From c484d01955cc47f78efe984e4ddf81046bd3c5c0 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 4 Oct 2026 18:43:00 +0800 Subject: [PATCH 001/148] Vendor the v0.15.16 core libraries into the standard library Prelude keeps the psrs:effect bindings and re-exports the official class hierarchy. Data.Show and Data.Tuple stay the implementations this compiler already lowers. Value foreign imports become intrinsics or diverging stubs. The parser accepts an `as@` named pattern and a `where` block on a pattern binding. A backticked local binds tighter than a symbolic operator. A module re-export keeps the imported data constructors, `Partial` is in scope without an import, and `T()` exports a type with none of its constructors. `-` and `/` are the library operators over `intSub` and `intQuot`. The trusted set parses. Modules that construct an algebraic `Tuple`, or that call FFI this target does not implement, still fail resolve. No scoreboard number moves. Refs #94 --- README.md | 12 +- crates/psrs-ast/src/expr/mod.rs | 44 + crates/psrs-ast/src/lib.rs | 11 +- crates/psrs-ast/src/local.rs | 7 +- crates/psrs-ast/src/tests.rs | 38 + crates/psrs-ast/src/type_decl.rs | 20 +- .../psrs-backend/src/cc/layout/aggregate.rs | 4 + .../src/cc/layout/functions/mod.rs | 18 +- .../src/cc/layout/functions/reachable.rs | 21 +- crates/psrs-backend/src/cc/layout/scalar.rs | 36 +- .../psrs-backend/src/cc/lower/lambda/mod.rs | 53 +- .../psrs-backend/src/cc/lower/record/mod.rs | 11 +- crates/psrs-core/src/effect/mod.rs | 10 + crates/psrs-core/src/link/mod.rs | 122 +- crates/psrs-core/src/lower/dictionary.rs | 11 +- crates/psrs-core/src/lower/mod.rs | 149 +- crates/psrs-core/src/lower/module.rs | 151 +- .../src/verify/types/matching/mod.rs | 85 +- crates/psrs-cst/src/declaration.rs | 2 + crates/psrs-cst/src/expr.rs | 10 + crates/psrs-desugar/src/fixity.rs | 20 +- crates/psrs-desugar/src/lib.rs | 5 +- crates/psrs-driver/src/prelude.rs | 45 +- crates/psrs-driver/src/program/effects.rs | 6 +- crates/psrs-driver/src/tests/data_tuple.rs | 70 +- crates/psrs-driver/src/tests/effect_arity.rs | 4 +- crates/psrs-driver/src/tests/module_loader.rs | 93 +- crates/psrs-driver/src/tests/records.rs | 10 + crates/psrs-driver/src/tests/scalars.rs | 21 + .../psrs-driver/src/tests/wasi/classes/mod.rs | 14 + crates/psrs-hir/src/expr.rs | 4 + crates/psrs-hir/src/intrinsic/registry.rs | 11 +- crates/psrs-hir/src/module.rs | 3 + crates/psrs-hir/src/verify/mod.rs | 18 +- .../psrs-resolve/src/resolver/exports/mod.rs | 160 +- crates/psrs-resolve/src/resolver/names/mod.rs | 6 +- .../psrs-resolve/src/resolver/names/util.rs | 44 +- crates/psrs-resolve/src/resolver/operators.rs | 44 +- .../src/resolver/program/interface.rs | 22 + .../psrs-resolve/src/resolver/program/mod.rs | 52 +- .../src/resolver/program/tests.rs | 40 + .../src/resolver/type_resolution.rs | 11 +- .../psrs-syntax/src/parser/declaration/mod.rs | 12 +- .../psrs-syntax/src/parser/expr/atom/mod.rs | 49 +- crates/psrs-syntax/src/parser/expr/pattern.rs | 23 +- crates/psrs-syntax/src/parser/tests.rs | 29 + .../psrs-syntax/src/parser/type_expr/mod.rs | 7 +- crates/psrs-thir/src/scope/mod.rs | 94 +- crates/psrs-thir/src/scope/polymorphic.rs | 57 + crates/psrs-thir/src/tests.rs | 78 + crates/psrs-thir/src/verify/mod.rs | 52 +- .../src/verify/semantics/matching/mod.rs | 44 +- .../src/verify/semantics/matching/tests.rs | 45 + crates/psrs-thir/src/verify/semantics/mod.rs | 5 + .../src/typecheck/classes/deriving/eq.rs | 204 +++ .../src/typecheck/classes/deriving/generic.rs | 459 ++++++ .../src/typecheck/classes/deriving/mod.rs | 293 ++-- .../src/typecheck/classes/deriving/newtype.rs | 32 +- .../src/typecheck/classes/deriving/ord.rs | 38 +- .../src/typecheck/classes/deriving/types.rs | 3 + .../src/typecheck/classes/environment/mod.rs | 99 +- .../src/typecheck/classes/fundeps.rs | 96 +- .../src/typecheck/classes/instance.rs | 29 +- crates/psrs-typecheck/src/typecheck/entry.rs | 1 - .../src/typecheck/generalize.rs | 18 + .../src/typecheck/infer/construct.rs | 4 +- crates/psrs-typecheck/src/typecheck/order.rs | 11 +- .../src/typecheck/prim/coercible/givens.rs | 40 +- .../src/typecheck/prim/coercible/mod.rs | 54 +- crates/psrs-typecheck/src/typecheck/state.rs | 12 +- .../src/typecheck/vocabulary.rs | 5 +- .../DEC-13-wit-to-source-type-mapping.md | 19 +- docs/design/D-04-suite-roadmap.md | 113 +- docs/design/D-15-compiler-builtins.md | 8 +- .../type-system/classes-and-evidence.md | 11 +- stdlib/lib/Control/Alt.purs | 42 + stdlib/lib/Control/Alternative.purs | 50 + stdlib/lib/Control/Applicative.purs | 70 + stdlib/lib/Control/Apply.purs | 119 ++ stdlib/lib/Control/Biapplicative.purs | 12 + stdlib/lib/Control/Biapply.purs | 59 + stdlib/lib/Control/Bind.purs | 158 ++ stdlib/lib/Control/Category.purs | 22 + stdlib/lib/Control/Comonad.purs | 21 + stdlib/lib/Control/Extend.purs | 60 + stdlib/lib/Control/Lazy.purs | 25 + stdlib/lib/Control/Monad.purs | 86 ++ stdlib/lib/Control/Monad/Gen.purs | 132 ++ stdlib/lib/Control/Monad/Gen/Class.purs | 29 + stdlib/lib/Control/Monad/Gen/Common.purs | 67 + stdlib/lib/Control/Monad/Rec/Class.purs | 191 +++ stdlib/lib/Control/Monad/ST.purs | 3 + stdlib/lib/Control/Monad/ST/Class.purs | 17 + stdlib/lib/Control/Monad/ST/Global.purs | 18 + stdlib/lib/Control/Monad/ST/Internal.purs | 147 ++ stdlib/lib/Control/Monad/ST/Ref.purs | 3 + stdlib/lib/Control/Monad/ST/Uncurried.purs | 101 ++ stdlib/lib/Control/MonadPlus.purs | 32 + stdlib/lib/Control/Plus.purs | 27 + stdlib/lib/Control/Semigroupoid.purs | 25 + stdlib/lib/Data/Array.purs | 1335 +++++++++++++++++ stdlib/lib/Data/Array/NonEmpty.purs | 598 ++++++++ stdlib/lib/Data/Array/NonEmpty/Internal.purs | 81 + stdlib/lib/Data/Array/Partial.purs | 35 + stdlib/lib/Data/Array/ST.purs | 265 ++++ stdlib/lib/Data/Array/ST/Iterator.purs | 80 + stdlib/lib/Data/Array/ST/Partial.purs | 38 + stdlib/lib/Data/Bifoldable.purs | 198 +++ stdlib/lib/Data/Bifunctor.purs | 46 + stdlib/lib/Data/Bifunctor/Join.purs | 31 + stdlib/lib/Data/Bitraversable.purs | 136 ++ stdlib/lib/Data/Boolean.purs | 10 + stdlib/lib/Data/BooleanAlgebra.purs | 43 + stdlib/lib/Data/Bounded.purs | 111 ++ stdlib/lib/Data/Bounded/Generic.purs | 56 + stdlib/lib/Data/Char.purs | 16 + stdlib/lib/Data/Char/Gen.purs | 35 + stdlib/lib/Data/CommutativeRing.purs | 44 + stdlib/lib/Data/Compactable.purs | 164 ++ stdlib/lib/Data/Comparison.purs | 25 + stdlib/lib/Data/Const.purs | 63 + stdlib/lib/Data/Decidable.purs | 29 + stdlib/lib/Data/Decide.purs | 42 + stdlib/lib/Data/Distributive.purs | 67 + stdlib/lib/Data/Divide.purs | 46 + stdlib/lib/Data/Divisible.purs | 25 + stdlib/lib/Data/DivisionRing.purs | 55 + stdlib/lib/Data/Either.purs | 297 +++- stdlib/lib/Data/Either/Inject.purs | 23 + stdlib/lib/Data/Either/Nested.purs | 278 ++++ stdlib/lib/Data/Enum.purs | 323 ++++ stdlib/lib/Data/Enum/Gen.purs | 18 + stdlib/lib/Data/Enum/Generic.purs | 118 ++ stdlib/lib/Data/Eq.purs | 133 +- stdlib/lib/Data/Eq/Generic.purs | 35 + stdlib/lib/Data/Equivalence.purs | 31 + stdlib/lib/Data/EuclideanRing.purs | 105 ++ stdlib/lib/Data/Exists.purs | 57 + stdlib/lib/Data/Field.purs | 41 + stdlib/lib/Data/Filterable.purs | 229 +++ stdlib/lib/Data/Foldable.purs | 497 +++++- stdlib/lib/Data/FoldableWithIndex.purs | 370 +++++ stdlib/lib/Data/Function.purs | 139 +- stdlib/lib/Data/Function/Uncurried.purs | 144 ++ stdlib/lib/Data/Functor.purs | 117 +- stdlib/lib/Data/Functor/App.purs | 56 + stdlib/lib/Data/Functor/Clown.purs | 44 + stdlib/lib/Data/Functor/Compose.purs | 58 + stdlib/lib/Data/Functor/Contravariant.purs | 35 + stdlib/lib/Data/Functor/Coproduct.purs | 76 + stdlib/lib/Data/Functor/Coproduct/Inject.purs | 24 + stdlib/lib/Data/Functor/Coproduct/Nested.purs | 273 ++++ stdlib/lib/Data/Functor/Costar.purs | 66 + stdlib/lib/Data/Functor/Flip.purs | 44 + stdlib/lib/Data/Functor/Invariant.purs | 57 + stdlib/lib/Data/Functor/Joker.purs | 60 + stdlib/lib/Data/Functor/Product.purs | 60 + stdlib/lib/Data/Functor/Product/Nested.purs | 112 ++ stdlib/lib/Data/Functor/Product2.purs | 40 + stdlib/lib/Data/FunctorWithIndex.purs | 94 ++ stdlib/lib/Data/Generic/Rep.purs | 62 + stdlib/lib/Data/HeytingAlgebra.purs | 174 +++ stdlib/lib/Data/HeytingAlgebra/Generic.purs | 70 + stdlib/lib/Data/Identity.purs | 72 + stdlib/lib/Data/Int.purs | 255 ++++ stdlib/lib/Data/Int/Bits.purs | 44 + stdlib/lib/Data/Lazy.purs | 144 ++ stdlib/lib/Data/List.purs | 826 ++++++++++ stdlib/lib/Data/List/Internal.purs | 63 + stdlib/lib/Data/List/Lazy.purs | 780 ++++++++++ stdlib/lib/Data/List/Lazy/NonEmpty.purs | 88 ++ stdlib/lib/Data/List/Lazy/Types.purs | 295 ++++ stdlib/lib/Data/List/NonEmpty.purs | 307 ++++ stdlib/lib/Data/List/Partial.purs | 30 + stdlib/lib/Data/List/Types.purs | 264 ++++ stdlib/lib/Data/List/ZipList.purs | 66 + stdlib/lib/Data/Map.purs | 65 + stdlib/lib/Data/Map/Gen.purs | 24 + stdlib/lib/Data/Map/Internal.purs | 988 ++++++++++++ stdlib/lib/Data/Maybe.purs | 312 +++- stdlib/lib/Data/Maybe/First.purs | 68 + stdlib/lib/Data/Maybe/Last.purs | 67 + stdlib/lib/Data/Monoid.purs | 117 +- stdlib/lib/Data/Monoid/Additive.purs | 44 + stdlib/lib/Data/Monoid/Alternate.purs | 60 + stdlib/lib/Data/Monoid/Conj.purs | 51 + stdlib/lib/Data/Monoid/Disj.purs | 51 + stdlib/lib/Data/Monoid/Dual.purs | 44 + stdlib/lib/Data/Monoid/Endo.purs | 30 + stdlib/lib/Data/Monoid/Generic.purs | 27 + stdlib/lib/Data/Monoid/Multiplicative.purs | 44 + stdlib/lib/Data/NaturalTransformation.purs | 20 + stdlib/lib/Data/Newtype.purs | 308 ++++ stdlib/lib/Data/NonEmpty.purs | 174 +++ stdlib/lib/Data/Number.purs | 388 +++++ stdlib/lib/Data/Number/Approximate.purs | 95 ++ stdlib/lib/Data/Number/Format.purs | 80 + stdlib/lib/Data/Op.purs | 22 + stdlib/lib/Data/Ord.purs | 279 +++- stdlib/lib/Data/Ord/Down.purs | 26 + stdlib/lib/Data/Ord/Generic.purs | 39 + stdlib/lib/Data/Ord/Max.purs | 29 + stdlib/lib/Data/Ord/Min.purs | 29 + stdlib/lib/Data/Ordering.purs | 36 + stdlib/lib/Data/Predicate.purs | 18 + stdlib/lib/Data/Profunctor.purs | 44 + stdlib/lib/Data/Profunctor/Choice.purs | 83 + stdlib/lib/Data/Profunctor/Closed.purs | 12 + stdlib/lib/Data/Profunctor/Cochoice.purs | 9 + stdlib/lib/Data/Profunctor/Costrong.purs | 9 + stdlib/lib/Data/Profunctor/Join.purs | 28 + stdlib/lib/Data/Profunctor/Split.purs | 39 + stdlib/lib/Data/Profunctor/Star.purs | 80 + stdlib/lib/Data/Profunctor/Strong.purs | 80 + stdlib/lib/Data/Reflectable.purs | 58 + stdlib/lib/Data/Ring.purs | 79 + stdlib/lib/Data/Ring/Generic.purs | 24 + stdlib/lib/Data/Semigroup.purs | 84 +- stdlib/lib/Data/Semigroup/First.purs | 40 + stdlib/lib/Data/Semigroup/Foldable.purs | 178 +++ stdlib/lib/Data/Semigroup/Generic.purs | 31 + stdlib/lib/Data/Semigroup/Last.purs | 40 + stdlib/lib/Data/Semigroup/Traversable.purs | 72 + stdlib/lib/Data/Semiring.purs | 131 +- stdlib/lib/Data/Semiring/Generic.purs | 51 + stdlib/lib/Data/Set.purs | 188 +++ stdlib/lib/Data/Set/NonEmpty.purs | 163 ++ stdlib/lib/Data/Show.purs | 16 +- stdlib/lib/Data/Show/Generic.purs | 64 + stdlib/lib/Data/String.purs | 10 + stdlib/lib/Data/String/CaseInsensitive.purs | 22 + stdlib/lib/Data/String/CodePoints.purs | 418 ++++++ stdlib/lib/Data/String/CodeUnits.purs | 316 ++++ stdlib/lib/Data/String/Common.purs | 98 ++ stdlib/lib/Data/String/Gen.purs | 43 + stdlib/lib/Data/String/NonEmpty.purs | 9 + .../Data/String/NonEmpty/CaseInsensitive.purs | 22 + .../lib/Data/String/NonEmpty/CodePoints.purs | 138 ++ .../lib/Data/String/NonEmpty/CodeUnits.purs | 308 ++++ stdlib/lib/Data/String/NonEmpty/Internal.purs | 232 +++ stdlib/lib/Data/String/Pattern.purs | 33 + stdlib/lib/Data/String/Regex.purs | 120 ++ stdlib/lib/Data/String/Regex/Flags.purs | 129 ++ stdlib/lib/Data/String/Regex/Unsafe.purs | 14 + stdlib/lib/Data/String/Unsafe.purs | 17 + stdlib/lib/Data/Symbol.purs | 25 + stdlib/lib/Data/Traversable.purs | 251 ++++ stdlib/lib/Data/Traversable/Accum.purs | 5 + .../lib/Data/Traversable/Accum/Internal.purs | 44 + stdlib/lib/Data/TraversableWithIndex.purs | 213 +++ stdlib/lib/Data/Tuple.purs | 30 +- stdlib/lib/Data/Tuple/Nested.purs | 294 ++++ stdlib/lib/Data/Unfoldable.purs | 96 ++ stdlib/lib/Data/Unfoldable1.purs | 124 ++ stdlib/lib/Data/Unit.purs | 5 + stdlib/lib/Data/Void.purs | 34 + stdlib/lib/Data/Witherable.purs | 162 ++ stdlib/lib/Effect.purs | 8 +- stdlib/lib/Effect/Ref.purs | 78 + stdlib/lib/Partial.purs | 16 + stdlib/lib/Partial/Unsafe.purs | 25 + stdlib/lib/Prelude.purs | 154 +- stdlib/lib/Record/Unsafe.purs | 31 + stdlib/lib/Safe/Coerce.purs | 27 + stdlib/lib/Type/Data/Boolean.purs | 66 + stdlib/lib/Type/Data/Ordering.purs | 69 + stdlib/lib/Type/Data/Symbol.purs | 35 + stdlib/lib/Type/Equality.purs | 35 + stdlib/lib/Type/Function.purs | 23 + stdlib/lib/Type/Prelude.purs | 17 + stdlib/lib/Type/Proxy.purs | 53 + stdlib/lib/Type/Row.purs | 22 + stdlib/lib/Type/Row/Homogeneous.purs | 23 + stdlib/lib/Type/RowList.purs | 82 + stdlib/lib/Unsafe/Coerce.purs | 28 + stdlib/lib/trusted | 206 ++- 276 files changed, 24627 insertions(+), 1067 deletions(-) create mode 100644 crates/psrs-thir/src/scope/polymorphic.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs create mode 100644 stdlib/lib/Control/Alt.purs create mode 100644 stdlib/lib/Control/Alternative.purs create mode 100644 stdlib/lib/Control/Applicative.purs create mode 100644 stdlib/lib/Control/Apply.purs create mode 100644 stdlib/lib/Control/Biapplicative.purs create mode 100644 stdlib/lib/Control/Biapply.purs create mode 100644 stdlib/lib/Control/Bind.purs create mode 100644 stdlib/lib/Control/Category.purs create mode 100644 stdlib/lib/Control/Comonad.purs create mode 100644 stdlib/lib/Control/Extend.purs create mode 100644 stdlib/lib/Control/Lazy.purs create mode 100644 stdlib/lib/Control/Monad.purs create mode 100644 stdlib/lib/Control/Monad/Gen.purs create mode 100644 stdlib/lib/Control/Monad/Gen/Class.purs create mode 100644 stdlib/lib/Control/Monad/Gen/Common.purs create mode 100644 stdlib/lib/Control/Monad/Rec/Class.purs create mode 100644 stdlib/lib/Control/Monad/ST.purs create mode 100644 stdlib/lib/Control/Monad/ST/Class.purs create mode 100644 stdlib/lib/Control/Monad/ST/Global.purs create mode 100644 stdlib/lib/Control/Monad/ST/Internal.purs create mode 100644 stdlib/lib/Control/Monad/ST/Ref.purs create mode 100644 stdlib/lib/Control/Monad/ST/Uncurried.purs create mode 100644 stdlib/lib/Control/MonadPlus.purs create mode 100644 stdlib/lib/Control/Plus.purs create mode 100644 stdlib/lib/Control/Semigroupoid.purs create mode 100644 stdlib/lib/Data/Array.purs create mode 100644 stdlib/lib/Data/Array/NonEmpty.purs create mode 100644 stdlib/lib/Data/Array/NonEmpty/Internal.purs create mode 100644 stdlib/lib/Data/Array/Partial.purs create mode 100644 stdlib/lib/Data/Array/ST.purs create mode 100644 stdlib/lib/Data/Array/ST/Iterator.purs create mode 100644 stdlib/lib/Data/Array/ST/Partial.purs create mode 100644 stdlib/lib/Data/Bifoldable.purs create mode 100644 stdlib/lib/Data/Bifunctor.purs create mode 100644 stdlib/lib/Data/Bifunctor/Join.purs create mode 100644 stdlib/lib/Data/Bitraversable.purs create mode 100644 stdlib/lib/Data/Boolean.purs create mode 100644 stdlib/lib/Data/BooleanAlgebra.purs create mode 100644 stdlib/lib/Data/Bounded.purs create mode 100644 stdlib/lib/Data/Bounded/Generic.purs create mode 100644 stdlib/lib/Data/Char.purs create mode 100644 stdlib/lib/Data/Char/Gen.purs create mode 100644 stdlib/lib/Data/CommutativeRing.purs create mode 100644 stdlib/lib/Data/Compactable.purs create mode 100644 stdlib/lib/Data/Comparison.purs create mode 100644 stdlib/lib/Data/Const.purs create mode 100644 stdlib/lib/Data/Decidable.purs create mode 100644 stdlib/lib/Data/Decide.purs create mode 100644 stdlib/lib/Data/Distributive.purs create mode 100644 stdlib/lib/Data/Divide.purs create mode 100644 stdlib/lib/Data/Divisible.purs create mode 100644 stdlib/lib/Data/DivisionRing.purs create mode 100644 stdlib/lib/Data/Either/Inject.purs create mode 100644 stdlib/lib/Data/Either/Nested.purs create mode 100644 stdlib/lib/Data/Enum.purs create mode 100644 stdlib/lib/Data/Enum/Gen.purs create mode 100644 stdlib/lib/Data/Enum/Generic.purs create mode 100644 stdlib/lib/Data/Eq/Generic.purs create mode 100644 stdlib/lib/Data/Equivalence.purs create mode 100644 stdlib/lib/Data/EuclideanRing.purs create mode 100644 stdlib/lib/Data/Exists.purs create mode 100644 stdlib/lib/Data/Field.purs create mode 100644 stdlib/lib/Data/Filterable.purs create mode 100644 stdlib/lib/Data/FoldableWithIndex.purs create mode 100644 stdlib/lib/Data/Function/Uncurried.purs create mode 100644 stdlib/lib/Data/Functor/App.purs create mode 100644 stdlib/lib/Data/Functor/Clown.purs create mode 100644 stdlib/lib/Data/Functor/Compose.purs create mode 100644 stdlib/lib/Data/Functor/Contravariant.purs create mode 100644 stdlib/lib/Data/Functor/Coproduct.purs create mode 100644 stdlib/lib/Data/Functor/Coproduct/Inject.purs create mode 100644 stdlib/lib/Data/Functor/Coproduct/Nested.purs create mode 100644 stdlib/lib/Data/Functor/Costar.purs create mode 100644 stdlib/lib/Data/Functor/Flip.purs create mode 100644 stdlib/lib/Data/Functor/Invariant.purs create mode 100644 stdlib/lib/Data/Functor/Joker.purs create mode 100644 stdlib/lib/Data/Functor/Product.purs create mode 100644 stdlib/lib/Data/Functor/Product/Nested.purs create mode 100644 stdlib/lib/Data/Functor/Product2.purs create mode 100644 stdlib/lib/Data/FunctorWithIndex.purs create mode 100644 stdlib/lib/Data/Generic/Rep.purs create mode 100644 stdlib/lib/Data/HeytingAlgebra.purs create mode 100644 stdlib/lib/Data/HeytingAlgebra/Generic.purs create mode 100644 stdlib/lib/Data/Identity.purs create mode 100644 stdlib/lib/Data/Int.purs create mode 100644 stdlib/lib/Data/Int/Bits.purs create mode 100644 stdlib/lib/Data/Lazy.purs create mode 100644 stdlib/lib/Data/List.purs create mode 100644 stdlib/lib/Data/List/Internal.purs create mode 100644 stdlib/lib/Data/List/Lazy.purs create mode 100644 stdlib/lib/Data/List/Lazy/NonEmpty.purs create mode 100644 stdlib/lib/Data/List/Lazy/Types.purs create mode 100644 stdlib/lib/Data/List/NonEmpty.purs create mode 100644 stdlib/lib/Data/List/Partial.purs create mode 100644 stdlib/lib/Data/List/Types.purs create mode 100644 stdlib/lib/Data/List/ZipList.purs create mode 100644 stdlib/lib/Data/Map.purs create mode 100644 stdlib/lib/Data/Map/Gen.purs create mode 100644 stdlib/lib/Data/Map/Internal.purs create mode 100644 stdlib/lib/Data/Maybe/First.purs create mode 100644 stdlib/lib/Data/Maybe/Last.purs create mode 100644 stdlib/lib/Data/Monoid/Additive.purs create mode 100644 stdlib/lib/Data/Monoid/Alternate.purs create mode 100644 stdlib/lib/Data/Monoid/Conj.purs create mode 100644 stdlib/lib/Data/Monoid/Disj.purs create mode 100644 stdlib/lib/Data/Monoid/Dual.purs create mode 100644 stdlib/lib/Data/Monoid/Endo.purs create mode 100644 stdlib/lib/Data/Monoid/Generic.purs create mode 100644 stdlib/lib/Data/Monoid/Multiplicative.purs create mode 100644 stdlib/lib/Data/NaturalTransformation.purs create mode 100644 stdlib/lib/Data/Newtype.purs create mode 100644 stdlib/lib/Data/NonEmpty.purs create mode 100644 stdlib/lib/Data/Number.purs create mode 100644 stdlib/lib/Data/Number/Approximate.purs create mode 100644 stdlib/lib/Data/Number/Format.purs create mode 100644 stdlib/lib/Data/Op.purs create mode 100644 stdlib/lib/Data/Ord/Down.purs create mode 100644 stdlib/lib/Data/Ord/Generic.purs create mode 100644 stdlib/lib/Data/Ord/Max.purs create mode 100644 stdlib/lib/Data/Ord/Min.purs create mode 100644 stdlib/lib/Data/Ordering.purs create mode 100644 stdlib/lib/Data/Predicate.purs create mode 100644 stdlib/lib/Data/Profunctor.purs create mode 100644 stdlib/lib/Data/Profunctor/Choice.purs create mode 100644 stdlib/lib/Data/Profunctor/Closed.purs create mode 100644 stdlib/lib/Data/Profunctor/Cochoice.purs create mode 100644 stdlib/lib/Data/Profunctor/Costrong.purs create mode 100644 stdlib/lib/Data/Profunctor/Join.purs create mode 100644 stdlib/lib/Data/Profunctor/Split.purs create mode 100644 stdlib/lib/Data/Profunctor/Star.purs create mode 100644 stdlib/lib/Data/Profunctor/Strong.purs create mode 100644 stdlib/lib/Data/Reflectable.purs create mode 100644 stdlib/lib/Data/Ring.purs create mode 100644 stdlib/lib/Data/Ring/Generic.purs create mode 100644 stdlib/lib/Data/Semigroup/First.purs create mode 100644 stdlib/lib/Data/Semigroup/Foldable.purs create mode 100644 stdlib/lib/Data/Semigroup/Generic.purs create mode 100644 stdlib/lib/Data/Semigroup/Last.purs create mode 100644 stdlib/lib/Data/Semigroup/Traversable.purs create mode 100644 stdlib/lib/Data/Semiring/Generic.purs create mode 100644 stdlib/lib/Data/Set.purs create mode 100644 stdlib/lib/Data/Set/NonEmpty.purs create mode 100644 stdlib/lib/Data/Show/Generic.purs create mode 100644 stdlib/lib/Data/String.purs create mode 100644 stdlib/lib/Data/String/CaseInsensitive.purs create mode 100644 stdlib/lib/Data/String/CodePoints.purs create mode 100644 stdlib/lib/Data/String/CodeUnits.purs create mode 100644 stdlib/lib/Data/String/Common.purs create mode 100644 stdlib/lib/Data/String/Gen.purs create mode 100644 stdlib/lib/Data/String/NonEmpty.purs create mode 100644 stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs create mode 100644 stdlib/lib/Data/String/NonEmpty/CodePoints.purs create mode 100644 stdlib/lib/Data/String/NonEmpty/CodeUnits.purs create mode 100644 stdlib/lib/Data/String/NonEmpty/Internal.purs create mode 100644 stdlib/lib/Data/String/Pattern.purs create mode 100644 stdlib/lib/Data/String/Regex.purs create mode 100644 stdlib/lib/Data/String/Regex/Flags.purs create mode 100644 stdlib/lib/Data/String/Regex/Unsafe.purs create mode 100644 stdlib/lib/Data/String/Unsafe.purs create mode 100644 stdlib/lib/Data/Symbol.purs create mode 100644 stdlib/lib/Data/Traversable.purs create mode 100644 stdlib/lib/Data/Traversable/Accum.purs create mode 100644 stdlib/lib/Data/Traversable/Accum/Internal.purs create mode 100644 stdlib/lib/Data/TraversableWithIndex.purs create mode 100644 stdlib/lib/Data/Tuple/Nested.purs create mode 100644 stdlib/lib/Data/Unfoldable.purs create mode 100644 stdlib/lib/Data/Unfoldable1.purs create mode 100644 stdlib/lib/Data/Unit.purs create mode 100644 stdlib/lib/Data/Void.purs create mode 100644 stdlib/lib/Data/Witherable.purs create mode 100644 stdlib/lib/Effect/Ref.purs create mode 100644 stdlib/lib/Partial.purs create mode 100644 stdlib/lib/Partial/Unsafe.purs create mode 100644 stdlib/lib/Record/Unsafe.purs create mode 100644 stdlib/lib/Safe/Coerce.purs create mode 100644 stdlib/lib/Type/Data/Boolean.purs create mode 100644 stdlib/lib/Type/Data/Ordering.purs create mode 100644 stdlib/lib/Type/Data/Symbol.purs create mode 100644 stdlib/lib/Type/Equality.purs create mode 100644 stdlib/lib/Type/Function.purs create mode 100644 stdlib/lib/Type/Prelude.purs create mode 100644 stdlib/lib/Type/Proxy.purs create mode 100644 stdlib/lib/Type/Row.purs create mode 100644 stdlib/lib/Type/Row/Homogeneous.purs create mode 100644 stdlib/lib/Type/RowList.purs create mode 100644 stdlib/lib/Unsafe/Coerce.purs diff --git a/README.md b/README.md index 11c624ee..a53b0afa 100644 --- a/README.md +++ b/README.md @@ -46,17 +46,17 @@ what remains in each layer. | Gate | Measured | Scope | | --- | --- | --- | | L0/L1 lexing, layout, parsing | 904/908 | non-FFI `layout`, `passing`, `failing`, `warning` files; the four differences are recorded DEC-16 intentional differences | -| L2 resolution | 72/72 failing, 276/413 passing | official `errorCode`s; 53 `passing` files stop on a missing module and 80 at P3 | -| L3 kinds | 36/48 failing | official kind `errorCode`s | -| L4 types | 35/50 failing | official `errorCode`s | -| L5 classes | 53/79 failing | official `errorCode`s | -| L6/M7 runtime | 125/413 passing | all 125 exit 0; 63 have no selected `main`; 53 stop on a missing module | +| L2 resolution | 71/72 failing, 386/413 passing | official `errorCode`s; 23 passing files stop at P3 and 4 at P0 | +| L3 kinds | 39/48 failing | official kind `errorCode`s | +| L4 types | 39/50 failing | official `errorCode`s | +| L5 classes | 58/81 failing | official `errorCode`s | +| L6/M7 runtime | 164/413 passing | all 164 exit 0; 249 do not agree, including 46 with no selected `main` | | M8 warnings, optimization | not measured | no scoreboard exists | Run the scoreboards yourself: ```sh -PSRS_ORACLE=annotations \ +PSRS_ORACLE=annotations PSRS_REQUIRE_WASMTIME=1 \ cargo test -p psrs-driver --test suite -- --ignored --nocapture ``` diff --git a/crates/psrs-ast/src/expr/mod.rs b/crates/psrs-ast/src/expr/mod.rs index 7811a9f7..7838e897 100644 --- a/crates/psrs-ast/src/expr/mod.rs +++ b/crates/psrs-ast/src/expr/mod.rs @@ -191,6 +191,50 @@ pub(super) fn lower_record_update( }) } +pub(super) fn lower_field_access( + expression: psrs_cst::Expr, + field: psrs_cst::CstName, + span: TextRange, +) -> Result { + Ok(Expr { + kind: ExprKind::FieldAccess { + expression: Box::new(super::lower_expr(expression)?), + field: field.text, + }, + span, + }) +} + +pub(super) fn lower_record_accessor( + marker_span: TextRange, + fields: Vec, + span: TextRange, +) -> Expr { + let binder = Binder { + name: format!("$psrs_record_accessor_{}", marker_span.start), + span: marker_span, + }; + let mut body = Expr { + kind: ExprKind::Name(crate::Name { + text: binder.name.clone(), + span: marker_span, + }), + span: marker_span, + }; + for field in fields { + body = Expr { + kind: ExprKind::FieldAccess { + expression: Box::new(body), + field: field.field.text, + }, + span: TextRange::new(marker_span.start, field.field.span.end), + }; + } + let mut accessor = super::lower_lambda(binder, body); + accessor.span = span; + accessor +} + pub(super) fn lower_pattern_lambda( pattern: psrs_cst::Pattern, body: Expr, diff --git a/crates/psrs-ast/src/lib.rs b/crates/psrs-ast/src/lib.rs index ac1c73ea..97f41db6 100644 --- a/crates/psrs-ast/src/lib.rs +++ b/crates/psrs-ast/src/lib.rs @@ -218,10 +218,13 @@ pub(crate) fn lower_expr(expression: cst::Expr) -> Result { } => expr::lower_record_update(*expression, fields)?, CstExprKind::FieldAccess { expression, field, .. - } => ExprKind::FieldAccess { - expression: Box::new(lower_expr(*expression)?), - field: field.text, - }, + } => return expr::lower_field_access(*expression, field, span), + CstExprKind::RecordAccessor { + marker_span, + fields, + } => { + return Ok(expr::lower_record_accessor(marker_span, fields, span)); + } CstExprKind::Application(function, argument) => ExprKind::Application( Box::new(lower_expr(*function)?), Box::new(lower_expr(*argument)?), diff --git a/crates/psrs-ast/src/local.rs b/crates/psrs-ast/src/local.rs index da9a62f0..fe8930dd 100644 --- a/crates/psrs-ast/src/local.rs +++ b/crates/psrs-ast/src/local.rs @@ -19,7 +19,12 @@ pub(crate) fn lower_local_declarations( return Err(error); } let pattern_span = pattern.span; - let scrutinee = Box::new(crate::lower_expr(pattern.value.clone())?); + let mut scrutinee = crate::lower_expr(pattern.value.clone())?; + if let Some(block) = &pattern.where_block { + let span = TextRange::new(block.span.start, scrutinee.span.end); + scrutinee = lower_local_declarations(block.declarations.clone(), scrutinee, span)?; + } + let scrutinee = Box::new(scrutinee); let pattern = crate::expr::lower_pattern(pattern.pattern.clone())?; let remaining = lower_local_declarations(declarations[1..].to_vec(), body, span)?; let branch_span = TextRange::new(pattern_span.start, remaining.span.end); diff --git a/crates/psrs-ast/src/tests.rs b/crates/psrs-ast/src/tests.rs index a745509c..d765ecf1 100644 --- a/crates/psrs-ast/src/tests.rs +++ b/crates/psrs-ast/src/tests.rs @@ -132,6 +132,44 @@ fn parentheses_are_removed_without_losing_the_expression_range() { assert_eq!(value.span, TextRange::new(25, 29)); } +#[test] +fn anonymous_record_accessor_is_lowered_to_a_lambda() { + let underscore_span = TextRange::new(25, 26); + let field_span = TextRange::new(27, 32); + let expression = cst::Expr { + kind: CstExprKind::RecordAccessor { + marker_span: underscore_span, + fields: vec![cst::RecordAccessorField { + dot_span: TextRange::new(26, 27), + field: name("value", field_span.start), + }], + }, + span: TextRange::new(25, 32), + }; + let declaration = value_declaration( + "project", + 18, + Vec::new(), + TextRange::new(23, 24), + expression, + 32, + None, + ); + let module = lower_module(cst_module(declaration)).unwrap(); + let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { + panic!("an anonymous record accessor should become a lambda"); + }; + assert_eq!(module.declarations[0].value.span, TextRange::new(25, 32)); + let ExprKind::FieldAccess { expression, field } = &body.kind else { + panic!("the accessor lambda should contain a field access"); + }; + assert_eq!(field, "value"); + assert!(matches!( + &expression.kind, + ExprKind::Name(name) if name.text == binder.name + )); +} + #[test] fn lowers_forall_types_and_removes_parentheses() { let annotation = cst::TypeExpr { diff --git a/crates/psrs-ast/src/type_decl.rs b/crates/psrs-ast/src/type_decl.rs index e4028d5d..e97fb526 100644 --- a/crates/psrs-ast/src/type_decl.rs +++ b/crates/psrs-ast/src/type_decl.rs @@ -336,7 +336,8 @@ fn collect_parameters( if let cst::TypeExprKind::Application(function, arguments) = &expression.kind { collect_parameters(function, out)?; for argument in arguments { - match &strip_parens(argument).kind { + let argument = strip_parens(argument); + match &argument.kind { cst::TypeExprKind::Name(name) if is_type_variable(&name.text) => { out.push(TypeParameter { name: lower_name(name.clone()), @@ -360,6 +361,23 @@ fn collect_parameters( }); } } + // In a class head, `(a :: k)` is a kinded class parameter. + // The CST parser represents this parenthesized form as a + // one-field row because the same token sequence also spells a + // row type. At this boundary the class-head context makes the + // binder interpretation explicit. + cst::TypeExprKind::Row { fields, tail, .. } + if tail.is_none() + && fields.len() == 1 + && is_type_variable(&fields[0].label.text) => + { + let field = &fields[0]; + out.push(TypeParameter { + name: lower_name(field.label.clone()), + kind: Some(lower_type(field.type_expr.clone())?), + span: field.label.span, + }); + } _ => {} } } diff --git a/crates/psrs-backend/src/cc/layout/aggregate.rs b/crates/psrs-backend/src/cc/layout/aggregate.rs index 29309b4f..0a113ec1 100644 --- a/crates/psrs-backend/src/cc/layout/aggregate.rs +++ b/crates/psrs-backend/src/cc/layout/aggregate.rs @@ -28,8 +28,12 @@ pub(super) fn reserve_aggregate_layouts( ) -> AggregateLayouts { let mut arrays = HashMap::new(); let mut records = HashMap::new(); + let live_types = super::functions::live_type_ids(module); for index in 0..module.types.len() { let id = TypeId(index as u32); + if !live_types.contains(&id) { + continue; + } if array_element_type(module, id).is_some() { arrays.insert(id, representations.reserve()); } else if module.is_record_type(id) && !module.record_is_open(id).unwrap_or(false) { diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index fa633aec..49c89225 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -7,8 +7,13 @@ use std::collections::{HashMap, HashSet}; mod reachable; +use super::scalar::function_parameter_shape; use reachable::referenced_types; +pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { + reachable::live_type_ids(module) +} + pub(super) fn append_function_types( module: &CoreModule, enum_types: &HashSet, @@ -19,14 +24,9 @@ pub(super) fn append_function_types( representations: &mut RepresentationTable, ) -> Result> { // Constructor schemes and unused library declarations leave callable types - // in the linked table. Laying those out would demand a runtime shape for an - // ADT the program never references. Both source arrows and the closure - // representation of a registered callable constructor are callable, so both - // receive a signature here. - let referenced = referenced_types( - module, - array_types.keys().chain(record_types.keys()).copied(), - ); + // in the linked table. Only types referenced by remaining declarations and + // constructor fields need runtime signatures. + let referenced = referenced_types(module, std::iter::empty()); let function_ids = module .types .iter() @@ -114,7 +114,7 @@ pub(crate) fn function_signature( let parameters = parameter_ids .into_iter() .map(|parameter| { - scalar_type( + function_parameter_shape( module, parameter, module.span, diff --git a/crates/psrs-backend/src/cc/layout/functions/reachable.rs b/crates/psrs-backend/src/cc/layout/functions/reachable.rs index 479de563..eb8969ef 100644 --- a/crates/psrs-backend/src/cc/layout/functions/reachable.rs +++ b/crates/psrs-backend/src/cc/layout/functions/reachable.rs @@ -1,14 +1,13 @@ use psrs_core::{Expr, ExprKind, Module as CoreModule, Pattern, PatternKind, Type, TypeId}; use std::collections::HashSet; -/// Callable types that occur on a remaining declaration, expression, or -/// constructor field, or reserved aggregate layout. Other residual callable -/// types left behind by pruned library code are omitted. +/// Types referenced by remaining declarations, expressions, constructor fields, +/// and any explicitly supplied aggregate layout roots. pub(super) fn referenced_types( module: &CoreModule, aggregate_roots: impl Iterator, ) -> HashSet { - let mut referenced = HashSet::new(); + let mut referenced = live_type_ids(module); let mut visiting = HashSet::new(); // Every reserved aggregate is normalized by the layout builder. Its nested // callable fields therefore need signatures even when its Core type is a @@ -16,6 +15,12 @@ pub(super) fn referenced_types( for ty in aggregate_roots { record_type(module, ty, &mut visiting, &mut referenced); } + referenced +} + +pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { + let mut referenced = HashSet::new(); + let mut visiting = HashSet::new(); for declaration in &module.declarations { record_type(module, declaration.ty, &mut visiting, &mut referenced); record_expr(module, &declaration.value, &mut visiting, &mut referenced); @@ -145,14 +150,12 @@ fn record_type( if !visiting.insert(id) { return; } + referenced.insert(id); match module.types.get(id.0 as usize) { Some(Type::Application(function, argument)) => { // An ordinary arrow and a registered callable constructor // application are both callable closures and need a representation // signature even though they are not a dedicated type node. - if super::super::is_callable_type(module, id) { - referenced.insert(id); - } record_type(module, *function, visiting, referenced); record_type(module, *argument, visiting, referenced); } @@ -164,13 +167,9 @@ fn record_type( // Keep a signature entry for the quantified value itself as well // as for its body. Use sites retain the scheme TypeId on binders, // while expression TypeIds may name its instantiated body. - if super::super::is_callable_type(module, id) { - referenced.insert(id); - } record_type(module, *body, visiting, referenced); } Some(Type::Closure { parameters, result }) => { - referenced.insert(id); for parameter in parameters { record_type(module, *parameter, visiting, referenced); } diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index cb37d31f..e229918e 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -1,6 +1,6 @@ use super::{ - function_type_signature, is_callable_type, layout_error, newtype_field_type, - primitive_shape_of, unquantified_type, user_type_id, + depends_on_type_variable, function_type_signature, is_callable_type, layout_error, + newtype_field_type, primitive_shape_of, unquantified_type, user_type_id, }; use crate::BackendError; use crate::cc::{RefShape, Reference, ReprId, Signature, SignatureId, ValueShape}; @@ -43,7 +43,7 @@ pub(crate) fn declaration_shape( "lambda binder type differs from the function parameter type", )]); } - parameters.push(scalar_type( + parameters.push(function_parameter_shape( module, binder.ty, binder.span, @@ -84,7 +84,7 @@ pub(crate) fn declaration_shape( )]); } ty = result; - parameters.push(scalar_type( + parameters.push(function_parameter_shape( module, binder.ty, binder.span, @@ -393,6 +393,34 @@ pub(crate) fn scalar_type( } } +pub(super) fn function_parameter_shape( + module: &CoreModule, + ty: TypeId, + span: TextRange, + enum_types: &HashSet, + aggregate_types: &HashSet, + newtype_ids: &HashSet, + array_types: &HashMap, + record_types: &HashMap, + function_types: &HashMap, +) -> Result> { + if module.is_record_type(ty) && depends_on_type_variable(module, ty) { + Ok(aggregate_value_type()) + } else { + scalar_type( + module, + ty, + span, + enum_types, + aggregate_types, + newtype_ids, + array_types, + record_types, + function_types, + ) + } +} + fn aggregate_value_type() -> ValueShape { ValueShape::Reference(Reference { nullable: false, diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index a5cda1c6..6d09ad0f 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -1,4 +1,6 @@ -use super::super::layout::{function_type_signature, scalar_type, unquantified_type}; +use super::super::layout::{ + function_arrow_parameters, function_type_signature, scalar_type, unquantified_type, +}; use super::super::{ Assignment, AssignmentKind, Function, RefShape, Reference, ValueId, ValueShape, }; @@ -103,8 +105,11 @@ impl LambdaLowering for FunctionLowerer<'_> { let mut nested = self.child_lowerer(); let closure_parameter = nested.fresh(closure_value_type()); let mut parameters = vec![closure_parameter]; - for binder in &binders { - let parameter_type = scalar_type( + let source_parameter_types = function_arrow_parameters(self.module, expression.ty).0; + let mut nested_assignments = Vec::new(); + let mut binder_adaptations = Vec::with_capacity(binders.len()); + for (index, binder) in binders.iter().enumerate() { + let binder_shape = scalar_type( self.module, binder.ty, binder.span, @@ -115,9 +120,26 @@ impl LambdaLowering for FunctionLowerer<'_> { self.record_types, self.function_types, )?; - let parameter = nested.fresh(parameter_type); - nested.locals.insert(binder.id, parameter); + let parameter_shape = signature_definition + .as_ref() + .and_then(|signature| signature.parameters.get(index)) + .copied() + .unwrap_or(binder_shape); + let parameter = nested.fresh(parameter_shape); nested.local_types.insert(binder.id, binder.ty); + let source_type = source_parameter_types + .get(index) + .copied() + .unwrap_or(binder.ty); + binder_adaptations.push(( + binder.id, + parameter, + source_type, + binder.ty, + parameter_shape, + binder_shape, + binder.span, + )); parameters.push(parameter); } let mut extra_parameters = Vec::new(); @@ -131,7 +153,26 @@ impl LambdaLowering for FunctionLowerer<'_> { extra_parameters.push(parameter); } } - let mut nested_assignments = Vec::new(); + for (local, parameter, source_type, binder_type, parameter_shape, binder_shape, span) in + binder_adaptations + { + let conversion = nested.typed_conversion( + source_type, + binder_type, + parameter_shape, + binder_shape, + span, + )?; + let bound_value = nested.emit_conversion( + parameter, + parameter_shape, + binder_shape, + conversion, + span, + &mut nested_assignments, + ); + nested.locals.insert(local, bound_value); + } for (index, capture) in captures.into_iter().enumerate() { let Some(outer_value) = self.locals.get(&capture).copied() else { return Err(capture_error(expression)); diff --git a/crates/psrs-backend/src/cc/lower/record/mod.rs b/crates/psrs-backend/src/cc/lower/record/mod.rs index e34f24bf..c6d35111 100644 --- a/crates/psrs-backend/src/cc/lower/record/mod.rs +++ b/crates/psrs-backend/src/cc/lower/record/mod.rs @@ -212,7 +212,16 @@ impl FunctionLowerer<'_> { ty: ValueShape, assignments: &mut Vec, ) -> Result> { - let Some(representation) = self.record_types.get(&record.ty).copied() else { + // A local may be used at an instantiated type while its runtime value + // still has the layout fixed by its binder (notably a class dictionary + // passed through a higher-kinded method). Project using that stored + // layout, then convert the selected field to the use-site type below. + let source_type = match &record.kind { + psrs_core::ExprKind::Local(local) => self.local_types.get(local).copied(), + _ => None, + } + .unwrap_or(record.ty); + let Some(representation) = self.record_types.get(&source_type).copied() else { return Err(vec![BackendError::new( "P8 closure conversion", expression.span, diff --git a/crates/psrs-core/src/effect/mod.rs b/crates/psrs-core/src/effect/mod.rs index db0657a4..b150cdb9 100644 --- a/crates/psrs-core/src/effect/mod.rs +++ b/crates/psrs-core/src/effect/mod.rs @@ -147,6 +147,16 @@ pub fn lower_effects( "trusted Effect identity is missing or is not an opaque type", )]); } + match module.callable_parameters(effect) { + Some(1) => {} + Some(_) => { + return Err(vec![verification_error( + module, + "trusted Effect type has an incompatible callable representation", + )]); + } + None => module.callable_types.push((effect, 1)), + } let token = intern(module, Type::Constructor(TypeConstructor::Int)); let closures = rewrite_effect_applications(module, effect, token); let synthesized = synthesize_operations(module, token, trusted)?; diff --git a/crates/psrs-core/src/link/mod.rs b/crates/psrs-core/src/link/mod.rs index ca4fdcae..bed51572 100644 --- a/crates/psrs-core/src/link/mod.rs +++ b/crates/psrs-core/src/link/mod.rs @@ -235,6 +235,8 @@ fn shift_pattern(pattern: crate::Pattern, offset: u32) -> crate::Pattern { /// library declarations it reaches. pub fn prune_unreachable(module: &mut Module, root: SymbolId) { let mut reachable = HashSet::new(); + let mut used_types = HashSet::new(); + let mut visited_types = HashSet::new(); let mut work = vec![root]; while let Some(symbol) = work.pop() { if !reachable.insert(symbol) { @@ -245,7 +247,14 @@ pub fn prune_unreachable(module: &mut Module, root: SymbolId) { .iter() .find(|declaration| declaration.symbol == symbol) { - collect_references(&declaration.value, &mut work); + collect_core_type_ids(declaration.ty, module, &mut used_types, &mut visited_types); + collect_references( + &declaration.value, + &mut work, + module, + &mut used_types, + &mut visited_types, + ); } } module @@ -253,19 +262,19 @@ pub fn prune_unreachable(module: &mut Module, root: SymbolId) { .retain(|declaration| reachable.contains(&declaration.symbol)); // A reachable constructor keeps every case of its type so the variant // layout stays complete. Unused library types drop out with their cases. - let mut used_types = module - .constructors - .iter() - .filter(|constructor| reachable.contains(&constructor.symbol)) - .map(|constructor| constructor.type_id) - .collect::>(); - // A foreign import's declared signature can name a library type the program - // never constructs or matches, such as a newtype resource wrapper. Its - // constructors are still needed to resolve and lay out the binding, so keep - // every type the external signatures mention. - let mut visited = HashSet::new(); + used_types.extend( + module + .constructors + .iter() + .filter(|constructor| reachable.contains(&constructor.symbol)) + .map(|constructor| constructor.type_id), + ); + // Reachable declaration and foreign-import signatures can mention library + // types that the program never constructs or matches directly. Their + // constructors are still needed to lay out those signatures (for example, + // the nullary `Proxy` constructor in a class method type). for external in &module.external_types { - collect_core_type_ids(external.ty, module, &mut used_types, &mut visited); + collect_core_type_ids(external.ty, module, &mut used_types, &mut visited_types); } loop { let before = used_types.len(); @@ -276,7 +285,7 @@ pub fn prune_unreachable(module: &mut Module, root: SymbolId) { .flat_map(|constructor| constructor.field_types.iter().copied()) .collect::>(); for field_type in field_types { - collect_core_type_ids(field_type, module, &mut used_types, &mut visited); + collect_core_type_ids(field_type, module, &mut used_types, &mut visited_types); } if used_types.len() == before { break; @@ -321,13 +330,20 @@ fn collect_core_type_ids( } } -fn collect_references(expression: &Expr, out: &mut Vec) { +fn collect_references( + expression: &Expr, + out: &mut Vec, + module: &Module, + used_types: &mut HashSet, + visited_types: &mut HashSet, +) { + collect_core_type_ids(expression.ty, module, used_types, visited_types); match &expression.kind { ExprKind::Global(symbol) => out.push(*symbol), ExprKind::Constructor { symbol, arguments } => { out.push(*symbol); for argument in arguments { - collect_references(argument, out); + collect_references(argument, out, module, used_types, visited_types); } } ExprKind::Local(_) @@ -335,83 +351,107 @@ fn collect_references(expression: &Expr, out: &mut Vec) { | ExprKind::Number(_) | ExprKind::Boolean(_) | ExprKind::String(_) - | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::Trap => {} + | ExprKind::Char(_) + | ExprKind::Unit + | ExprKind::Trap => {} ExprKind::Array { elements } => { for element in elements { - collect_references(element, out); + collect_references(element, out, module, used_types, visited_types); } } ExprKind::Record { fields } => { for (_, value) in fields { - collect_references(value, out); + collect_references(value, out, module, used_types, visited_types); } } ExprKind::RecordUpdate { record, fields } => { - collect_references(record, out); + collect_references(record, out, module, used_types, visited_types); for (_, value) in fields { - collect_references(value, out); + collect_references(value, out, module, used_types, visited_types); } } - ExprKind::FieldAccess { record, .. } => collect_references(record, out), - ExprKind::RepresentationCast { value, .. } => collect_references(value, out), + ExprKind::FieldAccess { record, .. } => { + collect_references(record, out, module, used_types, visited_types) + } + ExprKind::RepresentationCast { + value, + source_type, + target_type, + } => { + collect_core_type_ids(*source_type, module, used_types, visited_types); + collect_core_type_ids(*target_type, module, used_types, visited_types); + collect_references(value, out, module, used_types, visited_types); + } ExprKind::IntrinsicCall { arguments, .. } => { for argument in arguments { - collect_references(argument, out); + collect_references(argument, out, module, used_types, visited_types); } } ExprKind::Application(left, right) => { - collect_references(left, out); - collect_references(right, out); + collect_references(left, out, module, used_types, visited_types); + collect_references(right, out, module, used_types, visited_types); + } + ExprKind::Lambda { binder, body } => { + collect_core_type_ids(binder.ty, module, used_types, visited_types); + collect_references(body, out, module, used_types, visited_types); } - ExprKind::Lambda { body, .. } => collect_references(body, out), ExprKind::Let { bindings, body } => { for binding in bindings { - collect_references(&binding.value, out); + collect_core_type_ids(binding.binder.ty, module, used_types, visited_types); + collect_references(&binding.value, out, module, used_types, visited_types); } - collect_references(body, out); + collect_references(body, out, module, used_types, visited_types); } ExprKind::If { condition, then_branch, else_branch, } => { - collect_references(condition, out); - collect_references(then_branch, out); - collect_references(else_branch, out); + collect_references(condition, out, module, used_types, visited_types); + collect_references(then_branch, out, module, used_types, visited_types); + collect_references(else_branch, out, module, used_types, visited_types); } ExprKind::Case { scrutinee, branches, } => { - collect_references(scrutinee, out); + collect_references(scrutinee, out, module, used_types, visited_types); for branch in branches { - collect_pattern(&branch.pattern, out); - collect_references(&branch.value, out); + collect_pattern(&branch.pattern, out, module, used_types, visited_types); + collect_references(&branch.value, out, module, used_types, visited_types); } } } } -fn collect_pattern(pattern: &crate::Pattern, out: &mut Vec) { +fn collect_pattern( + pattern: &crate::Pattern, + out: &mut Vec, + module: &Module, + used_types: &mut HashSet, + visited_types: &mut HashSet, +) { + collect_core_type_ids(pattern.ty, module, used_types, visited_types); match &pattern.kind { PatternKind::Constructor { symbol, arguments } => { out.push(*symbol); for argument in arguments { - collect_pattern(argument, out); + collect_pattern(argument, out, module, used_types, visited_types); } } PatternKind::Record { fields } => { for (_, field) in fields { - collect_pattern(field, out); + collect_pattern(field, out, module, used_types, visited_types); } } PatternKind::Array { elements } => { for element in elements { - collect_pattern(element, out); + collect_pattern(element, out, module, used_types, visited_types); } } - PatternKind::Named { pattern, .. } => collect_pattern(pattern, out), + PatternKind::Named { pattern, .. } => { + collect_pattern(pattern, out, module, used_types, visited_types) + } _ => {} } } diff --git a/crates/psrs-core/src/lower/dictionary.rs b/crates/psrs-core/src/lower/dictionary.rs index 63b6b2cc..c0900396 100644 --- a/crates/psrs-core/src/lower/dictionary.rs +++ b/crates/psrs-core/src/lower/dictionary.rs @@ -50,12 +50,11 @@ pub(super) fn lower_evidence(evidence: &Evidence, types: &[Type]) -> Result, constructors: &HashMap, source_types: &[psrs_thir::Type], + context: &mut module::LowerContext, ) -> Result { let span = expression.span; let ty = TypeId(expression.ty.0); if let Some((symbol, arguments)) = constructor_application(&expression, constructors) { let arguments = arguments .into_iter() - .map(|argument| lower_expr(argument.clone(), externals, constructors, source_types)) + .map(|argument| { + lower_expr( + argument.clone(), + externals, + constructors, + source_types, + context, + ) + }) .collect::, _>>()?; return Ok(Expr { kind: ExprKind::Constructor { symbol, arguments }, @@ -79,10 +88,14 @@ fn lower_expr( } if let Some(constructor) = constructors.get(&id) { if constructor.field_count != 0 { - return Err(LowerError { + return lower_partial_constructor( + id, + expression.ty, + constructor.field_count, span, - message: "partially applied field constructors require closure conversion", - }); + source_types, + context, + ); } ExprKind::Constructor { symbol: id, @@ -100,7 +113,7 @@ fn lower_expr( TypedExprKind::Array(elements) => ExprKind::Array { elements: elements .into_iter() - .map(|element| lower_expr(element, externals, constructors, source_types)) + .map(|element| lower_expr(element, externals, constructors, source_types, context)) .collect::, _>>()?, }, TypedExprKind::Record(fields) => ExprKind::Record { @@ -109,7 +122,7 @@ fn lower_expr( .map(|(label, value)| { Ok(( label, - lower_expr(value, externals, constructors, source_types)?, + lower_expr(value, externals, constructors, source_types, context)?, )) }) .collect::, LowerError>>()?, @@ -120,13 +133,14 @@ fn lower_expr( externals, constructors, source_types, + context, )?), fields: fields .into_iter() .map(|(label, value)| { Ok(( label, - lower_expr(value, externals, constructors, source_types)?, + lower_expr(value, externals, constructors, source_types, context)?, )) }) .collect::, LowerError>>()?, @@ -137,6 +151,7 @@ fn lower_expr( externals, constructors, source_types, + context, )?), field, }, @@ -159,14 +174,20 @@ fn lower_expr( }); } ExprKind::RepresentationCast { - value: Box::new(lower_expr(*value, externals, constructors, source_types)?), + value: Box::new(lower_expr( + *value, + externals, + constructors, + source_types, + context, + )?), source_type: TypeId(source_type.0), target_type: TypeId(target_type.0), } } TypedExprKind::Application(function, argument) => { - let function = lower_expr(*function, externals, constructors, source_types)?; - let argument = lower_expr(*argument, externals, constructors, source_types)?; + let function = lower_expr(*function, externals, constructors, source_types, context)?; + let argument = lower_expr(*argument, externals, constructors, source_types, context)?; // A saturated intrinsic application becomes one IntrinsicCall. The // registry's arity decides saturation, and the per-intrinsic // handling lives in the intrinsic module rather than here. @@ -192,7 +213,13 @@ fn lower_expr( ty: TypeId(binder.ty.0), span: binder.span, }, - body: Box::new(lower_expr(*body, externals, constructors, source_types)?), + body: Box::new(lower_expr( + *body, + externals, + constructors, + source_types, + context, + )?), }, TypedExprKind::Let { bindings, body } => ExprKind::Let { bindings: bindings @@ -206,12 +233,24 @@ fn lower_expr( span: binding.binder.span, }, quantified: binding.quantified, - value: lower_expr(binding.value, externals, constructors, source_types)?, + value: lower_expr( + binding.value, + externals, + constructors, + source_types, + context, + )?, span: binding.span, }) }) .collect::, LowerError>>()?, - body: Box::new(lower_expr(*body, externals, constructors, source_types)?), + body: Box::new(lower_expr( + *body, + externals, + constructors, + source_types, + context, + )?), }, TypedExprKind::If { condition, @@ -223,18 +262,21 @@ fn lower_expr( externals, constructors, source_types, + context, )?), then_branch: Box::new(lower_expr( *then_branch, externals, constructors, source_types, + context, )?), else_branch: Box::new(lower_expr( *else_branch, externals, constructors, source_types, + context, )?), }, TypedExprKind::Case { @@ -246,13 +288,20 @@ fn lower_expr( externals, constructors, source_types, + context, )?), branches: branches .into_iter() .map(|branch| { Ok(crate::CaseBranch { pattern: lower_pattern(branch.pattern)?, - value: lower_expr(branch.value, externals, constructors, source_types)?, + value: lower_expr( + branch.value, + externals, + constructors, + source_types, + context, + )?, span: branch.span, coverage: branch.coverage, }) @@ -263,6 +312,78 @@ fn lower_expr( Ok(Expr { kind, ty, span }) } +fn lower_partial_constructor( + symbol: SymbolId, + function_type: psrs_thir::TypeId, + field_count: usize, + span: psrs_span::TextRange, + source_types: &[psrs_thir::Type], + context: &mut module::LowerContext, +) -> Result { + let mut current_type = function_type; + let mut binders = Vec::with_capacity(field_count); + for index in 0..field_count { + let Some((parameter, result)) = arrow_parts_after_foralls(source_types, current_type) + else { + return Err(LowerError { + span, + message: "constructor type has fewer arguments than its declaration", + }); + }; + let Some(id) = context.fresh_local() else { + return Err(LowerError { + span, + message: "cannot allocate a local for a constructor function", + }); + }; + binders.push(( + Binder { + id, + name: format!("__partial_constructor_{index}"), + ty: TypeId(parameter.0), + span, + }, + TypeId(current_type.0), + )); + current_type = result; + } + + let arguments = binders + .iter() + .map(|(binder, _)| Expr { + kind: ExprKind::Local(binder.id), + ty: binder.ty, + span, + }) + .collect(); + let mut body = Expr { + kind: ExprKind::Constructor { symbol, arguments }, + ty: TypeId(current_type.0), + span, + }; + for (binder, function_type) in binders.into_iter().rev() { + body = Expr { + kind: ExprKind::Lambda { + binder, + body: Box::new(body), + }, + ty: function_type, + span, + }; + } + Ok(body) +} + +fn arrow_parts_after_foralls( + types: &[psrs_thir::Type], + mut function_type: psrs_thir::TypeId, +) -> Option<(psrs_thir::TypeId, psrs_thir::TypeId)> { + while let Some((_, body)) = psrs_thir::forall_parts(types, function_type) { + function_type = body; + } + psrs_thir::arrow_parts(types, function_type) +} + fn lower_pattern(pattern: psrs_thir::Pattern) -> Result { let span = pattern.span; let kind = match pattern.kind { diff --git a/crates/psrs-core/src/lower/module.rs b/crates/psrs-core/src/lower/module.rs index 9af7177a..d04cbe72 100644 --- a/crates/psrs-core/src/lower/module.rs +++ b/crates/psrs-core/src/lower/module.rs @@ -1,6 +1,146 @@ use crate::{Declaration, LowerError, Module, Type, TypeId}; use std::collections::HashMap; +pub(super) struct LowerContext { + next_local_id: u64, +} + +impl LowerContext { + fn new(module: &psrs_thir::Module) -> Self { + let mut max_local_id = None; + for declaration in &module.declarations { + scan_expr_locals(&declaration.value, &mut max_local_id); + } + Self { + next_local_id: max_local_id.map_or(0, |id| u64::from(id) + 1), + } + } + + pub(super) fn fresh_local(&mut self) -> Option { + let id = u32::try_from(self.next_local_id).ok()?; + self.next_local_id += 1; + Some(psrs_hir::LocalId(id)) + } +} + +fn scan_expr_locals(expression: &psrs_thir::Expr, max: &mut Option) { + let note = |id: psrs_hir::LocalId, max: &mut Option| { + *max = Some(max.map_or(id.0, |current| current.max(id.0))); + }; + match &expression.kind { + psrs_thir::ExprKind::Local(id) => note(*id, max), + psrs_thir::ExprKind::Global(_) + | psrs_thir::ExprKind::Integer(_) + | psrs_thir::ExprKind::Number(_) + | psrs_thir::ExprKind::Boolean(_) + | psrs_thir::ExprKind::String(_) + | psrs_thir::ExprKind::Char(_) => {} + psrs_thir::ExprKind::Array(elements) => { + for element in elements { + scan_expr_locals(element, max); + } + } + psrs_thir::ExprKind::Record(fields) => { + for (_, value) in fields { + scan_expr_locals(value, max); + } + } + psrs_thir::ExprKind::RecordUpdate { expression, fields } => { + scan_expr_locals(expression, max); + for (_, value) in fields { + scan_expr_locals(value, max); + } + } + psrs_thir::ExprKind::FieldAccess { expression, .. } => scan_expr_locals(expression, max), + psrs_thir::ExprKind::Evidence(evidence) => scan_evidence_locals(evidence, max), + psrs_thir::ExprKind::Coerce { + value, evidence, .. + } => { + scan_expr_locals(value, max); + scan_evidence_locals(evidence, max); + } + psrs_thir::ExprKind::Application(function, argument) => { + scan_expr_locals(function, max); + scan_expr_locals(argument, max); + } + psrs_thir::ExprKind::Lambda { binder, body } => { + note(binder.id, max); + scan_expr_locals(body, max); + } + psrs_thir::ExprKind::Let { bindings, body } => { + for binding in bindings { + note(binding.binder.id, max); + scan_expr_locals(&binding.value, max); + } + scan_expr_locals(body, max); + } + psrs_thir::ExprKind::If { + condition, + then_branch, + else_branch, + } => { + scan_expr_locals(condition, max); + scan_expr_locals(then_branch, max); + scan_expr_locals(else_branch, max); + } + psrs_thir::ExprKind::Case { + scrutinee, + branches, + } => { + scan_expr_locals(scrutinee, max); + for branch in branches { + scan_pattern_locals(&branch.pattern, max); + scan_expr_locals(&branch.value, max); + } + } + } +} + +fn scan_pattern_locals(pattern: &psrs_thir::Pattern, max: &mut Option) { + match &pattern.kind { + psrs_thir::PatternKind::Wildcard | psrs_thir::PatternKind::Literal { .. } => {} + psrs_thir::PatternKind::Array { elements } => { + for element in elements { + scan_pattern_locals(element, max); + } + } + psrs_thir::PatternKind::Named { id, pattern } => { + *max = Some(max.map_or(id.0, |current| current.max(id.0))); + scan_pattern_locals(pattern, max); + } + psrs_thir::PatternKind::Var { id, .. } => { + *max = Some(max.map_or(id.0, |current| current.max(id.0))); + } + psrs_thir::PatternKind::Constructor { arguments, .. } => { + for argument in arguments { + scan_pattern_locals(argument, max); + } + } + psrs_thir::PatternKind::Record { fields } => { + for (_, pattern) in fields { + scan_pattern_locals(pattern, max); + } + } + } +} + +fn scan_evidence_locals(evidence: &psrs_thir::Evidence, max: &mut Option) { + match &evidence.kind { + psrs_thir::EvidenceKind::Given(id) => { + *max = Some(max.map_or(id.0, |current| current.max(id.0))); + } + psrs_thir::EvidenceKind::Superclass { parent, .. } => scan_evidence_locals(parent, max), + psrs_thir::EvidenceKind::Instance { context, .. } => { + for evidence in context { + scan_evidence_locals(evidence, max); + } + } + psrs_thir::EvidenceKind::Global(_) + | psrs_thir::EvidenceKind::Coercible { .. } + | psrs_thir::EvidenceKind::Primitive { .. } => {} + } +} + fn lower_type_constructor(constructor: psrs_thir::TypeConstructor) -> crate::TypeConstructor { match constructor { psrs_thir::TypeConstructor::Function => crate::TypeConstructor::Function, @@ -40,6 +180,7 @@ pub(super) fn lower_module_inner(module: psrs_thir::Module) -> Result>(); + let mut context = LowerContext::new(&module); let source_types = module.types; let types = source_types .iter() @@ -68,8 +209,14 @@ pub(super) fn lower_module_inner(module: psrs_thir::Module) -> Result Option<(psrs_hir::TypeVariableId, TypeId)> { + let Type::Application(function, argument) = module.types.get(id.0 as usize)? else { + return None; + }; + let Type::Variable(variable) = module.types.get(function.0 as usize)? else { + return None; + }; + Some((*variable, *argument)) +} + /// Checks whether `instance` is a legal use of a declaration or local scheme. /// Every quantified variable receives one consistent replacement for the full /// type, while nested `ForAll` binders remain rigid where the type is consumed. @@ -246,6 +256,11 @@ impl TypeMatcher<'_> { return result; } + if let Some(result) = self.subsumes_callable_application(actual, expected, instantiate) { + self.active.remove(&(actual, expected)); + return result; + } + if let Some(result) = self.subsumes_closure(actual, expected, instantiate) { self.active.remove(&(actual, expected)); return result; @@ -344,6 +359,74 @@ impl TypeMatcher<'_> { true } + /// A trusted callable type constructor application is lowered to a + /// closure type at P8. When a polymorphic class method is instantiated + /// through such a constructor, relate `f a` to `Closure(params, a)` while + /// retaining the constructor identity for other occurrences of `f`. + fn subsumes_callable_application( + &mut self, + actual: TypeId, + expected: TypeId, + instantiate: bool, + ) -> Option { + let actual_application = applied_variable(actual, self.module); + let expected_application = applied_variable(expected, self.module); + let actual_closure = crate::closure_parts(&self.module.types, actual) + .map(|(parameters, result)| (parameters.len(), result)); + let expected_closure = crate::closure_parts(&self.module.types, expected) + .map(|(parameters, result)| (parameters.len(), result)); + let (variable, argument, result, actual_is_application, arity) = match ( + actual_application, + expected_application, + actual_closure, + expected_closure, + ) { + (Some((variable, argument)), None, _, Some((arity, result))) => { + (variable, argument, result, true, arity) + } + (None, Some((variable, argument)), Some((arity, result)), _) => { + (variable, argument, result, false, arity) + } + _ => return None, + }; + + if !self.flexible.contains(&variable) { + return Some(false); + } + let mut callable_ids = + self.module + .callable_types + .iter() + .filter_map(|(id, hidden_parameters)| { + (*hidden_parameters as usize == arity).then_some(*id) + }); + let Some(callable_id) = callable_ids.next() else { + return Some(false); + }; + if callable_ids.next().is_some() { + return Some(false); + } + let Some((constructor_index, _)) = self + .module + .types + .iter() + .enumerate() + .find(|(_, ty)| { + matches!(ty, Type::Constructor(TypeConstructor::User(id)) if *id == callable_id) + }) + else { + return Some(false); + }; + if !self.bind_flexible(variable, TypeId(constructor_index as u32)) { + return Some(false); + } + Some(if actual_is_application { + self.subsumes(argument, result, instantiate) + } else { + self.subsumes(result, argument, instantiate) + }) + } + fn subsumes_record(&mut self, actual: TypeId, expected: TypeId) -> bool { self.relate_records(actual, expected, true) } diff --git a/crates/psrs-cst/src/declaration.rs b/crates/psrs-cst/src/declaration.rs index b58f73cc..8afc6b35 100644 --- a/crates/psrs-cst/src/declaration.rs +++ b/crates/psrs-cst/src/declaration.rs @@ -250,5 +250,7 @@ pub struct PatternDeclaration { pub pattern: Pattern, pub equals_span: TextRange, pub value: Expr, + /// Bindings in scope for `value`, as in `pattern = expr where ...`. + pub where_block: Option, pub span: TextRange, } diff --git a/crates/psrs-cst/src/expr.rs b/crates/psrs-cst/src/expr.rs index 6b882ae9..6fb047c0 100644 --- a/crates/psrs-cst/src/expr.rs +++ b/crates/psrs-cst/src/expr.rs @@ -48,6 +48,10 @@ pub enum ExprKind { dot_span: TextRange, field: CstName, }, + RecordAccessor { + marker_span: TextRange, + fields: Vec, + }, Operator { operator: CstName, left: Box, @@ -112,6 +116,12 @@ pub enum ExprKind { }, } +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct RecordAccessorField { + pub dot_span: TextRange, + pub field: CstName, +} + #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub enum OperatorSectionSide { /// The section supplies the left operand: `(expression operator _)`. diff --git a/crates/psrs-desugar/src/fixity.rs b/crates/psrs-desugar/src/fixity.rs index 0e233294..78136928 100644 --- a/crates/psrs-desugar/src/fixity.rs +++ b/crates/psrs-desugar/src/fixity.rs @@ -350,15 +350,25 @@ fn reduce(values: &mut Vec, operators: &mut Vec) { let right = values.pop().expect("operator has a right operand"); let left = values.pop().expect("operator has a left operand"); let span = TextRange::new(left.span.start, right.span.end); - values.push(Expr { - kind: ExprKind::Operator { + let kind = if let Some(local) = operator.local { + let function = Expr { + kind: ExprKind::Local(local), + span: operator.operator_span, + }; + let partial = Expr { + kind: ExprKind::Application(Box::new(function), Box::new(left)), + span, + }; + ExprKind::Application(Box::new(partial), Box::new(right)) + } else { + ExprKind::Operator { operator: operator.symbol, operator_span: operator.operator_span, left: Box::new(left), right: Box::new(right), - }, - span, - }); + } + }; + values.push(Expr { kind, span }); } pub(super) fn reassociate_pattern( diff --git a/crates/psrs-desugar/src/lib.rs b/crates/psrs-desugar/src/lib.rs index 31f93252..d3323c27 100644 --- a/crates/psrs-desugar/src/lib.rs +++ b/crates/psrs-desugar/src/lib.rs @@ -158,7 +158,10 @@ fn desugar_expr(expression: Expr) -> Expr { span: binder.span, }; let function = Expr { - kind: ExprKind::Global(operator.symbol), + kind: match operator.local { + Some(local) => ExprKind::Local(local), + None => ExprKind::Global(operator.symbol), + }, span: operator.operator_span, }; let (left, right) = match side { diff --git a/crates/psrs-driver/src/prelude.rs b/crates/psrs-driver/src/prelude.rs index b3ceed55..74c3d947 100644 --- a/crates/psrs-driver/src/prelude.rs +++ b/crates/psrs-driver/src/prelude.rs @@ -6,6 +6,7 @@ //! depend on the process current directory. use std::collections::HashSet; +use std::collections::VecDeque; use std::path::{Path, PathBuf}; use std::sync::OnceLock; @@ -16,6 +17,7 @@ pub(crate) struct ModuleSource { pub path: String, pub module_name: String, pub text: String, + imports: Vec, } struct Library { @@ -33,14 +35,41 @@ pub(crate) fn module_names() -> Result, String> { .collect()) } -/// Prepends the trusted standard-library modules to `sources`. +/// Prepends the trusted standard-library modules reachable from `sources`. pub(crate) fn prepend<'a>( user_sources: &[(&'a str, &'a str)], ) -> Result, String> { let library = sources()?; - let trusted_prefix = library.len(); + let by_name = library + .iter() + .enumerate() + .map(|(index, module)| (module.module_name.as_str(), index)) + .collect::>(); + let mut needed = HashSet::new(); + let mut pending = VecDeque::new(); + for (name, text) in user_sources { + if let Ok(parsed) = crate::lower_source_to_ast(name, text) { + pending.extend(parsed.imports.into_iter().map(|import| import.module.text)); + } + } + while let Some(name) = pending.pop_front() { + let Some(&index) = by_name.get(name.as_str()) else { + continue; + }; + if needed.insert(index) { + pending.extend(library[index].imports.iter().cloned()); + } + } + + let selected = library + .iter() + .enumerate() + .filter(|(index, _)| needed.contains(index)) + .map(|(_, module)| module) + .collect::>(); + let trusted_prefix = selected.len(); let mut all = Vec::with_capacity(trusted_prefix + user_sources.len()); - for module in library { + for module in selected { all.push((module.path.as_str(), module.text.as_str())); } all.extend_from_slice(user_sources); @@ -71,7 +100,10 @@ fn read_library() -> Result { .first() .map(|error| error.message.as_str()) .unwrap_or("could not parse the standard-library module"); - format!("{display}: {message}") + format!( + "{display}:{}: {message}", + errors.first().map(|error| error.span.start).unwrap_or(0) + ) })?; if parsed.name.text != name { return Err(format!( @@ -83,6 +115,11 @@ fn read_library() -> Result { path: display, module_name: name, text, + imports: parsed + .imports + .into_iter() + .map(|import| import.module.text) + .collect(), }); } Ok(Library { modules }) diff --git a/crates/psrs-driver/src/program/effects.rs b/crates/psrs-driver/src/program/effects.rs index 5bc52a47..a2ebdc59 100644 --- a/crates/psrs-driver/src/program/effects.rs +++ b/crates/psrs-driver/src/program/effects.rs @@ -113,8 +113,8 @@ pub(super) fn trusted_effect( }; let mut operations = Vec::new(); for (name, operation, wit_name) in [ - ("pure", EffectOperation::Pure, "pure"), - ("bind", EffectOperation::Bind, "bind"), + ("effectPure", EffectOperation::Pure, "pure"), + ("effectBind", EffectOperation::Bind, "bind"), ("runEffect", EffectOperation::Run, "run"), ("trap", EffectOperation::Trap, "trap"), ] { @@ -275,7 +275,7 @@ fn collect_runner_references(expression: &Expr, runner: SymbolId, spans: &mut Ve operators, } => { for operator in operators { - if operator.symbol == runner { + if operator.local.is_none() && operator.symbol == runner { spans.push(operator.operator_span); } } diff --git a/crates/psrs-driver/src/tests/data_tuple.rs b/crates/psrs-driver/src/tests/data_tuple.rs index f19e3e88..a0b04a17 100644 --- a/crates/psrs-driver/src/tests/data_tuple.rs +++ b/crates/psrs-driver/src/tests/data_tuple.rs @@ -1,46 +1,54 @@ -//! The library's `Data.Tuple` surface. -//! -//! `Tuple a b` is the closed record `{ _1 :: a, _2 :: b }` that FE-06 already -//! lowers a tuple to, not an algebraic product. These tests check that the -//! synonym, the tuple syntax, and a record literal are one value, and that the -//! projection functions execute under Wasmtime. +//! Library tuples and native tuple syntax keep their distinct representations. use super::*; +const DATA_TUPLE: &str = include_str!("../../../../stdlib/lib/Data/Tuple.purs"); + +#[test] +fn library_tuple_constructor_and_helpers_execute() { + let main = r#" +module Main where + +import Data.Tuple (Tuple(..), curry, fst, snd, swap, uncurry) + +pair :: Tuple Int Int +pair = Tuple 40 2 + +main = if intEq (uncurry (\left right -> intAdd left right) pair) 42 + then if intEq (fst (swap pair)) 2 + then if intEq (snd (swap pair)) 40 + then if intEq (curry (\tuple -> intAdd (fst tuple) (snd tuple)) 20 22) 42 then 0 else 1 + else 1 + else 1 + else 1 +"#; + let sources = [("Data.Tuple.purs", DATA_TUPLE), ("Main.purs", main)]; + let Some(output) = run_program_with_wasmtime(&sources) else { + eprintln!("skipping execution: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); +} + #[test] -fn a_tuple_is_the_closed_record_and_executes_under_wasmtime() { - let source = r#" +fn native_tuple_syntax_still_has_the_closed_record_representation() { + let main = r#" module Main where -import Prelude -import Data.Tuple (Tuple, curry, fst, snd, swap, uncurry) +type Pair = { _1 :: Int, _2 :: Int } -fromSyntax :: Tuple Int Int +fromSyntax :: Pair fromSyntax = (40, 2) -fromRecord :: Tuple Int Int +fromRecord :: Pair fromRecord = { _1: 40, _2: 2 } -passed :: Boolean -> Int -passed flag = if flag then 1 else 0 - -main :: Int -main = - passed (uncurry (\a b -> a + b) fromSyntax == 42) - + passed (uncurry (\a b -> a + b) fromRecord == 42) - + passed (fst fromSyntax == 40) - + passed (snd fromRecord == 2) - + passed (fst (swap fromSyntax) == 2) - + passed (snd (swap fromRecord) == 40) - + passed (curry (\pair -> fst pair + snd pair) 20 22 == 42) +main = 0 "#; - let Some(output) = run_with_wasmtime(source) else { - eprintln!("skipping: wasmtime is not installed"); + let sources = [("Data.Tuple.purs", DATA_TUPLE), ("Main.purs", main)]; + let Some(output) = run_program_with_wasmtime(&sources) else { + eprintln!("skipping execution: wasmtime is not installed"); return; }; - assert_eq!( - output.status.code(), - Some(7), - "tuple syntax and the record form must be the same value: {output:?}" - ); + assert_eq!(output.status.code(), Some(0), "{output:?}"); } diff --git a/crates/psrs-driver/src/tests/effect_arity.rs b/crates/psrs-driver/src/tests/effect_arity.rs index 88480fbf..bc2b3af8 100644 --- a/crates/psrs-driver/src/tests/effect_arity.rs +++ b/crates/psrs-driver/src/tests/effect_arity.rs @@ -29,12 +29,12 @@ fn an_effect_of_a_function_is_not_arity_two_and_log_is_saturated() { "Effect Int is a one-parameter closure" ); assert_eq!( - function("pure").parameters.len(), + function("effectPure").parameters.len(), 1, "pure takes the value and returns the token closure" ); assert_eq!( - function("bind").parameters.len(), + function("effectBind").parameters.len(), 2, "bind takes the effect and the continuation; the token belongs to the result" ); diff --git a/crates/psrs-driver/src/tests/module_loader.rs b/crates/psrs-driver/src/tests/module_loader.rs index 0a814c27..79ae6db4 100644 --- a/crates/psrs-driver/src/tests/module_loader.rs +++ b/crates/psrs-driver/src/tests/module_loader.rs @@ -97,66 +97,21 @@ fn loads_the_standard_library_from_disk_in_trusted_order() { .iter() .map(|module| module.module_name.as_str()) .collect::>(); + assert_eq!(names.first().copied(), Some("Prelude")); + assert!(names.iter().any(|name| *name == "WASI")); assert_eq!( - names, - [ - "Prelude", - "Data.Function", - "Data.Semigroup", - "Data.Monoid", - "Data.Eq", - "Data.Ord", - "Data.Semiring", - "Data.Show", - "Effect", - "Effect.Console", - "Test.Assert", - "Data.Maybe", - "Data.Either", - "Data.Functor", - "Data.Tuple", - "Data.Foldable", - "WASI.Resource", - "WASI.IO", - "WASI.Clock", - "WASI.Random", - "WASI.Console", - "WASI.Process", - "WASI.FileSystem", - "WASI.Network", - "WASI" - ] + names.len(), + names.iter().collect::>().len(), + "trusted module names are unique: {names:?}" ); for module in modules { let path = std::path::Path::new(&module.path); + let relative = module.module_name.replace('.', "/") + ".purs"; assert!( - path.ends_with("lib/Prelude.purs") - || path.ends_with("lib/Data/Function.purs") - || path.ends_with("lib/Data/Semigroup.purs") - || path.ends_with("lib/Data/Monoid.purs") - || path.ends_with("lib/Data/Eq.purs") - || path.ends_with("lib/Data/Ord.purs") - || path.ends_with("lib/Data/Semiring.purs") - || path.ends_with("lib/Data/Show.purs") - || path.ends_with("lib/Effect.purs") - || path.ends_with("lib/Effect/Console.purs") - || path.ends_with("lib/Test/Assert.purs") - || path.ends_with("lib/Data/Maybe.purs") - || path.ends_with("lib/Data/Either.purs") - || path.ends_with("lib/Data/Functor.purs") - || path.ends_with("lib/Data/Tuple.purs") - || path.ends_with("lib/Data/Foldable.purs") - || path.ends_with("lib/WASI/Resource.purs") - || path.ends_with("lib/WASI/IO.purs") - || path.ends_with("lib/WASI/Clock.purs") - || path.ends_with("lib/WASI/Random.purs") - || path.ends_with("lib/WASI/Console.purs") - || path.ends_with("lib/WASI/Process.purs") - || path.ends_with("lib/WASI/FileSystem.purs") - || path.ends_with("lib/WASI/Network.purs") - || path.ends_with("lib/WASI.purs"), - "{}", - module.path + path.ends_with(format!("lib/{relative}")), + "{} should be the file for {}", + module.path, + module.module_name ); let on_disk = std::fs::read_to_string(path).expect("the standard-library file should exist"); @@ -169,6 +124,34 @@ fn loads_the_standard_library_from_disk_in_trusted_order() { .expect("the on-disk standard library should typecheck with a user module"); } +#[test] +fn resolves_the_standard_library_closure_imported_by_a_wasi_program() { + let source = "module Main where\nimport Prelude\nimport WASI.Console\nimport WASI.Clock\nmain = let stamp = runEffect now in let action = runEffect (log \"ok\") in stamp\n"; + let (sources, trusted_prefix) = crate::prelude::prepend(&[("Main.purs", source)]) + .expect("the standard library should load from disk"); + assert!(trusted_prefix > 0); + crate::resolve_program_sources(&sources) + .expect("the imported standard library closure should resolve"); +} + +#[test] +fn lowers_parenthesized_kinded_class_parameters_as_binders() { + let module = crate::lower_source_to_ast( + "KindedClass.purs", + "module KindedClass where\nclass IsSymbol (sym :: Symbol) where\n reflect :: Proxy sym -> String\n", + ) + .expect("the kinded class should parse and lower"); + let psrs_ast::TypeDeclaration::Class(class) = &module.type_declarations[0] else { + panic!("expected a class declaration"); + }; + assert_eq!(class.parameters.len(), 1); + assert_eq!(class.parameters[0].name.text, "sym"); + assert!(matches!( + class.parameters[0].kind.as_ref().map(|kind| &kind.kind), + Some(psrs_ast::TypeKind::Name(name)) if name.text == "Symbol" + )); +} + #[test] fn does_not_discover_a_user_module_shadowing_the_standard_library() { let directory = temp_directory("stdlib-shadow"); diff --git a/crates/psrs-driver/src/tests/records.rs b/crates/psrs-driver/src/tests/records.rs index d2624334..28fb0e00 100644 --- a/crates/psrs-driver/src/tests/records.rs +++ b/crates/psrs-driver/src/tests/records.rs @@ -52,6 +52,16 @@ fn runs_a_record_field_access_through_a_gc_struct() { assert_eq!(output.status.code(), Some(42)); } +#[test] +fn anonymous_record_accessor_projects_nested_fields() { + let source = "module Main where\nproject :: { inner :: { value :: Int } } -> Int\nproject = _.inner.value\nmain = if intEq (project { inner: { value: 42 } }) 42 then 0 else 1\n"; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + eprintln!("skipping execution: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); +} + #[test] fn evaluates_record_fields_in_source_order_before_canonical_layout() { let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let record = { z: runEffect (log \"z\"), a: runEffect (log \"a\") } in 0\n"; diff --git a/crates/psrs-driver/src/tests/scalars.rs b/crates/psrs-driver/src/tests/scalars.rs index 151d5f87..30e6db8c 100644 --- a/crates/psrs-driver/src/tests/scalars.rs +++ b/crates/psrs-driver/src/tests/scalars.rs @@ -108,6 +108,27 @@ fn scalar_intrinsics_are_reachable_from_source_and_execute_with_documented_seman ); } +#[test] +fn data_int_bits_uses_the_integer_bitwise_intrinsics() { + let main = r#" +module Main where +import Data.Int.Bits ((.&.)) +main = if intEq (6 .&. 3) 2 then 0 else 1 +"#; + let sources = [ + ( + "Data.Int.Bits.purs", + include_str!("../../../../stdlib/lib/Data/Int/Bits.purs"), + ), + ("Main.purs", main), + ]; + let Some(output) = super::run_program_with_wasmtime(&sources) else { + eprintln!("skipping execution: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); +} + const CASE_HELPER_SOURCE: &str = "\ module Main where diff --git a/crates/psrs-driver/src/tests/wasi/classes/mod.rs b/crates/psrs-driver/src/tests/wasi/classes/mod.rs index 59a214b8..1a98e3e9 100644 --- a/crates/psrs-driver/src/tests/wasi/classes/mod.rs +++ b/crates/psrs-driver/src/tests/wasi/classes/mod.rs @@ -396,6 +396,20 @@ fn an_ambiguous_instance_context_variable_is_reported() { ); } +#[test] +fn instance_context_variables_determined_by_functional_dependencies_are_accepted() { + let source = r#" +module Main where + +class KeyValue key value | key -> value +class Container key + +instance containerKeyValue :: KeyValue key value => Container key +"#; + crate::typecheck_program_sources(&[("Main.purs", source)]) + .expect("the instance head determines `value` through KeyValue's functional dependency"); +} + const CLASS_DEFAULT_SOURCE: &str = r#" module Main where diff --git a/crates/psrs-hir/src/expr.rs b/crates/psrs-hir/src/expr.rs index fb7218d6..129841a4 100644 --- a/crates/psrs-hir/src/expr.rs +++ b/crates/psrs-hir/src/expr.rs @@ -111,6 +111,10 @@ pub enum ExprKind { #[derive(Clone, Debug, PartialEq, Eq)] pub struct ResolvedOperator { pub symbol: SymbolId, + /// A backticked value in scope, such as `` `f` ``. The CST grammar binds + /// that form tighter than every symbolic operator. `symbol` is unused + /// when this is set. + pub local: Option, pub operator_span: TextRange, pub associativity: Associativity, pub precedence: u32, diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index a252cfa5..597838a7 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -46,10 +46,9 @@ pub enum IntrinsicCategory { pub struct IntrinsicDescriptor { pub intrinsic: Intrinsic, /// The name `resolve` binds for this intrinsic. It is the compiler-internal - /// primitive name; a surface operator spelling and its fixity belong to the - /// library. Until the library classes land, the `Int` operators are still - /// bound directly here (see the implementation notes in - /// `docs/design/D-15-compiler-builtins.md`). + /// primitive name. Surface operator spellings and their fixities belong to + /// the library (`Data.Ring` owns `-`, `Data.EuclideanRing` owns `/`). + /// `%` is still the truncating remainder primitive. pub name: &'static str, /// The number of arguments a saturated call supplies: the leading-arrow /// count of `scheme`. @@ -85,9 +84,9 @@ descriptors! { BoolTrue => "true", 0, Nullary, scheme::boolean; BoolFalse => "false", 0, Nullary, scheme::boolean; I32Add => "intAdd", 2, BinaryScalar, scheme::int_int_int; - I32Sub => "-", 2, BinaryScalar, scheme::int_int_int; + I32Sub => "intSub", 2, BinaryScalar, scheme::int_int_int; I32Mul => "intMul", 2, BinaryScalar, scheme::int_int_int; - I32DivS => "/", 2, BinaryScalar, scheme::int_int_int; + I32DivS => "intQuot", 2, BinaryScalar, scheme::int_int_int; I32RemS => "%", 2, BinaryScalar, scheme::int_int_int; I32Eq => "intEq", 2, BinaryScalar, scheme::int_int_bool; I32Ne => "intNe", 2, BinaryScalar, scheme::int_int_bool; diff --git a/crates/psrs-hir/src/module.rs b/crates/psrs-hir/src/module.rs index 29706a7d..cd4d78ca 100644 --- a/crates/psrs-hir/src/module.rs +++ b/crates/psrs-hir/src/module.rs @@ -25,6 +25,9 @@ pub struct ImportedType { /// Importers must keep that nominal identity; the declaring module is not /// consulted again when a signature mentions the type. pub opaque: bool, + /// Data constructors brought in with this type. A `module` re-export + /// publishes these, so `Ordering(..)` stays available through `Data.Ord`. + pub constructors: Vec<(String, SymbolId)>, } /// A resolved import declaration. The imported module is identified by ID and diff --git a/crates/psrs-hir/src/verify/mod.rs b/crates/psrs-hir/src/verify/mod.rs index 936608bb..c2a8a708 100644 --- a/crates/psrs-hir/src/verify/mod.rs +++ b/crates/psrs-hir/src/verify/mod.rs @@ -93,7 +93,14 @@ pub(crate) fn verify_expr( }); } for operator in operators { - if !globals.contains(&operator.symbol) { + if let Some(local) = operator.local { + if !visible_locals.contains(&local) { + errors.push(VerifyError { + span: operator.operator_span, + message: "backticked operator is not in scope", + }); + } + } else if !globals.contains(&operator.symbol) { errors.push(VerifyError { span: operator.operator_span, message: "operator symbol is not declared in the module or intrinsic set", @@ -110,7 +117,14 @@ pub(crate) fn verify_expr( binder, .. } => { - if !globals.contains(&operator.symbol) { + if let Some(local) = operator.local { + if !visible_locals.contains(&local) { + errors.push(VerifyError { + span: operator.operator_span, + message: "backticked operator is not in scope", + }); + } + } else if !globals.contains(&operator.symbol) { errors.push(VerifyError { span: operator.operator_span, message: "operator symbol is not declared in the module or intrinsic set", diff --git a/crates/psrs-resolve/src/resolver/exports/mod.rs b/crates/psrs-resolve/src/resolver/exports/mod.rs index 47ab9bcd..965c5445 100644 --- a/crates/psrs-resolve/src/resolver/exports/mod.rs +++ b/crates/psrs-resolve/src/resolver/exports/mod.rs @@ -1,5 +1,6 @@ use super::ResolveErrorKind; use super::names::Resolver; +use super::names::builtin_type; use psrs_ast as ast; use psrs_hir::{ self as hir, ExportedInstance, ExportedOperator, ExportedSymbol, ExportedType, @@ -284,83 +285,89 @@ impl Resolver { }) .cloned() .collect(); - let [import] = matches.as_slice() else { - if matches.is_empty() { - self.report( - ResolveErrorKind::UnknownExport, - name.text.clone(), - name.span, - ); - } else { - // More than one import provides the qualifier. - self.report_conflict(name.text.clone(), name.span); - } - return; - }; - let pseudo = import.alias.is_some(); - for symbol in &import.symbols { - if import.fixities.iter().any(|fixity| { - fixity.namespace == hir::FixityNamespace::Value - && fixity.operator == symbol.external_name - }) { - continue; - } - // A real (unaliased) import re-exports names from unqualified - // scope, so an ambiguous name is a scope conflict. - if !pseudo - && self - .unqualified - .get(&symbol.external_name) - .is_some_and(|symbols| symbols.iter().any(|other| *other != symbol.symbol)) - { - self.report_conflict(symbol.external_name.clone(), name.span); - continue; - } - self.add_value( - &mut exports.values, - &mut exports.value_sources, - symbol.symbol, - symbol.external_name.clone(), + if matches.is_empty() { + self.report( + ResolveErrorKind::UnknownExport, + name.text.clone(), name.span, ); + return; } - for fixity in &import.fixities { - match fixity.target { - hir::FixityTarget::Value(symbol) => self.add_operator( - &mut exports.operators, + // A shared import alias (for example the standard library's + // `as Exports`) denotes the union of those modules' exports. + for import in &matches { + let pseudo = import.alias.is_some(); + for symbol in &import.symbols { + if import.fixities.iter().any(|fixity| { + fixity.namespace == hir::FixityNamespace::Value + && fixity.operator == symbol.external_name + }) { + continue; + } + // A real (unaliased) import re-exports names from unqualified + // scope, so an ambiguous name is a scope conflict. + if !pseudo + && self + .unqualified + .get(&symbol.external_name) + .is_some_and(|symbols| symbols.iter().any(|other| *other != symbol.symbol)) + { + self.report_conflict(symbol.external_name.clone(), name.span); + continue; + } + self.add_value( + &mut exports.values, &mut exports.value_sources, - symbol, - fixity.operator.clone(), - fixity.target_name.clone(), + symbol.symbol, + symbol.external_name.clone(), name.span, - ), - hir::FixityTarget::Type(reference) => self.add_type_operator( - &mut exports.type_operators, - &mut exports.type_sources, - reference, - fixity.operator.clone(), - fixity.target_name.clone(), - name.span, - ), + ); } - } - for imported in &import.types { - if import.fixities.iter().any(|fixity| { - fixity.namespace == hir::FixityNamespace::Type && fixity.operator == imported.name - }) { - continue; + for fixity in &import.fixities { + match fixity.target { + hir::FixityTarget::Value(symbol) => self.add_operator( + &mut exports.operators, + &mut exports.value_sources, + symbol, + fixity.operator.clone(), + fixity.target_name.clone(), + name.span, + ), + hir::FixityTarget::Type(reference) => self.add_type_operator( + &mut exports.type_operators, + &mut exports.type_sources, + reference, + fixity.operator.clone(), + fixity.target_name.clone(), + name.span, + ), + } + } + for imported in &import.types { + if import.fixities.iter().any(|fixity| { + fixity.namespace == hir::FixityNamespace::Type + && fixity.operator == imported.name + }) { + continue; + } + self.add_type( + exports, + TypeExportRequest { + reference: imported.reference, + name: imported.name.clone(), + name_span: name.span, + is_class: false, + constructors: (!imported.constructors.is_empty()).then(|| { + imported + .constructors + .iter() + .map(|(_, symbol)| *symbol) + .collect() + }), + opaque: imported.opaque, + }, + ); } - self.add_type( - exports, - TypeExportRequest { - reference: imported.reference, - name: imported.name.clone(), - name_span: name.span, - is_class: false, - constructors: None, - opaque: imported.opaque, - }, - ); } } @@ -381,6 +388,10 @@ impl Resolver { .collect(), ); } + // `Format()` exports the type and none of its constructors. + if members.names.is_empty() { + return Some(Vec::new()); + } let mut symbols = Vec::new(); for member in &members.names { match declaration @@ -436,8 +447,15 @@ impl Resolver { if let Some(id) = self.type_names.get(name) { return Some(TypeReference::Named(*id)); } - self.imported_types + if let Some(reference) = self + .imported_types .get(name) .and_then(|references| references.first().copied()) + { + return Some(reference); + } + // `Unit` is a compiler builtin with no local declaration. `Data.Unit` + // re-exports that builtin so `import Data.Unit (Unit)` is the same type. + builtin_type(name).map(TypeReference::Builtin) } } diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index d23bdc74..07682e65 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -370,7 +370,7 @@ impl Resolver { .collect() } - fn lookup_local(&self, name: &str) -> Option<&LocalBinder> { + pub(super) fn lookup_local(&self, name: &str) -> Option<&LocalBinder> { self.scopes.iter().rev().find_map(|scope| scope.get(name)) } @@ -465,4 +465,6 @@ fn ast_expr_is_guarded(expression: &ast::Expr) -> bool { } } -pub(super) use util::{PRIM_TYPES, builtin_type, is_uppercase, prim_type, split_qualified}; +pub(super) use util::{ + PRIM_TYPES, builtin_type, implicit_prim_class, is_uppercase, prim_type, split_qualified, +}; diff --git a/crates/psrs-resolve/src/resolver/names/util.rs b/crates/psrs-resolve/src/resolver/names/util.rs index f680d2bd..c9514f88 100644 --- a/crates/psrs-resolve/src/resolver/names/util.rs +++ b/crates/psrs-resolve/src/resolver/names/util.rs @@ -1,4 +1,4 @@ -use psrs_hir::BuiltinType; +use psrs_hir::{BuiltinType, TypeReference}; pub(in crate::resolver) const PRIM_TYPES: [(&str, BuiltinType); 12] = [ ("Array", BuiltinType::Array), @@ -19,10 +19,21 @@ pub(in crate::resolver) fn split_qualified(text: &str) -> Option<(&str, &str)> { if let Some(index) = text.rfind(".(") && text.ends_with(')') { - return Some((&text[..index], &text[index + 2..text.len() - 1])); + let qualifier = &text[..index]; + return is_module_qualifier(qualifier) + .then_some((qualifier, &text[index + 2..text.len() - 1])); } let index = text.rfind('.')?; - Some((&text[..index], &text[index + 1..])) + let qualifier = &text[..index]; + let member = &text[index + 1..]; + (is_module_qualifier(qualifier) && !member.is_empty()).then_some((qualifier, member)) +} + +fn is_module_qualifier(qualifier: &str) -> bool { + !qualifier.is_empty() + && qualifier + .split('.') + .all(|part| part.chars().next().is_some_and(char::is_uppercase)) } pub(in crate::resolver) fn is_uppercase(name: &str) -> bool { @@ -50,8 +61,35 @@ pub(in crate::resolver) fn builtin_type(name: &str) -> Option { }) } +/// `Partial` lives in `Prim` and is in scope in every module, the same way +/// `Int` is. Source does not import it. +pub(in crate::resolver) fn implicit_prim_class(name: &str) -> Option { + psrs_hir::primitive_type_declarations() + .into_iter() + .find(|(owner, declaration)| *owner == "Prim" && declaration.name == name) + .map(|(_, declaration)| TypeReference::Named(declaration.id)) +} + pub(in crate::resolver) fn prim_type(name: &str) -> Option { PRIM_TYPES .iter() .find_map(|(prim_name, builtin)| (*prim_name == name).then_some(*builtin)) } + +#[cfg(test)] +mod tests { + use super::split_qualified; + + #[test] + fn symbolic_operator_names_are_not_split_as_qualified_names() { + assert_eq!(split_qualified(".&."), None); + assert_eq!( + split_qualified("Data.Int.Bits.and"), + Some(("Data.Int.Bits", "and")) + ); + assert_eq!( + split_qualified("Data.Int.Bits.(.&.)"), + Some(("Data.Int.Bits", ".&.")) + ); + } +} diff --git a/crates/psrs-resolve/src/resolver/operators.rs b/crates/psrs-resolve/src/resolver/operators.rs index 701aebcc..141891de 100644 --- a/crates/psrs-resolve/src/resolver/operators.rs +++ b/crates/psrs-resolve/src/resolver/operators.rs @@ -1,6 +1,6 @@ use super::names::Resolver; use psrs_ast as ast; -use psrs_hir::{self as hir, Associativity, ExprKind, ResolvedOperator}; +use psrs_hir::{self as hir, Associativity, ExprKind, LocalId, ModuleId, ResolvedOperator, SymbolId}; use std::collections::HashMap; pub(super) fn merge_fixities( @@ -48,7 +48,7 @@ impl Resolver { .collect::>>()?; let operators = operators .into_iter() - .map(|operator| self.resolve_operator(&operator.name.text, operator.span)) + .map(|operator| self.resolve_chain_operator(&operator.name.text, operator.span)) .collect::>>()?; Some(ExprKind::OperatorChain { operands, @@ -63,7 +63,7 @@ impl Resolver { side: ast::SectionSide, span: psrs_span::TextRange, ) -> Option { - let operator = self.resolve_operator(&operator.text, operator.span)?; + let operator = self.resolve_chain_operator(&operator.text, operator.span)?; let operand = self.resolve_expr(operand)?; let binder = self.new_local(format!("__psrs_section_{}", span.start), span); Some(ExprKind::OperatorSection { @@ -83,17 +83,51 @@ impl Resolver { span: psrs_span::TextRange, ) -> Option { let symbol = self.lookup_global(name, span)?; + Some(self.global_operator(name, symbol, span)) + } + + /// A backticked identifier is the value itself, not a fixity declaration. + /// A name in scope wins. Otherwise the operator is the global of that name. + fn resolve_chain_operator( + &mut self, + name: &str, + span: psrs_span::TextRange, + ) -> Option { + if let Some(local) = self.lookup_local(name).map(|binder| binder.id) { + return Some(local_operator(local, span)); + } + self.resolve_operator(name, span) + } + + fn global_operator( + &self, + name: &str, + symbol: SymbolId, + span: psrs_span::TextRange, + ) -> ResolvedOperator { let (associativity, precedence) = self .fixities .get(name) .map(|fixity| (fixity.associativity, fixity.precedence)) .unwrap_or_else(|| default_fixity(name)); - Some(ResolvedOperator { + ResolvedOperator { symbol, + local: None, operator_span: span, associativity, precedence, - }) + } + } +} + +/// Backticked values sit above the symbolic operator table, left-associative. +fn local_operator(local: LocalId, span: psrs_span::TextRange) -> ResolvedOperator { + ResolvedOperator { + symbol: SymbolId::new(ModuleId::INTRINSICS, u32::MAX), + local: Some(local), + operator_span: span, + associativity: Associativity::Left, + precedence: 10, } } diff --git a/crates/psrs-resolve/src/resolver/program/interface.rs b/crates/psrs-resolve/src/resolver/program/interface.rs index f8bcf093..74c57ef6 100644 --- a/crates/psrs-resolve/src/resolver/program/interface.rs +++ b/crates/psrs-resolve/src/resolver/program/interface.rs @@ -143,6 +143,28 @@ impl Interface { class_members.insert(exported.name.clone(), members); } } + for exported in &exports.types { + let TypeReference::Named(id) = exported.reference else { + continue; + }; + if declarations.contains_key(&id) { + continue; + } + let Some(symbols) = &exported.constructors else { + continue; + }; + let mut members = Vec::new(); + for symbol in symbols { + let Some(value) = + exports.values.iter().find(|value| value.symbol == *symbol) + else { + continue; + }; + values.entry(value.name.clone()).or_insert(*symbol); + members.push((value.name.clone(), *symbol)); + } + constructors.insert(exported.name.clone(), members); + } for operator in &exports.type_operators { types.insert(operator.name.clone(), operator.reference); if let Some(fixity) = find_fixity(module, &operator.name) { diff --git a/crates/psrs-resolve/src/resolver/program/mod.rs b/crates/psrs-resolve/src/resolver/program/mod.rs index 3f855302..8d92a05f 100644 --- a/crates/psrs-resolve/src/resolver/program/mod.rs +++ b/crates/psrs-resolve/src/resolver/program/mod.rs @@ -254,12 +254,18 @@ fn build_import( symbols.push(imported(*symbol, name, name, import.span)); } for (name, reference) in &interface.types { - types.push(imported_type( + let mut imported = imported_type( *reference, name, import.span, reference_is_opaque(interface, *reference), - )); + ); + imported.constructors = interface + .constructors + .get(name) + .cloned() + .unwrap_or_default(); + types.push(imported); } } Some(list) if list.hiding => { @@ -287,12 +293,18 @@ fn build_import( } for (name, reference) in &interface.types { if !hidden.contains(name) { - types.push(imported_type( + let mut imported = imported_type( *reference, name, import.span, reference_is_opaque(interface, *reference), - )); + ); + imported.constructors = interface + .constructors + .get(name) + .cloned() + .unwrap_or_default(); + types.push(imported); } } } @@ -311,18 +323,21 @@ fn build_import( unknown_import(module_index, name, errors); continue; }; - types.push(imported_type( + let mut imported_ty = imported_type( reference, &name.text, name.span, reference_is_opaque(interface, reference), - )); + ); match members { None => {} Some(members) if members.all => { - for (member, symbol) in - interface.constructors.get(&name.text).into_iter().flatten() - { + imported_ty.constructors = interface + .constructors + .get(&name.text) + .cloned() + .unwrap_or_default(); + for (member, symbol) in &imported_ty.constructors { symbols.push(imported(*symbol, member, member, name.span)); } } @@ -335,12 +350,17 @@ fn build_import( .find(|(name, _)| *name == member.text) }); match found { - Some((name, symbol)) => symbols.push(imported( - *symbol, - name, - name, - member.span, - )), + Some((constructor_name, symbol)) => { + imported_ty + .constructors + .push((constructor_name.clone(), *symbol)); + symbols.push(imported( + *symbol, + constructor_name, + constructor_name, + member.span, + )); + } None => errors.push(ProgramError { module: module_index, error: ResolveError::named( @@ -353,6 +373,7 @@ fn build_import( } } } + types.push(imported_ty); } ast::ImportRef::Class(name) => { match interface.types.get(&name.text).copied() { @@ -454,6 +475,7 @@ fn imported_type( name: name.to_string(), span, opaque, + constructors: Vec::new(), } } diff --git a/crates/psrs-resolve/src/resolver/program/tests.rs b/crates/psrs-resolve/src/resolver/program/tests.rs index d9af0691..631ada7d 100644 --- a/crates/psrs-resolve/src/resolver/program/tests.rs +++ b/crates/psrs-resolve/src/resolver/program/tests.rs @@ -60,6 +60,15 @@ fn import(module_name: &str) -> ast::Import { } } +fn import_as(module_name: &str, alias: &str) -> ast::Import { + ast::Import { + module: name(module_name), + alias: Some(name(alias)), + list: None, + span: TextRange::new(0, 10), + } +} + fn import_list(module_name: &str, items: Vec, hiding: bool) -> ast::Import { let span = TextRange::new(0, 20); ast::Import { @@ -407,6 +416,37 @@ fn a_module_can_reexport_an_imported_operator_alias_without_its_target() { ); } +#[test] +fn a_module_reexports_all_imports_sharing_one_alias() { + let left = module("Left", Vec::new(), None, vec![value("left", integer("1"))]); + let right = module( + "Right", + Vec::new(), + None, + vec![value("right", integer("2"))], + ); + let facade = module( + "Facade", + vec![import_as("Left", "Exports"), import_as("Right", "Exports")], + Some(ast::ExportList { + items: vec![ast::ExportRef::Module(name("Exports"))], + span: TextRange::new(0, 20), + }), + Vec::new(), + ); + + let resolved = resolve_program(vec![left, right, facade]).unwrap(); + let names = resolved[2] + .exports + .as_ref() + .unwrap() + .values + .iter() + .map(|value| value.name.as_str()) + .collect::>(); + assert_eq!(names, std::collections::HashSet::from(["left", "right"])); +} + #[test] fn an_exported_operator_alias_must_export_a_local_target() { // The same shape, but the target is declared in the exporting module and is diff --git a/crates/psrs-resolve/src/resolver/type_resolution.rs b/crates/psrs-resolve/src/resolver/type_resolution.rs index 190bfbf5..9be9dcf0 100644 --- a/crates/psrs-resolve/src/resolver/type_resolution.rs +++ b/crates/psrs-resolve/src/resolver/type_resolution.rs @@ -1,4 +1,6 @@ -use super::names::{Resolver, builtin_type, is_uppercase, prim_type, split_qualified}; +use super::names::{ + Resolver, builtin_type, implicit_prim_class, is_uppercase, prim_type, split_qualified, +}; use super::{PlannedType, ResolveErrorKind}; use psrs_ast as ast; use psrs_hir::{ @@ -168,8 +170,11 @@ impl Resolver { self.report(ResolveErrorKind::UnknownTypeName, text.to_owned(), span); None } - (None, None) => match builtin_type(text) { - Some(builtin) => Some(TypeReference::Builtin(builtin)), + (None, None) => match builtin_type(text) + .map(TypeReference::Builtin) + .or_else(|| implicit_prim_class(text)) + { + Some(reference) => Some(reference), None => { self.report(ResolveErrorKind::UnknownTypeName, text.to_owned(), span); None diff --git a/crates/psrs-syntax/src/parser/declaration/mod.rs b/crates/psrs-syntax/src/parser/declaration/mod.rs index 18e2717b..16f599a4 100644 --- a/crates/psrs-syntax/src/parser/declaration/mod.rs +++ b/crates/psrs-syntax/src/parser/declaration/mod.rs @@ -36,11 +36,21 @@ impl<'a> Parser<'a> { let pattern = self.parse_pattern()?; let equals_span = self.consume_raw(RawTokenKind::Equals)?.span; let value = self.parse_expression(0)?; - let span = TextRange::new(pattern.span.start, value.span.end); + let where_block = if self.at_raw(&RawTokenKind::Where) { + Some(self.parse_declaration_block()?) + } else { + None + }; + let end = where_block + .as_ref() + .map(|block| block.span.end) + .unwrap_or(value.span.end); + let span = TextRange::new(pattern.span.start, end); Ok(Declaration::Pattern(PatternDeclaration { pattern, equals_span, value, + where_block, span, })) } diff --git a/crates/psrs-syntax/src/parser/expr/atom/mod.rs b/crates/psrs-syntax/src/parser/expr/atom/mod.rs index b60494a3..c3314ad0 100644 --- a/crates/psrs-syntax/src/parser/expr/atom/mod.rs +++ b/crates/psrs-syntax/src/parser/expr/atom/mod.rs @@ -2,7 +2,7 @@ mod records; mod sections; use crate::{LayoutTokenKind, RawTokenKind}; -use psrs_cst::{CstName, Expr, ExprKind, RecordField, RecordUpdateField}; +use psrs_cst::{CstName, Expr, ExprKind, RecordAccessorField, RecordField, RecordUpdateField}; use psrs_span::TextRange; use super::super::{ParseError, Parser}; @@ -14,14 +14,45 @@ impl<'a> Parser<'a> { if self.at_raw(&RawTokenKind::Dot) && self.starts_label_at(1) { let dot_span = self.bump().span; let field = self.parse_label("record field")?; - let span = TextRange::new(function.span.start, field.span.end); - function = Expr { - kind: ExprKind::FieldAccess { - expression: Box::new(function), - dot_span, - field, - }, - span, + let field_end = field.span.end; + function = match function.kind { + ExprKind::Name(name) if name.text == "_" => { + let marker_span = name.span; + Expr { + kind: ExprKind::RecordAccessor { + marker_span, + fields: vec![RecordAccessorField { dot_span, field }], + }, + span: TextRange::new(marker_span.start, field_end), + } + } + ExprKind::RecordAccessor { + marker_span, + mut fields, + } => { + fields.push(RecordAccessorField { dot_span, field }); + Expr { + kind: ExprKind::RecordAccessor { + marker_span, + fields, + }, + span: TextRange::new(marker_span.start, field_end), + } + } + kind => { + let span = TextRange::new(function.span.start, field.span.end); + Expr { + kind: ExprKind::FieldAccess { + expression: Box::new(Expr { + kind, + span: function.span, + }), + dot_span, + field, + }, + span, + } + } }; continue; } diff --git a/crates/psrs-syntax/src/parser/expr/pattern.rs b/crates/psrs-syntax/src/parser/expr/pattern.rs index 019de1f5..2cf9017a 100644 --- a/crates/psrs-syntax/src/parser/expr/pattern.rs +++ b/crates/psrs-syntax/src/parser/expr/pattern.rs @@ -224,10 +224,29 @@ impl<'a> Parser<'a> { RawTokenKind::Hiding => "hiding", _ => "role", }; - Ok(Pattern { + let pattern = Pattern { kind: PatternKind::Var(CstName::new(text, token.span)), span: token.span, - }) + }; + // `as` is the fixity keyword, and it is also a legal binder. + // `merge as@(a : as')` is a named pattern, same as a lower-ident binder. + if self.at_operator_text("@") { + let at_span = self.bump().span; + let inner = self.parse_pattern_atom()?; + let span = TextRange::new(pattern.span.start, inner.span.end); + let PatternKind::Var(name) = pattern.kind else { + unreachable!("just constructed a variable pattern") + }; + return Ok(Pattern { + kind: PatternKind::Named { + name, + at_span, + pattern: Box::new(inner), + }, + span, + }); + } + Ok(pattern) } LayoutTokenKind::Raw(RawTokenKind::LParen) => self.parse_parenthesized_pattern(), LayoutTokenKind::Raw(RawTokenKind::LBracket) => self.parse_array_pattern(), diff --git a/crates/psrs-syntax/src/parser/tests.rs b/crates/psrs-syntax/src/parser/tests.rs index b61d7960..9d9e5c67 100644 --- a/crates/psrs-syntax/src/parser/tests.rs +++ b/crates/psrs-syntax/src/parser/tests.rs @@ -129,6 +129,23 @@ fn distinguishes_lowercase_record_fields_from_uppercase_qualified_values() { assert!(matches!(&qualified.kind, ExprKind::Name(name) if name.text == "Data.Array.map")); } +#[test] +fn parses_anonymous_record_field_accessors() { + let module = parse("module Main where\nproject = _.value.nested\n").unwrap(); + let accessor = plain_value(as_value(&module.declarations[0])); + let ExprKind::RecordAccessor { + marker_span, + fields, + } = &accessor.kind + else { + panic!("expected `_ .field` to have its own CST node"); + }; + assert_eq!(marker_span, &TextRange::new(28, 29)); + assert_eq!(fields.len(), 2); + assert_eq!(fields[0].field.text, "value"); + assert_eq!(fields[1].field.text, "nested"); +} + #[test] fn parses_single_line_let_blocks() { let module = parse("module Main where\nmain = let x = 1 in x\n").unwrap(); @@ -221,6 +238,18 @@ fn parses_forall_with_multiple_variables() { ); } +#[test] +fn parses_empty_parentheses_as_an_empty_row_type() { + let module = parse("module Main where\ntype Empty = ()\n").unwrap(); + let Declaration::TypeSynonym(declaration) = &module.declarations[0] else { + panic!("expected a type synonym"); + }; + assert!(matches!( + &declaration.body.kind, + TypeExprKind::Row { fields, tail: None, .. } if fields.is_empty() + )); +} + #[test] fn type_arrows_are_right_associative() { let module = parse("module Main where\nf :: a -> b -> c\nf x = x\n").unwrap(); diff --git a/crates/psrs-syntax/src/parser/type_expr/mod.rs b/crates/psrs-syntax/src/parser/type_expr/mod.rs index b655529c..56f3a5a1 100644 --- a/crates/psrs-syntax/src/parser/type_expr/mod.rs +++ b/crates/psrs-syntax/src/parser/type_expr/mod.rs @@ -311,7 +311,12 @@ impl<'a> Parser<'a> { let close_paren_span = self.bump().span; let span = TextRange::new(open_paren_span.start, close_paren_span.end); return Ok(TypeExpr { - kind: TypeExprKind::Name(CstName::new("Unit", span)), + kind: TypeExprKind::Row { + open_paren_span, + fields: Vec::new(), + tail: None, + close_paren_span, + }, span, }); } diff --git a/crates/psrs-thir/src/scope/mod.rs b/crates/psrs-thir/src/scope/mod.rs index 83984fc2..ee3011af 100644 --- a/crates/psrs-thir/src/scope/mod.rs +++ b/crates/psrs-thir/src/scope/mod.rs @@ -3,10 +3,11 @@ use crate::{ }; use psrs_hir::TypeVariableId; use psrs_span::TextRange; -use std::collections::{HashMap, HashSet}; +use std::collections::HashSet; mod free_type_variables; -use free_type_variables::free_type_variables; +mod polymorphic; +use polymorphic::{leading_foralls, open_child_binders}; pub(super) fn verify_module(module: &Module) -> Vec { let mut errors = Vec::new(); @@ -121,10 +122,12 @@ fn verify_type_scope( return; } match types.get(id.0 as usize) { - Some(Type::Variable(variable)) if !scope.contains(variable) => errors.push(VerifyError { - span, - message: "type variable is outside its quantifier scope", - }), + Some(Type::Variable(variable)) if !scope.contains(variable) => { + errors.push(VerifyError { + span, + message: "type variable is outside its quantifier scope", + }); + } Some(Type::Application(function, argument)) => { verify_type_scope(*function, types, scope, span, active, errors); verify_type_scope(*argument, types, scope, span, active, errors); @@ -195,13 +198,24 @@ fn verify_expr_scope( | ExprKind::String(_) | ExprKind::Char(_) => {} ExprKind::Array(elements) => { + let binders = leading_foralls(types, expression.ty); for element in elements { - verify_expr_scope(element, types, scope, errors); + let mut element_scope = scope.clone(); + open_child_binders(element, &binders, types, &mut element_scope, errors); + verify_expr_scope(element, types, &mut element_scope, errors); } } ExprKind::Record(fields) => { - for (_, value) in fields { - verify_expr_scope(value, types, scope, errors); + let field_types = crate::record_fields(types, expression.ty).unwrap_or_default(); + for (label, value) in fields { + let binders = field_types + .iter() + .find(|(field_label, _)| field_label == label) + .map(|(_, ty)| leading_foralls(types, *ty)) + .unwrap_or_default(); + let mut field_scope = scope.clone(); + open_child_binders(value, &binders, types, &mut field_scope, errors); + verify_expr_scope(value, types, &mut field_scope, errors); } } ExprKind::RecordUpdate { expression, fields } => { @@ -210,8 +224,13 @@ fn verify_expr_scope( verify_expr_scope(value, types, scope, errors); } } - ExprKind::FieldAccess { expression, .. } => { - verify_expr_scope(expression, types, scope, errors) + ExprKind::FieldAccess { + expression: record, .. + } => { + let binders = leading_foralls(types, expression.ty); + let mut record_scope = scope.clone(); + open_child_binders(record, &binders, types, &mut record_scope, errors); + verify_expr_scope(record, types, &mut record_scope, errors) } ExprKind::Evidence(evidence) => verify_evidence_scope(evidence, types, scope, errors), ExprKind::Coerce { @@ -334,42 +353,6 @@ fn open_expression_binders( scope.extend(local); } -fn open_child_binders( - child: &Expr, - candidates: &[TypeVariableId], - types: &[Type], - scope: &mut HashSet, - errors: &mut Vec, -) { - let mut free = HashSet::new(); - free_type_variables( - child.ty, - types, - &mut HashMap::new(), - &mut HashSet::new(), - &mut free, - ); - let relevant = candidates - .iter() - .copied() - .filter(|variable| free.contains(variable)) - .collect::>(); - if relevant.is_empty() { - return; - } - let mut local = HashSet::new(); - if relevant - .iter() - .any(|variable| !local.insert(*variable) || scope.contains(variable)) - { - errors.push(VerifyError { - span: child.span, - message: "forall binder shadows an active type variable", - }); - } - scope.extend(local); -} - fn verify_pattern_scope( pattern: &Pattern, types: &[Type], @@ -481,20 +464,3 @@ fn verify_evidence_scope( } } } - -fn leading_foralls(types: &[Type], mut id: TypeId) -> Vec { - let mut variables = Vec::new(); - let mut seen = HashSet::new(); - while let Some(Type::ForAll { - variables: binders, - body, - }) = types.get(id.0 as usize) - { - if !seen.insert(id) { - break; - } - variables.extend(binders.iter().copied()); - id = *body; - } - variables -} diff --git a/crates/psrs-thir/src/scope/polymorphic.rs b/crates/psrs-thir/src/scope/polymorphic.rs new file mode 100644 index 00000000..5374f6b5 --- /dev/null +++ b/crates/psrs-thir/src/scope/polymorphic.rs @@ -0,0 +1,57 @@ +use super::free_type_variables::free_type_variables; +use crate::{Expr, Type, TypeId, VerifyError}; +use psrs_hir::TypeVariableId; +use std::collections::{HashMap, HashSet}; + +pub(super) fn open_child_binders( + child: &Expr, + candidates: &[TypeVariableId], + types: &[Type], + scope: &mut HashSet, + errors: &mut Vec, +) { + let mut free = HashSet::new(); + free_type_variables( + child.ty, + types, + &mut HashMap::new(), + &mut HashSet::new(), + &mut free, + ); + let relevant = candidates + .iter() + .copied() + .filter(|variable| free.contains(variable)) + .collect::>(); + if relevant.is_empty() { + return; + } + let mut local = HashSet::new(); + if relevant + .iter() + .any(|variable| !local.insert(*variable) || scope.contains(variable)) + { + errors.push(VerifyError { + span: child.span, + message: "forall binder shadows an active type variable", + }); + } + scope.extend(local); +} + +pub(super) fn leading_foralls(types: &[Type], mut id: TypeId) -> Vec { + let mut variables = Vec::new(); + let mut seen = HashSet::new(); + while let Some(Type::ForAll { + variables: binders, + body, + }) = types.get(id.0 as usize) + { + if !seen.insert(id) { + break; + } + variables.extend(binders.iter().copied()); + id = *body; + } + variables +} diff --git a/crates/psrs-thir/src/tests.rs b/crates/psrs-thir/src/tests.rs index edc82c8d..778bad7c 100644 --- a/crates/psrs-thir/src/tests.rs +++ b/crates/psrs-thir/src/tests.rs @@ -157,6 +157,84 @@ fn verifier_requires_superclass_evidence_to_name_a_well_typed_field() { ); } +#[test] +fn verifier_accepts_alpha_equivalent_superclass_field_types() { + let left_variable = TypeVariableId(10); + let right_variable = TypeVariableId(11); + let module = Module { + type_names: Vec::new(), + id: ModuleId(0), + name: "Main".into(), + externals: Vec::new(), + external_types: Vec::new(), + types: vec![ + Type::RowEmpty, + Type::Variable(left_variable), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(2), TypeId(1)), + Type::Application(TypeId(3), TypeId(1)), + Type::ForAll { + variables: vec![left_variable], + body: TypeId(4), + }, + Type::Variable(right_variable), + Type::Application(TypeId(2), TypeId(6)), + Type::Application(TypeId(7), TypeId(6)), + Type::ForAll { + variables: vec![right_variable], + body: TypeId(8), + }, + Type::RowExtend { + label: "method".into(), + ty: TypeId(5), + tail: TypeId(0), + }, + Type::Constructor(TypeConstructor::Record), + Type::Application(TypeId(11), TypeId(10)), + Type::RowExtend { + label: "super".into(), + ty: TypeId(12), + tail: TypeId(0), + }, + Type::Constructor(TypeConstructor::Record), + Type::Application(TypeId(14), TypeId(13)), + ], + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: vec![Declaration { + symbol: SymbolId::new(ModuleId(0), 0), + name: "main".into(), + name_span: TextRange::new(0, 4), + quantified: Vec::new(), + ty: TypeId(12), + value: Expr { + kind: ExprKind::Evidence(Evidence { + kind: EvidenceKind::Superclass { + parent: Box::new(Evidence { + kind: EvidenceKind::Given(LocalId(0)), + class_id: psrs_hir::TypeId::new(ModuleId(0), 1), + ty: TypeId(15), + span: TextRange::new(8, 9), + }), + field: "super".into(), + }, + class_id: psrs_hir::TypeId::new(ModuleId(0), 0), + ty: TypeId(12), + span: TextRange::new(8, 18), + }), + ty: TypeId(12), + span: TextRange::new(8, 18), + }, + span: TextRange::new(0, 18), + }], + span: TextRange::new(0, 18), + }; + + assert!(module.verify().is_ok()); +} + /// A module carrying `Proxy 1` and `Proxy 2` and one global reference at each. /// A literal is decided, so the verifier compares the two by value instead of /// treating both as applications of the same nominal head. diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index 20e2a369..e8db1f3a 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -85,7 +85,7 @@ pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { declaration.name_span, &mut errors, ); - verify_expr(&declaration.value, &module.types, &mut errors); + verify_expr(&declaration.value, module, &mut errors); } if !errors.is_empty() { return Err(errors); @@ -98,7 +98,8 @@ pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { } } -fn verify_expr(expression: &Expr, types: &[Type], errors: &mut Vec) { +fn verify_expr(expression: &Expr, module: &Module, errors: &mut Vec) { + let types = &module.types; verify_type_id(expression.ty, types.len(), expression.span, errors); match &expression.kind { ExprKind::Local(_) @@ -110,30 +111,30 @@ fn verify_expr(expression: &Expr, types: &[Type], errors: &mut Vec) | ExprKind::Char(_) => {} ExprKind::Array(elements) => { for element in elements { - verify_expr(element, types, errors); + verify_expr(element, module, errors); } } ExprKind::Record(fields) => { for (_, value) in fields { - verify_expr(value, types, errors); + verify_expr(value, module, errors); } } ExprKind::RecordUpdate { expression, fields } => { - verify_expr(expression, types, errors); + verify_expr(expression, module, errors); for (_, value) in fields { - verify_expr(value, types, errors); + verify_expr(value, module, errors); } } - ExprKind::FieldAccess { expression, .. } => verify_expr(expression, types, errors), - ExprKind::Evidence(evidence) => verify_evidence(evidence, types, errors), + ExprKind::FieldAccess { expression, .. } => verify_expr(expression, module, errors), + ExprKind::Evidence(evidence) => verify_evidence(evidence, module, errors), ExprKind::Coerce { value, evidence, source_type, target_type, } => { - verify_expr(value, types, errors); - verify_evidence(evidence, types, errors); + verify_expr(value, module, errors); + verify_evidence(evidence, module, errors); if evidence.class_id != psrs_hir::TypeId::COERCIBLE { errors.push(VerifyError { span: evidence.span, @@ -164,43 +165,44 @@ fn verify_expr(expression: &Expr, types: &[Type], errors: &mut Vec) } } ExprKind::Application(function, argument) => { - verify_expr(function, types, errors); - verify_expr(argument, types, errors); + verify_expr(function, module, errors); + verify_expr(argument, module, errors); } ExprKind::Lambda { binder, body } => { verify_type_id(binder.ty, types.len(), binder.span, errors); - verify_expr(body, types, errors); + verify_expr(body, module, errors); } ExprKind::Let { bindings, body } => { for binding in bindings { verify_type_id(binding.binder.ty, types.len(), binding.binder.span, errors); - verify_expr(&binding.value, types, errors); + verify_expr(&binding.value, module, errors); } - verify_expr(body, types, errors); + verify_expr(body, module, errors); } ExprKind::If { condition, then_branch, else_branch, } => { - verify_expr(condition, types, errors); - verify_expr(then_branch, types, errors); - verify_expr(else_branch, types, errors); + verify_expr(condition, module, errors); + verify_expr(then_branch, module, errors); + verify_expr(else_branch, module, errors); } ExprKind::Case { scrutinee, branches, } => { - verify_expr(scrutinee, types, errors); + verify_expr(scrutinee, module, errors); for branch in branches { verify_pattern(&branch.pattern, types.len(), errors); - verify_expr(&branch.value, types, errors); + verify_expr(&branch.value, module, errors); } } } } -fn verify_evidence(evidence: &Evidence, types: &[Type], errors: &mut Vec) { +fn verify_evidence(evidence: &Evidence, module: &Module, errors: &mut Vec) { + let types = &module.types; verify_type_id(evidence.ty, types.len(), evidence.span, errors); match &evidence.kind { EvidenceKind::Given(_) | EvidenceKind::Global(_) => {} @@ -227,7 +229,7 @@ fn verify_evidence(evidence: &Evidence, types: &[Type], errors: &mut Vec { - verify_evidence(parent, types, errors); + verify_evidence(parent, module, errors); let Some(fields) = crate::record_fields(types, parent.ty) else { errors.push(VerifyError { span: evidence.span, @@ -236,7 +238,7 @@ fn verify_evidence(evidence: &Evidence, types: &[Type], errors: &mut Vec {} + Some((_, field_ty)) if semantics::types_equal(*field_ty, evidence.ty, module) => {} _ => errors.push(VerifyError { span: evidence.span, message: "superclass evidence field has the wrong type", @@ -251,7 +253,7 @@ fn verify_evidence(evidence: &Evidence, types: &[Type], errors: &mut Vec bool { + Matcher::new(module).equal(left, right, &mut HashSet::new()) +} + struct Matcher<'a> { module: &'a Module, flexible: HashSet, @@ -116,35 +120,27 @@ impl<'a> Matcher<'a> { body: actual_body, } = actual_type { - if let Type::ForAll { - variables: expected_variables, - body: expected_body, - } = expected_type - { - if actual_variables.len() != expected_variables.len() - || actual_variables - .iter() - .any(|variable| self.alpha.contains_key(variable)) - { - self.active.remove(&(actual, expected)); - return false; - } - for (actual, expected) in actual_variables.iter().zip(expected_variables) { - self.alpha.insert(*actual, *expected); - } - let result = self.subsumes(*actual_body, *expected_body); - for variable in actual_variables { - self.alpha.remove(variable); - } - self.active.remove(&(actual, expected)); - return result; - } let added = actual_variables .iter() .copied() .filter(|variable| self.flexible.insert(*variable)) .collect::>(); - let result = self.subsumes(*actual_body, expected); + let (expected_body, expected_flexible) = match expected_type { + Type::ForAll { variables, body } => { + let previous = variables + .iter() + .map(|variable| (*variable, self.flexible.remove(variable))) + .collect::>(); + (*body, previous) + } + _ => (expected, Vec::new()), + }; + let result = self.subsumes(*actual_body, expected_body); + for (variable, was_flexible) in expected_flexible { + if was_flexible { + self.flexible.insert(variable); + } + } for variable in added { self.flexible.remove(&variable); self.replacements.remove(&variable); diff --git a/crates/psrs-thir/src/verify/semantics/matching/tests.rs b/crates/psrs-thir/src/verify/semantics/matching/tests.rs index 0b1cf2ed..201348e0 100644 --- a/crates/psrs-thir/src/verify/semantics/matching/tests.rs +++ b/crates/psrs-thir/src/verify/semantics/matching/tests.rs @@ -157,6 +157,51 @@ fn alpha_equal_foralls_match_reordered_rows_inside_nested_proxy_types() { assert!(Matcher::new(&module).equal(left, right, &mut HashSet::new())); } +#[test] +fn a_more_polymorphic_function_matches_a_rank_n_instance_method() { + let mut types = Vec::new(); + let x = TypeVariableId(50); + let y = TypeVariableId(51); + let z = TypeVariableId(52); + let x_ty = push(&mut types, Type::Variable(x)); + let y_ty = push(&mut types, Type::Variable(y)); + let z_ty = push(&mut types, Type::Variable(z)); + let y_to_z = arrow(&mut types, y_ty, z_ty); + let x_to_y = arrow(&mut types, x_ty, y_ty); + let x_to_z = arrow(&mut types, x_ty, z_ty); + let function_after_first = arrow(&mut types, x_to_y, x_to_z); + let actual_body = arrow(&mut types, y_to_z, function_after_first); + let actual = push( + &mut types, + Type::ForAll { + variables: vec![x, y, z], + body: actual_body, + }, + ); + + let a = TypeVariableId(53); + let b = TypeVariableId(54); + let r = TypeVariableId(55); + let a_ty = push(&mut types, Type::Variable(a)); + let b_ty = push(&mut types, Type::Variable(b)); + let r_ty = push(&mut types, Type::Variable(r)); + let a_to_b = arrow(&mut types, a_ty, b_ty); + let r_to_a = arrow(&mut types, r_ty, a_ty); + let r_to_b = arrow(&mut types, r_ty, b_ty); + let function_after_first = arrow(&mut types, r_to_a, r_to_b); + let expected_body = arrow(&mut types, a_to_b, function_after_first); + let expected = push( + &mut types, + Type::ForAll { + variables: vec![a, b], + body: expected_body, + }, + ); + let module = module(types, Vec::new()); + + assert!(compatible(actual, expected, &module)); +} + #[test] fn scheme_instantiation_rejects_inconsistent_reuses_of_a_generic_row_tail() { let mut types = vec![Type::RowEmpty]; diff --git a/crates/psrs-thir/src/verify/semantics/mod.rs b/crates/psrs-thir/src/verify/semantics/mod.rs index f556cb92..db6f4960 100644 --- a/crates/psrs-thir/src/verify/semantics/mod.rs +++ b/crates/psrs-thir/src/verify/semantics/mod.rs @@ -6,6 +6,10 @@ use std::collections::HashMap; mod matching; +pub(super) fn types_equal(left: TypeId, right: TypeId, module: &Module) -> bool { + matching::equivalent(left, right, module) +} + #[derive(Clone)] struct Scheme { ty: TypeId, @@ -351,6 +355,7 @@ fn primitive_type(module: &Module, constructor: TypeConstructor) -> Option Option { + let id = strip_leading_foralls(module, id); let Type::Application(head, element) = module.types.get(id.0 as usize)? else { return None; }; diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs new file mode 100644 index 00000000..9d3729de --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs @@ -0,0 +1,204 @@ +use super::*; + +impl Checker { + pub(super) fn derive_eq_method( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + self.derive_structural_eq(method, class_arguments, method.symbol, false, span) + } + + pub(super) fn derive_eq1_method( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + let Some(eq_method) = self.known_method_symbol("Data.Eq", "Eq", "eq") else { + return self.deriving_error(span, "cannot find the Eq method for Eq1 deriving"); + }; + self.derive_structural_eq(method, class_arguments, eq_method, true, span) + } + + fn derive_structural_eq( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + eq_method: SymbolId, + higher_kinded: bool, + span: TextRange, + ) -> Option { + let description = if higher_kinded { "Eq1" } else { "Eq" }; + let Some(instance_type) = class_arguments.first() else { + return self.deriving_error(span, "equality deriving requires one type argument"); + }; + let instance_type = self.resolve_type(instance_type.clone()); + let (head, arguments) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return self.deriving_error( + span, + &format!("{description} deriving requires a local data or newtype constructor"), + ); + }; + let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { + return self + .deriving_error(span, "cannot find the data declaration to derive equality"); + }; + let fixed_parameters = + declaration + .parameters + .len() + .checked_sub(if higher_kinded { 1 } else { 0 }); + if type_id.module != self.env.module_id + || !matches!( + declaration.kind, + hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype + ) + || fixed_parameters != Some(arguments.len()) + { + let requirement = if higher_kinded { + "a locally declared type constructor with one final parameter" + } else { + "a locally declared, fully applied data type" + }; + return self.deriving_error( + span, + &format!("{description} deriving requires {requirement}"), + ); + } + + let left = self.fresh_deriving_binder("__derived_left", span); + let right = self.fresh_deriving_binder("__derived_right", span); + let mut left_case_branches = Vec::new(); + for constructor in &declaration.constructors { + let left_fields = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__derived_l", span)) + .collect::>(); + let right_fields = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__derived_r", span)) + .collect::>(); + let body = + derive_eq_field_tests(constructor, &left_fields, &right_fields, eq_method, span); + let same_constructor = hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: constructor_pattern(constructor, &right_fields, span), + value: body, + span, + }; + let mismatch = hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: hir::Pattern { + kind: hir::PatternKind::Wildcard, + span, + }, + value: boolean_literal(false, span), + span, + }; + let right_case = hir::Expr { + kind: hir::ExprKind::Case { + scrutinee: Box::new(local_expr(right.id, span)), + branches: vec![same_constructor, mismatch], + }, + span, + }; + left_case_branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: constructor_pattern(constructor, &left_fields, span), + value: right_case, + span, + }); + } + if left_case_branches.is_empty() { + left_case_branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: hir::Pattern { + kind: hir::PatternKind::Wildcard, + span, + }, + value: boolean_literal(true, span), + span, + }); + } + let implementation = hir::Expr { + kind: hir::ExprKind::Lambda { + binder: left.clone(), + body: Box::new(hir::Expr { + kind: hir::ExprKind::Lambda { + binder: right.clone(), + body: Box::new(hir::Expr { + kind: hir::ExprKind::Case { + scrutinee: Box::new(local_expr(left.id, span)), + branches: left_case_branches, + }, + span, + }), + }, + span, + }), + }, + span, + }; + self.infer_derived_method(method, class_arguments, &implementation) + } +} + +fn derive_eq_field_tests( + constructor: &hir::Constructor, + left_fields: &[hir::LocalBinder], + right_fields: &[hir::LocalBinder], + eq_method: SymbolId, + span: TextRange, +) -> hir::Expr { + constructor + .fields + .iter() + .zip(left_fields) + .zip(right_fields) + .map(|((_field, left), right)| { + let method = global_expr(eq_method, span); + apply_expr( + apply_expr(method, local_expr(left.id, span), span), + local_expr(right.id, span), + span, + ) + }) + .collect::>() + .into_iter() + .rev() + .fold(boolean_literal(true, span), |rest, test| hir::Expr { + kind: hir::ExprKind::If { + condition: Box::new(test), + then_branch: Box::new(rest), + else_branch: Box::new(boolean_literal(false, span)), + }, + span, + }) +} + +fn constructor_pattern( + constructor: &hir::Constructor, + binders: &[hir::LocalBinder], + span: TextRange, +) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Constructor { + symbol: constructor.symbol, + name_span: constructor.name_span, + arguments: binders + .iter() + .cloned() + .map(|binder| hir::Pattern { + kind: hir::PatternKind::Var(binder), + span, + }) + .collect(), + }, + span, + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs new file mode 100644 index 00000000..c49454c2 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs @@ -0,0 +1,459 @@ +use super::super::super::*; +use super::{apply_expr, flatten_spine, global_expr, local_expr}; + +impl Checker { + pub(super) fn generic_representation( + &mut self, + instance_type: &InferType, + span: TextRange, + ) -> Option { + let instance_type = self.resolve_type(instance_type.clone()); + let (head, arguments) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return self.deriving_error(span, "Generic deriving requires a local data type"); + }; + let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { + return self.deriving_error(span, "cannot find the data declaration for Generic"); + }; + if type_id.module != self.env.module_id + || declaration.kind != hir::TypeDeclarationKind::Data + || declaration.parameters.len() != arguments.len() + { + return self.deriving_error( + span, + "Generic deriving requires a locally declared, fully applied data type", + ); + } + if declaration.constructors.is_empty() { + return self.generic_type("NoConstructors", Vec::new()).or_else(|| { + self.deriving_error(span, "cannot find Data.Generic.Rep.NoConstructors") + }); + } + + let parameter_types = declaration + .parameters + .iter() + .map(|parameter| parameter.name.clone()) + .zip(arguments) + .collect::>(); + let mut constructor_representations = Vec::new(); + for constructor in &declaration.constructors { + let mut fields = Vec::new(); + for field in &constructor.fields { + let mut variables = parameter_types.clone(); + let field_type = self.elaborate_type(field, &mut variables); + let Some(argument) = self.generic_type("Argument", vec![field_type]) else { + return self.deriving_error(span, "cannot find Data.Generic.Rep.Argument"); + }; + fields.push(argument); + } + let product = if fields.is_empty() { + let Some(no_arguments) = self.generic_type("NoArguments", Vec::new()) else { + return self.deriving_error(span, "cannot find Data.Generic.Rep.NoArguments"); + }; + no_arguments + } else { + let Some(product) = self.generic_product_type(fields) else { + return self.deriving_error(span, "cannot find Data.Generic.Rep.Product"); + }; + product + }; + let Some(representation) = self.generic_type( + "Constructor", + vec![ + InferType::TypeLevelString(constructor.name.clone()), + product, + ], + ) else { + return self.deriving_error(span, "cannot find Data.Generic.Rep.Constructor"); + }; + constructor_representations.push(representation); + } + if constructor_representations.len() == 1 { + return constructor_representations.pop(); + } + self.generic_sum_type(constructor_representations) + .or_else(|| self.deriving_error(span, "cannot find Data.Generic.Rep.Sum")) + } + + pub(super) fn derive_generic_method( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + let Some(instance_type) = class_arguments.first() else { + return self.deriving_error(span, "Generic deriving requires its data type argument"); + }; + let instance_type = self.resolve_type(instance_type.clone()); + let (head, arguments) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return self.deriving_error(span, "Generic deriving requires a local data type"); + }; + let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { + return self.deriving_error(span, "cannot find the data declaration for Generic"); + }; + if type_id.module != self.env.module_id + || declaration.kind != hir::TypeDeclarationKind::Data + || declaration.parameters.len() != arguments.len() + { + return self.deriving_error( + span, + "Generic deriving requires a locally declared, fully applied data type", + ); + } + + let value = self.fresh_deriving_binder("__generic_value", span); + let implementation = match method.name.as_str() { + "from" => self.derive_generic_from(&declaration, &value, span)?, + "to" => self.derive_generic_to(&declaration, &value, span)?, + _ => { + return self + .deriving_error(span, "Generic derives only its `to` and `from` methods"); + } + }; + self.infer_derived_method(method, class_arguments, &implementation) + } + + fn derive_generic_from( + &mut self, + declaration: &hir::TypeDeclaration, + value: &hir::LocalBinder, + span: TextRange, + ) -> Option { + let mut branches = Vec::with_capacity(declaration.constructors.len()); + let count = declaration.constructors.len(); + for (index, constructor) in declaration.constructors.iter().enumerate() { + let fields = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__generic_field", span)) + .collect::>(); + let product = self.generic_product_expression(&fields, span)?; + let wrapped = self.generic_constructor_expression("Constructor", product, span)?; + let encoded = self.generic_sum_expression(wrapped, index, count, span)?; + branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: data_constructor_pattern(constructor, &fields, span), + value: encoded, + span, + }); + } + if branches.is_empty() { + let recursive = apply_expr( + global_expr(self.current_generic_method("from")?, span), + local_expr(value.id, span), + span, + ); + return Some(hir::Expr { + kind: hir::ExprKind::Lambda { + binder: value.clone(), + body: Box::new(recursive), + }, + span, + }); + } + Some(hir::Expr { + kind: hir::ExprKind::Lambda { + binder: value.clone(), + body: Box::new(hir::Expr { + kind: hir::ExprKind::Case { + scrutinee: Box::new(local_expr(value.id, span)), + branches, + }, + span, + }), + }, + span, + }) + } + + fn derive_generic_to( + &mut self, + declaration: &hir::TypeDeclaration, + value: &hir::LocalBinder, + span: TextRange, + ) -> Option { + let count = declaration.constructors.len(); + let mut branches = Vec::with_capacity(count); + for (index, constructor) in declaration.constructors.iter().enumerate() { + let fields = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__generic_field", span)) + .collect::>(); + let product = self.generic_product_pattern(&fields, span)?; + let wrapped = self.generic_constructor_pattern("Constructor", product, span)?; + let encoded = self.generic_sum_pattern(wrapped, index, count, span)?; + let value = fields + .iter() + .fold(global_expr(constructor.symbol, span), |function, field| { + apply_expr(function, local_expr(field.id, span), span) + }); + branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: encoded, + value, + span, + }); + } + if branches.is_empty() { + let recursive = apply_expr( + global_expr(self.current_generic_method("to")?, span), + local_expr(value.id, span), + span, + ); + return Some(hir::Expr { + kind: hir::ExprKind::Lambda { + binder: value.clone(), + body: Box::new(recursive), + }, + span, + }); + } + Some(hir::Expr { + kind: hir::ExprKind::Lambda { + binder: value.clone(), + body: Box::new(hir::Expr { + kind: hir::ExprKind::Case { + scrutinee: Box::new(local_expr(value.id, span)), + branches, + }, + span, + }), + }, + span, + }) + } + + fn generic_product_expression( + &self, + fields: &[hir::LocalBinder], + span: TextRange, + ) -> Option { + if fields.is_empty() { + return Some(global_expr( + self.generic_rep_constructor("NoArguments")?, + span, + )); + } + let argument = self.generic_rep_constructor("Argument")?; + let product = self.generic_rep_constructor("Product")?; + let mut values = fields + .iter() + .map(|field| { + apply_expr( + global_expr(argument, span), + local_expr(field.id, span), + span, + ) + }) + .rev(); + let mut result = values.next()?; + for value in values { + result = apply_expr( + apply_expr(global_expr(product, span), value, span), + result, + span, + ); + } + Some(result) + } + + fn generic_product_pattern( + &self, + fields: &[hir::LocalBinder], + span: TextRange, + ) -> Option { + match fields { + [] => Some(wildcard_pattern(span)), + [field] => { + self.generic_constructor_pattern("Argument", variable_pattern(field, span), span) + } + [first, rest @ ..] => Some(constructor_pattern( + self.generic_rep_constructor("Product")?, + vec![ + self.generic_constructor_pattern( + "Argument", + variable_pattern(first, span), + span, + )?, + self.generic_product_pattern(rest, span)?, + ], + span, + )), + } + } + + fn generic_constructor_expression( + &self, + name: &str, + argument: hir::Expr, + span: TextRange, + ) -> Option { + Some(apply_expr( + global_expr(self.generic_rep_constructor(name)?, span), + argument, + span, + )) + } + + fn generic_constructor_pattern( + &self, + name: &str, + argument: hir::Pattern, + span: TextRange, + ) -> Option { + Some(constructor_pattern( + self.generic_rep_constructor(name)?, + vec![argument], + span, + )) + } + + fn generic_sum_expression( + &self, + expression: hir::Expr, + index: usize, + count: usize, + span: TextRange, + ) -> Option { + if count <= 1 { + return Some(expression); + } + let name = if index == 0 { "Inl" } else { "Inr" }; + let nested = if index == 0 { + expression + } else { + self.generic_sum_expression(expression, index - 1, count - 1, span)? + }; + Some(apply_expr( + global_expr(self.generic_rep_constructor(name)?, span), + nested, + span, + )) + } + + fn generic_sum_pattern( + &self, + pattern: hir::Pattern, + index: usize, + count: usize, + span: TextRange, + ) -> Option { + if count <= 1 { + return Some(pattern); + } + let name = if index == 0 { "Inl" } else { "Inr" }; + let nested = if index == 0 { + pattern + } else { + self.generic_sum_pattern(pattern, index - 1, count - 1, span)? + }; + Some(constructor_pattern( + self.generic_rep_constructor(name)?, + vec![nested], + span, + )) + } + + fn generic_product_type(&self, fields: Vec) -> Option { + let mut fields = fields.into_iter().rev(); + let mut result = fields.next()?; + for field in fields { + result = self.generic_type("Product", vec![field, result])?; + } + Some(result) + } + + fn generic_sum_type(&self, constructors: Vec) -> Option { + let mut constructors = constructors.into_iter().rev(); + let mut result = constructors.next()?; + for constructor in constructors { + result = self.generic_type("Sum", vec![constructor, result])?; + } + Some(result) + } + + fn generic_type(&self, name: &str, arguments: Vec) -> Option { + let type_id = self.generic_rep_type_id(name)?; + Some(arguments.into_iter().fold( + InferType::Constructor(TypeConstructor::User(type_id)), + |function, argument| InferType::Application(Box::new(function), Box::new(argument)), + )) + } + + fn generic_rep_type_id(&self, name: &str) -> Option { + self.env.type_names.iter().find_map(|(type_id, type_name)| { + (type_name == name + && self + .env + .type_modules + .get(type_id) + .is_some_and(|module| module == "Data.Generic.Rep")) + .then_some(*type_id) + }) + } + + fn generic_rep_constructor(&self, name: &str) -> Option { + let type_id = self.generic_rep_type_id(match name { + "Inl" | "Inr" => "Sum", + _ => name, + })?; + self.env + .type_declarations + .get(&type_id)? + .constructors + .iter() + .find(|constructor| constructor.name == name) + .map(|constructor| constructor.symbol) + } + + fn current_generic_method(&self, name: &str) -> Option { + self.known_method_symbol("Data.Generic.Rep", "Generic", name) + } +} + +fn data_constructor_pattern( + constructor: &hir::Constructor, + fields: &[hir::LocalBinder], + span: TextRange, +) -> hir::Pattern { + constructor_pattern( + constructor.symbol, + fields + .iter() + .map(|field| variable_pattern(field, span)) + .collect(), + span, + ) +} + +fn constructor_pattern( + symbol: SymbolId, + arguments: Vec, + span: TextRange, +) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Constructor { + symbol, + name_span: span, + arguments, + }, + span, + } +} + +fn variable_pattern(binder: &hir::LocalBinder, span: TextRange) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Var(binder.clone()), + span, + } +} + +fn wildcard_pattern(span: TextRange) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Wildcard, + span, + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs index 6a06b1ad..c3becfa6 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs @@ -2,7 +2,9 @@ use super::super::*; mod bifunctor; mod contravariant; +mod eq; mod functor; +mod generic; mod newtype; mod ord; mod types; @@ -12,7 +14,11 @@ pub(crate) use types::contains_wildcard; #[derive(Clone, Copy, Debug, PartialEq, Eq)] enum KnownDerivingClass { Eq, + Eq1, Ord, + Ord1, + Newtype, + Generic, Functor, Bifunctor, Contravariant, @@ -22,7 +28,11 @@ impl KnownDerivingClass { fn identity(self) -> (&'static str, &'static str) { match self { Self::Eq => ("Data.Eq", "Eq"), + Self::Eq1 => ("Data.Eq", "Eq1"), Self::Ord => ("Data.Ord", "Ord"), + Self::Ord1 => ("Data.Ord", "Ord1"), + Self::Newtype => ("Data.Newtype", "Newtype"), + Self::Generic => ("Data.Generic.Rep", "Generic"), Self::Functor => ("Data.Functor", "Functor"), Self::Bifunctor => ("Data.Bifunctor", "Bifunctor"), Self::Contravariant => ("Data.Functor.Contravariant", "Contravariant"), @@ -32,7 +42,11 @@ impl KnownDerivingClass { fn method(self) -> &'static str { match self { Self::Eq => "eq", + Self::Eq1 => "eq1", Self::Ord => "compare", + Self::Ord1 => "compare1", + Self::Newtype => "wrap", + Self::Generic => "to", Self::Functor => "map", Self::Bifunctor => "bimap", Self::Contravariant => "cmap", @@ -57,10 +71,7 @@ impl Checker { self.infer_expr_with_expected(implementation, Some(expected)) } - /// Generates the structural `Eq` method for a local data or newtype type. - /// Field comparisons remain ordinary class-method selections, so explicit - /// instance-context dictionaries and imported instances use the existing - /// evidence solver. + /// Synthesizes the methods of a compiler-supported derived class. pub(super) fn derive_known_class_method( &mut self, class_id: hir::TypeId, @@ -69,15 +80,25 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - if class.parameters.len() != 1 { - return self.deriving_error(span, "known-class deriving requires a unary class"); - } let Some(known_class) = self.known_deriving_class(class_id) else { return self.deriving_error( span, "the known-class deriving rule is unavailable for this class", ); }; + if known_class == KnownDerivingClass::Newtype { + return self.deriving_error(span, "Newtype has no derivable class methods"); + } + if known_class == KnownDerivingClass::Generic { + if !matches!(method.name.as_str(), "to" | "from") { + return self + .deriving_error(span, "Generic derives only its `to` and `from` methods"); + } + return self.derive_generic_method(method, class_arguments, span); + } + if class.parameters.len() != 1 { + return self.deriving_error(span, "known-class deriving requires a unary class"); + } if method.name != known_class.method() { return self.deriving_error( span, @@ -85,162 +106,29 @@ impl Checker { ); } match known_class { + KnownDerivingClass::Eq => self.derive_eq_method(method, class_arguments, span), + KnownDerivingClass::Eq1 => self.derive_eq1_method(method, class_arguments, span), + KnownDerivingClass::Ord => self.derive_ord_method(method, class_arguments, span), + KnownDerivingClass::Ord1 => self.derive_ord1_method(method, class_arguments, span), KnownDerivingClass::Functor => { - return self.derive_functor_method(method, class_arguments, span); + self.derive_functor_method(method, class_arguments, span) } KnownDerivingClass::Bifunctor => { - return self.derive_bifunctor_method(method, class_arguments, span); + self.derive_bifunctor_method(method, class_arguments, span) } KnownDerivingClass::Contravariant => { - return self.derive_contravariant_method(method, class_arguments, span); - } - KnownDerivingClass::Ord => { - return self.derive_ord_method(method, class_arguments, span); + self.derive_contravariant_method(method, class_arguments, span) } - KnownDerivingClass::Eq => {} - } - let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "Eq deriving requires one type argument"); - }; - let instance_type = self.resolve_type(instance_type.clone()); - let (head, arguments) = flatten_spine(&instance_type); - let InferType::Constructor(TypeConstructor::User(type_id)) = head else { - return self.deriving_error( - span, - "Eq deriving requires a local data or newtype constructor", - ); - }; - let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error(span, "cannot find the data declaration to derive Eq"); - }; - if type_id.module != self.env.module_id - || !matches!( - declaration.kind, - hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype - ) - || arguments.len() != declaration.parameters.len() - { - return self.deriving_error( - span, - "Eq deriving requires a locally declared, fully applied data type", - ); - } - - let left = self.fresh_deriving_binder("__derived_left", span); - let right = self.fresh_deriving_binder("__derived_right", span); - let mut left_case_branches = Vec::new(); - for constructor in &declaration.constructors { - let left_fields = constructor - .fields - .iter() - .map(|_| self.fresh_deriving_binder("__derived_l", span)) - .collect::>(); - let right_fields = constructor - .fields - .iter() - .map(|_| self.fresh_deriving_binder("__derived_r", span)) - .collect::>(); - let body = Self::derive_eq_field_tests( - constructor, - &left_fields, - &right_fields, - method.symbol, - span, - ); - let same_constructor = hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol: constructor.symbol, - name_span: constructor.name_span, - arguments: right_fields - .iter() - .cloned() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder), - span, - }) - .collect(), - }, - span, - }, - value: body, - span, - }; - let mismatch = hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Wildcard, - span, - }, - value: boolean_literal(false, span), - span, - }; - let right_case = hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(right.id, span)), - branches: vec![same_constructor, mismatch], - }, - span, - }; - left_case_branches.push(hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol: constructor.symbol, - name_span: constructor.name_span, - arguments: left_fields - .iter() - .cloned() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder), - span, - }) - .collect(), - }, - span, - }, - value: right_case, - span, - }); - } - if left_case_branches.is_empty() { - left_case_branches.push(hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Wildcard, - span, - }, - value: boolean_literal(true, span), - span, - }); + KnownDerivingClass::Newtype => unreachable!("handled above"), + KnownDerivingClass::Generic => unreachable!("handled above"), } - let implementation = hir::Expr { - kind: hir::ExprKind::Lambda { - binder: left.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: right.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(left.id, span)), - branches: left_case_branches, - }, - span, - }), - }, - span, - }), - }, - span, - }; - self.infer_derived_method(method, class_arguments, &implementation) } pub(super) fn validate_known_deriving_class( &mut self, class_id: hir::TypeId, class: &ClassInfo, + head_arguments: &[InferType], span: TextRange, ) -> Option<()> { let Some(known_class) = self.known_deriving_class(class_id) else { @@ -249,28 +137,85 @@ impl Checker { "the known-class deriving rule is unavailable for this class", ); }; - if class.parameters.len() != 1 { - return self.deriving_error(span, "known-class deriving requires a unary class"); + let expected_arity = match known_class { + KnownDerivingClass::Newtype | KnownDerivingClass::Generic => 2, + _ => 1, + }; + if class.parameters.len() != expected_arity || head_arguments.len() != expected_arity { + return self.deriving_error( + span, + "known-class deriving requires the class's supported parameter arity", + ); } - if !class - .methods - .iter() - .any(|method| method.name == known_class.method()) - { + let has_required_methods = match known_class { + KnownDerivingClass::Newtype => class.methods.is_empty(), + KnownDerivingClass::Generic => ["to", "from"] + .iter() + .all(|name| class.methods.iter().any(|method| method.name == *name)), + _ => class + .methods + .iter() + .any(|method| method.name == known_class.method()), + }; + if !has_required_methods { return self.deriving_error( span, "the class is missing the method required by its known deriving rule", ); } + if known_class == KnownDerivingClass::Newtype { + let underlying = self.newtype_underlying_type(&head_arguments[..1], span)?; + let errors_before = self.state.errors.len(); + self.unify(head_arguments[1].clone(), underlying, span); + if self.state.errors.len() != errors_before { + return None; + } + } + if known_class == KnownDerivingClass::Generic { + let representation = self.generic_representation(&head_arguments[0], span)?; + let errors_before = self.state.errors.len(); + self.unify(head_arguments[1].clone(), representation, span); + if self.state.errors.len() != errors_before { + return None; + } + } Some(()) } + fn known_method_symbol( + &self, + module_name: &str, + class_name: &str, + method_name: &str, + ) -> Option { + let class_id = self.env.type_names.iter().find_map(|(class_id, name)| { + (name == class_name + && self + .env + .type_modules + .get(class_id) + .is_some_and(|module| module == module_name)) + .then_some(*class_id) + })?; + self.env + .classes + .get(&class_id)? + .methods + .iter() + .find(|method| method.name == method_name) + .map(|method| method.symbol) + } + fn known_deriving_class(&self, class_id: hir::TypeId) -> Option { let module = self.env.type_modules.get(&class_id)?.as_str(); let name = self.env.type_names.get(&class_id)?.as_str(); [ KnownDerivingClass::Eq, + KnownDerivingClass::Eq1, KnownDerivingClass::Ord, + KnownDerivingClass::Ord1, + KnownDerivingClass::Newtype, + KnownDerivingClass::Generic, KnownDerivingClass::Functor, KnownDerivingClass::Bifunctor, KnownDerivingClass::Contravariant, @@ -279,40 +224,6 @@ impl Checker { .find(|known| known.identity() == (module, name)) } - fn derive_eq_field_tests( - constructor: &hir::Constructor, - left_fields: &[hir::LocalBinder], - right_fields: &[hir::LocalBinder], - eq_method: SymbolId, - span: TextRange, - ) -> hir::Expr { - let tests = constructor - .fields - .iter() - .zip(left_fields) - .zip(right_fields) - .map(|((_field, left), right)| { - let method = global_expr(eq_method, span); - apply_expr( - apply_expr(method, local_expr(left.id, span), span), - local_expr(right.id, span), - span, - ) - }) - .collect::>(); - tests - .into_iter() - .rev() - .fold(boolean_literal(true, span), |rest, test| hir::Expr { - kind: hir::ExprKind::If { - condition: Box::new(test), - then_branch: Box::new(rest), - else_branch: Box::new(boolean_literal(false, span)), - }, - span, - }) - } - fn fresh_deriving_local(&mut self, prefix: &str, span: TextRange) -> hir::LocalBinder { let id = LocalId(self.state.next_dictionary_local); self.state.next_dictionary_local += 1; diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs index 8ca1b091..487924d6 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs @@ -74,12 +74,16 @@ impl Checker { ty: underlying_method_type.clone(), span, }; - self.adapt_newtype_method( - selected_method, - underlying_method_type, - derived_method_type, - span, - ) + let mut method_foralls = Vec::new(); + leading_forall_variables(&derived_method_type, &mut method_foralls); + self.with_skolem_scope(&method_foralls, |checker| { + checker.adapt_newtype_method( + selected_method, + underlying_method_type, + derived_method_type, + span, + ) + }) } pub(in crate::typecheck::classes) fn validate_newtype_deriving_instance( @@ -90,7 +94,7 @@ impl Checker { self.newtype_underlying_type(class_arguments, span) } - fn newtype_underlying_type( + pub(super) fn newtype_underlying_type( &mut self, class_arguments: &[InferType], span: TextRange, @@ -310,3 +314,17 @@ fn strip_newtype_arguments( } Some(ty) } + +fn leading_forall_variables(ty: &InferType, variables: &mut Vec) { + match ty { + InferType::ForAll { + variables: binders, + body, + } => { + variables.extend(binders); + leading_forall_variables(body, variables); + } + InferType::Constrained { body, .. } => leading_forall_variables(body, variables), + _ => {} + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs index a3b709d4..ed7689c7 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs @@ -16,6 +16,29 @@ impl Checker { method: &MethodInfo, class_arguments: &[InferType], span: TextRange, + ) -> Option { + self.derive_ord_method_using(method, class_arguments, method.symbol, false, span) + } + + pub(super) fn derive_ord1_method( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + let Some(compare_method) = self.known_method_symbol("Data.Ord", "Ord", "compare") else { + return self.deriving_error(span, "cannot find the Ord method for Ord1 deriving"); + }; + self.derive_ord_method_using(method, class_arguments, compare_method, true, span) + } + + fn derive_ord_method_using( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + compare_method: SymbolId, + higher_kinded: bool, + span: TextRange, ) -> Option { let Some(instance_type) = class_arguments.first() else { return self.deriving_error(span, "Ord deriving requires one type argument"); @@ -31,16 +54,25 @@ impl Checker { let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { return self.deriving_error(span, "cannot find the data declaration to derive Ord"); }; + let expected_arguments = + declaration + .parameters + .len() + .checked_sub(if higher_kinded { 1 } else { 0 }); if type_id.module != self.env.module_id || !matches!( declaration.kind, hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype ) - || arguments.len() != declaration.parameters.len() + || expected_arguments != Some(arguments.len()) { return self.deriving_error( span, - "Ord deriving requires a locally declared, fully applied data type", + if higher_kinded { + "Ord1 deriving requires a locally declared type constructor with one final parameter" + } else { + "Ord deriving requires a locally declared, fully applied data type" + }, ); } let Some(ordering_id) = ordering_result_id(&method.signature) else { @@ -65,7 +97,7 @@ impl Checker { let left = self.fresh_deriving_binder("__derived_left", span); let right = self.fresh_deriving_binder("__derived_right", span); let field_context = OrdFieldContext { - method: method.symbol, + method: compare_method, less, equal, greater, diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/types.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/types.rs index 13b431a2..3242288e 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/types.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/types.rs @@ -14,6 +14,9 @@ impl Checker { /// `TypeChecker.checkTypeClassInstance` with `InvalidInstanceHead`; see /// `failing/TypeWildcards3.purs`. A wildcard in an instance *context* is a /// different matter and stays legal, as `passing/WildcardInInstance.purs` needs. +/// The compiler's known `Newtype` and `Generic` derivations also accept one +/// final wildcard: the wrapped field or generated representation determines +/// that class argument. pub(crate) fn contains_wildcard(ty: &hir::Type) -> bool { match &ty.kind { hir::TypeKind::Wildcard => true, diff --git a/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs index 2fc2e075..afc38ef3 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs @@ -1,6 +1,7 @@ use super::super::signature::flatten_spine; use super::super::*; use super::deriving::contains_wildcard; +use super::fundeps::collect_infer_variables; mod method; use method::validate_method_signature; @@ -242,7 +243,41 @@ impl Checker { return; } let (_, arguments) = flatten_spine(&instance.head); - if local && arguments.iter().any(|argument| contains_wildcard(argument)) { + let newtype_deriving_wildcard = local + && instance.derivation == Some(hir::DerivationStrategy::KnownClass) + && self + .env + .type_modules + .get(&instance.class_id) + .is_some_and(|module| module == "Data.Newtype") + && self + .env + .type_names + .get(&instance.class_id) + .is_some_and(|name| name == "Newtype") + && arguments.len() == 2 + && !contains_wildcard(arguments[0]) + && matches!(arguments[1].kind, hir::TypeKind::Wildcard); + let generic_deriving_wildcard = local + && instance.derivation == Some(hir::DerivationStrategy::KnownClass) + && self + .env + .type_modules + .get(&instance.class_id) + .is_some_and(|module| module == "Data.Generic.Rep") + && self + .env + .type_names + .get(&instance.class_id) + .is_some_and(|name| name == "Generic") + && arguments.len() == 2 + && !contains_wildcard(arguments[0]) + && matches!(arguments[1].kind, hir::TypeKind::Wildcard); + let has_unsupported_wildcard = arguments.iter().enumerate().any(|(index, argument)| { + contains_wildcard(argument) + && !((newtype_deriving_wildcard || generic_deriving_wildcard) && index == 1) + }); + if local && has_unsupported_wildcard { self.state.errors.push(TypeCheckError::new( TypeCheckErrorKind::InvalidInstanceHead, instance.head.span, @@ -265,7 +300,6 @@ impl Checker { .iter() .map(|argument| self.elaborate_type(argument, &mut variables)) .collect::>(); - let head_variable_types = variables.clone(); let mut context = Vec::with_capacity(instance.context.len()); let mut context_parameters = Vec::with_capacity(instance.context.len()); let mut valid = true; @@ -286,13 +320,21 @@ impl Checker { if !valid { return; } + let instance_variables = variables.clone(); if local { let head_names = head_variables(&arguments); + let determined = + instance_context_determined_variables(&self.env.classes, &context, &head_arguments); for constraint in &instance.context { let mut used = Vec::new(); collect_variables(constraint, &mut used); for name in used { - if !head_names.contains(&name) { + let determined_by_fundep = variables.get(&name).is_some_and(|ty| { + let mut variables = HashSet::new(); + collect_infer_variables(ty, &mut variables); + !variables.is_empty() && variables.is_subset(&determined) + }); + if !head_names.contains(&name) && !determined_by_fundep { self.state.errors.push(TypeCheckError::new( TypeCheckErrorKind::UnsupportedClass, constraint.span, @@ -312,13 +354,62 @@ impl Checker { chain_id: instance.chain_id, chain_position: instance.chain_position, head_arguments, - head_variables: head_variable_types, + instance_variables, context, context_parameters, }); } } +/// The head arguments determine their own variables, and class functional +/// dependencies may determine additional variables in instance contexts. Take +/// the closure across context constraints so chained dependencies work too. +fn instance_context_determined_variables( + classes: &HashMap, + context: &[ClassConstraint], + head_arguments: &[InferType], +) -> HashSet { + let mut determined = HashSet::new(); + for argument in head_arguments { + collect_infer_variables(argument, &mut determined); + } + loop { + let mut changed = false; + for constraint in context { + let Some(class) = classes.get(&constraint.class_id) else { + continue; + }; + for fundep in &class.fundeps { + let determining = fundep + .determining + .iter() + .filter_map(|&index| constraint.arguments.get(index)) + .flat_map(|argument| { + let mut variables = HashSet::new(); + collect_infer_variables(argument, &mut variables); + variables + }) + .collect::>(); + if !determining.is_subset(&determined) { + continue; + } + for &index in &fundep.determined { + if let Some(argument) = constraint.arguments.get(index) { + let mut variables = HashSet::new(); + collect_infer_variables(argument, &mut variables); + for variable in variables { + changed |= determined.insert(variable); + } + } + } + } + } + if !changed { + return determined; + } + } +} + /// Depth-first search for a superclass cycle through `classes`. fn superclass_cycle( id: hir::TypeId, diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps.rs index 1b302772..743c64b1 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps.rs @@ -1,5 +1,6 @@ use super::super::unify::substitute; use super::super::*; +use std::collections::HashMap; /// Functional-dependency improvement and ambiguity checking for wanted /// constraints. Improvement assigns only the positions a dependency determines @@ -230,6 +231,17 @@ impl Checker { if start == self.state.wanted.len() { return; } + let solutions = self + .state + .wanted + .iter() + .filter_map(|constraint| { + constraint + .solution + .clone() + .map(|solution| (constraint.id, solution)) + }) + .collect::>(); let mut determined = HashSet::new(); collect_infer_variables(&self.resolve_type(result.clone()), &mut determined); self.fundep_determined(&self.state.wanted[start..], &mut determined); @@ -237,19 +249,16 @@ impl Checker { if constraint.solution.is_none() { continue; } - // A wanted discharged directly from a lexical dictionary is - // already determined by that dictionary's scope. This commonly - // occurs inside a rank-N method body, where the skolem appears in - // the wanted but intentionally does not escape through the - // method's result type. Do not apply this exemption to an - // instance dictionary merely because one of its context - // constraints comes from a given: the instance head itself may - // still contain an ambiguous variable. - if constraint - .solution - .as_ref() - .is_some_and(solution_uses_lexical_given) - { + // A wanted discharged using a lexical dictionary, directly or + // through the context of a selected instance, is determined by + // that dictionary's scope. This commonly occurs inside a rank-N + // method body, where the skolem appears in the wanted but + // intentionally does not escape through the enclosing instance's + // result type. A context-free instance does not provide this + // evidence: its head may still contain an ambiguous variable. + if constraint.solution.as_ref().is_some_and(|solution| { + solution_uses_lexical_given(solution, &solutions, &mut HashSet::new()) + }) { continue; } let mut variables = HashSet::new(); @@ -258,6 +267,11 @@ impl Checker { } let ambiguous = variables .difference(&determined) + // A rigid variable belongs to an enclosing forall or given + // scope. Its obligation is checked at that use site and does + // not become an unconstrained variable of the declaration + // currently discharging the worklist. + .filter(|variable| !self.state.rigid.contains(variable)) .copied() .collect::>(); if ambiguous.is_empty() { @@ -394,23 +408,73 @@ impl Checker { } } -fn solution_uses_lexical_given(solution: &WantedSolution) -> bool { +fn solution_uses_lexical_given( + solution: &WantedSolution, + solutions: &HashMap, + visited: &mut HashSet, +) -> bool { match solution { WantedSolution::Given(_) => true, WantedSolution::Superclass { parent, .. } => parent .solution .as_ref() - .is_some_and(solution_uses_lexical_given), + .is_some_and(|solution| solution_uses_lexical_given(solution, solutions, visited)), + WantedSolution::Instance { context, .. } => context.iter().any(|id| { + if !visited.insert(*id) { + return false; + } + let uses_given = solutions + .get(id) + .is_some_and(|solution| solution_uses_lexical_given(solution, solutions, visited)); + visited.remove(id); + uses_given + }), // An abstracted dictionary is a parameter of the declaration itself, so // it determines nothing the result type and the dependencies do not. WantedSolution::Global(_) - | WantedSolution::Instance { .. } | WantedSolution::Abstracted(_) | WantedSolution::Coercible { .. } | WantedSolution::Primitive { .. } => false, } } +#[cfg(test)] +mod tests { + use super::*; + use psrs_hir::{LocalId, ModuleId, SymbolId}; + + #[test] + fn instance_context_using_a_given_determines_its_rank_n_wanted() { + let selected = WantedSolution::Instance { + constructor: SymbolId::new(ModuleId(0), 1), + constructor_type: InferType::Variable(0), + context: vec![7], + }; + let solutions = HashMap::from([(7, WantedSolution::Given(LocalId(2)))]); + + assert!(solution_uses_lexical_given( + &selected, + &solutions, + &mut HashSet::new() + )); + } + + #[test] + fn context_free_instance_does_not_determine_its_wanted_variables() { + let selected = WantedSolution::Instance { + constructor: SymbolId::new(ModuleId(0), 1), + constructor_type: InferType::Variable(0), + context: Vec::new(), + }; + + assert!(!solution_uses_lexical_given( + &selected, + &HashMap::new(), + &mut HashSet::new() + )); + } +} + /// The inference variables used anywhere in a type. pub(in crate::typecheck) fn collect_infer_variables(ty: &InferType, out: &mut HashSet) { match ty { diff --git a/crates/psrs-typecheck/src/typecheck/classes/instance.rs b/crates/psrs-typecheck/src/typecheck/classes/instance.rs index ef7a0781..0531788b 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/instance.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/instance.rs @@ -21,7 +21,7 @@ impl Checker { instance: &hir::InstanceDeclaration, ) -> Option { let class = self.env.classes.get(&instance.class_id).cloned()?; - let (head_arguments, head_variables, context, context_parameters) = { + let (head_arguments, instance_variables, context, context_parameters) = { let info = self .env .instances @@ -29,7 +29,7 @@ impl Checker { .find(|info| info.symbol == instance.symbol)?; ( info.head_arguments.clone(), - info.head_variables.clone(), + info.instance_variables.clone(), info.context.clone(), info.context_parameters.clone(), ) @@ -53,7 +53,12 @@ impl Checker { } let derived_newtype_underlying = match instance.derivation { Some(hir::DerivationStrategy::KnownClass) => { - self.validate_known_deriving_class(instance.class_id, &class, instance.span)?; + self.validate_known_deriving_class( + instance.class_id, + &class, + &head_arguments, + instance.span, + )?; None } Some(hir::DerivationStrategy::Newtype) => { @@ -116,9 +121,9 @@ impl Checker { Some(member) => { let mut method_variables = variables.clone(); let expected = self.elaborate_type(&method.signature, &mut method_variables); - let head_variables = head_variables.clone(); + let annotation_variables = instance_variables.clone(); let value = self.with_scope(|checker| { - checker.scope.annotation_variables = head_variables; + checker.scope.annotation_variables = annotation_variables; checker.in_nested_level(|checker| { checker.infer_expr_with_expected(&member.value, Some(expected)) }) @@ -200,8 +205,18 @@ impl Checker { ); // An instance head may contain type variables (for example a // `ToInt (Array a)` head); generalize the dictionary constructor over - // them so the declaration is polymorphic in the head variables. - let scheme = self.generalize(&[], &value.ty, &[], TOP_LEVEL); + // them so the declaration is polymorphic in the head variables. Keep + // variables that only occur in erased evidence too: a `Coercible` + // superclass proof still needs them while its type is finalized. + let mut head_variables = HashSet::new(); + for variable in instance_variables.values() { + super::fundeps::collect_infer_variables( + &self.resolve_type(variable.clone()), + &mut head_variables, + ); + } + let head_variables = head_variables.into_iter().collect::>(); + let scheme = self.generalize_instance_dictionary(&head_variables, &value.ty); Some(InferredDeclaration { symbol: instance.symbol, name: instance.name.clone(), diff --git a/crates/psrs-typecheck/src/typecheck/entry.rs b/crates/psrs-typecheck/src/typecheck/entry.rs index 06643a04..a3aa7c8e 100644 --- a/crates/psrs-typecheck/src/typecheck/entry.rs +++ b/crates/psrs-typecheck/src/typecheck/entry.rs @@ -160,7 +160,6 @@ pub fn typecheck_module_with_checked_kinds_and_module_names_and_warnings( return Err(checker.state.errors); } let inferred = inferred.into_iter().flatten().collect::>(); - let mut types = TypeInterner::default(); let mut generics = checker.state.generic_variables.clone(); let external_types = module diff --git a/crates/psrs-typecheck/src/typecheck/generalize.rs b/crates/psrs-typecheck/src/typecheck/generalize.rs index 4d509f95..d96633d2 100644 --- a/crates/psrs-typecheck/src/typecheck/generalize.rs +++ b/crates/psrs-typecheck/src/typecheck/generalize.rs @@ -47,6 +47,24 @@ impl Checker { self.scheme(variables, constraints.to_vec(), resolved) } + /// Generalizes an instance dictionary over every variable in its head, + /// including variables erased from the runtime dictionary shape. Compiler + /// evidence such as `Coercible (Additive a) a` still mentions those + /// variables while the dictionary constructor is checked and finalized. + pub(in crate::typecheck) fn generalize_instance_dictionary( + &mut self, + head_variables: &[u32], + ty: &InferType, + ) -> Scheme { + // Instance head variables belong to the dictionary constructor even if + // the runtime dictionary erases them. Its compile-time evidence still + // mentions them, so retain them alongside variables in the value type. + let inferred = self.generalize(&[], ty, &[], TOP_LEVEL); + let mut variables = inferred.variables; + variables.extend(head_variables.iter().copied()); + self.scheme(variables, inferred.constraints, inferred.ty) + } + /// The scheme a declaration exposes to the uses inside its binding group: the /// type its signature states, with that signature's `forall` binders /// quantified. A recursive use instantiates it, so a signature's diff --git a/crates/psrs-typecheck/src/typecheck/infer/construct.rs b/crates/psrs-typecheck/src/typecheck/infer/construct.rs index 05f2c305..5d961643 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/construct.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/construct.rs @@ -44,9 +44,7 @@ impl Checker { .map(|declaration| (declaration.id, module.name.clone())) .collect::>(); for declaration in known_types { - if declaration.kind == hir::TypeDeclarationKind::Class - && let Some(name) = module_names.get(&declaration.id.module) - { + if let Some(name) = module_names.get(&declaration.id.module) { type_modules.insert(declaration.id, name.clone()); } } diff --git a/crates/psrs-typecheck/src/typecheck/order.rs b/crates/psrs-typecheck/src/typecheck/order.rs index 8486cfc1..3bcf6e95 100644 --- a/crates/psrs-typecheck/src/typecheck/order.rs +++ b/crates/psrs-typecheck/src/typecheck/order.rs @@ -97,7 +97,12 @@ fn collect_globals(expression: &hir::Expr, out: &mut Vec) { operands, operators, } => { - out.extend(operators.iter().map(|operator| operator.symbol)); + out.extend( + operators + .iter() + .filter(|operator| operator.local.is_none()) + .map(|operator| operator.symbol), + ); for operand in operands { collect_globals(operand, out); } @@ -105,7 +110,9 @@ fn collect_globals(expression: &hir::Expr, out: &mut Vec) { hir::ExprKind::OperatorSection { operator, operand, .. } => { - out.push(operator.symbol); + if operator.local.is_none() { + out.push(operator.symbol); + } collect_globals(operand, out); } hir::ExprKind::Application(function, argument) => { diff --git a/crates/psrs-typecheck/src/typecheck/prim/coercible/givens.rs b/crates/psrs-typecheck/src/typecheck/prim/coercible/givens.rs index 84613420..f78b5033 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/coercible/givens.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/coercible/givens.rs @@ -8,18 +8,40 @@ impl Checker { let mut direct = Vec::new(); let mut edges = Vec::new(); let mut relations = Vec::new(); - for (given, _) in &self.scope.givens { - if given.class_id != hir::TypeId::COERCIBLE || given.arguments.len() != 2 { + let mut pending = self + .scope + .givens + .iter() + .map(|(given, _)| (given.class_id, given.arguments.clone())) + .collect::>(); + let mut visited: Vec<(hir::TypeId, Vec)> = Vec::new(); + while let Some((class_id, arguments)) = pending.pop() { + if visited.iter().any(|(seen_class, seen_arguments)| { + *seen_class == class_id + && seen_arguments.len() == arguments.len() + && seen_arguments + .iter() + .zip(&arguments) + .all(|(seen, current)| self.infer_types_equal(seen, current)) + }) { continue; } - let left = self.resolve_type(given.arguments[0].clone()); - let right = self.resolve_type(given.arguments[1].clone()); - add_edge(&mut edges, left.clone(), right.clone(), self); - add_edge(&mut edges, right.clone(), left.clone(), self); - direct.push((left.clone(), right.clone())); - if let Some(canonical) = self.canonical_given(&left, &right) { - push_relation(&mut relations, canonical, self); + visited.push((class_id, arguments.clone())); + if class_id == hir::TypeId::COERCIBLE && arguments.len() == 2 { + let left = self.resolve_type(arguments[0].clone()); + let right = self.resolve_type(arguments[1].clone()); + add_edge(&mut edges, left.clone(), right.clone(), self); + add_edge(&mut edges, right.clone(), left.clone(), self); + direct.push((left.clone(), right.clone())); + if let Some(canonical) = self.canonical_given(&left, &right) { + push_relation(&mut relations, canonical, self); + } } + pending.extend( + self.superclass_constraints(class_id, &arguments) + .into_iter() + .map(|(_, constraint)| (constraint.class_id, constraint.arguments)), + ); } // A given can discharge its exact relation (in either direction), and diff --git a/crates/psrs-typecheck/src/typecheck/prim/coercible/mod.rs b/crates/psrs-typecheck/src/typecheck/prim/coercible/mod.rs index 3b838962..1ed4ec98 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/coercible/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/coercible/mod.rs @@ -81,10 +81,45 @@ impl Checker { } let source = self.resolve_type(source.clone()); let target = self.resolve_type(target.clone()); + // Reflexivity does not depend on learning a kind: identical types + // necessarily have the same representation, even while their kind is + // still being inferred. + if self.infer_types_equal(&source, &target) { + return true; + } + // A constrained function is represented as one dictionary argument per + // constraint followed by its body. When the constraints are identical, + // the dictionary prefix has the same representation on both sides and + // the body can be checked using the ordinary coercion rules. + if let ( + InferType::Constrained { + constraints: source_constraints, + body: source_body, + }, + InferType::Constrained { + constraints: target_constraints, + body: target_body, + }, + ) = (&source, &target) + { + if !constraints_equal(source_constraints, target_constraints, self) { + // Constraints are part of the representation prefix, so + // different dictionaries cannot be skipped. + return false; + } + let mut nested = path.clone(); + return self.proves_coercible_inner( + source_body, + target_body, + span, + depth + 1, + &mut nested, + ); + } if !self.coercion_kinds_compatible(&source, &target, span) { return false; } - if self.infer_types_equal(&source, &target) || self.given_coercible(&source, &target) { + if self.given_coercible(&source, &target) { return true; } match (&source, &target) { @@ -238,6 +273,23 @@ impl Checker { } } +fn constraints_equal( + left: &[ClassConstraint], + right: &[ClassConstraint], + checker: &Checker, +) -> bool { + left.len() == right.len() + && left.iter().zip(right).all(|(left, right)| { + left.class_id == right.class_id + && left.arguments.len() == right.arguments.len() + && left + .arguments + .iter() + .zip(&right.arguments) + .all(|(left, right)| checker.infer_types_equal(left, right)) + }) +} + pub(super) fn flatten_infer_spine(ty: &InferType) -> (&InferType, Vec) { let mut head = ty; let mut arguments = Vec::new(); diff --git a/crates/psrs-typecheck/src/typecheck/state.rs b/crates/psrs-typecheck/src/typecheck/state.rs index 9625be0d..c1c8b193 100644 --- a/crates/psrs-typecheck/src/typecheck/state.rs +++ b/crates/psrs-typecheck/src/typecheck/state.rs @@ -209,9 +209,10 @@ impl Checker { } } - /// Runs `f` with `givens` as the given evidence in scope, and restores what - /// leaving the scope restores: the givens, the rigid variables their - /// arguments added, and the given-rigid record that tracks them. + /// Runs `f` with `givens` added to the enclosing given evidence, and + /// restores what leaving the scope restores: the givens, the rigid + /// variables their arguments added, and the given-rigid record that tracks + /// them. /// /// A given's variables are rigid only while the given is in scope, which is /// why this is not [`Self::with_skolem_scope`]: a skolem outlives its scope, @@ -221,10 +222,11 @@ impl Checker { givens: Vec<(ClassConstraint, WantedSolution)>, f: impl FnOnce(&mut Self) -> T, ) -> T { - let previous_givens = std::mem::replace(&mut self.scope.givens, givens); + let previous_givens = self.scope.givens.clone(); + self.scope.givens.extend(givens); let previous_rigid = self.state.rigid.clone(); let previous_given_rigid = std::mem::take(&mut self.scope.given_rigid); - for (constraint, _) in self.scope.givens.clone() { + for (constraint, _) in self.scope.givens[previous_givens.len()..].to_vec() { for argument in &constraint.arguments { let mut variables = HashSet::new(); classes::collect_infer_variables(argument, &mut variables); diff --git a/crates/psrs-typecheck/src/typecheck/vocabulary.rs b/crates/psrs-typecheck/src/typecheck/vocabulary.rs index 0585330c..424aac48 100644 --- a/crates/psrs-typecheck/src/typecheck/vocabulary.rs +++ b/crates/psrs-typecheck/src/typecheck/vocabulary.rs @@ -103,7 +103,10 @@ pub(super) struct InstanceInfo { pub(super) chain_id: u32, pub(super) chain_position: u32, pub(super) head_arguments: Vec, - pub(super) head_variables: HashMap, + /// Every type variable shared by the instance head and context. Context + /// variables determined through fundeps still need one identity in method + /// bodies and their type annotations. + pub(super) instance_variables: HashMap, pub(super) context: Vec, pub(super) context_parameters: Vec<(LocalId, InferType)>, } diff --git a/docs/decision/DEC-13-wit-to-source-type-mapping.md b/docs/decision/DEC-13-wit-to-source-type-mapping.md index a9e380cc..0e578356 100644 --- a/docs/decision/DEC-13-wit-to-source-type-mapping.md +++ b/docs/decision/DEC-13-wit-to-source-type-mapping.md @@ -23,8 +23,11 @@ interfaces already require them: `result, error-code>`. PureScript already has idiomatic, common types for every one of these forms. -No new compiler type vocabulary is required: records (the frontend already treats a tuple as a closed record, FE-06), `Data.Maybe.Maybe`, `Data.Either.Either`, and -ordinary user data types. The functional shape of WIT maps directly onto them. +Native tuple syntax is a closed record (FE-06). The core library's +`Data.Tuple.Tuple` is an ordinary algebraic data type with a `Tuple` data +constructor; it is a separate library type. WIT tuples map to the closed-record +form so the ABI mapping remains structural and does not depend on importing +`Data.Tuple`. ## Decision @@ -70,6 +73,10 @@ source field is `Unit`. There is no `Unit`/trap special case: a unit-success type, the linking stage interns it and validates it against the WIT descriptor, CC derives the layout, and MIR lowers from the CC signature and the descriptor. `SourceType` is not reintroduced. +- FE-06 native tuple syntax and `Data.Tuple.Tuple` remain separate source forms: + `(a, b)` is the closed record `{ _1 :: a, _2 :: b }`, while `Tuple a b` is the + library ADT. This decision does not add a compiler tuple type or make the two + source forms interchangeable. - DEC-11's mechanism clause ("do not grow `SourceType`"; "do not recognize `Maybe`/`Either`/tuples") is superseded by this decision. DEC-11's two-layer rule stands: the standard library wraps foreign imports in ordinary @@ -92,14 +99,10 @@ source field is `Unit`. There is no `Unit`/trap special case: a unit-success Rejected alternatives: -- **Compiler builtins for `Maybe`, `Either`, or tuples.** The library types are - the idiomatic ones; a builtin would duplicate them and force a name on user - code. +- **Compiler builtins for `Maybe` or `Either`.** The library types are the + idiomatic ones; a builtin would duplicate them and force a name on user code. - **A dedicated WIT aggregate type in the compiler.** Reintroduces the vocabulary DEC-12 removed. - **Structural recognition of any two-case ADT by constructor shape.** Two unrelated ADTs would be treated as `option`/`result`; recognition is by the named library type instead. -- **A project-specific encoding of tuples as anything other than a record.** - FE-06 already fixes a tuple as `{ _1, _2, ... }`. - diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index d47cdbfc..7c513355 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -390,6 +390,13 @@ fails, and a type synonym for the record fails identically. Changing the argumen shape would change the API the corpus calls, so the two functions stay out and the defect is filed as #137. That leaves 2 `passing` cases blocked on them. +**Latest full-board remeasurement (2026-10-04, annotations oracle):** M2 +failing agreement is **71/72**; `failing/ConflictingQualifiedImports2.purs` +expects `ScopeConflict` but produces `ExportConflict`. Passing modules resolve +in **386/413** cases; the other 27 stop at P3 (23) or P0 (4). Nineteen sibling +modules load successfully, and no case is blocked because the loader cannot use +an imported sibling. + ### M3 — Kinds and higher-kinded types - **Suite:** `KindsDoNotUnify` (24), `PartiallyAppliedSynonym` (12), @@ -422,15 +429,11 @@ environment, which owns `ClassInstanceArityMismatch`. The driver exposes a lenient kind check and the `l3` scoreboard; the scoreboard also runs against the vendored corpus without `purs`. -**Measured current result (annotations oracle, 2026-10-04):** M3 failing -agreement is **35/48**. Per code: `CycleInKindDeclaration` 2/2, -`InfiniteKind` 2/2, `CycleInTypeSynonym` 3/4, `UndefinedTypeVariable` 3/4, -`PartiallyAppliedSynonym` 10/12, and `KindsDoNotUnify` 15/24. Thirteen expected -diagnostics still differ: some are blocked by absent cross-module libraries -such as `Data.Foldable`, `Data.Newtype`, `Effect.Console`, `Safe.Coerce`, or -`Prim.*`; the rest need kind checking in expressions, polykinded instantiation, -type-level row functions, or local scoped variables. The scoreboard output records -each case. +**Measured current result (2026-10-04, remeasured with the full boards):** M3 +failing agreement is **39/48**. Per code: `CycleInKindDeclaration` 2/2, +`InfiniteKind` 2/2, `CycleInTypeSynonym` 4/4, `UndefinedTypeVariable` 3/4, +`PartiallyAppliedSynonym` 12/12, and `KindsDoNotUnify` 16/24. The scoreboard +output records each remaining mismatch. `failing/DiffKindsSameName.purs` now agrees, and it is the case the single program-level environment was for: kind checking ran twice before, a program-level pass whose diagnostics were discarded and a per-module pass that gave an imported @@ -470,13 +473,13 @@ measurable until Phase 3 provides those modules. - **Acceptance:** Agreement on the `errorCode`s above. - **Prerequisite:** M3 and M6. -**Measured current result (2026-10-04, annotations oracle):** **35/50** failing -cases agree, per code: `TypesDoNotUnify` 32/41, `IntOutOfRange` 1/1, -`InfiniteType` 2/2, `CannotApplyExpressionOfTypeOnType` 1/2, `EscapedSkolem` -0/2, `ExpectedType` 0/2, and `AmbiguousTypeVariables` 0/1. `HoleInferredType` -has no mapped kind and contributes no case. The `<>` slice moves the aggregate -from 34/50: the cases that `<>` unblocked now reach type checking, and -`TypesDoNotUnify` rises from 29/41 to 32/41 as three of them report that code. +**Measured current result (2026-10-04, remeasured with the full boards):** +**39/50** failing cases agree. The scoreboard's aggregate and per-code counts +disagree by one case, so this remeasurement does not publish a per-code +decomposition. `HoleInferredType` has no mapped kind and contributes no case. +The `<>` slice moved the aggregate from 34/50: the cases that `<>` unblocked +now reach type checking, and `TypesDoNotUnify` rose from 29/41 to 32/41 as +three of them reported that code. #87 moves M4 from 30/47 to 32/50. The denominator grew by three because the visible type application files now reach type checking instead of stopping at P2, @@ -502,7 +505,7 @@ That change moved no count, which is the point worth keeping: `30/47` was true before it and true after it, and the board cannot distinguish a case that agrees because the compiler is right from one that agrees because a defect happened to emit the right code. Read the aggregate as a floor on agreement, not as -agreement. The current result is 35/50, and the same caution applies to it. +agreement. The later 35/50 measurement had the same limitation. The aggregate counts distinct cases, while per-code totals count expected annotations: `failing/MultipleErrors.purs` declares `TypesDoNotUnify` twice, so @@ -577,13 +580,13 @@ obligation to FE-13, and accepted mismatches still need type-checking fixes. - **Acceptance:** Agreement on the `errorCode`s above. - **Prerequisite:** M4. -**Measured current result (2026-10-04, annotations oracle, remeasured with the -Effect-entry run):** **53/80** failing cases agree. An earlier headline said -53/84; the per-code totals sum to 80, and this run confirms 80. Per-code agreement is -`OverlappingInstances` 8/8, `NoInstanceFound` 41/52, `MissingClassMember` 2/2, -`DuplicateInstance` 1/1, `InvalidInstanceHead` 1/5, and 0 for -`PossiblyInfiniteInstance` (1), `OrphanInstance` (6), `InvalidNewtypeInstance` -(1), `DuplicateTypeClass` (1), and `CannotDeriveInvalidConstructorArg` (7). +**Measured current result (2026-10-04, remeasured with the full boards):** +**58/81** failing cases agree. Per-code agreement is `OverlappingInstances` +8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, `DuplicateInstance` +1/1, `InvalidInstanceHead` 1/7, and 0 for `PossiblyInfiniteInstance` (1), +`OrphanInstance` (7), `DuplicateTypeClass` (1), and +`CannotDeriveInvalidConstructorArg` (1). `InvalidNewtypeInstance` and +`ClassInstanceArityMismatch` are no longer in this board. The historical 51/92 figure below predates `Eq`/`Ord`/`Semiring` and this slice; the 84 is the set of cases whose annotations are entirely M5 codes on this tree. The `<>` slice raises `NoInstanceFound` @@ -718,13 +721,14 @@ the code reference and an immutable capture array. file. - **Prerequisite:** M2–M6. -**Progress (measured by `runtime::l6_runtime_scoreboard`):** **124 of 413** -non-FFI `passing` files compile, validate, and run, with 26 excluded as FFI. -All 124 exit 0 and print a first stdout line. They are the same 124 files whose -previous first blocker was a `main` that was not a zero-argument `Int`. The 63 -files with no selected `main` stay blocked at P10. This measurement does not -emit an empty main and does not change the 413 denominator. The board compiles -each case with the on-disk standard library on the module path. Separate +**Progress (measured by `runtime::l6_runtime_scoreboard`):** **164 of 413** +non-FFI `passing` files compile, validate, and run; all exit 0. Twenty-six FFI +files are excluded. Of the other 249 cases, 230 block before runtime and 19 +trap while running. The largest current blockers are P5 typechecking (68), P10 +files with no selected `main` (46), P8 CC verification (30), and P3 resolution +(23). This measurement does not emit an empty main or change the 413 denominator. +The board compiles each case with the on-disk standard library on the module +path. Separate vertical execution tests run under mandatory Wasmtime for GC strings, arrays, closed records, erased newtypes, parameterized ADTs, closures, dictionaries, effects, the component path, and pattern-matrix behavior including the @@ -739,14 +743,29 @@ failure must reach the guest as a trap to be visible, which is the only execution signal the corpus can express. Nothing in the corpus needs argv, stdin, or a preopened directory, so the runner passes none. -The 289 rejections, by the first phase that blocks them. The current figures come -from one `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` run of all five boards -on 2026-10-04 (Wasmtime 49.0.2, `purs` 0.15.16). L1–L5 did not move in that run. +The 249 non-agreements, by the first phase that blocks them or runtime outcome. +These are from the latest `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` run +of all five boards on 2026-10-04 (Wasmtime 49.0.2, `purs` 0.15.16): + +| Blocker | Cases | Recovered by | +| --- | --- | --- | +| P5 typecheck | 68 | Type and class inference gaps behind earlier-stage blockers. | +| P10 Wasm structuring | 46 | No selected `main`. | +| P8 CC verification | 30 | Most commonly a call whose arguments do not match its signature. | +| P3 resolve | 23 | Remaining name and import resolution gaps. | +| P8 closure conversion | 16 | Unsupported or inconsistent runtime representations. | +| P5 kind check | 16 | Kind checking gaps. | +| P0 lex | 4 | DEC-16 lone-surrogate cases, also recorded as L1 differences. | +| P7 Core verification | 1 | A typed Core expression has an inconsistent context type. | +| Harness loading | 26 | Multi-module corpus inputs the current runner cannot assemble. | +| Runtime trap | 19 | The compiled guest traps under Wasmtime. | +| P2 surface lowering | 0 | No `passing` file stops in surface lowering. | + The tables after the current one are earlier measurements and are **not** additive with it or with each other; they are kept because the M2 paragraphs cite them. -After the `Effect Unit` command entry (the same run): +Earlier, after the `Effect Unit` command entry: | Blocker | Cases | Recovered by | | --- | --- | --- | @@ -841,7 +860,7 @@ The failure path is now landed rather than assumed: `Prelude.trap` is a message and then escapes through it, and the vertical tests assert the trap rather than an exit code (`PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::assertions`). That measurement's board was still 0/413. The -current board is the 125/413 table above. +current board is the 164/413 table above. The L2 run reports 19 sibling modules loaded and no case blocked because the loader could not use an on-disk sibling. Before #86, two such cases were @@ -1050,15 +1069,15 @@ for matrix status. | --- | --- | --- | --- | | L0 | Layout goldens | 15/15 official parse outcomes agree (12 accepted, 3 rejected), enforced by regression tests. | 15/15 agreement, with all layout cases covered by regression tests. | | L1 | Non-excluded parse behavior | 904/908 agreement using the annotations oracle; `passing` 410/413, `failing` 412/413, `warning` 67/67, `layout` 15/15, with the four remaining cases recorded as DEC-16 intentional differences | 100% agreement apart from the DEC-16 intentional differences. | -| L2 | Module, import, export, and name resolution | 72/72 failing cases. `passing` resolution is **276/413**, with 53 first-stage blockers on a missing module and 80 at P3; none at P2, and none blocked on assembly. One `PSRS_ORACLE=annotations` run of all boards on 2026-10-04 after `Data.Functor`. | The mapped resolution cases and all required passing-module cases agree. | -| L3 | Kinds and higher-kinded types | 36/48 failing cases (`KindsDoNotUnify` 16/24, `PartiallyAppliedSynonym` 10/12, and the other mapped code totals as measured in M3). `failing/3549.purs` now agrees. | 100% agreement for the mapped kind cases. | -| L4 | Core type checking | 35/50 failing cases; `TypesDoNotUnify` 32/41, `IntOutOfRange` 1/1, `InfiniteType` 2/2, `CannotApplyExpressionOfTypeOnType` 1/2, `EscapedSkolem` 0/2, `ExpectedType` 0/2, `AmbiguousTypeVariables` 0/1. | 100% agreement for the mapped type cases. | -| L5 | Classes and instances | 53/79 failing cases; `OverlappingInstances` 8/8, `NoInstanceFound` 41/52, `MissingClassMember` 2/2, `DuplicateInstance` 1/1, `InvalidInstanceHead` 1/5, and 0 for the other mapped codes. The per-code denominators sum to 79. `failing/NewtypeInstance5.purs` is no longer in this board. | 100% agreement for the mapped class cases. | -| L6/M7 | Runtime and standard library | 125/413 non-FFI passing files compile, validate, and run, all with exit code 0. Of the other 288, 53 stop on missing modules, 63 at P10 because no `main` was selected, 80 at P3, 49 at P5 typecheck, 17 at P5 kind checking, 16 at P8, 6 at P6, and 4 at P0; no P2 surface-lowering blockers and no harness-loading blockers. One `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` run of all boards on 2026-10-04 after `Data.Functor` (Wasmtime 49.0.2, `purs` 0.15.16). | Every in-scope passing file for the feature compiles, validates, and runs with the expected result. | +| L2 | Module, import, export, and name resolution | 71/72 failing cases. `passing` resolution is **386/413**; the remaining 27 stop at P3 (23) or P0 (4), with no missing-library or unusable-sibling blockers. The sole failing mismatch expects `ScopeConflict` and produces `ExportConflict`. Remeasured with all boards on 2026-10-04 after vendoring v0.15.16. | The mapped resolution cases and all required passing-module cases agree. | +| L3 | Kinds and higher-kinded types | 39/48 failing cases: `KindsDoNotUnify` 16/24, `PartiallyAppliedSynonym` 12/12, `CycleInTypeSynonym` 4/4, `CycleInKindDeclaration` 2/2, `InfiniteKind` 2/2, and `UndefinedTypeVariable` 3/4. | 100% agreement for the mapped kind cases. | +| L4 | Core type checking | 39/50 failing cases. The remaining mismatches include kind diagnostics reported in place of `ExpectedType`, missing `EscapedSkolem`, `VisibleTypeApplications1`, and five `Coercible` cases reported as `NoInstanceFound`. | 100% agreement for the mapped type cases. | +| L5 | Classes and instances | 58/81 failing cases: `OverlappingInstances` 8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, `DuplicateInstance` 1/1, `InvalidInstanceHead` 1/7, and 0 for the other mapped codes. | 100% agreement for the mapped class cases. | +| L6/M7 | Runtime and standard library | **164/413** non-FFI passing files compile, validate, and run, all with exit code 0. The other 249 do not agree: 46 stop at P10 with no selected `main`, 30 at P8 CC verification, 68 at P5 typecheck, 23 at P3, 16 at P5 kind checking, 16 at P8 closure conversion, 4 at P0, 1 at P7, 26 during harness loading, and 19 trap at runtime. Remeasured with `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` on 2026-10-04 (Wasmtime 49.0.2, `purs` 0.15.16). | Every in-scope passing file for the feature compiles, validates, and runs with the expected result. | | M8-W | Warnings | 67 non-FFI warning files are in scope; no warning-code scoreboard exists | Warning-code agreement reaches 100% for the tracked warning corpus. | | M8-O | Optimization | 10 optimize files are in scope; they are not vendored and their goldens are JavaScript output | Expected optimize/CoreFn output agrees for all tracked optimize files. | -The gate rows above are the 2026-10-04 measurement after `Data.Functor`. Earlier M7 tables in the progress section record the `logShow`, `Show`, and Foldable runs; those figures are historical and are not added to this table. L5 is 53/79. An older headline of 53/84 does not match the per-code totals. +The gate rows above are the 2026-10-04 remeasurement after vendoring the core libraries. Earlier M7 tables in the progress section record the `logShow`, `Show`, Foldable, and `Data.Functor` runs; those figures are historical and are not added to this table. The current L5 denominator is 81. ### Feature-to-gate crosswalk @@ -1095,7 +1114,7 @@ resolved, type checked, and represented in Typed Core as required. | ID | Feature | Current support | Status | Next landing | | --- | --- | --- | --- | --- | | FE-01 | Lexing, Unicode tokens, comments, literals, and layout | Lexer and layout agree with the L1 annotations scoreboard at 904/908, including 15/15 layout cases. The four differences are the DEC-16 intentional differences: a supplementary scalar is accepted as one `Char` (`failing/2434.purs`), and an unpaired surrogate escape is rejected in `StringEscapes.purs` and the two `StringEdgeCases` files. A paired surrogate escape decodes as one scalar, and no surrogate becomes U+FFFD. Parse agreement does not verify string values. | Partial | Cover the remaining literal forms the corpus exercises. | -| FE-02 | Module headers, imports, exports, qualified names, aliases, and hiding | Module graph, stable module IDs, value/type/constructor/class imports and exports, fixity aliases, virtual `Prim.*` type/class interfaces, instance dictionary identities, per-branch instance exports, and unary minus through ordinary `negate` resolution work in a subset; 72/72 mapped failing cases agree. `passing` resolution is **276/413**, with 53 first-stage blockers on a missing module and 80 at P3, from the 2026-10-04 `Data.Functor` remeasurement. A re-exported operator alias carries its target's identity and does not require the target's name unless the target is declared in the re-exporting module. Class-only imports do not import methods into the value namespace; selective imports still receive visible instances through the module dependency graph. P3 checks explicit signatures and declaration dependencies; P5 checks inferred public schemes by stable type identity. `Prim.undefined` has a compiler-owned identity, type, and interface export, but Core lowering still rejects it because no runtime representation is defined. The [primitives topic](frontend/type-system/prim.md) owns the `Prim.*` inventory, the evidence-class dispatch order, relation outcomes, and diagnostic behavior; #120 adds the missing relation and report paths. Broader pattern-binding support remains incomplete. | Partial | Complete pattern-binding support; add the `Prim.undefined` runtime representation and continue official-suite coverage for primitive solving. | +| FE-02 | Module headers, imports, exports, qualified names, aliases, and hiding | Module graph, stable module IDs, value/type/constructor/class imports and exports, fixity aliases, virtual `Prim.*` type/class interfaces, instance dictionary identities, per-branch instance exports, and unary minus through ordinary `negate` resolution work in a subset; the latest full-board run agrees on 71/72 mapped failing cases. `passing` resolution is **386/413**; 23 cases stop at P3 and 4 at P0. A re-exported operator alias carries its target's identity and does not require the target's name unless the target is declared in the re-exporting module. Class-only imports do not import methods into the value namespace; selective imports still receive visible instances through the module dependency graph. P3 checks explicit signatures and declaration dependencies; P5 checks inferred public schemes by stable type identity. `Prim.undefined` has a compiler-owned identity, type, and interface export, but Core lowering still rejects it because no runtime representation is defined. The [primitives topic](frontend/type-system/prim.md) owns the `Prim.*` inventory, the evidence-class dispatch order, relation outcomes, and diagnostic behavior; #120 adds the missing relation and report paths. Broader pattern-binding support remains incomplete. | Partial | Complete pattern-binding support; add the `Prim.undefined` runtime representation and continue official-suite coverage for primitive solving. | | FE-03 | Value declarations, signatures, recursive groups, pattern bindings, and `where` | Named declarations, signatures, recursive local groups, and top-level SCC inference work; selected local pattern declarations, including `LetPattern`, lower through the pattern pipeline. The full declaration and `where` forms are not end-to-end. | Partial | Complete remaining pattern declarations and local `where` blocks. | | FE-04 | Declaration forms: `data`, `newtype`, `type`, `class`, `instance`, `derive`, `foreign`, roles, fixities, and kind signatures | Data/newtype roles are inferred and checked, foreign role signatures enter the checked kind environment, and source role errors retain spans. Instance declarations resolve into dictionary-scoped members; signatures associate with consecutive equations, reject orphan/repeated declaration groups, and check against the class method specialized by the instance head. Deriving and several declaration forms remain incomplete. | Partial | Complete deriving and the remaining declaration-form semantics. | | FE-05 | Expressions: application, operators, lambdas, `if`, `let`, `case`, records, arrays, literals, sections, `do`, and `ado` | Application, value and type operators with resolved fixities, the `Data.Function` application operators `$` and `#` with their official associativity and precedence, unary minus through the ordinary in-scope `negate` value, lambdas, `if`, `let`, `case`, scalar arrays, empty array literals whose element type is determined, records, and selected literals work; `do`/`ado` lower to bind, discard, and `let`. The ascription `e :: T` is checked against its written type and remains explicit through Typed Core. Sections lower through P4 and have runtime coverage. Remaining literal and expression forms are open. | Partial | Complete the remaining literal and expression forms. | @@ -1113,7 +1132,7 @@ resolved, type checked, and represented in Typed Core as required. | FE-17 | Visible type application, typed binders, type wildcards, holes, and advanced annotations | Typed binders preserve and check scoped annotations, and each source type wildcard receives fresh kind/type variables through the shared type spine. Type-level `String` and `Int` literals are ordinary spine nodes: a signature may contain them, they unify by value, and they survive into THIR where the verifier compares them. A wildcard in a value signature is solved by unification and is accepted in every shape `purs` accepts; a wildcard in an instance head is rejected as `InvalidInstanceHead`, while one in an instance context stays legal. The `1664.purs` wildcard binder lowers through P2. Visible term type application, wildcard warning/error behavior, higher-kinded application, and non-generalized hole diagnostics remain incomplete. The `Type`, `Constraint`, and `Symbol` heads are accepted as ordinary type constructors with their declared primitive kinds. Official's CST has no kind-application node; its kind checker synthesizes `KindApp` while instantiating a polymorphic kind, and this compiler performs that instantiation in the kind solver, so its source type spine needs no `KindApplication` node. The source forms that do name a kind or type explicitly are separate nodes. #87 lands both of the forms that blocked P2: a negative type-level integer prefix is the negative literal on the shared spine, and a visible type application `e @T` is elaborated by the checker, which substitutes the written argument for the operand's outermost quantifier after checking it against that quantifier's kind, and is erased at runtime. No P2 surface-lowering case remains. Three limits are recorded rather than approximated. A chained application `f @A @B` is reported, because the quantifiers an application leaves behind are scheme variables here and choosing between them needs the scheme to record which variables a visible application has consumed. A visible application on a class-method head is unresolved, which is `failing/ClassHeadNoVTA3.purs`. And this compiler's CST does not carry the binder visibility that official's `CST/Convert.hs` derives from `forall @a.`, so a plain `forall a.` binder is selectable where `purs` rejects it — the permissive direction, and the remaining half of `failing/VisibleTypeApplications1.purs`. `CannotApplyExpressionOfTypeOnType` and `CannotSkipTypeApplication` are the mapped codes. The primitive row relations themselves all have rules, and the row-side gap that remains is the rigid-tail unification defect under FE-13. | Partial | Model `forall` binder visibility so a visible application matches official, then resolve chained applications and class-method heads. | | FE-18 | Higher-rank types, subsumption, impredicativity, and higher-rank `forall` | Bidirectional checking preserves nested quantifiers, checks directional function/record subsumption, and rejects escaping skolems and specialized universal arguments. Source and GC execution cases cover rank-2 through rank-4, fields, returned and captured values, recursive annotations, higher-kinded parameters, and nested constraints. See the [rank-N acceptance record](../implementation/frontend/rank-n.md) for verification evidence and the official differential battery. | Partial | Reconcile the complete official higher-rank/skolem corpus, including its library dependencies and separate higher-rank kind requirements; track visible type application and diagnostic agreement. | | FE-19 | Foreign declarations and target-aware external names | Source-declared WIT bindings are resolved for the supported backend path. `foreign import data` is a nominal opaque type with no constructors; a nullary one maps to a WIT resource. THIR and Core keep it as `Constructor(User(id))` plus `opaque_ids`, distinct from `Int` (`lowers_an_opaque_foreign_type_to_core_without_collapsing_it_to_int`). JavaScript FFI is not a frontend target. CC/MIR handle layout is not done. | Partial | Finish target-aware foreign value rules beyond the supported WIT subset. Resource lifetime and handle layout stay in the backend. | -| FE-20 | Warnings, holes, source spans, and official diagnostic codes | Source spans exist and resolution, kind, type, and class `errorCode`s are measured: L1 904/908, L2 72/72, L3 36/48, L4 35/50, L5 53/79. Pattern-binder diagnostics match the annotated duplicate-name cases; warning coverage and complete diagnostic agreement remain open. Non-generalized hole diagnostics remain tracked under FE-17. | Partial | Add the missing class checks (#97) and track warning-code agreement separately from acceptance errors. | +| FE-20 | Warnings, holes, source spans, and official diagnostic codes | Source spans exist and resolution, kind, type, and class `errorCode`s are measured: L1 904/908, L2 71/72, L3 39/48, L4 39/50, L5 58/81. The L4 aggregate is recorded without a per-code decomposition because the latest scoreboard's per-code counts sum to a different total. Pattern-binder diagnostics match the annotated duplicate-name cases; warning coverage and complete diagnostic agreement remain open. Non-generalized hole diagnostics remain tracked under FE-17. | Partial | Add the missing class checks (#97) and track warning-code agreement separately from acceptance errors. | | FE-21 | Typed Core normalization and CoreFn/optimization compatibility | Typed Core lowering and verification work for the supported subset; official optimize output is not yet a target. | Partial | Add Core optimization passes and an explicit optimize compatibility track. | The frontend landing order is: @@ -1153,13 +1172,13 @@ Wasm is the target encoding, and WIT/WASI are the platform integration layers. | BE-18 | Generic source-declared WIT imports | Compatible `Int`/`Boolean`/`Number` scalars, handles, and `list`/`string` imports lower through the canonical ABI with signature validation. A WIT `string` is a source `String` and a WIT `list` is `Array Int`, so the two no longer share a source type ([DEC-16](../decision/DEC-16-scalar-strings-and-utf8-storage.md)). Closed, directly flattened WIT records can contain nested `list` fields. | Partial | Add other aggregate WIT values, richer results, and user-library loading. | | BE-19 | WIT aggregate values and resources | Resource handles lower under [DEC-14](../decision/DEC-14-resource-handle-ownership.md): the compiler drops no handle on its own and exposes `resource.drop` to source, so the standard library owns the lifetime discipline; byte lists and closed WIT records with nested byte-list fields are classified and lowered in WIT field order. Indirect parameter tuples are allocated through `cabi_realloc`. Non-byte `list` of scalars, `bool`, `char`, strings, nullary enums, flags, resource handles, and directly flattened records of scalar or string fields is copied between a source GC array and the canonical buffer, with a driver execution test for `list` and synthesized Wasm fixtures for `list`, `list`, and `list` ([ABI-08](../implementation/backend/linear-memory-and-canonical-abi.md) In progress). `option`, `result`, and non-unit `variant` are classified and validated against `Data.Maybe.Maybe`, `Data.Either.Either`, and a source data type, CC derives their variant representation and a concrete payload tree, and MIR branches on each tag and rebuilds the source value recursively for a scalar payload of any width (`s8`..`u64`, `f32`/`f64`), a byte or non-byte list, `flags`, a closed record, and a nested `option`/`result`/`variant`, recursing through record fields and a `list`/`list` element, with synthesized Wasm fixtures ([DEC-13](../decision/DEC-13-wit-to-source-type-mapping.md)); a large aggregate return area is allocated through `cabi_realloc`, a handle in a result is an ordinary value the standard library drops explicitly, and an indirect parameter record carries a mapped aggregate. The aggregate ABI is generated from one normalized canonical type ([compositional canonical ABI lowering](backend/wasm/canonical-abi-compositional.md)); the descriptor types and per-shape plans are removed. `list>`/`list`/`list` elements, nested `list>`, multi-word flags as list elements and in aggregates, non-byte `list`, and `list>` results are classified and lowered, and a unit-success `result<_, E>` maps to `Either E Unit` (the error on `Left`) and sizes its return area from the error payload. | Partial | Add general aggregate layouts beyond the list-and-handle subset. | | BE-20 | Component Model packaging and capability-based imports | `wit-component` lifts the core module to a WASI 0.2 component and prunes unused imports. | Partial | Add component import/export regression cases beyond the CLI path and pass the L6/M7 gate. | -| BE-21 | WASI CLI entry, exit, stdout, and stderr | `wasi:cli/run`, exit codes, console output, and error output work in the component path. A selected `Int` entry returns its value as the exit code. A selected `Effect Unit` entry runs that action once, returns 0 after normal completion, and propagates a trap. Creating an action does not run its deferred operation. Focused Wasmtime tests assert output, status, and trap markers ([WASI-02/03](../implementation/backend/wasi-platform.md) Verified). The official board is 125/413, so this row stays Partial. | Partial | Pass the L6/M7 gate. The 63 files with no selected `main` stay explicit blockers. | +| BE-21 | WASI CLI entry, exit, stdout, and stderr | `wasi:cli/run`, exit codes, console output, and error output work in the component path. A selected `Int` entry returns its value as the exit code. A selected `Effect Unit` entry runs that action once, returns 0 after normal completion, and propagates a trap. Creating an action does not run its deferred operation. Focused Wasmtime tests assert output, status, and trap markers ([WASI-02/03](../implementation/backend/wasi-platform.md) Verified). The latest official runtime board is 164/413; 46 files have no selected `main`, and this row stays Partial. | Partial | Pass the L6/M7 gate. The 46 files with no selected `main` stay explicit blockers. | | BE-22 | WASI clocks and randomness | Monotonic time and random bytes are wired through WASI and tested. | Partial | Expose the remaining clock/random library surface and pass the L6/M7 gate. | | BE-23 | WASI arguments, environment, and filesystem | WIT descriptions are vendored, but the source library and aggregate lowering are not complete ([WASI-07](../implementation/backend/wasi-platform.md) In progress). | Planned | Add module loading and aggregate/list support, then expose these services. | | BE-24 | WASI sockets and HTTP | Not part of the current synchronous portable-program target. | Excluded | Revisit as a separate platform scope after the core target is stable. | | BE-25 | WASI 0.3 async streams and futures | The current compiler targets synchronous WASI 0.2. | Planned | Revisit only with an explicit platform decision and async language/library plan. | | BE-26 | Standard library and user module loading | User modules are discovered from the entry files' directories and linked transitively ([WASI-09](../implementation/backend/wasi-platform.md) Verified); the PureScript-facing standard library is loaded from `stdlib/lib` in trusted-prefix order ([WASI-10](../implementation/backend/wasi-platform.md) Verified). | Partial | Pass the L6/M7 module-loading scoreboard. | -| BE-27 | Wasm/WASI execution and official passing-suite runtime coverage | Vertical execution tests pass for the bootstrap slice, and the `l6_runtime_scoreboard` harness compiles, validates, and runs the 413 non-FFI `passing` files; it measures **125/413** on 2026-10-04 after `Data.Functor` (Wasmtime 49.0.2, `purs` 0.15.16). All 125 exit 0. 124 are the files whose previous first blocker was a non-`Int` entry; `passing/3549.purs` is the additional file and was blocked on `Functor`. The first blockers of the other 288 are 53 missing library modules, 63 P10 files with no selected `main`, 80 P3 resolution failures, 49 P5 type errors, 17 P5 kind errors, 16 P8 representation errors, 6 P6 Core-lowering failures, and 4 P0 lexing failures; there are 0 harness-loading blockers and 0 P2 blockers. The library surface this row was waiting on is landed: `Effect`/`Effect.Console` — including `logShow` over the library `show` — and `Test.Assert`, whose failure path is a real guest trap (`Prelude.trap`). The remaining library work is the `Prelude` class and value surface (#94), the unowned `Data.*` modules (#124), and `Test.Assert.assertEqual` (#95), which #137 blocks because a constraint on a variable inside a record type is elaborated against the record. The remaining P10 files have no selected `main` and stay explicit blockers; this row does not emit an empty main. The 26 FFI files are excluded. The row stays Partial because L6 is not complete. | Partial | Land the `Prelude` class surface, then track per-feature runtime cases against the board. | +| BE-27 | Wasm/WASI execution and official passing-suite runtime coverage | The `l6_runtime_scoreboard` compiles, validates, and executes the 413 non-FFI `passing` files under required Wasmtime. The 2026-10-04 full-board measurement is **164/413**, all exiting 0 (Wasmtime 49.0.2, `purs` 0.15.16). Of the other 249 cases, 230 stop before runtime and 19 trap. First blockers are P5 typecheck 68, P10 no selected `main` 46, P8 CC verification 30, P3 resolution 23, P8 closure conversion 16, P5 kind check 16, P0 lexing 4, P7 Core verification 1, and harness loading 26; no case stops at P2. The 26 FFI files are excluded. The row stays Partial because L6 is not complete. | Partial | Resolve the remaining compile and runtime blockers, then remeasure the full board. | | BE-28 | JavaScript/Node.js FFI compatibility | Not emitted or executed by this backend. | Excluded | No work planned under this decision. | ### Topic implementation acceptance @@ -1177,7 +1196,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Effects | BE-21; supporting BE-02, BE-26 | Trusted Effect identities and checked WIT schemes are passed explicitly. Source `Effect a` stays abstract through Typed Core; P8 lowers it to a generic one-parameter closure. EF-01..EF-13 are Verified, including the `Effect Unit` command adapter and the lexical `runEffect` rule. A type table changed after `lower_effects` returns is not checked again. The official runtime board is 125/413. The 63 files with no selected `main` remain blocked, and BE-21 stays Partial. | [EF-01..EF-13](../implementation/backend/effects.md) | +| Effects | BE-21; supporting BE-02, BE-26 | Trusted Effect identities and checked WIT schemes are passed explicitly. Source `Effect a` stays abstract through Typed Core; P8 lowers it to a generic one-parameter closure. EF-01..EF-13 are Verified, including the `Effect Unit` command adapter and the lexical `runEffect` rule. A type table changed after `lower_effects` returns is not checked again. The official runtime board is 164/413; 46 files with no selected `main` remain blocked, and BE-21 stays Partial. Focused effect tests still expose CC verification and runtime traps, so their source-level integration remains open. | [EF-01..EF-13](../implementation/backend/effects.md) | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-16. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | | Optimization | BE-12 | Topic acceptance complete: OPT-01..OPT-14 have implementation, verifier, and required execution evidence. The official M8-O gate stays on the broader BE-12 row. | [OPT-01..OPT-14](../implementation/backend/optimization.md) | diff --git a/docs/design/D-15-compiler-builtins.md b/docs/design/D-15-compiler-builtins.md index 564e21b0..6a8224e4 100644 --- a/docs/design/D-15-compiler-builtins.md +++ b/docs/design/D-15-compiler-builtins.md @@ -387,9 +387,11 @@ primitives, and `Prelude` re-exports them, matching official PureScript. A sourc that uses them imports `Prelude`. Each instance eta-expands its intrinsic (`eq x y = intEq x y`) because a first-class intrinsic reference is not lowerable. -The remaining surface operators `-`, `/`, and `%` are still bound to the `Int` -intrinsics directly. `Data.Ring` and the Euclidean division class are the -follow-up. +`-` is the `Data.Ring` operator and `/` is the `Data.EuclideanRing` operator, +both re-exported from `Prelude`. The primitives under them are `intSub` +(wrapping subtraction) and `intQuot` (truncating division). `intDiv` and +`intMod` stay the Euclidean pair the `Int` instance calls. `%` is still the +truncating remainder primitive; the library spells that operation `mod`. `Show` is a library class in `Data.Show`, re-exported from `Prelude`, over the same primitives. It does not add an intrinsic: integer, character, and string diff --git a/docs/design/frontend/type-system/classes-and-evidence.md b/docs/design/frontend/type-system/classes-and-evidence.md index 0762039c..2b9a34e3 100644 --- a/docs/design/frontend/type-system/classes-and-evidence.md +++ b/docs/design/frontend/type-system/classes-and-evidence.md @@ -54,10 +54,13 @@ the signature applies to that consecutive equation group. Consecutive equations for one member form one definition, while a later separated group with the same name is a duplicate declaration. A signature without its matching member is an orphan type declaration. Member signatures are checked against the class -method after substituting the instance head, and their unbound type variables -resolve in the instance-head scope. The implementation supports the existing -subsumption rules for these annotations; it does not yet solve a constrained -annotation merely to specialize it to a monomorphic expected method type. +method after substituting the instance head. Variables introduced by the +instance context share the same type identities in method bodies and +annotations; a context-only variable is valid when the context's functional +dependencies determine it from the instance head. The implementation supports +the existing subsumption rules for these annotations; it does not yet solve a +constrained annotation merely to specialize it to a monomorphic expected method +type. ## Design diff --git a/stdlib/lib/Control/Alt.purs b/stdlib/lib/Control/Alt.purs new file mode 100644 index 00000000..a8132706 --- /dev/null +++ b/stdlib/lib/Control/Alt.purs @@ -0,0 +1,42 @@ +module Control.Alt + ( class Alt, alt, (<|>) + , module Data.Functor + ) where + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.Semigroup (append) + +-- | The `Alt` type class identifies an associative operation on a type +-- | constructor. It is similar to `Semigroup`, except that it applies to +-- | types of kind `* -> *`, like `Array` or `List`, rather than concrete types +-- | `String` or `Number`. +-- | +-- | `Alt` instances are required to satisfy the following laws: +-- | +-- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)` +-- | - Distributivity: `f <$> (x <|> y) == (f <$> x) <|> (f <$> y)` +-- | +-- | For example, the `Array` (`[]`) type is an instance of `Alt`, where +-- | `(<|>)` is defined to be concatenation. +-- | +-- | A common use case is to select the first "valid" item, or, if all items +-- | are "invalid", the last "invalid" item. +-- | +-- | For example: +-- | +-- | ```purescript +-- | import Control.Alt ((<|>)) +-- | import Data.Maybe (Maybe(..) +-- | import Data.Either (Either(..)) +-- | +-- | Nothing <|> Just 1 <|> Just 2 == Just 1 +-- | Left "err" <|> Right 1 <|> Right 2 == Right 1 +-- | Left "err 1" <|> Left "err 2" <|> Left "err 3" == Left "err 3" +-- | ``` +class Functor f <= Alt f where + alt :: forall a. f a -> f a -> f a + +infixr 3 alt as <|> + +instance altArray :: Alt Array where + alt = append diff --git a/stdlib/lib/Control/Alternative.purs b/stdlib/lib/Control/Alternative.purs new file mode 100644 index 00000000..5bec9c77 --- /dev/null +++ b/stdlib/lib/Control/Alternative.purs @@ -0,0 +1,50 @@ +module Control.Alternative + ( class Alternative + , guard + , module Control.Alt + , module Control.Applicative + , module Control.Apply + , module Control.Plus + , module Data.Functor + ) where + +import Control.Alt (class Alt, alt, (<|>)) +import Control.Applicative (class Applicative, pure, liftA1, unless, when) +import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) +import Control.Plus (class Plus, empty) + +import Data.Unit (Unit, unit) +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) + +-- | The `Alternative` type class has no members of its own; it just specifies +-- | that the type constructor has both `Applicative` and `Plus` instances. +-- | +-- | Types which have `Alternative` instances should also satisfy the following +-- | laws: +-- | +-- | - Distributivity: `(f <|> g) <*> x == (f <*> x) <|> (g <*> x)` +-- | - Annihilation: `empty <*> f = empty` +class (Applicative f, Plus f) <= Alternative f + +instance alternativeArray :: Alternative Array + +-- | Fail using `Plus` if a condition does not hold, or +-- | succeed using `Applicative` if it does. +-- | +-- | For example: +-- | +-- | ```purescript +-- | import Prelude +-- | import Control.Alternative (guard) +-- | import Data.Array ((..)) +-- | +-- | factors :: Int -> Array Int +-- | factors n = do +-- | a <- 1..n +-- | b <- 1..n +-- | guard $ a * b == n +-- | pure a +-- | ``` +guard :: forall m. Alternative m => Boolean -> m Unit +guard true = pure unit +guard false = empty diff --git a/stdlib/lib/Control/Applicative.purs b/stdlib/lib/Control/Applicative.purs new file mode 100644 index 00000000..6d444460 --- /dev/null +++ b/stdlib/lib/Control/Applicative.purs @@ -0,0 +1,70 @@ +module Control.Applicative + ( class Applicative + , pure + , liftA1 + , unless + , when + , module Control.Apply + , module Data.Functor + ) where + +import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.Unit (Unit, unit) +import Type.Proxy (Proxy(..)) + +-- | The `Applicative` type class extends the [`Apply`](#apply) type class +-- | with a `pure` function, which can be used to create values of type `f a` +-- | from values of type `a`. +-- | +-- | Where [`Apply`](#apply) provides the ability to lift functions of two or +-- | more arguments to functions whose arguments are wrapped using `f`, and +-- | [`Functor`](#functor) provides the ability to lift functions of one +-- | argument, `pure` can be seen as the function which lifts functions of +-- | _zero_ arguments. That is, `Applicative` functors support a lifting +-- | operation for any number of function arguments. +-- | +-- | Instances must satisfy the following laws in addition to the `Apply` +-- | laws: +-- | +-- | - Identity: `(pure identity) <*> v = v` +-- | - Composition: `pure (<<<) <*> f <*> g <*> h = f <*> (g <*> h)` +-- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)` +-- | - Interchange: `u <*> (pure y) = (pure (_ $ y)) <*> u` +class Apply f <= Applicative f where + pure :: forall a. a -> f a + +instance applicativeFn :: Applicative ((->) r) where + pure x _ = x + +instance applicativeArray :: Applicative Array where + pure x = [ x ] + +instance applicativeProxy :: Applicative Proxy where + pure _ = Proxy + +-- | `liftA1` provides a default implementation of `(<$>)` for any +-- | [`Applicative`](#applicative) functor, without using `(<$>)` as provided +-- | by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass +-- | relationship. +-- | +-- | `liftA1` can therefore be used to write [`Functor`](#functor) instances +-- | as follows: +-- | +-- | ```purescript +-- | instance functorF :: Functor F where +-- | map = liftA1 +-- | ``` +liftA1 :: forall f a b. Applicative f => (a -> b) -> f a -> f b +liftA1 f a = pure f <*> a + +-- | Perform an applicative action when a condition is true. +when :: forall m. Applicative m => Boolean -> m Unit -> m Unit +when true m = m +when false _ = pure unit + +-- | Perform an applicative action unless a condition is true. +unless :: forall m. Applicative m => Boolean -> m Unit -> m Unit +unless false m = m +unless true _ = pure unit diff --git a/stdlib/lib/Control/Apply.purs b/stdlib/lib/Control/Apply.purs new file mode 100644 index 00000000..720e2538 --- /dev/null +++ b/stdlib/lib/Control/Apply.purs @@ -0,0 +1,119 @@ +module Control.Apply + ( class Apply + , apply + , (<*>) + , applyFirst + , (<*) + , applySecond + , (*>) + , lift2 + , lift3 + , lift4 + , lift5 + , module Data.Functor + ) where + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.Function (const) +import Control.Category (identity) +import Type.Proxy (Proxy(..)) + +-- | The `Apply` class provides the `(<*>)` which is used to apply a function +-- | to an argument under a type constructor. +-- | +-- | `Apply` can be used to lift functions of two or more arguments to work on +-- | values wrapped with the type constructor `f`. It might also be understood +-- | in terms of the `lift2` function: +-- | +-- | ```purescript +-- | lift2 :: forall f a b c. Apply f => (a -> b -> c) -> f a -> f b -> f c +-- | lift2 f a b = f <$> a <*> b +-- | ``` +-- | +-- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts +-- | the function application operator `($)` to arguments wrapped with the +-- | type constructor `f`. +-- | +-- | Put differently... +-- | ``` +-- | foo = +-- | functionTakingNArguments <$> computationProducingArg1 +-- | <*> computationProducingArg2 +-- | <*> ... +-- | <*> computationProducingArgN +-- | ``` +-- | +-- | Instances must satisfy the following law in addition to the `Functor` +-- | laws: +-- | +-- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)` +-- | +-- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor. +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b + +infixl 4 apply as <*> + +instance applyFn :: Apply ((->) r) where + apply f g x = f x (g x) + +instance applyArray :: Apply Array where + apply = arrayApply + +arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b +arrayApply a0 a1 = applyArrayFrom a0 a1 0 + +applyArrayFrom :: forall a b. Array (a -> b) -> Array a -> Int -> Array b +applyArrayFrom fs xs index = + if intLt index (arrayLength fs) then + arrayAppend (mapArrayAll (arrayIndex fs index) xs 0) (applyArrayFrom fs xs (intAdd index 1)) + else + [] + +mapArrayAll :: forall a b. (a -> b) -> Array a -> Int -> Array b +mapArrayAll f xs index = + if intLt index (arrayLength xs) then + arrayAppend [f (arrayIndex xs index)] (mapArrayAll f xs (intAdd index 1)) + else + [] + +instance applyProxy :: Apply Proxy where + apply _ _ = Proxy + +-- | Combine two effectful actions, keeping only the result of the first. +applyFirst :: forall a b f. Apply f => f a -> f b -> f a +applyFirst a b = const <$> a <*> b + +infixl 4 applyFirst as <* + +-- | Combine two effectful actions, keeping only the result of the second. +applySecond :: forall a b f. Apply f => f a -> f b -> f b +applySecond a b = const identity <$> a <*> b + +infixl 4 applySecond as *> + +-- | Lift a function of two arguments to a function which accepts and returns +-- | values wrapped with the type constructor `f`. +-- | +-- | ```purescript +-- | lift2 add (Just 1) (Just 2) == Just 3 +-- | lift2 add Nothing (Just 2) == Nothing +-- |``` +-- | +lift2 :: forall a b c f. Apply f => (a -> b -> c) -> f a -> f b -> f c +lift2 f a b = f <$> a <*> b + +-- | Lift a function of three arguments to a function which accepts and returns +-- | values wrapped with the type constructor `f`. +lift3 :: forall a b c d f. Apply f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d +lift3 f a b c = f <$> a <*> b <*> c + +-- | Lift a function of four arguments to a function which accepts and returns +-- | values wrapped with the type constructor `f`. +lift4 :: forall a b c d e f. Apply f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e +lift4 f a b c d = f <$> a <*> b <*> c <*> d + +-- | Lift a function of five arguments to a function which accepts and returns +-- | values wrapped with the type constructor `f`. +lift5 :: forall a b c d e f g. Apply f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g +lift5 f a b c d e = f <$> a <*> b <*> c <*> d <*> e diff --git a/stdlib/lib/Control/Biapplicative.purs b/stdlib/lib/Control/Biapplicative.purs new file mode 100644 index 00000000..b6e01ac6 --- /dev/null +++ b/stdlib/lib/Control/Biapplicative.purs @@ -0,0 +1,12 @@ +module Control.Biapplicative where + +import Control.Biapply (class Biapply) +import Data.Tuple (Tuple(..)) + +-- | `Biapplicative` captures type constructors of two arguments which support lifting of +-- | functions of zero or more arguments, in the sense of `Applicative`. +class Biapply w <= Biapplicative w where + bipure :: forall a b. a -> b -> w a b + +instance biapplicativeTuple :: Biapplicative Tuple where + bipure = Tuple diff --git a/stdlib/lib/Control/Biapply.purs b/stdlib/lib/Control/Biapply.purs new file mode 100644 index 00000000..6bb247cb --- /dev/null +++ b/stdlib/lib/Control/Biapply.purs @@ -0,0 +1,59 @@ +module Control.Biapply where + +import Data.Function (const, identity) + +import Data.Bifunctor (class Bifunctor, bimap) +import Data.Tuple (Tuple(..)) + +-- | A convenience operator which can be used to apply the result of `bipure` in +-- | the style of `Applicative`: +-- | +-- | ```purescript +-- | bipure f g <<$>> x <<*>> y +-- | ``` +infixl 4 identity as <<$>> + +-- | `Biapply` captures type constructors of two arguments which support lifting of +-- | functions of one or more arguments, in the sense of `Apply`. +class Bifunctor w <= Biapply w where + biapply :: forall a b c d. w (a -> b) (c -> d) -> w a c -> w b d + +infixl 4 biapply as <<*>> + +-- | Keep the results of the second computation. +biapplyFirst :: forall w a b c d. Biapply w => w a b -> w c d -> w c d +biapplyFirst a b = bimap (const identity) (const identity) <<$>> a <<*>> b + +infixl 4 biapplyFirst as *>> + +-- | Keep the results of the first computation. +biapplySecond :: forall w a b c d. Biapply w => w a b -> w c d -> w a b +biapplySecond a b = bimap const const <<$>> a <<*>> b + +infixl 4 biapplySecond as <<* + +-- | Lift a function of two arguments. +bilift2 + :: forall w a b c d e f + . Biapply w + => (a -> b -> c) + -> (d -> e -> f) + -> w a d + -> w b e + -> w c f +bilift2 f g a b = bimap f g <<$>> a <<*>> b + +-- | Lift a function of three arguments. +bilift3 + :: forall w a b c d e f g h + . Biapply w + => (a -> b -> c -> d) + -> (e -> f -> g -> h) + -> w a e + -> w b f + -> w c g + -> w d h +bilift3 f g a b c = bimap f g <<$>> a <<*>> b <<*>> c + +instance biapplyTuple :: Biapply Tuple where + biapply (Tuple f g) (Tuple a b) = Tuple (f a) (g b) diff --git a/stdlib/lib/Control/Bind.purs b/stdlib/lib/Control/Bind.purs new file mode 100644 index 00000000..2b6fcd19 --- /dev/null +++ b/stdlib/lib/Control/Bind.purs @@ -0,0 +1,158 @@ +module Control.Bind + ( class Bind + , bind + , (>>=) + , bindFlipped + , (=<<) + , class Discard + , discard + , join + , composeKleisli + , (>=>) + , composeKleisliFlipped + , (<=<) + , ifM + , module Data.Functor + , module Control.Apply + , module Control.Applicative + ) where + +import Control.Applicative (class Applicative, liftA1, pure, unless, when) +import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) +import Control.Category (identity) + +import Data.Function (flip) +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.Unit (Unit) +import Type.Proxy (Proxy(..)) + +-- | The `Bind` type class extends the [`Apply`](#apply) type class with a +-- | "bind" operation `(>>=)` which composes computations in sequence, using +-- | the return value of one computation to determine the next computation. +-- | +-- | The `>>=` operator can also be expressed using `do` notation, as follows: +-- | +-- | ```purescript +-- | x >>= f = do y <- x +-- | f y +-- | ``` +-- | +-- | where the function argument of `f` is given the name `y`. +-- | +-- | Instances must satisfy the following laws in addition to the `Apply` +-- | laws: +-- | +-- | - Associativity: `(x >>= f) >>= g = x >>= (\k -> f k >>= g)` +-- | - Apply Superclass: `apply f x = f >>= \f’ -> map f’ x` +-- | +-- | Associativity tells us that we can regroup operations which use `do` +-- | notation so that we can unambiguously write, for example: +-- | +-- | ```purescript +-- | do x <- m1 +-- | y <- m2 x +-- | m3 x y +-- | ``` +class Apply m <= Bind m where + bind :: forall a b. m a -> (a -> m b) -> m b + +infixl 1 bind as >>= + +-- | `bindFlipped` is `bind` with its arguments reversed. For example: +-- | +-- | ```purescript +-- | print =<< random +-- | ``` +bindFlipped :: forall m a b. Bind m => (a -> m b) -> m a -> m b +bindFlipped = flip bind + +infixr 1 bindFlipped as =<< + +instance bindFn :: Bind ((->) r) where + bind m f x = f (m x) x + +-- | The `bind`/`>>=` function for `Array` works by applying a function to +-- | each element in the array, and flattening the results into a single, +-- | new array. +-- | +-- | Array's `bind`/`>>=` works like a nested for loop. Each `bind` adds +-- | another level of nesting in the loop. For example: +-- | ``` +-- | foo :: Array String +-- | foo = +-- | ["a", "b"] >>= \eachElementInArray1 -> +-- | ["c", "d"] >>= \eachElementInArray2 +-- | pure (eachElementInArray1 <> eachElementInArray2) +-- | +-- | -- In other words... +-- | foo +-- | -- ... is the same as... +-- | [ ("a" <> "c"), ("a" <> "d"), ("b" <> "c"), ("b" <> "d") ] +-- | -- which simplifies to... +-- | [ "ac", "ad", "bc", "bd" ] +-- | ``` +instance bindArray :: Bind Array where + bind = arrayBind + +arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b +arrayBind a0 a1 = bindArrayFrom a0 a1 0 + +bindArrayFrom :: forall a b. Array a -> (a -> Array b) -> Int -> Array b +bindArrayFrom xs f index = + if intLt index (arrayLength xs) then + arrayAppend (f (arrayIndex xs index)) (bindArrayFrom xs f (intAdd index 1)) + else + [] + +instance bindProxy :: Bind Proxy where + bind _ _ = Proxy + +-- | A class for types whose values can safely be discarded +-- | in a `do` notation block. +-- | +-- | An example is the `Unit` type, since there is only one +-- | possible value which can be returned. +class Discard a where + discard :: forall f b. Bind f => f a -> (a -> f b) -> f b + +instance discardUnit :: Discard Unit where + discard = bind + +instance discardProxy :: Discard (Proxy a) where + discard = bind + +-- | Collapse two applications of a monadic type constructor into one. +join :: forall a m. Bind m => m (m a) -> m a +join m = m >>= identity + +-- | Forwards Kleisli composition. +-- | +-- | For example: +-- | +-- | ```purescript +-- | import Data.Array (head, tail) +-- | +-- | third = tail >=> tail >=> head +-- | ``` +composeKleisli :: forall a b c m. Bind m => (a -> m b) -> (b -> m c) -> a -> m c +composeKleisli f g a = f a >>= g + +infixr 1 composeKleisli as >=> + +-- | Backwards Kleisli composition. +composeKleisliFlipped :: forall a b c m. Bind m => (b -> m c) -> (a -> m b) -> a -> m c +composeKleisliFlipped f g a = f =<< g a + +infixr 1 composeKleisliFlipped as <=< + +-- | Execute a monadic action if a condition holds. +-- | +-- | For example: +-- | +-- | ```purescript +-- | main = ifM ((< 0.5) <$> random) +-- | (trace "Heads") +-- | (trace "Tails") +-- | ``` +ifM :: forall a m. Bind m => m Boolean -> m a -> m a -> m a +ifM cond t f = cond >>= \cond' -> if cond' then t else f diff --git a/stdlib/lib/Control/Category.purs b/stdlib/lib/Control/Category.purs new file mode 100644 index 00000000..c2f224a4 --- /dev/null +++ b/stdlib/lib/Control/Category.purs @@ -0,0 +1,22 @@ +module Control.Category + ( class Category + , identity + , module Control.Semigroupoid + ) where + +import Control.Semigroupoid (class Semigroupoid, compose, (<<<), (>>>)) + +-- | `Category`s consist of objects and composable morphisms between them, and +-- | as such are [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids` +-- | must have an identity element. +-- | +-- | Instances must satisfy the following law in addition to the +-- | `Semigroupoid` law: +-- | +-- | - Identity: `identity <<< p = p <<< identity = p` +class Category :: forall k. (k -> k -> Type) -> Constraint +class Semigroupoid a <= Category a where + identity :: forall t. a t t + +instance categoryFn :: Category (->) where + identity x = x diff --git a/stdlib/lib/Control/Comonad.purs b/stdlib/lib/Control/Comonad.purs new file mode 100644 index 00000000..d471e2db --- /dev/null +++ b/stdlib/lib/Control/Comonad.purs @@ -0,0 +1,21 @@ +module Control.Comonad + ( class Comonad, extract + , module Control.Extend + , module Data.Functor + ) where + +import Control.Extend (class Extend, duplicate, extend, (<<=), (=<=), (=>=), (=>>)) + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) + +-- | `Comonad` extends the `Extend` class with the `extract` function +-- | which extracts a value, discarding the comonadic context. +-- | +-- | `Comonad` is the dual of `Monad`, and `extract` is the dual of `pure`. +-- | +-- | Laws: +-- | +-- | - Left Identity: `extract <<= xs = xs` +-- | - Right Identity: `extract (f <<= xs) = f xs` +class Extend w <= Comonad w where + extract :: forall a. w a -> a diff --git a/stdlib/lib/Control/Extend.purs b/stdlib/lib/Control/Extend.purs new file mode 100644 index 00000000..8f979d54 --- /dev/null +++ b/stdlib/lib/Control/Extend.purs @@ -0,0 +1,60 @@ +module Control.Extend + ( class Extend, extend, (<<=), extendFlipped, (=>>) + , composeCoKleisli, (=>=) + , composeCoKleisliFlipped, (=<=) + , duplicate + , module Data.Functor + ) where + +import Control.Category (identity) + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.Semigroup (class Semigroup, (<>)) + +-- | The `Extend` class defines the extension operator `(<<=)` +-- | which extends a local context-dependent computation to +-- | a global computation. +-- | +-- | `Extend` is the dual of `Bind`, and `(<<=)` is the dual of +-- | `(>>=)`. +-- | +-- | Laws: +-- | +-- | - Associativity: `extend f <<< extend g = extend (f <<< extend g)` +class Functor w <= Extend w where + extend :: forall b a. (w a -> b) -> w a -> w b + +instance extendFn :: Semigroup w => Extend ((->) w) where + extend f g w = f \w' -> g (w <> w') + +arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b +arrayExtend a0 a1 = arrayExtend a0 a1 + +instance extendArray :: Extend Array where + extend = arrayExtend + +infixr 1 extend as <<= + +-- | A version of `extend` with its arguments flipped. +extendFlipped :: forall b a w. Extend w => w a -> (w a -> b) -> w b +extendFlipped w f = f <<= w + +infixl 1 extendFlipped as =>> + +-- | Forwards co-Kleisli composition. +composeCoKleisli :: forall b a w c. Extend w => (w a -> b) -> (w b -> c) -> w a -> c +composeCoKleisli f g w = g (f <<= w) + +infixr 1 composeCoKleisli as =>= + +-- | Backwards co-Kleisli composition. +composeCoKleisliFlipped :: forall b a w c. Extend w => (w b -> c) -> (w a -> b) -> w a -> c +composeCoKleisliFlipped f g w = f (g <<= w) + +infixr 1 composeCoKleisliFlipped as =<= + +-- | Duplicate a comonadic context. +-- | +-- | `duplicate` is dual to `Control.Bind.join`. +duplicate :: forall a w. Extend w => w a -> w (w a) +duplicate = extend identity diff --git a/stdlib/lib/Control/Lazy.purs b/stdlib/lib/Control/Lazy.purs new file mode 100644 index 00000000..3434d091 --- /dev/null +++ b/stdlib/lib/Control/Lazy.purs @@ -0,0 +1,25 @@ +module Control.Lazy where + +import Data.Unit (Unit, unit) + +-- | The `Lazy` class represents types which allow evaluation of values +-- | to be _deferred_. +-- | +-- | Usually, this means that a type contains a function arrow which can +-- | be used to delay evaluation. +class Lazy l where + defer :: (Unit -> l) -> l + +instance lazyFn :: Lazy (a -> b) where + defer f = \x -> f unit x + +instance lazyUnit :: Lazy Unit where + defer _ = unit + +-- | `fix` defines a value as the fixed point of a function. +-- | +-- | The `Lazy` instance allows us to generate the result lazily. +fix :: forall l. Lazy l => (l -> l) -> l +fix f = go + where + go = defer \_ -> f go diff --git a/stdlib/lib/Control/Monad.purs b/stdlib/lib/Control/Monad.purs new file mode 100644 index 00000000..3d8400ae --- /dev/null +++ b/stdlib/lib/Control/Monad.purs @@ -0,0 +1,86 @@ +module Control.Monad + ( class Monad + , liftM1 + , whenM + , unlessM + , ap + , module Data.Functor + , module Control.Apply + , module Control.Applicative + , module Control.Bind + ) where + +import Control.Applicative (class Applicative, liftA1, pure, unless, when) +import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) +import Control.Bind (class Bind, bind, ifM, join, (<=<), (=<<), (>=>), (>>=)) + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) +import Data.Unit (Unit) +import Type.Proxy (Proxy) + +-- | The `Monad` type class combines the operations of the `Bind` and +-- | `Applicative` type classes. Therefore, `Monad` instances represent type +-- | constructors which support sequential composition, and also lifting of +-- | functions of arbitrary arity. +-- | +-- | Instances must satisfy the following laws in addition to the +-- | `Applicative` and `Bind` laws: +-- | +-- | - Left Identity: `pure x >>= f = f x` +-- | - Right Identity: `x >>= pure = x` +class (Applicative m, Bind m) <= Monad m + +instance monadFn :: Monad ((->) r) + +instance monadArray :: Monad Array + +instance monadProxy :: Monad Proxy + +-- | `liftM1` provides a default implementation of `(<$>)` for any +-- | [`Monad`](#monad), without using `(<$>)` as provided by the +-- | [`Functor`](#functor)-[`Monad`](#monad) superclass relationship. +-- | +-- | `liftM1` can therefore be used to write [`Functor`](#functor) instances +-- | as follows: +-- | +-- | ```purescript +-- | instance functorF :: Functor F where +-- | map = liftM1 +-- | ``` +liftM1 :: forall m a b. Monad m => (a -> b) -> m a -> m b +liftM1 f a = do + a' <- a + pure (f a') + +-- | Perform a monadic action when a condition is true, where the conditional +-- | value is also in a monadic context. +whenM :: forall m. Monad m => m Boolean -> m Unit -> m Unit +whenM mb m = do + b <- mb + when b m + +-- | Perform a monadic action unless a condition is true, where the conditional +-- | value is also in a monadic context. +unlessM :: forall m. Monad m => m Boolean -> m Unit -> m Unit +unlessM mb m = do + b <- mb + unless b m + +-- | `ap` provides a default implementation of `(<*>)` for any `Monad`, without +-- | using `(<*>)` as provided by the `Apply`-`Monad` superclass relationship. +-- | +-- | `ap` can therefore be used to write `Apply` instances as follows: +-- | +-- | ```purescript +-- | instance applyF :: Apply F where +-- | apply = ap +-- | ``` +-- Note: Only a `Bind` constraint is needed, but this can +-- produce loops when used with other default implementations +-- (i.e. `liftA1`). +-- See https://github.com/purescript/purescript-prelude/issues/232 +ap :: forall m a b. Monad m => m (a -> b) -> m a -> m b +ap f a = do + f' <- f + a' <- a + pure (f' a') diff --git a/stdlib/lib/Control/Monad/Gen.purs b/stdlib/lib/Control/Monad/Gen.purs new file mode 100644 index 00000000..3ceee57d --- /dev/null +++ b/stdlib/lib/Control/Monad/Gen.purs @@ -0,0 +1,132 @@ +module Control.Monad.Gen + ( module Control.Monad.Gen.Class + , choose + , oneOf + , frequency + , elements + , unfoldable + , suchThat + , filtered + ) where + +import Prelude + +import Control.Monad.Gen.Class (class MonadGen, Size, chooseBool, chooseFloat, chooseInt, resize, sized) +import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) +import Data.Foldable (foldMap, foldr, length) +import Data.Maybe (Maybe(..)) +import Data.Monoid.Additive (Additive(..)) +import Data.Newtype (alaF, un) +import Data.Semigroup.Foldable (class Foldable1, foldMap1) +import Data.Semigroup.Last (Last(..)) +import Data.Tuple (Tuple(..), fst, snd) +import Data.Unfoldable (class Unfoldable, unfoldr) + +data LL a = Cons a (LL a) | Nil + +-- | Creates a generator that outputs a value chosen from one of two existing +-- | existing generators with even probability. +choose :: forall m a. MonadGen m => m a -> m a -> m a +choose genA genB = chooseBool >>= if _ then genA else genB + +-- | Creates a generator that outputs a value chosen from a selection of +-- | existing generators with uniform probability. +oneOf :: forall m f a. MonadGen m => Foldable1 f => f (m a) -> m a +oneOf xs = do + n <- chooseInt 0 (length xs - 1) + fromIndex n xs + +newtype FreqSemigroup a = FreqSemigroup (Number -> Tuple (Maybe Number) a) + +freqSemigroup :: forall a. Tuple Number a -> FreqSemigroup a +freqSemigroup (Tuple weight x) = + FreqSemigroup \pos -> + if pos >= weight + then Tuple (Just (pos - weight)) x + else Tuple Nothing x + +getFreqVal :: forall a. FreqSemigroup a -> Number -> a +getFreqVal (FreqSemigroup f) = snd <<< f + +instance semigroupFreqSemigroup :: Semigroup (FreqSemigroup a) where + append (FreqSemigroup f) (FreqSemigroup g) = + FreqSemigroup \pos -> + case f pos of + Tuple (Just pos') _ -> g pos' + result -> result + +-- | Creates a generator that outputs a value chosen from a selection of +-- | existing generators, where the selection has weight values for the +-- | probability of choice for each generator. The probability values will be +-- | normalised. +frequency + :: forall m f a + . MonadGen m + => Foldable1 f + => f (Tuple Number (m a)) + -> m a +frequency xs = + let total = alaF Additive foldMap fst xs + in chooseFloat 0.0 total >>= getFreqVal (foldMap1 freqSemigroup xs) + +-- | Creates a generator that outputs a value chosen from a selection with +-- | uniform probability. +elements :: forall m f a. MonadGen m => Foldable1 f => f a -> m a +elements xs = do + n <- chooseInt 0 (length xs - 1) + pure $ fromIndex n xs + +-- | Creates a generator that produces unfoldable structures based on an +-- | existing generator for the elements. +-- | +-- | The size of the unfoldable will be determined by the current size state +-- | for the generator. To generate an unfoldable structure of a particular +-- | size, use the `resize` function from the `MonadGen` class first. +unfoldable + :: forall m f a + . MonadRec m + => MonadGen m + => Unfoldable f + => m a + -> m (f a) +unfoldable gen = unfoldr unfold <$> sized (tailRecM loopGen <<< Tuple Nil) + where + loopGen :: Tuple (LL a) Int -> m (Step (Tuple (LL a) Int) (LL a)) + loopGen (Tuple acc n) + | n <= 0 = + pure $ Done acc + | otherwise = do + x <- gen + pure $ Loop (Tuple (Cons x acc) (n - 1)) + unfold :: LL a -> Maybe (Tuple a (LL a)) + unfold = case _ of + Nil -> Nothing + Cons x xs -> Just (Tuple x xs) + +-- | Creates a generator that repeatedly run another generator until its output +-- | matches a given predicate. This will never halt if the predicate always +-- | fails. +suchThat :: forall m a. MonadRec m => MonadGen m => m a -> (a -> Boolean) -> m a +suchThat gen pred = filtered $ gen <#> \a -> if pred a then Just a else Nothing + +-- | Creates a generator that repeatedly run another generator until it produces +-- | `Just` node. This will never halt if the input generator always produces `Nothing`. +filtered :: forall m a. MonadRec m => MonadGen m => m (Maybe a) -> m a +filtered gen = tailRecM go unit + where + go :: Unit -> m (Step Unit a) + go _ = gen <#> \a -> case a of + Nothing -> Loop unit + Just a' -> Done a' + +-- | Internal: get the Foldable element at index i. +-- | If the index is <= 0, return the first element. +-- | If it's >= length, return the last. +fromIndex :: forall f a. Foldable1 f => Int -> f a -> a +fromIndex i xs = go i (foldr Cons Nil xs) + where + go _ (Cons a Nil) = a + go j (Cons a _) | j <= 0 = a + go j (Cons _ as) = go (j - 1) as + -- next case is "impossible", but serves as proof of non-emptyness + go _ Nil = un Last (foldMap1 Last xs) diff --git a/stdlib/lib/Control/Monad/Gen/Class.purs b/stdlib/lib/Control/Monad/Gen/Class.purs new file mode 100644 index 00000000..3a972c7a --- /dev/null +++ b/stdlib/lib/Control/Monad/Gen/Class.purs @@ -0,0 +1,29 @@ +module Control.Monad.Gen.Class where + +import Prelude + +-- | A class for random generator implementations. +-- | +-- | Instances should provide implementations for the generation functions +-- | that return choices with uniform probability. +-- | +-- | See also `Gen` in `purescript-quickcheck`, which implements this +-- | type class. +class Monad m <= MonadGen m where + + -- | Chooses an integer in the specified (inclusive) range. + chooseInt :: Int -> Int -> m Int + + -- | Chooses an floating point number in the specified (inclusive) range. + chooseFloat :: Number -> Number -> m Number + + -- | Chooses a random boolean value. + chooseBool :: m Boolean + + -- | Modifies the size state for a random generator. + resize :: forall a. (Size -> Size) -> m a -> m a + + -- | Runs a generator, passing in the current size state. + sized :: forall a. (Size -> m a) -> m a + +type Size = Int diff --git a/stdlib/lib/Control/Monad/Gen/Common.purs b/stdlib/lib/Control/Monad/Gen/Common.purs new file mode 100644 index 00000000..f1d76ae5 --- /dev/null +++ b/stdlib/lib/Control/Monad/Gen/Common.purs @@ -0,0 +1,67 @@ +module Control.Monad.Gen.Common where + +import Prelude + +import Control.Apply (lift2) +import Control.Monad.Gen (class MonadGen, chooseFloat, resize, unfoldable) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe(..)) +import Data.NonEmpty (NonEmpty, (:|)) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable) + +-- | Creates a generator that outputs `Either` values, choosing a value from a +-- | `Left` or the `Right` with even probability. +genEither :: forall m a b. MonadGen m => m a -> m b -> m (Either a b) +genEither = genEither' 0.5 + +-- | Creates a generator that outputs `Either` values, choosing a value from a +-- | `Left` or the `Right` with adjustable bias. As the bias value increases, +-- | the chance of returning a `Left` value rises. A bias ≤ 0.0 will always +-- | return `Right`, a bias ≥ 1.0 will always return `Left`. +genEither' :: forall m a b. MonadGen m => Number -> m a -> m b -> m (Either a b) +genEither' bias genA genB = do + n <- chooseFloat 0.0 1.0 + if n < bias then Left <$> genA else Right <$> genB + +-- | Creates a generator that outputs `Identity` values, choosing a value from +-- | another generator for the inner value. +genIdentity :: forall m a. Functor m => m a -> m (Identity a) +genIdentity = map Identity + +-- | Creates a generator that outputs `Maybe` values, choosing a value from +-- | another generator for the inner value. The generator has a 75% chance of +-- | returning a `Just` over a `Nothing`. +genMaybe :: forall m a. MonadGen m => m a -> m (Maybe a) +genMaybe = genMaybe' 0.75 + +-- | Creates a generator that outputs `Maybe` values, choosing a value from +-- | another generator for the inner value, with an adjustable bias for how +-- | often `Just` is returned vs `Nothing`. A bias ≤ 0.0 will always +-- | return `Nothing`, a bias ≥ 1.0 will always return `Just`. +genMaybe' :: forall m a. MonadGen m => Number -> m a -> m (Maybe a) +genMaybe' bias gen = do + n <- chooseFloat 0.0 1.0 + if n < bias then Just <$> gen else pure Nothing + +-- | Creates a generator that outputs `Tuple` values, choosing values from a +-- | pair of generators for each slot in the tuple. +genTuple :: forall m a b. Apply m => m a -> m b -> m (Tuple a b) +genTuple = lift2 Tuple + +-- | Creates a generator that outputs `NonEmpty` values, choosing values from a +-- | generator for each of the items. +-- | +-- | The size of the value will be determined by the current size state +-- | for the generator. To generate a value of a particular size, use the +-- | `resize` function from the `MonadGen` class first. +genNonEmpty + :: forall m a f + . MonadRec m + => MonadGen m + => Unfoldable f + => m a + -> m (NonEmpty f a) +genNonEmpty gen = (:|) <$> gen <*> resize (max 0 <<< (_ - 1)) (unfoldable gen) diff --git a/stdlib/lib/Control/Monad/Rec/Class.purs b/stdlib/lib/Control/Monad/Rec/Class.purs new file mode 100644 index 00000000..b80de6b8 --- /dev/null +++ b/stdlib/lib/Control/Monad/Rec/Class.purs @@ -0,0 +1,191 @@ +module Control.Monad.Rec.Class + ( Step(..) + , class MonadRec + , tailRec + , tailRec2 + , tailRec3 + , tailRecM + , tailRecM2 + , tailRecM3 + , forever + , whileJust + , untilJust + , loop2 + , loop3 + ) where + +import Prelude + +import Data.Bifunctor (class Bifunctor) +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe(..)) +import Effect (Effect, untilE) +import Effect.Ref as Ref +import Partial.Unsafe (unsafePartial) + +-- | The result of a computation: either `Loop` containing the updated +-- | accumulator, or `Done` containing the final result of the computation. +data Step a b = Loop a | Done b + +derive instance functorStep :: Functor (Step a) + +instance bifunctorStep :: Bifunctor Step where + bimap f _ (Loop a) = Loop (f a) + bimap _ g (Done b) = Done (g b) + +-- | This type class captures those monads which support tail recursion in +-- | constant stack space. +-- | +-- | The `tailRecM` function takes a step function, and applies that step +-- | function recursively until a pure value of type `b` is found. +-- | +-- | Instances are provided for standard monad transformers. +-- | +-- | For example: +-- | +-- | ```purescript +-- | loopWriter :: Int -> WriterT (Additive Int) Effect Unit +-- | loopWriter n = tailRecM go n +-- | where +-- | go 0 = do +-- | traceM "Done!" +-- | pure (Done unit) +-- | go i = do +-- | tell $ Additive i +-- | pure (Loop (i - 1)) +-- | ``` +class Monad m <= MonadRec m where + tailRecM :: forall a b. (a -> m (Step a b)) -> a -> m b + +-- | Create a tail-recursive function of two arguments which uses constant stack space. +-- | +-- | The `loop2` helper function provides a curried alternative to the `Loop` +-- | constructor for this function. +tailRecM2 + :: forall m a b c + . MonadRec m + => (a -> b -> m (Step { a :: a, b :: b } c)) + -> a + -> b + -> m c +tailRecM2 f a b = tailRecM (\o -> f o.a o.b) { a, b } + +-- | Create a tail-recursive function of three arguments which uses constant stack space. +-- | +-- | The `loop3` helper function provides a curried alternative to the `Loop` +-- | constructor for this function. +tailRecM3 + :: forall m a b c d + . MonadRec m + => (a -> b -> c -> m (Step { a :: a, b :: b, c :: c } d)) + -> a + -> b + -> c + -> m d +tailRecM3 f a b c = tailRecM (\o -> f o.a o.b o.c) { a, b, c } + +-- | Create a pure tail-recursive function of one argument +-- | +-- | For example: +-- | +-- | ```purescript +-- | pow :: Int -> Int -> Int +-- | pow n p = tailRec go { accum: 1, power: p } +-- | where +-- | go :: _ -> Step _ Int +-- | go { accum: acc, power: 0 } = Done acc +-- | go { accum: acc, power: p } = Loop { accum: acc * n, power: p - 1 } +-- | ``` +tailRec :: forall a b. (a -> Step a b) -> a -> b +tailRec f = go <<< f + where + go (Loop a) = go (f a) + go (Done b) = b + +-- | Create a pure tail-recursive function of two arguments +-- | +-- | The `loop2` helper function provides a curried alternative to the `Loop` +-- | constructor for this function. +tailRec2 :: forall a b c. (a -> b -> Step { a :: a, b :: b } c) -> a -> b -> c +tailRec2 f a b = tailRec (\o -> f o.a o.b) { a, b } + +-- | Create a pure tail-recursive function of three arguments +-- | +-- | The `loop3` helper function provides a curried alternative to the `Loop` +-- | constructor for this function. +tailRec3 :: forall a b c d. (a -> b -> c -> Step { a :: a, b :: b, c :: c } d) -> a -> b -> c -> d +tailRec3 f a b c = tailRec (\o -> f o.a o.b o.c) { a, b, c } + +instance monadRecIdentity :: MonadRec Identity where + tailRecM f = Identity <<< tailRec (runIdentity <<< f) + where runIdentity (Identity x) = x + +instance monadRecEffect :: MonadRec Effect where + tailRecM f a = do + r <- Ref.new =<< f a + untilE do + Ref.read r >>= case _ of + Loop a' -> do + e <- f a' + _ <- Ref.write e r + pure false + Done _ -> pure true + fromDone <$> Ref.read r + where + fromDone :: forall a b. Step a b -> b + fromDone = unsafePartial \(Done b) -> b + +instance monadRecFunction :: MonadRec ((->) e) where + tailRecM f a0 e = tailRec (\a -> f a e) a0 + +instance monadRecEither :: MonadRec (Either e) where + tailRecM f a0 = + let + g (Left e) = Done (Left e) + g (Right (Loop a)) = Loop (f a) + g (Right (Done b)) = Done (Right b) + in tailRec g (f a0) + +instance monadRecMaybe :: MonadRec Maybe where + tailRecM f a0 = + let + g Nothing = Done Nothing + g (Just (Loop a)) = Loop (f a) + g (Just (Done b)) = Done (Just b) + in tailRec g (f a0) + +-- | `forever` runs an action indefinitely, using the `MonadRec` instance to +-- | ensure constant stack usage. +-- | +-- | For example: +-- | +-- | ```purescript +-- | main = forever $ trace "Hello, World!" +-- | ``` +forever :: forall m a b. MonadRec m => m a -> m b +forever ma = tailRecM (\u -> Loop u <$ ma) unit + +-- | While supplied computation evaluates to `Just _`, it will be +-- | executed repeatedly and results will be combined using monoid instance. +whileJust :: forall a m. Monoid a => MonadRec m => m (Maybe a) -> m a +whileJust m = mempty # tailRecM \v -> m <#> case _ of + Nothing -> Done v + Just x -> Loop $ v <> x + +-- | Supplied computation will be executed repeatedly until it evaluates +-- | to `Just value` and then that `value` will be returned. +untilJust :: forall a m. MonadRec m => m (Maybe a) -> m a +untilJust m = unit # tailRecM \_ -> m <#> case _ of + Nothing -> Loop unit + Just x -> Done x + +-- | A curried version of the `Loop` constructor, provided as a convenience for +-- | use with `tailRec2` and `tailRecM2`. +loop2 :: forall a b c. a -> b -> Step { a :: a, b :: b } c +loop2 a b = Loop { a, b } + +-- | A curried version of the `Loop` constructor, provided as a convenience for +-- | use with `tailRec3` and `tailRecM3`. +loop3 :: forall a b c d. a -> b -> c -> Step { a :: a, b :: b, c :: c } d +loop3 a b c = Loop { a, b, c } diff --git a/stdlib/lib/Control/Monad/ST.purs b/stdlib/lib/Control/Monad/ST.purs new file mode 100644 index 00000000..b8b11fd4 --- /dev/null +++ b/stdlib/lib/Control/Monad/ST.purs @@ -0,0 +1,3 @@ +module Control.Monad.ST (module Internal) where + +import Control.Monad.ST.Internal (ST, Region, run, while, for, foreach) as Internal diff --git a/stdlib/lib/Control/Monad/ST/Class.purs b/stdlib/lib/Control/Monad/ST/Class.purs new file mode 100644 index 00000000..692b317c --- /dev/null +++ b/stdlib/lib/Control/Monad/ST/Class.purs @@ -0,0 +1,17 @@ +module Control.Monad.ST.Class where + +import Prelude + +import Control.Monad.ST (ST) +import Control.Monad.ST.Global (Global) +import Control.Monad.ST.Global as Global +import Effect (Effect) + +class Monad m <= MonadST s m | m -> s where + liftST :: ST s ~> m + +instance monadSTEffect :: MonadST Global Effect where + liftST = Global.toEffect + +instance monadSTST :: MonadST s (ST s) where + liftST = identity diff --git a/stdlib/lib/Control/Monad/ST/Global.purs b/stdlib/lib/Control/Monad/ST/Global.purs new file mode 100644 index 00000000..58a822ab --- /dev/null +++ b/stdlib/lib/Control/Monad/ST/Global.purs @@ -0,0 +1,18 @@ +module Control.Monad.ST.Global + ( Global + , toEffect + ) where + +import Prelude + +import Control.Monad.ST (ST, Region) +import Effect (Effect) +import Unsafe.Coerce (unsafeCoerce) + +-- | This region allows `ST` computations to be converted into `Effect` +-- | computations so they can be run in a global context. +foreign import data Global :: Region + +-- | Converts an `ST` computation into an `Effect` computation. +toEffect :: ST Global ~> Effect +toEffect = unsafeCoerce diff --git a/stdlib/lib/Control/Monad/ST/Internal.purs b/stdlib/lib/Control/Monad/ST/Internal.purs new file mode 100644 index 00000000..a736f9f0 --- /dev/null +++ b/stdlib/lib/Control/Monad/ST/Internal.purs @@ -0,0 +1,147 @@ +module Control.Monad.ST.Internal + ( Region + , ST + , run + , while + , for + , foreach + , STRef + , new + , read + , modify' + , modify + , write + ) where + +import Prelude + +import Control.Apply (lift2) +import Control.Monad.Rec.Class (class MonadRec, Step(..)) +import Partial.Unsafe (unsafePartial) + +-- | `ST` is concerned with _restricted_ mutation. Mutation is restricted to a +-- | _region_ of mutable references. This kind is inhabited by phantom types +-- | which represent regions in the type system. +foreign import data Region :: Type + +-- | The `ST` type constructor allows _local mutation_, i.e. mutation which +-- | does not "escape" into the surrounding computation. +-- | +-- | An `ST` computation is parameterized by a phantom type which is used to +-- | restrict the set of reference cells it is allowed to access. +-- | +-- | The `run` function can be used to run a computation in the `ST` monad. +foreign import data ST :: Region -> Type -> Type + +type role ST nominal representational + +map_ :: forall r a b. (a -> b) -> ST r a -> ST r b +map_ a0 a1 = map_ a0 a1 + +pure_ :: forall r a. a -> ST r a +pure_ a0 = pure_ a0 + +bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b +bind_ a0 a1 = bind_ a0 a1 + +instance functorST :: Functor (ST r) where + map = map_ + +instance applyST :: Apply (ST r) where + apply = ap + +instance applicativeST :: Applicative (ST r) where + pure = pure_ + +instance bindST :: Bind (ST r) where + bind = bind_ + +instance monadST :: Monad (ST r) + +instance monadRecST :: MonadRec (ST r) where + tailRecM f a = do + r <- new =<< f a + while (isLooping <$> read r) do + read r >>= case _ of + Loop a' -> do + e <- f a' + void (write e r) + Done _ -> pure unit + fromDone <$> read r + where + fromDone :: forall a b. Step a b -> b + fromDone = unsafePartial \(Done b) -> b + + isLooping = case _ of + Loop _ -> true + _ -> false + +instance semigroupST :: Semigroup a => Semigroup (ST r a) where + append = lift2 append + +instance monoidST :: Monoid a => Monoid (ST r a) where + mempty = pure mempty + +-- | Run an `ST` computation. +-- | +-- | Note: the type of `run` uses a rank-2 type to constrain the phantom +-- | type `r`, such that the computation must not leak any mutable references +-- | to the surrounding computation. It may cause problems to apply this +-- | function using the `$` operator. The recommended approach is to use +-- | parentheses instead. +run :: forall a. (forall r. ST r a) -> a +run a0 = run a0 + +-- | Loop while a condition is `true`. +-- | +-- | `while b m` is ST computation which runs the ST computation `b`. If its +-- | result is `true`, it runs the ST computation `m` and loops. If not, the +-- | computation ends. +while :: forall r a. ST r Boolean -> ST r a -> ST r Unit +while a0 a1 = while a0 a1 + +-- | Loop over a consecutive collection of numbers +-- | +-- | `ST.for lo hi f` runs the computation returned by the function `f` for each +-- | of the inputs between `lo` (inclusive) and `hi` (exclusive). +for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit +for a0 a1 a2 = for a0 a1 a2 + +-- | Loop over an array of values. +-- | +-- | `ST.foreach xs f` runs the computation returned by the function `f` for each +-- | of the inputs `xs`. +foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit +foreach a0 a1 = foreach a0 a1 + +-- | The type `STRef r a` represents a mutable reference holding a value of +-- | type `a`, which can be used with the `ST r` effect. +foreign import data STRef :: Region -> Type -> Type + +type role STRef nominal representational + +-- | Create a new mutable reference. +new :: forall a r. a -> ST r (STRef r a) +new a0 = new a0 + +-- | Read the current value of a mutable reference. +read :: forall a r. STRef r a -> ST r a +read a0 = read a0 + +-- | Update the value of a mutable reference by applying a function +-- | to the current value, computing a new state value for the reference and +-- | a return value. +modify' :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b +modify' = modifyImpl + +modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b +modifyImpl a0 a1 = modifyImpl a0 a1 + +-- | Modify the value of a mutable reference by applying a function to the +-- | current value. The modified value is returned. +modify :: forall r a. (a -> a) -> STRef r a -> ST r a +modify f = modify' \s -> let s' = f s in { state: s', value: s' } + +-- | Set the value of a mutable reference. +write :: forall a r. a -> STRef r a -> ST r a +write a0 a1 = write a0 a1 diff --git a/stdlib/lib/Control/Monad/ST/Ref.purs b/stdlib/lib/Control/Monad/ST/Ref.purs new file mode 100644 index 00000000..1759d9fb --- /dev/null +++ b/stdlib/lib/Control/Monad/ST/Ref.purs @@ -0,0 +1,3 @@ +module Control.Monad.ST.Ref (module Internal) where + +import Control.Monad.ST.Internal (STRef, new, read, modify, modify', write) as Internal diff --git a/stdlib/lib/Control/Monad/ST/Uncurried.purs b/stdlib/lib/Control/Monad/ST/Uncurried.purs new file mode 100644 index 00000000..965cd6c0 --- /dev/null +++ b/stdlib/lib/Control/Monad/ST/Uncurried.purs @@ -0,0 +1,101 @@ +-- | This module defines types for STf uncurried functions, as well as +-- | functions for converting back and forth between them. +-- | +-- | The general naming scheme for functions and types in this module is as +-- | follows: +-- | +-- | * `STFn{N}` means, an uncurried function which accepts N arguments and +-- | performs some STs. The first N arguments are the actual function's +-- | argument. The last type argument is the return type. +-- | * `runSTFn{N}` takes an `STFn` of N arguments, and converts it into +-- | the normal PureScript form: a curried function which returns an ST +-- | action. +-- | * `mkSTFn{N}` is the inverse of `runSTFn{N}`. It can be useful for +-- | callbacks. +-- | + +module Control.Monad.ST.Uncurried where + +import Control.Monad.ST.Internal (ST, Region) + +foreign import data STFn1 :: Type -> Region -> Type -> Type + +type role STFn1 representational nominal representational + +foreign import data STFn2 :: Type -> Type -> Region -> Type -> Type + +type role STFn2 representational representational nominal representational + +foreign import data STFn3 :: Type -> Type -> Type -> Region -> Type -> Type + +type role STFn3 representational representational representational nominal representational + +foreign import data STFn4 :: Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn4 representational representational representational representational nominal representational + +foreign import data STFn5 :: Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn5 representational representational representational representational representational nominal representational + +foreign import data STFn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn6 representational representational representational representational representational representational nominal representational + +foreign import data STFn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn7 representational representational representational representational representational representational representational nominal representational + +foreign import data STFn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn8 representational representational representational representational representational representational representational representational nominal representational + +foreign import data STFn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn9 representational representational representational representational representational representational representational representational representational nominal representational + +foreign import data STFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type + +type role STFn10 representational representational representational representational representational representational representational representational representational representational nominal representational + +mkSTFn1 :: forall a t r. (a -> ST t r) -> STFn1 a t r +mkSTFn1 a0 = mkSTFn1 a0 +mkSTFn2 :: forall a b t r. (a -> b -> ST t r) -> STFn2 a b t r +mkSTFn2 a0 = mkSTFn2 a0 +mkSTFn3 :: forall a b c t r. (a -> b -> c -> ST t r) -> STFn3 a b c t r +mkSTFn3 a0 = mkSTFn3 a0 +mkSTFn4 :: forall a b c d t r. (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r +mkSTFn4 a0 = mkSTFn4 a0 +mkSTFn5 :: forall a b c d e t r. (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r +mkSTFn5 a0 = mkSTFn5 a0 +mkSTFn6 :: forall a b c d e f t r. (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r +mkSTFn6 a0 = mkSTFn6 a0 +mkSTFn7 :: forall a b c d e f g t r. (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r +mkSTFn7 a0 = mkSTFn7 a0 +mkSTFn8 :: forall a b c d e f g h t r. (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r +mkSTFn8 a0 = mkSTFn8 a0 +mkSTFn9 :: forall a b c d e f g h i t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r +mkSTFn9 a0 = mkSTFn9 a0 +mkSTFn10 :: forall a b c d e f g h i j t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r +mkSTFn10 a0 = mkSTFn10 a0 + +runSTFn1 :: forall a t r. STFn1 a t r -> a -> ST t r +runSTFn1 a0 a1 = runSTFn1 a0 a1 +runSTFn2 :: forall a b t r. STFn2 a b t r -> a -> b -> ST t r +runSTFn2 a0 a1 a2 = runSTFn2 a0 a1 a2 +runSTFn3 :: forall a b c t r. STFn3 a b c t r -> a -> b -> c -> ST t r +runSTFn3 a0 a1 a2 a3 = runSTFn3 a0 a1 a2 a3 +runSTFn4 :: forall a b c d t r. STFn4 a b c d t r -> a -> b -> c -> d -> ST t r +runSTFn4 a0 a1 a2 a3 a4 = runSTFn4 a0 a1 a2 a3 a4 +runSTFn5 :: forall a b c d e t r. STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r +runSTFn5 a0 a1 a2 a3 a4 a5 = runSTFn5 a0 a1 a2 a3 a4 a5 +runSTFn6 :: forall a b c d e f t r. STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r +runSTFn6 a0 a1 a2 a3 a4 a5 a6 = runSTFn6 a0 a1 a2 a3 a4 a5 a6 +runSTFn7 :: forall a b c d e f g t r. STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r +runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 +runSTFn8 :: forall a b c d e f g h t r. STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r +runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 +runSTFn9 :: forall a b c d e f g h i t r. STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r +runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 +runSTFn10 :: forall a b c d e f g h i j t r. STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r +runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 diff --git a/stdlib/lib/Control/MonadPlus.purs b/stdlib/lib/Control/MonadPlus.purs new file mode 100644 index 00000000..83f71abc --- /dev/null +++ b/stdlib/lib/Control/MonadPlus.purs @@ -0,0 +1,32 @@ +module Control.MonadPlus + ( class MonadPlus + , module Control.Alt + , module Control.Alternative + , module Control.Applicative + , module Control.Apply + , module Control.Bind + , module Control.Monad + , module Control.Plus + , module Data.Functor + ) where + +import Control.Alt (class Alt, alt, (<|>)) +import Control.Alternative (class Alternative, guard) +import Control.Applicative (class Applicative, pure, liftA1, unless, when) +import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) +import Control.Bind (class Bind, bind, ifM, join, (<=<), (=<<), (>=>), (>>=)) +import Control.Monad (class Monad, ap, liftM1) +import Control.Plus (class Plus, empty) + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) + +-- | The `MonadPlus` type class has no members of its own; it just specifies +-- | that the type has both `Monad` and `Alternative` instances. +-- | +-- | Types which have `MonadPlus` instances should also satisfy the following +-- | law: +-- | +-- | - Distributivity: `(x <|> y) >>= f == (x >>= f) <|> (y >>= f)` +class (Monad m, Alternative m) <= MonadPlus m + +instance monadPlusArray :: MonadPlus Array diff --git a/stdlib/lib/Control/Plus.purs b/stdlib/lib/Control/Plus.purs new file mode 100644 index 00000000..f8724ea6 --- /dev/null +++ b/stdlib/lib/Control/Plus.purs @@ -0,0 +1,27 @@ +module Control.Plus + ( class Plus, empty + , module Control.Alt + , module Data.Functor + ) where + +import Control.Alt (class Alt, alt, (<|>)) + +import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) + +-- | The `Plus` type class extends the `Alt` type class with a value that +-- | should be the left and right identity for `(<|>)`. +-- | +-- | It is similar to `Monoid`, except that it applies to types of +-- | kind `* -> *`, like `Array` or `List`, rather than concrete types like +-- | `String` or `Number`. +-- | +-- | `Plus` instances should satisfy the following laws: +-- | +-- | - Left identity: `empty <|> x == x` +-- | - Right identity: `x <|> empty == x` +-- | - Annihilation: `f <$> empty == empty` +class Alt f <= Plus f where + empty :: forall a. f a + +instance plusArray :: Plus Array where + empty = [] diff --git a/stdlib/lib/Control/Semigroupoid.purs b/stdlib/lib/Control/Semigroupoid.purs new file mode 100644 index 00000000..a529e0f7 --- /dev/null +++ b/stdlib/lib/Control/Semigroupoid.purs @@ -0,0 +1,25 @@ +module Control.Semigroupoid where + +-- | A `Semigroupoid` is similar to a [`Category`](#category) but does not +-- | require an identity element `identity`, just composable morphisms. +-- | +-- | `Semigroupoid`s must satisfy the following law: +-- | +-- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r` +-- | +-- | One example of a `Semigroupoid` is the function type constructor `(->)`, +-- | with `(<<<)` defined as function composition. +class Semigroupoid :: forall k. (k -> k -> Type) -> Constraint +class Semigroupoid a where + compose :: forall b c d. a c d -> a b c -> a b d + +instance semigroupoidFn :: Semigroupoid (->) where + compose f g x = f (g x) + +infixr 9 compose as <<< + +-- | Forwards composition, or `compose` with its arguments reversed. +composeFlipped :: forall a b c d. Semigroupoid a => a b c -> a c d -> a b d +composeFlipped f g = compose g f + +infixr 9 composeFlipped as >>> diff --git a/stdlib/lib/Data/Array.purs b/stdlib/lib/Data/Array.purs new file mode 100644 index 00000000..d9953366 --- /dev/null +++ b/stdlib/lib/Data/Array.purs @@ -0,0 +1,1335 @@ +-- | Helper functions for working with immutable Javascript arrays. +-- | +-- | _Note_: Depending on your use-case, you may prefer to use `Data.List` or +-- | `Data.Sequence` instead, which might give better performance for certain +-- | use cases. This module is useful when integrating with JavaScript libraries +-- | which use arrays, but immutable arrays are not a practical data structure +-- | for many use cases due to their poor asymptotics. +-- | +-- | In addition to the functions in this module, Arrays have a number of +-- | useful instances: +-- | +-- | * `Functor`, which provides `map :: forall a b. (a -> b) -> Array a -> +-- | Array b` +-- | * `Apply`, which provides `(<*>) :: forall a b. Array (a -> b) -> Array a +-- | -> Array b`. This function works a bit like a Cartesian product; the +-- | result array is constructed by applying each function in the first +-- | array to each value in the second, so that the result array ends up with +-- | a length equal to the product of the two arguments' lengths. +-- | * `Bind`, which provides `(>>=) :: forall a b. (a -> Array b) -> Array a +-- | -> Array b` (this is the same as `concatMap`). +-- | * `Semigroup`, which provides `(<>) :: forall a. Array a -> Array a -> +-- | Array a`, for concatenating arrays. +-- | * `Foldable`, which provides a slew of functions for *folding* (also known +-- | as *reducing*) arrays down to one value. For example, +-- | `Data.Foldable.or` tests whether an array of `Boolean` values contains +-- | at least one `true` value. +-- | * `Traversable`, which provides the PureScript version of a for-loop, +-- | allowing you to STAI.iterate over an array and accumulate effects. +-- | +module Data.Array + ( fromFoldable + , toUnfoldable + , singleton + , (..) + , range + , replicate + , some + , many + + , null + , length + + , (:) + , cons + , snoc + , insert + , insertBy + + , head + , last + , tail + , init + , uncons + , unsnoc + + , (!!) + , index + , elem + , notElem + , elemIndex + , elemLastIndex + , find + , findMap + , findIndex + , findLastIndex + , insertAt + , deleteAt + , updateAt + , updateAtIndices + , modifyAt + , modifyAtIndices + , alterAt + + , intersperse + , reverse + , concat + , concatMap + , filter + , partition + , splitAt + , filterA + , mapMaybe + , catMaybes + , mapWithIndex + , foldl + , foldr + , foldMap + , fold + , intercalate + , transpose + , scanl + , scanr + + , sort + , sortBy + , sortWith + , slice + , take + , takeEnd + , takeWhile + , drop + , dropEnd + , dropWhile + , span + , group + , groupAll + , groupBy + , groupAllBy + + , nub + , nubEq + , nubBy + , nubByEq + , union + , unionBy + , delete + , deleteBy + + , (\\) + , difference + , intersect + , intersectBy + + , zipWith + , zipWithA + , zip + , unzip + + , any + , all + + , foldM + , foldRecM + + , unsafeIndex + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy, defer) +import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2) +import Control.Monad.ST as ST +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) +import Data.Array.ST as STA +import Data.Array.ST.Iterator as STAI +import Data.Foldable (class Foldable, traverse_) +import Data.Foldable as F +import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn5, runFn2, runFn3, runFn4, runFn5) +import Data.FunctorWithIndex as FWI +import Data.Maybe (Maybe(..), maybe, isJust, fromJust, isNothing) +import Data.Traversable (sequence, traverse) +import Data.Tuple (Tuple(..), fst, snd) +import Data.Unfoldable (class Unfoldable, unfoldr) +import Partial.Unsafe (unsafePartial) + +-- | Convert an `Array` into an `Unfoldable` structure. +toUnfoldable :: forall f. Unfoldable f => Array ~> f +toUnfoldable xs = unfoldr f 0 + where + len = length xs + f i + | i < len = Just (Tuple (unsafePartial (unsafeIndex xs i)) (i + 1)) + | otherwise = Nothing + +-- | Convert a `Foldable` structure into an `Array`. +-- | +-- | ```purescript +-- | fromFoldable (Just 1) = [1] +-- | fromFoldable (Nothing) = [] +-- | ``` +-- | +fromFoldable :: forall f. Foldable f => f ~> Array +fromFoldable = runFn2 fromFoldableImpl F.foldr + +fromFoldableImpl :: forall f a . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a) +fromFoldableImpl = fromFoldableImpl + +-- | Create an array of one element +-- | ```purescript +-- | singleton 2 = [2] +-- | ``` +singleton :: forall a. a -> Array a +singleton a = [ a ] + +-- | Create an array containing a range of integers, including both endpoints. +-- | ```purescript +-- | range 2 5 = [2, 3, 4, 5] +-- | ``` +range :: Int -> Int -> Array Int +range = runFn2 rangeImpl + +rangeImpl :: Fn2 Int Int (Array Int) +rangeImpl = rangeImpl + +-- | Create an array containing a value repeated the specified number of times. +-- | ```purescript +-- | replicate 2 "Hi" = ["Hi", "Hi"] +-- | ``` +replicate :: forall a. Int -> a -> Array a +replicate = runFn2 replicateImpl + +replicateImpl :: forall a. Fn2 Int a (Array a) +replicateImpl = replicateImpl + +-- | An infix synonym for `range`. +-- | ```purescript +-- | 2 .. 5 = [2, 3, 4, 5] +-- | ``` +infix 8 range as .. + +-- | Attempt a computation multiple times, requiring at least one success. +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +some :: forall f a. Alternative f => Lazy (f (Array a)) => f a -> f (Array a) +some v = (:) <$> v <*> defer (\_ -> many v) + +-- | Attempt a computation multiple times, returning as many successful results +-- | as possible (possibly zero). +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +many :: forall f a. Alternative f => Lazy (f (Array a)) => f a -> f (Array a) +many v = some v <|> pure [] + +-------------------------------------------------------------------------------- +-- Array size ------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-- | Test whether an array is empty. +-- | ```purescript +-- | null [] = true +-- | null [1, 2] = false +-- | ``` +null :: forall a. Array a -> Boolean +null xs = length xs == 0 + +-- | Get the number of elements in an array. +-- | ```purescript +-- | length ["Hello", "World"] = 2 +-- | ``` +length :: forall a. Array a -> Int +length a0 = length a0 + +-------------------------------------------------------------------------------- +-- Extending arrays ------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-- | Attaches an element to the front of an array, creating a new array. +-- | +-- | ```purescript +-- | cons 1 [2, 3, 4] = [1, 2, 3, 4] +-- | ``` +-- | +-- | Note, the running time of this function is `O(n)`. +cons :: forall a. a -> Array a -> Array a +cons x xs = [ x ] <> xs + +-- | An infix alias for `cons`. +-- | +-- | ```purescript +-- | 1 : [2, 3, 4] = [1, 2, 3, 4] +-- | ``` +-- | +-- | Note, the running time of this function is `O(n)`. +infixr 6 cons as : + +-- | Append an element to the end of an array, creating a new array. +-- | +-- | ```purescript +-- | snoc [1, 2, 3] 4 = [1, 2, 3, 4] +-- | ``` +-- | +snoc :: forall a. Array a -> a -> Array a +snoc xs x = ST.run (STA.withArray (STA.push x) xs) + +-- | Insert an element into a sorted array. +-- | +-- | ```purescript +-- | insert 10 [1, 2, 20, 21] = [1, 2, 10, 20, 21] +-- | ``` +-- | +insert :: forall a. Ord a => a -> Array a -> Array a +insert = insertBy compare + +-- | Insert an element into a sorted array, using the specified function to +-- | determine the ordering of elements. +-- | +-- | ```purescript +-- | invertCompare a b = invert $ compare a b +-- | +-- | insertBy invertCompare 10 [21, 20, 2, 1] = [21, 20, 10, 2, 1] +-- | ``` +-- | +insertBy :: forall a. (a -> a -> Ordering) -> a -> Array a -> Array a +insertBy cmp x ys = + let + i = maybe 0 (_ + 1) (findLastIndex (\y -> cmp x y == GT) ys) + in + unsafePartial (fromJust (insertAt i x ys)) + +-------------------------------------------------------------------------------- +-- Non-indexed reads ----------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Get the first element in an array, or `Nothing` if the array is empty +-- | +-- | Running time: `O(1)`. +-- | +-- | ```purescript +-- | head [1, 2] = Just 1 +-- | head [] = Nothing +-- | ``` +-- | +head :: forall a. Array a -> Maybe a +head xs = xs !! 0 + +-- | Get the last element in an array, or `Nothing` if the array is empty +-- | +-- | Running time: `O(1)`. +-- | +-- | ```purescript +-- | last [1, 2] = Just 2 +-- | last [] = Nothing +-- | ``` +-- | +last :: forall a. Array a -> Maybe a +last xs = xs !! (length xs - 1) + +-- | Get all but the first element of an array, creating a new array, or +-- | `Nothing` if the array is empty +-- | +-- | ```purescript +-- | tail [1, 2, 3, 4] = Just [2, 3, 4] +-- | tail [] = Nothing +-- | ``` +-- | +-- | Running time: `O(n)` where `n` is the length of the array +tail :: forall a. Array a -> Maybe (Array a) +tail = runFn3 unconsImpl (const Nothing) (\_ xs -> Just xs) + +-- | Get all but the last element of an array, creating a new array, or +-- | `Nothing` if the array is empty. +-- | +-- | ```purescript +-- | init [1, 2, 3, 4] = Just [1, 2, 3] +-- | init [] = Nothing +-- | ``` +-- | +-- | Running time: `O(n)` where `n` is the length of the array +init :: forall a. Array a -> Maybe (Array a) +init xs + | null xs = Nothing + | otherwise = Just (slice zero (length xs - one) xs) + +-- | Break an array into its first element and remaining elements. +-- | +-- | Using `uncons` provides a way of writing code that would use cons patterns +-- | in Haskell or pre-PureScript 0.7: +-- | ``` purescript +-- | f (x : xs) = something +-- | f [] = somethingElse +-- | ``` +-- | Becomes: +-- | ``` purescript +-- | f arr = case uncons arr of +-- | Just { head: x, tail: xs } -> something +-- | Nothing -> somethingElse +-- | ``` +uncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a } +uncons = runFn3 unconsImpl (const Nothing) \x xs -> Just { head: x, tail: xs } + +unconsImpl :: forall a b . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b +unconsImpl = unconsImpl + +-- | Break an array into its last element and all preceding elements. +-- | +-- | ```purescript +-- | unsnoc [1, 2, 3] = Just {init: [1, 2], last: 3} +-- | unsnoc [] = Nothing +-- | ``` +-- | +-- | Running time: `O(n)` where `n` is the length of the array +unsnoc :: forall a. Array a -> Maybe { init :: Array a, last :: a } +unsnoc xs = { init: _, last: _ } <$> init xs <*> last xs + +-------------------------------------------------------------------------------- +-- Indexed operations ---------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | This function provides a safe way to read a value at a particular index +-- | from an array. +-- | +-- | ```purescript +-- | sentence = ["Hello", "World", "!"] +-- | +-- | index sentence 0 = Just "Hello" +-- | index sentence 7 = Nothing +-- | ``` +-- | +index :: forall a. Array a -> Int -> Maybe a +index = runFn4 indexImpl Just Nothing + +indexImpl :: forall a . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a) +indexImpl = indexImpl + +-- | An infix version of `index`. +-- | +-- | ```purescript +-- | sentence = ["Hello", "World", "!"] +-- | +-- | sentence !! 0 = Just "Hello" +-- | sentence !! 7 = Nothing +-- | ``` +-- | +infixl 8 index as !! + +-- | Returns true if the array has the given element. +elem :: forall a. Eq a => a -> Array a -> Boolean +elem a arr = isJust $ elemIndex a arr + +-- | Returns true if the array does not have the given element. +notElem :: forall a. Eq a => a -> Array a -> Boolean +notElem a arr = isNothing $ elemIndex a arr + +-- | Find the index of the first element equal to the specified element. +-- | +-- | ```purescript +-- | elemIndex "a" ["a", "b", "a", "c"] = Just 0 +-- | elemIndex "Earth" ["Hello", "World", "!"] = Nothing +-- | ``` +-- | +elemIndex :: forall a. Eq a => a -> Array a -> Maybe Int +elemIndex x = findIndex (_ == x) + +-- | Find the index of the last element equal to the specified element. +-- | +-- | ```purescript +-- | elemLastIndex "a" ["a", "b", "a", "c"] = Just 2 +-- | elemLastIndex "Earth" ["Hello", "World", "!"] = Nothing +-- | ``` +-- | +elemLastIndex :: forall a. Eq a => a -> Array a -> Maybe Int +elemLastIndex x = findLastIndex (_ == x) + +-- | Find the first element for which a predicate holds. +-- | +-- | ```purescript +-- | find (contains $ Pattern "b") ["a", "bb", "b", "d"] = Just "bb" +-- | find (contains $ Pattern "x") ["a", "bb", "b", "d"] = Nothing +-- | ``` +find :: forall a. (a -> Boolean) -> Array a -> Maybe a +find f xs = unsafePartial (unsafeIndex xs) <$> findIndex f xs + +-- | Find the first element in a data structure which satisfies +-- | a predicate mapping. +findMap :: forall a b. (a -> Maybe b) -> Array a -> Maybe b +findMap = runFn4 findMapImpl Nothing isJust + +findMapImpl :: forall a b . Fn4 (forall c. Maybe c) (forall c. Maybe c -> Boolean) (a -> Maybe b) (Array a) (Maybe b) +findMapImpl = findMapImpl + +-- | Find the first index for which a predicate holds. +-- | +-- | ```purescript +-- | findIndex (contains $ Pattern "b") ["a", "bb", "b", "d"] = Just 1 +-- | findIndex (contains $ Pattern "x") ["a", "bb", "b", "d"] = Nothing +-- | ``` +-- | +findIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int +findIndex = runFn4 findIndexImpl Just Nothing + +findIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int) +findIndexImpl = findIndexImpl + +-- | Find the last index for which a predicate holds. +-- | +-- | ```purescript +-- | findLastIndex (contains $ Pattern "b") ["a", "bb", "b", "d"] = Just 2 +-- | findLastIndex (contains $ Pattern "x") ["a", "bb", "b", "d"] = Nothing +-- | ``` +-- | +findLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int +findLastIndex = runFn4 findLastIndexImpl Just Nothing + +findLastIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int) +findLastIndexImpl = findLastIndexImpl + +-- | Insert an element at the specified index, creating a new array, or +-- | returning `Nothing` if the index is out of bounds. +-- | +-- | ```purescript +-- | insertAt 2 "!" ["Hello", "World"] = Just ["Hello", "World", "!"] +-- | insertAt 10 "!" ["Hello"] = Nothing +-- | ``` +-- | +insertAt :: forall a. Int -> a -> Array a -> Maybe (Array a) +insertAt = runFn5 _insertAt Just Nothing + +_insertAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a)) +_insertAt = _insertAt + +-- | Delete the element at the specified index, creating a new array, or +-- | returning `Nothing` if the index is out of bounds. +-- | +-- | ```purescript +-- | deleteAt 0 ["Hello", "World"] = Just ["World"] +-- | deleteAt 10 ["Hello", "World"] = Nothing +-- | ``` +-- | +deleteAt :: forall a. Int -> Array a -> Maybe (Array a) +deleteAt = runFn4 _deleteAt Just Nothing + +_deleteAt :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) Int (Array a) (Maybe (Array a)) +_deleteAt = _deleteAt + +-- | Change the element at the specified index, creating a new array, or +-- | returning `Nothing` if the index is out of bounds. +-- | +-- | ```purescript +-- | updateAt 1 "World" ["Hello", "Earth"] = Just ["Hello", "World"] +-- | updateAt 10 "World" ["Hello", "Earth"] = Nothing +-- | ``` +-- | +updateAt :: forall a. Int -> a -> Array a -> Maybe (Array a) +updateAt = runFn5 _updateAt Just Nothing + +_updateAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a)) +_updateAt = _updateAt + +-- | Apply a function to the element at the specified index, creating a new +-- | array, or returning `Nothing` if the index is out of bounds. +-- | +-- | ```purescript +-- | modifyAt 1 toUpper ["Hello", "World"] = Just ["Hello", "WORLD"] +-- | modifyAt 10 toUpper ["Hello", "World"] = Nothing +-- | ``` +-- | +modifyAt :: forall a. Int -> (a -> a) -> Array a -> Maybe (Array a) +modifyAt i f xs = maybe Nothing go (xs !! i) + where + go x = updateAt i (f x) xs + +-- | Update or delete the element at the specified index by applying a +-- | function to the current value, returning a new array or `Nothing` if the +-- | index is out-of-bounds. +-- | +-- | ```purescript +-- | alterAt 1 (stripSuffix $ Pattern "!") ["Hello", "World!"] +-- | = Just ["Hello", "World"] +-- | +-- | alterAt 1 (stripSuffix $ Pattern "!!!!!") ["Hello", "World!"] +-- | = Just ["Hello"] +-- | +-- | alterAt 10 (stripSuffix $ Pattern "!") ["Hello", "World!"] = Nothing +-- | ``` +-- | +alterAt :: forall a. Int -> (a -> Maybe a) -> Array a -> Maybe (Array a) +alterAt i f xs = maybe Nothing go (xs !! i) + where + go x = case f x of + Nothing -> deleteAt i xs + Just x' -> updateAt i x' xs + +-------------------------------------------------------------------------------- +-- Transformations ------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Inserts the given element in between each element in the array. The array +-- | must have two or more elements for this operation to take effect. +-- | +-- | ```purescript +-- | intersperse " " [ "a", "b" ] == [ "a", " ", "b" ] +-- | intersperse 0 [ 1, 2, 3, 4, 5 ] == [ 1, 0, 2, 0, 3, 0, 4, 0, 5 ] +-- | ``` +-- | +-- | If the array has less than two elements, the input array is returned. +-- | ```purescript +-- | intersperse " " [] == [] +-- | intersperse " " ["a"] == ["a"] +-- | ``` +intersperse :: forall a. a -> Array a -> Array a +intersperse a arr = case length arr of + len + | len < 2 -> arr + | otherwise -> STA.run do + let unsafeGetElem idx = unsafePartial (unsafeIndex arr idx) + out <- STA.new + _ <- STA.push (unsafeGetElem 0) out + ST.for 1 len \idx -> do + _ <- STA.push a out + void (STA.push (unsafeGetElem idx) out) + pure out + +-- | Reverse an array, creating a new array. +-- | +-- | ```purescript +-- | reverse [] = [] +-- | reverse [1, 2, 3] = [3, 2, 1] +-- | ``` +-- | +reverse :: forall a. Array a -> Array a +reverse a0 = reverse a0 + +-- | Flatten an array of arrays, creating a new array. +-- | +-- | ```purescript +-- | concat [[1, 2, 3], [], [4, 5, 6]] = [1, 2, 3, 4, 5, 6] +-- | ``` +-- | +concat :: forall a. Array (Array a) -> Array a +concat a0 = concat a0 + +-- | Apply a function to each element in an array, and flatten the results +-- | into a single, new array. +-- | +-- | ```purescript +-- | concatMap (split $ Pattern " ") ["Hello World", "other thing"] +-- | = ["Hello", "World", "other", "thing"] +-- | ``` +-- | +concatMap :: forall a b. (a -> Array b) -> Array a -> Array b +concatMap = flip bind + +-- | Filter an array, keeping the elements which satisfy a predicate function, +-- | creating a new array. +-- | +-- | ```purescript +-- | filter (_ > 0) [-1, 4, -5, 7] = [4, 7] +-- | ``` +-- | +filter :: forall a. (a -> Boolean) -> Array a -> Array a +filter = runFn2 filterImpl + +filterImpl :: forall a . Fn2 (a -> Boolean) (Array a) (Array a) +filterImpl = filterImpl + +-- | Partition an array using a predicate function, creating a set of +-- | new arrays. One for the values satisfying the predicate function +-- | and one for values that don't. +-- | +-- | ```purescript +-- | partition (_ > 0) [-1, 4, -5, 7] = { yes: [4, 7], no: [-1, -5] } +-- | ``` +-- | +partition + :: forall a + . (a -> Boolean) + -> Array a + -> { yes :: Array a, no :: Array a } +partition = runFn2 partitionImpl + +partitionImpl :: forall a . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a } +partitionImpl = partitionImpl + +-- | Splits an array into two subarrays, where `before` contains the elements +-- | up to (but not including) the given index, and `after` contains the rest +-- | of the elements, from that index on. +-- | +-- | ```purescript +-- | >>> splitAt 3 [1, 2, 3, 4, 5] +-- | { before: [1, 2, 3], after: [4, 5] } +-- | ``` +-- | +-- | Thus, the length of `(splitAt i arr).before` will equal either `i` or +-- | `length arr`, if that is shorter. (Or if `i` is negative the length will +-- | be 0.) +-- | +-- | ```purescript +-- | splitAt 2 ([] :: Array Int) == { before: [], after: [] } +-- | splitAt 3 [1, 2, 3, 4, 5] == { before: [1, 2, 3], after: [4, 5] } +-- | ``` +splitAt :: forall a. Int -> Array a -> { before :: Array a, after :: Array a } +splitAt i xs | i <= 0 = { before: [], after: xs } +splitAt i xs = { before: slice 0 i xs, after: slice i (length xs) xs } + +-- | Filter where the predicate returns a `Boolean` in some `Applicative`. +-- | +-- | ```purescript +-- | powerSet :: forall a. Array a -> Array (Array a) +-- | powerSet = filterA (const [true, false]) +-- | ``` +filterA :: forall a f. Applicative f => (a -> f Boolean) -> Array a -> f (Array a) +filterA p = + traverse (\x -> Tuple x <$> p x) + >>> map (mapMaybe (\(Tuple x b) -> if b then Just x else Nothing)) + +-- | Apply a function to each element in an array, keeping only the results +-- | which contain a value, creating a new array. +-- | +-- | ```purescript +-- | parseEmail :: String -> Maybe Email +-- | parseEmail = ... +-- | +-- | mapMaybe parseEmail ["a.com", "hello@example.com", "--"] +-- | = [Email {user: "hello", domain: "example.com"}] +-- | ``` +-- | +mapMaybe :: forall a b. (a -> Maybe b) -> Array a -> Array b +mapMaybe f = concatMap (maybe [] singleton <<< f) + +-- | Filter an array of optional values, keeping only the elements which contain +-- | a value, creating a new array. +-- | +-- | ```purescript +-- | catMaybes [Nothing, Just 2, Nothing, Just 4] = [2, 4] +-- | ``` +-- | +catMaybes :: forall a. Array (Maybe a) -> Array a +catMaybes = mapMaybe identity + +-- | Apply a function to each element in an array, supplying a generated +-- | zero-based index integer along with the element, creating an array +-- | with the new elements. +-- | +-- | ```purescript +-- | prefixIndex index element = show index <> element +-- | +-- | mapWithIndex prefixIndex ["Hello", "World"] = ["0Hello", "1World"] +-- | ``` +-- | +mapWithIndex :: forall a b. (Int -> a -> b) -> Array a -> Array b +mapWithIndex = FWI.mapWithIndex + +-- | Change the elements at the specified indices in index/value pairs. +-- | Out-of-bounds indices will have no effect. +-- | +-- | ```purescript +-- | updates = [Tuple 0 "Hi", Tuple 2 "." , Tuple 10 "foobar"] +-- | +-- | updateAtIndices updates ["Hello", "World", "!"] = ["Hi", "World", "."] +-- | ``` +-- | +updateAtIndices :: forall t a. Foldable t => t (Tuple Int a) -> Array a -> Array a +updateAtIndices us xs = + ST.run (STA.withArray (\res -> traverse_ (\(Tuple i a) -> STA.poke i a res) us) xs) + +-- | Apply a function to the element at the specified indices, +-- | creating a new array. Out-of-bounds indices will have no effect. +-- | +-- | ```purescript +-- | indices = [1, 3] +-- | modifyAtIndices indices toUpper ["Hello", "World", "and", "others"] +-- | = ["Hello", "WORLD", "and", "OTHERS"] +-- | ``` +-- | +modifyAtIndices :: forall t a. Foldable t => t Int -> (a -> a) -> Array a -> Array a +modifyAtIndices is f xs = + ST.run (STA.withArray (\res -> traverse_ (\i -> STA.modify i f res) is) xs) + +foldl :: forall a b. (b -> a -> b) -> b -> Array a -> b +foldl = F.foldl + +foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b +foldr = F.foldr + +foldMap :: forall a m. Monoid m => (a -> m) -> Array a -> m +foldMap = F.foldMap + +fold :: forall m. Monoid m => Array m -> m +fold = F.fold + +intercalate :: forall a. Monoid a => a -> Array a -> a +intercalate = F.intercalate + +-- | The 'transpose' function transposes the rows and columns of its argument. +-- | For example, +-- | +-- | ```purescript +-- | transpose +-- | [ [1, 2, 3] +-- | , [4, 5, 6] +-- | ] == +-- | [ [1, 4] +-- | , [2, 5] +-- | , [3, 6] +-- | ] +-- | ``` +-- | +-- | If some of the rows are shorter than the following rows, their elements are skipped: +-- | +-- | ```purescript +-- | transpose +-- | [ [10, 11] +-- | , [20] +-- | , [30, 31, 32] +-- | ] == +-- | [ [10, 20, 30] +-- | , [11, 31] +-- | , [32] +-- | ] +-- | ``` +transpose :: forall a. Array (Array a) -> Array (Array a) +transpose xs = go 0 [] + where + go :: Int -> Array (Array a) -> Array (Array a) + go idx allArrays = case buildNext idx of + Nothing -> allArrays + Just next -> go (idx + 1) (snoc allArrays next) + + buildNext :: Int -> Maybe (Array a) + buildNext idx = do + xs # flip foldl Nothing \acc nextArr -> do + maybe acc (\el -> Just $ maybe [ el ] (flip snoc el) acc) $ index nextArr idx + +-- | Fold a data structure from the left, keeping all intermediate results +-- | instead of only the final result. Note that the initial value does not +-- | appear in the result (unlike Haskell's `Prelude.scanl`). +-- | +-- | ``` +-- | scanl (+) 0 [1,2,3] = [1,3,6] +-- | scanl (-) 10 [1,2,3] = [9,7,4] +-- | ``` +scanl :: forall a b. (b -> a -> b) -> b -> Array a -> Array b +scanl = runFn3 scanlImpl + +scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b) +scanlImpl = scanlImpl + +-- | Fold a data structure from the right, keeping all intermediate results +-- | instead of only the final result. Note that the initial value does not +-- | appear in the result (unlike Haskell's `Prelude.scanr`). +-- | +-- | ``` +-- | scanr (+) 0 [1,2,3] = [6,5,3] +-- | scanr (flip (-)) 10 [1,2,3] = [4,5,7] +-- | ``` +scanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b +scanr = runFn3 scanrImpl + +scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b) +scanrImpl = scanrImpl + +-------------------------------------------------------------------------------- +-- Sorting --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Sort the elements of an array in increasing order, creating a new array. +-- | Sorting is stable: the order of equal elements is preserved. +-- | +-- | ```purescript +-- | sort [2, -3, 1] = [-3, 1, 2] +-- | ``` +-- | +sort :: forall a. Ord a => Array a -> Array a +sort xs = sortBy compare xs + +-- | Sort the elements of an array in increasing order, where elements are +-- | compared using the specified partial ordering, creating a new array. +-- | Sorting is stable: the order of elements is preserved if they are equal +-- | according to the specified partial ordering. +-- | +-- | ```purescript +-- | compareLength a b = compare (length a) (length b) +-- | sortBy compareLength [[1, 2, 3], [7, 9], [-2]] = [[-2],[7,9],[1,2,3]] +-- | ``` +-- | +sortBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a +sortBy comp = runFn3 sortByImpl comp case _ of + GT -> 1 + EQ -> 0 + LT -> -1 + +-- | Sort the elements of an array in increasing order, where elements are +-- | sorted based on a projection. Sorting is stable: the order of elements is +-- | preserved if they are equal according to the projection. +-- | +-- | ```purescript +-- | sortWith (_.age) [{name: "Alice", age: 42}, {name: "Bob", age: 21}] +-- | = [{name: "Bob", age: 21}, {name: "Alice", age: 42}] +-- | ``` +-- | +sortWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a +sortWith f = sortBy (comparing f) + +sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a) +sortByImpl = sortByImpl + +-------------------------------------------------------------------------------- +-- Subarrays ------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Extract a subarray by a start and end index. +-- | +-- | ```purescript +-- | letters = ["a", "b", "c"] +-- | slice 1 3 letters = ["b", "c"] +-- | slice 5 7 letters = [] +-- | slice 4 1 letters = [] +-- | ``` +-- | +slice :: forall a. Int -> Int -> Array a -> Array a +slice = runFn3 sliceImpl + +sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a) +sliceImpl = sliceImpl + +-- | Keep only a number of elements from the start of an array, creating a new +-- | array. +-- | +-- | ```purescript +-- | letters = ["a", "b", "c"] +-- | +-- | take 2 letters = ["a", "b"] +-- | take 100 letters = ["a", "b", "c"] +-- | ``` +-- | +take :: forall a. Int -> Array a -> Array a +take n xs = if n < 1 then [] else slice 0 n xs + +-- | Keep only a number of elements from the end of an array, creating a new +-- | array. +-- | +-- | ```purescript +-- | letters = ["a", "b", "c"] +-- | +-- | takeEnd 2 letters = ["b", "c"] +-- | takeEnd 100 letters = ["a", "b", "c"] +-- | ``` +-- | +takeEnd :: forall a. Int -> Array a -> Array a +takeEnd n xs = drop (length xs - n) xs + +-- | Calculate the longest initial subarray for which all element satisfy the +-- | specified predicate, creating a new array. +-- | +-- | ```purescript +-- | takeWhile (_ > 0) [4, 1, 0, -4, 5] = [4, 1] +-- | takeWhile (_ > 0) [-1, 4] = [] +-- | ``` +-- | +takeWhile :: forall a. (a -> Boolean) -> Array a -> Array a +takeWhile p xs = (span p xs).init + +-- | Drop a number of elements from the start of an array, creating a new array. +-- | +-- | ```purescript +-- | letters = ["a", "b", "c", "d"] +-- | +-- | drop 2 letters = ["c", "d"] +-- | drop 10 letters = [] +-- | ``` +-- | +drop :: forall a. Int -> Array a -> Array a +drop n xs = if n < 1 then xs else slice n (length xs) xs + +-- | Drop a number of elements from the end of an array, creating a new array. +-- | +-- | ```purescript +-- | letters = ["a", "b", "c", "d"] +-- | +-- | dropEnd 2 letters = ["a", "b"] +-- | dropEnd 10 letters = [] +-- | ``` +-- | +dropEnd :: forall a. Int -> Array a -> Array a +dropEnd n xs = take (length xs - n) xs + +-- | Remove the longest initial subarray for which all element satisfy the +-- | specified predicate, creating a new array. +-- | +-- | ```purescript +-- | dropWhile (_ < 0) [-3, -1, 0, 4, -6] = [0, 4, -6] +-- | ``` +-- | +dropWhile :: forall a. (a -> Boolean) -> Array a -> Array a +dropWhile p xs = (span p xs).rest + +-- | Split an array into two parts: +-- | +-- | 1. the longest initial subarray for which all elements satisfy the +-- | specified predicate +-- | 2. the remaining elements +-- | +-- | ```purescript +-- | span (\n -> n % 2 == 1) [1,3,2,4,5] == { init: [1,3], rest: [2,4,5] } +-- | ``` +-- | +-- | Running time: `O(n)`. +span + :: forall a + . (a -> Boolean) + -> Array a + -> { init :: Array a, rest :: Array a } +span p arr = + case breakIndex of + Just 0 -> + { init: [], rest: arr } + Just i -> + { init: slice 0 i arr, rest: slice i (length arr) arr } + Nothing -> + { init: arr, rest: [] } + where + breakIndex = go 0 + go i = + -- This looks like a good opportunity to use the Monad Maybe instance, + -- but it's important to write out an explicit case expression here in + -- order to ensure that TCO is triggered. + case index arr i of + Just x -> if p x then go (i + 1) else Just i + Nothing -> Nothing + +-- | Group equal, consecutive elements of an array into arrays. +-- | +-- | ```purescript +-- | group [1, 1, 2, 2, 1] == [NonEmptyArray [1, 1], NonEmptyArray [2, 2], NonEmptyArray [1]] +-- | ``` +group :: forall a. Eq a => Array a -> Array (NonEmptyArray a) +group xs = groupBy eq xs + +-- | Group equal elements of an array into arrays. +-- | +-- | ```purescript +-- | groupAll [1, 1, 2, 2, 1] == [NonEmptyArray [1, 1, 1], NonEmptyArray [2, 2]] +-- | ``` +groupAll :: forall a. Ord a => Array a -> Array (NonEmptyArray a) +groupAll = groupAllBy compare + +-- | Group equal, consecutive elements of an array into arrays, using the +-- | specified equivalence relation to determine equality. +-- | +-- | ```purescript +-- | groupBy (\a b -> odd a && odd b) [1, 3, 2, 4, 3, 3] +-- | = [NonEmptyArray [1, 3], NonEmptyArray [2], NonEmptyArray [4], NonEmptyArray [3, 3]] +-- | ``` +-- | +groupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmptyArray a) +groupBy op xs = + ST.run do + result <- STA.new + iter <- STAI.iterator (xs !! _) + STAI.iterate iter \x -> void do + sub <- STA.new + _ <- STA.push x sub + STAI.pushWhile (op x) iter sub + grp <- STA.unsafeFreeze sub + STA.push (NonEmptyArray grp) result + STA.unsafeFreeze result + +-- | Group equal elements of an array into arrays, using the specified +-- | comparison function to determine equality. +-- | +-- | ```purescript +-- | groupAllBy (comparing Down) [1, 3, 2, 4, 3, 3] +-- | = [NonEmptyArray [4], NonEmptyArray [3, 3, 3], NonEmptyArray [2], NonEmptyArray [1]] +-- | ``` +-- | +groupAllBy :: forall a. (a -> a -> Ordering) -> Array a -> Array (NonEmptyArray a) +groupAllBy cmp = groupBy (\x y -> cmp x y == EQ) <<< sortBy cmp + +-- | Remove the duplicates from an array, creating a new array. +-- | +-- | ```purescript +-- | nub [1, 2, 1, 3, 3] = [1, 2, 3] +-- | ``` +-- | +nub :: forall a. Ord a => Array a -> Array a +nub = nubBy compare + +-- | Remove the duplicates from an array, creating a new array. +-- | +-- | This less efficient version of `nub` only requires an `Eq` instance. +-- | +-- | ```purescript +-- | nubEq [1, 2, 1, 3, 3] = [1, 2, 3] +-- | ``` +-- | +nubEq :: forall a. Eq a => Array a -> Array a +nubEq = nubByEq eq + +-- | Remove the duplicates from an array, where element equality is determined +-- | by the specified ordering, creating a new array. +-- | +-- | ```purescript +-- | nubBy compare [1, 3, 4, 2, 2, 1] == [1, 3, 4, 2] +-- | ``` +-- | +nubBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a +nubBy comp xs = case head indexedAndSorted of + Nothing -> [] + Just x -> map snd $ sortWith fst $ ST.run do + -- TODO: use NonEmptyArrays here to avoid partial functions + result <- STA.unsafeThaw $ singleton x + ST.foreach indexedAndSorted \pair@(Tuple _ x') -> do + lst <- snd <<< unsafePartial (fromJust <<< last) <$> STA.unsafeFreeze result + when (comp lst x' /= EQ) $ void $ STA.push pair result + STA.unsafeFreeze result + where + indexedAndSorted :: Array (Tuple Int a) + indexedAndSorted = sortBy (\x y -> comp (snd x) (snd y)) + (mapWithIndex Tuple xs) + +-- | Remove the duplicates from an array, where element equality is determined +-- | by the specified equivalence relation, creating a new array. +-- | +-- | This less efficient version of `nubBy` only requires an equivalence +-- | relation. +-- | +-- | ```purescript +-- | mod3eq a b = a `mod` 3 == b `mod` 3 +-- | nubByEq mod3eq [1, 3, 4, 5, 6] = [1, 3, 5] +-- | ``` +-- | +nubByEq :: forall a. (a -> a -> Boolean) -> Array a -> Array a +nubByEq eq xs = ST.run do + arr <- STA.new + ST.foreach xs \x -> do + e <- not <<< any (_ `eq` x) <$> (STA.unsafeFreeze arr) + when e $ void $ STA.push x arr + STA.unsafeFreeze arr + +-- | Calculate the union of two arrays. Note that duplicates in the first array +-- | are preserved while duplicates in the second array are removed. +-- | +-- | Running time: `O(n^2)` +-- | +-- | ```purescript +-- | union [1, 2, 1, 1] [3, 3, 3, 4] = [1, 2, 1, 1, 3, 4] +-- | ``` +-- | +union :: forall a. Eq a => Array a -> Array a -> Array a +union = unionBy (==) + +-- | Calculate the union of two arrays, using the specified function to +-- | determine equality of elements. Note that duplicates in the first array +-- | are preserved while duplicates in the second array are removed. +-- | +-- | ```purescript +-- | mod3eq a b = a `mod` 3 == b `mod` 3 +-- | unionBy mod3eq [1, 5, 1, 2] [3, 4, 3, 3] = [1, 5, 1, 2, 3] +-- | ``` +-- | +unionBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a +unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs + +-- | Delete the first element of an array which is equal to the specified value, +-- | creating a new array. +-- | +-- | ```purescript +-- | delete 7 [1, 7, 3, 7] = [1, 3, 7] +-- | delete 7 [1, 2, 3] = [1, 2, 3] +-- | ``` +-- | +-- | Running time: `O(n)` +delete :: forall a. Eq a => a -> Array a -> Array a +delete = deleteBy eq + +-- | Delete the first element of an array which matches the specified value, +-- | under the equivalence relation provided in the first argument, creating a +-- | new array. +-- | +-- | ```purescript +-- | mod3eq a b = a `mod` 3 == b `mod` 3 +-- | deleteBy mod3eq 6 [1, 3, 4, 3] = [1, 4, 3] +-- | ``` +-- | +deleteBy :: forall a. (a -> a -> Boolean) -> a -> Array a -> Array a +deleteBy _ _ [] = [] +deleteBy eq x ys = maybe ys (\i -> unsafePartial $ fromJust (deleteAt i ys)) (findIndex (eq x) ys) + +-- | Delete the first occurrence of each element in the second array from the +-- | first array, creating a new array. +-- | +-- | ```purescript +-- | difference [2, 1] [2, 3] = [1] +-- | ``` +-- | +-- | Running time: `O(n*m)`, where n is the length of the first array, and m is +-- | the length of the second. +difference :: forall a. Eq a => Array a -> Array a -> Array a +difference = foldr delete + +infix 5 difference as \\ + +-- | Calculate the intersection of two arrays, creating a new array. Note that +-- | duplicates in the first array are preserved while duplicates in the second +-- | array are removed. +-- | +-- | ```purescript +-- | intersect [1, 1, 2] [2, 2, 1] = [1, 1, 2] +-- | ``` +-- | +intersect :: forall a. Eq a => Array a -> Array a -> Array a +intersect = intersectBy eq + +-- | Calculate the intersection of two arrays, using the specified equivalence +-- | relation to compare elements, creating a new array. Note that duplicates +-- | in the first array are preserved while duplicates in the second array are +-- | removed. +-- | +-- | ```purescript +-- | mod3eq a b = a `mod` 3 == b `mod` 3 +-- | intersectBy mod3eq [1, 2, 3] [4, 6, 7] = [1, 3] +-- | ``` +-- | +intersectBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a +intersectBy eq xs ys = filter (\x -> isJust (findIndex (eq x) ys)) xs + +-- | Apply a function to pairs of elements at the same index in two arrays, +-- | collecting the results in a new array. +-- | +-- | If one array is longer, elements will be discarded from the longer array. +-- | +-- | For example +-- | +-- | ```purescript +-- | zipWith (*) [1, 2, 3] [4, 5, 6, 7] == [4, 10, 18] +-- | ``` +zipWith + :: forall a b c + . (a -> b -> c) + -> Array a + -> Array b + -> Array c +zipWith = runFn3 zipWithImpl + +zipWithImpl :: forall a b c . Fn3 (a -> b -> c) (Array a) (Array b) (Array c) +zipWithImpl = zipWithImpl + +-- | A generalization of `zipWith` which accumulates results in some +-- | `Applicative` functor. +-- | +-- | ```purescript +-- | sndChars = zipWithA (\a b -> charAt 2 (a <> b)) +-- | sndChars ["a", "b"] ["A", "B"] = Nothing -- since "aA" has no 3rd char +-- | sndChars ["aa", "b"] ["AA", "BBB"] = Just ['A', 'B'] +-- | ``` +-- | +zipWithA + :: forall m a b c + . Applicative m + => (a -> b -> m c) + -> Array a + -> Array b + -> m (Array c) +zipWithA f xs ys = sequence (zipWith f xs ys) + +-- | Takes two arrays and returns an array of corresponding pairs. +-- | If one input array is short, excess elements of the longer array are +-- | discarded. +-- | +-- | ```purescript +-- | zip [1, 2, 3] ["a", "b"] = [Tuple 1 "a", Tuple 2 "b"] +-- | ``` +-- | +zip :: forall a b. Array a -> Array b -> Array (Tuple a b) +zip = zipWith Tuple + +-- | Transforms an array of pairs into an array of first components and an +-- | array of second components. +-- | +-- | ```purescript +-- | unzip [Tuple 1 "a", Tuple 2 "b"] = Tuple [1, 2] ["a", "b"] +-- | ``` +-- | +unzip :: forall a b. Array (Tuple a b) -> Tuple (Array a) (Array b) +unzip xs = + ST.run do + fsts <- STA.new + snds <- STA.new + iter <- STAI.iterator (xs !! _) + STAI.iterate iter \(Tuple fst snd) -> do + void $ STA.push fst fsts + void $ STA.push snd snds + fsts' <- STA.unsafeFreeze fsts + snds' <- STA.unsafeFreeze snds + pure $ Tuple fsts' snds' + +-- | Returns true if at least one array element satisfies the given predicate, +-- | iterating the array only as necessary and stopping as soon as the predicate +-- | yields true. +-- | +-- | ```purescript +-- | any (_ > 0) [] = False +-- | any (_ > 0) [-1, 0, 1] = True +-- | any (_ > 0) [-1, -2, -3] = False +-- | ``` +any :: forall a. (a -> Boolean) -> Array a -> Boolean +any = runFn2 anyImpl + +anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean +anyImpl = anyImpl + +-- | Returns true if all the array elements satisfy the given predicate. +-- | iterating the array only as necessary and stopping as soon as the predicate +-- | yields false. +-- | +-- | ```purescript +-- | all (_ > 0) [] = True +-- | all (_ > 0) [1, 2, 3] = True +-- | all (_ > 0) [-1, -2, -3] = False +-- | ``` +all :: forall a. (a -> Boolean) -> Array a -> Boolean +all = runFn2 allImpl + +allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean +allImpl = allImpl + +-- | Perform a fold using a monadic step function. +-- | +-- | ```purescript +-- | foldM (\x y -> Just (x + y)) 0 [1, 4] = Just 5 +-- | ``` +foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> Array a -> m b +foldM f b = runFn3 unconsImpl (\_ -> pure b) (\a as -> f b a >>= \b' -> foldM f b' as) + +foldRecM :: forall m a b. MonadRec m => (b -> a -> m b) -> b -> Array a -> m b +foldRecM f b array = tailRecM2 go b 0 + where + go res i + | i >= length array = pure (Done res) + | otherwise = do + res' <- f res (unsafePartial (unsafeIndex array i)) + pure (Loop { a: res', b: i + 1 }) + +-- | Find the element of an array at the specified index. +-- | +-- | ```purescript +-- | unsafePartial $ unsafeIndex ["a", "b", "c"] 1 = "b" +-- | ``` +-- | +-- | Using `unsafeIndex` with an out-of-range index will not immediately raise a runtime error. +-- | Instead, the result will be undefined. Most attempts to subsequently use the result will +-- | cause a runtime error, of course, but this is not guaranteed, and is dependent on the backend; +-- | some programs will continue to run as if nothing is wrong. For example, in the JavaScript backend, +-- | the expression `unsafePartial (unsafeIndex [true] 1)` has type `Boolean`; +-- | since this expression evaluates to `undefined`, attempting to use it in an `if` statement will cause +-- | the else branch to be taken. +unsafeIndex :: forall a. Partial => Array a -> Int -> a +unsafeIndex = runFn2 unsafeIndexImpl + +unsafeIndexImpl :: forall a. Fn2 (Array a) Int a +unsafeIndexImpl = unsafeIndexImpl diff --git a/stdlib/lib/Data/Array/NonEmpty.purs b/stdlib/lib/Data/Array/NonEmpty.purs new file mode 100644 index 00000000..e69a7bf1 --- /dev/null +++ b/stdlib/lib/Data/Array/NonEmpty.purs @@ -0,0 +1,598 @@ +module Data.Array.NonEmpty + ( module Internal + , fromArray + , fromNonEmpty + , toArray + , toNonEmpty + + , fromFoldable + , fromFoldable1 + , toUnfoldable + , toUnfoldable1 + , singleton + , (..), range + , replicate + , some + + , length + + , (:), cons + , cons' + , snoc + , snoc' + , appendArray + , prependArray + , insert + , insertBy + + , head + , last + , tail + , init + , uncons + , unsnoc + + , (!!), index + , elem + , notElem + , elemIndex + , elemLastIndex + , find + , findMap + , findIndex + , findLastIndex + , insertAt + , deleteAt + , updateAt + , updateAtIndices + , modifyAt + , modifyAtIndices + , alterAt + + , intersperse + , reverse + , concat + , concatMap + , filter + , partition + , splitAt + , filterA + , mapMaybe + , catMaybes + , mapWithIndex + , foldl1 + , foldr1 + , foldMap1 + , fold1 + , intercalate + , transpose + , transpose' + , scanl + , scanr + + , sort + , sortBy + , sortWith + , slice + , take + , takeEnd + , takeWhile + , drop + , dropEnd + , dropWhile + , span + , group + , groupAll + , groupBy + , groupAllBy + + , nub + , nubBy + , nubEq + , nubByEq + , union + , union' + , unionBy + , unionBy' + , delete + , deleteBy + + , (\\), difference + , difference' + , intersect + , intersect' + , intersectBy + , intersectBy' + + , zipWith + , zipWithA + , zip + , unzip + + , any + , all + + , foldM + , foldRecM + + , unsafeIndex + ) where + +import Prelude + +import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Array as A +import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) +import Data.Array.NonEmpty.Internal (NonEmptyArray) as Internal +import Data.Bifunctor (bimap) +import Data.Foldable (class Foldable) +import Data.Maybe (Maybe(..), fromJust) +import Data.NonEmpty (NonEmpty, (:|)) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Foldable as F +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable) +import Data.Unfoldable1 (class Unfoldable1, unfoldr1) +import Partial.Unsafe (unsafePartial) +import Safe.Coerce (coerce) +import Unsafe.Coerce (unsafeCoerce) + +-- | Internal - adapt an Array transform to NonEmptyArray +-- +-- Note that this is unsafe: if the transform returns an empty array, this can +-- explode at runtime. +unsafeAdapt :: forall a b. (Array a -> Array b) -> NonEmptyArray a -> NonEmptyArray b +unsafeAdapt f = unsafeFromArray <<< adaptAny f + +-- | Internal - adapt an Array transform to NonEmptyArray, +-- with polymorphic result. +-- +-- Note that this is unsafe: if the transform returns an empty array, this can +-- explode at runtime. +adaptAny :: forall a b. (Array a -> b) -> NonEmptyArray a -> b +adaptAny f = f <<< toArray + +-- | Internal - adapt Array functions returning Maybes to NonEmptyArray +adaptMaybe :: forall a b. (Array a -> Maybe b) -> NonEmptyArray a -> b +adaptMaybe f = unsafePartial $ fromJust <<< f <<< toArray + +fromArray :: forall a. Array a -> Maybe (NonEmptyArray a) +fromArray xs + | A.length xs > 0 = Just (unsafeFromArray xs) + | otherwise = Nothing + +-- | INTERNAL +unsafeFromArray :: forall a. Array a -> NonEmptyArray a +unsafeFromArray = NonEmptyArray + +unsafeFromArrayF :: forall f a. f (Array a) -> f (NonEmptyArray a) +unsafeFromArrayF = unsafeCoerce + +fromNonEmpty :: forall a. NonEmpty Array a -> NonEmptyArray a +fromNonEmpty (x :| xs) = cons' x xs + +toArray :: forall a. NonEmptyArray a -> Array a +toArray (NonEmptyArray xs) = xs + +toNonEmpty :: forall a. NonEmptyArray a -> NonEmpty Array a +toNonEmpty = uncons >>> \{head: x, tail: xs} -> x :| xs + +fromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyArray a) +fromFoldable = fromArray <<< A.fromFoldable + +fromFoldable1 :: forall f a. Foldable1 f => f a -> NonEmptyArray a +fromFoldable1 = unsafeFromArray <<< A.fromFoldable + +toUnfoldable :: forall f a. Unfoldable f => NonEmptyArray a -> f a +toUnfoldable = adaptAny A.toUnfoldable + +toUnfoldable1 :: forall f a. Unfoldable1 f => NonEmptyArray a -> f a +toUnfoldable1 xs = unfoldr1 f 0 + where + len = length xs + f i = Tuple (unsafePartial unsafeIndex xs i) $ + if i < (len - 1) then Just (i + 1) else Nothing + +singleton :: forall a. a -> NonEmptyArray a +singleton = unsafeFromArray <<< A.singleton + +range :: Int -> Int -> NonEmptyArray Int +range x y = unsafeFromArray $ A.range x y + +infix 8 range as .. + +-- | Replicate an item at least once +replicate :: forall a. Int -> a -> NonEmptyArray a +replicate i x = unsafeFromArray $ A.replicate (max 1 i) x + +some + :: forall f a + . Alternative f + => Lazy (f (Array a)) + => f a -> f (NonEmptyArray a) +some = unsafeFromArrayF <<< A.some + +length :: forall a. NonEmptyArray a -> Int +length = adaptAny A.length + +cons :: forall a. a -> NonEmptyArray a -> NonEmptyArray a +cons x = unsafeAdapt $ A.cons x + +infixr 6 cons as : + +cons' :: forall a. a -> Array a -> NonEmptyArray a +cons' x xs = unsafeFromArray $ A.cons x xs + +snoc :: forall a. NonEmptyArray a -> a -> NonEmptyArray a +snoc xs x = unsafeFromArray $ A.snoc (toArray xs) x + +snoc' :: forall a. Array a -> a -> NonEmptyArray a +snoc' xs x = unsafeFromArray $ A.snoc xs x + +appendArray :: forall a. NonEmptyArray a -> Array a -> NonEmptyArray a +appendArray xs ys = unsafeFromArray $ toArray xs <> ys + +prependArray :: forall a. Array a -> NonEmptyArray a -> NonEmptyArray a +prependArray xs ys = unsafeFromArray $ xs <> toArray ys + +insert :: forall a. Ord a => a -> NonEmptyArray a -> NonEmptyArray a +insert x = unsafeAdapt $ A.insert x + +insertBy :: forall a. (a -> a -> Ordering) -> a -> NonEmptyArray a -> NonEmptyArray a +insertBy f x = unsafeAdapt $ A.insertBy f x + +head :: forall a. NonEmptyArray a -> a +head = adaptMaybe A.head + +last :: forall a. NonEmptyArray a -> a +last = adaptMaybe A.last + +tail :: forall a. NonEmptyArray a -> Array a +tail = adaptMaybe A.tail + +init :: forall a. NonEmptyArray a -> Array a +init = adaptMaybe A.init + +uncons :: forall a. NonEmptyArray a -> { head :: a, tail :: Array a } +uncons = adaptMaybe A.uncons + +unsnoc :: forall a. NonEmptyArray a -> { init :: Array a, last :: a } +unsnoc = adaptMaybe A.unsnoc + +index :: forall a. NonEmptyArray a -> Int -> Maybe a +index = adaptAny A.index + +infixl 8 index as !! + +elem :: forall a. Eq a => a -> NonEmptyArray a -> Boolean +elem x = adaptAny $ A.elem x + +notElem :: forall a. Eq a => a -> NonEmptyArray a -> Boolean +notElem x = adaptAny $ A.notElem x + +elemIndex :: forall a. Eq a => a -> NonEmptyArray a -> Maybe Int +elemIndex x = adaptAny $ A.elemIndex x + +elemLastIndex :: forall a. Eq a => a -> NonEmptyArray a -> Maybe Int +elemLastIndex x = adaptAny $ A.elemLastIndex x + +find :: forall a. (a -> Boolean) -> NonEmptyArray a -> Maybe a +find p = adaptAny $ A.find p + +findMap :: forall a b. (a -> Maybe b) -> NonEmptyArray a -> Maybe b +findMap p = adaptAny $ A.findMap p + +findIndex :: forall a. (a -> Boolean) -> NonEmptyArray a -> Maybe Int +findIndex p = adaptAny $ A.findIndex p + +findLastIndex :: forall a. (a -> Boolean) -> NonEmptyArray a -> Maybe Int +findLastIndex x = adaptAny $ A.findLastIndex x + +insertAt :: forall a. Int -> a -> NonEmptyArray a -> Maybe (NonEmptyArray a) +insertAt i x = unsafeFromArrayF <<< A.insertAt i x <<< toArray + +deleteAt :: forall a. Int -> NonEmptyArray a -> Maybe (Array a) +deleteAt i = adaptAny $ A.deleteAt i + +updateAt :: forall a. Int -> a -> NonEmptyArray a -> Maybe (NonEmptyArray a) +updateAt i x = unsafeFromArrayF <<< A.updateAt i x <<< toArray + +updateAtIndices :: forall t a. Foldable t => t (Tuple Int a) -> NonEmptyArray a -> NonEmptyArray a +updateAtIndices pairs = unsafeAdapt $ A.updateAtIndices pairs + +modifyAt :: forall a. Int -> (a -> a) -> NonEmptyArray a -> Maybe (NonEmptyArray a) +modifyAt i f = unsafeFromArrayF <<< A.modifyAt i f <<< toArray + +modifyAtIndices :: forall t a. Foldable t => t Int -> (a -> a) -> NonEmptyArray a -> NonEmptyArray a +modifyAtIndices is f = unsafeAdapt $ A.modifyAtIndices is f + +alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyArray a -> Maybe (Array a) +alterAt i f = A.alterAt i f <<< toArray + +intersperse :: forall a. a -> NonEmptyArray a -> NonEmptyArray a +intersperse x = unsafeAdapt $ A.intersperse x + +reverse :: forall a. NonEmptyArray a -> NonEmptyArray a +reverse = unsafeAdapt A.reverse + +concat :: forall a. NonEmptyArray (NonEmptyArray a) -> NonEmptyArray a +concat = unsafeFromArray <<< A.concat <<< toArray <<< map toArray + +concatMap :: forall a b. (a -> NonEmptyArray b) -> NonEmptyArray a -> NonEmptyArray b +concatMap = flip bind + +filter :: forall a. (a -> Boolean) -> NonEmptyArray a -> Array a +filter f = adaptAny $ A.filter f + +partition + :: forall a + . (a -> Boolean) + -> NonEmptyArray a + -> { yes :: Array a, no :: Array a} +partition f = adaptAny $ A.partition f + +filterA + :: forall a f + . Applicative f + => (a -> f Boolean) + -> NonEmptyArray a + -> f (Array a) +filterA f = adaptAny $ A.filterA f + +splitAt :: forall a. Int -> NonEmptyArray a -> { before :: Array a, after :: Array a } +splitAt i xs = A.splitAt i $ toArray xs + +mapMaybe :: forall a b. (a -> Maybe b) -> NonEmptyArray a -> Array b +mapMaybe f = adaptAny $ A.mapMaybe f + +catMaybes :: forall a. NonEmptyArray (Maybe a) -> Array a +catMaybes = adaptAny A.catMaybes + +mapWithIndex :: forall a b. (Int -> a -> b) -> NonEmptyArray a -> NonEmptyArray b +mapWithIndex f = unsafeAdapt $ A.mapWithIndex f + +foldl1 :: forall a. (a -> a -> a) -> NonEmptyArray a -> a +foldl1 = F.foldl1 + +foldr1 :: forall a. (a -> a -> a) -> NonEmptyArray a -> a +foldr1 = F.foldr1 + +foldMap1 :: forall a m. Semigroup m => (a -> m) -> NonEmptyArray a -> m +foldMap1 = F.foldMap1 + +fold1 :: forall m. Semigroup m => NonEmptyArray m -> m +fold1 = F.fold1 + +intercalate :: forall a. Semigroup a => a -> NonEmptyArray a -> a +intercalate = F.intercalate + +-- | The 'transpose' function transposes the rows and columns of its argument. +-- | For example, +-- | +-- | ```purescript +-- | transpose +-- | (NonEmptyArray [ NonEmptyArray [1, 2, 3] +-- | , NonEmptyArray [4, 5, 6] +-- | ]) == +-- | (NonEmptyArray [ NonEmptyArray [1, 4] +-- | , NonEmptyArray [2, 5] +-- | , NonEmptyArray [3, 6] +-- | ]) +-- | ``` +-- | +-- | If some of the rows are shorter than the following rows, their elements are skipped: +-- | +-- | ```purescript +-- | transpose +-- | (NonEmptyArray [ NonEmptyArray [10, 11] +-- | , NonEmptyArray [20] +-- | , NonEmptyArray [30, 31, 32] +-- | ]) == +-- | (NomEmptyArray [ NonEmptyArray [10, 20, 30] +-- | , NonEmptyArray [11, 31] +-- | , NonEmptyArray [32] +-- | ]) +-- | ``` +transpose :: forall a. NonEmptyArray (NonEmptyArray a) -> NonEmptyArray (NonEmptyArray a) +transpose = + (coerce :: (Array (Array a)) -> (NonEmptyArray (NonEmptyArray a))) + <<< A.transpose <<< coerce + +-- | `transpose`' is identical to `transpose` other than that the inner arrays are each +-- | a standard `Array` and not a `NonEmptyArray`. However, the result is wrapped in a +-- | `Maybe` to cater for the case where the inner `Array` is empty and must return `Nothing`. +transpose' :: forall a. NonEmptyArray (Array a) -> Maybe (NonEmptyArray (Array a)) +transpose' = fromArray <<< A.transpose <<< coerce + +scanl :: forall a b. (b -> a -> b) -> b -> NonEmptyArray a -> NonEmptyArray b +scanl f x = unsafeAdapt $ A.scanl f x + +scanr :: forall a b. (a -> b -> b) -> b -> NonEmptyArray a -> NonEmptyArray b +scanr f x = unsafeAdapt $ A.scanr f x + +sort :: forall a. Ord a => NonEmptyArray a -> NonEmptyArray a +sort = unsafeAdapt A.sort + +sortBy :: forall a. (a -> a -> Ordering) -> NonEmptyArray a -> NonEmptyArray a +sortBy f = unsafeAdapt $ A.sortBy f + +sortWith :: forall a b. Ord b => (a -> b) -> NonEmptyArray a -> NonEmptyArray a +sortWith f = unsafeAdapt $ A.sortWith f + +slice :: forall a. Int -> Int -> NonEmptyArray a -> Array a +slice start end = adaptAny $ A.slice start end + +take :: forall a. Int -> NonEmptyArray a -> Array a +take i = adaptAny $ A.take i + +takeEnd :: forall a. Int -> NonEmptyArray a -> Array a +takeEnd i = adaptAny $ A.takeEnd i + +takeWhile :: forall a. (a -> Boolean) -> NonEmptyArray a -> Array a +takeWhile f = adaptAny $ A.takeWhile f + +drop :: forall a. Int -> NonEmptyArray a -> Array a +drop i = adaptAny $ A.drop i + +dropEnd :: forall a. Int -> NonEmptyArray a -> Array a +dropEnd i = adaptAny $ A.dropEnd i + +dropWhile :: forall a. (a -> Boolean) -> NonEmptyArray a -> Array a +dropWhile f = adaptAny $ A.dropWhile f + +span + :: forall a + . (a -> Boolean) + -> NonEmptyArray a + -> { init :: Array a, rest :: Array a } +span f = adaptAny $ A.span f + +-- | Group equal, consecutive elements of an array into arrays. +-- | +-- | ```purescript +-- | group (NonEmptyArray [1, 1, 2, 2, 1]) == +-- | NonEmptyArray [NonEmptyArray [1, 1], NonEmptyArray [2, 2], NonEmptyArray [1]] +-- | ``` +group :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) +group = unsafeAdapt $ A.group + +-- | Group equal elements of an array into arrays. +-- | +-- | ```purescript +-- | groupAll (NonEmptyArray [1, 1, 2, 2, 1]) == +-- | NonEmptyArray [NonEmptyArray [1, 1, 1], NonEmptyArray [2, 2]] +-- | ` +groupAll :: forall a. Ord a => NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) +groupAll = groupAllBy compare + +-- | Group equal, consecutive elements of an array into arrays, using the +-- | specified equivalence relation to determine equality. +-- | +-- | ```purescript +-- | groupBy (\a b -> odd a && odd b) (NonEmptyArray [1, 3, 2, 4, 3, 3]) +-- | = NonEmptyArray [NonEmptyArray [1, 3], NonEmptyArray [2], NonEmptyArray [4], NonEmptyArray [3, 3]] +-- | ``` +-- | +groupBy :: forall a. (a -> a -> Boolean) -> NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) +groupBy op = unsafeAdapt $ A.groupBy op + +-- | Group equal elements of an array into arrays, using the specified +-- | comparison function to determine equality. +-- | +-- | ```purescript +-- | groupAllBy (comparing Down) (NonEmptyArray [1, 3, 2, 4, 3, 3]) +-- | = NonEmptyArray [NonEmptyArray [4], NonEmptyArray [3, 3, 3], NonEmptyArray [2], NonEmptyArray [1]] +-- | ``` +groupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) +groupAllBy op = unsafeAdapt $ A.groupAllBy op + +nub :: forall a. Ord a => NonEmptyArray a -> NonEmptyArray a +nub = unsafeAdapt A.nub + +nubEq :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray a +nubEq = unsafeAdapt A.nubEq + +nubBy :: forall a. (a -> a -> Ordering) -> NonEmptyArray a -> NonEmptyArray a +nubBy f = unsafeAdapt $ A.nubBy f + +nubByEq :: forall a. (a -> a -> Boolean) -> NonEmptyArray a -> NonEmptyArray a +nubByEq f = unsafeAdapt $ A.nubByEq f + +union :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray a -> NonEmptyArray a +union = unionBy (==) + +union' :: forall a. Eq a => NonEmptyArray a -> Array a -> NonEmptyArray a +union' = unionBy' (==) + +unionBy + :: forall a + . (a -> a -> Boolean) + -> NonEmptyArray a + -> NonEmptyArray a + -> NonEmptyArray a +unionBy eq xs = unionBy' eq xs <<< toArray + +unionBy' + :: forall a + . (a -> a -> Boolean) + -> NonEmptyArray a + -> Array a + -> NonEmptyArray a +unionBy' eq xs = unsafeFromArray <<< A.unionBy eq (toArray xs) + +delete :: forall a. Eq a => a -> NonEmptyArray a -> Array a +delete x = adaptAny $ A.delete x + +deleteBy :: forall a. (a -> a -> Boolean) -> a -> NonEmptyArray a -> Array a +deleteBy f x = adaptAny $ A.deleteBy f x + +difference :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray a -> Array a +difference xs = adaptAny $ difference' xs + +difference' :: forall a. Eq a => NonEmptyArray a -> Array a -> Array a +difference' xs = A.difference $ toArray xs + +intersect :: forall a . Eq a => NonEmptyArray a -> NonEmptyArray a -> Array a +intersect = intersectBy eq + +intersect' :: forall a . Eq a => NonEmptyArray a -> Array a -> Array a +intersect' = intersectBy' eq + +intersectBy + :: forall a + . (a -> a -> Boolean) + -> NonEmptyArray a + -> NonEmptyArray a + -> Array a +intersectBy eq xs = intersectBy' eq xs <<< toArray + +intersectBy' + :: forall a + . (a -> a -> Boolean) + -> NonEmptyArray a + -> Array a + -> Array a +intersectBy' eq xs = A.intersectBy eq (toArray xs) + +infix 5 difference as \\ + +zipWith + :: forall a b c + . (a -> b -> c) + -> NonEmptyArray a + -> NonEmptyArray b + -> NonEmptyArray c +zipWith f xs ys = unsafeFromArray $ A.zipWith f (toArray xs) (toArray ys) + + +zipWithA + :: forall m a b c + . Applicative m + => (a -> b -> m c) + -> NonEmptyArray a + -> NonEmptyArray b + -> m (NonEmptyArray c) +zipWithA f xs ys = unsafeFromArrayF $ A.zipWithA f (toArray xs) (toArray ys) + +zip :: forall a b. NonEmptyArray a -> NonEmptyArray b -> NonEmptyArray (Tuple a b) +zip xs ys = unsafeFromArray $ toArray xs `A.zip` toArray ys + +unzip :: forall a b. NonEmptyArray (Tuple a b) -> Tuple (NonEmptyArray a) (NonEmptyArray b) +unzip = bimap unsafeFromArray unsafeFromArray <<< A.unzip <<< toArray + +any :: forall a. (a -> Boolean) -> NonEmptyArray a -> Boolean +any p = adaptAny $ A.any p + +all :: forall a. (a -> Boolean) -> NonEmptyArray a -> Boolean +all p = adaptAny $ A.all p + +foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyArray a -> m b +foldM f acc = adaptAny $ A.foldM f acc + +foldRecM :: forall m a b. MonadRec m => (b -> a -> m b) -> b -> NonEmptyArray a -> m b +foldRecM f acc = adaptAny $ A.foldRecM f acc + +unsafeIndex :: forall a. Partial => NonEmptyArray a -> Int -> a +unsafeIndex = adaptAny A.unsafeIndex diff --git a/stdlib/lib/Data/Array/NonEmpty/Internal.purs b/stdlib/lib/Data/Array/NonEmpty/Internal.purs new file mode 100644 index 00000000..f1e3eedc --- /dev/null +++ b/stdlib/lib/Data/Array/NonEmpty/Internal.purs @@ -0,0 +1,81 @@ +-- | This module exports the `NonEmptyArray` constructor. +-- | +-- | It is **NOT** intended for public use and is **NOT** versioned. +-- | +-- | Its content may change **in any way**, **at any time** and +-- | **without notice**. + +module Data.Array.NonEmpty.Internal (NonEmptyArray(..)) where + +import Prelude + +import Control.Alt (class Alt) +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable) +import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3) +import Data.FunctorWithIndex (class FunctorWithIndex) +import Data.Ord (class Ord1) +import Data.Semigroup.Foldable (class Foldable1, foldMap1DefaultL) +import Data.Semigroup.Traversable (class Traversable1, sequence1Default) +import Data.Traversable (class Traversable) +import Data.TraversableWithIndex (class TraversableWithIndex) +import Data.Unfoldable1 (class Unfoldable1) + +-- | An array that is known not to be empty. +-- | +-- | You can use the constructor to create a `NonEmptyArray` that isn't +-- | non-empty, breaking the guarantee behind this newtype. It is +-- | provided as an escape hatch mainly for the `Data.Array.NonEmpty` +-- | and `Data.Array` modules. Use this at your own risk when you know +-- | what you are doing. +newtype NonEmptyArray a = NonEmptyArray (Array a) + +instance showNonEmptyArray :: Show a => Show (NonEmptyArray a) where + show (NonEmptyArray xs) = "(NonEmptyArray " <> show xs <> ")" + +derive newtype instance eqNonEmptyArray :: Eq a => Eq (NonEmptyArray a) +derive newtype instance eq1NonEmptyArray :: Eq1 NonEmptyArray + +derive newtype instance ordNonEmptyArray :: Ord a => Ord (NonEmptyArray a) +derive newtype instance ord1NonEmptyArray :: Ord1 NonEmptyArray + +derive newtype instance semigroupNonEmptyArray :: Semigroup (NonEmptyArray a) + +derive newtype instance functorNonEmptyArray :: Functor NonEmptyArray +derive newtype instance functorWithIndexNonEmptyArray :: FunctorWithIndex Int NonEmptyArray + +derive newtype instance foldableNonEmptyArray :: Foldable NonEmptyArray +derive newtype instance foldableWithIndexNonEmptyArray :: FoldableWithIndex Int NonEmptyArray + +instance foldable1NonEmptyArray :: Foldable1 NonEmptyArray where + foldMap1 = foldMap1DefaultL + foldr1 = runFn2 foldr1Impl + foldl1 = runFn2 foldl1Impl + +derive newtype instance unfoldable1NonEmptyArray :: Unfoldable1 NonEmptyArray +derive newtype instance traversableNonEmptyArray :: Traversable NonEmptyArray +derive newtype instance traversableWithIndexNonEmptyArray :: TraversableWithIndex Int NonEmptyArray + +instance traversable1NonEmptyArray :: Traversable1 NonEmptyArray where + traverse1 f = runFn3 traverse1Impl apply map f + sequence1 = sequence1Default + +derive newtype instance applyNonEmptyArray :: Apply NonEmptyArray + +derive newtype instance applicativeNonEmptyArray :: Applicative NonEmptyArray + +derive newtype instance bindNonEmptyArray :: Bind NonEmptyArray + +derive newtype instance monadNonEmptyArray :: Monad NonEmptyArray + +derive newtype instance altNonEmptyArray :: Alt NonEmptyArray + +-- we use FFI here to avoid the unncessary copy created by `tail` +foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a +foldr1Impl = foldr1Impl +foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a +foldl1Impl = foldl1Impl + +traverse1Impl :: forall m a b . Fn3 (forall a' b'. (m (a' -> b') -> m a' -> m b')) (forall a' b'. (a' -> b') -> m a' -> m b') (a -> m b) (NonEmptyArray a -> m (NonEmptyArray b)) +traverse1Impl = traverse1Impl diff --git a/stdlib/lib/Data/Array/Partial.purs b/stdlib/lib/Data/Array/Partial.purs new file mode 100644 index 00000000..c3aa1561 --- /dev/null +++ b/stdlib/lib/Data/Array/Partial.purs @@ -0,0 +1,35 @@ +-- | Partial helper functions for working with immutable arrays. +module Data.Array.Partial + ( head + , tail + , last + , init + ) where + +import Prelude + +import Data.Array (length, slice, unsafeIndex) + +-- | Get the first element of a non-empty array. +-- | +-- | Running time: `O(1)`. +head :: forall a. Partial => Array a -> a +head xs = unsafeIndex xs 0 + +-- | Get all but the first element of a non-empty array. +-- | +-- | Running time: `O(n)`, where `n` is the length of the array. +tail :: forall a. Partial => Array a -> Array a +tail xs = slice 1 (length xs) xs + +-- | Get the last element of a non-empty array. +-- | +-- | Running time: `O(1)`. +last :: forall a. Partial => Array a -> a +last xs = unsafeIndex xs (length xs - 1) + +-- | Get all but the last element of a non-empty array. +-- | +-- | Running time: `O(n)`, where `n` is the length of the array. +init :: forall a. Partial => Array a -> Array a +init xs = slice 0 (length xs - 1) xs diff --git a/stdlib/lib/Data/Array/ST.purs b/stdlib/lib/Data/Array/ST.purs new file mode 100644 index 00000000..116243d0 --- /dev/null +++ b/stdlib/lib/Data/Array/ST.purs @@ -0,0 +1,265 @@ +-- | Helper functions for working with mutable arrays using the `ST` effect. +-- | +-- | This module can be used when performance is important and mutation is a local effect. + +module Data.Array.ST + ( STArray(..) + , Assoc + , run + , withArray + , new + , peek + , poke + , modify + , length + , pop + , push + , pushAll + , shift + , unshift + , unshiftAll + , splice + , sort + , sortBy + , sortWith + , freeze + , thaw + , clone + , unsafeFreeze + , unsafeThaw + , toAssocArray + ) where + +import Prelude + +import Control.Monad.ST (ST, Region) +import Control.Monad.ST as ST +import Control.Monad.ST.Uncurried (STFn1, STFn2, STFn3, STFn4, runSTFn1, runSTFn2, runSTFn3, runSTFn4) +import Data.Maybe (Maybe(..)) + +-- | A reference to a mutable array. +-- | +-- | The first type parameter represents the memory region which the array belongs to. +-- | The second type parameter defines the type of elements of the mutable array. +-- | +-- | The runtime representation of a value of type `STArray h a` is the same as that of `Array a`, +-- | except that mutation is allowed. +foreign import data STArray :: Region -> Type -> Type + +type role STArray nominal representational + +-- | An element and its index. +type Assoc a = { value :: a, index :: Int } + +-- | A safe way to create and work with a mutable array before returning an +-- | immutable array for later perusal. This function avoids copying the array +-- | before returning it - it uses unsafeFreeze internally, but this wrapper is +-- | a safe interface to that function. +run :: forall a. (forall h. ST h (STArray h a)) -> Array a +run st = ST.run (st >>= unsafeFreeze) + +-- | Perform an effect requiring a mutable array on a copy of an immutable array, +-- | safely returning the result as an immutable array. +withArray + :: forall h a b + . (STArray h a -> ST h b) + -> Array a + -> ST h (Array a) +withArray f xs = do + result <- thaw xs + _ <- f result + unsafeFreeze result + +-- | O(1). Convert a mutable array to an immutable array, without copying. The mutable +-- | array must not be mutated afterwards. +unsafeFreeze :: forall h a. STArray h a -> ST h (Array a) +unsafeFreeze = runSTFn1 unsafeFreezeImpl + +unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) +unsafeFreezeImpl = unsafeFreezeImpl + +-- | O(1) Convert an immutable array to a mutable array, without copying. The input +-- | array must not be used afterward. +unsafeThaw :: forall h a. Array a -> ST h (STArray h a) +unsafeThaw = runSTFn1 unsafeThawImpl + +unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a) +unsafeThawImpl = unsafeThawImpl + +-- | Create a new, empty mutable array. +new :: forall h a. ST h (STArray h a) +new = new + +thaw + :: forall h a + . Array a + -> ST h (STArray h a) +thaw = runSTFn1 thawImpl + +-- | Create a mutable copy of an immutable array. +thawImpl :: forall h a. STFn1 (Array a) h (STArray h a) +thawImpl = thawImpl + +-- | Make a mutable copy of a mutable array. +clone + :: forall h a + . STArray h a + -> ST h (STArray h a) +clone = runSTFn1 cloneImpl + +cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a) +cloneImpl = cloneImpl + +-- | Sort a mutable array in place. Sorting is stable: the order of equal +-- | elements is preserved. +sort :: forall a h. Ord a => STArray h a -> ST h (STArray h a) +sort = sortBy compare + +-- | Remove the first element from an array and return that element. +shift :: forall h a. STArray h a -> ST h (Maybe a) +shift = runSTFn3 shiftImpl Just Nothing + +shiftImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) +shiftImpl = shiftImpl + +-- | Sort a mutable array in place using a comparison function. Sorting is +-- | stable: the order of elements is preserved if they are equal according to +-- | the comparison function. +sortBy + :: forall a h + . (a -> a -> Ordering) + -> STArray h a + -> ST h (STArray h a) +sortBy comp = runSTFn3 sortByImpl comp case _ of + GT -> 1 + EQ -> 0 + LT -> -1 + +sortByImpl :: forall a h . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a) +sortByImpl = sortByImpl + +-- | Sort a mutable array in place based on a projection. Sorting is stable: the +-- | order of elements is preserved if they are equal according to the projection. +sortWith + :: forall a b h + . Ord b + => (a -> b) + -> STArray h a + -> ST h (STArray h a) +sortWith f = sortBy (comparing f) + +-- | Create an immutable copy of a mutable array. +freeze + :: forall h a + . STArray h a + -> ST h (Array a) +freeze = runSTFn1 freezeImpl + +freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) +freezeImpl = freezeImpl + +-- | Read the value at the specified index in a mutable array. +peek + :: forall h a + . Int + -> STArray h a + -> ST h (Maybe a) +peek = runSTFn4 peekImpl Just Nothing + +peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r +peekImpl = peekImpl + +poke + :: forall h a + . Int + -> a + -> STArray h a + -> ST h Boolean +poke = runSTFn3 pokeImpl + +-- | Change the value at the specified index in a mutable array. +pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean +pokeImpl = pokeImpl + +lengthImpl :: forall h a. STFn1 (STArray h a) h Int +lengthImpl = lengthImpl + +-- | Get the number of elements in a mutable array. +length :: forall h a. STArray h a -> ST h Int +length = runSTFn1 lengthImpl + +-- | Remove the last element from an array and return that element. +pop :: forall h a. STArray h a -> ST h (Maybe a) +pop = runSTFn3 popImpl Just Nothing + +popImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) +popImpl = popImpl + +-- | Append an element to the end of a mutable array. Returns the new length of +-- | the array. +push :: forall h a. a -> (STArray h a) -> ST h Int +push = runSTFn2 pushImpl + +pushImpl :: forall h a. STFn2 a (STArray h a) h Int +pushImpl = pushImpl + +-- | Append the values in an immutable array to the end of a mutable array. +-- | Returns the new length of the mutable array. +pushAll + :: forall h a + . Array a + -> STArray h a + -> ST h Int +pushAll = runSTFn2 pushAllImpl + +pushAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int +pushAllImpl = pushAllImpl + +-- | Append an element to the front of a mutable array. Returns the new length of +-- | the array. +unshift :: forall h a. a -> STArray h a -> ST h Int +unshift a = runSTFn2 unshiftAllImpl [ a ] + +-- | Append the values in an immutable array to the front of a mutable array. +-- | Returns the new length of the mutable array. +unshiftAll + :: forall h a + . Array a + -> STArray h a + -> ST h Int +unshiftAll = runSTFn2 unshiftAllImpl + +unshiftAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int +unshiftAllImpl = unshiftAllImpl + +-- | Mutate the element at the specified index using the supplied function. +modify :: forall h a. Int -> (a -> a) -> STArray h a -> ST h Boolean +modify i f xs = do + entry <- peek i xs + case entry of + Just x -> poke i (f x) xs + Nothing -> pure false + +-- | Remove and/or insert elements from/into a mutable array at the specified index. +splice + :: forall h a + . Int + -> Int + -> Array a + -> STArray h a + -> ST h (Array a) +splice = runSTFn4 spliceImpl + +spliceImpl :: forall h a . STFn4 Int Int (Array a) (STArray h a) h (Array a) +spliceImpl = spliceImpl + +-- | Create an immutable copy of a mutable array, where each element +-- | is labelled with its index in the original array. +toAssocArray + :: forall h a + . STArray h a + -> ST h (Array (Assoc a)) +toAssocArray = runSTFn1 toAssocArrayImpl + +toAssocArrayImpl :: forall h a . STFn1 (STArray h a) h (Array (Assoc a)) +toAssocArrayImpl = toAssocArrayImpl diff --git a/stdlib/lib/Data/Array/ST/Iterator.purs b/stdlib/lib/Data/Array/ST/Iterator.purs new file mode 100644 index 00000000..09daf0ed --- /dev/null +++ b/stdlib/lib/Data/Array/ST/Iterator.purs @@ -0,0 +1,80 @@ +module Data.Array.ST.Iterator + ( Iterator + , iterator + , iterate + , next + , peek + , exhausted + , pushWhile + , pushAll + ) where + +import Prelude +import Control.Monad.ST (ST) +import Control.Monad.ST as ST +import Control.Monad.ST.Ref (STRef) +import Control.Monad.ST.Ref as STRef +import Data.Array.ST (STArray) +import Data.Array.ST as STA + +import Data.Maybe (Maybe(..), isNothing) + +-- | This type provides a slightly easier way of iterating over an array's +-- | elements in an STArray computation, without having to keep track of +-- | indices. +data Iterator r a = Iterator (Int -> Maybe a) (STRef r Int) + +-- | Make an Iterator given an indexing function into an array (or anything +-- | else). If `xs :: Array a`, the standard way to create an iterator over +-- | `xs` is to use `iterator (xs !! _)`, where `(!!)` comes from `Data.Array`. +iterator :: forall r a. (Int -> Maybe a) -> ST r (Iterator r a) +iterator f = + Iterator f <$> STRef.new 0 + +-- | Perform an action once for each item left in an iterator. If the action +-- | itself also advances the same iterator, `iterate` will miss those items +-- | out. +iterate :: forall r a. Iterator r a -> (a -> ST r Unit) -> ST r Unit +iterate iter f = do + break <- STRef.new false + ST.while (not <$> STRef.read break) do + mx <- next iter + case mx of + Just x -> f x + Nothing -> void $ STRef.write true break + +-- | Get the next item out of an iterator, advancing it. Returns Nothing if the +-- | Iterator is exhausted. +next :: forall r a. Iterator r a -> ST r (Maybe a) +next (Iterator f currentIndex) = do + i <- STRef.read currentIndex + _ <- STRef.modify (_ + 1) currentIndex + pure (f i) + +-- | Get the next item out of an iterator without advancing it. +peek :: forall r a. Iterator r a -> ST r (Maybe a) +peek (Iterator f currentIndex) = do + i <- STRef.read currentIndex + pure (f i) + +-- | Check whether an iterator has been exhausted. +exhausted :: forall r a. Iterator r a -> ST r Boolean +exhausted = map isNothing <<< peek + +-- | Extract elements from an iterator and push them on to an STArray for as +-- | long as those elements satisfy a given predicate. +pushWhile :: forall r a. (a -> Boolean) -> Iterator r a -> STArray r a -> ST r Unit +pushWhile p iter array = do + break <- STRef.new false + ST.while (not <$> STRef.read break) do + mx <- peek iter + case mx of + Just x | p x -> do + _ <- STA.push x array + void $ next iter + _ -> + void $ STRef.write true break + +-- | Push the entire remaining contents of an iterator onto an STArray. +pushAll :: forall r a. Iterator r a -> STArray r a -> ST r Unit +pushAll = pushWhile (const true) diff --git a/stdlib/lib/Data/Array/ST/Partial.purs b/stdlib/lib/Data/Array/ST/Partial.purs new file mode 100644 index 00000000..bfde4eb7 --- /dev/null +++ b/stdlib/lib/Data/Array/ST/Partial.purs @@ -0,0 +1,38 @@ +-- | Partial functions for working with mutable arrays using the `ST` effect. +-- | +-- | This module is particularly helpful when performance is very important. + +module Data.Array.ST.Partial + ( peek + , poke + ) where + +import Control.Monad.ST (ST) +import Control.Monad.ST.Uncurried (STFn2, STFn3, runSTFn2, runSTFn3) +import Data.Array.ST (STArray) +import Data.Unit (Unit) + +-- | Read the value at the specified index in a mutable array. +peek + :: forall h a + . Partial + => Int + -> STArray h a + -> ST h a +peek = runSTFn2 peekImpl + +peekImpl :: forall h a. STFn2 Int (STArray h a) h a +peekImpl = peekImpl + +-- | Change the value at the specified index in a mutable array. +poke + :: forall h a + . Partial + => Int + -> a + -> STArray h a + -> ST h Unit +poke = runSTFn3 pokeImpl + +pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit +pokeImpl = pokeImpl diff --git a/stdlib/lib/Data/Bifoldable.purs b/stdlib/lib/Data/Bifoldable.purs new file mode 100644 index 00000000..9b187231 --- /dev/null +++ b/stdlib/lib/Data/Bifoldable.purs @@ -0,0 +1,198 @@ +module Data.Bifoldable where + +import Prelude + +import Control.Apply (applySecond) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, foldr, foldl, foldMap) +import Data.Functor.Clown (Clown(..)) +import Data.Functor.Flip (Flip(..)) +import Data.Functor.Joker (Joker(..)) +import Data.Functor.Product2 (Product2(..)) +import Data.Monoid.Conj (Conj(..)) +import Data.Monoid.Disj (Disj(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Endo (Endo(..)) +import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..)) + +-- | `Bifoldable` represents data structures with two type arguments which can be +-- | folded. +-- | +-- | A fold for such a structure requires two step functions, one for each type +-- | argument. Type class instances should choose the appropriate step function based +-- | on the type of the element encountered at each point of the fold. +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `bifoldrDefault` +-- | - `bifoldlDefault` +-- | - `bifoldMapDefaultR` +-- | - `bifoldMapDefaultL` +-- | +-- | Note: some combinations of the default implementations are unsafe to +-- | use together - causing a non-terminating mutually recursive cycle. +-- | These combinations are documented per function. +class Bifoldable p where + bifoldr :: forall a b c. (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c + bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c + bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m + +instance bifoldableClown :: Foldable f => Bifoldable (Clown f) where + bifoldr l _ u (Clown f) = foldr l u f + bifoldl l _ u (Clown f) = foldl l u f + bifoldMap l _ (Clown f) = foldMap l f + +instance bifoldableJoker :: Foldable f => Bifoldable (Joker f) where + bifoldr _ r u (Joker f) = foldr r u f + bifoldl _ r u (Joker f) = foldl r u f + bifoldMap _ r (Joker f) = foldMap r f + +instance bifoldableFlip :: Bifoldable p => Bifoldable (Flip p) where + bifoldr r l u (Flip p) = bifoldr l r u p + bifoldl r l u (Flip p) = bifoldl l r u p + bifoldMap r l (Flip p) = bifoldMap l r p + +instance bifoldableProduct2 :: (Bifoldable f, Bifoldable g) => Bifoldable (Product2 f g) where + bifoldr l r u m = bifoldrDefault l r u m + bifoldl l r u m = bifoldlDefault l r u m + bifoldMap l r (Product2 f g) = bifoldMap l r f <> bifoldMap l r g + +instance bifoldableEither :: Bifoldable Either where + bifoldr f _ z (Left a) = f a z + bifoldr _ g z (Right b) = g b z + bifoldl f _ z (Left a) = f z a + bifoldl _ g z (Right b) = g z b + bifoldMap f _ (Left a) = f a + bifoldMap _ g (Right b) = g b + +instance bifoldableTuple :: Bifoldable Tuple where + bifoldMap f g (Tuple a b) = f a <> g b + bifoldr f g z (Tuple a b) = f a (g b z) + bifoldl f g z (Tuple a b) = g (f z a) b + +instance bifoldableConst :: Bifoldable Const where + bifoldr f _ z (Const a) = f a z + bifoldl f _ z (Const a) = f z a + bifoldMap f _ (Const a) = f a + +-- | A default implementation of `bifoldr` using `bifoldMap`. +-- | +-- | Note: when defining a `Bifoldable` instance, this function is unsafe to +-- | use in combination with `bifoldMapDefaultR`. +bifoldrDefault + :: forall p a b c + . Bifoldable p + => (a -> c -> c) + -> (b -> c -> c) + -> c + -> p a b + -> c +bifoldrDefault f g z p = unwrap (bifoldMap (Endo <<< f) (Endo <<< g) p) z + +-- | A default implementation of `bifoldl` using `bifoldMap`. +-- | +-- | Note: when defining a `Bifoldable` instance, this function is unsafe to +-- | use in combination with `bifoldMapDefaultL`. +bifoldlDefault + :: forall p a b c + . Bifoldable p + => (c -> a -> c) + -> (c -> b -> c) + -> c + -> p a b + -> c +bifoldlDefault f g z p = + unwrap + (unwrap + (bifoldMap (Dual <<< Endo <<< flip f) (Dual <<< Endo <<< flip g) p)) + z + +-- | A default implementation of `bifoldMap` using `bifoldr`. +-- | +-- | Note: when defining a `Bifoldable` instance, this function is unsafe to +-- | use in combination with `bifoldrDefault`. +bifoldMapDefaultR + :: forall p m a b + . Bifoldable p + => Monoid m + => (a -> m) + -> (b -> m) + -> p a b + -> m +bifoldMapDefaultR f g = bifoldr (append <<< f) (append <<< g) mempty + +-- | A default implementation of `bifoldMap` using `bifoldl`. +-- | +-- | Note: when defining a `Bifoldable` instance, this function is unsafe to +-- | use in combination with `bifoldlDefault`. +bifoldMapDefaultL + :: forall p m a b + . Bifoldable p + => Monoid m + => (a -> m) + -> (b -> m) + -> p a b + -> m +bifoldMapDefaultL f g = bifoldl (\m a -> m <> f a) (\m b -> m <> g b) mempty + + +-- | Fold a data structure, accumulating values in a monoidal type. +bifold :: forall t m. Bifoldable t => Monoid m => t m m -> m +bifold = bifoldMap identity identity + +-- | Traverse a data structure, accumulating effects using an `Applicative` functor, +-- | ignoring the final result. +bitraverse_ + :: forall t f a b c d + . Bifoldable t + => Applicative f + => (a -> f c) + -> (b -> f d) + -> t a b + -> f Unit +bitraverse_ f g = bifoldr (applySecond <<< f) (applySecond <<< g) (pure unit) + +-- | A version of `bitraverse_` with the data structure as the first argument. +bifor_ + :: forall t f a b c d + . Bifoldable t + => Applicative f + => t a b + -> (a -> f c) + -> (b -> f d) + -> f Unit +bifor_ t f g = bitraverse_ f g t + +-- | Collapse a data structure, collecting effects using an `Applicative` functor, +-- | ignoring the final result. +bisequence_ + :: forall t f a b + . Bifoldable t + => Applicative f + => t (f a) (f b) + -> f Unit +bisequence_ = bitraverse_ identity identity + +-- | Test whether a predicate holds at any position in a data structure. +biany + :: forall t a b c + . Bifoldable t + => BooleanAlgebra c + => (a -> c) + -> (b -> c) + -> t a b + -> c +biany p q = unwrap <<< bifoldMap (Disj <<< p) (Disj <<< q) + +-- | Test whether a predicate holds at all positions in a data structure. +biall + :: forall t a b c + . Bifoldable t + => BooleanAlgebra c + => (a -> c) + -> (b -> c) + -> t a b + -> c +biall p q = unwrap <<< bifoldMap (Conj <<< p) (Conj <<< q) diff --git a/stdlib/lib/Data/Bifunctor.purs b/stdlib/lib/Data/Bifunctor.purs new file mode 100644 index 00000000..83287326 --- /dev/null +++ b/stdlib/lib/Data/Bifunctor.purs @@ -0,0 +1,46 @@ +module Data.Bifunctor where + +import Control.Category (identity) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Tuple (Tuple(..)) +import Data.Unit (Unit, unit) +import Data.Function (const) + +-- | A `Bifunctor` is a `Functor` from the pair category `(Type, Type)` to `Type`. +-- | +-- | A type constructor with two type arguments can be made into a `Bifunctor` if +-- | both of its type arguments are covariant. +-- | +-- | The `bimap` function maps a pair of functions over the two type arguments +-- | of the bifunctor. +-- | +-- | Laws: +-- | +-- | - Identity: `bimap identity identity == identity` +-- | - Composition: `bimap f1 g1 <<< bimap f2 g2 == bimap (f1 <<< f2) (g1 <<< g2)` +-- | +class Bifunctor f where + bimap :: forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d + +-- | Map a function over the first type argument of a `Bifunctor`. +lmap :: forall f a b c. Bifunctor f => (a -> b) -> f a c -> f b c +lmap f = bimap f identity + +-- | Map a function over the second type arguments of a `Bifunctor`. +rmap :: forall f a b c. Bifunctor f => (b -> c) -> f a b -> f a c +rmap = bimap identity + +-- | The bivoid function is used to ignore the types wrapped by a Bifunctor. +bivoid :: forall f a b. Bifunctor f => f a b -> f Unit Unit +bivoid = bimap (const unit) (const unit) + +instance bifunctorEither :: Bifunctor Either where + bimap f _ (Left l) = Left (f l) + bimap _ g (Right r) = Right (g r) + +instance bifunctorTuple :: Bifunctor Tuple where + bimap f g (Tuple x y) = Tuple (f x) (g y) + +instance bifunctorConst :: Bifunctor Const where + bimap f _ (Const a) = Const (f a) diff --git a/stdlib/lib/Data/Bifunctor/Join.purs b/stdlib/lib/Data/Bifunctor/Join.purs new file mode 100644 index 00000000..bbf8c756 --- /dev/null +++ b/stdlib/lib/Data/Bifunctor/Join.purs @@ -0,0 +1,31 @@ +module Data.Bifunctor.Join where + +import Prelude + +import Control.Biapplicative (class Biapplicative, bipure) +import Control.Biapply (class Biapply, (<<*>>)) + +import Data.Bifunctor (class Bifunctor, bimap) +import Data.Newtype (class Newtype) + +-- | Turns a `Bifunctor` into a `Functor` by equating the two type arguments. +newtype Join :: forall k. (k -> k -> Type) -> k -> Type +newtype Join p a = Join (p a a) + +derive instance newtypeJoin :: Newtype (Join p a) _ + +derive newtype instance eqJoin :: Eq (p a a) => Eq (Join p a) + +derive newtype instance ordJoin :: Ord (p a a) => Ord (Join p a) + +instance showJoin :: Show (p a a) => Show (Join p a) where + show (Join x) = "(Join " <> show x <> ")" + +instance bifunctorJoin :: Bifunctor p => Functor (Join p) where + map f (Join a) = Join (bimap f f a) + +instance biapplyJoin :: Biapply p => Apply (Join p) where + apply (Join f) (Join a) = Join (f <<*>> a) + +instance biapplicativeJoin :: Biapplicative p => Applicative (Join p) where + pure a = Join (bipure a a) diff --git a/stdlib/lib/Data/Bitraversable.purs b/stdlib/lib/Data/Bitraversable.purs new file mode 100644 index 00000000..6760549f --- /dev/null +++ b/stdlib/lib/Data/Bitraversable.purs @@ -0,0 +1,136 @@ +module Data.Bitraversable + ( class Bitraversable, bitraverse, bisequence + , bitraverseDefault + , bisequenceDefault + , ltraverse + , rtraverse + , bifor + , lfor + , rfor + , module Data.Bifoldable + ) where + +import Prelude + +import Data.Bifoldable (class Bifoldable, biall, biany, bifold, bifoldMap, bifoldMapDefaultL, bifoldMapDefaultR, bifoldl, bifoldlDefault, bifoldr, bifoldrDefault, bifor_, bisequence_, bitraverse_) +import Data.Traversable (class Traversable, traverse, sequence) +import Data.Bifunctor (class Bifunctor, bimap) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Functor.Clown (Clown(..)) +import Data.Functor.Flip (Flip(..)) +import Data.Functor.Joker (Joker(..)) +import Data.Functor.Product2 (Product2(..)) +import Data.Tuple (Tuple(..)) + +-- | `Bitraversable` represents data structures with two type arguments which can be +-- | traversed. +-- | +-- | A traversal for such a structure requires two functions, one for each type +-- | argument. Type class instances should choose the appropriate function based +-- | on the type of the element encountered at each point of the traversal. +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `bitraverseDefault` +-- | - `bisequenceDefault` +class (Bifunctor t, Bifoldable t) <= Bitraversable t where + bitraverse :: forall f a b c d. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) + bisequence :: forall f a b. Applicative f => t (f a) (f b) -> f (t a b) + +instance bitraversableClown :: Traversable f => Bitraversable (Clown f) where + bitraverse l _ (Clown f) = Clown <$> traverse l f + bisequence (Clown f) = Clown <$> sequence f + +instance bitraversableJoker :: Traversable f => Bitraversable (Joker f) where + bitraverse _ r (Joker f) = Joker <$> traverse r f + bisequence (Joker f) = Joker <$> sequence f + +instance bitraversableFlip :: Bitraversable p => Bitraversable (Flip p) where + bitraverse r l (Flip p) = Flip <$> bitraverse l r p + bisequence (Flip p) = Flip <$> bisequence p + +instance bitraversableProduct2 :: (Bitraversable f, Bitraversable g) => Bitraversable (Product2 f g) where + bitraverse l r (Product2 f g) = Product2 <$> bitraverse l r f <*> bitraverse l r g + bisequence (Product2 f g) = Product2 <$> bisequence f <*> bisequence g + +instance bitraversableEither :: Bitraversable Either where + bitraverse f _ (Left a) = Left <$> f a + bitraverse _ g (Right b) = Right <$> g b + bisequence (Left a) = Left <$> a + bisequence (Right b) = Right <$> b + +instance bitraversableTuple :: Bitraversable Tuple where + bitraverse f g (Tuple a b) = Tuple <$> f a <*> g b + bisequence (Tuple a b) = Tuple <$> a <*> b + +instance bitraversableConst :: Bitraversable Const where + bitraverse f _ (Const a) = Const <$> f a + bisequence (Const a) = Const <$> a + +ltraverse + :: forall t b c a f + . Bitraversable t + => Applicative f + => (a -> f c) + -> t a b + -> f (t c b) +ltraverse f = bitraverse f pure + +rtraverse + :: forall t b c a f + . Bitraversable t + => Applicative f + => (b -> f c) + -> t a b + -> f (t a c) +rtraverse = bitraverse pure + +-- | A default implementation of `bitraverse` using `bisequence` and `bimap`. +bitraverseDefault + :: forall t f a b c d + . Bitraversable t + => Applicative f + => (a -> f c) + -> (b -> f d) + -> t a b + -> f (t c d) +bitraverseDefault f g t = bisequence (bimap f g t) + +-- | A default implementation of `bisequence` using `bitraverse`. +bisequenceDefault + :: forall t f a b + . Bitraversable t + => Applicative f + => t (f a) (f b) + -> f (t a b) +bisequenceDefault = bitraverse identity identity + +-- | Traverse a data structure, accumulating effects and results using an `Applicative` functor. +bifor + :: forall t f a b c d + . Bitraversable t + => Applicative f + => t a b + -> (a -> f c) + -> (b -> f d) + -> f (t c d) +bifor t f g = bitraverse f g t + +lfor + :: forall t b c a f + . Bitraversable t + => Applicative f + => t a b + -> (a -> f c) + -> f (t c b) +lfor t f = bitraverse f pure t + +rfor + :: forall t b c a f + . Bitraversable t + => Applicative f + => t a b + -> (b -> f c) + -> f (t a c) +rfor t f = bitraverse pure f t diff --git a/stdlib/lib/Data/Boolean.purs b/stdlib/lib/Data/Boolean.purs new file mode 100644 index 00000000..9b4f6909 --- /dev/null +++ b/stdlib/lib/Data/Boolean.purs @@ -0,0 +1,10 @@ +module Data.Boolean where + +-- | An alias for `true`, which can be useful in guard clauses: +-- | +-- | ```purescript +-- | max x y | x >= y = x +-- | | otherwise = y +-- | ``` +otherwise :: Boolean +otherwise = true diff --git a/stdlib/lib/Data/BooleanAlgebra.purs b/stdlib/lib/Data/BooleanAlgebra.purs new file mode 100644 index 00000000..622caee5 --- /dev/null +++ b/stdlib/lib/Data/BooleanAlgebra.purs @@ -0,0 +1,43 @@ +module Data.BooleanAlgebra + ( class BooleanAlgebra + , module Data.HeytingAlgebra + , class BooleanAlgebraRecord + ) where + +import Data.HeytingAlgebra (class HeytingAlgebra, class HeytingAlgebraRecord, ff, tt, implies, conj, disj, not, (&&), (||)) +import Data.Symbol (class IsSymbol) +import Data.Unit (Unit) +import Prim.Row as Row +import Prim.RowList as RL +import Type.Proxy (Proxy) + +-- | The `BooleanAlgebra` type class represents types that behave like boolean +-- | values. +-- | +-- | Instances should satisfy the following laws in addition to the +-- | `HeytingAlgebra` law: +-- | +-- | - Excluded middle: +-- | - `a || not a = tt` +class HeytingAlgebra a <= BooleanAlgebra a + +instance booleanAlgebraBoolean :: BooleanAlgebra Boolean +instance booleanAlgebraUnit :: BooleanAlgebra Unit +instance booleanAlgebraFn :: BooleanAlgebra b => BooleanAlgebra (a -> b) +instance booleanAlgebraRecord :: (RL.RowToList row list, BooleanAlgebraRecord list row row) => BooleanAlgebra (Record row) +instance booleanAlgebraProxy :: BooleanAlgebra (Proxy a) + +-- | A class for records where all fields have `BooleanAlgebra` instances, used +-- | to implement the `BooleanAlgebra` instance for records. +class BooleanAlgebraRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class HeytingAlgebraRecord rowlist row subrow <= BooleanAlgebraRecord rowlist row subrow | rowlist -> subrow + +instance booleanAlgebraRecordNil :: BooleanAlgebraRecord RL.Nil row () + +instance booleanAlgebraRecordCons :: + ( IsSymbol key + , Row.Cons key focus subrowTail subrow + , BooleanAlgebraRecord rowlistTail row subrowTail + , BooleanAlgebra focus + ) => + BooleanAlgebraRecord (RL.Cons key focus rowlistTail) row subrow diff --git a/stdlib/lib/Data/Bounded.purs b/stdlib/lib/Data/Bounded.purs new file mode 100644 index 00000000..35ca7c2b --- /dev/null +++ b/stdlib/lib/Data/Bounded.purs @@ -0,0 +1,111 @@ +module Data.Bounded + ( class Bounded + , bottom + , top + , module Data.Ord + , class BoundedRecord + , bottomRecord + , topRecord + ) where + +import Data.Ord (class Ord, class OrdRecord, Ordering(..), compare, (<), (<=), (>), (>=)) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit, unit) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeSet) +import Type.Proxy (Proxy(..)) + +-- | The `Bounded` type class represents totally ordered types that have an +-- | upper and lower boundary. +-- | +-- | Instances should satisfy the following law in addition to the `Ord` laws: +-- | +-- | - Bounded: `bottom <= a <= top` +class Ord a <= Bounded a where + top :: a + bottom :: a + +instance boundedBoolean :: Bounded Boolean where + top = true + bottom = false + +-- | The `Bounded` `Int` instance has `top :: Int` equal to 2^31 - 1, +-- | and `bottom :: Int` equal to -2^31, since these are the largest and smallest +-- | integers representable by twos-complement 32-bit integers, respectively. +instance boundedInt :: Bounded Int where + top = topInt + bottom = bottomInt + +topInt :: Int +topInt = 2147483647 +bottomInt :: Int +bottomInt = intSub (intSub 0 2147483647) 1 + +-- | Characters fall within the Unicode range. +instance boundedChar :: Bounded Char where + top = topChar + bottom = bottomChar + +topChar :: Char +topChar = intToChar 65535 +bottomChar :: Char +bottomChar = intToChar 0 + +instance boundedOrdering :: Bounded Ordering where + top = GT + bottom = LT + +instance boundedUnit :: Bounded Unit where + top = unit + bottom = unit + +topNumber :: Number +topNumber = numberDiv 1.0 0.0 +bottomNumber :: Number +bottomNumber = numberNeg (numberDiv 1.0 0.0) + +instance boundedNumber :: Bounded Number where + top = topNumber + bottom = bottomNumber + +instance boundedProxy :: Bounded (Proxy a) where + bottom = Proxy + top = Proxy + +class BoundedRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class OrdRecord rowlist row <= BoundedRecord rowlist row subrow | rowlist -> subrow where + topRecord :: Proxy rowlist -> Proxy row -> Record subrow + bottomRecord :: Proxy rowlist -> Proxy row -> Record subrow + +instance boundedRecordNil :: BoundedRecord RL.Nil row () where + topRecord _ _ = {} + bottomRecord _ _ = {} + +instance boundedRecordCons :: + ( IsSymbol key + , Bounded focus + , Row.Cons key focus rowTail row + , Row.Cons key focus subrowTail subrow + , BoundedRecord rowlistTail row subrowTail + ) => + BoundedRecord (RL.Cons key focus rowlistTail) row subrow where + topRecord _ rowProxy = insert top tail + where + key = reflectSymbol (Proxy :: Proxy key) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = topRecord (Proxy :: Proxy rowlistTail) rowProxy + + bottomRecord _ rowProxy = insert bottom tail + where + key = reflectSymbol (Proxy :: Proxy key) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = bottomRecord (Proxy :: Proxy rowlistTail) rowProxy + +instance boundedRecord :: + ( RL.RowToList row list + , BoundedRecord list row row + ) => + Bounded (Record row) where + top = topRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + bottom = bottomRecord (Proxy :: Proxy list) (Proxy :: Proxy row) diff --git a/stdlib/lib/Data/Bounded/Generic.purs b/stdlib/lib/Data/Bounded/Generic.purs new file mode 100644 index 00000000..c7e2e2ed --- /dev/null +++ b/stdlib/lib/Data/Bounded/Generic.purs @@ -0,0 +1,56 @@ +module Data.Bounded.Generic + ( class GenericBottom + , genericBottom' + , genericBottom + , class GenericTop + , genericTop' + , genericTop + ) where + +import Data.Generic.Rep + +import Data.Bounded (class Bounded, bottom, top) + +class GenericBottom a where + genericBottom' :: a + +instance genericBottomNoArguments :: GenericBottom NoArguments where + genericBottom' = NoArguments + +instance genericBottomArgument :: Bounded a => GenericBottom (Argument a) where + genericBottom' = Argument bottom + +instance genericBottomSum :: GenericBottom a => GenericBottom (Sum a b) where + genericBottom' = Inl genericBottom' + +instance genericBottomProduct :: (GenericBottom a, GenericBottom b) => GenericBottom (Product a b) where + genericBottom' = Product genericBottom' genericBottom' + +instance genericBottomConstructor :: GenericBottom a => GenericBottom (Constructor name a) where + genericBottom' = Constructor genericBottom' + +class GenericTop a where + genericTop' :: a + +instance genericTopNoArguments :: GenericTop NoArguments where + genericTop' = NoArguments + +instance genericTopArgument :: Bounded a => GenericTop (Argument a) where + genericTop' = Argument top + +instance genericTopSum :: GenericTop b => GenericTop (Sum a b) where + genericTop' = Inr genericTop' + +instance genericTopProduct :: (GenericTop a, GenericTop b) => GenericTop (Product a b) where + genericTop' = Product genericTop' genericTop' + +instance genericTopConstructor :: GenericTop a => GenericTop (Constructor name a) where + genericTop' = Constructor genericTop' + +-- | A `Generic` implementation of the `bottom` member from the `Bounded` type class. +genericBottom :: forall a rep. Generic a rep => GenericBottom rep => a +genericBottom = to genericBottom' + +-- | A `Generic` implementation of the `top` member from the `Bounded` type class. +genericTop :: forall a rep. Generic a rep => GenericTop rep => a +genericTop = to genericTop' diff --git a/stdlib/lib/Data/Char.purs b/stdlib/lib/Data/Char.purs new file mode 100644 index 00000000..bb413b7d --- /dev/null +++ b/stdlib/lib/Data/Char.purs @@ -0,0 +1,16 @@ +-- | A type and functions for single characters. +module Data.Char + ( toCharCode + , fromCharCode + ) where + +import Data.Enum (fromEnum, toEnum) +import Data.Maybe (Maybe) + +-- | Returns the numeric Unicode value of the character. +toCharCode :: Char -> Int +toCharCode = fromEnum + +-- | Constructs a character from the given Unicode numeric value. +fromCharCode :: Int -> Maybe Char +fromCharCode = toEnum diff --git a/stdlib/lib/Data/Char/Gen.purs b/stdlib/lib/Data/Char/Gen.purs new file mode 100644 index 00000000..838ff29d --- /dev/null +++ b/stdlib/lib/Data/Char/Gen.purs @@ -0,0 +1,35 @@ +module Data.Char.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, oneOf) +import Data.Enum (toEnumWithDefaults) +import Data.NonEmpty ((:|)) + +-- | Generates a character of the Unicode basic multilingual plane. +genUnicodeChar :: forall m. MonadGen m => m Char +genUnicodeChar = toEnumWithDefaults bottom top <$> chooseInt 0 65536 + +-- | Generates a character in the ASCII character set, excluding control codes. +genAsciiChar :: forall m. MonadGen m => m Char +genAsciiChar = toEnumWithDefaults bottom top <$> chooseInt 32 127 + +-- | Generates a character in the ASCII character set. +genAsciiChar' :: forall m. MonadGen m => m Char +genAsciiChar' = toEnumWithDefaults bottom top <$> chooseInt 0 127 + +-- | Generates a character that is a numeric digit. +genDigitChar :: forall m. MonadGen m => m Char +genDigitChar = toEnumWithDefaults bottom top <$> chooseInt 48 57 + +-- | Generates a character from the basic latin alphabet. +genAlpha :: forall m. MonadGen m => m Char +genAlpha = oneOf (genAlphaLowercase :| [genAlphaUppercase]) + +-- | Generates a lowercase character from the basic latin alphabet. +genAlphaLowercase :: forall m. MonadGen m => m Char +genAlphaLowercase = toEnumWithDefaults bottom top <$> chooseInt 97 122 + +-- | Generates an uppercase character from the basic latin alphabet. +genAlphaUppercase :: forall m. MonadGen m => m Char +genAlphaUppercase = toEnumWithDefaults bottom top <$> chooseInt 65 90 diff --git a/stdlib/lib/Data/CommutativeRing.purs b/stdlib/lib/Data/CommutativeRing.purs new file mode 100644 index 00000000..38e6e27e --- /dev/null +++ b/stdlib/lib/Data/CommutativeRing.purs @@ -0,0 +1,44 @@ +module Data.CommutativeRing + ( class CommutativeRing + , module Data.Ring + , module Data.Semiring + , class CommutativeRingRecord + ) where + +import Data.Ring (class Ring, class RingRecord) +import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) +import Data.Symbol (class IsSymbol) +import Data.Unit (Unit) +import Prim.Row as Row +import Prim.RowList as RL +import Type.Proxy (Proxy) + +-- | The `CommutativeRing` class is for rings where multiplication is +-- | commutative. +-- | +-- | Instances must satisfy the following law in addition to the `Ring` +-- | laws: +-- | +-- | - Commutative multiplication: `a * b = b * a` +class Ring a <= CommutativeRing a + +instance commutativeRingInt :: CommutativeRing Int +instance commutativeRingNumber :: CommutativeRing Number +instance commutativeRingUnit :: CommutativeRing Unit +instance commutativeRingFn :: CommutativeRing b => CommutativeRing (a -> b) +instance commutativeRingRecord :: (RL.RowToList row list, CommutativeRingRecord list row row) => CommutativeRing (Record row) +instance commutativeRingProxy :: CommutativeRing (Proxy a) + +-- | A class for records where all fields have `CommutativeRing` instances, used +-- | to implement the `CommutativeRing` instance for records. +class RingRecord rowlist row subrow <= CommutativeRingRecord rowlist row subrow | rowlist -> subrow + +instance commutativeRingRecordNil :: CommutativeRingRecord RL.Nil row () + +instance commutativeRingRecordCons :: + ( IsSymbol key + , Row.Cons key focus subrowTail subrow + , CommutativeRingRecord rowlistTail row subrowTail + , CommutativeRing focus + ) => + CommutativeRingRecord (RL.Cons key focus rowlistTail) row subrow diff --git a/stdlib/lib/Data/Compactable.purs b/stdlib/lib/Data/Compactable.purs new file mode 100644 index 00000000..2e6be9de --- /dev/null +++ b/stdlib/lib/Data/Compactable.purs @@ -0,0 +1,164 @@ +module Data.Compactable + ( class Compactable + , compact + , separate + , compactDefault + , separateDefault + , applyMaybe + , applyEither + , bindMaybe + , bindEither + ) where + +import Control.Alternative (empty, (<|>)) +import Control.Applicative (class Apply, apply, pure) +import Control.Apply ((<*>)) +import Control.Bind (class Bind, bind, join) +import Control.Monad.ST as ST +import Data.Array ((!!)) +import Data.Array.ST as STA +import Data.Array.ST.Iterator as STAI +import Data.Either (Either(Right, Left), hush, note) +import Data.Foldable (foldl, foldr) +import Data.Function (($)) +import Data.Functor (class Functor, map, (<$>)) +import Data.List as List +import Data.Map as Map +import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid, mempty) +import Data.Tuple (Tuple(..)) +import Prelude (class Ord, const, discard, unit, void, (<<<)) + +-- | `Compactable` represents data structures which can be _compacted_/_filtered_. +-- | This is a generalization of catMaybes as a new function `compact`. `compact` +-- | has relations with `Functor`, `Applicative`, `Monad`, `Plus`, and `Traversable` +-- | in that we can use these classes to provide the ability to operate on a data type +-- | by eliminating intermediate Nothings. This is useful for representing the +-- | filtering out of values, or failure. +-- | +-- | To be compactable alone, no laws must be satisfied other than the type signature. +-- | +-- | If the data type is also a Functor the following should hold: +-- | +-- | - Functor Identity: `compact <<< map Just ≡ id` +-- | +-- | According to Kmett, (Compactable f, Functor f) is a functor from the +-- | kleisli category of Maybe to the category of Hask. +-- | `Kleisli Maybe -> Hask`. +-- | +-- | If the data type is also `Applicative` the following should hold: +-- | +-- | - `compact <<< (pure Just <*> _) ≡ id` +-- | - `applyMaybe (pure Just) ≡ id` +-- | - `compact ≡ applyMaybe (pure id)` +-- | +-- | If the data type is also a `Monad` the following should hold: +-- | +-- | - `flip bindMaybe (pure <<< Just) ≡ id` +-- | - `compact <<< (pure <<< (Just (=<<))) ≡ id` +-- | - `compact ≡ flip bindMaybe pure` +-- | +-- | If the data type is also `Plus` the following should hold: +-- | +-- | - `compact empty ≡ empty` +-- | - `compact (const Nothing <$> xs) ≡ empty` + +class Compactable f where + compact :: forall a. + f (Maybe a) -> f a + + separate :: forall l r. + f (Either l r) -> { left :: f l, right :: f r } + +compactDefault :: forall f a. Functor f => Compactable f => + f (Maybe a) -> f a +compactDefault = _.right <<< separate <<< map (note unit) + +separateDefault :: forall f l r. Functor f => Compactable f => + f (Either l r) -> { left :: f l, right :: f r} +separateDefault xs = { left: compact $ (hush <<< swapEither) <$> xs + , right: compact $ hush <$> xs + } + where + swapEither e = case e of + Left x -> Right x + Right y -> Left y + +instance compactableMaybe :: Compactable Maybe where + compact = join + + separate Nothing = { left: Nothing, right: Nothing } + separate (Just e) = case e of + Left l -> { left: Just l, right: Nothing } + Right r -> { left: Nothing, right: Just r } + +instance compactableEither :: Monoid m => Compactable (Either m) where + compact (Left m) = Left m + compact (Right m) = case m of + Just v -> Right v + Nothing -> Left mempty + + separate (Left x) = { left: Left x, right: Left x } + separate (Right e) = case e of + Left l -> { left: Right l, right: Left mempty } + Right r -> { left: Left mempty, right: Right r } + +instance compactableArray :: Compactable Array where + compact xs = ST.run do + result <- STA.new + iter <- STAI.iterator (xs !! _) + + STAI.iterate iter $ void <<< case _ of + Nothing -> pure 0 + Just j -> STA.push j result + + STA.unsafeFreeze result + + separate xs = ST.run do + ls <- STA.new + rs <- STA.new + iter <- STAI.iterator (xs !! _) + + STAI.iterate iter $ void <<< case _ of + Left l -> STA.push l ls + Right r -> STA.push r rs + + {left: _, right: _} <$> STA.unsafeFreeze ls <*> STA.unsafeFreeze rs + +instance compactableList :: Compactable List.List where + compact = List.catMaybes + separate = foldl go { left: empty, right: empty } where + go acc = case _ of + Left l -> acc { left = acc.left <|> pure l } + Right r -> acc { right = acc.right <|> pure r } + +instance compactableMap :: Ord k => Compactable (Map.Map k) where + compact = foldr select Map.empty <<< mapToList + where + select (Tuple k x) m = Map.alter (const x) k m + + separate = foldr select { left: Map.empty, right: Map.empty } <<< mapToList + where + select (Tuple k v) { left, right } = case v of + Left l -> { left: Map.insert k l left, right } + Right r -> { left: left, right: Map.insert k r right } + +mapToList :: forall k v. Ord k => + Map.Map k v -> List.List (Tuple k v) +mapToList = Map.toUnfoldable + +applyMaybe :: forall f a b. Apply f => Compactable f => + f (a -> Maybe b) -> f a -> f b +applyMaybe p = compact <<< apply p + +applyEither :: forall f a l r. Apply f => Compactable f => + f (a -> Either l r) -> f a -> { left :: f l, right :: f r } +applyEither p = separate <<< apply p + +bindMaybe :: forall m a b. Bind m => Compactable m => + m a -> (a -> m (Maybe b)) -> m b +bindMaybe x = compact <<< bind x + +bindEither :: forall m a l r. Bind m => Compactable m => + m a -> (a -> m (Either l r)) -> { left :: m l, right :: m r } +bindEither x = separate <<< bind x diff --git a/stdlib/lib/Data/Comparison.purs b/stdlib/lib/Data/Comparison.purs new file mode 100644 index 00000000..9f9132d2 --- /dev/null +++ b/stdlib/lib/Data/Comparison.purs @@ -0,0 +1,25 @@ +module Data.Comparison where + +import Prelude + +import Data.Function (on) +import Data.Functor.Contravariant (class Contravariant) +import Data.Newtype (class Newtype) + +-- | An adaptor allowing `>$<` to map over the inputs of a comparison function. +newtype Comparison a = Comparison (a -> a -> Ordering) + +derive instance newtypeComparison :: Newtype (Comparison a) _ + +instance contravariantComparison :: Contravariant Comparison where + cmap f (Comparison g) = Comparison (g `on` f) + +instance semigroupComparison :: Semigroup (Comparison a) where + append (Comparison p) (Comparison q) = Comparison (p <> q) + +instance monoidComparison :: Monoid (Comparison a) where + mempty = Comparison (\_ _ -> EQ) + +-- | The default comparison for any values with an `Ord` instance. +defaultComparison :: forall a. Ord a => Comparison a +defaultComparison = Comparison compare diff --git a/stdlib/lib/Data/Const.purs b/stdlib/lib/Data/Const.purs new file mode 100644 index 00000000..eeeccba2 --- /dev/null +++ b/stdlib/lib/Data/Const.purs @@ -0,0 +1,63 @@ +module Data.Const where + +import Prelude + +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) + +-- | The `Const` type constructor, which wraps its first type argument +-- | and ignores its second. That is, `Const a b` is isomorphic to `a` +-- | for any `b`. +-- | +-- | `Const` has some useful instances. For example, the `Applicative` +-- | instance allows us to collect results using a `Monoid` while +-- | ignoring return values. +newtype Const :: forall k. Type -> k -> Type +newtype Const a b = Const a + +derive instance newtypeConst :: Newtype (Const a b) _ + +derive newtype instance eqConst :: Eq a => Eq (Const a b) + +derive instance eq1Const :: Eq a => Eq1 (Const a) + +derive newtype instance ordConst :: Ord a => Ord (Const a b) + +derive instance ord1Const :: Ord a => Ord1 (Const a) + +derive newtype instance boundedConst :: Bounded a => Bounded (Const a b) + +instance showConst :: Show a => Show (Const a b) where + show (Const x) = "(Const " <> show x <> ")" + +instance semigroupoidConst :: Semigroupoid Const where + compose _ (Const x) = Const x + +derive newtype instance semigroupConst :: Semigroup a => Semigroup (Const a b) + +derive newtype instance monoidConst :: Monoid a => Monoid (Const a b) + +derive newtype instance semiringConst :: Semiring a => Semiring (Const a b) + +derive newtype instance ringConst :: Ring a => Ring (Const a b) + +derive newtype instance euclideanRingConst :: EuclideanRing a => EuclideanRing (Const a b) + +derive newtype instance commutativeRingConst :: CommutativeRing a => CommutativeRing (Const a b) + +derive newtype instance heytingAlgebraConst :: HeytingAlgebra a => HeytingAlgebra (Const a b) + +derive newtype instance booleanAlgebraConst :: BooleanAlgebra a => BooleanAlgebra (Const a b) + +derive instance functorConst :: Functor (Const a) + +instance invariantConst :: Invariant (Const a) where + imap = imapF + +instance applyConst :: Semigroup a => Apply (Const a) where + apply (Const x) (Const y) = Const (x <> y) + +instance applicativeConst :: Monoid a => Applicative (Const a) where + pure _ = Const mempty diff --git a/stdlib/lib/Data/Decidable.purs b/stdlib/lib/Data/Decidable.purs new file mode 100644 index 00000000..ce910de1 --- /dev/null +++ b/stdlib/lib/Data/Decidable.purs @@ -0,0 +1,29 @@ +module Data.Decidable where + +import Prelude + +import Data.Comparison (Comparison(..)) +import Data.Decide (class Decide) +import Data.Divisible (class Divisible) +import Data.Equivalence (Equivalence(..)) +import Data.Op (Op(..)) +import Data.Predicate (Predicate(..)) + +-- | `Decidable` is the contravariant analogue of `Alternative`. +class (Decide f, Divisible f) <= Decidable f where + lose :: forall a. (a -> Void) -> f a + +instance decidableComparison :: Decidable Comparison where + lose f = Comparison \a _ -> absurd (f a) + +instance decidableEquivalence :: Decidable Equivalence where + lose f = Equivalence \a -> absurd (f a) + +instance decidablePredicate :: Decidable Predicate where + lose f = Predicate \a -> absurd (f a) + +instance decidableOp :: Monoid r => Decidable (Op r) where + lose f = Op \a -> absurd (f a) + +lost :: forall f. Decidable f => f Void +lost = lose identity diff --git a/stdlib/lib/Data/Decide.purs b/stdlib/lib/Data/Decide.purs new file mode 100644 index 00000000..746f3323 --- /dev/null +++ b/stdlib/lib/Data/Decide.purs @@ -0,0 +1,42 @@ +module Data.Decide where + +import Prelude + +import Data.Comparison (Comparison(..)) +import Data.Divide (class Divide) +import Data.Either (Either(..), either) +import Data.Equivalence (Equivalence(..)) +import Data.Op (Op(..)) +import Data.Predicate (Predicate(..)) + +-- | `Decide` is the contravariant analogue of `Alt`. +class Divide f <= Decide f where + choose :: forall a b c. (a -> Either b c) -> f b -> f c -> f a + +instance chooseComparison :: Decide Comparison where + choose f (Comparison g) (Comparison h) = Comparison \a b -> case f a of + Left c -> case f b of + Left d -> g c d + Right _ -> LT + Right c -> case f b of + Left _ -> GT + Right d -> h c d + +instance chooseEquivalence :: Decide Equivalence where + choose f (Equivalence g) (Equivalence h) = Equivalence \a b -> case f a of + Left c -> case f b of + Left d -> g c d + Right _ -> false + Right c -> case f b of + Left _ -> false + Right d -> h c d + +instance choosePredicate :: Decide Predicate where + choose f (Predicate g) (Predicate h) = Predicate (either g h <<< f) + +instance chooseOp :: Semigroup r => Decide (Op r) where + choose f (Op g) (Op h) = Op (either g h <<< f) + +-- | `chosen = choose id` +chosen :: forall f a b. Decide f => f a -> f b -> f (Either a b) +chosen = choose identity diff --git a/stdlib/lib/Data/Distributive.purs b/stdlib/lib/Data/Distributive.purs new file mode 100644 index 00000000..a4a83e45 --- /dev/null +++ b/stdlib/lib/Data/Distributive.purs @@ -0,0 +1,67 @@ +module Data.Distributive where + +import Prelude + +import Data.Identity (Identity(..)) +import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..), snd) +import Type.Equality (class TypeEquals, from) + +-- | Categorical dual of `Traversable`: +-- | +-- | - `distribute` is the dual of `sequence` - it zips an arbitrary collection +-- | of containers. +-- | - `collect` is the dual of `traverse` - it traverses an arbitrary +-- | collection of values. +-- | +-- | Laws: +-- | +-- | - `distribute = collect identity` +-- | - `distribute <<< distribute = identity` +-- | - `collect f = distribute <<< map f` +-- | - `map f = unwrap <<< collect (Identity <<< f)` +-- | - `map distribute <<< collect f = unwrap <<< collect (Compose <<< f)` +class Functor f <= Distributive f where + distribute :: forall a g. Functor g => g (f a) -> f (g a) + collect :: forall a b g. Functor g => (a -> f b) -> g a -> f (g b) + +instance distributiveIdentity :: Distributive Identity where + distribute = Identity <<< map unwrap + collect f = Identity <<< map (unwrap <<< f) + +instance distributiveFunction :: Distributive ((->) e) where + distribute a e = map (_ $ e) a + collect f = distribute <<< map f + +instance distributiveTuple :: TypeEquals a Unit => Distributive (Tuple a) where + collect = collectDefault + distribute = Tuple (from unit) <<< map snd + +-- | A default implementation of `distribute`, based on `collect`. +distributeDefault + :: forall a f g + . Distributive f + => Functor g + => g (f a) + -> f (g a) +distributeDefault = collect identity + +-- | A default implementation of `collect`, based on `distribute`. +collectDefault + :: forall a b f g + . Distributive f + => Functor g + => (a -> f b) + -> g a + -> f (g b) +collectDefault f = distribute <<< map f + +-- | Zip an arbitrary collection of containers and summarize the results +cotraverse + :: forall a b f g + . Distributive f + => Functor g + => (g a -> b) + -> g (f a) + -> f b +cotraverse f = map f <<< distribute diff --git a/stdlib/lib/Data/Divide.purs b/stdlib/lib/Data/Divide.purs new file mode 100644 index 00000000..4581dcc9 --- /dev/null +++ b/stdlib/lib/Data/Divide.purs @@ -0,0 +1,46 @@ +module Data.Divide where + +import Prelude + +import Data.Comparison (Comparison(..)) +import Data.Equivalence (Equivalence(..)) +import Data.Functor.Contravariant (class Contravariant) +import Data.Op (Op(..)) +import Data.Predicate (Predicate(..)) +import Data.Tuple (Tuple(..)) + +-- | `Divide` is the contravariant analogue of `Apply`. +-- | +-- | For example, to test equality of `Point`s, we can use the `Divide` instance +-- | for `Equivalence`: +-- | +-- | ```purescript +-- | type Point = Tuple Int Int +-- | +-- | pointEquiv :: Equivalence Point +-- | pointEquiv = divided defaultEquivalence defaultEquivalence +-- | ``` +class Contravariant f <= Divide f where + divide :: forall a b c. (a -> Tuple b c) -> f b -> f c -> f a + +instance divideComparison :: Divide Comparison where + divide f (Comparison g) (Comparison h) = Comparison \a b -> case f a of + Tuple a' a'' -> case f b of + Tuple b' b'' -> g a' b' <> h a'' b'' + +instance divideEquivalence :: Divide Equivalence where + divide f (Equivalence g) (Equivalence h) = Equivalence \a b -> case f a of + Tuple a' a'' -> case f b of + Tuple b' b'' -> g a' b' && h a'' b'' + +instance dividePredicate :: Divide Predicate where + divide f (Predicate g) (Predicate h) = Predicate \a -> case f a of + Tuple b c -> g b && h c + +instance divideOp :: Semigroup r => Divide (Op r) where + divide f (Op g) (Op h) = Op \a -> case f a of + Tuple b c -> g b <> h c + +-- | `divided = divide id` +divided :: forall f a b. Divide f => f a -> f b -> f (Tuple a b) +divided = divide identity diff --git a/stdlib/lib/Data/Divisible.purs b/stdlib/lib/Data/Divisible.purs new file mode 100644 index 00000000..d717b4ac --- /dev/null +++ b/stdlib/lib/Data/Divisible.purs @@ -0,0 +1,25 @@ +module Data.Divisible where + +import Prelude + +import Data.Comparison (Comparison(..)) +import Data.Divide (class Divide) +import Data.Equivalence (Equivalence(..)) +import Data.Op (Op(..)) +import Data.Predicate (Predicate(..)) + +-- | `Divisible` is the contravariant analogue of `Applicative`. +class Divide f <= Divisible f where + conquer :: forall a. f a + +instance divisibleComparison :: Divisible Comparison where + conquer = Comparison $ \_ _ -> EQ + +instance divisibleEquivalence :: Divisible Equivalence where + conquer = Equivalence $ \_ _ -> true + +instance divisiblePredicate :: Divisible Predicate where + conquer = Predicate (const true) + +instance divisibleOp :: (Monoid r) => Divisible (Op r) where + conquer = Op $ const mempty diff --git a/stdlib/lib/Data/DivisionRing.purs b/stdlib/lib/Data/DivisionRing.purs new file mode 100644 index 00000000..227f7a94 --- /dev/null +++ b/stdlib/lib/Data/DivisionRing.purs @@ -0,0 +1,55 @@ +module Data.DivisionRing + ( class DivisionRing + , recip + , leftDiv + , rightDiv + , module Data.Ring + , module Data.Semiring + ) where + +import Data.EuclideanRing ((/)) +import Data.Ring (class Ring, negate, sub) +import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) + +-- | The `DivisionRing` class is for non-zero rings in which every non-zero +-- | element has a multiplicative inverse. Division rings are sometimes also +-- | called *skew fields*. +-- | +-- | Instances must satisfy the following laws in addition to the `Ring` laws: +-- | +-- | - Non-zero ring: `one /= zero` +-- | - Non-zero multiplicative inverse: `recip a * a = a * recip a = one` for +-- | all non-zero `a` +-- | +-- | The result of `recip zero` is left undefined; individual instances may +-- | choose how to handle this case. +-- | +-- | If a type has both `DivisionRing` and `CommutativeRing` instances, then +-- | it is a field and should have a `Field` instance. +class Ring a <= DivisionRing a where + recip :: a -> a + +-- | Left division, defined as `leftDiv a b = recip b * a`. Left and right +-- | division are distinct in this module because a `DivisionRing` is not +-- | necessarily commutative. +-- | +-- | If the type `a` is also a `EuclideanRing`, then this function is +-- | equivalent to `div` from the `EuclideanRing` class. When working +-- | abstractly, `div` should generally be preferred, unless you know that you +-- | need your code to work with noncommutative rings. +leftDiv :: forall a. DivisionRing a => a -> a -> a +leftDiv a b = recip b * a + +-- | Right division, defined as `rightDiv a b = a * recip b`. Left and right +-- | division are distinct in this module because a `DivisionRing` is not +-- | necessarily commutative. +-- | +-- | If the type `a` is also a `EuclideanRing`, then this function is +-- | equivalent to `div` from the `EuclideanRing` class. When working +-- | abstractly, `div` should generally be preferred, unless you know that you +-- | need your code to work with noncommutative rings. +rightDiv :: forall a. DivisionRing a => a -> a -> a +rightDiv a b = a * recip b + +instance divisionringNumber :: DivisionRing Number where + recip x = 1.0 / x diff --git a/stdlib/lib/Data/Either.purs b/stdlib/lib/Data/Either.purs index b22b6b88..3940d936 100644 --- a/stdlib/lib/Data/Either.purs +++ b/stdlib/lib/Data/Either.purs @@ -1,21 +1,294 @@ - module Data.Either where -import Data.Maybe +import Prelude + +import Control.Alt (class Alt, (<|>)) +import Control.Extend (class Extend) +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.Generic.Rep (class Generic) +import Data.Maybe (Maybe(..), maybe, maybe') +import Data.Ord (class Ord1) +-- | The `Either` type is used to represent a choice between two types of value. +-- | +-- | A common use case for `Either` is error handling, where `Left` is used to +-- | carry an error value and `Right` is used to carry a success value. data Either a b = Left a | Right b +-- | The `Functor` instance allows functions to transform the contents of a +-- | `Right` with the `<$>` operator: +-- | +-- | ``` purescript +-- | f <$> Right x == Right (f x) +-- | ``` +-- | +-- | `Left` values are untouched: +-- | +-- | ``` purescript +-- | f <$> Left y == Left y +-- | ``` +derive instance functorEither :: Functor (Either a) + +derive instance genericEither :: Generic (Either a b) _ + +instance invariantEither :: Invariant (Either a) where + imap = imapF + +-- | The `Apply` instance allows functions contained within a `Right` to +-- | transform a value contained within a `Right` using the `(<*>)` operator: +-- | +-- | ``` purescript +-- | Right f <*> Right x == Right (f x) +-- | ``` +-- | +-- | `Left` values are left untouched: +-- | +-- | ``` purescript +-- | Left f <*> Right x == Left f +-- | Right f <*> Left y == Left y +-- | ``` +-- | +-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used to transform a +-- | pure function to take `Either`-typed arguments so `f :: a -> b -> c` +-- | becomes `f :: Either l a -> Either l b -> Either l c`: +-- | +-- | ``` purescript +-- | f <$> Right x <*> Right y == Right (f x y) +-- | ``` +-- | +-- | The `Left`-preserving behaviour of both operators means the result of +-- | an expression like the above but where any one of the values is `Left` +-- | means the whole result becomes `Left` also, taking the first `Left` value +-- | found: +-- | +-- | ``` purescript +-- | f <$> Left x <*> Right y == Left x +-- | f <$> Right x <*> Left y == Left y +-- | f <$> Left x <*> Left y == Left x +-- | ``` +instance applyEither :: Apply (Either e) where + apply (Left e) _ = Left e + apply (Right f) r = f <$> r + +-- | The `Applicative` instance enables lifting of values into `Either` with the +-- | `pure` function: +-- | +-- | ``` purescript +-- | pure x :: Either _ _ == Right x +-- | ``` +-- | +-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s +-- | `pure` can be used to pass a mixture of `Either` and non-`Either` typed +-- | values to a function that does not usually expect them, by using `pure` +-- | for any value that is not already `Either` typed: +-- | +-- | ``` purescript +-- | f <$> Right x <*> pure y == Right (f x y) +-- | ``` +-- | +-- | Even though `pure = Right` it is recommended to use `pure` in situations +-- | like this as it allows the choice of `Applicative` to be changed later +-- | without having to go through and replace `Right` with a new constructor. +instance applicativeEither :: Applicative (Either e) where + pure = Right + +-- | The `Alt` instance allows for a choice to be made between two `Either` +-- | values with the `<|>` operator, where the first `Right` encountered +-- | is taken. +-- | +-- | ``` purescript +-- | Right x <|> Right y == Right x +-- | Left x <|> Right y == Right y +-- | Left x <|> Left y == Left y +-- | ``` +instance altEither :: Alt (Either e) where + alt (Left _) r = r + alt l _ = l + +-- | The `Bind` instance allows sequencing of `Either` values and functions that +-- | return an `Either` by using the `>>=` operator: +-- | +-- | ``` purescript +-- | Left x >>= f = Left x +-- | Right x >>= f = f x +-- | ``` +-- | +-- | `Either`'s "do notation" can be understood to work like this: +-- | ``` purescript +-- | x :: forall e a. Either e a +-- | x = -- +-- | +-- | y :: forall e b. Either e b +-- | y = -- +-- | +-- | foo :: forall e a. (a -> b -> c) -> Either e c +-- | foo f = do +-- | x' <- x +-- | y' <- y +-- | pure (f x' y') +-- | ``` +-- | +-- | ...which is equivalent to... +-- | +-- | ``` purescript +-- | x >>= (\x' -> y >>= (\y' -> pure (f x' y'))) +-- | ``` +-- | +-- | ...and is the same as writing... +-- | +-- | ``` +-- | foo :: forall e a. (a -> b -> c) -> Either e c +-- | foo f = case x of +-- | Left e -> +-- | Left e +-- | Right x -> case y of +-- | Left e -> +-- | Left e +-- | Right y -> +-- | Right (f x y) +-- | ``` +instance bindEither :: Bind (Either e) where + bind = either (\e _ -> Left e) (\a f -> f a) + +-- | The `Monad` instance guarantees that there are both `Applicative` and +-- | `Bind` instances for `Either`. +instance monadEither :: Monad (Either e) + +-- | The `Extend` instance allows sequencing of `Either` values and functions +-- | that accept an `Either` and return a non-`Either` result using the +-- | `<<=` operator. +-- | +-- | ``` purescript +-- | f <<= Left x = Left x +-- | f <<= Right x = Right (f (Right x)) +-- | ``` +instance extendEither :: Extend (Either e) where + extend _ (Left y) = Left y + extend f x = Right (f x) + +-- | The `Show` instance allows `Either` values to be rendered as a string with +-- | `show` whenever there is an `Show` instance for both type the `Either` can +-- | contain. +instance showEither :: (Show a, Show b) => Show (Either a b) where + show (Left x) = "(Left " <> show x <> ")" + show (Right y) = "(Right " <> show y <> ")" + +-- | The `Eq` instance allows `Either` values to be checked for equality with +-- | `==` and inequality with `/=` whenever there is an `Eq` instance for both +-- | types the `Either` can contain. +derive instance eqEither :: (Eq a, Eq b) => Eq (Either a b) + +derive instance eq1Either :: Eq a => Eq1 (Either a) + +-- | The `Ord` instance allows `Either` values to be compared with +-- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for +-- | both types the `Either` can contain. +-- | +-- | Any `Left` value is considered to be less than a `Right` value. +derive instance ordEither :: (Ord a, Ord b) => Ord (Either a b) + +derive instance ord1Either :: Ord a => Ord1 (Either a) + +instance boundedEither :: (Bounded a, Bounded b) => Bounded (Either a b) where + top = Right top + bottom = Left bottom + +instance semigroupEither :: (Semigroup b) => Semigroup (Either a b) where + append x y = append <$> x <*> y + +-- | Takes two functions and an `Either` value, if the value is a `Left` the +-- | inner value is applied to the first function, if the value is a `Right` +-- | the inner value is applied to the second function. +-- | +-- | ``` purescript +-- | either f g (Left x) == f x +-- | either f g (Right y) == g y +-- | ``` either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c -either onLeft onRight value = case value of - Left left -> onLeft left - Right right -> onRight right +either f _ (Left a) = f a +either _ g (Right b) = g b -hush :: forall a b. Either a b -> Maybe b -hush value = case value of - Left _ -> Nothing - Right right -> Just right +-- | Combine two alternatives. +choose :: forall m a b. Alt m => m a -> m b -> m (Either a b) +choose a b = Left <$> a <|> Right <$> b + +-- | Returns `true` when the `Either` value was constructed with `Left`. +isLeft :: forall a b. Either a b -> Boolean +isLeft = either (const true) (const false) + +-- | Returns `true` when the `Either` value was constructed with `Right`. +isRight :: forall a b. Either a b -> Boolean +isRight = either (const false) (const true) + +-- | A function that extracts the value from the `Left` data constructor. +-- | The first argument is a default value, which will be returned in the +-- | case where a `Right` is passed to `fromLeft`. +fromLeft :: forall a b. a -> Either a b -> a +fromLeft _ (Left a) = a +fromLeft default _ = default +-- | Similar to `fromLeft` but for use in cases where the default value may be +-- | expensive to compute. As PureScript is not lazy, the standard `fromLeft` +-- | has to evaluate the default value before returning the result, +-- | whereas here the value is only computed when the `Either` is known +-- | to be `Right`. +fromLeft' :: forall a b. (Unit -> a) -> Either a b -> a +fromLeft' _ (Left a) = a +fromLeft' default _ = default unit + +-- | A function that extracts the value from the `Right` data constructor. +-- | The first argument is a default value, which will be returned in the +-- | case where a `Left` is passed to `fromRight`. +fromRight :: forall a b. b -> Either a b -> b +fromRight _ (Right b) = b +fromRight default _ = default + +-- | Similar to `fromRight` but for use in cases where the default value may be +-- | expensive to compute. As PureScript is not lazy, the standard `fromRight` +-- | has to evaluate the default value before returning the result, +-- | whereas here the value is only computed when the `Either` is known +-- | to be `Left`. +fromRight' :: forall a b. (Unit -> b) -> Either a b -> b +fromRight' _ (Right b) = b +fromRight' default _ = default unit + +-- | Takes a default and a `Maybe` value, if the value is a `Just`, turn it into +-- | a `Right`, if the value is a `Nothing` use the provided default as a `Left` +-- | +-- | ```purescript +-- | note "default" Nothing = Left "default" +-- | note "default" (Just 1) = Right 1 +-- | ``` note :: forall a b. a -> Maybe b -> Either a b -note fallback value = case value of - Nothing -> Left fallback - Just inner -> Right inner +note a = maybe (Left a) Right + +-- | Similar to `note`, but for use in cases where the default value may be +-- | expensive to compute. +-- | +-- | ```purescript +-- | note' (\_ -> "default") Nothing = Left "default" +-- | note' (\_ -> "default") (Just 1) = Right 1 +-- | ``` +note' :: forall a b. (Unit -> a) -> Maybe b -> Either a b +note' f = maybe' (Left <<< f) Right + +-- | Turns an `Either` into a `Maybe`, by throwing potential `Left` values away and converting +-- | them into `Nothing`. `Right` values get turned into `Just`s. +-- | +-- | ```purescript +-- | hush (Left "ParseError") = Nothing +-- | hush (Right 42) = Just 42 +-- | ``` +hush :: forall a b. Either a b -> Maybe b +hush = either (const Nothing) Just + +-- | Turns an `Either` into a `Maybe`, by throwing potential `Right` values away and converting +-- | them into `Nothing`. `Left` values get turned into `Just`s. +-- | +-- | ```purescript +-- | blush (Left "ParseError") = Just "Parse Error" +-- | blush (Right 42) = Nothing +-- | ``` +blush :: forall a b. Either a b -> Maybe a +blush = either Just (const Nothing) diff --git a/stdlib/lib/Data/Either/Inject.purs b/stdlib/lib/Data/Either/Inject.purs new file mode 100644 index 00000000..502d4649 --- /dev/null +++ b/stdlib/lib/Data/Either/Inject.purs @@ -0,0 +1,23 @@ +module Data.Either.Inject where + +import Prelude + +import Data.Either (Either(..), either) +import Data.Maybe (Maybe(..)) + +class Inject a b where + inj :: a -> b + prj :: b -> Maybe a + +instance injectReflexive :: Inject a a where + inj = identity + prj = Just + +else instance injectLeft :: Inject a (Either a b) where + inj = Left + prj = either Just (const Nothing) + +else instance injectRight :: Inject a b => Inject a (Either c b) where + inj = Right <<< inj + prj = either (const Nothing) prj + diff --git a/stdlib/lib/Data/Either/Nested.purs b/stdlib/lib/Data/Either/Nested.purs new file mode 100644 index 00000000..f4ee9318 --- /dev/null +++ b/stdlib/lib/Data/Either/Nested.purs @@ -0,0 +1,278 @@ +-- | Utilities for n-eithers: sums types with more than two terms built from nested eithers. +-- | +-- | Nested eithers arise naturally in sum combinators. You shouldn't +-- | represent sum data using nested eithers, but if combinators you're working with +-- | create them, utilities in this module will allow to to more easily work +-- | with them, including translating to and from more traditional sum types. +-- | +-- | ```purescript +-- | data Color = Red Number | Green Number | Blue Number +-- | +-- | fromEither3 :: Either3 Number Number Number -> Color +-- | fromEither3 = either3 Red Green Blue +-- | +-- | toEither3 :: Color -> Either3 Number Number Number +-- | toEither3 (Red v) = in1 v +-- | toEither3 (Green v) = in2 v +-- | toEither3 (Blue v) = in3 v +-- | ``` +module Data.Either.Nested + ( type (\/), (\/) + , in1, in2, in3, in4, in5, in6, in7, in8, in9, in10 + , at1, at2, at3, at4, at5, at6, at7, at8, at9, at10 + , Either1, Either2, Either3, Either4, Either5, Either6, Either7, Either8, Either9, Either10 + , either1, either2, either3, either4, either5, either6, either7, either8, either9, either10 + ) where + +import Data.Either (Either(..), either) +import Data.Void (Void, absurd) + +infixr 6 type Either as \/ + +-- | The `\/` operator alias for the `either` function allows easy matching on nested Eithers. For example, consider the function +-- | +-- | ```purescript +-- | f :: (Int \/ String \/ Boolean) -> String +-- | f (Left x) = show x +-- | f (Right (Left y)) = y +-- | f (Right (Right z)) = if z then "Yes" else "No" +-- | ``` +-- | +-- | The `\/` operator alias allows us to rewrite this function as +-- | +-- | ```purescript +-- | f :: (Int \/ String \/ Boolean) -> String +-- | f = show \/ identity \/ if _ then "Yes" else "No" +-- | ``` +infixr 6 either as \/ + +type Either1 a = a \/ Void +type Either2 a b = a \/ b \/ Void +type Either3 a b c = a \/ b \/ c \/ Void +type Either4 a b c d = a \/ b \/ c \/ d \/ Void +type Either5 a b c d e = a \/ b \/ c \/ d \/ e \/ Void +type Either6 a b c d e f = a \/ b \/ c \/ d \/ e \/ f \/ Void +type Either7 a b c d e f g = a \/ b \/ c \/ d \/ e \/ f \/ g \/ Void +type Either8 a b c d e f g h = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ Void +type Either9 a b c d e f g h i = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ Void +type Either10 a b c d e f g h i j = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ Void + +in1 :: forall a z. a -> a \/ z +in1 = Left + +in2 :: forall a b z. b -> a \/ b \/ z +in2 v = Right (Left v) + +in3 :: forall a b c z. c -> a \/ b \/ c \/ z +in3 v = Right (Right (Left v)) + +in4 :: forall a b c d z. d -> a \/ b \/ c \/ d \/ z +in4 v = Right (Right (Right (Left v))) + +in5 :: forall a b c d e z. e -> a \/ b \/ c \/ d \/ e \/ z +in5 v = Right (Right (Right (Right (Left v)))) + +in6 :: forall a b c d e f z. f -> a \/ b \/ c \/ d \/ e \/ f \/ z +in6 v = Right (Right (Right (Right (Right (Left v))))) + +in7 :: forall a b c d e f g z. g -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ z +in7 v = Right (Right (Right (Right (Right (Right (Left v)))))) + +in8 :: forall a b c d e f g h z. h -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ z +in8 v = Right (Right (Right (Right (Right (Right (Right (Left v))))))) + +in9 :: forall a b c d e f g h i z. i -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ z +in9 v = Right (Right (Right (Right (Right (Right (Right (Right (Left v)))))))) + +in10 :: forall a b c d e f g h i j z. j -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ z +in10 v = Right (Right (Right (Right (Right (Right (Right (Right (Right (Left v))))))))) + +at1 :: forall r a z. r -> (a -> r) -> a \/ z -> r +at1 b f y = case y of + Left r -> f r + _ -> b + +at2 :: forall r a b z. r -> (b -> r) -> a \/ b \/ z -> r +at2 b f y = case y of + Right (Left r) -> f r + _ -> b + +at3 :: forall r a b c z. r -> (c -> r) -> a \/ b \/ c \/ z -> r +at3 b f y = case y of + Right (Right (Left r)) -> f r + _ -> b + +at4 :: forall r a b c d z. r -> (d -> r) -> a \/ b \/ c \/ d \/ z -> r +at4 b f y = case y of + Right (Right (Right (Left r))) -> f r + _ -> b + +at5 :: forall r a b c d e z. r -> (e -> r) -> a \/ b \/ c \/ d \/ e \/ z -> r +at5 b f y = case y of + Right (Right (Right (Right (Left r)))) -> f r + _ -> b + +at6 :: forall r a b c d e f z. r -> (f -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ z -> r +at6 b f y = case y of + Right (Right (Right (Right (Right (Left r))))) -> f r + _ -> b + +at7 :: forall r a b c d e f g z. r -> (g -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ z -> r +at7 b f y = case y of + Right (Right (Right (Right (Right (Right (Left r)))))) -> f r + _ -> b + +at8 :: forall r a b c d e f g h z. r -> (h -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ z -> r +at8 b f y = case y of + Right (Right (Right (Right (Right (Right (Right (Left r))))))) -> f r + _ -> b + +at9 :: forall r a b c d e f g h i z. r -> (i -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ z -> r +at9 b f y = case y of + Right (Right (Right (Right (Right (Right (Right (Right (Left r)))))))) -> f r + _ -> b + +at10 :: forall r a b c d e f g h i j z. r -> (j -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ z -> r +at10 b f y = case y of + Right (Right (Right (Right (Right (Right (Right (Right (Right (Left r))))))))) -> f r + _ -> b + +either1 :: forall a. Either1 a -> a +either1 y = case y of + Left r -> r + Right _1 -> absurd _1 + +either2 :: forall r a b. (a -> r) -> (b -> r) -> Either2 a b -> r +either2 a b y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> absurd _2 + +either3 :: forall r a b c. (a -> r) -> (b -> r) -> (c -> r) -> Either3 a b c -> r +either3 a b c y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> absurd _3 + +either4 :: forall r a b c d. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> Either4 a b c d -> r +either4 a b c d y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> absurd _4 + +either5 :: forall r a b c d e. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> Either5 a b c d e -> r +either5 a b c d e y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> case _4 of + Left r -> e r + Right _5 -> absurd _5 + +either6 :: forall r a b c d e f. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> Either6 a b c d e f -> r +either6 a b c d e f y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> case _4 of + Left r -> e r + Right _5 -> case _5 of + Left r -> f r + Right _6 -> absurd _6 + +either7 :: forall r a b c d e f g. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> Either7 a b c d e f g -> r +either7 a b c d e f g y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> case _4 of + Left r -> e r + Right _5 -> case _5 of + Left r -> f r + Right _6 -> case _6 of + Left r -> g r + Right _7 -> absurd _7 + +either8 :: forall r a b c d e f g h. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> (h -> r) -> Either8 a b c d e f g h -> r +either8 a b c d e f g h y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> case _4 of + Left r -> e r + Right _5 -> case _5 of + Left r -> f r + Right _6 -> case _6 of + Left r -> g r + Right _7 -> case _7 of + Left r -> h r + Right _8 -> absurd _8 + +either9 :: forall r a b c d e f g h i. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> (h -> r) -> (i -> r) -> Either9 a b c d e f g h i -> r +either9 a b c d e f g h i y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> case _4 of + Left r -> e r + Right _5 -> case _5 of + Left r -> f r + Right _6 -> case _6 of + Left r -> g r + Right _7 -> case _7 of + Left r -> h r + Right _8 -> case _8 of + Left r -> i r + Right _9 -> absurd _9 + +either10 :: forall r a b c d e f g h i j. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> (h -> r) -> (i -> r) -> (j -> r) -> Either10 a b c d e f g h i j -> r +either10 a b c d e f g h i j y = case y of + Left r -> a r + Right _1 -> case _1 of + Left r -> b r + Right _2 -> case _2 of + Left r -> c r + Right _3 -> case _3 of + Left r -> d r + Right _4 -> case _4 of + Left r -> e r + Right _5 -> case _5 of + Left r -> f r + Right _6 -> case _6 of + Left r -> g r + Right _7 -> case _7 of + Left r -> h r + Right _8 -> case _8 of + Left r -> i r + Right _9 -> case _9 of + Left r -> j r + Right _10 -> absurd _10 diff --git a/stdlib/lib/Data/Enum.purs b/stdlib/lib/Data/Enum.purs new file mode 100644 index 00000000..a188fbca --- /dev/null +++ b/stdlib/lib/Data/Enum.purs @@ -0,0 +1,323 @@ +module Data.Enum + ( class Enum, succ, pred + , class BoundedEnum, cardinality, toEnum, fromEnum + , toEnumWithDefaults + , Cardinality(..) + , enumFromTo + , enumFromThenTo + , upFrom + , upFromIncluding + , downFrom + , downFromIncluding + , defaultSucc + , defaultPred + , defaultCardinality + , defaultToEnum + , defaultFromEnum + ) where + +import Prelude + +import Control.MonadPlus (guard) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..), maybe, fromJust) +import Data.Newtype (class Newtype) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, singleton, unfoldr) +import Data.Unfoldable1 (class Unfoldable1, unfoldr1) +import Partial.Unsafe (unsafePartial) + +-- | Type class for enumerations. +-- | +-- | Laws: +-- | - Successor: `all (a < _) (succ a)` +-- | - Predecessor: `all (_ < a) (pred a)` +-- | - Succ retracts pred: `pred >=> succ >=> pred = pred` +-- | - Pred retracts succ: `succ >=> pred >=> succ = succ` +-- | - Non-skipping succ: `b <= a || any (_ <= b) (succ a)` +-- | - Non-skipping pred: `a <= b || any (b <= _) (pred a)` +-- | +-- | The retraction laws can intuitively be understood as saying that `succ` is +-- | the opposite of `pred`; if you apply `succ` and then `pred` to something, +-- | you should end up with what you started with (although of course this +-- | doesn't apply if you tried to `succ` the last value in an enumeration and +-- | therefore got `Nothing` out). +-- | +-- | The non-skipping laws can intuitively be understood as saying that `succ` +-- | shouldn't skip over any elements of your type. For example, _without_ the +-- | non-skipping laws, it would be permissible to write an `Enum Int` instance +-- | where `succ x = Just (x+2)`, and similarly `pred x = Just (x-2)`. +class Ord a <= Enum a where + succ :: a -> Maybe a + pred :: a -> Maybe a + +instance enumBoolean :: Enum Boolean where + succ false = Just true + succ _ = Nothing + pred true = Just false + pred _= Nothing + +instance enumInt :: Enum Int where + succ n = if n < top then Just (n + 1) else Nothing + pred n = if n > bottom then Just (n - 1) else Nothing + +instance enumChar :: Enum Char where + succ = defaultSucc charToEnum toCharCode + pred = defaultPred charToEnum toCharCode + +instance enumUnit :: Enum Unit where + succ = const Nothing + pred = const Nothing + +instance enumOrdering :: Enum Ordering where + succ LT = Just EQ + succ EQ = Just GT + succ GT = Nothing + pred LT = Nothing + pred EQ = Just LT + pred GT = Just EQ + +instance enumMaybe :: BoundedEnum a => Enum (Maybe a) where + succ Nothing = Just (Just bottom) + succ (Just a) = Just <$> succ a + pred Nothing = Nothing + pred (Just a) = Just (pred a) + +instance enumEither :: (BoundedEnum a, BoundedEnum b) => Enum (Either a b) where + succ (Left a) = maybe (Just (Right bottom)) (Just <<< Left) (succ a) + succ (Right b) = maybe Nothing (Just <<< Right) (succ b) + pred (Left a) = maybe Nothing (Just <<< Left) (pred a) + pred (Right b) = maybe (Just (Left top)) (Just <<< Right) (pred b) + +instance enumTuple :: (Enum a, BoundedEnum b) => Enum (Tuple a b) where + succ (Tuple a b) = maybe (flip Tuple bottom <$> succ a) (Just <<< Tuple a) (succ b) + pred (Tuple a b) = maybe (flip Tuple top <$> pred a) (Just <<< Tuple a) (pred b) + +-- | Type class for finite enumerations. +-- | +-- | This should not be considered a part of a numeric hierarchy, as in Haskell. +-- | Rather, this is a type class for small, ordered sum types with +-- | statically-determined cardinality and the ability to easily compute +-- | successor and predecessor elements like `DayOfWeek`. +-- | +-- | Laws: +-- | +-- | - ```succ bottom >>= succ >>= succ ... succ [cardinality - 1 times] == top``` +-- | - ```pred top >>= pred >>= pred ... pred [cardinality - 1 times] == bottom``` +-- | - ```forall a > bottom: pred a >>= succ == Just a``` +-- | - ```forall a < top: succ a >>= pred == Just a``` +-- | - ```forall a > bottom: fromEnum <$> pred a = pred (fromEnum a)``` +-- | - ```forall a < top: fromEnum <$> succ a = succ (fromEnum a)``` +-- | - ```e1 `compare` e2 == fromEnum e1 `compare` fromEnum e2``` +-- | - ```toEnum (fromEnum a) = Just a``` +class (Bounded a, Enum a) <= BoundedEnum a where + cardinality :: Cardinality a + toEnum :: Int -> Maybe a + fromEnum :: a -> Int + +instance boundedEnumBoolean :: BoundedEnum Boolean where + cardinality = Cardinality 2 + toEnum 0 = Just false + toEnum 1 = Just true + toEnum _ = Nothing + fromEnum false = 0 + fromEnum true = 1 + +instance boundedEnumChar :: BoundedEnum Char where + cardinality = Cardinality (toCharCode top - toCharCode bottom) + toEnum = charToEnum + fromEnum = toCharCode + +instance boundedEnumUnit :: BoundedEnum Unit where + cardinality = Cardinality 1 + toEnum 0 = Just unit + toEnum _ = Nothing + fromEnum = const 0 + +instance boundedEnumOrdering :: BoundedEnum Ordering where + cardinality = Cardinality 3 + toEnum 0 = Just LT + toEnum 1 = Just EQ + toEnum 2 = Just GT + toEnum _ = Nothing + fromEnum LT = 0 + fromEnum EQ = 1 + fromEnum GT = 2 + +-- | Like `toEnum` but returns the first argument if `x` is less than +-- | `fromEnum bottom` and the second argument if `x` is greater than +-- | `fromEnum top`. +-- | +-- | ``` purescript +-- | toEnumWithDefaults False True (-1) -- False +-- | toEnumWithDefaults False True 0 -- False +-- | toEnumWithDefaults False True 1 -- True +-- | toEnumWithDefaults False True 2 -- True +-- | ``` +toEnumWithDefaults :: forall a. BoundedEnum a => a -> a -> Int -> a +toEnumWithDefaults low high x = case toEnum x of + Just enum -> enum + Nothing -> if x < fromEnum (bottom :: a) then low else high + +-- | A type for the size of finite enumerations. +newtype Cardinality :: forall k. k -> Type +newtype Cardinality a = Cardinality Int + +type role Cardinality representational + +derive instance newtypeCardinality :: Newtype (Cardinality a) _ +derive newtype instance eqCardinality :: Eq (Cardinality a) +derive newtype instance ordCardinality :: Ord (Cardinality a) + +instance showCardinality :: Show (Cardinality a) where + show (Cardinality n) = "(Cardinality " <> show n <> ")" + +-- | Returns a contiguous sequence of elements from the first value to the +-- | second value (inclusive). +-- | +-- | ``` purescript +-- | enumFromTo 0 3 = [0, 1, 2, 3] +-- | enumFromTo 'c' 'a' = ['c', 'b', 'a'] +-- | ``` +-- | +-- | The example shows `Array` return values, but the result can be any type +-- | with an `Unfoldable1` instance. +enumFromTo :: forall a u. Enum a => Unfoldable1 u => a -> a -> u a +enumFromTo = case _, _ of + from, to + | from == to -> singleton from + | from < to -> unfoldr1 (go succ (<=) to) from + | otherwise -> unfoldr1 (go pred (>=) to) from + where + go step op to a = Tuple a (step a >>= \a' -> guard (a' `op` to) $> a') + +-- | Returns a sequence of elements from the first value, taking steps +-- | according to the difference between the first and second value, up to +-- | (but not exceeding) the third value. +-- | +-- | ``` purescript +-- | enumFromThenTo 0 2 6 = [0, 2, 4, 6] +-- | enumFromThenTo 0 3 5 = [0, 3] +-- | ``` +-- | +-- | Note that there is no `BoundedEnum` instance for integers, they're just +-- | being used here for illustrative purposes to help clarify the behaviour. +-- | +-- | The example shows `Array` return values, but the result can be any type +-- | with an `Unfoldable1` instance. +enumFromThenTo :: forall f a. Unfoldable f => Functor f => BoundedEnum a => a -> a -> a -> f a +enumFromThenTo = unsafePartial \a b c -> + let + a' = fromEnum a + b' = fromEnum b + c' = fromEnum c + in + (toEnum >>> fromJust) <$> unfoldr (go (b' - a') c') a' + where + go step to e + | e <= to = Just (Tuple e (e + step)) + | otherwise = Nothing + +-- | Produces all successors of an `Enum` value, excluding the start value. +upFrom :: forall a u. Enum a => Unfoldable u => a -> u a +upFrom = unfoldr (map diag <<< succ) + +-- | Produces all successors of an `Enum` value, including the start value. +-- | +-- | `upFromIncluding bottom` will return all values in an `Enum`. +upFromIncluding :: ∀ a u. Enum a => Unfoldable1 u => a -> u a +upFromIncluding = unfoldr1 (Tuple <*> succ) + +-- | Produces all predecessors of an `Enum` value, excluding the start value. +downFrom :: forall a u. Enum a => Unfoldable u => a -> u a +downFrom = unfoldr (map diag <<< pred) + +-- | Produces all predecessors of an `Enum` value, including the start value. +-- | +-- | `downFromIncluding top` will return all values in an `Enum`, in reverse +-- | order. +downFromIncluding :: forall a u. Enum a => Unfoldable1 u => a -> u a +downFromIncluding = unfoldr1 (Tuple <*> pred) + +-- | Provides a default implementation for `succ`, given a function that maps +-- | integers to values in the `Enum`, and a function that maps values in the +-- | `Enum` back to integers. The integer mapping must agree in both directions +-- | for this to implement a law-abiding `succ`. +-- | +-- | If a `BoundedEnum` instance exists for `a`, the `toEnum` and `fromEnum` +-- | functions can be used here: +-- | +-- | ``` purescript +-- | succ = defaultSucc toEnum fromEnum +-- | ``` +defaultSucc :: forall a. (Int -> Maybe a) -> (a -> Int) -> a -> Maybe a +defaultSucc toEnum' fromEnum' a = toEnum' (fromEnum' a + 1) + +-- | Provides a default implementation for `pred`, given a function that maps +-- | integers to values in the `Enum`, and a function that maps values in the +-- | `Enum` back to integers. The integer mapping must agree in both directions +-- | for this to implement a law-abiding `pred`. +-- | +-- | If a `BoundedEnum` instance exists for `a`, the `toEnum` and `fromEnum` +-- | functions can be used here: +-- | +-- | ``` purescript +-- | pred = defaultPred toEnum fromEnum +-- | ``` +defaultPred :: forall a. (Int -> Maybe a) -> (a -> Int) -> a -> Maybe a +defaultPred toEnum' fromEnum' a = toEnum' (fromEnum' a - 1) + +-- | Provides a default implementation for `cardinality`. +-- | +-- | Runs in `O(n)` where `n` is `fromEnum top` +defaultCardinality :: forall a. Bounded a => Enum a => Cardinality a +defaultCardinality = Cardinality $ go 1 (bottom :: a) where + go i x = + case succ x of + Just x' -> go (i + 1) x' + Nothing -> i + +-- | Provides a default implementation for `toEnum`. +-- | +-- | - Assumes `fromEnum bottom = 0`. +-- | - Cannot be used in conjuction with `defaultSucc`. +-- | +-- | Runs in `O(n)` where `n` is `fromEnum a`. +defaultToEnum :: forall a. Bounded a => Enum a => Int -> Maybe a +defaultToEnum i' = + if i' < 0 + then Nothing + else go i' bottom + where + go i x = + if i == 0 + then Just x + -- We avoid using >>= here because it foils tail-call optimization + else case succ x of + Just x' -> go (i - 1) x' + Nothing -> Nothing + +-- | Provides a default implementation for `fromEnum`. +-- | +-- | - Assumes `toEnum 0 = Just bottom`. +-- | - Cannot be used in conjuction with `defaultPred`. +-- | +-- | Runs in `O(n)` where `n` is `fromEnum a`. +defaultFromEnum :: forall a. Enum a => a -> Int +defaultFromEnum = go 0 where + go i x = + case pred x of + Just x' -> go (i + 1) x' + Nothing -> i + +diag :: forall a. a -> Tuple a a +diag a = Tuple a a + +charToEnum :: Int -> Maybe Char +charToEnum n | n >= toCharCode bottom && n <= toCharCode top = Just (fromCharCode n) +charToEnum _ = Nothing + +toCharCode :: Char -> Int +toCharCode a0 = toCharCode a0 +fromCharCode :: Int -> Char +fromCharCode a0 = fromCharCode a0 diff --git a/stdlib/lib/Data/Enum/Gen.purs b/stdlib/lib/Data/Enum/Gen.purs new file mode 100644 index 00000000..86caebd1 --- /dev/null +++ b/stdlib/lib/Data/Enum/Gen.purs @@ -0,0 +1,18 @@ +module Data.Enum.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, elements) +import Data.Enum (class BoundedEnum, succ, enumFromTo) +import Data.Maybe (Maybe(..)) +import Data.NonEmpty ((:|)) + +-- | Create a random generator for a finite enumeration. +genBoundedEnum :: forall m a. MonadGen m => BoundedEnum a => m a +genBoundedEnum = + case succ bottom of + Just a → + let possibilities = enumFromTo a top :: Array a + in elements (bottom :| possibilities) + Nothing → + pure bottom diff --git a/stdlib/lib/Data/Enum/Generic.purs b/stdlib/lib/Data/Enum/Generic.purs new file mode 100644 index 00000000..0d59cca7 --- /dev/null +++ b/stdlib/lib/Data/Enum/Generic.purs @@ -0,0 +1,118 @@ +module Data.Enum.Generic where + +import Prelude + +import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum) +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to) +import Data.Bounded.Generic (class GenericBottom, class GenericTop, genericBottom', genericTop') +import Data.Maybe (Maybe(..)) +import Data.Newtype (unwrap) + +class GenericEnum a where + genericPred' :: a -> Maybe a + genericSucc' :: a -> Maybe a + +instance genericEnumNoArguments :: GenericEnum NoArguments where + genericPred' _ = Nothing + genericSucc' _ = Nothing + +instance genericEnumArgument :: Enum a => GenericEnum (Argument a) where + genericPred' (Argument a) = Argument <$> pred a + genericSucc' (Argument a) = Argument <$> succ a + +instance genericEnumConstructor :: GenericEnum a => GenericEnum (Constructor name a) where + genericPred' (Constructor a) = Constructor <$> genericPred' a + genericSucc' (Constructor a) = Constructor <$> genericSucc' a + +instance genericEnumSum :: (GenericEnum a, GenericTop a, GenericEnum b, GenericBottom b) => GenericEnum (Sum a b) where + genericPred' = case _ of + Inl a -> Inl <$> genericPred' a + Inr b -> case genericPred' b of + Nothing -> Just (Inl genericTop') + Just b' -> Just (Inr b') + genericSucc' = case _ of + Inl a -> case genericSucc' a of + Nothing -> Just (Inr genericBottom') + Just a' -> Just (Inl a') + Inr b -> Inr <$> genericSucc' b + +instance genericEnumProduct :: (GenericEnum a, GenericTop a, GenericBottom a, GenericEnum b, GenericTop b, GenericBottom b) => GenericEnum (Product a b) where + genericPred' (Product a b) = case genericPred' b of + Just p -> Just $ Product a p + Nothing -> flip Product genericTop' <$> genericPred' a + genericSucc' (Product a b) = case genericSucc' b of + Just s -> Just $ Product a s + Nothing -> flip Product genericBottom' <$> genericSucc' a + + +-- | A `Generic` implementation of the `pred` member from the `Enum` type class. +genericPred :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a +genericPred = map to <<< genericPred' <<< from + +-- | A `Generic` implementation of the `succ` member from the `Enum` type class. +genericSucc :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a +genericSucc = map to <<< genericSucc' <<< from + +class GenericBoundedEnum a where + genericCardinality' :: Cardinality a + genericToEnum' :: Int -> Maybe a + genericFromEnum' :: a -> Int + +instance genericBoundedEnumNoArguments :: GenericBoundedEnum NoArguments where + genericCardinality' = Cardinality 1 + genericToEnum' i = if i == 0 then Just NoArguments else Nothing + genericFromEnum' _ = 0 + +instance genericBoundedEnumArgument :: BoundedEnum a => GenericBoundedEnum (Argument a) where + genericCardinality' = Cardinality (unwrap (cardinality :: Cardinality a)) + genericToEnum' i = Argument <$> toEnum i + genericFromEnum' (Argument a) = fromEnum a + +instance genericBoundedEnumConstructor :: GenericBoundedEnum a => GenericBoundedEnum (Constructor name a) where + genericCardinality' = Cardinality (unwrap (genericCardinality' :: Cardinality a)) + genericToEnum' i = Constructor <$> genericToEnum' i + genericFromEnum' (Constructor a) = genericFromEnum' a + +instance genericBoundedEnumSum :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Sum a b) where + genericCardinality' = + Cardinality + $ unwrap (genericCardinality' :: Cardinality a) + + unwrap (genericCardinality' :: Cardinality b) + genericToEnum' n = to genericCardinality' + where + to :: Cardinality a -> Maybe (Sum a b) + to (Cardinality ca) + | n >= 0 && n < ca = Inl <$> genericToEnum' n + | otherwise = Inr <$> genericToEnum' (n - ca) + genericFromEnum' = case _ of + Inl a -> genericFromEnum' a + Inr b -> genericFromEnum' b + unwrap (genericCardinality' :: Cardinality a) + + +instance genericBoundedEnumProduct :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Product a b) where + genericCardinality' = + Cardinality + $ unwrap (genericCardinality' :: Cardinality a) + * unwrap (genericCardinality' :: Cardinality b) + genericToEnum' n = to genericCardinality' + where to :: Cardinality b -> Maybe (Product a b) + to (Cardinality cb) = Product <$> (genericToEnum' $ n `div` cb) <*> (genericToEnum' $ n `mod` cb) + genericFromEnum' = from genericCardinality' + where from :: Cardinality b -> (Product a b) -> Int + from (Cardinality cb) (Product a b) = genericFromEnum' a * cb + genericFromEnum' b + + +-- | A `Generic` implementation of the `cardinality` member from the +-- | `BoundedEnum` type class. +genericCardinality :: forall a rep. Generic a rep => GenericBoundedEnum rep => Cardinality a +genericCardinality = Cardinality (unwrap (genericCardinality' :: Cardinality rep)) + +-- | A `Generic` implementation of the `toEnum` member from the `BoundedEnum` +-- | type class. +genericToEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => Int -> Maybe a +genericToEnum = map to <<< genericToEnum' + +-- | A `Generic` implementation of the `fromEnum` member from the `BoundedEnum` +-- | type class. +genericFromEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => a -> Int +genericFromEnum = genericFromEnum' <<< from diff --git a/stdlib/lib/Data/Eq.purs b/stdlib/lib/Data/Eq.purs index 97fce2e6..bf38459a 100644 --- a/stdlib/lib/Data/Eq.purs +++ b/stdlib/lib/Data/Eq.purs @@ -1,41 +1,134 @@ --- | The `Eq` class and its `==` / `/=` operators. --- | --- | The `Int`, `Number`, `Boolean`, and `Char` instances are the compiler's --- | internal equality intrinsics; `Unit` has one value, so it is equal to --- | itself. The surface operators are library declarations over the internal --- | primitives, so the primitive names stay out of the source namespace. module Data.Eq ( class Eq , eq - , notEq , (==) + , notEq , (/=) + , class Eq1 + , eq1 + , notEq1 + , class EqRecord + , eqRecord ) where --- | A type whose values can be compared for equality. +import Data.HeytingAlgebra ((&&)) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit) +import Data.Void (Void) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeGet) +import Type.Proxy (Proxy(..)) + +-- | The `Eq` type class represents types which support decidable equality. +-- | +-- | `Eq` instances should satisfy the following laws: +-- | +-- | - Reflexivity: `x == x = true` +-- | - Symmetry: `x == y = y == x` +-- | - Transitivity: if `x == y` and `y == z` then `x == z` +-- | +-- | **Note:** The `Number` type is not an entirely law abiding member of this +-- | class due to the presence of `NaN`, since `NaN /= NaN`. Additionally, +-- | computing with `Number` can result in a loss of precision, so sometimes +-- | values that should be equivalent are not. class Eq a where eq :: a -> a -> Boolean - notEq :: a -> a -> Boolean infix 4 eq as == + +-- | `notEq` tests whether one value is _not equal_ to another. Shorthand for +-- | `not (eq x y)`. +notEq :: forall a. Eq a => a -> a -> Boolean +notEq x y = (x == y) == false + infix 4 notEq as /= +instance eqBoolean :: Eq Boolean where + eq x y = eqBooleanImpl x y + instance eqInt :: Eq Int where - eq x y = intEq x y - notEq x y = intNe x y + eq x y = eqIntImpl x y instance eqNumber :: Eq Number where - eq x y = numberEq x y - notEq x y = numberNe x y - -instance eqBoolean :: Eq Boolean where - eq x y = booleanEq x y - notEq x y = booleanNe x y + eq x y = eqNumberImpl x y instance eqChar :: Eq Char where - eq x y = charEq x y - notEq x y = charNe x y + eq x y = eqCharImpl x y + +instance eqString :: Eq String where + eq x y = eqStringImpl x y instance eqUnit :: Eq Unit where eq _ _ = true - notEq _ _ = false + +instance eqVoid :: Eq Void where + eq _ _ = true + +instance eqArray :: Eq a => Eq (Array a) where + eq xs ys = eqArrayImpl eq xs ys + +instance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) where + eq = eqRecord (Proxy :: Proxy list) + +instance eqProxy :: Eq (Proxy a) where + eq _ _ = true + +eqBooleanImpl :: Boolean -> Boolean -> Boolean +eqBooleanImpl a0 a1 = booleanEq a0 a1 +eqIntImpl :: Int -> Int -> Boolean +eqIntImpl a0 a1 = intEq a0 a1 +eqNumberImpl :: Number -> Number -> Boolean +eqNumberImpl a0 a1 = numberEq a0 a1 +eqCharImpl :: Char -> Char -> Boolean +eqCharImpl a0 a1 = charEq a0 a1 +eqStringImpl :: String -> String -> Boolean +eqStringImpl a0 a1 = eqBytes (stringToBytes a0) (stringToBytes a1) 0 + +eqBytes :: Array Int -> Array Int -> Int -> Boolean +eqBytes xs ys index = + if intGe index (arrayLength xs) then intEq (arrayLength xs) (arrayLength ys) + else if intGe index (arrayLength ys) then false + else if intEq (arrayIndex xs index) (arrayIndex ys index) then eqBytes xs ys (intAdd index 1) + else false + +eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean +eqArrayImpl a0 a1 a2 = eqArrayFrom a0 a1 a2 0 + +eqArrayFrom :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Int -> Boolean +eqArrayFrom eq xs ys index = + if intGe index (arrayLength xs) then intEq (arrayLength xs) (arrayLength ys) + else if eq (arrayIndex xs index) (arrayIndex ys index) then eqArrayFrom eq xs ys (intAdd index 1) + else false + +-- | The `Eq1` type class represents type constructors with decidable equality. +class Eq1 f where + eq1 :: forall a. Eq a => f a -> f a -> Boolean + +instance eq1Array :: Eq1 Array where + eq1 = eq + +notEq1 :: forall f a. Eq1 f => Eq a => f a -> f a -> Boolean +notEq1 x y = (x `eq1` y) == false + +-- | A class for records where all fields have `Eq` instances, used to implement +-- | the `Eq` instance for records. +class EqRecord :: RL.RowList Type -> Row Type -> Constraint +class EqRecord rowlist row where + eqRecord :: Proxy rowlist -> Record row -> Record row -> Boolean + +instance eqRowNil :: EqRecord RL.Nil row where + eqRecord _ _ _ = true + +instance eqRowCons :: + ( EqRecord rowlistTail row + , Row.Cons key focus rowTail row + , IsSymbol key + , Eq focus + ) => + EqRecord (RL.Cons key focus rowlistTail) row where + eqRecord _ ra rb = (get ra == get rb) && tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + tail = eqRecord (Proxy :: Proxy rowlistTail) ra rb diff --git a/stdlib/lib/Data/Eq/Generic.purs b/stdlib/lib/Data/Eq/Generic.purs new file mode 100644 index 00000000..1c9e1386 --- /dev/null +++ b/stdlib/lib/Data/Eq/Generic.purs @@ -0,0 +1,35 @@ +module Data.Eq.Generic + ( class GenericEq + , genericEq' + , genericEq + ) where + +import Prelude (class Eq, (==), (&&)) +import Data.Generic.Rep + +class GenericEq a where + genericEq' :: a -> a -> Boolean + +instance genericEqNoConstructors :: GenericEq NoConstructors where + genericEq' _ _ = true + +instance genericEqNoArguments :: GenericEq NoArguments where + genericEq' _ _ = true + +instance genericEqSum :: (GenericEq a, GenericEq b) => GenericEq (Sum a b) where + genericEq' (Inl a1) (Inl a2) = genericEq' a1 a2 + genericEq' (Inr b1) (Inr b2) = genericEq' b1 b2 + genericEq' _ _ = false + +instance genericEqProduct :: (GenericEq a, GenericEq b) => GenericEq (Product a b) where + genericEq' (Product a1 b1) (Product a2 b2) = genericEq' a1 a2 && genericEq' b1 b2 + +instance genericEqConstructor :: GenericEq a => GenericEq (Constructor name a) where + genericEq' (Constructor a1) (Constructor a2) = genericEq' a1 a2 + +instance genericEqArgument :: Eq a => GenericEq (Argument a) where + genericEq' (Argument a1) (Argument a2) = a1 == a2 + +-- | A `Generic` implementation of the `eq` member from the `Eq` type class. +genericEq :: forall a rep. Generic a rep => GenericEq rep => a -> a -> Boolean +genericEq x y = genericEq' (from x) (from y) diff --git a/stdlib/lib/Data/Equivalence.purs b/stdlib/lib/Data/Equivalence.purs new file mode 100644 index 00000000..bbd062ed --- /dev/null +++ b/stdlib/lib/Data/Equivalence.purs @@ -0,0 +1,31 @@ +module Data.Equivalence where + +import Prelude + +import Data.Comparison (Comparison(..)) +import Data.Function (on) +import Data.Functor.Contravariant (class Contravariant) +import Data.Newtype (class Newtype) + +-- | An adaptor allowing `>$<` to map over the inputs of an equivalence +-- | relation. +newtype Equivalence a = Equivalence (a -> a -> Boolean) + +derive instance newtypeEquivalence :: Newtype (Equivalence a) _ + +instance contravariantEquivalence :: Contravariant Equivalence where + cmap f (Equivalence g) = Equivalence (g `on` f) + +instance semigroupEquivalence :: Semigroup (Equivalence a) where + append (Equivalence p) (Equivalence q) = Equivalence (\a b -> p a b && q a b) + +instance monoidEquivalence :: Monoid (Equivalence a) where + mempty = Equivalence (\_ _ -> true) + +-- | The default equivalence relation for any values with an `Eq` instance. +defaultEquivalence :: forall a. Eq a => Equivalence a +defaultEquivalence = Equivalence eq + +-- | An equivalence relation for any `Comparison`. +comparisonEquivalence :: forall a. Comparison a -> Equivalence a +comparisonEquivalence (Comparison p) = Equivalence (\a b -> p a b == EQ) diff --git a/stdlib/lib/Data/EuclideanRing.purs b/stdlib/lib/Data/EuclideanRing.purs new file mode 100644 index 00000000..9c94986d --- /dev/null +++ b/stdlib/lib/Data/EuclideanRing.purs @@ -0,0 +1,105 @@ +module Data.EuclideanRing + ( class EuclideanRing + , degree + , div + , mod + , (/) + , gcd + , lcm + , module Data.CommutativeRing + , module Data.Ring + , module Data.Semiring + ) where + +import Data.BooleanAlgebra ((||)) +import Data.CommutativeRing (class CommutativeRing) +import Data.Eq (class Eq, (==)) +import Data.Ring (class Ring, sub, (-)) +import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) + +-- | The `EuclideanRing` class is for commutative rings that support division. +-- | The mathematical structure this class is based on is sometimes also called +-- | a *Euclidean domain*. +-- | +-- | Instances must satisfy the following laws in addition to the `Ring` +-- | laws: +-- | +-- | - Integral domain: `one /= zero`, and if `a` and `b` are both nonzero then +-- | so is their product `a * b` +-- | - Euclidean function `degree`: +-- | - Nonnegativity: For all nonzero `a`, `degree a >= 0` +-- | - Quotient/remainder: For all `a` and `b`, where `b` is nonzero, +-- | let `q = a / b` and ``r = a `mod` b``; then `a = q*b + r`, and also +-- | either `r = zero` or `degree r < degree b` +-- | - Submultiplicative euclidean function: +-- | - For all nonzero `a` and `b`, `degree a <= degree (a * b)` +-- | +-- | The behaviour of division by `zero` is unconstrained by these laws, +-- | meaning that individual instances are free to choose how to behave in this +-- | case. Similarly, there are no restrictions on what the result of +-- | `degree zero` is; it doesn't make sense to ask for `degree zero` in the +-- | same way that it doesn't make sense to divide by `zero`, so again, +-- | individual instances may choose how to handle this case. +-- | +-- | For any `EuclideanRing` which is also a `Field`, one valid choice +-- | for `degree` is simply `const 1`. In fact, unless there's a specific +-- | reason not to, `Field` types should normally use this definition of +-- | `degree`. +-- | +-- | The `EuclideanRing Int` instance is one of the most commonly used +-- | `EuclideanRing` instances and deserves a little more discussion. In +-- | particular, there are a few different sensible law-abiding implementations +-- | to choose from, with slightly different behaviour in the presence of +-- | negative dividends or divisors. The most common definitions are "truncating" +-- | division, where the result of `a / b` is rounded towards 0, and "Knuthian" +-- | or "flooring" division, where the result of `a / b` is rounded towards +-- | negative infinity. A slightly less common, but arguably more useful, option +-- | is "Euclidean" division, which is defined so as to ensure that ``a `mod` b`` +-- | is always nonnegative. With Euclidean division, `a / b` rounds towards +-- | negative infinity if the divisor is positive, and towards positive infinity +-- | if the divisor is negative. Note that all three definitions are identical if +-- | we restrict our attention to nonnegative dividends and divisors. +-- | +-- | In versions 1.x, 2.x, and 3.x of the Prelude, the `EuclideanRing Int` +-- | instance used truncating division. As of 4.x, the `EuclideanRing Int` +-- | instance uses Euclidean division. Additional functions `quot` and `rem` are +-- | supplied if truncating division is desired. +class CommutativeRing a <= EuclideanRing a where + degree :: a -> Int + div :: a -> a -> a + mod :: a -> a -> a + +infixl 7 div as / + +instance euclideanRingInt :: EuclideanRing Int where + degree x = intDegree x + div x y = intDiv x y + mod x y = intMod x y + +instance euclideanRingNumber :: EuclideanRing Number where + degree _ = 1 + div x y = numDiv x y + mod _ _ = 0.0 + +intDegree :: Int -> Int +intDegree a0 = if intEq a0 minInt32 then 2147483647 else if intLt a0 0 then intNeg a0 else a0 + +minInt32 :: Int +minInt32 = intSub (intSub 0 2147483647) 1 + + + +numDiv :: Number -> Number -> Number +numDiv a0 a1 = numberDiv a0 a1 + +-- | The *greatest common divisor* of two values. +gcd :: forall a. Eq a => EuclideanRing a => a -> a -> a +gcd a b = + if b == zero then a + else gcd b (a `mod` b) + +-- | The *least common multiple* of two values. +lcm :: forall a. Eq a => EuclideanRing a => a -> a -> a +lcm a b = + if a == zero || b == zero then zero + else a * b / gcd a b diff --git a/stdlib/lib/Data/Exists.purs b/stdlib/lib/Data/Exists.purs new file mode 100644 index 00000000..ada29d22 --- /dev/null +++ b/stdlib/lib/Data/Exists.purs @@ -0,0 +1,57 @@ +module Data.Exists where + +import Unsafe.Coerce (unsafeCoerce) + +-- | This type constructor can be used to existentially quantify over a type. +-- | +-- | Specifically, the type `Exists f` is isomorphic to the existential type `exists a. f a`. +-- | +-- | Existential types can be encoded using universal types (`forall`) for endofunctors in more general +-- | categories. The benefit of this library is that, by using the FFI, we can create an efficient +-- | representation of the existential by simply hiding type information. +-- | +-- | For example, consider the type `exists s. Tuple s (s -> Tuple s a)` which represents infinite streams +-- | of elements of type `a`. +-- | +-- | This type can be constructed by creating a type constructor `StreamF` as follows: +-- | +-- | ```purescript +-- | data StreamF a s = StreamF s (s -> Tuple s a) +-- | ``` +-- | +-- | We can then define the type of streams using `Exists`: +-- | +-- | ```purescript +-- | type Stream a = Exists (StreamF a) +-- | ``` +foreign import data Exists :: forall k. (k -> Type) -> Type + +type role Exists representational + +-- | The `mkExists` function is used to introduce a value of type `Exists f`, by providing a value of +-- | type `f a`, for some type `a` which will be hidden in the existentially-quantified type. +-- | +-- | For example, to create a value of type `Stream Number`, we might use `mkExists` as follows: +-- | +-- | ```purescript +-- | nats :: Stream Number +-- | nats = mkExists $ StreamF 0 (\n -> Tuple (n + 1) n) +-- | ``` +mkExists :: forall f a. f a -> Exists f +mkExists = unsafeCoerce + +-- | The `runExists` function is used to eliminate a value of type `Exists f`. The rank 2 type ensures +-- | that the existentially-quantified type does not escape its scope. Since the function is required +-- | to work for _any_ type `a`, it will work for the existentially-quantified type. +-- | +-- | For example, we can write a function to obtain the head of a stream by using `runExists` as follows: +-- | +-- | ```purescript +-- | head :: forall a. Stream a -> a +-- | head = runExists head' +-- | where +-- | head' :: forall s. StreamF a s -> a +-- | head' (StreamF s f) = snd (f s) +-- | ``` +runExists :: forall f r. (forall a. f a -> r) -> Exists f -> r +runExists = unsafeCoerce diff --git a/stdlib/lib/Data/Field.purs b/stdlib/lib/Data/Field.purs new file mode 100644 index 00000000..113b714d --- /dev/null +++ b/stdlib/lib/Data/Field.purs @@ -0,0 +1,41 @@ +module Data.Field + ( class Field + , module Data.DivisionRing + , module Data.CommutativeRing + , module Data.EuclideanRing + , module Data.Ring + , module Data.Semiring + ) where + +import Data.DivisionRing (class DivisionRing, recip) +import Data.CommutativeRing (class CommutativeRing) +import Data.EuclideanRing (class EuclideanRing, degree, div, mod, (/), gcd, lcm) +import Data.Ring (class Ring, negate, sub) +import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) + +-- | The `Field` class is for types that are (commutative) fields. +-- | +-- | Mathematically, a field is a ring which is commutative and in which every +-- | nonzero element has a multiplicative inverse; these conditions correspond +-- | to the `CommutativeRing` and `DivisionRing` classes in PureScript +-- | respectively. However, the `Field` class has `EuclideanRing` and +-- | `DivisionRing` as superclasses, which seems like a stronger requirement +-- | (since `CommutativeRing` is a superclass of `EuclideanRing`). In fact, it +-- | is not stronger, since any type which has law-abiding `CommutativeRing` +-- | and `DivisionRing` instances permits exactly one law-abiding +-- | `EuclideanRing` instance. We use a `EuclideanRing` superclass here in +-- | order to ensure that a `Field` constraint on a function permits you to use +-- | `div` on that type, since `div` is a member of `EuclideanRing`. +-- | +-- | This class has no laws or members of its own; it exists as a convenience, +-- | so a single constraint can be used when field-like behaviour is expected. +-- | +-- | This module also defines a single `Field` instance for any type which has +-- | both `EuclideanRing` and `DivisionRing` instances. Any other instance +-- | would overlap with this instance, so no other `Field` instances should be +-- | defined in libraries. Instead, simply define `EuclideanRing` and +-- | `DivisionRing` instances, and this will permit your type to be used with a +-- | `Field` constraint. +class (EuclideanRing a, DivisionRing a) <= Field a + +instance field :: (EuclideanRing a, DivisionRing a) => Field a diff --git a/stdlib/lib/Data/Filterable.purs b/stdlib/lib/Data/Filterable.purs new file mode 100644 index 00000000..860d213f --- /dev/null +++ b/stdlib/lib/Data/Filterable.purs @@ -0,0 +1,229 @@ +module Data.Filterable + ( class Filterable + , partitionMap + , partition + , filterMap + , filter + , eitherBool + , partitionDefault + , partitionDefaultFilter + , partitionDefaultFilterMap + , partitionMapDefault + , maybeBool + , filterDefault + , filterDefaultPartition + , filterDefaultPartitionMap + , filterMapDefault + , cleared + , module Data.Compactable + ) where + +import Control.Bind ((=<<)) +import Control.Category ((<<<)) +import Data.Array (partition, mapMaybe, filter) as Array +import Data.Compactable (class Compactable, compact, separate) +import Data.Either (Either(..)) +import Data.Foldable (foldl, foldr) +import Data.Functor (class Functor, map) +import Data.HeytingAlgebra (not) +import Data.List (List(..), filter, mapMaybe) as List +import Data.Map (Map, empty, insert, alter, toUnfoldable) as Map +import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid, mempty) +import Data.Semigroup ((<>)) +import Data.Tuple (Tuple(..)) +import Prelude (const, class Ord) + +-- | `Filterable` represents data structures which can be _partitioned_/_filtered_. +-- | +-- | - `partitionMap` - partition a data structure based on an either predicate. +-- | - `partition` - partition a data structure based on boolean predicate. +-- | - `filterMap` - map over a data structure and filter based on a maybe. +-- | - `filter` - filter a data structure based on a boolean. +-- | +-- | Laws: +-- | - Functor Relation: `filterMap identity ≡ compact` +-- | - Functor Identity: `filterMap Just ≡ identity` +-- | - Kleisli Composition: `filterMap (l <=< r) ≡ filterMap l <<< filterMap r` +-- | +-- | - `filter ≡ filterMap <<< maybeBool` +-- | - `filterMap p ≡ filter (isJust <<< p)` +-- | +-- | - Functor Relation: `partitionMap identity ≡ separate` +-- | - Functor Identity 1: `_.right <<< partitionMap Right ≡ identity` +-- | - Functor Identity 2: `_.left <<< partitionMap Left ≡ identity` +-- | +-- | - `f <<< partition ≡ partitionMap <<< eitherBool` where `f = \{ no, yes } -> { left: no, right: yes }` +-- | - `f <<< partitionMap p ≡ partition (isRight <<< p)` where `f = \{ left, right } -> { no: left, yes: right}` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `partitionDefault` +-- | - `partitionDefaultFilter` +-- | - `partitionDefaultFilterMap` +-- | - `partitionMapDefault` +-- | - `filterDefault` +-- | - `filterDefaultPartition` +-- | - `filterDefaultPartitionMap` +-- | - `filterMapDefault` +class (Compactable f, Functor f) <= Filterable f where + partitionMap :: forall a l r. + (a -> Either l r) -> f a -> { left :: f l, right :: f r } + + partition :: forall a. + (a -> Boolean) -> f a -> { no :: f a, yes :: f a } + + filterMap :: forall a b. + (a -> Maybe b) -> f a -> f b + + filter :: forall a. + (a -> Boolean) -> f a -> f a + +-- | Upgrade a boolean-style predicate to an either-style predicate mapping. +eitherBool :: forall a. + (a -> Boolean) -> a -> Either a a +eitherBool p x = if p x then Right x else Left x + +-- | Upgrade a boolean-style predicate to a maybe-style predicate mapping. +maybeBool :: forall a. + (a -> Boolean) -> a -> Maybe a +maybeBool p x = if p x then Just x else Nothing + +-- | A default implementation of `partitionMap` using `separate`. Note that this is +-- | almost certainly going to be suboptimal compared to direct implementations. +partitionMapDefault :: forall f a l r. Filterable f => + (a -> Either l r) -> f a -> { left :: f l, right :: f r } +partitionMapDefault p = separate <<< map p + +-- | A default implementation of `partition` using `partitionMap`. +partitionDefault :: forall f a. Filterable f => + (a -> Boolean) -> f a -> { no :: f a, yes :: f a } +partitionDefault p xs = + let o = partitionMap (eitherBool p) xs + in {no: o.left, yes: o.right} + +-- | A default implementation of `partition` using `filter`. Note that this is +-- | almost certainly going to be suboptimal compared to direct implementations. +partitionDefaultFilter :: forall f a. Filterable f => + (a -> Boolean) -> f a -> { no :: f a, yes :: f a } +partitionDefaultFilter p xs = { yes: filter p xs, no: filter (not p) xs } + +-- | A default implementation of `filterMap` using `separate`. Note that this is +-- | almost certainly going to be suboptimal compared to direct implementations. +filterMapDefault :: forall f a b. Filterable f => + (a -> Maybe b) -> f a -> f b +filterMapDefault p = compact <<< map p + +-- | A default implementation of `partition` using `filterMap`. Note that this +-- | is almost certainly going to be suboptimal compared to direct +-- | implementations. +partitionDefaultFilterMap :: forall f a. Filterable f => + (a -> Boolean) -> f a -> { no :: f a, yes :: f a } +partitionDefaultFilterMap p xs = + { yes: filterMap (maybeBool p) xs + , no: filterMap (maybeBool (not p)) xs + } + +-- | A default implementation of `filter` using `filterMap`. +filterDefault :: forall f a. Filterable f => + (a -> Boolean) -> f a -> f a +filterDefault = filterMap <<< maybeBool + +-- | A default implementation of `filter` using `partition`. +filterDefaultPartition :: forall f a. Filterable f => + (a -> Boolean) -> f a -> f a +filterDefaultPartition p xs = (partition p xs).yes + +-- | A default implementation of `filter` using `partitionMap`. +filterDefaultPartitionMap :: forall f a. Filterable f => + (a -> Boolean) -> f a -> f a +filterDefaultPartitionMap p xs = (partitionMap (eitherBool p) xs).right + +-- | Filter out all values. +cleared :: forall f a b. Filterable f => + f a -> f b +cleared = filterMap (const Nothing) + +instance filterableArray :: Filterable Array where + partitionMap p = foldl go {left: [], right: []} where + go acc x = case p x of + Left l -> acc { left = acc.left <> [l] } + Right r -> acc { right = acc.right <> [r] } + + partition = Array.partition + + filterMap = Array.mapMaybe + + filter = Array.filter + +instance filterableMaybe :: Filterable Maybe where + partitionMap _ Nothing = { left: Nothing, right: Nothing } + partitionMap p (Just x) = case p x of + Left a -> { left: Just a, right: Nothing } + Right b -> { left: Nothing, right: Just b } + + partition p = partitionDefault p + + filterMap = (=<<) + + filter p = filterDefault p + +instance filterableEither :: Monoid m => Filterable (Either m) where + partitionMap _ (Left x) = { left: Left x, right: Left x } + partitionMap p (Right x) = case p x of + Left a -> { left: Right a, right: Left mempty } + Right b -> { left: Left mempty, right: Right b } + + partition p = partitionDefault p + + filterMap _ (Left l) = Left l + filterMap p (Right r) = case p r of + Nothing -> Left mempty + Just x -> Right x + + filter p = filterDefault p + +instance filterableList :: Filterable List.List where + -- partitionMap :: forall a l r. (a -> Either l r) -> List a -> { left :: List l, right :: List r } + partitionMap p xs = foldr select { left: List.Nil, right: List.Nil } xs + where + select x { left, right } = case p x of + Left l -> { left: List.Cons l left, right } + Right r -> { left, right: List.Cons r right } + + -- partition :: forall a. (a -> Boolean) -> List a -> { no :: List a, yes :: List a } + partition p xs = foldr select { no: List.Nil, yes: List.Nil } xs + where + -- select :: (a -> Boolean) -> a -> { no :: List a, yes :: List a } -> { no :: List a, yes :: List a } + select x { no, yes } = if p x + then { no, yes: List.Cons x yes } + else { no: List.Cons x no, yes } + + -- filterMap :: forall a b. (a -> Maybe b) -> List a -> List b + filterMap p = List.mapMaybe p + + -- filter :: forall a. (a -> Boolean) -> List a -> List a + filter = List.filter + +instance filterableMap :: Ord k => Filterable (Map.Map k) where + partitionMap p xs = + foldr select { left: Map.empty, right: Map.empty } (toList xs) + where + toList :: forall v. Map.Map k v -> List.List (Tuple k v) + toList = Map.toUnfoldable + + select (Tuple k x) { left, right } = case p x of + Left l -> { left: Map.insert k l left, right } + Right r -> { left, right: Map.insert k r right } + + partition p = partitionDefault p + + filterMap p xs = + foldr select Map.empty (toList xs) + where + toList :: forall v. Map.Map k v -> List.List (Tuple k v) + toList = Map.toUnfoldable + + select (Tuple k x) m = Map.alter (const (p x)) k m + + filter p = filterDefault p diff --git a/stdlib/lib/Data/Foldable.purs b/stdlib/lib/Data/Foldable.purs index 5b54e8b0..b11eed3d 100644 --- a/stdlib/lib/Data/Foldable.purs +++ b/stdlib/lib/Data/Foldable.purs @@ -1,66 +1,473 @@ --- | The `Foldable` class. --- | --- | This is the class surface deriving and the fundep work assume: `foldr`, --- | `foldl`, and `foldMap`, not a second traversal implementation. The `Array` --- | instance walks indexes with the compiler's `arrayLength` and `arrayIndex` --- | primitives. `Maybe` and `Either` fold by cases. `fold` is omitted. It would be `foldMap` of the identity under a --- | quantified -- | `Foldable f`, and projecting that rank-2 method from a dictionary parameter --- | fails CC verification, which rejects every program that does not prune --- | unreachable library declarations. Combinators that need --- | `Applicative`, `Alt`, or `Ord` stay out until those classes exist. module Data.Foldable - ( class Foldable - , foldr - , foldl - , foldMap + ( class Foldable, foldr, foldl, foldMap + , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR + , fold + , foldM + , traverse_ + , for_ + , sequence_ + , oneOf + , oneOfMap + , intercalate + , surroundMap + , surround + , and + , or + , all + , any + , sum + , product + , elem + , notElem + , indexl + , indexr + , find + , findMap + , maximum + , maximumBy + , minimum + , minimumBy + , null + , length + , lookup ) where +import Prelude + +import Control.Plus (class Plus, alt, empty) +import Data.Const (Const) import Data.Either (Either(..)) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct, coproduct) +import Data.Functor.Product (Product(..)) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid, mempty) -import Data.Semigroup (class Semigroup, append) +import Data.Maybe.First (First(..)) +import Data.Maybe.Last (Last(..)) +import Data.Monoid.Additive (Additive(..)) +import Data.Monoid.Conj (Conj(..)) +import Data.Monoid.Disj (Disj(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Endo (Endo(..)) +import Data.Monoid.Multiplicative (Multiplicative(..)) +import Data.Newtype (alaF, unwrap) +import Data.Tuple (Tuple(..)) --- | A container that can be folded. +-- | `Foldable` represents data structures which can be _folded_. +-- | +-- | - `foldr` folds a structure from the right +-- | - `foldl` folds a structure from the left +-- | - `foldMap` folds a structure by accumulating values in a `Monoid` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `foldrDefault` +-- | - `foldlDefault` +-- | - `foldMapDefaultR` +-- | - `foldMapDefaultL` +-- | +-- | Note: some combinations of the default implementations are unsafe to +-- | use together - causing a non-terminating mutually recursive cycle. +-- | These combinations are documented per function. class Foldable f where foldr :: forall a b. (a -> b -> b) -> b -> f a -> b foldl :: forall a b. (b -> a -> b) -> b -> f a -> b foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m +-- | A default implementation of `foldr` using `foldMap`. +-- | +-- | Note: when defining a `Foldable` instance, this function is unsafe to use +-- | in combination with `foldMapDefaultR`. +foldrDefault + :: forall f a b + . Foldable f + => (a -> b -> b) + -> b + -> f a + -> b +foldrDefault c u xs = unwrap (foldMap (Endo <<< c) xs) u + +-- | A default implementation of `foldl` using `foldMap`. +-- | +-- | Note: when defining a `Foldable` instance, this function is unsafe to use +-- | in combination with `foldMapDefaultL`. +foldlDefault + :: forall f a b + . Foldable f + => (b -> a -> b) + -> b + -> f a + -> b +foldlDefault c u xs = unwrap (unwrap (foldMap (Dual <<< Endo <<< flip c) xs)) u + +-- | A default implementation of `foldMap` using `foldr`. +-- | +-- | Note: when defining a `Foldable` instance, this function is unsafe to use +-- | in combination with `foldrDefault`. +foldMapDefaultR + :: forall f a m + . Foldable f + => Monoid m + => (a -> m) + -> f a + -> m +foldMapDefaultR f = foldr (\x acc -> f x <> acc) mempty + +-- | A default implementation of `foldMap` using `foldl`. +-- | +-- | Note: when defining a `Foldable` instance, this function is unsafe to use +-- | in combination with `foldlDefault`. +foldMapDefaultL + :: forall f a m + . Foldable f + => Monoid m + => (a -> m) + -> f a + -> m +foldMapDefaultL f = foldl (\acc x -> acc <> f x) mempty + instance foldableArray :: Foldable Array where - foldr f z xs = foldrIndex f z xs 0 - foldl f z xs = foldlIndex f z xs 0 - foldMap f xs = foldr (\x acc -> append (f x) acc) mempty xs + foldr = foldrArray + foldl = foldlArray + foldMap = foldMapDefaultR + +foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b +foldrArray a0 a1 a2 = foldrArray a0 a1 a2 +foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b +foldlArray a0 a1 a2 = foldlArray a0 a1 a2 instance foldableMaybe :: Foldable Maybe where - foldr _ z Nothing = z - foldr f z (Just x) = f x z - foldl _ z Nothing = z - foldl f z (Just x) = f z x - foldMap _ Nothing = mempty + foldr _ z Nothing = z + foldr f z (Just x) = x `f` z + foldl _ z Nothing = z + foldl f z (Just x) = z `f` x + foldMap _ Nothing = mempty foldMap f (Just x) = f x +instance foldableFirst :: Foldable First where + foldr f z (First x) = foldr f z x + foldl f z (First x) = foldl f z x + foldMap f (First x) = foldMap f x + +instance foldableLast :: Foldable Last where + foldr f z (Last x) = foldr f z x + foldl f z (Last x) = foldl f z x + foldMap f (Last x) = foldMap f x + +instance foldableAdditive :: Foldable Additive where + foldr f z (Additive x) = x `f` z + foldl f z (Additive x) = z `f` x + foldMap f (Additive x) = f x + +instance foldableDual :: Foldable Dual where + foldr f z (Dual x) = x `f` z + foldl f z (Dual x) = z `f` x + foldMap f (Dual x) = f x + +instance foldableDisj :: Foldable Disj where + foldr f z (Disj x) = f x z + foldl f z (Disj x) = f z x + foldMap f (Disj x) = f x + +instance foldableConj :: Foldable Conj where + foldr f z (Conj x) = f x z + foldl f z (Conj x) = f z x + foldMap f (Conj x) = f x + +instance foldableMultiplicative :: Foldable Multiplicative where + foldr f z (Multiplicative x) = x `f` z + foldl f z (Multiplicative x) = z `f` x + foldMap f (Multiplicative x) = f x + instance foldableEither :: Foldable (Either a) where - foldr _ z (Left _) = z + foldr _ z (Left _) = z foldr f z (Right x) = f x z - foldl _ z (Left _) = z + foldl _ z (Left _) = z foldl f z (Right x) = f z x - foldMap _ (Left _) = mempty + foldMap _ (Left _) = mempty foldMap f (Right x) = f x --- | Left-to-right index, right-to-left combination: `go i` is --- | `f xs[i] (go (i + 1))`, which is `foldr`. `intLt` is the internal --- | comparison, so this module does not import the `Ord` operator. -foldrIndex :: forall a b. (a -> b -> b) -> b -> Array a -> Int -> b -foldrIndex f z xs i = - if intLt i (arrayLength xs) then - f (arrayIndex xs i) (foldrIndex f z xs (intAdd i 1)) - else - z - --- | Left-to-right walk. The recursive call is in tail position. -foldlIndex :: forall a b. (b -> a -> b) -> b -> Array a -> Int -> b -foldlIndex f z xs i = - if intLt i (arrayLength xs) then - foldlIndex f (f z (arrayIndex xs i)) xs (intAdd i 1) - else - z +instance foldableTuple :: Foldable (Tuple a) where + foldr f z (Tuple _ x) = f x z + foldl f z (Tuple _ x) = f z x + foldMap f (Tuple _ x) = f x + +instance foldableIdentity :: Foldable Identity where + foldr f z (Identity x) = f x z + foldl f z (Identity x) = f z x + foldMap f (Identity x) = f x + +instance foldableConst :: Foldable (Const a) where + foldr _ z _ = z + foldl _ z _ = z + foldMap _ _ = mempty + +instance foldableProduct :: (Foldable f, Foldable g) => Foldable (Product f g) where + foldr f z (Product (Tuple fa ga)) = foldr f (foldr f z ga) fa + foldl f z (Product (Tuple fa ga)) = foldl f (foldl f z fa) ga + foldMap f (Product (Tuple fa ga)) = foldMap f fa <> foldMap f ga + +instance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f g) where + foldr f z = coproduct (foldr f z) (foldr f z) + foldl f z = coproduct (foldl f z) (foldl f z) + foldMap f = coproduct (foldMap f) (foldMap f) + +instance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) where + foldr f i (Compose fga) = foldr (flip (foldr f)) i fga + foldl f i (Compose fga) = foldl (foldl f) i fga + foldMap f (Compose fga) = foldMap (foldMap f) fga + +instance foldableApp :: Foldable f => Foldable (App f) where + foldr f i (App x) = foldr f i x + foldl f i (App x) = foldl f i x + foldMap f (App x) = foldMap f x + +-- | Fold a data structure, accumulating values in some `Monoid`. +fold :: forall f m. Foldable f => Monoid m => f m -> m +fold xs = foldMap identity xs + +-- | Similar to 'foldl', but the result is encapsulated in a monad. +-- | +-- | Note: this function is not generally stack-safe, e.g., for monads which +-- | build up thunks a la `Eff`. +foldM :: forall f m a b. Foldable f => Monad m => (b -> a -> m b) -> b -> f a -> m b +foldM f b0 = foldl (\b a -> b >>= flip f a) (pure b0) + +-- | Traverse a data structure, performing some effects encoded by an +-- | `Applicative` functor at each value, ignoring the final result. +-- | +-- | For example: +-- | +-- | ```purescript +-- | traverse_ print [1, 2, 3] +-- | ``` +traverse_ + :: forall a b f m + . Applicative m + => Foldable f + => (a -> m b) + -> f a + -> m Unit +traverse_ f = foldr ((*>) <<< f) (pure unit) + +-- | A version of `traverse_` with its arguments flipped. +-- | +-- | This can be useful when running an action written using do notation +-- | for every element in a data structure: +-- | +-- | For example: +-- | +-- | ```purescript +-- | for_ [1, 2, 3] \n -> do +-- | print n +-- | trace "squared is" +-- | print (n * n) +-- | ``` +for_ + :: forall a b f m + . Applicative m + => Foldable f + => f a + -> (a -> m b) + -> m Unit +for_ = flip traverse_ + +-- | Perform all of the effects in some data structure in the order +-- | given by the `Foldable` instance, ignoring the final result. +-- | +-- | For example: +-- | +-- | ```purescript +-- | sequence_ [ trace "Hello, ", trace " world!" ] +-- | ``` +sequence_ :: forall a f m. Applicative m => Foldable f => f (m a) -> m Unit +sequence_ = traverse_ identity + +-- | Combines a collection of elements using the `Alt` operation. +oneOf :: forall f g a. Foldable f => Plus g => f (g a) -> g a +oneOf = foldr alt empty + +-- | Folds a structure into some `Plus`. +oneOfMap :: forall f g a b. Foldable f => Plus g => (a -> g b) -> f a -> g b +oneOfMap f = foldr (alt <<< f) empty + +-- | Fold a data structure, accumulating values in some `Monoid`, +-- | combining adjacent elements using the specified separator. +-- | +-- | For example: +-- | +-- | ```purescript +-- | > intercalate ", " ["Lorem", "ipsum", "dolor"] +-- | = "Lorem, ipsum, dolor" +-- | +-- | > intercalate "*" ["a", "b", "c"] +-- | = "a*b*c" +-- | +-- | > intercalate [1] [[2, 3], [4, 5], [6, 7]] +-- | = [2, 3, 1, 4, 5, 1, 6, 7] +-- | ``` +intercalate :: forall f m. Foldable f => Monoid m => m -> f m -> m +intercalate sep xs = (foldl go { init: true, acc: mempty } xs).acc + where + go { init: true } x = { init: false, acc: x } + go { acc: acc } x = { init: false, acc: acc <> sep <> x } + +-- | `foldMap` but with each element surrounded by some fixed value. +-- | +-- | For example: +-- | +-- | ```purescript +-- | > surroundMap "*" show [] +-- | = "*" +-- | +-- | > surroundMap "*" show [1] +-- | = "*1*" +-- | +-- | > surroundMap "*" show [1, 2] +-- | = "*1*2*" +-- | +-- | > surroundMap "*" show [1, 2, 3] +-- | = "*1*2*3*" +-- | ``` +surroundMap :: forall f a m. Foldable f => Semigroup m => m -> (a -> m) -> f a -> m +surroundMap d t f = unwrap (foldMap joined f) d + where joined a = Endo \m -> d <> t a <> m + +-- | `fold` but with each element surrounded by some fixed value. +-- | +-- | For example: +-- | +-- | ```purescript +-- | > surround "*" [] +-- | = "*" +-- | +-- | > surround "*" ["1"] +-- | = "*1*" +-- | +-- | > surround "*" ["1", "2"] +-- | = "*1*2*" +-- | +-- | > surround "*" ["1", "2", "3"] +-- | = "*1*2*3*" +-- | ``` +surround :: forall f m. Foldable f => Semigroup m => m -> f m -> m +surround d = surroundMap d identity + +-- | The conjunction of all the values in a data structure. When specialized +-- | to `Boolean`, this function will test whether all of the values in a data +-- | structure are `true`. +and :: forall a f. Foldable f => HeytingAlgebra a => f a -> a +and = all identity + +-- | The disjunction of all the values in a data structure. When specialized +-- | to `Boolean`, this function will test whether any of the values in a data +-- | structure is `true`. +or :: forall a f. Foldable f => HeytingAlgebra a => f a -> a +or = any identity + +-- | `all f` is the same as `and <<< map f`; map a function over the structure, +-- | and then get the conjunction of the results. +all :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b +all = alaF Conj foldMap + +-- | `any f` is the same as `or <<< map f`; map a function over the structure, +-- | and then get the disjunction of the results. +any :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b +any = alaF Disj foldMap + +-- | Find the sum of the numeric values in a data structure. +sum :: forall a f. Foldable f => Semiring a => f a -> a +sum = foldl (+) zero + +-- | Find the product of the numeric values in a data structure. +product :: forall a f. Foldable f => Semiring a => f a -> a +product = foldl (*) one + +-- | Test whether a value is an element of a data structure. +elem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean +elem = any <<< (==) + +-- | Test whether a value is not an element of a data structure. +notElem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean +notElem x = not <<< elem x + +-- | Try to get nth element from the left in a data structure +indexl :: forall a f. Foldable f => Int -> f a -> Maybe a +indexl idx = _.elem <<< foldl go { elem: Nothing, pos: 0 } + where + go cursor a = + case cursor.elem of + Just _ -> cursor + _ -> + if cursor.pos == idx + then { elem: Just a, pos: cursor.pos } + else { pos: cursor.pos + 1, elem: cursor.elem } + +-- | Try to get nth element from the right in a data structure +indexr :: forall a f. Foldable f => Int -> f a -> Maybe a +indexr idx = _.elem <<< foldr go { elem: Nothing, pos: 0 } + where + go a cursor = + case cursor.elem of + Just _ -> cursor + _ -> + if cursor.pos == idx + then { elem: Just a, pos: cursor.pos } + else { pos: cursor.pos + 1, elem: cursor.elem } + +-- | Try to find an element in a data structure which satisfies a predicate. +find :: forall a f. Foldable f => (a -> Boolean) -> f a -> Maybe a +find p = foldl go Nothing + where + go Nothing x | p x = Just x + go r _ = r + +-- | Try to find an element in a data structure which satisfies a predicate mapping. +findMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b +findMap p = foldl go Nothing + where + go Nothing x = p x + go r _ = r + +-- | Find the largest element of a structure, according to its `Ord` instance. +maximum :: forall a f. Ord a => Foldable f => f a -> Maybe a +maximum = maximumBy compare + +-- | Find the largest element of a structure, according to a given comparison +-- | function. The comparison function should represent a total ordering (see +-- | the `Ord` type class laws); if it does not, the behaviour is undefined. +maximumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a +maximumBy cmp = foldl max' Nothing + where + max' Nothing x = Just x + max' (Just x) y = Just (if cmp x y == GT then x else y) + +-- | Find the smallest element of a structure, according to its `Ord` instance. +minimum :: forall a f. Ord a => Foldable f => f a -> Maybe a +minimum = minimumBy compare + +-- | Find the smallest element of a structure, according to a given comparison +-- | function. The comparison function should represent a total ordering (see +-- | the `Ord` type class laws); if it does not, the behaviour is undefined. +minimumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a +minimumBy cmp = foldl min' Nothing + where + min' Nothing x = Just x + min' (Just x) y = Just (if cmp x y == LT then x else y) + +-- | Test whether the structure is empty. +-- | Optimized for structures that are similar to cons-lists, because there +-- | is no general way to do better. +null :: forall a f. Foldable f => f a -> Boolean +null = foldr (\_ _ -> false) true + +-- | Returns the size/length of a finite structure. +-- | Optimized for structures that are similar to cons-lists, because there +-- | is no general way to do better. +length :: forall a b f. Foldable f => Semiring b => f a -> b +length = foldl (\c _ -> add one c) zero + +-- | Lookup a value in a data structure of `Tuple`s, generalizing association lists. +lookup :: forall a b f. Foldable f => Eq a => a -> f (Tuple a b) -> Maybe b +lookup a = unwrap <<< foldMap \(Tuple a' b) -> First (if a == a' then Just b else Nothing) diff --git a/stdlib/lib/Data/FoldableWithIndex.purs b/stdlib/lib/Data/FoldableWithIndex.purs new file mode 100644 index 00000000..258fe1e7 --- /dev/null +++ b/stdlib/lib/Data/FoldableWithIndex.purs @@ -0,0 +1,370 @@ +module Data.FoldableWithIndex + ( class FoldableWithIndex, foldrWithIndex, foldlWithIndex, foldMapWithIndex + , foldrWithIndexDefault + , foldlWithIndexDefault + , foldMapWithIndexDefaultR + , foldMapWithIndexDefaultL + , foldWithIndexM + , traverseWithIndex_ + , forWithIndex_ + , surroundMapWithIndex + , allWithIndex + , anyWithIndex + , findWithIndex + , findMapWithIndex + , foldrDefault + , foldlDefault + , foldMapDefault + ) where + +import Prelude + +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct, coproduct) +import Data.Functor.Product (Product(..)) +import Data.FunctorWithIndex (mapWithIndex) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe(..)) +import Data.Maybe.First (First) +import Data.Maybe.Last (Last) +import Data.Monoid.Additive (Additive) +import Data.Monoid.Conj (Conj(..)) +import Data.Monoid.Disj (Disj(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Endo (Endo(..)) +import Data.Monoid.Multiplicative (Multiplicative) +import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..), curry) + +-- | A `Foldable` with an additional index. +-- | A `FoldableWithIndex` instance must be compatible with its `Foldable` +-- | instance +-- | ```purescript +-- | foldr f = foldrWithIndex (const f) +-- | foldl f = foldlWithIndex (const f) +-- | foldMap f = foldMapWithIndex (const f) +-- | ``` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `foldrWithIndexDefault` +-- | - `foldlWithIndexDefault` +-- | - `foldMapWithIndexDefaultR` +-- | - `foldMapWithIndexDefaultL` +-- | +-- | Note: some combinations of the default implementations are unsafe to +-- | use together - causing a non-terminating mutually recursive cycle. +-- | These combinations are documented per function. +class Foldable f <= FoldableWithIndex i f | f -> i where + foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b + foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b + foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m + +-- | A default implementation of `foldrWithIndex` using `foldMapWithIndex`. +-- | +-- | Note: when defining a `FoldableWithIndex` instance, this function is +-- | unsafe to use in combination with `foldMapWithIndexDefaultR`. +foldrWithIndexDefault + :: forall i f a b + . FoldableWithIndex i f + => (i -> a -> b -> b) + -> b + -> f a + -> b +foldrWithIndexDefault c u xs = unwrap (foldMapWithIndex (\i -> Endo <<< c i) xs) u + +-- | A default implementation of `foldlWithIndex` using `foldMapWithIndex`. +-- | +-- | Note: when defining a `FoldableWithIndex` instance, this function is +-- | unsafe to use in combination with `foldMapWithIndexDefaultL`. +foldlWithIndexDefault + :: forall i f a b + . FoldableWithIndex i f + => (i -> b -> a -> b) + -> b + -> f a + -> b +foldlWithIndexDefault c u xs = unwrap (unwrap (foldMapWithIndex (\i -> Dual <<< Endo <<< flip (c i)) xs)) u + +-- | A default implementation of `foldMapWithIndex` using `foldrWithIndex`. +-- | +-- | Note: when defining a `FoldableWithIndex` instance, this function is +-- | unsafe to use in combination with `foldrWithIndexDefault`. +foldMapWithIndexDefaultR + :: forall i f a m + . FoldableWithIndex i f + => Monoid m + => (i -> a -> m) + -> f a + -> m +foldMapWithIndexDefaultR f = foldrWithIndex (\i x acc -> f i x <> acc) mempty + +-- | A default implementation of `foldMapWithIndex` using `foldlWithIndex`. +-- | +-- | Note: when defining a `FoldableWithIndex` instance, this function is +-- | unsafe to use in combination with `foldlWithIndexDefault`. +foldMapWithIndexDefaultL + :: forall i f a m + . FoldableWithIndex i f + => Monoid m + => (i -> a -> m) + -> f a + -> m +foldMapWithIndexDefaultL f = foldlWithIndex (\i acc x -> acc <> f i x) mempty + +instance foldableWithIndexArray :: FoldableWithIndex Int Array where + foldrWithIndex f z = foldr (\(Tuple i x) y -> f i x y) z <<< mapWithIndex Tuple + foldlWithIndex f z = foldl (\y (Tuple i x) -> f i y x) z <<< mapWithIndex Tuple + foldMapWithIndex = foldMapWithIndexDefaultR + +instance foldableWithIndexMaybe :: FoldableWithIndex Unit Maybe where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexFirst :: FoldableWithIndex Unit First where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexLast :: FoldableWithIndex Unit Last where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexAdditive :: FoldableWithIndex Unit Additive where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexDual :: FoldableWithIndex Unit Dual where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexDisj :: FoldableWithIndex Unit Disj where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexConj :: FoldableWithIndex Unit Conj where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexMultiplicative :: FoldableWithIndex Unit Multiplicative where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldableWithIndexEither :: FoldableWithIndex Unit (Either a) where + foldrWithIndex _ z (Left _) = z + foldrWithIndex f z (Right x) = f unit x z + foldlWithIndex _ z (Left _) = z + foldlWithIndex f z (Right x) = f unit z x + foldMapWithIndex _ (Left _) = mempty + foldMapWithIndex f (Right x) = f unit x + +instance foldableWithIndexTuple :: FoldableWithIndex Unit (Tuple a) where + foldrWithIndex f z (Tuple _ x) = f unit x z + foldlWithIndex f z (Tuple _ x) = f unit z x + foldMapWithIndex f (Tuple _ x) = f unit x + +instance foldableWithIndexIdentity :: FoldableWithIndex Unit Identity where + foldrWithIndex f z (Identity x) = f unit x z + foldlWithIndex f z (Identity x) = f unit z x + foldMapWithIndex f (Identity x) = f unit x + +instance foldableWithIndexConst :: FoldableWithIndex Void (Const a) where + foldrWithIndex _ z _ = z + foldlWithIndex _ z _ = z + foldMapWithIndex _ _ = mempty + +instance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where + foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa + foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga + foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga + +instance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where + foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z) + foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z) + foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right)) + +instance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where + foldrWithIndex f i (Compose fga) = foldrWithIndex (\a -> flip (foldrWithIndex (curry f a))) i fga + foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga + foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga + +instance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f) where + foldrWithIndex f z (App x) = foldrWithIndex f z x + foldlWithIndex f z (App x) = foldlWithIndex f z x + foldMapWithIndex f (App x) = foldMapWithIndex f x + + +-- | Similar to 'foldlWithIndex', but the result is encapsulated in a monad. +-- | +-- | Note: this function is not generally stack-safe, e.g., for monads which +-- | build up thunks a la `Eff`. +foldWithIndexM + :: forall i f m a b + . FoldableWithIndex i f + => Monad m + => (i -> a -> b -> m a) + -> a + -> f b + -> m a +foldWithIndexM f a0 = foldlWithIndex (\i ma b -> ma >>= flip (f i) b) (pure a0) + +-- | Traverse a data structure with access to the index, performing some +-- | effects encoded by an `Applicative` functor at each value, ignoring the +-- | final result. +-- | +-- | For example: +-- | +-- | ```purescript +-- | > traverseWithIndex_ (curry logShow) ["a", "b", "c"] +-- | (Tuple 0 "a") +-- | (Tuple 1 "b") +-- | (Tuple 2 "c") +-- | ``` +traverseWithIndex_ + :: forall i a b f m + . Applicative m + => FoldableWithIndex i f + => (i -> a -> m b) + -> f a + -> m Unit +traverseWithIndex_ f = foldrWithIndex (\i -> (*>) <<< f i) (pure unit) + +-- | A version of `traverseWithIndex_` with its arguments flipped. +-- | +-- | This can be useful when running an action written using do notation +-- | for every element in a data structure: +-- | +-- | For example: +-- | +-- | ```purescript +-- | forWithIndex_ ["a", "b", "c"] \i x -> do +-- | logShow i +-- | log x +-- | ``` +forWithIndex_ + :: forall i a b f m + . Applicative m + => FoldableWithIndex i f + => f a + -> (i -> a -> m b) + -> m Unit +forWithIndex_ = flip traverseWithIndex_ + +-- | `foldMapWithIndex` but with each element surrounded by some fixed value. +-- | +-- | For example: +-- | +-- | ```purescript +-- | > surroundMapWithIndex "*" (\i x -> show i <> x) [] +-- | = "*" +-- | +-- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a"] +-- | = "*0a*" +-- | +-- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b"] +-- | = "*0a*1b*" +-- | +-- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b", "c"] +-- | = "*0a*1b*2c*" +-- | ``` +surroundMapWithIndex + :: forall i f a m + . FoldableWithIndex i f + => Semigroup m + => m + -> (i -> a -> m) + -> f a + -> m +surroundMapWithIndex d t f = unwrap (foldMapWithIndex joined f) d + where joined i a = Endo \m -> d <> t i a <> m + +-- | `allWithIndex f` is the same as `and <<< mapWithIndex f`; map a function over the +-- | structure, and then get the conjunction of the results. +allWithIndex + :: forall i a b f + . FoldableWithIndex i f + => HeytingAlgebra b + => (i -> a -> b) + -> f a + -> b +allWithIndex t = unwrap <<< foldMapWithIndex (\i -> Conj <<< t i) + +-- | `anyWithIndex f` is the same as `or <<< mapWithIndex f`; map a function over the +-- | structure, and then get the disjunction of the results. +anyWithIndex + :: forall i a b f + . FoldableWithIndex i f + => HeytingAlgebra b + => (i -> a -> b) + -> f a + -> b +anyWithIndex t = unwrap <<< foldMapWithIndex (\i -> Disj <<< t i) + +-- | Try to find an element in a data structure which satisfies a predicate +-- | with access to the index. +findWithIndex + :: forall i a f + . FoldableWithIndex i f + => (i -> a -> Boolean) + -> f a + -> Maybe { index :: i, value :: a } +findWithIndex p = foldlWithIndex go Nothing + where + go + :: i + -> Maybe { index :: i, value :: a } + -> a + -> Maybe { index :: i, value :: a } + go i Nothing x | p i x = Just { index: i, value: x } + go _ r _ = r + +-- | Try to find an element in a data structure which satisfies a predicate mapping +-- | with access to the index. +findMapWithIndex + :: forall i a b f + . FoldableWithIndex i f + => (i -> a -> Maybe b) + -> f a + -> Maybe b +findMapWithIndex f = foldlWithIndex go Nothing + where + go + :: i + -> Maybe b + -> a + -> Maybe b + go i Nothing x = f i x + go _ r _ = r + +-- | A default implementation of `foldr` using `foldrWithIndex` +foldrDefault + :: forall i f a b + . FoldableWithIndex i f + => (a -> b -> b) -> b -> f a -> b +foldrDefault f = foldrWithIndex (const f) + +-- | A default implementation of `foldl` using `foldlWithIndex` +foldlDefault + :: forall i f a b + . FoldableWithIndex i f + => (b -> a -> b) -> b -> f a -> b +foldlDefault f = foldlWithIndex (const f) + +-- | A default implementation of `foldMap` using `foldMapWithIndex` +foldMapDefault + :: forall i f a m + . FoldableWithIndex i f + => Monoid m + => (a -> m) -> f a -> m +foldMapDefault f = foldMapWithIndex (const f) diff --git a/stdlib/lib/Data/Function.purs b/stdlib/lib/Data/Function.purs index b80a969e..37ff740c 100644 --- a/stdlib/lib/Data/Function.purs +++ b/stdlib/lib/Data/Function.purs @@ -1,47 +1,120 @@ --- | Function combinators and application operators. --- | --- | The operators are aliases for the value functions here, exactly as the --- | official `Data.Function` declares them: `$` applies a function to an --- | argument, so it is the definition that names `apply`, and the fixity --- | declaration gives the operator its right associativity and lowest --- | precedence. --- | --- | `identity` is **not** here. The official `Prelude` re-exports it from --- | `Control.Category`, where it is the `Category` class method, and defining a --- | private `identity` here first would be the narrower model that has to be --- | replaced when the class hierarchy lands in #94. module Data.Function - ( apply - , applyFlipped + ( flip , const - , flip - , on - , (#) + , apply , ($) + , applyFlipped + , (#) + , applyN + , on + , module Control.Category ) where --- | Applies a function to an argument: `apply f x = f x`. +import Control.Category (identity, compose, (<<<), (>>>)) +import Data.Boolean (otherwise) +import Data.Ord ((<=)) +import Data.Ring ((-)) + +-- | Given a function that takes two arguments, applies the arguments +-- | to the function in a swapped order. +-- | +-- | ```purescript +-- | flip append "1" "2" == append "2" "1" == "21" +-- | +-- | const 1 "two" == 1 +-- | +-- | flip const 1 "two" == const "two" 1 == "two" +-- | ``` +flip :: forall a b c. (a -> b -> c) -> b -> a -> c +flip f b a = f a b + +-- | Returns its first argument and ignores its second. +-- | +-- | ```purescript +-- | const 1 "hello" = 1 +-- | ``` +-- | +-- | It can also be thought of as creating a function that ignores its argument: +-- | +-- | ```purescript +-- | const 1 = \_ -> 1 +-- | ``` +const :: forall a b. a -> b -> a +const a _ = a + +-- | Applies a function to an argument. This is primarily used as the operator +-- | `($)` which allows parentheses to be omitted in some cases, or as a +-- | natural way to apply a chain of composed functions to a value. apply :: forall a b. (a -> b) -> a -> b apply f x = f x --- | Applies a function to an argument, with the argument first: --- | `applyFlipped x f = f x`. +-- | Applies a function to an argument: the reverse of `(#)`. +-- | +-- | ```purescript +-- | length $ groupBy productCategory $ filter isInStock $ products +-- | ``` +-- | +-- | is equivalent to: +-- | +-- | ```purescript +-- | length (groupBy productCategory (filter isInStock products)) +-- | ``` +-- | +-- | Or another alternative equivalent, applying chain of composed functions to +-- | a value: +-- | +-- | ```purescript +-- | length <<< groupBy productCategory <<< filter isInStock $ products +-- | ``` +infixr 0 apply as $ + +-- | Applies an argument to a function. This is primarily used as the `(#)` +-- | operator, which allows parentheses to be omitted in some cases, or as a +-- | natural way to apply a value to a chain of composed functions. applyFlipped :: forall a b. a -> (a -> b) -> b applyFlipped x f = f x --- | Returns its first argument and ignores the second. -const :: forall a b. a -> b -> a -const value _ = value +-- | Applies an argument to a function: the reverse of `($)`. +-- | +-- | ```purescript +-- | products # filter isInStock # groupBy productCategory # length +-- | ``` +-- | +-- | is equivalent to: +-- | +-- | ```purescript +-- | length (groupBy productCategory (filter isInStock products)) +-- | ``` +-- | +-- | Or another alternative equivalent, applying a value to a chain of composed +-- | functions: +-- | +-- | ```purescript +-- | products # filter isInStock >>> groupBy productCategory >>> length +-- | ``` +infixl 1 applyFlipped as # --- | Reverses the argument order of a two-argument function. -flip :: forall a b c. (a -> b -> c) -> b -> a -> c -flip f b a = f a b +-- | `applyN f n` applies the function `f` to its argument `n` times. +-- | +-- | If n is less than or equal to 0, the function is not applied. +-- | +-- | ```purescript +-- | applyN (_ + 1) 10 0 == 10 +-- | ``` +applyN :: forall a. (a -> a) -> Int -> a -> a +applyN f = go + where + go n acc + | n <= 0 = acc + | otherwise = go (n - 1) (f acc) --- | Applies a unary function to both arguments before a binary function: --- | `on f g x y = f (g x) (g y)`. +-- | The `on` function is used to change the domain of a binary operator. +-- | +-- | For example, we can create a function which compares two records based on the values of their `x` properties: +-- | +-- | ```purescript +-- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering +-- | compareX = compare `on` _.x +-- | ``` on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c -on f g x y = f (g x) (g y) - -infixr 0 apply as $ - -infixl 1 applyFlipped as # +on f g x y = g x `f` g y diff --git a/stdlib/lib/Data/Function/Uncurried.purs b/stdlib/lib/Data/Function/Uncurried.purs new file mode 100644 index 00000000..4373b027 --- /dev/null +++ b/stdlib/lib/Data/Function/Uncurried.purs @@ -0,0 +1,144 @@ +module Data.Function.Uncurried where + +import Data.Unit (Unit) + +-- | A function of zero arguments +foreign import data Fn0 :: Type -> Type + +type role Fn0 representational + +-- | A function of one argument +type Fn1 a b = a -> b + +-- | A function of two arguments +foreign import data Fn2 :: Type -> Type -> Type -> Type + +type role Fn2 representational representational representational + +-- | A function of three arguments +foreign import data Fn3 :: Type -> Type -> Type -> Type -> Type + +type role Fn3 representational representational representational representational + +-- | A function of four arguments +foreign import data Fn4 :: Type -> Type -> Type -> Type -> Type -> Type + +type role Fn4 representational representational representational representational representational + +-- | A function of five arguments +foreign import data Fn5 :: Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role Fn5 representational representational representational representational representational representational + +-- | A function of six arguments +foreign import data Fn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role Fn6 representational representational representational representational representational representational representational + +-- | A function of seven arguments +foreign import data Fn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role Fn7 representational representational representational representational representational representational representational representational + +-- | A function of eight arguments +foreign import data Fn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role Fn8 representational representational representational representational representational representational representational representational representational + +-- | A function of nine arguments +foreign import data Fn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role Fn9 representational representational representational representational representational representational representational representational representational representational + +-- | A function of ten arguments +foreign import data Fn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role Fn10 representational representational representational representational representational representational representational representational representational representational representational + +-- | Create a function of no arguments +mkFn0 :: forall a. (Unit -> a) -> Fn0 a +mkFn0 a0 = mkFn0 a0 + +-- | Create a function of one argument +mkFn1 :: forall a b. (a -> b) -> Fn1 a b +mkFn1 f = f + +-- | Create a function of two arguments from a curried function +mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c +mkFn2 a0 = mkFn2 a0 + +-- | Create a function of three arguments from a curried function +mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d +mkFn3 a0 = mkFn3 a0 + +-- | Create a function of four arguments from a curried function +mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e +mkFn4 a0 = mkFn4 a0 + +-- | Create a function of five arguments from a curried function +mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f +mkFn5 a0 = mkFn5 a0 + +-- | Create a function of six arguments from a curried function +mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g +mkFn6 a0 = mkFn6 a0 + +-- | Create a function of seven arguments from a curried function +mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h +mkFn7 a0 = mkFn7 a0 + +-- | Create a function of eight arguments from a curried function +mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i +mkFn8 a0 = mkFn8 a0 + +-- | Create a function of nine arguments from a curried function +mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j +mkFn9 a0 = mkFn9 a0 + +-- | Create a function of ten arguments from a curried function +mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k +mkFn10 a0 = mkFn10 a0 + +-- | Apply a function of no arguments +runFn0 :: forall a. Fn0 a -> a +runFn0 a0 = runFn0 a0 + +-- | Apply a function of one argument +runFn1 :: forall a b. Fn1 a b -> a -> b +runFn1 f = f + +-- | Apply a function of two arguments +runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c +runFn2 a0 a1 a2 = runFn2 a0 a1 a2 + +-- | Apply a function of three arguments +runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d +runFn3 a0 a1 a2 a3 = runFn3 a0 a1 a2 a3 + +-- | Apply a function of four arguments +runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e +runFn4 a0 a1 a2 a3 a4 = runFn4 a0 a1 a2 a3 a4 + +-- | Apply a function of five arguments +runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f +runFn5 a0 a1 a2 a3 a4 a5 = runFn5 a0 a1 a2 a3 a4 a5 + +-- | Apply a function of six arguments +runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g +runFn6 a0 a1 a2 a3 a4 a5 a6 = runFn6 a0 a1 a2 a3 a4 a5 a6 + +-- | Apply a function of seven arguments +runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h +runFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runFn7 a0 a1 a2 a3 a4 a5 a6 a7 + +-- | Apply a function of eight arguments +runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i +runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 + +-- | Apply a function of nine arguments +runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j +runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 + +-- | Apply a function of ten arguments +runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k +runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 diff --git a/stdlib/lib/Data/Functor.purs b/stdlib/lib/Data/Functor.purs index 9f6a82a1..068a8f75 100644 --- a/stdlib/lib/Data/Functor.purs +++ b/stdlib/lib/Data/Functor.purs @@ -1,41 +1,114 @@ --- | The `Functor` class and the `<$>` operator. --- | --- | `map` is the class method. `Prelude` re-exports it and supplies the --- | `Effect` instance, because this module cannot import `Prelude` without a --- | cycle. The `Array` instance walks indexes with `arrayIndex` and builds the --- | result with `arrayAppend`, the same primitives the rest of the library --- | uses for arrays. module Data.Functor ( class Functor , map , (<$>) + , mapFlipped + , (<#>) + , void + , voidRight + , (<$) + , voidLeft + , ($>) + , flap + , (<@>) ) where -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) +import Data.Function (const, compose) +import Data.Unit (Unit, unit) +import Type.Proxy (Proxy(..)) --- | A type constructor that can apply a function to its contents. +-- | A `Functor` is a type constructor which supports a mapping operation +-- | `map`. +-- | +-- | `map` can be used to turn functions `a -> b` into functions +-- | `f a -> f b` whose argument and return types use the type constructor `f` +-- | to represent some computational context. +-- | +-- | Instances must satisfy the following laws: +-- | +-- | - Identity: `map identity = identity` +-- | - Composition: `map (f <<< g) = map f <<< map g` class Functor f where map :: forall a b. (a -> b) -> f a -> f b infixl 4 map as <$> +-- | `mapFlipped` is `map` with its arguments reversed. For example: +-- | +-- | ```purescript +-- | [1, 2, 3] <#> \n -> n * n +-- | ``` +mapFlipped :: forall f a b. Functor f => f a -> (a -> b) -> f b +mapFlipped fa f = f <$> fa + +infixl 1 mapFlipped as <#> + +instance functorFn :: Functor ((->) r) where + map = compose + instance functorArray :: Functor Array where - map f xs = mapFrom f xs 0 + map x y = arrayMap x y -instance functorMaybe :: Functor Maybe where - map _ Nothing = Nothing - map f (Just value) = Just (f value) +instance functorProxy :: Functor Proxy where + map _ _ = Proxy -instance functorEither :: Functor (Either a) where - map _ (Left value) = Left value - map f (Right value) = Right (f value) +arrayMap :: forall a b. (a -> b) -> Array a -> Array b +arrayMap a0 a1 = mapArrayFrom a0 a1 0 --- | `mapFrom f xs i` is `f xs[i]` followed by the rest. The recursive call is --- | an argument of `arrayAppend`, so this copies the tail at each index. -mapFrom :: forall a b. (a -> b) -> Array a -> Int -> Array b -mapFrom f xs index = +mapArrayFrom :: forall a b. (a -> b) -> Array a -> Int -> Array b +mapArrayFrom f xs index = if intLt index (arrayLength xs) then - arrayAppend [f (arrayIndex xs index)] (mapFrom f xs (intAdd index 1)) + arrayAppend [f (arrayIndex xs index)] (mapArrayFrom f xs (intAdd index 1)) else [] + +-- | The `void` function is used to ignore the type wrapped by a +-- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type +-- | information provided by the type constructor itself. +-- | +-- | `void` is often useful when using `do` notation to change the return type +-- | of a monadic computation: +-- | +-- | ```purescript +-- | main = forE 1 10 \n -> void do +-- | print n +-- | print (n * n) +-- | ``` +void :: forall f a. Functor f => f a -> f Unit +void fa = map (\_ -> unit) fa + +-- | Ignore the return value of a computation, using the specified return value +-- | instead. +voidRight :: forall f a b. Functor f => a -> f b -> f a +voidRight x fa = map (\_ -> x) fa + +infixl 4 voidRight as <$ + +-- | A version of `voidRight` with its arguments flipped. +voidLeft :: forall f a b. Functor f => f a -> b -> f b +voidLeft fa x = (\_ -> x) <$> fa + +infixl 4 voidLeft as $> + +-- | Apply a value in a computational context to a value in no context. +-- | +-- | Generalizes `flip`. +-- | +-- | ```purescript +-- | longEnough :: String -> Bool +-- | hasSymbol :: String -> Bool +-- | hasDigit :: String -> Bool +-- | password :: String +-- | +-- | validate :: String -> Array Bool +-- | validate = flap [longEnough, hasSymbol, hasDigit] +-- | ``` +-- | +-- | ```purescript +-- | flap (-) 3 4 == 1 +-- | threeve <$> Just 1 <@> 'a' <*> Just true == Just (threeve 1 'a' true) +-- | ``` +flap :: forall f a b. Functor f => f (a -> b) -> a -> f b +flap ff x = map (\f -> f x) ff + +infixl 4 flap as <@> diff --git a/stdlib/lib/Data/Functor/App.purs b/stdlib/lib/Data/Functor/App.purs new file mode 100644 index 00000000..05b12079 --- /dev/null +++ b/stdlib/lib/Data/Functor/App.purs @@ -0,0 +1,56 @@ +module Data.Functor.App where + +import Prelude + +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.Apply (lift2) +import Control.Comonad (class Comonad) +import Control.Extend (class Extend) +import Control.Lazy (class Lazy) +import Control.MonadPlus (class MonadPlus) +import Control.Plus (class Plus) +import Data.Eq (class Eq1) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) +import Unsafe.Coerce (unsafeCoerce) + +newtype App :: forall k. (k -> Type) -> k -> Type +newtype App f a = App (f a) + +hoistApp :: forall f g. (f ~> g) -> App f ~> App g +hoistApp f (App fa) = App (f fa) + +hoistLiftApp :: forall f g a. f (g a) -> f (App g a) +hoistLiftApp = unsafeCoerce -- safe as newtypes have no runtime representation + +hoistLowerApp :: forall f g a. f (App g a) -> f (g a) +hoistLowerApp = unsafeCoerce -- safe as newtypes have no runtime representation + +derive instance newtypeApp :: Newtype (App f a) _ +derive instance eqApp :: (Eq1 f, Eq a) => Eq (App f a) +derive instance eq1App :: Eq1 f => Eq1 (App f) +derive instance ordApp :: (Ord1 f, Ord a) => Ord (App f a) +derive instance ord1App :: Ord1 f => Ord1 (App f) + +instance showApp :: Show (f a) => Show (App f a) where + show (App fa) = "(App " <> show fa <> ")" + +instance semigroupApp :: (Apply f, Semigroup a) => Semigroup (App f a) where + append (App fa1) (App fa2) = App (lift2 append fa1 fa2) + +instance monoidApp :: (Applicative f, Monoid a) => Monoid (App f a) where + mempty = App (pure mempty) + +derive newtype instance functorApp :: Functor f => Functor (App f) +derive newtype instance applyApp :: Apply f => Apply (App f) +derive newtype instance applicativeApp :: Applicative f => Applicative (App f) +derive newtype instance bindApp :: Bind f => Bind (App f) +derive newtype instance monadApp :: Monad f => Monad (App f) +derive newtype instance altApp :: Alt f => Alt (App f) +derive newtype instance plusApp :: Plus f => Plus (App f) +derive newtype instance alternativeApp :: Alternative f => Alternative (App f) +derive newtype instance monadPlusApp :: MonadPlus f => MonadPlus (App f) +derive newtype instance lazyApp :: Lazy (f a) => Lazy (App f a) +derive newtype instance extendApp :: Extend f => Extend (App f) +derive newtype instance comonadApp :: Comonad f => Comonad (App f) diff --git a/stdlib/lib/Data/Functor/Clown.purs b/stdlib/lib/Data/Functor/Clown.purs new file mode 100644 index 00000000..7924ed76 --- /dev/null +++ b/stdlib/lib/Data/Functor/Clown.purs @@ -0,0 +1,44 @@ +module Data.Functor.Clown where + +import Prelude + +import Control.Biapplicative (class Biapplicative) +import Control.Biapply (class Biapply) +import Data.Bifunctor (class Bifunctor) +import Data.Functor.Contravariant (class Contravariant, cmap) +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor) + +-- | This advanced type's usage and its relation to `Joker` is best understood +-- | by reading through "Clowns to the Left, Jokers to the Right (Functional +-- | Pearl)" +-- | https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.475.6134&rep=rep1&type=pdf +newtype Clown :: (Type -> Type) -> Type -> Type -> Type +newtype Clown f a b = Clown (f a) + +derive instance newtypeClown :: Newtype (Clown f a b) _ + +derive newtype instance eqClown :: Eq (f a) => Eq (Clown f a b) + +derive newtype instance ordClown :: Ord (f a) => Ord (Clown f a b) + +instance showClown :: Show (f a) => Show (Clown f a b) where + show (Clown x) = "(Clown " <> show x <> ")" + +instance functorClown :: Functor (Clown f a) where + map _ (Clown a) = Clown a + +instance bifunctorClown :: Functor f => Bifunctor (Clown f) where + bimap f _ (Clown a) = Clown (map f a) + +instance biapplyClown :: Apply f => Biapply (Clown f) where + biapply (Clown fg) (Clown xy) = Clown (fg <*> xy) + +instance biapplicativeClown :: Applicative f => Biapplicative (Clown f) where + bipure a _ = Clown (pure a) + +instance profunctorClown :: Contravariant f => Profunctor (Clown f) where + dimap f _ (Clown a) = Clown (cmap f a) + +hoistClown :: forall f g a b. (f ~> g) -> Clown f a b -> Clown g a b +hoistClown f (Clown a) = Clown (f a) diff --git a/stdlib/lib/Data/Functor/Compose.purs b/stdlib/lib/Data/Functor/Compose.purs new file mode 100644 index 00000000..7c8b68f8 --- /dev/null +++ b/stdlib/lib/Data/Functor/Compose.purs @@ -0,0 +1,58 @@ +module Data.Functor.Compose where + +import Prelude + +import Control.Alt (class Alt, alt) +import Control.Alternative (class Alternative) +import Control.Plus (class Plus, empty) +import Data.Eq (class Eq1, eq1) +import Data.Functor.App (hoistLiftApp) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1, compare1) + +-- | `Compose f g` is the composition of the two functors `f` and `g`. +newtype Compose :: forall k1 k2. (k2 -> Type) -> (k1 -> k2) -> k1 -> Type +newtype Compose f g a = Compose (f (g a)) + +bihoistCompose + :: forall f g h i + . Functor f + => (f ~> h) + -> (g ~> i) + -> Compose f g + ~> Compose h i +bihoistCompose natF natG (Compose fga) = Compose (natF (map natG fga)) + +derive instance newtypeCompose :: Newtype (Compose f g a) _ + +instance eqCompose :: (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where + eq (Compose fga1) (Compose fga2) = + eq1 (hoistLiftApp fga1) (hoistLiftApp fga2) + +derive instance eq1Compose :: (Eq1 f, Eq1 g) => Eq1 (Compose f g) + +instance ordCompose :: (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where + compare (Compose fga1) (Compose fga2) = + compare1 (hoistLiftApp fga1) (hoistLiftApp fga2) + +derive instance ord1Compose :: (Ord1 f, Ord1 g) => Ord1 (Compose f g) + +instance showCompose :: Show (f (g a)) => Show (Compose f g a) where + show (Compose fga) = "(Compose " <> show fga <> ")" + +instance functorCompose :: (Functor f, Functor g) => Functor (Compose f g) where + map f (Compose fga) = Compose $ map f <$> fga + +instance applyCompose :: (Apply f, Apply g) => Apply (Compose f g) where + apply (Compose f) (Compose x) = Compose $ apply <$> f <*> x + +instance applicativeCompose :: (Applicative f, Applicative g) => Applicative (Compose f g) where + pure = Compose <<< pure <<< pure + +instance altCompose :: (Alt f, Functor g) => Alt (Compose f g) where + alt (Compose a) (Compose b) = Compose $ alt a b + +instance plusCompose :: (Plus f, Functor g) => Plus (Compose f g) where + empty = Compose empty + +instance alternativeCompose :: (Alternative f, Applicative g) => Alternative (Compose f g) diff --git a/stdlib/lib/Data/Functor/Contravariant.purs b/stdlib/lib/Data/Functor/Contravariant.purs new file mode 100644 index 00000000..b2a7ec65 --- /dev/null +++ b/stdlib/lib/Data/Functor/Contravariant.purs @@ -0,0 +1,35 @@ +module Data.Functor.Contravariant where + +import Prelude + +import Data.Const (Const(..)) + +-- | A `Contravariant` functor can be seen as a way of changing the input type +-- | of a consumer of input, in contrast to the standard covariant `Functor` +-- | that can be seen as a way of changing the output type of a producer of +-- | output. +-- | +-- | `Contravariant` instances should satisfy the following laws: +-- | +-- | - Identity `cmap id = id` +-- | - Composition `cmap f <<< cmap g = cmap (g <<< f)` +class Contravariant f where + cmap :: forall a b. (b -> a) -> f a -> f b + +infixl 4 cmap as >$< + +-- | `cmapFlipped` is `cmap` with its arguments reversed. +cmapFlipped :: forall a b f. Contravariant f => f a -> (b -> a) -> f b +cmapFlipped x f = f >$< x + +infixl 4 cmapFlipped as >#< + +coerce :: forall f a b. Contravariant f => Functor f => f a -> f b +coerce a = absurd <$> (absurd >$< a) + +-- | As all `Contravariant` functors are also trivially `Invariant`, this function can be used as the `imap` implementation for any types that have an existing `Contravariant` instance. +imapC :: forall f a b. Contravariant f => (a -> b) -> (b -> a) -> f a -> f b +imapC _ f = cmap f + +instance contravariantConst :: Contravariant (Const a) where + cmap _ (Const x) = Const x diff --git a/stdlib/lib/Data/Functor/Coproduct.purs b/stdlib/lib/Data/Functor/Coproduct.purs new file mode 100644 index 00000000..ceac080f --- /dev/null +++ b/stdlib/lib/Data/Functor/Coproduct.purs @@ -0,0 +1,76 @@ +module Data.Functor.Coproduct where + +import Prelude + +import Control.Comonad (class Comonad, extract) +import Control.Extend (class Extend, extend) +import Data.Bifunctor (bimap) +import Data.Either (Either(..)) +import Data.Eq (class Eq1, eq1) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1, compare1) + +-- | `Coproduct f g` is the coproduct of two functors `f` and `g` +newtype Coproduct :: forall k. (k -> Type) -> (k -> Type) -> k -> Type +newtype Coproduct f g a = Coproduct (Either (f a) (g a)) + +-- | Left injection +left :: forall f g a. f a -> Coproduct f g a +left fa = Coproduct (Left fa) + +-- | Right injection +right :: forall f g a. g a -> Coproduct f g a +right ga = Coproduct (Right ga) + +-- | Eliminate a coproduct by providing eliminators for the left and +-- | right components +coproduct :: forall f g a b. (f a -> b) -> (g a -> b) -> Coproduct f g a -> b +coproduct f _ (Coproduct (Left a)) = f a +coproduct _ g (Coproduct (Right b)) = g b + +-- | Change the underlying functors in a coproduct +bihoistCoproduct + :: forall f g h i + . (f ~> h) + -> (g ~> i) + -> Coproduct f g + ~> Coproduct h i +bihoistCoproduct natF natG (Coproduct e) = Coproduct (bimap natF natG e) + +derive instance newtypeCoproduct :: Newtype (Coproduct f g a) _ + +instance eqCoproduct :: (Eq1 f, Eq1 g, Eq a) => Eq (Coproduct f g a) where + eq = eq1 + +instance eq1Coproduct :: (Eq1 f, Eq1 g) => Eq1 (Coproduct f g) where + eq1 (Coproduct x) (Coproduct y) = + case x, y of + Left fa, Left ga -> eq1 fa ga + Right fa, Right ga -> eq1 fa ga + _, _ -> false + +instance ordCoproduct :: (Ord1 f, Ord1 g, Ord a) => Ord (Coproduct f g a) where + compare = compare1 + +instance ord1Coproduct :: (Ord1 f, Ord1 g) => Ord1 (Coproduct f g) where + compare1 (Coproduct x) (Coproduct y) = + case x, y of + Left fa, Left ga -> compare1 fa ga + Left _, _ -> LT + _, Left _ -> GT + Right fa, Right ga -> compare1 fa ga + +instance showCoproduct :: (Show (f a), Show (g a)) => Show (Coproduct f g a) where + show (Coproduct (Left fa)) = "(left " <> show fa <> ")" + show (Coproduct (Right ga)) = "(right " <> show ga <> ")" + +instance functorCoproduct :: (Functor f, Functor g) => Functor (Coproduct f g) where + map f (Coproduct e) = Coproduct (bimap (map f) (map f) e) + +instance extendCoproduct :: (Extend f, Extend g) => Extend (Coproduct f g) where + extend f = Coproduct <<< coproduct + (Left <<< extend (f <<< Coproduct <<< Left)) + (Right <<< extend (f <<< Coproduct <<< Right)) + +instance comonadCoproduct :: (Comonad f, Comonad g) => Comonad (Coproduct f g) where + extract = coproduct extract extract diff --git a/stdlib/lib/Data/Functor/Coproduct/Inject.purs b/stdlib/lib/Data/Functor/Coproduct/Inject.purs new file mode 100644 index 00000000..6f8f136e --- /dev/null +++ b/stdlib/lib/Data/Functor/Coproduct/Inject.purs @@ -0,0 +1,24 @@ +module Data.Functor.Coproduct.Inject where + +import Prelude + +import Data.Either (Either(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Maybe (Maybe(..)) + +class Inject :: forall k. (k -> Type) -> (k -> Type) -> Constraint +class Inject f g where + inj :: forall a. f a -> g a + prj :: forall a. g a -> Maybe (f a) + +instance injectReflexive :: Inject f f where + inj = identity + prj = Just + +else instance injectLeft :: Inject f (Coproduct f g) where + inj = Coproduct <<< Left + prj = coproduct Just (const Nothing) + +else instance injectRight :: Inject f g => Inject f (Coproduct h g) where + inj = Coproduct <<< Right <<< inj + prj = coproduct (const Nothing) prj diff --git a/stdlib/lib/Data/Functor/Coproduct/Nested.purs b/stdlib/lib/Data/Functor/Coproduct/Nested.purs new file mode 100644 index 00000000..9e37903e --- /dev/null +++ b/stdlib/lib/Data/Functor/Coproduct/Nested.purs @@ -0,0 +1,273 @@ +module Data.Functor.Coproduct.Nested where + +import Prelude + +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct, left, right) +import Data.Newtype (unwrap) + +type Coproduct1 :: forall k. (k -> Type) -> k -> Type +type Coproduct1 a = C2 a (Const Void) +type Coproduct2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct2 a b = C3 a b (Const Void) +type Coproduct3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct3 a b c = C4 a b c (Const Void) +type Coproduct4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct4 a b c d = C5 a b c d (Const Void) +type Coproduct5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct5 a b c d e = C6 a b c d e (Const Void) +type Coproduct6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct6 a b c d e f = C7 a b c d e f (Const Void) +type Coproduct7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct7 a b c d e f g = C8 a b c d e f g (Const Void) +type Coproduct8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct8 a b c d e f g h = C9 a b c d e f g h (Const Void) +type Coproduct9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct9 a b c d e f g h i = C10 a b c d e f g h i (Const Void) +type Coproduct10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Coproduct10 a b c d e f g h i j = C11 a b c d e f g h i j (Const Void) + +type C2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type +type C2 a z = Coproduct a z +type C3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C3 a b z = Coproduct a (C2 b z) +type C4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C4 a b c z = Coproduct a (C3 b c z) +type C5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C5 a b c d z = Coproduct a (C4 b c d z) +type C6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C6 a b c d e z = Coproduct a (C5 b c d e z) +type C7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C7 a b c d e f z = Coproduct a (C6 b c d e f z) +type C8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C8 a b c d e f g z = Coproduct a (C7 b c d e f g z) +type C9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C9 a b c d e f g h z = Coproduct a (C8 b c d e f g h z) +type C10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C10 a b c d e f g h i z = Coproduct a (C9 b c d e f g h i z) +type C11 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type C11 a b c d e f g h i j z = Coproduct a (C10 b c d e f g h i j z) + +infixr 6 coproduct as <\/> +infixr 6 type Coproduct as <\/> + +in1 :: forall a z. a ~> C2 a z +in1 = left + +in2 :: forall a b z. b ~> C3 a b z +in2 v = right (left v) + +in3 :: forall a b c z. c ~> C4 a b c z +in3 v = right (right (left v)) + +in4 :: forall a b c d z. d ~> C5 a b c d z +in4 v = right (right (right (left v))) + +in5 :: forall a b c d e z. e ~> C6 a b c d e z +in5 v = right (right (right (right (left v)))) + +in6 :: forall a b c d e f z. f ~> C7 a b c d e f z +in6 v = right (right (right (right (right (left v))))) + +in7 :: forall a b c d e f g z. g ~> C8 a b c d e f g z +in7 v = right (right (right (right (right (right (left v)))))) + +in8 :: forall a b c d e f g h z. h ~> C9 a b c d e f g h z +in8 v = right (right (right (right (right (right (right (left v))))))) + +in9 :: forall a b c d e f g h i z. i ~> C10 a b c d e f g h i z +in9 v = right (right (right (right (right (right (right (right (left v)))))))) + +in10 :: forall a b c d e f g h i j z. j ~> C11 a b c d e f g h i j z +in10 v = right (right (right (right (right (right (right (right (right (left v))))))))) + +at1 :: forall r x a z. r -> (a x -> r) -> C2 a z x -> r +at1 b f y = case y of + Coproduct (Left r) -> f r + _ -> b + +at2 :: forall r x a b z. r -> (b x -> r) -> C3 a b z x -> r +at2 b f y = case y of + Coproduct (Right (Coproduct (Left r))) -> f r + _ -> b + +at3 :: forall r x a b c z. r -> (c x -> r) -> C4 a b c z x -> r +at3 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Left r))))) -> f r + _ -> b + +at4 :: forall r x a b c d z. r -> (d x -> r) -> C5 a b c d z x -> r +at4 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))) -> f r + _ -> b + +at5 :: forall r x a b c d e z. r -> (e x -> r) -> C6 a b c d e z x -> r +at5 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))) -> f r + _ -> b + +at6 :: forall r x a b c d e f z. r -> (f x -> r) -> C7 a b c d e f z x -> r +at6 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))) -> f r + _ -> b + +at7 :: forall r x a b c d e f g z. r -> (g x -> r) -> C8 a b c d e f g z x -> r +at7 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))) -> f r + _ -> b + +at8 :: forall r x a b c d e f g h z. r -> (h x -> r) -> C9 a b c d e f g h z x -> r +at8 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))))) -> f r + _ -> b + +at9 :: forall r x a b c d e f g h i z. r -> (i x -> r) -> C10 a b c d e f g h i z x -> r +at9 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))))))) -> f r + _ -> b + +at10 :: forall r x a b c d e f g h i j z. r -> (j x -> r) -> C11 a b c d e f g h i j z x -> r +at10 b f y = case y of + Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))))))))) -> f r + _ -> b + +coproduct1 :: forall a. Coproduct1 a ~> a +coproduct1 y = case y of + Coproduct (Left r) -> r + Coproduct (Right _1) -> absurd (unwrap _1) + +coproduct2 :: forall r x a b. (a x -> r) -> (b x -> r) -> Coproduct2 a b x -> r +coproduct2 a b y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> absurd (unwrap _2) + +coproduct3 :: forall r x a b c. (a x -> r) -> (b x -> r) -> (c x -> r) -> Coproduct3 a b c x -> r +coproduct3 a b c y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> absurd (unwrap _3) + +coproduct4 :: forall r x a b c d. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> Coproduct4 a b c d x -> r +coproduct4 a b c d y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> absurd (unwrap _4) + +coproduct5 :: forall r x a b c d e. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> Coproduct5 a b c d e x -> r +coproduct5 a b c d e y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> case _4 of + Coproduct (Left r) -> e r + Coproduct (Right _5) -> absurd (unwrap _5) + +coproduct6 :: forall r x a b c d e f. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> Coproduct6 a b c d e f x -> r +coproduct6 a b c d e f y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> case _4 of + Coproduct (Left r) -> e r + Coproduct (Right _5) -> case _5 of + Coproduct (Left r) -> f r + Coproduct (Right _6) -> absurd (unwrap _6) + +coproduct7 :: forall r x a b c d e f g. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> Coproduct7 a b c d e f g x -> r +coproduct7 a b c d e f g y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> case _4 of + Coproduct (Left r) -> e r + Coproduct (Right _5) -> case _5 of + Coproduct (Left r) -> f r + Coproduct (Right _6) -> case _6 of + Coproduct (Left r) -> g r + Coproduct (Right _7) -> absurd (unwrap _7) + +coproduct8 :: forall r x a b c d e f g h. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> (h x -> r) -> Coproduct8 a b c d e f g h x -> r +coproduct8 a b c d e f g h y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> case _4 of + Coproduct (Left r) -> e r + Coproduct (Right _5) -> case _5 of + Coproduct (Left r) -> f r + Coproduct (Right _6) -> case _6 of + Coproduct (Left r) -> g r + Coproduct (Right _7) -> case _7 of + Coproduct (Left r) -> h r + Coproduct (Right _8) -> absurd (unwrap _8) + +coproduct9 :: forall r x a b c d e f g h i. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> (h x -> r) -> (i x -> r) -> Coproduct9 a b c d e f g h i x -> r +coproduct9 a b c d e f g h i y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> case _4 of + Coproduct (Left r) -> e r + Coproduct (Right _5) -> case _5 of + Coproduct (Left r) -> f r + Coproduct (Right _6) -> case _6 of + Coproduct (Left r) -> g r + Coproduct (Right _7) -> case _7 of + Coproduct (Left r) -> h r + Coproduct (Right _8) -> case _8 of + Coproduct (Left r) -> i r + Coproduct (Right _9) -> absurd (unwrap _9) + +coproduct10 :: forall r x a b c d e f g h i j. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> (h x -> r) -> (i x -> r) -> (j x -> r) -> Coproduct10 a b c d e f g h i j x -> r +coproduct10 a b c d e f g h i j y = case y of + Coproduct (Left r) -> a r + Coproduct (Right _1) -> case _1 of + Coproduct (Left r) -> b r + Coproduct (Right _2) -> case _2 of + Coproduct (Left r) -> c r + Coproduct (Right _3) -> case _3 of + Coproduct (Left r) -> d r + Coproduct (Right _4) -> case _4 of + Coproduct (Left r) -> e r + Coproduct (Right _5) -> case _5 of + Coproduct (Left r) -> f r + Coproduct (Right _6) -> case _6 of + Coproduct (Left r) -> g r + Coproduct (Right _7) -> case _7 of + Coproduct (Left r) -> h r + Coproduct (Right _8) -> case _8 of + Coproduct (Left r) -> i r + Coproduct (Right _9) -> case _9 of + Coproduct (Left r) -> j r + Coproduct (Right _10) -> absurd (unwrap _10) diff --git a/stdlib/lib/Data/Functor/Costar.purs b/stdlib/lib/Data/Functor/Costar.purs new file mode 100644 index 00000000..edffe4e9 --- /dev/null +++ b/stdlib/lib/Data/Functor/Costar.purs @@ -0,0 +1,66 @@ +module Data.Functor.Costar where + +import Prelude + +import Control.Comonad (class Comonad, extract) +import Control.Extend (class Extend, (=<=)) +import Data.Bifunctor (class Bifunctor) +import Data.Distributive (class Distributive, distribute) +import Data.Functor.Contravariant (class Contravariant, cmap) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor, lcmap) +import Data.Profunctor.Closed (class Closed) +import Data.Profunctor.Strong (class Strong) +import Data.Tuple (Tuple(..), fst, snd) + +-- | `Costar` turns a `Functor` into a `Profunctor` "backwards". +-- | +-- | `Costar f` is also the co-Kleisli category for `f`. +newtype Costar :: (Type -> Type) -> Type -> Type -> Type +newtype Costar f b a = Costar (f b -> a) + +derive instance newtypeCostar :: Newtype (Costar f a b) _ + +instance semigroupoidCostar :: Extend f => Semigroupoid (Costar f) where + compose (Costar f) (Costar g) = Costar (f =<= g) + +instance categoryCostar :: Comonad f => Category (Costar f) where + identity = Costar extract + +instance functorCostar :: Functor (Costar f a) where + map f (Costar g) = Costar (f <<< g) + +instance invariantCostar :: Invariant (Costar f a) where + imap = imapF + +instance applyCostar :: Apply (Costar f a) where + apply (Costar f) (Costar g) = Costar \a -> f a (g a) + +instance applicativeCostar :: Applicative (Costar f a) where + pure a = Costar \_ -> a + +instance bindCostar :: Bind (Costar f a) where + bind (Costar m) f = Costar \x -> case f (m x) of Costar g -> g x + +instance monadCostar :: Monad (Costar f a) + +instance distributiveCostar :: Distributive (Costar f a) where + distribute f = Costar \a -> map (\(Costar g) -> g a) f + collect f = distribute <<< map f + +instance bifunctorCostar :: Contravariant f => Bifunctor (Costar f) where + bimap f g (Costar h) = Costar (cmap f >>> h >>> g) + +instance profunctorCostar :: Functor f => Profunctor (Costar f) where + dimap f g (Costar h) = Costar (map f >>> h >>> g) + +instance strongCostar :: Comonad f => Strong (Costar f) where + first (Costar f) = Costar \x -> Tuple (f (map fst x)) (snd (extract x)) + second (Costar f) = Costar \x -> Tuple (fst (extract x)) (f (map snd x)) + +instance closedCostar :: Functor f => Closed (Costar f) where + closed (Costar f) = Costar \g x -> f (map (_ $ x) g) + +hoistCostar :: forall f g a b. (g ~> f) -> Costar f a b -> Costar g a b +hoistCostar f (Costar g) = Costar (lcmap f g) diff --git a/stdlib/lib/Data/Functor/Flip.purs b/stdlib/lib/Data/Functor/Flip.purs new file mode 100644 index 00000000..baf98e14 --- /dev/null +++ b/stdlib/lib/Data/Functor/Flip.purs @@ -0,0 +1,44 @@ +module Data.Functor.Flip where + +import Prelude + +import Control.Biapplicative (class Biapplicative, bipure) +import Control.Biapply (class Biapply, (<<*>>)) +import Data.Bifunctor (class Bifunctor, bimap, lmap) +import Data.Functor.Contravariant (class Contravariant) +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor, lcmap) + +-- | Flips the order of the type arguments of a `Bifunctor`. +newtype Flip :: forall k1 k2. (k1 -> k2 -> Type) -> k2 -> k1 -> Type +newtype Flip p a b = Flip (p b a) + +derive instance newtypeFlip :: Newtype (Flip p a b) _ + +derive newtype instance eqFlip :: Eq (p b a) => Eq (Flip p a b) + +derive newtype instance ordFlip :: Ord (p b a) => Ord (Flip p a b) + +instance showFlip :: Show (p a b) => Show (Flip p b a) where + show (Flip x) = "(Flip " <> show x <> ")" + +instance functorFlip :: Bifunctor p => Functor (Flip p a) where + map f (Flip a) = Flip (lmap f a) + +instance bifunctorFlip :: Bifunctor p => Bifunctor (Flip p) where + bimap f g (Flip a) = Flip (bimap g f a) + +instance biapplyFlip :: Biapply p => Biapply (Flip p) where + biapply (Flip fg) (Flip xy) = Flip (fg <<*>> xy) + +instance biapplicativeFlip :: Biapplicative p => Biapplicative (Flip p) where + bipure a b = Flip (bipure b a) + +instance contravariantFlip :: Profunctor p => Contravariant (Flip p b) where + cmap f (Flip a) = Flip (lcmap f a) + +instance semigroupoidFlip :: Semigroupoid p => Semigroupoid (Flip p) where + compose (Flip a) (Flip b) = Flip $ compose b a + +instance categoryFlip :: Category p => Category (Flip p) where + identity = Flip identity diff --git a/stdlib/lib/Data/Functor/Invariant.purs b/stdlib/lib/Data/Functor/Invariant.purs new file mode 100644 index 00000000..d9756c6e --- /dev/null +++ b/stdlib/lib/Data/Functor/Invariant.purs @@ -0,0 +1,57 @@ +module Data.Functor.Invariant where + +import Control.Semigroupoid ((<<<)) +import Data.Functor (class Functor, map) +import Data.Monoid.Additive (Additive(..)) +import Data.Monoid.Conj (Conj(..)) +import Data.Monoid.Disj (Disj(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Endo (Endo(..)) +import Data.Monoid.Multiplicative (Multiplicative(..)) +import Data.Monoid.Alternate (Alternate(..)) + +-- | A type of functor that can be used to adapt the type of a wrapped function +-- | where the parameterised type occurs in both the positive and negative +-- | position, for example, `F (a -> a)`. +-- | +-- | An `Invariant` instance should satisfy the following laws: +-- | +-- | - Identity: `imap id id = id` +-- | - Composition: `imap g1 g2 <<< imap f1 f2 = imap (g1 <<< f1) (f2 <<< g2)` +-- | +class Invariant :: (Type -> Type) -> Constraint +class Invariant f where + imap :: forall a b. (a -> b) -> (b -> a) -> f a -> f b + +instance invariantFn :: Invariant ((->) a) where + imap = imapF + +instance invariantArray :: Invariant Array where + imap = imapF + +instance invariantAdditive :: Invariant Additive where + imap f _ (Additive x) = Additive (f x) + +instance invariantConj :: Invariant Conj where + imap f _ (Conj x) = Conj (f x) + +instance invariantDisj :: Invariant Disj where + imap f _ (Disj x) = Disj (f x) + +instance invariantDual :: Invariant Dual where + imap f _ (Dual x) = Dual (f x) + +instance invariantEndo :: Invariant (Endo Function) where + imap ab ba (Endo f) = Endo (ab <<< f <<< ba) + +instance invariantMultiplicative :: Invariant Multiplicative where + imap f _ (Multiplicative x) = Multiplicative (f x) + +instance invariantAlternate :: Invariant f => Invariant (Alternate f) where + imap f g (Alternate x) = Alternate (imap f g x) + +-- | As all `Functor`s are also trivially `Invariant`, this function can be +-- | used as the `imap` implementation for any types that has an existing +-- | `Functor` instance. +imapF :: forall f a b. Functor f => (a -> b) -> (b -> a) -> f a -> f b +imapF f _ = map f diff --git a/stdlib/lib/Data/Functor/Joker.purs b/stdlib/lib/Data/Functor/Joker.purs new file mode 100644 index 00000000..97e43fbb --- /dev/null +++ b/stdlib/lib/Data/Functor/Joker.purs @@ -0,0 +1,60 @@ +module Data.Functor.Joker where + +import Prelude + +import Control.Biapplicative (class Biapplicative) +import Control.Biapply (class Biapply) +import Data.Bifunctor (class Bifunctor) +import Data.Either (Either(..)) +import Data.Newtype (class Newtype, un) +import Data.Profunctor (class Profunctor) +import Data.Profunctor.Choice (class Choice) + +-- | This advanced type's usage and its relation to `Clown` is best understood +-- | by reading through "Clowns to the Left, Jokers to the Right (Functional +-- | Pearl)" +-- | https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.475.6134&rep=rep1&type=pdf +newtype Joker :: (Type -> Type) -> Type -> Type -> Type +newtype Joker g a b = Joker (g b) + +derive instance newtypeJoker :: Newtype (Joker f a b) _ + +derive newtype instance eqJoker :: Eq (f b) => Eq (Joker f a b) + +derive newtype instance ordJoker :: Ord (f b) => Ord (Joker f a b) + +instance showJoker :: Show (f b) => Show (Joker f a b) where + show (Joker x) = "(Joker " <> show x <> ")" + +instance functorJoker :: Functor f => Functor (Joker f a) where + map f (Joker a) = Joker (map f a) + +instance applyJoker :: Apply f => Apply (Joker f a) where + apply (Joker f) (Joker g) = Joker $ apply f g + +instance applicativeJoker :: Applicative f => Applicative (Joker f a) where + pure = Joker <<< pure + +instance bindJoker :: Bind f => Bind (Joker f a) where + bind (Joker ma) amb = Joker $ ma >>= (amb >>> un Joker) + +instance monadJoker :: Monad m => Monad (Joker m a) + +instance bifunctorJoker :: Functor g => Bifunctor (Joker g) where + bimap _ g (Joker a) = Joker (map g a) + +instance biapplyJoker :: Apply g => Biapply (Joker g) where + biapply (Joker fg) (Joker xy) = Joker (fg <*> xy) + +instance biapplicativeJoker :: Applicative g => Biapplicative (Joker g) where + bipure _ b = Joker (pure b) + +instance profunctorJoker :: Functor f => Profunctor (Joker f) where + dimap _ g (Joker a) = Joker (map g a) + +instance choiceJoker :: Functor f => Choice (Joker f) where + left (Joker f) = Joker $ map Left f + right (Joker f) = Joker $ map Right f + +hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b +hoistJoker f (Joker a) = Joker (f a) diff --git a/stdlib/lib/Data/Functor/Product.purs b/stdlib/lib/Data/Functor/Product.purs new file mode 100644 index 00000000..53ac8647 --- /dev/null +++ b/stdlib/lib/Data/Functor/Product.purs @@ -0,0 +1,60 @@ +module Data.Functor.Product where + +import Prelude + +import Data.Bifunctor (bimap) +import Data.Eq (class Eq1, eq1) +import Data.Newtype (class Newtype, unwrap) +import Data.Ord (class Ord1, compare1) +import Data.Tuple (Tuple(..), fst, snd) + +-- | `Product f g` is the product of the two functors `f` and `g`. +newtype Product :: forall k. (k -> Type) -> (k -> Type) -> k -> Type +newtype Product f g a = Product (Tuple (f a) (g a)) + +-- | Create a product. +product :: forall f g a. f a -> g a -> Product f g a +product fa ga = Product (Tuple fa ga) + +bihoistProduct + :: forall f g h i + . (f ~> h) + -> (g ~> i) + -> Product f g + ~> Product h i +bihoistProduct natF natG (Product e) = Product (bimap natF natG e) + +derive instance newtypeProduct :: Newtype (Product f g a) _ + +instance eqProduct :: (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) where + eq = eq1 + +instance eq1Product :: (Eq1 f, Eq1 g) => Eq1 (Product f g) where + eq1 (Product (Tuple l1 r1)) (Product (Tuple l2 r2)) = eq1 l1 l2 && eq1 r1 r2 + +instance ordProduct :: (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where + compare = compare1 + +instance ord1Product :: (Ord1 f, Ord1 g) => Ord1 (Product f g) where + compare1 (Product (Tuple l1 r1)) (Product (Tuple l2 r2)) = + case compare1 l1 l2 of + EQ -> compare1 r1 r2 + o -> o + +instance showProduct :: (Show (f a), Show (g a)) => Show (Product f g a) where + show (Product (Tuple fa ga)) = "(product " <> show fa <> " " <> show ga <> ")" + +instance functorProduct :: (Functor f, Functor g) => Functor (Product f g) where + map f (Product fga) = Product (bimap (map f) (map f) fga) + +instance applyProduct :: (Apply f, Apply g) => Apply (Product f g) where + apply (Product (Tuple f g)) (Product (Tuple a b)) = product (apply f a) (apply g b) + +instance applicativeProduct :: (Applicative f, Applicative g) => Applicative (Product f g) where + pure a = product (pure a) (pure a) + +instance bindProduct :: (Bind f, Bind g) => Bind (Product f g) where + bind (Product (Tuple fa ga)) f = + product (fa >>= fst <<< unwrap <<< f) (ga >>= snd <<< unwrap <<< f) + +instance monadProduct :: (Monad f, Monad g) => Monad (Product f g) diff --git a/stdlib/lib/Data/Functor/Product/Nested.purs b/stdlib/lib/Data/Functor/Product/Nested.purs new file mode 100644 index 00000000..8ec70a94 --- /dev/null +++ b/stdlib/lib/Data/Functor/Product/Nested.purs @@ -0,0 +1,112 @@ +module Data.Functor.Product.Nested where + +import Prelude + +import Data.Const (Const(..)) +import Data.Functor.Product (Product(..), product) +import Data.Tuple (Tuple(..)) + +type Product1 :: forall k. (k -> Type) -> k -> Type +type Product1 a = T2 a (Const Unit) +type Product2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type +type Product2 a b = T3 a b (Const Unit) +type Product3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product3 a b c = T4 a b c (Const Unit) +type Product4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product4 a b c d = T5 a b c d (Const Unit) +type Product5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product5 a b c d e= T6 a b c d e (Const Unit) +type Product6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product6 a b c d e f = T7 a b c d e f (Const Unit) +type Product7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product7 a b c d e f g = T8 a b c d e f g (Const Unit) +type Product8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product8 a b c d e f g h = T9 a b c d e f g h (Const Unit) +type Product9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product9 a b c d e f g h i = T10 a b c d e f g h i (Const Unit) +type Product10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type Product10 a b c d e f g h i j = T11 a b c d e f g h i j (Const Unit) + +type T2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type +type T2 a z = Product a z +type T3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T3 a b z = Product a (T2 b z) +type T4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T4 a b c z = Product a (T3 b c z) +type T5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T5 a b c d z = Product a (T4 b c d z) +type T6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T6 a b c d e z = Product a (T5 b c d e z) +type T7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T7 a b c d e f z = Product a (T6 b c d e f z) +type T8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T8 a b c d e f g z = Product a (T7 b c d e f g z) +type T9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T9 a b c d e f g h z = Product a (T8 b c d e f g h z) +type T10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T10 a b c d e f g h i z = Product a (T9 b c d e f g h i z) +type T11 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type +type T11 a b c d e f g h i j z = Product a (T10 b c d e f g h i j z) + +infixr 6 product as +infixr 6 type Product as + +product1 :: forall a. a ~> Product1 a +product1 a = a Const unit + +product2 :: forall a b x. a x -> b x -> Product2 a b x +product2 a b = a b Const unit + +product3 :: forall a b c x. a x -> b x -> c x -> Product3 a b c x +product3 a b c = a b c Const unit + +product4 :: forall a b c d x. a x -> b x -> c x -> d x -> Product4 a b c d x +product4 a b c d = a b c d Const unit + +product5 :: forall a b c d e x. a x -> b x -> c x -> d x -> e x -> Product5 a b c d e x +product5 a b c d e = a b c d e Const unit + +product6 :: forall a b c d e f x. a x -> b x -> c x -> d x -> e x -> f x -> Product6 a b c d e f x +product6 a b c d e f = a b c d e f Const unit + +product7 :: forall a b c d e f g x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> Product7 a b c d e f g x +product7 a b c d e f g = a b c d e f g Const unit + +product8 :: forall a b c d e f g h x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> h x -> Product8 a b c d e f g h x +product8 a b c d e f g h = a b c d e f g h Const unit + +product9 :: forall a b c d e f g h i x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> h x -> i x -> Product9 a b c d e f g h i x +product9 a b c d e f g h i = a b c d e f g h i Const unit + +product10 :: forall a b c d e f g h i j x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> h x -> i x -> j x -> Product10 a b c d e f g h i j x +product10 a b c d e f g h i j = a b c d e f g h i j Const unit + +get1 :: forall a z. T2 a z ~> a +get1 (Product (Tuple a _)) = a + +get2 :: forall a b z. T3 a b z ~> b +get2 (Product (Tuple _ (Product (Tuple b _)))) = b + +get3 :: forall a b c z. T4 a b c z ~> c +get3 (Product (Tuple _ (Product (Tuple _ (Product (Tuple c _)))))) = c + +get4 :: forall a b c d z. T5 a b c d z ~> d +get4 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple d _)))))))) = d + +get5 :: forall a b c d e z. T6 a b c d e z ~> e +get5 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple e _)))))))))) = e + +get6 :: forall a b c d e f z. T7 a b c d e f z ~> f +get6 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple f _)))))))))))) = f + +get7 :: forall a b c d e f g z. T8 a b c d e f g z ~> g +get7 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple g _)))))))))))))) = g + +get8 :: forall a b c d e f g h z. T9 a b c d e f g h z ~> h +get8 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple h _)))))))))))))))) = h + +get9 :: forall a b c d e f g h i z. T10 a b c d e f g h i z ~> i +get9 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple i _)))))))))))))))))) = i + +get10 :: forall a b c d e f g h i j z. T11 a b c d e f g h i j z ~> j +get10 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple j _)))))))))))))))))))) = j diff --git a/stdlib/lib/Data/Functor/Product2.purs b/stdlib/lib/Data/Functor/Product2.purs new file mode 100644 index 00000000..5dc1fe97 --- /dev/null +++ b/stdlib/lib/Data/Functor/Product2.purs @@ -0,0 +1,40 @@ +module Data.Functor.Product2 where + +import Prelude + +import Control.Biapplicative (class Biapplicative, bipure) +import Control.Biapply (class Biapply, biapply) +import Data.Bifunctor (class Bifunctor, bimap) +import Data.Profunctor (class Profunctor, dimap) + +-- | The product of two types that both take two type parameters (e.g. `Either`, +-- | `Tuple, etc.) where both type parameters are the same. +-- | +-- | ```purescript +-- | Product2 (Tuple 4 true) (Right false) :: Product2 Tuple Either Int Boolean +-- | Product2 (Tuple 4 true) (Left 8) :: Product2 Tuple Either Int Boolean +-- | ``` +data Product2 :: (Type -> Type -> Type) -> (Type -> Type -> Type) -> Type -> Type -> Type +data Product2 f g a b = Product2 (f a b) (g a b) + +derive instance eqProduct2 :: (Eq (f a b), Eq (g a b)) => Eq (Product2 f g a b) + +derive instance ordProduct2 :: (Ord (f a b), Ord (g a b)) => Ord (Product2 f g a b) + +instance showProduct2 :: (Show (f a b), Show (g a b)) => Show (Product2 f g a b) where + show (Product2 x y) = "(Product2 " <> show x <> " " <> show y <> ")" + +instance functorProduct2 :: (Functor (f a), Functor (g a)) => Functor (Product2 f g a) where + map f (Product2 x y) = Product2 (map f x) (map f y) + +instance bifunctorProduct2 :: (Bifunctor f, Bifunctor g) => Bifunctor (Product2 f g) where + bimap f g (Product2 x y) = Product2 (bimap f g x) (bimap f g y) + +instance biapplyProduct2 :: (Biapply f, Biapply g) => Biapply (Product2 f g) where + biapply (Product2 w x) (Product2 y z) = Product2 (biapply w y) (biapply x z) + +instance biapplicativeProduct2 :: (Biapplicative f, Biapplicative g) => Biapplicative (Product2 f g) where + bipure a b = Product2 (bipure a b) (bipure a b) + +instance profunctorProduct2 :: (Profunctor f, Profunctor g) => Profunctor (Product2 f g) where + dimap f g (Product2 x y) = Product2 (dimap f g x) (dimap f g y) diff --git a/stdlib/lib/Data/FunctorWithIndex.purs b/stdlib/lib/Data/FunctorWithIndex.purs new file mode 100644 index 00000000..a02a68c6 --- /dev/null +++ b/stdlib/lib/Data/FunctorWithIndex.purs @@ -0,0 +1,94 @@ +module Data.FunctorWithIndex + ( class FunctorWithIndex, mapWithIndex, mapDefault + ) where + +import Prelude + +import Data.Bifunctor (bimap) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..)) +import Data.Functor.Product (Product(..)) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe) +import Data.Maybe.First (First) +import Data.Maybe.Last (Last) +import Data.Monoid.Additive (Additive) +import Data.Monoid.Conj (Conj) +import Data.Monoid.Disj (Disj) +import Data.Monoid.Dual (Dual) +import Data.Monoid.Multiplicative (Multiplicative) +import Data.Tuple (Tuple, curry) + +-- | A `Functor` with an additional index. +-- | Instances must satisfy a modified form of the `Functor` laws +-- | ```purescript +-- | mapWithIndex (\_ a -> a) = identity +-- | mapWithIndex f . mapWithIndex g = mapWithIndex (\i -> f i <<< g i) +-- | ``` +-- | and be compatible with the `Functor` instance +-- | ```purescript +-- | map f = mapWithIndex (const f) +-- | ``` +class Functor f <= FunctorWithIndex i f | f -> i where + mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b + +mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b +mapWithIndexArray a0 a1 = mapWithIndexArray a0 a1 + +instance functorWithIndexArray :: FunctorWithIndex Int Array where + mapWithIndex = mapWithIndexArray + +instance functorWithIndexMaybe :: FunctorWithIndex Unit Maybe where + mapWithIndex f = map $ f unit + +instance functorWithIndexFirst :: FunctorWithIndex Unit First where + mapWithIndex f = map $ f unit + +instance functorWithIndexLast :: FunctorWithIndex Unit Last where + mapWithIndex f = map $ f unit + +instance functorWithIndexAdditive :: FunctorWithIndex Unit Additive where + mapWithIndex f = map $ f unit + +instance functorWithIndexDual :: FunctorWithIndex Unit Dual where + mapWithIndex f = map $ f unit + +instance functorWithIndexConj :: FunctorWithIndex Unit Conj where + mapWithIndex f = map $ f unit + +instance functorWithIndexDisj :: FunctorWithIndex Unit Disj where + mapWithIndex f = map $ f unit + +instance functorWithIndexMultiplicative :: FunctorWithIndex Unit Multiplicative where + mapWithIndex f = map $ f unit + +instance functorWithIndexEither :: FunctorWithIndex Unit (Either a) where + mapWithIndex f = map $ f unit + +instance functorWithIndexTuple :: FunctorWithIndex Unit (Tuple a) where + mapWithIndex f = map $ f unit + +instance functorWithIndexIdentity :: FunctorWithIndex Unit Identity where + mapWithIndex f (Identity a) = Identity (f unit a) + +instance functorWithIndexConst :: FunctorWithIndex Void (Const a) where + mapWithIndex _ (Const x) = Const x + +instance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where + mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga) + +instance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where + mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e) + +instance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where + mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga + +instance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f) where + mapWithIndex f (App x) = App $ mapWithIndex f x + +-- | A default implementation of Functor's `map` in terms of `mapWithIndex` +mapDefault :: forall i f a b. FunctorWithIndex i f => (a -> b) -> f a -> f b +mapDefault f = mapWithIndex (const f) diff --git a/stdlib/lib/Data/Generic/Rep.purs b/stdlib/lib/Data/Generic/Rep.purs new file mode 100644 index 00000000..c3de434a --- /dev/null +++ b/stdlib/lib/Data/Generic/Rep.purs @@ -0,0 +1,62 @@ +module Data.Generic.Rep + ( class Generic + , to + , from + , repOf + , NoConstructors + , NoArguments(..) + , Sum(..) + , Product(..) + , Constructor(..) + , Argument(..) + ) where + +import Data.Semigroup ((<>)) +import Data.Show (class Show, show) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Void (Void) +import Type.Proxy (Proxy(..)) + +-- | A representation for types with no constructors. +newtype NoConstructors = NoConstructors Void + +-- | A representation for constructors with no arguments. +data NoArguments = NoArguments + +instance showNoArguments :: Show NoArguments where + show _ = "NoArguments" + +-- | A representation for types with multiple constructors. +data Sum a b = Inl a | Inr b + +instance showSum :: (Show a, Show b) => Show (Sum a b) where + show (Inl a) = "(Inl " <> show a <> ")" + show (Inr b) = "(Inr " <> show b <> ")" + +-- | A representation for constructors with multiple fields. +data Product a b = Product a b + +instance showProduct :: (Show a, Show b) => Show (Product a b) where + show (Product a b) = "(Product " <> show a <> " " <> show b <> ")" + +-- | A representation for constructors which includes the data constructor name +-- | as a type-level string. +newtype Constructor (name :: Symbol) a = Constructor a + +instance showConstructor :: (IsSymbol name, Show a) => Show (Constructor name a) where + show (Constructor a) = "(Constructor @" <> show (reflectSymbol (Proxy :: Proxy name)) <> " " <> show a <> ")" + +-- | A representation for an argument in a data constructor. +newtype Argument a = Argument a + +instance showArgument :: Show a => Show (Argument a) where + show (Argument a) = "(Argument " <> show a <> ")" + +-- | The `Generic` class asserts the existence of a type function from types +-- | to their representations using the type constructors defined in this module. +class Generic a rep | a -> rep where + to :: rep -> a + from :: a -> rep + +repOf :: forall a rep. Generic a rep => Proxy a -> Proxy rep +repOf _ = Proxy diff --git a/stdlib/lib/Data/HeytingAlgebra.purs b/stdlib/lib/Data/HeytingAlgebra.purs new file mode 100644 index 00000000..1bfc9da9 --- /dev/null +++ b/stdlib/lib/Data/HeytingAlgebra.purs @@ -0,0 +1,174 @@ +module Data.HeytingAlgebra + ( class HeytingAlgebra + , tt + , ff + , implies + , conj + , disj + , not + , (&&) + , (||) + , class HeytingAlgebraRecord + , ffRecord + , ttRecord + , impliesRecord + , conjRecord + , disjRecord + , notRecord + ) where + +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit, unit) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeGet, unsafeSet) +import Type.Proxy (Proxy(..)) + +-- | The `HeytingAlgebra` type class represents types that are bounded lattices with +-- | an implication operator such that the following laws hold: +-- | +-- | - Associativity: +-- | - `a || (b || c) = (a || b) || c` +-- | - `a && (b && c) = (a && b) && c` +-- | - Commutativity: +-- | - `a || b = b || a` +-- | - `a && b = b && a` +-- | - Absorption: +-- | - `a || (a && b) = a` +-- | - `a && (a || b) = a` +-- | - Idempotent: +-- | - `a || a = a` +-- | - `a && a = a` +-- | - Identity: +-- | - `a || ff = a` +-- | - `a && tt = a` +-- | - Implication: +-- | - ``a `implies` a = tt`` +-- | - ``a && (a `implies` b) = a && b`` +-- | - ``b && (a `implies` b) = b`` +-- | - ``a `implies` (b && c) = (a `implies` b) && (a `implies` c)`` +-- | - Complemented: +-- | - ``not a = a `implies` ff`` +class HeytingAlgebra a where + ff :: a + tt :: a + implies :: a -> a -> a + conj :: a -> a -> a + disj :: a -> a -> a + not :: a -> a + +infixr 3 conj as && +infixr 2 disj as || + +instance heytingAlgebraBoolean :: HeytingAlgebra Boolean where + ff = false + tt = true + implies a b = not a || b + conj x y = boolConj x y + disj x y = boolDisj x y + not x = boolNot x + +instance heytingAlgebraUnit :: HeytingAlgebra Unit where + ff = unit + tt = unit + implies _ _ = unit + conj _ _ = unit + disj _ _ = unit + not _ = unit + +instance heytingAlgebraFunction :: HeytingAlgebra b => HeytingAlgebra (a -> b) where + ff _ = ff + tt _ = tt + implies f g a = f a `implies` g a + conj f g a = f a && g a + disj f g a = f a || g a + not f a = not (f a) + +instance heytingAlgebraProxy :: HeytingAlgebra (Proxy a) where + conj _ _ = Proxy + disj _ _ = Proxy + implies _ _ = Proxy + ff = Proxy + not _ = Proxy + tt = Proxy + +instance heytingAlgebraRecord :: (RL.RowToList row list, HeytingAlgebraRecord list row row) => HeytingAlgebra (Record row) where + ff = ffRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + tt = ttRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + conj = conjRecord (Proxy :: Proxy list) + disj = disjRecord (Proxy :: Proxy list) + implies = impliesRecord (Proxy :: Proxy list) + not = notRecord (Proxy :: Proxy list) + +boolConj :: Boolean -> Boolean -> Boolean +boolConj a0 a1 = booleanAnd a0 a1 +boolDisj :: Boolean -> Boolean -> Boolean +boolDisj a0 a1 = booleanOr a0 a1 +boolNot :: Boolean -> Boolean +boolNot a0 = booleanNot a0 + +-- | A class for records where all fields have `HeytingAlgebra` instances, used +-- | to implement the `HeytingAlgebra` instance for records. +class HeytingAlgebraRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class HeytingAlgebraRecord rowlist row subrow | rowlist -> subrow where + ffRecord :: Proxy rowlist -> Proxy row -> Record subrow + ttRecord :: Proxy rowlist -> Proxy row -> Record subrow + impliesRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + disjRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + conjRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + notRecord :: Proxy rowlist -> Record row -> Record subrow + +instance heytingAlgebraRecordNil :: HeytingAlgebraRecord RL.Nil row () where + conjRecord _ _ _ = {} + disjRecord _ _ _ = {} + ffRecord _ _ = {} + impliesRecord _ _ _ = {} + notRecord _ _ = {} + ttRecord _ _ = {} + +instance heytingAlgebraRecordCons :: + ( IsSymbol key + , Row.Cons key focus subrowTail subrow + , HeytingAlgebraRecord rowlistTail row subrowTail + , HeytingAlgebra focus + ) => + HeytingAlgebraRecord (RL.Cons key focus rowlistTail) row subrow where + conjRecord _ ra rb = insert (conj (get ra) (get rb)) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = conjRecord (Proxy :: Proxy rowlistTail) ra rb + + disjRecord _ ra rb = insert (disj (get ra) (get rb)) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = disjRecord (Proxy :: Proxy rowlistTail) ra rb + + impliesRecord _ ra rb = insert (implies (get ra) (get rb)) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = impliesRecord (Proxy :: Proxy rowlistTail) ra rb + + ffRecord _ row = insert ff tail + where + key = reflectSymbol (Proxy :: Proxy key) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = ffRecord (Proxy :: Proxy rowlistTail) row + + notRecord _ row = insert (not (get row)) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = notRecord (Proxy :: Proxy rowlistTail) row + + ttRecord _ row = insert tt tail + where + key = reflectSymbol (Proxy :: Proxy key) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = ttRecord (Proxy :: Proxy rowlistTail) row diff --git a/stdlib/lib/Data/HeytingAlgebra/Generic.purs b/stdlib/lib/Data/HeytingAlgebra/Generic.purs new file mode 100644 index 00000000..92bab32c --- /dev/null +++ b/stdlib/lib/Data/HeytingAlgebra/Generic.purs @@ -0,0 +1,70 @@ +module Data.HeytingAlgebra.Generic where + +import Prelude + +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) +import Data.HeytingAlgebra (ff, implies, tt) + +class GenericHeytingAlgebra a where + genericFF' :: a + genericTT' :: a + genericImplies' :: a -> a -> a + genericConj' :: a -> a -> a + genericDisj' :: a -> a -> a + genericNot' :: a -> a + +instance genericHeytingAlgebraNoArguments :: GenericHeytingAlgebra NoArguments where + genericFF' = NoArguments + genericTT' = NoArguments + genericImplies' _ _ = NoArguments + genericConj' _ _ = NoArguments + genericDisj' _ _ = NoArguments + genericNot' _ = NoArguments + +instance genericHeytingAlgebraArgument :: HeytingAlgebra a => GenericHeytingAlgebra (Argument a) where + genericFF' = Argument ff + genericTT' = Argument tt + genericImplies' (Argument x) (Argument y) = Argument (implies x y) + genericConj' (Argument x) (Argument y) = Argument (conj x y) + genericDisj' (Argument x) (Argument y) = Argument (disj x y) + genericNot' (Argument x) = Argument (not x) + +instance genericHeytingAlgebraProduct :: (GenericHeytingAlgebra a, GenericHeytingAlgebra b) => GenericHeytingAlgebra (Product a b) where + genericFF' = Product genericFF' genericFF' + genericTT' = Product genericTT' genericTT' + genericImplies' (Product a1 b1) (Product a2 b2) = Product (genericImplies' a1 a2) (genericImplies' b1 b2) + genericConj' (Product a1 b1) (Product a2 b2) = Product (genericConj' a1 a2) (genericConj' b1 b2) + genericDisj' (Product a1 b1) (Product a2 b2) = Product (genericDisj' a1 a2) (genericDisj' b1 b2) + genericNot' (Product a b) = Product (genericNot' a) (genericNot' b) + +instance genericHeytingAlgebraConstructor :: GenericHeytingAlgebra a => GenericHeytingAlgebra (Constructor name a) where + genericFF' = Constructor genericFF' + genericTT' = Constructor genericTT' + genericImplies' (Constructor a1) (Constructor a2) = Constructor (genericImplies' a1 a2) + genericConj' (Constructor a1) (Constructor a2) = Constructor (genericConj' a1 a2) + genericDisj' (Constructor a1) (Constructor a2) = Constructor (genericDisj' a1 a2) + genericNot' (Constructor a) = Constructor (genericNot' a) + +-- | A `Generic` implementation of the `ff` member from the `HeytingAlgebra` type class. +genericFF :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a +genericFF = to genericFF' + +-- | A `Generic` implementation of the `tt` member from the `HeytingAlgebra` type class. +genericTT :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a +genericTT = to genericTT' + +-- | A `Generic` implementation of the `implies` member from the `HeytingAlgebra` type class. +genericImplies :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a +genericImplies x y = to $ from x `genericImplies'` from y + +-- | A `Generic` implementation of the `conj` member from the `HeytingAlgebra` type class. +genericConj :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a +genericConj x y = to $ from x `genericConj'` from y + +-- | A `Generic` implementation of the `disj` member from the `HeytingAlgebra` type class. +genericDisj :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a +genericDisj x y = to $ from x `genericDisj'` from y + +-- | A `Generic` implementation of the `not` member from the `HeytingAlgebra` type class. +genericNot :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a +genericNot x = to $ genericNot' (from x) diff --git a/stdlib/lib/Data/Identity.purs b/stdlib/lib/Data/Identity.purs new file mode 100644 index 00000000..9ae89d50 --- /dev/null +++ b/stdlib/lib/Data/Identity.purs @@ -0,0 +1,72 @@ +module Data.Identity where + +import Prelude + +import Control.Alt (class Alt) +import Control.Comonad (class Comonad) +import Control.Extend (class Extend) +import Control.Lazy (class Lazy) +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) + +newtype Identity a = Identity a + +derive instance newtypeIdentity :: Newtype (Identity a) _ + +derive newtype instance eqIdentity :: Eq a => Eq (Identity a) + +derive newtype instance ordIdentity :: Ord a => Ord (Identity a) + +derive newtype instance boundedIdentity :: Bounded a => Bounded (Identity a) + +derive newtype instance heytingAlgebraIdentity :: HeytingAlgebra a => HeytingAlgebra (Identity a) + +derive newtype instance booleanAlgebraIdentity :: BooleanAlgebra a => BooleanAlgebra (Identity a) + +derive newtype instance semigroupIdentity :: Semigroup a => Semigroup (Identity a) + +derive newtype instance monoidIdentity :: Monoid a => Monoid (Identity a) + +derive newtype instance semiringIdentity :: Semiring a => Semiring (Identity a) + +derive newtype instance euclideanRingIdentity :: EuclideanRing a => EuclideanRing (Identity a) + +derive newtype instance ringIdentity :: Ring a => Ring (Identity a) + +derive newtype instance commutativeRingIdentity :: CommutativeRing a => CommutativeRing (Identity a) + +derive newtype instance lazyIdentity :: Lazy a => Lazy (Identity a) + +instance showIdentity :: Show a => Show (Identity a) where + show (Identity x) = "(Identity " <> show x <> ")" + +derive instance eq1Identity :: Eq1 Identity + +derive instance ord1Identity :: Ord1 Identity + +derive instance functorIdentity :: Functor Identity + +instance invariantIdentity :: Invariant Identity where + imap = imapF + +instance altIdentity :: Alt Identity where + alt x _ = x + +instance applyIdentity :: Apply Identity where + apply (Identity f) (Identity x) = Identity (f x) + +instance applicativeIdentity :: Applicative Identity where + pure = Identity + +instance bindIdentity :: Bind Identity where + bind (Identity m) f = f m + +instance monadIdentity :: Monad Identity + +instance extendIdentity :: Extend Identity where + extend f m = Identity (f m) + +instance comonadIdentity :: Comonad Identity where + extract (Identity x) = x diff --git a/stdlib/lib/Data/Int.purs b/stdlib/lib/Data/Int.purs new file mode 100644 index 00000000..bafb13ae --- /dev/null +++ b/stdlib/lib/Data/Int.purs @@ -0,0 +1,255 @@ +module Data.Int + ( fromNumber + , ceil + , floor + , trunc + , round + , toNumber + , fromString + , Radix + , radix + , binary + , octal + , decimal + , hexadecimal + , base36 + , fromStringAs + , toStringAs + , Parity(..) + , parity + , even + , odd + , quot + , rem + , pow + ) where + +import Prelude + +import Data.Int.Bits ((.&.)) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Number (isFinite) +import Data.Number as Number + +-- | Creates an `Int` from a `Number` value. The number must already be an +-- | integer and fall within the valid range of values for the `Int` type +-- | otherwise `Nothing` is returned. +fromNumber :: Number -> Maybe Int +fromNumber = fromNumberImpl Just Nothing + +fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int +fromNumberImpl a0 a1 a2 = fromNumberImpl a0 a1 a2 + +-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or +-- | less than the argument. Values outside the `Int` range are clamped, `NaN` +-- | and `Infinity` values return 0. +floor :: Number -> Int +floor = unsafeClamp <<< Number.floor + +-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or +-- | greater than the argument. Values outside the `Int` range are clamped, +-- | `NaN` and `Infinity` values return 0. +ceil :: Number -> Int +ceil = unsafeClamp <<< Number.ceil + +-- | Convert a `Number` to an `Int`, by dropping the decimal. +-- | Values outside the `Int` range are clamped, `NaN` and `Infinity` +-- | values return 0. +trunc :: Number -> Int +trunc = unsafeClamp <<< Number.trunc + +-- | Convert a `Number` to an `Int`, by taking the nearest integer to the +-- | argument. Values outside the `Int` range are clamped, `NaN` and `Infinity` +-- | values return 0. +round :: Number -> Int +round = unsafeClamp <<< Number.round + +-- | Convert an integral `Number` to an `Int`, by clamping to the `Int` range. +-- | This function will return 0 if the input is `NaN` or an `Infinity`. +unsafeClamp :: Number -> Int +unsafeClamp x + | not (isFinite x) = 0 + | x >= toNumber top = top + | x <= toNumber bottom = bottom + | otherwise = fromMaybe 0 (fromNumber x) + +-- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number` +-- | so there is no loss of precision with this function. +toNumber :: Int -> Number +toNumber a0 = toNumber a0 + +-- | Reads an `Int` from a `String` value. The number must parse as an integer +-- | and fall within the valid range of values for the `Int` type, otherwise +-- | `Nothing` is returned. +fromString :: String -> Maybe Int +fromString = fromStringAs (Radix 10) + +-- | A type for describing whether an integer is even or odd. +-- | +-- | The `Ord` instance considers `Even` to be less than `Odd`. +-- | +-- | The `Semiring` instance allows you to ask about the parity of the results +-- | of arithmetical operations, given only the parities of the inputs. For +-- | example, the sum of an odd number and an even number is odd, so +-- | `Odd + Even == Odd`. This also works for multiplication, eg. the product +-- | of two odd numbers is odd, and therefore `Odd * Odd == Odd`. +-- | +-- | More generally, we have that +-- | +-- | ```purescript +-- | parity x + parity y == parity (x + y) +-- | parity x * parity y == parity (x * y) +-- | ``` +-- | +-- | for any integers `x`, `y`. (A mathematician would say that `parity` is a +-- | *ring homomorphism*.) +-- | +-- | After defining addition and multiplication on `Parity` in this way, the +-- | `Semiring` laws now force us to choose `zero = Even` and `one = Odd`. +-- | This `Semiring` instance actually turns out to be a `Field`. +data Parity = Even | Odd + +derive instance eqParity :: Eq Parity +derive instance ordParity :: Ord Parity + +instance showParity :: Show Parity where + show Even = "Even" + show Odd = "Odd" + +instance boundedParity :: Bounded Parity where + bottom = Even + top = Odd + +instance semiringParity :: Semiring Parity where + zero = Even + add x y = if x == y then Even else Odd + one = Odd + mul Odd Odd = Odd + mul _ _ = Even + +instance ringParity :: Ring Parity where + sub = add + +instance commutativeRingParity :: CommutativeRing Parity + +instance euclideanRingParity :: EuclideanRing Parity where + degree Even = 0 + degree Odd = 1 + div x _ = x + mod _ _ = Even + +instance divisionRingParity :: DivisionRing Parity where + recip = identity + +-- | Returns whether an `Int` is `Even` or `Odd`. +-- | +-- | ``` purescript +-- | parity 0 == Even +-- | parity 1 == Odd +-- | ``` +parity :: Int -> Parity +parity n = if even n then Even else Odd + +-- | Returns whether an `Int` is an even number. +-- | +-- | ``` purescript +-- | even 0 == true +-- | even 1 == false +-- | ``` +even :: Int -> Boolean +even x = x .&. 1 == 0 + +-- | The negation of `even`. +-- | +-- | ``` purescript +-- | odd 0 == false +-- | odd 1 == true +-- | ``` +odd :: Int -> Boolean +odd x = x .&. 1 /= 0 + +-- | The number of unique digits (including zero) used to represent integers in +-- | a specific base. +newtype Radix = Radix Int + +-- | The base-2 system. +binary :: Radix +binary = Radix 2 + +-- | The base-8 system. +octal :: Radix +octal = Radix 8 + +-- | The base-10 system. +decimal :: Radix +decimal = Radix 10 + +-- | The base-16 system. +hexadecimal :: Radix +hexadecimal = Radix 16 + +-- | The base-36 system. +base36 :: Radix +base36 = Radix 36 + +-- | Create a `Radix` from a number between 2 and 36. +radix :: Int -> Maybe Radix +radix n | n >= 2 && n <= 36 = Just (Radix n) + | otherwise = Nothing + +-- | Like `fromString`, but the integer can be specified in a different base. +-- | +-- | Example: +-- | ``` purs +-- | fromStringAs binary "100" == Just 4 +-- | fromStringAs hexadecimal "ff" == Just 255 +-- | ``` +fromStringAs :: Radix -> String -> Maybe Int +fromStringAs = fromStringAsImpl Just Nothing + +-- | The `quot` function provides _truncating_ integer division (see the +-- | documentation for the `EuclideanRing` class). It is identical to `div` in +-- | the `EuclideanRing Int` instance if the dividend is positive, but will be +-- | slightly different if the dividend is negative. For example: +-- | +-- | ```purescript +-- | div 2 3 == 0 +-- | quot 2 3 == 0 +-- | +-- | div (-2) 3 == (-1) +-- | quot (-2) 3 == 0 +-- | +-- | div 2 (-3) == 0 +-- | quot 2 (-3) == 0 +-- | ``` +quot :: Int -> Int -> Int +quot a0 a1 = quot a0 a1 + +-- | The `rem` function provides the remainder after _truncating_ integer +-- | division (see the documentation for the `EuclideanRing` class). It is +-- | identical to `mod` in the `EuclideanRing Int` instance if the dividend is +-- | positive, but will be slightly different if the dividend is negative. For +-- | example: +-- | +-- | ```purescript +-- | mod 2 3 == 2 +-- | rem 2 3 == 2 +-- | +-- | mod (-2) 3 == 1 +-- | rem (-2) 3 == (-2) +-- | +-- | mod 2 (-3) == 2 +-- | rem 2 (-3) == 2 +-- | ``` +rem :: Int -> Int -> Int +rem a0 a1 = rem a0 a1 + +-- | Raise an Int to the power of another Int. +pow :: Int -> Int -> Int +pow a0 a1 = pow a0 a1 + +fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int +fromStringAsImpl a0 a1 a2 a3 = fromStringAsImpl a0 a1 a2 a3 + +toStringAs :: Radix -> Int -> String +toStringAs a0 a1 = toStringAs a0 a1 diff --git a/stdlib/lib/Data/Int/Bits.purs b/stdlib/lib/Data/Int/Bits.purs new file mode 100644 index 00000000..ca7a9556 --- /dev/null +++ b/stdlib/lib/Data/Int/Bits.purs @@ -0,0 +1,44 @@ +-- | This module defines bitwise operations for the `Int` type. +module Data.Int.Bits + ( and, (.&.) + , or, (.|.) + , xor, (.^.) + , shl + , shr + , zshr + , complement + ) where + +-- | Bitwise AND. +and :: Int -> Int -> Int +and a0 a1 = intAnd a0 a1 + +infixl 10 and as .&. + +-- | Bitwise OR. +or :: Int -> Int -> Int +or a0 a1 = intOr a0 a1 + +infixl 10 or as .|. + +-- | Bitwise XOR. +xor :: Int -> Int -> Int +xor a0 a1 = intXor a0 a1 + +infixl 10 xor as .^. + +-- | Bitwise shift left. +shl :: Int -> Int -> Int +shl a0 a1 = intShl a0 a1 + +-- | Bitwise shift right. +shr :: Int -> Int -> Int +shr a0 a1 = intShr a0 a1 + +-- | Bitwise zero-fill shift right. +zshr :: Int -> Int -> Int +zshr a0 a1 = intZshr a0 a1 + +-- | Bitwise NOT. +complement :: Int -> Int +complement a0 = intComplement a0 diff --git a/stdlib/lib/Data/Lazy.purs b/stdlib/lib/Data/Lazy.purs new file mode 100644 index 00000000..e9b8b121 --- /dev/null +++ b/stdlib/lib/Data/Lazy.purs @@ -0,0 +1,144 @@ +module Data.Lazy where + +import Prelude + +import Control.Comonad (class Comonad) +import Control.Extend (class Extend) +import Control.Lazy as CL +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.FunctorWithIndex (class FunctorWithIndex) +import Data.HeytingAlgebra (implies, ff, tt) +import Data.Ord (class Ord1) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Traversable (class Traversable1) +import Data.Traversable (class Traversable, traverse) +import Data.TraversableWithIndex (class TraversableWithIndex) + +-- | `Lazy a` represents lazily-computed values of type `a`. +-- | +-- | A lazy value is computed at most once - the result is saved +-- | after the first computation, and subsequent attempts to read +-- | the value simply return the saved value. +-- | +-- | `Lazy` values can be created with `defer`, or by using the provided +-- | type class instances. +-- | +-- | `Lazy` values can be evaluated by using the `force` function. +foreign import data Lazy :: Type -> Type + +type role Lazy representational + +-- | Defer a computation, creating a `Lazy` value. +defer :: forall a. (Unit -> a) -> Lazy a +defer a0 = defer a0 + +-- | Force evaluation of a `Lazy` value. +force :: forall a. Lazy a -> a +force a0 = force a0 + +instance semiringLazy :: Semiring a => Semiring (Lazy a) where + add a b = defer \_ -> force a + force b + zero = defer \_ -> zero + mul a b = defer \_ -> force a * force b + one = defer \_ -> one + +instance ringLazy :: Ring a => Ring (Lazy a) where + sub a b = defer \_ -> force a - force b + +instance commutativeRingLazy :: CommutativeRing a => CommutativeRing (Lazy a) + +instance euclideanRingLazy :: EuclideanRing a => EuclideanRing (Lazy a) where + degree = degree <<< force + div a b = defer \_ -> force a / force b + mod a b = defer \_ -> force a `mod` force b + +instance eqLazy :: Eq a => Eq (Lazy a) where + eq x y = (force x) == (force y) + +derive instance eq1Lazy :: Eq1 Lazy + +instance ordLazy :: Ord a => Ord (Lazy a) where + compare x y = compare (force x) (force y) + +derive instance ord1Lazy :: Ord1 Lazy + +instance boundedLazy :: Bounded a => Bounded (Lazy a) where + top = defer \_ -> top + bottom = defer \_ -> bottom + +instance semigroupLazy :: Semigroup a => Semigroup (Lazy a) where + append a b = defer \_ -> force a <> force b + +instance monoidLazy :: Monoid a => Monoid (Lazy a) where + mempty = defer \_ -> mempty + +instance heytingAlgebraLazy :: HeytingAlgebra a => HeytingAlgebra (Lazy a) where + ff = defer \_ -> ff + tt = defer \_ -> tt + implies a b = implies <$> a <*> b + conj a b = conj <$> a <*> b + disj a b = disj <$> a <*> b + not a = not <$> a + +instance booleanAlgebraLazy :: BooleanAlgebra a => BooleanAlgebra (Lazy a) + +instance functorLazy :: Functor Lazy where + map f l = defer \_ -> f (force l) + +instance functorWithIndexLazy :: FunctorWithIndex Unit Lazy where + mapWithIndex f = map $ f unit + +instance foldableLazy :: Foldable Lazy where + foldr f z l = f (force l) z + foldl f z l = f z (force l) + foldMap f l = f (force l) + +instance foldableWithIndexLazy :: FoldableWithIndex Unit Lazy where + foldrWithIndex f = foldr $ f unit + foldlWithIndex f = foldl $ f unit + foldMapWithIndex f = foldMap $ f unit + +instance foldable1Lazy :: Foldable1 Lazy where + foldMap1 f l = f (force l) + foldr1 _ l = force l + foldl1 _ l = force l + +instance traversableLazy :: Traversable Lazy where + traverse f l = defer <<< const <$> f (force l) + sequence l = defer <<< const <$> force l + +instance traversableWithIndexLazy :: TraversableWithIndex Unit Lazy where + traverseWithIndex f = traverse $ f unit + +instance traversable1Lazy :: Traversable1 Lazy where + traverse1 f l = defer <<< const <$> f (force l) + sequence1 l = defer <<< const <$> force l + +instance invariantLazy :: Invariant Lazy where + imap = imapF + +instance applyLazy :: Apply Lazy where + apply f x = defer \_ -> force f (force x) + +instance applicativeLazy :: Applicative Lazy where + pure a = defer \_ -> a + +instance bindLazy :: Bind Lazy where + bind l f = defer \_ -> force $ f (force l) + +instance monadLazy :: Monad Lazy + +instance extendLazy :: Extend Lazy where + extend f x = defer \_ -> f x + +instance comonadLazy :: Comonad Lazy where + extract = force + +instance showLazy :: Show a => Show (Lazy a) where + show x = "(defer \\_ -> " <> show (force x) <> ")" + +instance lazyLazy :: CL.Lazy (Lazy a) where + defer f = defer \_ -> force (f unit) diff --git a/stdlib/lib/Data/List.purs b/stdlib/lib/Data/List.purs new file mode 100644 index 00000000..38f90365 --- /dev/null +++ b/stdlib/lib/Data/List.purs @@ -0,0 +1,826 @@ +-- | This module defines a type of _strict_ linked lists, and associated helper +-- | functions and type class instances. +-- | +-- | _Note_: Depending on your use-case, you may prefer to use +-- | `Data.Sequence` instead, which might give better performance for certain +-- | use cases. This module is an improvement over `Data.Array` when working with +-- | immutable lists of data in a purely-functional setting, but does not have +-- | good random-access performance. + +module Data.List + ( module Data.List.Types + , toUnfoldable + , fromFoldable + + , singleton + , (..), range + , some + , someRec + , many + , manyRec + + , null + , length + + , snoc + , insert + , insertBy + + , head + , last + , tail + , init + , uncons + , unsnoc + + , (!!), index + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , insertAt + , deleteAt + , updateAt + , modifyAt + , alterAt + + , reverse + , concat + , concatMap + , filter + , filterM + , mapMaybe + , catMaybes + + , sort + , sortBy + + , Pattern(..) + , stripPrefix + , slice + , take + , takeEnd + , takeWhile + , drop + , dropEnd + , dropWhile + , span + , group + , groupAll + , groupBy + , groupAllBy + , partition + + , nub + , nubBy + , nubEq + , nubByEq + , union + , unionBy + , delete + , deleteBy + , (\\), difference + , intersect + , intersectBy + + , zipWith + , zipWithA + , zip + , unzip + + , transpose + + , foldM + + , module Exports + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy, defer) +import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM, tailRecM2) +import Data.Bifunctor (bimap) +import Data.Foldable (class Foldable, foldr, any, foldl) +import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports +import Data.List.Internal (emptySet, insertAndLookupBy) +import Data.List.Types (List(..), (:)) +import Data.List.Types (NonEmptyList(..)) as NEL +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) +import Data.NonEmpty ((:|)) +import Data.Traversable (scanl, scanr) as Exports +import Data.Traversable (sequence) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, unfoldr) + +-- | Convert a list into any unfoldable structure. +-- | +-- | Running time: `O(n)` +toUnfoldable :: forall f. Unfoldable f => List ~> f +toUnfoldable = unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> uncons xs) + +-- | Construct a list from a foldable structure. +-- | +-- | Running time: `O(n)` +fromFoldable :: forall f. Foldable f => f ~> List +fromFoldable = foldr Cons Nil + +-------------------------------------------------------------------------------- +-- List creation --------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Create a list with a single element. +-- | +-- | Running time: `O(1)` +singleton :: forall a. a -> List a +singleton a = a : Nil + +-- | An infix synonym for `range`. +infix 8 range as .. + +-- | Create a list containing a range of integers, including both endpoints. +range :: Int -> Int -> List Int +range start end | start == end = singleton start + | otherwise = go end start (if start > end then 1 else -1) Nil + where + go s e step rest | s == e = s : rest + | otherwise = go (s + step) e step (s : rest) + +-- | Attempt a computation multiple times, requiring at least one success. +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +some :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a) +some v = Cons <$> v <*> defer (\_ -> many v) + +-- | A stack-safe version of `some`, at the cost of a `MonadRec` constraint. +someRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) +someRec v = Cons <$> v <*> manyRec v + +-- | Attempt a computation multiple times, returning as many successful results +-- | as possible (possibly zero). +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +many :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a) +many v = some v <|> pure Nil + +-- | A stack-safe version of `many`, at the cost of a `MonadRec` constraint. +manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) +manyRec p = tailRecM go Nil + where + go :: List a -> f (Step (List a) (List a)) + go acc = do + aa <- (Loop <$> p) <|> pure (Done unit) + pure $ bimap (_ : acc) (\_ -> reverse acc) aa + +-------------------------------------------------------------------------------- +-- List size ------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Test whether a list is empty. +-- | +-- | Running time: `O(1)` +null :: forall a. List a -> Boolean +null Nil = true +null _ = false + +-- | Get the length of a list +-- | +-- | Running time: `O(n)` +length :: forall a. List a -> Int +length = foldl (\acc _ -> acc + 1) 0 + +-------------------------------------------------------------------------------- +-- Extending lists ------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Append an element to the end of a list, creating a new list. +-- | +-- | Running time: `O(n)` +snoc :: forall a. List a -> a -> List a +snoc xs x = foldr (:) (x : Nil) xs + +-- | Insert an element into a sorted list. +-- | +-- | Running time: `O(n)` +insert :: forall a. Ord a => a -> List a -> List a +insert = insertBy compare + +-- | Insert an element into a sorted list, using the specified function to +-- | determine the ordering of elements. +-- | +-- | Running time: `O(n)` +insertBy :: forall a. (a -> a -> Ordering) -> a -> List a -> List a +insertBy _ x Nil = singleton x +insertBy cmp x ys@(y : ys') = + case cmp x y of + GT -> y : (insertBy cmp x ys') + _ -> x : ys + +-------------------------------------------------------------------------------- +-- Non-indexed reads ----------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Get the first element in a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(1)`. +head :: List ~> Maybe +head Nil = Nothing +head (x : _) = Just x + +-- | Get the last element in a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(n)`. +last :: List ~> Maybe +last (x : Nil) = Just x +last (_ : xs) = last xs +last _ = Nothing + +-- | Get all but the first element of a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(1)` +tail :: forall a. List a -> Maybe (List a) +tail Nil = Nothing +tail (_ : xs) = Just xs + +-- | Get all but the last element of a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(n)` +init :: forall a. List a -> Maybe (List a) +init lst = _.init <$> unsnoc lst + +-- | Break a list into its first element, and the remaining elements, +-- | or `Nothing` if the list is empty. +-- | +-- | Running time: `O(1)` +uncons :: forall a. List a -> Maybe { head :: a, tail :: List a } +uncons Nil = Nothing +uncons (x : xs) = Just { head: x, tail: xs } + +-- | Break a list into its last element, and the preceding elements, +-- | or `Nothing` if the list is empty. +-- | +-- | Running time: `O(n)` +unsnoc :: forall a. List a -> Maybe { init :: List a, last :: a } +unsnoc lst = (\h -> { init: reverse h.revInit, last: h.last }) <$> go lst Nil + where + go Nil _ = Nothing + go (x : Nil) acc = Just { revInit: acc, last: x } + go (x : xs) acc = go xs (x : acc) + +-------------------------------------------------------------------------------- +-- Indexed operations ---------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Get the element at the specified index, or `Nothing` if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` where `n` is the required index. +index :: forall a. List a -> Int -> Maybe a +index Nil _ = Nothing +index (a : _) 0 = Just a +index (_ : as) i = index as (i - 1) + +-- | An infix synonym for `index`. +infixl 8 index as !! + +-- | Find the index of the first element equal to the specified element. +elemIndex :: forall a. Eq a => a -> List a -> Maybe Int +elemIndex x = findIndex (_ == x) + +-- | Find the index of the last element equal to the specified element. +elemLastIndex :: forall a. Eq a => a -> List a -> Maybe Int +elemLastIndex x = findLastIndex (_ == x) + +-- | Find the first index for which a predicate holds. +findIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int +findIndex fn = go 0 + where + go :: Int -> List a -> Maybe Int + go n (x : xs) | fn x = Just n + | otherwise = go (n + 1) xs + go _ Nil = Nothing + +-- | Find the last index for which a predicate holds. +findLastIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int +findLastIndex fn xs = ((length xs - 1) - _) <$> findIndex fn (reverse xs) + +-- | Insert an element into a list at the specified index, returning a new +-- | list or `Nothing` if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +insertAt :: forall a. Int -> a -> List a -> Maybe (List a) +insertAt 0 x xs = Just (x : xs) +insertAt n x (y : ys) = (y : _) <$> insertAt (n - 1) x ys +insertAt _ _ _ = Nothing + +-- | Delete an element from a list at the specified index, returning a new +-- | list or `Nothing` if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +deleteAt :: forall a. Int -> List a -> Maybe (List a) +deleteAt 0 (_ : ys) = Just ys +deleteAt n (y : ys) = (y : _) <$> deleteAt (n - 1) ys +deleteAt _ _ = Nothing + +-- | Update the element at the specified index, returning a new +-- | list or `Nothing` if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +updateAt :: forall a. Int -> a -> List a -> Maybe (List a) +updateAt 0 x ( _ : xs) = Just (x : xs) +updateAt n x (x1 : xs) = (x1 : _) <$> updateAt (n - 1) x xs +updateAt _ _ _ = Nothing + +-- | Update the element at the specified index by applying a function to +-- | the current value, returning a new list or `Nothing` if the index is +-- | out-of-bounds. +-- | +-- | Running time: `O(n)` +modifyAt :: forall a. Int -> (a -> a) -> List a -> Maybe (List a) +modifyAt n f = alterAt n (Just <<< f) + +-- | Update or delete the element at the specified index by applying a +-- | function to the current value, returning a new list or `Nothing` if the +-- | index is out-of-bounds. +-- | +-- | Running time: `O(n)` +alterAt :: forall a. Int -> (a -> Maybe a) -> List a -> Maybe (List a) +alterAt 0 f (y : ys) = Just $ + case f y of + Nothing -> ys + Just y' -> y' : ys +alterAt n f (y : ys) = (y : _) <$> alterAt (n - 1) f ys +alterAt _ _ _ = Nothing + +-------------------------------------------------------------------------------- +-- Transformations ------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Reverse a list. +-- | +-- | Running time: `O(n)` +reverse :: List ~> List +reverse = go Nil + where + go acc Nil = acc + go acc (x : xs) = go (x : acc) xs + +-- | Flatten a list of lists. +-- | +-- | Running time: `O(n)`, where `n` is the total number of elements. +concat :: forall a. List (List a) -> List a +concat = (_ >>= identity) + +-- | Apply a function to each element in a list, and flatten the results +-- | into a single, new list. +-- | +-- | Running time: `O(n)`, where `n` is the total number of elements. +concatMap :: forall a b. (a -> List b) -> List a -> List b +concatMap = flip bind + +-- | Filter a list, keeping the elements which satisfy a predicate function. +-- | +-- | Running time: `O(n)` +filter :: forall a. (a -> Boolean) -> List a -> List a +filter p = go Nil + where + go acc Nil = reverse acc + go acc (x : xs) + | p x = go (x : acc) xs + | otherwise = go acc xs + +-- | Filter where the predicate returns a monadic `Boolean`. +-- | +-- | For example: +-- | +-- | ```purescript +-- | powerSet :: forall a. [a] -> [[a]] +-- | powerSet = filterM (const [true, false]) +-- | ``` +filterM :: forall a m. Monad m => (a -> m Boolean) -> List a -> m (List a) +filterM _ Nil = pure Nil +filterM p (x : xs) = do + b <- p x + xs' <- filterM p xs + pure if b then x : xs' else xs' + +-- | Apply a function to each element in a list, keeping only the results which +-- | contain a value. +-- | +-- | Running time: `O(n)` +mapMaybe :: forall a b. (a -> Maybe b) -> List a -> List b +mapMaybe f = go Nil + where + go acc Nil = reverse acc + go acc (x : xs) = + case f x of + Nothing -> go acc xs + Just y -> go (y : acc) xs + +-- | Filter a list of optional values, keeping only the elements which contain +-- | a value. +catMaybes :: forall a. List (Maybe a) -> List a +catMaybes = mapMaybe identity + +-------------------------------------------------------------------------------- +-- Sorting --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Sort the elements of an list in increasing order. +sort :: forall a. Ord a => List a -> List a +sort xs = sortBy compare xs + +-- | Sort the elements of a list in increasing order, where elements are +-- | compared using the specified ordering. +sortBy :: forall a. (a -> a -> Ordering) -> List a -> List a +sortBy cmp = mergeAll <<< sequences + -- implementation lifted from http://hackage.haskell.org/package/base-4.8.0.0/docs/src/Data-OldList.html#sort + where + sequences :: List a -> List (List a) + sequences (a : b : xs) + | a `cmp` b == GT = descending b (singleton a) xs + | otherwise = ascending b (a : _) xs + sequences xs = singleton xs + + descending :: a -> List a -> List a -> List (List a) + descending a as (b : bs) + | a `cmp` b == GT = descending b (a : as) bs + descending a as bs = (a : as) : sequences bs + + ascending :: a -> (List a -> List a) -> List a -> List (List a) + ascending a as (b : bs) + | a `cmp` b /= GT = ascending b (\ys -> as (a : ys)) bs + ascending a as bs = ((as $ singleton a) : sequences bs) + + mergeAll :: List (List a) -> List a + mergeAll (x : Nil) = x + mergeAll xs = mergeAll (mergePairs xs) + + mergePairs :: List (List a) -> List (List a) + mergePairs (a : b : xs) = merge a b : mergePairs xs + mergePairs xs = xs + + merge :: List a -> List a -> List a + merge as@(a : as') bs@(b : bs') + | a `cmp` b == GT = b : merge as bs' + | otherwise = a : merge as' bs + merge Nil bs = bs + merge as Nil = as + +-------------------------------------------------------------------------------- +-- Sublists -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | A newtype used in cases where there is a list to be matched. +newtype Pattern a = Pattern (List a) + +derive instance eqPattern :: Eq a => Eq (Pattern a) +derive instance ordPattern :: Ord a => Ord (Pattern a) +derive instance newtypePattern :: Newtype (Pattern a) _ + +instance showPattern :: Show a => Show (Pattern a) where + show (Pattern s) = "(Pattern " <> show s <> ")" + + +-- | If the list starts with the given prefix, return the portion of the +-- | list left after removing it, as a Just value. Otherwise, return Nothing. +-- | * `stripPrefix (Pattern (1:Nil)) (1:2:Nil) == Just (2:Nil)` +-- | * `stripPrefix (Pattern Nil) (1:Nil) == Just (1:Nil)` +-- | * `stripPrefix (Pattern (2:Nil)) (1:Nil) == Nothing` +-- | +-- | Running time: `O(n)` where `n` is the number of elements to strip. +stripPrefix :: forall a. Eq a => Pattern a -> List a -> Maybe (List a) +stripPrefix (Pattern p') s = tailRecM2 go p' s + where + go prefix input = case prefix, input of + Cons p ps, Cons i is | p == i -> Just $ Loop { a: ps, b: is } + Nil, is -> Just $ Done is + _, _ -> Nothing + +-- | Extract a sublist by a start and end index. +slice :: Int -> Int -> List ~> List +slice start end xs = take (end - start) (drop start xs) + +-- | Take the specified number of elements from the front of a list. +-- | +-- | Running time: `O(n)` where `n` is the number of elements to take. +take :: forall a. Int -> List a -> List a +take = go Nil + where + go acc n _ | n < 1 = reverse acc + go acc _ Nil = reverse acc + go acc n (x : xs) = go (x : acc) (n - 1) xs + +-- | Take the specified number of elements from the end of a list. +-- | +-- | Running time: `O(2n - m)` where `n` is the number of elements in list +-- | and `m` is number of elements to take. +takeEnd :: forall a. Int -> List a -> List a +takeEnd n xs = drop (length xs - n) xs + +-- | Take those elements from the front of a list which match a predicate. +-- | +-- | Running time (worst case): `O(n)` +takeWhile :: forall a. (a -> Boolean) -> List a -> List a +takeWhile p = go Nil + where + go acc (x : xs) | p x = go (x : acc) xs + go acc _ = reverse acc + +-- | Drop the specified number of elements from the front of a list. +-- | +-- | Running time: `O(n)` where `n` is the number of elements to drop. +drop :: forall a. Int -> List a -> List a +drop n xs | n < 1 = xs +drop _ Nil = Nil +drop n (_ : xs) = drop (n - 1) xs + +-- | Drop the specified number of elements from the end of a list. +-- | +-- | Running time: `O(2n - m)` where `n` is the number of elements in list +-- | and `m` is number of elements to drop. +dropEnd :: forall a. Int -> List a -> List a +dropEnd n xs = take (length xs - n) xs + +-- | Drop those elements from the front of a list which match a predicate. +-- | +-- | Running time (worst case): `O(n)` +dropWhile :: forall a. (a -> Boolean) -> List a -> List a +dropWhile p = go + where + go (x : xs) | p x = go xs + go xs = xs + +-- | Split a list into two parts: +-- | +-- | 1. the longest initial segment for which all elements satisfy the specified predicate +-- | 2. the remaining elements +-- | +-- | For example, +-- | +-- | ```purescript +-- | span (\n -> n % 2 == 1) (1 : 3 : 2 : 4 : 5 : Nil) == { init: (1 : 3 : Nil), rest: (2 : 4 : 5 : Nil) } +-- | ``` +-- | +-- | Running time: `O(n)` +span :: forall a. (a -> Boolean) -> List a -> { init :: List a, rest :: List a } +span p (x : xs') | p x = case span p xs' of + { init: ys, rest: zs } -> { init: x : ys, rest: zs } +span _ xs = { init: Nil, rest: xs } + +-- | Group equal, consecutive elements of a list into lists. +-- | +-- | For example, +-- | +-- | ```purescript +-- | group (1 : 1 : 2 : 2 : 1 : Nil) == +-- | (NonEmptyList (NonEmpty 1 (1 : Nil))) : (NonEmptyList (NonEmpty 2 (2 : Nil))) : (NonEmptyList (NonEmpty 1 Nil)) : Nil +-- | ``` +-- | +-- | Running time: `O(n)` +group :: forall a. Eq a => List a -> List (NEL.NonEmptyList a) +group = groupBy (==) + +-- | Group equal elements of a list into lists. +-- | +-- | For example, +-- | +-- | ```purescript +-- | groupAll (1 : 1 : 2 : 2 : 1 : Nil) == +-- | (NonEmptyList (NonEmpty 1 (1 : 1 : Nil))) : (NonEmptyList (NonEmpty 2 (2 : Nil))) : Nil +-- | ``` +groupAll :: forall a. Ord a => List a -> List (NEL.NonEmptyList a) +groupAll = group <<< sort + +-- | Group equal, consecutive elements of a list into lists, using the specified +-- | equivalence relation to determine equality. +-- | +-- | For example, +-- | +-- | ```purescript +-- | groupBy (\a b -> odd a && odd b) (1 : 3 : 2 : 4 : 3 : 3 : Nil) == +-- | (NonEmptyList (NonEmpty 1 (3 : Nil))) : (NonEmptyList (NonEmpty 2 Nil)) : (NonEmptyList (NonEmpty 4 Nil)) : (NonEmptyList (NonEmpty 3 (3 : Nil))) : Nil +-- | ``` +-- | +-- | Running time: `O(n)` +groupBy :: forall a. (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) +groupBy _ Nil = Nil +groupBy eq (x : xs) = case span (eq x) xs of + { init: ys, rest: zs } -> NEL.NonEmptyList (x :| ys) : groupBy eq zs + +-- | Sort, then group equal elements of a list into lists, using the provided comparison function. +-- | +-- | ```purescript +-- | groupAllBy (compare `on` (_ `div` 10)) (32 : 31 : 21 : 22 : 11 : 33 : Nil) == +-- | NonEmptyList (11 :| Nil) : NonEmptyList (21 :| 22 : Nil) : NonEmptyList (32 :| 31 : 33) : Nil +-- | ``` +-- | +-- | Running time: `O(n log n)` +groupAllBy :: forall a. (a -> a -> Ordering) -> List a -> List (NEL.NonEmptyList a) +groupAllBy p = groupBy (\x y -> p x y == EQ) <<< sortBy p + +-- | Returns a lists of elements which do and do not satisfy a predicate. +-- | +-- | Running time: `O(n)` +partition :: forall a. (a -> Boolean) -> List a -> { yes :: List a, no :: List a } +partition p xs = foldr select { no: Nil, yes: Nil } xs + where + select x { no, yes } = if p x + then { no, yes: x : yes } + else { no: x : no, yes } + +-- | Returns all final segments of the argument, longest first. For example, +-- | +-- | ```purescript +-- | tails (1 : 2 : 3 : Nil) == ((1 : 2 : 3 : Nil) : (2 : 3 : Nil) : (3 : Nil) : (Nil) : Nil) +-- | ``` +-- | Running time: `O(n)` +tails :: forall a. List a -> List (List a) +tails Nil = singleton Nil +tails list@(Cons _ tl)= list : tails tl + +-------------------------------------------------------------------------------- +-- Set-like operations --------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Remove duplicate elements from a list. +-- | Keeps the first occurrence of each element in the input list, +-- | in the same order they appear in the input list. +-- | +-- | ```purescript +-- | nub 1:2:1:3:3:Nil == 1:2:3:Nil +-- | ``` +-- | +-- | Running time: `O(n log n)` +nub :: forall a. Ord a => List a -> List a +nub = nubBy compare + +-- | Remove duplicate elements from a list based on the provided comparison function. +-- | Keeps the first occurrence of each element in the input list, +-- | in the same order they appear in the input list. +-- | +-- | ```purescript +-- | nubBy (compare `on` Array.length) ([1]:[2]:[3,4]:Nil) == [1]:[3,4]:Nil +-- | ``` +-- | +-- | Running time: `O(n log n)` +nubBy :: forall a. (a -> a -> Ordering) -> List a -> List a +nubBy p = reverse <<< go emptySet Nil + where + go _ acc Nil = acc + go s acc (a : as) = + let { found, result: s' } = insertAndLookupBy p a s + in if found + then go s' acc as + else go s' (a : acc) as + +-- | Remove duplicate elements from a list. +-- | Keeps the first occurrence of each element in the input list, +-- | in the same order they appear in the input list. +-- | This less efficient version of `nub` only requires an `Eq` instance. +-- | +-- | ```purescript +-- | nubEq 1:2:1:3:3:Nil == 1:2:3:Nil +-- | ``` +-- | +-- | Running time: `O(n^2)` +nubEq :: forall a. Eq a => List a -> List a +nubEq = nubByEq eq + +-- | Remove duplicate elements from a list, using the provided equivalence function. +-- | Keeps the first occurrence of each element in the input list, +-- | in the same order they appear in the input list. +-- | This less efficient version of `nubBy` only requires an equivalence +-- | function, rather than an ordering function. +-- | +-- | ```purescript +-- | mod3eq = eq `on` \n -> mod n 3 +-- | nubByEq mod3eq 1:3:4:5:6:Nil == 1:3:5:Nil +-- | ``` +-- | +-- | Running time: `O(n^2)` +nubByEq :: forall a. (a -> a -> Boolean) -> List a -> List a +nubByEq _ Nil = Nil +nubByEq eq' (x : xs) = x : nubByEq eq' (filter (\y -> not (eq' x y)) xs) + +-- | Calculate the union of two lists. +-- | +-- | Running time: `O(n^2)` +union :: forall a. Eq a => List a -> List a -> List a +union = unionBy (==) + +-- | Calculate the union of two lists, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n^2)` +unionBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a +unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs + +-- | Delete the first occurrence of an element from a list. +-- | +-- | Running time: `O(n)` +delete :: forall a. Eq a => a -> List a -> List a +delete = deleteBy (==) + +-- | Delete the first occurrence of an element from a list, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n)` +deleteBy :: forall a. (a -> a -> Boolean) -> a -> List a -> List a +deleteBy _ _ Nil = Nil +deleteBy eq' x (y : ys) | eq' x y = ys +deleteBy eq' x (y : ys) = y : deleteBy eq' x ys + +infix 5 difference as \\ + +-- | Delete the first occurrence of each element in the second list from the first list. +-- | +-- | Running time: `O(n^2)` +difference :: forall a. Eq a => List a -> List a -> List a +difference = foldl (flip delete) + +-- | Calculate the intersection of two lists. +-- | +-- | Running time: `O(n^2)` +intersect :: forall a. Eq a => List a -> List a -> List a +intersect = intersectBy (==) + +-- | Calculate the intersection of two lists, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n^2)` +intersectBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a +intersectBy _ Nil _ = Nil +intersectBy _ _ Nil = Nil +intersectBy eq xs ys = filter (\x -> any (eq x) ys) xs + +-------------------------------------------------------------------------------- +-- Zipping --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Apply a function to pairs of elements at the same positions in two lists, +-- | collecting the results in a new list. +-- | +-- | If one list is longer, elements will be discarded from the longer list. +-- | +-- | For example +-- | +-- | ```purescript +-- | zipWith (*) (1 : 2 : 3 : Nil) (4 : 5 : 6 : 7 Nil) == 4 : 10 : 18 : Nil +-- | ``` +-- | +-- | Running time: `O(min(m, n))` +zipWith :: forall a b c. (a -> b -> c) -> List a -> List b -> List c +zipWith f xs ys = reverse $ go xs ys Nil + where + go Nil _ acc = acc + go _ Nil acc = acc + go (a : as) (b : bs) acc = go as bs $ f a b : acc + +-- | A generalization of `zipWith` which accumulates results in some `Applicative` +-- | functor. +zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> List a -> List b -> m (List c) +zipWithA f xs ys = sequence (zipWith f xs ys) + +-- | Collect pairs of elements at the same positions in two lists. +-- | +-- | Running time: `O(min(m, n))` +zip :: forall a b. List a -> List b -> List (Tuple a b) +zip = zipWith Tuple + +-- | Transforms a list of pairs into a list of first components and a list of +-- | second components. +unzip :: forall a b. List (Tuple a b) -> Tuple (List a) (List b) +unzip = foldr (\(Tuple a b) (Tuple as bs) -> Tuple (a : as) (b : bs)) (Tuple Nil Nil) + +-------------------------------------------------------------------------------- +-- Transpose ------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | The 'transpose' function transposes the rows and columns of its argument. +-- | For example, +-- | +-- | transpose ((1:2:3:Nil) : (4:5:6:Nil) : Nil) == +-- | ((1:4:Nil) : (2:5:Nil) : (3:6:Nil) : Nil) +-- | +-- | If some of the rows are shorter than the following rows, their elements are skipped: +-- | +-- | transpose ((10:11:Nil) : (20:Nil) : Nil : (30:31:32:Nil) : Nil) == +-- | ((10:20:30:Nil) : (11:31:Nil) : (32:Nil) : Nil) +transpose :: forall a. List (List a) -> List (List a) +transpose Nil = Nil +transpose (Nil : xss) = transpose xss +transpose ((x : xs) : xss) = + (x : mapMaybe head xss) : transpose (xs : mapMaybe tail xss) + +-------------------------------------------------------------------------------- +-- Folding --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Perform a fold using a monadic step function. +foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> List a -> m b +foldM _ b Nil = pure b +foldM f b (a : as) = f b a >>= \b' -> foldM f b' as diff --git a/stdlib/lib/Data/List/Internal.purs b/stdlib/lib/Data/List/Internal.purs new file mode 100644 index 00000000..5f5c950d --- /dev/null +++ b/stdlib/lib/Data/List/Internal.purs @@ -0,0 +1,63 @@ +module Data.List.Internal (Set, emptySet, insertAndLookupBy) where + +import Prelude + +import Data.List.Types (List(..)) + +data Set k + = Leaf + | Two (Set k) k (Set k) + | Three (Set k) k (Set k) k (Set k) + +emptySet :: forall k. Set k +emptySet = Leaf + +data TreeContext k + = TwoLeft k (Set k) + | TwoRight (Set k) k + | ThreeLeft k (Set k) k (Set k) + | ThreeMiddle (Set k) k k (Set k) + | ThreeRight (Set k) k (Set k) k + +fromZipper :: forall k. List (TreeContext k) -> Set k -> Set k +fromZipper Nil tree = tree +fromZipper (Cons x ctx) tree = + case x of + TwoLeft k1 right -> fromZipper ctx (Two tree k1 right) + TwoRight left k1 -> fromZipper ctx (Two left k1 tree) + ThreeLeft k1 mid k2 right -> fromZipper ctx (Three tree k1 mid k2 right) + ThreeMiddle left k1 k2 right -> fromZipper ctx (Three left k1 tree k2 right) + ThreeRight left k1 mid k2 -> fromZipper ctx (Three left k1 mid k2 tree) + +data KickUp k = KickUp (Set k) k (Set k) + +-- | Insert or replace a key/value pair in a map +insertAndLookupBy :: forall k. (k -> k -> Ordering) -> k -> Set k -> { found :: Boolean, result :: Set k } +insertAndLookupBy comp k orig = down Nil orig + where + down :: List (TreeContext k) -> Set k -> { found :: Boolean, result :: Set k } + down ctx Leaf = { found: false, result: up ctx (KickUp Leaf k Leaf) } + down ctx (Two left k1 right) = + case comp k k1 of + EQ -> { found: true, result: orig } + LT -> down (Cons (TwoLeft k1 right) ctx) left + _ -> down (Cons (TwoRight left k1) ctx) right + down ctx (Three left k1 mid k2 right) = + case comp k k1 of + EQ -> { found: true, result: orig } + c1 -> + case c1, comp k k2 of + _ , EQ -> { found: true, result: orig } + LT, _ -> down (Cons (ThreeLeft k1 mid k2 right) ctx) left + GT, LT -> down (Cons (ThreeMiddle left k1 k2 right) ctx) mid + _ , _ -> down (Cons (ThreeRight left k1 mid k2) ctx) right + + up :: List (TreeContext k) -> KickUp k -> Set k + up Nil (KickUp left k' right) = Two left k' right + up (Cons x ctx) kup = + case x, kup of + TwoLeft k1 right, KickUp left k' mid -> fromZipper ctx (Three left k' mid k1 right) + TwoRight left k1, KickUp mid k' right -> fromZipper ctx (Three left k1 mid k' right) + ThreeLeft k1 c k2 d, KickUp a k' b -> up ctx (KickUp (Two a k' b) k1 (Two c k2 d)) + ThreeMiddle a k1 k2 d, KickUp b k' c -> up ctx (KickUp (Two a k1 b) k' (Two c k2 d)) + ThreeRight a k1 b k2, KickUp c k' d -> up ctx (KickUp (Two a k1 b) k2 (Two c k' d)) diff --git a/stdlib/lib/Data/List/Lazy.purs b/stdlib/lib/Data/List/Lazy.purs new file mode 100644 index 00000000..8821753e --- /dev/null +++ b/stdlib/lib/Data/List/Lazy.purs @@ -0,0 +1,780 @@ +-- | This module defines a type of _lazy_ linked lists, and associated helper +-- | functions and type class instances. +-- | +-- | _Note_: Depending on your use-case, you may prefer to use +-- | `Data.Sequence` instead, which might give better performance for certain +-- | use cases. This module is an improvement over `Data.Array` when working with +-- | immutable lists of data in a purely-functional setting, but does not have +-- | good random-access performance. + +module Data.List.Lazy + ( module Data.List.Lazy.Types + , toUnfoldable + , fromFoldable + + , singleton + , (..), range + , replicate + , replicateM + , some + , many + , repeat + , iterate + , cycle + + , null + , length + + , snoc + , insert + , insertBy + + , head + , last + , tail + , init + , uncons + + , (!!), index + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , insertAt + , deleteAt + , updateAt + , modifyAt + , alterAt + + , reverse + , concat + , concatMap + , filter + , filterM + , mapMaybe + , catMaybes + + -- , sort + -- , sortBy + + , Pattern(..) + , stripPrefix + , slice + , take + , takeWhile + , drop + , dropWhile + , span + , group + -- , group' + , groupBy + , partition + + , nub + , nubBy + , nubEq + , nubByEq + , union + , unionBy + , delete + , deleteBy + , (\\), difference + , intersect + , intersectBy + + , zipWith + , zipWithA + , zip + , unzip + + , transpose + + , foldM + , foldrLazy + , scanlLazy + + , module Exports + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Alternative (class Alternative) +import Control.Lazy as Z +import Control.Monad.Rec.Class as Rec +import Data.Foldable (class Foldable, foldr, any, foldl) +import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports +import Data.Lazy (defer) +import Data.List.Internal (emptySet, insertAndLookupBy) +import Data.List.Lazy.Types (List(..), Step(..), step, nil, cons, (:)) +import Data.List.Lazy.Types (NonEmptyList(..)) as NEL +import Data.Maybe (Maybe(..), isNothing) +import Data.Newtype (class Newtype, unwrap) +import Data.NonEmpty ((:|)) +import Data.Traversable (scanl, scanr) as Exports +import Data.Traversable (sequence) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, unfoldr) + +-- | Convert a list into any unfoldable structure. +-- | +-- | Running time: `O(n)` +toUnfoldable :: forall f. Unfoldable f => List ~> f +toUnfoldable = unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> uncons xs) + +-- | Construct a list from a foldable structure. +-- | +-- | Running time: `O(n)` +fromFoldable :: forall f. Foldable f => f ~> List +fromFoldable = foldr cons nil + +fromStep :: forall a. Step a -> List a +fromStep = List <<< pure + +-------------------------------------------------------------------------------- +-- List creation --------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Create a list with a single element. +-- | +-- | Running time: `O(1)` +singleton :: forall a. a -> List a +singleton a = cons a nil + +-- | An infix synonym for `range`. +infix 8 range as .. + +-- | Create a list containing a range of integers, including both endpoints. +range :: Int -> Int -> List Int +range start end + | start > end = + let g x | x >= end = Just (Tuple x (x - 1)) + | otherwise = Nothing + in unfoldr g start + | otherwise = unfoldr f start + where + f x | x <= end = Just (Tuple x (x + 1)) + | otherwise = Nothing + +-- | Create a list with repeated instances of a value. +replicate :: forall a. Int -> a -> List a +replicate i xs = take i (repeat xs) + +-- | Perform a monadic action `n` times collecting all of the results. +replicateM :: forall m a. Monad m => Int -> m a -> m (List a) +replicateM n m + | n < one = pure nil + | otherwise = do + a <- m + as <- replicateM (n - one) m + pure (cons a as) + +-- | Attempt a computation multiple times, requiring at least one success. +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +some :: forall f a. Alternative f => Z.Lazy (f (List a)) => f a -> f (List a) +some v = cons <$> v <*> Z.defer (\_ -> many v) + +-- | Attempt a computation multiple times, returning as many successful results +-- | as possible (possibly zero). +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +many :: forall f a. Alternative f => Z.Lazy (f (List a)) => f a -> f (List a) +many v = some v <|> pure nil + +-- | Create a list by repeating an element +repeat :: forall a. a -> List a +repeat x = Z.fix \xs -> cons x xs + +-- | Create a list by iterating a function +iterate :: forall a. (a -> a) -> a -> List a +iterate f x = Z.fix \xs -> cons x (f <$> xs) + +-- | Create a list by repeating another list +cycle :: forall a. List a -> List a +cycle xs = Z.fix \ys -> xs <> ys + +-------------------------------------------------------------------------------- +-- List size ------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Test whether a list is empty. +-- | +-- | Running time: `O(1)` +null :: forall a. List a -> Boolean +null = isNothing <<< uncons + +-- | Get the length of a list +-- | +-- | Running time: `O(n)` +length :: forall a. List a -> Int +length = foldl (\l _ -> l + 1) 0 + +-------------------------------------------------------------------------------- +-- Extending lists ------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Append an element to the end of a list, creating a new list. +-- | +-- | Running time: `O(n)` +snoc :: forall a. List a -> a -> List a +snoc xs x = foldr cons (cons x nil) xs + +-- | Insert an element into a sorted list. +-- | +-- | Running time: `O(n)` +insert :: forall a. Ord a => a -> List a -> List a +insert = insertBy compare + +-- | Insert an element into a sorted list, using the specified function to determine the ordering +-- | of elements. +-- | +-- | Running time: `O(n)` +insertBy :: forall a. (a -> a -> Ordering) -> a -> List a -> List a +insertBy cmp x xs = List (go <$> unwrap xs) + where + go Nil = Cons x nil + go ys@(Cons y ys') = + case cmp x y of + GT -> Cons y (insertBy cmp x ys') + _ -> Cons x (fromStep ys) + +-------------------------------------------------------------------------------- +-- Non-indexed reads ----------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Get the first element in a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(1)`. +head :: List ~> Maybe +head xs = _.head <$> uncons xs + +-- | Get the last element in a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(n)`. +last :: List ~> Maybe +last = go <<< step + where + go (Cons x xs) + | null xs = Just x + | otherwise = go (step xs) + go _ = Nothing + +-- | Get all but the first element of a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(1)` +tail :: forall a. List a -> Maybe (List a) +tail xs = _.tail <$> uncons xs + +-- | Get all but the last element of a list, or `Nothing` if the list is empty. +-- | +-- | Running time: `O(n)` +init :: forall a. List a -> Maybe (List a) +init = go <<< step + where + go :: Step a -> Maybe (List a) + go (Cons x xs) + | null xs = Just nil + | otherwise = cons x <$> go (step xs) + go _ = Nothing + +-- | Break a list into its first element, and the remaining elements, +-- | or `Nothing` if the list is empty. +-- | +-- | Running time: `O(1)` +uncons :: forall a. List a -> Maybe { head :: a, tail :: List a } +uncons xs = case step xs of + Nil -> Nothing + Cons x xs' -> Just { head: x, tail: xs' } + +-------------------------------------------------------------------------------- +-- Indexed operations ---------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Get the element at the specified index, or `Nothing` if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` where `n` is the required index. +index :: forall a. List a -> Int -> Maybe a +index xs = go (step xs) + where + go Nil _ = Nothing + go (Cons a _) 0 = Just a + go (Cons _ as) i = go (step as) (i - 1) + +-- | An infix synonym for `index`. +infixl 8 index as !! + +-- | Find the index of the first element equal to the specified element. +elemIndex :: forall a. Eq a => a -> List a -> Maybe Int +elemIndex x = findIndex (_ == x) + +-- | Find the index of the last element equal to the specified element. +elemLastIndex :: forall a. Eq a => a -> List a -> Maybe Int +elemLastIndex x = findLastIndex (_ == x) + +-- | Find the first index for which a predicate holds. +findIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int +findIndex fn = go 0 + where + go :: Int -> List a -> Maybe Int + go n list = do + o <- uncons list + if fn o.head + then pure n + else go (n + 1) o.tail + +-- | Find the last index for which a predicate holds. +findLastIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int +findLastIndex fn xs = ((length xs - 1) - _) <$> findIndex fn (reverse xs) + +-- | Insert an element into a list at the specified index, or append the element +-- | to the end of the list if the index is out-of-bounds, returning a new list. +-- | +-- | Running time: `O(n)` +insertAt :: forall a. Int -> a -> List a -> List a +insertAt 0 x xs = cons x xs +insertAt n x xs = List (go <$> unwrap xs) + where + go Nil = Cons x nil + go (Cons y ys) = Cons y (insertAt (n - 1) x ys) + +-- | Delete an element from a list at the specified index, returning a new list, +-- | or return the original list unchanged if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +deleteAt :: forall a. Int -> List a -> List a +deleteAt n xs = List (go n <$> unwrap xs) + where + go _ Nil = Nil + go 0 (Cons _ ys) = step ys + go n' (Cons y ys) = Cons y (deleteAt (n' - 1) ys) + +-- | Update the element at the specified index, returning a new list, +-- | or return the original list unchanged if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +updateAt :: forall a. Int -> a -> List a -> List a +updateAt n x xs = List (go n <$> unwrap xs) + where + go _ Nil = Nil + go 0 (Cons _ ys) = Cons x ys + go n' (Cons y ys) = Cons y (updateAt (n' - 1) x ys) + +-- | Update the element at the specified index by applying a function to +-- | the current value, returning a new list, or return the original list unchanged +-- | if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +modifyAt :: forall a. Int -> (a -> a) -> List a -> List a +modifyAt n f = alterAt n (Just <<< f) + +-- | Update or delete the element at the specified index by applying a +-- | function to the current value, returning a new list, or return the +-- | original list unchanged if the index is out-of-bounds. +-- | +-- | Running time: `O(n)` +alterAt :: forall a. Int -> (a -> Maybe a) -> List a -> List a +alterAt n f xs = List (go n <$> unwrap xs) + where + go _ Nil = Nil + go 0 (Cons y ys) = case f y of + Nothing -> step ys + Just y' -> Cons y' ys + go n' (Cons y ys) = Cons y (alterAt (n' - 1) f ys) + +-------------------------------------------------------------------------------- +-- Transformations ------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Reverse a list. +-- | +-- | Running time: `O(n)` +reverse :: List ~> List +reverse xs = Z.defer \_ -> foldl (flip cons) nil xs + +-- | Flatten a list of lists. +-- | +-- | Running time: `O(n)`, where `n` is the total number of elements. +concat :: forall a. List (List a) -> List a +concat = (_ >>= identity) + +-- | Apply a function to each element in a list, and flatten the results +-- | into a single, new list. +-- | +-- | Running time: `O(n)`, where `n` is the total number of elements. +concatMap :: forall a b. (a -> List b) -> List a -> List b +concatMap = flip bind + +-- | Filter a list, keeping the elements which satisfy a predicate function. +-- | +-- | Running time: `O(n)` +filter :: forall a. (a -> Boolean) -> List a -> List a +filter p = List <<< map go <<< unwrap + where + go Nil = Nil + go (Cons x xs) + | p x = Cons x (filter p xs) + | otherwise = go (step xs) + +-- | Filter where the predicate returns a monadic `Boolean`. +-- | +-- | For example: +-- | +-- | ```purescript +-- | powerSet :: forall a. [a] -> [[a]] +-- | powerSet = filterM (const [true, false]) +-- | ``` +filterM :: forall a m. Monad m => (a -> m Boolean) -> List a -> m (List a) +filterM p list = + case uncons list of + Nothing -> pure nil + Just { head: x, tail: xs } -> do + b <- p x + xs' <- filterM p xs + pure if b then cons x xs' else xs' + + +-- | Apply a function to each element in a list, keeping only the results which +-- | contain a value. +-- | +-- | Running time: `O(n)` +mapMaybe :: forall a b. (a -> Maybe b) -> List a -> List b +mapMaybe f = List <<< map go <<< unwrap + where + go Nil = Nil + go (Cons x xs) = + case f x of + Nothing -> go (step xs) + Just y -> Cons y (mapMaybe f xs) + +-- | Filter a list of optional values, keeping only the elements which contain +-- | a value. +catMaybes :: forall a. List (Maybe a) -> List a +catMaybes = mapMaybe identity + +-------------------------------------------------------------------------------- +-- Sorting --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- Sublists -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + + +-- | A newtype used in cases where there is a list to be matched. +newtype Pattern a = Pattern (List a) + +derive instance eqPattern :: Eq a => Eq (Pattern a) +derive instance ordPattern :: Ord a => Ord (Pattern a) +derive instance newtypePattern :: Newtype (Pattern a) _ + +instance showPattern :: Show a => Show (Pattern a) where + show (Pattern s) = "(Pattern " <> show s <> ")" + + +-- | If the list starts with the given prefix, return the portion of the +-- | list left after removing it, as a Just value. Otherwise, return Nothing. +-- | * `stripPrefix (Pattern (fromFoldable [1])) (fromFoldable [1,2]) == Just (fromFoldable [2])` +-- | * `stripPrefix (Pattern (fromFoldable [])) (fromFoldable [1]) == Just (fromFoldable [1])` +-- | * `stripPrefix (Pattern (fromFoldable [2])) (fromFoldable [1]) == Nothing` +-- | +-- | Running time: `O(n)` where `n` is the number of elements to strip. +stripPrefix :: forall a. Eq a => Pattern a -> List a -> Maybe (List a) +stripPrefix (Pattern p') s = Rec.tailRecM2 go p' s + where + go prefix input = case step prefix of + Nil -> Just $ Rec.Done input + Cons p ps -> case step input of + Cons i is | p == i -> Just $ Rec.Loop { a: ps, b: is } + _ -> Nothing + +-- | Extract a sublist by a start and end index. +slice :: Int -> Int -> List ~> List +slice start end xs = take (end - start) (drop start xs) + +-- | Take the specified number of elements from the front of a list. +-- | +-- | Running time: `O(n)` where `n` is the number of elements to take. +take :: forall a. Int -> List a -> List a +take n = if n <= 0 + then const nil + else List <<< map (go n) <<< unwrap + where + go :: Int -> Step a -> Step a + go _ Nil = Nil + go n' (Cons x xs) = Cons x (take (n' - 1) xs) + +-- | Take those elements from the front of a list which match a predicate. +-- | +-- | Running time (worst case): `O(n)` +takeWhile :: forall a. (a -> Boolean) -> List a -> List a +takeWhile p = List <<< map go <<< unwrap + where + go (Cons x xs) | p x = Cons x (takeWhile p xs) + go _ = Nil + +-- | Drop the specified number of elements from the front of a list. +-- | +-- | Running time: `O(n)` where `n` is the number of elements to drop. +drop :: forall a. Int -> List a -> List a +drop n = List <<< map (go n) <<< unwrap + where + go 0 xs = xs + go _ Nil = Nil + go n' (Cons _ xs) = go (n' - 1) (step xs) + +-- | Drop those elements from the front of a list which match a predicate. +-- | +-- | Running time (worst case): `O(n)` +dropWhile :: forall a. (a -> Boolean) -> List a -> List a +dropWhile p = go <<< step + where + go (Cons x xs) | p x = go (step xs) + go xs = fromStep xs + +-- | Split a list into two parts: +-- | +-- | 1. the longest initial segment for which all elements satisfy the specified predicate +-- | 2. the remaining elements +-- | +-- | For example, +-- | +-- | ```purescript +-- | span (\n -> n % 2 == 1) (1 : 3 : 2 : 4 : 5 : Nil) == Tuple (1 : 3 : Nil) (2 : 4 : 5 : Nil) +-- | ``` +-- | +-- | Running time: `O(n)` +span :: forall a. (a -> Boolean) -> List a -> { init :: List a, rest :: List a } +span p xs = + case uncons xs of + Just { head: x, tail: xs' } | p x -> + case span p xs' of + { init: ys, rest: zs } -> { init: cons x ys, rest: zs } + _ -> { init: nil, rest: xs } + +-- | Group equal, consecutive elements of a list into lists. +-- | +-- | For example, +-- | +-- | ```purescript +-- | group (1 : 1 : 2 : 2 : 1 : Nil) == (1 : 1 : Nil) : (2 : 2 : Nil) : (1 : Nil) : Nil +-- | ``` +-- | +-- | Running time: `O(n)` +group :: forall a. Eq a => List a -> List (NEL.NonEmptyList a) +group = groupBy (==) + +-- | Group equal, consecutive elements of a list into lists, using the specified +-- | equivalence relation to determine equality. +-- | +-- | Running time: `O(n)` +groupBy :: forall a. (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) +groupBy eq = List <<< map go <<< unwrap + where + go Nil = Nil + go (Cons x xs) = + case span (eq x) xs of + { init: ys, rest: zs } -> + Cons (NEL.NonEmptyList (defer \_ -> x :| ys)) (groupBy eq zs) + +-- | Returns a tuple of lists of elements which do +-- | and do not satisfy a predicate, respectively. +-- | +-- | Running time: `O(n)` +partition :: forall a. (a -> Boolean) -> List a -> { yes :: List a, no :: List a } +partition f = foldr go {yes: nil, no: nil} + where + go x {yes: ys, no: ns} = + if f x then {yes: x : ys, no: ns} else {yes: ys, no: x : ns} + +-------------------------------------------------------------------------------- +-- Set-like operations --------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Remove duplicate elements from a list. +-- | Keeps the first occurrence of each element in the input list, +-- | in the same order they appear in the input list. +-- | +-- | Running time: `O(n log n)` +nub :: forall a. Ord a => List a -> List a +nub = nubBy compare + +-- | Remove duplicate elements from a list based on the provided comparison function. +-- | Keeps the first occurrence of each element in the input list, +-- | in the same order they appear in the input list. +-- | +-- | Running time: `O(n log n)` +nubBy :: forall a. (a -> a -> Ordering) -> List a -> List a +nubBy p = go emptySet + where + go s (List l) = List (map (goStep s) l) + goStep _ Nil = Nil + goStep s (Cons a as) = + let { found, result: s' } = insertAndLookupBy p a s + in if found + then step (go s' as) + else Cons a (go s' as) + +-- | Remove duplicate elements from a list. +-- | +-- | Running time: `O(n^2)` +nubEq :: forall a. Eq a => List a -> List a +nubEq = nubByEq eq + +-- | Remove duplicate elements from a list, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n^2)` +nubByEq :: forall a. (a -> a -> Boolean) -> List a -> List a +nubByEq eq = List <<< map go <<< unwrap + where + go Nil = Nil + go (Cons x xs) = Cons x (nubByEq eq (filter (\y -> not (eq x y)) xs)) + +-- | Calculate the union of two lists. +-- | +-- | Running time: `O(n^2)` +union :: forall a. Eq a => List a -> List a -> List a +union = unionBy (==) + +-- | Calculate the union of two lists, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n^2)` +unionBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a +unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs + +-- | Delete the first occurrence of an element from a list. +-- | +-- | Running time: `O(n)` +delete :: forall a. Eq a => a -> List a -> List a +delete = deleteBy (==) + +-- | Delete the first occurrence of an element from a list, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n)` +deleteBy :: forall a. (a -> a -> Boolean) -> a -> List a -> List a +deleteBy eq x xs = List (go <$> unwrap xs) + where + go Nil = Nil + go (Cons y ys) | eq x y = step ys + | otherwise = Cons y (deleteBy eq x ys) + +-- | Delete the first occurrence of each element in the second list from the first list. +-- | +-- | Running time: `O(n^2)` +difference :: forall a. Eq a => List a -> List a -> List a +difference = foldl (flip delete) +infix 5 difference as \\ + +-- | Calculate the intersection of two lists. +-- | +-- | Running time: `O(n^2)` +intersect :: forall a. Eq a => List a -> List a -> List a +intersect = intersectBy (==) + +-- | Calculate the intersection of two lists, using the specified +-- | function to determine equality of elements. +-- | +-- | Running time: `O(n^2)` +intersectBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a +intersectBy eq xs ys = filter (\x -> any (eq x) ys) xs + +-------------------------------------------------------------------------------- +-- Zipping --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Apply a function to pairs of elements at the same positions in two lists, +-- | collecting the results in a new list. +-- | +-- | If one list is longer, elements will be discarded from the longer list. +-- | +-- | For example +-- | +-- | ```purescript +-- | zipWith (*) (1 : 2 : 3 : Nil) (4 : 5 : 6 : 7 Nil) == 4 : 10 : 18 : Nil +-- | ``` +-- | +-- | Running time: `O(min(m, n))` +zipWith :: forall a b c. (a -> b -> c) -> List a -> List b -> List c +zipWith f xs ys = List (go <$> unwrap xs <*> unwrap ys) + where + go :: Step a -> Step b -> Step c + go Nil _ = Nil + go _ Nil = Nil + go (Cons a as) (Cons b bs) = Cons (f a b) (zipWith f as bs) + +-- | A generalization of `zipWith` which accumulates results in some `Applicative` +-- | functor. +zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> List a -> List b -> m (List c) +zipWithA f xs ys = sequence (zipWith f xs ys) + +-- | Collect pairs of elements at the same positions in two lists. +-- | +-- | Running time: `O(min(m, n))` +zip :: forall a b. List a -> List b -> List (Tuple a b) +zip = zipWith Tuple + +-- | Transforms a list of pairs into a list of first components and a list of +-- | second components. +unzip :: forall a b. List (Tuple a b) -> Tuple (List a) (List b) +unzip = foldr (\(Tuple a b) (Tuple as bs) -> Tuple (cons a as) (cons b bs)) (Tuple nil nil) + +-------------------------------------------------------------------------------- +-- Transpose ------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | The 'transpose' function transposes the rows and columns of its argument. +-- | For example, +-- | +-- | transpose ((1:2:3:nil) : (4:5:6:nil) : nil) == +-- | ((1:4:nil) : (2:5:nil) : (3:6:nil) : nil) +-- | +-- | If some of the rows are shorter than the following rows, their elements are skipped: +-- | +-- | transpose ((10:11:nil) : (20:nil) : nil : (30:31:32:nil) : nil) == +-- | ((10:20:30:nil) : (11:31:nil) : (32:nil) : nil) +transpose :: forall a. List (List a) -> List (List a) +transpose xs = + case uncons xs of + Nothing -> + xs + Just { head: h, tail: xss } -> + case uncons h of + Nothing -> + transpose xss + Just { head: x, tail: xs' } -> + (x : mapMaybe head xss) : transpose (xs' : mapMaybe tail xss) + +-------------------------------------------------------------------------------- +-- Folding --------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- | Perform a fold using a monadic step function. +foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> List a -> m b +foldM f b xs = + case uncons xs of + Nothing -> pure b + Just { head: a, tail: as } -> + f b a >>= \b' -> foldM f b' as + +-- | Perform a right fold lazily +foldrLazy :: forall a b. Z.Lazy b => (a -> b -> b) -> b -> List a -> b +foldrLazy op z = go + where + go xs = case step xs of + Cons x xs' -> Z.defer \_ -> x `op` go xs' + Nil -> z + +-- | Perform a left scan lazily +scanlLazy :: forall a b. (b -> a -> b) -> b -> List a -> List b +scanlLazy f acc xs = List (go <$> unwrap xs) + where + go :: Step a -> Step b + go Nil = Nil + go (Cons x xs') = + let acc' = f acc x + in Cons acc' $ scanlLazy f acc' xs' diff --git a/stdlib/lib/Data/List/Lazy/NonEmpty.purs b/stdlib/lib/Data/List/Lazy/NonEmpty.purs new file mode 100644 index 00000000..d5d207df --- /dev/null +++ b/stdlib/lib/Data/List/Lazy/NonEmpty.purs @@ -0,0 +1,88 @@ +module Data.List.Lazy.NonEmpty + ( module Data.List.Lazy.Types + , toUnfoldable + , fromFoldable + , fromList + , toList + , singleton + , repeat + , iterate + , head + , last + , tail + , init + , cons + , uncons + , length + , concatMap + , appendFoldable + ) where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Lazy (force, defer) +import Data.List.Lazy ((:)) +import Data.List.Lazy as L +import Data.List.Lazy.Types (NonEmptyList(..)) +import Data.Maybe (Maybe(..), maybe, fromMaybe) +import Data.NonEmpty ((:|)) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, unfoldr) + +toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f +toUnfoldable = + unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> L.uncons xs) <<< toList + +fromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyList a) +fromFoldable = fromList <<< L.fromFoldable + +fromList :: forall a. L.List a -> Maybe (NonEmptyList a) +fromList l = + case L.step l of + L.Nil -> Nothing + L.Cons x xs -> Just (NonEmptyList (defer \_ -> x :| xs)) + +toList :: NonEmptyList ~> L.List +toList (NonEmptyList nel) = case force nel of x :| xs -> x : xs + +singleton :: forall a. a -> NonEmptyList a +singleton = pure + +repeat :: forall a. a -> NonEmptyList a +repeat x = NonEmptyList $ defer \_ -> x :| L.repeat x + +iterate :: forall a. (a -> a) -> a -> NonEmptyList a +iterate f x = NonEmptyList $ defer \_ -> x :| L.iterate f (f x) + +head :: forall a. NonEmptyList a -> a +head (NonEmptyList nel) = case force nel of x :| _ -> x + +last :: forall a. NonEmptyList a -> a +last (NonEmptyList nel) = case force nel of x :| xs -> fromMaybe x (L.last xs) + +tail :: NonEmptyList ~> L.List +tail (NonEmptyList nel) = case force nel of _ :| xs -> xs + +init :: NonEmptyList ~> L.List +init (NonEmptyList nel) = + case force nel of + x :| xs -> + maybe L.nil (x : _) (L.init xs) + +cons :: forall a. a -> NonEmptyList a -> NonEmptyList a +cons y (NonEmptyList nel) = + NonEmptyList (defer \_ -> case force nel of x :| xs -> y :| x : xs) + +uncons :: forall a. NonEmptyList a -> { head :: a, tail :: L.List a } +uncons (NonEmptyList nel) = case force nel of x :| xs -> { head: x, tail: xs } + +length :: forall a. NonEmptyList a -> Int +length (NonEmptyList nel) = case force nel of _ :| xs -> 1 + L.length xs + +concatMap :: forall a b. (a -> NonEmptyList b) -> NonEmptyList a -> NonEmptyList b +concatMap = flip bind + +appendFoldable :: forall t a. Foldable t => NonEmptyList a -> t a -> NonEmptyList a +appendFoldable nel ys = + NonEmptyList (defer \_ -> head nel :| tail nel <> L.fromFoldable ys) diff --git a/stdlib/lib/Data/List/Lazy/Types.purs b/stdlib/lib/Data/List/Lazy/Types.purs new file mode 100644 index 00000000..6a4163b1 --- /dev/null +++ b/stdlib/lib/Data/List/Lazy/Types.purs @@ -0,0 +1,295 @@ +module Data.List.Lazy.Types where + +import Prelude + +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.Comonad (class Comonad) +import Control.Extend (class Extend) +import Control.Lazy as Z +import Control.MonadPlus (class MonadPlus) +import Control.Plus (class Plus) +import Data.Eq (class Eq1, eq1) +import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndex) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Lazy (Lazy, defer, force) +import Data.Maybe (Maybe(..), maybe) +import Data.Newtype (class Newtype, unwrap) +import Data.NonEmpty (NonEmpty, (:|)) +import Data.NonEmpty as NE +import Data.Ord (class Ord1, compare1) +import Data.Traversable (class Traversable, traverse, sequence) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) +import Data.Tuple (Tuple(..), snd) +import Data.Unfoldable (class Unfoldable, unfoldr1) +import Data.Unfoldable1 (class Unfoldable1) + +-- | A lazy linked list. +newtype List a = List (Lazy (Step a)) + +-- | A list is either empty (represented by the `Nil` constructor) or non-empty, in +-- | which case it consists of a head element, and another list (represented by the +-- | `Cons` constructor). +data Step a = Nil | Cons a (List a) + +instance showStep :: Show a => Show (Step a) where + show Nil = "Nil" + show (Cons x xs) = "(" <> show x <> " : " <> show xs <> ")" + +-- | Unwrap a lazy linked list +step :: forall a. List a -> Step a +step = force <<< unwrap + +-- | The empty list. +-- | +-- | Running time: `O(1)` +nil :: forall a. List a +nil = List $ defer \_ -> Nil + +-- | Attach an element to the front of a lazy list. +-- | +-- | Running time: `O(1)` +cons :: forall a. a -> List a -> List a +cons x xs = List $ defer \_ -> Cons x xs + +-- | An infix alias for `cons`; attaches an element to the front of +-- | a list. +-- | +-- | Running time: `O(1)` +infixr 6 cons as : + +derive instance newtypeList :: Newtype (List a) _ + +instance showList :: Show a => Show (List a) where + show xs = "(fromFoldable [" + <> case step xs of + Nil -> "" + Cons x xs' -> + show x <> foldl (\shown x' -> shown <> "," <> show x') "" xs' + <> "])" + +instance eqList :: Eq a => Eq (List a) where + eq = eq1 + +instance eq1List :: Eq1 List where + eq1 xs ys = go (step xs) (step ys) + where + go Nil Nil = true + go (Cons x xs') (Cons y ys') + | x == y = go (step xs') (step ys') + go _ _ = false + +instance ordList :: Ord a => Ord (List a) where + compare = compare1 + +instance ord1List :: Ord1 List where + compare1 xs ys = go (step xs) (step ys) + where + go Nil Nil = EQ + go Nil _ = LT + go _ Nil = GT + go (Cons x xs') (Cons y ys') = + case compare x y of + EQ -> go (step xs') (step ys') + other -> other + +instance lazyList :: Z.Lazy (List a) where + defer f = List $ defer (step <<< f) + +instance semigroupList :: Semigroup (List a) where + append xs ys = List (go <$> unwrap xs) + where + go Nil = step ys + go (Cons x xs') = Cons x (xs' <> ys) + +instance monoidList :: Monoid (List a) where + mempty = nil + +instance functorList :: Functor List where + map f xs = List (go <$> unwrap xs) + where + go Nil = Nil + go (Cons x xs') = Cons (f x) (f <$> xs') + +instance functorWithIndexList :: FunctorWithIndex Int List where + mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) nil + +instance foldableList :: Foldable List where + -- calls foldl on the reversed list + foldr op z xs = foldl (flip op) z (rev xs) where + rev = foldl (flip cons) nil + + foldl op = go + where + -- `go` is needed to ensure the function is tail-call optimized + go b xs = + case step xs of + Nil -> b + Cons hd tl -> go (b `op` hd) tl + + foldMap f = foldl (\b a -> b <> f a) mempty + +instance foldableWithIndexList :: FoldableWithIndex Int List where + foldrWithIndex f b xs = + -- as we climb the reversed list, we decrement the index + snd $ foldl + (\(Tuple i b') a -> Tuple (i - 1) (f (i - 1) a b')) + (Tuple len b) + revList + where + Tuple len revList = rev (Tuple 0 nil) xs + where + -- As we create our reversed list, we count elements. + rev = foldl (\(Tuple i acc) a -> Tuple (i + 1) (a : acc)) + foldlWithIndex f acc = + snd <<< foldl (\(Tuple i b) a -> Tuple (i + 1) (f i b a)) (Tuple 0 acc) + foldMapWithIndex f = foldlWithIndex (\i acc -> append acc <<< f i) mempty + +instance unfoldable1List :: Unfoldable1 List where + unfoldr1 = go where + go f b = Z.defer \_ -> case f b of + Tuple a (Just b') -> a : go f b' + Tuple a Nothing -> a : nil + +instance unfoldableList :: Unfoldable List where + unfoldr = go where + go f b = Z.defer \_ -> case f b of + Nothing -> nil + Just (Tuple a b') -> a : go f b' + +instance traversableList :: Traversable List where + traverse f = + foldr (\a b -> cons <$> f a <*> b) (pure nil) + + sequence = traverse identity + +instance traversableWithIndexList :: TraversableWithIndex Int List where + traverseWithIndex f = + foldrWithIndex (\i a b -> cons <$> f i a <*> b) (pure nil) + +instance applyList :: Apply List where + apply = ap + +instance applicativeList :: Applicative List where + pure a = a : nil + +instance bindList :: Bind List where + bind xs f = List (go <$> unwrap xs) + where + go Nil = Nil + go (Cons x xs') = step (f x <> bind xs' f) + +instance monadList :: Monad List + +instance altList :: Alt List where + alt = append + +instance plusList :: Plus List where + empty = nil + +instance alternativeList :: Alternative List + +instance monadPlusList :: MonadPlus List + +instance extendList :: Extend List where + extend f l = + case step l of + Nil -> nil + Cons _ as -> + f l : (foldr go { val: nil, acc: nil } as).val + where + go a { val, acc } = + let acc' = a : acc + in { val: f acc' : val, acc: acc' } + +newtype NonEmptyList a = NonEmptyList (Lazy (NonEmpty List a)) + +toList :: NonEmptyList ~> List +toList (NonEmptyList nel) = Z.defer \_ -> + case force nel of x :| xs -> x : xs + +derive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _ + +derive newtype instance eqNonEmptyList :: Eq a => Eq (NonEmptyList a) +derive newtype instance ordNonEmptyList :: Ord a => Ord (NonEmptyList a) + +instance eq1NonEmptyList :: Eq1 NonEmptyList where + eq1 (NonEmptyList lhs) (NonEmptyList rhs) = eq1 lhs rhs + +instance ord1NonEmptyList :: Ord1 NonEmptyList where + compare1 (NonEmptyList lhs) (NonEmptyList rhs) = compare1 lhs rhs + +instance showNonEmptyList :: Show a => Show (NonEmptyList a) where + show (NonEmptyList nel) = "(NonEmptyList " <> show nel <> ")" + +instance functorNonEmptyList :: Functor NonEmptyList where + map f (NonEmptyList nel) = NonEmptyList (map f <$> nel) + +instance applyNonEmptyList :: Apply NonEmptyList where + apply (NonEmptyList nefs) (NonEmptyList neas) = + case force nefs, force neas of + f :| fs, a :| as -> + NonEmptyList (defer \_ -> f a :| (fs <*> a : nil) <> ((f : fs) <*> as)) + +instance applicativeNonEmptyList :: Applicative NonEmptyList where + pure a = NonEmptyList (defer \_ -> NE.singleton a) + +instance bindNonEmptyList :: Bind NonEmptyList where + bind (NonEmptyList nel) f = + case force nel of + a :| as -> + case force $ unwrap $ f a of + b :| bs -> + NonEmptyList (defer \_ -> b :| bs <> bind as (toList <<< f)) + +instance monadNonEmptyList :: Monad NonEmptyList + +instance altNonEmptyList :: Alt NonEmptyList where + alt = append + +instance extendNonEmptyList :: Extend NonEmptyList where + extend f w@(NonEmptyList nel) = + case force nel of + _ :| as -> + NonEmptyList $ defer \_ -> + f w :| (foldr go { val: nil, acc: nil } as).val + where + go a { val, acc } = + { val: f (NonEmptyList (defer \_ -> a :| acc)) : val + , acc: a : acc + } + +instance comonadNonEmptyList :: Comonad NonEmptyList where + extract (NonEmptyList nel) = NE.head $ force nel + +instance semigroupNonEmptyList :: Semigroup (NonEmptyList a) where + append (NonEmptyList neas) as' = + case force neas of + a :| as -> NonEmptyList (defer \_ -> a :| as <> toList as') + +instance foldableNonEmptyList :: Foldable NonEmptyList where + foldr f b (NonEmptyList nel) = foldr f b (force nel) + foldl f b (NonEmptyList nel) = foldl f b (force nel) + foldMap f (NonEmptyList nel) = foldMap f (force nel) + +instance traversableNonEmptyList :: Traversable NonEmptyList where + traverse f (NonEmptyList nel) = + map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ traverse f (force nel) + sequence (NonEmptyList nel) = + map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ sequence (force nel) + +instance unfoldable1NonEmptyList :: Unfoldable1 NonEmptyList where + unfoldr1 f b = NonEmptyList $ defer \_ -> unfoldr1 f b + +instance functorWithIndexNonEmptyList :: FunctorWithIndex Int NonEmptyList where + mapWithIndex f (NonEmptyList ne) = NonEmptyList $ defer \_ -> mapWithIndex (f <<< maybe 0 (add 1)) $ force ne + +instance foldableWithIndexNonEmptyList :: FoldableWithIndex Int NonEmptyList where + foldMapWithIndex f (NonEmptyList ne) = foldMapWithIndex (f <<< maybe 0 (add 1)) $ force ne + foldlWithIndex f b (NonEmptyList ne) = foldlWithIndex (f <<< maybe 0 (add 1)) b $ force ne + foldrWithIndex f b (NonEmptyList ne) = foldrWithIndex (f <<< maybe 0 (add 1)) b $ force ne + +instance traversableWithIndexNonEmptyList :: TraversableWithIndex Int NonEmptyList where + traverseWithIndex f (NonEmptyList ne) = + map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ traverseWithIndex (f <<< maybe 0 (add 1)) $ force ne diff --git a/stdlib/lib/Data/List/NonEmpty.purs b/stdlib/lib/Data/List/NonEmpty.purs new file mode 100644 index 00000000..42fa49ec --- /dev/null +++ b/stdlib/lib/Data/List/NonEmpty.purs @@ -0,0 +1,307 @@ +module Data.List.NonEmpty + ( module Data.List.Types + , toUnfoldable + , fromFoldable + , fromList + , toList + , singleton + , length + , cons + , cons' + , snoc + , snoc' + , head + , last + , tail + , init + , uncons + , unsnoc + , (!!), index + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , insertAt + , updateAt + , modifyAt + , reverse + , concat + , concatMap + , filter + , filterM + , mapMaybe + , catMaybes + , appendFoldable + , sort + , sortBy + , take + , takeWhile + , drop + , dropWhile + , span + , group + , groupAll + , groupBy + , groupAllBy + , partition + , nub + , nubBy + , nubEq + , nubByEq + , union + , unionBy + , intersect + , intersectBy + , zipWith + , zipWithA + , zip + , unzip + , foldM + , module Exports + ) where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.List ((:)) +import Data.List as L +import Data.List.Types (NonEmptyList(..)) +import Data.Maybe (Maybe(..), fromMaybe, maybe) +import Data.NonEmpty ((:|)) +import Data.NonEmpty as NE +import Data.Semigroup.Traversable (sequence1) +import Data.Tuple (Tuple(..), fst, snd) +import Data.Unfoldable (class Unfoldable, unfoldr) +import Partial.Unsafe (unsafeCrashWith) + +import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports +import Data.Semigroup.Foldable (fold1, foldMap1, for1_, sequence1_, traverse1_) as Exports +import Data.Semigroup.Traversable (sequence1, traverse1, traverse1Default) as Exports +import Data.Traversable (scanl, scanr) as Exports + +-- | Internal function: any operation on a list that is guaranteed not to delete +-- | all elements also applies to a NEL, this function is a helper for defining +-- | those cases. +wrappedOperation + :: forall a b + . String + -> (L.List a -> L.List b) + -> NonEmptyList a + -> NonEmptyList b +wrappedOperation name f (NonEmptyList (x :| xs)) = + case f (x : xs) of + x' : xs' -> NonEmptyList (x' :| xs') + L.Nil -> unsafeCrashWith ("Impossible: empty list in NonEmptyList " <> name) + +-- | Like `wrappedOperation`, but for functions that operate on 2 lists. +wrappedOperation2 + :: forall a b c + . String + -> (L.List a -> L.List b -> L.List c) + -> NonEmptyList a + -> NonEmptyList b + -> NonEmptyList c +wrappedOperation2 name f (NonEmptyList (x :| xs)) (NonEmptyList (y :| ys)) = + case f (x : xs) (y : ys) of + x' : xs' -> NonEmptyList (x' :| xs') + L.Nil -> unsafeCrashWith ("Impossible: empty list in NonEmptyList " <> name) + +-- | Lifts a function that operates on a list to work on a NEL. This does not +-- | preserve the non-empty status of the result. +lift :: forall a b. (L.List a -> b) -> NonEmptyList a -> b +lift f (NonEmptyList (x :| xs)) = f (x : xs) + +toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f +toUnfoldable = + unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> L.uncons xs) <<< toList + +fromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyList a) +fromFoldable = fromList <<< L.fromFoldable + +fromList :: forall a. L.List a -> Maybe (NonEmptyList a) +fromList L.Nil = Nothing +fromList (x : xs) = Just (NonEmptyList (x :| xs)) + +toList :: NonEmptyList ~> L.List +toList (NonEmptyList (x :| xs)) = x : xs + +singleton :: forall a. a -> NonEmptyList a +singleton = NonEmptyList <<< NE.singleton + +cons :: forall a. a -> NonEmptyList a -> NonEmptyList a +cons y (NonEmptyList (x :| xs)) = NonEmptyList (y :| x : xs) + +cons' :: forall a. a -> L.List a -> NonEmptyList a +cons' x xs = NonEmptyList (x :| xs) + +snoc :: forall a. NonEmptyList a -> a -> NonEmptyList a +snoc (NonEmptyList (x :| xs)) y = NonEmptyList (x :| L.snoc xs y) + +snoc' :: forall a. L.List a -> a -> NonEmptyList a +snoc' (x : xs) y = NonEmptyList (x :| L.snoc xs y) +snoc' L.Nil y = singleton y + +head :: forall a. NonEmptyList a -> a +head (NonEmptyList (x :| _)) = x + +last :: forall a. NonEmptyList a -> a +last (NonEmptyList (x :| xs)) = fromMaybe x (L.last xs) + +tail :: NonEmptyList ~> L.List +tail (NonEmptyList (_ :| xs)) = xs + +init :: NonEmptyList ~> L.List +init (NonEmptyList (x :| xs)) = maybe L.Nil (x : _) (L.init xs) + +uncons :: forall a. NonEmptyList a -> { head :: a, tail :: L.List a } +uncons (NonEmptyList (x :| xs)) = { head: x, tail: xs } + +unsnoc :: forall a. NonEmptyList a -> { init :: L.List a, last :: a } +unsnoc (NonEmptyList (x :| xs)) = case L.unsnoc xs of + Nothing -> { init: L.Nil, last: x } + Just un -> { init: x : un.init, last: un.last } + +length :: forall a. NonEmptyList a -> Int +length (NonEmptyList (_ :| xs)) = 1 + L.length xs + +index :: forall a. NonEmptyList a -> Int -> Maybe a +index (NonEmptyList (x :| xs)) i + | i == 0 = Just x + | otherwise = L.index xs (i - 1) + +infixl 8 index as !! + +elemIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int +elemIndex x = findIndex (_ == x) + +elemLastIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int +elemLastIndex x = findLastIndex (_ == x) + +findIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int +findIndex f (NonEmptyList (x :| xs)) + | f x = Just 0 + | otherwise = (_ + 1) <$> L.findIndex f xs + +findLastIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int +findLastIndex f (NonEmptyList (x :| xs)) = + case L.findLastIndex f xs of + Just i -> Just (i + 1) + Nothing + | f x -> Just 0 + | otherwise -> Nothing + +insertAt :: forall a. Int -> a -> NonEmptyList a -> Maybe (NonEmptyList a) +insertAt i a (NonEmptyList (x :| xs)) + | i == 0 = Just (NonEmptyList (a :| x : xs)) + | otherwise = NonEmptyList <<< (x :| _) <$> L.insertAt (i - 1) a xs + +updateAt :: forall a. Int -> a -> NonEmptyList a -> Maybe (NonEmptyList a) +updateAt i a (NonEmptyList (x :| xs)) + | i == 0 = Just (NonEmptyList (a :| xs)) + | otherwise = NonEmptyList <<< (x :| _) <$> L.updateAt (i - 1) a xs + +modifyAt :: forall a. Int -> (a -> a) -> NonEmptyList a -> Maybe (NonEmptyList a) +modifyAt i f (NonEmptyList (x :| xs)) + | i == 0 = Just (NonEmptyList (f x :| xs)) + | otherwise = NonEmptyList <<< (x :| _) <$> L.modifyAt (i - 1) f xs + +reverse :: forall a. NonEmptyList a -> NonEmptyList a +reverse = wrappedOperation "reverse" L.reverse + +filter :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a +filter = lift <<< L.filter + +filterM :: forall m a. Monad m => (a -> m Boolean) -> NonEmptyList a -> m (L.List a) +filterM = lift <<< L.filterM + +mapMaybe :: forall a b. (a -> Maybe b) -> NonEmptyList a -> L.List b +mapMaybe = lift <<< L.mapMaybe + +catMaybes :: forall a. NonEmptyList (Maybe a) -> L.List a +catMaybes = lift L.catMaybes + +concat :: forall a. NonEmptyList (NonEmptyList a) -> NonEmptyList a +concat = (_ >>= identity) + +concatMap :: forall a b. (a -> NonEmptyList b) -> NonEmptyList a -> NonEmptyList b +concatMap = flip bind + +appendFoldable :: forall t a. Foldable t => NonEmptyList a -> t a -> NonEmptyList a +appendFoldable (NonEmptyList (x :| xs)) ys = + NonEmptyList (x :| (xs <> L.fromFoldable ys)) + +sort :: forall a. Ord a => NonEmptyList a -> NonEmptyList a +sort xs = sortBy compare xs + +sortBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a +sortBy = wrappedOperation "sortBy" <<< L.sortBy + +take :: forall a. Int -> NonEmptyList a -> L.List a +take = lift <<< L.take + +takeWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a +takeWhile = lift <<< L.takeWhile + +drop :: forall a. Int -> NonEmptyList a -> L.List a +drop = lift <<< L.drop + +dropWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a +dropWhile = lift <<< L.dropWhile + +span :: forall a. (a -> Boolean) -> NonEmptyList a -> { init :: L.List a, rest :: L.List a } +span = lift <<< L.span + +group :: forall a. Eq a => NonEmptyList a -> NonEmptyList (NonEmptyList a) +group = wrappedOperation "group" L.group + +groupAll :: forall a. Ord a => NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupAll = wrappedOperation "groupAll" L.groupAll + +groupBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupBy = wrappedOperation "groupBy" <<< L.groupBy + +groupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupAllBy = wrappedOperation "groupAllBy" <<< L.groupAllBy + +partition :: forall a. (a -> Boolean) -> NonEmptyList a -> { yes :: L.List a, no :: L.List a } +partition = lift <<< L.partition + +nub :: forall a. Ord a => NonEmptyList a -> NonEmptyList a +nub = wrappedOperation "nub" L.nub + +nubBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a +nubBy = wrappedOperation "nubBy" <<< L.nubBy + +nubEq :: forall a. Eq a => NonEmptyList a -> NonEmptyList a +nubEq = wrappedOperation "nubEq" L.nubEq + +nubByEq :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a +nubByEq = wrappedOperation "nubByEq" <<< L.nubByEq + +union :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a +union = wrappedOperation2 "union" L.union + +unionBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a +unionBy = wrappedOperation2 "unionBy" <<< L.unionBy + +intersect :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a +intersect = wrappedOperation2 "intersect" L.intersect + +intersectBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a +intersectBy = wrappedOperation2 "intersectBy" <<< L.intersectBy + +zipWith :: forall a b c. (a -> b -> c) -> NonEmptyList a -> NonEmptyList b -> NonEmptyList c +zipWith f (NonEmptyList (x :| xs)) (NonEmptyList (y :| ys)) = + NonEmptyList (f x y :| L.zipWith f xs ys) + +zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> NonEmptyList a -> NonEmptyList b -> m (NonEmptyList c) +zipWithA f xs ys = sequence1 (zipWith f xs ys) + +zip :: forall a b. NonEmptyList a -> NonEmptyList b -> NonEmptyList (Tuple a b) +zip = zipWith Tuple + +unzip :: forall a b. NonEmptyList (Tuple a b) -> Tuple (NonEmptyList a) (NonEmptyList b) +unzip ts = Tuple (map fst ts) (map snd ts) + +foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyList a -> m b +foldM f b (NonEmptyList (a :| as)) = f b a >>= \b' -> L.foldM f b' as diff --git a/stdlib/lib/Data/List/Partial.purs b/stdlib/lib/Data/List/Partial.purs new file mode 100644 index 00000000..7d7987f2 --- /dev/null +++ b/stdlib/lib/Data/List/Partial.purs @@ -0,0 +1,30 @@ +-- | Partial helper functions for working with strict linked lists. +module Data.List.Partial where + +import Data.List (List(..)) + +-- | Get the first element of a non-empty list. +-- | +-- | Running time: `O(1)`. +head :: forall a. Partial => List a -> a +head (Cons x _) = x + +-- | Get all but the first element of a non-empty list. +-- | +-- | Running time: `O(1)` +tail :: forall a. Partial => List a -> List a +tail (Cons _ xs) = xs + +-- | Get the last element of a non-empty list. +-- | +-- | Running time: `O(n)` +last :: forall a. Partial => List a -> a +last (Cons x Nil) = x +last (Cons _ xs) = last xs + +-- | Get all but the last element of a non-empty list. +-- | +-- | Running time: `O(n)` +init :: forall a. Partial => List a -> List a +init (Cons _ Nil) = Nil +init (Cons x xs) = Cons x (init xs) diff --git a/stdlib/lib/Data/List/Types.purs b/stdlib/lib/Data/List/Types.purs new file mode 100644 index 00000000..a44df659 --- /dev/null +++ b/stdlib/lib/Data/List/Types.purs @@ -0,0 +1,264 @@ +module Data.List.Types + ( List(..) + , (:) + , NonEmptyList(..) + , toList + , nelCons + ) where + +import Prelude + +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.Apply (lift2) +import Control.Comonad (class Comonad) +import Control.Extend (class Extend) +import Control.MonadPlus (class MonadPlus) +import Control.Plus (class Plus) +import Data.Eq (class Eq1, eq1) +import Data.Foldable (class Foldable, foldl, foldr, intercalate) +import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndex) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Maybe (Maybe(..), maybe) +import Data.Newtype (class Newtype) +import Data.NonEmpty (NonEmpty, (:|)) +import Data.NonEmpty as NE +import Data.Ord (class Ord1, compare1) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Traversable (class Traversable1, traverse1) +import Data.Traversable (class Traversable, traverse) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) +import Data.Tuple (Tuple(..), snd) +import Data.Unfoldable (class Unfoldable) +import Data.Unfoldable1 (class Unfoldable1) + +data List a = Nil | Cons a (List a) + +infixr 6 Cons as : + +instance showList :: Show a => Show (List a) where + show Nil = "Nil" + show xs = "(" <> intercalate " : " (show <$> xs) <> " : Nil)" + +instance eqList :: Eq a => Eq (List a) where + eq = eq1 + +instance eq1List :: Eq1 List where + eq1 xs ys = go xs ys true + where + go _ _ false = false + go Nil Nil acc = acc + go (x : xs') (y : ys') acc = go xs' ys' $ acc && (y == x) + go _ _ _ = false + +instance ordList :: Ord a => Ord (List a) where + compare = compare1 + +instance ord1List :: Ord1 List where + compare1 xs ys = go xs ys + where + go Nil Nil = EQ + go Nil _ = LT + go _ Nil = GT + go (x : xs') (y : ys') = + case compare x y of + EQ -> go xs' ys' + other -> other + +instance semigroupList :: Semigroup (List a) where + append xs ys = foldr (:) ys xs + +instance monoidList :: Monoid (List a) where + mempty = Nil + +instance functorList :: Functor List where + map = listMap + +-- chunked list Functor inspired by OCaml +-- https://discuss.ocaml.org/t/a-new-list-map-that-is-both-stack-safe-and-fast/865 +-- chunk sizes determined through experimentation +listMap :: forall a b. (a -> b) -> List a -> List b +listMap f = chunkedRevMap Nil + where + chunkedRevMap :: List (List a) -> List a -> List b + chunkedRevMap chunksAcc chunk@(_ : _ : _ : xs) = + chunkedRevMap (chunk : chunksAcc) xs + chunkedRevMap chunksAcc xs = + reverseUnrolledMap chunksAcc $ unrolledMap xs + where + unrolledMap :: List a -> List b + unrolledMap (x1 : x2 : Nil) = f x1 : f x2 : Nil + unrolledMap (x1 : Nil) = f x1 : Nil + unrolledMap _ = Nil + + reverseUnrolledMap :: List (List a) -> List b -> List b + reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc = + reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc) + reverseUnrolledMap _ acc = acc + +instance functorWithIndexList :: FunctorWithIndex Int List where + mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) Nil + +instance foldableList :: Foldable List where + foldr f b = foldl (flip f) b <<< rev + where + rev = go Nil + where + go acc Nil = acc + go acc (x : xs) = go (x : acc) xs + foldl f = go + where + go b = case _ of + Nil -> b + a : as -> go (f b a) as + foldMap f = foldl (\acc -> append acc <<< f) mempty + +instance foldableWithIndexList :: FoldableWithIndex Int List where + foldrWithIndex f b xs = + -- as we climb the reversed list, we decrement the index + snd $ foldl + (\(Tuple i b') a -> Tuple (i - 1) (f (i - 1) a b')) + (Tuple len b) + revList + where + Tuple len revList = rev (Tuple 0 Nil) xs + where + -- As we create our reversed list, we count elements. + rev = foldl (\(Tuple i acc) a -> Tuple (i + 1) (a : acc)) + foldlWithIndex f acc = + snd <<< foldl (\(Tuple i b) a -> Tuple (i + 1) (f i b a)) (Tuple 0 acc) + foldMapWithIndex f = foldlWithIndex (\i acc -> append acc <<< f i) mempty + +instance unfoldable1List :: Unfoldable1 List where + unfoldr1 f b = go b Nil + where + go source memo = case f source of + Tuple one (Just rest) -> go rest (one : memo) + Tuple one Nothing -> foldl (flip (:)) Nil (one : memo) + +instance unfoldableList :: Unfoldable List where + unfoldr f b = go b Nil + where + go source memo = case f source of + Nothing -> (foldl (flip (:)) Nil memo) + Just (Tuple one rest) -> go rest (one : memo) + +instance traversableList :: Traversable List where + traverse f = map (foldl (flip (:)) Nil) <<< foldl (\acc -> lift2 (flip (:)) acc <<< f) (pure Nil) + sequence = traverse identity + +instance traversableWithIndexList :: TraversableWithIndex Int List where + traverseWithIndex f = + map rev + <<< foldlWithIndex (\i acc -> lift2 (flip (:)) acc <<< f i) (pure Nil) + where + rev = foldl (flip Cons) Nil + +instance applyList :: Apply List where + apply Nil _ = Nil + apply (f : fs) xs = (f <$> xs) <> (fs <*> xs) + +instance applicativeList :: Applicative List where + pure a = a : Nil + +instance bindList :: Bind List where + bind Nil _ = Nil + bind (x : xs) f = f x <> bind xs f + +instance monadList :: Monad List + +instance altList :: Alt List where + alt = append + +instance plusList :: Plus List where + empty = Nil + +instance alternativeList :: Alternative List + +instance monadPlusList :: MonadPlus List + +instance extendList :: Extend List where + extend _ Nil = Nil + extend f l@(_ : as) = + f l : (foldr go { val: Nil, acc: Nil } as).val + where + go a' { val, acc } = + let acc' = a' : acc + in { val: f acc' : val, acc: acc' } + +newtype NonEmptyList a = NonEmptyList (NonEmpty List a) + +toList :: NonEmptyList ~> List +toList (NonEmptyList (x :| xs)) = x : xs + +nelCons :: forall a. a -> NonEmptyList a -> NonEmptyList a +nelCons a (NonEmptyList (b :| bs)) = NonEmptyList (a :| b : bs) + +derive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _ + +derive newtype instance eqNonEmptyList :: Eq a => Eq (NonEmptyList a) +derive newtype instance ordNonEmptyList :: Ord a => Ord (NonEmptyList a) + +derive newtype instance eq1NonEmptyList :: Eq1 NonEmptyList +derive newtype instance ord1NonEmptyList :: Ord1 NonEmptyList + +instance showNonEmptyList :: Show a => Show (NonEmptyList a) where + show (NonEmptyList nel) = "(NonEmptyList " <> show nel <> ")" + +derive newtype instance functorNonEmptyList :: Functor NonEmptyList + +instance applyNonEmptyList :: Apply NonEmptyList where + apply (NonEmptyList (f :| fs)) (NonEmptyList (a :| as)) = + NonEmptyList (f a :| (fs <*> a : Nil) <> ((f : fs) <*> as)) + +instance applicativeNonEmptyList :: Applicative NonEmptyList where + pure = NonEmptyList <<< NE.singleton + +instance bindNonEmptyList :: Bind NonEmptyList where + bind (NonEmptyList (a :| as)) f = + case f a of + NonEmptyList (b :| bs) -> + NonEmptyList (b :| bs <> bind as (toList <<< f)) + +instance monadNonEmptyList :: Monad NonEmptyList + +instance altNonEmptyList :: Alt NonEmptyList where + alt = append + +instance extendNonEmptyList :: Extend NonEmptyList where + extend f w@(NonEmptyList (_ :| as)) = + NonEmptyList (f w :| (foldr go { val: Nil, acc: Nil } as).val) + where + go a { val, acc } = { val: f (NonEmptyList (a :| acc)) : val, acc: a : acc } + +instance comonadNonEmptyList :: Comonad NonEmptyList where + extract (NonEmptyList (a :| _)) = a + +instance semigroupNonEmptyList :: Semigroup (NonEmptyList a) where + append (NonEmptyList (a :| as)) as' = + NonEmptyList (a :| as <> toList as') + +derive newtype instance foldableNonEmptyList :: Foldable NonEmptyList + +derive newtype instance traversableNonEmptyList :: Traversable NonEmptyList + +derive newtype instance foldable1NonEmptyList :: Foldable1 NonEmptyList + +derive newtype instance unfoldable1NonEmptyList :: Unfoldable1 NonEmptyList + +instance functorWithIndexNonEmptyList :: FunctorWithIndex Int NonEmptyList where + mapWithIndex fn (NonEmptyList ne) = NonEmptyList $ mapWithIndex (fn <<< maybe 0 (add 1)) ne + +instance foldableWithIndexNonEmptyList :: FoldableWithIndex Int NonEmptyList where + foldMapWithIndex f (NonEmptyList ne) = foldMapWithIndex (f <<< maybe 0 (add 1)) ne + foldlWithIndex f b (NonEmptyList ne) = foldlWithIndex (f <<< maybe 0 (add 1)) b ne + foldrWithIndex f b (NonEmptyList ne) = foldrWithIndex (f <<< maybe 0 (add 1)) b ne + +instance traversableWithIndexNonEmptyList :: TraversableWithIndex Int NonEmptyList where + traverseWithIndex f (NonEmptyList ne) = NonEmptyList <$> traverseWithIndex (f <<< maybe 0 (add 1)) ne + +instance traversable1NonEmptyList :: Traversable1 NonEmptyList where + traverse1 f (NonEmptyList (a :| as)) = + foldl (\acc -> lift2 (flip nelCons) acc <<< f) (pure <$> f a) as + <#> case _ of NonEmptyList (x :| xs) → foldl (flip nelCons) (pure x) xs + sequence1 = traverse1 identity diff --git a/stdlib/lib/Data/List/ZipList.purs b/stdlib/lib/Data/List/ZipList.purs new file mode 100644 index 00000000..09e334d5 --- /dev/null +++ b/stdlib/lib/Data/List/ZipList.purs @@ -0,0 +1,66 @@ +-- | This module defines the type of _zip lists_, i.e. linked lists +-- | with a zippy `Applicative` instance. + +module Data.List.ZipList + ( ZipList(..) + ) where + +import Prelude + +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.Plus (class Plus) +import Data.Foldable (class Foldable) +import Data.List.Lazy (List, drop, length, repeat, zipWith) +import Data.Newtype (class Newtype) +import Data.Traversable (class Traversable) +import Partial.Unsafe (unsafeCrashWith) +import Prim.TypeError (class Fail, Text) + +-- | `ZipList` is a newtype around `List` which provides a zippy +-- | `Applicative` instance. +newtype ZipList a = ZipList (List a) + +instance showZipList :: Show a => Show (ZipList a) where + show (ZipList xs) = "(ZipList " <> show xs <> ")" + +derive instance newtypeZipList :: Newtype (ZipList a) _ + +derive newtype instance eqZipList :: Eq a => Eq (ZipList a) + +derive newtype instance ordZipList :: Ord a => Ord (ZipList a) + +derive newtype instance semigroupZipList :: Semigroup (ZipList a) + +derive newtype instance monoidZipList :: Monoid (ZipList a) + +derive newtype instance foldableZipList :: Foldable ZipList + +derive newtype instance traversableZipList :: Traversable ZipList + +derive newtype instance functorZipList :: Functor ZipList + +instance applyZipList :: Apply ZipList where + apply (ZipList fs) (ZipList xs) = ZipList (zipWith ($) fs xs) + +instance applicativeZipList :: Applicative ZipList where + pure = ZipList <<< repeat + +instance altZipList :: Alt ZipList where + alt (ZipList xs) (ZipList ys) = ZipList $ xs <> drop (length xs) ys + +instance plusZipList :: Plus ZipList where + empty = mempty + +instance alternativeZipList :: Alternative ZipList + +instance zipListIsNotBind + :: Fail (Text """ + ZipList is not Bind. Any implementation would break the associativity law. + + Possible alternatives: + Data.List.List + Data.List.Lazy.List + """) + => Bind ZipList where + bind = unsafeCrashWith "bind: unreachable" diff --git a/stdlib/lib/Data/Map.purs b/stdlib/lib/Data/Map.purs new file mode 100644 index 00000000..4aac96f7 --- /dev/null +++ b/stdlib/lib/Data/Map.purs @@ -0,0 +1,65 @@ +module Data.Map + ( module Data.Map.Internal + , keys + , SemigroupMap(..) + ) where + +import Prelude + +import Control.Alt (class Alt) +import Control.Plus (class Plus) +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable) +import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.FunctorWithIndex (class FunctorWithIndex) +import Data.Map.Internal (Map, alter, catMaybes, checkValid, delete, empty, filter, filterKeys, filterWithKey, findMax, findMin, foldSubmap, fromFoldable, fromFoldableWith, fromFoldableWithIndex, insert, insertWith, isEmpty, isSubmap, lookup, lookupGE, lookupGT, lookupLE, lookupLT, member, pop, showTree, singleton, size, submap, toUnfoldable, toUnfoldableUnordered, union, unionWith, unions, intersection, intersectionWith, difference, update, values, mapMaybeWithKey, mapMaybe, any, anyWithKey) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) +import Data.Traversable (class Traversable) +import Data.TraversableWithIndex (class TraversableWithIndex) +import Data.Set (Set, fromMap) + +-- | The set of keys of the given map. +-- | See also `Data.Set.fromMap`. +keys :: forall k v. Map k v -> Set k +keys = fromMap <<< void + +-- | `SemigroupMap k v` provides a `Semigroup` instance for `Map k v` whose +-- | definition depends on the `Semigroup` instance for the `v` type. +-- | You should only use this type when you need `Data.Map` to have +-- | a `Semigroup` instance. +-- | +-- | ```purescript +-- | let +-- | s :: forall key value. key -> value -> SemigroupMap key value +-- | s k v = SemigroupMap (singleton k v) +-- | +-- | (s 1 "foo") <> (s 1 "bar") == (s 1 "foobar") +-- | (s 1 (First 1)) <> (s 1 (First 2)) == (s 1 (First 1)) +-- | (s 1 (Last 1)) <> (s 1 (Last 2)) == (s 1 (Last 2)) +-- | ``` +newtype SemigroupMap k v = SemigroupMap (Map k v) + +derive newtype instance eq1SemigroupMap :: Eq k => Eq1 (SemigroupMap k) +derive newtype instance eqSemigroupMap :: (Eq k, Eq v) => Eq (SemigroupMap k v) +derive newtype instance ord1SemigroupMap :: Ord k => Ord1 (SemigroupMap k) +derive newtype instance ordSemigroupMap :: (Ord k, Ord v) => Ord (SemigroupMap k v) +derive instance newtypeSemigroupMap :: Newtype (SemigroupMap k v) _ +derive newtype instance showSemigroupMap :: (Show k, Show v) => Show (SemigroupMap k v) + +instance semigroupSemigroupMap :: (Ord k, Semigroup v) => Semigroup (SemigroupMap k v) where + append (SemigroupMap l) (SemigroupMap r) = SemigroupMap (unionWith append l r) + +instance monoidSemigroupMap :: (Ord k, Semigroup v) => Monoid (SemigroupMap k v) where + mempty = SemigroupMap empty + +derive newtype instance altSemigroupMap :: Ord k => Alt (SemigroupMap k) +derive newtype instance plusSemigroupMap :: Ord k => Plus (SemigroupMap k) +derive newtype instance functorSemigroupMap :: Functor (SemigroupMap k) +derive newtype instance functorWithIndexSemigroupMap :: FunctorWithIndex k (SemigroupMap k) +derive newtype instance applySemigroupMap :: Ord k => Apply (SemigroupMap k) +derive newtype instance bindSemigroupMap :: Ord k => Bind (SemigroupMap k) +derive newtype instance foldableSemigroupMap :: Foldable (SemigroupMap k) +derive newtype instance foldableWithIndexSemigroupMap :: FoldableWithIndex k (SemigroupMap k) +derive newtype instance traversableSemigroupMap :: Traversable (SemigroupMap k) +derive newtype instance traversableWithIndexSemigroupMap :: TraversableWithIndex k (SemigroupMap k) diff --git a/stdlib/lib/Data/Map/Gen.purs b/stdlib/lib/Data/Map/Gen.purs new file mode 100644 index 00000000..6398a2db --- /dev/null +++ b/stdlib/lib/Data/Map/Gen.purs @@ -0,0 +1,24 @@ +module Data.Map.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Map (Map, fromFoldable) +import Data.Tuple (Tuple(..)) +import Data.List (List) + +-- | Generates a `Map` using the specified key and value generators. +genMap + :: forall m a b + . MonadRec m + => MonadGen m + => Ord a + => m a + -> m b + -> m (Map a b) +genMap genKey genValue = sized \size -> do + newSize <- chooseInt 0 size + resize (const newSize) $ + (fromFoldable :: List (Tuple a b) -> Map a b) + <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/stdlib/lib/Data/Map/Internal.purs b/stdlib/lib/Data/Map/Internal.purs new file mode 100644 index 00000000..81cc3983 --- /dev/null +++ b/stdlib/lib/Data/Map/Internal.purs @@ -0,0 +1,988 @@ +-- | This module defines a type of maps as height-balanced (AVL) binary trees. +-- | Efficient set operations are implemented in terms of +-- | + +module Data.Map.Internal + ( Map(..) + , showTree + , empty + , isEmpty + , singleton + , checkValid + , insert + , insertWith + , lookup + , lookupLE + , lookupLT + , lookupGE + , lookupGT + , findMin + , findMax + , foldSubmap + , submap + , fromFoldable + , fromFoldableWith + , fromFoldableWithIndex + , toUnfoldable + , toUnfoldableUnordered + , delete + , pop + , member + , alter + , update + , keys + , values + , union + , unionWith + , unions + , intersection + , intersectionWith + , difference + , isSubmap + , size + , filterWithKey + , filterKeys + , filter + , mapMaybeWithKey + , mapMaybe + , catMaybes + , any + , anyWithKey + , MapIter + , MapIterStep(..) + , toMapIter + , stepAsc + , stepAscCps + , stepDesc + , stepDescCps + , stepUnordered + , stepUnorderedCps + , unsafeNode + , unsafeBalancedNode + , unsafeJoinNodes + , unsafeSplit + , Split(..) + ) where + +import Prelude + +import Control.Alt (class Alt) +import Control.Plus (class Plus) +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable, foldl, foldr) +import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex) +import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn7, mkFn2, mkFn3, mkFn4, mkFn7, runFn2, runFn3, runFn4, runFn7) +import Data.FunctorWithIndex (class FunctorWithIndex) +import Data.List (List(..), (:)) +import Data.Maybe (Maybe(..)) +import Data.Ord (class Ord1, abs) +import Data.Traversable (traverse, class Traversable) +import Data.TraversableWithIndex (class TraversableWithIndex) +import Data.Tuple (Tuple(Tuple)) +import Data.Unfoldable (class Unfoldable, unfoldr) +import Prim.TypeError (class Warn, Text) + +-- | `Map k v` represents maps from keys of type `k` to values of type `v`. +data Map k v = Leaf | Node Int Int k v (Map k v) (Map k v) + +type role Map nominal representational + +instance eq1Map :: Eq k => Eq1 (Map k) where + eq1 = eq + +instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where + eq xs ys = case xs of + Leaf -> + case ys of + Leaf -> true + _ -> false + Node _ s1 _ _ _ _ -> + case ys of + Node _ s2 _ _ _ _ + | s1 == s2 -> + toMapIter xs == toMapIter ys + _ -> + false + +instance ord1Map :: Ord k => Ord1 (Map k) where + compare1 = compare + +instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where + compare xs ys = case xs of + Leaf -> + case ys of + Leaf -> EQ + _ -> LT + _ -> + case ys of + Leaf -> GT + _ -> compare (toMapIter xs) (toMapIter ys) + +instance showMap :: (Show k, Show v) => Show (Map k v) where + show as = "(fromFoldable " <> show (toUnfoldable as :: Array _) <> ")" + +instance semigroupMap :: + ( Warn (Text "Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.") + , Ord k + , Semigroup v + ) => Semigroup (Map k v) where + append = unionWith append + +instance monoidSemigroupMap :: + ( Warn (Text "Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.") + , Ord k + , Semigroup v + ) => Monoid (Map k v) where + mempty = empty + +instance altMap :: Ord k => Alt (Map k) where + alt = union + +instance plusMap :: Ord k => Plus (Map k) where + empty = empty + +instance functorMap :: Functor (Map k) where + map f = go + where + go = case _ of + Leaf -> Leaf + Node h s k v l r -> + Node h s k (f v) (go l) (go r) + +instance functorWithIndexMap :: FunctorWithIndex k (Map k) where + mapWithIndex f = go + where + go = case _ of + Leaf -> Leaf + Node h s k v l r -> + Node h s k (f k v) (go l) (go r) + +instance applyMap :: Ord k => Apply (Map k) where + apply = intersectionWith identity + +instance bindMap :: Ord k => Bind (Map k) where + bind m f = mapMaybeWithKey (\k -> lookup k <<< f) m + +instance foldableMap :: Foldable (Map k) where + foldr f z = \m -> runFn2 go m z + where + go = mkFn2 \m' z' -> case m' of + Leaf -> z' + Node _ _ _ v l r -> + runFn2 go l (f v (runFn2 go r z')) + foldl f z = \m -> runFn2 go z m + where + go = mkFn2 \z' m' -> case m' of + Leaf -> z' + Node _ _ _ v l r -> + runFn2 go (f (runFn2 go z' l) v) r + foldMap f = go + where + go = case _ of + Leaf -> mempty + Node _ _ _ v l r -> + go l <> f v <> go r + +instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where + foldrWithIndex f z = \m -> runFn2 go m z + where + go = mkFn2 \m' z' -> case m' of + Leaf -> z' + Node _ _ k v l r -> + runFn2 go l (f k v (runFn2 go r z')) + foldlWithIndex f z = \m -> runFn2 go z m + where + go = mkFn2 \z' m' -> case m' of + Leaf -> z' + Node _ _ k v l r -> + runFn2 go (f k (runFn2 go z' l) v) r + foldMapWithIndex f = go + where + go = case _ of + Leaf -> mempty + Node _ _ k v l r -> + go l <> f k v <> go r + +instance traversableMap :: Traversable (Map k) where + traverse f = go + where + go = case _ of + Leaf -> pure Leaf + Node h s k v l r -> + (\l' v' r' -> Node h s k v' l' r') + <$> go l + <*> f v + <*> go r + sequence = traverse identity + +instance traversableWithIndexMap :: TraversableWithIndex k (Map k) where + traverseWithIndex f = go + where + go = case _ of + Leaf -> pure Leaf + Node h s k v l r -> + (\l' v' r' -> Node h s k v' l' r') + <$> go l + <*> f k v + <*> go r + +-- | Render a `Map` as a `String` +showTree :: forall k v. Show k => Show v => Map k v -> String +showTree = go "" + where + go ind = case _ of + Leaf -> ind <> "Leaf" + Node h _ k v l r -> + (ind <> "[" <> show h <> "] " <> show k <> " => " <> show v <> "\n") + <> (go (ind <> " ") l <> "\n") + <> (go (ind <> " ") r) + +-- | An empty map +empty :: forall k v. Map k v +empty = Leaf + +-- | Test if a map is empty +isEmpty :: forall k v. Map k v -> Boolean +isEmpty Leaf = true +isEmpty _ = false + +-- | Create a map with one key/value pair +singleton :: forall k v. k -> v -> Map k v +singleton k v = Node 1 1 k v Leaf Leaf + +-- | Check whether the underlying tree satisfies the height, size, and ordering invariants. +-- | +-- | This function is provided for internal use. +checkValid :: forall k v. Ord k => Map k v -> Boolean +checkValid = go + where + go = case _ of + Leaf -> true + Node h s k _ l r -> + case l of + Leaf -> + case r of + Leaf -> + true + Node rh rs rk _ _ _ -> + h == 2 && rh == 1 && s > rs && rk > k && go r + Node lh ls lk _ _ _ -> + case r of + Leaf -> + h == 2 && lh == 1 && s > ls && lk < k && go l + Node rh rs rk _ _ _ -> + h > rh && rk > k && h > lh && lk < k && abs (rh - lh) < 2 && rs + ls + 1 == s && go l && go r + +-- | Look up a value for the specified key +lookup :: forall k v. Ord k => k -> Map k v -> Maybe v +lookup k = go + where + go = case _ of + Leaf -> Nothing + Node _ _ mk mv ml mr -> + case compare k mk of + LT -> go ml + GT -> go mr + EQ -> Just mv + +-- | Look up a value for the specified key, or the greatest one less than it +lookupLE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } +lookupLE k = go + where + go = case _ of + Leaf -> Nothing + Node _ _ mk mv ml mr -> + case compare k mk of + LT -> go ml + GT -> + case go mr of + Nothing -> Just { key: mk, value: mv } + other -> other + EQ -> + Just { key: mk, value: mv } + +-- | Look up a value for the greatest key less than the specified key +lookupLT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } +lookupLT k = go + where + go = case _ of + Leaf -> Nothing + Node _ _ mk mv ml mr -> + case compare k mk of + LT -> go ml + GT -> + case go mr of + Nothing -> Just { key: mk, value: mv } + other -> other + EQ -> + findMax ml + +-- | Look up a value for the specified key, or the least one greater than it +lookupGE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } +lookupGE k = go + where + go = case _ of + Leaf -> Nothing + Node _ _ mk mv ml mr -> + case compare k mk of + LT -> + case go ml of + Nothing -> Just { key: mk, value: mv } + other -> other + GT -> go mr + EQ -> Just { key: mk, value: mv } + +-- | Look up a value for the least key greater than the specified key +lookupGT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } +lookupGT k = go + where + go = case _ of + Leaf -> Nothing + Node _ _ mk mv ml mr -> + case compare k mk of + LT -> + case go ml of + Nothing -> Just { key: mk, value: mv } + other -> other + GT -> go mr + EQ -> findMin mr + +-- | Returns the pair with the greatest key +findMax :: forall k v. Map k v -> Maybe { key :: k, value :: v } +findMax = case _ of + Leaf -> Nothing + Node _ _ k v _ r -> + case r of + Leaf -> Just { key: k, value: v } + _ -> findMax r + +-- | Returns the pair with the least key +findMin :: forall k v. Map k v -> Maybe { key :: k, value :: v } +findMin = case _ of + Leaf -> Nothing + Node _ _ k v l _ -> + case l of + Leaf -> Just { key: k, value: v } + _ -> findMin l + +-- | Fold over the entries of a given map where the key is between a lower and +-- | an upper bound. Passing `Nothing` as either the lower or upper bound +-- | argument means that the fold has no lower or upper bound, i.e. the fold +-- | starts from (or ends with) the smallest (or largest) key in the map. +-- | +-- | ```purescript +-- | foldSubmap (Just 1) (Just 2) (\_ v -> [v]) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == ["one", "two"] +-- | +-- | foldSubmap Nothing (Just 2) (\_ v -> [v]) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == ["zero", "one", "two"] +-- | ``` +foldSubmap :: forall k v m. Ord k => Monoid m => Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m +foldSubmap = foldSubmapBy (<>) mempty + +foldSubmapBy :: forall k v m. Ord k => (m -> m -> m) -> m -> Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m +foldSubmapBy appendFn memptyValue kmin kmax f = + let + tooSmall = + case kmin of + Just kmin' -> + \k -> k < kmin' + Nothing -> + const false + + tooLarge = + case kmax of + Just kmax' -> + \k -> k > kmax' + Nothing -> + const false + + inBounds = + case kmin, kmax of + Just kmin', Just kmax' -> + \k -> kmin' <= k && k <= kmax' + Just kmin', Nothing -> + \k -> kmin' <= k + Nothing, Just kmax' -> + \k -> k <= kmax' + Nothing, Nothing -> + const true + + go = case _ of + Leaf -> + memptyValue + Node _ _ k v left right -> + (if tooSmall k then memptyValue else go left) + `appendFn` (if inBounds k then f k v else memptyValue) + `appendFn` (if tooLarge k then memptyValue else go right) + in + go + +-- | Returns a new map containing all entries of the given map which lie +-- | between a given lower and upper bound, treating `Nothing` as no bound i.e. +-- | including the smallest (or largest) key in the map, no matter how small +-- | (or large) it is. For example: +-- | +-- | ```purescript +-- | submap (Just 1) (Just 2) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == fromFoldable [Tuple 1 "one", Tuple 2 "two"] +-- | +-- | submap Nothing (Just 2) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two"] +-- | ``` +-- | +-- | The function is entirely specified by the following +-- | property: +-- | +-- | ```purescript +-- | Given any m :: Map k v, mmin :: Maybe k, mmax :: Maybe k, key :: k, +-- | let m' = submap mmin mmax m in +-- | if (maybe true (\min -> min <= key) mmin && +-- | maybe true (\max -> max >= key) mmax) +-- | then lookup key m == lookup key m' +-- | else not (member key m') +-- | ``` +submap :: forall k v. Ord k => Maybe k -> Maybe k -> Map k v -> Map k v +submap kmin kmax = foldSubmapBy union empty kmin kmax singleton + +-- | Test if a key is a member of a map +member :: forall k v. Ord k => k -> Map k v -> Boolean +member k = go + where + go = case _ of + Leaf -> false + Node _ _ mk _ ml mr -> + case compare k mk of + LT -> go ml + GT -> go mr + EQ -> true + +-- | Insert or replace a key/value pair in a map +insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v +insert k v = go + where + go = case _ of + Leaf -> singleton k v + Node mh ms mk mv ml mr -> + case compare k mk of + LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr + GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) + EQ -> Node mh ms k v ml mr + +-- | Inserts or updates a value with the given function. +-- | +-- | The combining function is called with the existing value as the first +-- | argument and the new value as the second argument. +insertWith :: forall k v. Ord k => (v -> v -> v) -> k -> v -> Map k v -> Map k v +insertWith app k v = go + where + go = case _ of + Leaf -> singleton k v + Node mh ms mk mv ml mr -> + case compare k mk of + LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr + GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) + EQ -> Node mh ms k (app mv v) ml mr + +-- | Delete a key and its corresponding value from a map. +delete :: forall k v. Ord k => k -> Map k v -> Map k v +delete k = go + where + go = case _ of + Leaf -> Leaf + Node _ _ mk mv ml mr -> + case compare k mk of + LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr + GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) + EQ -> runFn2 unsafeJoinNodes ml mr + +-- | Delete a key and its corresponding value from a map, returning the value +-- | as well as the subsequent map. +pop :: forall k v. Ord k => k -> Map k v -> Maybe (Tuple v (Map k v)) +pop k m = do + let (Split x l r) = runFn3 unsafeSplit compare k m + map (\a -> Tuple a (runFn2 unsafeJoinNodes l r)) x + +-- | Insert the value, delete a value, or update a value for a key in a map +alter :: forall k v. Ord k => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +alter f k m = do + let Split v l r = runFn3 unsafeSplit compare k m + case f v of + Nothing -> + runFn2 unsafeJoinNodes l r + Just v' -> + runFn4 unsafeBalancedNode k v' l r + +-- | Update or delete the value for a key in a map +update :: forall k v. Ord k => (v -> Maybe v) -> k -> Map k v -> Map k v +update f k = go + where + go = case _ of + Leaf -> Leaf + Node mh ms mk mv ml mr -> + case compare k mk of + LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr + GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) + EQ -> + case f mv of + Nothing -> + runFn2 unsafeJoinNodes ml mr + Just mv' -> + Node mh ms mk mv' ml mr + +-- | Convert any foldable collection of key/value pairs to a map. +-- | On key collision, later values take precedence over earlier ones. +fromFoldable :: forall f k v. Ord k => Foldable f => f (Tuple k v) -> Map k v +fromFoldable = foldl (\m (Tuple k v) -> insert k v m) empty + +-- | Convert any foldable collection of key/value pairs to a map. +-- | On key collision, the values are configurably combined. +fromFoldableWith :: forall f k v. Ord k => Foldable f => (v -> v -> v) -> f (Tuple k v) -> Map k v +fromFoldableWith f = foldl (\m (Tuple k v) -> f' k v m) empty + where + f' = insertWith (flip f) + +-- | Convert any indexed foldable collection into a map. +fromFoldableWithIndex :: forall f k v. Ord k => FoldableWithIndex k f => f v -> Map k v +fromFoldableWithIndex = foldlWithIndex (\k m v -> insert k v m) empty + +-- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order +toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) +toUnfoldable = unfoldr stepUnfoldr <<< toMapIter + +-- | Convert a map to an unfoldable structure of key/value pairs +-- | +-- | While this traversal is up to 10% faster in benchmarks than `toUnfoldable`, +-- | it leaks the underlying map stucture, making it only suitable for applications +-- | where order is irrelevant. +-- | +-- | If you are unsure, use `toUnfoldable` +toUnfoldableUnordered :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) +toUnfoldableUnordered = unfoldr stepUnfoldrUnordered <<< toMapIter + +-- | Get a list of the keys contained in a map +keys :: forall k v. Map k v -> List k +keys = foldrWithIndex (\k _ acc -> k : acc) Nil + +-- | Get a list of the values contained in a map +values :: forall k v. Map k v -> List v +values = foldr Cons Nil + +-- | Compute the union of two maps, using the specified function +-- | to combine values for duplicate keys. +unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v +unionWith app m1 m2 = runFn4 unsafeUnionWith compare app m1 m2 + +-- | Compute the union of two maps, preferring values from the first map in the case +-- | of duplicate keys +union :: forall k v. Ord k => Map k v -> Map k v -> Map k v +union = unionWith const + +-- | Compute the union of a collection of maps +unions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v +unions = foldl union empty + +-- | Compute the intersection of two maps, using the specified function +-- | to combine values for duplicate keys. +intersectionWith :: forall k a b c. Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c +intersectionWith app m1 m2 = runFn4 unsafeIntersectionWith compare app m1 m2 + +-- | Compute the intersection of two maps, preferring values from the first map in the case +-- | of duplicate keys. +intersection :: forall k a b. Ord k => Map k a -> Map k b -> Map k a +intersection = intersectionWith const + +-- | Difference of two maps. Return elements of the first map where +-- | the keys do not exist in the second map. +difference :: forall k v w. Ord k => Map k v -> Map k w -> Map k v +difference m1 m2 = runFn3 unsafeDifference compare m1 m2 + +-- | Test whether one map contains all of the keys and values contained in another map +isSubmap :: forall k v. Ord k => Eq v => Map k v -> Map k v -> Boolean +isSubmap = go + where + go m1 m2 = case m1 of + Leaf -> true + Node _ _ k v l r -> + case lookup k m2 of + Nothing -> false + Just v' -> + v == v' && go l m2 && go r m2 + +-- | Calculate the number of key/value pairs in a map +size :: forall k v. Map k v -> Int +size = case _ of + Leaf -> 0 + Node _ s _ _ _ _ -> s + +-- | Filter out those key/value pairs of a map for which a predicate +-- | fails to hold. +filterWithKey :: forall k v. Ord k => (k -> v -> Boolean) -> Map k v -> Map k v +filterWithKey f = go + where + go = case _ of + Leaf -> Leaf + Node _ _ k v l r + | f k v -> + runFn4 unsafeBalancedNode k v (go l) (go r) + | otherwise -> + runFn2 unsafeJoinNodes (go l) (go r) + +-- | Filter out those key/value pairs of a map for which a predicate +-- | on the key fails to hold. +filterKeys :: forall k. Ord k => (k -> Boolean) -> Map k ~> Map k +filterKeys f = go + where + go = case _ of + Leaf -> Leaf + Node _ _ k v l r + | f k -> + runFn4 unsafeBalancedNode k v (go l) (go r) + | otherwise -> + runFn2 unsafeJoinNodes (go l) (go r) + +-- | Filter out those key/value pairs of a map for which a predicate +-- | on the value fails to hold. +filter :: forall k v. Ord k => (v -> Boolean) -> Map k v -> Map k v +filter = filterWithKey <<< const + +-- | Applies a function to each key/value pair in a map, discarding entries +-- | where the function returns `Nothing`. +mapMaybeWithKey :: forall k a b. Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b +mapMaybeWithKey f = go + where + go = case _ of + Leaf -> Leaf + Node _ _ k v l r -> + case f k v of + Just v' -> + runFn4 unsafeBalancedNode k v' (go l) (go r) + Nothing -> + runFn2 unsafeJoinNodes (go l) (go r) + +-- | Applies a function to each value in a map, discarding entries where the +-- | function returns `Nothing`. +mapMaybe :: forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b +mapMaybe = mapMaybeWithKey <<< const + +-- | Filter a map of optional values, keeping only the key/value pairs which +-- | contain a value, creating a new map. +catMaybes :: forall k v. Ord k => Map k (Maybe v) -> Map k v +catMaybes = mapMaybe identity + +-- | Returns true if at least one map element satisfies the given predicateon the value, +-- | iterating the map only as necessary and stopping as soon as the predicate +-- | yields true. +any :: forall k v. (v -> Boolean) -> Map k v -> Boolean +any predicate = go + where + go = case _ of + Leaf -> false + Node _ _ _ mv ml mr -> predicate mv || go ml || go mr + +-- | Returns true if at least one map element satisfies the given predicate, +-- | iterating the map only as necessary and stopping as soon as the predicate +-- | yields true. +anyWithKey :: forall k v. (k -> v -> Boolean) -> Map k v -> Boolean +anyWithKey predicate = go + where + go = case _ of + Leaf -> false + Node _ _ mk mv ml mr -> predicate mk mv || go ml || go mr + +-- | Low-level Node constructor which maintains the height and size invariants +-- | This is unsafe because it assumes the child Maps are ordered and balanced. +unsafeNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v) +unsafeNode = mkFn4 \k v l r -> case l of + Leaf -> + case r of + Leaf -> + Node 1 1 k v l r + Node h2 s2 _ _ _ _ -> + Node (1 + h2) (1 + s2) k v l r + Node h1 s1 _ _ _ _ -> + case r of + Leaf -> + Node (1 + h1) (1 + s1) k v l r + Node h2 s2 _ _ _ _ -> + Node (1 + if h1 > h2 then h1 else h2) (1 + s1 + s2) k v l r + +-- | Low-level Node constructor which maintains the balance invariants. +-- | This is unsafe because it assumes the child Maps are ordered. +unsafeBalancedNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v) +unsafeBalancedNode = mkFn4 \k v l r -> case l of + Leaf -> + case r of + Leaf -> + singleton k v + Node rh _ rk rv rl rr + | rh > 1 -> + runFn7 rotateLeft k v l rk rv rl rr + _ -> + runFn4 unsafeNode k v l r + Node lh _ lk lv ll lr -> + case r of + Node rh _ rk rv rl rr + | rh > lh + 1 -> + runFn7 rotateLeft k v l rk rv rl rr + | lh > rh + 1 -> + runFn7 rotateRight k v lk lv ll lr r + Leaf + | lh > 1 -> + runFn7 rotateRight k v lk lv ll lr r + _ -> + runFn4 unsafeNode k v l r + where + rotateLeft :: Fn7 k v (Map k v) k v (Map k v) (Map k v) (Map k v) + rotateLeft = mkFn7 \k v l rk rv rl rr -> case rl of + Node lh _ lk lv ll lr + | lh > height rr -> + runFn4 unsafeNode lk lv (runFn4 unsafeNode k v l ll) (runFn4 unsafeNode rk rv lr rr) + _ -> + runFn4 unsafeNode rk rv (runFn4 unsafeNode k v l rl) rr + + rotateRight :: Fn7 k v k v (Map k v) (Map k v) (Map k v) (Map k v) + rotateRight = mkFn7 \k v lk lv ll lr r -> case lr of + Node rh _ rk rv rl rr + | height ll <= rh -> + runFn4 unsafeNode rk rv (runFn4 unsafeNode lk lv ll rl) (runFn4 unsafeNode k v rr r) + _ -> + runFn4 unsafeNode lk lv ll (runFn4 unsafeNode k v lr r) + + height :: Map k v -> Int + height = case _ of + Leaf -> 0 + Node h _ _ _ _ _ -> h + +-- | Low-level Node constructor from two Maps. +-- | This is unsafe because it assumes the child Maps are ordered. +unsafeJoinNodes :: forall k v. Fn2 (Map k v) (Map k v) (Map k v) +unsafeJoinNodes = mkFn2 case _, _ of + Leaf, b -> b + Node _ _ lk lv ll lr, r -> do + let (SplitLast k v l) = runFn4 unsafeSplitLast lk lv ll lr + runFn4 unsafeBalancedNode k v l r + +data SplitLast k v = SplitLast k v (Map k v) + +-- | Reassociates a node by moving the last node to the top. +-- | This is unsafe because it assumes the key and child Maps are from +-- | a balanced node. +unsafeSplitLast :: forall k v. Fn4 k v (Map k v) (Map k v) (SplitLast k v) +unsafeSplitLast = mkFn4 \k v l r -> case r of + Leaf -> SplitLast k v l + Node _ _ rk rv rl rr -> do + let (SplitLast k' v' t') = runFn4 unsafeSplitLast rk rv rl rr + SplitLast k' v' (runFn4 unsafeBalancedNode k v l t') + +data Split k v = Split (Maybe v) (Map k v) (Map k v) + +-- | Reassocates a Map so the given key is at the top. +-- | This is unsafe because it assumes the ordering function is appropriate. +unsafeSplit :: forall k v. Fn3 (k -> k -> Ordering) k (Map k v) (Split k v) +unsafeSplit = mkFn3 \comp k m -> case m of + Leaf -> + Split Nothing Leaf Leaf + Node _ _ mk mv ml mr -> + case comp k mk of + LT -> do + let (Split b ll lr) = runFn3 unsafeSplit comp k ml + Split b ll (runFn4 unsafeBalancedNode mk mv lr mr) + GT -> do + let (Split b rl rr) = runFn3 unsafeSplit comp k mr + Split b (runFn4 unsafeBalancedNode mk mv ml rl) rr + EQ -> + Split (Just mv) ml mr + +-- | Low-level unionWith implementation. +-- | This is unsafe because it assumes the ordering function is appropriate. +unsafeUnionWith :: forall k v. Fn4 (k -> k -> Ordering) (v -> v -> v) (Map k v) (Map k v) (Map k v) +unsafeUnionWith = mkFn4 \comp app l r -> case l, r of + Leaf, _ -> r + _, Leaf -> l + _, Node _ _ rk rv rl rr -> do + let (Split lv ll lr) = runFn3 unsafeSplit comp rk l + let l' = runFn4 unsafeUnionWith comp app ll rl + let r' = runFn4 unsafeUnionWith comp app lr rr + case lv of + Just lv' -> + runFn4 unsafeBalancedNode rk (app lv' rv) l' r' + Nothing -> + runFn4 unsafeBalancedNode rk rv l' r' + +-- | Low-level intersectionWith implementation. +-- | This is unsafe because it assumes the ordering function is appropriate. +unsafeIntersectionWith :: forall k a b c. Fn4 (k -> k -> Ordering) (a -> b -> c) (Map k a) (Map k b) (Map k c) +unsafeIntersectionWith = mkFn4 \comp app l r -> case l, r of + Leaf, _ -> Leaf + _, Leaf -> Leaf + _, Node _ _ rk rv rl rr -> do + let (Split lv ll lr) = runFn3 unsafeSplit comp rk l + let l' = runFn4 unsafeIntersectionWith comp app ll rl + let r' = runFn4 unsafeIntersectionWith comp app lr rr + case lv of + Just lv' -> + runFn4 unsafeBalancedNode rk (app lv' rv) l' r' + Nothing -> + runFn2 unsafeJoinNodes l' r' + +-- | Low-level difference implementation. +-- | This is unsafe because it assumes the ordering function is appropriate. +unsafeDifference :: forall k v w. Fn3 (k -> k -> Ordering) (Map k v) (Map k w) (Map k v) +unsafeDifference = mkFn3 \comp l r -> case l, r of + Leaf, _ -> Leaf + _, Leaf -> l + _, Node _ _ rk _ rl rr -> do + let (Split _ ll lr) = runFn3 unsafeSplit comp rk l + let l' = runFn3 unsafeDifference comp ll rl + let r' = runFn3 unsafeDifference comp lr rr + runFn2 unsafeJoinNodes l' r' + +data MapIterStep k v + = IterDone + | IterNext k v (MapIter k v) + +-- | Low-level iteration state for a `Map`. Must be consumed using +-- | an appropriate stepper. +data MapIter k v + = IterLeaf + | IterEmit k v (MapIter k v) + | IterNode (Map k v) (MapIter k v) + +instance (Eq k, Eq v) => Eq (MapIter k v) where + eq = go + where + go a b = case stepAsc a of + IterNext k1 v1 a' -> + case stepAsc b of + IterNext k2 v2 b' + | k1 == k2 && v1 == v2 -> + go a' b' + _ -> + false + IterDone -> + true + +instance (Ord k, Ord v) => Ord (MapIter k v) where + compare = go + where + go a b = case stepAsc a, stepAsc b of + IterNext k1 v1 a', IterNext k2 v2 b' -> + case compare k1 k2 of + EQ -> + case compare v1 v2 of + EQ -> + go a' b' + other -> + other + other -> + other + IterDone, b'-> + case b' of + IterDone -> + EQ + _ -> + LT + _, IterDone -> + GT + +-- | Converts a Map to a MapIter for iteration using a MapStepper. +toMapIter :: forall k v. Map k v -> MapIter k v +toMapIter = flip IterNode IterLeaf + +type MapStepper k v = MapIter k v -> MapIterStep k v + +type MapStepperCps k v = forall r. (Fn3 k v (MapIter k v) r) -> (Unit -> r) -> MapIter k v -> r + +-- | Steps a `MapIter` in ascending order. +stepAsc :: forall k v. MapStepper k v +stepAsc = stepAscCps (mkFn3 \k v next -> IterNext k v next) (const IterDone) + +-- | Steps a `MapIter` in descending order. +stepDesc :: forall k v. MapStepper k v +stepDesc = stepDescCps (mkFn3 \k v next -> IterNext k v next) (const IterDone) + +-- | Steps a `MapIter` in arbitrary order. +stepUnordered :: forall k v. MapStepper k v +stepUnordered = stepUnorderedCps (mkFn3 \k v next -> IterNext k v next) (const IterDone) + +-- | Steps a `MapIter` in ascending order with a CPS encoding. +stepAscCps :: forall k v. MapStepperCps k v +stepAscCps = stepWith iterMapL + +-- | Steps a `MapIter` in descending order with a CPS encoding. +stepDescCps :: forall k v. MapStepperCps k v +stepDescCps = stepWith iterMapR + +-- | Steps a `MapIter` in arbitrary order with a CPS encoding. +stepUnorderedCps :: forall k v. MapStepperCps k v +stepUnorderedCps = stepWith iterMapU + +stepUnfoldr :: forall k v. MapIter k v -> Maybe (Tuple (Tuple k v) (MapIter k v)) +stepUnfoldr = stepAscCps step (\_ -> Nothing) + where + step = mkFn3 \k v next -> + Just (Tuple (Tuple k v) next) + +stepUnfoldrUnordered :: forall k v. MapIter k v -> Maybe (Tuple (Tuple k v) (MapIter k v)) +stepUnfoldrUnordered = stepUnorderedCps step (\_ -> Nothing) + where + step = mkFn3 \k v next -> + Just (Tuple (Tuple k v) next) + +stepWith :: forall k v r. (MapIter k v -> Map k v -> MapIter k v) -> (Fn3 k v (MapIter k v) r) -> (Unit -> r) -> MapIter k v -> r +stepWith f next done = go + where + go = case _ of + IterLeaf -> + done unit + IterEmit k v iter -> + runFn3 next k v iter + IterNode m iter -> + go (f iter m) + +iterMapL :: forall k v. MapIter k v -> Map k v -> MapIter k v +iterMapL = go + where + go iter = case _ of + Leaf -> iter + Node _ _ k v l r -> + case r of + Leaf -> + go (IterEmit k v iter) l + _ -> + go (IterEmit k v (IterNode r iter)) l + +iterMapR :: forall k v. MapIter k v -> Map k v -> MapIter k v +iterMapR = go + where + go iter = case _ of + Leaf -> iter + Node _ _ k v l r -> + case r of + Leaf -> + go (IterEmit k v iter) l + _ -> + go (IterEmit k v (IterNode l iter)) r + +iterMapU :: forall k v. MapIter k v -> Map k v -> MapIter k v +iterMapU iter = case _ of + Leaf -> iter + Node _ _ k v l r -> + case l of + Leaf -> + case r of + Leaf -> + IterEmit k v iter + _ -> + IterEmit k v (IterNode r iter) + _ -> + case r of + Leaf -> + IterEmit k v (IterNode l iter) + _ -> + IterEmit k v (IterNode l (IterNode r iter)) diff --git a/stdlib/lib/Data/Maybe.purs b/stdlib/lib/Data/Maybe.purs index 6fe76ef1..743279b1 100644 --- a/stdlib/lib/Data/Maybe.purs +++ b/stdlib/lib/Data/Maybe.purs @@ -1,14 +1,312 @@ - module Data.Maybe where +import Prelude + +import Control.Alt (class Alt, (<|>)) +import Control.Alternative (class Alternative) +import Control.Extend (class Extend) +import Control.Plus (class Plus) + +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.Generic.Rep (class Generic) +import Data.Ord (class Ord1) + +-- | The `Maybe` type is used to represent optional values and can be seen as +-- | something like a type-safe `null`, where `Nothing` is `null` and `Just x` +-- | is the non-null value `x`. data Maybe a = Nothing | Just a +-- | The `Functor` instance allows functions to transform the contents of a +-- | `Just` with the `<$>` operator: +-- | +-- | ``` purescript +-- | f <$> Just x == Just (f x) +-- | ``` +-- | +-- | `Nothing` values are left untouched: +-- | +-- | ``` purescript +-- | f <$> Nothing == Nothing +-- | ``` +instance functorMaybe :: Functor Maybe where + map fn (Just x) = Just (fn x) + map _ _ = Nothing + +-- | The `Apply` instance allows functions contained within a `Just` to +-- | transform a value contained within a `Just` using the `apply` operator: +-- | +-- | ``` purescript +-- | Just f <*> Just x == Just (f x) +-- | ``` +-- | +-- | `Nothing` values are left untouched: +-- | +-- | ``` purescript +-- | Just f <*> Nothing == Nothing +-- | Nothing <*> Just x == Nothing +-- | ``` +-- | +-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used transform a +-- | pure function to take `Maybe`-typed arguments so `f :: a -> b -> c` +-- | becomes `f :: Maybe a -> Maybe b -> Maybe c`: +-- | +-- | ``` purescript +-- | f <$> Just x <*> Just y == Just (f x y) +-- | ``` +-- | +-- | The `Nothing`-preserving behaviour of both operators means the result of +-- | an expression like the above but where any one of the values is `Nothing` +-- | means the whole result becomes `Nothing` also: +-- | +-- | ``` purescript +-- | f <$> Nothing <*> Just y == Nothing +-- | f <$> Just x <*> Nothing == Nothing +-- | f <$> Nothing <*> Nothing == Nothing +-- | ``` +instance applyMaybe :: Apply Maybe where + apply (Just fn) x = fn <$> x + apply Nothing _ = Nothing + +-- | The `Applicative` instance enables lifting of values into `Maybe` with the +-- | `pure` function: +-- | +-- | ``` purescript +-- | pure x :: Maybe _ == Just x +-- | ``` +-- | +-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s +-- | `pure` can be used to pass a mixture of `Maybe` and non-`Maybe` typed +-- | values to a function that does not usually expect them, by using `pure` +-- | for any value that is not already `Maybe` typed: +-- | +-- | ``` purescript +-- | f <$> Just x <*> pure y == Just (f x y) +-- | ``` +-- | +-- | Even though `pure = Just` it is recommended to use `pure` in situations +-- | like this as it allows the choice of `Applicative` to be changed later +-- | without having to go through and replace `Just` with a new constructor. +instance applicativeMaybe :: Applicative Maybe where + pure = Just + +-- | The `Alt` instance allows for a choice to be made between two `Maybe` +-- | values with the `<|>` operator, where the first `Just` encountered +-- | is taken. +-- | +-- | ``` purescript +-- | Just x <|> Just y == Just x +-- | Nothing <|> Just y == Just y +-- | Nothing <|> Nothing == Nothing +-- | ``` +instance altMaybe :: Alt Maybe where + alt Nothing r = r + alt l _ = l + +-- | The `Plus` instance provides a default `Maybe` value: +-- | +-- | ``` purescript +-- | empty :: Maybe _ == Nothing +-- | ``` +instance plusMaybe :: Plus Maybe where + empty = Nothing + +-- | The `Alternative` instance guarantees that there are both `Applicative` and +-- | `Plus` instances for `Maybe`. +instance alternativeMaybe :: Alternative Maybe + +-- | The `Bind` instance allows sequencing of `Maybe` values and functions that +-- | return a `Maybe` by using the `>>=` operator: +-- | +-- | ``` purescript +-- | Just x >>= f = f x +-- | Nothing >>= f = Nothing +-- | ``` +instance bindMaybe :: Bind Maybe where + bind (Just x) k = k x + bind Nothing _ = Nothing + +-- | The `Monad` instance guarantees that there are both `Applicative` and +-- | `Bind` instances for `Maybe`. This also enables the `do` syntactic sugar: +-- | +-- | ``` purescript +-- | do +-- | x' <- x +-- | y' <- y +-- | pure (f x' y') +-- | ``` +-- | +-- | Which is equivalent to: +-- | +-- | ``` purescript +-- | x >>= (\x' -> y >>= (\y' -> pure (f x' y'))) +-- | ``` +-- | +-- | Which is equivalent to: +-- | +-- | ``` purescript +-- | case x of +-- | Nothing -> Nothing +-- | Just x' -> case y of +-- | Nothing -> Nothing +-- | Just y' -> Just (f x' y') +-- | ``` +instance monadMaybe :: Monad Maybe + +-- | The `Extend` instance allows sequencing of `Maybe` values and functions +-- | that accept a `Maybe a` and return a non-`Maybe` result using the +-- | `<<=` operator. +-- | +-- | ``` purescript +-- | f <<= Nothing = Nothing +-- | f <<= x = Just (f x) +-- | ``` +instance extendMaybe :: Extend Maybe where + extend _ Nothing = Nothing + extend f x = Just (f x) + +instance invariantMaybe :: Invariant Maybe where + imap = imapF + +-- | The `Semigroup` instance enables use of the operator `<>` on `Maybe` values +-- | whenever there is a `Semigroup` instance for the type the `Maybe` contains. +-- | The exact behaviour of `<>` depends on the "inner" `Semigroup` instance, +-- | but generally captures the notion of appending or combining things. +-- | +-- | ``` purescript +-- | Just x <> Just y = Just (x <> y) +-- | Just x <> Nothing = Just x +-- | Nothing <> Just y = Just y +-- | Nothing <> Nothing = Nothing +-- | ``` +instance semigroupMaybe :: Semigroup a => Semigroup (Maybe a) where + append Nothing y = y + append x Nothing = x + append (Just x) (Just y) = Just (x <> y) + +instance monoidMaybe :: Semigroup a => Monoid (Maybe a) where + mempty = Nothing + +instance semiringMaybe :: Semiring a => Semiring (Maybe a) where + zero = Nothing + one = Just one + + add Nothing y = y + add x Nothing = x + add (Just x) (Just y) = Just (add x y) + + mul x y = mul <$> x <*> y + +-- | The `Eq` instance allows `Maybe` values to be checked for equality with +-- | `==` and inequality with `/=` whenever there is an `Eq` instance for the +-- | type the `Maybe` contains. +derive instance eqMaybe :: Eq a => Eq (Maybe a) + +instance eq1Maybe :: Eq1 Maybe where eq1 = eq + +-- | The `Ord` instance allows `Maybe` values to be compared with +-- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for +-- | the type the `Maybe` contains. +-- | +-- | `Nothing` is considered to be less than any `Just` value. +derive instance ordMaybe :: Ord a => Ord (Maybe a) + +instance ord1Maybe :: Ord1 Maybe where compare1 = compare + +instance boundedMaybe :: Bounded a => Bounded (Maybe a) where + top = Just top + bottom = Nothing + +-- | The `Show` instance allows `Maybe` values to be rendered as a string with +-- | `show` whenever there is an `Show` instance for the type the `Maybe` +-- | contains. +instance showMaybe :: Show a => Show (Maybe a) where + show (Just x) = "(Just " <> show x <> ")" + show Nothing = "Nothing" + +derive instance genericMaybe :: Generic (Maybe a) _ + +-- | Takes a default value, a function, and a `Maybe` value. If the `Maybe` +-- | value is `Nothing` the default value is returned, otherwise the function +-- | is applied to the value inside the `Just` and the result is returned. +-- | +-- | ``` purescript +-- | maybe x f Nothing == x +-- | maybe x f (Just y) == f y +-- | ``` maybe :: forall a b. b -> (a -> b) -> Maybe a -> b -maybe fallback transform value = case value of - Nothing -> fallback - Just inner -> transform inner +maybe b _ Nothing = b +maybe _ f (Just a) = f a +-- | Similar to `maybe` but for use in cases where the default value may be +-- | expensive to compute. As PureScript is not lazy, the standard `maybe` has +-- | to evaluate the default value before returning the result, whereas here +-- | the value is only computed when the `Maybe` is known to be `Nothing`. +-- | +-- | ``` purescript +-- | maybe' (\_ -> x) f Nothing == x +-- | maybe' (\_ -> x) f (Just y) == f y +-- | ``` +maybe' :: forall a b. (Unit -> b) -> (a -> b) -> Maybe a -> b +maybe' g _ Nothing = g unit +maybe' _ f (Just a) = f a + +-- | Takes a default value, and a `Maybe` value. If the `Maybe` value is +-- | `Nothing` the default value is returned, otherwise the value inside the +-- | `Just` is returned. +-- | +-- | ``` purescript +-- | fromMaybe x Nothing == x +-- | fromMaybe x (Just y) == y +-- | ``` fromMaybe :: forall a. a -> Maybe a -> a -fromMaybe fallback value = case value of - Nothing -> fallback - Just inner -> inner +fromMaybe a = maybe a identity + +-- | Similar to `fromMaybe` but for use in cases where the default value may be +-- | expensive to compute. As PureScript is not lazy, the standard `fromMaybe` +-- | has to evaluate the default value before returning the result, whereas here +-- | the value is only computed when the `Maybe` is known to be `Nothing`. +-- | +-- | ``` purescript +-- | fromMaybe' (\_ -> x) Nothing == x +-- | fromMaybe' (\_ -> x) (Just y) == y +-- | ``` +fromMaybe' :: forall a. (Unit -> a) -> Maybe a -> a +fromMaybe' a = maybe' a identity + +-- | Returns `true` when the `Maybe` value was constructed with `Just`. +isJust :: forall a. Maybe a -> Boolean +isJust = maybe false (const true) + +-- | Returns `true` when the `Maybe` value is `Nothing`. +isNothing :: forall a. Maybe a -> Boolean +isNothing = maybe true (const false) + +-- | A partial function that extracts the value from the `Just` data +-- | constructor. Passing `Nothing` to `fromJust` will throw an error at +-- | runtime. +fromJust :: forall a. Partial => Maybe a -> a +fromJust (Just x) = x + +-- | One or none. +-- | +-- | ```purescript +-- | optional empty = pure Nothing +-- | ``` +-- | +-- | The behaviour of `optional (pure x)` depends on whether the `Alt` instance +-- | satisfy the left catch law (`pure a <|> b = pure a`). +-- | +-- | `Either e` does: +-- | +-- | ```purescript +-- | optional (Right x) = Right (Just x) +-- | ``` +-- | +-- | But `Array` does not: +-- | +-- | ```purescript +-- | optional [x] = [Just x, Nothing] +-- | ``` +optional :: forall f a. Alt f => Applicative f => f a -> f (Maybe a) +optional a = map Just a <|> pure Nothing diff --git a/stdlib/lib/Data/Maybe/First.purs b/stdlib/lib/Data/Maybe/First.purs new file mode 100644 index 00000000..2641c5cb --- /dev/null +++ b/stdlib/lib/Data/Maybe/First.purs @@ -0,0 +1,68 @@ +module Data.Maybe.First where + +import Prelude + +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.Extend (class Extend) +import Control.Plus (class Plus) + +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant) +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) + +-- | Monoid returning the first (left-most) non-`Nothing` value. +-- | +-- | ``` purescript +-- | First (Just x) <> First (Just y) == First (Just x) +-- | First Nothing <> First (Just y) == First (Just y) +-- | First Nothing <> First Nothing == First Nothing +-- | mempty :: First _ == First Nothing +-- | ``` +newtype First a = First (Maybe a) + +derive instance newtypeFirst :: Newtype (First a) _ + +derive newtype instance eqFirst :: (Eq a) => Eq (First a) + +derive newtype instance eq1First :: Eq1 First + +derive newtype instance ordFirst :: (Ord a) => Ord (First a) + +derive newtype instance ord1First :: Ord1 First + +derive newtype instance boundedFirst :: (Bounded a) => Bounded (First a) + +derive newtype instance functorFirst :: Functor First + +derive newtype instance invariantFirst :: Invariant First + +derive newtype instance applyFirst :: Apply First + +derive newtype instance applicativeFirst :: Applicative First + +derive newtype instance bindFirst :: Bind First + +derive newtype instance monadFirst :: Monad First + +derive newtype instance extendFirst :: Extend First + +instance showFirst :: (Show a) => Show (First a) where + show (First a) = "First (" <> show a <> ")" + +instance semigroupFirst :: Semigroup (First a) where + append first@(First (Just _)) _ = first + append _ second = second + +instance monoidFirst :: Monoid (First a) where + mempty = First Nothing + +instance altFirst :: Alt First where + alt = append + +instance plusFirst :: Plus First where + empty = mempty + +instance alternativeFirst :: Alternative First diff --git a/stdlib/lib/Data/Maybe/Last.purs b/stdlib/lib/Data/Maybe/Last.purs new file mode 100644 index 00000000..b70502cd --- /dev/null +++ b/stdlib/lib/Data/Maybe/Last.purs @@ -0,0 +1,67 @@ +module Data.Maybe.Last where + +import Prelude + +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.Extend (class Extend) +import Control.Plus (class Plus) +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant) +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) + +-- | Monoid returning the last (right-most) non-`Nothing` value. +-- | +-- | ``` purescript +-- | Last (Just x) <> Last (Just y) == Last (Just y) +-- | Last (Just x) <> Last Nothing == Last (Just x) +-- | Last Nothing <> Last Nothing == Last Nothing +-- | mempty :: Last _ == Last Nothing +-- | ``` +newtype Last a = Last (Maybe a) + +derive instance newtypeLast :: Newtype (Last a) _ + +derive newtype instance eqLast :: (Eq a) => Eq (Last a) + +derive newtype instance eq1Last :: Eq1 Last + +derive newtype instance ordLast :: (Ord a) => Ord (Last a) + +derive newtype instance ord1Last :: Ord1 Last + +derive newtype instance boundedLast :: (Bounded a) => Bounded (Last a) + +derive newtype instance functorLast :: Functor Last + +derive newtype instance invariantLast :: Invariant Last + +derive newtype instance applyLast :: Apply Last + +derive newtype instance applicativeLast :: Applicative Last + +derive newtype instance bindLast :: Bind Last + +derive newtype instance monadLast :: Monad Last + +derive newtype instance extendLast :: Extend Last + +instance showLast :: Show a => Show (Last a) where + show (Last a) = "(Last " <> show a <> ")" + +instance semigroupLast :: Semigroup (Last a) where + append _ last@(Last (Just _)) = last + append last (Last Nothing) = last + +instance monoidLast :: Monoid (Last a) where + mempty = Last Nothing + +instance altLast :: Alt Last where + alt = append + +instance plusLast :: Plus Last where + empty = mempty + +instance alternativeLast :: Alternative Last diff --git a/stdlib/lib/Data/Monoid.purs b/stdlib/lib/Data/Monoid.purs index 9698f4d3..96edcddd 100644 --- a/stdlib/lib/Data/Monoid.purs +++ b/stdlib/lib/Data/Monoid.purs @@ -1,25 +1,120 @@ --- | The `Monoid` class. --- | --- | `Monoid` is the superclass constraint on `Data.Foldable.foldMap` and --- | `fold`. The class and its `mempty` method are the official surface; the --- | instances are the three types whose `Semigroup` instances already exist, --- | so folding those types does not invent a second appending operation. module Data.Monoid ( class Monoid , mempty + , power + , guard + , module Data.Semigroup + , class MonoidRecord + , memptyRecord ) where -import Data.Semigroup (class Semigroup) +import Data.Boolean (otherwise) +import Data.Eq ((==)) +import Data.EuclideanRing (mod, (/)) +import Data.Ord ((<=)) +import Data.Ordering (Ordering(..)) +import Data.Semigroup (class Semigroup, class SemigroupRecord, (<>)) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit, unit) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeSet) +import Type.Proxy (Proxy(..)) --- | A `Semigroup` with an identity element. +-- | A `Monoid` is a `Semigroup` with a value `mempty`, which is both a +-- | left and right unit for the associative operation `<>`: +-- | +-- | - Left unit: `(mempty <> x) = x` +-- | - Right unit: `(x <> mempty) = x` +-- | +-- | `Monoid`s are commonly used as the result of fold operations, where +-- | `<>` is used to combine individual results, and `mempty` gives the result +-- | of folding an empty collection of elements. +-- | +-- | ### Newtypes for Monoid +-- | +-- | Some types (e.g. `Int`, `Boolean`) can implement multiple law-abiding +-- | instances for `Monoid`. Let's use `Int` as an example +-- | 1. `<>` could be `+` and `mempty` could be `0` +-- | 2. `<>` could be `*` and `mempty` could be `1`. +-- | +-- | To clarify these ambiguous situations, one should use the newtypes +-- | defined in `Data.Monoid.` modules. +-- | +-- | In the above ambiguous situation, we could use `Additive` +-- | for the first situation or `Multiplicative` for the second one. class Semigroup m <= Monoid m where mempty :: m -instance monoidString :: Monoid String where - mempty = "" - instance monoidUnit :: Monoid Unit where mempty = unit +instance monoidOrdering :: Monoid Ordering where + mempty = EQ + +instance monoidFn :: Monoid b => Monoid (a -> b) where + mempty _ = mempty + +instance monoidString :: Monoid String where + mempty = "" + instance monoidArray :: Monoid (Array a) where mempty = [] + +instance monoidRecord :: (RL.RowToList row list, MonoidRecord list row row) => Monoid (Record row) where + mempty = memptyRecord (Proxy :: Proxy list) + +-- | Append a value to itself a certain number of times. For the +-- | `Multiplicative` type, and for a non-negative power, this is the same as +-- | normal number exponentiation. +-- | +-- | If the second argument is negative this function will return `mempty` +-- | (*unlike* normal number exponentiation). The `Monoid` constraint alone +-- | is not enough to write a `power` function with the property that `power x +-- | n` cancels with `power x (-n)`, i.e. `power x n <> power x (-n) = mempty`. +-- | For that, we would additionally need the ability to invert elements, i.e. +-- | a Group. +-- | +-- | ```purescript +-- | power [1,2] 3 == [1,2,1,2,1,2] +-- | power [1,2] 1 == [1,2] +-- | power [1,2] 0 == [] +-- | power [1,2] (-3) == [] +-- | ``` +-- | +power :: forall m. Monoid m => m -> Int -> m +power x = go + where + go :: Int -> m + go p + | p <= 0 = mempty + | p == 1 = x + | p `mod` 2 == 0 = let x' = go (p / 2) in x' <> x' + | otherwise = let x' = go (p / 2) in x' <> x' <> x + +-- | Allow or "truncate" a Monoid to its `mempty` value based on a condition. +guard :: forall m. Monoid m => Boolean -> m -> m +guard true a = a +guard false _ = mempty + +-- | A class for records where all fields have `Monoid` instances, used to +-- | implement the `Monoid` instance for records. +class MonoidRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class SemigroupRecord rowlist row subrow <= MonoidRecord rowlist row subrow | rowlist -> row subrow where + memptyRecord :: Proxy rowlist -> Record subrow + +instance monoidRecordNil :: MonoidRecord RL.Nil row () where + memptyRecord _ = {} + +instance monoidRecordCons :: + ( IsSymbol key + , Monoid focus + , Row.Cons key focus subrowTail subrow + , MonoidRecord rowlistTail row subrowTail + ) => + MonoidRecord (RL.Cons key focus rowlistTail) row subrow where + memptyRecord _ = insert mempty tail + where + key = reflectSymbol (Proxy :: Proxy key) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = memptyRecord (Proxy :: Proxy rowlistTail) diff --git a/stdlib/lib/Data/Monoid/Additive.purs b/stdlib/lib/Data/Monoid/Additive.purs new file mode 100644 index 00000000..62396dd6 --- /dev/null +++ b/stdlib/lib/Data/Monoid/Additive.purs @@ -0,0 +1,44 @@ +module Data.Monoid.Additive where + +import Prelude + +import Data.Eq (class Eq1) +import Data.Ord (class Ord1) + +-- | Monoid and semigroup for semirings under addition. +-- | +-- | ``` purescript +-- | Additive x <> Additive y == Additive (x + y) +-- | (mempty :: Additive _) == Additive zero +-- | ``` +newtype Additive a = Additive a + +derive newtype instance eqAdditive :: Eq a => Eq (Additive a) +derive instance eq1Additive :: Eq1 Additive + +derive newtype instance ordAdditive :: Ord a => Ord (Additive a) +derive instance ord1Additive :: Ord1 Additive + +derive newtype instance boundedAdditive :: Bounded a => Bounded (Additive a) + +instance showAdditive :: Show a => Show (Additive a) where + show (Additive a) = "(Additive " <> show a <> ")" + +derive instance functorAdditive :: Functor Additive + +instance applyAdditive :: Apply Additive where + apply (Additive f) (Additive x) = Additive (f x) + +instance applicativeAdditive :: Applicative Additive where + pure = Additive + +instance bindAdditive :: Bind Additive where + bind (Additive x) f = f x + +instance monadAdditive :: Monad Additive + +instance semigroupAdditive :: Semiring a => Semigroup (Additive a) where + append (Additive a) (Additive b) = Additive (a + b) + +instance monoidAdditive :: Semiring a => Monoid (Additive a) where + mempty = Additive zero diff --git a/stdlib/lib/Data/Monoid/Alternate.purs b/stdlib/lib/Data/Monoid/Alternate.purs new file mode 100644 index 00000000..9a16f1e8 --- /dev/null +++ b/stdlib/lib/Data/Monoid/Alternate.purs @@ -0,0 +1,60 @@ +module Data.Monoid.Alternate where + +import Prelude + +import Control.Alternative (class Alt, class Plus, class Alternative, empty, (<|>)) +import Control.Comonad (class Comonad, class Extend) +import Data.Eq (class Eq1) +import Data.Newtype (class Newtype) +import Data.Ord (class Ord1) + +-- | Monoid and semigroup instances corresponding to `Plus` and `Alt` instances +-- | for `f` +-- | +-- | ``` purescript +-- | Alternate fx <> Alternate fy == Alternate (fx <|> fy) +-- | mempty :: Alternate _ == Alternate empty +-- | ``` +newtype Alternate :: forall k. (k -> Type) -> k -> Type +newtype Alternate f a = Alternate (f a) + +derive instance newtypeAlternate :: Newtype (Alternate f a) _ + +derive newtype instance eqAlternate :: Eq (f a) => Eq (Alternate f a) + +derive newtype instance eq1Alternate :: Eq1 f => Eq1 (Alternate f) + +derive newtype instance ordAlternate :: Ord (f a) => Ord (Alternate f a) + +derive newtype instance ord1Alternate :: Ord1 f => Ord1 (Alternate f) + +derive newtype instance boundedAlternate :: Bounded (f a) => Bounded (Alternate f a) + +derive newtype instance functorAlternate :: Functor f => Functor (Alternate f) + +derive newtype instance applyAlternate :: Apply f => Apply (Alternate f) + +derive newtype instance applicativeAlternate :: Applicative f => Applicative (Alternate f) + +derive newtype instance altAlternate :: Alt f => Alt (Alternate f) + +derive newtype instance plusAlternate :: Plus f => Plus (Alternate f) + +derive newtype instance alternativeAlternate :: Alternative f => Alternative (Alternate f) + +derive newtype instance bindAlternate :: Bind f => Bind (Alternate f) + +derive newtype instance monadAlternate :: Monad f => Monad (Alternate f) + +derive newtype instance extendAlternate :: Extend f => Extend (Alternate f) + +derive newtype instance comonadAlternate :: Comonad f => Comonad (Alternate f) + +instance showAlternate :: Show (f a) => Show (Alternate f a) where + show (Alternate a) = "(Alternate " <> show a <> ")" + +instance semigroupAlternate :: Alt f => Semigroup (Alternate f a) where + append (Alternate a) (Alternate b) = Alternate (a <|> b) + +instance monoidAlternate :: Plus f => Monoid (Alternate f a) where + mempty = Alternate empty diff --git a/stdlib/lib/Data/Monoid/Conj.purs b/stdlib/lib/Data/Monoid/Conj.purs new file mode 100644 index 00000000..6dc93630 --- /dev/null +++ b/stdlib/lib/Data/Monoid/Conj.purs @@ -0,0 +1,51 @@ +module Data.Monoid.Conj where + +import Prelude + +import Data.Eq (class Eq1) +import Data.HeytingAlgebra (ff, tt) +import Data.Ord (class Ord1) + +-- | Monoid and semigroup for conjunction. +-- | +-- | ``` purescript +-- | Conj x <> Conj y == Conj (x && y) +-- | (mempty :: Conj _) == Conj tt +-- | ``` +newtype Conj a = Conj a + +derive newtype instance eqConj :: Eq a => Eq (Conj a) +derive instance eq1Conj :: Eq1 Conj + +derive newtype instance ordConj :: Ord a => Ord (Conj a) +derive instance ord1Conj :: Ord1 Conj + +derive newtype instance boundedConj :: Bounded a => Bounded (Conj a) + +instance showConj :: (Show a) => Show (Conj a) where + show (Conj a) = "(Conj " <> show a <> ")" + +derive instance functorConj :: Functor Conj + +instance applyConj :: Apply Conj where + apply (Conj f) (Conj x) = Conj (f x) + +instance applicativeConj :: Applicative Conj where + pure = Conj + +instance bindConj :: Bind Conj where + bind (Conj x) f = f x + +instance monadConj :: Monad Conj + +instance semigroupConj :: HeytingAlgebra a => Semigroup (Conj a) where + append (Conj a) (Conj b) = Conj (conj a b) + +instance monoidConj :: HeytingAlgebra a => Monoid (Conj a) where + mempty = Conj tt + +instance semiringConj :: HeytingAlgebra a => Semiring (Conj a) where + zero = Conj tt + one = Conj ff + add (Conj a) (Conj b) = Conj (conj a b) + mul (Conj a) (Conj b) = Conj (disj a b) diff --git a/stdlib/lib/Data/Monoid/Disj.purs b/stdlib/lib/Data/Monoid/Disj.purs new file mode 100644 index 00000000..1036c843 --- /dev/null +++ b/stdlib/lib/Data/Monoid/Disj.purs @@ -0,0 +1,51 @@ +module Data.Monoid.Disj where + +import Prelude + +import Data.Eq (class Eq1) +import Data.HeytingAlgebra (ff, tt) +import Data.Ord (class Ord1) + +-- | Monoid and semigroup for disjunction. +-- | +-- | ``` purescript +-- | Disj x <> Disj y == Disj (x || y) +-- | (mempty :: Disj _) == Disj bottom +-- | ``` +newtype Disj a = Disj a + +derive newtype instance eqDisj :: Eq a => Eq (Disj a) +derive instance eq1Disj :: Eq1 Disj + +derive newtype instance ordDisj :: Ord a => Ord (Disj a) +derive instance ord1Disj :: Ord1 Disj + +derive newtype instance boundedDisj :: Bounded a => Bounded (Disj a) + +instance showDisj :: Show a => Show (Disj a) where + show (Disj a) = "(Disj " <> show a <> ")" + +derive instance functorDisj :: Functor Disj + +instance applyDisj :: Apply Disj where + apply (Disj f) (Disj x) = Disj (f x) + +instance applicativeDisj :: Applicative Disj where + pure = Disj + +instance bindDisj :: Bind Disj where + bind (Disj x) f = f x + +instance monadDisj :: Monad Disj + +instance semigroupDisj :: HeytingAlgebra a => Semigroup (Disj a) where + append (Disj a) (Disj b) = Disj (disj a b) + +instance monoidDisj :: HeytingAlgebra a => Monoid (Disj a) where + mempty = Disj ff + +instance semiringDisj :: HeytingAlgebra a => Semiring (Disj a) where + zero = Disj ff + one = Disj tt + add (Disj a) (Disj b) = Disj (disj a b) + mul (Disj a) (Disj b) = Disj (conj a b) diff --git a/stdlib/lib/Data/Monoid/Dual.purs b/stdlib/lib/Data/Monoid/Dual.purs new file mode 100644 index 00000000..09168b88 --- /dev/null +++ b/stdlib/lib/Data/Monoid/Dual.purs @@ -0,0 +1,44 @@ +module Data.Monoid.Dual where + +import Prelude + +import Data.Eq (class Eq1) +import Data.Ord (class Ord1) + +-- | The dual of a monoid. +-- | +-- | ``` purescript +-- | Dual x <> Dual y == Dual (y <> x) +-- | (mempty :: Dual _) == Dual mempty +-- | ``` +newtype Dual a = Dual a + +derive newtype instance eqDual :: Eq a => Eq (Dual a) +derive instance eq1Dual :: Eq1 Dual + +derive newtype instance ordDual :: Ord a => Ord (Dual a) +derive instance ord1Dual :: Ord1 Dual + +derive newtype instance boundedDual :: Bounded a => Bounded (Dual a) + +instance showDual :: Show a => Show (Dual a) where + show (Dual a) = "(Dual " <> show a <> ")" + +derive instance functorDual :: Functor Dual + +instance applyDual :: Apply Dual where + apply (Dual f) (Dual x) = Dual (f x) + +instance applicativeDual :: Applicative Dual where + pure = Dual + +instance bindDual :: Bind Dual where + bind (Dual x) f = f x + +instance monadDual :: Monad Dual + +instance semigroupDual :: Semigroup a => Semigroup (Dual a) where + append (Dual x) (Dual y) = Dual (y <> x) + +instance monoidDual :: Monoid a => Monoid (Dual a) where + mempty = Dual mempty diff --git a/stdlib/lib/Data/Monoid/Endo.purs b/stdlib/lib/Data/Monoid/Endo.purs new file mode 100644 index 00000000..f88ba149 --- /dev/null +++ b/stdlib/lib/Data/Monoid/Endo.purs @@ -0,0 +1,30 @@ +module Data.Monoid.Endo where + +import Prelude + +-- | Monoid and semigroup for category endomorphisms. +-- | +-- | When `c` is instantiated with `->` this composes functions of type +-- | `a -> a`: +-- | +-- | ``` purescript +-- | Endo f <> Endo g == Endo (f <<< g) +-- | (mempty :: Endo _) == Endo identity +-- | ``` +newtype Endo :: forall k. (k -> k -> Type) -> k -> Type +newtype Endo c a = Endo (c a a) + +derive newtype instance eqEndo :: Eq (c a a) => Eq (Endo c a) + +derive newtype instance ordEndo :: Ord (c a a) => Ord (Endo c a) + +derive newtype instance boundedEndo :: Bounded (c a a) => Bounded (Endo c a) + +instance showEndo :: Show (c a a) => Show (Endo c a) where + show (Endo x) = "(Endo " <> show x <> ")" + +instance semigroupEndo :: Semigroupoid c => Semigroup (Endo c a) where + append (Endo a) (Endo b) = Endo (a <<< b) + +instance monoidEndo :: Category c => Monoid (Endo c a) where + mempty = Endo identity diff --git a/stdlib/lib/Data/Monoid/Generic.purs b/stdlib/lib/Data/Monoid/Generic.purs new file mode 100644 index 00000000..a73232df --- /dev/null +++ b/stdlib/lib/Data/Monoid/Generic.purs @@ -0,0 +1,27 @@ +module Data.Monoid.Generic + ( class GenericMonoid + , genericMempty' + , genericMempty + ) where + +import Data.Monoid (class Monoid, mempty) +import Data.Generic.Rep + +class GenericMonoid a where + genericMempty' :: a + +instance genericMonoidNoArguments :: GenericMonoid NoArguments where + genericMempty' = NoArguments + +instance genericMonoidProduct :: (GenericMonoid a, GenericMonoid b) => GenericMonoid (Product a b) where + genericMempty' = Product genericMempty' genericMempty' + +instance genericMonoidConstructor :: GenericMonoid a => GenericMonoid (Constructor name a) where + genericMempty' = Constructor genericMempty' + +instance genericMonoidArgument :: Monoid a => GenericMonoid (Argument a) where + genericMempty' = Argument mempty + +-- | A `Generic` implementation of the `mempty` member from the `Monoid` type class. +genericMempty :: forall a rep. Generic a rep => GenericMonoid rep => a +genericMempty = to genericMempty' diff --git a/stdlib/lib/Data/Monoid/Multiplicative.purs b/stdlib/lib/Data/Monoid/Multiplicative.purs new file mode 100644 index 00000000..c0552a0f --- /dev/null +++ b/stdlib/lib/Data/Monoid/Multiplicative.purs @@ -0,0 +1,44 @@ +module Data.Monoid.Multiplicative where + +import Prelude + +import Data.Eq (class Eq1) +import Data.Ord (class Ord1) + +-- | Monoid and semigroup for semirings under multiplication. +-- | +-- | ``` purescript +-- | Multiplicative x <> Multiplicative y == Multiplicative (x * y) +-- | (mempty :: Multiplicative _) == Multiplicative one +-- | ``` +newtype Multiplicative a = Multiplicative a + +derive newtype instance eqMultiplicative :: Eq a => Eq (Multiplicative a) +derive instance eq1Multiplicative :: Eq1 Multiplicative + +derive newtype instance ordMultiplicative :: Ord a => Ord (Multiplicative a) +derive instance ord1Multiplicative :: Ord1 Multiplicative + +derive newtype instance boundedMultiplicative :: Bounded a => Bounded (Multiplicative a) + +instance showMultiplicative :: Show a => Show (Multiplicative a) where + show (Multiplicative a) = "(Multiplicative " <> show a <> ")" + +derive instance functorMultiplicative :: Functor Multiplicative + +instance applyMultiplicative :: Apply Multiplicative where + apply (Multiplicative f) (Multiplicative x) = Multiplicative (f x) + +instance applicativeMultiplicative :: Applicative Multiplicative where + pure = Multiplicative + +instance bindMultiplicative :: Bind Multiplicative where + bind (Multiplicative x) f = f x + +instance monadMultiplicative :: Monad Multiplicative + +instance semigroupMultiplicative :: Semiring a => Semigroup (Multiplicative a) where + append (Multiplicative a) (Multiplicative b) = Multiplicative (a * b) + +instance monoidMultiplicative :: Semiring a => Monoid (Multiplicative a) where + mempty = Multiplicative one diff --git a/stdlib/lib/Data/NaturalTransformation.purs b/stdlib/lib/Data/NaturalTransformation.purs new file mode 100644 index 00000000..682e8a12 --- /dev/null +++ b/stdlib/lib/Data/NaturalTransformation.purs @@ -0,0 +1,20 @@ +module Data.NaturalTransformation where + +-- | A type for natural transformations. +-- | +-- | A natural transformation is a mapping between type constructors of kind +-- | `k -> Type`, for any kind `k`, where the mapping operation has no ability +-- | to manipulate the inner values. +-- | +-- | An example of this is the `fromFoldable` function provided in +-- | `purescript-lists`, where some foldable structure containing values of +-- | type `a` is converted into a `List a`. +-- | +-- | The definition of a natural transformation in category theory states that +-- | `f` and `g` should be functors, but the `Functor` constraint is not +-- | enforced here; that the types are of kind `k -> Type` is enough for our +-- | purposes. +type NaturalTransformation :: forall k. (k -> Type) -> (k -> Type) -> Type +type NaturalTransformation f g = forall a. f a -> g a + +infixr 4 type NaturalTransformation as ~> diff --git a/stdlib/lib/Data/Newtype.purs b/stdlib/lib/Data/Newtype.purs new file mode 100644 index 00000000..1ac00a93 --- /dev/null +++ b/stdlib/lib/Data/Newtype.purs @@ -0,0 +1,308 @@ +module Data.Newtype where + +import Data.Monoid.Additive (Additive(..)) +import Data.Monoid.Conj (Conj(..)) +import Data.Monoid.Disj (Disj(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Endo (Endo(..)) +import Data.Monoid.Multiplicative (Multiplicative(..)) +import Data.Semigroup.First (First(..)) +import Data.Semigroup.Last (Last(..)) +import Safe.Coerce (class Coercible, coerce) + +-- | A type class for `newtype`s to enable convenient wrapping and unwrapping, +-- | and the use of the other functions in this module. +-- | +-- | The compiler can derive instances of `Newtype` automatically: +-- | +-- | ``` purescript +-- | newtype EmailAddress = EmailAddress String +-- | +-- | derive instance newtypeEmailAddress :: Newtype EmailAddress _ +-- | ``` +-- | +-- | Note that deriving for `Newtype` instances requires that the type be +-- | defined as `newtype` rather than `data` declaration (even if the `data` +-- | structurally fits the rules of a `newtype`), and the use of a wildcard for +-- | the wrapped type. +class Newtype :: Type -> Type -> Constraint +class Coercible t a <= Newtype t a | t -> a + +wrap :: forall t a. Newtype t a => a -> t +wrap = coerce + +unwrap :: forall t a. Newtype t a => t -> a +unwrap = coerce + +instance newtypeAdditive :: Newtype (Additive a) a + +instance newtypeMultiplicative :: Newtype (Multiplicative a) a + +instance newtypeConj :: Newtype (Conj a) a + +instance newtypeDisj :: Newtype (Disj a) a + +instance newtypeDual :: Newtype (Dual a) a + +instance newtypeEndo :: Newtype (Endo c a) (c a a) + +instance newtypeFirst :: Newtype (First a) a + +instance newtypeLast :: Newtype (Last a) a + +-- | Given a constructor for a `Newtype`, this returns the appropriate `unwrap` +-- | function. +un :: forall t a. Newtype t a => (a -> t) -> t -> a +un _ = unwrap + +-- | This combinator unwraps the newtype, applies a monomorphic function to the +-- | contained value and wraps the result back in the newtype +modify :: forall t a. Newtype t a => (a -> a) -> t -> t +modify fn t = wrap (fn (unwrap t)) + +-- | This combinator is for when you have a higher order function that you want +-- | to use in the context of some newtype - `foldMap` being a common example: +-- | +-- | ``` purescript +-- | ala Additive foldMap [1,2,3,4] -- 10 +-- | ala Multiplicative foldMap [1,2,3,4] -- 24 +-- | ala Conj foldMap [true, false] -- false +-- | ala Disj foldMap [true, false] -- true +-- | ``` +ala + :: forall f t a s b + . Coercible (f t) (f a) + => Newtype t a + => Newtype s b + => (a -> t) + -> ((b -> s) -> f t) + -> f a +ala _ f = coerce (f wrap) + +-- | Similar to `ala` but useful for cases where you want to use an additional +-- | projection with the higher order function: +-- | +-- | ``` purescript +-- | alaF Additive foldMap String.length ["hello", "world"] -- 10 +-- | alaF Multiplicative foldMap Math.abs [1.0, -2.0, 3.0, -4.0] -- 24.0 +-- | ``` +-- | +-- | The type admits other possibilities due to the polymorphic `Functor` +-- | constraints, but the case described above works because ((->) a) is a +-- | `Functor`. +alaF + :: forall f g t a s b + . Coercible (f t) (f a) + => Coercible (g s) (g b) + => Newtype t a + => Newtype s b + => (a -> t) + -> (f t -> g s) + -> f a + -> g b +alaF _ = coerce + +-- | Lifts a function operate over newtypes. This can be used to lift a +-- | function to manipulate the contents of a single newtype, somewhat like +-- | `map` does for a `Functor`: +-- | +-- | ``` purescript +-- | newtype Label = Label String +-- | derive instance newtypeLabel :: Newtype Label _ +-- | +-- | toUpperLabel :: Label -> Label +-- | toUpperLabel = over Label String.toUpper +-- | ``` +-- | +-- | But the result newtype is polymorphic, meaning the result can be returned +-- | as an alternative newtype: +-- | +-- | ``` purescript +-- | newtype UppercaseLabel = UppercaseLabel String +-- | derive instance newtypeUppercaseLabel :: Newtype UppercaseLabel _ +-- | +-- | toUpperLabel' :: Label -> UppercaseLabel +-- | toUpperLabel' = over Label String.toUpper +-- | ``` +over + :: forall t a s b + . Newtype t a + => Newtype s b + => (a -> t) + -> (a -> b) + -> t + -> s +over _ = coerce + +-- | Much like `over`, but where the lifted function operates on values in a +-- | `Functor`: +-- | +-- | ``` purescript +-- | findLabel :: String -> Array Label -> Maybe Label +-- | findLabel s = overF Label (Foldable.find (_ == s)) +-- | ``` +-- | +-- | The above example also demonstrates that the functor type is polymorphic +-- | here too, the input is an `Array` but the result is a `Maybe`. +overF + :: forall f g t a s b + . Coercible (f a) (f t) + => Coercible (g b) (g s) + => Newtype t a + => Newtype s b + => (a -> t) + -> (f a -> g b) + -> f t + -> g s +overF _ = coerce + +-- | The opposite of `over`: lowers a function that operates on `Newtype`d +-- | values to operate on the wrapped value instead. +-- | +-- | ``` purescript +-- | newtype Degrees = Degrees Number +-- | derive instance newtypeDegrees :: Newtype Degrees _ +-- | +-- | newtype NormalDegrees = NormalDegrees Number +-- | derive instance newtypeNormalDegrees :: Newtype NormalDegrees _ +-- | +-- | normaliseDegrees :: Degrees -> NormalDegrees +-- | normaliseDegrees (Degrees deg) = NormalDegrees (deg % 360.0) +-- | +-- | asNormalDegrees :: Number -> Number +-- | asNormalDegrees = under Degrees normaliseDegrees +-- | ``` +-- | +-- | As with `over` the `Newtype` is polymorphic, as illustrated in the example +-- | above - both `Degrees` and `NormalDegrees` are instances of `Newtype`, +-- | so even though `normaliseDegrees` changes the result type we can still put +-- | a `Number` in and get a `Number` out via `under`. +under + :: forall t a s b + . Newtype t a + => Newtype s b + => (a -> t) + -> (t -> s) + -> a + -> b +under _ = coerce + +-- | Much like `under`, but where the lifted function operates on values in a +-- | `Functor`: +-- | +-- | ``` purescript +-- | newtype EmailAddress = EmailAddress String +-- | derive instance newtypeEmailAddress :: Newtype EmailAddress _ +-- | +-- | isValid :: EmailAddress -> Boolean +-- | isValid x = false -- imagine a slightly less strict predicate here +-- | +-- | findValidEmailString :: Array String -> Maybe String +-- | findValidEmailString = underF EmailAddress (Foldable.find isValid) +-- | ``` +-- | +-- | The above example also demonstrates that the functor type is polymorphic +-- | here too, the input is an `Array` but the result is a `Maybe`. +underF + :: forall f g t a s b + . Coercible (f t) (f a) + => Coercible (g s) (g b) + => Newtype t a + => Newtype s b + => (a -> t) + -> (f t -> g s) + -> f a + -> g b +underF _ = coerce + +-- | Lifts a binary function to operate over newtypes. +-- | +-- | ``` purescript +-- | newtype Meter = Meter Int +-- | derive newtype instance newtypeMeter :: Newtype Meter _ +-- | newtype SquareMeter = SquareMeter Int +-- | derive newtype instance newtypeSquareMeter :: Newtype SquareMeter _ +-- | +-- | area :: Meter -> Meter -> SquareMeter +-- | area = over2 Meter (*) +-- | ``` +-- | +-- | The above example also demonstrates that the return type is polymorphic +-- | here too. +over2 + :: forall t a s b + . Newtype t a + => Newtype s b + => (a -> t) + -> (a -> a -> b) + -> t + -> t + -> s +over2 _ = coerce + +-- | Much like `over2`, but where the lifted binary function operates on +-- | values in a `Functor`. +overF2 + :: forall f g t a s b + . Coercible (f a) (f t) + => Coercible (g b) (g s) + => Newtype t a + => Newtype s b + => (a -> t) + -> (f a -> f a -> g b) + -> f t + -> f t + -> g s +overF2 _ = coerce + +-- | The opposite of `over2`: lowers a binary function that operates on `Newtype`d +-- | values to operate on the wrapped value instead. +under2 + :: forall t a s b + . Newtype t a + => Newtype s b + => (a -> t) + -> (t -> t -> s) + -> a + -> a + -> b +under2 _ = coerce + +-- | Much like `under2`, but where the lifted binary function operates on +-- | values in a `Functor`. +underF2 + :: forall f g t a s b + . Coercible (f t) (f a) + => Coercible (g s) (g b) + => Newtype t a + => Newtype s b + => (a -> t) + -> (f t -> f t -> g s) + -> f a + -> f a + -> g b +underF2 _ = coerce + +-- | Similar to the function from the `Traversable` class, but operating within +-- | a newtype instead. +traverse + :: forall f t a + . Coercible (f a) (f t) + => Newtype t a + => (a -> t) + -> (a -> f a) + -> t + -> f t +traverse _ = coerce + +-- | Similar to the function from the `Distributive` class, but operating within +-- | a newtype instead. +collect + :: forall f t a + . Coercible (f a) (f t) + => Newtype t a + => (a -> t) + -> (f a -> a) + -> f t + -> t +collect _ = coerce diff --git a/stdlib/lib/Data/NonEmpty.purs b/stdlib/lib/Data/NonEmpty.purs new file mode 100644 index 00000000..411fa856 --- /dev/null +++ b/stdlib/lib/Data/NonEmpty.purs @@ -0,0 +1,174 @@ +-- | This module defines a generic non-empty data structure, which adds an +-- | additional element to any container type. +module Data.NonEmpty + ( NonEmpty(..) + , singleton + , (:|) + , foldl1 + , fromNonEmpty + , oneOf + , head + , tail + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Alternative (class Alternative) +import Control.Plus (class Plus, empty) +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable, foldl, foldr, foldMap) +import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Maybe (Maybe(..), maybe) +import Data.Ord (class Ord1) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Foldable (foldl1) as Foldable1 +import Data.Traversable (class Traversable, traverse, sequence) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) +import Data.Tuple (uncurry) +import Data.Unfoldable (class Unfoldable, unfoldr) +import Data.Unfoldable1 (class Unfoldable1) + +-- | A non-empty container of elements of type a. +-- | +-- | ```purescript +-- | import Data.NonEmpty +-- | +-- | nonEmptyArray :: NonEmpty Array Int +-- | nonEmptyArray = NonEmpty 1 [2,3] +-- | +-- | import Data.List(List(..), (:)) +-- | +-- | nonEmptyList :: NonEmpty List Int +-- | nonEmptyList = NonEmpty 1 (2 : 3 : Nil) +-- | ``` +data NonEmpty f a = NonEmpty a (f a) + +-- | An infix synonym for `NonEmpty`. +-- | +-- | ```purescript +-- | nonEmptyArray :: NonEmpty Array Int +-- | nonEmptyArray = 1 :| [2,3] +-- | +-- | nonEmptyList :: NonEmpty List Int +-- | nonEmptyList = 1 :| 2 : 3 : Nil +-- | ``` +infixr 5 NonEmpty as :| + +-- | Create a non-empty structure with a single value. +-- | +-- | ```purescript +-- | import Prelude +-- | +-- | singleton 1 == 1 :| [] +-- | singleton 1 == 1 :| Nil +-- | ``` +singleton :: forall f a. Plus f => a -> NonEmpty f a +singleton a = a :| empty + +-- | Fold a non-empty structure, collecting results using a binary operation. +-- | +-- | ```purescript +-- | foldl1 (+) (1 :| [2, 3]) == 6 +-- | ``` +foldl1 :: forall f a. Foldable f => (a -> a -> a) -> NonEmpty f a -> a +foldl1 = Foldable1.foldl1 + +-- | Apply a function that takes the `first` element and remaining elements +-- | as arguments to a non-empty container. +-- | +-- | For example, return the remaining elements multiplied by the first element: +-- | +-- | ```purescript +-- | fromNonEmpty (\x xs -> map (_ * x) xs) (3 :| [2, 1]) == [6, 3] +-- | ``` +fromNonEmpty :: forall f a r. (a -> f a -> r) -> NonEmpty f a -> r +fromNonEmpty f (a :| fa) = a `f` fa + +-- | Returns the `alt` (`<|>`) result of: +-- | - The first element lifted to the container of the remaining elements. +-- | - The remaining elements. +-- | +-- | ```purescript +-- | import Data.Maybe(Maybe(..)) +-- | +-- | oneOf (1 :| Nothing) == Just 1 +-- | oneOf (1 :| Just 2) == Just 1 +-- | +-- | oneOf (1 :| [2, 3]) == [1,2,3] +-- | ``` +oneOf :: forall f a. Alternative f => NonEmpty f a -> f a +oneOf (a :| fa) = pure a <|> fa + +-- | Get the 'first' element of a non-empty container. +-- | +-- | ```purescript +-- | head (1 :| [2, 3]) == 1 +-- | ``` +head :: forall f a. NonEmpty f a -> a +head (x :| _) = x + +-- | Get everything but the 'first' element of a non-empty container. +-- | +-- | ```purescript +-- | tail (1 :| [2, 3]) == [2, 3] +-- | ``` +tail :: forall f a. NonEmpty f a -> f a +tail (_ :| xs) = xs + +instance showNonEmpty :: (Show a, Show (f a)) => Show (NonEmpty f a) where + show (a :| fa) = "(NonEmpty " <> show a <> " " <> show fa <> ")" + +derive instance eqNonEmpty :: (Eq1 f, Eq a) => Eq (NonEmpty f a) + +derive instance eq1NonEmpty :: Eq1 f => Eq1 (NonEmpty f) + +derive instance ordNonEmpty :: (Ord1 f, Ord a) => Ord (NonEmpty f a) + +derive instance ord1NonEmpty :: Ord1 f => Ord1 (NonEmpty f) + +derive instance functorNonEmpty :: Functor f => Functor (NonEmpty f) + +instance functorWithIndex + :: FunctorWithIndex i f + => FunctorWithIndex (Maybe i) (NonEmpty f) where + mapWithIndex f (a :| fa) = f Nothing a :| mapWithIndex (f <<< Just) fa + +instance foldableNonEmpty :: Foldable f => Foldable (NonEmpty f) where + foldMap f (a :| fa) = f a <> foldMap f fa + foldl f b (a :| fa) = foldl f (f b a) fa + foldr f b (a :| fa) = f a (foldr f b fa) + +instance foldableWithIndexNonEmpty + :: (FoldableWithIndex i f) + => FoldableWithIndex (Maybe i) (NonEmpty f) where + foldMapWithIndex f (a :| fa) = f Nothing a <> foldMapWithIndex (f <<< Just) fa + foldlWithIndex f b (a :| fa) = foldlWithIndex (f <<< Just) (f Nothing b a) fa + foldrWithIndex f b (a :| fa) = f Nothing a (foldrWithIndex (f <<< Just) b fa) + +instance traversableNonEmpty :: Traversable f => Traversable (NonEmpty f) where + sequence (a :| fa) = NonEmpty <$> a <*> sequence fa + traverse f (a :| fa) = NonEmpty <$> f a <*> traverse f fa + +instance traversableWithIndexNonEmpty + :: (TraversableWithIndex i f) + => TraversableWithIndex (Maybe i) (NonEmpty f) where + traverseWithIndex f (a :| fa) = + NonEmpty <$> f Nothing a <*> traverseWithIndex (f <<< Just) fa + +instance foldable1NonEmpty :: Foldable f => Foldable1 (NonEmpty f) where + foldMap1 f (a :| fa) = foldl (\s a1 -> s <> f a1) (f a) fa + foldr1 f (a :| fa) = maybe a (f a) $ foldr (\a1 -> Just <<< maybe a1 (f a1)) Nothing fa + foldl1 f (a :| fa) = foldl f a fa + +instance unfoldable1NonEmpty :: Unfoldable f => Unfoldable1 (NonEmpty f) where + unfoldr1 f b = uncurry (:|) $ unfoldr (map f) <$> f b + +-- | This is a lawful `Semigroup` instance that will behave sensibly for common nonempty +-- | containers like lists and arrays. However, it's not guaranteed that `pure` will behave +-- | sensibly alongside `<>` for all types, as we don't have any laws which govern their behavior. +instance semigroupNonEmpty + :: (Applicative f, Semigroup (f a)) + => Semigroup (NonEmpty f a) where + append (a1 :| f1) (a2 :| f2) = a1 :| (f1 <> pure a2 <> f2) diff --git a/stdlib/lib/Data/Number.purs b/stdlib/lib/Data/Number.purs new file mode 100644 index 00000000..02b9bc7d --- /dev/null +++ b/stdlib/lib/Data/Number.purs @@ -0,0 +1,388 @@ +-- | Functions for working with PureScripts builtin `Number` type. +module Data.Number + ( fromString + , nan + , isNaN + , infinity + , isFinite + , abs + , acos + , asin + , atan + , atan2 + , ceil + , cos + , exp + , floor + , log + , max + , min + , pow + , remainder, (%) + , round + , sign + , sin + , sqrt + , tan + , trunc + , e + , ln2 + , ln10 + , log10e + , log2e + , pi + , sqrt1_2 + , sqrt2 + , tau + ) where + +import Data.Function.Uncurried (Fn4, runFn4) +import Data.Maybe (Maybe(..)) + +-- | Not a number (NaN). +-- | ```purs +-- | > nan +-- | NaN +-- | ``` +nan :: Number +nan = nan + +-- | Test whether a number is NaN. +-- | ```purs +-- | > isNaN 0.0 +-- | false +-- | +-- | > isNaN nan +-- | true +-- | ``` +isNaN :: Number -> Boolean +isNaN a0 = isNaN a0 + +-- | Positive infinity. For negative infinity use `(-infinity)` +-- | ```purs +-- | > infinity +-- | Infinity +-- | +-- | > (-infinity) +-- | - Infinity +-- | ``` +infinity :: Number +infinity = infinity + +-- | Test whether a number is finite. +-- | ```purs +-- | > isFinite 0.0 +-- | true +-- | +-- | > isFinite infinity +-- | false +-- | +-- | > isFinite (-infinity) +-- | false +-- | +-- | > isFinite nan +-- | false +-- | ``` +isFinite :: Number -> Boolean +isFinite a0 = isFinite a0 + +-- | Attempt to parse a `Number` using JavaScripts `parseFloat`. Returns +-- | `Nothing` if the parse fails or if the result is not a finite number. +-- | +-- | Example: +-- | ```purs +-- | > fromString "123" +-- | (Just 123.0) +-- | +-- | > fromString "12.34" +-- | (Just 12.34) +-- | +-- | > fromString "1e4" +-- | (Just 10000.0) +-- | +-- | > fromString "1.2e4" +-- | (Just 12000.0) +-- | +-- | > fromString "bad" +-- | Nothing +-- | ``` +-- | +-- | Note that `parseFloat` allows for trailing non-digit characters and +-- | whitespace as a prefix: +-- | ``` +-- | > fromString " 1.2 ??" +-- | (Just 1.2) +-- | ``` +fromString :: String -> Maybe Number +fromString str = runFn4 fromStringImpl str isFinite Just Nothing + +fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number) +fromStringImpl = fromStringImpl + +-- | Returns the absolute value of the argument. +-- | ```purs +-- | > x = -42.0 +-- | > sign x * abs x == x +-- | true +-- | ``` +abs :: Number -> Number +abs a0 = abs a0 + +-- | Returns the inverse cosine in radians of the argument. +-- | ```purs +-- | > acos 0.0 == pi / 2.0 +-- | true +-- | ``` +acos :: Number -> Number +acos a0 = acos a0 + +-- | Returns the inverse sine in radians of the argument. +-- | ```purs +-- | > asin 1.0 == pi / 2.0 +-- | true +-- | ``` +asin :: Number -> Number +asin a0 = asin a0 + +-- | Returns the inverse tangent in radians of the argument. +-- | ```purs +-- | > atan 1.0 == pi / 4.0 +-- | true +-- | ``` +atan :: Number -> Number +atan a0 = atan a0 + +-- | Four-quadrant tangent inverse. Given the arguments `y` and `x`, returns +-- | the inverse tangent of `y / x`, where the signs of both arguments are used +-- | to determine the sign of the result. +-- | If the first argument is negative, the result will be negative. +-- | The result is the angle between the positive x axis and a point `(x, y)`. +-- | ```purs +-- | > atan2 0.0 1.0 +-- | 0.0 +-- | > atan2 1.0 0.0 == pi / 2.0 +-- | true +-- | ``` +atan2 :: Number -> Number -> Number +atan2 a0 a1 = atan2 a0 a1 + +-- | Returns the smallest integer not smaller than the argument. +-- | ```purs +-- | > ceil 1.5 +-- | 2.0 +-- | ``` +ceil :: Number -> Number +ceil a0 = ceil a0 + +-- | Returns the cosine of the argument, where the argument is in radians. +-- | ```purs +-- | > cos (pi / 4.0) == sqrt2 / 2.0 +-- | true +-- | ``` +cos :: Number -> Number +cos a0 = cos a0 + +-- | Returns `e` exponentiated to the power of the argument. +-- | ```purs +-- | > exp 1.0 +-- | 2.718281828459045 +-- | ``` +exp :: Number -> Number +exp a0 = exp a0 + +-- | Returns the largest integer not larger than the argument. +-- | ```purs +-- | > floor 1.5 +-- | 1.0 +-- | ``` +floor :: Number -> Number +floor a0 = floor a0 + +-- | Returns the natural logarithm of a number. +-- | ```purs +-- | > log e +-- | 1.0 +log :: Number -> Number +log a0 = log a0 + +-- | Returns the largest of two numbers. Unlike `max` in Data.Ord this version +-- | returns NaN if either argument is NaN. +max :: Number -> Number -> Number +max a0 a1 = max a0 a1 + +-- | Returns the smallest of two numbers. Unlike `min` in Data.Ord this version +-- | returns NaN if either argument is NaN. +min :: Number -> Number -> Number +min a0 a1 = min a0 a1 + +-- | Return the first argument exponentiated to the power of the second argument. +-- | ```purs +-- | > pow 3.0 2.0 +-- | 9.0 +-- | > sqrt 42.0 == pow 42.0 0.5 +-- | true +-- | ``` + +pow :: Number -> Number -> Number +pow a0 a1 = pow a0 a1 + +-- | Computes the remainder after division. This is the same as JavaScript's `%` operator. +-- ```purs +-- > 5.3 % 2.0 +-- 1.2999999999999998 +-- ``` +remainder :: Number -> Number -> Number +remainder a0 a1 = remainder a0 a1 + +infixl 7 remainder as % + +-- | Returns the integer closest to the argument. +-- | ```purs +-- | > round 1.5 +-- | 2.0 +-- | ``` +round :: Number -> Number +round a0 = round a0 + +-- | Returns either a positive or negative +/- 1, indicating the sign of the +-- | argument. If the argument is 0, it will return a +/- 0. If the argument is +-- | NaN it will return NaN. +-- | ```purs +-- | > x = -42.0 +-- | > sign x * abs x == x +-- | true +-- | ``` +sign :: Number -> Number +sign a0 = sign a0 + +-- | Returns the sine of the argument, where the argument is in radians. +-- | ```purs +-- | > sin (pi / 2.0) +-- | 1.0 +-- | ``` +sin :: Number -> Number +sin a0 = sin a0 + +-- | Returns the square root of the argument. +-- | ```purs +-- | > sqrt 49.0 +-- | 7.0 +-- | ``` +sqrt :: Number -> Number +sqrt a0 = sqrt a0 + +-- | Returns the tangent of the argument, where the argument is in radians. +-- | ``` +-- | > tan (pi / 4.0) +-- | 0.9999999999999999 +-- | ``` +tan :: Number -> Number +tan a0 = tan a0 + +-- | Truncates the decimal portion of a number. Equivalent to `floor` if the +-- | number is positive, and `ceil` if the number is negative. +-- | ```purs +-- | ceil 1.5 +-- | 2.0 +-- | ``` +trunc :: Number -> Number +trunc a0 = trunc a0 + +-- | The base of the natural logarithm, also known as Euler's number or *e*. +-- | ```purs +-- | > log e +-- | 1.0 +-- | +-- | > exp 1.0 == e +-- | true +-- | +-- | > e +-- | 2.718281828459045 +-- | ``` +e :: Number +e = 2.718281828459045 + +-- | The natural logarithm of 2. +-- | ```purs +-- | > log 2.0 == ln2 +-- | true +-- | +-- | > ln2 +-- | 0.6931471805599453 +-- | ``` +ln2 :: Number +ln2 = 0.6931471805599453 + +-- | The natural logarithm of 10. +-- | ```purs +-- | > log 10.0 == ln10 +-- | true +-- | +-- | > ln10 +-- | 2.302585092994046 +-- | ``` +ln10 :: Number +ln10 = 2.302585092994046 + +-- | Base 10 logarithm of `e`. +-- | ```purs +-- | > 1.0 / ln10 - log10e +-- | -5.551115123125783e-17 +-- | +-- | > log10e +-- | 0.4342944819032518 +-- | ``` +log10e :: Number +log10e = 0.4342944819032518 + +-- | The base 2 logarithm of `e`. +-- | ```purs +-- | > 1.0 / ln2 == log2e +-- | true +-- | +-- | > log2e +-- | 1.4426950408889634 +-- | ``` +log2e :: Number +log2e = 1.4426950408889634 + +-- | The ratio of the circumference of a circle to its diameter. +-- | ```purs +-- | > pi +-- | 3.141592653589793 +-- | ``` +pi :: Number +pi = 3.141592653589793 + +-- | The square root of one half. +-- | ```purs +-- | > sqrt 0.5 == sqrt1_2 +-- | true +-- | +-- | > sqrt1_2 +-- | 0.7071067811865476 +-- | ``` +sqrt1_2 :: Number +sqrt1_2 = 0.7071067811865476 + +-- | The square root of two. +-- | ```purs +-- | > sqrt 2.0 == sqrt2 +-- | true +-- | +-- | > sqrt2 +-- | 1.4142135623730951 +-- | ``` +sqrt2 :: Number +sqrt2 = 1.4142135623730951 + +-- | The ratio of the circumference of a circle to its radius. +-- | ```purs +-- | > 2.0 * pi == tau +-- | true +-- | +-- | > tau +-- | 6.283185307179586 +-- | ``` +tau :: Number +tau = 6.283185307179586 diff --git a/stdlib/lib/Data/Number/Approximate.purs b/stdlib/lib/Data/Number/Approximate.purs new file mode 100644 index 00000000..b8afcf55 --- /dev/null +++ b/stdlib/lib/Data/Number/Approximate.purs @@ -0,0 +1,95 @@ +-- | This module defines functions for comparing numbers. +module Data.Number.Approximate + ( Fraction(..) + , eqRelative + , eqApproximate + , (~=) + , (≅) + , neqApproximate + , (≇) + , Tolerance(..) + , eqAbsolute + ) where + +import Prelude + +import Data.Number (abs) + +-- | A newtype for (small) numbers, typically in the range *[0:1]*. It is used +-- | as an argument for `eqRelative`. +newtype Fraction = Fraction Number + +-- | Compare two `Number`s and return `true` if they are equal up to the +-- | given *relative* error (`Fraction` parameter). +-- | +-- | This comparison is scale-invariant, i.e. if `eqRelative frac x y`, then +-- | `eqRelative frac (s * x) (s * y)` for a given scale factor `s > 0.0` +-- | (unless one of x, y is exactly `0.0`). +-- | +-- | Note that the relation that `eqRelative frac` induces on `Number` is +-- | not an equivalence relation. It is reflexive and symmetric, but not +-- | transitive. +-- | +-- | Example: +-- | ``` purs +-- | > (eqRelative (Fraction 0.01)) 133.7 133.0 +-- | true +-- | +-- | > (eqRelative (Fraction 0.001)) 133.7 133.0 +-- | false +-- | +-- | > (eqRelative (Fraction 0.01)) (0.1 + 0.2) 0.3 +-- | true +-- | ``` +eqRelative :: Fraction -> Number -> Number -> Boolean +eqRelative (Fraction frac) 0.0 y = abs y <= frac +eqRelative (Fraction frac) x 0.0 = abs x <= frac +eqRelative (Fraction frac) x y = abs (x - y) <= frac * abs (x + y) / 2.0 + +-- | Test if two numbers are approximately equal, up to a relative difference +-- | of one part in a million: +-- | ``` purs +-- | eqApproximate = eqRelative (Fraction 1.0e-6) +-- | ``` +-- | +-- | Example +-- | ``` purs +-- | > 0.1 + 0.2 == 0.3 +-- | false +-- | +-- | > 0.1 + 0.2 ≅ 0.3 +-- | true +-- | ``` +eqApproximate :: Number -> Number -> Boolean +eqApproximate = eqRelative onePPM + where + onePPM :: Fraction + onePPM = Fraction 1.0e-6 + +infix 4 eqApproximate as ~= +infix 4 eqApproximate as ≅ + +-- | The complement of `eqApproximate`. +neqApproximate :: Number -> Number -> Boolean +neqApproximate x y = not (x ≅ y) + +infix 4 neqApproximate as ≇ + +-- | A newtype for (small) numbers. It is used as an argument for `eqAbsolute`. +newtype Tolerance = Tolerance Number + +-- | Compare two `Number`s and return `true` if they are equal up to the given +-- | (absolute) tolerance value. Note that this type of comparison is *not* +-- | scale-invariant. The relation induced by `(eqAbsolute (Tolerance eps))` is +-- | symmetric and reflexive, but not transitive. +-- | +-- | Example: +-- | ``` purs +-- | > (eqAbsolute (Tolerance 1.0)) 133.7 133.0 +-- | true +-- | +-- | > (eqAbsolute (Tolerance 0.1)) 133.7 133.0 +-- | false +-- | ``` +eqAbsolute :: Tolerance -> Number -> Number -> Boolean +eqAbsolute (Tolerance tolerance) x y = abs (x - y) <= tolerance diff --git a/stdlib/lib/Data/Number/Format.purs b/stdlib/lib/Data/Number/Format.purs new file mode 100644 index 00000000..29bb788f --- /dev/null +++ b/stdlib/lib/Data/Number/Format.purs @@ -0,0 +1,80 @@ +-- | A module for formatting numbers as strings. +-- | +-- | Usage: +-- | ``` purs +-- | > let x = 1234.56789 +-- | +-- | > toStringWith (precision 6) x +-- | "1234.57" +-- | +-- | > toStringWith (fixed 3) x +-- | "1234.568" +-- | +-- | > toStringWith (exponential 2) x +-- | "1.23e+3" +-- | ``` +-- | +-- | The main method of this module is the `toStringWith` function that accepts +-- | a `Format` argument which can be constructed through one of the smart +-- | constructors `precision`, `fixed` and `exponential`. Internally, the +-- | number will be formatted with JavaScripts `toPrecision`, `toFixed` or +-- | `toExponential`. +module Data.Number.Format + ( Format() + , precision + , fixed + , exponential + , toStringWith + , toString + ) where + +import Prelude + +toPrecisionNative :: Int -> Number -> String +toPrecisionNative a0 a1 = toPrecisionNative a0 a1 +toFixedNative :: Int -> Number -> String +toFixedNative a0 a1 = toFixedNative a0 a1 +toExponentialNative :: Int -> Number -> String +toExponentialNative a0 a1 = toExponentialNative a0 a1 + +-- | The `Format` data type specifies how a number will be formatted. +data Format + = Precision Int + | Fixed Int + | Exponential Int + +-- | Create a `toPrecision`-based format from an integer. Values smaller than +-- | `1` and larger than `21` will be clamped. +precision :: Int -> Format +precision = Precision <<< clamp 1 21 + +-- | Create a `toFixed`-based format from an integer. Values smaller than `0` +-- | and larger than `20` will be clamped. +fixed :: Int -> Format +fixed = Fixed <<< clamp 0 20 + +-- | Create a `toExponential`-based format from an integer. Values smaller than +-- | `0` and larger than `20` will be clamped. +exponential :: Int -> Format +exponential = Exponential <<< clamp 0 20 + +-- | Convert a number to a string with a given format. +toStringWith :: Format -> Number -> String +toStringWith (Precision p) = toPrecisionNative p +toStringWith (Fixed p) = toFixedNative p +toStringWith (Exponential p) = toExponentialNative p + +-- | Convert a number to a string via JavaScript's toString method. +-- | +-- | ```purs +-- | > toString 12.34 +-- | "12.34" +-- | +-- | > toString 1234.0 +-- | "1234" +-- | +-- | > toString 1.2e-10 +-- | "1.2e-10" +-- | ``` +toString :: Number -> String +toString a0 = toString a0 diff --git a/stdlib/lib/Data/Op.purs b/stdlib/lib/Data/Op.purs new file mode 100644 index 00000000..370451ab --- /dev/null +++ b/stdlib/lib/Data/Op.purs @@ -0,0 +1,22 @@ +module Data.Op where + +import Prelude + +import Data.Functor.Contravariant (class Contravariant) +import Data.Newtype (class Newtype) + +-- | The opposite of the function category. +newtype Op a b = Op (b -> a) + +derive instance newtypeOp :: Newtype (Op a b) _ +derive newtype instance semigroupOp :: Semigroup a ⇒ Semigroup (Op a b) +derive newtype instance monoidOp :: Monoid a => Monoid (Op a b) + +instance semigroupoidOp :: Semigroupoid Op where + compose (Op f) (Op g) = Op (compose g f) + +instance categoryOp :: Category Op where + identity = Op identity + +instance contravariantOp :: Contravariant (Op a) where + cmap f (Op g) = Op (g <<< f) diff --git a/stdlib/lib/Data/Ord.purs b/stdlib/lib/Data/Ord.purs index 3c5d7fe7..97a0ea90 100644 --- a/stdlib/lib/Data/Ord.purs +++ b/stdlib/lib/Data/Ord.purs @@ -1,54 +1,263 @@ --- | The `Ord` class and its `<`, `<=`, `>`, and `>=` operators. --- | --- | `Ord` is a subclass of `Eq`. Each instance is defined by the four --- | comparison intrinsics for the ordered types; `Boolean` is ordered by --- | `false < true` and needs no intrinsic. module Data.Ord ( class Ord + , compare + , class Ord1 + , compare1 , lessThan - , lessThanOrEq - , greaterThan - , greaterThanOrEq , (<) + , lessThanOrEq , (<=) + , greaterThan , (>) + , greaterThanOrEq , (>=) + , comparing + , min + , max + , clamp + , between + , abs + , signum + , module Data.Ordering + , class OrdRecord + , compareRecord ) where -import Data.Eq (class Eq) +import Data.Eq (class Eq, class Eq1, class EqRecord, (/=)) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Ordering (Ordering(..)) +import Data.Ring (class Ring, zero, one, negate) +import Data.Unit (Unit) +import Data.Void (Void) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeGet) +import Type.Proxy (Proxy(..)) --- | A type with a total order. Its `Eq` instance agrees with the order. +-- | The `Ord` type class represents types which support comparisons with a +-- | _total order_. +-- | +-- | `Ord` instances should satisfy the laws of total orderings: +-- | +-- | - Reflexivity: `a <= a` +-- | - Antisymmetry: if `a <= b` and `b <= a` then `a == b` +-- | - Transitivity: if `a <= b` and `b <= c` then `a <= c` +-- | +-- | **Note:** The `Number` type is not an entirely law abiding member of this +-- | class due to the presence of `NaN`, since `NaN <= NaN` evaluates to `false` class Eq a <= Ord a where - lessThan :: a -> a -> Boolean - lessThanOrEq :: a -> a -> Boolean - greaterThan :: a -> a -> Boolean - greaterThanOrEq :: a -> a -> Boolean + compare :: a -> a -> Ordering -infix 4 lessThan as < -infix 4 lessThanOrEq as <= -infix 4 greaterThan as > -infix 4 greaterThanOrEq as >= +instance ordBoolean :: Ord Boolean where + compare x y = ordBooleanImpl LT EQ GT x y instance ordInt :: Ord Int where - lessThan x y = intLt x y - lessThanOrEq x y = intLe x y - greaterThan x y = intGt x y - greaterThanOrEq x y = intGe x y + compare x y = ordIntImpl LT EQ GT x y instance ordNumber :: Ord Number where - lessThan x y = numberLt x y - lessThanOrEq x y = numberLe x y - greaterThan x y = numberGt x y - greaterThanOrEq x y = numberGe x y + compare x y = ordNumberImpl LT EQ GT x y + +instance ordString :: Ord String where + compare x y = ordStringImpl LT EQ GT x y instance ordChar :: Ord Char where - lessThan x y = charLt x y - lessThanOrEq x y = charLe x y - greaterThan x y = charGt x y - greaterThanOrEq x y = charGe x y + compare x y = ordCharImpl LT EQ GT x y -instance ordBoolean :: Ord Boolean where - lessThan left right = if left then false else right - lessThanOrEq left right = if left then right else true - greaterThan left right = if right then false else left - greaterThanOrEq left right = if right then left else true +instance ordUnit :: Ord Unit where + compare _ _ = EQ + +instance ordVoid :: Ord Void where + compare _ _ = EQ + +instance ordProxy :: Ord (Proxy a) where + compare _ _ = EQ + +instance ordArray :: Ord a => Ord (Array a) where + compare = \xs ys -> compare 0 (ordArrayImpl toDelta xs ys) + where + toDelta x y = + case compare x y of + EQ -> 0 + LT -> 1 + GT -> -1 + +ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering +ordBooleanImpl a0 a1 a2 a3 a4 = if booleanEq a3 a4 then a1 else if a3 then a2 else a0 + +ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering +ordIntImpl a0 a1 a2 a3 a4 = if intLt a3 a4 then a0 else if intEq a3 a4 then a1 else a2 + +ordNumberImpl :: Ordering -> Ordering -> Ordering -> Number -> Number -> Ordering +ordNumberImpl a0 a1 a2 a3 a4 = if numberLt a3 a4 then a0 else if numberEq a3 a4 then a1 else a2 + +ordStringImpl :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering +ordStringImpl a0 a1 a2 a3 a4 = ordBytes a0 a1 a2 (stringToBytes a3) (stringToBytes a4) 0 + +ordBytes :: forall a. a -> a -> a -> Array Int -> Array Int -> Int -> a +ordBytes lt eq gt xs ys index = + if intGe index (arrayLength xs) then + if intEq (arrayLength xs) (arrayLength ys) then eq + else if intGt (arrayLength xs) (arrayLength ys) then gt + else lt + else if intGe index (arrayLength ys) then gt + else if intLt (arrayIndex xs index) (arrayIndex ys index) then lt + else if intEq (arrayIndex xs index) (arrayIndex ys index) then ordBytes lt eq gt xs ys (intAdd index 1) + else gt + +ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering +ordCharImpl a0 a1 a2 a3 a4 = if charLt a3 a4 then a0 else if charEq a3 a4 then a1 else a2 + +ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int +ordArrayImpl a0 a1 a2 = ordArrayFrom a0 a1 a2 0 + +ordArrayFrom :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int -> Int +ordArrayFrom compareOne xs ys index = + if intLt index (arrayLength xs) then + if intLt index (arrayLength ys) then + let + order = compareOne (arrayIndex xs index) (arrayIndex ys index) + in + if intEq order 0 then ordArrayFrom compareOne xs ys (intAdd index 1) else order + else intNeg 1 + else if intEq (arrayLength xs) (arrayLength ys) then 0 + else 1 + +instance ordOrdering :: Ord Ordering where + compare LT LT = EQ + compare EQ EQ = EQ + compare GT GT = EQ + compare LT _ = LT + compare EQ LT = GT + compare EQ GT = LT + compare GT _ = GT + +-- | Test whether one value is _strictly less than_ another. +lessThan :: forall a. Ord a => a -> a -> Boolean +lessThan a1 a2 = case a1 `compare` a2 of + LT -> true + _ -> false + +-- | Test whether one value is _strictly greater than_ another. +greaterThan :: forall a. Ord a => a -> a -> Boolean +greaterThan a1 a2 = case a1 `compare` a2 of + GT -> true + _ -> false + +-- | Test whether one value is _non-strictly less than_ another. +lessThanOrEq :: forall a. Ord a => a -> a -> Boolean +lessThanOrEq a1 a2 = case a1 `compare` a2 of + GT -> false + _ -> true + +-- | Test whether one value is _non-strictly greater than_ another. +greaterThanOrEq :: forall a. Ord a => a -> a -> Boolean +greaterThanOrEq a1 a2 = case a1 `compare` a2 of + LT -> false + _ -> true + +infixl 4 lessThan as < +infixl 4 lessThanOrEq as <= +infixl 4 greaterThan as > +infixl 4 greaterThanOrEq as >= + +-- | Compares two values by mapping them to a type with an `Ord` instance. +comparing :: forall a b. Ord b => (a -> b) -> (a -> a -> Ordering) +comparing f x y = compare (f x) (f y) + +-- | Take the minimum of two values. If they are considered equal, the first +-- | argument is chosen. +min :: forall a. Ord a => a -> a -> a +min x y = + case compare x y of + LT -> x + EQ -> x + GT -> y + +-- | Take the maximum of two values. If they are considered equal, the first +-- | argument is chosen. +max :: forall a. Ord a => a -> a -> a +max x y = + case compare x y of + LT -> y + EQ -> x + GT -> x + +-- | Clamp a value between a minimum and a maximum. For example: +-- | +-- | ``` purescript +-- | let f = clamp 0 10 +-- | f (-5) == 0 +-- | f 5 == 5 +-- | f 15 == 10 +-- | ``` +clamp :: forall a. Ord a => a -> a -> a -> a +clamp low hi x = min hi (max low x) + +-- | Test whether a value is between a minimum and a maximum (inclusive). +-- | For example: +-- | +-- | ``` purescript +-- | let f = between 0 10 +-- | f 0 == true +-- | f (-5) == false +-- | f 5 == true +-- | f 10 == true +-- | f 15 == false +-- | ``` +between :: forall a. Ord a => a -> a -> a -> Boolean +between low hi x + | x < low = false + | x > hi = false + | true = true + +-- | The absolute value function. `abs x` is defined as `if x >= zero then x +-- | else negate x`. +abs :: forall a. Ord a => Ring a => a -> a +abs x = if x >= zero then x else negate x + +-- | The sign function; returns `one` if the argument is positive, +-- | `negate one` if the argument is negative, or `zero` if the argument is `zero`. +-- | For floating point numbers with signed zeroes, when called with a zero, +-- | this function returns the argument in order to preserve the sign. +-- | For any `x`, we should have `signum x * abs x == x`. +signum :: forall a. Ord a => Ring a => a -> a +signum x = + if x < zero then negate one + else if x > zero then one + else x + +-- | The `Ord1` type class represents totally ordered type constructors. +class Eq1 f <= Ord1 f where + compare1 :: forall a. Ord a => f a -> f a -> Ordering + +instance ord1Array :: Ord1 Array where + compare1 = compare + +class OrdRecord :: RL.RowList Type -> Row Type -> Constraint +class EqRecord rowlist row <= OrdRecord rowlist row where + compareRecord :: Proxy rowlist -> Record row -> Record row -> Ordering + +instance ordRecordNil :: OrdRecord RL.Nil row where + compareRecord _ _ _ = EQ + +instance ordRecordCons :: + ( OrdRecord rowlistTail row + , Row.Cons key focus rowTail row + , IsSymbol key + , Ord focus + ) => + OrdRecord (RL.Cons key focus rowlistTail) row where + compareRecord _ ra rb = + if left /= EQ then left + else compareRecord (Proxy :: Proxy rowlistTail) ra rb + where + key = reflectSymbol (Proxy :: Proxy key) + unsafeGet' = unsafeGet :: String -> Record row -> focus + left = unsafeGet' key ra `compare` unsafeGet' key rb + +instance ordRecord :: + ( RL.RowToList row list + , OrdRecord list row + ) => + Ord (Record row) where + compare = compareRecord (Proxy :: Proxy list) diff --git a/stdlib/lib/Data/Ord/Down.purs b/stdlib/lib/Data/Ord/Down.purs new file mode 100644 index 00000000..b06e30dd --- /dev/null +++ b/stdlib/lib/Data/Ord/Down.purs @@ -0,0 +1,26 @@ +module Data.Ord.Down where + +import Prelude + +import Data.Newtype (class Newtype) +import Data.Ordering (invert) + +-- | A newtype wrapper which provides a reversed `Ord` instance. For example: +-- | +-- | sortBy (comparing Down) [1,2,3] = [3,2,1] +-- | +newtype Down a = Down a + +derive instance newtypeDown :: Newtype (Down a) _ + +derive newtype instance eqDown :: Eq a => Eq (Down a) + +instance ordDown :: Ord a => Ord (Down a) where + compare (Down x) (Down y) = invert (compare x y) + +instance boundedDown :: Bounded a => Bounded (Down a) where + top = Down bottom + bottom = Down top + +instance showDown :: Show a => Show (Down a) where + show (Down a) = "(Down " <> show a <> ")" diff --git a/stdlib/lib/Data/Ord/Generic.purs b/stdlib/lib/Data/Ord/Generic.purs new file mode 100644 index 00000000..b1e2129c --- /dev/null +++ b/stdlib/lib/Data/Ord/Generic.purs @@ -0,0 +1,39 @@ +module Data.Ord.Generic + ( class GenericOrd + , genericCompare' + , genericCompare + ) where + +import Prelude (class Ord, compare, Ordering(..)) +import Data.Generic.Rep + +class GenericOrd a where + genericCompare' :: a -> a -> Ordering + +instance genericOrdNoConstructors :: GenericOrd NoConstructors where + genericCompare' _ _ = EQ + +instance genericOrdNoArguments :: GenericOrd NoArguments where + genericCompare' _ _ = EQ + +instance genericOrdSum :: (GenericOrd a, GenericOrd b) => GenericOrd (Sum a b) where + genericCompare' (Inl a1) (Inl a2) = genericCompare' a1 a2 + genericCompare' (Inr b1) (Inr b2) = genericCompare' b1 b2 + genericCompare' (Inl _) (Inr _) = LT + genericCompare' (Inr _) (Inl _) = GT + +instance genericOrdProduct :: (GenericOrd a, GenericOrd b) => GenericOrd (Product a b) where + genericCompare' (Product a1 b1) (Product a2 b2) = + case genericCompare' a1 a2 of + EQ -> genericCompare' b1 b2 + other -> other + +instance genericOrdConstructor :: GenericOrd a => GenericOrd (Constructor name a) where + genericCompare' (Constructor a1) (Constructor a2) = genericCompare' a1 a2 + +instance genericOrdArgument :: Ord a => GenericOrd (Argument a) where + genericCompare' (Argument a1) (Argument a2) = compare a1 a2 + +-- | A `Generic` implementation of the `compare` member from the `Ord` type class. +genericCompare :: forall a rep. Generic a rep => GenericOrd rep => a -> a -> Ordering +genericCompare x y = genericCompare' (from x) (from y) diff --git a/stdlib/lib/Data/Ord/Max.purs b/stdlib/lib/Data/Ord/Max.purs new file mode 100644 index 00000000..a076185d --- /dev/null +++ b/stdlib/lib/Data/Ord/Max.purs @@ -0,0 +1,29 @@ +module Data.Ord.Max where + +import Prelude + +import Data.Newtype (class Newtype) + +-- | Provides a `Semigroup` based on the `max` function. If the type has a +-- | `Bounded` instance, then a `Monoid` instance is provided too. For example: +-- | +-- | unwrap (Max 5 <> Max 6) = 6 +-- | mempty :: Max Ordering = Max LT +-- | +newtype Max a = Max a + +derive instance newtypeMax :: Newtype (Max a) _ + +derive newtype instance eqMax :: Eq a => Eq (Max a) + +instance ordMax :: Ord a => Ord (Max a) where + compare (Max x) (Max y) = compare x y + +instance semigroupMax :: Ord a => Semigroup (Max a) where + append (Max x) (Max y) = Max (max x y) + +instance monoidMax :: Bounded a => Monoid (Max a) where + mempty = Max bottom + +instance showMax :: Show a => Show (Max a) where + show (Max a) = "(Max " <> show a <> ")" diff --git a/stdlib/lib/Data/Ord/Min.purs b/stdlib/lib/Data/Ord/Min.purs new file mode 100644 index 00000000..64e6e5c1 --- /dev/null +++ b/stdlib/lib/Data/Ord/Min.purs @@ -0,0 +1,29 @@ +module Data.Ord.Min where + +import Prelude + +import Data.Newtype (class Newtype) + +-- | Provides a `Semigroup` based on the `min` function. If the type has a +-- | `Bounded` instance, then a `Monoid` instance is provided too. For example: +-- | +-- | unwrap (Min 5 <> Min 6) = 5 +-- | mempty :: Min Ordering = Min GT +-- | +newtype Min a = Min a + +derive instance newtypeMin :: Newtype (Min a) _ + +derive newtype instance eqMin :: Eq a => Eq (Min a) + +instance ordMin :: Ord a => Ord (Min a) where + compare (Min x) (Min y) = compare x y + +instance semigroupMin :: Ord a => Semigroup (Min a) where + append (Min x) (Min y) = Min (min x y) + +instance monoidMin :: Bounded a => Monoid (Min a) where + mempty = Min top + +instance showMin :: Show a => Show (Min a) where + show (Min a) = "(Min " <> show a <> ")" diff --git a/stdlib/lib/Data/Ordering.purs b/stdlib/lib/Data/Ordering.purs new file mode 100644 index 00000000..f2477cd2 --- /dev/null +++ b/stdlib/lib/Data/Ordering.purs @@ -0,0 +1,36 @@ +module Data.Ordering (Ordering(..), invert) where + +import Data.Eq (class Eq) +import Data.Semigroup (class Semigroup) +import Data.Show (class Show) + +-- | The `Ordering` data type represents the three possible outcomes of +-- | comparing two values: +-- | +-- | `LT` - The first value is _less than_ the second. +-- | `GT` - The first value is _greater than_ the second. +-- | `EQ` - The first value is _equal to_ the second. +data Ordering = LT | GT | EQ + +instance eqOrdering :: Eq Ordering where + eq LT LT = true + eq GT GT = true + eq EQ EQ = true + eq _ _ = false + +instance semigroupOrdering :: Semigroup Ordering where + append LT _ = LT + append GT _ = GT + append EQ y = y + +instance showOrdering :: Show Ordering where + show LT = "LT" + show GT = "GT" + show EQ = "EQ" + +-- | Reverses an `Ordering` value, flipping greater than for less than while +-- | preserving equality. +invert :: Ordering -> Ordering +invert GT = LT +invert EQ = EQ +invert LT = GT diff --git a/stdlib/lib/Data/Predicate.purs b/stdlib/lib/Data/Predicate.purs new file mode 100644 index 00000000..1d292b9d --- /dev/null +++ b/stdlib/lib/Data/Predicate.purs @@ -0,0 +1,18 @@ +module Data.Predicate where + +import Prelude + +import Data.Functor.Contravariant (class Contravariant) +import Data.Newtype (class Newtype) + +-- | An adaptor allowing `>$<` to map over the inputs of a predicate. +newtype Predicate a = Predicate (a -> Boolean) + +derive instance newtypePredicate :: Newtype (Predicate a) _ + +derive newtype instance heytingAlgebraPredicate :: HeytingAlgebra (Predicate a) + +derive newtype instance booleanAlgebraPredicate :: BooleanAlgebra (Predicate a) + +instance contravariantPredicate :: Contravariant Predicate where + cmap f (Predicate g) = Predicate (g <<< f) diff --git a/stdlib/lib/Data/Profunctor.purs b/stdlib/lib/Data/Profunctor.purs new file mode 100644 index 00000000..29c626a8 --- /dev/null +++ b/stdlib/lib/Data/Profunctor.purs @@ -0,0 +1,44 @@ +module Data.Profunctor where + +import Prelude +import Data.Newtype (class Newtype, wrap, unwrap) + +-- | A `Profunctor` is a `Functor` from the pair category `(Type^op, Type)` +-- | to `Type`. +-- | +-- | In other words, a `Profunctor` is a type constructor of two type +-- | arguments, which is contravariant in its first argument and covariant +-- | in its second argument. +-- | +-- | The `dimap` function can be used to map functions over both arguments +-- | simultaneously. +-- | +-- | A straightforward example of a profunctor is the function arrow `(->)`. +-- | +-- | Laws: +-- | +-- | - Identity: `dimap identity identity = identity` +-- | - Composition: `dimap f1 g1 <<< dimap f2 g2 = dimap (f1 >>> f2) (g1 <<< g2)` +class Profunctor p where + dimap :: forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d + +-- | Map a function over the (contravariant) first type argument only. +lcmap :: forall a b c p. Profunctor p => (a -> b) -> p b c -> p a c +lcmap a2b = dimap a2b identity + +-- | Map a function over the (covariant) second type argument only. +rmap :: forall a b c p. Profunctor p => (b -> c) -> p a b -> p a c +rmap b2c = dimap identity b2c + +-- | Lift a pure function into any `Profunctor` which is also a `Category`. +arr :: forall a b p. Category p => Profunctor p => (a -> b) -> p a b +arr f = rmap f identity + +unwrapIso :: forall p t a. Profunctor p => Newtype t a => p t t -> p a a +unwrapIso = dimap wrap unwrap + +wrapIso :: forall p t a. Profunctor p => Newtype t a => (a -> t) -> p a a -> p t t +wrapIso _ = dimap unwrap wrap + +instance profunctorFn :: Profunctor (->) where + dimap a2b c2d b2c = a2b >>> b2c >>> c2d diff --git a/stdlib/lib/Data/Profunctor/Choice.purs b/stdlib/lib/Data/Profunctor/Choice.purs new file mode 100644 index 00000000..2003445d --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Choice.purs @@ -0,0 +1,83 @@ +module Data.Profunctor.Choice where + +import Prelude + +import Data.Either (Either(..), either) +import Data.Profunctor (class Profunctor, rmap) + +-- | The `Choice` class extends `Profunctor` with combinators for working with +-- | sum types. +-- | +-- | `left` and `right` lift values in a `Profunctor` to act on the `Left` and +-- | `Right` components of a sum, respectively. +-- | +-- | Looking at `Choice` through the intuition of inputs and outputs +-- | yields the following type signature: +-- | ``` +-- | left :: forall input output a. p input output -> p (Either input a) (Either output a) +-- | right :: forall input output a. p input output -> p (Either a input) (Either a output) +-- | ``` +-- | If we specialize the profunctor `p` to the `function` arrow, we get the following type +-- | signatures: +-- | ``` +-- | left :: forall input output a. (input -> output) -> (Either input a) -> (Either output a) +-- | right :: forall input output a. (input -> output) -> (Either a input) -> (Either a output) +-- | ``` +-- | When the `profunctor` is `Function` application, `left` allows you to map a function over the +-- | left side of an `Either`, and `right` maps it over the right side (same as `map` would do). +class Profunctor p <= Choice p where + left :: forall a b c. p a b -> p (Either a c) (Either b c) + right :: forall a b c. p b c -> p (Either a b) (Either a c) + +instance choiceFn :: Choice (->) where + left a2b (Left a) = Left $ a2b a + left _ (Right c) = Right c + right = (<$>) + +-- | Compose a value acting on a sum from two values, each acting on one of +-- | the components of the sum. +-- | +-- | Specializing `(+++)` to function application would look like this: +-- | ``` +-- | (+++) :: forall a b c d. (a -> b) -> (c -> d) -> (Either a c) -> (Either b d) +-- | ``` +-- | We take two functions, `f` and `g`, and we transform them into a single function which +-- | takes an `Either`and maps `f` over the left side and `g` over the right side. Just like +-- | `bi-map` would do for the `bi-functor` instance of `Either`. +splitChoice + :: forall p a b c d + . Semigroupoid p + => Choice p + => p a b + -> p c d + -> p (Either a c) (Either b d) +splitChoice l r = left l >>> right r + +infixr 2 splitChoice as +++ + +-- | Compose a value which eliminates a sum from two values, each eliminating +-- | one side of the sum. +-- | +-- | This combinator is useful when assembling values from smaller components, +-- | because it provides a way to support two different types of input. +-- | +-- | Specializing `(|||)` to function application would look like this: +-- | ``` +-- | (|||) :: forall a b c d. (a -> c) -> (b -> c) -> Either a b -> c +-- | ``` +-- | We take two functions, `f` and `g`, which both return the same type `c` and we transform them into a +-- | single function which takes an `Either` value with the parameter type of `f` on the left side and +-- | the parameter type of `g` on the right side. The function then runs either `f` or `g`, depending on +-- | whether the `Either` value is a `Left` or a `Right`. +-- | This allows us to bundle two different computations which both have the same result type into one +-- | function which will run the approriate computation based on the parameter supplied in the `Either` value. +fanin + :: forall p a b c + . Semigroupoid p + => Choice p + => p a c + -> p b c + -> p (Either a b) c +fanin l r = rmap (either identity identity) (l +++ r) + +infixr 2 fanin as ||| diff --git a/stdlib/lib/Data/Profunctor/Closed.purs b/stdlib/lib/Data/Profunctor/Closed.purs new file mode 100644 index 00000000..fae4b5a4 --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Closed.purs @@ -0,0 +1,12 @@ +module Data.Profunctor.Closed where + +import Prelude + +import Data.Profunctor (class Profunctor) + +-- | The `Closed` class extends the `Profunctor` class to work with functions. +class Profunctor p <= Closed p where + closed :: forall a b x. p a b -> p (x -> a) (x -> b) + +instance closedFunction :: Closed Function where + closed = (<<<) diff --git a/stdlib/lib/Data/Profunctor/Cochoice.purs b/stdlib/lib/Data/Profunctor/Cochoice.purs new file mode 100644 index 00000000..0eb9cbf0 --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Cochoice.purs @@ -0,0 +1,9 @@ +module Data.Profunctor.Cochoice where + +import Data.Either (Either) +import Data.Profunctor (class Profunctor) + +-- | The `Cochoice` class provides the dual operations of the `Choice` class. +class Profunctor p <= Cochoice p where + unleft :: forall a b c. p (Either a c) (Either b c) -> p a b + unright :: forall a b c. p (Either a b) (Either a c) -> p b c diff --git a/stdlib/lib/Data/Profunctor/Costrong.purs b/stdlib/lib/Data/Profunctor/Costrong.purs new file mode 100644 index 00000000..0e4695b5 --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Costrong.purs @@ -0,0 +1,9 @@ +module Data.Profunctor.Costrong where + +import Data.Tuple (Tuple) +import Data.Profunctor (class Profunctor) + +-- | The `Costrong` class provides the dual operations of the `Strong` class. +class Profunctor p <= Costrong p where + unfirst :: forall a b c. p (Tuple a c) (Tuple b c) -> p a b + unsecond :: forall a b c. p (Tuple a b) (Tuple a c) -> p b c diff --git a/stdlib/lib/Data/Profunctor/Join.purs b/stdlib/lib/Data/Profunctor/Join.purs new file mode 100644 index 00000000..e5a047c0 --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Join.purs @@ -0,0 +1,28 @@ +module Data.Profunctor.Join where + +import Prelude + +import Data.Functor.Invariant (class Invariant) +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor, dimap) + +-- | Turns a `Profunctor` into a `Invariant` functor by equating the two type +-- | arguments. +newtype Join :: forall k. (k -> k -> Type) -> k -> Type +newtype Join p a = Join (p a a) + +derive instance newtypeJoin :: Newtype (Join p a) _ +derive newtype instance eqJoin :: Eq (p a a) => Eq (Join p a) +derive newtype instance ordJoin :: Ord (p a a) => Ord (Join p a) + +instance showJoin :: Show (p a a) => Show (Join p a) where + show (Join x) = "(Join " <> show x <> ")" + +instance semigroupJoin :: Semigroupoid p => Semigroup (Join p a) where + append (Join a) (Join b) = Join (a <<< b) + +instance monoidJoin :: Category p => Monoid (Join p a) where + mempty = Join identity + +instance invariantJoin :: Profunctor p => Invariant (Join p) where + imap f g (Join a) = Join (dimap g f a) diff --git a/stdlib/lib/Data/Profunctor/Split.purs b/stdlib/lib/Data/Profunctor/Split.purs new file mode 100644 index 00000000..01d08db3 --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Split.purs @@ -0,0 +1,39 @@ +module Data.Profunctor.Split + ( Split + , split + , unSplit + , liftSplit + , lowerSplit + , hoistSplit + ) where + +import Prelude + +import Data.Exists (Exists, mkExists, runExists) +import Data.Functor.Invariant (class Invariant, imap) +import Data.Profunctor (class Profunctor) + +newtype Split f a b = Split (Exists (SplitF f a b)) + +data SplitF f a b x = SplitF (a -> x) (x -> b) (f x) + +instance functorSplit :: Functor (Split f a) where + map f = unSplit \g h fx -> split g (f <<< h) fx + +instance profunctorSplit :: Profunctor (Split f) where + dimap f g = unSplit \h i -> split (h <<< f) (g <<< i) + +split :: forall f a b x. (a -> x) -> (x -> b) -> f x -> Split f a b +split f g fx = Split (mkExists (SplitF f g fx)) + +unSplit :: forall f a b r. (forall x. (a -> x) -> (x -> b) -> f x -> r) -> Split f a b -> r +unSplit f (Split e) = runExists (\(SplitF g h fx) -> f g h fx) e + +liftSplit :: forall f a. f a -> Split f a a +liftSplit = split identity identity + +lowerSplit :: forall f a. Invariant f => Split f a a -> f a +lowerSplit = unSplit (flip imap) + +hoistSplit :: forall f g a b. (f ~> g) -> Split f a b -> Split g a b +hoistSplit nat = unSplit (\f g -> split f g <<< nat) diff --git a/stdlib/lib/Data/Profunctor/Star.purs b/stdlib/lib/Data/Profunctor/Star.purs new file mode 100644 index 00000000..25ec7e9c --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Star.purs @@ -0,0 +1,80 @@ +module Data.Profunctor.Star where + +import Prelude + +import Control.Alt (class Alt, (<|>)) +import Control.Alternative (class Alternative) +import Control.MonadPlus (class MonadPlus) +import Control.Plus (class Plus, empty) + +import Data.Distributive (class Distributive, distribute, collect) +import Data.Either (Either(..), either) +import Data.Functor.Invariant (class Invariant, imap) +import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor) +import Data.Profunctor.Choice (class Choice) +import Data.Profunctor.Closed (class Closed) +import Data.Profunctor.Strong (class Strong) +import Data.Tuple (Tuple(..)) + +-- | `Star` turns a `Functor` into a `Profunctor`. +-- | +-- | `Star f` is also the Kleisli category for `f` +newtype Star :: forall k. (k -> Type) -> Type -> k -> Type +newtype Star f a b = Star (a -> f b) + +derive instance newtypeStar :: Newtype (Star f a b) _ + +instance semigroupoidStar :: Bind f => Semigroupoid (Star f) where + compose (Star f) (Star g) = Star \x -> g x >>= f + +instance categoryStar :: Monad f => Category (Star f) where + identity = Star pure + +instance functorStar :: Functor f => Functor (Star f a) where + map f (Star g) = Star (map f <<< g) + +instance invariantStar :: Invariant f => Invariant (Star f a) where + imap f g (Star h) = Star (imap f g <<< h) + +instance applyStar :: Apply f => Apply (Star f a) where + apply (Star f) (Star g) = Star \a -> f a <*> g a + +instance applicativeStar :: Applicative f => Applicative (Star f a) where + pure a = Star \_ -> pure a + +instance bindStar :: Bind f => Bind (Star f a) where + bind (Star m) f = Star \x -> m x >>= \a -> case f a of Star g -> g x + +instance monadStar :: Monad f => Monad (Star f a) + +instance altStar :: Alt f => Alt (Star f a) where + alt (Star f) (Star g) = Star \a -> f a <|> g a + +instance plusStar :: Plus f => Plus (Star f a) where + empty = Star \_ -> empty + +instance alternativeStar :: Alternative f => Alternative (Star f a) + +instance monadPlusStar :: MonadPlus f => MonadPlus (Star f a) + +instance distributiveStar :: Distributive f => Distributive (Star f a) where + distribute f = Star \a -> collect (\(Star g) -> g a) f + collect f = distribute <<< map f + +instance profunctorStar :: Functor f => Profunctor (Star f) where + dimap f g (Star ft) = Star (f >>> ft >>> map g) + +instance strongStar :: Functor f => Strong (Star f) where + first (Star f) = Star \(Tuple s x) -> map (_ `Tuple` x) (f s) + second (Star f) = Star \(Tuple x s) -> map (Tuple x) (f s) + +instance choiceStar :: Applicative f => Choice (Star f) where + left (Star f) = Star $ either (map Left <<< f) (pure <<< Right) + right (Star f) = Star $ either (pure <<< Left) (map Right <<< f) + +instance closedStar :: Distributive f => Closed (Star f) where + closed (Star f) = Star \g -> distribute (f <<< g) + +hoistStar :: forall f g a b. (f ~> g) -> Star f a b -> Star g a b +hoistStar f (Star g) = Star (f <<< g) diff --git a/stdlib/lib/Data/Profunctor/Strong.purs b/stdlib/lib/Data/Profunctor/Strong.purs new file mode 100644 index 00000000..1b4784d0 --- /dev/null +++ b/stdlib/lib/Data/Profunctor/Strong.purs @@ -0,0 +1,80 @@ +module Data.Profunctor.Strong where + +import Prelude + +import Data.Profunctor (class Profunctor, lcmap) +import Data.Tuple (Tuple(..)) + +-- | The `Strong` class extends `Profunctor` with combinators for working with +-- | product types. +-- | +-- | `first` and `second` lift values in a `Profunctor` to act on the first and +-- | second components of a `Tuple`, respectively. +-- | +-- | Another way to think about Strong is to piggyback on the intuition of +-- | inputs and outputs. Rewriting the type signature in this light then yields: +-- | ``` +-- | first :: forall input output a. p input output -> p (Tuple input a) (Tuple output a) +-- | second :: forall input output a. p input output -> p (Tuple a input) (Tuple a output) +-- | ``` +-- | If we specialize the profunctor p to the function arrow, we get the following type +-- | signatures, which may look a bit more familiar: +-- | ``` +-- | first :: forall input output a. (input -> output) -> (Tuple input a) -> (Tuple output a) +-- | second :: forall input output a. (input -> output) -> (Tuple a input) -> (Tuple a output) +-- | ``` +-- | So, when the `profunctor` is `Function` application, `first` essentially applies your function +-- | to the first element of a `Tuple`, and `second` applies it to the second element (same as `map` would do). +class Profunctor p <= Strong p where + first :: forall a b c. p a b -> p (Tuple a c) (Tuple b c) + second :: forall a b c. p b c -> p (Tuple a b) (Tuple a c) + +instance strongFn :: Strong (->) where + first a2b (Tuple a c) = Tuple (a2b a) c + second = (<$>) + +-- | Compose a value acting on a `Tuple` from two values, each acting on one of +-- | the components of the `Tuple`. +-- | +-- | Specializing `(***)` to function application would look like this: +-- | ``` +-- | (***) :: forall a b c d. (a -> b) -> (c -> d) -> (Tuple a c) -> (Tuple b d) +-- | ``` +-- | We take two functions, `f` and `g`, and we transform them into a single function which +-- | takes a `Tuple` and maps `f` over the first element and `g` over the second. Just like `bi-map` +-- | would do for the `bi-functor` instance of `Tuple`. +splitStrong + :: forall p a b c d + . Semigroupoid p + => Strong p + => p a b + -> p c d + -> p (Tuple a c) (Tuple b d) +splitStrong l r = first l >>> second r + +infixr 3 splitStrong as *** + +-- | Compose a value which introduces a `Tuple` from two values, each introducing +-- | one side of the `Tuple`. +-- | +-- | This combinator is useful when assembling values from smaller components, +-- | because it provides a way to support two different types of output. +-- | +-- | Specializing `(&&&)` to function application would look like this: +-- | ``` +-- | (&&&) :: forall a b c. (a -> b) -> (a -> c) -> (a -> (Tuple b c)) +-- | ``` +-- | We take two functions, `f` and `g`, with the same parameter type and we transform them into a +-- | single function which takes one parameter and returns a `Tuple` of the results of running +-- | `f` and `g` on the parameter, respectively. This allows us to run two parallel computations +-- | on the same input and return both results in a `Tuple`. +fanout + :: forall p a b c + . Semigroupoid p + => Strong p + => p a b + -> p a c + -> p a (Tuple b c) +fanout l r = lcmap (\a -> Tuple a a) (l *** r) + +infixr 3 fanout as &&& diff --git a/stdlib/lib/Data/Reflectable.purs b/stdlib/lib/Data/Reflectable.purs new file mode 100644 index 00000000..edf2fc1a --- /dev/null +++ b/stdlib/lib/Data/Reflectable.purs @@ -0,0 +1,58 @@ +module Data.Reflectable + ( class Reflectable + , class Reifiable + , reflectType + , reifyType + ) where + +import Data.Ord (Ordering) +import Type.Proxy (Proxy(..)) + +-- | A type-class for reflectable types. +-- | +-- | Instances for the following kinds are solved by the compiler: +-- | * Boolean +-- | * Int +-- | * Ordering +-- | * Symbol +class Reflectable :: forall k. k -> Type -> Constraint +class Reflectable v t | v -> t where + -- | Reflect a type `v` to its term-level representation. + reflectType :: Proxy v -> t + +-- | A type class for reifiable types. +-- | +-- | Instances of this type class correspond to the `t` synthesized +-- | by the compiler when solving the `Reflectable` type class. +class Reifiable :: Type -> Constraint +class Reifiable t + +instance Reifiable Boolean +instance Reifiable Int +instance Reifiable Ordering +instance Reifiable String + +-- local definition for use in `reifyType` +unsafeCoerce :: forall a b. a -> b +unsafeCoerce a0 = unsafeCoerce a0 + +-- | Reify a value of type `t` such that it can be consumed by a +-- | function constrained by the `Reflectable` type class. For +-- | example: +-- | +-- | ```purs +-- | twiceFromType :: forall v. Reflectable v Int => Proxy v -> Int +-- | twiceFromType = (_ * 2) <<< reflectType +-- | +-- | twiceOfTerm :: Int +-- | twiceOfTerm = reifyType 21 twiceFromType +-- | ``` +reifyType :: forall t r. Reifiable t => t -> (forall v. Reflectable v t => Proxy v -> r) -> r +reifyType s f = coerce f { reflectType: \_ -> s } Proxy + where + coerce + :: (forall v. Reflectable v t => Proxy v -> r) + -> { reflectType :: Proxy _ -> t } + -> Proxy _ + -> r + coerce = unsafeCoerce diff --git a/stdlib/lib/Data/Ring.purs b/stdlib/lib/Data/Ring.purs new file mode 100644 index 00000000..4e8c879b --- /dev/null +++ b/stdlib/lib/Data/Ring.purs @@ -0,0 +1,79 @@ +module Data.Ring + ( class Ring + , sub + , negate + , (-) + , module Data.Semiring + , class RingRecord + , subRecord + ) where + +import Data.Semiring (class Semiring, class SemiringRecord, add, mul, one, zero, (*), (+)) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit, unit) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeGet, unsafeSet) +import Type.Proxy (Proxy(..)) + +-- | The `Ring` class is for types that support addition, multiplication, +-- | and subtraction operations. +-- | +-- | Instances must satisfy the following laws in addition to the `Semiring` +-- | laws: +-- | +-- | - Additive inverse: `a - a = zero` +-- | - Compatibility of `sub` and `negate`: `a - b = a + (zero - b)` +class Semiring a <= Ring a where + sub :: a -> a -> a + +infixl 6 sub as - + +instance ringInt :: Ring Int where + sub x y = intSub x y + +instance ringNumber :: Ring Number where + sub x y = numSub x y + +instance ringUnit :: Ring Unit where + sub _ _ = unit + +instance ringFn :: Ring b => Ring (a -> b) where + sub f g x = f x - g x + +instance ringProxy :: Ring (Proxy a) where + sub _ _ = Proxy + +instance ringRecord :: (RL.RowToList row list, RingRecord list row row) => Ring (Record row) where + sub = subRecord (Proxy :: Proxy list) + +-- | `negate x` can be used as a shorthand for `zero - x`. +negate :: forall a. Ring a => a -> a +negate a = zero - a + + +numSub :: Number -> Number -> Number +numSub a0 a1 = numberSub a0 a1 + +-- | A class for records where all fields have `Ring` instances, used to +-- | implement the `Ring` instance for records. +class RingRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class SemiringRecord rowlist row subrow <= RingRecord rowlist row subrow | rowlist -> subrow where + subRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + +instance ringRecordNil :: RingRecord RL.Nil row () where + subRecord _ _ _ = {} + +instance ringRecordCons :: + ( IsSymbol key + , Row.Cons key focus subrowTail subrow + , RingRecord rowlistTail row subrowTail + , Ring focus + ) => + RingRecord (RL.Cons key focus rowlistTail) row subrow where + subRecord _ ra rb = insert (get ra - get rb) tail + where + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + tail = subRecord (Proxy :: Proxy rowlistTail) ra rb diff --git a/stdlib/lib/Data/Ring/Generic.purs b/stdlib/lib/Data/Ring/Generic.purs new file mode 100644 index 00000000..a93208d1 --- /dev/null +++ b/stdlib/lib/Data/Ring/Generic.purs @@ -0,0 +1,24 @@ +module Data.Ring.Generic where + +import Prelude + +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) + +class GenericRing a where + genericSub' :: a -> a -> a + +instance genericRingNoArguments :: GenericRing NoArguments where + genericSub' _ _ = NoArguments + +instance genericRingArgument :: Ring a => GenericRing (Argument a) where + genericSub' (Argument x) (Argument y) = Argument (sub x y) + +instance genericRingProduct :: (GenericRing a, GenericRing b) => GenericRing (Product a b) where + genericSub' (Product a1 b1) (Product a2 b2) = Product (genericSub' a1 a2) (genericSub' b1 b2) + +instance genericRingConstructor :: GenericRing a => GenericRing (Constructor name a) where + genericSub' (Constructor a1) (Constructor a2) = Constructor (genericSub' a1 a2) + +-- | A `Generic` implementation of the `sub` member from the `Ring` type class. +genericSub :: forall a rep. Generic a rep => GenericRing rep => a -> a -> a +genericSub x y = to $ from x `genericSub'` from y diff --git a/stdlib/lib/Data/Semigroup.purs b/stdlib/lib/Data/Semigroup.purs index bdef6d10..4d5ef48a 100644 --- a/stdlib/lib/Data/Semigroup.purs +++ b/stdlib/lib/Data/Semigroup.purs @@ -1,32 +1,86 @@ --- | The `Semigroup` class and its `<>` operator. --- | --- | This is the first class the library itself declares. The class, its --- | method, and the operator alias are all re-exported from `Prelude`, which --- | is what the corpus imports. --- | --- | `append` for `String` is built from the effect-free `stringToBytes` / --- | `arrayAppend` / `bytesToString` primitives rather than a second string --- | concatenation path. Joining two well-formed UTF-8 byte sequences always --- | yields well-formed UTF-8, so `bytesToString`'s validation is a no-op here --- | and the one string representation stays the only writer --- | ([DEC-16](../../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). module Data.Semigroup ( class Semigroup , append , (<>) + , class SemigroupRecord + , appendRecord ) where --- | A type with an associative binary operation. +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit, unit) +import Data.Void (Void, absurd) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeGet, unsafeSet) +import Type.Proxy (Proxy(..)) + +-- | The `Semigroup` type class identifies an associative operation on a type. +-- | +-- | Instances are required to satisfy the following law: +-- | +-- | - Associativity: `(x <> y) <> z = x <> (y <> z)` +-- | +-- | One example of a `Semigroup` is `String`, with `(<>)` defined as string +-- | concatenation. Another example is `List a`, with `(<>)` defined as +-- | list concatenation. +-- | +-- | ### Newtypes for Semigroup +-- | +-- | There are two other ways to implement an instance for this type class +-- | regardless of which type is used. These instances can be used by +-- | wrapping the values in one of the two newtypes below: +-- | 1. `First` - Use the first argument every time: `append first _ = first`. +-- | 2. `Last` - Use the last argument every time: `append _ last = last`. class Semigroup a where append :: a -> a -> a infixr 5 append as <> instance semigroupString :: Semigroup String where - append left right = bytesToString (arrayAppend (stringToBytes left) (stringToBytes right)) + append x y = concatString x y instance semigroupUnit :: Semigroup Unit where append _ _ = unit +instance semigroupVoid :: Semigroup Void where + append _ = absurd + +instance semigroupFn :: Semigroup s' => Semigroup (s -> s') where + append f g x = f x <> g x + instance semigroupArray :: Semigroup (Array a) where - append left right = arrayAppend left right + append x y = concatArray x y + +instance semigroupProxy :: Semigroup (Proxy a) where + append _ _ = Proxy + +instance semigroupRecord :: (RL.RowToList row list, SemigroupRecord list row row) => Semigroup (Record row) where + append = appendRecord (Proxy :: Proxy list) + +concatString :: String -> String -> String +concatString a0 a1 = bytesToString (arrayAppend (stringToBytes a0) (stringToBytes a1)) +concatArray :: forall a. Array a -> Array a -> Array a +concatArray a0 a1 = arrayAppend a0 a1 + +-- | A class for records where all fields have `Semigroup` instances, used to +-- | implement the `Semigroup` instance for records. +class SemigroupRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class SemigroupRecord rowlist row subrow | rowlist -> subrow where + appendRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + +instance semigroupRecordNil :: SemigroupRecord RL.Nil row () where + appendRecord _ _ _ = {} + +instance semigroupRecordCons :: + ( IsSymbol key + , Row.Cons key focus subrowTail subrow + , SemigroupRecord rowlistTail row subrowTail + , Semigroup focus + ) => + SemigroupRecord (RL.Cons key focus rowlistTail) row subrow where + appendRecord _ ra rb = insert (get ra <> get rb) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + tail = appendRecord (Proxy :: Proxy rowlistTail) ra rb diff --git a/stdlib/lib/Data/Semigroup/First.purs b/stdlib/lib/Data/Semigroup/First.purs new file mode 100644 index 00000000..18681bb0 --- /dev/null +++ b/stdlib/lib/Data/Semigroup/First.purs @@ -0,0 +1,40 @@ +module Data.Semigroup.First where + +import Prelude + +import Data.Eq (class Eq1) +import Data.Ord (class Ord1) + +-- | Semigroup where `append` always takes the first option. +-- | +-- | ``` purescript +-- | First x <> First y == First x +-- | ``` +newtype First a = First a + +derive newtype instance eqFirst :: Eq a => Eq (First a) +derive instance eq1First :: Eq1 First + +derive newtype instance ordFirst :: Ord a => Ord (First a) +derive instance ord1First :: Ord1 First + +derive newtype instance boundedFirst :: Bounded a => Bounded (First a) + +instance showFirst :: Show a => Show (First a) where + show (First a) = "(First " <> show a <> ")" + +derive instance functorFirst :: Functor First + +instance applyFirst :: Apply First where + apply (First f) (First x) = First (f x) + +instance applicativeFirst :: Applicative First where + pure = First + +instance bindFirst :: Bind First where + bind (First x) f = f x + +instance monadFirst :: Monad First + +instance semigroupFirst :: Semigroup (First a) where + append x _ = x diff --git a/stdlib/lib/Data/Semigroup/Foldable.purs b/stdlib/lib/Data/Semigroup/Foldable.purs new file mode 100644 index 00000000..a7fdf36f --- /dev/null +++ b/stdlib/lib/Data/Semigroup/Foldable.purs @@ -0,0 +1,178 @@ +module Data.Semigroup.Foldable + ( class Foldable1 + , foldMap1 + , fold1 + , foldr1 + , foldl1 + , traverse1_ + , for1_ + , sequence1_ + , foldr1Default + , foldl1Default + , foldMap1DefaultR + , foldMap1DefaultL + , intercalate + , intercalateMap + , maximum + , maximumBy + , minimum + , minimumBy + ) where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Identity (Identity(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Multiplicative (Multiplicative(..)) +import Data.Newtype (ala, alaF) +import Data.Ord.Max (Max(..)) +import Data.Ord.Min (Min(..)) +import Data.Tuple (Tuple(..)) + +-- | `Foldable1` represents data structures with a minimum of one element that can be _folded_. +-- | +-- | - `foldr1` folds a structure from the right +-- | - `foldl1` folds a structure from the left +-- | - `foldMap1` folds a structure by accumulating values in a `Semigroup` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `foldr1Default` +-- | - `foldl1Default` +-- | - `foldMap1DefaultR` +-- | - `foldMap1DefaultL` +-- | +-- | Note: some combinations of the default implementations are unsafe to +-- | use together - causing a non-terminating mutually recursive cycle. +-- | These combinations are documented per function. +class Foldable t <= Foldable1 t where + foldr1 :: forall a. (a -> a -> a) -> t a -> a + foldl1 :: forall a. (a -> a -> a) -> t a -> a + foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m + +-- | A default implementation of `foldr1` using `foldMap1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldMap1DefaultR`. +foldr1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a +foldr1Default = flip (runFoldRight1 <<< foldMap1 mkFoldRight1) + +-- | A default implementation of `foldl1` using `foldMap1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldMap1DefaultL`. +foldl1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a +foldl1Default = flip (runFoldRight1 <<< alaF Dual foldMap1 mkFoldRight1) <<< flip + +-- | A default implementation of `foldMap1` using `foldr1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldr1Default`. +foldMap1DefaultR :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m +foldMap1DefaultR f = map f >>> foldr1 (<>) + +-- | A default implementation of `foldMap1` using `foldl1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldl1Default`. +foldMap1DefaultL :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m +foldMap1DefaultL f = map f >>> foldl1 (<>) + +instance foldableDual :: Foldable1 Dual where + foldr1 _ (Dual x) = x + foldl1 _ (Dual x) = x + foldMap1 f (Dual x) = f x + +instance foldableMultiplicative :: Foldable1 Multiplicative where + foldr1 _ (Multiplicative x) = x + foldl1 _ (Multiplicative x) = x + foldMap1 f (Multiplicative x) = f x + +instance foldableTuple :: Foldable1 (Tuple a) where + foldMap1 f (Tuple _ x) = f x + foldr1 _ (Tuple _ x) = x + foldl1 _ (Tuple _ x) = x + +instance foldableIdentity :: Foldable1 Identity where + foldMap1 f (Identity x) = f x + foldl1 _ (Identity x) = x + foldr1 _ (Identity x) = x + +-- | Fold a data structure, accumulating values in some `Semigroup`. +fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m +fold1 = foldMap1 identity + +newtype Act :: forall k. (k -> Type) -> k -> Type +newtype Act f a = Act (f a) + +getAct :: forall f a. Act f a -> f a +getAct (Act f) = f + +instance semigroupAct :: Apply f => Semigroup (Act f a) where + append (Act a) (Act b) = Act (a *> b) + +-- | Traverse a data structure, performing some effects encoded by an +-- | `Apply` instance at each value, ignoring the final result. +traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit +traverse1_ f t = unit <$ getAct (foldMap1 (Act <<< f) t) + +-- | A version of `traverse1_` with its arguments flipped. +-- | +-- | This can be useful when running an action written using do notation +-- | for every element in a data structure: +for1_ :: forall t f a b. Foldable1 t => Apply f => t a -> (a -> f b) -> f Unit +for1_ = flip traverse1_ + +-- | Perform all of the effects in some data structure in the order +-- | given by the `Foldable1` instance, ignoring the final result. +sequence1_ :: forall t f a. Foldable1 t => Apply f => t (f a) -> f Unit +sequence1_ = traverse1_ identity + +maximum :: forall f a. Ord a => Foldable1 f => f a -> a +maximum = ala Max foldMap1 + +maximumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a +maximumBy cmp = foldl1 \x y -> if cmp x y == GT then x else y + +minimum :: forall f a. Ord a => Foldable1 f => f a -> a +minimum = ala Min foldMap1 + +minimumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a +minimumBy cmp = foldl1 \x y -> if cmp x y == LT then x else y + +-- | Internal. Used by intercalation functions. +newtype JoinWith a = JoinWith (a -> a) + +joinee :: forall a. JoinWith a -> a -> a +joinee (JoinWith x) = x + +instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where + append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j + +-- | Fold a data structure using a `Semigroup` instance, +-- | combining adjacent elements using the specified separator. +intercalate :: forall f m. Foldable1 f => Semigroup m => m -> f m -> m +intercalate = flip intercalateMap identity + +-- | Fold a data structure, accumulating values in some `Semigroup`, +-- | combining adjacent elements using the specified separator. +intercalateMap + :: forall f m a + . Foldable1 f + => Semigroup m + => m -> (a -> m) -> f a -> m +intercalateMap j f foldable = + joinee (foldMap1 (JoinWith <<< const <<< f) foldable) j + +-- | Internal. Used by foldr1Default and foldl1Default. +data FoldRight1 a = FoldRight1 (a -> (a -> a -> a) -> a) a + +instance foldRight1Semigroup :: Semigroup (FoldRight1 a) where + append (FoldRight1 lf lr) (FoldRight1 rf rr) = FoldRight1 (\a f -> lf (f lr (rf a f)) f) rr + +mkFoldRight1 :: forall a. a -> FoldRight1 a +mkFoldRight1 = FoldRight1 const + +runFoldRight1 :: forall a. FoldRight1 a -> (a -> a -> a) -> a +runFoldRight1 (FoldRight1 f a) = f a diff --git a/stdlib/lib/Data/Semigroup/Generic.purs b/stdlib/lib/Data/Semigroup/Generic.purs new file mode 100644 index 00000000..5591903d --- /dev/null +++ b/stdlib/lib/Data/Semigroup/Generic.purs @@ -0,0 +1,31 @@ +module Data.Semigroup.Generic + ( class GenericSemigroup + , genericAppend' + , genericAppend + ) where + +import Prelude (class Semigroup, append) +import Data.Generic.Rep + +class GenericSemigroup a where + genericAppend' :: a -> a -> a + +instance genericSemigroupNoConstructors :: GenericSemigroup NoConstructors where + genericAppend' a _ = a + +instance genericSemigroupNoArguments :: GenericSemigroup NoArguments where + genericAppend' a _ = a + +instance genericSemigroupProduct :: (GenericSemigroup a, GenericSemigroup b) => GenericSemigroup (Product a b) where + genericAppend' (Product a1 b1) (Product a2 b2) = + Product (genericAppend' a1 a2) (genericAppend' b1 b2) + +instance genericSemigroupConstructor :: GenericSemigroup a => GenericSemigroup (Constructor name a) where + genericAppend' (Constructor a1) (Constructor a2) = Constructor (genericAppend' a1 a2) + +instance genericSemigroupArgument :: Semigroup a => GenericSemigroup (Argument a) where + genericAppend' (Argument a1) (Argument a2) = Argument (append a1 a2) + +-- | A `Generic` implementation of the `append` member from the `Semigroup` type class. +genericAppend :: forall a rep. Generic a rep => GenericSemigroup rep => a -> a -> a +genericAppend x y = to (genericAppend' (from x) (from y)) diff --git a/stdlib/lib/Data/Semigroup/Last.purs b/stdlib/lib/Data/Semigroup/Last.purs new file mode 100644 index 00000000..232f9989 --- /dev/null +++ b/stdlib/lib/Data/Semigroup/Last.purs @@ -0,0 +1,40 @@ +module Data.Semigroup.Last where + +import Prelude + +import Data.Eq (class Eq1) +import Data.Ord (class Ord1) + +-- | Semigroup where `append` always takes the second option. +-- | +-- | ``` purescript +-- | Last x <> Last y == Last y +-- | ``` +newtype Last a = Last a + +derive newtype instance eqLast :: Eq a => Eq (Last a) +derive instance eq1Last :: Eq1 Last + +derive newtype instance ordLast :: Ord a => Ord (Last a) +derive instance ord1Last :: Ord1 Last + +derive newtype instance boundedLast :: Bounded a => Bounded (Last a) + +instance showLast :: Show a => Show (Last a) where + show (Last a) = "(Last " <> show a <> ")" + +derive instance functorLast :: Functor Last + +instance applyLast :: Apply Last where + apply (Last f) (Last x) = Last (f x) + +instance applicativeLast :: Applicative Last where + pure = Last + +instance bindLast :: Bind Last where + bind (Last x) f = f x + +instance monadLast :: Monad Last + +instance semigroupLast :: Semigroup (Last a) where + append _ x = x diff --git a/stdlib/lib/Data/Semigroup/Traversable.purs b/stdlib/lib/Data/Semigroup/Traversable.purs new file mode 100644 index 00000000..c01c671d --- /dev/null +++ b/stdlib/lib/Data/Semigroup/Traversable.purs @@ -0,0 +1,72 @@ +module Data.Semigroup.Traversable where + +import Prelude + +import Data.Identity (Identity(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Multiplicative (Multiplicative(..)) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Traversable (class Traversable) +import Data.Tuple (Tuple(..)) + +-- | `Traversable1` represents data structures with a minimum of one element that can be _traversed_, +-- | accumulating results and effects in some `Applicative` functor. +-- | +-- | - `traverse1` runs an action for every element in a data structure, +-- | and accumulates the results. +-- | - `sequence1` runs the actions _contained_ in a data structure, +-- | and accumulates the results. +-- | +-- | The `traverse1` and `sequence1` functions should be compatible in the +-- | following sense: +-- | +-- | - `traverse1 f xs = sequence1 (f <$> xs)` +-- | - `sequence1 = traverse1 identity` +-- | +-- | `Traversable1` instances should also be compatible with the corresponding +-- | `Foldable1` instances, in the following sense: +-- | +-- | - `foldMap1 f = runConst <<< traverse1 (Const <<< f)` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `traverse1Default` +-- | - `sequence1Default` +class (Foldable1 t, Traversable t) <= Traversable1 t where + traverse1 :: forall a b f. Apply f => (a -> f b) -> t a -> f (t b) + sequence1 :: forall b f. Apply f => t (f b) -> f (t b) + +instance traversableDual :: Traversable1 Dual where + traverse1 f (Dual x) = Dual <$> f x + sequence1 = sequence1Default + +instance traversableMultiplicative :: Traversable1 Multiplicative where + traverse1 f (Multiplicative x) = Multiplicative <$> f x + sequence1 = sequence1Default + +instance traversableTuple :: Traversable1 (Tuple a) where + traverse1 f (Tuple x y) = Tuple x <$> f y + sequence1 (Tuple x y) = Tuple x <$> y + +instance traversableIdentity :: Traversable1 Identity where + traverse1 f (Identity x) = Identity <$> f x + sequence1 (Identity x) = Identity <$> x + +-- | A default implementation of `traverse1` using `sequence1`. +traverse1Default + :: forall t a b m + . Traversable1 t + => Apply m + => (a -> m b) + -> t a + -> m (t b) +traverse1Default f ta = sequence1 (f <$> ta) + +-- | A default implementation of `sequence1` using `traverse1`. +sequence1Default + :: forall t a m + . Traversable1 t + => Apply m + => t (m a) + -> m (t a) +sequence1Default = traverse1 identity diff --git a/stdlib/lib/Data/Semiring.purs b/stdlib/lib/Data/Semiring.purs index 86fd6538..cfb1530d 100644 --- a/stdlib/lib/Data/Semiring.purs +++ b/stdlib/lib/Data/Semiring.purs @@ -1,27 +1,142 @@ --- | The `Semiring` class and its `+` / `*` operators. --- | --- | The `Int` and `Number` instances are the compiler's internal arithmetic --- | intrinsics; the surface operators are library declarations over them. module Data.Semiring ( class Semiring , add - , mul , (+) + , zero + , mul , (*) + , one + , class SemiringRecord + , addRecord + , mulRecord + , oneRecord + , zeroRecord ) where --- | A type with addition and multiplication. +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit, unit) +import Prim.Row as Row +import Prim.RowList as RL +import Record.Unsafe (unsafeGet, unsafeSet) +import Type.Proxy (Proxy(..)) + +-- | The `Semiring` class is for types that support an addition and +-- | multiplication operation. +-- | +-- | Instances must satisfy the following laws: +-- | +-- | - Commutative monoid under addition: +-- | - Associativity: `(a + b) + c = a + (b + c)` +-- | - Identity: `zero + a = a + zero = a` +-- | - Commutative: `a + b = b + a` +-- | - Monoid under multiplication: +-- | - Associativity: `(a * b) * c = a * (b * c)` +-- | - Identity: `one * a = a * one = a` +-- | - Multiplication distributes over addition: +-- | - Left distributivity: `a * (b + c) = (a * b) + (a * c)` +-- | - Right distributivity: `(a + b) * c = (a * c) + (b * c)` +-- | - Annihilation: `zero * a = a * zero = zero` +-- | +-- | **Note:** The `Number` and `Int` types are not fully law abiding +-- | members of this class hierarchy due to the potential for arithmetic +-- | overflows, and in the case of `Number`, the presence of `NaN` and +-- | `Infinity` values. The behaviour is unspecified in these cases. class Semiring a where add :: a -> a -> a + zero :: a mul :: a -> a -> a + one :: a infixl 6 add as + infixl 7 mul as * instance semiringInt :: Semiring Int where add x y = intAdd x y + zero = 0 mul x y = intMul x y + one = 1 instance semiringNumber :: Semiring Number where - add x y = numberAdd x y - mul x y = numberMul x y + add x y = numAdd x y + zero = 0.0 + mul x y = numMul x y + one = 1.0 + +instance semiringFn :: Semiring b => Semiring (a -> b) where + add f g x = f x + g x + zero = \_ -> zero + mul f g x = f x * g x + one = \_ -> one + +instance semiringUnit :: Semiring Unit where + add _ _ = unit + zero = unit + mul _ _ = unit + one = unit + +instance semiringProxy :: Semiring (Proxy a) where + add _ _ = Proxy + mul _ _ = Proxy + one = Proxy + zero = Proxy + +instance semiringRecord :: (RL.RowToList row list, SemiringRecord list row row) => Semiring (Record row) where + add = addRecord (Proxy :: Proxy list) + mul = mulRecord (Proxy :: Proxy list) + one = oneRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + zero = zeroRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + + + +numAdd :: Number -> Number -> Number +numAdd a0 a1 = numberAdd a0 a1 +numMul :: Number -> Number -> Number +numMul a0 a1 = numberMul a0 a1 + +-- | A class for records where all fields have `Semiring` instances, used to +-- | implement the `Semiring` instance for records. +class SemiringRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint +class SemiringRecord rowlist row subrow | rowlist -> subrow where + addRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + mulRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow + oneRecord :: Proxy rowlist -> Proxy row -> Record subrow + zeroRecord :: Proxy rowlist -> Proxy row -> Record subrow + +instance semiringRecordNil :: SemiringRecord RL.Nil row () where + addRecord _ _ _ = {} + mulRecord _ _ _ = {} + oneRecord _ _ = {} + zeroRecord _ _ = {} + +instance semiringRecordCons :: + ( IsSymbol key + , Row.Cons key focus subrowTail subrow + , SemiringRecord rowlistTail row subrowTail + , Semiring focus + ) => + SemiringRecord (RL.Cons key focus rowlistTail) row subrow where + addRecord _ ra rb = insert (get ra + get rb) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + tail = addRecord (Proxy :: Proxy rowlistTail) ra rb + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + + mulRecord _ ra rb = insert (get ra * get rb) tail + where + key = reflectSymbol (Proxy :: Proxy key) + get = unsafeGet key :: Record row -> focus + tail = mulRecord (Proxy :: Proxy rowlistTail) ra rb + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + + oneRecord _ _ = insert one tail + where + key = reflectSymbol (Proxy :: Proxy key) + tail = oneRecord (Proxy :: Proxy rowlistTail) (Proxy :: Proxy row) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow + + zeroRecord _ _ = insert zero tail + where + key = reflectSymbol (Proxy :: Proxy key) + tail = zeroRecord (Proxy :: Proxy rowlistTail) (Proxy :: Proxy row) + insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow diff --git a/stdlib/lib/Data/Semiring/Generic.purs b/stdlib/lib/Data/Semiring/Generic.purs new file mode 100644 index 00000000..baf95aa9 --- /dev/null +++ b/stdlib/lib/Data/Semiring/Generic.purs @@ -0,0 +1,51 @@ +module Data.Semiring.Generic where + +import Prelude + +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) + +class GenericSemiring a where + genericAdd' :: a -> a -> a + genericZero' :: a + genericMul' :: a -> a -> a + genericOne' :: a + +instance genericSemiringNoArguments :: GenericSemiring NoArguments where + genericAdd' _ _ = NoArguments + genericZero' = NoArguments + genericMul' _ _ = NoArguments + genericOne' = NoArguments + +instance genericSemiringArgument :: Semiring a => GenericSemiring (Argument a) where + genericAdd' (Argument x) (Argument y) = Argument (add x y) + genericZero' = Argument zero + genericMul' (Argument x) (Argument y) = Argument (mul x y) + genericOne' = Argument one + +instance genericSemiringProduct :: (GenericSemiring a, GenericSemiring b) => GenericSemiring (Product a b) where + genericAdd' (Product a1 b1) (Product a2 b2) = Product (genericAdd' a1 a2) (genericAdd' b1 b2) + genericZero' = Product genericZero' genericZero' + genericMul' (Product a1 b1) (Product a2 b2) = Product (genericMul' a1 a2) (genericMul' b1 b2) + genericOne' = Product genericOne' genericOne' + +instance genericSemiringConstructor :: GenericSemiring a => GenericSemiring (Constructor name a) where + genericAdd' (Constructor a1) (Constructor a2) = Constructor (genericAdd' a1 a2) + genericZero' = Constructor genericZero' + genericMul' (Constructor a1) (Constructor a2) = Constructor (genericMul' a1 a2) + genericOne' = Constructor genericOne' + +-- | A `Generic` implementation of the `zero` member from the `Semiring` type class. +genericZero :: forall a rep. Generic a rep => GenericSemiring rep => a +genericZero = to genericZero' + +-- | A `Generic` implementation of the `one` member from the `Semiring` type class. +genericOne :: forall a rep. Generic a rep => GenericSemiring rep => a +genericOne = to genericOne' + +-- | A `Generic` implementation of the `add` member from the `Semiring` type class. +genericAdd :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a +genericAdd x y = to $ from x `genericAdd'` from y + +-- | A `Generic` implementation of the `mul` member from the `Semiring` type class. +genericMul :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a +genericMul x y = to $ from x `genericMul'` from y diff --git a/stdlib/lib/Data/Set.purs b/stdlib/lib/Data/Set.purs new file mode 100644 index 00000000..ef35ff62 --- /dev/null +++ b/stdlib/lib/Data/Set.purs @@ -0,0 +1,188 @@ +-- | This module defines a type of sets as height-balanced (AVL) binary trees. +-- | Efficient set operations are implemented in terms of +-- | + +module Data.Set + ( Set + , fromFoldable + , toUnfoldable + , empty + , isEmpty + , singleton + , map + , checkValid + , insert + , member + , delete + , toggle + , size + , findMin + , findMax + , union + , unions + , difference + , subset + , properSubset + , intersection + , filter + , mapMaybe + , catMaybes + , toMap + , fromMap + ) where + +import Prelude hiding (map) + +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.List (List) +import Data.List as List +import Data.Map.Internal as M +import Data.Maybe (Maybe(..), maybe) +import Data.Ord (class Ord1) +import Data.Unfoldable (class Unfoldable) +import Prelude as Prelude +import Safe.Coerce (coerce) + +-- | `Set a` represents a set of values of type `a` +newtype Set a = Set (M.Map a Unit) + +-- | Create a set from a foldable structure. +fromFoldable :: forall f a. Foldable f => Ord a => f a -> Set a +fromFoldable = foldl (\m a -> insert a m) empty + +-- | Convert a set to an unfoldable structure. +toUnfoldable :: forall f a. Unfoldable f => Set a -> f a +toUnfoldable = List.toUnfoldable <<< toList + +toList :: forall a. Set a -> List a +toList (Set m) = M.keys m + +instance eqSet :: Eq a => Eq (Set a) where + eq (Set m1) (Set m2) = m1 == m2 + +instance eq1Set :: Eq1 Set where + eq1 = eq + +instance showSet :: Show a => Show (Set a) where + show s = "(fromFoldable " <> show (toUnfoldable s :: Array a) <> ")" + +instance ordSet :: Ord a => Ord (Set a) where + compare s1 s2 = compare (toList s1) (toList s2) + +instance ord1Set :: Ord1 Set where + compare1 = compare + +instance monoidSet :: Ord a => Monoid (Set a) where + mempty = empty + +instance semigroupSet :: Ord a => Semigroup (Set a) where + append = union + +instance foldableSet :: Foldable Set where + foldMap f = foldMap f <<< toList + foldl f x = foldl f x <<< toList + foldr f x = foldr f x <<< toList + +-- | An empty set +empty :: forall a. Set a +empty = Set M.empty + +-- | Test if a set is empty +isEmpty :: forall a. Set a -> Boolean +isEmpty = coerce (M.isEmpty :: M.Map a Unit -> _) + +-- | Create a set with one element +singleton :: forall a. a -> Set a +singleton a = Set (M.singleton a unit) + +-- | Maps over the values in a set. +-- | +-- | This operation is not structure-preserving for sets, so is not a valid +-- | `Functor`. An example case: mapping `const x` over a set with `n > 0` +-- | elements will result in a set with one element. +map :: forall a b. Ord b => (a -> b) -> Set a -> Set b +map f = foldl (\m a -> insert (f a) m) empty + +-- | Check whether the underlying tree satisfies the height, size, and ordering invariants. +-- | +-- | This function is provided for internal use. +checkValid :: forall a. Ord a => Set a -> Boolean +checkValid = coerce (M.checkValid :: M.Map a Unit -> _) + +-- | Test if a value is a member of a set +member :: forall a. Ord a => a -> Set a -> Boolean +member = coerce (M.member :: _ -> M.Map a Unit -> _) + +-- | Insert a value into a set +insert :: forall a. Ord a => a -> Set a -> Set a +insert a (Set m) = Set (M.insert a unit m) + +-- | Delete a value from a set +delete :: forall a. Ord a => a -> Set a -> Set a +delete = coerce (M.delete :: _ -> M.Map a Unit -> _) + +-- | Insert a value into a set if it is not already present, if it is present, delete it. +toggle :: forall a. Ord a => a -> Set a -> Set a +toggle a (Set m) = Set (M.alter (maybe (Just unit) (\_ -> Nothing)) a m) + +-- | Find the size of a set +size :: forall a. Set a -> Int +size = coerce (M.size :: M.Map a Unit -> _) + +findMin :: forall a. Set a -> Maybe a +findMin (Set m) = Prelude.map _.key (M.findMin m) + +findMax :: forall a. Set a -> Maybe a +findMax (Set m) = Prelude.map _.key (M.findMax m) + +-- | Form the union of two sets +-- | +-- | Running time: `O(n + m)` +union :: forall a. Ord a => Set a -> Set a -> Set a +union = coerce (M.union :: M.Map a Unit -> _ -> _) + +-- | Form the union of a collection of sets +unions :: forall f a. Foldable f => Ord a => f (Set a) -> Set a +unions = foldl union empty + +-- | Form the set difference +difference :: forall a. Ord a => Set a -> Set a -> Set a +difference = coerce (M.difference :: M.Map a Unit -> M.Map a Unit -> _) + +-- | True if and only if every element in the first set +-- | is an element of the second set +subset :: forall a. Ord a => Set a -> Set a -> Boolean +subset s1 s2 = isEmpty $ s1 `difference` s2 + +-- | True if and only if the first set is a subset of the second set +-- | and the sets are not equal +properSubset :: forall a. Ord a => Set a -> Set a -> Boolean +properSubset s1 s2 = size s1 /= size s2 && subset s1 s2 + +-- | The set of elements which are in both the first and second set +intersection :: forall a. Ord a => Set a -> Set a -> Set a +intersection = coerce (M.intersection :: M.Map a Unit -> M.Map a Unit -> _) + +-- | Filter out those values of a set for which a predicate on the value fails +-- | to hold. +filter :: forall a. Ord a => (a -> Boolean) -> Set a -> Set a +filter = coerce (M.filterKeys :: _ -> M.Map a Unit -> _) + +-- | Applies a function to each value in a set, discarding entries where the +-- | function returns `Nothing`. +mapMaybe :: forall a b. Ord b => (a -> Maybe b) -> Set a -> Set b +mapMaybe f = foldr (\a acc -> maybe acc (\b -> insert b acc) (f a)) empty + +-- | Filter a set of optional values, discarding values that contain `Nothing` +catMaybes :: forall a. Ord a => Set (Maybe a) -> Set a +catMaybes = mapMaybe identity + +-- | A set is a map with no value attached to each key. +toMap :: forall a. Set a -> M.Map a Unit +toMap (Set s) = s + +-- | A map with no value attached to each key is a set. +-- | See also `Data.Map.keys`. +fromMap :: forall a. M.Map a Unit -> Set a +fromMap = Set diff --git a/stdlib/lib/Data/Set/NonEmpty.purs b/stdlib/lib/Data/Set/NonEmpty.purs new file mode 100644 index 00000000..a4c2deee --- /dev/null +++ b/stdlib/lib/Data/Set/NonEmpty.purs @@ -0,0 +1,163 @@ +module Data.Set.NonEmpty + ( NonEmptySet + , singleton + , cons + , fromSet + , fromFoldable + , fromFoldable1 + , toSet + , toUnfoldable + , toUnfoldable1 + , map + , member + , insert + , delete + , size + , min + , max + , unionSet + , difference + , subset + , properSubset + , intersection + , filter + , mapMaybe + ) where + +import Prelude hiding (map) + +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable) +import Data.Function.Uncurried (mkFn3) +import Data.List.NonEmpty (NonEmptyList) +import Data.Map.Internal as Internal +import Data.Maybe (Maybe(..), fromJust) +import Data.Ord (class Ord1) +import Data.Semigroup.Foldable (class Foldable1, foldMap1, foldr1, foldl1) +import Data.Set (Set) +import Data.Set as Set +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, class Unfoldable1, unfoldr1) +import Partial.Unsafe (unsafeCrashWith, unsafePartial) +import Safe.Coerce (coerce) + +-- | `NonEmptySet a` represents a non-empty set of values of type `a` +newtype NonEmptySet a = NonEmptySet (Set a) + +derive newtype instance eqNonEmptySet :: Eq a => Eq (NonEmptySet a) +derive newtype instance eq1NonEmptySet :: Eq1 NonEmptySet +derive newtype instance ordNonEmptySet :: Ord a => Ord (NonEmptySet a) +derive newtype instance ord1NonEmptySet :: Ord1 NonEmptySet +derive newtype instance semigroupNonEmptySet :: Ord a => Semigroup (NonEmptySet a) +derive newtype instance foldableNonEmptySet :: Foldable NonEmptySet + +instance foldable1NonEmptySet :: Foldable1 NonEmptySet where + foldMap1 f = foldMap1 f <<< (toUnfoldable1 :: forall a. NonEmptySet a -> NonEmptyList a) + foldr1 f = foldr1 f <<< (toUnfoldable1 :: forall a. NonEmptySet a -> NonEmptyList a) + foldl1 f = foldl1 f <<< (toUnfoldable1 :: forall a. NonEmptySet a -> NonEmptyList a) + +instance showNonEmptySet :: Show a => Show (NonEmptySet a) where + show s = "(fromFoldable1 " <> show (toUnfoldable1 s :: NonEmptyArray a) <> ")" + +-- | Create a set with one element. +singleton :: forall a. a -> NonEmptySet a +singleton = coerce (Set.singleton :: a -> _) + +-- | Creates a `NonEmptySet` from an item and a `Set`. +cons :: forall a. Ord a => a -> Set a -> NonEmptySet a +cons = coerce (Set.insert :: a -> _) + +-- | Attempts to create a non-empty set from a possibly-empty set. +fromSet :: forall a. Set a -> Maybe (NonEmptySet a) +fromSet s = if Set.isEmpty s then Nothing else Just (NonEmptySet s) + +-- | Create a set from a foldable structure. +fromFoldable :: forall f a. Foldable f => Ord a => f a -> Maybe (NonEmptySet a) +fromFoldable = fromSet <<< Set.fromFoldable + +-- | Create a set from a non-empty foldable structure. +fromFoldable1 :: forall f a. Foldable1 f => Ord a => f a -> NonEmptySet a +fromFoldable1 = foldMap1 singleton + +-- | Forgets the non-empty property of a set, giving a normal possibly-empty +-- | set. +toSet :: forall a. NonEmptySet a -> Set a +toSet (NonEmptySet s) = s + +-- | Convert a set to an unfoldable structure. +toUnfoldable :: forall f a. Unfoldable f => NonEmptySet a -> f a +toUnfoldable = coerce (Set.toUnfoldable :: Set a -> f a) + +-- | Convert a set to a non-empty unfoldable structure. +toUnfoldable1 :: forall f a. Unfoldable1 f => NonEmptySet a -> f a +toUnfoldable1 = unfoldr1 (stepNext <$> _) <<< stepHead <<< Internal.toMapIter <<< Set.toMap <<< coerce + where + stepHead = Internal.stepAscCps (mkFn3 \k _ next -> Tuple k next) \_ -> unsafeCrashWith "toUnfoldable1: impossible" + stepNext = Internal.stepAscCps (mkFn3 \k _ next -> Just (Tuple k next)) \_ -> Nothing + +-- | Maps over the values in a set. +-- | +-- | This operation is not structure-preserving for sets, so is not a valid +-- | `Functor`. An example case: mapping `const x` over a set with `n > 0` +-- | elements will result in a set with one element. +map :: forall a b. Ord b => (a -> b) -> NonEmptySet a -> NonEmptySet b +map = coerce (Set.map :: (a -> b) -> _) + +-- | Test if a value is a member of a set. +member :: forall a. Ord a => a -> NonEmptySet a -> Boolean +member = coerce (Set.member :: a -> _) + +-- | Insert a value into a set. +insert :: forall a. Ord a => a -> NonEmptySet a -> NonEmptySet a +insert = coerce (Set.insert :: a -> _) + +-- | Delete a value from a non-empty set. If this would empty the set, the +-- | result is `Nothing`. +delete :: forall a. Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a) +delete a (NonEmptySet s) = fromSet (Set.delete a s) + +-- | Find the size of a set. +size :: forall a. NonEmptySet a -> Int +size = coerce (Set.size :: Set a -> _) + +-- | The minimum value in the set. +min :: forall a. NonEmptySet a -> a +min (NonEmptySet s) = unsafePartial (fromJust (Set.findMin s)) + +-- | The maximum value in the set. +max :: forall a. NonEmptySet a -> a +max (NonEmptySet s) = unsafePartial (fromJust (Set.findMax s)) + +-- | Form the union of a set and the non-empty set. +unionSet :: forall a. Ord a => Set a -> NonEmptySet a -> NonEmptySet a +unionSet = coerce (append :: _ -> Set a -> _) + +-- | Form the set difference. `Nothing` if the first is a subset of the second. +difference :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Maybe (NonEmptySet a) +difference (NonEmptySet s1) (NonEmptySet s2) = fromSet (Set.difference s1 s2) + +-- | True if and only if every element in the first set is an element of the +-- | second set. +subset :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Boolean +subset = coerce (Set.subset :: Set a -> _) + +-- | True if and only if the first set is a subset of the second set and the +-- | sets are not equal. +properSubset :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Boolean +properSubset = coerce (Set.properSubset :: Set a -> _) + +-- | The set of elements which are in both the first and second set. `Nothing` +-- | if the sets are disjoint. +intersection :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Maybe (NonEmptySet a) +intersection (NonEmptySet s1) (NonEmptySet s2) = fromSet (Set.intersection s1 s2) + +-- | Filter out those values of a set for which a predicate on the value fails +-- | to hold. +filter :: forall a. Ord a => (a -> Boolean) -> NonEmptySet a -> Set a +filter = coerce (Set.filter :: _ -> Set a -> _) + +-- | Applies a function to each value in a set, discarding entries where the +-- | function returns `Nothing`. +mapMaybe :: forall a b. Ord b => (a -> Maybe b) -> NonEmptySet a -> Set b +mapMaybe = coerce (Set.mapMaybe :: _ -> Set a -> Set b) diff --git a/stdlib/lib/Data/Show.purs b/stdlib/lib/Data/Show.purs index 40dae577..1b2c08a3 100644 --- a/stdlib/lib/Data/Show.purs +++ b/stdlib/lib/Data/Show.purs @@ -2,9 +2,9 @@ -- | -- | `show` renders a value as text. The `Int`, `Number`, `Boolean`, `Char`, -- | `String`, `Unit`, and `Array` instances are the ones the corpus actually --- | applies `show` to. `Show Unit` lives here rather than in `Data.Unit` --- | because that module is not part of this library yet; a record instance is --- | not here because it needs `reflectSymbol`, which has no runtime. +-- | applies `show` to. `Show Unit` lives here; `Data.Unit` only re-exports the +-- | builtin. A record instance is not here because `reflectSymbol` has no +-- | runtime. -- | -- | `Boolean`, `Int`, `Char`, `String`, `Unit`, and `Array` match the official -- | spelling, including the `Char`/`String` escapes. `Number` uses the same @@ -55,7 +55,7 @@ instance showArray :: Show a => Show (Array a) where show value = "[" <> showElements value 0 <> "]" minInt :: Int -minInt = (0 - 2147483647) - 1 +minInt = intSub (intSub 0 2147483647) 1 positiveInfinity :: Number positiveInfinity = numberDiv 1.0 0.0 @@ -121,13 +121,13 @@ powerOfTen :: Number -> Int -> Int powerOfTen value exponent = if numberEq value 0.0 then exponent else if numberGe value 10.0 then powerOfTen (numberDiv value 10.0) (intAdd exponent 1) - else if numberLt value 1.0 then powerOfTen (numberMul value 10.0) (exponent - 1) + else if numberLt value 1.0 then powerOfTen (numberMul value 10.0) (intSub exponent 1) else exponent scaleToUnit :: Number -> Int -> Number scaleToUnit value exponent = if intEq exponent 0 then value - else if intGt exponent 0 then scaleToUnit (numberDiv value 10.0) (exponent - 1) + else if intGt exponent 0 then scaleToUnit (numberDiv value 10.0) (intSub exponent 1) else scaleToUnit (numberMul value 10.0) (intAdd exponent 1) -- | Floor of a non-negative number. Groups of nine digits stay inside `Int`, @@ -176,7 +176,7 @@ collectFraction fraction remaining digits = digitValue = numberToInt scaled rest = numberSub scaled (intToNumber digitValue) in - collectFraction rest (remaining - 1) (arrayAppend digits [digitValue]) + collectFraction rest (intSub remaining 1) (arrayAppend digits [digitValue]) trimZeros :: Array Int -> Array Int trimZeros digits = @@ -184,7 +184,7 @@ trimZeros digits = length = arrayLength digits in if intEq length 0 then digits - else if intEq (arrayIndex digits (length - 1)) 0 then trimZeros (takePrefix digits (length - 1)) + else if intEq (arrayIndex digits (intSub length 1)) 0 then trimZeros (takePrefix digits (intSub length 1)) else digits takePrefix :: Array Int -> Int -> Array Int diff --git a/stdlib/lib/Data/Show/Generic.purs b/stdlib/lib/Data/Show/Generic.purs new file mode 100644 index 00000000..8bf6aba2 --- /dev/null +++ b/stdlib/lib/Data/Show/Generic.purs @@ -0,0 +1,64 @@ +module Data.Show.Generic + ( class GenericShow + , genericShow' + , genericShow + , class GenericShowArgs + , genericShowArgs + ) where + +import Prelude (class Show, show, (<>)) +import Data.Generic.Rep +import Data.Symbol (class IsSymbol, reflectSymbol) +import Type.Proxy (Proxy(..)) + +class GenericShow a where + genericShow' :: a -> String + +class GenericShowArgs a where + genericShowArgs :: a -> Array String + +instance genericShowNoConstructors :: GenericShow NoConstructors where + genericShow' a = genericShow' a + +instance genericShowArgsNoArguments :: GenericShowArgs NoArguments where + genericShowArgs _ = [] + +instance genericShowSum :: (GenericShow a, GenericShow b) => GenericShow (Sum a b) where + genericShow' (Inl a) = genericShow' a + genericShow' (Inr b) = genericShow' b + +instance genericShowArgsProduct :: + ( GenericShowArgs a + , GenericShowArgs b + ) => + GenericShowArgs (Product a b) where + genericShowArgs (Product a b) = genericShowArgs a <> genericShowArgs b + +instance genericShowConstructor :: + ( GenericShowArgs a + , IsSymbol name + ) => + GenericShow (Constructor name a) where + genericShow' (Constructor a) = + case genericShowArgs a of + [] -> ctor + args -> "(" <> intercalate " " ([ ctor ] <> args) <> ")" + where + ctor :: String + ctor = reflectSymbol (Proxy :: Proxy name) + +instance genericShowArgsArgument :: Show a => GenericShowArgs (Argument a) where + genericShowArgs (Argument a) = [ show a ] + +-- | A `Generic` implementation of the `show` member from the `Show` type class. +genericShow :: forall a rep. Generic a rep => GenericShow rep => a -> String +genericShow x = genericShow' (from x) + +intercalate :: String -> Array String -> String +intercalate a0 a1 = intercalateFrom a0 a1 0 + +intercalateFrom :: String -> Array String -> Int -> String +intercalateFrom separator values index = + if intGe index (arrayLength values) then "" + else if intEq index 0 then arrayIndex values index <> intercalateFrom separator values (intAdd index 1) + else separator <> arrayIndex values index <> intercalateFrom separator values (intAdd index 1) diff --git a/stdlib/lib/Data/String.purs b/stdlib/lib/Data/String.purs new file mode 100644 index 00000000..742f2650 --- /dev/null +++ b/stdlib/lib/Data/String.purs @@ -0,0 +1,10 @@ +module Data.String + ( module Data.String.Common + , module Data.String.CodePoints + , module Data.String.Pattern + ) where + +import Data.String.CodePoints + +import Data.String.Common (joinWith, localeCompare, null, replace, replaceAll, split, toLower, toUpper, trim) +import Data.String.Pattern (Pattern(..), Replacement(..)) diff --git a/stdlib/lib/Data/String/CaseInsensitive.purs b/stdlib/lib/Data/String/CaseInsensitive.purs new file mode 100644 index 00000000..3783164d --- /dev/null +++ b/stdlib/lib/Data/String/CaseInsensitive.purs @@ -0,0 +1,22 @@ +module Data.String.CaseInsensitive where + +import Prelude + +import Data.Newtype (class Newtype) +import Data.String (toLower) + +-- | A newtype for case insensitive string comparisons and ordering. +newtype CaseInsensitiveString = CaseInsensitiveString String + +instance eqCaseInsensitiveString :: Eq CaseInsensitiveString where + eq (CaseInsensitiveString s1) (CaseInsensitiveString s2) = + toLower s1 == toLower s2 + +instance ordCaseInsensitiveString :: Ord CaseInsensitiveString where + compare (CaseInsensitiveString s1) (CaseInsensitiveString s2) = + compare (toLower s1) (toLower s2) + +instance showCaseInsensitiveString :: Show CaseInsensitiveString where + show (CaseInsensitiveString s) = "(CaseInsensitiveString " <> show s <> ")" + +derive instance newtypeCaseInsensitiveString :: Newtype CaseInsensitiveString _ diff --git a/stdlib/lib/Data/String/CodePoints.purs b/stdlib/lib/Data/String/CodePoints.purs new file mode 100644 index 00000000..e7cb8b29 --- /dev/null +++ b/stdlib/lib/Data/String/CodePoints.purs @@ -0,0 +1,418 @@ +-- | These functions allow PureScript strings to be treated as if they were +-- | sequences of Unicode code points instead of their true underlying +-- | implementation (sequences of UTF-16 code units). For nearly all uses of +-- | strings, these functions should be preferred over the ones in +-- | `Data.String.CodeUnits`. +module Data.String.CodePoints + ( module Exports + , CodePoint + , codePointFromChar + , singleton + , fromCodePointArray + , toCodePointArray + , codePointAt + , uncons + , length + , countPrefix + , indexOf + , indexOf' + , lastIndexOf + , lastIndexOf' + , take + -- , takeRight + , takeWhile + , drop + -- , dropRight + , dropWhile + -- , slice + , splitAt + ) where + +import Prelude + +import Data.Array as Array +import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), defaultPred, defaultSucc, fromEnum, toEnum, toEnumWithDefaults) +import Data.Int (hexadecimal, toStringAs) +import Data.Maybe (Maybe(..)) +import Data.String.CodeUnits (contains, stripPrefix, stripSuffix) as Exports +import Data.String.CodeUnits as CU +import Data.String.Common (toUpper) +import Data.String.Pattern (Pattern) +import Data.String.Unsafe as Unsafe +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (unfoldr) + +-- | CodePoint is an `Int` bounded between `0` and `0x10FFFF`, corresponding to +-- | Unicode code points. +newtype CodePoint = CodePoint Int + +derive instance eqCodePoint :: Eq CodePoint +derive instance ordCodePoint :: Ord CodePoint + +instance showCodePoint :: Show CodePoint where + show (CodePoint i) = "(CodePoint 0x" <> toUpper (toStringAs hexadecimal i) <> ")" + +instance boundedCodePoint :: Bounded CodePoint where + bottom = CodePoint 0 + top = CodePoint 0x10FFFF + +instance enumCodePoint :: Enum CodePoint where + succ = defaultSucc toEnum fromEnum + pred = defaultPred toEnum fromEnum + +instance boundedEnumCodePoint :: BoundedEnum CodePoint where + cardinality = Cardinality (0x10FFFF + 1) + fromEnum (CodePoint n) = n + toEnum n + | n >= 0 && n <= 0x10FFFF = Just (CodePoint n) + | otherwise = Nothing + +-- | Creates a `CodePoint` from a given `Char`. +-- | +-- | ```purescript +-- | >>> codePointFromChar 'B' +-- | CodePoint 0x42 -- represents 'B' +-- | ``` +-- | +codePointFromChar :: Char -> CodePoint +codePointFromChar = fromEnum >>> CodePoint + +-- | Creates a string containing just the given code point. Operates in +-- | constant space and time. +-- | +-- | ```purescript +-- | >>> map singleton (toEnum 0x1D400) +-- | Just "𝐀" +-- | ``` +-- | +singleton :: CodePoint -> String +singleton = _singleton singletonFallback + +_singleton :: (CodePoint -> String) -> CodePoint -> String +_singleton a0 a1 = _singleton a0 a1 + +singletonFallback :: CodePoint -> String +singletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp +singletonFallback (CodePoint cp) = + let lead = ((cp - 0x10000) / 0x400) + 0xD800 in + let trail = (cp - 0x10000) `mod` 0x400 + 0xDC00 in + fromCharCode lead <> fromCharCode trail + +-- | Creates a string from an array of code points. Operates in space and time +-- | linear to the length of the array. +-- | +-- | ```purescript +-- | >>> codePointArray = toCodePointArray "c 𝐀" +-- | >>> codePointArray +-- | [CodePoint 0x63, CodePoint 0x20, CodePoint 0x1D400] +-- | >>> fromCodePointArray codePointArray +-- | "c 𝐀" +-- | ``` +-- | +fromCodePointArray :: Array CodePoint -> String +fromCodePointArray = _fromCodePointArray singletonFallback + +_fromCodePointArray :: (CodePoint -> String) -> Array CodePoint -> String +_fromCodePointArray a0 a1 = _fromCodePointArray a0 a1 + +-- | Creates an array of code points from a string. Operates in space and time +-- | linear to the length of the string. +-- | +-- | ```purescript +-- | >>> codePointArray = toCodePointArray "b 𝐀𝐀" +-- | >>> codePointArray +-- | [CodePoint 0x62, CodePoint 0x20, CodePoint 0x1D400, CodePoint 0x1D400] +-- | >>> map singleton codePointArray +-- | ["b", " ", "𝐀", "𝐀"] +-- | ``` +-- | +toCodePointArray :: String -> Array CodePoint +toCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0 + +_toCodePointArray :: (String -> Array CodePoint) -> (String -> CodePoint) -> String -> Array CodePoint +_toCodePointArray a0 a1 a2 = _toCodePointArray a0 a1 a2 + +toCodePointArrayFallback :: String -> Array CodePoint +toCodePointArrayFallback s = unfoldr unconsButWithTuple s + +unconsButWithTuple :: String -> Maybe (Tuple CodePoint String) +unconsButWithTuple s = (\{ head, tail } -> Tuple head tail) <$> uncons s + +-- | Returns the first code point of the string after dropping the given number +-- | of code points from the beginning, if there is such a code point. Operates +-- | in constant space and in time linear to the given index. +-- | +-- | ```purescript +-- | >>> codePointAt 1 "𝐀𝐀𝐀𝐀" +-- | Just (CodePoint 0x1D400) -- represents "𝐀" +-- | -- compare to Data.String: +-- | >>> charAt 1 "𝐀𝐀𝐀𝐀" +-- | Just '�' +-- | ``` +-- | +codePointAt :: Int -> String -> Maybe CodePoint +codePointAt n _ | n < 0 = Nothing +codePointAt 0 "" = Nothing +codePointAt 0 s = Just (unsafeCodePointAt0 s) +codePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s + +_codePointAt :: (Int -> String -> Maybe CodePoint) -> (forall a. a -> Maybe a) -> (forall a. Maybe a) -> (String -> CodePoint) -> Int -> String -> Maybe CodePoint +_codePointAt a0 a1 a2 a3 a4 a5 = _codePointAt a0 a1 a2 a3 a4 a5 + +codePointAtFallback :: Int -> String -> Maybe CodePoint +codePointAtFallback n s = case uncons s of + Just { head, tail } -> if n == 0 then Just head else codePointAtFallback (n - 1) tail + _ -> Nothing + +-- | Returns a record with the first code point and the remaining code points +-- | of the string. Returns `Nothing` if the string is empty. Operates in +-- | constant space and time. +-- | +-- | ```purescript +-- | >>> uncons "𝐀𝐀 c 𝐀" +-- | Just { head: CodePoint 0x1D400, tail: "𝐀 c 𝐀" } +-- | >>> uncons "" +-- | Nothing +-- | ``` +-- | +uncons :: String -> Maybe { head :: CodePoint, tail :: String } +uncons s = case CU.length s of + 0 -> Nothing + 1 -> Just { head: CodePoint (fromEnum (Unsafe.charAt 0 s)), tail: "" } + _ -> + let + cu0 = fromEnum (Unsafe.charAt 0 s) + cu1 = fromEnum (Unsafe.charAt 1 s) + in + if isLead cu0 && isTrail cu1 + then Just { head: unsurrogate cu0 cu1, tail: CU.drop 2 s } + else Just { head: CodePoint cu0, tail: CU.drop 1 s } + +-- | Returns the number of code points in the string. Operates in constant +-- | space and in time linear to the length of the string. +-- | +-- | ```purescript +-- | >>> length "b 𝐀𝐀 c 𝐀" +-- | 8 +-- | -- compare to Data.String: +-- | >>> length "b 𝐀𝐀 c 𝐀" +-- | 11 +-- | ``` +-- | +length :: String -> Int +length = Array.length <<< toCodePointArray + +-- | Returns the number of code points in the leading sequence of code points +-- | which all match the given predicate. Operates in constant space and in +-- | time linear to the length of the string. +-- | +-- | ```purescript +-- | >>> countPrefix (\c -> fromEnum c == 0x1D400) "𝐀𝐀 b c 𝐀" +-- | 2 +-- | ``` +-- | +countPrefix :: (CodePoint -> Boolean) -> String -> Int +countPrefix = _countPrefix countFallback unsafeCodePointAt0 + +_countPrefix :: ((CodePoint -> Boolean) -> String -> Int) -> (String -> CodePoint) -> (CodePoint -> Boolean) -> String -> Int +_countPrefix a0 a1 a2 a3 = _countPrefix a0 a1 a2 a3 + +countFallback :: (CodePoint -> Boolean) -> String -> Int +countFallback p s = countTail p s 0 + +countTail :: (CodePoint -> Boolean) -> String -> Int -> Int +countTail p s accum = case uncons s of + Just { head, tail } -> if p head then countTail p tail (accum + 1) else accum + _ -> accum + +-- | Returns the number of code points preceding the first match of the given +-- | pattern in the string. Returns `Nothing` when no matches are found. +-- | +-- | ```purescript +-- | >>> indexOf (Pattern "𝐀") "b 𝐀𝐀 c 𝐀" +-- | Just 2 +-- | >>> indexOf (Pattern "o") "b 𝐀𝐀 c 𝐀" +-- | Nothing +-- | ``` +-- | +indexOf :: Pattern -> String -> Maybe Int +indexOf p s = (\i -> length (CU.take i s)) <$> CU.indexOf p s + +-- | Returns the number of code points preceding the first match of the given +-- | pattern in the string. Pattern matches preceding the given index will be +-- | ignored. Returns `Nothing` when no matches are found. +-- | +-- | ```purescript +-- | >>> indexOf' (Pattern "𝐀") 4 "b 𝐀𝐀 c 𝐀" +-- | Just 7 +-- | >>> indexOf' (Pattern "o") 4 "b 𝐀𝐀 c 𝐀" +-- | Nothing +-- | ``` +-- | +indexOf' :: Pattern -> Int -> String -> Maybe Int +indexOf' p i s = + let s' = drop i s in + (\k -> i + length (CU.take k s')) <$> CU.indexOf p s' + +-- | Returns the number of code points preceding the last match of the given +-- | pattern in the string. Returns `Nothing` when no matches are found. +-- | +-- | ```purescript +-- | >>> lastIndexOf (Pattern "𝐀") "b 𝐀𝐀 c 𝐀" +-- | Just 7 +-- | >>> lastIndexOf (Pattern "o") "b 𝐀𝐀 c 𝐀" +-- | Nothing +-- | ``` +-- | +lastIndexOf :: Pattern -> String -> Maybe Int +lastIndexOf p s = (\i -> length (CU.take i s)) <$> CU.lastIndexOf p s + +-- | Returns the number of code points preceding the first match of the given +-- | pattern in the string. Pattern matches following the given index will be +-- | ignored. +-- | +-- | Giving a negative index is equivalent to giving 0 and giving an index +-- | greater than the number of code points in the string is equivalent to +-- | searching in the whole string. +-- | +-- | Returns `Nothing` when no matches are found. +-- | +-- | ```purescript +-- | >>> lastIndexOf' (Pattern "𝐀") (-1) "b 𝐀𝐀 c 𝐀" +-- | Nothing +-- | >>> lastIndexOf' (Pattern "𝐀") 0 "b 𝐀𝐀 c 𝐀" +-- | Nothing +-- | >>> lastIndexOf' (Pattern "𝐀") 5 "b 𝐀𝐀 c 𝐀" +-- | Just 3 +-- | >>> lastIndexOf' (Pattern "𝐀") 8 "b 𝐀𝐀 c 𝐀" +-- | Just 7 +-- | >>> lastIndexOf' (Pattern "o") 5 "b 𝐀𝐀 c 𝐀" +-- | Nothing +-- | ``` +-- | +lastIndexOf' :: Pattern -> Int -> String -> Maybe Int +lastIndexOf' p i s = + let i' = CU.length (take i s) in + (\k -> length (CU.take k s)) <$> CU.lastIndexOf' p i' s + +-- | Returns a string containing the given number of code points from the +-- | beginning of the given string. If the string does not have that many code +-- | points, returns the empty string. Operates in constant space and in time +-- | linear to the given number. +-- | +-- | ```purescript +-- | >>> take 3 "b 𝐀𝐀 c 𝐀" +-- | "b 𝐀" +-- | -- compare to Data.String: +-- | >>> take 3 "b 𝐀𝐀 c 𝐀" +-- | "b �" +-- | ``` +-- | +take :: Int -> String -> String +take = _take takeFallback + +_take :: (Int -> String -> String) -> Int -> String -> String +_take a0 a1 a2 = _take a0 a1 a2 + +takeFallback :: Int -> String -> String +takeFallback n _ | n < 1 = "" +takeFallback n s = case uncons s of + Just { head, tail } -> singleton head <> takeFallback (n - 1) tail + _ -> s + +-- | Returns a string containing the leading sequence of code points which all +-- | match the given predicate from the string. Operates in constant space and +-- | in time linear to the length of the string. +-- | +-- | ```purescript +-- | >>> takeWhile (\c -> fromEnum c == 0x1D400) "𝐀𝐀 b c 𝐀" +-- | "𝐀𝐀" +-- | ``` +-- | +takeWhile :: (CodePoint -> Boolean) -> String -> String +takeWhile p s = take (countPrefix p s) s + +-- | Drops the given number of code points from the beginning of the string. If +-- | the string does not have that many code points, returns the empty string. +-- | Operates in constant space and in time linear to the given number. +-- | +-- | ```purescript +-- | >>> drop 5 "𝐀𝐀 b c" +-- | "c" +-- | -- compared to Data.String: +-- | >>> drop 5 "𝐀𝐀 b c" +-- | "b c" -- because "𝐀" occupies 2 code units +-- | ``` +-- | +drop :: Int -> String -> String +drop n s = CU.drop (CU.length (take n s)) s + +-- | Drops the leading sequence of code points which all match the given +-- | predicate from the string. Operates in constant space and in time linear +-- | to the length of the string. +-- | +-- | ```purescript +-- | >>> dropWhile (\c -> fromEnum c == 0x1D400) "𝐀𝐀 b c 𝐀" +-- | " b c 𝐀" +-- | ``` +-- | +dropWhile :: (CodePoint -> Boolean) -> String -> String +dropWhile p s = drop (countPrefix p s) s + +-- | Splits a string into two substrings, where `before` contains the code +-- | points up to (but not including) the given index, and `after` contains the +-- | rest of the string, from that index on. +-- | +-- | ```purescript +-- | >>> splitAt 3 "b 𝐀𝐀 c 𝐀" +-- | { before: "b 𝐀", after: "𝐀 c 𝐀" } +-- | ``` +-- | +-- | Thus the length of `(splitAt i s).before` will equal either `i` or +-- | `length s`, if that is shorter. (Or if `i` is negative the length will be +-- | 0.) +-- | +-- | In code: +-- | ```purescript +-- | length (splitAt i s).before == min (max i 0) (length s) +-- | (splitAt i s).before <> (splitAt i s).after == s +-- | splitAt i s == {before: take i s, after: drop i s} +-- | ``` +splitAt :: Int -> String -> { before :: String, after :: String } +splitAt i s = + let before = take i s in + { before + -- inline drop i s to reuse the result of take i s + , after: CU.drop (CU.length before) s + } + +unsurrogate :: Int -> Int -> CodePoint +unsurrogate lead trail = CodePoint ((lead - 0xD800) * 0x400 + (trail - 0xDC00) + 0x10000) + +isLead :: Int -> Boolean +isLead cu = 0xD800 <= cu && cu <= 0xDBFF + +isTrail :: Int -> Boolean +isTrail cu = 0xDC00 <= cu && cu <= 0xDFFF + +fromCharCode :: Int -> String +fromCharCode = CU.singleton <<< toEnumWithDefaults bottom top + +-- WARN: this function expects the String parameter to be non-empty +unsafeCodePointAt0 :: String -> CodePoint +unsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback + +_unsafeCodePointAt0 :: (String -> CodePoint) -> String -> CodePoint +_unsafeCodePointAt0 a0 a1 = _unsafeCodePointAt0 a0 a1 + +unsafeCodePointAt0Fallback :: String -> CodePoint +unsafeCodePointAt0Fallback s = + let + cu0 = fromEnum (Unsafe.charAt 0 s) + in + if isLead cu0 && CU.length s > 1 + then + let cu1 = fromEnum (Unsafe.charAt 1 s) in + if isTrail cu1 then unsurrogate cu0 cu1 else CodePoint cu0 + else + CodePoint cu0 diff --git a/stdlib/lib/Data/String/CodeUnits.purs b/stdlib/lib/Data/String/CodeUnits.purs new file mode 100644 index 00000000..05cef29f --- /dev/null +++ b/stdlib/lib/Data/String/CodeUnits.purs @@ -0,0 +1,316 @@ +module Data.String.CodeUnits + ( stripPrefix + , stripSuffix + , contains + , singleton + , fromCharArray + , toCharArray + , charAt + , toChar + , uncons + , length + , countPrefix + , indexOf + , indexOf' + , lastIndexOf + , lastIndexOf' + , take + , takeRight + , takeWhile + , drop + , dropRight + , dropWhile + , slice + , splitAt + ) where + +import Prelude + +import Data.Maybe (Maybe(..), isJust) +import Data.String.Pattern (Pattern(..)) +import Data.String.Unsafe as U + +------------------------------------------------------------------------------- +-- `stripPrefix`, `stripSuffix`, and `contains` are CodeUnit/CodePoint agnostic +-- as they are based on patterns rather than lengths/indices, but they need to +-- be defined in here to avoid a circular module dependency +------------------------------------------------------------------------------- + +-- | If the string starts with the given prefix, return the portion of the +-- | string left after removing it, as a `Just` value. Otherwise, return `Nothing`. +-- | +-- | ```purescript +-- | stripPrefix (Pattern "http:") "http://purescript.org" == Just "//purescript.org" +-- | stripPrefix (Pattern "http:") "https://purescript.org" == Nothing +-- | ``` +stripPrefix :: Pattern -> String -> Maybe String +stripPrefix (Pattern prefix) str = + let { before, after } = splitAt (length prefix) str in + if before == prefix then Just after else Nothing + +-- | If the string ends with the given suffix, return the portion of the +-- | string left after removing it, as a `Just` value. Otherwise, return +-- | `Nothing`. +-- | +-- | ```purescript +-- | stripSuffix (Pattern ".exe") "psc.exe" == Just "psc" +-- | stripSuffix (Pattern ".exe") "psc" == Nothing +-- | ``` +stripSuffix :: Pattern -> String -> Maybe String +stripSuffix (Pattern suffix) str = + let { before, after } = splitAt (length str - length suffix) str in + if after == suffix then Just before else Nothing + +-- | Checks whether the pattern appears in the given string. +-- | +-- | ```purescript +-- | contains (Pattern "needle") "haystack with needle" == true +-- | contains (Pattern "needle") "haystack" == false +-- | ``` +contains :: Pattern -> String -> Boolean +contains pat = isJust <<< indexOf pat + +------------------------------------------------------------------------------- +-- all functions past this point are CodeUnit specific +------------------------------------------------------------------------------- + +-- | Returns a string of length `1` containing the given character. +-- | +-- | ```purescript +-- | singleton 'l' == "l" +-- | ``` +-- | +singleton :: Char -> String +singleton a0 = singleton a0 + +-- | Converts an array of characters into a string. +-- | +-- | ```purescript +-- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == "Hello" +-- | ``` +fromCharArray :: Array Char -> String +fromCharArray a0 = fromCharArray a0 + +-- | Converts the string into an array of characters. +-- | +-- | ```purescript +-- | toCharArray "Hello☺\n" == ['H','e','l','l','o','☺','\n'] +-- | ``` +toCharArray :: String -> Array Char +toCharArray a0 = toCharArray a0 + +-- | Returns the character at the given index, if the index is within bounds. +-- | +-- | ```purescript +-- | charAt 2 "Hello" == Just 'l' +-- | charAt 10 "Hello" == Nothing +-- | ``` +-- | +charAt :: Int -> String -> Maybe Char +charAt = _charAt Just Nothing + +_charAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Int -> String -> Maybe Char +_charAt a0 a1 a2 a3 = _charAt a0 a1 a2 a3 + +-- | Converts the string to a character, if the length of the string is +-- | exactly `1`. +-- | +-- | ```purescript +-- | toChar "l" == Just 'l' +-- | toChar "Hi" == Nothing -- since length is not 1 +-- | ``` +toChar :: String -> Maybe Char +toChar = _toChar Just Nothing + +_toChar :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> String -> Maybe Char +_toChar a0 a1 a2 = _toChar a0 a1 a2 + +-- | Returns the first character and the rest of the string, +-- | if the string is not empty. +-- | +-- | ```purescript +-- | uncons "" == Nothing +-- | uncons "Hello World" == Just { head: 'H', tail: "ello World" } +-- | ``` +-- | +uncons :: String -> Maybe { head :: Char, tail :: String } +uncons "" = Nothing +uncons s = Just { head: U.charAt zero s, tail: drop one s } + +-- | Returns the number of characters the string is composed of. +-- | +-- | ```purescript +-- | length "Hello World" == 11 +-- | ``` +-- | +length :: String -> Int +length a0 = length a0 + +-- | Returns the number of contiguous characters at the beginning +-- | of the string for which the predicate holds. +-- | +-- | ```purescript +-- | countPrefix (_ /= ' ') "Hello World" == 5 -- since length "Hello" == 5 +-- | ``` +-- | +countPrefix :: (Char -> Boolean) -> String -> Int +countPrefix a0 a1 = countPrefix a0 a1 + +-- | Returns the index of the first occurrence of the pattern in the +-- | given string. Returns `Nothing` if there is no match. +-- | +-- | ```purescript +-- | indexOf (Pattern "c") "abcdc" == Just 2 +-- | indexOf (Pattern "c") "aaa" == Nothing +-- | ``` +-- | +indexOf :: Pattern -> String -> Maybe Int +indexOf = _indexOf Just Nothing + +_indexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int +_indexOf a0 a1 a2 a3 = _indexOf a0 a1 a2 a3 + +-- | Returns the index of the first occurrence of the pattern in the +-- | given string, starting at the specified index. Returns `Nothing` if there is +-- | no match. +-- | +-- | ```purescript +-- | indexOf' (Pattern "a") 2 "ababa" == Just 2 +-- | indexOf' (Pattern "a") 3 "ababa" == Just 4 +-- | ``` +-- | +indexOf' :: Pattern -> Int -> String -> Maybe Int +indexOf' = _indexOfStartingAt Just Nothing + +_indexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int +_indexOfStartingAt a0 a1 a2 a3 a4 = _indexOfStartingAt a0 a1 a2 a3 a4 + +-- | Returns the index of the last occurrence of the pattern in the +-- | given string. Returns `Nothing` if there is no match. +-- | +-- | ```purescript +-- | lastIndexOf (Pattern "c") "abcdc" == Just 4 +-- | lastIndexOf (Pattern "c") "aaa" == Nothing +-- | ``` +-- | +lastIndexOf :: Pattern -> String -> Maybe Int +lastIndexOf = _lastIndexOf Just Nothing + +_lastIndexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int +_lastIndexOf a0 a1 a2 a3 = _lastIndexOf a0 a1 a2 a3 + +-- | Returns the index of the last occurrence of the pattern in the +-- | given string, starting at the specified index and searching +-- | backwards towards the beginning of the string. +-- | +-- | Starting at a negative index is equivalent to starting at 0 and +-- | starting at an index greater than the string length is equivalent +-- | to searching in the whole string. +-- | +-- | Returns `Nothing` if there is no match. +-- | +-- | ```purescript +-- | lastIndexOf' (Pattern "a") (-1) "ababa" == Just 0 +-- | lastIndexOf' (Pattern "a") 1 "ababa" == Just 0 +-- | lastIndexOf' (Pattern "a") 3 "ababa" == Just 2 +-- | lastIndexOf' (Pattern "a") 4 "ababa" == Just 4 +-- | lastIndexOf' (Pattern "a") 5 "ababa" == Just 4 +-- | ``` +-- | +lastIndexOf' :: Pattern -> Int -> String -> Maybe Int +lastIndexOf' = _lastIndexOfStartingAt Just Nothing + +_lastIndexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int +_lastIndexOfStartingAt a0 a1 a2 a3 a4 = _lastIndexOfStartingAt a0 a1 a2 a3 a4 + +-- | Returns the first `n` characters of the string. +-- | +-- | ```purescript +-- | take 5 "Hello World" == "Hello" +-- | ``` +-- | +take :: Int -> String -> String +take a0 a1 = take a0 a1 + +-- | Returns the last `n` characters of the string. +-- | +-- | ```purescript +-- | takeRight 5 "Hello World" == "World" +-- | ``` +-- | +takeRight :: Int -> String -> String +takeRight i s = drop (length s - i) s + +-- | Returns the longest prefix (possibly empty) of characters that satisfy +-- | the predicate. +-- | +-- | ```purescript +-- | takeWhile (_ /= ':') "http://purescript.org" == "http" +-- | ``` +-- | +takeWhile :: (Char -> Boolean) -> String -> String +takeWhile p s = take (countPrefix p s) s + +-- | Returns the string without the first `n` characters. +-- | +-- | ```purescript +-- | drop 6 "Hello World" == "World" +-- | ``` +-- | +drop :: Int -> String -> String +drop a0 a1 = drop a0 a1 + +-- | Returns the string without the last `n` characters. +-- | +-- | ```purescript +-- | dropRight 6 "Hello World" == "Hello" +-- | ``` +-- | +dropRight :: Int -> String -> String +dropRight i s = take (length s - i) s + +-- | Returns the suffix remaining after `takeWhile`. +-- | +-- | ```purescript +-- | dropWhile (_ /= '.') "Test.purs" == ".purs" +-- | ``` +-- | +dropWhile :: (Char -> Boolean) -> String -> String +dropWhile p s = drop (countPrefix p s) s + +-- | Returns the substring at indices `[begin, end)`. +-- | If either index is negative, it is normalised to `length s - index`, +-- | where `s` is the input string. `""` is returned if either +-- | index is out of bounds or if `begin > end` after normalisation. +-- | +-- | ```purescript +-- | slice 0 0 "purescript" == "" +-- | slice 0 1 "purescript" == "p" +-- | slice 3 6 "purescript" == "esc" +-- | slice (-4) (-1) "purescript" == "rip" +-- | slice (-4) 3 "purescript" == "" +-- | ``` +slice :: Int -> Int -> String -> String +slice a0 a1 a2 = slice a0 a1 a2 + +-- | Splits a string into two substrings, where `before` contains the +-- | characters up to (but not including) the given index, and `after` contains +-- | the rest of the string, from that index on. +-- | +-- | ```purescript +-- | splitAt 2 "Hello World" == { before: "He", after: "llo World"} +-- | splitAt 10 "Hi" == { before: "Hi", after: ""} +-- | ``` +-- | +-- | Thus the length of `(splitAt i s).before` will equal either `i` or +-- | `length s`, if that is shorter. (Or if `i` is negative the length will be +-- | 0.) +-- | +-- | In code: +-- | ```purescript +-- | length (splitAt i s).before == min (max i 0) (length s) +-- | (splitAt i s).before <> (splitAt i s).after == s +-- | splitAt i s == {before: take i s, after: drop i s} +-- | ``` +splitAt :: Int -> String -> { before :: String, after :: String } +splitAt a0 a1 = splitAt a0 a1 diff --git a/stdlib/lib/Data/String/Common.purs b/stdlib/lib/Data/String/Common.purs new file mode 100644 index 00000000..e684682c --- /dev/null +++ b/stdlib/lib/Data/String/Common.purs @@ -0,0 +1,98 @@ +module Data.String.Common + ( null + , localeCompare + , replace + , replaceAll + , split + , toLower + , toUpper + , trim + , joinWith + ) where + +import Prelude + +import Data.String.Pattern (Pattern, Replacement) + +-- | Returns `true` if the given string is empty. +-- | +-- | ```purescript +-- | null "" == true +-- | null "Hi" == false +-- | ``` +null :: String -> Boolean +null s = s == "" + +-- | Compare two strings in a locale-aware fashion. This is in contrast to +-- | the `Ord` instance on `String` which treats strings as arrays of code +-- | units: +-- | +-- | ```purescript +-- | "ä" `localeCompare` "b" == LT +-- | "ä" `compare` "b" == GT +-- | ``` +localeCompare :: String -> String -> Ordering +localeCompare = _localeCompare LT EQ GT + +_localeCompare :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering +_localeCompare a0 a1 a2 a3 a4 = _localeCompare a0 a1 a2 a3 a4 + +-- | Replaces the first occurence of the pattern with the replacement string. +-- | +-- | ```purescript +-- | replace (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b <= c" +-- | ``` +replace :: Pattern -> Replacement -> String -> String +replace a0 a1 a2 = replace a0 a1 a2 + +-- | Replaces all occurences of the pattern with the replacement string. +-- | +-- | ```purescript +-- | replaceAll (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b ≤ c" +-- | ``` +replaceAll :: Pattern -> Replacement -> String -> String +replaceAll a0 a1 a2 = replaceAll a0 a1 a2 + +-- | Returns the substrings of the second string separated along occurences +-- | of the first string. +-- | +-- | ```purescript +-- | split (Pattern " ") "hello world" == ["hello", "world"] +-- | ``` +split :: Pattern -> String -> Array String +split a0 a1 = split a0 a1 + +-- | Returns the argument converted to lowercase. +-- | +-- | ```purescript +-- | toLower "hElLo" == "hello" +-- | ``` +toLower :: String -> String +toLower a0 = toLower a0 + +-- | Returns the argument converted to uppercase. +-- | +-- | ```purescript +-- | toUpper "Hello" == "HELLO" +-- | ``` +toUpper :: String -> String +toUpper a0 = toUpper a0 + +-- | Removes whitespace from the beginning and end of a string, including +-- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2) +-- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3). +-- | +-- | ```purescript +-- | trim " Hello \n World\n\t " == "Hello \n World" +-- | ``` +trim :: String -> String +trim a0 = trim a0 + +-- | Joins the strings in the array together, inserting the first argument +-- | as separator between them. +-- | +-- | ```purescript +-- | joinWith ", " ["apple", "banana", "orange"] == "apple, banana, orange" +-- | ``` +joinWith :: String -> Array String -> String +joinWith a0 a1 = joinWith a0 a1 diff --git a/stdlib/lib/Data/String/Gen.purs b/stdlib/lib/Data/String/Gen.purs new file mode 100644 index 00000000..845b5e80 --- /dev/null +++ b/stdlib/lib/Data/String/Gen.purs @@ -0,0 +1,43 @@ +module Data.String.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, unfoldable, sized, resize) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Char.Gen as CG +import Data.String.CodeUnits as SCU + +-- | Generates a string using the specified character generator. +genString :: forall m. MonadRec m => MonadGen m => m Char -> m String +genString genChar = sized \size -> do + newSize <- chooseInt 1 (max 1 size) + resize (const newSize) $ SCU.fromCharArray <$> unfoldable genChar + +-- | Generates a string using characters from the Unicode basic multilingual +-- | plain. +genUnicodeString :: forall m. MonadRec m => MonadGen m => m String +genUnicodeString = genString CG.genUnicodeChar + +-- | Generates a string using the ASCII character set, excluding control codes. +genAsciiString :: forall m. MonadRec m => MonadGen m => m String +genAsciiString = genString CG.genAsciiChar + +-- | Generates a string using the ASCII character set. +genAsciiString' :: forall m. MonadRec m => MonadGen m => m String +genAsciiString' = genString CG.genAsciiChar' + +-- | Generates a string made up of numeric digits. +genDigitString :: forall m. MonadRec m => MonadGen m => m String +genDigitString = genString CG.genDigitChar + +-- | Generates a string using characters from the basic Latin alphabet. +genAlphaString :: forall m. MonadRec m => MonadGen m => m String +genAlphaString = genString CG.genAlpha + +-- | Generates a string using lowercase characters from the basic Latin alphabet. +genAlphaLowercaseString :: forall m. MonadRec m => MonadGen m => m String +genAlphaLowercaseString = genString CG.genAlphaLowercase + +-- | Generates a string using uppercase characters from the basic Latin alphabet. +genAlphaUppercaseString :: forall m. MonadRec m => MonadGen m => m String +genAlphaUppercaseString = genString CG.genAlphaUppercase diff --git a/stdlib/lib/Data/String/NonEmpty.purs b/stdlib/lib/Data/String/NonEmpty.purs new file mode 100644 index 00000000..6b6210c7 --- /dev/null +++ b/stdlib/lib/Data/String/NonEmpty.purs @@ -0,0 +1,9 @@ +module Data.String.NonEmpty + ( module Data.String.Pattern + , module Data.String.NonEmpty.Internal + , module Data.String.NonEmpty.CodePoints + ) where + +import Data.String.NonEmpty.Internal (NonEmptyString, class MakeNonEmpty, NonEmptyReplacement(..), appendString, contains, fromString, join1With, joinWith, joinWith1, localeCompare, nes, prependString, replace, replaceAll, stripPrefix, stripSuffix, toLower, toString, toUpper, trim, unsafeFromString) +import Data.String.Pattern (Pattern(..)) +import Data.String.NonEmpty.CodePoints diff --git a/stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs b/stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs new file mode 100644 index 00000000..d1c1719e --- /dev/null +++ b/stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs @@ -0,0 +1,22 @@ +module Data.String.NonEmpty.CaseInsensitive where + +import Prelude + +import Data.Newtype (class Newtype) +import Data.String.NonEmpty (NonEmptyString, toLower) + +-- | A newtype for case insensitive string comparisons and ordering. +newtype CaseInsensitiveNonEmptyString = CaseInsensitiveNonEmptyString NonEmptyString + +instance eqCaseInsensitiveNonEmptyString :: Eq CaseInsensitiveNonEmptyString where + eq (CaseInsensitiveNonEmptyString s1) (CaseInsensitiveNonEmptyString s2) = + toLower s1 == toLower s2 + +instance ordCaseInsensitiveNonEmptyString :: Ord CaseInsensitiveNonEmptyString where + compare (CaseInsensitiveNonEmptyString s1) (CaseInsensitiveNonEmptyString s2) = + compare (toLower s1) (toLower s2) + +instance showCaseInsensitiveNonEmptyString :: Show CaseInsensitiveNonEmptyString where + show (CaseInsensitiveNonEmptyString s) = "(CaseInsensitiveNonEmptyString " <> show s <> ")" + +derive instance newtypeCaseInsensitiveNonEmptyString :: Newtype CaseInsensitiveNonEmptyString _ diff --git a/stdlib/lib/Data/String/NonEmpty/CodePoints.purs b/stdlib/lib/Data/String/NonEmpty/CodePoints.purs new file mode 100644 index 00000000..7b5328ab --- /dev/null +++ b/stdlib/lib/Data/String/NonEmpty/CodePoints.purs @@ -0,0 +1,138 @@ +module Data.String.NonEmpty.CodePoints + ( fromCodePointArray + , fromNonEmptyCodePointArray + , singleton + , cons + , snoc + , fromFoldable1 + , toCodePointArray + , toNonEmptyCodePointArray + , codePointAt + , indexOf + , indexOf' + , lastIndexOf + , lastIndexOf' + , uncons + , length + , take + -- takeRight + , takeWhile + , drop + -- dropRight + , dropWhile + , countPrefix + , splitAt + ) where + +import Prelude + +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Array.NonEmpty as NEA +import Data.Maybe (Maybe(..), fromJust) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Foldable as F1 +import Data.String.CodePoints (CodePoint) +import Data.String.CodePoints as CP +import Data.String.NonEmpty.Internal (NonEmptyString(..), fromString) +import Data.String.Pattern (Pattern) +import Partial.Unsafe (unsafePartial) + +-- For internal use only. Do not export. +toNonEmptyString :: String -> NonEmptyString +toNonEmptyString = NonEmptyString + +-- For internal use only. Do not export. +fromNonEmptyString :: NonEmptyString -> String +fromNonEmptyString (NonEmptyString s) = s + +-- For internal use only. Do not export. +liftS :: forall r. (String -> r) -> NonEmptyString -> r +liftS f (NonEmptyString s) = f s + +fromCodePointArray :: Array CodePoint -> Maybe NonEmptyString +fromCodePointArray = case _ of + [] -> Nothing + cs -> Just (toNonEmptyString (CP.fromCodePointArray cs)) + +fromNonEmptyCodePointArray :: NonEmptyArray CodePoint -> NonEmptyString +fromNonEmptyCodePointArray = unsafePartial fromJust <<< fromCodePointArray <<< NEA.toArray + +singleton :: CodePoint -> NonEmptyString +singleton = toNonEmptyString <<< CP.singleton + +cons :: CodePoint -> String -> NonEmptyString +cons c s = toNonEmptyString (CP.singleton c <> s) + +snoc :: CodePoint -> String -> NonEmptyString +snoc c s = toNonEmptyString (s <> CP.singleton c) + +fromFoldable1 :: forall f. Foldable1 f => f CodePoint -> NonEmptyString +fromFoldable1 = F1.foldMap1 singleton + +toCodePointArray :: NonEmptyString -> Array CodePoint +toCodePointArray = CP.toCodePointArray <<< fromNonEmptyString + +toNonEmptyCodePointArray :: NonEmptyString -> NonEmptyArray CodePoint +toNonEmptyCodePointArray = unsafePartial fromJust <<< NEA.fromArray <<< toCodePointArray + +codePointAt :: Int -> NonEmptyString -> Maybe CodePoint +codePointAt = liftS <<< CP.codePointAt + +indexOf :: Pattern -> NonEmptyString -> Maybe Int +indexOf = liftS <<< CP.indexOf + +indexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int +indexOf' pat = liftS <<< CP.indexOf' pat + +lastIndexOf :: Pattern -> NonEmptyString -> Maybe Int +lastIndexOf = liftS <<< CP.lastIndexOf + +lastIndexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int +lastIndexOf' pat = liftS <<< CP.lastIndexOf' pat + +uncons :: NonEmptyString -> { head :: CodePoint, tail :: Maybe NonEmptyString } +uncons nes = + let + s = fromNonEmptyString nes + in + { head: unsafePartial fromJust (CP.codePointAt 0 s) + , tail: fromString (CP.drop 1 s) + } + +length :: NonEmptyString -> Int +length = CP.length <<< fromNonEmptyString + +take :: Int -> NonEmptyString -> Maybe NonEmptyString +take i nes = + let + s = fromNonEmptyString nes + in + if i < 1 + then Nothing + else Just (toNonEmptyString (CP.take i s)) + +takeWhile :: (CodePoint -> Boolean) -> NonEmptyString -> Maybe NonEmptyString +takeWhile f = fromString <<< liftS (CP.takeWhile f) + +drop :: Int -> NonEmptyString -> Maybe NonEmptyString +drop i nes = + let + s = fromNonEmptyString nes + in + if i >= CP.length s + then Nothing + else Just (toNonEmptyString (CP.drop i s)) + +dropWhile :: (CodePoint -> Boolean) -> NonEmptyString -> Maybe NonEmptyString +dropWhile f = fromString <<< liftS (CP.dropWhile f) + +countPrefix :: (CodePoint -> Boolean) -> NonEmptyString -> Int +countPrefix = liftS <<< CP.countPrefix + +splitAt + :: Int + -> NonEmptyString + -> { before :: Maybe NonEmptyString, after :: Maybe NonEmptyString } +splitAt i nes = + case CP.splitAt i (fromNonEmptyString nes) of + { before, after } -> { before: fromString before, after: fromString after } diff --git a/stdlib/lib/Data/String/NonEmpty/CodeUnits.purs b/stdlib/lib/Data/String/NonEmpty/CodeUnits.purs new file mode 100644 index 00000000..af3de430 --- /dev/null +++ b/stdlib/lib/Data/String/NonEmpty/CodeUnits.purs @@ -0,0 +1,308 @@ +module Data.String.NonEmpty.CodeUnits + ( fromCharArray + , fromNonEmptyCharArray + , singleton + , cons + , snoc + , fromFoldable1 + , toCharArray + , toNonEmptyCharArray + , charAt + , toChar + , indexOf + , indexOf' + , lastIndexOf + , lastIndexOf' + , uncons + , length + , take + , takeRight + , takeWhile + , drop + , dropRight + , dropWhile + , countPrefix + , splitAt + ) where + +import Prelude + +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Array.NonEmpty as NEA +import Data.Maybe (Maybe(..), fromJust) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Foldable as F1 +import Data.String.CodeUnits as CU +import Data.String.NonEmpty.Internal (NonEmptyString(..), fromString) +import Data.String.Pattern (Pattern) +import Data.String.Unsafe as U +import Partial.Unsafe (unsafePartial) +import Unsafe.Coerce (unsafeCoerce) + +-- For internal use only. Do not export. +toNonEmptyString :: String -> NonEmptyString +toNonEmptyString = NonEmptyString + +-- For internal use only. Do not export. +fromNonEmptyString :: NonEmptyString -> String +fromNonEmptyString (NonEmptyString s) = s + +-- For internal use only. Do not export. +liftS :: forall r. (String -> r) -> NonEmptyString -> r +liftS f (NonEmptyString s) = f s + +-- | Creates a `NonEmptyString` from a character array `String`, returning +-- | `Nothing` if the input is empty. +-- | +-- | ```purescript +-- | fromCharArray [] = Nothing +-- | fromCharArray ['a', 'b', 'c'] = Just (NonEmptyString "abc") +-- | ``` +fromCharArray :: Array Char -> Maybe NonEmptyString +fromCharArray = case _ of + [] -> Nothing + cs -> Just (toNonEmptyString (CU.fromCharArray cs)) + +fromNonEmptyCharArray :: NonEmptyArray Char -> NonEmptyString +fromNonEmptyCharArray = unsafePartial fromJust <<< fromCharArray <<< NEA.toArray + +-- | Creates a `NonEmptyString` from a character. +singleton :: Char -> NonEmptyString +singleton = toNonEmptyString <<< CU.singleton + +-- | Creates a `NonEmptyString` from a string by prepending a character. +-- | +-- | ```purescript +-- | cons 'a' "bc" = NonEmptyString "abc" +-- | cons 'a' "" = NonEmptyString "a" +-- | ``` +cons :: Char -> String -> NonEmptyString +cons c s = toNonEmptyString (CU.singleton c <> s) + +-- | Creates a `NonEmptyString` from a string by appending a character. +-- | +-- | ```purescript +-- | snoc 'c' "ab" = NonEmptyString "abc" +-- | snoc 'a' "" = NonEmptyString "a" +-- | ``` +snoc :: Char -> String -> NonEmptyString +snoc c s = toNonEmptyString (s <> CU.singleton c) + +-- | Creates a `NonEmptyString` from a `Foldable1` container carrying +-- | characters. +fromFoldable1 :: forall f. Foldable1 f => f Char -> NonEmptyString +fromFoldable1 = F1.fold1 <<< coe + where + coe ∷ f Char -> f NonEmptyString + coe = unsafeCoerce + +-- | Converts the `NonEmptyString` into an array of characters. +-- | +-- | ```purescript +-- | toCharArray (NonEmptyString "Hello☺\n") == ['H','e','l','l','o','☺','\n'] +-- | ``` +toCharArray :: NonEmptyString -> Array Char +toCharArray = CU.toCharArray <<< fromNonEmptyString + +-- | Converts the `NonEmptyString` into a non-empty array of characters. +toNonEmptyCharArray :: NonEmptyString -> NonEmptyArray Char +toNonEmptyCharArray = unsafePartial fromJust <<< NEA.fromArray <<< toCharArray + +-- | Returns the character at the given index, if the index is within bounds. +-- | +-- | ```purescript +-- | charAt 2 (NonEmptyString "Hello") == Just 'l' +-- | charAt 10 (NonEmptyString "Hello") == Nothing +-- | ``` +charAt :: Int -> NonEmptyString -> Maybe Char +charAt = liftS <<< CU.charAt + +-- | Converts the `NonEmptyString` to a character, if the length of the string +-- | is exactly `1`. +-- | +-- | ```purescript +-- | toChar "H" == Just 'H' +-- | toChar "Hi" == Nothing +-- | ``` +toChar :: NonEmptyString -> Maybe Char +toChar = CU.toChar <<< fromNonEmptyString + +-- | Returns the index of the first occurrence of the pattern in the +-- | given string. Returns `Nothing` if there is no match. +-- | +-- | ```purescript +-- | indexOf (Pattern "c") (NonEmptyString "abcdc") == Just 2 +-- | indexOf (Pattern "c") (NonEmptyString "aaa") == Nothing +-- | ``` +indexOf :: Pattern -> NonEmptyString -> Maybe Int +indexOf = liftS <<< CU.indexOf + +-- | Returns the index of the first occurrence of the pattern in the +-- | given string, starting at the specified index. Returns `Nothing` if there is +-- | no match. +-- | +-- | ```purescript +-- | indexOf' (Pattern "a") 2 (NonEmptyString "ababa") == Just 2 +-- | indexOf' (Pattern "a") 3 (NonEmptyString "ababa") == Just 4 +-- | ``` +indexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int +indexOf' pat = liftS <<< CU.indexOf' pat + +-- | Returns the index of the last occurrence of the pattern in the +-- | given string. Returns `Nothing` if there is no match. +-- | +-- | ```purescript +-- | lastIndexOf (Pattern "c") (NonEmptyString "abcdc") == Just 4 +-- | lastIndexOf (Pattern "c") (NonEmptyString "aaa") == Nothing +-- | ``` +lastIndexOf :: Pattern -> NonEmptyString -> Maybe Int +lastIndexOf = liftS <<< CU.lastIndexOf + +-- | Returns the index of the last occurrence of the pattern in the +-- | given string, starting at the specified index and searching +-- | backwards towards the beginning of the string. +-- | +-- | Starting at a negative index is equivalent to starting at 0 and +-- | starting at an index greater than the string length is equivalent +-- | to searching in the whole string. +-- | +-- | Returns `Nothing` if there is no match. +-- | +-- | ```purescript +-- | lastIndexOf' (Pattern "a") (-1) (NonEmptyString "ababa") == Just 0 +-- | lastIndexOf' (Pattern "a") 1 (NonEmptyString "ababa") == Just 0 +-- | lastIndexOf' (Pattern "a") 3 (NonEmptyString "ababa") == Just 2 +-- | lastIndexOf' (Pattern "a") 4 (NonEmptyString "ababa") == Just 4 +-- | lastIndexOf' (Pattern "a") 5 (NonEmptyString "ababa") == Just 4 +-- | ``` +lastIndexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int +lastIndexOf' pat = liftS <<< CU.lastIndexOf' pat + +-- | Returns the first character and the rest of the string. +-- | +-- | ```purescript +-- | uncons "a" == { head: 'a', tail: Nothing } +-- | uncons "Hello World" == { head: 'H', tail: Just (NonEmptyString "ello World") } +-- | ``` +uncons :: NonEmptyString -> { head :: Char, tail :: Maybe NonEmptyString } +uncons nes = + let + s = fromNonEmptyString nes + in + { head: U.charAt 0 s + , tail: fromString (CU.drop 1 s) + } + +-- | Returns the number of characters the string is composed of. +-- | +-- | ```purescript +-- | length (NonEmptyString "Hello World") == 11 +-- | ``` +length :: NonEmptyString -> Int +length = CU.length <<< fromNonEmptyString + +-- | Returns the first `n` characters of the string. Returns `Nothing` if `n` is +-- | less than 1. +-- | +-- | ```purescript +-- | take 5 (NonEmptyString "Hello World") == Just (NonEmptyString "Hello") +-- | take 0 (NonEmptyString "Hello World") == Nothing +-- | ``` +take :: Int -> NonEmptyString -> Maybe NonEmptyString +take i nes = + let + s = fromNonEmptyString nes + in + if i < 1 + then Nothing + else Just (toNonEmptyString (CU.take i s)) + +-- | Returns the last `n` characters of the string. Returns `Nothing` if `n` is +-- | less than 1. +-- | +-- | ```purescript +-- | take 5 (NonEmptyString "Hello World") == Just (NonEmptyString "World") +-- | take 0 (NonEmptyString "Hello World") == Nothing +-- | ``` +takeRight :: Int -> NonEmptyString -> Maybe NonEmptyString +takeRight i nes = + let + s = fromNonEmptyString nes + in + if i < 1 + then Nothing + else Just (toNonEmptyString (CU.takeRight i s)) + +-- | Returns the longest prefix of characters that satisfy the predicate. +-- | `Nothing` is returned if there is no matching prefix. +-- | +-- | ```purescript +-- | takeWhile (_ /= ':') (NonEmptyString "http://purescript.org") == Just (NonEmptyString "http") +-- | takeWhile (_ == 'a') (NonEmptyString "xyz") == Nothing +-- | ``` +takeWhile :: (Char -> Boolean) -> NonEmptyString -> Maybe NonEmptyString +takeWhile f = fromString <<< liftS (CU.takeWhile f) + +-- | Returns the string without the first `n` characters. Returns `Nothing` if +-- | more characters are dropped than the string is long. +-- | +-- | ```purescript +-- | drop 6 (NonEmptyString "Hello World") == Just (NonEmptyString "World") +-- | drop 20 (NonEmptyString "Hello World") == Nothing +-- | ``` +drop :: Int -> NonEmptyString -> Maybe NonEmptyString +drop i nes = + let + s = fromNonEmptyString nes + in + if i >= CU.length s + then Nothing + else Just (toNonEmptyString (CU.drop i s)) + +-- | Returns the string without the last `n` characters. Returns `Nothing` if +-- | more characters are dropped than the string is long. +-- | +-- | ```purescript +-- | dropRight 6 (NonEmptyString "Hello World") == Just (NonEmptyString "Hello") +-- | dropRight 20 (NonEmptyString "Hello World") == Nothing +-- | ``` +dropRight :: Int -> NonEmptyString -> Maybe NonEmptyString +dropRight i nes = + let + s = fromNonEmptyString nes + in + if i >= CU.length s + then Nothing + else Just (toNonEmptyString (CU.dropRight i s)) + +-- | Returns the suffix remaining after `takeWhile`. +-- | +-- | ```purescript +-- | dropWhile (_ /= '.') (NonEmptyString "Test.purs") == Just (NonEmptyString ".purs") +-- | ``` +dropWhile :: (Char -> Boolean) -> NonEmptyString -> Maybe NonEmptyString +dropWhile f = fromString <<< liftS (CU.dropWhile f) + +-- | Returns the number of contiguous characters at the beginning of the string +-- | for which the predicate holds. +-- | +-- | ```purescript +-- | countPrefix (_ /= 'o') (NonEmptyString "Hello World") == 4 +-- | ``` +countPrefix :: (Char -> Boolean) -> NonEmptyString -> Int +countPrefix = liftS <<< CU.countPrefix + +-- | Returns the substrings of a split at the given index, if the index is +-- | within bounds. +-- | +-- | ```purescript +-- | splitAt 2 (NonEmptyString "Hello World") == Just { before: Just (NonEmptyString "He"), after: Just (NonEmptyString "llo World") } +-- | splitAt 10 (NonEmptyString "Hi") == Nothing +-- | ``` +splitAt + :: Int + -> NonEmptyString + -> { before :: Maybe NonEmptyString, after :: Maybe NonEmptyString } +splitAt i nes = + case CU.splitAt i (fromNonEmptyString nes) of + { before, after } -> { before: fromString before, after: fromString after } diff --git a/stdlib/lib/Data/String/NonEmpty/Internal.purs b/stdlib/lib/Data/String/NonEmpty/Internal.purs new file mode 100644 index 00000000..87226543 --- /dev/null +++ b/stdlib/lib/Data/String/NonEmpty/Internal.purs @@ -0,0 +1,232 @@ +-- | While most of the code in this module is safe, this module does +-- | export a few partial functions and the `NonEmptyString` constructor. +-- | While the partial functions are obvious from the `Partial` constraint in +-- | their type signature, the `NonEmptyString` constructor can be overlooked +-- | when searching for issues in one's code. See the constructor's +-- | documentation for more information. +module Data.String.NonEmpty.Internal where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Foldable as F +import Data.Maybe (Maybe(..), fromJust) +import Data.Semigroup.Foldable (class Foldable1) +import Data.String as String +import Data.String.Pattern (Pattern) +import Data.Symbol (class IsSymbol, reflectSymbol) +import Prim.TypeError as TE +import Type.Proxy (Proxy) +import Unsafe.Coerce (unsafeCoerce) + +-- | A string that is known not to be empty. +-- | +-- | You can use this constructor to create a `NonEmptyString` that isn't +-- | non-empty, breaking the guarantee behind this newtype. It is +-- | provided as an escape hatch mainly for the `Data.NonEmpty.CodeUnits` +-- | and `Data.NonEmpty.CodePoints` modules. Use this at your own risk +-- | when you know what you are doing. +newtype NonEmptyString = NonEmptyString String + +derive newtype instance eqNonEmptyString ∷ Eq NonEmptyString +derive newtype instance ordNonEmptyString ∷ Ord NonEmptyString +derive newtype instance semigroupNonEmptyString ∷ Semigroup NonEmptyString + +instance showNonEmptyString :: Show NonEmptyString where + show (NonEmptyString s) = "(NonEmptyString.unsafeFromString " <> show s <> ")" + +-- | A helper class for defining non-empty string values at compile time. +-- | +-- | ``` purescript +-- | something :: NonEmptyString +-- | something = nes (Proxy :: Proxy "something") +-- | ``` +class MakeNonEmpty (s :: Symbol) where + nes :: Proxy s -> NonEmptyString + +instance makeNonEmptyBad :: TE.Fail (TE.Text "Cannot create an NonEmptyString from an empty Symbol") => MakeNonEmpty "" where + nes _ = NonEmptyString "" + +else instance nonEmptyNonEmpty :: IsSymbol s => MakeNonEmpty s where + nes p = NonEmptyString (reflectSymbol p) + +-- | A newtype used in cases to specify a non-empty replacement for a pattern. +newtype NonEmptyReplacement = NonEmptyReplacement NonEmptyString + +derive newtype instance eqNonEmptyReplacement :: Eq NonEmptyReplacement +derive newtype instance ordNonEmptyReplacement :: Ord NonEmptyReplacement +derive newtype instance semigroupNonEmptyReplacement ∷ Semigroup NonEmptyReplacement + +instance showNonEmptyReplacement :: Show NonEmptyReplacement where + show (NonEmptyReplacement s) = "(NonEmptyReplacement " <> show s <> ")" + +-- | Creates a `NonEmptyString` from a `String`, returning `Nothing` if the +-- | input is empty. +-- | +-- | ```purescript +-- | fromString "" = Nothing +-- | fromString "hello" = Just (NES.unsafeFromString "hello") +-- | ``` +fromString :: String -> Maybe NonEmptyString +fromString = case _ of + "" -> Nothing + s -> Just (NonEmptyString s) + +-- | A partial version of `fromString`. +unsafeFromString :: Partial => String -> NonEmptyString +unsafeFromString = fromJust <<< fromString + +-- | Converts a `NonEmptyString` back into a standard `String`. +toString :: NonEmptyString -> String +toString (NonEmptyString s) = s + +-- | Appends a string to this non-empty string. Since one of the strings is +-- | non-empty we know the result will be too. +-- | +-- | ```purescript +-- | appendString (NonEmptyString "Hello") " world" == NonEmptyString "Hello world" +-- | appendString (NonEmptyString "Hello") "" == NonEmptyString "Hello" +-- | ``` +appendString :: NonEmptyString -> String -> NonEmptyString +appendString (NonEmptyString s1) s2 = NonEmptyString (s1 <> s2) + +-- | Prepends a string to this non-empty string. Since one of the strings is +-- | non-empty we know the result will be too. +-- | +-- | ```purescript +-- | prependString "be" (NonEmptyString "fore") == NonEmptyString "before" +-- | prependString "" (NonEmptyString "fore") == NonEmptyString "fore" +-- | ``` +prependString :: String -> NonEmptyString -> NonEmptyString +prependString s1 (NonEmptyString s2) = NonEmptyString (s1 <> s2) + +-- | If the string starts with the given prefix, return the portion of the +-- | string left after removing it. If the prefix does not match or there is no +-- | remainder, the result will be `Nothing`. +-- | +-- | ```purescript +-- | stripPrefix (Pattern "http:") (NonEmptyString "http://purescript.org") == Just (NonEmptyString "//purescript.org") +-- | stripPrefix (Pattern "http:") (NonEmptyString "https://purescript.org") == Nothing +-- | stripPrefix (Pattern "Hello!") (NonEmptyString "Hello!") == Nothing +-- | ``` +stripPrefix :: Pattern -> NonEmptyString -> Maybe NonEmptyString +stripPrefix pat = fromString <=< liftS (String.stripPrefix pat) + +-- | If the string ends with the given suffix, return the portion of the +-- | string left after removing it. If the suffix does not match or there is no +-- | remainder, the result will be `Nothing`. +-- | +-- | ```purescript +-- | stripSuffix (Pattern ".exe") (NonEmptyString "purs.exe") == Just (NonEmptyString "purs") +-- | stripSuffix (Pattern ".exe") (NonEmptyString "purs") == Nothing +-- | stripSuffix (Pattern "Hello!") (NonEmptyString "Hello!") == Nothing +-- | ``` +stripSuffix :: Pattern -> NonEmptyString -> Maybe NonEmptyString +stripSuffix pat = fromString <=< liftS (String.stripSuffix pat) + +-- | Checks whether the pattern appears in the given string. +-- | +-- | ```purescript +-- | contains (Pattern "needle") (NonEmptyString "haystack with needle") == true +-- | contains (Pattern "needle") (NonEmptyString "haystack") == false +-- | ``` +contains :: Pattern -> NonEmptyString -> Boolean +contains = liftS <<< String.contains + +-- | Compare two strings in a locale-aware fashion. This is in contrast to +-- | the `Ord` instance on `String` which treats strings as arrays of code +-- | units: +-- | +-- | ```purescript +-- | NonEmptyString "ä" `localeCompare` NonEmptyString "b" == LT +-- | NonEmptyString "ä" `compare` NonEmptyString "b" == GT +-- | ``` +localeCompare :: NonEmptyString -> NonEmptyString -> Ordering +localeCompare (NonEmptyString a) (NonEmptyString b) = String.localeCompare a b + +-- | Replaces the first occurence of the pattern with the replacement string. +-- | +-- | ```purescript +-- | replace (Pattern "<=") (NonEmptyReplacement "≤") (NonEmptyString "a <= b <= c") == NonEmptyString "a ≤ b <= c" +-- | ``` +replace :: Pattern -> NonEmptyReplacement -> NonEmptyString -> NonEmptyString +replace pat (NonEmptyReplacement (NonEmptyString rep)) (NonEmptyString s) = + NonEmptyString (String.replace pat (String.Replacement rep) s) + +-- | Replaces all occurences of the pattern with the replacement string. +-- | +-- | ```purescript +-- | replaceAll (Pattern "<=") (NonEmptyReplacement "≤") (NonEmptyString "a <= b <= c") == NonEmptyString "a ≤ b ≤ c" +-- | ``` +replaceAll :: Pattern -> NonEmptyReplacement -> NonEmptyString -> NonEmptyString +replaceAll pat (NonEmptyReplacement (NonEmptyString rep)) (NonEmptyString s) = + NonEmptyString (String.replaceAll pat (String.Replacement rep) s) + +-- | Returns the argument converted to lowercase. +-- | +-- | ```purescript +-- | toLower (NonEmptyString "hElLo") == NonEmptyString "hello" +-- | ``` +toLower :: NonEmptyString -> NonEmptyString +toLower (NonEmptyString s) = NonEmptyString (String.toLower s) + +-- | Returns the argument converted to uppercase. +-- | +-- | ```purescript +-- | toUpper (NonEmptyString "Hello") == NonEmptyString "HELLO" +-- | ``` +toUpper :: NonEmptyString -> NonEmptyString +toUpper (NonEmptyString s) = NonEmptyString (String.toUpper s) + +-- | Removes whitespace from the beginning and end of a string, including +-- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2) +-- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3). +-- | If the string is entirely made up of whitespace the result will be Nothing. +-- | +-- | ```purescript +-- | trim (NonEmptyString " Hello \n World\n\t ") == Just (NonEmptyString "Hello \n World") +-- | trim (NonEmptyString " \n") == Nothing +-- | ``` +trim :: NonEmptyString -> Maybe NonEmptyString +trim (NonEmptyString s) = fromString (String.trim s) + +-- | Joins the strings in a container together as a new string, inserting the +-- | first argument as separator between them. The result is not guaranteed to +-- | be non-empty. +-- | +-- | ```purescript +-- | joinWith ", " [NonEmptyString "apple", NonEmptyString "banana"] == "apple, banana" +-- | joinWith ", " [] == "" +-- | ``` +joinWith :: forall f. Foldable f => String -> f NonEmptyString -> String +joinWith splice = F.intercalate splice <<< coe + where + coe :: f NonEmptyString -> f String + coe = unsafeCoerce + +-- | Joins non-empty strings in a non-empty container together as a new +-- | non-empty string, inserting a possibly empty string as separator between +-- | them. The result is guaranteed to be non-empty. +-- | +-- | ```purescript +-- | -- array syntax is used for demonstration here, it would need to be a real `Foldable1` +-- | join1With ", " [NonEmptyString "apple", NonEmptyString "banana"] == NonEmptyString "apple, banana" +-- | join1With "" [NonEmptyString "apple", NonEmptyString "banana"] == NonEmptyString "applebanana" +-- | ``` +join1With :: forall f. Foldable1 f => String -> f NonEmptyString -> NonEmptyString +join1With splice = NonEmptyString <<< joinWith splice + +-- | Joins possibly empty strings in a non-empty container together as a new +-- | non-empty string, inserting a non-empty string as a separator between them. +-- | The result is guaranteed to be non-empty. +-- | +-- | ```purescript +-- | -- array syntax is used for demonstration here, it would need to be a real `Foldable1` +-- | joinWith1 (NonEmptyString ", ") ["apple", "banana"] == NonEmptyString "apple, banana" +-- | joinWith1 (NonEmptyString "/") ["a", "b", "", "c", ""] == NonEmptyString "a/b//c/" +-- | ``` +joinWith1 :: forall f. Foldable1 f => NonEmptyString -> f String -> NonEmptyString +joinWith1 (NonEmptyString splice) = NonEmptyString <<< F.intercalate splice + +liftS :: forall r. (String -> r) -> NonEmptyString -> r +liftS f (NonEmptyString s) = f s diff --git a/stdlib/lib/Data/String/Pattern.purs b/stdlib/lib/Data/String/Pattern.purs new file mode 100644 index 00000000..e0aea960 --- /dev/null +++ b/stdlib/lib/Data/String/Pattern.purs @@ -0,0 +1,33 @@ +module Data.String.Pattern where + +import Prelude + +import Data.Newtype (class Newtype) + +-- | A newtype used in cases where there is a string to be matched. +-- | +-- | ```purescript +-- | pursPattern = Pattern ".purs" +-- | --can be used like this: +-- | contains pursPattern "Test.purs" +-- | == true +-- | ``` +-- | +newtype Pattern = Pattern String + +derive instance eqPattern :: Eq Pattern +derive instance ordPattern :: Ord Pattern +derive instance newtypePattern :: Newtype Pattern _ + +instance showPattern :: Show Pattern where + show (Pattern s) = "(Pattern " <> show s <> ")" + +-- | A newtype used in cases to specify a replacement for a pattern. +newtype Replacement = Replacement String + +derive instance eqReplacement :: Eq Replacement +derive instance ordReplacement :: Ord Replacement +derive instance newtypeReplacement :: Newtype Replacement _ + +instance showReplacement :: Show Replacement where + show (Replacement s) = "(Replacement " <> show s <> ")" diff --git a/stdlib/lib/Data/String/Regex.purs b/stdlib/lib/Data/String/Regex.purs new file mode 100644 index 00000000..6cd837d6 --- /dev/null +++ b/stdlib/lib/Data/String/Regex.purs @@ -0,0 +1,120 @@ +-- | Wraps Javascript's `RegExp` object that enables matching strings with +-- | patterns defined by regular expressions. +-- | For details of the underlying implementation, see [RegExp Reference at MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/RegExp). +module Data.String.Regex + ( Regex(..) + , regex + , source + , flags + , renderFlags + , parseFlags + , test + , match + , replace + , replace' + , search + , split + ) where + +import Prelude + +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.String (contains) +import Data.String.Pattern (Pattern(..)) +import Data.String.Regex.Flags (RegexFlags(..), RegexFlagsRec) + +-- | Wraps Javascript `RegExp` objects. +foreign import data Regex :: Type + +showRegexImpl :: Regex -> String +showRegexImpl a0 = showRegexImpl a0 + +instance showRegex :: Show Regex where + show = showRegexImpl + +regexImpl :: (String -> Either String Regex) -> (Regex -> Either String Regex) -> String -> String -> Either String Regex +regexImpl a0 a1 a2 a3 = regexImpl a0 a1 a2 a3 + +-- | Constructs a `Regex` from a pattern string and flags. Fails with +-- | `Left error` if the pattern contains a syntax error. +regex :: String -> RegexFlags -> Either String Regex +regex s f = regexImpl Left Right s $ renderFlags f + +-- | Returns the pattern string used to construct the given `Regex`. +source :: Regex -> String +source a0 = source a0 + +-- | Returns the `RegexFlags` used to construct the given `Regex`. +flags :: Regex -> RegexFlags +flags = RegexFlags <<< flagsImpl + +-- | Returns the `RegexFlags` inner record used to construct the given `Regex`. +flagsImpl :: Regex -> RegexFlagsRec +flagsImpl a0 = flagsImpl a0 + +-- | Returns the string representation of the given `RegexFlags`. +renderFlags :: RegexFlags -> String +renderFlags (RegexFlags f) = + (if f.global then "g" else "") <> + (if f.ignoreCase then "i" else "") <> + (if f.multiline then "m" else "") <> + (if f.dotAll then "s" else "") <> + (if f.sticky then "y" else "") <> + (if f.unicode then "u" else "") + +-- | Parses the string representation of `RegexFlags`. +parseFlags :: String -> RegexFlags +parseFlags s = RegexFlags + { global: contains (Pattern "g") s + , ignoreCase: contains (Pattern "i") s + , multiline: contains (Pattern "m") s + , dotAll: contains (Pattern "s") s + , sticky: contains (Pattern "y") s + , unicode: contains (Pattern "u") s + } + +-- | Returns `true` if the `Regex` matches the string. In contrast to +-- | `RegExp.prototype.test()` in JavaScript, `test` does not affect +-- | the `lastIndex` property of the Regex. +test :: Regex -> String -> Boolean +test a0 a1 = test a0 a1 + +_match :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe (NonEmptyArray (Maybe String)) +_match a0 a1 a2 a3 = _match a0 a1 a2 a3 + +-- | Matches the string against the `Regex` and returns an array of matches +-- | if there were any. Each match has type `Maybe String`, where `Nothing` +-- | represents an unmatched optional capturing group. +-- | See [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/match). +match :: Regex -> String -> Maybe (NonEmptyArray (Maybe String)) +match = _match Just Nothing + +-- | Replaces occurrences of the `Regex` with the first string. The replacement +-- | string can include special replacement patterns escaped with `"$"`. +-- | See [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/replace). +replace :: Regex -> String -> String -> String +replace a0 a1 a2 = replace a0 a1 a2 + +_replaceBy :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> (String -> Array (Maybe String) -> String) -> String -> String +_replaceBy a0 a1 a2 a3 a4 = _replaceBy a0 a1 a2 a3 a4 + +-- | Transforms occurrences of the `Regex` using a function of the matched +-- | substring and a list of captured substrings of type `Maybe String`, +-- | where `Nothing` represents an unmatched optional capturing group. +-- | See the [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/replace#Specifying_a_function_as_a_parameter). +replace' :: Regex -> (String -> Array (Maybe String) -> String) -> String -> String +replace' = _replaceBy Just Nothing + +_search :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe Int +_search a0 a1 a2 a3 = _search a0 a1 a2 a3 + +-- | Returns `Just` the index of the first match of the `Regex` in the string, +-- | or `Nothing` if there is no match. +search :: Regex -> String -> Maybe Int +search = _search Just Nothing + +-- | Split the string into an array of substrings along occurrences of the `Regex`. +split :: Regex -> String -> Array String +split a0 a1 = split a0 a1 diff --git a/stdlib/lib/Data/String/Regex/Flags.purs b/stdlib/lib/Data/String/Regex/Flags.purs new file mode 100644 index 00000000..6d7dd710 --- /dev/null +++ b/stdlib/lib/Data/String/Regex/Flags.purs @@ -0,0 +1,129 @@ +module Data.String.Regex.Flags where + +import Prelude + +import Control.MonadPlus (guard) +import Data.Newtype (class Newtype) +import Data.String (joinWith) + +type RegexFlagsRec = + { global :: Boolean + , ignoreCase :: Boolean + , multiline :: Boolean + , dotAll :: Boolean + , sticky :: Boolean + , unicode :: Boolean + } + +-- | Flags that control matching. +newtype RegexFlags = RegexFlags RegexFlagsRec + +derive instance newtypeRegexFlags :: Newtype RegexFlags _ + +-- | All flags set to false. +noFlags :: RegexFlags +noFlags = RegexFlags + { global: false + , ignoreCase: false + , multiline: false + , dotAll: false + , sticky: false + , unicode: false + } + +-- | Only global flag set to true +global :: RegexFlags +global = RegexFlags + { global: true + , ignoreCase: false + , multiline: false + , dotAll: false + , sticky: false + , unicode: false + } + +-- | Only ignoreCase flag set to true +ignoreCase :: RegexFlags +ignoreCase = RegexFlags + { global: false + , ignoreCase: true + , multiline: false + , dotAll: false + , sticky: false + , unicode: false + } + +-- | Only multiline flag set to true +multiline :: RegexFlags +multiline = RegexFlags + { global: false + , ignoreCase: false + , multiline: true + , dotAll: false + , sticky: false + , unicode: false + } + +-- | Only sticky flag set to true +sticky :: RegexFlags +sticky = RegexFlags + { global: false + , ignoreCase: false + , multiline: false + , dotAll: false + , sticky: true + , unicode: false + } + +-- | Only unicode flag set to true +unicode :: RegexFlags +unicode = RegexFlags + { global: false + , ignoreCase: false + , multiline: false + , dotAll: false + , sticky: false + , unicode: true + } + +-- | Only dotAll flag set to true +dotAll :: RegexFlags +dotAll = RegexFlags + { global: false + , ignoreCase: false + , multiline: false + , dotAll: true + , sticky: false + , unicode: false + } + +instance semigroupRegexFlags :: Semigroup RegexFlags where + append (RegexFlags x) (RegexFlags y) = RegexFlags + { global: x.global || y.global + , ignoreCase: x.ignoreCase || y.ignoreCase + , multiline: x.multiline || y.multiline + , dotAll: x.dotAll || y.dotAll + , sticky: x.sticky || y.sticky + , unicode: x.unicode || y.unicode + } + +instance monoidRegexFlags :: Monoid RegexFlags where + mempty = noFlags + +derive newtype instance eqRegexFlags :: Eq RegexFlags + +instance showRegexFlags :: Show RegexFlags where + show (RegexFlags flags) = + let + usedFlags = + [] + <> (guard flags.global $> "global") + <> (guard flags.ignoreCase $> "ignoreCase") + <> (guard flags.multiline $> "multiline") + <> (guard flags.dotAll $> "dotAll") + <> (guard flags.sticky $> "sticky") + <> (guard flags.unicode $> "unicode") + in + if usedFlags == [] + then "noFlags" + else "(" <> joinWith " <> " usedFlags <> ")" diff --git a/stdlib/lib/Data/String/Regex/Unsafe.purs b/stdlib/lib/Data/String/Regex/Unsafe.purs new file mode 100644 index 00000000..8afd1a29 --- /dev/null +++ b/stdlib/lib/Data/String/Regex/Unsafe.purs @@ -0,0 +1,14 @@ +module Data.String.Regex.Unsafe + ( unsafeRegex + ) where + +import Control.Category (identity) +import Data.Either (either) +import Data.String.Regex (Regex, regex) +import Data.String.Regex.Flags (RegexFlags) +import Partial.Unsafe (unsafeCrashWith) + +-- | Constructs a `Regex` from a pattern string and flags. Fails with +-- | an exception if the pattern contains a syntax error. +unsafeRegex :: String -> RegexFlags -> Regex +unsafeRegex s f = either unsafeCrashWith identity (regex s f) diff --git a/stdlib/lib/Data/String/Unsafe.purs b/stdlib/lib/Data/String/Unsafe.purs new file mode 100644 index 00000000..b1bdce28 --- /dev/null +++ b/stdlib/lib/Data/String/Unsafe.purs @@ -0,0 +1,17 @@ +-- | Unsafe string and character functions. +module Data.String.Unsafe + ( char + , charAt + ) where + +-- | Returns the character at the given index. +-- | +-- | **Unsafe:** throws runtime exception if the index is out of bounds. +charAt :: Int -> String -> Char +charAt a0 a1 = charAt a0 a1 + +-- | Converts a string of length `1` to a character. +-- | +-- | **Unsafe:** throws runtime exception if length is not `1`. +char :: String -> Char +char a0 = char a0 diff --git a/stdlib/lib/Data/Symbol.purs b/stdlib/lib/Data/Symbol.purs new file mode 100644 index 00000000..5cf5c884 --- /dev/null +++ b/stdlib/lib/Data/Symbol.purs @@ -0,0 +1,25 @@ +module Data.Symbol + ( class IsSymbol + , reflectSymbol + , reifySymbol + ) where + +import Type.Proxy (Proxy(..)) + +-- | A class for known symbols +class IsSymbol (sym :: Symbol) where + reflectSymbol :: Proxy sym -> String + +-- local definition for use in `reifySymbol` +unsafeCoerce :: forall a b. a -> b +unsafeCoerce a0 = unsafeCoerce a0 + +reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r +reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy + where + coerce + :: (forall sym1. IsSymbol sym1 => Proxy sym1 -> r) + -> { reflectSymbol :: Proxy "" -> String } + -> Proxy "" + -> r + coerce = unsafeCoerce diff --git a/stdlib/lib/Data/Traversable.purs b/stdlib/lib/Data/Traversable.purs new file mode 100644 index 00000000..a5206cea --- /dev/null +++ b/stdlib/lib/Data/Traversable.purs @@ -0,0 +1,251 @@ +module Data.Traversable + ( class Traversable, traverse, sequence + , traverseDefault, sequenceDefault + , for + , scanl + , scanr + , mapAccumL + , mapAccumR + , module Data.Foldable + , module Data.Traversable.Accum + ) where + +import Prelude + +import Control.Apply (lift2) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, sequence_, sum, traverse_) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Functor.Product (Product(..), product) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe(..)) +import Data.Maybe.First (First(..)) +import Data.Maybe.Last (Last(..)) +import Data.Monoid.Additive (Additive(..)) +import Data.Monoid.Conj (Conj(..)) +import Data.Monoid.Disj (Disj(..)) +import Data.Monoid.Dual (Dual(..)) +import Data.Monoid.Multiplicative (Multiplicative(..)) +import Data.Traversable.Accum (Accum) +import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) +import Data.Tuple (Tuple(..)) + +-- | `Traversable` represents data structures which can be _traversed_, +-- | accumulating results and effects in some `Applicative` functor. +-- | +-- | - `traverse` runs an action for every element in a data structure, +-- | and accumulates the results. +-- | - `sequence` runs the actions _contained_ in a data structure, +-- | and accumulates the results. +-- | +-- | ```purescript +-- | import Data.Traversable +-- | import Data.Maybe +-- | import Data.Int (fromNumber) +-- | +-- | sequence [Just 1, Just 2, Just 3] == Just [1,2,3] +-- | sequence [Nothing, Just 2, Just 3] == Nothing +-- | +-- | traverse fromNumber [1.0, 2.0, 3.0] == Just [1,2,3] +-- | traverse fromNumber [1.5, 2.0, 3.0] == Nothing +-- | +-- | traverse logShow [1,2,3] +-- | -- prints: +-- | 1 +-- | 2 +-- | 3 +-- | +-- | traverse (\x -> [x, 0]) [1,2,3] == [[1,2,3],[1,2,0],[1,0,3],[1,0,0],[0,2,3],[0,2,0],[0,0,3],[0,0,0]] +-- | ``` +-- | +-- | The `traverse` and `sequence` functions should be compatible in the +-- | following sense: +-- | +-- | - `traverse f xs = sequence (f <$> xs)` +-- | - `sequence = traverse identity` +-- | +-- | `Traversable` instances should also be compatible with the corresponding +-- | `Foldable` instances, in the following sense: +-- | +-- | - `foldMap f = runConst <<< traverse (Const <<< f)` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `traverseDefault` +-- | - `sequenceDefault` +class (Functor t, Foldable t) <= Traversable t where + traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b) + sequence :: forall a m. Applicative m => t (m a) -> m (t a) + +-- | A default implementation of `traverse` using `sequence` and `map`. +traverseDefault + :: forall t a b m + . Traversable t + => Applicative m + => (a -> m b) + -> t a + -> m (t b) +traverseDefault f ta = sequence (f <$> ta) + +-- | A default implementation of `sequence` using `traverse`. +sequenceDefault + :: forall t a m + . Traversable t + => Applicative m + => t (m a) + -> m (t a) +sequenceDefault = traverse identity + +instance traversableArray :: Traversable Array where + traverse = traverseArrayImpl apply map pure + sequence = sequenceDefault + +traverseArrayImpl :: forall m a b . (forall x y. m (x -> y) -> m x -> m y) -> (forall x y. (x -> y) -> m x -> m y) -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b) +traverseArrayImpl a0 a1 a2 a3 a4 = traverseArrayImpl a0 a1 a2 a3 a4 + +instance traversableMaybe :: Traversable Maybe where + traverse _ Nothing = pure Nothing + traverse f (Just x) = Just <$> f x + sequence Nothing = pure Nothing + sequence (Just x) = Just <$> x + +instance traversableFirst :: Traversable First where + traverse f (First x) = First <$> traverse f x + sequence (First x) = First <$> sequence x + +instance traversableLast :: Traversable Last where + traverse f (Last x) = Last <$> traverse f x + sequence (Last x) = Last <$> sequence x + +instance traversableAdditive :: Traversable Additive where + traverse f (Additive x) = Additive <$> f x + sequence (Additive x) = Additive <$> x + +instance traversableDual :: Traversable Dual where + traverse f (Dual x) = Dual <$> f x + sequence (Dual x) = Dual <$> x + +instance traversableConj :: Traversable Conj where + traverse f (Conj x) = Conj <$> f x + sequence (Conj x) = Conj <$> x + +instance traversableDisj :: Traversable Disj where + traverse f (Disj x) = Disj <$> f x + sequence (Disj x) = Disj <$> x + +instance traversableMultiplicative :: Traversable Multiplicative where + traverse f (Multiplicative x) = Multiplicative <$> f x + sequence (Multiplicative x) = Multiplicative <$> x + +instance traversableEither :: Traversable (Either a) where + traverse _ (Left x) = pure (Left x) + traverse f (Right x) = Right <$> f x + sequence (Left x) = pure (Left x) + sequence (Right x) = Right <$> x + +instance traversableTuple :: Traversable (Tuple a) where + traverse f (Tuple x y) = Tuple x <$> f y + sequence (Tuple x y) = Tuple x <$> y + +instance traversableIdentity :: Traversable Identity where + traverse f (Identity x) = Identity <$> f x + sequence (Identity x) = Identity <$> x + +instance traversableConst :: Traversable (Const a) where + traverse _ (Const x) = pure (Const x) + sequence (Const x) = pure (Const x) + +instance traversableProduct :: (Traversable f, Traversable g) => Traversable (Product f g) where + traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga) + sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga) + +instance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where + traverse f = coproduct + (map (Coproduct <<< Left) <<< traverse f) + (map (Coproduct <<< Right) <<< traverse f) + sequence = coproduct + (map (Coproduct <<< Left) <<< sequence) + (map (Coproduct <<< Right) <<< sequence) + +instance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where + traverse f (Compose fga) = map Compose $ traverse (traverse f) fga + sequence = traverse identity + +instance traversableApp :: Traversable f => Traversable (App f) where + traverse f (App x) = App <$> traverse f x + sequence (App x) = App <$> sequence x + +-- | A version of `traverse` with its arguments flipped. +-- | +-- | +-- | This can be useful when running an action written using do notation +-- | for every element in a data structure: +-- | +-- | For example: +-- | +-- | ```purescript +-- | for [1, 2, 3] \n -> do +-- | print n +-- | return (n * n) +-- | ``` +for + :: forall a b m t + . Applicative m + => Traversable t + => t a + -> (a -> m b) + -> m (t b) +for x f = traverse f x + +-- | Fold a data structure from the left, keeping all intermediate results +-- | instead of only the final result. Note that the initial value does not +-- | appear in the result (unlike Haskell's `Prelude.scanl`). +-- | +-- | ```purescript +-- | scanl (+) 0 [1,2,3] = [1,3,6] +-- | scanl (-) 10 [1,2,3] = [9,7,4] +-- | ``` +scanl :: forall a b f. Traversable f => (b -> a -> b) -> b -> f a -> f b +scanl f b0 xs = (mapAccumL (\b a -> let b' = f b a in { accum: b', value: b' }) b0 xs).value + +-- | Fold a data structure from the left, keeping all intermediate results +-- | instead of only the final result. +-- | +-- | Unlike `scanl`, `mapAccumL` allows the type of accumulator to differ +-- | from the element type of the final data structure. +mapAccumL + :: forall a b s f + . Traversable f + => (s -> a -> Accum s b) + -> s + -> f a + -> Accum s (f b) +mapAccumL f s0 xs = stateL (traverse (\a -> StateL \s -> f s a) xs) s0 + +-- | Fold a data structure from the right, keeping all intermediate results +-- | instead of only the final result. Note that the initial value does not +-- | appear in the result (unlike Haskell's `Prelude.scanr`). +-- | +-- | ```purescript +-- | scanr (+) 0 [1,2,3] = [6,5,3] +-- | scanr (flip (-)) 10 [1,2,3] = [4,5,7] +-- | ``` +scanr :: forall a b f. Traversable f => (a -> b -> b) -> b -> f a -> f b +scanr f b0 xs = (mapAccumR (\b a -> let b' = f a b in { accum: b', value: b' }) b0 xs).value + +-- | Fold a data structure from the right, keeping all intermediate results +-- | instead of only the final result. +-- | +-- | Unlike `scanr`, `mapAccumR` allows the type of accumulator to differ +-- | from the element type of the final data structure. +mapAccumR + :: forall a b s f + . Traversable f + => (s -> a -> Accum s b) + -> s + -> f a + -> Accum s (f b) +mapAccumR f s0 xs = stateR (traverse (\a -> StateR \s -> f s a) xs) s0 diff --git a/stdlib/lib/Data/Traversable/Accum.purs b/stdlib/lib/Data/Traversable/Accum.purs new file mode 100644 index 00000000..774b174b --- /dev/null +++ b/stdlib/lib/Data/Traversable/Accum.purs @@ -0,0 +1,5 @@ +module Data.Traversable.Accum + ( Accum + ) where + +type Accum s a = { accum :: s, value :: a } diff --git a/stdlib/lib/Data/Traversable/Accum/Internal.purs b/stdlib/lib/Data/Traversable/Accum/Internal.purs new file mode 100644 index 00000000..9f9ae33d --- /dev/null +++ b/stdlib/lib/Data/Traversable/Accum/Internal.purs @@ -0,0 +1,44 @@ +module Data.Traversable.Accum.Internal + ( StateL(..) + , stateL + , StateR(..) + , stateR + ) where + +import Prelude +import Data.Traversable.Accum (Accum) + +newtype StateL s a = StateL (s -> Accum s a) + +stateL :: forall s a. StateL s a -> s -> Accum s a +stateL (StateL k) = k + +instance functorStateL :: Functor (StateL s) where + map f k = StateL \s -> case stateL k s of + { accum: s1, value: a } -> { accum: s1, value: f a } + +instance applyStateL :: Apply (StateL s) where + apply f x = StateL \s -> case stateL f s of + { accum: s1, value: f' } -> case stateL x s1 of + { accum: s2, value: x' } -> { accum: s2, value: f' x' } + +instance applicativeStateL :: Applicative (StateL s) where + pure a = StateL \s -> { accum: s, value: a } + + +newtype StateR s a = StateR (s -> Accum s a) + +stateR :: forall s a. StateR s a -> s -> Accum s a +stateR (StateR k) = k + +instance functorStateR :: Functor (StateR s) where + map f k = StateR \s -> case stateR k s of + { accum: s1, value: a } -> { accum: s1, value: f a } + +instance applyStateR :: Apply (StateR s) where + apply f x = StateR \s -> case stateR x s of + { accum: s1, value: x' } -> case stateR f s1 of + { accum: s2, value: f' } -> { accum: s2, value: f' x' } + +instance applicativeStateR :: Applicative (StateR s) where + pure a = StateR \s -> { accum: s, value: a } diff --git a/stdlib/lib/Data/TraversableWithIndex.purs b/stdlib/lib/Data/TraversableWithIndex.purs new file mode 100644 index 00000000..f09d5e70 --- /dev/null +++ b/stdlib/lib/Data/TraversableWithIndex.purs @@ -0,0 +1,213 @@ +module Data.TraversableWithIndex + ( class TraversableWithIndex, traverseWithIndex + , traverseWithIndexDefault + , forWithIndex + , scanlWithIndex + , mapAccumLWithIndex + , scanrWithIndex + , mapAccumRWithIndex + , traverseDefault + , module Data.Traversable.Accum + ) where + +import Prelude + +import Control.Apply (lift2) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Functor.Product (Product(..), product) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe) +import Data.Maybe.First (First) +import Data.Maybe.Last (Last) +import Data.Monoid.Additive (Additive) +import Data.Monoid.Conj (Conj) +import Data.Monoid.Disj (Disj) +import Data.Monoid.Dual (Dual) +import Data.Monoid.Multiplicative (Multiplicative) +import Data.Traversable (class Traversable, sequence, traverse) +import Data.Traversable.Accum (Accum) +import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) +import Data.Tuple (Tuple(..), curry) + + +-- | A `Traversable` with an additional index. +-- | A `TraversableWithIndex` instance must be compatible with its +-- | `Traversable` instance +-- | ```purescript +-- | traverse f = traverseWithIndex (const f) +-- | ``` +-- | with its `FoldableWithIndex` instance +-- | ``` +-- | foldMapWithIndex f = unwrap <<< traverseWithIndex (\i -> Const <<< f i) +-- | ``` +-- | and with its `FunctorWithIndex` instance +-- | ``` +-- | mapWithIndex f = unwrap <<< traverseWithIndex (\i -> Identity <<< f i) +-- | ``` +-- | +-- | A default implementation is provided by `traverseWithIndexDefault`. +class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) <= TraversableWithIndex i t | t -> i where + traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) + +-- | A default implementation of `traverseWithIndex` using `sequence` and `mapWithIndex`. +traverseWithIndexDefault + :: forall i t a b m + . TraversableWithIndex i t + => Applicative m + => (i -> a -> m b) + -> t a + -> m (t b) +traverseWithIndexDefault f = sequence <<< mapWithIndex f + +instance traversableWithIndexArray :: TraversableWithIndex Int Array where + traverseWithIndex = traverseWithIndexDefault + +instance traversableWithIndexMaybe :: TraversableWithIndex Unit Maybe where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexFirst :: TraversableWithIndex Unit First where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexLast :: TraversableWithIndex Unit Last where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexAdditive :: TraversableWithIndex Unit Additive where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexDual :: TraversableWithIndex Unit Dual where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexConj :: TraversableWithIndex Unit Conj where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexDisj :: TraversableWithIndex Unit Disj where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexMultiplicative :: TraversableWithIndex Unit Multiplicative where + traverseWithIndex f = traverse $ f unit + +instance traversableWithIndexEither :: TraversableWithIndex Unit (Either a) where + traverseWithIndex _ (Left x) = pure (Left x) + traverseWithIndex f (Right x) = Right <$> f unit x + +instance traversableWithIndexTuple :: TraversableWithIndex Unit (Tuple a) where + traverseWithIndex f (Tuple x y) = Tuple x <$> f unit y + +instance traversableWithIndexIdentity :: TraversableWithIndex Unit Identity where + traverseWithIndex f (Identity x) = Identity <$> f unit x + +instance traversableWithIndexConst :: TraversableWithIndex Void (Const a) where + traverseWithIndex _ (Const x) = pure (Const x) + +instance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where + traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga) + +instance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where + traverseWithIndex f = coproduct + (map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left)) + (map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right)) + +instance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where + traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga + +instance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f) where + traverseWithIndex f (App x) = App <$> traverseWithIndex f x + +-- | A version of `traverseWithIndex` with its arguments flipped. +-- | +-- | +-- | This can be useful when running an action written using do notation +-- | for every element in a data structure: +-- | +-- | For example: +-- | +-- | ```purescript +-- | for [1, 2, 3] \i x -> do +-- | logShow i +-- | pure (x * x) +-- | ``` +forWithIndex + :: forall i a b m t + . Applicative m + => TraversableWithIndex i t + => t a + -> (i -> a -> m b) + -> m (t b) +forWithIndex = flip traverseWithIndex + +-- | Fold a data structure from the left with access to the indices, keeping +-- | all intermediate results instead of only the final result. Note that the +-- | initial value does not appear in the result (unlike Haskell's +-- | `Prelude.scanl`). +-- | +-- | ```purescript +-- | scanlWithIndex (\i y x -> i + y + x) 0 [1, 2, 3] = [1, 4, 9] +-- | ``` +scanlWithIndex + :: forall i a b f + . TraversableWithIndex i f + => (i -> b -> a -> b) + -> b + -> f a + -> f b +scanlWithIndex f b0 xs = + (mapAccumLWithIndex (\i b a -> let b' = f i b a in { accum: b', value: b' }) b0 xs).value + +-- | Fold a data structure from the left with access to the indices, keeping +-- | all intermediate results instead of only the final result. +-- | +-- | Unlike `scanlWithIndex`, `mapAccumLWithIndex` allows the type of accumulator to differ +-- | from the element type of the final data structure. +mapAccumLWithIndex + :: forall i a b s f + . TraversableWithIndex i f + => (i -> s -> a -> Accum s b) + -> s + -> f a + -> Accum s (f b) +mapAccumLWithIndex f s0 xs = stateL (traverseWithIndex (\i a -> StateL \s -> f i s a) xs) s0 + +-- | Fold a data structure from the right with access to the indices, keeping +-- | all intermediate results instead of only the final result. Note that the +-- | initial value does not appear in the result (unlike Haskell's `Prelude.scanr`). +-- | +-- | ```purescript +-- | scanrWithIndex (\i x y -> i + x + y) 0 [1, 2, 3] = [9, 8, 5] +-- | ``` +scanrWithIndex + :: forall i a b f + . TraversableWithIndex i f + => (i -> a -> b -> b) + -> b + -> f a + -> f b +scanrWithIndex f b0 xs = + (mapAccumRWithIndex (\i b a -> let b' = f i a b in { accum: b', value: b' }) b0 xs).value + +-- | Fold a data structure from the right with access to the indices, keeping +-- | all intermediate results instead of only the final result. +-- | +-- | Unlike `scanrWithIndex`, `imapAccumRWithIndex` allows the type of accumulator to differ +-- | from the element type of the final data structure. +mapAccumRWithIndex + :: forall i a b s f + . TraversableWithIndex i f + => (i -> s -> a -> Accum s b) + -> s + -> f a + -> Accum s (f b) +mapAccumRWithIndex f s0 xs = stateR (traverseWithIndex (\i a -> StateR \s -> f i s a) xs) s0 + +-- | A default implementation of `traverse` in terms of `traverseWithIndex` +traverseDefault + :: forall i t a b m + . TraversableWithIndex i t + => Applicative m + => (a -> m b) -> t a -> m (t b) +traverseDefault f = traverseWithIndex (const f) diff --git a/stdlib/lib/Data/Tuple.purs b/stdlib/lib/Data/Tuple.purs index 0f82c4ee..8e1a347c 100644 --- a/stdlib/lib/Data/Tuple.purs +++ b/stdlib/lib/Data/Tuple.purs @@ -1,13 +1,9 @@ --- | A pair, as the closed record `{ _1, _2 }`. --- | --- | FE-06 already lowers tuple syntax to that record, and DEC-13 maps a WIT --- | `tuple` to the same labels. This module is that record, not a second --- | product: `Tuple a b` and `{ _1 :: a, _2 :: b }` are one type, and `(x, y)` --- | is a value of it. There is no algebraic `Tuple` constructor and no --- | `Eq` / `Ord` / `Show` / `Functor` instance; those would either duplicate --- | the record or belong to the Prelude class slices. +-- | A strict product of two values. Native tuple syntax remains a closed +-- | record, while this library type provides the constructor used by the core +-- | libraries. WIT tuples continue to map to closed records as specified by +-- | DEC-13. module Data.Tuple - ( Tuple + ( Tuple(..) , fst , snd , curry @@ -15,24 +11,24 @@ module Data.Tuple , swap ) where -type Tuple a b = { _1 :: a, _2 :: b } +data Tuple a b = Tuple a b --- | The first component. `fst (x, y)` is `x`. +-- | The first component. `fst (Tuple x y)` is `x`. fst :: forall a b. Tuple a b -> a -fst tuple = tuple._1 +fst (Tuple first _) = first --- | The second component. `snd (x, y)` is `y`. +-- | The second component. `snd (Tuple x y)` is `y`. snd :: forall a b. Tuple a b -> b -snd tuple = tuple._2 +snd (Tuple _ second) = second -- | Turns a function of a pair into a function of two arguments. curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c -curry f x y = f { _1: x, _2: y } +curry f x y = f (Tuple x y) -- | Turns a function of two arguments into a function of a pair. uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c -uncurry f tuple = f (tuple._1) (tuple._2) +uncurry f (Tuple first second) = f first second -- | Exchanges the two components. swap :: forall a b. Tuple a b -> Tuple b a -swap tuple = { _1: tuple._2, _2: tuple._1 } +swap (Tuple first second) = Tuple second first diff --git a/stdlib/lib/Data/Tuple/Nested.purs b/stdlib/lib/Data/Tuple/Nested.purs new file mode 100644 index 00000000..156547ad --- /dev/null +++ b/stdlib/lib/Data/Tuple/Nested.purs @@ -0,0 +1,294 @@ +-- | Tuples that are not restricted to two elements. +-- | +-- | Here is an example of a 3-tuple: +-- | +-- | +-- | ```purescript +-- | > tuple = tuple3 1 "2" 3.0 +-- | > tuple +-- | (Tuple 1 (Tuple "2" (Tuple 3.0 unit))) +-- | ``` +-- | +-- | Notice that a tuple is a nested structure not unlike a list. The type of `tuple` is this: +-- | +-- | ```purescript +-- | > :t tuple +-- | Tuple Int (Tuple String (Tuple Number Unit)) +-- | ``` +-- | +-- | That, however, can be abbreviated with the `Tuple3` type: +-- | +-- | ```purescript +-- | Tuple3 Int String Number +-- | ``` +-- | +-- | All tuple functions are numbered from 1 to 10. That is, there's +-- | a `get1` and a `get10`. +-- | +-- | The `getN` functions accept tuples of length N or greater: +-- | +-- | ```purescript +-- | get1 tuple = 1 +-- | get3 tuple = 3 +-- | get4 tuple -- type error. `get4` requires a longer tuple. +-- | ``` +-- | +-- | The same is true of the `overN` functions: +-- | +-- | ```purescript +-- | over2 negate (tuple3 1 2 3) = tuple3 1 (-2) 3 +-- | ``` +-- | + +-- | `uncurryN` can be used to convert a function that takes `N` arguments to one that takes an N-tuple: +-- | +-- | ```purescript +-- | uncurry2 (+) (tuple2 1 2) = 3 +-- | ``` +-- | +-- | The reverse `curryN` function converts functions that take +-- | N-tuples (which are rare) to functions that take `N` arguments. +-- | +-- | --------------- +-- | In addition to types like `Tuple3`, there are also types like +-- | `T3`. Whereas `Tuple3` describes a tuple with exactly three +-- | elements, `T3` describes a tuple of length *two or longer*. More +-- | specifically, `T3` requires two element plus a "tail" that may be +-- | `unit` or more tuple elements. Use types like `T3` when you want to +-- | create a set of functions for arbitrary tuples. See the source for how that's done. +-- | +module Data.Tuple.Nested where + +import Prelude +import Data.Tuple (Tuple(..)) + +-- | Shorthand for constructing n-tuples as nested pairs. +-- | `a /\ b /\ c /\ d /\ unit` becomes `Tuple a (Tuple b (Tuple c (Tuple d unit)))` +infixr 6 Tuple as /\ + +-- | Shorthand for constructing n-tuple types as nested pairs. +-- | `forall a b c d. a /\ b /\ c /\ d /\ Unit` becomes +-- | `forall a b c d. Tuple a (Tuple b (Tuple c (Tuple d Unit)))` +infixr 6 type Tuple as /\ + +type Tuple1 a = T2 a Unit +type Tuple2 a b = T3 a b Unit +type Tuple3 a b c = T4 a b c Unit +type Tuple4 a b c d = T5 a b c d Unit +type Tuple5 a b c d e= T6 a b c d e Unit +type Tuple6 a b c d e f = T7 a b c d e f Unit +type Tuple7 a b c d e f g = T8 a b c d e f g Unit +type Tuple8 a b c d e f g h = T9 a b c d e f g h Unit +type Tuple9 a b c d e f g h i = T10 a b c d e f g h i Unit +type Tuple10 a b c d e f g h i j = T11 a b c d e f g h i j Unit + +type T2 a z = Tuple a z +type T3 a b z = Tuple a (T2 b z) +type T4 a b c z = Tuple a (T3 b c z) +type T5 a b c d z = Tuple a (T4 b c d z) +type T6 a b c d e z = Tuple a (T5 b c d e z) +type T7 a b c d e f z = Tuple a (T6 b c d e f z) +type T8 a b c d e f g z = Tuple a (T7 b c d e f g z) +type T9 a b c d e f g h z = Tuple a (T8 b c d e f g h z) +type T10 a b c d e f g h i z = Tuple a (T9 b c d e f g h i z) +type T11 a b c d e f g h i j z = Tuple a (T10 b c d e f g h i j z) + +-- | Creates a singleton tuple. +tuple1 :: forall a. a -> Tuple1 a +tuple1 a = a /\ unit + +-- | Given 2 values, creates a 2-tuple. +tuple2 :: forall a b. a -> b -> Tuple2 a b +tuple2 a b = a /\ b /\ unit + +-- | Given 3 values, creates a nested 3-tuple. +tuple3 :: forall a b c. a -> b -> c -> Tuple3 a b c +tuple3 a b c = a /\ b /\ c /\ unit + +-- | Given 4 values, creates a nested 4-tuple. +tuple4 :: forall a b c d. a -> b -> c -> d -> Tuple4 a b c d +tuple4 a b c d = a /\ b /\ c /\ d /\ unit + +-- | Given 5 values, creates a nested 5-tuple. +tuple5 :: forall a b c d e. a -> b -> c -> d -> e -> Tuple5 a b c d e +tuple5 a b c d e = a /\ b /\ c /\ d /\ e /\ unit + +-- | Given 6 values, creates a nested 6-tuple. +tuple6 :: forall a b c d e f. a -> b -> c -> d -> e -> f -> Tuple6 a b c d e f +tuple6 a b c d e f = a /\ b /\ c /\ d /\ e /\ f /\ unit + +-- | Given 7 values, creates a nested 7-tuple. +tuple7 :: forall a b c d e f g. a -> b -> c -> d -> e -> f -> g -> Tuple7 a b c d e f g +tuple7 a b c d e f g = a /\ b /\ c /\ d /\ e /\ f /\ g /\ unit + +-- | Given 8 values, creates a nested 8-tuple. +tuple8 :: forall a b c d e f g h. a -> b -> c -> d -> e -> f -> g -> h -> Tuple8 a b c d e f g h +tuple8 a b c d e f g h = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ unit + +-- | Given 9 values, creates a nested 9-tuple. +tuple9 :: forall a b c d e f g h i. a -> b -> c -> d -> e -> f -> g -> h -> i -> Tuple9 a b c d e f g h i +tuple9 a b c d e f g h i = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ unit + +-- | Given 10 values, creates a nested 10-tuple. +tuple10 :: forall a b c d e f g h i j. a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Tuple10 a b c d e f g h i j +tuple10 a b c d e f g h i j = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ unit + +-- | Given at least a singleton tuple, gets the first value. +get1 :: forall a z. T2 a z -> a +get1 (a /\ _) = a + +-- | Given at least a 2-tuple, gets the second value. +get2 :: forall a b z. T3 a b z -> b +get2 (_ /\ b /\ _) = b + +-- | Given at least a 3-tuple, gets the third value. +get3 :: forall a b c z. T4 a b c z -> c +get3 (_ /\ _ /\ c /\ _) = c + +-- | Given at least a 4-tuple, gets the fourth value. +get4 :: forall a b c d z. T5 a b c d z -> d +get4 (_ /\ _ /\ _ /\ d /\ _) = d + +-- | Given at least a 5-tuple, gets the fifth value. +get5 :: forall a b c d e z. T6 a b c d e z -> e +get5 (_ /\ _ /\ _ /\ _ /\ e /\ _) = e + +-- | Given at least a 6-tuple, gets the sixth value. +get6 :: forall a b c d e f z. T7 a b c d e f z -> f +get6 (_ /\ _ /\ _ /\ _ /\ _ /\ f /\ _) = f + +-- | Given at least a 7-tuple, gets the seventh value. +get7 :: forall a b c d e f g z. T8 a b c d e f g z -> g +get7 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ g /\ _) = g + +-- | Given at least an 8-tuple, gets the eigth value. +get8 :: forall a b c d e f g h z. T9 a b c d e f g h z -> h +get8 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ h /\ _) = h + +-- | Given at least a 9-tuple, gets the ninth value. +get9 :: forall a b c d e f g h i z. T10 a b c d e f g h i z -> i +get9 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ i /\ _) = i + +-- | Given at least a 10-tuple, gets the tenth value. +get10 :: forall a b c d e f g h i j z. T11 a b c d e f g h i j z -> j +get10 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ j /\ _) = j + +-- | Given at least a singleton tuple, modifies the first value. +over1 :: forall a r z. (a -> r) -> T2 a z -> T2 r z +over1 o (a /\ z) = o a /\ z + +-- | Given at least a 2-tuple, modifies the second value. +over2 :: forall a b r z. (b -> r) -> T3 a b z -> T3 a r z +over2 o (a /\ b /\ z) = a /\ o b /\ z + +-- | Given at least a 3-tuple, modifies the third value. +over3 :: forall a b c r z. (c -> r) -> T4 a b c z -> T4 a b r z +over3 o (a /\ b /\ c /\ z) = a /\ b /\ o c /\ z + +-- | Given at least a 4-tuple, modifies the fourth value. +over4 :: forall a b c d r z. (d -> r) -> T5 a b c d z -> T5 a b c r z +over4 o (a /\ b /\ c /\ d /\ z) = a /\ b /\ c /\ o d /\ z + +-- | Given at least a 5-tuple, modifies the fifth value. +over5 :: forall a b c d e r z. (e -> r) -> T6 a b c d e z -> T6 a b c d r z +over5 o (a /\ b /\ c /\ d /\ e /\ z) = a /\ b /\ c /\ d /\ o e /\ z + +-- | Given at least a 6-tuple, modifies the sixth value. +over6 :: forall a b c d e f r z. (f -> r) -> T7 a b c d e f z -> T7 a b c d e r z +over6 o (a /\ b /\ c /\ d /\ e /\ f /\ z) = a /\ b /\ c /\ d /\ e /\ o f /\ z + +-- | Given at least a 7-tuple, modifies the seventh value. +over7 :: forall a b c d e f g r z. (g -> r) -> T8 a b c d e f g z -> T8 a b c d e f r z +over7 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ o g /\ z + +-- | Given at least an 8-tuple, modifies the eighth value. +over8 :: forall a b c d e f g h r z. (h -> r) -> T9 a b c d e f g h z -> T9 a b c d e f g r z +over8 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ g /\ o h /\ z + +-- | Given at least a 9-tuple, modifies the ninth value. +over9 :: forall a b c d e f g h i r z. (i -> r) -> T10 a b c d e f g h i z -> T10 a b c d e f g h r z +over9 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ o i /\ z + +-- | Given at least a 10-tuple, modifies the tenth value. +over10 :: forall a b c d e f g h i j r z. (j -> r) -> T11 a b c d e f g h i j z -> T11 a b c d e f g h i r z +over10 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ o j /\ z + +-- | Given a function of 1 argument, returns a function that accepts a singleton tuple. +uncurry1 :: forall a r z. (a -> r) -> T2 a z -> r +uncurry1 f (a /\ _) = f a + +-- | Given a function of 2 arguments, returns a function that accepts a 2-tuple. +uncurry2 :: forall a b r z. (a -> b -> r) -> T3 a b z -> r +uncurry2 f (a /\ b /\ _) = f a b + +-- | Given a function of 3 arguments, returns a function that accepts a 3-tuple. +uncurry3 :: forall a b c r z. (a -> b -> c -> r) -> T4 a b c z -> r +uncurry3 f (a /\ b /\ c /\ _) = f a b c + +-- | Given a function of 4 arguments, returns a function that accepts a 4-tuple. +uncurry4 :: forall a b c d r z. (a -> b -> c -> d -> r) -> T5 a b c d z -> r +uncurry4 f (a /\ b /\ c /\ d /\ _) = f a b c d + +-- | Given a function of 5 arguments, returns a function that accepts a 5-tuple. +uncurry5 :: forall a b c d e r z. (a -> b -> c -> d -> e -> r) -> T6 a b c d e z -> r +uncurry5 f (a /\ b /\ c /\ d /\ e /\ _) = f a b c d e + +-- | Given a function of 6 arguments, returns a function that accepts a 6-tuple. +uncurry6 :: forall a b c d e f r z. (a -> b -> c -> d -> e -> f -> r) -> T7 a b c d e f z -> r +uncurry6 f' (a /\ b /\ c /\ d /\ e /\ f /\ _) = f' a b c d e f + +-- | Given a function of 7 arguments, returns a function that accepts a 7-tuple. +uncurry7 :: forall a b c d e f g r z. (a -> b -> c -> d -> e -> f -> g -> r) -> T8 a b c d e f g z -> r +uncurry7 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ _) = f' a b c d e f g + +-- | Given a function of 8 arguments, returns a function that accepts an 8-tuple. +uncurry8 :: forall a b c d e f g h r z. (a -> b -> c -> d -> e -> f -> g -> h -> r) -> T9 a b c d e f g h z -> r +uncurry8 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ _) = f' a b c d e f g h + +-- | Given a function of 9 arguments, returns a function that accepts a 9-tuple. +uncurry9 :: forall a b c d e f g h i r z. (a -> b -> c -> d -> e -> f -> g -> h -> i -> r) -> T10 a b c d e f g h i z -> r +uncurry9 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ _) = f' a b c d e f g h i + +-- | Given a function of 10 arguments, returns a function that accepts a 10-tuple. +uncurry10 :: forall a b c d e f g h i j r z. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> r) -> T11 a b c d e f g h i j z -> r +uncurry10 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ _) = f' a b c d e f g h i j + +-- | Given a function that accepts at least a singleton tuple, returns a function of 1 argument. +curry1 :: forall a r z. z -> (T2 a z -> r) -> a -> r +curry1 z f a = f (a /\ z) + +-- | Given a function that accepts at least a 2-tuple, returns a function of 2 arguments. +curry2 :: forall a b r z. z -> (T3 a b z -> r) -> a -> b -> r +curry2 z f a b = f (a /\ b /\ z) + +-- | Given a function that accepts at least a 3-tuple, returns a function of 3 arguments. +curry3 :: forall a b c r z. z -> (T4 a b c z -> r) -> a -> b -> c -> r +curry3 z f a b c = f (a /\ b /\ c /\ z) + +-- | Given a function that accepts at least a 4-tuple, returns a function of 4 arguments. +curry4 :: forall a b c d r z. z -> (T5 a b c d z -> r) -> a -> b -> c -> d -> r +curry4 z f a b c d = f (a /\ b /\ c /\ d /\ z) + +-- | Given a function that accepts at least a 5-tuple, returns a function of 5 arguments. +curry5 :: forall a b c d e r z. z -> (T6 a b c d e z -> r) -> a -> b -> c -> d -> e -> r +curry5 z f a b c d e = f (a /\ b /\ c /\ d /\ e /\ z) + +-- | Given a function that accepts at least a 6-tuple, returns a function of 6 arguments. +curry6 :: forall a b c d e f r z. z -> (T7 a b c d e f z -> r) -> a -> b -> c -> d -> e -> f -> r +curry6 z f' a b c d e f = f' (a /\ b /\ c /\ d /\ e /\ f /\ z) + +-- | Given a function that accepts at least a 7-tuple, returns a function of 7 arguments. +curry7 :: forall a b c d e f g r z. z -> (T8 a b c d e f g z -> r) -> a -> b -> c -> d -> e -> f -> g -> r +curry7 z f' a b c d e f g = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ z) + +-- | Given a function that accepts at least an 8-tuple, returns a function of 8 arguments. +curry8 :: forall a b c d e f g h r z. z -> (T9 a b c d e f g h z -> r) -> a -> b -> c -> d -> e -> f -> g -> h -> r +curry8 z f' a b c d e f g h = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ z) + +-- | Given a function that accepts at least a 9-tuple, returns a function of 9 arguments. +curry9 :: forall a b c d e f g h i r z. z -> (T10 a b c d e f g h i z -> r) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> r +curry9 z f' a b c d e f g h i = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ z) + +-- | Given a function that accepts at least a 10-tuple, returns a function of 10 arguments. +curry10 :: forall a b c d e f g h i j r z. z -> (T11 a b c d e f g h i j z -> r) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> r +curry10 z f' a b c d e f g h i j = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ z) diff --git a/stdlib/lib/Data/Unfoldable.purs b/stdlib/lib/Data/Unfoldable.purs new file mode 100644 index 00000000..83e5d029 --- /dev/null +++ b/stdlib/lib/Data/Unfoldable.purs @@ -0,0 +1,96 @@ +-- | This module provides a type class for _unfoldable functors_, i.e. +-- | functors which support an `unfoldr` operation. +-- | +-- | This allows us to unify various operations on arrays, lists, +-- | sequences, etc. + +module Data.Unfoldable + ( class Unfoldable, unfoldr + , replicate + , replicateA + , none + , fromMaybe + , module Data.Unfoldable1 + ) where + +import Prelude + +import Data.Maybe (Maybe(..), isNothing, fromJust) +import Data.Traversable (class Traversable, sequence) +import Data.Tuple (Tuple(..), fst, snd) +import Data.Unfoldable1 (class Unfoldable1, unfoldr1, singleton, range, iterateN, replicate1, replicate1A) +import Partial.Unsafe (unsafePartial) + +-- | This class identifies (possibly empty) data structures which can be +-- | _unfolded_. +-- | +-- | The generating function `f` in `unfoldr f` is understood as follows: +-- | +-- | - If `f b` is `Nothing`, then `unfoldr f b` should be empty. +-- | - If `f b` is `Just (Tuple a b1)`, then `unfoldr f b` should consist of `a` +-- | appended to the result of `unfoldr f b1`. +-- | +-- | Note that it is not possible to give `Unfoldable` instances to types which +-- | represent structures which are guaranteed to be non-empty, such as +-- | `NonEmptyArray`: consider what `unfoldr (const Nothing)` should produce. +-- | Structures which are guaranteed to be non-empty can instead be given +-- | `Unfoldable1` instances. +class Unfoldable1 t <= Unfoldable t where + unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> t a + +instance unfoldableArray :: Unfoldable Array where + unfoldr = unfoldrArrayImpl isNothing (unsafePartial fromJust) fst snd + +instance unfoldableMaybe :: Unfoldable Maybe where + unfoldr f b = fst <$> f b + +unfoldrArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Maybe (Tuple a b)) -> b -> Array a +unfoldrArrayImpl a0 a1 a2 a3 a4 a5 = unfoldrArrayImpl a0 a1 a2 a3 a4 a5 + +-- | Replicate a value some natural number of times. +-- | For example: +-- | +-- | ``` purescript +-- | replicate 2 "foo" == (["foo", "foo"] :: Array String) +-- | ``` +replicate :: forall f a. Unfoldable f => Int -> a -> f a +replicate n v = unfoldr step n + where + step :: Int -> Maybe (Tuple a Int) + step i = + if i <= 0 then Nothing + else Just (Tuple v (i - 1)) + +-- | Perform an Applicative action `n` times, and accumulate all the results. +-- | +-- | ``` purescript +-- | > replicateA 5 (randomInt 1 10) :: Effect (Array Int) +-- | [1,3,2,7,5] +-- | ``` +replicateA + :: forall m f a + . Applicative m + => Unfoldable f + => Traversable f + => Int + -> m a + -> m (f a) +replicateA n m = sequence (replicate n m) + +-- | The container with no elements - unfolded with zero iterations. +-- | For example: +-- | +-- | ``` purescript +-- | none == ([] :: Array Unit) +-- | ``` +none :: forall f a. Unfoldable f => f a +none = unfoldr (const Nothing) unit + +-- | Convert a Maybe to any Unfoldable, such as lists or arrays. +-- | +-- | ``` purescript +-- | fromMaybe (Nothing :: Maybe Int) == [] +-- | fromMaybe (Just 1) == [1] +-- | ``` +fromMaybe :: forall f a. Unfoldable f => Maybe a -> f a +fromMaybe = unfoldr (\b -> flip Tuple Nothing <$> b) diff --git a/stdlib/lib/Data/Unfoldable1.purs b/stdlib/lib/Data/Unfoldable1.purs new file mode 100644 index 00000000..add27ca5 --- /dev/null +++ b/stdlib/lib/Data/Unfoldable1.purs @@ -0,0 +1,124 @@ +module Data.Unfoldable1 + ( class Unfoldable1, unfoldr1 + , replicate1 + , replicate1A + , singleton + , range + , iterateN + ) where + +import Prelude + +import Data.Maybe (Maybe(..), fromJust, isNothing) +import Data.Semigroup.Traversable (class Traversable1, sequence1) +import Data.Tuple (Tuple(..), fst, snd) +import Partial.Unsafe (unsafePartial) + +-- | This class identifies data structures which can be _unfolded_. +-- | +-- | The generating function `f` in `unfoldr1 f` corresponds to the `uncons` +-- | operation of a non-empty list or array; it always returns a value, and +-- | then optionally a value to continue unfolding from. +-- | +-- | Note that, in order to provide an `Unfoldable1 t` instance, `t` need not +-- | be a type which is guaranteed to be non-empty. For example, the fact that +-- | lists can be empty does not prevent us from providing an +-- | `Unfoldable1 List` instance. However, the result of `unfoldr1` should +-- | always be non-empty. +-- | +-- | Every type which has an `Unfoldable` instance can be given an +-- | `Unfoldable1` instance (and, in fact, is required to, because +-- | `Unfoldable1` is a superclass of `Unfoldable`). However, there are types +-- | which have `Unfoldable1` instances but cannot have `Unfoldable` instances. +-- | In particular, types which are guaranteed to be non-empty, such as +-- | `NonEmptyList`, cannot be given `Unfoldable` instances. +-- | +-- | The utility of this class, then, is that it provides an `Unfoldable`-like +-- | interface while still permitting instances for guaranteed-non-empty types +-- | like `NonEmptyList`. +class Unfoldable1 t where + unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a + +instance unfoldable1Array :: Unfoldable1 Array where + unfoldr1 = unfoldr1ArrayImpl isNothing (unsafePartial fromJust) fst snd + +instance unfoldable1Maybe :: Unfoldable1 Maybe where + unfoldr1 f b = Just (fst (f b)) + +unfoldr1ArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Tuple a (Maybe b)) -> b -> Array a +unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 = unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 + +-- | Replicate a value `n` times. At least one value will be produced, so values +-- | `n` less than 1 will be treated as 1. +-- | +-- | ``` purescript +-- | replicate1 2 "foo" == (NEL.cons "foo" (NEL.singleton "foo") :: NEL.NonEmptyList String) +-- | replicate1 0 "foo" == (NEL.singleton "foo" :: NEL.NonEmptyList String) +-- | ``` +replicate1 :: forall f a. Unfoldable1 f => Int -> a -> f a +replicate1 n v = unfoldr1 step (n - 1) + where + step :: Int -> Tuple a (Maybe Int) + step i + | i <= 0 = Tuple v Nothing + | otherwise = Tuple v (Just (i - 1)) + +-- | Perform an `Apply` action `n` times (at least once, so values `n` less +-- | than 1 will be treated as 1), and accumulate the results. +-- | +-- | ``` purescript +-- | > replicate1A 2 (randomInt 1 10) :: Effect (NEL.NonEmptyList Int) +-- | (NonEmptyList (NonEmpty 8 (2 : Nil))) +-- | > replicate1A 0 (randomInt 1 10) :: Effect (NEL.NonEmptyList Int) +-- | (NonEmptyList (NonEmpty 4 Nil)) +-- | ``` +replicate1A + :: forall m f a + . Apply m + => Unfoldable1 f + => Traversable1 f + => Int + -> m a + -> m (f a) +replicate1A n m = sequence1 (replicate1 n m) + +-- | Contain a single value. For example: +-- | +-- | ``` purescript +-- | singleton "foo" == (NEL.singleton "foo" :: NEL.NonEmptyList String) +-- | ``` +singleton :: forall f a. Unfoldable1 f => a -> f a +singleton = replicate1 1 + +-- | Create an `Unfoldable1` containing a range of values, including both +-- | endpoints. +-- | +-- | ``` purescript +-- | range 0 0 == (NEL.singleton 0 :: NEL.NonEmptyList Int) +-- | range 1 2 == (NEL.cons 1 (NEL.singleton 2) :: NEL.NonEmptyList Int) +-- | range 2 0 == (NEL.cons 2 (NEL.cons 1 (NEL.singleton 0)) :: NEL.NonEmptyList Int) +-- | ``` +range :: forall f. Unfoldable1 f => Int -> Int -> f Int +range start end = + let delta = if end >= start then 1 else -1 in unfoldr1 (go delta) start + where + go delta i = + let i' = i + delta + in Tuple i (if i == end then Nothing else Just i') + +-- | Create an `Unfoldable1` by repeated application of a function to a seed value. +-- | For example: +-- | +-- | ``` purescript +-- | (iterateN 5 (_ + 1) 0 :: Array Int) == [0, 1, 2, 3, 4] +-- | (iterateN 5 (_ + 1) 0 :: NonEmptyArray Int) == NonEmptyArray [0, 1, 2, 3, 4] +-- | +-- | (iterateN 0 (_ + 1) 0 :: Array Int) == [0] +-- | (iterateN 0 (_ + 1) 0 :: NonEmptyArray Int) == NonEmptyArray [0] +-- | ``` +iterateN :: forall f a. Unfoldable1 f => Int -> (a -> a) -> a -> f a +iterateN n f s = unfoldr1 go $ Tuple s (n - 1) + where + go (Tuple x n') = Tuple x + if n' > 0 then Just $ Tuple (f x) $ n' - 1 + else Nothing diff --git a/stdlib/lib/Data/Unit.purs b/stdlib/lib/Data/Unit.purs new file mode 100644 index 00000000..2e5e2721 --- /dev/null +++ b/stdlib/lib/Data/Unit.purs @@ -0,0 +1,5 @@ +-- | `Unit` is a compiler builtin, the same type as an unqualified +-- | `Unit`. This module re-exports that builtin and the `unit` +-- | primitive so `import Data.Unit` matches the official library +-- | without declaring a second unit type. +module Data.Unit (Unit, unit) where diff --git a/stdlib/lib/Data/Void.purs b/stdlib/lib/Data/Void.purs new file mode 100644 index 00000000..dd6f3088 --- /dev/null +++ b/stdlib/lib/Data/Void.purs @@ -0,0 +1,34 @@ +module Data.Void (Void, absurd) where + +-- | An uninhabited data type. In other words, one can never create +-- | a runtime value of type `Void` because no such value exists. +-- | +-- | `Void` is useful to eliminate the possibility of a value being created. +-- | For example, a value of type `Either Void Boolean` can never have +-- | a Left value created in PureScript. +-- | +-- | This should not be confused with the keyword `void` that commonly appears in +-- | C-family languages, such as Java: +-- | ``` +-- | public class Foo { +-- | void doSomething() { System.out.println("hello world!"); } +-- | } +-- | ``` +-- | +-- | In PureScript, one often uses `Unit` to achieve similar effects as +-- | the `void` of C-family languages above. +newtype Void = Void Void + +-- | Eliminator for the `Void` type. +-- | Useful for stating that some code branch is impossible because you've +-- | "acquired" a value of type `Void` (which you can't). +-- | +-- | ```purescript +-- | rightOnly :: forall t . Either Void t -> t +-- | rightOnly (Left v) = absurd v +-- | rightOnly (Right t) = t +-- | ``` +absurd :: forall a. Void -> a +absurd a = spin a + where + spin (Void b) = spin b diff --git a/stdlib/lib/Data/Witherable.purs b/stdlib/lib/Data/Witherable.purs new file mode 100644 index 00000000..1dfa232f --- /dev/null +++ b/stdlib/lib/Data/Witherable.purs @@ -0,0 +1,162 @@ +module Data.Witherable + ( class Witherable + , wilt + , wither + , partitionMapByWilt + , filterMapByWither + , traverseByWither + , wilted + , withered + , witherDefault + , wiltDefault + , module Data.Filterable + ) where + +import Control.Applicative (class Applicative, (<*>), pure) +import Control.Category ((<<<), identity) +import Data.Compactable (compact, separate) +import Data.Either (Either(..)) +import Data.Filterable (class Filterable) +import Data.Functor (map, (<$>)) +import Data.Identity (Identity(..)) +import Data.List (List(..), (:)) +import Data.List as List +import Data.Map as Map +import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid, mempty) +import Data.Newtype (unwrap) +import Data.Traversable (class Traversable, traverse) +import Data.Tuple (Tuple(..)) +import Prelude (class Ord) + +-- | `Witherable` represents data structures which can be _partitioned_ with +-- | effects in some `Applicative` functor. +-- | +-- | - `wilt` - partition a structure with effects +-- | - `wither` - filter a structure with effects +-- | +-- | Laws: +-- | +-- | - Naturality: `t <<< wither f ≡ wither (t <<< f)` +-- | - Identity: `wither (pure <<< Just) ≡ pure` +-- | - Composition: `Compose <<< map (wither f) <<< wither g ≡ wither (Compose <<< map (wither f) <<< g)` +-- | - Multipass partition: `wilt p ≡ map separate <<< traverse p` +-- | - Multipass filter: `wither p ≡ map compact <<< traverse p` +-- | +-- | Superclass equivalences: +-- | +-- | - `partitionMap p = runIdentity <<< wilt (Identity <<< p)` +-- | - `filterMap p = runIdentity <<< wither (Identity <<< p)` +-- | - `traverse f ≡ wither (map Just <<< f)` +-- | +-- | Default implementations are provided by the following functions: +-- | +-- | - `wiltDefault` +-- | - `witherDefault` +-- | - `partitionMapByWilt` +-- | - `filterMapByWither` +-- | - `traverseByWither` +class (Filterable t, Traversable t) <= Witherable t where + wilt :: forall m a l r. Applicative m => + (a -> m (Either l r)) -> t a -> m { left :: t l, right :: t r } + + wither :: forall m a b. Applicative m => + (a -> m (Maybe b)) -> t a -> m (t b) + +-- | A default implementation of `wilt` using `separate` +wiltDefault :: forall t m a l r. Witherable t => Applicative m => + (a -> m (Either l r)) -> t a -> m { left :: t l, right :: t r } +wiltDefault p = map separate <<< traverse p + +-- | A default implementation of `wither` using `compact`. +witherDefault :: forall t m a b. Witherable t => Applicative m => + (a -> m (Maybe b)) -> t a -> m (t b) +witherDefault p = map compact <<< traverse p + +-- | A default implementation of `partitionMap` given a `Witherable`. +partitionMapByWilt :: forall t a l r. Witherable t => + (a -> Either l r) -> t a -> { left :: t l, right :: t r } +partitionMapByWilt p = unwrap <<< wilt (Identity <<< p) + +-- | A default implementation of `filterMap` given a `Witherable`. +filterMapByWither :: forall t a b. Witherable t => + (a -> Maybe b) -> t a -> t b +filterMapByWither p = unwrap <<< wither (Identity <<< p) + +-- | A default implementation of `traverse` given a `Witherable`. +traverseByWither :: forall t m a b. Witherable t => Applicative m => + (a -> m b) -> t a -> m (t b) +traverseByWither f = wither (map Just <<< f) + +-- | Partition between `Left` and `Right` values - with effects in `m`. +wilted :: forall t m l r. Witherable t => Applicative m => + t (m (Either l r)) -> m { left :: t l, right :: t r } +wilted = wilt identity + +-- | Filter out all the `Nothing` values - with effects in `m`. +withered :: forall t m x. Witherable t => Applicative m => + t (m (Maybe x)) -> m (t x) +withered = wither identity + +instance witherableArray :: Witherable Array where + wilt = wiltDefault + wither = witherDefault + +instance witherableList :: Witherable List where + wilt p = map rev <<< List.foldl go (pure { left: Nil, right: Nil }) where + rev { left, right } = { left: List.reverse left, right: List.reverse right } + go acc x = (\{left, right} -> + case _ of + Left l -> { left: l : left, right } + Right r -> { left, right: r : right } + ) <$> acc <*> p x + + wither p = map List.reverse <<< List.foldl go (pure Nil) where + go acc x = (\comp -> + case _ of + Nothing -> comp + Just j -> j : comp + ) <$> acc <*> p x + +instance witherableMap :: Ord k => Witherable (Map.Map k) where + wilt p = List.foldl go (pure { left: Map.empty, right: Map.empty }) <<< toList + where + toList :: forall v. Ord k => Map.Map k v -> List.List (Tuple k v) + toList = Map.toUnfoldable + + go acc (Tuple k x) = (\{left, right} -> + case _ of + Left l -> { left: Map.insert k l left, right } + Right r -> { left, right: Map.insert k r right } + ) <$> acc <*> p x + + wither p = List.foldl go (pure Map.empty) <<< toList + where + toList :: forall v. Ord k => Map.Map k v -> List.List (Tuple k v) + toList = Map.toUnfoldable + + go acc (Tuple k x) = (\comp -> + case _ of + Nothing -> comp + Just j -> Map.insert k j comp + ) <$> acc <*> p x + +instance witherableMaybe :: Witherable Maybe where + wilt _ Nothing = pure { left: Nothing, right: Nothing } + wilt p (Just x) = map convert (p x) where + convert (Left l) = { left: Just l, right: Nothing } + convert (Right r) = { left: Nothing, right: Just r } + + wither _ Nothing = pure Nothing + wither p (Just x) = p x + +instance witherableEither :: Monoid m => Witherable (Either m) where + wilt _ (Left el) = pure { left: Left el, right: Left el } + wilt p (Right er) = map convert (p er) where + convert (Left l) = { left: Right l, right: Left mempty } + convert (Right r) = { left: Left mempty, right: Right r } + + wither _ (Left el) = pure (Left el) + wither p (Right er) = map convert (p er) where + convert Nothing = Left mempty + convert (Just r) = Right r diff --git a/stdlib/lib/Effect.purs b/stdlib/lib/Effect.purs index d8934f39..df3a50e9 100644 --- a/stdlib/lib/Effect.purs +++ b/stdlib/lib/Effect.purs @@ -18,6 +18,12 @@ module Effect , discard , map , apply + , untilE ) where -import Prelude (Effect, apply, bind, discard, map, pure) \ No newline at end of file +import Prelude (Effect, apply, bind, discard, map, pure) + +-- | Repeats an effect until it returns `true`. +untilE :: Effect Boolean -> Effect Unit +untilE action = bind action \done -> + if done then pure unit else untilE action diff --git a/stdlib/lib/Effect/Ref.purs b/stdlib/lib/Effect/Ref.purs new file mode 100644 index 00000000..52e46bc1 --- /dev/null +++ b/stdlib/lib/Effect/Ref.purs @@ -0,0 +1,78 @@ +-- | This module defines the `Ref` type for mutable value references, as well +-- | as actions for working with them. +-- | +-- | You'll notice that all of the functions that operate on a `Ref` (e.g. +-- | `new`, `read`, `write`) return their result wrapped in an `Effect`. +-- | Working with mutable references is considered effectful in PureScript +-- | because of the principle of purity: functions should not have side +-- | effects, and should return the same result when called with the same +-- | arguments. If a `Ref` could be written to without using `Effect`, that +-- | would cause a side effect (the effect of changing the result of subsequent +-- | reads for that `Ref`). If there were a function for reading the current +-- | value of a `Ref` without the result being wrapped in `Effect`, the result +-- | of calling that function would change each time a new value was written to +-- | the `Ref`. Even creating a new `Ref` is effectful: if there were a +-- | function for creating a new `Ref` with the type `forall s. s -> Ref s`, +-- | then calling that function twice with the same argument would not give the +-- | same result in each case, since you'd end up with two distinct references +-- | which could be updated independently of each other. +-- | +-- | _Note_: `Control.Monad.ST` provides a pure alternative to `Ref` when +-- | mutation is restricted to a local scope. +module Effect.Ref + ( Ref + , new + , newWithSelf + , read + , modify' + , modify + , modify_ + , write + ) where + +import Prelude + +import Effect (Effect) + +-- | A value of type `Ref a` represents a mutable reference +-- | which holds a value of type `a`. +foreign import data Ref :: Type -> Type + +type role Ref representational + +-- | Create a new mutable reference containing the specified value. +_new :: forall s. s -> Effect (Ref s) +_new a0 = _new a0 + +new :: forall s. s -> Effect (Ref s) +new = _new + +-- | Create a new mutable reference containing a value that can refer to the +-- | `Ref` being created. +newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s) +newWithSelf a0 = newWithSelf a0 + +-- | Read the current value of a mutable reference. +read :: forall s. Ref s -> Effect s +read a0 = read a0 + +-- | Update the value of a mutable reference by applying a function +-- | to the current value. +modify' :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b +modify' = modifyImpl + +modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b +modifyImpl a0 a1 = modifyImpl a0 a1 + +-- | Update the value of a mutable reference by applying a function +-- | to the current value. The updated value is returned. +modify :: forall s. (s -> s) -> Ref s -> Effect s +modify f = modify' \s -> let s' = f s in { state: s', value: s' } + +-- | A version of `modify` which does not return the updated value. +modify_ :: forall s. (s -> s) -> Ref s -> Effect Unit +modify_ f s = void $ modify f s + +-- | Update the value of a mutable reference to the specified value. +write :: forall s. s -> Ref s -> Effect Unit +write a0 a1 = write a0 a1 diff --git a/stdlib/lib/Partial.purs b/stdlib/lib/Partial.purs new file mode 100644 index 00000000..cfb5cc09 --- /dev/null +++ b/stdlib/lib/Partial.purs @@ -0,0 +1,16 @@ +-- | Some partial helper functions. See the README for more documentation. +module Partial + ( crash + , crashWith + ) where + +-- | A partial function which crashes on any input with a default message. +crash :: forall a. Partial => a +crash = crashWith "Partial.crash: partial function" + +-- | A partial function which crashes on any input with the specified message. +crashWith :: forall a. Partial => String -> a +crashWith = _crashWith + +_crashWith :: forall a. String -> a +_crashWith a0 = _crashWith a0 diff --git a/stdlib/lib/Partial/Unsafe.purs b/stdlib/lib/Partial/Unsafe.purs new file mode 100644 index 00000000..0071c039 --- /dev/null +++ b/stdlib/lib/Partial/Unsafe.purs @@ -0,0 +1,25 @@ +-- | Utilities for working with partial functions. +-- | See the README for more documentation. +module Partial.Unsafe + ( unsafePartial + , unsafeCrashWith + ) where + +import Partial (crashWith) + +-- Note: this function's type signature is more like +-- `(Unit -> a) -> a`. However, we would need to use +-- `unsafeCoerce` to make this compile, incurring +-- either a dependency or reimplementing it here. +-- Rather than doing that, we'll use a type signature +-- of `a -> b` instead. +_unsafePartial :: forall a b. a -> b +_unsafePartial a0 = _unsafePartial a0 + +-- | Discharge a partiality constraint, unsafely. +unsafePartial :: forall a. (Partial => a) -> a +unsafePartial = _unsafePartial + +-- | A function which crashes with the specified error message. +unsafeCrashWith :: forall a. String -> a +unsafeCrashWith msg = unsafePartial (crashWith msg) diff --git a/stdlib/lib/Prelude.purs b/stdlib/lib/Prelude.purs index 27aa8668..4da4db96 100644 --- a/stdlib/lib/Prelude.purs +++ b/stdlib/lib/Prelude.purs @@ -1,90 +1,85 @@ -- | The primitive surface the rest of the library and the corpus build on. -- | --- | `Effect` is an abstract type here: the compiler owns its representation --- | rather than this file, and `psrs_core::effect::lower_effects` rewrites each --- | `Effect a` application into a closure over the runtime token after Typed --- | Core. The operations below are the externals that lowering supplies bodies --- | for, so they stay in this module by name — `check_run_effect_scope` --- | resolves the trusted `Prelude.runEffect` value, and --- | `psrs_core::effect::operations` dispatches on the `psrs:effect` bindings --- | declared here. +-- | The class hierarchy is the official `purescript-prelude` v6.0.1 re-export +-- | list. `Effect` stays in this module: `check_run_effect_scope` resolves +-- | `Prelude.runEffect`, and `psrs_core::effect::operations` synthesizes +-- | `effectPure`, `effectBind`, `runEffect`, and `trap` from the `psrs:effect` +-- | bindings declared here. The class methods `pure` and `bind` are the +-- | official `Applicative` and `Bind` methods; the `Effect` instances call +-- | those bindings, so creating an action still does not run it. -- | --- | `unit` is not declared here either. `Unit` is a builtin type with no --- | constructor table, so the one `Unit` value is a compiler primitive --- | (`psrs_hir::Intrinsic::Unit`) rather than a library declaration, exactly as --- | `true` and `false` are. --- | --- | The re-export list is explicit because the module now re-exports the --- | `Data.Function` operators, and this resolver's `module Data.Function` --- | re-export form is not selective: it would pull in `Data.Function.apply` --- | beside the Effect `apply` this module declares. The named entries re-export --- | exactly the four names the official `Prelude` takes from `Data.Function`. +-- | `unit` is not declared here. `Unit` is a builtin, re-exported through +-- | `Data.Unit`, and the one `Unit` value is `Intrinsic::Unit`. module Prelude ( Effect - , pure - , bind - , discard - , class Functor - , map - , (<$>) - , apply , runEffect , trap - , class Semigroup - , append - , (<>) - , class Eq - , eq - , notEq - , (==) - , (/=) - , class Ord - , lessThan - , lessThanOrEq - , greaterThan - , greaterThanOrEq - , (<) - , (<=) - , (>) - , (>=) - , class Semiring - , add - , mul - , (+) - , (*) - , class Show - , show - , const - , flip - , ($) - , (#) + , module Control.Applicative + , module Control.Apply + , module Control.Bind + , module Control.Category + , module Control.Monad + , module Control.Semigroupoid + , module Data.Boolean + , module Data.BooleanAlgebra + , module Data.Bounded + , module Data.CommutativeRing + , module Data.DivisionRing + , module Data.Eq + , module Data.EuclideanRing + , module Data.Field + , module Data.Function + , module Data.Functor + , module Data.HeytingAlgebra + , module Data.Monoid + , module Data.NaturalTransformation + , module Data.Ord + , module Data.Ordering + , module Data.Ring + , module Data.Semigroup + , module Data.Semiring + , module Data.Show + , module Data.Unit + , module Data.Void ) where -import Data.Function (const, flip, (#), ($)) -import Data.Functor (class Functor, map, (<$>)) +import Control.Applicative (class Applicative, pure, liftA1, unless, when) +import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) +import Control.Bind (class Bind, bind, class Discard, discard, ifM, join, (<=<), (=<<), (>=>), (>>=)) +import Control.Category (class Category, identity) +import Control.Monad (class Monad, liftM1, unlessM, whenM, ap) +import Control.Semigroupoid (class Semigroupoid, compose, (<<<), (>>>)) + +import Data.Boolean (otherwise) +import Data.BooleanAlgebra (class BooleanAlgebra) +import Data.Bounded (class Bounded, bottom, top) +import Data.CommutativeRing (class CommutativeRing) +import Data.DivisionRing (class DivisionRing, recip) +import Data.Eq (class Eq, eq, notEq, (/=), (==)) +import Data.EuclideanRing (class EuclideanRing, degree, div, mod, (/), gcd, lcm) +import Data.Field (class Field) +import Data.Function (const, flip, ($), (#)) +import Data.Functor (class Functor, flap, map, void, ($>), (<#>), (<$), (<$>), (<@>)) +import Data.HeytingAlgebra (class HeytingAlgebra, conj, disj, not, (&&), (||)) +import Data.Monoid (class Monoid, mempty) +import Data.NaturalTransformation (type (~>)) +import Data.Ord (class Ord, compare, (<), (<=), (>), (>=), comparing, min, max, clamp, between) +import Data.Ordering (Ordering(..)) +import Data.Ring (class Ring, negate, sub, (-)) import Data.Semigroup (class Semigroup, append, (<>)) -import Data.Eq (class Eq, eq, notEq, (==), (/=)) -import Data.Ord (class Ord, lessThan, lessThanOrEq, greaterThan, greaterThanOrEq, (<), (<=), (>), (>=)) -import Data.Semiring (class Semiring, add, mul, (+), (*)) +import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) import Data.Show (class Show, show) +import Data.Unit (Unit, unit) +import Data.Void (Void, absurd) foreign import data Effect :: Type -> Type -foreign import "psrs:effect#pure" pure :: forall a. a -> Effect a - -foreign import "psrs:effect#bind" bind :: forall a b. Effect a -> (a -> Effect b) -> Effect b - -discard :: forall a b. Effect a -> (a -> Effect b) -> Effect b -discard first next = bind first next - --- | `map` on `Effect` is this instance, not a separate function. The body is --- | the previous `Effect`-only `map`: it builds a new action and does not run --- | `action` until that action is run. -instance functorEffect :: Functor Effect where - map f action = bind action (\value -> pure (f value)) +-- | Builds an `Effect` that returns `value`. Lowering replaces this binding; +-- | the `Applicative` instance is what user code calls `pure`. +foreign import "psrs:effect#pure" effectPure :: forall a. a -> Effect a -apply :: forall a b. Effect (a -> b) -> Effect a -> Effect b -apply f x = bind f (\g -> bind x (\v -> pure (g v))) +-- | Sequences two effects. The `Bind` instance is what user code calls `bind`. +foreign import "psrs:effect#bind" effectBind :: forall a b. Effect a -> (a -> Effect b) -> Effect b foreign import "psrs:effect#run" runEffect :: forall a. Effect a -> a @@ -92,3 +87,18 @@ foreign import "psrs:effect#run" runEffect :: forall a. Effect a -> a -- | target is a guest trap, so this is the one operation whose result never -- | exists; it is how a library reports an assertion that did not hold. foreign import "psrs:effect#trap" trap :: Effect Unit + +instance functorEffect :: Functor Effect where + map f action = bind action (\value -> pure (f value)) + +instance applyEffect :: Apply Effect where + apply wrapped action = + bind wrapped (\function -> bind action (\value -> pure (function value))) + +instance applicativeEffect :: Applicative Effect where + pure value = effectPure value + +instance bindEffect :: Bind Effect where + bind action next = effectBind action next + +instance monadEffect :: Monad Effect diff --git a/stdlib/lib/Record/Unsafe.purs b/stdlib/lib/Record/Unsafe.purs new file mode 100644 index 00000000..7496e0f7 --- /dev/null +++ b/stdlib/lib/Record/Unsafe.purs @@ -0,0 +1,31 @@ +-- | The functions in this module are highly unsafe as they treat records like +-- | stringly-keyed maps and can coerce the row of labels that a record has. +-- | +-- | These function are intended for situations where there is some other way of +-- | proving things about the structure of the record - for example, when using +-- | `RowToList`. **They should never be used for general record manipulation.** +module Record.Unsafe where + +-- | Checks if a record has a key, using a string for the key. +unsafeHas :: forall r1. String -> Record r1 -> Boolean +unsafeHas a0 a1 = unsafeHas a0 a1 + +-- | Unsafely gets a value from a record, using a string for the key. +-- | +-- | If the key does not exist this will cause a runtime error elsewhere. +unsafeGet :: forall r a. String -> Record r -> a +unsafeGet a0 a1 = unsafeGet a0 a1 + +-- | Unsafely sets a value on a record, using a string for the key. +-- | +-- | The output record's row is unspecified so can be coerced to any row. If the +-- | output type is incorrect it will cause a runtime error elsewhere. +unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2 +unsafeSet a0 a1 a2 = unsafeSet a0 a1 a2 + +-- | Unsafely removes a value on a record, using a string for the key. +-- | +-- | The output record's row is unspecified so can be coerced to any row. If the +-- | output type is incorrect it will cause a runtime error elsewhere. +unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2 +unsafeDelete a0 a1 = unsafeDelete a0 a1 diff --git a/stdlib/lib/Safe/Coerce.purs b/stdlib/lib/Safe/Coerce.purs new file mode 100644 index 00000000..2f4babe6 --- /dev/null +++ b/stdlib/lib/Safe/Coerce.purs @@ -0,0 +1,27 @@ +module Safe.Coerce + ( module Prim.Coerce + , coerce + ) where + +import Prim.Coerce (class Coercible) +import Unsafe.Coerce (unsafeCoerce) + +-- | Coerce a value of one type to a value of some other type, without changing +-- | its runtime representation. This function behaves identically to +-- | `unsafeCoerce` at runtime. Unlike `unsafeCoerce`, it is safe, because the +-- | `Coercible` constraint prevents any use of this function from compiling +-- | unless the compiler can prove that the two types have the same runtime +-- | representation. +-- | +-- | One application for this function is to avoid doing work that you know is a +-- | no-op because of newtypes. For example, if you have an `Array (Conj a)` and you +-- | want an `Array (Disj a)`, you could do `Data.Array.map (un Conj >>> Disj)`, but +-- | this performs an unnecessary traversal of the array, with O(n) cost. +-- | `coerce` accomplishes the same with only O(1) cost: +-- | +-- | ```purescript +-- | mapConjToDisj :: forall a. Array (Conj a) -> Array (Disj a) +-- | mapConjToDisj = coerce +-- | ``` +coerce :: forall a b. Coercible a b => a -> b +coerce = unsafeCoerce diff --git a/stdlib/lib/Type/Data/Boolean.purs b/stdlib/lib/Type/Data/Boolean.purs new file mode 100644 index 00000000..b56d8a26 --- /dev/null +++ b/stdlib/lib/Type/Data/Boolean.purs @@ -0,0 +1,66 @@ +module Type.Data.Boolean + ( module Prim.Boolean + , class IsBoolean + , reflectBoolean + , reifyBoolean + , class And + , and + , class Or + , or + , class Not + , not + , class If + , if_ + ) where + +import Prim.Boolean (True, False) +import Type.Proxy (Proxy(..)) + +-- | Class for reflecting a type level `Boolean` at the value level +class IsBoolean :: Boolean -> Constraint +class IsBoolean bool where + reflectBoolean :: Proxy bool -> Boolean + +instance isBooleanTrue :: IsBoolean True where reflectBoolean _ = true +instance isBooleanFalse :: IsBoolean False where reflectBoolean _ = false + +-- | Use a value level `Boolean` as a type-level `Boolean` +reifyBoolean :: forall r. Boolean -> (forall o. IsBoolean o => Proxy o -> r) -> r +reifyBoolean true f = f (Proxy :: Proxy True) +reifyBoolean false f = f (Proxy :: Proxy False) + +-- | And two `Boolean` types together +class And :: Boolean -> Boolean -> Boolean -> Constraint +class And lhs rhs out | lhs rhs -> out +instance andTrue :: And True rhs rhs +instance andFalse :: And False rhs False + +and :: forall l r o. And l r o => Proxy l -> Proxy r -> Proxy o +and _ _ = Proxy + +-- | Or two `Boolean` types together +class Or :: Boolean -> Boolean -> Boolean -> Constraint +class Or lhs rhs output | lhs rhs -> output +instance orTrue :: Or True rhs True +instance orFalse :: Or False rhs rhs + +or :: forall l r o. Or l r o => Proxy l -> Proxy r -> Proxy o +or _ _ = Proxy + +-- | Not a `Boolean` +class Not :: Boolean -> Boolean -> Constraint +class Not bool output | bool -> output +instance notTrue :: Not True False +instance notFalse :: Not False True + +not :: forall i o. Not i o => Proxy i -> Proxy o +not _ = Proxy + +-- | If - dispatch based on a boolean +class If :: forall k. Boolean -> k -> k -> k -> Constraint +class If bool onTrue onFalse output | bool onTrue onFalse -> output +instance ifTrue :: If True onTrue onFalse onTrue +instance ifFalse :: If False onTrue onFalse onFalse + +if_ :: forall b t e o. If b t e o => Proxy b -> Proxy t -> Proxy e -> Proxy o +if_ _ _ _ = Proxy diff --git a/stdlib/lib/Type/Data/Ordering.purs b/stdlib/lib/Type/Data/Ordering.purs new file mode 100644 index 00000000..5dd15cb2 --- /dev/null +++ b/stdlib/lib/Type/Data/Ordering.purs @@ -0,0 +1,69 @@ +module Type.Data.Ordering + ( module PO + , class IsOrdering + , reflectOrdering + , reifyOrdering + , class Append + , append + , class Invert + , invert + , class Equals + , equals + ) where + +import Prim.Ordering (LT, EQ, GT, Ordering) as PO +import Data.Ordering (Ordering(..)) +import Type.Data.Boolean (True, False) +import Type.Proxy (Proxy(..)) + +-- | Class for reflecting a type level `Ordering` at the value level +class IsOrdering :: PO.Ordering -> Constraint +class IsOrdering ordering where + reflectOrdering :: Proxy ordering -> Ordering + +instance isOrderingLT :: IsOrdering PO.LT where reflectOrdering _ = LT +instance isOrderingEQ :: IsOrdering PO.EQ where reflectOrdering _ = EQ +instance isOrderingGT :: IsOrdering PO.GT where reflectOrdering _ = GT + +-- | Use a value level `Ordering` as a type-level `Ordering` +reifyOrdering :: forall r. Ordering -> (forall o. IsOrdering o => Proxy o -> r) -> r +reifyOrdering LT f = f (Proxy :: Proxy PO.LT) +reifyOrdering EQ f = f (Proxy :: Proxy PO.EQ) +reifyOrdering GT f = f (Proxy :: Proxy PO.GT) + +-- | Append two `Ordering` types together +-- | Reflective of the semigroup for value level `Ordering` +class Append :: PO.Ordering -> PO.Ordering -> PO.Ordering -> Constraint +class Append lhs rhs output | lhs -> rhs output +instance appendOrderingLT :: Append PO.LT rhs PO.LT +instance appendOrderingEQ :: Append PO.EQ rhs rhs +instance appendOrderingGT :: Append PO.GT rhs PO.GT + +append :: forall l r o. Append l r o => Proxy l -> Proxy r -> Proxy o +append _ _ = Proxy + +-- | Invert an `Ordering` +class Invert :: PO.Ordering -> PO.Ordering -> Constraint +class Invert ordering result | ordering -> result +instance invertOrderingLT :: Invert PO.LT PO.GT +instance invertOrderingEQ :: Invert PO.EQ PO.EQ +instance invertOrderingGT :: Invert PO.GT PO.LT + +invert :: forall i o. Invert i o => Proxy i -> Proxy o +invert _ = Proxy + +class Equals :: PO.Ordering -> PO.Ordering -> Boolean -> Constraint +class Equals lhs rhs out | lhs rhs -> out + +instance equalsEQEQ :: Equals PO.EQ PO.EQ True +instance equalsLTLT :: Equals PO.LT PO.LT True +instance equalsGTGT :: Equals PO.GT PO.GT True +instance equalsEQLT :: Equals PO.EQ PO.LT False +instance equalsEQGT :: Equals PO.EQ PO.GT False +instance equalsLTEQ :: Equals PO.LT PO.EQ False +instance equalsLTGT :: Equals PO.LT PO.GT False +instance equalsGTLT :: Equals PO.GT PO.LT False +instance equalsGTEQ :: Equals PO.GT PO.EQ False + +equals :: forall l r o. Equals l r o => Proxy l -> Proxy r -> Proxy o +equals _ _ = Proxy diff --git a/stdlib/lib/Type/Data/Symbol.purs b/stdlib/lib/Type/Data/Symbol.purs new file mode 100644 index 00000000..535ae49c --- /dev/null +++ b/stdlib/lib/Type/Data/Symbol.purs @@ -0,0 +1,35 @@ +module Type.Data.Symbol + ( module Prim.Symbol + , module Data.Symbol + , append + , compare + , uncons + , class Equals + , equals + ) where + +import Prim.Symbol (class Append, class Compare, class Cons) +import Data.Symbol (class IsSymbol, reflectSymbol, reifySymbol) +import Type.Data.Ordering (EQ) +import Type.Data.Ordering (class Equals) as Ordering +import Type.Proxy (Proxy(..)) + +compare :: forall l r o. Compare l r o => Proxy l -> Proxy r -> Proxy o +compare _ _ = Proxy + +append :: forall l r o. Append l r o => Proxy l -> Proxy r -> Proxy o +append _ _ = Proxy + +uncons :: forall h t s. Cons h t s => Proxy s -> {head :: Proxy h, tail :: Proxy t} +uncons _ = {head : Proxy, tail : Proxy} + +class Equals :: Symbol -> Symbol -> Boolean -> Constraint +class Equals lhs rhs out | lhs rhs -> out + +instance equalsSymbol + :: (Compare lhs rhs ord, + Ordering.Equals EQ ord out) + => Equals lhs rhs out + +equals :: forall l r o. Equals l r o => Proxy l -> Proxy r -> Proxy o +equals _ _ = Proxy diff --git a/stdlib/lib/Type/Equality.purs b/stdlib/lib/Type/Equality.purs new file mode 100644 index 00000000..686655b5 --- /dev/null +++ b/stdlib/lib/Type/Equality.purs @@ -0,0 +1,35 @@ +module Type.Equality + ( class TypeEquals + , proof + , to + , from + ) where + +import Prim.Coerce (class Coercible) + +-- | This type class asserts that types `a` and `b` +-- | are equal. +-- | +-- | The functional dependencies and the single +-- | instance below will force the two type arguments +-- | to unify when either one is known. +-- | +-- | Note: any instance will necessarily overlap with +-- | `refl` below, so instances of this class should +-- | not be defined in libraries. +class TypeEquals :: forall k. k -> k -> Constraint +class Coercible a b <= TypeEquals a b | a -> b, b -> a where + proof :: forall p. p a -> p b + +instance refl :: TypeEquals a a where + proof a = a + +newtype To a b = To (a -> b) + +to :: forall a b. TypeEquals a b => a -> b +to = case proof (To (\a -> a)) of To f -> f + +newtype From a b = From (b -> a) + +from :: forall a b. TypeEquals a b => b -> a +from = case proof (From (\a -> a)) of From f -> f diff --git a/stdlib/lib/Type/Function.purs b/stdlib/lib/Type/Function.purs new file mode 100644 index 00000000..78440ad5 --- /dev/null +++ b/stdlib/lib/Type/Function.purs @@ -0,0 +1,23 @@ +module Type.Function where + +-- | Polymorphic Type application +-- | +-- | For example... +-- | ``` +-- | APPLY Maybe Int == Maybe $ Int == Maybe Int +-- | ``` +type APPLY :: forall a b. (a -> b) -> a -> b +type APPLY f a = f a + +infixr 0 type APPLY as $ + +-- | Reversed polymorphic Type application +-- | +-- | For example... +-- | ``` +-- | FLIP Int Maybe == Int # Maybe == Maybe Int +-- | ``` +type FLIP :: forall a b. a -> (a -> b) -> b +type FLIP a f = f a + +infixl 1 type FLIP as # diff --git a/stdlib/lib/Type/Prelude.purs b/stdlib/lib/Type/Prelude.purs new file mode 100644 index 00000000..f67d0a26 --- /dev/null +++ b/stdlib/lib/Type/Prelude.purs @@ -0,0 +1,17 @@ +module Type.Prelude + ( module Type.Data.Boolean + , module Type.Data.Ordering + , module Type.Data.Symbol + , module Type.Equality + , module Type.Proxy + , module Type.Row + , module Type.RowList + ) where + +import Type.Data.Boolean (True, False, class IsBoolean, reflectBoolean, reifyBoolean) +import Type.Data.Ordering (Ordering, LT, EQ, GT, class IsOrdering, reflectOrdering, reifyOrdering) +import Type.Proxy (Proxy(..)) +import Type.Data.Symbol (class IsSymbol, reflectSymbol, reifySymbol, class Compare, compare, class Append, append) +import Type.Equality (class TypeEquals, from, to) +import Type.Row (class Union, class Lacks) +import Type.RowList (class RowToList, class ListToRow) diff --git a/stdlib/lib/Type/Proxy.purs b/stdlib/lib/Type/Proxy.purs new file mode 100644 index 00000000..a3782fdd --- /dev/null +++ b/stdlib/lib/Type/Proxy.purs @@ -0,0 +1,53 @@ +-- | The `Proxy` type and values are for situations where type information is +-- | required for an input to determine the type of an output, but where it is +-- | not possible or convenient to provide a _value_ for the input. +-- | +-- | A hypothetical example: if you have a class that is used to handle the +-- | result of an AJAX request, you may want to use this information to set the +-- | expected content type of the request, so you might have a class something +-- | like this: +-- | +-- | ``` purescript +-- | class AjaxResponse a where +-- | responseType :: a -> ResponseType +-- | fromResponse :: Foreign -> a +-- | ``` +-- | +-- | The problem here is `responseType` requires a value of type `a`, but we +-- | won't have a value of that type until the request has been completed. The +-- | solution is to use a `Proxy` type instead: +-- | +-- | ``` purescript +-- | class AjaxResponse a where +-- | responseType :: Proxy a -> ResponseType +-- | fromResponse :: Foreign -> a +-- | ``` +-- | +-- | We can now call `responseType (Proxy :: Proxy SomeContentType)` to produce +-- | a `ResponseType` for `SomeContentType` without having to construct some +-- | empty version of `SomeContentType` first. In situations like this where +-- | the `Proxy` type can be statically determined, it is recommended to pull +-- | out the definition to the top level and make a declaration like: +-- | +-- | ``` purescript +-- | _SomeContentType :: Proxy SomeContentType +-- | _SomeContentType = Proxy +-- | ``` +-- | +-- | That way the proxy value can be used as `responseType _SomeContentType` +-- | for improved readability. However, this is not always possible, sometimes +-- | the type required will be determined by a type variable. As PureScript has +-- | scoped type variables, we can do things like this: +-- | +-- | ``` purescript +-- | makeRequest :: URL -> ResponseType -> Aff _ Foreign +-- | makeRequest = ... +-- | +-- | fetchData :: forall a. (AjaxResponse a) => URL -> Aff _ a +-- | fetchData url = fromResponse <$> makeRequest url (responseType (Proxy :: Proxy a)) +-- | ``` +module Type.Proxy where + +-- | Proxy type for all `kind`s. +data Proxy :: forall k. k -> Type +data Proxy a = Proxy diff --git a/stdlib/lib/Type/Row.purs b/stdlib/lib/Type/Row.purs new file mode 100644 index 00000000..101cb9d5 --- /dev/null +++ b/stdlib/lib/Type/Row.purs @@ -0,0 +1,22 @@ +module Type.Row + ( module Prim.Row + , RowApply + , type (+) + ) where + +import Prim.Row (class Lacks, class Nub, class Cons, class Union) + +-- | Type application for rows. +type RowApply :: forall k. (Row k -> Row k) -> Row k -> Row k +type RowApply f a = f a + +-- | Applies a type alias of open rows to a set of rows. The primary use case +-- | this operator is as convenient sugar for combining open rows without +-- | parentheses. +-- | ```purescript +-- | type Rows1 r = (a :: Int, b :: String | r) +-- | type Rows2 r = (c :: Boolean | r) +-- | type Rows3 r = (Rows1 + Rows2 + r) +-- | type Rows4 r = (d :: String | Rows1 + Rows2 + r) +-- | ``` +infixr 0 type RowApply as + diff --git a/stdlib/lib/Type/Row/Homogeneous.purs b/stdlib/lib/Type/Row/Homogeneous.purs new file mode 100644 index 00000000..69e1cb73 --- /dev/null +++ b/stdlib/lib/Type/Row/Homogeneous.purs @@ -0,0 +1,23 @@ +module Type.Row.Homogeneous + ( class Homogeneous + , class HomogeneousRowList + ) where + +import Type.Equality (class TypeEquals) +import Type.RowList (class RowToList, Cons, Nil, RowList) + +-- | Ensure that every field in a row has the same type. +class Homogeneous :: forall k. Row k -> k -> Constraint +class Homogeneous row fieldType | row -> fieldType +instance homogeneous + :: ( RowToList row fields + , HomogeneousRowList fields fieldType ) + => Homogeneous row fieldType + +class HomogeneousRowList :: forall k. RowList k -> k -> Constraint +class HomogeneousRowList rowList fieldType | rowList -> fieldType +instance homogeneousRowListCons + :: ( HomogeneousRowList tail fieldType + , TypeEquals fieldType fieldType2 ) + => HomogeneousRowList (Cons symbol fieldType tail) fieldType2 +instance homogeneousRowListNil :: HomogeneousRowList Nil fieldType diff --git a/stdlib/lib/Type/RowList.purs b/stdlib/lib/Type/RowList.purs new file mode 100644 index 00000000..5a555422 --- /dev/null +++ b/stdlib/lib/Type/RowList.purs @@ -0,0 +1,82 @@ +module Type.RowList + ( module Prim.RowList + , class ListToRow + , class RowListRemove + , class RowListSet + , class RowListNub + , class RowListAppend + ) where + +import Prim.Row as Row +import Prim.RowList (RowList, Cons, Nil, class RowToList) +import Type.Equality (class TypeEquals) +import Type.Data.Symbol as Symbol +import Type.Data.Boolean as Boolean + +-- | Convert a RowList to a row of types. +-- | The inverse of this operation is `RowToList`. +class ListToRow :: forall k. RowList k -> Row k -> Constraint +class ListToRow list row | list -> row + +instance listToRowNil + :: ListToRow Nil () + +instance listToRowCons + :: ( ListToRow tail tailRow + , Row.Cons label ty tailRow row ) + => ListToRow (Cons label ty tail) row + +-- | Remove all occurences of a given label from a RowList +class RowListRemove :: forall k. Symbol -> RowList k -> RowList k -> Constraint +class RowListRemove label input output | label input -> output + +instance rowListRemoveNil + :: RowListRemove label Nil Nil + +instance rowListRemoveCons + :: ( RowListRemove label tail tailOutput + , Symbol.Equals label key eq + , Boolean.If eq + tailOutput + (Cons key head tailOutput) + output + ) + => RowListRemove label (Cons key head tail) output + +-- | Add a label to a RowList after removing other occurences. +class RowListSet :: forall k. Symbol -> k -> RowList k -> RowList k -> Constraint +class RowListSet label typ input output | label typ input -> output + +instance rowListSetImpl + :: ( TypeEquals label label' + , TypeEquals typ typ' + , RowListRemove label input lacking ) + => RowListSet label typ input (Cons label' typ' lacking) + +-- | Remove label duplicates, keeps earlier occurrences. +class RowListNub :: forall k. RowList k -> RowList k -> Constraint +class RowListNub input output | input -> output + +instance rowListNubNil + :: RowListNub Nil Nil + +instance rowListNubCons + :: ( TypeEquals label label' + , TypeEquals head head' + , TypeEquals nubbed nubbed' + , RowListRemove label tail removed + , RowListNub removed nubbed ) + => RowListNub (Cons label head tail) (Cons label' head' nubbed') + +-- Append two row lists together +class RowListAppend :: forall k. RowList k -> RowList k -> RowList k -> Constraint +class RowListAppend lhs rhs out | lhs rhs -> out + +instance rowListAppendNil + :: TypeEquals rhs out + => RowListAppend Nil rhs out + +instance rowListAppendCons + :: ( RowListAppend tail rhs out' + , TypeEquals (Cons label head out') out ) + => RowListAppend (Cons label head tail) rhs out diff --git a/stdlib/lib/Unsafe/Coerce.purs b/stdlib/lib/Unsafe/Coerce.purs new file mode 100644 index 00000000..40013c40 --- /dev/null +++ b/stdlib/lib/Unsafe/Coerce.purs @@ -0,0 +1,28 @@ + +module Unsafe.Coerce + ( unsafeCoerce + ) where + +-- | A _highly unsafe_ function, which can be used to persuade the type system that +-- | any type is the same as any other type. When using this function, it is your +-- | (that is, the caller's) responsibility to ensure that the underlying +-- | representation for both types is the same. +-- | +-- | Because this function is extraordinarily flexible, type inference +-- | can greatly suffer. It is highly recommended to define specializations of +-- | this function rather than using it as-is. For example: +-- | +-- | ```purescript +-- | fromBoolean :: Boolean -> Json +-- | fromBoolean = unsafeCoerce +-- | ``` +-- | +-- | This way, you won't have any nasty surprises due to the inferred type being +-- | different to what you expected. +-- | +-- | After the v0.14.0 PureScript release, some of what was accomplished via +-- | `unsafeCoerce` can now be accomplished via `coerce` from +-- | `purescript-safe-coerce`. See that library's documentation for more +-- | context. +unsafeCoerce :: forall a b. a -> b +unsafeCoerce a0 = unsafeCoerce a0 diff --git a/stdlib/lib/trusted b/stdlib/lib/trusted index 08b7eb17..666e5dad 100644 --- a/stdlib/lib/trusted +++ b/stdlib/lib/trusted @@ -1,21 +1,211 @@ -# Trusted standard-library modules, in prefix order. +# Trusted standard-library modules, in load order. # Dots are directory separators under this directory. +# Vendored from the PureScript core libraries used by the v0.15.16 +# compiler tests (prelude v6.0.1 and the matching package majors). +# `Prelude` keeps the psrs:effect bindings. `Data.Show` and `Data.Tuple` +# stay the implementations this compiler already lowers. Prelude +Control.Alt +Control.Alternative +Control.Applicative +Control.Apply +Control.Biapplicative +Control.Biapply +Control.Bind +Control.Category +Control.Comonad +Control.Extend +Control.Lazy +Control.Monad +Control.Monad.Gen +Control.Monad.Gen.Class +Control.Monad.Gen.Common +Control.Monad.Rec.Class +Control.Monad.ST +Control.Monad.ST.Class +Control.Monad.ST.Global +Control.Monad.ST.Internal +Control.Monad.ST.Ref +Control.Monad.ST.Uncurried +Control.MonadPlus +Control.Plus +Control.Semigroupoid +Data.Array +Data.Array.NonEmpty +Data.Array.NonEmpty.Internal +Data.Array.Partial +Data.Array.ST +Data.Array.ST.Iterator +Data.Array.ST.Partial +Data.Bifoldable +Data.Bifunctor +Data.Bifunctor.Join +Data.Bitraversable +Data.Boolean +Data.BooleanAlgebra +Data.Bounded +Data.Bounded.Generic +Data.Char +Data.Char.Gen +Data.CommutativeRing +Data.Compactable +Data.Comparison +Data.Const +Data.Decidable +Data.Decide +Data.Distributive +Data.Divide +Data.Divisible +Data.DivisionRing +Data.Either +Data.Either.Inject +Data.Either.Nested +Data.Enum +Data.Enum.Gen +Data.Enum.Generic +Data.Eq +Data.Eq.Generic +Data.Equivalence +Data.EuclideanRing +Data.Exists +Data.Field +Data.Filterable +Data.Foldable +Data.FoldableWithIndex Data.Function -Data.Semigroup +Data.Function.Uncurried +Data.Functor +Data.Functor.App +Data.Functor.Clown +Data.Functor.Compose +Data.Functor.Contravariant +Data.Functor.Coproduct +Data.Functor.Coproduct.Inject +Data.Functor.Coproduct.Nested +Data.Functor.Costar +Data.Functor.Flip +Data.Functor.Invariant +Data.Functor.Joker +Data.Functor.Product +Data.Functor.Product.Nested +Data.Functor.Product2 +Data.FunctorWithIndex +Data.Generic.Rep +Data.HeytingAlgebra +Data.HeytingAlgebra.Generic +Data.Identity +Data.Int +Data.Int.Bits +Data.Lazy +Data.List +Data.List.Internal +Data.List.Lazy +Data.List.Lazy.NonEmpty +Data.List.Lazy.Types +Data.List.NonEmpty +Data.List.Partial +Data.List.Types +Data.List.ZipList +Data.Map +Data.Map.Gen +Data.Map.Internal +Data.Maybe +Data.Maybe.First +Data.Maybe.Last Data.Monoid -Data.Eq +Data.Monoid.Additive +Data.Monoid.Alternate +Data.Monoid.Conj +Data.Monoid.Disj +Data.Monoid.Dual +Data.Monoid.Endo +Data.Monoid.Generic +Data.Monoid.Multiplicative +Data.NaturalTransformation +Data.Newtype +Data.NonEmpty +Data.Number +Data.Number.Approximate +Data.Number.Format +Data.Op Data.Ord +Data.Ord.Down +Data.Ord.Generic +Data.Ord.Max +Data.Ord.Min +Data.Ordering +Data.Predicate +Data.Profunctor +Data.Profunctor.Choice +Data.Profunctor.Closed +Data.Profunctor.Cochoice +Data.Profunctor.Costrong +Data.Profunctor.Join +Data.Profunctor.Split +Data.Profunctor.Star +Data.Profunctor.Strong +Data.Reflectable +Data.Ring +Data.Ring.Generic +Data.Semigroup +Data.Semigroup.First +Data.Semigroup.Foldable +Data.Semigroup.Generic +Data.Semigroup.Last +Data.Semigroup.Traversable Data.Semiring +Data.Semiring.Generic +Data.Set +Data.Set.NonEmpty Data.Show +Data.Show.Generic +Data.String +Data.String.CaseInsensitive +Data.String.CodePoints +Data.String.CodeUnits +Data.String.Common +Data.String.Gen +Data.String.NonEmpty +Data.String.NonEmpty.CaseInsensitive +Data.String.NonEmpty.CodePoints +Data.String.NonEmpty.CodeUnits +Data.String.NonEmpty.Internal +Data.String.Pattern +Data.String.Regex +Data.String.Regex.Flags +Data.String.Regex.Unsafe +Data.String.Unsafe +Data.Symbol +Data.Traversable +Data.Traversable.Accum +Data.Traversable.Accum.Internal +Data.TraversableWithIndex +Data.Tuple +Data.Tuple.Nested +Data.Unfoldable +Data.Unfoldable1 +Data.Unit +Data.Void +Data.Witherable Effect Effect.Console +Effect.Ref +Partial +Partial.Unsafe +Record.Unsafe +Safe.Coerce Test.Assert -Data.Maybe -Data.Either -Data.Functor -Data.Tuple -Data.Foldable +Type.Data.Boolean +Type.Data.Ordering +Type.Data.Symbol +Type.Equality +Type.Function +Type.Prelude +Type.Proxy +Type.Row +Type.Row.Homogeneous +Type.RowList +Unsafe.Coerce WASI.Resource WASI.IO WASI.Clock From 74a9b0256e3c779c9572fa17eaa74b0ddde63556 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 00:28:42 +0800 Subject: [PATCH 002/148] Add compile diagnosis tooling and iteration workflow --- AGENTS.md | 12 + Cargo.lock | 3 + crates/psrs-backend/src/cc/verify/helpers.rs | 40 +- crates/psrs-backend/src/cc/verify/mod.rs | 1 + crates/psrs-backend/src/cc/verify/ops/mod.rs | 29 +- .../src/cc/verify/ops/tag_switch.rs | 3 + .../src/cc/verify/tests/structure.rs | 8 +- crates/psrs-backend/src/lib.rs | 57 +++ crates/psrs-cli/Cargo.toml | 2 + crates/psrs-cli/src/diagnose/artifacts.rs | 301 ++++++++++++ crates/psrs-cli/src/diagnose/mod.rs | 456 ++++++++++++++++++ crates/psrs-cli/src/diagnose/report.rs | 290 +++++++++++ crates/psrs-cli/src/diagnose/worker.rs | 290 +++++++++++ crates/psrs-cli/src/main.rs | 15 +- crates/psrs-cli/tests/cli.rs | 74 +++ crates/psrs-driver/src/diagnostics.rs | 31 ++ crates/psrs-driver/src/lib.rs | 11 +- crates/psrs-driver/src/loader.rs | 75 +++ crates/psrs-driver/src/program/compilation.rs | 133 +++++ crates/psrs-driver/src/program/library.rs | 17 +- crates/psrs-driver/src/program/mod.rs | 49 +- crates/psrs-driver/tests/suite/corpus/mod.rs | 54 +-- docs/README.md | 7 + docs/authoring-guide.md | 1 + docs/design/D-16-compile-diagnosis.md | 69 +++ docs/feature/F-04-compile-diagnosis.md | 46 ++ docs/workflow/compiler-iteration-sop.md | 128 +++++ 27 files changed, 2099 insertions(+), 103 deletions(-) create mode 100644 crates/psrs-cli/src/diagnose/artifacts.rs create mode 100644 crates/psrs-cli/src/diagnose/mod.rs create mode 100644 crates/psrs-cli/src/diagnose/report.rs create mode 100644 crates/psrs-cli/src/diagnose/worker.rs create mode 100644 crates/psrs-driver/src/diagnostics.rs create mode 100644 crates/psrs-driver/src/program/compilation.rs create mode 100644 docs/design/D-16-compile-diagnosis.md create mode 100644 docs/feature/F-04-compile-diagnosis.md create mode 100644 docs/workflow/compiler-iteration-sop.md diff --git a/AGENTS.md b/AGENTS.md index 1a398249..3e96adb9 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -19,6 +19,9 @@ uncommitted work. - For a new user-facing feature, maintain the relevant feature and design documents under `docs/`. Add a decision record only for a major, durable decision. Keep documentation proportional to the change. +- For compiler fixes, follow the [compiler iteration SOP](docs/workflow/compiler-iteration-sop.md) + to capture a comparable baseline, locate the owning stage contract, and verify + the change at the right layer. - Review the local diff and run the validation relevant to the files changed. ### Commit granularity @@ -104,6 +107,10 @@ as project fields would create a second source of truth. - New syntax and new diagnostics land with official-suite evidence, not only a local test. The issue states whether that is a `purs` differential case or a scoreboard number. +- Before a broad compiler fix, record a small or filtered compile-diagnosis + baseline and inspect the first blocker, diagnostic origin, and last completed + stage. Use the SOP's failure-group counts to guide investigation, while + choosing roadmap work and semantic ownership by the rules in this section. - Run the issue's `Validation` block. It is the issue-specific superset of the workspace validation below. @@ -239,6 +246,11 @@ cargo test --workspace cargo clippy --workspace --all-targets -- -D warnings ``` +An explicit user-defined validation scope takes precedence over these +defaults. An issue's `Validation` block adds its required checks to the +applicable defaults. Report omitted commands and their scope; do not present +unrun checks as passing. + The workspace default member is the CLI so `cargo run -- ...` works from the repository root. Always use `cargo test --workspace` to include library tests. diff --git a/Cargo.lock b/Cargo.lock index 87b59ba4..a03f0935 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -227,6 +227,8 @@ dependencies = [ "psrs-resolve", "psrs-span", "psrs-syntax", + "serde", + "serde_json", ] [[package]] @@ -355,6 +357,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "4148590afebada386688f18773da617792bf2ef03ffc1e4cbd2b1d45b023e0ba" dependencies = [ "serde_core", + "serde_derive", ] [[package]] diff --git a/crates/psrs-backend/src/cc/verify/helpers.rs b/crates/psrs-backend/src/cc/verify/helpers.rs index 7252dda8..28e8458f 100644 --- a/crates/psrs-backend/src/cc/verify/helpers.rs +++ b/crates/psrs-backend/src/cc/verify/helpers.rs @@ -150,6 +150,9 @@ pub(super) fn verify_call_shape( declared: &HashMap, signature: &Signature, arguments: &[ValueId], + callee: &str, + function_name: &str, + function_span: TextRange, ) -> Result<(), Vec> { if arguments.len() != signature.parameters.len() || arguments @@ -157,17 +160,40 @@ pub(super) fn verify_call_shape( .zip(&signature.parameters) .any(|(argument, expected)| declared.get(argument).copied() != Some(*expected)) { + let expected = signature + .parameters + .iter() + .map(|shape| format!("{shape:?}")) + .collect::>() + .join(", "); + let actual = arguments + .iter() + .map(|value| match declared.get(value) { + Some(shape) => format!("{value:?}: {shape:?}"), + None => format!("{value:?}: "), + }) + .collect::>() + .join(", "); return Err(assignment_error( assignment, - "call arguments do not match its signature", + format!( + "call shape mismatch: callee `{callee}` in function `{function_name}` at {function_span:?}; expected {} argument(s) [{expected}], got {} [{actual}]", + signature.parameters.len(), + arguments.len(), + ), )); } - require_destination( - declared, - assignment, - signature.result, - "call result shape does not match its signature", - ) + let actual_result = declared.get(&assignment.destination).copied(); + if actual_result != Some(signature.result) { + return Err(assignment_error( + assignment, + format!( + "call result shape mismatch: callee `{callee}` in function `{function_name}` at {function_span:?}; expected {:?}, got {actual_result:?}", + signature.result, + ), + )); + } + Ok(()) } pub(super) fn verify_product_value( diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 290e611d..8173a398 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -194,6 +194,7 @@ fn verify_function_inner( representations, functions, function.span, + &function.name, )?; if !available.contains(&function.result) { return Err(vec![BackendError::invalid_ir( diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index b411b1da..654ee6a2 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -21,6 +21,7 @@ mod tag_switch; pub(super) use table::verify_table; +#[allow(clippy::too_many_arguments)] pub(super) fn verify_assignments( assignments: &[Assignment], available: &mut HashSet, @@ -29,6 +30,7 @@ pub(super) fn verify_assignments( table: &RepresentationTable, functions: Option<&HashMap>, function_span: TextRange, + function_name: &str, ) -> Result<(), Vec> { for assignment in assignments { let mut uses = Vec::new(); @@ -97,7 +99,19 @@ pub(super) fn verify_assignments( "direct call references an unknown function", )); }; - verify_call_shape(assignment, declared, signature, arguments)?; + let callee = functions + .and_then(|functions| functions.get(function)) + .map(|function| function.name.clone()) + .unwrap_or_else(|| format!("symbol {function:?}")); + verify_call_shape( + assignment, + declared, + signature, + arguments, + &callee, + function_name, + function_span, + )?; uses.extend(arguments.iter().copied()); } AssignmentKind::FunctionRef { @@ -137,7 +151,15 @@ pub(super) fn verify_assignments( let signature_id = *signature; let signature = table_signature(table, signature_id, assignment)?; require_value_shape(declared, *function, closure_shape(signature_id), assignment)?; - verify_call_shape(assignment, declared, signature, arguments)?; + verify_call_shape( + assignment, + declared, + signature, + arguments, + &format!("indirect call with signature {signature_id:?}"), + function_name, + function_span, + )?; uses.push(*function); uses.extend(arguments.iter().copied()); } @@ -354,6 +376,7 @@ pub(super) fn verify_assignments( table, functions, function_span, + function_name, )?; let mut else_available = available.clone(); verify_assignments( @@ -364,6 +387,7 @@ pub(super) fn verify_assignments( table, functions, function_span, + function_name, )?; if !then_available.contains(then_value) || !else_available.contains(else_value) { return Err(undef_error(assignment.span, function_span)); @@ -397,6 +421,7 @@ pub(super) fn verify_assignments( table, functions, function_span, + function_name, )?; uses.push(*value); } diff --git a/crates/psrs-backend/src/cc/verify/ops/tag_switch.rs b/crates/psrs-backend/src/cc/verify/ops/tag_switch.rs index d10d451c..160dfc0b 100644 --- a/crates/psrs-backend/src/cc/verify/ops/tag_switch.rs +++ b/crates/psrs-backend/src/cc/verify/ops/tag_switch.rs @@ -20,6 +20,7 @@ pub(super) fn verify_tag_switch( table: &crate::cc::RepresentationTable, functions: Option<&HashMap>, function_span: TextRange, + function_name: &str, ) -> Result<(), Vec> { require_value_shape(declared, value, ValueShape::Integer, assignment)?; if cases.is_empty() @@ -52,6 +53,7 @@ pub(super) fn verify_tag_switch( table, functions, function_span, + function_name, )?; if !default_available.contains(&default_value) { return Err(undef_error(assignment.span, function_span)); @@ -67,6 +69,7 @@ pub(super) fn verify_tag_switch( table, functions, function_span, + function_name, )?; if !case_available.contains(&case.value) || declared_shape(declared, case.value, assignment)? != expected diff --git a/crates/psrs-backend/src/cc/verify/tests/structure.rs b/crates/psrs-backend/src/cc/verify/tests/structure.rs index bee14368..fea45333 100644 --- a/crates/psrs-backend/src/cc/verify/tests/structure.rs +++ b/crates/psrs-backend/src/cc/verify/tests/structure.rs @@ -157,7 +157,13 @@ fn rejects_a_direct_call_with_the_wrong_arity() { result: ValueShape::Integer, }, )]); - assert!(verify_function(&function, &signatures, &table()).is_err()); + let errors = verify_function(&function, &signatures, &table()) + .expect_err("the callee expects one integer argument"); + let message = &errors[0].message; + assert!(message.contains("call shape mismatch")); + assert!(message.contains("bad_arity")); + assert!(message.contains("expected 1 argument(s) [Integer]")); + assert!(message.contains("got 0 []")); } #[test] diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 40629f36..282de619 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -178,6 +178,27 @@ pub struct Stages { pub artifact: Artifact, } +/// IR values captured by the diagnostic compile path. Each field is populated +/// only after that representation has been produced successfully by its pass. +#[derive(Clone, Debug, Default)] +pub struct PartialStages { + /// Optimized Core after P7. + pub core: Option, + /// CC after closure conversion and its verifier both succeed. + pub cc: Option, + /// Latest MIR produced by lowering or optimization. + pub mir: Option, + /// The pass that most recently produced `mir`. + pub mir_stage: Option<&'static str>, +} + +/// Backend diagnostics together with the last successful IR values. +#[derive(Clone, Debug)] +pub struct CompileFailure { + pub errors: Vec, + pub partial: PartialStages, +} + pub fn compile_with_stages(module: psrs_core::Module) -> Result> { compile_with_target(module, TargetCapabilities::default()) } @@ -194,6 +215,28 @@ pub fn compile_with_context( module: psrs_core::Module, effect_context: Option, target: TargetCapabilities, +) -> Result> { + compile_with_context_inner(module, effect_context, target, None) +} + +/// Compiles using the normal backend pipeline and returns only representations +/// whose producing pass completed. In particular, a CC verifier failure leaves +/// the verified Core available but does not publish the unverified CC candidate. +pub fn compile_with_context_capturing( + module: psrs_core::Module, + effect_context: Option, + target: TargetCapabilities, +) -> Result { + let mut partial = PartialStages::default(); + compile_with_context_inner(module, effect_context, target, Some(&mut partial)) + .map_err(|errors| CompileFailure { errors, partial }) +} + +fn compile_with_context_inner( + module: psrs_core::Module, + effect_context: Option, + target: TargetCapabilities, + mut capture: Option<&mut PartialStages>, ) -> Result> { let owner = module.entry.map(|entry| entry.module); let mut module = @@ -210,6 +253,9 @@ pub fn compile_with_context( ) })?; let optimized_core = module.clone(); + if let Some(capture) = capture.as_deref_mut() { + capture.core = Some(optimized_core.clone()); + } let mut external_bindings = ExternalBindings::from_core(&module); if let Some(context) = effect_context.as_ref() { effects::lower_effects(&mut module, &mut external_bindings, context)?; @@ -217,9 +263,20 @@ pub fn compile_with_context( external_bindings.validate_conformance(&module, target)?; let lowered_cc = cc::lower_module_with_bindings(module, external_bindings)?; let cc = lowered_cc.cc; + if let Some(capture) = capture.as_deref_mut() { + capture.cc = Some(cc.clone()); + } let (mir, mut wasi) = mir::lower_module_with_bindings(cc.clone(), lowered_cc.externals, target)?; + if let Some(capture) = capture.as_deref_mut() { + capture.mir = Some(mir.clone()); + capture.mir_stage = Some("P9 MIR lowering"); + } let mir = mir::opt::optimize(mir, target)?; + if let Some(capture) = capture.as_deref_mut() { + capture.mir = Some(mir.clone()); + capture.mir_stage = Some("P10 MIR optimization"); + } let owner = mir.entry.map(|entry| entry.module); if !target.component_model || !target.wasi_p2 diff --git a/crates/psrs-cli/Cargo.toml b/crates/psrs-cli/Cargo.toml index 016b3e03..bf16680c 100644 --- a/crates/psrs-cli/Cargo.toml +++ b/crates/psrs-cli/Cargo.toml @@ -15,3 +15,5 @@ psrs-hir.workspace = true psrs-resolve.workspace = true psrs-span.workspace = true psrs-syntax.workspace = true +serde = { version = "1", features = ["derive"] } +serde_json = "1" diff --git a/crates/psrs-cli/src/diagnose/artifacts.rs b/crates/psrs-cli/src/diagnose/artifacts.rs new file mode 100644 index 00000000..acee6327 --- /dev/null +++ b/crates/psrs-cli/src/diagnose/artifacts.rs @@ -0,0 +1,301 @@ +use super::{BundleContext, CompilerRevision, Snapshot, SourceInput, WorkerResponse}; +use serde::de::DeserializeOwned; +use std::path::{Path, PathBuf}; +use std::process::Command; +use std::{env, fs}; + +pub(super) fn write_bundle( + bundle: &Path, + sources: &[SourceInput], + response: &WorkerResponse, + case: &str, + input_set_complete: bool, + context: &BundleContext, +) -> Result<(), String> { + let _ = fs::remove_dir_all(bundle); + fs::create_dir_all(bundle.join("inputs")) + .map_err(|error| format!("{}: {error}", bundle.display()))?; + let mut paths = Vec::new(); + for (index, source) in sources.iter().enumerate() { + let file = format!("inputs/{index:04}-{}.purs", safe_name(&source.name)); + fs::write(bundle.join(&file), &source.text) + .map_err(|error| format!("{}: {error}", bundle.join(&file).display()))?; + paths.push(file); + } + write_dumps(bundle, response)?; + let command = replay_command(&paths, &context.executable); + fs::write( + bundle.join("replay.sh"), + format!("#!/bin/sh\nset -eu\ncd \"$(dirname \"$0\")\"\n{command}\n"), + ) + .map_err(|error| error.to_string())?; + let metadata = serde_json::json!({ + "case": case, + "input_names": sources.iter().map(|source| &source.name).collect::>(), + "replay_argv": std::iter::once(context.executable.clone()) + .chain(std::iter::once("build".to_owned())) + .chain(paths.iter().cloned()) + .chain(["-o".into(), "output.wasm".into()]) + .collect::>(), + "diagnostics": &response.diagnostics, + "input_fingerprint": &response.input_fingerprint, + "compiler": &context.compiler, + "trusted_stdlib_fingerprint": &context.trusted_stdlib_fingerprint, + "input_set_complete": input_set_complete, + }); + fs::write( + bundle.join("case.json"), + serde_json::to_vec_pretty(&metadata).map_err(|error| error.to_string())?, + ) + .map_err(|error| format!("{}: {error}", bundle.display())) +} + +pub(super) fn write_empty_bundle( + bundle: &Path, + sources: &[SourceInput], + case: &str, + reason: &str, + stderr: &str, + input_set_complete: bool, + context: &BundleContext, +) -> Result<(), String> { + let empty = WorkerResponse { + passed: false, + input_fingerprint: fingerprint_sources(sources), + sources: sources.to_vec(), + input_set_complete, + elapsed_ms: 0, + diagnostics: Vec::new(), + core_stage: None, + core: None, + cc_stage: None, + cc: None, + mir_stage: None, + mir: None, + }; + write_bundle(bundle, sources, &empty, case, input_set_complete, context)?; + fs::write(bundle.join("worker-failure.txt"), reason).map_err(|error| error.to_string())?; + if !stderr.is_empty() { + fs::write(bundle.join("worker-stderr.log"), stderr).map_err(|error| error.to_string())?; + } + Ok(()) +} + +fn write_dumps(bundle: &Path, response: &WorkerResponse) -> Result<(), String> { + for (name, stage, text) in [ + ("core", &response.core_stage, &response.core), + ("cc", &response.cc_stage, &response.cc), + ("mir", &response.mir_stage, &response.mir), + ] { + if let Some(text) = text { + fs::write(bundle.join(format!("{name}.debug")), text) + .map_err(|error| error.to_string())?; + fs::write( + bundle.join(format!("{name}.stage")), + stage.as_deref().unwrap_or("unknown"), + ) + .map_err(|error| error.to_string())?; + } + } + Ok(()) +} + +fn replay_command(paths: &[String], executable: &str) -> String { + let args = paths + .iter() + .map(|path| shell_quote(path)) + .collect::>() + .join(" "); + let args = format!("build {args} -o output.wasm"); + format!( + "if [ -z \"${{PSRS_BIN:-}}\" ]; then PSRS_BIN={}; fi\n\"$PSRS_BIN\" {args}", + shell_quote(executable) + ) +} + +pub(super) fn trusted_stdlib_fingerprint() -> Result { + let root = PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../../stdlib/lib"); + let trusted_path = root.join("trusted"); + let trusted = fs::read_to_string(&trusted_path) + .map_err(|error| format!("{}: {error}", trusted_path.display()))?; + let mut bytes = trusted.as_bytes().to_vec(); + for name in trusted + .lines() + .map(str::trim) + .filter(|line| !line.is_empty() && !line.starts_with('#')) + { + let path = root.join(format!("{}.purs", name.replace('.', "/"))); + let text = fs::read(&path).map_err(|error| format!("{}: {error}", path.display()))?; + bytes.extend_from_slice(path.to_string_lossy().as_bytes()); + bytes.extend_from_slice(&text); + } + Ok(hash_bytes(&bytes)) +} + +pub(super) fn compiler_revision() -> CompilerRevision { + let root = PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../.."); + let head = Command::new("git") + .arg("-C") + .arg(&root) + .args(["rev-parse", "HEAD"]) + .output() + .ok() + .filter(|output| output.status.success()) + .map(|output| String::from_utf8_lossy(&output.stdout).trim().to_owned()); + let diff = Command::new("git") + .arg("-C") + .arg(&root) + .args(["diff", "HEAD", "--binary"]) + .output() + .ok() + .map(|output| output.stdout) + .unwrap_or_default(); + let status = Command::new("git") + .arg("-C") + .arg(&root) + .args(["status", "--porcelain"]) + .output() + .ok() + .map(|output| output.stdout) + .unwrap_or_default(); + let dirty = !status.is_empty(); + let mut bytes = diff; + bytes.extend_from_slice(&status); + if let Ok(output) = Command::new("git") + .arg("-C") + .arg(&root) + .args(["ls-files", "--others", "--exclude-standard", "-z"]) + .output() + { + for path in output + .stdout + .split(|byte| *byte == 0) + .filter(|path| !path.is_empty()) + { + bytes.extend_from_slice(path); + if let Ok(content) = fs::read(root.join(String::from_utf8_lossy(path).as_ref())) { + bytes.extend_from_slice(&content); + } + } + } + let binary_fingerprint = env::current_exe() + .ok() + .and_then(|path| fs::read(path).ok()) + .map(|binary| hash_bytes(&binary)) + .unwrap_or_else(|| "unavailable".into()); + CompilerRevision { + head, + dirty, + working_tree_fingerprint: hash_bytes(&bytes), + binary_fingerprint, + } +} + +pub(super) fn corpus_root() -> Result { + if let Ok(path) = env::var("PURESCRIPT_REPO") { + let root = PathBuf::from(path).join("tests/purs"); + return if root.is_dir() { + Ok(root) + } else { + Err(format!( + "{}: corpus directory does not exist", + root.display() + )) + }; + } + let root = PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../../tests/upstream"); + if root.is_dir() { + Ok(root) + } else { + Err(format!("{}: vendored corpus not found", root.display())) + } +} + +pub(super) fn is_ffi_excluded(path: &Path, text: &str) -> bool { + text.contains("foreign import") || path.with_extension("js").is_file() +} + +pub(super) fn fingerprint_sources(sources: &[SourceInput]) -> String { + let mut bytes = Vec::new(); + for source in sources { + bytes.extend_from_slice(source.name.as_bytes()); + bytes.push(0); + bytes.extend_from_slice(source.text.as_bytes()); + bytes.push(0xff); + } + hash_bytes(&bytes) +} + +fn hash_bytes(bytes: &[u8]) -> String { + let mut hash = 0xcbf29ce484222325u64; + for byte in bytes { + hash ^= u64::from(*byte); + hash = hash.wrapping_mul(0x100000001b3); + } + format!("fnv1a64:{hash:016x}") +} + +pub(super) fn safe_name(value: &str) -> String { + let name = Path::new(value) + .file_stem() + .unwrap_or_default() + .to_string_lossy(); + let cleaned = name + .chars() + .map(|ch| { + if ch.is_ascii_alphanumeric() || ch == '-' || ch == '_' { + ch + } else { + '_' + } + }) + .collect::(); + if cleaned.is_empty() { + "case".into() + } else { + cleaned + } +} + +fn shell_quote(value: &str) -> String { + format!("'{}'", value.replace('\'', "'\\''")) +} + +pub(super) fn absolute_path(path: &Path) -> Result { + if path.is_absolute() { + Ok(path.to_path_buf()) + } else { + env::current_dir() + .map(|cwd| cwd.join(path)) + .map_err(|error| error.to_string()) + } +} + +pub(super) fn atomic_write(path: &Path, bytes: &[u8]) -> Result<(), String> { + if let Some(parent) = path.parent() { + fs::create_dir_all(parent).map_err(|error| format!("{}: {error}", parent.display()))?; + } + let temporary = path.with_extension(format!("tmp-{}", std::process::id())); + fs::write(&temporary, bytes).map_err(|error| format!("{}: {error}", temporary.display()))?; + fs::rename(&temporary, path).map_err(|error| format!("{}: {error}", path.display())) +} + +pub(super) fn write_snapshot(path: &Path, snapshot: &Snapshot) -> Result<(), String> { + let bytes = serde_json::to_vec_pretty(snapshot).map_err(|error| error.to_string())?; + atomic_write(path, &bytes) +} + +pub(super) fn read_json(path: &str) -> Result { + let bytes = fs::read(path).map_err(|error| format!("{path}: {error}"))?; + serde_json::from_slice(&bytes).map_err(|error| format!("{path}: invalid JSON: {error}")) +} + +pub(super) fn first_line(text: &str) -> &str { + text.lines() + .next() + .unwrap_or("worker crashed without a message") +} + +pub(super) fn usage() -> String { + "usage: psrs diagnose [--out report.json] [--timeout SECONDS]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--out report.json] [--timeout SECONDS]\n psrs diagnose --compare OLD.json NEW.json".into() +} diff --git a/crates/psrs-cli/src/diagnose/mod.rs b/crates/psrs-cli/src/diagnose/mod.rs new file mode 100644 index 00000000..324ef63f --- /dev/null +++ b/crates/psrs-cli/src/diagnose/mod.rs @@ -0,0 +1,456 @@ +use serde::{Deserialize, Serialize}; +use std::collections::BTreeMap; +use std::path::PathBuf; +use std::{env, fs}; + +mod artifacts; +use artifacts::*; +mod report; +use report::*; +mod worker; +pub(super) use worker::worker; +use worker::{WorkerOutcome, WorkerResponse, run_worker}; + +const SCHEMA_VERSION: u32 = 1; +const DEFAULT_TIMEOUT: u64 = 20; + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct SourceInput { + name: String, + text: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct DiagnosticRecord { + origin: String, + source: Option, + stage: String, + start: u32, + end: u32, + code: Option, + kind: Option, + message: String, +} + +#[derive(Clone, Copy, Debug, Serialize, Deserialize)] +#[serde(rename_all = "snake_case")] +enum CaseStatus { + Passed, + Failed, + Excluded, + TimedOut, + Crashed, +} + +#[derive(Clone, Debug, PartialEq, Eq, Serialize, Deserialize)] +struct FirstBlocker { + stage: String, + category: String, + message: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct CaseRecord { + path: String, + input_fingerprint: String, + input_set_complete: bool, + elapsed_ms: u64, + status: CaseStatus, + excluded_reason: Option, + diagnostics: Vec, + first_blocker: Option, + bundle: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct GroupRecord { + stage: String, + category: String, + sample_messages: Vec, + cases: Vec, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct Cohort { + mode: String, + corpus: Option, + filter: Option, + limit: Option, + timeout_seconds: u64, + trusted_stdlib_fingerprint: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct CompilerRevision { + head: Option, + dirty: bool, + working_tree_fingerprint: String, + binary_fingerprint: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct BundleContext { + compiler: CompilerRevision, + trusted_stdlib_fingerprint: String, + executable: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct Snapshot { + schema_version: u32, + cohort: Cohort, + compiler: CompilerRevision, + cases: Vec, + groups: Vec, + counts: BTreeMap, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct CompareRow { + path: String, + change: String, + input_comparison: String, + before: Option, + after: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct CompareReport { + compatible_cohort: bool, + before_compiler: CompilerRevision, + after_compiler: CompilerRevision, + changes: Vec, +} + +pub(super) fn run(args: Vec) -> Result<(), String> { + if args.first().is_some_and(|arg| arg == "--compare") { + if args.len() != 3 { + return Err(usage()); + } + return compare(&args[1], &args[2]); + } + let options = Options::parse(args)?; + let output = options.output.clone(); + let snapshot = diagnose(options)?; + print_summary(&snapshot); + write_snapshot(&output, &snapshot)?; + println!("snapshot: {}", output.display()); + Ok(()) +} + +struct Options { + file: Option, + corpus: Option, + filter: Option, + limit: Option, + timeout_seconds: u64, + output: PathBuf, +} + +impl Options { + fn parse(args: Vec) -> Result { + let mut file = None; + let mut corpus = None; + let mut filter = None; + let mut limit = None; + let mut timeout_seconds = DEFAULT_TIMEOUT; + let mut output = PathBuf::from("diagnose.json"); + let mut index = 0; + while index < args.len() { + match args[index].as_str() { + "--corpus" => { + index += 1; + let Some(value) = args.get(index) else { + return Err(usage()); + }; + corpus = Some(value.clone()); + } + "--filter" => { + index += 1; + let Some(value) = args.get(index) else { + return Err(usage()); + }; + filter = Some(value.clone()); + } + "--limit" => { + index += 1; + let Some(value) = args.get(index) else { + return Err(usage()); + }; + limit = Some(value.parse().map_err(|_| usage())?); + } + "--timeout" => { + index += 1; + let Some(value) = args.get(index) else { + return Err(usage()); + }; + timeout_seconds = value.parse().map_err(|_| usage())?; + if timeout_seconds == 0 { + return Err(usage()); + } + } + "--out" => { + index += 1; + let Some(value) = args.get(index) else { + return Err(usage()); + }; + output = PathBuf::from(value); + } + value if value.starts_with('-') => return Err(usage()), + value => { + if file.replace(PathBuf::from(value)).is_some() { + return Err(usage()); + } + } + } + index += 1; + } + if file.is_some() == corpus.is_some() + || corpus.as_deref().is_some_and(|name| name != "passing") + { + return Err(usage()); + } + Ok(Self { + file, + corpus, + filter, + limit, + timeout_seconds, + output, + }) + } +} + +fn diagnose(options: Options) -> Result { + let corpus_root = options.corpus.as_ref().map(|_| corpus_root()).transpose()?; + let mode = if options.file.is_some() { + "file" + } else { + "corpus" + }; + let mut selected = if let Some(file) = &options.file { + vec![(file.clone(), None)] + } else { + let root = corpus_root.as_ref().expect("corpus mode has a root"); + let passing = root.join("passing"); + let mut paths = Vec::new(); + psrs_driver::collect_purs_files(&passing, &mut paths); + paths.sort(); + paths + .into_iter() + .filter(|path| { + options.filter.as_ref().is_none_or(|filter| { + path.strip_prefix(root) + .unwrap_or(path) + .to_string_lossy() + .contains(filter) + }) + }) + .take(options.limit.unwrap_or(usize::MAX)) + .map(|path| (path, Some(passing.clone()))) + .collect() + }; + if let Some(file) = &options.file { + if !file.is_file() { + return Err(format!("{}: file does not exist", file.display())); + } + } + + let output = absolute_path(&options.output)?; + let bundles = output.with_extension("bundles"); + let work_root = env::temp_dir().join(format!("psrs-diagnose-{}", std::process::id())); + let _ = fs::remove_dir_all(&work_root); + fs::create_dir_all(&work_root).map_err(|error| format!("{}: {error}", work_root.display()))?; + let bundle_context = BundleContext { + compiler: compiler_revision(), + trusted_stdlib_fingerprint: trusted_stdlib_fingerprint()?, + executable: env::var("PSRS_BIN") + .ok() + .or_else(|| { + env::current_exe() + .ok() + .map(|path| path.to_string_lossy().into_owned()) + }) + .unwrap_or_else(|| "psrs".into()), + }; + let mut records = Vec::with_capacity(selected.len()); + let total = selected.len(); + let mut worker_index = 0usize; + for (path, category) in selected.drain(..) { + let text = + fs::read_to_string(&path).map_err(|error| format!("{}: {error}", path.display()))?; + let display_path = corpus_root + .as_ref() + .and_then(|root| path.strip_prefix(root).ok()) + .unwrap_or(&path) + .to_string_lossy() + .into_owned(); + if options.corpus.is_some() && is_ffi_excluded(&path, &text) { + records.push(CaseRecord { + path: display_path, + input_fingerprint: fingerprint_sources(&[SourceInput { + name: path.to_string_lossy().into_owned(), + text, + }]), + input_set_complete: false, + elapsed_ms: 0, + status: CaseStatus::Excluded, + excluded_reason: Some("foreign import or adjacent JavaScript FFI file".into()), + diagnostics: Vec::new(), + first_blocker: None, + bundle: None, + }); + eprintln!( + "[{}/{}] {}: excluded (FFI)", + worker_index + 1, + total, + path.display() + ); + worker_index += 1; + continue; + } + let bundle = bundles.join(format!("{:04}-{}", worker_index, safe_name(&display_path))); + let result = run_worker( + &work_root, + worker_index, + &path, + category.as_deref(), + options.timeout_seconds, + )?; + let entry_source = vec![SourceInput { + name: path.to_string_lossy().into_owned(), + text, + }]; + let ( + status, + diagnostics, + input_fingerprint, + input_set_complete, + elapsed_ms, + blocker, + bundle_path, + ) = match result { + WorkerOutcome::Completed(response) => { + let status = if response.passed { + CaseStatus::Passed + } else { + CaseStatus::Failed + }; + let blocker = response.diagnostics.first().map(first_blocker); + if !response.passed { + write_bundle( + &bundle, + &response.sources, + &response, + &display_path, + response.input_set_complete, + &bundle_context, + )?; + } + ( + status, + response.diagnostics, + response.input_fingerprint, + response.input_set_complete, + response.elapsed_ms, + blocker, + (!response.passed).then(|| bundle.to_string_lossy().into_owned()), + ) + } + WorkerOutcome::TimedOut { elapsed_ms } => { + write_empty_bundle( + &bundle, + &entry_source, + &display_path, + "compiler worker timed out", + "", + false, + &bundle_context, + )?; + ( + CaseStatus::TimedOut, + Vec::new(), + fingerprint_sources(&entry_source), + false, + elapsed_ms, + Some(FirstBlocker { + stage: "timeout".into(), + category: "worker_timeout".into(), + message: format!("exceeded {}s", options.timeout_seconds), + }), + Some(bundle.to_string_lossy().into_owned()), + ) + } + WorkerOutcome::Crashed { + message, + stderr, + elapsed_ms, + } => { + write_empty_bundle( + &bundle, + &entry_source, + &display_path, + &message, + &stderr, + false, + &bundle_context, + )?; + ( + CaseStatus::Crashed, + Vec::new(), + fingerprint_sources(&entry_source), + false, + elapsed_ms, + Some(FirstBlocker { + stage: "worker".into(), + category: "worker_crash".into(), + message, + }), + Some(bundle.to_string_lossy().into_owned()), + ) + } + }; + eprintln!( + "[{}/{}] {}: {:?} in {} ms", + worker_index + 1, + total, + display_path, + status, + elapsed_ms + ); + records.push(CaseRecord { + path: display_path, + input_fingerprint, + input_set_complete, + elapsed_ms, + status, + excluded_reason: None, + diagnostics, + first_blocker: blocker, + bundle: bundle_path, + }); + worker_index += 1; + } + let _ = fs::remove_dir_all(&work_root); + let cohort = Cohort { + mode: mode.into(), + corpus: corpus_root.map(|root| root.to_string_lossy().into_owned()), + filter: options.filter.clone(), + limit: options.limit, + timeout_seconds: options.timeout_seconds, + trusted_stdlib_fingerprint: bundle_context.trusted_stdlib_fingerprint.clone(), + }; + let mut snapshot = Snapshot { + schema_version: SCHEMA_VERSION, + cohort, + compiler: bundle_context.compiler, + cases: records, + groups: Vec::new(), + counts: BTreeMap::new(), + }; + group_cases(&mut snapshot); + if snapshot.cases.is_empty() { + return Err("diagnosis selected no cases".into()); + } + Ok(snapshot) +} diff --git a/crates/psrs-cli/src/diagnose/report.rs b/crates/psrs-cli/src/diagnose/report.rs new file mode 100644 index 00000000..9b9f0823 --- /dev/null +++ b/crates/psrs-cli/src/diagnose/report.rs @@ -0,0 +1,290 @@ +use super::*; +use std::collections::{BTreeMap, BTreeSet}; + +pub(super) fn first_blocker(diagnostic: &DiagnosticRecord) -> FirstBlocker { + let category = diagnostic.code.as_deref().unwrap_or_else(|| { + if diagnostic.stage == "P8 CC verification" + && (diagnostic.message.starts_with("call shape mismatch:") + || diagnostic + .message + .starts_with("call result shape mismatch:")) + { + "call_shape_mismatch" + } else { + diagnostic.kind.as_deref().unwrap_or("uncoded") + } + }); + FirstBlocker { + stage: diagnostic.stage.clone(), + category: category.to_owned(), + message: diagnostic.message.clone(), + } +} + +pub(super) fn group_cases(snapshot: &mut Snapshot) { + let mut groups: BTreeMap<(String, String), (BTreeSet, BTreeSet)> = + BTreeMap::new(); + let mut counts = BTreeMap::new(); + for case in &snapshot.cases { + let key = match case.status { + CaseStatus::Passed => "passed", + CaseStatus::Failed => "failed", + CaseStatus::Excluded => "excluded", + CaseStatus::TimedOut => "timed_out", + CaseStatus::Crashed => "crashed", + }; + *counts.entry(key.to_owned()).or_default() += 1; + if let Some(first) = &case.first_blocker { + let (cases, messages) = groups + .entry((first.stage.clone(), first.category.clone())) + .or_default(); + cases.insert(case.path.clone()); + messages.insert(first.message.clone()); + } + } + snapshot.groups = groups + .into_iter() + .map(|((stage, category), (cases, messages))| GroupRecord { + stage, + category, + sample_messages: messages.into_iter().take(3).collect(), + cases: cases.into_iter().collect(), + }) + .collect(); + snapshot.groups.sort_by(|left, right| { + right + .cases + .len() + .cmp(&left.cases.len()) + .then_with(|| left.stage.cmp(&right.stage)) + }); + snapshot.counts = counts; +} + +pub(super) fn print_summary(snapshot: &Snapshot) { + println!( + "{} cases: {} passed, {} failed, {} excluded, {} timed out, {} crashed", + snapshot.cases.len(), + count(snapshot, "passed"), + count(snapshot, "failed"), + count(snapshot, "excluded"), + count(snapshot, "timed_out"), + count(snapshot, "crashed") + ); + println!( + "Largest first-blocker signatures (identical signature does not prove a shared root cause):" + ); + for group in snapshot.groups.iter().take(12) { + println!( + " {} case(s) at {} [{}]", + group.cases.len(), + group.stage, + group.category + ); + for message in &group.sample_messages { + println!(" {message}"); + } + } +} + +pub(super) fn count(snapshot: &Snapshot, key: &str) -> usize { + snapshot.counts.get(key).copied().unwrap_or(0) +} + +pub(super) fn compare(before_path: &str, after_path: &str) -> Result<(), String> { + let before: Snapshot = read_json(before_path)?; + let after: Snapshot = read_json(after_path)?; + if before.schema_version != SCHEMA_VERSION || after.schema_version != SCHEMA_VERSION { + return Err("cannot compare unsupported diagnosis snapshot schema".into()); + } + if before.cohort.mode != after.cohort.mode + || before.cohort.corpus != after.cohort.corpus + || before.cohort.filter != after.cohort.filter + || before.cohort.limit != after.cohort.limit + || before.cohort.timeout_seconds != after.cohort.timeout_seconds + || before.cohort.trusted_stdlib_fingerprint != after.cohort.trusted_stdlib_fingerprint + { + return Err("snapshot cohorts differ (mode, selected cases, timeout, or trusted stdlib); comparison is not meaningful".into()); + } + let old = before + .cases + .iter() + .map(|case| (case.path.as_str(), case)) + .collect::>(); + let new = after + .cases + .iter() + .map(|case| (case.path.as_str(), case)) + .collect::>(); + let paths = old + .keys() + .chain(new.keys()) + .copied() + .collect::>(); + let changes = paths + .into_iter() + .map(|path| { + let left = old.get(path).copied(); + let right = new.get(path).copied(); + let (change, input_comparison) = match (left, right) { + (None, Some(_)) => ("unmatched_new_case", "unavailable"), + (Some(_), None) => ("unmatched_removed_case", "unavailable"), + (Some(a), Some(b)) + if a.input_set_complete + && b.input_set_complete + && a.input_fingerprint != b.input_fingerprint => + { + ("input_changed", "changed") + } + (Some(a), Some(b)) if !a.input_set_complete || !b.input_set_complete => { + (compare_status(a, b), "incomplete") + } + (Some(a), Some(b)) => (compare_status(a, b), "same"), + (None, None) => unreachable!(), + }; + CompareRow { + path: path.to_owned(), + change: change.into(), + input_comparison: input_comparison.into(), + before: left.and_then(case_label), + after: right.and_then(case_label), + } + }) + .collect::>(); + let report = CompareReport { + compatible_cohort: true, + before_compiler: before.compiler, + after_compiler: after.compiler, + changes, + }; + println!( + "{}", + serde_json::to_string_pretty(&report).map_err(|error| error.to_string())? + ); + Ok(()) +} + +pub(super) fn compare_status(before: &CaseRecord, after: &CaseRecord) -> &'static str { + match (before.status, after.status) { + (CaseStatus::Passed, CaseStatus::Passed) => "unchanged_pass", + (CaseStatus::Passed, CaseStatus::Excluded) => "scope_changed", + (CaseStatus::Passed, _) => "regressed", + (CaseStatus::Excluded, CaseStatus::Excluded) => "unchanged_excluded", + (CaseStatus::Excluded, _) => "scope_changed", + (_, CaseStatus::Excluded) => "scope_changed", + (_, CaseStatus::Passed) => "recovered", + (CaseStatus::Failed, CaseStatus::Failed) => { + match (&before.first_blocker, &after.first_blocker) { + (Some(left), Some(right)) if left.stage != right.stage => "stage_changed", + (Some(left), Some(right)) if left.category != right.category => "category_changed", + (Some(left), Some(right)) if left.message != right.message => { + "diagnostic_details_changed" + } + _ => "unchanged_failure", + } + } + (a, b) if status_key(a) == status_key(b) => "unchanged_failure", + _ => "execution_failure_changed", + } +} + +pub(super) fn status_key(status: CaseStatus) -> &'static str { + match status { + CaseStatus::Passed => "passed", + CaseStatus::Failed => "failed", + CaseStatus::Excluded => "excluded", + CaseStatus::TimedOut => "timed_out", + CaseStatus::Crashed => "crashed", + } +} + +pub(super) fn case_label(case: &CaseRecord) -> Option { + Some(match &case.first_blocker { + Some(first) => format!("{} [{}]: {}", first.stage, first.category, first.message), + None => status_key(case.status).to_owned(), + }) +} + +#[cfg(test)] +mod tests { + use super::*; + + fn failed_case(path: &str, message: &str) -> CaseRecord { + CaseRecord { + path: path.into(), + input_fingerprint: "input".into(), + input_set_complete: true, + elapsed_ms: 1, + status: CaseStatus::Failed, + excluded_reason: None, + diagnostics: Vec::new(), + first_blocker: Some(FirstBlocker { + stage: "P8 CC verification".into(), + category: "call_shape_mismatch".into(), + message: message.into(), + }), + bundle: None, + } + } + + #[test] + fn first_blocker_groups_call_shapes_by_stable_category() { + let diagnostic = DiagnosticRecord { + origin: "source".into(), + source: Some("Main.purs".into()), + stage: "P8 CC verification".into(), + start: 4, + end: 9, + code: None, + kind: Some("InvalidCompilerIr".into()), + message: "call shape mismatch: expected Integer, got Number".into(), + }; + assert_eq!(first_blocker(&diagnostic).category, "call_shape_mismatch"); + } + + #[test] + fn grouping_keeps_distinct_messages_inside_one_stage_category() { + let mut snapshot = Snapshot { + schema_version: SCHEMA_VERSION, + cohort: Cohort { + mode: "file".into(), + corpus: None, + filter: None, + limit: None, + timeout_seconds: 20, + trusted_stdlib_fingerprint: "stdlib".into(), + }, + compiler: CompilerRevision { + head: None, + dirty: false, + working_tree_fingerprint: "tree".into(), + binary_fingerprint: "binary".into(), + }, + cases: vec![ + failed_case("A.purs", "expected Integer, got Number"), + failed_case("B.purs", "expected Integer, got Boolean"), + ], + groups: Vec::new(), + counts: BTreeMap::new(), + }; + group_cases(&mut snapshot); + assert_eq!(snapshot.groups.len(), 1); + assert_eq!(snapshot.groups[0].cases, ["A.purs", "B.purs"]); + assert_eq!(snapshot.groups[0].sample_messages.len(), 2); + } + + #[test] + fn incomplete_inputs_do_not_hide_a_pass_recovery() { + let before = CaseRecord { + status: CaseStatus::TimedOut, + input_set_complete: false, + ..failed_case("Main.purs", "worker timeout") + }; + let after = CaseRecord { + status: CaseStatus::Passed, + first_blocker: None, + ..failed_case("Main.purs", "worker timeout") + }; + assert_eq!(compare_status(&before, &after), "recovered"); + } +} diff --git a/crates/psrs-cli/src/diagnose/worker.rs b/crates/psrs-cli/src/diagnose/worker.rs new file mode 100644 index 00000000..e32c130d --- /dev/null +++ b/crates/psrs-cli/src/diagnose/worker.rs @@ -0,0 +1,290 @@ +use super::{DiagnosticRecord, SourceInput, atomic_write, fingerprint_sources, first_line}; +use serde::{Deserialize, Serialize}; +use std::path::{Path, PathBuf}; +use std::process::{Command, Stdio}; +use std::time::{Duration, Instant}; +use std::{env, fs, thread}; + +#[derive(Clone, Debug, Serialize, Deserialize)] +struct WorkerRequest { + path: String, + category_dir: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct WorkerResponse { + pub(super) passed: bool, + pub(super) input_fingerprint: String, + pub(super) sources: Vec, + pub(super) input_set_complete: bool, + pub(super) elapsed_ms: u64, + pub(super) diagnostics: Vec, + pub(super) core_stage: Option, + pub(super) core: Option, + pub(super) cc_stage: Option, + pub(super) cc: Option, + pub(super) mir_stage: Option, + pub(super) mir: Option, +} + +#[derive(Debug)] +pub(super) enum WorkerOutcome { + Completed(WorkerResponse), + TimedOut { + elapsed_ms: u64, + }, + Crashed { + message: String, + stderr: String, + elapsed_ms: u64, + }, +} + +pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { + let request_bytes = + fs::read(request_path).map_err(|error| format!("{request_path}: {error}"))?; + let request: WorkerRequest = serde_json::from_slice(&request_bytes) + .map_err(|error| format!("{request_path}: invalid worker request: {error}"))?; + let started = Instant::now(); + let entry_path = PathBuf::from(&request.path); + let entry_text = match fs::read_to_string(&entry_path) { + Ok(text) => text, + Err(error) => { + let response = WorkerResponse { + passed: false, + input_fingerprint: fingerprint_sources(&[]), + sources: Vec::new(), + input_set_complete: false, + elapsed_ms: started.elapsed().as_millis() as u64, + diagnostics: vec![DiagnosticRecord { + origin: "program".into(), + source: Some(request.path), + stage: "input loading".into(), + start: 0, + end: 0, + code: None, + kind: None, + message: format!("{}: {error}", entry_path.display()), + }], + core_stage: None, + core: None, + cc_stage: None, + cc: None, + mir_stage: None, + mir: None, + }; + return atomic_write( + Path::new(response_path), + &serde_json::to_vec(&response).map_err(|error| error.to_string())?, + ); + } + }; + let loaded = if let Some(category) = request.category_dir.as_deref() { + psrs_driver::load_program_case_sources(&entry_path, Path::new(category), &entry_text) + .map(|case| case.own.into_iter().chain(case.loaded).collect::>()) + } else { + psrs_driver::load_program_files(&[request.path.clone()]) + }; + let (sources, input_set_complete, load_error) = match loaded { + Ok(sources) => (sources, true, None), + Err(error) => (vec![(request.path.clone(), entry_text)], false, Some(error)), + }; + let inputs = sources + .iter() + .map(|(name, text)| SourceInput { + name: name.clone(), + text: text.clone(), + }) + .collect::>(); + if let Some(error) = load_error { + let response = WorkerResponse { + passed: false, + input_fingerprint: fingerprint_sources(&inputs), + sources: inputs, + input_set_complete, + elapsed_ms: started.elapsed().as_millis() as u64, + diagnostics: vec![DiagnosticRecord { + origin: "program".into(), + source: Some(request.path), + stage: "input loading".into(), + start: 0, + end: 0, + code: None, + kind: None, + message: error, + }], + core_stage: None, + core: None, + cc_stage: None, + cc: None, + mir_stage: None, + mir: None, + }; + return atomic_write( + Path::new(response_path), + &serde_json::to_vec(&response).map_err(|error| error.to_string())?, + ); + } + let sources = inputs; + let source_refs = sources + .iter() + .map(|source| (source.name.as_str(), source.text.as_str())) + .collect::>(); + let report = psrs_driver::compile_program_sources_with_prelude_report(&source_refs); + let diagnostics = report + .diagnostics + .iter() + .map(|item| { + let (origin, source) = match item.source { + psrs_driver::DiagnosticOrigin::Source(index) => ( + "source".to_owned(), + sources.get(index).map(|source| source.name.clone()), + ), + psrs_driver::DiagnosticOrigin::Library => ("library".to_owned(), None), + psrs_driver::DiagnosticOrigin::Program => ("program".to_owned(), None), + }; + DiagnosticRecord { + origin, + source, + stage: item.diagnostic.stage.to_owned(), + start: item.diagnostic.span.start, + end: item.diagnostic.span.end, + code: item.diagnostic.code.map(str::to_owned), + kind: item.diagnostic.kind.map(|kind| format!("{kind:?}")), + message: item.diagnostic.message.clone(), + } + }) + .collect::>(); + let response = WorkerResponse { + passed: report.artifact.is_some(), + input_fingerprint: fingerprint_sources(&sources), + sources, + input_set_complete, + elapsed_ms: started.elapsed().as_millis() as u64, + diagnostics, + core_stage: report.dumps.core_stage.map(str::to_owned), + core: report.dumps.core, + cc_stage: report.dumps.cc_stage.map(str::to_owned), + cc: report.dumps.cc, + mir_stage: report.dumps.mir_stage.map(str::to_owned), + mir: report.dumps.mir, + }; + atomic_write( + Path::new(response_path), + &serde_json::to_vec(&response).map_err(|error| error.to_string())?, + ) +} + +#[cfg(test)] +mod tests { + use super::*; + use std::time::{SystemTime, UNIX_EPOCH}; + + #[test] + fn missing_entry_is_a_loading_error_without_fabricated_source() { + let unique = SystemTime::now() + .duration_since(UNIX_EPOCH) + .expect("clock after UNIX epoch") + .as_nanos(); + let root = env::temp_dir().join(format!("psrs-diagnose-worker-{unique}")); + fs::create_dir_all(&root).expect("create worker test directory"); + let missing = root.join("missing.purs"); + let request_path = root.join("request.json"); + let response_path = root.join("response.json"); + let request = WorkerRequest { + path: missing.to_string_lossy().into_owned(), + category_dir: None, + }; + fs::write( + &request_path, + serde_json::to_vec(&request).expect("serialize worker request"), + ) + .expect("write worker request"); + + worker( + request_path.to_str().expect("request path is UTF-8"), + response_path.to_str().expect("response path is UTF-8"), + ) + .expect("worker writes loading-error response"); + let response: WorkerResponse = + serde_json::from_slice(&fs::read(&response_path).expect("read worker response")) + .expect("parse worker response"); + + assert!(!response.passed); + assert!(!response.input_set_complete); + assert!(response.sources.is_empty()); + assert_eq!(response.diagnostics[0].stage, "input loading"); + assert!(response.diagnostics[0].message.contains("missing.purs")); + let _ = fs::remove_dir_all(root); + } +} + +pub(super) fn run_worker( + work_root: &Path, + index: usize, + path: &Path, + category_dir: Option<&Path>, + timeout_seconds: u64, +) -> Result { + let worker_dir = work_root.join(format!("case-{index}")); + let _ = fs::remove_dir_all(&worker_dir); + fs::create_dir_all(&worker_dir) + .map_err(|error| format!("{}: {error}", worker_dir.display()))?; + let request_path = worker_dir.join("request.json"); + let response_path = worker_dir.join("response.json"); + let stderr_path = worker_dir.join("stderr.log"); + let request = WorkerRequest { + path: path.to_string_lossy().into_owned(), + category_dir: category_dir.map(|path| path.to_string_lossy().into_owned()), + }; + fs::write( + &request_path, + serde_json::to_vec(&request).map_err(|error| error.to_string())?, + ) + .map_err(|error| format!("{}: {error}", request_path.display()))?; + let stderr = fs::File::create(&stderr_path) + .map_err(|error| format!("{}: {error}", stderr_path.display()))?; + let executable = env::current_exe().map_err(|error| error.to_string())?; + let mut child = Command::new(executable) + .arg("__diagnose-worker") + .arg(&request_path) + .arg(&response_path) + .stdin(Stdio::null()) + .stdout(Stdio::null()) + .stderr(Stdio::from(stderr)) + .spawn() + .map_err(|error| format!("could not start compiler worker: {error}"))?; + let started = Instant::now(); + loop { + if let Some(status) = child.try_wait().map_err(|error| error.to_string())? { + let result = if response_path.is_file() { + let bytes = fs::read(&response_path).map_err(|error| error.to_string())?; + serde_json::from_slice(&bytes) + .map_err(|error| format!("worker returned invalid report: {error}"))? + } else { + let stderr = fs::read_to_string(&stderr_path).unwrap_or_default(); + let message = if stderr.trim().is_empty() { + format!("worker exited with {status} before writing a report") + } else { + first_line(&stderr).to_owned() + }; + return Ok(WorkerOutcome::Crashed { + message, + stderr, + elapsed_ms: started.elapsed().as_millis() as u64, + }); + }; + return Ok(WorkerOutcome::Completed(result)); + } + if started.elapsed() >= Duration::from_secs(timeout_seconds) { + child + .kill() + .map_err(|error| format!("could not stop timed-out worker: {error}"))?; + let _ = child.wait(); + return Ok(WorkerOutcome::TimedOut { + elapsed_ms: started.elapsed().as_millis() as u64, + }); + } + thread::sleep(Duration::from_millis(15)); + } +} diff --git a/crates/psrs-cli/src/main.rs b/crates/psrs-cli/src/main.rs index f727b2d9..35237b0f 100644 --- a/crates/psrs-cli/src/main.rs +++ b/crates/psrs-cli/src/main.rs @@ -2,6 +2,8 @@ use psrs_span::{SourceFile, TextRange}; use psrs_syntax::{LayoutTokenKind, RawToken, RawTokenKind, add_layout, lex, parse_module}; use std::{env, fs, process::ExitCode}; +mod diagnose; + fn main() -> ExitCode { match run() { Ok(()) => ExitCode::SUCCESS, @@ -19,6 +21,17 @@ fn run() -> Result<(), String> { let Some(command) = args.next() else { return Err(usage()); }; + if command == "__diagnose-worker" { + let request = args.next().ok_or_else(usage)?; + let response = args.next().ok_or_else(usage)?; + if args.next().is_some() { + return Err(usage()); + } + return diagnose::worker(&request, &response); + } + if command == "diagnose" { + return diagnose::run(args.collect()); + } if command == "check-program" { let paths: Vec = args.collect(); if paths.is_empty() { @@ -256,7 +269,7 @@ fn compile_program(command: &str, raw_args: Vec) -> Result<(), String> { } fn usage() -> String { - "usage: psrs \n psrs check-program ...\n psrs check-program-kinds ...\n psrs build ... [-o output.wasm]\n psrs wat ... [-o output.wat]\n psrs dump ".into() + "usage: psrs \n psrs check-program ...\n psrs check-program-kinds ...\n psrs build ... [-o output.wasm]\n psrs wat ... [-o output.wat]\n psrs dump \n psrs diagnose [--out report.json]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--out report.json]\n psrs diagnose --compare OLD.json NEW.json".into() } fn check_program(paths: &[String], kinds: bool) -> Result<(), String> { diff --git a/crates/psrs-cli/tests/cli.rs b/crates/psrs-cli/tests/cli.rs index 20cd789a..09405f15 100644 --- a/crates/psrs-cli/tests/cli.rs +++ b/crates/psrs-cli/tests/cli.rs @@ -133,3 +133,77 @@ fn check_commands_print_typecheck_warnings() { let _ = std::fs::remove_dir_all(root); } + +#[test] +fn diagnose_writes_a_diagnostic_bundle_that_replays_outside_the_bundle() { + use std::time::{SystemTime, UNIX_EPOCH}; + + let unique = SystemTime::now() + .duration_since(UNIX_EPOCH) + .expect("clock after UNIX epoch") + .as_nanos(); + let root = + std::env::temp_dir().join(format!("psrs-diagnose-cli-{}-{unique}", std::process::id())); + std::fs::create_dir_all(&root).expect("create diagnosis test directory"); + let source = root.join("Broken.purs"); + let snapshot = root.join("snapshot.json"); + std::fs::write(&source, "module Broken where\nmain = @\n").expect("write malformed source"); + + let result = Command::new(env!("CARGO_BIN_EXE_psrs")) + .args([ + "diagnose", + source.to_str().expect("source path is UTF-8"), + "--out", + snapshot.to_str().expect("snapshot path is UTF-8"), + ]) + .output() + .expect("run psrs diagnose"); + assert!( + result.status.success(), + "diagnosis command failed: {}", + String::from_utf8_lossy(&result.stderr) + ); + + let report: serde_json::Value = + serde_json::from_slice(&std::fs::read(&snapshot).expect("read diagnosis snapshot")) + .expect("parse diagnosis snapshot"); + let case = &report["cases"][0]; + assert_eq!(case["status"], "failed"); + assert_eq!(case["input_set_complete"], true); + let diagnostic = &case["diagnostics"][0]; + assert!(!diagnostic["stage"].as_str().unwrap_or_default().is_empty()); + assert!( + !diagnostic["message"] + .as_str() + .unwrap_or_default() + .is_empty() + ); + + let bundle = std::path::PathBuf::from( + case["bundle"] + .as_str() + .expect("failed case has bundle path"), + ); + assert!(bundle.join("case.json").is_file()); + assert!(bundle.join("inputs/0000-Broken.purs").is_file()); + let replay = Command::new("sh") + .arg(bundle.join("replay.sh")) + .current_dir(&root) + .output() + .expect("replay diagnosis bundle from outside its directory"); + assert!( + !replay.status.success(), + "broken source unexpectedly compiled" + ); + let replay_output = format!( + "{}{}", + String::from_utf8_lossy(&replay.stdout), + String::from_utf8_lossy(&replay.stderr) + ); + assert!( + replay_output.contains(diagnostic["message"].as_str().unwrap()), + "replay did not reproduce the recorded diagnostic: {replay_output}" + ); + + let _ = std::fs::remove_dir_all(root); +} diff --git a/crates/psrs-driver/src/diagnostics.rs b/crates/psrs-driver/src/diagnostics.rs new file mode 100644 index 00000000..000351dd --- /dev/null +++ b/crates/psrs-driver/src/diagnostics.rs @@ -0,0 +1,31 @@ +use crate::{Artifact, ProgramDiagnostic}; + +/// IR dumps retained when a program reaches only part of the compile pipeline. +/// A stage name records exactly which pass produced the dump. +#[derive(Clone, Debug, Default, PartialEq, Eq)] +pub struct PartialIrDumps { + pub core_stage: Option<&'static str>, + pub core: Option, + pub cc_stage: Option<&'static str>, + pub cc: Option, + pub mir_stage: Option<&'static str>, + pub mir: Option, +} + +/// Result of one whole-program compile attempt, including partial IR on failure. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct CompilationReport { + pub artifact: Option, + pub diagnostics: Vec, + pub dumps: PartialIrDumps, +} + +impl CompilationReport { + pub(crate) fn failed(diagnostics: Vec, dumps: PartialIrDumps) -> Self { + Self { + artifact: None, + diagnostics, + dumps, + } + } +} diff --git a/crates/psrs-driver/src/lib.rs b/crates/psrs-driver/src/lib.rs index e74874c1..ff3d495b 100644 --- a/crates/psrs-driver/src/lib.rs +++ b/crates/psrs-driver/src/lib.rs @@ -1,16 +1,21 @@ use psrs_span::{SourceFile, TextRange}; +mod diagnostics; mod loader; mod prelude; mod program; -pub use loader::load_program_files; +pub use diagnostics::{CompilationReport, PartialIrDumps}; + +pub use loader::{ + ProgramCaseSources, collect_purs_files, load_program_case_sources, load_program_files, +}; pub use program::{ check_program, check_program_kinds_lenient, check_program_kinds_lenient_with_prelude, check_program_lenient, check_program_lenient_with_prelude, check_program_types_lenient, check_program_types_lenient_with_prelude, check_program_with_warnings, compile_program_sources, - compile_program_sources_with_prelude, resolve_program_sources, typecheck_program_sources, - typecheck_program_sources_with_warnings, + compile_program_sources_with_prelude, compile_program_sources_with_prelude_report, + resolve_program_sources, typecheck_program_sources, typecheck_program_sources_with_warnings, }; #[derive(Clone, Debug, PartialEq, Eq)] diff --git a/crates/psrs-driver/src/loader.rs b/crates/psrs-driver/src/loader.rs index 5f31b474..6705614b 100644 --- a/crates/psrs-driver/src/loader.rs +++ b/crates/psrs-driver/src/loader.rs @@ -11,6 +11,81 @@ use crate::lower_source_to_ast; use std::collections::{HashMap, HashSet, VecDeque}; use std::path::{Path, PathBuf}; +/// Source files that make up a corpus case: the main file, its optional +/// same-stem support directory, and the transitive imports the normal loader +/// discovers for those entry files. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ProgramCaseSources { + pub own: Vec<(String, String)>, + pub loaded: Vec<(String, String)>, +} + +impl ProgramCaseSources { + pub fn inputs(&self) -> Vec<(&str, &str)> { + self.own + .iter() + .chain(&self.loaded) + .map(|(path, text)| (path.as_str(), text.as_str())) + .collect() + } +} + +/// Assembles one suite case using the compiler's regular import loader. +/// Files beside a category root are independent; a same-stem subdirectory is +/// searched only when the case itself lives below that root. +pub fn load_program_case_sources( + path: &Path, + category_dir: &Path, + main_text: &str, +) -> Result { + let mut own = vec![(path.to_string_lossy().into_owned(), main_text.to_owned())]; + let support_dir = path.with_extension(""); + if support_dir.is_dir() { + let mut support = Vec::new(); + collect_purs_files(&support_dir, &mut support); + support.sort(); + for support_path in support { + let text = std::fs::read_to_string(&support_path) + .map_err(|error| format!("{}: {error}", support_path.display()))?; + own.push((support_path.to_string_lossy().into_owned(), text)); + } + } + + let own_directory = path.parent() != Some(category_dir); + let loaded = if own_directory { + let entry_paths = own + .iter() + .skip(1) + .map(|(path, _)| path.clone()) + .chain(std::iter::once(path.to_string_lossy().into_owned())) + .collect::>(); + load_program_files(&entry_paths)? + .into_iter() + .filter(|(loaded, _)| !own.iter().any(|(own, _)| own == loaded)) + .collect() + } else { + Vec::new() + }; + Ok(ProgramCaseSources { own, loaded }) +} + +pub fn collect_purs_files(dir: &Path, out: &mut Vec) { + let Ok(entries) = std::fs::read_dir(dir) else { + return; + }; + for entry in entries.filter_map(Result::ok) { + let path = entry.path(); + if path.is_dir() { + collect_purs_files(&path, out); + } else if path + .extension() + .is_some_and(|extension| extension == "purs") + { + out.push(path); + } + } +} + /// Loads the entry files plus every transitively imported user module found on /// disk. Returns `(path, text)` pairs; the order is discovery order, and P3 /// orders modules by dependency. An unreadable entry file is an error. diff --git a/crates/psrs-driver/src/program/compilation.rs b/crates/psrs-driver/src/program/compilation.rs new file mode 100644 index 00000000..98f3c49b --- /dev/null +++ b/crates/psrs-driver/src/program/compilation.rs @@ -0,0 +1,133 @@ +use super::{lower_program_to_core_and_effect_context, typecheck_warnings}; +use crate::{ + Artifact, CompilationReport, Diagnostic, DiagnosticOrigin, PartialIrDumps, ProgramDiagnostic, + backend_warnings, +}; + +/// Compiles a whole program to a single Wasm component. +pub fn compile_program_sources( + sources: &[(&str, &str)], +) -> Result> { + compile_program_sources_with_trusted_prefix(sources, 0) +} + +pub(crate) fn compile_program_sources_with_trusted_prefix( + sources: &[(&str, &str)], + trusted_prefix: usize, +) -> Result> { + let report = compile_attempt(sources, trusted_prefix, false); + match report.artifact { + Some(artifact) => Ok(artifact), + None => Err(report.diagnostics), + } +} + +pub(crate) fn compile_program_sources_with_trusted_prefix_report( + sources: &[(&str, &str)], + trusted_prefix: usize, +) -> CompilationReport { + compile_attempt(sources, trusted_prefix, true) +} + +fn compile_attempt( + sources: &[(&str, &str)], + trusted_prefix: usize, + capture: bool, +) -> CompilationReport { + let (core, source_warnings, effect_context) = + match lower_program_to_core_and_effect_context(sources, trusted_prefix) { + Ok(lowered) => lowered, + Err(diagnostics) => { + return CompilationReport::failed(diagnostics, PartialIrDumps::default()); + } + }; + if capture { + let linked_core = core.clone(); + let stages = match psrs_backend::compile_with_context_capturing( + core, + effect_context, + psrs_backend::TargetCapabilities::default(), + ) { + Ok(stages) => stages, + Err(failure) => { + let mut dumps = PartialIrDumps::default(); + let (core, stage) = match failure.partial.core { + Some(core) => (core, "P7 Core optimization"), + None => (linked_core, "P7 Core verification"), + }; + dumps.core_stage = Some(stage); + dumps.core = Some(format!("{core:#?}")); + if let Some(cc) = failure.partial.cc { + dumps.cc_stage = Some("P8 closure conversion (verified)"); + dumps.cc = Some(format!("{cc:#?}")); + } + if let Some(mir) = failure.partial.mir { + dumps.mir_stage = failure.partial.mir_stage; + dumps.mir = Some(format!("{mir:#?}")); + } + return CompilationReport::failed(backend_diagnostics(failure.errors), dumps); + } + }; + return success_report(stages, source_warnings, trusted_prefix, true); + } + + match psrs_backend::compile_with_context( + core, + effect_context, + psrs_backend::TargetCapabilities::default(), + ) { + Ok(stages) => success_report(stages, source_warnings, trusted_prefix, false), + Err(errors) => { + CompilationReport::failed(backend_diagnostics(errors), PartialIrDumps::default()) + } + } +} + +fn success_report( + stages: psrs_backend::Stages, + source_warnings: Vec, + trusted_prefix: usize, + capture: bool, +) -> CompilationReport { + let mut warnings = typecheck_warnings(source_warnings, trusted_prefix); + warnings.extend(backend_warnings(stages.artifact.warnings, trusted_prefix)); + let dumps = if capture { + PartialIrDumps { + core_stage: Some("P7 Core optimization"), + core: Some(format!("{:#?}", stages.core)), + cc_stage: Some("P8 closure conversion (verified)"), + cc: Some(format!("{:#?}", stages.cc)), + mir_stage: Some("P10 MIR optimization"), + mir: Some(format!("{:#?}", stages.mir)), + } + } else { + PartialIrDumps::default() + }; + CompilationReport { + artifact: Some(Artifact { + wasm: stages.artifact.wasm, + wat: stages.artifact.wat, + warnings, + }), + diagnostics: Vec::new(), + dumps, + } +} + +fn backend_diagnostics(errors: Vec) -> Vec { + errors + .into_iter() + .map(|error| ProgramDiagnostic { + source: error.module.map_or(DiagnosticOrigin::Program, |module| { + DiagnosticOrigin::Source(module.0 as usize) + }), + diagnostic: Diagnostic { + stage: error.pass, + span: error.span, + message: error.message, + code: None, + kind: Some(error.kind), + }, + }) + .collect() +} diff --git a/crates/psrs-driver/src/program/library.rs b/crates/psrs-driver/src/program/library.rs index 2d1f4c8d..2fe4af0c 100644 --- a/crates/psrs-driver/src/program/library.rs +++ b/crates/psrs-driver/src/program/library.rs @@ -1,11 +1,11 @@ //! Prepends the on-disk standard library as the trusted source prefix. use super::{ - Artifact, check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, + check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, compile_program_sources_with_trusted_prefix, diagnostic, }; use crate::prelude; -use crate::{DiagnosticOrigin, ProgramDiagnostic}; +use crate::{Artifact, CompilationReport, DiagnosticOrigin, ProgramDiagnostic}; /// Compiles user sources together with the on-disk standard library. /// @@ -21,6 +21,19 @@ pub fn compile_program_sources_with_prelude( .map_err(|errors| shift(errors, trusted_prefix)) } +/// Compiles with the trusted library and retains the last successful IR stages +/// for diagnosis. Backend diagnostics keep their source origin and error kind. +pub fn compile_program_sources_with_prelude_report(sources: &[(&str, &str)]) -> CompilationReport { + let (all_sources, trusted_prefix) = match with_prelude(sources) { + Ok(sources) => sources, + Err(errors) => return CompilationReport::failed(errors, Default::default()), + }; + let mut report = + super::compile_program_sources_with_trusted_prefix_report(&all_sources, trusted_prefix); + report.diagnostics = shift(report.diagnostics, trusted_prefix); + report +} + /// Resolves user sources leniently together with the on-disk standard library. /// /// A lenient check tolerates imports whose modules are not provided at all, so a diff --git a/crates/psrs-driver/src/program/mod.rs b/crates/psrs-driver/src/program/mod.rs index e5dcb152..d396704c 100644 --- a/crates/psrs-driver/src/program/mod.rs +++ b/crates/psrs-driver/src/program/mod.rs @@ -2,19 +2,25 @@ //! checking against imported signatures, Core lowering, and linking. use super::{ - Artifact, DiagnosticOrigin, ProgramDiagnostic, ProgramWarning, Warning, backend_warnings, - coded_diagnostic, diagnostic, lower_source_to_ast, + DiagnosticOrigin, ProgramDiagnostic, ProgramWarning, Warning, coded_diagnostic, diagnostic, + lower_source_to_ast, }; +pub use compilation::compile_program_sources; +pub(super) use compilation::{ + compile_program_sources_with_trusted_prefix, compile_program_sources_with_trusted_prefix_report, +}; pub use lenient::{ check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, }; pub use library::{ check_program_kinds_lenient_with_prelude, check_program_lenient_with_prelude, check_program_types_lenient_with_prelude, compile_program_sources_with_prelude, + compile_program_sources_with_prelude_report, }; use std::collections::{HashMap, HashSet}; +mod compilation; mod effects; mod graph; mod lenient; @@ -42,45 +48,6 @@ fn desugar_diagnostic(error: psrs_desugar::DesugarError) -> super::Diagnostic { use graph::{imported_instance_declarations, module_dependencies, module_table, typecheck_order}; -/// Compiles a whole program to a single Wasm component. Every module is type -/// checked in dependency order and lowered to Core; the modules are then linked -/// into one before the backend runs. -pub fn compile_program_sources( - sources: &[(&str, &str)], -) -> Result> { - compile_program_sources_with_trusted_prefix(sources, 0) -} - -fn compile_program_sources_with_trusted_prefix( - sources: &[(&str, &str)], - trusted_prefix: usize, -) -> Result> { - let (core, source_warnings, effect_context) = - lower_program_to_core_and_effect_context(sources, trusted_prefix)?; - let output = match effect_context { - Some(context) => psrs_backend::compile_with_effect_context(core, context), - None => psrs_backend::compile(core), - } - .map_err(|errors| { - errors - .into_iter() - .map(|error| ProgramDiagnostic { - source: error.module.map_or(DiagnosticOrigin::Program, |module| { - DiagnosticOrigin::Source(module.0 as usize) - }), - diagnostic: diagnostic(error.pass, error.span, error.message), - }) - .collect::>() - })?; - let mut warnings = typecheck_warnings(source_warnings, trusted_prefix); - warnings.extend(backend_warnings(output.warnings, trusted_prefix)); - Ok(Artifact { - wasm: output.wasm, - wat: output.wat, - warnings, - }) -} - #[cfg(test)] pub(crate) fn lower_program_to_core( sources: &[(&str, &str)], diff --git a/crates/psrs-driver/tests/suite/corpus/mod.rs b/crates/psrs-driver/tests/suite/corpus/mod.rs index c9c8bfc4..2b636488 100644 --- a/crates/psrs-driver/tests/suite/corpus/mod.rs +++ b/crates/psrs-driver/tests/suite/corpus/mod.rs @@ -48,17 +48,7 @@ pub fn collected_files(dir: &Path, limit: Option) -> Vec { } pub fn collect_purs_files(dir: &Path, out: &mut Vec) { - let Ok(entries) = std::fs::read_dir(dir) else { - return; - }; - for entry in entries.filter_map(|entry| entry.ok()) { - let path = entry.path(); - if path.is_dir() { - collect_purs_files(&path, out); - } else if path.extension().is_some_and(|ext| ext == "purs") { - out.push(path); - } - } + psrs_driver::collect_purs_files(dir, out); } /// One corpus case, assembled the way the compiler loads a program. @@ -127,30 +117,12 @@ impl Case { /// dependencies there, and that subdirectory is searched first, so its support /// modules win over anything found beside the case. pub fn load_case(path: &Path, category_dir: &Path, text: &str) -> Case { - let own = own_sources(path, text); let own_directory = path.parent() != Some(category_dir); - let loaded = if !own_directory { - Vec::new() - } else { - let entry = own - .iter() - .skip(1) - .map(|(path, _)| path.clone()) - .chain(std::iter::once(path.to_string_lossy().into_owned())) - .collect::>(); - match psrs_driver::load_program_files(&entry) { - Ok(sources) => sources - .into_iter() - .filter(|(loaded, _)| !own.iter().any(|(own, _)| own == loaded)) - .collect(), - // The loader only fails on an unreadable entry file, which the case - // sources above have already read. - Err(_) => Vec::new(), - } - }; + let sources = psrs_driver::load_program_case_sources(path, category_dir, text) + .expect("a previously read suite case and its support files remain readable"); Case { - own, - loaded, + own: sources.own, + loaded: sources.loaded, directory: path.parent().unwrap_or(Path::new(".")).to_path_buf(), own_directory, } @@ -159,19 +131,9 @@ pub fn load_case(path: &Path, category_dir: &Path, text: &str) -> Case { /// The main source plus the modules in a sibling directory named after the file /// stem, which is how the corpus supplies a case's support modules. pub fn own_sources(path: &Path, text: &str) -> Vec<(String, String)> { - let mut sources = vec![(path.to_string_lossy().into_owned(), text.to_owned())]; - let support_dir = path.with_extension(""); - if support_dir.is_dir() { - let mut files = Vec::new(); - collect_purs_files(&support_dir, &mut files); - files.sort(); - for support in files { - if let Ok(text) = std::fs::read_to_string(&support) { - sources.push((support.to_string_lossy().into_owned(), text)); - } - } - } - sources + psrs_driver::load_program_case_sources(path, path.parent().unwrap_or(Path::new(".")), text) + .map(|sources| sources.own) + .unwrap_or_else(|_| vec![(path.to_string_lossy().into_owned(), text.to_owned())]) } /// Why a case is blocked, split so the phase that recovers it is visible. diff --git a/docs/README.md b/docs/README.md index 14022ba9..24319264 100644 --- a/docs/README.md +++ b/docs/README.md @@ -15,12 +15,19 @@ Project documentation is written in English and grouped by purpose: | [F-01: Source inspection](feature/F-01-source-inspection.md) | [Frontend and IR boundaries](design/D-01-frontend-and-ir-boundaries.md) | In progress | | [F-02: Build portable programs](feature/F-02-portable-programs.md) | [Backend design](design/backend/README.md) | In progress | | [F-03: PSRS Explorer](feature/F-03-interactive-ir-explorer.md) | [PSRS Explorer](design/D-14-interactive-ir-explorer.md) | In progress | +| [F-04: Diagnose compile failures](feature/F-04-compile-diagnosis.md) | [Compile failure diagnosis](design/D-16-compile-diagnosis.md) | In progress | Decision records use the `DEC-XX` prefix. See [decision policy](decision/README.md). The [authoring guide](authoring-guide.md) is the reference for where a document goes, how it is named, the topic design document template, and how to state a measured number. +## Contributor workflows + +- [Compiler iteration SOP](workflow/compiler-iteration-sop.md): diagnose a + baseline, locate the responsible stage contract, implement a bounded fix, and + compare the same cases afterward. + ## Compiler design The [frontend design](design/frontend/README.md) groups syntax, semantic diff --git a/docs/authoring-guide.md b/docs/authoring-guide.md index 8d114968..c582ebcf 100644 --- a/docs/authoring-guide.md +++ b/docs/authoring-guide.md @@ -15,6 +15,7 @@ except `AGENTS.md` and the root `README.md`. | Implementation and IR architecture | `docs/design/` | | A major, durable decision only | `docs/decision/DEC-XX-.md` | | Per-topic acceptance checklists and evidence | `docs/implementation/` | +| Contributor process and repeatable workflows | `docs/workflow/` | ## Naming and identity diff --git a/docs/design/D-16-compile-diagnosis.md b/docs/design/D-16-compile-diagnosis.md new file mode 100644 index 00000000..bd24d6a2 --- /dev/null +++ b/docs/design/D-16-compile-diagnosis.md @@ -0,0 +1,69 @@ +# D-16 — Compile Failure Diagnosis + +**Status:** Draft + +**Implements:** [F-04 — Diagnose Compile Failures](../feature/F-04-compile-diagnosis.md) + +## Purpose + +`psrs diagnose` runs one source file or a selected part of the vendored +`passing` corpus through the normal compiler pipeline. It records the first +blocking stage and category for each case, keeps every diagnostic with its +source origin, and writes a versioned JSON snapshot that can be compared with a +later compiler revision. Failure bundles retain the exact loaded user modules, +the replay arguments, and every IR stage that completed successfully. + +## Commands + +```sh +cargo run -p psrs-cli -- diagnose path/to/Main.purs --out /tmp/main.json +cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ + --out /tmp/functor.json --timeout 20 +cargo run -p psrs-cli -- diagnose --compare /tmp/before.json /tmp/after.json +``` + +The corpus command uses `tests/upstream` unless `PURESCRIPT_REPO` selects an +official checkout. It applies the path filter before the limit. Cases with +foreign imports or adjacent JavaScript FFI files are recorded as `excluded`; +they do not count as passes. + +Each selected case runs in its own child process. `--timeout` is a per-case +deadline in seconds. A timeout or crash is captured as a case result, and the +batch continues. Progress and elapsed time are printed to stderr. Compiler +rejections are snapshot data and do not make the diagnosis command itself fail; +invalid options, missing files, or report I/O errors do. + +## Snapshot and comparison + +The JSON snapshot records the selected cohort, the trusted-library fingerprint, +the compiler commit, dirty-tree fingerprint and executable fingerprint, every +case's input fingerprint and elapsed time, and its full ordered diagnostic list. +Source, trusted-library and program-wide origins remain distinct. A failed +backend attempt includes the last successful Core, verified CC, and MIR dumps +available from the shared compile pipeline; an unverified CC candidate is never +presented as a completed stage. + +Summary groups use first-blocker stage and stable diagnostic category. The full +message and span stay on each case, and a shared group is only a matching +diagnostic signature; it does not claim the cases share one root cause. + +Snapshots compare only when corpus mode, selected path filter and limit, +timeout, and trusted-library fingerprint match. Compiler revision may differ. +For cases with complete input sets, changed module contents are reported as +`input_changed`. If a worker timed out or crashed before loading all modules, +the case is still compared by observed status and the report marks input +comparison as incomplete. New and removed paths are listed as unmatched rather +than counted as regressions or recoveries. + +Each failed case gets a directory beside the snapshot with numbered source +files, `case.json`, and `replay.sh`. The bundle records whether module loading +completed. `core.debug`, `cc.debug`, and `mir.debug` are present only when the +named stage completed; the adjacent `.stage` file gives the producing pass. +`replay.sh` runs the same CLI binary recorded in the bundle by default. Set +`PSRS_BIN` to choose another compiler executable. + +## Scope + +This tool measures compile acceptance and locates the first compiler-reported +blocker. It does not execute generated Wasm, diagnose runtime traps, reduce a +source file automatically, or prove a grouped failure has a common cause. diff --git a/docs/feature/F-04-compile-diagnosis.md b/docs/feature/F-04-compile-diagnosis.md new file mode 100644 index 00000000..3f53ced5 --- /dev/null +++ b/docs/feature/F-04-compile-diagnosis.md @@ -0,0 +1,46 @@ +# F-04 — Diagnose Compile Failures + +**Status:** In progress + +**Design:** [D-16 — Compile Failure Diagnosis](../design/D-16-compile-diagnosis.md) + +## User need + +Compiler contributors need a repeatable way to find which stage stops a source +case, compare compile acceptance across revisions, and replay a failure without +reconstructing its module inputs by hand. + +## User-visible behavior + +Given a source file or a selected part of the `passing` corpus, contributors can +run `psrs diagnose` to get a versioned JSON report. The report lists each +diagnostic and its source, groups cases by first-blocker stage and category, and +records exclusions, timeouts, crashes, and elapsed time separately from passes. +Each failed case produces a replay bundle with its loaded source files and any +compiler-stage details that completed successfully. + +Two compatible reports can be compared case by case. The comparison shows +recovered and regressed cases, stage or category changes, changed source inputs, +and paths that occur in only one snapshot. It identifies cases whose full input +set was not captured before a timeout or crash. + +## Acceptance criteria + +- A single source file can be diagnosed with a per-case deadline. +- The selected corpus subset reports progress and records FFI exclusions without + counting them as passing cases. +- Every case retains all ordered diagnostics and the origin of each diagnostic. +- A failure bundle contains exact loaded user modules, replay arguments, and + dumps only for stages that completed successfully. +- A worker timeout or crash is isolated to its case, retains available process + output, and does not stop the remaining selected cases. +- Snapshot comparison rejects incompatible trusted-library or selection + cohorts and reports new or removed paths as unmatched. +- Compile outcomes remain data in a completed report; command failure indicates + invalid options or an operational error such as missing input or unwritable + output. + +## Out of scope + +This workflow does not run generated Wasm, attribute runtime traps, reduce a +program automatically, or prove that matching diagnostics share a root cause. diff --git a/docs/workflow/compiler-iteration-sop.md b/docs/workflow/compiler-iteration-sop.md new file mode 100644 index 00000000..b357d371 --- /dev/null +++ b/docs/workflow/compiler-iteration-sop.md @@ -0,0 +1,128 @@ +# Compiler Iteration SOP + +Use this workflow when investigating compile failures or making a compiler +change. It turns a failing case into reproducible evidence, helps locate the +semantic owner of a defect, and checks the same inputs after a change. + +For roadmap work, first select an issue using the phase and dependency rules in +[`AGENTS.md`](../../AGENTS.md#choosing-the-next-item), then read its references +and validation requirements. Diagnosis helps investigate the selected work; it +does not replace roadmap priority or acceptance evidence. + +## 1. Capture the starting point + +Record the branch, commit, and existing worktree changes. Choose one reproducer +or a small corpus cohort that reaches the relevant feature. Save the report +outside the source tree so the generated JSON and bundles do not change the +working-tree fingerprint recorded in the next report. + +```sh +# One file, including its imported modules and a replay bundle. +cargo run -p psrs-cli -- diagnose path/to/Main.purs \ + --out /tmp/psrs-before.json --timeout 20 + +# A bounded, repeatable corpus cohort. The filter is applied before the limit. +cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ + --out /tmp/psrs-before.json --timeout 20 +``` + +Compiler rejections are recorded in the report and do not make the diagnosis +command fail. A nonzero command result indicates an operational problem such as +invalid arguments, missing inputs, or an output error. Timeouts, crashes, and +FFI exclusions are separate outcomes; none counts as a successful compile. + +## 2. Find the first blocking boundary + +Start with the first blocker stage and category, then inspect the case's full +ordered diagnostics. Keep source, trusted-library, and program-level origins +distinct. A library-origin diagnostic may be triggered by a user module, but +that does not establish which implementation is wrong. + +Open a representative failure bundle. Its `case.json` records the case and +inputs; `replay.sh` reruns it with the recorded compiler. Override the executable +when comparing a different build: + +```sh +BUNDLE=/tmp/psrs-before.bundles/0000-Functor +PSRS_BIN="$PWD/target/debug/psrs" sh "$BUNDLE/replay.sh" +``` + +Use the bundle directory recorded in the report; the example name above is +illustrative. + +Inspect only IR dumps whose `.stage` file says the stage completed. A missing +dump means that stage did not produce a completed result. Use the last +successful representation to locate where the invariant first stops holding. + +Failure groups are matching diagnostic signatures, not proven shared causes. +Use group size to estimate reach, then verify representatives from the group +before treating one owner hypothesis as established. Preserve the distinction +between the number of cases grouped and the number whose root cause has been +confirmed. + +## 3. Reduce and identify the owner + +Make a small reproducer from the replay bundle while preserving required imports +and declarations. State the expected behavior, actual diagnostic or output, and +the earliest representation where they diverge. + +Read the governing design and identify the stage that owns the rule. Check the +input and output invariants of the adjacent stages. Prefer repairing a shared +representation or operation when multiple forms rely on it. Avoid a +feature-specific backend workaround when the earlier representation or calling +contract is wrong. Keep a concrete next hypothesis; when an investigation pass +produces no falsifiable next step, save the evidence and narrow the unanswered +boundary before adding more speculative changes. + +For roadmap work, the issue and board rules still decide which work comes next. +Among cases within that work, use affected-case count and downstream dependencies +to choose investigation order; a large signature group alone does not prove +cause or raise an issue's roadmap priority. + +## 4. Validate the change at each affected layer + +Run a focused test or replay that covers the reduced case and the relevant +rejection path. Then rerun the same diagnosis selection with the same filter, +limit, timeout, corpus, and trusted-library setup. Compare the reports: + +```sh +cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ + --out /tmp/psrs-after.json --timeout 20 +cargo run -p psrs-cli -- diagnose --compare /tmp/psrs-before.json /tmp/psrs-after.json +``` + +The comparison reports per-case recovery, regression, stage/category changes, +input changes, and unmatched paths. Do not compare reports with incompatible +cohorts as if they were the same measurement. Investigate regressions and cases +whose inputs changed; record timeouts and crashes as incomplete evidence. + +Compile diagnosis only establishes compile acceptance. If the behavior under +change reaches Wasm execution, add focused runtime checks that observe actual +values, call counts, output order, or traps as appropriate. A successful compile +does not establish correct runtime behavior. For runtime-gated driver tests +that support it, require Wasmtime explicitly: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib focused_runtime_test_name +``` + +Run the issue's required official-suite or scoreboard validation when the change +affects a gate or its acceptance evidence. Update D-04 and README measurements +only after rerunning the relevant scoreboard with the documented settings. +Small filtered diagnosis reports are useful for locating regressions; they are +not replacements for official acceptance measurements. + +## 5. Report the evidence + +For each iteration, report: + +- the starting commit and whether the worktree already had changes; +- the exact baseline and comparison commands and selected cohort; +- compile outcomes by first-blocker stage/category, keeping exclusions, + timeouts, crashes, and incomplete inputs separate; +- the reproducer, suspected semantic owner, and evidence for that hypothesis; +- focused tests, runtime behavior exercised, and required suite/scoreboard runs; +- what changed, what remains unresolved, and which validations were not run. + +Do not turn a filtered cohort into a corpus-wide pass rate. Do not update a +scoreboard number from diagnostic output or from an unverified estimate. From af2f5af07a2cf3b945c94e1409f15bb86484a51d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 02:17:03 +0800 Subject: [PATCH 003/148] Add backend compile pass trace model --- crates/psrs-backend/src/lib.rs | 143 ++---- crates/psrs-backend/src/pipeline/emission.rs | 233 +++++++++ crates/psrs-backend/src/pipeline/mod.rs | 366 +++++++++++++++ crates/psrs-backend/src/trace.rs | 443 ++++++++++++++++++ crates/psrs-cli/src/diagnose/artifacts.rs | 90 +++- crates/psrs-cli/src/diagnose/mod.rs | 229 ++++----- crates/psrs-cli/src/diagnose/report.rs | 65 ++- crates/psrs-cli/src/diagnose/schema.rs | 151 ++++++ crates/psrs-cli/src/diagnose/trace/build.rs | 404 ++++++++++++++++ crates/psrs-cli/src/diagnose/trace/compare.rs | 112 +++++ .../src/diagnose/trace/environment.rs | 19 + crates/psrs-cli/src/diagnose/trace/mod.rs | 170 +++++++ crates/psrs-cli/src/diagnose/worker.rs | 160 ++++--- crates/psrs-cli/src/main.rs | 2 +- crates/psrs-cli/tests/diagnose_trace.rs | 310 ++++++++++++ crates/psrs-driver/src/diagnostics.rs | 31 +- crates/psrs-driver/src/lib.rs | 8 +- crates/psrs-driver/src/program/compilation.rs | 171 ++++++- crates/psrs-driver/src/program/library.rs | 19 + crates/psrs-driver/src/program/mod.rs | 6 +- .../psrs-driver/src/tests/diagnosis_trace.rs | 165 +++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-16-compile-diagnosis.md | 249 ++++++++-- docs/feature/F-04-compile-diagnosis.md | 86 +++- docs/workflow/compiler-iteration-sop.md | 169 ++++--- 25 files changed, 3308 insertions(+), 494 deletions(-) create mode 100644 crates/psrs-backend/src/pipeline/emission.rs create mode 100644 crates/psrs-backend/src/pipeline/mod.rs create mode 100644 crates/psrs-backend/src/trace.rs create mode 100644 crates/psrs-cli/src/diagnose/schema.rs create mode 100644 crates/psrs-cli/src/diagnose/trace/build.rs create mode 100644 crates/psrs-cli/src/diagnose/trace/compare.rs create mode 100644 crates/psrs-cli/src/diagnose/trace/environment.rs create mode 100644 crates/psrs-cli/src/diagnose/trace/mod.rs create mode 100644 crates/psrs-cli/tests/diagnose_trace.rs create mode 100644 crates/psrs-driver/src/tests/diagnosis_trace.rs diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 282de619..dfcd6384 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -5,12 +5,15 @@ pub mod cc; pub mod component; mod effects; pub mod mir; +mod pipeline; +pub mod trace; pub mod types; pub mod wasm; pub use bindings::{BackendInput, ExternalBinding, ExternalBindings}; pub use capability::TargetCapabilities; +pub use trace::*; use psrs_hir::ModuleId; use psrs_span::TextRange; @@ -199,6 +202,14 @@ pub struct CompileFailure { pub partial: PartialStages, } +/// Normal backend result together with the pass/artifact events observed while +/// compiling it. Partial IR values are retained only when requested. +#[derive(Clone, Debug)] +pub struct TracedCompile { + pub result: Result, + pub trace: CompileTrace, +} + pub fn compile_with_stages(module: psrs_core::Module) -> Result> { compile_with_target(module, TargetCapabilities::default()) } @@ -216,7 +227,21 @@ pub fn compile_with_context( effect_context: Option, target: TargetCapabilities, ) -> Result> { - compile_with_context_inner(module, effect_context, target, None) + pipeline::compile_with_context_inner(module, effect_context, target, None, None) +} + +/// Compiles with actual top-level pass/artifact tracing. Setting +/// `capture_partial` retains IR snapshots for diagnostics; the trace itself is +/// lightweight and does not clone or format IR values. +pub fn compile_with_context_traced( + module: psrs_core::Module, + effect_context: Option, + target: TargetCapabilities, + capture_partial: bool, +) -> TracedCompile { + let (result, trace) = + pipeline::compile_with_context_traced(module, effect_context, target, capture_partial); + TracedCompile { result, trace } } /// Compiles using the normal backend pipeline and returns only representations @@ -228,120 +253,6 @@ pub fn compile_with_context_capturing( target: TargetCapabilities, ) -> Result { let mut partial = PartialStages::default(); - compile_with_context_inner(module, effect_context, target, Some(&mut partial)) + pipeline::compile_with_context_inner(module, effect_context, target, Some(&mut partial), None) .map_err(|errors| CompileFailure { errors, partial }) } - -fn compile_with_context_inner( - module: psrs_core::Module, - effect_context: Option, - target: TargetCapabilities, - mut capture: Option<&mut PartialStages>, -) -> Result> { - let owner = module.entry.map(|entry| entry.module); - let mut module = - psrs_core::opt::optimize(module, psrs_core::opt::Budget::default()).map_err(|errors| { - annotate_errors( - errors - .into_iter() - .map(|error| { - BackendError::new("P7 Core optimization", error.span, error.message) - .with_module(error.module) - }) - .collect(), - owner, - ) - })?; - let optimized_core = module.clone(); - if let Some(capture) = capture.as_deref_mut() { - capture.core = Some(optimized_core.clone()); - } - let mut external_bindings = ExternalBindings::from_core(&module); - if let Some(context) = effect_context.as_ref() { - effects::lower_effects(&mut module, &mut external_bindings, context)?; - } - external_bindings.validate_conformance(&module, target)?; - let lowered_cc = cc::lower_module_with_bindings(module, external_bindings)?; - let cc = lowered_cc.cc; - if let Some(capture) = capture.as_deref_mut() { - capture.cc = Some(cc.clone()); - } - let (mir, mut wasi) = - mir::lower_module_with_bindings(cc.clone(), lowered_cc.externals, target)?; - if let Some(capture) = capture.as_deref_mut() { - capture.mir = Some(mir.clone()); - capture.mir_stage = Some("P9 MIR lowering"); - } - let mir = mir::opt::optimize(mir, target)?; - if let Some(capture) = capture.as_deref_mut() { - capture.mir = Some(mir.clone()); - capture.mir_stage = Some("P10 MIR optimization"); - } - let owner = mir.entry.map(|entry| entry.module); - if !target.component_model - || !target.wasi_p2 - || !target.wasi_cli - || !target.wasi_io - || !target.wasi_clocks - || !target.wasi_random - { - return Err(annotate_errors( - vec![BackendError::new( - "P11 target capabilities", - mir.span, - "the current artifact pipeline requires Component Model and WASI 0.2 capabilities", - )], - owner, - )); - } - let wasm = wasm::lower_module_with_capabilities(&mir, &mut wasi, target) - .map_err(|errors| annotate_errors(errors, owner))?; - let core = wasm::encode_module(&wasm).map_err(|errors| annotate_errors(errors, owner))?; - let (resolve, world) = component::command_world().map_err(|message| { - annotate_errors( - vec![BackendError::new("P11 component", mir.span, message)], - owner, - ) - })?; - let binary = component::componentize(&core, &resolve, world).map_err(|message| { - annotate_errors( - vec![BackendError::new("P11 component", mir.span, message)], - owner, - ) - })?; - validator_for(target) - .validate_all(&binary) - .map_err(|error| { - annotate_errors( - vec![BackendError::new( - "P11 Wasm validation", - mir.span, - format!("generated WebAssembly failed validation: {error}"), - )], - owner, - ) - })?; - let warnings = lowered_cc.warnings; - let text = wasmprinter::print_bytes(&binary).map_err(|error| { - annotate_errors( - vec![BackendError::new( - "P11 WAT printing", - mir.span, - format!("generated WebAssembly could not be printed as WAT: {error}"), - )], - owner, - ) - })?; - Ok(Stages { - core: optimized_core, - effect_context, - cc, - mir, - wasm, - artifact: Artifact { - wasm: binary, - wat: text, - warnings, - }, - }) -} diff --git a/crates/psrs-backend/src/pipeline/emission.rs b/crates/psrs-backend/src/pipeline/emission.rs new file mode 100644 index 00000000..9cc732ba --- /dev/null +++ b/crates/psrs-backend/src/pipeline/emission.rs @@ -0,0 +1,233 @@ +use super::*; + +use crate::component; + +pub(crate) struct EmittedWasm { + pub module: crate::wasm::Module, + pub component: Vec, + pub wat: String, +} + +pub(crate) fn emit( + mir: &mir::Module, + wasi: &mut crate::abi::WasiRegistry, + target: TargetCapabilities, + owner: Option, + mir_id: Option, + wasi_id: Option, + mut trace: Option<&mut TraceRecorder>, +) -> Result> { + let target_parameter = || { + vec![TraceParameter { + key: "target_capabilities", + value: format!("{target:?}"), + }] + }; + let wasm_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.wasm.lower", + &[ + mir_id.expect("traced MIR before Wasm lowering"), + wasi_id.expect("traced WASI registry before Wasm lowering"), + ], + TraceValidationCoverage::Composite, + target_parameter(), + ) + }); + let module = match crate::wasm::lower_module_with_capabilities(mir, wasi, target) { + Ok(module) => module, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), wasm_call) { + trace.reject(call, errors.len()); + } + return Err(annotate_errors(errors, owner)); + } + }; + let wasm_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), wasm_call) { + trace + .complete( + call, + &[TraceRepresentation::WasmModule], + &[TraceValidationSpec::output( + "wasm::lower_module_with_capabilities", + 0, + TraceValidationCoverage::Composite, + )], + ) + .first() + .copied() + } else { + None + }; + + let encode_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.wasm.encode", + &[wasm_id.expect("traced Wasm module before encoding")], + TraceValidationCoverage::NotObserved, + Vec::new(), + ) + }); + let core = match crate::wasm::encode_module(&module) { + Ok(core) => core, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), encode_call) { + trace.reject(call, errors.len()); + } + return Err(annotate_errors(errors, owner)); + } + }; + let core_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), encode_call) { + trace + .complete(call, &[TraceRepresentation::WasmCoreBinary], &[]) + .first() + .copied() + } else { + None + }; + + let resolve_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.component.resolve_world", + &[], + TraceValidationCoverage::NotObserved, + vec![TraceParameter { + key: "wit_source", + value: "vendored".into(), + }], + ) + }); + let (resolve, world) = match component::command_world() { + Ok(result) => result, + Err(message) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), resolve_call) { + trace.reject(call, 1); + } + return Err(annotate_errors( + vec![BackendError::new("P11 component", mir.span, message)], + owner, + )); + } + }; + let world_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), resolve_call) { + trace + .complete(call, &[TraceRepresentation::WitWorld], &[]) + .first() + .copied() + } else { + None + }; + + let component_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.component.assemble", + &[ + core_id.expect("traced core Wasm before component assembly"), + world_id.expect("traced WIT world before component assembly"), + ], + TraceValidationCoverage::Composite, + Vec::new(), + ) + }); + let binary = match component::componentize(&core, &resolve, world) { + Ok(binary) => binary, + Err(message) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), component_call) { + trace.reject(call, 1); + } + return Err(annotate_errors( + vec![BackendError::new("P11 component", mir.span, message)], + owner, + )); + } + }; + let component_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), component_call) { + trace + .complete( + call, + &[TraceRepresentation::ComponentBinary], + &[TraceValidationSpec::output( + "wit_component::ComponentEncoder::validate_and_encode", + 0, + TraceValidationCoverage::Composite, + )], + ) + .first() + .copied() + } else { + None + }; + + let validate_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.component.validate", + &[component_id.expect("traced component before validation")], + TraceValidationCoverage::Direct, + target_parameter(), + ) + }); + if let Err(error) = crate::validator_for(target).validate_all(&binary) { + let errors = annotate_errors( + vec![BackendError::new( + "P11 Wasm validation", + mir.span, + format!("generated WebAssembly failed validation: {error}"), + )], + owner, + ); + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), validate_call) { + trace.reject_validation( + call, + errors.len(), + "wasmparser::Validator::validate_all", + &[component_id.expect("traced component before validation")], + ); + } + return Err(errors); + } + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), validate_call) { + trace.complete( + call, + &[], + &[TraceValidationSpec::input( + "wasmparser::Validator::validate_all", + 0, + TraceValidationCoverage::Direct, + )], + ); + } + + let print_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.wat.print", + &[component_id.expect("traced component before WAT printing")], + TraceValidationCoverage::NotObserved, + Vec::new(), + ) + }); + let wat = match wasmprinter::print_bytes(&binary) { + Ok(wat) => wat, + Err(error) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), print_call) { + trace.reject(call, 1); + } + return Err(annotate_errors( + vec![BackendError::new( + "P11 WAT printing", + mir.span, + format!("generated WebAssembly could not be printed as WAT: {error}"), + )], + owner, + )); + } + }; + if let (Some(trace), Some(call)) = (trace, print_call) { + trace.complete(call, &[TraceRepresentation::WatText], &[]); + } + + Ok(EmittedWasm { + module, + component: binary, + wat, + }) +} diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs new file mode 100644 index 00000000..a67d646d --- /dev/null +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -0,0 +1,366 @@ +use crate::trace::{ + CompileTrace, TraceArtifactId, TraceParameter, TraceRecorder, TraceRepresentation, + TraceValidationCoverage, TraceValidationSpec, +}; +use crate::{ + Artifact, BackendError, CompileFailure, PartialStages, Stages, TargetCapabilities, + annotate_errors, +}; + +use crate::{cc, effects, mir}; + +mod emission; + +pub(crate) fn compile_with_context_inner( + module: psrs_core::Module, + effect_context: Option, + target: TargetCapabilities, + mut capture: Option<&mut PartialStages>, + mut trace: Option<&mut TraceRecorder>, +) -> Result> { + let target_parameter = || { + vec![TraceParameter { + key: "target_capabilities", + value: format!("{target:?}"), + }] + }; + let mut core_id = trace.as_deref().map(|trace| trace.initial_core()); + let owner = module.entry.map(|entry| entry.module); + + let core_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.core.optimize", + &[core_id.expect("traced Core input")], + TraceValidationCoverage::Composite, + target_parameter(), + ) + }); + let mut module = match psrs_core::opt::optimize(module, psrs_core::opt::Budget::default()) { + Ok(module) => module, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), core_call) { + trace.reject(call, errors.len()); + } + return Err(annotate_errors( + errors + .into_iter() + .map(|error| { + BackendError::new("P7 Core optimization", error.span, error.message) + .with_module(error.module) + }) + .collect(), + owner, + )); + } + }; + let optimized_core = module.clone(); + if let Some(capture) = capture.as_deref_mut() { + capture.core = Some(optimized_core.clone()); + } + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), core_call) { + core_id = trace + .complete( + call, + &[TraceRepresentation::Core], + &[TraceValidationSpec::output( + "psrs_core::opt::optimize", + 0, + TraceValidationCoverage::Composite, + )], + ) + .first() + .copied(); + } + + let binding_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.external_bindings.extract", + &[core_id.expect("traced optimized Core")], + TraceValidationCoverage::NotObserved, + Vec::new(), + ) + }); + let mut external_bindings = crate::ExternalBindings::from_core(&module); + let mut binding_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), binding_call) { + trace + .complete(call, &[TraceRepresentation::ExternalBindings], &[]) + .first() + .copied() + } else { + None + }; + + if let Some(context) = effect_context.as_ref() { + let effect_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.effect.lower", + &[ + core_id.expect("traced optimized Core"), + binding_id.expect("traced external bindings"), + ], + TraceValidationCoverage::Composite, + vec![TraceParameter { + key: "effect_context", + value: "present".into(), + }], + ) + }); + if let Err(errors) = effects::lower_effects(&mut module, &mut external_bindings, context) { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { + trace.reject(call, errors.len()); + } + return Err(errors); + } + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { + let outputs = trace.complete( + call, + &[ + TraceRepresentation::Core, + TraceRepresentation::ExternalBindings, + ], + &[TraceValidationSpec::outputs( + "psrs_backend::effects::lower_effects", + &[0, 1], + TraceValidationCoverage::Composite, + )], + ); + core_id = outputs.first().copied(); + binding_id = outputs.get(1).copied(); + } + } else if let Some(trace) = trace.as_deref_mut() { + trace.not_applicable("backend.effect.lower", "no effect context supplied"); + } + + let conformance_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.external_bindings.validate_conformance", + &[ + core_id.expect("traced Core before binding validation"), + binding_id.expect("traced external bindings"), + ], + TraceValidationCoverage::Direct, + target_parameter(), + ) + }); + if let Err(errors) = external_bindings.validate_conformance(&module, target) { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), conformance_call) { + trace.reject_validation( + call, + errors.len(), + "ExternalBindings::validate_conformance", + &[ + core_id.expect("traced Core before binding validation"), + binding_id.expect("traced external bindings"), + ], + ); + } + return Err(errors); + } + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), conformance_call) { + trace.complete( + call, + &[], + &[TraceValidationSpec::inputs( + "ExternalBindings::validate_conformance", + &[0, 1], + TraceValidationCoverage::Direct, + )], + ); + } + + let cc_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.cc.lower", + &[ + core_id.expect("traced Core before CC lowering"), + binding_id.expect("traced external bindings"), + ], + TraceValidationCoverage::Composite, + target_parameter(), + ) + }); + let lowered_cc = match cc::lower_module_with_bindings(module, external_bindings) { + Ok(lowered) => lowered, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), cc_call) { + trace.reject(call, errors.len()); + } + return Err(errors); + } + }; + let cc = lowered_cc.cc; + let (cc_id, binding_id) = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), cc_call) { + let outputs = trace.complete( + call, + &[ + TraceRepresentation::ClosureConverted, + TraceRepresentation::ExternalBindings, + ], + &[TraceValidationSpec::outputs( + "cc::lower_module_with_bindings", + &[0], + TraceValidationCoverage::Composite, + )], + ); + (outputs.first().copied(), outputs.get(1).copied()) + } else { + (None, None) + }; + if let Some(capture) = capture.as_deref_mut() { + capture.cc = Some(cc.clone()); + } + + let mir_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.mir.lower", + &[ + cc_id.expect("traced CC before MIR lowering"), + binding_id.expect("traced external bindings before MIR lowering"), + ], + TraceValidationCoverage::Composite, + target_parameter(), + ) + }); + let (mir, mut wasi) = + match mir::lower_module_with_bindings(cc.clone(), lowered_cc.externals, target) { + Ok(result) => result, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_call) { + trace.reject(call, errors.len()); + } + return Err(errors); + } + }; + let (mut mir, mir_ids) = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_call) { + let outputs = trace.complete( + call, + &[TraceRepresentation::Mir, TraceRepresentation::WasiRegistry], + &[TraceValidationSpec::output( + "mir::lower_module_with_bindings", + 0, + TraceValidationCoverage::Composite, + )], + ); + (mir, outputs) + } else { + (mir, Vec::new()) + }; + let mut mir_id = mir_ids.first().copied(); + let wasi_id = mir_ids.get(1).copied(); + if let Some(capture) = capture.as_deref_mut() { + capture.mir = Some(mir.clone()); + capture.mir_stage = Some("P9 MIR lowering"); + } + + let mir_opt_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.mir.optimize", + &[mir_id.expect("traced MIR before optimization")], + TraceValidationCoverage::Composite, + target_parameter(), + ) + }); + mir = match mir::opt::optimize(mir, target) { + Ok(mir) => mir, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_opt_call) { + trace.reject(call, errors.len()); + } + return Err(errors); + } + }; + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_opt_call) { + mir_id = trace + .complete( + call, + &[TraceRepresentation::Mir], + &[TraceValidationSpec::output( + "mir::opt::optimize", + 0, + TraceValidationCoverage::Composite, + )], + ) + .first() + .copied(); + } + if let Some(capture) = capture { + capture.mir = Some(mir.clone()); + capture.mir_stage = Some("P10 MIR optimization"); + } + + let owner = mir.entry.map(|entry| entry.module); + let target_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.target.requirements", + &[mir_id.expect("traced MIR before target check")], + TraceValidationCoverage::Direct, + target_parameter(), + ) + }); + if !target.component_model + || !target.wasi_p2 + || !target.wasi_cli + || !target.wasi_io + || !target.wasi_clocks + || !target.wasi_random + { + let errors = annotate_errors( + vec![BackendError::new( + "P11 target capabilities", + mir.span, + "the current artifact pipeline requires Component Model and WASI 0.2 capabilities", + )], + owner, + ); + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), target_call) { + trace.reject(call, errors.len()); + } + return Err(errors); + } + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), target_call) { + trace.complete( + call, + &[], + &[TraceValidationSpec::input( + "backend_component_wasi_target_requirements", + 0, + TraceValidationCoverage::Direct, + )], + ); + } + + let emitted = emission::emit(&mir, &mut wasi, target, owner, mir_id, wasi_id, trace)?; + let warnings = lowered_cc.warnings; + + Ok(Stages { + core: optimized_core, + effect_context, + cc, + mir, + wasm: emitted.module, + artifact: Artifact { + wasm: emitted.component, + wat: emitted.wat, + warnings, + }, + }) +} + +pub(crate) fn compile_with_context_traced( + module: psrs_core::Module, + effect_context: Option, + target: TargetCapabilities, + capture_partial: bool, +) -> (Result, CompileTrace) { + let mut trace = TraceRecorder::new(); + let mut partial = PartialStages::default(); + let result = compile_with_context_inner( + module, + effect_context, + target, + capture_partial.then_some(&mut partial), + Some(&mut trace), + ) + .map_err(|errors| CompileFailure { errors, partial }); + (result, trace.finish()) +} diff --git a/crates/psrs-backend/src/trace.rs b/crates/psrs-backend/src/trace.rs new file mode 100644 index 00000000..a320fcb4 --- /dev/null +++ b/crates/psrs-backend/src/trace.rs @@ -0,0 +1,443 @@ +//! Plain pass and artifact records for one backend compile attempt. + +/// Version of the backend-owned trace vocabulary. +pub const COMPILE_TRACE_VERSION: u32 = 1; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord, Hash)] +pub struct TraceArtifactId(pub u32); + +#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord, Hash)] +pub struct TraceExecutionId(pub u32); + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TraceRepresentation { + Core, + ExternalBindings, + ClosureConverted, + Mir, + WasmModule, + WasmCoreBinary, + ComponentBinary, + WatText, + WitWorld, + WasiRegistry, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TraceArtifactState { + Provided, + Produced, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TracePassStatus { + Completed, + Rejected, + NotApplicable, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TraceEdgeRole { + Input, + Output, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TraceValidationStatus { + Passed, + Rejected, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TraceValidationCoverage { + Direct, + Composite, + NotObserved, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct TraceArtifact { + pub id: TraceArtifactId, + pub representation: TraceRepresentation, + pub state: TraceArtifactState, + pub producer: Option, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct TraceExecution { + pub id: TraceExecutionId, + pub pass_key: &'static str, + pub contract_version: u32, + pub inputs: Vec, + pub outputs: Vec, + pub status: TracePassStatus, + /// Indexes into the backend error list returned from this same compile. + pub diagnostic_indices: Vec, + /// Nested verifiers and transformations not exposed by this call remain + /// opaque; the CLI serializes this observed boundary explicitly. + pub validation_coverage: TraceValidationCoverage, + pub parameters: Vec, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct TraceParameter { + pub key: &'static str, + pub value: String, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct TraceEdge { + pub execution: TraceExecutionId, + pub artifact: TraceArtifactId, + pub role: TraceEdgeRole, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct TraceValidation { + pub execution: TraceExecutionId, + pub validator_key: &'static str, + pub artifacts: Vec, + pub status: TraceValidationStatus, + pub coverage: TraceValidationCoverage, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TraceArtifactSelector { + Input(usize), + Output(usize), +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct TraceValidationSpec { + pub validator_key: &'static str, + pub artifacts: Vec, + pub coverage: TraceValidationCoverage, +} + +impl TraceValidationSpec { + pub(crate) fn input( + validator_key: &'static str, + index: usize, + coverage: TraceValidationCoverage, + ) -> Self { + Self { + validator_key, + artifacts: vec![TraceArtifactSelector::Input(index)], + coverage, + } + } + + pub(crate) fn output( + validator_key: &'static str, + index: usize, + coverage: TraceValidationCoverage, + ) -> Self { + Self { + validator_key, + artifacts: vec![TraceArtifactSelector::Output(index)], + coverage, + } + } + + pub(crate) fn inputs( + validator_key: &'static str, + indices: &[usize], + coverage: TraceValidationCoverage, + ) -> Self { + Self { + validator_key, + artifacts: indices + .iter() + .copied() + .map(TraceArtifactSelector::Input) + .collect(), + coverage, + } + } + + pub(crate) fn outputs( + validator_key: &'static str, + indices: &[usize], + coverage: TraceValidationCoverage, + ) -> Self { + Self { + validator_key, + artifacts: indices + .iter() + .copied() + .map(TraceArtifactSelector::Output) + .collect(), + coverage, + } + } +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct CompileTrace { + pub version: u32, + pub initial_core: TraceArtifactId, + pub artifacts: Vec, + pub executions: Vec, + pub edges: Vec, + pub validations: Vec, +} + +pub(crate) struct TraceRecorder { + trace: CompileTrace, + next_artifact: u32, + next_execution: u32, +} + +pub(crate) struct TraceCall { + id: TraceExecutionId, + inputs: Vec, + pass_key: &'static str, + validation_coverage: TraceValidationCoverage, + parameters: Vec, +} + +impl TraceRecorder { + pub(crate) fn new() -> Self { + let initial_core = TraceArtifactId(0); + Self { + trace: CompileTrace { + version: COMPILE_TRACE_VERSION, + initial_core, + artifacts: vec![TraceArtifact { + id: initial_core, + representation: TraceRepresentation::Core, + state: TraceArtifactState::Provided, + producer: None, + }], + executions: Vec::new(), + edges: Vec::new(), + validations: Vec::new(), + }, + next_artifact: 1, + next_execution: 0, + } + } + + pub(crate) fn begin( + &mut self, + pass_key: &'static str, + inputs: &[TraceArtifactId], + validation_coverage: TraceValidationCoverage, + parameters: Vec, + ) -> TraceCall { + let id = TraceExecutionId(self.next_execution); + self.next_execution += 1; + for artifact in inputs { + self.trace.edges.push(TraceEdge { + execution: id, + artifact: *artifact, + role: TraceEdgeRole::Input, + }); + } + TraceCall { + id, + inputs: inputs.to_vec(), + pass_key, + validation_coverage, + parameters, + } + } + + pub(crate) fn initial_core(&self) -> TraceArtifactId { + self.trace.initial_core + } + + pub(crate) fn complete( + &mut self, + call: TraceCall, + outputs: &[TraceRepresentation], + validations: &[TraceValidationSpec], + ) -> Vec { + let output_ids = outputs + .iter() + .map(|representation| { + let id = TraceArtifactId(self.next_artifact); + self.next_artifact += 1; + self.trace.artifacts.push(TraceArtifact { + id, + representation: *representation, + state: TraceArtifactState::Produced, + producer: Some(call.id), + }); + self.trace.edges.push(TraceEdge { + execution: call.id, + artifact: id, + role: TraceEdgeRole::Output, + }); + id + }) + .collect::>(); + for validation in validations { + let artifacts = validation + .artifacts + .iter() + .map(|selector| match selector { + TraceArtifactSelector::Input(index) => *call + .inputs + .get(*index) + .expect("validation input selector must name an existing artifact"), + TraceArtifactSelector::Output(index) => *output_ids + .get(*index) + .expect("validation output selector must name an existing artifact"), + }) + .collect(); + self.trace.validations.push(TraceValidation { + execution: call.id, + validator_key: validation.validator_key, + artifacts, + status: TraceValidationStatus::Passed, + coverage: validation.coverage, + }); + } + self.trace.executions.push(TraceExecution { + id: call.id, + pass_key: call.pass_key, + contract_version: 1, + inputs: call.inputs, + outputs: output_ids.clone(), + status: TracePassStatus::Completed, + diagnostic_indices: Vec::new(), + validation_coverage: call.validation_coverage, + parameters: call.parameters, + }); + output_ids + } + + pub(crate) fn reject(&mut self, call: TraceCall, diagnostic_count: usize) { + self.trace.executions.push(TraceExecution { + id: call.id, + pass_key: call.pass_key, + contract_version: 1, + inputs: call.inputs, + outputs: Vec::new(), + status: TracePassStatus::Rejected, + diagnostic_indices: (0..diagnostic_count).collect(), + validation_coverage: call.validation_coverage, + parameters: call.parameters, + }); + } + + pub(crate) fn reject_validation( + &mut self, + call: TraceCall, + diagnostic_count: usize, + validator_key: &'static str, + artifacts: &[TraceArtifactId], + ) { + self.trace.validations.push(TraceValidation { + execution: call.id, + validator_key, + artifacts: artifacts.to_vec(), + status: TraceValidationStatus::Rejected, + coverage: TraceValidationCoverage::Direct, + }); + self.reject(call, diagnostic_count); + } + + pub(crate) fn not_applicable(&mut self, pass_key: &'static str, reason: &'static str) { + let call = self.begin( + pass_key, + &[], + TraceValidationCoverage::NotObserved, + vec![TraceParameter { + key: "reason", + value: reason.into(), + }], + ); + self.trace.executions.push(TraceExecution { + id: call.id, + pass_key: call.pass_key, + contract_version: 1, + inputs: Vec::new(), + outputs: Vec::new(), + status: TracePassStatus::NotApplicable, + diagnostic_indices: Vec::new(), + validation_coverage: call.validation_coverage, + parameters: call.parameters, + }); + } + + #[cfg(test)] + fn validations(&self) -> &[TraceValidation] { + &self.trace.validations + } + + pub(crate) fn finish(self) -> CompileTrace { + self.trace + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + #[should_panic(expected = "validation output selector must name an existing artifact")] + fn validation_selectors_cannot_silently_drop_missing_outputs() { + let mut trace = TraceRecorder::new(); + let core = trace.initial_core(); + let call = trace.begin( + "test.pass", + &[core], + TraceValidationCoverage::Direct, + Vec::new(), + ); + trace.complete( + call, + &[TraceRepresentation::Core], + &[TraceValidationSpec::output( + "test.validator", + 1, + TraceValidationCoverage::Direct, + )], + ); + } + + #[test] + fn validations_reference_only_the_declared_artifacts() { + let mut trace = TraceRecorder::new(); + let core = trace.initial_core(); + let call = trace.begin( + "test.pass", + &[core], + TraceValidationCoverage::Composite, + Vec::new(), + ); + let output = trace.complete( + call, + &[ + TraceRepresentation::Core, + TraceRepresentation::ExternalBindings, + ], + &[TraceValidationSpec::output( + "test.validator", + 0, + TraceValidationCoverage::Composite, + )], + ); + assert_eq!(trace.validations()[0].artifacts, vec![output[0]]); + } + + #[test] + fn rejected_validation_references_its_input_and_stays_rejected() { + let mut trace = TraceRecorder::new(); + let core = trace.initial_core(); + let call = trace.begin( + "test.validate", + &[core], + TraceValidationCoverage::Direct, + Vec::new(), + ); + trace.reject_validation(call, 1, "test.validator", &[core]); + let trace = trace.finish(); + assert_eq!(trace.validations[0].status, TraceValidationStatus::Rejected); + assert_eq!(trace.validations[0].artifacts, vec![core]); + assert_eq!(trace.executions[0].status, TracePassStatus::Rejected); + assert!(trace.executions[0].outputs.is_empty()); + } +} diff --git a/crates/psrs-cli/src/diagnose/artifacts.rs b/crates/psrs-cli/src/diagnose/artifacts.rs index acee6327..9e456fe9 100644 --- a/crates/psrs-cli/src/diagnose/artifacts.rs +++ b/crates/psrs-cli/src/diagnose/artifacts.rs @@ -1,4 +1,6 @@ -use super::{BundleContext, CompilerRevision, Snapshot, SourceInput, WorkerResponse}; +use super::{ + BundleContext, CompilerRevision, Snapshot, SourceInput, WorkerResponse, empty_case_trace, +}; use serde::de::DeserializeOwned; use std::path::{Path, PathBuf}; use std::process::Command; @@ -11,6 +13,7 @@ pub(super) fn write_bundle( case: &str, input_set_complete: bool, context: &BundleContext, + capture_trace: bool, ) -> Result<(), String> { let _ = fs::remove_dir_all(bundle); fs::create_dir_all(bundle.join("inputs")) @@ -23,7 +26,7 @@ pub(super) fn write_bundle( paths.push(file); } write_dumps(bundle, response)?; - let command = replay_command(&paths, &context.executable); + let command = replay_script(&paths, &context.executable, capture_trace); fs::write( bundle.join("replay.sh"), format!("#!/bin/sh\nset -eu\ncd \"$(dirname \"$0\")\"\n{command}\n"), @@ -37,6 +40,14 @@ pub(super) fn write_bundle( .chain(paths.iter().cloned()) .chain(["-o".into(), "output.wasm".into()]) .collect::>(), + "trace_replay_argv": if capture_trace { + trace_replay_argv(&paths) + } else { + None + }, + "trace_mode": if capture_trace { "dumps" } else { "manifest" }, + "trace_capture_status": if response.trace.is_some() { "recorded" } else { "unavailable" }, + "trace": &response.trace, "diagnostics": &response.diagnostics, "input_fingerprint": &response.input_fingerprint, "compiler": &context.compiler, @@ -53,17 +64,15 @@ pub(super) fn write_bundle( pub(super) fn write_empty_bundle( bundle: &Path, sources: &[SourceInput], - case: &str, - reason: &str, - stderr: &str, - input_set_complete: bool, + failure: EmptyBundleFailure<'_>, context: &BundleContext, + capture_trace: bool, ) -> Result<(), String> { let empty = WorkerResponse { passed: false, input_fingerprint: fingerprint_sources(sources), sources: sources.to_vec(), - input_set_complete, + input_set_complete: failure.input_set_complete, elapsed_ms: 0, diagnostics: Vec::new(), core_stage: None, @@ -72,15 +81,38 @@ pub(super) fn write_empty_bundle( cc: None, mir_stage: None, mir: None, + trace: Some(empty_case_trace( + sources, + failure.input_set_complete, + &fingerprint_sources(sources), + capture_trace, + )), }; - write_bundle(bundle, sources, &empty, case, input_set_complete, context)?; - fs::write(bundle.join("worker-failure.txt"), reason).map_err(|error| error.to_string())?; - if !stderr.is_empty() { - fs::write(bundle.join("worker-stderr.log"), stderr).map_err(|error| error.to_string())?; + write_bundle( + bundle, + sources, + &empty, + failure.case, + failure.input_set_complete, + context, + capture_trace, + )?; + fs::write(bundle.join("worker-failure.txt"), failure.reason) + .map_err(|error| error.to_string())?; + if !failure.stderr.is_empty() { + fs::write(bundle.join("worker-stderr.log"), failure.stderr) + .map_err(|error| error.to_string())?; } Ok(()) } +pub(super) struct EmptyBundleFailure<'a> { + pub(super) case: &'a str, + pub(super) reason: &'a str, + pub(super) stderr: &'a str, + pub(super) input_set_complete: bool, +} + fn write_dumps(bundle: &Path, response: &WorkerResponse) -> Result<(), String> { for (name, stage, text) in [ ("core", &response.core_stage, &response.core), @@ -100,19 +132,47 @@ fn write_dumps(bundle: &Path, response: &WorkerResponse) -> Result<(), String> { Ok(()) } -fn replay_command(paths: &[String], executable: &str) -> String { +fn replay_script(paths: &[String], executable: &str, capture_trace: bool) -> String { let args = paths .iter() .map(|path| shell_quote(path)) .collect::>() .join(" "); - let args = format!("build {args} -o output.wasm"); + let build = format!("\"$PSRS_BIN\" build {args} -o output.wasm"); + let trace = if capture_trace { + trace_replay_argv(paths).map_or_else( + || "echo 'trace recapture unavailable: bundle contains no source inputs' >&2\n".into(), + |argv| { + let diagnose = argv + .iter() + .map(|arg| shell_quote(arg)) + .collect::>() + .join(" "); + format!( + "if ! \"$PSRS_BIN\" {diagnose}; then\n echo 'trace recapture failed; continuing with build replay' >&2\nfi\n" + ) + }, + ) + } else { + String::new() + }; format!( - "if [ -z \"${{PSRS_BIN:-}}\" ]; then PSRS_BIN={}; fi\n\"$PSRS_BIN\" {args}", + "if [ -z \"${{PSRS_BIN:-}}\" ]; then PSRS_BIN={}; fi\n{trace}{build}", shell_quote(executable) ) } +fn trace_replay_argv(paths: &[String]) -> Option> { + let first = paths.first()?; + let mut args = vec!["diagnose".to_owned(), first.clone()]; + for path in paths.iter().skip(1) { + args.push("--input".into()); + args.push(path.clone()); + } + args.extend(["--trace".into(), "--out".into(), "replay-trace.json".into()]); + Some(args) +} + pub(super) fn trusted_stdlib_fingerprint() -> Result { let root = PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../../stdlib/lib"); let trusted_path = root.join("trusted"); @@ -297,5 +357,5 @@ pub(super) fn first_line(text: &str) -> &str { } pub(super) fn usage() -> String { - "usage: psrs diagnose [--out report.json] [--timeout SECONDS]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--out report.json] [--timeout SECONDS]\n psrs diagnose --compare OLD.json NEW.json".into() + "usage: psrs diagnose [--input FILE]... [--trace] [--out report.json] [--timeout SECONDS]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--trace] [--out report.json] [--timeout SECONDS]\n psrs diagnose --compare OLD.json NEW.json".into() } diff --git a/crates/psrs-cli/src/diagnose/mod.rs b/crates/psrs-cli/src/diagnose/mod.rs index 324ef63f..e57e4f13 100644 --- a/crates/psrs-cli/src/diagnose/mod.rs +++ b/crates/psrs-cli/src/diagnose/mod.rs @@ -1,4 +1,3 @@ -use serde::{Deserialize, Serialize}; use std::collections::BTreeMap; use std::path::PathBuf; use std::{env, fs}; @@ -7,121 +6,17 @@ mod artifacts; use artifacts::*; mod report; use report::*; +mod schema; +use schema::*; +mod trace; +use trace::*; mod worker; pub(super) use worker::worker; -use worker::{WorkerOutcome, WorkerResponse, run_worker}; +use worker::{WorkerOutcome, WorkerRequest, WorkerResponse, run_worker}; -const SCHEMA_VERSION: u32 = 1; +const SCHEMA_VERSION: u32 = 2; const DEFAULT_TIMEOUT: u64 = 20; -#[derive(Clone, Debug, Serialize, Deserialize)] -struct SourceInput { - name: String, - text: String, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct DiagnosticRecord { - origin: String, - source: Option, - stage: String, - start: u32, - end: u32, - code: Option, - kind: Option, - message: String, -} - -#[derive(Clone, Copy, Debug, Serialize, Deserialize)] -#[serde(rename_all = "snake_case")] -enum CaseStatus { - Passed, - Failed, - Excluded, - TimedOut, - Crashed, -} - -#[derive(Clone, Debug, PartialEq, Eq, Serialize, Deserialize)] -struct FirstBlocker { - stage: String, - category: String, - message: String, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct CaseRecord { - path: String, - input_fingerprint: String, - input_set_complete: bool, - elapsed_ms: u64, - status: CaseStatus, - excluded_reason: Option, - diagnostics: Vec, - first_blocker: Option, - bundle: Option, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct GroupRecord { - stage: String, - category: String, - sample_messages: Vec, - cases: Vec, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct Cohort { - mode: String, - corpus: Option, - filter: Option, - limit: Option, - timeout_seconds: u64, - trusted_stdlib_fingerprint: String, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct CompilerRevision { - head: Option, - dirty: bool, - working_tree_fingerprint: String, - binary_fingerprint: String, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -pub(super) struct BundleContext { - compiler: CompilerRevision, - trusted_stdlib_fingerprint: String, - executable: String, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct Snapshot { - schema_version: u32, - cohort: Cohort, - compiler: CompilerRevision, - cases: Vec, - groups: Vec, - counts: BTreeMap, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct CompareRow { - path: String, - change: String, - input_comparison: String, - before: Option, - after: Option, -} - -#[derive(Clone, Debug, Serialize, Deserialize)] -struct CompareReport { - compatible_cohort: bool, - before_compiler: CompilerRevision, - after_compiler: CompilerRevision, - changes: Vec, -} - pub(super) fn run(args: Vec) -> Result<(), String> { if args.first().is_some_and(|arg| arg == "--compare") { if args.len() != 3 { @@ -138,23 +33,16 @@ pub(super) fn run(args: Vec) -> Result<(), String> { Ok(()) } -struct Options { - file: Option, - corpus: Option, - filter: Option, - limit: Option, - timeout_seconds: u64, - output: PathBuf, -} - impl Options { fn parse(args: Vec) -> Result { let mut file = None; + let mut additional_inputs = Vec::new(); let mut corpus = None; let mut filter = None; let mut limit = None; let mut timeout_seconds = DEFAULT_TIMEOUT; let mut output = PathBuf::from("diagnose.json"); + let mut trace = false; let mut index = 0; while index < args.len() { match args[index].as_str() { @@ -196,6 +84,14 @@ impl Options { }; output = PathBuf::from(value); } + "--input" => { + index += 1; + let Some(value) = args.get(index) else { + return Err(usage()); + }; + additional_inputs.push(PathBuf::from(value)); + } + "--trace" => trace = true, value if value.starts_with('-') => return Err(usage()), value => { if file.replace(PathBuf::from(value)).is_some() { @@ -207,16 +103,28 @@ impl Options { } if file.is_some() == corpus.is_some() || corpus.as_deref().is_some_and(|name| name != "passing") + || (corpus.is_some() && !additional_inputs.is_empty()) { return Err(usage()); } + if let Some(main) = file.as_ref() { + let mut seen = BTreeMap::new(); + for input in std::iter::once(main).chain(additional_inputs.iter()) { + let identity = fs::canonicalize(input).unwrap_or_else(|_| input.clone()); + if seen.insert(identity, ()).is_some() { + return Err(format!("{}: duplicate diagnosis input", input.display())); + } + } + } Ok(Self { file, + additional_inputs, corpus, filter, limit, timeout_seconds, output, + trace, }) } } @@ -251,8 +159,10 @@ fn diagnose(options: Options) -> Result { .collect() }; if let Some(file) = &options.file { - if !file.is_file() { - return Err(format!("{}: file does not exist", file.display())); + for input in std::iter::once(file).chain(options.additional_inputs.iter()) { + if !input.is_file() { + return Err(format!("{}: file does not exist", input.display())); + } } } @@ -299,6 +209,7 @@ fn diagnose(options: Options) -> Result { diagnostics: Vec::new(), first_blocker: None, bundle: None, + trace: None, }); eprintln!( "[{}/{}] {}: excluded (FFI)", @@ -310,13 +221,23 @@ fn diagnose(options: Options) -> Result { continue; } let bundle = bundles.join(format!("{:04}-{}", worker_index, safe_name(&display_path))); - let result = run_worker( - &work_root, - worker_index, - &path, - category.as_deref(), - options.timeout_seconds, - )?; + let request = WorkerRequest { + path: path.to_string_lossy().into_owned(), + category_dir: category + .as_ref() + .map(|path| path.to_string_lossy().into_owned()), + explicit_inputs: if category.is_none() && !options.additional_inputs.is_empty() { + std::iter::once(&path) + .chain(options.additional_inputs.iter()) + .map(|input| input.to_string_lossy().into_owned()) + .collect() + } else { + Vec::new() + }, + capture_dumps: options.trace, + trusted_stdlib_fingerprint: bundle_context.trusted_stdlib_fingerprint.clone(), + }; + let result = run_worker(&work_root, worker_index, options.timeout_seconds, request)?; let entry_source = vec![SourceInput { name: path.to_string_lossy().into_owned(), text, @@ -329,15 +250,18 @@ fn diagnose(options: Options) -> Result { elapsed_ms, blocker, bundle_path, + trace_record, ) = match result { WorkerOutcome::Completed(response) => { + let response = *response; let status = if response.passed { CaseStatus::Passed } else { CaseStatus::Failed }; let blocker = response.diagnostics.first().map(first_blocker); - if !response.passed { + let should_bundle = !response.passed || options.trace; + if should_bundle { write_bundle( &bundle, &response.sources, @@ -345,6 +269,7 @@ fn diagnose(options: Options) -> Result { &display_path, response.input_set_complete, &bundle_context, + options.trace, )?; } ( @@ -354,18 +279,22 @@ fn diagnose(options: Options) -> Result { response.input_set_complete, response.elapsed_ms, blocker, - (!response.passed).then(|| bundle.to_string_lossy().into_owned()), + should_bundle.then(|| bundle.to_string_lossy().into_owned()), + response.trace, ) } WorkerOutcome::TimedOut { elapsed_ms } => { write_empty_bundle( &bundle, &entry_source, - &display_path, - "compiler worker timed out", - "", - false, + EmptyBundleFailure { + case: &display_path, + reason: "compiler worker timed out", + stderr: "", + input_set_complete: false, + }, &bundle_context, + options.trace, )?; ( CaseStatus::TimedOut, @@ -379,6 +308,12 @@ fn diagnose(options: Options) -> Result { message: format!("exceeded {}s", options.timeout_seconds), }), Some(bundle.to_string_lossy().into_owned()), + Some(empty_case_trace( + &entry_source, + false, + &fingerprint_sources(&entry_source), + options.trace, + )), ) } WorkerOutcome::Crashed { @@ -389,11 +324,14 @@ fn diagnose(options: Options) -> Result { write_empty_bundle( &bundle, &entry_source, - &display_path, - &message, - &stderr, - false, + EmptyBundleFailure { + case: &display_path, + reason: &message, + stderr: &stderr, + input_set_complete: false, + }, &bundle_context, + options.trace, )?; ( CaseStatus::Crashed, @@ -407,6 +345,12 @@ fn diagnose(options: Options) -> Result { message, }), Some(bundle.to_string_lossy().into_owned()), + Some(empty_case_trace( + &entry_source, + false, + &fingerprint_sources(&entry_source), + options.trace, + )), ) } }; @@ -428,6 +372,7 @@ fn diagnose(options: Options) -> Result { diagnostics, first_blocker: blocker, bundle: bundle_path, + trace: trace_record, }); worker_index += 1; } @@ -444,6 +389,12 @@ fn diagnose(options: Options) -> Result { schema_version: SCHEMA_VERSION, cohort, compiler: bundle_context.compiler, + environment: observed_environment(), + trace_mode: if options.trace { + TraceMode::Dumps + } else { + TraceMode::Manifest + }, cases: records, groups: Vec::new(), counts: BTreeMap::new(), diff --git a/crates/psrs-cli/src/diagnose/report.rs b/crates/psrs-cli/src/diagnose/report.rs index 9b9f0823..94ccec5a 100644 --- a/crates/psrs-cli/src/diagnose/report.rs +++ b/crates/psrs-cli/src/diagnose/report.rs @@ -94,7 +94,9 @@ pub(super) fn count(snapshot: &Snapshot, key: &str) -> usize { pub(super) fn compare(before_path: &str, after_path: &str) -> Result<(), String> { let before: Snapshot = read_json(before_path)?; let after: Snapshot = read_json(after_path)?; - if before.schema_version != SCHEMA_VERSION || after.schema_version != SCHEMA_VERSION { + if !matches!(before.schema_version, 1 | SCHEMA_VERSION) + || !matches!(after.schema_version, 1 | SCHEMA_VERSION) + { return Err("cannot compare unsupported diagnosis snapshot schema".into()); } if before.cohort.mode != after.cohort.mode @@ -148,11 +150,33 @@ pub(super) fn compare(before_path: &str, after_path: &str) -> Result<(), String> input_comparison: input_comparison.into(), before: left.and_then(case_label), after: right.and_then(case_label), + trace_comparison: match (left, right) { + (Some(a), Some(b)) + if before.schema_version == SCHEMA_VERSION + && after.schema_version == SCHEMA_VERSION => + { + Some(compare_traces( + a.trace.as_ref(), + b.trace.as_ref(), + a.input_set_complete + && b.input_set_complete + && a.input_fingerprint == b.input_fingerprint, + )) + } + _ => None, + }, } }) .collect::>(); let report = CompareReport { compatible_cohort: true, + observed_environment_compatibility: compare_observed_environment( + &before.environment, + &after.environment, + before.schema_version, + after.schema_version, + ), + build_toolchain_compatibility: "unavailable_not_embedded_in_compiler_binary".into(), before_compiler: before.compiler, after_compiler: after.compiler, changes, @@ -164,6 +188,42 @@ pub(super) fn compare(before_path: &str, after_path: &str) -> Result<(), String> Ok(()) } +fn compare_observed_environment( + before: &EnvironmentMetadata, + after: &EnvironmentMetadata, + before_schema: u32, + after_schema: u32, +) -> String { + if before_schema < SCHEMA_VERSION || after_schema < SCHEMA_VERSION { + return "unavailable_legacy_snapshot".into(); + } + let values = [ + (&before.host_os, &after.host_os), + (&before.host_arch, &after.host_arch), + ( + &before.rustc_observed_version, + &after.rustc_observed_version, + ), + ( + &before.cargo_observed_version, + &after.cargo_observed_version, + ), + ]; + if values + .iter() + .any(|(left, right)| left.is_some() && right.is_some() && left != right) + { + "observed_values_differ".into() + } else if values + .iter() + .all(|(left, right)| left.is_some() && right.is_some()) + { + "same_observed_values".into() + } else { + "incomplete_observation".into() + } +} + pub(super) fn compare_status(before: &CaseRecord, after: &CaseRecord) -> &'static str { match (before.status, after.status) { (CaseStatus::Passed, CaseStatus::Passed) => "unchanged_pass", @@ -224,6 +284,7 @@ mod tests { message: message.into(), }), bundle: None, + trace: None, } } @@ -260,6 +321,8 @@ mod tests { working_tree_fingerprint: "tree".into(), binary_fingerprint: "binary".into(), }, + environment: EnvironmentMetadata::default(), + trace_mode: TraceMode::Manifest, cases: vec![ failed_case("A.purs", "expected Integer, got Number"), failed_case("B.purs", "expected Integer, got Boolean"), diff --git a/crates/psrs-cli/src/diagnose/schema.rs b/crates/psrs-cli/src/diagnose/schema.rs new file mode 100644 index 00000000..8d3243ca --- /dev/null +++ b/crates/psrs-cli/src/diagnose/schema.rs @@ -0,0 +1,151 @@ +use super::trace::{CaseTrace, EnvironmentMetadata, TraceMode}; +use serde::{Deserialize, Serialize}; +use std::collections::BTreeMap; +use std::path::PathBuf; + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct SourceInput { + pub(super) name: String, + pub(super) text: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct DiagnosticRecord { + pub(super) origin: String, + pub(super) source: Option, + pub(super) stage: String, + pub(super) start: u32, + pub(super) end: u32, + pub(super) code: Option, + pub(super) kind: Option, + pub(super) message: String, +} + +#[derive(Clone, Copy, Debug, Serialize, Deserialize)] +#[serde(rename_all = "snake_case")] +pub(super) enum CaseStatus { + Passed, + Failed, + Excluded, + TimedOut, + Crashed, +} + +#[derive(Clone, Debug, PartialEq, Eq, Serialize, Deserialize)] +pub(super) struct FirstBlocker { + pub(super) stage: String, + pub(super) category: String, + pub(super) message: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct CaseRecord { + pub(super) path: String, + pub(super) input_fingerprint: String, + pub(super) input_set_complete: bool, + pub(super) elapsed_ms: u64, + pub(super) status: CaseStatus, + pub(super) excluded_reason: Option, + pub(super) diagnostics: Vec, + pub(super) first_blocker: Option, + pub(super) bundle: Option, + #[serde(default)] + pub(super) trace: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct GroupRecord { + pub(super) stage: String, + pub(super) category: String, + pub(super) sample_messages: Vec, + pub(super) cases: Vec, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct Cohort { + pub(super) mode: String, + pub(super) corpus: Option, + pub(super) filter: Option, + pub(super) limit: Option, + pub(super) timeout_seconds: u64, + pub(super) trusted_stdlib_fingerprint: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct CompilerRevision { + pub(super) head: Option, + pub(super) dirty: bool, + pub(super) working_tree_fingerprint: String, + pub(super) binary_fingerprint: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct BundleContext { + pub(super) compiler: CompilerRevision, + pub(super) trusted_stdlib_fingerprint: String, + pub(super) executable: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct Snapshot { + pub(super) schema_version: u32, + pub(super) cohort: Cohort, + pub(super) compiler: CompilerRevision, + #[serde(default)] + pub(super) environment: EnvironmentMetadata, + #[serde(default)] + pub(super) trace_mode: TraceMode, + pub(super) cases: Vec, + pub(super) groups: Vec, + pub(super) counts: BTreeMap, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct CompareRow { + pub(super) path: String, + pub(super) change: String, + pub(super) input_comparison: String, + pub(super) before: Option, + pub(super) after: Option, + #[serde(default)] + pub(super) trace_comparison: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct TraceComparison { + pub(super) status: String, + pub(super) first_pass_difference: Option, + pub(super) artifact_content: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct PassDifference { + pub(super) index: usize, + pub(super) kind: String, + pub(super) before_pass: Option, + pub(super) after_pass: Option, + pub(super) before_status: Option, + pub(super) after_status: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct CompareReport { + pub(super) compatible_cohort: bool, + pub(super) observed_environment_compatibility: String, + pub(super) build_toolchain_compatibility: String, + pub(super) before_compiler: CompilerRevision, + pub(super) after_compiler: CompilerRevision, + pub(super) changes: Vec, +} + +#[derive(Clone, Debug, Default)] +pub(super) struct Options { + pub(super) file: Option, + pub(super) additional_inputs: Vec, + pub(super) corpus: Option, + pub(super) filter: Option, + pub(super) limit: Option, + pub(super) timeout_seconds: u64, + pub(super) output: PathBuf, + pub(super) trace: bool, +} diff --git a/crates/psrs-cli/src/diagnose/trace/build.rs b/crates/psrs-cli/src/diagnose/trace/build.rs new file mode 100644 index 00000000..b1efe1b7 --- /dev/null +++ b/crates/psrs-cli/src/diagnose/trace/build.rs @@ -0,0 +1,404 @@ +use super::*; +use psrs_driver::{ + TraceArtifactState, TraceEdgeRole, TracePassStatus, TraceRepresentation, + TraceValidationCoverage, TraceValidationStatus, +}; +use std::collections::BTreeMap; + +fn representation_key(value: TraceRepresentation) -> &'static str { + match value { + TraceRepresentation::Core => "core", + TraceRepresentation::ExternalBindings => "external_bindings", + TraceRepresentation::ClosureConverted => "closure_converted", + TraceRepresentation::Mir => "mir", + TraceRepresentation::WasmModule => "wasm_module", + TraceRepresentation::WasmCoreBinary => "wasm_core_binary", + TraceRepresentation::ComponentBinary => "component_binary", + TraceRepresentation::WatText => "wat_text", + TraceRepresentation::WitWorld => "wit_world", + TraceRepresentation::WasiRegistry => "wasi_registry", + } +} + +fn artifact_state_key(value: TraceArtifactState) -> &'static str { + match value { + TraceArtifactState::Provided => "provided", + TraceArtifactState::Produced => "produced", + } +} + +fn pass_status_key(value: TracePassStatus) -> &'static str { + match value { + TracePassStatus::Completed => "completed", + TracePassStatus::Rejected => "rejected", + TracePassStatus::NotApplicable => "not_applicable", + } +} + +fn edge_role_key(value: TraceEdgeRole) -> &'static str { + match value { + TraceEdgeRole::Input => "input", + TraceEdgeRole::Output => "output", + } +} + +fn validation_status_key(value: TraceValidationStatus) -> &'static str { + match value { + TraceValidationStatus::Passed => "passed", + TraceValidationStatus::Rejected => "rejected", + } +} + +fn coverage_key(value: TraceValidationCoverage) -> &'static str { + match value { + TraceValidationCoverage::Direct => "direct", + TraceValidationCoverage::Composite => "composite", + TraceValidationCoverage::NotObserved => "not_observed", + } +} + +pub fn from_report( + sources: &[SourceInput], + complete: bool, + fingerprint: &str, + trusted_stdlib_fingerprint: &str, + dumps_requested: bool, + report: &psrs_driver::CompilationReport, +) -> Result { + let mut trace = empty_case_trace(sources, complete, fingerprint, dumps_requested); + let mut artifact_representations = BTreeMap::new(); + let trusted_source_names = report + .frontend_trace + .as_ref() + .map(|frontend| { + frontend + .source_names + .iter() + .take(frontend.trusted_prefix) + .cloned() + .collect::>() + }) + .unwrap_or_default(); + let user_source_names = report + .frontend_trace + .as_ref() + .map(|frontend| { + frontend + .source_names + .iter() + .skip(frontend.trusted_prefix) + .cloned() + .collect::>() + }) + .unwrap_or_default(); + + if let Some(frontend) = report.frontend_trace.as_ref() { + if frontend.trusted_prefix > frontend.source_names.len() { + return Err("frontend trace trusted prefix exceeds its source list".into()); + } + trace.artifacts.push(TraceArtifactRecord { + id: "inputs:trusted_stdlib:i0".into(), + representation: "trusted_library_set".into(), + state: "provided".into(), + producer: None, + format_version: Some(1), + input_fingerprint: Some(InputFingerprint { + algorithm: "fnv1a64_trusted_stdlib".into(), + version: 1, + value: trusted_stdlib_fingerprint.to_owned(), + }), + sources: trusted_source_names + .iter() + .map(|logical_name| TraceSourceRecord { + logical_name: logical_name.clone(), + fingerprint: None, + }) + .collect(), + canonical_summary: TraceAvailability { + status: "not_applicable".into(), + reason: None, + }, + retained_dump: None, + }); + let source_input = "inputs:i0".to_owned(); + let trusted_input = "inputs:trusted_stdlib:i0".to_owned(); + let output = frontend.output_core.map(|id| format!("backend:a{}", id.0)); + trace.executions.push(TraceExecutionRecord { + id: "frontend:e0".into(), + pass_key: frontend.pass_key.into(), + contract_version: frontend.contract_version, + inputs: vec![source_input.clone(), trusted_input.clone()], + outputs: output.iter().cloned().collect(), + input_representations: vec!["source_set".into(), "trusted_library_set".into()], + output_representations: output + .as_ref() + .map(|_| vec!["core".into()]) + .unwrap_or_default(), + status: pass_status_key(frontend.status).into(), + diagnostic_indices: frontend.diagnostic_indices.clone(), + validation_coverage: "not_observed".into(), + parameters: BTreeMap::from([( + "trusted_prefix".into(), + frontend.trusted_prefix.to_string(), + )]), + user_source_names: user_source_names.clone(), + trusted_source_names: trusted_source_names.clone(), + }); + trace.edges.extend([ + TraceEdgeRecord { + execution: "frontend:e0".into(), + artifact: source_input, + role: "input".into(), + }, + TraceEdgeRecord { + execution: "frontend:e0".into(), + artifact: trusted_input, + role: "input".into(), + }, + ]); + if let Some(artifact) = output { + trace.edges.push(TraceEdgeRecord { + execution: "frontend:e0".into(), + artifact, + role: "output".into(), + }); + } + } + + if let Some(backend) = report.backend_trace.as_ref() { + let frontend_core = report + .frontend_trace + .as_ref() + .and_then(|frontend| frontend.output_core); + if frontend_core.is_some_and(|id| id != backend.initial_core) { + return Err("frontend trace output does not match backend initial Core".into()); + } + for artifact in &backend.artifacts { + let id = format!("backend:a{}", artifact.id.0); + let representation = representation_key(artifact.representation).to_owned(); + artifact_representations.insert(artifact.id.0, representation.clone()); + let frontend_produced = artifact.id == backend.initial_core && frontend_core.is_some(); + trace.artifacts.push(TraceArtifactRecord { + id, + representation, + state: if frontend_produced { + "produced" + } else { + artifact_state_key(artifact.state) + } + .into(), + producer: if frontend_produced { + Some("frontend:e0".into()) + } else { + artifact + .producer + .map(|producer| format!("backend:e{}", producer.0)) + }, + format_version: None, + input_fingerprint: None, + sources: Vec::new(), + canonical_summary: TraceAvailability::unavailable( + "canonical artifact summaries are not implemented", + ), + retained_dump: retained_dump_for(artifact.id.0, report, dumps_requested), + }); + } + validate_dump_refs(report, backend)?; + for execution in &backend.executions { + let inputs = execution + .inputs + .iter() + .map(|artifact| format!("backend:a{}", artifact.0)) + .collect::>(); + let outputs = execution + .outputs + .iter() + .map(|artifact| format!("backend:a{}", artifact.0)) + .collect::>(); + let input_representations = representation_list( + execution.id.0, + "input", + &execution.inputs, + &artifact_representations, + )?; + let output_representations = representation_list( + execution.id.0, + "output", + &execution.outputs, + &artifact_representations, + )?; + trace.executions.push(TraceExecutionRecord { + id: format!("backend:e{}", execution.id.0), + pass_key: execution.pass_key.into(), + contract_version: execution.contract_version, + input_representations, + output_representations, + inputs, + outputs, + status: pass_status_key(execution.status).into(), + diagnostic_indices: execution.diagnostic_indices.clone(), + validation_coverage: coverage_key(execution.validation_coverage).into(), + parameters: execution + .parameters + .iter() + .map(|parameter| (parameter.key.to_owned(), parameter.value.clone())) + .collect(), + user_source_names: Vec::new(), + trusted_source_names: Vec::new(), + }); + } + trace + .edges + .extend(backend.edges.iter().map(|edge| TraceEdgeRecord { + execution: format!("backend:e{}", edge.execution.0), + artifact: format!("backend:a{}", edge.artifact.0), + role: edge_role_key(edge.role).into(), + })); + for validation in &backend.validations { + trace.validations.push(TraceValidationRecord { + execution: format!("backend:e{}", validation.execution.0), + validator_key: validation.validator_key.into(), + artifacts: validation + .artifacts + .iter() + .map(|artifact| format!("backend:a{}", artifact.0)) + .collect(), + status: validation_status_key(validation.status).into(), + coverage: coverage_key(validation.coverage).into(), + }); + } + } + trace.pass_capture = match (&report.frontend_trace, &report.artifact) { + (None, _) => TraceAvailability::unavailable( + "trusted prelude loading stopped before the frontend trace boundary", + ), + (Some(_), Some(_)) => TraceAvailability { + status: "complete".into(), + reason: None, + }, + (Some(_), None) => TraceAvailability { + status: "observed_prefix".into(), + reason: Some("compilation stopped after the recorded execution prefix".into()), + }, + }; + validate_references(&trace)?; + Ok(trace) +} + +fn representation_list( + execution_id: u32, + role: &str, + ids: &[psrs_driver::TraceArtifactId], + representations: &BTreeMap, +) -> Result, String> { + ids.iter() + .map(|artifact| { + representations.get(&artifact.0).cloned().ok_or_else(|| { + format!( + "backend trace execution {execution_id} references missing {role} artifact {}", + artifact.0 + ) + }) + }) + .collect() +} + +fn retained_dump_for( + artifact_id: u32, + report: &psrs_driver::CompilationReport, + requested: bool, +) -> Option { + if !requested { + return None; + } + if report + .dump_artifacts + .core + .is_some_and(|id| id.0 == artifact_id) + { + Some("core.debug".into()) + } else if report + .dump_artifacts + .cc + .is_some_and(|id| id.0 == artifact_id) + { + Some("cc.debug".into()) + } else if report + .dump_artifacts + .mir + .is_some_and(|id| id.0 == artifact_id) + { + Some("mir.debug".into()) + } else { + None + } +} + +fn validate_dump_refs( + report: &psrs_driver::CompilationReport, + backend: &psrs_driver::CompileTrace, +) -> Result<(), String> { + for id in [ + report.dump_artifacts.core, + report.dump_artifacts.cc, + report.dump_artifacts.mir, + ] + .into_iter() + .flatten() + { + if !backend.artifacts.iter().any(|artifact| artifact.id == id) { + return Err(format!( + "IR dump references missing backend artifact {}", + id.0 + )); + } + } + Ok(()) +} + +fn validate_references(trace: &CaseTrace) -> Result<(), String> { + let artifact_ids = trace + .artifacts + .iter() + .map(|artifact| artifact.id.as_str()) + .collect::>(); + let execution_ids = trace + .executions + .iter() + .map(|execution| execution.id.as_str()) + .collect::>(); + for execution in &trace.executions { + for artifact in execution.inputs.iter().chain(&execution.outputs) { + if !artifact_ids.contains(artifact.as_str()) { + return Err(format!( + "trace execution {} references unknown artifact {artifact}", + execution.id + )); + } + } + } + for edge in &trace.edges { + if !execution_ids.contains(edge.execution.as_str()) + || !artifact_ids.contains(edge.artifact.as_str()) + { + return Err(format!( + "trace edge references unknown execution/artifact {} / {}", + edge.execution, edge.artifact + )); + } + } + for validation in &trace.validations { + if !execution_ids.contains(validation.execution.as_str()) + || validation + .artifacts + .iter() + .any(|artifact| !artifact_ids.contains(artifact.as_str())) + { + return Err(format!( + "trace validation references unknown execution/artifact {}", + validation.execution + )); + } + } + Ok(()) +} diff --git a/crates/psrs-cli/src/diagnose/trace/compare.rs b/crates/psrs-cli/src/diagnose/trace/compare.rs new file mode 100644 index 00000000..98dc26ca --- /dev/null +++ b/crates/psrs-cli/src/diagnose/trace/compare.rs @@ -0,0 +1,112 @@ +use super::super::{PassDifference, TraceComparison}; +use super::{CaseTrace, TraceExecutionRecord}; + +pub fn compare_traces( + before: Option<&CaseTrace>, + after: Option<&CaseTrace>, + same_inputs: bool, +) -> TraceComparison { + let unavailable = |status: &str| TraceComparison { + status: status.into(), + first_pass_difference: None, + artifact_content: "unavailable_no_canonical_summary".into(), + }; + if !same_inputs { + return unavailable("not_compared_input_mismatch"); + } + let (Some(before), Some(after)) = (before, after) else { + return unavailable("unavailable_trace_missing"); + }; + if before.version != after.version { + return unavailable("unavailable_trace_version_mismatch"); + } + if before.version != 1 { + return unavailable("unavailable_unsupported_trace_version"); + } + if before.pass_capture.status == "unavailable" || after.pass_capture.status == "unavailable" { + return unavailable("unavailable_pass_capture_gap"); + } + + let max_len = before.executions.len().max(after.executions.len()); + for index in 0..max_len { + let left = before.executions.get(index); + let right = after.executions.get(index); + let Some(kind) = execution_difference(left, right) else { + continue; + }; + return TraceComparison { + status: "pass_difference_observed".into(), + first_pass_difference: Some(PassDifference { + index, + kind: kind.into(), + before_pass: left.map(|pass| pass.pass_key.clone()), + after_pass: right.map(|pass| pass.pass_key.clone()), + before_status: left.map(|pass| pass.status.clone()), + after_status: right.map(|pass| pass.status.clone()), + }), + artifact_content: "unavailable_no_canonical_summary".into(), + }; + } + if before.pass_capture.status != after.pass_capture.status { + let index = max_len; + return TraceComparison { + status: "pass_capture_coverage_changed".into(), + first_pass_difference: Some(PassDifference { + index, + kind: "pass_capture_coverage_changed".into(), + before_pass: None, + after_pass: None, + before_status: Some(before.pass_capture.status.clone()), + after_status: Some(after.pass_capture.status.clone()), + }), + artifact_content: "unavailable_no_canonical_summary".into(), + }; + } + if before.pass_capture.status == "observed_prefix" { + return TraceComparison { + status: "no_difference_in_observed_prefix".into(), + first_pass_difference: None, + artifact_content: "unavailable_no_canonical_summary".into(), + }; + } + TraceComparison { + status: "no_observed_pass_difference".into(), + first_pass_difference: None, + artifact_content: "unavailable_no_canonical_summary".into(), + } +} + +fn execution_difference( + before: Option<&TraceExecutionRecord>, + after: Option<&TraceExecutionRecord>, +) -> Option<&'static str> { + match (before, after) { + (None, Some(_)) => Some("pass_added"), + (Some(_), None) => Some("pass_removed"), + (Some(before), Some(after)) if before.pass_key != after.pass_key => { + Some("pass_order_or_identity_changed") + } + (Some(before), Some(after)) if before.contract_version != after.contract_version => { + Some("pass_contract_changed") + } + (Some(before), Some(after)) if before.status != after.status => Some("pass_status_changed"), + (Some(before), Some(after)) + if before.input_representations != after.input_representations + || before.output_representations != after.output_representations => + { + Some("pass_boundary_changed") + } + (Some(before), Some(after)) if before.validation_coverage != after.validation_coverage => { + Some("validation_coverage_changed") + } + (Some(before), Some(after)) + if before.parameters != after.parameters + || before.user_source_names != after.user_source_names + || before.trusted_source_names != after.trusted_source_names => + { + Some("pass_inputs_or_parameters_changed") + } + (Some(_), Some(_)) => None, + (None, None) => None, + } +} diff --git a/crates/psrs-cli/src/diagnose/trace/environment.rs b/crates/psrs-cli/src/diagnose/trace/environment.rs new file mode 100644 index 00000000..a9172432 --- /dev/null +++ b/crates/psrs-cli/src/diagnose/trace/environment.rs @@ -0,0 +1,19 @@ +use super::EnvironmentMetadata; + +pub fn observed_environment() -> EnvironmentMetadata { + EnvironmentMetadata { + host_os: Some(std::env::consts::OS.into()), + host_arch: Some(std::env::consts::ARCH.into()), + rustc_observed_version: command_version("rustc", "--version"), + cargo_observed_version: command_version("cargo", "--version"), + } +} + +fn command_version(command: &str, argument: &str) -> Option { + std::process::Command::new(command) + .arg(argument) + .output() + .ok() + .filter(|output| output.status.success()) + .map(|output| String::from_utf8_lossy(&output.stdout).trim().to_owned()) +} diff --git a/crates/psrs-cli/src/diagnose/trace/mod.rs b/crates/psrs-cli/src/diagnose/trace/mod.rs new file mode 100644 index 00000000..ef62a08e --- /dev/null +++ b/crates/psrs-cli/src/diagnose/trace/mod.rs @@ -0,0 +1,170 @@ +use super::{SourceInput, fingerprint_sources}; +use serde::{Deserialize, Serialize}; +use std::collections::BTreeMap; + +#[derive(Clone, Copy, Debug, Default, PartialEq, Eq, Serialize, Deserialize)] +#[serde(rename_all = "snake_case")] +pub(super) enum TraceMode { + #[default] + Manifest, + Dumps, +} + +#[derive(Clone, Debug, Default, PartialEq, Eq, Serialize, Deserialize)] +pub(super) struct EnvironmentMetadata { + pub(super) host_os: Option, + pub(super) host_arch: Option, + pub(super) rustc_observed_version: Option, + pub(super) cargo_observed_version: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct CaseTrace { + pub(super) version: u32, + pub(super) dumps_requested: bool, + pub(super) source_set_complete: bool, + pub(super) pass_capture: TraceAvailability, + pub(super) artifacts: Vec, + pub(super) executions: Vec, + pub(super) edges: Vec, + pub(super) validations: Vec, + pub(super) lineage: TraceAvailability, + pub(super) canonical_summaries: TraceAvailability, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct TraceArtifactRecord { + pub(super) id: String, + pub(super) representation: String, + pub(super) state: String, + pub(super) producer: Option, + pub(super) format_version: Option, + pub(super) input_fingerprint: Option, + pub(super) sources: Vec, + pub(super) canonical_summary: TraceAvailability, + pub(super) retained_dump: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct InputFingerprint { + pub(super) algorithm: String, + pub(super) version: u32, + pub(super) value: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct TraceSourceRecord { + pub(super) logical_name: String, + pub(super) fingerprint: Option, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct TraceExecutionRecord { + pub(super) id: String, + pub(super) pass_key: String, + pub(super) contract_version: u32, + pub(super) inputs: Vec, + pub(super) outputs: Vec, + pub(super) input_representations: Vec, + pub(super) output_representations: Vec, + pub(super) status: String, + pub(super) diagnostic_indices: Vec, + pub(super) validation_coverage: String, + pub(super) parameters: BTreeMap, + pub(super) user_source_names: Vec, + pub(super) trusted_source_names: Vec, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct TraceEdgeRecord { + pub(super) execution: String, + pub(super) artifact: String, + pub(super) role: String, +} + +#[derive(Clone, Debug, Serialize, Deserialize)] +pub(super) struct TraceValidationRecord { + pub(super) execution: String, + pub(super) validator_key: String, + pub(super) artifacts: Vec, + pub(super) status: String, + pub(super) coverage: String, +} + +#[derive(Clone, Debug, PartialEq, Eq, Serialize, Deserialize)] +pub(super) struct TraceAvailability { + pub(super) status: String, + pub(super) reason: Option, +} + +impl TraceAvailability { + fn unavailable(reason: &str) -> Self { + Self { + status: "unavailable".into(), + reason: Some(reason.into()), + } + } +} + +pub(super) fn empty_case_trace( + sources: &[SourceInput], + complete: bool, + fingerprint: &str, + dumps_requested: bool, +) -> CaseTrace { + CaseTrace { + version: 1, + dumps_requested, + source_set_complete: complete, + pass_capture: TraceAvailability::unavailable( + "compiler did not reach an instrumented frontend pass boundary", + ), + artifacts: vec![source_set_artifact(sources, complete, fingerprint)], + executions: Vec::new(), + edges: Vec::new(), + validations: Vec::new(), + lineage: TraceAvailability::unavailable("node lineage is not captured by this trace slice"), + canonical_summaries: TraceAvailability::unavailable( + "no canonical artifact summary is implemented for this representation", + ), + } +} + +fn source_set_artifact( + sources: &[SourceInput], + complete: bool, + fingerprint: &str, +) -> TraceArtifactRecord { + TraceArtifactRecord { + id: "inputs:i0".into(), + representation: "source_set".into(), + state: if complete { "provided" } else { "partial" }.into(), + producer: None, + format_version: Some(1), + input_fingerprint: Some(InputFingerprint { + algorithm: "fnv1a64_ordered_sources".into(), + version: 1, + value: fingerprint.to_owned(), + }), + sources: sources + .iter() + .map(|source| TraceSourceRecord { + logical_name: source.name.clone(), + fingerprint: Some(fingerprint_sources(std::slice::from_ref(source))), + }) + .collect(), + canonical_summary: TraceAvailability { + status: "not_applicable".into(), + reason: None, + }, + retained_dump: None, + } +} + +mod build; +mod compare; +mod environment; + +pub(super) use build::from_report; +pub(super) use compare::compare_traces; +pub(super) use environment::observed_environment; diff --git a/crates/psrs-cli/src/diagnose/worker.rs b/crates/psrs-cli/src/diagnose/worker.rs index e32c130d..b6c443a2 100644 --- a/crates/psrs-cli/src/diagnose/worker.rs +++ b/crates/psrs-cli/src/diagnose/worker.rs @@ -1,4 +1,7 @@ -use super::{DiagnosticRecord, SourceInput, atomic_write, fingerprint_sources, first_line}; +use super::{ + CaseTrace, DiagnosticRecord, SourceInput, atomic_write, empty_case_trace, fingerprint_sources, + first_line, from_report, +}; use serde::{Deserialize, Serialize}; use std::path::{Path, PathBuf}; use std::process::{Command, Stdio}; @@ -6,9 +9,15 @@ use std::time::{Duration, Instant}; use std::{env, fs, thread}; #[derive(Clone, Debug, Serialize, Deserialize)] -struct WorkerRequest { - path: String, - category_dir: Option, +pub(super) struct WorkerRequest { + pub(super) path: String, + pub(super) category_dir: Option, + #[serde(default)] + pub(super) explicit_inputs: Vec, + #[serde(default)] + pub(super) capture_dumps: bool, + #[serde(default)] + pub(super) trusted_stdlib_fingerprint: String, } #[derive(Clone, Debug, Serialize, Deserialize)] @@ -25,11 +34,12 @@ pub(super) struct WorkerResponse { pub(super) cc: Option, pub(super) mir_stage: Option, pub(super) mir: Option, + pub(super) trace: Option, } #[derive(Debug)] pub(super) enum WorkerOutcome { - Completed(WorkerResponse), + Completed(Box), TimedOut { elapsed_ms: u64, }, @@ -72,6 +82,7 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { cc: None, mir_stage: None, mir: None, + trace: None, }; return atomic_write( Path::new(response_path), @@ -82,8 +93,18 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { let loaded = if let Some(category) = request.category_dir.as_deref() { psrs_driver::load_program_case_sources(&entry_path, Path::new(category), &entry_text) .map(|case| case.own.into_iter().chain(case.loaded).collect::>()) + } else if request.explicit_inputs.is_empty() { + psrs_driver::load_program_files(std::slice::from_ref(&request.path)) } else { - psrs_driver::load_program_files(&[request.path.clone()]) + request + .explicit_inputs + .iter() + .map(|path| { + fs::read_to_string(path) + .map(|text| (path.clone(), text)) + .map_err(|error| format!("{path}: {error}")) + }) + .collect::, _>>() }; let (sources, input_set_complete, load_error) = match loaded { Ok(sources) => (sources, true, None), @@ -97,9 +118,16 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { }) .collect::>(); if let Some(error) = load_error { + let input_fingerprint = fingerprint_sources(&inputs); + let trace = empty_case_trace( + &inputs, + input_set_complete, + &input_fingerprint, + request.capture_dumps, + ); let response = WorkerResponse { passed: false, - input_fingerprint: fingerprint_sources(&inputs), + input_fingerprint, sources: inputs, input_set_complete, elapsed_ms: started.elapsed().as_millis() as u64, @@ -119,6 +147,7 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { cc: None, mir_stage: None, mir: None, + trace: Some(trace), }; return atomic_write( Path::new(response_path), @@ -130,7 +159,19 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { .iter() .map(|source| (source.name.as_str(), source.text.as_str())) .collect::>(); - let report = psrs_driver::compile_program_sources_with_prelude_report(&source_refs); + let report = psrs_driver::compile_program_sources_with_prelude_diagnosis( + &source_refs, + request.capture_dumps, + ); + let input_fingerprint = fingerprint_sources(&sources); + let trace = from_report( + &sources, + input_set_complete, + &input_fingerprint, + &request.trusted_stdlib_fingerprint, + request.capture_dumps, + &report, + )?; let diagnostics = report .diagnostics .iter() @@ -157,7 +198,7 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { .collect::>(); let response = WorkerResponse { passed: report.artifact.is_some(), - input_fingerprint: fingerprint_sources(&sources), + input_fingerprint, sources, input_set_complete, elapsed_ms: started.elapsed().as_millis() as u64, @@ -168,6 +209,7 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { cc: report.dumps.cc, mir_stage: report.dumps.mir_stage.map(str::to_owned), mir: report.dumps.mir, + trace: Some(trace), }; atomic_write( Path::new(response_path), @@ -175,56 +217,11 @@ pub fn worker(request_path: &str, response_path: &str) -> Result<(), String> { ) } -#[cfg(test)] -mod tests { - use super::*; - use std::time::{SystemTime, UNIX_EPOCH}; - - #[test] - fn missing_entry_is_a_loading_error_without_fabricated_source() { - let unique = SystemTime::now() - .duration_since(UNIX_EPOCH) - .expect("clock after UNIX epoch") - .as_nanos(); - let root = env::temp_dir().join(format!("psrs-diagnose-worker-{unique}")); - fs::create_dir_all(&root).expect("create worker test directory"); - let missing = root.join("missing.purs"); - let request_path = root.join("request.json"); - let response_path = root.join("response.json"); - let request = WorkerRequest { - path: missing.to_string_lossy().into_owned(), - category_dir: None, - }; - fs::write( - &request_path, - serde_json::to_vec(&request).expect("serialize worker request"), - ) - .expect("write worker request"); - - worker( - request_path.to_str().expect("request path is UTF-8"), - response_path.to_str().expect("response path is UTF-8"), - ) - .expect("worker writes loading-error response"); - let response: WorkerResponse = - serde_json::from_slice(&fs::read(&response_path).expect("read worker response")) - .expect("parse worker response"); - - assert!(!response.passed); - assert!(!response.input_set_complete); - assert!(response.sources.is_empty()); - assert_eq!(response.diagnostics[0].stage, "input loading"); - assert!(response.diagnostics[0].message.contains("missing.purs")); - let _ = fs::remove_dir_all(root); - } -} - pub(super) fn run_worker( work_root: &Path, index: usize, - path: &Path, - category_dir: Option<&Path>, timeout_seconds: u64, + request: WorkerRequest, ) -> Result { let worker_dir = work_root.join(format!("case-{index}")); let _ = fs::remove_dir_all(&worker_dir); @@ -233,10 +230,6 @@ pub(super) fn run_worker( let request_path = worker_dir.join("request.json"); let response_path = worker_dir.join("response.json"); let stderr_path = worker_dir.join("stderr.log"); - let request = WorkerRequest { - path: path.to_string_lossy().into_owned(), - category_dir: category_dir.map(|path| path.to_string_lossy().into_owned()), - }; fs::write( &request_path, serde_json::to_vec(&request).map_err(|error| error.to_string())?, @@ -274,7 +267,7 @@ pub(super) fn run_worker( elapsed_ms: started.elapsed().as_millis() as u64, }); }; - return Ok(WorkerOutcome::Completed(result)); + return Ok(WorkerOutcome::Completed(Box::new(result))); } if started.elapsed() >= Duration::from_secs(timeout_seconds) { child @@ -288,3 +281,50 @@ pub(super) fn run_worker( thread::sleep(Duration::from_millis(15)); } } + +#[cfg(test)] +mod tests { + use super::*; + use std::time::{SystemTime, UNIX_EPOCH}; + + #[test] + fn missing_entry_is_a_loading_error_without_fabricated_source() { + let unique = SystemTime::now() + .duration_since(UNIX_EPOCH) + .expect("clock after UNIX epoch") + .as_nanos(); + let root = env::temp_dir().join(format!("psrs-diagnose-worker-{unique}")); + fs::create_dir_all(&root).expect("create worker test directory"); + let missing = root.join("missing.purs"); + let request_path = root.join("request.json"); + let response_path = root.join("response.json"); + let request = WorkerRequest { + path: missing.to_string_lossy().into_owned(), + category_dir: None, + explicit_inputs: Vec::new(), + capture_dumps: false, + trusted_stdlib_fingerprint: String::new(), + }; + fs::write( + &request_path, + serde_json::to_vec(&request).expect("serialize worker request"), + ) + .expect("write worker request"); + + worker( + request_path.to_str().expect("request path is UTF-8"), + response_path.to_str().expect("response path is UTF-8"), + ) + .expect("worker writes loading-error response"); + let response: WorkerResponse = + serde_json::from_slice(&fs::read(&response_path).expect("read worker response")) + .expect("parse worker response"); + + assert!(!response.passed); + assert!(!response.input_set_complete); + assert!(response.sources.is_empty()); + assert_eq!(response.diagnostics[0].stage, "input loading"); + assert!(response.diagnostics[0].message.contains("missing.purs")); + let _ = fs::remove_dir_all(root); + } +} diff --git a/crates/psrs-cli/src/main.rs b/crates/psrs-cli/src/main.rs index 35237b0f..66a05c35 100644 --- a/crates/psrs-cli/src/main.rs +++ b/crates/psrs-cli/src/main.rs @@ -269,7 +269,7 @@ fn compile_program(command: &str, raw_args: Vec) -> Result<(), String> { } fn usage() -> String { - "usage: psrs \n psrs check-program ...\n psrs check-program-kinds ...\n psrs build ... [-o output.wasm]\n psrs wat ... [-o output.wat]\n psrs dump \n psrs diagnose [--out report.json]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--out report.json]\n psrs diagnose --compare OLD.json NEW.json".into() + "usage: psrs \n psrs check-program ...\n psrs check-program-kinds ...\n psrs build ... [-o output.wasm]\n psrs wat ... [-o output.wat]\n psrs dump \n psrs diagnose [--input FILE]... [--trace] [--out report.json]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--trace] [--out report.json]\n psrs diagnose --compare OLD.json NEW.json".into() } fn check_program(paths: &[String], kinds: bool) -> Result<(), String> { diff --git a/crates/psrs-cli/tests/diagnose_trace.rs b/crates/psrs-cli/tests/diagnose_trace.rs new file mode 100644 index 00000000..d43eac52 --- /dev/null +++ b/crates/psrs-cli/tests/diagnose_trace.rs @@ -0,0 +1,310 @@ +use std::path::{Path, PathBuf}; +use std::process::{Command, Output}; +use std::time::{SystemTime, UNIX_EPOCH}; + +fn test_dir(label: &str) -> PathBuf { + let unique = SystemTime::now() + .duration_since(UNIX_EPOCH) + .expect("clock after UNIX epoch") + .as_nanos(); + let path = std::env::temp_dir().join(format!("psrs-{label}-{}-{unique}", std::process::id())); + std::fs::create_dir_all(&path).expect("create CLI test directory"); + path +} + +fn diagnose(args: &[&str]) -> Output { + Command::new(env!("CARGO_BIN_EXE_psrs")) + .args(["diagnose"]) + .args(args) + .output() + .expect("run psrs diagnose") +} + +fn value(path: &Path) -> serde_json::Value { + serde_json::from_slice(&std::fs::read(path).expect("read JSON fixture")) + .expect("parse JSON fixture") +} + +#[test] +fn diagnose_trace_captures_pass_dumps_and_keeps_v1_status_comparison() { + let root = test_dir("diagnose-trace"); + let source = root.join("Main.purs"); + let manifest = root.join("manifest.json"); + let traced_manifest = root.join("trace.json"); + let changed_manifest = root.join("changed-trace.json"); + let legacy_manifest = root.join("legacy-v1.json"); + std::fs::write( + &source, + "module Main where\nimport Prelude\nmain = 40 + 2\n", + ) + .expect("write accepted source"); + + for (args, label) in [ + ( + vec![ + source.to_str().unwrap(), + "--out", + manifest.to_str().unwrap(), + ], + "manifest", + ), + ( + vec![ + source.to_str().unwrap(), + "--trace", + "--out", + traced_manifest.to_str().unwrap(), + ], + "trace", + ), + ] { + let result = diagnose(&args); + assert!( + result.status.success(), + "{label} diagnosis failed: {}", + String::from_utf8_lossy(&result.stderr) + ); + } + + let before = value(&manifest); + assert_eq!(before["schema_version"], 2); + assert_eq!(before["trace_mode"], "manifest"); + let before_case = &before["cases"][0]; + assert_eq!(before_case["status"], "passed"); + assert_eq!(before_case["trace"]["dumps_requested"], false); + assert_eq!( + before_case["trace"]["canonical_summaries"]["status"], + "unavailable" + ); + assert!(before_case["trace"]["executions"].as_array().unwrap().len() > 1); + let frontend = &before_case["trace"]["executions"][0]; + assert_eq!(frontend["id"], "frontend:e0"); + assert!( + frontend["inputs"] + .as_array() + .unwrap() + .contains(&"inputs:i0".into()) + ); + assert!( + frontend["inputs"] + .as_array() + .unwrap() + .contains(&"inputs:trusted_stdlib:i0".into()) + ); + let core = before_case["trace"]["artifacts"] + .as_array() + .unwrap() + .iter() + .find(|artifact| artifact["id"] == "backend:a0") + .unwrap(); + assert_eq!(core["state"], "produced"); + assert_eq!(core["producer"], "frontend:e0"); + assert!( + before_case["trace"]["artifacts"] + .as_array() + .unwrap() + .iter() + .all(|artifact| artifact["retained_dump"].is_null()) + ); + + let traced = value(&traced_manifest); + assert_eq!(traced["trace_mode"], "dumps"); + let traced_case = &traced["cases"][0]; + assert_eq!(traced_case["status"], "passed"); + assert_eq!(traced_case["trace"]["dumps_requested"], true); + let bundle = PathBuf::from(traced_case["bundle"].as_str().unwrap()); + for name in ["core.debug", "cc.debug", "mir.debug"] { + assert!(bundle.join(name).is_file(), "missing retained {name}"); + assert!( + traced_case["trace"]["artifacts"] + .as_array() + .unwrap() + .iter() + .any(|artifact| artifact["retained_dump"] == name) + ); + } + assert!(value(&bundle.join("case.json"))["trace"].is_object()); + let trace_replay = + std::fs::read_to_string(bundle.join("replay.sh")).expect("read trace replay script"); + assert!(trace_replay.contains("'diagnose'")); + assert!(trace_replay.contains(" build ")); + + let same_trace_compare = Command::new(env!("CARGO_BIN_EXE_psrs")) + .args([ + "diagnose", + "--compare", + manifest.to_str().unwrap(), + traced_manifest.to_str().unwrap(), + ]) + .output() + .expect("compare manifest and trace runs"); + assert!(same_trace_compare.status.success()); + let same_trace_report: serde_json::Value = + serde_json::from_slice(&same_trace_compare.stdout).expect("parse trace comparison"); + assert_eq!( + same_trace_report["changes"][0]["trace_comparison"]["status"], + "no_observed_pass_difference" + ); + assert_eq!( + same_trace_report["changes"][0]["trace_comparison"]["artifact_content"], + "unavailable_no_canonical_summary" + ); + + let mut changed = traced.clone(); + let passes = changed["cases"][0]["trace"]["executions"] + .as_array_mut() + .unwrap(); + passes[0]["status"] = "rejected".into(); + std::fs::write( + &changed_manifest, + serde_json::to_vec_pretty(&changed).unwrap(), + ) + .expect("write changed trace fixture"); + let changed_compare = Command::new(env!("CARGO_BIN_EXE_psrs")) + .args([ + "diagnose", + "--compare", + traced_manifest.to_str().unwrap(), + changed_manifest.to_str().unwrap(), + ]) + .output() + .expect("compare pass status change"); + assert!(changed_compare.status.success()); + let changed_report: serde_json::Value = + serde_json::from_slice(&changed_compare.stdout).expect("parse changed comparison"); + assert_eq!( + changed_report["changes"][0]["trace_comparison"]["first_pass_difference"]["kind"], + "pass_status_changed" + ); + + let mut legacy = before; + legacy["schema_version"] = 1.into(); + legacy.as_object_mut().unwrap().remove("environment"); + legacy.as_object_mut().unwrap().remove("trace_mode"); + legacy["cases"][0].as_object_mut().unwrap().remove("trace"); + std::fs::write( + &legacy_manifest, + serde_json::to_vec_pretty(&legacy).unwrap(), + ) + .expect("write v1 snapshot fixture"); + let comparison = Command::new(env!("CARGO_BIN_EXE_psrs")) + .args([ + "diagnose", + "--compare", + legacy_manifest.to_str().unwrap(), + traced_manifest.to_str().unwrap(), + ]) + .output() + .expect("compare v1 and v2 snapshots"); + assert!( + comparison.status.success(), + "v1 comparison failed: {}", + String::from_utf8_lossy(&comparison.stderr) + ); + let comparison_json: serde_json::Value = + serde_json::from_slice(&comparison.stdout).expect("parse compare report"); + assert_eq!( + comparison_json["observed_environment_compatibility"], + "unavailable_legacy_snapshot" + ); + assert_eq!( + comparison_json["build_toolchain_compatibility"], + "unavailable_not_embedded_in_compiler_binary" + ); + assert!(comparison_json["changes"][0]["trace_comparison"].is_null()); + + let _ = std::fs::remove_dir_all(root); +} + +#[test] +fn diagnose_input_list_is_ordered_exact_and_replayed_with_trace() { + let root = test_dir("diagnose-inputs"); + let main = root.join("Main.purs"); + let spare = root.join("Spare.purs"); + let helper = root.join("Helper.purs"); + let hidden = root.join("Hidden.purs"); + let snapshot = root.join("snapshot.json"); + std::fs::write( + &main, + "module Main where\nimport Prelude\nimport Spare\nimport Helper\nmain = spare + helper\n", + ) + .expect("write entry source"); + std::fs::write(&spare, "module Spare where\nspare = 1\n").expect("write first explicit input"); + std::fs::write( + &helper, + "module Helper where\nimport Hidden\nhelper = hidden\n", + ) + .expect("write second explicit input"); + std::fs::write(&hidden, "module Hidden where\nhidden = 2\n") + .expect("write unlisted adjacent module"); + + let result = diagnose(&[ + main.to_str().unwrap(), + "--input", + spare.to_str().unwrap(), + "--input", + helper.to_str().unwrap(), + "--trace", + "--out", + snapshot.to_str().unwrap(), + ]); + assert!( + result.status.success(), + "diagnosis command failed: {}", + String::from_utf8_lossy(&result.stderr) + ); + let report = value(&snapshot); + let case = &report["cases"][0]; + assert_eq!(case["status"], "failed"); + let sources = case["trace"]["artifacts"][0]["sources"] + .as_array() + .unwrap() + .iter() + .map(|source| source["logical_name"].as_str().unwrap()) + .collect::>(); + assert_eq!( + sources, + [ + main.to_str().unwrap(), + spare.to_str().unwrap(), + helper.to_str().unwrap() + ] + ); + assert!( + case["diagnostics"] + .as_array() + .unwrap() + .iter() + .any(|diagnostic| diagnostic["message"].as_str().unwrap().contains("Hidden")) + ); + + let bundle = PathBuf::from(case["bundle"].as_str().unwrap()); + let replay = Command::new("sh") + .arg(bundle.join("replay.sh")) + .current_dir(&root) + .output() + .expect("run trace replay"); + assert!( + !replay.status.success(), + "the unresolved import should fail" + ); + assert!( + bundle.join("replay-trace.json").is_file(), + "replay did not recapture a trace" + ); + + let duplicate = diagnose(&[ + main.to_str().unwrap(), + "--input", + helper.to_str().unwrap(), + "--input", + root.join(".").join("Helper.purs").to_str().unwrap(), + ]); + assert!(!duplicate.status.success()); + assert!(String::from_utf8_lossy(&duplicate.stderr).contains("duplicate diagnosis input")); + + let corpus_input = diagnose(&["--corpus", "passing", "--input", helper.to_str().unwrap()]); + assert!(!corpus_input.status.success()); + + let _ = std::fs::remove_dir_all(root); +} diff --git a/crates/psrs-driver/src/diagnostics.rs b/crates/psrs-driver/src/diagnostics.rs index 000351dd..507bb63c 100644 --- a/crates/psrs-driver/src/diagnostics.rs +++ b/crates/psrs-driver/src/diagnostics.rs @@ -1,7 +1,8 @@ use crate::{Artifact, ProgramDiagnostic}; +use psrs_backend::{CompileTrace, TraceArtifactId, TracePassStatus}; /// IR dumps retained when a program reaches only part of the compile pipeline. -/// A stage name records exactly which pass produced the dump. +/// The boundary label identifies the last pass completed or input boundary. #[derive(Clone, Debug, Default, PartialEq, Eq)] pub struct PartialIrDumps { pub core_stage: Option<&'static str>, @@ -18,6 +19,31 @@ pub struct CompilationReport { pub artifact: Option, pub diagnostics: Vec, pub dumps: PartialIrDumps, + /// Backend pass/artifact events, populated only by the diagnosis entrypoint. + pub backend_trace: Option, + /// The driver-owned frontend boundary for a diagnosis compile attempt. + pub frontend_trace: Option, + /// Exact trace artifacts represented by the retained Core/CC/MIR dumps. + pub dump_artifacts: IrDumpArtifacts, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct FrontendPassTrace { + pub contract_version: u32, + pub pass_key: &'static str, + /// Number of leading entries owned by the trusted library. + pub trusted_prefix: usize, + pub source_names: Vec, + pub status: TracePassStatus, + pub output_core: Option, + pub diagnostic_indices: Vec, +} + +#[derive(Clone, Debug, Default, PartialEq, Eq)] +pub struct IrDumpArtifacts { + pub core: Option, + pub cc: Option, + pub mir: Option, } impl CompilationReport { @@ -26,6 +52,9 @@ impl CompilationReport { artifact: None, diagnostics, dumps, + backend_trace: None, + frontend_trace: None, + dump_artifacts: IrDumpArtifacts::default(), } } } diff --git a/crates/psrs-driver/src/lib.rs b/crates/psrs-driver/src/lib.rs index ff3d495b..44e6e377 100644 --- a/crates/psrs-driver/src/lib.rs +++ b/crates/psrs-driver/src/lib.rs @@ -5,7 +5,8 @@ mod loader; mod prelude; mod program; -pub use diagnostics::{CompilationReport, PartialIrDumps}; +pub use diagnostics::{CompilationReport, FrontendPassTrace, IrDumpArtifacts, PartialIrDumps}; +pub use psrs_backend::trace::*; pub use loader::{ ProgramCaseSources, collect_purs_files, load_program_case_sources, load_program_files, @@ -14,8 +15,9 @@ pub use program::{ check_program, check_program_kinds_lenient, check_program_kinds_lenient_with_prelude, check_program_lenient, check_program_lenient_with_prelude, check_program_types_lenient, check_program_types_lenient_with_prelude, check_program_with_warnings, compile_program_sources, - compile_program_sources_with_prelude, compile_program_sources_with_prelude_report, - resolve_program_sources, typecheck_program_sources, typecheck_program_sources_with_warnings, + compile_program_sources_with_prelude, compile_program_sources_with_prelude_diagnosis, + compile_program_sources_with_prelude_report, resolve_program_sources, + typecheck_program_sources, typecheck_program_sources_with_warnings, }; #[derive(Clone, Debug, PartialEq, Eq)] diff --git a/crates/psrs-driver/src/program/compilation.rs b/crates/psrs-driver/src/program/compilation.rs index 98f3c49b..6911883c 100644 --- a/crates/psrs-driver/src/program/compilation.rs +++ b/crates/psrs-driver/src/program/compilation.rs @@ -1,8 +1,9 @@ use super::{lower_program_to_core_and_effect_context, typecheck_warnings}; use crate::{ - Artifact, CompilationReport, Diagnostic, DiagnosticOrigin, PartialIrDumps, ProgramDiagnostic, - backend_warnings, + Artifact, CompilationReport, Diagnostic, DiagnosticOrigin, FrontendPassTrace, IrDumpArtifacts, + PartialIrDumps, ProgramDiagnostic, backend_warnings, }; +use psrs_backend::{CompileTrace, TraceArtifactId, TracePassStatus}; /// Compiles a whole program to a single Wasm component. pub fn compile_program_sources( @@ -15,7 +16,7 @@ pub(crate) fn compile_program_sources_with_trusted_prefix( sources: &[(&str, &str)], trusted_prefix: usize, ) -> Result> { - let report = compile_attempt(sources, trusted_prefix, false); + let report = compile_attempt(sources, trusted_prefix, false, false); match report.artifact { Some(artifact) => Ok(artifact), None => Err(report.diagnostics), @@ -26,22 +27,94 @@ pub(crate) fn compile_program_sources_with_trusted_prefix_report( sources: &[(&str, &str)], trusted_prefix: usize, ) -> CompilationReport { - compile_attempt(sources, trusted_prefix, true) + compile_attempt(sources, trusted_prefix, true, false) +} + +pub(crate) fn compile_program_sources_with_trusted_prefix_diagnosis( + sources: &[(&str, &str)], + trusted_prefix: usize, + capture_dumps: bool, +) -> CompilationReport { + compile_attempt(sources, trusted_prefix, capture_dumps, true) } fn compile_attempt( sources: &[(&str, &str)], trusted_prefix: usize, - capture: bool, + capture_dumps: bool, + trace_enabled: bool, ) -> CompilationReport { let (core, source_warnings, effect_context) = match lower_program_to_core_and_effect_context(sources, trusted_prefix) { Ok(lowered) => lowered, Err(diagnostics) => { - return CompilationReport::failed(diagnostics, PartialIrDumps::default()); + let mut report = CompilationReport::failed(diagnostics, PartialIrDumps::default()); + if trace_enabled { + report.frontend_trace = Some(FrontendPassTrace { + contract_version: 1, + pass_key: "driver.frontend.lower_program_to_core", + trusted_prefix, + source_names: sources.iter().map(|(name, _)| (*name).to_owned()).collect(), + status: TracePassStatus::Rejected, + output_core: None, + diagnostic_indices: (0..report.diagnostics.len()).collect(), + }); + } + return report; } }; - if capture { + + let mut frontend_trace = trace_enabled.then(|| FrontendPassTrace { + contract_version: 1, + pass_key: "driver.frontend.lower_program_to_core", + trusted_prefix, + source_names: sources.iter().map(|(name, _)| (*name).to_owned()).collect(), + status: TracePassStatus::Completed, + output_core: None, + diagnostic_indices: Vec::new(), + }); + + if trace_enabled { + let linked_core = capture_dumps.then(|| core.clone()); + let traced = psrs_backend::compile_with_context_traced( + core, + effect_context, + psrs_backend::TargetCapabilities::default(), + capture_dumps, + ); + if let Some(frontend) = &mut frontend_trace { + frontend.output_core = Some(traced.trace.initial_core); + } + return match traced.result { + Ok(stages) => success_report( + stages, + source_warnings, + trusted_prefix, + capture_dumps, + Some(traced.trace), + frontend_trace, + ), + Err(failure) => { + let (dumps, dump_artifacts) = if capture_dumps { + partial_dumps( + failure.partial, + linked_core.expect("dump capture retained linked Core"), + Some(&traced.trace), + ) + } else { + (PartialIrDumps::default(), IrDumpArtifacts::default()) + }; + let mut report = + CompilationReport::failed(backend_diagnostics(failure.errors), dumps); + report.backend_trace = Some(traced.trace); + report.frontend_trace = frontend_trace; + report.dump_artifacts = dump_artifacts; + report + } + }; + } + + if capture_dumps { let linked_core = core.clone(); let stages = match psrs_backend::compile_with_context_capturing( core, @@ -50,25 +123,11 @@ fn compile_attempt( ) { Ok(stages) => stages, Err(failure) => { - let mut dumps = PartialIrDumps::default(); - let (core, stage) = match failure.partial.core { - Some(core) => (core, "P7 Core optimization"), - None => (linked_core, "P7 Core verification"), - }; - dumps.core_stage = Some(stage); - dumps.core = Some(format!("{core:#?}")); - if let Some(cc) = failure.partial.cc { - dumps.cc_stage = Some("P8 closure conversion (verified)"); - dumps.cc = Some(format!("{cc:#?}")); - } - if let Some(mir) = failure.partial.mir { - dumps.mir_stage = failure.partial.mir_stage; - dumps.mir = Some(format!("{mir:#?}")); - } + let (dumps, _) = partial_dumps(failure.partial, linked_core, None); return CompilationReport::failed(backend_diagnostics(failure.errors), dumps); } }; - return success_report(stages, source_warnings, trusted_prefix, true); + return success_report(stages, source_warnings, trusted_prefix, true, None, None); } match psrs_backend::compile_with_context( @@ -76,7 +135,7 @@ fn compile_attempt( effect_context, psrs_backend::TargetCapabilities::default(), ) { - Ok(stages) => success_report(stages, source_warnings, trusted_prefix, false), + Ok(stages) => success_report(stages, source_warnings, trusted_prefix, false, None, None), Err(errors) => { CompilationReport::failed(backend_diagnostics(errors), PartialIrDumps::default()) } @@ -88,6 +147,8 @@ fn success_report( source_warnings: Vec, trusted_prefix: usize, capture: bool, + backend_trace: Option, + frontend_trace: Option, ) -> CompilationReport { let mut warnings = typecheck_warnings(source_warnings, trusted_prefix); warnings.extend(backend_warnings(stages.artifact.warnings, trusted_prefix)); @@ -103,6 +164,15 @@ fn success_report( } else { PartialIrDumps::default() }; + let dump_artifacts = backend_trace + .as_ref() + .filter(|_| capture) + .map(|trace| IrDumpArtifacts { + core: artifact_from_pass(trace, "backend.core.optimize", 0), + cc: artifact_from_pass(trace, "backend.cc.lower", 0), + mir: artifact_from_pass(trace, "backend.mir.optimize", 0), + }) + .unwrap_or_default(); CompilationReport { artifact: Some(Artifact { wasm: stages.artifact.wasm, @@ -111,9 +181,62 @@ fn success_report( }), diagnostics: Vec::new(), dumps, + backend_trace, + frontend_trace, + dump_artifacts, } } +fn partial_dumps( + partial: psrs_backend::PartialStages, + linked_core: psrs_core::Module, + trace: Option<&CompileTrace>, +) -> (PartialIrDumps, IrDumpArtifacts) { + let mut dumps = PartialIrDumps::default(); + let mut artifacts = IrDumpArtifacts::default(); + let (core, stage, artifact) = match partial.core { + Some(core) => ( + core, + "P7 Core optimization", + trace.and_then(|trace| artifact_from_pass(trace, "backend.core.optimize", 0)), + ), + None => ( + linked_core, + "linked Core input to P7", + trace.map(|trace| trace.initial_core), + ), + }; + dumps.core_stage = Some(stage); + dumps.core = Some(format!("{core:#?}")); + artifacts.core = artifact; + if let Some(cc) = partial.cc { + dumps.cc_stage = Some("P8 closure conversion (verified)"); + dumps.cc = Some(format!("{cc:#?}")); + artifacts.cc = trace.and_then(|trace| artifact_from_pass(trace, "backend.cc.lower", 0)); + } + if let Some(mir) = partial.mir { + dumps.mir_stage = partial.mir_stage; + dumps.mir = Some(format!("{mir:#?}")); + artifacts.mir = trace.and_then(|trace| match partial.mir_stage { + Some("P9 MIR lowering") => artifact_from_pass(trace, "backend.mir.lower", 0), + _ => artifact_from_pass(trace, "backend.mir.optimize", 0), + }); + } + (dumps, artifacts) +} + +fn artifact_from_pass( + trace: &CompileTrace, + pass_key: &str, + output_index: usize, +) -> Option { + trace + .executions + .iter() + .find(|execution| execution.pass_key == pass_key) + .and_then(|execution| execution.outputs.get(output_index).copied()) +} + fn backend_diagnostics(errors: Vec) -> Vec { errors .into_iter() diff --git a/crates/psrs-driver/src/program/library.rs b/crates/psrs-driver/src/program/library.rs index 2fe4af0c..ba45b67d 100644 --- a/crates/psrs-driver/src/program/library.rs +++ b/crates/psrs-driver/src/program/library.rs @@ -34,6 +34,25 @@ pub fn compile_program_sources_with_prelude_report(sources: &[(&str, &str)]) -> report } +/// Compiles for `psrs diagnose`, retaining a lightweight pass trace and +/// optionally the IR snapshots used by trace-mode bundles. +pub fn compile_program_sources_with_prelude_diagnosis( + sources: &[(&str, &str)], + capture_dumps: bool, +) -> CompilationReport { + let (all_sources, trusted_prefix) = match with_prelude(sources) { + Ok(sources) => sources, + Err(errors) => return CompilationReport::failed(errors, Default::default()), + }; + let mut report = super::compile_program_sources_with_trusted_prefix_diagnosis( + &all_sources, + trusted_prefix, + capture_dumps, + ); + report.diagnostics = shift(report.diagnostics, trusted_prefix); + report +} + /// Resolves user sources leniently together with the on-disk standard library. /// /// A lenient check tolerates imports whose modules are not provided at all, so a diff --git a/crates/psrs-driver/src/program/mod.rs b/crates/psrs-driver/src/program/mod.rs index d396704c..bd980f74 100644 --- a/crates/psrs-driver/src/program/mod.rs +++ b/crates/psrs-driver/src/program/mod.rs @@ -8,7 +8,9 @@ use super::{ pub use compilation::compile_program_sources; pub(super) use compilation::{ - compile_program_sources_with_trusted_prefix, compile_program_sources_with_trusted_prefix_report, + compile_program_sources_with_trusted_prefix, + compile_program_sources_with_trusted_prefix_diagnosis, + compile_program_sources_with_trusted_prefix_report, }; pub use lenient::{ check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, @@ -16,7 +18,7 @@ pub use lenient::{ pub use library::{ check_program_kinds_lenient_with_prelude, check_program_lenient_with_prelude, check_program_types_lenient_with_prelude, compile_program_sources_with_prelude, - compile_program_sources_with_prelude_report, + compile_program_sources_with_prelude_diagnosis, compile_program_sources_with_prelude_report, }; use std::collections::{HashMap, HashSet}; diff --git a/crates/psrs-driver/src/tests/diagnosis_trace.rs b/crates/psrs-driver/src/tests/diagnosis_trace.rs new file mode 100644 index 00000000..723a48bf --- /dev/null +++ b/crates/psrs-driver/src/tests/diagnosis_trace.rs @@ -0,0 +1,165 @@ +use super::*; + +#[test] +fn traced_and_untraced_compilation_produce_the_same_artifact_without_default_dumps() { + let sources = [("Main.purs", "module Main where\nmain = 42\n")]; + let ordinary = + compile_program_sources_with_prelude(&sources).expect("ordinary compile should succeed"); + let diagnosis = compile_program_sources_with_prelude_diagnosis(&sources, false); + let traced = diagnosis + .artifact + .expect("diagnosis compile should succeed"); + + assert_eq!(ordinary.wasm, traced.wasm); + assert_eq!(ordinary.wat, traced.wat); + assert_eq!(diagnosis.dumps, PartialIrDumps::default()); + assert!(diagnosis.backend_trace.is_some()); + assert_eq!( + diagnosis + .frontend_trace + .as_ref() + .and_then(|frontend| frontend.output_core), + diagnosis + .backend_trace + .as_ref() + .map(|trace| trace.initial_core), + ); +} + +#[test] +fn effect_lowering_output_binding_artifact_flows_into_validation_and_cc() { + let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain :: Effect Unit\nmain = log \"trace\"\n"; + let report = compile_program_sources_with_prelude_diagnosis(&[("Main.purs", source)], false); + assert!( + report.artifact.is_some(), + "effect program should compile: {:?}", + report.diagnostics + ); + let trace = report.backend_trace.expect("backend pass trace"); + let effect = trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.effect.lower") + .expect("effect context triggers the lowering pass"); + assert_eq!(effect.status, TracePassStatus::Completed); + let bindings = *effect.outputs.get(1).expect("effect pass outputs bindings"); + let conformance = trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.external_bindings.validate_conformance") + .expect("binding conformance is observed"); + let cc = trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.cc.lower") + .expect("CC lowering is observed"); + assert!(conformance.inputs.contains(&bindings)); + assert!(cc.inputs.contains(&bindings)); + assert!(trace.edges.iter().any(|edge| { + edge.execution == effect.id + && edge.artifact == bindings + && edge.role == TraceEdgeRole::Output + })); +} + +#[test] +fn trace_dump_references_name_the_exact_produced_artifacts() { + let source = "module Main where\nmain = 42\n"; + let report = compile_program_sources_with_prelude_diagnosis(&[("Main.purs", source)], true); + assert!(report.artifact.is_some()); + assert!( + report + .dumps + .core + .as_ref() + .is_some_and(|dump| !dump.is_empty()) + ); + assert!( + report + .dumps + .cc + .as_ref() + .is_some_and(|dump| !dump.is_empty()) + ); + assert!( + report + .dumps + .mir + .as_ref() + .is_some_and(|dump| !dump.is_empty()) + ); + let trace = report.backend_trace.expect("backend pass trace"); + let artifacts = report.dump_artifacts; + for id in [artifacts.core, artifacts.cc, artifacts.mir] + .into_iter() + .flatten() + { + assert!(trace.artifacts.iter().any(|artifact| artifact.id == id)); + } + assert_eq!( + trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.core.optimize") + .and_then(|execution| execution.outputs.first().copied()), + artifacts.core, + ); +} + +#[test] +fn frontend_rejection_has_diagnostics_but_no_backend_trace_or_core_output() { + let report = compile_program_sources_with_prelude_diagnosis( + &[("Main.purs", "module Main where\nmain = @\n")], + false, + ); + assert!(report.artifact.is_none()); + assert!(report.backend_trace.is_none()); + assert!(!report.diagnostics.is_empty()); + let frontend = report.frontend_trace.expect("frontend attempt is observed"); + assert_eq!(frontend.status, TracePassStatus::Rejected); + assert!(frontend.output_core.is_none()); + assert_eq!(frontend.diagnostic_indices.len(), report.diagnostics.len()); +} + +#[test] +fn target_rejection_keeps_prior_artifacts_and_maps_errors_to_its_execution() { + let prepared = crate::prepare_sources(&[("Main.purs", "module Main where\nmain = 42\n")]) + .expect("frontend should produce checked Core"); + let mut target = psrs_backend::TargetCapabilities::default(); + target.component_model = false; + let traced = psrs_backend::compile_with_context_traced( + prepared.core, + prepared.effect_context, + target, + false, + ); + let failure = traced + .result + .expect_err("target profile should be rejected"); + let target_execution = traced + .trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.target.requirements") + .expect("the target check is an observed execution"); + assert_eq!(target_execution.status, TracePassStatus::Rejected); + assert_eq!(target_execution.outputs, Vec::::new()); + assert!(!target_execution.diagnostic_indices.is_empty()); + assert!( + target_execution + .diagnostic_indices + .iter() + .all(|index| *index < failure.errors.len()) + ); + assert!(traced.trace.artifacts.iter().any(|artifact| { + artifact.representation == TraceRepresentation::Mir + && artifact.state == TraceArtifactState::Produced + })); + assert!( + !traced + .trace + .artifacts + .iter() + .any(|artifact| { artifact.representation == TraceRepresentation::WasmModule }) + ); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 5ad8a90e..11699faf 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -9,6 +9,7 @@ mod coercion; mod data_function; mod data_tuple; mod deriving; +mod diagnosis_trace; mod effect_arity; mod effects; mod foldable; diff --git a/docs/design/D-16-compile-diagnosis.md b/docs/design/D-16-compile-diagnosis.md index bd24d6a2..8bfd3af6 100644 --- a/docs/design/D-16-compile-diagnosis.md +++ b/docs/design/D-16-compile-diagnosis.md @@ -1,69 +1,214 @@ -# D-16 — Compile Failure Diagnosis +# D-16 — Compile Diagnosis -**Status:** Draft +**Status:** Stable (design) -**Implements:** [F-04 — Diagnose Compile Failures](../feature/F-04-compile-diagnosis.md) +**Implements:** [F-04 — Compile Diagnosis](../feature/F-04-compile-diagnosis.md) -## Purpose +## Purpose and scope -`psrs diagnose` runs one source file or a selected part of the vendored -`passing` corpus through the normal compiler pipeline. It records the first -blocking stage and category for each case, keeps every diagnostic with its -source origin, and writes a versioned JSON snapshot that can be compared with a -later compiler revision. Failure bundles retain the exact loaded user modules, -the replay arguments, and every IR stage that completed successfully. +`psrs diagnose` records what the compiler actually did for each selected case. +It groups compile outcomes by their first reported blocker, records pass and +artifact boundaries, and compares compatible runs. A trace may retain selected +IR dumps and node lineage for focused investigations. Compile acceptance, +compile lineage, and Wasmtime runtime evidence are separate records with +separate claims. + +The tool does not infer root causes from matching diagnostics, reconstruct +lineage from text dumps, alter compiler semantics, or treat compilation as +runtime validation. Official suite scoreboards remain the acceptance evidence +for roadmap gates. ## Commands ```sh cargo run -p psrs-cli -- diagnose path/to/Main.purs --out /tmp/main.json +cargo run -p psrs-cli -- diagnose path/to/Main.purs --trace --out /tmp/main.json +cargo run -p psrs-cli -- diagnose path/to/Main.purs \ + --input path/to/Imported.purs --trace --out /tmp/explicit-inputs.json cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ --out /tmp/functor.json --timeout 20 cargo run -p psrs-cli -- diagnose --compare /tmp/before.json /tmp/after.json ``` +Without `--trace`, diagnosis records the run manifest, pass executions, +artifact identities, explicit input/output edges, diagnostics, and compact +canonical summaries only for representations that implement a versioned +summary. It does not clone or format complete IR values solely to make dumps. +With `--trace`, the compiler retains requested IR dumps on both accepted and +rejected cases and may attach node-level lineage when the producing pass +supports it. A replay bundle records the selected trace mode and forwards it +when replaying. Repeatable `--input FILE` adds explicitly ordered sources after +the primary file; this mode compiles exactly that list without rediscovering +imports. It is available only for file diagnosis, cannot be combined with +`--corpus`, and rejects duplicate canonical paths. The replay script first +runs a new diagnosis with the saved entry-first input list, trace mode, and a +separate `replay-trace.json`, then invokes the recorded `build` command on the +same files. These are separate compile attempts; the build command preserves +the original compile-failure exit status. Unsupported summary and lineage coverage is represented as +`unavailable` or `untracked`, never approximated with a Debug-text hash or +source-span overlap. + The corpus command uses `tests/upstream` unless `PURESCRIPT_REPO` selects an official checkout. It applies the path filter before the limit. Cases with foreign imports or adjacent JavaScript FFI files are recorded as `excluded`; -they do not count as passes. - -Each selected case runs in its own child process. `--timeout` is a per-case -deadline in seconds. A timeout or crash is captured as a case result, and the -batch continues. Progress and elapsed time are printed to stderr. Compiler -rejections are snapshot data and do not make the diagnosis command itself fail; -invalid options, missing files, or report I/O errors do. - -## Snapshot and comparison - -The JSON snapshot records the selected cohort, the trusted-library fingerprint, -the compiler commit, dirty-tree fingerprint and executable fingerprint, every -case's input fingerprint and elapsed time, and its full ordered diagnostic list. -Source, trusted-library and program-wide origins remain distinct. A failed -backend attempt includes the last successful Core, verified CC, and MIR dumps -available from the shared compile pipeline; an unverified CC candidate is never -presented as a completed stage. - -Summary groups use first-blocker stage and stable diagnostic category. The full -message and span stay on each case, and a shared group is only a matching -diagnostic signature; it does not claim the cases share one root cause. - -Snapshots compare only when corpus mode, selected path filter and limit, -timeout, and trusted-library fingerprint match. Compiler revision may differ. -For cases with complete input sets, changed module contents are reported as -`input_changed`. If a worker timed out or crashed before loading all modules, -the case is still compared by observed status and the report marks input -comparison as incomplete. New and removed paths are listed as unmatched rather -than counted as regressions or recoveries. - -Each failed case gets a directory beside the snapshot with numbered source -files, `case.json`, and `replay.sh`. The bundle records whether module loading -completed. `core.debug`, `cc.debug`, and `mir.debug` are present only when the -named stage completed; the adjacent `.stage` file gives the producing pass. -`replay.sh` runs the same CLI binary recorded in the bundle by default. Set -`PSRS_BIN` to choose another compiler executable. - -## Scope - -This tool measures compile acceptance and locates the first compiler-reported -blocker. It does not execute generated Wasm, diagnose runtime traps, reduce a -source file automatically, or prove a grouped failure has a common cause. +they do not count as passes. Each selected case runs in its own child process. +`--timeout` is a per-case deadline in seconds. A timeout or crash is captured +as a case result, and the batch continues. Progress and elapsed time are +printed to stderr. Compiler rejections are snapshot data and do not make the +diagnosis command itself fail; invalid options, missing files, or report I/O +errors do. + +Querying a saved trace by case, symbol, or source span is part of the design. +Symbol queries resolve to declaration identities; span queries return every +linked node and its relation. If the saved coverage cannot answer a query, the +result says so. Re-capturing missing evidence creates a new linked run rather +than mutating an existing snapshot. The query command is not implemented by the +current first slice. + +## Run and trace schema + +The serialized format is versioned independently of compiler and pass +versions. A run manifest records: + +- the selected case cohort and whether each case's complete input set was + observed; +- ordered logical source identities and content fingerprints, including + trusted-library inputs and their fingerprint, plus logical-to-physical path + mappings when replay needs them; +- compiler revision, working-tree and executable fingerprints when available; +- target capabilities, optimization settings, relevant tool versions, and + environment inputs when the runner can observe them; +- the trace mode, schema version, per-pass contract versions, summary versions, + and explicit coverage gaps. + +Unavailable environment facts stay absent or explicitly unavailable. A run +must not claim compatibility based on guessed defaults. + +An artifact ID is unique within one run and identifies one produced snapshot; +it is not a content digest and equal content does not merge identities. Each +artifact record names its representation and format version, producer, storage +reference if retained, summary and digest state, and whether the artifact is +complete, partial, invalid, or unavailable. Production and validation are +different facts: validation records refer to artifact IDs and name the +validator, result, and observed coverage. A failed or skipped validator never +turns an artifact into a verified artifact. + +A pass execution records a stable machine key, pass contract version, ordered +input and output artifact IDs, status (`completed`, `rejected`, `crashed`, +`timed_out`, or `not_run`), diagnostics, and observed validation references. +One execution may consume and produce multiple artifacts. Explicit edges tie +each artifact to the pass execution and its input or output role. In-place +optimization still creates a new artifact identity. Configuration, target +capabilities, effect context, and external bindings that affect a pass are +recorded as metadata inputs where available; the manifest marks any +unobserved dependency. + +Diagnostics retain source, trusted-library, or program origin. When the +compiler can identify a trusted-library module, the diagnostic also records +that logical source identity and span; the broad `trusted_library` class alone +does not identify the file. + +The complete backend pass sequence is represented at actual call boundaries: + +```text +linked Core + -> Core optimization + -> Effect lowering and binding conformance + -> closure conversion and CC verification + -> MIR lowering and verification + -> MIR optimization + -> Wasm structuring and encoding + -> component assembly and validation + -> WAT printing +``` + +Nested verifier calls may initially have coarser coverage than their enclosing +pass. The trace states that granularity instead of synthesizing a separate +verifier event from a final success flag. Driver diagnostics and artifact +records use backend-owned pass/artifact events; serialization belongs to the +CLI layer, and lower-level IR crates do not depend on the CLI or its JSON +format. + +## Source identity and lineage + +Lineage is a many-to-many derivation relation. It is produced by the pass that +creates or transforms nodes; query code may index it but may not infer it from +formatted output. + +- `SourceRef` identifies a logical source file by stable logical name and + content fingerprint, with a byte span and an origin class (`user`, + `trusted_library`, or `generated`). A run may separately map this identity to + a physical path used for replay. A span locates source text; it is not a + semantic identity. +- `DeclarationRef` identifies a module declaration by namespace and a stable + cross-run key. Compiler-local numeric IDs are retained for within-run joins + but are not treated as stable across runs. +- `NodeRef` is the pair of an artifact ID and a node ID local to that artifact. +- A derivation record names the producing execution, zero or more input nodes, + zero or more output nodes, a relation role, and source/declaration origins. + It has at least one input or output; elimination has one or more inputs and + no outputs. + +This shape expresses one-to-many expansion, many-to-one combination, and +elimination. For example, lowering one lambda may produce a lifted function, +an environment layout, and a closure construction; inlining may combine +several input nodes into several output nodes. Generated adapters record their +actual generation role and the input value, instantiation site, and owning +declaration when the pass has that evidence. Shared spans are query hints, not +proof of a derivation. Uninstrumented nodes are marked `untracked`. + +## Comparison + +`--compare` first checks compatibility of the selected case set, complete +source/import closure and load order, trusted-library contents, target and +relevant tool configuration, schema, pass contracts, and summary versions. +Compiler revision and executable fingerprints may differ because revisions +are the subject of comparison; both are shown. Incomplete source capture, +changed environment, unsupported versions, or coverage gaps are reported and +limit the claims that can be made. + +For each matched case, comparison preserves compile status, blocker stage and +category, diagnostic details, and input-change semantics. Where compatible +canonical summaries exist, artifacts and pass executions are aligned by their +dependency edges and roles. The report names the earliest observed boundary +whose output differs. Independent branches may produce several incomparable +earliest differences. A missing artifact, pass, summary, or lineage record is +reported as an observation gap; it is not treated as an unchanged artifact. +Cross-run node IDs are never compared directly. + +The initial trace implementation does not yet produce canonical IR summaries, +so artifact-content and earliest-artifact-difference comparison must report +`unavailable`. It may still compare the existing case statuses, blockers, +diagnostics, cohort, and source fingerprints. + +## Runtime evidence + +Compile traces end at produced Wasm/component artifacts. Runtime validation is +a separate `RuntimeRun` that references the exact Wasm artifact digest and +records the Wasmtime version and configuration, exit or trap result, and +value-sensitive assertions. A successful compile is never a runtime pass. +Runtime events do not become compiler pass executions. If a runtime provides a +Wasm function/type/instruction location, it may be joined to the Wasm artifact; +otherwise the raw trap is retained with the location marked unavailable. + +## Implementation coverage + +The backend and driver provide a versioned run-local artifact/pass model, +actual top-level backend pass IO boundaries, and an opt-in diagnosis API that +avoids dump capture by default. The CLI writes schema-v2 manifests, captures +selected dumps for accepted and rejected cases with `--trace`, replays explicit +ordered inputs, and preserves v1 status/blocker/input comparison. Its pass +comparison reports only the first observed execution-sequence difference +after checking cohort and complete per-case input compatibility. It is not an +artifact-content or DAG comparison, and it does not identify a root cause. +Observed host and installed `rustc`/`cargo` versions are reported separately; +the compiler build toolchain cannot be established from those observations and +remains unavailable. + +The frontend trace is one coarse lowering boundary, and backend trace +validation is recorded only at the granularity the backend observes. Canonical +artifact summaries, source/declaration/node lineage, query commands, earliest +artifact-DAG diffing, and Wasmtime runtime records remain planned. Diagnosis +does not fix backend defects; in particular, an observed closure-signature +trap remains runtime evidence until a focused runtime test and compiler +investigation establish the cause and repair. diff --git a/docs/feature/F-04-compile-diagnosis.md b/docs/feature/F-04-compile-diagnosis.md index 3f53ced5..e65e8163 100644 --- a/docs/feature/F-04-compile-diagnosis.md +++ b/docs/feature/F-04-compile-diagnosis.md @@ -1,46 +1,86 @@ -# F-04 — Diagnose Compile Failures +# F-04 — Compile Diagnosis **Status:** In progress -**Design:** [D-16 — Compile Failure Diagnosis](../design/D-16-compile-diagnosis.md) +**Design:** [D-16 — Compile Diagnosis](../design/D-16-compile-diagnosis.md) ## User need -Compiler contributors need a repeatable way to find which stage stops a source -case, compare compile acceptance across revisions, and replay a failure without -reconstructing its module inputs by hand. +Compiler contributors need a repeatable way to identify where a source case +stops, compare compile behavior across revisions, and replay an investigation +without reconstructing its module inputs. When a pipeline boundary changes, +they need evidence tied to the actual artifacts and passes that ran. ## User-visible behavior -Given a source file or a selected part of the `passing` corpus, contributors can -run `psrs diagnose` to get a versioned JSON report. The report lists each -diagnostic and its source, groups cases by first-blocker stage and category, and -records exclusions, timeouts, crashes, and elapsed time separately from passes. -Each failed case produces a replay bundle with its loaded source files and any -compiler-stage details that completed successfully. +Given one source file or a selected part of the `passing` corpus, contributors +can run `psrs diagnose` to create a versioned report. The report lists each +diagnostic and its source origin, groups cases by first-blocker stage and +category, and records exclusions, timeouts, crashes, and elapsed time +separately from successful compilation. -Two compatible reports can be compared case by case. The comparison shows -recovered and regressed cases, stage or category changes, changed source inputs, -and paths that occur in only one snapshot. It identifies cases whose full input -set was not captured before a timeout or crash. +The default report keeps a lightweight manifest of pass executions, artifact +identities, and explicit input/output edges. `--trace` retains selected IR +dumps on both successful and failed cases and carries the option into replay. +Unsupported artifact summaries or lineage are identified as unavailable. A +report never treats a compile pass as evidence that generated Wasm executes +correctly. ## Acceptance criteria - A single source file can be diagnosed with a per-case deadline. +- File diagnosis can take additional ordered `--input FILE` sources, compile + that exact list without import rediscovery, and reject duplicate canonical + paths or combining explicit inputs with corpus mode. - The selected corpus subset reports progress and records FFI exclusions without counting them as passing cases. - Every case retains all ordered diagnostics and the origin of each diagnostic. -- A failure bundle contains exact loaded user modules, replay arguments, and - dumps only for stages that completed successfully. -- A worker timeout or crash is isolated to its case, retains available process - output, and does not stop the remaining selected cases. -- Snapshot comparison rejects incompatible trusted-library or selection - cohorts and reports new or removed paths as unmatched. +- The run manifest records the available input, compiler, target, toolchain, + schema, pass-contract, and trace-coverage metadata without inventing missing + compatibility evidence. +- Each observed pass has a stable identity, ordered input and output artifact + references, status, diagnostic references, and explicit artifact edges. +- Artifact production is distinct from verification evidence; a partial, + rejected, timed out, crashed, or unavailable result is represented + truthfully. +- Default diagnosis avoids formatting or cloning complete IR values solely for + dumps. `--trace` can retain the selected dumps for accepted and rejected + cases. Replay first creates a new trace report from the saved ordered inputs, + then runs the recorded build command so a compiler rejection keeps its + nonzero build exit status. +- Reports compare only compatible cohorts and identify changed or incomplete + source inputs. Where canonical summaries are absent, artifact-content + comparison is explicitly unavailable. +- Compile acceptance, compile lineage, and Wasmtime runtime evidence remain + separate; runtime correctness requires value-sensitive execution evidence. - Compile outcomes remain data in a completed report; command failure indicates invalid options or an operational error such as missing input or unwritable output. +## Implementation status + +Implemented: versioned run-local pass/artifact IO records, observed top-level +backend boundaries, a diagnosis API with optional dump capture, and the CLI +schema-v2 manifest. Default reports keep pass/artifact metadata without +formatting IR dumps; `--trace` retains selected Core, CC, and MIR dumps on +accepted and rejected cases. Explicit ordered `--input` sources and trace-aware +replay are supported. `--compare` retains v1 status/blocker/input comparison +and reports the first observed pass-sequence difference for compatible v2 +traces. It reports observed environment differences separately and marks the +compiler build toolchain unavailable because it is not embedded in the +binary. Exact nested-verifier coverage is recorded at the granularity exposed +by the backend. + +Planned: canonical versioned IR summaries and artifact-content comparison, +source/declaration/node lineage, many-to-many derivation queries by +case/symbol/span, and a separate Wasmtime runtime evidence record. Current +pass comparison follows execution order and does not establish the earliest +artifact divergence or explain a runtime failure. These capabilities are not +implied by the presence of a pass manifest or an IR dump. + ## Out of scope -This workflow does not run generated Wasm, attribute runtime traps, reduce a -program automatically, or prove that matching diagnostics share a root cause. +This workflow does not repair compiler behavior, infer lineage from Debug +output or span overlap, reduce a source file automatically, prove matching +diagnostics have a common root cause, or use compile acceptance as runtime +correctness evidence. diff --git a/docs/workflow/compiler-iteration-sop.md b/docs/workflow/compiler-iteration-sop.md index b357d371..0e10dd86 100644 --- a/docs/workflow/compiler-iteration-sop.md +++ b/docs/workflow/compiler-iteration-sop.md @@ -1,23 +1,24 @@ # Compiler Iteration SOP Use this workflow when investigating compile failures or making a compiler -change. It turns a failing case into reproducible evidence, helps locate the -semantic owner of a defect, and checks the same inputs after a change. +change. It creates reproducible evidence, locates the earliest observed +boundary, and checks the same inputs after a change. Compile evidence and +runtime evidence answer different questions and must be recorded separately. For roadmap work, first select an issue using the phase and dependency rules in [`AGENTS.md`](../../AGENTS.md#choosing-the-next-item), then read its references and validation requirements. Diagnosis helps investigate the selected work; it does not replace roadmap priority or acceptance evidence. -## 1. Capture the starting point +## 1. Record the starting point and capture a baseline Record the branch, commit, and existing worktree changes. Choose one reproducer -or a small corpus cohort that reaches the relevant feature. Save the report -outside the source tree so the generated JSON and bundles do not change the -working-tree fingerprint recorded in the next report. +or a small corpus cohort that reaches the relevant feature. Save reports and +bundles outside the source tree so they do not change the working-tree +fingerprint in a later report. ```sh -# One file, including its imported modules and a replay bundle. +# One file, including imported modules and a replay bundle. cargo run -p psrs-cli -- diagnose path/to/Main.purs \ --out /tmp/psrs-before.json --timeout 20 @@ -26,21 +27,67 @@ cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ --out /tmp/psrs-before.json --timeout 20 ``` +Use the default run first when pass outcomes and blocker attribution are enough. Compiler rejections are recorded in the report and do not make the diagnosis command fail. A nonzero command result indicates an operational problem such as invalid arguments, missing inputs, or an output error. Timeouts, crashes, and FFI exclusions are separate outcomes; none counts as a successful compile. -## 2. Find the first blocking boundary +## 2. Locate the first observed boundary -Start with the first blocker stage and category, then inspect the case's full -ordered diagnostics. Keep source, trusted-library, and program-level origins -distinct. A library-origin diagnostic may be triggered by a user module, but -that does not establish which implementation is wrong. +Start with the case's first blocker and complete ordered diagnostics. Keep +source, trusted-library, and program-level origins distinct. A library-origin +diagnostic may be triggered by a user module, but does not establish which +implementation is wrong. -Open a representative failure bundle. Its `case.json` records the case and -inputs; `replay.sh` reruns it with the recorded compiler. Override the executable -when comparing a different build: +The run manifest records actual pass executions and their input/output +artifacts. Follow those edges to find the first observed boundary that differs +from the expected contract. A matching first-blocker group is only a shared +diagnostic signature. Use group size to estimate reach, then inspect +representatives before treating one owner hypothesis as established. + +For a focused case where the IR itself is needed, request a trace: + +```sh +cargo run -p psrs-cli -- diagnose path/to/Main.purs --trace \ + --out /tmp/psrs-before-trace.json --timeout 20 + +# An explicit ordered input closure for a multi-file reproducer. +cargo run -p psrs-cli -- diagnose path/to/Main.purs \ + --input path/to/Imported.purs --trace \ + --out /tmp/psrs-before-trace.json --timeout 20 +``` + +Trace mode retains the selected Core, CC, and MIR dumps for accepted and +rejected cases and is preserved by the replay bundle. Open only artifacts whose +manifest record says they were produced. Read validation records separately: +artifact production does not establish verification. Pass entries may group +nested verifier work at an explicitly coarser observed boundary. A missing +summary or lineage relation means that evidence is unavailable; do not +reconstruct it from formatted text or overlapping spans. Querying by case, +symbol, or source span is planned; until it is implemented, inspect the saved +case, pass, and artifact records directly. + +`--compare` requires matching cohort selection and trusted-library fingerprints. +For each matching case it separately checks complete input fingerprints before +comparing pass records. The reported first difference is the first observed +execution-sequence difference, not an earliest artifact divergence or a root +cause. Canonical artifact-content comparison is unavailable until versioned +summaries exist. Host and installed tool versions are observations only; the +compiler build toolchain is not embedded in the current manifest. + +Use repeatable `--input FILE` when the reproducer's source set is explicit. +The primary file is first and each `--input` follows in order; this mode +compiles that exact list without resolving imports again. It applies only to +file diagnosis, and duplicate canonical paths or `--corpus` combined with +`--input` are invalid. A trace replay runs `diagnose` on the saved entry-first +list into a new `replay-trace.json`, then invokes the recorded `build` command +on the same files. The two runs are separate; the build command retains the +original compiler rejection's nonzero status. + +Failure bundles record the case and loaded inputs; `replay.sh` reruns with the +recorded compiler and trace mode. Override the executable when comparing a +different build: ```sh BUNDLE=/tmp/psrs-before.bundles/0000-Functor @@ -50,40 +97,32 @@ PSRS_BIN="$PWD/target/debug/psrs" sh "$BUNDLE/replay.sh" Use the bundle directory recorded in the report; the example name above is illustrative. -Inspect only IR dumps whose `.stage` file says the stage completed. A missing -dump means that stage did not produce a completed result. Use the last -successful representation to locate where the invariant first stops holding. - -Failure groups are matching diagnostic signatures, not proven shared causes. -Use group size to estimate reach, then verify representatives from the group -before treating one owner hypothesis as established. Preserve the distinction -between the number of cases grouped and the number whose root cause has been -confirmed. +## 3. Reduce the case and identify the owner -## 3. Reduce and identify the owner - -Make a small reproducer from the replay bundle while preserving required imports -and declarations. State the expected behavior, actual diagnostic or output, and -the earliest representation where they diverge. +Make a small reproducer from the replay bundle while preserving required +imports and declarations. State the expected behavior, actual diagnostic or +output, and the earliest representation where they diverge. For generated +adapters or other compiler-created nodes, use explicit derivation records when +available. Source span overlap is a search hint, not lineage evidence. Read the governing design and identify the stage that owns the rule. Check the -input and output invariants of the adjacent stages. Prefer repairing a shared +input and output invariants of adjacent stages. Prefer repairing a shared representation or operation when multiple forms rely on it. Avoid a -feature-specific backend workaround when the earlier representation or calling -contract is wrong. Keep a concrete next hypothesis; when an investigation pass -produces no falsifiable next step, save the evidence and narrow the unanswered -boundary before adding more speculative changes. +feature-specific backend workaround when an earlier representation or calling +contract is wrong. Keep a falsifiable next hypothesis; when an investigation +produces no next step, save the evidence and narrow the unanswered boundary +before adding speculative changes. For roadmap work, the issue and board rules still decide which work comes next. -Among cases within that work, use affected-case count and downstream dependencies -to choose investigation order; a large signature group alone does not prove -cause or raise an issue's roadmap priority. +Among cases within that work, use affected-case count and downstream +dependencies to choose investigation order; a large signature group alone +does not prove cause or raise an issue's roadmap priority. ## 4. Validate the change at each affected layer -Run a focused test or replay that covers the reduced case and the relevant +Run a focused test or replay that covers the reduced case and relevant rejection path. Then rerun the same diagnosis selection with the same filter, -limit, timeout, corpus, and trusted-library setup. Compare the reports: +limit, timeout, corpus, trusted-library setup, and trace mode: ```sh cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ @@ -91,38 +130,54 @@ cargo run -p psrs-cli -- diagnose --corpus passing --filter Functor --limit 20 \ cargo run -p psrs-cli -- diagnose --compare /tmp/psrs-before.json /tmp/psrs-after.json ``` -The comparison reports per-case recovery, regression, stage/category changes, -input changes, and unmatched paths. Do not compare reports with incompatible -cohorts as if they were the same measurement. Investigate regressions and cases -whose inputs changed; record timeouts and crashes as incomplete evidence. +Comparison checks cohort and observed input compatibility, then reports +per-case recovery, regression, blocker changes, input changes, and unmatched +paths. Compiler revision may differ and is shown as the subject of comparison. +If inputs are incomplete or environment metadata differs, keep that limitation +visible. Until compatible canonical summaries are available, artifact-content +and earliest-artifact difference are reported as unavailable; do not infer an +IR change from different Debug output. + +Compile diagnosis establishes compile acceptance only. If behavior reaches +Wasm execution, run a focused value-sensitive runtime check that observes the +relevant results, call counts, output order, or traps. Record the exact Wasm +artifact and runtime/tool version where the test supports it. Keep outcomes +separate, for example: + +```text +compile: accepted +runtime: trapped +value assertions: incomplete +``` -Compile diagnosis only establishes compile acceptance. If the behavior under -change reaches Wasm execution, add focused runtime checks that observe actual -values, call counts, output order, or traps as appropriate. A successful compile -does not establish correct runtime behavior. For runtime-gated driver tests -that support it, require Wasmtime explicitly: +A successful compile does not establish correct runtime behavior. For +runtime-gated driver tests that support it, require Wasmtime explicitly: ```sh PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib focused_runtime_test_name ``` -Run the issue's required official-suite or scoreboard validation when the change -affects a gate or its acceptance evidence. Update D-04 and README measurements -only after rerunning the relevant scoreboard with the documented settings. -Small filtered diagnosis reports are useful for locating regressions; they are -not replacements for official acceptance measurements. +Run the issue's required official-suite or scoreboard validation when the +change affects a gate or its acceptance evidence. Update D-04 and README +measurements only after rerunning the relevant scoreboard with the documented +settings. Small filtered diagnosis reports are useful for locating regressions; +they are not replacements for official acceptance measurements. ## 5. Report the evidence For each iteration, report: - the starting commit and whether the worktree already had changes; -- the exact baseline and comparison commands and selected cohort; +- the exact baseline and comparison commands, selected cohort, and trace mode; - compile outcomes by first-blocker stage/category, keeping exclusions, timeouts, crashes, and incomplete inputs separate; -- the reproducer, suspected semantic owner, and evidence for that hypothesis; -- focused tests, runtime behavior exercised, and required suite/scoreboard runs; +- the first observed pass/artifact boundary, its evidence coverage, the + reproducer, and the suspected semantic owner; +- focused compile checks, runtime behavior exercised, and required suite or + scoreboard runs; - what changed, what remains unresolved, and which validations were not run. Do not turn a filtered cohort into a corpus-wide pass rate. Do not update a -scoreboard number from diagnostic output or from an unverified estimate. +scoreboard number from diagnostic output or from an unverified estimate. A +manifest, dump, or compile status does not substitute for missing lineage, +canonical artifact summaries, or value-sensitive runtime evidence. From 1cb5e428d91dfcccd6ed529869763e82182484d7 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 02:55:47 +0800 Subject: [PATCH 004/148] Ignore bound quantifiers when testing record layout dependence A rank-n dictionary field quantifies its own variables, so those variables do not make the record's layout depend on a free type variable. Parameter shapes then use the same scalar layout as other closed records instead of the erased aggregate special case. --- crates/psrs-backend/src/cc/layout/mod.rs | 38 +++++++++--- crates/psrs-backend/src/cc/layout/scalar.rs | 30 ++++----- .../psrs-backend/src/cc/layout/tests/mod.rs | 62 +++++++++++++++++++ 3 files changed, 104 insertions(+), 26 deletions(-) diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 15e3dbfc..629eb951 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -2,7 +2,7 @@ use super::VariantCase; use super::{ReprId, Representation, RepresentationTable, Signature, SignatureId, ValueShape}; use crate::BackendError; use psrs_core::{Module as CoreModule, Type, TypeConstructor, TypeId}; -use psrs_hir::{SymbolId, TypeId as HirTypeId}; +use psrs_hir::{SymbolId, TypeId as HirTypeId, TypeVariableId}; use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; @@ -408,24 +408,44 @@ pub(super) fn array_element_type(module: &CoreModule, id: TypeId) -> Option bool { - fn visit(module: &CoreModule, id: TypeId, visiting: &mut HashSet) -> bool { + fn visit( + module: &CoreModule, + id: TypeId, + bound: &mut HashMap, + visiting: &mut HashSet, + ) -> bool { if !visiting.insert(id) { return false; } let result = match module.types.get(id.0 as usize) { - Some(Type::Variable(_)) => true, + Some(Type::Variable(variable)) => !bound.contains_key(variable), Some(Type::Application(function, argument)) => { - visit(module, *function, visiting) || visit(module, *argument, visiting) + visit(module, *function, bound, visiting) + || visit(module, *argument, bound, visiting) + } + Some(Type::ForAll { variables, body }) => { + for variable in variables { + *bound.entry(*variable).or_default() += 1; + } + let dependent = visit(module, *body, bound, visiting); + for variable in variables { + if let Some(count) = bound.get_mut(variable) { + *count -= 1; + if *count == 0 { + bound.remove(variable); + } + } + } + dependent } - Some(Type::ForAll { body, .. }) => visit(module, *body, visiting), Some(Type::RowExtend { ty, tail, .. }) => { - visit(module, *ty, visiting) || visit(module, *tail, visiting) + visit(module, *ty, bound, visiting) || visit(module, *tail, bound, visiting) } Some(Type::Closure { parameters, result }) => { parameters .iter() - .any(|parameter| visit(module, *parameter, visiting)) - || visit(module, *result, visiting) + .any(|parameter| visit(module, *parameter, bound, visiting)) + || visit(module, *result, bound, visiting) } Some(Type::RowEmpty) => false, _ => false, @@ -434,5 +454,5 @@ pub(super) fn depends_on_type_variable(module: &CoreModule, id: TypeId) -> bool result } - visit(module, id, &mut HashSet::new()) + visit(module, id, &mut HashMap::new(), &mut HashSet::new()) } diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index e229918e..afc844bd 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -1,6 +1,6 @@ use super::{ - depends_on_type_variable, function_type_signature, is_callable_type, layout_error, - newtype_field_type, primitive_shape_of, unquantified_type, user_type_id, + function_type_signature, is_callable_type, layout_error, newtype_field_type, + primitive_shape_of, unquantified_type, user_type_id, }; use crate::BackendError; use crate::cc::{RefShape, Reference, ReprId, Signature, SignatureId, ValueShape}; @@ -404,21 +404,17 @@ pub(super) fn function_parameter_shape( record_types: &HashMap, function_types: &HashMap, ) -> Result> { - if module.is_record_type(ty) && depends_on_type_variable(module, ty) { - Ok(aggregate_value_type()) - } else { - scalar_type( - module, - ty, - span, - enum_types, - aggregate_types, - newtype_ids, - array_types, - record_types, - function_types, - ) - } + scalar_type( + module, + ty, + span, + enum_types, + aggregate_types, + newtype_ids, + array_types, + record_types, + function_types, + ) } fn aggregate_value_type() -> ValueShape { diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index 57c6da6e..90579056 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -122,6 +122,68 @@ fn quantifier_erasure_terminates_on_a_malformed_cycle() { ); } +#[test] +fn bound_rank_n_record_fields_do_not_make_dictionary_layout_dependent() { + fn push_closed_record(types: &mut Vec, field_type: TypeId) -> TypeId { + let empty = TypeId(types.len() as u32); + types.push(Type::RowEmpty); + let row = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: "method".into(), + ty: field_type, + tail: empty, + }); + let record_constructor = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::Record)); + let record = TypeId(types.len() as u32); + types.push(Type::Application(record_constructor, row)); + record + } + + let variable = TypeVariableId(0); + let mut types = vec![ + Type::Variable(variable), + Type::Constructor(TypeConstructor::Int), + ]; + let identity = push_arrow(&mut types, TypeId(0), TypeId(0)); + let polymorphic_identity = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![variable], + body: identity, + }); + let dictionary = push_closed_record(&mut types, polymorphic_identity); + let genuinely_dependent = push_closed_record(&mut types, TypeId(0)); + let module = empty_module(types); + + fn parameter_shape(module: &Module, ty: TypeId, representation: ReprId) -> ValueShape { + let record_types = HashMap::from([(ty, representation)]); + super::scalar::function_parameter_shape( + module, + ty, + module.span, + &HashSet::new(), + &HashSet::new(), + &HashSet::new(), + &HashMap::new(), + &record_types, + &HashMap::new(), + ) + .expect("a closed record parameter has a canonical product shape") + } + + assert!(!depends_on_type_variable(&module, dictionary)); + assert!(depends_on_type_variable(&module, genuinely_dependent)); + for (ty, representation) in [(dictionary, ReprId(7)), (genuinely_dependent, ReprId(8))] { + assert_eq!( + parameter_shape(&module, ty, representation), + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(representation), + }) + ); + } +} + #[test] fn equal_normalized_function_signatures_share_one_signature_id() { let array = TypeId(0); From a0cedcc4d60deddfc5a607b743c2773be389ab05 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 02:55:47 +0800 Subject: [PATCH 005/148] Add optional CC and WAT dumps to the Wasmtime test helper PSRS_DUMP_CC and PSRS_DUMP_WAT write the calling-convention and text forms beside a focused runtime test without changing the compiled artifact. --- crates/psrs-driver/src/tests/mod.rs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 11699faf..e6614b21 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -94,7 +94,14 @@ fn run_wasmtime_with_dirs( ) -> Option { wasmtime_available()?; use std::io::Write; + if let Some(path) = std::env::var_os("PSRS_DUMP_CC") { + let compilation = crate::compile_source_with_dumps("Main.purs", source).unwrap(); + std::fs::write(path, compilation.dumps.cc).unwrap(); + } let artifact = compile_source("Main.purs", source).unwrap(); + if let Some(path) = std::env::var_os("PSRS_DUMP_WAT") { + std::fs::write(path, &artifact.wat).unwrap(); + } let id = WASM_ARTIFACT_COUNTER.fetch_add(1, Ordering::Relaxed); let path = std::env::temp_dir().join(format!("psrs-{}-{id}.wasm", std::process::id())); std::fs::write(&path, &artifact.wasm).unwrap(); From e1ba35e1fc7a77e8f1b4657a2173fb9b1738ab97 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 16:44:53 +0800 Subject: [PATCH 006/148] Skip compiler-provided modules when loading the vendored library The vendored official `Safe.Coerce` shadows the compiler's primitive interface for the same module. Its body is `coerce = unsafeCoerce`, whose `unsafeCoerce` is a self-recursive stub this project cannot execute, so every program that reaches it loops at runtime. Keep the vendored source faithful to upstream and resolve the module through the compiler interface instead: expose `compiler_provided_module` from `psrs-resolve` and have the driver's library loader skip such a name. Imports then fall through to the virtual interface, which maps `coerce` to the checked coercion intrinsic and `Coercible` to the shared class. `Unsafe.Coerce` has no compiler interface yet; its `foreign import` is represented as the same recursive stub, so a program that reaches it is a recorded gap rather than a working coercion. --- crates/psrs-driver/src/prelude.rs | 7 +++++++ crates/psrs-resolve/src/lib.rs | 4 ++-- crates/psrs-resolve/src/resolver/mod.rs | 4 ++-- crates/psrs-resolve/src/resolver/program/mod.rs | 6 ++++++ .../frontend/semantics/modules-and-resolution.md | 12 +++++++++++- 5 files changed, 28 insertions(+), 5 deletions(-) diff --git a/crates/psrs-driver/src/prelude.rs b/crates/psrs-driver/src/prelude.rs index 74c3d947..a82d88a6 100644 --- a/crates/psrs-driver/src/prelude.rs +++ b/crates/psrs-driver/src/prelude.rs @@ -91,6 +91,13 @@ fn read_library() -> Result { let names = read_trusted_names(&lib.join("trusted"))?; let mut modules = Vec::with_capacity(names.len()); for name in names { + // A compiler-provided module (for example `Safe.Coerce`) resolves + // through its primitive interface. Loading the vendored file as well + // would shadow that interface with the official `unsafeCoerce` body, + // which the project cannot compile. + if psrs_resolve::compiler_provided_module(&name) { + continue; + } let path = module_file(&lib, &name); let text = std::fs::read_to_string(&path) .map_err(|error| format!("{}: {error}", path.display()))?; diff --git a/crates/psrs-resolve/src/lib.rs b/crates/psrs-resolve/src/lib.rs index d5bca052..b523b5ae 100644 --- a/crates/psrs-resolve/src/lib.rs +++ b/crates/psrs-resolve/src/lib.rs @@ -2,6 +2,6 @@ mod resolver; pub use resolver::{ ProgramError, ResolveError, ResolveErrorKind, ResolveOptions, bootstrap_externals, - resolve_module, resolve_module_with_externals, resolve_program, resolve_program_partial, - resolve_program_with_options, + compiler_provided_module, resolve_module, resolve_module_with_externals, resolve_program, + resolve_program_partial, resolve_program_with_options, }; diff --git a/crates/psrs-resolve/src/resolver/mod.rs b/crates/psrs-resolve/src/resolver/mod.rs index 5f852a05..f9719491 100644 --- a/crates/psrs-resolve/src/resolver/mod.rs +++ b/crates/psrs-resolve/src/resolver/mod.rs @@ -8,8 +8,8 @@ use std::collections::{HashMap, HashSet}; mod program; pub use program::{ - ProgramError, ResolveOptions, resolve_program, resolve_program_partial, - resolve_program_with_options, + ProgramError, ResolveOptions, compiler_provided_module, resolve_program, + resolve_program_partial, resolve_program_with_options, }; mod bootstrap; diff --git a/crates/psrs-resolve/src/resolver/program/mod.rs b/crates/psrs-resolve/src/resolver/program/mod.rs index 8d92a05f..1740cea8 100644 --- a/crates/psrs-resolve/src/resolver/program/mod.rs +++ b/crates/psrs-resolve/src/resolver/program/mod.rs @@ -17,6 +17,12 @@ mod interface; use interface::Interface; +/// Whether the compiler provides `name` as a primitive interface rather than +/// from source. A library file with the same name must not shadow it. +pub fn compiler_provided_module(name: &str) -> bool { + Interface::primitive_module(name).is_some() +} + /// A resolution error tied to one module of a program. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ProgramError { diff --git a/docs/design/frontend/semantics/modules-and-resolution.md b/docs/design/frontend/semantics/modules-and-resolution.md index 580050a5..be00a7dc 100644 --- a/docs/design/frontend/semantics/modules-and-resolution.md +++ b/docs/design/frontend/semantics/modules-and-resolution.md @@ -94,7 +94,17 @@ declared identities through qualification and re-exports, and carry a reach the same compiler-owned identity. A source module named `Prim` or beginning with `Prim.` is rejected; source cannot replace a compiler interface. The root `undefined` value reaches source only through this interface, not as a -free name. +free name. The compiler-provided set is not limited to `Prim`: +`Safe.Coerce` is virtual too, exporting `coerce` as the checked coercion +intrinsic and `Coercible` as the shared declared class. Because the vendored +official `Safe.Coerce` source is kept faithful to upstream — its body is +`coerce = unsafeCoerce` — the driver must not load an on-disk file for a module +the compiler provides; doing so would shadow the interface with a body the +project cannot compile. The loader skips such a module and imports fall through +to the virtual interface. `Unsafe.Coerce.unsafeCoerce` has no compiler +interface yet: the vendored module is faithful but its `foreign import` is +represented as a self-recursive stub this project cannot execute, so a program +that reaches it is a recorded gap rather than a working coercion. This document owns that interface: which names exist, which identity each carries, and that nothing in source can replace one. What a member *means* — which of them From 447c4cd9bd7640ccaf9bd610d19b3b14c1625327 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 16:45:00 +0800 Subject: [PATCH 007/148] Restore the workspace test suite after vendored-library slicing The live-type layout filter added when the core libraries were vendored only lays out arrays and records reachable from a declaration or constructor field, so the raw-type layout fixtures never reserved their aggregates. Root those types through declarations in the tests, which is what the production builder sees. Split `psrs-ast/tests.rs` and `psrs-typecheck/classes/fundeps.rs` into module directories; both crossed the 500-line source limit earlier on this branch. --- crates/psrs-ast/src/tests.rs | 525 ------------------ crates/psrs-ast/src/tests/do_blocks.rs | 200 +++++++ crates/psrs-ast/src/tests/mod.rs | 225 ++++++++ crates/psrs-ast/src/tests/where_blocks.rs | 104 ++++ .../psrs-backend/src/cc/layout/tests/mod.rs | 33 +- .../src/cc/layout/tests/records.rs | 3 +- .../classes/{fundeps.rs => fundeps/mod.rs} | 70 +-- .../src/typecheck/classes/fundeps/support.rs | 68 +++ 8 files changed, 632 insertions(+), 596 deletions(-) delete mode 100644 crates/psrs-ast/src/tests.rs create mode 100644 crates/psrs-ast/src/tests/do_blocks.rs create mode 100644 crates/psrs-ast/src/tests/mod.rs create mode 100644 crates/psrs-ast/src/tests/where_blocks.rs rename crates/psrs-typecheck/src/typecheck/classes/{fundeps.rs => fundeps/mod.rs} (89%) create mode 100644 crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs diff --git a/crates/psrs-ast/src/tests.rs b/crates/psrs-ast/src/tests.rs deleted file mode 100644 index d765ecf1..00000000 --- a/crates/psrs-ast/src/tests.rs +++ /dev/null @@ -1,525 +0,0 @@ -use super::*; -use psrs_cst::{ - CstName, Declaration as CstDeclaration, Module as CstModule, Pattern, PatternKind, - TypeVarBinder, ValueDeclaration, ValueRhs, -}; -use psrs_span::TextRange; - -fn name(text: &str, start: u32) -> CstName { - CstName { - text: text.into(), - span: TextRange::new(start, start + text.len() as u32), - } -} - -fn pattern_var(text: &str, start: u32) -> Pattern { - Pattern { - kind: PatternKind::Var(name(text, start)), - span: TextRange::new(start, start + text.len() as u32), - } -} - -fn type_var_binder(text: &str, start: u32) -> TypeVarBinder { - TypeVarBinder { - name: name(text, start), - kind: None, - span: TextRange::new(start, start + text.len() as u32), - } -} - -fn cst_module(declaration: CstDeclaration) -> CstModule { - CstModule { - module_keyword_span: TextRange::new(0, 6), - name: name("Main", 7), - exports: None, - where_keyword_span: TextRange::new(12, 17), - imports: Vec::new(), - declarations: vec![declaration], - span: TextRange::new(0, 40), - } -} - -fn value_declaration( - name_text: &str, - name_start: u32, - parameters: Vec, - equals_span: TextRange, - value: cst::Expr, - span_end: u32, - annotation: Option, -) -> CstDeclaration { - CstDeclaration::Value(ValueDeclaration { - name: name(name_text, name_start), - parameters, - rhs: ValueRhs::Plain { equals_span, value }, - where_block: None, - span: TextRange::new(name_start, span_end), - annotation, - }) -} - -#[test] -fn function_parameters_become_nested_lambdas_and_names_stay_unresolved() { - let value = cst::Expr { - kind: CstExprKind::Operator { - operator: name("+", 33), - left: Box::new(cst::Expr { - kind: CstExprKind::Name(name("x", 31)), - span: TextRange::new(31, 32), - }), - right: Box::new(cst::Expr { - kind: CstExprKind::Name(name("y", 35)), - span: TextRange::new(35, 36), - }), - }, - span: TextRange::new(31, 36), - }; - let declaration = value_declaration( - "add", - 19, - vec![pattern_var("x", 23), pattern_var("y", 25)], - TextRange::new(27, 28), - value, - 36, - None, - ); - let module = lower_module(cst_module(declaration)).unwrap(); - let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { - panic!("expected the first normalized lambda"); - }; - assert_eq!(binder.name, "x"); - let ExprKind::Lambda { binder, body } = &body.kind else { - panic!("expected the second normalized lambda"); - }; - assert_eq!(binder.name, "y"); - let ExprKind::OperatorChain { - operands, - operators, - } = &body.kind - else { - panic!("expected the source operator chain to remain unresolved"); - }; - assert_eq!(operators.len(), 1); - assert_eq!(operators[0].name.text, "+"); - assert!(matches!(&operands[0].kind, ExprKind::Name(name) if name.text == "x")); - assert!(matches!(&operands[1].kind, ExprKind::Name(name) if name.text == "y")); -} - -#[test] -fn parentheses_are_removed_without_losing_the_expression_range() { - let declaration = value_declaration( - "main", - 18, - Vec::new(), - TextRange::new(23, 24), - cst::Expr { - kind: CstExprKind::Parens { - open_paren_span: TextRange::new(25, 26), - expression: Box::new(cst::Expr { - kind: CstExprKind::Integer("42".into()), - span: TextRange::new(26, 28), - }), - close_paren_span: TextRange::new(28, 29), - }, - span: TextRange::new(25, 29), - }, - 29, - None, - ); - let module = lower_module(cst_module(declaration)).unwrap(); - let value = &module.declarations[0].value; - assert!(matches!(value.kind, ExprKind::Integer(ref value) if value == "42")); - assert_eq!(value.span, TextRange::new(25, 29)); -} - -#[test] -fn anonymous_record_accessor_is_lowered_to_a_lambda() { - let underscore_span = TextRange::new(25, 26); - let field_span = TextRange::new(27, 32); - let expression = cst::Expr { - kind: CstExprKind::RecordAccessor { - marker_span: underscore_span, - fields: vec![cst::RecordAccessorField { - dot_span: TextRange::new(26, 27), - field: name("value", field_span.start), - }], - }, - span: TextRange::new(25, 32), - }; - let declaration = value_declaration( - "project", - 18, - Vec::new(), - TextRange::new(23, 24), - expression, - 32, - None, - ); - let module = lower_module(cst_module(declaration)).unwrap(); - let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { - panic!("an anonymous record accessor should become a lambda"); - }; - assert_eq!(module.declarations[0].value.span, TextRange::new(25, 32)); - let ExprKind::FieldAccess { expression, field } = &body.kind else { - panic!("the accessor lambda should contain a field access"); - }; - assert_eq!(field, "value"); - assert!(matches!( - &expression.kind, - ExprKind::Name(name) if name.text == binder.name - )); -} - -#[test] -fn lowers_forall_types_and_removes_parentheses() { - let annotation = cst::TypeExpr { - kind: cst::TypeExprKind::Forall { - forall_span: TextRange::new(0, 6), - variables: vec![type_var_binder("a", 7)], - dot_span: TextRange::new(8, 9), - body: Box::new(cst::TypeExpr { - kind: cst::TypeExprKind::Parens { - open_paren_span: TextRange::new(10, 11), - expression: Box::new(cst::TypeExpr { - kind: cst::TypeExprKind::Name(name("a", 11)), - span: TextRange::new(11, 12), - }), - close_paren_span: TextRange::new(12, 13), - }, - span: TextRange::new(10, 13), - }), - }, - span: TextRange::new(0, 13), - }; - let declaration = value_declaration( - "id", - 19, - vec![pattern_var("x", 23)], - TextRange::new(25, 26), - cst::Expr { - kind: CstExprKind::Name(name("x", 27)), - span: TextRange::new(27, 28), - }, - 28, - Some(annotation), - ); - let module = lower_module(cst_module(declaration)).unwrap(); - let annotation = module.declarations[0].annotation.as_ref().unwrap(); - let TypeKind::Forall { variables, body } = &annotation.kind else { - panic!("expected a lowered forall"); - }; - assert_eq!(variables.len(), 1); - assert_eq!(variables[0].name.text, "a"); - assert!(variables[0].kind.is_none()); - assert!(matches!(&body.kind, TypeKind::Name(name) if name.text == "a")); - assert_eq!(body.span, TextRange::new(10, 13)); -} - -fn cst_expr(kind: CstExprKind, start: u32, end: u32) -> cst::Expr { - cst::Expr { - kind, - span: TextRange::new(start, end), - } -} - -fn do_expr(statements: Vec, start: u32, end: u32) -> cst::Expr { - cst::Expr { - kind: CstExprKind::Do { - do_keyword_span: TextRange::new(start, start + 2), - layout_start_span: TextRange::empty(start + 2), - statements, - layout_end_span: TextRange::empty(end), - in_keyword_span: None, - result: None, - }, - span: TextRange::new(start, end), - } -} - -fn lower_do_blocks(statements: Vec) -> Result> { - let value = do_expr(statements, 30, 90); - let declaration = value_declaration( - "main", - 18, - Vec::new(), - TextRange::new(24, 25), - value, - 90, - None, - ); - Ok(lower_module(cst_module(declaration))? - .declarations - .remove(0) - .value) -} - -#[test] -fn lowers_a_do_bind_to_bind_and_a_continuation_lambda() { - let statements = vec![ - cst::DoStatement::Bind { - pattern: pattern_var("x", 40), - left_arrow_span: TextRange::new(42, 44), - value: cst_expr(CstExprKind::Name(name("effect", 45)), 45, 51), - }, - cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 55)), 55, 59)), - ]; - let value = lower_do_blocks(statements).unwrap(); - let ExprKind::Application(partial, continuation) = &value.kind else { - panic!("expected a bind application, got {:?}", value.kind); - }; - let ExprKind::Application(function, argument) = &partial.kind else { - panic!("expected the bind function to be applied to the effect"); - }; - assert!(matches!(&function.kind, ExprKind::Name(name) if name.text == "bind")); - assert!(matches!(&argument.kind, ExprKind::Name(name) if name.text == "effect")); - let ExprKind::Lambda { binder, body } = &continuation.kind else { - panic!("expected a continuation lambda"); - }; - assert_eq!(binder.name, "x"); - assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "rest")); - assert_eq!(value.span, TextRange::new(30, 90)); -} - -#[test] -fn lowers_a_do_discard_to_discard_and_a_wildcard_lambda() { - let statements = vec![ - cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("effect", 40)), 40, 46)), - cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 48)), 48, 52)), - ]; - let value = lower_do_blocks(statements).unwrap(); - let ExprKind::Application(partial, continuation) = &value.kind else { - panic!("expected a discard application"); - }; - let ExprKind::Application(function, _) = &partial.kind else { - panic!("expected the discard function to be applied to the effect"); - }; - assert!(matches!(&function.kind, ExprKind::Name(name) if name.text == "discard")); - let ExprKind::Lambda { binder, .. } = &continuation.kind else { - panic!("expected a wildcard continuation lambda"); - }; - assert!(binder.name.starts_with("__psrs_do_wildcard_")); -} - -#[test] -fn a_final_do_value_is_the_result_without_pure() { - let statements = vec![cst::DoStatement::Discard(cst_expr( - CstExprKind::Name(name("result", 40)), - 40, - 46, - ))]; - let value = lower_do_blocks(statements).unwrap(); - assert!(matches!(&value.kind, ExprKind::Name(name) if name.text == "result")); - assert_eq!(value.span, TextRange::new(30, 90)); -} - -#[test] -fn lowers_a_non_variable_do_binder_through_a_case() { - let constructor = Pattern { - kind: PatternKind::Constructor { - name: name("Unit", 40), - arguments: Vec::new(), - }, - span: TextRange::new(40, 44), - }; - let statements = vec![ - cst::DoStatement::Bind { - pattern: constructor, - left_arrow_span: TextRange::new(45, 47), - value: cst_expr(CstExprKind::Name(name("effect", 48)), 48, 54), - }, - cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 56)), 56, 60)), - ]; - let value = lower_do_blocks(statements).unwrap(); - let ExprKind::Application(_, continuation) = &value.kind else { - panic!("expected a bind application"); - }; - let ExprKind::Lambda { binder, body } = &continuation.kind else { - panic!("expected a continuation lambda"); - }; - assert!(binder.name.starts_with("$psrs_pattern_")); - let ExprKind::Case { - scrutinee, - branches, - } = &body.kind - else { - panic!("expected a case for the non-variable binder"); - }; - assert!(matches!(&scrutinee.kind, ExprKind::Name(name) if name.text == binder.name)); - assert_eq!(branches.len(), 1); - assert!(matches!( - &branches[0].pattern.kind, - crate::PatternKind::Constructor { name, arguments } - if name.text == "Unit" && arguments.is_empty() - )); -} - -#[test] -fn lowers_a_do_let_to_a_let_around_the_rest() { - let binding = value_declaration( - "y", - 40, - Vec::new(), - TextRange::new(42, 43), - cst_expr(CstExprKind::Integer("1".into()), 44, 45), - 45, - None, - ); - let statements = vec![ - cst::DoStatement::Let { - let_keyword_span: TextRange::new(32, 35), - declarations: vec![binding], - layout_start_span: TextRange::empty(36), - layout_end_span: TextRange::empty(45), - }, - cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 48)), 48, 52)), - ]; - let value = lower_do_blocks(statements).unwrap(); - let ExprKind::Let { declarations, body } = &value.kind else { - panic!("expected a let around the rest"); - }; - assert_eq!(declarations.len(), 1); - assert_eq!(declarations[0].name.text, "y"); - assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "rest")); -} - -#[test] -fn rejects_an_empty_do_block() { - let error = lower_do_blocks(Vec::new()).unwrap_err(); - assert_eq!(error[0].message, "an empty `do` block is not allowed"); - assert!(error[0].code.is_none()); -} - -#[test] -fn rejects_a_do_block_ending_in_a_bind() { - let statements = vec![cst::DoStatement::Bind { - pattern: pattern_var("x", 40), - left_arrow_span: TextRange::new(42, 44), - value: cst_expr(CstExprKind::Name(name("effect", 45)), 45, 51), - }]; - let error = lower_do_blocks(statements).unwrap_err(); - assert_eq!(error[0].code, Some("InvalidDoBind")); -} - -fn declaration_block( - declarations: Vec, - start: u32, - end: u32, -) -> cst::DeclarationBlock { - cst::DeclarationBlock { - where_keyword_span: TextRange::new(start, start + 5), - layout_start_span: TextRange::empty(start + 5), - declarations, - layout_end_span: TextRange::empty(end), - span: TextRange::new(start, end), - } -} - -#[test] -fn lowers_a_value_where_block_to_a_let_inside_the_parameters() { - let binding = value_declaration( - "y", - 40, - Vec::new(), - TextRange::new(42, 43), - cst_expr(CstExprKind::Integer("1".into()), 44, 45), - 45, - None, - ); - let declaration = CstDeclaration::Value(ValueDeclaration { - name: name("f", 30), - parameters: vec![pattern_var("x", 32)], - rhs: ValueRhs::Plain { - equals_span: TextRange::new(34, 35), - value: cst_expr(CstExprKind::Name(name("y", 36)), 36, 37), - }, - where_block: Some(declaration_block(vec![binding], 38, 50)), - span: TextRange::new(30, 50), - annotation: None, - }); - let module = lower_module(cst_module(declaration)).unwrap(); - let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { - panic!("expected the parameter lambda"); - }; - assert_eq!(binder.name, "x"); - let ExprKind::Let { declarations, body } = &body.kind else { - panic!("expected the where declarations as a let inside the parameter"); - }; - assert_eq!(declarations.len(), 1); - assert_eq!(declarations[0].name.text, "y"); - assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "y")); -} - -#[test] -fn lowers_a_case_where_block_to_a_let_in_the_branch() { - let binding = value_declaration( - "y", - 40, - Vec::new(), - TextRange::new(42, 43), - cst_expr(CstExprKind::Name(name("x", 44)), 44, 45), - 45, - None, - ); - let alternative = cst::CaseAlternative { - patterns: vec![pattern_var("x", 33)], - rhs: cst::CaseRhs::Plain { - arrow_span: TextRange::new(35, 37), - value: cst_expr(CstExprKind::Name(name("y", 38)), 38, 39), - where_block: Some(declaration_block(vec![binding], 40, 50)), - }, - span: TextRange::new(33, 50), - }; - let case = cst_expr( - CstExprKind::Case { - case_keyword_span: TextRange::new(20, 24), - scrutinees: vec![cst_expr(CstExprKind::Name(name("value", 25)), 25, 30)], - of_keyword_span: TextRange::new(31, 33), - layout_start_span: TextRange::empty(33), - alternatives: vec![alternative], - layout_end_span: TextRange::empty(50), - }, - 20, - 50, - ); - let declaration = value_declaration( - "main", - 18, - Vec::new(), - TextRange::new(24, 25), - case, - 50, - None, - ); - let module = lower_module(cst_module(declaration)).unwrap(); - let ExprKind::Case { branches, .. } = &module.declarations[0].value.kind else { - panic!("expected a case expression"); - }; - assert_eq!(branches.len(), 1); - let ExprKind::Let { declarations, body } = &branches[0].value.kind else { - panic!("expected the where declarations as a let around the branch body"); - }; - assert_eq!(declarations.len(), 1); - assert_eq!(declarations[0].name.text, "y"); - assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "y")); -} - -#[test] -fn rejects_a_do_block_ending_in_a_let() { - let binding = value_declaration( - "y", - 40, - Vec::new(), - TextRange::new(42, 43), - cst_expr(CstExprKind::Integer("1".into()), 44, 45), - 45, - None, - ); - let statements = vec![cst::DoStatement::Let { - let_keyword_span: TextRange::new(32, 35), - declarations: vec![binding], - layout_start_span: TextRange::empty(36), - layout_end_span: TextRange::empty(45), - }]; - let error = lower_do_blocks(statements).unwrap_err(); - assert_eq!(error[0].code, Some("InvalidDoLet")); -} diff --git a/crates/psrs-ast/src/tests/do_blocks.rs b/crates/psrs-ast/src/tests/do_blocks.rs new file mode 100644 index 00000000..13ace09e --- /dev/null +++ b/crates/psrs-ast/src/tests/do_blocks.rs @@ -0,0 +1,200 @@ +use super::*; + +fn do_expr(statements: Vec, start: u32, end: u32) -> cst::Expr { + cst::Expr { + kind: CstExprKind::Do { + do_keyword_span: TextRange::new(start, start + 2), + layout_start_span: TextRange::empty(start + 2), + statements, + layout_end_span: TextRange::empty(end), + in_keyword_span: None, + result: None, + }, + span: TextRange::new(start, end), + } +} + +fn lower_do_blocks(statements: Vec) -> Result> { + let value = do_expr(statements, 30, 90); + let declaration = value_declaration( + "main", + 18, + Vec::new(), + TextRange::new(24, 25), + value, + 90, + None, + ); + Ok(lower_module(cst_module(declaration))? + .declarations + .remove(0) + .value) +} + +#[test] +fn lowers_a_do_bind_to_bind_and_a_continuation_lambda() { + let statements = vec![ + cst::DoStatement::Bind { + pattern: pattern_var("x", 40), + left_arrow_span: TextRange::new(42, 44), + value: cst_expr(CstExprKind::Name(name("effect", 45)), 45, 51), + }, + cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 55)), 55, 59)), + ]; + let value = lower_do_blocks(statements).unwrap(); + let ExprKind::Application(partial, continuation) = &value.kind else { + panic!("expected a bind application, got {:?}", value.kind); + }; + let ExprKind::Application(function, argument) = &partial.kind else { + panic!("expected the bind function to be applied to the effect"); + }; + assert!(matches!(&function.kind, ExprKind::Name(name) if name.text == "bind")); + assert!(matches!(&argument.kind, ExprKind::Name(name) if name.text == "effect")); + let ExprKind::Lambda { binder, body } = &continuation.kind else { + panic!("expected a continuation lambda"); + }; + assert_eq!(binder.name, "x"); + assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "rest")); + assert_eq!(value.span, TextRange::new(30, 90)); +} + +#[test] +fn lowers_a_do_discard_to_discard_and_a_wildcard_lambda() { + let statements = vec![ + cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("effect", 40)), 40, 46)), + cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 48)), 48, 52)), + ]; + let value = lower_do_blocks(statements).unwrap(); + let ExprKind::Application(partial, continuation) = &value.kind else { + panic!("expected a discard application"); + }; + let ExprKind::Application(function, _) = &partial.kind else { + panic!("expected the discard function to be applied to the effect"); + }; + assert!(matches!(&function.kind, ExprKind::Name(name) if name.text == "discard")); + let ExprKind::Lambda { binder, .. } = &continuation.kind else { + panic!("expected a wildcard continuation lambda"); + }; + assert!(binder.name.starts_with("__psrs_do_wildcard_")); +} + +#[test] +fn a_final_do_value_is_the_result_without_pure() { + let statements = vec![cst::DoStatement::Discard(cst_expr( + CstExprKind::Name(name("result", 40)), + 40, + 46, + ))]; + let value = lower_do_blocks(statements).unwrap(); + assert!(matches!(&value.kind, ExprKind::Name(name) if name.text == "result")); + assert_eq!(value.span, TextRange::new(30, 90)); +} + +#[test] +fn lowers_a_non_variable_do_binder_through_a_case() { + let constructor = Pattern { + kind: PatternKind::Constructor { + name: name("Unit", 40), + arguments: Vec::new(), + }, + span: TextRange::new(40, 44), + }; + let statements = vec![ + cst::DoStatement::Bind { + pattern: constructor, + left_arrow_span: TextRange::new(45, 47), + value: cst_expr(CstExprKind::Name(name("effect", 48)), 48, 54), + }, + cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 56)), 56, 60)), + ]; + let value = lower_do_blocks(statements).unwrap(); + let ExprKind::Application(_, continuation) = &value.kind else { + panic!("expected a bind application"); + }; + let ExprKind::Lambda { binder, body } = &continuation.kind else { + panic!("expected a continuation lambda"); + }; + assert!(binder.name.starts_with("$psrs_pattern_")); + let ExprKind::Case { + scrutinee, + branches, + } = &body.kind + else { + panic!("expected a case for the non-variable binder"); + }; + assert!(matches!(&scrutinee.kind, ExprKind::Name(name) if name.text == binder.name)); + assert_eq!(branches.len(), 1); + assert!(matches!( + &branches[0].pattern.kind, + crate::PatternKind::Constructor { name, arguments } + if name.text == "Unit" && arguments.is_empty() + )); +} + +#[test] +fn lowers_a_do_let_to_a_let_around_the_rest() { + let binding = value_declaration( + "y", + 40, + Vec::new(), + TextRange::new(42, 43), + cst_expr(CstExprKind::Integer("1".into()), 44, 45), + 45, + None, + ); + let statements = vec![ + cst::DoStatement::Let { + let_keyword_span: TextRange::new(32, 35), + declarations: vec![binding], + layout_start_span: TextRange::empty(36), + layout_end_span: TextRange::empty(45), + }, + cst::DoStatement::Discard(cst_expr(CstExprKind::Name(name("rest", 48)), 48, 52)), + ]; + let value = lower_do_blocks(statements).unwrap(); + let ExprKind::Let { declarations, body } = &value.kind else { + panic!("expected a let around the rest"); + }; + assert_eq!(declarations.len(), 1); + assert_eq!(declarations[0].name.text, "y"); + assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "rest")); +} + +#[test] +fn rejects_an_empty_do_block() { + let error = lower_do_blocks(Vec::new()).unwrap_err(); + assert_eq!(error[0].message, "an empty `do` block is not allowed"); + assert!(error[0].code.is_none()); +} + +#[test] +fn rejects_a_do_block_ending_in_a_bind() { + let statements = vec![cst::DoStatement::Bind { + pattern: pattern_var("x", 40), + left_arrow_span: TextRange::new(42, 44), + value: cst_expr(CstExprKind::Name(name("effect", 45)), 45, 51), + }]; + let error = lower_do_blocks(statements).unwrap_err(); + assert_eq!(error[0].code, Some("InvalidDoBind")); +} + +#[test] +fn rejects_a_do_block_ending_in_a_let() { + let binding = value_declaration( + "y", + 40, + Vec::new(), + TextRange::new(42, 43), + cst_expr(CstExprKind::Integer("1".into()), 44, 45), + 45, + None, + ); + let statements = vec![cst::DoStatement::Let { + let_keyword_span: TextRange::new(32, 35), + declarations: vec![binding], + layout_start_span: TextRange::empty(36), + layout_end_span: TextRange::empty(45), + }]; + let error = lower_do_blocks(statements).unwrap_err(); + assert_eq!(error[0].code, Some("InvalidDoLet")); +} diff --git a/crates/psrs-ast/src/tests/mod.rs b/crates/psrs-ast/src/tests/mod.rs new file mode 100644 index 00000000..a698a2b3 --- /dev/null +++ b/crates/psrs-ast/src/tests/mod.rs @@ -0,0 +1,225 @@ +use super::*; +use psrs_cst::{ + CstName, Declaration as CstDeclaration, Module as CstModule, Pattern, PatternKind, + TypeVarBinder, ValueDeclaration, ValueRhs, +}; +use psrs_span::TextRange; +mod do_blocks; +mod where_blocks; + +fn name(text: &str, start: u32) -> CstName { + CstName { + text: text.into(), + span: TextRange::new(start, start + text.len() as u32), + } +} + +fn pattern_var(text: &str, start: u32) -> Pattern { + Pattern { + kind: PatternKind::Var(name(text, start)), + span: TextRange::new(start, start + text.len() as u32), + } +} + +fn type_var_binder(text: &str, start: u32) -> TypeVarBinder { + TypeVarBinder { + name: name(text, start), + kind: None, + span: TextRange::new(start, start + text.len() as u32), + } +} + +fn cst_module(declaration: CstDeclaration) -> CstModule { + CstModule { + module_keyword_span: TextRange::new(0, 6), + name: name("Main", 7), + exports: None, + where_keyword_span: TextRange::new(12, 17), + imports: Vec::new(), + declarations: vec![declaration], + span: TextRange::new(0, 40), + } +} + +fn value_declaration( + name_text: &str, + name_start: u32, + parameters: Vec, + equals_span: TextRange, + value: cst::Expr, + span_end: u32, + annotation: Option, +) -> CstDeclaration { + CstDeclaration::Value(ValueDeclaration { + name: name(name_text, name_start), + parameters, + rhs: ValueRhs::Plain { equals_span, value }, + where_block: None, + span: TextRange::new(name_start, span_end), + annotation, + }) +} + +#[test] +fn function_parameters_become_nested_lambdas_and_names_stay_unresolved() { + let value = cst::Expr { + kind: CstExprKind::Operator { + operator: name("+", 33), + left: Box::new(cst::Expr { + kind: CstExprKind::Name(name("x", 31)), + span: TextRange::new(31, 32), + }), + right: Box::new(cst::Expr { + kind: CstExprKind::Name(name("y", 35)), + span: TextRange::new(35, 36), + }), + }, + span: TextRange::new(31, 36), + }; + let declaration = value_declaration( + "add", + 19, + vec![pattern_var("x", 23), pattern_var("y", 25)], + TextRange::new(27, 28), + value, + 36, + None, + ); + let module = lower_module(cst_module(declaration)).unwrap(); + let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { + panic!("expected the first normalized lambda"); + }; + assert_eq!(binder.name, "x"); + let ExprKind::Lambda { binder, body } = &body.kind else { + panic!("expected the second normalized lambda"); + }; + assert_eq!(binder.name, "y"); + let ExprKind::OperatorChain { + operands, + operators, + } = &body.kind + else { + panic!("expected the source operator chain to remain unresolved"); + }; + assert_eq!(operators.len(), 1); + assert_eq!(operators[0].name.text, "+"); + assert!(matches!(&operands[0].kind, ExprKind::Name(name) if name.text == "x")); + assert!(matches!(&operands[1].kind, ExprKind::Name(name) if name.text == "y")); +} + +#[test] +fn parentheses_are_removed_without_losing_the_expression_range() { + let declaration = value_declaration( + "main", + 18, + Vec::new(), + TextRange::new(23, 24), + cst::Expr { + kind: CstExprKind::Parens { + open_paren_span: TextRange::new(25, 26), + expression: Box::new(cst::Expr { + kind: CstExprKind::Integer("42".into()), + span: TextRange::new(26, 28), + }), + close_paren_span: TextRange::new(28, 29), + }, + span: TextRange::new(25, 29), + }, + 29, + None, + ); + let module = lower_module(cst_module(declaration)).unwrap(); + let value = &module.declarations[0].value; + assert!(matches!(value.kind, ExprKind::Integer(ref value) if value == "42")); + assert_eq!(value.span, TextRange::new(25, 29)); +} + +#[test] +fn anonymous_record_accessor_is_lowered_to_a_lambda() { + let underscore_span = TextRange::new(25, 26); + let field_span = TextRange::new(27, 32); + let expression = cst::Expr { + kind: CstExprKind::RecordAccessor { + marker_span: underscore_span, + fields: vec![cst::RecordAccessorField { + dot_span: TextRange::new(26, 27), + field: name("value", field_span.start), + }], + }, + span: TextRange::new(25, 32), + }; + let declaration = value_declaration( + "project", + 18, + Vec::new(), + TextRange::new(23, 24), + expression, + 32, + None, + ); + let module = lower_module(cst_module(declaration)).unwrap(); + let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { + panic!("an anonymous record accessor should become a lambda"); + }; + assert_eq!(module.declarations[0].value.span, TextRange::new(25, 32)); + let ExprKind::FieldAccess { expression, field } = &body.kind else { + panic!("the accessor lambda should contain a field access"); + }; + assert_eq!(field, "value"); + assert!(matches!( + &expression.kind, + ExprKind::Name(name) if name.text == binder.name + )); +} + +#[test] +fn lowers_forall_types_and_removes_parentheses() { + let annotation = cst::TypeExpr { + kind: cst::TypeExprKind::Forall { + forall_span: TextRange::new(0, 6), + variables: vec![type_var_binder("a", 7)], + dot_span: TextRange::new(8, 9), + body: Box::new(cst::TypeExpr { + kind: cst::TypeExprKind::Parens { + open_paren_span: TextRange::new(10, 11), + expression: Box::new(cst::TypeExpr { + kind: cst::TypeExprKind::Name(name("a", 11)), + span: TextRange::new(11, 12), + }), + close_paren_span: TextRange::new(12, 13), + }, + span: TextRange::new(10, 13), + }), + }, + span: TextRange::new(0, 13), + }; + let declaration = value_declaration( + "id", + 19, + vec![pattern_var("x", 23)], + TextRange::new(25, 26), + cst::Expr { + kind: CstExprKind::Name(name("x", 27)), + span: TextRange::new(27, 28), + }, + 28, + Some(annotation), + ); + let module = lower_module(cst_module(declaration)).unwrap(); + let annotation = module.declarations[0].annotation.as_ref().unwrap(); + let TypeKind::Forall { variables, body } = &annotation.kind else { + panic!("expected a lowered forall"); + }; + assert_eq!(variables.len(), 1); + assert_eq!(variables[0].name.text, "a"); + assert!(variables[0].kind.is_none()); + assert!(matches!(&body.kind, TypeKind::Name(name) if name.text == "a")); + assert_eq!(body.span, TextRange::new(10, 13)); +} + +fn cst_expr(kind: CstExprKind, start: u32, end: u32) -> cst::Expr { + cst::Expr { + kind, + span: TextRange::new(start, end), + } +} diff --git a/crates/psrs-ast/src/tests/where_blocks.rs b/crates/psrs-ast/src/tests/where_blocks.rs new file mode 100644 index 00000000..54771ed9 --- /dev/null +++ b/crates/psrs-ast/src/tests/where_blocks.rs @@ -0,0 +1,104 @@ +use super::*; + +fn declaration_block( + declarations: Vec, + start: u32, + end: u32, +) -> cst::DeclarationBlock { + cst::DeclarationBlock { + where_keyword_span: TextRange::new(start, start + 5), + layout_start_span: TextRange::empty(start + 5), + declarations, + layout_end_span: TextRange::empty(end), + span: TextRange::new(start, end), + } +} + +#[test] +fn lowers_a_value_where_block_to_a_let_inside_the_parameters() { + let binding = value_declaration( + "y", + 40, + Vec::new(), + TextRange::new(42, 43), + cst_expr(CstExprKind::Integer("1".into()), 44, 45), + 45, + None, + ); + let declaration = CstDeclaration::Value(ValueDeclaration { + name: name("f", 30), + parameters: vec![pattern_var("x", 32)], + rhs: ValueRhs::Plain { + equals_span: TextRange::new(34, 35), + value: cst_expr(CstExprKind::Name(name("y", 36)), 36, 37), + }, + where_block: Some(declaration_block(vec![binding], 38, 50)), + span: TextRange::new(30, 50), + annotation: None, + }); + let module = lower_module(cst_module(declaration)).unwrap(); + let ExprKind::Lambda { binder, body } = &module.declarations[0].value.kind else { + panic!("expected the parameter lambda"); + }; + assert_eq!(binder.name, "x"); + let ExprKind::Let { declarations, body } = &body.kind else { + panic!("expected the where declarations as a let inside the parameter"); + }; + assert_eq!(declarations.len(), 1); + assert_eq!(declarations[0].name.text, "y"); + assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "y")); +} + +#[test] +fn lowers_a_case_where_block_to_a_let_in_the_branch() { + let binding = value_declaration( + "y", + 40, + Vec::new(), + TextRange::new(42, 43), + cst_expr(CstExprKind::Name(name("x", 44)), 44, 45), + 45, + None, + ); + let alternative = cst::CaseAlternative { + patterns: vec![pattern_var("x", 33)], + rhs: cst::CaseRhs::Plain { + arrow_span: TextRange::new(35, 37), + value: cst_expr(CstExprKind::Name(name("y", 38)), 38, 39), + where_block: Some(declaration_block(vec![binding], 40, 50)), + }, + span: TextRange::new(33, 50), + }; + let case = cst_expr( + CstExprKind::Case { + case_keyword_span: TextRange::new(20, 24), + scrutinees: vec![cst_expr(CstExprKind::Name(name("value", 25)), 25, 30)], + of_keyword_span: TextRange::new(31, 33), + layout_start_span: TextRange::empty(33), + alternatives: vec![alternative], + layout_end_span: TextRange::empty(50), + }, + 20, + 50, + ); + let declaration = value_declaration( + "main", + 18, + Vec::new(), + TextRange::new(24, 25), + case, + 50, + None, + ); + let module = lower_module(cst_module(declaration)).unwrap(); + let ExprKind::Case { branches, .. } = &module.declarations[0].value.kind else { + panic!("expected a case expression"); + }; + assert_eq!(branches.len(), 1); + let ExprKind::Let { declarations, body } = &branches[0].value.kind else { + panic!("expected the where declarations as a let around the branch body"); + }; + assert_eq!(declarations.len(), 1); + assert_eq!(declarations[0].name.text, "y"); + assert!(matches!(&body.kind, ExprKind::Name(name) if name.text == "y")); +} diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index 90579056..9df377ac 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -42,9 +42,31 @@ fn layout_for(module: &Module) -> TypeLayout { type_layout(module, &enums, &aggregates, &newtypes).expect("layout should succeed") } +/// Roots aggregate types through declarations so the layout builder treats +/// them as live. The production builder only lays out types reachable from a +/// declaration or a constructor field, so a fixture with neither has no +/// arrays or records to normalize. +fn root_types(module: &mut Module, roots: impl IntoIterator) { + for (index, ty) in roots.into_iter().enumerate() { + module.declarations.push(Declaration { + symbol: SymbolId::new(module.id, index as u32), + name: format!("root{index}"), + name_span: psrs_span::TextRange::new(0, 1), + quantified: Vec::new(), + ty, + value: Expr { + kind: ExprKind::Unit, + ty, + span: psrs_span::TextRange::new(0, 1), + }, + span: psrs_span::TextRange::new(0, 1), + }); + } +} + #[test] fn canonical_arrays_key_by_element_shape() { - let module = empty_module(vec![ + let mut module = empty_module(vec![ Type::Variable(TypeVariableId(0)), Type::Constructor(TypeConstructor::Array), Type::Application(TypeId(1), TypeId(0)), @@ -52,6 +74,8 @@ fn canonical_arrays_key_by_element_shape() { Type::Application(TypeId(1), TypeId(3)), Type::Application(TypeId(1), TypeId(2)), ]); + // `Array Int` and `Array (Array a)` reach every element shape under test. + root_types(&mut module, [TypeId(4), TypeId(5)]); let layout = layout_for(&module); let generic = layout.array_types[&TypeId(2)]; let concrete = layout.array_types[&TypeId(4)]; @@ -85,11 +109,13 @@ fn canonical_arrays_key_by_element_shape() { #[test] fn recursive_aggregate_normalization_terminates() { - let module = empty_module(vec![ + let mut module = empty_module(vec![ Type::Application(TypeId(2), TypeId(1)), Type::Application(TypeId(2), TypeId(0)), Type::Constructor(TypeConstructor::Array), ]); + // The two mutually recursive arrays are unreachable without a root. + root_types(&mut module, [TypeId(0)]); let layout = layout_for(&module); let first = layout.array_types[&TypeId(0)]; let second = layout.array_types[&TypeId(1)]; @@ -431,7 +457,7 @@ fn an_opaque_handle_and_an_array_of_handles_have_scalar_layouts() { let opaque = HirTypeId::new(module_id, 0); let handle = TypeId(0); let array_handle = TypeId(2); - let module = Module { + let mut module = Module { type_names: Vec::new(), id: module_id, name: "OpaqueHandleLayoutTest".into(), @@ -450,6 +476,7 @@ fn an_opaque_handle_and_an_array_of_handles_have_scalar_layouts() { entry: None, span: psrs_span::TextRange::new(0, 40), }; + root_types(&mut module, [array_handle]); let newtypes = HashSet::new(); let enums = enum_type_ids(&module, &newtypes); let aggregates = aggregate_type_ids(&module, &newtypes); diff --git a/crates/psrs-backend/src/cc/layout/tests/records.rs b/crates/psrs-backend/src/cc/layout/tests/records.rs index 436dbfe1..f83b682f 100644 --- a/crates/psrs-backend/src/cc/layout/tests/records.rs +++ b/crates/psrs-backend/src/cc/layout/tests/records.rs @@ -170,7 +170,8 @@ fn canonical_record_keys_sort_labels_and_share_equal_keyed_records() { ]; let first_record = push_record(&mut types, vec![("x", TypeId(0)), ("y", TypeId(1))]); let second_record = push_record(&mut types, vec![("y", TypeId(1)), ("x", TypeId(0))]); - let module = empty_module(types); + let mut module = empty_module(types); + root_types(&mut module, [first_record, second_record]); let layout = layout_for(&module); let first = layout.record_types[&first_record]; let second = layout.record_types[&second_record]; diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs similarity index 89% rename from crates/psrs-typecheck/src/typecheck/classes/fundeps.rs rename to crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs index 743c64b1..49baf38e 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs @@ -1,6 +1,9 @@ use super::super::unify::substitute; use super::super::*; use std::collections::HashMap; +mod support; + +use support::solution_uses_lexical_given; /// Functional-dependency improvement and ambiguity checking for wanted /// constraints. Improvement assigns only the positions a dependency determines @@ -408,73 +411,6 @@ impl Checker { } } -fn solution_uses_lexical_given( - solution: &WantedSolution, - solutions: &HashMap, - visited: &mut HashSet, -) -> bool { - match solution { - WantedSolution::Given(_) => true, - WantedSolution::Superclass { parent, .. } => parent - .solution - .as_ref() - .is_some_and(|solution| solution_uses_lexical_given(solution, solutions, visited)), - WantedSolution::Instance { context, .. } => context.iter().any(|id| { - if !visited.insert(*id) { - return false; - } - let uses_given = solutions - .get(id) - .is_some_and(|solution| solution_uses_lexical_given(solution, solutions, visited)); - visited.remove(id); - uses_given - }), - // An abstracted dictionary is a parameter of the declaration itself, so - // it determines nothing the result type and the dependencies do not. - WantedSolution::Global(_) - | WantedSolution::Abstracted(_) - | WantedSolution::Coercible { .. } - | WantedSolution::Primitive { .. } => false, - } -} - -#[cfg(test)] -mod tests { - use super::*; - use psrs_hir::{LocalId, ModuleId, SymbolId}; - - #[test] - fn instance_context_using_a_given_determines_its_rank_n_wanted() { - let selected = WantedSolution::Instance { - constructor: SymbolId::new(ModuleId(0), 1), - constructor_type: InferType::Variable(0), - context: vec![7], - }; - let solutions = HashMap::from([(7, WantedSolution::Given(LocalId(2)))]); - - assert!(solution_uses_lexical_given( - &selected, - &solutions, - &mut HashSet::new() - )); - } - - #[test] - fn context_free_instance_does_not_determine_its_wanted_variables() { - let selected = WantedSolution::Instance { - constructor: SymbolId::new(ModuleId(0), 1), - constructor_type: InferType::Variable(0), - context: Vec::new(), - }; - - assert!(!solution_uses_lexical_given( - &selected, - &HashMap::new(), - &mut HashSet::new() - )); - } -} - /// The inference variables used anywhere in a type. pub(in crate::typecheck) fn collect_infer_variables(ty: &InferType, out: &mut HashSet) { match ty { diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs new file mode 100644 index 00000000..4e04fd1a --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs @@ -0,0 +1,68 @@ +use super::*; + +pub(super) fn solution_uses_lexical_given( + solution: &WantedSolution, + solutions: &HashMap, + visited: &mut HashSet, +) -> bool { + match solution { + WantedSolution::Given(_) => true, + WantedSolution::Superclass { parent, .. } => parent + .solution + .as_ref() + .is_some_and(|solution| solution_uses_lexical_given(solution, solutions, visited)), + WantedSolution::Instance { context, .. } => context.iter().any(|id| { + if !visited.insert(*id) { + return false; + } + let uses_given = solutions + .get(id) + .is_some_and(|solution| solution_uses_lexical_given(solution, solutions, visited)); + visited.remove(id); + uses_given + }), + // An abstracted dictionary is a parameter of the declaration itself, so + // it determines nothing the result type and the dependencies do not. + WantedSolution::Global(_) + | WantedSolution::Abstracted(_) + | WantedSolution::Coercible { .. } + | WantedSolution::Primitive { .. } => false, + } +} + +#[cfg(test)] +mod tests { + use super::*; + use psrs_hir::{LocalId, ModuleId, SymbolId}; + + #[test] + fn instance_context_using_a_given_determines_its_rank_n_wanted() { + let selected = WantedSolution::Instance { + constructor: SymbolId::new(ModuleId(0), 1), + constructor_type: InferType::Variable(0), + context: vec![7], + }; + let solutions = HashMap::from([(7, WantedSolution::Given(LocalId(2)))]); + + assert!(solution_uses_lexical_given( + &selected, + &solutions, + &mut HashSet::new() + )); + } + + #[test] + fn context_free_instance_does_not_determine_its_wanted_variables() { + let selected = WantedSolution::Instance { + constructor: SymbolId::new(ModuleId(0), 1), + constructor_type: InferType::Variable(0), + context: Vec::new(), + }; + + assert!(!solution_uses_lexical_given( + &selected, + &HashMap::new(), + &mut HashSet::new() + )); + } +} From 529de8e1481f4faed1d7cde69fb955ece0eceb98 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 16:45:14 +0800 Subject: [PATCH 008/148] Transport abstract constructor protocols through checked instantiation An abstract constructor application (`f a`, including `f Unit`) lowers to an erased value whose stored calling convention is established by its producer. Recovering it at a concrete consumer needs that convention; the previous code cast the erased closure directly onto the consumer signature, which trapped when a dictionary method produced a closure under its own protocol (`wasm trap: cast failure`). Add read-only checked instantiation evidence (`psrs-core`), a shared conversion planner that recovers the producer protocol and emits an explicit adapter when it differs from the consumer (`cc/lower/conversion`), and thread the evidence to each boundary (global use, direct call, dictionary field, erased local use). The Effect representation owner contributes its runtime token as the `Effect` constructor protocol. A reference cast is no longer used as an adapter, and a missing constructor binding is a source-spanned unsupported conversion rather than a fresh guess. Value-sensitive Wasmtime execution now covers the non-Effect Reader dictionary, Effect discard, delayed map, and a fixed `f Unit` payload, plus signature inspection of the generated adapter and factory. Ordinary closure and aggregate regressions are re-run through the workspace suite. PE-13 and EF-14 are recorded as verified in the acceptance documents. --- README.md | 9 +- .../src/cc/case/decision/realize/tests/mod.rs | 3 + .../decision/realize/tests/nested_tests.rs | 3 + .../decision/realize/tests/newtype_tests.rs | 3 + .../tests/parameterized_tests/support.rs | 3 + .../decision/realize/tests/product_tests.rs | 3 + .../decision/realize/tests/record_tests.rs | 3 + .../src/cc/layout/functions/mod.rs | 34 +++ crates/psrs-backend/src/cc/layout/mod.rs | 2 + .../src/cc/lower/call/application.rs | 15 +- .../src/cc/lower/conversion/callable.rs | 215 ++++++++++++++ .../src/cc/lower/conversion/mod.rs | 69 +++-- .../src/cc/lower/conversion/scalars.rs | 83 ++++++ .../src/cc/lower/conversion/tests.rs | 8 +- .../src/cc/lower/conversion/transport.rs | 130 +++++++++ .../src/cc/lower/erased/conversion.rs | 2 + .../src/cc/lower/erased/curried.rs | 7 +- .../psrs-backend/src/cc/lower/erased/eta.rs | 7 +- .../psrs-backend/src/cc/lower/erased/mod.rs | 34 ++- crates/psrs-backend/src/cc/lower/global.rs | 27 +- .../src/cc/lower/instantiation.rs | 42 +++ .../psrs-backend/src/cc/lower/lambda/mod.rs | 3 + crates/psrs-backend/src/cc/lower/mod.rs | 15 + .../psrs-backend/src/cc/lower/record/mod.rs | 13 +- crates/psrs-backend/src/cc/mod.rs | 19 +- crates/psrs-backend/src/effects/mod.rs | 45 ++- crates/psrs-backend/src/lib.rs | 8 +- crates/psrs-backend/src/pipeline/mod.rs | 24 +- crates/psrs-core/src/instantiation.rs | 49 ++++ crates/psrs-core/src/lib.rs | 26 +- crates/psrs-core/src/tests/instantiation.rs | 168 +++++++++++ crates/psrs-core/src/tests/mod.rs | 1 + crates/psrs-core/src/verify/expr/entry.rs | 3 + crates/psrs-core/src/verify/expr/mod.rs | 67 +++-- crates/psrs-core/src/verify/mod.rs | 4 +- .../src/verify/types/matching/evidence.rs | 27 ++ .../src/verify/types/matching/invariant.rs | 169 +++++++++++ .../src/verify/types/matching/mod.rs | 275 +++--------------- crates/psrs-core/src/verify/types/mod.rs | 1 + .../psrs-driver/src/tests/closure_protocol.rs | 133 +++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-resolve/src/resolver/operators.rs | 4 +- docs/design/D-04-suite-roadmap.md | 35 ++- docs/design/backend/fp/effects.md | 27 +- .../backend/fp/generic-aggregate-erasure.md | 8 + .../backend/fp/polymorphism-and-erasure.md | 176 +++++++++-- docs/implementation/backend/effects.md | 40 +++ .../backend/polymorphism-and-erasure.md | 229 +++++++++++++++ 48 files changed, 1908 insertions(+), 364 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/conversion/callable.rs create mode 100644 crates/psrs-backend/src/cc/lower/conversion/scalars.rs create mode 100644 crates/psrs-backend/src/cc/lower/conversion/transport.rs create mode 100644 crates/psrs-backend/src/cc/lower/instantiation.rs create mode 100644 crates/psrs-core/src/instantiation.rs create mode 100644 crates/psrs-core/src/tests/instantiation.rs create mode 100644 crates/psrs-core/src/verify/types/matching/evidence.rs create mode 100644 crates/psrs-core/src/verify/types/matching/invariant.rs create mode 100644 crates/psrs-driver/src/tests/closure_protocol.rs diff --git a/README.md b/README.md index a53b0afa..8ba9f289 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ what remains in each layer. | L3 kinds | 39/48 failing | official kind `errorCode`s | | L4 types | 39/50 failing | official `errorCode`s | | L5 classes | 58/81 failing | official `errorCode`s | -| L6/M7 runtime | 164/413 passing | all 164 exit 0; 249 do not agree, including 46 with no selected `main` | +| L6/M7 runtime | 207/413 passing | all 207 exit 0; 206 do not agree, including 47 with no selected `main` | | M8 warnings, optimization | not measured | no scoreboard exists | Run the scoreboards yourself: @@ -114,8 +114,11 @@ Verified working subsets, each with source tests and Wasmtime execution: scalar, string, list, flags, handle, and variant shapes ([canonical ABI](docs/design/backend/wasm/canonical-abi-and-wit.md)), and the synthesized aggregate fixtures validate but do not yet execute; -- **the standard library** — `stdlib/lib` holds 12 modules, and 244 corpus - programs import a module it does not provide. +- **the standard library** — `stdlib/lib` holds the vendored `v0.15.16` core + libraries (211 modules). A module the compiler owns, such as `Safe.Coerce`, + resolves through its primitive interface rather than the vendored file, which + stays faithful to upstream; `Unsafe.Coerce.unsafeCoerce` has no interface yet + and is a recorded gap. ## Workspace diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs index 06a58810..7f017744 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs @@ -135,7 +135,10 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { locals: HashMap::new(), signatures: &signatures, representations: &representations, + transport_signatures: &HashMap::new(), module: &module, + source: &module, + constructor_protocols: &HashMap::new(), enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs index 244f3d7b..2998695e 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs @@ -184,7 +184,10 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta locals: HashMap::new(), signatures: &signatures, representations: &representations, + transport_signatures: &HashMap::new(), module: &module, + source: &module, + constructor_protocols: &HashMap::new(), enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs index 1cb615b9..66333930 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs @@ -124,7 +124,10 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { locals: HashMap::new(), signatures: &signatures, representations: &representations, + transport_signatures: &HashMap::new(), module: &module, + source: &module, + constructor_protocols: &HashMap::new(), enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs index 3bcaf406..f78620f4 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs @@ -52,7 +52,10 @@ pub(super) fn lower_and_verify( locals: HashMap::new(), signatures: &signatures, representations: context.representations, + transport_signatures: &HashMap::new(), module, + source: module, + constructor_protocols: &HashMap::new(), enum_types: context.enum_types, aggregate_types: context.aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs index 5636f8a8..4c6ab3e8 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs @@ -120,7 +120,10 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { locals: HashMap::new(), signatures: &signatures, representations: &representations, + transport_signatures: &HashMap::new(), module: &module, + source: &module, + constructor_protocols: &HashMap::new(), enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs index 1970b478..d21073b4 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs @@ -144,7 +144,10 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { locals: HashMap::new(), signatures: &signatures, representations: &representations, + transport_signatures: &HashMap::new(), module: &module, + source: &module, + constructor_protocols: &HashMap::new(), enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index 49c89225..fee341bc 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -99,6 +99,40 @@ pub(super) struct FunctionLayouts { pub(super) function_types: HashMap, } +/// Registers physical callable-constructor protocols. A checked constructor +/// binding determines the fixed parameter prefix; the varying payload uses the +/// erased result protocol. These are representation-only signatures. +pub(super) fn transport_signatures( + representations: &mut RepresentationTable, +) -> HashMap, SignatureId> { + let mut interned = representations + .signatures + .iter() + .cloned() + .enumerate() + .map(|(index, signature)| (signature, SignatureId(index as u32))) + .collect::>(); + let signatures = representations.signatures.clone(); + let mut protocols = HashMap::new(); + for signature in signatures { + for count in 0..=signature.parameters.len() { + let parameters = signature.parameters[..count].to_vec(); + let protocol = Signature { + parameters: parameters.clone(), + result: ValueShape::Reference(crate::cc::Reference { + nullable: false, + heap: RefShape::Erased, + }), + }; + let id = *interned + .entry(protocol.clone()) + .or_insert_with(|| representations.add_signature(protocol)); + protocols.insert(parameters, id); + } + } + protocols +} + #[allow(clippy::too_many_arguments)] pub(crate) fn function_signature( module: &CoreModule, diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 629eb951..c1da5258 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -288,6 +288,7 @@ pub(super) fn type_layout( } Ok(TypeLayout { + transport_signatures: functions::transport_signatures(&mut representations), representations, array_types, record_types, @@ -299,6 +300,7 @@ pub(super) fn type_layout( } pub(super) struct TypeLayout { + pub(super) transport_signatures: HashMap, SignatureId>, pub(super) representations: RepresentationTable, pub(super) array_types: HashMap, pub(super) record_types: HashMap, diff --git a/crates/psrs-backend/src/cc/lower/call/application.rs b/crates/psrs-backend/src/cc/lower/call/application.rs index 0a323cd6..ce995c0d 100644 --- a/crates/psrs-backend/src/cc/lower/call/application.rs +++ b/crates/psrs-backend/src/cc/lower/call/application.rs @@ -54,6 +54,15 @@ impl ApplicationLowering for FunctionLowerer<'_> { assignments, ); } + let declaration = self + .module + .declarations + .iter() + .find(|declaration| declaration.symbol == function); + let evidence = declaration.and_then(|declaration| { + self.source + .checked_instantiation(declaration.ty, &declaration.quantified, head.ty) + }); self.check_call_shape( &signature, arguments.len(), @@ -73,12 +82,13 @@ impl ApplicationLowering for FunctionLowerer<'_> { )] })?; let source_shape = self.value_shape(argument.ty, argument.span)?; - let conversion = self.typed_conversion( + let conversion = self.typed_conversion_with_instantiation( argument.ty, source_type, source_shape, *expected, expression.span, + evidence.as_ref(), )?; conversions.push((source_shape, conversion)); } @@ -132,12 +142,13 @@ impl ApplicationLowering for FunctionLowerer<'_> { "call target has no declaration result type", )] })?; - let conversion = self.typed_conversion( + let conversion = self.typed_conversion_with_instantiation( source_type, expression.ty, signature.result, result_type, expression.span, + evidence.as_ref(), )?; Ok(self.emit_conversion( call_result, diff --git a/crates/psrs-backend/src/cc/lower/conversion/callable.rs b/crates/psrs-backend/src/cc/lower/conversion/callable.rs new file mode 100644 index 00000000..d613afff --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/conversion/callable.rs @@ -0,0 +1,215 @@ +//! Emission of callable plans with representation-only endpoints. + +use super::super::{FunctionLowerer, LambdaLowering}; +use crate::BackendError; +use crate::cc::{ + Assignment, AssignmentKind, Function, RefShape, Reference, SignatureId, ValueConversion, + ValueShape, +}; +use psrs_span::TextRange; + +fn closure(signature: SignatureId) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(signature), + }) +} + +impl FunctionLowerer<'_> { + /// Emits a completed callable plan. No source matching occurs here: the + /// two signatures and recursive argument/result plans are already fixed. + pub(super) fn physical_callable_plan( + &mut self, + source: SignatureId, + target: SignatureId, + arguments: Vec, + result_plan: ValueConversion, + span: TextRange, + ) -> Result> { + if source == target + && arguments + .iter() + .all(|plan| matches!(plan, ValueConversion::Identity)) + && matches!(result_plan, ValueConversion::Identity) + { + return Ok(ValueConversion::Identity); + } + let source_shape = self + .representations + .signature(source) + .cloned() + .ok_or_else(|| { + super::conversion_error(span, "callable plan has no producer signature") + })?; + let target_shape = self + .representations + .signature(target) + .cloned() + .ok_or_else(|| { + super::conversion_error(span, "callable plan has no consumer signature") + })?; + if source_shape.parameters.len() != target_shape.parameters.len() + || arguments.len() != target_shape.parameters.len() + { + return Err(super::conversion_error( + span, + "callable plan has incompatible parameter counts", + )); + } + let mut body = self.child_lowerer(); + let receiver = body.fresh(ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Aggregate, + })); + let mut parameters = vec![receiver]; + let inputs = target_shape + .parameters + .iter() + .map(|shape| body.fresh(*shape)) + .collect::>(); + parameters.extend(inputs.iter().copied()); + let mut values = Vec::new(); + let mut assignments = Vec::new(); + let captured = body.fresh(super::erased_shape()); + assignments.push(Assignment { + destination: captured, + kind: AssignmentKind::ClosureGetCapture { + closure: receiver, + index: 0, + }, + span, + }); + let producer = body.fresh(closure(source)); + assignments.push(Assignment { + destination: producer, + kind: AssignmentKind::RepresentationCast { + destination: producer, + value: captured, + reference: Reference { + nullable: false, + heap: RefShape::Closure(source), + }, + }, + span, + }); + // Preserve references across recursive plans that can allocate loops. + let (producer, producer_shape) = super::super::call::persist_reference( + &mut body, + producer, + closure(source), + span, + &mut assignments, + ); + for (index, plan) in arguments.into_iter().enumerate() { + let parameter = inputs[index]; + let value = body.emit_conversion( + parameter, + target_shape.parameters[index], + source_shape.parameters[index], + plan, + span, + &mut assignments, + ); + values.push(super::super::call::persist_reference( + &mut body, + value, + source_shape.parameters[index], + span, + &mut assignments, + )); + } + let producer = match producer_shape { + Some(shape) => super::super::call::restore_reference( + &mut body, + producer, + shape, + span, + &mut assignments, + ), + None => producer, + }; + let values = values + .into_iter() + .map(|(value, shape)| match shape { + Some(shape) => super::super::call::restore_reference( + &mut body, + value, + shape, + span, + &mut assignments, + ), + None => value, + }) + .collect(); + let value = body.fresh(source_shape.result); + assignments.push(Assignment { + destination: value, + kind: AssignmentKind::IndirectCall { + function: producer, + signature: source, + arguments: values, + }, + span, + }); + let result = body.emit_conversion( + value, + source_shape.result, + target_shape.result, + result_plan, + span, + &mut assignments, + ); + let body_symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let function = Function { + symbol: body_symbol, + name: format!("protocol_adapter_{}", span.start), + parameters, + values: body.values, + assignments, + result, + result_type: target_shape.result, + span, + }; + super::super::super::verify::verify_function( + &function, + self.signatures, + self.representations, + )?; + self.generated.extend(body.generated); + self.generated.push(function); + + let mut factory = self.child_lowerer(); + let input = factory.fresh(closure(source)); + let output = factory.fresh(closure(target)); + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let function = Function { + symbol, + name: format!("protocol_adapter_factory_{}", span.start), + parameters: vec![input], + values: factory.values, + assignments: vec![Assignment { + destination: output, + kind: AssignmentKind::FunctionRef { + function: body_symbol, + signature: target, + captures: vec![input], + }, + span, + }], + result: output, + result_type: closure(target), + span, + }; + super::super::super::verify::verify_function( + &function, + self.signatures, + self.representations, + )?; + self.generated.push(function); + Ok(ValueConversion::FunctionAdapter { + function: symbol, + source: closure(source), + destination: closure(target), + }) + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/mod.rs b/crates/psrs-backend/src/cc/lower/conversion/mod.rs index 64ef4c90..0aee4d4e 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/mod.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/mod.rs @@ -11,6 +11,10 @@ use crate::BackendError; use psrs_core::TypeId; use psrs_span::TextRange; +mod callable; +mod scalars; +mod transport; + pub(in crate::cc) struct VariantFieldConversion { pub(in crate::cc) variant: ReprId, pub(in crate::cc) tag: u32, @@ -48,6 +52,25 @@ impl FunctionLowerer<'_> { source_shape: ValueShape, destination_shape: ValueShape, span: TextRange, + ) -> Result> { + self.typed_conversion_with_instantiation( + source_type, + destination_type, + source_shape, + destination_shape, + span, + None, + ) + } + + pub(in crate::cc::lower) fn typed_conversion_with_instantiation( + &mut self, + source_type: TypeId, + destination_type: TypeId, + source_shape: ValueShape, + destination_shape: ValueShape, + span: TextRange, + instantiation: Option<&psrs_core::Instantiation<'_>>, ) -> Result> { self.plan_conversion( source_type, @@ -55,6 +78,7 @@ impl FunctionLowerer<'_> { source_shape, destination_shape, span, + instantiation, ) } @@ -65,7 +89,18 @@ impl FunctionLowerer<'_> { source_shape: ValueShape, destination_shape: ValueShape, span: TextRange, + instantiation: Option<&psrs_core::Instantiation<'_>>, ) -> Result> { + if let Some(plan) = self.constructor_transport( + source_type, + destination_type, + source_shape, + destination_shape, + span, + instantiation, + )? { + return Ok(plan); + } if source_shape == destination_shape { return Ok(ValueConversion::Identity); } @@ -90,6 +125,7 @@ impl FunctionLowerer<'_> { source_shape, destination_shape, span, + instantiation, ); } if is_abstract_type(self.module, destination_type) { @@ -185,6 +221,7 @@ impl FunctionLowerer<'_> { source_element_shape, destination_element_shape, span, + instantiation, )?; return Ok(ValueConversion::ArrayMap { source: source_repr, @@ -247,6 +284,7 @@ impl FunctionLowerer<'_> { self.value_shape(source_field, span)?, self.value_shape(destination_field, span)?, span, + instantiation, )?); } return Ok(ValueConversion::ProductMap { @@ -283,36 +321,6 @@ impl FunctionLowerer<'_> { Ok(ty) } - fn box_plan( - &self, - kind: BoxKind, - representation: Option, - span: TextRange, - ) -> Result> { - representation - .map(|representation| ValueConversion::BoxScalar { - kind, - representation, - }) - .ok_or_else(|| conversion_error(span, "erased scalar has no box representation")) - } - - fn unbox_plan( - &self, - kind: BoxKind, - representation: Option, - destination: ValueShape, - span: TextRange, - ) -> Result> { - representation - .map(|representation| ValueConversion::UnboxScalar { - kind, - representation, - destination, - }) - .ok_or_else(|| conversion_error(span, "erased scalar has no box representation")) - } - pub(in crate::cc) fn emit_conversion( &mut self, value: ValueId, @@ -385,6 +393,7 @@ impl FunctionLowerer<'_> { template_shape, target_shape, span, + None, ) } } diff --git a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs new file mode 100644 index 00000000..62c07ad2 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs @@ -0,0 +1,83 @@ +use super::super::FunctionLowerer; +use super::{conversion_error, erased_shape, sequence}; +use crate::{ + BackendError, + cc::{BoxKind, RecoveryEvidence, ReprId, ValueConversion, ValueShape}, +}; +use psrs_span::TextRange; + +impl FunctionLowerer<'_> { + pub(super) fn erase_payload( + &self, + shape: ValueShape, + span: TextRange, + ) -> Result> { + if shape == erased_shape() { + return Ok(ValueConversion::Identity); + } + let boxed = match shape { + ValueShape::Integer | ValueShape::Boolean => { + self.box_plan(BoxKind::Integer, self.boxed_integer_type, span)? + } + ValueShape::Number => self.box_plan(BoxKind::Number, self.boxed_number_type, span)?, + ValueShape::String | ValueShape::Reference(_) => { + return Ok(ValueConversion::EraseReference); + } + }; + Ok(sequence(vec![boxed, ValueConversion::EraseReference])) + } + + pub(super) fn recover_payload( + &self, + shape: ValueShape, + span: TextRange, + ) -> Result> { + if shape == erased_shape() { + return Ok(ValueConversion::Identity); + } + match shape { + ValueShape::Integer | ValueShape::Boolean => { + self.unbox_plan(BoxKind::Integer, self.boxed_integer_type, shape, span) + } + ValueShape::Number => { + self.unbox_plan(BoxKind::Number, self.boxed_number_type, shape, span) + } + ValueShape::String | ValueShape::Reference(_) => { + Ok(ValueConversion::RecoverReference { + destination: shape, + evidence: RecoveryEvidence::TypeInstantiation, + }) + } + } + } + + pub(super) fn box_plan( + &self, + kind: BoxKind, + representation: Option, + span: TextRange, + ) -> Result> { + representation + .map(|representation| ValueConversion::BoxScalar { + kind, + representation, + }) + .ok_or_else(|| conversion_error(span, "erased scalar has no box representation")) + } + + pub(super) fn unbox_plan( + &self, + kind: BoxKind, + representation: Option, + destination: ValueShape, + span: TextRange, + ) -> Result> { + representation + .map(|representation| ValueConversion::UnboxScalar { + kind, + representation, + destination, + }) + .ok_or_else(|| conversion_error(span, "erased scalar has no box representation")) + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/tests.rs b/crates/psrs-backend/src/cc/lower/conversion/tests.rs index d13c233d..73ede8cc 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/tests.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/tests.rs @@ -42,7 +42,10 @@ fn unsupported_typed_boundary_reports_its_source_span() { locals: HashMap::new(), signatures: &signatures, representations: &representations, + transport_signatures: &HashMap::new(), module: &module, + source: &module, + constructor_protocols: &HashMap::new(), enum_types: &ids, aggregate_types: &ids, newtype_ids: &ids, @@ -69,6 +72,7 @@ fn unsupported_typed_boundary_reports_its_source_span() { ValueShape::Integer, ValueShape::Number, span, + None, ) .unwrap_err(); assert!( @@ -90,12 +94,12 @@ fn unsupported_typed_boundary_reports_its_source_span() { heap: RefShape::Repr(ReprId(3)), }); assert!(matches!( - lowerer.plan_conversion(TypeId(0), TypeId(1), aggregate, representation, span), + lowerer.plan_conversion(TypeId(0), TypeId(1), aggregate, representation, span, None), Ok(ValueConversion::RecoverReference { .. }) )); assert!(matches!( lowerer - .plan_conversion(TypeId(0), TypeId(1), representation, aggregate, span) + .plan_conversion(TypeId(0), TypeId(1), representation, aggregate, span, None) .expect("a representation should recover its aggregate supertype"), ValueConversion::RecoverReference { .. } )); diff --git a/crates/psrs-backend/src/cc/lower/conversion/transport.rs b/crates/psrs-backend/src/cc/lower/conversion/transport.rs new file mode 100644 index 00000000..d0bbbd62 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/conversion/transport.rs @@ -0,0 +1,130 @@ +//! Constructor transport at checked generic boundaries. + +use super::super::FunctionLowerer; +use super::{conversion_error, sequence}; +use crate::{ + BackendError, + cc::{RecoveryEvidence, RefShape, Reference, ValueConversion, ValueShape}, +}; +use psrs_core::{Instantiation, Type, TypeConstructor, TypeId}; +use psrs_span::TextRange; + +fn abstract_head(module: &psrs_core::Module, ty: TypeId) -> Option { + let ty = super::super::super::layout::unquantified_type(module, ty); + let Type::Application(head, _) = module.types.get(ty.0 as usize)? else { + return None; + }; + let Type::Variable(variable) = module.types.get(head.0 as usize)? else { + return None; + }; + Some(*variable) +} + +fn callable(shape: ValueShape) -> Option { + match shape { + ValueShape::Reference(Reference { + heap: RefShape::Closure(id), + .. + }) => Some(id), + _ => None, + } +} + +impl FunctionLowerer<'_> { + pub(super) fn constructor_transport( + &mut self, + source: TypeId, + target: TypeId, + source_shape: ValueShape, + target_shape: ValueShape, + span: TextRange, + evidence: Option<&Instantiation<'_>>, + ) -> Result, Vec> { + let boundary = match ( + abstract_head(self.module, source), + abstract_head(self.module, target), + ) { + (Some(variable), None) if callable(target_shape).is_some() => (variable, false), + (None, Some(variable)) if callable(source_shape).is_some() => (variable, true), + _ => return Ok(None), + }; + let (variable, entering) = boundary; + let (constructor, arguments) = evidence.and_then(|proof| proof.constructor(variable)) + .ok_or_else(|| vec![BackendError::new("P8 closure conversion", span, + format!("abstract constructor transport has no checked constructor binding for {variable:?}, endpoints {source:?} -> {target:?}"))])?; + let parameter_types = self.protocol_parameters(constructor, arguments, span)?; + let parameters = parameter_types + .into_iter() + .map(|ty| self.value_shape(ty, span)) + .collect::, _>>()?; + let protocol = self + .transport_signatures + .get(¶meters) + .copied() + .ok_or_else(|| { + conversion_error(span, "constructor transport has no registered signature") + })?; + let concrete = callable(if entering { source_shape } else { target_shape }).unwrap(); + let signature = self.representations.signature(concrete).ok_or_else(|| { + conversion_error(span, "constructor transport has no concrete signature") + })?; + if signature.parameters != parameters { + return Err(conversion_error( + span, + "constructor transport requires a callable segment adapter", + )); + } + let payload = signature.result; + let protocol_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(protocol), + }); + let identity_arguments = vec![ValueConversion::Identity; parameters.len()]; + let plan = if entering { + let result = self.erase_payload(payload, span)?; + let adapter = + self.physical_callable_plan(concrete, protocol, identity_arguments, result, span)?; + sequence(vec![adapter, ValueConversion::EraseReference]) + } else { + let result = self.recover_payload(payload, span)?; + let adapter = + self.physical_callable_plan(protocol, concrete, identity_arguments, result, span)?; + sequence(vec![ + ValueConversion::RecoverReference { + destination: protocol_shape, + evidence: RecoveryEvidence::TypeInstantiation, + }, + adapter, + ]) + }; + Ok(Some(plan)) + } + + /// Fixed parameters of a constructor protocol. + /// + /// `Function` takes its checked instantiation arguments (the Reader domain). + /// A registered representation owner, such as Effect, supplies its own + /// hidden parameters (the runtime token) and does not read them off the + /// closure. An unregistered constructor is rejected. + fn protocol_parameters( + &self, + constructor: TypeConstructor, + arguments: Vec, + span: TextRange, + ) -> Result, Vec> { + match constructor { + TypeConstructor::Function if arguments.len() == 1 => Ok(arguments), + TypeConstructor::User(type_id) if arguments.is_empty() => self + .constructor_protocols + .get(&type_id) + .cloned() + .ok_or_else(|| { + conversion_error(span, "constructor transport has no representation protocol") + }), + _ => Err(conversion_error( + span, + "constructor transport has no callable representation contract", + )), + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/erased/conversion.rs b/crates/psrs-backend/src/cc/lower/erased/conversion.rs index b0693aff..2550cb00 100644 --- a/crates/psrs-backend/src/cc/lower/erased/conversion.rs +++ b/crates/psrs-backend/src/cc/lower/erased/conversion.rs @@ -14,6 +14,7 @@ impl FunctionLowerer<'_> { source: ValueShape, destination: ValueShape, span: TextRange, + instantiation: Option<&psrs_core::Instantiation<'_>>, ) -> Result> { let mut factory = self.child_lowerer(); let value = factory.fresh(source); @@ -24,6 +25,7 @@ impl FunctionLowerer<'_> { target_type, span, &mut assignments, + instantiation, )?; let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); let function = Function { diff --git a/crates/psrs-backend/src/cc/lower/erased/curried.rs b/crates/psrs-backend/src/cc/lower/erased/curried.rs index 945aa3b0..e392e57d 100644 --- a/crates/psrs-backend/src/cc/lower/erased/curried.rs +++ b/crates/psrs-backend/src/cc/lower/erased/curried.rs @@ -28,6 +28,7 @@ impl FunctionLowerer<'_> { target_shape: &Signature, span: psrs_span::TextRange, assignments: &mut Vec, + instantiation: Option<&psrs_core::Instantiation<'_>>, ) -> Result> { let prefix = target_shape.parameters.len(); let remaining_type = @@ -99,12 +100,13 @@ impl FunctionLowerer<'_> { }); let mut inner_captures = vec![source_closure]; for index in 0..prefix { - let conversion = outer.typed_conversion( + let conversion = outer.typed_conversion_with_instantiation( target_parameters[index], source_parameters[index], target_shape.parameters[index], source_shape.parameters[index], span, + instantiation, )?; let converted = outer.emit_conversion( target_arguments[index], @@ -186,12 +188,13 @@ impl FunctionLowerer<'_> { }, span, }); - let conversion = outer.typed_conversion( + let conversion = outer.typed_conversion_with_instantiation( remaining_type, function_arrow_parameters(self.module, target_type).1, closure_value_type_for(remaining_signature_id), target_shape.result, span, + instantiation, )?; let result = outer.emit_conversion( inner_closure_value, diff --git a/crates/psrs-backend/src/cc/lower/erased/eta.rs b/crates/psrs-backend/src/cc/lower/erased/eta.rs index 757f87ff..5a97e895 100644 --- a/crates/psrs-backend/src/cc/lower/erased/eta.rs +++ b/crates/psrs-backend/src/cc/lower/erased/eta.rs @@ -30,6 +30,7 @@ impl FunctionLowerer<'_> { target_shape: &Signature, span: psrs_span::TextRange, assignments: &mut Vec, + instantiation: Option<&psrs_core::Instantiation<'_>>, ) -> Result> { let source_arity = source_shape.parameters.len(); let source_parameters = function_arrow_parameters(self.module, source_type).0; @@ -79,12 +80,13 @@ impl FunctionLowerer<'_> { // signature consumes, converting each from the target representation. let mut concrete_arguments = Vec::with_capacity(source_arity); for index in 0..source_arity { - let conversion = adapter.typed_conversion( + let conversion = adapter.typed_conversion_with_instantiation( target_parameters[index], source_parameters[index], target_shape.parameters[index], source_shape.parameters[index], span, + instantiation, )?; let converted = adapter.emit_conversion( target_arguments[index], @@ -154,12 +156,13 @@ impl FunctionLowerer<'_> { }; let source_result_type = function_arrow_parameters(self.module, source_type).1; let remaining_closure = closure_value_type_for(remaining_signature_id); - let recover = adapter.typed_conversion( + let recover = adapter.typed_conversion_with_instantiation( source_result_type, remaining_type, source_shape.result, remaining_closure, span, + instantiation, )?; let recovered = adapter.emit_conversion( concrete_result, diff --git a/crates/psrs-backend/src/cc/lower/erased/mod.rs b/crates/psrs-backend/src/cc/lower/erased/mod.rs index 64b728ab..043aba5a 100644 --- a/crates/psrs-backend/src/cc/lower/erased/mod.rs +++ b/crates/psrs-backend/src/cc/lower/erased/mod.rs @@ -46,7 +46,20 @@ impl FunctionLowerer<'_> { if source_type == target_type || !is_function_type(self.module, target_type) { return Ok(value); } - self.adapt_erased_function_value(value, source_type, target_type, span, assignments) + let evidence = super::instantiation::instantiation_at( + self.source, + self.module, + source_type, + target_type, + ); + self.adapt_erased_function_value( + value, + source_type, + target_type, + span, + assignments, + evidence.as_ref(), + ) } fn value_shape_of(&self, value: ValueId) -> Option { @@ -63,6 +76,7 @@ impl FunctionLowerer<'_> { target_type: TypeId, span: psrs_span::TextRange, assignments: &mut Vec, + instantiation: Option<&psrs_core::Instantiation<'_>>, ) -> Result> { // A value that is not a function at its source type is an erased (or // concrete) value recovered at the target function type, such as a type @@ -74,8 +88,14 @@ impl FunctionLowerer<'_> { if source_shape == target_shape { return Ok(value); } - let conversion = - self.typed_conversion(source_type, target_type, source_shape, target_shape, span)?; + let conversion = self.typed_conversion_with_instantiation( + source_type, + target_type, + source_shape, + target_shape, + span, + instantiation, + )?; return Ok(self.emit_conversion( value, source_shape, @@ -147,6 +167,7 @@ impl FunctionLowerer<'_> { &target_shape, span, assignments, + instantiation, ); } // A concrete curried function (the `ado` block's `\x -> \y -> ...`) @@ -168,6 +189,7 @@ impl FunctionLowerer<'_> { &target_shape, span, assignments, + instantiation, ); } return Err(vec![BackendError::new( @@ -221,12 +243,13 @@ impl FunctionLowerer<'_> { for (index, argument) in adapter_arguments.into_iter().enumerate() { let source_parameter = source_shape.parameters[index]; let target_parameter = target_shape.parameters[index]; - let conversion = adapter.typed_conversion( + let conversion = adapter.typed_conversion_with_instantiation( target_parameters[index], source_parameters[index], target_parameter, source_parameter, span, + instantiation, )?; let converted = adapter.emit_conversion( argument, @@ -275,12 +298,13 @@ impl FunctionLowerer<'_> { }); let source_result_type = function_arrow_parameters(self.module, source_type).1; let target_result_type = function_arrow_parameters(self.module, target_type).1; - let conversion = adapter.typed_conversion( + let conversion = adapter.typed_conversion_with_instantiation( source_result_type, target_result_type, source_shape.result, target_shape.result, span, + instantiation, )?; let result = adapter.emit_conversion( concrete_result, diff --git a/crates/psrs-backend/src/cc/lower/global.rs b/crates/psrs-backend/src/cc/lower/global.rs index 1b2c13ed..4f079208 100644 --- a/crates/psrs-backend/src/cc/lower/global.rs +++ b/crates/psrs-backend/src/cc/lower/global.rs @@ -81,12 +81,27 @@ impl GlobalLowering for FunctionLowerer<'_> { if source_type == expression.ty { Ok(destination) } else { + let declaration = self + .module + .declarations + .iter() + .find(|declaration| declaration.symbol == function) + .expect("the source declaration was found above"); + // Evidence is required only if the adaptation reaches an + // abstract constructor boundary; `constructor_transport` + // reports the missing binding where the boundary applies. + let evidence = self.source.checked_instantiation( + source_type, + &declaration.quantified, + expression.ty, + ); self.adapt_erased_function_value( destination, source_type, expression.ty, expression.span, assignments, + evidence.as_ref(), ) } } else { @@ -109,21 +124,27 @@ impl GlobalLowering for FunctionLowerer<'_> { if source_shape == result_type { return Ok(destination); } - let source_type = self + let declaration = self .module .declarations .iter() .find(|declaration| declaration.symbol == function) - .map(|declaration| declaration.ty) .ok_or_else(|| { global_error(expression, "global value has no source declaration type") })?; - let conversion = self.typed_conversion( + let source_type = declaration.ty; + let evidence = self.source.checked_instantiation( + source_type, + &declaration.quantified, + expression.ty, + ); + let conversion = self.typed_conversion_with_instantiation( source_type, expression.ty, source_shape, result_type, expression.span, + evidence.as_ref(), )?; Ok(self.emit_conversion( destination, diff --git a/crates/psrs-backend/src/cc/lower/instantiation.rs b/crates/psrs-backend/src/cc/lower/instantiation.rs new file mode 100644 index 00000000..9390cfeb --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/instantiation.rs @@ -0,0 +1,42 @@ +//! Checked scheme/use evidence for representation conversion. +//! +//! The evidence borrows the module that owns the relation, not the lowerer, so +//! a later conversion can mutably borrow the lowerer. + +use psrs_core::{Instantiation, Module, TypeId}; +use psrs_hir::TypeVariableId; +use std::collections::HashSet; + +/// Checked scheme/use bindings. Leading quantifiers are pre-seeded so opening +/// them retains constructor replacements. Relations whose type ids still exist +/// use the immutable source module. +pub(in crate::cc::lower) fn instantiation_at<'a>( + source: &'a Module, + physical: &'a Module, + scheme: TypeId, + instance: TypeId, +) -> Option> { + let relation = + if (scheme.0 as usize) < source.types.len() && (instance.0 as usize) < source.types.len() { + source + } else { + physical + }; + let quantified = scheme_quantifiers(relation, scheme); + relation.checked_instantiation(scheme, &quantified, instance) +} + +/// Leading quantifiers of a scheme. Pre-seeding these keeps their constructor +/// bindings when instantiation opens the same quantifiers. +fn scheme_quantifiers(module: &Module, mut ty: TypeId) -> Vec { + let mut variables = Vec::new(); + let mut seen = HashSet::new(); + while let Some((bound, body)) = psrs_core::forall_parts(&module.types, ty) { + if !seen.insert(ty) { + break; + } + variables.extend(bound.iter().copied()); + ty = body; + } + variables +} diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index 6d09ad0f..071adea0 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -314,7 +314,10 @@ impl LambdaLowering for FunctionLowerer<'_> { locals: HashMap::new(), signatures: self.signatures, representations: self.representations, + transport_signatures: self.transport_signatures, module: self.module, + source: self.source, + constructor_protocols: self.constructor_protocols, enum_types: self.enum_types, aggregate_types: self.aggregate_types, newtype_ids: self.newtype_ids, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 9b564ddc..5e0d9caa 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -17,6 +17,7 @@ mod conversion; mod dictionary; mod erased; mod global; +pub(in crate::cc::lower) mod instantiation; mod intrinsic; mod lambda; mod letrec; @@ -34,8 +35,16 @@ pub(in crate::cc) use symbols::GeneratedSymbolAllocator; pub(super) struct LoweringContext<'a> { pub(super) module: &'a CoreModule, + /// Types used for checked instantiation. This is the physical module when + /// representation lowering has not rewritten any source type. + pub(super) source: &'a CoreModule, + /// Fixed calling-convention parameters registered by a representation + /// owner, keyed by the source constructor. `Function` is not in this map: + /// its fixed parameters are the checked instantiation arguments. + pub(super) constructor_protocols: &'a HashMap>, pub(super) signatures: &'a HashMap, pub(super) representations: &'a RepresentationTable, + pub(super) transport_signatures: &'a HashMap, SignatureId>, pub(super) enum_types: &'a HashSet, pub(super) aggregate_types: &'a HashSet, pub(super) newtype_ids: &'a HashSet, @@ -63,7 +72,10 @@ pub(super) fn lower_function( local_types: HashMap::new(), signatures: context.signatures, representations: context.representations, + transport_signatures: context.transport_signatures, module, + source: context.source, + constructor_protocols: context.constructor_protocols, enum_types: context.enum_types, aggregate_types: context.aggregate_types, newtype_ids: context.newtype_ids, @@ -202,7 +214,10 @@ pub(super) struct FunctionLowerer<'a> { pub(super) local_types: HashMap, pub(super) signatures: &'a HashMap, pub(super) representations: &'a RepresentationTable, + pub(super) transport_signatures: &'a HashMap, SignatureId>, pub(super) module: &'a CoreModule, + pub(super) source: &'a CoreModule, + pub(super) constructor_protocols: &'a HashMap>, pub(super) enum_types: &'a HashSet, pub(super) aggregate_types: &'a HashSet, pub(super) newtype_ids: &'a HashSet, diff --git a/crates/psrs-backend/src/cc/lower/record/mod.rs b/crates/psrs-backend/src/cc/lower/record/mod.rs index c6d35111..fd7dee6b 100644 --- a/crates/psrs-backend/src/cc/lower/record/mod.rs +++ b/crates/psrs-backend/src/cc/lower/record/mod.rs @@ -269,12 +269,23 @@ impl FunctionLowerer<'_> { }); let target_type = expression.ty; let target_shape = self.value_shape(target_type, expression.span)?; - let conversion = self.typed_conversion( + // The stored field keeps the dictionary method's scheme. Its use type + // is the checked instance, including a constructor such as Effect. + // The source module still has that relation after representation + // rewriting replaces applications at the same type ids. + let evidence = super::instantiation::instantiation_at( + self.source, + self.module, + field_layout.ty, + target_type, + ); + let conversion = self.typed_conversion_with_instantiation( field_layout.ty, target_type, stored, target_shape, expression.span, + evidence.as_ref(), )?; Ok(self.emit_conversion( projected, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 2081c710..63e27fd1 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -247,9 +247,23 @@ pub fn lower_module(module: CoreModule) -> Result Result> { + lower_module_with_relations(module, bindings, None, &HashMap::new()) +} + +/// Lowers Core using an immutable source module for instantiation evidence and +/// representation-owner constructor protocols. `source` is the pre-lowering +/// module when effect applications have been rewritten; otherwise it is absent +/// and relations are read from `module` itself. +pub(crate) fn lower_module_with_relations( + module: CoreModule, + bindings: ExternalBindings, + source: Option<&CoreModule>, + protocols: &HashMap>, ) -> Result> { bindings.validate_core(&module)?; - if let Err(errors) = module.verify() { + let relations = source.unwrap_or(&module); + if let Err(errors) = module.verify_with_source(relations) { return Err(annotate_errors( errors .into_iter() @@ -337,8 +351,11 @@ pub fn lower_module_with_bindings( .collect::>(); let context = LoweringContext { module: &module, + source: relations, + constructor_protocols: protocols, signatures: &signatures, representations: &layout.representations, + transport_signatures: &layout.transport_signatures, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/effects/mod.rs b/crates/psrs-backend/src/effects/mod.rs index 720c09a1..d7afdb22 100644 --- a/crates/psrs-backend/src/effects/mod.rs +++ b/crates/psrs-backend/src/effects/mod.rs @@ -7,18 +7,29 @@ mod verify; use crate::BackendError; use crate::bindings::ExternalBindings; -use psrs_core::{Module as CoreModule, effect::EffectCompilation}; +use psrs_core::{Module as CoreModule, TypeId, effect::EffectCompilation}; +use psrs_hir::TypeId as HirTypeId; +use std::collections::{HashMap, HashSet}; + +/// Source Core captured before effect applications become closures, plus the +/// token protocol the Effect representation owner contributes to conversion. +pub(crate) struct EffectPreparation { + pub(crate) source: CoreModule, + pub(crate) protocols: HashMap>, +} pub(crate) fn lower_effects( module: &mut CoreModule, bindings: &mut ExternalBindings, context: &EffectCompilation, -) -> Result<(), Vec> { +) -> Result> { verify::trusted_contract(module, bindings, &context.trusted)?; validate_entry_context(module, context)?; let suspensions = suspension::plan(module, bindings, &context.trusted)?; + let source = module.clone(); let lowering = psrs_core::effect::lower_effects(module, &context.trusted) .map_err(|errors| verify::verification_errors(&errors))?; + let protocols = effect_protocols(module, &context.trusted, &lowering)?; let applied = suspension::apply(module, bindings, &suspensions)?; if let Some(entry) = context.command_entry { @@ -28,7 +39,7 @@ pub(crate) fn lower_effects( lowering .verify(module) .map_err(|errors| verify::verification_errors(&errors))?; - if let Err(errors) = module.verify() { + if let Err(errors) = module.verify_with_source(&source) { return Err(verify::verification_errors(&errors)); } suspension::verify(module, bindings, &suspensions, &applied)?; @@ -36,7 +47,33 @@ pub(crate) fn lower_effects( bindings .imports .retain(|binding| !synthesized.contains(&binding.symbol)); - Ok(()) + Ok(EffectPreparation { source, protocols }) +} + +/// The Effect constructor's stored calling convention is the token chosen by +/// effect lowering. The payload remains the application's result and is not a +/// hidden parameter. +fn effect_protocols( + module: &CoreModule, + trusted: &psrs_core::effect::TrustedEffect, + lowering: &psrs_core::effect::EffectLowering, +) -> Result>, Vec> { + let mut tokens = HashSet::new(); + for closure in &lowering.closures { + tokens.insert(closure.token); + } + if tokens.len() > 1 { + return Err(vec![verify::effect_error( + module, + module.span, + "Effect lowering produced more than one runtime token", + )]); + } + let mut protocols = HashMap::new(); + if let Some(token) = tokens.into_iter().next() { + protocols.insert(trusted.effect_type, vec![token]); + } + Ok(protocols) } fn validate_entry_context( diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index dfcd6384..91d48821 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -149,10 +149,14 @@ pub fn lower_cc_with_context( effect_context: Option<&psrs_core::effect::EffectCompilation>, ) -> Result> { let mut external_bindings = ExternalBindings::from_core(&module); + let mut source = None; + let mut protocols = std::collections::HashMap::new(); if let Some(context) = effect_context { - effects::lower_effects(&mut module, &mut external_bindings, context)?; + let prepared = effects::lower_effects(&mut module, &mut external_bindings, context)?; + protocols = prepared.protocols; + source = Some(prepared.source); } - cc::lower_module_with_bindings(module, external_bindings) + cc::lower_module_with_relations(module, external_bindings, source.as_ref(), &protocols) } /// The default-profile validator, retained for backend unit tests. diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs index a67d646d..c48dc674 100644 --- a/crates/psrs-backend/src/pipeline/mod.rs +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -90,6 +90,8 @@ pub(crate) fn compile_with_context_inner( None }; + let mut effect_source = None; + let mut effect_protocols = std::collections::HashMap::new(); if let Some(context) = effect_context.as_ref() { let effect_call = trace.as_deref_mut().map(|trace| { trace.begin( @@ -105,12 +107,17 @@ pub(crate) fn compile_with_context_inner( }], ) }); - if let Err(errors) = effects::lower_effects(&mut module, &mut external_bindings, context) { - if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { - trace.reject(call, errors.len()); + let prepared = match effects::lower_effects(&mut module, &mut external_bindings, context) { + Ok(prepared) => prepared, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { + trace.reject(call, errors.len()); + } + return Err(errors); } - return Err(errors); - } + }; + effect_protocols = prepared.protocols; + effect_source = Some(prepared.source); if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { let outputs = trace.complete( call, @@ -179,7 +186,12 @@ pub(crate) fn compile_with_context_inner( target_parameter(), ) }); - let lowered_cc = match cc::lower_module_with_bindings(module, external_bindings) { + let lowered_cc = match cc::lower_module_with_relations( + module, + external_bindings, + effect_source.as_ref(), + &effect_protocols, + ) { Ok(lowered) => lowered, Err(errors) => { if let (Some(trace), Some(call)) = (trace.as_deref_mut(), cc_call) { diff --git a/crates/psrs-core/src/instantiation.rs b/crates/psrs-core/src/instantiation.rs new file mode 100644 index 00000000..4e46f730 --- /dev/null +++ b/crates/psrs-core/src/instantiation.rs @@ -0,0 +1,49 @@ +//! Read-only instantiation evidence from the Core checking relation. + +use crate::{Module, Type, TypeConstructor, TypeId}; +use psrs_hir::TypeVariableId; +use std::collections::{HashMap, HashSet}; + +/// A successful declaration-scheme/use check. Borrowing the source module keeps +/// its type arena immutable for the lifetime of the evidence. +pub struct Instantiation<'a> { + pub(crate) module: &'a Module, + pub(crate) replacements: HashMap, +} + +impl std::fmt::Debug for Instantiation<'_> { + fn fmt(&self, formatter: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + formatter + .debug_struct("Instantiation") + .field("replacements", &self.replacements) + .finish() + } +} + +impl Instantiation<'_> { + /// Resolves an abstract constructor to its checked constructor application. + /// Fixed arguments belong to the borrowed source arena. An unsolved head, + /// row solution or substitution cycle is not a constructor identity. + pub fn constructor(&self, variable: TypeVariableId) -> Option<(TypeConstructor, Vec)> { + let mut current = *self.replacements.get(&variable)?; + let mut arguments = Vec::new(); + let mut seen = HashSet::new(); + loop { + if !seen.insert(current) { + return None; + } + match self.module.types.get(current.0 as usize)? { + Type::Variable(variable) => current = *self.replacements.get(variable)?, + Type::Application(function, argument) => { + arguments.push(*argument); + current = *function; + } + Type::Constructor(constructor) => { + arguments.reverse(); + return Some((*constructor, arguments)); + } + _ => return None, + } + } + } +} diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 54d64aec..6118ba4f 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -1,10 +1,12 @@ pub mod dictionary; pub mod effect; +mod instantiation; mod link; mod lower; pub mod opt; mod pattern; mod records; +pub use instantiation::Instantiation; mod types; mod verify; @@ -225,7 +227,29 @@ pub fn lower_module_unverified(module: psrs_thir::Module) -> Result Result<(), Vec> { - verify::module(self) + verify::module(self, None) + } + + /// Verifies this physical module while checking declaration instantiation + /// against `source` whenever both type ids still exist there. + /// + /// Representation lowering may replace a source application with a closure + /// at the same type id. Those relations stay on the immutable source + /// module. Types allocated only in this module, including synthesized + /// operation closures, are checked against this module's own type table. + pub fn verify_with_source(&self, source: &Module) -> Result<(), Vec> { + verify::module(self, Some(source)) + } + + /// Checks a declaration use with the same relation as Core verification, + /// retaining its solved constructor bindings without changing acceptance. + pub fn checked_instantiation( + &self, + scheme: TypeId, + quantified: &[TypeVariableId], + instance: TypeId, + ) -> Option> { + verify::instantiation(self, scheme, quantified, instance) } /// The hidden calling-convention parameter count registered for a callable diff --git a/crates/psrs-core/src/tests/instantiation.rs b/crates/psrs-core/src/tests/instantiation.rs new file mode 100644 index 00000000..71f6544f --- /dev/null +++ b/crates/psrs-core/src/tests/instantiation.rs @@ -0,0 +1,168 @@ +//! Checked instantiation evidence. These cases cover the relation P8 reads +//! before representation lowering rewrites a constructor application. + +use super::*; +use psrs_hir::{ModuleId, TypeId as HirTypeId, TypeVariableId}; +use std::collections::HashMap; + +const SPAN: TextRange = TextRange::new(0, 1); + +fn bare(types: Vec) -> Module { + Module { + type_names: Vec::new(), + id: ModuleId(0), + name: "Instantiation".into(), + externals: Vec::new(), + external_types: Vec::new(), + types, + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: Vec::new(), + entry: None, + span: SPAN, + } +} + +fn apply(types: &mut Vec, function: TypeId, argument: TypeId) -> TypeId { + let id = TypeId(types.len() as u32); + types.push(Type::Application(function, argument)); + id +} + +fn nominal(types: &mut Vec, id: u32, argument: TypeId) -> TypeId { + let constructor = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::User(HirTypeId::new( + ModuleId(0), + id, + )))); + apply(types, constructor, argument) +} + +#[test] +fn distinct_nominal_applications_are_rejected() { + let mut types = vec![Type::Constructor(TypeConstructor::Int)]; + let maybe = nominal(&mut types, 1, TypeId(0)); + let either = nominal(&mut types, 2, TypeId(0)); + let module = bare(types); + assert!(module.checked_instantiation(maybe, &[], either).is_none()); +} + +#[test] +fn flexible_variables_match_from_either_side() { + let variable = TypeVariableId(7); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Variable(variable), + ]; + let head = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::User(HirTypeId::new( + ModuleId(0), + 1, + )))); + let concrete = apply(&mut types, head, TypeId(0)); + let abstract_application = apply(&mut types, TypeId(1), TypeId(0)); + let module = bare(types); + + let from_scheme = module + .checked_instantiation(abstract_application, &[variable], concrete) + .expect("a flexible head instantiates to the nominal constructor"); + assert_eq!( + from_scheme.constructor(variable), + Some(( + TypeConstructor::User(HirTypeId::new(ModuleId(0), 1)), + Vec::new() + )) + ); + + let from_target = module + .checked_instantiation(concrete, &[variable], abstract_application) + .expect("a flexible target head binds to the concrete constructor"); + assert_eq!( + from_target.constructor(variable), + Some(( + TypeConstructor::User(HirTypeId::new(ModuleId(0), 1)), + Vec::new() + )) + ); +} + +#[test] +fn dictionary_fields_alpha_rename_their_quantifiers() { + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Variable(TypeVariableId(1)), + Type::Variable(TypeVariableId(2)), + Type::RowEmpty, + ]; + let left_body = arrow(&mut types, TypeId(0), TypeId(1)); + let left_scheme = forall(&mut types, vec![TypeVariableId(1)], left_body); + let right_body = arrow(&mut types, TypeId(0), TypeId(2)); + let right_scheme = forall(&mut types, vec![TypeVariableId(2)], right_body); + let left = record(&mut types, left_scheme); + let right = record(&mut types, right_scheme); + let module = bare(types); + assert!( + module.checked_instantiation(left, &[], right).is_some(), + "a dictionary field quantifier is alpha-equivalent under a renamed binder" + ); +} + +#[test] +fn constructor_binding_rejects_unsolved_variables_and_cycles() { + let variable = TypeVariableId(3); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Variable(variable), + Type::Constructor(TypeConstructor::Function), + ]; + let function_int = apply(&mut types, TypeId(2), TypeId(0)); + let solved_module = bare(types); + let solved = Instantiation { + module: &solved_module, + replacements: HashMap::from([(variable, function_int)]), + }; + assert_eq!( + solved.constructor(variable), + Some((TypeConstructor::Function, vec![TypeId(0)])) + ); + + let unsolved = Instantiation { + module: &solved_module, + replacements: HashMap::from([(variable, TypeId(1))]), + }; + assert_eq!(unsolved.constructor(variable), None); + + let cyclic_module = bare(vec![Type::Application(TypeId(0), TypeId(0))]); + let cyclic = Instantiation { + module: &cyclic_module, + replacements: HashMap::from([(variable, TypeId(0))]), + }; + assert_eq!(cyclic.constructor(variable), None); +} + +fn arrow(types: &mut Vec, parameter: TypeId, result: TypeId) -> TypeId { + let function = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::Function)); + let applied = apply(types, function, parameter); + apply(types, applied, result) +} + +fn forall(types: &mut Vec, variables: Vec, body: TypeId) -> TypeId { + let id = TypeId(types.len() as u32); + types.push(Type::ForAll { variables, body }); + id +} + +fn record(types: &mut Vec, field: TypeId) -> TypeId { + let row = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: "chain".into(), + ty: field, + tail: TypeId(3), + }); + let head = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::Record)); + apply(types, head, row) +} diff --git a/crates/psrs-core/src/tests/mod.rs b/crates/psrs-core/src/tests/mod.rs index 0ed11b44..2c35ff5e 100644 --- a/crates/psrs-core/src/tests/mod.rs +++ b/crates/psrs-core/src/tests/mod.rs @@ -3,6 +3,7 @@ use psrs_hir::{Intrinsic, LocalId, ModuleId, SymbolId}; mod effects; mod external_types; +mod instantiation; mod link; mod patterns; mod rank_n; diff --git a/crates/psrs-core/src/verify/expr/entry.rs b/crates/psrs-core/src/verify/expr/entry.rs index ff2c5ea0..58fe4e54 100644 --- a/crates/psrs-core/src/verify/expr/entry.rs +++ b/crates/psrs-core/src/verify/expr/entry.rs @@ -4,10 +4,12 @@ use crate::{Expr, Module, TypeId, VerifyError}; use psrs_hir::{ModuleId, SymbolId}; use std::collections::HashMap; +#[allow(clippy::too_many_arguments)] pub(in crate::verify) fn verify_expr( expression: &Expr, expected: Option, module: &Module, + source: Option<&Module>, owner: ModuleId, globals: &HashMap>, locals: &mut Locals, @@ -15,6 +17,7 @@ pub(in crate::verify) fn verify_expr( ) { let mut context = Context { module, + source, owner, globals, locals, diff --git a/crates/psrs-core/src/verify/expr/mod.rs b/crates/psrs-core/src/verify/expr/mod.rs index 42d0cd8c..0dd523ee 100644 --- a/crates/psrs-core/src/verify/expr/mod.rs +++ b/crates/psrs-core/src/verify/expr/mod.rs @@ -17,12 +17,25 @@ use helpers::{closure_call, strip_leading_foralls}; struct Context<'a> { module: &'a Module, + /// Immutable source module used for declaration instantiation. `None` + /// checks every relation against `module`. + source: Option<&'a Module>, owner: ModuleId, globals: &'a HashMap>, locals: &'a mut Locals, errors: &'a mut Vec, } +/// Source relations apply only when every type id still addresses the +/// immutable source table. A newer id belongs to a representation closure +/// and is checked on the physical module. +fn viewed<'a>(physical: &'a Module, source: Option<&'a Module>, ids: &[TypeId]) -> &'a Module { + match source { + Some(source) if ids.iter().all(|id| (id.0 as usize) < source.types.len()) => source, + _ => physical, + } +} + impl Context<'_> { fn expr(&mut self, expression: &Expr, expected: Option) { verify_type( @@ -33,10 +46,11 @@ impl Context<'_> { self.errors, ); if let Some(expected) = expected { + let module = viewed(self.module, self.source, &[expression.ty, expected]); compatible( expression.ty, expected, - self.module, + module, self.owner, expression.span, self.errors, @@ -52,11 +66,12 @@ impl Context<'_> { )); return; }; + let module = viewed(self.module, self.source, &[local_type.ty, expression.ty]); if !super::types::scheme_instance( local_type.ty, &local_type.quantified, expression.ty, - self.module, + module, ) { self.errors.push(error( self.owner, @@ -67,11 +82,12 @@ impl Context<'_> { } ExprKind::Global(id) => match self.globals.get(id) { Some(Some(global_type)) => { + let module = viewed(self.module, self.source, &[global_type.ty, expression.ty]); if !super::types::scheme_instance( global_type.ty, &global_type.quantified, expression.ty, - self.module, + module, ) { self.errors.push(error( self.owner, @@ -148,10 +164,11 @@ impl Context<'_> { ExprKind::FieldAccess { record, field } => { self.expr(record, None); if let Some(field_type) = record_field(record.ty, field, self.module) { + let module = viewed(self.module, self.source, &[field_type, expression.ty]); compatible( field_type, expression.ty, - self.module, + module, self.owner, expression.span, self.errors, @@ -244,18 +261,20 @@ impl Context<'_> { self.expr(argument, None); let function_body = strip_leading_foralls(self.module, function.ty); if let Some((parameter, result)) = closure_call(self.module, function_body) { + let module = viewed(self.module, self.source, &[argument.ty, parameter]); compatible( argument.ty, parameter, - self.module, + module, self.owner, argument.span, self.errors, ); + let module = viewed(self.module, self.source, &[result, expression.ty]); compatible( result, expression.ty, - self.module, + module, self.owner, expression.span, self.errors, @@ -266,26 +285,34 @@ impl Context<'_> { function.span, "application target is not a function", )); - } else if !super::types::application_matches( - function.ty, - argument.ty, - expression.ty, - self.module, - ) { - self.errors.push(error( - self.owner, - function.span, - "Core expression type is inconsistent with its context", - )); + } else { + let module = viewed( + self.module, + self.source, + &[function.ty, argument.ty, expression.ty], + ); + if !super::types::application_matches( + function.ty, + argument.ty, + expression.ty, + module, + ) { + self.errors.push(error( + self.owner, + function.span, + "Core expression type is inconsistent with its context", + )); + } } } ExprKind::Lambda { binder, body } => { let function_type = strip_leading_foralls(self.module, expression.ty); if let Some((parameter, result)) = closure_call(self.module, function_type) { + let module = viewed(self.module, self.source, &[binder.ty, parameter]); compatible( binder.ty, parameter, - self.module, + module, self.owner, binder.span, self.errors, @@ -311,10 +338,11 @@ impl Context<'_> { )); return; }; + let module = viewed(self.module, self.source, &[binder.ty, parameter]); compatible( binder.ty, parameter, - self.module, + module, self.owner, binder.span, self.errors, @@ -390,6 +418,7 @@ impl Context<'_> { ); let mut branch_context = Context { module: self.module, + source: self.source, owner: self.owner, globals: self.globals, locals: &mut branch_locals, diff --git a/crates/psrs-core/src/verify/mod.rs b/crates/psrs-core/src/verify/mod.rs index 1cd9c6f4..ac4d51c6 100644 --- a/crates/psrs-core/src/verify/mod.rs +++ b/crates/psrs-core/src/verify/mod.rs @@ -8,6 +8,7 @@ mod scopes; mod types; pub(crate) use types::equivalent_types; +pub(crate) use types::instantiation; use expr::verify_expr; use patterns::verify_pattern; @@ -23,7 +24,7 @@ pub(super) struct SchemeType { type Locals = HashMap; -pub(crate) fn module(module: &Module) -> Result<(), Vec> { +pub(crate) fn module(module: &Module, source: Option<&Module>) -> Result<(), Vec> { let globals = module .declarations .iter() @@ -145,6 +146,7 @@ pub(crate) fn module(module: &Module) -> Result<(), Vec> { &declaration.value, Some(declaration.ty), module, + source, owner, &globals, &mut locals, diff --git a/crates/psrs-core/src/verify/types/matching/evidence.rs b/crates/psrs-core/src/verify/types/matching/evidence.rs new file mode 100644 index 00000000..1c92f767 --- /dev/null +++ b/crates/psrs-core/src/verify/types/matching/evidence.rs @@ -0,0 +1,27 @@ +use super::TypeMatcher; +use crate::{Instantiation, Module, TypeId}; +use psrs_hir::TypeVariableId; +use std::collections::{HashMap, HashSet}; + +pub(crate) fn instantiation<'a>( + module: &'a Module, + scheme: TypeId, + quantified: &[TypeVariableId], + instance: TypeId, +) -> Option> { + let mut matcher = TypeMatcher { + module, + flexible: quantified.iter().copied().collect(), + replacements: HashMap::new(), + row_forms: HashMap::new(), + alpha: HashMap::new(), + active: HashSet::new(), + }; + if !matcher.subsumes(scheme, instance, true) { + return None; + } + Some(Instantiation { + module, + replacements: matcher.replacements, + }) +} diff --git a/crates/psrs-core/src/verify/types/matching/invariant.rs b/crates/psrs-core/src/verify/types/matching/invariant.rs new file mode 100644 index 00000000..21bb1854 --- /dev/null +++ b/crates/psrs-core/src/verify/types/matching/invariant.rs @@ -0,0 +1,169 @@ +//! Invariant type matching. Flexible variables are solved from either side. +//! Constructor identity comes from an explicit binding, never from a closure's +//! parameter count. + +use super::{Relation, TypeMatcher}; +use crate::Type; + +impl TypeMatcher<'_> { + pub(super) fn matches( + &mut self, + source: crate::TypeId, + target: crate::TypeId, + instantiate: bool, + ) -> bool { + if !self.active.insert((Relation::Invariant, source, target)) { + return true; + } + if let ( + Some((source_parameters, source_result)), + Some((target_parameters, target_result)), + ) = ( + crate::closure_parts(&self.module.types, source), + crate::closure_parts(&self.module.types, target), + ) { + let source_parameters = source_parameters.to_vec(); + let target_parameters = target_parameters.to_vec(); + let result = source_parameters.len() == target_parameters.len() + && source_parameters + .into_iter() + .zip(target_parameters) + .all(|(source, target)| self.matches(source, target, false)) + && self.matches(source_result, target_result, instantiate); + self.active.remove(&(Relation::Invariant, source, target)); + return result; + } + let (Some(source_type), Some(target_type)) = ( + self.module.types.get(source.0 as usize), + self.module.types.get(target.0 as usize), + ) else { + self.active.remove(&(Relation::Invariant, source, target)); + return false; + }; + if let Type::Variable(variable) = source_type { + let result = if self.alpha.contains_key(variable) + || self.alpha.values().any(|bound| bound == variable) + || matches!(target_type, Type::Variable(other) if self.alpha.contains_key(other) || self.alpha.values().any(|bound| bound == other)) + { + matches!(target_type, Type::Variable(other) if self.alpha_variables_match(*variable, *other)) + } else if self.flexible.contains(variable) { + if matches!(target_type, Type::ForAll { .. }) { + false + } else { + self.bind_flexible(*variable, target) + } + } else { + match target_type { + Type::Variable(actual) if self.flexible.contains(actual) => { + self.bind_flexible(*actual, source) + } + Type::Variable(actual) => actual == variable, + _ => false, + } + }; + self.active.remove(&(Relation::Invariant, source, target)); + return result; + } + if let Type::Variable(variable) = target_type { + let result = !self.alpha.values().any(|bound| bound == variable) + && self.flexible.contains(variable) + && !matches!(source_type, Type::ForAll { .. }) + && self.bind_flexible(*variable, source); + self.active.remove(&(Relation::Invariant, source, target)); + return result; + } + let result = match (source_type, target_type) { + ( + Type::ForAll { + variables: source_variables, + body: source_body, + }, + Type::ForAll { + variables: target_variables, + body: target_body, + }, + ) if source_variables.len() == target_variables.len() => { + if source_variables + .iter() + .any(|variable| self.alpha.contains_key(variable)) + { + false + } else { + for (source, target) in source_variables.iter().zip(target_variables) { + self.alpha.insert(*source, *target); + } + let matches = self.matches(*source_body, *target_body, instantiate); + for variable in source_variables { + self.alpha.remove(variable); + } + matches + } + } + (Type::ForAll { variables, body }, _) if instantiate => { + let added = variables + .iter() + .copied() + .filter(|variable| self.flexible.insert(*variable)) + .collect::>(); + let matches = self.matches(*body, target, true); + for variable in added { + self.flexible.remove(&variable); + self.replacements.remove(&variable); + } + matches + } + (Type::ForAll { .. }, _) | (_, Type::ForAll { .. }) => false, + (Type::Constructor(left), Type::Constructor(right)) => left == right, + (Type::Application(_, _), Type::Application(_, _)) => { + if let ( + Some((source_parameter, source_result)), + Some((target_parameter, target_result)), + ) = ( + crate::arrow_parts(&self.module.types, source), + crate::arrow_parts(&self.module.types, target), + ) { + self.matches(source_parameter, target_parameter, false) + && self.matches(source_result, target_result, instantiate) + } else if super::is_record_type(self.module, source) + && super::is_record_type(self.module, target) + { + self.matches_record(source, target) + } else { + let ( + Type::Application(source_function, source_argument), + Type::Application(target_function, target_argument), + ) = (source_type, target_type) + else { + unreachable!() + }; + self.matches(*source_function, *target_function, false) + && self.matches(*source_argument, *target_argument, false) + } + } + (Type::RowEmpty, Type::RowEmpty) => true, + ( + Type::RowExtend { + label: left_label, + ty: left_ty, + tail: left_tail, + }, + Type::RowExtend { + label: right_label, + ty: right_ty, + tail: right_tail, + }, + ) => { + left_label == right_label + && self.matches(*left_ty, *right_ty, false) + && self.matches(*left_tail, *right_tail, false) + } + _ => false, + }; + self.active.remove(&(Relation::Invariant, source, target)); + result + } + + pub(super) fn matches_record(&mut self, source: crate::TypeId, target: crate::TypeId) -> bool { + self.relate_records(source, target, false) + } +} diff --git a/crates/psrs-core/src/verify/types/matching/mod.rs b/crates/psrs-core/src/verify/types/matching/mod.rs index ff9ccc92..a200c368 100644 --- a/crates/psrs-core/src/verify/types/matching/mod.rs +++ b/crates/psrs-core/src/verify/types/matching/mod.rs @@ -1,11 +1,14 @@ use super::error; -use crate::{Module, Type, TypeConstructor, TypeId, VerifyError}; +use crate::{Module, Type, TypeId, VerifyError}; use psrs_hir::ModuleId; use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; mod closure; mod constructors; +mod evidence; +mod invariant; +pub(crate) use evidence::instantiation; mod helpers; mod rows; pub(in crate::verify) use constructors::constructor_fields_match; @@ -38,16 +41,6 @@ pub(in crate::verify) fn compatible( } } -fn applied_variable(id: TypeId, module: &Module) -> Option<(psrs_hir::TypeVariableId, TypeId)> { - let Type::Application(function, argument) = module.types.get(id.0 as usize)? else { - return None; - }; - let Type::Variable(variable) = module.types.get(function.0 as usize)? else { - return None; - }; - Some((*variable, *argument)) -} - /// Checks whether `instance` is a legal use of a declaration or local scheme. /// Every quantified variable receives one consistent replacement for the full /// type, while nested `ForAll` binders remain rigid where the type is consumed. @@ -102,13 +95,19 @@ pub(in crate::verify) fn application_matches( matcher.subsumes(argument, parameter, true) && matcher.subsumes(function_result, result, true) } +#[derive(Clone, Copy, PartialEq, Eq, Hash)] +enum Relation { + Subsumption, + Invariant, +} + struct TypeMatcher<'a> { module: &'a Module, flexible: HashSet, replacements: HashMap, row_forms: HashMap, alpha: HashMap, - active: HashSet<(TypeId, TypeId)>, + active: HashSet<(Relation, TypeId, TypeId)>, } impl TypeMatcher<'_> { @@ -118,14 +117,18 @@ impl TypeMatcher<'_> { /// an expected universal remains rigid and therefore requires an actual /// universal with alpha-equivalent binders. fn subsumes(&mut self, actual: TypeId, expected: TypeId, instantiate: bool) -> bool { - if !self.active.insert((actual, expected)) { + if !self + .active + .insert((Relation::Subsumption, actual, expected)) + { return true; } let (Some(actual_type), Some(expected_type)) = ( self.module.types.get(actual.0 as usize), self.module.types.get(expected.0 as usize), ) else { - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return false; }; @@ -137,7 +140,8 @@ impl TypeMatcher<'_> { } else { self.bind_flexible(*variable, actual) }; - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } @@ -152,7 +156,8 @@ impl TypeMatcher<'_> { } else { self.bind_flexible(*variable, expected) }; - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } let Type::ForAll { variables, body } = expected_type else { @@ -168,7 +173,8 @@ impl TypeMatcher<'_> { self.flexible.insert(variable); } } - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } @@ -187,7 +193,8 @@ impl TypeMatcher<'_> { .iter() .any(|variable| self.alpha.contains_key(variable)) { - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return false; } for (actual, expected) in actual_variables.iter().zip(expected_variables) { @@ -197,11 +204,13 @@ impl TypeMatcher<'_> { for variable in actual_variables { self.alpha.remove(variable); } - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } if !instantiate { - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return false; } let added = actual_variables @@ -214,7 +223,8 @@ impl TypeMatcher<'_> { self.flexible.remove(&variable); self.replacements.remove(&variable); } - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } if let Type::Variable(variable) = actual_type { @@ -241,7 +251,8 @@ impl TypeMatcher<'_> { } else { false }; - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } if let Type::Variable(variable) = expected_type { @@ -252,17 +263,14 @@ impl TypeMatcher<'_> { } else { false }; - self.active.remove(&(actual, expected)); - return result; - } - - if let Some(result) = self.subsumes_callable_application(actual, expected, instantiate) { - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } if let Some(result) = self.subsumes_closure(actual, expected, instantiate) { - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); return result; } @@ -307,7 +315,8 @@ impl TypeMatcher<'_> { } _ => false, }; - self.active.remove(&(actual, expected)); + self.active + .remove(&(Relation::Subsumption, actual, expected)); result } @@ -359,213 +368,7 @@ impl TypeMatcher<'_> { true } - /// A trusted callable type constructor application is lowered to a - /// closure type at P8. When a polymorphic class method is instantiated - /// through such a constructor, relate `f a` to `Closure(params, a)` while - /// retaining the constructor identity for other occurrences of `f`. - fn subsumes_callable_application( - &mut self, - actual: TypeId, - expected: TypeId, - instantiate: bool, - ) -> Option { - let actual_application = applied_variable(actual, self.module); - let expected_application = applied_variable(expected, self.module); - let actual_closure = crate::closure_parts(&self.module.types, actual) - .map(|(parameters, result)| (parameters.len(), result)); - let expected_closure = crate::closure_parts(&self.module.types, expected) - .map(|(parameters, result)| (parameters.len(), result)); - let (variable, argument, result, actual_is_application, arity) = match ( - actual_application, - expected_application, - actual_closure, - expected_closure, - ) { - (Some((variable, argument)), None, _, Some((arity, result))) => { - (variable, argument, result, true, arity) - } - (None, Some((variable, argument)), Some((arity, result)), _) => { - (variable, argument, result, false, arity) - } - _ => return None, - }; - - if !self.flexible.contains(&variable) { - return Some(false); - } - let mut callable_ids = - self.module - .callable_types - .iter() - .filter_map(|(id, hidden_parameters)| { - (*hidden_parameters as usize == arity).then_some(*id) - }); - let Some(callable_id) = callable_ids.next() else { - return Some(false); - }; - if callable_ids.next().is_some() { - return Some(false); - } - let Some((constructor_index, _)) = self - .module - .types - .iter() - .enumerate() - .find(|(_, ty)| { - matches!(ty, Type::Constructor(TypeConstructor::User(id)) if *id == callable_id) - }) - else { - return Some(false); - }; - if !self.bind_flexible(variable, TypeId(constructor_index as u32)) { - return Some(false); - } - Some(if actual_is_application { - self.subsumes(argument, result, instantiate) - } else { - self.subsumes(result, argument, instantiate) - }) - } - fn subsumes_record(&mut self, actual: TypeId, expected: TypeId) -> bool { self.relate_records(actual, expected, true) } - - fn matches(&mut self, source: TypeId, target: TypeId, instantiate: bool) -> bool { - if !self.active.insert((source, target)) { - return true; - } - if let ( - Some((source_parameters, source_result)), - Some((target_parameters, target_result)), - ) = ( - crate::closure_parts(&self.module.types, source), - crate::closure_parts(&self.module.types, target), - ) { - let source_parameters = source_parameters.to_vec(); - let target_parameters = target_parameters.to_vec(); - let result = source_parameters.len() == target_parameters.len() - && source_parameters - .into_iter() - .zip(target_parameters) - .all(|(source, target)| self.matches(source, target, false)) - && self.matches(source_result, target_result, instantiate); - self.active.remove(&(source, target)); - return result; - } - let (Some(source_type), Some(target_type)) = ( - self.module.types.get(source.0 as usize), - self.module.types.get(target.0 as usize), - ) else { - self.active.remove(&(source, target)); - return false; - }; - if let Type::Variable(variable) = source_type { - let result = if let Some(mapped) = self.alpha.get(variable) { - matches!(target_type, Type::Variable(actual) if actual == mapped) - } else if self.flexible.contains(variable) { - if matches!(target_type, Type::ForAll { .. }) { - false - } else { - self.bind_flexible(*variable, target) - } - } else { - matches!(target_type, Type::Variable(actual) if actual == variable) - }; - self.active.remove(&(source, target)); - return result; - } - let result = match (source_type, target_type) { - ( - Type::ForAll { - variables: source_variables, - body: source_body, - }, - Type::ForAll { - variables: target_variables, - body: target_body, - }, - ) if source_variables.len() == target_variables.len() => { - if source_variables - .iter() - .any(|variable| self.alpha.contains_key(variable)) - { - false - } else { - for (source, target) in source_variables.iter().zip(target_variables) { - self.alpha.insert(*source, *target); - } - let matches = self.matches(*source_body, *target_body, instantiate); - for variable in source_variables { - self.alpha.remove(variable); - } - matches - } - } - (Type::ForAll { variables, body }, _) if instantiate => { - let added = variables - .iter() - .copied() - .filter(|variable| self.flexible.insert(*variable)) - .collect::>(); - let matches = self.matches(*body, target, true); - for variable in added { - self.flexible.remove(&variable); - self.replacements.remove(&variable); - } - matches - } - (Type::ForAll { .. }, _) | (_, Type::ForAll { .. }) => false, - (Type::Constructor(left), Type::Constructor(right)) => left == right, - (Type::Application(_, _), Type::Application(_, _)) => { - if let ( - Some((source_parameter, source_result)), - Some((target_parameter, target_result)), - ) = ( - crate::arrow_parts(&self.module.types, source), - crate::arrow_parts(&self.module.types, target), - ) { - self.matches(source_parameter, target_parameter, false) - && self.matches(source_result, target_result, instantiate) - } else if is_record_type(self.module, source) && is_record_type(self.module, target) - { - self.matches_record(source, target) - } else { - let ( - Type::Application(source_function, source_argument), - Type::Application(target_function, target_argument), - ) = (source_type, target_type) - else { - unreachable!() - }; - self.matches(*source_function, *target_function, false) - && self.matches(*source_argument, *target_argument, false) - } - } - (Type::RowEmpty, Type::RowEmpty) => true, - ( - Type::RowExtend { - label: left_label, - ty: left_ty, - tail: left_tail, - }, - Type::RowExtend { - label: right_label, - ty: right_ty, - tail: right_tail, - }, - ) => { - left_label == right_label - && self.matches(*left_ty, *right_ty, false) - && self.matches(*left_tail, *right_tail, false) - } - _ => false, - }; - self.active.remove(&(source, target)); - result - } - - fn matches_record(&mut self, source: TypeId, target: TypeId) -> bool { - self.relate_records(source, target, false) - } } diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 90eba305..ab9ae981 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -126,6 +126,7 @@ pub(super) fn record_field(id: TypeId, label: &str, module: &Module) -> Option (a -> f b) -> f b + +instance chainReader :: Chain ((->) Int) where + chain m k x = k (m x) x + +repeatAction :: forall f. Chain f => f Int -> f Int +repeatAction action = chain action (\_ -> action) + +action :: Int -> Int +action x = x + +main :: Int +main = repeatAction action 42 +"#; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"", "{output:?}"); +} + +/// A fixed source payload (`f Unit`) still crosses the generic method's +/// definition ABI. The method returns an `f Unit` whose stored calling +/// convention is its own, so running it executes the action twice without a +/// cast from one closure signature onto another. +#[test] +fn fixed_unit_payload_through_a_bind_constraint_repeats_the_action() { + let source = r#" +module Main where + +import Prelude +import Effect.Console (log) + +again :: forall f. Bind f => f Unit -> f Unit +again action = bind action (\_ -> action) + +main :: Effect Unit +main = again (log "again") +"#; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); + assert_eq!(output.stdout, b"again\nagain\n", "{output:?}"); +} + +/// The abstract callable boundary recovers the producer's stored protocol and +/// then adapts it, rather than casting the erased closure directly onto the +/// consumer's concrete signature. The generated adapter returns the concrete +/// payload and its factory captures the producer protocol closure. +#[test] +fn abstract_callable_transport_emits_a_checked_adapter() { + let source = r#" +module Main where + +class Chain f where + chain :: forall a b. f a -> (a -> f b) -> f b + +instance chainReader :: Chain ((->) Int) where + chain m k x = k (m x) x + +repeatAction :: forall f. Chain f => f Int -> f Int +repeatAction action = chain action (\_ -> action) + +action :: Int -> Int +action x = x + +main :: Int +main = repeatAction action 42 +"#; + let prepared = crate::prepare_main(source).expect("source should lower to Core"); + let cc = psrs_backend::lower_cc_with_context( + prepared.core.clone(), + prepared.effect_context.as_ref(), + ) + .expect("the Reader dictionary should lower to CC") + .cc; + let has_adapter = cc + .functions + .iter() + .flat_map(|function| &function.assignments) + .any(|assignment| { + matches!( + &assignment.kind, + psrs_backend::cc::AssignmentKind::AggregateConvert { conversion, .. } + if plan_has_adapter(&conversion.plan) + ) + }); + assert!( + has_adapter, + "the abstract callable boundary must emit a checked adapter" + ); + assert!( + cc.functions + .iter() + .any(|function| function.name.starts_with("protocol_adapter_factory_")), + "the adapter factory must exist and capture the producer protocol closure" + ); + assert!( + cc.functions + .iter() + .filter(|function| function.name.starts_with("protocol_adapter_")) + .any(|function| function.result_type == psrs_backend::cc::ValueShape::Integer), + "the generated adapter must return the concrete payload, not the erased result" + ); +} + +fn plan_has_adapter(plan: &psrs_backend::cc::ValueConversion) -> bool { + use psrs_backend::cc::ValueConversion; + match plan { + ValueConversion::FunctionAdapter { .. } => true, + ValueConversion::Sequence(steps) => steps.iter().any(plan_has_adapter), + ValueConversion::ArrayMap { element, .. } => plan_has_adapter(element), + ValueConversion::ProductMap { fields, .. } => fields.iter().any(plan_has_adapter), + _ => false, + } +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index e6614b21..d1539d8b 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -5,6 +5,7 @@ use std::sync::atomic::{AtomicU32, Ordering}; static WASM_ARTIFACT_COUNTER: AtomicU32 = AtomicU32::new(0); mod assertions; +mod closure_protocol; mod coercion; mod data_function; mod data_tuple; diff --git a/crates/psrs-resolve/src/resolver/operators.rs b/crates/psrs-resolve/src/resolver/operators.rs index 141891de..47c6a233 100644 --- a/crates/psrs-resolve/src/resolver/operators.rs +++ b/crates/psrs-resolve/src/resolver/operators.rs @@ -1,6 +1,8 @@ use super::names::Resolver; use psrs_ast as ast; -use psrs_hir::{self as hir, Associativity, ExprKind, LocalId, ModuleId, ResolvedOperator, SymbolId}; +use psrs_hir::{ + self as hir, Associativity, ExprKind, LocalId, ModuleId, ResolvedOperator, SymbolId, +}; use std::collections::HashMap; pub(super) fn merge_fixities( diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 7c513355..a6f7bf8d 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -721,19 +721,26 @@ the code reference and an immutable capture array. file. - **Prerequisite:** M2–M6. -**Progress (measured by `runtime::l6_runtime_scoreboard`):** **164 of 413** +**Progress (measured by `runtime::l6_runtime_scoreboard`):** **207 of 413** non-FFI `passing` files compile, validate, and run; all exit 0. Twenty-six FFI -files are excluded. Of the other 249 cases, 230 block before runtime and 19 +files are excluded. Of the other 206 cases, 204 block before runtime and 2 trap while running. The largest current blockers are P5 typechecking (68), P10 -files with no selected `main` (46), P8 CC verification (30), and P3 resolution -(23). This measurement does not emit an empty main or change the 413 denominator. -The board compiles each case with the on-disk standard library on the module -path. Separate +files with no selected `main` (47), P3 resolution (23), and P8 closure +conversion (18). This measurement does not emit an empty main or change the 413 +denominator. The board compiles each case with the on-disk standard library on +the module path. Separate vertical execution tests run under mandatory Wasmtime for GC strings, arrays, closed records, erased newtypes, parameterized ADTs, closures, dictionaries, effects, the component path, and pattern-matrix behavior including the value-sensitive `1185.purs` and `2049.purs` shapes. +The 43-case move from the earlier 164 measurement is the +[abstract-constructor transport contract](backend/fp/polymorphism-and-erasure.md): +recovering a stored closure protocol and generating an adapter, instead of +casting the erased closure onto the consumer signature, eliminated 29 of the 30 +P8 CC verifier failures and 17 of the 19 runtime traps; five of those cases then +surfaced at a later blocker. + Agreement here means the pipeline compiles the file, the component passes Wasm validation, and the guest runs to completion without trapping. The corpus vendors no execution goldens and upstream's `passing` suite is a compile-time @@ -743,22 +750,22 @@ failure must reach the guest as a trap to be visible, which is the only execution signal the corpus can express. Nothing in the corpus needs argv, stdin, or a preopened directory, so the runner passes none. -The 249 non-agreements, by the first phase that blocks them or runtime outcome. +The 206 non-agreements, by the first phase that blocks them or runtime outcome. These are from the latest `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` run -of all five boards on 2026-10-04 (Wasmtime 49.0.2, `purs` 0.15.16): +of all five boards on 2026-10-05 (Wasmtime 49.0.2, `purs` 0.15.16): | Blocker | Cases | Recovered by | | --- | --- | --- | | P5 typecheck | 68 | Type and class inference gaps behind earlier-stage blockers. | -| P10 Wasm structuring | 46 | No selected `main`. | -| P8 CC verification | 30 | Most commonly a call whose arguments do not match its signature. | +| P10 Wasm structuring | 47 | No selected `main`. | | P3 resolve | 23 | Remaining name and import resolution gaps. | -| P8 closure conversion | 16 | Unsupported or inconsistent runtime representations. | +| P8 closure conversion | 18 | Unsupported or inconsistent runtime representations. | | P5 kind check | 16 | Kind checking gaps. | | P0 lex | 4 | DEC-16 lone-surrogate cases, also recorded as L1 differences. | -| P7 Core verification | 1 | A typed Core expression has an inconsistent context type. | -| Harness loading | 26 | Multi-module corpus inputs the current runner cannot assemble. | -| Runtime trap | 19 | The compiled guest traps under Wasmtime. | +| P7 Core verification | 3 | A typed Core expression has an inconsistent context type. | +| P8 CC verification | 1 | A call whose arguments do not match its signature. | +| Harness loading | 24 | Multi-module corpus inputs the current runner cannot assemble. | +| Runtime trap | 2 | The compiled guest traps under Wasmtime. | | P2 surface lowering | 0 | No `passing` file stops in surface lowering. | The tables after the current one are earlier measurements and are **not** diff --git a/docs/design/backend/fp/effects.md b/docs/design/backend/fp/effects.md index 6687b8d6..c374f77b 100644 --- a/docs/design/backend/fp/effects.md +++ b/docs/design/backend/fp/effects.md @@ -374,7 +374,10 @@ rewrites to `bind` before Core, so the backend sees only `pure`, `bind`, - **`bind` with a continuation that ignores its argument.** Still sequenced; the first computation runs before the continuation. - **Polymorphic effect.** `Effect a` with an erased `a` uses the erased - protocol; `runEffect`'s consumer knows the concrete type + protocol; `runEffect`'s consumer knows the concrete type. Crossing an abstract + constructor boundary (`f a`, including `f Unit`) uses the common checked + representation conversion contract, including the producer's stored closure + signature; source instantiation alone does not authorize a signature cast ([polymorphism and erasure](polymorphism-and-erasure.md)). - **A future richer token.** Changing the token to a stateful value changes the representation lowering and the runtime, not the source API or the CC/MIR @@ -439,14 +442,30 @@ Responsibilities and required types: - The wrapper and rewritten Core are structurally verified before CC. This checks binding and type-shape contracts; it does not add a Core or CC Effect node or prove runtime behavior. +- Authoritative source Core remains available until checked boundary relations + and representation conversion plans have been consumed. The application-to- + closure mapping is explicit. An internal rewritten Core-shaped module is a + separate physical view, verified against its own complete structural contract; + it is not passed to the source matcher as though `Effect a` were a source + function. Arity-based reconstruction of the erased constructor is forbidden. +- The Effect representation owner contributes its trusted constructor mapping, + token parameter, result representation and transport protocol to the common + conversion planner. It owns operation synthesis, suspension and command-entry + behavior. Generic calls, dictionary fields, captures and adapter construction + consume ordinary checked boundary evidence and representation contracts; they + do not select an Effect-specific conversion path. A representation-only + canonical closure receives its authority from the plan that creates it, + without a fabricated source `Effect` type or closure-origin field. - CC and MIR lower the resulting generic closures through `FunctionRef` and direct or indirect calls. Curried-arrow flattening reads source `Function` spines only. Partial application (`lower_partial_global_application`) applies to under-applied source arrows, not to the token of an effect. -- The representation may later grow into dictionary passing - ([type classes and dictionaries](type-classes-and-dictionaries.md)). The token - stays inside effect lowering; its type is chosen there. +- Dictionary passing uses the ordinary product and closure representation + ([type classes and dictionaries](type-classes-and-dictionaries.md)). A chosen + `Bind Effect` instance still crosses the definition ABI of a shared generic + method; instance selection does not specialize that ABI automatically. The + token stays inside effect lowering; its type is chosen there. - WASI operations are owned by the [WASI platform library](../wasm/wasi-platform-library.md) and the [canonical ABI and WIT](../wasm/canonical-abi-and-wit.md). A host call is diff --git a/docs/design/backend/fp/generic-aggregate-erasure.md b/docs/design/backend/fp/generic-aggregate-erasure.md index c7af47e8..4ba07667 100644 --- a/docs/design/backend/fp/generic-aggregate-erasure.md +++ b/docs/design/backend/fp/generic-aggregate-erasure.md @@ -237,6 +237,14 @@ representation and the callee or storage representation differ: ### Reconstruction semantics +The typed boundary evidence and stored representation contracts come from the +common planner in [polymorphism and erasure](polymorphism-and-erasure.md#checked-boundaries-and-stored-representation-contracts). +Nested `ProductMap`, `ArrayMap` and callable leaves retain their field/element +position and quantifier context. A dictionary is an ordinary product; its +method field does not authorize a separate Effect-specific matcher or recovery +rule. A stored erased reference can be recovered only to the layout or callable +signature established by its producer protocol. + `ArrayMap` allocates a fresh destination array of the target layout, iterates from zero to the source length, reads each source element, applies the nested element conversion, and writes the converted element into the private target. diff --git a/docs/design/backend/fp/polymorphism-and-erasure.md b/docs/design/backend/fp/polymorphism-and-erasure.md index 3a4000a3..c6422c7d 100644 --- a/docs/design/backend/fp/polymorphism-and-erasure.md +++ b/docs/design/backend/fp/polymorphism-and-erasure.md @@ -25,7 +25,8 @@ This document owns the erased representation for polymorphic values, the distinction between concrete and erased representation requirements, the semantics of the adaptation operations, the generated function adapters used at higher-order boundaries, and the closure capture rules that follow from -erasure. It does not own concrete scalar and GC layouts (see +erasure. This includes applications of abstract constructors (`f a`) and +methods transported through ordinary class dictionaries. It does not own concrete scalar and GC layouts (see [data representation](data-representation.md)), the MIR type model and verifier (see [mir](mir.md)), type-class elaboration and dictionary construction (see [type classes and dictionaries](type-classes-and-dictionaries.md)), scalar @@ -174,6 +175,71 @@ same kind of boundary: `Effect (a -> b)` lowers to a closure that takes the runtime token and returns a function, and flattening that function into the effect closure is forbidden ([effects](effects.md)). +### Checked boundaries and stored representation contracts + +Keep three facts separate until a representation conversion has been planned: + +1. The source definition scheme and the checked type at this particular use. +2. The representation actually produced or stored by the definition, including + a closure's complete parameter/result signature. +3. The representation required by the consumer. + +Source checking owns scheme instantiation, subsumption, binder scope and field +compatibility. P8 consumes that result together with representation mappings; +it does not extend source compatibility to accommodate rewritten types. A +checked relation is attached to a particular boundary and immutable source +artifact. Type IDs alone, declaration arity, or a set of successful matcher +node pairs are insufficient: evidence must preserve relation direction, +quantifier scope, substitutions and the argument/result or field position to +which it applies. Contravariant parameters reverse the checking direction; +they do not make the evidence interchangeable with arbitrary endpoint pairs. + +The planning inputs have the following conceptual shape; these are compiler +contracts, not runtime fields: + +```text +Boundary = CallFrame | Return | Field | Element | Capture +CheckedBoundary = { source_artifact, boundary_position, scoped_type_relation } +RepresentationView = { source_use_or_generated_plan, value_shape, stored_protocol } +ConversionPlan = { checked_boundary, producer_view, consumer_view, operation_tree } +``` + +`source_use_or_generated_plan` identifies either a checked source type in its +binder environment or the plan that authorized a synthetic endpoint. An erased +value shape does not remove `stored_protocol` from planning. CC receives the +resulting explicit operations and signatures; it does not receive a runtime +constructor identity or type witness. + +A bare variable `a` can transport an existing reference object unchanged. Its +recovery contract is the representation established when the value entered +that slot. An application `f a` also hides its constructor. A generic method +may produce a new value of that application, so recovering it requires the +constructor transport contract shared by the method implementation and its +generic consumers, rather than a guess from the consumer's concrete type. +The same requirement applies to `f Unit`; a fixed argument does not establish +the stored calling convention of a value returned through a generic method. + +At a checked instantiation of `f`, the representation owner supplies that +constructor's transport protocol. For a callable constructor it specifies the +fixed parameters and the result protocol; for arrays it uses the canonical +element layout; ADTs retain their declared field storage contracts. Partial +constructor applications retain their fixed arguments. This is representation +lowering, not runtime instance selection. It neither requires a runtime type +tag nor authorizes erasing every constructor argument unconditionally. + +Dictionary selection determines the implementation to call. A shared generic +body and that implementation still have definition ABIs. Direct calling or +specializing a known dictionary may remove a boundary, but the unspecialized +path must satisfy the same transport contract. Dictionary fields, callbacks, +returns, captures and ordinary functions use the common conversion planner. + +Source types and checked boundary evidence remain available until P8 emits +explicit conversion operations with exact physical endpoints. Representation +lowering must not overwrite the authoritative source type arena and then +reconstruct source relations from closure signatures. A synthesized adapter +endpoint can be representation-only: its validity follows from its conversion +plan and signature, without inventing a source constructor for it. + ### Erased values and boxes The erased representation is `eqref`, a non-null reference. Concrete values @@ -198,8 +264,9 @@ an `eqref` cast alone is not that conversion. turning a string into an integer. The i31 shorthand is used only for closure *captures*, not for the general erased protocol (see [data representation](data-representation.md)). -The empty-erasure case (an erased value used where an erased value is expected) -is an identity, so nested polymorphic boundaries add no work. +The empty-erasure case is an identity when both endpoints share the same stored +representation contract. Equal `Erased` shapes alone do not prove that two +hidden closure or aggregate protocols agree. ### Dictionaries @@ -337,19 +404,61 @@ constructors such as `Array a` still retain their canonical layouts. A type variable nested in an ADT field continues to follow [DEC-07](../../../decision/DEC-07-runtime-representation-for-parameterized-adts.md). +### Planning a checked representation boundary + +All typed boundaries use one planning operation, including direct and indirect +calls, partial applications, returned functions, dictionary fields, aggregate +elements and lifted captures: + +```text +plan(checked_boundary, producer_contract, consumer_contract): + validate boundary ownership, scope and endpoint positions + obtain source/use relation from the source checking owner + obtain physical views and transport protocols from representation lowering + if both contracts agree: + Identity + else: + recursively plan scalar, reference, callable and aggregate conversions + reject any recovery whose stored representation cannot be established + +emit(plan, value): + emit the plan's exact source/target shapes and signatures + verify generated adapter bodies, captures and calls +``` + +Planning retains semantic evidence; emission consumes the completed plan. +Emission must not rerun source matching for representation-only adapter types, +search a module for a plausible signature, or recover directly to the desired +consumer signature. A function conversion first establishes the stored +producer signature, then generates an adapter if the consumer signature differs. +Producer erasure and consumer recovery use the same protocol. For example, an +abstract callable-constructor protocol may transport a closure with a fixed +parameter and erased result; entering it adapts the result before erasure, +and leaving it recovers that closure before adapting to the concrete result. + +Representation owners contribute mappings and protocols to this common +operation. An Effect owner supplies the trusted application-to-token-closure +mapping; it does not collect separate call, dictionary or field evidence. +Planning context is explicit and belongs to a boundary. Ambient Effect-specific +matcher state is not a substitute for that context. + ### Boxing and unboxing ```text -adapt(value, source_type, destination_type): - if destination_type is a bare type variable: +adapt(value, checked_boundary, stored_contract, consumer_contract): + validate the checked plan and its endpoint contracts + if consumer is a bare type-variable slot: scalar -> allocate its existing erased box reference -> RepresentationCast(value, Erased) - else if source_type and destination_type are aggregate types: - AggregateConvert(value, plan_for(source_type, destination_type)) - else if source_type is erased and destination_type is a concrete scalar: - project the typed box and unbox - else if source and destination reference shapes agree: - use identity or the compatible erased reference cast + else if stored and consumer contracts require aggregate conversion: + AggregateConvert(value, checked recursive plan) + else if value is erased: + recover the box, layout or callable signature established by storage + apply the remaining plan to reach the consumer contract + else if callable signatures differ: + generate the checked function adapter + else if physical shapes and storage protocols agree: + Identity otherwise: report a source-spanned unsupported conversion ``` @@ -375,26 +484,26 @@ payload. Unwrapping a newtype never allocates a separate wrapper object. ### Adapter generation ```text -adapt(value, concrete_type, generic_type): - source = function_signature(concrete_type) - target = function_signature(generic_type) +adapt(value, checked_callable_plan): + source = checked_callable_plan.producer_signature + target = checked_callable_plan.consumer_signature require source and target have equal arity adapter: captured = ClosureGetCapture(closure = adapter_closure, index = 0) - concrete = RepresentationCast(captured, Closure(signature(concrete_type))) - args' = for each (arg, source_param, target_param): - source erased and target concrete -> box(arg) - source concrete and target erased -> unbox(arg, source_param) - otherwise -> arg - result = IndirectCall(concrete, signature(concrete_type), args') - return target erased and source concrete -> box(result) - target concrete and source erased -> unbox(result, target) - otherwise -> result - - emit FunctionRef(adapter, signature(generic_type), captures = [value]) + producer = RepresentationCast(captured, Closure(source)) + args' = emit each checked target-parameter -> source-parameter plan + result = IndirectCall(producer, source, args') + return emit the checked source-result -> target-result plan + + emit FunctionRef(adapter, target, captures = [value]) ``` +This is the equal-arity branch. Curried and eta-expanded adapters segment the +call at quantifier and representation-closure boundaries and use the same +checked plans for each segment; they do not flatten a returned closure into +the producer's own parameters. + The original `value` is named once and captured; the adapter body is verified against the CC signatures and representations exactly like a source function before it is added to the module. @@ -434,6 +543,13 @@ The erased requirement itself is produced by the CC representation model as non-null `eqref` reference (`RefType { nullable: false, heap: Eq }`). No module may attach a runtime type tag to an erased value. +The source Core checking owner supplies scoped instantiation and compatibility +evidence. P8 representation lowering supplies source-to-physical mappings and +storage protocols. `cc/lower/conversion/` combines those inputs into the common +plan; `cc/lower/erased/` emits its callable leaves. Extracting evidence must +preserve the source checker's acceptance contract. Missing evidence is a +reported limitation, not a reason to silently strengthen or weaken subsumption. + **Required types and helpers.** CC owns representation-directed conversion and adapter generation. Its callable-shape and adapter entry points are: @@ -474,6 +590,9 @@ signatures map to one `SignatureId` and one MIR func type, so one The CC verifier: +- validates stored representation contracts and checked conversion-plan + endpoints before semantic evidence is discharged; equal erased shapes do + not authorize recovery to an arbitrary signature; - accepts `RepresentationTest`/`RepresentationCast` only when the source value is erased or the destination requirement is erased (`cc/verify/adaptation.rs`); @@ -497,6 +616,13 @@ The MIR verifier then checks the concrete side: Failure is a compiler bug or an unsupported program, reported with the operation's source span. +If P8 uses an internal Core-shaped materialization, it is a distinct lowered +representation with a complete structural verifier. Checking source Core and +selected rewritten types alone does not verify its expressions, generated +declarations, suspension wrappers or entry adapter. Removing source verification +from a physical view requires replacing it with these target contracts; it +does not remove the verification obligation. + ## Worked example ### Polymorphic identity diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index 8902fbf8..5c0cf02f 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -17,6 +17,19 @@ records below describe the earlier encoding and are not the current evidence. ## Scope and dependencies +The abstract-constructor/dictionary closure boundary is landed in the +vendored-library iteration. The 2026-10-05 +[constructor investigation](polymorphism-and-erasure.md#constructor-and-closure-investigation-2026-10-05) +reproduces a matching producer/consumer signature failure without Effect. At +`675f0e3` the discard, delayed-map, and fixed-payload Effect cases compiled +and then trapped. The landed checkpoint recorded there executes those three +programs and the Reader reproduction, and the transport contract is the same +one PE-13 verifies. Historical EF evidence below does not establish that +boundary. The general checked-conversion contract owns the repair; Effect +contributes its trusted token protocol. On this tree the L6/M7 scoreboard moved +from 164/413 to 207/413 and the D-04 and README runtime rows are updated; L1–L5 +are unchanged. + Complete the linked design's `Effect a` representation, `pure`, `bind`, `runEffect`, hidden execution token, and sequencing through CC/MIR/Wasm. An Effect value defers its operation until an explicit source runner or the @@ -49,6 +62,7 @@ Verified row needs behavior-sensitive execution, not only a closure-shaped IR. | EF-11 | Structural verification checks trusted identities and checked WIT operation signatures, every recorded Effect application closure, each import plan against its host wrapper, and the complete transformed Core including generated wrappers. | Malformed identity, checked WIT scheme, import-plan, closure-shape, wrapper-signature, and post-wrapper Core fixtures fail before CC/encoding; these checks are reported as structural evidence only. | Verified | | EF-12 | `trap` is the `Effect Unit` whose application ends the guest instead of returning, and the effect chain sequenced after it does not run. | A failing library assertion writes its message and traps; a held one lets the program finish; a statement after the trap never writes. | Verified | | EF-13 | Entry selection resolves one source declaration: prefer `Main.main`, otherwise require a unique top-level `main`. The same `SymbolId` drives the runner check and any generated adapter; accepted result types are `Int` and trusted `Effect Unit`. | Source tests for preferred/fallback/ambiguous selection, aliases of `Effect Unit`, and agreement between selected identity, runner diagnostic, and generated adapter. | Verified | +| EF-14 | Effect application-to-closure lowering composes with the common abstract-constructor transport protocol across generic functions, dictionary methods and callbacks. | Execute discard, delayed map and `f Unit` cases with mandatory Wasmtime and exact output/status; retain the non-Effect Reader regression and verify the complete lowered representation. | Verified | ## Current evidence (2026-10-04) @@ -118,6 +132,32 @@ EF-13: Result: pass. Selection prefers Main.main, otherwise one top-level main. Effect Int is rejected. Effect Unit synonyms are accepted. Gaps: files with no selected main stay scoreboard blockers (63). +EF-14: + Implementation: crates/psrs-core/src/instantiation.rs (checked + instantiation), crates/psrs-backend/src/effects/mod.rs (the Effect + representation owner contributes the runtime token as the `Effect` + constructor protocol), crates/psrs-backend/src/cc/lower/conversion/ + (transport.rs and callable.rs) and cc/lower/{global,record,erased} + (evidence threaded to each boundary). + Tests: tests::effects::discard_defined_from_bind_sequences_effects (stdout + `a\nb\n`, exit 0); tests::functor:: + mapping_an_effect_does_not_run_it_until_the_action_runs (stdout + `before\ntick\n2\n`, exit 0); tests::closure_protocol:: + fixed_unit_payload_through_a_bind_constraint_repeats_the_action + (`forall f. Bind f => f Unit -> f Unit` at Effect, stdout `again\nagain\n`, + exit 0) and reader_dictionary_returns_the_concrete_result (the non-Effect + regression, exit 42); tests::closure_protocol:: + abstract_callable_transport_emits_a_checked_adapter (the generated adapter + and factory). + Input boundary: source; executed Wasm component. + Commands: PSRS_REQUIRE_WASMTIME=1 cargo test --workspace. + Result: pass. The Effect discard, delayed-map, and fixed-payload programs + run to completion with the exact output and status, and the non-Effect + Reader regression still returns 42. + Revision: 675f0e3 plus this slice. + Gaps: an under-applied or indirectly applied dictionary method is rejected + before adapters; that indirect/partial-application gap is shared with + PE-13 and recorded in [polymorphism and erasure](polymorphism-and-erasure.md). ``` ## Vertical execution order diff --git a/docs/implementation/backend/polymorphism-and-erasure.md b/docs/implementation/backend/polymorphism-and-erasure.md index c18ac093..0acd4c78 100644 --- a/docs/implementation/backend/polymorphism-and-erasure.md +++ b/docs/implementation/backend/polymorphism-and-erasure.md @@ -46,6 +46,7 @@ existing code or a fixture that only inspects WAT does not verify execution. | PE-10 | CC and MIR verifiers reject malformed adapters, captures, calls, and unresolved representation requirements. | Full-module negative fixtures for wrong signature, capture index/type, arity, cast provenance, and result shape before Wasm emission. | Verified | | PE-11 | Erased values are recovered before canonical WIT calls; optimized and unspecialized execution agree. | Source or verified Core fixture crossing a concrete ABI call, plus execution retaining an erased generic path and normal optimized execution. | Verified | | PE-12 | Nested quantifiers preserve each value's uniform definition signature, independent use-site conversions, and returned closure arity. | Verified Core and source execution at distinct instantiations; quantified parameters, fields, captures, returned functions and direct over-application; malformed boundary rejection. Coordinate RN-02 through RN-11. | Unverified | +| PE-13 | Abstract constructor applications preserve their producer storage protocol across generic calls, dictionary methods and returned closures. Source evidence survives until a common conversion plan fixes both physical endpoints. | Mandatory value-sensitive execution of the non-Effect Reader dictionary reproduction below, Effect discard/map and fixed-payload cases; inspect producer/recovery signatures; retain ordinary closure and aggregate regressions. | Verified | ## Vertical execution order @@ -270,10 +271,80 @@ PE-11: Revision: cc5d0f4 + audit diff. Gaps: there is no separate unspecialized compiler mode; the erased path is the one path and it is the executed path. + +PE-13: + Implementation: psrs-core/src/instantiation.rs (read-only checked + instantiation evidence), psrs-core/src/verify/types/matching/invariant.rs + (invariant matcher with explicit constructor binding), psrs-backend/src/ + cc/lower/instantiation.rs (scheme/use evidence that borrows the immutable + source module), cc/lower/conversion/transport.rs (constructor transport), + cc/lower/conversion/callable.rs (representation-only adapter emission), + cc/lower/conversion/mod.rs (plan_conversion consults transport first), + cc/lower/erased/mod.rs and cc/lower/{global,record}/mod.rs (evidence + threaded to the boundary), cc/layout/functions/mod.rs + (transport_signatures registers the producer protocol). + Tests: psrs-driver tests::closure_protocol:: + reader_dictionary_returns_the_concrete_result (Reader `Chain ((->) Int)` + exits 42 with empty stdout), + abstract_callable_transport_emits_a_checked_adapter (the CC contains a + FunctionAdapter, a `protocol_adapter_factory_` capturing the producer + protocol closure, and a generated adapter returning `ValueShape::Integer`), + fixed_unit_payload_through_a_bind_constraint_repeats_the_action + (`forall f. Bind f => f Unit -> f Unit` at Effect prints `again` twice); + psrs-core tests::instantiation (distinct nominal applications rejected, + flexible heads bind from either side, dictionary quantifiers alpha-rename, + unsolved and cyclic bindings are not constructor identities); + psrs-driver tests::effects::discard_defined_from_bind_sequences_effects + (`a\nb\n`); psrs-driver tests::functor:: + mapping_an_effect_does_not_run_it_until_the_action_runs (`before\ntick\n2\n`). + Input boundary: linked source and source plus a verified CC module. + Commands: PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib + closure_protocol; PSRS_REQUIRE_WASMTIME=1 cargo test --workspace. + Result: pass. The Reader method and its caller recover the stored protocol + and adapt; a reference cast is not used as the adapter. The Effect discard, + delayed-map and fixed-payload cases run to completion with the exact + output. The L6/M7 scoreboard moved from 164/413 to 207/413 on this tree: + the stored-protocol recovery cleared 29 of the 30 P8 CC verifier failures + and 17 of the 19 runtime traps. L1–L5 are unchanged. The workspace suite is + not fully green: ten pre-existing Phase-3 failures (bare library operators + that now need an import, a local `Data.Boolean` that duplicates the vendored + module, `Newtype`/`Coercible` type checking on the official `Data.Foldable` + and `Data.Monoid`, a resolver `ScopeConflict`, and a class-mediated + constant fold) are unrelated to this topic and are recorded under remaining + work. + Revision: 675f0e3 plus this slice. + Gaps: a partially applied or indirectly applied dictionary method (for + example `let step = chain action`) is still rejected before adapters; that + is an indirect partial-application gap independent of the transport + contract, and it is recorded under remaining work. ``` ## Remaining work and blockers +- **Abstract constructor and closure transport (PE-13, landed).** The 2026-10-05 + investigation below reproduces the runtime failure without Effect. The + repair is now landed and tested: the non-Effect Reader dictionary, Effect + `discard`, delayed map, and fixed-payload `f Unit` programs execute, and the + abstract callable boundary recovers the producer's stored protocol before + generating an adapter (see the PE-13 evidence). The L6/M7 scoreboard moved + from 164/413 to 207/413. What remains is an + indirect/partial-application gap: a dictionary method that is under-applied + (`let step = chain action`) or applied through a local callee is still + rejected before adapters, and constructors other than `Function` and the + registered Effect token protocol do not each have explicit execution + evidence. The two experimental worktrees are stopped and are not integrated. +- **Workspace suite still red on the Phase-3 migration.** Ten driver tests fail + for reasons this topic does not own: five use `-` or `/` without importing the + library operator that now owns it (`tests::scalars`, `tests::functions`, + `tests::operators` twice, and + `polymorphism_erasure_audit::linked_modules_round_trip_an_erased_high_bit_int`); + two declare a local `Data.Boolean` that the vendored library now also + provides (`tests::guards`); one folds `+` through the `Data.Semiring` class + and no longer reaches `i32.const 42` (`tests::integration`); one expects a + resolver `ScopeConflict` (`tests::declarations`); and one needs + `Newtype`/`Coercible` type checking on the official `Data.Foldable` and + `Data.Monoid` (`tests::foldable`). `cargo clippy --workspace --all-targets -- + -D warnings` also reports pre-existing lints on the same branch. - **MIR RefCast/RefTest nullability handoff.** `mir/verify/instruction` checks the cast target heap and destination type but does not reject a nullable operand or mismatched operand/target nullability; tightening it is owned by @@ -300,3 +371,161 @@ PE-11: erased identity fixture; type-class dictionaries and returned polymorphic functions remain independently tracked in [type classes and dictionaries](type-classes-and-dictionaries.md). + +## Constructor and closure investigation (2026-10-05) + +### Baseline and classification + +Revision `675f0e3` on `stdlib/vendor-core-libraries`. Experiments used a clean +`git archive` of that revision, built with `cargo build --offline -p psrs-cli +--bin psrs`, and Wasmtime 49.0.2. The active implementation checkout is the +main worktree on that existing iteration branch. No experimental Rust diff was +transferred there. No workspace suite or official scoreboard was run, and no +D-04 or README rate was changed. + +The independent reproduction defines its own class and does not import Prelude, +Effect, a host service or a trusted Effect operation: + +```purescript +module Main where + +class Chain f where + chain :: forall a b. f a -> (a -> f b) -> f b + +instance chainReader :: Chain ((->) Int) where + chain m k x = k (m x) x + +repeatAction :: forall f. Chain f => f Int -> f Int +repeatAction action = chain action (\_ -> action) + +action :: Int -> Int +action x = x + +main :: Int +main = repeatAction action 42 +``` + +Compilation succeeds. Expected exit is 42 with empty stdout; actual exit is +134 with `wasm trap: cast failure`. In the emitted core module, function 14 +constructs a closure using `ref.func 13`, whose code type 9 is +`(ref struct, i32) -> eqref`. Function 16 receives the returned erased closure, +recovers it, and casts its code reference to type 10, +`(ref struct, i32) -> i32`, before `call_ref 10`. The generated CC records direct +`RecoverReference(TypeInstantiation)` to the consumer closure signature. +This is a producer/consumer calling-convention mismatch, not an Effect +operation or runtime instance-selection failure. Function/type numbers are +evidence for this artifact only. + +The same clean build measured these small source cases: + +| Case | Expected behavior | Observed behavior | +| --- | --- | --- | +| Generic `apply` receives a locally generalized identity | Exit 42, no stdout | Exit 42, no stdout | +| A closure passes through `forall a. a -> a` | Exit 42, no stdout | Exit 42, no stdout | +| A closure passes through a `Box a` constructor and projection | Exit 42, no stdout | Exit 42, no stdout | +| A closure is forwarded through `forall f a. f a -> f a` | Exit 42, no stdout | Exit 42, no stdout | +| Custom Reader `Chain` example above | Exit 42, no stdout | Cast trap, exit 134 | +| Effect `discard` | Exit 0, `a\nb\n` | Cast trap, exit 134, empty stdout | +| Mapping an Effect action | Exit 0, `before\ntick\n2\n` | Cast trap, exit 134, empty stdout | +| `forall f. Bind f => f Unit -> f Unit` instantiated at Effect | Exit 0, `again\nagain\n` | Cast trap, exit 134, empty stdout | +| Reader examples using the vendored Prelude instances | Compile, then execute | Rejected at P7; no runtime result | + +The passing forwarding case shows that erasure does not always require an +adapter. The failing Reader dictionary establishes a general representation +contract gap. It does not prove that every Effect failure follows an identical +adapter chain or that one local patch repairs them all. Effect additionally +rewrites source applications before P8; its explicit source-to-physical mapping +must compose with the general repair. Keep the separate P7 Reader failure out +of the runtime diagnosis. + +Artifacts are preserved at +`/private/tmp/psrs-closure-representation-audit-20261005/`: source files, +`measurements.json`, build/runtime stdout and stderr, and Reader CC/MIR/WAT. +The recorded command form was `baseline/target/debug/psrs build .purs +-o .wasm`, followed by `wasmtime run .wasm`, from that directory. +Expected nonzero successful exits were checked as values, not as shell success. + +### Disposition of stopped candidates + +Both worktrees remain at base `675f0e3`, with uncommitted checkpoints and exported +patches. Neither is a repair suitable for integration: + +| Candidate | Useful investigation result | Disposition | +| --- | --- | --- | +| `fix/stdlib-closure-contract` | Established the lost constructor relation and exercised Core traversals | Reject the closure-origin field approach; preserve the checkpoint, do not apply it | +| `fix/stdlib-p8-effect-contract` | Explored immutable source/physical views, shared checking evidence and layout roots | Restart implementation from the existing iteration branch; do not transplant this diff | + +The second candidate routes the public conversion entry through +`effect_aware_conversion`, scopes `effect_instantiation`/`effect_compatibility` +state and gathers evidence primarily for saturated direct Global calls. This +does not define the ordinary Reader constructor protocol and leaves other +call/storage boundaries incomplete. Its flat symmetric node correspondences +do not preserve position, checking direction or binder context. Its extra +scheme projection can reject a previously successful match; evidence extraction +has not been shown to preserve the source checker's acceptance contract. +Removing the rewritten module's ordinary verification also left the complete +physical expression/declaration contract unverified. Focused proof tests and a +successful package check cannot establish these obligations or runtime repair. + +Retain the reproduced programs, signature traces and test intentions. Reuse the +ideas of immutable source views and Core-owned checked relations after defining +their general contracts; review any code extracted for those ideas separately. +The Core matcher must not infer a source constructor from callable arity. + +### Restart order and acceptance gates + +1. Fix the general boundary model before coding: definition/use relation, + producer storage protocol, consumer requirement and source-to-physical map. + Preserve quantifier boundaries, direction and field/application positions. +2. Define one checked conversion-plan API for ordinary callable constructors, + scalar boxes, arrays and ADT/record storage. Separate planning from emission; + representation-only adapter endpoints need a physical contract, not an + invented source origin. Evidence collection must not change source acceptance. +3. Implement and execute the minimal non-Effect Reader dictionary path through + this API. Cover both the method producer and returned-closure consumer; + direct/indirect calls and partial applications must use the same contract or + report unsupported boundaries explicitly. Preserve the passing controls. +4. Connect the trusted Effect application-to-closure mapping to that API. + Execute discard, delayed map and fixed-payload cases with exact output/status. + Check arrays, dictionary fields and captures through the recursive planner. +5. Verify the complete lowered representation and generated CC before erasing + semantic evidence. Then run the agreed focused regression scope. Workspace + tests, scoreboard measurements and completion claims remain separate gates. + +This is a design and investigation checkpoint. No replacement implementation +is claimed complete, and the historical evidence above does not close PE-13. + +### Landed execution checkpoint (2026-10-05) + +The main worktree on `stdlib/vendor-core-libraries`, based on `675f0e3`, keeps +an immutable Core snapshot from before `lower_effects`. Expression +instantiation and compatibility whose type ids still exist use that snapshot. +`Function` with one fixed argument supplies the Reader domain. The Effect +representation owner supplies the runtime token for a registered user +constructor with no instantiation arguments. Dictionary-field selection and a +generalized local use pass that checked instantiation into the common +conversion planner. The planner emits an adapter when the producer and +consumer protocols differ. A reference cast is not used as that adapter. + +Wasmtime 49.0.2 executed these programs from the current debug `psrs` binary. +Exit status is the program value, including Reader's 42. + +| Case | Result | +| --- | --- | +| Custom Reader `Chain` | Exit 42, empty stdout | +| Effect `discard` | Exit 0, stdout `a\nb\n` | +| Mapping an Effect action | Exit 0, stdout `before\ntick\n2\n` | +| `forall f. Bind f => f Unit -> f Unit` at Effect | Exit 0, stdout `again\nagain\n` | + +The Reader and fixed-payload cases are committed as +`crates/psrs-driver/src/tests/closure_protocol.rs` tests; the discard and map +cases are the existing `effects` and `functor` tests. The checkpoint closes +PE-13's acceptance. Indirect calls, partial applications, and binding +quantifiers that are not leading `forall` nodes on the type still need explicit +evidence review: an under-applied or indirectly applied dictionary method is +rejected before adapters, and this is an indirect/partial-application gap rather +than a transport-contract rule. Array, ADT, and newtype protocols still belong +to their representation owners. Unsupported constructor transport is rejected +with a source-spanned diagnostic. On this tree the L6/M7 scoreboard moved from +164/413 to 207/413, so the D-04 and README runtime rows are updated with it; +L1–L5 are unchanged. From 681d3f5a2baa718e28feac3b9bd3cc4bb33b654d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 17:24:15 +0800 Subject: [PATCH 009/148] Support under-application of indirect callees A callee that is not a top-level declaration - a local closure or a class method reached through a field access - was rejected when under-applied (`call expects N arguments but received M`). Only top-level declarations had a partial-application path. Add `lower_indirect_partial_application`: evaluate the callee and the supplied arguments, capture them, and emit a generated closure that exposes the remaining parameters and calls the captured callee indirectly. The generated closure is verified like any other function before it is added. Cover both an under-applied local closure and an under-applied dictionary method with Wasmtime execution. The L6/M7 scoreboard moved from 207/413 to 210/413: three corpus cases whose first blocker was P8 closure conversion now run. D-04 and README are updated. --- README.md | 2 +- .../src/cc/lower/call/application.rs | 30 ++- .../psrs-backend/src/cc/lower/call/partial.rs | 237 +++++++++++++++++- .../src/tests/partial_application.rs | 52 ++++ docs/design/D-04-suite-roadmap.md | 26 +- docs/implementation/backend/effects.md | 8 +- .../backend/polymorphism-and-erasure.md | 62 ++--- 7 files changed, 363 insertions(+), 54 deletions(-) diff --git a/README.md b/README.md index 8ba9f289..ff64a198 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ what remains in each layer. | L3 kinds | 39/48 failing | official kind `errorCode`s | | L4 types | 39/50 failing | official `errorCode`s | | L5 classes | 58/81 failing | official `errorCode`s | -| L6/M7 runtime | 207/413 passing | all 207 exit 0; 206 do not agree, including 47 with no selected `main` | +| L6/M7 runtime | 210/413 passing | all 210 exit 0; 203 do not agree, including 47 with no selected `main` | | M8 warnings, optimization | not measured | no scoreboard exists | Run the scoreboards yourself: diff --git a/crates/psrs-backend/src/cc/lower/call/application.rs b/crates/psrs-backend/src/cc/lower/call/application.rs index ce995c0d..6e9b0cef 100644 --- a/crates/psrs-backend/src/cc/lower/call/application.rs +++ b/crates/psrs-backend/src/cc/lower/call/application.rs @@ -5,7 +5,7 @@ use super::helpers::{ callable_parameter_types, callable_result_type, collect_application, conversion_reconstructs_aggregate, function_value_types, persist_reference, restore_reference, }; -use super::partial::PartialApplication; +use super::partial::{IndirectPartialApplication, PartialApplication}; use super::{ApplicationLowering, CallShape}; use crate::BackendError; use psrs_core::{Expr, ExprKind}; @@ -186,12 +186,6 @@ impl FunctionLowerer<'_> { self.record_types, self.function_types, )?; - self.check_call_shape( - &signature, - arguments.len(), - signature.result, - expression.span, - )?; let Some(signature_id) = function_type_signature(self.module, self.function_types, head.ty) else { return Err(vec![BackendError::new( @@ -200,6 +194,28 @@ impl FunctionLowerer<'_> { "higher-order call has no runtime function type", )]); }; + // An under-applied callee that is not a top-level declaration (a local + // closure or a dictionary method) captures the supplied arguments and + // exposes the remaining parameters through a generated closure. + if arguments.len() < signature.parameters.len() { + return self.lower_indirect_partial_application( + IndirectPartialApplication { + expression, + head, + arguments, + signature: &signature, + signature_id, + result_type, + }, + assignments, + ); + } + self.check_call_shape( + &signature, + arguments.len(), + signature.result, + expression.span, + )?; let (source_parameters, source_result) = function_value_types(self.module, head.ty); // The callee expression is lowered at its own use type, so its runtime // value already matches `head.ty`; no side-table adaptation is needed. diff --git a/crates/psrs-backend/src/cc/lower/call/partial.rs b/crates/psrs-backend/src/cc/lower/call/partial.rs index 4e3d2756..d7654f2f 100644 --- a/crates/psrs-backend/src/cc/lower/call/partial.rs +++ b/crates/psrs-backend/src/cc/lower/call/partial.rs @@ -1,6 +1,7 @@ -use super::super::super::layout::function_type_signature; +use super::super::super::layout::{function_arrow_parameters, function_type_signature}; use super::super::super::{ - Assignment, AssignmentKind, Function, RefShape, Reference, ValueConversion, ValueId, + Assignment, AssignmentKind, Function, RefShape, Reference, SignatureId, ValueConversion, + ValueId, }; use super::super::lambda::LambdaLowering; use super::super::{FunctionLowerer, Signature, ValueShape}; @@ -22,6 +23,19 @@ pub(super) struct PartialApplication<'a> { pub(super) callable_type: TypeId, } +/// An under-applied callee that is not a top-level declaration: a local +/// closure or a dictionary method reached through a field access. The supplied +/// arguments are captured and the remaining parameters are exposed by a +/// generated closure that calls the callee indirectly. +pub(super) struct IndirectPartialApplication<'a> { + pub(super) expression: &'a Expr, + pub(super) head: &'a Expr, + pub(super) arguments: Vec<&'a Expr>, + pub(super) signature: &'a Signature, + pub(super) signature_id: SignatureId, + pub(super) result_type: ValueShape, +} + impl FunctionLowerer<'_> { pub(super) fn lower_partial_global_application( &mut self, @@ -274,4 +288,223 @@ impl FunctionLowerer<'_> { )]) } } + + /// Under-application of a local closure or dictionary method. Mirrors + /// [`Self::lower_partial_global_application`] but calls the captured callee + /// value indirectly instead of a declaration symbol. + pub(super) fn lower_indirect_partial_application( + &mut self, + application: IndirectPartialApplication<'_>, + assignments: &mut Vec, + ) -> Result> { + let IndirectPartialApplication { + expression, + head, + arguments, + signature, + signature_id, + result_type, + } = application; + let Some(target_signature_id) = + function_type_signature(self.module, self.function_types, expression.ty) + else { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application has no runtime function type", + )]); + }; + let Some(target_signature) = self.representations.signature(target_signature_id).cloned() + else { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application has no target call signature", + )]); + }; + let source_parameter_types = function_arrow_parameters(self.module, head.ty).0; + if source_parameter_types.len() != signature.parameters.len() { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application has an incomplete callee signature", + )]); + } + + // Convert each supplied argument to the callee's expected parameter + // shape; each becomes a capture of the generated closure. + let mut capture_conversions = Vec::with_capacity(arguments.len()); + for (index, argument) in arguments.iter().enumerate() { + let expected = signature.parameters[index]; + let source_shape = self.value_shape(argument.ty, argument.span)?; + let conversion = self.typed_conversion( + argument.ty, + source_parameter_types[index], + source_shape, + expected, + expression.span, + )?; + capture_conversions.push((source_shape, conversion)); + } + + let callee = self.lower_value(head, assignments)?; + let callee_type = self + .values + .iter() + .find(|declaration| declaration.id == callee) + .map(|declaration| declaration.ty) + .ok_or_else(|| { + vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application callee has no runtime type", + )] + })?; + let mut captured = Vec::with_capacity(arguments.len() + 1); + captured.push(callee); + for (index, argument) in arguments.iter().enumerate() { + let value = self.lower_value(argument, assignments)?; + let expected = signature.parameters[index]; + let (source_shape, conversion) = capture_conversions[index].clone(); + let converted = self.emit_conversion( + value, + source_shape, + expected, + conversion, + expression.span, + assignments, + ); + captured.push(converted); + } + + let mut nested = self.child_lowerer(); + let closure_parameter = nested.fresh(closure_value_type()); + let mut parameters = vec![closure_parameter]; + let mut remaining_parameters = Vec::with_capacity(target_signature.parameters.len()); + for expected in &target_signature.parameters { + let parameter = nested.fresh(*expected); + parameters.push(parameter); + remaining_parameters.push(parameter); + } + let mut nested_assignments = Vec::with_capacity(signature.parameters.len() + 1); + let mut call_arguments = Vec::with_capacity(signature.parameters.len()); + let callee_capture = nested.fresh(callee_type); + nested_assignments.push(Assignment { + destination: callee_capture, + kind: AssignmentKind::ClosureGetCapture { + closure: closure_parameter, + index: 0, + }, + span: expression.span, + }); + for (index, expected) in signature.parameters[..arguments.len()].iter().enumerate() { + let destination = nested.fresh(*expected); + nested_assignments.push(Assignment { + destination, + kind: AssignmentKind::ClosureGetCapture { + closure: closure_parameter, + index: (index + 1) as u32, + }, + span: expression.span, + }); + call_arguments.push(destination); + } + // A remaining parameter carries the expression's concrete shape, but + // the callee stores its parameter erased. Convert it the way the + // declaration partial application does. + for (index, parameter) in remaining_parameters.into_iter().enumerate() { + let position = arguments.len() + index; + let source_type = source_parameter_types[position]; + let source_shape = target_signature.parameters[index]; + let expected = signature.parameters[position]; + let conversion = nested.typed_conversion( + source_type, + source_type, + source_shape, + expected, + expression.span, + )?; + let converted = nested.emit_conversion( + parameter, + source_shape, + expected, + conversion, + expression.span, + &mut nested_assignments, + ); + call_arguments.push(converted); + } + if signature.result != target_signature.result { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application result does not match the callee result", + )]); + } + let result = nested.fresh(signature.result); + nested_assignments.push(Assignment { + destination: result, + kind: AssignmentKind::IndirectCall { + function: callee_capture, + signature: signature_id, + arguments: call_arguments, + }, + span: expression.span, + }); + + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let generated = Function { + symbol, + name: format!("partial_indirect_{}", expression.span.start), + parameters, + values: nested.values, + assignments: nested_assignments, + result, + result_type: target_signature.result, + span: expression.span, + }; + crate::cc::verify::verify_function(&generated, self.signatures, self.representations)?; + self.generated.extend(nested.generated); + self.generated.push(generated); + + let closure = self.fresh(closure_value_type_for(target_signature_id)); + assignments.push(Assignment { + destination: closure, + kind: AssignmentKind::FunctionRef { + function: symbol, + signature: target_signature_id, + captures: captured, + }, + span: expression.span, + }); + if result_type == closure_value_type_for(target_signature_id) { + Ok(closure) + } else if result_type + == ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }) + { + let erased = self.fresh(result_type); + assignments.push(Assignment { + destination: erased, + kind: AssignmentKind::RepresentationCast { + destination: erased, + value: closure, + reference: Reference { + nullable: false, + heap: RefShape::Erased, + }, + }, + span: expression.span, + }); + Ok(erased) + } else { + Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application result has the wrong runtime type", + )]) + } + } } diff --git a/crates/psrs-driver/src/tests/partial_application.rs b/crates/psrs-driver/src/tests/partial_application.rs index 8785dc49..35cb8ac5 100644 --- a/crates/psrs-driver/src/tests/partial_application.rs +++ b/crates/psrs-driver/src/tests/partial_application.rs @@ -48,3 +48,55 @@ main = flip (\a b -> a + b) 20 22 }; assert_eq!(output.status.code(), Some(42), "{output:?}"); } + +#[test] +fn a_partial_application_of_a_local_closure_defers_the_remaining_argument() { + // The callee is a local value, not a top-level declaration, so the + // remaining parameter is exposed by a generated closure that calls the + // captured callee indirectly. + let source = r#" +module Main where + +main :: Int +main = + let combine = \a b -> intAdd a b + in let step = combine 20 + in step 22 +"#; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn a_partial_application_of_a_dictionary_method_defers_the_remaining_argument() { + // A class method reached through a field access is also an indirect + // callee; its result still names the abstract constructor. + let source = r#" +module Main where + +class Chain f where + chain :: forall a b. f a -> (a -> f b) -> f b + +instance chainReader :: Chain ((->) Int) where + chain m k x = k (m x) x + +action :: Int -> Int +action x = x + +run :: forall f. Chain f => f Int -> f Int +run a = + let step = chain a + in step (\_ -> a) + +main :: Int +main = run action 42 +"#; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index a6f7bf8d..8730aaa9 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -721,12 +721,12 @@ the code reference and an immutable capture array. file. - **Prerequisite:** M2–M6. -**Progress (measured by `runtime::l6_runtime_scoreboard`):** **207 of 413** +**Progress (measured by `runtime::l6_runtime_scoreboard`):** **210 of 413** non-FFI `passing` files compile, validate, and run; all exit 0. Twenty-six FFI -files are excluded. Of the other 206 cases, 204 block before runtime and 2 +files are excluded. Of the other 203 cases, 201 block before runtime and 2 trap while running. The largest current blockers are P5 typechecking (68), P10 -files with no selected `main` (47), P3 resolution (23), and P8 closure -conversion (18). This measurement does not emit an empty main or change the 413 +files with no selected `main` (47), P3 resolution (23), and P5 kind checking +(16). This measurement does not emit an empty main or change the 413 denominator. The board compiles each case with the on-disk standard library on the module path. Separate vertical execution tests run under mandatory Wasmtime for GC strings, arrays, @@ -734,12 +734,14 @@ closed records, erased newtypes, parameterized ADTs, closures, dictionaries, effects, the component path, and pattern-matrix behavior including the value-sensitive `1185.purs` and `2049.purs` shapes. -The 43-case move from the earlier 164 measurement is the -[abstract-constructor transport contract](backend/fp/polymorphism-and-erasure.md): -recovering a stored closure protocol and generating an adapter, instead of -casting the erased closure onto the consumer signature, eliminated 29 of the 30 -P8 CC verifier failures and 17 of the 19 runtime traps; five of those cases then -surfaced at a later blocker. +The 46-case move from the earlier 164 measurement combines the +[abstract-constructor transport contract](backend/fp/polymorphism-and-erasure.md) +and its indirect partial-application path. Recovering a stored closure protocol +and generating an adapter, instead of casting the erased closure onto the +consumer signature, cleared 29 of the 30 P8 CC verifier failures and 17 of the +19 runtime traps; allowing an under-applied local closure or dictionary method +to expose its remaining parameter cleared three more P8 closure-conversion +failures. Five of the recovered cases then surfaced at a later blocker. Agreement here means the pipeline compiles the file, the component passes Wasm validation, and the guest runs to completion without trapping. The corpus @@ -750,7 +752,7 @@ failure must reach the guest as a trap to be visible, which is the only execution signal the corpus can express. Nothing in the corpus needs argv, stdin, or a preopened directory, so the runner passes none. -The 206 non-agreements, by the first phase that blocks them or runtime outcome. +The 203 non-agreements, by the first phase that blocks them or runtime outcome. These are from the latest `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` run of all five boards on 2026-10-05 (Wasmtime 49.0.2, `purs` 0.15.16): @@ -759,8 +761,8 @@ of all five boards on 2026-10-05 (Wasmtime 49.0.2, `purs` 0.15.16): | P5 typecheck | 68 | Type and class inference gaps behind earlier-stage blockers. | | P10 Wasm structuring | 47 | No selected `main`. | | P3 resolve | 23 | Remaining name and import resolution gaps. | -| P8 closure conversion | 18 | Unsupported or inconsistent runtime representations. | | P5 kind check | 16 | Kind checking gaps. | +| P8 closure conversion | 15 | Unsupported or inconsistent runtime representations. | | P0 lex | 4 | DEC-16 lone-surrogate cases, also recorded as L1 differences. | | P7 Core verification | 3 | A typed Core expression has an inconsistent context type. | | P8 CC verification | 1 | A call whose arguments do not match its signature. | diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index 5c0cf02f..625047e4 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -27,7 +27,7 @@ programs and the Reader reproduction, and the transport contract is the same one PE-13 verifies. Historical EF evidence below does not establish that boundary. The general checked-conversion contract owns the repair; Effect contributes its trusted token protocol. On this tree the L6/M7 scoreboard moved -from 164/413 to 207/413 and the D-04 and README runtime rows are updated; L1–L5 +from 164/413 to 210/413 and the D-04 and README runtime rows are updated; L1–L5 are unchanged. Complete the linked design's `Effect a` representation, `pure`, `bind`, @@ -155,9 +155,9 @@ EF-14: run to completion with the exact output and status, and the non-Effect Reader regression still returns 42. Revision: 675f0e3 plus this slice. - Gaps: an under-applied or indirectly applied dictionary method is rejected - before adapters; that indirect/partial-application gap is shared with - PE-13 and recorded in [polymorphism and erasure](polymorphism-and-erasure.md). + Gaps: none. Under-application of an indirect callee, including a dictionary + method, is lowered by the same generated indirect call the PE-13 evidence + records for [polymorphism and erasure](polymorphism-and-erasure.md). ``` ## Vertical execution order diff --git a/docs/implementation/backend/polymorphism-and-erasure.md b/docs/implementation/backend/polymorphism-and-erasure.md index 0acd4c78..5d7ffd2a 100644 --- a/docs/implementation/backend/polymorphism-and-erasure.md +++ b/docs/implementation/backend/polymorphism-and-erasure.md @@ -281,7 +281,9 @@ PE-13: cc/lower/conversion/callable.rs (representation-only adapter emission), cc/lower/conversion/mod.rs (plan_conversion consults transport first), cc/lower/erased/mod.rs and cc/lower/{global,record}/mod.rs (evidence - threaded to the boundary), cc/layout/functions/mod.rs + threaded to the boundary), cc/lower/call/partial.rs + (lower_indirect_partial_application captures an under-applied local or + dictionary callee), cc/layout/functions/mod.rs (transport_signatures registers the producer protocol). Tests: psrs-driver tests::closure_protocol:: reader_dictionary_returns_the_concrete_result (Reader `Chain ((->) Int)` @@ -291,6 +293,9 @@ PE-13: protocol closure, and a generated adapter returning `ValueShape::Integer`), fixed_unit_payload_through_a_bind_constraint_repeats_the_action (`forall f. Bind f => f Unit -> f Unit` at Effect prints `again` twice); + psrs-driver tests::partial_application:: + a_partial_application_of_a_local_closure_defers_the_remaining_argument and + a_partial_application_of_a_dictionary_method_defers_the_remaining_argument; psrs-core tests::instantiation (distinct nominal applications rejected, flexible heads bind from either side, dictionary quantifiers alpha-rename, unsolved and cyclic bindings are not constructor identities); @@ -303,20 +308,21 @@ PE-13: Result: pass. The Reader method and its caller recover the stored protocol and adapt; a reference cast is not used as the adapter. The Effect discard, delayed-map and fixed-payload cases run to completion with the exact - output. The L6/M7 scoreboard moved from 164/413 to 207/413 on this tree: - the stored-protocol recovery cleared 29 of the 30 P8 CC verifier failures - and 17 of the 19 runtime traps. L1–L5 are unchanged. The workspace suite is - not fully green: ten pre-existing Phase-3 failures (bare library operators - that now need an import, a local `Data.Boolean` that duplicates the vendored - module, `Newtype`/`Coercible` type checking on the official `Data.Foldable` - and `Data.Monoid`, a resolver `ScopeConflict`, and a class-mediated - constant fold) are unrelated to this topic and are recorded under remaining - work. + output, and an under-applied local closure or dictionary method exposes its + remaining parameter through a generated indirect call. The L6/M7 scoreboard + moved from 164/413 to 210/413 on this tree: the stored-protocol recovery + cleared 29 of the 30 P8 CC verifier failures and 17 of the 19 runtime traps, + and the indirect partial-application handling cleared three more + closure-conversion failures. L1–L5 are unchanged. The workspace suite is not fully green: ten + pre-existing Phase-3 failures (bare library operators that now need an + import, a local `Data.Boolean` that duplicates the vendored module, + `Newtype`/`Coercible` type checking on the official `Data.Foldable` and + `Data.Monoid`, a resolver `ScopeConflict`, and a class-mediated constant + fold) are unrelated to this topic and are recorded under remaining work. Revision: 675f0e3 plus this slice. - Gaps: a partially applied or indirectly applied dictionary method (for - example `let step = chain action`) is still rejected before adapters; that - is an indirect partial-application gap independent of the transport - contract, and it is recorded under remaining work. + Gaps: none for the Reader, discard, delayed-map and fixed-payload cases. + Binding quantifiers that are not leading `forall` nodes on the type still + need explicit evidence review. ``` ## Remaining work and blockers @@ -327,12 +333,12 @@ PE-13: `discard`, delayed map, and fixed-payload `f Unit` programs execute, and the abstract callable boundary recovers the producer's stored protocol before generating an adapter (see the PE-13 evidence). The L6/M7 scoreboard moved - from 164/413 to 207/413. What remains is an - indirect/partial-application gap: a dictionary method that is under-applied - (`let step = chain action`) or applied through a local callee is still - rejected before adapters, and constructors other than `Function` and the - registered Effect token protocol do not each have explicit execution - evidence. The two experimental worktrees are stopped and are not integrated. + from 164/413 to 210/413. An under-applied local closure or dictionary method + is supported by a generated closure that calls the captured callee + indirectly. What remains is binding quantifiers that are not leading `forall` + nodes on the type, and constructors other than `Function` and the registered + Effect token protocol do not each have explicit execution evidence. The two + experimental worktrees are stopped and are not integrated. - **Workspace suite still red on the Phase-3 migration.** Ten driver tests fail for reasons this topic does not own: five use `-` or `/` without importing the library operator that now owns it (`tests::scalars`, `tests::functions`, @@ -519,13 +525,13 @@ Exit status is the program value, including Reader's 42. The Reader and fixed-payload cases are committed as `crates/psrs-driver/src/tests/closure_protocol.rs` tests; the discard and map -cases are the existing `effects` and `functor` tests. The checkpoint closes -PE-13's acceptance. Indirect calls, partial applications, and binding +cases are the existing `effects` and `functor` tests. Under-application of an +indirect callee (a local closure or a dictionary method) is now lowered by a +generated closure that captures the callee and the supplied arguments and calls +it indirectly; the `tests::partial_application` cases execute it. Binding quantifiers that are not leading `forall` nodes on the type still need explicit -evidence review: an under-applied or indirectly applied dictionary method is -rejected before adapters, and this is an indirect/partial-application gap rather -than a transport-contract rule. Array, ADT, and newtype protocols still belong -to their representation owners. Unsupported constructor transport is rejected -with a source-spanned diagnostic. On this tree the L6/M7 scoreboard moved from -164/413 to 207/413, so the D-04 and README runtime rows are updated with it; +evidence review. Array, ADT, and newtype protocols still belong to their +representation owners. Unsupported constructor transport is rejected with a +source-spanned diagnostic. On this tree the L6/M7 scoreboard moved from +164/413 to 210/413, so the D-04 and README runtime rows are updated with it; L1–L5 are unchanged. From ef1cc5601ffd5b777b19b6b53b91717052366f7a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 19:24:14 +0800 Subject: [PATCH 010/148] Establish the unified RuntimeRep and layout model (DEC-17) The runtime-representation model and checked-boundary contract was spread across the erasure and aggregate documents and referenced by name from several topics, so each feature grew its own notion of how a value is adapted. Give it a single owner, name it after industry practice, and make the target layout a total level of the same model. - New functional topic representation-and-evidence.md: the target-neutral RuntimeRep (the analogue of GHC's RuntimeRep), RepresentationPolicy, Boundary, Evidence, ConversionPlan, generic aggregate normalization and the aggregate conversion plan, the representation owners, and the one planner. A RuntimeRep a target uses has exactly one Layout, joined by a total mapping per target (heap_layout for Wasm GC; abi_layout for the Canonical ABI), which is what makes the functional backend complete. Erasure, callables, dictionaries, effects, coercion, and partial application become instances of it in their own documents, deferring to it instead of restating it. - data-representation is named as the Wasm GC heap_layout realization of each RuntimeRep, with a total ValueShape -> ValueType mapping; the former generic-aggregate-erasure design is folded into the model (normalization and conversion) and this document (layouts). - Erasure defines the policy of an erased value and its ownership (producer), grounded in GHC RuntimeRep/Any, Swift reabstraction thunks and witness tables, and Java bridge methods. - cc-ir: partial application is the standard PAP closure for every callee kind; the adapted function boundary is a reabstraction thunk; checked instantiation evidence travels through an explicit Core-to-CC side table. - effects: the token is the State# RealWorld analogue; i32 0 is a placeholder and an implementation gap. - modules-and-resolution, prim: coerce and unsafeCoerce are compiler-provided primitive values; a compiler-provided module is never shadowed. - DEC-17 records the durable decision; the backend index and IR boundaries reference the new topic and name the evidence/policy side table. - Acceptance records name the transitional mechanism and its removal target. --- .../DEC-17-representation-and-evidence.md | 136 ++++ docs/design/D-04-suite-roadmap.md | 2 +- docs/design/backend/00-ir-boundaries.md | 9 +- docs/design/backend/README.md | 12 +- docs/design/backend/fp/cc-ir.md | 45 +- docs/design/backend/fp/data-representation.md | 33 +- docs/design/backend/fp/effects.md | 41 +- .../backend/fp/generic-aggregate-erasure.md | 583 ------------------ docs/design/backend/fp/mir.md | 8 +- .../backend/fp/polymorphism-and-erasure.md | 175 ++---- .../backend/fp/representation-and-evidence.md | 530 ++++++++++++++++ .../fp/type-classes-and-dictionaries.md | 3 + .../semantics/modules-and-resolution.md | 23 +- docs/design/frontend/type-system/prim.md | 1 + .../backend/data-representation.md | 3 +- docs/implementation/backend/effects.md | 12 +- .../backend/generic-aggregate-erasure.md | 2 +- .../backend/polymorphism-and-erasure.md | 14 + 18 files changed, 871 insertions(+), 761 deletions(-) create mode 100644 docs/decision/DEC-17-representation-and-evidence.md delete mode 100644 docs/design/backend/fp/generic-aggregate-erasure.md create mode 100644 docs/design/backend/fp/representation-and-evidence.md diff --git a/docs/decision/DEC-17-representation-and-evidence.md b/docs/decision/DEC-17-representation-and-evidence.md new file mode 100644 index 00000000..b7aaeb1b --- /dev/null +++ b/docs/decision/DEC-17-representation-and-evidence.md @@ -0,0 +1,136 @@ +# DEC-17 — Unified Runtime Representation and Checked-Boundary Model + +**Status:** Proposed +**Date:** 2026-10-05 + +## Context and constraints + +A source type does not determine a runtime representation. Representation is +representation-polymorphic wherever a type variable, an abstract constructor, a +class dictionary, an effect, or a newtype is involved. The frontend already +produces explicit evidence for these cases — class dictionaries and selected +instances, `Coercible` proofs, instantiation and subsumption — and the backend +already owns layout ([CC IR](../design/backend/fp/cc-ir.md), +[MIR](../design/backend/fp/mir.md)). What was missing is a single contract for +how the two meet. + +Without that contract, the abstract-constructor transport work grew private, +per-feature mechanisms: a HIR-`TypeId`-keyed constructor-protocol table inside +CC, a callable-protocol signature derived by enumerating signatures and taking +parameter prefixes, an effect token lowered to the constant `i32` `0`, and a +driver that skips the compiler-provided `Safe.Coerce` module to avoid a +recursive vendored body. Each is a local rule where a shared one is required, +each keys a representation decision on information its owner does not have, and +together they make erasure, dictionaries, effects, coercion, and partial +application agree only by coincidence. + +Established practice treats these as one problem. GHC represents a value of kind +`TYPE r` through its `RuntimeRep` `r`, carries that representation at a coercion +site, uses `Any` as the uniform boxed inhabitant, represents `IO` as a state +token, and exposes `unsafeCoerce#` as the primitive representation coercion. +Swift gives a function value a calling convention and reintroduces a changed one +with a reabstraction thunk, and represents dictionaries as witness tables. Java +erases generic type arguments and restores call compatibility with bridge +methods. Koka elaborates class and effect operations to explicit evidence. The +constraint is to adopt that one model instead of another feature-local rule, +without adding a runtime type tag and without putting a source or HIR identity +into the CC representation. + +## Decision + +Adopt one runtime representation model, one checked-boundary contract, and one +conversion planner, shared by every feature: + +- **RuntimeRep** (`Scalar`, `Box`, `Reference`, `Aggregate`, `Closure`, + `Erased`) is the target-neutral representation a value has at a boundary; its + `Layout` is the target-specific realization. `Erased` is the uniform + anyref slot, not a loss of information. +- **RepresentationPolicy** is the `RuntimeRep` a producer chose when the value + entered an `Erased` slot (`Boxed`, `Nominal`, `AggregateLayout`, `Callable`). + It is compiler evidence, not a runtime tag. +- **Boundary**, **Evidence** (instantiation, subsumption, dictionary selection, + coercion proof, effect plan), and **ConversionPlan** describe the crossing. +- **Adaptation** (`Identity`, `Box`, `Unbox`, `Cast`, `AggregateConvert`, + `Thunk`, `Coerce`) is planned from the evidence and the two representations; + it is never searched for. +- A **representation owner** maps a source constructor plus its checked + instantiation arguments to a policy. There is one registry, not a special case + per feature. + +Four facts have four owners: checking owns the source relation (P5/P6); the +producer or representation owner owns the policy; the checked use owns the +consumer requirement; P9 owns the layout. The model has two levels: the +`RuntimeRep` of a value at a boundary is target-neutral, and its `Layout` is +the target-specific realization, joined by a total mapping per target +(`heap_layout` for the Wasm GC language heap, `abi_layout` for the Canonical ABI +boundary). A `RuntimeRep` a target uses must have a layout, so the target-neutral +model plus a total, verified mapping is what makes the backend complete. +`RuntimeRep` is this compiler's analogue of GHC's `RuntimeRep`; source-level +representation polymorphism (`TYPE r`) is not a PureScript feature, so it is an +internal descriptor, not a kind. +Erasure, canonical +aggregates, callables, dictionaries, effects, coercion, and partial application +are instances of this model, specified in +[representation and evidence](../design/backend/fp/representation-and-evidence.md), +not separate mechanisms. + +Checked evidence and representation policies travel to P8 through an explicit +Core-to-CC side table, the same boundary discipline `ExternalBindings` uses for +WIT bindings. P8 must not read the Core type arena ambiently, must not key a +semantic decision on a HIR identity, and must not reconstruct a producer policy +from a consumer type or a declaration arity. Missing evidence is a reported +unsupported boundary. + +The model adopts the established naming: GHC `RuntimeRep`/`Any`/`unsafeCoerce#`, +Swift calling conventions and reabstraction thunks with witness tables, Java +erasure with bridge methods, and Koka-style explicit evidence. + +## Consequences + +- The transitional mechanisms are removed, not extended: the HIR-keyed protocol + table, the signature-prefix protocol derivation, and the effect token's + special case become a single side table plus the one planner. Until that + migration lands, they are recorded as deviations from the design. +- A new constructor is added by registering one representation owner, not by + teaching each pass a new rule. +- `Safe.Coerce.coerce` and `Unsafe.Coerce.unsafeCoerce` are compiler-provided + primitive values. A module the compiler provides is never shadowed by a + vendored on-disk file, so the vendored source stays faithful to upstream. +- The effect token becomes the `State# RealWorld` analogue; the current `i32` `0` + is a placeholder rather than the model. +- Generic aggregate normalization and the aggregate conversion plan + (`ProductMap`/`ArrayMap`, canonical aggregate keys) are sections of the model + document, not a separate design; the concrete aggregate layouts and their + lowering stay in [data representation](../design/backend/fp/data-representation.md). +- The cost is a longer-lived boundary artifact: checked evidence and policies + must be preserved until P8 emits conversion operations, and the side table is + validated in both directions like `ExternalBindings`. That cost is accepted + because it is the only way a consumer can recover a value without guessing. +- CC remains target-neutral and free of source identity; MIR keeps sole + ownership of concrete layout. + +## Rejected alternatives + +- **Keep the per-feature rules (HIR-keyed protocol table and signature-prefix + derivation).** Rejected: they key a representation decision on an identity + owned by another stage, they give the same constructor two mechanisms, and + they cannot be extended without another local rule. +- **Recompute the checked relation inside the backend instead of carrying it.** + Rejected: it duplicates the checker's subsumption without preserving its + direction, scope, or substitutions, and it makes acceptance depend on the + backend's copy. +- **Runtime type tags or type passing.** Rejected: the typed core performs no + runtime type analysis, so a tag store and load on every polymorphic boundary + buys nothing; dictionaries already carry the operations a class needs + ([DEC-15](DEC-15-unified-type-representation.md), + [polymorphism and erasure](../design/backend/fp/polymorphism-and-erasure.md)). +- **A dedicated IR node or runtime object per feature (dictionary, effect, + coercion).** Rejected: dictionaries and effects are ordinary products and + closures, and a dedicated node couples the backend to one library and adds a + verifier path for no semantic gain. +- **Keying representation behavior on a source or HIR identity inside CC.** + Rejected: representation decisions belong to stable representation indices; + a HIR identity is not part of the CC contract. +- **Treating representation equality as nominal identity.** Rejected: + structurally equal signatures must share one `SignatureId`, or a `ref.func` + for one source type is not callable through a shared `call_ref`. diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 8730aaa9..35f98f6a 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -735,7 +735,7 @@ effects, the component path, and pattern-matrix behavior including the value-sensitive `1185.purs` and `2049.purs` shapes. The 46-case move from the earlier 164 measurement combines the -[abstract-constructor transport contract](backend/fp/polymorphism-and-erasure.md) +[abstract-constructor representation policy](backend/fp/polymorphism-and-erasure.md) and its indirect partial-application path. Recovering a stored closure protocol and generating an adapter, instead of casting the erased closure onto the consumer signature, cleared 29 of the 30 P8 CC verifier failures and 17 of the diff --git a/docs/design/backend/00-ir-boundaries.md b/docs/design/backend/00-ir-boundaries.md index 4f0791b2..029ff0a7 100644 --- a/docs/design/backend/00-ir-boundaries.md +++ b/docs/design/backend/00-ir-boundaries.md @@ -21,7 +21,9 @@ the boundary-verification philosophy, and the responsibilities of the thin Wasm encoding (P10) and artifact production (P11). It is the cross-cutting contract between the two backend concerns. -It does not own the individual representations or topics. The typed core +It does not own the individual representations or topics. The shared +representation model and checked-boundary conversion contract is +[representation and evidence](fp/representation-and-evidence.md); the typed core calculus is [functional core](../frontend/semantics/functional-core.md); ANF and closure conversion are [CC IR](fp/cc-ir.md); SSA/CFG and representation planning are [MIR](fp/mir.md); control-flow structuring and tail calls are @@ -450,7 +452,10 @@ and P10/P11 would name it from the ABI registry; CC would be unchanged. ([D-01](../D-01-frontend-and-ir-boundaries.md), [Wasm encoding](wasm/encoding-and-structuring.md)). - **P7 to P8.** Verified Core plus explicit trusted-effect and selected-entry - metadata. P8 builds WIT bindings from Core's checked `ExternalType` + metadata, plus the boundary side table that carries checked instantiation + evidence and representation policies + ([representation and evidence](fp/representation-and-evidence.md)). P8 builds + WIT bindings from Core's checked `ExternalType` schemes before erasure. See [functional core](../frontend/semantics/functional-core.md) and [CC IR](fp/cc-ir.md). diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index f0d63cf1..a3c720a5 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -45,6 +45,7 @@ is [Functional Core](../frontend/semantics/functional-core.md). | Document | Owns | Depends on | | --- | --- | --- | +| [representation-and-evidence.md](fp/representation-and-evidence.md) | The shared RuntimeRep model, generic aggregate normalization, and the checked-boundary conversion contract every adaptation uses | frontend classes and evidence; functional core | | [cc-ir.md](fp/cc-ir.md) | ANF, closure conversion, CC operations and verifier | frontend Functional Core | | [mir.md](fp/mir.md) | SSA/CFG model, representation planning, MIR verifier | cc-ir | | [polymorphism-and-erasure.md](fp/polymorphism-and-erasure.md) | Rank-1 polymorphism, erased representation, adapters | mir | @@ -77,11 +78,12 @@ rules. ## Ordering -Read the functional concern bottom-up: functional core, then CC and MIR, then -representation topics (erasure, scalars, data, patterns, control flow), then -dictionaries and effects. Read P7 optimization after Core and P10 optimization -after MIR and the target capability profile. Wasm/WASI encoding consumes the -optimized MIR. +Read the functional concern bottom-up: functional core, then the shared +[representation and evidence](fp/representation-and-evidence.md) model, then CC +and MIR, then representation topics (erasure, scalars, data, patterns, control +flow), then dictionaries and effects. Read P7 optimization after Core and P10 +optimization after MIR and the target capability profile. Wasm/WASI encoding +consumes the optimized MIR. ## Writing diff --git a/docs/design/backend/fp/cc-ir.md b/docs/design/backend/fp/cc-ir.md index 7fa9c3ce..9c063da5 100644 --- a/docs/design/backend/fp/cc-ir.md +++ b/docs/design/backend/fp/cc-ir.md @@ -20,11 +20,13 @@ operation families, the external-binding boundary, and the CC verifier. It specifies what CC must express and must never contain. It does not own the Core terms it lowers (see [functional core](../../frontend/semantics/functional-core.md)), -the concrete runtime layout or Wasm type table (see [MIR](mir.md)), the pattern +the shared representation model and checked-boundary contract (see +[representation and evidence](representation-and-evidence.md)), the concrete +runtime layout or Wasm type table (see [MIR](mir.md)), the pattern decision algorithm (see [pattern matching](pattern-matching.md)), the erased representation protocol (see [polymorphism and erasure](polymorphism-and-erasure.md)), or canonical generic aggregate layouts and conversion semantics (see -[generic aggregate erasure](generic-aggregate-erasure.md)), +[representation and evidence](representation-and-evidence.md)), the scalar operator definitions (see [scalars and primitives](scalars-and-primitives.md)), or the WIT/canonical-ABI binding rules (see [canonical ABI and WIT](../wasm/canonical-abi-and-wit.md)). Dictionary @@ -142,7 +144,7 @@ canonical aggregate representation with recursively normalized elements or fields. CC records a target-neutral aggregate conversion plan when a typed boundary must reconstruct a different aggregate shape; it never encodes that work as a nominal reference cast. See -[generic aggregate erasure](generic-aggregate-erasure.md) for the canonical +[representation and evidence](representation-and-evidence.md) for the canonical keys and conversion rules. `RepresentationTable::reserve` allocates a stable `ReprId` before its @@ -400,16 +402,27 @@ function value without a separate calling convention. ### Partial application and erased adapters -When a `Global` is applied to fewer source-arrow arguments than its signature -has, P8 generates a wrapper closure that captures the supplied arguments and -calls the original function with the remaining source parameters appended. +Partial application is under-application of a source arrow: a call that +supplies fewer arguments than the callee's arrow arity. This is the ordinary +partial-application closure of functional-language runtimes (GHC's `PAP` +objects, OCaml's `caml_apply`), so P8 handles it uniformly for every callee +kind, not only `Global`: + +- a `Global` applied to fewer source-arrow arguments generates a wrapper + closure that captures the supplied arguments and calls the declaration with + the remaining source parameters appended; and +- a callee value that is not a declaration — a local closure or a class method + reached through a dictionary field — generates a closure that captures the + callee and the supplied arguments, exposes the remaining parameters, and + calls the captured callee indirectly. + `log "message"` for `log :: String -> Effect Unit` is a saturated source call; the effect token is not a remaining parameter of `log`. The token belongs to -the representation closure that the call returns -([effects](effects.md)). When a concrete function value crosses a polymorphic -function boundary, `adapt_erased_function_value` builds an adapter closure with -the erased signature that captures the original, boxes/unboxes each parameter, -calls the concrete closure, and boxes/unboxes the result +the representation closure that the call returns ([effects](effects.md)). When +a concrete function value crosses a polymorphic function boundary, +`adapt_erased_function_value` builds a reabstraction thunk with the erased +signature that captures the original, boxes/unboxes each parameter, calls the +concrete closure, and boxes/unboxes the result ([polymorphism and erasure](polymorphism-and-erasure.md)). ### Pattern decision and case lowering @@ -578,8 +591,12 @@ inside `If` assignments. See [MIR's worked example](mir.md) for the SSA form. the layout, builds the Wasm type table, lowers aggregate maps, and converts structured `If` into a CFG; it must not invent a requirement CC did not state. -- **From Core.** Core types and names are consumed here; nothing below CC - depends on Core `TypeId`s except lowering-only diagnostic side data. +- **From Core.** Core types and names are consumed here. A representation + decision must not read the Core type arena ambiently: checked instantiation + evidence and each erased value's representation policy travel with the input + as an explicit side table, the same way `ExternalBindings` carries the WIT + binding boundary. Nothing below CC depends on Core `TypeId`s except that + side table and lowering-only diagnostic data. ## Open questions and future work @@ -595,7 +612,7 @@ inside `If` assignments. See [MIR's worked example](mir.md) for the SSA form. - **Open rows.** Closed records only; row polymorphism needs a separate representation contract. Canonical closed generic aggregates and explicit conversion plans are specified in - [generic aggregate erasure](generic-aggregate-erasure.md). + [representation and evidence](representation-and-evidence.md). ## Implementation notes diff --git a/docs/design/backend/fp/data-representation.md b/docs/design/backend/fp/data-representation.md index f44cdcbc..bbbcf6b7 100644 --- a/docs/design/backend/fp/data-representation.md +++ b/docs/design/backend/fp/data-representation.md @@ -4,7 +4,7 @@ **Status:** Stable (design) **Prerequisites:** [CC IR](cc-ir.md), [MIR](mir.md), [polymorphism and erasure](polymorphism-and-erasure.md), and -[generic aggregate erasure](generic-aggregate-erasure.md); the WebAssembly 3.0 +[representation and evidence](representation-and-evidence.md); the WebAssembly 3.0 type system (structs, arrays, subtyping, `ref.test`/`ref.cast`, `i31`, and typed function references). Read [IR boundaries](../00-ir-boundaries.md) first. @@ -13,21 +13,28 @@ entirely by the P9 planner: sums become a tag-carrying abstract supertype with one final subtype per case (or an immediate `i32` tag when every case is nullary), products and records become structs, arrays become mutable GC arrays, and closures become `{ funref, capture-array }` structs whose captures are -stored in one uniform `eqref` array. This document fixes those layouts, the -operation lowering, and the execution-evidence expectations that promote a -backend capability. +stored in one uniform `eqref` array. This document is the Wasm GC half of the +runtime representation model: it realizes the `heap_layout : RuntimeRep -> +HeapLayout` mapping of +[representation and evidence](representation-and-evidence.md). It fixes those +layouts, the operation lowering, and the execution-evidence expectations that +promote a backend capability. ## Scope This document owns the concrete GC heap layouts that the P9 GC planner builds from CC requirements, the Wasm operations that construct and observe them, and -the execution-evidence expectations recorded for each capability. It does not +the execution-evidence expectations recorded for each capability. It realizes +the target-specific `Layout` of every `RuntimeRep` the Wasm GC profile supports, +so the runtime representation model is complete on this target. It does not own the planner contract (see [IR boundaries](../00-ir-boundaries.md)), the +shared representation model and checked-boundary contract (see +[representation and evidence](representation-and-evidence.md)), the target-neutral `Variant` model (see [CC IR](cc-ir.md)), the erased protocol for polymorphic values (see [polymorphism and erasure](polymorphism-and-erasure.md)), the normalization and conversion between generic and concrete aggregate layouts (see -[generic aggregate erasure](generic-aggregate-erasure.md)), scalar semantics (see +[representation and evidence](representation-and-evidence.md)), scalar semantics (see [scalars and primitives](scalars-and-primitives.md)), or the byte-oriented string and ABI boundary (see [linear memory and the canonical ABI @@ -62,7 +69,7 @@ fields retain canonical array, product, or closure references. Captures use a separate uniform reference-array protocol. A generic array or closed record has its own canonical aggregate layout; converting to or from a specialized concrete layout requires reconstruction, -as specified by [generic aggregate erasure](generic-aggregate-erasure.md). +as specified by [representation and evidence](representation-and-evidence.md). **Target-neutral variants.** [CC IR](cc-ir.md) makes the sum encoding a P9 decision: CC states one `Variant` requirement per @@ -73,6 +80,10 @@ chooses the object layout. ### Value types +A CC `ValueShape` is the materialization of a +[`RuntimeRep`](representation-and-evidence.md), and the MIR `ValueType` is its +`HeapLayout` on this target. The mapping is total on the supported profile: + | CC `ValueShape` | MIR `ValueType` | | --- | --- | | `Integer` | `I32` | @@ -138,7 +149,7 @@ for `Array a` is `Array(Erased)` with nullable `eqref` storage; other generic array layouts are keyed by their recursively normalized element shape. Closed generic records likewise use canonical products of normalized field shapes. Their conversions are explicit aggregate reconstruction, not `ref.cast` -between nominal layouts. See [generic aggregate erasure](generic-aggregate-erasure.md). +between nominal layouts. See [representation and evidence](representation-and-evidence.md). ### Type-table invariants @@ -201,7 +212,7 @@ shapes, and dependent closed records use canonical record keys containing sorted labels and normalized field shapes. P9 assigns one `DefinedTypeId` per reachable `ReprId`; concrete `Array Int` and canonical `Array(Erased)` remain distinct nominal types. An aggregate conversion plan that names distinct layouts is lowered to -reconstruction by [generic aggregate erasure](generic-aggregate-erasure.md), +reconstruction by [representation and evidence](representation-and-evidence.md), never to an array or struct `ref.cast`. A profile without `gc`, `reference_types`, or (for closures) `function_references` @@ -240,7 +251,7 @@ Three sequences are worth spelling out: - **Converting aggregate layouts.** A generic/concrete array boundary lowers to a fresh array and a loop that converts each element; a closed record boundary reads, converts, and rebuilds its fields. The aggregate conversion - plan is defined in [generic aggregate erasure](generic-aggregate-erasure.md). + plan is defined in [representation and evidence](representation-and-evidence.md). No conversion uses a cast between distinct nominal array or struct types. - **Closure call.** The closure is loaded, the arguments are loaded, and the closure is loaded again, cast to the closure struct, and its field 0 code @@ -557,7 +568,7 @@ Recovery to scalar fields uses typed GC boxes; conversion between different nominal array or closed-record layouts uses explicit reconstruction between `ReprId`s, and function signatures change through closure adapters. Canonical layouts and conversion plans are implemented as specified in -[generic aggregate erasure](generic-aggregate-erasure.md). The +[representation and evidence](representation-and-evidence.md). The [acceptance record](../../../implementation/backend/generic-aggregate-erasure.md) includes source-to-component execution and verified Typed Core fixtures for backend inputs that source lowering does not yet produce. It also records the diff --git a/docs/design/backend/fp/effects.md b/docs/design/backend/fp/effects.md index c374f77b..5b4da8e2 100644 --- a/docs/design/backend/fp/effects.md +++ b/docs/design/backend/fp/effects.md @@ -17,7 +17,11 @@ effectful entry once and returns zero after normal completion. This document owns the representation of `Effect a` and the meaning of `pure`, `bind`, and `runEffect`, including the execution token and effect sequencing. It -does not own the WASI services an effect may call +is the `Effect` representation owner in the shared model of +[representation and evidence](representation-and-evidence.md): `Effect a` is a +`Callable` policy with a fixed state-token parameter and the payload as result, +so it uses the ordinary closure and conversion contract rather than a private +path. It does not own the WASI services an effect may call ([WASI platform library](../wasm/wasi-platform-library.md)), the do/ado desugaring that produces `bind` (frontend; `FE-05` in [DEC-04](../../../decision/DEC-04-official-test-suite-roadmap.md)), or the @@ -174,9 +178,15 @@ flag, private constructor, or representation mode. - No stage stores an "effect" flag on an expression or adds a dedicated Effect IR node, closure kind, or runtime object. After representation lowering, CC and MIR see generic closures and calls. -- The synchronous token may be the integer zero. It carries no scheduling or - ordering guarantee. Call order and multiplicity are preserved by the - evaluation and optimizer contracts. +- The runtime token is the state token of a strict IO-like effect, the + `State# RealWorld` analogue in GHC. It is threaded through the chain and may + be neither duplicated nor observed; ordering comes from the calls and strict + evaluation order, not from the token's bits. For the current synchronous, + single-threaded `Effect` the token carries no payload, so it lowers to a + constant placeholder; that placeholder is an implementation gap, not the + model, because a value that can be copied is not a linear state token. + Call order and multiplicity are preserved by the evaluation and optimizer + contracts. - Entry selection produces one resolved command-entry `SymbolId`: use `Main.main` when present, otherwise require one unique top-level `main`. The lexical `runEffect` reference check and generated entry wrapper use that @@ -228,10 +238,13 @@ becomes a record/closure over its operation implementations and `runEffect` interprets it. That is a change of the operation set, not of the lowering mechanism, and it still introduces no dedicated CC/MIR node. -The synchronous token may be the constant `i32` value `0`. The calls themselves -are observable and cannot be merged or removed; distinct token bits are not a -substitute for that optimizer rule. A later runtime may pass state or resource -handles without exposing the token to source programs. +The token is a single abstract state value, the `State# RealWorld` analogue: +the lowering passes it along and never inspects or copies it. The current +implementation lowers it to the constant `i32` `0`, which is a placeholder +rather than the model — distinct token bits carry no meaning, and the calls +themselves are observable and cannot be merged or removed. A later runtime may +pass a state or resource handle through the same parameter without exposing it +to source programs. ### Partial application @@ -449,18 +462,18 @@ Responsibilities and required types: it is not passed to the source matcher as though `Effect a` were a source function. Arity-based reconstruction of the erased constructor is forbidden. - The Effect representation owner contributes its trusted constructor mapping, - token parameter, result representation and transport protocol to the common + token parameter, result representation and representation policy to the common conversion planner. It owns operation synthesis, suspension and command-entry behavior. Generic calls, dictionary fields, captures and adapter construction - consume ordinary checked boundary evidence and representation contracts; they + consume ordinary checked boundary evidence and representation policies; they do not select an Effect-specific conversion path. A representation-only canonical closure receives its authority from the plan that creates it, without a fabricated source `Effect` type or closure-origin field. - CC and MIR lower the resulting generic closures through `FunctionRef` and direct or indirect calls. Curried-arrow flattening reads source `Function` - spines only. Partial application - (`lower_partial_global_application`) applies to under-applied source arrows, - not to the token of an effect. + spines only. Partial application applies to under-applied source arrows, + whether the callee is a declaration or an indirect value, and never to the + token of an effect. - Dictionary passing uses the ordinary product and closure representation ([type classes and dictionaries](type-classes-and-dictionaries.md)). A chosen `Bind Effect` instance still crosses the definition ABI of a shared generic @@ -580,6 +593,8 @@ the behavioral guarantees above. - Wadler, P., *Monads for Functional Programming* (1992/1995). - Levy, P. B., *Call-by-Push-Value: A Subsuming Paradigm* (1999) and *Call-by-Push-Value* (2004). +- GHC's `IO` as `State# RealWorld` (Launchbury and Peyton Jones, *State in + Haskell*, 1994): the state-token representation of a strict IO effect. - [CC IR](cc-ir.md): closures, captures, and partial application. - [type classes and dictionaries](type-classes-and-dictionaries.md): the dictionary form the effect representation may grow into. diff --git a/docs/design/backend/fp/generic-aggregate-erasure.md b/docs/design/backend/fp/generic-aggregate-erasure.md deleted file mode 100644 index 4ba07667..00000000 --- a/docs/design/backend/fp/generic-aggregate-erasure.md +++ /dev/null @@ -1,583 +0,0 @@ -# Generic Aggregate Erasure - -**Feature:** F-02 -**Status:** Stable (design) -**Prerequisites:** [CC IR](cc-ir.md), [MIR](mir.md), [data representation](data-representation.md), and [polymorphism and erasure](polymorphism-and-erasure.md); WebAssembly GC's nominal struct and array types. Read [IR boundaries](../00-ir-boundaries.md) first. -**Summary:** This document defines how generic arrays and closed records cross between concrete, specialized layouts and canonical layouts that are independent of type arguments. It keeps DEC-07's runtime erasure for parameterized ADTs and adds explicit, typed conversions wherever an aggregate's nominal GC layout changes. Generic arrays and closed records use canonical erased layouts inside polymorphic code; concrete instantiations keep their specialized layouts. - -## Scope - -This document owns representation normalization and conversion for generic -arrays and closed records, including their use as fields of parameterized ADTs. -It defines the CC conversion contract and its lowering and verifier obligations -through MIR. It refines field normalization while preserving the single-layout -invariant in [DEC-07](../../../decision/DEC-07-runtime-representation-for-parameterized-adts.md), -and does not define open-row records, change source type inference, or define -independent Wasm artifact linking. Scalar boxing and polymorphic function adapters remain -specified by [polymorphism and erasure](polymorphism-and-erasure.md); concrete -GC objects and pure array update remain specified by -[data representation](data-representation.md). - -Implementation acceptance is tracked in the -[topic execution checklist](../../../implementation/backend/generic-aggregate-erasure.md). -Existing code and regression tests are evidence candidates; this stable design -status does not claim that every requirement has been implemented or verified. - -## Background - -Wasm GC struct and array types are nominal. Mutable array element types are -invariant: `(array (mut i32))` and `(array (mut eqref))` are distinct defined -types, and `ref.cast` cannot transform one array's elements into another -layout. A reference cast checks object identity and declared subtyping; it does -not walk an array or rebuild a struct. - -DEC-07 selects one erased runtime representation for parameterized ADTs and -does not specialize a polymorphic function for every call. Its erased `eqref` -slot can hold a reference, but that fact does not make a concrete aggregate -object have the layout expected by a generic body. For example, an -`Array Int` reference may be upcast to `eqref`, but it is not an instance of the -canonical array type needed to implement `Array a` for arbitrary `a`. - -The design therefore distinguishes **erasing a reference** from **converting an -aggregate layout**. Erasing a reference is a reference upcast and preserves the -object. Converting a layout allocates a new aggregate and converts its elements -or fields according to the typed source and destination. Scalar values use the -existing typed boxes when they cross an `Erased` boundary. - -## Model - -### Runtime shape normalization - -P8 derives a runtime shape from a typed Core type and its type-variable scope. -It distinguishes a declaration template from an instantiated actual type; this -keeps a generic layout canonical at a concrete call site. Normalization is -structural and cycle-safe, and produces CC requirements, never Wasm types: - -- `Template(T, Q)` normalizes a type in a polymorphic declaration while - treating that declaration's bound variables `Q` as abstract. It does not - apply a call-site substitution to those variables. -- `Actual(T, S)` first applies boundary substitution `S` to the source - expression's type. A closed result receives its specialized shape; variables - that `S` does not resolve remain abstract and use template normalization. - -Formal parameters, function results, and declared ADT field templates are -normalized with `Template`. Values at calls and constructors are normalized -with `Actual`. P8 constructs a conversion plan between those two shapes. - -In the CC plan, `TypeRole` records only which normalization rule P8 used: -`Template` or `Actual`. It carries no Core `TypeId` into MIR. `TemplateContext` -identifies the bound variables that remain abstract; `Substitution` resolves -the variables known at an actual call or construction boundary. - -| Typed Core type | Normalized runtime value shape | -| --- | --- | -| A bare type variable `a` | `Erased` | -| An application `f a` headed by a type variable | `Erased`, because its storage constructor is unknown | -| A concrete scalar such as `Int` | Its scalar CC shape | -| A concrete `Array Int` | `Reference(Repr(Array(Integer)))` | -| A type-dependent `Array a` | `Reference(Repr(Array(Erased)))`, the canonical generic array | -| A type-dependent `Array (Array a)` | An array of references to canonical `Array(Erased)` values | -| A closed record `{ x :: Int }` | A product with the concrete `Integer` field | -| A dependent closed record `{ x :: a }` | A canonical product with an `Erased` field | -| A dependent closed record `{ xs :: Array a }` | A canonical product with an `Array(Erased)` reference field | -| A function `a -> Int` | `Reference(Closure(Signature([Erased], Integer)))` | -| A parameterized ADT | Its nominal variant representation, independent of type arguments | - -For a type-dependent `Array T`, P8 recursively normalizes `T` and interns the -array by that normalized element shape. Thus the canonical `Array a` layout is -`Array(Erased)`, a GC array whose physical element storage is nullable `eqref`. -Its elements are logically non-null language values; nullable storage exists -for default allocation and private construction only. `Array (Array a)` stores -references to the canonical inner-array layout in its slots. This recursive -rule preserves useful reference shapes while ensuring that `Array a` has one -layout independent of the instantiation of `a`. - -A closed generic record uses a canonical product shape. Each field is -normalized recursively, and the physical field order is the canonical field -order. Thus `{ value :: a, items :: Array a }` has the field shapes -`[Erased, Reference(Repr(Array(Erased)))]`. A bare variable field is erased; -aggregate fields retain their canonical aggregate reference shape. Open rows -have no canonical product in this design and remain unsupported. - -An ADT's variant layout continues to be keyed by its resolved declaration. A -constructor field is stored in the normalized shape of its declared template, -independent of concrete substitutions. A field declared `Array a` directly -stores its canonical `Array(Erased)` reference; closed records and function -fields likewise retain canonical product and closure shapes. A field declared -just `a` uses ordinary erased storage and does not force an aggregate copy. - -### Layout identity and conversion plans - -`CoreTypeId` and a concrete type substitution are inputs to normalization, not -runtime layout identities. CC interns requirements by canonical shape: - -- generic arrays share a representation keyed by normalized element shape; - every `Array a` specifically uses `Array(Erased)`; -- concrete arrays are keyed by their element storage shape; -- closed record keys contain canonical `(label, normalized field shape)` pairs; - ordinary positional products have their own key. `Representation::Product` - still contains only physical field shapes, while P8 keeps each record's - label-to-index mapping for lowering; and -- ADT variants are keyed by resolved declaration identity, with one set of - normalized template fields for all type arguments. - -P8 reserves a representation handle before recursively normalizing its fields, -so recursive references are cycle-safe. Equal canonical keys share a CC -`ReprId`; distinct concrete instantiations may have different IDs. P9 assigns -one `DefinedTypeId` to each reachable `ReprId` according to the existing -planner contract. P9 does not merge IDs by physical shape: ADT identity remains -declaration-based, and record/positional-product identity follows its P8 key. -The current driver links source modules into one Core program before P8, so -they share normalized keys and the resulting layout table. Linking -independently compiled Wasm artifacts while sharing GC nominal types is -outside this design. - -P8 records a target-neutral conversion plan when typed values with different -normalized shapes cross a semantic boundary: - -```text -ValueConversion = Identity - | BoxScalar(BoxKind) - | UnboxScalar(BoxKind) - | EraseReference - | RecoverReference { destination: ValueShape, - evidence: RecoveryEvidence } - | Sequence([ValueConversion]) - | ArrayMap { source: ReprId, target: ReprId, - element: ValueConversion } - | ProductMap { source: ReprId, target: ReprId, - fields: [ValueConversion] } - | FunctionAdapter { function: SymbolId, source: ValueShape, - destination: ValueShape } - -RecoveryEvidence = TypeInstantiation - | ErasedVariantField { variant: ReprId, tag: u32, - field: u32, template: ValueShape } - -AggregateConvert = { value: ValueId, source: ValueShape, - destination: ValueShape, plan: ValueConversion } -``` - -`FunctionAdapter` names a P8-generated factory with one parameter of the -source shape and a result of the destination closure shape. The factory -captures the original closure once and returns an adapter; the adapter converts -arguments and results when called. This leaf participates recursively in both -`ArrayMap` and `ProductMap`, in either conversion direction. A field declared -as a function retains its normalized template closure signature; instantiation -never casts it directly to a different call signature. A bare variable -instantiated as a function can recover the already-stored concrete closure. - -The exact Rust names may differ, but CC must state the source and destination -shapes and the recursive work. The plan contains no Wasm type index, physical -field offset, or unverified type-variable cast. `ArrayMap` and `ProductMap` -mean element-wise or field-wise reconstruction; they are not reference casts. - -## Design - -### Canonical layouts and concrete layouts - -Concrete, variable-free arrays and records keep their specialized layouts. For -example, `Array Int` remains `(array (mut i32))`, and `{ x :: Int }` remains a -struct with an `i32` field. This preserves the current concrete data path. - -Within a polymorphic function, `Array a` uses the canonical -`(array (mut (ref null eq)))` layout. Its slots contain erased elements: `Int`, -`Boolean`, and `String` values are boxed in the integer box, `Number` values -use the number box, and references are upcast to `eqref`. Other -generic arrays use an array of their recursively normalized element shape; for -example, `Array (Array a)` stores references to the canonical `Array a` -layout. A dependent closed record similarly uses one canonical product whose -fields are the normalized shapes of its declared fields. Such a product may -contain scalar fields, erased fields, canonical generic arrays, or nested -canonical records. - -When values cross between these layouts, P8 emits a conversion plan and P9 -lowers it to explicit work. If the source and destination shapes agree, the -conversion is identity. If the shapes differ only because a concrete scalar -crosses an erased slot, the conversion boxes or unboxes. If a nominal aggregate -layout differs, the conversion allocates and reconstructs it. A nominal -`ref.cast` is used only to recover a reference whose canonical or concrete -layout is guaranteed by the typed construction path; it never substitutes for -reconstruction. - -### Where conversions occur - -Conversions are inserted at every typed boundary where the caller's actual -representation and the callee or storage representation differ: - -- **Parameterized ADT construction and projection.** Convert the field value - to the normalized shape of its declared field template and store that shape - directly. Projection converts from the same template shape to the consumer's - concrete shape if needed. Only bare-variable slots require erased recovery. -- **Record construction, access, and update.** Construct the product required - by the record type at that boundary. Access reads the current record layout - and converts its field to the typed result shape. Update converts assigned - fields to the layout of the new record and returns a fresh product. -- **Array construction, read, and update.** A literal converts each element to - the chosen array's logical element representation before storage. Reads - convert from the physical slot shape to the statically known result shape. - A pure update clones the source layout and converts the replacement element - before writing; it never mutates the source. -- **Direct calls and returns.** Arguments convert from the caller's actual - shapes to the callee signature's normalized shapes. Results convert from the - callee result shape to the caller's instantiated result shape. Reading a - top-level value invokes its zero-argument producer and uses this same result - conversion, including generic dictionary records. -- **Higher-order calls.** The existing erased function adapter includes these - argument and result conversions in its body, alongside scalar box/unbox and - closure-signature adaptation. -- **Captures.** A captured generic aggregate is stored using its canonical - aggregate layout and then placed in the uniform capture array as an - `eqref`. A concrete aggregate captured by concrete code keeps its specialized - layout. Any conversion required by the lifted function's signature is - performed before capture or when the capture is read. -- **Linked source modules.** Since modules are combined into one Core program - before P8, the call boundary uses the same canonical `ReprId` and requires - only the type-directed conversion above, not a separate module ABI adapter. - -### Reconstruction semantics - -The typed boundary evidence and stored representation contracts come from the -common planner in [polymorphism and erasure](polymorphism-and-erasure.md#checked-boundaries-and-stored-representation-contracts). -Nested `ProductMap`, `ArrayMap` and callable leaves retain their field/element -position and quantifier context. A dictionary is an ordinary product; its -method field does not authorize a separate Effect-specific matcher or recovery -rule. A stored erased reference can be recovered only to the layout or callable -signature established by its producer protocol. - -`ArrayMap` allocates a fresh destination array of the target layout, iterates -from zero to the source length, reads each source element, applies the nested -element conversion, and writes the converted element into the private target. -For reference element storage, physical slots are nullable references of the -target heap type; for `Array(Erased)` they are nullable `eqref`. All logical -values are converted to non-null references before the destination is exposed. -No source array is changed. Nested array and record values recursively use -their own conversion plans. A conversion whose source and target layouts are -identical does not allocate. - -`ProductMap` reads fields in canonical logical order, converts each field, and -allocates one fresh destination product only after the field values are ready. -Record updates follow the existing pure semantics: they construct a fresh -product with unchanged fields copied and changed fields converted. They do not -mutate an aliased record. Because arrays and records have no observable pointer -identity or mutation, a conversion may duplicate physical sharing while -preserving values. If the language later exposes pointer identity, mutable -aggregates, or cyclic aggregate graphs, the conversion design must add an -identity-preserving memo before those features are enabled. - -### Rejected alternatives - -- **Blind `ref.cast` from concrete to generic aggregate.** Rejected because - nominal GC types and mutable array element types differ; the cast does not - transform slots and may trap. -- **Erase every aggregate pointer and cast it back at each use.** Rejected for - the same nominal-layout reason. A cast from `eqref` to `Array(Erased)` is - valid only after the compiler has established that canonical layout. -- **Give every erased value a runtime type tag or dictionary.** Rejected by - DEC-07's uniform erased protocol; aggregate type reflection is not needed for - parametric source operations. -- **Use erased layouts for all concrete arrays and records.** Rejected because - it would discard specialized concrete layouts and force boxing and mapping - on programs that do not cross a polymorphic boundary. -- **Monomorphize every generic function.** Rejected by DEC-07; it changes the - selected runtime model and does not define behavior for higher-order values - or separate linking. - -## Algorithms - -### Normalization and plan construction - -P8 walks each typed value shape with a cycle guard and the active substitution. -It preserves concrete shapes when the type is closed. When a variable occurs -inside a generic aggregate, it creates or reuses the canonical aggregate -representation and records the logical element or field conversions at the -operation that crosses into or out of it. Open record rows and unknown foreign -aggregate layouts produce a named, source-spanned backend diagnostic. - -At a typed boundary, plan construction follows this procedure: - -```text -convert(source_type, source_role, destination_type, destination_role, substitution): - source_shape = normalize(source_type, source_role, substitution) - destination_shape = normalize(destination_type, destination_role, substitution) - require Core proves the typed boundary is valid under substitution - if source_shape == destination_shape: - return Identity - if destination_role is Template and destination_type is a bare variable: - if source_shape is scalar: return BoxScalar(box_kind(source_shape)) - if source_shape is reference: return EraseReference - if source_role is Template of bare variable and destination_role is Actual: - if destination_shape is scalar: return UnboxScalar(box_kind(destination_shape)) - if destination_shape is reference: - return RecoverReference(destination_shape, TypeInstantiation) - if both types are arrays and their element types correspond under substitution: - return ArrayMap(source_repr, destination_repr, - convert(source_element_type, source_role, - destination_element_type, destination_role, - substitution)) - if both types are closed records with the same label set and corresponding - field types under substitution: - return ProductMap(source_repr, destination_repr, - convert each matching field in canonical order with - the same source and destination roles) - otherwise: - report UnsupportedAggregateConversion at the boundary's source span -``` - -ADT construction and projection use the declared field template as the storage -contract. The variant slot must equal `Template(field_type)`; a mismatch is a -compiler IR error. A concrete substitution never changes that slot's layout. -For `Array a`, construction maps `Array Int` to canonical `Array(Erased)` and -stores that reference directly. A polymorphic projection reads the canonical -reference directly; a concrete projection maps its elements to `Array Int`. -For a bare `a`, construction erases the actual value without canonicalizing its -internal structure, and projection boxes/unboxes or recovers that actual shape. - -```text -construct_field(actual_value, field_template, substitution, stored_shape): - template_shape = Template(field_template) # never substitute first - assert stored_shape == template_shape - actual_shape = Actual(actual_value.ty, substitution) - return plan_conversion(actual_value.ty, Actual, field_template, Template, - substitution, actual_shape, template_shape) - -project_field(stored_value, field_template, substitution, stored_shape): - template_shape = Template(field_template) - assert stored_shape == template_shape - actual_type = substitute(field_template, substitution) - actual_shape = normalize_actual(actual_type, substitution) - if field_template is a bare variable and actual_shape is a concrete reference: - return RecoverReference(actual_shape, - ErasedVariantField(variant, tag, field, actual_shape)) - return plan_conversion(field_template, Template, actual_type, Actual, - substitution, template_shape, actual_shape) -``` - -`ErasedVariantField` evidence is produced only for an erased slot's reference -recovery. CC verifies that the named slot is physically `Erased` and the target -agrees with the token. Construction proves that a bare-variable slot received -the actual reference without changing its layout. Scalar recovery uses typed -box plans. Composite template fields require no outer erased recovery, and -function signature changes require adapters rather than reference casts. - -### Lowering conversion plans - -P9 lowers `Identity`, scalar boxing, scalar unboxing, reference erasure, and -reference recovery with the existing shape-checked operations. It lowers -`ProductMap` by `StructGet` on each source field, recursively converting the -fields, then `StructNew` on the target product. It lowers `ArrayMap` to MIR -control flow: read the source length, allocate a private destination with -defaultable storage, loop over elements, convert each element, and store it. -MIR includes an explicit `ArrayNewDefault` operation for this construction; -the verifier proves that the target element storage is defaultable and that -every slot is initialized before the array escapes. The Wasm encoder maps this -operation to `array.new_default` and emits the already-verified loop. - -P9 lowers a `FunctionAdapter` leaf to a direct call to its generated factory, -including inside an array loop or a product conversion. CC module verification -checks the factory's actual parameter and result against the plan's endpoints; -reachability includes the factory and its captured closure implementation. -P9 introduces no source-type reasoning or adapter-generation policy. - -Conversion helpers are interned by their complete source shape, target shape, -and nested conversion plan. This shares identical work without conflating -different type substitutions. The helper receives and returns the exact MIR -types in its key. A plan with an unsupported source or target fails in P8 with -a named diagnostic at the source operation; malformed internal plans are -rejected by the CC or MIR verifier as compiler errors. - -## Code map - -The design keeps normalization in P8, abstract conversion intent in CC, and -physical reconstruction in P9/MIR. Wasm encoding remains a mechanical mapping. - -```text -cc/ - layout/normalize.rs # typed Core shape normalization and canonical keys - convert.rs # target-neutral conversion plan construction - representation.rs # interned ReprId and ValueShape requirements -mir/ - layout/ # canonical and concrete GC layout planning - lower/aggregate.rs # ProductMap and ArrayMap helper/CFG lowering - lower/erased.rs # scalar boxes and checked erased-reference recovery - verify/conversion.rs # conversion-plan endpoints and initialization proof -wasm/lower/structure/ - arrays.rs # verified array.new_default and array operations -``` - -The entry points must preserve the IR boundary: - -```rust -fn normalize_template(core: &TypedCore, ty: TypeId, context: &TemplateContext) - -> Result; -fn normalize_actual(core: &TypedCore, ty: TypeId, substitution: &Substitution, - residual_template: &TemplateContext) - -> Result; -enum TypeRole { Template(TemplateContext), Actual(Substitution) } -fn plan_conversion(core: &TypedCore, source_type: TypeId, source_role: TypeRole, - destination_type: TypeId, destination_role: TypeRole, - substitution: &Substitution, - source_shape: ValueShape, destination_shape: ValueShape, - span: TextRange) -> Result; -fn lower_conversion(plan: &ValueConversion, value: ValueId, span: TextRange) - -> Result; -``` - -P8 owns type substitutions, source spans, and the proof that source and -destination types are compatible. CC carries only interned shapes and -target-neutral conversion plans. P9 resolves those shapes to `DefinedTypeId`s -and emits MIR instructions and CFG. MIR carries no Core `TypeId` or type -variable. The Wasm encoder receives verified MIR and chooses no layout. -`TemplateContext`, `Substitution`, and `TypeRole` are P8-only inputs; emitted CC -plans carry only `ValueShape`s, representation handles, and recovery evidence. - -## Invariants and verification - -- Every canonical key is deterministic and cycle-safe; `CoreTypeId` and - concrete type substitutions do not become runtime tags. -- Every value crossing a boundary has a conversion plan whose source and - destination match the typed Core types and CC shapes recorded at that - operation. -- A reference cast from `Erased` to an aggregate layout is allowed only when - the producing operation establishes that exact canonical or concrete - layout. It never converts between two different nominal aggregate layouts. -- Every `RecoverReference` includes P8 evidence. `TypeInstantiation` is emitted - only for a value whose typed source is an abstract variable instantiated at - that boundary. `ErasedVariantField` identifies a variant case field whose - stored shape is `Erased` and whose declared template normalizes to the target - shape. -- `ArrayMap` source and target handles resolve to array representations; its - nested plan matches their logical element conversion. The source is not - mutated, every target slot is initialized before exposure, and the result has - the target array shape. -- `ProductMap` source and target handles resolve to closed products with the - same field-label set. Corresponding field types agree under the boundary - substitution; field plans match labels and normalized shapes and the result - has the target product shape. -- Every ADT field's storage equals its normalized declared template. Bare - variables are `Erased`; composite references retain canonical aggregate or - closure shapes. Construction and projection convert between actual and - template shapes without changing the variant layout. -- Pure array and record updates produce fresh values. Conversion cannot mutate - its input or change any language-observable alias. -- CC verification rejects plans with unresolved handles, incompatible source - and destination shapes, wrong field arity, or an invalid nested conversion. - P9/MIR verification rejects mismatched nominal types, uninitialized - reference slots, invalid casts, and incorrect array element/index types. -- A source-level conversion that cannot be represented is a named, - source-spanned P8 diagnostic. A malformed internal plan is a compiler error; - it must never be emitted as a runtime cast that can trap on a well-typed - program. - -## Worked example - -Consider a parameterized constructor whose field is an array: - -```purescript -data Wrap a = Wrap (Array a) - -wrap :: Array Int -> Wrap Int -wrap xs = Wrap xs - -unwrap :: forall a. Wrap a -> Array a -unwrap (Wrap xs) = xs - -main :: Int -main = arrayIndex (unwrap (wrap [40, 42])) 1 -``` - -The concrete literal and `wrap` argument use `Array Int`, whose runtime layout -is `(array (mut i32))`. The declared field template is `Array a`, so its -canonical shape is `Array(Erased)`. At construction P8 records `ArrayMap` with -an `Integer -> Erased` element conversion; P9 allocates the canonical array, -boxes each integer, then stores the canonical array reference directly in the -ADT's canonical array field: - -```text -ArrayInt([40, 42]) - -> ArrayMap(BoxInteger) - -> ArrayErased([box(40), box(42)]) - -> Canonical array variant field -``` - -`unwrap` is compiled once. Its pattern projection directly reads the canonical -`Array(Erased)` layout established by the constructor path, and its generic -result uses that same layout. At the concrete call site, the result boundary -maps the canonical array back to `Array Int`, unboxing each element before -`arrayIndex` returns an `Int`. No runtime type tag is needed, and no nominal -array cast is used as a conversion. - -A closed generic record follows the same rule: - -```purescript -copy :: forall a. { values :: Array a } -> Array a -copy record = record.values - -main = arrayIndex (copy { values: [40, 42] }) 1 -``` - -The concrete record contains an `Array Int` reference. The generic record -layout contains a canonical `Array(Erased)` reference. The call boundary -converts the nested array and builds the canonical product. `copy` reads that -field using its canonical product layout and returns the canonical array. The -concrete caller converts the result back to `Array Int`. A generic update -builds a fresh canonical product and adapts the new `values` field by the same -rule; it does not mutate the input record. - -By contrast, for `data Hold a = Hold a`, `Hold (Array Int)` stores the concrete -array reference directly in the erased `a` slot. A polymorphic function may -return it as `a` without inspecting its shape; a concrete caller at -`Hold (Array Int)` recovers the same `Array Int` representation. This case -does not need an array map because the declared template is the bare variable -`a`, not `Array a`. - -## Boundaries and interfaces - -- **Typed Core to P8:** Core supplies the actual type substitution and source - span. P8 determines whether a boundary is identity, box/unbox, reference - erasure/recovery, or aggregate reconstruction. -- **P8 to CC:** CC receives target-neutral shapes and conversion plans. It does - not receive Core type variables, Wasm heap types, or physical field indices. -- **CC to P9/MIR:** P9 resolves canonical `ReprId`s to nominal layouts and - lowers `ArrayMap`/`ProductMap` to verified instructions and CFG. `ArrayNewDefault` - is legal only for defaultable storage and only while the result is private - until initialized. -- **MIR to Wasm:** the encoder emits GC operations and structured loops from - verified MIR; it performs no layout conversion itself. -- **Source modules:** linked Core modules share normalization and layout keys. - Independently compiled Wasm artifacts that must share nominal GC type - definitions need a separate artifact-linking design and are out of scope. -- **Failure:** unsupported open rows, unknown foreign generic aggregates, or - inconsistent source/target types produce source-spanned diagnostics before - Wasm emission. A Wasm allocation failure may still trap as specified by the - runtime. - -## Open questions and future work - -- Define a safe conversion protocol for open-row records if row-polymorphic - values become a backend feature. -- If pointer identity, mutation, or cyclic aggregate graphs become observable, - determine whether reconstruction must preserve sharing and cycles. -- Independent compiled Wasm module linking must define how canonical GC types - are shared or adapted; source-module linking through shared Core does not - answer that ABI question. - -## References - -- [DEC-07: Runtime Representation for Parameterized ADTs](../../../decision/DEC-07-runtime-representation-for-parameterized-adts.md). -- [Polymorphism and erasure](polymorphism-and-erasure.md). -- [Data representation](data-representation.md). -- [CC IR](cc-ir.md) and [MIR](mir.md). -- WebAssembly 3.0 specification: GC struct and array types, subtyping, - `array.new_default`, `array.get`, `array.set`, and reference casts. - -## Implementation notes - -The [implementation acceptance checklist](../../../implementation/backend/generic-aggregate-erasure.md) -records the GA-01 through GA-20 evidence and the independent review repairs. -P9 now interns complete conversion plans into shared MIR helpers, and MIR -verification rejects nullable array loads declared non-null and aggregate -conversion paths that can expose incompletely initialized arrays. Optimized -components execute the array, record, ADT, adapter, and capture cases under -required Wasmtime. Empty array backend coverage uses a Typed Core fixture; -source empty literals remain unsupported at P5. diff --git a/docs/design/backend/fp/mir.md b/docs/design/backend/fp/mir.md index 4a614cc3..bff4d039 100644 --- a/docs/design/backend/fp/mir.md +++ b/docs/design/backend/fp/mir.md @@ -4,7 +4,7 @@ **Status:** Stable (design) **Prerequisites:** [functional core](../../frontend/semantics/functional-core.md), [CC IR](cc-ir.md), [data representation](data-representation.md), and -[generic aggregate erasure](generic-aggregate-erasure.md); +[representation and evidence](representation-and-evidence.md); the WebAssembly type system (GC structs and arrays, typed function references) and the basics of SSA form and dominators. Read [IR boundaries](../00-ir-boundaries.md) first. @@ -27,7 +27,7 @@ in [scalars and primitives](scalars-and-primitives.md); concrete GC layouts in [data representation](data-representation.md); erased values in [polymorphism and erasure](polymorphism-and-erasure.md); generic aggregate normalization and conversion in -[generic aggregate erasure](generic-aggregate-erasure.md). +[representation and evidence](representation-and-evidence.md). ## Background @@ -214,7 +214,7 @@ generic array layout, and other dependent arrays use an array of recursively normalized element shapes. Dependent closed records likewise use canonical product layouts. P9 converts between these nominal layouts by fresh allocation and recursive reconstruction, following -[generic aggregate erasure](generic-aggregate-erasure.md). +[representation and evidence](representation-and-evidence.md). ### Aggregate conversion lowering @@ -502,7 +502,7 @@ dominated by the block, since `B3`'s parameter is defined at its entry. meantime. - **Generic aggregate conversion.** Canonical generic arrays, closed records, and their explicit reconstruction helpers are specified in - [generic aggregate erasure](generic-aggregate-erasure.md). Open rows and + [representation and evidence](representation-and-evidence.md). Open rows and unknown foreign aggregate layouts require separate contracts. - **Optimization.** [MIR optimization](../opt/mir.md) specifies P10 passes. Scalar unboxing across call boundaries remains a P9 representation decision. diff --git a/docs/design/backend/fp/polymorphism-and-erasure.md b/docs/design/backend/fp/polymorphism-and-erasure.md index c6422c7d..856e133c 100644 --- a/docs/design/backend/fp/polymorphism-and-erasure.md +++ b/docs/design/backend/fp/polymorphism-and-erasure.md @@ -17,7 +17,7 @@ boxing, unboxing, casts, and generated function adapters. This document specifies that erased representation, the concrete-versus-erased boundary, and the adaptation operations. Generic arrays and closed records use the recursive layout and conversion rules in -[generic aggregate erasure](generic-aggregate-erasure.md). +[representation and evidence](representation-and-evidence.md). ## Scope @@ -74,7 +74,7 @@ code signature is the erased one. **Terminology.** An *erased value* is the value of an abstract type variable, whose runtime representation is the uniform reference. A type such as `Array a` contains a variable but is itself a generic aggregate; see -[generic aggregate erasure](generic-aggregate-erasure.md). *Boxing* +[representation and evidence](representation-and-evidence.md). *Boxing* allocates a wrapper for a scalar so it can inhabit the erased representation; *unboxing* projects it back. A *concrete* value is one whose source type is variable-free and therefore has a specialized representation. An *adapter* is a @@ -102,7 +102,7 @@ containing a type variable does not by itself make an entire aggregate value an fields, and function signatures. In particular, `Array a` uses the canonical generic array shape and a dependent closed record uses a canonical product; their element or field values may use `Erased`. See -[generic aggregate erasure](generic-aggregate-erasure.md) for the normalization +[representation and evidence](representation-and-evidence.md) for the normalization and layout conversions. A function value uses `Closure(SignatureId)`, whose `Signature` records the normalized `ValueShape` for each parameter and result. @@ -175,70 +175,31 @@ same kind of boundary: `Effect (a -> b)` lowers to a closure that takes the runtime token and returns a function, and flattening that function into the effect closure is forbidden ([effects](effects.md)). -### Checked boundaries and stored representation contracts +### The erased instance -Keep three facts separate until a representation conversion has been planned: +The shared representation model, the definition of a representation policy, its +ownership, and the one conversion planner are in +[representation and evidence](representation-and-evidence.md). This document +owns the erased instance of that model: a bare type variable has representation +`Erased`, and the policy its producer recorded is one of `Boxed`, `Nominal`, +`AggregateLayout`, or `Callable`. -1. The source definition scheme and the checked type at this particular use. -2. The representation actually produced or stored by the definition, including - a closure's complete parameter/result signature. -3. The representation required by the consumer. +Three consequences are specific to erasure: -Source checking owns scheme instantiation, subsumption, binder scope and field -compatibility. P8 consumes that result together with representation mappings; -it does not extend source compatibility to accommodate rewritten types. A -checked relation is attached to a particular boundary and immutable source -artifact. Type IDs alone, declaration arity, or a set of successful matcher -node pairs are insufficient: evidence must preserve relation direction, -quantifier scope, substitutions and the argument/result or field position to -which it applies. Contravariant parameters reverse the checking direction; -they do not make the evidence interchangeable with arbitrary endpoint pairs. +- **A bare variable transports an existing object.** Its recovery policy is the + one established when the value entered the slot. +- **An abstract constructor hides its constructor.** A generic method may + produce a new value of `f a` (including `f Unit`), so recovery uses the + constructor's policy, shared by the method and its generic consumers, never a + guess from the consumer's concrete type. +- **An aggregate containing a variable is not itself `Erased`.** `Array a` and a + dependent closed record keep a canonical aggregate layout; only their bare + variable slots are erased + ([representation and evidence](representation-and-evidence.md)). -The planning inputs have the following conceptual shape; these are compiler -contracts, not runtime fields: - -```text -Boundary = CallFrame | Return | Field | Element | Capture -CheckedBoundary = { source_artifact, boundary_position, scoped_type_relation } -RepresentationView = { source_use_or_generated_plan, value_shape, stored_protocol } -ConversionPlan = { checked_boundary, producer_view, consumer_view, operation_tree } -``` - -`source_use_or_generated_plan` identifies either a checked source type in its -binder environment or the plan that authorized a synthetic endpoint. An erased -value shape does not remove `stored_protocol` from planning. CC receives the -resulting explicit operations and signatures; it does not receive a runtime -constructor identity or type witness. - -A bare variable `a` can transport an existing reference object unchanged. Its -recovery contract is the representation established when the value entered -that slot. An application `f a` also hides its constructor. A generic method -may produce a new value of that application, so recovering it requires the -constructor transport contract shared by the method implementation and its -generic consumers, rather than a guess from the consumer's concrete type. -The same requirement applies to `f Unit`; a fixed argument does not establish -the stored calling convention of a value returned through a generic method. - -At a checked instantiation of `f`, the representation owner supplies that -constructor's transport protocol. For a callable constructor it specifies the -fixed parameters and the result protocol; for arrays it uses the canonical -element layout; ADTs retain their declared field storage contracts. Partial -constructor applications retain their fixed arguments. This is representation -lowering, not runtime instance selection. It neither requires a runtime type -tag nor authorizes erasing every constructor argument unconditionally. - -Dictionary selection determines the implementation to call. A shared generic -body and that implementation still have definition ABIs. Direct calling or -specializing a known dictionary may remove a boundary, but the unspecialized -path must satisfy the same transport contract. Dictionary fields, callbacks, -returns, captures and ordinary functions use the common conversion planner. - -Source types and checked boundary evidence remain available until P8 emits -explicit conversion operations with exact physical endpoints. Representation -lowering must not overwrite the authoritative source type arena and then -reconstruct source relations from closure signatures. A synthesized adapter -endpoint can be representation-only: its validity follows from its conversion -plan and signature, without inventing a source constructor for it. +The boundary, evidence, and `plan`/`emit` definitions and the edge cases are +specified once in [representation and evidence](representation-and-evidence.md) +and are not restated here. ### Erased values and boxes @@ -264,9 +225,9 @@ an `eqref` cast alone is not that conversion. turning a string into an integer. The i31 shorthand is used only for closure *captures*, not for the general erased protocol (see [data representation](data-representation.md)). -The empty-erasure case is an identity when both endpoints share the same stored -representation contract. Equal `Erased` shapes alone do not prove that two -hidden closure or aggregate protocols agree. +The empty-erasure case is an identity when both endpoints share the same +representation policy. Equal `Erased` shapes alone do not prove that two hidden +closure or aggregate policies agree. ### Dictionaries @@ -303,7 +264,7 @@ type stay specialized. Aggregate types are normalized recursively, so a generic function's `a` parameter uses `Erased`, while its `Array a` parameter uses the canonical generic array. A call site with a concrete instantiation converts between that canonical shape and its specialized shape as specified -in [generic aggregate erasure](generic-aggregate-erasure.md). There is exactly +in [representation and evidence](representation-and-evidence.md). There is exactly one erased representation for abstract values, and it carries no source type identity. @@ -397,67 +358,40 @@ normalize(ty, substitution): ``` The array and record cases are defined by -[generic aggregate erasure](generic-aggregate-erasure.md), including their +[representation and evidence](representation-and-evidence.md), including their conversion plans. An application headed by an abstract constructor, such as `f a`, has no known aggregate layout and uses the erased value protocol; known constructors such as `Array a` still retain their canonical layouts. A type variable nested in an ADT field continues to follow [DEC-07](../../../decision/DEC-07-runtime-representation-for-parameterized-adts.md). -### Planning a checked representation boundary +### Planning is shared -All typed boundaries use one planning operation, including direct and indirect -calls, partial applications, returned functions, dictionary fields, aggregate -elements and lifted captures: - -```text -plan(checked_boundary, producer_contract, consumer_contract): - validate boundary ownership, scope and endpoint positions - obtain source/use relation from the source checking owner - obtain physical views and transport protocols from representation lowering - if both contracts agree: - Identity - else: - recursively plan scalar, reference, callable and aggregate conversions - reject any recovery whose stored representation cannot be established - -emit(plan, value): - emit the plan's exact source/target shapes and signatures - verify generated adapter bodies, captures and calls -``` - -Planning retains semantic evidence; emission consumes the completed plan. -Emission must not rerun source matching for representation-only adapter types, -search a module for a plausible signature, or recover directly to the desired -consumer signature. A function conversion first establishes the stored -producer signature, then generates an adapter if the consumer signature differs. -Producer erasure and consumer recovery use the same protocol. For example, an -abstract callable-constructor protocol may transport a closure with a fixed -parameter and erased result; entering it adapts the result before erasure, -and leaving it recovers that closure before adapting to the concrete result. - -Representation owners contribute mappings and protocols to this common -operation. An Effect owner supplies the trusted application-to-token-closure -mapping; it does not collect separate call, dictionary or field evidence. -Planning context is explicit and belongs to a boundary. Ambient Effect-specific -matcher state is not a substitute for that context. +Conversion planning is defined once in +[representation and evidence](representation-and-evidence.md#algorithms) and is +not restated here. Every boundary in this topic — a direct or indirect call, a +partial application, a returned function, a dictionary field, an aggregate +element, or a lifted capture — is an instance of that one planner. Emission +consumes the completed plan: it does not rerun source matching for +representation-only adapter types, search a module for a plausible signature, +or recover directly to the desired consumer signature. ### Boxing and unboxing ```text -adapt(value, checked_boundary, stored_contract, consumer_contract): +adapt(value, checked_boundary, producer_policy, consumer_requirement): validate the checked plan and its endpoint contracts if consumer is a bare type-variable slot: scalar -> allocate its existing erased box reference -> RepresentationCast(value, Erased) - else if stored and consumer contracts require aggregate conversion: + else if producer and consumer policies require aggregate conversion: AggregateConvert(value, checked recursive plan) else if value is erased: recover the box, layout or callable signature established by storage - apply the remaining plan to reach the consumer contract + apply the remaining plan to reach the consumer requirement else if callable signatures differ: generate the checked function adapter - else if physical shapes and storage protocols agree: + else if physical shapes and representation policies agree: Identity otherwise: report a source-spanned unsupported conversion @@ -590,14 +524,14 @@ signatures map to one `SignatureId` and one MIR func type, so one The CC verifier: -- validates stored representation contracts and checked conversion-plan +- validates stored representation policies and checked conversion-plan endpoints before semantic evidence is discharged; equal erased shapes do not authorize recovery to an arbitrary signature; - accepts `RepresentationTest`/`RepresentationCast` only when the source value is erased or the destination requirement is erased (`cc/verify/adaptation.rs`); - verifies `AggregateConvert` endpoints and nested plans as specified by - [generic aggregate erasure](generic-aggregate-erasure.md); and + [representation and evidence](representation-and-evidence.md); and - checks that direct-call arguments and results exactly match the callee `Signature`, closure-call arguments match the closure `SignatureId`, and capture count, order, and representations match the lifted function; and @@ -687,7 +621,7 @@ adapter is invoked, and each adapter call unboxes its argument exactly once. dictionary values this design assumes and feed them through the normal aggregate path. - **Open-row aggregates.** Canonical generic arrays and closed records use the - conversion contract in [generic aggregate erasure](generic-aggregate-erasure.md). + conversion contract in [representation and evidence](representation-and-evidence.md). Open-row records still need a separate representation and conversion contract. - **Higher-order acceptance breadth.** Direct generic calls, concrete arguments to generic parameters, and returned polymorphic functions are the remaining @@ -712,6 +646,19 @@ conversion plans, including recursive function-adapter leaves. The distinguishes source programs from verified Typed Core backend fixtures and records source coverage and remaining obligations. +**Transitional mechanism.** The current lowering does not yet carry a +representation policy explicitly. It reconstructs the checked boundary +relation inside P8 from the immutable Core module, and it derives callable +constructor policies from a constructor-identity table supplied by the Effect +owner plus a signature-prefix derivation over the registered signatures. Both +are interim implementations of this design, not the model: the checked +relation and each value's representation policy should be produced by their +owning stages and travel to P8 through an explicit Core-to-CC side table, the +same boundary discipline `ExternalBindings` already uses. Keying a semantic +decision on a HIR type identity inside CC, and deriving a protocol by +enumerating signatures, are deviations to remove once that side table exists; +they are recorded as such in the acceptance record. + ## References - Reynolds, *Types, Abstraction and Parametric Polymorphism* (1983). @@ -720,6 +667,12 @@ records source coverage and remaining obligations. - Wadler and Blott, *How to Make ad-hoc Polymorphism Less ad hoc* (1989). - Peyton Jones, Jones, and Meijer, *Type Classes: an exploration of the design space* (1997). +- Eisenberg and Peyton Jones, *Levity Polymorphism* (2017); GHC's + `RuntimeRep` and `Any`, and `unsafeCoerce#` as the representation coercion. +- Swift's function calling conventions (`@convention(thin)`/`thick`) and + *reabstraction thunks*; witness tables for dictionary evidence. +- Java type erasure and *bridge methods* (JLS/JVMS), as the erased-call + compatibility analogue. - WebAssembly 3.0: garbage collection and typed function references. - [DEC-07](../../../decision/DEC-07-runtime-representation-for-parameterized-adts.md), [CC IR](cc-ir.md), diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md new file mode 100644 index 00000000..957bd557 --- /dev/null +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -0,0 +1,530 @@ +# Runtime Representation and Checked Boundaries + +**Feature:** F-02 +**Status:** Stable (design) +**Prerequisites:** [functional core](../../frontend/semantics/functional-core.md), +[classes and evidence](../../frontend/type-system/classes-and-evidence.md), +[CC IR](cc-ir.md), [MIR](mir.md); type-erasure semantics and dictionary +passing. Read [IR boundaries](../00-ir-boundaries.md) first. +**Summary:** A source type does not determine a runtime representation. One +representation model and one checked-boundary contract govern every place the +backend changes or recovers a representation: scalar boxing and unboxing under +erasure, reference cast and recovery, canonical aggregate conversion, callable +adaptation, dictionary projection, effect token threading, and coercions. +Every change is a **conversion plan** built from checked **evidence** and the +producer's **representation policy**, then emitted as explicit CC operations. +A `RuntimeRep` and its target `Layout` are the two levels of one model, joined +by a total mapping per target. This document owns the target-neutral `RuntimeRep` +model and the layout-mapping contract; each topic document owns the concrete +operations that instantiate it, and each target document owns its `Layout`. + +## Scope + +This document owns the shared representation model (`RuntimeRep`, +`RepresentationPolicy`), the checked-boundary contract (`Boundary`, `Evidence`, +`ConversionPlan`), the ownership rules for who produces and who consumes them, +generic aggregate normalization and the aggregate conversion plan, and the +single conversion-planning algorithm. It also defines the layout obligations a +conversion depends on; it does not own the concrete layout that realizes a +representation. It exists so that no feature introduces a private rule for "how +this value is adapted". + +It does not own the concrete Wasm GC layouts (see +[data representation](data-representation.md)); the CC requirement table and +verifier (see [CC IR](cc-ir.md)); the erased protocol for bare variables and +abstract constructors (see [polymorphism and erasure](polymorphism-and-erasure.md)); +class validation, +entailment, functional dependencies, and evidence elaboration (see +[classes and evidence](../../frontend/type-system/classes-and-evidence.md)) or +its runtime product form (see +[type classes and dictionaries](type-classes-and-dictionaries.md)); effect +semantics (see [effects](effects.md)); or scalar operator semantics (see +[scalars and primitives](scalars-and-primitives.md)). + +## Background + +**A `RuntimeRep` is not a function of the source type alone.** The source type +is representation-polymorphic wherever a type variable, an abstract +constructor, a class dictionary, an effect, or a newtype is involved. A +`forall a. a -> a` applied to an `Int`, a value of type `f a` whose `f` is +`Effect`, and a `newtype` over `Int` all have a source type that cannot by +itself say how the value is laid out at a given boundary. + +**Industry practice names the pieces separately.** GHC represents a value of +kind `TYPE r` through its `RuntimeRep` `r`; a coercion site carries that +representation, `Any` is the uniform boxed inhabitant, dictionaries are +ordinary values, `IO` is a state token, and `unsafeCoerce#` is the primitive +representation coercion. Swift gives a function value a calling convention and +generates a *reabstraction thunk* when the convention changes, with a witness +table for dictionaries. Java erases generic type arguments and restores call +compatibility with bridge methods. Koka elaborates type-class and effect +operations to explicit *evidence*. These are the same idea: choose a +representation when a value is produced, keep the choice as compiler evidence, +and adapt explicitly where the requirement changes. + +**This repository already has the two halves and must join them.** The frontend +produces checked evidence +([classes and evidence](../../frontend/type-system/classes-and-evidence.md), +[type inference](../../frontend/type-system/type-inference.md)); the backend +owns representation ([CC IR](cc-ir.md), [MIR](mir.md)). What was missing is a +single contract for how the two meet, which is why per-feature rules appeared. + +## Model + +```text +RuntimeRep = -- the target-neutral runtime representation + Scalar(Int | Number | Boolean | Char | Unit) + | Box(Scalar) -- one-field struct that lets a scalar inhabit Erased + | Reference(NominalRef) -- GC struct/array of a known nominal shape + | Aggregate(CanonicalKey) -- canonical array/product layout + | Closure(Signature) -- callable value: code ref + capture array + | Erased -- the uniform non-null anyref slot + +RepresentationPolicy = -- the RuntimeRep a producer chose for an erased value + Boxed(Scalar) + | Nominal(NominalRef) + | AggregateLayout(CanonicalKey) + | Callable(Signature) -- includes Function, dictionary methods, effects + +Boundary = Call | Return | Field | Element | Capture | Slot +Evidence = Instantiation { scheme, use, substitutions } + | Subsumption { actual, expected } + | Dictionary { selected_instance | given } + | Coercion { proof } + | EffectPlan { import, payload } +ConversionPlan = { boundary, producer, consumer, operations } +Adaptation = Identity | Box | Unbox | Cast | AggregateConvert | Thunk | Coerce + +-- Layout is the target-specific realization of a RuntimeRep. One total mapping +-- per target; a RuntimeRep used by a target must have a layout. +HeapLayout = Wasm GC heap layout -- the language heap, owned by P9 +AbiLayout = Canonical ABI byte layout -- the boundary, owned by the ABI docs +heap_layout : RuntimeRep -> HeapLayout +abi_layout : RuntimeRep -> AbiLayout +``` + +`RuntimeRep` is this compiler's analogue of GHC's `RuntimeRep`. GHC's is a kind +because it has representation polymorphism (`TYPE r`) in the source; this +compiler has none, so `RuntimeRep` is an internal descriptor used by lowering, +not a source or type-system kind. It is target-neutral; a `Layout` is its +target-specific realization. They are two levels of one model, joined by a +total mapping per target. + +`Erased` is a *representation*, not a loss of information: it is the uniform +anyref slot. The information the producer had before the value entered that slot +is its `RepresentationPolicy`, carried as evidence. Recovery is valid only +against the policy that stored the value; the consumer's concrete type does not +establish it. + +## Design + +### Four facts, four owners + +1. **Source relation.** Whether a use is a legal instantiation of a scheme, a + subsumption, a selected dictionary, a `Coercible` proof, or a classified + effectful import. Owned by checking (P5/P6); it is `Evidence`. +2. **Producer policy.** The representation the value's producer chose. Owned by + the definition and, for a constructor, by that constructor's **representation + owner**. It is fixed wherever the value is produced, not at its use. +3. **Consumer representation.** The representation the use requires. Owned by + the checked type at the boundary. +4. **Layout.** The target-specific realization of a `RuntimeRep`, produced + by the one representation-to-layout mapping. Owned by P9 + ([MIR](mir.md), [data representation](data-representation.md)). + +No stage may substitute for a fact it does not own. In particular, a consumer +never infers the producer policy from its own type, and a representation owner +never inspects a consumer. + +### Representation owners + +A **representation owner** maps a source type constructor plus its checked +instantiation arguments to a `RepresentationPolicy`. The owners form one +registry, not a set of private special cases: + +| Constructor | Policy | +| --- | --- | +| `Function` | `Callable(arrow parameters, result)` | +| `Array` | `AggregateLayout(canonical array key)` | +| a data type | `Nominal(variant)` with declared field templates | +| a newtype | the policy of its declared field template | +| the trusted `Effect` | `Callable([state token], payload)` | +| a bare type variable | `Erased`; the value keeps whatever policy it entered with | + +The registry belongs to the Core-to-CC boundary (below). CC itself does not know +a source constructor, key behavior on a HIR identity, or derive a protocol by +searching signatures. + +### Generic aggregate RuntimeReps + +`Array` and a closed record are representation owners too, but a type argument +can appear inside them. Their `RuntimeRep` is **canonical**: it does not depend +on the instantiation of that argument. A bare variable `a` is `Erased`; an +application `f a` headed by an unresolved variable is `Erased`, because its +storage constructor is unknown. + +| Source type | Canonical `RuntimeRep` | +| --- | --- | +| `a` | `Erased` | +| `f a` (head a variable) | `Erased` | +| concrete `Array Int` | the specialized `Aggregate([Integer])` | +| `Array a` | `Aggregate([Erased])`, the canonical generic array | +| `Array (Array a)` | an aggregate whose element references the canonical `Array a` | +| concrete `{ x :: Int }` | the specialized `Aggregate` product | +| `{ x :: a }` | a canonical product with an `Erased` field | +| a parameterized data type | one nominal variant, each field in its declared template's normalized shape | + +Normalization is structural and cycle-safe, and distinguishes a declaration +**template** (its bound variables abstract) from an **actual** type (the +boundary substitution applied). A closed actual type is specialized; a variable +the substitution does not resolve stays abstract and uses the template rule. +Canonical keys are: arrays by normalized element shape, closed records by sorted +`(label, normalized field shape)` pairs, and variants by declaration identity. +Equal keys intern to one representation; P9 assigns one `DefinedTypeId` per +reachable representation and does not merge by physical shape. This preserves +[DEC-07](../../../decision/DEC-07-runtime-representation-for-parameterized-adts.md)'s +single erased layout for a parameterized data type. Open rows have no canonical +product and remain unsupported. + +### Aggregate conversion + +When two normalized shapes meet at a typed boundary, the planner builds one +`ConversionPlan`; the concrete layouts it produces are owned by the target +(see [data representation](data-representation.md)). The aggregate leaves are a +`ProductMap` (field-wise reconstruction) and an `ArrayMap` (element-wise +reconstruction), each recursing into its fields or elements. Reconstruction +allocates a fresh destination and converts each field or element: it never +mutates the source and never uses a nominal `ref.cast` between two different +aggregate layouts. A reference `Cast` recovers an object only to the layout its +producer established. + +Conversions are inserted at every boundary where the actual and required shapes +differ: parameterized ADT construction and projection, record construction, +access and update, array construction, read and update, direct-call arguments +and returns, higher-order adapters, and captures. Linked source modules are +merged into one Core program before P8, so they share canonical keys and need no +module ABI adapter. Because arrays and records have no observable identity or +mutation, a conversion may duplicate physical sharing while preserving values; +if the language later exposes pointer identity, mutation, or cyclic aggregates, +the plan must add an identity-preserving memo before those features are enabled. + +### One model, two levels: RuntimeRep and Layout + +This is one model, not two. It has a **target-neutral level** — the `RuntimeRep` +a value has at a boundary, and the conversion plan between two `RuntimeRep`s — +and a **target-specific level** — the `Layout` that realizes a `RuntimeRep` on a +target. The levels are joined by a **total mapping per target**: every +`RuntimeRep` a target uses has exactly one layout. P9 owns the Wasm GC +`heap_layout`; the ABI documents own the canonical `abi_layout`. A complete +functional backend is the target-neutral model plus a total, verified mapping to +each target it emits. + +A `RuntimeRep` classifies how a value is used and converted at a boundary; a +`Layout` fixes the concrete types and bytes that realize it. The target has +exactly two layout domains: + +- the **language heap** is Wasm GC. Its concrete types, field offsets and + mutability, tag encoding, box structs, the closure struct and its capture + array, and the defined-type table are planned by P9 and fixed in + [MIR](mir.md) and [data representation](data-representation.md). This is + **MIR layout**: the `ValueType`/`RefType`/`DefinedType` table and the GC + layouts built from CC requirements. +- the **Canonical ABI boundary** is linear memory. Its byte layout — computed + offsets, alignment and padding, `(pointer, length)` pairs, the scratch return + area, and `cabi_realloc` — is owned by + [canonical ABI and WIT](../wasm/canonical-abi-and-wit.md) and + [linear memory and the canonical ABI boundary](../wasm/linear-memory-and-canonical-abi-boundary.md). + +A concrete value converted for a WIT call is an instance of this model at the +ABI boundary: the consumer representation is the canonical exchange shape and +the adaptation is the canonical conversion; the ABI documents own the bytes. +Erased values and generic aggregates never cross that boundary — they are +recovered to a concrete representation first. + +The layout obligations the model relies on are what let it plan a conversion +without owning a layout: + +- the same requirements name the same runtime shape: representation is + deterministic and independent of source identity; +- aggregates are canonically keyed, so structurally equal aggregates share one + representation while physically equal but nominally distinct layouts stay + distinct (see [Generic aggregate RuntimeReps](#generic-aggregate-runtime-reps)); +- a `Box` is one field, and `Erased` is a non-null, untagged reference; +- a `Closure` is `{ funref, capture-array }` with one uniform nullable-reference + capture array, so its type does not depend on its captures; and +- a variant is one representation per source sum, with stable tags. + +Offsets, type indices, sizes, alignments, and addresses are layouts, not +representations, and never appear in the model. + +### One planner + +Every boundary uses one planning operation and one emission step; the model is +defined here and its algorithm is specified under [Algorithms](#algorithms). +Planning chooses an adaptation from the checked relation and the two +representations; it never searches for one. + +### Everything is an instance + +The contract is one, and each functional topic is one instance of it: + +- **Erasure** ([polymorphism and erasure](polymorphism-and-erasure.md)): bare + variables are `Erased`; a policy is `Boxed`, `Nominal`, `AggregateLayout`, or + `Callable`. Box, Unbox, Cast, and Thunk implement it. +- **Aggregates** (see [Generic aggregate RuntimeReps](#generic-aggregate-runtime-reps)): + a canonical array or product; a changed shape is an `AggregateConvert` with a + recursive `ArrayMap`/`ProductMap` plan. +- **Callables** ([CC IR](cc-ir.md)): a `Closure(Signature)`; a changed + signature is a `Thunk`. This is Swift's reabstraction thunk. +- **Dictionaries** ([type classes and dictionaries](type-classes-and-dictionaries.md)): + a `Nominal` product of method closures; method use is `ProductGet`, and the + `Dictionary` evidence names the selected instance. There is no dictionary + adaptation because the dictionary is already an ordinary value. +- **Effects** ([effects](effects.md)): the `Effect` representation owner + supplies `Callable([state token], payload)`; `pure`, `bind`, `runEffect`, and + `trap` are its operations. There is no Effect-specific conversion path. +- **Coercion and newtypes** ([roles and coercions](../../../implementation/frontend/roles-and-coercions.md)): + a `Coercion` proof justifies `Identity` or a newtype's field policy. The + checked coercion is the intrinsic `Safe.Coerce.coerce`; the unchecked cast is + the primitive `Unsafe.Coerce.unsafeCoerce`, the `unsafeCoerce#` analogue. +- **Partial application** ([CC IR](cc-ir.md#partial-application-and-erased-adapters)): + a `Callable` value applied to fewer arguments produces a new `Callable` value + under the same policy; it is the standard partial-application closure. +- **Canonical ABI** ([canonical ABI and WIT](../wasm/canonical-abi-and-wit.md), + [linear memory](../wasm/linear-memory-and-canonical-abi-boundary.md)): a + concrete value converted for a WIT call takes the canonical exchange + representation; the ABI documents own its byte layout. + +### Evidence and policies travel as a side table + +Checked evidence and representation policies reach P8 through an explicit +Core-to-CC **side table**, the same boundary discipline +[`ExternalBindings`](../00-ir-boundaries.md) uses for WIT bindings. They are not +read ambiently from the Core type arena, and they are not keyed by a HIR +identity inside CC. + +- **Produced by** checking and the representation owners. +- **Consumed by** P8's planner, which emits explicit operations and signatures. +- **Never reconstructed** from a consumer type, a declaration arity, or a search + over signatures. Missing evidence is a reported unsupported boundary. + +### What this forbids + +- runtime type tags on erased values (dictionary and dictionary-selection + evidence are compile-time); +- a dedicated IR node, closure kind, or runtime object per feature + (dictionaries and effects are ordinary products and closures); +- two mechanisms for the same constructor (for example a token table *and* a + signature-prefix derivation for callables); +- deriving a producer policy from arity or from the consumer's concrete type; +- using a HIR/Core identity as a semantic key inside CC; and +- treating representation equality as nominal identity — structurally equal + signatures share one `SignatureId`. + +## Algorithms + +### Planning and emission + +```text +plan(evidence, producer_policy, consumer_representation): + validate boundary ownership, scope, direction and endpoint positions + if producer_policy and consumer_representation agree: + Identity + else: + recursively plan scalar, reference, callable and aggregate conversions + reject a recovery whose producer policy cannot be established + +emit(plan, value): + emit the plan's exact source/target representations and signatures + verify generated adapter bodies, captures and calls +``` + +### Choosing the adaptation + +```text +adapt(value, plan): + bare variable slot, scalar -> Box + bare variable slot, reference -> Cast(Erased) + aggregate layouts differ -> AggregateConvert(plan) + value is Erased -> recover the box, layout or callable + signature the policy names, then adapt + callable signatures differ -> Thunk(plan) -- reabstraction + representation-preserving proof -> Identity | Coerce + otherwise -> source-spanned unsupported boundary +``` + +### Aggregate conversion plans + +```text +convert(source, destination): + normalize both with the boundary's template/actual role + require the checked boundary to prove them compatible + if shapes agree: Identity + if the destination is a bare variable: Box a scalar, or Cast a reference + if the source is a bare variable: Unbox a scalar, or recover the reference + if both are arrays with corresponding elements: + ArrayMap(source, target, convert(elements)) + if both are closed records with the same labels: + ProductMap(source, target, convert(each field in canonical order)) + otherwise: report an unsupported aggregate conversion at the source span +``` + +The plan is target-neutral and carries no Wasm type, offset, or unverified +cast. The concrete allocation, loop, and initialization it lowers to are owned +by [data representation](data-representation.md) and [MIR](mir.md). + +### Edge cases + +- **Direction.** A parameter position is contravariant: the producer plan and + the consumer plan reverse relative to a result position. Evidence preserves + direction; it is never reused for the mirrored pair. +- **Nested boundaries.** A plan inside an `ArrayMap` or `ProductMap` retains its + element or field position and its own scoped evidence. +- **Fixed payloads.** `f Unit` does not make the abstract constructor concrete; + the producer policy of the value returned through the generic method still + governs recovery. +- **Missing evidence.** An abstract boundary without a producer policy is + reported with its source span, never resolved by arity or by a signature + search. + +## Code map + +This document is the shared contract; it has no runtime code of its own. The +implementation target is split across the topic owners: + +```text +cc/lower/conversion/ the planner and emission: scalar, reference, callable and + aggregate leaves, and the generated adapters +cc/layout/ constructor policies for the local constructors + (Function, Array, data, newtype) and signature interning +cc/verify/ conversion-plan endpoint, capture and call-signature checks +mir/layout/ the physical layout each RuntimeRep maps to +mir/lower/ lowering of the emitted adaptations +abi/ and wit/ canonical-ABI adaptation on concrete signatures only +``` + +The Core-to-CC **side table** that carries `Evidence` and `RepresentationPolicy` +is a boundary input, carried beside CC like `ExternalBindings`; it is not a +field of the CC model and never appears in an emitted operation. The frontend +owners of `Evidence` are +[classes and evidence](../../frontend/type-system/classes-and-evidence.md) and +[type inference](../../frontend/type-system/type-inference.md). + +## Invariants and verification + +- Every value has exactly one `RuntimeRep` at its definition and at each + boundary; the planner is the only place a representation changes. +- An `Erased` value is recovered only to a policy recorded by its producer. +- Every adaptation is justified by `Evidence` and checked at both endpoints. +- A representation owner maps a constructor to exactly one policy; there is no + fallback obtained by searching signatures or by arity. +- CC and MIR contain no target type above P9 and no runtime type tag anywhere. +- The verifiers of [CC IR](cc-ir.md) and [MIR](mir.md) check the emitted + operations; the boundary side table is validated in both directions, as + `ExternalBindings` is. + +## Worked examples + +### A bare variable at a concrete use + +`identity :: forall a. a -> a` used at `Int`. Evidence is the instantiation +`a := Int`; the producer policy at `Int` is `Boxed(Int)`. The plan boxes the +argument, `Cast`s to `Erased`, calls the `Callable([Erased], Erased)` body, then +casts to the box and unboxes the result. This is +[polymorphism and erasure](polymorphism-and-erasure.md)'s identity fixture; the +same symbol serves every instantiation. + +### An abstract constructor with a fixed payload + +`again :: forall f. Bind f => f Unit -> f Unit` used at `Effect`. Evidence names +the selected `Bind Effect` dictionary and the instantiation `f := Effect`; the +`Effect` owner's policy is `Callable([state token], Unit)`. The generic body +still stores that callable value; the consumer recovers the policy and runs it. +No cast onto the consumer's signature is used, which is what the fixed-payload +case verifies. + +### A representation-preserving coercion + +`coerce (UserId (Raw 47)) :: Int` over two visible newtypes. The `Coercion` +proof establishes representational equality; the planner lowers the chain of +newtype field policies to `Identity`, so no wrapper object is allocated and no +cast is needed. + +### A generic aggregate across a concrete boundary + +`data Wrap a = Wrap (Array a)`, `wrap :: Array Int -> Wrap Int`, and +`unwrap :: forall a. Wrap a -> Array a`, with +`main = arrayIndex (unwrap (wrap [40, 42])) 1`. The concrete literal is +`Array Int`; the declared field template `Array a` has the canonical +`Array(Erased)` RuntimeRep. Construction plans an `ArrayMap` with an +`Integer -> Erased` element conversion, boxes each element into the canonical +array, and stores that reference in the variant's canonical field. `unwrap` +reads the canonical layout directly, and the outer boundary maps it back to +`Array Int`. No runtime tag and no nominal array cast is used. A bare-variable +field such as `data Hold a = Hold a` instead stores the concrete reference +directly in the erased slot and needs no array map. + +## Boundaries and interfaces + +- **From checking (P5/P6):** checked boundary `Evidence`, plus the representation + policies of constructors and definitions, as a side table. +- **To CC (P8):** `RuntimeRep` requirements and explicit `Adaptation` + operations; no source identity and no physical layout. +- **To MIR (P9):** the requirements and plans; P9 selects the physical layout + and lowers the operations. MIR does not re-plan or invent a policy. +- **To the ABI boundary:** the canonical exchange shape is the consumer + representation; its byte layout is owned by + [canonical ABI and WIT](../wasm/canonical-abi-and-wit.md) and + [linear memory](../wasm/linear-memory-and-canonical-abi-boundary.md). Erased + values and generic aggregates never cross it. + +## Open questions and future work + +- **Registry home.** Whether the representation-owner registry lives beside the + trusted-library identities or as its own module at the Core-to-CC boundary. +- **Monomorphization.** A specialization pass may remove boxes and casts at + statically known instantiations while preserving the erased representation as + the fallback; it must not become a second correctness mechanism. +- **Open rows.** Open-row records still need a canonical policy and conversion + contract before they join the registry. + +## Implementation notes + +The current lowering implements this contract in part. It reconstructs the +checked relation inside P8 from the immutable Core module +(`cc/lower/instantiation.rs`), and it derives callable constructor policies from +a HIR-`TypeId`-keyed table (`FunctionLowerer::constructor_protocols`) plus a +signature-prefix derivation (`cc/layout/functions/mod.rs::transport_signatures`). +Those are interim mechanisms, not the model: the checked relation and each +producer policy should be produced by their owning stages and travel through the +side table. Keying a semantic CC decision on a HIR identity, and deriving a +policy by enumerating signatures, are the deviations to remove, and they are +recorded in +[polymorphism and erasure](../../../implementation/backend/polymorphism-and-erasure.md). + +The effect token is likewise a placeholder: the model makes it the `State# +RealWorld` analogue, while the current lowering uses the constant `i32` `0` +([effects](../../../implementation/backend/effects.md)). + +## References + +- Reynolds, *Types, Abstraction and Parametric Polymorphism* (1983). +- Crary, Weirich, and Morrisett, *Intensional Polymorphism in Type-Erasure + Semantics* (2002). +- Wadler and Blott, *How to Make Ad-hoc Polymorphism Less Ad hoc* (1989); + Peyton Jones, Jones, and Meijer, *Type Classes: Exploring the Design Space* + (1997). +- Eisenberg and Peyton Jones, *Levity Polymorphism* (2017); GHC `RuntimeRep`, + `Any`, and `unsafeCoerce#`. +- Launchbury and Peyton Jones, *State in Haskell* (1995); GHC `IO` as + `State# RealWorld`. +- Swift function calling conventions (`@convention(thin)`/`thick`), + reabstraction thunks, and witness tables. +- Java type erasure and bridge methods. +- [IR boundaries](../00-ir-boundaries.md), [functional core](../../frontend/semantics/functional-core.md), + [classes and evidence](../../frontend/type-system/classes-and-evidence.md), + [CC IR](cc-ir.md), [MIR](mir.md), + [polymorphism and erasure](polymorphism-and-erasure.md). +- [DEC-17](../../decision/DEC-17-representation-and-evidence.md) records this + model as a durable decision; [DEC-15](../../decision/DEC-15-unified-type-representation.md) + is the type-spine counterpart. diff --git a/docs/design/backend/fp/type-classes-and-dictionaries.md b/docs/design/backend/fp/type-classes-and-dictionaries.md index e513bad7..e9f615f2 100644 --- a/docs/design/backend/fp/type-classes-and-dictionaries.md +++ b/docs/design/backend/fp/type-classes-and-dictionaries.md @@ -25,6 +25,9 @@ belong to the frontend's It does not own the general record and closure layouts ([data representation](data-representation.md)), or the erased representation of polymorphic values ([polymorphism and erasure](polymorphism-and-erasure.md)). +A dictionary is an instance of the shared representation policy and conversion +contract in [representation and evidence](representation-and-evidence.md): an +ordinary product of closures, with no dictionary-specific adaptation. ## Background diff --git a/docs/design/frontend/semantics/modules-and-resolution.md b/docs/design/frontend/semantics/modules-and-resolution.md index be00a7dc..79dcd130 100644 --- a/docs/design/frontend/semantics/modules-and-resolution.md +++ b/docs/design/frontend/semantics/modules-and-resolution.md @@ -94,17 +94,18 @@ declared identities through qualification and re-exports, and carry a reach the same compiler-owned identity. A source module named `Prim` or beginning with `Prim.` is rejected; source cannot replace a compiler interface. The root `undefined` value reaches source only through this interface, not as a -free name. The compiler-provided set is not limited to `Prim`: -`Safe.Coerce` is virtual too, exporting `coerce` as the checked coercion -intrinsic and `Coercible` as the shared declared class. Because the vendored -official `Safe.Coerce` source is kept faithful to upstream — its body is -`coerce = unsafeCoerce` — the driver must not load an on-disk file for a module -the compiler provides; doing so would shadow the interface with a body the -project cannot compile. The loader skips such a module and imports fall through -to the virtual interface. `Unsafe.Coerce.unsafeCoerce` has no compiler -interface yet: the vendored module is faithful but its `foreign import` is -represented as a self-recursive stub this project cannot execute, so a program -that reaches it is a recorded gap rather than a working coercion. +free name. The compiler-provided set is not limited to `Prim`. Compiler-provided modules +export primitive values, and `Safe.Coerce` and `Unsafe.Coerce` are two of them: +`coerce` is the checked coercion intrinsic with `Coercible` as the shared +declared class, and `unsafeCoerce` is the unchecked representation cast, the +`unsafeCoerce#` analogue. Both are compiler-owned primitive values, not the +bodies a faithful vendored source must carry. A module the compiler provides is +never shadowed by an on-disk file: the loader omits such a module and an import +of it resolves through the virtual interface, so the vendored source can stay +faithful to upstream without its uncompilable body taking effect. The +`unsafeCoerce` primitive is not implemented yet, so a program that reaches it is +a recorded gap rather than a working cast; the design target is the same +compiler-owned value path `coerce` already uses. This document owns that interface: which names exist, which identity each carries, and that nothing in source can replace one. What a member *means* — which of them diff --git a/docs/design/frontend/type-system/prim.md b/docs/design/frontend/type-system/prim.md index 811a2eb6..2f9c7d25 100644 --- a/docs/design/frontend/type-system/prim.md +++ b/docs/design/frontend/type-system/prim.md @@ -59,6 +59,7 @@ Kinds are the official ones, since source compatibility requires them. "Provided | `Prim.Partial` | `Constraint` | Diagnostic | ReportOnly | yes | partial | | `Prim.Boolean.True`, `Prim.Boolean.False` | `Boolean` | Interface | — | yes | n/a | | `Safe.Coerce.coerce` (value) | `forall a b. Coercible a b => a -> b` | Interface | — | yes, as an intrinsic | n/a | +| `Unsafe.Coerce.unsafeCoerce` (value) | `forall a b. a -> b` | Interface | — | yes, as an intrinsic | not yet | | `Prim.Coerce.Coercible` | `forall k. k -> k -> Constraint` | Proof | CompileTimeProof | yes | yes | | `Prim.Ordering.Ordering` | `Type` | Interface | — | yes | n/a | | `Prim.Ordering.LT`, `EQ`, `GT` | `Ordering` | Interface | — | yes | n/a | diff --git a/docs/implementation/backend/data-representation.md b/docs/implementation/backend/data-representation.md index d095a048..f5b87215 100644 --- a/docs/implementation/backend/data-representation.md +++ b/docs/implementation/backend/data-representation.md @@ -259,7 +259,8 @@ The physical layout families are verified on this revision. Open items outside this topic: - Open record rows and unknown foreign aggregate layouts remain unsupported - conversions, owned by [generic aggregate erasure](../../design/backend/fp/generic-aggregate-erasure.md). + conversions, owned by [representation and + evidence](../../design/backend/fp/representation-and-evidence.md). - The `i31` optimization for nullary cases of mixed sums and GC strings remain future work in the design. - The capture-array element mutability bit is part of the planned layout but is diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index 625047e4..b07a8454 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -23,7 +23,7 @@ vendored-library iteration. The 2026-10-05 reproduces a matching producer/consumer signature failure without Effect. At `675f0e3` the discard, delayed-map, and fixed-payload Effect cases compiled and then trapped. The landed checkpoint recorded there executes those three -programs and the Reader reproduction, and the transport contract is the same +programs and the Reader reproduction, and the representation policy is the same one PE-13 verifies. Historical EF evidence below does not establish that boundary. The general checked-conversion contract owns the repair; Effect contributes its trusted token protocol. On this tree the L6/M7 scoreboard moved @@ -62,7 +62,7 @@ Verified row needs behavior-sensitive execution, not only a closure-shaped IR. | EF-11 | Structural verification checks trusted identities and checked WIT operation signatures, every recorded Effect application closure, each import plan against its host wrapper, and the complete transformed Core including generated wrappers. | Malformed identity, checked WIT scheme, import-plan, closure-shape, wrapper-signature, and post-wrapper Core fixtures fail before CC/encoding; these checks are reported as structural evidence only. | Verified | | EF-12 | `trap` is the `Effect Unit` whose application ends the guest instead of returning, and the effect chain sequenced after it does not run. | A failing library assertion writes its message and traps; a held one lets the program finish; a statement after the trap never writes. | Verified | | EF-13 | Entry selection resolves one source declaration: prefer `Main.main`, otherwise require a unique top-level `main`. The same `SymbolId` drives the runner check and any generated adapter; accepted result types are `Int` and trusted `Effect Unit`. | Source tests for preferred/fallback/ambiguous selection, aliases of `Effect Unit`, and agreement between selected identity, runner diagnostic, and generated adapter. | Verified | -| EF-14 | Effect application-to-closure lowering composes with the common abstract-constructor transport protocol across generic functions, dictionary methods and callbacks. | Execute discard, delayed map and `f Unit` cases with mandatory Wasmtime and exact output/status; retain the non-Effect Reader regression and verify the complete lowered representation. | Verified | +| EF-14 | Effect application-to-closure lowering composes with the common abstract-constructor representation policy across generic functions, dictionary methods and callbacks. | Execute discard, delayed map and `f Unit` cases with mandatory Wasmtime and exact output/status; retain the non-Effect Reader regression and verify the complete lowered representation. | Verified | ## Current evidence (2026-10-04) @@ -136,9 +136,13 @@ EF-14: Implementation: crates/psrs-core/src/instantiation.rs (checked instantiation), crates/psrs-backend/src/effects/mod.rs (the Effect representation owner contributes the runtime token as the `Effect` - constructor protocol), crates/psrs-backend/src/cc/lower/conversion/ + constructor policy), crates/psrs-backend/src/cc/lower/conversion/ (transport.rs and callable.rs) and cc/lower/{global,record,erased} - (evidence threaded to each boundary). + (evidence threaded to each boundary). The token and the + HIR-`TypeId`-keyed policy table are the transitional mechanism described in + [polymorphism and erasure](../../design/backend/fp/polymorphism-and-erasure.md#implementation-notes); + the design token is the `State# RealWorld` analogue and the policy should + travel with the value, not be keyed by source identity. Tests: tests::effects::discard_defined_from_bind_sequences_effects (stdout `a\nb\n`, exit 0); tests::functor:: mapping_an_effect_does_not_run_it_until_the_action_runs (stdout diff --git a/docs/implementation/backend/generic-aggregate-erasure.md b/docs/implementation/backend/generic-aggregate-erasure.md index 42f5cfbc..a35d87f0 100644 --- a/docs/implementation/backend/generic-aggregate-erasure.md +++ b/docs/implementation/backend/generic-aggregate-erasure.md @@ -1,7 +1,7 @@ # Generic Aggregate Erasure Implementation Acceptance **Feature:** [F-02](../../feature/F-02-portable-programs.md) -**Design:** [Generic aggregate erasure](../../design/backend/fp/generic-aggregate-erasure.md) +**Design:** [Runtime representation and checked boundaries](../../design/backend/fp/representation-and-evidence.md) **Progress:** Accepted against GA-01 through GA-20 after the independent review findings were fixed and required execution was repeated. The earlier audit and review findings below are retained as history; [resolution evidence](#resolution-of-independent-review-2026-09-25) diff --git a/docs/implementation/backend/polymorphism-and-erasure.md b/docs/implementation/backend/polymorphism-and-erasure.md index 5d7ffd2a..8e01ee90 100644 --- a/docs/implementation/backend/polymorphism-and-erasure.md +++ b/docs/implementation/backend/polymorphism-and-erasure.md @@ -339,6 +339,20 @@ PE-13: nodes on the type, and constructors other than `Function` and the registered Effect token protocol do not each have explicit execution evidence. The two experimental worktrees are stopped and are not integrated. +- **Transitional representation evidence (to remove).** P8 currently + reconstructs the checked instantiation relation from the immutable Core module + (`cc/lower/instantiation.rs`, `FunctionLowerer::source`) and derives callable + constructor policies from a HIR-`TypeId`-keyed table + (`FunctionLowerer::constructor_protocols`) plus a signature-prefix derivation + (`cc/layout/functions/mod.rs::transport_signatures`). The design + ([representation and + evidence](../../design/backend/fp/representation-and-evidence.md)) + calls for the checked relation and each erased value's representation policy + to be produced by their owning stages and carried through an explicit + Core-to-CC side table, the way `ExternalBindings` carries the WIT boundary. + These fields are the interim implementation and should be removed when that + side table lands; keying a semantic CC decision on a HIR identity, and + deriving a protocol by enumerating signatures, are not the model. - **Workspace suite still red on the Phase-3 migration.** Ten driver tests fail for reasons this topic does not own: five use `-` or `/` without importing the library operator that now owns it (`tests::scalars`, `tests::functions`, From f0c5441162b85047b548058ac615e2f4ec983784 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 20:18:55 +0800 Subject: [PATCH 011/148] Carry checked evidence and policies through a Core-to-CC side table Replace the transitional representation mechanisms with the boundary the design names. Checked instantiation evidence and each constructor's representation policy now travel to P8 through BoundaryEvidence beside CC, the same discipline ExternalBindings uses for WIT bindings. - Add RepresentationRegistry: Function stores under its checked instantiation arguments; the trusted Effect owner registers its runtime token. An unregistered constructor is reported, not resolved by arity. - Intern one payload-erased protocol signature per registered callable constructor, keyed by the concrete signature, replacing the signature-prefix derivation in cc/layout/functions. - Delete FunctionLowerer::source, constructor_protocols, transport_signatures, protocol_parameters, and cc/lower/instantiation.rs. - Route every use (global, direct call, dictionary field, erased local) through BoundaryEvidence. Behaviour is unchanged: the focused closure_protocol, partial_application, effects, and functor cases pass, and the driver suite stays at 549 passed/10 pre-existing failures. --- crates/psrs-backend/src/boundary.rs | 217 ++++++++++++++++++ .../src/cc/case/decision/realize/tests/mod.rs | 6 +- .../decision/realize/tests/nested_tests.rs | 6 +- .../decision/realize/tests/newtype_tests.rs | 6 +- .../tests/parameterized_tests/support.rs | 6 +- .../decision/realize/tests/product_tests.rs | 6 +- .../decision/realize/tests/record_tests.rs | 6 +- .../src/cc/layout/functions/mod.rs | 34 --- crates/psrs-backend/src/cc/layout/mod.rs | 7 +- .../src/cc/lower/call/application.rs | 7 +- .../src/cc/lower/conversion/tests.rs | 6 +- .../src/cc/lower/conversion/transport.rs | 47 +--- .../psrs-backend/src/cc/lower/erased/mod.rs | 7 +- crates/psrs-backend/src/cc/lower/global.rs | 4 +- .../src/cc/lower/instantiation.rs | 42 ---- .../psrs-backend/src/cc/lower/lambda/mod.rs | 4 +- crates/psrs-backend/src/cc/lower/mod.rs | 24 +- .../psrs-backend/src/cc/lower/record/mod.rs | 7 +- crates/psrs-backend/src/cc/mod.rs | 18 +- crates/psrs-backend/src/effects/mod.rs | 33 +-- crates/psrs-backend/src/lib.rs | 7 +- crates/psrs-backend/src/pipeline/mod.rs | 6 +- .../backend/fp/polymorphism-and-erasure.md | 20 +- .../backend/fp/representation-and-evidence.md | 27 +-- docs/implementation/backend/effects.md | 14 +- .../backend/polymorphism-and-erasure.md | 34 ++- 26 files changed, 349 insertions(+), 252 deletions(-) create mode 100644 crates/psrs-backend/src/boundary.rs delete mode 100644 crates/psrs-backend/src/cc/lower/instantiation.rs diff --git a/crates/psrs-backend/src/boundary.rs b/crates/psrs-backend/src/boundary.rs new file mode 100644 index 00000000..8f0594c5 --- /dev/null +++ b/crates/psrs-backend/src/boundary.rs @@ -0,0 +1,217 @@ +//! The Core-to-CC boundary side table. +//! +//! Checked instantiation evidence and the representation policies of source +//! constructors travel to P8 through this table, beside CC, the same way +//! [`crate::ExternalBindings`] carries the WIT boundary. P8 consumes it: it +//! does not read the Core type arena for a relation, key a semantic decision on +//! a HIR identity, or derive a producer policy by searching signatures. + +use crate::cc::{RefShape, Reference, Signature, SignatureId, ValueShape}; +use psrs_core::{Instantiation, Module as CoreModule, TypeConstructor, TypeId}; +use psrs_hir::TypeVariableId; +use std::collections::{HashMap, HashSet}; + +/// A representation owner's policy for the runtime form of a source +/// constructor. It records the constructor's fixed calling-convention +/// parameters; the payload is the value's declared result. +#[derive(Clone, Debug, PartialEq, Eq)] +pub(crate) enum RepresentationPolicy { + /// The fixed parameters are the constructor's checked instantiation + /// arguments (a function arrow's domain). + InstantiationArguments, + /// The owner registered explicit fixed parameters (the Effect runtime + /// token). The payload remains the application's result. + Fixed(Vec), +} + +/// The registry of representation owners, keyed by source constructor. +/// +/// `Function` stores its values under the arrow domain from the checked +/// instantiation; a representation owner registers additional constructors, +/// such as the trusted `Effect`. A constructor with no entry has no callable +/// representation contract, so transport reports it rather than guessing one +/// from the declaration arity or a signature search. +#[derive(Clone, Debug, Default, PartialEq, Eq)] +pub(crate) struct RepresentationRegistry { + policies: HashMap, +} + +impl RepresentationRegistry { + /// The built-in owners. `Function` is representation-directed by its own + /// checked instantiation arguments. + pub(crate) fn new() -> Self { + let mut registry = Self::default(); + registry.register( + TypeConstructor::Function, + RepresentationPolicy::InstantiationArguments, + ); + registry + } + + /// Registers one constructor's representation owner. + pub(crate) fn register(&mut self, constructor: TypeConstructor, policy: RepresentationPolicy) { + self.policies.insert(constructor, policy); + } + + /// The fixed protocol parameters for a constructor application, or `None` + /// when no owner registered the constructor. + pub(crate) fn protocol_parameters( + &self, + constructor: TypeConstructor, + arguments: &[TypeId], + ) -> Option> { + Some(match self.policies.get(&constructor)? { + RepresentationPolicy::InstantiationArguments => arguments.to_vec(), + RepresentationPolicy::Fixed(parameters) => parameters.clone(), + }) + } +} + +/// Checked evidence and producer policies at the Core-to-CC boundary. +pub(crate) struct BoundaryEvidence<'a> { + /// The immutable Core program that owns the checked relation. + source: &'a CoreModule, + /// The module under lowering. A relation whose type ids still exist in the + /// source uses the source; a type allocated only by representation + /// lowering uses the physical module. + physical: &'a CoreModule, + registry: RepresentationRegistry, + /// The payload-erased protocol signature of every callable constructor, + /// keyed by the concrete callable's signature. Built by P8 layout from the + /// registered owners and the module's callable signatures. + protocols: HashMap, +} + +impl<'a> BoundaryEvidence<'a> { + pub(crate) fn new( + source: &'a CoreModule, + physical: &'a CoreModule, + registry: RepresentationRegistry, + protocols: HashMap, + ) -> Self { + Self { + source, + physical, + registry, + protocols, + } + } + + /// A boundary with no relation beyond the module itself, for lowering + /// fixtures that exercise no abstract constructor protocol. + #[cfg(test)] + pub(crate) fn empty(physical: &'a CoreModule) -> Self { + Self::new( + physical, + physical, + RepresentationRegistry::new(), + HashMap::new(), + ) + } + + fn relation(&self, scheme: TypeId, instance: TypeId) -> &'a CoreModule { + if (scheme.0 as usize) < self.source.types.len() + && (instance.0 as usize) < self.source.types.len() + { + self.source + } else { + self.physical + } + } + + /// Checks a declaration use through the checking-owned relation, retaining + /// its solved constructor bindings. P8 reads the result; it does not + /// reimplement the relation. + pub(crate) fn instantiation_at( + &self, + scheme: TypeId, + instance: TypeId, + ) -> Option> { + let relation = self.relation(scheme, instance); + let quantified = scheme_quantifiers(relation, scheme); + relation.checked_instantiation(scheme, &quantified, instance) + } + + /// Checks a declaration use whose quantifiers are already known. + pub(crate) fn checked_instantiation( + &self, + scheme: TypeId, + quantified: &[TypeVariableId], + instance: TypeId, + ) -> Option> { + self.relation(scheme, instance) + .checked_instantiation(scheme, quantified, instance) + } + + /// The fixed protocol parameters for a constructor application. + pub(crate) fn protocol_parameters( + &self, + constructor: TypeConstructor, + arguments: &[TypeId], + ) -> Option> { + self.registry.protocol_parameters(constructor, arguments) + } + + /// The payload-erased protocol signature a callable constructor stores its + /// values under, keyed by the concrete callable signature. + pub(crate) fn protocol_signature(&self, concrete: SignatureId) -> Option { + self.protocols.get(&concrete).copied() + } +} + +/// Leading quantifiers of a scheme. Pre-seeding these keeps their constructor +/// bindings when instantiation opens the same quantifiers. +fn scheme_quantifiers(module: &CoreModule, mut ty: TypeId) -> Vec { + let mut variables = Vec::new(); + let mut seen = HashSet::new(); + while let Some((bound, body)) = psrs_core::forall_parts(&module.types, ty) { + if !seen.insert(ty) { + break; + } + variables.extend(bound.iter().copied()); + ty = body; + } + variables +} + +/// Builds the payload-erased protocol signature for every distinct callable +/// signature. The protocol keeps the concrete calling convention but erases the +/// payload, so a producer and its generic consumer can be related by the +/// constructor policy rather than by a cast onto the consumer's signature. +pub(crate) fn payload_erased_protocols( + representations: &mut crate::cc::RepresentationTable, + function_types: &HashMap, +) -> HashMap { + let mut protocols = HashMap::new(); + let mut interned = HashMap::::new(); + let mut ids = function_types.values().copied().collect::>(); + ids.sort_by_key(|id| id.0); + ids.dedup(); + for concrete in ids { + if protocols.contains_key(&concrete) { + continue; + } + let Some(parameters) = representations + .signature(concrete) + .map(|signature| signature.parameters.clone()) + else { + continue; + }; + let protocol = Signature { + parameters, + result: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }), + }; + let protocol_id = if let Some(existing) = interned.get(&protocol) { + *existing + } else { + let new = representations.add_signature(protocol.clone()); + interned.insert(protocol, new); + new + }; + protocols.insert(concrete, protocol_id); + } + protocols +} diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs index 7f017744..723be3c0 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs @@ -1,4 +1,5 @@ use super::*; +use crate::boundary::BoundaryEvidence; use crate::cc::lower::{FunctionLowerer, GeneratedSymbolAllocator}; use crate::cc::{ Assignment, AssignmentKind, Function, Module as CcModule, RepresentationTable, ValueDecl, @@ -126,6 +127,7 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { let function_types = HashMap::new(); let function_wrappers = HashMap::new(); let generated_symbols = Rc::new(RefCell::new(GeneratedSymbolAllocator::new(&module))); + let boundary = BoundaryEvidence::empty(&module); let mut lowerer = FunctionLowerer { next_value: 1, values: vec![ValueDecl { @@ -135,10 +137,8 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { locals: HashMap::new(), signatures: &signatures, representations: &representations, - transport_signatures: &HashMap::new(), module: &module, - source: &module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs index 2998695e..34251dd6 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs @@ -1,3 +1,4 @@ +use crate::boundary::BoundaryEvidence; use crate::cc::lower::{FunctionLowerer, GeneratedSymbolAllocator}; use crate::cc::{ Assignment, AssignmentKind, Function, RefShape, Reference, Representation, RepresentationTable, @@ -175,6 +176,7 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta nullable: false, heap: RefShape::Repr(representation), }); + let boundary = BoundaryEvidence::empty(&module); let mut lowerer = FunctionLowerer { next_value: 1, values: vec![ValueDecl { @@ -184,10 +186,8 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta locals: HashMap::new(), signatures: &signatures, representations: &representations, - transport_signatures: &HashMap::new(), module: &module, - source: &module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs index 66333930..4505c246 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs @@ -1,3 +1,4 @@ +use crate::boundary::BoundaryEvidence; use crate::cc::lower::{FunctionLowerer, GeneratedSymbolAllocator}; use crate::cc::{AssignmentKind, Function, RepresentationTable, ValueDecl, ValueShape}; use psrs_core::{ @@ -115,6 +116,7 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { let function_types = HashMap::new(); let function_wrappers = HashMap::new(); let generated_symbols = Rc::new(RefCell::new(GeneratedSymbolAllocator::new(&module))); + let boundary = BoundaryEvidence::empty(&module); let mut lowerer = FunctionLowerer { next_value: 1, values: vec![ValueDecl { @@ -124,10 +126,8 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { locals: HashMap::new(), signatures: &signatures, representations: &representations, - transport_signatures: &HashMap::new(), module: &module, - source: &module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs index f78620f4..522d8757 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs @@ -1,3 +1,4 @@ +use crate::boundary::BoundaryEvidence; use crate::cc::lower::{FunctionLowerer, GeneratedSymbolAllocator}; use crate::cc::{ Function, RefShape, Reference, ReprId, RepresentationTable, ValueDecl, ValueShape, @@ -43,6 +44,7 @@ pub(super) fn lower_and_verify( let function_types = HashMap::new(); let function_wrappers = HashMap::new(); let generated_symbols = Rc::new(RefCell::new(GeneratedSymbolAllocator::new(module))); + let boundary = BoundaryEvidence::empty(module); let mut lowerer = FunctionLowerer { next_value: 1, values: vec![ValueDecl { @@ -52,10 +54,8 @@ pub(super) fn lower_and_verify( locals: HashMap::new(), signatures: &signatures, representations: context.representations, - transport_signatures: &HashMap::new(), module, - source: module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: context.enum_types, aggregate_types: context.aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs index 4c6ab3e8..482cc45d 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs @@ -1,3 +1,4 @@ +use crate::boundary::BoundaryEvidence; use crate::cc::lower::{FunctionLowerer, GeneratedSymbolAllocator}; use crate::cc::{ Function, RefShape, Reference, Representation, RepresentationTable, ValueDecl, ValueShape, @@ -111,6 +112,7 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { nullable: false, heap: RefShape::Repr(representation), }); + let boundary = BoundaryEvidence::empty(&module); let mut lowerer = FunctionLowerer { next_value: 1, values: vec![ValueDecl { @@ -120,10 +122,8 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { locals: HashMap::new(), signatures: &signatures, representations: &representations, - transport_signatures: &HashMap::new(), module: &module, - source: &module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs index d21073b4..10baa07d 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs @@ -1,3 +1,4 @@ +use crate::boundary::BoundaryEvidence; use crate::cc::lower::{FunctionLowerer, GeneratedSymbolAllocator}; use crate::cc::{ AssignmentKind, Function, RefShape, Reference, Representation, RepresentationTable, ValueDecl, @@ -135,6 +136,7 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { nullable: false, heap: RefShape::Repr(record_repr), }); + let boundary = BoundaryEvidence::empty(&module); let mut lowerer = FunctionLowerer { next_value: 1, values: vec![ValueDecl { @@ -144,10 +146,8 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { locals: HashMap::new(), signatures: &signatures, representations: &representations, - transport_signatures: &HashMap::new(), module: &module, - source: &module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index fee341bc..49c89225 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -99,40 +99,6 @@ pub(super) struct FunctionLayouts { pub(super) function_types: HashMap, } -/// Registers physical callable-constructor protocols. A checked constructor -/// binding determines the fixed parameter prefix; the varying payload uses the -/// erased result protocol. These are representation-only signatures. -pub(super) fn transport_signatures( - representations: &mut RepresentationTable, -) -> HashMap, SignatureId> { - let mut interned = representations - .signatures - .iter() - .cloned() - .enumerate() - .map(|(index, signature)| (signature, SignatureId(index as u32))) - .collect::>(); - let signatures = representations.signatures.clone(); - let mut protocols = HashMap::new(); - for signature in signatures { - for count in 0..=signature.parameters.len() { - let parameters = signature.parameters[..count].to_vec(); - let protocol = Signature { - parameters: parameters.clone(), - result: ValueShape::Reference(crate::cc::Reference { - nullable: false, - heap: RefShape::Erased, - }), - }; - let id = *interned - .entry(protocol.clone()) - .or_insert_with(|| representations.add_signature(protocol)); - protocols.insert(parameters, id); - } - } - protocols -} - #[allow(clippy::too_many_arguments)] pub(crate) fn function_signature( module: &CoreModule, diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index c1da5258..d5faee92 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -288,7 +288,7 @@ pub(super) fn type_layout( } Ok(TypeLayout { - transport_signatures: functions::transport_signatures(&mut representations), + protocols: crate::boundary::payload_erased_protocols(&mut representations, &function_types), representations, array_types, record_types, @@ -300,7 +300,10 @@ pub(super) fn type_layout( } pub(super) struct TypeLayout { - pub(super) transport_signatures: HashMap, SignatureId>, + /// The payload-erased protocol signature of each callable constructor, + /// keyed by its concrete signature. Built from the registered + /// representation owners and the module's callable signatures. + pub(super) protocols: HashMap, pub(super) representations: RepresentationTable, pub(super) array_types: HashMap, pub(super) record_types: HashMap, diff --git a/crates/psrs-backend/src/cc/lower/call/application.rs b/crates/psrs-backend/src/cc/lower/call/application.rs index 6e9b0cef..7f0e9c54 100644 --- a/crates/psrs-backend/src/cc/lower/call/application.rs +++ b/crates/psrs-backend/src/cc/lower/call/application.rs @@ -60,8 +60,11 @@ impl ApplicationLowering for FunctionLowerer<'_> { .iter() .find(|declaration| declaration.symbol == function); let evidence = declaration.and_then(|declaration| { - self.source - .checked_instantiation(declaration.ty, &declaration.quantified, head.ty) + self.boundary.checked_instantiation( + declaration.ty, + &declaration.quantified, + head.ty, + ) }); self.check_call_shape( &signature, diff --git a/crates/psrs-backend/src/cc/lower/conversion/tests.rs b/crates/psrs-backend/src/cc/lower/conversion/tests.rs index 73ede8cc..d852276f 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/tests.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/tests.rs @@ -1,4 +1,5 @@ use super::*; +use crate::boundary::BoundaryEvidence; use crate::cc::RepresentationTable; use crate::cc::lower::GeneratedSymbolAllocator; use psrs_core::Type; @@ -36,16 +37,15 @@ fn unsupported_typed_boundary_reports_its_source_span() { let constructor_reprs = HashMap::new(); let function_types = HashMap::new(); let function_wrappers = HashMap::new(); + let boundary = BoundaryEvidence::empty(&module); let mut lowerer = FunctionLowerer { next_value: 0, values: Vec::new(), locals: HashMap::new(), signatures: &signatures, representations: &representations, - transport_signatures: &HashMap::new(), module: &module, - source: &module, - constructor_protocols: &HashMap::new(), + boundary: &boundary, enum_types: &ids, aggregate_types: &ids, newtype_ids: &ids, diff --git a/crates/psrs-backend/src/cc/lower/conversion/transport.rs b/crates/psrs-backend/src/cc/lower/conversion/transport.rs index d0bbbd62..80f18d9b 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/transport.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/transport.rs @@ -6,7 +6,7 @@ use crate::{ BackendError, cc::{RecoveryEvidence, RefShape, Reference, ValueConversion, ValueShape}, }; -use psrs_core::{Instantiation, Type, TypeConstructor, TypeId}; +use psrs_core::{Instantiation, Type, TypeId}; use psrs_span::TextRange; fn abstract_head(module: &psrs_core::Module, ty: TypeId) -> Option { @@ -52,18 +52,16 @@ impl FunctionLowerer<'_> { let (constructor, arguments) = evidence.and_then(|proof| proof.constructor(variable)) .ok_or_else(|| vec![BackendError::new("P8 closure conversion", span, format!("abstract constructor transport has no checked constructor binding for {variable:?}, endpoints {source:?} -> {target:?}"))])?; - let parameter_types = self.protocol_parameters(constructor, arguments, span)?; + let parameter_types = self + .boundary + .protocol_parameters(constructor, &arguments) + .ok_or_else(|| { + conversion_error(span, "constructor transport has no representation protocol") + })?; let parameters = parameter_types .into_iter() .map(|ty| self.value_shape(ty, span)) .collect::, _>>()?; - let protocol = self - .transport_signatures - .get(¶meters) - .copied() - .ok_or_else(|| { - conversion_error(span, "constructor transport has no registered signature") - })?; let concrete = callable(if entering { source_shape } else { target_shape }).unwrap(); let signature = self.representations.signature(concrete).ok_or_else(|| { conversion_error(span, "constructor transport has no concrete signature") @@ -74,6 +72,9 @@ impl FunctionLowerer<'_> { "constructor transport requires a callable segment adapter", )); } + let protocol = self.boundary.protocol_signature(concrete).ok_or_else(|| { + conversion_error(span, "constructor transport has no registered protocol") + })?; let payload = signature.result; let protocol_shape = ValueShape::Reference(Reference { nullable: false, @@ -99,32 +100,4 @@ impl FunctionLowerer<'_> { }; Ok(Some(plan)) } - - /// Fixed parameters of a constructor protocol. - /// - /// `Function` takes its checked instantiation arguments (the Reader domain). - /// A registered representation owner, such as Effect, supplies its own - /// hidden parameters (the runtime token) and does not read them off the - /// closure. An unregistered constructor is rejected. - fn protocol_parameters( - &self, - constructor: TypeConstructor, - arguments: Vec, - span: TextRange, - ) -> Result, Vec> { - match constructor { - TypeConstructor::Function if arguments.len() == 1 => Ok(arguments), - TypeConstructor::User(type_id) if arguments.is_empty() => self - .constructor_protocols - .get(&type_id) - .cloned() - .ok_or_else(|| { - conversion_error(span, "constructor transport has no representation protocol") - }), - _ => Err(conversion_error( - span, - "constructor transport has no callable representation contract", - )), - } - } } diff --git a/crates/psrs-backend/src/cc/lower/erased/mod.rs b/crates/psrs-backend/src/cc/lower/erased/mod.rs index 043aba5a..4610897c 100644 --- a/crates/psrs-backend/src/cc/lower/erased/mod.rs +++ b/crates/psrs-backend/src/cc/lower/erased/mod.rs @@ -46,12 +46,7 @@ impl FunctionLowerer<'_> { if source_type == target_type || !is_function_type(self.module, target_type) { return Ok(value); } - let evidence = super::instantiation::instantiation_at( - self.source, - self.module, - source_type, - target_type, - ); + let evidence = self.boundary.instantiation_at(source_type, target_type); self.adapt_erased_function_value( value, source_type, diff --git a/crates/psrs-backend/src/cc/lower/global.rs b/crates/psrs-backend/src/cc/lower/global.rs index 4f079208..66abb93e 100644 --- a/crates/psrs-backend/src/cc/lower/global.rs +++ b/crates/psrs-backend/src/cc/lower/global.rs @@ -90,7 +90,7 @@ impl GlobalLowering for FunctionLowerer<'_> { // Evidence is required only if the adaptation reaches an // abstract constructor boundary; `constructor_transport` // reports the missing binding where the boundary applies. - let evidence = self.source.checked_instantiation( + let evidence = self.boundary.checked_instantiation( source_type, &declaration.quantified, expression.ty, @@ -133,7 +133,7 @@ impl GlobalLowering for FunctionLowerer<'_> { global_error(expression, "global value has no source declaration type") })?; let source_type = declaration.ty; - let evidence = self.source.checked_instantiation( + let evidence = self.boundary.checked_instantiation( source_type, &declaration.quantified, expression.ty, diff --git a/crates/psrs-backend/src/cc/lower/instantiation.rs b/crates/psrs-backend/src/cc/lower/instantiation.rs deleted file mode 100644 index 9390cfeb..00000000 --- a/crates/psrs-backend/src/cc/lower/instantiation.rs +++ /dev/null @@ -1,42 +0,0 @@ -//! Checked scheme/use evidence for representation conversion. -//! -//! The evidence borrows the module that owns the relation, not the lowerer, so -//! a later conversion can mutably borrow the lowerer. - -use psrs_core::{Instantiation, Module, TypeId}; -use psrs_hir::TypeVariableId; -use std::collections::HashSet; - -/// Checked scheme/use bindings. Leading quantifiers are pre-seeded so opening -/// them retains constructor replacements. Relations whose type ids still exist -/// use the immutable source module. -pub(in crate::cc::lower) fn instantiation_at<'a>( - source: &'a Module, - physical: &'a Module, - scheme: TypeId, - instance: TypeId, -) -> Option> { - let relation = - if (scheme.0 as usize) < source.types.len() && (instance.0 as usize) < source.types.len() { - source - } else { - physical - }; - let quantified = scheme_quantifiers(relation, scheme); - relation.checked_instantiation(scheme, &quantified, instance) -} - -/// Leading quantifiers of a scheme. Pre-seeding these keeps their constructor -/// bindings when instantiation opens the same quantifiers. -fn scheme_quantifiers(module: &Module, mut ty: TypeId) -> Vec { - let mut variables = Vec::new(); - let mut seen = HashSet::new(); - while let Some((bound, body)) = psrs_core::forall_parts(&module.types, ty) { - if !seen.insert(ty) { - break; - } - variables.extend(bound.iter().copied()); - ty = body; - } - variables -} diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index 071adea0..24c5f99d 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -314,10 +314,8 @@ impl LambdaLowering for FunctionLowerer<'_> { locals: HashMap::new(), signatures: self.signatures, representations: self.representations, - transport_signatures: self.transport_signatures, module: self.module, - source: self.source, - constructor_protocols: self.constructor_protocols, + boundary: self.boundary, enum_types: self.enum_types, aggregate_types: self.aggregate_types, newtype_ids: self.newtype_ids, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 5e0d9caa..5056b074 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -3,6 +3,7 @@ use super::{ Assignment, AssignmentKind, Function, ReprId, RepresentationTable, Signature, SignatureId, ValueDecl, ValueId, ValueShape, }; +use crate::boundary::BoundaryEvidence; use crate::{BackendError, BackendWarning}; use psrs_core::{Expr, ExprKind, Module as CoreModule, dictionary::ClassLayout}; use psrs_hir::{LocalId, ModuleId, SymbolId, TypeId as HirTypeId}; @@ -17,7 +18,6 @@ mod conversion; mod dictionary; mod erased; mod global; -pub(in crate::cc::lower) mod instantiation; mod intrinsic; mod lambda; mod letrec; @@ -35,16 +35,12 @@ pub(in crate::cc) use symbols::GeneratedSymbolAllocator; pub(super) struct LoweringContext<'a> { pub(super) module: &'a CoreModule, - /// Types used for checked instantiation. This is the physical module when - /// representation lowering has not rewritten any source type. - pub(super) source: &'a CoreModule, - /// Fixed calling-convention parameters registered by a representation - /// owner, keyed by the source constructor. `Function` is not in this map: - /// its fixed parameters are the checked instantiation arguments. - pub(super) constructor_protocols: &'a HashMap>, + /// The Core-to-CC boundary side table: checked instantiation evidence and + /// the registered representation policies. Replaces ambient reads of the + /// Core arena and any HIR-keyed protocol table. + pub(super) boundary: &'a BoundaryEvidence<'a>, pub(super) signatures: &'a HashMap, pub(super) representations: &'a RepresentationTable, - pub(super) transport_signatures: &'a HashMap, SignatureId>, pub(super) enum_types: &'a HashSet, pub(super) aggregate_types: &'a HashSet, pub(super) newtype_ids: &'a HashSet, @@ -72,10 +68,8 @@ pub(super) fn lower_function( local_types: HashMap::new(), signatures: context.signatures, representations: context.representations, - transport_signatures: context.transport_signatures, module, - source: context.source, - constructor_protocols: context.constructor_protocols, + boundary: context.boundary, enum_types: context.enum_types, aggregate_types: context.aggregate_types, newtype_ids: context.newtype_ids, @@ -214,10 +208,10 @@ pub(super) struct FunctionLowerer<'a> { pub(super) local_types: HashMap, pub(super) signatures: &'a HashMap, pub(super) representations: &'a RepresentationTable, - pub(super) transport_signatures: &'a HashMap, SignatureId>, pub(super) module: &'a CoreModule, - pub(super) source: &'a CoreModule, - pub(super) constructor_protocols: &'a HashMap>, + /// Checked instantiation evidence and registered representation policies, + /// supplied by the Core-to-CC boundary. + pub(super) boundary: &'a BoundaryEvidence<'a>, pub(super) enum_types: &'a HashSet, pub(super) aggregate_types: &'a HashSet, pub(super) newtype_ids: &'a HashSet, diff --git a/crates/psrs-backend/src/cc/lower/record/mod.rs b/crates/psrs-backend/src/cc/lower/record/mod.rs index fd7dee6b..3056f0f9 100644 --- a/crates/psrs-backend/src/cc/lower/record/mod.rs +++ b/crates/psrs-backend/src/cc/lower/record/mod.rs @@ -273,12 +273,7 @@ impl FunctionLowerer<'_> { // is the checked instance, including a constructor such as Effect. // The source module still has that relation after representation // rewriting replaces applications at the same type ids. - let evidence = super::instantiation::instantiation_at( - self.source, - self.module, - field_layout.ty, - target_type, - ); + let evidence = self.boundary.instantiation_at(field_layout.ty, target_type); let conversion = self.typed_conversion_with_instantiation( field_layout.ty, target_type, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 63e27fd1..1ef6d9ea 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -1,3 +1,4 @@ +use crate::boundary::{BoundaryEvidence, RepresentationRegistry}; use crate::{BackendError, BackendInput, ExternalBindings, annotate_errors}; use psrs_core::Module as CoreModule; use psrs_hir::{SymbolId, TypeId as HirTypeId}; @@ -248,18 +249,18 @@ pub fn lower_module_with_bindings( module: CoreModule, bindings: ExternalBindings, ) -> Result> { - lower_module_with_relations(module, bindings, None, &HashMap::new()) + lower_module_with_relations(module, bindings, None, RepresentationRegistry::new()) } -/// Lowers Core using an immutable source module for instantiation evidence and -/// representation-owner constructor protocols. `source` is the pre-lowering -/// module when effect applications have been rewritten; otherwise it is absent -/// and relations are read from `module` itself. +/// Lowers Core using the Core-to-CC boundary side table: an immutable source +/// program for checked instantiation evidence and the registered representation +/// policies. `source` is the pre-lowering module when effect applications have +/// been rewritten; otherwise it is absent and relations are read from `module`. pub(crate) fn lower_module_with_relations( module: CoreModule, bindings: ExternalBindings, source: Option<&CoreModule>, - protocols: &HashMap>, + registry: RepresentationRegistry, ) -> Result> { bindings.validate_core(&module)?; let relations = source.unwrap_or(&module); @@ -349,13 +350,12 @@ pub(crate) fn lower_module_with_relations( (declaration.symbol, wrapper) }) .collect::>(); + let boundary = BoundaryEvidence::new(relations, &module, registry, layout.protocols); let context = LoweringContext { module: &module, - source: relations, - constructor_protocols: protocols, + boundary: &boundary, signatures: &signatures, representations: &layout.representations, - transport_signatures: &layout.transport_signatures, enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, diff --git a/crates/psrs-backend/src/effects/mod.rs b/crates/psrs-backend/src/effects/mod.rs index d7afdb22..f1de3058 100644 --- a/crates/psrs-backend/src/effects/mod.rs +++ b/crates/psrs-backend/src/effects/mod.rs @@ -5,17 +5,17 @@ mod entry; mod suspension; mod verify; +use super::boundary::{RepresentationPolicy, RepresentationRegistry}; use crate::BackendError; use crate::bindings::ExternalBindings; -use psrs_core::{Module as CoreModule, TypeId, effect::EffectCompilation}; -use psrs_hir::TypeId as HirTypeId; -use std::collections::{HashMap, HashSet}; +use psrs_core::{Module as CoreModule, TypeConstructor, effect::EffectCompilation}; +use std::collections::HashSet; /// Source Core captured before effect applications become closures, plus the -/// token protocol the Effect representation owner contributes to conversion. +/// representation registry the Effect owner contributes to conversion. pub(crate) struct EffectPreparation { pub(crate) source: CoreModule, - pub(crate) protocols: HashMap>, + pub(crate) registry: RepresentationRegistry, } pub(crate) fn lower_effects( @@ -29,7 +29,7 @@ pub(crate) fn lower_effects( let source = module.clone(); let lowering = psrs_core::effect::lower_effects(module, &context.trusted) .map_err(|errors| verify::verification_errors(&errors))?; - let protocols = effect_protocols(module, &context.trusted, &lowering)?; + let registry = effect_registry(module, &context.trusted, &lowering)?; let applied = suspension::apply(module, bindings, &suspensions)?; if let Some(entry) = context.command_entry { @@ -47,17 +47,17 @@ pub(crate) fn lower_effects( bindings .imports .retain(|binding| !synthesized.contains(&binding.symbol)); - Ok(EffectPreparation { source, protocols }) + Ok(EffectPreparation { source, registry }) } -/// The Effect constructor's stored calling convention is the token chosen by -/// effect lowering. The payload remains the application's result and is not a -/// hidden parameter. -fn effect_protocols( +/// The Effect representation owner registers its constructor's stored calling +/// convention: the runtime token chosen by effect lowering. The payload +/// remains the application's result and is not a hidden parameter. +fn effect_registry( module: &CoreModule, trusted: &psrs_core::effect::TrustedEffect, lowering: &psrs_core::effect::EffectLowering, -) -> Result>, Vec> { +) -> Result> { let mut tokens = HashSet::new(); for closure in &lowering.closures { tokens.insert(closure.token); @@ -69,11 +69,14 @@ fn effect_protocols( "Effect lowering produced more than one runtime token", )]); } - let mut protocols = HashMap::new(); + let mut registry = RepresentationRegistry::new(); if let Some(token) = tokens.into_iter().next() { - protocols.insert(trusted.effect_type, vec![token]); + registry.register( + TypeConstructor::User(trusted.effect_type), + RepresentationPolicy::Fixed(vec![token]), + ); } - Ok(protocols) + Ok(registry) } fn validate_entry_context( diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 91d48821..25c3b979 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -1,5 +1,6 @@ pub mod abi; mod bindings; +mod boundary; pub mod capability; pub mod cc; pub mod component; @@ -150,13 +151,13 @@ pub fn lower_cc_with_context( ) -> Result> { let mut external_bindings = ExternalBindings::from_core(&module); let mut source = None; - let mut protocols = std::collections::HashMap::new(); + let mut registry = boundary::RepresentationRegistry::new(); if let Some(context) = effect_context { let prepared = effects::lower_effects(&mut module, &mut external_bindings, context)?; - protocols = prepared.protocols; + registry = prepared.registry; source = Some(prepared.source); } - cc::lower_module_with_relations(module, external_bindings, source.as_ref(), &protocols) + cc::lower_module_with_relations(module, external_bindings, source.as_ref(), registry) } /// The default-profile validator, retained for backend unit tests. diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs index c48dc674..be11f043 100644 --- a/crates/psrs-backend/src/pipeline/mod.rs +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -91,7 +91,7 @@ pub(crate) fn compile_with_context_inner( }; let mut effect_source = None; - let mut effect_protocols = std::collections::HashMap::new(); + let mut effect_registry = crate::boundary::RepresentationRegistry::new(); if let Some(context) = effect_context.as_ref() { let effect_call = trace.as_deref_mut().map(|trace| { trace.begin( @@ -116,7 +116,7 @@ pub(crate) fn compile_with_context_inner( return Err(errors); } }; - effect_protocols = prepared.protocols; + effect_registry = prepared.registry; effect_source = Some(prepared.source); if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { let outputs = trace.complete( @@ -190,7 +190,7 @@ pub(crate) fn compile_with_context_inner( module, external_bindings, effect_source.as_ref(), - &effect_protocols, + effect_registry, ) { Ok(lowered) => lowered, Err(errors) => { diff --git a/docs/design/backend/fp/polymorphism-and-erasure.md b/docs/design/backend/fp/polymorphism-and-erasure.md index 856e133c..8f57b915 100644 --- a/docs/design/backend/fp/polymorphism-and-erasure.md +++ b/docs/design/backend/fp/polymorphism-and-erasure.md @@ -646,18 +646,14 @@ conversion plans, including recursive function-adapter leaves. The distinguishes source programs from verified Typed Core backend fixtures and records source coverage and remaining obligations. -**Transitional mechanism.** The current lowering does not yet carry a -representation policy explicitly. It reconstructs the checked boundary -relation inside P8 from the immutable Core module, and it derives callable -constructor policies from a constructor-identity table supplied by the Effect -owner plus a signature-prefix derivation over the registered signatures. Both -are interim implementations of this design, not the model: the checked -relation and each value's representation policy should be produced by their -owning stages and travel to P8 through an explicit Core-to-CC side table, the -same boundary discipline `ExternalBindings` already uses. Keying a semantic -decision on a HIR type identity inside CC, and deriving a protocol by -enumerating signatures, are deviations to remove once that side table exists; -they are recorded as such in the acceptance record. +Checked instantiation evidence and each constructor's representation policy +travel to P8 through the Core-to-CC side table +(`psrs-backend/src/boundary.rs`), beside CC the way `ExternalBindings` carries +the WIT boundary. The `RepresentationRegistry` registers `Function` (its checked +instantiation arguments are the fixed protocol parameters) and the trusted +`Effect` (its runtime token); an unregistered constructor is reported rather +than resolved by arity or a signature search, and the payload-erased protocol +signature is interned once per registered callable constructor. ## References diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index 957bd557..c2e0e3c0 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -490,19 +490,20 @@ directly in the erased slot and needs no array map. ## Implementation notes -The current lowering implements this contract in part. It reconstructs the -checked relation inside P8 from the immutable Core module -(`cc/lower/instantiation.rs`), and it derives callable constructor policies from -a HIR-`TypeId`-keyed table (`FunctionLowerer::constructor_protocols`) plus a -signature-prefix derivation (`cc/layout/functions/mod.rs::transport_signatures`). -Those are interim mechanisms, not the model: the checked relation and each -producer policy should be produced by their owning stages and travel through the -side table. Keying a semantic CC decision on a HIR identity, and deriving a -policy by enumerating signatures, are the deviations to remove, and they are -recorded in -[polymorphism and erasure](../../../implementation/backend/polymorphism-and-erasure.md). - -The effect token is likewise a placeholder: the model makes it the `State# +Checked instantiation evidence and the representation policies of constructors +reach P8 through the Core-to-CC side table (`psrs-backend/src/boundary.rs`), +beside CC the way `ExternalBindings` carries the WIT boundary. P8 reads the +checked relation from the immutable source program and the registered +`RepresentationPolicy` per constructor; it does not reconstruct the relation +from the Core type arena, key a semantic decision on a HIR identity, or derive a +policy by enumerating signatures. The registry registers `Function` (whose fixed +parameters are its checked instantiation arguments) and the trusted `Effect` +(whose fixed parameter is its runtime token); an unregistered constructor is +reported rather than resolved by arity or a signature search. Protocol +signatures are interned once per registered callable constructor as the concrete +calling convention with the payload erased. + +The effect token remains a placeholder: the model makes it the `State# RealWorld` analogue, while the current lowering uses the constant `i32` `0` ([effects](../../../implementation/backend/effects.md)). diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index b07a8454..51e8599c 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -135,14 +135,12 @@ EF-13: EF-14: Implementation: crates/psrs-core/src/instantiation.rs (checked instantiation), crates/psrs-backend/src/effects/mod.rs (the Effect - representation owner contributes the runtime token as the `Effect` - constructor policy), crates/psrs-backend/src/cc/lower/conversion/ - (transport.rs and callable.rs) and cc/lower/{global,record,erased} - (evidence threaded to each boundary). The token and the - HIR-`TypeId`-keyed policy table are the transitional mechanism described in - [polymorphism and erasure](../../design/backend/fp/polymorphism-and-erasure.md#implementation-notes); - the design token is the `State# RealWorld` analogue and the policy should - travel with the value, not be keyed by source identity. + representation owner registers the runtime token as a + `RepresentationPolicy` in the Core-to-CC registry), crates/psrs-backend/ + src/boundary.rs (`BoundaryEvidence`), crates/psrs-backend/src/cc/lower/ + conversion/ (transport.rs and callable.rs) and cc/lower/{global,record,erased} + (evidence read from the boundary at each use). The token itself is still the + `i32` `0` placeholder; the design token is the `State# RealWorld` analogue. Tests: tests::effects::discard_defined_from_bind_sequences_effects (stdout `a\nb\n`, exit 0); tests::functor:: mapping_an_effect_does_not_run_it_until_the_action_runs (stdout diff --git a/docs/implementation/backend/polymorphism-and-erasure.md b/docs/implementation/backend/polymorphism-and-erasure.md index 8e01ee90..c3b68bac 100644 --- a/docs/implementation/backend/polymorphism-and-erasure.md +++ b/docs/implementation/backend/polymorphism-and-erasure.md @@ -276,15 +276,16 @@ PE-13: Implementation: psrs-core/src/instantiation.rs (read-only checked instantiation evidence), psrs-core/src/verify/types/matching/invariant.rs (invariant matcher with explicit constructor binding), psrs-backend/src/ - cc/lower/instantiation.rs (scheme/use evidence that borrows the immutable - source module), cc/lower/conversion/transport.rs (constructor transport), + boundary.rs (BoundaryEvidence and the RepresentationRegistry: scheme/use + evidence read from the immutable source module; Function and Effect + constructor policies; payload-erased protocol signatures), + cc/lower/conversion/transport.rs (constructor transport), cc/lower/conversion/callable.rs (representation-only adapter emission), cc/lower/conversion/mod.rs (plan_conversion consults transport first), cc/lower/erased/mod.rs and cc/lower/{global,record}/mod.rs (evidence - threaded to the boundary), cc/lower/call/partial.rs + read from the boundary at the use), cc/lower/call/partial.rs (lower_indirect_partial_application captures an under-applied local or - dictionary callee), cc/layout/functions/mod.rs - (transport_signatures registers the producer protocol). + dictionary callee). Tests: psrs-driver tests::closure_protocol:: reader_dictionary_returns_the_concrete_result (Reader `Chain ((->) Int)` exits 42 with empty stdout), @@ -339,20 +340,15 @@ PE-13: nodes on the type, and constructors other than `Function` and the registered Effect token protocol do not each have explicit execution evidence. The two experimental worktrees are stopped and are not integrated. -- **Transitional representation evidence (to remove).** P8 currently - reconstructs the checked instantiation relation from the immutable Core module - (`cc/lower/instantiation.rs`, `FunctionLowerer::source`) and derives callable - constructor policies from a HIR-`TypeId`-keyed table - (`FunctionLowerer::constructor_protocols`) plus a signature-prefix derivation - (`cc/layout/functions/mod.rs::transport_signatures`). The design - ([representation and - evidence](../../design/backend/fp/representation-and-evidence.md)) - calls for the checked relation and each erased value's representation policy - to be produced by their owning stages and carried through an explicit - Core-to-CC side table, the way `ExternalBindings` carries the WIT boundary. - These fields are the interim implementation and should be removed when that - side table lands; keying a semantic CC decision on a HIR identity, and - deriving a protocol by enumerating signatures, are not the model. +- **Representation evidence and policies (landed).** Checked instantiation + evidence and constructor representation policies reach P8 through the + Core-to-CC side table (`psrs-backend/src/boundary.rs`). The + `RepresentationRegistry` registers `Function` (checked instantiation arguments) + and the trusted `Effect` (runtime token); `BoundaryEvidence` provides the + checking-owned relation and the payload-erased protocol signature of each + callable constructor. `FunctionLowerer::source`, `constructor_protocols`, and + `transport_signatures` are gone. What remains is the effect token placeholder + and the two-relation matcher, tracked separately. - **Workspace suite still red on the Phase-3 migration.** Ten driver tests fail for reasons this topic does not own: five use `-` or `/` without importing the library operator that now owns it (`tests::scalars`, `tests::functions`, From 161de49c06d3820e9d055a09568063089316dad8 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 20:29:07 +0800 Subject: [PATCH 012/148] Provide Unsafe.Coerce.unsafeCoerce as a compiler primitive Register Unsafe.Coerce in the compiler-provided interface and the unsafeCoerce intrinsic in the compiler vocabulary, so the vendored module is never loaded and its self-recursive body never takes effect. - Add Intrinsic::UnsafeCoerce with the forall a b. a -> b scheme. - Infer it as an unconstrained coercion function (no Coercible wanted); finalize closes it to a THIR UnsafeCoerce node lowered to Core's RepresentationCast. - Lower the intrinsic in CC through the common conversion planner, so it reinterprets the value at the erased boundary. - Add execution evidence (newtype through unsafeCoerce) plus the compiler-spelling scope test. The driver suite stays at 551 passed/10 pre-existing failures. --- crates/psrs-backend/src/cc/lower/intrinsic.rs | 21 ++++++++++++ crates/psrs-core/src/lower/mod.rs | 23 +++++++++++++ crates/psrs-core/src/lower/module.rs | 1 + crates/psrs-driver/src/tests/coercion.rs | 30 +++++++++++++++++ .../psrs-driver/src/tests/source_evidence.rs | 4 +++ crates/psrs-hir/src/intrinsic/mod.rs | 10 ++++-- crates/psrs-hir/src/intrinsic/registry.rs | 7 ++++ .../src/resolver/module_resolution.rs | 10 +++--- .../src/resolver/program/interface.rs | 5 +++ crates/psrs-thir/src/lib.rs | 9 ++++++ crates/psrs-thir/src/scope/mod.rs | 23 +++++++++++++ crates/psrs-thir/src/verify/mod.rs | 13 ++++++++ crates/psrs-thir/src/verify/semantics/mod.rs | 8 +++++ .../psrs-typecheck/src/typecheck/finalize.rs | 32 +++++++++++++++++++ .../src/typecheck/infer/intrinsics.rs | 25 ++++++++++++--- .../psrs-typecheck/src/typecheck/infer/mod.rs | 3 ++ crates/psrs-typecheck/src/typecheck/result.rs | 6 ++++ .../semantics/modules-and-resolution.md | 9 +++--- docs/design/frontend/type-system/prim.md | 2 +- .../frontend/roles-and-coercions.md | 6 +++- 20 files changed, 231 insertions(+), 16 deletions(-) diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index c92dcd70..57ab1d29 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -71,6 +71,27 @@ impl FunctionLowerer<'_> { Intrinsic::BytesToString => { self.lower_bytes_to_string(expression, &arguments[0], ty, assignments) } + Intrinsic::UnsafeCoerce => { + let argument = &arguments[0]; + let source_type = argument.ty; + let source_shape = self.value_shape(source_type, expression.span)?; + let value = self.lower_value(argument, assignments)?; + let conversion = self.typed_conversion( + source_type, + expression.ty, + source_shape, + ty, + expression.span, + )?; + Ok(self.emit_conversion( + value, + source_shape, + ty, + conversion, + expression.span, + assignments, + )) + } _ => match intrinsic.descriptor().category { IntrinsicCategory::BinaryScalar => { let left = self.lower_value(&arguments[0], assignments)?; diff --git a/crates/psrs-core/src/lower/mod.rs b/crates/psrs-core/src/lower/mod.rs index a17218d1..5cdd6218 100644 --- a/crates/psrs-core/src/lower/mod.rs +++ b/crates/psrs-core/src/lower/mod.rs @@ -185,6 +185,29 @@ fn lower_expr( target_type: TypeId(target_type.0), } } + TypedExprKind::UnsafeCoerce { + value, + source_type, + target_type, + } => { + if source_type != value.ty || target_type.0 != ty.0 { + return Err(LowerError { + span, + message: "unsafe coercion boundary does not match its value and result", + }); + } + ExprKind::RepresentationCast { + value: Box::new(lower_expr( + *value, + externals, + constructors, + source_types, + context, + )?), + source_type: TypeId(source_type.0), + target_type: TypeId(target_type.0), + } + } TypedExprKind::Application(function, argument) => { let function = lower_expr(*function, externals, constructors, source_types, context)?; let argument = lower_expr(*argument, externals, constructors, source_types, context)?; diff --git a/crates/psrs-core/src/lower/module.rs b/crates/psrs-core/src/lower/module.rs index d04cbe72..2c0c9fae 100644 --- a/crates/psrs-core/src/lower/module.rs +++ b/crates/psrs-core/src/lower/module.rs @@ -59,6 +59,7 @@ fn scan_expr_locals(expression: &psrs_thir::Expr, max: &mut Option) { scan_expr_locals(value, max); scan_evidence_locals(evidence, max); } + psrs_thir::ExprKind::UnsafeCoerce { value, .. } => scan_expr_locals(value, max), psrs_thir::ExprKind::Application(function, argument) => { scan_expr_locals(function, max); scan_expr_locals(argument, max); diff --git a/crates/psrs-driver/src/tests/coercion.rs b/crates/psrs-driver/src/tests/coercion.rs index ac6041f0..d6b50692 100644 --- a/crates/psrs-driver/src/tests/coercion.rs +++ b/crates/psrs-driver/src/tests/coercion.rs @@ -259,6 +259,36 @@ fn compiler_coercion_intrinsic_is_only_in_scope_through_safe_coerce() { rejects(&[("Main.purs", source)], "UnknownName"); } +#[test] +fn compiler_unsafe_coercion_intrinsic_is_only_in_scope_through_unsafe_coerce() { + let source = "module Main where\n\ + main :: Int\n\ + main = __psrs_unsafe_coerce 42\n"; + rejects(&[("Main.purs", source)], "UnknownName"); +} + +#[test] +fn unsafe_coerce_is_a_compiler_primitive_identity_cast() { + let source = r#" +module Main where + +import Unsafe.Coerce (unsafeCoerce) + +newtype Age = Age Int + +asInt :: Age -> Int +asInt = unsafeCoerce + +main :: Int +main = asInt (Age 42) +"#; + let Some(output) = super::run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + #[test] fn an_imported_newtype_requires_its_constructor_for_unwrapping() { let library = "module Lib (Age, age) where\n\ diff --git a/crates/psrs-driver/src/tests/source_evidence.rs b/crates/psrs-driver/src/tests/source_evidence.rs index 2e94710f..d528ea71 100644 --- a/crates/psrs-driver/src/tests/source_evidence.rs +++ b/crates/psrs-driver/src/tests/source_evidence.rs @@ -64,6 +64,10 @@ fn walk_expr(expression: &psrs_thir::Expr, seen: &mut Seen) { walk_evidence(evidence, seen); seen.coercible = true; } + ExprKind::UnsafeCoerce { value, .. } => { + walk_expr(value, seen); + seen.coercible = true; + } ExprKind::Array(elements) => { for element in elements { walk_expr(element, seen); diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 7127e899..a28d5f00 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -92,6 +92,11 @@ pub enum Intrinsic { /// of a computed length has no source spelling; the library's /// `Semigroup (Array a)` instance and `Semigroup String` are its users. ArrayAppend, + /// Source-level `Unsafe.Coerce.unsafeCoerce`, the unchecked representation + /// coercion (`unsafeCoerce#`). Unlike `Coerce` it carries no `Coercible` + /// proof; it is a representation-preserving cast at the value's erased + /// boundary. + UnsafeCoerce, } impl Intrinsic { @@ -107,7 +112,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 60] = [ + pub const ALL: [Intrinsic; 61] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -168,6 +173,7 @@ impl Intrinsic { Intrinsic::Undefined, Intrinsic::Unit, Intrinsic::ArrayAppend, + Intrinsic::UnsafeCoerce, ]; } @@ -176,7 +182,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::ArrayAppend as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::UnsafeCoerce as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 597838a7..a533f2aa 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -141,6 +141,7 @@ descriptors! { Undefined => "__psrs_undefined", 0, PartialValue, scheme::undefined; Unit => "unit", 0, Nullary, scheme::unit; ArrayAppend => "arrayAppend", 2, ArrayAppend, scheme::array_append; + UnsafeCoerce => "__psrs_unsafe_coerce", 1, Coercion, scheme::unsafe_coerce; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that @@ -348,6 +349,12 @@ mod scheme { span: empty_span(), } } + + /// `Unsafe.Coerce.unsafeCoerce`: an unconstrained identity cast. It has no + /// `Coercible` proof; the value crosses its erased representation unchanged. + pub(super) fn unsafe_coerce() -> Type { + forall(&["a", "b"], arrow(variable("a"), variable("b"))) + } } #[cfg(test)] diff --git a/crates/psrs-resolve/src/resolver/module_resolution.rs b/crates/psrs-resolve/src/resolver/module_resolution.rs index 1aa3b093..6e2ecabc 100644 --- a/crates/psrs-resolve/src/resolver/module_resolution.rs +++ b/crates/psrs-resolve/src/resolver/module_resolution.rs @@ -47,12 +47,14 @@ pub(crate) fn resolve_ast_module( let mut external_globals = HashMap::new(); for external in &inputs.externals { - // `coerce` and `undefined` are reached through their virtual module - // interfaces, not as free names, so their bootstrap spellings stay out - // of the value namespace. + // `coerce`, `unsafeCoerce`, and `undefined` are reached through their + // virtual module interfaces, not as free names, so their bootstrap + // spellings stay out of the value namespace. if matches!( &external.kind, - ExternalKind::Intrinsic(hir::Intrinsic::Coerce | hir::Intrinsic::Undefined) + ExternalKind::Intrinsic( + hir::Intrinsic::Coerce | hir::Intrinsic::UnsafeCoerce | hir::Intrinsic::Undefined + ) ) { continue; } diff --git a/crates/psrs-resolve/src/resolver/program/interface.rs b/crates/psrs-resolve/src/resolver/program/interface.rs index 74c57ef6..cb4cc391 100644 --- a/crates/psrs-resolve/src/resolver/program/interface.rs +++ b/crates/psrs-resolve/src/resolver/program/interface.rs @@ -51,6 +51,11 @@ impl Interface { TypeReference::Named(TypeId::COERCIBLE), ); } + "Unsafe.Coerce" => { + interface + .values + .insert("unsafeCoerce".to_owned(), Intrinsic::UnsafeCoerce.symbol()); + } _ if name != "Prim.Coerce" && !hir::primitive_type_declarations() .iter() diff --git a/crates/psrs-thir/src/lib.rs b/crates/psrs-thir/src/lib.rs index 192819de..ab016f77 100644 --- a/crates/psrs-thir/src/lib.rs +++ b/crates/psrs-thir/src/lib.rs @@ -287,6 +287,15 @@ pub enum ExprKind { source_type: TypeId, target_type: TypeId, }, + /// An unchecked representational conversion from `Unsafe.Coerce`. Unlike + /// [`ExprKind::Coerce`] it carries no `Coercible` proof; the value crosses + /// its erased representation unchanged. Core lowers it to a + /// `RepresentationCast`. + UnsafeCoerce { + value: Box, + source_type: TypeId, + target_type: TypeId, + }, Application(Box, Box), Lambda { binder: Binder, diff --git a/crates/psrs-thir/src/scope/mod.rs b/crates/psrs-thir/src/scope/mod.rs index ee3011af..42857a86 100644 --- a/crates/psrs-thir/src/scope/mod.rs +++ b/crates/psrs-thir/src/scope/mod.rs @@ -258,6 +258,29 @@ fn verify_expr_scope( errors, ); } + ExprKind::UnsafeCoerce { + value, + source_type, + target_type, + } => { + verify_expr_scope(value, types, scope, errors); + verify_type_scope( + *source_type, + types, + scope, + expression.span, + &mut HashSet::new(), + errors, + ); + verify_type_scope( + *target_type, + types, + scope, + expression.span, + &mut HashSet::new(), + errors, + ); + } ExprKind::Application(function, argument) => { let binders = leading_foralls(types, expression.ty); let mut function_scope = scope.clone(); diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index e8db1f3a..83ddd075 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -164,6 +164,19 @@ fn verify_expr(expression: &Expr, module: &Module, errors: &mut Vec }), } } + ExprKind::UnsafeCoerce { + value, + source_type, + target_type, + } => { + verify_expr(value, module, errors); + if *source_type != value.ty || *target_type != expression.ty { + errors.push(VerifyError { + span: expression.span, + message: "unsafe coercion boundary types do not match its value and result", + }); + } + } ExprKind::Application(function, argument) => { verify_expr(function, module, errors); verify_expr(argument, module, errors); diff --git a/crates/psrs-thir/src/verify/semantics/mod.rs b/crates/psrs-thir/src/verify/semantics/mod.rs index db6f4960..043585a1 100644 --- a/crates/psrs-thir/src/verify/semantics/mod.rs +++ b/crates/psrs-thir/src/verify/semantics/mod.rs @@ -157,6 +157,14 @@ impl Context<'_> { self.expr(value, Some(*source_type)); self.compatible(*target_type, expression.ty, expression.span); } + ExprKind::UnsafeCoerce { + value, + source_type, + target_type, + } => { + self.expr(value, Some(*source_type)); + self.compatible(*target_type, expression.ty, expression.span); + } ExprKind::Application(function, argument) => { self.expr(function, None); self.expr(argument, None); diff --git a/crates/psrs-typecheck/src/typecheck/finalize.rs b/crates/psrs-typecheck/src/typecheck/finalize.rs index 24eb5064..f6dcc8ea 100644 --- a/crates/psrs-typecheck/src/typecheck/finalize.rs +++ b/crates/psrs-typecheck/src/typecheck/finalize.rs @@ -112,6 +112,38 @@ impl Checker { body: Box::new(body), } } + InferredExprKind::UnsafeCoerceFunction { source, target } => { + let source_type = + self.finalize_type(&source, expression.span, interner, generics)?; + let target_type = + self.finalize_type(&target, expression.span, interner, generics)?; + let local = LocalId(self.state.next_dictionary_local); + self.state.next_dictionary_local += 1; + let binder = thir::Binder { + id: local, + name: "__unsafe_coerce_value".to_owned(), + ty: source_type, + span: expression.span, + }; + let value = thir::Expr { + kind: thir::ExprKind::Local(local), + ty: source_type, + span: expression.span, + }; + let body = thir::Expr { + kind: thir::ExprKind::UnsafeCoerce { + value: Box::new(value), + source_type, + target_type, + }, + ty: target_type, + span: expression.span, + }; + thir::ExprKind::Lambda { + binder, + body: Box::new(body), + } + } InferredExprKind::Evidence(wanted) => { let evidence = self.wanted_evidence(wanted, interner, generics)?; thir::ExprKind::Evidence(evidence) diff --git a/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs b/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs index 0fae1aea..40a17ec3 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs @@ -23,12 +23,29 @@ impl Checker { ) } + /// `Unsafe.Coerce.unsafeCoerce`: the same value shape as `coerce` with no + /// `Coercible` wanted. Its result type is fixed by the context. + pub(super) fn unsafe_coercion_function( + &mut self, + _span: TextRange, + ) -> (InferredExprKind, InferType) { + let source = self.fresh(); + let target = self.fresh(); + ( + InferredExprKind::UnsafeCoerceFunction { + source: source.clone(), + target: target.clone(), + }, + arrow(source, target), + ) + } + /// The type of an intrinsic, instantiated from its descriptor's scheme. /// - /// `Coerce` is handled by the caller before this point, because it needs a - /// `Coercible` wanted and a distinct expression node. `Prim.undefined`'s - /// scheme `forall a. a` needs no special case: instantiating it yields the - /// fresh variable the use decides. + /// `Coerce` and `UnsafeCoerce` are handled by the caller before this point, + /// because they need a distinct expression node (and, for `Coerce`, a + /// `Coercible` wanted). `Prim.undefined`'s scheme `forall a. a` needs no + /// special case: instantiating it yields the fresh variable the use decides. pub(super) fn intrinsic_type(&mut self, intrinsic: Intrinsic) -> InferType { let descriptor = intrinsic.descriptor(); self.elaborate_imported_signature(&(descriptor.scheme)()) diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index 0b50ca88..378bb6f4 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -139,6 +139,9 @@ impl Checker { Some(ExternalKind::Intrinsic(Intrinsic::Coerce)) => { self.coercion_function(span) } + Some(ExternalKind::Intrinsic(Intrinsic::UnsafeCoerce)) => { + self.unsafe_coercion_function(span) + } Some(ExternalKind::Intrinsic(intrinsic)) => ( InferredExprKind::Global(*symbol), self.intrinsic_type(intrinsic), diff --git a/crates/psrs-typecheck/src/typecheck/result.rs b/crates/psrs-typecheck/src/typecheck/result.rs index 587e4dc6..187db76a 100644 --- a/crates/psrs-typecheck/src/typecheck/result.rs +++ b/crates/psrs-typecheck/src/typecheck/result.rs @@ -76,6 +76,12 @@ pub(super) enum InferredExprKind { source: InferType, target: InferType, }, + /// The `Unsafe.Coerce.unsafeCoerce` function. It has no `Coercible` wanted; + /// finalization closes it into an unchecked representation cast. + UnsafeCoerceFunction { + source: InferType, + target: InferType, + }, /// A dictionary solved for `wanted`, used directly (for example as an /// instance's superclass field). Evidence(usize), diff --git a/docs/design/frontend/semantics/modules-and-resolution.md b/docs/design/frontend/semantics/modules-and-resolution.md index 79dcd130..2b29d811 100644 --- a/docs/design/frontend/semantics/modules-and-resolution.md +++ b/docs/design/frontend/semantics/modules-and-resolution.md @@ -102,10 +102,11 @@ declared class, and `unsafeCoerce` is the unchecked representation cast, the bodies a faithful vendored source must carry. A module the compiler provides is never shadowed by an on-disk file: the loader omits such a module and an import of it resolves through the virtual interface, so the vendored source can stay -faithful to upstream without its uncompilable body taking effect. The -`unsafeCoerce` primitive is not implemented yet, so a program that reaches it is -a recorded gap rather than a working cast; the design target is the same -compiler-owned value path `coerce` already uses. +faithful to upstream without its uncompilable body taking effect. `unsafeCoerce` +is the unchecked `unsafeCoerce#` analogue: the compiler lowers it to a +representation-preserving cast at the value's erased boundary, so a program that +reaches it compiles and runs through the same compiler-owned value path +`coerce` uses. This document owns that interface: which names exist, which identity each carries, and that nothing in source can replace one. What a member *means* — which of them diff --git a/docs/design/frontend/type-system/prim.md b/docs/design/frontend/type-system/prim.md index 2f9c7d25..9df64505 100644 --- a/docs/design/frontend/type-system/prim.md +++ b/docs/design/frontend/type-system/prim.md @@ -59,7 +59,7 @@ Kinds are the official ones, since source compatibility requires them. "Provided | `Prim.Partial` | `Constraint` | Diagnostic | ReportOnly | yes | partial | | `Prim.Boolean.True`, `Prim.Boolean.False` | `Boolean` | Interface | — | yes | n/a | | `Safe.Coerce.coerce` (value) | `forall a b. Coercible a b => a -> b` | Interface | — | yes, as an intrinsic | n/a | -| `Unsafe.Coerce.unsafeCoerce` (value) | `forall a b. a -> b` | Interface | — | yes, as an intrinsic | not yet | +| `Unsafe.Coerce.unsafeCoerce` (value) | `forall a b. a -> b` | Interface | — | yes, as an intrinsic | yes | | `Prim.Coerce.Coercible` | `forall k. k -> k -> Constraint` | Proof | CompileTimeProof | yes | yes | | `Prim.Ordering.Ordering` | `Type` | Interface | — | yes | n/a | | `Prim.Ordering.LT`, `EQ`, `GT` | `Ordering` | Interface | — | yes | n/a | diff --git a/docs/implementation/frontend/roles-and-coercions.md b/docs/implementation/frontend/roles-and-coercions.md index 26e9aef2..69ee973d 100644 --- a/docs/implementation/frontend/roles-and-coercions.md +++ b/docs/implementation/frontend/roles-and-coercions.md @@ -61,7 +61,11 @@ PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::wasi::classes::de ``` The compiler-provided value shim follows upstream's `Safe.Coerce.coerce` -source API; `Prim.Coerce.Coercible` remains the compiler-owned class. The +source API; `Prim.Coerce.Coercible` remains the compiler-owned class, and +`Unsafe.Coerce.unsafeCoerce` is the compiler-owned intrinsic that `coerce` is +defined from upstream. A focused execution case +(`tests::coercion::unsafe_coerce_is_a_compiler_primitive_identity_cast`) lowers a +newtype through `unsafeCoerce` and runs to its value under mandatory Wasmtime. The durable `differential_role_and_coercible_rules_against_purs` test compares 20 accepted and rejected fixtures with `purs 0.15.16`, including role decomposition, higher-kinded given rewriting, checked kind compatibility, From 3a8815c2614b8610dd1b33be4c7f5c743657798b Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 21:12:45 +0800 Subject: [PATCH 013/148] Make the effect token an opaque state token Replace the transitional Int token and its i32 0 placeholder with the compiler-owned opaque state token the design names (the State# RealWorld analogue). Effect lowering interns TypeId::STATE_TOKEN, marks it opaque, and threads it through each Effect closure; run supplies the StateToken value instead of an Int literal. - Add TypeId::STATE_TOKEN and Core ExprKind::StateToken. Only effect lowering produces it; the Core verifier requires it to carry the compiler token type, and the backend lowers it to a scalar constant because the synchronous effect carries no payload. - Update every Core traversal to treat the token as a leaf. - Update the effect fixture and the model, effects, and acceptance notes. The driver suite stays at 551 passed plus one pre-existing prim_row failure; the scoreboards are unchanged (L1 904/908, L2 71/72 + 386/413, L3 39/48, L4 39/50, L5 58/81, L6/M7 210/413). --- crates/psrs-backend/src/cc/layout/captures.rs | 4 +-- .../src/cc/layout/functions/reachable.rs | 2 +- .../src/cc/lower/lambda/captures.rs | 2 +- crates/psrs-backend/src/cc/lower/mod.rs | 9 ++++++ crates/psrs-core/src/effect/mod.rs | 14 ++++++++- crates/psrs-core/src/effect/operations.rs | 5 ++-- crates/psrs-core/src/effect/supplies.rs | 2 +- crates/psrs-core/src/lib.rs | 6 ++++ crates/psrs-core/src/link/mod.rs | 1 + crates/psrs-core/src/link/shift.rs | 1 + crates/psrs-core/src/link/variables.rs | 2 +- crates/psrs-core/src/opt/dead.rs | 3 +- crates/psrs-core/src/opt/effects.rs | 2 ++ crates/psrs-core/src/opt/inline/alpha.rs | 1 + .../src/opt/inline/global/analysis.rs | 4 ++- crates/psrs-core/src/opt/inline/global/mod.rs | 1 + crates/psrs-core/src/opt/inline/local.rs | 1 + crates/psrs-core/src/opt/simplify/mod.rs | 2 +- crates/psrs-core/src/opt/specialize/calls.rs | 1 + crates/psrs-core/src/opt/specialize/mod.rs | 2 +- .../src/opt/specialize/types/substitution.rs | 1 + crates/psrs-core/src/opt/util.rs | 5 ++-- crates/psrs-core/src/tests/effects.rs | 7 +++-- crates/psrs-core/src/verify/expr/mod.rs | 17 ++++++++++- crates/psrs-core/src/verify/scopes/expr.rs | 2 +- .../src/tests/generic_aggregate_fixtures.rs | 2 +- crates/psrs-hir/src/lib.rs | 6 ++++ .../DEC-17-representation-and-evidence.md | 7 ++--- docs/design/backend/fp/effects.md | 29 ++++++++++--------- .../backend/fp/representation-and-evidence.md | 9 ++++-- docs/implementation/backend/effects.md | 12 ++++---- .../backend/polymorphism-and-erasure.md | 5 ++-- 32 files changed, 118 insertions(+), 49 deletions(-) diff --git a/crates/psrs-backend/src/cc/layout/captures.rs b/crates/psrs-backend/src/cc/layout/captures.rs index 883d63fc..a0cf8d8b 100644 --- a/crates/psrs-backend/src/cc/layout/captures.rs +++ b/crates/psrs-backend/src/cc/layout/captures.rs @@ -71,7 +71,7 @@ fn expression_has_integer_capture(expression: &Expr, module: &CoreModule) -> boo | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => false, - ExprKind::Unit | ExprKind::Trap => false, + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => false, } } @@ -159,7 +159,7 @@ fn free_integer_local( | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => false, - ExprKind::Unit | ExprKind::Trap => false, + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => false, } } diff --git a/crates/psrs-backend/src/cc/layout/functions/reachable.rs b/crates/psrs-backend/src/cc/layout/functions/reachable.rs index eb8969ef..e818a691 100644 --- a/crates/psrs-backend/src/cc/layout/functions/reachable.rs +++ b/crates/psrs-backend/src/cc/layout/functions/reachable.rs @@ -108,7 +108,7 @@ fn record_expr( | ExprKind::Char(_) => {} // Both mention no subexpression, so the type recorded above is all // their layout can refer to. - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} } } diff --git a/crates/psrs-backend/src/cc/lower/lambda/captures.rs b/crates/psrs-backend/src/cc/lower/lambda/captures.rs index fee4554e..52cbef5f 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/captures.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/captures.rs @@ -90,7 +90,7 @@ pub(in crate::cc::lower) fn collect_captures( | ExprKind::String(_) | ExprKind::Char(_) => {} // Neither a literal unit nor a trap reads a local. - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} } } diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 5056b074..2318be23 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -320,6 +320,15 @@ impl FunctionLowerer<'_> { ty, assignments, )), + // The state token carries no payload for the synchronous effect + // model, so it lowers to a constant scalar. Its type stays opaque, + // so no pass can treat it as an `Int`. + ExprKind::StateToken => Ok(self.lower_literal( + AssignmentKind::Constant(0), + expression.span, + ty, + assignments, + )), // A trap has a type but no value: it is the one expression that // ends the path instead of filling a destination. ExprKind::Trap => self.lower_trap(expression.span, ty, assignments), diff --git a/crates/psrs-core/src/effect/mod.rs b/crates/psrs-core/src/effect/mod.rs index b150cdb9..5fb6fcfc 100644 --- a/crates/psrs-core/src/effect/mod.rs +++ b/crates/psrs-core/src/effect/mod.rs @@ -157,7 +157,7 @@ pub fn lower_effects( } None => module.callable_types.push((effect, 1)), } - let token = intern(module, Type::Constructor(TypeConstructor::Int)); + let token = state_token_type(module); let closures = rewrite_effect_applications(module, effect, token); let synthesized = synthesize_operations(module, token, trusted)?; let lowering = EffectLowering { @@ -269,6 +269,18 @@ fn is_effect_constructor(module: &Module, id: TypeId, effect: HirTypeId) -> bool ) } +/// Interns the compiler-owned opaque state token an `Effect` closure takes. +/// It has no source spelling; marking it opaque gives it a scalar runtime shape +/// without letting any pass treat it as an `Int` +/// ([effects](../../../design/backend/fp/effects.md)). +fn state_token_type(module: &mut Module) -> TypeId { + let token = psrs_hir::TypeId::STATE_TOKEN; + if !module.opaque_ids.contains(&token) { + module.opaque_ids.push(token); + } + intern(module, Type::Constructor(TypeConstructor::User(token))) +} + fn verification_error(module: &Module, message: &'static str) -> VerifyError { VerifyError { module: module.id, diff --git a/crates/psrs-core/src/effect/operations.rs b/crates/psrs-core/src/effect/operations.rs index 7af14f12..d3e805f3 100644 --- a/crates/psrs-core/src/effect/operations.rs +++ b/crates/psrs-core/src/effect/operations.rs @@ -3,7 +3,8 @@ //! `lower_effects` replaces the library's opaque imports with the values the //! design specifies: `pure` returns a closure over the token, `bind` runs the //! first effect before the continuation, `run` applies the closure to the -//! integer `0`, and `trap` is the effect that escapes instead of returning. +//! runtime state token, and `trap` is the effect that escapes instead of +//! returning. use super::supplies::{LocalSupply, VariableSupply}; use super::{EFFECT_INTERFACE, TrustedEffect, intern}; @@ -225,7 +226,7 @@ fn run_declaration( let action_ty = closure_type(module, token, result_ty); let ty = arrow(module, action_ty, result_ty); let action = locals.fresh(); - let token_value = expr(ExprKind::Integer(0), token, span); + let token_value = expr(ExprKind::StateToken, token, span); let body = application( expr(ExprKind::Local(action), action_ty, span), token_value, diff --git a/crates/psrs-core/src/effect/supplies.rs b/crates/psrs-core/src/effect/supplies.rs index 4a75c508..0387b403 100644 --- a/crates/psrs-core/src/effect/supplies.rs +++ b/crates/psrs-core/src/effect/supplies.rs @@ -76,7 +76,7 @@ fn max_local(expression: &Expr) -> u32 { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => 0, - ExprKind::Unit | ExprKind::Trap => 0, + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => 0, } } diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 6118ba4f..834bdda1 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -139,6 +139,12 @@ pub enum ExprKind { /// constructor application. Its canonical runtime value is the integer `0` /// ([scalars and primitives](../../design/backend/fp/scalars-and-primitives.md)). Unit, + /// The one value of the compiler-owned opaque state token an `Effect` + /// closure takes. Only effect lowering produces it; it is threaded through + /// the chain and never inspected, the `State# RealWorld` analogue of + /// [effects](../../design/backend/fp/effects.md). Its runtime shape is a + /// scalar, but it is not an `Int`. + StateToken, /// An expression that never produces its value: the guest traps. Core /// carries it so the effect interface can supply an `Effect Unit` that /// escapes instead of returning, which is what an uncaught failure is on diff --git a/crates/psrs-core/src/link/mod.rs b/crates/psrs-core/src/link/mod.rs index bed51572..3baff42c 100644 --- a/crates/psrs-core/src/link/mod.rs +++ b/crates/psrs-core/src/link/mod.rs @@ -353,6 +353,7 @@ fn collect_references( | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit + | ExprKind::StateToken | ExprKind::Trap => {} ExprKind::Array { elements } => { for element in elements { diff --git a/crates/psrs-core/src/link/shift.rs b/crates/psrs-core/src/link/shift.rs index 8acbfc66..6f56c577 100644 --- a/crates/psrs-core/src/link/shift.rs +++ b/crates/psrs-core/src/link/shift.rs @@ -24,6 +24,7 @@ pub(super) fn shift_kind(kind: ExprKind, offset: u32, variable_offset: u32) -> E ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/link/variables.rs b/crates/psrs-core/src/link/variables.rs index 0d327632..05f19190 100644 --- a/crates/psrs-core/src/link/variables.rs +++ b/crates/psrs-core/src/link/variables.rs @@ -97,6 +97,6 @@ fn expression_span(expression: &Expr, maximum: &mut Option) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/dead.rs b/crates/psrs-core/src/opt/dead.rs index e1bc734d..a0d0730f 100644 --- a/crates/psrs-core/src/opt/dead.rs +++ b/crates/psrs-core/src/opt/dead.rs @@ -109,6 +109,7 @@ fn eliminate_expr(mut expression: Expr) -> Expr { ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression @@ -220,6 +221,6 @@ fn collect_refs(expression: &Expr, references: &mut HashSet) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/effects.rs b/crates/psrs-core/src/opt/effects.rs index 280ca8e2..39ca6c23 100644 --- a/crates/psrs-core/src/opt/effects.rs +++ b/crates/psrs-core/src/opt/effects.rs @@ -31,6 +31,8 @@ pub(super) fn summarize(expression: &Expr) -> Effects { | ExprKind::Char(_) => Effects::default(), // The unit value has no payload and no failure mode. ExprKind::Unit => Effects::default(), + // The state token has no payload and no failure mode. + ExprKind::StateToken => Effects::default(), // A trap is a failure by definition, so no rewrite may drop or move it // as if it were an inert value. ExprKind::Trap => Effects { diff --git a/crates/psrs-core/src/opt/inline/alpha.rs b/crates/psrs-core/src/opt/inline/alpha.rs index 10af43ff..8f4484f3 100644 --- a/crates/psrs-core/src/opt/inline/alpha.rs +++ b/crates/psrs-core/src/opt/inline/alpha.rs @@ -38,6 +38,7 @@ fn clone_expr( ExprKind::String(value) => ExprKind::String(value.clone()), ExprKind::Char(value) => ExprKind::Char(*value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/opt/inline/global/analysis.rs b/crates/psrs-core/src/opt/inline/global/analysis.rs index 7ce35a4b..3e698c29 100644 --- a/crates/psrs-core/src/opt/inline/global/analysis.rs +++ b/crates/psrs-core/src/opt/inline/global/analysis.rs @@ -110,6 +110,7 @@ fn expr_introduces_type_binders(expression: &Expr, types: &[Type]) -> bool { | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit + | ExprKind::StateToken | ExprKind::Trap => false, } } @@ -185,6 +186,7 @@ pub(super) fn contains_case(expression: &Expr) -> bool { | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit + | ExprKind::StateToken | ExprKind::Trap => false, } } @@ -249,6 +251,6 @@ pub(super) fn collect_globals(expression: &Expr, out: &mut Vec) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/inline/global/mod.rs b/crates/psrs-core/src/opt/inline/global/mod.rs index f8f32e7a..23039f7c 100644 --- a/crates/psrs-core/src/opt/inline/global/mod.rs +++ b/crates/psrs-core/src/opt/inline/global/mod.rs @@ -339,6 +339,7 @@ fn inline_expr( ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression diff --git a/crates/psrs-core/src/opt/inline/local.rs b/crates/psrs-core/src/opt/inline/local.rs index 6b042fbc..99422ed5 100644 --- a/crates/psrs-core/src/opt/inline/local.rs +++ b/crates/psrs-core/src/opt/inline/local.rs @@ -159,6 +159,7 @@ fn inline_expr( ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression diff --git a/crates/psrs-core/src/opt/simplify/mod.rs b/crates/psrs-core/src/opt/simplify/mod.rs index cad65d91..18d32d98 100644 --- a/crates/psrs-core/src/opt/simplify/mod.rs +++ b/crates/psrs-core/src/opt/simplify/mod.rs @@ -215,7 +215,7 @@ fn simplify_expr(mut expression: Expr, fresh: &mut FreshLocals) -> Expr { ExprKind::Boolean(value) => ExprKind::Boolean(value), ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), - kind @ (ExprKind::Unit | ExprKind::Trap) => kind, + kind @ (ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap) => kind, }; expression } diff --git a/crates/psrs-core/src/opt/specialize/calls.rs b/crates/psrs-core/src/opt/specialize/calls.rs index 812b786f..cfb50597 100644 --- a/crates/psrs-core/src/opt/specialize/calls.rs +++ b/crates/psrs-core/src/opt/specialize/calls.rs @@ -122,6 +122,7 @@ pub(super) fn rewrite( ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression diff --git a/crates/psrs-core/src/opt/specialize/mod.rs b/crates/psrs-core/src/opt/specialize/mod.rs index 4f3ec83f..a1976d40 100644 --- a/crates/psrs-core/src/opt/specialize/mod.rs +++ b/crates/psrs-core/src/opt/specialize/mod.rs @@ -221,6 +221,6 @@ fn collect_references(expression: &crate::Expr, out: &mut Vec) { | crate::ExprKind::Boolean(_) | crate::ExprKind::String(_) | crate::ExprKind::Char(_) => {} - crate::ExprKind::Unit | crate::ExprKind::Trap => {} + crate::ExprKind::Unit | crate::ExprKind::StateToken | crate::ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/specialize/types/substitution.rs b/crates/psrs-core/src/opt/specialize/types/substitution.rs index aa6d1629..c7f228b2 100644 --- a/crates/psrs-core/src/opt/specialize/types/substitution.rs +++ b/crates/psrs-core/src/opt/specialize/types/substitution.rs @@ -186,6 +186,7 @@ impl TypeSubstitution<'_> { ExprKind::String(value) => ExprKind::String(value.clone()), ExprKind::Char(value) => ExprKind::Char(*value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/opt/util.rs b/crates/psrs-core/src/opt/util.rs index d502789b..de8770bf 100644 --- a/crates/psrs-core/src/opt/util.rs +++ b/crates/psrs-core/src/opt/util.rs @@ -34,7 +34,7 @@ pub(super) fn count_nodes(expression: &Expr) -> usize { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => 0, - ExprKind::Unit | ExprKind::Trap => 0, + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => 0, ExprKind::Constructor { arguments, .. } | ExprKind::IntrinsicCall { arguments, .. } | ExprKind::Array { @@ -131,6 +131,7 @@ fn substitute_inner( ExprKind::String(value) => ExprKind::String(value.clone()), ExprKind::Char(value) => ExprKind::Char(*value), ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements @@ -357,7 +358,7 @@ fn collect_ids(expression: &Expr, ids: &mut HashSet) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/tests/effects.rs b/crates/psrs-core/src/tests/effects.rs index 9f90da3b..fc8c652a 100644 --- a/crates/psrs-core/src/tests/effects.rs +++ b/crates/psrs-core/src/tests/effects.rs @@ -31,20 +31,21 @@ fn trusted_effect() -> TrustedEffect { /// /// | id | node | /// | --- | --- | -/// | 0 | `Int`, the token representation lowering chose | +/// | 0 | the opaque state token, the representation lowering chose | /// | 1, 2 | `a`, `b` | /// | 3, 4, 5 | `a -> b` | /// | 6 | `Prelude.Effect` | /// | 7 | `Effect (a -> b)`, the node lowering replaces | fn effect_module() -> Module { let effect = EFFECT_HIR; + let token = HirTypeId::STATE_TOKEN; Module { id: ModuleId(0), name: "Main".into(), externals: Vec::new(), external_types: Vec::new(), types: vec![ - Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::User(token)), Type::Variable(TypeVariableId(0)), Type::Variable(TypeVariableId(1)), Type::Constructor(TypeConstructor::Function), @@ -54,7 +55,7 @@ fn effect_module() -> Module { Type::Application(EFFECT, ARROW), ], newtype_ids: Vec::new(), - opaque_ids: vec![effect], + opaque_ids: vec![effect, token], callable_types: Vec::new(), constructors: Vec::new(), declarations: Vec::new(), diff --git a/crates/psrs-core/src/verify/expr/mod.rs b/crates/psrs-core/src/verify/expr/mod.rs index 0dd523ee..aeb2e03e 100644 --- a/crates/psrs-core/src/verify/expr/mod.rs +++ b/crates/psrs-core/src/verify/expr/mod.rs @@ -2,7 +2,7 @@ use super::{ Locals, SchemeType, array_element, compatible, error, primitive_type_id, record_field, restore_local, verify_pattern, verify_type, }; -use crate::{Expr, ExprKind, Module, TypeConstructor, TypeId, VerifyError}; +use crate::{Expr, ExprKind, Module, Type, TypeConstructor, TypeId, VerifyError}; use psrs_hir::{ModuleId, SymbolId}; use std::collections::HashMap; @@ -109,6 +109,21 @@ impl Context<'_> { ExprKind::String(_) => self.shape(expression, TypeConstructor::String), ExprKind::Char(_) => self.shape(expression, TypeConstructor::Char), ExprKind::Unit => self.shape(expression, TypeConstructor::Unit), + // The state token is the one value of the compiler-owned opaque + // token type. Only effect lowering produces it. + ExprKind::StateToken => { + if !matches!( + self.module.types.get(expression.ty.0 as usize), + Some(Type::Constructor(TypeConstructor::User(id))) + if *id == psrs_hir::TypeId::STATE_TOKEN + ) { + self.errors.push(error( + self.owner, + expression.span, + "state token expression does not have the compiler token type", + )); + } + } // A trap produces no value, so its type is only the one its context // wants; the surrounding context check already established that. ExprKind::Trap => {} diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index 050b1b6a..a43961b8 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -27,7 +27,7 @@ pub(super) fn scoped_expr( | ExprKind::Char(_) => {} // Both are leaves: their type is already checked by the expression // check, and neither mentions a binder. - ExprKind::Unit | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} ExprKind::Constructor { arguments, .. } => { for argument in arguments { scoped_expr(argument, module, scope, errors); diff --git a/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs b/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs index a24268ec..e2d2d8a7 100644 --- a/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs +++ b/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs @@ -54,7 +54,7 @@ pub(super) fn clear_array_literals(expression: &mut psrs_core::Expr) -> bool { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => false, - ExprKind::Unit | ExprKind::Trap => false, + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => false, } } diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index c1dfc8da..f04424f8 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -100,6 +100,12 @@ impl TypeId { pub const PRIM_TYPE_ERROR_QUOTE_LABEL: Self = Self::new(ModuleId::INTRINSICS, 28); pub const PRIM_TYPE_ERROR_BESIDE: Self = Self::new(ModuleId::INTRINSICS, 29); pub const PRIM_TYPE_ERROR_ABOVE: Self = Self::new(ModuleId::INTRINSICS, 30); + /// The compiler-owned opaque state token an `Effect` closure takes. It has + /// no source spelling and one uninspectable value; it is the `State# + /// RealWorld` analogue of [effects](../design/backend/fp/effects.md), not a + /// source type. Its runtime shape is a scalar, but no source or later pass + /// may treat it as an `Int`. + pub const STATE_TOKEN: Self = Self::new(ModuleId::INTRINSICS, 31); } mod intrinsic; diff --git a/docs/decision/DEC-17-representation-and-evidence.md b/docs/decision/DEC-17-representation-and-evidence.md index b7aaeb1b..4cfd3ba4 100644 --- a/docs/decision/DEC-17-representation-and-evidence.md +++ b/docs/decision/DEC-17-representation-and-evidence.md @@ -89,15 +89,14 @@ erasure with bridge methods, and Koka-style explicit evidence. - The transitional mechanisms are removed, not extended: the HIR-keyed protocol table, the signature-prefix protocol derivation, and the effect token's - special case become a single side table plus the one planner. Until that - migration lands, they are recorded as deviations from the design. + special case are now a single Core-to-CC side table plus the one planner. - A new constructor is added by registering one representation owner, not by teaching each pass a new rule. - `Safe.Coerce.coerce` and `Unsafe.Coerce.unsafeCoerce` are compiler-provided primitive values. A module the compiler provides is never shadowed by a vendored on-disk file, so the vendored source stays faithful to upstream. -- The effect token becomes the `State# RealWorld` analogue; the current `i32` `0` - is a placeholder rather than the model. +- The effect token is the opaque, compiler-owned `State# RealWorld` analogue; the + earlier `i32` `0` placeholder is gone. - Generic aggregate normalization and the aggregate conversion plan (`ProductMap`/`ArrayMap`, canonical aggregate keys) are sections of the model document, not a separate design; the concrete aggregate layouts and their diff --git a/docs/design/backend/fp/effects.md b/docs/design/backend/fp/effects.md index 5b4da8e2..6ac01640 100644 --- a/docs/design/backend/fp/effects.md +++ b/docs/design/backend/fp/effects.md @@ -179,14 +179,13 @@ flag, private constructor, or representation mode. IR node, closure kind, or runtime object. After representation lowering, CC and MIR see generic closures and calls. - The runtime token is the state token of a strict IO-like effect, the - `State# RealWorld` analogue in GHC. It is threaded through the chain and may - be neither duplicated nor observed; ordering comes from the calls and strict - evaluation order, not from the token's bits. For the current synchronous, - single-threaded `Effect` the token carries no payload, so it lowers to a - constant placeholder; that placeholder is an implementation gap, not the - model, because a value that can be copied is not a linear state token. - Call order and multiplicity are preserved by the evaluation and optimizer - contracts. + `State# RealWorld` analogue in GHC. It is the compiler-owned opaque + `TypeId::STATE_TOKEN`, threaded through the chain and neither duplicated nor + observed; ordering comes from the calls and strict evaluation order, not from + the token's bits. For the current synchronous, single-threaded `Effect` the + token carries no payload, so its runtime shape is a scalar constant; the type + stays opaque, so no pass treats it as an `Int`. Call order and multiplicity + are preserved by the evaluation and optimizer contracts. - Entry selection produces one resolved command-entry `SymbolId`: use `Main.main` when present, otherwise require one unique top-level `main`. The lexical `runEffect` reference check and generated entry wrapper use that @@ -239,12 +238,14 @@ becomes a record/closure over its operation implementations and lowering mechanism, and it still introduces no dedicated CC/MIR node. The token is a single abstract state value, the `State# RealWorld` analogue: -the lowering passes it along and never inspects or copies it. The current -implementation lowers it to the constant `i32` `0`, which is a placeholder -rather than the model — distinct token bits carry no meaning, and the calls -themselves are observable and cannot be merged or removed. A later runtime may -pass a state or resource handle through the same parameter without exposing it -to source programs. +the lowering passes it along and never inspects or copies it. The compiler +interns it as the opaque `TypeId::STATE_TOKEN`, which has no source spelling; +its one value is the `StateToken` expression the effect runner supplies. Its +runtime shape is a scalar constant because the synchronous effect carries no +payload — distinct token bits carry no meaning, and the calls themselves are +observable and cannot be merged or removed. A later runtime may pass a state or +resource handle through the same parameter without exposing it to source +programs. ### Partial application diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index c2e0e3c0..89b38c91 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -503,9 +503,12 @@ reported rather than resolved by arity or a signature search. Protocol signatures are interned once per registered callable constructor as the concrete calling convention with the payload erased. -The effect token remains a placeholder: the model makes it the `State# -RealWorld` analogue, while the current lowering uses the constant `i32` `0` -([effects](../../../implementation/backend/effects.md)). +The effect token is the compiler-owned opaque state token +(`psrs_hir::TypeId::STATE_TOKEN`) that effect lowering threads through each +`Effect` closure, the `State# RealWorld` analogue. It has no source spelling and +one uninspectable value, so no later pass can treat it as an `Int`; its runtime +shape is a scalar because the synchronous, single-threaded effect carries no +payload ([effects](../../../implementation/backend/effects.md)). ## References diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index 51e8599c..89a15b5b 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -139,8 +139,9 @@ EF-14: `RepresentationPolicy` in the Core-to-CC registry), crates/psrs-backend/ src/boundary.rs (`BoundaryEvidence`), crates/psrs-backend/src/cc/lower/ conversion/ (transport.rs and callable.rs) and cc/lower/{global,record,erased} - (evidence read from the boundary at each use). The token itself is still the - `i32` `0` placeholder; the design token is the `State# RealWorld` analogue. + (evidence read from the boundary at each use). The token is the compiler-owned + opaque `TypeId::STATE_TOKEN`; effect lowering threads it and `run` supplies the + `StateToken` value, the `State# RealWorld` analogue. Tests: tests::effects::discard_defined_from_bind_sequences_effects (stdout `a\nb\n`, exit 0); tests::functor:: mapping_an_effect_does_not_run_it_until_the_action_runs (stdout @@ -421,9 +422,10 @@ EF-12: ## Discovered obligations -- The token is the Core `Int` chosen by effect lowering. Its current value - `0` is a placeholder: it does not schedule work or establish ordering. - Source programs cannot name the token; order comes from the calls and +- The token is the compiler-owned opaque `TypeId::STATE_TOKEN` chosen by effect + lowering. Its one value is the `StateToken` expression `run` supplies; the + runtime shape is a scalar constant because the synchronous token carries no + payload. Source programs cannot name the token; order comes from the calls and optimizer contracts. A later stateful token is an open question, not a second representation. - Partial application of a polymorphic declaration whose result is a type diff --git a/docs/implementation/backend/polymorphism-and-erasure.md b/docs/implementation/backend/polymorphism-and-erasure.md index c3b68bac..c2cb64aa 100644 --- a/docs/implementation/backend/polymorphism-and-erasure.md +++ b/docs/implementation/backend/polymorphism-and-erasure.md @@ -347,8 +347,9 @@ PE-13: and the trusted `Effect` (runtime token); `BoundaryEvidence` provides the checking-owned relation and the payload-erased protocol signature of each callable constructor. `FunctionLowerer::source`, `constructor_protocols`, and - `transport_signatures` are gone. What remains is the effect token placeholder - and the two-relation matcher, tracked separately. + `transport_signatures` are gone. The effect token is the opaque + `TypeId::STATE_TOKEN`; what remains is the two-relation matcher (`subsumes` + and `matches`), tracked separately. - **Workspace suite still red on the Phase-3 migration.** Ten driver tests fail for reasons this topic does not own: five use `-` or `/` without importing the library operator that now owns it (`tests::scalars`, `tests::functions`, From 7081a6547d6c1f150386b7a34e711a5bfb74d96e Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 21:38:16 +0800 Subject: [PATCH 014/148] Present the checked type relation as one entry with a variance The matching module had two relation-shaped methods, subsumes and matches, with no single entry point. Fold them into one checked relation, TypeMatcher::relate(actual, expected, variance, instantiate), parameterized by Variance::{Subsumption, Invariant}. Subsumption is the value-level relation a scheme is checked against at its use; Invariant is the rigid mode for nominal and higher-kinded applications, closed and rigid rows, and constructor field templates. This is a behaviour-preserving structural change: every recursion and entry point now goes through relate, and the two modes keep their exact branch logic. The public entry points (compatible, scheme_instance, application_matches, instantiation) are unchanged. Checking remains the sole owner of the relation; P8 consumes only its Instantiation evidence. Validated: psrs-core, psrs-typecheck, and the full driver suite (551 passed, same 10 pre-existing failures) are unchanged, and all five scoreboards are unchanged (L1 904/908, L2 71/72 + 386/413, L3 39/48, L4 39/50, L5 58/81, L6/M7 210/413). --- .../src/verify/types/matching/closure.rs | 27 ++++- .../src/verify/types/matching/constructors.rs | 6 +- .../src/verify/types/matching/evidence.rs | 4 +- .../src/verify/types/matching/invariant.rs | 88 +++++++++----- .../src/verify/types/matching/mod.rs | 111 +++++++++++++----- .../src/verify/types/matching/rows.rs | 18 ++- .../backend/fp/representation-and-evidence.md | 5 +- .../backend/polymorphism-and-erasure.md | 5 +- 8 files changed, 179 insertions(+), 85 deletions(-) diff --git a/crates/psrs-core/src/verify/types/matching/closure.rs b/crates/psrs-core/src/verify/types/matching/closure.rs index 68c659c7..5e242c74 100644 --- a/crates/psrs-core/src/verify/types/matching/closure.rs +++ b/crates/psrs-core/src/verify/types/matching/closure.rs @@ -1,9 +1,9 @@ -use super::TypeMatcher; +use super::{TypeMatcher, Variance}; impl TypeMatcher<'_> { /// Both types are closures with a fixed parameter list. Parameters are /// invariant and the result follows the surrounding subsumption. - pub(super) fn subsumes_closure( + pub(super) fn closure_subsumption( &mut self, actual: crate::TypeId, expected: crate::TypeId, @@ -19,10 +19,27 @@ impl TypeMatcher<'_> { } let parameters_match = actual_parameters.into_iter().zip(expected_parameters).all( |(actual_parameter, expected_parameter)| { - self.subsumes(expected_parameter, actual_parameter, true) - && self.subsumes(actual_parameter, expected_parameter, true) + self.relate( + expected_parameter, + actual_parameter, + Variance::Subsumption, + true, + ) && self.relate( + actual_parameter, + expected_parameter, + Variance::Subsumption, + true, + ) }, ); - Some(parameters_match && self.subsumes(actual_result, expected_result, instantiate)) + Some( + parameters_match + && self.relate( + actual_result, + expected_result, + Variance::Subsumption, + instantiate, + ), + ) } } diff --git a/crates/psrs-core/src/verify/types/matching/constructors.rs b/crates/psrs-core/src/verify/types/matching/constructors.rs index 25b64ad3..b6aa581b 100644 --- a/crates/psrs-core/src/verify/types/matching/constructors.rs +++ b/crates/psrs-core/src/verify/types/matching/constructors.rs @@ -1,4 +1,4 @@ -use super::TypeMatcher; +use super::{TypeMatcher, Variance}; use crate::{Module, Type, TypeId}; use std::collections::{HashMap, HashSet}; @@ -36,5 +36,7 @@ pub(in crate::verify) fn constructor_fields_match( field_templates .iter() .zip(field_instances) - .all(|(template, instance)| matcher.matches(*template, *instance, false)) + .all(|(template, instance)| { + matcher.relate(*template, *instance, Variance::Invariant, false) + }) } diff --git a/crates/psrs-core/src/verify/types/matching/evidence.rs b/crates/psrs-core/src/verify/types/matching/evidence.rs index 1c92f767..b8ef9741 100644 --- a/crates/psrs-core/src/verify/types/matching/evidence.rs +++ b/crates/psrs-core/src/verify/types/matching/evidence.rs @@ -1,4 +1,4 @@ -use super::TypeMatcher; +use super::{TypeMatcher, Variance}; use crate::{Instantiation, Module, TypeId}; use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; @@ -17,7 +17,7 @@ pub(crate) fn instantiation<'a>( alpha: HashMap::new(), active: HashSet::new(), }; - if !matcher.subsumes(scheme, instance, true) { + if !matcher.relate(scheme, instance, Variance::Subsumption, true) { return None; } Some(Instantiation { diff --git a/crates/psrs-core/src/verify/types/matching/invariant.rs b/crates/psrs-core/src/verify/types/matching/invariant.rs index 21bb1854..24eb503d 100644 --- a/crates/psrs-core/src/verify/types/matching/invariant.rs +++ b/crates/psrs-core/src/verify/types/matching/invariant.rs @@ -1,18 +1,18 @@ -//! Invariant type matching. Flexible variables are solved from either side. -//! Constructor identity comes from an explicit binding, never from a closure's -//! parameter count. +//! The rigid (`Invariant`) mode of the single checked type relation. +//! Flexible variables are solved from either side, and constructor identity +//! comes from an explicit binding, never from a closure's parameter count. -use super::{Relation, TypeMatcher}; +use super::{TypeMatcher, Variance}; use crate::Type; impl TypeMatcher<'_> { - pub(super) fn matches( + pub(super) fn invariant( &mut self, source: crate::TypeId, target: crate::TypeId, instantiate: bool, ) -> bool { - if !self.active.insert((Relation::Invariant, source, target)) { + if !self.active.insert((Variance::Invariant, source, target)) { return true; } if let ( @@ -24,20 +24,25 @@ impl TypeMatcher<'_> { ) { let source_parameters = source_parameters.to_vec(); let target_parameters = target_parameters.to_vec(); - let result = source_parameters.len() == target_parameters.len() - && source_parameters - .into_iter() - .zip(target_parameters) - .all(|(source, target)| self.matches(source, target, false)) - && self.matches(source_result, target_result, instantiate); - self.active.remove(&(Relation::Invariant, source, target)); + let result = + source_parameters.len() == target_parameters.len() + && source_parameters.into_iter().zip(target_parameters).all( + |(source, target)| self.relate(source, target, Variance::Invariant, false), + ) + && self.relate( + source_result, + target_result, + Variance::Invariant, + instantiate, + ); + self.active.remove(&(Variance::Invariant, source, target)); return result; } let (Some(source_type), Some(target_type)) = ( self.module.types.get(source.0 as usize), self.module.types.get(target.0 as usize), ) else { - self.active.remove(&(Relation::Invariant, source, target)); + self.active.remove(&(Variance::Invariant, source, target)); return false; }; if let Type::Variable(variable) = source_type { @@ -61,7 +66,7 @@ impl TypeMatcher<'_> { _ => false, } }; - self.active.remove(&(Relation::Invariant, source, target)); + self.active.remove(&(Variance::Invariant, source, target)); return result; } if let Type::Variable(variable) = target_type { @@ -69,7 +74,7 @@ impl TypeMatcher<'_> { && self.flexible.contains(variable) && !matches!(source_type, Type::ForAll { .. }) && self.bind_flexible(*variable, source); - self.active.remove(&(Relation::Invariant, source, target)); + self.active.remove(&(Variance::Invariant, source, target)); return result; } let result = match (source_type, target_type) { @@ -92,11 +97,12 @@ impl TypeMatcher<'_> { for (source, target) in source_variables.iter().zip(target_variables) { self.alpha.insert(*source, *target); } - let matches = self.matches(*source_body, *target_body, instantiate); + let related = + self.relate(*source_body, *target_body, Variance::Invariant, instantiate); for variable in source_variables { self.alpha.remove(variable); } - matches + related } } (Type::ForAll { variables, body }, _) if instantiate => { @@ -105,12 +111,12 @@ impl TypeMatcher<'_> { .copied() .filter(|variable| self.flexible.insert(*variable)) .collect::>(); - let matches = self.matches(*body, target, true); + let related = self.relate(*body, target, Variance::Invariant, true); for variable in added { self.flexible.remove(&variable); self.replacements.remove(&variable); } - matches + related } (Type::ForAll { .. }, _) | (_, Type::ForAll { .. }) => false, (Type::Constructor(left), Type::Constructor(right)) => left == right, @@ -122,12 +128,21 @@ impl TypeMatcher<'_> { crate::arrow_parts(&self.module.types, source), crate::arrow_parts(&self.module.types, target), ) { - self.matches(source_parameter, target_parameter, false) - && self.matches(source_result, target_result, instantiate) + self.relate( + source_parameter, + target_parameter, + Variance::Invariant, + false, + ) && self.relate( + source_result, + target_result, + Variance::Invariant, + instantiate, + ) } else if super::is_record_type(self.module, source) && super::is_record_type(self.module, target) { - self.matches_record(source, target) + self.invariant_record(source, target) } else { let ( Type::Application(source_function, source_argument), @@ -136,8 +151,17 @@ impl TypeMatcher<'_> { else { unreachable!() }; - self.matches(*source_function, *target_function, false) - && self.matches(*source_argument, *target_argument, false) + self.relate( + *source_function, + *target_function, + Variance::Invariant, + false, + ) && self.relate( + *source_argument, + *target_argument, + Variance::Invariant, + false, + ) } } (Type::RowEmpty, Type::RowEmpty) => true, @@ -154,16 +178,20 @@ impl TypeMatcher<'_> { }, ) => { left_label == right_label - && self.matches(*left_ty, *right_ty, false) - && self.matches(*left_tail, *right_tail, false) + && self.relate(*left_ty, *right_ty, Variance::Invariant, false) + && self.relate(*left_tail, *right_tail, Variance::Invariant, false) } _ => false, }; - self.active.remove(&(Relation::Invariant, source, target)); + self.active.remove(&(Variance::Invariant, source, target)); result } - pub(super) fn matches_record(&mut self, source: crate::TypeId, target: crate::TypeId) -> bool { - self.relate_records(source, target, false) + pub(super) fn invariant_record( + &mut self, + source: crate::TypeId, + target: crate::TypeId, + ) -> bool { + self.relate_records(source, target, Variance::Invariant) } } diff --git a/crates/psrs-core/src/verify/types/matching/mod.rs b/crates/psrs-core/src/verify/types/matching/mod.rs index a200c368..fd6e39e3 100644 --- a/crates/psrs-core/src/verify/types/matching/mod.rs +++ b/crates/psrs-core/src/verify/types/matching/mod.rs @@ -1,3 +1,13 @@ +//! The one checked type relation. +//! +//! `TypeMatcher::relate` is the single entry point, parameterized by +//! [`Variance`]: `Subsumption` checks that an actual value type may be consumed +//! where an expected one is required, and `Invariant` checks rigid equality for +//! the positions where the type system allows no variance. Every public entry +//! point and every recursive step goes through it, so acceptance and the +//! substitution evidence it solves have one owner. This module is checking's +//! (P5/P6); no backend stage recomputes the relation. + use super::error; use crate::{Module, Type, TypeId, VerifyError}; use psrs_hir::ModuleId; @@ -32,7 +42,7 @@ pub(in crate::verify) fn compatible( alpha: HashMap::new(), active: HashSet::new(), }; - if !matcher.subsumes(actual, expected, true) { + if !matcher.relate(actual, expected, Variance::Subsumption, true) { errors.push(error( owner, span, @@ -58,7 +68,7 @@ pub(in crate::verify) fn scheme_instance( alpha: HashMap::new(), active: HashSet::new(), }; - matcher.subsumes(scheme, instance, true) + matcher.relate(scheme, instance, Variance::Subsumption, true) } /// Checks an application after transparently instantiating leading type-level @@ -92,11 +102,18 @@ pub(in crate::verify) fn application_matches( else { return false; }; - matcher.subsumes(argument, parameter, true) && matcher.subsumes(function_result, result, true) + matcher.relate(argument, parameter, Variance::Subsumption, true) + && matcher.relate(function_result, result, Variance::Subsumption, true) } +/// The variance mode of the single checked type relation. `Subsumption` is the +/// value-level relation a declaration or local scheme is checked against at its +/// use: function parameters are contravariant, immutable record fields are +/// covariant, and an actual universal may be instantiated. `Invariant` is the +/// rigid mode used where no variance applies — nominal and higher-kinded +/// applications, closed and rigid rows, and constructor field templates. #[derive(Clone, Copy, PartialEq, Eq, Hash)] -enum Relation { +pub(super) enum Variance { Subsumption, Invariant, } @@ -107,19 +124,35 @@ struct TypeMatcher<'a> { replacements: HashMap, row_forms: HashMap, alpha: HashMap, - active: HashSet<(Relation, TypeId, TypeId)>, + active: HashSet<(Variance, TypeId, TypeId)>, } impl TypeMatcher<'_> { + /// The one checked type relation. Every entry point and every recursive + /// position goes through it; `variance` selects the mode. Checking is the + /// sole owner of this relation, and its consumers read only its result. + pub(super) fn relate( + &mut self, + actual: TypeId, + expected: TypeId, + variance: Variance, + instantiate: bool, + ) -> bool { + match variance { + Variance::Subsumption => self.subsumption(actual, expected, instantiate), + Variance::Invariant => self.invariant(actual, expected, instantiate), + } + } + /// Checks value subsumption: `actual` may be consumed wherever `expected` /// is required. Function parameters are contravariant, while immutable /// record fields are covariant. An actual universal may be instantiated; /// an expected universal remains rigid and therefore requires an actual /// universal with alpha-equivalent binders. - fn subsumes(&mut self, actual: TypeId, expected: TypeId, instantiate: bool) -> bool { + fn subsumption(&mut self, actual: TypeId, expected: TypeId, instantiate: bool) -> bool { if !self .active - .insert((Relation::Subsumption, actual, expected)) + .insert((Variance::Subsumption, actual, expected)) { return true; } @@ -128,7 +161,7 @@ impl TypeMatcher<'_> { self.module.types.get(expected.0 as usize), ) else { self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return false; }; @@ -141,7 +174,7 @@ impl TypeMatcher<'_> { self.bind_flexible(*variable, actual) }; self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } @@ -152,12 +185,12 @@ impl TypeMatcher<'_> { && self.flexible.contains(variable) { let result = if let Some(previous) = self.replacements.get(variable) { - self.subsumes(*previous, expected, true) + self.relate(*previous, expected, Variance::Subsumption, true) } else { self.bind_flexible(*variable, expected) }; self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } let Type::ForAll { variables, body } = expected_type else { @@ -167,14 +200,14 @@ impl TypeMatcher<'_> { .iter() .map(|variable| (*variable, self.flexible.remove(variable))) .collect::>(); - let result = self.subsumes(actual, *body, instantiate); + let result = self.relate(actual, *body, Variance::Subsumption, instantiate); for (variable, was_flexible) in was_flexible { if was_flexible { self.flexible.insert(variable); } } self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } @@ -194,23 +227,28 @@ impl TypeMatcher<'_> { .any(|variable| self.alpha.contains_key(variable)) { self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return false; } for (actual, expected) in actual_variables.iter().zip(expected_variables) { self.alpha.insert(*actual, *expected); } - let result = self.subsumes(*actual_body, *expected_body, instantiate); + let result = self.relate( + *actual_body, + *expected_body, + Variance::Subsumption, + instantiate, + ); for variable in actual_variables { self.alpha.remove(variable); } self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } if !instantiate { self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return false; } let added = actual_variables @@ -218,13 +256,13 @@ impl TypeMatcher<'_> { .copied() .filter(|variable| self.flexible.insert(*variable)) .collect::>(); - let result = self.subsumes(*actual_body, expected, true); + let result = self.relate(*actual_body, expected, Variance::Subsumption, true); for variable in added { self.flexible.remove(&variable); self.replacements.remove(&variable); } self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } if let Type::Variable(variable) = actual_type { @@ -252,7 +290,7 @@ impl TypeMatcher<'_> { false }; self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } if let Type::Variable(variable) = expected_type { @@ -264,13 +302,13 @@ impl TypeMatcher<'_> { false }; self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } - if let Some(result) = self.subsumes_closure(actual, expected, instantiate) { + if let Some(result) = self.closure_subsumption(actual, expected, instantiate) { self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); return result; } @@ -284,16 +322,25 @@ impl TypeMatcher<'_> { crate::arrow_parts(&self.module.types, actual), crate::arrow_parts(&self.module.types, expected), ) { - self.subsumes(expected_parameter, actual_parameter, true) - && self.subsumes(actual_result, expected_result, instantiate) + self.relate( + expected_parameter, + actual_parameter, + Variance::Subsumption, + true, + ) && self.relate( + actual_result, + expected_result, + Variance::Subsumption, + instantiate, + ) } else if is_record_type(self.module, actual) && is_record_type(self.module, expected) { - self.subsumes_record(actual, expected) + self.record_subsumption(actual, expected) } else { // No variance metadata is carried for nominal and // higher-kinded applications, so keep them invariant. - self.matches(actual, expected, false) + self.relate(actual, expected, Variance::Invariant, false) } } (Type::RowEmpty, Type::RowEmpty) => true, @@ -310,13 +357,13 @@ impl TypeMatcher<'_> { }, ) => { actual_label == expected_label - && self.subsumes(*actual_ty, *expected_ty, true) - && self.matches(*actual_tail, *expected_tail, false) + && self.relate(*actual_ty, *expected_ty, Variance::Subsumption, true) + && self.relate(*actual_tail, *expected_tail, Variance::Invariant, false) } _ => false, }; self.active - .remove(&(Relation::Subsumption, actual, expected)); + .remove(&(Variance::Subsumption, actual, expected)); result } @@ -368,7 +415,7 @@ impl TypeMatcher<'_> { true } - fn subsumes_record(&mut self, actual: TypeId, expected: TypeId) -> bool { - self.relate_records(actual, expected, true) + fn record_subsumption(&mut self, actual: TypeId, expected: TypeId) -> bool { + self.relate_records(actual, expected, Variance::Subsumption) } } diff --git a/crates/psrs-core/src/verify/types/matching/rows.rs b/crates/psrs-core/src/verify/types/matching/rows.rs index ac0ea073..2d8d54f5 100644 --- a/crates/psrs-core/src/verify/types/matching/rows.rs +++ b/crates/psrs-core/src/verify/types/matching/rows.rs @@ -1,6 +1,6 @@ use super::super::types_compatible; -use super::TypeMatcher; use super::helpers::collect_free_variables; +use super::{TypeMatcher, Variance}; use crate::{Type, TypeId, record_row}; use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; @@ -21,14 +21,14 @@ enum TailKind { type RowShape = (Vec<(String, TypeId)>, Option); impl TypeMatcher<'_> { - /// Record subsumption (`covariant`) or invariant matching. Closed rows and - /// rigid open rows must agree exactly. A flexible tail is a quantifier - /// being instantiated and may absorb the other side's residual row. + /// Record relation in the given [`Variance`]. Closed rows and rigid open + /// rows must agree exactly. A flexible tail is a quantifier being + /// instantiated and may absorb the other side's residual row. pub(super) fn relate_records( &mut self, actual: TypeId, expected: TypeId, - covariant: bool, + variance: Variance, ) -> bool { let (Some(actual_row), Some(expected_row)) = ( record_row(&self.module.types, actual), @@ -51,12 +51,8 @@ impl TypeMatcher<'_> { return false; } if let Some(expected_ty) = expected_fields.remove(&label) { - let agrees = if covariant { - self.subsumes(actual_ty, expected_ty, true) - } else { - self.matches(actual_ty, expected_ty, false) - }; - if !agrees { + let instantiate = variance == Variance::Subsumption; + if !self.relate(actual_ty, expected_ty, variance, instantiate) { return false; } } else { diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index 89b38c91..6476a352 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -501,7 +501,10 @@ parameters are its checked instantiation arguments) and the trusted `Effect` (whose fixed parameter is its runtime token); an unregistered constructor is reported rather than resolved by arity or a signature search. Protocol signatures are interned once per registered callable constructor as the concrete -calling convention with the payload erased. +calling convention with the payload erased. The checker's relation itself is a +single `TypeMatcher::relate` parameterized by a `Variance` (subsumption or +invariant); P8 consumes the `Instantiation` evidence it produces and never +re-derives it. The effect token is the compiler-owned opaque state token (`psrs_hir::TypeId::STATE_TOKEN`) that effect lowering threads through each diff --git a/docs/implementation/backend/polymorphism-and-erasure.md b/docs/implementation/backend/polymorphism-and-erasure.md index c2cb64aa..60346b5e 100644 --- a/docs/implementation/backend/polymorphism-and-erasure.md +++ b/docs/implementation/backend/polymorphism-and-erasure.md @@ -348,8 +348,9 @@ PE-13: checking-owned relation and the payload-erased protocol signature of each callable constructor. `FunctionLowerer::source`, `constructor_protocols`, and `transport_signatures` are gone. The effect token is the opaque - `TypeId::STATE_TOKEN`; what remains is the two-relation matcher (`subsumes` - and `matches`), tracked separately. + `TypeId::STATE_TOKEN`. The checker's relation is a single `TypeMatcher::relate` + entry parameterized by `Variance` (subsumption or invariant); P8 consumes its + `Instantiation` evidence and recomputes nothing. - **Workspace suite still red on the Phase-3 migration.** Ten driver tests fail for reasons this topic does not own: five use `-` or `/` without importing the library operator that now owns it (`tests::scalars`, `tests::functions`, From aad64b90ea1b0347fa56a128a2498ce034cc1beb Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 22:19:12 +0800 Subject: [PATCH 015/148] Apply the official applied-variable rule to structural Eq and Ord A constructor field whose immediate head is a type variable, such as `f a`, is compared through the class's higher-kinded counterpart `eq1`/`compare1` instead of requiring `Eq (f a)`/`Ord (f a)`. This is upstream's `isAppliedVar` test in TypeChecker/Deriving.hs, and the vendored Data.Functor.App, Compose, Coproduct, and Product declarations rely on it. `Eq1` and `Ord1` now derive as `eq1 = eq` and `compare1 = compare`, matching upstream's deriveEq1 and deriveOrd1, so the matching `Eq`/`Ord` instance supplies the dictionary. The `Data.Foldable` graph no longer stops on `no instance for constraint Eq (_ _)` or `Ord (_ _)` in those modules. --- .../src/typecheck/classes/deriving/eq.rs | 77 ++++++++++++++----- .../src/typecheck/classes/deriving/mod.rs | 12 +++ .../src/typecheck/classes/deriving/ord.rs | 67 ++++++++++++---- 3 files changed, 119 insertions(+), 37 deletions(-) diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs index 9d3729de..d8e34ae1 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs @@ -7,7 +7,37 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - self.derive_structural_eq(method, class_arguments, method.symbol, false, span) + // A field whose type is an applied type variable `f a` is compared + // through `Eq1`'s `eq1`, exactly as the official deriving rule does. + // The lookup is lazy because a data type with no such field does not + // need `Eq1` to exist in the environment at all. + let needs_eq1 = class_arguments + .first() + .and_then(|argument| { + let instance_type = self.resolve_type(argument.clone()); + let (head, _) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return None; + }; + self.env.type_declarations.get(type_id).map(|declaration| { + declaration + .constructors + .iter() + .any(|constructor| constructor.fields.iter().any(is_applied_variable)) + }) + }) + .unwrap_or(false); + let eq1_method = if needs_eq1 { + match self.known_method_symbol("Data.Eq", "Eq1", "eq1") { + Some(method) => Some(method), + None => { + return self.deriving_error(span, "cannot find the Eq1 method for Eq deriving"); + } + } + } else { + None + }; + self.derive_structural_eq(method, class_arguments, method.symbol, eq1_method, span) } pub(super) fn derive_eq1_method( @@ -16,10 +46,14 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { + // The official rule derives `Eq1` by delegating to `Eq` at the applied + // argument: `eq1 = eq`. The matching `Eq` instance supplies the + // dictionary, so its context must be visible alongside the method's. let Some(eq_method) = self.known_method_symbol("Data.Eq", "Eq", "eq") else { return self.deriving_error(span, "cannot find the Eq method for Eq1 deriving"); }; - self.derive_structural_eq(method, class_arguments, eq_method, true, span) + let implementation = global_expr(eq_method, span); + self.infer_derived_method(method, class_arguments, &implementation) } fn derive_structural_eq( @@ -27,10 +61,9 @@ impl Checker { method: &MethodInfo, class_arguments: &[InferType], eq_method: SymbolId, - higher_kinded: bool, + eq1_method: Option, span: TextRange, ) -> Option { - let description = if higher_kinded { "Eq1" } else { "Eq" }; let Some(instance_type) = class_arguments.first() else { return self.deriving_error(span, "equality deriving requires one type argument"); }; @@ -39,33 +72,23 @@ impl Checker { let InferType::Constructor(TypeConstructor::User(type_id)) = head else { return self.deriving_error( span, - &format!("{description} deriving requires a local data or newtype constructor"), + "Eq deriving requires a local data or newtype constructor", ); }; let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { return self .deriving_error(span, "cannot find the data declaration to derive equality"); }; - let fixed_parameters = - declaration - .parameters - .len() - .checked_sub(if higher_kinded { 1 } else { 0 }); if type_id.module != self.env.module_id || !matches!( declaration.kind, hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype ) - || fixed_parameters != Some(arguments.len()) + || declaration.parameters.len() != arguments.len() { - let requirement = if higher_kinded { - "a locally declared type constructor with one final parameter" - } else { - "a locally declared, fully applied data type" - }; return self.deriving_error( span, - &format!("{description} deriving requires {requirement}"), + "Eq deriving requires a locally declared, fully applied data type", ); } @@ -83,8 +106,14 @@ impl Checker { .iter() .map(|_| self.fresh_deriving_binder("__derived_r", span)) .collect::>(); - let body = - derive_eq_field_tests(constructor, &left_fields, &right_fields, eq_method, span); + let body = derive_eq_field_tests( + constructor, + &left_fields, + &right_fields, + eq_method, + eq1_method, + span, + ); let same_constructor = hir::CaseBranch { coverage: hir::CaseBranchCoverage::Source, pattern: constructor_pattern(constructor, &right_fields, span), @@ -153,6 +182,7 @@ fn derive_eq_field_tests( left_fields: &[hir::LocalBinder], right_fields: &[hir::LocalBinder], eq_method: SymbolId, + eq1_method: Option, span: TextRange, ) -> hir::Expr { constructor @@ -160,8 +190,13 @@ fn derive_eq_field_tests( .iter() .zip(left_fields) .zip(right_fields) - .map(|((_field, left), right)| { - let method = global_expr(eq_method, span); + .map(|((field, left), right)| { + let method = if is_applied_variable(field) { + eq1_method.unwrap_or(eq_method) + } else { + eq_method + }; + let method = global_expr(method, span); apply_expr( apply_expr(method, local_expr(left.id, span), span), local_expr(right.id, span), diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs index c3becfa6..afdf2b98 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs @@ -252,6 +252,18 @@ impl Checker { } } +/// Whether the type is an application whose immediate head is a type +/// variable, such as `f a`. The official `Eq`/`Ord` deriving rules compare +/// exactly these fields through the class's higher-kinded `eq1`/`compare1` +/// counterpart; a deeper application such as `f a b` is not one, matching the +/// official `isAppliedVar` test. +fn is_applied_variable(ty: &hir::Type) -> bool { + matches!( + &ty.kind, + hir::TypeKind::Application(function, _) if matches!(function.kind, hir::TypeKind::Variable(_)) + ) +} + fn flatten_spine(ty: &InferType) -> (&InferType, Vec) { let mut head = ty; let mut arguments = Vec::new(); diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs index ed7689c7..c792e043 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs @@ -1,9 +1,10 @@ use super::super::super::*; -use super::flatten_spine; +use super::{flatten_spine, is_applied_variable}; #[derive(Clone, Copy)] struct OrdFieldContext { method: SymbolId, + field_method: Option, less: SymbolId, equal: SymbolId, greater: SymbolId, @@ -17,7 +18,38 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - self.derive_ord_method_using(method, class_arguments, method.symbol, false, span) + // A field whose type is an applied type variable `f a` is compared + // through `Ord1`'s `compare1`, exactly as the official deriving rule + // does. The lookup is lazy because a data type with no such field does + // not need `Ord1` to exist in the environment at all. + let needs_ord1 = class_arguments + .first() + .and_then(|argument| { + let instance_type = self.resolve_type(argument.clone()); + let (head, _) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return None; + }; + self.env.type_declarations.get(type_id).map(|declaration| { + declaration + .constructors + .iter() + .any(|constructor| constructor.fields.iter().any(is_applied_variable)) + }) + }) + .unwrap_or(false); + let field_method = if needs_ord1 { + match self.known_method_symbol("Data.Ord", "Ord1", "compare1") { + Some(method) => Some(method), + None => { + return self + .deriving_error(span, "cannot find the Ord1 method for Ord deriving"); + } + } + } else { + None + }; + self.derive_ord_method_using(method, class_arguments, method.symbol, field_method, span) } pub(super) fn derive_ord1_method( @@ -26,10 +58,15 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { + // The official rule derives `Ord1` by delegating to `Ord` at the + // applied argument: `compare1 = compare`. The matching `Ord` instance + // supplies the dictionary, so its context must be visible alongside the + // method's. let Some(compare_method) = self.known_method_symbol("Data.Ord", "Ord", "compare") else { return self.deriving_error(span, "cannot find the Ord method for Ord1 deriving"); }; - self.derive_ord_method_using(method, class_arguments, compare_method, true, span) + let implementation = global_expr(compare_method, span); + self.infer_derived_method(method, class_arguments, &implementation) } fn derive_ord_method_using( @@ -37,7 +74,7 @@ impl Checker { method: &MethodInfo, class_arguments: &[InferType], compare_method: SymbolId, - higher_kinded: bool, + field_method: Option, span: TextRange, ) -> Option { let Some(instance_type) = class_arguments.first() else { @@ -54,25 +91,16 @@ impl Checker { let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { return self.deriving_error(span, "cannot find the data declaration to derive Ord"); }; - let expected_arguments = - declaration - .parameters - .len() - .checked_sub(if higher_kinded { 1 } else { 0 }); if type_id.module != self.env.module_id || !matches!( declaration.kind, hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype ) - || expected_arguments != Some(arguments.len()) + || declaration.parameters.len() != arguments.len() { return self.deriving_error( span, - if higher_kinded { - "Ord1 deriving requires a locally declared type constructor with one final parameter" - } else { - "Ord deriving requires a locally declared, fully applied data type" - }, + "Ord deriving requires a locally declared, fully applied data type", ); } let Some(ordering_id) = ordering_result_id(&method.signature) else { @@ -98,6 +126,7 @@ impl Checker { let right = self.fresh_deriving_binder("__derived_right", span); let field_context = OrdFieldContext { method: compare_method, + field_method, less, equal, greater, @@ -195,6 +224,7 @@ fn derive_ord_field_tests( ) -> hir::Expr { let OrdFieldContext { method, + field_method, less, equal, greater, @@ -202,7 +232,12 @@ fn derive_ord_field_tests( } = context; fields.iter().zip(left).zip(right).rev().fold( global_expr(equal, span), - |rest, ((_field, left), right)| { + |rest, ((field, left), right)| { + let method = if is_applied_variable(field) { + field_method.unwrap_or(method) + } else { + method + }; let compared = apply_expr( apply_expr(global_expr(method, span), local_expr(left.id, span), span), local_expr(right.id, span), From f434ef4f7fbdf1d0dd3f54f2d52839263f79d4f6 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 5 Oct 2026 22:19:19 +0800 Subject: [PATCH 016/148] Instantiate a bare class method's local constraints at its use A class-method use that is not applied, such as `eq = eq1` or `compare = compare1`, kept its method-local `forall` and constraints on the inferred type. Checking it against the plain function type the instance method expects then reported a type mismatch instead of providing the method's dictionary. The expected-type path now runs the inferred expression through the shared `instantiate_expression_use`, the same operation the application path already uses, so the method-local obligation becomes a wanted constraint. This lets Data.Functor.Product and Data.Functor.Coproduct's hand-written `eq = eq1` and `compare = compare1` type check. --- crates/psrs-typecheck/src/typecheck/infer/expected.rs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/crates/psrs-typecheck/src/typecheck/infer/expected.rs b/crates/psrs-typecheck/src/typecheck/infer/expected.rs index 9a7bec13..bb21a091 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/expected.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/expected.rs @@ -235,7 +235,14 @@ impl Checker { ); } - let mut inferred = self.infer_expr(expression)?; + let inferred = self.infer_expr(expression)?; + // A bare class-method use keeps its method-local quantifiers and + // constraints on the inferred type. Instantiating them here matches the + // application path, so `eq = eq1` provides the `Eq a` dictionary the + // method signature requires instead of unifying the constraint with a + // plain function type. + let scheme = Scheme::monomorphic(inferred.ty.clone()); + let mut inferred = self.instantiate_expression_use(inferred, &scheme, expression.span); self.subsume(inferred.ty.clone(), expected.clone(), expression.span); inferred.ty = expected; Some(inferred) From 6547252b5bac2988dd4d8f49147a392c543e2823 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 01:56:07 +0800 Subject: [PATCH 017/148] Implement deriving with one identity registry, usage analysis, and all classes Compiler-supported deriving is now its own topic: it selects rules from one registry built once from the resolved declarations, validates each field's usage and variance against the visible instance environment, and reports the official deriving errorCode for every failure. The known classes are no longer recognized by comparing class module and name strings at use time. DerivingRegistry maps resolved class identities to their methods, to the representation declarations (Data.Ordering, Data.Generic.Rep), and to the trusted core values (append, mempty, identity, apply, pure) the fold and traversal rules name. A Newtype/Generic trailing wildcard is resolved to the wrapped type or representation before the instance is recorded, so the searchable head is concrete. usage.rs walks each field with polarity and instance existence, so a field head with no mapping instance is rejected at the declaration with CannotDeriveInvalidConstructorArg, matching purs. Every structural class now has a rule: Eq/Ord/Eq1/Ord1, Functor/Bifunctor/Contravariant/Profunctor, Foldable/Bifoldable, Traversable/Bitraversable, Newtype, Generic, and derive newtype. Eq and Ord normalize field synonyms before the applied-variable test. The new diagnostics map to their official codes: CannotDerive, ExpectedTypeConstructor, InvalidDerivedInstance, InvalidNewtypeInstance, CannotDeriveNewtypeForData, CannotDeriveInvalidConstructorArg, CannotFindDerivingType, and ExpectedWildcard. derive newtype on a data type is InvalidNewtypeInstance, and deriving the Newtype class for a data type is CannotDeriveNewtypeForData, as purs reports. Deriving is documented as its own topic and split out of FE-16 into FE-22. Validated: psrs-typecheck 134 passed; the deriving source tests 16 passed, the runtime deriving tests 8 passed under PSRS_REQUIRE_WASMTIME=1, and the upstream deriving batteries 2 passed (18 accept/reject cases and an errorCode comparison). The full driver suite is 561 passed with the same 10 pre-existing failures. Traversable/Bitraversable execution is blocked by a P8 CC verification limit and is recorded as such. --- crates/psrs-backend/src/boundary.rs | 29 ++ .../psrs-backend/src/cc/layout/aggregate.rs | 59 ++- crates/psrs-backend/src/cc/layout/mod.rs | 3 + crates/psrs-backend/src/cc/layout/scalar.rs | 4 +- .../src/cc/layout/tests/records.rs | 47 ++ .../src/cc/lower/conversion/function_slot.rs | 308 +++++++++++ .../src/cc/lower/conversion/mod.rs | 18 +- .../src/cc/lower/conversion/scalars.rs | 21 +- crates/psrs-backend/src/cc/mod.rs | 8 +- crates/psrs-core/src/lib.rs | 6 + crates/psrs-core/src/lower/dictionary.rs | 11 +- crates/psrs-core/src/tests/instantiation.rs | 24 + .../src/verify/types/matching/mod.rs | 14 + crates/psrs-driver/src/program/lenient.rs | 5 + crates/psrs-driver/src/program/mod.rs | 7 + .../psrs-driver/src/tests/closure_protocol.rs | 30 ++ crates/psrs-driver/src/tests/data_tuple.rs | 10 +- .../src/tests/deriving/diagnostics.rs | 205 ++++++++ .../tests/{deriving.rs => deriving/mod.rs} | 146 ++++++ .../src/tests/deriving/traversals.rs | 191 +++++++ .../src/tests/generic_aggregate_audit.rs | 2 +- .../tests/wasi/classes/deriving/adapters.rs | 146 ++++++ .../src/tests/wasi/classes/deriving/folds.rs | 61 +++ .../tests/wasi/classes/deriving/generic.rs | 64 +++ .../wasi/classes/deriving/higher_kinded.rs | 58 +++ .../classes/{deriving.rs => deriving/mod.rs} | 64 +++ .../tests/wasi/classes/deriving/records.rs | 216 ++++++++ .../tests/wasi/classes/deriving/traversals.rs | 286 +++++++++++ .../psrs-driver/src/tests/wasi/classes/mod.rs | 10 +- .../tests/upstream/deriving/diagnostics.rs | 102 ++++ .../tests/upstream/deriving/mod.rs | 5 + .../{deriving.rs => deriving/rules.rs} | 0 .../tests/upstream/deriving/traversals.rs | 291 +++++++++++ crates/psrs-driver/tests/upstream/mod.rs | 30 +- .../psrs-syntax/src/parser/expr/atom/mod.rs | 64 +-- .../src/parser/expr/atom/postfix.rs | 70 +++ crates/psrs-syntax/src/parser/tests.rs | 24 + crates/psrs-thir/src/tests.rs | 40 ++ crates/psrs-thir/src/verify/mod.rs | 2 +- .../typecheck/classes/deriving/bifunctor.rs | 178 +------ .../classes/deriving/contravariant.rs | 194 +------ .../src/typecheck/classes/deriving/eq.rs | 133 ++--- .../classes/deriving/foldable/branches.rs | 385 ++++++++++++++ .../classes/deriving/foldable/mod.rs | 193 +++++++ .../src/typecheck/classes/deriving/functor.rs | 191 +------ .../src/typecheck/classes/deriving/generic.rs | 188 +++---- .../src/typecheck/classes/deriving/mapping.rs | 131 +++++ .../src/typecheck/classes/deriving/mod.rs | 256 ++++----- .../src/typecheck/classes/deriving/newtype.rs | 38 +- .../src/typecheck/classes/deriving/ord.rs | 197 +++---- .../typecheck/classes/deriving/profunctor.rs | 13 + .../typecheck/classes/deriving/registry.rs | 321 ++++++++++++ .../src/typecheck/classes/deriving/syntax.rs | 153 ++++++ .../typecheck/classes/deriving/traversable.rs | 395 ++++++++++++++ .../classes/deriving/usage/mapping.rs | 104 ++++ .../typecheck/classes/deriving/usage/mod.rs | 388 ++++++++++++++ .../src/typecheck/classes/environment/mod.rs | 56 +- .../src/typecheck/classes/evidence/mod.rs | 2 + .../src/typecheck/classes/instance.rs | 2 + .../src/typecheck/classes/mod.rs | 1 + crates/psrs-typecheck/src/typecheck/entry.rs | 1 + crates/psrs-typecheck/src/typecheck/error.rs | 31 ++ .../src/typecheck/infer/construct.rs | 7 + crates/psrs-typecheck/src/typecheck/mod.rs | 4 + .../src/typecheck/prim/compare/tests.rs | 1 + .../psrs-typecheck/src/typecheck/prim/int.rs | 1 + .../src/typecheck/prim/row/tests/mod.rs | 1 + .../src/typecheck/prim/tests/mod.rs | 1 + crates/psrs-typecheck/src/typecheck/state.rs | 4 + .../src/typecheck/tests/binding_kinds.rs | 2 + .../DEC-17-representation-and-evidence.md | 7 + docs/design/D-04-suite-roadmap.md | 39 +- .../backend/fp/representation-and-evidence.md | 30 +- .../fp/type-classes-and-dictionaries.md | 4 +- .../backend/wasm/wasi-platform-library.md | 2 +- docs/design/frontend/README.md | 1 + .../design/frontend/syntax/parsing-and-cst.md | 7 + docs/design/frontend/type-system/README.md | 9 +- .../type-system/classes-and-evidence.md | 34 +- docs/design/frontend/type-system/deriving.md | 485 ++++++++++++++++++ .../backend/type-classes-and-dictionaries.md | 8 +- docs/implementation/frontend/deriving.md | 140 +++++ .../frontend/roles-and-coercions.md | 64 +-- stdlib/lib/Data/Tuple.purs | 4 + 84 files changed, 5850 insertions(+), 1237 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/conversion/function_slot.rs create mode 100644 crates/psrs-driver/src/tests/deriving/diagnostics.rs rename crates/psrs-driver/src/tests/{deriving.rs => deriving/mod.rs} (57%) create mode 100644 crates/psrs-driver/src/tests/deriving/traversals.rs create mode 100644 crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs create mode 100644 crates/psrs-driver/src/tests/wasi/classes/deriving/folds.rs create mode 100644 crates/psrs-driver/src/tests/wasi/classes/deriving/generic.rs create mode 100644 crates/psrs-driver/src/tests/wasi/classes/deriving/higher_kinded.rs rename crates/psrs-driver/src/tests/wasi/classes/{deriving.rs => deriving/mod.rs} (79%) create mode 100644 crates/psrs-driver/src/tests/wasi/classes/deriving/records.rs create mode 100644 crates/psrs-driver/src/tests/wasi/classes/deriving/traversals.rs create mode 100644 crates/psrs-driver/tests/upstream/deriving/diagnostics.rs create mode 100644 crates/psrs-driver/tests/upstream/deriving/mod.rs rename crates/psrs-driver/tests/upstream/{deriving.rs => deriving/rules.rs} (100%) create mode 100644 crates/psrs-driver/tests/upstream/deriving/traversals.rs create mode 100644 crates/psrs-syntax/src/parser/expr/atom/postfix.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/branches.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/mod.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/mapping.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/profunctor.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/registry.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/syntax.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/traversable.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mapping.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mod.rs create mode 100644 docs/design/frontend/type-system/deriving.md create mode 100644 docs/implementation/frontend/deriving.md diff --git a/crates/psrs-backend/src/boundary.rs b/crates/psrs-backend/src/boundary.rs index 8f0594c5..4a118ab1 100644 --- a/crates/psrs-backend/src/boundary.rs +++ b/crates/psrs-backend/src/boundary.rs @@ -80,6 +80,7 @@ pub(crate) struct BoundaryEvidence<'a> { /// keyed by the concrete callable's signature. Built by P8 layout from the /// registered owners and the module's callable signatures. protocols: HashMap, + function_slot: Option, } impl<'a> BoundaryEvidence<'a> { @@ -88,12 +89,14 @@ impl<'a> BoundaryEvidence<'a> { physical: &'a CoreModule, registry: RepresentationRegistry, protocols: HashMap, + function_slot: Option, ) -> Self { Self { source, physical, registry, protocols, + function_slot, } } @@ -106,6 +109,7 @@ impl<'a> BoundaryEvidence<'a> { physical, RepresentationRegistry::new(), HashMap::new(), + None, ) } @@ -152,6 +156,12 @@ impl<'a> BoundaryEvidence<'a> { self.registry.protocol_parameters(constructor, arguments) } + /// Bare polymorphic function slots use one erased argument at a time. + /// Multi-argument functions are curried on entry and flattened on recovery. + pub(crate) fn function_slot_signature(&self) -> Option { + self.function_slot + } + /// The payload-erased protocol signature a callable constructor stores its /// values under, keyed by the concrete callable signature. pub(crate) fn protocol_signature(&self, concrete: SignatureId) -> Option { @@ -215,3 +225,22 @@ pub(crate) fn payload_erased_protocols( } protocols } + +/// The representation owner for a function hidden by a bare type variable. +/// A unary protocol keeps the slot stable when instantiation changes arity. +pub(crate) fn function_slot_protocol(table: &mut crate::cc::RepresentationTable) -> SignatureId { + let erased = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }); + let signature = Signature { + parameters: vec![erased], + result: erased, + }; + table + .signatures + .iter() + .position(|existing| *existing == signature) + .map(|index| SignatureId(index as u32)) + .unwrap_or_else(|| table.add_signature(signature)) +} diff --git a/crates/psrs-backend/src/cc/layout/aggregate.rs b/crates/psrs-backend/src/cc/layout/aggregate.rs index 0a113ec1..936bf260 100644 --- a/crates/psrs-backend/src/cc/layout/aggregate.rs +++ b/crates/psrs-backend/src/cc/layout/aggregate.rs @@ -14,7 +14,7 @@ enum AggregateKey { Record(Vec<(String, ValueShape)>), } -#[derive(Clone)] +#[derive(Clone, PartialEq, Eq)] pub(super) struct AggregateLayouts { pub(super) arrays: HashMap, pub(super) records: HashMap, @@ -47,6 +47,45 @@ pub(super) fn reserve_aggregate_layouts( /// Core IDs select normalization inputs, not runtime layout identities. #[allow(clippy::too_many_arguments)] pub(super) fn normalize_aggregate_layouts( + module: &Module, + enum_types: &HashSet, + aggregate_types: &HashSet, + newtype_ids: &HashSet, + mut function_types: HashMap, + mut layouts: AggregateLayouts, + representations: &mut RepresentationTable, +) -> Result<(AggregateLayouts, HashMap), Vec> { + // Aggregate keys contain closure signatures, whose keys in turn contain + // aggregate handles. Intern both until neither identity changes. + let bound = representations.representations.len() + representations.signatures.len() + 2; + for _ in 0..bound { + let previous_layouts = layouts.clone(); + let previous_functions = function_types.clone(); + let previous_table = representations.clone(); + (layouts, function_types) = normalize_pass( + module, + enum_types, + aggregate_types, + newtype_ids, + function_types, + layouts, + representations, + )?; + if layouts == previous_layouts + && function_types == previous_functions + && *representations == previous_table + { + return Ok((layouts, function_types)); + } + } + Err(layout_error( + module.span, + "aggregate and callable layout normalization did not converge", + )) +} + +#[allow(clippy::too_many_arguments)] +fn normalize_pass( module: &Module, enum_types: &HashSet, aggregate_types: &HashSet, @@ -104,6 +143,24 @@ pub(super) fn normalize_aggregate_layouts( } remap_shape(&mut signature.result, &remapped); } + for representation in &mut representations_table.representations { + match representation { + Representation::Box { value } => remap_shape(value, &remapped), + Representation::Product { fields } => { + for field in fields { + remap_shape(field, &remapped); + } + } + Representation::Variant { cases } => { + for case in cases { + for field in &mut case.fields { + remap_shape(field, &remapped); + } + } + } + Representation::Array { element } => remap_shape(element, &remapped), + } + } canonicalize_signatures(representations_table, &mut function_types); Ok((layouts, function_types)) } diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index d5faee92..d4233dce 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -287,7 +287,9 @@ pub(super) fn type_layout( representations.set(id, Representation::Variant { cases }); } + let function_slot = crate::boundary::function_slot_protocol(&mut representations); Ok(TypeLayout { + function_slot, protocols: crate::boundary::payload_erased_protocols(&mut representations, &function_types), representations, array_types, @@ -300,6 +302,7 @@ pub(super) fn type_layout( } pub(super) struct TypeLayout { + pub(super) function_slot: SignatureId, /// The payload-erased protocol signature of each callable constructor, /// keyed by its concrete signature. Built from the registered /// representation owners and the module's callable signatures. diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index afc844bd..46226ef1 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -36,7 +36,7 @@ pub(crate) fn declaration_shape( let ExprKind::Lambda { binder, body } = &value.kind else { break; }; - if binder.ty != *parameter_ty { + if !module.types_equivalent(binder.ty, *parameter_ty) { return Err(vec![BackendError::new( "P8 closure conversion", binder.span, @@ -76,7 +76,7 @@ pub(crate) fn declaration_shape( let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, ty) else { break; }; - if parameter != binder.ty { + if !module.types_equivalent(parameter, binder.ty) { return Err(vec![BackendError::new( "P8 closure conversion", binder.span, diff --git a/crates/psrs-backend/src/cc/layout/tests/records.rs b/crates/psrs-backend/src/cc/layout/tests/records.rs index f83b682f..b619191b 100644 --- a/crates/psrs-backend/src/cc/layout/tests/records.rs +++ b/crates/psrs-backend/src/cc/layout/tests/records.rs @@ -196,3 +196,50 @@ fn canonical_record_keys_sort_labels_and_share_equal_keyed_records() { }) ); } + +#[test] +fn record_and_callable_keys_converge_together_through_nested_layouts() { + let mut types = vec![ + Type::Variable(TypeVariableId(0)), + Type::Variable(TypeVariableId(1)), + Type::Constructor(TypeConstructor::Int), + ]; + let first_inner = push_record(&mut types, vec![("payload", TypeId(0))]); + let second_inner = push_record(&mut types, vec![("payload", TypeId(1))]); + let first_method = push_arrow(&mut types, first_inner, TypeId(0)); + let second_method = push_arrow(&mut types, second_inner, TypeId(1)); + let first_outer = push_record(&mut types, vec![("run", first_method)]); + let second_outer = push_record(&mut types, vec![("run", second_method)]); + let first_consumer = push_arrow(&mut types, first_outer, TypeId(2)); + let second_consumer = push_arrow(&mut types, second_outer, TypeId(2)); + let mut module = empty_module(types); + root_types(&mut module, [first_consumer, second_consumer]); + let layout = layout_for(&module); + assert_eq!( + layout.record_types[&first_inner], + layout.record_types[&second_inner] + ); + assert_eq!( + layout.function_types[&first_method], + layout.function_types[&second_method] + ); + assert_eq!( + layout.record_types[&first_outer], + layout.record_types[&second_outer] + ); + assert_eq!( + layout.function_types[&first_consumer], + layout.function_types[&second_consumer] + ); + let signature = layout + .representations + .signature(layout.function_types[&first_consumer]) + .unwrap(); + assert_eq!( + signature.parameters, + vec![ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(layout.record_types[&first_outer]), + })] + ); +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs b/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs new file mode 100644 index 00000000..1126df2a --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs @@ -0,0 +1,308 @@ +//! One callable protocol for functions stored under bare polymorphic values. +//! Erasure curries flattened calls into unary erased segments; recovery applies +//! those segments and adapts every argument and the final result explicitly. +use super::super::LambdaLowering; +use super::*; +use crate::cc::{Function, Signature, SignatureId}; + +fn closure(signature: SignatureId) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(signature), + }) +} + +impl FunctionLowerer<'_> { + fn slot_signature(&self, span: TextRange) -> Result> { + self.boundary.function_slot_signature().ok_or_else(|| { + conversion_error(span, "polymorphic function slot has no registered protocol") + }) + } + + pub(super) fn erase_function_slot( + &mut self, + source: SignatureId, + span: TextRange, + ) -> Result> { + let slot = self.slot_signature(span)?; + if source == slot { + return Ok(ValueConversion::Identity); + } + let shape = self + .representations + .signature(source) + .cloned() + .ok_or_else(|| conversion_error(span, "function slot producer has no signature"))?; + if shape.parameters.is_empty() { + return Err(conversion_error( + span, + "function slot producer requires an argument", + )); + } + let function = self.slot_segment(source, slot, &shape, 0, span)?; + self.slot_factory(source, slot, function, span) + } + + fn slot_segment( + &mut self, + source: SignatureId, + slot: SignatureId, + shape: &Signature, + prefix: usize, + span: TextRange, + ) -> Result> { + let mut body = self.child_lowerer(); + let receiver = body.fresh(ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Aggregate, + })); + let input = body.fresh(erased_shape()); + let mut assignments = Vec::new(); + let producer = body.slot_capture(receiver, 0, closure(source), span, &mut assignments); + let mut arguments = Vec::new(); + for index in 0..prefix { + arguments.push(body.slot_capture( + receiver, + index as u32 + 1, + shape.parameters[index], + span, + &mut assignments, + )); + } + let conversion = body.recover_payload(shape.parameters[prefix], span)?; + arguments.push(body.emit_conversion( + input, + erased_shape(), + shape.parameters[prefix], + conversion, + span, + &mut assignments, + )); + let result = if prefix + 1 == shape.parameters.len() { + let result = body.fresh(shape.result); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::IndirectCall { + function: producer, + signature: source, + arguments, + }, + span, + }); + let conversion = body.erase_payload(shape.result, span)?; + body.emit_conversion( + result, + shape.result, + erased_shape(), + conversion, + span, + &mut assignments, + ) + } else { + let next = body.slot_segment(source, slot, shape, prefix + 1, span)?; + let value = body.fresh(closure(slot)); + let mut captures = vec![producer]; + captures.extend(arguments); + assignments.push(Assignment { + destination: value, + kind: AssignmentKind::FunctionRef { + function: next, + signature: slot, + captures, + }, + span, + }); + body.emit_conversion( + value, + closure(slot), + erased_shape(), + ValueConversion::EraseReference, + span, + &mut assignments, + ) + }; + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let function = Function { + symbol, + name: format!("function_slot_segment_{prefix}_{}", span.start), + parameters: vec![receiver, input], + values: body.values, + assignments, + result, + result_type: erased_shape(), + span, + }; + super::super::super::verify::verify_function( + &function, + self.signatures, + self.representations, + )?; + self.generated.extend(body.generated); + self.generated.push(function); + Ok(symbol) + } + + pub(super) fn recover_function_slot( + &mut self, + target: SignatureId, + span: TextRange, + ) -> Result> { + let slot = self.slot_signature(span)?; + let cast = ValueConversion::RecoverReference { + destination: closure(slot), + evidence: RecoveryEvidence::TypeInstantiation, + }; + if target == slot { + return Ok(cast); + } + let shape = self + .representations + .signature(target) + .cloned() + .ok_or_else(|| conversion_error(span, "function slot consumer has no signature"))?; + if shape.parameters.is_empty() { + return Err(conversion_error( + span, + "function slot consumer requires an argument", + )); + } + let mut body = self.child_lowerer(); + let receiver = body.fresh(ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Aggregate, + })); + let inputs: Vec<_> = shape + .parameters + .iter() + .map(|shape| body.fresh(*shape)) + .collect(); + let mut parameters = vec![receiver]; + parameters.extend(inputs.iter().copied()); + let mut assignments = Vec::new(); + let mut current = body.slot_capture(receiver, 0, closure(slot), span, &mut assignments); + let mut result = current; + for (index, parameter_shape) in shape.parameters.iter().enumerate() { + let input = inputs[index]; + let conversion = body.erase_payload(*parameter_shape, span)?; + let argument = body.emit_conversion( + input, + *parameter_shape, + erased_shape(), + conversion, + span, + &mut assignments, + ); + result = body.fresh(erased_shape()); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::IndirectCall { + function: current, + signature: slot, + arguments: vec![argument], + }, + span, + }); + if index + 1 < shape.parameters.len() { + current = body.emit_conversion( + result, + erased_shape(), + closure(slot), + cast.clone(), + span, + &mut assignments, + ); + } + } + let conversion = body.recover_payload(shape.result, span)?; + let result = body.emit_conversion( + result, + erased_shape(), + shape.result, + conversion, + span, + &mut assignments, + ); + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let function = Function { + symbol, + name: format!("function_slot_recovery_{}", span.start), + parameters, + values: body.values, + assignments, + result, + result_type: shape.result, + span, + }; + super::super::super::verify::verify_function( + &function, + self.signatures, + self.representations, + )?; + self.generated.extend(body.generated); + self.generated.push(function); + let factory = self.slot_factory(slot, target, symbol, span)?; + Ok(sequence(vec![cast, factory])) + } + + fn slot_capture( + &mut self, + receiver: ValueId, + index: u32, + shape: ValueShape, + span: TextRange, + assignments: &mut Vec, + ) -> ValueId { + let value = self.fresh(shape); + assignments.push(Assignment { + destination: value, + kind: AssignmentKind::ClosureGetCapture { + closure: receiver, + index, + }, + span, + }); + value + } + + fn slot_factory( + &mut self, + source: SignatureId, + target: SignatureId, + body: psrs_hir::SymbolId, + span: TextRange, + ) -> Result> { + let mut factory = self.child_lowerer(); + let input = factory.fresh(closure(source)); + let output = factory.fresh(closure(target)); + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let function = Function { + symbol, + name: format!("function_slot_factory_{}", span.start), + parameters: vec![input], + values: factory.values, + assignments: vec![Assignment { + destination: output, + kind: AssignmentKind::FunctionRef { + function: body, + signature: target, + captures: vec![input], + }, + span, + }], + result: output, + result_type: closure(target), + span, + }; + super::super::super::verify::verify_function( + &function, + self.signatures, + self.representations, + )?; + self.generated.push(function); + Ok(ValueConversion::FunctionAdapter { + function: symbol, + source: closure(source), + destination: closure(target), + }) + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/mod.rs b/crates/psrs-backend/src/cc/lower/conversion/mod.rs index 0aee4d4e..5a2863d6 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/mod.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/mod.rs @@ -12,6 +12,7 @@ use psrs_core::TypeId; use psrs_span::TextRange; mod callable; +mod function_slot; mod scalars; mod transport; @@ -129,6 +130,14 @@ impl FunctionLowerer<'_> { ); } if is_abstract_type(self.module, destination_type) { + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = source_shape + { + let adapter = self.erase_function_slot(signature, span)?; + return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); + } return match source_shape { ValueShape::Integer | ValueShape::Boolean => self .box_plan(BoxKind::Integer, self.boxed_integer_type, span) @@ -144,6 +153,13 @@ impl FunctionLowerer<'_> { }; } if is_abstract_type(self.module, source_type) { + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = destination_shape + { + return self.recover_function_slot(signature, span); + } return match destination_shape { ValueShape::Integer | ValueShape::Boolean => self.unbox_plan( BoxKind::Integer, @@ -367,7 +383,7 @@ impl FunctionLowerer<'_> { let template_shape = self.value_shape(template_type, span)?; if stored_shape == erased_shape() && is_abstract_type(self.module, template_type) - && matches!(target_shape, ValueShape::Reference(_)) + && matches!(target_shape, ValueShape::Reference(reference) if !matches!(reference.heap, RefShape::Closure(_))) && target_shape != erased_shape() { return Ok(ValueConversion::RecoverReference { diff --git a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs index 62c07ad2..5283f772 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs @@ -2,19 +2,27 @@ use super::super::FunctionLowerer; use super::{conversion_error, erased_shape, sequence}; use crate::{ BackendError, - cc::{BoxKind, RecoveryEvidence, ReprId, ValueConversion, ValueShape}, + cc::{BoxKind, RecoveryEvidence, RefShape, Reference, ReprId, ValueConversion, ValueShape}, }; use psrs_span::TextRange; impl FunctionLowerer<'_> { pub(super) fn erase_payload( - &self, + &mut self, shape: ValueShape, span: TextRange, ) -> Result> { if shape == erased_shape() { return Ok(ValueConversion::Identity); } + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = shape + { + let adapter = self.erase_function_slot(signature, span)?; + return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); + } let boxed = match shape { ValueShape::Integer | ValueShape::Boolean => { self.box_plan(BoxKind::Integer, self.boxed_integer_type, span)? @@ -28,13 +36,20 @@ impl FunctionLowerer<'_> { } pub(super) fn recover_payload( - &self, + &mut self, shape: ValueShape, span: TextRange, ) -> Result> { if shape == erased_shape() { return Ok(ValueConversion::Identity); } + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = shape + { + return self.recover_function_slot(signature, span); + } match shape { ValueShape::Integer | ValueShape::Boolean => { self.unbox_plan(BoxKind::Integer, self.boxed_integer_type, shape, span) diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 1ef6d9ea..72661dc5 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -350,7 +350,13 @@ pub(crate) fn lower_module_with_relations( (declaration.symbol, wrapper) }) .collect::>(); - let boundary = BoundaryEvidence::new(relations, &module, registry, layout.protocols); + let boundary = BoundaryEvidence::new( + relations, + &module, + registry, + layout.protocols, + Some(layout.function_slot), + ); let context = LoweringContext { module: &module, boundary: &boundary, diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 834bdda1..5b3ee833 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -258,6 +258,12 @@ impl Module { verify::instantiation(self, scheme, quantified, instance) } + /// Compares types with the same semantic relation used by Core verification, + /// including separately interned alpha-equivalent quantified types. + pub fn types_equivalent(&self, left: TypeId, right: TypeId) -> bool { + verify::equivalent_types(left, right, self) + } + /// The hidden calling-convention parameter count registered for a callable /// type constructor identity, or `None` when the constructor is not /// callable. diff --git a/crates/psrs-core/src/lower/dictionary.rs b/crates/psrs-core/src/lower/dictionary.rs index c0900396..4e6b3098 100644 --- a/crates/psrs-core/src/lower/dictionary.rs +++ b/crates/psrs-core/src/lower/dictionary.rs @@ -30,19 +30,16 @@ pub(super) fn lower_evidence(evidence: &Evidence, types: &[Type]) -> Result, field: TypeId) -> TypeId { types.push(Type::Constructor(TypeConstructor::Record)); apply(types, head, row) } + +#[test] +fn type_level_literals_match_by_value_in_invariant_applications() { + let mut types = vec![ + Type::TypeLevelString("Pair".into()), + Type::TypeLevelString("Pair".into()), + Type::TypeLevelString("Single".into()), + Type::TypeLevelInt(42), + Type::TypeLevelInt(42), + Type::TypeLevelInt(43), + ]; + for (first, equal, different) in [(0, 1, 2), (3, 4, 5)] { + let first = nominal(&mut types, 0, TypeId(first)); + let equal = nominal(&mut types, 0, TypeId(equal)); + let different = nominal(&mut types, 0, TypeId(different)); + let module = bare(types.clone()); + assert!(module.checked_instantiation(first, &[], equal).is_some()); + assert!( + module + .checked_instantiation(first, &[], different) + .is_none() + ); + } +} diff --git a/crates/psrs-core/src/verify/types/matching/mod.rs b/crates/psrs-core/src/verify/types/matching/mod.rs index fd6e39e3..f0f64517 100644 --- a/crates/psrs-core/src/verify/types/matching/mod.rs +++ b/crates/psrs-core/src/verify/types/matching/mod.rs @@ -138,6 +138,20 @@ impl TypeMatcher<'_> { variance: Variance, instantiate: bool, ) -> bool { + // Literal identity is by value in every mode, independent of the + // arena IDs assigned to occurrences of the same type-level literal. + match ( + self.module.types.get(actual.0 as usize), + self.module.types.get(expected.0 as usize), + ) { + (Some(Type::TypeLevelString(left)), Some(Type::TypeLevelString(right))) => { + return left == right; + } + (Some(Type::TypeLevelInt(left)), Some(Type::TypeLevelInt(right))) => { + return left == right; + } + _ => {} + } match variance { Variance::Subsumption => self.subsumption(actual, expected, instantiate), Variance::Invariant => self.invariant(actual, expected, instantiate), diff --git a/crates/psrs-driver/src/program/lenient.rs b/crates/psrs-driver/src/program/lenient.rs index 9b7b4c9e..5015a6f0 100644 --- a/crates/psrs-driver/src/program/lenient.rs +++ b/crates/psrs-driver/src/program/lenient.rs @@ -73,6 +73,10 @@ pub fn check_program_types_lenient(sources: &[(&str, &str)]) -> Result<(), Vec

>(); // Every per-module table below is indexed by the module's own `ModuleId`, // which is its position in `sources`. `resolved` holds only the sources that // reached resolution, so enumerating it would both attribute a diagnostic to @@ -113,6 +117,7 @@ pub fn check_program_types_lenient(sources: &[(&str, &str)]) -> Result<(), Vec

>(); // Instance declarations are threaded per module, like values: a module can // only select an instance declared in a module it imports, directly or // transitively. @@ -392,6 +398,7 @@ fn typecheck_resolved_program_with_warnings( false, psrs_typecheck::TypecheckContext { known_types: &known_types, + known_values: &known_values, imported_instances: &imported_instances, module_names: &module_names, checked_kinds: &checked_kinds, diff --git a/crates/psrs-driver/src/tests/closure_protocol.rs b/crates/psrs-driver/src/tests/closure_protocol.rs index 15461bdf..138378bf 100644 --- a/crates/psrs-driver/src/tests/closure_protocol.rs +++ b/crates/psrs-driver/src/tests/closure_protocol.rs @@ -131,3 +131,33 @@ fn plan_has_adapter(plan: &psrs_backend::cc::ValueConversion) -> bool { _ => false, } } + +#[test] +fn erased_function_slots_preserve_partial_application_and_captures() { + let source = r#" +module Main where + +data Box a = Box a + +store :: forall a. a -> Box a +store value = Box value + +load :: forall a. Box a -> a +load (Box value) = value + +add :: Int -> Int -> Int +add x y = intAdd x y + +capture :: Int -> Int -> Int -> Int +capture offset x y = intAdd offset (intAdd x y) + +main :: Int +main = if intEq (load (store add) 40 2) 42 + then load (store (capture 7)) 20 15 + else 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/data_tuple.rs b/crates/psrs-driver/src/tests/data_tuple.rs index a0b04a17..33c65f75 100644 --- a/crates/psrs-driver/src/tests/data_tuple.rs +++ b/crates/psrs-driver/src/tests/data_tuple.rs @@ -2,8 +2,6 @@ use super::*; -const DATA_TUPLE: &str = include_str!("../../../../stdlib/lib/Data/Tuple.purs"); - #[test] fn library_tuple_constructor_and_helpers_execute() { let main = r#" @@ -22,8 +20,7 @@ main = if intEq (uncurry (\left right -> intAdd left right) pair) 42 else 1 else 1 "#; - let sources = [("Data.Tuple.purs", DATA_TUPLE), ("Main.purs", main)]; - let Some(output) = run_program_with_wasmtime(&sources) else { + let Some(output) = run_with_wasmtime(main) else { eprintln!("skipping execution: wasmtime is not installed"); return; }; @@ -35,6 +32,8 @@ fn native_tuple_syntax_still_has_the_closed_record_representation() { let main = r#" module Main where +import Data.Tuple (Tuple) + type Pair = { _1 :: Int, _2 :: Int } fromSyntax :: Pair @@ -45,8 +44,7 @@ fromRecord = { _1: 40, _2: 2 } main = 0 "#; - let sources = [("Data.Tuple.purs", DATA_TUPLE), ("Main.purs", main)]; - let Some(output) = run_program_with_wasmtime(&sources) else { + let Some(output) = run_with_wasmtime(main) else { eprintln!("skipping execution: wasmtime is not installed"); return; }; diff --git a/crates/psrs-driver/src/tests/deriving/diagnostics.rs b/crates/psrs-driver/src/tests/deriving/diagnostics.rs new file mode 100644 index 00000000..c8959516 --- /dev/null +++ b/crates/psrs-driver/src/tests/deriving/diagnostics.rs @@ -0,0 +1,205 @@ +/// A deriving failure carries the official `errorCode` for its condition, not +/// one catch-all kind. This is the diagnostic half of the deriving design; the +/// official differential battery compares acceptance, not codes. +#[test] +fn deriving_failures_report_their_official_error_codes() { + let unknown_class = r#"module Main where + +class Marker a + +data Box = Box + +derive instance markerBox :: Marker Box + +main :: Int +main = 0 +"#; + let newtype_on_data = r#"module Main where + +class ToInt a where + toInt :: a -> Int + +data Box = Box Int + +derive newtype instance toIntBox :: ToInt Box + +main :: Int +main = 0 +"#; + let functor_module = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let functor_contravariant = r#"module Main where + +import Data.Functor (class Functor) + +data Contra a = Contra (a -> Int) + +derive instance functorContra :: Functor Contra + +main :: Int +main = 0 +"#; + let newtype_module = r#"module Data.Newtype where + +class Newtype t a +"#; + let explicit_newtype_argument = r#"module Main where + +import Data.Newtype (class Newtype) + +newtype Age = Age Int + +derive instance newtypeAge :: Newtype Age Int + +main :: Int +main = 0 +"#; + let newtype_class_on_data = r#"module Main where + +import Data.Newtype (class Newtype) + +data Box = Box Int + +derive instance newtypeBox :: Newtype Box _ + +main :: Int +main = 0 +"#; + let missing_mapping_instance_module = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let missing_mapping_instance = r#"module Main where + +import Data.Functor (class Functor) + +data Maybe a = Nothing | Just a + +data Box a = Box (Maybe a) + +derive instance functorBox :: Functor Box + +main :: Int +main = 0 +"#; + fn assert_code(name: &str, expected: &str, sources: &[(&str, &str)]) { + let errors = crate::check_program(sources).expect_err("deriving should be rejected"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some(expected)), + "`{name}`: expected {expected}, got {errors:?}" + ); + } + + assert_code( + "unknown class has no rule", + "CannotDerive", + &[("Main.purs", unknown_class)], + ); + assert_code( + "derive newtype on a data type", + "InvalidNewtypeInstance", + &[("Main.purs", newtype_on_data)], + ); + assert_code( + "Newtype class on a data type", + "CannotDeriveNewtypeForData", + &[ + ("Data.Newtype.purs", newtype_module), + ("Main.purs", newtype_class_on_data), + ], + ); + assert_code( + "Newtype without a wildcard", + "ExpectedWildcard", + &[ + ("Data.Newtype.purs", newtype_module), + ("Main.purs", explicit_newtype_argument), + ], + ); + assert_code( + "field head with no mapping instance", + "CannotDeriveInvalidConstructorArg", + &[ + ("Data.Functor.purs", missing_mapping_instance_module), + ("Main.purs", missing_mapping_instance), + ], + ); + assert_code( + "Functor with a contravariant field", + "CannotDeriveInvalidConstructorArg", + &[ + ("Data.Functor.purs", functor_module), + ("Main.purs", functor_contravariant), + ], + ); +} + +#[test] +fn fold_deriving_reports_missing_core_values_at_the_declaration() { + for (module, class, method, parameters, fields) in [ + ("Data.Foldable", "Foldable", "foldMap", "a", "a a"), + ("Data.Bifoldable", "Bifoldable", "bifoldMap", "a b", "a b"), + ("Data.Foldable", "Foldable", "foldMap", "a", ""), + ("Data.Bifoldable", "Bifoldable", "bifoldMap", "a b", ""), + ] { + let signature = if class == "Foldable" { + "forall a m. (a -> m) -> t a -> m" + } else { + "forall a b m. (a -> m) -> (b -> m) -> t a b -> m" + }; + let library = + format!("module {module} where\nclass {class} t where\n {method} :: {signature}\n"); + let main = format!( + "module Main where\nimport {module}\ndata Box {parameters} = Box {fields}\nderive instance foldBox :: {class} Box\nmain = 0\n" + ); + let errors = crate::check_program(&[("Fold.purs", &library), ("Main.purs", &main)]) + .expect_err("missing fold operations must reject deriving"); + let error = errors + .iter() + .find(|error| error.diagnostic.code == Some("CannotFindDerivingType")) + .unwrap_or_else(|| panic!("{class}, fields `{fields}`: {errors:?}")); + let span = error.diagnostic.span; + let declaration = &main[span.start as usize..span.end as usize]; + assert!( + declaration.contains("derive instance foldBox"), + "{declaration}" + ); + let operation = if fields.is_empty() { + "mempty" + } else { + "append" + }; + assert!(error.diagnostic.message.contains(operation)); + } +} + +#[test] +fn deriving_rejects_non_constructor_heads_and_invalid_class_arity() { + for (library, main, expected) in [ + ( + "module Data.Eq where\nclass Eq a where\n eq :: a -> a -> Boolean\n", + "module Main where\nimport Data.Eq\nderive instance eqInt :: Eq Int\nmain = 0\n", + "ExpectedTypeConstructor", + ), + ( + "module Data.Eq where\nclass Eq a b where\n eq :: a -> b -> Boolean\n", + "module Main where\nimport Data.Eq\ndata Box = Box\nderive instance eqBox :: Eq Box Box\nmain = 0\n", + "InvalidDerivedInstance", + ), + ] { + let errors = crate::check_program(&[("Data.Eq.purs", library), ("Main.purs", main)]) + .expect_err("invalid deriving head should be rejected"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some(expected)), + "{errors:?}" + ); + } +} diff --git a/crates/psrs-driver/src/tests/deriving.rs b/crates/psrs-driver/src/tests/deriving/mod.rs similarity index 57% rename from crates/psrs-driver/src/tests/deriving.rs rename to crates/psrs-driver/src/tests/deriving/mod.rs index 1262f929..a95da440 100644 --- a/crates/psrs-driver/src/tests/deriving.rs +++ b/crates/psrs-driver/src/tests/deriving/mod.rs @@ -1,3 +1,6 @@ +mod diagnostics; +mod traversals; + #[test] fn derives_newtype_methods_from_the_wrapped_instance() { let sources = [( @@ -176,6 +179,149 @@ main = case compare (Pair Low High) (Pair Low Low) of .unwrap_or_else(|errors| panic!("derived Ord should type check: {errors:?}")); } +#[test] +fn derives_eq1_and_ord1_by_delegating_to_the_monomorphic_method() { + let eq = r#"module Data.Eq where + +class Eq a where + eq :: a -> a -> Boolean + +class Eq1 f where + eq1 :: forall a. Eq a => f a -> f a -> Boolean +"#; + let ordering = r#"module Data.Ordering where + +data Ordering = LT | EQ | GT +"#; + let ord = r#"module Data.Ord where + +import Data.Ordering + +class Ord a where + compare :: a -> a -> Ordering + +class Ord1 f where + compare1 :: forall a. Ord a => f a -> f a -> Ordering +"#; + let main = r#"module Main where + +import Data.Eq +import Data.Ord +import Data.Ordering + +data Maybe a = Nothing | Just a + +derive instance eqMaybe :: Eq a => Eq (Maybe a) +derive instance eq1Maybe :: Eq1 Maybe + +derive instance ordMaybe :: Ord a => Ord (Maybe a) +derive instance ord1Maybe :: Ord1 Maybe + +main :: Int +main = 0 +"#; + crate::check_program(&[ + ("Data.Eq.purs", eq), + ("Data.Ordering.purs", ordering), + ("Data.Ord.purs", ord), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("Eq1/Ord1 deriving should type check: {errors:?}")); +} + +#[test] +fn derives_generic_representation_for_a_data_type() { + let generic_rep = r#"module Data.Generic.Rep where + +data NoConstructors + +data NoArguments = NoArguments + +newtype Argument a = Argument a + +data Product a b = Product a b + +data Sum a b = Inl a | Inr b + +newtype Constructor (name :: Symbol) a = Constructor a + +class Generic t rep | t -> rep where + from :: t -> rep + to :: rep -> t +"#; + let main = r#"module Main where + +import Data.Generic.Rep + +data Maybe a = Nothing | Just a + +derive instance genericMaybe :: Generic (Maybe a) _ + +main :: Int +main = 0 +"#; + crate::check_program(&[("Data.Generic.Rep.purs", generic_rep), ("Main.purs", main)]) + .unwrap_or_else(|errors| panic!("Generic deriving should type check: {errors:?}")); +} + +#[test] +fn derives_newtype_class_for_a_newtype_with_a_wildcard() { + let newtype_module = r#"module Data.Newtype where + +class Newtype t a +"#; + let main = r#"module Main where + +import Data.Newtype (class Newtype) + +newtype Age = Age Int + +derive instance newtypeAge :: Newtype Age _ + +main :: Int +main = 0 +"#; + crate::check_program(&[("Data.Newtype.purs", newtype_module), ("Main.purs", main)]) + .unwrap_or_else(|errors| panic!("Newtype wildcard deriving should type check: {errors:?}")); +} + +#[test] +fn derives_profunctor_through_a_contravariant_field() { + let profunctor = r#"module Data.Profunctor where + +class Profunctor p where + dimap :: forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d +"#; + let contravariant = r#"module Data.Functor.Contravariant where + +class Contravariant f where + cmap :: forall a b. (b -> a) -> f a -> f b +"#; + let main = r#"module Main where + +import Data.Profunctor (class Profunctor) +import Data.Functor.Contravariant (class Contravariant) + +newtype Predicate a = Predicate (a -> Boolean) + +instance contravariantPredicate :: Contravariant Predicate where + cmap f (Predicate g) = Predicate (\x -> g (f x)) + +data P a b = P (Predicate a) b + +derive instance profunctorP :: Profunctor P + +main :: Int +main = 0 +"#; + crate::check_program(&[ + ("Data.Profunctor.purs", profunctor), + ("Data.Functor.Contravariant.purs", contravariant), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("Profunctor deriving should type check: {errors:?}")); +} + #[test] fn derives_newtype_for_a_partially_applied_type_constructor() { let source = r#"module Main where diff --git a/crates/psrs-driver/src/tests/deriving/traversals.rs b/crates/psrs-driver/src/tests/deriving/traversals.rs new file mode 100644 index 00000000..44361537 --- /dev/null +++ b/crates/psrs-driver/src/tests/deriving/traversals.rs @@ -0,0 +1,191 @@ +#[test] +fn derives_bitraversable_for_a_two_parameter_type() { + let function = r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#; + let functor = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let apply = r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#; + let applicative = r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#; + let bitraversable = r#"module Data.Bitraversable where + +import Control.Applicative (class Applicative) + +class Bitraversable t where + bitraverse :: forall f a b c d. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) + bisequence :: forall f a b. Applicative f => t (f a) (f b) -> f (t a b) +"#; + let main = r#"module Main where + +import Data.Function (identity) +import Data.Bitraversable + +data P a b = P a b + +derive instance bitraversableP :: Bitraversable P + +main :: Int +main = 0 +"#; + crate::check_program(&[ + ("Data.Function.purs", function), + ("Data.Functor.purs", functor), + ("Control.Apply.purs", apply), + ("Control.Applicative.purs", applicative), + ("Data.Bitraversable.purs", bitraversable), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("Bitraversable deriving should type check: {errors:?}")); +} + +#[test] +fn derives_traversable_for_single_field_constructors() { + let function = r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#; + let functor = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let apply = r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#; + let applicative = r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#; + let traversable = r#"module Data.Traversable where + +import Control.Applicative (class Applicative) + +class Traversable t where + traverse :: forall a b f. Applicative f => (a -> f b) -> t a -> f (t b) + sequence :: forall a f. Applicative f => t (f a) -> f (t a) +"#; + let main = r#"module Main where + +import Data.Function (identity) +import Data.Traversable + +data Box a = Box a + +derive instance traversableBox :: Traversable Box + +main :: Int +main = 0 +"#; + crate::check_program(&[ + ("Data.Function.purs", function), + ("Data.Functor.purs", functor), + ("Control.Apply.purs", apply), + ("Control.Applicative.purs", applicative), + ("Data.Traversable.purs", traversable), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("Traversable deriving should type check: {errors:?}")); +} + +#[test] +fn derives_foldable_for_single_field_constructors() { + let monoid = r#"module Data.Monoid where + +class Monoid a where + mempty :: a +"#; + let foldable = r#"module Data.Foldable where + +import Data.Monoid + +class Foldable t where + foldr :: forall a b. (a -> b -> b) -> b -> t a -> b + foldl :: forall a b. (b -> a -> b) -> b -> t a -> b + foldMap :: forall a m. Monoid m => (a -> m) -> t a -> m +"#; + let main = r#"module Main where + +import Data.Foldable + +data Box a = Box a + +derive instance foldableBox :: Foldable Box + +main :: Int +main = 0 +"#; + crate::check_program(&[ + ("Data.Monoid.purs", monoid), + ("Data.Foldable.purs", foldable), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("Foldable deriving should type check: {errors:?}")); +} + +#[test] +fn derives_bifoldable_for_a_two_parameter_type() { + let semigroup = r#"module Data.Semigroup where + +class Semigroup a where + append :: a -> a -> a +"#; + let monoid = r#"module Data.Monoid where + +import Data.Semigroup + +class Semigroup a <= Monoid a where + mempty :: a +"#; + let bifoldable = r#"module Data.Bifoldable where + +import Data.Monoid + +class Bifoldable p where + bifoldr :: forall a b c. (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c + bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c + bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m +"#; + let main = r#"module Main where + +import Data.Bifoldable + +data P a b = P a b + +derive instance bifoldableP :: Bifoldable P + +main :: Int +main = 0 +"#; + crate::check_program(&[ + ("Data.Semigroup.purs", semigroup), + ("Data.Monoid.purs", monoid), + ("Data.Bifoldable.purs", bifoldable), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("Bifoldable deriving should type check: {errors:?}")); +} diff --git a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs index 1c59130b..e409e8c6 100644 --- a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs +++ b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs @@ -227,7 +227,7 @@ fn audit_battery() { }, Case { name: "record_roundtrip_nested", - source: "module Main where\ncopy :: forall a. { inner :: { value :: a } } -> { inner :: { value :: a } }\ncopy record = record\nmain = arrayIndex (copy { inner: { value: [40, 42] } }.inner.value) 1\n", + source: "module Main where\ncopy :: forall a. { inner :: { value :: a } } -> { inner :: { value :: a } }\ncopy record = record\nmain = arrayIndex ((copy { inner: { value: [40, 42] } }).inner.value) 1\n", exit: 42, }, // GA-06 dependent ADT fields, multiple instantiations diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs new file mode 100644 index 00000000..4275b65c --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs @@ -0,0 +1,146 @@ +use super::*; + +#[test] +fn polymorphic_newtype_deriving_executes_its_adapter() { + let source = r#"module Main where + +class ToInt a where + toInt :: forall b. a -> b -> Int + +instance toIntInt :: ToInt Int where + toInt value _ = value + +newtype Age = Age Int + +derive newtype instance toIntAge :: ToInt Age + +main :: Int +main = if intEq (toInt (Age 42) true) 42 then toInt (Age 42) [1, 2] else 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn function_contravariant_deriving_executes_its_adapter() { + let profunctor = r#"module Data.Profunctor where + +class Profunctor p where + dimap :: forall a b c d. (b -> a) -> (c -> d) -> p a c -> p b d + lcmap :: forall a b c. (b -> a) -> p a c -> p b c + rmap :: forall a b c. (b -> c) -> p a b -> p a c + +instance profunctorFunction :: Profunctor (->) where + dimap f g h = \x -> g (h (f x)) + lcmap f h = \x -> h (f x) + rmap f h = \x -> f (h x) +"#; + let contravariant = r#"module Data.Functor.Contravariant where + +class Contravariant f where + cmap :: forall a b. (b -> a) -> f a -> f b +"#; + let main = r#"module Main where + +import Data.Functor.Contravariant +import Data.Profunctor (class Profunctor) + +data Predicate a = Predicate (a -> Boolean) + +derive instance contravariantPredicate :: Contravariant Predicate + +main :: Int +main = case cmap (\x -> intAdd x 1) (Predicate (\x -> intEq x 42)) of + Predicate f -> if f 41 then if f 40 then 0 else 42 else 1 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Profunctor.purs", profunctor), + ("Data.Functor.Contravariant.purs", contravariant), + ("Main.purs", main), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn profunctor_deriving_maps_record_function_input_and_result() { + let profunctor = r#"module Data.Profunctor where + +class Profunctor p where + dimap :: forall a b c d. (b -> a) -> (c -> d) -> p a c -> p b d + +instance profunctorFunction :: Profunctor (->) where + dimap f g h = \x -> g (h (f x)) +"#; + let contravariant = r#"module Data.Functor.Contravariant where + +class Contravariant f where + cmap :: forall a b. (b -> a) -> f a -> f b +"#; + let main = r#"module Main where + +import Data.Functor.Contravariant +import Data.Profunctor + +data Predicate a b = Predicate { run :: a -> b, inert :: Int } + +derive instance profunctorPredicate :: Profunctor Predicate + +main :: Int +main = case dimap (\x -> intAdd x 1) (\y -> intAdd y 2) (Predicate { run: \x -> x, inert: 7 }) of + Predicate r -> if intEq r.inert 7 then r.run 39 else 0 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Profunctor.purs", profunctor), + ("Data.Functor.Contravariant.purs", contravariant), + ("Main.purs", main), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn contravariant_deriving_maps_record_predicates_and_retains_inert_fields() { + let profunctor = r#"module Data.Profunctor where + +class Profunctor p where + dimap :: forall a b c d. (b -> a) -> (c -> d) -> p a c -> p b d + lcmap :: forall a b c. (b -> a) -> p a c -> p b c + rmap :: forall a b c. (b -> c) -> p a b -> p a c + +instance profunctorFunction :: Profunctor (->) where + dimap f g h = \x -> g (h (f x)) + lcmap f h = \x -> h (f x) + rmap f h = \x -> f (h x) +"#; + let contravariant = r#"module Data.Functor.Contravariant where + +class Contravariant f where + cmap :: forall a b. (b -> a) -> f a -> f b +"#; + let main = r#"module Main where + +import Data.Functor.Contravariant +import Data.Profunctor (class Profunctor) + +data Predicate a = Predicate { run :: a -> Boolean, inert :: Int } + +derive instance contravariantPredicate :: Contravariant Predicate + +main :: Int +main = case cmap (\x -> intAdd x 1) (Predicate { run: \x -> intEq x 42, inert: 7 }) of + Predicate r -> if intEq r.inert 7 then if r.run 41 then if r.run 40 then 0 else 42 else 1 else 2 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Profunctor.purs", profunctor), + ("Data.Functor.Contravariant.purs", contravariant), + ("Main.purs", main), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/folds.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/folds.rs new file mode 100644 index 00000000..6f1dce45 --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/folds.rs @@ -0,0 +1,61 @@ +use super::*; + +#[test] +fn derived_bifoldable_preserves_left_right_mapping_and_fold_order() { + let semigroup = r#"module Data.Semigroup where + +class Semigroup a where + append :: a -> a -> a +"#; + let monoid = r#"module Data.Monoid where + +import Data.Semigroup + +class Semigroup a <= Monoid a where + mempty :: a +"#; + let foldable = r#"module Data.Bifoldable where + +import Data.Monoid + +class Bifoldable t where + bifoldr :: forall a b c. (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c + bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> t a b -> c + bifoldMap :: forall a b m. Monoid m => (a -> m) -> (b -> m) -> t a b -> m +"#; + let main = r#"module Main where + +import Data.Bifoldable +import Data.Monoid +import Data.Semigroup + +instance semigroupInt :: Semigroup Int where + append left right = intAdd left right + +instance monoidInt :: Monoid Int where + mempty = 0 + +data Box a b = Empty | Box { left :: a, right :: b, inert :: Int } + +derive instance bifoldableBox :: Bifoldable Box + +main :: Int +main = if intEq (bifoldMap (\x -> x) (\y -> intAdd y 1) (Box { left: 20, right: 21, inert: 7 })) 42 + then if intEq (bifoldr (\x acc -> intAdd x (intMul 10 acc)) (\x acc -> intAdd x (intMul 10 acc)) 0 (Box { left: 1, right: 2, inert: 7 })) 21 + then if intEq (bifoldl (\acc x -> intAdd (intMul 10 acc) x) (\acc x -> intAdd (intMul 10 acc) x) 0 (Box { left: 1, right: 2, inert: 7 })) 12 + then if intEq (bifoldMap (\x -> x) (\y -> y) (Empty :: Box Int Int)) 0 then 42 else 1 + else 2 + else 3 + else 4 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Semigroup.purs", semigroup), + ("Data.Monoid.purs", monoid), + ("Data.Bifoldable.purs", foldable), + ("Main.purs", main), + ]) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42)); +} diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/generic.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/generic.rs new file mode 100644 index 00000000..d6700073 --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/generic.rs @@ -0,0 +1,64 @@ +use super::*; + +#[test] +fn generic_deriving_round_trips_constructor_tags_and_fields() { + let generic_rep = r#"module Data.Generic.Rep where + +data NoConstructors + +data NoArguments = NoArguments + +newtype Argument a = Argument a + +data Product a b = Product a b + +data Sum a b = Inl a | Inr b + +newtype Constructor (name :: Symbol) a = Constructor a + +class Generic t rep | t -> rep where + from :: t -> rep + to :: rep -> t +"#; + let main = r#"module Main where + +import Data.Generic.Rep + +data Choice a = Empty | Single a | Pair a Int + +derive instance genericChoice :: Generic (Choice a) _ + +main :: Int +main = case to (from (Pair 40 2)) of + Pair x y -> case to (from (Single 7)) of + Single z -> if intEq z 7 then case to (from (Empty :: Choice Int)) of + Empty -> intAdd x y + _ -> 0 + else 1 + _ -> 2 + _ -> 3 +"#; + let Some(output) = + run_program_with_wasmtime(&[("Data.Generic.Rep.purs", generic_rep), ("Main.purs", main)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn generic_round_trip_uses_the_trusted_representation_declarations() { + let source = r#"module Main where +import Data.Generic.Rep (class Generic, to, from) +data Choice a = Empty | Single a | Pair a Int +derive instance genericChoice :: Generic (Choice a) _ +main :: Int +main = case to (from (Pair 40 2)) of + Pair x y -> intAdd x y + _ -> 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/higher_kinded.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/higher_kinded.rs new file mode 100644 index 00000000..97ec7125 --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/higher_kinded.rs @@ -0,0 +1,58 @@ +use super::*; + +#[test] +fn eq_and_ord_expand_applied_variable_aliases_and_use_higher_kinded_dictionaries() { + let eq = r#"module Data.Eq where +class Eq a where + eq :: a -> a -> Boolean +class Eq1 f where + eq1 :: forall a. Eq a => f a -> f a -> Boolean +instance eqInt :: Eq Int where + eq x y = intEq x y +"#; + let ordering = "module Data.Ordering where\ndata Ordering = LT | EQ | GT\n"; + let ord = r#"module Data.Ord where +import Data.Ordering +class Ord a where + compare :: a -> a -> Ordering +class Ord1 f where + compare1 :: forall a. Ord a => f a -> f a -> Ordering +instance ordInt :: Ord Int where + compare x y = if intEq x y then EQ else if intLt x y then LT else GT +"#; + let main = r#"module Main where +import Data.Eq +import Data.Ord +import Data.Ordering + +data Maybe a = Nothing | Just a +derive instance eqMaybe :: Eq a => Eq (Maybe a) +derive instance eq1Maybe :: Eq1 Maybe +derive instance ordMaybe :: Ord a => Ord (Maybe a) +derive instance ord1Maybe :: Ord1 Maybe + +type Applied f a = f a +data Box f a = Box (Applied f a) +derive instance eqBox :: (Eq1 f, Eq a) => Eq (Box f a) +derive instance ordBox :: (Ord1 f, Ord a) => Ord (Box f a) + +main :: Int +main = if eq (Box (Just 4)) (Box (Just 4)) then + if eq (Box (Just 4)) (Box (Just 5)) then 1 else + case compare (Box (Just 4)) (Box (Just 5)) of + LT -> 42 + _ -> 2 + else 3 +"#; + let sources = [ + ("Data.Eq.purs", eq), + ("Data.Ordering.purs", ordering), + ("Data.Ord.purs", ord), + ("Main.purs", main), + ]; + crate::check_program(&sources).expect("applied-variable aliases should type check"); + let Some(output) = run_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/mod.rs similarity index 79% rename from crates/psrs-driver/src/tests/wasi/classes/deriving.rs rename to crates/psrs-driver/src/tests/wasi/classes/deriving/mod.rs index d2ae860f..0cee778f 100644 --- a/crates/psrs-driver/src/tests/wasi/classes/deriving.rs +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/mod.rs @@ -2,6 +2,8 @@ use super::super::super::*; +mod traversals; + #[test] fn imported_newtype_derived_dictionary_executes_its_coercion_adapter() { let library = r#"module Lib (Age(..), class ToInt, toInt) where @@ -198,6 +200,60 @@ main = case map (\value -> intAdd value 1) (Box (Some 41)) of assert_eq!(output.status.code(), Some(42)); } +#[test] +fn derived_foldable_executes_through_its_instances() { + let semigroup = r#"module Data.Semigroup where + +class Semigroup a where + append :: a -> a -> a +"#; + let monoid = r#"module Data.Monoid where + +import Data.Semigroup + +class Semigroup a <= Monoid a where + mempty :: a +"#; + let foldable = r#"module Data.Foldable where + +import Data.Monoid + +class Foldable t where + foldr :: forall a b. (a -> b -> b) -> b -> t a -> b + foldl :: forall a b. (b -> a -> b) -> b -> t a -> b + foldMap :: forall a m. Monoid m => (a -> m) -> t a -> m +"#; + let main = r#"module Main where + +import Data.Foldable +import Data.Monoid +import Data.Semigroup + +instance semigroupInt :: Semigroup Int where + append left right = intAdd left right + +instance monoidInt :: Monoid Int where + mempty = 0 + +data Box a = Box a + +derive instance foldableBox :: Foldable Box + +main :: Int +main = intAdd (foldMap (\x -> x) (Box 40)) (foldr (\x acc -> intAdd x acc) 0 (Box 2)) +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Semigroup.purs", semigroup), + ("Data.Monoid.purs", monoid), + ("Data.Foldable.purs", foldable), + ("Main.purs", main), + ]) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + #[test] fn derives_bifunctor_mapping_for_both_type_parameters() { let bifunctor = r#"module Data.Bifunctor where @@ -226,3 +282,11 @@ main = case bimap (\value -> intAdd value 1) (\value -> intAdd value 1) (Pair 40 }; assert_eq!(output.status.code(), Some(42)); } + +mod adapters; +mod generic; + +mod higher_kinded; +mod records; + +mod folds; diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/records.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/records.rs new file mode 100644 index 00000000..b4ea283d --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/records.rs @@ -0,0 +1,216 @@ +use super::*; + +#[test] +fn derived_functor_maps_record_fields_and_retains_inert_fields() { + let library = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b + +data Option a = None | Some a + +instance functorOption :: Functor Option where + map f value = case value of + None -> None + Some item -> Some (f item) +"#; + let main = r#"module Main where + +import Data.Functor + +type Wrapped a = Option a + +data Box a = Box { nested :: Wrapped a, scalar :: a, flag :: Boolean } + +derive instance functorBox :: Functor Box + +main :: Int +main = case map (\value -> intAdd value 1) (Box { nested: Some 20, scalar: 20, flag: true }) of + Box r -> case r.nested of + Some x -> if r.flag then intAdd x r.scalar else 0 + _ -> 0 +"#; + let Some(output) = + run_program_with_wasmtime(&[("Data.Functor.purs", library), ("Main.purs", main)]) + else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn derived_foldable_preserves_record_label_order_in_both_fold_directions() { + let semigroup = r#"module Data.Semigroup where + +class Semigroup a where + append :: a -> a -> a +"#; + let monoid = r#"module Data.Monoid where + +import Data.Semigroup + +class Semigroup a <= Monoid a where + mempty :: a +"#; + let foldable = r#"module Data.Foldable where + +import Data.Monoid + +class Foldable t where + foldr :: forall a b. (a -> b -> b) -> b -> t a -> b + foldl :: forall a b. (b -> a -> b) -> b -> t a -> b + foldMap :: forall a m. Monoid m => (a -> m) -> t a -> m +"#; + let main = r#"module Main where + +import Data.Foldable +import Data.Monoid +import Data.Semigroup + +instance semigroupInt :: Semigroup Int where + append left right = intAdd left right + +instance monoidInt :: Monoid Int where + mempty = 0 + +data Box a = Box { first :: a, last :: a, flag :: Boolean } + +derive instance foldableBox :: Foldable Box + +value = Box { first: 1, last: 2, flag: true } +main :: Int +main = if intEq (foldMap (\x -> x) value) 3 then + if intEq (foldr (\x acc -> intAdd x (intMul 10 acc)) 0 value) 21 then + if intEq (foldl (\acc x -> intAdd (intMul 10 acc) x) 0 value) 12 then 42 else 1 + else 2 + else 3 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Semigroup.purs", semigroup), + ("Data.Monoid.purs", monoid), + ("Data.Foldable.purs", foldable), + ("Main.purs", main), + ]) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn derived_traversable_maps_record_effects_and_preserves_inert_fields() { + let function = r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#; + let functor = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let apply = r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#; + let applicative = r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#; + let traversable = r#"module Data.Traversable where + +import Control.Applicative (class Applicative) + +class Traversable t where + traverse :: forall a b f. Applicative f => (a -> f b) -> t a -> f (t b) + sequence :: forall a f. Applicative f => t (f a) -> f (t a) +"#; + let main = r#"module Main where + +import Data.Function (identity) +import Data.Traversable +import Data.Functor +import Control.Apply +import Control.Applicative + +data Maybe a = Nothing | Just a +instance functorMaybe :: Functor Maybe where + map f value = case value of + Nothing -> Nothing + Just x -> Just (f x) +instance applyMaybe :: Apply Maybe where + apply f value = case f of + Nothing -> Nothing + Just g -> map g value +instance applicativeMaybe :: Applicative Maybe where + pure = Just + +data Box a = Empty Int | Box { first :: a, last :: a, inert :: Int } + +derive instance traversableBox :: Traversable Box + +main :: Int +main = case traverse (\x -> Just (intAdd x 1)) (Box { first: 20, last: 20, inert: 7 }) of + Just (Box r) -> if intEq r.inert 7 then case sequence (Empty 9 :: Box (Maybe Int)) of + Just (Empty n) -> if intEq n 9 then intAdd r.first r.last else 1 + _ -> 2 + else 3 + _ -> 0 +"#; + let sources = [ + ("Data.Function.purs", function), + ("Data.Functor.purs", functor), + ("Control.Apply.purs", apply), + ("Control.Applicative.purs", applicative), + ("Data.Traversable.purs", traversable), + ("Main.purs", main), + ]; + let Some(output) = run_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn bifunctor_deriving_maps_both_record_parameters_and_retains_inert_fields() { + let bifunctor = r#"module Data.Bifunctor where +class Bifunctor f where + bimap :: forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d +"#; + let main = r#"module Main where +import Data.Bifunctor +data Box a b = Box { left :: a, right :: b, inert :: Int } +derive instance bifunctorBox :: Bifunctor Box +main :: Int +main = case bimap (\x -> intAdd x 1) (\y -> intAdd y 2) (Box { left: 19, right: 20, inert: 7 }) of + Box r -> if intEq r.inert 7 then intAdd r.left r.right else 0 +"#; + let Some(output) = + run_program_with_wasmtime(&[("Data.Bifunctor.purs", bifunctor), ("Main.purs", main)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/traversals.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/traversals.rs new file mode 100644 index 00000000..bc79ac7e --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/traversals.rs @@ -0,0 +1,286 @@ +use super::*; + +#[test] +fn derived_traversable_executes_through_its_instances() { + let function = r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#; + let functor = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let apply = r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#; + let applicative = r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#; + let traversable = r#"module Data.Traversable where + +import Control.Applicative (class Applicative) + +class Traversable t where + traverse :: forall a b f. Applicative f => (a -> f b) -> t a -> f (t b) + sequence :: forall a f. Applicative f => t (f a) -> f (t a) +"#; + let main = r#"module Main where + +import Data.Function (identity) +import Data.Traversable +import Data.Functor +import Control.Apply +import Control.Applicative + +data Maybe a = Nothing | Just a +instance functorMaybe :: Functor Maybe where + map f value = case value of + Nothing -> Nothing + Just x -> Just (f x) +instance applyMaybe :: Apply Maybe where + apply f value = case f of + Nothing -> Nothing + Just g -> map g value +instance applicativeMaybe :: Applicative Maybe where + pure = Just + +data Box a = Box a + +derive instance traversableBox :: Traversable Box + +main :: Int +main = case traverse (\x -> Just (intAdd x 1)) (Box 41) of + Just (Box x) -> x + _ -> 0 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Function.purs", function), + ("Data.Functor.purs", functor), + ("Control.Apply.purs", apply), + ("Control.Applicative.purs", applicative), + ("Data.Traversable.purs", traversable), + ("Main.purs", main), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn derived_bitraversable_preserves_both_effects_and_sequence() { + let function = r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#; + let functor = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let apply = r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#; + let applicative = r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#; + let traversable = r#"module Data.Bitraversable where + +import Control.Applicative (class Applicative) + +class Bitraversable t where + bitraverse :: forall a b c d f. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) + bisequence :: forall a b f. Applicative f => t (f a) (f b) -> f (t a b) +"#; + let main = r#"module Main where + +import Data.Function (identity) +import Data.Bitraversable +import Data.Functor +import Control.Apply +import Control.Applicative + +data Maybe a = Nothing | Just a +instance functorMaybe :: Functor Maybe where + map f value = case value of + Nothing -> Nothing + Just x -> Just (f x) +instance applyMaybe :: Apply Maybe where + apply f value = case f of + Nothing -> Nothing + Just g -> map g value +instance applicativeMaybe :: Applicative Maybe where + pure = Just + +data Box a b = Box a b + +derive instance bitraversableBox :: Bitraversable Box + +main :: Int +main = case bitraverse (\x -> Just (intAdd x 1)) (\y -> Just (intAdd y 2)) (Box 19 20) of + Just (Box x y) -> if intEq x 20 then if intEq y 22 then case bisequence (Box (Just 20) (Just 22)) of + Just (Box a b) -> intAdd a b + _ -> 1 + else 2 + else 3 + _ -> 0 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Function.purs", function), + ("Data.Functor.purs", functor), + ("Control.Apply.purs", apply), + ("Control.Applicative.purs", applicative), + ("Data.Bitraversable.purs", traversable), + ("Main.purs", main), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn derived_traversable_uses_its_higher_kinded_context_dictionary() { + let function = r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#; + let functor = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let apply = r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#; + let applicative = r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#; + let traversable = r#"module Data.Traversable where + +import Control.Applicative (class Applicative) + +class Traversable t where + traverse :: forall a b f. Applicative f => (a -> f b) -> t a -> f (t b) + sequence :: forall a f. Applicative f => t (f a) -> f (t a) +"#; + let main = r#"module Main where + +import Data.Function (identity) +import Data.Traversable +import Data.Functor +import Control.Apply +import Control.Applicative + +data Maybe a = Nothing | Just a +instance functorMaybe :: Functor Maybe where + map f value = case value of + Nothing -> Nothing + Just x -> Just (f x) +instance applyMaybe :: Apply Maybe where + apply f value = case f of + Nothing -> Nothing + Just g -> map g value +instance applicativeMaybe :: Applicative Maybe where + pure = Just + +data Box f a = Box (f a) + +derive instance traversableMaybe :: Traversable Maybe + +derive instance traversableBox :: Traversable f => Traversable (Box f) + +main :: Int +main = case traverse (\x -> Just (intAdd x 1)) (Box (Just 41)) of + Just (Box (Just x)) -> x + _ -> 0 +"#; + let Some(output) = run_program_with_wasmtime(&[ + ("Data.Function.purs", function), + ("Data.Functor.purs", functor), + ("Control.Apply.purs", apply), + ("Control.Applicative.purs", applicative), + ("Data.Traversable.purs", traversable), + ("Main.purs", main), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42)); +} + +#[test] +fn derived_traversable_sequences_through_the_trusted_core_libraries() { + let source = r#"module Main where +import Prelude +import Data.Maybe (Maybe(..)) +import Data.Traversable (class Traversable, traverse, sequence) +import Data.Foldable (class Foldable) +data Box a = Box a +derive instance functorBox :: Functor Box +derive instance foldableBox :: Foldable Box +derive instance traversableBox :: Traversable Box +main :: Int +main = case traverse (\x -> Just (intAdd x 1)) (Box 41) of + Just (Box x) -> if intEq x 42 then case sequence (Box (Just 42)) of + Just (Box y) -> y + _ -> 1 + else 2 + _ -> 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn derived_bitraversable_sequences_through_the_trusted_core_libraries() { + let source = r#"module Main where +import Prelude +import Data.Maybe (Maybe(..)) +import Data.Bifunctor (class Bifunctor) +import Data.Bifoldable (class Bifoldable) +import Data.Bitraversable (class Bitraversable, bitraverse, bisequence) +data Box a b = Box { left :: a, right :: b, inert :: Int } +derive instance bifunctorBox :: Bifunctor Box +derive instance bifoldableBox :: Bifoldable Box +derive instance bitraversableBox :: Bitraversable Box +main :: Int +main = case bitraverse (\x -> Just (intAdd x 1)) (\y -> Just (intAdd y 2)) (Box { left: 19, right: 20, inert: 7 }) of + Just (Box r) -> if intEq r.inert 7 then case bisequence (Box { left: Just r.left, right: Just r.right, inert: 7 }) of + Just (Box s) -> intAdd s.left s.right + _ -> 1 + else 2 + _ -> 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/wasi/classes/mod.rs b/crates/psrs-driver/src/tests/wasi/classes/mod.rs index 1a98e3e9..927301f8 100644 --- a/crates/psrs-driver/src/tests/wasi/classes/mod.rs +++ b/crates/psrs-driver/src/tests/wasi/classes/mod.rs @@ -448,14 +448,12 @@ fn a_class_method_body_is_rejected_as_invalid_purescript() { } #[test] -fn a_deriving_declaration_is_reported_as_unsupported() { +fn a_deriving_declaration_for_a_class_with_no_rule_is_rejected() { let errors = compile_source("Main.purs", DERIVE_SOURCE).expect_err("deriving must be rejected"); assert!( - errors.iter().any(|error| { - error - .message - .contains("known-class deriving rule is unavailable") - }), + errors + .iter() + .any(|error| error.code == Some("CannotDerive")), "unexpected diagnostics: {errors:?}" ); } diff --git a/crates/psrs-driver/tests/upstream/deriving/diagnostics.rs b/crates/psrs-driver/tests/upstream/deriving/diagnostics.rs new file mode 100644 index 00000000..27633d35 --- /dev/null +++ b/crates/psrs-driver/tests/upstream/deriving/diagnostics.rs @@ -0,0 +1,102 @@ +use super::*; + +#[test] +fn differential_deriving_error_codes_against_purs() { + if !purs_available() { + eprintln!("skipping: purs is not installed"); + return; + } + let functor_module = r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b +"#; + let functor_contravariant = r#"module Main where + +import Data.Functor (class Functor) + +data Contra a = Contra (a -> Int) + +derive instance functorContra :: Functor Contra + +main :: Int +main = 0 +"#; + let unknown_class = r#"module Main where + +class Marker a + +data Box = Box + +derive instance markerBox :: Marker Box + +main :: Int +main = 0 +"#; + let newtype_on_data = r#"module Main where + +class ToInt a where + toInt :: a -> Int + +data Box = Box Int + +derive newtype instance toIntBox :: ToInt Box + +main :: Int +main = 0 +"#; + let eq_builtin = "module Data.Eq where\nclass Eq a where\n eq :: a -> a -> Boolean\nderive instance eqInt :: Eq Int\n"; + let eq_binary = "module Data.Eq where\nclass Eq a b where\n eq :: a -> b -> Boolean\n"; + let invalid_arity = "module Main where\nimport Data.Eq\ndata Box = Box\nderive instance eqBox :: Eq Box Box\nmain = 0\n"; + let class_arity = "module Main where\nimport Data.Functor\ndata Box a = Box a\nderive instance functorBox :: Functor Box Int\nmain = 0\n"; + let cases: [(&str, &[(&str, &str)]); 6] = [ + ( + "functor-contravariant-field", + &[ + ("Data.Functor.purs", functor_module), + ("Main.purs", functor_contravariant), + ], + ), + ("builtin-head", &[("Data.Eq.purs", eq_builtin)]), + ( + "invalid-class-arity", + &[("Data.Eq.purs", eq_binary), ("Main.purs", invalid_arity)], + ), + ( + "class-instance-arity", + &[ + ("Data.Functor.purs", functor_module), + ("Main.purs", class_arity), + ], + ), + ("unknown-class", &[("Main.purs", unknown_class)]), + ("newtype-on-data", &[("Main.purs", newtype_on_data)]), + ]; + let mut failures = Vec::new(); + for (name, sources) in cases { + let purs_output = purs_sources_output(name, sources); + let purs_codes = purs_error_codes(&purs_output); + let psrs_codes: Vec = match psrs_driver::check_program(sources) { + Ok(()) => Vec::new(), + Err(errors) => errors + .into_iter() + .filter_map(|error| error.diagnostic.code.map(str::to_owned)) + .collect(), + }; + if psrs_codes.is_empty() { + failures.push(format!("`{name}`: psrs reported no errorCode")); + } + for code in &psrs_codes { + if !purs_codes.contains(code) { + failures.push(format!( + "`{name}`: psrs code `{code}` not among purs codes {purs_codes:?}" + )); + } + } + } + assert!( + failures.is_empty(), + "deriving error-code differential failures:\n{}", + failures.join("\n") + ); +} diff --git a/crates/psrs-driver/tests/upstream/deriving/mod.rs b/crates/psrs-driver/tests/upstream/deriving/mod.rs new file mode 100644 index 00000000..daa84dcf --- /dev/null +++ b/crates/psrs-driver/tests/upstream/deriving/mod.rs @@ -0,0 +1,5 @@ +use super::*; + +mod diagnostics; +mod rules; +mod traversals; diff --git a/crates/psrs-driver/tests/upstream/deriving.rs b/crates/psrs-driver/tests/upstream/deriving/rules.rs similarity index 100% rename from crates/psrs-driver/tests/upstream/deriving.rs rename to crates/psrs-driver/tests/upstream/deriving/rules.rs diff --git a/crates/psrs-driver/tests/upstream/deriving/traversals.rs b/crates/psrs-driver/tests/upstream/deriving/traversals.rs new file mode 100644 index 00000000..460da7bf --- /dev/null +++ b/crates/psrs-driver/tests/upstream/deriving/traversals.rs @@ -0,0 +1,291 @@ +use super::*; + +#[test] +fn differential_remaining_deriving_rules_against_purs() { + if !purs_available() { + return; + } + let libraries = [ + ( + "Control.Category.purs", + "module Control.Category where\nidentity :: forall a. a -> a\nidentity x = x\n", + ), + ( + "Data.Function.purs", + r#"module Data.Function where + +identity :: forall a. a -> a +identity x = x +"#, + ), + ( + "Data.Semigroup.purs", + r#"module Data.Semigroup where + +class Semigroup a where + append :: a -> a -> a +"#, + ), + ( + "Data.Monoid.purs", + r#"module Data.Monoid where + +import Data.Semigroup + +class Semigroup a <= Monoid a where + mempty :: a +"#, + ), + ( + "Data.Functor.purs", + r#"module Data.Functor where + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b + +instance functorFunction :: Functor ((->) r) where + map f g x = f (g x) +"#, + ), + ( + "Control.Apply.purs", + r#"module Control.Apply where + +import Data.Functor + +class Functor f <= Apply f where + apply :: forall a b. f (a -> b) -> f a -> f b +"#, + ), + ( + "Control.Applicative.purs", + r#"module Control.Applicative where + +import Control.Apply + +class Apply f <= Applicative f where + pure :: forall a. a -> f a +"#, + ), + ( + "Data.Foldable.purs", + r#"module Data.Foldable where + +import Data.Monoid + +class Foldable t where + foldr :: forall a b. (a -> b -> b) -> b -> t a -> b + foldl :: forall a b. (b -> a -> b) -> b -> t a -> b + foldMap :: forall a m. Monoid m => (a -> m) -> t a -> m +"#, + ), + ( + "Data.Bifoldable.purs", + r#"module Data.Bifoldable where + +import Data.Monoid + +class Bifoldable p where + bifoldr :: forall a b c. (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c + bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c + bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m +"#, + ), + ( + "Data.Traversable.purs", + r#"module Data.Traversable where + +import Control.Applicative +import Data.Functor +import Data.Function + +class Traversable t where + traverse :: forall a b f. Applicative f => (a -> f b) -> t a -> f (t b) + sequence :: forall a f. Applicative f => t (f a) -> f (t a) +"#, + ), + ( + "Data.Bitraversable.purs", + r#"module Data.Bitraversable where + +import Control.Applicative +import Data.Functor +import Data.Function + +class Bitraversable t where + bitraverse :: forall f a b c d. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) + bisequence :: forall f a b. Applicative f => t (f a) (f b) -> f (t a b) +"#, + ), + ( + "Data.Profunctor.purs", + r#"module Data.Profunctor where + +class Profunctor p where + dimap :: forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d +"#, + ), + ( + "Data.Functor.Contravariant.purs", + r#"module Data.Functor.Contravariant where + +class Contravariant f where + cmap :: forall a b. (b -> a) -> f a -> f b +"#, + ), + ( + "Data.Bifunctor.purs", + r#"module Data.Bifunctor where + +class Bifunctor f where + bimap :: forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d +"#, + ), + ]; + let cases = [ + ( + "Functor", + "Data.Functor", + "a", + "{ field :: a, inert :: Int }", + true, + ), + ( + "Bifunctor", + "Data.Bifunctor", + "a b", + "{ left :: a, right :: b, inert :: Int }", + true, + ), + ( + "Contravariant", + "Data.Functor.Contravariant", + "a", + "a", + false, + ), + ("Profunctor", "Data.Profunctor", "a b", "b", true), + ("Profunctor", "Data.Profunctor", "a b", "a", false), + ( + "Foldable", + "Data.Foldable", + "a", + "{ field :: a, inert :: Int }", + true, + ), + ("Foldable", "Data.Foldable", "a", "(a -> Int)", false), + ( + "Bifoldable", + "Data.Bifoldable", + "a b", + "{ left :: a, right :: b }", + true, + ), + ("Bifoldable", "Data.Bifoldable", "a b", "(a -> Int)", false), + ( + "Traversable", + "Data.Traversable", + "a", + "{ field :: a, inert :: Int }", + true, + ), + ("Traversable", "Data.Traversable", "a", "(a -> Int)", false), + ( + "Bitraversable", + "Data.Bitraversable", + "a b", + "{ left :: a, right :: b }", + true, + ), + ( + "Bitraversable", + "Data.Bitraversable", + "a b", + "(a -> Int)", + false, + ), + ]; + let mut failures = Vec::new(); + for (index, (class, module, parameters, field, accepted)) in cases.into_iter().enumerate() { + let main = format!( + "module Main where\nimport Data.Function as Function\nimport Control.Category (identity)\nimport Data.Functor\nimport Control.Apply\nimport Control.Applicative\nimport {module}\ndata Box {parameters} = Box {field}\nderive instance derivedBox :: {class} Box\nmain = 0\n" + ); + let mut sources = libraries.to_vec(); + sources.push(("Main.purs", &main)); + let name = format!("deriving-{class}-{index}"); + let purs_output = purs_sources_output(&name, &sources); + let purs_accepted = purs_output.status.success(); + let psrs = psrs_driver::check_program(&sources); + if purs_accepted != accepted || psrs.is_ok() != accepted { + failures.push(format!( + "{name}: expected={accepted}, purs={purs_accepted}, psrs={psrs:?}, purs stderr={}, stdout={}", + String::from_utf8_lossy(&purs_output.stderr), + String::from_utf8_lossy(&purs_output.stdout) + )); + } + if !accepted { + let codes = purs_error_codes(&purs_output); + if !codes + .iter() + .any(|code| code == "CannotDeriveInvalidConstructorArg") + || !psrs.as_ref().err().is_some_and(|errors| { + errors.iter().any(|error| { + error.diagnostic.code == Some("CannotDeriveInvalidConstructorArg") + }) + }) + { + failures.push(format!( + "{name}: expected field-usage errorCode, purs={codes:?}, psrs={psrs:?}" + )); + } + } + } + for (class, module) in [ + ("Functor", "Data.Functor"), + ("Foldable", "Data.Foldable"), + ("Traversable", "Data.Traversable"), + ] { + let main = format!( + "module Main where\nimport Data.Function as Function\nimport Control.Category (identity)\nimport Data.Functor\nimport Control.Apply\nimport Control.Applicative\nimport {module}\ndata Box f a = Box (f a)\nderive instance boxInstance :: {class} f => {class} (Box f)\nmain = 0\n" + ); + let mut sources = libraries.to_vec(); + sources.push(("Main.purs", &main)); + let output = purs_sources_output(&format!("deriving-context-{class}"), &sources); + let psrs = psrs_driver::check_program(&sources); + if !output.status.success() || psrs.is_err() { + failures.push(format!("{class} context: purs={output:?}, psrs={psrs:?}")); + } + } + let scoped = "module Main where\nimport Data.Bifunctor\nimport Data.Functor\ndata Box a b = Box (forall a. a -> b)\nderive instance bifunctorBox :: Bifunctor Box\nmain = 0\n"; + let mut sources = libraries.to_vec(); + sources.push(("Main.purs", scoped)); + let output = purs_sources_output("deriving-scoped-parameter", &sources); + let psrs = psrs_driver::check_program(&sources); + if !output.status.success() || psrs.is_err() { + failures.push(format!("scoped parameter: purs={output:?}, psrs={psrs:?}")); + } + assert!(failures.is_empty(), "{}", failures.join("\n")); +} + +#[test] +fn differential_record_postfix_precedence_against_purs() { + if !purs_available() { + return; + } + let source = r#"module Main where +consume :: Int -> Int +consume x = x +project :: { field :: Int } -> Int +project r = consume r.field +consumeRecord :: { field :: Int } -> { field :: Int } +consumeRecord r = r +update :: { field :: Int } -> { field :: Int } +update r = consumeRecord r { field = 42 } +main :: Int +main = project (update { field: 0 }) +"#; + let sources = [("Main.purs", source)]; + let output = purs_sources_output("record-postfix-precedence", &sources); + assert!(output.status.success(), "{output:?}"); + psrs_driver::check_program(&sources).expect("record postfix operands agree with purs"); +} diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 517c0319..8bb8771f 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -45,6 +45,12 @@ fn purs_accepts(source: &Path) -> bool { } fn purs_accepts_sources(name: &str, sources: &[SourceFile]) -> bool { + purs_sources_output(name, sources).status.success() +} + +/// Runs `purs` on the sources and returns its captured output. Used to compare +/// diagnostic codes, not only acceptance. +fn purs_sources_output(name: &str, sources: &[(&str, &str)]) -> std::process::Output { let case_dir = std::env::temp_dir().join(format!("psrs-purs-upstream-{}-{name}", std::process::id())); let _ = std::fs::remove_dir_all(&case_dir); @@ -65,17 +71,31 @@ fn purs_accepts_sources(name: &str, sources: &[SourceFile]) -> bool { }) .collect::>(); let output_dir = case_dir.join("output"); - let accepted = Command::new("purs") + let output = Command::new("purs") .arg("compile") .args(&paths) .arg("-o") .arg(output_dir) .output() - .expect("failed to run purs") - .status - .success(); + .expect("failed to run purs"); let _ = std::fs::remove_dir_all(case_dir); - accepted + output +} + +/// The `errorCode`s in a `purs` output, read from the `.../errors/.md` +/// links each diagnostic prints. +fn purs_error_codes(output: &std::process::Output) -> Vec { + let text = String::from_utf8_lossy(&output.stdout).into_owned() + + &String::from_utf8_lossy(&output.stderr); + text.lines() + .filter_map(|line| { + let marker = "/errors/"; + let start = line.find(marker)? + marker.len(); + let rest = &line[start..]; + let end = rest.find(".md")?; + Some(rest[..end].to_owned()) + }) + .collect() } #[test] diff --git a/crates/psrs-syntax/src/parser/expr/atom/mod.rs b/crates/psrs-syntax/src/parser/expr/atom/mod.rs index c3314ad0..9fbfc8fb 100644 --- a/crates/psrs-syntax/src/parser/expr/atom/mod.rs +++ b/crates/psrs-syntax/src/parser/expr/atom/mod.rs @@ -1,61 +1,17 @@ +mod postfix; mod records; mod sections; use crate::{LayoutTokenKind, RawTokenKind}; -use psrs_cst::{CstName, Expr, ExprKind, RecordAccessorField, RecordField, RecordUpdateField}; +use psrs_cst::{CstName, Expr, ExprKind, RecordField, RecordUpdateField}; use psrs_span::TextRange; use super::super::{ParseError, Parser}; impl<'a> Parser<'a> { pub(super) fn parse_application(&mut self) -> Result { - let mut function = self.parse_atom()?; + let mut function = self.parse_postfix_atom()?; loop { - if self.at_raw(&RawTokenKind::Dot) && self.starts_label_at(1) { - let dot_span = self.bump().span; - let field = self.parse_label("record field")?; - let field_end = field.span.end; - function = match function.kind { - ExprKind::Name(name) if name.text == "_" => { - let marker_span = name.span; - Expr { - kind: ExprKind::RecordAccessor { - marker_span, - fields: vec![RecordAccessorField { dot_span, field }], - }, - span: TextRange::new(marker_span.start, field_end), - } - } - ExprKind::RecordAccessor { - marker_span, - mut fields, - } => { - fields.push(RecordAccessorField { dot_span, field }); - Expr { - kind: ExprKind::RecordAccessor { - marker_span, - fields, - }, - span: TextRange::new(marker_span.start, field_end), - } - } - kind => { - let span = TextRange::new(function.span.start, field.span.end); - Expr { - kind: ExprKind::FieldAccess { - expression: Box::new(Expr { - kind, - span: function.span, - }), - dot_span, - field, - }, - span, - } - } - }; - continue; - } if let LayoutTokenKind::Raw(RawTokenKind::Operator(operator)) = &self.current().kind && operator == "@" && self.starts_type_atom_at(1) @@ -73,22 +29,10 @@ impl<'a> Parser<'a> { }; continue; } - if self.current().kind == LayoutTokenKind::Raw(RawTokenKind::LBrace) { - let checkpoint = self.cursor; - match self.parse_record_update(function.clone()) { - Ok(updated) => { - function = updated; - continue; - } - Err(_) => { - self.cursor = checkpoint; - } - } - } if !self.starts_atom() { break; } - let argument = self.parse_atom()?; + let argument = self.parse_postfix_atom()?; let span = TextRange::new(function.span.start, argument.span.end); function = Expr { kind: ExprKind::Application(Box::new(function), Box::new(argument)), diff --git a/crates/psrs-syntax/src/parser/expr/atom/postfix.rs b/crates/psrs-syntax/src/parser/expr/atom/postfix.rs new file mode 100644 index 00000000..a9b9c15f --- /dev/null +++ b/crates/psrs-syntax/src/parser/expr/atom/postfix.rs @@ -0,0 +1,70 @@ +//! Record projection and update bind to one atom before value application. +use super::*; +use psrs_cst::RecordAccessorField; + +impl Parser<'_> { + pub(super) fn parse_postfix_atom(&mut self) -> Result { + let mut function = self.parse_atom()?; + loop { + if self.at_raw(&RawTokenKind::Dot) && self.starts_label_at(1) { + let dot_span = self.bump().span; + let field = self.parse_label("record field")?; + let field_end = field.span.end; + function = match function.kind { + ExprKind::Name(name) if name.text == "_" => { + let marker_span = name.span; + Expr { + kind: ExprKind::RecordAccessor { + marker_span, + fields: vec![RecordAccessorField { dot_span, field }], + }, + span: TextRange::new(marker_span.start, field_end), + } + } + ExprKind::RecordAccessor { + marker_span, + mut fields, + } => { + fields.push(RecordAccessorField { dot_span, field }); + Expr { + kind: ExprKind::RecordAccessor { + marker_span, + fields, + }, + span: TextRange::new(marker_span.start, field_end), + } + } + kind => { + let span = TextRange::new(function.span.start, field.span.end); + Expr { + kind: ExprKind::FieldAccess { + expression: Box::new(Expr { + kind, + span: function.span, + }), + dot_span, + field, + }, + span, + } + } + }; + continue; + } + if self.current().kind == LayoutTokenKind::Raw(RawTokenKind::LBrace) { + let checkpoint = self.cursor; + match self.parse_record_update(function.clone()) { + Ok(updated) => { + function = updated; + continue; + } + Err(_) => { + self.cursor = checkpoint; + } + } + } + break; + } + Ok(function) + } +} diff --git a/crates/psrs-syntax/src/parser/tests.rs b/crates/psrs-syntax/src/parser/tests.rs index 9d9e5c67..2aa2603f 100644 --- a/crates/psrs-syntax/src/parser/tests.rs +++ b/crates/psrs-syntax/src/parser/tests.rs @@ -415,3 +415,27 @@ fn keeps_a_deeper_indented_minus_in_a_case_rhs_as_an_operator() { }; assert!(matches!(&value.kind, ExprKind::Operator { operator, .. } if operator.text == "-")); } + +#[test] +fn record_projection_and_update_bind_before_value_application() { + let module = parse( + "module Main where\nproject r = consume r.value\nupdate r = consume r { value = 42 }\n", + ) + .unwrap(); + for (index, projection) in [(0, true), (1, false)] { + let expression = plain_value(as_value(&module.declarations[index])); + let ExprKind::Application(function, argument) = &expression.kind else { + panic!("record postfix must belong to the argument: {expression:?}"); + }; + assert!(matches!(&function.kind, ExprKind::Name(name) if name.text == "consume")); + if projection { + assert!( + matches!(&argument.kind, ExprKind::FieldAccess { expression, .. } if matches!(&expression.kind, ExprKind::Name(name) if name.text == "r")) + ); + } else { + assert!( + matches!(&argument.kind, ExprKind::RecordUpdate { expression, .. } if matches!(&expression.kind, ExprKind::Name(name) if name.text == "r")) + ); + } + } +} diff --git a/crates/psrs-thir/src/tests.rs b/crates/psrs-thir/src/tests.rs index 778bad7c..0b5a5fc1 100644 --- a/crates/psrs-thir/src/tests.rs +++ b/crates/psrs-thir/src/tests.rs @@ -93,6 +93,46 @@ fn verifier_checks_instance_context_against_constructor_parameters() { assert!(errors.iter().any(|error| { error.message == "instance evidence does not match its context parameter" })); + + let mut equivalent = module.clone(); + for variable in [TypeVariableId(0), TypeVariableId(1)] { + let base = equivalent.types.len() as u32; + equivalent.types.extend([ + Type::Variable(variable), + Type::Application(TypeId(4), TypeId(base)), + Type::Application(TypeId(base + 1), TypeId(base)), + Type::ForAll { + variables: vec![variable], + body: TypeId(base + 2), + }, + Type::RowExtend { + label: "method".into(), + ty: TypeId(base + 3), + tail: TypeId(2), + }, + Type::Application(TypeId(1), TypeId(base + 4)), + ]); + } + equivalent.types.extend([ + Type::Application(TypeId(4), TypeId(12)), + Type::Application(TypeId(19), dictionary), + ]); + let ExprKind::Evidence(evidence) = &mut equivalent.declarations[0].value.kind else { + unreachable!() + }; + let EvidenceKind::Instance { + constructor_type, + context, + .. + } = &mut evidence.kind + else { + unreachable!() + }; + *constructor_type = TypeId(20); + context[0].ty = TypeId(18); + equivalent + .verify() + .expect("alpha-equivalent context dictionaries are valid"); } #[test] diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index 83ddd075..7dda06fb 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -274,7 +274,7 @@ fn verify_evidence(evidence: &Evidence, module: &Module, errors: &mut Vec { - left_parameter: &'a str, - right_parameter: &'a str, - left_mapper: &'a hir::Expr, - right_mapper: &'a hir::Expr, - bimap_method: SymbolId, - span: TextRange, -} +use super::KnownClass; impl Checker { pub(super) fn derive_bifunctor_method( @@ -18,170 +8,6 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "Bifunctor deriving requires one type argument"); - }; - let instance_type = self.resolve_type(instance_type.clone()); - let (head, arguments) = flatten_spine(&instance_type); - let InferType::Constructor(TypeConstructor::User(type_id)) = head else { - return self - .deriving_error(span, "Bifunctor deriving requires a local type constructor"); - }; - let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self - .deriving_error(span, "cannot find the data declaration to derive Bifunctor"); - }; - if type_id.module != self.env.module_id - || !matches!( - declaration.kind, - hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype - ) - || declaration.parameters.len() < 2 - || arguments.len() + 2 != declaration.parameters.len() - { - return self.deriving_error( - span, - "Bifunctor deriving requires a local type constructor applied to all but its final two parameters", - ); - } - if method.name != "bimap" { - return self.deriving_error(span, "Bifunctor deriving requires a bimap method"); - } - let left_parameter = &declaration.parameters[declaration.parameters.len() - 2].name; - let right_parameter = &declaration.parameters[declaration.parameters.len() - 1].name; - let left_mapper = self.fresh_deriving_binder("__derived_lmap", span); - let right_mapper = self.fresh_deriving_binder("__derived_rmap", span); - let left_mapper_expr = local_expr(left_mapper.id, span); - let right_mapper_expr = local_expr(right_mapper.id, span); - let field_map = BifunctorFieldMap { - left_parameter, - right_parameter, - left_mapper: &left_mapper_expr, - right_mapper: &right_mapper_expr, - bimap_method: method.symbol, - span, - }; - let value = self.fresh_deriving_binder("__derived_value", span); - let mut branches = Vec::with_capacity(declaration.constructors.len()); - for constructor in &declaration.constructors { - let binders = constructor - .fields - .iter() - .map(|_| self.fresh_deriving_binder("__derived_field", span)) - .collect::>(); - let mut result = global_expr(constructor.symbol, span); - for (field_type, binder) in constructor.fields.iter().zip(&binders) { - let field_type = self.normalize_deriving_type(field_type); - let field_value = local_expr(binder.id, span); - let mapped = match map_bifunctor_field(&field_type, &field_map, &field_value) { - Ok(mapped) => mapped, - Err(message) => return self.deriving_error(span, &message), - }; - result = apply_expr(result, mapped, span); - } - branches.push(hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol: constructor.symbol, - name_span: constructor.name_span, - arguments: binders - .into_iter() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder), - span, - }) - .collect(), - }, - span, - }, - value: result, - span, - }); - } - let implementation = hir::Expr { - kind: hir::ExprKind::Lambda { - binder: left_mapper.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: right_mapper.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(value.id, span)), - branches, - }, - span, - }), - }, - span, - }), - }, - span, - }), - }, - span, - }; - self.infer_derived_method(method, class_arguments, &implementation) - } -} - -fn map_bifunctor_field( - ty: &hir::Type, - context: &BifunctorFieldMap<'_>, - value: &hir::Expr, -) -> Result { - let BifunctorFieldMap { - left_parameter, - right_parameter, - left_mapper, - right_mapper, - bimap_method, - span, - } = *context; - let uses_left = contains_parameter(ty, left_parameter); - let uses_right = contains_parameter(ty, right_parameter); - if !uses_left && !uses_right { - return Ok(value.clone()); - } - if matches!(&ty.kind, hir::TypeKind::Variable(name) if name == left_parameter) { - return Ok(apply_expr(left_mapper.clone(), value.clone(), span)); - } - if matches!(&ty.kind, hir::TypeKind::Variable(name) if name == right_parameter) { - return Ok(apply_expr(right_mapper.clone(), value.clone(), span)); - } - let (head, arguments) = flatten_type_application(ty); - if !contains_parameter(head, left_parameter) - && !contains_parameter(head, right_parameter) - && arguments.len() >= 2 - && matches!(&arguments[arguments.len() - 2].kind, hir::TypeKind::Variable(name) if name == left_parameter) - && matches!(&arguments[arguments.len() - 1].kind, hir::TypeKind::Variable(name) if name == right_parameter) - && arguments[..arguments.len() - 2].iter().all(|argument| { - !contains_parameter(argument, left_parameter) - && !contains_parameter(argument, right_parameter) - }) - { - return Ok(apply_expr( - apply_expr( - apply_expr(global_expr(bimap_method, span), left_mapper.clone(), span), - right_mapper.clone(), - span, - ), - value.clone(), - span, - )); - } - if uses_left && !uses_right { - return Err( - "Bifunctor deriving does not support this nested left-parameter occurrence".to_owned(), - ); - } - if uses_right && !uses_left { - return Err( - "Bifunctor deriving does not support this nested right-parameter occurrence".to_owned(), - ); + self.derive_mapping_method(KnownClass::Bifunctor, method, class_arguments, span) } - Err("Bifunctor deriving does not support this parameter occurrence".to_owned()) } diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/contravariant.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/contravariant.rs index d1960ece..4deb336e 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/contravariant.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/contravariant.rs @@ -1,6 +1,5 @@ use super::super::super::*; -use super::types::{contains_parameter, flatten_type_application}; -use super::{apply_expr, flatten_spine, global_expr, local_expr}; +use super::KnownClass; impl Checker { pub(super) fn derive_contravariant_method( @@ -9,195 +8,6 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "Contravariant deriving requires one type argument"); - }; - let instance_type = self.resolve_type(instance_type.clone()); - let (head, arguments) = flatten_spine(&instance_type); - let InferType::Constructor(TypeConstructor::User(type_id)) = head else { - return self.deriving_error( - span, - "Contravariant deriving requires a local type constructor", - ); - }; - let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error( - span, - "cannot find the data declaration to derive Contravariant", - ); - }; - if type_id.module != self.env.module_id - || !matches!( - declaration.kind, - hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype - ) - || declaration.parameters.is_empty() - || arguments.len() + 1 != declaration.parameters.len() - { - return self.deriving_error( - span, - "Contravariant deriving requires a local type constructor applied to all but its final parameter", - ); - } - if method.name != "cmap" { - return self.deriving_error(span, "Contravariant deriving requires a cmap method"); - } - let parameter = &declaration.parameters.last()?.name; - let profunctor_lcmap = self.profunctor_lcmap_symbol(); - let mapper = self.fresh_deriving_binder("__derived_contramap", span); - let value = self.fresh_deriving_binder("__derived_value", span); - let mut branches = Vec::with_capacity(declaration.constructors.len()); - for constructor in &declaration.constructors { - let binders = constructor - .fields - .iter() - .map(|_| self.fresh_deriving_binder("__derived_field", span)) - .collect::>(); - let mut result = global_expr(constructor.symbol, span); - for (field_type, binder) in constructor.fields.iter().zip(&binders) { - let field_type = self.normalize_deriving_type(field_type); - let field_value = local_expr(binder.id, span); - let mapped = match contramap_field_value( - &field_type, - parameter, - &local_expr(mapper.id, span), - &field_value, - profunctor_lcmap, - span, - ) { - Ok(mapped) => mapped, - Err(message) => return self.deriving_error(span, &message), - }; - result = apply_expr(result, mapped, span); - } - branches.push(hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol: constructor.symbol, - name_span: constructor.name_span, - arguments: binders - .into_iter() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder), - span, - }) - .collect(), - }, - span, - }, - value: result, - span, - }); - } - let implementation = hir::Expr { - kind: hir::ExprKind::Lambda { - binder: mapper.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(value.id, span)), - branches, - }, - span, - }), - }, - span, - }), - }, - span, - }; - self.infer_derived_method(method, class_arguments, &implementation) + self.derive_mapping_method(KnownClass::Contravariant, method, class_arguments, span) } - - fn profunctor_lcmap_symbol(&self) -> Option { - self.env.classes.iter().find_map(|(class_id, class)| { - (self.env.type_names.get(class_id).map(String::as_str) == Some("Profunctor") - && self.env.type_modules.get(class_id).map(String::as_str) - == Some("Data.Profunctor")) - .then(|| { - class - .methods - .iter() - .find(|method| method.name == "lcmap") - .map(|method| method.symbol) - }) - .flatten() - }) - } -} - -fn contramap_field_value( - ty: &hir::Type, - parameter: &str, - mapper: &hir::Expr, - value: &hir::Expr, - profunctor_lcmap: Option, - span: TextRange, -) -> Result { - if !contains_parameter(ty, parameter) { - return Ok(value.clone()); - } - if let Some(lcmap) = - contravariant_profunctor_application(ty, parameter, mapper, value, profunctor_lcmap, span)? - { - return Ok(lcmap); - } - if let hir::TypeKind::Function { - parameter: input, - result, - } = &ty.kind - && matches!(&input.kind, hir::TypeKind::Variable(name) if name == parameter) - && !contains_parameter(result, parameter) - { - let Some(lcmap) = profunctor_lcmap else { - return Err( - "Contravariant deriving through a function requires Data.Profunctor.lcmap".into(), - ); - }; - return Ok(apply_expr( - apply_expr(global_expr(lcmap, span), mapper.clone(), span), - value.clone(), - span, - )); - } - Err("Contravariant deriving requires each occurrence to be a direct function input".into()) -} - -fn contravariant_profunctor_application( - ty: &hir::Type, - parameter: &str, - mapper: &hir::Expr, - value: &hir::Expr, - profunctor_lcmap: Option, - span: TextRange, -) -> Result, String> { - let (head, arguments) = flatten_type_application(ty); - if arguments.len() < 2 - || contains_parameter(head, parameter) - || !matches!( - &arguments[arguments.len() - 2].kind, - hir::TypeKind::Variable(name) if name == parameter - ) - || arguments[..arguments.len() - 2] - .iter() - .any(|argument| contains_parameter(argument, parameter)) - || arguments[arguments.len() - 1..] - .iter() - .any(|argument| contains_parameter(argument, parameter)) - { - return Ok(None); - } - let Some(lcmap) = profunctor_lcmap else { - return Err( - "Contravariant deriving through a profunctor requires Data.Profunctor.lcmap".into(), - ); - }; - Ok(Some(apply_expr( - apply_expr(global_expr(lcmap, span), mapper.clone(), span), - value.clone(), - span, - ))) } diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs index d8e34ae1..049a0cec 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/eq.rs @@ -1,4 +1,7 @@ use super::*; +use crate::typecheck::classes::deriving::syntax::{ + case_expr, constructor_pattern, if_expr, lambda, wildcard_pattern, +}; impl Checker { pub(super) fn derive_eq_method( @@ -20,18 +23,24 @@ impl Checker { return None; }; self.env.type_declarations.get(type_id).map(|declaration| { - declaration - .constructors - .iter() - .any(|constructor| constructor.fields.iter().any(is_applied_variable)) + declaration.constructors.iter().any(|constructor| { + constructor + .fields + .iter() + .any(|field| is_applied_variable(&self.normalize_deriving_type(field))) + }) }) }) .unwrap_or(false); let eq1_method = if needs_eq1 { - match self.known_method_symbol("Data.Eq", "Eq1", "eq1") { + match self.known_method(KnownClass::Eq1, "eq1") { Some(method) => Some(method), None => { - return self.deriving_error(span, "cannot find the Eq1 method for Eq deriving"); + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "cannot find the Eq1 method for Eq deriving", + ); } } } else { @@ -49,8 +58,12 @@ impl Checker { // The official rule derives `Eq1` by delegating to `Eq` at the applied // argument: `eq1 = eq`. The matching `Eq` instance supplies the // dictionary, so its context must be visible alongside the method's. - let Some(eq_method) = self.known_method_symbol("Data.Eq", "Eq", "eq") else { - return self.deriving_error(span, "cannot find the Eq method for Eq1 deriving"); + let Some(eq_method) = self.known_method(KnownClass::Eq, "eq") else { + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "cannot find the Eq method for Eq1 deriving", + ); }; let implementation = global_expr(eq_method, span); self.infer_derived_method(method, class_arguments, &implementation) @@ -65,19 +78,27 @@ impl Checker { span: TextRange, ) -> Option { let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "equality deriving requires one type argument"); + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "equality deriving requires one type argument", + ); }; let instance_type = self.resolve_type(instance_type.clone()); let (head, arguments) = flatten_spine(&instance_type); let InferType::Constructor(TypeConstructor::User(type_id)) = head else { return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, span, "Eq deriving requires a local data or newtype constructor", ); }; let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self - .deriving_error(span, "cannot find the data declaration to derive equality"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration to derive equality", + ); }; if type_id.module != self.env.module_id || !matches!( @@ -87,6 +108,7 @@ impl Checker { || declaration.parameters.len() != arguments.len() { return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, span, "Eq deriving requires a locally declared, fully applied data type", ); @@ -106,8 +128,13 @@ impl Checker { .iter() .map(|_| self.fresh_deriving_binder("__derived_r", span)) .collect::>(); + let field_types = constructor + .fields + .iter() + .map(|field| self.normalize_deriving_type(field)) + .collect::>(); let body = derive_eq_field_tests( - constructor, + &field_types, &left_fields, &right_fields, eq_method, @@ -122,20 +149,15 @@ impl Checker { }; let mismatch = hir::CaseBranch { coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Wildcard, - span, - }, + pattern: wildcard_pattern(span), value: boolean_literal(false, span), span, }; - let right_case = hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(right.id, span)), - branches: vec![same_constructor, mismatch], - }, + let right_case = case_expr( + local_expr(right.id, span), + vec![same_constructor, mismatch], span, - }; + ); left_case_branches.push(hir::CaseBranch { coverage: hir::CaseBranchCoverage::Source, pattern: constructor_pattern(constructor, &left_fields, span), @@ -146,47 +168,33 @@ impl Checker { if left_case_branches.is_empty() { left_case_branches.push(hir::CaseBranch { coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Wildcard, - span, - }, + pattern: wildcard_pattern(span), value: boolean_literal(true, span), span, }); } - let implementation = hir::Expr { - kind: hir::ExprKind::Lambda { - binder: left.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: right.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(left.id, span)), - branches: left_case_branches, - }, - span, - }), - }, - span, - }), - }, + let implementation = lambda( + left.clone(), + lambda( + right.clone(), + case_expr(local_expr(left.id, span), left_case_branches, span), + span, + ), span, - }; + ); self.infer_derived_method(method, class_arguments, &implementation) } } fn derive_eq_field_tests( - constructor: &hir::Constructor, + fields: &[hir::Type], left_fields: &[hir::LocalBinder], right_fields: &[hir::LocalBinder], eq_method: SymbolId, eq1_method: Option, span: TextRange, ) -> hir::Expr { - constructor - .fields + fields .iter() .zip(left_fields) .zip(right_fields) @@ -206,34 +214,7 @@ fn derive_eq_field_tests( .collect::>() .into_iter() .rev() - .fold(boolean_literal(true, span), |rest, test| hir::Expr { - kind: hir::ExprKind::If { - condition: Box::new(test), - then_branch: Box::new(rest), - else_branch: Box::new(boolean_literal(false, span)), - }, - span, + .fold(boolean_literal(true, span), |rest, test| { + if_expr(test, rest, boolean_literal(false, span), span) }) } - -fn constructor_pattern( - constructor: &hir::Constructor, - binders: &[hir::LocalBinder], - span: TextRange, -) -> hir::Pattern { - hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol: constructor.symbol, - name_span: constructor.name_span, - arguments: binders - .iter() - .cloned() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder), - span, - }) - .collect(), - }, - span, - } -} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/branches.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/branches.rs new file mode 100644 index 00000000..92d51420 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/branches.rs @@ -0,0 +1,385 @@ +use super::*; +use crate::typecheck::classes::deriving::syntax::field_expr; +use crate::typecheck::classes::deriving::syntax::lambda; + +impl Checker { + fn require_fold_symbol( + &mut self, + symbol: Option, + span: TextRange, + operation: &str, + ) -> Option { + symbol.or_else(|| { + self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + &format!("cannot find the `{operation}` value required to derive a fold"), + ) + }) + } + + pub(super) fn fold_map_branch( + &mut self, + binders: &[hir::LocalBinder], + usages: &[FieldUsage], + context: &FoldContext<'_>, + ) -> Option { + let FoldContext { + ref ops, + left, + right, + span, + } = *context; + let mut contributions = Vec::new(); + for (binder, usage) in binders.iter().zip(usages) { + if *usage == FieldUsage::Inert { + continue; + } + let field = local_expr(binder.id, span); + let function = self.fold_map_function(usage, ops, left, right, span)?; + contributions.push(apply_expr(function, field, span)); + } + self.fold_contributions(contributions, ops, span) + } + + fn fold_contributions( + &mut self, + mut contributions: Vec, + ops: &FoldOps, + span: TextRange, + ) -> Option { + let mut body = match contributions.pop() { + Some(last) => last, + None => { + return Some(global_expr( + self.require_fold_symbol(ops.mempty, span, "mempty")?, + span, + )); + } + }; + for contribution in contributions.into_iter().rev() { + body = apply_expr( + apply_expr( + global_expr(self.require_fold_symbol(ops.append, span, "append")?, span), + contribution, + span, + ), + body, + span, + ); + } + Some(body) + } + + /// A function `x -> m` for a field occurrence. + fn fold_map_function( + &mut self, + usage: &FieldUsage, + ops: &FoldOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + Some(match usage { + FieldUsage::Inert => { + let ignored = self.fresh_deriving_binder("__derived_ignored", span); + lambda( + ignored, + global_expr(self.require_fold_symbol(ops.mempty, span, "mempty")?, span), + span, + ) + } + FieldUsage::Record(fields) => { + let binder = self.fresh_deriving_binder("__derived_record", span); + let record = local_expr(binder.id, span); + let mut contributions = Vec::new(); + for (label, usage) in fields { + if *usage != FieldUsage::Inert { + let function = self.fold_map_function(usage, ops, left, right, span)?; + contributions.push(apply_expr( + function, + field_expr(record.clone(), label, span), + span, + )); + } + } + let body = self.fold_contributions(contributions, ops, span)?; + lambda(binder, body, span) + } + FieldUsage::Param => right.clone(), + FieldUsage::LParam => left.clone(), + FieldUsage::Mono(inner) => apply_expr( + global_expr( + self.require_fold_symbol(ops.fold_map, span, "foldMap")?, + span, + ), + self.fold_map_function(inner, ops, left, right, span)?, + span, + ), + FieldUsage::Bi(l, r) => apply_expr( + apply_expr( + global_expr( + self.require_fold_symbol(ops.bifold_map, span, "bifoldMap")?, + span, + ), + self.fold_map_function(l, ops, left, right, span)?, + span, + ), + self.fold_map_function(r, ops, left, right, span)?, + span, + ), + FieldUsage::Contra(inner) | FieldUsage::Pro(inner, _) => { + self.fold_map_function(inner, ops, left, right, span)? + } + }) + } + + pub(super) fn fold_r_branch( + &mut self, + binders: &[hir::LocalBinder], + usages: &[FieldUsage], + accumulator: &hir::Expr, + context: &FoldContext<'_>, + ) -> Option { + let FoldContext { + ref ops, + left, + right, + span, + } = *context; + let mut body = accumulator.clone(); + for (binder, usage) in binders.iter().zip(usages).rev() { + if *usage == FieldUsage::Inert { + continue; + } + let field = local_expr(binder.id, span); + let step = self.fold_r_step(usage, ops, left, right, span)?; + body = apply_expr(apply_expr(step, field, span), body, span); + } + Some(body) + } + + /// A `foldr` step `x -> rest -> b`. + fn fold_r_step( + &mut self, + usage: &FieldUsage, + ops: &FoldOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + Some(match usage { + FieldUsage::Inert => self.ignore_step(span, false), + FieldUsage::Record(fields) => { + self.record_fold_step(fields, ops, left, right, span, false)? + } + FieldUsage::Param => right.clone(), + FieldUsage::LParam => left.clone(), + FieldUsage::Mono(inner) => { + let step = self.fold_r_step(inner, ops, left, right, span)?; + let method = self.require_fold_symbol(ops.fold_r, span, "foldr")?; + self.nested_fold_step(method, step, span, false) + } + FieldUsage::Bi(l, r) => { + let l_step = self.fold_r_step(l, ops, left, right, span)?; + let r_step = self.fold_r_step(r, ops, left, right, span)?; + let method = self.require_fold_symbol(ops.bifold_r, span, "bifoldr")?; + self.nested_bifold_step(method, l_step, r_step, span, false) + } + FieldUsage::Contra(inner) | FieldUsage::Pro(inner, _) => { + let step = self.fold_r_step(inner, ops, left, right, span)?; + let method = self.require_fold_symbol(ops.fold_r, span, "foldr")?; + self.nested_fold_step(method, step, span, false) + } + }) + } + + pub(super) fn fold_l_branch( + &mut self, + binders: &[hir::LocalBinder], + usages: &[FieldUsage], + accumulator: &hir::Expr, + context: &FoldContext<'_>, + ) -> Option { + let FoldContext { + ref ops, + left, + right, + span, + } = *context; + let mut body = accumulator.clone(); + for (binder, usage) in binders.iter().zip(usages) { + if *usage == FieldUsage::Inert { + continue; + } + let field = local_expr(binder.id, span); + let step = self.fold_l_step(usage, ops, left, right, span)?; + body = apply_expr(apply_expr(step, body, span), field, span); + } + Some(body) + } + + /// A `foldl` step `rest -> x -> b`. + fn fold_l_step( + &mut self, + usage: &FieldUsage, + ops: &FoldOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + Some(match usage { + FieldUsage::Inert => self.ignore_step(span, true), + FieldUsage::Record(fields) => { + self.record_fold_step(fields, ops, left, right, span, true)? + } + FieldUsage::Param => right.clone(), + FieldUsage::LParam => left.clone(), + FieldUsage::Mono(inner) => { + let step = self.fold_l_step(inner, ops, left, right, span)?; + let method = self.require_fold_symbol(ops.fold_l, span, "foldl")?; + self.nested_fold_step(method, step, span, true) + } + FieldUsage::Bi(l, r) => { + let l_step = self.fold_l_step(l, ops, left, right, span)?; + let r_step = self.fold_l_step(r, ops, left, right, span)?; + let method = self.require_fold_symbol(ops.bifold_l, span, "bifoldl")?; + self.nested_bifold_step(method, l_step, r_step, span, true) + } + FieldUsage::Contra(inner) | FieldUsage::Pro(inner, _) => { + let step = self.fold_l_step(inner, ops, left, right, span)?; + let method = self.require_fold_symbol(ops.fold_l, span, "foldl")?; + self.nested_fold_step(method, step, span, true) + } + }) + } + + fn record_fold_step( + &mut self, + fields: &[(String, FieldUsage)], + ops: &FoldOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + forward: bool, + ) -> Option { + let record = self.fresh_deriving_binder("__derived_record", span); + let acc = self.fresh_deriving_binder("__derived_acc", span); + let mut body = local_expr(acc.id, span); + let ordered: Box> = if forward { + Box::new(fields.iter()) + } else { + Box::new(fields.iter().rev()) + }; + for (label, usage) in ordered { + if *usage == FieldUsage::Inert { + continue; + } + let field = field_expr(local_expr(record.id, span), label, span); + let step = if forward { + self.fold_l_step(usage, ops, left, right, span)? + } else { + self.fold_r_step(usage, ops, left, right, span)? + }; + body = if forward { + apply_expr(apply_expr(step, body, span), field, span) + } else { + apply_expr(apply_expr(step, field, span), body, span) + }; + } + Some(if forward { + lambda(acc, lambda(record, body, span), span) + } else { + lambda(record, lambda(acc, body, span), span) + }) + } + + /// A step that ignores its element and returns the accumulator. + fn ignore_step(&mut self, span: TextRange, left: bool) -> hir::Expr { + let accumulator = self.fresh_deriving_binder("__derived_rest", span); + let element = self.fresh_deriving_binder("__derived_ignored", span); + let (first, second) = if left { + (accumulator.clone(), element) + } else { + (element, accumulator.clone()) + }; + lambda( + first, + lambda(second, local_expr(accumulator.id, span), span), + span, + ) + } + + /// `\x rest -> method step rest x` (right) or `\rest x -> method step rest x` (left). + fn nested_fold_step( + &mut self, + method: SymbolId, + step: hir::Expr, + span: TextRange, + left: bool, + ) -> hir::Expr { + let accumulator = self.fresh_deriving_binder("__derived_rest", span); + let element = self.fresh_deriving_binder("__derived_x", span); + let (first, second) = if left { + (accumulator.clone(), element.clone()) + } else { + (element.clone(), accumulator.clone()) + }; + lambda( + first, + lambda( + second, + apply_expr( + apply_expr( + apply_expr(global_expr(method, span), step, span), + local_expr(accumulator.id, span), + span, + ), + local_expr(element.id, span), + span, + ), + span, + ), + span, + ) + } + + /// The bipartite version of `nested_fold_step`. + fn nested_bifold_step( + &mut self, + method: SymbolId, + l_step: hir::Expr, + r_step: hir::Expr, + span: TextRange, + left: bool, + ) -> hir::Expr { + let accumulator = self.fresh_deriving_binder("__derived_rest", span); + let element = self.fresh_deriving_binder("__derived_x", span); + let (first, second) = if left { + (accumulator.clone(), element.clone()) + } else { + (element.clone(), accumulator.clone()) + }; + lambda( + first, + lambda( + second, + apply_expr( + apply_expr( + apply_expr( + apply_expr(global_expr(method, span), l_step, span), + r_step, + span, + ), + local_expr(accumulator.id, span), + span, + ), + local_expr(element.id, span), + span, + ), + span, + ), + span, + ) + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/mod.rs new file mode 100644 index 00000000..c5234c3c --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/foldable/mod.rs @@ -0,0 +1,193 @@ +//! `Foldable` and `Bifoldable` deriving. +//! +//! `foldMap` combines each field's monoidal contribution; `foldr`/`foldl` +//! thread an accumulator through the contributing fields in right or left +//! order. The field usage tree decides which occurrences fold through the +//! nested `Foldable`/`Bifoldable` instance and which are inert. + +use crate::typecheck::classes::deriving::syntax::{case_expr, constructor_pattern, lambda}; +mod branches; + +use super::super::super::*; +use super::usage::FieldUsage; +use super::{KnownClass, MappingClasses, apply_expr, flatten_spine, global_expr, local_expr}; + +/// The method symbols a fold rule uses. +#[derive(Clone, Copy)] +struct FoldOps { + fold_map: Option, + fold_r: Option, + fold_l: Option, + bifold_map: Option, + bifold_r: Option, + bifold_l: Option, + append: Option, + mempty: Option, +} + +/// The shared inputs of the per-method branch builders. +#[derive(Clone, Copy)] +struct FoldContext<'a> { + ops: FoldOps, + left: &'a hir::Expr, + right: &'a hir::Expr, + span: TextRange, +} + +impl Checker { + pub(super) fn derive_foldable_method( + &mut self, + known: KnownClass, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + let is_bi = known == KnownClass::Bifoldable; + let Some(instance_type) = class_arguments.first() else { + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "fold deriving requires one type argument", + ); + }; + let instance_type = self.resolve_type(instance_type.clone()); + let (head, arguments) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "fold deriving requires a local type constructor", + ); + }; + let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration to derive a fold", + ); + }; + let arity = if is_bi { 2 } else { 1 }; + if type_id.module != self.env.module_id + || !matches!( + declaration.kind, + hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype + ) + || declaration.parameters.len() < arity + || arguments.len() + arity != declaration.parameters.len() + { + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "fold deriving requires a local type constructor applied to all but its final parameters", + ); + } + let lparam = is_bi.then(|| { + declaration.parameters[declaration.parameters.len() - 2] + .name + .as_str() + }); + let param = &declaration.parameters[declaration.parameters.len() - 1].name; + let usages = match self.validate_field_usage( + &declaration, + MappingClasses::foldable(), + lparam, + param, + (false, false), + &arguments, + ) { + Ok(usages) => usages, + Err(offending) => { + return self.deriving_error( + TypeCheckErrorKind::CannotDeriveInvalidConstructorArg, + offending, + "fold deriving cannot map a parameter occurrence in this field", + ); + } + }; + let ops = self.fold_ops(); + let left = self.fresh_deriving_binder("__derived_f", span); + let right = if is_bi { + self.fresh_deriving_binder("__derived_g", span) + } else { + left.clone() + }; + let accumulator = matches!( + method.name.as_str(), + "foldr" | "bifoldr" | "foldl" | "bifoldl" + ) + .then(|| self.fresh_deriving_binder("__derived_z", span)); + let left_expr = local_expr(left.id, span); + let right_expr = local_expr(right.id, span); + let accumulator_expr = accumulator + .as_ref() + .map(|binder| local_expr(binder.id, span)); + let context = FoldContext { + ops, + left: &left_expr, + right: &right_expr, + span, + }; + let mut branches = Vec::with_capacity(declaration.constructors.len()); + for (constructor, field_usages) in declaration.constructors.iter().zip(&usages) { + let binders = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__derived_field", span)) + .collect::>(); + let value = match method.name.as_str() { + "foldMap" | "bifoldMap" => { + self.fold_map_branch(&binders, field_usages, &context)? + } + "foldr" | "bifoldr" => self.fold_r_branch( + &binders, + field_usages, + accumulator_expr.as_ref()?, + &context, + )?, + "foldl" | "bifoldl" => self.fold_l_branch( + &binders, + field_usages, + accumulator_expr.as_ref()?, + &context, + )?, + _ => { + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "the known-class deriving rule is unavailable for this class method", + ); + } + }; + branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: constructor_pattern(constructor, &binders, span), + value, + span, + }); + } + let value = self.fresh_deriving_binder("__derived_value", span); + let mut body = case_expr(local_expr(value.id, span), branches, span); + body = lambda(value, body, span); + if let Some(accumulator) = accumulator { + body = lambda(accumulator, body, span); + } + if is_bi { + body = lambda(right, body, span); + } + let implementation = lambda(left, body, span); + self.infer_derived_method(method, class_arguments, &implementation) + } + + fn fold_ops(&self) -> FoldOps { + FoldOps { + fold_map: self.known_method(KnownClass::Foldable, "foldMap"), + fold_r: self.known_method(KnownClass::Foldable, "foldr"), + fold_l: self.known_method(KnownClass::Foldable, "foldl"), + bifold_map: self.known_method(KnownClass::Bifoldable, "bifoldMap"), + bifold_r: self.known_method(KnownClass::Bifoldable, "bifoldr"), + bifold_l: self.known_method(KnownClass::Bifoldable, "bifoldl"), + append: self.env.deriving.append(), + mempty: self.env.deriving.mempty(), + } + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/functor.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/functor.rs index cd5a4a99..9978f99b 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/functor.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/functor.rs @@ -1,6 +1,5 @@ use super::super::super::*; -use super::types::contains_parameter; -use super::{apply_expr, flatten_spine, global_expr, local_expr}; +use super::KnownClass; impl Checker { pub(super) fn derive_functor_method( @@ -9,192 +8,6 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "Functor deriving requires one type argument"); - }; - let instance_type = self.resolve_type(instance_type.clone()); - let (head, arguments) = flatten_spine(&instance_type); - let InferType::Constructor(TypeConstructor::User(type_id)) = head else { - return self.deriving_error(span, "Functor deriving requires a local type constructor"); - }; - let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error(span, "cannot find the data declaration to derive Functor"); - }; - if type_id.module != self.env.module_id - || !matches!( - declaration.kind, - hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype - ) - || declaration.parameters.is_empty() - || arguments.len() + 1 != declaration.parameters.len() - { - return self.deriving_error( - span, - "Functor deriving requires a local type constructor applied to all but its final parameter", - ); - } - if method.name != "map" { - return self.deriving_error(span, "Functor deriving requires a map method"); - } - - let parameter = declaration - .parameters - .last() - .map(|parameter| parameter.name.as_str())?; - let mapper = self.fresh_deriving_binder("__derived_map", span); - let value = self.fresh_deriving_binder("__derived_value", span); - let mut branches = Vec::with_capacity(declaration.constructors.len()); - for constructor in &declaration.constructors { - let binders = constructor - .fields - .iter() - .map(|_| self.fresh_deriving_binder("__derived_field", span)) - .collect::>(); - let mut result = global_expr(constructor.symbol, span); - for (field_type, binder) in constructor.fields.iter().zip(&binders) { - let input = local_expr(binder.id, span); - let field_type = self.normalize_deriving_type(field_type); - let mapped = match map_field_value( - &field_type, - parameter, - &local_expr(mapper.id, span), - &input, - method.symbol, - span, - ) { - Ok(mapped) => mapped, - Err(message) => return self.deriving_error(span, &message), - }; - result = apply_expr(result, mapped, span); - } - branches.push(hir::CaseBranch { - coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol: constructor.symbol, - name_span: constructor.name_span, - arguments: binders - .into_iter() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder), - span, - }) - .collect(), - }, - span, - }, - value: result, - span, - }); - } - let implementation = hir::Expr { - kind: hir::ExprKind::Lambda { - binder: mapper.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(value.id, span)), - branches, - }, - span, - }), - }, - span, - }), - }, - span, - }; - self.infer_derived_method(method, class_arguments, &implementation) - } -} - -fn map_field_value( - ty: &hir::Type, - parameter: &str, - mapper: &hir::Expr, - value: &hir::Expr, - map_method: SymbolId, - span: TextRange, -) -> Result { - if !contains_parameter(ty, parameter) { - return Ok(value.clone()); - } - if matches!(&ty.kind, hir::TypeKind::Variable(name) if name == parameter) { - return Ok(apply_expr(mapper.clone(), value.clone(), span)); - } - match &ty.kind { - hir::TypeKind::Application(function, argument) - if contains_parameter(argument, parameter) - && !contains_parameter(function, parameter) => - { - let mapper = mapping_function(argument, parameter, mapper, map_method, span)?; - Ok(apply_expr( - apply_expr(global_expr(map_method, span), mapper, span), - value.clone(), - span, - )) - } - hir::TypeKind::Function { - parameter: input, - result, - } if !contains_parameter(input, parameter) && contains_parameter(result, parameter) => { - let mapper = mapping_function(result, parameter, mapper, map_method, span)?; - Ok(apply_expr( - apply_expr(global_expr(map_method, span), mapper, span), - value.clone(), - span, - )) - } - hir::TypeKind::Function { - parameter: input, .. - } if contains_parameter(input, parameter) => { - Err("Functor deriving cannot map a type parameter in a function input".to_owned()) - } - hir::TypeKind::Application(_, _) => Err( - "Functor deriving cannot map a type parameter in a higher-kinded application head" - .to_owned(), - ), - hir::TypeKind::Record { .. } | hir::TypeKind::Row { .. } => { - Err("Functor deriving does not support a record containing its parameter".to_owned()) - } - _ => Err("Functor deriving does not support this parameter occurrence".to_owned()), - } -} - -fn mapping_function( - ty: &hir::Type, - parameter: &str, - mapper: &hir::Expr, - map_method: SymbolId, - span: TextRange, -) -> Result { - if matches!(&ty.kind, hir::TypeKind::Variable(name) if name == parameter) { - return Ok(mapper.clone()); - } - if !contains_parameter(ty, parameter) { - return Err("Functor deriving expected a parameter-containing field type".to_owned()); - } - match &ty.kind { - hir::TypeKind::Application(function, argument) - if contains_parameter(argument, parameter) - && !contains_parameter(function, parameter) => - { - let inner = mapping_function(argument, parameter, mapper, map_method, span)?; - Ok(apply_expr(global_expr(map_method, span), inner, span)) - } - hir::TypeKind::Function { - parameter: input, - result, - } if !contains_parameter(input, parameter) && contains_parameter(result, parameter) => { - let result_mapper = mapping_function(result, parameter, mapper, map_method, span)?; - Ok(apply_expr( - global_expr(map_method, span), - result_mapper, - span, - )) - } - _ => Err("Functor deriving does not support this nested parameter occurrence".to_owned()), + self.derive_mapping_method(KnownClass::Functor, method, class_arguments, span) } } diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs index c49454c2..f661c3ae 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/generic.rs @@ -1,8 +1,12 @@ use super::super::super::*; +use super::KnownClass; use super::{apply_expr, flatten_spine, global_expr, local_expr}; +use crate::typecheck::classes::deriving::syntax::{ + case_expr, lambda, symbol_pattern as constructor_pattern, variable_pattern, wildcard_pattern, +}; impl Checker { - pub(super) fn generic_representation( + pub(in crate::typecheck::classes) fn generic_representation( &mut self, instance_type: &InferType, span: TextRange, @@ -10,23 +14,36 @@ impl Checker { let instance_type = self.resolve_type(instance_type.clone()); let (head, arguments) = flatten_spine(&instance_type); let InferType::Constructor(TypeConstructor::User(type_id)) = head else { - return self.deriving_error(span, "Generic deriving requires a local data type"); + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "Generic deriving requires a local data type", + ); }; let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error(span, "cannot find the data declaration for Generic"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration for Generic", + ); }; if type_id.module != self.env.module_id || declaration.kind != hir::TypeDeclarationKind::Data || declaration.parameters.len() != arguments.len() { return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, span, "Generic deriving requires a locally declared, fully applied data type", ); } if declaration.constructors.is_empty() { return self.generic_type("NoConstructors", Vec::new()).or_else(|| { - self.deriving_error(span, "cannot find Data.Generic.Rep.NoConstructors") + self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find Data.Generic.Rep.NoConstructors", + ) }); } @@ -43,18 +60,30 @@ impl Checker { let mut variables = parameter_types.clone(); let field_type = self.elaborate_type(field, &mut variables); let Some(argument) = self.generic_type("Argument", vec![field_type]) else { - return self.deriving_error(span, "cannot find Data.Generic.Rep.Argument"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find Data.Generic.Rep.Argument", + ); }; fields.push(argument); } let product = if fields.is_empty() { let Some(no_arguments) = self.generic_type("NoArguments", Vec::new()) else { - return self.deriving_error(span, "cannot find Data.Generic.Rep.NoArguments"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find Data.Generic.Rep.NoArguments", + ); }; no_arguments } else { let Some(product) = self.generic_product_type(fields) else { - return self.deriving_error(span, "cannot find Data.Generic.Rep.Product"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find Data.Generic.Rep.Product", + ); }; product }; @@ -65,7 +94,11 @@ impl Checker { product, ], ) else { - return self.deriving_error(span, "cannot find Data.Generic.Rep.Constructor"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find Data.Generic.Rep.Constructor", + ); }; constructor_representations.push(representation); } @@ -73,7 +106,13 @@ impl Checker { return constructor_representations.pop(); } self.generic_sum_type(constructor_representations) - .or_else(|| self.deriving_error(span, "cannot find Data.Generic.Rep.Sum")) + .or_else(|| { + self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find Data.Generic.Rep.Sum", + ) + }) } pub(super) fn derive_generic_method( @@ -83,21 +122,34 @@ impl Checker { span: TextRange, ) -> Option { let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "Generic deriving requires its data type argument"); + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "Generic deriving requires its data type argument", + ); }; let instance_type = self.resolve_type(instance_type.clone()); let (head, arguments) = flatten_spine(&instance_type); let InferType::Constructor(TypeConstructor::User(type_id)) = head else { - return self.deriving_error(span, "Generic deriving requires a local data type"); + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "Generic deriving requires a local data type", + ); }; let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error(span, "cannot find the data declaration for Generic"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration for Generic", + ); }; if type_id.module != self.env.module_id || declaration.kind != hir::TypeDeclarationKind::Data || declaration.parameters.len() != arguments.len() { return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, span, "Generic deriving requires a locally declared, fully applied data type", ); @@ -108,8 +160,11 @@ impl Checker { "from" => self.derive_generic_from(&declaration, &value, span)?, "to" => self.derive_generic_to(&declaration, &value, span)?, _ => { - return self - .deriving_error(span, "Generic derives only its `to` and `from` methods"); + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "Generic derives only its `to` and `from` methods", + ); } }; self.infer_derived_method(method, class_arguments, &implementation) @@ -145,27 +200,13 @@ impl Checker { local_expr(value.id, span), span, ); - return Some(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(recursive), - }, - span, - }); + return Some(lambda(value.clone(), recursive, span)); } - Some(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(value.id, span)), - branches, - }, - span, - }), - }, + Some(lambda( + value.clone(), + case_expr(local_expr(value.id, span), branches, span), span, - }) + )) } fn derive_generic_to( @@ -203,27 +244,13 @@ impl Checker { local_expr(value.id, span), span, ); - return Some(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(recursive), - }, - span, - }); + return Some(lambda(value.clone(), recursive, span)); } - Some(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: value.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(value.id, span)), - branches, - }, - span, - }), - }, + Some(lambda( + value.clone(), + case_expr(local_expr(value.id, span), branches, span), span, - }) + )) } fn generic_product_expression( @@ -376,41 +403,19 @@ impl Checker { } fn generic_type(&self, name: &str, arguments: Vec) -> Option { - let type_id = self.generic_rep_type_id(name)?; + let type_id = self.env.deriving.generic_rep()?.type_id(name)?; Some(arguments.into_iter().fold( InferType::Constructor(TypeConstructor::User(type_id)), |function, argument| InferType::Application(Box::new(function), Box::new(argument)), )) } - fn generic_rep_type_id(&self, name: &str) -> Option { - self.env.type_names.iter().find_map(|(type_id, type_name)| { - (type_name == name - && self - .env - .type_modules - .get(type_id) - .is_some_and(|module| module == "Data.Generic.Rep")) - .then_some(*type_id) - }) - } - fn generic_rep_constructor(&self, name: &str) -> Option { - let type_id = self.generic_rep_type_id(match name { - "Inl" | "Inr" => "Sum", - _ => name, - })?; - self.env - .type_declarations - .get(&type_id)? - .constructors - .iter() - .find(|constructor| constructor.name == name) - .map(|constructor| constructor.symbol) + self.env.deriving.generic_rep()?.constructor(name) } fn current_generic_method(&self, name: &str) -> Option { - self.known_method_symbol("Data.Generic.Rep", "Generic", name) + self.known_method(KnownClass::Generic, name) } } @@ -428,32 +433,3 @@ fn data_constructor_pattern( span, ) } - -fn constructor_pattern( - symbol: SymbolId, - arguments: Vec, - span: TextRange, -) -> hir::Pattern { - hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol, - name_span: span, - arguments, - }, - span, - } -} - -fn variable_pattern(binder: &hir::LocalBinder, span: TextRange) -> hir::Pattern { - hir::Pattern { - kind: hir::PatternKind::Var(binder.clone()), - span, - } -} - -fn wildcard_pattern(span: TextRange) -> hir::Pattern { - hir::Pattern { - kind: hir::PatternKind::Wildcard, - span, - } -} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/mapping.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/mapping.rs new file mode 100644 index 00000000..a64e472a --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/mapping.rs @@ -0,0 +1,131 @@ +//! Usage-driven generation shared by the four structural mapping classes. +use super::super::super::*; +use super::syntax::{apply_expr, case_expr, constructor_pattern, global_expr, lambda, local_expr}; +use super::usage::{MappingClasses, MappingMethods}; +use super::{KnownClass, flatten_spine}; + +impl Checker { + pub(super) fn derive_mapping_method( + &mut self, + known: KnownClass, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + let Some(instance_type) = class_arguments.first() else { + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "mapping deriving requires one type argument", + ); + }; + let instance_type = self.resolve_type(instance_type.clone()); + let (head, arguments) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "mapping deriving requires a local type constructor", + ); + }; + let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration to derive a mapping", + ); + }; + let is_bi = matches!(known, KnownClass::Bifunctor | KnownClass::Profunctor); + let arity = if is_bi { 2 } else { 1 }; + if type_id.module != self.env.module_id + || !matches!( + declaration.kind, + hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype + ) + || declaration.parameters.len() < arity + || arguments.len() + arity != declaration.parameters.len() + { + return self.deriving_error(TypeCheckErrorKind::ExpectedTypeConstructor, span, "mapping deriving requires a local type constructor applied to all but its mapped parameters"); + } + let left_parameter = is_bi.then(|| { + declaration.parameters[declaration.parameters.len() - 2] + .name + .as_str() + }); + let right_parameter = &declaration.parameters.last()?.name; + let usages = match self.validate_field_usage( + &declaration, + MappingClasses::covariant(), + left_parameter, + right_parameter, + ( + known == KnownClass::Profunctor, + known == KnownClass::Contravariant, + ), + &arguments, + ) { + Ok(usages) => usages, + Err(offending) => { + return self.deriving_error( + TypeCheckErrorKind::CannotDeriveInvalidConstructorArg, + offending, + "mapping deriving cannot map a parameter occurrence in this field", + ); + } + }; + let methods = MappingMethods { + mono: self.known_method(KnownClass::Functor, "map"), + bi: self.known_method(KnownClass::Bifunctor, "bimap"), + contra: self.known_method(KnownClass::Contravariant, "cmap"), + pro: self.known_method(KnownClass::Profunctor, "dimap"), + pro_left: self.known_method(KnownClass::Profunctor, "lcmap"), + }; + let left = self.fresh_deriving_binder("__derived_f", span); + let right = if is_bi { + self.fresh_deriving_binder("__derived_g", span) + } else { + left.clone() + }; + let left_expr = local_expr(left.id, span); + let right_expr = local_expr(right.id, span); + let value = self.fresh_deriving_binder("__derived_value", span); + let mut branches = Vec::new(); + for (constructor, usages) in declaration.constructors.iter().zip(usages) { + let binders = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__derived_field", span)) + .collect::>(); + let mut result = global_expr(constructor.symbol, span); + for (binder, usage) in binders.iter().zip(usages) { + let field = local_expr(binder.id, span); + let Some(mapped) = + self.map_field_usage(&usage, &methods, &left_expr, &right_expr, &field, span) + else { + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the class method required by the checked field usage", + ); + }; + result = apply_expr(result, mapped, span); + } + branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: constructor_pattern(constructor, &binders, span), + value: result, + span, + }); + } + let mut body = lambda( + value.clone(), + case_expr(local_expr(value.id, span), branches, span), + span, + ); + if is_bi { + body = lambda(right, body, span); + } + let implementation = lambda(left, body, span); + self.infer_derived_method(method, class_arguments, &implementation) + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs index afdf2b98..0229d89d 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/mod.rs @@ -3,54 +3,44 @@ use super::super::*; mod bifunctor; mod contravariant; mod eq; +mod foldable; mod functor; mod generic; +mod mapping; mod newtype; mod ord; +mod profunctor; +mod registry; +mod syntax; +mod traversable; mod types; +mod usage; -pub(crate) use types::contains_wildcard; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -enum KnownDerivingClass { - Eq, - Eq1, - Ord, - Ord1, - Newtype, - Generic, - Functor, - Bifunctor, - Contravariant, -} +pub(in crate::typecheck) use registry::{DerivingRegistry, KnownClass}; -impl KnownDerivingClass { - fn identity(self) -> (&'static str, &'static str) { - match self { - Self::Eq => ("Data.Eq", "Eq"), - Self::Eq1 => ("Data.Eq", "Eq1"), - Self::Ord => ("Data.Ord", "Ord"), - Self::Ord1 => ("Data.Ord", "Ord1"), - Self::Newtype => ("Data.Newtype", "Newtype"), - Self::Generic => ("Data.Generic.Rep", "Generic"), - Self::Functor => ("Data.Functor", "Functor"), - Self::Bifunctor => ("Data.Bifunctor", "Bifunctor"), - Self::Contravariant => ("Data.Functor.Contravariant", "Contravariant"), - } - } +pub(crate) use types::contains_wildcard; - fn method(self) -> &'static str { - match self { - Self::Eq => "eq", - Self::Eq1 => "eq1", - Self::Ord => "compare", - Self::Ord1 => "compare1", - Self::Newtype => "wrap", - Self::Generic => "to", - Self::Functor => "map", - Self::Bifunctor => "bimap", - Self::Contravariant => "cmap", - } +use syntax::{apply_expr, boolean_literal, global_expr, local_expr}; +use usage::MappingClasses; + +/// Whether a structural rule produces this class method. Used only to reject a +/// method the rule does not derive. +fn handles_method(known: KnownClass, name: &str) -> bool { + match known { + KnownClass::Eq => name == "eq", + KnownClass::Eq1 => name == "eq1", + KnownClass::Ord => name == "compare", + KnownClass::Ord1 => name == "compare1", + KnownClass::Functor => name == "map", + KnownClass::Bifunctor => name == "bimap", + KnownClass::Contravariant => name == "cmap", + KnownClass::Profunctor => name == "dimap", + KnownClass::Foldable => matches!(name, "foldMap" | "foldr" | "foldl"), + KnownClass::Bifoldable => matches!(name, "bifoldMap" | "bifoldr" | "bifoldl"), + KnownClass::Traversable => matches!(name, "traverse" | "sequence"), + KnownClass::Bitraversable => matches!(name, "bitraverse" | "bisequence"), + KnownClass::Newtype => name == "wrap", + KnownClass::Generic => matches!(name, "to" | "from"), } } @@ -80,47 +70,62 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - let Some(known_class) = self.known_deriving_class(class_id) else { + let Some(known_class) = self.env.deriving.known_class(class_id) else { return self.deriving_error( + TypeCheckErrorKind::CannotDerive, span, - "the known-class deriving rule is unavailable for this class", + "the compiler has no deriving rule for this class", ); }; - if known_class == KnownDerivingClass::Newtype { - return self.deriving_error(span, "Newtype has no derivable class methods"); + if known_class == KnownClass::Newtype { + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "Newtype has no derivable class methods", + ); } - if known_class == KnownDerivingClass::Generic { + if known_class == KnownClass::Generic { if !matches!(method.name.as_str(), "to" | "from") { - return self - .deriving_error(span, "Generic derives only its `to` and `from` methods"); + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "Generic derives only its `to` and `from` methods", + ); } return self.derive_generic_method(method, class_arguments, span); } if class.parameters.len() != 1 { - return self.deriving_error(span, "known-class deriving requires a unary class"); + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "known-class deriving requires a unary class", + ); } - if method.name != known_class.method() { + if !handles_method(known_class, &method.name) { return self.deriving_error( + TypeCheckErrorKind::CannotDerive, span, "the known-class deriving rule is unavailable for this class method", ); } match known_class { - KnownDerivingClass::Eq => self.derive_eq_method(method, class_arguments, span), - KnownDerivingClass::Eq1 => self.derive_eq1_method(method, class_arguments, span), - KnownDerivingClass::Ord => self.derive_ord_method(method, class_arguments, span), - KnownDerivingClass::Ord1 => self.derive_ord1_method(method, class_arguments, span), - KnownDerivingClass::Functor => { - self.derive_functor_method(method, class_arguments, span) + KnownClass::Eq => self.derive_eq_method(method, class_arguments, span), + KnownClass::Eq1 => self.derive_eq1_method(method, class_arguments, span), + KnownClass::Ord => self.derive_ord_method(method, class_arguments, span), + KnownClass::Ord1 => self.derive_ord1_method(method, class_arguments, span), + KnownClass::Functor => self.derive_functor_method(method, class_arguments, span), + KnownClass::Bifunctor => self.derive_bifunctor_method(method, class_arguments, span), + KnownClass::Contravariant => { + self.derive_contravariant_method(method, class_arguments, span) } - KnownDerivingClass::Bifunctor => { - self.derive_bifunctor_method(method, class_arguments, span) + KnownClass::Profunctor => self.derive_profunctor_method(method, class_arguments, span), + KnownClass::Foldable | KnownClass::Bifoldable => { + self.derive_foldable_method(known_class, method, class_arguments, span) } - KnownDerivingClass::Contravariant => { - self.derive_contravariant_method(method, class_arguments, span) + KnownClass::Traversable | KnownClass::Bitraversable => { + self.derive_traversable_method(known_class, method, class_arguments, span) } - KnownDerivingClass::Newtype => unreachable!("handled above"), - KnownDerivingClass::Generic => unreachable!("handled above"), + KnownClass::Newtype | KnownClass::Generic => unreachable!("handled above"), } } @@ -128,100 +133,64 @@ impl Checker { &mut self, class_id: hir::TypeId, class: &ClassInfo, + head: &hir::Type, head_arguments: &[InferType], span: TextRange, ) -> Option<()> { - let Some(known_class) = self.known_deriving_class(class_id) else { + let Some(known_class) = self.env.deriving.known_class(class_id) else { return self.deriving_error( + TypeCheckErrorKind::CannotDerive, span, - "the known-class deriving rule is unavailable for this class", + "the compiler has no deriving rule for this class", ); }; let expected_arity = match known_class { - KnownDerivingClass::Newtype | KnownDerivingClass::Generic => 2, + KnownClass::Newtype | KnownClass::Generic => 2, _ => 1, }; if class.parameters.len() != expected_arity || head_arguments.len() != expected_arity { return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, span, "known-class deriving requires the class's supported parameter arity", ); } + if known_class.is_head_shape() { + let (_, raw_arguments) = types::flatten_type_application(head); + let is_wildcard = raw_arguments + .last() + .is_some_and(|argument| matches!(argument.kind, hir::TypeKind::Wildcard)); + if !is_wildcard { + return self.deriving_error( + TypeCheckErrorKind::ExpectedWildcard, + span, + "the derived class's final type argument must be a type wildcard", + ); + } + } let has_required_methods = match known_class { - KnownDerivingClass::Newtype => class.methods.is_empty(), - KnownDerivingClass::Generic => ["to", "from"] + KnownClass::Newtype => class.methods.is_empty(), + KnownClass::Generic => ["to", "from"] .iter() .all(|name| class.methods.iter().any(|method| method.name == *name)), _ => class .methods .iter() - .any(|method| method.name == known_class.method()), + .any(|method| handles_method(known_class, &method.name)), }; if !has_required_methods { return self.deriving_error( + TypeCheckErrorKind::CannotDerive, span, "the class is missing the method required by its known deriving rule", ); } - if known_class == KnownDerivingClass::Newtype { - let underlying = self.newtype_underlying_type(&head_arguments[..1], span)?; - let errors_before = self.state.errors.len(); - self.unify(head_arguments[1].clone(), underlying, span); - if self.state.errors.len() != errors_before { - return None; - } - } - if known_class == KnownDerivingClass::Generic { - let representation = self.generic_representation(&head_arguments[0], span)?; - let errors_before = self.state.errors.len(); - self.unify(head_arguments[1].clone(), representation, span); - if self.state.errors.len() != errors_before { - return None; - } - } Some(()) } - fn known_method_symbol( - &self, - module_name: &str, - class_name: &str, - method_name: &str, - ) -> Option { - let class_id = self.env.type_names.iter().find_map(|(class_id, name)| { - (name == class_name - && self - .env - .type_modules - .get(class_id) - .is_some_and(|module| module == module_name)) - .then_some(*class_id) - })?; - self.env - .classes - .get(&class_id)? - .methods - .iter() - .find(|method| method.name == method_name) - .map(|method| method.symbol) - } - - fn known_deriving_class(&self, class_id: hir::TypeId) -> Option { - let module = self.env.type_modules.get(&class_id)?.as_str(); - let name = self.env.type_names.get(&class_id)?.as_str(); - [ - KnownDerivingClass::Eq, - KnownDerivingClass::Eq1, - KnownDerivingClass::Ord, - KnownDerivingClass::Ord1, - KnownDerivingClass::Newtype, - KnownDerivingClass::Generic, - KnownDerivingClass::Functor, - KnownDerivingClass::Bifunctor, - KnownDerivingClass::Contravariant, - ] - .into_iter() - .find(|known| known.identity() == (module, name)) + /// A known class's method symbol by method name, read from the registry. + fn known_method(&self, known: KnownClass, name: &str) -> Option { + self.env.deriving.method(known, name) } fn fresh_deriving_local(&mut self, prefix: &str, span: TextRange) -> hir::LocalBinder { @@ -240,14 +209,13 @@ impl Checker { pub(in crate::typecheck::classes) fn deriving_error( &mut self, + kind: TypeCheckErrorKind, span: TextRange, message: &str, ) -> Option { - self.state.errors.push(TypeCheckError::new( - TypeCheckErrorKind::UnsupportedClass, - span, - message, - )); + self.state + .errors + .push(TypeCheckError::new(kind, span, message)); None } } @@ -274,35 +242,3 @@ fn flatten_spine(ty: &InferType) -> (&InferType, Vec) { arguments.reverse(); (head, arguments) } - -fn local_expr(local: LocalId, span: TextRange) -> hir::Expr { - hir::Expr { - kind: hir::ExprKind::Local(local), - span, - } -} - -fn global_expr(symbol: SymbolId, span: TextRange) -> hir::Expr { - hir::Expr { - kind: hir::ExprKind::Global(symbol), - span, - } -} - -fn apply_expr(function: hir::Expr, argument: hir::Expr, span: TextRange) -> hir::Expr { - hir::Expr { - kind: hir::ExprKind::Application(Box::new(function), Box::new(argument)), - span, - } -} - -fn boolean_literal(value: bool, span: TextRange) -> hir::Expr { - global_expr( - if value { - hir::Intrinsic::BoolTrue.symbol() - } else { - hir::Intrinsic::BoolFalse.symbol() - }, - span, - ) -} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs index 487924d6..3f75eea2 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs @@ -16,9 +16,13 @@ impl Checker { span: TextRange, ) -> Option { if class.parameters.len() != class_arguments.len() { - return self.deriving_error(span, "derive newtype class head has the wrong arity"); + return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, + span, + "derive newtype class head has the wrong arity", + ); } - let underlying = self.newtype_underlying_type(class_arguments, span)?; + let underlying = self.newtype_underlying_type(class_arguments, span, false)?; let mut underlying_arguments = class_arguments.to_vec(); *underlying_arguments.last_mut()? = underlying; @@ -91,16 +95,18 @@ impl Checker { class_arguments: &[InferType], span: TextRange, ) -> Option { - self.newtype_underlying_type(class_arguments, span) + self.newtype_underlying_type(class_arguments, span, false) } - pub(super) fn newtype_underlying_type( + pub(in crate::typecheck::classes) fn newtype_underlying_type( &mut self, class_arguments: &[InferType], span: TextRange, + deriving_newtype_class: bool, ) -> Option { let Some(newtype) = class_arguments.last() else { return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, span, "derive newtype requires a class with a final type parameter", ); @@ -109,27 +115,46 @@ impl Checker { let (head, arguments) = flatten_spine(&resolved_newtype); let InferType::Constructor(TypeConstructor::User(type_id)) = head else { return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, span, "derive newtype requires its final class argument to be a newtype constructor", ); }; let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error(span, "cannot find the newtype declaration to derive"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the newtype declaration to derive", + ); }; if declaration.kind != hir::TypeDeclarationKind::Newtype || type_id.module != self.env.module_id || arguments.len() > declaration.parameters.len() { + let kind = if deriving_newtype_class + && declaration.kind == hir::TypeDeclarationKind::Data + && type_id.module == self.env.module_id + { + TypeCheckErrorKind::CannotDeriveNewtypeForData + } else { + TypeCheckErrorKind::InvalidNewtypeInstance + }; return self.deriving_error( + kind, span, "derive newtype requires a locally declared newtype constructor", ); } let Some(constructor) = declaration.constructors.first() else { - return self.deriving_error(span, "the newtype has no data constructor"); + return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, + span, + "the newtype has no data constructor", + ); }; let [field] = constructor.fields.as_slice() else { return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, span, "derive newtype requires a constructor with exactly one field", ); @@ -150,6 +175,7 @@ impl Checker { let underlying = self.elaborate_type(field, &mut newtype_variables); let Some(underlying) = strip_newtype_arguments(underlying, &omitted_arguments, self) else { return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, span, "the wrapped type must end in every unapplied newtype parameter", ); diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs index c792e043..e83181bc 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/ord.rs @@ -1,5 +1,8 @@ use super::super::super::*; -use super::{flatten_spine, is_applied_variable}; +use super::{KnownClass, apply_expr, flatten_spine, global_expr, is_applied_variable, local_expr}; +use crate::typecheck::classes::deriving::syntax::{ + case_expr, lambda, symbol_pattern, variable_pattern, +}; #[derive(Clone, Copy)] struct OrdFieldContext { @@ -31,19 +34,24 @@ impl Checker { return None; }; self.env.type_declarations.get(type_id).map(|declaration| { - declaration - .constructors - .iter() - .any(|constructor| constructor.fields.iter().any(is_applied_variable)) + declaration.constructors.iter().any(|constructor| { + constructor + .fields + .iter() + .any(|field| is_applied_variable(&self.normalize_deriving_type(field))) + }) }) }) .unwrap_or(false); let field_method = if needs_ord1 { - match self.known_method_symbol("Data.Ord", "Ord1", "compare1") { + match self.known_method(KnownClass::Ord1, "compare1") { Some(method) => Some(method), None => { - return self - .deriving_error(span, "cannot find the Ord1 method for Ord deriving"); + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "cannot find the Ord1 method for Ord deriving", + ); } } } else { @@ -62,8 +70,12 @@ impl Checker { // applied argument: `compare1 = compare`. The matching `Ord` instance // supplies the dictionary, so its context must be visible alongside the // method's. - let Some(compare_method) = self.known_method_symbol("Data.Ord", "Ord", "compare") else { - return self.deriving_error(span, "cannot find the Ord method for Ord1 deriving"); + let Some(compare_method) = self.known_method(KnownClass::Ord, "compare") else { + return self.deriving_error( + TypeCheckErrorKind::CannotDerive, + span, + "cannot find the Ord method for Ord1 deriving", + ); }; let implementation = global_expr(compare_method, span); self.infer_derived_method(method, class_arguments, &implementation) @@ -78,18 +90,27 @@ impl Checker { span: TextRange, ) -> Option { let Some(instance_type) = class_arguments.first() else { - return self.deriving_error(span, "Ord deriving requires one type argument"); + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "Ord deriving requires one type argument", + ); }; let instance_type = self.resolve_type(instance_type.clone()); let (head, arguments) = flatten_spine(&instance_type); let InferType::Constructor(TypeConstructor::User(type_id)) = head else { return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, span, "Ord deriving requires a local data or newtype constructor", ); }; let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { - return self.deriving_error(span, "cannot find the data declaration to derive Ord"); + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration to derive Ord", + ); }; if type_id.module != self.env.module_id || !matches!( @@ -99,28 +120,21 @@ impl Checker { || declaration.parameters.len() != arguments.len() { return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, span, "Ord deriving requires a locally declared, fully applied data type", ); } - let Some(ordering_id) = ordering_result_id(&method.signature) else { + let Some(ordering) = self.env.deriving.ordering() else { return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, span, - "Ord deriving requires a method returning the Ordering data type", + "cannot find the Data.Ordering data declaration", ); }; - let Some(ordering) = self.env.type_declarations.get(&ordering_id) else { - return self.deriving_error(span, "cannot find the Ordering data declaration"); - }; - let Some(less) = nullary_constructor(ordering, "LT") else { - return self.deriving_error(span, "Ordering must define a nullary LT constructor"); - }; - let Some(equal) = nullary_constructor(ordering, "EQ") else { - return self.deriving_error(span, "Ordering must define a nullary EQ constructor"); - }; - let Some(greater) = nullary_constructor(ordering, "GT") else { - return self.deriving_error(span, "Ordering must define a nullary GT constructor"); - }; + let less = ordering.lt; + let equal = ordering.eq; + let greater = ordering.gt; let left = self.fresh_deriving_binder("__derived_left", span); let right = self.fresh_deriving_binder("__derived_right", span); @@ -139,6 +153,11 @@ impl Checker { .iter() .map(|_| self.fresh_deriving_binder("__derived_l", span)) .collect::>(); + let field_types = constructor + .fields + .iter() + .map(|field| self.normalize_deriving_type(field)) + .collect::>(); let mut right_branches = Vec::new(); for (right_index, other) in declaration.constructors.iter().enumerate() { let result_symbol = match left_index.cmp(&right_index) { @@ -152,12 +171,7 @@ impl Checker { .map(|_| self.fresh_deriving_binder("__derived_r", span)) .collect::>(); let value = if left_index == right_index { - derive_ord_field_tests( - &constructor.fields, - &left_fields, - &right_fields, - field_context, - ) + derive_ord_field_tests(&field_types, &left_fields, &right_fields, field_context) } else { global_expr(result_symbol, span) }; @@ -168,13 +182,7 @@ impl Checker { span, }); } - let right_case = hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(right.id, span)), - branches: right_branches, - }, - span, - }; + let right_case = case_expr(local_expr(right.id, span), right_branches, span); left_branches.push(hir::CaseBranch { coverage: hir::CaseBranchCoverage::Source, pattern: constructor_pattern(constructor.symbol, &left_fields, span), @@ -185,33 +193,20 @@ impl Checker { if left_branches.is_empty() { left_branches.push(hir::CaseBranch { coverage: hir::CaseBranchCoverage::Source, - pattern: hir::Pattern { - kind: hir::PatternKind::Wildcard, - span, - }, + pattern: crate::typecheck::classes::deriving::syntax::wildcard_pattern(span), value: global_expr(equal, span), span, }); } - let implementation = hir::Expr { - kind: hir::ExprKind::Lambda { - binder: left.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Lambda { - binder: right.clone(), - body: Box::new(hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(local_expr(left.id, span)), - branches: left_branches, - }, - span, - }), - }, - span, - }), - }, + let implementation = lambda( + left.clone(), + lambda( + right.clone(), + case_expr(local_expr(left.id, span), left_branches, span), + span, + ), span, - }; + ); self.infer_derived_method(method, class_arguments, &implementation) } } @@ -243,17 +238,15 @@ fn derive_ord_field_tests( local_expr(right.id, span), span, ); - hir::Expr { - kind: hir::ExprKind::Case { - scrutinee: Box::new(compared), - branches: vec![ - ordering_branch(less, global_expr(less, span), span), - ordering_branch(equal, rest, span), - ordering_branch(greater, global_expr(greater, span), span), - ], - }, + case_expr( + compared, + vec![ + ordering_branch(less, global_expr(less, span), span), + ordering_branch(equal, rest, span), + ordering_branch(greater, global_expr(greater, span), span), + ], span, - } + ) }, ) } @@ -272,60 +265,12 @@ fn constructor_pattern( arguments: &[hir::LocalBinder], span: TextRange, ) -> hir::Pattern { - hir::Pattern { - kind: hir::PatternKind::Constructor { - symbol, - name_span: span, - arguments: arguments - .iter() - .map(|binder| hir::Pattern { - kind: hir::PatternKind::Var(binder.clone()), - span, - }) - .collect(), - }, - span, - } -} - -fn nullary_constructor(declaration: &hir::TypeDeclaration, name: &str) -> Option { - declaration - .constructors - .iter() - .find(|constructor| constructor.name == name && constructor.fields.is_empty()) - .map(|constructor| constructor.symbol) -} - -fn ordering_result_id(mut ty: &hir::Type) -> Option { - loop { - match &ty.kind { - hir::TypeKind::Forall { body, .. } | hir::TypeKind::Constrained { body, .. } => { - ty = body; - } - hir::TypeKind::Function { result, .. } => ty = result, - hir::TypeKind::Named(id) => return Some(*id), - _ => return None, - } - } -} - -fn local_expr(local: LocalId, span: TextRange) -> hir::Expr { - hir::Expr { - kind: hir::ExprKind::Local(local), - span, - } -} - -fn global_expr(symbol: SymbolId, span: TextRange) -> hir::Expr { - hir::Expr { - kind: hir::ExprKind::Global(symbol), + symbol_pattern( + symbol, + arguments + .iter() + .map(|binder| variable_pattern(binder, span)) + .collect(), span, - } -} - -fn apply_expr(function: hir::Expr, argument: hir::Expr, span: TextRange) -> hir::Expr { - hir::Expr { - kind: hir::ExprKind::Application(Box::new(function), Box::new(argument)), - span, - } + ) } diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/profunctor.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/profunctor.rs new file mode 100644 index 00000000..0ddc7208 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/profunctor.rs @@ -0,0 +1,13 @@ +use super::super::super::*; +use super::KnownClass; + +impl Checker { + pub(super) fn derive_profunctor_method( + &mut self, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + self.derive_mapping_method(KnownClass::Profunctor, method, class_arguments, span) + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/registry.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/registry.rs new file mode 100644 index 00000000..3a38d5a6 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/registry.rs @@ -0,0 +1,321 @@ +//! The single table of compiler-known deriving classes and the representation +//! declarations their rules name. +//! +//! The table is built once from the resolved declarations and read by +//! `TypeId`; no deriving rule compares a class module or name at use time. The +//! declaring module and short name are inputs to construction only, so a +//! re-export keeps the defining identity and an unrelated same-name class gains +//! no rule. See [deriving](../../../../docs/design/frontend/type-system/deriving.md). + +use super::super::super::*; + +/// A class with a compiler-supported deriving rule. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub(in crate::typecheck) enum KnownClass { + Eq, + Eq1, + Ord, + Ord1, + Functor, + Bifunctor, + Contravariant, + Profunctor, + Foldable, + Bifoldable, + Traversable, + Bitraversable, + Newtype, + Generic, +} + +const ALL_KNOWN_CLASSES: [KnownClass; 14] = [ + KnownClass::Eq, + KnownClass::Eq1, + KnownClass::Ord, + KnownClass::Ord1, + KnownClass::Functor, + KnownClass::Bifunctor, + KnownClass::Contravariant, + KnownClass::Profunctor, + KnownClass::Foldable, + KnownClass::Bifoldable, + KnownClass::Traversable, + KnownClass::Bitraversable, + KnownClass::Newtype, + KnownClass::Generic, +]; + +impl KnownClass { + /// The declaring module and class name this rule is pinned to. This is a + /// construction-time key, not a use-time predicate. + pub(in crate::typecheck) fn identity(self) -> (&'static str, &'static str) { + match self { + Self::Eq => ("Data.Eq", "Eq"), + Self::Eq1 => ("Data.Eq", "Eq1"), + Self::Ord => ("Data.Ord", "Ord"), + Self::Ord1 => ("Data.Ord", "Ord1"), + Self::Functor => ("Data.Functor", "Functor"), + Self::Bifunctor => ("Data.Bifunctor", "Bifunctor"), + Self::Contravariant => ("Data.Functor.Contravariant", "Contravariant"), + Self::Profunctor => ("Data.Profunctor", "Profunctor"), + Self::Foldable => ("Data.Foldable", "Foldable"), + Self::Bifoldable => ("Data.Bifoldable", "Bifoldable"), + Self::Traversable => ("Data.Traversable", "Traversable"), + Self::Bitraversable => ("Data.Bitraversable", "Bitraversable"), + Self::Newtype => ("Data.Newtype", "Newtype"), + Self::Generic => ("Data.Generic.Rep", "Generic"), + } + } + + /// Whether the rule only fixes the instance head's final type argument + /// (Newtype, Generic) rather than deriving method bodies from fields. + pub(in crate::typecheck) fn is_head_shape(self) -> bool { + matches!(self, Self::Newtype | Self::Generic) + } +} + +/// The `Data.Ordering` constructors an `Ord` rule names. +#[derive(Clone, Copy, Debug)] +pub(in crate::typecheck) struct OrderingRep { + pub(in crate::typecheck) lt: SymbolId, + pub(in crate::typecheck) eq: SymbolId, + pub(in crate::typecheck) gt: SymbolId, +} + +/// The `Data.Generic.Rep` types and constructors a `Generic` rule names. +#[derive(Clone, Copy, Debug)] +pub(in crate::typecheck) struct GenericRep { + constructor_ty: hir::TypeId, + no_constructors: hir::TypeId, + no_arguments: hir::TypeId, + argument: hir::TypeId, + product: hir::TypeId, + sum: hir::TypeId, + constructor_ctor: SymbolId, + no_arguments_ctor: SymbolId, + argument_ctor: SymbolId, + product_ctor: SymbolId, + inl_ctor: SymbolId, + inr_ctor: SymbolId, +} + +impl GenericRep { + /// The representation type named `name`. + pub(in crate::typecheck) fn type_id(&self, name: &str) -> Option { + match name { + "Constructor" => Some(self.constructor_ty), + "NoConstructors" => Some(self.no_constructors), + "NoArguments" => Some(self.no_arguments), + "Argument" => Some(self.argument), + "Product" => Some(self.product), + "Sum" => Some(self.sum), + _ => None, + } + } + + /// The representation constructor named `name`. `Inl` and `Inr` are the + /// `Sum` constructors. + pub(in crate::typecheck) fn constructor(&self, name: &str) -> Option { + match name { + "Constructor" => Some(self.constructor_ctor), + "NoArguments" => Some(self.no_arguments_ctor), + "Argument" => Some(self.argument_ctor), + "Product" => Some(self.product_ctor), + "Inl" => Some(self.inl_ctor), + "Inr" => Some(self.inr_ctor), + _ => None, + } + } +} + +impl OrderingRep { + fn build(env: &SemanticEnv) -> Option { + let (_, declaration) = find_std_type(env, "Data.Ordering", "Ordering")?; + Some(Self { + lt: nullary_constructor(declaration, "LT")?, + eq: nullary_constructor(declaration, "EQ")?, + gt: nullary_constructor(declaration, "GT")?, + }) + } +} + +impl GenericRep { + fn build(env: &SemanticEnv) -> Option { + let (constructor_ty, constructor_declaration) = + find_std_type(env, "Data.Generic.Rep", "Constructor")?; + let (no_constructors, _) = find_std_type(env, "Data.Generic.Rep", "NoConstructors")?; + let (no_arguments, no_arguments_declaration) = + find_std_type(env, "Data.Generic.Rep", "NoArguments")?; + let (argument, argument_declaration) = find_std_type(env, "Data.Generic.Rep", "Argument")?; + let (product, product_declaration) = find_std_type(env, "Data.Generic.Rep", "Product")?; + let (sum, sum_declaration) = find_std_type(env, "Data.Generic.Rep", "Sum")?; + Some(Self { + constructor_ty, + no_constructors, + no_arguments, + argument, + product, + sum, + constructor_ctor: constructor_symbol(constructor_declaration, "Constructor")?, + no_arguments_ctor: constructor_symbol(no_arguments_declaration, "NoArguments")?, + argument_ctor: constructor_symbol(argument_declaration, "Argument")?, + product_ctor: constructor_symbol(product_declaration, "Product")?, + inl_ctor: constructor_symbol(sum_declaration, "Inl")?, + inr_ctor: constructor_symbol(sum_declaration, "Inr")?, + }) + } +} + +/// The single source of "which classes the compiler knows" and the symbols +/// their rules name. Built once when the semantic environment is constructed. +#[derive(Clone, Debug, Default)] +pub(in crate::typecheck) struct DerivingRegistry { + classes: HashMap, + ids: HashMap, + methods: HashMap<(KnownClass, String), SymbolId>, + values: HashMap<(String, String), SymbolId>, + ordering: Option, + generic: Option, +} + +impl DerivingRegistry { + pub(in crate::typecheck) fn build( + env: &SemanticEnv, + known_values: &[hir::Declaration], + module_names: &HashMap, + ) -> Self { + let mut registry = Self::default(); + for (class_id, class) in &env.classes { + let Some(module) = env.type_modules.get(class_id).map(String::as_str) else { + continue; + }; + let Some(name) = env.type_names.get(class_id).map(String::as_str) else { + continue; + }; + let Some(known) = ALL_KNOWN_CLASSES + .into_iter() + .find(|known| known.identity() == (module, name)) + else { + continue; + }; + registry.classes.insert(*class_id, known); + registry.ids.insert(known, *class_id); + for method in &class.methods { + registry + .methods + .insert((known, method.name.clone()), method.symbol); + } + } + // A class method is a value too: `append`, `mempty`, `apply`, and + // `pure` are methods of classes that are not deriving classes, so the + // fold and traversal rules reach them through the value table. + for (class_id, class) in &env.classes { + let Some(module) = env.type_modules.get(class_id) else { + continue; + }; + for method in &class.methods { + registry + .values + .insert((module.clone(), method.name.clone()), method.symbol); + } + } + for declaration in known_values { + if let Some(module) = module_names.get(&declaration.symbol.module) { + registry.values.insert( + (module.clone(), declaration.name.clone()), + declaration.symbol, + ); + } + } + registry.ordering = OrderingRep::build(env); + registry.generic = GenericRep::build(env); + registry + } + + /// The deriving rule for a resolved class identity, if the compiler knows + /// one. + pub(in crate::typecheck) fn known_class(&self, class_id: hir::TypeId) -> Option { + self.classes.get(&class_id).copied() + } + + /// The resolved class identity of a known class, for consulting the visible + /// instance environment. + pub(in crate::typecheck) fn class_id(&self, known: KnownClass) -> Option { + self.ids.get(&known).copied() + } + + /// A known class's method symbol by method name. + pub(in crate::typecheck) fn method(&self, known: KnownClass, name: &str) -> Option { + self.methods.get(&(known, name.to_owned())).copied() + } + + pub(in crate::typecheck) fn ordering(&self) -> Option { + self.ordering + } + + pub(in crate::typecheck) fn generic_rep(&self) -> Option { + self.generic + } + + /// A program value by declaring module and name. + pub(in crate::typecheck) fn value(&self, module: &str, name: &str) -> Option { + self.values + .get(&(module.to_owned(), name.to_owned())) + .copied() + } + + /// `Data.Semigroup.append`. + pub(in crate::typecheck) fn append(&self) -> Option { + self.value("Data.Semigroup", "append") + } + + /// `Data.Monoid.mempty`. + pub(in crate::typecheck) fn mempty(&self) -> Option { + self.value("Data.Monoid", "mempty") + } + + /// The canonical `Control.Category.identity`, re-exported by Data.Function. + /// Standalone source fixtures may provide the ordinary function directly. + pub(in crate::typecheck) fn identity(&self) -> Option { + self.value("Control.Category", "identity") + .or_else(|| self.value("Data.Function", "identity")) + } + + /// `Control.Apply.apply`. + pub(in crate::typecheck) fn apply(&self) -> Option { + self.value("Control.Apply", "apply") + } + + /// `Control.Applicative.pure`. + pub(in crate::typecheck) fn pure(&self) -> Option { + self.value("Control.Applicative", "pure") + } +} + +/// The declaration of `module.name` among the program's resolved types. +fn find_std_type<'a>( + env: &'a SemanticEnv, + module: &str, + name: &str, +) -> Option<(hir::TypeId, &'a hir::TypeDeclaration)> { + env.type_declarations.iter().find_map(|(id, declaration)| { + (declaration.name == name && env.type_modules.get(id).map(String::as_str) == Some(module)) + .then_some((*id, declaration)) + }) +} + +fn nullary_constructor(declaration: &hir::TypeDeclaration, name: &str) -> Option { + declaration + .constructors + .iter() + .find(|constructor| constructor.name == name && constructor.fields.is_empty()) + .map(|constructor| constructor.symbol) +} + +fn constructor_symbol(declaration: &hir::TypeDeclaration, name: &str) -> Option { + declaration + .constructors + .iter() + .find(|constructor| constructor.name == name) + .map(|constructor| constructor.symbol) +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/syntax.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/syntax.rs new file mode 100644 index 00000000..a128f32d --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/syntax.rs @@ -0,0 +1,153 @@ +//! The one term builder every structural deriving rule uses. +//! +//! A rule states its traversal; the lambdas, cases, applications, and literals +//! it emits are constructed here, so no rule builds resolved HIR by hand. The +//! output is ordinary resolved HIR and is checked by the normal inference path. + +use super::super::super::*; + +pub(super) fn local_expr(local: LocalId, span: TextRange) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::Local(local), + span, + } +} + +pub(super) fn global_expr(symbol: SymbolId, span: TextRange) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::Global(symbol), + span, + } +} + +pub(super) fn apply_expr(function: hir::Expr, argument: hir::Expr, span: TextRange) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::Application(Box::new(function), Box::new(argument)), + span, + } +} + +pub(super) fn boolean_literal(value: bool, span: TextRange) -> hir::Expr { + global_expr( + if value { + hir::Intrinsic::BoolTrue.symbol() + } else { + hir::Intrinsic::BoolFalse.symbol() + }, + span, + ) +} + +pub(super) fn lambda(binder: hir::LocalBinder, body: hir::Expr, span: TextRange) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::Lambda { + binder, + body: Box::new(body), + }, + span, + } +} + +pub(super) fn case_expr( + value: hir::Expr, + branches: Vec, + span: TextRange, +) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::Case { + scrutinee: Box::new(value), + branches, + }, + span, + } +} + +pub(super) fn constructor_pattern( + constructor: &hir::Constructor, + binders: &[hir::LocalBinder], + span: TextRange, +) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Constructor { + symbol: constructor.symbol, + name_span: constructor.name_span, + arguments: binders + .iter() + .map(|binder| hir::Pattern { + kind: hir::PatternKind::Var(binder.clone()), + span, + }) + .collect(), + }, + span, + } +} + +pub(super) fn field_expr(value: hir::Expr, field: &str, span: TextRange) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::FieldAccess { + expression: Box::new(value), + field: field.into(), + }, + span, + } +} + +pub(super) fn record_update( + value: hir::Expr, + fields: Vec<(String, hir::Expr)>, + span: TextRange, +) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::RecordUpdate { + expression: Box::new(value), + fields, + }, + span, + } +} + +pub(super) fn if_expr( + condition: hir::Expr, + then_branch: hir::Expr, + else_branch: hir::Expr, + span: TextRange, +) -> hir::Expr { + hir::Expr { + kind: hir::ExprKind::If { + condition: Box::new(condition), + then_branch: Box::new(then_branch), + else_branch: Box::new(else_branch), + }, + span, + } +} + +pub(super) fn variable_pattern(binder: &hir::LocalBinder, span: TextRange) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Var(binder.clone()), + span, + } +} + +pub(super) fn wildcard_pattern(span: TextRange) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Wildcard, + span, + } +} + +pub(super) fn symbol_pattern( + symbol: SymbolId, + arguments: Vec, + span: TextRange, +) -> hir::Pattern { + hir::Pattern { + kind: hir::PatternKind::Constructor { + symbol, + name_span: span, + arguments, + }, + span, + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/traversable.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/traversable.rs new file mode 100644 index 00000000..da91ad92 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/traversable.rs @@ -0,0 +1,395 @@ +//! `Traversable` and `Bitraversable` deriving. +//! +//! `traverse` runs an effect for each parameter occurrence and rebuilds the +//! constructor inside the applicative: `map C e1 <*> e2 ...`. Inert fields are +//! carried through unchanged, and a nested occurrence recurses through the +//! `Traversable`/`Bitraversable` instance. `sequence` is `traverse identity`. + +use super::super::super::*; +use super::syntax::{constructor_pattern, field_expr, record_update}; +use super::usage::FieldUsage; +use super::{KnownClass, MappingClasses, apply_expr, flatten_spine, global_expr, local_expr}; +use crate::typecheck::classes::deriving::syntax::{case_expr, lambda}; + +#[derive(Clone, Copy)] +struct TraverseOps { + traverse: Option, + bitraverse: Option, + map: Option, + apply: Option, + pure: Option, + identity: Option, +} + +#[derive(Clone, Copy)] +struct TraverseContext<'a> { + ops: TraverseOps, + left: &'a hir::Expr, + right: &'a hir::Expr, + span: TextRange, +} + +impl Checker { + pub(super) fn derive_traversable_method( + &mut self, + known: KnownClass, + method: &MethodInfo, + class_arguments: &[InferType], + span: TextRange, + ) -> Option { + let is_bi = known == KnownClass::Bitraversable; + let Some(instance_type) = class_arguments.first() else { + return self.deriving_error( + TypeCheckErrorKind::InvalidDerivedInstance, + span, + "traversal deriving requires one type argument", + ); + }; + let instance_type = self.resolve_type(instance_type.clone()); + let (head, arguments) = flatten_spine(&instance_type); + let InferType::Constructor(TypeConstructor::User(type_id)) = head else { + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "traversal deriving requires a local type constructor", + ); + }; + let Some(declaration) = self.env.type_declarations.get(type_id).cloned() else { + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "cannot find the data declaration to derive a traversal", + ); + }; + let arity = if is_bi { 2 } else { 1 }; + if type_id.module != self.env.module_id + || !matches!( + declaration.kind, + hir::TypeDeclarationKind::Data | hir::TypeDeclarationKind::Newtype + ) + || declaration.parameters.len() < arity + || arguments.len() + arity != declaration.parameters.len() + { + return self.deriving_error( + TypeCheckErrorKind::ExpectedTypeConstructor, + span, + "traversal deriving requires a local type constructor applied to all but its final parameters", + ); + } + let lparam = is_bi.then(|| { + declaration.parameters[declaration.parameters.len() - 2] + .name + .as_str() + }); + let param = &declaration.parameters[declaration.parameters.len() - 1].name; + let usages = match self.validate_field_usage( + &declaration, + MappingClasses::traversable(), + lparam, + param, + (false, false), + &arguments, + ) { + Ok(usages) => usages, + Err(offending) => { + return self.deriving_error( + TypeCheckErrorKind::CannotDeriveInvalidConstructorArg, + offending, + "traversal deriving cannot map a parameter occurrence in this field", + ); + } + }; + let ops = self.traverse_ops(); + if matches!(method.name.as_str(), "traverse" | "bitraverse") { + let traversal_method = if is_bi { ops.bitraverse } else { ops.traverse }; + if ops.map.is_none() + || ops.apply.is_none() + || ops.pure.is_none() + || traversal_method.is_none() + { + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "traversal deriving requires the Functor, Apply, and Applicative classes", + ); + } + } else { + let traversal_method = if is_bi { ops.bitraverse } else { ops.traverse }; + if ops.identity.is_none() || traversal_method.is_none() { + return self.deriving_error( + TypeCheckErrorKind::CannotFindDerivingType, + span, + "sequence deriving requires the registered identity and the traversal method", + ); + } + } + let value = self.fresh_deriving_binder("__derived_value", span); + let implementation = if matches!(method.name.as_str(), "sequence" | "bisequence") { + let identity = global_expr(ops.identity?, span); + let traversing = if is_bi { + apply_expr( + apply_expr(global_expr(ops.bitraverse?, span), identity.clone(), span), + identity, + span, + ) + } else { + apply_expr(global_expr(ops.traverse?, span), identity, span) + }; + lambda( + value.clone(), + apply_expr(traversing, local_expr(value.id, span), span), + span, + ) + } else { + let left = self.fresh_deriving_binder("__derived_f", span); + let right = if is_bi { + self.fresh_deriving_binder("__derived_g", span) + } else { + left.clone() + }; + let left_expr = local_expr(left.id, span); + let right_expr = local_expr(right.id, span); + let context = TraverseContext { + ops, + left: &left_expr, + right: &right_expr, + span, + }; + let mut branches = Vec::with_capacity(declaration.constructors.len()); + for (constructor, field_usages) in declaration.constructors.iter().zip(&usages) { + let binders = constructor + .fields + .iter() + .map(|_| self.fresh_deriving_binder("__derived_field", span)) + .collect::>(); + let body = self.traverse_branch(constructor, &binders, field_usages, &context)?; + branches.push(hir::CaseBranch { + coverage: hir::CaseBranchCoverage::Source, + pattern: constructor_pattern(constructor, &binders, span), + value: body, + span, + }); + } + let mut body = case_expr(local_expr(value.id, span), branches, span); + body = lambda(value, body, span); + if is_bi { + body = lambda(right, body, span); + } + lambda(left, body, span) + }; + self.infer_derived_method(method, class_arguments, &implementation) + } + + fn traverse_ops(&self) -> TraverseOps { + TraverseOps { + traverse: self.known_method(KnownClass::Traversable, "traverse"), + bitraverse: self.known_method(KnownClass::Bitraversable, "bitraverse"), + map: self.known_method(KnownClass::Functor, "map"), + apply: self.env.deriving.apply(), + pure: self.env.deriving.pure(), + identity: self.env.deriving.identity(), + } + } + + fn traverse_branch( + &mut self, + constructor: &hir::Constructor, + binders: &[hir::LocalBinder], + usages: &[FieldUsage], + context: &TraverseContext<'_>, + ) -> Option { + let TraverseContext { + ref ops, + left, + right, + span, + } = *context; + let mut arguments = Vec::new(); + let mut effects = Vec::new(); + let mut effect_binders = Vec::new(); + for (binder, usage) in binders.iter().zip(usages) { + let field = local_expr(binder.id, span); + if *usage == FieldUsage::Inert { + arguments.push(field); + } else { + let effect_binder = self.fresh_deriving_binder("__derived_effect", span); + arguments.push(local_expr(effect_binder.id, span)); + effects.push(self.traverse_effect(usage, &field, ops, left, right, span)?); + effect_binders.push(effect_binder); + } + } + let mut constructed = global_expr(constructor.symbol, span); + for argument in arguments { + constructed = apply_expr(constructed, argument, span); + } + self.combine_traversal(constructed, effects, effect_binders, ops, span) + } + + fn combine_traversal( + &mut self, + constructed: hir::Expr, + effects: Vec, + effect_binders: Vec, + ops: &TraverseOps, + span: TextRange, + ) -> Option { + if effects.is_empty() { + return Some(apply_expr(global_expr(ops.pure?, span), constructed, span)); + } + let mut combine = constructed; + for binder in effect_binders.into_iter().rev() { + combine = lambda(binder, combine, span); + } + let mut effects = effects.into_iter(); + let first = effects.next()?; + let mut body = apply_expr( + apply_expr(global_expr(ops.map?, span), combine, span), + first, + span, + ); + for effect in effects { + body = apply_expr( + apply_expr(global_expr(ops.apply?, span), body, span), + effect, + span, + ); + } + Some(body) + } + + /// The effectful expression for one field occurrence. + fn traverse_effect( + &mut self, + usage: &FieldUsage, + field: &hir::Expr, + ops: &TraverseOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + let function = match usage { + FieldUsage::Record(fields) => { + return self.traverse_record(fields, field, ops, left, right, span); + } + FieldUsage::Param => right.clone(), + FieldUsage::LParam => left.clone(), + FieldUsage::Mono(inner) => apply_expr( + global_expr(ops.traverse?, span), + self.traverse_function(inner, ops, left, right, span)?, + span, + ), + FieldUsage::Bi(l, r) => apply_expr( + apply_expr( + global_expr(ops.bitraverse?, span), + self.traverse_argument(l, ops, left, right, span)?, + span, + ), + self.traverse_argument(r, ops, left, right, span)?, + span, + ), + FieldUsage::Contra(inner) | FieldUsage::Pro(inner, _) => { + return self.traverse_effect(inner, field, ops, left, right, span); + } + FieldUsage::Inert => return None, + }; + Some(apply_expr(function, field.clone(), span)) + } + + /// A traversing function `x -> f y` for a nested occurrence. + fn traverse_function( + &mut self, + usage: &FieldUsage, + ops: &TraverseOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + Some(match usage { + FieldUsage::Record(fields) => { + let binder = self.fresh_deriving_binder("__derived_record", span); + let body = self.traverse_record( + fields, + &local_expr(binder.id, span), + ops, + left, + right, + span, + )?; + lambda(binder, body, span) + } + FieldUsage::Param => right.clone(), + FieldUsage::LParam => left.clone(), + FieldUsage::Mono(inner) => apply_expr( + global_expr(ops.traverse?, span), + self.traverse_function(inner, ops, left, right, span)?, + span, + ), + FieldUsage::Bi(l, r) => apply_expr( + apply_expr( + global_expr(ops.bitraverse?, span), + self.traverse_argument(l, ops, left, right, span)?, + span, + ), + self.traverse_argument(r, ops, left, right, span)?, + span, + ), + FieldUsage::Inert => global_expr(ops.pure?, span), + FieldUsage::Contra(inner) | FieldUsage::Pro(inner, _) => { + self.traverse_function(inner, ops, left, right, span)? + } + }) + } + + fn traverse_record( + &mut self, + fields: &[(String, FieldUsage)], + record: &hir::Expr, + ops: &TraverseOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + let mut updates = Vec::new(); + let mut effects = Vec::new(); + let mut binders = Vec::new(); + for (label, usage) in fields { + if *usage == FieldUsage::Inert { + continue; + } + let binder = self.fresh_deriving_binder("__derived_effect", span); + updates.push((label.clone(), local_expr(binder.id, span))); + effects.push(self.traverse_effect( + usage, + &field_expr(record.clone(), label, span), + ops, + left, + right, + span, + )?); + binders.push(binder); + } + self.combine_traversal( + record_update(record.clone(), updates, span), + effects, + binders, + ops, + span, + ) + } + + /// A traversing argument, using `pure` for an inert side. + fn traverse_argument( + &mut self, + usage: &FieldUsage, + ops: &TraverseOps, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + if *usage == FieldUsage::Inert { + Some(global_expr(ops.pure?, span)) + } else { + self.traverse_function(usage, ops, left, right, span) + } + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mapping.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mapping.rs new file mode 100644 index 00000000..41021f81 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mapping.rs @@ -0,0 +1,104 @@ +use super::super::syntax::{ + apply_expr, field_expr, global_expr, lambda, local_expr, record_update, +}; +use super::*; + +#[derive(Clone, Copy)] +pub(in crate::typecheck::classes::deriving) struct MappingMethods { + pub mono: Option, + pub bi: Option, + pub contra: Option, + pub pro: Option, + pub pro_left: Option, +} + +impl Checker { + /// Builds exactly the mapping accepted by field-usage analysis. An inert + /// nested argument receives identity, including the unused side of bimap. + pub(in crate::typecheck::classes::deriving) fn usage_function( + &mut self, + usage: &FieldUsage, + methods: &MappingMethods, + left: &hir::Expr, + right: &hir::Expr, + span: TextRange, + ) -> Option { + Some(match usage { + FieldUsage::Inert => { + let binder = self.fresh_deriving_binder("__derived_identity", span); + lambda(binder.clone(), local_expr(binder.id, span), span) + } + FieldUsage::Param => right.clone(), + FieldUsage::LParam => left.clone(), + FieldUsage::Mono(inner) => apply_expr( + global_expr(methods.mono?, span), + self.usage_function(inner, methods, left, right, span)?, + span, + ), + FieldUsage::Contra(inner) => apply_expr( + global_expr(methods.contra?, span), + self.usage_function(inner, methods, left, right, span)?, + span, + ), + FieldUsage::Bi(l, r) => apply_expr( + apply_expr( + global_expr(methods.bi?, span), + self.usage_function(l, methods, left, right, span)?, + span, + ), + self.usage_function(r, methods, left, right, span)?, + span, + ), + FieldUsage::Pro(l, r) if **r == FieldUsage::Inert && methods.pro_left.is_some() => { + apply_expr( + global_expr(methods.pro_left?, span), + self.usage_function(l, methods, left, right, span)?, + span, + ) + } + FieldUsage::Pro(l, r) => apply_expr( + apply_expr( + global_expr(methods.pro?, span), + self.usage_function(l, methods, left, right, span)?, + span, + ), + self.usage_function(r, methods, left, right, span)?, + span, + ), + FieldUsage::Record(fields) => { + let binder = self.fresh_deriving_binder("__derived_record", span); + let value = local_expr(binder.id, span); + let mut updates = Vec::new(); + for (label, usage) in fields { + if *usage != FieldUsage::Inert { + let field = field_expr(value.clone(), label, span); + updates.push(( + label.clone(), + self.map_field_usage(usage, methods, left, right, &field, span)?, + )); + } + } + lambda(binder, record_update(value, updates, span), span) + } + }) + } + + pub(in crate::typecheck::classes::deriving) fn map_field_usage( + &mut self, + usage: &FieldUsage, + methods: &MappingMethods, + left: &hir::Expr, + right: &hir::Expr, + value: &hir::Expr, + span: TextRange, + ) -> Option { + match usage { + FieldUsage::Inert => Some(value.clone()), + _ => Some(apply_expr( + self.usage_function(usage, methods, left, right, span)?, + value.clone(), + span, + )), + } + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mod.rs new file mode 100644 index 00000000..c323abc4 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/usage/mod.rs @@ -0,0 +1,388 @@ +//! Field-usage and variance analysis for structural deriving rules. +//! +//! A rule does not decide per field whether to map, recurse, or reject from the +//! field's shape alone. It first walks the field with the class's variance and +//! the visible instance environment: a field occurrence is acceptable only when +//! the mapping class it would use has a visible instance, and a parameter used +//! at the wrong polarity is rejected. The walk returns a [`FieldUsage`] tree so +//! the generator maps exactly the occurrences the analysis accepted. The +//! official compiler performs the same walk in `TypeChecker/Deriving.hs` +//! (`validateParamsInTypeConstructors` / `typeToUsageOf`). + +use super::types::{contains_parameter, flatten_type_application}; +use super::{KnownClass, flatten_spine}; +use crate::typecheck::*; + +mod mapping; +pub(super) use mapping::MappingMethods; + +/// The classes a `Functor`-shaped rule uses to map a field: a monomorphic +/// class, a bipartite class, and the contravariant/profunctor counterparts used +/// when a field occurrence flips polarity. +#[derive(Clone, Copy)] +pub(super) struct MappingClasses { + pub mono: KnownClass, + pub bi: KnownClass, + pub contra: Option, + pub pro: Option, +} + +impl MappingClasses { + /// The covariant classes shared by `Functor`, `Bifunctor`, `Contravariant`, + /// and `Profunctor` deriving. + pub(super) fn covariant() -> Self { + Self { + mono: KnownClass::Functor, + bi: KnownClass::Bifunctor, + contra: Some(KnownClass::Contravariant), + pro: Some(KnownClass::Profunctor), + } + } + + /// The fold classes (`Foldable`/`Bifoldable`), which have no contravariant + /// counterpart. + pub(super) fn foldable() -> Self { + Self { + mono: KnownClass::Foldable, + bi: KnownClass::Bifoldable, + contra: None, + pro: None, + } + } + + /// The traversal classes (`Traversable`/`Bitraversable`). + pub(super) fn traversable() -> Self { + Self { + mono: KnownClass::Traversable, + bi: KnownClass::Bitraversable, + contra: None, + pro: None, + } + } +} + +/// How one constructor field uses the parameters. The generator maps exactly +/// the occurrences this tree records. +#[derive(Clone, Debug, PartialEq, Eq)] +pub(super) enum FieldUsage { + /// The field does not mention a mapped parameter. + Inert, + /// The field is the final (covariant) parameter itself. + Param, + /// The field is the left parameter itself (bipartite rules). + LParam, + /// The field maps through the monomorphic class, e.g. `Array a`. + Mono(Box), + /// The field maps through the bipartite class, e.g. `Either e a`. + Bi(Box, Box), + /// The field maps through the contravariant class. + Contra(Box), + /// The field maps through the profunctor class, e.g. `p a c`. + Pro(Box, Box), + /// Each record field is traversed independently in canonical label order. + Record(Vec<(String, FieldUsage)>), +} + +/// The head a field application maps through. `Arrow` is the function type, +/// which every mapping class reaches through its own instance. +#[derive(Clone, Copy)] +enum MappingHead<'a> { + Arrow, + Constructor(&'a hir::Type), +} + +struct UsageContext<'a> { + classes: MappingClasses, + fixed: HashMap, + lparam: Option<&'a str>, + param: &'a str, + lparam_contra: bool, + param_contra: bool, +} + +impl Checker { + /// Validates every constructor field of a structural derivation against the + /// class's variance and the visible instance environment, returning the + /// usage tree per constructor and field. The first unmappable occurrence's + /// span is the error; the caller reports it as + /// `CannotDeriveInvalidConstructorArg`. + pub(super) fn validate_field_usage( + &self, + declaration: &hir::TypeDeclaration, + classes: MappingClasses, + lparam: Option<&str>, + param: &str, + variance: (bool, bool), + prefix: &[InferType], + ) -> Result>, TextRange> { + let context = UsageContext { + classes, + fixed: declaration + .parameters + .iter() + .zip(prefix) + .map(|(parameter, argument)| (parameter.name.clone(), argument.clone())) + .collect(), + lparam, + param, + lparam_contra: variance.0, + param_contra: variance.1, + }; + let mut constructors = Vec::with_capacity(declaration.constructors.len()); + for constructor in &declaration.constructors { + let mut fields = Vec::with_capacity(constructor.fields.len()); + for field in &constructor.fields { + let field = self.normalize_deriving_type(field); + fields.push(self.check_field(&field, &context, false)?); + } + constructors.push(fields); + } + Ok(constructors) + } + + fn check_field( + &self, + ty: &hir::Type, + context: &UsageContext<'_>, + negative: bool, + ) -> Result { + if !mentions_parameter(ty, context.lparam, context.param) { + return Ok(FieldUsage::Inert); + } + match &ty.kind { + hir::TypeKind::Variable(name) => { + let contra = if name == context.param { + context.param_contra + } else if context.lparam == Some(name.as_str()) { + context.lparam_contra + } else { + return Ok(FieldUsage::Inert); + }; + if contra != negative { + return Err(ty.span); + } + if name == context.param { + Ok(FieldUsage::Param) + } else { + Ok(FieldUsage::LParam) + } + } + hir::TypeKind::Function { parameter, result } => { + self.try_bipartite(context, MappingHead::Arrow, parameter, result, negative) + } + hir::TypeKind::Record { fields, tail } => { + if tail + .as_deref() + .is_some_and(|tail| mentions_parameter(tail, context.lparam, context.param)) + { + return Err(ty.span); + } + let mut fields = fields + .iter() + .map(|field| { + Ok(( + field.label.clone(), + self.check_field(&field.ty, context, negative)?, + )) + }) + .collect::, TextRange>>()?; + fields.sort_by(|left, right| left.0.cmp(&right.0)); + Ok(FieldUsage::Record(fields)) + } + hir::TypeKind::Row { .. } => Err(ty.span), + hir::TypeKind::Forall { variables, body } => { + let shadows = |name: &str| variables.iter().any(|variable| variable.name == name); + let scoped = UsageContext { + classes: context.classes, + fixed: context + .fixed + .iter() + .filter(|(name, _)| !shadows(name)) + .map(|(name, ty)| (name.clone(), ty.clone())) + .collect(), + lparam: context.lparam.filter(|name| !shadows(name)), + param: if shadows(context.param) { + "" + } else { + context.param + }, + lparam_contra: context.lparam_contra, + param_contra: context.param_contra, + }; + self.check_field(body, &scoped, negative) + } + hir::TypeKind::Constrained { body, .. } => self.check_field(body, context, negative), + hir::TypeKind::Application(function, argument) => { + let (head, _) = flatten_type_application(ty); + if mentions_parameter(head, context.lparam, context.param) { + return Err(head.span); + } + match &function.kind { + hir::TypeKind::Application(inner, l_arg) => { + if mentions_parameter(inner, context.lparam, context.param) { + return Err(inner.span); + } + let head = flatten_type_application(inner).0; + self.try_bipartite( + context, + MappingHead::Constructor(head), + l_arg, + argument, + negative, + ) + } + _ => { + if mentions_parameter(function, context.lparam, context.param) { + return Err(function.span); + } + let head = flatten_type_application(function).0; + self.try_mono(context, MappingHead::Constructor(head), argument, negative) + } + } + } + _ => Ok(FieldUsage::Inert), + } + } + + /// A two-argument application: map through the bipartite class, or the + /// profunctor class with the left argument contravariant, or fall back to + /// the mono class on the final argument with the left one inert. + fn try_bipartite( + &self, + context: &UsageContext<'_>, + head: MappingHead<'_>, + l_arg: &hir::Type, + r_arg: &hir::Type, + negative: bool, + ) -> Result { + if self.has_mapping_instance(context.classes.bi, head, context) { + let left = self.check_field(l_arg, context, negative)?; + let right = self.check_field(r_arg, context, negative)?; + if left == FieldUsage::Inert + && self.has_mapping_instance(context.classes.mono, head, context) + { + return Ok(FieldUsage::Mono(Box::new(right))); + } + return Ok(FieldUsage::Bi(Box::new(left), Box::new(right))); + } + if let Some(pro) = context.classes.pro + && self.has_mapping_instance(pro, head, context) + { + let left = self.check_field(l_arg, context, !negative)?; + let right = self.check_field(r_arg, context, negative)?; + if left == FieldUsage::Inert + && self.has_mapping_instance(context.classes.mono, head, context) + { + return Ok(FieldUsage::Mono(Box::new(right))); + } + return Ok(FieldUsage::Pro(Box::new(left), Box::new(right))); + } + if mentions_parameter(l_arg, context.lparam, context.param) { + return Err(l_arg.span); + } + self.try_mono(context, head, r_arg, negative) + } + + /// A one-argument application. When no mapping instance is visible, the + /// occurrence is only inert if it does not mention a parameter. + fn try_mono( + &self, + context: &UsageContext<'_>, + head: MappingHead<'_>, + argument: &hir::Type, + negative: bool, + ) -> Result { + if self.has_mapping_instance(context.classes.mono, head, context) { + let inner = self.check_field(argument, context, negative)?; + return Ok(FieldUsage::Mono(Box::new(inner))); + } + if let Some(contra) = context.classes.contra + && self.has_mapping_instance(contra, head, context) + { + let inner = self.check_field(argument, context, !negative)?; + return Ok(FieldUsage::Contra(Box::new(inner))); + } + if mentions_parameter(argument, context.lparam, context.param) { + Err(argument.span) + } else { + Ok(FieldUsage::Inert) + } + } + + /// Whether the visible instance environment proves `known` at `head`. + fn has_mapping_instance( + &self, + known: KnownClass, + head: MappingHead<'_>, + context: &UsageContext<'_>, + ) -> bool { + let Some(class_id) = self.env.deriving.class_id(known) else { + return false; + }; + let wanted = match head { + MappingHead::Arrow => InferType::Constructor(TypeConstructor::Function), + MappingHead::Constructor(ty) => { + if let Some(constructor) = field_head_constructor(ty) { + InferType::Constructor(constructor) + } else if let hir::TypeKind::Variable(name) = &ty.kind { + let Some(actual) = context.fixed.get(name) else { + return false; + }; + flatten_spine(&self.resolve_type(actual.clone())).0.clone() + } else { + return false; + } + } + }; + let agrees = |argument: &InferType| { + let resolved = self.resolve_type(argument.clone()); + flatten_spine(&resolved).0 == &wanted + }; + if self.scope.givens.iter().any(|(constraint, _)| { + constraint.class_id == class_id + && constraint.arguments.len() == 1 + && agrees(&constraint.arguments[0]) + }) { + return true; + } + let visible = self.instance_candidate_modules(class_id, std::slice::from_ref(&wanted)); + self.env.instances.iter().any(|info| { + info.class_id == class_id + && visible.contains(&info.symbol.module) + && info.head_arguments.len() == 1 + && agrees(&info.head_arguments[0]) + }) + } +} + +fn mentions_parameter(ty: &hir::Type, lparam: Option<&str>, param: &str) -> bool { + contains_parameter(ty, param) || lparam.is_some_and(|lparam| contains_parameter(ty, lparam)) +} + +/// The constructor a field head names, or `None` when the head is a type +/// variable or a form that cannot carry an instance. +fn field_head_constructor(ty: &hir::Type) -> Option { + match &ty.kind { + hir::TypeKind::Constructor(builtin) => Some(builtin_constructor(*builtin)), + hir::TypeKind::Named(id) | hir::TypeKind::Opaque(id) => Some(TypeConstructor::User(*id)), + _ => None, + } +} + +fn builtin_constructor(builtin: hir::BuiltinType) -> TypeConstructor { + match builtin { + hir::BuiltinType::Int => TypeConstructor::Int, + hir::BuiltinType::Number => TypeConstructor::Number, + hir::BuiltinType::Boolean => TypeConstructor::Boolean, + hir::BuiltinType::String => TypeConstructor::String, + hir::BuiltinType::Char => TypeConstructor::Char, + hir::BuiltinType::Unit => TypeConstructor::Unit, + hir::BuiltinType::Array => TypeConstructor::Array, + hir::BuiltinType::Function => TypeConstructor::Function, + hir::BuiltinType::Record => TypeConstructor::Record, + hir::BuiltinType::Row => TypeConstructor::Row, + hir::BuiltinType::Type => TypeConstructor::Type, + hir::BuiltinType::Constraint => TypeConstructor::Constraint, + hir::BuiltinType::Symbol => TypeConstructor::Symbol, + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs index afc38ef3..5015a04b 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs @@ -1,6 +1,6 @@ use super::super::signature::flatten_spine; use super::super::*; -use super::deriving::contains_wildcard; +use super::deriving::{KnownClass, contains_wildcard}; use super::fundeps::collect_infer_variables; mod method; @@ -243,39 +243,18 @@ impl Checker { return; } let (_, arguments) = flatten_spine(&instance.head); - let newtype_deriving_wildcard = local + let head_shape_wildcard = local && instance.derivation == Some(hir::DerivationStrategy::KnownClass) && self .env - .type_modules - .get(&instance.class_id) - .is_some_and(|module| module == "Data.Newtype") - && self - .env - .type_names - .get(&instance.class_id) - .is_some_and(|name| name == "Newtype") - && arguments.len() == 2 - && !contains_wildcard(arguments[0]) - && matches!(arguments[1].kind, hir::TypeKind::Wildcard); - let generic_deriving_wildcard = local - && instance.derivation == Some(hir::DerivationStrategy::KnownClass) - && self - .env - .type_modules - .get(&instance.class_id) - .is_some_and(|module| module == "Data.Generic.Rep") - && self - .env - .type_names - .get(&instance.class_id) - .is_some_and(|name| name == "Generic") + .deriving + .known_class(instance.class_id) + .is_some_and(|known| known.is_head_shape()) && arguments.len() == 2 && !contains_wildcard(arguments[0]) && matches!(arguments[1].kind, hir::TypeKind::Wildcard); let has_unsupported_wildcard = arguments.iter().enumerate().any(|(index, argument)| { - contains_wildcard(argument) - && !((newtype_deriving_wildcard || generic_deriving_wildcard) && index == 1) + contains_wildcard(argument) && !(head_shape_wildcard && index == 1) }); if local && has_unsupported_wildcard { self.state.errors.push(TypeCheckError::new( @@ -288,7 +267,7 @@ impl Checker { if arguments.len() != class.parameters.len() { if local { self.state.errors.push(TypeCheckError::new( - TypeCheckErrorKind::UnsupportedClass, + TypeCheckErrorKind::ClassInstanceArityMismatch, instance.span, "an instance head must apply its class to one type argument per parameter", )); @@ -296,10 +275,29 @@ impl Checker { return; } let mut variables = HashMap::new(); - let head_arguments = arguments + let mut head_arguments = arguments .iter() .map(|argument| self.elaborate_type(argument, &mut variables)) .collect::>(); + // A `Newtype`/`Generic` derivation's trailing wildcard is resolved to + // the wrapped type or representation before the instance is recorded, + // so the searchable head is concrete. The rule is chosen from the + // registry, not from a class name. + if head_shape_wildcard { + let resolved = match self.env.deriving.known_class(instance.class_id) { + Some(KnownClass::Newtype) => { + self.newtype_underlying_type(&head_arguments[..1], instance.span, true) + } + Some(KnownClass::Generic) => { + self.generic_representation(&head_arguments[0], instance.span) + } + _ => None, + }; + let Some(resolved) = resolved else { + return; + }; + head_arguments[1] = resolved; + } let mut context = Vec::with_capacity(instance.context.len()); let mut context_parameters = Vec::with_capacity(instance.context.len()); let mut valid = true; diff --git a/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs index 9f9102be..59b9ee84 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs @@ -51,6 +51,8 @@ impl Checker { ) { (InferType::Variable(a), InferType::Variable(b)) => a == b, (InferType::Constructor(a), InferType::Constructor(b)) => a == b, + (InferType::TypeLevelString(a), InferType::TypeLevelString(b)) => a == b, + (InferType::TypeLevelInt(a), InferType::TypeLevelInt(b)) => a == b, (InferType::Application(f1, a1), InferType::Application(f2, a2)) => { self.infer_types_equal(&f1, &f2) && self.infer_types_equal(&a1, &a2) } diff --git a/crates/psrs-typecheck/src/typecheck/classes/instance.rs b/crates/psrs-typecheck/src/typecheck/classes/instance.rs index 0531788b..bab361ea 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/instance.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/instance.rs @@ -56,6 +56,7 @@ impl Checker { self.validate_known_deriving_class( instance.class_id, &class, + &instance.head, &head_arguments, instance.span, )?; @@ -64,6 +65,7 @@ impl Checker { Some(hir::DerivationStrategy::Newtype) => { if class.parameters.len() != head_arguments.len() { return self.deriving_error( + TypeCheckErrorKind::InvalidNewtypeInstance, instance.span, "derive newtype class head has the wrong arity", ); diff --git a/crates/psrs-typecheck/src/typecheck/classes/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/mod.rs index 3e731f2f..2a45b9d5 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/mod.rs @@ -19,6 +19,7 @@ mod matching; mod solve; mod superclass; +pub(in crate::typecheck) use deriving::DerivingRegistry; pub(in crate::typecheck) use fundeps::collect_infer_variables; pub(in crate::typecheck) use locals::next_local_id; pub(in crate::typecheck) use solve::{SolveDepth, UnsolvedPolicy}; diff --git a/crates/psrs-typecheck/src/typecheck/entry.rs b/crates/psrs-typecheck/src/typecheck/entry.rs index a3aa7c8e..c72347c1 100644 --- a/crates/psrs-typecheck/src/typecheck/entry.rs +++ b/crates/psrs-typecheck/src/typecheck/entry.rs @@ -88,6 +88,7 @@ pub fn typecheck_module_with_checked_kinds( effect_runtime_representation, TypecheckContext { known_types, + known_values: &[], imported_instances, module_names: &module_names, checked_kinds, diff --git a/crates/psrs-typecheck/src/typecheck/error.rs b/crates/psrs-typecheck/src/typecheck/error.rs index 673780fc..ca6acbfa 100644 --- a/crates/psrs-typecheck/src/typecheck/error.rs +++ b/crates/psrs-typecheck/src/typecheck/error.rs @@ -40,6 +40,26 @@ pub enum TypeCheckErrorKind { InvalidInstanceHead, /// An inferred public value mentions a local type omitted from exports. TransitiveExport, + /// A class has no compiler-supported deriving rule. Official + /// `TypeChecker/Deriving.hs` raises `CannotDerive` in the same position. + CannotDerive, + /// A deriving head is not the local type constructor the rule expects. + ExpectedTypeConstructor, + /// A structural deriving head has the wrong number of type arguments. + InvalidDerivedInstance, + ClassInstanceArityMismatch, + /// A `derive newtype` head is not a locally declared newtype. + InvalidNewtypeInstance, + /// `derive newtype` was applied to a plain data type. + CannotDeriveNewtypeForData, + /// A constructor field cannot be mapped under the deriving class's + /// variance, the official `CannotDeriveInvalidConstructorArg`. + CannotDeriveInvalidConstructorArg, + /// The type a derivation refers to cannot be found. + CannotFindDerivingType, + /// A `Newtype` or `Generic` derivation is missing its trailing type + /// wildcard, the official `ExpectedWildcard`. + ExpectedWildcard, /// `e @T` where `e`'s type has no quantifier left to apply `T` to. /// `purs` raises this in `TypeChecker.Types.infer'` for /// `VisibleTypeApp`, where the operand's type is reported against the @@ -156,6 +176,17 @@ impl TypeCheckErrorKind { } TypeCheckErrorKind::InvalidInstanceHead => "InvalidInstanceHead", TypeCheckErrorKind::TransitiveExport => "TransitiveExportError", + TypeCheckErrorKind::CannotDerive => "CannotDerive", + TypeCheckErrorKind::ExpectedTypeConstructor => "ExpectedTypeConstructor", + TypeCheckErrorKind::InvalidDerivedInstance => "InvalidDerivedInstance", + TypeCheckErrorKind::ClassInstanceArityMismatch => "ClassInstanceArityMismatch", + TypeCheckErrorKind::InvalidNewtypeInstance => "InvalidNewtypeInstance", + TypeCheckErrorKind::CannotDeriveNewtypeForData => "CannotDeriveNewtypeForData", + TypeCheckErrorKind::CannotDeriveInvalidConstructorArg => { + "CannotDeriveInvalidConstructorArg" + } + TypeCheckErrorKind::CannotFindDerivingType => "CannotFindDerivingType", + TypeCheckErrorKind::ExpectedWildcard => "ExpectedWildcard", TypeCheckErrorKind::CannotApplyExpressionOfTypeOnType => { "CannotApplyExpressionOfTypeOnType" } diff --git a/crates/psrs-typecheck/src/typecheck/infer/construct.rs b/crates/psrs-typecheck/src/typecheck/infer/construct.rs index 5d961643..bac575b0 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/construct.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/construct.rs @@ -8,6 +8,7 @@ impl Checker { ) -> Self { let TypecheckContext { known_types, + known_values, imported_instances, module_names, checked_kinds, @@ -137,6 +138,7 @@ impl Checker { classes: HashMap::new(), class_methods: HashMap::new(), instances: Vec::new(), + deriving: classes::DerivingRegistry::default(), }, state: InferState { substitutions: HashMap::new(), @@ -165,6 +167,11 @@ impl Checker { // declarations, which also supports forward and mutually referring // class/data declarations. checker.build_class_environment(module, known_types); + // The deriving registry reads the class environment, the resolved type + // identities, and the program's value identities, so it is built once + // here and read afterwards. + checker.env.deriving = + classes::DerivingRegistry::build(&checker.env, known_values, module_names); checker.register_constructors(); checker.state.next_dictionary_local = classes::next_local_id(module); checker.build_instance_environment(module, imported_instances); diff --git a/crates/psrs-typecheck/src/typecheck/mod.rs b/crates/psrs-typecheck/src/typecheck/mod.rs index 60b24c47..29ccd2ab 100644 --- a/crates/psrs-typecheck/src/typecheck/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/mod.rs @@ -36,6 +36,10 @@ pub struct TypeCheckOutput { #[derive(Clone, Copy)] pub struct TypecheckContext<'a> { pub known_types: &'a [hir::TypeDeclaration], + /// Every value declaration in the resolved program, used to pin the core + /// library values a deriving rule names (`mempty`, `append`, `identity`, + /// `apply`, `pure`) to their declaring identity. + pub known_values: &'a [hir::Declaration], pub imported_instances: &'a [hir::InstanceDeclaration], pub module_names: &'a HashMap, pub checked_kinds: &'a CheckedKindEnv, diff --git a/crates/psrs-typecheck/src/typecheck/prim/compare/tests.rs b/crates/psrs-typecheck/src/typecheck/prim/compare/tests.rs index 191e63cc..bb301101 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/compare/tests.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/compare/tests.rs @@ -26,6 +26,7 @@ pub(super) fn checker() -> Checker { &HashMap::new(), TypecheckContext { known_types: &[], + known_values: &[], imported_instances: &[], module_names: &HashMap::from([(hir::ModuleId(0), "Main".to_owned())]), checked_kinds: &psrs_kind::CheckedKindEnv::default(), diff --git a/crates/psrs-typecheck/src/typecheck/prim/int.rs b/crates/psrs-typecheck/src/typecheck/prim/int.rs index 594e6783..7466f39d 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/int.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/int.rs @@ -217,6 +217,7 @@ mod tests { &HashMap::new(), TypecheckContext { known_types: &[], + known_values: &[], imported_instances: &[], module_names: &HashMap::from([(hir::ModuleId(0), "Main".to_owned())]), checked_kinds: &psrs_kind::CheckedKindEnv::default(), diff --git a/crates/psrs-typecheck/src/typecheck/prim/row/tests/mod.rs b/crates/psrs-typecheck/src/typecheck/prim/row/tests/mod.rs index ad2335ed..9ab547c0 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/row/tests/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/row/tests/mod.rs @@ -29,6 +29,7 @@ fn checker() -> Checker { &HashMap::new(), TypecheckContext { known_types: &[], + known_values: &[], imported_instances: &[], module_names: &HashMap::from([(hir::ModuleId(0), "Main".to_owned())]), checked_kinds: &psrs_kind::CheckedKindEnv::default(), diff --git a/crates/psrs-typecheck/src/typecheck/prim/tests/mod.rs b/crates/psrs-typecheck/src/typecheck/prim/tests/mod.rs index c8414568..75d2f0d7 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/tests/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/tests/mod.rs @@ -360,6 +360,7 @@ fn checker() -> Checker { &HashMap::new(), TypecheckContext { known_types: &[], + known_values: &[], imported_instances: &[], module_names: &HashMap::from([(ModuleId(0), "Main".to_owned())]), checked_kinds: &psrs_kind::CheckedKindEnv::default(), diff --git a/crates/psrs-typecheck/src/typecheck/state.rs b/crates/psrs-typecheck/src/typecheck/state.rs index c1c8b193..09e42f06 100644 --- a/crates/psrs-typecheck/src/typecheck/state.rs +++ b/crates/psrs-typecheck/src/typecheck/state.rs @@ -14,6 +14,7 @@ //! than its neighbour, and [`InferState::snapshot`] is the only way a snapshot //! is taken. +use super::classes::DerivingRegistry; use super::*; /// The read-only semantic inputs of one module being checked. @@ -43,6 +44,9 @@ pub(super) struct SemanticEnv { pub(super) classes: HashMap, pub(super) class_methods: HashMap, pub(super) instances: Vec, + /// The single table of compiler-known deriving classes and representation + /// declarations, built once from the resolved declarations. + pub(super) deriving: DerivingRegistry, } /// The mutable solver: everything a binding changes and a speculation must undo. diff --git a/crates/psrs-typecheck/src/typecheck/tests/binding_kinds.rs b/crates/psrs-typecheck/src/typecheck/tests/binding_kinds.rs index 491b7c06..39b7fbf6 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/binding_kinds.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/binding_kinds.rs @@ -50,6 +50,7 @@ fn typecheck_program(source: &str) -> Result Checker { &HashMap::new(), TypecheckContext { known_types: &[], + known_values: &[], imported_instances: &[], module_names: &HashMap::from([(ModuleId(0), "Main".to_owned())]), checked_kinds: &psrs_kind::CheckedKindEnv::default(), diff --git a/docs/decision/DEC-17-representation-and-evidence.md b/docs/decision/DEC-17-representation-and-evidence.md index 4cfd3ba4..71b652cd 100644 --- a/docs/decision/DEC-17-representation-and-evidence.md +++ b/docs/decision/DEC-17-representation-and-evidence.md @@ -85,6 +85,13 @@ The model adopts the established naming: GHC `RuntimeRep`/`Any`/`unsafeCoerce#`, Swift calling conventions and reabstraction thunks with witness tables, Java erasure with bridge methods, and Koka-style explicit evidence. +Bare polymorphic function values use one registered unary erased protocol. +Flattened arguments become successive segments, and recovery supplies them +through a checked adapter. This fixes arity at the storage boundary while +preserving the producer's concrete calling convention behind that adapter. +Constructor-owned callable protocols retain their checked fixed arguments; +the bare-slot protocol does not replace the Function domain or Effect token. + ## Consequences - The transitional mechanisms are removed, not extended: the HIR-keyed protocol diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 35f98f6a..f0f2a971 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -580,13 +580,20 @@ obligation to FE-13, and accepted mismatches still need type-checking fixes. - **Acceptance:** Agreement on the `errorCode`s above. - **Prerequisite:** M4. -**Measured current result (2026-10-04, remeasured with the full boards):** -**58/81** failing cases agree. Per-code agreement is `OverlappingInstances` -8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, `DuplicateInstance` -1/1, `InvalidInstanceHead` 1/7, and 0 for `PossiblyInfiniteInstance` (1), -`OrphanInstance` (7), `DuplicateTypeClass` (1), and -`CannotDeriveInvalidConstructorArg` (1). `InvalidNewtypeInstance` and -`ClassInstanceArityMismatch` are no longer in this board. +**Measured current result (2026-10-06, deriving follow-up):** **75/97** +failing cases agree. Per-code agreement is `OverlappingInstances` 8/8, +`NoInstanceFound` 46/53, `MissingClassMember` 2/2, +`InvalidNewtypeInstance` 6/6, `InvalidInstanceHead` 1/7, +`DuplicateInstance` 1/1, `ClassInstanceArityMismatch` 4/4, and +`CannotDeriveInvalidConstructorArg` 7/7. The remaining measured codes are +`PossiblyInfiniteInstance` 0/1, `OrphanInstance` 0/7, and +`DuplicateTypeClass` 0/1. Eleven cases are blocked before a mapped diagnostic: +five P2 expression cases, four P2 hole cases, and two superclass-cycle cases. +The four arity cases now report their official code at the common instance +recorder; all structural deriving families have source and execution evidence. +The previous 2026-10-04 result was 58/81. Denominators reflect cases with their +own mapped diagnostics; newly attributable deriving and arity cases enter the +board rather than being read as regressions. The historical 51/92 figure below predates `Eq`/`Ord`/`Semiring` and this slice; the 84 is the set of cases whose annotations are entirely M5 codes on this tree. The `<>` slice raises `NoInstanceFound` @@ -1081,12 +1088,12 @@ for matrix status. | L2 | Module, import, export, and name resolution | 71/72 failing cases. `passing` resolution is **386/413**; the remaining 27 stop at P3 (23) or P0 (4), with no missing-library or unusable-sibling blockers. The sole failing mismatch expects `ScopeConflict` and produces `ExportConflict`. Remeasured with all boards on 2026-10-04 after vendoring v0.15.16. | The mapped resolution cases and all required passing-module cases agree. | | L3 | Kinds and higher-kinded types | 39/48 failing cases: `KindsDoNotUnify` 16/24, `PartiallyAppliedSynonym` 12/12, `CycleInTypeSynonym` 4/4, `CycleInKindDeclaration` 2/2, `InfiniteKind` 2/2, and `UndefinedTypeVariable` 3/4. | 100% agreement for the mapped kind cases. | | L4 | Core type checking | 39/50 failing cases. The remaining mismatches include kind diagnostics reported in place of `ExpectedType`, missing `EscapedSkolem`, `VisibleTypeApplications1`, and five `Coercible` cases reported as `NoInstanceFound`. | 100% agreement for the mapped type cases. | -| L5 | Classes and instances | 58/81 failing cases: `OverlappingInstances` 8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, `DuplicateInstance` 1/1, `InvalidInstanceHead` 1/7, and 0 for the other mapped codes. | 100% agreement for the mapped class cases. | +| L5 | Classes and instances | 75/97 failing cases: `OverlappingInstances` 8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, `InvalidNewtypeInstance` 6/6, `DuplicateInstance` 1/1, `InvalidInstanceHead` 1/7, `ClassInstanceArityMismatch` 4/4, `CannotDeriveInvalidConstructorArg` 7/7; `PossiblyInfiniteInstance` 0/1, `OrphanInstance` 0/7, `DuplicateTypeClass` 0/1. Remeasured on 2026-10-06. | 100% agreement for the mapped class cases. | | L6/M7 | Runtime and standard library | **164/413** non-FFI passing files compile, validate, and run, all with exit code 0. The other 249 do not agree: 46 stop at P10 with no selected `main`, 30 at P8 CC verification, 68 at P5 typecheck, 23 at P3, 16 at P5 kind checking, 16 at P8 closure conversion, 4 at P0, 1 at P7, 26 during harness loading, and 19 trap at runtime. Remeasured with `PSRS_REQUIRE_WASMTIME=1 PSRS_ORACLE=annotations` on 2026-10-04 (Wasmtime 49.0.2, `purs` 0.15.16). | Every in-scope passing file for the feature compiles, validates, and runs with the expected result. | | M8-W | Warnings | 67 non-FFI warning files are in scope; no warning-code scoreboard exists | Warning-code agreement reaches 100% for the tracked warning corpus. | | M8-O | Optimization | 10 optimize files are in scope; they are not vendored and their goldens are JavaScript output | Expected optimize/CoreFn output agrees for all tracked optimize files. | -The gate rows above are the 2026-10-04 remeasurement after vendoring the core libraries. Earlier M7 tables in the progress section record the `logShow`, `Show`, Foldable, and `Data.Functor` runs; those figures are historical and are not added to this table. The current L5 denominator is 81. +The gate rows above are the 2026-10-04 remeasurement after vendoring the core libraries, except L4/L5, remeasured on 2026-10-06. Earlier M7 tables in the progress section record the `logShow`, `Show`, Foldable, and `Data.Functor` runs; those figures are historical and are not added to this table. The current L5 denominator is 97. ### Feature-to-gate crosswalk @@ -1104,6 +1111,7 @@ when its local implementation tests pass. | FE-19 | Non-FFI suite cases plus WIT-specific tests | JavaScript FFI remains excluded. | | FE-20 | L0–L5 diagnostics and M8-W | Error-code and warning-code scoreboards. | | FE-21 | M8-O and backend Core/MIR tests | Optimize output and semantics-preservation tests. | +| FE-22 | L5 and the corresponding L6/M7 cases | Deriving differential and execution tests; [deriving acceptance record](../implementation/frontend/deriving.md). | | BE-01–BE-11 | L6/M7 for source-visible behavior | CC/MIR lowering, representation, and execution tests. | | BE-12 | M8-O | Core/MIR optimization and output comparison. | | BE-13–BE-16 | L6/M7 for generated artifacts | Wasm feature-profile, validation, WAT, and runtime tests. | @@ -1125,7 +1133,7 @@ resolved, type checked, and represented in Typed Core as required. | FE-01 | Lexing, Unicode tokens, comments, literals, and layout | Lexer and layout agree with the L1 annotations scoreboard at 904/908, including 15/15 layout cases. The four differences are the DEC-16 intentional differences: a supplementary scalar is accepted as one `Char` (`failing/2434.purs`), and an unpaired surrogate escape is rejected in `StringEscapes.purs` and the two `StringEdgeCases` files. A paired surrogate escape decodes as one scalar, and no surrogate becomes U+FFFD. Parse agreement does not verify string values. | Partial | Cover the remaining literal forms the corpus exercises. | | FE-02 | Module headers, imports, exports, qualified names, aliases, and hiding | Module graph, stable module IDs, value/type/constructor/class imports and exports, fixity aliases, virtual `Prim.*` type/class interfaces, instance dictionary identities, per-branch instance exports, and unary minus through ordinary `negate` resolution work in a subset; the latest full-board run agrees on 71/72 mapped failing cases. `passing` resolution is **386/413**; 23 cases stop at P3 and 4 at P0. A re-exported operator alias carries its target's identity and does not require the target's name unless the target is declared in the re-exporting module. Class-only imports do not import methods into the value namespace; selective imports still receive visible instances through the module dependency graph. P3 checks explicit signatures and declaration dependencies; P5 checks inferred public schemes by stable type identity. `Prim.undefined` has a compiler-owned identity, type, and interface export, but Core lowering still rejects it because no runtime representation is defined. The [primitives topic](frontend/type-system/prim.md) owns the `Prim.*` inventory, the evidence-class dispatch order, relation outcomes, and diagnostic behavior; #120 adds the missing relation and report paths. Broader pattern-binding support remains incomplete. | Partial | Complete pattern-binding support; add the `Prim.undefined` runtime representation and continue official-suite coverage for primitive solving. | | FE-03 | Value declarations, signatures, recursive groups, pattern bindings, and `where` | Named declarations, signatures, recursive local groups, and top-level SCC inference work; selected local pattern declarations, including `LetPattern`, lower through the pattern pipeline. The full declaration and `where` forms are not end-to-end. | Partial | Complete remaining pattern declarations and local `where` blocks. | -| FE-04 | Declaration forms: `data`, `newtype`, `type`, `class`, `instance`, `derive`, `foreign`, roles, fixities, and kind signatures | Data/newtype roles are inferred and checked, foreign role signatures enter the checked kind environment, and source role errors retain spans. Instance declarations resolve into dictionary-scoped members; signatures associate with consecutive equations, reject orphan/repeated declaration groups, and check against the class method specialized by the instance head. Deriving and several declaration forms remain incomplete. | Partial | Complete deriving and the remaining declaration-form semantics. | +| FE-04 | Declaration forms: `data`, `newtype`, `type`, `class`, `instance`, `derive`, `foreign`, roles, fixities, and kind signatures | Data/newtype roles are inferred and checked, foreign role signatures enter the checked kind environment, and source role errors retain spans. Instance declarations resolve into dictionary-scoped members; signatures associate with consecutive equations, reject orphan/repeated declaration groups, and check against the class method specialized by the instance head. Deriving and several declaration forms remain incomplete. | Partial | Complete the remaining declaration-form semantics; deriving is tracked under FE-22. | | FE-05 | Expressions: application, operators, lambdas, `if`, `let`, `case`, records, arrays, literals, sections, `do`, and `ado` | Application, value and type operators with resolved fixities, the `Data.Function` application operators `$` and `#` with their official associativity and precedence, unary minus through the ordinary in-scope `negate` value, lambdas, `if`, `let`, `case`, scalar arrays, empty array literals whose element type is determined, records, and selected literals work; `do`/`ado` lower to bind, discard, and `let`. The ascription `e :: T` is checked against its written type and remains explicit through Typed Core. Sections lower through P4 and have runtime coverage. Remaining literal and expression forms are open. | Partial | Complete the remaining literal and expression forms. | | FE-06 | Patterns: variables, wildcards, constructors, records, literals, tuples, arrays, guards, and binders | Variables, wildcards, multi-field constructors (`passing/1185.purs`), nested named record patterns (`passing/2049.purs`), literals, arrays, typed binders, operator patterns, tuple products, and local pattern declarations reach Typed Core and the shared pattern matrix. The 34 fixed pattern blockers lower through P2; value-sensitive source-shaped executions select the expected fields for both 1185 (85) and 2049 (84), and the matrix suite covers scalar, array, string, char, Number, record, and guard first-match behavior. Guard coverage provenance and guarded Boolean alternative warnings have source and matrix evidence under PM-14; the full L4/L6 feature gates remain open, and no `passing` file stops in surface lowering. | Partial | Complete broader official type/runtime coverage. | | FE-07 | Operators, sections, fixity declarations, and type/value operators | P2 retains unresolved value, constructor-pattern, and type operator chains and both section forms; P3 binds value/type aliases and attaches fixities; P4 reassociates the chains and expands sections. Official operator-alias failures agree and focused runtime cases cover custom associativity, precedence, constructor patterns, and both sections. Builtin `Prim.Function` and `Prim.Int` type-operator aliases retain identity through module re-exports; `Prim.Int` overapplication reaches the kind arity check. Full type checking still depends on cross-module higher-kinded schemes. | Partial | Complete surrounding type/runtime coverage. | @@ -1135,19 +1143,20 @@ resolved, type checked, and represented in Typed Core as required. | FE-11 | Kinds, kind signatures, higher-kinded types, kind annotations, and kind variables | Dedicated kind inference/checking covers several declarations, annotations, records/rows, and official kind errors. Kind checking runs once per program and produces the checked kind and role environment every module's type check consumes, with each diagnostic attributed to the module that declares the offending type and a missing scheme reported instead of inferred; one primitive table is the only reading of a primitive's kind, and the `Coercible` solver consumes that shared denotation and kind solver. A declaration's scheme quantifies only the kind unknowns its own definition leaves undetermined, but the well-scoped-quantification rule (`QuantificationCheckFailureInKind`) is not implemented, and an instance head whose class is declared in another module is still skipped. | Partial | Add the well-scoped-quantification rule, cross-module instance heads, kind checking in expressions, and type-level row functions. | | FE-12 | Algebraic data types, constructors, newtypes, and constructor typing | Data/newtype declarations, constructor schemes, constructor application, and basic case typing work. | Partial | Add full recursive/parameterized checking, exhaustiveness, and all pattern forms. | | FE-13 | Records, row types, row polymorphism, and variants | Closed concrete records, field access/update, partial source record patterns, exact generated product patterns, and row unification work. The row normalizer returns collected fields and tail or an `InvalidShape` diagnostic; it does not treat an unrecognized shape as a closed row. The `Prim.Row` and `Prim.RowList` relations use that normalizer and the shared kind solver. #87 tracks row syntax under FE-17; #120 covers the primitive row constraints under FE-14. Rigid-tail row unification still has known bugs. Labels are scalar sequences under [DEC-16](../decision/DEC-16-scalar-strings-and-utf8-storage.md); the current compiler still uses Rust strings and does not preserve lone surrogates. A label that exists only in an unknown tail is not accessed or updated. Open rows still have no runtime layout, and variants are not implemented. | Partial | Fix rigid-tail row unification; complete row syntax and official coverage, then add variants without choosing a runtime field layout. | -| FE-14 | Constraints, type classes, superclasses, class members, and instances | Source constraint elaboration, contextual and multi-parameter instances, superclass evidence, imported generic dictionaries, ordered source instance chains, and rank-1 polymorphic method signatures execute. Superclass edges use `TypeTemplate` substitution, including constructed arguments such as `C (Array a)`; `a_superclass_edge_over_a_constructed_argument_runs_when_wasmtime_is_available` executes the `Gamma (Array a)` edge through an `Epsilon Int` use. Instance member signatures are associated with consecutive equations, resolve instance-head variables, and are checked against specialized class method types; source and Wasmtime tests cover specialized and more-general signatures plus mismatches. A constrained instance-member annotation cannot yet be solved solely to specialize it to a monomorphic expected method type. Duplicate member groups, orphan member signatures, duplicate named instances, and ordinary-value/name collisions use official diagnostics. Explicit export lists filter instance branches by class/head/context visibility while preserving identity and chain positions; imports do not require the class in their selective list to receive visible instances. Class-only imports keep methods out of the ordinary value namespace. Constrained-forall expression ascriptions are checked in a complete rollback probe, then elaborated at their expected use type; ordinary class dictionaries survive both monomorphic and rank-N uses, with actual Wasmtime execution evidence. #120 adds compiler-owned rules for the twelve `Prim.Row`, `Prim.RowList`, `Prim.Symbol`, and `Prim.Int` relations and a report path for `Prim.TypeError.Fail`, `Warn`, and `Partial`. Open-row `Lacks` and `Union` preserve partial evidence and re-enter solving on residual constraints; the outcome contract belongs to each rule, while the shared framework checks returned dictionary arguments and bounds speculative work. `Warn` propagates through explicit scoped dictionaries; otherwise it emits at the enclosing value or instance declaration and discharges, so inferred schemes do not retain a `Warn` context; `Fail` renders a valid `Doc` as a custom error, while malformed `Doc` falls back to `NoInstanceFound`. `Partial` still lacks HIR exhaustiveness metadata and therefore reports the generic no-instance message. Five `Coercible` board mismatches remain because the proof evidence has no relation arguments for the shared dictionary verification path. The [primitives topic](frontend/type-system/prim.md) owns these semantics and their measured coverage. A wildcard in an instance head is rejected as `InvalidInstanceHead`; a wildcard in an instance context stays legal because the constraint is still solvable. Scoped method-local constraints and quantified method parameters have evidence in the [rank-N acceptance record](../implementation/frontend/rank-n.md). The standard library now declares its first classes: `Data.Semigroup` defines `Semigroup`, its `append` method, and the `<>` alias, with `String`, `Unit`, and `Array a` instances resolved across the module graph and re-exported from `Prelude`. `Data.Monoid` adds `mempty` for those three types, `Data.Show` adds the `Show` class and `show` for `Boolean`, `Int`, `Number`, `Char`, `String`, `Unit`, and `Array a`, and `Data.Foldable` adds `foldr`, `foldl`, and `foldMap` for `Array`, `Maybe`, and `Either a`. `fold` is not part of that surface yet, because a polymorphic `foldMap` of the identity does not lower. | Partial | Reconcile remaining class-rule mismatches and official-suite coverage; deriving is tracked under FE-16. | +| FE-14 | Constraints, type classes, superclasses, class members, and instances | Source constraint elaboration, contextual and multi-parameter instances, superclass evidence, imported generic dictionaries, ordered source instance chains, and rank-1 polymorphic method signatures execute. Superclass edges use `TypeTemplate` substitution, including constructed arguments such as `C (Array a)`; `a_superclass_edge_over_a_constructed_argument_runs_when_wasmtime_is_available` executes the `Gamma (Array a)` edge through an `Epsilon Int` use. Instance member signatures are associated with consecutive equations, resolve instance-head variables, and are checked against specialized class method types; source and Wasmtime tests cover specialized and more-general signatures plus mismatches. A constrained instance-member annotation cannot yet be solved solely to specialize it to a monomorphic expected method type. Duplicate member groups, orphan member signatures, duplicate named instances, and ordinary-value/name collisions use official diagnostics. Explicit export lists filter instance branches by class/head/context visibility while preserving identity and chain positions; imports do not require the class in their selective list to receive visible instances. Class-only imports keep methods out of the ordinary value namespace. Constrained-forall expression ascriptions are checked in a complete rollback probe, then elaborated at their expected use type; ordinary class dictionaries survive both monomorphic and rank-N uses, with actual Wasmtime execution evidence. #120 adds compiler-owned rules for the twelve `Prim.Row`, `Prim.RowList`, `Prim.Symbol`, and `Prim.Int` relations and a report path for `Prim.TypeError.Fail`, `Warn`, and `Partial`. Open-row `Lacks` and `Union` preserve partial evidence and re-enter solving on residual constraints; the outcome contract belongs to each rule, while the shared framework checks returned dictionary arguments and bounds speculative work. `Warn` propagates through explicit scoped dictionaries; otherwise it emits at the enclosing value or instance declaration and discharges, so inferred schemes do not retain a `Warn` context; `Fail` renders a valid `Doc` as a custom error, while malformed `Doc` falls back to `NoInstanceFound`. `Partial` still lacks HIR exhaustiveness metadata and therefore reports the generic no-instance message. Five `Coercible` board mismatches remain because the proof evidence has no relation arguments for the shared dictionary verification path. The [primitives topic](frontend/type-system/prim.md) owns these semantics and their measured coverage. A wildcard in an instance head is rejected as `InvalidInstanceHead`; a wildcard in an instance context stays legal because the constraint is still solvable. Scoped method-local constraints and quantified method parameters have evidence in the [rank-N acceptance record](../implementation/frontend/rank-n.md). The standard library now declares its first classes: `Data.Semigroup` defines `Semigroup`, its `append` method, and the `<>` alias, with `String`, `Unit`, and `Array a` instances resolved across the module graph and re-exported from `Prelude`. `Data.Monoid` adds `mempty` for those three types, `Data.Show` adds the `Show` class and `show` for `Boolean`, `Int`, `Number`, `Char`, `String`, `Unit`, and `Array a`, and `Data.Foldable` adds `foldr`, `foldl`, and `foldMap` for `Array`, `Maybe`, and `Either a`. `fold` is not part of that surface yet, because a polymorphic `foldMap` of the identity does not lower. | Partial | Reconcile remaining class-rule mismatches and official-suite coverage; deriving is tracked under FE-22. | | FE-15 | Functional dependencies | Source fundep improvement uses transitive determining closure and selected branches; independent class arguments still prove apartness. Ambiguity and consistency diagnostics are covered. One known divergence: a type wildcard standing for a fundep-determined position is reported as a fundep conflict, where `purs` only warns — `passing/WildcardInInstance.purs` says so in its own comment. It is unmeasurable until Phase 3 provides `Effect` and `Effect.Console`. | Partial | Reconcile official-suite fundep coverage and remaining advanced class forms. | -| FE-16 | Deriving, roles, `Coercible`, and newtype-based derivation | Role inference/checking (including imported aliases), compiler-owned `Coercible` solving, checked kind compatibility, higher-kinded given rewriting, canonical open-row alignment, constructor-visibility checks, explicit Typed Core evidence boundaries, and backend-planned conversions work for the covered subset. Source and Wasmtime tests cover phantom/nominal/representational roles, parameterized newtype scalar/function/array payloads, structural `Eq`/`Ord`, nested alias-aware `Functor.map`, direct `Bifunctor.bimap`, recursive `Eq`, checked `derive newtype` adapters, empty-class underlying-instance validation, and cross-module dictionaries. Differential tests also cover function-result traversal, `Contravariant` via `Profunctor.lcmap`, and resolved re-exported class identity. Runtime closure capture still blocks the function-based `Contravariant` case; other upstream deriving classes and open-row runtime conversion remain incomplete. Scoped method-local constraints on class methods are covered under FE-18. The `Coercible` solver reads primitive kinds through the shared kind checker; expression-level kind checking remains incomplete. Five `Coercible` board mismatches remain because a `Proof` member has no dictionary arguments for the framework's decided-argument check, so its answer still needs an explicit verification contract. | Partial | Implement the remaining upstream deriving classes; expand closure-capture runtime support and remaining coercion cases. See [roles and coercions acceptance](../implementation/frontend/roles-and-coercions.md). | +| FE-16 | Roles and `Coercible` | Role inference/checking (including imported aliases), compiler-owned `Coercible` solving, checked kind compatibility, higher-kinded given rewriting, canonical open-row alignment, constructor-visibility checks, explicit Typed Core evidence boundaries, and backend-planned conversions work for the covered subset. Source and Wasmtime tests cover phantom/nominal/representational roles, parameterized newtype scalar/function/array payloads, and cross-module dictionaries. Scoped method-local constraints on class methods are covered under FE-18. The `Coercible` solver reads primitive kinds through the shared kind checker; expression-level kind checking remains incomplete. Five `Coercible` board mismatches remain because a `Proof` member has no dictionary arguments for the framework's decided-argument check, so its answer still needs an explicit verification contract. | Partial | Expand closure-capture runtime support and the remaining coercion cases. See [roles and coercions acceptance](../implementation/frontend/roles-and-coercions.md). | | FE-17 | Visible type application, typed binders, type wildcards, holes, and advanced annotations | Typed binders preserve and check scoped annotations, and each source type wildcard receives fresh kind/type variables through the shared type spine. Type-level `String` and `Int` literals are ordinary spine nodes: a signature may contain them, they unify by value, and they survive into THIR where the verifier compares them. A wildcard in a value signature is solved by unification and is accepted in every shape `purs` accepts; a wildcard in an instance head is rejected as `InvalidInstanceHead`, while one in an instance context stays legal. The `1664.purs` wildcard binder lowers through P2. Visible term type application, wildcard warning/error behavior, higher-kinded application, and non-generalized hole diagnostics remain incomplete. The `Type`, `Constraint`, and `Symbol` heads are accepted as ordinary type constructors with their declared primitive kinds. Official's CST has no kind-application node; its kind checker synthesizes `KindApp` while instantiating a polymorphic kind, and this compiler performs that instantiation in the kind solver, so its source type spine needs no `KindApplication` node. The source forms that do name a kind or type explicitly are separate nodes. #87 lands both of the forms that blocked P2: a negative type-level integer prefix is the negative literal on the shared spine, and a visible type application `e @T` is elaborated by the checker, which substitutes the written argument for the operand's outermost quantifier after checking it against that quantifier's kind, and is erased at runtime. No P2 surface-lowering case remains. Three limits are recorded rather than approximated. A chained application `f @A @B` is reported, because the quantifiers an application leaves behind are scheme variables here and choosing between them needs the scheme to record which variables a visible application has consumed. A visible application on a class-method head is unresolved, which is `failing/ClassHeadNoVTA3.purs`. And this compiler's CST does not carry the binder visibility that official's `CST/Convert.hs` derives from `forall @a.`, so a plain `forall a.` binder is selectable where `purs` rejects it — the permissive direction, and the remaining half of `failing/VisibleTypeApplications1.purs`. `CannotApplyExpressionOfTypeOnType` and `CannotSkipTypeApplication` are the mapped codes. The primitive row relations themselves all have rules, and the row-side gap that remains is the rigid-tail unification defect under FE-13. | Partial | Model `forall` binder visibility so a visible application matches official, then resolve chained applications and class-method heads. | | FE-18 | Higher-rank types, subsumption, impredicativity, and higher-rank `forall` | Bidirectional checking preserves nested quantifiers, checks directional function/record subsumption, and rejects escaping skolems and specialized universal arguments. Source and GC execution cases cover rank-2 through rank-4, fields, returned and captured values, recursive annotations, higher-kinded parameters, and nested constraints. See the [rank-N acceptance record](../implementation/frontend/rank-n.md) for verification evidence and the official differential battery. | Partial | Reconcile the complete official higher-rank/skolem corpus, including its library dependencies and separate higher-rank kind requirements; track visible type application and diagnostic agreement. | | FE-19 | Foreign declarations and target-aware external names | Source-declared WIT bindings are resolved for the supported backend path. `foreign import data` is a nominal opaque type with no constructors; a nullary one maps to a WIT resource. THIR and Core keep it as `Constructor(User(id))` plus `opaque_ids`, distinct from `Int` (`lowers_an_opaque_foreign_type_to_core_without_collapsing_it_to_int`). JavaScript FFI is not a frontend target. CC/MIR handle layout is not done. | Partial | Finish target-aware foreign value rules beyond the supported WIT subset. Resource lifetime and handle layout stay in the backend. | -| FE-20 | Warnings, holes, source spans, and official diagnostic codes | Source spans exist and resolution, kind, type, and class `errorCode`s are measured: L1 904/908, L2 71/72, L3 39/48, L4 39/50, L5 58/81. The L4 aggregate is recorded without a per-code decomposition because the latest scoreboard's per-code counts sum to a different total. Pattern-binder diagnostics match the annotated duplicate-name cases; warning coverage and complete diagnostic agreement remain open. Non-generalized hole diagnostics remain tracked under FE-17. | Partial | Add the missing class checks (#97) and track warning-code agreement separately from acceptance errors. | +| FE-20 | Warnings, holes, source spans, and official diagnostic codes | Source spans exist and resolution, kind, type, and class `errorCode`s are measured: L1 904/908, L2 71/72, L3 39/48, L4 39/50, L5 75/97. L4 per-code agreement is `TypesDoNotUnify` 34/41, `IntOutOfRange` 1/1, `InfiniteType` 2/2, `ExpectedType` 0/2, `EscapedSkolem` 1/2, `CannotApplyExpressionOfTypeOnType` 1/2, and `AmbiguousTypeVariables` 1/1. `MultipleErrors.purs` repeats its annotation, so code-occurrence counts sum to 40/51 while case agreement remains 39/50. Pattern-binder diagnostics match the annotated duplicate-name cases; warning coverage and complete diagnostic agreement remain open. Non-generalized hole diagnostics remain tracked under FE-17. | Partial | Add the missing class checks (#97) and track warning-code agreement separately from acceptance errors. | | FE-21 | Typed Core normalization and CoreFn/optimization compatibility | Typed Core lowering and verification work for the supported subset; official optimize output is not yet a target. | Partial | Add Core optimization passes and an explicit optimize compatibility track. | +| FE-22 | Deriving and newtype-based derivation | Every structural family generates ordinary checked instance members through one identity registry and syntax builder. All mapping families, folds, and traversals consume shared usage/variance analysis, including record fields, given higher-kinded dictionaries, and scoped forall parameters. Source tests cover every deriving diagnostic; differential batteries cover 18 original rules, 17 remaining-family/context/scoped cases, and six diagnostic cases. 25 Wasmtime cases cover all structural classes, Generic tag/field round trips, function Contravariant, polymorphic newtype adapters, applied-variable Eq1/Ord1 dispatch, both fold directions, sequencing, and multi-field traversal. L5 is 75/97, with deriving-specific `InvalidNewtypeInstance` 6/6 and `CannotDeriveInvalidConstructorArg` 7/7. | Partial | Shared declaration checks still mismatch the official orphan and invalid record/synonym instance-head cases, including `3405`, `3510`, and `InvalidDerivedInstance2`. See the [deriving design](frontend/type-system/deriving.md) and [acceptance record](../implementation/frontend/deriving.md). | The frontend landing order is: ```text -FE-01 -> FE-02..FE-07 -> FE-08..FE-13 -> FE-14..FE-17 -> FE-18..FE-21 +FE-01 -> FE-02..FE-07 -> FE-08..FE-13 -> FE-14..FE-17 -> FE-18..FE-22 ``` This is a dependency guide, not a requirement to finish every row in a block @@ -1206,7 +1215,7 @@ acceptance result. | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | | Effects | BE-21; supporting BE-02, BE-26 | Trusted Effect identities and checked WIT schemes are passed explicitly. Source `Effect a` stays abstract through Typed Core; P8 lowers it to a generic one-parameter closure. EF-01..EF-13 are Verified, including the `Effect Unit` command adapter and the lexical `runEffect` rule. A type table changed after `lower_effects` returns is not checked again. The official runtime board is 164/413; 46 files with no selected `main` remain blocked, and BE-21 stays Partial. Focused effect tests still expose CC verification and runtime traps, so their source-level integration remains open. | [EF-01..EF-13](../implementation/backend/effects.md) | -| Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-16. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | +| Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | | Optimization | BE-12 | Topic acceptance complete: OPT-01..OPT-14 have implementation, verifier, and required execution evidence. The official M8-O gate stays on the broader BE-12 row. | [OPT-01..OPT-14](../implementation/backend/optimization.md) | | Wasm encoding, validation, and capability | BE-13, BE-14, BE-16; supporting BE-15 | Topic acceptance complete: ENC-01..ENC-11 have implementation, verifier, and required execution evidence. Broader feature rows retain their separate gates. | [ENC-01..ENC-11](../implementation/backend/wasm-encoding.md) | diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index 6476a352..73074b09 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -186,8 +186,34 @@ reachable representation and does not merge by physical shape. This preserves single erased layout for a parameterized data type. Open rows have no canonical product and remain unsupported. +### Bare polymorphic function slots + +A bare type variable stores functions using one registered unary protocol: +`Erased -> Erased`. Erasing a concrete flattened function builds one segment +per parameter. Each segment captures the producer and the already recovered +arguments; the final segment calls the producer and erases its result. A +function result is recursively placed in the same protocol. Recovery builds +an adapter that supplies the consumer's arguments to those segments and +recovers its result. This permits an instantiation to change flattened arity +without treating a cast as a calling-convention conversion. + +This protocol belongs to bare polymorphic value storage. Abstract constructor +transport retains the constructor owner's registered fixed parameters and +payload protocol, including the Function domain and Effect state token. +Variant-field recovery must use the bare-slot adapter for callable targets; +the reference-only recovery shortcut cannot cast an erased function straight +to the consumer signature. Generated adapter parameters precede all local +values and each generated function passes the CC verifier. + ### Aggregate conversion +Canonical products and callable signatures are normalized together to a fixed +point: record fields may contain closures and closure signatures may contain +record layouts. Every iteration remaps aggregate handles in representations, +layouts, and signatures before signature interning. Convergence is bounded by +the representation and signature graph; failure to converge is invalid IR. +A single normalization pass cannot publish canonical identities for this graph. + When two normalized shapes meet at a typed boundary, the planner builds one `ConversionPlan`; the concrete layouts it produces are owned by the target (see [data representation](data-representation.md)). The aggregate leaves are a @@ -532,6 +558,6 @@ payload ([effects](../../../implementation/backend/effects.md)). [classes and evidence](../../frontend/type-system/classes-and-evidence.md), [CC IR](cc-ir.md), [MIR](mir.md), [polymorphism and erasure](polymorphism-and-erasure.md). -- [DEC-17](../../decision/DEC-17-representation-and-evidence.md) records this - model as a durable decision; [DEC-15](../../decision/DEC-15-unified-type-representation.md) +- [DEC-17](../../../decision/DEC-17-representation-and-evidence.md) records this + model as a durable decision; [DEC-15](../../../decision/DEC-15-unified-type-representation.md) is the type-spine counterpart. diff --git a/docs/design/backend/fp/type-classes-and-dictionaries.md b/docs/design/backend/fp/type-classes-and-dictionaries.md index e9f615f2..d198156f 100644 --- a/docs/design/backend/fp/type-classes-and-dictionaries.md +++ b/docs/design/backend/fp/type-classes-and-dictionaries.md @@ -207,7 +207,7 @@ different instance or resolve a new constraint. instance omits the method field; the instance simply stores the default closure in that field. - **Derived instances.** Deriving generates an ordinary instance and dictionary - at elaboration time; it adds no backend representation (`FE-16`). + at elaboration time; it adds no backend representation (`FE-22`). - **Erased polymorphism.** A dictionary passed through a polymorphic function is an ordinary erased value; recovery at the concrete consumer uses the erased protocol, not the dictionary. @@ -316,7 +316,7 @@ no runtime check of `a`. - **To optimization.** Specialization reads dictionaries but preserves the dictionary-passing semantics; it may not be the only encoding. - **Not owned.** Resolution at the source level, overlap/orphan diagnostics, and - functional dependencies (`FE-15`), deriving (`FE-16`), and higher-rank + functional dependencies (`FE-15`), deriving (`FE-22`), and higher-rank subsumption (`FE-18`). ## Open questions and future work diff --git a/docs/design/backend/wasm/wasi-platform-library.md b/docs/design/backend/wasm/wasi-platform-library.md index 07c74b4d..509f2530 100644 --- a/docs/design/backend/wasm/wasi-platform-library.md +++ b/docs/design/backend/wasm/wasi-platform-library.md @@ -128,7 +128,7 @@ wrapper owns the corpus-facing name. | `Data.Function` | `apply`, `applyFlipped`, `const`, `flip`, `on`, `$`, `#` | nothing: it is the definition site, and `$`/`#` are its fixity aliases | FE-05 | | `Data.Semigroup` | `class Semigroup`, `append`, `<>` | nothing: it is the definition site for the class, and `append` for `String` is built from the compiler's `stringToBytes` / `arrayAppend` / `bytesToString`; `append` for `Array a` is `arrayAppend` | FE-14, BE-10 | | `Data.Monoid` | `class Monoid`, `mempty` | `Data.Semigroup`; `String`, `Unit`, and `Array a` identities | FE-14 | -| `Data.Foldable` | `class Foldable`, `foldr`, `foldl`, `foldMap` | `Data.Monoid` and the array index primitives; `Array`, `Maybe`, and `Either a` instances | FE-14, FE-16 | +| `Data.Foldable` | `class Foldable`, `foldr`, `foldl`, `foldMap` | `Data.Monoid` and the array index primitives; `Array`, `Maybe`, and `Either a` instances | FE-14 | | `Data.Tuple` | `Tuple`, `fst`, `snd`, `curry`, `uncurry`, `swap` | the closed record `{ _1 :: a, _2 :: b }` that FE-06 already lowers a tuple to; `type Tuple a b` is that record, not an algebraic `data Tuple a b = Tuple a b` | FE-06 | | `Effect` | re-exports the `Prelude` surface above | `Prelude` | FE-02 | | `Effect.Console` | `log`, `warn`, `error`, `logShow` | `WASI.Console`, and the library `Data.Show.show` for `logShow` | BE-21 | diff --git a/docs/design/frontend/README.md b/docs/design/frontend/README.md index a7380c4b..1cc94c6c 100644 --- a/docs/design/frontend/README.md +++ b/docs/design/frontend/README.md @@ -45,6 +45,7 @@ flowchart LR | [Kinds](type-system/kinds.md) | Kinds, constructor application, synonym legality | Checked kinds | | [Type inference](type-system/type-inference.md) | Schemes, unification, signatures, typed terms | THIR types | | [Classes and evidence](type-system/classes-and-evidence.md) | Constraint solving, coherence, explicit dictionaries | THIR evidence | +| [Deriving](type-system/deriving.md) | Known deriving rules, field usage, generated members | Generated instance members | | [Rows and records](type-system/rows-and-records.md) | Row unification and record typing | Typed row operations | Each arrow is an explicit conversion or a verified same-representation pass. diff --git a/docs/design/frontend/syntax/parsing-and-cst.md b/docs/design/frontend/syntax/parsing-and-cst.md index dc7ef621..c4fb6808 100644 --- a/docs/design/frontend/syntax/parsing-and-cst.md +++ b/docs/design/frontend/syntax/parsing-and-cst.md @@ -60,6 +60,13 @@ Rejected alternatives: parsing straight to AST would erase concrete forms; resolving fixities in P1 would require the module environment; and storing checked types on CST nodes would violate the representation boundary. +Record projection and record update bind to their atom before value +application. Thus `consume r.field` applies `consume` to the projected field, +and `consume r { field = value }` applies it to the updated record. Projecting +or updating the call result requires parentheses, as in `(consume r).field`. +The parser preserves those distinctions in CST; resolving or lowering does +not repair application grouping. + ## Algorithms ```text diff --git a/docs/design/frontend/type-system/README.md b/docs/design/frontend/type-system/README.md index 24418c78..9f5f89b7 100644 --- a/docs/design/frontend/type-system/README.md +++ b/docs/design/frontend/type-system/README.md @@ -1,7 +1,7 @@ # Frontend Type System -P5 consumes normalized resolved HIR and produces verified THIR. It has four -ordered concerns about the language's types, plus one about what the compiler +P5 consumes normalized resolved HIR and produces verified THIR. It has five +ordered concerns about the language's types and one about what the compiler itself provides: | Document | Owns | Dependency | @@ -9,9 +9,14 @@ itself provides: | [Kinds](kinds.md) | Constructor kinds, synonym expansion, kind legality, the program-wide checked kind and role environment | resolved HIR | | [Type inference](type-inference.md) | The shared type spine, schemes, signatures, unification, generalization, THIR | kinds | | [Classes and evidence](classes-and-evidence.md) | Constraints, instances, dictionaries, evidence elaboration | type inference | +| [Deriving](deriving.md) | The known deriving rules, their field-usage and variance checks, generated members, and newtype adaptation | classes, kinds | | [Rows and records](rows-and-records.md) | Row kinds, the row normalizer, row unification and equations | kinds and type inference | | [Primitives](prim.md) | The `Prim.*` member inventory, per-relation rules, report-only members, and the proof/dictionary split | kinds, type inference, classes, rows | +Deriving consumes the compiler-owned `Coercible` proof that [Primitives](prim.md) +defines, and it emits generated members that [Classes and evidence](classes-and-evidence.md) +checks and elaborates like written ones. + [Primitives](prim.md) answers what the compiler itself provides: it names every `Prim.*` member, says which layer owns each member's semantics, and specifies the contract a member's rule must satisfy. It owns no type form — a primitive is a diff --git a/docs/design/frontend/type-system/classes-and-evidence.md b/docs/design/frontend/type-system/classes-and-evidence.md index 2b9a34e3..e89fc3ac 100644 --- a/docs/design/frontend/type-system/classes-and-evidence.md +++ b/docs/design/frontend/type-system/classes-and-evidence.md @@ -69,14 +69,13 @@ instances. Source default implementations are not part of PureScript syntax. A backend fixture placing a default closure in a dictionary does not add a source-language feature. -Compiler-supported deriving rules are selected by resolved class identity, -including the declaring module; re-exporting a class does not change its -identity, and an unrelated user class with the same short name does not gain -the rule. Structural rules traverse the declared type's normalized field -types. `derive newtype` delegates to the wrapped class dictionary and checked -coercion boundaries instead of generating per-class wrappers. Every generated -method and underlying dictionary obligation goes through ordinary instance -checking and evidence selection, including for classes with no methods. +Compiler-supported deriving is its own topic, [deriving](deriving.md). This +document owns only what every derivation consumes: the class environment, the +instance solver, and evidence elaboration. A derived instance is an ordinary +instance whose members happen to be generated, so it is checked and its evidence +selected by the same path as a written instance; the deriving registry is +selected by resolved class identity, including the declaring module, rather than +by a name at the use site. `Coercible` consults the role vector in the checked kind environment. Equal types are reflexive. Matching constructors decompose arguments by role: nominal @@ -115,6 +114,13 @@ storage. Check class parameter kinds, dependency indices, superclass cycles, method signatures, instance heads and contexts, and coherence conditions before solving uses. Build a searchable instance environment respecting module visibility and the official orphan and instance-chain rules. Compiler-owned primitive evidence has an evidence-defined place in the search order: proof and relation rules run before direct given lookup; report rules run after it so a warning or unsolved report constraint can propagate through the enclosing declaration. For ordinary class constraints, search givens first, then superclass paths and candidate instances. Matching a given unifies flexible wanted arguments with the given's arguments transactionally; it never assigns a rigid given variable, and a failed candidate leaves no substitutions behind. Apply functional dependencies to improve unknowns using only the selected branch in each chain; repeat until stable. Compare every class argument in an instance head. Functional dependencies contribute the transitive closure of already matched positions, while arguments outside that closure can still prove a candidate apart. Within each visible chain, continue only when a branch is provably apart. A matching branch commits before its context is solved. An unknown non-final branch blocks later alternatives in that chain; unknown singleton and final branches are ignored. Unknown branches do not create an overlap with one definite match from an unrelated chain. Failure to solve a selected context does not fall through. Unrelated ordinary candidates must remain coherent; overlapping or unresolved obligations receive source-oriented diagnostics. Memoize and bound search to prevent cycles. +The common instance recorder rejects a class-argument count mismatch with +`ClassInstanceArityMismatch` before deriving or member inference. Derived +known-class rules separately diagnose a supported rule's own arity contract +with `InvalidDerivedInstance`. THIR compares instance context dictionaries +with semantic type equality, including alpha-equivalent method quantifiers; +Core lowering consumes that verified result rather than comparing arena IDs. + Elaboration turns a constrained binding into explicit evidence parameters and inserts evidence at overloaded uses. A method selection projects from its dictionary; a superclass selection follows a dictionary field. The frontend proves and records the selected path. Backend optimization may specialize dictionaries but cannot change which instance was selected. Which constraints become parameters is decided by generalization, not here: a declaration's scheme carries the constraints inference retained, and elaboration realizes exactly those as dictionary parameters, so a signature and an inferred scheme produce the same evidence shape. A superclass edge is instantiated, never re-derived. Dictionary construction and superclass search substitute the subclass's arguments into the edge's template and unify the result against the wanted constraint, so an edge written over an arbitrary type such as `C (Array a)` needs no separate rule. The dictionary field that stores a superclass dictionary is chosen from the edge's position, so the evidence and the field agree by construction. @@ -210,7 +216,7 @@ Evidence verification in the checked IR has a stated boundary, following [type i ## Open questions and future work -Track the official compiler's exact orphan, instance-chain apartness, and primitive-class rules as executable compatibility cases. The current source subset covers role-aware higher-kinded given rewriting, checked kind compatibility, canonical open-row alignment, structural `Eq`/`Ord`, covariant `Functor.map`, `Bifunctor.bimap`, `Contravariant.cmap` through `Profunctor.lcmap`, and `derive newtype`. Class method `forall` signatures, quantified method parameters, and method-local constraints are checked with independent instantiation and scoped dictionary evidence; their verification is tracked in the [rank-N acceptance record](../../../implementation/frontend/rank-n.md). The remaining class-specific deriving traversals remain open. The function-based `Contravariant` case still reaches a backend closure-capture limit, and open-row runtime conversion remains outside the current CC layout. Implementation coverage belongs in [D-04](../../D-04-suite-roadmap.md) and the [roles and coercions acceptance record](../../../implementation/frontend/roles-and-coercions.md). +Track the official compiler's exact orphan, instance-chain apartness, and primitive-class rules as executable compatibility cases. The current source subset covers role-aware higher-kinded given rewriting, checked kind compatibility, and canonical open-row alignment. Class method `forall` signatures, quantified method parameters, and method-local constraints are checked with independent instantiation and scoped dictionary evidence; their verification is tracked in the [rank-N acceptance record](../../../implementation/frontend/rank-n.md). Class-specific deriving rules are owned by [deriving](deriving.md). The function-based `Contravariant` case still reaches a backend closure-capture limit, and open-row runtime conversion remains outside the current CC layout. Implementation coverage belongs in [D-04](../../D-04-suite-roadmap.md) and the [roles and coercions acceptance record](../../../implementation/frontend/roles-and-coercions.md). ## References @@ -224,13 +230,9 @@ The current bounded coercion solver is a dedicated checker helper, while the design target exposes it as a separate `solve_coercible` service. Implemented source cases cover higher-kinded application-head rewrites, kind compatibility, role-aware canonical-given interactions, and aligned open rows; open-row values -still lack a runtime layout. Structural `Eq`/`Ord`, nested `Functor.map`, -`Bifunctor.bimap`, and checked newtype-derived methods execute for the covered -method signatures. Function-result mapping and `Contravariant` through a -profunctor dictionary match the upstream source rules; the function-based -Contravariant case still lacks Wasmtime evidence because of closure capture. -Class-method local constraints and quantified parameters are covered under -FE-18; the remaining upstream deriving classes keep FE-16 partial. +still lack a runtime layout. Class-method local constraints and quantified +parameters are covered under FE-18; class-specific deriving rules and their +coverage are owned by [deriving](deriving.md). The primitive rule table now covers all twelve row, row-list, symbol, and integer relations as well as the `Coercible` proof. `Prim.TypeError.Warn` reports through diff --git a/docs/design/frontend/type-system/deriving.md b/docs/design/frontend/type-system/deriving.md new file mode 100644 index 00000000..756b2b71 --- /dev/null +++ b/docs/design/frontend/type-system/deriving.md @@ -0,0 +1,485 @@ +# Deriving + +**Feature:** F-02 + +**Status:** Draft + +**Prerequisites:** [Classes and evidence](classes-and-evidence.md), +[kinds](kinds.md), [primitives](prim.md), and +[type inference](type-inference.md); PureScript's standard class library, +algebraic data types, newtypes, and compiler code generation. + +**Summary:** A `derive instance` or `derive newtype instance` declaration is +elaborated at P5 into ordinary instance members and a concrete instance head. +The rule for a supported class is chosen by the resolved identity of that class +in one checked deriving registry, never by the name a use spelled. Generated +members then flow through the same instance checking and evidence selection as +written members, so a derivation creates no second evidence path. + +## Scope + +This document owns the compiler's deriving rules: which class identities have a +rule, the structural traversal each rule performs, the variance and +instance-existence checks those traversals require, the diagnostic for an +underivable field, and the adaptation a `derive newtype` method receives at each +function boundary. + +It does not own the class solver, instance search, coherence, evidence +elaboration, or superclass projection; those are +[classes and evidence](classes-and-evidence.md). It does not own the +`Coercible` proof; [primitives](prim.md) owns that rule and this document only +consumes its proof boundary. It does not own roles or the checked kind +environment ([kinds](kinds.md)), the constraint and `TypeTemplate` +representation, or the surface grammar of `derive` declarations +([parsing and CST](../syntax/parsing-and-cst.md)). Deriving is a distinct topic +from the [roles and coercions](../../../implementation/frontend/roles-and-coercions.md) +concerns that the two share a feature matrix row with. + +## Background + +PureScript's `derive instance` asks the compiler to synthesize a class instance +from a locally declared data type's constructors and fields. Two families exist, +matching the official compiler: + +- **Structural classes** derive each method by walking the declared fields. + `Eq` and `Ord` compare or order fields; `Functor`, `Bifunctor`, + `Contravariant`, and `Profunctor` map over fields; `Foldable`, `Bifoldable`, + `Traversable`, and `Bitraversable` fold or traverse them. `Eq1`/`Ord1` are + delegated to their monomorphic counterpart. +- **Head-shape classes** `Newtype` and `Generic` do not derive a method body + from fields so much as a *type argument*: the newtype's wrapped type, or the + `Data.Generic.Rep` representation of the data type. `Generic` also generates + its `to` and `from` methods from that representation. + +The official compiler splits the two families across stages for a reason: +`Newtype` and `Generic` depend only on the declaration's structure and replace a +user-written type wildcard, so `Sugar/TypeClasses/Deriving.hs` elaborates them +before type checking. The structural classes need types and the instance +environment to decide how a field is used, so +`TypeChecker/Deriving.hs` elaborates them during type checking. Both stages +synthesize ordinary expressions that the normal type checker then checks; neither +introduces a special evidence form. + +`derive newtype instance` is a separate strategy. It does not walk the wrapped +type's fields at all: it selects the dictionary for the wrapped class head and +adapts each method at function boundaries through checked `Coercible` evidence. +The wrapped head is a class constraint on the same constraint spine every other +instance context uses. + +## Model + +```text +Strategy = KnownClass | Newtype +KnownClass = Eq | Eq1 | Ord | Ord1 + | Functor | Bifunctor | Contravariant | Profunctor + | Foldable | Bifoldable | Traversable | Bitraversable + | Generic | Newtype +CovariantPair = { mono: class, bi: class } -- Functor/Bifunctor, Foldable/Bifoldable, ... +ContraPair = { contra: class, pro: class } -- Contravariant/Profunctor + +ParamUsage = IsParam + | IsLParam + | MentionsParam(ParamUsage) + | MentionsParamBi(These(ParamUsage, ParamUsage)) + | MentionsParamContravariantly(ParamUsage) + | IsRecord(labels) + +DerivingRegistry = { + class: TypeId -> KnownClass, + method: (KnownClass, name) -> SymbolId, + ordering: Option<{ ty: TypeId, lt: SymbolId, eq: SymbolId, gt: SymbolId }>, + generic: Option, +} + +GenericRep = { + no_constructors: TypeId, no_arguments: TypeId, argument: TypeId, + product: TypeId, sum: TypeId, + constructor: SymbolId, inl: SymbolId, inr: SymbolId, +} +``` + +`These(a, b)` is the shared three-way shape `This a`, `That b`, or `These a b`: +a field can mention the left parameter, the right, or both, and a bipartite rule +needs that distinction rather than a single "mentions the parameter" bit. + +The **deriving registry** is the single owner of "which classes the compiler +knows and what their methods and representation types are." It is built once +when the semantic environment is constructed, from the resolved declarations of +the program plus the compiler's trusted core identity. Every rule reads it by +`TypeId`; the module and class names are inputs to its construction and never a +runtime predicate. A class with no entry is not derivable, whatever its name. + +`ParamUsage` records how one occurrence of a declared type parameter is used in +a field. `IsParam`/`IsLParam` are the monomorphic/bipartite parameter itself; +`MentionsParam` is a monotone nested occurrence; `MentionsParamBi` is a +bipartite occurrence carrying left and right usages independently; +`MentionsParamContravariantly` is an occurrence that flips polarity; +`IsRecord` records a record whose fields are used independently. This is the +official `ParamUsage` model; it is what lets one traversal serve `Functor`, +`Foldable`, and `Traversable` and their bipartite counterparts instead of +hand-writing one shape test per class. + +The generated method terms are ordinary resolved HIR. They reference the +class's own method symbols, the registry's representation constructor symbols, +and freshly allocated locals, and they convert to THIR through the ordinary +inference entry point. + +## Design + +### One registry, selected by identity + +Selecting a rule is a lookup `registry.class[class_id]`, not a match on a +qualified name. `KnownClass` is therefore a closed enum with one constructor per +supported class, and `registry.method` supplies each method symbol from the same +resolved class declaration the solver uses. The registry also supplies the +`Data.Generic.Rep` type and constructor symbols and the `Data.Ordering` +constructors, so no rule re-derives a symbol by scanning the type namespace or +comparing module strings. + +The registry is built from the checked declarations, so a re-export preserves +the defining identity and a same-named user class in another module does not +gain a rule. A class is known because the compiler put it in the registry, not +because a string matched. + +### Head shape, not head spelling + +For a structural class, the instance head's final argument must be a locally +declared data or newtype constructor, fully applied for `Eq`/`Ord` (which +traverse every parameter), or applied to all but the final one for +`Functor`/`Contravariant` (one parameter), or to all but the final two for +`Bifunctor`/`Profunctor` (two parameters). The check is on the flattened spine +of the resolved type, not on its printed form. + +Before any field is inspected, the field types are synonym-expanded through the +shared normalizer, so a synonym that expands to `f a` is treated as an applied +variable exactly as `purs` treats it. Eq and Ord must expand fields too; a rule +that only inspects the raw field type diverges from `purs` on a synonym-to-`f a` +field. + +### Field usage and variance + +A structural rule does not decide per field whether to direct-map, recurse, or +reject. It first computes a `ParamUsage` for every constructor field and +validates it against the class's variance. The official rule is: + +- A field that does not mention any parameter is inert. +- The parameter itself is `IsParam` (or `IsLParam`). +- A field whose head is a class for which the required instance exists is a + monotone/bipartite mention and is mapped through that class. +- A parameter under a function input, or any occurrence the class cannot map, + is rejected with `CannotDeriveInvalidConstructorArg`, naming the related + source positions. + +The existence check consults the same visible instance environment the solver +uses. This is what makes the rule agree with the solver: a derivation is +rejected at the declaration when a field head has no instance for the mapping +class, instead of being accepted and failing later with `NoInstanceFound`. It is +also what lets a bipartite class choose between the mono and bi mapping when a +field head has an instance for one and not the other. + +### Generated terms and one builder + +Every rule emits terms through one small builder that owns fresh local +allocation, lambda/case construction, application, and the boolean and ordering +literals. A rule states only its traversal — the two-lambda/case skeleton is +shared, not re-written per class. The builder's output is resolved HIR handed to +`infer_derived_method`, which elaborates the method signature at the instance's +class arguments and infers the body with that expected type. Dictionary +selection for each mapped field therefore happens in the ordinary solver, not in +the rule. + +`Eq1` and `Ord1` are the trivial delegations the official rule uses: `eq1 = eq` +and `compare1 = compare`, typed at the applied argument, so the matching +monomorphic instance supplies the dictionary. + +### Newtype deriving + +`derive newtype instance C ... T` resolves `T` to a locally declared newtype, +computes its wrapped type, and pushes the wrapped constraint `C ... wrapped` as +an ordinary wanted. For each method it selects the wrapped dictionary's method +and adapts it to the derived head: it peels shared method quantifiers, then +inserts a `Coercible` conversion at each arrow boundary; a method whose type is +already equal needs no conversion. The proof is the compiler-owned `Coercible` +relation from [primitives](prim.md); deriving produces no coercion proof of its +own and cannot forge one. + +Method-level `forall` binders are instantiated once with stable placeholders and +substituted separately at the two heads, so a quantifier shared by the method +signature has one identity on both sides of the adapter, while a quantifier that +shadows a class parameter stays scoped to the body. + +### Wildcard handling and Newtype/Generic + +`derive instance newtypeX :: Newtype T _` and +`derive instance genericX :: Generic T _` carry a trailing type wildcard: the +wrapped type or representation determines that argument. The wildcard is +resolved by the rule and the instance is recorded with a concrete final +argument, so instance-head validation and the solver never see a derivable +wildcard. Instance recording must not special-case a class identity to tolerate +one. + +### Diagnostics + +Each failure maps to its official `errorCode`, and there is one variant per +official error rather than one catch-all: + +| Condition | Code | +| --- | --- | +| Class has no registry rule | `CannotDerive` | +| Head is not the expected local constructor | `ExpectedTypeConstructor` | +| Structural class head has the wrong arity | `InvalidDerivedInstance` | +| `derive newtype` head is not a newtype | `InvalidNewtypeInstance` | +| `Newtype` class derived for a data type | `CannotDeriveNewtypeForData` | +| Field cannot be mapped under the class's variance | `CannotDeriveInvalidConstructorArg` | +| Deriving type cannot be found | `CannotFindDerivingType` | +| Newtype/Generic wildcard missing | `ExpectedWildcard` | + +Rejected alternatives: a single `UnsupportedClass`-style kind loses the code the +official suite matches on and collapses unrelated failures into one bucket. + +### Rejected: name-based selection and per-rule scaffolding + +Matching a class by its declarer's module string and short name re-derives an +identity the resolver already owns, lets a user module that reuses a core +module name claim a rule, and scatters the same table across every rule. Writing +a separate field walk per class, and a separate pattern/lambda skeleton per +rule, duplicates the variance decision and lets the rules drift apart. Both are +rejected in favor of one registry and one usage analysis feeding one traversal +builder. + +## Algorithms + +```text +derive_instance(instance): + strategy = instance.derivation or return instance unchanged + match strategy: + Newtype -> derive_newtype(instance) + KnownClass -> known_class = registry.class[instance.class_id] + or fail CannotDerive + match known_class: + Newtype -> derive_newtype_class(instance) # head-shape only + Generic -> derive_generic(instance) + _ -> derive_structural(known_class, instance) + +derive_structural(class, instance): + utc = require_local_constructor(instance.head, class) # arity per class + usages = validate_params(class, utc) # ParamUsage per field + for each method of the class: + body = mk_traversal(class, usages, utc) + emit Member(method, infer_derived_method(method, head_args, body)) + +validate_params(class, utc): + expand all field type synonyms + for each field: + usage = usage_of(class, field, polarity = covariant) + if usage is unsupported under class.variance: + fail CannotDeriveInvalidConstructorArg at the offending span + return usages + +usage_of(class, ty, polarity): + if ty does not mention any parameter: return inert + if ty is the parameter: return IsParam / IsLParam + if ty is an application f arg and f is a type constructor: + if registry instance env proves class.mapping_class at f: + return MentionsParam(usage_of(class, arg, polarity)) + elif contra/pro mapping class proves at f: + return MentionsParamContravariantly(usage_of(class, arg, flipped polarity)) + else: fail + if ty is a function input: return fail at this span + ... record, forall, constrained cases follow the model ... + +mk_traversal(class, usages, utc): + f, g = fresh locals; v = fresh local + branches = for each constructor: + bind fields to fresh locals + argument = for each field usage: map_field(usage, local) + reconstruct constructor with mapped arguments + return \f [\g] v -> case v of branches + +map_field(IsParam, x) = f x +map_field(MentionsParam(u), x) = map (map_field(u)) x +map_field(MentionsParamBi(These(uL,uR)), x) = bimap (map_field(uL)) (map_field(uR)) x +map_field(MentionsParamContravariantly(u),x) = cmap (map_field(u)) x # or lmap/dimap via Profunctor +map_field(IsRecord(fields), x) = record update applying map_field per field + +derive_newtype(instance): + wrapped = wrapped_type_of(instance head's final argument) # or fail InvalidNewtypeInstance + push_wanted(class, init(head_args) ++ [wrapped]) + for each method: + template = elaborate method signature with one placeholder per class parameter + source = template[wrapped]; target = template[head_args] + body = adapt(select(source), source, target) # Coercible at each arrow + emit Member(method, body) + +adapt(value, source, target): + peel matching shared foralls + if source == target: return value + if source = a -> b and target = a' -> b': + return \x -> adapt(value (coerce x), b, b') + return coerce value # checked Coercible source -> target +``` + +Edge cases: a data type with no constructors derives a `Functor`/`Foldable` body +that is an empty case, and `Generic` uses `NoConstructors`; a zero-field +constructor uses `NoArguments`; `Ord` orders constructors by declaration order +and fields lexicographically; an applied-variable field uses the class's `1` +counterpart when it has one; a nullary `derive` for a class the compiler knows +only as head-shape (`Newtype`) produces a dictionary with superclass fields and +no method. + +## Code map + +The deriving topic lives inside the P5 owner. The intended organization: + +- `typecheck/classes/deriving/mod.rs` — `Strategy`/`KnownClass` entry points and + `derive_instance`, dispatching to the rule families. +- `typecheck/classes/deriving/registry.rs` — `DerivingRegistry`, its construction from + the resolved declarations and trusted core identity, and the `TypeId` lookup. +- `typecheck/classes/deriving/usage/` — `ParamUsage`, `usage_of`, and + `validate_params`, reading the shared instance environment for the + existence checks. +- `typecheck/classes/deriving/syntax.rs` — the one term builder: fresh locals, + lambdas, cases, application, literals. No rule builds HIR by hand. +- `typecheck/classes/deriving/eq.rs`, `ord.rs`, `functor.rs`, `bifunctor.rs`, + `contravariant.rs`, `profunctor.rs` — the `Functor`-shaped rules. +- `typecheck/classes/deriving/foldable/` — `Foldable`/`Bifoldable`, driven by the + usage tree. +- `typecheck/classes/deriving/traversable.rs` — `Traversable`/`Bitraversable`. +- `typecheck/classes/deriving/newtype.rs` — newtype strategy and the `Coercible` + adapter. +- `typecheck/classes/deriving/generic.rs` — representation type and `to`/`from`. +- `typecheck/error.rs` — the official deriving diagnostic variants and their + `errorCode` mapping. + +`identity` is defined by `Control.Category` and re-exported by `Data.Function`; +the registry retains that defining SymbolId. Minimal standalone fixtures may +provide `Data.Function.identity` directly, resolved during registry construction. +Consumers do not infer identity from an import spelling. + +The registry also holds the trusted core value identities (`append`, `mempty`, +`identity`, `apply`, `pure`) the fold and traversal rules name, resolved from +the program's value declarations by declaring module and name. + +The registry is constructed where the semantic environment is, so every rule +reads it as immutable checked metadata. The current file inventory is not the +design; code is expected to conform to this map, not the reverse. + +## Invariants and verification + +- Every rule is selected by `TypeId`; no rule compares a class module or name at + use time. +- A generated method proves exactly its class method's type at the instance + head. The ordinary inference path establishes this; there is no deriving-only + evidence form. +- Field usage agrees with the class's variance and with the visible instance + environment: a derivation is accepted exactly when every field occurrence has + the mapping instance the traversal needs. +- A newtype method conversion is authorized by a checked `Coercible` proof; the + adapter inserts no unchecked cast. +- A derivable wildcard is resolved before instance recording; no instance is + recorded with a wildcard it should not have. +- Each failure carries the official `errorCode` for its condition. + +The THIR verifier trusts the deriving rule's class selection and generated +evidence, on the same basis it trusts the solver's instance choice +([classes and evidence](classes-and-evidence.md#boundaries-and-interfaces)). A +guarantee that must be verified rather than trusted needs its metadata carried +across the P5 boundary; deriving does not change that boundary. + +Verification is by the official differential set: for each supported class, an +accepted source case and a rejected field-variance case compared with `purs` on +accept/reject and diagnostic code, plus the runtime cases for the classes whose +methods execute. + +## Worked example + +```purescript +data Pair a b = Pair a b | Left a | Right b + +derive instance bifunctorPair :: Bifunctor Pair +``` + +The rule is selected from the instance's class, +`Data.Bifunctor.Bifunctor`, through the registry built at P5; the type `Pair` +itself selects nothing. The head is locally declared and applied to all but its +final two parameters. Field usage is computed after synonym expansion: + +- `Pair a b`: `IsLParam` for `a`, `IsParam` for `b` — both covariant. +- `Left a`: `IsLParam` for `a`. +- `Right b`: `IsParam` for `b`. + +`map_field` maps `a` with `lmap`-style left marker `f` and `b` with right marker +`g`, so the generated body is + +```text +\f g v -> case v of + Pair a b -> Pair (f a) (g b) + Left a -> Left (f a) + Right b -> Right (g b) +``` + +`infer_derived_method` checks it against `bimap :: forall a b c d. (a -> b) -> +(c -> d) -> Pair a c -> Pair b d`, and the pair of mapper arguments fixes the +same parameter identities the instance head supplies. A field `a -> b` would +fail `validate_params` at its span with `CannotDeriveInvalidConstructorArg`, +because the left parameter appears under a function input. + +## Boundaries and interfaces + +Deriving consumes resolved HIR instance declarations, the checked kind and role +environment, the class environment, and the visible instance environment. It +produces generated method terms and, for `Newtype`/`Generic`, a concrete final +head argument, handing both to the instance-checking path in +[classes and evidence](classes-and-evidence.md). It consumes the `Coercible` +proof from [primitives](prim.md) but does not implement it. It adds no node to +CST, AST, or HIR; a derived instance is an ordinary instance after elaboration. + +## Open questions and future work + +- **Stage of `Newtype`/`Generic`.** The official compiler resolves their + wildcard in sugar. This design keeps all deriving at P5 so the registry and + the diagnostic surface are one owner. If the wildcard-before-recording rule is + easier to guarantee at P4, the head-shape rules may move there without moving + the structural rules; the split is a placement choice, not a semantic one. +- **Trusted core identity.** The registry needs stable identities for the core + declarations it names. How those identities are pinned (a trusted-declaration + table, or a checked marked set) is [primitives](prim.md)'s identity question; + deriving only requires that the registry is built once and read by `TypeId`. +- **Variance and the instance environment.** `validate_params` consults instance + existence. The exact boundary between "no instance yet" and "no instance + possible" is the solver's, and deriving must not form a second opinion; the + interaction belongs with the instance-search contract. +- **Remaining classes.** `Profunctor` and the foldable/traversable bipartite + classes have no implementation yet; this document specifies their intended + rules, and the acceptance record tracks which have source and runtime + evidence. + +## References + +- PureScript `TypeChecker/Deriving.hs` (structural rules, `ParamUsage`, + `validateParamsInTypeConstructors`, `mkTraversal`) and + `Sugar/TypeClasses/Deriving.hs` (`Generic` and `Newtype` elaboration). +- PureScript `Constants/Libs.hs` for the class, method, and representation + symbols the registry must resolve. +- [Classes and evidence](classes-and-evidence.md) for the solver and evidence + contract a derived instance uses. +- [Primitives](prim.md) for the `Coercible` proof boundary. +- [Kinds](kinds.md) for roles and the checked environment. + +## Implementation notes + +These record where the current code deviates from this design. They are not the +design; the sections above are normative. + +- **Usage owns structural traversal.** `usage/` computes field variance and + checks visible instance-head identities. As in official deriving, this is a + head-constructor availability test; ordinary inference checks the generated + member's complete instance constraints. All mapping families generate terms + from that tree, including canonical record fields and scoped `forall` + occurrences. Fold and traversal families consume the same analysis. An + unsupported mapped open row remains a diagnostic. +- **Coverage.** Every structural class has a rule. Generic round trips, + traversal effects, function Contravariant adapters, polymorphic newtype + adapters, and applied-variable Eq/Ord dictionaries have executed runtime + evidence. Coverage and remaining verification obligations are tracked in the + [deriving acceptance record](../../../implementation/frontend/deriving.md). diff --git a/docs/implementation/backend/type-classes-and-dictionaries.md b/docs/implementation/backend/type-classes-and-dictionaries.md index 9a64c754..43f5c5e2 100644 --- a/docs/implementation/backend/type-classes-and-dictionaries.md +++ b/docs/implementation/backend/type-classes-and-dictionaries.md @@ -14,7 +14,7 @@ currently reaches a P8 closure-capture limit and is not runtime-verified. Scoped method-local constraints and quantified method parameters have evidence in the [rank-N acceptance record](../frontend/rank-n.md). FE-14/15 remain partial because the complete official-suite reconciliation is incomplete. Other deriving -rules remain tracked under FE-16. +rules remain tracked under FE-22. **Roadmap:** [D-04 backend matrix](../../design/D-04-suite-roadmap.md#backend-feature-matrix), supporting BE-02 and BE-09; FE-14 and FE-15 supply resolved evidence. @@ -108,7 +108,7 @@ DICT-01: Result: pass; the positive case executed under Wasmtime. Gaps: an instance-member constrained annotation is not yet solved merely to specialize it to a monomorphic expected class-method type; the frontend owns - this FE-14 boundary. FE-16 executes structural `Eq`/`Ord`, nested `Functor`, + this FE-14 boundary. FE-22 executes structural `Eq`/`Ord`, nested `Functor`, `Bifunctor`, and newtype-derived dictionaries. `Contravariant` and function-result `Functor` have source and upstream differential evidence, but no Wasmtime result for the function adapter due @@ -255,7 +255,7 @@ DICT-11: Result: source tests pass with required Wasmtime execution for imported chains, transitive fundep selection, independent-argument fallback, repeated-head apartness, and recursive variable-headed application heads. - Gaps: deriving under FE-16 is partial (structural `Eq`/`Ord`, `Functor`, + Gaps: deriving under FE-22 is partial (structural `Eq`/`Ord`, `Functor`, `Bifunctor`, and newtype methods execute; function-based `Contravariant` is type-checked but not runtime-verified due closure capture), explicit foralls or constraints in method signatures and full official-suite acceptance remain @@ -302,7 +302,7 @@ DICT-11: annotation still cannot be solved solely to specialize it to a monomorphic expected class-method type; see the [frontend class and evidence design](../../design/frontend/type-system/classes-and-evidence.md). - Deriving belongs to FE-16. Source default methods are not part of PureScript + Deriving belongs to FE-22. Source default methods are not part of PureScript syntax; Typed Core default-field fixtures establish only the backend dictionary behavior. - Official test suite: class/instance upstream cases have not been individually diff --git a/docs/implementation/frontend/deriving.md b/docs/implementation/frontend/deriving.md new file mode 100644 index 00000000..64615ed1 --- /dev/null +++ b/docs/implementation/frontend/deriving.md @@ -0,0 +1,140 @@ +# Deriving Implementation Acceptance + +**Feature:** [F-02](../../feature/F-02-portable-programs.md) + +**Design:** [Deriving](../../design/frontend/type-system/deriving.md), with +[classes and evidence](../../design/frontend/type-system/classes-and-evidence.md), +[kinds](../../design/frontend/type-system/kinds.md), and +[primitives](../../design/frontend/type-system/prim.md). + +**Progress:** The seven deriving handoff items are implemented, with expanded +source, differential, and runtime evidence. The shared usage tree now drives +all mapping families and parameter-bearing record fields. Generic round trips, +Traversable/Bitraversable, function Contravariant adapters, and polymorphic +newtype adapters execute. Whole-workspace validation retains the unrelated +failures listed below; FE-22 remains partial for corpus mismatches in the +shared instance-declaration checks rather than a missing structural rule. + +## Acceptance matrix + +| ID | Requirement | Required evidence | State | +| --- | --- | --- | --- | +| DR-01 | AST/HIR retain the derivation strategy and distinguish `derive instance` from `derive newtype instance`. | AST lowering and HIR derivation field; source and runtime cases for both strategies. | Verified | +| DR-02 | A rule is selected by resolved class identity: a re-exported class keeps its rule, and an unrelated same-name class does not gain one. | Differential cases `deriving-recognizes-the-reexported-data-eq-identity`, `deriving-custom-prelude-eq-is-not-a-known-class`, `deriving-user-eq-is-not-selected-by-unqualified-name`. | Verified for covered cases | +| DR-03 | One deriving registry, read by `TypeId`, selects rules; no rule compares a class module or name at use time. | `DerivingRegistry::build` maps resolved class identities and their method symbols once; `known_class`/`method` read it by `TypeId`. No deriving rule, and no wildcard check, compares a module or name at use time. | Verified | +| DR-04 | A structural head is a locally declared data or newtype constructor applied at the class-appropriate arity, and a newtype head is a newtype. | Source cases `derives_newtype_for_a_partially_applied_type_constructor`, `rejects_newtype_deriving_for_a_data_declaration`, `derives_a_higher_kinded_newtype_instance_through_the_wrapped_type`; differential newtype cases. | Verified for covered cases | +| DR-05 | Every structural rule synonym-expands field types before deciding how a field is used. | Every implemented family (`Eq`, `Ord`, `Functor`, `Bifunctor`, `Contravariant`) normalizes its field types before the usage test; the alias case is exercised for `Functor` (`derives_nested_functor_mapping_through_an_imported_dictionary`). Runtime `eq_and_ord_expand_applied_variable_aliases_and_use_higher_kinded_dictionaries` checks both alias expansion and Eq1/Ord1 field dispatch. | Verified for covered cases | +| DR-06 | Field usage and variance are validated against the visible instance environment, and an unmappable field is `CannotDeriveInvalidConstructorArg` at its span. | `usage/` walks every field with polarity and instance existence; `deriving_failures_report_their_official_error_codes` covers a contravariant field and a field head with no mapping instance. | Verified for covered cases | +| DR-07 | Generated members are ordinary expressions: inference elaborates the method at the instance head and selects each field's dictionary. | Runtime cases execute derived methods through ordinary dictionaries. | Verified | +| DR-08 | Structural `Eq` compares constructor tags and fields and recurses through the instance dictionary. | Runtime `imported_structural_eq_instance_executes_constructor_and_field_comparisons`, `derives_recursive_eq_through_its_instance_dictionary`; differential `deriving-structural-eq`. | Verified | +| DR-09 | `derive Eq1`/`Ord1` delegate to their monomorphic counterpart, and a structural `Eq`/`Ord` field of type `f a` is compared through `eq1`/`compare1`. | Source `derives_eq1_and_ord1_by_delegating_to_the_monomorphic_method`; Runtime `eq_and_ord_expand_applied_variable_aliases_and_use_higher_kinded_dictionaries` executes the applied-variable field, derived Eq1/Ord1 dictionaries, and unequal/order cases. | Verified for covered cases | +| DR-10 | Structural `Ord` orders constructors by declaration order and fields lexicographically. | Runtime `derived_ord_executes_constructor_and_lexicographic_field_order`; differential `deriving-structural-ord`. | Verified | +| DR-11 | `Functor` maps nested applications and function results, and rejects a parameter under a function input. | Runtime `derives_nested_functor_mapping_through_an_imported_dictionary`; differential function-result and nested-function cases and `deriving-functor-rejects-contravariant-field`. | Verified | +| DR-12 | `Bifunctor` maps the final two parameters and rejects a negative parameter position. | Runtime `derives_bifunctor_mapping_for_both_type_parameters`; differential `deriving-bifunctor-final-two-parameters` and `deriving-bifunctor-rejects-negative-parameter`. | Verified | +| DR-13 | `Contravariant` maps function inputs through the `Profunctor.lcmap` dictionary and rejects a positive parameter. | Differential `deriving-contravariant-function-input` and `deriving-contravariant-rejects-positive-parameter`; runtime `function_contravariant_deriving_executes_its_adapter` and its record-field counterpart check both predicate outcomes and retained inert fields. | Verified | +| DR-14 | `derive newtype` selects the wrapped class dictionary and adapts each method at function boundaries through checked `Coercible` evidence, including empty classes and cross-module instances. | Runtime `imported_newtype_derived_dictionary_executes_its_coercion_adapter`, `derives_a_higher_kinded_newtype_instance_through_the_wrapped_type`; differential empty-class cases; source `derives_newtype_methods_from_the_wrapped_instance`. | Verified for covered cases | +| DR-15 | A rank-1 method `forall` is instantiated once and shared across the adapter's two heads. | Source `newtype_deriving_accepts_a_polymorphic_class_method`; runtime `polymorphic_newtype_deriving_executes_its_adapter` executes the same method at Boolean and Array argument instantiations. | Verified | +| DR-16 | A derivable `Newtype`/`Generic` wildcard is resolved before the instance is recorded. | `record_instance` resolves the wildcard through the registry and stores the concrete wrapped/representation type in the recorded head; a non-wildcard final argument is `ExpectedWildcard`. `derives_newtype_class_for_a_newtype_with_a_wildcard` covers the resolved path. | Verified | +| DR-17 | `Generic` derives the `Data.Generic.Rep` representation and its `to`/`from` methods. | Source `derives_generic_representation_for_a_data_type`; Runtime `generic_deriving_round_trips_constructor_tags_and_fields` checks nullary, unary, and multi-field constructors. | Verified for covered cases | +| DR-18 | `Profunctor`, `Foldable`, `Bifoldable`, `Traversable`, and `Bitraversable` have their structural rules. | Source `derives_profunctor_through_a_contravariant_field`, `derives_foldable_for_single_field_constructors`, `derives_bifoldable_for_a_two_parameter_type`, `derives_traversable_for_single_field_constructors`, `derives_bitraversable_for_a_two_parameter_type`; runtime `derived_foldable_executes_through_its_instances`. Runtime modules `adapters`, `folds`, `records`, and `traversals` execute every listed class, both fold directions, sequencing, multi-field effects, and preserved inert fields. `differential_remaining_deriving_rules_against_purs` checks every remaining family, record fields, rejection polarity, given dictionaries, and scoped forall parameters. | Verified for covered cases | +| DR-19 | Each deriving failure carries its official `errorCode` (`CannotDerive`, `ExpectedTypeConstructor`, `InvalidDerivedInstance`, `InvalidNewtypeInstance`, `CannotDeriveNewtypeForData`, `CannotDeriveInvalidConstructorArg`, `CannotFindDerivingType`, `ExpectedWildcard`). | `deriving_failures_report_their_official_error_codes` asserts `CannotDerive`, `CannotDeriveNewtypeForData`, `CannotDeriveInvalidConstructorArg`, `InvalidNewtypeInstance`, and `ExpectedWildcard`; `differential_deriving_error_codes_against_purs` confirms the code agrees with `purs` on rejected cases. `fold_deriving_reports_missing_core_values_at_the_declaration` covers `CannotFindDerivingType` for both fold classes: multiple contributing fields require `append`, and constructors without contributions require `mempty`. `deriving_rejects_non_constructor_heads_and_invalid_class_arity` directly checks `ExpectedTypeConstructor` and `InvalidDerivedInstance`, also confirmed by the differential diagnostic battery. The common recorder reports `ClassInstanceArityMismatch` before deriving when the declaration does not supply one argument per class parameter. | Verified for covered conditions | +| DR-20 | Source behavior agrees with official PureScript across the deriving surface, including diagnostics. | Differential batteries cover 18 original rules, 17 remaining-family/context/scoped-parameter cases, and six rejected diagnostic cases; a separate case agrees with purs on record postfix precedence. | Verified for covered cases | + +## Evidence and commands + +Source-only cases are in `crates/psrs-driver/src/tests/deriving/` (18 tests). +Value-level execution is in +`crates/psrs-driver/src/tests/wasi/classes/deriving/` (25 tests), with observable +assertions for every structural class. The official differential battery is +`crates/psrs-driver/tests/upstream/deriving/` (four Rust tests). + +```sh +cargo fmt --all --check +cargo test -p psrs-driver --lib tests::deriving +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::wasi::classes::deriving +PURESCRIPT_REPO=/Users/biu/Projects/purescript cargo test -p psrs-driver --test upstream deriving +PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast +cargo clippy --workspace --all-targets -- -D warnings +PSRS_ORACLE=annotations cargo test -p psrs-driver --test suite types::l4_l5_scoreboard_with_annotations -- --ignored --nocapture +``` + +The fold diagnostic regression reproduced a silently discarded multi-field +instance before the fix. Both fold classes now report `CannotFindDerivingType` +at the derive declaration for required missing `append` or `mempty`; a single +contribution requires neither an unnecessary append nor an unused folding +method. Generated mapping, fold, traversal, and Generic terms use the shared +syntax builder. + +Traversal exposed two shared backend representation boundaries. Aggregate +layouts and callable signatures now converge together rather than publishing +partially normalized product identities. Bare polymorphic function slots use +a registered unary erased calling protocol; erasure and recovery adapt every +argument and result instead of casting a concrete callable to a consumer +signature. The independent `erased_function_slots_preserve_partial_application_and_captures` +case checks flattened multi-argument functions and captured partial +applications. The existing 33-case generic aggregate battery also executes. +Record projection/update precedence agrees with the official parser; the +nested aggregate fixture explicitly parenthesizes the call result it projects. + +Generic representation literals compare by value in inference evidence and +Core's invariant type relation. THIR instance context parameters compare by +semantic equality, retaining rejection of an actually different dictionary. +Core lowering consumes that verified check; P8 uses the shared Core type +relation for alpha-equivalent lambda parameter types. A derived higher-kinded +Traversable context has source differential and runtime execution evidence. + +The trusted core-library path also executes `Generic` to/from round trips, +Traversable traverse/sequence, and Bitraversable bitraverse/bisequence with +`Maybe` effects and record fields. `identity` retains its defining +`Control.Category` symbol even when re-exported by `Data.Function`. +`Data.Tuple` supplies its ordinary derived `Functor (Tuple a)` instance, +required by `Data.Traversable`'s existing Tuple instance. The standard-library +loader's trusted-order regression passes. + +Validation on 2026-10-06 used Wasmtime 49.0.2 and purs 0.15.16. The 18 source +tests, 25 required-runtime deriving tests, and four differential batteries pass. +The backend (393), Core (79), THIR (25), and typechecker (134) unit tests pass. +Formatting, the local diff check, and changed Markdown link checks pass. + +The full required-runtime workspace run retains three failing targets: +`psrs-cli --test source_layout` (the pre-existing 510-line `partial.rs`), +`psrs-driver --test prim_row` (the pre-existing nested Union deferred execution +case), and the driver library. The newly required Tuple dependency first +exposed two isolated source fixtures that omitted `Data.Functor`; those tests +now load the real trusted library graph and both execute. After that test-only +correction, the full driver library rerun reports **581 passed / 10 failed**, +with exactly the handoff's ten pre-existing failures. + +Default workspace Clippy fails on the handoff's pre-existing +`unnecessary_to_owned`, `too_many_arguments`, and `result_large_err` findings. +The workspace check with the handoff's known lint categories allowed passes +(including its test-only `field_reassign_with_default`, `manual_contains`, and +`dead_code` allowances). This does not establish a clean default Clippy gate. +No L6/M7 corpus runtime measurement was run; the 25 execution cases are focused +acceptance evidence and are not a replacement for that scoreboard. + +## Known boundaries + +The L5 scoreboard includes unrelated shared class-rule mismatches, notably +orphan checks and invalid record/synonym instance heads. The annotated L4/L5 +run on 2026-10-06 measured L4 39/50 and L5 75/97, +with 11 cases blocked before a mapped diagnostic. L5 decomposes into +`OverlappingInstances` 8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, +`InvalidNewtypeInstance` 6/6, `InvalidInstanceHead` 1/7, +`DuplicateInstance` 1/1, `ClassInstanceArityMismatch` 4/4, +`CannotDeriveInvalidConstructorArg` 7/7, `PossiblyInfiniteInstance` 0/1, +`OrphanInstance` 0/7, and `DuplicateTypeClass` 0/1. Unsupported mapped open rows +remain explicit diagnostics rather than +empty usage results. Structural rule availability is a visible head-identity +check, matching official deriving; ordinary inference owns complete instance +constraint selection. + +## Completion rule + +Do not mark the deriving topic complete until DR-01..DR-20 have implementation +and source-level acceptance/rejection evidence, the single registry and the +field-usage analysis replace the scattered identity and shape checks, every +deriving failure reports its official `errorCode`, and every runtime requirement +executes with `PSRS_REQUIRE_WASMTIME=1`. The official differential set must then +include diagnostic-code agreement and the remaining structural classes. Run the +workspace test, format, and Clippy gates after code changes. diff --git a/docs/implementation/frontend/roles-and-coercions.md b/docs/implementation/frontend/roles-and-coercions.md index 69ee973d..51461d73 100644 --- a/docs/implementation/frontend/roles-and-coercions.md +++ b/docs/implementation/frontend/roles-and-coercions.md @@ -5,16 +5,13 @@ **Design:** [Kinds and type constructors](../../design/frontend/type-system/kinds.md), [classes and evidence](../../design/frontend/type-system/classes-and-evidence.md), [primitives](../../design/frontend/type-system/prim.md), and [polymorphism and erasure](../../design/backend/fp/polymorphism-and-erasure.md). **Progress:** Partial. Role inference/checking and the covered role-aware -`Coercible` rules are implemented through source, Typed Core, and CC. Structural -`Eq`/`Ord`, nested `Functor.map`, direct `Bifunctor.bimap`, and checked -`derive newtype` method adapters execute through ordinary dictionaries. -`Contravariant.cmap` follows the resolved `Profunctor.lcmap` dictionary and -matches the upstream source rule. Known deriving rules are selected by the -resolved class owner and name, so a re-export keeps its defining identity. -Other upstream deriving classes remain incomplete. Rank-1 method `forall` +`Coercible` rules are implemented through source, Typed Core, and CC. Deriving is +a distinct topic: its selected rules, coverage, and requirement IDs are recorded +in the [deriving acceptance record](deriving.md). Rank-1 method `forall` signatures and scoped method-local constraints are checked and instantiated independently at use sites, including quantifiers that shadow class parameters. -The acceptance evidence and remaining runtime limits are recorded below. +The roles and `Coercible` acceptance evidence and remaining runtime limits are +recorded below. ## Scope @@ -37,7 +34,7 @@ polymorphism-and-erasure design. | RC-06 | Newtype unwrapping requires its constructor to be visible. Nested visible newtypes and imported constructors are supported; visible nominal newtypes unwrap before parameter roles are compared. | `an_imported_newtype_requires_its_constructor_for_unwrapping`; Wasmtime tests `unwraps_nested_visible_newtypes_when_wasmtime_is_available`, `coerces_through_an_imported_visible_newtype_when_wasmtime_is_available`, and `unwraps_both_sides_before_applying_a_nominal_newtype_role_when_wasmtime_is_available`. | Verified for covered cases | | RC-07 | Checked coercion evidence retains source/target types through THIR and Core; malformed evidence cannot authorize a different boundary. | THIR `verifier_rejects_coercion_evidence_for_a_different_boundary`; Core verifier checks cast source and target against its value and result. | Verified | | RC-08 | Lowering uses the existing typed value-conversion protocol, including nested ADT fields, arrays, and function adapters; a source proof never becomes an arbitrary Wasm reference cast. | Wasmtime tests cover coercing parameterized newtypes to scalar, function, and array payloads; visible nested newtypes; phantom sums with constructor-tag preservation; representational data fields and imported aliases; imported generic constrained functions; and cross-module given transitivity. | Verified for listed shapes | -| RC-09 | FE-16 deriving generates checked instance evidence and handles newtype deriving rules. | AST/HIR retain the derivation strategy. Source and runtime tests cover structural `Eq` and `Ord`, `Functor` through imported and nested dictionaries, `Bifunctor`, recursive `Eq`, constructor and field order, rank-1 method polymorphism, cross-module newtype-derived dictionaries with checked coercion adapters, and partially applied higher-kinded newtype heads. Source/differential cases also cover `Contravariant` through `Profunctor.lcmap`, function-result traversal, alias expansion, empty-class validation, re-exported canonical class identity, and rejection of same-name user classes. `differential_deriving_rules_against_purs` compares 18 accepted/rejected cases. | Partial | +| RC-09 | Deriving is its own topic with requirement IDs DR-01..DR-20; this record does not own its rules or coverage. | See the [deriving acceptance record](deriving.md). | Moved | ## Source and runtime coverage @@ -47,19 +44,16 @@ hidden newtype constructors, imported aliases in data fields, higher-kinded given rewriting, kind mismatch, open-row alignment, and recursive given interactions. Value-sensitive Wasmtime tests execute the conversions, including parameterized newtype payloads represented as scalars, functions, and arrays; -a multi-constructor phantom value verifies its tag survives coercion. Separate -class tests execute structural `Eq`, recursive `Eq`, structural `Ord`, nested -`Functor.map`, `Bifunctor.bimap`, rank-1 method polymorphism, and the -cross-module newtype-derived dictionary. `Contravariant` and function-result -mapping type-check against upstream rules. The `Contravariant` function -adapter's source implementation currently reaches a P8 closure-capture limit, -so that case has no Wasmtime execution evidence yet. Focused runtime commands: +a multi-constructor phantom value verifies its tag survives coercion. Derived +instance tests are owned by the [deriving acceptance record](deriving.md). +Focused runtime commands: ```sh PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::wasi::coercion -PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::wasi::classes::deriving ``` +Deriving runtime commands are in the [deriving acceptance record](deriving.md). + The compiler-provided value shim follows upstream's `Safe.Coerce.coerce` source API; `Prim.Coerce.Coercible` remains the compiler-owned class, and `Unsafe.Coerce.unsafeCoerce` is the compiler-owned intrinsic that `coerce` is @@ -69,12 +63,9 @@ newtype through `unsafeCoerce` and runs to its value under mandatory Wasmtime. T durable `differential_role_and_coercible_rules_against_purs` test compares 20 accepted and rejected fixtures with `purs 0.15.16`, including role decomposition, higher-kinded given rewriting, checked kind compatibility, -open-row label alignment, and recursive-given behavior. The -`differential_deriving_rules_against_purs` test compares 18 deriving cases, -including structural `Eq` and `Ord`, alias and function-result `Functor.map`, -`Bifunctor`, `Contravariant` through a `Profunctor` instance, ordinary and -higher-kinded newtype adaptation, re-exported canonical classes, same-name -user classes, and empty-class derivation validation. +open-row label alignment, and recursive-given behavior. The deriving +differential battery is recorded in the +[deriving acceptance record](deriving.md). ## Known boundaries @@ -86,26 +77,17 @@ call-site special case rather than the primitive rule table the [primitives design](../../design/frontend/type-system/prim.md) specifies; both are recorded there as the deviations they are. Open-row values still have no runtime layout in the current CC path, while closed reordered records execute through Wasmtime. -The structural deriving subset covers `Eq`, `Ord`, `Functor.map` through -direct, nested application, and result-position function fields, -`Bifunctor.bimap` for final parameter pairs, and `Contravariant.cmap` through -the `Profunctor.lcmap` dictionary. `Eq1`, `Ord1`, `Foldable`, `Traversable`, -`Bifoldable`, `Bitraversable`, and deriving `Profunctor` still need their -upstream rules. Class-method `forall` and scoped method-local constraints are supported, -with evidence in the [rank-N acceptance record](rank-n.md). Record-field -traversal and full deriving variance checking remain open. Runtime closure capture limits also leave the function-based -Contravariant example unexecuted. Polymorphic newtype-derived methods share a -single method-quantifier instantiation at the checked adaptation boundary; -their source/typecheck regression passes, but their Wasmtime execution remains -unverified because the generated adapter reaches the same P8 closure-capture -limit. Existing non-polymorphic newtype-derived methods have runtime evidence. -FE-16 remains Partial until the other upstream deriving rules and remaining -official coercion cases have source and runtime evidence. +Class-method `forall` and scoped method-local constraints are supported, with +evidence in the [rank-N acceptance record](rank-n.md). Deriving boundaries, +including its variance checks, `Eq1`/`Ord1`, and the remaining upstream classes, +are owned by the [deriving acceptance record](deriving.md). FE-16 remains Partial +until the remaining official coercion cases have source and runtime evidence. ## Completion rule -Do not mark FE-16 complete until RC-01..RC-09 have implementation and +Do not mark FE-16 complete until RC-01..RC-08 have implementation and source-level acceptance/rejection evidence, every runtime requirement executes with `PSRS_REQUIRE_WASMTIME=1`, and the official compatibility set includes the -remaining coercion solver cases and deriving behavior. Run the workspace test, -format, and Clippy gates after code changes. +remaining coercion solver cases. Deriving has its own completion rule in the +[deriving acceptance record](deriving.md). Run the workspace test, format, and +Clippy gates after code changes. diff --git a/stdlib/lib/Data/Tuple.purs b/stdlib/lib/Data/Tuple.purs index 8e1a347c..702f72c5 100644 --- a/stdlib/lib/Data/Tuple.purs +++ b/stdlib/lib/Data/Tuple.purs @@ -11,8 +11,12 @@ module Data.Tuple , swap ) where +import Data.Functor (class Functor) + data Tuple a b = Tuple a b +derive instance functorTuple :: Functor (Tuple a) + -- | The first component. `fst (Tuple x y)` is `x`. fst :: forall a b. Tuple a b -> a fst (Tuple first _) = first From faf85d45cc8c82dc51d549a6572b9de50ff078b3 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 04:53:58 +0800 Subject: [PATCH 018/148] Reuse the wrapped dictionary for derive newtype Ordinary Coercible still cannot lift Coercible a b through an unknown constructor to Coercible (f a) (f b). That refusal matches purs. derive newtype does not ask for the proof. After the local single-field newtype and the underlying instance are checked, the derived methods reuse the wrapped dictionary and adapt each boundary with a representation cast authorized by that newtype. Beta-reducing the cast kept the method quantifier only on the let result. The binding now carries the same leading forall, so a variable such as Traversable's m stays in scope. The quantifier is not Coercible evidence. Validated with focused driver tests under PSRS_REQUIRE_WASMTIME=1, including unknown-constructor dictionary reuse, the ordinary Coercible rejection, and derived Traversable execution. The psrs-core optimizer tests passed. The full workspace suite was not run. --- crates/psrs-core/src/lower/mod.rs | 1 + .../src/opt/inline/global/analysis.rs | 27 ++++- .../psrs-core/src/opt/inline/global/call.rs | 6 +- crates/psrs-core/src/opt/inline/global/mod.rs | 2 +- crates/psrs-core/src/opt/inline/local.rs | 107 ++++++++++++++---- crates/psrs-core/src/opt/tests/rank_inline.rs | 56 +++++++++ crates/psrs-driver/src/tests/coercion.rs | 21 ++++ crates/psrs-driver/src/tests/deriving/mod.rs | 31 +++++ .../tests/wasi/classes/deriving/adapters.rs | 40 +++++++ crates/psrs-thir/src/evidence.rs | 13 +++ crates/psrs-thir/src/lib.rs | 5 +- crates/psrs-thir/src/scope/mod.rs | 1 + crates/psrs-thir/src/verify/mod.rs | 18 +++ crates/psrs-thir/src/verify/semantics/mod.rs | 1 + .../src/typecheck/classes/deriving/newtype.rs | 49 +++++--- .../psrs-typecheck/src/typecheck/finalize.rs | 7 +- .../src/typecheck/infer/intrinsics.rs | 1 + crates/psrs-typecheck/src/typecheck/result.rs | 4 +- docs/design/frontend/type-system/deriving.md | 56 +++++---- docs/feature/F-02-portable-programs.md | 5 +- docs/implementation/frontend/deriving.md | 2 +- docs/implementation/frontend/rank-n.md | 4 +- 22 files changed, 391 insertions(+), 66 deletions(-) diff --git a/crates/psrs-core/src/lower/mod.rs b/crates/psrs-core/src/lower/mod.rs index 5cdd6218..bff09db3 100644 --- a/crates/psrs-core/src/lower/mod.rs +++ b/crates/psrs-core/src/lower/mod.rs @@ -189,6 +189,7 @@ fn lower_expr( value, source_type, target_type, + .. } => { if source_type != value.ty || target_type.0 != ty.0 { return Err(LowerError { diff --git a/crates/psrs-core/src/opt/inline/global/analysis.rs b/crates/psrs-core/src/opt/inline/global/analysis.rs index 3e698c29..f1e2f03c 100644 --- a/crates/psrs-core/src/opt/inline/global/analysis.rs +++ b/crates/psrs-core/src/opt/inline/global/analysis.rs @@ -1,5 +1,5 @@ use crate::{Expr, ExprKind, Type, TypeId}; -use psrs_hir::SymbolId; +use psrs_hir::{SymbolId, TypeVariableId}; use std::collections::{HashMap, HashSet}; pub(super) fn application_parts(expression: &Expr) -> (&Expr, Vec<&Expr>) { @@ -39,7 +39,30 @@ fn type_has_forall(id: TypeId, types: &[Type], seen: &mut HashSet) -> bo } } -fn expr_introduces_type_binders(expression: &Expr, types: &[Type]) -> bool { +/// Leading quantifiers of an expression type. A beta-reduced let keeps this +/// type, and Core opens those binders for the let body only. Bindings need the +/// same binders in `quantified` when the inlined callee or its argument +/// mentions them. +pub(in crate::opt::inline) fn leading_foralls( + mut id: TypeId, + types: &[Type], +) -> Vec { + let mut binders = Vec::new(); + let mut seen = HashSet::new(); + while let Some(Type::ForAll { variables, body }) = types.get(id.0 as usize) { + if !seen.insert(id) { + break; + } + binders.extend(variables.iter().copied()); + id = *body; + } + binders +} + +pub(in crate::opt::inline) fn expr_introduces_type_binders( + expression: &Expr, + types: &[Type], +) -> bool { if type_has_forall(expression.ty, types, &mut HashSet::new()) { return true; } diff --git a/crates/psrs-core/src/opt/inline/global/call.rs b/crates/psrs-core/src/opt/inline/global/call.rs index 0916dcdc..0c371f39 100644 --- a/crates/psrs-core/src/opt/inline/global/call.rs +++ b/crates/psrs-core/src/opt/inline/global/call.rs @@ -1,6 +1,8 @@ use super::super::super::util::{FreshLocals, count_nodes, substitute_locals}; use super::super::alpha::clone_with_fresh_locals; -use super::analysis::{application_parts, function_arity, introduces_type_binders}; +use super::analysis::{ + application_parts, function_arity, introduces_type_binders, leading_foralls, +}; use crate::{Binder, Binding, Declaration, Expr, ExprKind, Type}; use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; @@ -66,7 +68,7 @@ pub(super) fn inline_named_global( ty: parameter.ty, span: parameter.span, }, - quantified: Vec::new(), + quantified: leading_foralls(application.ty, types), value: argument.clone(), span: application.span, }); diff --git a/crates/psrs-core/src/opt/inline/global/mod.rs b/crates/psrs-core/src/opt/inline/global/mod.rs index 23039f7c..f4040259 100644 --- a/crates/psrs-core/src/opt/inline/global/mod.rs +++ b/crates/psrs-core/src/opt/inline/global/mod.rs @@ -1,4 +1,4 @@ -mod analysis; +pub(super) mod analysis; mod call; use super::super::util::{FreshLocals, next_locals}; diff --git a/crates/psrs-core/src/opt/inline/local.rs b/crates/psrs-core/src/opt/inline/local.rs index 99422ed5..ef5638e0 100644 --- a/crates/psrs-core/src/opt/inline/local.rs +++ b/crates/psrs-core/src/opt/inline/local.rs @@ -1,5 +1,6 @@ use super::super::util::{FreshLocals, count_nodes, next_locals, substitute_locals}; -use crate::{Binding, Expr, ExprKind, Module}; +use super::global::analysis::{expr_introduces_type_binders, leading_foralls}; +use crate::{Binding, Expr, ExprKind, Module, Type}; use std::collections::HashMap; pub(super) fn run(mut module: Module, max_inline_nodes: usize, sites_left: &mut usize) -> Module { @@ -7,14 +8,19 @@ pub(super) fn run(mut module: Module, max_inline_nodes: usize, sites_left: &mut return module; } let mut fresh = next_locals(&module); + // Split the type table out so each declaration body can be rewritten + // while the binder check still reads the types those bodies mention. + let types = std::mem::take(&mut module.types); for (declaration, fresh) in module.declarations.iter_mut().zip(&mut fresh) { declaration.value = inline_expr( declaration.value.clone(), fresh, sites_left, max_inline_nodes, + &types, ); } + module.types = types; module } @@ -23,13 +29,14 @@ fn inline_expr( fresh: &mut FreshLocals, sites_left: &mut usize, max_body_nodes: usize, + types: &[Type], ) -> Expr { expression.kind = match expression.kind { ExprKind::Constructor { symbol, arguments } => ExprKind::Constructor { symbol, arguments: arguments .into_iter() - .map(|argument| inline_expr(argument, fresh, sites_left, max_body_nodes)) + .map(|argument| inline_expr(argument, fresh, sites_left, max_body_nodes, types)) .collect(), }, ExprKind::IntrinsicCall { @@ -39,34 +46,52 @@ fn inline_expr( intrinsic, arguments: arguments .into_iter() - .map(|argument| inline_expr(argument, fresh, sites_left, max_body_nodes)) + .map(|argument| inline_expr(argument, fresh, sites_left, max_body_nodes, types)) .collect(), }, ExprKind::Array { elements } => ExprKind::Array { elements: elements .into_iter() - .map(|element| inline_expr(element, fresh, sites_left, max_body_nodes)) + .map(|element| inline_expr(element, fresh, sites_left, max_body_nodes, types)) .collect(), }, ExprKind::Record { fields } => ExprKind::Record { fields: fields .into_iter() .map(|(label, value)| { - (label, inline_expr(value, fresh, sites_left, max_body_nodes)) + ( + label, + inline_expr(value, fresh, sites_left, max_body_nodes, types), + ) }) .collect(), }, ExprKind::RecordUpdate { record, fields } => ExprKind::RecordUpdate { - record: Box::new(inline_expr(*record, fresh, sites_left, max_body_nodes)), + record: Box::new(inline_expr( + *record, + fresh, + sites_left, + max_body_nodes, + types, + )), fields: fields .into_iter() .map(|(label, value)| { - (label, inline_expr(value, fresh, sites_left, max_body_nodes)) + ( + label, + inline_expr(value, fresh, sites_left, max_body_nodes, types), + ) }) .collect(), }, ExprKind::FieldAccess { record, field } => ExprKind::FieldAccess { - record: Box::new(inline_expr(*record, fresh, sites_left, max_body_nodes)), + record: Box::new(inline_expr( + *record, + fresh, + sites_left, + max_body_nodes, + types, + )), field, }, ExprKind::RepresentationCast { @@ -74,14 +99,24 @@ fn inline_expr( source_type, target_type, } => ExprKind::RepresentationCast { - value: Box::new(inline_expr(*value, fresh, sites_left, max_body_nodes)), + value: Box::new(inline_expr( + *value, + fresh, + sites_left, + max_body_nodes, + types, + )), source_type, target_type, }, ExprKind::Application(function, argument) => { - let function = inline_expr(*function, fresh, sites_left, max_body_nodes); - let argument = inline_expr(*argument, fresh, sites_left, max_body_nodes); + let function = inline_expr(*function, fresh, sites_left, max_body_nodes, types); + let argument = inline_expr(*argument, fresh, sites_left, max_body_nodes, types); + // A lambda whose type binds quantifiers is the scope of those + // variables. Copying its body into the call replaces that scope + // with the instantiated result type. let can_inline = *sites_left > 0 + && !expr_introduces_type_binders(&function, types) && matches!( &function.kind, ExprKind::Lambda { body, .. } if count_nodes(body) <= max_body_nodes @@ -97,6 +132,12 @@ fn inline_expr( span: expression.span, }; let body = substitute_locals(&body, &HashMap::from([(binder.id, replacement)])); + // The result type's leading quantifiers covered both the + // callee and the argument. The let body reopens them from + // its type; the binding does not, so they have to be named + // here. Newtype deriving casts an entire quantified method + // under an unknown constructor, and that variable occurs in + // the wrapped dictionary's type. ExprKind::Let { bindings: vec![Binding { binder: crate::Binder { @@ -105,7 +146,7 @@ fn inline_expr( ty: binder.ty, span: binder.span, }, - quantified: Vec::new(), + quantified: leading_foralls(expression.ty, types), value: argument, span: expression.span, }], @@ -117,36 +158,62 @@ fn inline_expr( } ExprKind::Lambda { binder, body } => ExprKind::Lambda { binder, - body: Box::new(inline_expr(*body, fresh, sites_left, max_body_nodes)), + body: Box::new(inline_expr(*body, fresh, sites_left, max_body_nodes, types)), }, ExprKind::Let { bindings, body } => ExprKind::Let { bindings: bindings .into_iter() .map(|mut binding| { - binding.value = inline_expr(binding.value, fresh, sites_left, max_body_nodes); + binding.value = + inline_expr(binding.value, fresh, sites_left, max_body_nodes, types); binding }) .collect(), - body: Box::new(inline_expr(*body, fresh, sites_left, max_body_nodes)), + body: Box::new(inline_expr(*body, fresh, sites_left, max_body_nodes, types)), }, ExprKind::If { condition, then_branch, else_branch, } => ExprKind::If { - condition: Box::new(inline_expr(*condition, fresh, sites_left, max_body_nodes)), - then_branch: Box::new(inline_expr(*then_branch, fresh, sites_left, max_body_nodes)), - else_branch: Box::new(inline_expr(*else_branch, fresh, sites_left, max_body_nodes)), + condition: Box::new(inline_expr( + *condition, + fresh, + sites_left, + max_body_nodes, + types, + )), + then_branch: Box::new(inline_expr( + *then_branch, + fresh, + sites_left, + max_body_nodes, + types, + )), + else_branch: Box::new(inline_expr( + *else_branch, + fresh, + sites_left, + max_body_nodes, + types, + )), }, ExprKind::Case { scrutinee, branches, } => ExprKind::Case { - scrutinee: Box::new(inline_expr(*scrutinee, fresh, sites_left, max_body_nodes)), + scrutinee: Box::new(inline_expr( + *scrutinee, + fresh, + sites_left, + max_body_nodes, + types, + )), branches: branches .into_iter() .map(|mut branch| { - branch.value = inline_expr(branch.value, fresh, sites_left, max_body_nodes); + branch.value = + inline_expr(branch.value, fresh, sites_left, max_body_nodes, types); branch }) .collect(), diff --git a/crates/psrs-core/src/opt/tests/rank_inline.rs b/crates/psrs-core/src/opt/tests/rank_inline.rs index 9e557181..fa3d3efe 100644 --- a/crates/psrs-core/src/opt/tests/rank_inline.rs +++ b/crates/psrs-core/src/opt/tests/rank_inline.rs @@ -175,3 +175,59 @@ fn global_inline_keeps_a_forall_signature_with_an_empty_quantified_list() { if matches!(&head.kind, ExprKind::Global(symbol) if *symbol == function) )); } + +#[test] +fn local_inline_keeps_a_result_quantifier_on_the_binding() { + let variable = TypeId(0); + let int_type = TypeId(1); + let mut types = vec![ + Type::Variable(TypeVariableId(0)), + Type::Constructor(TypeConstructor::Int), + ]; + let function_type = arrow_type(&mut types, variable, variable); + let quantified = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![TypeVariableId(0)], + body: variable, + }); + let argument = expression( + ExprKind::RepresentationCast { + value: Box::new(expression(ExprKind::Integer(1), int_type.0, 1, 2)), + source_type: int_type, + target_type: variable, + }, + variable.0, + 1, + 2, + ); + let lambda = expression( + ExprKind::Lambda { + binder: Binder { + id: LocalId(0), + name: "value".into(), + ty: variable, + span: span(3, 8), + }, + body: Box::new(expression(ExprKind::Local(LocalId(0)), variable.0, 9, 14)), + }, + function_type.0, + 3, + 14, + ); + let input = module( + types, + quantified.0, + expression( + ExprKind::Application(Box::new(lambda), Box::new(argument)), + quantified.0, + 1, + 14, + ), + ); + + let optimized = optimize(input, Budget::default()).expect("the cast variable stays bound"); + let ExprKind::Let { bindings, .. } = &optimized.declarations[0].value.kind else { + panic!("the coercion lambda should beta-reduce: {optimized:?}"); + }; + assert_eq!(bindings[0].quantified, vec![TypeVariableId(0)]); +} diff --git a/crates/psrs-driver/src/tests/coercion.rs b/crates/psrs-driver/src/tests/coercion.rs index d6b50692..9ad0f1fd 100644 --- a/crates/psrs-driver/src/tests/coercion.rs +++ b/crates/psrs-driver/src/tests/coercion.rs @@ -35,6 +35,27 @@ fn expands_type_synonyms_before_coercible_role_matching() { .unwrap_or_else(|errors| panic!("synonym coercion should type check: {errors:?}")); } +#[test] +fn ordinary_coercible_does_not_lift_through_an_unknown_type_constructor() { + // A newtype is coercible to its field, and that conversion lifts through a + // known representational constructor. It does not lift through a quantified + // `f`: the parameter's role is not known. Newtype deriving must not ask + // this rule to prove `Coercible (f (NonEmptyArray a)) (f (Array a))`. + let source = r#"module Main where + +import Safe.Coerce (coerce) + +newtype NonEmptyArray a = NonEmptyArray (Array a) + +bad :: forall f a. f (NonEmptyArray a) -> f (Array a) +bad = coerce + +main :: Int +main = 0 +"#; + rejects(&[("Main.purs", source)], "NoInstanceFound"); +} + #[test] fn a_nominal_data_role_blocks_newtype_coercion_of_its_parameter() { let source = "module Main where\n\ diff --git a/crates/psrs-driver/src/tests/deriving/mod.rs b/crates/psrs-driver/src/tests/deriving/mod.rs index a95da440..8c89ef94 100644 --- a/crates/psrs-driver/src/tests/deriving/mod.rs +++ b/crates/psrs-driver/src/tests/deriving/mod.rs @@ -86,6 +86,37 @@ main = toInt (Age 42) true }); } +#[test] +fn newtype_deriving_reuses_the_dictionary_under_an_unknown_type_constructor() { + // `Traversable`'s `sequence` / `traverse` quantify an unknown `m`. + // Ordinary `Coercible` cannot lift `NonEmptyArray` ~ `Array` under that + // `m`. Deriving still accepts the instance by reusing `Array`'s dictionary + // after the newtype and underlying-instance checks. + let source = r#"module Main where + +class Applicative m where + pure :: forall a. a -> m a + +class Sequence t where + echo :: forall f a. f (t a) -> f (t a) + run :: forall a m. Applicative m => (t a -> m (t a)) -> t a -> m (t a) + +instance sequenceArray :: Sequence Array where + echo value = value + run f xs = f xs + +newtype NonEmptyArray a = NonEmptyArray (Array a) + +derive newtype instance sequenceNonEmpty :: Sequence NonEmptyArray + +main :: Int +main = 0 +"#; + crate::check_program(&[("Main.purs", source)]).unwrap_or_else(|errors| { + panic!("newtype deriving should reuse the wrapped dictionary: {errors:?}") + }); +} + #[test] fn rejects_newtype_deriving_for_a_data_declaration() { let sources = [( diff --git a/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs b/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs index 4275b65c..ffe040a4 100644 --- a/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs +++ b/crates/psrs-driver/src/tests/wasi/classes/deriving/adapters.rs @@ -1,5 +1,45 @@ use super::*; +#[test] +fn newtype_deriving_reuses_a_dictionary_under_an_unknown_constructor() { + let source = r#"module Main where + +data Id a = Id a + +class Tick m where + project :: m Int -> Int + +instance tickId :: Tick Id where + project (Id n) = n + +class Echo t where + echo :: forall f. f t -> f t + run :: forall m. Tick m => (t -> m t) -> t -> Int + +instance echoInt :: Echo Int where + echo value = value + run f n = project (f n) + +newtype Age = Age Int + +derive newtype instance echoAge :: Echo Age + +main :: Int +main = case echo (Id (Age 42)) of + Id (Age n) -> run (\x -> Id x) (Age n) + _ -> 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "stderr: {}", + String::from_utf8_lossy(&output.stderr) + ); +} + #[test] fn polymorphic_newtype_deriving_executes_its_adapter() { let source = r#"module Main where diff --git a/crates/psrs-thir/src/evidence.rs b/crates/psrs-thir/src/evidence.rs index 43626727..98cf6197 100644 --- a/crates/psrs-thir/src/evidence.rs +++ b/crates/psrs-thir/src/evidence.rs @@ -2,6 +2,19 @@ use super::TypeId; use psrs_hir::{LocalId, SymbolId, TypeId as ClassId}; use psrs_span::TextRange; +/// Authority for a conversion that is not an ordinary Coercible proof. +/// Newtype deriving relies on representation transparency and a selected +/// wrapped instance, as upstream dictionary reuse does. The checker owns that +/// validation; THIR verifies the named newtype and the conversion endpoints. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum UncheckedCoercionOrigin { + UnsafeCoerce, + NewtypeDeriving { + class_id: ClassId, + newtype_id: ClassId, + }, +} + /// A frontend-selected dictionary derivation retained in Typed Core. /// /// The class solver owns the meaning and coherence of this derivation. Core diff --git a/crates/psrs-thir/src/lib.rs b/crates/psrs-thir/src/lib.rs index ab016f77..a5c0d018 100644 --- a/crates/psrs-thir/src/lib.rs +++ b/crates/psrs-thir/src/lib.rs @@ -8,7 +8,7 @@ mod evidence; mod scope; mod verify; -pub use evidence::{Evidence, EvidenceKind}; +pub use evidence::{Evidence, EvidenceKind, UncheckedCoercionOrigin}; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub struct TypeId(pub u32); @@ -287,7 +287,7 @@ pub enum ExprKind { source_type: TypeId, target_type: TypeId, }, - /// An unchecked representational conversion from `Unsafe.Coerce`. Unlike + /// An unchecked representational conversion with an explicit authority. Unlike /// [`ExprKind::Coerce`] it carries no `Coercible` proof; the value crosses /// its erased representation unchanged. Core lowers it to a /// `RepresentationCast`. @@ -295,6 +295,7 @@ pub enum ExprKind { value: Box, source_type: TypeId, target_type: TypeId, + origin: UncheckedCoercionOrigin, }, Application(Box, Box), Lambda { diff --git a/crates/psrs-thir/src/scope/mod.rs b/crates/psrs-thir/src/scope/mod.rs index 42857a86..cdc1f0b6 100644 --- a/crates/psrs-thir/src/scope/mod.rs +++ b/crates/psrs-thir/src/scope/mod.rs @@ -262,6 +262,7 @@ fn verify_expr_scope( value, source_type, target_type, + .. } => { verify_expr_scope(value, types, scope, errors); verify_type_scope( diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index 7dda06fb..fb766d53 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -168,6 +168,7 @@ fn verify_expr(expression: &Expr, module: &Module, errors: &mut Vec value, source_type, target_type, + origin, } => { verify_expr(value, module, errors); if *source_type != value.ty || *target_type != expression.ty { @@ -176,6 +177,23 @@ fn verify_expr(expression: &Expr, module: &Module, errors: &mut Vec message: "unsafe coercion boundary types do not match its value and result", }); } + if let crate::UncheckedCoercionOrigin::NewtypeDeriving { newtype_id, .. } = origin { + let constructors = module + .constructors + .iter() + .filter(|constructor| constructor.type_id == *newtype_id) + .collect::>(); + if !module.newtype_ids.contains(newtype_id) + || constructors.len() != 1 + || constructors[0].field_count != 1 + || constructors[0].field_types.len() != 1 + { + errors.push(VerifyError { + span: expression.span, + message: "newtype deriving conversion requires a declared single-field newtype", + }); + } + } } ExprKind::Application(function, argument) => { verify_expr(function, module, errors); diff --git a/crates/psrs-thir/src/verify/semantics/mod.rs b/crates/psrs-thir/src/verify/semantics/mod.rs index 043585a1..3a40cfe2 100644 --- a/crates/psrs-thir/src/verify/semantics/mod.rs +++ b/crates/psrs-thir/src/verify/semantics/mod.rs @@ -161,6 +161,7 @@ impl Context<'_> { value, source_type, target_type, + .. } => { self.expr(value, Some(*source_type)); self.compatible(*target_type, expression.ty, expression.span); diff --git a/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs b/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs index 3f75eea2..8862eb62 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/deriving/newtype.rs @@ -3,10 +3,16 @@ use super::super::super::*; use super::super::evidence::record_field_type; use super::flatten_spine; +struct CheckedNewtype { + type_id: hir::TypeId, + underlying: InferType, +} + impl Checker { /// Builds the method implementation for a `derive newtype` instance. /// The source method is selected from the wrapped type's dictionary, then - /// adapted at each function boundary through checked Coercible evidence. + /// adapted through the trusted representation-transparent newtype contract. + /// This is dictionary reuse, not a claim of ordinary Coercible entailment. pub(in crate::typecheck::classes) fn derive_newtype_method( &mut self, class_id: hir::TypeId, @@ -22,7 +28,12 @@ impl Checker { "derive newtype class head has the wrong arity", ); } - let underlying = self.newtype_underlying_type(class_arguments, span, false)?; + let checked = self.checked_newtype(class_arguments, span, false)?; + let origin = thir::UncheckedCoercionOrigin::NewtypeDeriving { + class_id, + newtype_id: checked.type_id, + }; + let underlying = checked.underlying; let mut underlying_arguments = class_arguments.to_vec(); *underlying_arguments.last_mut()? = underlying; @@ -86,6 +97,7 @@ impl Checker { underlying_method_type, derived_method_type, span, + origin, ) }) } @@ -104,6 +116,16 @@ impl Checker { span: TextRange, deriving_newtype_class: bool, ) -> Option { + self.checked_newtype(class_arguments, span, deriving_newtype_class) + .map(|checked| checked.underlying) + } + + fn checked_newtype( + &mut self, + class_arguments: &[InferType], + span: TextRange, + deriving_newtype_class: bool, + ) -> Option { let Some(newtype) = class_arguments.last() else { return self.deriving_error( TypeCheckErrorKind::InvalidNewtypeInstance, @@ -180,7 +202,10 @@ impl Checker { "the wrapped type must end in every unapplied newtype parameter", ); }; - Some(underlying) + Some(CheckedNewtype { + type_id: *type_id, + underlying, + }) } fn adapt_newtype_method( @@ -189,6 +214,7 @@ impl Checker { source: InferType, target: InferType, span: TextRange, + origin: thir::UncheckedCoercionOrigin, ) -> Option { let source = self.resolve_type(source); let target = self.resolve_type(target); @@ -217,6 +243,7 @@ impl Checker { source_body.as_ref().clone(), target_body.as_ref().clone(), span, + origin, )?; return Some(InferredExpr { ty: target, @@ -249,6 +276,7 @@ impl Checker { target_parameter.clone(), source_parameter, span, + origin, ); let applied = InferredExpr { kind: InferredExprKind::Application(Box::new(value), Box::new(converted_argument)), @@ -260,6 +288,7 @@ impl Checker { source_result.clone(), target_result.clone(), span, + origin, )?; return Some(InferredExpr { kind: InferredExprKind::Lambda { @@ -273,7 +302,7 @@ impl Checker { span, }); } - Some(self.apply_newtype_coercion(value, source, target, span)) + Some(self.apply_newtype_coercion(value, source, target, span, origin)) } fn apply_newtype_coercion( @@ -282,20 +311,14 @@ impl Checker { source: InferType, target: InferType, span: TextRange, + origin: thir::UncheckedCoercionOrigin, ) -> InferredExpr { - let constraint = ClassConstraint { - class_id: hir::TypeId::COERCIBLE, - arguments: vec![source.clone(), target.clone()], - span, - }; - let dictionary_type = self.dictionary_type(&constraint); - let wanted = self.push_wanted(constraint, dictionary_type); let function_type = arrow(source.clone(), target.clone()); let function = InferredExpr { - kind: InferredExprKind::CoerceFunction { - wanted, + kind: InferredExprKind::UnsafeCoerceFunction { source, target: target.clone(), + origin, }, ty: function_type, span, diff --git a/crates/psrs-typecheck/src/typecheck/finalize.rs b/crates/psrs-typecheck/src/typecheck/finalize.rs index f6dcc8ea..db4f202c 100644 --- a/crates/psrs-typecheck/src/typecheck/finalize.rs +++ b/crates/psrs-typecheck/src/typecheck/finalize.rs @@ -112,7 +112,11 @@ impl Checker { body: Box::new(body), } } - InferredExprKind::UnsafeCoerceFunction { source, target } => { + InferredExprKind::UnsafeCoerceFunction { + source, + target, + origin, + } => { let source_type = self.finalize_type(&source, expression.span, interner, generics)?; let target_type = @@ -135,6 +139,7 @@ impl Checker { value: Box::new(value), source_type, target_type, + origin, }, ty: target_type, span: expression.span, diff --git a/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs b/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs index 40a17ec3..909ef832 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/intrinsics.rs @@ -35,6 +35,7 @@ impl Checker { InferredExprKind::UnsafeCoerceFunction { source: source.clone(), target: target.clone(), + origin: psrs_thir::UncheckedCoercionOrigin::UnsafeCoerce, }, arrow(source, target), ) diff --git a/crates/psrs-typecheck/src/typecheck/result.rs b/crates/psrs-typecheck/src/typecheck/result.rs index 187db76a..f4332aa0 100644 --- a/crates/psrs-typecheck/src/typecheck/result.rs +++ b/crates/psrs-typecheck/src/typecheck/result.rs @@ -76,11 +76,13 @@ pub(super) enum InferredExprKind { source: InferType, target: InferType, }, - /// The `Unsafe.Coerce.unsafeCoerce` function. It has no `Coercible` wanted; + /// An unchecked conversion with a recorded source or derivation authority. + /// It has no `Coercible` wanted; /// finalization closes it into an unchecked representation cast. UnsafeCoerceFunction { source: InferType, target: InferType, + origin: thir::UncheckedCoercionOrigin, }, /// A dictionary solved for `wanted`, used directly (for example as an /// instance's superclass field). diff --git a/docs/design/frontend/type-system/deriving.md b/docs/design/frontend/type-system/deriving.md index 756b2b71..763b04f2 100644 --- a/docs/design/frontend/type-system/deriving.md +++ b/docs/design/frontend/type-system/deriving.md @@ -27,8 +27,9 @@ function boundary. It does not own the class solver, instance search, coherence, evidence elaboration, or superclass projection; those are [classes and evidence](classes-and-evidence.md). It does not own the -`Coercible` proof; [primitives](prim.md) owns that rule and this document only -consumes its proof boundary. It does not own roles or the checked kind +`Coercible` proof; [primitives](prim.md) owns that rule. Newtype deriving does +not consume it: a wrapped dictionary is reused after the newtype check. It does +not own roles or the checked kind environment ([kinds](kinds.md)), the constraint and `TypeTemplate` representation, or the surface grammar of `derive` declarations ([parsing and CST](../syntax/parsing-and-cst.md)). Deriving is a distinct topic @@ -62,7 +63,8 @@ introduces a special evidence form. `derive newtype instance` is a separate strategy. It does not walk the wrapped type's fields at all: it selects the dictionary for the wrapped class head and -adapts each method at function boundaries through checked `Coercible` evidence. +adapts each method at function boundaries by a representation cast. That cast +is the official dictionary reuse, not a `Coercible` proof. The wrapped head is a class constraint on the same constraint spine every other instance context uses. @@ -196,12 +198,23 @@ monomorphic instance supplies the dictionary. `derive newtype instance C ... T` resolves `T` to a locally declared newtype, computes its wrapped type, and pushes the wrapped constraint `C ... wrapped` as -an ordinary wanted. For each method it selects the wrapped dictionary's method -and adapts it to the derived head: it peels shared method quantifiers, then -inserts a `Coercible` conversion at each arrow boundary; a method whose type is -already equal needs no conversion. The proof is the compiler-owned `Coercible` -relation from [primitives](prim.md); deriving produces no coercion proof of its -own and cannot forge one. +an ordinary wanted. That wanted is solved by the ordinary instance solver, so +the wrapped type's instance is the dictionary that is reused. For each method +the implementation selects that dictionary's method and adapts it to the +derived head. Shared method quantifiers stay on the adapted value. At each +arrow boundary whose endpoints differ, the adapter inserts a representation +cast authorized by the checked newtype (a local single-field declaration) and +by the selected wrapped instance. A method whose type is already equal needs +no cast. + +This is not a `Coercible` proof. Ordinary `Coercible` cannot lift +`Coercible a b` through an unknown constructor `f` to `Coercible (f a) (f b)`, +and that refusal stays. `Traversable`'s `sequence` has the shape +`forall a m. Applicative m => t (m a) -> m (t a)`, so the two heads differ +under the unknown `m`. The official compiler therefore reuses the dictionary +after the newtype and underlying-instance checks (`DeferredDictionary`) rather +than discharging a coercion obligation. The cast records that deriving +authority; it does not invent a `Coercible` instance. Method-level `forall` binders are instantiated once with stable placeholders and substituted separately at the two heads, so a quantifier shared by the method @@ -308,15 +321,17 @@ derive_newtype(instance): for each method: template = elaborate method signature with one placeholder per class parameter source = template[wrapped]; target = template[head_args] - body = adapt(select(source), source, target) # Coercible at each arrow + body = adapt(select(source), source, target) # representation cast emit Member(method, body) adapt(value, source, target): - peel matching shared foralls + # Quantifiers stay on the result. Their binders are the scope of any + # cast underneath them; they are not discharged as Coercible. + peel matching shared foralls onto the result type if source == target: return value if source = a -> b and target = a' -> b': - return \x -> adapt(value (coerce x), b, b') - return coerce value # checked Coercible source -> target + return \x -> adapt(value (cast x), b, b') + return cast value # newtype-deriving authority, not Coercible ``` Edge cases: a data type with no constructors derives a `Functor`/`Foldable` body @@ -345,8 +360,8 @@ The deriving topic lives inside the P5 owner. The intended organization: - `typecheck/classes/deriving/foldable/` — `Foldable`/`Bifoldable`, driven by the usage tree. - `typecheck/classes/deriving/traversable.rs` — `Traversable`/`Bitraversable`. -- `typecheck/classes/deriving/newtype.rs` — newtype strategy and the `Coercible` - adapter. +- `typecheck/classes/deriving/newtype.rs` — newtype strategy and the + dictionary-reuse adapter. - `typecheck/classes/deriving/generic.rs` — representation type and `to`/`from`. - `typecheck/error.rs` — the official deriving diagnostic variants and their `errorCode` mapping. @@ -374,8 +389,10 @@ design; code is expected to conform to this map, not the reverse. - Field usage agrees with the class's variance and with the visible instance environment: a derivation is accepted exactly when every field occurrence has the mapping instance the traversal needs. -- A newtype method conversion is authorized by a checked `Coercible` proof; the - adapter inserts no unchecked cast. +- A newtype method conversion is authorized by the checked newtype declaration + and the selected wrapped instance. The adapter does not emit a `Coercible` + wanted, and ordinary `Coercible` still refuses to lift through an unknown + constructor. - A derivable wildcard is resolved before instance recording; no instance is recorded with a wildcard it should not have. - Each failure carries the official `errorCode` for its condition. @@ -430,8 +447,9 @@ Deriving consumes resolved HIR instance declarations, the checked kind and role environment, the class environment, and the visible instance environment. It produces generated method terms and, for `Newtype`/`Generic`, a concrete final head argument, handing both to the instance-checking path in -[classes and evidence](classes-and-evidence.md). It consumes the `Coercible` -proof from [primitives](prim.md) but does not implement it. It adds no node to +[classes and evidence](classes-and-evidence.md). Newtype deriving does not +consume the `Coercible` proof from [primitives](prim.md); that rule still +refuses to lift through an unknown constructor. It adds no node to CST, AST, or HIR; a derived instance is an ordinary instance after elaboration. ## Open questions and future work diff --git a/docs/feature/F-02-portable-programs.md b/docs/feature/F-02-portable-programs.md index 1becd537..893f5292 100644 --- a/docs/feature/F-02-portable-programs.md +++ b/docs/feature/F-02-portable-programs.md @@ -110,8 +110,9 @@ receive a source diagnostic. `derive instance` generates implementations for the supported standard classes from a locally declared type's constructors and fields. Structural `Eq` and `Ord`, and the covered `Functor` and `Bifunctor` mappings, are supported. -`derive newtype instance` reuses an instance for the wrapped type, with checked -conversions at method boundaries. Derived instances participate in the same +`derive newtype instance` reuses an instance for the wrapped type. Method +boundaries are representation casts authorized by the newtype declaration and +the wrapped instance, not by ordinary `Coercible`. Derived instances participate in the same constraint checks and module imports as explicitly written instances. Other standard deriving rules and additional field shapes remain incomplete. diff --git a/docs/implementation/frontend/deriving.md b/docs/implementation/frontend/deriving.md index 64615ed1..1bc58d2d 100644 --- a/docs/implementation/frontend/deriving.md +++ b/docs/implementation/frontend/deriving.md @@ -32,7 +32,7 @@ shared instance-declaration checks rather than a missing structural rule. | DR-11 | `Functor` maps nested applications and function results, and rejects a parameter under a function input. | Runtime `derives_nested_functor_mapping_through_an_imported_dictionary`; differential function-result and nested-function cases and `deriving-functor-rejects-contravariant-field`. | Verified | | DR-12 | `Bifunctor` maps the final two parameters and rejects a negative parameter position. | Runtime `derives_bifunctor_mapping_for_both_type_parameters`; differential `deriving-bifunctor-final-two-parameters` and `deriving-bifunctor-rejects-negative-parameter`. | Verified | | DR-13 | `Contravariant` maps function inputs through the `Profunctor.lcmap` dictionary and rejects a positive parameter. | Differential `deriving-contravariant-function-input` and `deriving-contravariant-rejects-positive-parameter`; runtime `function_contravariant_deriving_executes_its_adapter` and its record-field counterpart check both predicate outcomes and retained inert fields. | Verified | -| DR-14 | `derive newtype` selects the wrapped class dictionary and adapts each method at function boundaries through checked `Coercible` evidence, including empty classes and cross-module instances. | Runtime `imported_newtype_derived_dictionary_executes_its_coercion_adapter`, `derives_a_higher_kinded_newtype_instance_through_the_wrapped_type`; differential empty-class cases; source `derives_newtype_methods_from_the_wrapped_instance`. | Verified for covered cases | +| DR-14 | `derive newtype` selects the wrapped class dictionary and adapts each method by a representation cast authorized by the checked newtype and that dictionary. It does not prove ordinary `Coercible`, which still refuses to lift through an unknown constructor. Quantifiers on the method stay in scope across the cast. | Runtime `imported_newtype_derived_dictionary_executes_its_coercion_adapter`, `derives_a_higher_kinded_newtype_instance_through_the_wrapped_type`, `newtype_deriving_reuses_a_dictionary_under_an_unknown_constructor`; source `newtype_deriving_reuses_the_dictionary_under_an_unknown_type_constructor` and `ordinary_coercible_does_not_lift_through_an_unknown_type_constructor`; differential empty-class cases; source `derives_newtype_methods_from_the_wrapped_instance`. | Verified for covered cases | | DR-15 | A rank-1 method `forall` is instantiated once and shared across the adapter's two heads. | Source `newtype_deriving_accepts_a_polymorphic_class_method`; runtime `polymorphic_newtype_deriving_executes_its_adapter` executes the same method at Boolean and Array argument instantiations. | Verified | | DR-16 | A derivable `Newtype`/`Generic` wildcard is resolved before the instance is recorded. | `record_instance` resolves the wildcard through the registry and stores the concrete wrapped/representation type in the recorded head; a non-wildcard final argument is `ExpectedWildcard`. `derives_newtype_class_for_a_newtype_with_a_wildcard` covers the resolved path. | Verified | | DR-17 | `Generic` derives the `Data.Generic.Rep` representation and its `to`/`from` methods. | Source `derives_generic_representation_for_a_data_type`; Runtime `generic_deriving_round_trips_constructor_tags_and_fields` checks nullary, unary, and multi-field constructors. | Verified for covered cases | diff --git a/docs/implementation/frontend/rank-n.md b/docs/implementation/frontend/rank-n.md index 91fbb86c..feea4d99 100644 --- a/docs/implementation/frontend/rank-n.md +++ b/docs/implementation/frontend/rank-n.md @@ -61,8 +61,8 @@ inconsistent scheme instance, closed records with extra fields, rigid open rows, and one row variable with two residuals are rejected; one repeated residual is accepted. Global inlining leaves a `ForAll` signature and a body that binds its own type variable in place. The linker renumbers `TypeVariableId` across modules. -`derive newtype` peels a shared method quantifier before building `Coercible` -evidence. +`derive newtype` keeps a shared method quantifier as the scope of its +representation cast. That cast is not `Coercible` evidence. RN-12 stays unverified. The differential battery agrees with `purs` 0.15.16, and the official higher-rank and skolem corpus, including its library dependencies, From c7b0ef566468cda65d10688b3936b800bdb0bcf7 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 04:54:59 +0800 Subject: [PATCH 019/148] Lower record wildcards and backticked sections in source order A record constructor or updater with an immediate underscore becomes a lambda whose binders follow the written fields, not the canonical field order. Nested update paths share that updater. An explicit field expression or nested literal keeps its own scope, so `field = field { value = 7 }` uses the local `field` value. AST updates now distinguish a nested path from an expression, and resolution projects the path from the enclosing base. A parenthesized backticked section accepts the hole on either side and keeps the operand order and the unresolved local name. Validated under PSRS_REQUIRE_WASMTIME=1: the record suite (21) and the backticked-section test. The full workspace suite was not run. --- crates/psrs-ast/src/expr/mod.rs | 54 ++++----- crates/psrs-ast/src/expr/records.rs | 103 ++++++++++++++++++ crates/psrs-ast/src/lib.rs | 6 +- crates/psrs-driver/src/tests/operators/mod.rs | 1 + .../src/tests/operators/sections.rs | 21 ++++ crates/psrs-driver/src/tests/records.rs | 60 ++++++++++ crates/psrs-resolve/src/resolver/names/mod.rs | 25 ++--- .../src/parser/expr/atom/sections.rs | 13 ++- docs/design/frontend/syntax/ast-lowering.md | 17 +++ 9 files changed, 245 insertions(+), 55 deletions(-) create mode 100644 crates/psrs-ast/src/expr/records.rs create mode 100644 crates/psrs-driver/src/tests/operators/sections.rs diff --git a/crates/psrs-ast/src/expr/mod.rs b/crates/psrs-ast/src/expr/mod.rs index 7838e897..25926343 100644 --- a/crates/psrs-ast/src/expr/mod.rs +++ b/crates/psrs-ast/src/expr/mod.rs @@ -1,13 +1,15 @@ use crate::{LowerError, Name, Type}; -use psrs_cst::{self as cst, RecordField, RecordUpdateField}; +use psrs_cst as cst; use psrs_span::TextRange; use std::collections::HashSet; mod guards; +mod records; pub use guards::{Guard, GuardedExpr}; pub(super) use guards::{ lower_case_patterns, lower_case_scrutinees, lower_guard, lower_guarded_rhs, prepend_guards, }; +pub(super) use records::{lower_record, lower_record_update}; #[derive(Clone, Debug, PartialEq, Eq)] pub struct Binder { @@ -40,7 +42,7 @@ pub enum ExprKind { Record(Vec<(String, Expr)>), RecordUpdate { expression: Box, - fields: Vec<(String, Expr)>, + fields: Vec, }, FieldAccess { expression: Box, @@ -103,6 +105,22 @@ pub enum ExprKind { Guarded(Vec), } +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct RecordUpdateField { + pub label: String, + pub value: RecordUpdateValue, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum RecordUpdateValue { + Expression(Expr), + /// A source path update, whose base is the enclosing record's field. + Nested { + fields: Vec, + span: TextRange, + }, +} + #[derive(Clone, Debug, PartialEq, Eq)] pub struct CaseBranch { pub pattern: Pattern, @@ -159,38 +177,6 @@ pub enum PatternKind { }, } -pub(super) fn lower_record( - fields: Vec, - tail: Option>, - span: TextRange, -) -> Result { - if tail.is_some() { - return Err(LowerError::new( - span, - "open record rows are not supported yet", - )); - } - Ok(ExprKind::Record( - fields - .into_iter() - .map(|field| Ok((field.label.text, super::lower_expr(field.value)?))) - .collect::, LowerError>>()?, - )) -} - -pub(super) fn lower_record_update( - expression: psrs_cst::Expr, - fields: Vec, -) -> Result { - Ok(ExprKind::RecordUpdate { - expression: Box::new(super::lower_expr(expression)?), - fields: fields - .into_iter() - .map(|field| Ok((field.label.text, super::lower_expr(field.value)?))) - .collect::, LowerError>>()?, - }) -} - pub(super) fn lower_field_access( expression: psrs_cst::Expr, field: psrs_cst::CstName, diff --git a/crates/psrs-ast/src/expr/records.rs b/crates/psrs-ast/src/expr/records.rs new file mode 100644 index 00000000..1b927638 --- /dev/null +++ b/crates/psrs-ast/src/expr/records.rs @@ -0,0 +1,103 @@ +use super::{Binder, Expr, ExprKind, RecordUpdateValue}; +use crate::{LowerError, Name, lower_expr}; +use psrs_cst::{self as cst, RecordField, RecordUpdateField}; +use psrs_span::TextRange; + +/// Only immediate anonymous arguments belong to this constructor. Nested +/// literals introduce their own lambdas; nested update paths share this one. +fn lower_argument(expression: cst::Expr, binders: &mut Vec) -> Result { + if matches!(&expression.kind, cst::ExprKind::Name(name) if name.text == "_") { + let span = expression.span; + let name = format!("$psrs_record_argument_{}", span.start); + binders.push(Binder { + name: name.clone(), + span, + }); + Ok(Expr { + kind: ExprKind::Name(Name { text: name, span }), + span, + }) + } else { + lower_expr(expression) + } +} + +fn wrap_arguments(kind: ExprKind, binders: Vec, span: TextRange) -> Expr { + let mut expression = Expr { kind, span }; + for binder in binders.into_iter().rev() { + expression = Expr { + kind: ExprKind::Lambda { + binder, + body: Box::new(expression), + }, + span, + }; + } + expression +} + +pub(crate) fn lower_record( + fields: Vec, + tail: Option>, + span: TextRange, +) -> Result { + if tail.is_some() { + return Err(LowerError::new( + span, + "open record rows are not supported yet", + )); + } + let mut binders = Vec::new(); + let fields = fields + .into_iter() + .map(|field| Ok((field.label.text, lower_argument(field.value, &mut binders)?))) + .collect::, LowerError>>()?; + Ok(wrap_arguments(ExprKind::Record(fields), binders, span)) +} + +pub(crate) fn lower_record_update( + expression: cst::Expr, + fields: Vec, + span: TextRange, +) -> Result { + let mut binders = Vec::new(); + let expression = lower_argument(expression, &mut binders)?; + let fields = lower_update_fields(fields, &mut binders)?; + Ok(wrap_arguments( + ExprKind::RecordUpdate { + expression: Box::new(expression), + fields, + }, + binders, + span, + )) +} + +fn lower_update_fields( + fields: Vec, + binders: &mut Vec, +) -> Result, LowerError> { + fields + .into_iter() + .map(|field| { + // The parser marks path updates with the label span in place of + // an equals token. Explicit `field = expression` is a new scope. + let value = if field.equals_span == field.label.span { + let span = field.value.span; + let cst::ExprKind::RecordUpdate { fields, .. } = field.value.kind else { + return Err(LowerError::new(span, "invalid nested record update")); + }; + RecordUpdateValue::Nested { + fields: lower_update_fields(fields, binders)?, + span, + } + } else { + RecordUpdateValue::Expression(lower_argument(field.value, binders)?) + }; + Ok(super::RecordUpdateField { + label: field.label.text, + value, + }) + }) + .collect() +} diff --git a/crates/psrs-ast/src/lib.rs b/crates/psrs-ast/src/lib.rs index 97f41db6..bf2751b6 100644 --- a/crates/psrs-ast/src/lib.rs +++ b/crates/psrs-ast/src/lib.rs @@ -18,7 +18,7 @@ mod type_decl; pub use export::{ExportList, ExportRef, TypeMembers}; pub use expr::{ Binder, CaseBranch, Declaration, Expr, ExprKind, Guard, GuardedExpr, Pattern, PatternKind, - RecordPatternMode, + RecordPatternMode, RecordUpdateField, RecordUpdateValue, }; pub use fixity::{Associativity, FixityDeclaration, FixityNamespace, Operator, SectionSide}; pub use import::{Import, ImportList, ImportRef}; @@ -212,10 +212,10 @@ pub(crate) fn lower_expr(expression: cst::Expr) -> Result { .map(lower_expr) .collect::, _>>()?, ), - CstExprKind::Record { fields, tail, .. } => expr::lower_record(fields, tail, span)?, + CstExprKind::Record { fields, tail, .. } => return expr::lower_record(fields, tail, span), CstExprKind::RecordUpdate { expression, fields, .. - } => expr::lower_record_update(*expression, fields)?, + } => return expr::lower_record_update(*expression, fields, span), CstExprKind::FieldAccess { expression, field, .. } => return expr::lower_field_access(*expression, field, span), diff --git a/crates/psrs-driver/src/tests/operators/mod.rs b/crates/psrs-driver/src/tests/operators/mod.rs index cab83afd..2c6a1f4e 100644 --- a/crates/psrs-driver/src/tests/operators/mod.rs +++ b/crates/psrs-driver/src/tests/operators/mod.rs @@ -1,5 +1,6 @@ mod opaque_type; mod prim_type; +mod sections; use super::*; diff --git a/crates/psrs-driver/src/tests/operators/sections.rs b/crates/psrs-driver/src/tests/operators/sections.rs new file mode 100644 index 00000000..e06fe09f --- /dev/null +++ b/crates/psrs-driver/src/tests/operators/sections.rs @@ -0,0 +1,21 @@ +use super::*; + +#[test] +fn backticked_sections_keep_operand_order_and_resolve_local_values() { + let source = r#" +module Main where +subtract :: Int -> Int -> Int +subtract x y = intSub x y +main :: Int +main = let left = (_ `subtract` 8) + right = (50 `subtract` _) + local x y = intSub x y + in if intEq (left 50) 42 + then if intEq (right 8) 42 then (_ `local` 8) 50 else 0 + else 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/records.rs b/crates/psrs-driver/src/tests/records.rs index 28fb0e00..b1594b44 100644 --- a/crates/psrs-driver/src/tests/records.rs +++ b/crates/psrs-driver/src/tests/records.rs @@ -1,5 +1,65 @@ use super::*; +#[test] +fn explicit_update_expression_uses_the_local_record_even_when_labels_match() { + let source = r#" +module Main where +main :: Int +main = let field = { value: 0, kept: 42 } + original = { field: { value: 0, kept: 1 } } + explicit = original { field = field { value = 7 } } + nested = original { field { value = 7 } } + in if intEq nested.field.kept 1 then explicit.field.kept else 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn record_wildcards_bind_in_source_order_and_keep_nested_scopes() { + let source = r#" +module Main where +make :: Int -> Int -> { z :: Int, a :: Int, nested :: Int -> { value :: Int }, fixed :: Int } +make = { z: _, a: _, nested: { value: _ }, fixed: 7 } +main :: Int +main = let record = make 40 2 + in if intEq record.z 40 + then if intEq record.a 2 + then if intEq record.fixed 7 then (record.nested 42).value else 0 + else 0 + else 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn record_update_wildcards_share_nested_paths_and_keep_explicit_scopes() { + let source = r#" +module Main where +update :: { z :: Int, nested :: { a :: Int, b :: Int }, callback :: Int -> { value :: Int } } + -> Int -> Int -> Int + -> { z :: Int, nested :: { a :: Int, b :: Int }, callback :: Int -> { value :: Int } } +update = _ { z = _, nested { a = _, b = _ }, callback = { value: _ } } +main :: Int +main = let original = { z: 0, nested: { a: 0, b: 0 }, callback: \x -> { value: x } } + record = update original 10 20 30 + in if intEq record.z 10 + then if intEq record.nested.a 20 + then if intEq record.nested.b 30 then (record.callback 42).value else 0 + else 0 + else 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + #[test] fn runs_a_tuple_as_a_closed_record() { let source = "\ diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index 07682e65..f5fdf6ee 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -300,7 +300,7 @@ impl Resolver { fn resolve_record_update( &mut self, expression: ast::Expr, - fields: Vec<(String, ast::Expr)>, + fields: Vec, span: TextRange, ) -> Option { let record = self.resolve_expr(expression)?; @@ -330,19 +330,17 @@ impl Resolver { fn resolve_record_update_fields( &mut self, base: &Expr, - fields: Vec<(String, ast::Expr)>, + fields: Vec, ) -> Option> { fields .into_iter() - .map(|(label, value)| { - let value_span = value.span; - let value = match value.kind { - AstExprKind::RecordUpdate { expression, fields } - if matches!( - expression.kind, - AstExprKind::Name(ref name) if name.text == label - ) => - { + .map(|field| { + let label = field.label; + let value = match field.value { + ast::RecordUpdateValue::Nested { + fields, + span: value_span, + } => { let nested_record = Expr { kind: ExprKind::FieldAccess { expression: Box::new(base.clone()), @@ -360,10 +358,7 @@ impl Resolver { span: value_span, } } - kind => self.resolve_expr(ast::Expr { - kind, - span: value_span, - })?, + ast::RecordUpdateValue::Expression(value) => self.resolve_expr(value)?, }; Some((label, value)) }) diff --git a/crates/psrs-syntax/src/parser/expr/atom/sections.rs b/crates/psrs-syntax/src/parser/expr/atom/sections.rs index 1d29f253..13c75eed 100644 --- a/crates/psrs-syntax/src/parser/expr/atom/sections.rs +++ b/crates/psrs-syntax/src/parser/expr/atom/sections.rs @@ -92,15 +92,22 @@ impl<'a> Parser<'a> { left, right, } = &first.kind - && matches!(&right.kind, ExprKind::Name(name) if name.text == "_") + && (matches!(&right.kind, ExprKind::Name(name) if name.text == "_") + || matches!(&left.kind, ExprKind::Name(name) if name.text == "_")) { + let (operand, side) = if matches!(&right.kind, ExprKind::Name(name) if name.text == "_") + { + (left.clone(), OperatorSectionSide::Left) + } else { + (right.clone(), OperatorSectionSide::Right) + }; let close_paren_span = self.consume_raw(RawTokenKind::RParen)?.span; let span = TextRange::new(open_paren_span.start, close_paren_span.end); return Ok(Expr { kind: ExprKind::OperatorSection { operator: operator.clone(), - operand: left.clone(), - side: OperatorSectionSide::Left, + operand, + side, }, span, }); diff --git a/docs/design/frontend/syntax/ast-lowering.md b/docs/design/frontend/syntax/ast-lowering.md index a678e4b6..4ee34ea3 100644 --- a/docs/design/frontend/syntax/ast-lowering.md +++ b/docs/design/frontend/syntax/ast-lowering.md @@ -44,6 +44,8 @@ alias, and spans. Expression and type operator chains retain source order, and operator sections retain which side supplies their operand using explicit anonymous arguments such as `(_ + 1)` and `(1 + _)`. Parenthesized unary negation remains a negation expression; it is not interpreted as a section. +Backticked value sections such as ``(_ `eq` value)`` retain the same section +side and unresolved value identity, including local names. Constructor operator patterns remain chains as well. None of these forms binds an operator name or applies precedence in P2. @@ -56,6 +58,21 @@ and it keeps all forms whose meaning depends on imports, types, or the language's sequencing rules. The AST is a separate type, not a view or alias of CST. +Record constructors with immediate anonymous field arguments become lambdas +in written field order: `{ z: _, a: _ }` becomes `\z a -> { z, a }`, +independently of canonical type or runtime field ordering. Record updaters +use the same rule, with an anonymous base record as the first argument. +Anonymous leaves of nested update paths belong to the enclosing updater; +an explicit field expression or nested record literal introduces its own +scope. P2 gives generated binders source-inexpressible names and preserves +each underscore's span; it does not reinterpret other expressions containing +`_` as constructor arguments. These rules follow the official compiler's +`Sugar.ObjectWildcards` conversion and require no resolved names or types. +AST update fields explicitly distinguish an expression from a nested path. +P3 projects a nested path from its enclosing base, while resolving explicit +expressions in lexical scope: `field = field { value = 7 }` must use the +local `field` value rather than the enclosing record's `field` member. + Pattern normalization removes grouping parentheses, maps tuples to closed records, and turns record puns into field-variable patterns. Record patterns carry a match mode: source `{ field }` patterns are partial and accept other From 2c4ffc0c19679f6724d44fa246ad3ab691c84c17 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:05:05 +0800 Subject: [PATCH 020/148] Represent an applied foreign type as an erased reference. An applied foreign import data value is not a nullary handle and has no constructors. Closure conversion gives it the same non-null erased reference as an abstract type variable, so a saturated Fn2 can pass layout. --- crates/psrs-backend/src/cc/layout/scalar.rs | 20 +++++++- .../psrs-backend/src/cc/layout/tests/mod.rs | 1 + .../src/cc/layout/tests/opaque.rs | 50 +++++++++++++++++++ 3 files changed, 70 insertions(+), 1 deletion(-) create mode 100644 crates/psrs-backend/src/cc/layout/tests/opaque.rs diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index 46226ef1..ee233c5e 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -181,7 +181,15 @@ pub(crate) fn declaration_shape( "the first backend slice cannot represent aggregate or parameterized types", )]); }; - if enum_types.contains(&type_id) { + if module.opaque_ids.contains(&type_id) { + // An applied foreign type is not a nullary handle. It has no + // constructors, so its value uses the erased reference until a + // later calling convention gives that type its own layout. + Ok(Signature { + parameters, + result: erased_reference(), + }) + } else if enum_types.contains(&type_id) { Ok(Signature { parameters, result: ValueShape::Integer, @@ -328,6 +336,9 @@ pub(crate) fn scalar_type( "aggregate and parameterized types are not supported by the first backend slice", )]); }; + if module.opaque_ids.contains(&type_id) { + return Ok(erased_reference()); + } if enum_types.contains(&type_id) { Ok(ValueShape::Integer) } else if aggregate_types.contains(&type_id) { @@ -417,6 +428,13 @@ pub(super) fn function_parameter_shape( ) } +fn erased_reference() -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }) +} + fn aggregate_value_type() -> ValueShape { ValueShape::Reference(Reference { nullable: false, diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index 9df377ac..bf57dad7 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -5,6 +5,7 @@ use psrs_core::{ }; use psrs_hir::{LocalId, ModuleId, SymbolId, TypeId as HirTypeId, TypeVariableId}; +mod opaque; mod records; fn push_arrow(types: &mut Vec, parameter: TypeId, result: TypeId) -> TypeId { diff --git a/crates/psrs-backend/src/cc/layout/tests/opaque.rs b/crates/psrs-backend/src/cc/layout/tests/opaque.rs new file mode 100644 index 00000000..35410083 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/tests/opaque.rs @@ -0,0 +1,50 @@ +use super::{declaration_shape, empty_module}; +use crate::cc::{RefShape, Reference, ValueShape}; +use psrs_core::{Declaration, Expr, ExprKind, Type, TypeConstructor, TypeId}; +use psrs_hir::{ModuleId, SymbolId, TypeId as HirTypeId}; +use std::collections::{HashMap, HashSet}; + +#[test] +fn an_applied_opaque_foreign_type_uses_the_erased_reference() { + let opaque = HirTypeId::new(ModuleId(1), 0); + let mut module = empty_module(vec![ + Type::Constructor(TypeConstructor::User(opaque)), + Type::Constructor(TypeConstructor::Int), + Type::Application(TypeId(0), TypeId(1)), + ]); + module.opaque_ids.push(opaque); + let applied = TypeId(2); + module.declarations.push(Declaration { + symbol: SymbolId::new(module.id, 0), + name: "value".to_owned(), + name_span: psrs_span::TextRange::new(0, 1), + quantified: Vec::new(), + ty: applied, + value: Expr { + kind: ExprKind::Unit, + ty: applied, + span: psrs_span::TextRange::new(0, 1), + }, + span: psrs_span::TextRange::new(0, 1), + }); + let signature = declaration_shape( + &module.declarations[0], + &module, + &HashSet::new(), + &HashSet::new(), + &HashSet::new(), + &HashMap::new(), + &HashMap::new(), + &HashMap::new(), + ) + .expect("an applied opaque type should have a layout"); + assert!(signature.parameters.is_empty()); + assert_eq!(signature.result, erased()); +} + +fn erased() -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }) +} From 549343734cb4543e4ac1c6ee412765f594050bb5 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:05:05 +0800 Subject: [PATCH 021/148] Lower an immediate underscore in if to a lambda parameter. An underscore written as the condition, then branch, or else branch becomes a parameter in that order, the same way a case scrutinee already does. --- crates/psrs-ast/src/expr/guards.rs | 52 +++++++++++++++++++++ crates/psrs-ast/src/expr/mod.rs | 3 +- crates/psrs-ast/src/lib.rs | 8 ++-- crates/psrs-driver/src/tests/guards.rs | 10 ++++ docs/design/frontend/syntax/ast-lowering.md | 6 ++- 5 files changed, 71 insertions(+), 8 deletions(-) diff --git a/crates/psrs-ast/src/expr/guards.rs b/crates/psrs-ast/src/expr/guards.rs index 686d2b19..e4929e09 100644 --- a/crates/psrs-ast/src/expr/guards.rs +++ b/crates/psrs-ast/src/expr/guards.rs @@ -152,6 +152,58 @@ pub(crate) fn prepend_guards(mut expression: Expr, guards: Vec, span: Tex } } +/// An immediate `_` in an `if` condition, then branch, or else branch is a +/// function parameter, in that written order. Nested expressions keep their +/// own underscores. +pub(crate) fn lower_if( + condition: cst::Expr, + then_branch: cst::Expr, + else_branch: cst::Expr, + span: TextRange, +) -> Result { + let mut binders = Vec::new(); + let condition = lower_immediate_anonymous(condition, &mut binders)?; + let then_branch = lower_immediate_anonymous(then_branch, &mut binders)?; + let else_branch = lower_immediate_anonymous(else_branch, &mut binders)?; + let mut expression = Expr { + kind: ExprKind::If { + condition: Box::new(condition), + then_branch: Box::new(then_branch), + else_branch: Box::new(else_branch), + }, + span, + }; + for binder in binders.into_iter().rev() { + expression = Expr { + kind: ExprKind::Lambda { + binder, + body: Box::new(expression), + }, + span, + }; + } + Ok(expression) +} + +fn lower_immediate_anonymous( + expression: cst::Expr, + binders: &mut Vec, +) -> Result { + if matches!(&expression.kind, cst::ExprKind::Name(name) if name.text == "_") { + let span = expression.span; + let name = format!("$psrs_if_argument_{}", span.start); + binders.push(Binder { + name: name.clone(), + span, + }); + return Ok(Expr { + kind: ExprKind::Name(Name { text: name, span }), + span, + }); + } + lower_expr(expression) +} + pub(crate) fn lower_case_scrutinees( scrutinees: Vec, span: TextRange, diff --git a/crates/psrs-ast/src/expr/mod.rs b/crates/psrs-ast/src/expr/mod.rs index 25926343..86aaec16 100644 --- a/crates/psrs-ast/src/expr/mod.rs +++ b/crates/psrs-ast/src/expr/mod.rs @@ -7,7 +7,8 @@ mod guards; mod records; pub use guards::{Guard, GuardedExpr}; pub(super) use guards::{ - lower_case_patterns, lower_case_scrutinees, lower_guard, lower_guarded_rhs, prepend_guards, + lower_case_patterns, lower_case_scrutinees, lower_guard, lower_guarded_rhs, lower_if, + prepend_guards, }; pub(super) use records::{lower_record, lower_record_update}; diff --git a/crates/psrs-ast/src/lib.rs b/crates/psrs-ast/src/lib.rs index bf2751b6..e45eb9fd 100644 --- a/crates/psrs-ast/src/lib.rs +++ b/crates/psrs-ast/src/lib.rs @@ -276,11 +276,9 @@ pub(crate) fn lower_expr(expression: cst::Expr) -> Result { then_branch, else_branch, .. - } => ExprKind::If { - condition: Box::new(lower_expr(*condition)?), - then_branch: Box::new(lower_expr(*then_branch)?), - else_branch: Box::new(lower_expr(*else_branch)?), - }, + } => { + return expr::lower_if(*condition, *then_branch, *else_branch, span); + } CstExprKind::Case { scrutinees, alternatives, diff --git a/crates/psrs-driver/src/tests/guards.rs b/crates/psrs-driver/src/tests/guards.rs index d9433c38..358a6fbc 100644 --- a/crates/psrs-driver/src/tests/guards.rs +++ b/crates/psrs-driver/src/tests/guards.rs @@ -93,6 +93,16 @@ fn boolean_case_patterns_preserve_source_order() { assert_eq!(output.status.code(), Some(22), "{output:?}"); } +#[test] +fn an_anonymous_if_condition_is_a_function_parameter() { + let source = "module Main where\nchoose left right = (if _ then left else right) true\nmain = choose 7 9\n"; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(7), "{output:?}"); +} + #[test] fn anonymous_case_inputs_become_function_parameters_in_source_order() { let source = "module Main where\nchoose = case _, 2, _ of\n _, 2, _ -> 19\n _, _, _ -> 23\nmain = choose 1 3\n"; diff --git a/docs/design/frontend/syntax/ast-lowering.md b/docs/design/frontend/syntax/ast-lowering.md index 4ee34ea3..999dc3f2 100644 --- a/docs/design/frontend/syntax/ast-lowering.md +++ b/docs/design/frontend/syntax/ast-lowering.md @@ -65,8 +65,10 @@ use the same rule, with an anonymous base record as the first argument. Anonymous leaves of nested update paths belong to the enclosing updater; an explicit field expression or nested record literal introduces its own scope. P2 gives generated binders source-inexpressible names and preserves -each underscore's span; it does not reinterpret other expressions containing -`_` as constructor arguments. These rules follow the official compiler's +each underscore's span. An immediate `_` in an `if` condition, then branch, +or else branch is a lambda parameter in that written order, as a `case` +scrutinee already is. An underscore in any other expression position +stays an unresolved name. These rules follow the official compiler's `Sugar.ObjectWildcards` conversion and require no resolved names or types. AST update fields explicitly distinguish an expression from a nested path. P3 projects a nested path from its enclosing base, while resolving explicit From d2cee0d4c51ceab1cad489d8842d34829c024bbd Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:05:05 +0800 Subject: [PATCH 022/148] Expand local synonyms before checking an exported value. A value signature depends on the type constructors and classes that remain after a saturated local synonym expands. Constructor fields count only for the constructors the export actually lists. --- crates/psrs-driver/src/tests/declarations.rs | 69 +++++++ .../src/resolver/exports/transitive.rs | 180 +++++++++++++++++- .../semantics/modules-and-resolution.md | 18 +- 3 files changed, 257 insertions(+), 10 deletions(-) diff --git a/crates/psrs-driver/src/tests/declarations.rs b/crates/psrs-driver/src/tests/declarations.rs index 4f6743b2..7a4e0d8c 100644 --- a/crates/psrs-driver/src/tests/declarations.rs +++ b/crates/psrs-driver/src/tests/declarations.rs @@ -110,6 +110,53 @@ fn reports_a_transitive_export_of_an_unexported_type() { ); } +#[test] +fn an_exported_value_may_use_an_unexported_synonym_of_an_exported_type() { + let source = "module Main (step, Box) where\ndata Box = Box\ntype Inner = Box\ntype Step = Inner\nstep :: Step\nstep = Box\n"; + resolve_program_sources(&[("Main.purs", source)]) + .expect("a value signature expands local synonyms before the export check"); +} + +#[test] +fn an_exported_value_synonym_still_requires_its_hidden_type() { + let source = "module Main (step) where\ndata Hidden = Hidden\ntype Alias = Hidden\nstep :: Alias\nstep = Hidden\n"; + let errors = resolve_program_sources(&[("Main.purs", source)]).unwrap_err(); + assert!(errors.iter().any(|error| { + error.diagnostic.code == Some("TransitiveExportError") + && error.diagnostic.message.contains("Hidden") + })); + assert!( + errors + .iter() + .all(|error| !error.diagnostic.message.contains("Alias")) + ); +} + +#[test] +fn an_exported_synonym_still_requires_the_synonym_it_mentions() { + let source = "module Main (Y()) where\ntype X = Int\ntype Y = X\n"; + let errors = resolve_program_sources(&[("Main.purs", source)]).unwrap_err(); + assert!(errors.iter().any(|error| { + error.diagnostic.code == Some("TransitiveExportError") + && error.diagnostic.message.contains("`X`") + })); +} + +#[test] +fn a_quantified_synonym_body_keeps_its_hidden_type() { + let source = "module Main (value) where\ndata Pair a b = Pair a b\ntype Step a = forall r. Pair a r -> r\nvalue :: forall a. Step a\nvalue _ = 0\n"; + let errors = resolve_program_sources(&[("Main.purs", source)]).unwrap_err(); + assert!(errors.iter().any(|error| { + error.diagnostic.code == Some("TransitiveExportError") + && error.diagnostic.message.contains("Pair") + })); + assert!( + errors + .iter() + .all(|error| !error.diagnostic.message.contains("Step")) + ); +} + #[test] fn checks_an_inferred_public_result_type_after_typechecking() { let source = "module Main (value) where\ndata Hidden = Hidden\nidentity x = x\nvalue = identity Hidden\n"; @@ -178,6 +225,28 @@ fn checks_hidden_types_reached_through_an_inferred_record_field() { })); } +#[test] +fn a_hidden_constructor_does_not_require_its_field_type() { + let source = "module Main (Wrap) where\ndata Hidden = Hidden\nnewtype Wrap = Wrap Hidden\n"; + resolve_program_sources(&[("Main.purs", source)]) + .expect("a hidden constructor does not expose its field type"); +} + +#[test] +fn an_exported_constructor_requires_its_field_type() { + let source = "module Main (T(A)) where\ndata Shown = Shown\ndata Hidden = Hidden\ndata T = A Shown | B Hidden\n"; + let errors = resolve_program_sources(&[("Main.purs", source)]).unwrap_err(); + assert!(errors.iter().any(|error| { + error.diagnostic.code == Some("TransitiveExportError") + && error.diagnostic.message.contains("Shown") + })); + assert!( + errors + .iter() + .all(|error| !error.diagnostic.message.contains("Hidden")) + ); +} + #[test] fn reports_a_partial_constructor_export() { let source = "module Main (T(A)) where\ndata T = A | B\n"; diff --git a/crates/psrs-resolve/src/resolver/exports/transitive.rs b/crates/psrs-resolve/src/resolver/exports/transitive.rs index 3001787f..eb8328a9 100644 --- a/crates/psrs-resolve/src/resolver/exports/transitive.rs +++ b/crates/psrs-resolve/src/resolver/exports/transitive.rs @@ -118,9 +118,16 @@ impl Resolver { continue; }; let mut referenced = Vec::new(); - for constructor in &declaration.constructors { - for field in &constructor.fields { - collect_named_types(field, &mut referenced); + // Field types matter only for constructors the export actually + // lists. `T` and `T()` keep those constructors hidden. + if let Some(exported_constructors) = &exported.constructors { + for constructor in &declaration.constructors { + if !exported_constructors.contains(&constructor.symbol) { + continue; + } + for field in &constructor.fields { + collect_named_types(field, &mut referenced); + } } } if let Some(body) = &declaration.body { @@ -192,7 +199,9 @@ impl Resolver { if let Some(declaration) = own_declarations.get(&value.symbol) && let Some(signature) = &declaration.signature { - collect_named_types(signature, &mut required); + // A value type is stored after synonym expansion, so a local + // synonym in the explicit signature is not itself a dependency. + collect_named_types(&expand_value_synonyms(signature, &own), &mut required); } // Explicit signatures are checked at P3, where their named HIR // references are already resolved. Inferred public value types are @@ -266,3 +275,166 @@ fn collect_named_types(ty: &hir::Type, out: &mut Vec) { | hir::TypeKind::String(_) => {} } } + +/// Expands fully applied local type synonyms in a value signature. +/// +/// Exported declaration bodies keep the names written in source. Value types +/// do not: a saturated local synonym is replaced by its body, with its +/// parameters substituted, before the export dependency walk. An unsaturated +/// or recursive synonym stays in place; kind checking owns that error. +fn expand_value_synonyms( + ty: &hir::Type, + own: &HashMap, +) -> hir::Type { + expand_value_type(ty, own, &HashMap::new(), &[], &mut Vec::new()) +} + +fn expand_value_type( + ty: &hir::Type, + own: &HashMap, + subst: &HashMap, + bound: &[String], + stack: &mut Vec, +) -> hir::Type { + if let Some(expanded) = expand_saturated_synonym(ty, own, subst, bound, stack) { + return expanded; + } + let kind = match &ty.kind { + hir::TypeKind::Wildcard => hir::TypeKind::Wildcard, + hir::TypeKind::Variable(name) => { + if bound.iter().any(|binder| binder == name) { + hir::TypeKind::Variable(name.clone()) + } else if let Some(replacement) = subst.get(name) { + return replacement.clone(); + } else { + hir::TypeKind::Variable(name.clone()) + } + } + hir::TypeKind::Constructor(builtin) => hir::TypeKind::Constructor(*builtin), + hir::TypeKind::Named(id) => hir::TypeKind::Named(*id), + hir::TypeKind::Opaque(id) => hir::TypeKind::Opaque(*id), + hir::TypeKind::Application(function, argument) => hir::TypeKind::Application( + Box::new(expand_value_type(function, own, subst, bound, stack)), + Box::new(expand_value_type(argument, own, subst, bound, stack)), + ), + hir::TypeKind::OperatorChain { + operands, + operators, + } => hir::TypeKind::OperatorChain { + operands: operands + .iter() + .map(|operand| expand_value_type(operand, own, subst, bound, stack)) + .collect(), + operators: operators.clone(), + }, + hir::TypeKind::Function { parameter, result } => hir::TypeKind::Function { + parameter: Box::new(expand_value_type(parameter, own, subst, bound, stack)), + result: Box::new(expand_value_type(result, own, subst, bound, stack)), + }, + hir::TypeKind::Forall { variables, body } => { + let mut inner = bound.to_vec(); + let variables = variables + .iter() + .map(|variable| { + let kind = variable + .kind + .as_ref() + .map(|kind| expand_value_type(kind, own, subst, &inner, stack)); + inner.push(variable.name.clone()); + hir::TypeParameter { + name: variable.name.clone(), + name_span: variable.name_span, + kind, + } + }) + .collect(); + hir::TypeKind::Forall { + variables, + body: Box::new(expand_value_type(body, own, subst, &inner, stack)), + } + } + hir::TypeKind::Constrained { constraint, body } => hir::TypeKind::Constrained { + constraint: Box::new(expand_value_type(constraint, own, subst, bound, stack)), + body: Box::new(expand_value_type(body, own, subst, bound, stack)), + }, + hir::TypeKind::Row { fields, tail } => hir::TypeKind::Row { + fields: expand_fields(fields, own, subst, bound, stack), + tail: tail + .as_ref() + .map(|tail| Box::new(expand_value_type(tail, own, subst, bound, stack))), + }, + hir::TypeKind::Record { fields, tail } => hir::TypeKind::Record { + fields: expand_fields(fields, own, subst, bound, stack), + tail: tail + .as_ref() + .map(|tail| Box::new(expand_value_type(tail, own, subst, bound, stack))), + }, + hir::TypeKind::Integer(value) => hir::TypeKind::Integer(value.clone()), + hir::TypeKind::String(value) => hir::TypeKind::String(value.clone()), + }; + hir::Type { + kind, + span: ty.span, + } +} + +fn expand_fields( + fields: &[hir::TypeField], + own: &HashMap, + subst: &HashMap, + bound: &[String], + stack: &mut Vec, +) -> Vec { + fields + .iter() + .map(|field| hir::TypeField { + label: field.label.clone(), + label_span: field.label_span, + ty: expand_value_type(&field.ty, own, subst, bound, stack), + span: field.span, + }) + .collect() +} + +fn expand_saturated_synonym( + ty: &hir::Type, + own: &HashMap, + subst: &HashMap, + bound: &[String], + stack: &mut Vec, +) -> Option { + let (head, arguments) = applied_spine(ty); + let hir::TypeKind::Named(id) = head.kind else { + return None; + }; + let declaration = own.get(&id)?; + if declaration.kind != TypeDeclarationKind::TypeSynonym { + return None; + } + let body = declaration.body.as_ref()?; + if arguments.len() != declaration.parameters.len() || stack.contains(&id) { + return None; + } + stack.push(id); + let mut inner = HashMap::new(); + for (parameter, argument) in declaration.parameters.iter().zip(arguments) { + inner.insert( + parameter.name.clone(), + expand_value_type(argument, own, subst, bound, stack), + ); + } + let expanded = expand_value_type(body, own, &inner, &[], stack); + stack.pop(); + Some(expanded) +} + +fn applied_spine(ty: &hir::Type) -> (&hir::Type, Vec<&hir::Type>) { + let mut arguments = Vec::new(); + let mut head = ty; + while let hir::TypeKind::Application(function, argument) = &head.kind { + arguments.push(argument.as_ref()); + head = function.as_ref(); + } + arguments.reverse(); + (head, arguments) +} diff --git a/docs/design/frontend/semantics/modules-and-resolution.md b/docs/design/frontend/semantics/modules-and-resolution.md index 2b29d811..2d0ddc63 100644 --- a/docs/design/frontend/semantics/modules-and-resolution.md +++ b/docs/design/frontend/semantics/modules-and-resolution.md @@ -239,12 +239,18 @@ key policy. Orphan and overlapping instance visibility is specified with lookup alone. P3 checks explicit public signatures and declaration dependencies while their -resolved type references are available. It does not infer a public value's -type from expression syntax. After generalization, P5 traverses the checked -scheme by stable `TypeId` and reports hidden local types in inferred results, -function parameters, aliases, record fields, and constraints. The L2 export -scoreboard runs annotated transitive-export cases through the lenient typed -pipeline so each check is measured at its owning stage. +resolved type references are available. A fully applied local type synonym in +an explicit value signature is expanded first, and each in-module type +constructor or class that remains is a dependency. The synonym's own name is +not a dependency of that value. An exported data type, synonym, or class still +requires the in-module names written in its synonym body, superclasses, and +kinds. A data constructor's field types are dependencies only when that +constructor is part of the export. P3 does not infer a public value's type from +expression syntax. After generalization, P5 traverses the checked scheme by +stable `TypeId` and reports hidden local types in inferred results, function +parameters, aliases, record fields, and constraints. The L2 export scoreboard +runs annotated transitive-export cases through the lenient typed pipeline so +each check is measured at its owning stage. ## References From f69ae19676e367ef2644d9dea92cdddeef086a24 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:05:05 +0800 Subject: [PATCH 023/148] Parse a qualified name in backticks as one operator. A.zip between backticks is that qualified value used infix, so both operands stay on the operator chain. --- .../psrs-syntax/src/parser/expr/atom/mod.rs | 2 +- crates/psrs-syntax/src/parser/expr/mod.rs | 59 ++++++++++++++----- crates/psrs-syntax/src/parser/tests.rs | 10 ++++ 3 files changed, 55 insertions(+), 16 deletions(-) diff --git a/crates/psrs-syntax/src/parser/expr/atom/mod.rs b/crates/psrs-syntax/src/parser/expr/atom/mod.rs index 9fbfc8fb..f17b12f9 100644 --- a/crates/psrs-syntax/src/parser/expr/atom/mod.rs +++ b/crates/psrs-syntax/src/parser/expr/atom/mod.rs @@ -260,7 +260,7 @@ impl<'a> Parser<'a> { }) } - fn parse_qualified_value_name(&mut self) -> Result { + pub(super) fn parse_qualified_value_name(&mut self) -> Result { let token = self.current().clone(); let allow_qualification = matches!( &token.kind, diff --git a/crates/psrs-syntax/src/parser/expr/mod.rs b/crates/psrs-syntax/src/parser/expr/mod.rs index 4ced7903..884f0b0c 100644 --- a/crates/psrs-syntax/src/parser/expr/mod.rs +++ b/crates/psrs-syntax/src/parser/expr/mod.rs @@ -26,16 +26,9 @@ impl<'a> Parser<'a> { if precedence < min_precedence { break; } - let is_simple = matches!( - &self.peek(1).kind, - LayoutTokenKind::Raw( - RawTokenKind::LowerIdent(_) - | RawTokenKind::UpperIdent(_) - | RawTokenKind::Operator(_) - ) - ) && self.peek(2).kind - == LayoutTokenKind::Raw(RawTokenKind::Backtick); - if is_simple { + // A qualified name such as `A.zip` is one operator, not an + // expression applied to the left operand. + if self.at_simple_backticked_operator() { self.bump(); let operator = self.parse_backticked_operator()?; self.consume_raw(RawTokenKind::Backtick)?; @@ -124,14 +117,50 @@ impl<'a> Parser<'a> { Ok(left) } + fn at_simple_backticked_operator(&self) -> bool { + let close_at = match &self.peek(1).kind { + LayoutTokenKind::Raw( + RawTokenKind::LowerIdent(_) | RawTokenKind::Operator(_) | RawTokenKind::Colon, + ) => 2, + LayoutTokenKind::Raw(RawTokenKind::UpperIdent(_)) => { + let mut index = 1; + loop { + let name = self.peek(index); + let dot = self.peek(index + 1); + let part = self.peek(index + 2); + if !matches!(dot.kind, LayoutTokenKind::Raw(RawTokenKind::Dot)) + || dot.span.start != name.span.end + { + break; + } + let part_is_name = matches!( + part.kind, + LayoutTokenKind::Raw( + RawTokenKind::LowerIdent(_) | RawTokenKind::UpperIdent(_) + ) + ); + if !part_is_name || part.span.start != dot.span.end { + break; + } + index += 2; + } + index + 1 + } + _ => return false, + }; + self.peek(close_at).kind == LayoutTokenKind::Raw(RawTokenKind::Backtick) + } + fn parse_backticked_operator(&mut self) -> Result { + if matches!( + self.current().kind, + LayoutTokenKind::Raw(RawTokenKind::LowerIdent(_) | RawTokenKind::UpperIdent(_)) + ) { + return self.parse_qualified_value_name(); + } let token = self.current().clone(); match token.kind { - LayoutTokenKind::Raw( - RawTokenKind::LowerIdent(name) - | RawTokenKind::UpperIdent(name) - | RawTokenKind::Operator(name), - ) => { + LayoutTokenKind::Raw(RawTokenKind::Operator(name)) => { self.bump(); Ok(CstName::new(name, token.span)) } diff --git a/crates/psrs-syntax/src/parser/tests.rs b/crates/psrs-syntax/src/parser/tests.rs index 2aa2603f..9b0e4aab 100644 --- a/crates/psrs-syntax/src/parser/tests.rs +++ b/crates/psrs-syntax/src/parser/tests.rs @@ -76,6 +76,16 @@ fn parses_lambdas_conditionals_and_operator_precedence() { assert!(matches!(right.kind, ExprKind::Operator { ref operator, .. } if operator.text == "*")); } +#[test] +fn parses_a_qualified_name_between_backticks_as_one_operator() { + let module = parse("module Main where\nzip xs ys = xs `A.zip` ys\n").unwrap(); + let ExprKind::Operator { operator, .. } = &plain_value(as_value(&module.declarations[0])).kind + else { + panic!("expected an infix operator"); + }; + assert_eq!(operator.text, "A.zip"); +} + #[test] fn distinguishes_parenthesized_negation_from_explicit_operator_sections() { let module = parse( From c756e8daecdc0c7c5288fb22cf3286cd0f162c83 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:05:05 +0800 Subject: [PATCH 024/148] Apply extra arguments to an expanded type synonym. A synonym consumes only its declared parameters. Further arguments apply to the expanded body, so C2 a z x is (C2 a z) x. --- .../psrs-typecheck/src/typecheck/signature.rs | 27 ++++++++++-- .../src/typecheck/tests/user_types/mod.rs | 43 +++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/crates/psrs-typecheck/src/typecheck/signature.rs b/crates/psrs-typecheck/src/typecheck/signature.rs index b8aab276..168e9ac4 100644 --- a/crates/psrs-typecheck/src/typecheck/signature.rs +++ b/crates/psrs-typecheck/src/typecheck/signature.rs @@ -171,15 +171,34 @@ impl Checker { hir::TypeKind::Application(function, argument) => { let (head, arguments) = flatten_spine(ty); if let Some(id) = nominal_type_id(head) - && self.env.synonyms.contains_key(&id) + && let Some(arity) = self + .env + .synonyms + .get(&id) + .map(|synonym| synonym.parameters.len()) { - let arguments = arguments - .into_iter() + // Arguments past the synonym's own parameters apply to the + // expanded body. `C2 a z` has kind `k -> Type`, so + // `C2 a z x` is `(C2 a z) x`, not a third synonym parameter. + let elaborated = arguments + .iter() + .take(arity) .map(|argument| { self.elaborate_type_mode(argument, variables, rigid_variables) }) .collect(); - return self.expand_synonym(id, arguments, ty.span); + let mut expanded = self.expand_synonym(id, elaborated, ty.span); + for argument in arguments.iter().skip(arity) { + expanded = InferType::Application( + Box::new(expanded), + Box::new(self.elaborate_type_mode( + argument, + variables, + rigid_variables, + )), + ); + } + return expanded; } InferType::Application( Box::new(self.elaborate_type_mode(function, variables, rigid_variables)), diff --git a/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs b/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs index 70c084a8..08bb63f2 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs @@ -285,6 +285,49 @@ fn expands_type_synonyms_in_signatures() { typed.verify().unwrap(); } +#[test] +fn applies_extra_arguments_after_expanding_a_synonym() { + let element = applied( + applied( + named(0, 20), + builtin(psrs_hir::BuiltinType::Array, 24), + 20, + 30, + ), + builtin(psrs_hir::BuiltinType::Int, 31), + 20, + 34, + ); + let signature = HirType { + kind: HirTypeKind::Function { + parameter: Box::new(element.clone()), + result: Box::new(element), + }, + span: TextRange::new(20, 40), + }; + let declaration = declaration_with_signature(0, "f", 19, signature, identity_lambda(40)); + let mut resolved = module(vec![declaration], false); + resolved.types = vec![synonym(0, "Hom", &["f"], variable("f", 10))]; + + let typed = typecheck_module(resolved).unwrap(); + assert!( + typed + .types + .iter() + .any(|ty| matches!(ty, Type::Constructor(thir::TypeConstructor::Array))) + ); + assert!( + typed + .types + .iter() + .any(|ty| matches!(ty, Type::Constructor(thir::TypeConstructor::Int))) + ); + assert!(!typed.types.iter().any(|ty| matches!( + ty, + Type::Constructor(thir::TypeConstructor::User(id)) if id.index == 0 + ))); +} + #[test] fn rejects_a_partially_applied_synonym() { let signature = HirType { From 343298725cf3b3894c44f67cc193850d4aac9818 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:05:06 +0800 Subject: [PATCH 025/148] Parse hexadecimal integer literals as signed 32-bit Int. 0xFFFF fits in Int. A magnitude at or above 0x80000000 remains IntOutOfRange. --- crates/psrs-driver/src/tests/scalars.rs | 19 ++++++++++++++ .../psrs-typecheck/src/typecheck/infer/mod.rs | 26 ++++++++++++++++--- .../src/typecheck/infer/pattern.rs | 2 +- 3 files changed, 43 insertions(+), 4 deletions(-) diff --git a/crates/psrs-driver/src/tests/scalars.rs b/crates/psrs-driver/src/tests/scalars.rs index 30e6db8c..3f21f106 100644 --- a/crates/psrs-driver/src/tests/scalars.rs +++ b/crates/psrs-driver/src/tests/scalars.rs @@ -35,6 +35,25 @@ checkChar = booleanAnd (charEq 'A' 'A') (booleanAnd (charNe 'A' 'B') (booleanAnd main = if booleanAnd checkInt (booleanAnd checkUnary (booleanAnd checkNumber (booleanAnd checkBoolean checkChar))) then 0 else 1 "#; +#[test] +fn hexadecimal_integer_literals_use_the_signed_32_bit_range() { + crate::check_program(&[( + "Main.purs", + "module Main where\nvalue :: Int\nvalue = 0xFFFF\n", + )]) + .expect("0xFFFF fits in a signed 32-bit Int"); + let errors = crate::check_program(&[( + "Main.purs", + "module Main where\nvalue :: Int\nvalue = 0x80000000\n", + )]) + .expect_err("0x80000000 is outside signed 32-bit Int"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("IntOutOfRange")) + ); +} + #[test] fn scalar_intrinsics_are_reachable_from_source_and_execute_with_documented_semantics() { let core = lower_source_to_core("Main.purs", SCALAR_SOURCE) diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index 378bb6f4..4581a024 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -170,12 +170,12 @@ impl Checker { } } } - hir::ExprKind::Integer(text) => match text.parse::() { - Ok(value) => ( + hir::ExprKind::Integer(text) => match parse_int_literal(text) { + Some(value) => ( InferredExprKind::Integer(value), InferType::Constructor(TypeConstructor::Int), ), - Err(_) => { + None => { self.state.errors.push(TypeCheckError::new( TypeCheckErrorKind::IntegerOutOfRange, span, @@ -405,3 +405,23 @@ impl Checker { )) } } + +/// Decimal and hexadecimal integer literals, within signed 32-bit `Int`. +pub(super) fn parse_int_literal(text: &str) -> Option { + let (sign, digits) = if let Some(digits) = text.strip_prefix('-') { + (-1i64, digits) + } else if let Some(digits) = text.strip_prefix('+') { + (1, digits) + } else { + (1, text) + }; + let magnitude = if let Some(hexadecimal) = digits + .strip_prefix("0x") + .or_else(|| digits.strip_prefix("0X")) + { + i64::from_str_radix(hexadecimal, 16).ok()? + } else { + digits.parse::().ok()? + }; + i32::try_from(magnitude.checked_mul(sign)?).ok() +} diff --git a/crates/psrs-typecheck/src/typecheck/infer/pattern.rs b/crates/psrs-typecheck/src/typecheck/infer/pattern.rs index dafb4c2b..60e34d3a 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/pattern.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/pattern.rs @@ -18,7 +18,7 @@ impl Checker { } } hir::PatternKind::Integer(text) => { - let Ok(value) = text.parse::() else { + let Some(value) = super::parse_int_literal(text) else { self.state.errors.push(TypeCheckError::new( TypeCheckErrorKind::IntegerOutOfRange, span, From 74a0da81db03ce2d7aaec536b5fea08e59911708 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:48:06 +0800 Subject: [PATCH 026/148] Generalize local let constraints that one binding determines. A signed declaration solves every constraint, so a where-bound function quantified its monad before a use could refine that monad. A constraint stays on the local scheme only when that binding's type determines it. A constraint that still mentions an outer unknown stays with the enclosing declaration. --- .../psrs-driver/src/tests/let_constraints.rs | 108 +++++++ crates/psrs-driver/src/tests/mod.rs | 1 + .../src/typecheck/classes/fundeps/mod.rs | 7 + .../src/typecheck/classes/solve/entry.rs | 26 +- .../src/typecheck/classes/solve/search.rs | 10 +- .../src/typecheck/infer/let_expr.rs | 299 ++++++++++++++++++ .../psrs-typecheck/src/typecheck/infer/mod.rs | 57 +--- .../src/typecheck/prim/requeue.rs | 2 +- .../frontend/type-system/type-inference.md | 12 + 9 files changed, 454 insertions(+), 68 deletions(-) create mode 100644 crates/psrs-driver/src/tests/let_constraints.rs create mode 100644 crates/psrs-typecheck/src/typecheck/infer/let_expr.rs diff --git a/crates/psrs-driver/src/tests/let_constraints.rs b/crates/psrs-driver/src/tests/let_constraints.rs new file mode 100644 index 00000000..29833c41 --- /dev/null +++ b/crates/psrs-driver/src/tests/let_constraints.rs @@ -0,0 +1,108 @@ +//! Constraints inferred inside a local binding stay with that binding when the +//! enclosing declaration has a signature. The use instantiates them, so a +//! monad that is still unknown while the binding is checked can be `Maybe` at +//! the call. + +fn assert_checks(source: &str) { + crate::check_program(&[("Main.purs", source)]) + .unwrap_or_else(|errors| panic!("program should type check: {errors:?}")); +} + +#[test] +fn a_signed_function_generalizes_constraints_of_its_where_binding() { + let source = r#" +module Main where + +class Bind m where + bind :: forall a b. m a -> (a -> m b) -> m b + +class Enum a where + succ :: a -> Maybe a + +data Maybe a = Nothing | Just a + +instance bindMaybe :: Bind Maybe where + bind (Just value) continuation = continuation value + bind Nothing _ = Nothing + +instance enumInt :: Enum Int where + succ n = Just n + +enumFromTo :: forall a. Enum a => a -> Maybe a +enumFromTo from = go succ from + where + go step value = bind (step value) (\next -> Just next) + +main :: Int +main = 0 +"#; + assert_checks(source); +} + +#[test] +fn a_constraint_on_an_outer_unknown_stays_with_the_enclosing_binding() { + let source = r#" +module Main where + +class Show a where + show :: a -> Int + +instance showInt :: Show Int where + show _ = 1 + +shown value = let displayed = show value in displayed + +main :: Int +main = shown 1 +"#; + assert_checks(source); +} + +#[test] +fn a_recursive_local_keeps_a_shared_constraint_for_the_enclosing_use() { + let source = r#" +module Main where + +class Semiring a where + add :: a -> a -> a + +instance semiringInt :: Semiring Int where + add value _ = value + +loop :: Int -> Int +loop n = + let + go value = add value (go value) + in + go n + +main :: Int +main = loop 1 +"#; + assert_checks(source); +} + +#[test] +fn a_concrete_missing_instance_inside_a_let_is_still_rejected() { + let source = r#" +module Main where + +class Need a where + need :: a -> a + +bad :: Int -> Int +bad value = let needed = need value in needed + +main :: Int +main = bad 1 +"#; + let errors = + crate::check_program(&[("Main.purs", source)]).expect_err("Need Int has no instance"); + assert!( + errors.iter().any(|error| { + error.diagnostic.code == Some("NoInstanceFound") + && error.diagnostic.message.contains("Need Int") + }), + "expected a missing Need Int instance, got {errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index d1539d8b..d205988d 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -16,6 +16,7 @@ mod effects; mod foldable; mod functor; mod guard_coverage; +mod let_constraints; mod operators; mod partial_application; mod scalars; diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs index 49baf38e..1ee1960f 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs @@ -252,6 +252,13 @@ impl Checker { if constraint.solution.is_none() { continue; } + // An abstracted dictionary belongs to a nested binding that already + // measured the constraint against its own result. This declaration's + // residuals are still unsolved here; `check_residual_ambiguity` + // measures them after solving returns. + if matches!(constraint.solution, Some(WantedSolution::Abstracted(_))) { + continue; + } // A wanted discharged using a lexical dictionary, directly or // through the context of a selected instance, is determined by // that dictionary's scope. This commonly occurs inside a rank-N diff --git a/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs b/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs index 948b7910..41602b45 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs @@ -60,6 +60,12 @@ pub(in crate::typecheck) enum UnsolvedPolicy { /// quantify, so it is still `NoInstance`: generalizing it would hide a /// missing instance rather than defer it. Retain, + /// Every undischarged obligation is returned to the caller and none is + /// reported here. A nested `let` uses this to choose which constraints + /// become the binding's dictionary parameters and which stay with the + /// enclosing declaration. The enclosing solve still reports an obligation + /// this pass left unsolved. + Defer, } impl Checker { @@ -121,9 +127,7 @@ impl Checker { .iter() .any(|error| error.kind.reports_constraint_failure()); if constraint.solution.is_none() && !reported_resolution_error { - if unsolved == UnsolvedPolicy::Retain - && self.can_generalize_constraint(&constraint) - { + if self.policy_keeps_unsolved(unsolved, &constraint) { retained.push(index); } else { let rendered = @@ -151,6 +155,22 @@ impl Checker { retained } + /// Whether `unsolved` keeps this constraint instead of reporting it. + /// + /// `Defer` keeps every undischarged obligation so a caller can decide which + /// scope owns it. `Retain` keeps one only while it can still be quantified. + pub(in crate::typecheck) fn policy_keeps_unsolved( + &self, + unsolved: UnsolvedPolicy, + constraint: &WantedConstraint, + ) -> bool { + match unsolved { + UnsolvedPolicy::Defer => true, + UnsolvedPolicy::Retain => self.can_generalize_constraint(constraint), + UnsolvedPolicy::RequireSolved => false, + } + } + /// A constraint that still mentions something generalization /// could quantify. A nullary class constraint is generalized on its own, and /// any argument that is still a flexible inference variable makes the diff --git a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs index ab0f4049..f63c2409 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs @@ -73,10 +73,7 @@ impl Checker { if let Some(solution) = self.given_solution(constraint, depth) { return Some(solution); } - if policy == UnsolvedPolicy::Retain - && is_report_only(class_id) - && self.can_generalize_constraint(constraint) - { + if is_report_only(class_id) && self.policy_keeps_unsolved(policy, constraint) { return None; } } @@ -270,10 +267,7 @@ impl Checker { let has_nested_diagnostic = self.state.errors[errors_before..] .iter() .any(|error| error.kind.reports_constraint_failure()); - if !has_nested_diagnostic - && policy == UnsolvedPolicy::Retain - && self.can_generalize_constraint(&wanted) - { + if !has_nested_diagnostic && self.policy_keeps_unsolved(policy, &wanted) { // The selected instance's dictionary needs this context // dictionary; the declaration can supply it as a generalized // parameter. The stable id lets evidence elaboration read the diff --git a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs new file mode 100644 index 00000000..cad03186 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs @@ -0,0 +1,299 @@ +//! Local `let` and `where` bindings. +//! +//! A binding is generalized before its body so each use instantiates it. The +//! constraints inferred from the binding are part of that scheme when every +//! flexible variable they mention was allocated inside the binding and one +//! binding's type determines them. Other undischarged constraints stay on the +//! enclosing declaration: an outer unknown can still be solved by a later use, +//! and a recursive group does not quantify a variable an open constraint shares. + +use super::super::classes::{UnsolvedPolicy, collect_infer_variables}; +use super::super::*; +use std::collections::HashSet; + +impl Checker { + pub(in crate::typecheck) fn infer_let_expression( + &mut self, + bindings: &[hir::LocalBinding], + body: &hir::Expr, + expected: Option, + ) -> Option<(InferredExprKind, InferType)> { + // Binding bodies are inferred one level deeper, so their unknowns are + // generalized against this level; the body is checked back at it. + let outer_level = self.state.level; + let (inferred_bindings, body) = self.in_nested_level(|checker| { + let wanted_start = checker.state.wanted.len(); + let mut binders = Vec::with_capacity(bindings.len()); + for binding in bindings { + let ty = checker.fresh(); + checker + .scope + .locals + .insert(binding.binder.id, Scheme::monomorphic(ty.clone())); + binders.push(InferredBinder { + binder: binding.binder.clone(), + scheme: Scheme::monomorphic(ty), + }); + } + let mut inferred_bindings = Vec::with_capacity(bindings.len()); + for (binding, binder) in bindings.iter().zip(binders) { + if let Some(value) = checker.infer_expr(&binding.value) { + checker.unify(binder.scheme.ty.clone(), value.ty.clone(), binding.span); + inferred_bindings.push(InferredBinding { + binder, + value, + span: binding.span, + }); + } + } + checker.generalize_let_bindings( + bindings, + &mut inferred_bindings, + outer_level, + wanted_start, + ); + checker.state.level = outer_level; + let body = checker.infer_expr_with_expected(body, expected); + for binding in bindings { + checker.scope.locals.remove(&binding.binder.id); + } + (inferred_bindings, body) + }); + let body = body?; + let ty = body.ty.clone(); + Some(( + InferredExprKind::Let { + bindings: inferred_bindings, + body: Box::new(body), + }, + ty, + )) + } + + /// Splits the constraints the bindings raised. Ones determined by a single + /// binding become its dictionary parameters; the rest keep their unknowns + /// shared with the enclosing scope. + fn generalize_let_bindings( + &mut self, + bindings: &[hir::LocalBinding], + inferred: &mut [InferredBinding], + outer_level: u32, + wanted_start: usize, + ) { + let unsolved = self.solve_wanted_constraints(None, wanted_start, UnsolvedPolicy::Defer); + let recursive = bindings_are_recursive(bindings); + let binding_variables = inferred + .iter() + .map(|binding| { + let mut variables = HashSet::new(); + collect_infer_variables( + &self.resolve_type(binding.binder.scheme.ty.clone()), + &mut variables, + ); + variables + }) + .collect::>(); + let mut owned = vec![Vec::new(); inferred.len()]; + let mut lowered = HashSet::new(); + for index in unsolved { + let variables = self.constraint_variables(index); + let deep = self.deep_variables(&variables, outer_level); + let shares_outer = variables + .iter() + .any(|variable| !deep.contains(variable) && !self.state.rigid.contains(variable)); + if deep.is_empty() || recursive || shares_outer { + lowered.extend(deep); + continue; + } + let owners = binding_variables + .iter() + .enumerate() + .filter(|(_, binding_vars)| { + deep.iter().all(|variable| binding_vars.contains(variable)) + }) + .map(|(index, _)| index) + .collect::>(); + if let [owner] = owners.as_slice() { + let rigid_visible = variables + .iter() + .filter(|variable| self.state.rigid.contains(variable)) + .all(|variable| binding_variables[*owner].contains(variable)); + if rigid_visible { + owned[*owner].push(index); + continue; + } + } + lowered.extend(deep); + } + loop { + let mut changed = false; + for bucket in &mut owned { + let mut kept = Vec::new(); + for index in bucket.drain(..) { + let deep = self.deep_variables(&self.constraint_variables(index), outer_level); + if deep.iter().any(|variable| lowered.contains(variable)) { + lowered.extend(deep); + changed = true; + } else { + kept.push(index); + } + } + *bucket = kept; + } + if !changed { + break; + } + } + for variable in &lowered { + // Leave the unknown at the enclosing level so this binding does not + // quantify it while an undischarged constraint still mentions it. + self.state.levels.insert(*variable, outer_level); + } + for (binding, residual) in inferred.iter_mut().zip(owned) { + let monotype = binding.binder.scheme.ty.clone(); + self.check_residual_ambiguity( + &self.residual_wanted(&residual), + &monotype, + &binding.binder.binder.name, + binding.span, + ); + let parameters = self.abstract_dictionaries(&residual); + let constraints = self.retained_constraints(&residual); + let mut scheme = self.generalize(&[], &monotype, &constraints, outer_level); + binding.value = self.wrap_dictionary_lambdas( + std::mem::replace( + &mut binding.value, + InferredExpr { + kind: InferredExprKind::Integer(0), + ty: monotype, + span: binding.span, + }, + ), + ¶meters, + ); + self.scope + .locals + .insert(binding.binder.binder.id, scheme.clone()); + scheme.ty = binding.value.ty.clone(); + binding.binder.scheme = scheme; + } + } + + fn constraint_variables(&self, index: usize) -> HashSet { + let mut variables = HashSet::new(); + let Some(constraint) = self.state.wanted.get(index) else { + return variables; + }; + for argument in &constraint.arguments { + collect_infer_variables(&self.resolve_type(argument.clone()), &mut variables); + } + variables + } + + fn deep_variables(&self, variables: &HashSet, outer_level: u32) -> HashSet { + variables + .iter() + .copied() + .filter(|variable| { + !self.state.rigid.contains(variable) + && self + .state + .levels + .get(variable) + .copied() + .unwrap_or(TOP_LEVEL) + > outer_level + }) + .collect() + } +} + +fn bindings_are_recursive(bindings: &[hir::LocalBinding]) -> bool { + let ids = bindings + .iter() + .map(|binding| binding.binder.id) + .collect::>(); + bindings + .iter() + .any(|binding| expr_mentions(&binding.value, &ids)) +} + +fn expr_mentions(expression: &hir::Expr, ids: &HashSet) -> bool { + match &expression.kind { + hir::ExprKind::Local(id) => ids.contains(id), + hir::ExprKind::Application(function, argument) => { + expr_mentions(function, ids) || expr_mentions(argument, ids) + } + hir::ExprKind::Operator { left, right, .. } => { + expr_mentions(left, ids) || expr_mentions(right, ids) + } + hir::ExprKind::Negate { + function, + expression, + .. + } => expr_mentions(function, ids) || expr_mentions(expression, ids), + hir::ExprKind::Typed { expression, .. } + | hir::ExprKind::TypeApplication { expression, .. } + | hir::ExprKind::FieldAccess { expression, .. } => expr_mentions(expression, ids), + hir::ExprKind::Array(elements) => { + elements.iter().any(|element| expr_mentions(element, ids)) + } + hir::ExprKind::Record(fields) => fields.iter().any(|(_, value)| expr_mentions(value, ids)), + hir::ExprKind::RecordUpdate { expression, fields } => { + expr_mentions(expression, ids) + || fields.iter().any(|(_, value)| expr_mentions(value, ids)) + } + hir::ExprKind::OperatorChain { operands, .. } => { + operands.iter().any(|operand| expr_mentions(operand, ids)) + } + hir::ExprKind::OperatorSection { operand, .. } => expr_mentions(operand, ids), + hir::ExprKind::Lambda { body, .. } => expr_mentions(body, ids), + hir::ExprKind::Let { bindings, body } => { + bindings + .iter() + .any(|binding| expr_mentions(&binding.value, ids)) + || expr_mentions(body, ids) + } + hir::ExprKind::If { + condition, + then_branch, + else_branch, + } => { + expr_mentions(condition, ids) + || expr_mentions(then_branch, ids) + || expr_mentions(else_branch, ids) + } + hir::ExprKind::Case { + scrutinee, + branches, + } => { + expr_mentions(scrutinee, ids) + || branches + .iter() + .any(|branch| expr_mentions(&branch.value, ids)) + } + hir::ExprKind::Guarded(clauses) => clauses.iter().any(|clause| { + expr_mentions(&clause.value, ids) + || clause.guards.iter().any(|guard| guard_mentions(guard, ids)) + || clause + .where_bindings + .iter() + .any(|binding| expr_mentions(&binding.value, ids)) + }), + hir::ExprKind::Global(_) + | hir::ExprKind::Integer(_) + | hir::ExprKind::Number(_) + | hir::ExprKind::String(_) + | hir::ExprKind::Char(_) => false, + } +} + +fn guard_mentions(guard: &hir::Guard, ids: &HashSet) -> bool { + match guard { + hir::Guard::Boolean(expression) => expr_mentions(expression, ids), + hir::Guard::Pattern { value, .. } => expr_mentions(value, ids), + hir::Guard::Let { bindings, .. } => bindings + .iter() + .any(|binding| expr_mentions(&binding.value, ids)), + } +} diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index 4581a024..f27ed898 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -5,6 +5,7 @@ mod case; mod construct; mod expected; mod intrinsics; +mod let_expr; mod pattern; mod records; mod visible_type_application; @@ -348,62 +349,6 @@ impl Checker { }; Some(InferredExpr { kind, ty, span }) } - - pub(super) fn infer_let_expression( - &mut self, - bindings: &[hir::LocalBinding], - body: &hir::Expr, - expected: Option, - ) -> Option<(InferredExprKind, InferType)> { - // The binding bodies are inferred one level deeper, so their unknowns are - // generalized against this level; the body is checked back at it. - let outer_level = self.state.level; - let (inferred_bindings, body) = self.in_nested_level(|checker| { - let mut binders = Vec::with_capacity(bindings.len()); - for binding in bindings { - let ty = checker.fresh(); - checker - .scope - .locals - .insert(binding.binder.id, Scheme::monomorphic(ty.clone())); - binders.push(InferredBinder { - binder: binding.binder.clone(), - scheme: Scheme::monomorphic(ty), - }); - } - let mut inferred_bindings = Vec::with_capacity(bindings.len()); - for (binding, binder) in bindings.iter().zip(binders) { - if let Some(value) = checker.infer_expr(&binding.value) { - checker.unify(binder.scheme.ty.clone(), value.ty.clone(), binding.span); - inferred_bindings.push(InferredBinding { - binder, - value, - span: binding.span, - }); - } - } - for (binding, inferred) in bindings.iter().zip(inferred_bindings.iter_mut()) { - let scheme = checker.generalize(&[], &inferred.binder.scheme.ty, &[], outer_level); - inferred.binder.scheme = scheme.clone(); - checker.scope.locals.insert(binding.binder.id, scheme); - } - checker.state.level = outer_level; - let body = checker.infer_expr_with_expected(body, expected); - for binding in bindings { - checker.scope.locals.remove(&binding.binder.id); - } - (inferred_bindings, body) - }); - let body = body?; - let ty = body.ty.clone(); - Some(( - InferredExprKind::Let { - bindings: inferred_bindings, - body: Box::new(body), - }, - ty, - )) - } } /// Decimal and hexadecimal integer literals, within signed 32-bit `Int`. diff --git a/crates/psrs-typecheck/src/typecheck/prim/requeue.rs b/crates/psrs-typecheck/src/typecheck/prim/requeue.rs index a15bceff..dda4855c 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/requeue.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/requeue.rs @@ -141,7 +141,7 @@ impl Checker { { return; } - if policy == UnsolvedPolicy::Retain && self.can_generalize_constraint(&constraint) { + if self.policy_keeps_unsolved(policy, &constraint) { self.state.wanted.push(constraint); return; } diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index f371d63d..6440a7d2 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -255,6 +255,18 @@ so the body's evidence and the parameter the scheme hands on are one dictionary. `group.rs` runs the sequence and `entry.rs` hands it the module. A wanted from an earlier declaration is not re-solved: that declaration has already generalized or reported it, so a second attempt could bind a variable it has since quantified. +A local `let` or `where` binding is a nested generalization, not an obligation +of the enclosing signature. Before the binding is quantified, its new wanteds +are solved under `Defer`: nothing is reported yet. A constraint whose flexible +variables were all allocated inside that binding, and that exactly one binding's +type determines, is retained on the binding. It becomes dictionary parameters, +and each use instantiates it, so `go succ` can solve `Bind Maybe` after `succ` +fixes the monad. A constraint that still mentions an outer unknown stays +unsolved for the enclosing declaration. A recursive local group does not +quantify a variable an undischarged constraint still shares; that constraint +stays with the enclosing declaration, the same rule that refuses polymorphic +recursion at the top level. An abstracted dictionary is a nested binding's +parameter, so the enclosing ambiguity check does not measure it again. The scheme records the kind of each quantified variable, read through the kind owner, so an instantiation carries the declaration's own polymorphism rather than reading it back from the solver table. From 64330c2e57768ca54bd67329f8e0e8dee3ee5f23 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:49:37 +0800 Subject: [PATCH 027/148] Keep outer locals polymorphic in guarded fallthrough. A fallthrough helper is defined in the same let as the case, so it can name an outer local directly. Passing that local in as a value argument instantiated its scheme once, before the guard applied the arguments that solve its constraints. --- crates/psrs-desugar/src/expr.rs | 27 +- crates/psrs-desugar/src/free_vars.rs | 377 ------------------ crates/psrs-desugar/src/lib.rs | 1 - .../psrs-driver/src/tests/let_constraints.rs | 36 ++ docs/design/frontend/semantics/desugaring.md | 8 +- 5 files changed, 46 insertions(+), 403 deletions(-) delete mode 100644 crates/psrs-desugar/src/free_vars.rs diff --git a/crates/psrs-desugar/src/expr.rs b/crates/psrs-desugar/src/expr.rs index 06b264eb..38d2f6b0 100644 --- a/crates/psrs-desugar/src/expr.rs +++ b/crates/psrs-desugar/src/expr.rs @@ -4,7 +4,6 @@ use crate::{ apply, guarded_rhs_exhaustive, is_guarded_rhs, product_expression, product_pattern, wrap_lambdas, }, - free_vars, }; use psrs_hir::{ self as hir, CaseBranch, CaseBranchCoverage, Expr, ExprKind, LocalBinder, LocalBinding, @@ -163,7 +162,10 @@ impl Desugarer { } } - let captures = free_vars::captures(&branches); + // Fallthrough helpers stay in this `let`, so they see the same outer + // locals as the source branch. Passing those locals in as arguments + // would instantiate a polymorphic scheme once, before the guard body + // applies the arguments that determine its constraints. let temp = self.local_binder("case_scrutinee", span); let helper_binders = (1..=branches.len() + 1) .map(|index| self.local_binder(&format!("guard_fallthrough_{index}"), span)) @@ -180,17 +182,7 @@ impl Desugarer { .iter() .map(|_| self.local_binder("next_guard", span)) .collect::>(); - let capture_parameters = captures - .iter() - .map(|_| self.local_binder("guard_capture", span)) - .collect::>(); let temp_parameter = self.local_binder("guard_scrutinee", span); - let mut local_mapping = captures - .iter() - .zip(&capture_parameters) - .map(|(id, binder)| (*id, binder.id)) - .collect::>(); - local_mapping.insert(temp.id, temp_parameter.id); let body = if row_index == branches.len() { Expr { @@ -203,17 +195,11 @@ impl Desugarer { } else { let mut source = alpha::clone_branch(&branches[row_index], &mut self.fresh); source.coverage = CaseBranchCoverage::Generated; - source.value = free_vars::rebind(source.value, &local_mapping); let failure = apply( self.local_expr(&next_functions[0], span), next_functions[1..] .iter() .map(|binder| self.local_expr(binder, span)) - .chain( - capture_parameters - .iter() - .map(|binder| self.local_expr(binder, span)), - ) .chain(std::iter::once(self.local_expr(&temp_parameter, span))), span, ); @@ -238,7 +224,6 @@ impl Desugarer { }; let parameters = next_functions .into_iter() - .chain(capture_parameters) .chain(std::iter::once(temp_parameter)) .collect::>(); let value = wrap_lambdas(parameters, body, span); @@ -265,10 +250,6 @@ impl Desugarer { helper_binders[start..] .iter() .map(|binder| self.local_expr(binder, branch.span)) - .chain(captures.iter().map(|id| Expr { - kind: ExprKind::Local(*id), - span: branch.span, - })) .chain(std::iter::once(self.local_expr(&temp, branch.span))), branch.span, ); diff --git a/crates/psrs-desugar/src/free_vars.rs b/crates/psrs-desugar/src/free_vars.rs deleted file mode 100644 index 6ad4cebc..00000000 --- a/crates/psrs-desugar/src/free_vars.rs +++ /dev/null @@ -1,377 +0,0 @@ -use psrs_hir::{CaseBranch, Expr, ExprKind, Guard, GuardedExpr, LocalId, Pattern, PatternKind}; -use std::collections::{HashMap, HashSet}; - -pub(super) fn captures(branches: &[CaseBranch]) -> Vec { - let mut free = HashSet::new(); - for branch in branches { - let mut bound = HashSet::new(); - pattern_ids(&branch.pattern, &mut bound); - collect(&branch.value, &mut bound, &mut free); - } - let mut captures = free.into_iter().collect::>(); - captures.sort_by_key(|id| id.0); - captures -} - -pub(super) fn rebind(expression: Expr, mapping: &HashMap) -> Expr { - let span = expression.span; - let kind = match expression.kind { - ExprKind::Local(id) => ExprKind::Local(mapping.get(&id).copied().unwrap_or(id)), - ExprKind::Array(items) => ExprKind::Array( - items - .into_iter() - .map(|item| rebind(item, mapping)) - .collect(), - ), - ExprKind::Record(fields) => ExprKind::Record( - fields - .into_iter() - .map(|(label, value)| (label, rebind(value, mapping))) - .collect(), - ), - ExprKind::RecordUpdate { expression, fields } => ExprKind::RecordUpdate { - expression: Box::new(rebind(*expression, mapping)), - fields: fields - .into_iter() - .map(|(label, value)| (label, rebind(value, mapping))) - .collect(), - }, - ExprKind::FieldAccess { expression, field } => ExprKind::FieldAccess { - expression: Box::new(rebind(*expression, mapping)), - field, - }, - ExprKind::Application(function, argument) => ExprKind::Application( - Box::new(rebind(*function, mapping)), - Box::new(rebind(*argument, mapping)), - ), - ExprKind::Typed { expression, ty } => ExprKind::Typed { - expression: Box::new(rebind(*expression, mapping)), - ty, - }, - ExprKind::TypeApplication { expression, ty } => ExprKind::TypeApplication { - expression: Box::new(rebind(*expression, mapping)), - ty, - }, - ExprKind::Operator { - operator, - operator_span, - left, - right, - } => ExprKind::Operator { - operator, - operator_span, - left: Box::new(rebind(*left, mapping)), - right: Box::new(rebind(*right, mapping)), - }, - ExprKind::Negate { - function, - minus_span, - expression, - } => ExprKind::Negate { - function: Box::new(rebind(*function, mapping)), - minus_span, - expression: Box::new(rebind(*expression, mapping)), - }, - ExprKind::OperatorChain { - operands, - operators, - } => ExprKind::OperatorChain { - operands: operands - .into_iter() - .map(|operand| rebind(operand, mapping)) - .collect(), - operators, - }, - ExprKind::OperatorSection { - operator, - operand, - binder, - side, - } => ExprKind::OperatorSection { - operator, - operand: Box::new(rebind(*operand, mapping)), - binder, - side, - }, - ExprKind::Lambda { binder, body } => ExprKind::Lambda { - binder, - body: Box::new(rebind(*body, mapping)), - }, - ExprKind::Let { bindings, body } => ExprKind::Let { - bindings: bindings - .into_iter() - .map(|binding| LocalBinding { - value: rebind(binding.value, mapping), - ..binding - }) - .collect(), - body: Box::new(rebind(*body, mapping)), - }, - ExprKind::If { - condition, - then_branch, - else_branch, - } => ExprKind::If { - condition: Box::new(rebind(*condition, mapping)), - then_branch: Box::new(rebind(*then_branch, mapping)), - else_branch: Box::new(rebind(*else_branch, mapping)), - }, - ExprKind::Case { - scrutinee, - branches, - } => ExprKind::Case { - scrutinee: Box::new(rebind(*scrutinee, mapping)), - branches: branches - .into_iter() - .map(|branch| CaseBranch { - value: rebind(branch.value, mapping), - ..branch - }) - .collect(), - }, - ExprKind::Guarded(clauses) => ExprKind::Guarded( - clauses - .into_iter() - .map(|clause| rebind_clause(clause, mapping)) - .collect(), - ), - leaf @ (ExprKind::Global(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::String(_) - | ExprKind::Char(_)) => leaf, - }; - Expr { kind, span } -} - -use psrs_hir::LocalBinding; - -fn rebind_clause(clause: GuardedExpr, mapping: &HashMap) -> GuardedExpr { - GuardedExpr { - guards: clause - .guards - .into_iter() - .map(|guard| match guard { - Guard::Boolean(value) => Guard::Boolean(rebind(value, mapping)), - Guard::Pattern { pattern, value } => Guard::Pattern { - pattern, - value: rebind(value, mapping), - }, - Guard::Let { bindings, span } => Guard::Let { - bindings: bindings - .into_iter() - .map(|binding| LocalBinding { - value: rebind(binding.value, mapping), - ..binding - }) - .collect(), - span, - }, - }) - .collect(), - value: rebind(clause.value, mapping), - where_bindings: clause - .where_bindings - .into_iter() - .map(|binding| LocalBinding { - value: rebind(binding.value, mapping), - ..binding - }) - .collect(), - ..clause - } -} - -fn collect(expression: &Expr, bound: &mut HashSet, free: &mut HashSet) { - match &expression.kind { - ExprKind::Local(id) => { - if !bound.contains(id) { - free.insert(*id); - } - } - ExprKind::Array(items) => { - for item in items { - collect(item, bound, free); - } - } - ExprKind::Record(fields) => { - for (_, value) in fields { - collect(value, bound, free); - } - } - ExprKind::RecordUpdate { expression, fields } => { - collect(expression, bound, free); - for (_, value) in fields { - collect(value, bound, free); - } - } - ExprKind::FieldAccess { expression, .. } - | ExprKind::Typed { expression, .. } - | ExprKind::TypeApplication { expression, .. } => { - collect(expression, bound, free); - } - ExprKind::Application(function, argument) => { - collect(function, bound, free); - collect(argument, bound, free); - } - ExprKind::Operator { left, right, .. } => { - collect(left, bound, free); - collect(right, bound, free); - } - ExprKind::Negate { - function, - expression, - .. - } => { - collect(function, bound, free); - collect(expression, bound, free); - } - ExprKind::OperatorChain { operands, .. } => { - for operand in operands { - collect(operand, bound, free); - } - } - ExprKind::OperatorSection { operand, .. } => collect(operand, bound, free), - ExprKind::Lambda { binder, body } => { - let inserted = bound.insert(binder.id); - collect(body, bound, free); - if inserted { - bound.remove(&binder.id); - } - } - ExprKind::Let { bindings, body } => { - let mut inserted = Vec::new(); - for binding in bindings { - if bound.insert(binding.binder.id) { - inserted.push(binding.binder.id); - } - } - for binding in bindings { - collect(&binding.value, bound, free); - } - collect(body, bound, free); - for id in inserted { - bound.remove(&id); - } - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - collect(condition, bound, free); - collect(then_branch, bound, free); - collect(else_branch, bound, free); - } - ExprKind::Case { - scrutinee, - branches, - } => { - collect(scrutinee, bound, free); - for branch in branches { - let mut inserted = Vec::new(); - let mut ids = HashSet::new(); - pattern_ids(&branch.pattern, &mut ids); - for id in ids { - if bound.insert(id) { - inserted.push(id); - } - } - collect(&branch.value, bound, free); - for id in inserted { - bound.remove(&id); - } - } - } - ExprKind::Guarded(clauses) => { - for clause in clauses { - collect_clause(clause, bound, free); - } - } - ExprKind::Global(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::String(_) - | ExprKind::Char(_) => {} - } -} - -fn collect_clause(clause: &GuardedExpr, bound: &mut HashSet, free: &mut HashSet) { - let mut inserted = Vec::new(); - for binding in &clause.where_bindings { - if bound.insert(binding.binder.id) { - inserted.push(binding.binder.id); - } - } - for binding in &clause.where_bindings { - collect(&binding.value, bound, free); - } - for guard in &clause.guards { - match guard { - Guard::Boolean(value) => collect(value, bound, free), - Guard::Pattern { pattern, value } => { - collect(value, bound, free); - let mut ids = HashSet::new(); - pattern_ids(pattern, &mut ids); - for id in ids { - if bound.insert(id) { - inserted.push(id); - } - } - } - Guard::Let { bindings, .. } => { - for binding in bindings { - if bound.insert(binding.binder.id) { - inserted.push(binding.binder.id); - } - } - for binding in bindings { - collect(&binding.value, bound, free); - } - } - } - } - collect(&clause.value, bound, free); - for id in inserted { - bound.remove(&id); - } -} - -fn pattern_ids(pattern: &Pattern, ids: &mut HashSet) { - match &pattern.kind { - PatternKind::Var(binder) => { - ids.insert(binder.id); - } - PatternKind::Named { binder, pattern } => { - ids.insert(binder.id); - pattern_ids(pattern, ids); - } - PatternKind::Array(elements) => { - for element in elements { - pattern_ids(element, ids); - } - } - PatternKind::Typed { pattern, .. } => pattern_ids(pattern, ids), - PatternKind::Constructor { arguments, .. } => { - for argument in arguments { - pattern_ids(argument, ids); - } - } - PatternKind::Record { fields, .. } => { - for (_, field) in fields { - pattern_ids(field, ids); - } - } - PatternKind::OperatorChain { operands, .. } => { - for operand in operands { - pattern_ids(operand, ids); - } - } - PatternKind::Wildcard - | PatternKind::Boolean(_) - | PatternKind::Integer(_) - | PatternKind::Number(_) - | PatternKind::String(_) - | PatternKind::Char(_) => {} - } -} diff --git a/crates/psrs-desugar/src/lib.rs b/crates/psrs-desugar/src/lib.rs index d3323c27..9694acd1 100644 --- a/crates/psrs-desugar/src/lib.rs +++ b/crates/psrs-desugar/src/lib.rs @@ -22,7 +22,6 @@ mod case_helpers; mod constant_truth; mod expr; mod fixity; -mod free_vars; mod guards; mod types; diff --git a/crates/psrs-driver/src/tests/let_constraints.rs b/crates/psrs-driver/src/tests/let_constraints.rs index 29833c41..46c26c70 100644 --- a/crates/psrs-driver/src/tests/let_constraints.rs +++ b/crates/psrs-driver/src/tests/let_constraints.rs @@ -82,6 +82,42 @@ main = loop 1 assert_checks(source); } +#[test] +fn a_guarded_case_use_instantiates_a_where_binding() { + let source = r#" +module Main where + +class Bind m where + bind :: forall a b. m a -> (a -> m b) -> m b + +class Enum a where + succ :: a -> Maybe a + pred :: a -> Maybe a + +data Maybe a = Nothing | Just a + +instance bindMaybe :: Bind Maybe where + bind (Just value) continuation = continuation value + bind Nothing _ = Nothing + +instance enumInt :: Enum Int where + succ n = Just n + pred n = Just n + +enumFromTo :: forall a. Enum a => a -> a -> Maybe a +enumFromTo = case _, _ of + from, to + | true -> go succ from + | true -> go pred from + where + go step value = bind (step value) (\next -> Just next) + +main :: Int +main = 0 +"#; + assert_checks(source); +} + #[test] fn a_concrete_missing_instance_inside_a_let_is_still_rejected() { let source = r#" diff --git a/docs/design/frontend/semantics/desugaring.md b/docs/design/frontend/semantics/desugaring.md index 10d5a1a5..3419313e 100644 --- a/docs/design/frontend/semantics/desugaring.md +++ b/docs/design/frontend/semantics/desugaring.md @@ -105,8 +105,12 @@ remain as resolved `Typed` expressions for P5. Every rewrite evaluates source operands in the order defined by the language. A failed guard proceeds to the next guard without evaluating that guard's body. A generated temporary binds an expression once when duplication would change -evaluation. P4 preserves the source span of every retained user expression; -generated scaffolding points to the construct that introduced it. +evaluation. A fallthrough helper is defined in the same `let` as the case, so +it refers to outer locals directly. Passing one of those locals in as a value +argument would instantiate a polymorphic scheme once, before the guard body +applies the arguments that determine its constraints. P4 preserves the source +span of every retained user expression; generated scaffolding points to the +construct that introduced it. Rejected alternatives: desugaring operators in P2 cannot respect imported fixities; waiting until MIR would discard useful source types and spans; and From 9ffa17807d8a57f90495aa982497b0ea1c14f902 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 12:54:44 +0800 Subject: [PATCH 028/148] Lock an integer seed for a where-bound unfold stepper. enumFromThenTo feeds Int to a locally generalized stepper and maps the result with toEnum. The same shape, including guards, operators, and composition, has to keep that seed as Int. --- .../psrs-driver/src/tests/let_constraints.rs | 76 +++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/crates/psrs-driver/src/tests/let_constraints.rs b/crates/psrs-driver/src/tests/let_constraints.rs index 46c26c70..8a86424f 100644 --- a/crates/psrs-driver/src/tests/let_constraints.rs +++ b/crates/psrs-driver/src/tests/let_constraints.rs @@ -118,6 +118,82 @@ main = 0 assert_checks(source); } +#[test] +fn a_where_stepper_accepts_an_integer_seed() { + let source = r#" +module Main where + +class Semiring a where + add :: a -> a -> a + sub :: a -> a -> a + +instance semiringInt :: Semiring Int where + add x _ = x + sub x _ = x + +infixl 6 add as + +infixl 6 sub as - + +class Ord a where + le :: a -> a -> Boolean + +instance ordInt :: Ord Int where + le _ _ = true + +infix 4 le as <= + +class BoundedEnum a where + toEnum :: Int -> Maybe a + fromEnum :: a -> Int + +data Maybe a = Nothing | Just a +data Tuple a b = Tuple a b + +fromJust :: forall a. Maybe a -> a +fromJust (Just value) = value + +class Functor f where + map :: forall a b. (a -> b) -> f a -> f b + +infixl 4 map as <$> + +class Unfoldable t where + unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> t a + +class Semigroupoid a where + compose :: forall b c d. a c d -> a b c -> a b d + +instance semigroupoidFn :: Semigroupoid (->) where + compose f g value = f (g value) + +composeFlipped f g = compose g f + +infixr 9 composeFlipped as >>> + +unsafePartial :: forall a. a -> a +unsafePartial value = value + +otherwise = true + +enumFromThenTo :: forall f a. Unfoldable f => Functor f => BoundedEnum a => a -> a -> a -> f a +enumFromThenTo = unsafePartial \a b c -> + let + a' = fromEnum a + b' = fromEnum b + c' = fromEnum c + in + (toEnum >>> fromJust) <$> unfoldr (go (b' - a') c') a' + where + go step to index + | index <= to = Just (Tuple index (index + step)) + | otherwise = Nothing + +main :: Int +main = 0 +"#; + assert_checks(source); +} + #[test] fn a_concrete_missing_instance_inside_a_let_is_still_rejected() { let source = r#" From 0ace6620cd3d71a88721f6cc1524f3018ffa2f53 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 13:16:14 +0800 Subject: [PATCH 029/148] Match lexical dictionaries without choosing wanted types --- .../psrs-driver/src/tests/let_constraints.rs | 58 +++++++++++++++++-- .../src/typecheck/classes/fundeps/mod.rs | 7 ++- .../src/typecheck/classes/solve/search.rs | 43 ++++---------- .../src/typecheck/classes/superclass.rs | 20 +++++++ .../frontend/type-system/type-inference.md | 11 ++++ 5 files changed, 102 insertions(+), 37 deletions(-) diff --git a/crates/psrs-driver/src/tests/let_constraints.rs b/crates/psrs-driver/src/tests/let_constraints.rs index 8a86424f..0bdf0bc4 100644 --- a/crates/psrs-driver/src/tests/let_constraints.rs +++ b/crates/psrs-driver/src/tests/let_constraints.rs @@ -142,14 +142,16 @@ instance ordInt :: Ord Int where infix 4 le as <= -class BoundedEnum a where +class Ord a <= BoundedEnum a where toEnum :: Int -> Maybe a fromEnum :: a -> Int data Maybe a = Nothing | Just a data Tuple a b = Tuple a b -fromJust :: forall a. Maybe a -> a +class Partial + +fromJust :: forall a. Partial => Maybe a -> a fromJust (Just value) = value class Functor f where @@ -166,12 +168,16 @@ class Semigroupoid a where instance semigroupoidFn :: Semigroupoid (->) where compose f g value = f (g value) +composeFlipped :: forall a b c d. Semigroupoid a => a b c -> a c d -> a b d composeFlipped f g = compose g f infixr 9 composeFlipped as >>> -unsafePartial :: forall a. a -> a -unsafePartial value = value +unsafePartial :: forall a. (Partial => a) -> a +unsafePartial = discharge + +discharge :: forall a b. a -> b +discharge value = discharge value otherwise = true @@ -218,3 +224,47 @@ main = bad 1 "expected a missing Need Int instance, got {errors:?}" ); } + +#[test] +fn a_local_constraint_does_not_choose_an_unrelated_lexical_given() { + assert_checks( + r#" +module Main where + +class Measure a where + measure :: a -> Int + +instance measureInt :: Measure Int where + measure value = value + +outer :: forall a. Measure a => a -> Int +outer value = measured 1 + where + measured input = measure input + +main :: Int +main = outer 0 +"#, + ); +} + +#[test] +fn a_superclass_functional_dependency_improves_a_local_result() { + assert_checks( + r#" +module Main where + +class Convert a b | a -> b where + convert :: a -> b + +class Convert a b <= Middle a b +class Middle a b <= Child a b + +outer :: forall a b. Child a b => a -> Int +outer value = let converted = convert value in 0 + +main :: Int +main = 0 +"#, + ); +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs index 1ee1960f..98aefc06 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs @@ -51,13 +51,18 @@ impl Checker { if class.fundeps.is_empty() { return false; } + let givens = constraint + .givens + .iter() + .flat_map(|(given, _)| self.superclass_closure(given)) + .collect::>(); let mut changed = false; for fundep in &class.fundeps { if !self.determiners_are_known(&constraint.arguments, &fundep.determining) { continue; } let mut sources: Vec> = Vec::new(); - for (given, _) in constraint.givens.clone() { + for given in &givens { if given.class_id == constraint.class_id && fundep.determining.iter().all(|&index| { self.infer_types_equal( diff --git a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs index f63c2409..0a0d2955 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs @@ -138,11 +138,7 @@ impl Checker { ) -> Option { for (given, solution) in self.scope.givens.clone() { if given.class_id == constraint.class_id - && self.constraint_arguments_match_or_unify( - &given.arguments, - &constraint.arguments, - constraint.span, - ) + && self.constraint_arguments_match(&given.arguments, &constraint.arguments) { return Some(solution); } @@ -193,11 +189,7 @@ impl Checker { field, }; if edge.class_id == wanted.class_id - && self.constraint_arguments_match_or_unify( - &edge.arguments, - &wanted.arguments, - wanted.span, - ) + && self.constraint_arguments_match(&edge.arguments, &wanted.arguments) { return Some(solution); } @@ -214,28 +206,15 @@ impl Checker { None } - /// Matches a wanted constraint against a given or projected superclass. - /// Wanted type variables can be refined to the known argument types, but a - /// failed candidate must leave no substitution, level, kind, or evidence - /// behind. Its diagnostic is discarded, because a candidate that does not - /// match is not itself an error. - fn constraint_arguments_match_or_unify( - &mut self, - expected: &[InferType], - actual: &[InferType], - span: TextRange, - ) -> bool { - if expected.len() != actual.len() { - return false; - } - self.speculate(|checker| { - let errors_before = checker.state.errors.len(); - for (expected, actual) in expected.iter().zip(actual) { - checker.unify(actual.clone(), expected.clone(), span); - } - (checker.state.errors.len() == errors_before).then_some(()) - }) - .is_some() + /// A given proves only its existing argument types. Entailment must not + /// choose an unknown wanted argument by unifying it with a dictionary in + /// scope; functional-dependency improvement owns permitted refinement. + fn constraint_arguments_match(&self, expected: &[InferType], actual: &[InferType]) -> bool { + expected.len() == actual.len() + && expected + .iter() + .zip(actual) + .all(|(expected, actual)| self.infer_types_equal(expected, actual)) } /// Solves one instance's context and, on success, returns the instance diff --git a/crates/psrs-typecheck/src/typecheck/classes/superclass.rs b/crates/psrs-typecheck/src/typecheck/classes/superclass.rs index f2553aca..a4f2f6db 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/superclass.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/superclass.rs @@ -161,6 +161,26 @@ pub(in crate::typecheck) fn instantiate_template( } impl Checker { + /// The constraint and all instantiated superclass constraints reachable + /// from it. The checked class environment rejects superclass cycles, and + /// each path retains its argument types even when paths share a class. + pub(in crate::typecheck) fn superclass_closure( + &self, + constraint: &ClassConstraint, + ) -> Vec { + let mut pending = vec![constraint.clone()]; + let mut closure = Vec::new(); + while let Some(constraint) = pending.pop() { + pending.extend( + self.superclass_constraints(constraint.class_id, &constraint.arguments) + .into_iter() + .map(|(_, superclass)| superclass), + ); + closure.push(constraint); + } + closure + } + /// The superclass constraints a dictionary for `class_id arguments` stores, /// each with the dictionary field that holds it, in edge order. Each edge is /// instantiated over the subclass's arguments through the shared diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index 6440a7d2..ee127ca4 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -39,6 +39,17 @@ Inference state has three owners with distinct lifetimes. The `SemanticEnv` is i Infer synthesizable expressions and check expressions with expected types. Instantiate `forall` and solve constrained uses through class entailment. When checking a signature or higher-rank argument, skolemize expected quantifiers, perform structural subsumption, and check that skolems do not escape. Function parameter comparison is contravariant and result comparison covariant; record subsumption compares common labels and checks closed-row extras and omissions. Evidence can be inserted at elaboration sites, while comparison under a type constructor cannot invent term-level dictionaries. +Lexical givens and their superclass projections discharge a wanted only when +all resolved argument types already agree. Dictionary lookup does not unify an +unconstrained wanted variable with a given's skolem: that would prematurely +choose the type of a local binding before its uses instantiate it. Functional +dependency improvement remains the owner of permitted argument refinement, +including dependencies exposed by the instantiated superclass closure of each +lexical given. +For example, under `BoundedEnum a` with an `Ord a` superclass, a local integer +stepper's `Ord ?state` must stay residual until generalized or fixed by its +integer seed; the superclass dictionary proves `Ord a`, not `Ord ?state`. + Infer a recursive SCC with shared placeholders, respecting explicit signatures, then solve and generalize only variables permitted by the environment and remaining constraints. Use kind-correct constructor and pattern types; type-check case alternatives, literals, arrays, record operations, newtypes, and foreign imports. Visible type application `e @T` substitutes `T` for the operand's outermost quantifier after a kind check and is erased, and `e @_` consumes that quantifier without choosing a type. Typed holes follow the official source rules. A quantified kind argument is instantiated implicitly, because no source form applies one to a type constructor. Build THIR only after zonking, ambiguity checks, and evidence elaboration. A declaration's scheme carries the constraints that were inferred for it, whether or not the source declared them. Generalization is therefore one sequence and not two: From b67448317e470cbe07b28d8b21f2ec0386207952 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 13:16:17 +0800 Subject: [PATCH 030/148] Provide equality ordering and display for library tuples --- crates/psrs-driver/src/tests/data_tuple.rs | 56 +++++++++++++++++++ .../backend/wasm/primitive-ffi-and-stdlib.md | 5 ++ stdlib/lib/Data/Tuple.purs | 9 +++ 3 files changed, 70 insertions(+) diff --git a/crates/psrs-driver/src/tests/data_tuple.rs b/crates/psrs-driver/src/tests/data_tuple.rs index 33c65f75..3534a3ed 100644 --- a/crates/psrs-driver/src/tests/data_tuple.rs +++ b/crates/psrs-driver/src/tests/data_tuple.rs @@ -50,3 +50,59 @@ main = 0 }; assert_eq!(output.status.code(), Some(0), "{output:?}"); } + +#[test] +fn library_tuple_equality_ordering_and_show_typecheck() { + let main = r#" +module Main where + +import Data.Eq (eq) +import Data.Ord (compare, Ordering) +import Data.Show (show) +import Data.Tuple (Tuple(..)) + +equalPair :: Boolean +equalPair = eq (Tuple 1 "雪") (Tuple 1 "雪") + +orderedPair :: Ordering +orderedPair = compare (Tuple 1 "z") (Tuple 2 "a") + +shownPair :: String +shownPair = show (Tuple 1 "雪") + +main :: Int +main = 0 +"#; + crate::check_program_types_lenient_with_prelude(&[("Main.purs", main)]) + .unwrap_or_else(|errors| panic!("tuple instances should type check: {errors:?}")); +} + +#[test] +fn library_tuple_instances_compare_fields_and_render_utf8() { + let main = r#" +module Main where + +import Data.Eq (eq) +import Data.Ord (compare, Ordering(..)) +import Data.Show (show) +import Data.Tuple (Tuple(..)) + +main :: Int +main = + if eq (Tuple 1 "雪") (Tuple 1 "雪") then + if eq (Tuple 1 "雪") (Tuple 1 "a") then 1 + else case compare (Tuple 1 99) (Tuple 2 0) of + LT -> case compare (Tuple 1 3) (Tuple 1 2) of + GT -> case compare (Tuple 1 2) (Tuple 1 2) of + EQ -> if eq (show (Tuple 1 "雪")) "(Tuple 1 \"雪\")" then 0 else 4 + _ -> 3 + _ -> 2 + _ -> 1 + else 1 +"#; + let Some(output) = run_with_wasmtime(main) else { + eprintln!("skipping execution: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); +} diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index 4ebb5ec2..5c9e7528 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -576,6 +576,11 @@ not in `Prelude` and not compiler builtins. Nullary enum, closed record, and flags-record foreign imports still lower; new library code should not use that path. Handles are declared as the `Resource a` newtype over `Int`. +`Data.Tuple.Tuple` is an ordinary two-field ADT. Its `Eq` instance compares +both fields, its `Ord` instance compares them lexicographically, and its `Show` +instance renders `(Tuple )` using each field's `Show` instance. +These source instances do not change native tuple syntax or WIT tuple layout. + ## References - [DEC-11 — Primitive foreign imports and standard-library wrappers](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md). diff --git a/stdlib/lib/Data/Tuple.purs b/stdlib/lib/Data/Tuple.purs index 702f72c5..dbf0f89a 100644 --- a/stdlib/lib/Data/Tuple.purs +++ b/stdlib/lib/Data/Tuple.purs @@ -11,12 +11,21 @@ module Data.Tuple , swap ) where +import Data.Eq (class Eq) import Data.Functor (class Functor) +import Data.Ord (class Ord) +import Data.Show (class Show, show) +import Data.Semigroup ((<>)) data Tuple a b = Tuple a b +derive instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b) +derive instance ordTuple :: (Ord a, Ord b) => Ord (Tuple a b) derive instance functorTuple :: Functor (Tuple a) +instance showTuple :: (Show a, Show b) => Show (Tuple a b) where + show (Tuple first second) = "(Tuple " <> show first <> " " <> show second <> ")" + -- | The first component. `fst (Tuple x y)` is `x`. fst :: forall a b. Tuple a b -> a fst (Tuple first _) = first From e157505ba304462e768308f3bd8a67fbea7e4ab2 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 13:42:21 +0800 Subject: [PATCH 031/148] Preserve quantified source types at coercion boundaries --- crates/psrs-driver/src/tests/coercion.rs | 18 ++++++++++++++++++ .../src/typecheck/infer/expected.rs | 13 ++++++++++++- .../frontend/type-system/type-inference.md | 7 +++++++ 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/crates/psrs-driver/src/tests/coercion.rs b/crates/psrs-driver/src/tests/coercion.rs index 9ad0f1fd..a7a4ec11 100644 --- a/crates/psrs-driver/src/tests/coercion.rs +++ b/crates/psrs-driver/src/tests/coercion.rs @@ -429,3 +429,21 @@ fn accepts_a_type_wildcard_in_an_instance_context() { panic!("a wildcard in a constraint should be accepted: {errors:?}") }); } + +#[test] +fn unsafe_coercion_keeps_a_polymorphic_input_boundary() { + let source = r#" +module Main where +import Unsafe.Coerce (unsafeCoerce) + +foreign import data Exists :: (Type -> Type) -> Type + +runExists :: forall f r. (forall a. f a -> r) -> Exists f -> r +runExists = unsafeCoerce + +main :: Int +main = 0 +"#; + crate::check_program(&[("Main.purs", source)]) + .unwrap_or_else(|errors| panic!("rank-N cast boundary should check: {errors:?}")); +} diff --git a/crates/psrs-typecheck/src/typecheck/infer/expected.rs b/crates/psrs-typecheck/src/typecheck/infer/expected.rs index bb21a091..aa9fc2ef 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/expected.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/expected.rs @@ -243,7 +243,18 @@ impl Checker { // plain function type. let scheme = Scheme::monomorphic(inferred.ty.clone()); let mut inferred = self.instantiate_expression_use(inferred, &scheme, expression.span); - self.subsume(inferred.ty.clone(), expected.clone(), expression.span); + if matches!( + inferred.kind, + InferredExprKind::CoerceFunction { .. } | InferredExprKind::UnsafeCoerceFunction { .. } + ) { + // A cast's source and target are exact boundary types, rather than + // a function implementation adapted by contravariant subsumption. + // In particular, keep a contextual rank-N input quantified in the + // source metadata that finalization emits as the cast's binder. + self.unify(expected.clone(), inferred.ty.clone(), expression.span); + } else { + self.subsume(inferred.ty.clone(), expected.clone(), expression.span); + } inferred.ty = expected; Some(inferred) } diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index ee127ca4..7e2c239d 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -39,6 +39,13 @@ Inference state has three owners with distinct lifetimes. The `SemanticEnv` is i Infer synthesizable expressions and check expressions with expected types. Instantiate `forall` and solve constrained uses through class entailment. When checking a signature or higher-rank argument, skolemize expected quantifiers, perform structural subsumption, and check that skolems do not escape. Function parameter comparison is contravariant and result comparison covariant; record subsumption compares common labels and checks closed-row extras and omissions. Evidence can be inserted at elaboration sites, while comparison under a type constructor cannot invent term-level dictionaries. +Coercion primitives checked against an expected arrow take its parameter and +result as their exact source and target boundary types. Function variance must +not instantiate a quantified input and leave the cast's stored source at an +unresolved monotype. Checked casts retain a `Coercible` obligation over those +same boundary types; unchecked casts retain their declared unchecked origin. +This contextual boundary check does not change ordinary function subsumption. + Lexical givens and their superclass projections discharge a wanted only when all resolved argument types already agree. Dictionary lookup does not unify an unconstrained wanted variable with a given's skolem: that would prematurely From 1485e7ec25a9d038e9bc4fca49c51a182da26523 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 13:42:41 +0800 Subject: [PATCH 032/148] Scope quantified variables throughout checked binding implementations --- .../psrs-driver/src/tests/let_constraints.rs | 147 ++++++++++ .../src/typecheck/classes/fundeps/mod.rs | 4 + .../src/typecheck/classes/instance.rs | 1 + .../src/typecheck/generalize.rs | 4 +- .../src/typecheck/generalize/body.rs | 253 ++++++++++++++++++ crates/psrs-typecheck/src/typecheck/group.rs | 1 + .../src/typecheck/infer/let_expr.rs | 1 + .../type-system/classes-and-evidence.md | 4 +- .../frontend/type-system/type-inference.md | 20 ++ 9 files changed, 432 insertions(+), 3 deletions(-) create mode 100644 crates/psrs-typecheck/src/typecheck/generalize/body.rs diff --git a/crates/psrs-driver/src/tests/let_constraints.rs b/crates/psrs-driver/src/tests/let_constraints.rs index 0bdf0bc4..6613a4f0 100644 --- a/crates/psrs-driver/src/tests/let_constraints.rs +++ b/crates/psrs-driver/src/tests/let_constraints.rs @@ -268,3 +268,150 @@ main = 0 "#, ); } + +#[test] +fn a_solved_local_dictionary_uses_the_local_schemes_quantified_variables() { + assert_checks( + r#" +module Main where + +class Delay l where + delay :: (Int -> l) -> l + +data List a = Nil | Cons a (List a) + +instance delayList :: Delay (List a) where + delay thunk = thunk 0 + +class Build f where + build :: forall a. a -> f a + +instance buildList :: Build List where + build = go + where + go value = delay (\_ -> Cons value Nil) + +main :: Int +main = 0 +"#, + ); +} + +#[test] +fn an_unquantified_variable_of_a_solved_local_constraint_stays_ambiguous() { + let source = r#" +module Main where + +class Delay l where + delay :: (Int -> l) -> l + +data List a = Nil +instance delayList :: Delay (List a) where + delay thunk = thunk 0 + +class Choose a where + choose :: List a -> Int + +instance chooseInt :: Choose Int where + choose _ = 0 + +class Build f where + build :: forall a. a -> f a + +instance buildList :: Build List where + build _ = let discarded = choose (delay (\_ -> Nil)) in Nil + +main :: Int +main = 0 +"#; + let errors = crate::check_program(&[("Main.purs", source)]) + .expect_err("the local result does not quantify the delayed element type"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("AmbiguousTypeVariables")), + "expected the unquantified constraint to stay ambiguous: {errors:?}" + ); +} + +#[test] +fn a_signed_body_owns_its_unobservable_instantiation_variables() { + assert_checks( + r#" +module Main where + +data Proxy a = Proxy + +discard :: forall a. Proxy a -> Int +discard _ = 0 + +main :: Int +main = discard Proxy +"#, + ); +} + +#[test] +fn a_local_body_owns_its_unobservable_instantiation_variables() { + assert_checks( + r#" +module Main where + +data Proxy a = Proxy + +discard :: forall a. Proxy a -> Int +discard _ = 0 + +main = let discarded = discard Proxy in 0 +"#, + ); +} + +#[test] +fn an_instance_body_owns_its_unobservable_instantiation_variables() { + assert_checks( + r#" +module Main where + +data Proxy a = Proxy + +discard :: forall a. Proxy a -> Int +discard _ = 0 + +class Measure f where + measure :: forall a. f a -> Int + +instance measureProxy :: Measure Proxy where + measure _ = discard Proxy + +main :: Int +main = 0 +"#, + ); +} + +#[test] +fn body_only_quantifiers_preserve_execution() { + let source = r#" +module Main where + +data Proxy a = Proxy + +discard :: forall a. Proxy a -> Int +discard _ = 21 + +class Measure f where + measure :: forall a. f a -> Int + +instance measureProxy :: Measure Proxy where + measure _ = discard Proxy + +main :: Int +main = let part = discard Proxy in intAdd part (measure Proxy) +"#; + let Some(output) = super::run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs index 98aefc06..b5cbfef9 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs @@ -287,6 +287,10 @@ impl Checker { // not become an unconstrained variable of the declaration // currently discharging the worklist. .filter(|variable| !self.state.rigid.contains(variable)) + // A solved local obligation may still refer to its binding's + // quantified variables. They are parameters of that checked + // local scheme, not unknowns of the enclosing dictionary. + .filter(|variable| !self.state.generic_variables.contains(variable)) .copied() .collect::>(); if ambiguous.is_empty() { diff --git a/crates/psrs-typecheck/src/typecheck/classes/instance.rs b/crates/psrs-typecheck/src/typecheck/classes/instance.rs index bab361ea..c399adc5 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/instance.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/instance.rs @@ -219,6 +219,7 @@ impl Checker { } let head_variables = head_variables.into_iter().collect::>(); let scheme = self.generalize_instance_dictionary(&head_variables, &value.ty); + let scheme = self.generalize_body(scheme, &value, TOP_LEVEL); Some(InferredDeclaration { symbol: instance.symbol, name: instance.name.clone(), diff --git a/crates/psrs-typecheck/src/typecheck/generalize.rs b/crates/psrs-typecheck/src/typecheck/generalize.rs index d96633d2..359798b4 100644 --- a/crates/psrs-typecheck/src/typecheck/generalize.rs +++ b/crates/psrs-typecheck/src/typecheck/generalize.rs @@ -9,6 +9,8 @@ use super::*; +mod body; + impl Checker { /// Generalizes a declaration into a scheme. /// @@ -17,7 +19,7 @@ impl Checker { /// them, because they are the polymorphism the source declared rather than a /// side effect of the level a binder was allocated at. A binder that no /// surviving part of the type or the constraints mentions is not quantified: - /// a quantifier no occurrence refers to has no meaning. + /// body-only occurrences are handled by `generalize_body` after solving. /// /// `outer_level` is the level the declaration's scope sits at. A variable /// at that level or below belongs to the enclosing scope and is left alone, diff --git a/crates/psrs-typecheck/src/typecheck/generalize/body.rs b/crates/psrs-typecheck/src/typecheck/generalize/body.rs new file mode 100644 index 00000000..803db947 --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/generalize/body.rs @@ -0,0 +1,253 @@ +//! Quantifiers needed by checked implementation types, including phantom +//! instantiations that do not occur in a declaration's public result type. + +use super::*; + +#[derive(Default)] +struct BodyVariables { + candidates: Vec, + bound: HashSet, +} + +impl Checker { + /// Extends a finished binding scheme with flexible variables occurring only + /// in its implementation. Call after constraint solving and ambiguity checks; + /// this supplies lexical binders, never evidence for an unsolved constraint. + pub(in crate::typecheck) fn generalize_body( + &mut self, + scheme: Scheme, + value: &InferredExpr, + outer_level: u32, + ) -> Scheme { + let mut body_variables = BodyVariables::default(); + self.collect_body_variables(value, outer_level, &mut body_variables); + body_variables.candidates.retain(|variable| { + !body_variables.bound.contains(variable) + && !self.state.rigid.contains(variable) + && !self.state.generic_variables.contains(variable) + }); + let mut variables = scheme.variables; + variables.extend(body_variables.candidates); + self.scheme(variables, scheme.constraints, scheme.ty) + } + + fn collect_implementation_type(&self, ty: &InferType, level: u32, out: &mut BodyVariables) { + let ty = self.resolve_type(ty.clone()); + self.collect_generalizable(&ty, level, &mut out.candidates); + collect_structural_binders(&ty, &mut out.bound); + } + + fn collect_body_variables(&self, value: &InferredExpr, level: u32, out: &mut BodyVariables) { + let mut collect_type = |ty: &InferType| { + self.collect_implementation_type(ty, level, out); + }; + collect_type(&value.ty); + match &value.kind { + InferredExprKind::CoerceFunction { + wanted, + source, + target, + } => { + collect_type(source); + collect_type(target); + self.collect_wanted_variables(*wanted, level, out, &mut HashSet::new()); + } + InferredExprKind::UnsafeCoerceFunction { source, target, .. } => { + collect_type(source); + collect_type(target); + } + InferredExprKind::Lambda { binder, body } => { + collect_type(&binder.scheme.ty); + self.collect_body_variables(body, level, out); + } + InferredExprKind::Array(elements) => { + for element in elements { + self.collect_body_variables(element, level, out); + } + } + InferredExprKind::Record(fields) => { + for (_, field) in fields { + self.collect_body_variables(field, level, out); + } + } + InferredExprKind::RecordUpdate { expression, fields } => { + self.collect_body_variables(expression, level, out); + for (_, field) in fields { + self.collect_body_variables(field, level, out); + } + } + InferredExprKind::DictionaryApplication { function, wanted } => { + self.collect_body_variables(function, level, out); + self.collect_wanted_variables(*wanted, level, out, &mut HashSet::new()); + } + InferredExprKind::FieldAccess { expression, .. } => { + self.collect_body_variables(expression, level, out); + } + InferredExprKind::Application(function, argument) => { + self.collect_body_variables(function, level, out); + self.collect_body_variables(argument, level, out); + } + InferredExprKind::Let { bindings, body } => { + for binding in bindings { + self.collect_implementation_type(&binding.binder.scheme.ty, level, out); + self.collect_body_variables(&binding.value, level, out); + } + self.collect_body_variables(body, level, out); + } + InferredExprKind::If { + condition, + then_branch, + else_branch, + } => { + for child in [condition, then_branch, else_branch] { + self.collect_body_variables(child, level, out); + } + } + InferredExprKind::Case { + scrutinee, + branches, + } => { + self.collect_body_variables(scrutinee, level, out); + for branch in branches { + self.collect_pattern_variables(&branch.pattern, level, out); + self.collect_body_variables(&branch.value, level, out); + } + } + InferredExprKind::Local(_) + | InferredExprKind::Global(_) + | InferredExprKind::Integer(_) + | InferredExprKind::Number(_) + | InferredExprKind::Boolean(_) + | InferredExprKind::String(_) + | InferredExprKind::Char(_) => {} + InferredExprKind::Method { wanted, .. } | InferredExprKind::Evidence(wanted) => { + self.collect_wanted_variables(*wanted, level, out, &mut HashSet::new()); + } + } + } + + fn collect_wanted_variables( + &self, + index: usize, + level: u32, + out: &mut BodyVariables, + visited: &mut HashSet, + ) { + if let Some(wanted) = self.state.wanted.get(index) { + self.collect_evidence_variables(wanted, level, out, visited); + } + } + + fn collect_evidence_variables( + &self, + wanted: &WantedConstraint, + level: u32, + out: &mut BodyVariables, + visited: &mut HashSet, + ) { + let Some(solution) = &wanted.solution else { + return; + }; + if !visited.insert(wanted.id) { + return; + } + for ty in std::iter::once(&wanted.dictionary_type).chain(&wanted.arguments) { + self.collect_implementation_type(ty, level, out); + } + match solution { + WantedSolution::Instance { + constructor_type, + context, + .. + } => { + self.collect_implementation_type(constructor_type, level, out); + for id in context { + if let Some(child) = self.state.wanted.iter().find(|wanted| wanted.id == *id) { + self.collect_evidence_variables(child, level, out, visited); + } + } + } + WantedSolution::Superclass { parent, .. } => { + self.collect_evidence_variables(parent, level, out, visited); + } + WantedSolution::Coercible { source, target } => { + for ty in [source, target] { + self.collect_implementation_type(ty, level, out); + } + } + WantedSolution::Primitive { arguments } => { + for ty in arguments { + self.collect_implementation_type(ty, level, out); + } + } + WantedSolution::Given(_) + | WantedSolution::Abstracted(_) + | WantedSolution::Global(_) => {} + } + } + + fn collect_pattern_variables( + &self, + pattern: &InferredPattern, + level: u32, + out: &mut BodyVariables, + ) { + self.collect_implementation_type(&pattern.ty, level, out); + match &pattern.kind { + InferredPatternKind::Array { elements } + | InferredPatternKind::Constructor { + arguments: elements, + .. + } => { + for element in elements { + self.collect_pattern_variables(element, level, out); + } + } + InferredPatternKind::Named { pattern, .. } => { + self.collect_pattern_variables(pattern, level, out); + } + InferredPatternKind::Record { fields } => { + for (_, field) in fields { + self.collect_pattern_variables(field, level, out); + } + } + InferredPatternKind::Var { ty, .. } => { + self.collect_implementation_type(ty, level, out); + } + InferredPatternKind::Wildcard | InferredPatternKind::Literal { .. } => {} + } + } +} + +// Binder identity belongs to the checked type, even after the scope that +// skolemized it has ended. Never recapture such a binder from a child node. +fn collect_structural_binders(ty: &InferType, out: &mut HashSet) { + match ty { + InferType::ForAll { variables, body } => { + out.extend(variables); + collect_structural_binders(body, out); + } + InferType::Application(function, argument) => { + collect_structural_binders(function, out); + collect_structural_binders(argument, out); + } + InferType::Constrained { constraints, body } => { + for argument in constraints + .iter() + .flat_map(|constraint| &constraint.arguments) + { + collect_structural_binders(argument, out); + } + collect_structural_binders(body, out); + } + InferType::RowExtend { ty, tail, .. } => { + collect_structural_binders(ty, out); + collect_structural_binders(tail, out); + } + InferType::Variable(_) + | InferType::Constructor(_) + | InferType::RowEmpty + | InferType::TypeLevelInt(_) + | InferType::TypeLevelString(_) => {} + } +} diff --git a/crates/psrs-typecheck/src/typecheck/group.rs b/crates/psrs-typecheck/src/typecheck/group.rs index 47a4b1a2..bf64ac5b 100644 --- a/crates/psrs-typecheck/src/typecheck/group.rs +++ b/crates/psrs-typecheck/src/typecheck/group.rs @@ -282,6 +282,7 @@ impl Checker { }; let scheme = self.generalize(&member.quantified, &monomorphic, &retained, TOP_LEVEL); let value = self.wrap_dictionary_lambdas(value, &member.parameters); + let scheme = self.generalize_body(scheme, &value, TOP_LEVEL); self.state .pending_signatures .insert(member.symbol, member.parameters.clone()); diff --git a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs index cad03186..faba879b 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs @@ -171,6 +171,7 @@ impl Checker { ), ¶meters, ); + scheme = self.generalize_body(scheme, &binding.value, outer_level); self.scope .locals .insert(binding.binder.binder.id, scheme.clone()); diff --git a/docs/design/frontend/type-system/classes-and-evidence.md b/docs/design/frontend/type-system/classes-and-evidence.md index e89fc3ac..7cf1d4a3 100644 --- a/docs/design/frontend/type-system/classes-and-evidence.md +++ b/docs/design/frontend/type-system/classes-and-evidence.md @@ -112,7 +112,7 @@ literal is rejected before solving. `SymbolCons` splits or builds one scalar head and a scalar tail. These solver rules do not change value-level string storage. -Check class parameter kinds, dependency indices, superclass cycles, method signatures, instance heads and contexts, and coherence conditions before solving uses. Build a searchable instance environment respecting module visibility and the official orphan and instance-chain rules. Compiler-owned primitive evidence has an evidence-defined place in the search order: proof and relation rules run before direct given lookup; report rules run after it so a warning or unsolved report constraint can propagate through the enclosing declaration. For ordinary class constraints, search givens first, then superclass paths and candidate instances. Matching a given unifies flexible wanted arguments with the given's arguments transactionally; it never assigns a rigid given variable, and a failed candidate leaves no substitutions behind. Apply functional dependencies to improve unknowns using only the selected branch in each chain; repeat until stable. Compare every class argument in an instance head. Functional dependencies contribute the transitive closure of already matched positions, while arguments outside that closure can still prove a candidate apart. Within each visible chain, continue only when a branch is provably apart. A matching branch commits before its context is solved. An unknown non-final branch blocks later alternatives in that chain; unknown singleton and final branches are ignored. Unknown branches do not create an overlap with one definite match from an unrelated chain. Failure to solve a selected context does not fall through. Unrelated ordinary candidates must remain coherent; overlapping or unresolved obligations receive source-oriented diagnostics. Memoize and bound search to prevent cycles. +Check class parameter kinds, dependency indices, superclass cycles, method signatures, instance heads and contexts, and coherence conditions before solving uses. Build a searchable instance environment respecting module visibility and the official orphan and instance-chain rules. Compiler-owned primitive evidence has an evidence-defined place in the search order: proof and relation rules run before direct given lookup; report rules run after it so a warning or unsolved report constraint can propagate through the enclosing declaration. For ordinary class constraints, search givens first, then superclass paths and candidate instances. Matching a given compares all resolved wanted arguments with the given's arguments without choosing values for unknowns. Instantiated superclass arguments follow the same equality rule. Functional dependencies may improve unknowns separately, using the declared dependency relation. Apply functional dependencies to improve unknowns using only the selected branch in each chain; repeat until stable. Compare every class argument in an instance head. Functional dependencies contribute the transitive closure of already matched positions, while arguments outside that closure can still prove a candidate apart. Within each visible chain, continue only when a branch is provably apart. A matching branch commits before its context is solved. An unknown non-final branch blocks later alternatives in that chain; unknown singleton and final branches are ignored. Unknown branches do not create an overlap with one definite match from an unrelated chain. Failure to solve a selected context does not fall through. Unrelated ordinary candidates must remain coherent; overlapping or unresolved obligations receive source-oriented diagnostics. Memoize and bound search to prevent cycles. The common instance recorder rejects a class-argument count mismatch with `ClassInstanceArityMismatch` before deriving or member inference. Derived @@ -123,7 +123,7 @@ Core lowering consumes that verified result rather than comparing arena IDs. Elaboration turns a constrained binding into explicit evidence parameters and inserts evidence at overloaded uses. A method selection projects from its dictionary; a superclass selection follows a dictionary field. The frontend proves and records the selected path. Backend optimization may specialize dictionaries but cannot change which instance was selected. Which constraints become parameters is decided by generalization, not here: a declaration's scheme carries the constraints inference retained, and elaboration realizes exactly those as dictionary parameters, so a signature and an inferred scheme produce the same evidence shape. -A superclass edge is instantiated, never re-derived. Dictionary construction and superclass search substitute the subclass's arguments into the edge's template and unify the result against the wanted constraint, so an edge written over an arbitrary type such as `C (Array a)` needs no separate rule. The dictionary field that stores a superclass dictionary is chosen from the edge's position, so the evidence and the field agree by construction. +A superclass edge is instantiated, never re-derived. Dictionary construction and superclass search substitute the subclass's arguments into the edge's template; construction checks the field type, while lookup compares the instantiated arguments against the wanted constraint, so an edge written over an arbitrary type such as `C (Array a)` needs no separate rule. The dictionary field that stores a superclass dictionary is chosen from the edge's position, so the evidence and the field agree by construction. Rejected alternatives: a global ban on overlapping heads would reject valid instance-chain programs; choosing the first ordinary candidate is incoherent; postponing instance choice to runtime changes PureScript semantics; and representing a superclass edge as a permutation of parameter names would leave a constraint with two forms that only one of them can express. diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index 7e2c239d..a0bb110e 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -273,6 +273,26 @@ so the body's evidence and the parameter the scheme hands on are one dictionary. `group.rs` runs the sequence and `entry.rs` hands it the module. A wanted from an earlier declaration is not re-solved: that declaration has already generalized or reported it, so a second attempt could bind a variable it has since quantified. + +A finished binding also owns the flexible implementation variables that no +public result type mentions, such as the phantom argument in `discard Proxy`. +After solving and ambiguity checking, generalization traverses its checked +expression, patterns, cast boundaries, and solved evidence. It records the +remaining free variables as additional scheme binders with their checked +kinds. Variables already bound by a nested scheme or rigid quantifier are not +captured, and variables belonging to an outer level stay in that scope. This +applies to declarations, local bindings, and instance dictionaries. It supplies +explicit THIR scope for internal types without choosing a default type or +adding evidence for an unsolved obligation; unused binders in the public type +remain meaningful when the implementation mentions them. + +A solved obligation in a local binding may mention a variable that its local +scheme quantifies. An enclosing declaration's ambiguity check treats that +variable as already bound, even when the local's result does not escape into +the enclosing type. This does not determine an unknown that the local scheme +never quantified: such a variable remains subject to the enclosing ambiguity +check. Generalization's recorded binder identities distinguish the two cases. + A local `let` or `where` binding is a nested generalization, not an obligation of the enclosing signature. Before the binding is quantified, its new wanteds are solved under `Defer`: nothing is reported yet. A constraint whose flexible From 166f0f7f596eac380cdafe429875eba8607c55df Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 14:08:21 +0800 Subject: [PATCH 033/148] Preserve rank-N scrutinees across equation matching and guard fallthrough --- crates/psrs-ast/src/equations.rs | 2 +- crates/psrs-ast/src/expr/guards.rs | 2 +- crates/psrs-ast/src/expr/mod.rs | 4 + crates/psrs-desugar/src/alpha.rs | 8 +- crates/psrs-desugar/src/case_helpers.rs | 2 +- crates/psrs-desugar/src/expr.rs | 42 +++++++--- crates/psrs-desugar/src/fixity.rs | 2 +- crates/psrs-desugar/src/lib.rs | 6 ++ crates/psrs-driver/src/program/effects.rs | 2 +- .../tests/pattern_support/support.rs | 4 +- .../psrs-driver/tests/support/rank_n/mod.rs | 5 ++ .../psrs-driver/tests/support/rank_n/reify.rs | 77 +++++++++++++++++++ .../tests/support/rank_n/reject.rs | 1 + crates/psrs-hir/src/expr.rs | 4 + crates/psrs-hir/src/verify/mod.rs | 2 +- crates/psrs-hir/src/verify/normalized.rs | 2 +- .../src/check/infer/pattern_annotations.rs | 2 +- crates/psrs-resolve/src/resolver/names/mod.rs | 6 ++ .../src/typecheck/classes/locals.rs | 2 +- .../src/typecheck/infer/case.rs | 31 +++++++- .../src/typecheck/infer/let_expr.rs | 4 +- .../psrs-typecheck/src/typecheck/infer/mod.rs | 5 ++ .../src/typecheck/infer/records.rs | 49 +++++------- crates/psrs-typecheck/src/typecheck/order.rs | 2 +- docs/design/frontend/semantics/desugaring.md | 17 +++- .../frontend/type-system/type-inference.md | 8 ++ 26 files changed, 231 insertions(+), 60 deletions(-) create mode 100644 crates/psrs-driver/tests/support/rank_n/reify.rs diff --git a/crates/psrs-ast/src/equations.rs b/crates/psrs-ast/src/equations.rs index dab05324..894e4740 100644 --- a/crates/psrs-ast/src/equations.rs +++ b/crates/psrs-ast/src/equations.rs @@ -135,7 +135,7 @@ fn argument_record(arguments: &[Binder], span: TextRange) -> Expr { }) .collect::>(); Expr { - kind: ExprKind::Record(fields), + kind: ExprKind::MatchProduct(fields), span, } } diff --git a/crates/psrs-ast/src/expr/guards.rs b/crates/psrs-ast/src/expr/guards.rs index e4929e09..cd1eef2a 100644 --- a/crates/psrs-ast/src/expr/guards.rs +++ b/crates/psrs-ast/src/expr/guards.rs @@ -245,7 +245,7 @@ pub(crate) fn lower_case_scrutinees( lowered.pop().expect("one case scrutinee").1 } else { Expr { - kind: ExprKind::Record( + kind: ExprKind::MatchProduct( lowered .into_iter() .map(|(index, value)| (tuple_label(index), value)) diff --git a/crates/psrs-ast/src/expr/mod.rs b/crates/psrs-ast/src/expr/mod.rs index 86aaec16..09712085 100644 --- a/crates/psrs-ast/src/expr/mod.rs +++ b/crates/psrs-ast/src/expr/mod.rs @@ -41,6 +41,10 @@ pub enum ExprKind { Char(char), Array(Vec), Record(Vec<(String, Expr)>), + /// An ordered product of independent match scrutinees. Unlike a source + /// record literal, its fields retain polymorphism until pattern checking. + /// P5 checks the fields and converts the product to an ordinary typed record. + MatchProduct(Vec<(String, Expr)>), RecordUpdate { expression: Box, fields: Vec, diff --git a/crates/psrs-desugar/src/alpha.rs b/crates/psrs-desugar/src/alpha.rs index 45da7bbc..f14e6502 100644 --- a/crates/psrs-desugar/src/alpha.rs +++ b/crates/psrs-desugar/src/alpha.rs @@ -106,7 +106,7 @@ fn collect_expr_ids(expression: &Expr, ids: &mut HashSet) { collect_expr_ids(element, ids); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { collect_expr_ids(value, ids); } @@ -236,6 +236,12 @@ fn rename_expr(expression: Expr, mapping: &HashMap) -> Expr { .map(|(label, value)| (label, rename_expr(value, mapping))) .collect(), ), + ExprKind::MatchProduct(fields) => ExprKind::MatchProduct( + fields + .into_iter() + .map(|(label, value)| (label, rename_expr(value, mapping))) + .collect(), + ), ExprKind::RecordUpdate { expression, fields } => ExprKind::RecordUpdate { expression: Box::new(rename_expr(*expression, mapping)), fields: fields diff --git a/crates/psrs-desugar/src/case_helpers.rs b/crates/psrs-desugar/src/case_helpers.rs index 8ae30d1e..efb7c9d9 100644 --- a/crates/psrs-desugar/src/case_helpers.rs +++ b/crates/psrs-desugar/src/case_helpers.rs @@ -31,7 +31,7 @@ pub(super) fn wrap_lambdas(parameters: Vec, body: Expr, span: TextR pub(super) fn product_expression(value: Expr) -> Expr { let span = value.span; Expr { - kind: ExprKind::Record(vec![("_1".into(), value)]), + kind: ExprKind::MatchProduct(vec![("_1".into(), value)]), span, } } diff --git a/crates/psrs-desugar/src/expr.rs b/crates/psrs-desugar/src/expr.rs index 38d2f6b0..8e9d4c5d 100644 --- a/crates/psrs-desugar/src/expr.rs +++ b/crates/psrs-desugar/src/expr.rs @@ -72,6 +72,12 @@ impl Desugarer { .map(|(label, value)| (label, self.expr(value))) .collect(), ), + ExprKind::MatchProduct(fields) => ExprKind::MatchProduct( + fields + .into_iter() + .map(|(label, value)| (label, self.expr(value))) + .collect(), + ), ExprKind::RecordUpdate { expression, fields } => ExprKind::RecordUpdate { expression: Box::new(self.expr(*expression)), fields: fields @@ -165,29 +171,31 @@ impl Desugarer { // Fallthrough helpers stay in this `let`, so they see the same outer // locals as the source branch. Passing those locals in as arguments // would instantiate a polymorphic scheme once, before the guard body - // applies the arguments that determine its constraints. + // applies the arguments that determine its constraints. The scrutinee + // product is captured too: passing it would instantiate polymorphic + // fields across fallthrough rows. An empty token keeps helpers lazy. let temp = self.local_binder("case_scrutinee", span); let helper_binders = (1..=branches.len() + 1) .map(|index| self.local_binder(&format!("guard_fallthrough_{index}"), span)) .collect::>(); - let mut bindings = Vec::with_capacity(helper_binders.len() + 1); - bindings.push(LocalBinding { + let mut bindings = Vec::with_capacity(helper_binders.len()); + let scrutinee_binding = LocalBinding { binder: temp.clone(), value: scrutinee, span, - }); + }; for row_index in 0..=branches.len() { let next_functions = helper_binders[row_index + 1..] .iter() .map(|_| self.local_binder("next_guard", span)) .collect::>(); - let temp_parameter = self.local_binder("guard_scrutinee", span); + let temp_parameter = self.local_binder("guard_token", span); let body = if row_index == branches.len() { Expr { kind: ExprKind::Case { - scrutinee: Box::new(self.local_expr(&temp_parameter, span)), + scrutinee: Box::new(self.local_expr(&temp, span)), branches: Vec::new(), }, span, @@ -200,7 +208,10 @@ impl Desugarer { next_functions[1..] .iter() .map(|binder| self.local_expr(binder, span)) - .chain(std::iter::once(self.local_expr(&temp_parameter, span))), + .chain(std::iter::once(Expr { + kind: ExprKind::Record(Vec::new()), + span, + })), span, ); let guard_failure = self.clone_expression(&failure); @@ -216,7 +227,7 @@ impl Desugarer { }; Expr { kind: ExprKind::Case { - scrutinee: Box::new(self.local_expr(&temp_parameter, span)), + scrutinee: Box::new(self.local_expr(&temp, span)), branches: vec![source, wildcard], }, span, @@ -250,7 +261,10 @@ impl Desugarer { helper_binders[start..] .iter() .map(|binder| self.local_expr(binder, branch.span)) - .chain(std::iter::once(self.local_expr(&temp, branch.span))), + .chain(std::iter::once(Expr { + kind: ExprKind::Record(Vec::new()), + span: branch.span, + })), branch.span, ); branch.value = self.branch_value(branch.value, failure); @@ -269,8 +283,14 @@ impl Desugarer { }; Expr { kind: ExprKind::Let { - bindings, - body: Box::new(body), + bindings: vec![scrutinee_binding], + body: Box::new(Expr { + kind: ExprKind::Let { + bindings, + body: Box::new(body), + }, + span, + }), }, span, } diff --git a/crates/psrs-desugar/src/fixity.rs b/crates/psrs-desugar/src/fixity.rs index 78136928..396ddfeb 100644 --- a/crates/psrs-desugar/src/fixity.rs +++ b/crates/psrs-desugar/src/fixity.rs @@ -63,7 +63,7 @@ fn validate_expr(expression: &Expr, errors: &mut Vec) { validate_expr(element, errors); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { validate_expr(value, errors); } diff --git a/crates/psrs-desugar/src/lib.rs b/crates/psrs-desugar/src/lib.rs index 9694acd1..687faab7 100644 --- a/crates/psrs-desugar/src/lib.rs +++ b/crates/psrs-desugar/src/lib.rs @@ -193,6 +193,12 @@ fn desugar_expr(expression: Expr) -> Expr { .map(|(label, value)| (label, desugar_expr(value))) .collect(), ), + ExprKind::MatchProduct(fields) => ExprKind::MatchProduct( + fields + .into_iter() + .map(|(label, value)| (label, desugar_expr(value))) + .collect(), + ), ExprKind::RecordUpdate { expression, fields } => ExprKind::RecordUpdate { expression: Box::new(desugar_expr(*expression)), fields: fields diff --git a/crates/psrs-driver/src/program/effects.rs b/crates/psrs-driver/src/program/effects.rs index a2ebdc59..f42e7ea9 100644 --- a/crates/psrs-driver/src/program/effects.rs +++ b/crates/psrs-driver/src/program/effects.rs @@ -230,7 +230,7 @@ fn collect_runner_references(expression: &Expr, runner: SymbolId, spans: &mut Ve collect_runner_references(element, runner, spans); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { collect_runner_references(value, runner, spans); } diff --git a/crates/psrs-driver/tests/pattern_support/support.rs b/crates/psrs-driver/tests/pattern_support/support.rs index cef995de..90169950 100644 --- a/crates/psrs-driver/tests/pattern_support/support.rs +++ b/crates/psrs-driver/tests/pattern_support/support.rs @@ -52,7 +52,7 @@ pub(super) fn visit_expr_patterns<'a>(expression: &'a Expr, output: &mut Vec<&'a visit_expr_patterns(element, output); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { visit_expr_patterns(value, output); } @@ -140,7 +140,7 @@ pub(super) fn visit_expr_guards<'a>(expression: &'a Expr, output: &mut Vec<&'a G visit_expr_guards(element, output); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { visit_expr_guards(value, output); } diff --git a/crates/psrs-driver/tests/support/rank_n/mod.rs b/crates/psrs-driver/tests/support/rank_n/mod.rs index 51f8392a..7bb4a96c 100644 --- a/crates/psrs-driver/tests/support/rank_n/mod.rs +++ b/crates/psrs-driver/tests/support/rank_n/mod.rs @@ -1,5 +1,7 @@ //! Source cases shared by semantic, differential, and execution acceptance. +mod reify; + pub const CHECK_ONLY: &[(&str, &str)] = &[( "annotated_polymorphic_array", r#"module Main where @@ -32,6 +34,9 @@ main = case Holder (make 0) of ]; pub const ACCEPT: &[(&str, &str)] = &[ + ("rank_n_separate_equations", reify::EQUATIONS), + ("rank_n_multiple_scrutinees", reify::MULTIPLE), + ("rank_n_guarded_equations", reify::GUARDED), ( "returned_constraint", r#"module Main where diff --git a/crates/psrs-driver/tests/support/rank_n/reify.rs b/crates/psrs-driver/tests/support/rank_n/reify.rs new file mode 100644 index 00000000..2be2cc95 --- /dev/null +++ b/crates/psrs-driver/tests/support/rank_n/reify.rs @@ -0,0 +1,77 @@ +pub const EQUATIONS: &str = r#"module Main where +data First = First +data Second = Second +data Proxy a = Proxy +class Tag a where + tag :: Proxy a -> Int +instance tagFirst :: Tag First where + tag _ = 21 +instance tagSecond :: Tag Second where + tag _ = 42 +reify :: forall r. Boolean -> (forall a. Tag a => Proxy a -> r) -> r +reify true f = f (Proxy :: Proxy First) +reify false f = f (Proxy :: Proxy Second) +main :: Int +main = case reify true tag, reify false tag of + 21, 42 -> 42 + _, _ -> 1 +"#; + +pub const MULTIPLE: &str = r#"module Main where +data First = First +data Second = Second +data Proxy a = Proxy +class Tag a where + tag :: Proxy a -> Int +instance tagFirst :: Tag First where + tag _ = 21 +instance tagSecond :: Tag Second where + tag _ = 42 +reify :: forall r. Boolean -> (forall a. Tag a => Proxy a -> r) -> r +reify flag f = case flag, f of + true, continuation -> continuation (Proxy :: Proxy First) + false, continuation -> continuation (Proxy :: Proxy Second) +main :: Int +main = case reify true tag, reify false tag of + 21, 42 -> 42 + _, _ -> 1 +"#; + +pub const GUARDED: &str = r#"module Main where +data First = First +data Second = Second +data Proxy a = Proxy +class Tag a where + tag :: Proxy a -> Int +instance tagFirst :: Tag First where + tag _ = 21 +instance tagSecond :: Tag Second where + tag _ = 42 +reify :: forall r. Boolean -> (forall a. Tag a => Proxy a -> r) -> r +reify true f | true = f (Proxy :: Proxy First) +reify false f | true = f (Proxy :: Proxy Second) +main :: Int +main = case reify true tag, reify false tag of + 21, 42 -> 42 + _, _ -> 1 +"#; + +pub const RECORD: &str = r#"module Main where +data First = First +data Second = Second +data Proxy a = Proxy +class Tag a where + tag :: Proxy a -> Int +instance tagFirst :: Tag First where + tag _ = 21 +instance tagSecond :: Tag Second where + tag _ = 42 +reify :: forall r. Boolean -> (forall a. Tag a => Proxy a -> r) -> r +reify flag f = case { flag, f } of + { flag: true, f: continuation } -> continuation (Proxy :: Proxy First) + { flag: false, f: continuation } -> continuation (Proxy :: Proxy Second) +main :: Int +main = case reify true tag, reify false tag of + 21, 42 -> 42 + _, _ -> 1 +"#; diff --git a/crates/psrs-driver/tests/support/rank_n/reject.rs b/crates/psrs-driver/tests/support/rank_n/reject.rs index 6f3e378a..a7a91851 100644 --- a/crates/psrs-driver/tests/support/rank_n/reject.rs +++ b/crates/psrs-driver/tests/support/rank_n/reject.rs @@ -1,4 +1,5 @@ pub const REJECT: &[(&str, &str)] = &[ + ("rank_n_record_shares_instantiation", super::reify::RECORD), ( "ambiguous_unresolved_main_use", r#"module Main where diff --git a/crates/psrs-hir/src/expr.rs b/crates/psrs-hir/src/expr.rs index 129841a4..54d4c55b 100644 --- a/crates/psrs-hir/src/expr.rs +++ b/crates/psrs-hir/src/expr.rs @@ -41,6 +41,10 @@ pub enum ExprKind { Char(char), Array(Vec), Record(Vec<(String, Expr)>), + /// An ordered product of independent match scrutinees. Unlike a source + /// record literal, its fields retain polymorphism until pattern checking. + /// P5 checks the fields and converts the product to an ordinary typed record. + MatchProduct(Vec<(String, Expr)>), RecordUpdate { expression: Box, fields: Vec<(String, Expr)>, diff --git a/crates/psrs-hir/src/verify/mod.rs b/crates/psrs-hir/src/verify/mod.rs index c2a8a708..1e5a5f7a 100644 --- a/crates/psrs-hir/src/verify/mod.rs +++ b/crates/psrs-hir/src/verify/mod.rs @@ -38,7 +38,7 @@ pub(crate) fn verify_expr( verify_expr(element, globals, visible_locals, declared_locals, errors); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { verify_expr(value, globals, visible_locals, declared_locals, errors); } diff --git a/crates/psrs-hir/src/verify/normalized.rs b/crates/psrs-hir/src/verify/normalized.rs index bf0be858..65bb9604 100644 --- a/crates/psrs-hir/src/verify/normalized.rs +++ b/crates/psrs-hir/src/verify/normalized.rs @@ -88,7 +88,7 @@ fn check_normalized_expr(expression: &Expr, errors: &mut Vec) { check_normalized_expr(item, errors); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { check_normalized_expr(value, errors); } diff --git a/crates/psrs-kind/src/check/infer/pattern_annotations.rs b/crates/psrs-kind/src/check/infer/pattern_annotations.rs index 31777c82..3b6ad5a7 100644 --- a/crates/psrs-kind/src/check/infer/pattern_annotations.rs +++ b/crates/psrs-kind/src/check/infer/pattern_annotations.rs @@ -30,7 +30,7 @@ impl Checker<'_> { self.check_expression_annotations(element); } } - ExprKind::Record(fields) => { + ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { for (_, value) in fields { self.check_expression_annotations(value); } diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index f5fdf6ee..92c23747 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -178,6 +178,12 @@ impl Resolver { .map(|(label, value)| Some((label, self.resolve_expr(value)?))) .collect::>>()?, ), + AstExprKind::MatchProduct(fields) => ExprKind::MatchProduct( + fields + .into_iter() + .map(|(label, value)| Some((label, self.resolve_expr(value)?))) + .collect::>>()?, + ), AstExprKind::RecordUpdate { expression, fields } => { self.resolve_record_update(*expression, fields, span)? } diff --git a/crates/psrs-typecheck/src/typecheck/classes/locals.rs b/crates/psrs-typecheck/src/typecheck/classes/locals.rs index 2ff25dcd..45680d39 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/locals.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/locals.rs @@ -32,7 +32,7 @@ fn scan_expr(expression: &hir::Expr, max: &mut Option) { scan_expr(element, max); } } - hir::ExprKind::Record(fields) => { + hir::ExprKind::Record(fields) | hir::ExprKind::MatchProduct(fields) => { for (_, value) in fields { scan_expr(value, max); } diff --git a/crates/psrs-typecheck/src/typecheck/infer/case.rs b/crates/psrs-typecheck/src/typecheck/infer/case.rs index 4cd2d84e..e00e4bbe 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/case.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/case.rs @@ -20,7 +20,23 @@ impl Checker { let requires_monotype = branches .iter() .any(|branch| pattern_requires_monotype(&branch.pattern)); - let scrutinee = self.infer_pattern_scrutinee(scrutinee, requires_monotype)?; + let scrutinee = if let hir::ExprKind::MatchProduct(fields) = &scrutinee.kind { + let (kind, ty) = + self.infer_record_fields(fields, scrutinee.span, |checker, label, value| { + let requires_monotype = branches.iter().any(|branch| { + product_field_pattern(&branch.pattern, label) + .is_none_or(pattern_requires_monotype) + }); + checker.infer_pattern_scrutinee(value, requires_monotype) + })?; + InferredExpr { + kind, + ty, + span: scrutinee.span, + } + } else { + self.infer_pattern_scrutinee(scrutinee, requires_monotype)? + }; let mut result_ty = expected; let mut inferred = Vec::with_capacity(branches.len()); for branch in branches { @@ -55,7 +71,7 @@ impl Checker { /// A local pattern-matching scrutinee retains structural `forall` types so /// a typed binder can check a rank-N pattern against the value's declared /// type. Ordinary local references still instantiate those quantifiers. - fn infer_pattern_scrutinee( + pub(super) fn infer_pattern_scrutinee( &mut self, expression: &hir::Expr, requires_monotype: bool, @@ -125,6 +141,17 @@ impl Checker { } } +fn product_field_pattern<'a>(pattern: &'a hir::Pattern, label: &str) -> Option<&'a hir::Pattern> { + match &pattern.kind { + hir::PatternKind::Record { fields, .. } => fields + .iter() + .find(|(field, _)| field == label) + .map(|(_, pattern)| pattern), + hir::PatternKind::Named { pattern, .. } => product_field_pattern(pattern, label), + _ => None, + } +} + fn pattern_requires_monotype(pattern: &hir::Pattern) -> bool { match &pattern.kind { hir::PatternKind::Wildcard | hir::PatternKind::Var(_) => false, diff --git a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs index faba879b..5e8a9493 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs @@ -239,7 +239,9 @@ fn expr_mentions(expression: &hir::Expr, ids: &HashSet) -> bool { hir::ExprKind::Array(elements) => { elements.iter().any(|element| expr_mentions(element, ids)) } - hir::ExprKind::Record(fields) => fields.iter().any(|(_, value)| expr_mentions(value, ids)), + hir::ExprKind::Record(fields) | hir::ExprKind::MatchProduct(fields) => { + fields.iter().any(|(_, value)| expr_mentions(value, ids)) + } hir::ExprKind::RecordUpdate { expression, fields } => { expr_mentions(expression, ids) || fields.iter().any(|(_, value)| expr_mentions(value, ids)) diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index f27ed898..b2a4e4ba 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -239,6 +239,11 @@ impl Checker { } } hir::ExprKind::Record(fields) => self.infer_record(fields, span)?, + hir::ExprKind::MatchProduct(fields) => { + self.infer_record_fields(fields, span, |checker, _, value| { + checker.infer_pattern_scrutinee(value, false) + })? + } hir::ExprKind::RecordUpdate { expression, fields } => { self.infer_record_update(expression, fields, span)? } diff --git a/crates/psrs-typecheck/src/typecheck/infer/records.rs b/crates/psrs-typecheck/src/typecheck/infer/records.rs index 79d704ff..97a7c315 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/records.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/records.rs @@ -13,35 +13,24 @@ impl Checker { .. } = self.normalize_row_or_report(expected_row, span); let expected_fields = expected_fields.into_iter().collect::>(); - let mut inferred = Vec::with_capacity(fields.len()); - let mut labels = HashSet::new(); - for (label, value) in fields { - if !labels.insert(label) { - self.state.errors.push(TypeCheckError::new( - TypeCheckErrorKind::TypeMismatch, - span, - format!("record label `{label}` occurs more than once"), - )); - return None; - } - let value = - self.infer_expr_with_expected(value, expected_fields.get(label).cloned())?; - inferred.push((label.clone(), value)); - } - let actual = record_type( - inferred - .iter() - .map(|(label, value)| (label.clone(), value.ty.clone())) - .collect(), - InferType::RowEmpty, - ); - Some((InferredExprKind::Record(inferred), actual)) + self.infer_record_fields(fields, span, |checker, label, value| { + checker.infer_expr_with_expected(value, expected_fields.get(label).cloned()) + }) } pub(super) fn infer_record( &mut self, fields: &[(String, hir::Expr)], span: TextRange, + ) -> Option<(InferredExprKind, InferType)> { + self.infer_record_fields(fields, span, |checker, _, value| checker.infer_expr(value)) + } + + pub(super) fn infer_record_fields( + &mut self, + fields: &[(String, hir::Expr)], + span: TextRange, + mut infer_field: impl FnMut(&mut Self, &str, &hir::Expr) -> Option, ) -> Option<(InferredExprKind, InferType)> { let mut inferred = Vec::with_capacity(fields.len()); let mut labels = HashSet::new(); @@ -54,13 +43,15 @@ impl Checker { )); return None; } - inferred.push((label.clone(), self.infer_expr(value)?)); + inferred.push((label.clone(), infer_field(self, label, value)?)); } - let record_fields = inferred - .iter() - .map(|(label, value)| (label.clone(), value.ty.clone())) - .collect::>(); - let ty = record_type(record_fields, InferType::RowEmpty); + let ty = record_type( + inferred + .iter() + .map(|(label, value)| (label.clone(), value.ty.clone())) + .collect(), + InferType::RowEmpty, + ); Some((InferredExprKind::Record(inferred), ty)) } diff --git a/crates/psrs-typecheck/src/typecheck/order.rs b/crates/psrs-typecheck/src/typecheck/order.rs index 3bcf6e95..d8217b40 100644 --- a/crates/psrs-typecheck/src/typecheck/order.rs +++ b/crates/psrs-typecheck/src/typecheck/order.rs @@ -60,7 +60,7 @@ fn collect_globals(expression: &hir::Expr, out: &mut Vec) { collect_globals(element, out); } } - hir::ExprKind::Record(fields) => { + hir::ExprKind::Record(fields) | hir::ExprKind::MatchProduct(fields) => { for (_, value) in fields { collect_globals(value, out); } diff --git a/docs/design/frontend/semantics/desugaring.md b/docs/design/frontend/semantics/desugaring.md index 3419313e..350855e2 100644 --- a/docs/design/frontend/semantics/desugaring.md +++ b/docs/design/frontend/semantics/desugaring.md @@ -15,8 +15,13 @@ in-scope `negate` name. P4 rewrites surface constructs into a smaller resolved HIR, applying fixities, lowering unary minus, guards, equations, `do`/`ado`, and `where` scope while preserving source order and origins for P5 diagnostics. -The generated case and equation products use exact record patterns, so P5 -infers a closed row for the helper product. A source record pattern such as +The generated case and equation products retain an explicit `MatchProduct` +expression through P3 and P4, with exact record patterns. Each field is an +independent scrutinee, so P5 preserves a local field's structural `forall` +unless the corresponding source patterns require a monotype. P5 converts the +checked product into an ordinary typed record with a closed row. A source +record literal still instantiates its field expressions normally; its fields +must not acquire independent pattern-scrutinee polymorphism. A source record pattern such as `{ field }` remains partial and may leave the row tail open. This distinction keeps compiler-created products concrete without changing source record matching. @@ -105,8 +110,12 @@ remain as resolved `Typed` expressions for P5. Every rewrite evaluates source operands in the order defined by the language. A failed guard proceeds to the next guard without evaluating that guard's body. A generated temporary binds an expression once when duplication would change -evaluation. A fallthrough helper is defined in the same `let` as the case, so -it refers to outer locals directly. Passing one of those locals in as a value +evaluation. The saved scrutinee is bound in an outer `let`, and fallthrough helpers share +an inner `let` with the case. They refer to outer locals and the saved product +directly. Separating the saved value from the helper binding group preserves +its scope without making that group recursive. Its calls +pass an empty token to delay evaluation, rather than passing the product's +polymorphic fields through a newly inferred helper parameter. Passing one of those locals in as a value argument would instantiate a polymorphic scheme once, before the guard body applies the arguments that determine its constraints. P4 preserves the source span of every retained user expression; generated scaffolding points to the diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index a0bb110e..5e971e4d 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -39,6 +39,14 @@ Inference state has three owners with distinct lifetimes. The `SemanticEnv` is i Infer synthesizable expressions and check expressions with expected types. Instantiate `forall` and solve constrained uses through class entailment. When checking a signature or higher-rank argument, skolemize expected quantifiers, perform structural subsumption, and check that skolems do not escape. Function parameter comparison is contravariant and result comparison covariant; record subsumption compares common labels and checks closed-row extras and omissions. Evidence can be inserted at elaboration sites, while comparison under a type constructor cannot invent term-level dictionaries. +A multi-scrutinee case or multi-equation declaration retains a `MatchProduct` +until checking. Its fields are independent pattern scrutinees: a local +structural `forall` survives variable patterns, and each branch instantiates +its own bound value at use. Patterns requiring a monotype instantiate only +that field. The checked product becomes a closed record in THIR. Ordinary +source record construction continues to instantiate field expressions once. +Guard fallthrough captures the saved product to preserve the same rule. + Coercion primitives checked against an expected arrow take its parameter and result as their exact source and target boundary types. Function variance must not instantiate a quantified input and leave the cast's stored source at an From 6cb619eab21277e247562dbdba6ad1e6e7912872 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 14:10:58 +0800 Subject: [PATCH 034/148] Register compiler interfaces and synthesize checked Symbol dictionaries --- crates/psrs-core/src/lower/dictionary.rs | 32 ++- crates/psrs-core/src/lower/mod.rs | 60 +---- crates/psrs-core/src/lower/module.rs | 1 + crates/psrs-core/src/lower/pattern.rs | 52 +++++ crates/psrs-driver/src/tests/mod.rs | 2 + .../psrs-driver/src/tests/source_evidence.rs | 1 + .../src/tests/symbol_reflection.rs | 221 ++++++++++++++++++ crates/psrs-driver/tests/upstream/mod.rs | 1 + .../tests/upstream/symbol_reflection.rs | 27 +++ crates/psrs-hir/src/compiler_class.rs | 16 ++ crates/psrs-hir/src/compiler_interface.rs | 48 ++++ crates/psrs-hir/src/lib.rs | 6 + crates/psrs-hir/src/primitives/mod.rs | 2 + crates/psrs-hir/src/tests.rs | 1 + crates/psrs-hir/src/types.rs | 3 + .../src/resolver/module_resolution.rs | 16 +- .../src/resolver/program/interface.rs | 29 ++- .../src/resolver/type_resolution.rs | 1 + crates/psrs-thir/src/evidence.rs | 4 + crates/psrs-thir/src/scope/mod.rs | 3 + crates/psrs-thir/src/tests.rs | 2 + .../src/tests/constructed_dictionary.rs | 61 +++++ crates/psrs-thir/src/verify/mod.rs | 10 + crates/psrs-thir/src/verify/semantics/mod.rs | 18 +- .../typecheck/classes/environment/compiler.rs | 76 ++++++ .../src/typecheck/classes/environment/mod.rs | 4 + .../typecheck/classes/evidence/finalize.rs | 3 + .../src/typecheck/classes/evidence/mod.rs | 5 +- .../src/typecheck/classes/fundeps/support.rs | 3 +- .../src/typecheck/classes/mod.rs | 1 + .../src/typecheck/classes/solve/search.rs | 26 +-- .../src/typecheck/generalize/body.rs | 3 + .../src/typecheck/prim/dispatch.rs | 4 +- .../psrs-typecheck/src/typecheck/prim/mod.rs | 38 ++- .../src/typecheck/prim/reflection.rs | 65 ++++++ .../src/typecheck/prim/verify.rs | 18 +- .../src/typecheck/tests/rows.rs | 1 + .../typecheck/tests/type_level_literals.rs | 1 + .../src/typecheck/tests/user_types/mod.rs | 2 + .../src/typecheck/vocabulary.rs | 3 + .../type-system/classes-and-evidence.md | 12 + docs/design/frontend/type-system/prim.md | 23 +- 42 files changed, 799 insertions(+), 106 deletions(-) create mode 100644 crates/psrs-core/src/lower/pattern.rs create mode 100644 crates/psrs-driver/src/tests/symbol_reflection.rs create mode 100644 crates/psrs-driver/tests/upstream/symbol_reflection.rs create mode 100644 crates/psrs-hir/src/compiler_class.rs create mode 100644 crates/psrs-hir/src/compiler_interface.rs create mode 100644 crates/psrs-thir/src/tests/constructed_dictionary.rs create mode 100644 crates/psrs-typecheck/src/typecheck/classes/environment/compiler.rs create mode 100644 crates/psrs-typecheck/src/typecheck/prim/reflection.rs diff --git a/crates/psrs-core/src/lower/dictionary.rs b/crates/psrs-core/src/lower/dictionary.rs index 4e6b3098..91952f02 100644 --- a/crates/psrs-core/src/lower/dictionary.rs +++ b/crates/psrs-core/src/lower/dictionary.rs @@ -2,10 +2,25 @@ use super::{Expr, ExprKind, LowerError, TypeId}; use psrs_thir::{Evidence, EvidenceKind, Type}; /// Erases checked class evidence into the existing Core value and call forms. -pub(super) fn lower_evidence(evidence: &Evidence, types: &[Type]) -> Result { +pub(super) fn lower_evidence( + evidence: &Evidence, + types: &[Type], + externals: &std::collections::HashMap, + constructors: &std::collections::HashMap, + context: &mut super::module::LowerContext, +) -> Result { let span = evidence.span; let ty = TypeId(evidence.ty.0); let kind = match &evidence.kind { + EvidenceKind::DictionaryValue(value) => { + return super::lower_expr( + value.as_ref().clone(), + externals, + constructors, + types, + context, + ); + } EvidenceKind::Given(id) => ExprKind::Local(*id), EvidenceKind::Global(symbol) => ExprKind::Global(*symbol), EvidenceKind::Coercible { .. } | EvidenceKind::Primitive { .. } => { @@ -15,13 +30,19 @@ pub(super) fn lower_evidence(evidence: &Evidence, types: &[Type]) -> Result ExprKind::FieldAccess { - record: Box::new(lower_evidence(parent, types)?), + record: Box::new(lower_evidence( + parent, + types, + externals, + constructors, + context, + )?), field: field.clone(), }, EvidenceKind::Instance { constructor, constructor_type, - context, + context: arguments, } => { let mut function_type = *constructor_type; let mut function = Expr { @@ -29,14 +50,15 @@ pub(super) fn lower_evidence(evidence: &Evidence, types: &[Type]) -> Result { - return dictionary::lower_evidence(&evidence, source_types); + return dictionary::lower_evidence( + &evidence, + source_types, + externals, + constructors, + context, + ); } TypedExprKind::Coerce { value, @@ -408,56 +416,6 @@ fn arrow_parts_after_foralls( psrs_thir::arrow_parts(types, function_type) } -fn lower_pattern(pattern: psrs_thir::Pattern) -> Result { - let span = pattern.span; - let kind = match pattern.kind { - psrs_thir::PatternKind::Wildcard => crate::PatternKind::Wildcard, - psrs_thir::PatternKind::Literal { literal } => crate::PatternKind::Literal { - value: match literal { - psrs_thir::PatternLiteral::Integer(value) => crate::Literal::Integer(value), - psrs_thir::PatternLiteral::Number(value) => crate::Literal::Number(value), - psrs_thir::PatternLiteral::String(value) => crate::Literal::String(value), - psrs_thir::PatternLiteral::Char(value) => crate::Literal::Char(value), - psrs_thir::PatternLiteral::Boolean(value) => crate::Literal::Boolean(value), - }, - }, - psrs_thir::PatternKind::Array { elements } => crate::PatternKind::Array { - elements: elements - .into_iter() - .map(lower_pattern) - .collect::, _>>()?, - }, - psrs_thir::PatternKind::Named { id, pattern } => crate::PatternKind::Named { - id, - pattern: Box::new(lower_pattern(*pattern)?), - }, - psrs_thir::PatternKind::Var { id, ty } => crate::PatternKind::Var { - id, - ty: TypeId(ty.0), - }, - psrs_thir::PatternKind::Constructor { symbol, arguments } => { - crate::PatternKind::Constructor { - symbol, - arguments: arguments - .into_iter() - .map(lower_pattern) - .collect::, _>>()?, - } - } - psrs_thir::PatternKind::Record { fields } => crate::PatternKind::Record { - fields: fields - .into_iter() - .map(|(label, pattern)| Ok((label, lower_pattern(pattern)?))) - .collect::, LowerError>>()?, - }, - }; - Ok(crate::Pattern { - kind, - ty: TypeId(pattern.ty.0), - span, - }) -} - fn constructor_application<'a>( expression: &'a TypedExpr, constructors: &HashMap, diff --git a/crates/psrs-core/src/lower/module.rs b/crates/psrs-core/src/lower/module.rs index 2c0c9fae..c153c440 100644 --- a/crates/psrs-core/src/lower/module.rs +++ b/crates/psrs-core/src/lower/module.rs @@ -127,6 +127,7 @@ fn scan_pattern_locals(pattern: &psrs_thir::Pattern, max: &mut Option) { fn scan_evidence_locals(evidence: &psrs_thir::Evidence, max: &mut Option) { match &evidence.kind { + psrs_thir::EvidenceKind::DictionaryValue(value) => scan_expr_locals(value, max), psrs_thir::EvidenceKind::Given(id) => { *max = Some(max.map_or(id.0, |current| current.max(id.0))); } diff --git a/crates/psrs-core/src/lower/pattern.rs b/crates/psrs-core/src/lower/pattern.rs new file mode 100644 index 00000000..a280d3f3 --- /dev/null +++ b/crates/psrs-core/src/lower/pattern.rs @@ -0,0 +1,52 @@ +//! Checked pattern conversion from THIR to Core. +use super::{LowerError, TypeId}; + +pub(super) fn lower_pattern(pattern: psrs_thir::Pattern) -> Result { + let span = pattern.span; + let kind = match pattern.kind { + psrs_thir::PatternKind::Wildcard => crate::PatternKind::Wildcard, + psrs_thir::PatternKind::Literal { literal } => crate::PatternKind::Literal { + value: match literal { + psrs_thir::PatternLiteral::Integer(value) => crate::Literal::Integer(value), + psrs_thir::PatternLiteral::Number(value) => crate::Literal::Number(value), + psrs_thir::PatternLiteral::String(value) => crate::Literal::String(value), + psrs_thir::PatternLiteral::Char(value) => crate::Literal::Char(value), + psrs_thir::PatternLiteral::Boolean(value) => crate::Literal::Boolean(value), + }, + }, + psrs_thir::PatternKind::Array { elements } => crate::PatternKind::Array { + elements: elements + .into_iter() + .map(lower_pattern) + .collect::, _>>()?, + }, + psrs_thir::PatternKind::Named { id, pattern } => crate::PatternKind::Named { + id, + pattern: Box::new(lower_pattern(*pattern)?), + }, + psrs_thir::PatternKind::Var { id, ty } => crate::PatternKind::Var { + id, + ty: TypeId(ty.0), + }, + psrs_thir::PatternKind::Constructor { symbol, arguments } => { + crate::PatternKind::Constructor { + symbol, + arguments: arguments + .into_iter() + .map(lower_pattern) + .collect::, _>>()?, + } + } + psrs_thir::PatternKind::Record { fields } => crate::PatternKind::Record { + fields: fields + .into_iter() + .map(|(label, pattern)| Ok((label, lower_pattern(pattern)?))) + .collect::, LowerError>>()?, + }, + }; + Ok(crate::Pattern { + kind, + ty: TypeId(pattern.ty.0), + span, + }) +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index d205988d..d8b8324d 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -164,3 +164,5 @@ mod module_loader; mod library_types; mod tail_calls; + +mod symbol_reflection; diff --git a/crates/psrs-driver/src/tests/source_evidence.rs b/crates/psrs-driver/src/tests/source_evidence.rs index d528ea71..90b4f22b 100644 --- a/crates/psrs-driver/src/tests/source_evidence.rs +++ b/crates/psrs-driver/src/tests/source_evidence.rs @@ -127,6 +127,7 @@ fn walk_expr(expression: &psrs_thir::Expr, seen: &mut Seen) { fn walk_evidence(evidence: &psrs_thir::Evidence, seen: &mut Seen) { use psrs_thir::EvidenceKind; match &evidence.kind { + EvidenceKind::DictionaryValue(value) => walk_expr(value, seen), EvidenceKind::Given(_) => seen.given = true, EvidenceKind::Global(_) => seen.global = true, EvidenceKind::Superclass { parent, .. } => { diff --git a/crates/psrs-driver/src/tests/symbol_reflection.rs b/crates/psrs-driver/src/tests/symbol_reflection.rs new file mode 100644 index 00000000..36c33123 --- /dev/null +++ b/crates/psrs-driver/src/tests/symbol_reflection.rs @@ -0,0 +1,221 @@ +use psrs_thir::{Evidence, EvidenceKind, Expr, ExprKind}; + +const PROXY: &str = "module Type.Proxy where\ndata Proxy (s :: Symbol) = Proxy\n"; +const SYMBOL: &str = "module Data.Symbol where\nimport Type.Proxy (Proxy)\n\ +class IsSymbol (s :: Symbol) where\n reflectSymbol :: Proxy s -> String\n"; + +fn program(main: &str) -> Vec { + crate::typecheck_program_sources(&[ + ("Proxy.purs", PROXY), + ("Symbol.purs", SYMBOL), + ("Main.purs", main), + ]) + .unwrap_or_else(|errors| panic!("symbol program should check: {errors:?}")) +} + +#[test] +fn symbol_reflection_survives_aliases_and_reexports() { + let bridge = "module Bridge (module S) where\nimport Data.Symbol as S\n"; + let main = r#"module Main where +import Bridge as B +import Type.Proxy (Proxy(..)) +main :: String +main = B.reflectSymbol (Proxy :: Proxy "λ😀") +"#; + crate::check_program(&[ + ("Proxy.purs", PROXY), + ("Symbol.purs", SYMBOL), + ("Bridge.purs", bridge), + ("Main.purs", main), + ]) + .expect("canonical class identity survives alias and re-export"); +} + +#[test] +fn a_same_named_user_class_has_no_compiler_dictionary_rule() { + let ordinary = SYMBOL.replace("module Data.Symbol", "module Ordinary"); + let main = r#"module Main where +import Ordinary +import Type.Proxy (Proxy(..)) +main :: String +main = reflectSymbol (Proxy :: Proxy "unicode") +"#; + let errors = crate::check_program(&[ + ("Proxy.purs", PROXY), + ("Ordinary.purs", &ordinary), + ("Main.purs", main), + ]) + .expect_err("user class needs its own instance"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code.as_deref() == Some("NoInstanceFound")), + "{errors:?}" + ); +} + +#[test] +fn a_malformed_compiler_class_contract_is_rejected() { + let malformed = SYMBOL.replace("-> String", "-> Int"); + let errors = crate::check_program(&[("Proxy.purs", PROXY), ("Symbol.purs", &malformed)]) + .expect_err("compiler interface must declare the supported method type"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.message.contains("dictionary contract")), + "{errors:?}" + ); +} + +#[test] +fn an_unknown_symbol_is_not_defaulted() { + let main = r#"module Main where +import Data.Symbol +import Type.Proxy (Proxy(..)) +main :: String +main = reflectSymbol Proxy +"#; + crate::check_program(&[ + ("Proxy.purs", PROXY), + ("Symbol.purs", SYMBOL), + ("Main.purs", main), + ]) + .expect_err("reflection requires a known symbol or lexical dictionary"); +} + +#[test] +fn a_symbol_given_is_used_under_a_quantifier() { + program( + r#"module Main where +import Data.Symbol +import Type.Proxy (Proxy(..)) +reflect :: forall s. IsSymbol s => Proxy s -> String +reflect proxy = reflectSymbol proxy +main :: String +main = reflect (Proxy :: Proxy "") +"#, + ); +} + +fn constructed_evidence(expression: &mut Expr) -> Option<&mut Evidence> { + match &mut expression.kind { + ExprKind::Evidence(evidence) => Some(evidence), + ExprKind::Application(function, _) => constructed_evidence(function), + ExprKind::FieldAccess { expression, .. } => constructed_evidence(expression), + _ => None, + } +} + +#[test] +fn constructed_dictionaries_are_verified_as_ordinary_terms() { + let mut modules = program( + r#"module Main where +import Data.Symbol +import Type.Proxy (Proxy(..)) +main :: String +main = reflectSymbol (Proxy :: Proxy "λ😀") +"#, + ); + let main = modules.last_mut().unwrap(); + let evidence = + constructed_evidence(&mut main.declarations[0].value).expect("constructed evidence"); + let EvidenceKind::DictionaryValue(value) = &mut evidence.kind else { + panic!("expected runtime dictionary") + }; + let ExprKind::Record(fields) = &mut value.kind else { + panic!("expected dictionary fields") + }; + let ExprKind::Lambda { binder, body } = &mut fields[0].1.kind else { + panic!("expected reflection method") + }; + assert_eq!(body.kind, ExprKind::String("λ😀".into())); + // A bound proxy cannot serve as the method's String result. + body.kind = ExprKind::Local(binder.id); + assert!( + main.verify().is_err(), + "method body result disagrees with its binder" + ); +} + +#[test] +fn symbol_reflection_returns_canonical_utf8_at_runtime() { + let source = r#"module Main where +import Data.Symbol (reflectSymbol) +import Type.Proxy (Proxy(..)) +main :: Int +main = + let bytes = stringToBytes (reflectSymbol (Proxy :: Proxy "λ😀")) + in if intEq (arrayLength bytes) 6 then + if intEq (arrayIndex bytes 0) 206 then + if intEq (arrayIndex bytes 1) 187 then + if intEq (arrayIndex bytes 2) 240 then + if intEq (arrayIndex bytes 3) 159 then + if intEq (arrayIndex bytes 4) 152 then + if intEq (arrayIndex bytes 5) 128 then 42 else 1 + else 2 + else 3 + else 4 + else 5 + else 6 + else 7 +"#; + let Some(output) = super::run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn compiler_interface_contracts_accept_equivalent_type_synonyms() { + let symbol = SYMBOL + .replace( + "class IsSymbol", + "type Reflected s = Proxy s -> String\nclass IsSymbol", + ) + .replace( + "reflectSymbol :: Proxy s -> String", + "reflectSymbol :: Reflected s", + ); + crate::check_program(&[ + ("Proxy.purs", PROXY), + ("Symbol.purs", &symbol), + ( + "Main.purs", + r#"module Main where +import Data.Symbol +import Type.Proxy (Proxy(..)) +main :: String +main = reflectSymbol (Proxy :: Proxy "known") +"#, + ), + ]) + .expect("semantic interface validation expands synonyms"); +} + +#[test] +fn constructed_dictionary_methods_cannot_reference_missing_locals() { + let mut modules = program( + r#"module Main where +import Data.Symbol +import Type.Proxy (Proxy(..)) +main :: String +main = reflectSymbol (Proxy :: Proxy "known") +"#, + ); + let main = modules.last_mut().unwrap(); + let evidence = constructed_evidence(&mut main.declarations[0].value).unwrap(); + let EvidenceKind::DictionaryValue(value) = &mut evidence.kind else { + panic!("runtime dictionary") + }; + let ExprKind::Record(fields) = &mut value.kind else { + panic!("dictionary record") + }; + let ExprKind::Lambda { body, .. } = &mut fields[0].1.kind else { + panic!("method lambda") + }; + body.kind = ExprKind::Local(psrs_hir::LocalId(u32::MAX)); + assert!( + main.verify().is_err(), + "dictionary bodies have ordinary lexical scope" + ); +} diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 8bb8771f..4f2e5566 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -6,6 +6,7 @@ mod deriving; mod rank_n; mod reports; mod rows; +mod symbol_reflection; type SourceFile = (&'static str, &'static str); type SourceSet<'a> = &'a [SourceFile]; diff --git a/crates/psrs-driver/tests/upstream/symbol_reflection.rs b/crates/psrs-driver/tests/upstream/symbol_reflection.rs new file mode 100644 index 00000000..76994dd3 --- /dev/null +++ b/crates/psrs-driver/tests/upstream/symbol_reflection.rs @@ -0,0 +1,27 @@ +use super::*; + +#[test] +fn differential_symbol_reflection_against_purs() { + if !purs_available() { + eprintln!("skipping: purs is not installed"); + return; + } + let proxy = include_str!("../../../../stdlib/lib/Type/Proxy.purs"); + let symbol = include_str!("../../../../stdlib/lib/Data/Symbol.purs"); + let main = r#"module Main where +import Data.Symbol as S +import Type.Proxy (Proxy(..)) +reflect :: forall s. S.IsSymbol s => Proxy s -> String +reflect proxy = S.reflectSymbol proxy +main :: String +main = reflect (Proxy :: Proxy "λ😀") +"#; + let sources = [ + ("Proxy.purs", proxy), + ("Symbol.purs", symbol), + ("Main.purs", main), + ]; + let official = purs_sources_output("symbol-reflection", &sources); + assert!(official.status.success(), "{official:?}"); + psrs_driver::check_program(&sources).expect("accepts official symbol reflection"); +} diff --git a/crates/psrs-hir/src/compiler_class.rs b/crates/psrs-hir/src/compiler_class.rs new file mode 100644 index 00000000..1c6bdf72 --- /dev/null +++ b/crates/psrs-hir/src/compiler_class.rs @@ -0,0 +1,16 @@ +//! Canonical library interfaces whose dictionaries the compiler can construct. +//! Resolution attaches this identity once; aliases and re-exports preserve the +//! declaration's TypeId and consumers never dispatch on source name spelling. + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum CompilerClass { + IsSymbol, +} + +impl CompilerClass { + pub fn method(self) -> &'static str { + match self { + Self::IsSymbol => "reflectSymbol", + } + } +} diff --git a/crates/psrs-hir/src/compiler_interface.rs b/crates/psrs-hir/src/compiler_interface.rs new file mode 100644 index 00000000..8243421e --- /dev/null +++ b/crates/psrs-hir/src/compiler_interface.rs @@ -0,0 +1,48 @@ +//! Canonical compiler/library interface bindings, owned at name resolution. +//! This registry declares identities, not typechecker or runtime behavior. +//! Source implementations keep their declarations and ordinary module TypeIds. +use super::{CompilerClass, Intrinsic, TypeId}; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum InterfaceImplementation { + Compiler, + Source, +} + +pub struct CompilerInterface { + pub module: &'static str, + pub implementation: InterfaceImplementation, + pub values: &'static [(&'static str, Intrinsic)], + pub types: &'static [(&'static str, TypeId)], + pub classes: &'static [(&'static str, CompilerClass)], +} + +pub const COMPILER_INTERFACES: &[CompilerInterface] = &[ + CompilerInterface { + module: "Safe.Coerce", + implementation: InterfaceImplementation::Compiler, + values: &[("coerce", Intrinsic::Coerce)], + types: &[("Coercible", TypeId::COERCIBLE)], + classes: &[], + }, + CompilerInterface { + module: "Unsafe.Coerce", + implementation: InterfaceImplementation::Compiler, + values: &[("unsafeCoerce", Intrinsic::UnsafeCoerce)], + types: &[], + classes: &[], + }, + CompilerInterface { + module: "Data.Symbol", + implementation: InterfaceImplementation::Source, + values: &[], + types: &[], + classes: &[("IsSymbol", CompilerClass::IsSymbol)], + }, +]; + +pub fn compiler_interface(module: &str) -> Option<&'static CompilerInterface> { + COMPILER_INTERFACES + .iter() + .find(|interface| interface.module == module) +} diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index f04424f8..2668e0b5 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -2,6 +2,8 @@ use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; use verify::verify_expr; +mod compiler_class; +mod compiler_interface; mod expr; mod module; mod primitives; @@ -9,6 +11,10 @@ mod substitution; mod ty; mod types; +pub use compiler_class::CompilerClass; +pub use compiler_interface::{ + COMPILER_INTERFACES, CompilerInterface, InterfaceImplementation, compiler_interface, +}; pub use expr::{ CaseBranch, CaseBranchCoverage, Declaration, Expr, ExprKind, Guard, GuardedExpr, LocalBinder, LocalBinding, Pattern, PatternKind, RecordPatternMode, ResolvedOperator, SectionSide, diff --git a/crates/psrs-hir/src/primitives/mod.rs b/crates/psrs-hir/src/primitives/mod.rs index 8e95729f..9c9f4777 100644 --- a/crates/psrs-hir/src/primitives/mod.rs +++ b/crates/psrs-hir/src/primitives/mod.rs @@ -38,6 +38,7 @@ fn class( name: name.to_owned(), name_span: empty_span(), kind: TypeDeclarationKind::Class, + compiler_class: None, parameters: parameters .iter() .map(|name| TypeParameter { @@ -63,6 +64,7 @@ fn foreign_type(id: TypeId, name: &str, declared_kind: Type, roles: &[Role]) -> name: name.to_owned(), name_span: empty_span(), kind: TypeDeclarationKind::Foreign, + compiler_class: None, parameters: Vec::new(), constructors: Vec::new(), members: Vec::new(), diff --git a/crates/psrs-hir/src/tests.rs b/crates/psrs-hir/src/tests.rs index 07c892b6..ab567c13 100644 --- a/crates/psrs-hir/src/tests.rs +++ b/crates/psrs-hir/src/tests.rs @@ -6,6 +6,7 @@ fn class_type(module: ModuleId, index: u32) -> TypeDeclaration { name: format!("Class{index}"), name_span: TextRange::default(), kind: TypeDeclarationKind::Class, + compiler_class: None, parameters: Vec::new(), constructors: Vec::new(), members: Vec::new(), diff --git a/crates/psrs-hir/src/types.rs b/crates/psrs-hir/src/types.rs index 16feae4d..10f6230e 100644 --- a/crates/psrs-hir/src/types.rs +++ b/crates/psrs-hir/src/types.rs @@ -35,6 +35,9 @@ pub struct TypeDeclaration { pub name: String, pub name_span: TextRange, pub kind: TypeDeclarationKind, + /// A canonical library interface identity attached by resolution. P5 + /// validates the declared dictionary contract before enabling its rule. + pub compiler_class: Option, pub parameters: Vec, pub constructors: Vec, pub members: Vec, diff --git a/crates/psrs-resolve/src/resolver/module_resolution.rs b/crates/psrs-resolve/src/resolver/module_resolution.rs index 6e2ecabc..a9769fdd 100644 --- a/crates/psrs-resolve/src/resolver/module_resolution.rs +++ b/crates/psrs-resolve/src/resolver/module_resolution.rs @@ -171,7 +171,21 @@ pub(crate) fn resolve_ast_module( .zip(plans) .filter_map(|(declaration, plan)| { let role = role_declarations.get(&declaration.name().text).cloned(); - resolver.resolve_type_declaration(plan, declaration, role) + let mut declaration = resolver.resolve_type_declaration(plan, declaration, role)?; + // Bind canonical interface exports to the declaration's ordinary + // resolved identity. Type checking validates the interface contract. + declaration.compiler_class = hir::compiler_interface(&module.name.text) + .filter(|interface| { + interface.implementation == hir::InterfaceImplementation::Source + }) + .and_then(|interface| { + interface + .classes + .iter() + .find(|(name, _)| *name == declaration.name) + .map(|(_, identity)| *identity) + }); + Some(declaration) }) .collect(); let mut instance_names = HashSet::new(); diff --git a/crates/psrs-resolve/src/resolver/program/interface.rs b/crates/psrs-resolve/src/resolver/program/interface.rs index cb4cc391..92a55201 100644 --- a/crates/psrs-resolve/src/resolver/program/interface.rs +++ b/crates/psrs-resolve/src/resolver/program/interface.rs @@ -28,6 +28,18 @@ impl Interface { class_members: HashMap::new(), opaque: HashSet::new(), }; + let registered = hir::compiler_interface(name) + .filter(|entry| entry.implementation == hir::InterfaceImplementation::Compiler); + if let Some(registered) = registered { + for &(name, intrinsic) in registered.values { + interface.values.insert(name.into(), intrinsic.symbol()); + } + for &(name, id) in registered.types { + interface + .types + .insert(name.into(), TypeReference::Named(id)); + } + } match name { "Prim" => { for &(member, builtin) in &PRIM_TYPES { @@ -42,21 +54,8 @@ impl Interface { .values .insert("undefined".to_owned(), Intrinsic::Undefined.symbol()); } - "Safe.Coerce" => { - interface - .values - .insert("coerce".to_owned(), Intrinsic::Coerce.symbol()); - interface.types.insert( - "Coercible".to_owned(), - TypeReference::Named(TypeId::COERCIBLE), - ); - } - "Unsafe.Coerce" => { - interface - .values - .insert("unsafeCoerce".to_owned(), Intrinsic::UnsafeCoerce.symbol()); - } - _ if name != "Prim.Coerce" + _ if registered.is_none() + && name != "Prim.Coerce" && !hir::primitive_type_declarations() .iter() .any(|(owner, _)| *owner == name) => diff --git a/crates/psrs-resolve/src/resolver/type_resolution.rs b/crates/psrs-resolve/src/resolver/type_resolution.rs index 9be9dcf0..e65854d2 100644 --- a/crates/psrs-resolve/src/resolver/type_resolution.rs +++ b/crates/psrs-resolve/src/resolver/type_resolution.rs @@ -453,6 +453,7 @@ impl Resolver { name: name.text, name_span: name.span, kind, + compiler_class: None, parameters, constructors, members, diff --git a/crates/psrs-thir/src/evidence.rs b/crates/psrs-thir/src/evidence.rs index 98cf6197..f9aaf506 100644 --- a/crates/psrs-thir/src/evidence.rs +++ b/crates/psrs-thir/src/evidence.rs @@ -33,6 +33,10 @@ pub struct Evidence { #[derive(Clone, Debug, PartialEq, Eq)] pub enum EvidenceKind { + /// A compiler-constructed dictionary expressed as checked ordinary terms. + /// The verifier checks its fields, lexical scope, and dictionary type; + /// the frontend owns the class rule that authorizes construction. + DictionaryValue(Box), /// A dictionary parameter introduced by a constrained binding. Given(LocalId), /// A dictionary value already bound by the class elaborator. diff --git a/crates/psrs-thir/src/scope/mod.rs b/crates/psrs-thir/src/scope/mod.rs index cdc1f0b6..05bf57c1 100644 --- a/crates/psrs-thir/src/scope/mod.rs +++ b/crates/psrs-thir/src/scope/mod.rs @@ -432,6 +432,9 @@ fn verify_evidence_scope( errors, ); match &evidence.kind { + EvidenceKind::DictionaryValue(value) => { + verify_expr_scope(value, types, &mut scope.clone(), errors) + } EvidenceKind::Given(_) | EvidenceKind::Global(_) => {} EvidenceKind::Coercible { source_type, diff --git a/crates/psrs-thir/src/tests.rs b/crates/psrs-thir/src/tests.rs index 0b5a5fc1..e0d20644 100644 --- a/crates/psrs-thir/src/tests.rs +++ b/crates/psrs-thir/src/tests.rs @@ -441,3 +441,5 @@ fn verifier_rejects_coercion_evidence_for_a_different_boundary() { error.message == "coercion expression requires an explicit Coercible proof boundary" })); } + +mod constructed_dictionary; diff --git a/crates/psrs-thir/src/tests/constructed_dictionary.rs b/crates/psrs-thir/src/tests/constructed_dictionary.rs new file mode 100644 index 00000000..04d564fd --- /dev/null +++ b/crates/psrs-thir/src/tests/constructed_dictionary.rs @@ -0,0 +1,61 @@ +use super::*; + +#[test] +fn a_runtime_dictionary_cannot_authorize_a_coercion() { + let span = TextRange::new(0, 1); + let dictionary = Evidence { + kind: EvidenceKind::DictionaryValue(Box::new(Expr { + kind: ExprKind::Record(Vec::new()), + ty: TypeId(3), + span, + })), + class_id: psrs_hir::TypeId::COERCIBLE, + ty: TypeId(3), + span, + }; + let module = Module { + id: ModuleId(0), + name: "Main".into(), + type_names: Vec::new(), + externals: Vec::new(), + external_types: Vec::new(), + types: vec![ + Type::Constructor(TypeConstructor::Int), + Type::RowEmpty, + Type::Constructor(TypeConstructor::Record), + Type::Application(TypeId(2), TypeId(1)), + ], + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: vec![Declaration { + symbol: SymbolId::new(ModuleId(0), 0), + name: "main".into(), + name_span: span, + quantified: Vec::new(), + ty: TypeId(0), + span, + value: Expr { + kind: ExprKind::Coerce { + value: Box::new(Expr { + kind: ExprKind::Integer(42), + ty: TypeId(0), + span, + }), + evidence: dictionary, + source_type: TypeId(0), + target_type: TypeId(0), + }, + ty: TypeId(0), + span, + }, + }], + span, + }; + let errors = module + .verify() + .expect_err("dictionary terms are not proof boundaries"); + assert!(errors.iter().any(|error| error.message + == "coercion expression requires an explicit Coercible proof boundary")); +} diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index fb766d53..d1b2cf1a 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -236,6 +236,16 @@ fn verify_evidence(evidence: &Evidence, module: &Module, errors: &mut Vec { + verify_expr(value, module, errors); + if !semantics::types_equal(value.ty, evidence.ty, module) { + errors.push(VerifyError { + span: evidence.span, + message: "constructed evidence has the wrong dictionary type", + }); + } + } + EvidenceKind::Given(_) | EvidenceKind::Global(_) => {} EvidenceKind::Coercible { source_type, diff --git a/crates/psrs-thir/src/verify/semantics/mod.rs b/crates/psrs-thir/src/verify/semantics/mod.rs index 3a40cfe2..9b73e203 100644 --- a/crates/psrs-thir/src/verify/semantics/mod.rs +++ b/crates/psrs-thir/src/verify/semantics/mod.rs @@ -51,6 +51,22 @@ struct Context<'a> { } impl Context<'_> { + fn evidence(&mut self, evidence: &crate::Evidence) { + match &evidence.kind { + crate::EvidenceKind::DictionaryValue(value) => self.expr(value, Some(evidence.ty)), + crate::EvidenceKind::Superclass { parent, .. } => self.evidence(parent), + crate::EvidenceKind::Instance { context, .. } => { + for child in context { + self.evidence(child); + } + } + crate::EvidenceKind::Given(_) + | crate::EvidenceKind::Global(_) + | crate::EvidenceKind::Coercible { .. } + | crate::EvidenceKind::Primitive { .. } => {} + } + } + fn expr(&mut self, expression: &Expr, expected: Option) { if let Some(expected) = expected { self.compatible(expression.ty, expected, expression.span); @@ -147,7 +163,7 @@ impl Context<'_> { self.error(expression.span, "record field is not declared"); } } - ExprKind::Evidence(_) => {} + ExprKind::Evidence(evidence) => self.evidence(evidence), ExprKind::Coerce { value, source_type, diff --git a/crates/psrs-typecheck/src/typecheck/classes/environment/compiler.rs b/crates/psrs-typecheck/src/typecheck/classes/environment/compiler.rs new file mode 100644 index 00000000..5e79a99f --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/classes/environment/compiler.rs @@ -0,0 +1,76 @@ +use super::*; + +impl Checker { + pub(super) fn validate_compiler_class( + &mut self, + declaration: &hir::TypeDeclaration, + ) -> Option { + let identity = declaration.compiler_class?; + let valid = match identity { + hir::CompilerClass::IsSymbol => self.valid_symbol_interface(declaration, identity), + }; + if valid { + Some(identity) + } else { + self.state.errors.push(TypeCheckError::new( + TypeCheckErrorKind::UnsupportedClass, + declaration.span, + "compiler class declaration does not match its dictionary contract", + )); + None + } + } + + fn valid_symbol_interface( + &mut self, + declaration: &hir::TypeDeclaration, + identity: hir::CompilerClass, + ) -> bool { + if declaration.parameters.len() != 1 + || !declaration.superclasses.is_empty() + || !declaration.fundeps.is_empty() + || declaration.members.len() != 1 + || declaration.members[0].name != identity.method() + { + return false; + } + let Some(kind) = self.env.checked_kinds.kind_scheme(declaration.id).cloned() else { + return false; + }; + let Kind::Function(parameter_kind, _) = self.instantiate_kind_scheme(&kind) else { + return false; + }; + if *parameter_kind != Kind::Builtin(hir::BuiltinType::Symbol) { + return false; + } + let Some(signature) = declaration.members[0].signature.as_ref() else { + return false; + }; + let argument = self.fresh(); + let InferType::Variable(id) = argument else { + unreachable!() + }; + self.record_variable_kind(id, *parameter_kind); + self.with_skolem_scope(&[id], |checker| { + let mut variables = + HashMap::from([(declaration.parameters[0].name.clone(), argument.clone())]); + let ty = checker.elaborate_type_mode(signature, &mut variables, true); + let ty = checker.resolve_type(ty); + // Validate the elaborated contract, so synonyms and imported aliases + // receive exactly the same treatment as the written arrow. + let InferType::Application(function, result) = ty else { + return false; + }; + let InferType::Application(head, parameter) = *function else { + return false; + }; + let InferType::Application(proxy, parameter_argument) = *parameter else { + return false; + }; + *head == InferType::Constructor(TypeConstructor::Function) + && *result == InferType::Constructor(TypeConstructor::String) + && matches!(*proxy, InferType::Constructor(TypeConstructor::User(_))) + && *parameter_argument == argument + }) + } +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs index 5015a04b..c6179110 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/environment/mod.rs @@ -2,6 +2,7 @@ use super::super::signature::flatten_spine; use super::super::*; use super::deriving::{KnownClass, contains_wildcard}; use super::fundeps::collect_infer_variables; +mod compiler; mod method; use method::validate_method_signature; @@ -29,6 +30,7 @@ impl Checker { self.env.classes.insert( hir::TypeId::COERCIBLE, ClassInfo { + compiler_class: None, parameters: vec!["source".to_owned(), "target".to_owned()], superclasses: Vec::new(), fundeps: Vec::new(), @@ -83,9 +85,11 @@ impl Checker { .insert(member.symbol, (declaration.id, method.clone())); methods.push(method); } + let compiler_class = self.validate_compiler_class(declaration); self.env.classes.insert( declaration.id, ClassInfo { + compiler_class, parameters, superclasses: Vec::new(), fundeps, diff --git a/crates/psrs-typecheck/src/typecheck/classes/evidence/finalize.rs b/crates/psrs-typecheck/src/typecheck/classes/evidence/finalize.rs index 07f5c3ef..8603a324 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/evidence/finalize.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/evidence/finalize.rs @@ -128,6 +128,9 @@ impl Checker { generics: &HashSet, ) -> Option { Some(match solution { + WantedSolution::DictionaryValue(value) => thir::EvidenceKind::DictionaryValue( + Box::new(self.finalize_expr(*value, interner, generics)?), + ), WantedSolution::Given(id) | WantedSolution::Abstracted(id) => { thir::EvidenceKind::Given(id) } diff --git a/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs index 59b9ee84..f4770ecb 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs @@ -97,7 +97,10 @@ impl Checker { } } -pub(super) fn record_field_type(record: &InferType, wanted: &str) -> Option { +pub(in crate::typecheck) fn record_field_type( + record: &InferType, + wanted: &str, +) -> Option { let mut row = super::super::record_row(record)?; loop { match row { diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs index 4e04fd1a..bc5524f4 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/support.rs @@ -23,7 +23,8 @@ pub(super) fn solution_uses_lexical_given( }), // An abstracted dictionary is a parameter of the declaration itself, so // it determines nothing the result type and the dependencies do not. - WantedSolution::Global(_) + WantedSolution::DictionaryValue(_) + | WantedSolution::Global(_) | WantedSolution::Abstracted(_) | WantedSolution::Coercible { .. } | WantedSolution::Primitive { .. } => false, diff --git a/crates/psrs-typecheck/src/typecheck/classes/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/mod.rs index 2a45b9d5..e7fe51bd 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/mod.rs @@ -12,6 +12,7 @@ mod coherence; mod deriving; mod environment; mod evidence; +pub(in crate::typecheck) use evidence::record_field_type; mod fundeps; mod instance; mod locals; diff --git a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs index 0a0d2955..09c7a3fc 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs @@ -2,10 +2,7 @@ //! rule's entry into it. use super::super::super::prim::requeue::RequeueChain; -use super::super::super::prim::{ - PrimitiveDispatch, is_report_only, primitive_rule_precedes_givens, - primitive_rule_skips_given_lookup, -}; +use super::super::super::prim::{PrimitiveDispatch, is_report_only}; use super::super::super::unify::substitute; use super::super::fundeps::collect_infer_variables; use super::entry::{SolveDepth, UnsolvedPolicy}; @@ -14,14 +11,10 @@ impl Checker { /// Solves one wanted constraint, consulting givens, the primitive rule /// table, and instance search in that order. /// - /// The order is the one the primitive design fixes, and the one place it - /// varies is where a `Proof` member's rule is consulted: - /// [`primitive_rule_precedes_givens`] is the predicate, and it is false for - /// every other member. A `Proof` member's evidence is a checked boundary - /// rather than a dictionary, so a matching given cannot supply it — THIR - /// rejects a coercion whose evidence is not an explicit proof boundary — and - /// the rule has to derive the proof before the givens are consulted, which is - /// also what official solving does. + /// The registered rule's evidence classification owns its position. Proof + /// boundaries and runtime relation dictionaries precede givens; report rules + /// may propagate through a lexical dictionary first. A declined rule leaves + /// the ordinary given, superclass, and instance paths available. /// /// An instance's context is solved recursively before the instance is /// selected. @@ -49,8 +42,13 @@ impl Checker { } let class_id = constraint.class_id; let arguments = constraint.arguments.clone(); - let solves_before_givens = primitive_rule_precedes_givens(class_id); - let skips_given_lookup = primitive_rule_skips_given_lookup(class_id); + let rule = self.registered_primitive_rule(class_id); + let solves_before_givens = rule + .as_ref() + .is_some_and(|rule| rule.evidence.precedes_givens()); + let skips_given_lookup = rule + .as_ref() + .is_some_and(|rule| !rule.evidence.accepts_a_given()); // Relation rules precede ordinary dictionary lookup, as in // Entailment.hs:204-223. A checked proof also precedes givens, but its diff --git a/crates/psrs-typecheck/src/typecheck/generalize/body.rs b/crates/psrs-typecheck/src/typecheck/generalize/body.rs index 803db947..a6af5e8a 100644 --- a/crates/psrs-typecheck/src/typecheck/generalize/body.rs +++ b/crates/psrs-typecheck/src/typecheck/generalize/body.rs @@ -155,6 +155,9 @@ impl Checker { self.collect_implementation_type(ty, level, out); } match solution { + WantedSolution::DictionaryValue(value) => { + self.collect_body_variables(value, level, out) + } WantedSolution::Instance { constructor_type, context, diff --git a/crates/psrs-typecheck/src/typecheck/prim/dispatch.rs b/crates/psrs-typecheck/src/typecheck/prim/dispatch.rs index 97a9e272..38d37d78 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/dispatch.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/dispatch.rs @@ -44,7 +44,7 @@ impl Checker { policy: UnsolvedPolicy, chain: &mut RequeueChain, ) -> PrimitiveDispatch { - let Some(rule) = primitive_rule(constraint.class_id) else { + let Some(rule) = self.registered_primitive_rule(constraint.class_id) else { return PrimitiveDispatch::None; }; // A wanted constraint whose arguments are not the member's own is not @@ -62,7 +62,7 @@ impl Checker { self.improve_one(&mut improved); let snapshot = self.state.snapshot(); let outcome = self.call_rule( - rule, + &rule, &PrimitiveArgs { constraint: &improved, }, diff --git a/crates/psrs-typecheck/src/typecheck/prim/mod.rs b/crates/psrs-typecheck/src/typecheck/prim/mod.rs index f2537469..b715eed7 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/mod.rs @@ -23,6 +23,7 @@ mod coercible; mod compare; mod dispatch; mod int; +mod reflection; mod reports; pub(in crate::typecheck) mod requeue; mod row; @@ -58,7 +59,7 @@ impl EvidenceClass { /// dictionary can mask them. A report runs after givens so `Warn`, `Fail`, /// and `Partial` can propagate through an enclosing constraint. A proof /// runs first because a dictionary is not the proof boundary Core expects. - fn precedes_givens(self) -> bool { + pub(in crate::typecheck) fn precedes_givens(self) -> bool { matches!( self, EvidenceClass::CompileTimeProof | EvidenceClass::RuntimeDictionary @@ -69,7 +70,7 @@ impl EvidenceClass { /// /// `Coercible` is a checked proof boundary, so a given dictionary cannot /// discharge it. Its rule reads and composes proof givens itself. - fn accepts_a_given(self) -> bool { + pub(in crate::typecheck) fn accepts_a_given(self) -> bool { matches!( self, EvidenceClass::RuntimeDictionary @@ -80,6 +81,7 @@ impl EvidenceClass { } /// One primitive rule, as the table records it. +#[derive(Clone, Copy)] pub(in crate::typecheck) struct PrimitiveRule { /// The class identity the rule decides, and the key of its table entry. A /// qualification, an alias, or a re-export reaches the same identity, so @@ -94,9 +96,11 @@ pub(in crate::typecheck) struct PrimitiveRule { solve: fn(&mut Checker, &PrimitiveArgs) -> PrimitiveOutcome, } -/// The rules that exist. Every member with a rule appears here and nowhere -/// else, so adding a relation is a table entry and a rule function rather than -/// a branch at the dispatch site. +/// Rules for the compiler-owned `Prim` declaration inventory. Source library +/// interfaces enter the same dispatch through `registered_primitive_rule`, +/// after their interface identity and dictionary contract have been checked. +/// Adding a relation extends its owning registry and rule implementation, never +/// a source-name branch at the solving site. /// /// A member with no entry reaches instance search, and a member whose rule /// declines continues into instance search: a relation never depends on an @@ -148,6 +152,11 @@ pub(in crate::typecheck) fn is_report_only(class_id: hir::TypeId) -> bool { /// erases and records the arguments the rule decided, and a report has none. #[derive(Clone, Debug)] pub(in crate::typecheck) enum PrimitiveEvidence { + /// An ordinary checked dictionary whose methods have runtime values. + DictionaryValue { + arguments: Vec, + value: Box, + }, /// A checked boundary with no runtime value, recording the types it /// connects. Proof { @@ -183,6 +192,9 @@ impl PrimitiveEvidence { PrimitiveEvidence::Dictionary { arguments } => { Some(WantedSolution::Primitive { arguments }) } + PrimitiveEvidence::DictionaryValue { value, .. } => { + Some(WantedSolution::DictionaryValue(value)) + } PrimitiveEvidence::Report => None, } } @@ -288,13 +300,19 @@ pub(in crate::typecheck) enum PrimitiveDispatch { /// The evidence classification owns this position: type-level relations and /// proof boundaries precede givens; reports run after givens so they can /// propagate or emit their diagnostic at the unresolved boundary. +#[cfg(test)] pub(in crate::typecheck) fn primitive_rule_precedes_givens(class_id: hir::TypeId) -> bool { primitive_rule(class_id).is_some_and(|rule| rule.evidence.precedes_givens()) } -/// Whether a direct lexical given is forbidden from supplying this member's -/// evidence. `Coercible` is the only such member: its proof rule can consume -/// givens but must produce a verified proof boundary. -pub(in crate::typecheck) fn primitive_rule_skips_given_lookup(class_id: hir::TypeId) -> bool { - primitive_rule(class_id).is_some_and(|rule| !rule.evidence.accepts_a_given()) +impl Checker { + pub(in crate::typecheck) fn registered_primitive_rule( + &self, + class_id: hir::TypeId, + ) -> Option { + primitive_rule(class_id).copied().or_else(|| { + let identity = self.env.classes.get(&class_id)?.compiler_class?; + Some(reflection::rule(class_id, identity)) + }) + } } diff --git a/crates/psrs-typecheck/src/typecheck/prim/reflection.rs b/crates/psrs-typecheck/src/typecheck/prim/reflection.rs new file mode 100644 index 00000000..13e598fb --- /dev/null +++ b/crates/psrs-typecheck/src/typecheck/prim/reflection.rs @@ -0,0 +1,65 @@ +//! Runtime dictionaries for designated, validated library interfaces. +use super::*; +use crate::typecheck::classes::record_field_type; + +pub(super) fn rule(class_id: hir::TypeId, identity: hir::CompilerClass) -> PrimitiveRule { + match identity { + hir::CompilerClass::IsSymbol => PrimitiveRule { + class_id, + evidence: EvidenceClass::RuntimeDictionary, + arity: 1, + solve: is_symbol, + }, + } +} + +fn is_symbol(checker: &mut Checker, args: &PrimitiveArgs) -> PrimitiveOutcome { + let arguments = args.resolved(checker); + let [InferType::TypeLevelString(value)] = arguments.as_slice() else { + return PrimitiveOutcome::Undecided; + }; + let field = hir::CompilerClass::IsSymbol.method(); + let dictionary_type = checker.resolve_type(args.constraint.dictionary_type.clone()); + let Some(method_type) = record_field_type(&dictionary_type, field) else { + return PrimitiveOutcome::Undecided; + }; + let InferType::Application(function, _) = &method_type else { + return PrimitiveOutcome::Undecided; + }; + let InferType::Application(_, parameter) = function.as_ref() else { + return PrimitiveOutcome::Undecided; + }; + let span = args.span(); + let id = LocalId(checker.state.next_dictionary_local); + checker.state.next_dictionary_local += 1; + let method = InferredExpr { + kind: InferredExprKind::Lambda { + binder: InferredBinder { + binder: hir::LocalBinder { + id, + name: "$reflect".into(), + span, + }, + scheme: Scheme::monomorphic(parameter.as_ref().clone()), + }, + body: Box::new(InferredExpr { + kind: InferredExprKind::String(value.clone()), + ty: InferType::Constructor(TypeConstructor::String), + span, + }), + }, + ty: method_type, + span, + }; + PrimitiveOutcome::Solved { + evidence: PrimitiveEvidence::DictionaryValue { + arguments, + value: Box::new(InferredExpr { + kind: InferredExprKind::Record(vec![(field.into(), method)]), + ty: dictionary_type, + span, + }), + }, + deferred: Vec::new(), + } +} diff --git a/crates/psrs-typecheck/src/typecheck/prim/verify.rs b/crates/psrs-typecheck/src/typecheck/prim/verify.rs index 7909be23..15a73523 100644 --- a/crates/psrs-typecheck/src/typecheck/prim/verify.rs +++ b/crates/psrs-typecheck/src/typecheck/prim/verify.rs @@ -55,8 +55,10 @@ impl Checker { args: &PrimitiveArgs, evidence: &PrimitiveEvidence, ) -> bool { - let PrimitiveEvidence::Dictionary { arguments } = evidence else { - return true; + let arguments = match evidence { + PrimitiveEvidence::Dictionary { arguments } + | PrimitiveEvidence::DictionaryValue { arguments, .. } => arguments, + _ => return true, }; let wanted = args.resolved(self); let span = args.span(); @@ -73,6 +75,18 @@ impl Checker { return None; } } + if let PrimitiveEvidence::DictionaryValue { value, .. } = evidence { + let errors_before = checker.state.errors.len(); + checker.unify( + value.ty.clone(), + args.constraint.dictionary_type.clone(), + span, + ); + if checker.state.errors.len() > errors_before { + checker.state.errors.truncate(errors_before + 1); + return None; + } + } Some(()) }) .is_some() diff --git a/crates/psrs-typecheck/src/typecheck/tests/rows.rs b/crates/psrs-typecheck/src/typecheck/tests/rows.rs index 51e13e25..7d9bc19c 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/rows.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/rows.rs @@ -109,6 +109,7 @@ fn synonym(id: u32, name: &str, parameters: &[&str], body: HirType) -> psrs_hir: name: name.into(), name_span: TextRange::new(0, 1), kind: psrs_hir::TypeDeclarationKind::TypeSynonym, + compiler_class: None, parameters: parameters .iter() .map(|parameter| psrs_hir::TypeParameter { diff --git a/crates/psrs-typecheck/src/typecheck/tests/type_level_literals.rs b/crates/psrs-typecheck/src/typecheck/tests/type_level_literals.rs index b8094999..7b69ffe5 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/type_level_literals.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/type_level_literals.rs @@ -28,6 +28,7 @@ fn proxy_declaration() -> hir::TypeDeclaration { name: "Proxy".into(), name_span: TextRange::new(0, 5), kind: hir::TypeDeclarationKind::Data, + compiler_class: None, parameters: vec![psrs_hir::TypeParameter { name: "a".into(), name_span: TextRange::new(6, 7), diff --git a/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs b/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs index 08bb63f2..4fb821c2 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/user_types/mod.rs @@ -223,6 +223,7 @@ fn synonym(id: u32, name: &str, parameters: &[&str], body: HirType) -> psrs_hir: name: name.into(), name_span: TextRange::new(0, 1), kind: psrs_hir::TypeDeclarationKind::TypeSynonym, + compiler_class: None, parameters: parameters .iter() .map(|parameter| psrs_hir::TypeParameter { @@ -368,6 +369,7 @@ fn data_declaration( name: name.into(), name_span: TextRange::new(0, 1), kind: psrs_hir::TypeDeclarationKind::Data, + compiler_class: None, parameters: parameters .iter() .map(|parameter| psrs_hir::TypeParameter { diff --git a/crates/psrs-typecheck/src/typecheck/vocabulary.rs b/crates/psrs-typecheck/src/typecheck/vocabulary.rs index 424aac48..8fb262e4 100644 --- a/crates/psrs-typecheck/src/typecheck/vocabulary.rs +++ b/crates/psrs-typecheck/src/typecheck/vocabulary.rs @@ -87,6 +87,7 @@ pub(super) struct FundepInfo { /// functional dependencies. #[derive(Clone, Debug)] pub(super) struct ClassInfo { + pub(super) compiler_class: Option, pub(super) parameters: Vec, pub(super) superclasses: Vec, pub(super) fundeps: Vec, @@ -117,6 +118,8 @@ pub(super) struct InstanceInfo { /// whose dictionaries it applies the constructor to. #[derive(Clone, Debug)] pub(super) enum WantedSolution { + /// A compiler-constructed dictionary with checked ordinary term fields. + DictionaryValue(Box), Given(LocalId), Global(SymbolId), Instance { diff --git a/docs/design/frontend/type-system/classes-and-evidence.md b/docs/design/frontend/type-system/classes-and-evidence.md index 7cf1d4a3..191547b0 100644 --- a/docs/design/frontend/type-system/classes-and-evidence.md +++ b/docs/design/frontend/type-system/classes-and-evidence.md @@ -103,6 +103,18 @@ relation, not a raw Wasm cast: array elements, functions, records, and ADT payloads follow their established conversion plans, and unsupported conversion shapes fail lowering. +Compiler-supported library class interfaces have one declared registration in +`psrs-hir`'s compiler-interface catalog. Resolution links the canonical export +to its normal source declaration identity; qualification, aliases, and +re-exports retain that identity. This is an explicit language/library interface +binding, not recognition by class shape. P5 validates the parameter kinds and +elaborated dictionary contract before enabling synthesis. The solver dispatches +on that recorded identity and never on a function name or the spelling of a +literal. A synthesized runtime dictionary retains its checked ordinary terms as +`DictionaryValue` evidence until Core lowers them. THIR checks those terms and +their dictionary type; it trusts the frontend's registered class rule for the +semantic authorization, as it trusts ordinary instance selection. + Type-level `Symbol` values use the same Unicode scalar sequence as source strings ([DEC-16](../../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). `IsSymbol` evidence and `Reflectable` preserve or produce that sequence. diff --git a/docs/design/frontend/type-system/prim.md b/docs/design/frontend/type-system/prim.md index 9df64505..bd5fded0 100644 --- a/docs/design/frontend/type-system/prim.md +++ b/docs/design/frontend/type-system/prim.md @@ -258,9 +258,26 @@ constraint and a source `import Prim (Partial)` therefore reach `TypeId::PRIM_PARTIAL`, and `purs` reads the same kind for `Partial` as this compiler does. -Type-level `Reflectable` and `IsSymbol` relations exist in later official versions -and are not part of the inventory above; adding a member is a registry change -with the same requirements as any other. +`Data.Symbol.IsSymbol` is a compiler-supported library interface rather than a +member of the `Prim` declaration inventory. The shared compiler-interface +registry owns its canonical export binding alongside `Safe.Coerce` and +`Unsafe.Coerce`; P3 associates the source declaration's ordinary `TypeId` with +the registered class identity. The source module and its exports still resolve +normally. P5 validates the checked parameter kind and elaborated method contract +before registering a rule for that resolved identity. Synonyms and import +aliases do not change the contract, and an unrelated user class with the same +spelling receives no rule. + +A known Symbol literal produces a runtime dictionary whose `reflectSymbol` +method returns that literal's Unicode scalar sequence. The primitive framework +checks both its decided arguments and its dictionary type. `DictionaryValue` +evidence retains the ordinary typed record and method lambda; THIR verifies +their types and lexical scope, and Core lowers the terms through the normal +expression path. Unknown symbols decline the rule and may use lexical givens +or ordinary instances; no default symbol is chosen. Runtime dictionaries never +authorize a `Coercible` conversion. `Reflectable` remains outside this +compiler-interface registry; its current library instances use ordinary class +solving. Implementation coverage belongs in [D-04](../../D-04-suite-roadmap.md). A rule for a member whose shared foundations are incomplete is not a local shortcut: the argument types it needs must participate in ordinary instantiation, substitution, unification, generalization, and scope checking first, and a rule that cannot satisfy that reports the limitation rather than approximating the member with a private path. From a5c05250eff1c6476d3e4810e5a5e620f548db57 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 14:19:48 +0800 Subject: [PATCH 035/148] Clean up compiler and test lint across all targets --- .../src/cc/layout/functions/mod.rs | 3 +- crates/psrs-backend/src/cc/layout/scalar.rs | 28 ++----------------- .../psrs-backend/src/cc/layout/tests/mod.rs | 2 +- crates/psrs-backend/src/lib.rs | 7 +++-- crates/psrs-backend/src/pipeline/mod.rs | 5 +++- crates/psrs-driver/src/program/compilation.rs | 4 +-- .../psrs-driver/src/tests/diagnosis_trace.rs | 6 ++-- crates/psrs-driver/src/tests/module_loader.rs | 2 +- .../src/tests/symbol_reflection.rs | 2 +- .../tests/pattern_support/support.rs | 22 ++++++++++----- crates/psrs-driver/tests/suite/corpus/mod.rs | 8 ------ crates/psrs-typecheck/src/typecheck/state.rs | 2 +- 12 files changed, 37 insertions(+), 54 deletions(-) diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index 49c89225..1b82e8aa 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -7,7 +7,6 @@ use std::collections::{HashMap, HashSet}; mod reachable; -use super::scalar::function_parameter_shape; use reachable::referenced_types; pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { @@ -114,7 +113,7 @@ pub(crate) fn function_signature( let parameters = parameter_ids .into_iter() .map(|parameter| { - function_parameter_shape( + scalar_type( module, parameter, module.span, diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index ee233c5e..05b674a3 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -43,7 +43,7 @@ pub(crate) fn declaration_shape( "lambda binder type differs from the function parameter type", )]); } - parameters.push(function_parameter_shape( + parameters.push(scalar_type( module, binder.ty, binder.span, @@ -84,7 +84,7 @@ pub(crate) fn declaration_shape( )]); } ty = result; - parameters.push(function_parameter_shape( + parameters.push(scalar_type( module, binder.ty, binder.span, @@ -404,30 +404,6 @@ pub(crate) fn scalar_type( } } -pub(super) fn function_parameter_shape( - module: &CoreModule, - ty: TypeId, - span: TextRange, - enum_types: &HashSet, - aggregate_types: &HashSet, - newtype_ids: &HashSet, - array_types: &HashMap, - record_types: &HashMap, - function_types: &HashMap, -) -> Result> { - scalar_type( - module, - ty, - span, - enum_types, - aggregate_types, - newtype_ids, - array_types, - record_types, - function_types, - ) -} - fn erased_reference() -> ValueShape { ValueShape::Reference(Reference { nullable: false, diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index bf57dad7..0afbae9e 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -184,7 +184,7 @@ fn bound_rank_n_record_fields_do_not_make_dictionary_layout_dependent() { fn parameter_shape(module: &Module, ty: TypeId, representation: ReprId) -> ValueShape { let record_types = HashMap::from([(ty, representation)]); - super::scalar::function_parameter_shape( + super::scalar::scalar_type( module, ty, module.span, diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 25c3b979..fca133da 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -204,7 +204,7 @@ pub struct PartialStages { #[derive(Clone, Debug)] pub struct CompileFailure { pub errors: Vec, - pub partial: PartialStages, + pub partial: Box, } /// Normal backend result together with the pass/artifact events observed while @@ -259,5 +259,8 @@ pub fn compile_with_context_capturing( ) -> Result { let mut partial = PartialStages::default(); pipeline::compile_with_context_inner(module, effect_context, target, Some(&mut partial), None) - .map_err(|errors| CompileFailure { errors, partial }) + .map_err(|errors| CompileFailure { + errors, + partial: Box::new(partial), + }) } diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs index be11f043..2a5e3e75 100644 --- a/crates/psrs-backend/src/pipeline/mod.rs +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -373,6 +373,9 @@ pub(crate) fn compile_with_context_traced( capture_partial.then_some(&mut partial), Some(&mut trace), ) - .map_err(|errors| CompileFailure { errors, partial }); + .map_err(|errors| CompileFailure { + errors, + partial: Box::new(partial), + }); (result, trace.finish()) } diff --git a/crates/psrs-driver/src/program/compilation.rs b/crates/psrs-driver/src/program/compilation.rs index 6911883c..a2f58fd3 100644 --- a/crates/psrs-driver/src/program/compilation.rs +++ b/crates/psrs-driver/src/program/compilation.rs @@ -97,7 +97,7 @@ fn compile_attempt( Err(failure) => { let (dumps, dump_artifacts) = if capture_dumps { partial_dumps( - failure.partial, + *failure.partial, linked_core.expect("dump capture retained linked Core"), Some(&traced.trace), ) @@ -123,7 +123,7 @@ fn compile_attempt( ) { Ok(stages) => stages, Err(failure) => { - let (dumps, _) = partial_dumps(failure.partial, linked_core, None); + let (dumps, _) = partial_dumps(*failure.partial, linked_core, None); return CompilationReport::failed(backend_diagnostics(failure.errors), dumps); } }; diff --git a/crates/psrs-driver/src/tests/diagnosis_trace.rs b/crates/psrs-driver/src/tests/diagnosis_trace.rs index 723a48bf..76d7f559 100644 --- a/crates/psrs-driver/src/tests/diagnosis_trace.rs +++ b/crates/psrs-driver/src/tests/diagnosis_trace.rs @@ -125,8 +125,10 @@ fn frontend_rejection_has_diagnostics_but_no_backend_trace_or_core_output() { fn target_rejection_keeps_prior_artifacts_and_maps_errors_to_its_execution() { let prepared = crate::prepare_sources(&[("Main.purs", "module Main where\nmain = 42\n")]) .expect("frontend should produce checked Core"); - let mut target = psrs_backend::TargetCapabilities::default(); - target.component_model = false; + let target = psrs_backend::TargetCapabilities { + component_model: false, + ..Default::default() + }; let traced = psrs_backend::compile_with_context_traced( prepared.core, prepared.effect_context, diff --git a/crates/psrs-driver/src/tests/module_loader.rs b/crates/psrs-driver/src/tests/module_loader.rs index 79ae6db4..75b2da80 100644 --- a/crates/psrs-driver/src/tests/module_loader.rs +++ b/crates/psrs-driver/src/tests/module_loader.rs @@ -98,7 +98,7 @@ fn loads_the_standard_library_from_disk_in_trusted_order() { .map(|module| module.module_name.as_str()) .collect::>(); assert_eq!(names.first().copied(), Some("Prelude")); - assert!(names.iter().any(|name| *name == "WASI")); + assert!(names.contains(&"WASI")); assert_eq!( names.len(), names.iter().collect::>().len(), diff --git a/crates/psrs-driver/src/tests/symbol_reflection.rs b/crates/psrs-driver/src/tests/symbol_reflection.rs index 36c33123..1f3237c0 100644 --- a/crates/psrs-driver/src/tests/symbol_reflection.rs +++ b/crates/psrs-driver/src/tests/symbol_reflection.rs @@ -49,7 +49,7 @@ main = reflectSymbol (Proxy :: Proxy "unicode") assert!( errors .iter() - .any(|error| error.diagnostic.code.as_deref() == Some("NoInstanceFound")), + .any(|error| error.diagnostic.code == Some("NoInstanceFound")), "{errors:?}" ); } diff --git a/crates/psrs-driver/tests/pattern_support/support.rs b/crates/psrs-driver/tests/pattern_support/support.rs index 90169950..645d1500 100644 --- a/crates/psrs-driver/tests/pattern_support/support.rs +++ b/crates/psrs-driver/tests/pattern_support/support.rs @@ -1,4 +1,16 @@ -use psrs_ast::{Expr, ExprKind, Guard, Pattern, PatternKind, Type, TypeKind}; +use psrs_ast::{ + Expr, ExprKind, Guard, Pattern, PatternKind, RecordUpdateField, RecordUpdateValue, Type, + TypeKind, +}; + +fn visit_update_expressions<'a>(fields: &'a [RecordUpdateField], visit: &mut impl FnMut(&'a Expr)) { + for field in fields { + match &field.value { + RecordUpdateValue::Expression(value) => visit(value), + RecordUpdateValue::Nested { fields, .. } => visit_update_expressions(fields, visit), + } + } +} pub(super) fn type_contains_wildcard(ty: &Type) -> bool { match &ty.kind { @@ -59,9 +71,7 @@ pub(super) fn visit_expr_patterns<'a>(expression: &'a Expr, output: &mut Vec<&'a } ExprKind::RecordUpdate { expression, fields } => { visit_expr_patterns(expression, output); - for (_, value) in fields { - visit_expr_patterns(value, output); - } + visit_update_expressions(fields, &mut |value| visit_expr_patterns(value, output)); } ExprKind::Application(function, argument) | ExprKind::Operator { @@ -147,9 +157,7 @@ pub(super) fn visit_expr_guards<'a>(expression: &'a Expr, output: &mut Vec<&'a G } ExprKind::RecordUpdate { expression, fields } => { visit_expr_guards(expression, output); - for (_, value) in fields { - visit_expr_guards(value, output); - } + visit_update_expressions(fields, &mut |value| visit_expr_guards(value, output)); } ExprKind::Application(function, argument) | ExprKind::Operator { diff --git a/crates/psrs-driver/tests/suite/corpus/mod.rs b/crates/psrs-driver/tests/suite/corpus/mod.rs index 2b636488..ea883332 100644 --- a/crates/psrs-driver/tests/suite/corpus/mod.rs +++ b/crates/psrs-driver/tests/suite/corpus/mod.rs @@ -128,14 +128,6 @@ pub fn load_case(path: &Path, category_dir: &Path, text: &str) -> Case { } } -/// The main source plus the modules in a sibling directory named after the file -/// stem, which is how the corpus supplies a case's support modules. -pub fn own_sources(path: &Path, text: &str) -> Vec<(String, String)> { - psrs_driver::load_program_case_sources(path, path.parent().unwrap_or(Path::new(".")), text) - .map(|sources| sources.own) - .unwrap_or_else(|_| vec![(path.to_string_lossy().into_owned(), text.to_owned())]) -} - /// Why a case is blocked, split so the phase that recovers it is visible. #[derive(Clone, Debug, PartialEq, Eq)] pub enum Blocker { diff --git a/crates/psrs-typecheck/src/typecheck/state.rs b/crates/psrs-typecheck/src/typecheck/state.rs index 09e42f06..c888f838 100644 --- a/crates/psrs-typecheck/src/typecheck/state.rs +++ b/crates/psrs-typecheck/src/typecheck/state.rs @@ -230,7 +230,7 @@ impl Checker { self.scope.givens.extend(givens); let previous_rigid = self.state.rigid.clone(); let previous_given_rigid = std::mem::take(&mut self.scope.given_rigid); - for (constraint, _) in self.scope.givens[previous_givens.len()..].to_vec() { + for (constraint, _) in &self.scope.givens[previous_givens.len()..] { for argument in &constraint.arguments { let mut variables = HashSet::new(); classes::collect_infer_variables(argument, &mut variables); From b926fb8a4d8a4b0a715e532db03371959aae20aa Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 15:44:43 +0800 Subject: [PATCH 036/148] Restore official stdlib sources and preserve library foreign contracts --- AGENTS.md | 21 + crates/psrs-ast/src/lib.rs | 15 +- crates/psrs-backend/src/bindings/mod.rs | 31 + crates/psrs-core/src/verify/mod.rs | 4 +- crates/psrs-driver/src/program/signatures.rs | 4 +- .../psrs-driver/src/tests/library_foreign.rs | 114 + crates/psrs-driver/src/tests/mod.rs | 1 + .../tests/upstream/library_foreign.rs | 36 + crates/psrs-driver/tests/upstream/mod.rs | 1 + crates/psrs-hir/src/lib.rs | 11 + .../src/resolver/module_resolution.rs | 58 +- crates/psrs-resolve/src/resolver/names/mod.rs | 12 +- .../src/resolver/program/interface.rs | 2 +- crates/psrs-thir/src/external_type_tests.rs | 11 + crates/psrs-thir/src/verify/mod.rs | 3 +- crates/psrs-typecheck/src/typecheck/entry.rs | 8 +- .../psrs-typecheck/src/typecheck/infer/mod.rs | 4 +- .../backend/wasm/primitive-ffi-and-stdlib.md | 8 + .../frontend/semantics/foreign-imports.md | 27 +- .../vendor-audit-2026-10-06/inventory.json | 7155 +++++++++++++++++ .../stdlib/vendor-audit-2026-10-06/modules.md | 226 + .../official-vs-vendored.diff | 3821 +++++++++ .../stdlib/vendor-audit-2026-10-06/report.md | 291 + .../foreign-bindings.json | 2206 +++++ .../foreign-bindings.md | 59 + .../inventory.json | 5101 ++++++++++++ .../vendor-restoration-2026-10-06/modules.md | 221 + .../official-vs-vendored.diff | 261 + .../vendor-restoration-2026-10-06/report.md | 122 + docs/workflow/stdlib-vendoring.md | 90 + docs/workflow/tools/audit-stdlib-vendor.py | 233 + stdlib/lib/Control/Apply.purs | 17 +- stdlib/lib/Control/Bind.purs | 10 +- stdlib/lib/Control/Extend.purs | 3 +- stdlib/lib/Control/Monad/ST/Internal.purs | 33 +- stdlib/lib/Control/Monad/ST/Uncurried.purs | 82 +- stdlib/lib/Data/Array.purs | 132 +- stdlib/lib/Data/Array/NonEmpty/Internal.purs | 17 +- stdlib/lib/Data/Array/ST.purs | 65 +- stdlib/lib/Data/Array/ST/Partial.purs | 6 +- stdlib/lib/Data/Bounded.purs | 18 +- stdlib/lib/Data/Enum.purs | 6 +- stdlib/lib/Data/Eq.purs | 45 +- stdlib/lib/Data/EuclideanRing.purs | 21 +- stdlib/lib/Data/Foldable.purs | 8 +- stdlib/lib/Data/Function/Uncurried.purs | 60 +- stdlib/lib/Data/Functor.purs | 18 +- stdlib/lib/Data/FunctorWithIndex.purs | 3 +- stdlib/lib/Data/HeytingAlgebra.purs | 15 +- stdlib/lib/Data/HeytingAlgebra/Generic.purs | 2 +- stdlib/lib/Data/Int.purs | 30 +- stdlib/lib/Data/Int/Bits.purs | 21 +- stdlib/lib/Data/Lazy.purs | 6 +- stdlib/lib/Data/Number.purs | 75 +- stdlib/lib/Data/Number/Format.purs | 12 +- stdlib/lib/Data/Ord.purs | 91 +- stdlib/lib/Data/Reflectable.purs | 3 +- stdlib/lib/Data/Ring.purs | 9 +- stdlib/lib/Data/Ring/Generic.purs | 2 +- stdlib/lib/Data/Semigroup.purs | 10 +- stdlib/lib/Data/Semiring.purs | 18 +- stdlib/lib/Data/Semiring/Generic.purs | 2 +- stdlib/lib/Data/Show.purs | 337 +- stdlib/lib/Data/Show/Generic.purs | 9 +- stdlib/lib/Data/String/CodePoints.purs | 46 +- stdlib/lib/Data/String/CodeUnits.purs | 76 +- stdlib/lib/Data/String/Common.purs | 30 +- stdlib/lib/Data/String/Regex.purs | 51 +- stdlib/lib/Data/String/Unsafe.purs | 6 +- stdlib/lib/Data/Symbol.purs | 3 +- stdlib/lib/Data/Traversable.purs | 10 +- stdlib/lib/Data/Tuple.purs | 148 +- stdlib/lib/Data/Unfoldable.purs | 11 +- stdlib/lib/Data/Unfoldable1.purs | 11 +- stdlib/lib/Effect.purs | 85 +- stdlib/lib/Effect/Class.purs | 19 + stdlib/lib/Effect/Class/Console.purs | 49 + stdlib/lib/Effect/Console.purs | 86 +- stdlib/lib/Effect/Ref.purs | 15 +- stdlib/lib/Effect/Uncurried.purs | 286 + stdlib/lib/Effect/Unsafe.purs | 8 + stdlib/lib/Partial.purs | 3 +- stdlib/lib/Partial/Unsafe.purs | 3 +- stdlib/lib/Prelude.purs | 10 +- stdlib/lib/Record/Unsafe.purs | 12 +- stdlib/lib/Test/Assert.purs | 187 +- stdlib/lib/Unsafe/Coerce.purs | 3 +- stdlib/lib/trusted | 11 +- 88 files changed, 21462 insertions(+), 1050 deletions(-) create mode 100644 crates/psrs-driver/src/tests/library_foreign.rs create mode 100644 crates/psrs-driver/tests/upstream/library_foreign.rs create mode 100644 docs/implementation/stdlib/vendor-audit-2026-10-06/inventory.json create mode 100644 docs/implementation/stdlib/vendor-audit-2026-10-06/modules.md create mode 100644 docs/implementation/stdlib/vendor-audit-2026-10-06/official-vs-vendored.diff create mode 100644 docs/implementation/stdlib/vendor-audit-2026-10-06/report.md create mode 100644 docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.json create mode 100644 docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.md create mode 100644 docs/implementation/stdlib/vendor-restoration-2026-10-06/inventory.json create mode 100644 docs/implementation/stdlib/vendor-restoration-2026-10-06/modules.md create mode 100644 docs/implementation/stdlib/vendor-restoration-2026-10-06/official-vs-vendored.diff create mode 100644 docs/implementation/stdlib/vendor-restoration-2026-10-06/report.md create mode 100644 docs/workflow/stdlib-vendoring.md create mode 100644 docs/workflow/tools/audit-stdlib-vendor.py create mode 100644 stdlib/lib/Effect/Class.purs create mode 100644 stdlib/lib/Effect/Class/Console.purs create mode 100644 stdlib/lib/Effect/Uncurried.purs create mode 100644 stdlib/lib/Effect/Unsafe.purs diff --git a/AGENTS.md b/AGENTS.md index 3e96adb9..39e96e8b 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -24,6 +24,27 @@ uncommitted work. the change at the right layer. - Review the local diff and run the validation relevant to the files changed. +### Standard-library vendoring + +- Follow [the stdlib source-fidelity contract](docs/workflow/stdlib-vendoring.md) + when importing or changing official library sources. +- Pin upstream package versions and commits. Preserve official pure functions, + signatures, exports, classes, instances, and modules. Repair compiler defects + in the compiler rather than editing valid official source to compile. +- Official vendored `.purs` files retain their original length, including files + above 500 lines. The 500-line limit still applies to maintained compiler and + tooling source; do not split or rewrite official library modules to meet it. +- Differences require a concrete Wasm/WASI or DEC-16 representation reason, + an explicit implementation boundary, and focused behavior evidence. A compiler + limitation, reduced API, or convenient rewrite is not a target justification. +- Never replace an unimplemented foreign value with recursion, a fabricated + result, or another successful-looking placeholder. Keep its source contract + and report missing target support explicitly. +- Compile acceptance, source fidelity, and runtime correctness are separate + claims. Importing every module with an unused `main` does not prove that the + APIs execute, that every declaration survives backend lowering, or that FFI + behavior agrees with its contract. + ### Commit granularity - Group a commit by topic, not by file type. Code, tests, and the design or diff --git a/crates/psrs-ast/src/lib.rs b/crates/psrs-ast/src/lib.rs index e45eb9fd..029deebe 100644 --- a/crates/psrs-ast/src/lib.rs +++ b/crates/psrs-ast/src/lib.rs @@ -48,14 +48,13 @@ pub struct Module { pub span: TextRange, } -/// A `foreign import` with a WIT binding: a value provided by a WIT interface -/// rather than defined in source. +/// A source-declared foreign value, implemented by the target rather than source. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ForeignImport { pub name: Name, pub annotation: Type, - /// The WIT binding, `#`. - pub binding: String, + /// An explicit target binding, or an ordinary library foreign declaration. + pub binding: Option, pub span: TextRange, } @@ -97,19 +96,13 @@ impl LowerError { } fn lower_foreign_import(declaration: cst::ForeignDeclaration) -> Result { - let Some(binding) = declaration.binding else { - return Err(LowerError::new( - declaration.span, - "a foreign import requires a `\"#\"` WIT binding", - )); - }; Ok(ForeignImport { name: Name { text: declaration.name.text, span: declaration.name.span, }, annotation: lower_type(declaration.type_expr)?, - binding: binding.text, + binding: declaration.binding.map(|binding| binding.text), span: declaration.span, }) } diff --git a/crates/psrs-backend/src/bindings/mod.rs b/crates/psrs-backend/src/bindings/mod.rs index 23002ac9..2cc5812f 100644 --- a/crates/psrs-backend/src/bindings/mod.rs +++ b/crates/psrs-backend/src/bindings/mod.rs @@ -118,6 +118,37 @@ impl ExternalBindings { /// cannot accidentally make a target binding disappear by supplying a /// partial table. pub(crate) fn validate_core(&self, module: &CoreModule) -> Result<(), Vec> { + let unsupported = module + .externals + .iter() + .filter_map(|external| { + let ExternalKind::Library { module: owner } = &external.kind else { + return None; + }; + let mut error = BackendError::new( + "P8 library linking", + external + .signature + .as_ref() + .map_or(module.span, |ty| ty.span), + format!( + "foreign value `{owner}.{}` has no target implementation", + external.name + ), + ); + if let Some(checked) = module + .external_types + .iter() + .find(|checked| checked.symbol == external.symbol) + { + error = error.with_module(checked.source_module); + } + Some(error) + }) + .collect::>(); + if !unsupported.is_empty() { + return Err(unsupported); + } let expected = module .externals .iter() diff --git a/crates/psrs-core/src/verify/mod.rs b/crates/psrs-core/src/verify/mod.rs index ac4d51c6..29fa9f7e 100644 --- a/crates/psrs-core/src/verify/mod.rs +++ b/crates/psrs-core/src/verify/mod.rs @@ -1,5 +1,5 @@ use crate::{Module, Type, TypeId, VerifyError}; -use psrs_hir::{ExternalKind, LocalId}; +use psrs_hir::LocalId; use std::collections::HashMap; mod expr; @@ -82,7 +82,7 @@ pub(crate) fn module(module: &Module, source: Option<&Module>) -> Result<(), Vec ); } for external in &module.externals { - if matches!(&external.kind, ExternalKind::Wit { .. }) + if external.kind.requires_checked_signature() && !external_type_symbols.contains(&external.symbol) { errors.push(error( diff --git a/crates/psrs-driver/src/program/signatures.rs b/crates/psrs-driver/src/program/signatures.rs index d2ad0b72..860db646 100644 --- a/crates/psrs-driver/src/program/signatures.rs +++ b/crates/psrs-driver/src/program/signatures.rs @@ -17,11 +17,11 @@ pub(super) fn declared_signatures( .clone() .map(|signature| (declaration.symbol, signature)) }); - // Only a source `foreign import` (a WIT external) is declared in a + // Only a source `foreign import` is declared in a // module; a compiler intrinsic is not, even though its descriptor // gives it a signature. let externals = module.externals.iter().filter_map(|external| { - if matches!(external.kind, psrs_hir::ExternalKind::Wit { .. }) { + if external.kind.requires_checked_signature() { external .signature .clone() diff --git a/crates/psrs-driver/src/tests/library_foreign.rs b/crates/psrs-driver/src/tests/library_foreign.rs new file mode 100644 index 00000000..8954dbaf --- /dev/null +++ b/crates/psrs-driver/src/tests/library_foreign.rs @@ -0,0 +1,114 @@ +#[test] +fn library_foreign_values_preserve_identity_and_checked_signatures() { + let sources = [ + ( + "Native.purs", + "module Native where\nforeign import step :: Int -> Int\n", + ), + ( + "Main.purs", + "module Main where\nimport Native\nmain = step 42\n", + ), + ]; + let modules = crate::typecheck_program_sources(&sources).expect("declared foreign type checks"); + let native = &modules[0]; + let external = native + .externals + .iter() + .find(|external| external.name == "step") + .unwrap(); + assert_eq!( + external.kind, + psrs_hir::ExternalKind::Library { + module: "Native".into() + } + ); + assert!( + native + .external_types + .iter() + .any(|checked| checked.symbol == external.symbol) + ); + let mut core = crate::prepare_sources(&sources) + .expect("foreign signatures lower to Core") + .core; + core.external_types + .retain(|checked| checked.symbol != external.symbol); + assert!( + core.verify().is_err(), + "a library declaration needs its checked signature" + ); +} + +#[test] +fn a_library_foreign_value_can_own_an_operator_fixity() { + let sources = [( + "Main.purs", + "module Main where\nforeign import operation :: Int -> Int -> Int\ninfixl 4 operation as %%\nmain = 1 %% 2\n", + )]; + crate::check_program(&sources).expect("foreign values are declared before fixity resolution"); +} + +#[test] +fn a_source_foreign_declaration_shadows_a_bootstrap_primitive() { + let sources = [( + "Main.purs", + "module Main where\nforeign import intAdd :: Int -> Int\nmain :: Int\nmain = intAdd 42\n", + )]; + crate::check_program(&sources) + .expect("the source declaration owns its declared arity and type"); +} + +#[test] +fn a_reexported_foreign_value_shadows_a_bootstrap_primitive() { + let sources = [ + ( + "Native.purs", + "module Native where\nforeign import intAdd :: Int -> Int\n", + ), + ( + "Facade.purs", + "module Facade (module Native) where\nimport Native\n", + ), + ( + "Main.purs", + "module Main where\nimport Facade\nmain :: Int\nmain = intAdd 42\n", + ), + ]; + crate::check_program(&sources).expect("imports keep their declaring symbol and signature"); +} + +#[test] +fn a_library_foreign_signature_rejects_source_class_constraints() { + let sources = [( + "Main.purs", + "module Main where\nclass Equal a where\n equal :: a -> a -> Boolean\nforeign import compareValues :: forall a. Equal a => a -> a -> Boolean\nmain = 0\n", + )]; + let errors = crate::check_program(&sources).expect_err("purs rejects foreign constraints"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.message.contains("class constraints")) + ); +} + +#[test] +fn an_unimplemented_library_foreign_value_is_an_explicit_linking_error() { + let sources = [( + "Main.purs", + "module Main where\nforeign import step :: Int -> Int\nmain = step 42\n", + )]; + let errors = + crate::compile_program_sources(&sources).expect_err("no target implementation exists"); + assert!( + errors.iter().any(|error| { + error.diagnostic.stage == "P8 library linking" + && error.diagnostic.message.contains("Main.step") + && error + .diagnostic + .message + .contains("no target implementation") + }), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index d8b8324d..b2717097 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -17,6 +17,7 @@ mod foldable; mod functor; mod guard_coverage; mod let_constraints; +mod library_foreign; mod operators; mod partial_application; mod scalars; diff --git a/crates/psrs-driver/tests/upstream/library_foreign.rs b/crates/psrs-driver/tests/upstream/library_foreign.rs new file mode 100644 index 00000000..6913c4ed --- /dev/null +++ b/crates/psrs-driver/tests/upstream/library_foreign.rs @@ -0,0 +1,36 @@ +use super::*; + +#[test] +fn differential_library_foreign_declarations_against_purs() { + if !purs_available() { + eprintln!("skipping: purs is not installed"); + return; + } + let native = "module Native where\nforeign import intAdd :: Int -> Int\nforeign import operation :: Int -> Int -> Int\ninfixl 4 operation as %%\n"; + let main = "module Main where\nimport Native\nmain :: Int\nmain = intAdd (1 %% 2)\n"; + let sources = [("Native.purs", native), ("Main.purs", main)]; + psrs_driver::check_program(&sources).expect("source foreign declarations should type check"); + let directory = std::env::temp_dir().join(format!( + "psrs-official-library-foreign-{}", + std::process::id() + )); + std::fs::create_dir_all(&directory).unwrap(); + for (name, source) in sources { + std::fs::write(directory.join(name), source).unwrap(); + } + std::fs::write( + directory.join("Native.js"), + "export const intAdd = x => x;\nexport const operation = x => y => x + y;\n", + ) + .unwrap(); + let output = Command::new("purs") + .arg("compile") + .arg(directory.join("Native.purs")) + .arg(directory.join("Main.purs")) + .arg("-o") + .arg(directory.join("output")) + .output() + .expect("run the official compiler"); + let _ = std::fs::remove_dir_all(directory); + assert!(output.status.success(), "{output:?}"); +} diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 4f2e5566..9d688be7 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -3,6 +3,7 @@ use std::process::Command; mod coercion; mod deriving; +mod library_foreign; mod rank_n; mod reports; mod rows; diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index 2668e0b5..94d3ebd4 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -131,6 +131,17 @@ pub enum ExternalKind { /// resolves the canonical signature from the vendored WIT and lowers calls /// generically. See `docs/design/backend/wasm/canonical-abi-and-wit.md`. Wit { interface: String, function: String }, + /// An ordinary library foreign declaration awaiting target implementation. + /// Its identity is the declaring module and the external value's name; + /// absence of an implementation must remain an explicit linking failure. + Library { module: String }, +} + +impl ExternalKind { + /// Source declarations must retain a checked signature across IR boundaries. + pub fn requires_checked_signature(&self) -> bool { + !matches!(self, Self::Intrinsic(_)) + } } #[derive(Clone, Debug, PartialEq, Eq)] diff --git a/crates/psrs-resolve/src/resolver/module_resolution.rs b/crates/psrs-resolve/src/resolver/module_resolution.rs index a9769fdd..d728f0e0 100644 --- a/crates/psrs-resolve/src/resolver/module_resolution.rs +++ b/crates/psrs-resolve/src/resolver/module_resolution.rs @@ -30,6 +30,20 @@ pub(crate) fn resolve_ast_module( )); } } + // Foreign values share the ordinary value namespace and may be named by a + // fixity declaration before their signatures are resolved. + for (index, foreign) in module.foreign_imports.iter().enumerate() { + if globals + .insert(foreign.name.text.clone(), foreign_symbol(module_id, index)) + .is_some() + { + errors.push(ResolveError::named( + ResolveErrorKind::DuplicateDeclaration, + foreign.name.text.clone(), + foreign.name.span, + )); + } + } let mut type_declarations = module.type_declarations; let role_declarations: HashMap = module @@ -84,24 +98,33 @@ pub(crate) fn resolve_ast_module( resolver.opaque_types.extend(opaque_types); resolver.note_imported_opaque_types(); - // A `foreign import` declares an external value whose type and WIT binding + // A `foreign import` declares an external value whose type and target binding // come from source. Resolve its annotation first so expressions can refer // to it by name. for (index, foreign) in module.foreign_imports.iter().enumerate() { - let binding = foreign - .binding - .split_once('#') - .filter(|(interface, function)| !interface.is_empty() && !function.is_empty()); - let Some((interface, function)) = binding else { - resolver.errors.push(ResolveError { - kind: ResolveErrorKind::InvalidHir, - span: foreign.span, - message: format!( - "`{}` is not a `\"#\"` WIT binding", - foreign.binding - ), - }); - continue; + let kind = match &foreign.binding { + None => ExternalKind::Library { + module: module.name.text.clone(), + }, + Some(binding) => { + let Some((interface, function)) = binding + .split_once('#') + .filter(|(interface, function)| !interface.is_empty() && !function.is_empty()) + else { + resolver.errors.push(ResolveError { + kind: ResolveErrorKind::InvalidHir, + span: foreign.span, + message: format!( + "`{binding}` is not a `\"#\"` WIT binding" + ), + }); + continue; + }; + ExternalKind::Wit { + interface: interface.into(), + function: function.into(), + } + } }; let Some(signature) = resolver.resolve_type(foreign.annotation.clone()) else { continue; @@ -113,10 +136,7 @@ pub(crate) fn resolve_ast_module( ExternalSymbol { symbol, name: foreign.name.text.clone(), - kind: ExternalKind::Wit { - interface: interface.to_string(), - function: function.to_string(), - }, + kind, signature: Some(signature), }, foreign.name.span, diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index 92c23747..11afe1c4 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -142,7 +142,11 @@ impl Resolver { external: ExternalSymbol, span: TextRange, ) { - if self.external_globals.insert(name.clone(), symbol).is_some() { + if let Some(previous) = self.external_globals.insert(name.clone(), symbol) + && self.externals.iter().any(|external| { + external.symbol == previous && external.kind.requires_checked_signature() + }) + { self.errors.push(ResolveError::named( ResolveErrorKind::DuplicateExternal, name, @@ -382,9 +386,6 @@ impl Resolver { if let Some(symbol) = self.globals.get(text) { return Some(*symbol); } - if let Some(symbol) = self.external_globals.get(text) { - return Some(*symbol); - } if let Some(symbols) = self.unqualified.get(text) { let first = symbols[0]; if symbols.iter().all(|symbol| *symbol == first) { @@ -393,6 +394,9 @@ impl Resolver { self.report_conflict(text.to_string(), span); return None; } + if let Some(symbol) = self.external_globals.get(text) { + return Some(*symbol); + } self.report(ResolveErrorKind::UnknownName, text.to_string(), span); None } diff --git a/crates/psrs-resolve/src/resolver/program/interface.rs b/crates/psrs-resolve/src/resolver/program/interface.rs index 92a55201..f42cc7c3 100644 --- a/crates/psrs-resolve/src/resolver/program/interface.rs +++ b/crates/psrs-resolve/src/resolver/program/interface.rs @@ -181,7 +181,7 @@ impl Interface { values.insert(declaration.name.clone(), declaration.symbol); } for external in &module.externals { - if matches!(external.kind, hir::ExternalKind::Wit { .. }) { + if external.kind.requires_checked_signature() { values.insert(external.name.clone(), external.symbol); } } diff --git a/crates/psrs-thir/src/external_type_tests.rs b/crates/psrs-thir/src/external_type_tests.rs index c7023d31..c87a416c 100644 --- a/crates/psrs-thir/src/external_type_tests.rs +++ b/crates/psrs-thir/src/external_type_tests.rs @@ -50,6 +50,17 @@ fn a_wit_scheme_is_required_even_without_a_raw_annotation() { rejects(&module, "no checked signature"); } +#[test] +fn a_library_scheme_is_required_even_without_a_raw_annotation() { + let mut module = fixture(); + module.externals[0].kind = ExternalKind::Library { + module: "Native".into(), + }; + module.verify().unwrap(); + module.external_types.clear(); + rejects(&module, "no checked signature"); +} + #[test] fn checked_external_schemes_are_unique_and_have_an_external_owner() { let mut module = fixture(); diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index d1b2cf1a..ca1cd88c 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -1,7 +1,6 @@ use crate::{ Evidence, EvidenceKind, Expr, ExprKind, Module, Pattern, PatternKind, Type, TypeId, VerifyError, }; -use psrs_hir::ExternalKind; use psrs_span::TextRange; mod semantics; @@ -34,7 +33,7 @@ pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { ); } for external in &module.externals { - if matches!(&external.kind, ExternalKind::Wit { .. }) + if external.kind.requires_checked_signature() && !external_type_symbols.contains(&external.symbol) { errors.push(VerifyError { diff --git a/crates/psrs-typecheck/src/typecheck/entry.rs b/crates/psrs-typecheck/src/typecheck/entry.rs index c72347c1..40b4ab0f 100644 --- a/crates/psrs-typecheck/src/typecheck/entry.rs +++ b/crates/psrs-typecheck/src/typecheck/entry.rs @@ -167,7 +167,7 @@ pub fn typecheck_module_with_checked_kinds_and_module_names_and_warnings( .externals .iter() .filter_map(|external| { - if !matches!(external.kind, hir::ExternalKind::Wit { .. }) { + if !external.kind.requires_checked_signature() { return None; } let signature = external.signature.as_ref()?; @@ -176,7 +176,11 @@ pub fn typecheck_module_with_checked_kinds_and_module_names_and_warnings( checker.state.errors.push(TypeCheckError::new( TypeCheckErrorKind::UnsupportedType, signature.span, - "class-constrained WIT imports are not supported by the WASI binding ABI", + if matches!(external.kind, hir::ExternalKind::Wit { .. }) { + "class-constrained WIT imports are not supported by the WASI binding ABI" + } else { + "class constraints are not allowed in foreign import signatures" + }, )); return None; } diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index b2a4e4ba..ea0168d4 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -147,13 +147,13 @@ impl Checker { InferredExprKind::Global(*symbol), self.intrinsic_type(intrinsic), ), - Some(ExternalKind::Wit { .. }) => { + Some(ExternalKind::Wit { .. } | ExternalKind::Library { .. }) => { let Some(signature) = self.env.external_signatures.get(symbol).cloned() else { self.state.errors.push(TypeCheckError::new( TypeCheckErrorKind::InvalidHir, span, - "WIT import has no declared type", + "foreign import has no declared type", )); return None; }; diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index 5c9e7528..e215ef9e 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -13,6 +13,14 @@ the lowerer refuses to recognize, and how a wrapper encodes and decodes library types. It is the mechanism behind [DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md). +That contract applies to explicitly bound WIT imports. Ordinary upstream library +`foreign import name :: Type` declarations keep their source contract under +[foreign imports](../../frontend/semantics/foreign-imports.md) and +[source fidelity](../../../workflow/stdlib-vendoring.md). They are not implicit +WASI functions or subject to a fabricated canonical ABI. Until a checked target +implementation exists, P8 library linking rejects them explicitly; retaining a +declaration does not establish runtime support. + It does not own canonical flattening, `lift`/`lower`, or `cabi_realloc` ([canonical ABI and WIT](canonical-abi-and-wit.md)), buffer lifetime ([linear memory boundary](linear-memory-and-canonical-abi-boundary.md), diff --git a/docs/design/frontend/semantics/foreign-imports.md b/docs/design/frontend/semantics/foreign-imports.md index 9e405e04..00e27721 100644 --- a/docs/design/frontend/semantics/foreign-imports.md +++ b/docs/design/frontend/semantics/foreign-imports.md @@ -11,12 +11,23 @@ handles, and [modules and resolution](modules-and-resolution.md). Read [canonical ABI](../../backend/wasm/canonical-abi-and-wit.md) first. Roadmap row FE-19 tracks this surface. -**Summary:** A `foreign import` names either a WIT function or an opaque type. +**Summary:** A `foreign import` declares a library foreign value, explicitly +names a WIT function, or introduces an opaque type. `foreign import data T :: Kind` introduces a nominal type with no constructors. A nullary opaque type is the source image of a WIT resource; `Int` remains accepted at the ABI boundary so existing integer placeholders keep compiling. JavaScript FFI is not part of this surface. +An ordinary `foreign import name :: Type` retains its source-declared signature +and declaring-module identity. AST stores the absence of an explicit target +binding; resolution produces a library external rather than inventing a WIT +name or a source body. Type checking, imports, operator fixities, and checked +external signatures apply normally. Foreign value signatures cannot contain +class constraints, matching the official source restriction. Backend linking must +reject a library value without a registered target implementation explicitly. +This supports faithful source inventory and checking, not JavaScript execution +or an assertion that all library values already have Wasm implementations. + ## Scope This document owns foreign value imports and foreign data declarations from @@ -50,14 +61,17 @@ corresponds to a handle. ## Model ```text -ForeignValue = { name, binding: Interface "#" Function, type, span } +ForeignValue = { name, binding: Optional(Interface "#" Function), type, span } ForeignData = { name, kind, span } OpaqueType = nominal TypeId with no constructors SourceResource = { type_id: TypeId } ``` `ForeignValue` is a value-namespace declaration. Its binding text is -`#` and is metadata, not a term. `ForeignData` is a +`#` when present and is metadata, not a term. An absent +binding identifies an ordinary library declaration by its declaring module +and value symbol. Explicit source declarations and imports take precedence +over bootstrap intrinsic names. `ForeignData` is a type-namespace declaration. The type expression after `::` is the kind, not a value type. The kind may be `Type` or an arrow such as `Type -> Type`. There are no type parameters beside that kind, and there is no value constructor. @@ -93,7 +107,8 @@ Foreign data is lowered as a type declaration, not as a foreign value. The CST already records the optional `data` keyword and the kind expression; lowering rejects a WIT binding string on a data declaration, because a resource's identity is the nominal type rather than a function name. A foreign value -import still requires `#`. +import preserves either an explicit `#` binding or its +absence for a library declaration. Resolution allocates a type id and no value symbol. The type name occupies the uppercase namespace, so it conflicts with another type of the same name and @@ -141,7 +156,7 @@ lower_foreign(cst): reject a binding string emit ForeignData { name, kind: lower(cst.kind), span } else: - require a "#" binding + preserve an optional "#" binding emit ForeignValue { name, binding, type, span } resolve_module: @@ -166,7 +181,7 @@ validate_handle(source): ``` Edge cases: a binding string on foreign data is a lowering error; a missing -binding on a foreign value is a lowering error; a duplicate type name is a +binding on a foreign value denotes a library declaration; a duplicate type name is a declaration conflict; an imported opaque type stays opaque under an alias; a higher-kinded foreign constructor used without enough arguments fails kind checking rather than becoming a handle. diff --git a/docs/implementation/stdlib/vendor-audit-2026-10-06/inventory.json b/docs/implementation/stdlib/vendor-audit-2026-10-06/inventory.json new file mode 100644 index 00000000..49f790db --- /dev/null +++ b/docs/implementation/stdlib/vendor-audit-2026-10-06/inventory.json @@ -0,0 +1,7155 @@ +{ + "schema_version": 1, + "compiler_revision": "67369ba012755b1586d1250fac6a7254e096bb03", + "counts": { + "identical": 149, + "modified": 50, + "newline_only": 3, + "platform_addition": 9, + "vendored_modules": 211, + "packages": 41, + "direct_self_recursions": 200, + "modules_with_direct_self_recursions": 30, + "upstream_modules_absent_from_vendor": [ + "Effect/Class.purs", + "Effect/Class/Console.purs", + "Effect/Uncurried.purs", + "Effect/Unsafe.purs" + ], + "upstream_value_foreign_declarations": { + "nonrecursive_replacement": 40, + "direct_self_recursion": 200, + "declaration_removed": 27 + } + }, + "packages": [ + { + "name": "purescript-arrays", + "checkout": "/private/tmp/ps-pkgs/purescript-arrays", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "tag": "v7.3.0", + "remote": "https://github.com/purescript/purescript-arrays.git" + }, + { + "name": "purescript-bifunctors", + "checkout": "/private/tmp/ps-pkgs/purescript-bifunctors", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "tag": "v6.1.0", + "remote": "https://github.com/purescript/purescript-bifunctors.git" + }, + { + "name": "purescript-const", + "checkout": "/private/tmp/ps-pkgs/purescript-const", + "commit": "ab9570cf2b6e67f7e441178211db1231cfd75c37", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-const.git" + }, + { + "name": "purescript-contravariant", + "checkout": "/private/tmp/ps-pkgs/purescript-contravariant", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-contravariant.git" + }, + { + "name": "purescript-control", + "checkout": "/private/tmp/ps-pkgs/purescript-control", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-control.git" + }, + { + "name": "purescript-distributive", + "checkout": "/private/tmp/ps-pkgs/purescript-distributive", + "commit": "6005e513642e855ebf6f884d24a35c2803ca252a", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-distributive.git" + }, + { + "name": "purescript-either", + "checkout": "/private/tmp/ps-pkgs/purescript-either", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "tag": "v6.1.0", + "remote": "https://github.com/purescript/purescript-either.git" + }, + { + "name": "purescript-enums", + "checkout": "/private/tmp/ps-pkgs/purescript-enums", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-enums.git" + }, + { + "name": "purescript-exists", + "checkout": "/private/tmp/ps-pkgs/purescript-exists", + "commit": "f765b4ace7869c27b9c05949e18c843881f9173b", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-exists.git" + }, + { + "name": "purescript-filterable", + "checkout": "/private/tmp/ps-pkgs/purescript-filterable", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "tag": "v5.0.0", + "remote": "https://github.com/purescript/purescript-filterable.git" + }, + { + "name": "purescript-foldable-traversable", + "checkout": "/private/tmp/ps-pkgs/purescript-foldable-traversable", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-foldable-traversable.git" + }, + { + "name": "purescript-functions", + "checkout": "/private/tmp/ps-pkgs/purescript-functions", + "commit": "f626f20580483977c5b27a01aac6471e28aff367", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-functions.git" + }, + { + "name": "purescript-functors", + "checkout": "/private/tmp/ps-pkgs/purescript-functors", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "tag": "v5.0.0", + "remote": "https://github.com/purescript/purescript-functors.git" + }, + { + "name": "purescript-gen", + "checkout": "/private/tmp/ps-pkgs/purescript-gen", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "tag": "v4.0.0", + "remote": "https://github.com/purescript/purescript-gen.git" + }, + { + "name": "purescript-identity", + "checkout": "/private/tmp/ps-pkgs/purescript-identity", + "commit": "ef6768f8a52ab0bc943a85f5761ba07c257f639f", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-identity.git" + }, + { + "name": "purescript-integers", + "checkout": "/private/tmp/ps-pkgs/purescript-integers", + "commit": "54d712b25c594833083d15dc9ff2418eb9c52822", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-integers.git" + }, + { + "name": "purescript-invariant", + "checkout": "/private/tmp/ps-pkgs/purescript-invariant", + "commit": "1d2a196d51e90623adb88496c2cfd759c6736894", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-invariant.git" + }, + { + "name": "purescript-lazy", + "checkout": "/private/tmp/ps-pkgs/purescript-lazy", + "commit": "48347841226b27af5205a1a8ec71e27a93ce86fd", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-lazy.git" + }, + { + "name": "purescript-lists", + "checkout": "/private/tmp/ps-pkgs/purescript-lists", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-lists.git" + }, + { + "name": "purescript-maybe", + "checkout": "/private/tmp/ps-pkgs/purescript-maybe", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-maybe.git" + }, + { + "name": "purescript-newtype", + "checkout": "/private/tmp/ps-pkgs/purescript-newtype", + "commit": "29d8e6dd77aec2c975c948364ec3faf26e14ee7b", + "tag": "v5.0.0", + "remote": "https://github.com/purescript/purescript-newtype.git" + }, + { + "name": "purescript-nonempty", + "checkout": "/private/tmp/ps-pkgs/purescript-nonempty", + "commit": "28150ecc7419238b187abd609a92a645273348bb", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-nonempty.git" + }, + { + "name": "purescript-numbers", + "checkout": "/private/tmp/ps-pkgs/purescript-numbers", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "tag": "v9.0.1", + "remote": "https://github.com/purescript/purescript-numbers.git" + }, + { + "name": "purescript-ordered-collections", + "checkout": "/private/tmp/ps-pkgs/purescript-ordered-collections", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "tag": "v3.2.0", + "remote": "https://github.com/purescript/purescript-ordered-collections.git" + }, + { + "name": "purescript-orders", + "checkout": "/private/tmp/ps-pkgs/purescript-orders", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-orders.git" + }, + { + "name": "purescript-partial", + "checkout": "/private/tmp/ps-pkgs/purescript-partial", + "commit": "0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec", + "tag": "v4.0.0", + "remote": "https://github.com/purescript/purescript-partial.git" + }, + { + "name": "purescript-profunctor", + "checkout": "/private/tmp/ps-pkgs/purescript-profunctor", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-profunctor.git" + }, + { + "name": "purescript-refs", + "checkout": "/private/tmp/ps-pkgs/purescript-refs", + "commit": "f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-refs.git" + }, + { + "name": "purescript-safe-coerce", + "checkout": "/private/tmp/ps-pkgs/purescript-safe-coerce", + "commit": "7fa799ae80a38b8d948efcb52608e58e198b3da7", + "tag": "v2.0.0", + "remote": "https://github.com/purescript/purescript-safe-coerce.git" + }, + { + "name": "purescript-st", + "checkout": "/private/tmp/ps-pkgs/purescript-st", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "tag": "v6.2.0", + "remote": "https://github.com/purescript/purescript-st.git" + }, + { + "name": "purescript-strings", + "checkout": "/private/tmp/ps-pkgs/purescript-strings", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-strings.git" + }, + { + "name": "purescript-tailrec", + "checkout": "/private/tmp/ps-pkgs/purescript-tailrec", + "commit": "5661a10afbd4849bd2e45139ea567beb40b20f9f", + "tag": "v6.1.0", + "remote": "https://github.com/purescript/purescript-tailrec.git" + }, + { + "name": "purescript-tuples", + "checkout": "/private/tmp/ps-pkgs/purescript-tuples", + "commit": "4f52da2729b448c8564369378f1232d8d2dc1d8b", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-tuples.git" + }, + { + "name": "purescript-type-equality", + "checkout": "/private/tmp/ps-pkgs/purescript-type-equality", + "commit": "0525b7d39e0fbd81b4209518139fb8ab02695774", + "tag": "v4.0.1", + "remote": "https://github.com/purescript/purescript-type-equality.git" + }, + { + "name": "purescript-typelevel-prelude", + "checkout": "/private/tmp/ps-pkgs/purescript-typelevel-prelude", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-typelevel-prelude.git" + }, + { + "name": "purescript-unfoldable", + "checkout": "/private/tmp/ps-pkgs/purescript-unfoldable", + "commit": "493dfe04ed590e20d8f69079df2f58486882748d", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-unfoldable.git" + }, + { + "name": "purescript-unsafe-coerce", + "checkout": "/private/tmp/ps-pkgs/purescript-unsafe-coerce", + "commit": "ab956f82e66e633f647fb3098e8ddd3ec58d689f", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-unsafe-coerce.git" + }, + { + "name": "purescript-prelude", + "checkout": "/private/tmp/purescript-prelude", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-prelude.git" + }, + { + "name": "purescript-assert", + "checkout": "/private/tmp/psrs-stdlib-audit-20261006/upstream/purescript-assert", + "commit": "27c0edb57d2ee497eb5fab664f5601c35b613eda", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-assert.git" + }, + { + "name": "purescript-console", + "checkout": "/private/tmp/psrs-stdlib-audit-20261006/upstream/purescript-console", + "commit": "3b83d7b792d03872afeea5e62b4f686ab0f09842", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-console.git" + }, + { + "name": "purescript-effect", + "checkout": "/private/tmp/psrs-stdlib-audit-20261006/upstream/purescript-effect", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "tag": "v4.0.0", + "remote": "https://github.com/purescript/purescript-effect.git" + } + ], + "modules": [ + { + "path": "Control/Alt.purs", + "vendored_sha256": "f02098c849efebd9eaeff8340215637a6152db97b10743a86dec6fae149061a1", + "vendored_lines": 42, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "f02098c849efebd9eaeff8340215637a6152db97b10743a86dec6fae149061a1", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Alt.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Alternative.purs", + "vendored_sha256": "86e1c20be4b0d570377b607f53fdbce0c642065973b79b9211883dc2b9d9b329", + "vendored_lines": 50, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "86e1c20be4b0d570377b607f53fdbce0c642065973b79b9211883dc2b9d9b329", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Alternative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Applicative.purs", + "vendored_sha256": "4cf9abb5b98e7569c66375a725ce3815c57f020f1dc0513fc4bd853cd70b567b", + "vendored_lines": 70, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "4cf9abb5b98e7569c66375a725ce3815c57f020f1dc0513fc4bd853cd70b567b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Applicative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Apply.purs", + "vendored_sha256": "f174b8f2d019ad34d38fdc69deddcad303fa78cfebd127e05b8361319443f4bf", + "vendored_lines": 119, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "02712ac645e851672d659d9b21171514b6d727efa7de08461399d3e7e581859b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Apply.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "arrayApply", + "line": 63, + "declaration": "foreign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Biapplicative.purs", + "vendored_sha256": "5c3baecdf32b1e0eb8c871de70eac69aa558b2dca8710b7b3d84badb20ef00bb", + "vendored_lines": 12, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "5c3baecdf32b1e0eb8c871de70eac69aa558b2dca8710b7b3d84badb20ef00bb", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Control/Biapplicative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Biapply.purs", + "vendored_sha256": "e2adb06728bb1a789579e3876c0a3894f1cd3ee7e5acef3268a13023a1733de0", + "vendored_lines": 59, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "e2adb06728bb1a789579e3876c0a3894f1cd3ee7e5acef3268a13023a1733de0", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Control/Biapply.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Bind.purs", + "vendored_sha256": "967aca77c298e0d9a9774c18c6b57ba73d21cb51e220e0970b368772ff274718", + "vendored_lines": 158, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "ea03e5ffa8c55c101018ceb9bf19fca9af792b49113a73be4a85867ef2c022f7", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Bind.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "arrayBind", + "line": 97, + "declaration": "foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Category.purs", + "vendored_sha256": "9cd6a331c6e9a7e17f35adb8fd11ba9fbe4fd2034eed34979d9cfbef68fe4230", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9cd6a331c6e9a7e17f35adb8fd11ba9fbe4fd2034eed34979d9cfbef68fe4230", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Category.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Comonad.purs", + "vendored_sha256": "8ddf03de6841c4e570432c7186445ef912d9a63d1eb272e668657ab73d981521", + "vendored_lines": 21, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "8ddf03de6841c4e570432c7186445ef912d9a63d1eb272e668657ab73d981521", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Comonad.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Extend.purs", + "vendored_sha256": "6f03ca3513cfc0004437042ae7341eaccfec255d184b87c9a8a0499d22d6eae7", + "vendored_lines": 60, + "self_recursions": [ + { + "name": "arrayExtend", + "line": 31, + "equation": "arrayExtend a0 a1 = arrayExtend a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "20d5e8394e1e755187e594cda0a3f63147fa69f703e18d8b99244d59c55d2900", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Extend.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "arrayExtend", + "line": 30, + "declaration": "foreign import arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Lazy.purs", + "vendored_sha256": "05fce3e86c1c1b409f863368edb7991894c2c0d83ce99cdf7a3f84cdc30e9d0a", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "05fce3e86c1c1b409f863368edb7991894c2c0d83ce99cdf7a3f84cdc30e9d0a", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Lazy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Gen/Class.purs", + "vendored_sha256": "88fc916494c75e3309471a0852d0c740691570d68dd9dbb92ed4547e9e20f17a", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-gen", + "tag": "v4.0.0", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "upstream_sha256": "88fc916494c75e3309471a0852d0c740691570d68dd9dbb92ed4547e9e20f17a", + "upstream_url": "https://github.com/purescript/purescript-gen/blob/9fbcc2a1261c32e30d79c5418edef4d96fe76931/src/Control/Monad/Gen/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Gen/Common.purs", + "vendored_sha256": "d31ab1b6246acefd0e92f320483d413861e5727de6429d1b4ca391f8120e89a4", + "vendored_lines": 67, + "self_recursions": [], + "package": "purescript-gen", + "tag": "v4.0.0", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "upstream_sha256": "d31ab1b6246acefd0e92f320483d413861e5727de6429d1b4ca391f8120e89a4", + "upstream_url": "https://github.com/purescript/purescript-gen/blob/9fbcc2a1261c32e30d79c5418edef4d96fe76931/src/Control/Monad/Gen/Common.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Gen.purs", + "vendored_sha256": "1af7bc60432e7fb6f3e6e75da3b78be19bc2d1ad7e9cfcdcfcba4446ec317f1b", + "vendored_lines": 132, + "self_recursions": [], + "package": "purescript-gen", + "tag": "v4.0.0", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "upstream_sha256": "1af7bc60432e7fb6f3e6e75da3b78be19bc2d1ad7e9cfcdcfcba4446ec317f1b", + "upstream_url": "https://github.com/purescript/purescript-gen/blob/9fbcc2a1261c32e30d79c5418edef4d96fe76931/src/Control/Monad/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Rec/Class.purs", + "vendored_sha256": "fd2ea9d0000c0194b78949bcaf9c931dfc12c92de322f0cadf73d566c994ea2f", + "vendored_lines": 191, + "self_recursions": [], + "package": "purescript-tailrec", + "tag": "v6.1.0", + "commit": "5661a10afbd4849bd2e45139ea567beb40b20f9f", + "upstream_sha256": "fd2ea9d0000c0194b78949bcaf9c931dfc12c92de322f0cadf73d566c994ea2f", + "upstream_url": "https://github.com/purescript/purescript-tailrec/blob/5661a10afbd4849bd2e45139ea567beb40b20f9f/src/Control/Monad/Rec/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Class.purs", + "vendored_sha256": "227bf813cc68b69b167ade39f2531d0ba45dc259252001bb97758e08bc93247d", + "vendored_lines": 17, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "227bf813cc68b69b167ade39f2531d0ba45dc259252001bb97758e08bc93247d", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Global.purs", + "vendored_sha256": "4cb7ab62ecd6c6dfacfce32920bf5d9a3dc0f7ce7d9a25a16b453d0a4fc0f9e3", + "vendored_lines": 18, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "4cb7ab62ecd6c6dfacfce32920bf5d9a3dc0f7ce7d9a25a16b453d0a4fc0f9e3", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Global.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Internal.purs", + "vendored_sha256": "75990cb65730636563ed0a92e718f82b5fc5f3f42942ad43a38d7642fda2b411", + "vendored_lines": 147, + "self_recursions": [ + { + "name": "map_", + "line": 39, + "equation": "map_ a0 a1 = map_ a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "pure_", + "line": 42, + "equation": "pure_ a0 = pure_ a0", + "replaces_upstream_foreign": true + }, + { + "name": "bind_", + "line": 45, + "equation": "bind_ a0 a1 = bind_ a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "run", + "line": 93, + "equation": "run a0 = run a0", + "replaces_upstream_foreign": true + }, + { + "name": "while", + "line": 101, + "equation": "while a0 a1 = while a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "for", + "line": 108, + "equation": "for a0 a1 a2 = for a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "foreach", + "line": 115, + "equation": "foreach a0 a1 = foreach a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "new", + "line": 125, + "equation": "new a0 = new a0", + "replaces_upstream_foreign": true + }, + { + "name": "read", + "line": 129, + "equation": "read a0 = read a0", + "replaces_upstream_foreign": true + }, + { + "name": "modifyImpl", + "line": 138, + "equation": "modifyImpl a0 a1 = modifyImpl a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "write", + "line": 147, + "equation": "write a0 a1 = write a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "00159fcd8f3fa41d7ba5b50c596043bc46859f95f8d877b9ff18dbc37c7fad99", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "map_", + "line": 38, + "declaration": "foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pure_", + "line": 40, + "declaration": "foreign import pure_ :: forall r a. a -> ST r a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "bind_", + "line": 42, + "declaration": "foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b", + "vendored_status": "direct_self_recursion" + }, + { + "name": "run", + "line": 89, + "declaration": "foreign import run :: forall a. (forall r. ST r a) -> a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "while", + "line": 96, + "declaration": "foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit", + "vendored_status": "direct_self_recursion" + }, + { + "name": "for", + "line": 102, + "declaration": "foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit", + "vendored_status": "direct_self_recursion" + }, + { + "name": "foreach", + "line": 108, + "declaration": "foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit", + "vendored_status": "direct_self_recursion" + }, + { + "name": "new", + "line": 117, + "declaration": "foreign import new :: forall a r. a -> ST r (STRef r a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "read", + "line": 120, + "declaration": "foreign import read :: forall a r. STRef r a -> ST r a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "modifyImpl", + "line": 128, + "declaration": "foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b", + "vendored_status": "direct_self_recursion" + }, + { + "name": "write", + "line": 136, + "declaration": "foreign import write :: forall a r. a -> STRef r a -> ST r a", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Ref.purs", + "vendored_sha256": "cd155ad39db037f2b26d422461da697bc3b7b5fe9bfc93702df55cba38158d3a", + "vendored_lines": 3, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "cd155ad39db037f2b26d422461da697bc3b7b5fe9bfc93702df55cba38158d3a", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Ref.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Uncurried.purs", + "vendored_sha256": "dfd09b8d765830dc50da8c1ed248ef4de9099c6c0c072752dffd56177c1a638e", + "vendored_lines": 101, + "self_recursions": [ + { + "name": "mkSTFn1", + "line": 62, + "equation": "mkSTFn1 a0 = mkSTFn1 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn2", + "line": 64, + "equation": "mkSTFn2 a0 = mkSTFn2 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn3", + "line": 66, + "equation": "mkSTFn3 a0 = mkSTFn3 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn4", + "line": 68, + "equation": "mkSTFn4 a0 = mkSTFn4 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn5", + "line": 70, + "equation": "mkSTFn5 a0 = mkSTFn5 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn6", + "line": 72, + "equation": "mkSTFn6 a0 = mkSTFn6 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn7", + "line": 74, + "equation": "mkSTFn7 a0 = mkSTFn7 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn8", + "line": 76, + "equation": "mkSTFn8 a0 = mkSTFn8 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn9", + "line": 78, + "equation": "mkSTFn9 a0 = mkSTFn9 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkSTFn10", + "line": 80, + "equation": "mkSTFn10 a0 = mkSTFn10 a0", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn1", + "line": 83, + "equation": "runSTFn1 a0 a1 = runSTFn1 a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn2", + "line": 85, + "equation": "runSTFn2 a0 a1 a2 = runSTFn2 a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn3", + "line": 87, + "equation": "runSTFn3 a0 a1 a2 a3 = runSTFn3 a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn4", + "line": 89, + "equation": "runSTFn4 a0 a1 a2 a3 a4 = runSTFn4 a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn5", + "line": 91, + "equation": "runSTFn5 a0 a1 a2 a3 a4 a5 = runSTFn5 a0 a1 a2 a3 a4 a5", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn6", + "line": 93, + "equation": "runSTFn6 a0 a1 a2 a3 a4 a5 a6 = runSTFn6 a0 a1 a2 a3 a4 a5 a6", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn7", + "line": 95, + "equation": "runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn8", + "line": 97, + "equation": "runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn9", + "line": 99, + "equation": "runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9", + "replaces_upstream_foreign": true + }, + { + "name": "runSTFn10", + "line": 101, + "equation": "runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "bd2411e5e23d8b446ef2f6b924422071eb99c6c629395df21eb9821a341988a6", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "mkSTFn1", + "line": 61, + "declaration": "foreign import mkSTFn1 :: forall a t r. (a -> ST t r) -> STFn1 a t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn2", + "line": 63, + "declaration": "foreign import mkSTFn2 :: forall a b t r. (a -> b -> ST t r) -> STFn2 a b t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn3", + "line": 65, + "declaration": "foreign import mkSTFn3 :: forall a b c t r. (a -> b -> c -> ST t r) -> STFn3 a b c t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn4", + "line": 67, + "declaration": "foreign import mkSTFn4 :: forall a b c d t r. (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn5", + "line": 69, + "declaration": "foreign import mkSTFn5 :: forall a b c d e t r. (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn6", + "line": 71, + "declaration": "foreign import mkSTFn6 :: forall a b c d e f t r. (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn7", + "line": 73, + "declaration": "foreign import mkSTFn7 :: forall a b c d e f g t r. (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn8", + "line": 75, + "declaration": "foreign import mkSTFn8 :: forall a b c d e f g h t r. (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn9", + "line": 77, + "declaration": "foreign import mkSTFn9 :: forall a b c d e f g h i t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkSTFn10", + "line": 79, + "declaration": "foreign import mkSTFn10 :: forall a b c d e f g h i j t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn1", + "line": 82, + "declaration": "foreign import runSTFn1 :: forall a t r. STFn1 a t r -> a -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn2", + "line": 84, + "declaration": "foreign import runSTFn2 :: forall a b t r. STFn2 a b t r -> a -> b -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn3", + "line": 86, + "declaration": "foreign import runSTFn3 :: forall a b c t r. STFn3 a b c t r -> a -> b -> c -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn4", + "line": 88, + "declaration": "foreign import runSTFn4 :: forall a b c d t r. STFn4 a b c d t r -> a -> b -> c -> d -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn5", + "line": 90, + "declaration": "foreign import runSTFn5 :: forall a b c d e t r. STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn6", + "line": 92, + "declaration": "foreign import runSTFn6 :: forall a b c d e f t r. STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn7", + "line": 94, + "declaration": "foreign import runSTFn7 :: forall a b c d e f g t r. STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn8", + "line": 96, + "declaration": "foreign import runSTFn8 :: forall a b c d e f g h t r. STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn9", + "line": 98, + "declaration": "foreign import runSTFn9 :: forall a b c d e f g h i t r. STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runSTFn10", + "line": 100, + "declaration": "foreign import runSTFn10 :: forall a b c d e f g h i j t r. STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST.purs", + "vendored_sha256": "316ee75613cd7960cdaefdf6c26613c14badcc8a06ee2405617ed089072598a0", + "vendored_lines": 3, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "316ee75613cd7960cdaefdf6c26613c14badcc8a06ee2405617ed089072598a0", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad.purs", + "vendored_sha256": "0bad91df889b370157f300b5e5e0241272d9149380a6c5322a81af58a6fdc67c", + "vendored_lines": 86, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "0bad91df889b370157f300b5e5e0241272d9149380a6c5322a81af58a6fdc67c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Monad.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/MonadPlus.purs", + "vendored_sha256": "4a5f2eeb965af319ffb1427c1571235ca3de44881e19aa83f2cb12e8404df68f", + "vendored_lines": 32, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "4a5f2eeb965af319ffb1427c1571235ca3de44881e19aa83f2cb12e8404df68f", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/MonadPlus.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Plus.purs", + "vendored_sha256": "308ba7c0a3a65e9b81cf2cc6f0a7d8e4f77043c1c2c481c04b5ab22ccf991f19", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "308ba7c0a3a65e9b81cf2cc6f0a7d8e4f77043c1c2c481c04b5ab22ccf991f19", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Plus.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Semigroupoid.purs", + "vendored_sha256": "aefe8332e035b2f990e25981ac56abb63a71efed5d5e986657483dd51c04834a", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "aefe8332e035b2f990e25981ac56abb63a71efed5d5e986657483dd51c04834a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Semigroupoid.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/NonEmpty/Internal.purs", + "vendored_sha256": "fd4e4b50ed2df17c5ed38899b505cd256fc0c719c111e2cb75c237905d7e16d6", + "vendored_lines": 81, + "self_recursions": [ + { + "name": "foldr1Impl", + "line": 76, + "equation": "foldr1Impl = foldr1Impl", + "replaces_upstream_foreign": true + }, + { + "name": "foldl1Impl", + "line": 78, + "equation": "foldl1Impl = foldl1Impl", + "replaces_upstream_foreign": true + }, + { + "name": "traverse1Impl", + "line": 81, + "equation": "traverse1Impl = traverse1Impl", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "59ce6b9e860ccdd2a089fb055008b629cd9362bb3a7f703e6bd1fb2f7a642ae6", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty/Internal.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "foldr1Impl", + "line": 75, + "declaration": "foreign import foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "foldl1Impl", + "line": 76, + "declaration": "foreign import foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "traverse1Impl", + "line": 78, + "declaration": "foreign import traverse1Impl :: forall m a b . Fn3 (forall a' b'. (m (a' -> b') -> m a' -> m b')) (forall a' b'. (a' -> b') -> m a' -> m b') (a -> m b) (NonEmptyArray a -> m (NonEmptyArray b))", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/NonEmpty.purs", + "vendored_sha256": "4e42eb0655fef616939cdf91f8e87b8c5e3581f34a538a2066cd9a644302b8d4", + "vendored_lines": 598, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "4e42eb0655fef616939cdf91f8e87b8c5e3581f34a538a2066cd9a644302b8d4", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/Partial.purs", + "vendored_sha256": "21c2d565d728a650e1f0e3521570c518434a97aaad087893237d20c18fda8184", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "21c2d565d728a650e1f0e3521570c518434a97aaad087893237d20c18fda8184", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/Partial.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/ST/Iterator.purs", + "vendored_sha256": "96dd803b0c983a56714d1dbbf6d86193c245660e6acb4faffa2cec6f6e1d2583", + "vendored_lines": 80, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "96dd803b0c983a56714d1dbbf6d86193c245660e6acb4faffa2cec6f6e1d2583", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST/Iterator.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/ST/Partial.purs", + "vendored_sha256": "f834cdae62ba2e555925960d091ffc4d0af4f4c90c0cf3b98b9ae2446ba00258", + "vendored_lines": 38, + "self_recursions": [ + { + "name": "peekImpl", + "line": 25, + "equation": "peekImpl = peekImpl", + "replaces_upstream_foreign": true + }, + { + "name": "pokeImpl", + "line": 38, + "equation": "pokeImpl = pokeImpl", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "dd9dfaae9bd0942eb341324035ed96880dcf2e167033ef8164d700270af5957a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST/Partial.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "peekImpl", + "line": 24, + "declaration": "foreign import peekImpl :: forall h a. STFn2 Int (STArray h a) h a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pokeImpl", + "line": 36, + "declaration": "foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/ST.purs", + "vendored_sha256": "1c64f5c7bc92eb07d5d5bee4671e226c45ed1235a6854183a4cf71cf43da3024", + "vendored_lines": 265, + "self_recursions": [ + { + "name": "unsafeFreezeImpl", + "line": 79, + "equation": "unsafeFreezeImpl = unsafeFreezeImpl", + "replaces_upstream_foreign": true + }, + { + "name": "unsafeThawImpl", + "line": 87, + "equation": "unsafeThawImpl = unsafeThawImpl", + "replaces_upstream_foreign": true + }, + { + "name": "new", + "line": 91, + "equation": "new = new", + "replaces_upstream_foreign": true + }, + { + "name": "thawImpl", + "line": 101, + "equation": "thawImpl = thawImpl", + "replaces_upstream_foreign": true + }, + { + "name": "cloneImpl", + "line": 111, + "equation": "cloneImpl = cloneImpl", + "replaces_upstream_foreign": true + }, + { + "name": "shiftImpl", + "line": 123, + "equation": "shiftImpl = shiftImpl", + "replaces_upstream_foreign": true + }, + { + "name": "sortByImpl", + "line": 139, + "equation": "sortByImpl = sortByImpl", + "replaces_upstream_foreign": true + }, + { + "name": "freezeImpl", + "line": 159, + "equation": "freezeImpl = freezeImpl", + "replaces_upstream_foreign": true + }, + { + "name": "peekImpl", + "line": 170, + "equation": "peekImpl = peekImpl", + "replaces_upstream_foreign": true + }, + { + "name": "pokeImpl", + "line": 182, + "equation": "pokeImpl = pokeImpl", + "replaces_upstream_foreign": true + }, + { + "name": "lengthImpl", + "line": 185, + "equation": "lengthImpl = lengthImpl", + "replaces_upstream_foreign": true + }, + { + "name": "popImpl", + "line": 196, + "equation": "popImpl = popImpl", + "replaces_upstream_foreign": true + }, + { + "name": "pushImpl", + "line": 204, + "equation": "pushImpl = pushImpl", + "replaces_upstream_foreign": true + }, + { + "name": "pushAllImpl", + "line": 216, + "equation": "pushAllImpl = pushAllImpl", + "replaces_upstream_foreign": true + }, + { + "name": "unshiftAllImpl", + "line": 233, + "equation": "unshiftAllImpl = unshiftAllImpl", + "replaces_upstream_foreign": true + }, + { + "name": "spliceImpl", + "line": 254, + "equation": "spliceImpl = spliceImpl", + "replaces_upstream_foreign": true + }, + { + "name": "toAssocArrayImpl", + "line": 265, + "equation": "toAssocArrayImpl = toAssocArrayImpl", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "4af1b59e242a89e3e5aa427c4486fce587173b3008f369d9d00de398a84ea4dc", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeFreezeImpl", + "line": 78, + "declaration": "foreign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unsafeThawImpl", + "line": 85, + "declaration": "foreign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "new", + "line": 88, + "declaration": "foreign import new :: forall h a. ST h (STArray h a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "thawImpl", + "line": 97, + "declaration": "foreign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "cloneImpl", + "line": 106, + "declaration": "foreign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "shiftImpl", + "line": 117, + "declaration": "foreign import shiftImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "sortByImpl", + "line": 134, + "declaration": "foreign import sortByImpl :: forall a h . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "freezeImpl", + "line": 155, + "declaration": "foreign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "peekImpl", + "line": 165, + "declaration": "foreign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pokeImpl", + "line": 176, + "declaration": "foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "lengthImpl", + "line": 178, + "declaration": "foreign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "popImpl", + "line": 188, + "declaration": "foreign import popImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pushImpl", + "line": 197, + "declaration": "foreign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pushAllImpl", + "line": 208, + "declaration": "foreign import pushAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unshiftAllImpl", + "line": 226, + "declaration": "foreign import unshiftAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "spliceImpl", + "line": 248, + "declaration": "foreign import spliceImpl :: forall h a . STFn4 Int Int (Array a) (STArray h a) h (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toAssocArrayImpl", + "line": 260, + "declaration": "foreign import toAssocArrayImpl :: forall h a . STFn1 (STArray h a) h (Array (Assoc a))", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array.purs", + "vendored_sha256": "3ad283dd652df5defdd1e9f58ca18f331a72e38ef725fc28150f2cb4c0335c0a", + "vendored_lines": 1335, + "self_recursions": [ + { + "name": "fromFoldableImpl", + "line": 178, + "equation": "fromFoldableImpl = fromFoldableImpl", + "replaces_upstream_foreign": true + }, + { + "name": "rangeImpl", + "line": 195, + "equation": "rangeImpl = rangeImpl", + "replaces_upstream_foreign": true + }, + { + "name": "replicateImpl", + "line": 205, + "equation": "replicateImpl = replicateImpl", + "replaces_upstream_foreign": true + }, + { + "name": "length", + "line": 245, + "equation": "length a0 = length a0", + "replaces_upstream_foreign": true + }, + { + "name": "unconsImpl", + "line": 376, + "equation": "unconsImpl = unconsImpl", + "replaces_upstream_foreign": true + }, + { + "name": "indexImpl", + "line": 407, + "equation": "indexImpl = indexImpl", + "replaces_upstream_foreign": true + }, + { + "name": "findMapImpl", + "line": 463, + "equation": "findMapImpl = findMapImpl", + "replaces_upstream_foreign": true + }, + { + "name": "findIndexImpl", + "line": 476, + "equation": "findIndexImpl = findIndexImpl", + "replaces_upstream_foreign": true + }, + { + "name": "findLastIndexImpl", + "line": 489, + "equation": "findLastIndexImpl = findLastIndexImpl", + "replaces_upstream_foreign": true + }, + { + "name": "_insertAt", + "line": 503, + "equation": "_insertAt = _insertAt", + "replaces_upstream_foreign": true + }, + { + "name": "_deleteAt", + "line": 517, + "equation": "_deleteAt = _deleteAt", + "replaces_upstream_foreign": true + }, + { + "name": "_updateAt", + "line": 531, + "equation": "_updateAt = _updateAt", + "replaces_upstream_foreign": true + }, + { + "name": "reverse", + "line": 605, + "equation": "reverse a0 = reverse a0", + "replaces_upstream_foreign": true + }, + { + "name": "concat", + "line": 614, + "equation": "concat a0 = concat a0", + "replaces_upstream_foreign": true + }, + { + "name": "filterImpl", + "line": 638, + "equation": "filterImpl = filterImpl", + "replaces_upstream_foreign": true + }, + { + "name": "partitionImpl", + "line": 656, + "equation": "partitionImpl = partitionImpl", + "replaces_upstream_foreign": true + }, + { + "name": "scanlImpl", + "line": 820, + "equation": "scanlImpl = scanlImpl", + "replaces_upstream_foreign": true + }, + { + "name": "scanrImpl", + "line": 834, + "equation": "scanrImpl = scanrImpl", + "replaces_upstream_foreign": true + }, + { + "name": "sortByImpl", + "line": 879, + "equation": "sortByImpl = sortByImpl", + "replaces_upstream_foreign": true + }, + { + "name": "sliceImpl", + "line": 898, + "equation": "sliceImpl = sliceImpl", + "replaces_upstream_foreign": true + }, + { + "name": "zipWithImpl", + "line": 1220, + "equation": "zipWithImpl = zipWithImpl", + "replaces_upstream_foreign": true + }, + { + "name": "anyImpl", + "line": 1284, + "equation": "anyImpl = anyImpl", + "replaces_upstream_foreign": true + }, + { + "name": "allImpl", + "line": 1299, + "equation": "allImpl = allImpl", + "replaces_upstream_foreign": true + }, + { + "name": "unsafeIndexImpl", + "line": 1335, + "equation": "unsafeIndexImpl = unsafeIndexImpl", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "d336825bf660ee79f03c559eaa1a22f41ec5a194b8cce79c5b24877160c32455", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "fromFoldableImpl", + "line": 177, + "declaration": "foreign import fromFoldableImpl :: forall f a . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "rangeImpl", + "line": 195, + "declaration": "foreign import rangeImpl :: Fn2 Int Int (Array Int)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "replicateImpl", + "line": 204, + "declaration": "foreign import replicateImpl :: forall a. Fn2 Int a (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "length", + "line": 243, + "declaration": "foreign import length :: forall a. Array a -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unconsImpl", + "line": 373, + "declaration": "foreign import unconsImpl :: forall a b . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b", + "vendored_status": "direct_self_recursion" + }, + { + "name": "indexImpl", + "line": 405, + "declaration": "foreign import indexImpl :: forall a . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "findMapImpl", + "line": 462, + "declaration": "foreign import findMapImpl :: forall a b . Fn4 (forall c. Maybe c) (forall c. Maybe c -> Boolean) (a -> Maybe b) (Array a) (Maybe b)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "findIndexImpl", + "line": 481, + "declaration": "foreign import findIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "findLastIndexImpl", + "line": 500, + "declaration": "foreign import findLastIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_insertAt", + "line": 520, + "declaration": "foreign import _insertAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a))", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_deleteAt", + "line": 541, + "declaration": "foreign import _deleteAt :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) Int (Array a) (Maybe (Array a))", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_updateAt", + "line": 561, + "declaration": "foreign import _updateAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a))", + "vendored_status": "direct_self_recursion" + }, + { + "name": "reverse", + "line": 642, + "declaration": "foreign import reverse :: forall a. Array a -> Array a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "concat", + "line": 650, + "declaration": "foreign import concat :: forall a. Array (Array a) -> Array a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "filterImpl", + "line": 673, + "declaration": "foreign import filterImpl :: forall a . Fn2 (a -> Boolean) (Array a) (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "partitionImpl", + "line": 692, + "declaration": "foreign import partitionImpl :: forall a . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a }", + "vendored_status": "direct_self_recursion" + }, + { + "name": "scanlImpl", + "line": 857, + "declaration": "foreign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "scanrImpl", + "line": 870, + "declaration": "foreign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "sortByImpl", + "line": 914, + "declaration": "foreign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "sliceImpl", + "line": 932, + "declaration": "foreign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "zipWithImpl", + "line": 1253, + "declaration": "foreign import zipWithImpl :: forall a b c . Fn3 (a -> b -> c) (Array a) (Array b) (Array c)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "anyImpl", + "line": 1322, + "declaration": "foreign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "allImpl", + "line": 1336, + "declaration": "foreign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unsafeIndexImpl", + "line": 1371, + "declaration": "foreign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bifoldable.purs", + "vendored_sha256": "ba0f8f91040f1e49a0ef10ad012eb9be475fa820332eb3d6bca9345c1a3c4446", + "vendored_lines": 198, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "ba0f8f91040f1e49a0ef10ad012eb9be475fa820332eb3d6bca9345c1a3c4446", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Bifoldable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bifunctor/Join.purs", + "vendored_sha256": "5db9d1533e678809804465de95637fa980d264314428d25f18e10b673bba1308", + "vendored_lines": 31, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "5db9d1533e678809804465de95637fa980d264314428d25f18e10b673bba1308", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Data/Bifunctor/Join.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bifunctor.purs", + "vendored_sha256": "00c91e7e32934e59b1196a793247218670ed5ad6c69acb8ef4eec27db63a8e1a", + "vendored_lines": 46, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "00c91e7e32934e59b1196a793247218670ed5ad6c69acb8ef4eec27db63a8e1a", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Data/Bifunctor.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bitraversable.purs", + "vendored_sha256": "1f6eae4a9fb4457664d7fa4c822b451d15a1d320a28b12f81010622885e2cb84", + "vendored_lines": 136, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "1f6eae4a9fb4457664d7fa4c822b451d15a1d320a28b12f81010622885e2cb84", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Bitraversable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Boolean.purs", + "vendored_sha256": "cbffb99db81cebc7626ab43b43f785f62ffe8c59b3781174907b05d8fb171eb2", + "vendored_lines": 10, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "cbffb99db81cebc7626ab43b43f785f62ffe8c59b3781174907b05d8fb171eb2", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Boolean.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/BooleanAlgebra.purs", + "vendored_sha256": "cc5bcc84af3a96675d3b8ee03b7754a818dd0dd49d20248cf0e17c4793f5ba96", + "vendored_lines": 43, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "cc5bcc84af3a96675d3b8ee03b7754a818dd0dd49d20248cf0e17c4793f5ba96", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/BooleanAlgebra.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bounded/Generic.purs", + "vendored_sha256": "110cac55f2eadb6a6614397a31b5c167e20983d3ccdce89647ee975e24058f3f", + "vendored_lines": 56, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "110cac55f2eadb6a6614397a31b5c167e20983d3ccdce89647ee975e24058f3f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bounded.purs", + "vendored_sha256": "eae601093ee50d2d6134073077d098b8d87a141a9bc5237bad185107fc5a4c10", + "vendored_lines": 111, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "f67cb72dce353b0eecdd53214a76f879e52eba6335f1305c2ea744063c913d0a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "topInt", + "line": 40, + "declaration": "foreign import topInt :: Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "bottomInt", + "line": 41, + "declaration": "foreign import bottomInt :: Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "topChar", + "line": 48, + "declaration": "foreign import topChar :: Char", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "bottomChar", + "line": 49, + "declaration": "foreign import bottomChar :: Char", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "topNumber", + "line": 59, + "declaration": "foreign import topNumber :: Number", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "bottomNumber", + "line": 60, + "declaration": "foreign import bottomNumber :: Number", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Char/Gen.purs", + "vendored_sha256": "3ddf70117671935799e26aade08e1f932221200ab98a1b50c90ad50c090a6ec2", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "3ddf70117671935799e26aade08e1f932221200ab98a1b50c90ad50c090a6ec2", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/Char/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Char.purs", + "vendored_sha256": "3923ba1cf2abddfc3d4bebb1a2f84f198aa9b23b1fae8e68a281f2188cc79ee7", + "vendored_lines": 16, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "3923ba1cf2abddfc3d4bebb1a2f84f198aa9b23b1fae8e68a281f2188cc79ee7", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/Char.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/CommutativeRing.purs", + "vendored_sha256": "bcb4f94840a1544d53287ef6d44e51f8af66119f12910d3678f101a78a7fea05", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "bcb4f94840a1544d53287ef6d44e51f8af66119f12910d3678f101a78a7fea05", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/CommutativeRing.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Compactable.purs", + "vendored_sha256": "431fbe83796ed62eecb1e3311a7f4a7e5601aee50c611fcb11eff5f29bfe143a", + "vendored_lines": 164, + "self_recursions": [], + "package": "purescript-filterable", + "tag": "v5.0.0", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "upstream_sha256": "431fbe83796ed62eecb1e3311a7f4a7e5601aee50c611fcb11eff5f29bfe143a", + "upstream_url": "https://github.com/purescript/purescript-filterable/blob/7c5b8c72779997f2b17d12ce478ff81e7ddda285/src/Data/Compactable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Comparison.purs", + "vendored_sha256": "b94e588dbd3b667ef023394842ed4d0e2afb10b8b315173f5e1095fc3094fc02", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "b94e588dbd3b667ef023394842ed4d0e2afb10b8b315173f5e1095fc3094fc02", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Comparison.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Const.purs", + "vendored_sha256": "a6e5d9429e810f5b834720a35e3103c4f271ca6401b19e7f7f8250e96cb04828", + "vendored_lines": 63, + "self_recursions": [], + "package": "purescript-const", + "tag": "v6.0.0", + "commit": "ab9570cf2b6e67f7e441178211db1231cfd75c37", + "upstream_sha256": "a6e5d9429e810f5b834720a35e3103c4f271ca6401b19e7f7f8250e96cb04828", + "upstream_url": "https://github.com/purescript/purescript-const/blob/ab9570cf2b6e67f7e441178211db1231cfd75c37/src/Data/Const.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Decidable.purs", + "vendored_sha256": "d3260262715019947e3db7351810c3af103bd86cc4e94dcca3a28c22a3d3072a", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "d3260262715019947e3db7351810c3af103bd86cc4e94dcca3a28c22a3d3072a", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Decidable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Decide.purs", + "vendored_sha256": "0301661ba4052b57c193b57cac94dd78ebdb40ae91eb1d182637e6a68d8c9718", + "vendored_lines": 42, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "0301661ba4052b57c193b57cac94dd78ebdb40ae91eb1d182637e6a68d8c9718", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Decide.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Distributive.purs", + "vendored_sha256": "47bf3b62d71dbeef667007924b75ea18cc4179ef1f111a359d19463e1fa49279", + "vendored_lines": 67, + "self_recursions": [], + "package": "purescript-distributive", + "tag": "v6.0.0", + "commit": "6005e513642e855ebf6f884d24a35c2803ca252a", + "upstream_sha256": "47bf3b62d71dbeef667007924b75ea18cc4179ef1f111a359d19463e1fa49279", + "upstream_url": "https://github.com/purescript/purescript-distributive/blob/6005e513642e855ebf6f884d24a35c2803ca252a/src/Data/Distributive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Divide.purs", + "vendored_sha256": "cc9f771f056da1b686569a299b46fd0d09be4544bda5e95a01551ce4e0f2d021", + "vendored_lines": 46, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "cc9f771f056da1b686569a299b46fd0d09be4544bda5e95a01551ce4e0f2d021", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Divide.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Divisible.purs", + "vendored_sha256": "fe939175ea5070c0233b11fbf6dd035bae54a6e590dc47253977bbfba7beae82", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "fe939175ea5070c0233b11fbf6dd035bae54a6e590dc47253977bbfba7beae82", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Divisible.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/DivisionRing.purs", + "vendored_sha256": "be3721f83db50d4d1bcc6f2cba1cb30e2be39b376440e215c79ab0e0d7b688f5", + "vendored_lines": 55, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "be3721f83db50d4d1bcc6f2cba1cb30e2be39b376440e215c79ab0e0d7b688f5", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/DivisionRing.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Either/Inject.purs", + "vendored_sha256": "95f071e80bf9658d34b08093bc03ee3fbbb9ef6af3457ad4f203c396ea507e41", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-either", + "tag": "v6.1.0", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "upstream_sha256": "95f071e80bf9658d34b08093bc03ee3fbbb9ef6af3457ad4f203c396ea507e41", + "upstream_url": "https://github.com/purescript/purescript-either/blob/af655a04ed2fd694b6688af39ee20d7907ad0763/src/Data/Either/Inject.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Either/Nested.purs", + "vendored_sha256": "fa22a911e6c9f62dd7f1bfabfb98962824f75a7f5291e6fafc628dba658cb274", + "vendored_lines": 278, + "self_recursions": [], + "package": "purescript-either", + "tag": "v6.1.0", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "upstream_sha256": "fa22a911e6c9f62dd7f1bfabfb98962824f75a7f5291e6fafc628dba658cb274", + "upstream_url": "https://github.com/purescript/purescript-either/blob/af655a04ed2fd694b6688af39ee20d7907ad0763/src/Data/Either/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Either.purs", + "vendored_sha256": "047a8ae72c32cd064fddb773a739dc130c0cce615270d403491898fbf6c6f5d9", + "vendored_lines": 294, + "self_recursions": [], + "package": "purescript-either", + "tag": "v6.1.0", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "upstream_sha256": "047a8ae72c32cd064fddb773a739dc130c0cce615270d403491898fbf6c6f5d9", + "upstream_url": "https://github.com/purescript/purescript-either/blob/af655a04ed2fd694b6688af39ee20d7907ad0763/src/Data/Either.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Enum/Gen.purs", + "vendored_sha256": "3d7234b9dd417d2a31510cf22c691da3cfd0bb4a7bc2265c68cbae019dbcdc13", + "vendored_lines": 18, + "self_recursions": [], + "package": "purescript-enums", + "tag": "v6.0.1", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "upstream_sha256": "3d7234b9dd417d2a31510cf22c691da3cfd0bb4a7bc2265c68cbae019dbcdc13", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Enum/Generic.purs", + "vendored_sha256": "1c9eea073e25c24c7cca9455487ebec47f0072b1ecba7e2076e7da56fa473846", + "vendored_lines": 118, + "self_recursions": [], + "package": "purescript-enums", + "tag": "v6.0.1", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "upstream_sha256": "1c9eea073e25c24c7cca9455487ebec47f0072b1ecba7e2076e7da56fa473846", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Enum.purs", + "vendored_sha256": "ce04da7763ab6d7e6a00d63702f6dfd38f0b9101d101b04851281badc8445dfa", + "vendored_lines": 323, + "self_recursions": [ + { + "name": "toCharCode", + "line": 321, + "equation": "toCharCode a0 = toCharCode a0", + "replaces_upstream_foreign": true + }, + { + "name": "fromCharCode", + "line": 323, + "equation": "fromCharCode a0 = fromCharCode a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-enums", + "tag": "v6.0.1", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "upstream_sha256": "a7ffaa7a8cc15c362852409f1aba80a5b7792d89353635d54317d43e864e5e9c", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "toCharCode", + "line": 320, + "declaration": "foreign import toCharCode :: Char -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "fromCharCode", + "line": 321, + "declaration": "foreign import fromCharCode :: Int -> Char", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Eq/Generic.purs", + "vendored_sha256": "9cd6184fb35329e232a2b593e1e3404e89692b36b99104f800bfe23894627373", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9cd6184fb35329e232a2b593e1e3404e89692b36b99104f800bfe23894627373", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Eq.purs", + "vendored_sha256": "fdc7df1e5faaa15fdbb1a57c247592f4bc31ca8c9b794edf3fd42280f6270cb7", + "vendored_lines": 134, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "53036679ea014e3c452fce0ee8ce26f58de222cd88eed2586d6dd7dcea3fd872", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "eqBooleanImpl", + "line": 77, + "declaration": "foreign import eqBooleanImpl :: Boolean -> Boolean -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "eqIntImpl", + "line": 78, + "declaration": "foreign import eqIntImpl :: Int -> Int -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "eqNumberImpl", + "line": 79, + "declaration": "foreign import eqNumberImpl :: Number -> Number -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "eqCharImpl", + "line": 80, + "declaration": "foreign import eqCharImpl :: Char -> Char -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "eqStringImpl", + "line": 81, + "declaration": "foreign import eqStringImpl :: String -> String -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "eqArrayImpl", + "line": 83, + "declaration": "foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 48, + "text": " eq = eqBooleanImpl" + }, + { + "line": 51, + "text": " eq = eqIntImpl" + }, + { + "line": 54, + "text": " eq = eqNumberImpl" + }, + { + "line": 57, + "text": " eq = eqCharImpl" + }, + { + "line": 60, + "text": " eq = eqStringImpl" + }, + { + "line": 69, + "text": " eq = eqArrayImpl eq" + } + ] + }, + { + "path": "Data/Equivalence.purs", + "vendored_sha256": "82d547469f77f4be0ba5c8f151d623a12a2a3edaa3d7b65c7f01110ed696932f", + "vendored_lines": 31, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "82d547469f77f4be0ba5c8f151d623a12a2a3edaa3d7b65c7f01110ed696932f", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Equivalence.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/EuclideanRing.purs", + "vendored_sha256": "45b6572552d2728c43d0c00668239ca748f6522512d9d093aeefb719a3bb927f", + "vendored_lines": 105, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "15d83e118a173ae91fff5b12152afdacc549c12da0a541602d0cf5d702fae863", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/EuclideanRing.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "intDegree", + "line": 84, + "declaration": "foreign import intDegree :: Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "intDiv", + "line": 85, + "declaration": "foreign import intDiv :: Int -> Int -> Int", + "vendored_status": "declaration_removed" + }, + { + "name": "intMod", + "line": 86, + "declaration": "foreign import intMod :: Int -> Int -> Int", + "vendored_status": "declaration_removed" + }, + { + "name": "numDiv", + "line": 88, + "declaration": "foreign import numDiv :: Number -> Number -> Number", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 75, + "text": " degree = intDegree" + }, + { + "line": 76, + "text": " div = intDiv" + }, + { + "line": 77, + "text": " mod = intMod" + }, + { + "line": 81, + "text": " div = numDiv" + } + ] + }, + { + "path": "Data/Exists.purs", + "vendored_sha256": "74aec7e155ecd0bac49cacb3f87506223193a5f0ff4ae1dd0a8e134775d7794d", + "vendored_lines": 57, + "self_recursions": [], + "package": "purescript-exists", + "tag": "v6.0.0", + "commit": "f765b4ace7869c27b9c05949e18c843881f9173b", + "upstream_sha256": "74aec7e155ecd0bac49cacb3f87506223193a5f0ff4ae1dd0a8e134775d7794d", + "upstream_url": "https://github.com/purescript/purescript-exists/blob/f765b4ace7869c27b9c05949e18c843881f9173b/src/Data/Exists.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Field.purs", + "vendored_sha256": "a27a8bb18ff139cd8eb5c7512c9aa999050faad79f02727e285360b2cda5f06d", + "vendored_lines": 41, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "a27a8bb18ff139cd8eb5c7512c9aa999050faad79f02727e285360b2cda5f06d", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Field.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Filterable.purs", + "vendored_sha256": "459ef72163c124e3ea0f24a4682773ba8562dc9a1e8709a994eb3bd0aa3895bf", + "vendored_lines": 229, + "self_recursions": [], + "package": "purescript-filterable", + "tag": "v5.0.0", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "upstream_sha256": "459ef72163c124e3ea0f24a4682773ba8562dc9a1e8709a994eb3bd0aa3895bf", + "upstream_url": "https://github.com/purescript/purescript-filterable/blob/7c5b8c72779997f2b17d12ce478ff81e7ddda285/src/Data/Filterable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Foldable.purs", + "vendored_sha256": "3b833665daa379ff65f822737d6dccef23c1c068b4f813d0519e765285095ae0", + "vendored_lines": 473, + "self_recursions": [ + { + "name": "foldrArray", + "line": 136, + "equation": "foldrArray a0 a1 a2 = foldrArray a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "foldlArray", + "line": 138, + "equation": "foldlArray a0 a1 a2 = foldlArray a0 a1 a2", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "5557319b5a97cf265d53cd68266d721b31f28de3240b10e7728adae8a2070052", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Foldable.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "foldrArray", + "line": 135, + "declaration": "foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b", + "vendored_status": "direct_self_recursion" + }, + { + "name": "foldlArray", + "line": 136, + "declaration": "foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 226, + "text": "fold = foldMap identity" + } + ] + }, + { + "path": "Data/FoldableWithIndex.purs", + "vendored_sha256": "2e10b31b454a84f9597ddb15e43fcfa5bfa84cae8cc5e8b6bbbc5a2018755944", + "vendored_lines": 370, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "2e10b31b454a84f9597ddb15e43fcfa5bfa84cae8cc5e8b6bbbc5a2018755944", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/FoldableWithIndex.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Function/Uncurried.purs", + "vendored_sha256": "2b7328f13a13d5cf244fd08aba8c6e35027ac514de02b8a92ce13c0232141eaa", + "vendored_lines": 144, + "self_recursions": [ + { + "name": "mkFn0", + "line": 60, + "equation": "mkFn0 a0 = mkFn0 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn2", + "line": 68, + "equation": "mkFn2 a0 = mkFn2 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn3", + "line": 72, + "equation": "mkFn3 a0 = mkFn3 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn4", + "line": 76, + "equation": "mkFn4 a0 = mkFn4 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn5", + "line": 80, + "equation": "mkFn5 a0 = mkFn5 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn6", + "line": 84, + "equation": "mkFn6 a0 = mkFn6 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn7", + "line": 88, + "equation": "mkFn7 a0 = mkFn7 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn8", + "line": 92, + "equation": "mkFn8 a0 = mkFn8 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn9", + "line": 96, + "equation": "mkFn9 a0 = mkFn9 a0", + "replaces_upstream_foreign": true + }, + { + "name": "mkFn10", + "line": 100, + "equation": "mkFn10 a0 = mkFn10 a0", + "replaces_upstream_foreign": true + }, + { + "name": "runFn0", + "line": 104, + "equation": "runFn0 a0 = runFn0 a0", + "replaces_upstream_foreign": true + }, + { + "name": "runFn2", + "line": 112, + "equation": "runFn2 a0 a1 a2 = runFn2 a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "runFn3", + "line": 116, + "equation": "runFn3 a0 a1 a2 a3 = runFn3 a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "runFn4", + "line": 120, + "equation": "runFn4 a0 a1 a2 a3 a4 = runFn4 a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + }, + { + "name": "runFn5", + "line": 124, + "equation": "runFn5 a0 a1 a2 a3 a4 a5 = runFn5 a0 a1 a2 a3 a4 a5", + "replaces_upstream_foreign": true + }, + { + "name": "runFn6", + "line": 128, + "equation": "runFn6 a0 a1 a2 a3 a4 a5 a6 = runFn6 a0 a1 a2 a3 a4 a5 a6", + "replaces_upstream_foreign": true + }, + { + "name": "runFn7", + "line": 132, + "equation": "runFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runFn7 a0 a1 a2 a3 a4 a5 a6 a7", + "replaces_upstream_foreign": true + }, + { + "name": "runFn8", + "line": 136, + "equation": "runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8", + "replaces_upstream_foreign": true + }, + { + "name": "runFn9", + "line": 140, + "equation": "runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9", + "replaces_upstream_foreign": true + }, + { + "name": "runFn10", + "line": 144, + "equation": "runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-functions", + "tag": "v6.0.0", + "commit": "f626f20580483977c5b27a01aac6471e28aff367", + "upstream_sha256": "4e210a49f64e1862cc8530bcbe661c350c964568bbfa2f79bbb1fbe394152d02", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "mkFn0", + "line": 59, + "declaration": "foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn2", + "line": 66, + "declaration": "foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn3", + "line": 69, + "declaration": "foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn4", + "line": 72, + "declaration": "foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn5", + "line": 75, + "declaration": "foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn6", + "line": 78, + "declaration": "foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn7", + "line": 81, + "declaration": "foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn8", + "line": 84, + "declaration": "foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn9", + "line": 87, + "declaration": "foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j", + "vendored_status": "direct_self_recursion" + }, + { + "name": "mkFn10", + "line": 90, + "declaration": "foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn0", + "line": 93, + "declaration": "foreign import runFn0 :: forall a. Fn0 a -> a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn2", + "line": 100, + "declaration": "foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn3", + "line": 103, + "declaration": "foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn4", + "line": 106, + "declaration": "foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn5", + "line": 109, + "declaration": "foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn6", + "line": 112, + "declaration": "foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn7", + "line": 115, + "declaration": "foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn8", + "line": 118, + "declaration": "foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn9", + "line": 121, + "declaration": "foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j", + "vendored_status": "direct_self_recursion" + }, + { + "name": "runFn10", + "line": 124, + "declaration": "foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Function.purs", + "vendored_sha256": "2142b200f60953ac4fe648b765da7cf6cfb046e8600ffef3484a7f3e4f8f03b7", + "vendored_lines": 120, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "2142b200f60953ac4fe648b765da7cf6cfb046e8600ffef3484a7f3e4f8f03b7", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Function.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/App.purs", + "vendored_sha256": "2c90077463cc2deb82dc888dd7c6fc10fa465d444c7b48fa042b4a2d4e834711", + "vendored_lines": 56, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "2c90077463cc2deb82dc888dd7c6fc10fa465d444c7b48fa042b4a2d4e834711", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/App.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Clown.purs", + "vendored_sha256": "9e0ee4050d69d24a0965026576288b9742f1e77941b819d510e1317bbe1ca1c2", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "9e0ee4050d69d24a0965026576288b9742f1e77941b819d510e1317bbe1ca1c2", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Clown.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Compose.purs", + "vendored_sha256": "1ea6725c558c1d8424b8e8bf03331879bcc589ec95ef0208dea7dcb90861d202", + "vendored_lines": 58, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "1ea6725c558c1d8424b8e8bf03331879bcc589ec95ef0208dea7dcb90861d202", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Compose.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Contravariant.purs", + "vendored_sha256": "ecb01e255618d9b446bc72d042d10c44a84ce7b10df14f838e50fa49a8ddd4ab", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "ecb01e255618d9b446bc72d042d10c44a84ce7b10df14f838e50fa49a8ddd4ab", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Functor/Contravariant.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Coproduct/Inject.purs", + "vendored_sha256": "dfccf4433db792b3a1246b72b7aab69d39a593750c242a741a4adc92a012b743", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "dfccf4433db792b3a1246b72b7aab69d39a593750c242a741a4adc92a012b743", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Coproduct/Inject.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Coproduct/Nested.purs", + "vendored_sha256": "efd0e04c36996fd958425c21f3c6748cf3c08abf4ff014b09eca3687937e193c", + "vendored_lines": 273, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "efd0e04c36996fd958425c21f3c6748cf3c08abf4ff014b09eca3687937e193c", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Coproduct/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Coproduct.purs", + "vendored_sha256": "bdef394de4a506431d3397ed765e861daf47989882f1f8d97419edb312a62637", + "vendored_lines": 76, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "bdef394de4a506431d3397ed765e861daf47989882f1f8d97419edb312a62637", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Coproduct.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Costar.purs", + "vendored_sha256": "3bde423fa6f47a635e62c4a55fa4eb1ebbd32dcb5776b748bb4bc59b892c77b5", + "vendored_lines": 66, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "3bde423fa6f47a635e62c4a55fa4eb1ebbd32dcb5776b748bb4bc59b892c77b5", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Costar.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Flip.purs", + "vendored_sha256": "b3d31bfa23a05a6ed6c4185775bb45ff2e0c562cd9c95c711b1cf636459c153b", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "b3d31bfa23a05a6ed6c4185775bb45ff2e0c562cd9c95c711b1cf636459c153b", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Flip.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Invariant.purs", + "vendored_sha256": "070d432e594b5423ebd865d101dbddaf1bd64690917a6ebeabd559393c152f26", + "vendored_lines": 57, + "self_recursions": [], + "package": "purescript-invariant", + "tag": "v6.0.0", + "commit": "1d2a196d51e90623adb88496c2cfd759c6736894", + "upstream_sha256": "070d432e594b5423ebd865d101dbddaf1bd64690917a6ebeabd559393c152f26", + "upstream_url": "https://github.com/purescript/purescript-invariant/blob/1d2a196d51e90623adb88496c2cfd759c6736894/src/Data/Functor/Invariant.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Joker.purs", + "vendored_sha256": "3c32235123a30b6e38273bbfcf6cf50cef94d9a11e7da16e7ee3d7e0ed98cac4", + "vendored_lines": 60, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "3c32235123a30b6e38273bbfcf6cf50cef94d9a11e7da16e7ee3d7e0ed98cac4", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Joker.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Product/Nested.purs", + "vendored_sha256": "eabec66003663a5e64b64e6abf317a27e8660d5c09475bbd38d9219db0834580", + "vendored_lines": 112, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "eabec66003663a5e64b64e6abf317a27e8660d5c09475bbd38d9219db0834580", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Product/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Product.purs", + "vendored_sha256": "c43e912ffe484cfd0e01cafa143474e140f06a85c7177c9f2cc6b59b51d18a37", + "vendored_lines": 60, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "c43e912ffe484cfd0e01cafa143474e140f06a85c7177c9f2cc6b59b51d18a37", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Product.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Product2.purs", + "vendored_sha256": "80763924484595b34488d8cca7bd8e5d399aebc7a79442e1625d7ddbebec9c7c", + "vendored_lines": 40, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "80763924484595b34488d8cca7bd8e5d399aebc7a79442e1625d7ddbebec9c7c", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Product2.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor.purs", + "vendored_sha256": "4756955051839c40795329d7b32a26eec0db5425141731da22ed0fbc6723ab1d", + "vendored_lines": 114, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "fc5b0cc22a6c4d96a5779eb629cb304cebaa910f03a77192628c131a867bbeb8", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Functor.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "arrayMap", + "line": 55, + "declaration": "foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 50, + "text": " map = arrayMap" + }, + { + "line": 70, + "text": "void = map (const unit)" + }, + { + "line": 75, + "text": "voidRight x = map (const x)" + }, + { + "line": 81, + "text": "voidLeft f x = const x <$> f" + } + ] + }, + { + "path": "Data/FunctorWithIndex.purs", + "vendored_sha256": "41d57b2f4a7b3d785a1c0976351b4faf0dc0ce92717bf69f2b94e7e54c87942c", + "vendored_lines": 94, + "self_recursions": [ + { + "name": "mapWithIndexArray", + "line": 39, + "equation": "mapWithIndexArray a0 a1 = mapWithIndexArray a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "cdffaeb5485f7a5a12796b5db2a9a81b7212d50dacd6405a87bc3f57fbc15f6c", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/FunctorWithIndex.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "mapWithIndexArray", + "line": 38, + "declaration": "foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Generic/Rep.purs", + "vendored_sha256": "fc1e17e76bf53bf8dc86593ca2d27a77f921e8aa67bffcb6265fdc473736862d", + "vendored_lines": 62, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "fc1e17e76bf53bf8dc86593ca2d27a77f921e8aa67bffcb6265fdc473736862d", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Generic/Rep.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/HeytingAlgebra/Generic.purs", + "vendored_sha256": "e26f345cfc1d84df08677300132cfc93187e80a285e2f1228a45ae272e7f3260", + "vendored_lines": 70, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "c5022ab44881b51e4b62d06994d92f04b037ce97ff2c50054e4b90d91a463bbe", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra/Generic.purs", + "status": "newline_only", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/HeytingAlgebra.purs", + "vendored_sha256": "90b66ffc82855d35d43d568d5015bbf6b33917bb8e171db624467a6e9c35f7fc", + "vendored_lines": 174, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "797b9e8358e10691e93c8b1552723507fd12647441f90db11b01e35850bce75b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "boolConj", + "line": 103, + "declaration": "foreign import boolConj :: Boolean -> Boolean -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "boolDisj", + "line": 104, + "declaration": "foreign import boolDisj :: Boolean -> Boolean -> Boolean", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "boolNot", + "line": 105, + "declaration": "foreign import boolNot :: Boolean -> Boolean", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 67, + "text": " conj = boolConj" + }, + { + "line": 68, + "text": " disj = boolDisj" + }, + { + "line": 69, + "text": " not = boolNot" + } + ] + }, + { + "path": "Data/Identity.purs", + "vendored_sha256": "65f7f8ca763a00e78b46453c480a22e41e43dcda5a582cfea9eecd4b4448f87d", + "vendored_lines": 72, + "self_recursions": [], + "package": "purescript-identity", + "tag": "v6.0.0", + "commit": "ef6768f8a52ab0bc943a85f5761ba07c257f639f", + "upstream_sha256": "65f7f8ca763a00e78b46453c480a22e41e43dcda5a582cfea9eecd4b4448f87d", + "upstream_url": "https://github.com/purescript/purescript-identity/blob/ef6768f8a52ab0bc943a85f5761ba07c257f639f/src/Data/Identity.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Int/Bits.purs", + "vendored_sha256": "e0799d3e2f4611638dd57693399300590518cd45387e5ea014aa556af32a72ec", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-integers", + "tag": "v6.0.0", + "commit": "54d712b25c594833083d15dc9ff2418eb9c52822", + "upstream_sha256": "6377bce107895b0021264a30a35c8e50867b084349407009061728bb42c436de", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "and", + "line": 13, + "declaration": "foreign import and :: Int -> Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "or", + "line": 18, + "declaration": "foreign import or :: Int -> Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "xor", + "line": 23, + "declaration": "foreign import xor :: Int -> Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "shl", + "line": 28, + "declaration": "foreign import shl :: Int -> Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "shr", + "line": 31, + "declaration": "foreign import shr :: Int -> Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "zshr", + "line": 34, + "declaration": "foreign import zshr :: Int -> Int -> Int", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "complement", + "line": 37, + "declaration": "foreign import complement :: Int -> Int", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Int.purs", + "vendored_sha256": "d4ce869235bc1d0b0b8cb1415c51fbcf499319f3f332b258940f8ef9cc786b5d", + "vendored_lines": 255, + "self_recursions": [ + { + "name": "fromNumberImpl", + "line": 41, + "equation": "fromNumberImpl a0 a1 a2 = fromNumberImpl a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "toNumber", + "line": 79, + "equation": "toNumber a0 = toNumber a0", + "replaces_upstream_foreign": true + }, + { + "name": "quot", + "line": 226, + "equation": "quot a0 a1 = quot a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "rem", + "line": 245, + "equation": "rem a0 a1 = rem a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "pow", + "line": 249, + "equation": "pow a0 a1 = pow a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "fromStringAsImpl", + "line": 252, + "equation": "fromStringAsImpl a0 a1 a2 a3 = fromStringAsImpl a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "toStringAs", + "line": 255, + "equation": "toStringAs a0 a1 = toStringAs a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-integers", + "tag": "v6.0.0", + "commit": "54d712b25c594833083d15dc9ff2418eb9c52822", + "upstream_sha256": "53a7c199f384719a5f615faf6141e9b0ffa2fa9f66b9806d30a0f196be074eec", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "fromNumberImpl", + "line": 40, + "declaration": "foreign import fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toNumber", + "line": 81, + "declaration": "foreign import toNumber :: Int -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "quot", + "line": 227, + "declaration": "foreign import quot :: Int -> Int -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "rem", + "line": 245, + "declaration": "foreign import rem :: Int -> Int -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pow", + "line": 248, + "declaration": "foreign import pow :: Int -> Int -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "fromStringAsImpl", + "line": 250, + "declaration": "foreign import fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toStringAs", + "line": 257, + "declaration": "foreign import toStringAs :: Radix -> Int -> String", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Lazy.purs", + "vendored_sha256": "1a7a6fd1ac16db56608653d335d20573f0ff1861d3920990ea3a9ee4c49befcc", + "vendored_lines": 144, + "self_recursions": [ + { + "name": "defer", + "line": 36, + "equation": "defer a0 = defer a0", + "replaces_upstream_foreign": true + }, + { + "name": "force", + "line": 40, + "equation": "force a0 = force a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-lazy", + "tag": "v6.0.0", + "commit": "48347841226b27af5205a1a8ec71e27a93ce86fd", + "upstream_sha256": "9da5e2562a1a05764552d20dc3dc7119142550350a1f290d1919f502ebe54202", + "upstream_url": "https://github.com/purescript/purescript-lazy/blob/48347841226b27af5205a1a8ec71e27a93ce86fd/src/Data/Lazy.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "defer", + "line": 35, + "declaration": "foreign import defer :: forall a. (Unit -> a) -> Lazy a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "force", + "line": 38, + "declaration": "foreign import force :: forall a. Lazy a -> a", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Internal.purs", + "vendored_sha256": "9b542dbc4823476b26b6912cd0dbd47c3af97bc35f66f11b421aa59f28d6fc42", + "vendored_lines": 63, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "9b542dbc4823476b26b6912cd0dbd47c3af97bc35f66f11b421aa59f28d6fc42", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Lazy/NonEmpty.purs", + "vendored_sha256": "5b06d7bdbb485fa4766134635b43d22f1e148f0e4bbc61f7c4e78710686b2586", + "vendored_lines": 88, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "5b06d7bdbb485fa4766134635b43d22f1e148f0e4bbc61f7c4e78710686b2586", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Lazy/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Lazy/Types.purs", + "vendored_sha256": "68fa44b813560d340230fd122e965568c2920600c8153fd22219e27ab7307d64", + "vendored_lines": 295, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "68fa44b813560d340230fd122e965568c2920600c8153fd22219e27ab7307d64", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Lazy/Types.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Lazy.purs", + "vendored_sha256": "69f373e427611ef8124b9a49f4c02638aca287bc48bf095371da8afe090fe9b8", + "vendored_lines": 780, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "69f373e427611ef8124b9a49f4c02638aca287bc48bf095371da8afe090fe9b8", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Lazy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/NonEmpty.purs", + "vendored_sha256": "2b0911320ac74ddc1a80957592c965b370ee81de740f9c24f048d4f7d5c4b0d7", + "vendored_lines": 307, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "2b0911320ac74ddc1a80957592c965b370ee81de740f9c24f048d4f7d5c4b0d7", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Partial.purs", + "vendored_sha256": "95e40bb55ef84403901b6a19ac9367bae5cce79330703a8d4db60d57bf6fab4b", + "vendored_lines": 30, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "95e40bb55ef84403901b6a19ac9367bae5cce79330703a8d4db60d57bf6fab4b", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Partial.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Types.purs", + "vendored_sha256": "8a7d87397d8edc746e7fa1459d67e90ef9e2dd09bf7bd55baa9a4b549e316dd3", + "vendored_lines": 264, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "8a7d87397d8edc746e7fa1459d67e90ef9e2dd09bf7bd55baa9a4b549e316dd3", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Types.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/ZipList.purs", + "vendored_sha256": "09acb25d60dd823ee7ce94d33e5ac9bb46aee527638dd69ccf82f1532da13719", + "vendored_lines": 66, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "09acb25d60dd823ee7ce94d33e5ac9bb46aee527638dd69ccf82f1532da13719", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/ZipList.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List.purs", + "vendored_sha256": "fde72dc9da24f67efb446f57806890e95b3b40a4f0389ee313072de4cc2d56aa", + "vendored_lines": 826, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "fde72dc9da24f67efb446f57806890e95b3b40a4f0389ee313072de4cc2d56aa", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Map/Gen.purs", + "vendored_sha256": "9f2671c0a0a1efbad92a52b4e02517c06e08df9f741f59a9d8ae290d002a19e9", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "9f2671c0a0a1efbad92a52b4e02517c06e08df9f741f59a9d8ae290d002a19e9", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Map/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Map/Internal.purs", + "vendored_sha256": "03608bed5db4804aa898eff034bb5b2feab0676948b19aefa606dc927eeb5cc9", + "vendored_lines": 988, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "03608bed5db4804aa898eff034bb5b2feab0676948b19aefa606dc927eeb5cc9", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Map/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Map.purs", + "vendored_sha256": "8a999f683cf7f64950707e6cdc8e9a735974725e98b72c7a6d891f5f801e6242", + "vendored_lines": 65, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "8a999f683cf7f64950707e6cdc8e9a735974725e98b72c7a6d891f5f801e6242", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Map.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Maybe/First.purs", + "vendored_sha256": "7cfcf5744a424bc512fd7e7e04a71484c609a52cf94ef5552bcf7afa8f967abf", + "vendored_lines": 68, + "self_recursions": [], + "package": "purescript-maybe", + "tag": "v6.0.0", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "upstream_sha256": "7cfcf5744a424bc512fd7e7e04a71484c609a52cf94ef5552bcf7afa8f967abf", + "upstream_url": "https://github.com/purescript/purescript-maybe/blob/c6f98ac1088766287106c5d9c8e30e7648d36786/src/Data/Maybe/First.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Maybe/Last.purs", + "vendored_sha256": "cc86da8e91615e04b7973bdc5f7467db4adc8df722eb509bc2cf0e735cbb93ab", + "vendored_lines": 67, + "self_recursions": [], + "package": "purescript-maybe", + "tag": "v6.0.0", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "upstream_sha256": "cc86da8e91615e04b7973bdc5f7467db4adc8df722eb509bc2cf0e735cbb93ab", + "upstream_url": "https://github.com/purescript/purescript-maybe/blob/c6f98ac1088766287106c5d9c8e30e7648d36786/src/Data/Maybe/Last.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Maybe.purs", + "vendored_sha256": "dd49326b74a5ba9c5d0e0aaca7c05226aadb9b9bf851d9a3fdbc34df23319fa8", + "vendored_lines": 312, + "self_recursions": [], + "package": "purescript-maybe", + "tag": "v6.0.0", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "upstream_sha256": "dd49326b74a5ba9c5d0e0aaca7c05226aadb9b9bf851d9a3fdbc34df23319fa8", + "upstream_url": "https://github.com/purescript/purescript-maybe/blob/c6f98ac1088766287106c5d9c8e30e7648d36786/src/Data/Maybe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Additive.purs", + "vendored_sha256": "9b44eba5a733dbd6f7e908ea1c4eb44b61694f5a3d1d1e157c7c81300eb7417a", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9b44eba5a733dbd6f7e908ea1c4eb44b61694f5a3d1d1e157c7c81300eb7417a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Additive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Alternate.purs", + "vendored_sha256": "fb6b0d43a0c82f6028d64d957fad49d9ce48eb8a213ea8d2f0498d4be8f2de8d", + "vendored_lines": 60, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "fb6b0d43a0c82f6028d64d957fad49d9ce48eb8a213ea8d2f0498d4be8f2de8d", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Data/Monoid/Alternate.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Conj.purs", + "vendored_sha256": "0e3bedf55635d1c04225ff1a756bc55b94afafa8fb8d327f118e4c1f58f40858", + "vendored_lines": 51, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "0e3bedf55635d1c04225ff1a756bc55b94afafa8fb8d327f118e4c1f58f40858", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Conj.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Disj.purs", + "vendored_sha256": "e1eb141917201b0b866c433e19e68a6b0d80705d8fb6ea3d61d103d4a01c735f", + "vendored_lines": 51, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "e1eb141917201b0b866c433e19e68a6b0d80705d8fb6ea3d61d103d4a01c735f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Disj.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Dual.purs", + "vendored_sha256": "83c40da0d7125aa11225efe267713892ecaa044d66da05d048a1194ac0c48f6c", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "83c40da0d7125aa11225efe267713892ecaa044d66da05d048a1194ac0c48f6c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Dual.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Endo.purs", + "vendored_sha256": "aa5b2bc60841651e0bf54a683e6d6d99f4aca932bf583691b3fdd71a32aa5594", + "vendored_lines": 30, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "aa5b2bc60841651e0bf54a683e6d6d99f4aca932bf583691b3fdd71a32aa5594", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Endo.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Generic.purs", + "vendored_sha256": "a3df423b6bc60580e9e80612ae7c1682445853c55086363ceed129e43c72bf70", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "a3df423b6bc60580e9e80612ae7c1682445853c55086363ceed129e43c72bf70", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Multiplicative.purs", + "vendored_sha256": "0d01fac2de65e733c640b045e00f60422e1b776010ee69e7714dd659bb8c7796", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "0d01fac2de65e733c640b045e00f60422e1b776010ee69e7714dd659bb8c7796", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Multiplicative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid.purs", + "vendored_sha256": "a1bf093434dc1d8f162a19369f3376516f3f899e17875711be3d7164fb20e605", + "vendored_lines": 120, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "a1bf093434dc1d8f162a19369f3376516f3f899e17875711be3d7164fb20e605", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/NaturalTransformation.purs", + "vendored_sha256": "3196072783cdc7135047788ad6e58073e1cfeb50d284f038b79b65db2df9eb7e", + "vendored_lines": 20, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "3196072783cdc7135047788ad6e58073e1cfeb50d284f038b79b65db2df9eb7e", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/NaturalTransformation.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Newtype.purs", + "vendored_sha256": "572911ec613a337d30004c92120afea496af97d34b63617d884d4a96f03d8304", + "vendored_lines": 308, + "self_recursions": [], + "package": "purescript-newtype", + "tag": "v5.0.0", + "commit": "29d8e6dd77aec2c975c948364ec3faf26e14ee7b", + "upstream_sha256": "572911ec613a337d30004c92120afea496af97d34b63617d884d4a96f03d8304", + "upstream_url": "https://github.com/purescript/purescript-newtype/blob/29d8e6dd77aec2c975c948364ec3faf26e14ee7b/src/Data/Newtype.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/NonEmpty.purs", + "vendored_sha256": "c48366ad44cc7b4311d5032ef27ae8d2ea39f603d7bb33f03d51536758976d7e", + "vendored_lines": 174, + "self_recursions": [], + "package": "purescript-nonempty", + "tag": "v7.0.0", + "commit": "28150ecc7419238b187abd609a92a645273348bb", + "upstream_sha256": "c48366ad44cc7b4311d5032ef27ae8d2ea39f603d7bb33f03d51536758976d7e", + "upstream_url": "https://github.com/purescript/purescript-nonempty/blob/28150ecc7419238b187abd609a92a645273348bb/src/Data/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Number/Approximate.purs", + "vendored_sha256": "fbd544b15b42845be1a3fa11f1ec3c61d290baa300d41b7e41e3aacf707eacff", + "vendored_lines": 95, + "self_recursions": [], + "package": "purescript-numbers", + "tag": "v9.0.1", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "upstream_sha256": "fbd544b15b42845be1a3fa11f1ec3c61d290baa300d41b7e41e3aacf707eacff", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Approximate.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Number/Format.purs", + "vendored_sha256": "e6043544d5a1d545e807d200cfc0b99c269b797f046ad25aba51527ff7053924", + "vendored_lines": 80, + "self_recursions": [ + { + "name": "toPrecisionNative", + "line": 34, + "equation": "toPrecisionNative a0 a1 = toPrecisionNative a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "toFixedNative", + "line": 36, + "equation": "toFixedNative a0 a1 = toFixedNative a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "toExponentialNative", + "line": 38, + "equation": "toExponentialNative a0 a1 = toExponentialNative a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "toString", + "line": 80, + "equation": "toString a0 = toString a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-numbers", + "tag": "v9.0.1", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "upstream_sha256": "0922126e6d31ecc361a00b265ecf302fb1f6449ca11d2cc2331a0ae174d9f83f", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Format.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "toPrecisionNative", + "line": 33, + "declaration": "foreign import toPrecisionNative :: Int -> Number -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toFixedNative", + "line": 34, + "declaration": "foreign import toFixedNative :: Int -> Number -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toExponentialNative", + "line": 35, + "declaration": "foreign import toExponentialNative :: Int -> Number -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toString", + "line": 76, + "declaration": "foreign import toString :: Number -> String", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Number.purs", + "vendored_sha256": "eafedeed553989c8542ec41fdc7216a75d3195b235446448dc0bc69b88c4748b", + "vendored_lines": 388, + "self_recursions": [ + { + "name": "nan", + "line": 48, + "equation": "nan = nan", + "replaces_upstream_foreign": true + }, + { + "name": "isNaN", + "line": 59, + "equation": "isNaN a0 = isNaN a0", + "replaces_upstream_foreign": true + }, + { + "name": "infinity", + "line": 70, + "equation": "infinity = infinity", + "replaces_upstream_foreign": true + }, + { + "name": "isFinite", + "line": 87, + "equation": "isFinite a0 = isFinite a0", + "replaces_upstream_foreign": true + }, + { + "name": "fromStringImpl", + "line": 120, + "equation": "fromStringImpl = fromStringImpl", + "replaces_upstream_foreign": true + }, + { + "name": "abs", + "line": 129, + "equation": "abs a0 = abs a0", + "replaces_upstream_foreign": true + }, + { + "name": "acos", + "line": 137, + "equation": "acos a0 = acos a0", + "replaces_upstream_foreign": true + }, + { + "name": "asin", + "line": 145, + "equation": "asin a0 = asin a0", + "replaces_upstream_foreign": true + }, + { + "name": "atan", + "line": 153, + "equation": "atan a0 = atan a0", + "replaces_upstream_foreign": true + }, + { + "name": "atan2", + "line": 167, + "equation": "atan2 a0 a1 = atan2 a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "ceil", + "line": 175, + "equation": "ceil a0 = ceil a0", + "replaces_upstream_foreign": true + }, + { + "name": "cos", + "line": 183, + "equation": "cos a0 = cos a0", + "replaces_upstream_foreign": true + }, + { + "name": "exp", + "line": 191, + "equation": "exp a0 = exp a0", + "replaces_upstream_foreign": true + }, + { + "name": "floor", + "line": 199, + "equation": "floor a0 = floor a0", + "replaces_upstream_foreign": true + }, + { + "name": "log", + "line": 206, + "equation": "log a0 = log a0", + "replaces_upstream_foreign": true + }, + { + "name": "max", + "line": 211, + "equation": "max a0 a1 = max a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "min", + "line": 216, + "equation": "min a0 a1 = min a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "pow", + "line": 227, + "equation": "pow a0 a1 = pow a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "remainder", + "line": 235, + "equation": "remainder a0 a1 = remainder a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "round", + "line": 245, + "equation": "round a0 = round a0", + "replaces_upstream_foreign": true + }, + { + "name": "sign", + "line": 256, + "equation": "sign a0 = sign a0", + "replaces_upstream_foreign": true + }, + { + "name": "sin", + "line": 264, + "equation": "sin a0 = sin a0", + "replaces_upstream_foreign": true + }, + { + "name": "sqrt", + "line": 272, + "equation": "sqrt a0 = sqrt a0", + "replaces_upstream_foreign": true + }, + { + "name": "tan", + "line": 280, + "equation": "tan a0 = tan a0", + "replaces_upstream_foreign": true + }, + { + "name": "trunc", + "line": 289, + "equation": "trunc a0 = trunc a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-numbers", + "tag": "v9.0.1", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "upstream_sha256": "13c04cf0d293c54825fc95b5b3d543379a8d913e110d9e5056ca5388a31afc87", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "nan", + "line": 47, + "declaration": "foreign import nan :: Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "isNaN", + "line": 57, + "declaration": "foreign import isNaN :: Number -> Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "infinity", + "line": 67, + "declaration": "foreign import infinity :: Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "isFinite", + "line": 83, + "declaration": "foreign import isFinite :: Number -> Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "fromStringImpl", + "line": 115, + "declaration": "foreign import fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "abs", + "line": 123, + "declaration": "foreign import abs :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "acos", + "line": 130, + "declaration": "foreign import acos :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "asin", + "line": 137, + "declaration": "foreign import asin :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "atan", + "line": 144, + "declaration": "foreign import atan :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "atan2", + "line": 157, + "declaration": "foreign import atan2 :: Number -> Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "ceil", + "line": 164, + "declaration": "foreign import ceil :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "cos", + "line": 171, + "declaration": "foreign import cos :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "exp", + "line": 178, + "declaration": "foreign import exp :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "floor", + "line": 185, + "declaration": "foreign import floor :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "log", + "line": 191, + "declaration": "foreign import log :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "max", + "line": 195, + "declaration": "foreign import max :: Number -> Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "min", + "line": 199, + "declaration": "foreign import min :: Number -> Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "pow", + "line": 209, + "declaration": "foreign import pow :: Number -> Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "remainder", + "line": 216, + "declaration": "foreign import remainder :: Number -> Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "round", + "line": 225, + "declaration": "foreign import round :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "sign", + "line": 235, + "declaration": "foreign import sign :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "sin", + "line": 242, + "declaration": "foreign import sin :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "sqrt", + "line": 249, + "declaration": "foreign import sqrt :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "tan", + "line": 256, + "declaration": "foreign import tan :: Number -> Number", + "vendored_status": "direct_self_recursion" + }, + { + "name": "trunc", + "line": 264, + "declaration": "foreign import trunc :: Number -> Number", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Op.purs", + "vendored_sha256": "400182c9f9c76ef9eaab32377405195986d70d1f4a4a04cc4833fba0e035cec6", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "400182c9f9c76ef9eaab32377405195986d70d1f4a4a04cc4833fba0e035cec6", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Op.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Down.purs", + "vendored_sha256": "1c1ac8c739112884f86076eaae7ebe1a24c533892c044940813ceee796d840bc", + "vendored_lines": 26, + "self_recursions": [], + "package": "purescript-orders", + "tag": "v6.0.0", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "upstream_sha256": "1c1ac8c739112884f86076eaae7ebe1a24c533892c044940813ceee796d840bc", + "upstream_url": "https://github.com/purescript/purescript-orders/blob/f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c/src/Data/Ord/Down.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Generic.purs", + "vendored_sha256": "f1a8a7f58a29e0d22087de7acb3e7eb4a7e159fa5cb589d127274efcb91246ca", + "vendored_lines": 39, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "f1a8a7f58a29e0d22087de7acb3e7eb4a7e159fa5cb589d127274efcb91246ca", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Max.purs", + "vendored_sha256": "0ba5b99631c3d19685c2ff3141d8e7701933e53828ca4277c0060cdb010b6255", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-orders", + "tag": "v6.0.0", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "upstream_sha256": "0ba5b99631c3d19685c2ff3141d8e7701933e53828ca4277c0060cdb010b6255", + "upstream_url": "https://github.com/purescript/purescript-orders/blob/f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c/src/Data/Ord/Max.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Min.purs", + "vendored_sha256": "2ff841d2cdab3ddacb446d4562a49b7e17a76bfa23441188f02a77a65db4a6f1", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-orders", + "tag": "v6.0.0", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "upstream_sha256": "2ff841d2cdab3ddacb446d4562a49b7e17a76bfa23441188f02a77a65db4a6f1", + "upstream_url": "https://github.com/purescript/purescript-orders/blob/f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c/src/Data/Ord/Min.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord.purs", + "vendored_sha256": "c9d3cfd012a36939b4f10243aa9bf9db0b70bbb8901270eab314e1d9e5f46ff9", + "vendored_lines": 263, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "ba132ffbd2784283842f3e5c0b8a47be006968229bcd70abce0764a21b8a47ae", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "ordBooleanImpl", + "line": 84, + "declaration": "foreign import ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "ordIntImpl", + "line": 92, + "declaration": "foreign import ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "ordNumberImpl", + "line": 100, + "declaration": "foreign import ordNumberImpl :: Ordering -> Ordering -> Ordering -> Number -> Number -> Ordering", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "ordStringImpl", + "line": 108, + "declaration": "foreign import ordStringImpl :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "ordCharImpl", + "line": 116, + "declaration": "foreign import ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "ordArrayImpl", + "line": 124, + "declaration": "foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 52, + "text": " compare = ordBooleanImpl LT EQ GT" + }, + { + "line": 55, + "text": " compare = ordIntImpl LT EQ GT" + }, + { + "line": 58, + "text": " compare = ordNumberImpl LT EQ GT" + }, + { + "line": 61, + "text": " compare = ordStringImpl LT EQ GT" + }, + { + "line": 64, + "text": " compare = ordCharImpl LT EQ GT" + } + ] + }, + { + "path": "Data/Ordering.purs", + "vendored_sha256": "9a53fe2e7bd7afb11b8db093b1511bc210fc88c1661a78fe4d89800b20cae0a1", + "vendored_lines": 36, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9a53fe2e7bd7afb11b8db093b1511bc210fc88c1661a78fe4d89800b20cae0a1", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ordering.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Predicate.purs", + "vendored_sha256": "75e1d24c5f0eecc0d11f7664bd38edd641f5fcb039577d11213eac1a819a2d1c", + "vendored_lines": 18, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "75e1d24c5f0eecc0d11f7664bd38edd641f5fcb039577d11213eac1a819a2d1c", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Predicate.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Choice.purs", + "vendored_sha256": "687391e4819de27fda58acb18be86fdd99bf52166b1ca736525fa4c3310d752a", + "vendored_lines": 83, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "687391e4819de27fda58acb18be86fdd99bf52166b1ca736525fa4c3310d752a", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Choice.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Closed.purs", + "vendored_sha256": "2ebbae569682f0bb828e69417c6b991eb6ac54ae0c439e1da9a44064a613d01d", + "vendored_lines": 12, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "2ebbae569682f0bb828e69417c6b991eb6ac54ae0c439e1da9a44064a613d01d", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Closed.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Cochoice.purs", + "vendored_sha256": "d04b01c617f374356eba5358777bf945f6e41c274b7c8c58cd4327d2d6cfe117", + "vendored_lines": 9, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "d04b01c617f374356eba5358777bf945f6e41c274b7c8c58cd4327d2d6cfe117", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Cochoice.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Costrong.purs", + "vendored_sha256": "7d7eb115e194c2d8518b070a3b39809b1b9bc0bdcfe3e48a29b40e9bd6748513", + "vendored_lines": 9, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "7d7eb115e194c2d8518b070a3b39809b1b9bc0bdcfe3e48a29b40e9bd6748513", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Costrong.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Join.purs", + "vendored_sha256": "acbfbd68ca96516e42a4416e1c587b8db4cfae572f7814fa9784cbfeaf286c9f", + "vendored_lines": 28, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "acbfbd68ca96516e42a4416e1c587b8db4cfae572f7814fa9784cbfeaf286c9f", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Join.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Split.purs", + "vendored_sha256": "32b0f17f7d2140c6f7ed3e536d0ec5220b504017deedcb798df586e4c61ca909", + "vendored_lines": 39, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "32b0f17f7d2140c6f7ed3e536d0ec5220b504017deedcb798df586e4c61ca909", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Split.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Star.purs", + "vendored_sha256": "52953a97b7701dbe8619f61bf2bc0b13d2606efbf85d201527dbda5348c05b40", + "vendored_lines": 80, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "52953a97b7701dbe8619f61bf2bc0b13d2606efbf85d201527dbda5348c05b40", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Star.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Strong.purs", + "vendored_sha256": "7ce15c8be67cd563c7d611891e73be2018fae763e26b9b10d790cab4110cc1cb", + "vendored_lines": 80, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "7ce15c8be67cd563c7d611891e73be2018fae763e26b9b10d790cab4110cc1cb", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Strong.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor.purs", + "vendored_sha256": "f0e9030ebb6252131618dcbc5e181d98dab01020126bbcedd0344d78cea8c9e1", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "f0e9030ebb6252131618dcbc5e181d98dab01020126bbcedd0344d78cea8c9e1", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Reflectable.purs", + "vendored_sha256": "1e6690c68fc625587e7ec7f8417d4dffe153cc499c68220dc5b91aea6eb07807", + "vendored_lines": 58, + "self_recursions": [ + { + "name": "unsafeCoerce", + "line": 37, + "equation": "unsafeCoerce a0 = unsafeCoerce a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "3335b7b50707e01e8fe217afa89c1ccc3d9b1c9323329bd153094079a6890bfc", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Reflectable.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeCoerce", + "line": 36, + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ring/Generic.purs", + "vendored_sha256": "931e3701f06b90079c67160b02a3e8fe78703b68da7f0de98fab1efb88a1f99a", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "4aec6adf51e6cb9e63f3004968d2bda3801d31cbc60e8ffff183307393eabee4", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring/Generic.purs", + "status": "newline_only", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ring.purs", + "vendored_sha256": "63acb4da5368de6b5b30da20b01c17684e3d925a4c4232de6b99d3ddf1cf8fb7", + "vendored_lines": 79, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "1abcaa302136c9731ec2d89ee1fe29f3acbec0dd32da45d30a8d46cc6fb87b7d", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "intSub", + "line": 54, + "declaration": "foreign import intSub :: Int -> Int -> Int", + "vendored_status": "declaration_removed" + }, + { + "name": "numSub", + "line": 55, + "declaration": "foreign import numSub :: Number -> Number -> Number", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 33, + "text": " sub = intSub" + }, + { + "line": 36, + "text": " sub = numSub" + } + ] + }, + { + "path": "Data/Semigroup/First.purs", + "vendored_sha256": "9df1dca916c4a4d344ddf580f2a3d3a1cb270dc8df91044147d590e8bc315347", + "vendored_lines": 40, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9df1dca916c4a4d344ddf580f2a3d3a1cb270dc8df91044147d590e8bc315347", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup/First.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Foldable.purs", + "vendored_sha256": "7bbb43d0a9354e63d409e6b01f4ee634f0e900c6516ff17734eee0e0cbb03629", + "vendored_lines": 178, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "7bbb43d0a9354e63d409e6b01f4ee634f0e900c6516ff17734eee0e0cbb03629", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Semigroup/Foldable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Generic.purs", + "vendored_sha256": "c33f0a8dea5d46a2c7ac0b7805840a443b2ed3d82d226319c243ff0b29ded7bd", + "vendored_lines": 31, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "c33f0a8dea5d46a2c7ac0b7805840a443b2ed3d82d226319c243ff0b29ded7bd", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Last.purs", + "vendored_sha256": "f3aadefc2e6687234ad3d4690dd61e436bfa3aca9b57e0a1a4da7328738f7c11", + "vendored_lines": 40, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "f3aadefc2e6687234ad3d4690dd61e436bfa3aca9b57e0a1a4da7328738f7c11", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup/Last.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Traversable.purs", + "vendored_sha256": "361841e1f1960110c9bdaebdbdd8637742f626a26942e61fe7a8ee91fcf8b447", + "vendored_lines": 72, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "361841e1f1960110c9bdaebdbdd8637742f626a26942e61fe7a8ee91fcf8b447", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Semigroup/Traversable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup.purs", + "vendored_sha256": "fdb73654fa6881c3e3d7c5c110ba5a5a59f4b59f6343d0af868049a154a87c4d", + "vendored_lines": 86, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "e14ab5200a3ba533334c3d06cbeac9bd9fdb3428c64a9d59926f69284ce4f9a8", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "concatString", + "line": 60, + "declaration": "foreign import concatString :: String -> String -> String", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "concatArray", + "line": 61, + "declaration": "foreign import concatArray :: forall a. Array a -> Array a -> Array a", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 40, + "text": " append = concatString" + }, + { + "line": 52, + "text": " append = concatArray" + } + ] + }, + { + "path": "Data/Semiring/Generic.purs", + "vendored_sha256": "48598a49eeb1bae16eb02308dfb46ff9dd096b30d0100efcaee5b91232f61d88", + "vendored_lines": 51, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "13e146664e64d99ebe5d942ef3bd897ed78c85e2ab737374d1976b37c36b8601", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring/Generic.purs", + "status": "newline_only", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semiring.purs", + "vendored_sha256": "ec5df1607dee317beb962fda9b5165404d64336ce0a9d1b7f35fd45781582e36", + "vendored_lines": 142, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "6e588bb9736b230b5bd6410ce86f9e9e4d4326ab250a66fa239a7c5f822e7072", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "intAdd", + "line": 89, + "declaration": "foreign import intAdd :: Int -> Int -> Int", + "vendored_status": "declaration_removed" + }, + { + "name": "intMul", + "line": 90, + "declaration": "foreign import intMul :: Int -> Int -> Int", + "vendored_status": "declaration_removed" + }, + { + "name": "numAdd", + "line": 91, + "declaration": "foreign import numAdd :: Number -> Number -> Number", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "numMul", + "line": 92, + "declaration": "foreign import numMul :: Number -> Number -> Number", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 54, + "text": " add = intAdd" + }, + { + "line": 56, + "text": " mul = intMul" + }, + { + "line": 60, + "text": " add = numAdd" + }, + { + "line": 62, + "text": " mul = numMul" + } + ] + }, + { + "path": "Data/Set/NonEmpty.purs", + "vendored_sha256": "45a49dc49087f55b9c3c315a1fa68e62313a55bf6aab9f8df2bba52ccf7a4dd5", + "vendored_lines": 163, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "45a49dc49087f55b9c3c315a1fa68e62313a55bf6aab9f8df2bba52ccf7a4dd5", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Set/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Set.purs", + "vendored_sha256": "8281a67c595c3948a64b00cb3cb21d26c8b5f7a80c686e77320c85fdea46aee7", + "vendored_lines": 188, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "8281a67c595c3948a64b00cb3cb21d26c8b5f7a80c686e77320c85fdea46aee7", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Set.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Show/Generic.purs", + "vendored_sha256": "b6079dad4ee250ff2ad3b1369f509f0d28a8d05e05af6cdc88eb2950f5ac1c70", + "vendored_lines": 64, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "bd4a82c3cb1e734f775ff6a40fae47b053d336313faf47efb8b4b5d78895376f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show/Generic.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "intercalate", + "line": 57, + "declaration": "foreign import intercalate :: String -> Array String -> String", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Show.purs", + "vendored_sha256": "1abf3b5f105c2e441d7f32e7fd3be9321b5fbfaefdb814299cae7e0d27a83f7d", + "vendored_lines": 280, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "4422b4bbe3d67f1f85575937fb7b9127af4443fe951926a95f6ecf0822032e6c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "showIntImpl", + "line": 93, + "declaration": "foreign import showIntImpl :: Int -> String", + "vendored_status": "declaration_removed" + }, + { + "name": "showNumberImpl", + "line": 94, + "declaration": "foreign import showNumberImpl :: Number -> String", + "vendored_status": "declaration_removed" + }, + { + "name": "showCharImpl", + "line": 95, + "declaration": "foreign import showCharImpl :: Char -> String", + "vendored_status": "declaration_removed" + }, + { + "name": "showStringImpl", + "line": 96, + "declaration": "foreign import showStringImpl :: String -> String", + "vendored_status": "declaration_removed" + }, + { + "name": "showArrayImpl", + "line": 97, + "declaration": "foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String", + "vendored_status": "declaration_removed" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 4, + "text": " , class ShowRecordFields" + }, + { + "line": 5, + "text": " , showRecordFields" + }, + { + "line": 9, + "text": "import Data.Symbol (class IsSymbol, reflectSymbol)" + }, + { + "line": 10, + "text": "import Data.Unit (Unit)" + }, + { + "line": 11, + "text": "import Data.Void (Void, absurd)" + }, + { + "line": 12, + "text": "import Prim.Row (class Nub)" + }, + { + "line": 13, + "text": "import Prim.RowList as RL" + }, + { + "line": 14, + "text": "import Record.Unsafe (unsafeGet)" + }, + { + "line": 15, + "text": "import Type.Proxy (Proxy(..))" + }, + { + "line": 29, + "text": "instance showBoolean :: Show Boolean where" + }, + { + "line": 30, + "text": " show true = \"true\"" + }, + { + "line": 31, + "text": " show false = \"false\"" + }, + { + "line": 33, + "text": "instance showInt :: Show Int where" + }, + { + "line": 34, + "text": " show = showIntImpl" + }, + { + "line": 36, + "text": "instance showNumber :: Show Number where" + }, + { + "line": 37, + "text": " show = showNumberImpl" + }, + { + "line": 39, + "text": "instance showChar :: Show Char where" + }, + { + "line": 40, + "text": " show = showCharImpl" + }, + { + "line": 42, + "text": "instance showString :: Show String where" + }, + { + "line": 43, + "text": " show = showStringImpl" + }, + { + "line": 45, + "text": "instance showArray :: Show a => Show (Array a) where" + }, + { + "line": 46, + "text": " show = showArrayImpl show" + }, + { + "line": 48, + "text": "instance showProxy :: Show (Proxy a) where" + }, + { + "line": 49, + "text": " show _ = \"Proxy\"" + }, + { + "line": 51, + "text": "instance showVoid :: Show Void where" + }, + { + "line": 52, + "text": " show = absurd" + }, + { + "line": 54, + "text": "instance showRecord ::" + }, + { + "line": 55, + "text": " ( Nub rs rs" + }, + { + "line": 56, + "text": " , RL.RowToList rs ls" + }, + { + "line": 57, + "text": " , ShowRecordFields ls rs" + }, + { + "line": 58, + "text": " ) =>" + }, + { + "line": 59, + "text": " Show (Record rs) where" + }, + { + "line": 60, + "text": " show record = \"{\" <> showRecordFields (Proxy :: Proxy ls) record <> \"}\"" + }, + { + "line": 64, + "text": "class ShowRecordFields :: RL.RowList Type -> Row Type -> Constraint" + }, + { + "line": 65, + "text": "class ShowRecordFields rowlist row where" + }, + { + "line": 66, + "text": " showRecordFields :: Proxy rowlist -> Record row -> String" + }, + { + "line": 68, + "text": "instance showRecordFieldsNil :: ShowRecordFields RL.Nil row where" + }, + { + "line": 69, + "text": " showRecordFields _ _ = \"\"" + }, + { + "line": 70, + "text": "else" + }, + { + "line": 71, + "text": "instance showRecordFieldsConsNil ::" + }, + { + "line": 72, + "text": " ( IsSymbol key" + }, + { + "line": 73, + "text": " , Show focus" + }, + { + "line": 74, + "text": " ) =>" + }, + { + "line": 75, + "text": " ShowRecordFields (RL.Cons key focus RL.Nil) row where" + }, + { + "line": 76, + "text": " showRecordFields _ record = \" \" <> key <> \": \" <> show focus <> \" \"" + }, + { + "line": 77, + "text": " where" + }, + { + "line": 78, + "text": " key = reflectSymbol (Proxy :: Proxy key)" + }, + { + "line": 79, + "text": " focus = unsafeGet key record :: focus" + }, + { + "line": 80, + "text": "else" + }, + { + "line": 81, + "text": "instance showRecordFieldsCons ::" + }, + { + "line": 82, + "text": " ( IsSymbol key" + }, + { + "line": 83, + "text": " , ShowRecordFields rowlistTail row" + }, + { + "line": 84, + "text": " , Show focus" + }, + { + "line": 85, + "text": " ) =>" + }, + { + "line": 86, + "text": " ShowRecordFields (RL.Cons key focus rowlistTail) row where" + }, + { + "line": 87, + "text": " showRecordFields _ record = \" \" <> key <> \": \" <> show focus <> \",\" <> tail" + }, + { + "line": 88, + "text": " where" + }, + { + "line": 89, + "text": " key = reflectSymbol (Proxy :: Proxy key)" + }, + { + "line": 90, + "text": " focus = unsafeGet key record :: focus" + }, + { + "line": 91, + "text": " tail = showRecordFields (Proxy :: Proxy rowlistTail) record" + } + ] + }, + { + "path": "Data/String/CaseInsensitive.purs", + "vendored_sha256": "1d889da73589b5bed249153cc55a01654a912756bc062ae1f12df3357c2ca9ed", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "1d889da73589b5bed249153cc55a01654a912756bc062ae1f12df3357c2ca9ed", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CaseInsensitive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/CodePoints.purs", + "vendored_sha256": "5f4619365a32a93f2adf79e63dd58d292781520ba5da3227d46736ac031a4d50", + "vendored_lines": 418, + "self_recursions": [ + { + "name": "_singleton", + "line": 92, + "equation": "_singleton a0 a1 = _singleton a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "_fromCodePointArray", + "line": 116, + "equation": "_fromCodePointArray a0 a1 = _fromCodePointArray a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "_toCodePointArray", + "line": 133, + "equation": "_toCodePointArray a0 a1 a2 = _toCodePointArray a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "_codePointAt", + "line": 160, + "equation": "_codePointAt a0 a1 a2 a3 a4 a5 = _codePointAt a0 a1 a2 a3 a4 a5", + "replaces_upstream_foreign": true + }, + { + "name": "_countPrefix", + "line": 218, + "equation": "_countPrefix a0 a1 a2 a3 = _countPrefix a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "_take", + "line": 315, + "equation": "_take a0 a1 a2 = _take a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "_unsafeCodePointAt0", + "line": 406, + "equation": "_unsafeCodePointAt0 a0 a1 = _unsafeCodePointAt0 a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "a8415ac45b14a0d78334af6d0fb533c7bfc3cfb3ed90e28113c453c9b15f170b", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "_singleton", + "line": 91, + "declaration": "foreign import _singleton :: (CodePoint -> String) -> CodePoint -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_fromCodePointArray", + "line": 117, + "declaration": "foreign import _fromCodePointArray :: (CodePoint -> String) -> Array CodePoint -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_toCodePointArray", + "line": 136, + "declaration": "foreign import _toCodePointArray :: (String -> Array CodePoint) -> (String -> CodePoint) -> String -> Array CodePoint", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_codePointAt", + "line": 166, + "declaration": "foreign import _codePointAt :: (Int -> String -> Maybe CodePoint) -> (forall a. a -> Maybe a) -> (forall a. Maybe a) -> (String -> CodePoint) -> Int -> String -> Maybe CodePoint", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_countPrefix", + "line": 230, + "declaration": "foreign import _countPrefix :: ((CodePoint -> Boolean) -> String -> Int) -> (String -> CodePoint) -> (CodePoint -> Boolean) -> String -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_take", + "line": 331, + "declaration": "foreign import _take :: (Int -> String -> String) -> Int -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_unsafeCodePointAt0", + "line": 421, + "declaration": "foreign import _unsafeCodePointAt0 :: (String -> CodePoint) -> String -> CodePoint", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/CodeUnits.purs", + "vendored_sha256": "6fad18f94ea9b6310d9287777ebf95e85a09d30c12d7e1b1bd30abc56665dbce", + "vendored_lines": 316, + "self_recursions": [ + { + "name": "singleton", + "line": 84, + "equation": "singleton a0 = singleton a0", + "replaces_upstream_foreign": true + }, + { + "name": "fromCharArray", + "line": 92, + "equation": "fromCharArray a0 = fromCharArray a0", + "replaces_upstream_foreign": true + }, + { + "name": "toCharArray", + "line": 100, + "equation": "toCharArray a0 = toCharArray a0", + "replaces_upstream_foreign": true + }, + { + "name": "_charAt", + "line": 113, + "equation": "_charAt a0 a1 a2 a3 = _charAt a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "_toChar", + "line": 126, + "equation": "_toChar a0 a1 a2 = _toChar a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "length", + "line": 147, + "equation": "length a0 = length a0", + "replaces_upstream_foreign": true + }, + { + "name": "countPrefix", + "line": 157, + "equation": "countPrefix a0 a1 = countPrefix a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "_indexOf", + "line": 171, + "equation": "_indexOf a0 a1 a2 a3 = _indexOf a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "_indexOfStartingAt", + "line": 186, + "equation": "_indexOfStartingAt a0 a1 a2 a3 a4 = _indexOfStartingAt a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + }, + { + "name": "_lastIndexOf", + "line": 200, + "equation": "_lastIndexOf a0 a1 a2 a3 = _lastIndexOf a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "_lastIndexOfStartingAt", + "line": 224, + "equation": "_lastIndexOfStartingAt a0 a1 a2 a3 a4 = _lastIndexOfStartingAt a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + }, + { + "name": "take", + "line": 233, + "equation": "take a0 a1 = take a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "drop", + "line": 261, + "equation": "drop a0 a1 = drop a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "slice", + "line": 294, + "equation": "slice a0 a1 a2 = slice a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "splitAt", + "line": 316, + "equation": "splitAt a0 a1 = splitAt a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "801f13b0d180a49a454d6456c1c5a7a235a2a7d1827ab31537506e9b279a0648", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "singleton", + "line": 83, + "declaration": "foreign import singleton :: Char -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "fromCharArray", + "line": 90, + "declaration": "foreign import fromCharArray :: Array Char -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toCharArray", + "line": 97, + "declaration": "foreign import toCharArray :: String -> Array Char", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_charAt", + "line": 109, + "declaration": "foreign import _charAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Int -> String -> Maybe Char", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_toChar", + "line": 126, + "declaration": "foreign import _toChar :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> String -> Maybe Char", + "vendored_status": "direct_self_recursion" + }, + { + "name": "length", + "line": 150, + "declaration": "foreign import length :: String -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "countPrefix", + "line": 159, + "declaration": "foreign import countPrefix :: (Char -> Boolean) -> String -> Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_indexOf", + "line": 172, + "declaration": "foreign import _indexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_indexOfStartingAt", + "line": 191, + "declaration": "foreign import _indexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_lastIndexOf", + "line": 210, + "declaration": "foreign import _lastIndexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_lastIndexOfStartingAt", + "line": 238, + "declaration": "foreign import _lastIndexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "take", + "line": 252, + "declaration": "foreign import take :: Int -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "drop", + "line": 279, + "declaration": "foreign import drop :: Int -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "slice", + "line": 311, + "declaration": "foreign import slice :: Int -> Int -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "splitAt", + "line": 332, + "declaration": "foreign import splitAt :: Int -> String -> { before :: String, after :: String }", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Common.purs", + "vendored_sha256": "d6bc291322f005e1aef6fe4186037d484587b22704c285330130c7cf94054fdc", + "vendored_lines": 98, + "self_recursions": [ + { + "name": "_localeCompare", + "line": 38, + "equation": "_localeCompare a0 a1 a2 a3 a4 = _localeCompare a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + }, + { + "name": "replace", + "line": 46, + "equation": "replace a0 a1 a2 = replace a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "replaceAll", + "line": 54, + "equation": "replaceAll a0 a1 a2 = replaceAll a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "split", + "line": 63, + "equation": "split a0 a1 = split a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "toLower", + "line": 71, + "equation": "toLower a0 = toLower a0", + "replaces_upstream_foreign": true + }, + { + "name": "toUpper", + "line": 79, + "equation": "toUpper a0 = toUpper a0", + "replaces_upstream_foreign": true + }, + { + "name": "trim", + "line": 89, + "equation": "trim a0 = trim a0", + "replaces_upstream_foreign": true + }, + { + "name": "joinWith", + "line": 98, + "equation": "joinWith a0 a1 = joinWith a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "286d269bba5d0010924bc62a45188f664d93f7486707f9a3d5038ad7699a2f84", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "_localeCompare", + "line": 37, + "declaration": "foreign import _localeCompare :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering", + "vendored_status": "direct_self_recursion" + }, + { + "name": "replace", + "line": 50, + "declaration": "foreign import replace :: Pattern -> Replacement -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "replaceAll", + "line": 57, + "declaration": "foreign import replaceAll :: Pattern -> Replacement -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "split", + "line": 65, + "declaration": "foreign import split :: Pattern -> String -> Array String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toLower", + "line": 72, + "declaration": "foreign import toLower :: String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "toUpper", + "line": 79, + "declaration": "foreign import toUpper :: String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "trim", + "line": 88, + "declaration": "foreign import trim :: String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "joinWith", + "line": 96, + "declaration": "foreign import joinWith :: String -> Array String -> String", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Gen.purs", + "vendored_sha256": "fdc6f113d91213f5571aaef42726fd6966eba12c56cb30c40736ff9398a6585b", + "vendored_lines": 43, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "fdc6f113d91213f5571aaef42726fd6966eba12c56cb30c40736ff9398a6585b", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/CaseInsensitive.purs", + "vendored_sha256": "73160accd99f00200e60a5431d70f197aded453aac143f15d842d8fcb984d803", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "73160accd99f00200e60a5431d70f197aded453aac143f15d842d8fcb984d803", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/CaseInsensitive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/CodePoints.purs", + "vendored_sha256": "26f6c829cda09064888b07ada1989e44d5781c81d9927f9b3c2351e82b3077b0", + "vendored_lines": 138, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "26f6c829cda09064888b07ada1989e44d5781c81d9927f9b3c2351e82b3077b0", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/CodePoints.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/CodeUnits.purs", + "vendored_sha256": "305c39d652a011b9dbb723e22be8e87767bd91fb3f962cb511666828647fafc8", + "vendored_lines": 308, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "305c39d652a011b9dbb723e22be8e87767bd91fb3f962cb511666828647fafc8", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/CodeUnits.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/Internal.purs", + "vendored_sha256": "1efe2c4ec248665e11f8978bf5f44d6eec2c2c248586c47a6137e652d452d966", + "vendored_lines": 232, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "1efe2c4ec248665e11f8978bf5f44d6eec2c2c248586c47a6137e652d452d966", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty.purs", + "vendored_sha256": "b369bd4f0f9ee7f1d8ced366cd82f0c8b17b99365517d9f305b2fe980c172134", + "vendored_lines": 9, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "b369bd4f0f9ee7f1d8ced366cd82f0c8b17b99365517d9f305b2fe980c172134", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Pattern.purs", + "vendored_sha256": "cd63d7bb03364c5f5e0b2fbe44746c81b2965300bbf890702331d146a5f3b90f", + "vendored_lines": 33, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "cd63d7bb03364c5f5e0b2fbe44746c81b2965300bbf890702331d146a5f3b90f", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Pattern.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Regex/Flags.purs", + "vendored_sha256": "c764c8d36ccd74d5603dbfef8b62976788369c9844bceab91c319d61dea16c16", + "vendored_lines": 129, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "c764c8d36ccd74d5603dbfef8b62976788369c9844bceab91c319d61dea16c16", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex/Flags.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Regex/Unsafe.purs", + "vendored_sha256": "9a0bf4c37a2ac844622b29a72d24c3b3aa1e0ad04bcfe1186962f6cd2e433e59", + "vendored_lines": 14, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "9a0bf4c37a2ac844622b29a72d24c3b3aa1e0ad04bcfe1186962f6cd2e433e59", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex/Unsafe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Regex.purs", + "vendored_sha256": "224d33bddffeccad9347c2d4481752d3a5eb8ac29e0913bb7328b5e2faf1d58d", + "vendored_lines": 120, + "self_recursions": [ + { + "name": "showRegexImpl", + "line": 32, + "equation": "showRegexImpl a0 = showRegexImpl a0", + "replaces_upstream_foreign": true + }, + { + "name": "regexImpl", + "line": 38, + "equation": "regexImpl a0 a1 a2 a3 = regexImpl a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "source", + "line": 47, + "equation": "source a0 = source a0", + "replaces_upstream_foreign": true + }, + { + "name": "flagsImpl", + "line": 55, + "equation": "flagsImpl a0 = flagsImpl a0", + "replaces_upstream_foreign": true + }, + { + "name": "test", + "line": 82, + "equation": "test a0 a1 = test a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "_match", + "line": 85, + "equation": "_match a0 a1 a2 a3 = _match a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "replace", + "line": 98, + "equation": "replace a0 a1 a2 = replace a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "_replaceBy", + "line": 101, + "equation": "_replaceBy a0 a1 a2 a3 a4 = _replaceBy a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + }, + { + "name": "_search", + "line": 111, + "equation": "_search a0 a1 a2 a3 = _search a0 a1 a2 a3", + "replaces_upstream_foreign": true + }, + { + "name": "split", + "line": 120, + "equation": "split a0 a1 = split a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "101f80a5bcba3f3bf1b6ec1ec68f48c18d149d9e4b7808eddf8e753eb15d1d88", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "showRegexImpl", + "line": 31, + "declaration": "foreign import showRegexImpl :: Regex -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "regexImpl", + "line": 36, + "declaration": "foreign import regexImpl :: (String -> Either String Regex) -> (Regex -> Either String Regex) -> String -> String -> Either String Regex", + "vendored_status": "direct_self_recursion" + }, + { + "name": "source", + "line": 49, + "declaration": "foreign import source :: Regex -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "flagsImpl", + "line": 56, + "declaration": "foreign import flagsImpl :: Regex -> RegexFlagsRec", + "vendored_status": "direct_self_recursion" + }, + { + "name": "test", + "line": 82, + "declaration": "foreign import test :: Regex -> String -> Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_match", + "line": 84, + "declaration": "foreign import _match :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe (NonEmptyArray (Maybe String))", + "vendored_status": "direct_self_recursion" + }, + { + "name": "replace", + "line": 101, + "declaration": "foreign import replace :: Regex -> String -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_replaceBy", + "line": 103, + "declaration": "foreign import _replaceBy :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> (String -> Array (Maybe String) -> String) -> String -> String", + "vendored_status": "direct_self_recursion" + }, + { + "name": "_search", + "line": 118, + "declaration": "foreign import _search :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe Int", + "vendored_status": "direct_self_recursion" + }, + { + "name": "split", + "line": 131, + "declaration": "foreign import split :: Regex -> String -> Array String", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Unsafe.purs", + "vendored_sha256": "c737041c3238223555c325d8a30db5f590ea817b54f243be91fd968777f165f5", + "vendored_lines": 17, + "self_recursions": [ + { + "name": "charAt", + "line": 11, + "equation": "charAt a0 a1 = charAt a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "char", + "line": 17, + "equation": "char a0 = char a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "b361c98410d61e2d110a4ae54cda75012679a6733b101dde378d3307ec69c702", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Unsafe.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "charAt", + "line": 10, + "declaration": "foreign import charAt :: Int -> String -> Char", + "vendored_status": "direct_self_recursion" + }, + { + "name": "char", + "line": 15, + "declaration": "foreign import char :: String -> Char", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String.purs", + "vendored_sha256": "0cf63fa0bccd027bededff0647c1a4251d235be02c1df8a8310be2aea2eb367f", + "vendored_lines": 10, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "0cf63fa0bccd027bededff0647c1a4251d235be02c1df8a8310be2aea2eb367f", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Symbol.purs", + "vendored_sha256": "ed7c86cc83440e529dec16a2a4a7a62e1e5f1f60a31e4ff56d3146489cd00946", + "vendored_lines": 25, + "self_recursions": [ + { + "name": "unsafeCoerce", + "line": 15, + "equation": "unsafeCoerce a0 = unsafeCoerce a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "8302d378edfcd58fbe1aadcf95c22f8637533de188b99ca2a0e43147e8957ec4", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Symbol.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeCoerce", + "line": 14, + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Traversable/Accum/Internal.purs", + "vendored_sha256": "03a2322dd8920092618ad5a9ef8bab31e740b384af88b2e9816abd25d34d1755", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "03a2322dd8920092618ad5a9ef8bab31e740b384af88b2e9816abd25d34d1755", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable/Accum/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Traversable/Accum.purs", + "vendored_sha256": "a37609f85d2dc1e527a2cd969302f0bf0bd5c8735226f5fbc874f67a6f4b646d", + "vendored_lines": 5, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "a37609f85d2dc1e527a2cd969302f0bf0bd5c8735226f5fbc874f67a6f4b646d", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable/Accum.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Traversable.purs", + "vendored_sha256": "b7410ac276078ed6a821fac77137bf631e6c9ba31b438e5d5d04b4eb33129675", + "vendored_lines": 251, + "self_recursions": [ + { + "name": "traverseArrayImpl", + "line": 107, + "equation": "traverseArrayImpl a0 a1 a2 a3 a4 = traverseArrayImpl a0 a1 a2 a3 a4", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "605c2e3c31d3531ce3674d5fb48ab608981b1553f9272c234ad9ca792108bf77", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "traverseArrayImpl", + "line": 106, + "declaration": "foreign import traverseArrayImpl :: forall m a b . (forall x y. m (x -> y) -> m x -> m y) -> (forall x y. (x -> y) -> m x -> m y) -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b)", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/TraversableWithIndex.purs", + "vendored_sha256": "aa2f2406e9ffbf49bb8b07a74b5c044eef9f4e3cef21b8cf7ba18a0edddc23ac", + "vendored_lines": 213, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "aa2f2406e9ffbf49bb8b07a74b5c044eef9f4e3cef21b8cf7ba18a0edddc23ac", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/TraversableWithIndex.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Tuple/Nested.purs", + "vendored_sha256": "6747d4c125c506fb22b831142513c54112fb3bf5908697534b540ce8e4cb0a4e", + "vendored_lines": 294, + "self_recursions": [], + "package": "purescript-tuples", + "tag": "v7.0.0", + "commit": "4f52da2729b448c8564369378f1232d8d2dc1d8b", + "upstream_sha256": "6747d4c125c506fb22b831142513c54112fb3bf5908697534b540ce8e4cb0a4e", + "upstream_url": "https://github.com/purescript/purescript-tuples/blob/4f52da2729b448c8564369378f1232d8d2dc1d8b/src/Data/Tuple/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Tuple.purs", + "vendored_sha256": "dbeb961cc0b8d3b9b29d2377d2d961bba227087e6b324c19cef818c638dc1f06", + "vendored_lines": 47, + "self_recursions": [], + "package": "purescript-tuples", + "tag": "v7.0.0", + "commit": "4f52da2729b448c8564369378f1232d8d2dc1d8b", + "upstream_sha256": "dc2ef1a90e52e851e02de1e8bb3bbbe9bfdbff8fe821473cbfda1998a82bc0d7", + "upstream_url": "https://github.com/purescript/purescript-tuples/blob/4f52da2729b448c8564369378f1232d8d2dc1d8b/src/Data/Tuple.purs", + "status": "modified", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [ + { + "line": 2, + "text": "module Data.Tuple where" + }, + { + "line": 4, + "text": "import Prelude" + }, + { + "line": 6, + "text": "import Control.Comonad (class Comonad)" + }, + { + "line": 7, + "text": "import Control.Extend (class Extend)" + }, + { + "line": 8, + "text": "import Control.Lazy (class Lazy, defer)" + }, + { + "line": 9, + "text": "import Data.Eq (class Eq1)" + }, + { + "line": 10, + "text": "import Data.Functor.Invariant (class Invariant, imapF)" + }, + { + "line": 11, + "text": "import Data.Generic.Rep (class Generic)" + }, + { + "line": 12, + "text": "import Data.HeytingAlgebra (implies, ff, tt)" + }, + { + "line": 13, + "text": "import Data.Ord (class Ord1)" + }, + { + "line": 20, + "text": "instance showTuple :: (Show a, Show b) => Show (Tuple a b) where" + }, + { + "line": 21, + "text": " show (Tuple a b) = \"(Tuple \" <> show a <> \" \" <> show b <> \")\"" + }, + { + "line": 27, + "text": "derive instance eq1Tuple :: Eq a => Eq1 (Tuple a)" + }, + { + "line": 35, + "text": "derive instance ord1Tuple :: Ord a => Ord1 (Tuple a)" + }, + { + "line": 37, + "text": "instance boundedTuple :: (Bounded a, Bounded b) => Bounded (Tuple a b) where" + }, + { + "line": 38, + "text": " top = Tuple top top" + }, + { + "line": 39, + "text": " bottom = Tuple bottom bottom" + }, + { + "line": 41, + "text": "instance semigroupoidTuple :: Semigroupoid Tuple where" + }, + { + "line": 42, + "text": " compose (Tuple _ c) (Tuple a _) = Tuple a c" + }, + { + "line": 50, + "text": "instance semigroupTuple :: (Semigroup a, Semigroup b) => Semigroup (Tuple a b) where" + }, + { + "line": 51, + "text": " append (Tuple a1 b1) (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2)" + }, + { + "line": 53, + "text": "instance monoidTuple :: (Monoid a, Monoid b) => Monoid (Tuple a b) where" + }, + { + "line": 54, + "text": " mempty = Tuple mempty mempty" + }, + { + "line": 56, + "text": "instance semiringTuple :: (Semiring a, Semiring b) => Semiring (Tuple a b) where" + }, + { + "line": 57, + "text": " add (Tuple x1 y1) (Tuple x2 y2) = Tuple (add x1 x2) (add y1 y2)" + }, + { + "line": 58, + "text": " one = Tuple one one" + }, + { + "line": 59, + "text": " mul (Tuple x1 y1) (Tuple x2 y2) = Tuple (mul x1 x2) (mul y1 y2)" + }, + { + "line": 60, + "text": " zero = Tuple zero zero" + }, + { + "line": 62, + "text": "instance ringTuple :: (Ring a, Ring b) => Ring (Tuple a b) where" + }, + { + "line": 63, + "text": " sub (Tuple x1 y1) (Tuple x2 y2) = Tuple (sub x1 x2) (sub y1 y2)" + }, + { + "line": 65, + "text": "instance commutativeRingTuple :: (CommutativeRing a, CommutativeRing b) => CommutativeRing (Tuple a b)" + }, + { + "line": 67, + "text": "instance heytingAlgebraTuple :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAlgebra (Tuple a b) where" + }, + { + "line": 68, + "text": " tt = Tuple tt tt" + }, + { + "line": 69, + "text": " ff = Tuple ff ff" + }, + { + "line": 70, + "text": " implies (Tuple x1 y1) (Tuple x2 y2) = Tuple (x1 `implies` x2) (y1 `implies` y2)" + }, + { + "line": 71, + "text": " conj (Tuple x1 y1) (Tuple x2 y2) = Tuple (conj x1 x2) (conj y1 y2)" + }, + { + "line": 72, + "text": " disj (Tuple x1 y1) (Tuple x2 y2) = Tuple (disj x1 x2) (disj y1 y2)" + }, + { + "line": 73, + "text": " not (Tuple x y) = Tuple (not x) (not y)" + }, + { + "line": 75, + "text": "instance booleanAlgebraTuple :: (BooleanAlgebra a, BooleanAlgebra b) => BooleanAlgebra (Tuple a b)" + }, + { + "line": 85, + "text": "derive instance genericTuple :: Generic (Tuple a b) _" + }, + { + "line": 87, + "text": "instance invariantTuple :: Invariant (Tuple a) where" + }, + { + "line": 88, + "text": " imap = imapF" + }, + { + "line": 96, + "text": "instance applyTuple :: (Semigroup a) => Apply (Tuple a) where" + }, + { + "line": 97, + "text": " apply (Tuple a1 f) (Tuple a2 x) = Tuple (a1 <> a2) (f x)" + }, + { + "line": 99, + "text": "instance applicativeTuple :: (Monoid a) => Applicative (Tuple a) where" + }, + { + "line": 100, + "text": " pure = Tuple mempty" + }, + { + "line": 102, + "text": "instance bindTuple :: (Semigroup a) => Bind (Tuple a) where" + }, + { + "line": 103, + "text": " bind (Tuple a1 b) f = case f b of" + }, + { + "line": 104, + "text": " Tuple a2 c -> Tuple (a1 <> a2) c" + }, + { + "line": 106, + "text": "instance monadTuple :: (Monoid a) => Monad (Tuple a)" + }, + { + "line": 108, + "text": "instance extendTuple :: Extend (Tuple a) where" + }, + { + "line": 109, + "text": " extend f t@(Tuple a _) = Tuple a (f t)" + }, + { + "line": 111, + "text": "instance comonadTuple :: Comonad (Tuple a) where" + }, + { + "line": 112, + "text": " extract = snd" + }, + { + "line": 114, + "text": "instance lazyTuple :: (Lazy a, Lazy b) => Lazy (Tuple a b) where" + }, + { + "line": 115, + "text": " defer f = Tuple (defer $ \\_ -> fst (f unit)) (defer $ \\_ -> snd (f unit))" + }, + { + "line": 118, + "text": "fst :: forall a b. Tuple a b -> a" + }, + { + "line": 119, + "text": "fst (Tuple a _) = a" + }, + { + "line": 122, + "text": "snd :: forall a b. Tuple a b -> b" + }, + { + "line": 123, + "text": "snd (Tuple _ b) = b" + }, + { + "line": 126, + "text": "curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c" + }, + { + "line": 127, + "text": "curry f a b = f (Tuple a b)" + }, + { + "line": 130, + "text": "uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c" + }, + { + "line": 131, + "text": "uncurry f (Tuple a b) = f a b" + }, + { + "line": 135, + "text": "swap (Tuple a b) = Tuple b a" + } + ] + }, + { + "path": "Data/Unfoldable.purs", + "vendored_sha256": "c9e3dc6b977c57614e65fe0d20ab7b13d9358f22dbbef0367558cf2e2602001c", + "vendored_lines": 96, + "self_recursions": [ + { + "name": "unfoldrArrayImpl", + "line": 48, + "equation": "unfoldrArrayImpl a0 a1 a2 a3 a4 a5 = unfoldrArrayImpl a0 a1 a2 a3 a4 a5", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-unfoldable", + "tag": "v6.0.0", + "commit": "493dfe04ed590e20d8f69079df2f58486882748d", + "upstream_sha256": "c36722cb427b94e8d20b6a4df3afd8163ebf71cf88502cc20e68d8e3cad773f7", + "upstream_url": "https://github.com/purescript/purescript-unfoldable/blob/493dfe04ed590e20d8f69079df2f58486882748d/src/Data/Unfoldable.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unfoldrArrayImpl", + "line": 47, + "declaration": "foreign import unfoldrArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Maybe (Tuple a b)) -> b -> Array a", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Unfoldable1.purs", + "vendored_sha256": "f609c34c7ec0e075fed9e31834461b445fa1031bbcf492dd30f04945b3bcc414", + "vendored_lines": 124, + "self_recursions": [ + { + "name": "unfoldr1ArrayImpl", + "line": 49, + "equation": "unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 = unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-unfoldable", + "tag": "v6.0.0", + "commit": "493dfe04ed590e20d8f69079df2f58486882748d", + "upstream_sha256": "7e5bf042a5c7d47bc6b5c57bcbfec7eadfd72d2f33979fa0d5ab7c4605f8edc1", + "upstream_url": "https://github.com/purescript/purescript-unfoldable/blob/493dfe04ed590e20d8f69079df2f58486882748d/src/Data/Unfoldable1.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unfoldr1ArrayImpl", + "line": 48, + "declaration": "foreign import unfoldr1ArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Tuple a (Maybe b)) -> b -> Array a", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Unit.purs", + "vendored_sha256": "9da429dc5a86e009ed827b12b3b98106668d6d744c6f6ab7ee8d71414eb6ca0d", + "vendored_lines": 5, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "ce9f2d8fba25b6b392e5e9e81afe0fe33968dc15420765ab19bac8adb948e64f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Unit.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unit", + "line": 14, + "declaration": "foreign import unit :: Unit", + "vendored_status": "declaration_removed" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 1, + "text": "module Data.Unit where" + }, + { + "line": 11, + "text": "foreign import data Unit :: Type" + } + ] + }, + { + "path": "Data/Void.purs", + "vendored_sha256": "bf2d7931a857b5aeafc4e3a27c1425010c8c7710772b4e3ff8c102f5c3f84564", + "vendored_lines": 34, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "bf2d7931a857b5aeafc4e3a27c1425010c8c7710772b4e3ff8c102f5c3f84564", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Void.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Witherable.purs", + "vendored_sha256": "3250d0c8465691cc772887e09ef48f4b9554a236f614da7346abed3c0f5cfb93", + "vendored_lines": 162, + "self_recursions": [], + "package": "purescript-filterable", + "tag": "v5.0.0", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "upstream_sha256": "3250d0c8465691cc772887e09ef48f4b9554a236f614da7346abed3c0f5cfb93", + "upstream_url": "https://github.com/purescript/purescript-filterable/blob/7c5b8c72779997f2b17d12ce478ff81e7ddda285/src/Data/Witherable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Console.purs", + "vendored_sha256": "c2a5ee927ddd5adb8e9ff0a78ad4937527f170e2cdbeaa906c163f6f9ce2ad0b", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-console", + "tag": "v6.0.0", + "commit": "3b83d7b792d03872afeea5e62b4f686ab0f09842", + "upstream_sha256": "14a1820f28867485552db40f58826ceafb63fc899802a38a15ea82dd6974cce7", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Console.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "log", + "line": 9, + "declaration": "foreign import log :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "warn", + "line": 19, + "declaration": "foreign import warn :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "error", + "line": 29, + "declaration": "foreign import error :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "info", + "line": 39, + "declaration": "foreign import info :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "debug", + "line": 49, + "declaration": "foreign import debug :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "time", + "line": 59, + "declaration": "foreign import time :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "timeLog", + "line": 62, + "declaration": "foreign import timeLog :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "timeEnd", + "line": 65, + "declaration": "foreign import timeEnd :: String -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "clear", + "line": 68, + "declaration": "foreign import clear :: Effect Unit", + "vendored_status": "declaration_removed" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 1, + "text": "module Effect.Console where" + }, + { + "line": 3, + "text": "import Effect (Effect)" + }, + { + "line": 5, + "text": "import Data.Show (class Show, show)" + }, + { + "line": 6, + "text": "import Data.Unit (Unit)" + }, + { + "line": 16, + "text": "logShow a = log (show a)" + }, + { + "line": 25, + "text": "warnShow :: forall a. Show a => a -> Effect Unit" + }, + { + "line": 26, + "text": "warnShow a = warn (show a)" + }, + { + "line": 35, + "text": "errorShow :: forall a. Show a => a -> Effect Unit" + }, + { + "line": 36, + "text": "errorShow a = error (show a)" + }, + { + "line": 45, + "text": "infoShow :: forall a. Show a => a -> Effect Unit" + }, + { + "line": 46, + "text": "infoShow a = info (show a)" + }, + { + "line": 55, + "text": "debugShow :: forall a. Show a => a -> Effect Unit" + }, + { + "line": 56, + "text": "debugShow a = debug (show a)" + } + ] + }, + { + "path": "Effect/Ref.purs", + "vendored_sha256": "d86b26af62019f18a830bab785419eca0fa016a366a7aed267bcf8967ca7c27b", + "vendored_lines": 78, + "self_recursions": [ + { + "name": "_new", + "line": 45, + "equation": "_new a0 = _new a0", + "replaces_upstream_foreign": true + }, + { + "name": "newWithSelf", + "line": 53, + "equation": "newWithSelf a0 = newWithSelf a0", + "replaces_upstream_foreign": true + }, + { + "name": "read", + "line": 57, + "equation": "read a0 = read a0", + "replaces_upstream_foreign": true + }, + { + "name": "modifyImpl", + "line": 65, + "equation": "modifyImpl a0 a1 = modifyImpl a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "write", + "line": 78, + "equation": "write a0 a1 = write a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-refs", + "tag": "v6.0.0", + "commit": "f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8", + "upstream_sha256": "d1e4e9c7037152b73f39a9a1369e9d6c00ca0d6ce6c437abe7ea457adb6d8774", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "_new", + "line": 44, + "declaration": "foreign import _new :: forall s. s -> Effect (Ref s)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "newWithSelf", + "line": 51, + "declaration": "foreign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s)", + "vendored_status": "direct_self_recursion" + }, + { + "name": "read", + "line": 54, + "declaration": "foreign import read :: forall s. Ref s -> Effect s", + "vendored_status": "direct_self_recursion" + }, + { + "name": "modifyImpl", + "line": 61, + "declaration": "foreign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b", + "vendored_status": "direct_self_recursion" + }, + { + "name": "write", + "line": 73, + "declaration": "foreign import write :: forall s. s -> Ref s -> Effect Unit", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect.purs", + "vendored_sha256": "5fc8b5fcab7455eb0e8b465d2132e6d9661cda2234f8c33ba0786df943ea97a1", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "f5738a67511e72894c3784e44a334c94a6aa8e504fd3a29ddccc3617416b6f40", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "pureE", + "line": 29, + "declaration": "foreign import pureE :: forall a. a -> Effect a", + "vendored_status": "declaration_removed" + }, + { + "name": "bindE", + "line": 34, + "declaration": "foreign import bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b", + "vendored_status": "declaration_removed" + }, + { + "name": "untilE", + "line": 53, + "declaration": "foreign import untilE :: Effect Boolean -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "whileE", + "line": 60, + "declaration": "foreign import whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "forE", + "line": 66, + "declaration": "foreign import forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "foreachE", + "line": 72, + "declaration": "foreign import foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit", + "vendored_status": "declaration_removed" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 6, + "text": " , untilE, whileE, forE, foreachE" + }, + { + "line": 9, + "text": "import Prelude" + }, + { + "line": 11, + "text": "import Control.Apply (lift2)" + }, + { + "line": 16, + "text": "foreign import data Effect :: Type -> Type" + }, + { + "line": 18, + "text": "type role Effect representational" + }, + { + "line": 20, + "text": "instance functorEffect :: Functor Effect where" + }, + { + "line": 21, + "text": " map = liftA1" + }, + { + "line": 23, + "text": "instance applyEffect :: Apply Effect where" + }, + { + "line": 24, + "text": " apply = ap" + }, + { + "line": 26, + "text": "instance applicativeEffect :: Applicative Effect where" + }, + { + "line": 27, + "text": " pure = pureE" + }, + { + "line": 31, + "text": "instance bindEffect :: Bind Effect where" + }, + { + "line": 32, + "text": " bind = bindE" + }, + { + "line": 36, + "text": "instance monadEffect :: Monad Effect" + }, + { + "line": 41, + "text": "instance semigroupEffect :: Semigroup a => Semigroup (Effect a) where" + }, + { + "line": 42, + "text": " append = lift2 append" + }, + { + "line": 46, + "text": "instance monoidEffect :: Monoid a => Monoid (Effect a) where" + }, + { + "line": 47, + "text": " mempty = pureE mempty" + } + ] + }, + { + "path": "Partial/Unsafe.purs", + "vendored_sha256": "022f9f5be76786175aad6bd61195e5ee73de6de35d73ee358456052983868ff0", + "vendored_lines": 25, + "self_recursions": [ + { + "name": "_unsafePartial", + "line": 17, + "equation": "_unsafePartial a0 = _unsafePartial a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-partial", + "tag": "v4.0.0", + "commit": "0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec", + "upstream_sha256": "d3d70727652d25459d19f812d186cf24583de1be5eb1decd87b6bf4afc36a4bd", + "upstream_url": "https://github.com/purescript/purescript-partial/blob/0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec/src/Partial/Unsafe.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "_unsafePartial", + "line": 16, + "declaration": "foreign import _unsafePartial :: forall a b. a -> b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Partial.purs", + "vendored_sha256": "565d0df86ee74a5e8019f9b512a396accb6576a5b3d4d67eff8a594831d94c97", + "vendored_lines": 16, + "self_recursions": [ + { + "name": "_crashWith", + "line": 16, + "equation": "_crashWith a0 = _crashWith a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-partial", + "tag": "v4.0.0", + "commit": "0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec", + "upstream_sha256": "33ec6baf7de02292b40b97ed63f91402ec09ebf49c97392bb77ea78680177cd6", + "upstream_url": "https://github.com/purescript/purescript-partial/blob/0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec/src/Partial.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "_crashWith", + "line": 15, + "declaration": "foreign import _crashWith :: forall a. String -> a", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Prelude.purs", + "vendored_sha256": "925d3e4db03f42b08f79538d254b9c453a096330101768f8e425860b6e3c09d2", + "vendored_lines": 104, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "af6b069885f179a179cc805e6ff7920e1c791dba6fc4d07cd2f52c5e7b91e59f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Prelude.purs", + "status": "modified", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [ + { + "line": 14, + "text": " ( module Control.Applicative" + } + ] + }, + { + "path": "Record/Unsafe.purs", + "vendored_sha256": "5cc9d89e59a814db34295bbf35f1609d7e0b553cdc26ad2d03fc4aae9d0b59da", + "vendored_lines": 31, + "self_recursions": [ + { + "name": "unsafeHas", + "line": 11, + "equation": "unsafeHas a0 a1 = unsafeHas a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "unsafeGet", + "line": 17, + "equation": "unsafeGet a0 a1 = unsafeGet a0 a1", + "replaces_upstream_foreign": true + }, + { + "name": "unsafeSet", + "line": 24, + "equation": "unsafeSet a0 a1 a2 = unsafeSet a0 a1 a2", + "replaces_upstream_foreign": true + }, + { + "name": "unsafeDelete", + "line": 31, + "equation": "unsafeDelete a0 a1 = unsafeDelete a0 a1", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "21acab8a811f760d56be569f4e8c2ae30705b34711b26de1cc39b16f96ba3ac1", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Record/Unsafe.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeHas", + "line": 10, + "declaration": "foreign import unsafeHas :: forall r1. String -> Record r1 -> Boolean", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unsafeGet", + "line": 15, + "declaration": "foreign import unsafeGet :: forall r a. String -> Record r -> a", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unsafeSet", + "line": 21, + "declaration": "foreign import unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2", + "vendored_status": "direct_self_recursion" + }, + { + "name": "unsafeDelete", + "line": 27, + "declaration": "foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Safe/Coerce.purs", + "vendored_sha256": "67ab89bd8194231b886591fb03a5d8cd1cbb91e68e384a7e768c4405fa6d959e", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-safe-coerce", + "tag": "v2.0.0", + "commit": "7fa799ae80a38b8d948efcb52608e58e198b3da7", + "upstream_sha256": "67ab89bd8194231b886591fb03a5d8cd1cbb91e68e384a7e768c4405fa6d959e", + "upstream_url": "https://github.com/purescript/purescript-safe-coerce/blob/7fa799ae80a38b8d948efcb52608e58e198b3da7/src/Safe/Coerce.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Test/Assert.purs", + "vendored_sha256": "1bb4d996770bed380779a280c1c663703f151e4e89c146daec0b6b342be4f53b", + "vendored_lines": 70, + "self_recursions": [], + "package": "purescript-assert", + "tag": "v6.0.0", + "commit": "27c0edb57d2ee497eb5fab664f5601c35b613eda", + "upstream_sha256": "666601c3d459503802027dca698b9bd05bacd42f48f7d320a834196ed4cb4127", + "upstream_url": "https://github.com/purescript/purescript-assert/blob/27c0edb57d2ee497eb5fab664f5601c35b613eda/src/Test/Assert.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "assertImpl", + "line": 29, + "declaration": "foreign import assertImpl :: String -> Boolean -> Effect Unit", + "vendored_status": "declaration_removed" + }, + { + "name": "checkThrows", + "line": 59, + "declaration": "foreign import checkThrows :: forall a . (Unit -> a) -> Effect Boolean", + "vendored_status": "declaration_removed" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 1, + "text": "module Test.Assert" + }, + { + "line": 2, + "text": " ( assert" + }, + { + "line": 3, + "text": " , assert'" + }, + { + "line": 4, + "text": " , assertEqual" + }, + { + "line": 5, + "text": " , assertEqual'" + }, + { + "line": 6, + "text": " , assertFalse" + }, + { + "line": 7, + "text": " , assertFalse'" + }, + { + "line": 8, + "text": " , assertThrows" + }, + { + "line": 9, + "text": " , assertThrows'" + }, + { + "line": 10, + "text": " , assertTrue" + }, + { + "line": 11, + "text": " , assertTrue'" + }, + { + "line": 12, + "text": " ) where" + }, + { + "line": 26, + "text": "assert' :: String -> Boolean -> Effect Unit" + }, + { + "line": 27, + "text": "assert' = assertImpl" + }, + { + "line": 41, + "text": "assertThrows :: forall a. (Unit -> a) -> Effect Unit" + }, + { + "line": 42, + "text": "assertThrows =" + }, + { + "line": 43, + "text": " assertThrows' \"Assertion failed: An error should have been thrown\"" + }, + { + "line": 52, + "text": "assertThrows'" + }, + { + "line": 53, + "text": " :: forall a" + }, + { + "line": 54, + "text": " . String" + }, + { + "line": 55, + "text": " -> (Unit -> a)" + }, + { + "line": 56, + "text": " -> Effect Unit" + }, + { + "line": 57, + "text": "assertThrows' msg fn = assert' msg =<< checkThrows fn" + }, + { + "line": 68, + "text": "assertEqual" + }, + { + "line": 69, + "text": " :: forall a" + }, + { + "line": 70, + "text": " . Eq a" + }, + { + "line": 71, + "text": " => Show a" + }, + { + "line": 72, + "text": " => { actual :: a, expected :: a }" + }, + { + "line": 73, + "text": " -> Effect Unit" + }, + { + "line": 74, + "text": "assertEqual = assertEqual' \"\"" + }, + { + "line": 80, + "text": "assertEqual'" + }, + { + "line": 81, + "text": " :: forall a" + }, + { + "line": 82, + "text": " . Eq a" + }, + { + "line": 83, + "text": " => Show a" + }, + { + "line": 84, + "text": " => String" + }, + { + "line": 85, + "text": " -> { actual :: a, expected :: a }" + }, + { + "line": 86, + "text": " -> Effect Unit" + }, + { + "line": 87, + "text": "assertEqual' userMessage {actual, expected} = do" + }, + { + "line": 88, + "text": " unless result $ error message" + }, + { + "line": 89, + "text": " assert' message result" + }, + { + "line": 90, + "text": " where" + }, + { + "line": 91, + "text": " message = (if userMessage == \"\" then \"\" else userMessage <> \"\\n\")" + }, + { + "line": 92, + "text": " <> \"Expected: \" <> show expected" + }, + { + "line": 93, + "text": " <> \"\\nActual: \" <> show actual" + }, + { + "line": 94, + "text": " result = actual == expected" + }, + { + "line": 100, + "text": "assertTrue" + }, + { + "line": 101, + "text": " :: Boolean" + }, + { + "line": 102, + "text": " -> Effect Unit" + }, + { + "line": 103, + "text": "assertTrue actual = assertEqual { actual, expected: true }" + }, + { + "line": 110, + "text": "assertTrue'" + }, + { + "line": 111, + "text": " :: String" + }, + { + "line": 112, + "text": " -> Boolean" + }, + { + "line": 113, + "text": " -> Effect Unit" + }, + { + "line": 114, + "text": "assertTrue' message actual = assertEqual' message { actual, expected: true }" + }, + { + "line": 120, + "text": "assertFalse" + }, + { + "line": 121, + "text": " :: Boolean" + }, + { + "line": 122, + "text": " -> Effect Unit" + }, + { + "line": 123, + "text": "assertFalse actual = assertEqual { actual, expected: false }" + }, + { + "line": 130, + "text": "assertFalse'" + }, + { + "line": 131, + "text": " :: String" + }, + { + "line": 132, + "text": " -> Boolean" + }, + { + "line": 133, + "text": " -> Effect Unit" + }, + { + "line": 134, + "text": "assertFalse' message actual = assertEqual' message { actual, expected: false }" + } + ] + }, + { + "path": "Type/Data/Boolean.purs", + "vendored_sha256": "5bb19aeaddc6ea478b96f06025e742284c85f413637de56cb78198b86aa5fc87", + "vendored_lines": 66, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "5bb19aeaddc6ea478b96f06025e742284c85f413637de56cb78198b86aa5fc87", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Data/Boolean.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Data/Ordering.purs", + "vendored_sha256": "fcc7c02e66257c06c4647b929e187d214d653789fee6afc49346d4990ed14997", + "vendored_lines": 69, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "fcc7c02e66257c06c4647b929e187d214d653789fee6afc49346d4990ed14997", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Data/Ordering.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Data/Symbol.purs", + "vendored_sha256": "4c3283d0804ca9d2a1ba9fdfb7cf85aacdf2d0c8f6472b383d4b162d8940817b", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "4c3283d0804ca9d2a1ba9fdfb7cf85aacdf2d0c8f6472b383d4b162d8940817b", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Data/Symbol.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Equality.purs", + "vendored_sha256": "ac672615fd3612b596eda3ab9f2472006e7ee954c7880cc91ac4865f7c120f56", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-type-equality", + "tag": "v4.0.1", + "commit": "0525b7d39e0fbd81b4209518139fb8ab02695774", + "upstream_sha256": "ac672615fd3612b596eda3ab9f2472006e7ee954c7880cc91ac4865f7c120f56", + "upstream_url": "https://github.com/purescript/purescript-type-equality/blob/0525b7d39e0fbd81b4209518139fb8ab02695774/src/Type/Equality.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Function.purs", + "vendored_sha256": "d134b0394685faa83528c92f64c6827194b4531c956dd7d669436c30b2fd9812", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "d134b0394685faa83528c92f64c6827194b4531c956dd7d669436c30b2fd9812", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Function.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Prelude.purs", + "vendored_sha256": "2293b8cfd59325e393d51a047dcbaf4aaaf81a131c3f16c9b91ad49bb8f9732d", + "vendored_lines": 17, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "2293b8cfd59325e393d51a047dcbaf4aaaf81a131c3f16c9b91ad49bb8f9732d", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Prelude.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Proxy.purs", + "vendored_sha256": "e823c48b15006447de763d42a9f6b8c9e6913a3bd4b49b5e3b7cdce78d7d9b7c", + "vendored_lines": 53, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "e823c48b15006447de763d42a9f6b8c9e6913a3bd4b49b5e3b7cdce78d7d9b7c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Type/Proxy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Row/Homogeneous.purs", + "vendored_sha256": "a3db3ece627f2d2c1ef76b76a0e6699934115dd52c6e56ecf50d95868e4eaab8", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "a3db3ece627f2d2c1ef76b76a0e6699934115dd52c6e56ecf50d95868e4eaab8", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Row/Homogeneous.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Row.purs", + "vendored_sha256": "b504404c46678bdbe8c49567a4fbbc1ba3cdddc25a7834539c23a1e99001132b", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "b504404c46678bdbe8c49567a4fbbc1ba3cdddc25a7834539c23a1e99001132b", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Row.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/RowList.purs", + "vendored_sha256": "8e5b0112718c7a42104d5904dc8ad26619b04d826493fc818e375469010a24dd", + "vendored_lines": 82, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "8e5b0112718c7a42104d5904dc8ad26619b04d826493fc818e375469010a24dd", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/RowList.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Unsafe/Coerce.purs", + "vendored_sha256": "ddd0085161aef5cf24f2b0970307043ac3ca2988878949cc38440e5c1ef38493", + "vendored_lines": 28, + "self_recursions": [ + { + "name": "unsafeCoerce", + "line": 28, + "equation": "unsafeCoerce a0 = unsafeCoerce a0", + "replaces_upstream_foreign": true + } + ], + "package": "purescript-unsafe-coerce", + "tag": "v6.0.0", + "commit": "ab956f82e66e633f647fb3098e8ddd3ec58d689f", + "upstream_sha256": "f0d052e7b2e2431860e6e995a91824c0d6437e2de773fd51c2324f626e10ed19", + "upstream_url": "https://github.com/purescript/purescript-unsafe-coerce/blob/ab956f82e66e633f647fb3098e8ddd3ec58d689f/src/Unsafe/Coerce.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeCoerce", + "line": 27, + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "vendored_status": "direct_self_recursion" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "WASI/Clock.purs", + "vendored_sha256": "222f07399b2b881674691eff41d296a943824435ab13e60556f0117e048a7d0a", + "vendored_lines": 14, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Console.purs", + "vendored_sha256": "f49f4c7ae2e7c70f21bc35ce5080d000637a569e561567470ebf360c32c4beb9", + "vendored_lines": 33, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/FileSystem.purs", + "vendored_sha256": "66747fef3108642b01290cd8323b7ef9ff4aaf08703370ffcd2d1654d92f5a32", + "vendored_lines": 270, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/IO.purs", + "vendored_sha256": "e3df53b3966841930e01f4c89505172ed64996c60aae37118bb5d0d03d725c85", + "vendored_lines": 67, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Network.purs", + "vendored_sha256": "c2b769cf39bf4ba879024c5bcae388a0ee16bec143be81fb4bd199d6f3fd80d4", + "vendored_lines": 130, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Process.purs", + "vendored_sha256": "4cfd83ff897a6b3a1cea44aa6d4d5a3fd6e3d4d3a8ad30061ba80636de0bca7b", + "vendored_lines": 13, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Random.purs", + "vendored_sha256": "c05d4bf338e66e0358d9c74a494d8d84c2c4c99e37750a54c909600834175ee9", + "vendored_lines": 16, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Resource.purs", + "vendored_sha256": "8da4a53234de3f7d1ec6ee6aaead124a27201edba261da22da38f171fb167acc", + "vendored_lines": 14, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI.purs", + "vendored_sha256": "a1f72de13e9676ec66a87080e631ed4e31bf4a4392b10b6fdeabfc39f8d2bb11", + "vendored_lines": 102, + "self_recursions": [], + "status": "platform_addition" + } + ], + "absent_modules": [ + { + "path": "Effect/Class.purs", + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "a78c5876b0aad1123e30ca8a37cd79ca2a837fbccc3a9e92bea3793033cc5a03", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Class.purs" + }, + { + "path": "Effect/Class/Console.purs", + "package": "purescript-console", + "tag": "v6.0.0", + "commit": "3b83d7b792d03872afeea5e62b4f686ab0f09842", + "upstream_sha256": "1aa9260f9b96c0d6b5721c5ad473dd0c518157d06da9c5d4cbbac6c28518558d", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Class/Console.purs" + }, + { + "path": "Effect/Uncurried.purs", + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "0c6db8591d2519d9b18bf2c5ec56f33b6c25ee6f69d3edfbce8482d48771214b", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs" + }, + { + "path": "Effect/Unsafe.purs", + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "e20339c8aed22f342fa8d452dd186079b4324cd00933b9e9f4eeb59d3313cac0", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Unsafe.purs" + } + ], + "limits": [ + "Only supplied upstream checkouts are compared; baseline_unavailable is not a pass.", + "Self-recursion detection covers exact top-level same-argument equations only.", + "The script records differences without approving target adaptations or proving semantic equivalence.", + "The official compiler support dependency ranges do not uniquely pin package patch versions." + ] +} diff --git a/docs/implementation/stdlib/vendor-audit-2026-10-06/modules.md b/docs/implementation/stdlib/vendor-audit-2026-10-06/modules.md new file mode 100644 index 00000000..6b4fba99 --- /dev/null +++ b/docs/implementation/stdlib/vendor-audit-2026-10-06/modules.md @@ -0,0 +1,226 @@ +# Vendored module inventory + +Generated by `audit-stdlib-vendor.py`. Status is comparison evidence, not approval. + +| Module path | Official package/tag | Comparison | Direct self-recursions | +| --- | --- | --- | --- | +| `Control/Alt.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Alternative.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Applicative.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/Apply.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Control/Biapplicative.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Control/Biapply.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Control/Bind.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Control/Category.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/Comonad.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Extend.purs` | purescript-control v6.0.0 | modified | 1 | +| `Control/Lazy.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Monad/Gen/Class.purs` | purescript-gen v4.0.0 | identical | 0 | +| `Control/Monad/Gen/Common.purs` | purescript-gen v4.0.0 | identical | 0 | +| `Control/Monad/Gen.purs` | purescript-gen v4.0.0 | identical | 0 | +| `Control/Monad/Rec/Class.purs` | purescript-tailrec v6.1.0 | identical | 0 | +| `Control/Monad/ST/Class.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Global.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Internal.purs` | purescript-st v6.2.0 | modified | 11 | +| `Control/Monad/ST/Ref.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Uncurried.purs` | purescript-st v6.2.0 | modified | 20 | +| `Control/Monad/ST.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/MonadPlus.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Plus.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Semigroupoid.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Array/NonEmpty/Internal.purs` | purescript-arrays v7.3.0 | modified | 3 | +| `Data/Array/NonEmpty.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/Partial.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/ST/Iterator.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/ST/Partial.purs` | purescript-arrays v7.3.0 | modified | 2 | +| `Data/Array/ST.purs` | purescript-arrays v7.3.0 | modified | 17 | +| `Data/Array.purs` | purescript-arrays v7.3.0 | modified | 24 | +| `Data/Bifoldable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Bifunctor/Join.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Data/Bifunctor.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Data/Bitraversable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Boolean.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/BooleanAlgebra.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Bounded/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Bounded.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Char/Gen.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/Char.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/CommutativeRing.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Compactable.purs` | purescript-filterable v5.0.0 | identical | 0 | +| `Data/Comparison.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Const.purs` | purescript-const v6.0.0 | identical | 0 | +| `Data/Decidable.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Decide.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Distributive.purs` | purescript-distributive v6.0.0 | identical | 0 | +| `Data/Divide.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Divisible.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/DivisionRing.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Either/Inject.purs` | purescript-either v6.1.0 | identical | 0 | +| `Data/Either/Nested.purs` | purescript-either v6.1.0 | identical | 0 | +| `Data/Either.purs` | purescript-either v6.1.0 | identical | 0 | +| `Data/Enum/Gen.purs` | purescript-enums v6.0.1 | identical | 0 | +| `Data/Enum/Generic.purs` | purescript-enums v6.0.1 | identical | 0 | +| `Data/Enum.purs` | purescript-enums v6.0.1 | modified | 2 | +| `Data/Eq/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Eq.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Equivalence.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/EuclideanRing.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Exists.purs` | purescript-exists v6.0.0 | identical | 0 | +| `Data/Field.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Filterable.purs` | purescript-filterable v5.0.0 | identical | 0 | +| `Data/Foldable.purs` | purescript-foldable-traversable v6.0.0 | modified | 2 | +| `Data/FoldableWithIndex.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Function/Uncurried.purs` | purescript-functions v6.0.0 | modified | 20 | +| `Data/Function.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Functor/App.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Clown.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Compose.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Contravariant.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Functor/Coproduct/Inject.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Coproduct/Nested.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Coproduct.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Costar.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Flip.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Invariant.purs` | purescript-invariant v6.0.0 | identical | 0 | +| `Data/Functor/Joker.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Product/Nested.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Product.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Product2.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/FunctorWithIndex.purs` | purescript-foldable-traversable v6.0.0 | modified | 1 | +| `Data/Generic/Rep.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/HeytingAlgebra/Generic.purs` | purescript-prelude v6.0.1 | newline_only | 0 | +| `Data/HeytingAlgebra.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Identity.purs` | purescript-identity v6.0.0 | identical | 0 | +| `Data/Int/Bits.purs` | purescript-integers v6.0.0 | modified | 0 | +| `Data/Int.purs` | purescript-integers v6.0.0 | modified | 7 | +| `Data/Lazy.purs` | purescript-lazy v6.0.0 | modified | 2 | +| `Data/List/Internal.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Lazy/NonEmpty.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Lazy/Types.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Lazy.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/NonEmpty.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Partial.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Types.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/ZipList.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/Map/Gen.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Map/Internal.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Map.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Maybe/First.purs` | purescript-maybe v6.0.0 | identical | 0 | +| `Data/Maybe/Last.purs` | purescript-maybe v6.0.0 | identical | 0 | +| `Data/Maybe.purs` | purescript-maybe v6.0.0 | identical | 0 | +| `Data/Monoid/Additive.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Alternate.purs` | purescript-control v6.0.0 | identical | 0 | +| `Data/Monoid/Conj.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Disj.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Dual.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Endo.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Multiplicative.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/NaturalTransformation.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Newtype.purs` | purescript-newtype v5.0.0 | identical | 0 | +| `Data/NonEmpty.purs` | purescript-nonempty v7.0.0 | identical | 0 | +| `Data/Number/Approximate.purs` | purescript-numbers v9.0.1 | identical | 0 | +| `Data/Number/Format.purs` | purescript-numbers v9.0.1 | modified | 4 | +| `Data/Number.purs` | purescript-numbers v9.0.1 | modified | 25 | +| `Data/Op.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Ord/Down.purs` | purescript-orders v6.0.0 | identical | 0 | +| `Data/Ord/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Ord/Max.purs` | purescript-orders v6.0.0 | identical | 0 | +| `Data/Ord/Min.purs` | purescript-orders v6.0.0 | identical | 0 | +| `Data/Ord.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Ordering.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Predicate.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Profunctor/Choice.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Closed.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Cochoice.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Costrong.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Join.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Split.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Star.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Strong.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Reflectable.purs` | purescript-prelude v6.0.1 | modified | 1 | +| `Data/Ring/Generic.purs` | purescript-prelude v6.0.1 | newline_only | 0 | +| `Data/Ring.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Semigroup/First.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/Foldable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Semigroup/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/Last.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/Traversable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Semigroup.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Semiring/Generic.purs` | purescript-prelude v6.0.1 | newline_only | 0 | +| `Data/Semiring.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Set/NonEmpty.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Set.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Show/Generic.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Show.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/String/CaseInsensitive.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/CodePoints.purs` | purescript-strings v6.0.1 | modified | 7 | +| `Data/String/CodeUnits.purs` | purescript-strings v6.0.1 | modified | 15 | +| `Data/String/Common.purs` | purescript-strings v6.0.1 | modified | 8 | +| `Data/String/Gen.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/CaseInsensitive.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/CodePoints.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/CodeUnits.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/Internal.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Pattern.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Regex/Flags.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Regex/Unsafe.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Regex.purs` | purescript-strings v6.0.1 | modified | 10 | +| `Data/String/Unsafe.purs` | purescript-strings v6.0.1 | modified | 2 | +| `Data/String.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/Symbol.purs` | purescript-prelude v6.0.1 | modified | 1 | +| `Data/Traversable/Accum/Internal.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Traversable/Accum.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Traversable.purs` | purescript-foldable-traversable v6.0.0 | modified | 1 | +| `Data/TraversableWithIndex.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Tuple/Nested.purs` | purescript-tuples v7.0.0 | identical | 0 | +| `Data/Tuple.purs` | purescript-tuples v7.0.0 | modified | 0 | +| `Data/Unfoldable.purs` | purescript-unfoldable v6.0.0 | modified | 1 | +| `Data/Unfoldable1.purs` | purescript-unfoldable v6.0.0 | modified | 1 | +| `Data/Unit.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Void.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Witherable.purs` | purescript-filterable v5.0.0 | identical | 0 | +| `Effect/Console.purs` | purescript-console v6.0.0 | modified | 0 | +| `Effect/Ref.purs` | purescript-refs v6.0.0 | modified | 5 | +| `Effect.purs` | purescript-effect v4.0.0 | modified | 0 | +| `Partial/Unsafe.purs` | purescript-partial v4.0.0 | modified | 1 | +| `Partial.purs` | purescript-partial v4.0.0 | modified | 1 | +| `Prelude.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Record/Unsafe.purs` | purescript-prelude v6.0.1 | modified | 4 | +| `Safe/Coerce.purs` | purescript-safe-coerce v2.0.0 | identical | 0 | +| `Test/Assert.purs` | purescript-assert v6.0.0 | modified | 0 | +| `Type/Data/Boolean.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Data/Ordering.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Data/Symbol.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Equality.purs` | purescript-type-equality v4.0.1 | identical | 0 | +| `Type/Function.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Prelude.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Proxy.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Type/Row/Homogeneous.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Row.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/RowList.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Unsafe/Coerce.purs` | purescript-unsafe-coerce v6.0.0 | modified | 1 | +| `WASI/Clock.purs` | unavailable | platform_addition | 0 | +| `WASI/Console.purs` | unavailable | platform_addition | 0 | +| `WASI/FileSystem.purs` | unavailable | platform_addition | 0 | +| `WASI/IO.purs` | unavailable | platform_addition | 0 | +| `WASI/Network.purs` | unavailable | platform_addition | 0 | +| `WASI/Process.purs` | unavailable | platform_addition | 0 | +| `WASI/Random.purs` | unavailable | platform_addition | 0 | +| `WASI/Resource.purs` | unavailable | platform_addition | 0 | +| `WASI.purs` | unavailable | platform_addition | 0 | + +## Official modules absent from the vendored library + +| Module path | Official package/tag | +| --- | --- | +| `Effect/Class.purs` | purescript-effect v4.0.0 | +| `Effect/Class/Console.purs` | purescript-console v6.0.0 | +| `Effect/Uncurried.purs` | purescript-effect v4.0.0 | +| `Effect/Unsafe.purs` | purescript-effect v4.0.0 | diff --git a/docs/implementation/stdlib/vendor-audit-2026-10-06/official-vs-vendored.diff b/docs/implementation/stdlib/vendor-audit-2026-10-06/official-vs-vendored.diff new file mode 100644 index 00000000..3fc53ad5 --- /dev/null +++ b/docs/implementation/stdlib/vendor-audit-2026-10-06/official-vs-vendored.diff @@ -0,0 +1,3821 @@ +--- purescript-prelude@v6.0.1/src/Control/Apply.purs ++++ stdlib/lib/Control/Apply.purs +@@ -60,7 +60,22 @@ + instance applyArray :: Apply Array where + apply = arrayApply + +-foreign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b ++arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b ++arrayApply a0 a1 = applyArrayFrom a0 a1 0 ++ ++applyArrayFrom :: forall a b. Array (a -> b) -> Array a -> Int -> Array b ++applyArrayFrom fs xs index = ++ if intLt index (arrayLength fs) then ++ arrayAppend (mapArrayAll (arrayIndex fs index) xs 0) (applyArrayFrom fs xs (intAdd index 1)) ++ else ++ [] ++ ++mapArrayAll :: forall a b. (a -> b) -> Array a -> Int -> Array b ++mapArrayAll f xs index = ++ if intLt index (arrayLength xs) then ++ arrayAppend [f (arrayIndex xs index)] (mapArrayAll f xs (intAdd index 1)) ++ else ++ [] + + instance applyProxy :: Apply Proxy where + apply _ _ = Proxy +--- purescript-prelude@v6.0.1/src/Control/Bind.purs ++++ stdlib/lib/Control/Bind.purs +@@ -94,7 +94,15 @@ + instance bindArray :: Bind Array where + bind = arrayBind + +-foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b ++arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b ++arrayBind a0 a1 = bindArrayFrom a0 a1 0 ++ ++bindArrayFrom :: forall a b. Array a -> (a -> Array b) -> Int -> Array b ++bindArrayFrom xs f index = ++ if intLt index (arrayLength xs) then ++ arrayAppend (f (arrayIndex xs index)) (bindArrayFrom xs f (intAdd index 1)) ++ else ++ [] + + instance bindProxy :: Bind Proxy where + bind _ _ = Proxy +--- purescript-control@v6.0.0/src/Control/Extend.purs ++++ stdlib/lib/Control/Extend.purs +@@ -27,7 +27,8 @@ + instance extendFn :: Semigroup w => Extend ((->) w) where + extend f g w = f \w' -> g (w <> w') + +-foreign import arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b ++arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b ++arrayExtend a0 a1 = arrayExtend a0 a1 + + instance extendArray :: Extend Array where + extend = arrayExtend +--- purescript-st@v6.2.0/src/Control/Monad/ST/Internal.purs ++++ stdlib/lib/Control/Monad/ST/Internal.purs +@@ -35,11 +35,14 @@ + + type role ST nominal representational + +-foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b ++map_ :: forall r a b. (a -> b) -> ST r a -> ST r b ++map_ a0 a1 = map_ a0 a1 + +-foreign import pure_ :: forall r a. a -> ST r a ++pure_ :: forall r a. a -> ST r a ++pure_ a0 = pure_ a0 + +-foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b ++bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b ++bind_ a0 a1 = bind_ a0 a1 + + instance functorST :: Functor (ST r) where + map = map_ +@@ -86,26 +89,30 @@ + -- | to the surrounding computation. It may cause problems to apply this + -- | function using the `$` operator. The recommended approach is to use + -- | parentheses instead. +-foreign import run :: forall a. (forall r. ST r a) -> a ++run :: forall a. (forall r. ST r a) -> a ++run a0 = run a0 + + -- | Loop while a condition is `true`. + -- | + -- | `while b m` is ST computation which runs the ST computation `b`. If its + -- | result is `true`, it runs the ST computation `m` and loops. If not, the + -- | computation ends. +-foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit ++while :: forall r a. ST r Boolean -> ST r a -> ST r Unit ++while a0 a1 = while a0 a1 + + -- | Loop over a consecutive collection of numbers + -- | + -- | `ST.for lo hi f` runs the computation returned by the function `f` for each + -- | of the inputs between `lo` (inclusive) and `hi` (exclusive). +-foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit ++for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit ++for a0 a1 a2 = for a0 a1 a2 + + -- | Loop over an array of values. + -- | + -- | `ST.foreach xs f` runs the computation returned by the function `f` for each + -- | of the inputs `xs`. +-foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit ++foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit ++foreach a0 a1 = foreach a0 a1 + + -- | The type `STRef r a` represents a mutable reference holding a value of + -- | type `a`, which can be used with the `ST r` effect. +@@ -114,10 +121,12 @@ + type role STRef nominal representational + + -- | Create a new mutable reference. +-foreign import new :: forall a r. a -> ST r (STRef r a) ++new :: forall a r. a -> ST r (STRef r a) ++new a0 = new a0 + + -- | Read the current value of a mutable reference. +-foreign import read :: forall a r. STRef r a -> ST r a ++read :: forall a r. STRef r a -> ST r a ++read a0 = read a0 + + -- | Update the value of a mutable reference by applying a function + -- | to the current value, computing a new state value for the reference and +@@ -125,7 +134,8 @@ + modify' :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b + modify' = modifyImpl + +-foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b ++modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b ++modifyImpl a0 a1 = modifyImpl a0 a1 + + -- | Modify the value of a mutable reference by applying a function to the + -- | current value. The modified value is returned. +@@ -133,4 +143,5 @@ + modify f = modify' \s -> let s' = f s in { state: s', value: s' } + + -- | Set the value of a mutable reference. +-foreign import write :: forall a r. a -> STRef r a -> ST r a ++write :: forall a r. a -> STRef r a -> ST r a ++write a0 a1 = write a0 a1 +--- purescript-st@v6.2.0/src/Control/Monad/ST/Uncurried.purs ++++ stdlib/lib/Control/Monad/ST/Uncurried.purs +@@ -58,44 +58,44 @@ + + type role STFn10 representational representational representational representational representational representational representational representational representational representational nominal representational + +-foreign import mkSTFn1 :: forall a t r. +- (a -> ST t r) -> STFn1 a t r +-foreign import mkSTFn2 :: forall a b t r. +- (a -> b -> ST t r) -> STFn2 a b t r +-foreign import mkSTFn3 :: forall a b c t r. +- (a -> b -> c -> ST t r) -> STFn3 a b c t r +-foreign import mkSTFn4 :: forall a b c d t r. +- (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r +-foreign import mkSTFn5 :: forall a b c d e t r. +- (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r +-foreign import mkSTFn6 :: forall a b c d e f t r. +- (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r +-foreign import mkSTFn7 :: forall a b c d e f g t r. +- (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r +-foreign import mkSTFn8 :: forall a b c d e f g h t r. +- (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r +-foreign import mkSTFn9 :: forall a b c d e f g h i t r. +- (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r +-foreign import mkSTFn10 :: forall a b c d e f g h i j t r. +- (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r ++mkSTFn1 :: forall a t r. (a -> ST t r) -> STFn1 a t r ++mkSTFn1 a0 = mkSTFn1 a0 ++mkSTFn2 :: forall a b t r. (a -> b -> ST t r) -> STFn2 a b t r ++mkSTFn2 a0 = mkSTFn2 a0 ++mkSTFn3 :: forall a b c t r. (a -> b -> c -> ST t r) -> STFn3 a b c t r ++mkSTFn3 a0 = mkSTFn3 a0 ++mkSTFn4 :: forall a b c d t r. (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r ++mkSTFn4 a0 = mkSTFn4 a0 ++mkSTFn5 :: forall a b c d e t r. (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r ++mkSTFn5 a0 = mkSTFn5 a0 ++mkSTFn6 :: forall a b c d e f t r. (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r ++mkSTFn6 a0 = mkSTFn6 a0 ++mkSTFn7 :: forall a b c d e f g t r. (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r ++mkSTFn7 a0 = mkSTFn7 a0 ++mkSTFn8 :: forall a b c d e f g h t r. (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r ++mkSTFn8 a0 = mkSTFn8 a0 ++mkSTFn9 :: forall a b c d e f g h i t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r ++mkSTFn9 a0 = mkSTFn9 a0 ++mkSTFn10 :: forall a b c d e f g h i j t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r ++mkSTFn10 a0 = mkSTFn10 a0 + +-foreign import runSTFn1 :: forall a t r. +- STFn1 a t r -> a -> ST t r +-foreign import runSTFn2 :: forall a b t r. +- STFn2 a b t r -> a -> b -> ST t r +-foreign import runSTFn3 :: forall a b c t r. +- STFn3 a b c t r -> a -> b -> c -> ST t r +-foreign import runSTFn4 :: forall a b c d t r. +- STFn4 a b c d t r -> a -> b -> c -> d -> ST t r +-foreign import runSTFn5 :: forall a b c d e t r. +- STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r +-foreign import runSTFn6 :: forall a b c d e f t r. +- STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r +-foreign import runSTFn7 :: forall a b c d e f g t r. +- STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r +-foreign import runSTFn8 :: forall a b c d e f g h t r. +- STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r +-foreign import runSTFn9 :: forall a b c d e f g h i t r. +- STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r +-foreign import runSTFn10 :: forall a b c d e f g h i j t r. +- STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r ++runSTFn1 :: forall a t r. STFn1 a t r -> a -> ST t r ++runSTFn1 a0 a1 = runSTFn1 a0 a1 ++runSTFn2 :: forall a b t r. STFn2 a b t r -> a -> b -> ST t r ++runSTFn2 a0 a1 a2 = runSTFn2 a0 a1 a2 ++runSTFn3 :: forall a b c t r. STFn3 a b c t r -> a -> b -> c -> ST t r ++runSTFn3 a0 a1 a2 a3 = runSTFn3 a0 a1 a2 a3 ++runSTFn4 :: forall a b c d t r. STFn4 a b c d t r -> a -> b -> c -> d -> ST t r ++runSTFn4 a0 a1 a2 a3 a4 = runSTFn4 a0 a1 a2 a3 a4 ++runSTFn5 :: forall a b c d e t r. STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r ++runSTFn5 a0 a1 a2 a3 a4 a5 = runSTFn5 a0 a1 a2 a3 a4 a5 ++runSTFn6 :: forall a b c d e f t r. STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r ++runSTFn6 a0 a1 a2 a3 a4 a5 a6 = runSTFn6 a0 a1 a2 a3 a4 a5 a6 ++runSTFn7 :: forall a b c d e f g t r. STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r ++runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 ++runSTFn8 :: forall a b c d e f g h t r. STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r ++runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 ++runSTFn9 :: forall a b c d e f g h i t r. STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r ++runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 ++runSTFn10 :: forall a b c d e f g h i j t r. STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r ++runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 +--- purescript-arrays@v7.3.0/src/Data/Array/NonEmpty/Internal.purs ++++ stdlib/lib/Data/Array/NonEmpty/Internal.purs +@@ -72,13 +72,10 @@ + derive newtype instance altNonEmptyArray :: Alt NonEmptyArray + + -- we use FFI here to avoid the unncessary copy created by `tail` +-foreign import foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a +-foreign import foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a ++foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a ++foldr1Impl = foldr1Impl ++foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a ++foldl1Impl = foldl1Impl + +-foreign import traverse1Impl +- :: forall m a b +- . Fn3 +- (forall a' b'. (m (a' -> b') -> m a' -> m b')) +- (forall a' b'. (a' -> b') -> m a' -> m b') +- (a -> m b) +- (NonEmptyArray a -> m (NonEmptyArray b)) ++traverse1Impl :: forall m a b . Fn3 (forall a' b'. (m (a' -> b') -> m a' -> m b')) (forall a' b'. (a' -> b') -> m a' -> m b') (a -> m b) (NonEmptyArray a -> m (NonEmptyArray b)) ++traverse1Impl = traverse1Impl +--- purescript-arrays@v7.3.0/src/Data/Array/ST/Partial.purs ++++ stdlib/lib/Data/Array/ST/Partial.purs +@@ -21,7 +21,8 @@ + -> ST h a + peek = runSTFn2 peekImpl + +-foreign import peekImpl :: forall h a. STFn2 Int (STArray h a) h a ++peekImpl :: forall h a. STFn2 Int (STArray h a) h a ++peekImpl = peekImpl + + -- | Change the value at the specified index in a mutable array. + poke +@@ -33,4 +34,5 @@ + -> ST h Unit + poke = runSTFn3 pokeImpl + +-foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit ++pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit ++pokeImpl = pokeImpl +--- purescript-arrays@v7.3.0/src/Data/Array/ST.purs ++++ stdlib/lib/Data/Array/ST.purs +@@ -75,17 +75,20 @@ + unsafeFreeze :: forall h a. STArray h a -> ST h (Array a) + unsafeFreeze = runSTFn1 unsafeFreezeImpl + +-foreign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) ++unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) ++unsafeFreezeImpl = unsafeFreezeImpl + + -- | O(1) Convert an immutable array to a mutable array, without copying. The input + -- | array must not be used afterward. + unsafeThaw :: forall h a. Array a -> ST h (STArray h a) + unsafeThaw = runSTFn1 unsafeThawImpl + +-foreign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a) ++unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a) ++unsafeThawImpl = unsafeThawImpl + + -- | Create a new, empty mutable array. +-foreign import new :: forall h a. ST h (STArray h a) ++new :: forall h a. ST h (STArray h a) ++new = new + + thaw + :: forall h a +@@ -94,7 +97,8 @@ + thaw = runSTFn1 thawImpl + + -- | Create a mutable copy of an immutable array. +-foreign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a) ++thawImpl :: forall h a. STFn1 (Array a) h (STArray h a) ++thawImpl = thawImpl + + -- | Make a mutable copy of a mutable array. + clone +@@ -103,7 +107,8 @@ + -> ST h (STArray h a) + clone = runSTFn1 cloneImpl + +-foreign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a) ++cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a) ++cloneImpl = cloneImpl + + -- | Sort a mutable array in place. Sorting is stable: the order of equal + -- | elements is preserved. +@@ -114,9 +119,8 @@ + shift :: forall h a. STArray h a -> ST h (Maybe a) + shift = runSTFn3 shiftImpl Just Nothing + +-foreign import shiftImpl +- :: forall h a +- . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) ++shiftImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) ++shiftImpl = shiftImpl + + -- | Sort a mutable array in place using a comparison function. Sorting is + -- | stable: the order of elements is preserved if they are equal according to +@@ -131,9 +135,8 @@ + EQ -> 0 + LT -> -1 + +-foreign import sortByImpl +- :: forall a h +- . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a) ++sortByImpl :: forall a h . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a) ++sortByImpl = sortByImpl + + -- | Sort a mutable array in place based on a projection. Sorting is stable: the + -- | order of elements is preserved if they are equal according to the projection. +@@ -152,7 +155,8 @@ + -> ST h (Array a) + freeze = runSTFn1 freezeImpl + +-foreign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) ++freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) ++freezeImpl = freezeImpl + + -- | Read the value at the specified index in a mutable array. + peek +@@ -162,7 +166,8 @@ + -> ST h (Maybe a) + peek = runSTFn4 peekImpl Just Nothing + +-foreign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r ++peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r ++peekImpl = peekImpl + + poke + :: forall h a +@@ -173,9 +178,11 @@ + poke = runSTFn3 pokeImpl + + -- | Change the value at the specified index in a mutable array. +-foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean +- +-foreign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int ++pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean ++pokeImpl = pokeImpl ++ ++lengthImpl :: forall h a. STFn1 (STArray h a) h Int ++lengthImpl = lengthImpl + + -- | Get the number of elements in a mutable array. + length :: forall h a. STArray h a -> ST h Int +@@ -185,16 +192,16 @@ + pop :: forall h a. STArray h a -> ST h (Maybe a) + pop = runSTFn3 popImpl Just Nothing + +-foreign import popImpl +- :: forall h a +- . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) ++popImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) ++popImpl = popImpl + + -- | Append an element to the end of a mutable array. Returns the new length of + -- | the array. + push :: forall h a. a -> (STArray h a) -> ST h Int + push = runSTFn2 pushImpl + +-foreign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int ++pushImpl :: forall h a. STFn2 a (STArray h a) h Int ++pushImpl = pushImpl + + -- | Append the values in an immutable array to the end of a mutable array. + -- | Returns the new length of the mutable array. +@@ -205,9 +212,8 @@ + -> ST h Int + pushAll = runSTFn2 pushAllImpl + +-foreign import pushAllImpl +- :: forall h a +- . STFn2 (Array a) (STArray h a) h Int ++pushAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int ++pushAllImpl = pushAllImpl + + -- | Append an element to the front of a mutable array. Returns the new length of + -- | the array. +@@ -223,9 +229,8 @@ + -> ST h Int + unshiftAll = runSTFn2 unshiftAllImpl + +-foreign import unshiftAllImpl +- :: forall h a +- . STFn2 (Array a) (STArray h a) h Int ++unshiftAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int ++unshiftAllImpl = unshiftAllImpl + + -- | Mutate the element at the specified index using the supplied function. + modify :: forall h a. Int -> (a -> a) -> STArray h a -> ST h Boolean +@@ -245,9 +250,8 @@ + -> ST h (Array a) + splice = runSTFn4 spliceImpl + +-foreign import spliceImpl +- :: forall h a +- . STFn4 Int Int (Array a) (STArray h a) h (Array a) ++spliceImpl :: forall h a . STFn4 Int Int (Array a) (STArray h a) h (Array a) ++spliceImpl = spliceImpl + + -- | Create an immutable copy of a mutable array, where each element + -- | is labelled with its index in the original array. +@@ -257,6 +261,5 @@ + -> ST h (Array (Assoc a)) + toAssocArray = runSTFn1 toAssocArrayImpl + +-foreign import toAssocArrayImpl +- :: forall h a +- . STFn1 (STArray h a) h (Array (Assoc a)) ++toAssocArrayImpl :: forall h a . STFn1 (STArray h a) h (Array (Assoc a)) ++toAssocArrayImpl = toAssocArrayImpl +--- purescript-arrays@v7.3.0/src/Data/Array.purs ++++ stdlib/lib/Data/Array.purs +@@ -174,9 +174,8 @@ + fromFoldable :: forall f. Foldable f => f ~> Array + fromFoldable = runFn2 fromFoldableImpl F.foldr + +-foreign import fromFoldableImpl +- :: forall f a +- . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a) ++fromFoldableImpl :: forall f a . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a) ++fromFoldableImpl = fromFoldableImpl + + -- | Create an array of one element + -- | ```purescript +@@ -192,7 +191,8 @@ + range :: Int -> Int -> Array Int + range = runFn2 rangeImpl + +-foreign import rangeImpl :: Fn2 Int Int (Array Int) ++rangeImpl :: Fn2 Int Int (Array Int) ++rangeImpl = rangeImpl + + -- | Create an array containing a value repeated the specified number of times. + -- | ```purescript +@@ -201,7 +201,8 @@ + replicate :: forall a. Int -> a -> Array a + replicate = runFn2 replicateImpl + +-foreign import replicateImpl :: forall a. Fn2 Int a (Array a) ++replicateImpl :: forall a. Fn2 Int a (Array a) ++replicateImpl = replicateImpl + + -- | An infix synonym for `range`. + -- | ```purescript +@@ -240,7 +241,8 @@ + -- | ```purescript + -- | length ["Hello", "World"] = 2 + -- | ``` +-foreign import length :: forall a. Array a -> Int ++length :: forall a. Array a -> Int ++length a0 = length a0 + + -------------------------------------------------------------------------------- + -- Extending arrays ------------------------------------------------------------ +@@ -370,9 +372,8 @@ + uncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a } + uncons = runFn3 unconsImpl (const Nothing) \x xs -> Just { head: x, tail: xs } + +-foreign import unconsImpl +- :: forall a b +- . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b ++unconsImpl :: forall a b . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b ++unconsImpl = unconsImpl + + -- | Break an array into its last element and all preceding elements. + -- | +@@ -402,9 +403,8 @@ + index :: forall a. Array a -> Int -> Maybe a + index = runFn4 indexImpl Just Nothing + +-foreign import indexImpl +- :: forall a +- . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a) ++indexImpl :: forall a . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a) ++indexImpl = indexImpl + + -- | An infix version of `index`. + -- | +@@ -459,14 +459,8 @@ + findMap :: forall a b. (a -> Maybe b) -> Array a -> Maybe b + findMap = runFn4 findMapImpl Nothing isJust + +-foreign import findMapImpl +- :: forall a b +- . Fn4 +- (forall c. Maybe c) +- (forall c. Maybe c -> Boolean) +- (a -> Maybe b) +- (Array a) +- (Maybe b) ++findMapImpl :: forall a b . Fn4 (forall c. Maybe c) (forall c. Maybe c -> Boolean) (a -> Maybe b) (Array a) (Maybe b) ++findMapImpl = findMapImpl + + -- | Find the first index for which a predicate holds. + -- | +@@ -478,14 +472,8 @@ + findIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int + findIndex = runFn4 findIndexImpl Just Nothing + +-foreign import findIndexImpl +- :: forall a +- . Fn4 +- (forall b. b -> Maybe b) +- (forall b. Maybe b) +- (a -> Boolean) +- (Array a) +- (Maybe Int) ++findIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int) ++findIndexImpl = findIndexImpl + + -- | Find the last index for which a predicate holds. + -- | +@@ -497,14 +485,8 @@ + findLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int + findLastIndex = runFn4 findLastIndexImpl Just Nothing + +-foreign import findLastIndexImpl +- :: forall a +- . Fn4 +- (forall b. b -> Maybe b) +- (forall b. Maybe b) +- (a -> Boolean) +- (Array a) +- (Maybe Int) ++findLastIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int) ++findLastIndexImpl = findLastIndexImpl + + -- | Insert an element at the specified index, creating a new array, or + -- | returning `Nothing` if the index is out of bounds. +@@ -517,15 +499,8 @@ + insertAt :: forall a. Int -> a -> Array a -> Maybe (Array a) + insertAt = runFn5 _insertAt Just Nothing + +-foreign import _insertAt +- :: forall a +- . Fn5 +- (forall b. b -> Maybe b) +- (forall b. Maybe b) +- Int +- a +- (Array a) +- (Maybe (Array a)) ++_insertAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a)) ++_insertAt = _insertAt + + -- | Delete the element at the specified index, creating a new array, or + -- | returning `Nothing` if the index is out of bounds. +@@ -538,14 +513,8 @@ + deleteAt :: forall a. Int -> Array a -> Maybe (Array a) + deleteAt = runFn4 _deleteAt Just Nothing + +-foreign import _deleteAt +- :: forall a +- . Fn4 +- (forall b. b -> Maybe b) +- (forall b. Maybe b) +- Int +- (Array a) +- (Maybe (Array a)) ++_deleteAt :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) Int (Array a) (Maybe (Array a)) ++_deleteAt = _deleteAt + + -- | Change the element at the specified index, creating a new array, or + -- | returning `Nothing` if the index is out of bounds. +@@ -558,15 +527,8 @@ + updateAt :: forall a. Int -> a -> Array a -> Maybe (Array a) + updateAt = runFn5 _updateAt Just Nothing + +-foreign import _updateAt +- :: forall a +- . Fn5 +- (forall b. b -> Maybe b) +- (forall b. Maybe b) +- Int +- a +- (Array a) +- (Maybe (Array a)) ++_updateAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a)) ++_updateAt = _updateAt + + -- | Apply a function to the element at the specified index, creating a new + -- | array, or returning `Nothing` if the index is out of bounds. +@@ -639,7 +601,8 @@ + -- | reverse [1, 2, 3] = [3, 2, 1] + -- | ``` + -- | +-foreign import reverse :: forall a. Array a -> Array a ++reverse :: forall a. Array a -> Array a ++reverse a0 = reverse a0 + + -- | Flatten an array of arrays, creating a new array. + -- | +@@ -647,7 +610,8 @@ + -- | concat [[1, 2, 3], [], [4, 5, 6]] = [1, 2, 3, 4, 5, 6] + -- | ``` + -- | +-foreign import concat :: forall a. Array (Array a) -> Array a ++concat :: forall a. Array (Array a) -> Array a ++concat a0 = concat a0 + + -- | Apply a function to each element in an array, and flatten the results + -- | into a single, new array. +@@ -670,9 +634,8 @@ + filter :: forall a. (a -> Boolean) -> Array a -> Array a + filter = runFn2 filterImpl + +-foreign import filterImpl +- :: forall a +- . Fn2 (a -> Boolean) (Array a) (Array a) ++filterImpl :: forall a . Fn2 (a -> Boolean) (Array a) (Array a) ++filterImpl = filterImpl + + -- | Partition an array using a predicate function, creating a set of + -- | new arrays. One for the values satisfying the predicate function +@@ -689,9 +652,8 @@ + -> { yes :: Array a, no :: Array a } + partition = runFn2 partitionImpl + +-foreign import partitionImpl +- :: forall a +- . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a } ++partitionImpl :: forall a . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a } ++partitionImpl = partitionImpl + + -- | Splits an array into two subarrays, where `before` contains the elements + -- | up to (but not including) the given index, and `after` contains the rest +@@ -854,7 +816,8 @@ + scanl :: forall a b. (b -> a -> b) -> b -> Array a -> Array b + scanl = runFn3 scanlImpl + +-foreign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b) ++scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b) ++scanlImpl = scanlImpl + + -- | Fold a data structure from the right, keeping all intermediate results + -- | instead of only the final result. Note that the initial value does not +@@ -867,7 +830,8 @@ + scanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b + scanr = runFn3 scanrImpl + +-foreign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b) ++scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b) ++scanrImpl = scanrImpl + + -------------------------------------------------------------------------------- + -- Sorting --------------------------------------------------------------------- +@@ -911,7 +875,8 @@ + sortWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a + sortWith f = sortBy (comparing f) + +-foreign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a) ++sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a) ++sortByImpl = sortByImpl + + -------------------------------------------------------------------------------- + -- Subarrays ------------------------------------------------------------------- +@@ -929,7 +894,8 @@ + slice :: forall a. Int -> Int -> Array a -> Array a + slice = runFn3 sliceImpl + +-foreign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a) ++sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a) ++sliceImpl = sliceImpl + + -- | Keep only a number of elements from the start of an array, creating a new + -- | array. +@@ -1250,13 +1216,8 @@ + -> Array c + zipWith = runFn3 zipWithImpl + +-foreign import zipWithImpl +- :: forall a b c +- . Fn3 +- (a -> b -> c) +- (Array a) +- (Array b) +- (Array c) ++zipWithImpl :: forall a b c . Fn3 (a -> b -> c) (Array a) (Array b) (Array c) ++zipWithImpl = zipWithImpl + + -- | A generalization of `zipWith` which accumulates results in some + -- | `Applicative` functor. +@@ -1319,7 +1280,8 @@ + any :: forall a. (a -> Boolean) -> Array a -> Boolean + any = runFn2 anyImpl + +-foreign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean ++anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean ++anyImpl = anyImpl + + -- | Returns true if all the array elements satisfy the given predicate. + -- | iterating the array only as necessary and stopping as soon as the predicate +@@ -1333,7 +1295,8 @@ + all :: forall a. (a -> Boolean) -> Array a -> Boolean + all = runFn2 allImpl + +-foreign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean ++allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean ++allImpl = allImpl + + -- | Perform a fold using a monadic step function. + -- | +@@ -1368,4 +1331,5 @@ + unsafeIndex :: forall a. Partial => Array a -> Int -> a + unsafeIndex = runFn2 unsafeIndexImpl + +-foreign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a ++unsafeIndexImpl :: forall a. Fn2 (Array a) Int a ++unsafeIndexImpl = unsafeIndexImpl +--- purescript-prelude@v6.0.1/src/Data/Bounded.purs ++++ stdlib/lib/Data/Bounded.purs +@@ -37,16 +37,20 @@ + top = topInt + bottom = bottomInt + +-foreign import topInt :: Int +-foreign import bottomInt :: Int ++topInt :: Int ++topInt = 2147483647 ++bottomInt :: Int ++bottomInt = intSub (intSub 0 2147483647) 1 + + -- | Characters fall within the Unicode range. + instance boundedChar :: Bounded Char where + top = topChar + bottom = bottomChar + +-foreign import topChar :: Char +-foreign import bottomChar :: Char ++topChar :: Char ++topChar = intToChar 65535 ++bottomChar :: Char ++bottomChar = intToChar 0 + + instance boundedOrdering :: Bounded Ordering where + top = GT +@@ -56,8 +60,10 @@ + top = unit + bottom = unit + +-foreign import topNumber :: Number +-foreign import bottomNumber :: Number ++topNumber :: Number ++topNumber = numberDiv 1.0 0.0 ++bottomNumber :: Number ++bottomNumber = numberNeg (numberDiv 1.0 0.0) + + instance boundedNumber :: Bounded Number where + top = topNumber +--- purescript-enums@v6.0.1/src/Data/Enum.purs ++++ stdlib/lib/Data/Enum.purs +@@ -317,5 +317,7 @@ + charToEnum n | n >= toCharCode bottom && n <= toCharCode top = Just (fromCharCode n) + charToEnum _ = Nothing + +-foreign import toCharCode :: Char -> Int +-foreign import fromCharCode :: Int -> Char ++toCharCode :: Char -> Int ++toCharCode a0 = toCharCode a0 ++fromCharCode :: Int -> Char ++fromCharCode a0 = fromCharCode a0 +--- purescript-prelude@v6.0.1/src/Data/Eq.purs ++++ stdlib/lib/Data/Eq.purs +@@ -45,19 +45,19 @@ + infix 4 notEq as /= + + instance eqBoolean :: Eq Boolean where +- eq = eqBooleanImpl ++ eq x y = eqBooleanImpl x y + + instance eqInt :: Eq Int where +- eq = eqIntImpl ++ eq x y = eqIntImpl x y + + instance eqNumber :: Eq Number where +- eq = eqNumberImpl ++ eq x y = eqNumberImpl x y + + instance eqChar :: Eq Char where +- eq = eqCharImpl ++ eq x y = eqCharImpl x y + + instance eqString :: Eq String where +- eq = eqStringImpl ++ eq x y = eqStringImpl x y + + instance eqUnit :: Eq Unit where + eq _ _ = true +@@ -66,7 +66,7 @@ + eq _ _ = true + + instance eqArray :: Eq a => Eq (Array a) where +- eq = eqArrayImpl eq ++ eq xs ys = eqArrayImpl eq xs ys + + instance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) where + eq = eqRecord (Proxy :: Proxy list) +@@ -74,13 +74,32 @@ + instance eqProxy :: Eq (Proxy a) where + eq _ _ = true + +-foreign import eqBooleanImpl :: Boolean -> Boolean -> Boolean +-foreign import eqIntImpl :: Int -> Int -> Boolean +-foreign import eqNumberImpl :: Number -> Number -> Boolean +-foreign import eqCharImpl :: Char -> Char -> Boolean +-foreign import eqStringImpl :: String -> String -> Boolean ++eqBooleanImpl :: Boolean -> Boolean -> Boolean ++eqBooleanImpl a0 a1 = booleanEq a0 a1 ++eqIntImpl :: Int -> Int -> Boolean ++eqIntImpl a0 a1 = intEq a0 a1 ++eqNumberImpl :: Number -> Number -> Boolean ++eqNumberImpl a0 a1 = numberEq a0 a1 ++eqCharImpl :: Char -> Char -> Boolean ++eqCharImpl a0 a1 = charEq a0 a1 ++eqStringImpl :: String -> String -> Boolean ++eqStringImpl a0 a1 = eqBytes (stringToBytes a0) (stringToBytes a1) 0 + +-foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean ++eqBytes :: Array Int -> Array Int -> Int -> Boolean ++eqBytes xs ys index = ++ if intGe index (arrayLength xs) then intEq (arrayLength xs) (arrayLength ys) ++ else if intGe index (arrayLength ys) then false ++ else if intEq (arrayIndex xs index) (arrayIndex ys index) then eqBytes xs ys (intAdd index 1) ++ else false ++ ++eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean ++eqArrayImpl a0 a1 a2 = eqArrayFrom a0 a1 a2 0 ++ ++eqArrayFrom :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Int -> Boolean ++eqArrayFrom eq xs ys index = ++ if intGe index (arrayLength xs) then intEq (arrayLength xs) (arrayLength ys) ++ else if eq (arrayIndex xs index) (arrayIndex ys index) then eqArrayFrom eq xs ys (intAdd index 1) ++ else false + + -- | The `Eq1` type class represents type constructors with decidable equality. + class Eq1 f where +--- purescript-prelude@v6.0.1/src/Data/EuclideanRing.purs ++++ stdlib/lib/Data/EuclideanRing.purs +@@ -72,20 +72,25 @@ + infixl 7 div as / + + instance euclideanRingInt :: EuclideanRing Int where +- degree = intDegree +- div = intDiv +- mod = intMod ++ degree x = intDegree x ++ div x y = intDiv x y ++ mod x y = intMod x y + + instance euclideanRingNumber :: EuclideanRing Number where + degree _ = 1 +- div = numDiv ++ div x y = numDiv x y + mod _ _ = 0.0 + +-foreign import intDegree :: Int -> Int +-foreign import intDiv :: Int -> Int -> Int +-foreign import intMod :: Int -> Int -> Int ++intDegree :: Int -> Int ++intDegree a0 = if intEq a0 minInt32 then 2147483647 else if intLt a0 0 then intNeg a0 else a0 + +-foreign import numDiv :: Number -> Number -> Number ++minInt32 :: Int ++minInt32 = intSub (intSub 0 2147483647) 1 ++ ++ ++ ++numDiv :: Number -> Number -> Number ++numDiv a0 a1 = numberDiv a0 a1 + + -- | The *greatest common divisor* of two values. + gcd :: forall a. Eq a => EuclideanRing a => a -> a -> a +--- purescript-foldable-traversable@v6.0.0/src/Data/Foldable.purs ++++ stdlib/lib/Data/Foldable.purs +@@ -132,8 +132,10 @@ + foldl = foldlArray + foldMap = foldMapDefaultR + +-foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b +-foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b ++foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b ++foldrArray a0 a1 a2 = foldrArray a0 a1 a2 ++foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b ++foldlArray a0 a1 a2 = foldlArray a0 a1 a2 + + instance foldableMaybe :: Foldable Maybe where + foldr _ z Nothing = z +@@ -223,7 +225,7 @@ + + -- | Fold a data structure, accumulating values in some `Monoid`. + fold :: forall f m. Foldable f => Monoid m => f m -> m +-fold = foldMap identity ++fold xs = foldMap identity xs + + -- | Similar to 'foldl', but the result is encapsulated in a monad. + -- | +--- purescript-functions@v6.0.0/src/Data/Function/Uncurried.purs ++++ stdlib/lib/Data/Function/Uncurried.purs +@@ -56,69 +56,89 @@ + type role Fn10 representational representational representational representational representational representational representational representational representational representational representational + + -- | Create a function of no arguments +-foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a ++mkFn0 :: forall a. (Unit -> a) -> Fn0 a ++mkFn0 a0 = mkFn0 a0 + + -- | Create a function of one argument + mkFn1 :: forall a b. (a -> b) -> Fn1 a b + mkFn1 f = f + + -- | Create a function of two arguments from a curried function +-foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c ++mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c ++mkFn2 a0 = mkFn2 a0 + + -- | Create a function of three arguments from a curried function +-foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d ++mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d ++mkFn3 a0 = mkFn3 a0 + + -- | Create a function of four arguments from a curried function +-foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e ++mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e ++mkFn4 a0 = mkFn4 a0 + + -- | Create a function of five arguments from a curried function +-foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f ++mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f ++mkFn5 a0 = mkFn5 a0 + + -- | Create a function of six arguments from a curried function +-foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g ++mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g ++mkFn6 a0 = mkFn6 a0 + + -- | Create a function of seven arguments from a curried function +-foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h ++mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h ++mkFn7 a0 = mkFn7 a0 + + -- | Create a function of eight arguments from a curried function +-foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i ++mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i ++mkFn8 a0 = mkFn8 a0 + + -- | Create a function of nine arguments from a curried function +-foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j ++mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j ++mkFn9 a0 = mkFn9 a0 + + -- | Create a function of ten arguments from a curried function +-foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k ++mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k ++mkFn10 a0 = mkFn10 a0 + + -- | Apply a function of no arguments +-foreign import runFn0 :: forall a. Fn0 a -> a ++runFn0 :: forall a. Fn0 a -> a ++runFn0 a0 = runFn0 a0 + + -- | Apply a function of one argument + runFn1 :: forall a b. Fn1 a b -> a -> b + runFn1 f = f + + -- | Apply a function of two arguments +-foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c ++runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c ++runFn2 a0 a1 a2 = runFn2 a0 a1 a2 + + -- | Apply a function of three arguments +-foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d ++runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d ++runFn3 a0 a1 a2 a3 = runFn3 a0 a1 a2 a3 + + -- | Apply a function of four arguments +-foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e ++runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e ++runFn4 a0 a1 a2 a3 a4 = runFn4 a0 a1 a2 a3 a4 + + -- | Apply a function of five arguments +-foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f ++runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f ++runFn5 a0 a1 a2 a3 a4 a5 = runFn5 a0 a1 a2 a3 a4 a5 + + -- | Apply a function of six arguments +-foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g ++runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g ++runFn6 a0 a1 a2 a3 a4 a5 a6 = runFn6 a0 a1 a2 a3 a4 a5 a6 + + -- | Apply a function of seven arguments +-foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h ++runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h ++runFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runFn7 a0 a1 a2 a3 a4 a5 a6 a7 + + -- | Apply a function of eight arguments +-foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i ++runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i ++runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 + + -- | Apply a function of nine arguments +-foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j ++runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j ++runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 + + -- | Apply a function of ten arguments +-foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k ++runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k ++runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 +--- purescript-prelude@v6.0.1/src/Data/Functor.purs ++++ stdlib/lib/Data/Functor.purs +@@ -47,12 +47,20 @@ + map = compose + + instance functorArray :: Functor Array where +- map = arrayMap ++ map x y = arrayMap x y + + instance functorProxy :: Functor Proxy where + map _ _ = Proxy + +-foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b ++arrayMap :: forall a b. (a -> b) -> Array a -> Array b ++arrayMap a0 a1 = mapArrayFrom a0 a1 0 ++ ++mapArrayFrom :: forall a b. (a -> b) -> Array a -> Int -> Array b ++mapArrayFrom f xs index = ++ if intLt index (arrayLength xs) then ++ arrayAppend [f (arrayIndex xs index)] (mapArrayFrom f xs (intAdd index 1)) ++ else ++ [] + + -- | The `void` function is used to ignore the type wrapped by a + -- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type +@@ -67,18 +75,18 @@ + -- | print (n * n) + -- | ``` + void :: forall f a. Functor f => f a -> f Unit +-void = map (const unit) ++void fa = map (\_ -> unit) fa + + -- | Ignore the return value of a computation, using the specified return value + -- | instead. + voidRight :: forall f a b. Functor f => a -> f b -> f a +-voidRight x = map (const x) ++voidRight x fa = map (\_ -> x) fa + + infixl 4 voidRight as <$ + + -- | A version of `voidRight` with its arguments flipped. + voidLeft :: forall f a b. Functor f => f a -> b -> f b +-voidLeft f x = const x <$> f ++voidLeft fa x = (\_ -> x) <$> fa + + infixl 4 voidLeft as $> + +--- purescript-foldable-traversable@v6.0.0/src/Data/FunctorWithIndex.purs ++++ stdlib/lib/Data/FunctorWithIndex.purs +@@ -35,7 +35,8 @@ + class Functor f <= FunctorWithIndex i f | f -> i where + mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b + +-foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b ++mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b ++mapWithIndexArray a0 a1 = mapWithIndexArray a0 a1 + + instance functorWithIndexArray :: FunctorWithIndex Int Array where + mapWithIndex = mapWithIndexArray +--- purescript-prelude@v6.0.1/src/Data/HeytingAlgebra/Generic.purs ++++ stdlib/lib/Data/HeytingAlgebra/Generic.purs +@@ -67,4 +67,4 @@ + + -- | A `Generic` implementation of the `not` member from the `HeytingAlgebra` type class. + genericNot :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a +-genericNot x = to $ genericNot' (from x) +\ No newline at end of file ++genericNot x = to $ genericNot' (from x) +--- purescript-prelude@v6.0.1/src/Data/HeytingAlgebra.purs ++++ stdlib/lib/Data/HeytingAlgebra.purs +@@ -64,9 +64,9 @@ + ff = false + tt = true + implies a b = not a || b +- conj = boolConj +- disj = boolDisj +- not = boolNot ++ conj x y = boolConj x y ++ disj x y = boolDisj x y ++ not x = boolNot x + + instance heytingAlgebraUnit :: HeytingAlgebra Unit where + ff = unit +@@ -100,9 +100,12 @@ + implies = impliesRecord (Proxy :: Proxy list) + not = notRecord (Proxy :: Proxy list) + +-foreign import boolConj :: Boolean -> Boolean -> Boolean +-foreign import boolDisj :: Boolean -> Boolean -> Boolean +-foreign import boolNot :: Boolean -> Boolean ++boolConj :: Boolean -> Boolean -> Boolean ++boolConj a0 a1 = booleanAnd a0 a1 ++boolDisj :: Boolean -> Boolean -> Boolean ++boolDisj a0 a1 = booleanOr a0 a1 ++boolNot :: Boolean -> Boolean ++boolNot a0 = booleanNot a0 + + -- | A class for records where all fields have `HeytingAlgebra` instances, used + -- | to implement the `HeytingAlgebra` instance for records. +--- purescript-integers@v6.0.0/src/Data/Int/Bits.purs ++++ stdlib/lib/Data/Int/Bits.purs +@@ -10,28 +10,35 @@ + ) where + + -- | Bitwise AND. +-foreign import and :: Int -> Int -> Int ++and :: Int -> Int -> Int ++and a0 a1 = intAnd a0 a1 + + infixl 10 and as .&. + + -- | Bitwise OR. +-foreign import or :: Int -> Int -> Int ++or :: Int -> Int -> Int ++or a0 a1 = intOr a0 a1 + + infixl 10 or as .|. + + -- | Bitwise XOR. +-foreign import xor :: Int -> Int -> Int ++xor :: Int -> Int -> Int ++xor a0 a1 = intXor a0 a1 + + infixl 10 xor as .^. + + -- | Bitwise shift left. +-foreign import shl :: Int -> Int -> Int ++shl :: Int -> Int -> Int ++shl a0 a1 = intShl a0 a1 + + -- | Bitwise shift right. +-foreign import shr :: Int -> Int -> Int ++shr :: Int -> Int -> Int ++shr a0 a1 = intShr a0 a1 + + -- | Bitwise zero-fill shift right. +-foreign import zshr :: Int -> Int -> Int ++zshr :: Int -> Int -> Int ++zshr a0 a1 = intZshr a0 a1 + + -- | Bitwise NOT. +-foreign import complement :: Int -> Int ++complement :: Int -> Int ++complement a0 = intComplement a0 +--- purescript-integers@v6.0.0/src/Data/Int.purs ++++ stdlib/lib/Data/Int.purs +@@ -37,11 +37,8 @@ + fromNumber :: Number -> Maybe Int + fromNumber = fromNumberImpl Just Nothing + +-foreign import fromNumberImpl +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Number +- -> Maybe Int ++fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int ++fromNumberImpl a0 a1 a2 = fromNumberImpl a0 a1 a2 + + -- | Convert a `Number` to an `Int`, by taking the closest integer equal to or + -- | less than the argument. Values outside the `Int` range are clamped, `NaN` +@@ -78,7 +75,8 @@ + + -- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number` + -- | so there is no loss of precision with this function. +-foreign import toNumber :: Int -> Number ++toNumber :: Int -> Number ++toNumber a0 = toNumber a0 + + -- | Reads an `Int` from a `String` value. The number must parse as an integer + -- | and fall within the valid range of values for the `Int` type, otherwise +@@ -224,7 +222,8 @@ + -- | div 2 (-3) == 0 + -- | quot 2 (-3) == 0 + -- | ``` +-foreign import quot :: Int -> Int -> Int ++quot :: Int -> Int -> Int ++quot a0 a1 = quot a0 a1 + + -- | The `rem` function provides the remainder after _truncating_ integer + -- | division (see the documentation for the `EuclideanRing` class). It is +@@ -242,16 +241,15 @@ + -- | mod 2 (-3) == 2 + -- | rem 2 (-3) == 2 + -- | ``` +-foreign import rem :: Int -> Int -> Int ++rem :: Int -> Int -> Int ++rem a0 a1 = rem a0 a1 + + -- | Raise an Int to the power of another Int. +-foreign import pow :: Int -> Int -> Int +- +-foreign import fromStringAsImpl +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Radix +- -> String +- -> Maybe Int +- +-foreign import toStringAs :: Radix -> Int -> String ++pow :: Int -> Int -> Int ++pow a0 a1 = pow a0 a1 ++ ++fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int ++fromStringAsImpl a0 a1 a2 a3 = fromStringAsImpl a0 a1 a2 a3 ++ ++toStringAs :: Radix -> Int -> String ++toStringAs a0 a1 = toStringAs a0 a1 +--- purescript-lazy@v6.0.0/src/Data/Lazy.purs ++++ stdlib/lib/Data/Lazy.purs +@@ -32,10 +32,12 @@ + type role Lazy representational + + -- | Defer a computation, creating a `Lazy` value. +-foreign import defer :: forall a. (Unit -> a) -> Lazy a ++defer :: forall a. (Unit -> a) -> Lazy a ++defer a0 = defer a0 + + -- | Force evaluation of a `Lazy` value. +-foreign import force :: forall a. Lazy a -> a ++force :: forall a. Lazy a -> a ++force a0 = force a0 + + instance semiringLazy :: Semiring a => Semiring (Lazy a) where + add a b = defer \_ -> force a + force b +--- purescript-numbers@v9.0.1/src/Data/Number/Format.purs ++++ stdlib/lib/Data/Number/Format.purs +@@ -30,9 +30,12 @@ + + import Prelude + +-foreign import toPrecisionNative :: Int -> Number -> String +-foreign import toFixedNative :: Int -> Number -> String +-foreign import toExponentialNative :: Int -> Number -> String ++toPrecisionNative :: Int -> Number -> String ++toPrecisionNative a0 a1 = toPrecisionNative a0 a1 ++toFixedNative :: Int -> Number -> String ++toFixedNative a0 a1 = toFixedNative a0 a1 ++toExponentialNative :: Int -> Number -> String ++toExponentialNative a0 a1 = toExponentialNative a0 a1 + + -- | The `Format` data type specifies how a number will be formatted. + data Format +@@ -73,4 +76,5 @@ + -- | > toString 1.2e-10 + -- | "1.2e-10" + -- | ``` +-foreign import toString :: Number -> String ++toString :: Number -> String ++toString a0 = toString a0 +--- purescript-numbers@v9.0.1/src/Data/Number.purs ++++ stdlib/lib/Data/Number.purs +@@ -44,7 +44,8 @@ + -- | > nan + -- | NaN + -- | ``` +-foreign import nan :: Number ++nan :: Number ++nan = nan + + -- | Test whether a number is NaN. + -- | ```purs +@@ -54,7 +55,8 @@ + -- | > isNaN nan + -- | true + -- | ``` +-foreign import isNaN :: Number -> Boolean ++isNaN :: Number -> Boolean ++isNaN a0 = isNaN a0 + + -- | Positive infinity. For negative infinity use `(-infinity)` + -- | ```purs +@@ -64,7 +66,8 @@ + -- | > (-infinity) + -- | - Infinity + -- | ``` +-foreign import infinity :: Number ++infinity :: Number ++infinity = infinity + + -- | Test whether a number is finite. + -- | ```purs +@@ -80,7 +83,8 @@ + -- | > isFinite nan + -- | false + -- | ``` +-foreign import isFinite :: Number -> Boolean ++isFinite :: Number -> Boolean ++isFinite a0 = isFinite a0 + + -- | Attempt to parse a `Number` using JavaScripts `parseFloat`. Returns + -- | `Nothing` if the parse fails or if the result is not a finite number. +@@ -112,7 +116,8 @@ + fromString :: String -> Maybe Number + fromString str = runFn4 fromStringImpl str isFinite Just Nothing + +-foreign import fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number) ++fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number) ++fromStringImpl = fromStringImpl + + -- | Returns the absolute value of the argument. + -- | ```purs +@@ -120,28 +125,32 @@ + -- | > sign x * abs x == x + -- | true + -- | ``` +-foreign import abs :: Number -> Number ++abs :: Number -> Number ++abs a0 = abs a0 + + -- | Returns the inverse cosine in radians of the argument. + -- | ```purs + -- | > acos 0.0 == pi / 2.0 + -- | true + -- | ``` +-foreign import acos :: Number -> Number ++acos :: Number -> Number ++acos a0 = acos a0 + + -- | Returns the inverse sine in radians of the argument. + -- | ```purs + -- | > asin 1.0 == pi / 2.0 + -- | true + -- | ``` +-foreign import asin :: Number -> Number ++asin :: Number -> Number ++asin a0 = asin a0 + + -- | Returns the inverse tangent in radians of the argument. + -- | ```purs + -- | > atan 1.0 == pi / 4.0 + -- | true + -- | ``` +-foreign import atan :: Number -> Number ++atan :: Number -> Number ++atan a0 = atan a0 + + -- | Four-quadrant tangent inverse. Given the arguments `y` and `x`, returns + -- | the inverse tangent of `y / x`, where the signs of both arguments are used +@@ -154,49 +163,57 @@ + -- | > atan2 1.0 0.0 == pi / 2.0 + -- | true + -- | ``` +-foreign import atan2 :: Number -> Number -> Number ++atan2 :: Number -> Number -> Number ++atan2 a0 a1 = atan2 a0 a1 + + -- | Returns the smallest integer not smaller than the argument. + -- | ```purs + -- | > ceil 1.5 + -- | 2.0 + -- | ``` +-foreign import ceil :: Number -> Number ++ceil :: Number -> Number ++ceil a0 = ceil a0 + + -- | Returns the cosine of the argument, where the argument is in radians. + -- | ```purs + -- | > cos (pi / 4.0) == sqrt2 / 2.0 + -- | true + -- | ``` +-foreign import cos :: Number -> Number ++cos :: Number -> Number ++cos a0 = cos a0 + + -- | Returns `e` exponentiated to the power of the argument. + -- | ```purs + -- | > exp 1.0 + -- | 2.718281828459045 + -- | ``` +-foreign import exp :: Number -> Number ++exp :: Number -> Number ++exp a0 = exp a0 + + -- | Returns the largest integer not larger than the argument. + -- | ```purs + -- | > floor 1.5 + -- | 1.0 + -- | ``` +-foreign import floor :: Number -> Number ++floor :: Number -> Number ++floor a0 = floor a0 + + -- | Returns the natural logarithm of a number. + -- | ```purs + -- | > log e + -- | 1.0 +-foreign import log :: Number -> Number ++log :: Number -> Number ++log a0 = log a0 + + -- | Returns the largest of two numbers. Unlike `max` in Data.Ord this version + -- | returns NaN if either argument is NaN. +-foreign import max :: Number -> Number -> Number ++max :: Number -> Number -> Number ++max a0 a1 = max a0 a1 + + -- | Returns the smallest of two numbers. Unlike `min` in Data.Ord this version + -- | returns NaN if either argument is NaN. +-foreign import min :: Number -> Number -> Number ++min :: Number -> Number -> Number ++min a0 a1 = min a0 a1 + + -- | Return the first argument exponentiated to the power of the second argument. + -- | ```purs +@@ -206,14 +223,16 @@ + -- | true + -- | ``` + +-foreign import pow :: Number -> Number -> Number ++pow :: Number -> Number -> Number ++pow a0 a1 = pow a0 a1 + + -- | Computes the remainder after division. This is the same as JavaScript's `%` operator. + -- ```purs + -- > 5.3 % 2.0 + -- 1.2999999999999998 + -- ``` +-foreign import remainder :: Number -> Number -> Number ++remainder :: Number -> Number -> Number ++remainder a0 a1 = remainder a0 a1 + + infixl 7 remainder as % + +@@ -222,7 +241,8 @@ + -- | > round 1.5 + -- | 2.0 + -- | ``` +-foreign import round :: Number -> Number ++round :: Number -> Number ++round a0 = round a0 + + -- | Returns either a positive or negative +/- 1, indicating the sign of the + -- | argument. If the argument is 0, it will return a +/- 0. If the argument is +@@ -232,28 +252,32 @@ + -- | > sign x * abs x == x + -- | true + -- | ``` +-foreign import sign :: Number -> Number ++sign :: Number -> Number ++sign a0 = sign a0 + + -- | Returns the sine of the argument, where the argument is in radians. + -- | ```purs + -- | > sin (pi / 2.0) + -- | 1.0 + -- | ``` +-foreign import sin :: Number -> Number ++sin :: Number -> Number ++sin a0 = sin a0 + + -- | Returns the square root of the argument. + -- | ```purs + -- | > sqrt 49.0 + -- | 7.0 + -- | ``` +-foreign import sqrt :: Number -> Number ++sqrt :: Number -> Number ++sqrt a0 = sqrt a0 + + -- | Returns the tangent of the argument, where the argument is in radians. + -- | ``` + -- | > tan (pi / 4.0) + -- | 0.9999999999999999 + -- | ``` +-foreign import tan :: Number -> Number ++tan :: Number -> Number ++tan a0 = tan a0 + + -- | Truncates the decimal portion of a number. Equivalent to `floor` if the + -- | number is positive, and `ceil` if the number is negative. +@@ -261,7 +285,8 @@ + -- | ceil 1.5 + -- | 2.0 + -- | ``` +-foreign import trunc :: Number -> Number ++trunc :: Number -> Number ++trunc a0 = trunc a0 + + -- | The base of the natural logarithm, also known as Euler's number or *e*. + -- | ```purs +--- purescript-prelude@v6.0.1/src/Data/Ord.purs ++++ stdlib/lib/Data/Ord.purs +@@ -49,19 +49,19 @@ + compare :: a -> a -> Ordering + + instance ordBoolean :: Ord Boolean where +- compare = ordBooleanImpl LT EQ GT ++ compare x y = ordBooleanImpl LT EQ GT x y + + instance ordInt :: Ord Int where +- compare = ordIntImpl LT EQ GT ++ compare x y = ordIntImpl LT EQ GT x y + + instance ordNumber :: Ord Number where +- compare = ordNumberImpl LT EQ GT ++ compare x y = ordNumberImpl LT EQ GT x y + + instance ordString :: Ord String where +- compare = ordStringImpl LT EQ GT ++ compare x y = ordStringImpl LT EQ GT x y + + instance ordChar :: Ord Char where +- compare = ordCharImpl LT EQ GT ++ compare x y = ordCharImpl LT EQ GT x y + + instance ordUnit :: Ord Unit where + compare _ _ = EQ +@@ -81,47 +81,46 @@ + LT -> 1 + GT -> -1 + +-foreign import ordBooleanImpl +- :: Ordering +- -> Ordering +- -> Ordering +- -> Boolean +- -> Boolean +- -> Ordering +- +-foreign import ordIntImpl +- :: Ordering +- -> Ordering +- -> Ordering +- -> Int +- -> Int +- -> Ordering +- +-foreign import ordNumberImpl +- :: Ordering +- -> Ordering +- -> Ordering +- -> Number +- -> Number +- -> Ordering +- +-foreign import ordStringImpl +- :: Ordering +- -> Ordering +- -> Ordering +- -> String +- -> String +- -> Ordering +- +-foreign import ordCharImpl +- :: Ordering +- -> Ordering +- -> Ordering +- -> Char +- -> Char +- -> Ordering +- +-foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int ++ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering ++ordBooleanImpl a0 a1 a2 a3 a4 = if booleanEq a3 a4 then a1 else if a3 then a2 else a0 ++ ++ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering ++ordIntImpl a0 a1 a2 a3 a4 = if intLt a3 a4 then a0 else if intEq a3 a4 then a1 else a2 ++ ++ordNumberImpl :: Ordering -> Ordering -> Ordering -> Number -> Number -> Ordering ++ordNumberImpl a0 a1 a2 a3 a4 = if numberLt a3 a4 then a0 else if numberEq a3 a4 then a1 else a2 ++ ++ordStringImpl :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering ++ordStringImpl a0 a1 a2 a3 a4 = ordBytes a0 a1 a2 (stringToBytes a3) (stringToBytes a4) 0 ++ ++ordBytes :: forall a. a -> a -> a -> Array Int -> Array Int -> Int -> a ++ordBytes lt eq gt xs ys index = ++ if intGe index (arrayLength xs) then ++ if intEq (arrayLength xs) (arrayLength ys) then eq ++ else if intGt (arrayLength xs) (arrayLength ys) then gt ++ else lt ++ else if intGe index (arrayLength ys) then gt ++ else if intLt (arrayIndex xs index) (arrayIndex ys index) then lt ++ else if intEq (arrayIndex xs index) (arrayIndex ys index) then ordBytes lt eq gt xs ys (intAdd index 1) ++ else gt ++ ++ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering ++ordCharImpl a0 a1 a2 a3 a4 = if charLt a3 a4 then a0 else if charEq a3 a4 then a1 else a2 ++ ++ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int ++ordArrayImpl a0 a1 a2 = ordArrayFrom a0 a1 a2 0 ++ ++ordArrayFrom :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int -> Int ++ordArrayFrom compareOne xs ys index = ++ if intLt index (arrayLength xs) then ++ if intLt index (arrayLength ys) then ++ let ++ order = compareOne (arrayIndex xs index) (arrayIndex ys index) ++ in ++ if intEq order 0 then ordArrayFrom compareOne xs ys (intAdd index 1) else order ++ else intNeg 1 ++ else if intEq (arrayLength xs) (arrayLength ys) then 0 ++ else 1 + + instance ordOrdering :: Ord Ordering where + compare LT LT = EQ +--- purescript-prelude@v6.0.1/src/Data/Reflectable.purs ++++ stdlib/lib/Data/Reflectable.purs +@@ -33,7 +33,8 @@ + instance Reifiable String + + -- local definition for use in `reifyType` +-foreign import unsafeCoerce :: forall a b. a -> b ++unsafeCoerce :: forall a b. a -> b ++unsafeCoerce a0 = unsafeCoerce a0 + + -- | Reify a value of type `t` such that it can be consumed by a + -- | function constrained by the `Reflectable` type class. For +--- purescript-prelude@v6.0.1/src/Data/Ring/Generic.purs ++++ stdlib/lib/Data/Ring/Generic.purs +@@ -21,4 +21,4 @@ + + -- | A `Generic` implementation of the `sub` member from the `Ring` type class. + genericSub :: forall a rep. Generic a rep => GenericRing rep => a -> a -> a +-genericSub x y = to $ from x `genericSub'` from y +\ No newline at end of file ++genericSub x y = to $ from x `genericSub'` from y +--- purescript-prelude@v6.0.1/src/Data/Ring.purs ++++ stdlib/lib/Data/Ring.purs +@@ -30,10 +30,10 @@ + infixl 6 sub as - + + instance ringInt :: Ring Int where +- sub = intSub ++ sub x y = intSub x y + + instance ringNumber :: Ring Number where +- sub = numSub ++ sub x y = numSub x y + + instance ringUnit :: Ring Unit where + sub _ _ = unit +@@ -51,8 +51,9 @@ + negate :: forall a. Ring a => a -> a + negate a = zero - a + +-foreign import intSub :: Int -> Int -> Int +-foreign import numSub :: Number -> Number -> Number ++ ++numSub :: Number -> Number -> Number ++numSub a0 a1 = numberSub a0 a1 + + -- | A class for records where all fields have `Ring` instances, used to + -- | implement the `Ring` instance for records. +--- purescript-prelude@v6.0.1/src/Data/Semigroup.purs ++++ stdlib/lib/Data/Semigroup.purs +@@ -37,7 +37,7 @@ + infixr 5 append as <> + + instance semigroupString :: Semigroup String where +- append = concatString ++ append x y = concatString x y + + instance semigroupUnit :: Semigroup Unit where + append _ _ = unit +@@ -49,7 +49,7 @@ + append f g x = f x <> g x + + instance semigroupArray :: Semigroup (Array a) where +- append = concatArray ++ append x y = concatArray x y + + instance semigroupProxy :: Semigroup (Proxy a) where + append _ _ = Proxy +@@ -57,8 +57,10 @@ + instance semigroupRecord :: (RL.RowToList row list, SemigroupRecord list row row) => Semigroup (Record row) where + append = appendRecord (Proxy :: Proxy list) + +-foreign import concatString :: String -> String -> String +-foreign import concatArray :: forall a. Array a -> Array a -> Array a ++concatString :: String -> String -> String ++concatString a0 a1 = bytesToString (arrayAppend (stringToBytes a0) (stringToBytes a1)) ++concatArray :: forall a. Array a -> Array a -> Array a ++concatArray a0 a1 = arrayAppend a0 a1 + + -- | A class for records where all fields have `Semigroup` instances, used to + -- | implement the `Semigroup` instance for records. +--- purescript-prelude@v6.0.1/src/Data/Semiring/Generic.purs ++++ stdlib/lib/Data/Semiring/Generic.purs +@@ -48,4 +48,4 @@ + + -- | A `Generic` implementation of the `mul` member from the `Semiring` type class. + genericMul :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a +-genericMul x y = to $ from x `genericMul'` from y +\ No newline at end of file ++genericMul x y = to $ from x `genericMul'` from y +--- purescript-prelude@v6.0.1/src/Data/Semiring.purs ++++ stdlib/lib/Data/Semiring.purs +@@ -51,15 +51,15 @@ + infixl 7 mul as * + + instance semiringInt :: Semiring Int where +- add = intAdd ++ add x y = intAdd x y + zero = 0 +- mul = intMul ++ mul x y = intMul x y + one = 1 + + instance semiringNumber :: Semiring Number where +- add = numAdd ++ add x y = numAdd x y + zero = 0.0 +- mul = numMul ++ mul x y = numMul x y + one = 1.0 + + instance semiringFn :: Semiring b => Semiring (a -> b) where +@@ -86,10 +86,12 @@ + one = oneRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + zero = zeroRecord (Proxy :: Proxy list) (Proxy :: Proxy row) + +-foreign import intAdd :: Int -> Int -> Int +-foreign import intMul :: Int -> Int -> Int +-foreign import numAdd :: Number -> Number -> Number +-foreign import numMul :: Number -> Number -> Number ++ ++ ++numAdd :: Number -> Number -> Number ++numAdd a0 a1 = numberAdd a0 a1 ++numMul :: Number -> Number -> Number ++numMul a0 a1 = numberMul a0 a1 + + -- | A class for records where all fields have `Semiring` instances, used to + -- | implement the `Semiring` instance for records. +--- purescript-prelude@v6.0.1/src/Data/Show/Generic.purs ++++ stdlib/lib/Data/Show/Generic.purs +@@ -54,4 +54,11 @@ + genericShow :: forall a rep. Generic a rep => GenericShow rep => a -> String + genericShow x = genericShow' (from x) + +-foreign import intercalate :: String -> Array String -> String ++intercalate :: String -> Array String -> String ++intercalate a0 a1 = intercalateFrom a0 a1 0 ++ ++intercalateFrom :: String -> Array String -> Int -> String ++intercalateFrom separator values index = ++ if intGe index (arrayLength values) then "" ++ else if intEq index 0 then arrayIndex values index <> intercalateFrom separator values (intAdd index 1) ++ else separator <> arrayIndex values index <> intercalateFrom separator values (intAdd index 1) +--- purescript-prelude@v6.0.1/src/Data/Show.purs ++++ stdlib/lib/Data/Show.purs +@@ -1,97 +1,280 @@ ++-- | The `Show` class. ++-- | ++-- | `show` renders a value as text. The `Int`, `Number`, `Boolean`, `Char`, ++-- | `String`, `Unit`, and `Array` instances are the ones the corpus actually ++-- | applies `show` to. `Show Unit` lives here; `Data.Unit` only re-exports the ++-- | builtin. A record instance is not here because `reflectSymbol` has no ++-- | runtime. ++-- | ++-- | `Boolean`, `Int`, `Char`, `String`, `Unit`, and `Array` match the official ++-- | spelling, including the `Char`/`String` escapes. `Number` uses the same ++-- | shape as the official instance — decimal digits, `.0` on an integer token, ++-- | scientific form outside `(1e-6, 1e21)` — but the digits come from the ++-- | numeric primitives, not from a correctly rounded ECMAScript conversion. ++-- | Integers whose absolute value is below `1e21`, powers of ten, and the ++-- | dyadic fractions the digit loop reaches exactly match; other fractions ++-- | print a deterministic expansion that can differ from `purs`. + module Data.Show + ( class Show + , show +- , class ShowRecordFields +- , showRecordFields + ) where + + import Data.Semigroup ((<>)) +-import Data.Symbol (class IsSymbol, reflectSymbol) +-import Data.Unit (Unit) +-import Data.Void (Void, absurd) +-import Prim.Row (class Nub) +-import Prim.RowList as RL +-import Record.Unsafe (unsafeGet) +-import Type.Proxy (Proxy(..)) +- +--- | The `Show` type class represents those types which can be converted into +--- | a human-readable `String` representation. +--- | +--- | While not required, it is recommended that for any expression `x`, the +--- | string `show x` be executable PureScript code which evaluates to the same +--- | value as the expression `x`. ++ ++-- | A type that can be rendered as text. + class Show a where + show :: a -> String + ++instance showBoolean :: Show Boolean where ++ show value = if value then "true" else "false" ++ ++instance showInt :: Show Int where ++ show value = ++ if intEq value minInt then "-2147483648" ++ else if intLt value 0 then "-" <> showPositiveInt (intNeg value) ++ else showPositiveInt value ++ ++instance showNumber :: Show Number where ++ show value = ++ if numberNe value value then "NaN" ++ else if numberEq value positiveInfinity then "Infinity" ++ else if numberEq value negativeInfinity then "-Infinity" ++ else if numberLt value 0.0 then "-" <> showPositiveNumber (numberNeg value) ++ else showPositiveNumber value ++ ++instance showChar :: Show Char where ++ show value = "'" <> escapeCode (charToInt value) false false <> "'" ++ ++instance showString :: Show String where ++ show value = "\"" <> escapeBytes (stringToBytes value) 0 <> "\"" ++ + instance showUnit :: Show Unit where + show _ = "unit" + +-instance showBoolean :: Show Boolean where +- show true = "true" +- show false = "false" +- +-instance showInt :: Show Int where +- show = showIntImpl +- +-instance showNumber :: Show Number where +- show = showNumberImpl +- +-instance showChar :: Show Char where +- show = showCharImpl +- +-instance showString :: Show String where +- show = showStringImpl +- + instance showArray :: Show a => Show (Array a) where +- show = showArrayImpl show +- +-instance showProxy :: Show (Proxy a) where +- show _ = "Proxy" +- +-instance showVoid :: Show Void where +- show = absurd +- +-instance showRecord :: +- ( Nub rs rs +- , RL.RowToList rs ls +- , ShowRecordFields ls rs +- ) => +- Show (Record rs) where +- show record = "{" <> showRecordFields (Proxy :: Proxy ls) record <> "}" +- +--- | A class for records where all fields have `Show` instances, used to +--- | implement the `Show` instance for records. +-class ShowRecordFields :: RL.RowList Type -> Row Type -> Constraint +-class ShowRecordFields rowlist row where +- showRecordFields :: Proxy rowlist -> Record row -> String +- +-instance showRecordFieldsNil :: ShowRecordFields RL.Nil row where +- showRecordFields _ _ = "" +-else +-instance showRecordFieldsConsNil :: +- ( IsSymbol key +- , Show focus +- ) => +- ShowRecordFields (RL.Cons key focus RL.Nil) row where +- showRecordFields _ record = " " <> key <> ": " <> show focus <> " " +- where +- key = reflectSymbol (Proxy :: Proxy key) +- focus = unsafeGet key record :: focus +-else +-instance showRecordFieldsCons :: +- ( IsSymbol key +- , ShowRecordFields rowlistTail row +- , Show focus +- ) => +- ShowRecordFields (RL.Cons key focus rowlistTail) row where +- showRecordFields _ record = " " <> key <> ": " <> show focus <> "," <> tail +- where +- key = reflectSymbol (Proxy :: Proxy key) +- focus = unsafeGet key record :: focus +- tail = showRecordFields (Proxy :: Proxy rowlistTail) record +- +-foreign import showIntImpl :: Int -> String +-foreign import showNumberImpl :: Number -> String +-foreign import showCharImpl :: Char -> String +-foreign import showStringImpl :: String -> String +-foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String ++ show value = "[" <> showElements value 0 <> "]" ++ ++minInt :: Int ++minInt = intSub (intSub 0 2147483647) 1 ++ ++positiveInfinity :: Number ++positiveInfinity = numberDiv 1.0 0.0 ++ ++negativeInfinity :: Number ++negativeInfinity = numberDiv (numberNeg 1.0) 0.0 ++ ++showPositiveInt :: Int -> String ++showPositiveInt value = ++ if intLt value 10 then digit value ++ else showPositiveInt (intDiv value 10) <> digit (intMod value 10) ++ ++digit :: Int -> String ++digit value = bytesToString [intAdd 48 value] ++ ++-- | A non-negative `Number`. Integers below `1e21` print as decimal digits ++-- | plus `.0`. Smaller magnitudes print as a fixed expansion. The rest use ++-- | scientific form, which is what the official `Show Number` does past ++-- | those thresholds. ++showPositiveNumber :: Number -> String ++showPositiveNumber value = ++ if numberEq value 0.0 then "0.0" ++ else if numberGe value 1.0e21 then showScientific value ++ else if numberLt value 1.0e-6 then showScientific value ++ else if numberEq value (floorNumber value) then showIntegerNumber value <> ".0" ++ else showMixed value ++ ++showMixed :: Number -> String ++showMixed value = ++ let ++ whole = floorNumber value ++ fraction = numberSub value whole ++ wholeText = if numberEq whole 0.0 then "0" else showIntegerNumber whole ++ fractionText = digitsToString (trimZeros (collectFraction fraction 17 [])) 0 ++ in ++ if intEq (arrayLength (stringToBytes fractionText)) 0 then wholeText <> ".0" ++ else wholeText <> "." <> fractionText ++ ++showScientific :: Number -> String ++showScientific value = ++ let ++ exponent = powerOfTen value 0 ++ mantissa = scaleToUnit value exponent ++ in ++ showMantissa mantissa <> showExponent exponent ++ ++showMantissa :: Number -> String ++showMantissa value = ++ let ++ whole = numberToInt (floorNumber value) ++ fraction = numberSub value (intToNumber whole) ++ fractionText = digitsToString (trimZeros (collectFraction fraction 17 [])) 0 ++ in ++ if intEq (arrayLength (stringToBytes fractionText)) 0 then showPositiveInt whole ++ else showPositiveInt whole <> "." <> fractionText ++ ++showExponent :: Int -> String ++showExponent value = ++ if intLt value 0 then "e-" <> showPositiveInt (intNeg value) ++ else "e+" <> showPositiveInt value ++ ++powerOfTen :: Number -> Int -> Int ++powerOfTen value exponent = ++ if numberEq value 0.0 then exponent ++ else if numberGe value 10.0 then powerOfTen (numberDiv value 10.0) (intAdd exponent 1) ++ else if numberLt value 1.0 then powerOfTen (numberMul value 10.0) (intSub exponent 1) ++ else exponent ++ ++scaleToUnit :: Number -> Int -> Number ++scaleToUnit value exponent = ++ if intEq exponent 0 then value ++ else if intGt exponent 0 then scaleToUnit (numberDiv value 10.0) (intSub exponent 1) ++ else scaleToUnit (numberMul value 10.0) (intAdd exponent 1) ++ ++-- | Floor of a non-negative number. Groups of nine digits stay inside `Int`, ++-- | so a value past `2^31` still floors without a wider primitive. ++floorNumber :: Number -> Number ++floorNumber value = ++ if numberLt value 1000000000.0 then intToNumber (numberToInt value) ++ else ++ let ++ billions = floorNumber (numberDiv value 1000000000.0) ++ base = numberMul billions 1000000000.0 ++ low = numberToInt (numberSub value base) ++ in ++ numberAdd base (intToNumber low) ++ ++showIntegerNumber :: Number -> String ++showIntegerNumber value = ++ if numberLt value 1000000000.0 then showPositiveInt (numberToInt value) ++ else ++ let ++ billions = floorNumber (numberDiv value 1000000000.0) ++ base = numberMul billions 1000000000.0 ++ low = numberToInt (numberSub value base) ++ in ++ showIntegerNumber billions <> pad9 low ++ ++pad9 :: Int -> String ++pad9 value = ++ if intLt value 10 then "00000000" <> showPositiveInt value ++ else if intLt value 100 then "0000000" <> showPositiveInt value ++ else if intLt value 1000 then "000000" <> showPositiveInt value ++ else if intLt value 10000 then "00000" <> showPositiveInt value ++ else if intLt value 100000 then "0000" <> showPositiveInt value ++ else if intLt value 1000000 then "000" <> showPositiveInt value ++ else if intLt value 10000000 then "00" <> showPositiveInt value ++ else if intLt value 100000000 then "0" <> showPositiveInt value ++ else showPositiveInt value ++ ++collectFraction :: Number -> Int -> Array Int -> Array Int ++collectFraction fraction remaining digits = ++ if intEq remaining 0 then digits ++ else if numberEq fraction 0.0 then digits ++ else ++ let ++ scaled = numberMul fraction 10.0 ++ digitValue = numberToInt scaled ++ rest = numberSub scaled (intToNumber digitValue) ++ in ++ collectFraction rest (intSub remaining 1) (arrayAppend digits [digitValue]) ++ ++trimZeros :: Array Int -> Array Int ++trimZeros digits = ++ let ++ length = arrayLength digits ++ in ++ if intEq length 0 then digits ++ else if intEq (arrayIndex digits (intSub length 1)) 0 then trimZeros (takePrefix digits (intSub length 1)) ++ else digits ++ ++takePrefix :: Array Int -> Int -> Array Int ++takePrefix digits count = copyPrefix digits count 0 ++ ++copyPrefix :: Array Int -> Int -> Int -> Array Int ++copyPrefix digits count index = ++ if intGe index count then [] ++ else arrayAppend [arrayIndex digits index] (copyPrefix digits count (intAdd index 1)) ++ ++digitsToString :: Array Int -> Int -> String ++digitsToString digits index = ++ if intGe index (arrayLength digits) then "" ++ else digit (arrayIndex digits index) <> digitsToString digits (intAdd index 1) ++ ++showElements :: forall a. Show a => Array a -> Int -> String ++showElements values index = ++ if intGe index (arrayLength values) then "" ++ else if intEq index 0 then show (arrayIndex values index) <> showElements values (intAdd index 1) ++ else "," <> show (arrayIndex values index) <> showElements values (intAdd index 1) ++ ++-- | The body of a `Char` or `String` escape, without the surrounding quotes. ++-- | `ampersand` is true when a numeric escape must not swallow a following ++-- | digit, which is the official `\&` rule. ++escapeCode :: Int -> Boolean -> Boolean -> String ++escapeCode code ampersand inString = ++ if intEq code 7 then "\\a" ++ else if intEq code 8 then "\\b" ++ else if intEq code 12 then "\\f" ++ else if intEq code 10 then "\\n" ++ else if intEq code 13 then "\\r" ++ else if intEq code 9 then "\\t" ++ else if intEq code 11 then "\\v" ++ else if intLt code 32 then "\\" <> showPositiveInt code <> emptyAmpersand ampersand ++ else if intEq code 127 then "\\127" <> emptyAmpersand ampersand ++ else if intEq code 92 then "\\\\" ++ else if intEq code 34 then if inString then "\\\"" else utf8 code ++ else if intEq code 39 then if inString then utf8 code else "\\'" ++ else utf8 code ++ ++emptyAmpersand :: Boolean -> String ++emptyAmpersand needed = if needed then "\\&" else "" ++ ++escapeBytes :: Array Int -> Int -> String ++escapeBytes bytes index = ++ if intGe index (arrayLength bytes) then "" ++ else ++ let ++ decoded = decode bytes index ++ code = arrayIndex decoded 0 ++ next = arrayIndex decoded 1 ++ in ++ escapeCode code (nextIsDigit bytes next) true <> escapeBytes bytes next ++ ++nextIsDigit :: Array Int -> Int -> Boolean ++nextIsDigit bytes index = ++ if intGe index (arrayLength bytes) then false ++ else ++ let ++ code = arrayIndex (decode bytes index) 0 ++ in ++ if intLt code 48 then false else intLe code 57 ++ ++-- | One Unicode scalar and the index of the byte after it. The bytes are ++-- | well-formed UTF-8 because they came from `stringToBytes`. ++decode :: Array Int -> Int -> Array Int ++decode bytes index = ++ let ++ first = arrayIndex bytes index ++ in ++ if intLt first 128 then [first, intAdd index 1] ++ else if intLt first 224 then ++ [ intAdd (intShl (intAnd first 31) 6) (continuation bytes (intAdd index 1)) ++ , intAdd index 2 ++ ] ++ else if intLt first 240 then ++ [ intAdd (intAdd (intShl (intAnd first 15) 12) (intShl (continuation bytes (intAdd index 1)) 6)) (continuation bytes (intAdd index 2)) ++ , intAdd index 3 ++ ] ++ else ++ [ intAdd (intAdd (intAdd (intShl (intAnd first 7) 18) (intShl (continuation bytes (intAdd index 1)) 12)) (intShl (continuation bytes (intAdd index 2)) 6)) (continuation bytes (intAdd index 3)) ++ , intAdd index 4 ++ ] ++ ++continuation :: Array Int -> Int -> Int ++continuation bytes index = intAnd (arrayIndex bytes index) 63 ++ ++utf8 :: Int -> String ++utf8 code = ++ if intLt code 128 then bytesToString [code] ++ else if intLt code 2048 then bytesToString [intOr 192 (intShr code 6), intOr 128 (intAnd code 63)] ++ else if intLt code 65536 then bytesToString [intOr 224 (intShr code 12), intOr 128 (intAnd (intShr code 6) 63), intOr 128 (intAnd code 63)] ++ else bytesToString [intOr 240 (intShr code 18), intOr 128 (intAnd (intShr code 12) 63), intOr 128 (intAnd (intShr code 6) 63), intOr 128 (intAnd code 63)] +--- purescript-strings@v6.0.1/src/Data/String/CodePoints.purs ++++ stdlib/lib/Data/String/CodePoints.purs +@@ -88,10 +88,8 @@ + singleton :: CodePoint -> String + singleton = _singleton singletonFallback + +-foreign import _singleton +- :: (CodePoint -> String) +- -> CodePoint +- -> String ++_singleton :: (CodePoint -> String) -> CodePoint -> String ++_singleton a0 a1 = _singleton a0 a1 + + singletonFallback :: CodePoint -> String + singletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp +@@ -114,10 +112,8 @@ + fromCodePointArray :: Array CodePoint -> String + fromCodePointArray = _fromCodePointArray singletonFallback + +-foreign import _fromCodePointArray +- :: (CodePoint -> String) +- -> Array CodePoint +- -> String ++_fromCodePointArray :: (CodePoint -> String) -> Array CodePoint -> String ++_fromCodePointArray a0 a1 = _fromCodePointArray a0 a1 + + -- | Creates an array of code points from a string. Operates in space and time + -- | linear to the length of the string. +@@ -133,11 +129,8 @@ + toCodePointArray :: String -> Array CodePoint + toCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0 + +-foreign import _toCodePointArray +- :: (String -> Array CodePoint) +- -> (String -> CodePoint) +- -> String +- -> Array CodePoint ++_toCodePointArray :: (String -> Array CodePoint) -> (String -> CodePoint) -> String -> Array CodePoint ++_toCodePointArray a0 a1 a2 = _toCodePointArray a0 a1 a2 + + toCodePointArrayFallback :: String -> Array CodePoint + toCodePointArrayFallback s = unfoldr unconsButWithTuple s +@@ -163,14 +156,8 @@ + codePointAt 0 s = Just (unsafeCodePointAt0 s) + codePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s + +-foreign import _codePointAt +- :: (Int -> String -> Maybe CodePoint) +- -> (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> (String -> CodePoint) +- -> Int +- -> String +- -> Maybe CodePoint ++_codePointAt :: (Int -> String -> Maybe CodePoint) -> (forall a. a -> Maybe a) -> (forall a. Maybe a) -> (String -> CodePoint) -> Int -> String -> Maybe CodePoint ++_codePointAt a0 a1 a2 a3 a4 a5 = _codePointAt a0 a1 a2 a3 a4 a5 + + codePointAtFallback :: Int -> String -> Maybe CodePoint + codePointAtFallback n s = case uncons s of +@@ -227,12 +214,8 @@ + countPrefix :: (CodePoint -> Boolean) -> String -> Int + countPrefix = _countPrefix countFallback unsafeCodePointAt0 + +-foreign import _countPrefix +- :: ((CodePoint -> Boolean) -> String -> Int) +- -> (String -> CodePoint) +- -> (CodePoint -> Boolean) +- -> String +- -> Int ++_countPrefix :: ((CodePoint -> Boolean) -> String -> Int) -> (String -> CodePoint) -> (CodePoint -> Boolean) -> String -> Int ++_countPrefix a0 a1 a2 a3 = _countPrefix a0 a1 a2 a3 + + countFallback :: (CodePoint -> Boolean) -> String -> Int + countFallback p s = countTail p s 0 +@@ -328,7 +311,8 @@ + take :: Int -> String -> String + take = _take takeFallback + +-foreign import _take :: (Int -> String -> String) -> Int -> String -> String ++_take :: (Int -> String -> String) -> Int -> String -> String ++_take a0 a1 a2 = _take a0 a1 a2 + + takeFallback :: Int -> String -> String + takeFallback n _ | n < 1 = "" +@@ -418,10 +402,8 @@ + unsafeCodePointAt0 :: String -> CodePoint + unsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback + +-foreign import _unsafeCodePointAt0 +- :: (String -> CodePoint) +- -> String +- -> CodePoint ++_unsafeCodePointAt0 :: (String -> CodePoint) -> String -> CodePoint ++_unsafeCodePointAt0 a0 a1 = _unsafeCodePointAt0 a0 a1 + + unsafeCodePointAt0Fallback :: String -> CodePoint + unsafeCodePointAt0Fallback s = +--- purescript-strings@v6.0.1/src/Data/String/CodeUnits.purs ++++ stdlib/lib/Data/String/CodeUnits.purs +@@ -80,21 +80,24 @@ + -- | singleton 'l' == "l" + -- | ``` + -- | +-foreign import singleton :: Char -> String ++singleton :: Char -> String ++singleton a0 = singleton a0 + + -- | Converts an array of characters into a string. + -- | + -- | ```purescript + -- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == "Hello" + -- | ``` +-foreign import fromCharArray :: Array Char -> String ++fromCharArray :: Array Char -> String ++fromCharArray a0 = fromCharArray a0 + + -- | Converts the string into an array of characters. + -- | + -- | ```purescript + -- | toCharArray "Hello☺\n" == ['H','e','l','l','o','☺','\n'] + -- | ``` +-foreign import toCharArray :: String -> Array Char ++toCharArray :: String -> Array Char ++toCharArray a0 = toCharArray a0 + + -- | Returns the character at the given index, if the index is within bounds. + -- | +@@ -106,12 +109,8 @@ + charAt :: Int -> String -> Maybe Char + charAt = _charAt Just Nothing + +-foreign import _charAt +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Int +- -> String +- -> Maybe Char ++_charAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Int -> String -> Maybe Char ++_charAt a0 a1 a2 a3 = _charAt a0 a1 a2 a3 + + -- | Converts the string to a character, if the length of the string is + -- | exactly `1`. +@@ -123,11 +122,8 @@ + toChar :: String -> Maybe Char + toChar = _toChar Just Nothing + +-foreign import _toChar +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> String +- -> Maybe Char ++_toChar :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> String -> Maybe Char ++_toChar a0 a1 a2 = _toChar a0 a1 a2 + + -- | Returns the first character and the rest of the string, + -- | if the string is not empty. +@@ -147,7 +143,8 @@ + -- | length "Hello World" == 11 + -- | ``` + -- | +-foreign import length :: String -> Int ++length :: String -> Int ++length a0 = length a0 + + -- | Returns the number of contiguous characters at the beginning + -- | of the string for which the predicate holds. +@@ -156,7 +153,8 @@ + -- | countPrefix (_ /= ' ') "Hello World" == 5 -- since length "Hello" == 5 + -- | ``` + -- | +-foreign import countPrefix :: (Char -> Boolean) -> String -> Int ++countPrefix :: (Char -> Boolean) -> String -> Int ++countPrefix a0 a1 = countPrefix a0 a1 + + -- | Returns the index of the first occurrence of the pattern in the + -- | given string. Returns `Nothing` if there is no match. +@@ -169,12 +167,8 @@ + indexOf :: Pattern -> String -> Maybe Int + indexOf = _indexOf Just Nothing + +-foreign import _indexOf +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Pattern +- -> String +- -> Maybe Int ++_indexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int ++_indexOf a0 a1 a2 a3 = _indexOf a0 a1 a2 a3 + + -- | Returns the index of the first occurrence of the pattern in the + -- | given string, starting at the specified index. Returns `Nothing` if there is +@@ -188,13 +182,8 @@ + indexOf' :: Pattern -> Int -> String -> Maybe Int + indexOf' = _indexOfStartingAt Just Nothing + +-foreign import _indexOfStartingAt +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Pattern +- -> Int +- -> String +- -> Maybe Int ++_indexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int ++_indexOfStartingAt a0 a1 a2 a3 a4 = _indexOfStartingAt a0 a1 a2 a3 a4 + + -- | Returns the index of the last occurrence of the pattern in the + -- | given string. Returns `Nothing` if there is no match. +@@ -207,12 +196,8 @@ + lastIndexOf :: Pattern -> String -> Maybe Int + lastIndexOf = _lastIndexOf Just Nothing + +-foreign import _lastIndexOf +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Pattern +- -> String +- -> Maybe Int ++_lastIndexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int ++_lastIndexOf a0 a1 a2 a3 = _lastIndexOf a0 a1 a2 a3 + + -- | Returns the index of the last occurrence of the pattern in the + -- | given string, starting at the specified index and searching +@@ -235,13 +220,8 @@ + lastIndexOf' :: Pattern -> Int -> String -> Maybe Int + lastIndexOf' = _lastIndexOfStartingAt Just Nothing + +-foreign import _lastIndexOfStartingAt +- :: (forall a. a -> Maybe a) +- -> (forall a. Maybe a) +- -> Pattern +- -> Int +- -> String +- -> Maybe Int ++_lastIndexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int ++_lastIndexOfStartingAt a0 a1 a2 a3 a4 = _lastIndexOfStartingAt a0 a1 a2 a3 a4 + + -- | Returns the first `n` characters of the string. + -- | +@@ -249,7 +229,8 @@ + -- | take 5 "Hello World" == "Hello" + -- | ``` + -- | +-foreign import take :: Int -> String -> String ++take :: Int -> String -> String ++take a0 a1 = take a0 a1 + + -- | Returns the last `n` characters of the string. + -- | +@@ -276,7 +257,8 @@ + -- | drop 6 "Hello World" == "World" + -- | ``` + -- | +-foreign import drop :: Int -> String -> String ++drop :: Int -> String -> String ++drop a0 a1 = drop a0 a1 + + -- | Returns the string without the last `n` characters. + -- | +@@ -308,7 +290,8 @@ + -- | slice (-4) (-1) "purescript" == "rip" + -- | slice (-4) 3 "purescript" == "" + -- | ``` +-foreign import slice :: Int -> Int -> String -> String ++slice :: Int -> Int -> String -> String ++slice a0 a1 a2 = slice a0 a1 a2 + + -- | Splits a string into two substrings, where `before` contains the + -- | characters up to (but not including) the given index, and `after` contains +@@ -329,4 +312,5 @@ + -- | (splitAt i s).before <> (splitAt i s).after == s + -- | splitAt i s == {before: take i s, after: drop i s} + -- | ``` +-foreign import splitAt :: Int -> String -> { before :: String, after :: String } ++splitAt :: Int -> String -> { before :: String, after :: String } ++splitAt a0 a1 = splitAt a0 a1 +--- purescript-strings@v6.0.1/src/Data/String/Common.purs ++++ stdlib/lib/Data/String/Common.purs +@@ -34,27 +34,24 @@ + localeCompare :: String -> String -> Ordering + localeCompare = _localeCompare LT EQ GT + +-foreign import _localeCompare +- :: Ordering +- -> Ordering +- -> Ordering +- -> String +- -> String +- -> Ordering ++_localeCompare :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering ++_localeCompare a0 a1 a2 a3 a4 = _localeCompare a0 a1 a2 a3 a4 + + -- | Replaces the first occurence of the pattern with the replacement string. + -- | + -- | ```purescript + -- | replace (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b <= c" + -- | ``` +-foreign import replace :: Pattern -> Replacement -> String -> String ++replace :: Pattern -> Replacement -> String -> String ++replace a0 a1 a2 = replace a0 a1 a2 + + -- | Replaces all occurences of the pattern with the replacement string. + -- | + -- | ```purescript + -- | replaceAll (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b ≤ c" + -- | ``` +-foreign import replaceAll :: Pattern -> Replacement -> String -> String ++replaceAll :: Pattern -> Replacement -> String -> String ++replaceAll a0 a1 a2 = replaceAll a0 a1 a2 + + -- | Returns the substrings of the second string separated along occurences + -- | of the first string. +@@ -62,21 +59,24 @@ + -- | ```purescript + -- | split (Pattern " ") "hello world" == ["hello", "world"] + -- | ``` +-foreign import split :: Pattern -> String -> Array String ++split :: Pattern -> String -> Array String ++split a0 a1 = split a0 a1 + + -- | Returns the argument converted to lowercase. + -- | + -- | ```purescript + -- | toLower "hElLo" == "hello" + -- | ``` +-foreign import toLower :: String -> String ++toLower :: String -> String ++toLower a0 = toLower a0 + + -- | Returns the argument converted to uppercase. + -- | + -- | ```purescript + -- | toUpper "Hello" == "HELLO" + -- | ``` +-foreign import toUpper :: String -> String ++toUpper :: String -> String ++toUpper a0 = toUpper a0 + + -- | Removes whitespace from the beginning and end of a string, including + -- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2) +@@ -85,7 +85,8 @@ + -- | ```purescript + -- | trim " Hello \n World\n\t " == "Hello \n World" + -- | ``` +-foreign import trim :: String -> String ++trim :: String -> String ++trim a0 = trim a0 + + -- | Joins the strings in the array together, inserting the first argument + -- | as separator between them. +@@ -93,4 +94,5 @@ + -- | ```purescript + -- | joinWith ", " ["apple", "banana", "orange"] == "apple, banana, orange" + -- | ``` +-foreign import joinWith :: String -> Array String -> String ++joinWith :: String -> Array String -> String ++joinWith a0 a1 = joinWith a0 a1 +--- purescript-strings@v6.0.1/src/Data/String/Regex.purs ++++ stdlib/lib/Data/String/Regex.purs +@@ -28,17 +28,14 @@ + -- | Wraps Javascript `RegExp` objects. + foreign import data Regex :: Type + +-foreign import showRegexImpl :: Regex -> String ++showRegexImpl :: Regex -> String ++showRegexImpl a0 = showRegexImpl a0 + + instance showRegex :: Show Regex where + show = showRegexImpl + +-foreign import regexImpl +- :: (String -> Either String Regex) +- -> (Regex -> Either String Regex) +- -> String +- -> String +- -> Either String Regex ++regexImpl :: (String -> Either String Regex) -> (Regex -> Either String Regex) -> String -> String -> Either String Regex ++regexImpl a0 a1 a2 a3 = regexImpl a0 a1 a2 a3 + + -- | Constructs a `Regex` from a pattern string and flags. Fails with + -- | `Left error` if the pattern contains a syntax error. +@@ -46,14 +43,16 @@ + regex s f = regexImpl Left Right s $ renderFlags f + + -- | Returns the pattern string used to construct the given `Regex`. +-foreign import source :: Regex -> String ++source :: Regex -> String ++source a0 = source a0 + + -- | Returns the `RegexFlags` used to construct the given `Regex`. + flags :: Regex -> RegexFlags + flags = RegexFlags <<< flagsImpl + + -- | Returns the `RegexFlags` inner record used to construct the given `Regex`. +-foreign import flagsImpl :: Regex -> RegexFlagsRec ++flagsImpl :: Regex -> RegexFlagsRec ++flagsImpl a0 = flagsImpl a0 + + -- | Returns the string representation of the given `RegexFlags`. + renderFlags :: RegexFlags -> String +@@ -79,14 +78,11 @@ + -- | Returns `true` if the `Regex` matches the string. In contrast to + -- | `RegExp.prototype.test()` in JavaScript, `test` does not affect + -- | the `lastIndex` property of the Regex. +-foreign import test :: Regex -> String -> Boolean ++test :: Regex -> String -> Boolean ++test a0 a1 = test a0 a1 + +-foreign import _match +- :: (forall r. r -> Maybe r) +- -> (forall r. Maybe r) +- -> Regex +- -> String +- -> Maybe (NonEmptyArray (Maybe String)) ++_match :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe (NonEmptyArray (Maybe String)) ++_match a0 a1 a2 a3 = _match a0 a1 a2 a3 + + -- | Matches the string against the `Regex` and returns an array of matches + -- | if there were any. Each match has type `Maybe String`, where `Nothing` +@@ -98,15 +94,11 @@ + -- | Replaces occurrences of the `Regex` with the first string. The replacement + -- | string can include special replacement patterns escaped with `"$"`. + -- | See [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/replace). +-foreign import replace :: Regex -> String -> String -> String ++replace :: Regex -> String -> String -> String ++replace a0 a1 a2 = replace a0 a1 a2 + +-foreign import _replaceBy +- :: (forall r. r -> Maybe r) +- -> (forall r. Maybe r) +- -> Regex +- -> (String -> Array (Maybe String) -> String) +- -> String +- -> String ++_replaceBy :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> (String -> Array (Maybe String) -> String) -> String -> String ++_replaceBy a0 a1 a2 a3 a4 = _replaceBy a0 a1 a2 a3 a4 + + -- | Transforms occurrences of the `Regex` using a function of the matched + -- | substring and a list of captured substrings of type `Maybe String`, +@@ -115,12 +107,8 @@ + replace' :: Regex -> (String -> Array (Maybe String) -> String) -> String -> String + replace' = _replaceBy Just Nothing + +-foreign import _search +- :: (forall r. r -> Maybe r) +- -> (forall r. Maybe r) +- -> Regex +- -> String +- -> Maybe Int ++_search :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe Int ++_search a0 a1 a2 a3 = _search a0 a1 a2 a3 + + -- | Returns `Just` the index of the first match of the `Regex` in the string, + -- | or `Nothing` if there is no match. +@@ -128,4 +116,5 @@ + search = _search Just Nothing + + -- | Split the string into an array of substrings along occurrences of the `Regex`. +-foreign import split :: Regex -> String -> Array String ++split :: Regex -> String -> Array String ++split a0 a1 = split a0 a1 +--- purescript-strings@v6.0.1/src/Data/String/Unsafe.purs ++++ stdlib/lib/Data/String/Unsafe.purs +@@ -7,9 +7,11 @@ + -- | Returns the character at the given index. + -- | + -- | **Unsafe:** throws runtime exception if the index is out of bounds. +-foreign import charAt :: Int -> String -> Char ++charAt :: Int -> String -> Char ++charAt a0 a1 = charAt a0 a1 + + -- | Converts a string of length `1` to a character. + -- | + -- | **Unsafe:** throws runtime exception if length is not `1`. +-foreign import char :: String -> Char ++char :: String -> Char ++char a0 = char a0 +--- purescript-prelude@v6.0.1/src/Data/Symbol.purs ++++ stdlib/lib/Data/Symbol.purs +@@ -11,7 +11,8 @@ + reflectSymbol :: Proxy sym -> String + + -- local definition for use in `reifySymbol` +-foreign import unsafeCoerce :: forall a b. a -> b ++unsafeCoerce :: forall a b. a -> b ++unsafeCoerce a0 = unsafeCoerce a0 + + reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r + reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy +--- purescript-foldable-traversable@v6.0.0/src/Data/Traversable.purs ++++ stdlib/lib/Data/Traversable.purs +@@ -103,14 +103,8 @@ + traverse = traverseArrayImpl apply map pure + sequence = sequenceDefault + +-foreign import traverseArrayImpl +- :: forall m a b +- . (forall x y. m (x -> y) -> m x -> m y) +- -> (forall x y. (x -> y) -> m x -> m y) +- -> (forall x. x -> m x) +- -> (a -> m b) +- -> Array a +- -> m (Array b) ++traverseArrayImpl :: forall m a b . (forall x y. m (x -> y) -> m x -> m y) -> (forall x y. (x -> y) -> m x -> m y) -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b) ++traverseArrayImpl a0 a1 a2 a3 a4 = traverseArrayImpl a0 a1 a2 a3 a4 + + instance traversableMaybe :: Traversable Maybe where + traverse _ Nothing = pure Nothing +--- purescript-tuples@v7.0.0/src/Data/Tuple.purs ++++ stdlib/lib/Data/Tuple.purs +@@ -1,135 +1,47 @@ +--- | A data type and functions for working with ordered pairs. +-module Data.Tuple where ++-- | A strict product of two values. Native tuple syntax remains a closed ++-- | record, while this library type provides the constructor used by the core ++-- | libraries. WIT tuples continue to map to closed records as specified by ++-- | DEC-13. ++module Data.Tuple ++ ( Tuple(..) ++ , fst ++ , snd ++ , curry ++ , uncurry ++ , swap ++ ) where + +-import Prelude ++import Data.Eq (class Eq) ++import Data.Functor (class Functor) ++import Data.Ord (class Ord) ++import Data.Show (class Show, show) ++import Data.Semigroup ((<>)) + +-import Control.Comonad (class Comonad) +-import Control.Extend (class Extend) +-import Control.Lazy (class Lazy, defer) +-import Data.Eq (class Eq1) +-import Data.Functor.Invariant (class Invariant, imapF) +-import Data.Generic.Rep (class Generic) +-import Data.HeytingAlgebra (implies, ff, tt) +-import Data.Ord (class Ord1) +- +--- | A simple product type for wrapping a pair of component values. + data Tuple a b = Tuple a b + +--- | Allows `Tuple`s to be rendered as a string with `show` whenever there are +--- | `Show` instances for both component types. +-instance showTuple :: (Show a, Show b) => Show (Tuple a b) where +- show (Tuple a b) = "(Tuple " <> show a <> " " <> show b <> ")" +- +--- | Allows `Tuple`s to be checked for equality with `==` and `/=` whenever +--- | there are `Eq` instances for both component types. + derive instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b) +- +-derive instance eq1Tuple :: Eq a => Eq1 (Tuple a) +- +--- | Allows `Tuple`s to be compared with `compare`, `>`, `>=`, `<` and `<=` +--- | whenever there are `Ord` instances for both component types. To obtain +--- | the result, the `fst`s are `compare`d, and if they are `EQ`ual, the +--- | `snd`s are `compare`d. + derive instance ordTuple :: (Ord a, Ord b) => Ord (Tuple a b) +- +-derive instance ord1Tuple :: Ord a => Ord1 (Tuple a) +- +-instance boundedTuple :: (Bounded a, Bounded b) => Bounded (Tuple a b) where +- top = Tuple top top +- bottom = Tuple bottom bottom +- +-instance semigroupoidTuple :: Semigroupoid Tuple where +- compose (Tuple _ c) (Tuple a _) = Tuple a c +- +--- | The `Semigroup` instance enables use of the associative operator `<>` on +--- | `Tuple`s whenever there are `Semigroup` instances for the component +--- | types. The `<>` operator is applied pairwise, so: +--- | ```purescript +--- | (Tuple a1 b1) <> (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2) +--- | ``` +-instance semigroupTuple :: (Semigroup a, Semigroup b) => Semigroup (Tuple a b) where +- append (Tuple a1 b1) (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2) +- +-instance monoidTuple :: (Monoid a, Monoid b) => Monoid (Tuple a b) where +- mempty = Tuple mempty mempty +- +-instance semiringTuple :: (Semiring a, Semiring b) => Semiring (Tuple a b) where +- add (Tuple x1 y1) (Tuple x2 y2) = Tuple (add x1 x2) (add y1 y2) +- one = Tuple one one +- mul (Tuple x1 y1) (Tuple x2 y2) = Tuple (mul x1 x2) (mul y1 y2) +- zero = Tuple zero zero +- +-instance ringTuple :: (Ring a, Ring b) => Ring (Tuple a b) where +- sub (Tuple x1 y1) (Tuple x2 y2) = Tuple (sub x1 x2) (sub y1 y2) +- +-instance commutativeRingTuple :: (CommutativeRing a, CommutativeRing b) => CommutativeRing (Tuple a b) +- +-instance heytingAlgebraTuple :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAlgebra (Tuple a b) where +- tt = Tuple tt tt +- ff = Tuple ff ff +- implies (Tuple x1 y1) (Tuple x2 y2) = Tuple (x1 `implies` x2) (y1 `implies` y2) +- conj (Tuple x1 y1) (Tuple x2 y2) = Tuple (conj x1 x2) (conj y1 y2) +- disj (Tuple x1 y1) (Tuple x2 y2) = Tuple (disj x1 x2) (disj y1 y2) +- not (Tuple x y) = Tuple (not x) (not y) +- +-instance booleanAlgebraTuple :: (BooleanAlgebra a, BooleanAlgebra b) => BooleanAlgebra (Tuple a b) +- +--- | The `Functor` instance allows functions to transform the contents of a +--- | `Tuple` with the `<$>` operator, applying the function to the second +--- | component, so: +--- | ```purescript +--- | f <$> (Tuple x y) = Tuple x (f y) +--- | ```` + derive instance functorTuple :: Functor (Tuple a) + +-derive instance genericTuple :: Generic (Tuple a b) _ ++instance showTuple :: (Show a, Show b) => Show (Tuple a b) where ++ show (Tuple first second) = "(Tuple " <> show first <> " " <> show second <> ")" + +-instance invariantTuple :: Invariant (Tuple a) where +- imap = imapF ++-- | The first component. `fst (Tuple x y)` is `x`. ++fst :: forall a b. Tuple a b -> a ++fst (Tuple first _) = first + +--- | The `Apply` instance allows functions to transform the contents of a +--- | `Tuple` with the `<*>` operator whenever there is a `Semigroup` instance +--- | for the `fst` component, so: +--- | ```purescript +--- | (Tuple a1 f) <*> (Tuple a2 x) == Tuple (a1 <> a2) (f x) +--- | ``` +-instance applyTuple :: (Semigroup a) => Apply (Tuple a) where +- apply (Tuple a1 f) (Tuple a2 x) = Tuple (a1 <> a2) (f x) ++-- | The second component. `snd (Tuple x y)` is `y`. ++snd :: forall a b. Tuple a b -> b ++snd (Tuple _ second) = second + +-instance applicativeTuple :: (Monoid a) => Applicative (Tuple a) where +- pure = Tuple mempty ++-- | Turns a function of a pair into a function of two arguments. ++curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c ++curry f x y = f (Tuple x y) + +-instance bindTuple :: (Semigroup a) => Bind (Tuple a) where +- bind (Tuple a1 b) f = case f b of +- Tuple a2 c -> Tuple (a1 <> a2) c ++-- | Turns a function of two arguments into a function of a pair. ++uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c ++uncurry f (Tuple first second) = f first second + +-instance monadTuple :: (Monoid a) => Monad (Tuple a) +- +-instance extendTuple :: Extend (Tuple a) where +- extend f t@(Tuple a _) = Tuple a (f t) +- +-instance comonadTuple :: Comonad (Tuple a) where +- extract = snd +- +-instance lazyTuple :: (Lazy a, Lazy b) => Lazy (Tuple a b) where +- defer f = Tuple (defer $ \_ -> fst (f unit)) (defer $ \_ -> snd (f unit)) +- +--- | Returns the first component of a tuple. +-fst :: forall a b. Tuple a b -> a +-fst (Tuple a _) = a +- +--- | Returns the second component of a tuple. +-snd :: forall a b. Tuple a b -> b +-snd (Tuple _ b) = b +- +--- | Turn a function that expects a tuple into a function of two arguments. +-curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c +-curry f a b = f (Tuple a b) +- +--- | Turn a function of two arguments into a function that expects a tuple. +-uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c +-uncurry f (Tuple a b) = f a b +- +--- | Exchange the first and second components of a tuple. ++-- | Exchanges the two components. + swap :: forall a b. Tuple a b -> Tuple b a +-swap (Tuple a b) = Tuple b a ++swap (Tuple first second) = Tuple second first +--- purescript-unfoldable@v6.0.0/src/Data/Unfoldable.purs ++++ stdlib/lib/Data/Unfoldable.purs +@@ -44,15 +44,8 @@ + instance unfoldableMaybe :: Unfoldable Maybe where + unfoldr f b = fst <$> f b + +-foreign import unfoldrArrayImpl +- :: forall a b +- . (forall x. Maybe x -> Boolean) +- -> (forall x. Maybe x -> x) +- -> (forall x y. Tuple x y -> x) +- -> (forall x y. Tuple x y -> y) +- -> (b -> Maybe (Tuple a b)) +- -> b +- -> Array a ++unfoldrArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Maybe (Tuple a b)) -> b -> Array a ++unfoldrArrayImpl a0 a1 a2 a3 a4 a5 = unfoldrArrayImpl a0 a1 a2 a3 a4 a5 + + -- | Replicate a value some natural number of times. + -- | For example: +--- purescript-unfoldable@v6.0.0/src/Data/Unfoldable1.purs ++++ stdlib/lib/Data/Unfoldable1.purs +@@ -45,15 +45,8 @@ + instance unfoldable1Maybe :: Unfoldable1 Maybe where + unfoldr1 f b = Just (fst (f b)) + +-foreign import unfoldr1ArrayImpl +- :: forall a b +- . (forall x. Maybe x -> Boolean) +- -> (forall x. Maybe x -> x) +- -> (forall x y. Tuple x y -> x) +- -> (forall x y. Tuple x y -> y) +- -> (b -> Tuple a (Maybe b)) +- -> b +- -> Array a ++unfoldr1ArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Tuple a (Maybe b)) -> b -> Array a ++unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 = unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 + + -- | Replicate a value `n` times. At least one value will be produced, so values + -- | `n` less than 1 will be treated as 1. +--- purescript-prelude@v6.0.1/src/Data/Unit.purs ++++ stdlib/lib/Data/Unit.purs +@@ -1,14 +1,5 @@ +-module Data.Unit where +- +--- | The `Unit` type has a single inhabitant, called `unit`. It represents +--- | values with no computational content. +--- | +--- | `Unit` is often used, wrapped in a monadic type constructor, as the +--- | return type of a computation where only the _effects_ are important. +--- | +--- | When returning a value of type `Unit` from an FFI function, it is +--- | recommended to use `undefined`, or not return a value at all. +-foreign import data Unit :: Type +- +--- | `unit` is the sole inhabitant of the `Unit` type. +-foreign import unit :: Unit ++-- | `Unit` is a compiler builtin, the same type as an unqualified ++-- | `Unit`. This module re-exports that builtin and the `unit` ++-- | primitive so `import Data.Unit` matches the official library ++-- | without declaring a second unit type. ++module Data.Unit (Unit, unit) where +--- purescript-console@v6.0.0/src/Effect/Console.purs ++++ stdlib/lib/Effect/Console.purs +@@ -1,68 +1,23 @@ +-module Effect.Console where ++-- | The corpus's console surface, a thin binding over the platform layer ++-- | `WASI.Console` ++-- | ([DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md)). ++-- | ++-- | Nothing here chooses a stream or performs a write: `log` and `error` are the ++-- | platform functions under their corpus names, and `warn` is the platform's. ++-- | That keeps one place that decides where output goes, rather than a ++-- | wrapper that could drift from it. ++-- | ++-- | `logShow` adds no I/O of its own: it is `log` of `Data.Show.show`, so the ++-- | rendering is the library's `Show` and the destination is still the one ++-- | `WASI.Console.log` decides. It is a wrapper like `log`, not a second ++-- | stringifier. ++module Effect.Console (log, warn, error, logShow) where + +-import Effect (Effect) ++import Prelude ++import WASI.Console (error, log, warn) ++import Data.Show (class Show, show) + +-import Data.Show (class Show, show) +-import Data.Unit (Unit) +- +--- | Write a message to the console. +-foreign import log +- :: String +- -> Effect Unit +- +--- | Write a value to the console, using its `Show` instance to produce a +--- | `String`. ++-- | Writes the `Show` rendering of a value. `log` already writes the newline, ++-- | so this is `log` composed with the library's `show`. + logShow :: forall a. Show a => a -> Effect Unit +-logShow a = log (show a) +- +--- | Write an warning to the console. +-foreign import warn +- :: String +- -> Effect Unit +- +--- | Write an warning value to the console, using its `Show` instance to produce +--- | a `String`. +-warnShow :: forall a. Show a => a -> Effect Unit +-warnShow a = warn (show a) +- +--- | Write an error to the console. +-foreign import error +- :: String +- -> Effect Unit +- +--- | Write an error value to the console, using its `Show` instance to produce a +--- | `String`. +-errorShow :: forall a. Show a => a -> Effect Unit +-errorShow a = error (show a) +- +--- | Write an info message to the console. +-foreign import info +- :: String +- -> Effect Unit +- +--- | Write an info value to the console, using its `Show` instance to produce a +--- | `String`. +-infoShow :: forall a. Show a => a -> Effect Unit +-infoShow a = info (show a) +- +--- | Write an debug message to the console. +-foreign import debug +- :: String +- -> Effect Unit +- +--- | Write an debug value to the console, using its `Show` instance to produce a +--- | `String`. +-debugShow :: forall a. Show a => a -> Effect Unit +-debugShow a = debug (show a) +- +--- | Start a named timer. +-foreign import time :: String -> Effect Unit +- +--- | Print the time since a named timer started in milliseconds. +-foreign import timeLog :: String -> Effect Unit +- +--- | Stop a named timer and print time since it started in milliseconds. +-foreign import timeEnd :: String -> Effect Unit +- +--- | Clears the console +-foreign import clear :: Effect Unit ++logShow value = log (show value) +--- purescript-refs@v6.0.0/src/Effect/Ref.purs ++++ stdlib/lib/Effect/Ref.purs +@@ -41,24 +41,28 @@ + type role Ref representational + + -- | Create a new mutable reference containing the specified value. +-foreign import _new :: forall s. s -> Effect (Ref s) ++_new :: forall s. s -> Effect (Ref s) ++_new a0 = _new a0 + + new :: forall s. s -> Effect (Ref s) + new = _new + + -- | Create a new mutable reference containing a value that can refer to the + -- | `Ref` being created. +-foreign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s) ++newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s) ++newWithSelf a0 = newWithSelf a0 + + -- | Read the current value of a mutable reference. +-foreign import read :: forall s. Ref s -> Effect s ++read :: forall s. Ref s -> Effect s ++read a0 = read a0 + + -- | Update the value of a mutable reference by applying a function + -- | to the current value. + modify' :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b + modify' = modifyImpl + +-foreign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b ++modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b ++modifyImpl a0 a1 = modifyImpl a0 a1 + + -- | Update the value of a mutable reference by applying a function + -- | to the current value. The updated value is returned. +@@ -70,4 +74,5 @@ + modify_ f s = void $ modify f s + + -- | Update the value of a mutable reference to the specified value. +-foreign import write :: forall s. s -> Ref s -> Effect Unit ++write :: forall s. s -> Ref s -> Effect Unit ++write a0 a1 = write a0 a1 +--- purescript-effect@v4.0.0/src/Effect.purs ++++ stdlib/lib/Effect.purs +@@ -1,72 +1,29 @@ +--- | This module provides the `Effect` type, which is used to represent +--- | _native_ effects. The `Effect` type provides a typed API for effectful +--- | computations, while at the same time generating efficient JavaScript. ++-- | The `Effect` monad: the corpus-facing name for the abstract effect ++-- | interface this compiler already has. ++-- | ++-- | The operations themselves are anchored in `Prelude` rather than here, and ++-- | that is deliberate rather than an oversight. Two pieces of the compiler key ++-- | on that module by name: `check_run_effect_scope` resolves the trusted ++-- | `Prelude.runEffect` value, and `psrs_core::effect::operations` synthesizes ++-- | `pure`, `bind`, and `run` from the externals declared there. Moving the ++-- | foreign imports into this module would move the entry point with them. ++-- | ++-- | So this module is the public surface the corpus imports, and `Prelude` ++-- | remains the owner of the primitive interface. The dependency runs one way: ++-- | `Effect` imports `Prelude`, never the reverse. + module Effect + ( Effect +- , untilE, whileE, forE, foreachE ++ , pure ++ , bind ++ , discard ++ , map ++ , apply ++ , untilE + ) where + +-import Prelude ++import Prelude (Effect, apply, bind, discard, map, pure) + +-import Control.Apply (lift2) +- +--- | A native effect. The type parameter denotes the return type of running the +--- | effect, that is, an `Effect Int` is a possibly-effectful computation which +--- | eventually produces a value of the type `Int` when it finishes. +-foreign import data Effect :: Type -> Type +- +-type role Effect representational +- +-instance functorEffect :: Functor Effect where +- map = liftA1 +- +-instance applyEffect :: Apply Effect where +- apply = ap +- +-instance applicativeEffect :: Applicative Effect where +- pure = pureE +- +-foreign import pureE :: forall a. a -> Effect a +- +-instance bindEffect :: Bind Effect where +- bind = bindE +- +-foreign import bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b +- +-instance monadEffect :: Monad Effect +- +--- | The `Semigroup` instance for effects allows you to run two effects, one +--- | after the other, and then combine their results using the result type's +--- | `Semigroup` instance. +-instance semigroupEffect :: Semigroup a => Semigroup (Effect a) where +- append = lift2 append +- +--- | If you have a `Monoid a` instance, then `mempty :: Effect a` is defined as +--- | `pure mempty`. +-instance monoidEffect :: Monoid a => Monoid (Effect a) where +- mempty = pureE mempty +- +--- | Loop until a condition becomes `true`. +--- | +--- | `untilE b` is an effectful computation which repeatedly runs the effectful +--- | computation `b`, until its return value is `true`. +-foreign import untilE :: Effect Boolean -> Effect Unit +- +--- | Loop while a condition is `true`. +--- | +--- | `whileE b m` is effectful computation which runs the effectful computation +--- | `b`. If its result is `true`, it runs the effectful computation `m` and +--- | loops. If not, the computation ends. +-foreign import whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit +- +--- | Loop over a consecutive collection of numbers. +--- | +--- | `forE lo hi f` runs the computation returned by the function `f` for each +--- | of the inputs between `lo` (inclusive) and `hi` (exclusive). +-foreign import forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit +- +--- | Loop over an array of values. +--- | +--- | `foreachE xs f` runs the computation returned by the function `f` for each +--- | of the inputs `xs`. +-foreign import foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit ++-- | Repeats an effect until it returns `true`. ++untilE :: Effect Boolean -> Effect Unit ++untilE action = bind action \done -> ++ if done then pure unit else untilE action +--- purescript-partial@v4.0.0/src/Partial/Unsafe.purs ++++ stdlib/lib/Partial/Unsafe.purs +@@ -13,7 +13,8 @@ + -- either a dependency or reimplementing it here. + -- Rather than doing that, we'll use a type signature + -- of `a -> b` instead. +-foreign import _unsafePartial :: forall a b. a -> b ++_unsafePartial :: forall a b. a -> b ++_unsafePartial a0 = _unsafePartial a0 + + -- | Discharge a partiality constraint, unsafely. + unsafePartial :: forall a. (Partial => a) -> a +--- purescript-partial@v4.0.0/src/Partial.purs ++++ stdlib/lib/Partial.purs +@@ -12,4 +12,5 @@ + crashWith :: forall a. Partial => String -> a + crashWith = _crashWith + +-foreign import _crashWith :: forall a. String -> a ++_crashWith :: forall a. String -> a ++_crashWith a0 = _crashWith a0 +--- purescript-prelude@v6.0.1/src/Prelude.purs ++++ stdlib/lib/Prelude.purs +@@ -1,17 +1,20 @@ +--- | `Prelude` is a module that re-exports many other foundational modules from the `purescript-prelude` library +--- | (e.g. the Monad type class hierarchy, the Monoid type classes, Eq, Ord, etc.). ++-- | The primitive surface the rest of the library and the corpus build on. + -- | +--- | Typically, this module will be imported in most other libraries and projects as an open import. ++-- | The class hierarchy is the official `purescript-prelude` v6.0.1 re-export ++-- | list. `Effect` stays in this module: `check_run_effect_scope` resolves ++-- | `Prelude.runEffect`, and `psrs_core::effect::operations` synthesizes ++-- | `effectPure`, `effectBind`, `runEffect`, and `trap` from the `psrs:effect` ++-- | bindings declared here. The class methods `pure` and `bind` are the ++-- | official `Applicative` and `Bind` methods; the `Effect` instances call ++-- | those bindings, so creating an action still does not run it. + -- | +--- | ``` +--- | module MyModule where +--- | +--- | import Prelude -- open import +--- | +--- | import Data.Maybe (Maybe(..)) -- closed import +--- | ``` ++-- | `unit` is not declared here. `Unit` is a builtin, re-exported through ++-- | `Data.Unit`, and the one `Unit` value is `Intrinsic::Unit`. + module Prelude +- ( module Control.Applicative ++ ( Effect ++ , runEffect ++ , trap ++ , module Control.Applicative + , module Control.Apply + , module Control.Bind + , module Control.Category +@@ -68,3 +71,34 @@ + import Data.Show (class Show, show) + import Data.Unit (Unit, unit) + import Data.Void (Void, absurd) ++ ++foreign import data Effect :: Type -> Type ++ ++-- | Builds an `Effect` that returns `value`. Lowering replaces this binding; ++-- | the `Applicative` instance is what user code calls `pure`. ++foreign import "psrs:effect#pure" effectPure :: forall a. a -> Effect a ++ ++-- | Sequences two effects. The `Bind` instance is what user code calls `bind`. ++foreign import "psrs:effect#bind" effectBind :: forall a b. Effect a -> (a -> Effect b) -> Effect b ++ ++foreign import "psrs:effect#run" runEffect :: forall a. Effect a -> a ++ ++-- | The effect that escapes instead of returning. An uncaught failure on this ++-- | target is a guest trap, so this is the one operation whose result never ++-- | exists; it is how a library reports an assertion that did not hold. ++foreign import "psrs:effect#trap" trap :: Effect Unit ++ ++instance functorEffect :: Functor Effect where ++ map f action = bind action (\value -> pure (f value)) ++ ++instance applyEffect :: Apply Effect where ++ apply wrapped action = ++ bind wrapped (\function -> bind action (\value -> pure (function value))) ++ ++instance applicativeEffect :: Applicative Effect where ++ pure value = effectPure value ++ ++instance bindEffect :: Bind Effect where ++ bind action next = effectBind action next ++ ++instance monadEffect :: Monad Effect +--- purescript-prelude@v6.0.1/src/Record/Unsafe.purs ++++ stdlib/lib/Record/Unsafe.purs +@@ -7,21 +7,25 @@ + module Record.Unsafe where + + -- | Checks if a record has a key, using a string for the key. +-foreign import unsafeHas :: forall r1. String -> Record r1 -> Boolean ++unsafeHas :: forall r1. String -> Record r1 -> Boolean ++unsafeHas a0 a1 = unsafeHas a0 a1 + + -- | Unsafely gets a value from a record, using a string for the key. + -- | + -- | If the key does not exist this will cause a runtime error elsewhere. +-foreign import unsafeGet :: forall r a. String -> Record r -> a ++unsafeGet :: forall r a. String -> Record r -> a ++unsafeGet a0 a1 = unsafeGet a0 a1 + + -- | Unsafely sets a value on a record, using a string for the key. + -- | + -- | The output record's row is unspecified so can be coerced to any row. If the + -- | output type is incorrect it will cause a runtime error elsewhere. +-foreign import unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2 ++unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2 ++unsafeSet a0 a1 a2 = unsafeSet a0 a1 a2 + + -- | Unsafely removes a value on a record, using a string for the key. + -- | + -- | The output record's row is unspecified so can be coerced to any row. If the + -- | output type is incorrect it will cause a runtime error elsewhere. +-foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2 ++unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2 ++unsafeDelete a0 a1 = unsafeDelete a0 a1 +--- purescript-assert@v6.0.0/src/Test/Assert.purs ++++ stdlib/lib/Test/Assert.purs +@@ -1,134 +1,70 @@ +-module Test.Assert +- ( assert +- , assert' +- , assertEqual +- , assertEqual' +- , assertFalse +- , assertFalse' +- , assertThrows +- , assertThrows' +- , assertTrue +- , assertTrue' +- ) where ++-- | The corpus's assertion surface: the `Test.Assert` module the `passing` ++-- | suite imports. ++-- | ++-- | A failed assertion must be visible to whatever runs the program, and this ++-- | target's only such signal is a guest trap — a non-zero exit code is a ++-- | recorded result, not a failure. So the failure path writes the message to ++-- | standard error and then escapes through `Prelude.trap` ++-- | ([DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md): the ++-- | wrapper owns the corpus name, the primitive stays in `Prelude`). ++-- | ++-- | **Deliberately absent**, with the reason recorded rather than approximated: ++-- | ++-- | - `assertEqual` and `assertEqual'` compare with `Eq` and print with `Show`. ++-- | Both classes are declared (`Data.Eq`, `Data.Show`), so the surface itself ++-- | is writable — the official signature is what this compiler cannot yet ++-- | elaborate. The corpus calls the record form ++-- | (`assertEqual' "label" { expected: e, actual: a }`), whose official type is ++-- | `forall a. Eq a => Show a => String -> { actual :: a, expected :: a } -> ++-- | Effect Unit`. A constraint whose quantified variable appears inside a ++-- | record type is elaborated with the *record* as the constraint's argument, ++-- | so `Eq a` is wanted for `{ actual :: a, expected :: a }` and the ++-- | declaration is rejected with `NoInstanceFound`. The same signature with a ++-- | type synonym for the record fails identically, so it is constraint ++-- | elaboration rather than the record syntax. Approximating the signature ++-- | would change the official API the corpus calls, so the functions stay out ++-- | until that is fixed. #137 carries the minimal reproduction and the probes ++-- | that separate this defect from record syntax. ++-- | - `assertThrows` and `assertThrows'` need to observe that evaluating an ++-- | argument failed. A trap is not observable from inside the guest without ++-- | the Wasm exceptions proposal, which is outside the target profile ++-- | ([DEC-05](../../../decision/DEC-05-wasmtime-feature-set.md)), so there is ++-- | no honest implementation to write yet. ++module Test.Assert (assert, assert', assertTrue, assertFalse) where + + import Prelude +- + import Effect (Effect) + import Effect.Console (error) + +--- | Throws a runtime exception with message "Assertion failed" when the boolean +--- | value is false. ++-- | Escapes when the boolean is false. The message is written to standard ++-- | error first, so the trap carries the diagnostic with it. ++assert' :: String -> Boolean -> Effect Unit ++assert' message condition = ++ if condition ++ then pure unit ++ else abortWith message ++ ++-- | Escapes with the default message when the boolean is false. + assert :: Boolean -> Effect Unit + assert = assert' "Assertion failed" + +--- | Throws a runtime exception with the specified message when the boolean +--- | value is false. +-assert' :: String -> Boolean -> Effect Unit +-assert' = assertImpl ++-- | Escapes unless the value is `true`, naming both values. ++assertTrue :: Boolean -> Effect Unit ++assertTrue actual = ++ if actual ++ then pure unit ++ else abortWith "Assertion failed: Expected: true\nActual: false" + +-foreign import assertImpl +- :: String +- -> Boolean +- -> Effect Unit ++-- | Escapes unless the value is `false`, naming both values. ++assertFalse :: Boolean -> Effect Unit ++assertFalse actual = ++ if actual ++ then abortWith "Assertion failed: Expected: false\nActual: true" ++ else pure unit + +--- | Throws a runtime exception with message "Assertion failed: An error should +--- | have been thrown", unless the argument throws an exception when evaluated. +--- | +--- | This function is specifically for testing unsafe pure code; for example, +--- | to make sure that an exception is thrown if a precondition is not +--- | satisfied. Functions which use `Effect a` can be +--- | tested with `catchException` instead. +-assertThrows :: forall a. (Unit -> a) -> Effect Unit +-assertThrows = +- assertThrows' "Assertion failed: An error should have been thrown" +- +--- | Throws a runtime exception with the specified message, unless the argument +--- | throws an exception when evaluated. +--- | +--- | This function is specifically for testing unsafe pure code; for example, +--- | to make sure that an exception is thrown if a precondition is not +--- | satisfied. Functions which use `Effect a` can be +--- | tested with `catchException` instead. +-assertThrows' +- :: forall a +- . String +- -> (Unit -> a) +- -> Effect Unit +-assertThrows' msg fn = assert' msg =<< checkThrows fn +- +-foreign import checkThrows +- :: forall a +- . (Unit -> a) +- -> Effect Boolean +- +--- | Compares the `expected` and `actual` values for equality and +--- | throws a runtime exception when the values are not equal. +--- | +--- | The message indicates the expected value and the actual value. +-assertEqual +- :: forall a +- . Eq a +- => Show a +- => { actual :: a, expected :: a } +- -> Effect Unit +-assertEqual = assertEqual' "" +- +--- | Compares the `expected` and `actual` values for equality and throws a +--- | runtime exception with the specified message when the values are not equal. +--- | +--- | The message also indicates the expected value and the actual value. +-assertEqual' +- :: forall a +- . Eq a +- => Show a +- => String +- -> { actual :: a, expected :: a } +- -> Effect Unit +-assertEqual' userMessage {actual, expected} = do +- unless result $ error message +- assert' message result +- where +- message = (if userMessage == "" then "" else userMessage <> "\n") +- <> "Expected: " <> show expected +- <> "\nActual: " <> show actual +- result = actual == expected +- +--- | Throws a runtime exception when the value is `false`. +--- | +--- | The message indicates the expected value (`true`) +--- | and the actual value (`false`). +-assertTrue +- :: Boolean +- -> Effect Unit +-assertTrue actual = assertEqual { actual, expected: true } +- +--- | Throws a runtime exception with the specified message when the value is +--- | `false`. +--- | +--- | The message also indicates the expected value (`true`) +--- | and the actual value (`false`). +-assertTrue' +- :: String +- -> Boolean +- -> Effect Unit +-assertTrue' message actual = assertEqual' message { actual, expected: true } +- +--- | Throws a runtime exception when the value is `true`. +--- | +--- | The message indicates the expected value (`false`) +--- | and the actual value (`true`). +-assertFalse +- :: Boolean +- -> Effect Unit +-assertFalse actual = assertEqual { actual, expected: false } +- +--- | Throws a runtime exception with the specified message when the value is +--- | `true`. +--- | +--- | The message also indicates the expected value (`false`) +--- | and the actual value (`true`). +-assertFalse' +- :: String +- -> Boolean +- -> Effect Unit +-assertFalse' message actual = assertEqual' message { actual, expected: false } ++-- | The escape itself. Kept private: a caller reports a failure by choosing the ++-- | message, not by reaching for the trap. ++abortWith :: String -> Effect Unit ++abortWith message = do ++ _ <- error message ++ trap +--- purescript-unsafe-coerce@v6.0.0/src/Unsafe/Coerce.purs ++++ stdlib/lib/Unsafe/Coerce.purs +@@ -24,4 +24,5 @@ + -- | `unsafeCoerce` can now be accomplished via `coerce` from + -- | `purescript-safe-coerce`. See that library's documentation for more + -- | context. +-foreign import unsafeCoerce :: forall a b. a -> b ++unsafeCoerce :: forall a b. a -> b ++unsafeCoerce a0 = unsafeCoerce a0 +--- purescript-effect@v4.0.0/src/Effect/Class.purs ++++ /dev/null +@@ -1,19 +0,0 @@ +-module Effect.Class where +- +-import Control.Category (identity) +-import Control.Monad (class Monad) +-import Effect (Effect) +- +--- | The `MonadEffect` class captures those monads which support native effects. +--- | +--- | Instances are provided for `Effect` itself, and the standard monad +--- | transformers. +--- | +--- | `liftEffect` can be used in any appropriate monad transformer stack to lift an +--- | action of type `Effect a` into the monad. +--- | +-class Monad m <= MonadEffect m where +- liftEffect :: forall a. Effect a -> m a +- +-instance monadEffectEffect :: MonadEffect Effect where +- liftEffect = identity +--- purescript-console@v6.0.0/src/Effect/Class/Console.purs ++++ /dev/null +@@ -1,49 +0,0 @@ +-module Effect.Class.Console where +- +-import Data.Function ((<<<)) +-import Data.Show (class Show) +-import Data.Unit (Unit) +-import Effect.Class (class MonadEffect, liftEffect) +-import Effect.Console as EffConsole +- +-log :: forall m. MonadEffect m => String -> m Unit +-log = liftEffect <<< EffConsole.log +- +-logShow :: forall m a. MonadEffect m => Show a => a -> m Unit +-logShow = liftEffect <<< EffConsole.logShow +- +-warn :: forall m. MonadEffect m => String -> m Unit +-warn = liftEffect <<< EffConsole.warn +- +-warnShow :: forall m a. MonadEffect m => Show a => a -> m Unit +-warnShow = liftEffect <<< EffConsole.warnShow +- +-error :: forall m. MonadEffect m => String -> m Unit +-error = liftEffect <<< EffConsole.error +- +-errorShow :: forall m a. MonadEffect m => Show a => a -> m Unit +-errorShow = liftEffect <<< EffConsole.errorShow +- +-info :: forall m. MonadEffect m => String -> m Unit +-info = liftEffect <<< EffConsole.info +- +-infoShow :: forall m a. MonadEffect m => Show a => a -> m Unit +-infoShow = liftEffect <<< EffConsole.infoShow +- +-debug :: forall m. MonadEffect m => String -> m Unit +-debug = liftEffect <<< EffConsole.debug +- +-debugShow :: forall m a. MonadEffect m => Show a => a -> m Unit +-debugShow = liftEffect <<< EffConsole.debugShow +- +-time :: forall m. MonadEffect m => String -> m Unit +-time = liftEffect <<< EffConsole.time +- +-timeLog :: forall m. MonadEffect m => String -> m Unit +-timeLog = liftEffect <<< EffConsole.timeLog +- +-timeEnd :: forall m. MonadEffect m => String -> m Unit +-timeEnd = liftEffect <<< EffConsole.timeEnd +- +-clear :: forall m. MonadEffect m => m Unit +-clear = liftEffect EffConsole.clear +--- purescript-effect@v4.0.0/src/Effect/Uncurried.purs ++++ /dev/null +@@ -1,286 +0,0 @@ +--- | This module defines types for effectful uncurried functions, as well as +--- | functions for converting back and forth between them. +--- | +--- | This makes it possible to give a PureScript type to JavaScript functions +--- | such as this one: +--- | +--- | ```javascript +--- | function logMessage(level, message) { +--- | console.log(level + ": " + message); +--- | } +--- | ``` +--- | +--- | In particular, note that `logMessage` performs effects immediately after +--- | receiving all of its parameters, so giving it the type `Data.Function.Fn2 +--- | String String Unit`, while convenient, would effectively be a lie. +--- | +--- | One way to handle this would be to convert the function into the normal +--- | PureScript form (namely, a curried function returning an Effect action), +--- | and performing the marshalling in JavaScript, in the FFI module, like this: +--- | +--- | ```purescript +--- | -- In the PureScript file: +--- | foreign import logMessage :: String -> String -> Effect Unit +--- | ``` +--- | +--- | ```javascript +--- | // In the FFI file: +--- | exports.logMessage = function(level) { +--- | return function(message) { +--- | return function() { +--- | logMessage(level, message); +--- | }; +--- | }; +--- | }; +--- | ``` +--- | +--- | This method, unfortunately, turns out to be both tiresome and error-prone. +--- | This module offers an alternative solution. By providing you with: +--- | +--- | * the ability to give the real `logMessage` function a PureScript type, +--- | and +--- | * functions for converting between this form and the normal PureScript +--- | form, +--- | +--- | the FFI boilerplate is no longer needed. The previous example becomes: +--- | +--- | ```purescript +--- | -- In the PureScript file: +--- | foreign import logMessageImpl :: EffectFn2 String String Unit +--- | ``` +--- | +--- | ```javascript +--- | // In the FFI file: +--- | exports.logMessageImpl = logMessage +--- | ``` +--- | +--- | You can then use `runEffectFn2` to provide a nicer version: +--- | +--- | ```purescript +--- | logMessage :: String -> String -> Effect Unit +--- | logMessage = runEffectFn2 logMessageImpl +--- | ``` +--- | +--- | (note that this has the same type as the original `logMessage`). +--- | +--- | Effectively, we have reduced the risk of errors by moving as much code into +--- | PureScript as possible, so that we can leverage the type system. Hopefully, +--- | this is a little less tiresome too. +--- | +--- | Here's a slightly more advanced example. Here, because we are using +--- | callbacks, we need to use `mkEffectFn{N}` as well. +--- | +--- | Suppose our `logMessage` changes so that it sometimes sends details of the +--- | message to some external server, and in those cases, we want the resulting +--- | `HttpResponse` (for whatever reason). +--- | +--- | ```javascript +--- | function logMessage(level, message, callback) { +--- | console.log(level + ": " + message); +--- | if (level > LogLevel.WARN) { +--- | LogAggregatorService.post("/logs", { +--- | level: level, +--- | message: message +--- | }, callback); +--- | } else { +--- | callback(null); +--- | } +--- | } +--- | ``` +--- | +--- | The import then looks like this: +--- | ```purescript +--- | foreign import logMessageImpl +--- | EffectFn3 +--- | String +--- | String +--- | (EffectFn1 (Nullable HttpResponse) Unit) +--- | Unit +--- | ``` +--- | +--- | And, as before, the FFI file is extremely simple: +--- | +--- | ```javascript +--- | exports.logMessageImpl = logMessage +--- | ``` +--- | +--- | Finally, we use `runEffectFn{N}` and `mkEffectFn{N}` for a more comfortable +--- | PureScript version: +--- | +--- | ```purescript +--- | logMessage :: +--- | String -> +--- | String -> +--- | (Nullable HttpResponse -> Effect Unit) -> +--- | Effect Unit +--- | logMessage level message callback = +--- | runEffectFn3 logMessageImpl level message (mkEffectFn1 callback) +--- | ``` +--- | +--- | The general naming scheme for functions and types in this module is as +--- | follows: +--- | +--- | * `EffectFn{N}` means, an uncurried function which accepts N arguments and +--- | performs some effects. The first N arguments are the actual function's +--- | argument. The last type argument is the return type. +--- | * `runEffectFn{N}` takes an `EffectFn` of N arguments, and converts it into +--- | the normal PureScript form: a curried function which returns an Effect +--- | action. +--- | * `mkEffectFn{N}` is the inverse of `runEffectFn{N}`. It can be useful for +--- | callbacks. +--- | +- +-module Effect.Uncurried where +- +-import Data.Monoid (class Monoid, class Semigroup, mempty, (<>)) +-import Effect (Effect) +- +-foreign import data EffectFn1 :: Type -> Type -> Type +- +-type role EffectFn1 representational representational +- +-foreign import data EffectFn2 :: Type -> Type -> Type -> Type +- +-type role EffectFn2 representational representational representational +- +-foreign import data EffectFn3 :: Type -> Type -> Type -> Type -> Type +- +-type role EffectFn3 representational representational representational representational +- +-foreign import data EffectFn4 :: Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn4 representational representational representational representational representational +- +-foreign import data EffectFn5 :: Type -> Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn5 representational representational representational representational representational representational +- +-foreign import data EffectFn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn6 representational representational representational representational representational representational representational +- +-foreign import data EffectFn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn7 representational representational representational representational representational representational representational representational +- +-foreign import data EffectFn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn8 representational representational representational representational representational representational representational representational representational +- +-foreign import data EffectFn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn9 representational representational representational representational representational representational representational representational representational representational +- +-foreign import data EffectFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type +- +-type role EffectFn10 representational representational representational representational representational representational representational representational representational representational representational +- +-foreign import mkEffectFn1 :: forall a r. +- (a -> Effect r) -> EffectFn1 a r +-foreign import mkEffectFn2 :: forall a b r. +- (a -> b -> Effect r) -> EffectFn2 a b r +-foreign import mkEffectFn3 :: forall a b c r. +- (a -> b -> c -> Effect r) -> EffectFn3 a b c r +-foreign import mkEffectFn4 :: forall a b c d r. +- (a -> b -> c -> d -> Effect r) -> EffectFn4 a b c d r +-foreign import mkEffectFn5 :: forall a b c d e r. +- (a -> b -> c -> d -> e -> Effect r) -> EffectFn5 a b c d e r +-foreign import mkEffectFn6 :: forall a b c d e f r. +- (a -> b -> c -> d -> e -> f -> Effect r) -> EffectFn6 a b c d e f r +-foreign import mkEffectFn7 :: forall a b c d e f g r. +- (a -> b -> c -> d -> e -> f -> g -> Effect r) -> EffectFn7 a b c d e f g r +-foreign import mkEffectFn8 :: forall a b c d e f g h r. +- (a -> b -> c -> d -> e -> f -> g -> h -> Effect r) -> EffectFn8 a b c d e f g h r +-foreign import mkEffectFn9 :: forall a b c d e f g h i r. +- (a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r) -> EffectFn9 a b c d e f g h i r +-foreign import mkEffectFn10 :: forall a b c d e f g h i j r. +- (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r) -> EffectFn10 a b c d e f g h i j r +- +-foreign import runEffectFn1 :: forall a r. +- EffectFn1 a r -> a -> Effect r +-foreign import runEffectFn2 :: forall a b r. +- EffectFn2 a b r -> a -> b -> Effect r +-foreign import runEffectFn3 :: forall a b c r. +- EffectFn3 a b c r -> a -> b -> c -> Effect r +-foreign import runEffectFn4 :: forall a b c d r. +- EffectFn4 a b c d r -> a -> b -> c -> d -> Effect r +-foreign import runEffectFn5 :: forall a b c d e r. +- EffectFn5 a b c d e r -> a -> b -> c -> d -> e -> Effect r +-foreign import runEffectFn6 :: forall a b c d e f r. +- EffectFn6 a b c d e f r -> a -> b -> c -> d -> e -> f -> Effect r +-foreign import runEffectFn7 :: forall a b c d e f g r. +- EffectFn7 a b c d e f g r -> a -> b -> c -> d -> e -> f -> g -> Effect r +-foreign import runEffectFn8 :: forall a b c d e f g h r. +- EffectFn8 a b c d e f g h r -> a -> b -> c -> d -> e -> f -> g -> h -> Effect r +-foreign import runEffectFn9 :: forall a b c d e f g h i r. +- EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r +-foreign import runEffectFn10 :: forall a b c d e f g h i j r. +- EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r +- +--- The reason these are written eta-expanded instead of as: +--- ``` +--- append f1 f2 = mkEffectFnN $ runEffectFnN f1 <> runEffectFnN f2 +--- ``` +--- is to help the compiler recognize that it can emit uncurried +--- JS functions (which are more efficient), when an appended +--- EffectFn is applied to all its arguments +- +-instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where +- append f1 f2 = mkEffectFn1 \a -> runEffectFn1 f1 a <> runEffectFn1 f2 a +- +-instance semigroupEffectFn2 :: Semigroup r => Semigroup (EffectFn2 a b r) where +- append f1 f2 = mkEffectFn2 \a b -> runEffectFn2 f1 a b <> runEffectFn2 f2 a b +- +-instance semigroupEffectFn3 :: Semigroup r => Semigroup (EffectFn3 a b c r) where +- append f1 f2 = mkEffectFn3 \a b c -> runEffectFn3 f1 a b c <> runEffectFn3 f2 a b c +- +-instance semigroupEffectFn4 :: Semigroup r => Semigroup (EffectFn4 a b c d r) where +- append f1 f2 = mkEffectFn4 \a b c d -> runEffectFn4 f1 a b c d <> runEffectFn4 f2 a b c d +- +-instance semigroupEffectFn5 :: Semigroup r => Semigroup (EffectFn5 a b c d e r) where +- append f1 f2 = mkEffectFn5 \a b c d e -> runEffectFn5 f1 a b c d e <> runEffectFn5 f2 a b c d e +- +-instance semigroupEffectFn6 :: Semigroup r => Semigroup (EffectFn6 a b c d e f r) where +- append f1 f2 = mkEffectFn6 \a b c d e f -> runEffectFn6 f1 a b c d e f <> runEffectFn6 f2 a b c d e f +- +-instance semigroupEffectFn7 :: Semigroup r => Semigroup (EffectFn7 a b c d e f g r) where +- append f1 f2 = mkEffectFn7 \a b c d e f g -> runEffectFn7 f1 a b c d e f g <> runEffectFn7 f2 a b c d e f g +- +-instance semigroupEffectFn8 :: Semigroup r => Semigroup (EffectFn8 a b c d e f g h r) where +- append f1 f2 = mkEffectFn8 \a b c d e f g h -> runEffectFn8 f1 a b c d e f g h <> runEffectFn8 f2 a b c d e f g h +- +-instance semigroupEffectFn9 :: Semigroup r => Semigroup (EffectFn9 a b c d e f g h i r) where +- append f1 f2 = mkEffectFn9 \a b c d e f g h i -> runEffectFn9 f1 a b c d e f g h i <> runEffectFn9 f2 a b c d e f g h i +- +-instance semigroupEffectFn10 :: Semigroup r => Semigroup (EffectFn10 a b c d e f g h i j r) where +- append f1 f2 = mkEffectFn10 \a b c d e f g h i j -> runEffectFn10 f1 a b c d e f g h i j <> runEffectFn10 f2 a b c d e f g h i j +- +-instance monoidEffectFn1 :: Monoid r => Monoid (EffectFn1 a r) where +- mempty = mkEffectFn1 \_ -> mempty +- +-instance monoidEffectFn2 :: Monoid r => Monoid (EffectFn2 a b r) where +- mempty = mkEffectFn2 \_ _ -> mempty +- +-instance monoidEffectFn3 :: Monoid r => Monoid (EffectFn3 a b c r) where +- mempty = mkEffectFn3 \_ _ _ -> mempty +- +-instance monoidEffectFn4 :: Monoid r => Monoid (EffectFn4 a b c d r) where +- mempty = mkEffectFn4 \_ _ _ _ -> mempty +- +-instance monoidEffectFn5 :: Monoid r => Monoid (EffectFn5 a b c d e r) where +- mempty = mkEffectFn5 \_ _ _ _ _ -> mempty +- +-instance monoidEffectFn6 :: Monoid r => Monoid (EffectFn6 a b c d e f r) where +- mempty = mkEffectFn6 \_ _ _ _ _ _ -> mempty +- +-instance monoidEffectFn7 :: Monoid r => Monoid (EffectFn7 a b c d e f g r) where +- mempty = mkEffectFn7 \_ _ _ _ _ _ _ -> mempty +- +-instance monoidEffectFn8 :: Monoid r => Monoid (EffectFn8 a b c d e f g h r) where +- mempty = mkEffectFn8 \_ _ _ _ _ _ _ _ -> mempty +- +-instance monoidEffectFn9 :: Monoid r => Monoid (EffectFn9 a b c d e f g h i r) where +- mempty = mkEffectFn9 \_ _ _ _ _ _ _ _ _ -> mempty +- +-instance monoidEffectFn10 :: Monoid r => Monoid (EffectFn10 a b c d e f g h i j r) where +- mempty = mkEffectFn10 \_ _ _ _ _ _ _ _ _ _ -> mempty +--- purescript-effect@v4.0.0/src/Effect/Unsafe.purs ++++ /dev/null +@@ -1,8 +0,0 @@ +-module Effect.Unsafe where +- +-import Effect (Effect) +- +--- | Run an effectful computation. +--- | +--- | *Note*: use of this function can result in arbitrary side-effects. +-foreign import unsafePerformEffect :: forall a. Effect a -> a diff --git a/docs/implementation/stdlib/vendor-audit-2026-10-06/report.md b/docs/implementation/stdlib/vendor-audit-2026-10-06/report.md new file mode 100644 index 00000000..b7447fa5 --- /dev/null +++ b/docs/implementation/stdlib/vendor-audit-2026-10-06/report.md @@ -0,0 +1,291 @@ +# Vendored standard-library source audit + +## Result and policy + +The current vendored library does **not** satisfy the policy that differences +from official PureScript libraries must be justified by the Wasm/WASI target. +There are 200 exact self-recursive placeholder definitions in 30 modules, +removed official APIs and instances, and changes to ordinary PureScript +functions made to accommodate compiler limitations. These are defects, not +accepted target adaptations. + +This audit inspects revision `67369ba` on `stdlib/vendor-core-libraries` with a +clean starting worktree. Library sources were not changed. The audit adds only +this report, its evidence, and a repeatable inventory tool. No scoreboard was +run or updated. + +The successful `/tmp/psrs-stdlib-all.purs` diagnosis establishes acceptance of +these modified sources, with `main = 0`. It does not establish acceptance of +unchanged official sources or execution correctness of the exported APIs. +Unused declarations can disappear before backend layout and execution. + +## Baselines and coverage + +The original vendoring script `/tmp/vendor_stdlib.py` names `/tmp/ps-pkgs` and +`/tmp/purescript-prelude` as inputs. Its `render_foreign` operation deliberately +replaces an unsupported value foreign import with a self-recursive equation. +Its `EXACT` list also rewrites `void`, `voidRight`, `voidLeft`, and `fold`. +Commit `0118695ffffd71200ece889cf863086955c03a64` explicitly records that value +foreign imports become intrinsics or diverging stubs. The script was inspected +without running its source-writing entry point. + +All 41 upstream checkouts are clean, at exact version tags, and have +`https://github.com/purescript/...` origin URLs. Their tags, commits, paths, +and source SHA-256 hashes are captured in [inventory.json](inventory.json). +The compiler support manifest at +`/Users/biu/Projects/purescript/tests/support/bower.json` uses dependency ranges, +not a lockfile. These tags identify the available vendoring baselines; they do +not prove a uniquely pinned dependency set for compiler version 0.15.16. +The original 38 checkouts are supplemented by official effect v4.0.0, +console v6.0.0, and assert v6.0.0, downloaded after explicit user approval. +These versions satisfy the compiler support manifest's dependency ranges; +they are explicit comparison baselines, not a recovered original lockfile. +Four upstream modules from the supplemental packages are absent from the +vendored directory and are listed below. + +| Comparison of current `.purs` modules | Count | +| --- | ---: | +| Byte-identical to the available official baseline | 149 | +| Different only in final line termination | 3 | +| Source changes requiring review | 50 | +| Wasm/WASI platform additions without an official counterpart | 9 | +| Official baseline unavailable | 0 | +| Total current vendored modules | 211 | + +The 202 compared modules come from prelude v6.0.1 and 40 other tagged packages. +The complete per-module table is [modules.md](modules.md); the unfiltered patch +is [official-vs-vendored.diff](official-vs-vendored.diff). Newline-only changes +are in Data.HeytingAlgebra.Generic, Data.Ring.Generic, and Data.Semiring.Generic. + +The initially missing baselines are now verified against both clean tagged git +checkouts and independently downloaded tagged archives. The official commits +are effect `a192ddb923027d426d6ea3d8deb030c9aa7c7dda`, console +`3b83d7b792d03872afeea5e62b4f686ab0f09842`, and assert +`27c0edb57d2ee497eb5fab664f5601c35b613eda`. All current non-WASI modules have an +official comparison baseline; no baseline remains unavailable. + +## Confirmed violations + +### Foreign declarations replaced by nontermination + +Across the compared present modules, 267 upstream value foreign declarations +have changed: 200 have exact self-recursive replacements, 40 have nonrecursive +replacement declarations, and 27 declarations have no local replacement +signature. The last category includes values now re-exported from another +module or supplied as compiler primitives; it does not mean that all 27 public +values are absent. A +nonrecursive replacement is only a syntactic classification, not a correctness +judgment. All 200 detected placeholders correspond to original foreign values. +Their names and vendored line numbers are in the inventory. The count excludes +other possible incorrect implementations or forms of nontermination. + +For example, Data.Int replaces the official `foreign import toNumber` with +`toNumber a0 = toNumber a0`. Data.Array replaces a foreign `rangeImpl` with +`rangeImpl = rangeImpl`. Similar replacements affect ST operations, reference +mutation, uncurried functions, array construction and traversal, numeric +functions, regular expressions, string operations, partiality, and reflection. +A declaration being unreachable or supplied through a compiler interface does +not make its on-disk source replacement faithful. + +| Module containing placeholders | Definitions | +| --- | ---: | +| Control.Extend | 1 | +| Control.Monad.ST.Internal | 11 | +| Control.Monad.ST.Uncurried | 20 | +| Data.Array.NonEmpty.Internal | 3 | +| Data.Array.ST.Partial | 2 | +| Data.Array.ST | 17 | +| Data.Array | 24 | +| Data.Enum | 2 | +| Data.Foldable | 2 | +| Data.Function.Uncurried | 20 | +| Data.FunctorWithIndex | 1 | +| Data.Int | 7 | +| Data.Lazy | 2 | +| Data.Number.Format | 4 | +| Data.Number | 25 | +| Data.Reflectable | 1 | +| Data.String.CodePoints | 7 | +| Data.String.CodeUnits | 15 | +| Data.String.Common | 8 | +| Data.String.Regex | 10 | +| Data.String.Unsafe | 2 | +| Data.Symbol | 1 | +| Data.Traversable | 1 | +| Data.Unfoldable | 1 | +| Data.Unfoldable1 | 1 | +| Effect.Ref | 5 | +| Partial.Unsafe | 1 | +| Partial | 1 | +| Record.Unsafe | 4 | +| Unsafe.Coerce | 1 | + +The loader excludes compiler-provided Safe.Coerce and Unsafe.Coerce source +modules, so the Unsafe.Coerce placeholder is not evidence that every ordinary +use of the compiler primitive diverges. Data.Symbol retains source ownership; +its local `unsafeCoerce` placeholder is a separate declaration from the +canonical Unsafe.Coerce compiler interface. Static IsSymbol dictionary +synthesis does not establish runtime reification through this local body. + +### Removed pure APIs and instances + +**Data.Tuple:** upstream v7.0.0 declares 24 instances; the vendored module keeps +four. It removes Eq1, Ord1, Bounded, Semigroupoid, Semigroup, Monoid, Semiring, +Ring, CommutativeRing, HeytingAlgebra, BooleanAlgebra, Generic, Invariant, Apply, +Applicative, Bind, Monad, Extend, Comonad, and Lazy instances. The ADT is already +`data Tuple a b = Tuple a b` in both sources. Distinguishing that ADT from a WIT +record tuple provides no justification for removing its ordinary instances. + +**Data.Show:** the vendored module removes the exported ShowRecordFields class +and showRecordFields method, the Show instances for Proxy, Void, and records, +and all three ShowRecordFields instances. These are pure API removals, not +UTF-8 storage adaptations. Its header explicitly acknowledges that Number +rendering can differ from official correctly rounded formatting. A Wasm +implementation of numeric/string formatting needs behavior evidence; target +storage does not justify silently narrowing the class surface or approximating +unrelated numeric behavior. + +**Test.Assert:** the exact v6.0.0 diff confirms removal of six public functions: +assertEqual, assertEqual', assertTrue', assertFalse', assertThrows, and +assertThrows'. The first four are ordinary PureScript functions with no target +implementation requirement of their own. The current source documents omission +of the equality functions because of a compiler constraint-elaboration defect; +that rationale violates the policy. Replacing JavaScript assertion exceptions +with a Wasm trap, and limitations on observing a Wasm trap inside the guest, +are target-related concerns requiring a declared contract. They do not justify +removing the comparison and message-taking Boolean assertions. + +**Effect:** the exact v4.0.0 diff confirms removal of whileE, forE, and foreachE, +plus the pure semigroupEffect and monoidEffect instances. The ordinary Effect +Functor/Apply/Applicative/Bind/Monad instances and type ownership were moved to +Prelude, and the source role declaration was removed. The target state-token +protocol can justify implementation and ownership adaptations, but not deletion +of the two pure instances or omission of the standard loop APIs. The vendor +also exports pure, bind, discard, map, and apply, which upstream Effect does not +export. These additions belong in the reviewed target-interface inventory. + +**Effect.Console:** the exact v6.0.0 diff confirms removal of ten public values: +warnShow, errorShow, info, infoShow, debug, debugShow, time, timeLog, timeEnd, and +clear. The Show wrappers are pure composition over existing console operations; +warnShow and errorShow need no new host capability. Direct writes routed through +WASI.Console are target adaptations. JavaScript console timers/clear and +severity routing need explicit target decisions; they do not justify silently +removing the pure wrappers or presenting this reduced module as the full API. + +### Whole official modules omitted + +The supplemental packages also contain these four modules, all absent from the +current vendor. The inventory records their upstream hashes and links, and the +full diff records them as removals to `/dev/null`. + +| Official module | Source contract and disposition | +| --- | --- | +| Effect.Class | Pure MonadEffect class, liftEffect method, and Effect instance. No Wasm-specific reason for omission. | +| Effect.Class.Console | Pure MonadEffect lifting wrappers for all console operations. No Wasm-specific reason for wholesale omission. | +| Effect.Uncurried | EffectFn types and mk/run conversions. Requires a target calling-convention implementation or explicit unsupported bindings. | +| Effect.Unsafe | unsafePerformEffect foreign binding. Requires the checked target Effect execution protocol or explicit unsupported status. | + +### Ordinary source functions changed for the compiler + +The original `void = map (const unit)`, `voidRight x = map (const x)`, +`voidLeft f x = const x <$> f`, and `fold = foldMap identity` have been rewritten. +These are valid ordinary PureScript definitions and have no Wasm/WASI-specific +semantics. Restore the official forms and repair compiler handling at its +owning stage if necessary. + +Instance methods were also eta-expanded in Data.Eq, Data.EuclideanRing, +Data.Functor, Data.HeytingAlgebra, Data.Ord, Data.Ring, Data.Semigroup, and +Data.Semiring. The vendoring script explains this through its restriction that +bare intrinsics are not first-class values. A target binding can have a wrapper, +but that compiler limitation does not by itself authorize rewriting the +upstream instance definitions. Preserve the foreign value's source contract +and put implementation adaptation at the defined primitive boundary. + +### An incorrect FFI replacement + +Official `Data.Eq.js` checks the two array lengths before reading any element. +The vendored `eqArrayFrom` stops only when its index reaches the left array's +length. It can read beyond the right array's bounds when the left array is +longer. For `[1] == []`, the official operation returns false without reading +an element; the replacement attempts to index the empty right array. This is +an observable algorithm difference found by source inspection; this audit did +not execute a Wasm reproduction or claim a measured trap. + +## Target-related changes requiring separate evidence + +The other changed files must not be automatically approved merely because +an upstream foreign declaration was replaced. The following table accounts for +all 20 modified modules without an exact self-recursive placeholder. The other +30 modified modules are covered by the placeholder inventory above. + +| Module | Difference and disposition | +| --- | --- | +| Control.Apply | Replaces arrayApply FFI with recursive PureScript helpers. Target implementation candidate; equivalence and stack behavior unverified. | +| Control.Bind | Replaces arrayBind FFI with recursive PureScript helpers. Target implementation candidate; equivalence and stack behavior unverified. | +| Data.Bounded | Replaces numeric/character constants. Primitive representation candidate; validate bounds against the target Char/Number contracts. | +| Data.Eq | FFI replacements plus method rewrites; confirmed array bounds difference and unapproved pure rewrites. | +| Data.EuclideanRing | Removes intDiv/intMod foreign declarations and uses intrinsics, implements intDegree/numDiv, rewrites methods. Verify negative and zero divisors; pure method rewrites lack target necessity. | +| Data.Functor | Implements arrayMap with recursion, eta-expands map, rewrites three pure combinators. Pure combinator changes violate policy. | +| Data.HeytingAlgebra | Boolean primitive wrappers plus instance-method rewrites. Primitive implementation candidate; pure rewrites require restoration. | +| Data.Int.Bits | Seven FFI values call Wasm-oriented integer intrinsics. Target implementation candidate; validate bit and shift semantics. | +| Data.Ord | Numeric, character, array, and UTF-8 byte comparators plus method rewrites. UTF-8 ordering must follow DEC-16; method rewrites are compiler accommodations. | +| Data.Ring | Removes intSub declaration and implements numSub; rewrites both methods. Primitive bindings need an explicit target boundary, not source-method workarounds. | +| Data.Semigroup | Implements string concatenation through UTF-8 bytes and array concatenation through intrinsics, rewrites append methods. Storage adaptations are candidates; method rewrites are not established as necessary. | +| Data.Semiring | Removes intAdd/intMul declarations, adds numeric primitive wrappers, rewrites methods. Primitive adaptation candidate; method rewrites are compiler accommodations. | +| Data.Show.Generic | Replaces intercalate FFI with a PureScript helper. Target implementation candidate; output/order/boundary behavior unverified. | +| Data.Show | Target rendering implementation mixed with API removals and acknowledged Number behavior differences. Fails policy as a whole. | +| Data.Tuple | Pure implementation replaced and 20 instances removed. Fails policy. | +| Data.Unit | Replaces foreign type/value declarations with re-exports of compiler builtins. Requires an explicit primitive identity/representation justification; not blanket-approved. | +| Prelude | Adds Effect, runEffect, trap and their primitive bindings/instances. Documented target interface, but relocation and extra exports require API/dependency review rather than an assumption of upstream equality. | +| Effect | Target type and instances relocated to Prelude, standard loops and two pure instances omitted. Fails policy as a whole. | +| Effect.Console | WASI routing mixed with ten omitted values, including pure Show wrappers. Fails policy as a whole. | +| Test.Assert | Trap-based failure mixed with removed equality and message-taking Boolean assertions. Fails policy as a whole. | + +The nine WASI modules are platform additions: WASI, WASI.Resource, WASI.IO, +WASI.Clock, WASI.Random, WASI.Console, WASI.Process, WASI.FileSystem, and +WASI.Network. Their scope is target-related. This audit does not assert their +runtime correctness. Effect, Effect.Console, and Test.Assert are handwritten +platform wrappers whose exact differences are now included in the audit. + +DEC-16 permits target-specific Unicode scalar and UTF-8 behavior; it does not +permit dropping pure instances or using nontermination to fake an FFI value. +A reviewed adaptation must identify the target requirement and preserve the +public source contract wherever that requirement does not explicitly change it. +Unsupported bindings must remain explicit compile/link failures rather than +apparently implemented recursive functions. + +## Reproduction and next obligations + +Run from the repository root with the same clean upstream checkouts: + +```sh +python3 docs/workflow/tools/audit-stdlib-vendor.py \ + --vendor stdlib/lib \ + --upstream /tmp/ps-pkgs \ + --upstream /tmp/purescript-prelude \ + --upstream /tmp/psrs-stdlib-audit-20261006/upstream \ + --out /tmp/psrs-stdlib-audit-repeat +``` + +The tool checks clean tagged upstream checkouts, rejects duplicate module paths, +records byte hashes, emits an unfiltered unified diff, reports exact top-level +self-recursions, and flags changes to original code outside value FFI declaration +spans. Those flags are review evidence, not semantic approval. Matching source +paths and package tags do not certify behavior of generated primitive bindings. + +Required continuation: + +1. Keep all 41 comparison baselines pinned and preserve their source provenance. +2. Restore removed pure APIs/instances, omitted pure modules, and the ordinary + upstream function forms. +3. Restore unsupported foreign declarations instead of recursive placeholders; + connect supported values through the explicit Wasm/WASI primitive contract. +4. Keep target adaptations reviewable with their rationale and behavior tests, + including UTF-8 differences under DEC-16. +5. Rerun source compile acceptance after restoration; expect honest compiler or + linking blockers until the required target implementations exist. +6. Run focused value-sensitive runtime comparisons for each implemented binding. + A complete runtime scoreboard remains a separate measurement. + +No library repair, compiler change, push, PR, or issue operation was performed +as part of this source audit. diff --git a/docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.json b/docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.json new file mode 100644 index 00000000..2942cd0e --- /dev/null +++ b/docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.json @@ -0,0 +1,2206 @@ +{ + "schema_version": 1, + "scope": "Restored ordinary foreign declarations; runtime support is unimplemented.", + "bindings": [ + { + "value": "Control.Apply.arrayApply", + "module_path": "Control/Apply.purs", + "declaration": "foreign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Apply.purs#L63", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Bind.arrayBind", + "module_path": "Control/Bind.purs", + "declaration": "foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Bind.purs#L97", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Extend.arrayExtend", + "module_path": "Control/Extend.purs", + "declaration": "foreign import arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Extend.purs#L30", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.map_", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L38", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.pure_", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import pure_ :: forall r a. a -> ST r a", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L40", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.bind_", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L42", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.run", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import run :: forall a. (forall r. ST r a) -> a", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L89", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.while", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L96", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.for", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L102", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.foreach", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L108", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.new", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import new :: forall a r. a -> ST r (STRef r a)", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L117", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.read", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import read :: forall a r. STRef r a -> ST r a", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L120", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.modifyImpl", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L128", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Internal.write", + "module_path": "Control/Monad/ST/Internal.purs", + "declaration": "foreign import write :: forall a r. a -> STRef r a -> ST r a", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs#L136", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn1", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn1 :: forall a t r. (a -> ST t r) -> STFn1 a t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L61", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn2", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn2 :: forall a b t r. (a -> b -> ST t r) -> STFn2 a b t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L63", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn3", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn3 :: forall a b c t r. (a -> b -> c -> ST t r) -> STFn3 a b c t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L65", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn4", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn4 :: forall a b c d t r. (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L67", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn5", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn5 :: forall a b c d e t r. (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L69", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn6", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn6 :: forall a b c d e f t r. (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L71", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn7", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn7 :: forall a b c d e f g t r. (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L73", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn8", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn8 :: forall a b c d e f g h t r. (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L75", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn9", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn9 :: forall a b c d e f g h i t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L77", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.mkSTFn10", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import mkSTFn10 :: forall a b c d e f g h i j t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L79", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn1", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn1 :: forall a t r. STFn1 a t r -> a -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L82", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn2", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn2 :: forall a b t r. STFn2 a b t r -> a -> b -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L84", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn3", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn3 :: forall a b c t r. STFn3 a b c t r -> a -> b -> c -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L86", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn4", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn4 :: forall a b c d t r. STFn4 a b c d t r -> a -> b -> c -> d -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L88", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn5", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn5 :: forall a b c d e t r. STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L90", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn6", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn6 :: forall a b c d e f t r. STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L92", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn7", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn7 :: forall a b c d e f g t r. STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L94", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn8", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn8 :: forall a b c d e f g h t r. STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L96", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn9", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn9 :: forall a b c d e f g h i t r. STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L98", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Control.Monad.ST.Uncurried.runSTFn10", + "module_path": "Control/Monad/ST/Uncurried.purs", + "declaration": "foreign import runSTFn10 :: forall a b c d e f g h i j t r. STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs#L100", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.NonEmpty.Internal.foldr1Impl", + "module_path": "Data/Array/NonEmpty/Internal.purs", + "declaration": "foreign import foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty/Internal.purs#L75", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.NonEmpty.Internal.foldl1Impl", + "module_path": "Data/Array/NonEmpty/Internal.purs", + "declaration": "foreign import foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty/Internal.purs#L76", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.NonEmpty.Internal.traverse1Impl", + "module_path": "Data/Array/NonEmpty/Internal.purs", + "declaration": "foreign import traverse1Impl :: forall m a b . Fn3 (forall a' b'. (m (a' -> b') -> m a' -> m b')) (forall a' b'. (a' -> b') -> m a' -> m b') (a -> m b) (NonEmptyArray a -> m (NonEmptyArray b))", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty/Internal.purs#L78", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.Partial.peekImpl", + "module_path": "Data/Array/ST/Partial.purs", + "declaration": "foreign import peekImpl :: forall h a. STFn2 Int (STArray h a) h a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST/Partial.purs#L24", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.Partial.pokeImpl", + "module_path": "Data/Array/ST/Partial.purs", + "declaration": "foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST/Partial.purs#L36", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.unsafeFreezeImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L78", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.unsafeThawImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L85", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.new", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import new :: forall h a. ST h (STArray h a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L88", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.thawImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L97", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.cloneImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L106", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.shiftImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import shiftImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L117", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.sortByImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import sortByImpl :: forall a h . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L134", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.freezeImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L155", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.peekImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L165", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.pokeImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L176", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.lengthImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L178", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.popImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import popImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L188", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.pushImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L197", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.pushAllImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import pushAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L208", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.unshiftAllImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import unshiftAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L226", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.spliceImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import spliceImpl :: forall h a . STFn4 Int Int (Array a) (STArray h a) h (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L248", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.ST.toAssocArrayImpl", + "module_path": "Data/Array/ST.purs", + "declaration": "foreign import toAssocArrayImpl :: forall h a . STFn1 (STArray h a) h (Array (Assoc a))", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs#L260", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.fromFoldableImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import fromFoldableImpl :: forall f a . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L177", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.rangeImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import rangeImpl :: Fn2 Int Int (Array Int)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L195", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.replicateImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import replicateImpl :: forall a. Fn2 Int a (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L204", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.length", + "module_path": "Data/Array.purs", + "declaration": "foreign import length :: forall a. Array a -> Int", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L243", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.unconsImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import unconsImpl :: forall a b . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L373", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.indexImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import indexImpl :: forall a . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L405", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.findMapImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import findMapImpl :: forall a b . Fn4 (forall c. Maybe c) (forall c. Maybe c -> Boolean) (a -> Maybe b) (Array a) (Maybe b)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L462", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.findIndexImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import findIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L481", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.findLastIndexImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import findLastIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L500", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array._insertAt", + "module_path": "Data/Array.purs", + "declaration": "foreign import _insertAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a))", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L520", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array._deleteAt", + "module_path": "Data/Array.purs", + "declaration": "foreign import _deleteAt :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) Int (Array a) (Maybe (Array a))", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L541", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array._updateAt", + "module_path": "Data/Array.purs", + "declaration": "foreign import _updateAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a))", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L561", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.reverse", + "module_path": "Data/Array.purs", + "declaration": "foreign import reverse :: forall a. Array a -> Array a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L642", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.concat", + "module_path": "Data/Array.purs", + "declaration": "foreign import concat :: forall a. Array (Array a) -> Array a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L650", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.filterImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import filterImpl :: forall a . Fn2 (a -> Boolean) (Array a) (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L673", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.partitionImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import partitionImpl :: forall a . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a }", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L692", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.scanlImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L857", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.scanrImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L870", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.sortByImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L914", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.sliceImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L932", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.zipWithImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import zipWithImpl :: forall a b c . Fn3 (a -> b -> c) (Array a) (Array b) (Array c)", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L1253", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.anyImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L1322", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.allImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L1336", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Array.unsafeIndexImpl", + "module_path": "Data/Array.purs", + "declaration": "foreign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs#L1371", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Bounded.topInt", + "module_path": "Data/Bounded.purs", + "declaration": "foreign import topInt :: Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs#L40", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Bounded.bottomInt", + "module_path": "Data/Bounded.purs", + "declaration": "foreign import bottomInt :: Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs#L41", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Bounded.topChar", + "module_path": "Data/Bounded.purs", + "declaration": "foreign import topChar :: Char", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs#L48", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Bounded.bottomChar", + "module_path": "Data/Bounded.purs", + "declaration": "foreign import bottomChar :: Char", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs#L49", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Bounded.topNumber", + "module_path": "Data/Bounded.purs", + "declaration": "foreign import topNumber :: Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs#L59", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Bounded.bottomNumber", + "module_path": "Data/Bounded.purs", + "declaration": "foreign import bottomNumber :: Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs#L60", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Enum.toCharCode", + "module_path": "Data/Enum.purs", + "declaration": "foreign import toCharCode :: Char -> Int", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum.purs#L320", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Enum.fromCharCode", + "module_path": "Data/Enum.purs", + "declaration": "foreign import fromCharCode :: Int -> Char", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum.purs#L321", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Eq.eqBooleanImpl", + "module_path": "Data/Eq.purs", + "declaration": "foreign import eqBooleanImpl :: Boolean -> Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L77", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Eq.eqIntImpl", + "module_path": "Data/Eq.purs", + "declaration": "foreign import eqIntImpl :: Int -> Int -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L78", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Eq.eqNumberImpl", + "module_path": "Data/Eq.purs", + "declaration": "foreign import eqNumberImpl :: Number -> Number -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L79", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Eq.eqCharImpl", + "module_path": "Data/Eq.purs", + "declaration": "foreign import eqCharImpl :: Char -> Char -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L80", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Eq.eqStringImpl", + "module_path": "Data/Eq.purs", + "declaration": "foreign import eqStringImpl :: String -> String -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L81", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Eq.eqArrayImpl", + "module_path": "Data/Eq.purs", + "declaration": "foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L83", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.EuclideanRing.intDegree", + "module_path": "Data/EuclideanRing.purs", + "declaration": "foreign import intDegree :: Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/EuclideanRing.purs#L84", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.EuclideanRing.intDiv", + "module_path": "Data/EuclideanRing.purs", + "declaration": "foreign import intDiv :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/EuclideanRing.purs#L85", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.EuclideanRing.intMod", + "module_path": "Data/EuclideanRing.purs", + "declaration": "foreign import intMod :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/EuclideanRing.purs#L86", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.EuclideanRing.numDiv", + "module_path": "Data/EuclideanRing.purs", + "declaration": "foreign import numDiv :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/EuclideanRing.purs#L88", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Foldable.foldrArray", + "module_path": "Data/Foldable.purs", + "declaration": "foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Foldable.purs#L135", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Foldable.foldlArray", + "module_path": "Data/Foldable.purs", + "declaration": "foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Foldable.purs#L136", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn0", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L59", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn2", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L66", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn3", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L69", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn4", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L72", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn5", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L75", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn6", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L78", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn7", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L81", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn8", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L84", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn9", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L87", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.mkFn10", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L90", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn0", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn0 :: forall a. Fn0 a -> a", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L93", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn2", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L100", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn3", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L103", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn4", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L106", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn5", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L109", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn6", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L112", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn7", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L115", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn8", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L118", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn9", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L121", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Function.Uncurried.runFn10", + "module_path": "Data/Function/Uncurried.purs", + "declaration": "foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs#L124", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Functor.arrayMap", + "module_path": "Data/Functor.purs", + "declaration": "foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Functor.purs#L55", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.FunctorWithIndex.mapWithIndexArray", + "module_path": "Data/FunctorWithIndex.purs", + "declaration": "foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/FunctorWithIndex.purs#L38", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.HeytingAlgebra.boolConj", + "module_path": "Data/HeytingAlgebra.purs", + "declaration": "foreign import boolConj :: Boolean -> Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs#L103", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.HeytingAlgebra.boolDisj", + "module_path": "Data/HeytingAlgebra.purs", + "declaration": "foreign import boolDisj :: Boolean -> Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs#L104", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.HeytingAlgebra.boolNot", + "module_path": "Data/HeytingAlgebra.purs", + "declaration": "foreign import boolNot :: Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs#L105", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.and", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import and :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L13", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.or", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import or :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L18", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.xor", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import xor :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L23", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.shl", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import shl :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L28", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.shr", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import shr :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L31", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.zshr", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import zshr :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L34", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.Bits.complement", + "module_path": "Data/Int/Bits.purs", + "declaration": "foreign import complement :: Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L37", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.fromNumberImpl", + "module_path": "Data/Int.purs", + "declaration": "foreign import fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L40", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.toNumber", + "module_path": "Data/Int.purs", + "declaration": "foreign import toNumber :: Int -> Number", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L81", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.quot", + "module_path": "Data/Int.purs", + "declaration": "foreign import quot :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L227", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.rem", + "module_path": "Data/Int.purs", + "declaration": "foreign import rem :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L245", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.pow", + "module_path": "Data/Int.purs", + "declaration": "foreign import pow :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L248", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.fromStringAsImpl", + "module_path": "Data/Int.purs", + "declaration": "foreign import fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L250", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Int.toStringAs", + "module_path": "Data/Int.purs", + "declaration": "foreign import toStringAs :: Radix -> Int -> String", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L257", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Lazy.defer", + "module_path": "Data/Lazy.purs", + "declaration": "foreign import defer :: forall a. (Unit -> a) -> Lazy a", + "upstream_url": "https://github.com/purescript/purescript-lazy/blob/48347841226b27af5205a1a8ec71e27a93ce86fd/src/Data/Lazy.purs#L35", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Lazy.force", + "module_path": "Data/Lazy.purs", + "declaration": "foreign import force :: forall a. Lazy a -> a", + "upstream_url": "https://github.com/purescript/purescript-lazy/blob/48347841226b27af5205a1a8ec71e27a93ce86fd/src/Data/Lazy.purs#L38", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.Format.toPrecisionNative", + "module_path": "Data/Number/Format.purs", + "declaration": "foreign import toPrecisionNative :: Int -> Number -> String", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Format.purs#L33", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.Format.toFixedNative", + "module_path": "Data/Number/Format.purs", + "declaration": "foreign import toFixedNative :: Int -> Number -> String", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Format.purs#L34", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.Format.toExponentialNative", + "module_path": "Data/Number/Format.purs", + "declaration": "foreign import toExponentialNative :: Int -> Number -> String", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Format.purs#L35", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.Format.toString", + "module_path": "Data/Number/Format.purs", + "declaration": "foreign import toString :: Number -> String", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Format.purs#L76", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.nan", + "module_path": "Data/Number.purs", + "declaration": "foreign import nan :: Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L47", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.isNaN", + "module_path": "Data/Number.purs", + "declaration": "foreign import isNaN :: Number -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L57", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.infinity", + "module_path": "Data/Number.purs", + "declaration": "foreign import infinity :: Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L67", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.isFinite", + "module_path": "Data/Number.purs", + "declaration": "foreign import isFinite :: Number -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L83", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.fromStringImpl", + "module_path": "Data/Number.purs", + "declaration": "foreign import fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number)", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L115", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.abs", + "module_path": "Data/Number.purs", + "declaration": "foreign import abs :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L123", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.acos", + "module_path": "Data/Number.purs", + "declaration": "foreign import acos :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L130", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.asin", + "module_path": "Data/Number.purs", + "declaration": "foreign import asin :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L137", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.atan", + "module_path": "Data/Number.purs", + "declaration": "foreign import atan :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L144", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.atan2", + "module_path": "Data/Number.purs", + "declaration": "foreign import atan2 :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L157", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.ceil", + "module_path": "Data/Number.purs", + "declaration": "foreign import ceil :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L164", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.cos", + "module_path": "Data/Number.purs", + "declaration": "foreign import cos :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L171", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.exp", + "module_path": "Data/Number.purs", + "declaration": "foreign import exp :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L178", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.floor", + "module_path": "Data/Number.purs", + "declaration": "foreign import floor :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L185", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.log", + "module_path": "Data/Number.purs", + "declaration": "foreign import log :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L191", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.max", + "module_path": "Data/Number.purs", + "declaration": "foreign import max :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L195", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.min", + "module_path": "Data/Number.purs", + "declaration": "foreign import min :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L199", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.pow", + "module_path": "Data/Number.purs", + "declaration": "foreign import pow :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L209", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.remainder", + "module_path": "Data/Number.purs", + "declaration": "foreign import remainder :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L216", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.round", + "module_path": "Data/Number.purs", + "declaration": "foreign import round :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L225", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.sign", + "module_path": "Data/Number.purs", + "declaration": "foreign import sign :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L235", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.sin", + "module_path": "Data/Number.purs", + "declaration": "foreign import sin :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L242", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.sqrt", + "module_path": "Data/Number.purs", + "declaration": "foreign import sqrt :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L249", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.tan", + "module_path": "Data/Number.purs", + "declaration": "foreign import tan :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L256", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Number.trunc", + "module_path": "Data/Number.purs", + "declaration": "foreign import trunc :: Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs#L264", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ord.ordBooleanImpl", + "module_path": "Data/Ord.purs", + "declaration": "foreign import ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs#L84", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ord.ordIntImpl", + "module_path": "Data/Ord.purs", + "declaration": "foreign import ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs#L92", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ord.ordNumberImpl", + "module_path": "Data/Ord.purs", + "declaration": "foreign import ordNumberImpl :: Ordering -> Ordering -> Ordering -> Number -> Number -> Ordering", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs#L100", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ord.ordStringImpl", + "module_path": "Data/Ord.purs", + "declaration": "foreign import ordStringImpl :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs#L108", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ord.ordCharImpl", + "module_path": "Data/Ord.purs", + "declaration": "foreign import ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs#L116", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ord.ordArrayImpl", + "module_path": "Data/Ord.purs", + "declaration": "foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs#L124", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Reflectable.unsafeCoerce", + "module_path": "Data/Reflectable.purs", + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Reflectable.purs#L36", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ring.intSub", + "module_path": "Data/Ring.purs", + "declaration": "foreign import intSub :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring.purs#L54", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Ring.numSub", + "module_path": "Data/Ring.purs", + "declaration": "foreign import numSub :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring.purs#L55", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Semigroup.concatString", + "module_path": "Data/Semigroup.purs", + "declaration": "foreign import concatString :: String -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup.purs#L60", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Semigroup.concatArray", + "module_path": "Data/Semigroup.purs", + "declaration": "foreign import concatArray :: forall a. Array a -> Array a -> Array a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup.purs#L61", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Semiring.intAdd", + "module_path": "Data/Semiring.purs", + "declaration": "foreign import intAdd :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L89", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Semiring.intMul", + "module_path": "Data/Semiring.purs", + "declaration": "foreign import intMul :: Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L90", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Semiring.numAdd", + "module_path": "Data/Semiring.purs", + "declaration": "foreign import numAdd :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L91", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Semiring.numMul", + "module_path": "Data/Semiring.purs", + "declaration": "foreign import numMul :: Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L92", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Show.Generic.intercalate", + "module_path": "Data/Show/Generic.purs", + "declaration": "foreign import intercalate :: String -> Array String -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show/Generic.purs#L57", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Show.showIntImpl", + "module_path": "Data/Show.purs", + "declaration": "foreign import showIntImpl :: Int -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs#L93", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Show.showNumberImpl", + "module_path": "Data/Show.purs", + "declaration": "foreign import showNumberImpl :: Number -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs#L94", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Show.showCharImpl", + "module_path": "Data/Show.purs", + "declaration": "foreign import showCharImpl :: Char -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs#L95", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Show.showStringImpl", + "module_path": "Data/Show.purs", + "declaration": "foreign import showStringImpl :: String -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs#L96", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Show.showArrayImpl", + "module_path": "Data/Show.purs", + "declaration": "foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs#L97", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._singleton", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _singleton :: (CodePoint -> String) -> CodePoint -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L91", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._fromCodePointArray", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _fromCodePointArray :: (CodePoint -> String) -> Array CodePoint -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L117", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._toCodePointArray", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _toCodePointArray :: (String -> Array CodePoint) -> (String -> CodePoint) -> String -> Array CodePoint", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L136", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._codePointAt", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _codePointAt :: (Int -> String -> Maybe CodePoint) -> (forall a. a -> Maybe a) -> (forall a. Maybe a) -> (String -> CodePoint) -> Int -> String -> Maybe CodePoint", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L166", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._countPrefix", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _countPrefix :: ((CodePoint -> Boolean) -> String -> Int) -> (String -> CodePoint) -> (CodePoint -> Boolean) -> String -> Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L230", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._take", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _take :: (Int -> String -> String) -> Int -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L331", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodePoints._unsafeCodePointAt0", + "module_path": "Data/String/CodePoints.purs", + "declaration": "foreign import _unsafeCodePointAt0 :: (String -> CodePoint) -> String -> CodePoint", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs#L421", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.singleton", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import singleton :: Char -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L83", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.fromCharArray", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import fromCharArray :: Array Char -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L90", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.toCharArray", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import toCharArray :: String -> Array Char", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L97", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits._charAt", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import _charAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Int -> String -> Maybe Char", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L109", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits._toChar", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import _toChar :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> String -> Maybe Char", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L126", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.length", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import length :: String -> Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L150", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.countPrefix", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import countPrefix :: (Char -> Boolean) -> String -> Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L159", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits._indexOf", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import _indexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L172", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits._indexOfStartingAt", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import _indexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L191", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits._lastIndexOf", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import _lastIndexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L210", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits._lastIndexOfStartingAt", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import _lastIndexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L238", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.take", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import take :: Int -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L252", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.drop", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import drop :: Int -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L279", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.slice", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import slice :: Int -> Int -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L311", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.CodeUnits.splitAt", + "module_path": "Data/String/CodeUnits.purs", + "declaration": "foreign import splitAt :: Int -> String -> { before :: String, after :: String }", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs#L332", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common._localeCompare", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import _localeCompare :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L37", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.replace", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import replace :: Pattern -> Replacement -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L50", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.replaceAll", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import replaceAll :: Pattern -> Replacement -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L57", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.split", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import split :: Pattern -> String -> Array String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L65", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.toLower", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import toLower :: String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L72", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.toUpper", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import toUpper :: String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L79", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.trim", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import trim :: String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L88", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Common.joinWith", + "module_path": "Data/String/Common.purs", + "declaration": "foreign import joinWith :: String -> Array String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs#L96", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.showRegexImpl", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import showRegexImpl :: Regex -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L31", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.regexImpl", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import regexImpl :: (String -> Either String Regex) -> (Regex -> Either String Regex) -> String -> String -> Either String Regex", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L36", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.source", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import source :: Regex -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L49", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.flagsImpl", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import flagsImpl :: Regex -> RegexFlagsRec", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L56", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.test", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import test :: Regex -> String -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L82", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex._match", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import _match :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe (NonEmptyArray (Maybe String))", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L84", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.replace", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import replace :: Regex -> String -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L101", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex._replaceBy", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import _replaceBy :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> (String -> Array (Maybe String) -> String) -> String -> String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L103", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex._search", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import _search :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe Int", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L118", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Regex.split", + "module_path": "Data/String/Regex.purs", + "declaration": "foreign import split :: Regex -> String -> Array String", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs#L131", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Unsafe.charAt", + "module_path": "Data/String/Unsafe.purs", + "declaration": "foreign import charAt :: Int -> String -> Char", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Unsafe.purs#L10", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.String.Unsafe.char", + "module_path": "Data/String/Unsafe.purs", + "declaration": "foreign import char :: String -> Char", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Unsafe.purs#L15", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Symbol.unsafeCoerce", + "module_path": "Data/Symbol.purs", + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Symbol.purs#L14", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Traversable.traverseArrayImpl", + "module_path": "Data/Traversable.purs", + "declaration": "foreign import traverseArrayImpl :: forall m a b . (forall x y. m (x -> y) -> m x -> m y) -> (forall x y. (x -> y) -> m x -> m y) -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b)", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable.purs#L106", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Unfoldable.unfoldrArrayImpl", + "module_path": "Data/Unfoldable.purs", + "declaration": "foreign import unfoldrArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Maybe (Tuple a b)) -> b -> Array a", + "upstream_url": "https://github.com/purescript/purescript-unfoldable/blob/493dfe04ed590e20d8f69079df2f58486882748d/src/Data/Unfoldable.purs#L47", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Data.Unfoldable1.unfoldr1ArrayImpl", + "module_path": "Data/Unfoldable1.purs", + "declaration": "foreign import unfoldr1ArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Tuple a (Maybe b)) -> b -> Array a", + "upstream_url": "https://github.com/purescript/purescript-unfoldable/blob/493dfe04ed590e20d8f69079df2f58486882748d/src/Data/Unfoldable1.purs#L48", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Console.time", + "module_path": "Effect/Console.purs", + "declaration": "foreign import time :: String -> Effect Unit", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Console.purs#L59", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Console.timeLog", + "module_path": "Effect/Console.purs", + "declaration": "foreign import timeLog :: String -> Effect Unit", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Console.purs#L62", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Console.timeEnd", + "module_path": "Effect/Console.purs", + "declaration": "foreign import timeEnd :: String -> Effect Unit", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Console.purs#L65", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Console.clear", + "module_path": "Effect/Console.purs", + "declaration": "foreign import clear :: Effect Unit", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Console.purs#L68", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Ref._new", + "module_path": "Effect/Ref.purs", + "declaration": "foreign import _new :: forall s. s -> Effect (Ref s)", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs#L44", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Ref.newWithSelf", + "module_path": "Effect/Ref.purs", + "declaration": "foreign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s)", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs#L51", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Ref.read", + "module_path": "Effect/Ref.purs", + "declaration": "foreign import read :: forall s. Ref s -> Effect s", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs#L54", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Ref.modifyImpl", + "module_path": "Effect/Ref.purs", + "declaration": "foreign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs#L61", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Ref.write", + "module_path": "Effect/Ref.purs", + "declaration": "foreign import write :: forall s. s -> Ref s -> Effect Unit", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs#L73", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Effect.Uncurried.mkEffectFn1", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn1 :: forall a r. (a -> Effect r) -> EffectFn1 a r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L178", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn2", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn2 :: forall a b r. (a -> b -> Effect r) -> EffectFn2 a b r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L180", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn3", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn3 :: forall a b c r. (a -> b -> c -> Effect r) -> EffectFn3 a b c r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L182", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn4", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn4 :: forall a b c d r. (a -> b -> c -> d -> Effect r) -> EffectFn4 a b c d r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L184", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn5", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn5 :: forall a b c d e r. (a -> b -> c -> d -> e -> Effect r) -> EffectFn5 a b c d e r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L186", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn6", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn6 :: forall a b c d e f r. (a -> b -> c -> d -> e -> f -> Effect r) -> EffectFn6 a b c d e f r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L188", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn7", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn7 :: forall a b c d e f g r. (a -> b -> c -> d -> e -> f -> g -> Effect r) -> EffectFn7 a b c d e f g r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L190", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn8", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn8 :: forall a b c d e f g h r. (a -> b -> c -> d -> e -> f -> g -> h -> Effect r) -> EffectFn8 a b c d e f g h r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L192", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn9", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn9 :: forall a b c d e f g h i r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r) -> EffectFn9 a b c d e f g h i r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L194", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.mkEffectFn10", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import mkEffectFn10 :: forall a b c d e f g h i j r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r) -> EffectFn10 a b c d e f g h i j r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L196", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn1", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn1 :: forall a r. EffectFn1 a r -> a -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L199", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn2", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn2 :: forall a b r. EffectFn2 a b r -> a -> b -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L201", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn3", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn3 :: forall a b c r. EffectFn3 a b c r -> a -> b -> c -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L203", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn4", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn4 :: forall a b c d r. EffectFn4 a b c d r -> a -> b -> c -> d -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L205", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn5", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn5 :: forall a b c d e r. EffectFn5 a b c d e r -> a -> b -> c -> d -> e -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L207", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn6", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn6 :: forall a b c d e f r. EffectFn6 a b c d e f r -> a -> b -> c -> d -> e -> f -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L209", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn7", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn7 :: forall a b c d e f g r. EffectFn7 a b c d e f g r -> a -> b -> c -> d -> e -> f -> g -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L211", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn8", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn8 :: forall a b c d e f g h r. EffectFn8 a b c d e f g h r -> a -> b -> c -> d -> e -> f -> g -> h -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L213", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn9", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn9 :: forall a b c d e f g h i r. EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L215", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Uncurried.runEffectFn10", + "module_path": "Effect/Uncurried.purs", + "declaration": "foreign import runEffectFn10 :: forall a b c d e f g h i j r. EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs#L217", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Effect.Unsafe.unsafePerformEffect", + "module_path": "Effect/Unsafe.purs", + "declaration": "foreign import unsafePerformEffect :: forall a. Effect a -> a", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Unsafe.purs#L8", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + }, + { + "value": "Partial.Unsafe._unsafePartial", + "module_path": "Partial/Unsafe.purs", + "declaration": "foreign import _unsafePartial :: forall a b. a -> b", + "upstream_url": "https://github.com/purescript/purescript-partial/blob/0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec/src/Partial/Unsafe.purs#L16", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Partial._crashWith", + "module_path": "Partial.purs", + "declaration": "foreign import _crashWith :: forall a. String -> a", + "upstream_url": "https://github.com/purescript/purescript-partial/blob/0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec/src/Partial.purs#L15", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Record.Unsafe.unsafeHas", + "module_path": "Record/Unsafe.purs", + "declaration": "foreign import unsafeHas :: forall r1. String -> Record r1 -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Record/Unsafe.purs#L10", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Record.Unsafe.unsafeGet", + "module_path": "Record/Unsafe.purs", + "declaration": "foreign import unsafeGet :: forall r a. String -> Record r -> a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Record/Unsafe.purs#L15", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Record.Unsafe.unsafeSet", + "module_path": "Record/Unsafe.purs", + "declaration": "foreign import unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Record/Unsafe.purs#L21", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Record.Unsafe.unsafeDelete", + "module_path": "Record/Unsafe.purs", + "declaration": "foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Record/Unsafe.purs#L27", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Test.Assert.checkThrows", + "module_path": "Test/Assert.purs", + "declaration": "foreign import checkThrows :: forall a . (Unit -> a) -> Effect Boolean", + "upstream_url": "https://github.com/purescript/purescript-assert/blob/27c0edb57d2ee497eb5fab664f5601c35b613eda/src/Test/Assert.purs#L59", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": true + }, + { + "value": "Unsafe.Coerce.unsafeCoerce", + "module_path": "Unsafe/Coerce.purs", + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "upstream_url": "https://github.com/purescript/purescript-unsafe-coerce/blob/ab956f82e66e633f647fb3098e8ddd3ec58d689f/src/Unsafe/Coerce.purs#L27", + "target_implementation": "missing", + "all_stdlib_reproducer_reports_missing": false + } + ] +} diff --git a/docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.md b/docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.md new file mode 100644 index 00000000..2e3f0777 --- /dev/null +++ b/docs/implementation/stdlib/vendor-restoration-2026-10-06/foreign-bindings.md @@ -0,0 +1,59 @@ +# Ordinary foreign bindings awaiting target implementation + +Generated from the pinned source inventory. Every entry still lacks a target +implementation and runtime acceptance evidence. The full reproducer imports only +a subset of the inventory; absence from its errors does not establish support. + +| Official module | Missing bindings | Reported by full reproducer | +| --- | ---: | ---: | +| `Control/Apply.purs` | 1 | 1 | +| `Control/Bind.purs` | 1 | 1 | +| `Control/Extend.purs` | 1 | 1 | +| `Control/Monad/ST/Internal.purs` | 11 | 11 | +| `Control/Monad/ST/Uncurried.purs` | 20 | 20 | +| `Data/Array.purs` | 24 | 24 | +| `Data/Array/NonEmpty/Internal.purs` | 3 | 3 | +| `Data/Array/ST.purs` | 17 | 17 | +| `Data/Array/ST/Partial.purs` | 2 | 2 | +| `Data/Bounded.purs` | 6 | 6 | +| `Data/Enum.purs` | 2 | 2 | +| `Data/Eq.purs` | 6 | 6 | +| `Data/EuclideanRing.purs` | 4 | 4 | +| `Data/Foldable.purs` | 2 | 2 | +| `Data/Function/Uncurried.purs` | 20 | 20 | +| `Data/Functor.purs` | 1 | 1 | +| `Data/FunctorWithIndex.purs` | 1 | 1 | +| `Data/HeytingAlgebra.purs` | 3 | 3 | +| `Data/Int.purs` | 7 | 7 | +| `Data/Int/Bits.purs` | 7 | 7 | +| `Data/Lazy.purs` | 2 | 2 | +| `Data/Number.purs` | 25 | 25 | +| `Data/Number/Format.purs` | 4 | 4 | +| `Data/Ord.purs` | 6 | 6 | +| `Data/Reflectable.purs` | 1 | 1 | +| `Data/Ring.purs` | 2 | 2 | +| `Data/Semigroup.purs` | 2 | 2 | +| `Data/Semiring.purs` | 4 | 4 | +| `Data/Show.purs` | 5 | 5 | +| `Data/Show/Generic.purs` | 1 | 1 | +| `Data/String/CodePoints.purs` | 7 | 7 | +| `Data/String/CodeUnits.purs` | 15 | 15 | +| `Data/String/Common.purs` | 8 | 8 | +| `Data/String/Regex.purs` | 10 | 10 | +| `Data/String/Unsafe.purs` | 2 | 2 | +| `Data/Symbol.purs` | 1 | 1 | +| `Data/Traversable.purs` | 1 | 1 | +| `Data/Unfoldable.purs` | 1 | 1 | +| `Data/Unfoldable1.purs` | 1 | 1 | +| `Effect/Console.purs` | 4 | 4 | +| `Effect/Ref.purs` | 5 | 5 | +| `Effect/Uncurried.purs` | 20 | 0 | +| `Effect/Unsafe.purs` | 1 | 0 | +| `Partial.purs` | 1 | 1 | +| `Partial/Unsafe.purs` | 1 | 1 | +| `Record/Unsafe.purs` | 4 | 4 | +| `Test/Assert.purs` | 1 | 1 | +| `Unsafe/Coerce.purs` | 1 | 0 | + +See [foreign-bindings.json](foreign-bindings.json) for each original declaration +and pinned upstream source link. diff --git a/docs/implementation/stdlib/vendor-restoration-2026-10-06/inventory.json b/docs/implementation/stdlib/vendor-restoration-2026-10-06/inventory.json new file mode 100644 index 00000000..767b80cb --- /dev/null +++ b/docs/implementation/stdlib/vendor-restoration-2026-10-06/inventory.json @@ -0,0 +1,5101 @@ +{ + "schema_version": 1, + "compiler_revision": "67369ba012755b1586d1250fac6a7254e096bb03", + "counts": { + "identical": 201, + "modified": 5, + "platform_addition": 9, + "vendored_modules": 215, + "packages": 41, + "direct_self_recursions": 0, + "modules_with_direct_self_recursions": 0, + "upstream_modules_absent_from_vendor": [], + "upstream_value_foreign_declarations": { + "foreign_declaration_retained": 275, + "declaration_removed": 1, + "nonrecursive_replacement": 12 + } + }, + "packages": [ + { + "name": "purescript-arrays", + "checkout": "/private/tmp/ps-pkgs/purescript-arrays", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "tag": "v7.3.0", + "remote": "https://github.com/purescript/purescript-arrays.git" + }, + { + "name": "purescript-bifunctors", + "checkout": "/private/tmp/ps-pkgs/purescript-bifunctors", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "tag": "v6.1.0", + "remote": "https://github.com/purescript/purescript-bifunctors.git" + }, + { + "name": "purescript-const", + "checkout": "/private/tmp/ps-pkgs/purescript-const", + "commit": "ab9570cf2b6e67f7e441178211db1231cfd75c37", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-const.git" + }, + { + "name": "purescript-contravariant", + "checkout": "/private/tmp/ps-pkgs/purescript-contravariant", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-contravariant.git" + }, + { + "name": "purescript-control", + "checkout": "/private/tmp/ps-pkgs/purescript-control", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-control.git" + }, + { + "name": "purescript-distributive", + "checkout": "/private/tmp/ps-pkgs/purescript-distributive", + "commit": "6005e513642e855ebf6f884d24a35c2803ca252a", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-distributive.git" + }, + { + "name": "purescript-either", + "checkout": "/private/tmp/ps-pkgs/purescript-either", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "tag": "v6.1.0", + "remote": "https://github.com/purescript/purescript-either.git" + }, + { + "name": "purescript-enums", + "checkout": "/private/tmp/ps-pkgs/purescript-enums", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-enums.git" + }, + { + "name": "purescript-exists", + "checkout": "/private/tmp/ps-pkgs/purescript-exists", + "commit": "f765b4ace7869c27b9c05949e18c843881f9173b", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-exists.git" + }, + { + "name": "purescript-filterable", + "checkout": "/private/tmp/ps-pkgs/purescript-filterable", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "tag": "v5.0.0", + "remote": "https://github.com/purescript/purescript-filterable.git" + }, + { + "name": "purescript-foldable-traversable", + "checkout": "/private/tmp/ps-pkgs/purescript-foldable-traversable", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-foldable-traversable.git" + }, + { + "name": "purescript-functions", + "checkout": "/private/tmp/ps-pkgs/purescript-functions", + "commit": "f626f20580483977c5b27a01aac6471e28aff367", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-functions.git" + }, + { + "name": "purescript-functors", + "checkout": "/private/tmp/ps-pkgs/purescript-functors", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "tag": "v5.0.0", + "remote": "https://github.com/purescript/purescript-functors.git" + }, + { + "name": "purescript-gen", + "checkout": "/private/tmp/ps-pkgs/purescript-gen", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "tag": "v4.0.0", + "remote": "https://github.com/purescript/purescript-gen.git" + }, + { + "name": "purescript-identity", + "checkout": "/private/tmp/ps-pkgs/purescript-identity", + "commit": "ef6768f8a52ab0bc943a85f5761ba07c257f639f", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-identity.git" + }, + { + "name": "purescript-integers", + "checkout": "/private/tmp/ps-pkgs/purescript-integers", + "commit": "54d712b25c594833083d15dc9ff2418eb9c52822", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-integers.git" + }, + { + "name": "purescript-invariant", + "checkout": "/private/tmp/ps-pkgs/purescript-invariant", + "commit": "1d2a196d51e90623adb88496c2cfd759c6736894", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-invariant.git" + }, + { + "name": "purescript-lazy", + "checkout": "/private/tmp/ps-pkgs/purescript-lazy", + "commit": "48347841226b27af5205a1a8ec71e27a93ce86fd", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-lazy.git" + }, + { + "name": "purescript-lists", + "checkout": "/private/tmp/ps-pkgs/purescript-lists", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-lists.git" + }, + { + "name": "purescript-maybe", + "checkout": "/private/tmp/ps-pkgs/purescript-maybe", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-maybe.git" + }, + { + "name": "purescript-newtype", + "checkout": "/private/tmp/ps-pkgs/purescript-newtype", + "commit": "29d8e6dd77aec2c975c948364ec3faf26e14ee7b", + "tag": "v5.0.0", + "remote": "https://github.com/purescript/purescript-newtype.git" + }, + { + "name": "purescript-nonempty", + "checkout": "/private/tmp/ps-pkgs/purescript-nonempty", + "commit": "28150ecc7419238b187abd609a92a645273348bb", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-nonempty.git" + }, + { + "name": "purescript-numbers", + "checkout": "/private/tmp/ps-pkgs/purescript-numbers", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "tag": "v9.0.1", + "remote": "https://github.com/purescript/purescript-numbers.git" + }, + { + "name": "purescript-ordered-collections", + "checkout": "/private/tmp/ps-pkgs/purescript-ordered-collections", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "tag": "v3.2.0", + "remote": "https://github.com/purescript/purescript-ordered-collections.git" + }, + { + "name": "purescript-orders", + "checkout": "/private/tmp/ps-pkgs/purescript-orders", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-orders.git" + }, + { + "name": "purescript-partial", + "checkout": "/private/tmp/ps-pkgs/purescript-partial", + "commit": "0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec", + "tag": "v4.0.0", + "remote": "https://github.com/purescript/purescript-partial.git" + }, + { + "name": "purescript-profunctor", + "checkout": "/private/tmp/ps-pkgs/purescript-profunctor", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-profunctor.git" + }, + { + "name": "purescript-refs", + "checkout": "/private/tmp/ps-pkgs/purescript-refs", + "commit": "f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-refs.git" + }, + { + "name": "purescript-safe-coerce", + "checkout": "/private/tmp/ps-pkgs/purescript-safe-coerce", + "commit": "7fa799ae80a38b8d948efcb52608e58e198b3da7", + "tag": "v2.0.0", + "remote": "https://github.com/purescript/purescript-safe-coerce.git" + }, + { + "name": "purescript-st", + "checkout": "/private/tmp/ps-pkgs/purescript-st", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "tag": "v6.2.0", + "remote": "https://github.com/purescript/purescript-st.git" + }, + { + "name": "purescript-strings", + "checkout": "/private/tmp/ps-pkgs/purescript-strings", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-strings.git" + }, + { + "name": "purescript-tailrec", + "checkout": "/private/tmp/ps-pkgs/purescript-tailrec", + "commit": "5661a10afbd4849bd2e45139ea567beb40b20f9f", + "tag": "v6.1.0", + "remote": "https://github.com/purescript/purescript-tailrec.git" + }, + { + "name": "purescript-tuples", + "checkout": "/private/tmp/ps-pkgs/purescript-tuples", + "commit": "4f52da2729b448c8564369378f1232d8d2dc1d8b", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-tuples.git" + }, + { + "name": "purescript-type-equality", + "checkout": "/private/tmp/ps-pkgs/purescript-type-equality", + "commit": "0525b7d39e0fbd81b4209518139fb8ab02695774", + "tag": "v4.0.1", + "remote": "https://github.com/purescript/purescript-type-equality.git" + }, + { + "name": "purescript-typelevel-prelude", + "checkout": "/private/tmp/ps-pkgs/purescript-typelevel-prelude", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "tag": "v7.0.0", + "remote": "https://github.com/purescript/purescript-typelevel-prelude.git" + }, + { + "name": "purescript-unfoldable", + "checkout": "/private/tmp/ps-pkgs/purescript-unfoldable", + "commit": "493dfe04ed590e20d8f69079df2f58486882748d", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-unfoldable.git" + }, + { + "name": "purescript-unsafe-coerce", + "checkout": "/private/tmp/ps-pkgs/purescript-unsafe-coerce", + "commit": "ab956f82e66e633f647fb3098e8ddd3ec58d689f", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-unsafe-coerce.git" + }, + { + "name": "purescript-prelude", + "checkout": "/private/tmp/purescript-prelude", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "tag": "v6.0.1", + "remote": "https://github.com/purescript/purescript-prelude.git" + }, + { + "name": "purescript-assert", + "checkout": "/private/tmp/psrs-stdlib-audit-20261006/upstream/purescript-assert", + "commit": "27c0edb57d2ee497eb5fab664f5601c35b613eda", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-assert.git" + }, + { + "name": "purescript-console", + "checkout": "/private/tmp/psrs-stdlib-audit-20261006/upstream/purescript-console", + "commit": "3b83d7b792d03872afeea5e62b4f686ab0f09842", + "tag": "v6.0.0", + "remote": "https://github.com/purescript/purescript-console.git" + }, + { + "name": "purescript-effect", + "checkout": "/private/tmp/psrs-stdlib-audit-20261006/upstream/purescript-effect", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "tag": "v4.0.0", + "remote": "https://github.com/purescript/purescript-effect.git" + } + ], + "modules": [ + { + "path": "Control/Alt.purs", + "vendored_sha256": "f02098c849efebd9eaeff8340215637a6152db97b10743a86dec6fae149061a1", + "vendored_lines": 42, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "f02098c849efebd9eaeff8340215637a6152db97b10743a86dec6fae149061a1", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Alt.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Alternative.purs", + "vendored_sha256": "86e1c20be4b0d570377b607f53fdbce0c642065973b79b9211883dc2b9d9b329", + "vendored_lines": 50, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "86e1c20be4b0d570377b607f53fdbce0c642065973b79b9211883dc2b9d9b329", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Alternative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Applicative.purs", + "vendored_sha256": "4cf9abb5b98e7569c66375a725ce3815c57f020f1dc0513fc4bd853cd70b567b", + "vendored_lines": 70, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "4cf9abb5b98e7569c66375a725ce3815c57f020f1dc0513fc4bd853cd70b567b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Applicative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Apply.purs", + "vendored_sha256": "02712ac645e851672d659d9b21171514b6d727efa7de08461399d3e7e581859b", + "vendored_lines": 104, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "02712ac645e851672d659d9b21171514b6d727efa7de08461399d3e7e581859b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Apply.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "arrayApply", + "line": 63, + "declaration": "foreign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Biapplicative.purs", + "vendored_sha256": "5c3baecdf32b1e0eb8c871de70eac69aa558b2dca8710b7b3d84badb20ef00bb", + "vendored_lines": 12, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "5c3baecdf32b1e0eb8c871de70eac69aa558b2dca8710b7b3d84badb20ef00bb", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Control/Biapplicative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Biapply.purs", + "vendored_sha256": "e2adb06728bb1a789579e3876c0a3894f1cd3ee7e5acef3268a13023a1733de0", + "vendored_lines": 59, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "e2adb06728bb1a789579e3876c0a3894f1cd3ee7e5acef3268a13023a1733de0", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Control/Biapply.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Bind.purs", + "vendored_sha256": "ea03e5ffa8c55c101018ceb9bf19fca9af792b49113a73be4a85867ef2c022f7", + "vendored_lines": 150, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "ea03e5ffa8c55c101018ceb9bf19fca9af792b49113a73be4a85867ef2c022f7", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Bind.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "arrayBind", + "line": 97, + "declaration": "foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Category.purs", + "vendored_sha256": "9cd6a331c6e9a7e17f35adb8fd11ba9fbe4fd2034eed34979d9cfbef68fe4230", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9cd6a331c6e9a7e17f35adb8fd11ba9fbe4fd2034eed34979d9cfbef68fe4230", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Category.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Comonad.purs", + "vendored_sha256": "8ddf03de6841c4e570432c7186445ef912d9a63d1eb272e668657ab73d981521", + "vendored_lines": 21, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "8ddf03de6841c4e570432c7186445ef912d9a63d1eb272e668657ab73d981521", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Comonad.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Extend.purs", + "vendored_sha256": "20d5e8394e1e755187e594cda0a3f63147fa69f703e18d8b99244d59c55d2900", + "vendored_lines": 59, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "20d5e8394e1e755187e594cda0a3f63147fa69f703e18d8b99244d59c55d2900", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Extend.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "arrayExtend", + "line": 30, + "declaration": "foreign import arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Lazy.purs", + "vendored_sha256": "05fce3e86c1c1b409f863368edb7991894c2c0d83ce99cdf7a3f84cdc30e9d0a", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "05fce3e86c1c1b409f863368edb7991894c2c0d83ce99cdf7a3f84cdc30e9d0a", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Lazy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Gen/Class.purs", + "vendored_sha256": "88fc916494c75e3309471a0852d0c740691570d68dd9dbb92ed4547e9e20f17a", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-gen", + "tag": "v4.0.0", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "upstream_sha256": "88fc916494c75e3309471a0852d0c740691570d68dd9dbb92ed4547e9e20f17a", + "upstream_url": "https://github.com/purescript/purescript-gen/blob/9fbcc2a1261c32e30d79c5418edef4d96fe76931/src/Control/Monad/Gen/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Gen/Common.purs", + "vendored_sha256": "d31ab1b6246acefd0e92f320483d413861e5727de6429d1b4ca391f8120e89a4", + "vendored_lines": 67, + "self_recursions": [], + "package": "purescript-gen", + "tag": "v4.0.0", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "upstream_sha256": "d31ab1b6246acefd0e92f320483d413861e5727de6429d1b4ca391f8120e89a4", + "upstream_url": "https://github.com/purescript/purescript-gen/blob/9fbcc2a1261c32e30d79c5418edef4d96fe76931/src/Control/Monad/Gen/Common.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Gen.purs", + "vendored_sha256": "1af7bc60432e7fb6f3e6e75da3b78be19bc2d1ad7e9cfcdcfcba4446ec317f1b", + "vendored_lines": 132, + "self_recursions": [], + "package": "purescript-gen", + "tag": "v4.0.0", + "commit": "9fbcc2a1261c32e30d79c5418edef4d96fe76931", + "upstream_sha256": "1af7bc60432e7fb6f3e6e75da3b78be19bc2d1ad7e9cfcdcfcba4446ec317f1b", + "upstream_url": "https://github.com/purescript/purescript-gen/blob/9fbcc2a1261c32e30d79c5418edef4d96fe76931/src/Control/Monad/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/Rec/Class.purs", + "vendored_sha256": "fd2ea9d0000c0194b78949bcaf9c931dfc12c92de322f0cadf73d566c994ea2f", + "vendored_lines": 191, + "self_recursions": [], + "package": "purescript-tailrec", + "tag": "v6.1.0", + "commit": "5661a10afbd4849bd2e45139ea567beb40b20f9f", + "upstream_sha256": "fd2ea9d0000c0194b78949bcaf9c931dfc12c92de322f0cadf73d566c994ea2f", + "upstream_url": "https://github.com/purescript/purescript-tailrec/blob/5661a10afbd4849bd2e45139ea567beb40b20f9f/src/Control/Monad/Rec/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Class.purs", + "vendored_sha256": "227bf813cc68b69b167ade39f2531d0ba45dc259252001bb97758e08bc93247d", + "vendored_lines": 17, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "227bf813cc68b69b167ade39f2531d0ba45dc259252001bb97758e08bc93247d", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Global.purs", + "vendored_sha256": "4cb7ab62ecd6c6dfacfce32920bf5d9a3dc0f7ce7d9a25a16b453d0a4fc0f9e3", + "vendored_lines": 18, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "4cb7ab62ecd6c6dfacfce32920bf5d9a3dc0f7ce7d9a25a16b453d0a4fc0f9e3", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Global.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Internal.purs", + "vendored_sha256": "00159fcd8f3fa41d7ba5b50c596043bc46859f95f8d877b9ff18dbc37c7fad99", + "vendored_lines": 136, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "00159fcd8f3fa41d7ba5b50c596043bc46859f95f8d877b9ff18dbc37c7fad99", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "map_", + "line": 38, + "declaration": "foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pure_", + "line": 40, + "declaration": "foreign import pure_ :: forall r a. a -> ST r a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "bind_", + "line": 42, + "declaration": "foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "run", + "line": 89, + "declaration": "foreign import run :: forall a. (forall r. ST r a) -> a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "while", + "line": 96, + "declaration": "foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "for", + "line": 102, + "declaration": "foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "foreach", + "line": 108, + "declaration": "foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "new", + "line": 117, + "declaration": "foreign import new :: forall a r. a -> ST r (STRef r a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "read", + "line": 120, + "declaration": "foreign import read :: forall a r. STRef r a -> ST r a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "modifyImpl", + "line": 128, + "declaration": "foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "write", + "line": 136, + "declaration": "foreign import write :: forall a r. a -> STRef r a -> ST r a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Ref.purs", + "vendored_sha256": "cd155ad39db037f2b26d422461da697bc3b7b5fe9bfc93702df55cba38158d3a", + "vendored_lines": 3, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "cd155ad39db037f2b26d422461da697bc3b7b5fe9bfc93702df55cba38158d3a", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Ref.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST/Uncurried.purs", + "vendored_sha256": "bd2411e5e23d8b446ef2f6b924422071eb99c6c629395df21eb9821a341988a6", + "vendored_lines": 101, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "bd2411e5e23d8b446ef2f6b924422071eb99c6c629395df21eb9821a341988a6", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST/Uncurried.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "mkSTFn1", + "line": 61, + "declaration": "foreign import mkSTFn1 :: forall a t r. (a -> ST t r) -> STFn1 a t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn2", + "line": 63, + "declaration": "foreign import mkSTFn2 :: forall a b t r. (a -> b -> ST t r) -> STFn2 a b t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn3", + "line": 65, + "declaration": "foreign import mkSTFn3 :: forall a b c t r. (a -> b -> c -> ST t r) -> STFn3 a b c t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn4", + "line": 67, + "declaration": "foreign import mkSTFn4 :: forall a b c d t r. (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn5", + "line": 69, + "declaration": "foreign import mkSTFn5 :: forall a b c d e t r. (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn6", + "line": 71, + "declaration": "foreign import mkSTFn6 :: forall a b c d e f t r. (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn7", + "line": 73, + "declaration": "foreign import mkSTFn7 :: forall a b c d e f g t r. (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn8", + "line": 75, + "declaration": "foreign import mkSTFn8 :: forall a b c d e f g h t r. (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn9", + "line": 77, + "declaration": "foreign import mkSTFn9 :: forall a b c d e f g h i t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkSTFn10", + "line": 79, + "declaration": "foreign import mkSTFn10 :: forall a b c d e f g h i j t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn1", + "line": 82, + "declaration": "foreign import runSTFn1 :: forall a t r. STFn1 a t r -> a -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn2", + "line": 84, + "declaration": "foreign import runSTFn2 :: forall a b t r. STFn2 a b t r -> a -> b -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn3", + "line": 86, + "declaration": "foreign import runSTFn3 :: forall a b c t r. STFn3 a b c t r -> a -> b -> c -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn4", + "line": 88, + "declaration": "foreign import runSTFn4 :: forall a b c d t r. STFn4 a b c d t r -> a -> b -> c -> d -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn5", + "line": 90, + "declaration": "foreign import runSTFn5 :: forall a b c d e t r. STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn6", + "line": 92, + "declaration": "foreign import runSTFn6 :: forall a b c d e f t r. STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn7", + "line": 94, + "declaration": "foreign import runSTFn7 :: forall a b c d e f g t r. STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn8", + "line": 96, + "declaration": "foreign import runSTFn8 :: forall a b c d e f g h t r. STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn9", + "line": 98, + "declaration": "foreign import runSTFn9 :: forall a b c d e f g h i t r. STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runSTFn10", + "line": 100, + "declaration": "foreign import runSTFn10 :: forall a b c d e f g h i j t r. STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad/ST.purs", + "vendored_sha256": "316ee75613cd7960cdaefdf6c26613c14badcc8a06ee2405617ed089072598a0", + "vendored_lines": 3, + "self_recursions": [], + "package": "purescript-st", + "tag": "v6.2.0", + "commit": "fc2fe2972bb12e6a2bd3b295baf01577240c23ac", + "upstream_sha256": "316ee75613cd7960cdaefdf6c26613c14badcc8a06ee2405617ed089072598a0", + "upstream_url": "https://github.com/purescript/purescript-st/blob/fc2fe2972bb12e6a2bd3b295baf01577240c23ac/src/Control/Monad/ST.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Monad.purs", + "vendored_sha256": "0bad91df889b370157f300b5e5e0241272d9149380a6c5322a81af58a6fdc67c", + "vendored_lines": 86, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "0bad91df889b370157f300b5e5e0241272d9149380a6c5322a81af58a6fdc67c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Monad.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/MonadPlus.purs", + "vendored_sha256": "4a5f2eeb965af319ffb1427c1571235ca3de44881e19aa83f2cb12e8404df68f", + "vendored_lines": 32, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "4a5f2eeb965af319ffb1427c1571235ca3de44881e19aa83f2cb12e8404df68f", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/MonadPlus.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Plus.purs", + "vendored_sha256": "308ba7c0a3a65e9b81cf2cc6f0a7d8e4f77043c1c2c481c04b5ab22ccf991f19", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "308ba7c0a3a65e9b81cf2cc6f0a7d8e4f77043c1c2c481c04b5ab22ccf991f19", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Control/Plus.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Control/Semigroupoid.purs", + "vendored_sha256": "aefe8332e035b2f990e25981ac56abb63a71efed5d5e986657483dd51c04834a", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "aefe8332e035b2f990e25981ac56abb63a71efed5d5e986657483dd51c04834a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Control/Semigroupoid.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/NonEmpty/Internal.purs", + "vendored_sha256": "59ce6b9e860ccdd2a089fb055008b629cd9362bb3a7f703e6bd1fb2f7a642ae6", + "vendored_lines": 84, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "59ce6b9e860ccdd2a089fb055008b629cd9362bb3a7f703e6bd1fb2f7a642ae6", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "foldr1Impl", + "line": 75, + "declaration": "foreign import foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "foldl1Impl", + "line": 76, + "declaration": "foreign import foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "traverse1Impl", + "line": 78, + "declaration": "foreign import traverse1Impl :: forall m a b . Fn3 (forall a' b'. (m (a' -> b') -> m a' -> m b')) (forall a' b'. (a' -> b') -> m a' -> m b') (a -> m b) (NonEmptyArray a -> m (NonEmptyArray b))", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/NonEmpty.purs", + "vendored_sha256": "4e42eb0655fef616939cdf91f8e87b8c5e3581f34a538a2066cd9a644302b8d4", + "vendored_lines": 598, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "4e42eb0655fef616939cdf91f8e87b8c5e3581f34a538a2066cd9a644302b8d4", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/Partial.purs", + "vendored_sha256": "21c2d565d728a650e1f0e3521570c518434a97aaad087893237d20c18fda8184", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "21c2d565d728a650e1f0e3521570c518434a97aaad087893237d20c18fda8184", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/Partial.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/ST/Iterator.purs", + "vendored_sha256": "96dd803b0c983a56714d1dbbf6d86193c245660e6acb4faffa2cec6f6e1d2583", + "vendored_lines": 80, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "96dd803b0c983a56714d1dbbf6d86193c245660e6acb4faffa2cec6f6e1d2583", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST/Iterator.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/ST/Partial.purs", + "vendored_sha256": "dd9dfaae9bd0942eb341324035ed96880dcf2e167033ef8164d700270af5957a", + "vendored_lines": 36, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "dd9dfaae9bd0942eb341324035ed96880dcf2e167033ef8164d700270af5957a", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST/Partial.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "peekImpl", + "line": 24, + "declaration": "foreign import peekImpl :: forall h a. STFn2 Int (STArray h a) h a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pokeImpl", + "line": 36, + "declaration": "foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array/ST.purs", + "vendored_sha256": "4af1b59e242a89e3e5aa427c4486fce587173b3008f369d9d00de398a84ea4dc", + "vendored_lines": 262, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "4af1b59e242a89e3e5aa427c4486fce587173b3008f369d9d00de398a84ea4dc", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array/ST.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeFreezeImpl", + "line": 78, + "declaration": "foreign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unsafeThawImpl", + "line": 85, + "declaration": "foreign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "new", + "line": 88, + "declaration": "foreign import new :: forall h a. ST h (STArray h a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "thawImpl", + "line": 97, + "declaration": "foreign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "cloneImpl", + "line": 106, + "declaration": "foreign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "shiftImpl", + "line": 117, + "declaration": "foreign import shiftImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "sortByImpl", + "line": 134, + "declaration": "foreign import sortByImpl :: forall a h . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "freezeImpl", + "line": 155, + "declaration": "foreign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "peekImpl", + "line": 165, + "declaration": "foreign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pokeImpl", + "line": 176, + "declaration": "foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "lengthImpl", + "line": 178, + "declaration": "foreign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "popImpl", + "line": 188, + "declaration": "foreign import popImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pushImpl", + "line": 197, + "declaration": "foreign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pushAllImpl", + "line": 208, + "declaration": "foreign import pushAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unshiftAllImpl", + "line": 226, + "declaration": "foreign import unshiftAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "spliceImpl", + "line": 248, + "declaration": "foreign import spliceImpl :: forall h a . STFn4 Int Int (Array a) (STArray h a) h (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toAssocArrayImpl", + "line": 260, + "declaration": "foreign import toAssocArrayImpl :: forall h a . STFn1 (STArray h a) h (Array (Assoc a))", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Array.purs", + "vendored_sha256": "d336825bf660ee79f03c559eaa1a22f41ec5a194b8cce79c5b24877160c32455", + "vendored_lines": 1371, + "self_recursions": [], + "package": "purescript-arrays", + "tag": "v7.3.0", + "commit": "6554b3d9c1ebb871477ffa88c2f3850d714b42b0", + "upstream_sha256": "d336825bf660ee79f03c559eaa1a22f41ec5a194b8cce79c5b24877160c32455", + "upstream_url": "https://github.com/purescript/purescript-arrays/blob/6554b3d9c1ebb871477ffa88c2f3850d714b42b0/src/Data/Array.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "fromFoldableImpl", + "line": 177, + "declaration": "foreign import fromFoldableImpl :: forall f a . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "rangeImpl", + "line": 195, + "declaration": "foreign import rangeImpl :: Fn2 Int Int (Array Int)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "replicateImpl", + "line": 204, + "declaration": "foreign import replicateImpl :: forall a. Fn2 Int a (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "length", + "line": 243, + "declaration": "foreign import length :: forall a. Array a -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unconsImpl", + "line": 373, + "declaration": "foreign import unconsImpl :: forall a b . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "indexImpl", + "line": 405, + "declaration": "foreign import indexImpl :: forall a . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "findMapImpl", + "line": 462, + "declaration": "foreign import findMapImpl :: forall a b . Fn4 (forall c. Maybe c) (forall c. Maybe c -> Boolean) (a -> Maybe b) (Array a) (Maybe b)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "findIndexImpl", + "line": 481, + "declaration": "foreign import findIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "findLastIndexImpl", + "line": 500, + "declaration": "foreign import findLastIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_insertAt", + "line": 520, + "declaration": "foreign import _insertAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a))", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_deleteAt", + "line": 541, + "declaration": "foreign import _deleteAt :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) Int (Array a) (Maybe (Array a))", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_updateAt", + "line": 561, + "declaration": "foreign import _updateAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a))", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "reverse", + "line": 642, + "declaration": "foreign import reverse :: forall a. Array a -> Array a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "concat", + "line": 650, + "declaration": "foreign import concat :: forall a. Array (Array a) -> Array a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "filterImpl", + "line": 673, + "declaration": "foreign import filterImpl :: forall a . Fn2 (a -> Boolean) (Array a) (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "partitionImpl", + "line": 692, + "declaration": "foreign import partitionImpl :: forall a . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a }", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "scanlImpl", + "line": 857, + "declaration": "foreign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "scanrImpl", + "line": 870, + "declaration": "foreign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "sortByImpl", + "line": 914, + "declaration": "foreign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "sliceImpl", + "line": 932, + "declaration": "foreign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "zipWithImpl", + "line": 1253, + "declaration": "foreign import zipWithImpl :: forall a b c . Fn3 (a -> b -> c) (Array a) (Array b) (Array c)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "anyImpl", + "line": 1322, + "declaration": "foreign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "allImpl", + "line": 1336, + "declaration": "foreign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unsafeIndexImpl", + "line": 1371, + "declaration": "foreign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bifoldable.purs", + "vendored_sha256": "ba0f8f91040f1e49a0ef10ad012eb9be475fa820332eb3d6bca9345c1a3c4446", + "vendored_lines": 198, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "ba0f8f91040f1e49a0ef10ad012eb9be475fa820332eb3d6bca9345c1a3c4446", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Bifoldable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bifunctor/Join.purs", + "vendored_sha256": "5db9d1533e678809804465de95637fa980d264314428d25f18e10b673bba1308", + "vendored_lines": 31, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "5db9d1533e678809804465de95637fa980d264314428d25f18e10b673bba1308", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Data/Bifunctor/Join.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bifunctor.purs", + "vendored_sha256": "00c91e7e32934e59b1196a793247218670ed5ad6c69acb8ef4eec27db63a8e1a", + "vendored_lines": 46, + "self_recursions": [], + "package": "purescript-bifunctors", + "tag": "v6.1.0", + "commit": "d35e0f1e5a33d59a226859b6bc53075fb58ced87", + "upstream_sha256": "00c91e7e32934e59b1196a793247218670ed5ad6c69acb8ef4eec27db63a8e1a", + "upstream_url": "https://github.com/purescript/purescript-bifunctors/blob/d35e0f1e5a33d59a226859b6bc53075fb58ced87/src/Data/Bifunctor.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bitraversable.purs", + "vendored_sha256": "1f6eae4a9fb4457664d7fa4c822b451d15a1d320a28b12f81010622885e2cb84", + "vendored_lines": 136, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "1f6eae4a9fb4457664d7fa4c822b451d15a1d320a28b12f81010622885e2cb84", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Bitraversable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Boolean.purs", + "vendored_sha256": "cbffb99db81cebc7626ab43b43f785f62ffe8c59b3781174907b05d8fb171eb2", + "vendored_lines": 10, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "cbffb99db81cebc7626ab43b43f785f62ffe8c59b3781174907b05d8fb171eb2", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Boolean.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/BooleanAlgebra.purs", + "vendored_sha256": "cc5bcc84af3a96675d3b8ee03b7754a818dd0dd49d20248cf0e17c4793f5ba96", + "vendored_lines": 43, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "cc5bcc84af3a96675d3b8ee03b7754a818dd0dd49d20248cf0e17c4793f5ba96", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/BooleanAlgebra.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bounded/Generic.purs", + "vendored_sha256": "110cac55f2eadb6a6614397a31b5c167e20983d3ccdce89647ee975e24058f3f", + "vendored_lines": 56, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "110cac55f2eadb6a6614397a31b5c167e20983d3ccdce89647ee975e24058f3f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Bounded.purs", + "vendored_sha256": "f67cb72dce353b0eecdd53214a76f879e52eba6335f1305c2ea744063c913d0a", + "vendored_lines": 105, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "f67cb72dce353b0eecdd53214a76f879e52eba6335f1305c2ea744063c913d0a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Bounded.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "topInt", + "line": 40, + "declaration": "foreign import topInt :: Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "bottomInt", + "line": 41, + "declaration": "foreign import bottomInt :: Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "topChar", + "line": 48, + "declaration": "foreign import topChar :: Char", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "bottomChar", + "line": 49, + "declaration": "foreign import bottomChar :: Char", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "topNumber", + "line": 59, + "declaration": "foreign import topNumber :: Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "bottomNumber", + "line": 60, + "declaration": "foreign import bottomNumber :: Number", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Char/Gen.purs", + "vendored_sha256": "3ddf70117671935799e26aade08e1f932221200ab98a1b50c90ad50c090a6ec2", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "3ddf70117671935799e26aade08e1f932221200ab98a1b50c90ad50c090a6ec2", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/Char/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Char.purs", + "vendored_sha256": "3923ba1cf2abddfc3d4bebb1a2f84f198aa9b23b1fae8e68a281f2188cc79ee7", + "vendored_lines": 16, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "3923ba1cf2abddfc3d4bebb1a2f84f198aa9b23b1fae8e68a281f2188cc79ee7", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/Char.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/CommutativeRing.purs", + "vendored_sha256": "bcb4f94840a1544d53287ef6d44e51f8af66119f12910d3678f101a78a7fea05", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "bcb4f94840a1544d53287ef6d44e51f8af66119f12910d3678f101a78a7fea05", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/CommutativeRing.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Compactable.purs", + "vendored_sha256": "431fbe83796ed62eecb1e3311a7f4a7e5601aee50c611fcb11eff5f29bfe143a", + "vendored_lines": 164, + "self_recursions": [], + "package": "purescript-filterable", + "tag": "v5.0.0", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "upstream_sha256": "431fbe83796ed62eecb1e3311a7f4a7e5601aee50c611fcb11eff5f29bfe143a", + "upstream_url": "https://github.com/purescript/purescript-filterable/blob/7c5b8c72779997f2b17d12ce478ff81e7ddda285/src/Data/Compactable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Comparison.purs", + "vendored_sha256": "b94e588dbd3b667ef023394842ed4d0e2afb10b8b315173f5e1095fc3094fc02", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "b94e588dbd3b667ef023394842ed4d0e2afb10b8b315173f5e1095fc3094fc02", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Comparison.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Const.purs", + "vendored_sha256": "a6e5d9429e810f5b834720a35e3103c4f271ca6401b19e7f7f8250e96cb04828", + "vendored_lines": 63, + "self_recursions": [], + "package": "purescript-const", + "tag": "v6.0.0", + "commit": "ab9570cf2b6e67f7e441178211db1231cfd75c37", + "upstream_sha256": "a6e5d9429e810f5b834720a35e3103c4f271ca6401b19e7f7f8250e96cb04828", + "upstream_url": "https://github.com/purescript/purescript-const/blob/ab9570cf2b6e67f7e441178211db1231cfd75c37/src/Data/Const.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Decidable.purs", + "vendored_sha256": "d3260262715019947e3db7351810c3af103bd86cc4e94dcca3a28c22a3d3072a", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "d3260262715019947e3db7351810c3af103bd86cc4e94dcca3a28c22a3d3072a", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Decidable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Decide.purs", + "vendored_sha256": "0301661ba4052b57c193b57cac94dd78ebdb40ae91eb1d182637e6a68d8c9718", + "vendored_lines": 42, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "0301661ba4052b57c193b57cac94dd78ebdb40ae91eb1d182637e6a68d8c9718", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Decide.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Distributive.purs", + "vendored_sha256": "47bf3b62d71dbeef667007924b75ea18cc4179ef1f111a359d19463e1fa49279", + "vendored_lines": 67, + "self_recursions": [], + "package": "purescript-distributive", + "tag": "v6.0.0", + "commit": "6005e513642e855ebf6f884d24a35c2803ca252a", + "upstream_sha256": "47bf3b62d71dbeef667007924b75ea18cc4179ef1f111a359d19463e1fa49279", + "upstream_url": "https://github.com/purescript/purescript-distributive/blob/6005e513642e855ebf6f884d24a35c2803ca252a/src/Data/Distributive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Divide.purs", + "vendored_sha256": "cc9f771f056da1b686569a299b46fd0d09be4544bda5e95a01551ce4e0f2d021", + "vendored_lines": 46, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "cc9f771f056da1b686569a299b46fd0d09be4544bda5e95a01551ce4e0f2d021", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Divide.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Divisible.purs", + "vendored_sha256": "fe939175ea5070c0233b11fbf6dd035bae54a6e590dc47253977bbfba7beae82", + "vendored_lines": 25, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "fe939175ea5070c0233b11fbf6dd035bae54a6e590dc47253977bbfba7beae82", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Divisible.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/DivisionRing.purs", + "vendored_sha256": "be3721f83db50d4d1bcc6f2cba1cb30e2be39b376440e215c79ab0e0d7b688f5", + "vendored_lines": 55, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "be3721f83db50d4d1bcc6f2cba1cb30e2be39b376440e215c79ab0e0d7b688f5", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/DivisionRing.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Either/Inject.purs", + "vendored_sha256": "95f071e80bf9658d34b08093bc03ee3fbbb9ef6af3457ad4f203c396ea507e41", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-either", + "tag": "v6.1.0", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "upstream_sha256": "95f071e80bf9658d34b08093bc03ee3fbbb9ef6af3457ad4f203c396ea507e41", + "upstream_url": "https://github.com/purescript/purescript-either/blob/af655a04ed2fd694b6688af39ee20d7907ad0763/src/Data/Either/Inject.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Either/Nested.purs", + "vendored_sha256": "fa22a911e6c9f62dd7f1bfabfb98962824f75a7f5291e6fafc628dba658cb274", + "vendored_lines": 278, + "self_recursions": [], + "package": "purescript-either", + "tag": "v6.1.0", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "upstream_sha256": "fa22a911e6c9f62dd7f1bfabfb98962824f75a7f5291e6fafc628dba658cb274", + "upstream_url": "https://github.com/purescript/purescript-either/blob/af655a04ed2fd694b6688af39ee20d7907ad0763/src/Data/Either/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Either.purs", + "vendored_sha256": "047a8ae72c32cd064fddb773a739dc130c0cce615270d403491898fbf6c6f5d9", + "vendored_lines": 294, + "self_recursions": [], + "package": "purescript-either", + "tag": "v6.1.0", + "commit": "af655a04ed2fd694b6688af39ee20d7907ad0763", + "upstream_sha256": "047a8ae72c32cd064fddb773a739dc130c0cce615270d403491898fbf6c6f5d9", + "upstream_url": "https://github.com/purescript/purescript-either/blob/af655a04ed2fd694b6688af39ee20d7907ad0763/src/Data/Either.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Enum/Gen.purs", + "vendored_sha256": "3d7234b9dd417d2a31510cf22c691da3cfd0bb4a7bc2265c68cbae019dbcdc13", + "vendored_lines": 18, + "self_recursions": [], + "package": "purescript-enums", + "tag": "v6.0.1", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "upstream_sha256": "3d7234b9dd417d2a31510cf22c691da3cfd0bb4a7bc2265c68cbae019dbcdc13", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Enum/Generic.purs", + "vendored_sha256": "1c9eea073e25c24c7cca9455487ebec47f0072b1ecba7e2076e7da56fa473846", + "vendored_lines": 118, + "self_recursions": [], + "package": "purescript-enums", + "tag": "v6.0.1", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "upstream_sha256": "1c9eea073e25c24c7cca9455487ebec47f0072b1ecba7e2076e7da56fa473846", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Enum.purs", + "vendored_sha256": "a7ffaa7a8cc15c362852409f1aba80a5b7792d89353635d54317d43e864e5e9c", + "vendored_lines": 321, + "self_recursions": [], + "package": "purescript-enums", + "tag": "v6.0.1", + "commit": "cd373c580b69fdc00e412bddbc299adabe242cc5", + "upstream_sha256": "a7ffaa7a8cc15c362852409f1aba80a5b7792d89353635d54317d43e864e5e9c", + "upstream_url": "https://github.com/purescript/purescript-enums/blob/cd373c580b69fdc00e412bddbc299adabe242cc5/src/Data/Enum.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "toCharCode", + "line": 320, + "declaration": "foreign import toCharCode :: Char -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "fromCharCode", + "line": 321, + "declaration": "foreign import fromCharCode :: Int -> Char", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Eq/Generic.purs", + "vendored_sha256": "9cd6184fb35329e232a2b593e1e3404e89692b36b99104f800bfe23894627373", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9cd6184fb35329e232a2b593e1e3404e89692b36b99104f800bfe23894627373", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Eq.purs", + "vendored_sha256": "53036679ea014e3c452fce0ee8ce26f58de222cd88eed2586d6dd7dcea3fd872", + "vendored_lines": 115, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "53036679ea014e3c452fce0ee8ce26f58de222cd88eed2586d6dd7dcea3fd872", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "eqBooleanImpl", + "line": 77, + "declaration": "foreign import eqBooleanImpl :: Boolean -> Boolean -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "eqIntImpl", + "line": 78, + "declaration": "foreign import eqIntImpl :: Int -> Int -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "eqNumberImpl", + "line": 79, + "declaration": "foreign import eqNumberImpl :: Number -> Number -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "eqCharImpl", + "line": 80, + "declaration": "foreign import eqCharImpl :: Char -> Char -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "eqStringImpl", + "line": 81, + "declaration": "foreign import eqStringImpl :: String -> String -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "eqArrayImpl", + "line": 83, + "declaration": "foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Equivalence.purs", + "vendored_sha256": "82d547469f77f4be0ba5c8f151d623a12a2a3edaa3d7b65c7f01110ed696932f", + "vendored_lines": 31, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "82d547469f77f4be0ba5c8f151d623a12a2a3edaa3d7b65c7f01110ed696932f", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Equivalence.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/EuclideanRing.purs", + "vendored_sha256": "15d83e118a173ae91fff5b12152afdacc549c12da0a541602d0cf5d702fae863", + "vendored_lines": 100, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "15d83e118a173ae91fff5b12152afdacc549c12da0a541602d0cf5d702fae863", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/EuclideanRing.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "intDegree", + "line": 84, + "declaration": "foreign import intDegree :: Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "intDiv", + "line": 85, + "declaration": "foreign import intDiv :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "intMod", + "line": 86, + "declaration": "foreign import intMod :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "numDiv", + "line": 88, + "declaration": "foreign import numDiv :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Exists.purs", + "vendored_sha256": "74aec7e155ecd0bac49cacb3f87506223193a5f0ff4ae1dd0a8e134775d7794d", + "vendored_lines": 57, + "self_recursions": [], + "package": "purescript-exists", + "tag": "v6.0.0", + "commit": "f765b4ace7869c27b9c05949e18c843881f9173b", + "upstream_sha256": "74aec7e155ecd0bac49cacb3f87506223193a5f0ff4ae1dd0a8e134775d7794d", + "upstream_url": "https://github.com/purescript/purescript-exists/blob/f765b4ace7869c27b9c05949e18c843881f9173b/src/Data/Exists.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Field.purs", + "vendored_sha256": "a27a8bb18ff139cd8eb5c7512c9aa999050faad79f02727e285360b2cda5f06d", + "vendored_lines": 41, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "a27a8bb18ff139cd8eb5c7512c9aa999050faad79f02727e285360b2cda5f06d", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Field.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Filterable.purs", + "vendored_sha256": "459ef72163c124e3ea0f24a4682773ba8562dc9a1e8709a994eb3bd0aa3895bf", + "vendored_lines": 229, + "self_recursions": [], + "package": "purescript-filterable", + "tag": "v5.0.0", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "upstream_sha256": "459ef72163c124e3ea0f24a4682773ba8562dc9a1e8709a994eb3bd0aa3895bf", + "upstream_url": "https://github.com/purescript/purescript-filterable/blob/7c5b8c72779997f2b17d12ce478ff81e7ddda285/src/Data/Filterable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Foldable.purs", + "vendored_sha256": "5557319b5a97cf265d53cd68266d721b31f28de3240b10e7728adae8a2070052", + "vendored_lines": 471, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "5557319b5a97cf265d53cd68266d721b31f28de3240b10e7728adae8a2070052", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Foldable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "foldrArray", + "line": 135, + "declaration": "foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "foldlArray", + "line": 136, + "declaration": "foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/FoldableWithIndex.purs", + "vendored_sha256": "2e10b31b454a84f9597ddb15e43fcfa5bfa84cae8cc5e8b6bbbc5a2018755944", + "vendored_lines": 370, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "2e10b31b454a84f9597ddb15e43fcfa5bfa84cae8cc5e8b6bbbc5a2018755944", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/FoldableWithIndex.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Function/Uncurried.purs", + "vendored_sha256": "4e210a49f64e1862cc8530bcbe661c350c964568bbfa2f79bbb1fbe394152d02", + "vendored_lines": 124, + "self_recursions": [], + "package": "purescript-functions", + "tag": "v6.0.0", + "commit": "f626f20580483977c5b27a01aac6471e28aff367", + "upstream_sha256": "4e210a49f64e1862cc8530bcbe661c350c964568bbfa2f79bbb1fbe394152d02", + "upstream_url": "https://github.com/purescript/purescript-functions/blob/f626f20580483977c5b27a01aac6471e28aff367/src/Data/Function/Uncurried.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "mkFn0", + "line": 59, + "declaration": "foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn2", + "line": 66, + "declaration": "foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn3", + "line": 69, + "declaration": "foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn4", + "line": 72, + "declaration": "foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn5", + "line": 75, + "declaration": "foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn6", + "line": 78, + "declaration": "foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn7", + "line": 81, + "declaration": "foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn8", + "line": 84, + "declaration": "foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn9", + "line": 87, + "declaration": "foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkFn10", + "line": 90, + "declaration": "foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn0", + "line": 93, + "declaration": "foreign import runFn0 :: forall a. Fn0 a -> a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn2", + "line": 100, + "declaration": "foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn3", + "line": 103, + "declaration": "foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn4", + "line": 106, + "declaration": "foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn5", + "line": 109, + "declaration": "foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn6", + "line": 112, + "declaration": "foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn7", + "line": 115, + "declaration": "foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn8", + "line": 118, + "declaration": "foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn9", + "line": 121, + "declaration": "foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runFn10", + "line": 124, + "declaration": "foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Function.purs", + "vendored_sha256": "2142b200f60953ac4fe648b765da7cf6cfb046e8600ffef3484a7f3e4f8f03b7", + "vendored_lines": 120, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "2142b200f60953ac4fe648b765da7cf6cfb046e8600ffef3484a7f3e4f8f03b7", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Function.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/App.purs", + "vendored_sha256": "2c90077463cc2deb82dc888dd7c6fc10fa465d444c7b48fa042b4a2d4e834711", + "vendored_lines": 56, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "2c90077463cc2deb82dc888dd7c6fc10fa465d444c7b48fa042b4a2d4e834711", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/App.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Clown.purs", + "vendored_sha256": "9e0ee4050d69d24a0965026576288b9742f1e77941b819d510e1317bbe1ca1c2", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "9e0ee4050d69d24a0965026576288b9742f1e77941b819d510e1317bbe1ca1c2", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Clown.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Compose.purs", + "vendored_sha256": "1ea6725c558c1d8424b8e8bf03331879bcc589ec95ef0208dea7dcb90861d202", + "vendored_lines": 58, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "1ea6725c558c1d8424b8e8bf03331879bcc589ec95ef0208dea7dcb90861d202", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Compose.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Contravariant.purs", + "vendored_sha256": "ecb01e255618d9b446bc72d042d10c44a84ce7b10df14f838e50fa49a8ddd4ab", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "ecb01e255618d9b446bc72d042d10c44a84ce7b10df14f838e50fa49a8ddd4ab", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Functor/Contravariant.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Coproduct/Inject.purs", + "vendored_sha256": "dfccf4433db792b3a1246b72b7aab69d39a593750c242a741a4adc92a012b743", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "dfccf4433db792b3a1246b72b7aab69d39a593750c242a741a4adc92a012b743", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Coproduct/Inject.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Coproduct/Nested.purs", + "vendored_sha256": "efd0e04c36996fd958425c21f3c6748cf3c08abf4ff014b09eca3687937e193c", + "vendored_lines": 273, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "efd0e04c36996fd958425c21f3c6748cf3c08abf4ff014b09eca3687937e193c", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Coproduct/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Coproduct.purs", + "vendored_sha256": "bdef394de4a506431d3397ed765e861daf47989882f1f8d97419edb312a62637", + "vendored_lines": 76, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "bdef394de4a506431d3397ed765e861daf47989882f1f8d97419edb312a62637", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Coproduct.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Costar.purs", + "vendored_sha256": "3bde423fa6f47a635e62c4a55fa4eb1ebbd32dcb5776b748bb4bc59b892c77b5", + "vendored_lines": 66, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "3bde423fa6f47a635e62c4a55fa4eb1ebbd32dcb5776b748bb4bc59b892c77b5", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Costar.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Flip.purs", + "vendored_sha256": "b3d31bfa23a05a6ed6c4185775bb45ff2e0c562cd9c95c711b1cf636459c153b", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "b3d31bfa23a05a6ed6c4185775bb45ff2e0c562cd9c95c711b1cf636459c153b", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Flip.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Invariant.purs", + "vendored_sha256": "070d432e594b5423ebd865d101dbddaf1bd64690917a6ebeabd559393c152f26", + "vendored_lines": 57, + "self_recursions": [], + "package": "purescript-invariant", + "tag": "v6.0.0", + "commit": "1d2a196d51e90623adb88496c2cfd759c6736894", + "upstream_sha256": "070d432e594b5423ebd865d101dbddaf1bd64690917a6ebeabd559393c152f26", + "upstream_url": "https://github.com/purescript/purescript-invariant/blob/1d2a196d51e90623adb88496c2cfd759c6736894/src/Data/Functor/Invariant.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Joker.purs", + "vendored_sha256": "3c32235123a30b6e38273bbfcf6cf50cef94d9a11e7da16e7ee3d7e0ed98cac4", + "vendored_lines": 60, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "3c32235123a30b6e38273bbfcf6cf50cef94d9a11e7da16e7ee3d7e0ed98cac4", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Joker.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Product/Nested.purs", + "vendored_sha256": "eabec66003663a5e64b64e6abf317a27e8660d5c09475bbd38d9219db0834580", + "vendored_lines": 112, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "eabec66003663a5e64b64e6abf317a27e8660d5c09475bbd38d9219db0834580", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Product/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Product.purs", + "vendored_sha256": "c43e912ffe484cfd0e01cafa143474e140f06a85c7177c9f2cc6b59b51d18a37", + "vendored_lines": 60, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "c43e912ffe484cfd0e01cafa143474e140f06a85c7177c9f2cc6b59b51d18a37", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Product.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor/Product2.purs", + "vendored_sha256": "80763924484595b34488d8cca7bd8e5d399aebc7a79442e1625d7ddbebec9c7c", + "vendored_lines": 40, + "self_recursions": [], + "package": "purescript-functors", + "tag": "v5.0.0", + "commit": "022ffd7a2a7ec12080314f3d217b400674a247b4", + "upstream_sha256": "80763924484595b34488d8cca7bd8e5d399aebc7a79442e1625d7ddbebec9c7c", + "upstream_url": "https://github.com/purescript/purescript-functors/blob/022ffd7a2a7ec12080314f3d217b400674a247b4/src/Data/Functor/Product2.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Functor.purs", + "vendored_sha256": "fc5b0cc22a6c4d96a5779eb629cb304cebaa910f03a77192628c131a867bbeb8", + "vendored_lines": 106, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "fc5b0cc22a6c4d96a5779eb629cb304cebaa910f03a77192628c131a867bbeb8", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Functor.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "arrayMap", + "line": 55, + "declaration": "foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/FunctorWithIndex.purs", + "vendored_sha256": "cdffaeb5485f7a5a12796b5db2a9a81b7212d50dacd6405a87bc3f57fbc15f6c", + "vendored_lines": 93, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "cdffaeb5485f7a5a12796b5db2a9a81b7212d50dacd6405a87bc3f57fbc15f6c", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/FunctorWithIndex.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "mapWithIndexArray", + "line": 38, + "declaration": "foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Generic/Rep.purs", + "vendored_sha256": "fc1e17e76bf53bf8dc86593ca2d27a77f921e8aa67bffcb6265fdc473736862d", + "vendored_lines": 62, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "fc1e17e76bf53bf8dc86593ca2d27a77f921e8aa67bffcb6265fdc473736862d", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Generic/Rep.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/HeytingAlgebra/Generic.purs", + "vendored_sha256": "c5022ab44881b51e4b62d06994d92f04b037ce97ff2c50054e4b90d91a463bbe", + "vendored_lines": 70, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "c5022ab44881b51e4b62d06994d92f04b037ce97ff2c50054e4b90d91a463bbe", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/HeytingAlgebra.purs", + "vendored_sha256": "797b9e8358e10691e93c8b1552723507fd12647441f90db11b01e35850bce75b", + "vendored_lines": 171, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "797b9e8358e10691e93c8b1552723507fd12647441f90db11b01e35850bce75b", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "boolConj", + "line": 103, + "declaration": "foreign import boolConj :: Boolean -> Boolean -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "boolDisj", + "line": 104, + "declaration": "foreign import boolDisj :: Boolean -> Boolean -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "boolNot", + "line": 105, + "declaration": "foreign import boolNot :: Boolean -> Boolean", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Identity.purs", + "vendored_sha256": "65f7f8ca763a00e78b46453c480a22e41e43dcda5a582cfea9eecd4b4448f87d", + "vendored_lines": 72, + "self_recursions": [], + "package": "purescript-identity", + "tag": "v6.0.0", + "commit": "ef6768f8a52ab0bc943a85f5761ba07c257f639f", + "upstream_sha256": "65f7f8ca763a00e78b46453c480a22e41e43dcda5a582cfea9eecd4b4448f87d", + "upstream_url": "https://github.com/purescript/purescript-identity/blob/ef6768f8a52ab0bc943a85f5761ba07c257f639f/src/Data/Identity.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Int/Bits.purs", + "vendored_sha256": "6377bce107895b0021264a30a35c8e50867b084349407009061728bb42c436de", + "vendored_lines": 37, + "self_recursions": [], + "package": "purescript-integers", + "tag": "v6.0.0", + "commit": "54d712b25c594833083d15dc9ff2418eb9c52822", + "upstream_sha256": "6377bce107895b0021264a30a35c8e50867b084349407009061728bb42c436de", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "and", + "line": 13, + "declaration": "foreign import and :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "or", + "line": 18, + "declaration": "foreign import or :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "xor", + "line": 23, + "declaration": "foreign import xor :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "shl", + "line": 28, + "declaration": "foreign import shl :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "shr", + "line": 31, + "declaration": "foreign import shr :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "zshr", + "line": 34, + "declaration": "foreign import zshr :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "complement", + "line": 37, + "declaration": "foreign import complement :: Int -> Int", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Int.purs", + "vendored_sha256": "53a7c199f384719a5f615faf6141e9b0ffa2fa9f66b9806d30a0f196be074eec", + "vendored_lines": 257, + "self_recursions": [], + "package": "purescript-integers", + "tag": "v6.0.0", + "commit": "54d712b25c594833083d15dc9ff2418eb9c52822", + "upstream_sha256": "53a7c199f384719a5f615faf6141e9b0ffa2fa9f66b9806d30a0f196be074eec", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "fromNumberImpl", + "line": 40, + "declaration": "foreign import fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toNumber", + "line": 81, + "declaration": "foreign import toNumber :: Int -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "quot", + "line": 227, + "declaration": "foreign import quot :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "rem", + "line": 245, + "declaration": "foreign import rem :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pow", + "line": 248, + "declaration": "foreign import pow :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "fromStringAsImpl", + "line": 250, + "declaration": "foreign import fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toStringAs", + "line": 257, + "declaration": "foreign import toStringAs :: Radix -> Int -> String", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Lazy.purs", + "vendored_sha256": "9da5e2562a1a05764552d20dc3dc7119142550350a1f290d1919f502ebe54202", + "vendored_lines": 142, + "self_recursions": [], + "package": "purescript-lazy", + "tag": "v6.0.0", + "commit": "48347841226b27af5205a1a8ec71e27a93ce86fd", + "upstream_sha256": "9da5e2562a1a05764552d20dc3dc7119142550350a1f290d1919f502ebe54202", + "upstream_url": "https://github.com/purescript/purescript-lazy/blob/48347841226b27af5205a1a8ec71e27a93ce86fd/src/Data/Lazy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "defer", + "line": 35, + "declaration": "foreign import defer :: forall a. (Unit -> a) -> Lazy a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "force", + "line": 38, + "declaration": "foreign import force :: forall a. Lazy a -> a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Internal.purs", + "vendored_sha256": "9b542dbc4823476b26b6912cd0dbd47c3af97bc35f66f11b421aa59f28d6fc42", + "vendored_lines": 63, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "9b542dbc4823476b26b6912cd0dbd47c3af97bc35f66f11b421aa59f28d6fc42", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Lazy/NonEmpty.purs", + "vendored_sha256": "5b06d7bdbb485fa4766134635b43d22f1e148f0e4bbc61f7c4e78710686b2586", + "vendored_lines": 88, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "5b06d7bdbb485fa4766134635b43d22f1e148f0e4bbc61f7c4e78710686b2586", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Lazy/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Lazy/Types.purs", + "vendored_sha256": "68fa44b813560d340230fd122e965568c2920600c8153fd22219e27ab7307d64", + "vendored_lines": 295, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "68fa44b813560d340230fd122e965568c2920600c8153fd22219e27ab7307d64", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Lazy/Types.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Lazy.purs", + "vendored_sha256": "69f373e427611ef8124b9a49f4c02638aca287bc48bf095371da8afe090fe9b8", + "vendored_lines": 780, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "69f373e427611ef8124b9a49f4c02638aca287bc48bf095371da8afe090fe9b8", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Lazy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/NonEmpty.purs", + "vendored_sha256": "2b0911320ac74ddc1a80957592c965b370ee81de740f9c24f048d4f7d5c4b0d7", + "vendored_lines": 307, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "2b0911320ac74ddc1a80957592c965b370ee81de740f9c24f048d4f7d5c4b0d7", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Partial.purs", + "vendored_sha256": "95e40bb55ef84403901b6a19ac9367bae5cce79330703a8d4db60d57bf6fab4b", + "vendored_lines": 30, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "95e40bb55ef84403901b6a19ac9367bae5cce79330703a8d4db60d57bf6fab4b", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Partial.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/Types.purs", + "vendored_sha256": "8a7d87397d8edc746e7fa1459d67e90ef9e2dd09bf7bd55baa9a4b549e316dd3", + "vendored_lines": 264, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "8a7d87397d8edc746e7fa1459d67e90ef9e2dd09bf7bd55baa9a4b549e316dd3", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/Types.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List/ZipList.purs", + "vendored_sha256": "09acb25d60dd823ee7ce94d33e5ac9bb46aee527638dd69ccf82f1532da13719", + "vendored_lines": 66, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "09acb25d60dd823ee7ce94d33e5ac9bb46aee527638dd69ccf82f1532da13719", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List/ZipList.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/List.purs", + "vendored_sha256": "fde72dc9da24f67efb446f57806890e95b3b40a4f0389ee313072de4cc2d56aa", + "vendored_lines": 826, + "self_recursions": [], + "package": "purescript-lists", + "tag": "v7.0.0", + "commit": "b113451e5b41cad87d669a3165f955c71cd863e2", + "upstream_sha256": "fde72dc9da24f67efb446f57806890e95b3b40a4f0389ee313072de4cc2d56aa", + "upstream_url": "https://github.com/purescript/purescript-lists/blob/b113451e5b41cad87d669a3165f955c71cd863e2/src/Data/List.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Map/Gen.purs", + "vendored_sha256": "9f2671c0a0a1efbad92a52b4e02517c06e08df9f741f59a9d8ae290d002a19e9", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "9f2671c0a0a1efbad92a52b4e02517c06e08df9f741f59a9d8ae290d002a19e9", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Map/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Map/Internal.purs", + "vendored_sha256": "03608bed5db4804aa898eff034bb5b2feab0676948b19aefa606dc927eeb5cc9", + "vendored_lines": 988, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "03608bed5db4804aa898eff034bb5b2feab0676948b19aefa606dc927eeb5cc9", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Map/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Map.purs", + "vendored_sha256": "8a999f683cf7f64950707e6cdc8e9a735974725e98b72c7a6d891f5f801e6242", + "vendored_lines": 65, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "8a999f683cf7f64950707e6cdc8e9a735974725e98b72c7a6d891f5f801e6242", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Map.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Maybe/First.purs", + "vendored_sha256": "7cfcf5744a424bc512fd7e7e04a71484c609a52cf94ef5552bcf7afa8f967abf", + "vendored_lines": 68, + "self_recursions": [], + "package": "purescript-maybe", + "tag": "v6.0.0", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "upstream_sha256": "7cfcf5744a424bc512fd7e7e04a71484c609a52cf94ef5552bcf7afa8f967abf", + "upstream_url": "https://github.com/purescript/purescript-maybe/blob/c6f98ac1088766287106c5d9c8e30e7648d36786/src/Data/Maybe/First.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Maybe/Last.purs", + "vendored_sha256": "cc86da8e91615e04b7973bdc5f7467db4adc8df722eb509bc2cf0e735cbb93ab", + "vendored_lines": 67, + "self_recursions": [], + "package": "purescript-maybe", + "tag": "v6.0.0", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "upstream_sha256": "cc86da8e91615e04b7973bdc5f7467db4adc8df722eb509bc2cf0e735cbb93ab", + "upstream_url": "https://github.com/purescript/purescript-maybe/blob/c6f98ac1088766287106c5d9c8e30e7648d36786/src/Data/Maybe/Last.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Maybe.purs", + "vendored_sha256": "dd49326b74a5ba9c5d0e0aaca7c05226aadb9b9bf851d9a3fdbc34df23319fa8", + "vendored_lines": 312, + "self_recursions": [], + "package": "purescript-maybe", + "tag": "v6.0.0", + "commit": "c6f98ac1088766287106c5d9c8e30e7648d36786", + "upstream_sha256": "dd49326b74a5ba9c5d0e0aaca7c05226aadb9b9bf851d9a3fdbc34df23319fa8", + "upstream_url": "https://github.com/purescript/purescript-maybe/blob/c6f98ac1088766287106c5d9c8e30e7648d36786/src/Data/Maybe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Additive.purs", + "vendored_sha256": "9b44eba5a733dbd6f7e908ea1c4eb44b61694f5a3d1d1e157c7c81300eb7417a", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9b44eba5a733dbd6f7e908ea1c4eb44b61694f5a3d1d1e157c7c81300eb7417a", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Additive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Alternate.purs", + "vendored_sha256": "fb6b0d43a0c82f6028d64d957fad49d9ce48eb8a213ea8d2f0498d4be8f2de8d", + "vendored_lines": 60, + "self_recursions": [], + "package": "purescript-control", + "tag": "v6.0.0", + "commit": "a6033808790879a17b2729e73747a9ed3fb2264e", + "upstream_sha256": "fb6b0d43a0c82f6028d64d957fad49d9ce48eb8a213ea8d2f0498d4be8f2de8d", + "upstream_url": "https://github.com/purescript/purescript-control/blob/a6033808790879a17b2729e73747a9ed3fb2264e/src/Data/Monoid/Alternate.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Conj.purs", + "vendored_sha256": "0e3bedf55635d1c04225ff1a756bc55b94afafa8fb8d327f118e4c1f58f40858", + "vendored_lines": 51, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "0e3bedf55635d1c04225ff1a756bc55b94afafa8fb8d327f118e4c1f58f40858", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Conj.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Disj.purs", + "vendored_sha256": "e1eb141917201b0b866c433e19e68a6b0d80705d8fb6ea3d61d103d4a01c735f", + "vendored_lines": 51, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "e1eb141917201b0b866c433e19e68a6b0d80705d8fb6ea3d61d103d4a01c735f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Disj.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Dual.purs", + "vendored_sha256": "83c40da0d7125aa11225efe267713892ecaa044d66da05d048a1194ac0c48f6c", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "83c40da0d7125aa11225efe267713892ecaa044d66da05d048a1194ac0c48f6c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Dual.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Endo.purs", + "vendored_sha256": "aa5b2bc60841651e0bf54a683e6d6d99f4aca932bf583691b3fdd71a32aa5594", + "vendored_lines": 30, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "aa5b2bc60841651e0bf54a683e6d6d99f4aca932bf583691b3fdd71a32aa5594", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Endo.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Generic.purs", + "vendored_sha256": "a3df423b6bc60580e9e80612ae7c1682445853c55086363ceed129e43c72bf70", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "a3df423b6bc60580e9e80612ae7c1682445853c55086363ceed129e43c72bf70", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid/Multiplicative.purs", + "vendored_sha256": "0d01fac2de65e733c640b045e00f60422e1b776010ee69e7714dd659bb8c7796", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "0d01fac2de65e733c640b045e00f60422e1b776010ee69e7714dd659bb8c7796", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid/Multiplicative.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Monoid.purs", + "vendored_sha256": "a1bf093434dc1d8f162a19369f3376516f3f899e17875711be3d7164fb20e605", + "vendored_lines": 120, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "a1bf093434dc1d8f162a19369f3376516f3f899e17875711be3d7164fb20e605", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Monoid.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/NaturalTransformation.purs", + "vendored_sha256": "3196072783cdc7135047788ad6e58073e1cfeb50d284f038b79b65db2df9eb7e", + "vendored_lines": 20, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "3196072783cdc7135047788ad6e58073e1cfeb50d284f038b79b65db2df9eb7e", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/NaturalTransformation.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Newtype.purs", + "vendored_sha256": "572911ec613a337d30004c92120afea496af97d34b63617d884d4a96f03d8304", + "vendored_lines": 308, + "self_recursions": [], + "package": "purescript-newtype", + "tag": "v5.0.0", + "commit": "29d8e6dd77aec2c975c948364ec3faf26e14ee7b", + "upstream_sha256": "572911ec613a337d30004c92120afea496af97d34b63617d884d4a96f03d8304", + "upstream_url": "https://github.com/purescript/purescript-newtype/blob/29d8e6dd77aec2c975c948364ec3faf26e14ee7b/src/Data/Newtype.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/NonEmpty.purs", + "vendored_sha256": "c48366ad44cc7b4311d5032ef27ae8d2ea39f603d7bb33f03d51536758976d7e", + "vendored_lines": 174, + "self_recursions": [], + "package": "purescript-nonempty", + "tag": "v7.0.0", + "commit": "28150ecc7419238b187abd609a92a645273348bb", + "upstream_sha256": "c48366ad44cc7b4311d5032ef27ae8d2ea39f603d7bb33f03d51536758976d7e", + "upstream_url": "https://github.com/purescript/purescript-nonempty/blob/28150ecc7419238b187abd609a92a645273348bb/src/Data/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Number/Approximate.purs", + "vendored_sha256": "fbd544b15b42845be1a3fa11f1ec3c61d290baa300d41b7e41e3aacf707eacff", + "vendored_lines": 95, + "self_recursions": [], + "package": "purescript-numbers", + "tag": "v9.0.1", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "upstream_sha256": "fbd544b15b42845be1a3fa11f1ec3c61d290baa300d41b7e41e3aacf707eacff", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Approximate.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Number/Format.purs", + "vendored_sha256": "0922126e6d31ecc361a00b265ecf302fb1f6449ca11d2cc2331a0ae174d9f83f", + "vendored_lines": 76, + "self_recursions": [], + "package": "purescript-numbers", + "tag": "v9.0.1", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "upstream_sha256": "0922126e6d31ecc361a00b265ecf302fb1f6449ca11d2cc2331a0ae174d9f83f", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number/Format.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "toPrecisionNative", + "line": 33, + "declaration": "foreign import toPrecisionNative :: Int -> Number -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toFixedNative", + "line": 34, + "declaration": "foreign import toFixedNative :: Int -> Number -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toExponentialNative", + "line": 35, + "declaration": "foreign import toExponentialNative :: Int -> Number -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toString", + "line": 76, + "declaration": "foreign import toString :: Number -> String", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Number.purs", + "vendored_sha256": "13c04cf0d293c54825fc95b5b3d543379a8d913e110d9e5056ca5388a31afc87", + "vendored_lines": 363, + "self_recursions": [], + "package": "purescript-numbers", + "tag": "v9.0.1", + "commit": "27d54effdd2c0e7a86fe356b1cd813dca5981c2d", + "upstream_sha256": "13c04cf0d293c54825fc95b5b3d543379a8d913e110d9e5056ca5388a31afc87", + "upstream_url": "https://github.com/purescript/purescript-numbers/blob/27d54effdd2c0e7a86fe356b1cd813dca5981c2d/src/Data/Number.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "nan", + "line": 47, + "declaration": "foreign import nan :: Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "isNaN", + "line": 57, + "declaration": "foreign import isNaN :: Number -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "infinity", + "line": 67, + "declaration": "foreign import infinity :: Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "isFinite", + "line": 83, + "declaration": "foreign import isFinite :: Number -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "fromStringImpl", + "line": 115, + "declaration": "foreign import fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "abs", + "line": 123, + "declaration": "foreign import abs :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "acos", + "line": 130, + "declaration": "foreign import acos :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "asin", + "line": 137, + "declaration": "foreign import asin :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "atan", + "line": 144, + "declaration": "foreign import atan :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "atan2", + "line": 157, + "declaration": "foreign import atan2 :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "ceil", + "line": 164, + "declaration": "foreign import ceil :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "cos", + "line": 171, + "declaration": "foreign import cos :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "exp", + "line": 178, + "declaration": "foreign import exp :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "floor", + "line": 185, + "declaration": "foreign import floor :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "log", + "line": 191, + "declaration": "foreign import log :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "max", + "line": 195, + "declaration": "foreign import max :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "min", + "line": 199, + "declaration": "foreign import min :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "pow", + "line": 209, + "declaration": "foreign import pow :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "remainder", + "line": 216, + "declaration": "foreign import remainder :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "round", + "line": 225, + "declaration": "foreign import round :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "sign", + "line": 235, + "declaration": "foreign import sign :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "sin", + "line": 242, + "declaration": "foreign import sin :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "sqrt", + "line": 249, + "declaration": "foreign import sqrt :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "tan", + "line": 256, + "declaration": "foreign import tan :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "trunc", + "line": 264, + "declaration": "foreign import trunc :: Number -> Number", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Op.purs", + "vendored_sha256": "400182c9f9c76ef9eaab32377405195986d70d1f4a4a04cc4833fba0e035cec6", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "400182c9f9c76ef9eaab32377405195986d70d1f4a4a04cc4833fba0e035cec6", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Op.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Down.purs", + "vendored_sha256": "1c1ac8c739112884f86076eaae7ebe1a24c533892c044940813ceee796d840bc", + "vendored_lines": 26, + "self_recursions": [], + "package": "purescript-orders", + "tag": "v6.0.0", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "upstream_sha256": "1c1ac8c739112884f86076eaae7ebe1a24c533892c044940813ceee796d840bc", + "upstream_url": "https://github.com/purescript/purescript-orders/blob/f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c/src/Data/Ord/Down.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Generic.purs", + "vendored_sha256": "f1a8a7f58a29e0d22087de7acb3e7eb4a7e159fa5cb589d127274efcb91246ca", + "vendored_lines": 39, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "f1a8a7f58a29e0d22087de7acb3e7eb4a7e159fa5cb589d127274efcb91246ca", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Max.purs", + "vendored_sha256": "0ba5b99631c3d19685c2ff3141d8e7701933e53828ca4277c0060cdb010b6255", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-orders", + "tag": "v6.0.0", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "upstream_sha256": "0ba5b99631c3d19685c2ff3141d8e7701933e53828ca4277c0060cdb010b6255", + "upstream_url": "https://github.com/purescript/purescript-orders/blob/f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c/src/Data/Ord/Max.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord/Min.purs", + "vendored_sha256": "2ff841d2cdab3ddacb446d4562a49b7e17a76bfa23441188f02a77a65db4a6f1", + "vendored_lines": 29, + "self_recursions": [], + "package": "purescript-orders", + "tag": "v6.0.0", + "commit": "f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c", + "upstream_sha256": "2ff841d2cdab3ddacb446d4562a49b7e17a76bfa23441188f02a77a65db4a6f1", + "upstream_url": "https://github.com/purescript/purescript-orders/blob/f86db621ec5eef1274145f8b1fd8ebbfe0ed4a2c/src/Data/Ord/Min.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ord.purs", + "vendored_sha256": "ba132ffbd2784283842f3e5c0b8a47be006968229bcd70abce0764a21b8a47ae", + "vendored_lines": 264, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "ba132ffbd2784283842f3e5c0b8a47be006968229bcd70abce0764a21b8a47ae", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ord.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "ordBooleanImpl", + "line": 84, + "declaration": "foreign import ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "ordIntImpl", + "line": 92, + "declaration": "foreign import ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "ordNumberImpl", + "line": 100, + "declaration": "foreign import ordNumberImpl :: Ordering -> Ordering -> Ordering -> Number -> Number -> Ordering", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "ordStringImpl", + "line": 108, + "declaration": "foreign import ordStringImpl :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "ordCharImpl", + "line": 116, + "declaration": "foreign import ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "ordArrayImpl", + "line": 124, + "declaration": "foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ordering.purs", + "vendored_sha256": "9a53fe2e7bd7afb11b8db093b1511bc210fc88c1661a78fe4d89800b20cae0a1", + "vendored_lines": 36, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9a53fe2e7bd7afb11b8db093b1511bc210fc88c1661a78fe4d89800b20cae0a1", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ordering.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Predicate.purs", + "vendored_sha256": "75e1d24c5f0eecc0d11f7664bd38edd641f5fcb039577d11213eac1a819a2d1c", + "vendored_lines": 18, + "self_recursions": [], + "package": "purescript-contravariant", + "tag": "v6.0.0", + "commit": "9ad3e105b8855bcc25f4e0893c784789d05a58de", + "upstream_sha256": "75e1d24c5f0eecc0d11f7664bd38edd641f5fcb039577d11213eac1a819a2d1c", + "upstream_url": "https://github.com/purescript/purescript-contravariant/blob/9ad3e105b8855bcc25f4e0893c784789d05a58de/src/Data/Predicate.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Choice.purs", + "vendored_sha256": "687391e4819de27fda58acb18be86fdd99bf52166b1ca736525fa4c3310d752a", + "vendored_lines": 83, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "687391e4819de27fda58acb18be86fdd99bf52166b1ca736525fa4c3310d752a", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Choice.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Closed.purs", + "vendored_sha256": "2ebbae569682f0bb828e69417c6b991eb6ac54ae0c439e1da9a44064a613d01d", + "vendored_lines": 12, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "2ebbae569682f0bb828e69417c6b991eb6ac54ae0c439e1da9a44064a613d01d", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Closed.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Cochoice.purs", + "vendored_sha256": "d04b01c617f374356eba5358777bf945f6e41c274b7c8c58cd4327d2d6cfe117", + "vendored_lines": 9, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "d04b01c617f374356eba5358777bf945f6e41c274b7c8c58cd4327d2d6cfe117", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Cochoice.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Costrong.purs", + "vendored_sha256": "7d7eb115e194c2d8518b070a3b39809b1b9bc0bdcfe3e48a29b40e9bd6748513", + "vendored_lines": 9, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "7d7eb115e194c2d8518b070a3b39809b1b9bc0bdcfe3e48a29b40e9bd6748513", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Costrong.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Join.purs", + "vendored_sha256": "acbfbd68ca96516e42a4416e1c587b8db4cfae572f7814fa9784cbfeaf286c9f", + "vendored_lines": 28, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "acbfbd68ca96516e42a4416e1c587b8db4cfae572f7814fa9784cbfeaf286c9f", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Join.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Split.purs", + "vendored_sha256": "32b0f17f7d2140c6f7ed3e536d0ec5220b504017deedcb798df586e4c61ca909", + "vendored_lines": 39, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "32b0f17f7d2140c6f7ed3e536d0ec5220b504017deedcb798df586e4c61ca909", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Split.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Star.purs", + "vendored_sha256": "52953a97b7701dbe8619f61bf2bc0b13d2606efbf85d201527dbda5348c05b40", + "vendored_lines": 80, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "52953a97b7701dbe8619f61bf2bc0b13d2606efbf85d201527dbda5348c05b40", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Star.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor/Strong.purs", + "vendored_sha256": "7ce15c8be67cd563c7d611891e73be2018fae763e26b9b10d790cab4110cc1cb", + "vendored_lines": 80, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "7ce15c8be67cd563c7d611891e73be2018fae763e26b9b10d790cab4110cc1cb", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor/Strong.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Profunctor.purs", + "vendored_sha256": "f0e9030ebb6252131618dcbc5e181d98dab01020126bbcedd0344d78cea8c9e1", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-profunctor", + "tag": "v6.0.1", + "commit": "17f927ce69710085f2bbefc9a37506828d1ebc5a", + "upstream_sha256": "f0e9030ebb6252131618dcbc5e181d98dab01020126bbcedd0344d78cea8c9e1", + "upstream_url": "https://github.com/purescript/purescript-profunctor/blob/17f927ce69710085f2bbefc9a37506828d1ebc5a/src/Data/Profunctor.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Reflectable.purs", + "vendored_sha256": "3335b7b50707e01e8fe217afa89c1ccc3d9b1c9323329bd153094079a6890bfc", + "vendored_lines": 57, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "3335b7b50707e01e8fe217afa89c1ccc3d9b1c9323329bd153094079a6890bfc", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Reflectable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeCoerce", + "line": 36, + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ring/Generic.purs", + "vendored_sha256": "4aec6adf51e6cb9e63f3004968d2bda3801d31cbc60e8ffff183307393eabee4", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "4aec6adf51e6cb9e63f3004968d2bda3801d31cbc60e8ffff183307393eabee4", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Ring.purs", + "vendored_sha256": "1abcaa302136c9731ec2d89ee1fe29f3acbec0dd32da45d30a8d46cc6fb87b7d", + "vendored_lines": 78, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "1abcaa302136c9731ec2d89ee1fe29f3acbec0dd32da45d30a8d46cc6fb87b7d", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "intSub", + "line": 54, + "declaration": "foreign import intSub :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "numSub", + "line": 55, + "declaration": "foreign import numSub :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/First.purs", + "vendored_sha256": "9df1dca916c4a4d344ddf580f2a3d3a1cb270dc8df91044147d590e8bc315347", + "vendored_lines": 40, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "9df1dca916c4a4d344ddf580f2a3d3a1cb270dc8df91044147d590e8bc315347", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup/First.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Foldable.purs", + "vendored_sha256": "7bbb43d0a9354e63d409e6b01f4ee634f0e900c6516ff17734eee0e0cbb03629", + "vendored_lines": 178, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "7bbb43d0a9354e63d409e6b01f4ee634f0e900c6516ff17734eee0e0cbb03629", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Semigroup/Foldable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Generic.purs", + "vendored_sha256": "c33f0a8dea5d46a2c7ac0b7805840a443b2ed3d82d226319c243ff0b29ded7bd", + "vendored_lines": 31, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "c33f0a8dea5d46a2c7ac0b7805840a443b2ed3d82d226319c243ff0b29ded7bd", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Last.purs", + "vendored_sha256": "f3aadefc2e6687234ad3d4690dd61e436bfa3aca9b57e0a1a4da7328738f7c11", + "vendored_lines": 40, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "f3aadefc2e6687234ad3d4690dd61e436bfa3aca9b57e0a1a4da7328738f7c11", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup/Last.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup/Traversable.purs", + "vendored_sha256": "361841e1f1960110c9bdaebdbdd8637742f626a26942e61fe7a8ee91fcf8b447", + "vendored_lines": 72, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "361841e1f1960110c9bdaebdbdd8637742f626a26942e61fe7a8ee91fcf8b447", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Semigroup/Traversable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semigroup.purs", + "vendored_sha256": "e14ab5200a3ba533334c3d06cbeac9bd9fdb3428c64a9d59926f69284ce4f9a8", + "vendored_lines": 84, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "e14ab5200a3ba533334c3d06cbeac9bd9fdb3428c64a9d59926f69284ce4f9a8", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semigroup.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "concatString", + "line": 60, + "declaration": "foreign import concatString :: String -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "concatArray", + "line": 61, + "declaration": "foreign import concatArray :: forall a. Array a -> Array a -> Array a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semiring/Generic.purs", + "vendored_sha256": "13e146664e64d99ebe5d942ef3bd897ed78c85e2ab737374d1976b37c36b8601", + "vendored_lines": 51, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "13e146664e64d99ebe5d942ef3bd897ed78c85e2ab737374d1976b37c36b8601", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Semiring.purs", + "vendored_sha256": "6e588bb9736b230b5bd6410ce86f9e9e4d4326ab250a66fa239a7c5f822e7072", + "vendored_lines": 140, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "6e588bb9736b230b5bd6410ce86f9e9e4d4326ab250a66fa239a7c5f822e7072", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "intAdd", + "line": 89, + "declaration": "foreign import intAdd :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "intMul", + "line": 90, + "declaration": "foreign import intMul :: Int -> Int -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "numAdd", + "line": 91, + "declaration": "foreign import numAdd :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "numMul", + "line": 92, + "declaration": "foreign import numMul :: Number -> Number -> Number", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Set/NonEmpty.purs", + "vendored_sha256": "45a49dc49087f55b9c3c315a1fa68e62313a55bf6aab9f8df2bba52ccf7a4dd5", + "vendored_lines": 163, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "45a49dc49087f55b9c3c315a1fa68e62313a55bf6aab9f8df2bba52ccf7a4dd5", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Set/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Set.purs", + "vendored_sha256": "8281a67c595c3948a64b00cb3cb21d26c8b5f7a80c686e77320c85fdea46aee7", + "vendored_lines": 188, + "self_recursions": [], + "package": "purescript-ordered-collections", + "tag": "v3.2.0", + "commit": "b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438", + "upstream_sha256": "8281a67c595c3948a64b00cb3cb21d26c8b5f7a80c686e77320c85fdea46aee7", + "upstream_url": "https://github.com/purescript/purescript-ordered-collections/blob/b9c8ec72b53ee56d6cb6dc962d5ad7ea4708b438/src/Data/Set.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Show/Generic.purs", + "vendored_sha256": "bd4a82c3cb1e734f775ff6a40fae47b053d336313faf47efb8b4b5d78895376f", + "vendored_lines": 57, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "bd4a82c3cb1e734f775ff6a40fae47b053d336313faf47efb8b4b5d78895376f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show/Generic.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "intercalate", + "line": 57, + "declaration": "foreign import intercalate :: String -> Array String -> String", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Show.purs", + "vendored_sha256": "4422b4bbe3d67f1f85575937fb7b9127af4443fe951926a95f6ecf0822032e6c", + "vendored_lines": 97, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "4422b4bbe3d67f1f85575937fb7b9127af4443fe951926a95f6ecf0822032e6c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Show.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "showIntImpl", + "line": 93, + "declaration": "foreign import showIntImpl :: Int -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "showNumberImpl", + "line": 94, + "declaration": "foreign import showNumberImpl :: Number -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "showCharImpl", + "line": 95, + "declaration": "foreign import showCharImpl :: Char -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "showStringImpl", + "line": 96, + "declaration": "foreign import showStringImpl :: String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "showArrayImpl", + "line": 97, + "declaration": "foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/CaseInsensitive.purs", + "vendored_sha256": "1d889da73589b5bed249153cc55a01654a912756bc062ae1f12df3357c2ca9ed", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "1d889da73589b5bed249153cc55a01654a912756bc062ae1f12df3357c2ca9ed", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CaseInsensitive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/CodePoints.purs", + "vendored_sha256": "a8415ac45b14a0d78334af6d0fb533c7bfc3cfb3ed90e28113c453c9b15f170b", + "vendored_lines": 436, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "a8415ac45b14a0d78334af6d0fb533c7bfc3cfb3ed90e28113c453c9b15f170b", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodePoints.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "_singleton", + "line": 91, + "declaration": "foreign import _singleton :: (CodePoint -> String) -> CodePoint -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_fromCodePointArray", + "line": 117, + "declaration": "foreign import _fromCodePointArray :: (CodePoint -> String) -> Array CodePoint -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_toCodePointArray", + "line": 136, + "declaration": "foreign import _toCodePointArray :: (String -> Array CodePoint) -> (String -> CodePoint) -> String -> Array CodePoint", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_codePointAt", + "line": 166, + "declaration": "foreign import _codePointAt :: (Int -> String -> Maybe CodePoint) -> (forall a. a -> Maybe a) -> (forall a. Maybe a) -> (String -> CodePoint) -> Int -> String -> Maybe CodePoint", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_countPrefix", + "line": 230, + "declaration": "foreign import _countPrefix :: ((CodePoint -> Boolean) -> String -> Int) -> (String -> CodePoint) -> (CodePoint -> Boolean) -> String -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_take", + "line": 331, + "declaration": "foreign import _take :: (Int -> String -> String) -> Int -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_unsafeCodePointAt0", + "line": 421, + "declaration": "foreign import _unsafeCodePointAt0 :: (String -> CodePoint) -> String -> CodePoint", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/CodeUnits.purs", + "vendored_sha256": "801f13b0d180a49a454d6456c1c5a7a235a2a7d1827ab31537506e9b279a0648", + "vendored_lines": 332, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "801f13b0d180a49a454d6456c1c5a7a235a2a7d1827ab31537506e9b279a0648", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/CodeUnits.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "singleton", + "line": 83, + "declaration": "foreign import singleton :: Char -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "fromCharArray", + "line": 90, + "declaration": "foreign import fromCharArray :: Array Char -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toCharArray", + "line": 97, + "declaration": "foreign import toCharArray :: String -> Array Char", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_charAt", + "line": 109, + "declaration": "foreign import _charAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Int -> String -> Maybe Char", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_toChar", + "line": 126, + "declaration": "foreign import _toChar :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> String -> Maybe Char", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "length", + "line": 150, + "declaration": "foreign import length :: String -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "countPrefix", + "line": 159, + "declaration": "foreign import countPrefix :: (Char -> Boolean) -> String -> Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_indexOf", + "line": 172, + "declaration": "foreign import _indexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_indexOfStartingAt", + "line": 191, + "declaration": "foreign import _indexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_lastIndexOf", + "line": 210, + "declaration": "foreign import _lastIndexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_lastIndexOfStartingAt", + "line": 238, + "declaration": "foreign import _lastIndexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "take", + "line": 252, + "declaration": "foreign import take :: Int -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "drop", + "line": 279, + "declaration": "foreign import drop :: Int -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "slice", + "line": 311, + "declaration": "foreign import slice :: Int -> Int -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "splitAt", + "line": 332, + "declaration": "foreign import splitAt :: Int -> String -> { before :: String, after :: String }", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Common.purs", + "vendored_sha256": "286d269bba5d0010924bc62a45188f664d93f7486707f9a3d5038ad7699a2f84", + "vendored_lines": 96, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "286d269bba5d0010924bc62a45188f664d93f7486707f9a3d5038ad7699a2f84", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Common.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "_localeCompare", + "line": 37, + "declaration": "foreign import _localeCompare :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "replace", + "line": 50, + "declaration": "foreign import replace :: Pattern -> Replacement -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "replaceAll", + "line": 57, + "declaration": "foreign import replaceAll :: Pattern -> Replacement -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "split", + "line": 65, + "declaration": "foreign import split :: Pattern -> String -> Array String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toLower", + "line": 72, + "declaration": "foreign import toLower :: String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "toUpper", + "line": 79, + "declaration": "foreign import toUpper :: String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "trim", + "line": 88, + "declaration": "foreign import trim :: String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "joinWith", + "line": 96, + "declaration": "foreign import joinWith :: String -> Array String -> String", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Gen.purs", + "vendored_sha256": "fdc6f113d91213f5571aaef42726fd6966eba12c56cb30c40736ff9398a6585b", + "vendored_lines": 43, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "fdc6f113d91213f5571aaef42726fd6966eba12c56cb30c40736ff9398a6585b", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Gen.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/CaseInsensitive.purs", + "vendored_sha256": "73160accd99f00200e60a5431d70f197aded453aac143f15d842d8fcb984d803", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "73160accd99f00200e60a5431d70f197aded453aac143f15d842d8fcb984d803", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/CaseInsensitive.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/CodePoints.purs", + "vendored_sha256": "26f6c829cda09064888b07ada1989e44d5781c81d9927f9b3c2351e82b3077b0", + "vendored_lines": 138, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "26f6c829cda09064888b07ada1989e44d5781c81d9927f9b3c2351e82b3077b0", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/CodePoints.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/CodeUnits.purs", + "vendored_sha256": "305c39d652a011b9dbb723e22be8e87767bd91fb3f962cb511666828647fafc8", + "vendored_lines": 308, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "305c39d652a011b9dbb723e22be8e87767bd91fb3f962cb511666828647fafc8", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/CodeUnits.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty/Internal.purs", + "vendored_sha256": "1efe2c4ec248665e11f8978bf5f44d6eec2c2c248586c47a6137e652d452d966", + "vendored_lines": 232, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "1efe2c4ec248665e11f8978bf5f44d6eec2c2c248586c47a6137e652d452d966", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/NonEmpty.purs", + "vendored_sha256": "b369bd4f0f9ee7f1d8ced366cd82f0c8b17b99365517d9f305b2fe980c172134", + "vendored_lines": 9, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "b369bd4f0f9ee7f1d8ced366cd82f0c8b17b99365517d9f305b2fe980c172134", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/NonEmpty.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Pattern.purs", + "vendored_sha256": "cd63d7bb03364c5f5e0b2fbe44746c81b2965300bbf890702331d146a5f3b90f", + "vendored_lines": 33, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "cd63d7bb03364c5f5e0b2fbe44746c81b2965300bbf890702331d146a5f3b90f", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Pattern.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Regex/Flags.purs", + "vendored_sha256": "c764c8d36ccd74d5603dbfef8b62976788369c9844bceab91c319d61dea16c16", + "vendored_lines": 129, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "c764c8d36ccd74d5603dbfef8b62976788369c9844bceab91c319d61dea16c16", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex/Flags.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Regex/Unsafe.purs", + "vendored_sha256": "9a0bf4c37a2ac844622b29a72d24c3b3aa1e0ad04bcfe1186962f6cd2e433e59", + "vendored_lines": 14, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "9a0bf4c37a2ac844622b29a72d24c3b3aa1e0ad04bcfe1186962f6cd2e433e59", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex/Unsafe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Regex.purs", + "vendored_sha256": "101f80a5bcba3f3bf1b6ec1ec68f48c18d149d9e4b7808eddf8e753eb15d1d88", + "vendored_lines": 131, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "101f80a5bcba3f3bf1b6ec1ec68f48c18d149d9e4b7808eddf8e753eb15d1d88", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Regex.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "showRegexImpl", + "line": 31, + "declaration": "foreign import showRegexImpl :: Regex -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "regexImpl", + "line": 36, + "declaration": "foreign import regexImpl :: (String -> Either String Regex) -> (Regex -> Either String Regex) -> String -> String -> Either String Regex", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "source", + "line": 49, + "declaration": "foreign import source :: Regex -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "flagsImpl", + "line": 56, + "declaration": "foreign import flagsImpl :: Regex -> RegexFlagsRec", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "test", + "line": 82, + "declaration": "foreign import test :: Regex -> String -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_match", + "line": 84, + "declaration": "foreign import _match :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe (NonEmptyArray (Maybe String))", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "replace", + "line": 101, + "declaration": "foreign import replace :: Regex -> String -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_replaceBy", + "line": 103, + "declaration": "foreign import _replaceBy :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> (String -> Array (Maybe String) -> String) -> String -> String", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "_search", + "line": 118, + "declaration": "foreign import _search :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe Int", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "split", + "line": 131, + "declaration": "foreign import split :: Regex -> String -> Array String", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String/Unsafe.purs", + "vendored_sha256": "b361c98410d61e2d110a4ae54cda75012679a6733b101dde378d3307ec69c702", + "vendored_lines": 15, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "b361c98410d61e2d110a4ae54cda75012679a6733b101dde378d3307ec69c702", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String/Unsafe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "charAt", + "line": 10, + "declaration": "foreign import charAt :: Int -> String -> Char", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "char", + "line": 15, + "declaration": "foreign import char :: String -> Char", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/String.purs", + "vendored_sha256": "0cf63fa0bccd027bededff0647c1a4251d235be02c1df8a8310be2aea2eb367f", + "vendored_lines": 10, + "self_recursions": [], + "package": "purescript-strings", + "tag": "v6.0.1", + "commit": "3d3e2f7197d4f7aacb15e854ee9a645489555fff", + "upstream_sha256": "0cf63fa0bccd027bededff0647c1a4251d235be02c1df8a8310be2aea2eb367f", + "upstream_url": "https://github.com/purescript/purescript-strings/blob/3d3e2f7197d4f7aacb15e854ee9a645489555fff/src/Data/String.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Symbol.purs", + "vendored_sha256": "8302d378edfcd58fbe1aadcf95c22f8637533de188b99ca2a0e43147e8957ec4", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "8302d378edfcd58fbe1aadcf95c22f8637533de188b99ca2a0e43147e8957ec4", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Symbol.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeCoerce", + "line": 14, + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Traversable/Accum/Internal.purs", + "vendored_sha256": "03a2322dd8920092618ad5a9ef8bab31e740b384af88b2e9816abd25d34d1755", + "vendored_lines": 44, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "03a2322dd8920092618ad5a9ef8bab31e740b384af88b2e9816abd25d34d1755", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable/Accum/Internal.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Traversable/Accum.purs", + "vendored_sha256": "a37609f85d2dc1e527a2cd969302f0bf0bd5c8735226f5fbc874f67a6f4b646d", + "vendored_lines": 5, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "a37609f85d2dc1e527a2cd969302f0bf0bd5c8735226f5fbc874f67a6f4b646d", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable/Accum.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Traversable.purs", + "vendored_sha256": "605c2e3c31d3531ce3674d5fb48ab608981b1553f9272c234ad9ca792108bf77", + "vendored_lines": 257, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "605c2e3c31d3531ce3674d5fb48ab608981b1553f9272c234ad9ca792108bf77", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/Traversable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "traverseArrayImpl", + "line": 106, + "declaration": "foreign import traverseArrayImpl :: forall m a b . (forall x y. m (x -> y) -> m x -> m y) -> (forall x y. (x -> y) -> m x -> m y) -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b)", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/TraversableWithIndex.purs", + "vendored_sha256": "aa2f2406e9ffbf49bb8b07a74b5c044eef9f4e3cef21b8cf7ba18a0edddc23ac", + "vendored_lines": 213, + "self_recursions": [], + "package": "purescript-foldable-traversable", + "tag": "v6.0.0", + "commit": "b3926f870532d287ea59e2d5cd3873b81ef2a93a", + "upstream_sha256": "aa2f2406e9ffbf49bb8b07a74b5c044eef9f4e3cef21b8cf7ba18a0edddc23ac", + "upstream_url": "https://github.com/purescript/purescript-foldable-traversable/blob/b3926f870532d287ea59e2d5cd3873b81ef2a93a/src/Data/TraversableWithIndex.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Tuple/Nested.purs", + "vendored_sha256": "6747d4c125c506fb22b831142513c54112fb3bf5908697534b540ce8e4cb0a4e", + "vendored_lines": 294, + "self_recursions": [], + "package": "purescript-tuples", + "tag": "v7.0.0", + "commit": "4f52da2729b448c8564369378f1232d8d2dc1d8b", + "upstream_sha256": "6747d4c125c506fb22b831142513c54112fb3bf5908697534b540ce8e4cb0a4e", + "upstream_url": "https://github.com/purescript/purescript-tuples/blob/4f52da2729b448c8564369378f1232d8d2dc1d8b/src/Data/Tuple/Nested.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Tuple.purs", + "vendored_sha256": "dc2ef1a90e52e851e02de1e8bb3bbbe9bfdbff8fe821473cbfda1998a82bc0d7", + "vendored_lines": 135, + "self_recursions": [], + "package": "purescript-tuples", + "tag": "v7.0.0", + "commit": "4f52da2729b448c8564369378f1232d8d2dc1d8b", + "upstream_sha256": "dc2ef1a90e52e851e02de1e8bb3bbbe9bfdbff8fe821473cbfda1998a82bc0d7", + "upstream_url": "https://github.com/purescript/purescript-tuples/blob/4f52da2729b448c8564369378f1232d8d2dc1d8b/src/Data/Tuple.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Unfoldable.purs", + "vendored_sha256": "c36722cb427b94e8d20b6a4df3afd8163ebf71cf88502cc20e68d8e3cad773f7", + "vendored_lines": 103, + "self_recursions": [], + "package": "purescript-unfoldable", + "tag": "v6.0.0", + "commit": "493dfe04ed590e20d8f69079df2f58486882748d", + "upstream_sha256": "c36722cb427b94e8d20b6a4df3afd8163ebf71cf88502cc20e68d8e3cad773f7", + "upstream_url": "https://github.com/purescript/purescript-unfoldable/blob/493dfe04ed590e20d8f69079df2f58486882748d/src/Data/Unfoldable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unfoldrArrayImpl", + "line": 47, + "declaration": "foreign import unfoldrArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Maybe (Tuple a b)) -> b -> Array a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Unfoldable1.purs", + "vendored_sha256": "7e5bf042a5c7d47bc6b5c57bcbfec7eadfd72d2f33979fa0d5ab7c4605f8edc1", + "vendored_lines": 131, + "self_recursions": [], + "package": "purescript-unfoldable", + "tag": "v6.0.0", + "commit": "493dfe04ed590e20d8f69079df2f58486882748d", + "upstream_sha256": "7e5bf042a5c7d47bc6b5c57bcbfec7eadfd72d2f33979fa0d5ab7c4605f8edc1", + "upstream_url": "https://github.com/purescript/purescript-unfoldable/blob/493dfe04ed590e20d8f69079df2f58486882748d/src/Data/Unfoldable1.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unfoldr1ArrayImpl", + "line": 48, + "declaration": "foreign import unfoldr1ArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Tuple a (Maybe b)) -> b -> Array a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Unit.purs", + "vendored_sha256": "9da429dc5a86e009ed827b12b3b98106668d6d744c6f6ab7ee8d71414eb6ca0d", + "vendored_lines": 5, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "ce9f2d8fba25b6b392e5e9e81afe0fe33968dc15420765ab19bac8adb948e64f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Unit.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "unit", + "line": 14, + "declaration": "foreign import unit :: Unit", + "vendored_status": "declaration_removed" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 1, + "text": "module Data.Unit where" + }, + { + "line": 11, + "text": "foreign import data Unit :: Type" + } + ] + }, + { + "path": "Data/Void.purs", + "vendored_sha256": "bf2d7931a857b5aeafc4e3a27c1425010c8c7710772b4e3ff8c102f5c3f84564", + "vendored_lines": 34, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "bf2d7931a857b5aeafc4e3a27c1425010c8c7710772b4e3ff8c102f5c3f84564", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Void.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Data/Witherable.purs", + "vendored_sha256": "3250d0c8465691cc772887e09ef48f4b9554a236f614da7346abed3c0f5cfb93", + "vendored_lines": 162, + "self_recursions": [], + "package": "purescript-filterable", + "tag": "v5.0.0", + "commit": "7c5b8c72779997f2b17d12ce478ff81e7ddda285", + "upstream_sha256": "3250d0c8465691cc772887e09ef48f4b9554a236f614da7346abed3c0f5cfb93", + "upstream_url": "https://github.com/purescript/purescript-filterable/blob/7c5b8c72779997f2b17d12ce478ff81e7ddda285/src/Data/Witherable.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Class/Console.purs", + "vendored_sha256": "1aa9260f9b96c0d6b5721c5ad473dd0c518157d06da9c5d4cbbac6c28518558d", + "vendored_lines": 49, + "self_recursions": [], + "package": "purescript-console", + "tag": "v6.0.0", + "commit": "3b83d7b792d03872afeea5e62b4f686ab0f09842", + "upstream_sha256": "1aa9260f9b96c0d6b5721c5ad473dd0c518157d06da9c5d4cbbac6c28518558d", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Class/Console.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Class.purs", + "vendored_sha256": "a78c5876b0aad1123e30ca8a37cd79ca2a837fbccc3a9e92bea3793033cc5a03", + "vendored_lines": 19, + "self_recursions": [], + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "a78c5876b0aad1123e30ca8a37cd79ca2a837fbccc3a9e92bea3793033cc5a03", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Class.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Console.purs", + "vendored_sha256": "06eacf43a1b90e48e5e482805d7ca029c888b98adbd1440ccda4da3894a4ecc1", + "vendored_lines": 69, + "self_recursions": [], + "package": "purescript-console", + "tag": "v6.0.0", + "commit": "3b83d7b792d03872afeea5e62b4f686ab0f09842", + "upstream_sha256": "14a1820f28867485552db40f58826ceafb63fc899802a38a15ea82dd6974cce7", + "upstream_url": "https://github.com/purescript/purescript-console/blob/3b83d7b792d03872afeea5e62b4f686ab0f09842/src/Effect/Console.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "log", + "line": 9, + "declaration": "foreign import log :: String -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "warn", + "line": 19, + "declaration": "foreign import warn :: String -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "error", + "line": 29, + "declaration": "foreign import error :: String -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "info", + "line": 39, + "declaration": "foreign import info :: String -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "debug", + "line": 49, + "declaration": "foreign import debug :: String -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "time", + "line": 59, + "declaration": "foreign import time :: String -> Effect Unit", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "timeLog", + "line": 62, + "declaration": "foreign import timeLog :: String -> Effect Unit", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "timeEnd", + "line": 65, + "declaration": "foreign import timeEnd :: String -> Effect Unit", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "clear", + "line": 68, + "declaration": "foreign import clear :: Effect Unit", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Ref.purs", + "vendored_sha256": "d1e4e9c7037152b73f39a9a1369e9d6c00ca0d6ce6c437abe7ea457adb6d8774", + "vendored_lines": 73, + "self_recursions": [], + "package": "purescript-refs", + "tag": "v6.0.0", + "commit": "f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8", + "upstream_sha256": "d1e4e9c7037152b73f39a9a1369e9d6c00ca0d6ce6c437abe7ea457adb6d8774", + "upstream_url": "https://github.com/purescript/purescript-refs/blob/f8e6216da4cb9309fde1f20cd6f69ac3a3b7f9e8/src/Effect/Ref.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "_new", + "line": 44, + "declaration": "foreign import _new :: forall s. s -> Effect (Ref s)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "newWithSelf", + "line": 51, + "declaration": "foreign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s)", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "read", + "line": 54, + "declaration": "foreign import read :: forall s. Ref s -> Effect s", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "modifyImpl", + "line": 61, + "declaration": "foreign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "write", + "line": 73, + "declaration": "foreign import write :: forall s. s -> Ref s -> Effect Unit", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Uncurried.purs", + "vendored_sha256": "0c6db8591d2519d9b18bf2c5ec56f33b6c25ee6f69d3edfbce8482d48771214b", + "vendored_lines": 286, + "self_recursions": [], + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "0c6db8591d2519d9b18bf2c5ec56f33b6c25ee6f69d3edfbce8482d48771214b", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Uncurried.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "mkEffectFn1", + "line": 178, + "declaration": "foreign import mkEffectFn1 :: forall a r. (a -> Effect r) -> EffectFn1 a r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn2", + "line": 180, + "declaration": "foreign import mkEffectFn2 :: forall a b r. (a -> b -> Effect r) -> EffectFn2 a b r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn3", + "line": 182, + "declaration": "foreign import mkEffectFn3 :: forall a b c r. (a -> b -> c -> Effect r) -> EffectFn3 a b c r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn4", + "line": 184, + "declaration": "foreign import mkEffectFn4 :: forall a b c d r. (a -> b -> c -> d -> Effect r) -> EffectFn4 a b c d r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn5", + "line": 186, + "declaration": "foreign import mkEffectFn5 :: forall a b c d e r. (a -> b -> c -> d -> e -> Effect r) -> EffectFn5 a b c d e r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn6", + "line": 188, + "declaration": "foreign import mkEffectFn6 :: forall a b c d e f r. (a -> b -> c -> d -> e -> f -> Effect r) -> EffectFn6 a b c d e f r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn7", + "line": 190, + "declaration": "foreign import mkEffectFn7 :: forall a b c d e f g r. (a -> b -> c -> d -> e -> f -> g -> Effect r) -> EffectFn7 a b c d e f g r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn8", + "line": 192, + "declaration": "foreign import mkEffectFn8 :: forall a b c d e f g h r. (a -> b -> c -> d -> e -> f -> g -> h -> Effect r) -> EffectFn8 a b c d e f g h r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn9", + "line": 194, + "declaration": "foreign import mkEffectFn9 :: forall a b c d e f g h i r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r) -> EffectFn9 a b c d e f g h i r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "mkEffectFn10", + "line": 196, + "declaration": "foreign import mkEffectFn10 :: forall a b c d e f g h i j r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r) -> EffectFn10 a b c d e f g h i j r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn1", + "line": 199, + "declaration": "foreign import runEffectFn1 :: forall a r. EffectFn1 a r -> a -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn2", + "line": 201, + "declaration": "foreign import runEffectFn2 :: forall a b r. EffectFn2 a b r -> a -> b -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn3", + "line": 203, + "declaration": "foreign import runEffectFn3 :: forall a b c r. EffectFn3 a b c r -> a -> b -> c -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn4", + "line": 205, + "declaration": "foreign import runEffectFn4 :: forall a b c d r. EffectFn4 a b c d r -> a -> b -> c -> d -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn5", + "line": 207, + "declaration": "foreign import runEffectFn5 :: forall a b c d e r. EffectFn5 a b c d e r -> a -> b -> c -> d -> e -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn6", + "line": 209, + "declaration": "foreign import runEffectFn6 :: forall a b c d e f r. EffectFn6 a b c d e f r -> a -> b -> c -> d -> e -> f -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn7", + "line": 211, + "declaration": "foreign import runEffectFn7 :: forall a b c d e f g r. EffectFn7 a b c d e f g r -> a -> b -> c -> d -> e -> f -> g -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn8", + "line": 213, + "declaration": "foreign import runEffectFn8 :: forall a b c d e f g h r. EffectFn8 a b c d e f g h r -> a -> b -> c -> d -> e -> f -> g -> h -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn9", + "line": 215, + "declaration": "foreign import runEffectFn9 :: forall a b c d e f g h i r. EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "runEffectFn10", + "line": 217, + "declaration": "foreign import runEffectFn10 :: forall a b c d e f g h i j r. EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect/Unsafe.purs", + "vendored_sha256": "e20339c8aed22f342fa8d452dd186079b4324cd00933b9e9f4eeb59d3313cac0", + "vendored_lines": 8, + "self_recursions": [], + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "e20339c8aed22f342fa8d452dd186079b4324cd00933b9e9f4eeb59d3313cac0", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect/Unsafe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unsafePerformEffect", + "line": 8, + "declaration": "foreign import unsafePerformEffect :: forall a. Effect a -> a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Effect.purs", + "vendored_sha256": "4095762286c11b91d19728e14e9cb260bda98e7982ee29a1b14566cee14faae7", + "vendored_lines": 72, + "self_recursions": [], + "package": "purescript-effect", + "tag": "v4.0.0", + "commit": "a192ddb923027d426d6ea3d8deb030c9aa7c7dda", + "upstream_sha256": "f5738a67511e72894c3784e44a334c94a6aa8e504fd3a29ddccc3617416b6f40", + "upstream_url": "https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "pureE", + "line": 29, + "declaration": "foreign import pureE :: forall a. a -> Effect a", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "bindE", + "line": 34, + "declaration": "foreign import bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "untilE", + "line": 53, + "declaration": "foreign import untilE :: Effect Boolean -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "whileE", + "line": 60, + "declaration": "foreign import whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "forE", + "line": 66, + "declaration": "foreign import forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "foreachE", + "line": 72, + "declaration": "foreign import foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + } + ], + "changed_original_code_outside_value_ffi": [ + { + "line": 16, + "text": "foreign import data Effect :: Type -> Type" + }, + { + "line": 18, + "text": "type role Effect representational" + }, + { + "line": 20, + "text": "instance functorEffect :: Functor Effect where" + }, + { + "line": 21, + "text": " map = liftA1" + }, + { + "line": 23, + "text": "instance applyEffect :: Apply Effect where" + }, + { + "line": 24, + "text": " apply = ap" + }, + { + "line": 26, + "text": "instance applicativeEffect :: Applicative Effect where" + }, + { + "line": 27, + "text": " pure = pureE" + }, + { + "line": 31, + "text": "instance bindEffect :: Bind Effect where" + }, + { + "line": 32, + "text": " bind = bindE" + }, + { + "line": 36, + "text": "instance monadEffect :: Monad Effect" + } + ] + }, + { + "path": "Partial/Unsafe.purs", + "vendored_sha256": "d3d70727652d25459d19f812d186cf24583de1be5eb1decd87b6bf4afc36a4bd", + "vendored_lines": 24, + "self_recursions": [], + "package": "purescript-partial", + "tag": "v4.0.0", + "commit": "0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec", + "upstream_sha256": "d3d70727652d25459d19f812d186cf24583de1be5eb1decd87b6bf4afc36a4bd", + "upstream_url": "https://github.com/purescript/purescript-partial/blob/0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec/src/Partial/Unsafe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "_unsafePartial", + "line": 16, + "declaration": "foreign import _unsafePartial :: forall a b. a -> b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Partial.purs", + "vendored_sha256": "33ec6baf7de02292b40b97ed63f91402ec09ebf49c97392bb77ea78680177cd6", + "vendored_lines": 15, + "self_recursions": [], + "package": "purescript-partial", + "tag": "v4.0.0", + "commit": "0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec", + "upstream_sha256": "33ec6baf7de02292b40b97ed63f91402ec09ebf49c97392bb77ea78680177cd6", + "upstream_url": "https://github.com/purescript/purescript-partial/blob/0fa0646f5ea1ec5f0c46dcbd770c705a6c9ad3ec/src/Partial.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "_crashWith", + "line": 15, + "declaration": "foreign import _crashWith :: forall a. String -> a", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Prelude.purs", + "vendored_sha256": "52f6778cf0da8490efb92963454d82a2b9863293d7a52c958572e2d161c3bbaf", + "vendored_lines": 104, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "af6b069885f179a179cc805e6ff7920e1c791dba6fc4d07cd2f52c5e7b91e59f", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Prelude.purs", + "status": "modified", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [ + { + "line": 14, + "text": " ( module Control.Applicative" + } + ] + }, + { + "path": "Record/Unsafe.purs", + "vendored_sha256": "21acab8a811f760d56be569f4e8c2ae30705b34711b26de1cc39b16f96ba3ac1", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "21acab8a811f760d56be569f4e8c2ae30705b34711b26de1cc39b16f96ba3ac1", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Record/Unsafe.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeHas", + "line": 10, + "declaration": "foreign import unsafeHas :: forall r1. String -> Record r1 -> Boolean", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unsafeGet", + "line": 15, + "declaration": "foreign import unsafeGet :: forall r a. String -> Record r -> a", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unsafeSet", + "line": 21, + "declaration": "foreign import unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2", + "vendored_status": "foreign_declaration_retained" + }, + { + "name": "unsafeDelete", + "line": 27, + "declaration": "foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Safe/Coerce.purs", + "vendored_sha256": "67ab89bd8194231b886591fb03a5d8cd1cbb91e68e384a7e768c4405fa6d959e", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-safe-coerce", + "tag": "v2.0.0", + "commit": "7fa799ae80a38b8d948efcb52608e58e198b3da7", + "upstream_sha256": "67ab89bd8194231b886591fb03a5d8cd1cbb91e68e384a7e768c4405fa6d959e", + "upstream_url": "https://github.com/purescript/purescript-safe-coerce/blob/7fa799ae80a38b8d948efcb52608e58e198b3da7/src/Safe/Coerce.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Test/Assert.purs", + "vendored_sha256": "6e04b61530ffab4c0dff75431b82aed94853c1207faf88e0531fa79b120c1a00", + "vendored_lines": 137, + "self_recursions": [], + "package": "purescript-assert", + "tag": "v6.0.0", + "commit": "27c0edb57d2ee497eb5fab664f5601c35b613eda", + "upstream_sha256": "666601c3d459503802027dca698b9bd05bacd42f48f7d320a834196ed4cb4127", + "upstream_url": "https://github.com/purescript/purescript-assert/blob/27c0edb57d2ee497eb5fab664f5601c35b613eda/src/Test/Assert.purs", + "status": "modified", + "upstream_value_foreign_declarations": [ + { + "name": "assertImpl", + "line": 29, + "declaration": "foreign import assertImpl :: String -> Boolean -> Effect Unit", + "vendored_status": "nonrecursive_replacement" + }, + { + "name": "checkThrows", + "line": 59, + "declaration": "foreign import checkThrows :: forall a . (Unit -> a) -> Effect Boolean", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Data/Boolean.purs", + "vendored_sha256": "5bb19aeaddc6ea478b96f06025e742284c85f413637de56cb78198b86aa5fc87", + "vendored_lines": 66, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "5bb19aeaddc6ea478b96f06025e742284c85f413637de56cb78198b86aa5fc87", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Data/Boolean.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Data/Ordering.purs", + "vendored_sha256": "fcc7c02e66257c06c4647b929e187d214d653789fee6afc49346d4990ed14997", + "vendored_lines": 69, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "fcc7c02e66257c06c4647b929e187d214d653789fee6afc49346d4990ed14997", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Data/Ordering.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Data/Symbol.purs", + "vendored_sha256": "4c3283d0804ca9d2a1ba9fdfb7cf85aacdf2d0c8f6472b383d4b162d8940817b", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "4c3283d0804ca9d2a1ba9fdfb7cf85aacdf2d0c8f6472b383d4b162d8940817b", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Data/Symbol.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Equality.purs", + "vendored_sha256": "ac672615fd3612b596eda3ab9f2472006e7ee954c7880cc91ac4865f7c120f56", + "vendored_lines": 35, + "self_recursions": [], + "package": "purescript-type-equality", + "tag": "v4.0.1", + "commit": "0525b7d39e0fbd81b4209518139fb8ab02695774", + "upstream_sha256": "ac672615fd3612b596eda3ab9f2472006e7ee954c7880cc91ac4865f7c120f56", + "upstream_url": "https://github.com/purescript/purescript-type-equality/blob/0525b7d39e0fbd81b4209518139fb8ab02695774/src/Type/Equality.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Function.purs", + "vendored_sha256": "d134b0394685faa83528c92f64c6827194b4531c956dd7d669436c30b2fd9812", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "d134b0394685faa83528c92f64c6827194b4531c956dd7d669436c30b2fd9812", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Function.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Prelude.purs", + "vendored_sha256": "2293b8cfd59325e393d51a047dcbaf4aaaf81a131c3f16c9b91ad49bb8f9732d", + "vendored_lines": 17, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "2293b8cfd59325e393d51a047dcbaf4aaaf81a131c3f16c9b91ad49bb8f9732d", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Prelude.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Proxy.purs", + "vendored_sha256": "e823c48b15006447de763d42a9f6b8c9e6913a3bd4b49b5e3b7cdce78d7d9b7c", + "vendored_lines": 53, + "self_recursions": [], + "package": "purescript-prelude", + "tag": "v6.0.1", + "commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "upstream_sha256": "e823c48b15006447de763d42a9f6b8c9e6913a3bd4b49b5e3b7cdce78d7d9b7c", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Type/Proxy.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Row/Homogeneous.purs", + "vendored_sha256": "a3db3ece627f2d2c1ef76b76a0e6699934115dd52c6e56ecf50d95868e4eaab8", + "vendored_lines": 23, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "a3db3ece627f2d2c1ef76b76a0e6699934115dd52c6e56ecf50d95868e4eaab8", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Row/Homogeneous.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/Row.purs", + "vendored_sha256": "b504404c46678bdbe8c49567a4fbbc1ba3cdddc25a7834539c23a1e99001132b", + "vendored_lines": 22, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "b504404c46678bdbe8c49567a4fbbc1ba3cdddc25a7834539c23a1e99001132b", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/Row.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Type/RowList.purs", + "vendored_sha256": "8e5b0112718c7a42104d5904dc8ad26619b04d826493fc818e375469010a24dd", + "vendored_lines": 82, + "self_recursions": [], + "package": "purescript-typelevel-prelude", + "tag": "v7.0.0", + "commit": "dca2fe3c8cfd5527d4fe70c4bedfda30148405bf", + "upstream_sha256": "8e5b0112718c7a42104d5904dc8ad26619b04d826493fc818e375469010a24dd", + "upstream_url": "https://github.com/purescript/purescript-typelevel-prelude/blob/dca2fe3c8cfd5527d4fe70c4bedfda30148405bf/src/Type/RowList.purs", + "status": "identical", + "upstream_value_foreign_declarations": [], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "Unsafe/Coerce.purs", + "vendored_sha256": "f0d052e7b2e2431860e6e995a91824c0d6437e2de773fd51c2324f626e10ed19", + "vendored_lines": 27, + "self_recursions": [], + "package": "purescript-unsafe-coerce", + "tag": "v6.0.0", + "commit": "ab956f82e66e633f647fb3098e8ddd3ec58d689f", + "upstream_sha256": "f0d052e7b2e2431860e6e995a91824c0d6437e2de773fd51c2324f626e10ed19", + "upstream_url": "https://github.com/purescript/purescript-unsafe-coerce/blob/ab956f82e66e633f647fb3098e8ddd3ec58d689f/src/Unsafe/Coerce.purs", + "status": "identical", + "upstream_value_foreign_declarations": [ + { + "name": "unsafeCoerce", + "line": 27, + "declaration": "foreign import unsafeCoerce :: forall a b. a -> b", + "vendored_status": "foreign_declaration_retained" + } + ], + "changed_original_code_outside_value_ffi": [] + }, + { + "path": "WASI/Clock.purs", + "vendored_sha256": "222f07399b2b881674691eff41d296a943824435ab13e60556f0117e048a7d0a", + "vendored_lines": 14, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Console.purs", + "vendored_sha256": "f49f4c7ae2e7c70f21bc35ce5080d000637a569e561567470ebf360c32c4beb9", + "vendored_lines": 33, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/FileSystem.purs", + "vendored_sha256": "66747fef3108642b01290cd8323b7ef9ff4aaf08703370ffcd2d1654d92f5a32", + "vendored_lines": 270, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/IO.purs", + "vendored_sha256": "e3df53b3966841930e01f4c89505172ed64996c60aae37118bb5d0d03d725c85", + "vendored_lines": 67, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Network.purs", + "vendored_sha256": "c2b769cf39bf4ba879024c5bcae388a0ee16bec143be81fb4bd199d6f3fd80d4", + "vendored_lines": 130, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Process.purs", + "vendored_sha256": "4cfd83ff897a6b3a1cea44aa6d4d5a3fd6e3d4d3a8ad30061ba80636de0bca7b", + "vendored_lines": 13, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Random.purs", + "vendored_sha256": "c05d4bf338e66e0358d9c74a494d8d84c2c4c99e37750a54c909600834175ee9", + "vendored_lines": 16, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI/Resource.purs", + "vendored_sha256": "8da4a53234de3f7d1ec6ee6aaead124a27201edba261da22da38f171fb167acc", + "vendored_lines": 14, + "self_recursions": [], + "status": "platform_addition" + }, + { + "path": "WASI.purs", + "vendored_sha256": "a1f72de13e9676ec66a87080e631ed4e31bf4a4392b10b6fdeabfc39f8d2bb11", + "vendored_lines": 102, + "self_recursions": [], + "status": "platform_addition" + } + ], + "absent_modules": [], + "limits": [ + "Only supplied upstream checkouts are compared; baseline_unavailable is not a pass.", + "Self-recursion detection covers exact top-level same-argument equations only.", + "The script records differences without approving target adaptations or proving semantic equivalence.", + "The official compiler support dependency ranges do not uniquely pin package patch versions." + ] +} diff --git a/docs/implementation/stdlib/vendor-restoration-2026-10-06/modules.md b/docs/implementation/stdlib/vendor-restoration-2026-10-06/modules.md new file mode 100644 index 00000000..21462131 --- /dev/null +++ b/docs/implementation/stdlib/vendor-restoration-2026-10-06/modules.md @@ -0,0 +1,221 @@ +# Vendored module inventory + +Generated by `audit-stdlib-vendor.py`. Status is comparison evidence, not approval. + +| Module path | Official package/tag | Comparison | Direct self-recursions | +| --- | --- | --- | --- | +| `Control/Alt.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Alternative.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Applicative.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/Apply.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/Biapplicative.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Control/Biapply.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Control/Bind.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/Category.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/Comonad.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Extend.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Lazy.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Monad/Gen/Class.purs` | purescript-gen v4.0.0 | identical | 0 | +| `Control/Monad/Gen/Common.purs` | purescript-gen v4.0.0 | identical | 0 | +| `Control/Monad/Gen.purs` | purescript-gen v4.0.0 | identical | 0 | +| `Control/Monad/Rec/Class.purs` | purescript-tailrec v6.1.0 | identical | 0 | +| `Control/Monad/ST/Class.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Global.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Internal.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Ref.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST/Uncurried.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad/ST.purs` | purescript-st v6.2.0 | identical | 0 | +| `Control/Monad.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Control/MonadPlus.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Plus.purs` | purescript-control v6.0.0 | identical | 0 | +| `Control/Semigroupoid.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Array/NonEmpty/Internal.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/NonEmpty.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/Partial.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/ST/Iterator.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/ST/Partial.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array/ST.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Array.purs` | purescript-arrays v7.3.0 | identical | 0 | +| `Data/Bifoldable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Bifunctor/Join.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Data/Bifunctor.purs` | purescript-bifunctors v6.1.0 | identical | 0 | +| `Data/Bitraversable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Boolean.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/BooleanAlgebra.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Bounded/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Bounded.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Char/Gen.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/Char.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/CommutativeRing.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Compactable.purs` | purescript-filterable v5.0.0 | identical | 0 | +| `Data/Comparison.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Const.purs` | purescript-const v6.0.0 | identical | 0 | +| `Data/Decidable.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Decide.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Distributive.purs` | purescript-distributive v6.0.0 | identical | 0 | +| `Data/Divide.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Divisible.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/DivisionRing.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Either/Inject.purs` | purescript-either v6.1.0 | identical | 0 | +| `Data/Either/Nested.purs` | purescript-either v6.1.0 | identical | 0 | +| `Data/Either.purs` | purescript-either v6.1.0 | identical | 0 | +| `Data/Enum/Gen.purs` | purescript-enums v6.0.1 | identical | 0 | +| `Data/Enum/Generic.purs` | purescript-enums v6.0.1 | identical | 0 | +| `Data/Enum.purs` | purescript-enums v6.0.1 | identical | 0 | +| `Data/Eq/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Eq.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Equivalence.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/EuclideanRing.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Exists.purs` | purescript-exists v6.0.0 | identical | 0 | +| `Data/Field.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Filterable.purs` | purescript-filterable v5.0.0 | identical | 0 | +| `Data/Foldable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/FoldableWithIndex.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Function/Uncurried.purs` | purescript-functions v6.0.0 | identical | 0 | +| `Data/Function.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Functor/App.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Clown.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Compose.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Contravariant.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Functor/Coproduct/Inject.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Coproduct/Nested.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Coproduct.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Costar.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Flip.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Invariant.purs` | purescript-invariant v6.0.0 | identical | 0 | +| `Data/Functor/Joker.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Product/Nested.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Product.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor/Product2.purs` | purescript-functors v5.0.0 | identical | 0 | +| `Data/Functor.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/FunctorWithIndex.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Generic/Rep.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/HeytingAlgebra/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/HeytingAlgebra.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Identity.purs` | purescript-identity v6.0.0 | identical | 0 | +| `Data/Int/Bits.purs` | purescript-integers v6.0.0 | identical | 0 | +| `Data/Int.purs` | purescript-integers v6.0.0 | identical | 0 | +| `Data/Lazy.purs` | purescript-lazy v6.0.0 | identical | 0 | +| `Data/List/Internal.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Lazy/NonEmpty.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Lazy/Types.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Lazy.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/NonEmpty.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Partial.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/Types.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List/ZipList.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/List.purs` | purescript-lists v7.0.0 | identical | 0 | +| `Data/Map/Gen.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Map/Internal.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Map.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Maybe/First.purs` | purescript-maybe v6.0.0 | identical | 0 | +| `Data/Maybe/Last.purs` | purescript-maybe v6.0.0 | identical | 0 | +| `Data/Maybe.purs` | purescript-maybe v6.0.0 | identical | 0 | +| `Data/Monoid/Additive.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Alternate.purs` | purescript-control v6.0.0 | identical | 0 | +| `Data/Monoid/Conj.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Disj.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Dual.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Endo.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid/Multiplicative.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Monoid.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/NaturalTransformation.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Newtype.purs` | purescript-newtype v5.0.0 | identical | 0 | +| `Data/NonEmpty.purs` | purescript-nonempty v7.0.0 | identical | 0 | +| `Data/Number/Approximate.purs` | purescript-numbers v9.0.1 | identical | 0 | +| `Data/Number/Format.purs` | purescript-numbers v9.0.1 | identical | 0 | +| `Data/Number.purs` | purescript-numbers v9.0.1 | identical | 0 | +| `Data/Op.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Ord/Down.purs` | purescript-orders v6.0.0 | identical | 0 | +| `Data/Ord/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Ord/Max.purs` | purescript-orders v6.0.0 | identical | 0 | +| `Data/Ord/Min.purs` | purescript-orders v6.0.0 | identical | 0 | +| `Data/Ord.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Ordering.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Predicate.purs` | purescript-contravariant v6.0.0 | identical | 0 | +| `Data/Profunctor/Choice.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Closed.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Cochoice.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Costrong.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Join.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Split.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Star.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor/Strong.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Profunctor.purs` | purescript-profunctor v6.0.1 | identical | 0 | +| `Data/Reflectable.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Ring/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Ring.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/First.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/Foldable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Semigroup/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/Last.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semigroup/Traversable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Semigroup.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semiring/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Semiring.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Set/NonEmpty.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Set.purs` | purescript-ordered-collections v3.2.0 | identical | 0 | +| `Data/Show/Generic.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Show.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/String/CaseInsensitive.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/CodePoints.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/CodeUnits.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Common.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Gen.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/CaseInsensitive.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/CodePoints.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/CodeUnits.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty/Internal.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/NonEmpty.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Pattern.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Regex/Flags.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Regex/Unsafe.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Regex.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String/Unsafe.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/String.purs` | purescript-strings v6.0.1 | identical | 0 | +| `Data/Symbol.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Traversable/Accum/Internal.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Traversable/Accum.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Traversable.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/TraversableWithIndex.purs` | purescript-foldable-traversable v6.0.0 | identical | 0 | +| `Data/Tuple/Nested.purs` | purescript-tuples v7.0.0 | identical | 0 | +| `Data/Tuple.purs` | purescript-tuples v7.0.0 | identical | 0 | +| `Data/Unfoldable.purs` | purescript-unfoldable v6.0.0 | identical | 0 | +| `Data/Unfoldable1.purs` | purescript-unfoldable v6.0.0 | identical | 0 | +| `Data/Unit.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Data/Void.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Data/Witherable.purs` | purescript-filterable v5.0.0 | identical | 0 | +| `Effect/Class/Console.purs` | purescript-console v6.0.0 | identical | 0 | +| `Effect/Class.purs` | purescript-effect v4.0.0 | identical | 0 | +| `Effect/Console.purs` | purescript-console v6.0.0 | modified | 0 | +| `Effect/Ref.purs` | purescript-refs v6.0.0 | identical | 0 | +| `Effect/Uncurried.purs` | purescript-effect v4.0.0 | identical | 0 | +| `Effect/Unsafe.purs` | purescript-effect v4.0.0 | identical | 0 | +| `Effect.purs` | purescript-effect v4.0.0 | modified | 0 | +| `Partial/Unsafe.purs` | purescript-partial v4.0.0 | identical | 0 | +| `Partial.purs` | purescript-partial v4.0.0 | identical | 0 | +| `Prelude.purs` | purescript-prelude v6.0.1 | modified | 0 | +| `Record/Unsafe.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Safe/Coerce.purs` | purescript-safe-coerce v2.0.0 | identical | 0 | +| `Test/Assert.purs` | purescript-assert v6.0.0 | modified | 0 | +| `Type/Data/Boolean.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Data/Ordering.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Data/Symbol.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Equality.purs` | purescript-type-equality v4.0.1 | identical | 0 | +| `Type/Function.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Prelude.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Proxy.purs` | purescript-prelude v6.0.1 | identical | 0 | +| `Type/Row/Homogeneous.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/Row.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Type/RowList.purs` | purescript-typelevel-prelude v7.0.0 | identical | 0 | +| `Unsafe/Coerce.purs` | purescript-unsafe-coerce v6.0.0 | identical | 0 | +| `WASI/Clock.purs` | unavailable | platform_addition | 0 | +| `WASI/Console.purs` | unavailable | platform_addition | 0 | +| `WASI/FileSystem.purs` | unavailable | platform_addition | 0 | +| `WASI/IO.purs` | unavailable | platform_addition | 0 | +| `WASI/Network.purs` | unavailable | platform_addition | 0 | +| `WASI/Process.purs` | unavailable | platform_addition | 0 | +| `WASI/Random.purs` | unavailable | platform_addition | 0 | +| `WASI/Resource.purs` | unavailable | platform_addition | 0 | +| `WASI.purs` | unavailable | platform_addition | 0 | diff --git a/docs/implementation/stdlib/vendor-restoration-2026-10-06/official-vs-vendored.diff b/docs/implementation/stdlib/vendor-restoration-2026-10-06/official-vs-vendored.diff new file mode 100644 index 00000000..32168725 --- /dev/null +++ b/docs/implementation/stdlib/vendor-restoration-2026-10-06/official-vs-vendored.diff @@ -0,0 +1,261 @@ +--- purescript-prelude@v6.0.1/src/Data/Unit.purs ++++ stdlib/lib/Data/Unit.purs +@@ -1,14 +1,5 @@ +-module Data.Unit where +- +--- | The `Unit` type has a single inhabitant, called `unit`. It represents +--- | values with no computational content. +--- | +--- | `Unit` is often used, wrapped in a monadic type constructor, as the +--- | return type of a computation where only the _effects_ are important. +--- | +--- | When returning a value of type `Unit` from an FFI function, it is +--- | recommended to use `undefined`, or not return a value at all. +-foreign import data Unit :: Type +- +--- | `unit` is the sole inhabitant of the `Unit` type. +-foreign import unit :: Unit ++-- | `Unit` is a compiler builtin, the same type as an unqualified ++-- | `Unit`. This module re-exports that builtin and the `unit` ++-- | primitive so `import Data.Unit` matches the official library ++-- | without declaring a second unit type. ++module Data.Unit (Unit, unit) where +--- purescript-console@v6.0.0/src/Effect/Console.purs ++++ stdlib/lib/Effect/Console.purs +@@ -1,14 +1,15 @@ + module Effect.Console where + + import Effect (Effect) ++import WASI.Console as Console + + import Data.Show (class Show, show) + import Data.Unit (Unit) + + -- | Write a message to the console. +-foreign import log +- :: String +- -> Effect Unit ++-- WASI routes log to its log stream operation. ++log :: String -> Effect Unit ++log = Console.log + + -- | Write a value to the console, using its `Show` instance to produce a + -- | `String`. +@@ -16,9 +17,9 @@ + logShow a = log (show a) + + -- | Write an warning to the console. +-foreign import warn +- :: String +- -> Effect Unit ++-- WASI routes warn to its warn stream operation. ++warn :: String -> Effect Unit ++warn = Console.warn + + -- | Write an warning value to the console, using its `Show` instance to produce + -- | a `String`. +@@ -26,9 +27,9 @@ + warnShow a = warn (show a) + + -- | Write an error to the console. +-foreign import error +- :: String +- -> Effect Unit ++-- WASI routes error to its error stream operation. ++error :: String -> Effect Unit ++error = Console.error + + -- | Write an error value to the console, using its `Show` instance to produce a + -- | `String`. +@@ -36,9 +37,9 @@ + errorShow a = error (show a) + + -- | Write an info message to the console. +-foreign import info +- :: String +- -> Effect Unit ++-- WASI routes info to its log stream operation. ++info :: String -> Effect Unit ++info = Console.log + + -- | Write an info value to the console, using its `Show` instance to produce a + -- | `String`. +@@ -46,9 +47,9 @@ + infoShow a = info (show a) + + -- | Write an debug message to the console. +-foreign import debug +- :: String +- -> Effect Unit ++-- WASI routes debug to its log stream operation. ++debug :: String -> Effect Unit ++debug = Console.log + + -- | Write an debug value to the console, using its `Show` instance to produce a + -- | `String`. +--- purescript-effect@v4.0.0/src/Effect.purs ++++ stdlib/lib/Effect.purs +@@ -13,27 +13,14 @@ + -- | A native effect. The type parameter denotes the return type of running the + -- | effect, that is, an `Effect Int` is a possibly-effectful computation which + -- | eventually produces a value of the type `Int` when it finishes. +-foreign import data Effect :: Type -> Type ++-- The Wasm state-token type and core instances are owned by Prelude. + +-type role Effect representational ++-- Target adapters retain the private upstream operation contracts. ++pureE :: forall a. a -> Effect a ++pureE = pure + +-instance functorEffect :: Functor Effect where +- map = liftA1 +- +-instance applyEffect :: Apply Effect where +- apply = ap +- +-instance applicativeEffect :: Applicative Effect where +- pure = pureE +- +-foreign import pureE :: forall a. a -> Effect a +- +-instance bindEffect :: Bind Effect where +- bind = bindE +- +-foreign import bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b +- +-instance monadEffect :: Monad Effect ++bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b ++bindE = bind + + -- | The `Semigroup` instance for effects allows you to run two effects, one + -- | after the other, and then combine their results using the result type's +@@ -50,23 +37,36 @@ + -- | + -- | `untilE b` is an effectful computation which repeatedly runs the effectful + -- | computation `b`, until its return value is `true`. +-foreign import untilE :: Effect Boolean -> Effect Unit ++untilE :: Effect Boolean -> Effect Unit ++untilE action = bind action \done -> ++ if done then pure unit else untilE action + + -- | Loop while a condition is `true`. + -- | + -- | `whileE b m` is effectful computation which runs the effectful computation + -- | `b`. If its result is `true`, it runs the effectful computation `m` and + -- | loops. If not, the computation ends. +-foreign import whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit ++whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit ++whileE condition action = bind condition \continue -> ++ if continue then bind action (\_ -> whileE condition action) else pure unit + + -- | Loop over a consecutive collection of numbers. + -- | + -- | `forE lo hi f` runs the computation returned by the function `f` for each + -- | of the inputs between `lo` (inclusive) and `hi` (exclusive). +-foreign import forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit ++forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit ++forE lower upper action = ++ if lower < upper then bind (action lower) (\_ -> forE (lower + 1) upper action) ++ else pure unit + + -- | Loop over an array of values. + -- | + -- | `foreachE xs f` runs the computation returned by the function `f` for each + -- | of the inputs `xs`. +-foreign import foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit ++foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit ++foreachE values action = go 0 ++ where ++ go index = ++ if intLt index (arrayLength values) ++ then bind (action (arrayIndex values index)) (\_ -> go (intAdd index 1)) ++ else pure unit +--- purescript-prelude@v6.0.1/src/Prelude.purs ++++ stdlib/lib/Prelude.purs +@@ -1,17 +1,20 @@ +--- | `Prelude` is a module that re-exports many other foundational modules from the `purescript-prelude` library +--- | (e.g. the Monad type class hierarchy, the Monoid type classes, Eq, Ord, etc.). ++-- | The primitive surface the rest of the library and the corpus build on. + -- | +--- | Typically, this module will be imported in most other libraries and projects as an open import. ++-- | The class hierarchy is the official `purescript-prelude` v6.0.1 re-export ++-- | list. `Effect` stays in this module: `check_run_effect_scope` resolves ++-- | `Prelude.runEffect`, and `psrs_core::effect::operations` synthesizes ++-- | `effectPure`, `effectBind`, `runEffect`, and `trap` from the `psrs:effect` ++-- | bindings declared here. The class methods `pure` and `bind` are the ++-- | official `Applicative` and `Bind` methods; the `Effect` instances call ++-- | those bindings, so creating an action still does not run it. + -- | +--- | ``` +--- | module MyModule where +--- | +--- | import Prelude -- open import +--- | +--- | import Data.Maybe (Maybe(..)) -- closed import +--- | ``` ++-- | `unit` is not declared here. `Unit` is a builtin, re-exported through ++-- | `Data.Unit`, and the one `Unit` value is `Intrinsic::Unit`. + module Prelude +- ( module Control.Applicative ++ ( Effect ++ , runEffect ++ , trap ++ , module Control.Applicative + , module Control.Apply + , module Control.Bind + , module Control.Category +@@ -68,3 +71,34 @@ + import Data.Show (class Show, show) + import Data.Unit (Unit, unit) + import Data.Void (Void, absurd) ++ ++foreign import data Effect :: Type -> Type ++type role Effect representational ++ ++-- | Builds an `Effect` that returns `value`. Lowering replaces this binding; ++-- | the `Applicative` instance is what user code calls `pure`. ++foreign import "psrs:effect#pure" effectPure :: forall a. a -> Effect a ++ ++-- | Sequences two effects. The `Bind` instance is what user code calls `bind`. ++foreign import "psrs:effect#bind" effectBind :: forall a b. Effect a -> (a -> Effect b) -> Effect b ++ ++foreign import "psrs:effect#run" runEffect :: forall a. Effect a -> a ++ ++-- | The effect that escapes instead of returning. An uncaught failure on this ++-- | target is a guest trap, so this is the one operation whose result never ++-- | exists; it is how a library reports an assertion that did not hold. ++foreign import "psrs:effect#trap" trap :: Effect Unit ++ ++instance functorEffect :: Functor Effect where ++ map = liftA1 ++ ++instance applyEffect :: Apply Effect where ++ apply = ap ++ ++instance applicativeEffect :: Applicative Effect where ++ pure = effectPure ++ ++instance bindEffect :: Bind Effect where ++ bind = effectBind ++ ++instance monadEffect :: Monad Effect +--- purescript-assert@v6.0.0/src/Test/Assert.purs ++++ stdlib/lib/Test/Assert.purs +@@ -26,10 +26,13 @@ + assert' :: String -> Boolean -> Effect Unit + assert' = assertImpl + +-foreign import assertImpl +- :: String +- -> Boolean +- -> Effect Unit ++-- Wasm/WASI implementation: failure writes its message before trapping. ++assertImpl :: String -> Boolean -> Effect Unit ++assertImpl message condition = ++ if condition then pure unit ++ else do ++ _ <- error message ++ trap + + -- | Throws a runtime exception with message "Assertion failed: An error should + -- | have been thrown", unless the argument throws an exception when evaluated. diff --git a/docs/implementation/stdlib/vendor-restoration-2026-10-06/report.md b/docs/implementation/stdlib/vendor-restoration-2026-10-06/report.md new file mode 100644 index 00000000..1e5b12d0 --- /dev/null +++ b/docs/implementation/stdlib/vendor-restoration-2026-10-06/report.md @@ -0,0 +1,122 @@ +# Standard-library restoration checkpoint + +This checkpoint describes the uncommitted restoration on top of revision +`67369ba`, on `stdlib/vendor-core-libraries`. It does not supersede the +[historical audit](../vendor-audit-2026-10-06/report.md), which records the +defects in that revision. The governing policy is +[standard-library source fidelity](../../../workflow/stdlib-vendoring.md). + +## Source evidence + +The [inventory](inventory.json) pins all 41 upstream packages by release tag, +commit, and per-module SHA-256. All 206 official modules are now present: +201 are byte-identical and five have target adaptations. The nine additional +modules are the existing WASI integration. No exact top-level same-argument +self-recursion remains; the detector previously found 200 such placeholders. +This syntactic check is not a general termination or semantic-equivalence proof. + +The four restored modules are `Effect.Class`, `Effect.Class.Console`, +`Effect.Uncurried`, and `Effect.Unsafe`. The official Tuple instances, Show +surface, assertion wrappers, console Show wrappers, pure combinators, and +instance method definitions have been restored. Original vendored source +length is preserved under the explicitly approved exception to the maintained +source-file limit. + +See [the exact remaining diff](official-vs-vendored.diff) and +[the module table](modules.md). An inventory difference is not approval of +an adaptation or proof that its implementation works. + +## Target adaptations and remaining obligations + +| Module | Target reason and owner | Preserved contract | Unverified obligations | +| --- | --- | --- | --- | +| `Prelude` | Existing state-token Effect operations and command entry, governed by the effects design | Ordinary official re-exports; Effect methods use the official combinators; representational role retained | Source ownership of Effect is relocated; execute sequencing and callback cases under mandatory Wasmtime | +| `Data.Unit` | Compiler-owned builtin Unit representation | Public Unit and unit are re-exported | Verify builtin ownership against the official public role and instance contract | +| `Effect` | Source wrappers around the target state-token operations | Official exports, loop signatures, Semigroup and Monoid bodies; core instances remain in Prelude | Execute all four loops, zero iterations, order, boundary inputs, and termination; source recursion may differ from the upstream iterative implementation in resource use | +| `Effect.Console` | WASI streams replace JavaScript console methods | All public values and official Show wrappers restored | Verify stream routing and output; time, timeLog, timeEnd, and clear retain foreign declarations without implementations | +| `Test.Assert` | WASI stderr plus the existing guest-trap failure protocol | All ten public values and ordinary comparisons/message construction restored | Execute successful and failed assertions; checkThrows and catch-based assertion behavior remain unsupported | + +The Effect implementation owner and protocol are described in +[effects](../../../design/backend/fp/effects.md). Unit ownership is described +in [scalars and primitives](../../../design/backend/fp/scalars-and-primitives.md). +Unicode target differences remain governed by DEC-16; no numeric formatting +approximation or pure API deletion is justified by UTF-8 storage. + +These adaptations are candidate implementations, not completed runtime +acceptance. In particular, retaining the `checkThrows` declaration preserves +the public source surface without pretending that guest traps can be caught. + +## Foreign declarations and compiler contracts + +Ordinary `foreign import` now retains its absence of an explicit WIT binding in +AST and its declaring module in HIR. Source declarations enter the ordinary +value namespace before fixity resolution. Imports and re-exports retain their +declaration symbol and signature and take precedence over bootstrap intrinsics. +THIR and Core require checked external signatures for ordinary library imports +as well as WIT imports. Foreign signatures with class constraints remain +rejected, matching the official compiler's restriction. + +P8 reports a missing target implementation explicitly, including declaration +ownership. No recursive source body or fabricated WIT import replaces it. +All 275 retained ordinary foreign declarations still need target implementations +and behavior evidence. The [binding inventory](foreign-bindings.json) links +every declaration to its pinned official source; the +[module summary](foreign-bindings.md) distinguishes the complete inventory from +the reproducer's import closure. + +Future target implementations must use an explicit binding contract, validate +the checked source signature, and retain producer/consumer evidence until the +owning lowering discharges it. Matching a spelling or guessing an arity cannot +establish representation compatibility. Scalar operations, polymorphic array +callbacks, mutable ST/Ref state, lazy values, uncurried functions, regexes, +number rendering, and failure behavior require their own observable tests. + +## Validation + +The pre-restoration import-only reproducer compiled in 21,707 ms, with the +recursive placeholders still present. After restoration and a fresh offline +CLI build, the same `/tmp/psrs-stdlib-all.purs` failed in 26,669 ms with +253 `P8 library linking` diagnostics and no earlier diagnostics. A subsequent +rebuild after completing THIR signature validation produced the same 253 +diagnostics in 21,996 ms. The first is +`Control.Apply.arrayApply`. The snapshot is `/tmp/psrs-stdlib-all.json`; its +complete input set is recorded, with trusted-library fingerprint +`fnv1a64:3f3081e2d1ea1032`. Source inputs intentionally changed, so this is +restoration evidence rather than a compatible-input compiler-only comparison. + +Focused validation: + +- `cargo test -p psrs-driver --lib let_constraints --offline`: 14 passed. +- Six passing library foreign tests cover checked evidence, source shadowing, imports, + fixities, forbidden constraints, and explicit missing-implementation errors. +- `PURESCRIPT_REPO=/Users/biu/Projects/purescript cargo test -p psrs-driver + --test upstream differential_library_foreign --offline`: passed against + official purs 0.15.16, including a same-name bootstrap collision. +- The trusted-order loader test passed. This validates loading/checking, not + target implementation or runtime behavior. +- `cargo test -p psrs-core --lib external_types --offline`: seven passed. +- THIR checked-external tests: six passed, including missing library evidence. + Backend binding projection tests: four passed. The existing class-constrained + WIT rejection test also passed with its original diagnostic. +- `cargo fmt --all --check` and strict workspace clippy with all targets passed. + +The filtered resolver command selected zero tests and supplies no independent +resolver coverage; the driver and official comparison exercise that boundary. +No workspace test suite, full runtime scoreboard, or full FFI behavior suite was +run. No D-04 or README measurement was changed. The restored stdlib does **not** +compile fully and does **not** have full runtime acceptance. + +## Reproduce the source comparison + +```sh +python3 docs/workflow/tools/audit-stdlib-vendor.py \ + --vendor stdlib/lib \ + --upstream /tmp/ps-pkgs \ + --upstream /tmp/purescript-prelude \ + --upstream /tmp/psrs-stdlib-audit-20261006/upstream \ + --out /tmp/psrs-stdlib-fidelity-current +``` + +Those directories must contain the exact clean tagged checkouts recorded in +the inventory. The comparison tool does not fetch dependencies or approve +changes. Preserve the historical audit separately from new measurements. diff --git a/docs/workflow/stdlib-vendoring.md b/docs/workflow/stdlib-vendoring.md new file mode 100644 index 00000000..72ce2a5a --- /dev/null +++ b/docs/workflow/stdlib-vendoring.md @@ -0,0 +1,90 @@ +# Standard-library source fidelity + +The vendored standard library preserves the official PureScript source contract. +The only permitted semantic differences have a concrete Wasm/WASI target or +DEC-16 Unicode scalar/UTF-8 representation justification. This policy governs +both new imports and repairs of the existing library. + +## Upstream provenance + +Record the upstream repository URL, exact release tag, commit, and source hash +for every package/module. Dependency ranges do not identify a reproducible +baseline. Include all package source modules; an omitted module is an explicit +gap, not an implicitly supported subset. Audit byte-level differences and +review changes to APIs and behavior separately. + +Official vendored `.purs` files retain upstream length even when they exceed +500 lines. The repository's 500-line rule continues to apply to maintained +compiler and tooling source. Do not split official modules to satisfy that rule. + +The initial complete audit and pinned comparison baselines are recorded in +[the source audit](../implementation/stdlib/vendor-audit-2026-10-06/report.md). +That audit describes revision 67369ba, including defects; it is not an approved +patch manifest. Its repeatable inventory tool is +[audit-stdlib-vendor.py](tools/audit-stdlib-vendor.py). + +The [restoration checkpoint](../implementation/stdlib/vendor-restoration-2026-10-06/report.md) +records restored sources, remaining target adaptations, and missing foreign +implementations separately from the historical defects. + +## Preserve ordinary PureScript + +Preserve official pure functions, type signatures, exports, type roles, classes, +instances, and modules. Do not remove a declaration because the compiler cannot +handle it. Do not eta-expand instance methods, replace a valid combinator, +change a record signature, or simplify a module to work around inference, +resolution, deriving, closure, or layout defects. Fix the owning compiler stage +and validate the unchanged source instead. + +Compiler-provided interfaces must have one declared semantic owner and validate +their public source contract. A primitive implementation must not arise from a +function-name heuristic, inferred arity, or a fabricated source body. + +## Foreign implementations and target adaptations + +An official foreign declaration states the public type; the target implements +that contract through an explicit primitive or host binding. The compiler must +retain checked binding identity and type evidence through lowering. Where a +binding is not implemented, compilation or linking reports unsupported target +support. No recursive equation, arbitrary constant, empty result, or permissive +fallback can stand in for the implementation. + +Each deliberate target adaptation records: + +1. The pinned original declaration and exact source difference. +2. The target requirement, with its governing design or decision. +3. The implementation owner and preserved source/API guarantees. +4. Behavior evidence for normal, boundary, and failure cases. +5. Any deliberately different observable behavior and remaining obligations. + +WASI routing and a declared trap-based failure protocol can justify changes to +host I/O and exception handling. They do not justify deleting comparison +assertions, tuple instances, console Show wrappers, or other pure APIs. UTF-8 +storage does not justify removing Show instances or approximating unrelated +numeric rendering. Target limitations must be recorded without redefining +official support around the implemented subset. + +## Verification and reporting + +Keep these acceptance layers separate: + +- Source fidelity: complete inventory, upstream hashes, exact diffs, and reviewed + target adaptations, including omitted module/API checks. +- Compilation: the restored source closure passes the compiler, with missing + support reported at its actual owning stage. +- Runtime: programs actually call the APIs and assert returned values, output, + mutation, sequencing, and failure behavior under mandatory Wasmtime. +- Foreign behavior: each implemented binding has type/ABI checks and observable + behavior comparisons with the official implementation or its explicit target + contract. Keep DEC-16 differences visible in Unicode cases. + +An import-only program with `main = 0` proves none of the runtime assertions. +Dead-code elimination can hide missing implementations and layouts. A runtime +scoreboard without output goldens proves execution without traps, not complete +semantic agreement. Missing or skipped execution is unverified. + +Follow [the compiler iteration SOP](compiler-iteration-sop.md), use focused +tests for each restored interaction, and capture comparable compile diagnoses. +Update roadmap measurements only after the required full scoreboard run. Do not +claim completion while any required API, binding, source-restoration obligation, +or behavior evidence remains missing. diff --git a/docs/workflow/tools/audit-stdlib-vendor.py b/docs/workflow/tools/audit-stdlib-vendor.py new file mode 100644 index 00000000..c93f0a86 --- /dev/null +++ b/docs/workflow/tools/audit-stdlib-vendor.py @@ -0,0 +1,233 @@ +#!/usr/bin/env python3 +"""Compare vendored modules with locally available, tagged upstream checkouts. + +This is an inventory, not an allowlist or a PureScript semantic verifier. +It never modifies library sources and never downloads missing dependencies. +""" + +import argparse +import collections +import difflib +import hashlib +import json +from pathlib import Path +import re +import subprocess + + +def git(root, *args): + return subprocess.check_output( + ["git", "-C", str(root), *args], text=True + ).strip() + + +def digest(data): + return hashlib.sha256(data).hexdigest() + + +def append_diff(patch, original, vendored, before_path, after_path): + differences = difflib.unified_diff( + original.splitlines(keepends=True), vendored.splitlines(keepends=True), + fromfile=before_path, tofile=after_path, + ) + for line in differences: + patch.append(line if line.endswith("\n") else line + "\n\\ No newline at end of file\n") + + +def foreign_declarations(text): + lines = text.splitlines() + declarations = [] + covered = set() + for index, line in enumerate(lines): + match = re.match(r"^foreign import (?!data\b)([\w']+)\b", line) + if not match: + continue + end = index + 1 + while end < len(lines) and lines[end].startswith((" ", "\t")): + end += 1 + covered.update(range(index, end)) + declarations.append({ + "name": match[1], + "line": index + 1, + "declaration": " ".join(part.strip() for part in lines[index:end]), + }) + return declarations, covered + + +def self_recursions(text): + result = [] + for number, line in enumerate(text.splitlines(), 1): + match = re.fullmatch( + r"([A-Za-z_][\w']*(?:\s+[A-Za-z_][\w']*)*)\s*=\s*(.*?)\s*", + line, + ) + if match and match[1].split() == match[2].split(): + result.append({"name": match[1].split()[0], "line": number, "equation": line}) + return result + + +def ordinary_removals(before, after, foreign_lines): + """Report changed original code outside value FFI declaration spans. + + This deliberately reports eta expansion and signature/layout changes too. + A reported removal requires review; it does not automatically prove a bug. + """ + old, new = before.splitlines(), after.splitlines() + result = [] + for kind, start, end, _, _ in difflib.SequenceMatcher( + None, old, new, autojunk=False + ).get_opcodes(): + if kind not in ("delete", "replace"): + continue + for index in range(start, end): + line = old[index] + if index not in foreign_lines and line.strip() and not line.lstrip().startswith("--"): + result.append({"line": index + 1, "text": line}) + return result + + +def main(): + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument("--vendor", type=Path, required=True) + parser.add_argument("--upstream", type=Path, action="append", required=True, + help="A git checkout with src/, or a directory of those checkouts") + parser.add_argument("--out", type=Path, required=True) + args = parser.parse_args() + args.out.mkdir(parents=True, exist_ok=True) + roots = [] + for root in args.upstream: + if (root / "src").is_dir(): + roots.append(root) + else: + roots.extend(child for child in sorted(root.iterdir()) if (child / "src").is_dir()) + + packages, sources = [], {} + for root in roots: + if git(root, "status", "--porcelain"): + raise SystemExit(f"upstream checkout is dirty: {root}") + package = { + "name": root.name, + "checkout": str(root.resolve()), + "commit": git(root, "rev-parse", "HEAD"), + "tag": git(root, "describe", "--tags", "--exact-match"), + "remote": git(root, "remote", "get-url", "origin"), + } + packages.append(package) + for path in sorted((root / "src").rglob("*.purs")): + relative = path.relative_to(root / "src").as_posix() + if relative in sources: + raise SystemExit(f"duplicate upstream source: {relative}") + sources[relative] = (path, package) + + modules, patch = [], [] + for path in sorted(args.vendor.rglob("*.purs")): + relative = path.relative_to(args.vendor).as_posix() + data = path.read_bytes() + text = data.decode("utf-8") + row = { + "path": relative, + "vendored_sha256": digest(data), + "vendored_lines": len(text.splitlines()), + "self_recursions": self_recursions(text), + } + if relative not in sources: + row["status"] = "platform_addition" if relative.startswith("WASI/") or relative == "WASI.purs" else "baseline_unavailable" + modules.append(row) + continue + upstream, package = sources[relative] + original_data = upstream.read_bytes() + original = original_data.decode("utf-8") + row.update({ + "package": package["name"], + "tag": package["tag"], + "commit": package["commit"], + "upstream_sha256": digest(original_data), + "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, + "status": "identical" if data == original_data else "newline_only" if original.splitlines() == text.splitlines() else "modified", + }) + declarations, covered = foreign_declarations(original) + names = {declaration["name"] for declaration in declarations} + recursive_names = {recursion["name"] for recursion in row["self_recursions"]} + retained_foreign_names = set(re.findall( + r'^foreign import (?:"[^"\n]*"\s+)?(?!data\b)([\w\x27]+)\b', text, re.M + )) + for declaration in declarations: + name = declaration["name"] + declaration["vendored_status"] = ( + "foreign_declaration_retained" if name in retained_foreign_names else + "direct_self_recursion" if name in recursive_names else + "nonrecursive_replacement" if re.search(r"^" + re.escape(name) + r"\s*::", text, re.M) else + "declaration_removed" + ) + row["upstream_value_foreign_declarations"] = declarations + for recursion in row["self_recursions"]: + recursion["replaces_upstream_foreign"] = recursion["name"] in names + row["changed_original_code_outside_value_ffi"] = ordinary_removals(original, text, covered) + if data != original_data: + append_diff(patch, original, text, + package["name"] + "@" + package["tag"] + "/src/" + relative, + "stdlib/lib/" + relative) + modules.append(row) + + absent_modules = [] + absent_paths = sorted(set(sources) - {row["path"] for row in modules}) + for relative in absent_paths: + path, package = sources[relative] + data = path.read_bytes() + absent_modules.append({ + "path": relative, + "package": package["name"], + "tag": package["tag"], + "commit": package["commit"], + "upstream_sha256": digest(data), + "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, + }) + append_diff(patch, data.decode("utf-8"), "", + package["name"] + "@" + package["tag"] + "/src/" + relative, + "/dev/null") + + counts = dict(collections.Counter(row["status"] for row in modules)) + counts.update({ + "vendored_modules": len(modules), + "packages": len(packages), + "direct_self_recursions": sum(len(row["self_recursions"]) for row in modules), + "modules_with_direct_self_recursions": sum(bool(row["self_recursions"]) for row in modules), + "upstream_modules_absent_from_vendor": absent_paths, + "upstream_value_foreign_declarations": dict(collections.Counter( + declaration["vendored_status"] for row in modules + for declaration in row.get("upstream_value_foreign_declarations", []) + )), + }) + repository = args.vendor.resolve().parents[1] + result = { + "schema_version": 1, + "compiler_revision": git(repository, "rev-parse", "HEAD"), + "counts": counts, + "packages": packages, + "modules": modules, + "absent_modules": absent_modules, + "limits": [ + "Only supplied upstream checkouts are compared; baseline_unavailable is not a pass.", + "Self-recursion detection covers exact top-level same-argument equations only.", + "The script records differences without approving target adaptations or proving semantic equivalence.", + "The official compiler support dependency ranges do not uniquely pin package patch versions.", + ], + } + (args.out / "inventory.json").write_text(json.dumps(result, ensure_ascii=False, indent=2) + "\n") + (args.out / "official-vs-vendored.diff").write_text("".join(patch)) + table = ["# Vendored module inventory", "", "Generated by `audit-stdlib-vendor.py`. Status is comparison evidence, not approval.", "", + "| Module path | Official package/tag | Comparison | Direct self-recursions |", "| --- | --- | --- | --- |"] + for row in modules: + origin = row.get("package", "unavailable") + (" " + row["tag"] if "tag" in row else "") + table.append(f"| `{row['path']}` | {origin} | {row['status']} | {len(row['self_recursions'])} |") + if absent_modules: + table.extend(["", "## Official modules absent from the vendored library", "", + "| Module path | Official package/tag |", "| --- | --- |"]) + for row in absent_modules: + table.append(f"| `{row['path']}` | {row['package']} {row['tag']} |") + (args.out / "modules.md").write_text("\n".join(table) + "\n") + print(json.dumps(counts, ensure_ascii=False, indent=2)) + + +if __name__ == "__main__": + main() diff --git a/stdlib/lib/Control/Apply.purs b/stdlib/lib/Control/Apply.purs index 720e2538..6cde1c85 100644 --- a/stdlib/lib/Control/Apply.purs +++ b/stdlib/lib/Control/Apply.purs @@ -60,22 +60,7 @@ instance applyFn :: Apply ((->) r) where instance applyArray :: Apply Array where apply = arrayApply -arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b -arrayApply a0 a1 = applyArrayFrom a0 a1 0 - -applyArrayFrom :: forall a b. Array (a -> b) -> Array a -> Int -> Array b -applyArrayFrom fs xs index = - if intLt index (arrayLength fs) then - arrayAppend (mapArrayAll (arrayIndex fs index) xs 0) (applyArrayFrom fs xs (intAdd index 1)) - else - [] - -mapArrayAll :: forall a b. (a -> b) -> Array a -> Int -> Array b -mapArrayAll f xs index = - if intLt index (arrayLength xs) then - arrayAppend [f (arrayIndex xs index)] (mapArrayAll f xs (intAdd index 1)) - else - [] +foreign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b instance applyProxy :: Apply Proxy where apply _ _ = Proxy diff --git a/stdlib/lib/Control/Bind.purs b/stdlib/lib/Control/Bind.purs index 2b6fcd19..c6d8a6ae 100644 --- a/stdlib/lib/Control/Bind.purs +++ b/stdlib/lib/Control/Bind.purs @@ -94,15 +94,7 @@ instance bindFn :: Bind ((->) r) where instance bindArray :: Bind Array where bind = arrayBind -arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b -arrayBind a0 a1 = bindArrayFrom a0 a1 0 - -bindArrayFrom :: forall a b. Array a -> (a -> Array b) -> Int -> Array b -bindArrayFrom xs f index = - if intLt index (arrayLength xs) then - arrayAppend (f (arrayIndex xs index)) (bindArrayFrom xs f (intAdd index 1)) - else - [] +foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b instance bindProxy :: Bind Proxy where bind _ _ = Proxy diff --git a/stdlib/lib/Control/Extend.purs b/stdlib/lib/Control/Extend.purs index 8f979d54..367ccd55 100644 --- a/stdlib/lib/Control/Extend.purs +++ b/stdlib/lib/Control/Extend.purs @@ -27,8 +27,7 @@ class Functor w <= Extend w where instance extendFn :: Semigroup w => Extend ((->) w) where extend f g w = f \w' -> g (w <> w') -arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b -arrayExtend a0 a1 = arrayExtend a0 a1 +foreign import arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b instance extendArray :: Extend Array where extend = arrayExtend diff --git a/stdlib/lib/Control/Monad/ST/Internal.purs b/stdlib/lib/Control/Monad/ST/Internal.purs index a736f9f0..a0c4dcfa 100644 --- a/stdlib/lib/Control/Monad/ST/Internal.purs +++ b/stdlib/lib/Control/Monad/ST/Internal.purs @@ -35,14 +35,11 @@ foreign import data ST :: Region -> Type -> Type type role ST nominal representational -map_ :: forall r a b. (a -> b) -> ST r a -> ST r b -map_ a0 a1 = map_ a0 a1 +foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b -pure_ :: forall r a. a -> ST r a -pure_ a0 = pure_ a0 +foreign import pure_ :: forall r a. a -> ST r a -bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b -bind_ a0 a1 = bind_ a0 a1 +foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b instance functorST :: Functor (ST r) where map = map_ @@ -89,30 +86,26 @@ instance monoidST :: Monoid a => Monoid (ST r a) where -- | to the surrounding computation. It may cause problems to apply this -- | function using the `$` operator. The recommended approach is to use -- | parentheses instead. -run :: forall a. (forall r. ST r a) -> a -run a0 = run a0 +foreign import run :: forall a. (forall r. ST r a) -> a -- | Loop while a condition is `true`. -- | -- | `while b m` is ST computation which runs the ST computation `b`. If its -- | result is `true`, it runs the ST computation `m` and loops. If not, the -- | computation ends. -while :: forall r a. ST r Boolean -> ST r a -> ST r Unit -while a0 a1 = while a0 a1 +foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit -- | Loop over a consecutive collection of numbers -- | -- | `ST.for lo hi f` runs the computation returned by the function `f` for each -- | of the inputs between `lo` (inclusive) and `hi` (exclusive). -for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit -for a0 a1 a2 = for a0 a1 a2 +foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit -- | Loop over an array of values. -- | -- | `ST.foreach xs f` runs the computation returned by the function `f` for each -- | of the inputs `xs`. -foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit -foreach a0 a1 = foreach a0 a1 +foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit -- | The type `STRef r a` represents a mutable reference holding a value of -- | type `a`, which can be used with the `ST r` effect. @@ -121,12 +114,10 @@ foreign import data STRef :: Region -> Type -> Type type role STRef nominal representational -- | Create a new mutable reference. -new :: forall a r. a -> ST r (STRef r a) -new a0 = new a0 +foreign import new :: forall a r. a -> ST r (STRef r a) -- | Read the current value of a mutable reference. -read :: forall a r. STRef r a -> ST r a -read a0 = read a0 +foreign import read :: forall a r. STRef r a -> ST r a -- | Update the value of a mutable reference by applying a function -- | to the current value, computing a new state value for the reference and @@ -134,8 +125,7 @@ read a0 = read a0 modify' :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b modify' = modifyImpl -modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b -modifyImpl a0 a1 = modifyImpl a0 a1 +foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b -- | Modify the value of a mutable reference by applying a function to the -- | current value. The modified value is returned. @@ -143,5 +133,4 @@ modify :: forall r a. (a -> a) -> STRef r a -> ST r a modify f = modify' \s -> let s' = f s in { state: s', value: s' } -- | Set the value of a mutable reference. -write :: forall a r. a -> STRef r a -> ST r a -write a0 a1 = write a0 a1 +foreign import write :: forall a r. a -> STRef r a -> ST r a diff --git a/stdlib/lib/Control/Monad/ST/Uncurried.purs b/stdlib/lib/Control/Monad/ST/Uncurried.purs index 965cd6c0..2eced884 100644 --- a/stdlib/lib/Control/Monad/ST/Uncurried.purs +++ b/stdlib/lib/Control/Monad/ST/Uncurried.purs @@ -58,44 +58,44 @@ foreign import data STFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Ty type role STFn10 representational representational representational representational representational representational representational representational representational representational nominal representational -mkSTFn1 :: forall a t r. (a -> ST t r) -> STFn1 a t r -mkSTFn1 a0 = mkSTFn1 a0 -mkSTFn2 :: forall a b t r. (a -> b -> ST t r) -> STFn2 a b t r -mkSTFn2 a0 = mkSTFn2 a0 -mkSTFn3 :: forall a b c t r. (a -> b -> c -> ST t r) -> STFn3 a b c t r -mkSTFn3 a0 = mkSTFn3 a0 -mkSTFn4 :: forall a b c d t r. (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r -mkSTFn4 a0 = mkSTFn4 a0 -mkSTFn5 :: forall a b c d e t r. (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r -mkSTFn5 a0 = mkSTFn5 a0 -mkSTFn6 :: forall a b c d e f t r. (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r -mkSTFn6 a0 = mkSTFn6 a0 -mkSTFn7 :: forall a b c d e f g t r. (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r -mkSTFn7 a0 = mkSTFn7 a0 -mkSTFn8 :: forall a b c d e f g h t r. (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r -mkSTFn8 a0 = mkSTFn8 a0 -mkSTFn9 :: forall a b c d e f g h i t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r -mkSTFn9 a0 = mkSTFn9 a0 -mkSTFn10 :: forall a b c d e f g h i j t r. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r -mkSTFn10 a0 = mkSTFn10 a0 - -runSTFn1 :: forall a t r. STFn1 a t r -> a -> ST t r -runSTFn1 a0 a1 = runSTFn1 a0 a1 -runSTFn2 :: forall a b t r. STFn2 a b t r -> a -> b -> ST t r -runSTFn2 a0 a1 a2 = runSTFn2 a0 a1 a2 -runSTFn3 :: forall a b c t r. STFn3 a b c t r -> a -> b -> c -> ST t r -runSTFn3 a0 a1 a2 a3 = runSTFn3 a0 a1 a2 a3 -runSTFn4 :: forall a b c d t r. STFn4 a b c d t r -> a -> b -> c -> d -> ST t r -runSTFn4 a0 a1 a2 a3 a4 = runSTFn4 a0 a1 a2 a3 a4 -runSTFn5 :: forall a b c d e t r. STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r -runSTFn5 a0 a1 a2 a3 a4 a5 = runSTFn5 a0 a1 a2 a3 a4 a5 -runSTFn6 :: forall a b c d e f t r. STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r -runSTFn6 a0 a1 a2 a3 a4 a5 a6 = runSTFn6 a0 a1 a2 a3 a4 a5 a6 -runSTFn7 :: forall a b c d e f g t r. STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r -runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runSTFn7 a0 a1 a2 a3 a4 a5 a6 a7 -runSTFn8 :: forall a b c d e f g h t r. STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r -runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runSTFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 -runSTFn9 :: forall a b c d e f g h i t r. STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r -runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runSTFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 -runSTFn10 :: forall a b c d e f g h i j t r. STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r -runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runSTFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 +foreign import mkSTFn1 :: forall a t r. + (a -> ST t r) -> STFn1 a t r +foreign import mkSTFn2 :: forall a b t r. + (a -> b -> ST t r) -> STFn2 a b t r +foreign import mkSTFn3 :: forall a b c t r. + (a -> b -> c -> ST t r) -> STFn3 a b c t r +foreign import mkSTFn4 :: forall a b c d t r. + (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r +foreign import mkSTFn5 :: forall a b c d e t r. + (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r +foreign import mkSTFn6 :: forall a b c d e f t r. + (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r +foreign import mkSTFn7 :: forall a b c d e f g t r. + (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r +foreign import mkSTFn8 :: forall a b c d e f g h t r. + (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r +foreign import mkSTFn9 :: forall a b c d e f g h i t r. + (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r +foreign import mkSTFn10 :: forall a b c d e f g h i j t r. + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r + +foreign import runSTFn1 :: forall a t r. + STFn1 a t r -> a -> ST t r +foreign import runSTFn2 :: forall a b t r. + STFn2 a b t r -> a -> b -> ST t r +foreign import runSTFn3 :: forall a b c t r. + STFn3 a b c t r -> a -> b -> c -> ST t r +foreign import runSTFn4 :: forall a b c d t r. + STFn4 a b c d t r -> a -> b -> c -> d -> ST t r +foreign import runSTFn5 :: forall a b c d e t r. + STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r +foreign import runSTFn6 :: forall a b c d e f t r. + STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r +foreign import runSTFn7 :: forall a b c d e f g t r. + STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r +foreign import runSTFn8 :: forall a b c d e f g h t r. + STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r +foreign import runSTFn9 :: forall a b c d e f g h i t r. + STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r +foreign import runSTFn10 :: forall a b c d e f g h i j t r. + STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r diff --git a/stdlib/lib/Data/Array.purs b/stdlib/lib/Data/Array.purs index d9953366..431f942a 100644 --- a/stdlib/lib/Data/Array.purs +++ b/stdlib/lib/Data/Array.purs @@ -174,8 +174,9 @@ toUnfoldable xs = unfoldr f 0 fromFoldable :: forall f. Foldable f => f ~> Array fromFoldable = runFn2 fromFoldableImpl F.foldr -fromFoldableImpl :: forall f a . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a) -fromFoldableImpl = fromFoldableImpl +foreign import fromFoldableImpl + :: forall f a + . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a) -- | Create an array of one element -- | ```purescript @@ -191,8 +192,7 @@ singleton a = [ a ] range :: Int -> Int -> Array Int range = runFn2 rangeImpl -rangeImpl :: Fn2 Int Int (Array Int) -rangeImpl = rangeImpl +foreign import rangeImpl :: Fn2 Int Int (Array Int) -- | Create an array containing a value repeated the specified number of times. -- | ```purescript @@ -201,8 +201,7 @@ rangeImpl = rangeImpl replicate :: forall a. Int -> a -> Array a replicate = runFn2 replicateImpl -replicateImpl :: forall a. Fn2 Int a (Array a) -replicateImpl = replicateImpl +foreign import replicateImpl :: forall a. Fn2 Int a (Array a) -- | An infix synonym for `range`. -- | ```purescript @@ -241,8 +240,7 @@ null xs = length xs == 0 -- | ```purescript -- | length ["Hello", "World"] = 2 -- | ``` -length :: forall a. Array a -> Int -length a0 = length a0 +foreign import length :: forall a. Array a -> Int -------------------------------------------------------------------------------- -- Extending arrays ------------------------------------------------------------ @@ -372,8 +370,9 @@ init xs uncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a } uncons = runFn3 unconsImpl (const Nothing) \x xs -> Just { head: x, tail: xs } -unconsImpl :: forall a b . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b -unconsImpl = unconsImpl +foreign import unconsImpl + :: forall a b + . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b -- | Break an array into its last element and all preceding elements. -- | @@ -403,8 +402,9 @@ unsnoc xs = { init: _, last: _ } <$> init xs <*> last xs index :: forall a. Array a -> Int -> Maybe a index = runFn4 indexImpl Just Nothing -indexImpl :: forall a . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a) -indexImpl = indexImpl +foreign import indexImpl + :: forall a + . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a) -- | An infix version of `index`. -- | @@ -459,8 +459,14 @@ find f xs = unsafePartial (unsafeIndex xs) <$> findIndex f xs findMap :: forall a b. (a -> Maybe b) -> Array a -> Maybe b findMap = runFn4 findMapImpl Nothing isJust -findMapImpl :: forall a b . Fn4 (forall c. Maybe c) (forall c. Maybe c -> Boolean) (a -> Maybe b) (Array a) (Maybe b) -findMapImpl = findMapImpl +foreign import findMapImpl + :: forall a b + . Fn4 + (forall c. Maybe c) + (forall c. Maybe c -> Boolean) + (a -> Maybe b) + (Array a) + (Maybe b) -- | Find the first index for which a predicate holds. -- | @@ -472,8 +478,14 @@ findMapImpl = findMapImpl findIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int findIndex = runFn4 findIndexImpl Just Nothing -findIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int) -findIndexImpl = findIndexImpl +foreign import findIndexImpl + :: forall a + . Fn4 + (forall b. b -> Maybe b) + (forall b. Maybe b) + (a -> Boolean) + (Array a) + (Maybe Int) -- | Find the last index for which a predicate holds. -- | @@ -485,8 +497,14 @@ findIndexImpl = findIndexImpl findLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int findLastIndex = runFn4 findLastIndexImpl Just Nothing -findLastIndexImpl :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) (a -> Boolean) (Array a) (Maybe Int) -findLastIndexImpl = findLastIndexImpl +foreign import findLastIndexImpl + :: forall a + . Fn4 + (forall b. b -> Maybe b) + (forall b. Maybe b) + (a -> Boolean) + (Array a) + (Maybe Int) -- | Insert an element at the specified index, creating a new array, or -- | returning `Nothing` if the index is out of bounds. @@ -499,8 +517,15 @@ findLastIndexImpl = findLastIndexImpl insertAt :: forall a. Int -> a -> Array a -> Maybe (Array a) insertAt = runFn5 _insertAt Just Nothing -_insertAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a)) -_insertAt = _insertAt +foreign import _insertAt + :: forall a + . Fn5 + (forall b. b -> Maybe b) + (forall b. Maybe b) + Int + a + (Array a) + (Maybe (Array a)) -- | Delete the element at the specified index, creating a new array, or -- | returning `Nothing` if the index is out of bounds. @@ -513,8 +538,14 @@ _insertAt = _insertAt deleteAt :: forall a. Int -> Array a -> Maybe (Array a) deleteAt = runFn4 _deleteAt Just Nothing -_deleteAt :: forall a . Fn4 (forall b. b -> Maybe b) (forall b. Maybe b) Int (Array a) (Maybe (Array a)) -_deleteAt = _deleteAt +foreign import _deleteAt + :: forall a + . Fn4 + (forall b. b -> Maybe b) + (forall b. Maybe b) + Int + (Array a) + (Maybe (Array a)) -- | Change the element at the specified index, creating a new array, or -- | returning `Nothing` if the index is out of bounds. @@ -527,8 +558,15 @@ _deleteAt = _deleteAt updateAt :: forall a. Int -> a -> Array a -> Maybe (Array a) updateAt = runFn5 _updateAt Just Nothing -_updateAt :: forall a . Fn5 (forall b. b -> Maybe b) (forall b. Maybe b) Int a (Array a) (Maybe (Array a)) -_updateAt = _updateAt +foreign import _updateAt + :: forall a + . Fn5 + (forall b. b -> Maybe b) + (forall b. Maybe b) + Int + a + (Array a) + (Maybe (Array a)) -- | Apply a function to the element at the specified index, creating a new -- | array, or returning `Nothing` if the index is out of bounds. @@ -601,8 +639,7 @@ intersperse a arr = case length arr of -- | reverse [1, 2, 3] = [3, 2, 1] -- | ``` -- | -reverse :: forall a. Array a -> Array a -reverse a0 = reverse a0 +foreign import reverse :: forall a. Array a -> Array a -- | Flatten an array of arrays, creating a new array. -- | @@ -610,8 +647,7 @@ reverse a0 = reverse a0 -- | concat [[1, 2, 3], [], [4, 5, 6]] = [1, 2, 3, 4, 5, 6] -- | ``` -- | -concat :: forall a. Array (Array a) -> Array a -concat a0 = concat a0 +foreign import concat :: forall a. Array (Array a) -> Array a -- | Apply a function to each element in an array, and flatten the results -- | into a single, new array. @@ -634,8 +670,9 @@ concatMap = flip bind filter :: forall a. (a -> Boolean) -> Array a -> Array a filter = runFn2 filterImpl -filterImpl :: forall a . Fn2 (a -> Boolean) (Array a) (Array a) -filterImpl = filterImpl +foreign import filterImpl + :: forall a + . Fn2 (a -> Boolean) (Array a) (Array a) -- | Partition an array using a predicate function, creating a set of -- | new arrays. One for the values satisfying the predicate function @@ -652,8 +689,9 @@ partition -> { yes :: Array a, no :: Array a } partition = runFn2 partitionImpl -partitionImpl :: forall a . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a } -partitionImpl = partitionImpl +foreign import partitionImpl + :: forall a + . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a } -- | Splits an array into two subarrays, where `before` contains the elements -- | up to (but not including) the given index, and `after` contains the rest @@ -816,8 +854,7 @@ transpose xs = go 0 [] scanl :: forall a b. (b -> a -> b) -> b -> Array a -> Array b scanl = runFn3 scanlImpl -scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b) -scanlImpl = scanlImpl +foreign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b) -- | Fold a data structure from the right, keeping all intermediate results -- | instead of only the final result. Note that the initial value does not @@ -830,8 +867,7 @@ scanlImpl = scanlImpl scanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b scanr = runFn3 scanrImpl -scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b) -scanrImpl = scanrImpl +foreign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b) -------------------------------------------------------------------------------- -- Sorting --------------------------------------------------------------------- @@ -875,8 +911,7 @@ sortBy comp = runFn3 sortByImpl comp case _ of sortWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a sortWith f = sortBy (comparing f) -sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a) -sortByImpl = sortByImpl +foreign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a) -------------------------------------------------------------------------------- -- Subarrays ------------------------------------------------------------------- @@ -894,8 +929,7 @@ sortByImpl = sortByImpl slice :: forall a. Int -> Int -> Array a -> Array a slice = runFn3 sliceImpl -sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a) -sliceImpl = sliceImpl +foreign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a) -- | Keep only a number of elements from the start of an array, creating a new -- | array. @@ -1216,8 +1250,13 @@ zipWith -> Array c zipWith = runFn3 zipWithImpl -zipWithImpl :: forall a b c . Fn3 (a -> b -> c) (Array a) (Array b) (Array c) -zipWithImpl = zipWithImpl +foreign import zipWithImpl + :: forall a b c + . Fn3 + (a -> b -> c) + (Array a) + (Array b) + (Array c) -- | A generalization of `zipWith` which accumulates results in some -- | `Applicative` functor. @@ -1280,8 +1319,7 @@ unzip xs = any :: forall a. (a -> Boolean) -> Array a -> Boolean any = runFn2 anyImpl -anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean -anyImpl = anyImpl +foreign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean -- | Returns true if all the array elements satisfy the given predicate. -- | iterating the array only as necessary and stopping as soon as the predicate @@ -1295,8 +1333,7 @@ anyImpl = anyImpl all :: forall a. (a -> Boolean) -> Array a -> Boolean all = runFn2 allImpl -allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean -allImpl = allImpl +foreign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean -- | Perform a fold using a monadic step function. -- | @@ -1331,5 +1368,4 @@ foldRecM f b array = tailRecM2 go b 0 unsafeIndex :: forall a. Partial => Array a -> Int -> a unsafeIndex = runFn2 unsafeIndexImpl -unsafeIndexImpl :: forall a. Fn2 (Array a) Int a -unsafeIndexImpl = unsafeIndexImpl +foreign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a diff --git a/stdlib/lib/Data/Array/NonEmpty/Internal.purs b/stdlib/lib/Data/Array/NonEmpty/Internal.purs index f1e3eedc..752ada6e 100644 --- a/stdlib/lib/Data/Array/NonEmpty/Internal.purs +++ b/stdlib/lib/Data/Array/NonEmpty/Internal.purs @@ -72,10 +72,13 @@ derive newtype instance monadNonEmptyArray :: Monad NonEmptyArray derive newtype instance altNonEmptyArray :: Alt NonEmptyArray -- we use FFI here to avoid the unncessary copy created by `tail` -foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a -foldr1Impl = foldr1Impl -foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a -foldl1Impl = foldl1Impl - -traverse1Impl :: forall m a b . Fn3 (forall a' b'. (m (a' -> b') -> m a' -> m b')) (forall a' b'. (a' -> b') -> m a' -> m b') (a -> m b) (NonEmptyArray a -> m (NonEmptyArray b)) -traverse1Impl = traverse1Impl +foreign import foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a +foreign import foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a + +foreign import traverse1Impl + :: forall m a b + . Fn3 + (forall a' b'. (m (a' -> b') -> m a' -> m b')) + (forall a' b'. (a' -> b') -> m a' -> m b') + (a -> m b) + (NonEmptyArray a -> m (NonEmptyArray b)) diff --git a/stdlib/lib/Data/Array/ST.purs b/stdlib/lib/Data/Array/ST.purs index 116243d0..158e4104 100644 --- a/stdlib/lib/Data/Array/ST.purs +++ b/stdlib/lib/Data/Array/ST.purs @@ -75,20 +75,17 @@ withArray f xs = do unsafeFreeze :: forall h a. STArray h a -> ST h (Array a) unsafeFreeze = runSTFn1 unsafeFreezeImpl -unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) -unsafeFreezeImpl = unsafeFreezeImpl +foreign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) -- | O(1) Convert an immutable array to a mutable array, without copying. The input -- | array must not be used afterward. unsafeThaw :: forall h a. Array a -> ST h (STArray h a) unsafeThaw = runSTFn1 unsafeThawImpl -unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a) -unsafeThawImpl = unsafeThawImpl +foreign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a) -- | Create a new, empty mutable array. -new :: forall h a. ST h (STArray h a) -new = new +foreign import new :: forall h a. ST h (STArray h a) thaw :: forall h a @@ -97,8 +94,7 @@ thaw thaw = runSTFn1 thawImpl -- | Create a mutable copy of an immutable array. -thawImpl :: forall h a. STFn1 (Array a) h (STArray h a) -thawImpl = thawImpl +foreign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a) -- | Make a mutable copy of a mutable array. clone @@ -107,8 +103,7 @@ clone -> ST h (STArray h a) clone = runSTFn1 cloneImpl -cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a) -cloneImpl = cloneImpl +foreign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a) -- | Sort a mutable array in place. Sorting is stable: the order of equal -- | elements is preserved. @@ -119,8 +114,9 @@ sort = sortBy compare shift :: forall h a. STArray h a -> ST h (Maybe a) shift = runSTFn3 shiftImpl Just Nothing -shiftImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) -shiftImpl = shiftImpl +foreign import shiftImpl + :: forall h a + . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) -- | Sort a mutable array in place using a comparison function. Sorting is -- | stable: the order of elements is preserved if they are equal according to @@ -135,8 +131,9 @@ sortBy comp = runSTFn3 sortByImpl comp case _ of EQ -> 0 LT -> -1 -sortByImpl :: forall a h . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a) -sortByImpl = sortByImpl +foreign import sortByImpl + :: forall a h + . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a) -- | Sort a mutable array in place based on a projection. Sorting is stable: the -- | order of elements is preserved if they are equal according to the projection. @@ -155,8 +152,7 @@ freeze -> ST h (Array a) freeze = runSTFn1 freezeImpl -freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) -freezeImpl = freezeImpl +foreign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) -- | Read the value at the specified index in a mutable array. peek @@ -166,8 +162,7 @@ peek -> ST h (Maybe a) peek = runSTFn4 peekImpl Just Nothing -peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r -peekImpl = peekImpl +foreign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r poke :: forall h a @@ -178,11 +173,9 @@ poke poke = runSTFn3 pokeImpl -- | Change the value at the specified index in a mutable array. -pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean -pokeImpl = pokeImpl +foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean -lengthImpl :: forall h a. STFn1 (STArray h a) h Int -lengthImpl = lengthImpl +foreign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int -- | Get the number of elements in a mutable array. length :: forall h a. STArray h a -> ST h Int @@ -192,16 +185,16 @@ length = runSTFn1 lengthImpl pop :: forall h a. STArray h a -> ST h (Maybe a) pop = runSTFn3 popImpl Just Nothing -popImpl :: forall h a . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) -popImpl = popImpl +foreign import popImpl + :: forall h a + . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) -- | Append an element to the end of a mutable array. Returns the new length of -- | the array. push :: forall h a. a -> (STArray h a) -> ST h Int push = runSTFn2 pushImpl -pushImpl :: forall h a. STFn2 a (STArray h a) h Int -pushImpl = pushImpl +foreign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int -- | Append the values in an immutable array to the end of a mutable array. -- | Returns the new length of the mutable array. @@ -212,8 +205,9 @@ pushAll -> ST h Int pushAll = runSTFn2 pushAllImpl -pushAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int -pushAllImpl = pushAllImpl +foreign import pushAllImpl + :: forall h a + . STFn2 (Array a) (STArray h a) h Int -- | Append an element to the front of a mutable array. Returns the new length of -- | the array. @@ -229,8 +223,9 @@ unshiftAll -> ST h Int unshiftAll = runSTFn2 unshiftAllImpl -unshiftAllImpl :: forall h a . STFn2 (Array a) (STArray h a) h Int -unshiftAllImpl = unshiftAllImpl +foreign import unshiftAllImpl + :: forall h a + . STFn2 (Array a) (STArray h a) h Int -- | Mutate the element at the specified index using the supplied function. modify :: forall h a. Int -> (a -> a) -> STArray h a -> ST h Boolean @@ -250,8 +245,9 @@ splice -> ST h (Array a) splice = runSTFn4 spliceImpl -spliceImpl :: forall h a . STFn4 Int Int (Array a) (STArray h a) h (Array a) -spliceImpl = spliceImpl +foreign import spliceImpl + :: forall h a + . STFn4 Int Int (Array a) (STArray h a) h (Array a) -- | Create an immutable copy of a mutable array, where each element -- | is labelled with its index in the original array. @@ -261,5 +257,6 @@ toAssocArray -> ST h (Array (Assoc a)) toAssocArray = runSTFn1 toAssocArrayImpl -toAssocArrayImpl :: forall h a . STFn1 (STArray h a) h (Array (Assoc a)) -toAssocArrayImpl = toAssocArrayImpl +foreign import toAssocArrayImpl + :: forall h a + . STFn1 (STArray h a) h (Array (Assoc a)) diff --git a/stdlib/lib/Data/Array/ST/Partial.purs b/stdlib/lib/Data/Array/ST/Partial.purs index bfde4eb7..f492b6ed 100644 --- a/stdlib/lib/Data/Array/ST/Partial.purs +++ b/stdlib/lib/Data/Array/ST/Partial.purs @@ -21,8 +21,7 @@ peek -> ST h a peek = runSTFn2 peekImpl -peekImpl :: forall h a. STFn2 Int (STArray h a) h a -peekImpl = peekImpl +foreign import peekImpl :: forall h a. STFn2 Int (STArray h a) h a -- | Change the value at the specified index in a mutable array. poke @@ -34,5 +33,4 @@ poke -> ST h Unit poke = runSTFn3 pokeImpl -pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit -pokeImpl = pokeImpl +foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit diff --git a/stdlib/lib/Data/Bounded.purs b/stdlib/lib/Data/Bounded.purs index 35ca7c2b..91fec94d 100644 --- a/stdlib/lib/Data/Bounded.purs +++ b/stdlib/lib/Data/Bounded.purs @@ -37,20 +37,16 @@ instance boundedInt :: Bounded Int where top = topInt bottom = bottomInt -topInt :: Int -topInt = 2147483647 -bottomInt :: Int -bottomInt = intSub (intSub 0 2147483647) 1 +foreign import topInt :: Int +foreign import bottomInt :: Int -- | Characters fall within the Unicode range. instance boundedChar :: Bounded Char where top = topChar bottom = bottomChar -topChar :: Char -topChar = intToChar 65535 -bottomChar :: Char -bottomChar = intToChar 0 +foreign import topChar :: Char +foreign import bottomChar :: Char instance boundedOrdering :: Bounded Ordering where top = GT @@ -60,10 +56,8 @@ instance boundedUnit :: Bounded Unit where top = unit bottom = unit -topNumber :: Number -topNumber = numberDiv 1.0 0.0 -bottomNumber :: Number -bottomNumber = numberNeg (numberDiv 1.0 0.0) +foreign import topNumber :: Number +foreign import bottomNumber :: Number instance boundedNumber :: Bounded Number where top = topNumber diff --git a/stdlib/lib/Data/Enum.purs b/stdlib/lib/Data/Enum.purs index a188fbca..0d4b0976 100644 --- a/stdlib/lib/Data/Enum.purs +++ b/stdlib/lib/Data/Enum.purs @@ -317,7 +317,5 @@ charToEnum :: Int -> Maybe Char charToEnum n | n >= toCharCode bottom && n <= toCharCode top = Just (fromCharCode n) charToEnum _ = Nothing -toCharCode :: Char -> Int -toCharCode a0 = toCharCode a0 -fromCharCode :: Int -> Char -fromCharCode a0 = fromCharCode a0 +foreign import toCharCode :: Char -> Int +foreign import fromCharCode :: Int -> Char diff --git a/stdlib/lib/Data/Eq.purs b/stdlib/lib/Data/Eq.purs index bf38459a..e8380efe 100644 --- a/stdlib/lib/Data/Eq.purs +++ b/stdlib/lib/Data/Eq.purs @@ -45,19 +45,19 @@ notEq x y = (x == y) == false infix 4 notEq as /= instance eqBoolean :: Eq Boolean where - eq x y = eqBooleanImpl x y + eq = eqBooleanImpl instance eqInt :: Eq Int where - eq x y = eqIntImpl x y + eq = eqIntImpl instance eqNumber :: Eq Number where - eq x y = eqNumberImpl x y + eq = eqNumberImpl instance eqChar :: Eq Char where - eq x y = eqCharImpl x y + eq = eqCharImpl instance eqString :: Eq String where - eq x y = eqStringImpl x y + eq = eqStringImpl instance eqUnit :: Eq Unit where eq _ _ = true @@ -66,7 +66,7 @@ instance eqVoid :: Eq Void where eq _ _ = true instance eqArray :: Eq a => Eq (Array a) where - eq xs ys = eqArrayImpl eq xs ys + eq = eqArrayImpl eq instance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) where eq = eqRecord (Proxy :: Proxy list) @@ -74,32 +74,13 @@ instance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) instance eqProxy :: Eq (Proxy a) where eq _ _ = true -eqBooleanImpl :: Boolean -> Boolean -> Boolean -eqBooleanImpl a0 a1 = booleanEq a0 a1 -eqIntImpl :: Int -> Int -> Boolean -eqIntImpl a0 a1 = intEq a0 a1 -eqNumberImpl :: Number -> Number -> Boolean -eqNumberImpl a0 a1 = numberEq a0 a1 -eqCharImpl :: Char -> Char -> Boolean -eqCharImpl a0 a1 = charEq a0 a1 -eqStringImpl :: String -> String -> Boolean -eqStringImpl a0 a1 = eqBytes (stringToBytes a0) (stringToBytes a1) 0 - -eqBytes :: Array Int -> Array Int -> Int -> Boolean -eqBytes xs ys index = - if intGe index (arrayLength xs) then intEq (arrayLength xs) (arrayLength ys) - else if intGe index (arrayLength ys) then false - else if intEq (arrayIndex xs index) (arrayIndex ys index) then eqBytes xs ys (intAdd index 1) - else false - -eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean -eqArrayImpl a0 a1 a2 = eqArrayFrom a0 a1 a2 0 - -eqArrayFrom :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Int -> Boolean -eqArrayFrom eq xs ys index = - if intGe index (arrayLength xs) then intEq (arrayLength xs) (arrayLength ys) - else if eq (arrayIndex xs index) (arrayIndex ys index) then eqArrayFrom eq xs ys (intAdd index 1) - else false +foreign import eqBooleanImpl :: Boolean -> Boolean -> Boolean +foreign import eqIntImpl :: Int -> Int -> Boolean +foreign import eqNumberImpl :: Number -> Number -> Boolean +foreign import eqCharImpl :: Char -> Char -> Boolean +foreign import eqStringImpl :: String -> String -> Boolean + +foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean -- | The `Eq1` type class represents type constructors with decidable equality. class Eq1 f where diff --git a/stdlib/lib/Data/EuclideanRing.purs b/stdlib/lib/Data/EuclideanRing.purs index 9c94986d..b2ddbfaa 100644 --- a/stdlib/lib/Data/EuclideanRing.purs +++ b/stdlib/lib/Data/EuclideanRing.purs @@ -72,25 +72,20 @@ class CommutativeRing a <= EuclideanRing a where infixl 7 div as / instance euclideanRingInt :: EuclideanRing Int where - degree x = intDegree x - div x y = intDiv x y - mod x y = intMod x y + degree = intDegree + div = intDiv + mod = intMod instance euclideanRingNumber :: EuclideanRing Number where degree _ = 1 - div x y = numDiv x y + div = numDiv mod _ _ = 0.0 -intDegree :: Int -> Int -intDegree a0 = if intEq a0 minInt32 then 2147483647 else if intLt a0 0 then intNeg a0 else a0 +foreign import intDegree :: Int -> Int +foreign import intDiv :: Int -> Int -> Int +foreign import intMod :: Int -> Int -> Int -minInt32 :: Int -minInt32 = intSub (intSub 0 2147483647) 1 - - - -numDiv :: Number -> Number -> Number -numDiv a0 a1 = numberDiv a0 a1 +foreign import numDiv :: Number -> Number -> Number -- | The *greatest common divisor* of two values. gcd :: forall a. Eq a => EuclideanRing a => a -> a -> a diff --git a/stdlib/lib/Data/Foldable.purs b/stdlib/lib/Data/Foldable.purs index b11eed3d..cf160adb 100644 --- a/stdlib/lib/Data/Foldable.purs +++ b/stdlib/lib/Data/Foldable.purs @@ -132,10 +132,8 @@ instance foldableArray :: Foldable Array where foldl = foldlArray foldMap = foldMapDefaultR -foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b -foldrArray a0 a1 a2 = foldrArray a0 a1 a2 -foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b -foldlArray a0 a1 a2 = foldlArray a0 a1 a2 +foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b +foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b instance foldableMaybe :: Foldable Maybe where foldr _ z Nothing = z @@ -225,7 +223,7 @@ instance foldableApp :: Foldable f => Foldable (App f) where -- | Fold a data structure, accumulating values in some `Monoid`. fold :: forall f m. Foldable f => Monoid m => f m -> m -fold xs = foldMap identity xs +fold = foldMap identity -- | Similar to 'foldl', but the result is encapsulated in a monad. -- | diff --git a/stdlib/lib/Data/Function/Uncurried.purs b/stdlib/lib/Data/Function/Uncurried.purs index 4373b027..a5553703 100644 --- a/stdlib/lib/Data/Function/Uncurried.purs +++ b/stdlib/lib/Data/Function/Uncurried.purs @@ -56,89 +56,69 @@ foreign import data Fn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type type role Fn10 representational representational representational representational representational representational representational representational representational representational representational -- | Create a function of no arguments -mkFn0 :: forall a. (Unit -> a) -> Fn0 a -mkFn0 a0 = mkFn0 a0 +foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a -- | Create a function of one argument mkFn1 :: forall a b. (a -> b) -> Fn1 a b mkFn1 f = f -- | Create a function of two arguments from a curried function -mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c -mkFn2 a0 = mkFn2 a0 +foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c -- | Create a function of three arguments from a curried function -mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d -mkFn3 a0 = mkFn3 a0 +foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d -- | Create a function of four arguments from a curried function -mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e -mkFn4 a0 = mkFn4 a0 +foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e -- | Create a function of five arguments from a curried function -mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f -mkFn5 a0 = mkFn5 a0 +foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f -- | Create a function of six arguments from a curried function -mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g -mkFn6 a0 = mkFn6 a0 +foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g -- | Create a function of seven arguments from a curried function -mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h -mkFn7 a0 = mkFn7 a0 +foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h -- | Create a function of eight arguments from a curried function -mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i -mkFn8 a0 = mkFn8 a0 +foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i -- | Create a function of nine arguments from a curried function -mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j -mkFn9 a0 = mkFn9 a0 +foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j -- | Create a function of ten arguments from a curried function -mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k -mkFn10 a0 = mkFn10 a0 +foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k -- | Apply a function of no arguments -runFn0 :: forall a. Fn0 a -> a -runFn0 a0 = runFn0 a0 +foreign import runFn0 :: forall a. Fn0 a -> a -- | Apply a function of one argument runFn1 :: forall a b. Fn1 a b -> a -> b runFn1 f = f -- | Apply a function of two arguments -runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c -runFn2 a0 a1 a2 = runFn2 a0 a1 a2 +foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c -- | Apply a function of three arguments -runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d -runFn3 a0 a1 a2 a3 = runFn3 a0 a1 a2 a3 +foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d -- | Apply a function of four arguments -runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e -runFn4 a0 a1 a2 a3 a4 = runFn4 a0 a1 a2 a3 a4 +foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e -- | Apply a function of five arguments -runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f -runFn5 a0 a1 a2 a3 a4 a5 = runFn5 a0 a1 a2 a3 a4 a5 +foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f -- | Apply a function of six arguments -runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g -runFn6 a0 a1 a2 a3 a4 a5 a6 = runFn6 a0 a1 a2 a3 a4 a5 a6 +foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g -- | Apply a function of seven arguments -runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h -runFn7 a0 a1 a2 a3 a4 a5 a6 a7 = runFn7 a0 a1 a2 a3 a4 a5 a6 a7 +foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h -- | Apply a function of eight arguments -runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i -runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 = runFn8 a0 a1 a2 a3 a4 a5 a6 a7 a8 +foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i -- | Apply a function of nine arguments -runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 = runFn9 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 +foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -- | Apply a function of ten arguments -runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = runFn10 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 +foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k diff --git a/stdlib/lib/Data/Functor.purs b/stdlib/lib/Data/Functor.purs index 068a8f75..fb97ea8d 100644 --- a/stdlib/lib/Data/Functor.purs +++ b/stdlib/lib/Data/Functor.purs @@ -47,20 +47,12 @@ instance functorFn :: Functor ((->) r) where map = compose instance functorArray :: Functor Array where - map x y = arrayMap x y + map = arrayMap instance functorProxy :: Functor Proxy where map _ _ = Proxy -arrayMap :: forall a b. (a -> b) -> Array a -> Array b -arrayMap a0 a1 = mapArrayFrom a0 a1 0 - -mapArrayFrom :: forall a b. (a -> b) -> Array a -> Int -> Array b -mapArrayFrom f xs index = - if intLt index (arrayLength xs) then - arrayAppend [f (arrayIndex xs index)] (mapArrayFrom f xs (intAdd index 1)) - else - [] +foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b -- | The `void` function is used to ignore the type wrapped by a -- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type @@ -75,18 +67,18 @@ mapArrayFrom f xs index = -- | print (n * n) -- | ``` void :: forall f a. Functor f => f a -> f Unit -void fa = map (\_ -> unit) fa +void = map (const unit) -- | Ignore the return value of a computation, using the specified return value -- | instead. voidRight :: forall f a b. Functor f => a -> f b -> f a -voidRight x fa = map (\_ -> x) fa +voidRight x = map (const x) infixl 4 voidRight as <$ -- | A version of `voidRight` with its arguments flipped. voidLeft :: forall f a b. Functor f => f a -> b -> f b -voidLeft fa x = (\_ -> x) <$> fa +voidLeft f x = const x <$> f infixl 4 voidLeft as $> diff --git a/stdlib/lib/Data/FunctorWithIndex.purs b/stdlib/lib/Data/FunctorWithIndex.purs index a02a68c6..9d9a48d0 100644 --- a/stdlib/lib/Data/FunctorWithIndex.purs +++ b/stdlib/lib/Data/FunctorWithIndex.purs @@ -35,8 +35,7 @@ import Data.Tuple (Tuple, curry) class Functor f <= FunctorWithIndex i f | f -> i where mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b -mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b -mapWithIndexArray a0 a1 = mapWithIndexArray a0 a1 +foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b instance functorWithIndexArray :: FunctorWithIndex Int Array where mapWithIndex = mapWithIndexArray diff --git a/stdlib/lib/Data/HeytingAlgebra.purs b/stdlib/lib/Data/HeytingAlgebra.purs index 1bfc9da9..26387398 100644 --- a/stdlib/lib/Data/HeytingAlgebra.purs +++ b/stdlib/lib/Data/HeytingAlgebra.purs @@ -64,9 +64,9 @@ instance heytingAlgebraBoolean :: HeytingAlgebra Boolean where ff = false tt = true implies a b = not a || b - conj x y = boolConj x y - disj x y = boolDisj x y - not x = boolNot x + conj = boolConj + disj = boolDisj + not = boolNot instance heytingAlgebraUnit :: HeytingAlgebra Unit where ff = unit @@ -100,12 +100,9 @@ instance heytingAlgebraRecord :: (RL.RowToList row list, HeytingAlgebraRecord li implies = impliesRecord (Proxy :: Proxy list) not = notRecord (Proxy :: Proxy list) -boolConj :: Boolean -> Boolean -> Boolean -boolConj a0 a1 = booleanAnd a0 a1 -boolDisj :: Boolean -> Boolean -> Boolean -boolDisj a0 a1 = booleanOr a0 a1 -boolNot :: Boolean -> Boolean -boolNot a0 = booleanNot a0 +foreign import boolConj :: Boolean -> Boolean -> Boolean +foreign import boolDisj :: Boolean -> Boolean -> Boolean +foreign import boolNot :: Boolean -> Boolean -- | A class for records where all fields have `HeytingAlgebra` instances, used -- | to implement the `HeytingAlgebra` instance for records. diff --git a/stdlib/lib/Data/HeytingAlgebra/Generic.purs b/stdlib/lib/Data/HeytingAlgebra/Generic.purs index 92bab32c..d42e0b65 100644 --- a/stdlib/lib/Data/HeytingAlgebra/Generic.purs +++ b/stdlib/lib/Data/HeytingAlgebra/Generic.purs @@ -67,4 +67,4 @@ genericDisj x y = to $ from x `genericDisj'` from y -- | A `Generic` implementation of the `not` member from the `HeytingAlgebra` type class. genericNot :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -genericNot x = to $ genericNot' (from x) +genericNot x = to $ genericNot' (from x) \ No newline at end of file diff --git a/stdlib/lib/Data/Int.purs b/stdlib/lib/Data/Int.purs index bafb13ae..c637fc8c 100644 --- a/stdlib/lib/Data/Int.purs +++ b/stdlib/lib/Data/Int.purs @@ -37,8 +37,11 @@ import Data.Number as Number fromNumber :: Number -> Maybe Int fromNumber = fromNumberImpl Just Nothing -fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int -fromNumberImpl a0 a1 a2 = fromNumberImpl a0 a1 a2 +foreign import fromNumberImpl + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Number + -> Maybe Int -- | Convert a `Number` to an `Int`, by taking the closest integer equal to or -- | less than the argument. Values outside the `Int` range are clamped, `NaN` @@ -75,8 +78,7 @@ unsafeClamp x -- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number` -- | so there is no loss of precision with this function. -toNumber :: Int -> Number -toNumber a0 = toNumber a0 +foreign import toNumber :: Int -> Number -- | Reads an `Int` from a `String` value. The number must parse as an integer -- | and fall within the valid range of values for the `Int` type, otherwise @@ -222,8 +224,7 @@ fromStringAs = fromStringAsImpl Just Nothing -- | div 2 (-3) == 0 -- | quot 2 (-3) == 0 -- | ``` -quot :: Int -> Int -> Int -quot a0 a1 = quot a0 a1 +foreign import quot :: Int -> Int -> Int -- | The `rem` function provides the remainder after _truncating_ integer -- | division (see the documentation for the `EuclideanRing` class). It is @@ -241,15 +242,16 @@ quot a0 a1 = quot a0 a1 -- | mod 2 (-3) == 2 -- | rem 2 (-3) == 2 -- | ``` -rem :: Int -> Int -> Int -rem a0 a1 = rem a0 a1 +foreign import rem :: Int -> Int -> Int -- | Raise an Int to the power of another Int. -pow :: Int -> Int -> Int -pow a0 a1 = pow a0 a1 +foreign import pow :: Int -> Int -> Int -fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int -fromStringAsImpl a0 a1 a2 a3 = fromStringAsImpl a0 a1 a2 a3 +foreign import fromStringAsImpl + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Radix + -> String + -> Maybe Int -toStringAs :: Radix -> Int -> String -toStringAs a0 a1 = toStringAs a0 a1 +foreign import toStringAs :: Radix -> Int -> String diff --git a/stdlib/lib/Data/Int/Bits.purs b/stdlib/lib/Data/Int/Bits.purs index ca7a9556..d1b47156 100644 --- a/stdlib/lib/Data/Int/Bits.purs +++ b/stdlib/lib/Data/Int/Bits.purs @@ -10,35 +10,28 @@ module Data.Int.Bits ) where -- | Bitwise AND. -and :: Int -> Int -> Int -and a0 a1 = intAnd a0 a1 +foreign import and :: Int -> Int -> Int infixl 10 and as .&. -- | Bitwise OR. -or :: Int -> Int -> Int -or a0 a1 = intOr a0 a1 +foreign import or :: Int -> Int -> Int infixl 10 or as .|. -- | Bitwise XOR. -xor :: Int -> Int -> Int -xor a0 a1 = intXor a0 a1 +foreign import xor :: Int -> Int -> Int infixl 10 xor as .^. -- | Bitwise shift left. -shl :: Int -> Int -> Int -shl a0 a1 = intShl a0 a1 +foreign import shl :: Int -> Int -> Int -- | Bitwise shift right. -shr :: Int -> Int -> Int -shr a0 a1 = intShr a0 a1 +foreign import shr :: Int -> Int -> Int -- | Bitwise zero-fill shift right. -zshr :: Int -> Int -> Int -zshr a0 a1 = intZshr a0 a1 +foreign import zshr :: Int -> Int -> Int -- | Bitwise NOT. -complement :: Int -> Int -complement a0 = intComplement a0 +foreign import complement :: Int -> Int diff --git a/stdlib/lib/Data/Lazy.purs b/stdlib/lib/Data/Lazy.purs index e9b8b121..9fe61171 100644 --- a/stdlib/lib/Data/Lazy.purs +++ b/stdlib/lib/Data/Lazy.purs @@ -32,12 +32,10 @@ foreign import data Lazy :: Type -> Type type role Lazy representational -- | Defer a computation, creating a `Lazy` value. -defer :: forall a. (Unit -> a) -> Lazy a -defer a0 = defer a0 +foreign import defer :: forall a. (Unit -> a) -> Lazy a -- | Force evaluation of a `Lazy` value. -force :: forall a. Lazy a -> a -force a0 = force a0 +foreign import force :: forall a. Lazy a -> a instance semiringLazy :: Semiring a => Semiring (Lazy a) where add a b = defer \_ -> force a + force b diff --git a/stdlib/lib/Data/Number.purs b/stdlib/lib/Data/Number.purs index 02b9bc7d..926b2e53 100644 --- a/stdlib/lib/Data/Number.purs +++ b/stdlib/lib/Data/Number.purs @@ -44,8 +44,7 @@ import Data.Maybe (Maybe(..)) -- | > nan -- | NaN -- | ``` -nan :: Number -nan = nan +foreign import nan :: Number -- | Test whether a number is NaN. -- | ```purs @@ -55,8 +54,7 @@ nan = nan -- | > isNaN nan -- | true -- | ``` -isNaN :: Number -> Boolean -isNaN a0 = isNaN a0 +foreign import isNaN :: Number -> Boolean -- | Positive infinity. For negative infinity use `(-infinity)` -- | ```purs @@ -66,8 +64,7 @@ isNaN a0 = isNaN a0 -- | > (-infinity) -- | - Infinity -- | ``` -infinity :: Number -infinity = infinity +foreign import infinity :: Number -- | Test whether a number is finite. -- | ```purs @@ -83,8 +80,7 @@ infinity = infinity -- | > isFinite nan -- | false -- | ``` -isFinite :: Number -> Boolean -isFinite a0 = isFinite a0 +foreign import isFinite :: Number -> Boolean -- | Attempt to parse a `Number` using JavaScripts `parseFloat`. Returns -- | `Nothing` if the parse fails or if the result is not a finite number. @@ -116,8 +112,7 @@ isFinite a0 = isFinite a0 fromString :: String -> Maybe Number fromString str = runFn4 fromStringImpl str isFinite Just Nothing -fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number) -fromStringImpl = fromStringImpl +foreign import fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number) -- | Returns the absolute value of the argument. -- | ```purs @@ -125,32 +120,28 @@ fromStringImpl = fromStringImpl -- | > sign x * abs x == x -- | true -- | ``` -abs :: Number -> Number -abs a0 = abs a0 +foreign import abs :: Number -> Number -- | Returns the inverse cosine in radians of the argument. -- | ```purs -- | > acos 0.0 == pi / 2.0 -- | true -- | ``` -acos :: Number -> Number -acos a0 = acos a0 +foreign import acos :: Number -> Number -- | Returns the inverse sine in radians of the argument. -- | ```purs -- | > asin 1.0 == pi / 2.0 -- | true -- | ``` -asin :: Number -> Number -asin a0 = asin a0 +foreign import asin :: Number -> Number -- | Returns the inverse tangent in radians of the argument. -- | ```purs -- | > atan 1.0 == pi / 4.0 -- | true -- | ``` -atan :: Number -> Number -atan a0 = atan a0 +foreign import atan :: Number -> Number -- | Four-quadrant tangent inverse. Given the arguments `y` and `x`, returns -- | the inverse tangent of `y / x`, where the signs of both arguments are used @@ -163,57 +154,49 @@ atan a0 = atan a0 -- | > atan2 1.0 0.0 == pi / 2.0 -- | true -- | ``` -atan2 :: Number -> Number -> Number -atan2 a0 a1 = atan2 a0 a1 +foreign import atan2 :: Number -> Number -> Number -- | Returns the smallest integer not smaller than the argument. -- | ```purs -- | > ceil 1.5 -- | 2.0 -- | ``` -ceil :: Number -> Number -ceil a0 = ceil a0 +foreign import ceil :: Number -> Number -- | Returns the cosine of the argument, where the argument is in radians. -- | ```purs -- | > cos (pi / 4.0) == sqrt2 / 2.0 -- | true -- | ``` -cos :: Number -> Number -cos a0 = cos a0 +foreign import cos :: Number -> Number -- | Returns `e` exponentiated to the power of the argument. -- | ```purs -- | > exp 1.0 -- | 2.718281828459045 -- | ``` -exp :: Number -> Number -exp a0 = exp a0 +foreign import exp :: Number -> Number -- | Returns the largest integer not larger than the argument. -- | ```purs -- | > floor 1.5 -- | 1.0 -- | ``` -floor :: Number -> Number -floor a0 = floor a0 +foreign import floor :: Number -> Number -- | Returns the natural logarithm of a number. -- | ```purs -- | > log e -- | 1.0 -log :: Number -> Number -log a0 = log a0 +foreign import log :: Number -> Number -- | Returns the largest of two numbers. Unlike `max` in Data.Ord this version -- | returns NaN if either argument is NaN. -max :: Number -> Number -> Number -max a0 a1 = max a0 a1 +foreign import max :: Number -> Number -> Number -- | Returns the smallest of two numbers. Unlike `min` in Data.Ord this version -- | returns NaN if either argument is NaN. -min :: Number -> Number -> Number -min a0 a1 = min a0 a1 +foreign import min :: Number -> Number -> Number -- | Return the first argument exponentiated to the power of the second argument. -- | ```purs @@ -223,16 +206,14 @@ min a0 a1 = min a0 a1 -- | true -- | ``` -pow :: Number -> Number -> Number -pow a0 a1 = pow a0 a1 +foreign import pow :: Number -> Number -> Number -- | Computes the remainder after division. This is the same as JavaScript's `%` operator. -- ```purs -- > 5.3 % 2.0 -- 1.2999999999999998 -- ``` -remainder :: Number -> Number -> Number -remainder a0 a1 = remainder a0 a1 +foreign import remainder :: Number -> Number -> Number infixl 7 remainder as % @@ -241,8 +222,7 @@ infixl 7 remainder as % -- | > round 1.5 -- | 2.0 -- | ``` -round :: Number -> Number -round a0 = round a0 +foreign import round :: Number -> Number -- | Returns either a positive or negative +/- 1, indicating the sign of the -- | argument. If the argument is 0, it will return a +/- 0. If the argument is @@ -252,32 +232,28 @@ round a0 = round a0 -- | > sign x * abs x == x -- | true -- | ``` -sign :: Number -> Number -sign a0 = sign a0 +foreign import sign :: Number -> Number -- | Returns the sine of the argument, where the argument is in radians. -- | ```purs -- | > sin (pi / 2.0) -- | 1.0 -- | ``` -sin :: Number -> Number -sin a0 = sin a0 +foreign import sin :: Number -> Number -- | Returns the square root of the argument. -- | ```purs -- | > sqrt 49.0 -- | 7.0 -- | ``` -sqrt :: Number -> Number -sqrt a0 = sqrt a0 +foreign import sqrt :: Number -> Number -- | Returns the tangent of the argument, where the argument is in radians. -- | ``` -- | > tan (pi / 4.0) -- | 0.9999999999999999 -- | ``` -tan :: Number -> Number -tan a0 = tan a0 +foreign import tan :: Number -> Number -- | Truncates the decimal portion of a number. Equivalent to `floor` if the -- | number is positive, and `ceil` if the number is negative. @@ -285,8 +261,7 @@ tan a0 = tan a0 -- | ceil 1.5 -- | 2.0 -- | ``` -trunc :: Number -> Number -trunc a0 = trunc a0 +foreign import trunc :: Number -> Number -- | The base of the natural logarithm, also known as Euler's number or *e*. -- | ```purs diff --git a/stdlib/lib/Data/Number/Format.purs b/stdlib/lib/Data/Number/Format.purs index 29bb788f..6cf40809 100644 --- a/stdlib/lib/Data/Number/Format.purs +++ b/stdlib/lib/Data/Number/Format.purs @@ -30,12 +30,9 @@ module Data.Number.Format import Prelude -toPrecisionNative :: Int -> Number -> String -toPrecisionNative a0 a1 = toPrecisionNative a0 a1 -toFixedNative :: Int -> Number -> String -toFixedNative a0 a1 = toFixedNative a0 a1 -toExponentialNative :: Int -> Number -> String -toExponentialNative a0 a1 = toExponentialNative a0 a1 +foreign import toPrecisionNative :: Int -> Number -> String +foreign import toFixedNative :: Int -> Number -> String +foreign import toExponentialNative :: Int -> Number -> String -- | The `Format` data type specifies how a number will be formatted. data Format @@ -76,5 +73,4 @@ toStringWith (Exponential p) = toExponentialNative p -- | > toString 1.2e-10 -- | "1.2e-10" -- | ``` -toString :: Number -> String -toString a0 = toString a0 +foreign import toString :: Number -> String diff --git a/stdlib/lib/Data/Ord.purs b/stdlib/lib/Data/Ord.purs index 97a0ea90..ed699905 100644 --- a/stdlib/lib/Data/Ord.purs +++ b/stdlib/lib/Data/Ord.purs @@ -49,19 +49,19 @@ class Eq a <= Ord a where compare :: a -> a -> Ordering instance ordBoolean :: Ord Boolean where - compare x y = ordBooleanImpl LT EQ GT x y + compare = ordBooleanImpl LT EQ GT instance ordInt :: Ord Int where - compare x y = ordIntImpl LT EQ GT x y + compare = ordIntImpl LT EQ GT instance ordNumber :: Ord Number where - compare x y = ordNumberImpl LT EQ GT x y + compare = ordNumberImpl LT EQ GT instance ordString :: Ord String where - compare x y = ordStringImpl LT EQ GT x y + compare = ordStringImpl LT EQ GT instance ordChar :: Ord Char where - compare x y = ordCharImpl LT EQ GT x y + compare = ordCharImpl LT EQ GT instance ordUnit :: Ord Unit where compare _ _ = EQ @@ -81,46 +81,47 @@ instance ordArray :: Ord a => Ord (Array a) where LT -> 1 GT -> -1 -ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering -ordBooleanImpl a0 a1 a2 a3 a4 = if booleanEq a3 a4 then a1 else if a3 then a2 else a0 - -ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering -ordIntImpl a0 a1 a2 a3 a4 = if intLt a3 a4 then a0 else if intEq a3 a4 then a1 else a2 - -ordNumberImpl :: Ordering -> Ordering -> Ordering -> Number -> Number -> Ordering -ordNumberImpl a0 a1 a2 a3 a4 = if numberLt a3 a4 then a0 else if numberEq a3 a4 then a1 else a2 - -ordStringImpl :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering -ordStringImpl a0 a1 a2 a3 a4 = ordBytes a0 a1 a2 (stringToBytes a3) (stringToBytes a4) 0 - -ordBytes :: forall a. a -> a -> a -> Array Int -> Array Int -> Int -> a -ordBytes lt eq gt xs ys index = - if intGe index (arrayLength xs) then - if intEq (arrayLength xs) (arrayLength ys) then eq - else if intGt (arrayLength xs) (arrayLength ys) then gt - else lt - else if intGe index (arrayLength ys) then gt - else if intLt (arrayIndex xs index) (arrayIndex ys index) then lt - else if intEq (arrayIndex xs index) (arrayIndex ys index) then ordBytes lt eq gt xs ys (intAdd index 1) - else gt - -ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering -ordCharImpl a0 a1 a2 a3 a4 = if charLt a3 a4 then a0 else if charEq a3 a4 then a1 else a2 - -ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int -ordArrayImpl a0 a1 a2 = ordArrayFrom a0 a1 a2 0 - -ordArrayFrom :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int -> Int -ordArrayFrom compareOne xs ys index = - if intLt index (arrayLength xs) then - if intLt index (arrayLength ys) then - let - order = compareOne (arrayIndex xs index) (arrayIndex ys index) - in - if intEq order 0 then ordArrayFrom compareOne xs ys (intAdd index 1) else order - else intNeg 1 - else if intEq (arrayLength xs) (arrayLength ys) then 0 - else 1 +foreign import ordBooleanImpl + :: Ordering + -> Ordering + -> Ordering + -> Boolean + -> Boolean + -> Ordering + +foreign import ordIntImpl + :: Ordering + -> Ordering + -> Ordering + -> Int + -> Int + -> Ordering + +foreign import ordNumberImpl + :: Ordering + -> Ordering + -> Ordering + -> Number + -> Number + -> Ordering + +foreign import ordStringImpl + :: Ordering + -> Ordering + -> Ordering + -> String + -> String + -> Ordering + +foreign import ordCharImpl + :: Ordering + -> Ordering + -> Ordering + -> Char + -> Char + -> Ordering + +foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int instance ordOrdering :: Ord Ordering where compare LT LT = EQ diff --git a/stdlib/lib/Data/Reflectable.purs b/stdlib/lib/Data/Reflectable.purs index edf2fc1a..fafe5278 100644 --- a/stdlib/lib/Data/Reflectable.purs +++ b/stdlib/lib/Data/Reflectable.purs @@ -33,8 +33,7 @@ instance Reifiable Ordering instance Reifiable String -- local definition for use in `reifyType` -unsafeCoerce :: forall a b. a -> b -unsafeCoerce a0 = unsafeCoerce a0 +foreign import unsafeCoerce :: forall a b. a -> b -- | Reify a value of type `t` such that it can be consumed by a -- | function constrained by the `Reflectable` type class. For diff --git a/stdlib/lib/Data/Ring.purs b/stdlib/lib/Data/Ring.purs index 4e8c879b..c06abd63 100644 --- a/stdlib/lib/Data/Ring.purs +++ b/stdlib/lib/Data/Ring.purs @@ -30,10 +30,10 @@ class Semiring a <= Ring a where infixl 6 sub as - instance ringInt :: Ring Int where - sub x y = intSub x y + sub = intSub instance ringNumber :: Ring Number where - sub x y = numSub x y + sub = numSub instance ringUnit :: Ring Unit where sub _ _ = unit @@ -51,9 +51,8 @@ instance ringRecord :: (RL.RowToList row list, RingRecord list row row) => Ring negate :: forall a. Ring a => a -> a negate a = zero - a - -numSub :: Number -> Number -> Number -numSub a0 a1 = numberSub a0 a1 +foreign import intSub :: Int -> Int -> Int +foreign import numSub :: Number -> Number -> Number -- | A class for records where all fields have `Ring` instances, used to -- | implement the `Ring` instance for records. diff --git a/stdlib/lib/Data/Ring/Generic.purs b/stdlib/lib/Data/Ring/Generic.purs index a93208d1..27c38fd6 100644 --- a/stdlib/lib/Data/Ring/Generic.purs +++ b/stdlib/lib/Data/Ring/Generic.purs @@ -21,4 +21,4 @@ instance genericRingConstructor :: GenericRing a => GenericRing (Constructor nam -- | A `Generic` implementation of the `sub` member from the `Ring` type class. genericSub :: forall a rep. Generic a rep => GenericRing rep => a -> a -> a -genericSub x y = to $ from x `genericSub'` from y +genericSub x y = to $ from x `genericSub'` from y \ No newline at end of file diff --git a/stdlib/lib/Data/Semigroup.purs b/stdlib/lib/Data/Semigroup.purs index 4d5ef48a..28032270 100644 --- a/stdlib/lib/Data/Semigroup.purs +++ b/stdlib/lib/Data/Semigroup.purs @@ -37,7 +37,7 @@ class Semigroup a where infixr 5 append as <> instance semigroupString :: Semigroup String where - append x y = concatString x y + append = concatString instance semigroupUnit :: Semigroup Unit where append _ _ = unit @@ -49,7 +49,7 @@ instance semigroupFn :: Semigroup s' => Semigroup (s -> s') where append f g x = f x <> g x instance semigroupArray :: Semigroup (Array a) where - append x y = concatArray x y + append = concatArray instance semigroupProxy :: Semigroup (Proxy a) where append _ _ = Proxy @@ -57,10 +57,8 @@ instance semigroupProxy :: Semigroup (Proxy a) where instance semigroupRecord :: (RL.RowToList row list, SemigroupRecord list row row) => Semigroup (Record row) where append = appendRecord (Proxy :: Proxy list) -concatString :: String -> String -> String -concatString a0 a1 = bytesToString (arrayAppend (stringToBytes a0) (stringToBytes a1)) -concatArray :: forall a. Array a -> Array a -> Array a -concatArray a0 a1 = arrayAppend a0 a1 +foreign import concatString :: String -> String -> String +foreign import concatArray :: forall a. Array a -> Array a -> Array a -- | A class for records where all fields have `Semigroup` instances, used to -- | implement the `Semigroup` instance for records. diff --git a/stdlib/lib/Data/Semiring.purs b/stdlib/lib/Data/Semiring.purs index cfb1530d..b764425c 100644 --- a/stdlib/lib/Data/Semiring.purs +++ b/stdlib/lib/Data/Semiring.purs @@ -51,15 +51,15 @@ infixl 6 add as + infixl 7 mul as * instance semiringInt :: Semiring Int where - add x y = intAdd x y + add = intAdd zero = 0 - mul x y = intMul x y + mul = intMul one = 1 instance semiringNumber :: Semiring Number where - add x y = numAdd x y + add = numAdd zero = 0.0 - mul x y = numMul x y + mul = numMul one = 1.0 instance semiringFn :: Semiring b => Semiring (a -> b) where @@ -86,12 +86,10 @@ instance semiringRecord :: (RL.RowToList row list, SemiringRecord list row row) one = oneRecord (Proxy :: Proxy list) (Proxy :: Proxy row) zero = zeroRecord (Proxy :: Proxy list) (Proxy :: Proxy row) - - -numAdd :: Number -> Number -> Number -numAdd a0 a1 = numberAdd a0 a1 -numMul :: Number -> Number -> Number -numMul a0 a1 = numberMul a0 a1 +foreign import intAdd :: Int -> Int -> Int +foreign import intMul :: Int -> Int -> Int +foreign import numAdd :: Number -> Number -> Number +foreign import numMul :: Number -> Number -> Number -- | A class for records where all fields have `Semiring` instances, used to -- | implement the `Semiring` instance for records. diff --git a/stdlib/lib/Data/Semiring/Generic.purs b/stdlib/lib/Data/Semiring/Generic.purs index baf95aa9..6bf60d17 100644 --- a/stdlib/lib/Data/Semiring/Generic.purs +++ b/stdlib/lib/Data/Semiring/Generic.purs @@ -48,4 +48,4 @@ genericAdd x y = to $ from x `genericAdd'` from y -- | A `Generic` implementation of the `mul` member from the `Semiring` type class. genericMul :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a -genericMul x y = to $ from x `genericMul'` from y +genericMul x y = to $ from x `genericMul'` from y \ No newline at end of file diff --git a/stdlib/lib/Data/Show.purs b/stdlib/lib/Data/Show.purs index 1b2c08a3..93c62076 100644 --- a/stdlib/lib/Data/Show.purs +++ b/stdlib/lib/Data/Show.purs @@ -1,280 +1,97 @@ --- | The `Show` class. --- | --- | `show` renders a value as text. The `Int`, `Number`, `Boolean`, `Char`, --- | `String`, `Unit`, and `Array` instances are the ones the corpus actually --- | applies `show` to. `Show Unit` lives here; `Data.Unit` only re-exports the --- | builtin. A record instance is not here because `reflectSymbol` has no --- | runtime. --- | --- | `Boolean`, `Int`, `Char`, `String`, `Unit`, and `Array` match the official --- | spelling, including the `Char`/`String` escapes. `Number` uses the same --- | shape as the official instance — decimal digits, `.0` on an integer token, --- | scientific form outside `(1e-6, 1e21)` — but the digits come from the --- | numeric primitives, not from a correctly rounded ECMAScript conversion. --- | Integers whose absolute value is below `1e21`, powers of ten, and the --- | dyadic fractions the digit loop reaches exactly match; other fractions --- | print a deterministic expansion that can differ from `purs`. module Data.Show ( class Show , show + , class ShowRecordFields + , showRecordFields ) where import Data.Semigroup ((<>)) - --- | A type that can be rendered as text. +import Data.Symbol (class IsSymbol, reflectSymbol) +import Data.Unit (Unit) +import Data.Void (Void, absurd) +import Prim.Row (class Nub) +import Prim.RowList as RL +import Record.Unsafe (unsafeGet) +import Type.Proxy (Proxy(..)) + +-- | The `Show` type class represents those types which can be converted into +-- | a human-readable `String` representation. +-- | +-- | While not required, it is recommended that for any expression `x`, the +-- | string `show x` be executable PureScript code which evaluates to the same +-- | value as the expression `x`. class Show a where show :: a -> String +instance showUnit :: Show Unit where + show _ = "unit" + instance showBoolean :: Show Boolean where - show value = if value then "true" else "false" + show true = "true" + show false = "false" instance showInt :: Show Int where - show value = - if intEq value minInt then "-2147483648" - else if intLt value 0 then "-" <> showPositiveInt (intNeg value) - else showPositiveInt value + show = showIntImpl instance showNumber :: Show Number where - show value = - if numberNe value value then "NaN" - else if numberEq value positiveInfinity then "Infinity" - else if numberEq value negativeInfinity then "-Infinity" - else if numberLt value 0.0 then "-" <> showPositiveNumber (numberNeg value) - else showPositiveNumber value + show = showNumberImpl instance showChar :: Show Char where - show value = "'" <> escapeCode (charToInt value) false false <> "'" + show = showCharImpl instance showString :: Show String where - show value = "\"" <> escapeBytes (stringToBytes value) 0 <> "\"" - -instance showUnit :: Show Unit where - show _ = "unit" + show = showStringImpl instance showArray :: Show a => Show (Array a) where - show value = "[" <> showElements value 0 <> "]" - -minInt :: Int -minInt = intSub (intSub 0 2147483647) 1 - -positiveInfinity :: Number -positiveInfinity = numberDiv 1.0 0.0 - -negativeInfinity :: Number -negativeInfinity = numberDiv (numberNeg 1.0) 0.0 - -showPositiveInt :: Int -> String -showPositiveInt value = - if intLt value 10 then digit value - else showPositiveInt (intDiv value 10) <> digit (intMod value 10) - -digit :: Int -> String -digit value = bytesToString [intAdd 48 value] - --- | A non-negative `Number`. Integers below `1e21` print as decimal digits --- | plus `.0`. Smaller magnitudes print as a fixed expansion. The rest use --- | scientific form, which is what the official `Show Number` does past --- | those thresholds. -showPositiveNumber :: Number -> String -showPositiveNumber value = - if numberEq value 0.0 then "0.0" - else if numberGe value 1.0e21 then showScientific value - else if numberLt value 1.0e-6 then showScientific value - else if numberEq value (floorNumber value) then showIntegerNumber value <> ".0" - else showMixed value - -showMixed :: Number -> String -showMixed value = - let - whole = floorNumber value - fraction = numberSub value whole - wholeText = if numberEq whole 0.0 then "0" else showIntegerNumber whole - fractionText = digitsToString (trimZeros (collectFraction fraction 17 [])) 0 - in - if intEq (arrayLength (stringToBytes fractionText)) 0 then wholeText <> ".0" - else wholeText <> "." <> fractionText - -showScientific :: Number -> String -showScientific value = - let - exponent = powerOfTen value 0 - mantissa = scaleToUnit value exponent - in - showMantissa mantissa <> showExponent exponent - -showMantissa :: Number -> String -showMantissa value = - let - whole = numberToInt (floorNumber value) - fraction = numberSub value (intToNumber whole) - fractionText = digitsToString (trimZeros (collectFraction fraction 17 [])) 0 - in - if intEq (arrayLength (stringToBytes fractionText)) 0 then showPositiveInt whole - else showPositiveInt whole <> "." <> fractionText - -showExponent :: Int -> String -showExponent value = - if intLt value 0 then "e-" <> showPositiveInt (intNeg value) - else "e+" <> showPositiveInt value - -powerOfTen :: Number -> Int -> Int -powerOfTen value exponent = - if numberEq value 0.0 then exponent - else if numberGe value 10.0 then powerOfTen (numberDiv value 10.0) (intAdd exponent 1) - else if numberLt value 1.0 then powerOfTen (numberMul value 10.0) (intSub exponent 1) - else exponent - -scaleToUnit :: Number -> Int -> Number -scaleToUnit value exponent = - if intEq exponent 0 then value - else if intGt exponent 0 then scaleToUnit (numberDiv value 10.0) (intSub exponent 1) - else scaleToUnit (numberMul value 10.0) (intAdd exponent 1) - --- | Floor of a non-negative number. Groups of nine digits stay inside `Int`, --- | so a value past `2^31` still floors without a wider primitive. -floorNumber :: Number -> Number -floorNumber value = - if numberLt value 1000000000.0 then intToNumber (numberToInt value) - else - let - billions = floorNumber (numberDiv value 1000000000.0) - base = numberMul billions 1000000000.0 - low = numberToInt (numberSub value base) - in - numberAdd base (intToNumber low) - -showIntegerNumber :: Number -> String -showIntegerNumber value = - if numberLt value 1000000000.0 then showPositiveInt (numberToInt value) - else - let - billions = floorNumber (numberDiv value 1000000000.0) - base = numberMul billions 1000000000.0 - low = numberToInt (numberSub value base) - in - showIntegerNumber billions <> pad9 low - -pad9 :: Int -> String -pad9 value = - if intLt value 10 then "00000000" <> showPositiveInt value - else if intLt value 100 then "0000000" <> showPositiveInt value - else if intLt value 1000 then "000000" <> showPositiveInt value - else if intLt value 10000 then "00000" <> showPositiveInt value - else if intLt value 100000 then "0000" <> showPositiveInt value - else if intLt value 1000000 then "000" <> showPositiveInt value - else if intLt value 10000000 then "00" <> showPositiveInt value - else if intLt value 100000000 then "0" <> showPositiveInt value - else showPositiveInt value - -collectFraction :: Number -> Int -> Array Int -> Array Int -collectFraction fraction remaining digits = - if intEq remaining 0 then digits - else if numberEq fraction 0.0 then digits - else - let - scaled = numberMul fraction 10.0 - digitValue = numberToInt scaled - rest = numberSub scaled (intToNumber digitValue) - in - collectFraction rest (intSub remaining 1) (arrayAppend digits [digitValue]) - -trimZeros :: Array Int -> Array Int -trimZeros digits = - let - length = arrayLength digits - in - if intEq length 0 then digits - else if intEq (arrayIndex digits (intSub length 1)) 0 then trimZeros (takePrefix digits (intSub length 1)) - else digits - -takePrefix :: Array Int -> Int -> Array Int -takePrefix digits count = copyPrefix digits count 0 - -copyPrefix :: Array Int -> Int -> Int -> Array Int -copyPrefix digits count index = - if intGe index count then [] - else arrayAppend [arrayIndex digits index] (copyPrefix digits count (intAdd index 1)) - -digitsToString :: Array Int -> Int -> String -digitsToString digits index = - if intGe index (arrayLength digits) then "" - else digit (arrayIndex digits index) <> digitsToString digits (intAdd index 1) - -showElements :: forall a. Show a => Array a -> Int -> String -showElements values index = - if intGe index (arrayLength values) then "" - else if intEq index 0 then show (arrayIndex values index) <> showElements values (intAdd index 1) - else "," <> show (arrayIndex values index) <> showElements values (intAdd index 1) - --- | The body of a `Char` or `String` escape, without the surrounding quotes. --- | `ampersand` is true when a numeric escape must not swallow a following --- | digit, which is the official `\&` rule. -escapeCode :: Int -> Boolean -> Boolean -> String -escapeCode code ampersand inString = - if intEq code 7 then "\\a" - else if intEq code 8 then "\\b" - else if intEq code 12 then "\\f" - else if intEq code 10 then "\\n" - else if intEq code 13 then "\\r" - else if intEq code 9 then "\\t" - else if intEq code 11 then "\\v" - else if intLt code 32 then "\\" <> showPositiveInt code <> emptyAmpersand ampersand - else if intEq code 127 then "\\127" <> emptyAmpersand ampersand - else if intEq code 92 then "\\\\" - else if intEq code 34 then if inString then "\\\"" else utf8 code - else if intEq code 39 then if inString then utf8 code else "\\'" - else utf8 code - -emptyAmpersand :: Boolean -> String -emptyAmpersand needed = if needed then "\\&" else "" - -escapeBytes :: Array Int -> Int -> String -escapeBytes bytes index = - if intGe index (arrayLength bytes) then "" - else - let - decoded = decode bytes index - code = arrayIndex decoded 0 - next = arrayIndex decoded 1 - in - escapeCode code (nextIsDigit bytes next) true <> escapeBytes bytes next - -nextIsDigit :: Array Int -> Int -> Boolean -nextIsDigit bytes index = - if intGe index (arrayLength bytes) then false - else - let - code = arrayIndex (decode bytes index) 0 - in - if intLt code 48 then false else intLe code 57 - --- | One Unicode scalar and the index of the byte after it. The bytes are --- | well-formed UTF-8 because they came from `stringToBytes`. -decode :: Array Int -> Int -> Array Int -decode bytes index = - let - first = arrayIndex bytes index - in - if intLt first 128 then [first, intAdd index 1] - else if intLt first 224 then - [ intAdd (intShl (intAnd first 31) 6) (continuation bytes (intAdd index 1)) - , intAdd index 2 - ] - else if intLt first 240 then - [ intAdd (intAdd (intShl (intAnd first 15) 12) (intShl (continuation bytes (intAdd index 1)) 6)) (continuation bytes (intAdd index 2)) - , intAdd index 3 - ] - else - [ intAdd (intAdd (intAdd (intShl (intAnd first 7) 18) (intShl (continuation bytes (intAdd index 1)) 12)) (intShl (continuation bytes (intAdd index 2)) 6)) (continuation bytes (intAdd index 3)) - , intAdd index 4 - ] - -continuation :: Array Int -> Int -> Int -continuation bytes index = intAnd (arrayIndex bytes index) 63 - -utf8 :: Int -> String -utf8 code = - if intLt code 128 then bytesToString [code] - else if intLt code 2048 then bytesToString [intOr 192 (intShr code 6), intOr 128 (intAnd code 63)] - else if intLt code 65536 then bytesToString [intOr 224 (intShr code 12), intOr 128 (intAnd (intShr code 6) 63), intOr 128 (intAnd code 63)] - else bytesToString [intOr 240 (intShr code 18), intOr 128 (intAnd (intShr code 12) 63), intOr 128 (intAnd (intShr code 6) 63), intOr 128 (intAnd code 63)] + show = showArrayImpl show + +instance showProxy :: Show (Proxy a) where + show _ = "Proxy" + +instance showVoid :: Show Void where + show = absurd + +instance showRecord :: + ( Nub rs rs + , RL.RowToList rs ls + , ShowRecordFields ls rs + ) => + Show (Record rs) where + show record = "{" <> showRecordFields (Proxy :: Proxy ls) record <> "}" + +-- | A class for records where all fields have `Show` instances, used to +-- | implement the `Show` instance for records. +class ShowRecordFields :: RL.RowList Type -> Row Type -> Constraint +class ShowRecordFields rowlist row where + showRecordFields :: Proxy rowlist -> Record row -> String + +instance showRecordFieldsNil :: ShowRecordFields RL.Nil row where + showRecordFields _ _ = "" +else +instance showRecordFieldsConsNil :: + ( IsSymbol key + , Show focus + ) => + ShowRecordFields (RL.Cons key focus RL.Nil) row where + showRecordFields _ record = " " <> key <> ": " <> show focus <> " " + where + key = reflectSymbol (Proxy :: Proxy key) + focus = unsafeGet key record :: focus +else +instance showRecordFieldsCons :: + ( IsSymbol key + , ShowRecordFields rowlistTail row + , Show focus + ) => + ShowRecordFields (RL.Cons key focus rowlistTail) row where + showRecordFields _ record = " " <> key <> ": " <> show focus <> "," <> tail + where + key = reflectSymbol (Proxy :: Proxy key) + focus = unsafeGet key record :: focus + tail = showRecordFields (Proxy :: Proxy rowlistTail) record + +foreign import showIntImpl :: Int -> String +foreign import showNumberImpl :: Number -> String +foreign import showCharImpl :: Char -> String +foreign import showStringImpl :: String -> String +foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String diff --git a/stdlib/lib/Data/Show/Generic.purs b/stdlib/lib/Data/Show/Generic.purs index 8bf6aba2..297986a4 100644 --- a/stdlib/lib/Data/Show/Generic.purs +++ b/stdlib/lib/Data/Show/Generic.purs @@ -54,11 +54,4 @@ instance genericShowArgsArgument :: Show a => GenericShowArgs (Argument a) where genericShow :: forall a rep. Generic a rep => GenericShow rep => a -> String genericShow x = genericShow' (from x) -intercalate :: String -> Array String -> String -intercalate a0 a1 = intercalateFrom a0 a1 0 - -intercalateFrom :: String -> Array String -> Int -> String -intercalateFrom separator values index = - if intGe index (arrayLength values) then "" - else if intEq index 0 then arrayIndex values index <> intercalateFrom separator values (intAdd index 1) - else separator <> arrayIndex values index <> intercalateFrom separator values (intAdd index 1) +foreign import intercalate :: String -> Array String -> String diff --git a/stdlib/lib/Data/String/CodePoints.purs b/stdlib/lib/Data/String/CodePoints.purs index e7cb8b29..65e0b55b 100644 --- a/stdlib/lib/Data/String/CodePoints.purs +++ b/stdlib/lib/Data/String/CodePoints.purs @@ -88,8 +88,10 @@ codePointFromChar = fromEnum >>> CodePoint singleton :: CodePoint -> String singleton = _singleton singletonFallback -_singleton :: (CodePoint -> String) -> CodePoint -> String -_singleton a0 a1 = _singleton a0 a1 +foreign import _singleton + :: (CodePoint -> String) + -> CodePoint + -> String singletonFallback :: CodePoint -> String singletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp @@ -112,8 +114,10 @@ singletonFallback (CodePoint cp) = fromCodePointArray :: Array CodePoint -> String fromCodePointArray = _fromCodePointArray singletonFallback -_fromCodePointArray :: (CodePoint -> String) -> Array CodePoint -> String -_fromCodePointArray a0 a1 = _fromCodePointArray a0 a1 +foreign import _fromCodePointArray + :: (CodePoint -> String) + -> Array CodePoint + -> String -- | Creates an array of code points from a string. Operates in space and time -- | linear to the length of the string. @@ -129,8 +133,11 @@ _fromCodePointArray a0 a1 = _fromCodePointArray a0 a1 toCodePointArray :: String -> Array CodePoint toCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0 -_toCodePointArray :: (String -> Array CodePoint) -> (String -> CodePoint) -> String -> Array CodePoint -_toCodePointArray a0 a1 a2 = _toCodePointArray a0 a1 a2 +foreign import _toCodePointArray + :: (String -> Array CodePoint) + -> (String -> CodePoint) + -> String + -> Array CodePoint toCodePointArrayFallback :: String -> Array CodePoint toCodePointArrayFallback s = unfoldr unconsButWithTuple s @@ -156,8 +163,14 @@ codePointAt 0 "" = Nothing codePointAt 0 s = Just (unsafeCodePointAt0 s) codePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s -_codePointAt :: (Int -> String -> Maybe CodePoint) -> (forall a. a -> Maybe a) -> (forall a. Maybe a) -> (String -> CodePoint) -> Int -> String -> Maybe CodePoint -_codePointAt a0 a1 a2 a3 a4 a5 = _codePointAt a0 a1 a2 a3 a4 a5 +foreign import _codePointAt + :: (Int -> String -> Maybe CodePoint) + -> (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> (String -> CodePoint) + -> Int + -> String + -> Maybe CodePoint codePointAtFallback :: Int -> String -> Maybe CodePoint codePointAtFallback n s = case uncons s of @@ -214,8 +227,12 @@ length = Array.length <<< toCodePointArray countPrefix :: (CodePoint -> Boolean) -> String -> Int countPrefix = _countPrefix countFallback unsafeCodePointAt0 -_countPrefix :: ((CodePoint -> Boolean) -> String -> Int) -> (String -> CodePoint) -> (CodePoint -> Boolean) -> String -> Int -_countPrefix a0 a1 a2 a3 = _countPrefix a0 a1 a2 a3 +foreign import _countPrefix + :: ((CodePoint -> Boolean) -> String -> Int) + -> (String -> CodePoint) + -> (CodePoint -> Boolean) + -> String + -> Int countFallback :: (CodePoint -> Boolean) -> String -> Int countFallback p s = countTail p s 0 @@ -311,8 +328,7 @@ lastIndexOf' p i s = take :: Int -> String -> String take = _take takeFallback -_take :: (Int -> String -> String) -> Int -> String -> String -_take a0 a1 a2 = _take a0 a1 a2 +foreign import _take :: (Int -> String -> String) -> Int -> String -> String takeFallback :: Int -> String -> String takeFallback n _ | n < 1 = "" @@ -402,8 +418,10 @@ fromCharCode = CU.singleton <<< toEnumWithDefaults bottom top unsafeCodePointAt0 :: String -> CodePoint unsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback -_unsafeCodePointAt0 :: (String -> CodePoint) -> String -> CodePoint -_unsafeCodePointAt0 a0 a1 = _unsafeCodePointAt0 a0 a1 +foreign import _unsafeCodePointAt0 + :: (String -> CodePoint) + -> String + -> CodePoint unsafeCodePointAt0Fallback :: String -> CodePoint unsafeCodePointAt0Fallback s = diff --git a/stdlib/lib/Data/String/CodeUnits.purs b/stdlib/lib/Data/String/CodeUnits.purs index 05cef29f..5fed21fd 100644 --- a/stdlib/lib/Data/String/CodeUnits.purs +++ b/stdlib/lib/Data/String/CodeUnits.purs @@ -80,24 +80,21 @@ contains pat = isJust <<< indexOf pat -- | singleton 'l' == "l" -- | ``` -- | -singleton :: Char -> String -singleton a0 = singleton a0 +foreign import singleton :: Char -> String -- | Converts an array of characters into a string. -- | -- | ```purescript -- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == "Hello" -- | ``` -fromCharArray :: Array Char -> String -fromCharArray a0 = fromCharArray a0 +foreign import fromCharArray :: Array Char -> String -- | Converts the string into an array of characters. -- | -- | ```purescript -- | toCharArray "Hello☺\n" == ['H','e','l','l','o','☺','\n'] -- | ``` -toCharArray :: String -> Array Char -toCharArray a0 = toCharArray a0 +foreign import toCharArray :: String -> Array Char -- | Returns the character at the given index, if the index is within bounds. -- | @@ -109,8 +106,12 @@ toCharArray a0 = toCharArray a0 charAt :: Int -> String -> Maybe Char charAt = _charAt Just Nothing -_charAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Int -> String -> Maybe Char -_charAt a0 a1 a2 a3 = _charAt a0 a1 a2 a3 +foreign import _charAt + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Int + -> String + -> Maybe Char -- | Converts the string to a character, if the length of the string is -- | exactly `1`. @@ -122,8 +123,11 @@ _charAt a0 a1 a2 a3 = _charAt a0 a1 a2 a3 toChar :: String -> Maybe Char toChar = _toChar Just Nothing -_toChar :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> String -> Maybe Char -_toChar a0 a1 a2 = _toChar a0 a1 a2 +foreign import _toChar + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> String + -> Maybe Char -- | Returns the first character and the rest of the string, -- | if the string is not empty. @@ -143,8 +147,7 @@ uncons s = Just { head: U.charAt zero s, tail: drop one s } -- | length "Hello World" == 11 -- | ``` -- | -length :: String -> Int -length a0 = length a0 +foreign import length :: String -> Int -- | Returns the number of contiguous characters at the beginning -- | of the string for which the predicate holds. @@ -153,8 +156,7 @@ length a0 = length a0 -- | countPrefix (_ /= ' ') "Hello World" == 5 -- since length "Hello" == 5 -- | ``` -- | -countPrefix :: (Char -> Boolean) -> String -> Int -countPrefix a0 a1 = countPrefix a0 a1 +foreign import countPrefix :: (Char -> Boolean) -> String -> Int -- | Returns the index of the first occurrence of the pattern in the -- | given string. Returns `Nothing` if there is no match. @@ -167,8 +169,12 @@ countPrefix a0 a1 = countPrefix a0 a1 indexOf :: Pattern -> String -> Maybe Int indexOf = _indexOf Just Nothing -_indexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int -_indexOf a0 a1 a2 a3 = _indexOf a0 a1 a2 a3 +foreign import _indexOf + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Pattern + -> String + -> Maybe Int -- | Returns the index of the first occurrence of the pattern in the -- | given string, starting at the specified index. Returns `Nothing` if there is @@ -182,8 +188,13 @@ _indexOf a0 a1 a2 a3 = _indexOf a0 a1 a2 a3 indexOf' :: Pattern -> Int -> String -> Maybe Int indexOf' = _indexOfStartingAt Just Nothing -_indexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int -_indexOfStartingAt a0 a1 a2 a3 a4 = _indexOfStartingAt a0 a1 a2 a3 a4 +foreign import _indexOfStartingAt + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Pattern + -> Int + -> String + -> Maybe Int -- | Returns the index of the last occurrence of the pattern in the -- | given string. Returns `Nothing` if there is no match. @@ -196,8 +207,12 @@ _indexOfStartingAt a0 a1 a2 a3 a4 = _indexOfStartingAt a0 a1 a2 a3 a4 lastIndexOf :: Pattern -> String -> Maybe Int lastIndexOf = _lastIndexOf Just Nothing -_lastIndexOf :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> String -> Maybe Int -_lastIndexOf a0 a1 a2 a3 = _lastIndexOf a0 a1 a2 a3 +foreign import _lastIndexOf + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Pattern + -> String + -> Maybe Int -- | Returns the index of the last occurrence of the pattern in the -- | given string, starting at the specified index and searching @@ -220,8 +235,13 @@ _lastIndexOf a0 a1 a2 a3 = _lastIndexOf a0 a1 a2 a3 lastIndexOf' :: Pattern -> Int -> String -> Maybe Int lastIndexOf' = _lastIndexOfStartingAt Just Nothing -_lastIndexOfStartingAt :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Pattern -> Int -> String -> Maybe Int -_lastIndexOfStartingAt a0 a1 a2 a3 a4 = _lastIndexOfStartingAt a0 a1 a2 a3 a4 +foreign import _lastIndexOfStartingAt + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Pattern + -> Int + -> String + -> Maybe Int -- | Returns the first `n` characters of the string. -- | @@ -229,8 +249,7 @@ _lastIndexOfStartingAt a0 a1 a2 a3 a4 = _lastIndexOfStartingAt a0 a1 a2 a3 a4 -- | take 5 "Hello World" == "Hello" -- | ``` -- | -take :: Int -> String -> String -take a0 a1 = take a0 a1 +foreign import take :: Int -> String -> String -- | Returns the last `n` characters of the string. -- | @@ -257,8 +276,7 @@ takeWhile p s = take (countPrefix p s) s -- | drop 6 "Hello World" == "World" -- | ``` -- | -drop :: Int -> String -> String -drop a0 a1 = drop a0 a1 +foreign import drop :: Int -> String -> String -- | Returns the string without the last `n` characters. -- | @@ -290,8 +308,7 @@ dropWhile p s = drop (countPrefix p s) s -- | slice (-4) (-1) "purescript" == "rip" -- | slice (-4) 3 "purescript" == "" -- | ``` -slice :: Int -> Int -> String -> String -slice a0 a1 a2 = slice a0 a1 a2 +foreign import slice :: Int -> Int -> String -> String -- | Splits a string into two substrings, where `before` contains the -- | characters up to (but not including) the given index, and `after` contains @@ -312,5 +329,4 @@ slice a0 a1 a2 = slice a0 a1 a2 -- | (splitAt i s).before <> (splitAt i s).after == s -- | splitAt i s == {before: take i s, after: drop i s} -- | ``` -splitAt :: Int -> String -> { before :: String, after :: String } -splitAt a0 a1 = splitAt a0 a1 +foreign import splitAt :: Int -> String -> { before :: String, after :: String } diff --git a/stdlib/lib/Data/String/Common.purs b/stdlib/lib/Data/String/Common.purs index e684682c..9e3132e6 100644 --- a/stdlib/lib/Data/String/Common.purs +++ b/stdlib/lib/Data/String/Common.purs @@ -34,24 +34,27 @@ null s = s == "" localeCompare :: String -> String -> Ordering localeCompare = _localeCompare LT EQ GT -_localeCompare :: Ordering -> Ordering -> Ordering -> String -> String -> Ordering -_localeCompare a0 a1 a2 a3 a4 = _localeCompare a0 a1 a2 a3 a4 +foreign import _localeCompare + :: Ordering + -> Ordering + -> Ordering + -> String + -> String + -> Ordering -- | Replaces the first occurence of the pattern with the replacement string. -- | -- | ```purescript -- | replace (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b <= c" -- | ``` -replace :: Pattern -> Replacement -> String -> String -replace a0 a1 a2 = replace a0 a1 a2 +foreign import replace :: Pattern -> Replacement -> String -> String -- | Replaces all occurences of the pattern with the replacement string. -- | -- | ```purescript -- | replaceAll (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b ≤ c" -- | ``` -replaceAll :: Pattern -> Replacement -> String -> String -replaceAll a0 a1 a2 = replaceAll a0 a1 a2 +foreign import replaceAll :: Pattern -> Replacement -> String -> String -- | Returns the substrings of the second string separated along occurences -- | of the first string. @@ -59,24 +62,21 @@ replaceAll a0 a1 a2 = replaceAll a0 a1 a2 -- | ```purescript -- | split (Pattern " ") "hello world" == ["hello", "world"] -- | ``` -split :: Pattern -> String -> Array String -split a0 a1 = split a0 a1 +foreign import split :: Pattern -> String -> Array String -- | Returns the argument converted to lowercase. -- | -- | ```purescript -- | toLower "hElLo" == "hello" -- | ``` -toLower :: String -> String -toLower a0 = toLower a0 +foreign import toLower :: String -> String -- | Returns the argument converted to uppercase. -- | -- | ```purescript -- | toUpper "Hello" == "HELLO" -- | ``` -toUpper :: String -> String -toUpper a0 = toUpper a0 +foreign import toUpper :: String -> String -- | Removes whitespace from the beginning and end of a string, including -- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2) @@ -85,8 +85,7 @@ toUpper a0 = toUpper a0 -- | ```purescript -- | trim " Hello \n World\n\t " == "Hello \n World" -- | ``` -trim :: String -> String -trim a0 = trim a0 +foreign import trim :: String -> String -- | Joins the strings in the array together, inserting the first argument -- | as separator between them. @@ -94,5 +93,4 @@ trim a0 = trim a0 -- | ```purescript -- | joinWith ", " ["apple", "banana", "orange"] == "apple, banana, orange" -- | ``` -joinWith :: String -> Array String -> String -joinWith a0 a1 = joinWith a0 a1 +foreign import joinWith :: String -> Array String -> String diff --git a/stdlib/lib/Data/String/Regex.purs b/stdlib/lib/Data/String/Regex.purs index 6cd837d6..aae56e1b 100644 --- a/stdlib/lib/Data/String/Regex.purs +++ b/stdlib/lib/Data/String/Regex.purs @@ -28,14 +28,17 @@ import Data.String.Regex.Flags (RegexFlags(..), RegexFlagsRec) -- | Wraps Javascript `RegExp` objects. foreign import data Regex :: Type -showRegexImpl :: Regex -> String -showRegexImpl a0 = showRegexImpl a0 +foreign import showRegexImpl :: Regex -> String instance showRegex :: Show Regex where show = showRegexImpl -regexImpl :: (String -> Either String Regex) -> (Regex -> Either String Regex) -> String -> String -> Either String Regex -regexImpl a0 a1 a2 a3 = regexImpl a0 a1 a2 a3 +foreign import regexImpl + :: (String -> Either String Regex) + -> (Regex -> Either String Regex) + -> String + -> String + -> Either String Regex -- | Constructs a `Regex` from a pattern string and flags. Fails with -- | `Left error` if the pattern contains a syntax error. @@ -43,16 +46,14 @@ regex :: String -> RegexFlags -> Either String Regex regex s f = regexImpl Left Right s $ renderFlags f -- | Returns the pattern string used to construct the given `Regex`. -source :: Regex -> String -source a0 = source a0 +foreign import source :: Regex -> String -- | Returns the `RegexFlags` used to construct the given `Regex`. flags :: Regex -> RegexFlags flags = RegexFlags <<< flagsImpl -- | Returns the `RegexFlags` inner record used to construct the given `Regex`. -flagsImpl :: Regex -> RegexFlagsRec -flagsImpl a0 = flagsImpl a0 +foreign import flagsImpl :: Regex -> RegexFlagsRec -- | Returns the string representation of the given `RegexFlags`. renderFlags :: RegexFlags -> String @@ -78,11 +79,14 @@ parseFlags s = RegexFlags -- | Returns `true` if the `Regex` matches the string. In contrast to -- | `RegExp.prototype.test()` in JavaScript, `test` does not affect -- | the `lastIndex` property of the Regex. -test :: Regex -> String -> Boolean -test a0 a1 = test a0 a1 +foreign import test :: Regex -> String -> Boolean -_match :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe (NonEmptyArray (Maybe String)) -_match a0 a1 a2 a3 = _match a0 a1 a2 a3 +foreign import _match + :: (forall r. r -> Maybe r) + -> (forall r. Maybe r) + -> Regex + -> String + -> Maybe (NonEmptyArray (Maybe String)) -- | Matches the string against the `Regex` and returns an array of matches -- | if there were any. Each match has type `Maybe String`, where `Nothing` @@ -94,11 +98,15 @@ match = _match Just Nothing -- | Replaces occurrences of the `Regex` with the first string. The replacement -- | string can include special replacement patterns escaped with `"$"`. -- | See [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/replace). -replace :: Regex -> String -> String -> String -replace a0 a1 a2 = replace a0 a1 a2 +foreign import replace :: Regex -> String -> String -> String -_replaceBy :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> (String -> Array (Maybe String) -> String) -> String -> String -_replaceBy a0 a1 a2 a3 a4 = _replaceBy a0 a1 a2 a3 a4 +foreign import _replaceBy + :: (forall r. r -> Maybe r) + -> (forall r. Maybe r) + -> Regex + -> (String -> Array (Maybe String) -> String) + -> String + -> String -- | Transforms occurrences of the `Regex` using a function of the matched -- | substring and a list of captured substrings of type `Maybe String`, @@ -107,8 +115,12 @@ _replaceBy a0 a1 a2 a3 a4 = _replaceBy a0 a1 a2 a3 a4 replace' :: Regex -> (String -> Array (Maybe String) -> String) -> String -> String replace' = _replaceBy Just Nothing -_search :: (forall r. r -> Maybe r) -> (forall r. Maybe r) -> Regex -> String -> Maybe Int -_search a0 a1 a2 a3 = _search a0 a1 a2 a3 +foreign import _search + :: (forall r. r -> Maybe r) + -> (forall r. Maybe r) + -> Regex + -> String + -> Maybe Int -- | Returns `Just` the index of the first match of the `Regex` in the string, -- | or `Nothing` if there is no match. @@ -116,5 +128,4 @@ search :: Regex -> String -> Maybe Int search = _search Just Nothing -- | Split the string into an array of substrings along occurrences of the `Regex`. -split :: Regex -> String -> Array String -split a0 a1 = split a0 a1 +foreign import split :: Regex -> String -> Array String diff --git a/stdlib/lib/Data/String/Unsafe.purs b/stdlib/lib/Data/String/Unsafe.purs index b1bdce28..75f5037f 100644 --- a/stdlib/lib/Data/String/Unsafe.purs +++ b/stdlib/lib/Data/String/Unsafe.purs @@ -7,11 +7,9 @@ module Data.String.Unsafe -- | Returns the character at the given index. -- | -- | **Unsafe:** throws runtime exception if the index is out of bounds. -charAt :: Int -> String -> Char -charAt a0 a1 = charAt a0 a1 +foreign import charAt :: Int -> String -> Char -- | Converts a string of length `1` to a character. -- | -- | **Unsafe:** throws runtime exception if length is not `1`. -char :: String -> Char -char a0 = char a0 +foreign import char :: String -> Char diff --git a/stdlib/lib/Data/Symbol.purs b/stdlib/lib/Data/Symbol.purs index 5cf5c884..80f289e3 100644 --- a/stdlib/lib/Data/Symbol.purs +++ b/stdlib/lib/Data/Symbol.purs @@ -11,8 +11,7 @@ class IsSymbol (sym :: Symbol) where reflectSymbol :: Proxy sym -> String -- local definition for use in `reifySymbol` -unsafeCoerce :: forall a b. a -> b -unsafeCoerce a0 = unsafeCoerce a0 +foreign import unsafeCoerce :: forall a b. a -> b reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy diff --git a/stdlib/lib/Data/Traversable.purs b/stdlib/lib/Data/Traversable.purs index a5206cea..180bf2f3 100644 --- a/stdlib/lib/Data/Traversable.purs +++ b/stdlib/lib/Data/Traversable.purs @@ -103,8 +103,14 @@ instance traversableArray :: Traversable Array where traverse = traverseArrayImpl apply map pure sequence = sequenceDefault -traverseArrayImpl :: forall m a b . (forall x y. m (x -> y) -> m x -> m y) -> (forall x y. (x -> y) -> m x -> m y) -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b) -traverseArrayImpl a0 a1 a2 a3 a4 = traverseArrayImpl a0 a1 a2 a3 a4 +foreign import traverseArrayImpl + :: forall m a b + . (forall x y. m (x -> y) -> m x -> m y) + -> (forall x y. (x -> y) -> m x -> m y) + -> (forall x. x -> m x) + -> (a -> m b) + -> Array a + -> m (Array b) instance traversableMaybe :: Traversable Maybe where traverse _ Nothing = pure Nothing diff --git a/stdlib/lib/Data/Tuple.purs b/stdlib/lib/Data/Tuple.purs index dbf0f89a..ffbacc97 100644 --- a/stdlib/lib/Data/Tuple.purs +++ b/stdlib/lib/Data/Tuple.purs @@ -1,47 +1,135 @@ --- | A strict product of two values. Native tuple syntax remains a closed --- | record, while this library type provides the constructor used by the core --- | libraries. WIT tuples continue to map to closed records as specified by --- | DEC-13. -module Data.Tuple - ( Tuple(..) - , fst - , snd - , curry - , uncurry - , swap - ) where - -import Data.Eq (class Eq) -import Data.Functor (class Functor) -import Data.Ord (class Ord) -import Data.Show (class Show, show) -import Data.Semigroup ((<>)) +-- | A data type and functions for working with ordered pairs. +module Data.Tuple where +import Prelude + +import Control.Comonad (class Comonad) +import Control.Extend (class Extend) +import Control.Lazy (class Lazy, defer) +import Data.Eq (class Eq1) +import Data.Functor.Invariant (class Invariant, imapF) +import Data.Generic.Rep (class Generic) +import Data.HeytingAlgebra (implies, ff, tt) +import Data.Ord (class Ord1) + +-- | A simple product type for wrapping a pair of component values. data Tuple a b = Tuple a b +-- | Allows `Tuple`s to be rendered as a string with `show` whenever there are +-- | `Show` instances for both component types. +instance showTuple :: (Show a, Show b) => Show (Tuple a b) where + show (Tuple a b) = "(Tuple " <> show a <> " " <> show b <> ")" + +-- | Allows `Tuple`s to be checked for equality with `==` and `/=` whenever +-- | there are `Eq` instances for both component types. derive instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b) + +derive instance eq1Tuple :: Eq a => Eq1 (Tuple a) + +-- | Allows `Tuple`s to be compared with `compare`, `>`, `>=`, `<` and `<=` +-- | whenever there are `Ord` instances for both component types. To obtain +-- | the result, the `fst`s are `compare`d, and if they are `EQ`ual, the +-- | `snd`s are `compare`d. derive instance ordTuple :: (Ord a, Ord b) => Ord (Tuple a b) + +derive instance ord1Tuple :: Ord a => Ord1 (Tuple a) + +instance boundedTuple :: (Bounded a, Bounded b) => Bounded (Tuple a b) where + top = Tuple top top + bottom = Tuple bottom bottom + +instance semigroupoidTuple :: Semigroupoid Tuple where + compose (Tuple _ c) (Tuple a _) = Tuple a c + +-- | The `Semigroup` instance enables use of the associative operator `<>` on +-- | `Tuple`s whenever there are `Semigroup` instances for the component +-- | types. The `<>` operator is applied pairwise, so: +-- | ```purescript +-- | (Tuple a1 b1) <> (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2) +-- | ``` +instance semigroupTuple :: (Semigroup a, Semigroup b) => Semigroup (Tuple a b) where + append (Tuple a1 b1) (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2) + +instance monoidTuple :: (Monoid a, Monoid b) => Monoid (Tuple a b) where + mempty = Tuple mempty mempty + +instance semiringTuple :: (Semiring a, Semiring b) => Semiring (Tuple a b) where + add (Tuple x1 y1) (Tuple x2 y2) = Tuple (add x1 x2) (add y1 y2) + one = Tuple one one + mul (Tuple x1 y1) (Tuple x2 y2) = Tuple (mul x1 x2) (mul y1 y2) + zero = Tuple zero zero + +instance ringTuple :: (Ring a, Ring b) => Ring (Tuple a b) where + sub (Tuple x1 y1) (Tuple x2 y2) = Tuple (sub x1 x2) (sub y1 y2) + +instance commutativeRingTuple :: (CommutativeRing a, CommutativeRing b) => CommutativeRing (Tuple a b) + +instance heytingAlgebraTuple :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAlgebra (Tuple a b) where + tt = Tuple tt tt + ff = Tuple ff ff + implies (Tuple x1 y1) (Tuple x2 y2) = Tuple (x1 `implies` x2) (y1 `implies` y2) + conj (Tuple x1 y1) (Tuple x2 y2) = Tuple (conj x1 x2) (conj y1 y2) + disj (Tuple x1 y1) (Tuple x2 y2) = Tuple (disj x1 x2) (disj y1 y2) + not (Tuple x y) = Tuple (not x) (not y) + +instance booleanAlgebraTuple :: (BooleanAlgebra a, BooleanAlgebra b) => BooleanAlgebra (Tuple a b) + +-- | The `Functor` instance allows functions to transform the contents of a +-- | `Tuple` with the `<$>` operator, applying the function to the second +-- | component, so: +-- | ```purescript +-- | f <$> (Tuple x y) = Tuple x (f y) +-- | ```` derive instance functorTuple :: Functor (Tuple a) -instance showTuple :: (Show a, Show b) => Show (Tuple a b) where - show (Tuple first second) = "(Tuple " <> show first <> " " <> show second <> ")" +derive instance genericTuple :: Generic (Tuple a b) _ + +instance invariantTuple :: Invariant (Tuple a) where + imap = imapF + +-- | The `Apply` instance allows functions to transform the contents of a +-- | `Tuple` with the `<*>` operator whenever there is a `Semigroup` instance +-- | for the `fst` component, so: +-- | ```purescript +-- | (Tuple a1 f) <*> (Tuple a2 x) == Tuple (a1 <> a2) (f x) +-- | ``` +instance applyTuple :: (Semigroup a) => Apply (Tuple a) where + apply (Tuple a1 f) (Tuple a2 x) = Tuple (a1 <> a2) (f x) + +instance applicativeTuple :: (Monoid a) => Applicative (Tuple a) where + pure = Tuple mempty + +instance bindTuple :: (Semigroup a) => Bind (Tuple a) where + bind (Tuple a1 b) f = case f b of + Tuple a2 c -> Tuple (a1 <> a2) c + +instance monadTuple :: (Monoid a) => Monad (Tuple a) + +instance extendTuple :: Extend (Tuple a) where + extend f t@(Tuple a _) = Tuple a (f t) + +instance comonadTuple :: Comonad (Tuple a) where + extract = snd + +instance lazyTuple :: (Lazy a, Lazy b) => Lazy (Tuple a b) where + defer f = Tuple (defer $ \_ -> fst (f unit)) (defer $ \_ -> snd (f unit)) --- | The first component. `fst (Tuple x y)` is `x`. +-- | Returns the first component of a tuple. fst :: forall a b. Tuple a b -> a -fst (Tuple first _) = first +fst (Tuple a _) = a --- | The second component. `snd (Tuple x y)` is `y`. +-- | Returns the second component of a tuple. snd :: forall a b. Tuple a b -> b -snd (Tuple _ second) = second +snd (Tuple _ b) = b --- | Turns a function of a pair into a function of two arguments. +-- | Turn a function that expects a tuple into a function of two arguments. curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c -curry f x y = f (Tuple x y) +curry f a b = f (Tuple a b) --- | Turns a function of two arguments into a function of a pair. +-- | Turn a function of two arguments into a function that expects a tuple. uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c -uncurry f (Tuple first second) = f first second +uncurry f (Tuple a b) = f a b --- | Exchanges the two components. +-- | Exchange the first and second components of a tuple. swap :: forall a b. Tuple a b -> Tuple b a -swap (Tuple first second) = Tuple second first +swap (Tuple a b) = Tuple b a diff --git a/stdlib/lib/Data/Unfoldable.purs b/stdlib/lib/Data/Unfoldable.purs index 83e5d029..fd115c1a 100644 --- a/stdlib/lib/Data/Unfoldable.purs +++ b/stdlib/lib/Data/Unfoldable.purs @@ -44,8 +44,15 @@ instance unfoldableArray :: Unfoldable Array where instance unfoldableMaybe :: Unfoldable Maybe where unfoldr f b = fst <$> f b -unfoldrArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Maybe (Tuple a b)) -> b -> Array a -unfoldrArrayImpl a0 a1 a2 a3 a4 a5 = unfoldrArrayImpl a0 a1 a2 a3 a4 a5 +foreign import unfoldrArrayImpl + :: forall a b + . (forall x. Maybe x -> Boolean) + -> (forall x. Maybe x -> x) + -> (forall x y. Tuple x y -> x) + -> (forall x y. Tuple x y -> y) + -> (b -> Maybe (Tuple a b)) + -> b + -> Array a -- | Replicate a value some natural number of times. -- | For example: diff --git a/stdlib/lib/Data/Unfoldable1.purs b/stdlib/lib/Data/Unfoldable1.purs index add27ca5..2eb285b3 100644 --- a/stdlib/lib/Data/Unfoldable1.purs +++ b/stdlib/lib/Data/Unfoldable1.purs @@ -45,8 +45,15 @@ instance unfoldable1Array :: Unfoldable1 Array where instance unfoldable1Maybe :: Unfoldable1 Maybe where unfoldr1 f b = Just (fst (f b)) -unfoldr1ArrayImpl :: forall a b . (forall x. Maybe x -> Boolean) -> (forall x. Maybe x -> x) -> (forall x y. Tuple x y -> x) -> (forall x y. Tuple x y -> y) -> (b -> Tuple a (Maybe b)) -> b -> Array a -unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 = unfoldr1ArrayImpl a0 a1 a2 a3 a4 a5 +foreign import unfoldr1ArrayImpl + :: forall a b + . (forall x. Maybe x -> Boolean) + -> (forall x. Maybe x -> x) + -> (forall x y. Tuple x y -> x) + -> (forall x y. Tuple x y -> y) + -> (b -> Tuple a (Maybe b)) + -> b + -> Array a -- | Replicate a value `n` times. At least one value will be produced, so values -- | `n` less than 1 will be treated as 1. diff --git a/stdlib/lib/Effect.purs b/stdlib/lib/Effect.purs index df3a50e9..fa53e4f6 100644 --- a/stdlib/lib/Effect.purs +++ b/stdlib/lib/Effect.purs @@ -1,29 +1,72 @@ --- | The `Effect` monad: the corpus-facing name for the abstract effect --- | interface this compiler already has. --- | --- | The operations themselves are anchored in `Prelude` rather than here, and --- | that is deliberate rather than an oversight. Two pieces of the compiler key --- | on that module by name: `check_run_effect_scope` resolves the trusted --- | `Prelude.runEffect` value, and `psrs_core::effect::operations` synthesizes --- | `pure`, `bind`, and `run` from the externals declared there. Moving the --- | foreign imports into this module would move the entry point with them. --- | --- | So this module is the public surface the corpus imports, and `Prelude` --- | remains the owner of the primitive interface. The dependency runs one way: --- | `Effect` imports `Prelude`, never the reverse. +-- | This module provides the `Effect` type, which is used to represent +-- | _native_ effects. The `Effect` type provides a typed API for effectful +-- | computations, while at the same time generating efficient JavaScript. module Effect ( Effect - , pure - , bind - , discard - , map - , apply - , untilE + , untilE, whileE, forE, foreachE ) where -import Prelude (Effect, apply, bind, discard, map, pure) +import Prelude + +import Control.Apply (lift2) + +-- | A native effect. The type parameter denotes the return type of running the +-- | effect, that is, an `Effect Int` is a possibly-effectful computation which +-- | eventually produces a value of the type `Int` when it finishes. +-- The Wasm state-token type and core instances are owned by Prelude. + +-- Target adapters retain the private upstream operation contracts. +pureE :: forall a. a -> Effect a +pureE = pure + +bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b +bindE = bind + +-- | The `Semigroup` instance for effects allows you to run two effects, one +-- | after the other, and then combine their results using the result type's +-- | `Semigroup` instance. +instance semigroupEffect :: Semigroup a => Semigroup (Effect a) where + append = lift2 append + +-- | If you have a `Monoid a` instance, then `mempty :: Effect a` is defined as +-- | `pure mempty`. +instance monoidEffect :: Monoid a => Monoid (Effect a) where + mempty = pureE mempty --- | Repeats an effect until it returns `true`. +-- | Loop until a condition becomes `true`. +-- | +-- | `untilE b` is an effectful computation which repeatedly runs the effectful +-- | computation `b`, until its return value is `true`. untilE :: Effect Boolean -> Effect Unit untilE action = bind action \done -> if done then pure unit else untilE action + +-- | Loop while a condition is `true`. +-- | +-- | `whileE b m` is effectful computation which runs the effectful computation +-- | `b`. If its result is `true`, it runs the effectful computation `m` and +-- | loops. If not, the computation ends. +whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit +whileE condition action = bind condition \continue -> + if continue then bind action (\_ -> whileE condition action) else pure unit + +-- | Loop over a consecutive collection of numbers. +-- | +-- | `forE lo hi f` runs the computation returned by the function `f` for each +-- | of the inputs between `lo` (inclusive) and `hi` (exclusive). +forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit +forE lower upper action = + if lower < upper then bind (action lower) (\_ -> forE (lower + 1) upper action) + else pure unit + +-- | Loop over an array of values. +-- | +-- | `foreachE xs f` runs the computation returned by the function `f` for each +-- | of the inputs `xs`. +foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit +foreachE values action = go 0 + where + go index = + if intLt index (arrayLength values) + then bind (action (arrayIndex values index)) (\_ -> go (intAdd index 1)) + else pure unit diff --git a/stdlib/lib/Effect/Class.purs b/stdlib/lib/Effect/Class.purs new file mode 100644 index 00000000..6bdbd6bd --- /dev/null +++ b/stdlib/lib/Effect/Class.purs @@ -0,0 +1,19 @@ +module Effect.Class where + +import Control.Category (identity) +import Control.Monad (class Monad) +import Effect (Effect) + +-- | The `MonadEffect` class captures those monads which support native effects. +-- | +-- | Instances are provided for `Effect` itself, and the standard monad +-- | transformers. +-- | +-- | `liftEffect` can be used in any appropriate monad transformer stack to lift an +-- | action of type `Effect a` into the monad. +-- | +class Monad m <= MonadEffect m where + liftEffect :: forall a. Effect a -> m a + +instance monadEffectEffect :: MonadEffect Effect where + liftEffect = identity diff --git a/stdlib/lib/Effect/Class/Console.purs b/stdlib/lib/Effect/Class/Console.purs new file mode 100644 index 00000000..8f22f8e5 --- /dev/null +++ b/stdlib/lib/Effect/Class/Console.purs @@ -0,0 +1,49 @@ +module Effect.Class.Console where + +import Data.Function ((<<<)) +import Data.Show (class Show) +import Data.Unit (Unit) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console as EffConsole + +log :: forall m. MonadEffect m => String -> m Unit +log = liftEffect <<< EffConsole.log + +logShow :: forall m a. MonadEffect m => Show a => a -> m Unit +logShow = liftEffect <<< EffConsole.logShow + +warn :: forall m. MonadEffect m => String -> m Unit +warn = liftEffect <<< EffConsole.warn + +warnShow :: forall m a. MonadEffect m => Show a => a -> m Unit +warnShow = liftEffect <<< EffConsole.warnShow + +error :: forall m. MonadEffect m => String -> m Unit +error = liftEffect <<< EffConsole.error + +errorShow :: forall m a. MonadEffect m => Show a => a -> m Unit +errorShow = liftEffect <<< EffConsole.errorShow + +info :: forall m. MonadEffect m => String -> m Unit +info = liftEffect <<< EffConsole.info + +infoShow :: forall m a. MonadEffect m => Show a => a -> m Unit +infoShow = liftEffect <<< EffConsole.infoShow + +debug :: forall m. MonadEffect m => String -> m Unit +debug = liftEffect <<< EffConsole.debug + +debugShow :: forall m a. MonadEffect m => Show a => a -> m Unit +debugShow = liftEffect <<< EffConsole.debugShow + +time :: forall m. MonadEffect m => String -> m Unit +time = liftEffect <<< EffConsole.time + +timeLog :: forall m. MonadEffect m => String -> m Unit +timeLog = liftEffect <<< EffConsole.timeLog + +timeEnd :: forall m. MonadEffect m => String -> m Unit +timeEnd = liftEffect <<< EffConsole.timeEnd + +clear :: forall m. MonadEffect m => m Unit +clear = liftEffect EffConsole.clear diff --git a/stdlib/lib/Effect/Console.purs b/stdlib/lib/Effect/Console.purs index e336027e..a5ab3949 100644 --- a/stdlib/lib/Effect/Console.purs +++ b/stdlib/lib/Effect/Console.purs @@ -1,23 +1,69 @@ --- | The corpus's console surface, a thin binding over the platform layer --- | `WASI.Console` --- | ([DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md)). --- | --- | Nothing here chooses a stream or performs a write: `log` and `error` are the --- | platform functions under their corpus names, and `warn` is the platform's. --- | That keeps one place that decides where output goes, rather than a --- | wrapper that could drift from it. --- | --- | `logShow` adds no I/O of its own: it is `log` of `Data.Show.show`, so the --- | rendering is the library's `Show` and the destination is still the one --- | `WASI.Console.log` decides. It is a wrapper like `log`, not a second --- | stringifier. -module Effect.Console (log, warn, error, logShow) where - -import Prelude -import WASI.Console (error, log, warn) +module Effect.Console where + +import Effect (Effect) +import WASI.Console as Console + import Data.Show (class Show, show) +import Data.Unit (Unit) --- | Writes the `Show` rendering of a value. `log` already writes the newline, --- | so this is `log` composed with the library's `show`. +-- | Write a message to the console. +-- WASI routes log to its log stream operation. +log :: String -> Effect Unit +log = Console.log + +-- | Write a value to the console, using its `Show` instance to produce a +-- | `String`. logShow :: forall a. Show a => a -> Effect Unit -logShow value = log (show value) +logShow a = log (show a) + +-- | Write an warning to the console. +-- WASI routes warn to its warn stream operation. +warn :: String -> Effect Unit +warn = Console.warn + +-- | Write an warning value to the console, using its `Show` instance to produce +-- | a `String`. +warnShow :: forall a. Show a => a -> Effect Unit +warnShow a = warn (show a) + +-- | Write an error to the console. +-- WASI routes error to its error stream operation. +error :: String -> Effect Unit +error = Console.error + +-- | Write an error value to the console, using its `Show` instance to produce a +-- | `String`. +errorShow :: forall a. Show a => a -> Effect Unit +errorShow a = error (show a) + +-- | Write an info message to the console. +-- WASI routes info to its log stream operation. +info :: String -> Effect Unit +info = Console.log + +-- | Write an info value to the console, using its `Show` instance to produce a +-- | `String`. +infoShow :: forall a. Show a => a -> Effect Unit +infoShow a = info (show a) + +-- | Write an debug message to the console. +-- WASI routes debug to its log stream operation. +debug :: String -> Effect Unit +debug = Console.log + +-- | Write an debug value to the console, using its `Show` instance to produce a +-- | `String`. +debugShow :: forall a. Show a => a -> Effect Unit +debugShow a = debug (show a) + +-- | Start a named timer. +foreign import time :: String -> Effect Unit + +-- | Print the time since a named timer started in milliseconds. +foreign import timeLog :: String -> Effect Unit + +-- | Stop a named timer and print time since it started in milliseconds. +foreign import timeEnd :: String -> Effect Unit + +-- | Clears the console +foreign import clear :: Effect Unit diff --git a/stdlib/lib/Effect/Ref.purs b/stdlib/lib/Effect/Ref.purs index 52e46bc1..115238ee 100644 --- a/stdlib/lib/Effect/Ref.purs +++ b/stdlib/lib/Effect/Ref.purs @@ -41,28 +41,24 @@ foreign import data Ref :: Type -> Type type role Ref representational -- | Create a new mutable reference containing the specified value. -_new :: forall s. s -> Effect (Ref s) -_new a0 = _new a0 +foreign import _new :: forall s. s -> Effect (Ref s) new :: forall s. s -> Effect (Ref s) new = _new -- | Create a new mutable reference containing a value that can refer to the -- | `Ref` being created. -newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s) -newWithSelf a0 = newWithSelf a0 +foreign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s) -- | Read the current value of a mutable reference. -read :: forall s. Ref s -> Effect s -read a0 = read a0 +foreign import read :: forall s. Ref s -> Effect s -- | Update the value of a mutable reference by applying a function -- | to the current value. modify' :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b modify' = modifyImpl -modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b -modifyImpl a0 a1 = modifyImpl a0 a1 +foreign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b -- | Update the value of a mutable reference by applying a function -- | to the current value. The updated value is returned. @@ -74,5 +70,4 @@ modify_ :: forall s. (s -> s) -> Ref s -> Effect Unit modify_ f s = void $ modify f s -- | Update the value of a mutable reference to the specified value. -write :: forall s. s -> Ref s -> Effect Unit -write a0 a1 = write a0 a1 +foreign import write :: forall s. s -> Ref s -> Effect Unit diff --git a/stdlib/lib/Effect/Uncurried.purs b/stdlib/lib/Effect/Uncurried.purs new file mode 100644 index 00000000..7ed42e85 --- /dev/null +++ b/stdlib/lib/Effect/Uncurried.purs @@ -0,0 +1,286 @@ +-- | This module defines types for effectful uncurried functions, as well as +-- | functions for converting back and forth between them. +-- | +-- | This makes it possible to give a PureScript type to JavaScript functions +-- | such as this one: +-- | +-- | ```javascript +-- | function logMessage(level, message) { +-- | console.log(level + ": " + message); +-- | } +-- | ``` +-- | +-- | In particular, note that `logMessage` performs effects immediately after +-- | receiving all of its parameters, so giving it the type `Data.Function.Fn2 +-- | String String Unit`, while convenient, would effectively be a lie. +-- | +-- | One way to handle this would be to convert the function into the normal +-- | PureScript form (namely, a curried function returning an Effect action), +-- | and performing the marshalling in JavaScript, in the FFI module, like this: +-- | +-- | ```purescript +-- | -- In the PureScript file: +-- | foreign import logMessage :: String -> String -> Effect Unit +-- | ``` +-- | +-- | ```javascript +-- | // In the FFI file: +-- | exports.logMessage = function(level) { +-- | return function(message) { +-- | return function() { +-- | logMessage(level, message); +-- | }; +-- | }; +-- | }; +-- | ``` +-- | +-- | This method, unfortunately, turns out to be both tiresome and error-prone. +-- | This module offers an alternative solution. By providing you with: +-- | +-- | * the ability to give the real `logMessage` function a PureScript type, +-- | and +-- | * functions for converting between this form and the normal PureScript +-- | form, +-- | +-- | the FFI boilerplate is no longer needed. The previous example becomes: +-- | +-- | ```purescript +-- | -- In the PureScript file: +-- | foreign import logMessageImpl :: EffectFn2 String String Unit +-- | ``` +-- | +-- | ```javascript +-- | // In the FFI file: +-- | exports.logMessageImpl = logMessage +-- | ``` +-- | +-- | You can then use `runEffectFn2` to provide a nicer version: +-- | +-- | ```purescript +-- | logMessage :: String -> String -> Effect Unit +-- | logMessage = runEffectFn2 logMessageImpl +-- | ``` +-- | +-- | (note that this has the same type as the original `logMessage`). +-- | +-- | Effectively, we have reduced the risk of errors by moving as much code into +-- | PureScript as possible, so that we can leverage the type system. Hopefully, +-- | this is a little less tiresome too. +-- | +-- | Here's a slightly more advanced example. Here, because we are using +-- | callbacks, we need to use `mkEffectFn{N}` as well. +-- | +-- | Suppose our `logMessage` changes so that it sometimes sends details of the +-- | message to some external server, and in those cases, we want the resulting +-- | `HttpResponse` (for whatever reason). +-- | +-- | ```javascript +-- | function logMessage(level, message, callback) { +-- | console.log(level + ": " + message); +-- | if (level > LogLevel.WARN) { +-- | LogAggregatorService.post("/logs", { +-- | level: level, +-- | message: message +-- | }, callback); +-- | } else { +-- | callback(null); +-- | } +-- | } +-- | ``` +-- | +-- | The import then looks like this: +-- | ```purescript +-- | foreign import logMessageImpl +-- | EffectFn3 +-- | String +-- | String +-- | (EffectFn1 (Nullable HttpResponse) Unit) +-- | Unit +-- | ``` +-- | +-- | And, as before, the FFI file is extremely simple: +-- | +-- | ```javascript +-- | exports.logMessageImpl = logMessage +-- | ``` +-- | +-- | Finally, we use `runEffectFn{N}` and `mkEffectFn{N}` for a more comfortable +-- | PureScript version: +-- | +-- | ```purescript +-- | logMessage :: +-- | String -> +-- | String -> +-- | (Nullable HttpResponse -> Effect Unit) -> +-- | Effect Unit +-- | logMessage level message callback = +-- | runEffectFn3 logMessageImpl level message (mkEffectFn1 callback) +-- | ``` +-- | +-- | The general naming scheme for functions and types in this module is as +-- | follows: +-- | +-- | * `EffectFn{N}` means, an uncurried function which accepts N arguments and +-- | performs some effects. The first N arguments are the actual function's +-- | argument. The last type argument is the return type. +-- | * `runEffectFn{N}` takes an `EffectFn` of N arguments, and converts it into +-- | the normal PureScript form: a curried function which returns an Effect +-- | action. +-- | * `mkEffectFn{N}` is the inverse of `runEffectFn{N}`. It can be useful for +-- | callbacks. +-- | + +module Effect.Uncurried where + +import Data.Monoid (class Monoid, class Semigroup, mempty, (<>)) +import Effect (Effect) + +foreign import data EffectFn1 :: Type -> Type -> Type + +type role EffectFn1 representational representational + +foreign import data EffectFn2 :: Type -> Type -> Type -> Type + +type role EffectFn2 representational representational representational + +foreign import data EffectFn3 :: Type -> Type -> Type -> Type -> Type + +type role EffectFn3 representational representational representational representational + +foreign import data EffectFn4 :: Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn4 representational representational representational representational representational + +foreign import data EffectFn5 :: Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn5 representational representational representational representational representational representational + +foreign import data EffectFn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn6 representational representational representational representational representational representational representational + +foreign import data EffectFn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn7 representational representational representational representational representational representational representational representational + +foreign import data EffectFn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn8 representational representational representational representational representational representational representational representational representational + +foreign import data EffectFn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn9 representational representational representational representational representational representational representational representational representational representational + +foreign import data EffectFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type + +type role EffectFn10 representational representational representational representational representational representational representational representational representational representational representational + +foreign import mkEffectFn1 :: forall a r. + (a -> Effect r) -> EffectFn1 a r +foreign import mkEffectFn2 :: forall a b r. + (a -> b -> Effect r) -> EffectFn2 a b r +foreign import mkEffectFn3 :: forall a b c r. + (a -> b -> c -> Effect r) -> EffectFn3 a b c r +foreign import mkEffectFn4 :: forall a b c d r. + (a -> b -> c -> d -> Effect r) -> EffectFn4 a b c d r +foreign import mkEffectFn5 :: forall a b c d e r. + (a -> b -> c -> d -> e -> Effect r) -> EffectFn5 a b c d e r +foreign import mkEffectFn6 :: forall a b c d e f r. + (a -> b -> c -> d -> e -> f -> Effect r) -> EffectFn6 a b c d e f r +foreign import mkEffectFn7 :: forall a b c d e f g r. + (a -> b -> c -> d -> e -> f -> g -> Effect r) -> EffectFn7 a b c d e f g r +foreign import mkEffectFn8 :: forall a b c d e f g h r. + (a -> b -> c -> d -> e -> f -> g -> h -> Effect r) -> EffectFn8 a b c d e f g h r +foreign import mkEffectFn9 :: forall a b c d e f g h i r. + (a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r) -> EffectFn9 a b c d e f g h i r +foreign import mkEffectFn10 :: forall a b c d e f g h i j r. + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r) -> EffectFn10 a b c d e f g h i j r + +foreign import runEffectFn1 :: forall a r. + EffectFn1 a r -> a -> Effect r +foreign import runEffectFn2 :: forall a b r. + EffectFn2 a b r -> a -> b -> Effect r +foreign import runEffectFn3 :: forall a b c r. + EffectFn3 a b c r -> a -> b -> c -> Effect r +foreign import runEffectFn4 :: forall a b c d r. + EffectFn4 a b c d r -> a -> b -> c -> d -> Effect r +foreign import runEffectFn5 :: forall a b c d e r. + EffectFn5 a b c d e r -> a -> b -> c -> d -> e -> Effect r +foreign import runEffectFn6 :: forall a b c d e f r. + EffectFn6 a b c d e f r -> a -> b -> c -> d -> e -> f -> Effect r +foreign import runEffectFn7 :: forall a b c d e f g r. + EffectFn7 a b c d e f g r -> a -> b -> c -> d -> e -> f -> g -> Effect r +foreign import runEffectFn8 :: forall a b c d e f g h r. + EffectFn8 a b c d e f g h r -> a -> b -> c -> d -> e -> f -> g -> h -> Effect r +foreign import runEffectFn9 :: forall a b c d e f g h i r. + EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r +foreign import runEffectFn10 :: forall a b c d e f g h i j r. + EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r + +-- The reason these are written eta-expanded instead of as: +-- ``` +-- append f1 f2 = mkEffectFnN $ runEffectFnN f1 <> runEffectFnN f2 +-- ``` +-- is to help the compiler recognize that it can emit uncurried +-- JS functions (which are more efficient), when an appended +-- EffectFn is applied to all its arguments + +instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where + append f1 f2 = mkEffectFn1 \a -> runEffectFn1 f1 a <> runEffectFn1 f2 a + +instance semigroupEffectFn2 :: Semigroup r => Semigroup (EffectFn2 a b r) where + append f1 f2 = mkEffectFn2 \a b -> runEffectFn2 f1 a b <> runEffectFn2 f2 a b + +instance semigroupEffectFn3 :: Semigroup r => Semigroup (EffectFn3 a b c r) where + append f1 f2 = mkEffectFn3 \a b c -> runEffectFn3 f1 a b c <> runEffectFn3 f2 a b c + +instance semigroupEffectFn4 :: Semigroup r => Semigroup (EffectFn4 a b c d r) where + append f1 f2 = mkEffectFn4 \a b c d -> runEffectFn4 f1 a b c d <> runEffectFn4 f2 a b c d + +instance semigroupEffectFn5 :: Semigroup r => Semigroup (EffectFn5 a b c d e r) where + append f1 f2 = mkEffectFn5 \a b c d e -> runEffectFn5 f1 a b c d e <> runEffectFn5 f2 a b c d e + +instance semigroupEffectFn6 :: Semigroup r => Semigroup (EffectFn6 a b c d e f r) where + append f1 f2 = mkEffectFn6 \a b c d e f -> runEffectFn6 f1 a b c d e f <> runEffectFn6 f2 a b c d e f + +instance semigroupEffectFn7 :: Semigroup r => Semigroup (EffectFn7 a b c d e f g r) where + append f1 f2 = mkEffectFn7 \a b c d e f g -> runEffectFn7 f1 a b c d e f g <> runEffectFn7 f2 a b c d e f g + +instance semigroupEffectFn8 :: Semigroup r => Semigroup (EffectFn8 a b c d e f g h r) where + append f1 f2 = mkEffectFn8 \a b c d e f g h -> runEffectFn8 f1 a b c d e f g h <> runEffectFn8 f2 a b c d e f g h + +instance semigroupEffectFn9 :: Semigroup r => Semigroup (EffectFn9 a b c d e f g h i r) where + append f1 f2 = mkEffectFn9 \a b c d e f g h i -> runEffectFn9 f1 a b c d e f g h i <> runEffectFn9 f2 a b c d e f g h i + +instance semigroupEffectFn10 :: Semigroup r => Semigroup (EffectFn10 a b c d e f g h i j r) where + append f1 f2 = mkEffectFn10 \a b c d e f g h i j -> runEffectFn10 f1 a b c d e f g h i j <> runEffectFn10 f2 a b c d e f g h i j + +instance monoidEffectFn1 :: Monoid r => Monoid (EffectFn1 a r) where + mempty = mkEffectFn1 \_ -> mempty + +instance monoidEffectFn2 :: Monoid r => Monoid (EffectFn2 a b r) where + mempty = mkEffectFn2 \_ _ -> mempty + +instance monoidEffectFn3 :: Monoid r => Monoid (EffectFn3 a b c r) where + mempty = mkEffectFn3 \_ _ _ -> mempty + +instance monoidEffectFn4 :: Monoid r => Monoid (EffectFn4 a b c d r) where + mempty = mkEffectFn4 \_ _ _ _ -> mempty + +instance monoidEffectFn5 :: Monoid r => Monoid (EffectFn5 a b c d e r) where + mempty = mkEffectFn5 \_ _ _ _ _ -> mempty + +instance monoidEffectFn6 :: Monoid r => Monoid (EffectFn6 a b c d e f r) where + mempty = mkEffectFn6 \_ _ _ _ _ _ -> mempty + +instance monoidEffectFn7 :: Monoid r => Monoid (EffectFn7 a b c d e f g r) where + mempty = mkEffectFn7 \_ _ _ _ _ _ _ -> mempty + +instance monoidEffectFn8 :: Monoid r => Monoid (EffectFn8 a b c d e f g h r) where + mempty = mkEffectFn8 \_ _ _ _ _ _ _ _ -> mempty + +instance monoidEffectFn9 :: Monoid r => Monoid (EffectFn9 a b c d e f g h i r) where + mempty = mkEffectFn9 \_ _ _ _ _ _ _ _ _ -> mempty + +instance monoidEffectFn10 :: Monoid r => Monoid (EffectFn10 a b c d e f g h i j r) where + mempty = mkEffectFn10 \_ _ _ _ _ _ _ _ _ _ -> mempty diff --git a/stdlib/lib/Effect/Unsafe.purs b/stdlib/lib/Effect/Unsafe.purs new file mode 100644 index 00000000..79614d81 --- /dev/null +++ b/stdlib/lib/Effect/Unsafe.purs @@ -0,0 +1,8 @@ +module Effect.Unsafe where + +import Effect (Effect) + +-- | Run an effectful computation. +-- | +-- | *Note*: use of this function can result in arbitrary side-effects. +foreign import unsafePerformEffect :: forall a. Effect a -> a diff --git a/stdlib/lib/Partial.purs b/stdlib/lib/Partial.purs index cfb5cc09..22e2b076 100644 --- a/stdlib/lib/Partial.purs +++ b/stdlib/lib/Partial.purs @@ -12,5 +12,4 @@ crash = crashWith "Partial.crash: partial function" crashWith :: forall a. Partial => String -> a crashWith = _crashWith -_crashWith :: forall a. String -> a -_crashWith a0 = _crashWith a0 +foreign import _crashWith :: forall a. String -> a diff --git a/stdlib/lib/Partial/Unsafe.purs b/stdlib/lib/Partial/Unsafe.purs index 0071c039..2221d09b 100644 --- a/stdlib/lib/Partial/Unsafe.purs +++ b/stdlib/lib/Partial/Unsafe.purs @@ -13,8 +13,7 @@ import Partial (crashWith) -- either a dependency or reimplementing it here. -- Rather than doing that, we'll use a type signature -- of `a -> b` instead. -_unsafePartial :: forall a b. a -> b -_unsafePartial a0 = _unsafePartial a0 +foreign import _unsafePartial :: forall a b. a -> b -- | Discharge a partiality constraint, unsafely. unsafePartial :: forall a. (Partial => a) -> a diff --git a/stdlib/lib/Prelude.purs b/stdlib/lib/Prelude.purs index 4da4db96..1aefdb1d 100644 --- a/stdlib/lib/Prelude.purs +++ b/stdlib/lib/Prelude.purs @@ -73,6 +73,7 @@ import Data.Unit (Unit, unit) import Data.Void (Void, absurd) foreign import data Effect :: Type -> Type +type role Effect representational -- | Builds an `Effect` that returns `value`. Lowering replaces this binding; -- | the `Applicative` instance is what user code calls `pure`. @@ -89,16 +90,15 @@ foreign import "psrs:effect#run" runEffect :: forall a. Effect a -> a foreign import "psrs:effect#trap" trap :: Effect Unit instance functorEffect :: Functor Effect where - map f action = bind action (\value -> pure (f value)) + map = liftA1 instance applyEffect :: Apply Effect where - apply wrapped action = - bind wrapped (\function -> bind action (\value -> pure (function value))) + apply = ap instance applicativeEffect :: Applicative Effect where - pure value = effectPure value + pure = effectPure instance bindEffect :: Bind Effect where - bind action next = effectBind action next + bind = effectBind instance monadEffect :: Monad Effect diff --git a/stdlib/lib/Record/Unsafe.purs b/stdlib/lib/Record/Unsafe.purs index 7496e0f7..adeaade7 100644 --- a/stdlib/lib/Record/Unsafe.purs +++ b/stdlib/lib/Record/Unsafe.purs @@ -7,25 +7,21 @@ module Record.Unsafe where -- | Checks if a record has a key, using a string for the key. -unsafeHas :: forall r1. String -> Record r1 -> Boolean -unsafeHas a0 a1 = unsafeHas a0 a1 +foreign import unsafeHas :: forall r1. String -> Record r1 -> Boolean -- | Unsafely gets a value from a record, using a string for the key. -- | -- | If the key does not exist this will cause a runtime error elsewhere. -unsafeGet :: forall r a. String -> Record r -> a -unsafeGet a0 a1 = unsafeGet a0 a1 +foreign import unsafeGet :: forall r a. String -> Record r -> a -- | Unsafely sets a value on a record, using a string for the key. -- | -- | The output record's row is unspecified so can be coerced to any row. If the -- | output type is incorrect it will cause a runtime error elsewhere. -unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2 -unsafeSet a0 a1 a2 = unsafeSet a0 a1 a2 +foreign import unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2 -- | Unsafely removes a value on a record, using a string for the key. -- | -- | The output record's row is unspecified so can be coerced to any row. If the -- | output type is incorrect it will cause a runtime error elsewhere. -unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2 -unsafeDelete a0 a1 = unsafeDelete a0 a1 +foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2 diff --git a/stdlib/lib/Test/Assert.purs b/stdlib/lib/Test/Assert.purs index 477c987f..92d9858c 100644 --- a/stdlib/lib/Test/Assert.purs +++ b/stdlib/lib/Test/Assert.purs @@ -1,70 +1,137 @@ --- | The corpus's assertion surface: the `Test.Assert` module the `passing` --- | suite imports. --- | --- | A failed assertion must be visible to whatever runs the program, and this --- | target's only such signal is a guest trap — a non-zero exit code is a --- | recorded result, not a failure. So the failure path writes the message to --- | standard error and then escapes through `Prelude.trap` --- | ([DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md): the --- | wrapper owns the corpus name, the primitive stays in `Prelude`). --- | --- | **Deliberately absent**, with the reason recorded rather than approximated: --- | --- | - `assertEqual` and `assertEqual'` compare with `Eq` and print with `Show`. --- | Both classes are declared (`Data.Eq`, `Data.Show`), so the surface itself --- | is writable — the official signature is what this compiler cannot yet --- | elaborate. The corpus calls the record form --- | (`assertEqual' "label" { expected: e, actual: a }`), whose official type is --- | `forall a. Eq a => Show a => String -> { actual :: a, expected :: a } -> --- | Effect Unit`. A constraint whose quantified variable appears inside a --- | record type is elaborated with the *record* as the constraint's argument, --- | so `Eq a` is wanted for `{ actual :: a, expected :: a }` and the --- | declaration is rejected with `NoInstanceFound`. The same signature with a --- | type synonym for the record fails identically, so it is constraint --- | elaboration rather than the record syntax. Approximating the signature --- | would change the official API the corpus calls, so the functions stay out --- | until that is fixed. #137 carries the minimal reproduction and the probes --- | that separate this defect from record syntax. --- | - `assertThrows` and `assertThrows'` need to observe that evaluating an --- | argument failed. A trap is not observable from inside the guest without --- | the Wasm exceptions proposal, which is outside the target profile --- | ([DEC-05](../../../decision/DEC-05-wasmtime-feature-set.md)), so there is --- | no honest implementation to write yet. -module Test.Assert (assert, assert', assertTrue, assertFalse) where +module Test.Assert + ( assert + , assert' + , assertEqual + , assertEqual' + , assertFalse + , assertFalse' + , assertThrows + , assertThrows' + , assertTrue + , assertTrue' + ) where import Prelude + import Effect (Effect) import Effect.Console (error) --- | Escapes when the boolean is false. The message is written to standard --- | error first, so the trap carries the diagnostic with it. -assert' :: String -> Boolean -> Effect Unit -assert' message condition = - if condition - then pure unit - else abortWith message - --- | Escapes with the default message when the boolean is false. +-- | Throws a runtime exception with message "Assertion failed" when the boolean +-- | value is false. assert :: Boolean -> Effect Unit assert = assert' "Assertion failed" --- | Escapes unless the value is `true`, naming both values. -assertTrue :: Boolean -> Effect Unit -assertTrue actual = - if actual - then pure unit - else abortWith "Assertion failed: Expected: true\nActual: false" +-- | Throws a runtime exception with the specified message when the boolean +-- | value is false. +assert' :: String -> Boolean -> Effect Unit +assert' = assertImpl + +-- Wasm/WASI implementation: failure writes its message before trapping. +assertImpl :: String -> Boolean -> Effect Unit +assertImpl message condition = + if condition then pure unit + else do + _ <- error message + trap + +-- | Throws a runtime exception with message "Assertion failed: An error should +-- | have been thrown", unless the argument throws an exception when evaluated. +-- | +-- | This function is specifically for testing unsafe pure code; for example, +-- | to make sure that an exception is thrown if a precondition is not +-- | satisfied. Functions which use `Effect a` can be +-- | tested with `catchException` instead. +assertThrows :: forall a. (Unit -> a) -> Effect Unit +assertThrows = + assertThrows' "Assertion failed: An error should have been thrown" + +-- | Throws a runtime exception with the specified message, unless the argument +-- | throws an exception when evaluated. +-- | +-- | This function is specifically for testing unsafe pure code; for example, +-- | to make sure that an exception is thrown if a precondition is not +-- | satisfied. Functions which use `Effect a` can be +-- | tested with `catchException` instead. +assertThrows' + :: forall a + . String + -> (Unit -> a) + -> Effect Unit +assertThrows' msg fn = assert' msg =<< checkThrows fn --- | Escapes unless the value is `false`, naming both values. -assertFalse :: Boolean -> Effect Unit -assertFalse actual = - if actual - then abortWith "Assertion failed: Expected: false\nActual: true" - else pure unit +foreign import checkThrows + :: forall a + . (Unit -> a) + -> Effect Boolean --- | The escape itself. Kept private: a caller reports a failure by choosing the --- | message, not by reaching for the trap. -abortWith :: String -> Effect Unit -abortWith message = do - _ <- error message - trap +-- | Compares the `expected` and `actual` values for equality and +-- | throws a runtime exception when the values are not equal. +-- | +-- | The message indicates the expected value and the actual value. +assertEqual + :: forall a + . Eq a + => Show a + => { actual :: a, expected :: a } + -> Effect Unit +assertEqual = assertEqual' "" + +-- | Compares the `expected` and `actual` values for equality and throws a +-- | runtime exception with the specified message when the values are not equal. +-- | +-- | The message also indicates the expected value and the actual value. +assertEqual' + :: forall a + . Eq a + => Show a + => String + -> { actual :: a, expected :: a } + -> Effect Unit +assertEqual' userMessage {actual, expected} = do + unless result $ error message + assert' message result + where + message = (if userMessage == "" then "" else userMessage <> "\n") + <> "Expected: " <> show expected + <> "\nActual: " <> show actual + result = actual == expected + +-- | Throws a runtime exception when the value is `false`. +-- | +-- | The message indicates the expected value (`true`) +-- | and the actual value (`false`). +assertTrue + :: Boolean + -> Effect Unit +assertTrue actual = assertEqual { actual, expected: true } + +-- | Throws a runtime exception with the specified message when the value is +-- | `false`. +-- | +-- | The message also indicates the expected value (`true`) +-- | and the actual value (`false`). +assertTrue' + :: String + -> Boolean + -> Effect Unit +assertTrue' message actual = assertEqual' message { actual, expected: true } + +-- | Throws a runtime exception when the value is `true`. +-- | +-- | The message indicates the expected value (`false`) +-- | and the actual value (`true`). +assertFalse + :: Boolean + -> Effect Unit +assertFalse actual = assertEqual { actual, expected: false } + +-- | Throws a runtime exception with the specified message when the value is +-- | `true`. +-- | +-- | The message also indicates the expected value (`false`) +-- | and the actual value (`true`). +assertFalse' + :: String + -> Boolean + -> Effect Unit +assertFalse' message actual = assertEqual' message { actual, expected: false } diff --git a/stdlib/lib/Unsafe/Coerce.purs b/stdlib/lib/Unsafe/Coerce.purs index 40013c40..6acc04db 100644 --- a/stdlib/lib/Unsafe/Coerce.purs +++ b/stdlib/lib/Unsafe/Coerce.purs @@ -24,5 +24,4 @@ module Unsafe.Coerce -- | `unsafeCoerce` can now be accomplished via `coerce` from -- | `purescript-safe-coerce`. See that library's documentation for more -- | context. -unsafeCoerce :: forall a b. a -> b -unsafeCoerce a0 = unsafeCoerce a0 +foreign import unsafeCoerce :: forall a b. a -> b diff --git a/stdlib/lib/trusted b/stdlib/lib/trusted index 666e5dad..23289f93 100644 --- a/stdlib/lib/trusted +++ b/stdlib/lib/trusted @@ -1,9 +1,6 @@ # Trusted standard-library modules, in load order. -# Dots are directory separators under this directory. -# Vendored from the PureScript core libraries used by the v0.15.16 -# compiler tests (prelude v6.0.1 and the matching package majors). -# `Prelude` keeps the psrs:effect bindings. `Data.Show` and `Data.Tuple` -# stay the implementations this compiler already lowers. +# Official sources retain their public contracts; target adaptations follow +# docs/workflow/stdlib-vendoring.md. Unsupported foreign values are not stubbed. Prelude Control.Alt Control.Alternative @@ -188,8 +185,12 @@ Data.Unit Data.Void Data.Witherable Effect +Effect.Class +Effect.Class.Console Effect.Console Effect.Ref +Effect.Uncurried +Effect.Unsafe Partial Partial.Unsafe Record.Unsafe From dbfd2b7cc436b04b5501136ccc56cf209c964dd5 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 16:13:04 +0800 Subject: [PATCH 037/148] Implement checked scalar stdlib bindings with official behavior evidence --- crates/psrs-backend/src/bindings/mod.rs | 3 + .../psrs-backend/src/bindings/primitives.rs | 160 ++++++ .../src/bindings/primitives/tests.rs | 84 +++ crates/psrs-backend/src/cc/mod.rs | 3 +- crates/psrs-core/src/lib.rs | 7 +- crates/psrs-driver/src/tests/mod.rs | 1 + .../src/tests/primitive_foreign.rs | 118 ++++ .../tests/fixtures/stdlib-scalar/Golden.purs | 21 + .../tests/fixtures/stdlib-scalar/Main.purs | 3 + .../fixtures/stdlib-scalar/observations.json | 530 ++++++++++++++++++ crates/psrs-hir/src/intrinsic/mod.rs | 7 + crates/psrs-hir/src/lib.rs | 3 + .../src/resolver/module_resolution.rs | 18 +- crates/psrs-thir/src/lib.rs | 7 +- .../psrs-typecheck/src/typecheck/infer/mod.rs | 6 +- .../frontend/semantics/foreign-imports.md | 13 + .../bindings.json | 145 +++++ .../primitive-bindings-2026-10-06/report.md | 110 ++++ docs/workflow/tools/stdlib-scalar-oracle.mjs | 101 ++++ stdlib/lib/Data/Eq.purs | 8 +- stdlib/lib/Data/HeytingAlgebra.purs | 6 +- stdlib/lib/Data/Int.purs | 2 +- stdlib/lib/Data/Int/Bits.purs | 14 +- stdlib/lib/Data/Ring.purs | 4 +- stdlib/lib/Data/Semiring.purs | 6 +- 25 files changed, 1349 insertions(+), 31 deletions(-) create mode 100644 crates/psrs-backend/src/bindings/primitives.rs create mode 100644 crates/psrs-backend/src/bindings/primitives/tests.rs create mode 100644 crates/psrs-driver/src/tests/primitive_foreign.rs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-scalar/Golden.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-scalar/Main.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-scalar/observations.json create mode 100644 docs/implementation/stdlib/primitive-bindings-2026-10-06/bindings.json create mode 100644 docs/implementation/stdlib/primitive-bindings-2026-10-06/report.md create mode 100644 docs/workflow/tools/stdlib-scalar-oracle.mjs diff --git a/crates/psrs-backend/src/bindings/mod.rs b/crates/psrs-backend/src/bindings/mod.rs index 2cc5812f..13af6351 100644 --- a/crates/psrs-backend/src/bindings/mod.rs +++ b/crates/psrs-backend/src/bindings/mod.rs @@ -6,6 +6,9 @@ use psrs_core::{Module as CoreModule, TypeId as CoreTypeId}; use psrs_hir::{ExternalKind, ModuleId, SymbolId}; use std::collections::{HashMap, HashSet}; +mod primitives; +pub(crate) use primitives::lower as lower_primitives; + /// The complete input consumed by P9. Platform binding metadata is kept beside /// CC rather than embedded in the CC module itself. #[derive(Clone, Debug, PartialEq, Eq)] diff --git a/crates/psrs-backend/src/bindings/primitives.rs b/crates/psrs-backend/src/bindings/primitives.rs new file mode 100644 index 00000000..a011bbff --- /dev/null +++ b/crates/psrs-backend/src/bindings/primitives.rs @@ -0,0 +1,160 @@ +//! Discharges explicit primitive bindings into verified ordinary Core functions. + +use crate::BackendError; +use psrs_core::{Binder, Declaration, Expr, ExprKind, Module, arrow_parts}; +use psrs_hir::{ExternalKind, IntrinsicCategory, LocalId}; + +#[cfg(test)] +mod tests; + +pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), Vec> { + let bindings = module + .externals + .iter() + .filter_map(|external| { + let ExternalKind::Primitive(intrinsic) = external.kind else { + return None; + }; + Some((external.clone(), intrinsic)) + }) + .collect::>(); + if bindings.is_empty() { + return Ok(()); + } + module + .verify_with_source(source.unwrap_or(module)) + .map_err(|errors| { + errors + .into_iter() + .map(|error| { + BackendError::invalid_ir("P8 primitive linking", error.span, error.message) + .with_module(error.module) + }) + .collect::>() + })?; + // Work on a complete candidate. Failed validation must not publish a + // partially discharged external table or generated declaration. + let mut candidate = module.clone(); + // Each generated function is closed over only its typed parameters and + // the registry operation. Validate these independent units with the full + // type/representation facts, without rechecking every source body for + // each binding. The common CC entry validates the complete output module. + let mut probe = module.clone(); + probe.declarations.clear(); + probe.entry = None; + for (external, intrinsic) in bindings { + let span = external + .signature + .as_ref() + .map_or(module.span, |ty| ty.span); + let Some(checked) = module + .external_types + .iter() + .find(|ty| ty.symbol == external.symbol) + else { + return Err(vec![BackendError::new( + "P8 primitive linking", + span, + "primitive binding has no checked source signature", + )]); + }; + let error = |message: String| { + vec![ + BackendError::new("P8 primitive linking", span, message) + .with_module(checked.source_module), + ] + }; + if !matches!( + intrinsic.descriptor().category, + IntrinsicCategory::UnaryScalar | IntrinsicCategory::BinaryScalar + ) { + return Err(error(format!( + "primitive binding `{}` has no foreign-function implementation yet", + intrinsic.descriptor().name + ))); + } + let mut result = checked.ty; + let mut parameters = Vec::new(); + let mut arrows = Vec::new(); + while let Some((parameter, tail)) = arrow_parts(&candidate.types, result) { + arrows.push(result); + parameters.push(Binder { + id: LocalId(parameters.len() as u32), + name: format!("primitive_argument_{}", parameters.len()), + ty: parameter, + span, + }); + result = tail; + } + if parameters.len() != intrinsic.descriptor().arity as usize { + return Err(error(format!( + "primitive binding `{}` does not match its declared function type", + intrinsic.descriptor().name + ))); + } + let mut value = Expr { + kind: ExprKind::IntrinsicCall { + intrinsic, + arguments: parameters + .iter() + .map(|binder| Expr { + kind: ExprKind::Local(binder.id), + ty: binder.ty, + span, + }) + .collect(), + }, + ty: result, + span, + }; + for (binder, ty) in parameters.into_iter().zip(arrows).rev() { + value = Expr { + kind: ExprKind::Lambda { + binder, + body: Box::new(value), + }, + ty, + span, + }; + } + let declaration = Declaration { + symbol: external.symbol, + name: external.name, + name_span: span, + quantified: Vec::new(), + ty: checked.ty, + value, + span, + }; + probe.declarations.push(declaration.clone()); + candidate.declarations.push(declaration); + candidate + .externals + .retain(|value| value.symbol != external.symbol); + candidate + .external_types + .retain(|value| value.symbol != external.symbol); + probe + .externals + .retain(|value| value.symbol != external.symbol); + probe + .external_types + .retain(|value| value.symbol != external.symbol); + // Core's existing intrinsic rules check operand and result identity, + // including unused bindings. No source-type or arity heuristic is used. + if let Err(errors) = probe.verify_with_source(source.unwrap_or(&probe)) { + return Err(error(format!( + "primitive binding `{}` violates its checked type contract: {}", + intrinsic.descriptor().name, + errors + .iter() + .map(|error| error.message) + .collect::>() + .join("; ") + ))); + } + probe.declarations.clear(); + } + *module = candidate; + Ok(()) +} diff --git a/crates/psrs-backend/src/bindings/primitives/tests.rs b/crates/psrs-backend/src/bindings/primitives/tests.rs new file mode 100644 index 00000000..bb5fbdb9 --- /dev/null +++ b/crates/psrs-backend/src/bindings/primitives/tests.rs @@ -0,0 +1,84 @@ +use super::*; +use psrs_core::{ExternalType, Type, TypeConstructor, TypeId}; +use psrs_hir::{ExternalSymbol, Intrinsic, ModuleId, SymbolId}; +use psrs_span::TextRange; + +fn fixture(types: &[TypeId]) -> Module { + let span = TextRange::new(0, 1); + let externals = types + .iter() + .enumerate() + .map(|(index, _)| ExternalSymbol { + symbol: SymbolId::new(ModuleId::INTRINSICS, 200 + index as u32), + name: format!("convert{index}"), + kind: ExternalKind::Primitive(Intrinsic::IntToNumber), + signature: None, + }) + .collect::>(); + let external_types = externals + .iter() + .zip(types) + .map(|(external, ty)| ExternalType { + symbol: external.symbol, + source_module: ModuleId(7), + ty: *ty, + }) + .collect(); + Module { + id: ModuleId(7), + name: "Bindings".into(), + externals, + external_types, + types: vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Number), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(2), TypeId(0)), + Type::Application(TypeId(3), TypeId(1)), + Type::Application(TypeId(3), TypeId(0)), + ], + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: Vec::new(), + type_names: Vec::new(), + entry: None, + span, + } +} + +#[test] +fn primitive_linking_does_not_publish_an_earlier_binding_when_a_later_one_fails() { + let mut module = fixture(&[TypeId(4), TypeId(5)]); + let before = module.clone(); + let errors = lower(&mut module, None).expect_err("second source signature is wrong"); + assert_eq!(module, before); + assert!(errors.iter().all(|error| error.module == Some(ModuleId(7)))); +} + +#[test] +fn primitive_linking_rejects_cyclic_checked_input_before_traversing_arrows() { + let mut module = fixture(&[TypeId(4)]); + module.types[4] = Type::Application(TypeId(3), TypeId(4)); + let before = module.clone(); + let errors = lower(&mut module, None).expect_err("cyclic source scheme is invalid IR"); + assert_eq!(module, before); + assert!( + errors + .iter() + .any(|error| error.kind == crate::BackendErrorKind::InvalidCompilerIr) + ); +} + +#[test] +fn primitive_linking_transfers_checked_identity_to_a_verified_function() { + let mut module = fixture(&[TypeId(4)]); + let symbol = module.externals[0].symbol; + lower(&mut module, None).unwrap(); + assert!(module.externals.is_empty()); + assert!(module.external_types.is_empty()); + assert_eq!(module.declarations[0].symbol, symbol); + assert_eq!(module.declarations[0].ty, TypeId(4)); + module.verify().unwrap(); +} diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 72661dc5..3d758843 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -257,11 +257,12 @@ pub fn lower_module_with_bindings( /// policies. `source` is the pre-lowering module when effect applications have /// been rewritten; otherwise it is absent and relations are read from `module`. pub(crate) fn lower_module_with_relations( - module: CoreModule, + mut module: CoreModule, bindings: ExternalBindings, source: Option<&CoreModule>, registry: RepresentationRegistry, ) -> Result> { + crate::bindings::lower_primitives(&mut module, source)?; bindings.validate_core(&module)?; let relations = source.unwrap_or(&module); if let Err(errors) = module.verify_with_source(relations) { diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 5b3ee833..d118d226 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -38,8 +38,9 @@ pub struct ConstructorInfo { pub parameters: Vec, } -/// The checked, synonym-expanded signature of a WIT value import. Compiler -/// intrinsics use registry-owned contracts and do not appear in this table. +/// The checked, synonym-expanded signature of a source foreign value import. +/// Bootstrap intrinsics use registry-owned contracts and do not appear here; +/// explicit primitive bindings retain their source signature until linking. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ExternalType { pub symbol: SymbolId, @@ -55,7 +56,7 @@ pub struct Module { pub id: ModuleId, pub name: String, pub externals: Vec, - /// Checked WIT import signatures projected from THIR. Backend binding and + /// Checked source foreign signatures projected from THIR. Backend binding and /// representation lowering must consume these schemes rather than /// reconstructing types from raw HIR annotations. pub external_types: Vec, diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index b2717097..5f189c25 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -20,6 +20,7 @@ mod let_constraints; mod library_foreign; mod operators; mod partial_application; +mod primitive_foreign; mod scalars; mod semigroup; mod show; diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs new file mode 100644 index 00000000..fec903ac --- /dev/null +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -0,0 +1,118 @@ +use super::*; + +#[test] +fn primitive_foreign_bindings_validate_unused_operand_and_result_types() { + for ty in [ + "Int -> Int", + "Number -> Number", + "Int -> Number -> Number", + "forall a. a -> a", + ] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#intToNumber\" convert :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("invalid primitive contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking"), + "{errors:?}" + ); + } +} + +#[test] +fn primitive_foreign_binding_names_are_registry_operations() { + let source = "module Main where\nforeign import \"psrs:intrinsic#missing\" convert :: Int -> Number\nmain = 0\n"; + let errors = check_program(&[("Main.purs", source)]).expect_err("unknown operation"); + assert!( + errors.iter().any(|error| error + .diagnostic + .message + .contains("unknown primitive binding")), + "{errors:?}" + ); +} + +#[test] +fn primitive_foreign_bindings_keep_unimplemented_categories_explicit() { + let source = "module Main where\nforeign import \"psrs:intrinsic#arrayLength\" size :: forall a. Array a -> Int\nmain = 0\n"; + let errors = compile_program_sources(&[("Main.purs", source)]) + .expect_err("array foreign lowering is not implemented yet"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking" + && error + .diagnostic + .message + .contains("no foreign-function implementation yet")), + "{errors:?}" + ); +} + +#[test] +fn primitive_foreign_bindings_execute_as_first_class_functions() { + let source = "module Main where\nforeign import \"psrs:intrinsic#intToNumber\" convert :: Int -> Number\nforeign import \"psrs:intrinsic#numberAdd\" add :: Number -> Number -> Number\nforeign import \"psrs:intrinsic#numberEq\" equal :: Number -> Number -> Boolean\napply f x = f x\nmain = if equal (apply (add (convert 40)) 2.0) 42.0 then 42 else 1\n"; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn primitive_foreign_bindings_preserve_cross_module_operator_identity() { + let native = "module Native where\nforeign import \"psrs:intrinsic#intAdd\" sum :: Int -> Int -> Int\ninfixl 6 sum as %%\n"; + let main = "module Main where\nimport Native\nmain = 40 %% 2\n"; + let Some(output) = run_program_with_wasmtime(&[("Native.purs", native), ("Main.purs", main)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn vendored_bit_operations_execute_the_declared_target_contract() { + let source = "module Main where\nimport Data.Int.Bits as Bits\nmain = if booleanAnd (intEq (Bits.and 63 42) 42) (booleanAnd (intEq (Bits.or 32 10) 42) (booleanAnd (intEq (Bits.xor 63 21) 42) (booleanAnd (intEq (Bits.shl 21 33) 42) (booleanAnd (intEq (Bits.shr (intNeg 84) 33) (intNeg 42)) (booleanAnd (intEq (Bits.zshr (intNeg 1) 1) 2147483647) (booleanAnd (intEq (Bits.zshr (intNeg 1) 0) (intNeg 1)) (intEq (Bits.complement (intNeg 43)) 42))))))) then 42 else 1\n"; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn primitive_foreign_bindings_match_pinned_official_scalar_observations() { + let sources = [ + ( + "Golden.purs", + include_str!("../../tests/fixtures/stdlib-scalar/Golden.purs"), + ), + ( + "Main.purs", + include_str!("../../tests/fixtures/stdlib-scalar/Main.purs"), + ), + ]; + let vendor = std::path::Path::new(env!("CARGO_MANIFEST_DIR")).join("../../stdlib/lib"); + let modules = [ + "Data/Int.purs", + "Data/Int/Bits.purs", + "Data/Eq.purs", + "Data/Ring.purs", + "Data/Semiring.purs", + "Data/HeytingAlgebra.purs", + ] + .map(|path| std::fs::read_to_string(vendor.join(path)).unwrap()); + for declaration in sources[0].1.lines().skip(1) { + assert!( + modules + .iter() + .any(|module| module.lines().any(|line| line == declaration)), + "oracle fixture must retain the actual vendored binding: {declaration}" + ); + } + let Some(output) = run_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/tests/fixtures/stdlib-scalar/Golden.purs b/crates/psrs-driver/tests/fixtures/stdlib-scalar/Golden.purs new file mode 100644 index 00000000..aff65a5b --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-scalar/Golden.purs @@ -0,0 +1,21 @@ +module Golden where +foreign import "psrs:intrinsic#intToNumber" toNumber :: Int -> Number +foreign import "psrs:intrinsic#intAnd" and :: Int -> Int -> Int +foreign import "psrs:intrinsic#intOr" or :: Int -> Int -> Int +foreign import "psrs:intrinsic#intXor" xor :: Int -> Int -> Int +foreign import "psrs:intrinsic#intShl" shl :: Int -> Int -> Int +foreign import "psrs:intrinsic#intShr" shr :: Int -> Int -> Int +foreign import "psrs:intrinsic#intZshr" zshr :: Int -> Int -> Int +foreign import "psrs:intrinsic#intComplement" complement :: Int -> Int +foreign import "psrs:intrinsic#booleanEq" eqBooleanImpl :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#intEq" eqIntImpl :: Int -> Int -> Boolean +foreign import "psrs:intrinsic#numberEq" eqNumberImpl :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#charEq" eqCharImpl :: Char -> Char -> Boolean +foreign import "psrs:intrinsic#intSub" intSub :: Int -> Int -> Int +foreign import "psrs:intrinsic#numberSub" numSub :: Number -> Number -> Number +foreign import "psrs:intrinsic#intAdd" intAdd :: Int -> Int -> Int +foreign import "psrs:intrinsic#numberAdd" numAdd :: Number -> Number -> Number +foreign import "psrs:intrinsic#numberMul" numMul :: Number -> Number -> Number +foreign import "psrs:intrinsic#booleanAnd" boolConj :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#booleanOr" boolDisj :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#booleanNot" boolNot :: Boolean -> Boolean diff --git a/crates/psrs-driver/tests/fixtures/stdlib-scalar/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-scalar/Main.purs new file mode 100644 index 00000000..5b683a2b --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-scalar/Main.purs @@ -0,0 +1,3 @@ +module Main where +import Golden as Golden +main = if (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (numberEq (Golden.toNumber 42) 42.0) (numberEq (Golden.toNumber (intSub (intNeg 2147483647) 1)) (numberNeg 2147483648.0))) (booleanAnd (numberEq (Golden.toNumber 2147483647) 2147483647.0) (booleanAnd (intEq (Golden.and 63 42) 42) (intEq (Golden.and (intNeg 1) 42) 42)))) (booleanAnd (booleanAnd (intEq (Golden.or 32 10) 42) (booleanAnd (intEq (Golden.or (intNeg 1) 0) (intNeg 1)) (intEq (Golden.xor 63 21) 42))) (booleanAnd (intEq (Golden.xor (intNeg 1) 0) (intNeg 1)) (booleanAnd (intEq (Golden.shl 21 1) 42) (intEq (Golden.shl 21 33) 42))))) (booleanAnd (booleanAnd (booleanAnd (intEq (Golden.shl 1 (intNeg 1)) (intSub (intNeg 2147483647) 1)) (booleanAnd (intEq (Golden.shr (intNeg 84) 1) (intNeg 42)) (intEq (Golden.shr (intNeg 84) 33) (intNeg 42)))) (booleanAnd (intEq (Golden.shr 1 (intNeg 1)) 0) (booleanAnd (intEq (Golden.zshr (intNeg 1) 1) 2147483647) (intEq (Golden.zshr (intNeg 1) 0) (intNeg 1))))) (booleanAnd (booleanAnd (intEq (Golden.zshr (intNeg 1) 32) (intNeg 1)) (booleanAnd (intEq (Golden.complement (intNeg 43)) 42) (intEq (Golden.complement (intSub (intNeg 2147483647) 1)) 2147483647))) (booleanAnd (booleanEq (Golden.eqBooleanImpl true true) true) (booleanAnd (booleanEq (Golden.eqBooleanImpl true false) false) (booleanEq (Golden.eqIntImpl 42 42) true)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanEq (Golden.eqIntImpl (intSub (intNeg 2147483647) 1) 2147483647) false) (booleanEq (Golden.eqNumberImpl 0.0 (numberNeg 0.0)) true)) (booleanAnd (booleanEq (Golden.eqNumberImpl (numberDiv 0.0 0.0) (numberDiv 0.0 0.0)) false) (booleanAnd (booleanEq (Golden.eqNumberImpl (numberDiv 1.0 0.0) (numberDiv 1.0 0.0)) true) (booleanEq (Golden.eqCharImpl 'λ' 'λ') true)))) (booleanAnd (booleanAnd (booleanEq (Golden.eqCharImpl '😀' '😀') true) (booleanAnd (booleanEq (Golden.eqCharImpl 'λ' '😀') false) (intEq (Golden.intSub 44 2) 42))) (booleanAnd (intEq (Golden.intSub (intSub (intNeg 2147483647) 1) 1) 2147483647) (booleanAnd (numberEq (Golden.numSub 44.0 2.0) 42.0) (numberEq (numberDiv 1.0 (Golden.numSub (numberNeg 0.0) 0.0)) (numberDiv (numberNeg 1.0) 0.0)))))) (booleanAnd (booleanAnd (booleanAnd (intEq (Golden.intAdd 40 2) 42) (booleanAnd (intEq (Golden.intAdd 2147483647 1) (intSub (intNeg 2147483647) 1)) (numberEq (Golden.numAdd 40.0 2.0) 42.0))) (booleanAnd (booleanNot (numberEq (Golden.numAdd (numberDiv 1.0 0.0) (numberDiv (numberNeg 1.0) 0.0)) (Golden.numAdd (numberDiv 1.0 0.0) (numberDiv (numberNeg 1.0) 0.0)))) (booleanAnd (numberEq (Golden.numMul 21.0 2.0) 42.0) (numberEq (numberDiv 1.0 (Golden.numMul (numberNeg 0.0) 2.0)) (numberDiv (numberNeg 1.0) 0.0))))) (booleanAnd (booleanAnd (booleanEq (Golden.boolConj true true) true) (booleanAnd (booleanEq (Golden.boolConj true false) false) (booleanEq (Golden.boolDisj false true) true))) (booleanAnd (booleanEq (Golden.boolDisj false false) false) (booleanAnd (booleanEq (Golden.boolNot true) false) (booleanEq (Golden.boolNot false) true))))))) then 42 else 1 diff --git a/crates/psrs-driver/tests/fixtures/stdlib-scalar/observations.json b/crates/psrs-driver/tests/fixtures/stdlib-scalar/observations.json new file mode 100644 index 00000000..39fa41a4 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-scalar/observations.json @@ -0,0 +1,530 @@ +{ + "node": "v26.10.0", + "inputs": [ + { + "path": "/tmp/ps-pkgs/purescript-integers/src/Data/Int.js", + "sha256": "35ff31f29f669c4c5d2ab3baee06b74a30b8cf5fcad77d25390158593ab9ac26" + }, + { + "path": "/tmp/ps-pkgs/purescript-integers/src/Data/Int/Bits.js", + "sha256": "4e253dbde0792507b4ed73f5f7c6409f1e297e84a4c481fda159a66842159343" + }, + { + "path": "/tmp/purescript-prelude/src/Data/Eq.js", + "sha256": "0a322f9252ba18de27c1dbb8fec560b44dfd4f2b4c82b3a51fde82af4d871ffe" + }, + { + "path": "/tmp/purescript-prelude/src/Data/Ring.js", + "sha256": "cbddf7ed3d4c34c775dffd9534719fc20f980d6063edbffcf1ac2bd436b59131" + }, + { + "path": "/tmp/purescript-prelude/src/Data/Semiring.js", + "sha256": "fb5e09243e90fcde78f52b15d56a07216a8bea1267db2e12d46ff07c8e0334c9" + }, + { + "path": "/tmp/purescript-prelude/src/Data/HeytingAlgebra.js", + "sha256": "c047b0c397ee4127c2e14ac297f97f9e8deddcb1bace7bcecb2ee1d3117bb70b" + } + ], + "observations": [ + { + "module": "Data/Int.purs", + "name": "toNumber", + "arguments": [ + 42 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int.purs", + "name": "toNumber", + "arguments": [ + -2147483648 + ], + "official_result": -2147483648, + "target_result": -2147483648, + "representation_difference": false + }, + { + "module": "Data/Int.purs", + "name": "toNumber", + "arguments": [ + 2147483647 + ], + "official_result": 2147483647, + "target_result": 2147483647, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "and", + "arguments": [ + 63, + 42 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "and", + "arguments": [ + -1, + 42 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "or", + "arguments": [ + 32, + 10 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "or", + "arguments": [ + -1, + 0 + ], + "official_result": -1, + "target_result": -1, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "xor", + "arguments": [ + 63, + 21 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "xor", + "arguments": [ + -1, + 0 + ], + "official_result": -1, + "target_result": -1, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "shl", + "arguments": [ + 21, + 1 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "shl", + "arguments": [ + 21, + 33 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "shl", + "arguments": [ + 1, + -1 + ], + "official_result": -2147483648, + "target_result": -2147483648, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "shr", + "arguments": [ + -84, + 1 + ], + "official_result": -42, + "target_result": -42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "shr", + "arguments": [ + -84, + 33 + ], + "official_result": -42, + "target_result": -42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "shr", + "arguments": [ + 1, + -1 + ], + "official_result": 0, + "target_result": 0, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "zshr", + "arguments": [ + -1, + 1 + ], + "official_result": 2147483647, + "target_result": 2147483647, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "zshr", + "arguments": [ + -1, + 0 + ], + "official_result": 4294967295, + "target_result": -1, + "representation_difference": true + }, + { + "module": "Data/Int/Bits.purs", + "name": "zshr", + "arguments": [ + -1, + 32 + ], + "official_result": 4294967295, + "target_result": -1, + "representation_difference": true + }, + { + "module": "Data/Int/Bits.purs", + "name": "complement", + "arguments": [ + -43 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Int/Bits.purs", + "name": "complement", + "arguments": [ + -2147483648 + ], + "official_result": 2147483647, + "target_result": 2147483647, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqBooleanImpl", + "arguments": [ + true, + true + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqBooleanImpl", + "arguments": [ + true, + false + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqIntImpl", + "arguments": [ + 42, + 42 + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqIntImpl", + "arguments": [ + -2147483648, + 2147483647 + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqNumberImpl", + "arguments": [ + 0, + "-0" + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqNumberImpl", + "arguments": [ + "NaN", + "NaN" + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqNumberImpl", + "arguments": [ + "Infinity", + "Infinity" + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqCharImpl", + "arguments": [ + "λ", + "λ" + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqCharImpl", + "arguments": [ + "😀", + "😀" + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/Eq.purs", + "name": "eqCharImpl", + "arguments": [ + "λ", + "😀" + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/Ring.purs", + "name": "intSub", + "arguments": [ + 44, + 2 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Ring.purs", + "name": "intSub", + "arguments": [ + -2147483648, + 1 + ], + "official_result": 2147483647, + "target_result": 2147483647, + "representation_difference": false + }, + { + "module": "Data/Ring.purs", + "name": "numSub", + "arguments": [ + 44, + 2 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Ring.purs", + "name": "numSub", + "arguments": [ + "-0", + 0 + ], + "official_result": "-0", + "target_result": "-0", + "representation_difference": false + }, + { + "module": "Data/Semiring.purs", + "name": "intAdd", + "arguments": [ + 40, + 2 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Semiring.purs", + "name": "intAdd", + "arguments": [ + 2147483647, + 1 + ], + "official_result": -2147483648, + "target_result": -2147483648, + "representation_difference": false + }, + { + "module": "Data/Semiring.purs", + "name": "numAdd", + "arguments": [ + 40, + 2 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Semiring.purs", + "name": "numAdd", + "arguments": [ + "Infinity", + "-Infinity" + ], + "official_result": "NaN", + "target_result": "NaN", + "representation_difference": false + }, + { + "module": "Data/Semiring.purs", + "name": "numMul", + "arguments": [ + 21, + 2 + ], + "official_result": 42, + "target_result": 42, + "representation_difference": false + }, + { + "module": "Data/Semiring.purs", + "name": "numMul", + "arguments": [ + "-0", + 2 + ], + "official_result": "-0", + "target_result": "-0", + "representation_difference": false + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolConj", + "arguments": [ + true, + true + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolConj", + "arguments": [ + true, + false + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolDisj", + "arguments": [ + false, + true + ], + "official_result": true, + "target_result": true, + "representation_difference": false + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolDisj", + "arguments": [ + false, + false + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolNot", + "arguments": [ + true + ], + "official_result": false, + "target_result": false, + "representation_difference": false + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolNot", + "arguments": [ + false + ], + "official_result": true, + "target_result": true, + "representation_difference": false + } + ] +} diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index a28d5f00..a4e442b9 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -110,6 +110,13 @@ impl Intrinsic { registry::descriptor(self) } + /// Resolves an explicit primitive binding using the authoritative registry. + pub fn from_binding(name: &str) -> Option { + Self::ALL + .into_iter() + .find(|value| value.descriptor().name == name) + } + /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. pub const ALL: [Intrinsic; 61] = [ diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index 94d3ebd4..e876a9de 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -135,6 +135,9 @@ pub enum ExternalKind { /// Its identity is the declaring module and the external value's name; /// absence of an implementation must remain an explicit linking failure. Library { module: String }, + /// A source value explicitly bound to a compiler primitive. Its checked + /// declaration type remains authoritative until target linking verifies it. + Primitive(Intrinsic), } impl ExternalKind { diff --git a/crates/psrs-resolve/src/resolver/module_resolution.rs b/crates/psrs-resolve/src/resolver/module_resolution.rs index d728f0e0..38b16d86 100644 --- a/crates/psrs-resolve/src/resolver/module_resolution.rs +++ b/crates/psrs-resolve/src/resolver/module_resolution.rs @@ -120,9 +120,21 @@ pub(crate) fn resolve_ast_module( }); continue; }; - ExternalKind::Wit { - interface: interface.into(), - function: function.into(), + if interface == "psrs:intrinsic" { + let Some(intrinsic) = hir::Intrinsic::from_binding(function) else { + resolver.errors.push(ResolveError { + kind: ResolveErrorKind::InvalidHir, + span: foreign.span, + message: format!("unknown primitive binding `{function}`"), + }); + continue; + }; + ExternalKind::Primitive(intrinsic) + } else { + ExternalKind::Wit { + interface: interface.into(), + function: function.into(), + } } } }; diff --git a/crates/psrs-thir/src/lib.rs b/crates/psrs-thir/src/lib.rs index a5c0d018..91e12866 100644 --- a/crates/psrs-thir/src/lib.rs +++ b/crates/psrs-thir/src/lib.rs @@ -177,10 +177,11 @@ pub struct ConstructorInfo { pub parameters: Vec, } -/// The normalized checked scheme for one WIT value import. Unlike the HIR +/// The normalized checked scheme for one source foreign value import. Unlike the HIR /// signature kept for names and diagnostics, `ty` has had type synonyms -/// expanded by the type checker and uses this module's type table. Intrinsics -/// use registry-owned contracts and do not appear in this table. +/// expanded by the type checker and uses this module's type table. Bootstrap +/// intrinsics use registry-owned contracts; explicit primitive bindings still +/// require the checked source scheme recorded here. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ExternalType { pub symbol: SymbolId, diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index ea0168d4..a15478fa 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -147,7 +147,11 @@ impl Checker { InferredExprKind::Global(*symbol), self.intrinsic_type(intrinsic), ), - Some(ExternalKind::Wit { .. } | ExternalKind::Library { .. }) => { + Some( + ExternalKind::Wit { .. } + | ExternalKind::Library { .. } + | ExternalKind::Primitive(_), + ) => { let Some(signature) = self.env.external_signatures.get(symbol).cloned() else { self.state.errors.push(TypeCheckError::new( diff --git a/docs/design/frontend/semantics/foreign-imports.md b/docs/design/frontend/semantics/foreign-imports.md index 00e27721..0399871c 100644 --- a/docs/design/frontend/semantics/foreign-imports.md +++ b/docs/design/frontend/semantics/foreign-imports.md @@ -28,6 +28,18 @@ reject a library value without a registered target implementation explicitly. This supports faithful source inventory and checking, not JavaScript execution or an assertion that all library values already have Wasm implementations. +An explicit `"psrs:intrinsic#operation"` binding selects an operation from the +authoritative intrinsic registry. Resolution records `Primitive(Intrinsic)`; +the declaration still owns its source type and symbol. P8 linking generates an +ordinary typed Core function, checks its operand and result identities with the +existing Core intrinsic verifier, and discharges the external only after those +checks succeed. The generated function supports ordinary first-class use and +partial application. A wrong type is rejected even if the binding is unused. +The initial foreign-binding implementation covers monomorphic unary and binary +scalar operations. Other registered operations remain explicit unsupported +bindings until their full checked implementation exists. The binding string, +never the source function's name or declaring module, selects the operation. + ## Scope This document owns foreign value imports and foreign data declarations from @@ -62,6 +74,7 @@ corresponds to a handle. ```text ForeignValue = { name, binding: Optional(Interface "#" Function), type, span } +Binding = WIT(Interface, Function) | Primitive(Intrinsic) | Library(Module, Symbol) ForeignData = { name, kind, span } OpaqueType = nominal TypeId with no constructors SourceResource = { type_id: TypeId } diff --git a/docs/implementation/stdlib/primitive-bindings-2026-10-06/bindings.json b/docs/implementation/stdlib/primitive-bindings-2026-10-06/bindings.json new file mode 100644 index 00000000..269bdf17 --- /dev/null +++ b/docs/implementation/stdlib/primitive-bindings-2026-10-06/bindings.json @@ -0,0 +1,145 @@ +{ + "schema_version": 1, + "bindings": [ + { + "module": "Data/Eq.purs", + "name": "eqBooleanImpl", + "operation": "booleanEq", + "signature": "Boolean -> Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L77" + }, + { + "module": "Data/Eq.purs", + "name": "eqIntImpl", + "operation": "intEq", + "signature": "Int -> Int -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L78" + }, + { + "module": "Data/Eq.purs", + "name": "eqNumberImpl", + "operation": "numberEq", + "signature": "Number -> Number -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L79" + }, + { + "module": "Data/Eq.purs", + "name": "eqCharImpl", + "operation": "charEq", + "signature": "Char -> Char -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Eq.purs#L80" + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolConj", + "operation": "booleanAnd", + "signature": "Boolean -> Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs#L103" + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolDisj", + "operation": "booleanOr", + "signature": "Boolean -> Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs#L104" + }, + { + "module": "Data/HeytingAlgebra.purs", + "name": "boolNot", + "operation": "booleanNot", + "signature": "Boolean -> Boolean", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/HeytingAlgebra.purs#L105" + }, + { + "module": "Data/Int/Bits.purs", + "name": "and", + "operation": "intAnd", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L13" + }, + { + "module": "Data/Int/Bits.purs", + "name": "or", + "operation": "intOr", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L18" + }, + { + "module": "Data/Int/Bits.purs", + "name": "xor", + "operation": "intXor", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L23" + }, + { + "module": "Data/Int/Bits.purs", + "name": "shl", + "operation": "intShl", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L28" + }, + { + "module": "Data/Int/Bits.purs", + "name": "shr", + "operation": "intShr", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L31" + }, + { + "module": "Data/Int/Bits.purs", + "name": "zshr", + "operation": "intZshr", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L34" + }, + { + "module": "Data/Int/Bits.purs", + "name": "complement", + "operation": "intComplement", + "signature": "Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int/Bits.purs#L37" + }, + { + "module": "Data/Int.purs", + "name": "toNumber", + "operation": "intToNumber", + "signature": "Int -> Number", + "upstream_url": "https://github.com/purescript/purescript-integers/blob/54d712b25c594833083d15dc9ff2418eb9c52822/src/Data/Int.purs#L81" + }, + { + "module": "Data/Ring.purs", + "name": "intSub", + "operation": "intSub", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring.purs#L54" + }, + { + "module": "Data/Ring.purs", + "name": "numSub", + "operation": "numberSub", + "signature": "Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Ring.purs#L55" + }, + { + "module": "Data/Semiring.purs", + "name": "intAdd", + "operation": "intAdd", + "signature": "Int -> Int -> Int", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L89" + }, + { + "module": "Data/Semiring.purs", + "name": "numAdd", + "operation": "numberAdd", + "signature": "Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L91" + }, + { + "module": "Data/Semiring.purs", + "name": "numMul", + "operation": "numberMul", + "signature": "Number -> Number -> Number", + "upstream_url": "https://github.com/purescript/purescript-prelude/blob/f4cad0ae8106185c9ab407f43cf9abf05c256af4/src/Data/Semiring.purs#L92" + } + ] +} diff --git a/docs/implementation/stdlib/primitive-bindings-2026-10-06/report.md b/docs/implementation/stdlib/primitive-bindings-2026-10-06/report.md new file mode 100644 index 00000000..6309acf2 --- /dev/null +++ b/docs/implementation/stdlib/primitive-bindings-2026-10-06/report.md @@ -0,0 +1,110 @@ +# Checked scalar foreign bindings + +This iteration follows the [source restoration checkpoint](../vendor-restoration-2026-10-06/report.md) +at `f0b1b71`. It implements 20 previously missing foreign values through explicit +`psrs:intrinsic` bindings. All official public signatures and ordinary source +bodies remain unchanged; only the target binding string is inserted into those +foreign declarations. The [binding manifest](bindings.json) records each +operation, exact signature, and pinned upstream declaration. + +## Implementation contract + +The compiler resolves the explicit operation through the existing authoritative +intrinsic registry. It retains the declaring symbol and checked source type. +P8 constructs typed Core functions over those parameters, validates them with +the common Core intrinsic rules, and transfers the declaration identity only +after validation. Ordinary closure conversion handles first-class functions, +partial applications, and imported fixity aliases. No source function name or +module name selects an implementation. + +The input Core is verified before traversing the signature; cyclic or missing +type evidence is invalid IR. Linking uses a complete candidate and does not +publish a previously generated binding if another binding fails. A declaration +with the wrong argument or result type fails even when unused. Non-scalar +categories remain explicit unsupported bindings; they are not approximated. + +## Source and target evidence + +| Official module | Implemented foreign values | +| --- | --- | +| `Data.Int` | toNumber | +| `Data.Int.Bits` | and, or, xor, shl, shr, zshr, complement | +| `Data.Eq` | eqBooleanImpl, eqIntImpl, eqNumberImpl, eqCharImpl | +| `Data.Ring` | intSub, numSub | +| `Data.Semiring` | intAdd, numAdd, numMul | +| `Data.HeytingAlgebra` | boolConj, boolDisj, boolNot | + +Wasm uses signed i32 for Int and IEEE-754 f64 for Number, as specified by +[scalars and primitives](../../../design/backend/fp/scalars-and-primitives.md). +DEC-16 supplies the Char scalar-value contract. Numeric conversion of every +i32 to f64 is exact; it replaces the missing foreign implementation without +inventing a source equation. + +The oracle generator executes the original JavaScript from the exact clean +package revisions pinned in the restoration inventory. It records JavaScript +file hashes and both official and target observations. The committed +[fixtures](../../../../crates/psrs-driver/tests/fixtures/stdlib-scalar/observations.json) +cover 20 bindings in 46 cases, including integer wrapping, shift-count masking, +negative values, NaN, infinities, signed zero, and non-ASCII/supplementary Char. +Node v26.10.0 produced these observations; Wasmtime 49.0.2 executed the target. + +Two cases deliberately differ in representation: official JS evaluates +`zshr(-1, 0)` and `zshr(-1, 32)` to `4294967295`; this target returns `-1`, the +same 32-bit bit pattern interpreted as the specified signed Int. Both raw and +normalized results remain visible. This is a Wasm Int representation difference, +not an assertion of identical JavaScript number behavior. The source signature +and shift-count masking are preserved. + +The large-product behavior of official `intMul`, division/remainder edge cases, +string equality, callback-based array equality, and other foreign values were +not silently mapped to superficially similar primitives. They remain explicit +gaps pending their implementation and behavior review. + +## Validation and remaining work + +Mandatory Wasmtime driver tests cover the 46-case official observation fixture, +the complete actual vendored Bits module, first-class and partially applied +functions, imported operator identity, unused wrong signatures, unknown +operations, and unimplemented operation categories. The fixture test also checks +that every tested declaration is still the actual vendored declaration. + +Seven primitive-foreign driver tests passed with `PSRS_REQUIRE_WASMTIME=1`. +Fourteen let-constraint tests and six ordinary-library-foreign tests passed. +Backend tests cover transactional failure, checked input cycles, identity +transfer, and verification of the generated function; all three passed. Format +checking and strict workspace clippy with all targets also passed. The full +workspace test suite and full scoreboards were not run. + +A 46-level right-nested fixture originally overflowed the Rust test thread's +stack. The generator now combines the same independent conditions as a +balanced tree; no case was removed. Arbitrarily deep expression robustness was +not established by this iteration. + +After rebuilding the CLI, `/tmp/psrs-stdlib-all.purs` still fails at P8 library +linking. The missing-implementation diagnostics decreased from 253 to 233, with +`Control.Apply.arrayApply` still first. The report is +`/tmp/psrs-stdlib-primitive2.json`; the observed run took 43,198 ms. Twenty of the +275 inventory foreign values now have target implementations, leaving 255 in +the full inventory, including modules outside this reproducer's closure. +Full stdlib compilation and full runtime acceptance remain incomplete. No +scoreboard, README, or D-04 measurement was changed. + +The fixtures isolate these foreign declarations from other missing imports; +they do not establish runtime behavior of the complete Eq/Semiring/Prelude +closures. The Bits runtime test imports the actual complete module. A future +standalone conformance component must keep this distinction visible when +moving the oracle generator and fixture runner out of compiler tests. + +## Reproduce + +```sh +node docs/workflow/tools/stdlib-scalar-oracle.mjs \ + /tmp/purescript-prelude /tmp/ps-pkgs/purescript-integers \ + crates/psrs-driver/tests/fixtures/stdlib-scalar +PSRS_REQUIRE_WASMTIME=1 \ + cargo test -p psrs-driver --lib primitive_foreign --offline +cargo test -p psrs-backend --lib bindings::primitives --offline +``` + +The source-fidelity policy still applies. This manifest covers target bindings; +it does not authorize edits to ordinary PureScript bodies or signatures. diff --git a/docs/workflow/tools/stdlib-scalar-oracle.mjs b/docs/workflow/tools/stdlib-scalar-oracle.mjs new file mode 100644 index 00000000..873a6dce --- /dev/null +++ b/docs/workflow/tools/stdlib-scalar-oracle.mjs @@ -0,0 +1,101 @@ +// Generate source-signature and behavior fixtures from pinned official FFI. +import { readFile, writeFile, mkdir } from 'node:fs/promises'; +import { execFileSync } from 'node:child_process'; +import { createHash } from 'node:crypto'; +import { resolve, join } from 'node:path'; +import { pathToFileURL } from 'node:url'; + +const [prelude, integers, output] = process.argv.slice(2).map(value => resolve(value)); +if (!prelude || !integers || !output) throw Error('usage: node stdlib-scalar-oracle.mjs PRELUDE INTEGERS OUTPUT'); +const repository = resolve(import.meta.dirname, '../../..'); +const inventory = JSON.parse(await readFile(join(repository, + 'docs/implementation/stdlib/vendor-restoration-2026-10-06/inventory.json'), 'utf8')); +const roots = { 'purescript-prelude': prelude, 'purescript-integers': integers }; +for (const [packageName, root] of Object.entries(roots)) { + const pin = inventory.packages.find(value => value.name === packageName); + if (execFileSync('git', ['-C', root, 'rev-parse', 'HEAD'], { encoding: 'utf8' }).trim() !== pin.commit) + throw Error(`unexpected upstream revision: ${packageName}`); + if (execFileSync('git', ['-C', root, 'status', '--porcelain'], { encoding: 'utf8' }).trim()) + throw Error(`dirty upstream: ${packageName}`); +} +const specifications = [ + ['Data/Int.purs', 'toNumber', [[42], [-2147483648], [2147483647]]], + ['Data/Int/Bits.purs', 'and', [[63, 42], [-1, 42]]], + ['Data/Int/Bits.purs', 'or', [[32, 10], [-1, 0]]], + ['Data/Int/Bits.purs', 'xor', [[63, 21], [-1, 0]]], + ['Data/Int/Bits.purs', 'shl', [[21, 1], [21, 33], [1, -1]]], + ['Data/Int/Bits.purs', 'shr', [[-84, 1], [-84, 33], [1, -1]]], + ['Data/Int/Bits.purs', 'zshr', [[-1, 1], [-1, 0], [-1, 32]]], + ['Data/Int/Bits.purs', 'complement', [[-43], [-2147483648]]], + ['Data/Eq.purs', 'eqBooleanImpl', [[true, true], [true, false]]], + ['Data/Eq.purs', 'eqIntImpl', [[42, 42], [-2147483648, 2147483647]]], + ['Data/Eq.purs', 'eqNumberImpl', [[0, -0], [NaN, NaN], [Infinity, Infinity]]], + ['Data/Eq.purs', 'eqCharImpl', [['λ', 'λ'], ['😀', '😀'], ['λ', '😀']]], + ['Data/Ring.purs', 'intSub', [[44, 2], [-2147483648, 1]]], + ['Data/Ring.purs', 'numSub', [[44, 2], [-0, 0]]], + ['Data/Semiring.purs', 'intAdd', [[40, 2], [2147483647, 1]]], + ['Data/Semiring.purs', 'numAdd', [[40, 2], [Infinity, -Infinity]]], + ['Data/Semiring.purs', 'numMul', [[21, 2], [-0, 2]]], + ['Data/HeytingAlgebra.purs', 'boolConj', [[true, true], [true, false]]], + ['Data/HeytingAlgebra.purs', 'boolDisj', [[false, true], [false, false]]], + ['Data/HeytingAlgebra.purs', 'boolNot', [[true], [false]]], +]; +const hashes = new Map(), declarations = [], observations = [], checks = []; +function marker(value) { + if (typeof value !== 'number') return value; + if (Number.isNaN(value)) return 'NaN'; + if (Object.is(value, -0)) return '-0'; + if (!Number.isFinite(value)) return String(value); + return value; +} +function literal(value, type) { + if (typeof value === 'boolean') return String(value); + if (typeof value === 'string') return `'${value}'`; + if (Number.isNaN(value)) return '(numberDiv 0.0 0.0)'; + if (!Number.isFinite(value)) return `(numberDiv ${value < 0 ? '(numberNeg 1.0)' : '1.0'} 0.0)`; + const negative = value < 0 || Object.is(value, -0); + const magnitude = String(Math.abs(value)); + if (type === 'Number') { + const number = magnitude.includes('.') ? magnitude : magnitude + '.0'; + return negative ? `(numberNeg ${number})` : number; + } + if (value === -2147483648) return '(intSub (intNeg 2147483647) 1)'; + return negative ? `(intNeg ${magnitude})` : magnitude; +} +for (const [file, name, cases] of specifications) { + const metadata = inventory.modules.find(value => value.path === file); + const upstream = join(roots[metadata.package], 'src', file.replace('.purs', '.js')); + const js = await readFile(upstream); + hashes.set(upstream, createHash('sha256').update(js).digest('hex')); + const functions = await import(pathToFileURL(upstream)); + const vendor = await readFile(join(repository, 'stdlib/lib', file), 'utf8'); + const declaration = vendor.split('\n').find(line => line.startsWith('foreign import "psrs:intrinsic#') && line.includes(`" ${name} ::`)); + if (!declaration) throw Error(`missing explicit target binding: ${file}.${name}`); + declarations.push(declaration); + const types = declaration.split('::')[1].trim().split(' -> '); + const resultType = types.at(-1); + for (const args of cases) { + let expected = functions[name]; + for (const argument of args) expected = expected(argument); + // Wasm Int is signed i32; record the raw JS observation separately. + const target = resultType === 'Int' ? expected | 0 : expected; + const call = `(Golden.${name} ${args.map((value, i) => literal(value, types[i])).join(' ')})`; + let condition; + if (resultType === 'Number' && Number.isNaN(target)) condition = `(booleanNot (numberEq ${call} ${call}))`; + else if (resultType === 'Number' && Object.is(target, -0)) + condition = `(numberEq (numberDiv 1.0 ${call}) (numberDiv (numberNeg 1.0) 0.0))`; + else condition = `(${resultType === 'Int' ? 'intEq' : resultType === 'Boolean' ? 'booleanEq' : 'numberEq'} ${call} ${literal(target, resultType)})`; + observations.push({ module: file, name, arguments: args.map(marker), official_result: marker(expected), target_result: marker(target), representation_difference: !Object.is(expected, target) }); + checks.push(condition); + } +} +await mkdir(output, { recursive: true }); +await writeFile(join(output, 'Golden.purs'), 'module Golden where\n' + declarations.join('\n') + '\n'); +function conjunction(values) { + if (values.length === 1) return values[0]; + const middle = Math.floor(values.length / 2); + return `(booleanAnd ${conjunction(values.slice(0, middle))} ${conjunction(values.slice(middle))})`; +} +await writeFile(join(output, 'Main.purs'), 'module Main where\nimport Golden as Golden\nmain = if ' + conjunction(checks) + ' then 42 else 1\n'); +await writeFile(join(output, 'observations.json'), JSON.stringify({ node: process.version, inputs: [...hashes].map(([path, sha256]) => ({ path, sha256 })), observations }, null, 2) + '\n'); +console.log(`${declarations.length} bindings, ${checks.length} cases`); diff --git a/stdlib/lib/Data/Eq.purs b/stdlib/lib/Data/Eq.purs index e8380efe..b4bbbf4b 100644 --- a/stdlib/lib/Data/Eq.purs +++ b/stdlib/lib/Data/Eq.purs @@ -74,10 +74,10 @@ instance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) instance eqProxy :: Eq (Proxy a) where eq _ _ = true -foreign import eqBooleanImpl :: Boolean -> Boolean -> Boolean -foreign import eqIntImpl :: Int -> Int -> Boolean -foreign import eqNumberImpl :: Number -> Number -> Boolean -foreign import eqCharImpl :: Char -> Char -> Boolean +foreign import "psrs:intrinsic#booleanEq" eqBooleanImpl :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#intEq" eqIntImpl :: Int -> Int -> Boolean +foreign import "psrs:intrinsic#numberEq" eqNumberImpl :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#charEq" eqCharImpl :: Char -> Char -> Boolean foreign import eqStringImpl :: String -> String -> Boolean foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean diff --git a/stdlib/lib/Data/HeytingAlgebra.purs b/stdlib/lib/Data/HeytingAlgebra.purs index 26387398..af402e09 100644 --- a/stdlib/lib/Data/HeytingAlgebra.purs +++ b/stdlib/lib/Data/HeytingAlgebra.purs @@ -100,9 +100,9 @@ instance heytingAlgebraRecord :: (RL.RowToList row list, HeytingAlgebraRecord li implies = impliesRecord (Proxy :: Proxy list) not = notRecord (Proxy :: Proxy list) -foreign import boolConj :: Boolean -> Boolean -> Boolean -foreign import boolDisj :: Boolean -> Boolean -> Boolean -foreign import boolNot :: Boolean -> Boolean +foreign import "psrs:intrinsic#booleanAnd" boolConj :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#booleanOr" boolDisj :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#booleanNot" boolNot :: Boolean -> Boolean -- | A class for records where all fields have `HeytingAlgebra` instances, used -- | to implement the `HeytingAlgebra` instance for records. diff --git a/stdlib/lib/Data/Int.purs b/stdlib/lib/Data/Int.purs index c637fc8c..1f9f3b76 100644 --- a/stdlib/lib/Data/Int.purs +++ b/stdlib/lib/Data/Int.purs @@ -78,7 +78,7 @@ unsafeClamp x -- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number` -- | so there is no loss of precision with this function. -foreign import toNumber :: Int -> Number +foreign import "psrs:intrinsic#intToNumber" toNumber :: Int -> Number -- | Reads an `Int` from a `String` value. The number must parse as an integer -- | and fall within the valid range of values for the `Int` type, otherwise diff --git a/stdlib/lib/Data/Int/Bits.purs b/stdlib/lib/Data/Int/Bits.purs index d1b47156..c6f17df5 100644 --- a/stdlib/lib/Data/Int/Bits.purs +++ b/stdlib/lib/Data/Int/Bits.purs @@ -10,28 +10,28 @@ module Data.Int.Bits ) where -- | Bitwise AND. -foreign import and :: Int -> Int -> Int +foreign import "psrs:intrinsic#intAnd" and :: Int -> Int -> Int infixl 10 and as .&. -- | Bitwise OR. -foreign import or :: Int -> Int -> Int +foreign import "psrs:intrinsic#intOr" or :: Int -> Int -> Int infixl 10 or as .|. -- | Bitwise XOR. -foreign import xor :: Int -> Int -> Int +foreign import "psrs:intrinsic#intXor" xor :: Int -> Int -> Int infixl 10 xor as .^. -- | Bitwise shift left. -foreign import shl :: Int -> Int -> Int +foreign import "psrs:intrinsic#intShl" shl :: Int -> Int -> Int -- | Bitwise shift right. -foreign import shr :: Int -> Int -> Int +foreign import "psrs:intrinsic#intShr" shr :: Int -> Int -> Int -- | Bitwise zero-fill shift right. -foreign import zshr :: Int -> Int -> Int +foreign import "psrs:intrinsic#intZshr" zshr :: Int -> Int -> Int -- | Bitwise NOT. -foreign import complement :: Int -> Int +foreign import "psrs:intrinsic#intComplement" complement :: Int -> Int diff --git a/stdlib/lib/Data/Ring.purs b/stdlib/lib/Data/Ring.purs index c06abd63..2ff5b292 100644 --- a/stdlib/lib/Data/Ring.purs +++ b/stdlib/lib/Data/Ring.purs @@ -51,8 +51,8 @@ instance ringRecord :: (RL.RowToList row list, RingRecord list row row) => Ring negate :: forall a. Ring a => a -> a negate a = zero - a -foreign import intSub :: Int -> Int -> Int -foreign import numSub :: Number -> Number -> Number +foreign import "psrs:intrinsic#intSub" intSub :: Int -> Int -> Int +foreign import "psrs:intrinsic#numberSub" numSub :: Number -> Number -> Number -- | A class for records where all fields have `Ring` instances, used to -- | implement the `Ring` instance for records. diff --git a/stdlib/lib/Data/Semiring.purs b/stdlib/lib/Data/Semiring.purs index b764425c..79638568 100644 --- a/stdlib/lib/Data/Semiring.purs +++ b/stdlib/lib/Data/Semiring.purs @@ -86,10 +86,10 @@ instance semiringRecord :: (RL.RowToList row list, SemiringRecord list row row) one = oneRecord (Proxy :: Proxy list) (Proxy :: Proxy row) zero = zeroRecord (Proxy :: Proxy list) (Proxy :: Proxy row) -foreign import intAdd :: Int -> Int -> Int +foreign import "psrs:intrinsic#intAdd" intAdd :: Int -> Int -> Int foreign import intMul :: Int -> Int -> Int -foreign import numAdd :: Number -> Number -> Number -foreign import numMul :: Number -> Number -> Number +foreign import "psrs:intrinsic#numberAdd" numAdd :: Number -> Number -> Number +foreign import "psrs:intrinsic#numberMul" numMul :: Number -> Number -> Number -- | A class for records where all fields have `Semiring` instances, used to -- | implement the `Semiring` instance for records. From d52573fa1a58ceb9b581ddd77aff9c20f94d402a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 16:37:53 +0800 Subject: [PATCH 038/148] Consume independent psrs-stdlib package and separate conformance tooling --- .gitignore | 3 + AGENTS.md | 9 +- Cargo.lock | 2 + README.md | 17 +- crates/psrs-cli/src/diagnose/artifacts.rs | 17 +- crates/psrs-driver/Cargo.toml | 2 + crates/psrs-driver/src/lib.rs | 1 + crates/psrs-driver/src/loader.rs | 2 +- crates/psrs-driver/src/prelude.rs | 76 +- crates/psrs-driver/src/prelude/package.rs | 269 ++++ .../src/tests/primitive_foreign.rs | 13 +- crates/psrs-driver/src/tests/scalars.rs | 8 +- .../tests/fixtures/upstream-prelude/Symbol.js | 5 + crates/psrs-driver/tests/upstream/mod.rs | 11 + .../tests/upstream/symbol_reflection.rs | 22 +- docs/README.md | 5 + .../D-17-stdlib-and-conformance-boundaries.md | 76 + .../backend/wasm/primitive-ffi-and-stdlib.md | 2 +- .../backend/wasm/wasi-platform-library.md | 10 +- .../stdlib/package-split-2026-10-06/report.md | 45 + docs/workflow/stdlib-conformance.md | 50 + docs/workflow/stdlib-vendoring.md | 10 +- docs/workflow/tools/audit-stdlib-vendor.py | 231 +-- docs/workflow/tools/stdlib-scalar-oracle.mjs | 117 +- stdlib.lock.json | 6 + stdlib/lib/Control/Alt.purs | 42 - stdlib/lib/Control/Alternative.purs | 50 - stdlib/lib/Control/Applicative.purs | 70 - stdlib/lib/Control/Apply.purs | 104 -- stdlib/lib/Control/Biapplicative.purs | 12 - stdlib/lib/Control/Biapply.purs | 59 - stdlib/lib/Control/Bind.purs | 150 -- stdlib/lib/Control/Category.purs | 22 - stdlib/lib/Control/Comonad.purs | 21 - stdlib/lib/Control/Extend.purs | 59 - stdlib/lib/Control/Lazy.purs | 25 - stdlib/lib/Control/Monad.purs | 86 -- stdlib/lib/Control/Monad/Gen.purs | 132 -- stdlib/lib/Control/Monad/Gen/Class.purs | 29 - stdlib/lib/Control/Monad/Gen/Common.purs | 67 - stdlib/lib/Control/Monad/Rec/Class.purs | 191 --- stdlib/lib/Control/Monad/ST.purs | 3 - stdlib/lib/Control/Monad/ST/Class.purs | 17 - stdlib/lib/Control/Monad/ST/Global.purs | 18 - stdlib/lib/Control/Monad/ST/Internal.purs | 136 -- stdlib/lib/Control/Monad/ST/Ref.purs | 3 - stdlib/lib/Control/Monad/ST/Uncurried.purs | 101 -- stdlib/lib/Control/MonadPlus.purs | 32 - stdlib/lib/Control/Plus.purs | 27 - stdlib/lib/Control/Semigroupoid.purs | 25 - stdlib/lib/Data/Array.purs | 1371 ----------------- stdlib/lib/Data/Array/NonEmpty.purs | 598 ------- stdlib/lib/Data/Array/NonEmpty/Internal.purs | 84 - stdlib/lib/Data/Array/Partial.purs | 35 - stdlib/lib/Data/Array/ST.purs | 262 ---- stdlib/lib/Data/Array/ST/Iterator.purs | 80 - stdlib/lib/Data/Array/ST/Partial.purs | 36 - stdlib/lib/Data/Bifoldable.purs | 198 --- stdlib/lib/Data/Bifunctor.purs | 46 - stdlib/lib/Data/Bifunctor/Join.purs | 31 - stdlib/lib/Data/Bitraversable.purs | 136 -- stdlib/lib/Data/Boolean.purs | 10 - stdlib/lib/Data/BooleanAlgebra.purs | 43 - stdlib/lib/Data/Bounded.purs | 105 -- stdlib/lib/Data/Bounded/Generic.purs | 56 - stdlib/lib/Data/Char.purs | 16 - stdlib/lib/Data/Char/Gen.purs | 35 - stdlib/lib/Data/CommutativeRing.purs | 44 - stdlib/lib/Data/Compactable.purs | 164 -- stdlib/lib/Data/Comparison.purs | 25 - stdlib/lib/Data/Const.purs | 63 - stdlib/lib/Data/Decidable.purs | 29 - stdlib/lib/Data/Decide.purs | 42 - stdlib/lib/Data/Distributive.purs | 67 - stdlib/lib/Data/Divide.purs | 46 - stdlib/lib/Data/Divisible.purs | 25 - stdlib/lib/Data/DivisionRing.purs | 55 - stdlib/lib/Data/Either.purs | 294 ---- stdlib/lib/Data/Either/Inject.purs | 23 - stdlib/lib/Data/Either/Nested.purs | 278 ---- stdlib/lib/Data/Enum.purs | 321 ---- stdlib/lib/Data/Enum/Gen.purs | 18 - stdlib/lib/Data/Enum/Generic.purs | 118 -- stdlib/lib/Data/Eq.purs | 115 -- stdlib/lib/Data/Eq/Generic.purs | 35 - stdlib/lib/Data/Equivalence.purs | 31 - stdlib/lib/Data/EuclideanRing.purs | 100 -- stdlib/lib/Data/Exists.purs | 57 - stdlib/lib/Data/Field.purs | 41 - stdlib/lib/Data/Filterable.purs | 229 --- stdlib/lib/Data/Foldable.purs | 471 ------ stdlib/lib/Data/FoldableWithIndex.purs | 370 ----- stdlib/lib/Data/Function.purs | 120 -- stdlib/lib/Data/Function/Uncurried.purs | 124 -- stdlib/lib/Data/Functor.purs | 106 -- stdlib/lib/Data/Functor/App.purs | 56 - stdlib/lib/Data/Functor/Clown.purs | 44 - stdlib/lib/Data/Functor/Compose.purs | 58 - stdlib/lib/Data/Functor/Contravariant.purs | 35 - stdlib/lib/Data/Functor/Coproduct.purs | 76 - stdlib/lib/Data/Functor/Coproduct/Inject.purs | 24 - stdlib/lib/Data/Functor/Coproduct/Nested.purs | 273 ---- stdlib/lib/Data/Functor/Costar.purs | 66 - stdlib/lib/Data/Functor/Flip.purs | 44 - stdlib/lib/Data/Functor/Invariant.purs | 57 - stdlib/lib/Data/Functor/Joker.purs | 60 - stdlib/lib/Data/Functor/Product.purs | 60 - stdlib/lib/Data/Functor/Product/Nested.purs | 112 -- stdlib/lib/Data/Functor/Product2.purs | 40 - stdlib/lib/Data/FunctorWithIndex.purs | 93 -- stdlib/lib/Data/Generic/Rep.purs | 62 - stdlib/lib/Data/HeytingAlgebra.purs | 171 -- stdlib/lib/Data/HeytingAlgebra/Generic.purs | 70 - stdlib/lib/Data/Identity.purs | 72 - stdlib/lib/Data/Int.purs | 257 --- stdlib/lib/Data/Int/Bits.purs | 37 - stdlib/lib/Data/Lazy.purs | 142 -- stdlib/lib/Data/List.purs | 826 ---------- stdlib/lib/Data/List/Internal.purs | 63 - stdlib/lib/Data/List/Lazy.purs | 780 ---------- stdlib/lib/Data/List/Lazy/NonEmpty.purs | 88 -- stdlib/lib/Data/List/Lazy/Types.purs | 295 ---- stdlib/lib/Data/List/NonEmpty.purs | 307 ---- stdlib/lib/Data/List/Partial.purs | 30 - stdlib/lib/Data/List/Types.purs | 264 ---- stdlib/lib/Data/List/ZipList.purs | 66 - stdlib/lib/Data/Map.purs | 65 - stdlib/lib/Data/Map/Gen.purs | 24 - stdlib/lib/Data/Map/Internal.purs | 988 ------------ stdlib/lib/Data/Maybe.purs | 312 ---- stdlib/lib/Data/Maybe/First.purs | 68 - stdlib/lib/Data/Maybe/Last.purs | 67 - stdlib/lib/Data/Monoid.purs | 120 -- stdlib/lib/Data/Monoid/Additive.purs | 44 - stdlib/lib/Data/Monoid/Alternate.purs | 60 - stdlib/lib/Data/Monoid/Conj.purs | 51 - stdlib/lib/Data/Monoid/Disj.purs | 51 - stdlib/lib/Data/Monoid/Dual.purs | 44 - stdlib/lib/Data/Monoid/Endo.purs | 30 - stdlib/lib/Data/Monoid/Generic.purs | 27 - stdlib/lib/Data/Monoid/Multiplicative.purs | 44 - stdlib/lib/Data/NaturalTransformation.purs | 20 - stdlib/lib/Data/Newtype.purs | 308 ---- stdlib/lib/Data/NonEmpty.purs | 174 --- stdlib/lib/Data/Number.purs | 363 ----- stdlib/lib/Data/Number/Approximate.purs | 95 -- stdlib/lib/Data/Number/Format.purs | 76 - stdlib/lib/Data/Op.purs | 22 - stdlib/lib/Data/Ord.purs | 264 ---- stdlib/lib/Data/Ord/Down.purs | 26 - stdlib/lib/Data/Ord/Generic.purs | 39 - stdlib/lib/Data/Ord/Max.purs | 29 - stdlib/lib/Data/Ord/Min.purs | 29 - stdlib/lib/Data/Ordering.purs | 36 - stdlib/lib/Data/Predicate.purs | 18 - stdlib/lib/Data/Profunctor.purs | 44 - stdlib/lib/Data/Profunctor/Choice.purs | 83 - stdlib/lib/Data/Profunctor/Closed.purs | 12 - stdlib/lib/Data/Profunctor/Cochoice.purs | 9 - stdlib/lib/Data/Profunctor/Costrong.purs | 9 - stdlib/lib/Data/Profunctor/Join.purs | 28 - stdlib/lib/Data/Profunctor/Split.purs | 39 - stdlib/lib/Data/Profunctor/Star.purs | 80 - stdlib/lib/Data/Profunctor/Strong.purs | 80 - stdlib/lib/Data/Reflectable.purs | 57 - stdlib/lib/Data/Ring.purs | 78 - stdlib/lib/Data/Ring/Generic.purs | 24 - stdlib/lib/Data/Semigroup.purs | 84 - stdlib/lib/Data/Semigroup/First.purs | 40 - stdlib/lib/Data/Semigroup/Foldable.purs | 178 --- stdlib/lib/Data/Semigroup/Generic.purs | 31 - stdlib/lib/Data/Semigroup/Last.purs | 40 - stdlib/lib/Data/Semigroup/Traversable.purs | 72 - stdlib/lib/Data/Semiring.purs | 140 -- stdlib/lib/Data/Semiring/Generic.purs | 51 - stdlib/lib/Data/Set.purs | 188 --- stdlib/lib/Data/Set/NonEmpty.purs | 163 -- stdlib/lib/Data/Show.purs | 97 -- stdlib/lib/Data/Show/Generic.purs | 57 - stdlib/lib/Data/String.purs | 10 - stdlib/lib/Data/String/CaseInsensitive.purs | 22 - stdlib/lib/Data/String/CodePoints.purs | 436 ------ stdlib/lib/Data/String/CodeUnits.purs | 332 ---- stdlib/lib/Data/String/Common.purs | 96 -- stdlib/lib/Data/String/Gen.purs | 43 - stdlib/lib/Data/String/NonEmpty.purs | 9 - .../Data/String/NonEmpty/CaseInsensitive.purs | 22 - .../lib/Data/String/NonEmpty/CodePoints.purs | 138 -- .../lib/Data/String/NonEmpty/CodeUnits.purs | 308 ---- stdlib/lib/Data/String/NonEmpty/Internal.purs | 232 --- stdlib/lib/Data/String/Pattern.purs | 33 - stdlib/lib/Data/String/Regex.purs | 131 -- stdlib/lib/Data/String/Regex/Flags.purs | 129 -- stdlib/lib/Data/String/Regex/Unsafe.purs | 14 - stdlib/lib/Data/String/Unsafe.purs | 15 - stdlib/lib/Data/Symbol.purs | 24 - stdlib/lib/Data/Traversable.purs | 257 --- stdlib/lib/Data/Traversable/Accum.purs | 5 - .../lib/Data/Traversable/Accum/Internal.purs | 44 - stdlib/lib/Data/TraversableWithIndex.purs | 213 --- stdlib/lib/Data/Tuple.purs | 135 -- stdlib/lib/Data/Tuple/Nested.purs | 294 ---- stdlib/lib/Data/Unfoldable.purs | 103 -- stdlib/lib/Data/Unfoldable1.purs | 131 -- stdlib/lib/Data/Unit.purs | 5 - stdlib/lib/Data/Void.purs | 34 - stdlib/lib/Data/Witherable.purs | 162 -- stdlib/lib/Effect.purs | 72 - stdlib/lib/Effect/Class.purs | 19 - stdlib/lib/Effect/Class/Console.purs | 49 - stdlib/lib/Effect/Console.purs | 69 - stdlib/lib/Effect/Ref.purs | 73 - stdlib/lib/Effect/Uncurried.purs | 286 ---- stdlib/lib/Effect/Unsafe.purs | 8 - stdlib/lib/Partial.purs | 15 - stdlib/lib/Partial/Unsafe.purs | 24 - stdlib/lib/Prelude.purs | 104 -- stdlib/lib/Record/Unsafe.purs | 27 - stdlib/lib/Safe/Coerce.purs | 27 - stdlib/lib/Test/Assert.purs | 137 -- stdlib/lib/Type/Data/Boolean.purs | 66 - stdlib/lib/Type/Data/Ordering.purs | 69 - stdlib/lib/Type/Data/Symbol.purs | 35 - stdlib/lib/Type/Equality.purs | 35 - stdlib/lib/Type/Function.purs | 23 - stdlib/lib/Type/Prelude.purs | 17 - stdlib/lib/Type/Proxy.purs | 53 - stdlib/lib/Type/Row.purs | 22 - stdlib/lib/Type/Row/Homogeneous.purs | 23 - stdlib/lib/Type/RowList.purs | 82 - stdlib/lib/Unsafe/Coerce.purs | 27 - stdlib/lib/WASI.purs | 102 -- stdlib/lib/WASI/Clock.purs | 14 - stdlib/lib/WASI/Console.purs | 33 - stdlib/lib/WASI/FileSystem.purs | 270 ---- stdlib/lib/WASI/IO.purs | 67 - stdlib/lib/WASI/Network.purs | 130 -- stdlib/lib/WASI/Process.purs | 13 - stdlib/lib/WASI/Random.purs | 16 - stdlib/lib/WASI/Resource.purs | 14 - stdlib/lib/trusted | 218 --- tools/stdlib-conformance/pyproject.toml | 19 + .../src/stdlib_conformance/__init__.py | 1 + .../src/stdlib_conformance/__main__.py | 3 + .../src/stdlib_conformance/audit.py | 245 +++ .../src/stdlib_conformance/cli.py | 23 + .../src/stdlib_conformance/package.py | 37 + .../src/stdlib_conformance/runner.py | 106 ++ .../src/stdlib_conformance/scalar_oracle.mjs | 102 ++ 249 files changed, 1103 insertions(+), 23898 deletions(-) create mode 100644 crates/psrs-driver/src/prelude/package.rs create mode 100644 crates/psrs-driver/tests/fixtures/upstream-prelude/Symbol.js create mode 100644 docs/design/D-17-stdlib-and-conformance-boundaries.md create mode 100644 docs/implementation/stdlib/package-split-2026-10-06/report.md create mode 100644 docs/workflow/stdlib-conformance.md create mode 100644 stdlib.lock.json delete mode 100644 stdlib/lib/Control/Alt.purs delete mode 100644 stdlib/lib/Control/Alternative.purs delete mode 100644 stdlib/lib/Control/Applicative.purs delete mode 100644 stdlib/lib/Control/Apply.purs delete mode 100644 stdlib/lib/Control/Biapplicative.purs delete mode 100644 stdlib/lib/Control/Biapply.purs delete mode 100644 stdlib/lib/Control/Bind.purs delete mode 100644 stdlib/lib/Control/Category.purs delete mode 100644 stdlib/lib/Control/Comonad.purs delete mode 100644 stdlib/lib/Control/Extend.purs delete mode 100644 stdlib/lib/Control/Lazy.purs delete mode 100644 stdlib/lib/Control/Monad.purs delete mode 100644 stdlib/lib/Control/Monad/Gen.purs delete mode 100644 stdlib/lib/Control/Monad/Gen/Class.purs delete mode 100644 stdlib/lib/Control/Monad/Gen/Common.purs delete mode 100644 stdlib/lib/Control/Monad/Rec/Class.purs delete mode 100644 stdlib/lib/Control/Monad/ST.purs delete mode 100644 stdlib/lib/Control/Monad/ST/Class.purs delete mode 100644 stdlib/lib/Control/Monad/ST/Global.purs delete mode 100644 stdlib/lib/Control/Monad/ST/Internal.purs delete mode 100644 stdlib/lib/Control/Monad/ST/Ref.purs delete mode 100644 stdlib/lib/Control/Monad/ST/Uncurried.purs delete mode 100644 stdlib/lib/Control/MonadPlus.purs delete mode 100644 stdlib/lib/Control/Plus.purs delete mode 100644 stdlib/lib/Control/Semigroupoid.purs delete mode 100644 stdlib/lib/Data/Array.purs delete mode 100644 stdlib/lib/Data/Array/NonEmpty.purs delete mode 100644 stdlib/lib/Data/Array/NonEmpty/Internal.purs delete mode 100644 stdlib/lib/Data/Array/Partial.purs delete mode 100644 stdlib/lib/Data/Array/ST.purs delete mode 100644 stdlib/lib/Data/Array/ST/Iterator.purs delete mode 100644 stdlib/lib/Data/Array/ST/Partial.purs delete mode 100644 stdlib/lib/Data/Bifoldable.purs delete mode 100644 stdlib/lib/Data/Bifunctor.purs delete mode 100644 stdlib/lib/Data/Bifunctor/Join.purs delete mode 100644 stdlib/lib/Data/Bitraversable.purs delete mode 100644 stdlib/lib/Data/Boolean.purs delete mode 100644 stdlib/lib/Data/BooleanAlgebra.purs delete mode 100644 stdlib/lib/Data/Bounded.purs delete mode 100644 stdlib/lib/Data/Bounded/Generic.purs delete mode 100644 stdlib/lib/Data/Char.purs delete mode 100644 stdlib/lib/Data/Char/Gen.purs delete mode 100644 stdlib/lib/Data/CommutativeRing.purs delete mode 100644 stdlib/lib/Data/Compactable.purs delete mode 100644 stdlib/lib/Data/Comparison.purs delete mode 100644 stdlib/lib/Data/Const.purs delete mode 100644 stdlib/lib/Data/Decidable.purs delete mode 100644 stdlib/lib/Data/Decide.purs delete mode 100644 stdlib/lib/Data/Distributive.purs delete mode 100644 stdlib/lib/Data/Divide.purs delete mode 100644 stdlib/lib/Data/Divisible.purs delete mode 100644 stdlib/lib/Data/DivisionRing.purs delete mode 100644 stdlib/lib/Data/Either.purs delete mode 100644 stdlib/lib/Data/Either/Inject.purs delete mode 100644 stdlib/lib/Data/Either/Nested.purs delete mode 100644 stdlib/lib/Data/Enum.purs delete mode 100644 stdlib/lib/Data/Enum/Gen.purs delete mode 100644 stdlib/lib/Data/Enum/Generic.purs delete mode 100644 stdlib/lib/Data/Eq.purs delete mode 100644 stdlib/lib/Data/Eq/Generic.purs delete mode 100644 stdlib/lib/Data/Equivalence.purs delete mode 100644 stdlib/lib/Data/EuclideanRing.purs delete mode 100644 stdlib/lib/Data/Exists.purs delete mode 100644 stdlib/lib/Data/Field.purs delete mode 100644 stdlib/lib/Data/Filterable.purs delete mode 100644 stdlib/lib/Data/Foldable.purs delete mode 100644 stdlib/lib/Data/FoldableWithIndex.purs delete mode 100644 stdlib/lib/Data/Function.purs delete mode 100644 stdlib/lib/Data/Function/Uncurried.purs delete mode 100644 stdlib/lib/Data/Functor.purs delete mode 100644 stdlib/lib/Data/Functor/App.purs delete mode 100644 stdlib/lib/Data/Functor/Clown.purs delete mode 100644 stdlib/lib/Data/Functor/Compose.purs delete mode 100644 stdlib/lib/Data/Functor/Contravariant.purs delete mode 100644 stdlib/lib/Data/Functor/Coproduct.purs delete mode 100644 stdlib/lib/Data/Functor/Coproduct/Inject.purs delete mode 100644 stdlib/lib/Data/Functor/Coproduct/Nested.purs delete mode 100644 stdlib/lib/Data/Functor/Costar.purs delete mode 100644 stdlib/lib/Data/Functor/Flip.purs delete mode 100644 stdlib/lib/Data/Functor/Invariant.purs delete mode 100644 stdlib/lib/Data/Functor/Joker.purs delete mode 100644 stdlib/lib/Data/Functor/Product.purs delete mode 100644 stdlib/lib/Data/Functor/Product/Nested.purs delete mode 100644 stdlib/lib/Data/Functor/Product2.purs delete mode 100644 stdlib/lib/Data/FunctorWithIndex.purs delete mode 100644 stdlib/lib/Data/Generic/Rep.purs delete mode 100644 stdlib/lib/Data/HeytingAlgebra.purs delete mode 100644 stdlib/lib/Data/HeytingAlgebra/Generic.purs delete mode 100644 stdlib/lib/Data/Identity.purs delete mode 100644 stdlib/lib/Data/Int.purs delete mode 100644 stdlib/lib/Data/Int/Bits.purs delete mode 100644 stdlib/lib/Data/Lazy.purs delete mode 100644 stdlib/lib/Data/List.purs delete mode 100644 stdlib/lib/Data/List/Internal.purs delete mode 100644 stdlib/lib/Data/List/Lazy.purs delete mode 100644 stdlib/lib/Data/List/Lazy/NonEmpty.purs delete mode 100644 stdlib/lib/Data/List/Lazy/Types.purs delete mode 100644 stdlib/lib/Data/List/NonEmpty.purs delete mode 100644 stdlib/lib/Data/List/Partial.purs delete mode 100644 stdlib/lib/Data/List/Types.purs delete mode 100644 stdlib/lib/Data/List/ZipList.purs delete mode 100644 stdlib/lib/Data/Map.purs delete mode 100644 stdlib/lib/Data/Map/Gen.purs delete mode 100644 stdlib/lib/Data/Map/Internal.purs delete mode 100644 stdlib/lib/Data/Maybe.purs delete mode 100644 stdlib/lib/Data/Maybe/First.purs delete mode 100644 stdlib/lib/Data/Maybe/Last.purs delete mode 100644 stdlib/lib/Data/Monoid.purs delete mode 100644 stdlib/lib/Data/Monoid/Additive.purs delete mode 100644 stdlib/lib/Data/Monoid/Alternate.purs delete mode 100644 stdlib/lib/Data/Monoid/Conj.purs delete mode 100644 stdlib/lib/Data/Monoid/Disj.purs delete mode 100644 stdlib/lib/Data/Monoid/Dual.purs delete mode 100644 stdlib/lib/Data/Monoid/Endo.purs delete mode 100644 stdlib/lib/Data/Monoid/Generic.purs delete mode 100644 stdlib/lib/Data/Monoid/Multiplicative.purs delete mode 100644 stdlib/lib/Data/NaturalTransformation.purs delete mode 100644 stdlib/lib/Data/Newtype.purs delete mode 100644 stdlib/lib/Data/NonEmpty.purs delete mode 100644 stdlib/lib/Data/Number.purs delete mode 100644 stdlib/lib/Data/Number/Approximate.purs delete mode 100644 stdlib/lib/Data/Number/Format.purs delete mode 100644 stdlib/lib/Data/Op.purs delete mode 100644 stdlib/lib/Data/Ord.purs delete mode 100644 stdlib/lib/Data/Ord/Down.purs delete mode 100644 stdlib/lib/Data/Ord/Generic.purs delete mode 100644 stdlib/lib/Data/Ord/Max.purs delete mode 100644 stdlib/lib/Data/Ord/Min.purs delete mode 100644 stdlib/lib/Data/Ordering.purs delete mode 100644 stdlib/lib/Data/Predicate.purs delete mode 100644 stdlib/lib/Data/Profunctor.purs delete mode 100644 stdlib/lib/Data/Profunctor/Choice.purs delete mode 100644 stdlib/lib/Data/Profunctor/Closed.purs delete mode 100644 stdlib/lib/Data/Profunctor/Cochoice.purs delete mode 100644 stdlib/lib/Data/Profunctor/Costrong.purs delete mode 100644 stdlib/lib/Data/Profunctor/Join.purs delete mode 100644 stdlib/lib/Data/Profunctor/Split.purs delete mode 100644 stdlib/lib/Data/Profunctor/Star.purs delete mode 100644 stdlib/lib/Data/Profunctor/Strong.purs delete mode 100644 stdlib/lib/Data/Reflectable.purs delete mode 100644 stdlib/lib/Data/Ring.purs delete mode 100644 stdlib/lib/Data/Ring/Generic.purs delete mode 100644 stdlib/lib/Data/Semigroup.purs delete mode 100644 stdlib/lib/Data/Semigroup/First.purs delete mode 100644 stdlib/lib/Data/Semigroup/Foldable.purs delete mode 100644 stdlib/lib/Data/Semigroup/Generic.purs delete mode 100644 stdlib/lib/Data/Semigroup/Last.purs delete mode 100644 stdlib/lib/Data/Semigroup/Traversable.purs delete mode 100644 stdlib/lib/Data/Semiring.purs delete mode 100644 stdlib/lib/Data/Semiring/Generic.purs delete mode 100644 stdlib/lib/Data/Set.purs delete mode 100644 stdlib/lib/Data/Set/NonEmpty.purs delete mode 100644 stdlib/lib/Data/Show.purs delete mode 100644 stdlib/lib/Data/Show/Generic.purs delete mode 100644 stdlib/lib/Data/String.purs delete mode 100644 stdlib/lib/Data/String/CaseInsensitive.purs delete mode 100644 stdlib/lib/Data/String/CodePoints.purs delete mode 100644 stdlib/lib/Data/String/CodeUnits.purs delete mode 100644 stdlib/lib/Data/String/Common.purs delete mode 100644 stdlib/lib/Data/String/Gen.purs delete mode 100644 stdlib/lib/Data/String/NonEmpty.purs delete mode 100644 stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs delete mode 100644 stdlib/lib/Data/String/NonEmpty/CodePoints.purs delete mode 100644 stdlib/lib/Data/String/NonEmpty/CodeUnits.purs delete mode 100644 stdlib/lib/Data/String/NonEmpty/Internal.purs delete mode 100644 stdlib/lib/Data/String/Pattern.purs delete mode 100644 stdlib/lib/Data/String/Regex.purs delete mode 100644 stdlib/lib/Data/String/Regex/Flags.purs delete mode 100644 stdlib/lib/Data/String/Regex/Unsafe.purs delete mode 100644 stdlib/lib/Data/String/Unsafe.purs delete mode 100644 stdlib/lib/Data/Symbol.purs delete mode 100644 stdlib/lib/Data/Traversable.purs delete mode 100644 stdlib/lib/Data/Traversable/Accum.purs delete mode 100644 stdlib/lib/Data/Traversable/Accum/Internal.purs delete mode 100644 stdlib/lib/Data/TraversableWithIndex.purs delete mode 100644 stdlib/lib/Data/Tuple.purs delete mode 100644 stdlib/lib/Data/Tuple/Nested.purs delete mode 100644 stdlib/lib/Data/Unfoldable.purs delete mode 100644 stdlib/lib/Data/Unfoldable1.purs delete mode 100644 stdlib/lib/Data/Unit.purs delete mode 100644 stdlib/lib/Data/Void.purs delete mode 100644 stdlib/lib/Data/Witherable.purs delete mode 100644 stdlib/lib/Effect.purs delete mode 100644 stdlib/lib/Effect/Class.purs delete mode 100644 stdlib/lib/Effect/Class/Console.purs delete mode 100644 stdlib/lib/Effect/Console.purs delete mode 100644 stdlib/lib/Effect/Ref.purs delete mode 100644 stdlib/lib/Effect/Uncurried.purs delete mode 100644 stdlib/lib/Effect/Unsafe.purs delete mode 100644 stdlib/lib/Partial.purs delete mode 100644 stdlib/lib/Partial/Unsafe.purs delete mode 100644 stdlib/lib/Prelude.purs delete mode 100644 stdlib/lib/Record/Unsafe.purs delete mode 100644 stdlib/lib/Safe/Coerce.purs delete mode 100644 stdlib/lib/Test/Assert.purs delete mode 100644 stdlib/lib/Type/Data/Boolean.purs delete mode 100644 stdlib/lib/Type/Data/Ordering.purs delete mode 100644 stdlib/lib/Type/Data/Symbol.purs delete mode 100644 stdlib/lib/Type/Equality.purs delete mode 100644 stdlib/lib/Type/Function.purs delete mode 100644 stdlib/lib/Type/Prelude.purs delete mode 100644 stdlib/lib/Type/Proxy.purs delete mode 100644 stdlib/lib/Type/Row.purs delete mode 100644 stdlib/lib/Type/Row/Homogeneous.purs delete mode 100644 stdlib/lib/Type/RowList.purs delete mode 100644 stdlib/lib/Unsafe/Coerce.purs delete mode 100644 stdlib/lib/WASI.purs delete mode 100644 stdlib/lib/WASI/Clock.purs delete mode 100644 stdlib/lib/WASI/Console.purs delete mode 100644 stdlib/lib/WASI/FileSystem.purs delete mode 100644 stdlib/lib/WASI/IO.purs delete mode 100644 stdlib/lib/WASI/Network.purs delete mode 100644 stdlib/lib/WASI/Process.purs delete mode 100644 stdlib/lib/WASI/Random.purs delete mode 100644 stdlib/lib/WASI/Resource.purs delete mode 100644 stdlib/lib/trusted create mode 100644 tools/stdlib-conformance/pyproject.toml create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/__init__.py create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/__main__.py create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/audit.py create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/cli.py create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/package.py create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/runner.py create mode 100644 tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs diff --git a/.gitignore b/.gitignore index 1fc17ab8..720459a2 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,6 @@ .DS_Store node_modules/ dist/ + +__pycache__/ +*.egg-info/ diff --git a/AGENTS.md b/AGENTS.md index 39e96e8b..2cdf61cf 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -24,8 +24,11 @@ uncommitted work. the change at the right layer. - Review the local diff and run the validation relevant to the files changed. -### Standard-library vendoring +### Standard-library package +- Keep official library sources and case data in the independent `psrs-stdlib` + repository. The compiler consumes `stdlib.lock.json`; use `PSRS_STDLIB_ROOT` + only for an explicit development package. - Follow [the stdlib source-fidelity contract](docs/workflow/stdlib-vendoring.md) when importing or changing official library sources. - Pin upstream package versions and commits. Preserve official pure functions, @@ -45,6 +48,10 @@ uncommitted work. APIs execute, that every declaration survives backend lowering, or that FFI behavior agrees with its contract. +- Use the standalone [conformance commands](docs/workflow/stdlib-conformance.md) + for source and runtime comparisons. The tool consumes executable and package + paths; it must not depend on compiler-internal representations. + ### Commit granularity - Group a commit by topic, not by file type. Code, tests, and the design or diff --git a/Cargo.lock b/Cargo.lock index a03f0935..5d284311 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -270,6 +270,8 @@ dependencies = [ "psrs-syntax", "psrs-thir", "psrs-typecheck", + "serde", + "serde_json", ] [[package]] diff --git a/README.md b/README.md index ff64a198..8550d17a 100644 --- a/README.md +++ b/README.md @@ -25,9 +25,13 @@ cargo run -- check-program-kinds examples/basic.purs cargo run -- dump mir examples/basic.purs ``` +The local default expects `../psrs-stdlib` at the revision/content recorded in +`stdlib.lock.json`. Set `PSRS_STDLIB_ROOT` for an explicit development package. +See [package and conformance setup](docs/workflow/stdlib-conformance.md). + `build ...` resolves and links every listed module with the standard -library from `stdlib/lib` and writes the artifact. `wat ...` renders -the text form. `dump ` prints an intermediate IR for +library from the locked `psrs-stdlib` package and writes the artifact. +`wat ...` renders the text form. `dump ` prints an intermediate IR for debugging. A selected `main :: Int` returns its value as the process exit code. A selected `main :: Effect Unit` runs that action once and returns 0; a trap still propagates. @@ -76,7 +80,7 @@ The compiler currently: functional dependencies**, then passes dictionaries through to Wasm — a method reached through a superclass constraint returns the right value under `wasmtime`, as does a call through a constrained function argument; -- loads the PureScript standard library from [`stdlib/lib`](stdlib/lib) on disk, +- loads the PureScript standard library from the locked `psrs-stdlib` package, exposing console, clock, random, process arguments and environment, filesystem, and sockets over WASI. @@ -114,8 +118,9 @@ Verified working subsets, each with source tests and Wasmtime execution: scalar, string, list, flags, handle, and variant shapes ([canonical ABI](docs/design/backend/wasm/canonical-abi-and-wit.md)), and the synthesized aggregate fixtures validate but do not yet execute; -- **the standard library** — `stdlib/lib` holds the vendored `v0.15.16` core - libraries (211 modules). A module the compiler owns, such as `Safe.Coerce`, +- **the standard library** — the independent `psrs-stdlib` package holds the + pinned official core libraries (215 source modules). A module the compiler owns, + such as `Safe.Coerce`, resolves through its primitive interface rather than the vendored file, which stays faithful to upstream; `Unsafe.Coerce.unsafeCoerce` has no interface yet and is a recorded gap. @@ -136,7 +141,7 @@ Verified working subsets, each with source tests and Wasmtime execution: | `psrs-desugar` | Operator desugaring while preserving HIR. | | `psrs-core` | Typed Core and its HIR lowering. | | `psrs-backend` | CC IR, MIR/CFG, structured Wasm encoding, WIT/ABI lowering, validation, and WAT. | -| `psrs-driver` | Wires the compiler passes together and loads `stdlib/lib`. | +| `psrs-driver` | Wires the compiler passes together and loads the locked `psrs-stdlib` package. | | `psrs-cli` | Source inspection, `build`, `wat`, and `dump` commands. | The architecture defines twelve major passes across six long-lived IR families; diff --git a/crates/psrs-cli/src/diagnose/artifacts.rs b/crates/psrs-cli/src/diagnose/artifacts.rs index 9e456fe9..8b906c02 100644 --- a/crates/psrs-cli/src/diagnose/artifacts.rs +++ b/crates/psrs-cli/src/diagnose/artifacts.rs @@ -174,22 +174,7 @@ fn trace_replay_argv(paths: &[String]) -> Option> { } pub(super) fn trusted_stdlib_fingerprint() -> Result { - let root = PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../../stdlib/lib"); - let trusted_path = root.join("trusted"); - let trusted = fs::read_to_string(&trusted_path) - .map_err(|error| format!("{}: {error}", trusted_path.display()))?; - let mut bytes = trusted.as_bytes().to_vec(); - for name in trusted - .lines() - .map(str::trim) - .filter(|line| !line.is_empty() && !line.starts_with('#')) - { - let path = root.join(format!("{}.purs", name.replace('.', "/"))); - let text = fs::read(&path).map_err(|error| format!("{}: {error}", path.display()))?; - bytes.extend_from_slice(path.to_string_lossy().as_bytes()); - bytes.extend_from_slice(&text); - } - Ok(hash_bytes(&bytes)) + Ok(psrs_driver::standard_library_info()?.source_fingerprint) } pub(super) fn compiler_revision() -> CompilerRevision { diff --git a/crates/psrs-driver/Cargo.toml b/crates/psrs-driver/Cargo.toml index a14281fa..d31da7c6 100644 --- a/crates/psrs-driver/Cargo.toml +++ b/crates/psrs-driver/Cargo.toml @@ -24,3 +24,5 @@ psrs-span.workspace = true psrs-syntax.workspace = true psrs-thir.workspace = true psrs-typecheck.workspace = true +serde = { version = "1", features = ["derive"] } +serde_json = "1" diff --git a/crates/psrs-driver/src/lib.rs b/crates/psrs-driver/src/lib.rs index 44e6e377..391c18fb 100644 --- a/crates/psrs-driver/src/lib.rs +++ b/crates/psrs-driver/src/lib.rs @@ -3,6 +3,7 @@ use psrs_span::{SourceFile, TextRange}; mod diagnostics; mod loader; mod prelude; +pub use prelude::{StandardLibraryInfo, standard_library_info}; mod program; pub use diagnostics::{CompilationReport, FrontendPassTrace, IrDumpArtifacts, PartialIrDumps}; diff --git a/crates/psrs-driver/src/loader.rs b/crates/psrs-driver/src/loader.rs index 6705614b..d92c375d 100644 --- a/crates/psrs-driver/src/loader.rs +++ b/crates/psrs-driver/src/loader.rs @@ -1,6 +1,6 @@ //! Filesystem discovery for the transitive source graph. //! -//! The standard library is read from `stdlib/lib`; user modules are discovered +//! The standard library is read from the locked `psrs-stdlib` package; user modules are discovered //! from the filesystem. Given the entry files, this loader scans their //! directories for `.purs` files, indexes them by declared module name, and //! follows the `import` graph until it closes. Modules supplied by the diff --git a/crates/psrs-driver/src/prelude.rs b/crates/psrs-driver/src/prelude.rs index a82d88a6..a6369c1d 100644 --- a/crates/psrs-driver/src/prelude.rs +++ b/crates/psrs-driver/src/prelude.rs @@ -1,9 +1,10 @@ //! The on-disk PureScript standard library. //! -//! Sources are read from `stdlib/lib` at runtime (not embedded). `lib/trusted` -//! names the modules that form the trusted prefix, in order. The directory is -//! resolved from the crate location first, so `cargo test` and the CLI do not -//! depend on the process current directory. +//! Sources come from the locked external `psrs-stdlib` package at runtime. +//! `PSRS_STDLIB_ROOT` explicitly selects an unlocked development package. + +mod package; +pub use package::StandardLibraryInfo; use std::collections::HashSet; use std::collections::VecDeque; @@ -21,9 +22,14 @@ pub(crate) struct ModuleSource { } struct Library { + info: StandardLibraryInfo, modules: Vec, } +pub fn standard_library_info() -> Result { + Ok(load()?.info.clone()) +} + pub(crate) fn sources() -> Result<&'static [ModuleSource], String> { Ok(&load()?.modules) } @@ -86,8 +92,8 @@ fn load() -> Result<&'static Library, String> { } fn read_library() -> Result { - let root = find_stdlib_root()?; - let lib = root.join("lib"); + let info = package::select()?; + let lib = info.root.join("lib"); let names = read_trusted_names(&lib.join("trusted"))?; let mut modules = Vec::with_capacity(names.len()); for name in names { @@ -129,7 +135,10 @@ fn read_library() -> Result { .collect(), }); } - Ok(Library { modules }) + if package::fingerprint(&info.root)? != info.source_fingerprint { + return Err("standard-library package changed during loading".into()); + } + Ok(Library { modules, info }) } fn read_trusted_names(path: &Path) -> Result, String> { @@ -171,56 +180,3 @@ fn module_file(lib: &Path, module_name: &str) -> PathBuf { path.push(format!("{file_stem}.purs")); path } - -fn find_stdlib_root() -> Result { - let mut tried = Vec::new(); - for candidate in stdlib_candidates() { - if is_stdlib_root(&candidate) { - return candidate - .canonicalize() - .map_err(|error| format!("{}: {error}", candidate.display())); - } - if !tried.iter().any(|existing| existing == &candidate) { - tried.push(candidate); - } - } - Err(format!( - "could not find the standard library (expected stdlib/lib/trusted and stdlib/lib/Prelude.purs); looked in {}", - tried - .iter() - .map(|path| path.display().to_string()) - .collect::>() - .join(", ") - )) -} - -fn is_stdlib_root(path: &Path) -> bool { - path.join("lib/trusted").is_file() && path.join("lib/Prelude.purs").is_file() -} - -fn stdlib_candidates() -> Vec { - let mut candidates = Vec::new(); - let crate_dir = PathBuf::from(env!("CARGO_MANIFEST_DIR")); - // Anchored at this crate: `crates/psrs-driver` -> repository `stdlib/`. - candidates.push(crate_dir.join("../../stdlib")); - push_ancestor_stdlibs(&crate_dir, &mut candidates); - if let Ok(current) = std::env::current_dir() { - push_ancestor_stdlibs(¤t, &mut candidates); - } - if let Ok(executable) = std::env::current_exe() - && let Some(parent) = executable.parent() - { - push_ancestor_stdlibs(parent, &mut candidates); - } - candidates -} - -fn push_ancestor_stdlibs(start: &Path, candidates: &mut Vec) { - let mut directory = start.to_path_buf(); - loop { - candidates.push(directory.join("stdlib")); - if !directory.pop() { - break; - } - } -} diff --git a/crates/psrs-driver/src/prelude/package.rs b/crates/psrs-driver/src/prelude/package.rs new file mode 100644 index 00000000..326d9a78 --- /dev/null +++ b/crates/psrs-driver/src/prelude/package.rs @@ -0,0 +1,269 @@ +//! Package selection and portable content identity for the external stdlib. +use std::path::{Path, PathBuf}; + +use serde::Deserialize; + +#[derive(Clone, Debug)] +pub struct StandardLibraryInfo { + pub root: PathBuf, + pub source_fingerprint: String, + /// Absent for an explicit development override. + pub locked_revision: Option, +} + +#[derive(Deserialize)] +#[serde(deny_unknown_fields)] +struct Lock { + schema_version: u32, + path: PathBuf, + revision: String, + source_fingerprint: String, +} + +pub(super) fn select() -> Result { + if let Some(root) = std::env::var_os("PSRS_STDLIB_ROOT") { + return inspect(Path::new(&root), None); + } + let lock_path = Path::new(env!("CARGO_MANIFEST_DIR")).join("../../stdlib.lock.json"); + select_locked(&lock_path) +} + +fn select_locked(lock_path: &Path) -> Result { + let lock: Lock = serde_json::from_slice(&read(lock_path)?) + .map_err(|error| format!("{}: {error}", lock_path.display()))?; + if lock.schema_version != 1 + || lock.revision.len() != 40 + || !lock.revision.bytes().all(|byte| byte.is_ascii_hexdigit()) + { + return Err(format!( + "{}: unsupported or invalid stdlib lock", + lock_path.display() + )); + } + let info = inspect( + &lock_path.parent().unwrap().join(lock.path), + Some(lock.revision), + )?; + if info.source_fingerprint != lock.source_fingerprint { + return Err(format!( + "{}: standard-library content differs from the lock; use PSRS_STDLIB_ROOT for an explicit development override", + info.root.display() + )); + } + Ok(info) +} + +fn inspect(root: &Path, revision: Option) -> Result { + let root = root + .canonicalize() + .map_err(|error| format!("{}: {error}", root.display()))?; + let manifest: serde_json::Value = serde_json::from_slice(&read(&root.join("manifest.json"))?) + .map_err(|error| format!("{}: {error}", root.display()))?; + // Protocol versions are compiler contracts, not assumptions inferred from source names. + for (pointer, expected) in [ + ("/schema_version", serde_json::json!(1)), + ("/name", serde_json::json!("psrs-stdlib")), + ("/source_root", serde_json::json!("lib")), + ("/trusted_modules", serde_json::json!("lib/trusted")), + ("/upstream_lock", serde_json::json!("upstream-lock.json")), + ( + "/compiler_contract/primitive_binding_protocol", + serde_json::json!(1), + ), + ( + "/compiler_contract/string_semantics", + serde_json::json!("unicode-scalar-utf8"), + ), + ( + "/compiler_contract/int_semantics", + serde_json::json!("signed-i32"), + ), + ] { + if manifest.pointer(pointer) != Some(&expected) { + return Err(format!( + "{}: unsupported stdlib manifest field {pointer}", + root.display() + )); + } + } + // Required metadata must exist even in development mode. + read(&root.join("lib/trusted"))?; + read(&root.join("lib/Prelude.purs"))?; + read(&root.join("upstream-lock.json"))?; + let source_fingerprint = fingerprint(&root)?; + Ok(StandardLibraryInfo { + root, + source_fingerprint, + locked_revision: revision, + }) +} + +/// FNV-1a content identity, versioned and independent of checkout paths. +/// Covers all files under lib/ and conformance/, plus both package manifests. +/// This is a reproducibility identifier, not a cryptographic integrity claim. +pub(super) fn fingerprint(root: &Path) -> Result { + let mut paths = vec![ + PathBuf::from("manifest.json"), + PathBuf::from("upstream-lock.json"), + ]; + collect(root, Path::new("lib"), &mut paths)?; + collect(root, Path::new("conformance"), &mut paths)?; + paths.sort(); + let mut hash = 0xcbf29ce484222325_u64; + let mut feed = |bytes: &[u8]| { + for byte in bytes { + hash = (hash ^ u64::from(*byte)).wrapping_mul(0x100000001b3); + } + }; + feed(b"psrs-stdlib-content-v1\0"); + for path in paths { + let bytes = read(&root.join(&path))?; + let name = path + .components() + .map(|part| { + part.as_os_str() + .to_str() + .ok_or("stdlib contains a non-UTF-8 path") + }) + .collect::, _>>()? + .join("/"); + feed(name.as_bytes()); + feed(&[0]); + feed(&(bytes.len() as u64).to_le_bytes()); + feed(&bytes); + } + Ok(format!("fnv1a64-v1:{hash:016x}")) +} + +fn collect(root: &Path, relative: &Path, paths: &mut Vec) -> Result<(), String> { + let path = root.join(relative); + if std::fs::symlink_metadata(&path) + .map_err(|error| error.to_string())? + .file_type() + .is_symlink() + { + return Err(format!( + "{}: stdlib package symlinks are unsupported", + path.display() + )); + } + for entry in std::fs::read_dir(&path).map_err(|error| format!("{}: {error}", path.display()))? { + let entry = entry.map_err(|error| error.to_string())?; + let kind = entry.file_type().map_err(|error| error.to_string())?; + let relative = relative.join(entry.file_name()); + if kind.is_symlink() { + return Err(format!( + "{}: stdlib package symlinks are unsupported", + entry.path().display() + )); + } else if kind.is_dir() { + collect(root, &relative, paths)?; + } else if kind.is_file() { + paths.push(relative); + } else { + return Err(format!( + "{}: expected a regular package file", + entry.path().display() + )); + } + } + Ok(()) +} + +fn read(path: &Path) -> Result, String> { + if !std::fs::symlink_metadata(path) + .map_err(|error| format!("{}: {error}", path.display()))? + .file_type() + .is_file() + { + return Err(format!( + "{}: expected a regular package file", + path.display() + )); + } + std::fs::read(path).map_err(|error| format!("{}: {error}", path.display())) +} + +#[cfg(test)] +mod tests { + use super::*; + use std::sync::atomic::{AtomicU64, Ordering}; + + struct Fixture(PathBuf); + impl Fixture { + fn new() -> Self { + static NEXT: AtomicU64 = AtomicU64::new(0); + let root = std::env::temp_dir().join(format!( + "psrs-package-{}-{}", + std::process::id(), + NEXT.fetch_add(1, Ordering::Relaxed) + )); + std::fs::create_dir_all(root.join("lib")).unwrap(); + std::fs::create_dir_all(root.join("conformance")).unwrap(); + let manifest = serde_json::json!({ + "schema_version": 1, "name": "psrs-stdlib", "source_root": "lib", + "trusted_modules": "lib/trusted", "upstream_lock": "upstream-lock.json", + "compiler_contract": {"primitive_binding_protocol": 1, + "string_semantics": "unicode-scalar-utf8", "int_semantics": "signed-i32"} + }); + std::fs::write( + root.join("manifest.json"), + serde_json::to_vec(&manifest).unwrap(), + ) + .unwrap(); + std::fs::write(root.join("upstream-lock.json"), "{}").unwrap(); + std::fs::write(root.join("lib/trusted"), "Prelude\n").unwrap(); + std::fs::write(root.join("lib/Prelude.purs"), "module Prelude where\n").unwrap(); + Self(root) + } + } + impl Drop for Fixture { + fn drop(&mut self) { + let _ = std::fs::remove_dir_all(&self.0); + } + } + + #[test] + fn package_identity_is_portable_and_covers_cases_and_extra_modules() { + let a = Fixture::new(); + let b = Fixture::new(); + let original = fingerprint(&a.0).unwrap(); + assert_eq!(original, fingerprint(&b.0).unwrap()); + std::fs::write(b.0.join("lib/Unused.purs"), "module Unused where").unwrap(); + assert_ne!(original, fingerprint(&b.0).unwrap()); + std::fs::remove_file(b.0.join("lib/Unused.purs")).unwrap(); + std::fs::write(b.0.join("conformance/cases.json"), "[]").unwrap(); + assert_ne!(original, fingerprint(&b.0).unwrap()); + } + + #[test] + fn package_without_required_protocol_is_rejected() { + let fixture = Fixture::new(); + std::fs::write(fixture.0.join("manifest.json"), b"{}").unwrap(); + let error = inspect(&fixture.0, None).unwrap_err(); + assert!( + error.contains("unsupported stdlib manifest field"), + "{error}" + ); + } + #[test] + fn locked_package_rejects_dirty_content_and_invalid_dependency_paths() { + let fixture = Fixture::new(); + let lock_path = fixture.0.join("consumer.lock.json"); + let lock = serde_json::json!({"schema_version": 1, "path": fixture.0, + "revision": "0000000000000000000000000000000000000000", + "source_fingerprint": fingerprint(&fixture.0).unwrap()}); + std::fs::write(&lock_path, serde_json::to_vec(&lock).unwrap()).unwrap(); + let selected = select_locked(&lock_path).unwrap(); + assert_eq!(selected.root, fixture.0.canonicalize().unwrap()); + assert!(selected.locked_revision.is_some()); + std::fs::write(fixture.0.join("lib/Prelude.purs"), "changed").unwrap(); + assert!( + select_locked(&lock_path) + .unwrap_err() + .contains("differs from the lock") + ); + std::fs::remove_dir_all(fixture.0.join("lib")).unwrap(); + assert!(select_locked(&lock_path).is_err()); + } +} diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index fec903ac..25f82219 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -93,21 +93,12 @@ fn primitive_foreign_bindings_match_pinned_official_scalar_observations() { include_str!("../../tests/fixtures/stdlib-scalar/Main.purs"), ), ]; - let vendor = std::path::Path::new(env!("CARGO_MANIFEST_DIR")).join("../../stdlib/lib"); - let modules = [ - "Data/Int.purs", - "Data/Int/Bits.purs", - "Data/Eq.purs", - "Data/Ring.purs", - "Data/Semiring.purs", - "Data/HeytingAlgebra.purs", - ] - .map(|path| std::fs::read_to_string(vendor.join(path)).unwrap()); + let modules = crate::prelude::sources().unwrap(); for declaration in sources[0].1.lines().skip(1) { assert!( modules .iter() - .any(|module| module.lines().any(|line| line == declaration)), + .any(|module| module.text.lines().any(|line| line == declaration)), "oracle fixture must retain the actual vendored binding: {declaration}" ); } diff --git a/crates/psrs-driver/src/tests/scalars.rs b/crates/psrs-driver/src/tests/scalars.rs index 3f21f106..204723a0 100644 --- a/crates/psrs-driver/src/tests/scalars.rs +++ b/crates/psrs-driver/src/tests/scalars.rs @@ -134,13 +134,7 @@ module Main where import Data.Int.Bits ((.&.)) main = if intEq (6 .&. 3) 2 then 0 else 1 "#; - let sources = [ - ( - "Data.Int.Bits.purs", - include_str!("../../../../stdlib/lib/Data/Int/Bits.purs"), - ), - ("Main.purs", main), - ]; + let sources = [("Main.purs", main)]; let Some(output) = super::run_program_with_wasmtime(&sources) else { eprintln!("skipping execution: wasmtime is not installed"); return; diff --git a/crates/psrs-driver/tests/fixtures/upstream-prelude/Symbol.js b/crates/psrs-driver/tests/fixtures/upstream-prelude/Symbol.js new file mode 100644 index 00000000..72041597 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/upstream-prelude/Symbol.js @@ -0,0 +1,5 @@ +// module Data.Symbol + +export const unsafeCoerce = function (arg) { + return arg; +}; diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 9d688be7..4efef3d7 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -53,6 +53,14 @@ fn purs_accepts_sources(name: &str, sources: &[SourceFile]) -> bool { /// Runs `purs` on the sources and returns its captured output. Used to compare /// diagnostic codes, not only acceptance. fn purs_sources_output(name: &str, sources: &[(&str, &str)]) -> std::process::Output { + purs_sources_with_foreign_output(name, sources, &[]) +} + +fn purs_sources_with_foreign_output( + name: &str, + sources: &[(&str, &str)], + foreign_sources: &[(&str, &str)], +) -> std::process::Output { let case_dir = std::env::temp_dir().join(format!("psrs-purs-upstream-{}-{name}", std::process::id())); let _ = std::fs::remove_dir_all(&case_dir); @@ -72,6 +80,9 @@ fn purs_sources_output(name: &str, sources: &[(&str, &str)]) -> std::process::Ou path }) .collect::>(); + for (name, source) in foreign_sources { + std::fs::write(case_dir.join(name), source).expect("write supplied official FFI fixture"); + } let output_dir = case_dir.join("output"); let output = Command::new("purs") .arg("compile") diff --git a/crates/psrs-driver/tests/upstream/symbol_reflection.rs b/crates/psrs-driver/tests/upstream/symbol_reflection.rs index 76994dd3..e1cad71a 100644 --- a/crates/psrs-driver/tests/upstream/symbol_reflection.rs +++ b/crates/psrs-driver/tests/upstream/symbol_reflection.rs @@ -6,8 +6,12 @@ fn differential_symbol_reflection_against_purs() { eprintln!("skipping: purs is not installed"); return; } - let proxy = include_str!("../../../../stdlib/lib/Type/Proxy.purs"); - let symbol = include_str!("../../../../stdlib/lib/Data/Symbol.purs"); + let root = psrs_driver::standard_library_info() + .unwrap() + .root + .join("lib"); + let proxy = std::fs::read_to_string(root.join("Type/Proxy.purs")).unwrap(); + let symbol = std::fs::read_to_string(root.join("Data/Symbol.purs")).unwrap(); let main = r#"module Main where import Data.Symbol as S import Type.Proxy (Proxy(..)) @@ -17,11 +21,19 @@ main :: String main = reflect (Proxy :: Proxy "λ😀") "#; let sources = [ - ("Proxy.purs", proxy), - ("Symbol.purs", symbol), + ("Proxy.purs", proxy.as_str()), + ("Symbol.purs", symbol.as_str()), ("Main.purs", main), ]; - let official = purs_sources_output("symbol-reflection", &sources); + // Official FFI implementation: purescript-prelude v6.0.1, f4cad0ae8106185c9ab407f43cf9abf05c256af4. + let official = purs_sources_with_foreign_output( + "symbol-reflection", + &sources, + &[( + "Symbol.js", + include_str!("../fixtures/upstream-prelude/Symbol.js"), + )], + ); assert!(official.status.success(), "{official:?}"); psrs_driver::check_program(&sources).expect("accepts official symbol reflection"); } diff --git a/docs/README.md b/docs/README.md index 24319264..1e1f94b9 100644 --- a/docs/README.md +++ b/docs/README.md @@ -28,6 +28,11 @@ measured number. baseline, locate the responsible stage contract, implement a bounded fix, and compare the same cases afterward. +- [Standard-library conformance](workflow/stdlib-conformance.md): audit pinned + upstream sources and compare explicit runtime observations. +- [Standard-library boundaries](design/D-17-stdlib-and-conformance-boundaries.md): + independent package ownership and locked compiler consumption. + ## Compiler design The [frontend design](design/frontend/README.md) groups syntax, semantic diff --git a/docs/design/D-17-stdlib-and-conformance-boundaries.md b/docs/design/D-17-stdlib-and-conformance-boundaries.md new file mode 100644 index 00000000..b9f9ac93 --- /dev/null +++ b/docs/design/D-17-stdlib-and-conformance-boundaries.md @@ -0,0 +1,76 @@ +# Standard-library package and conformance boundaries + +Matching features: [F-02](../feature/F-02-portable-programs.md) and +[F-04](../feature/F-04-compile-diagnosis.md). + +## Ownership + +`psrs-stdlib` is a separate source package and local Git repository. It owns +official library sources, exact upstream package pins and SHA-256 source hashes, +target adaptations, and library behavior cases. Its initial history is the +compiler's `stdlib/` subtree history; the move preserves source bytes. + +The compiler owns language semantics, checked foreign binding identity and type +evidence, supported binding protocols, lowering, and runtime representation. +Library source changes cannot compensate for compiler defects. Follow the +[source-fidelity contract](../workflow/stdlib-vendoring.md). + +`tools/stdlib-conformance` is a standalone Python/Node component. It compares +source inventories, evaluates pinned upstream JavaScript implementations, and +runs a compiler executable and Wasmtime. Inputs are package paths, manifests, +case data, and executable paths. It has no compiler-internal Rust dependency. +A future cargo xtask may invoke these commands without becoming their owner. + +## Package selection + +`stdlib.lock.json` records a package revision, relative local checkout path, +and portable content fingerprint. The development default is `../psrs-stdlib`; +no remote publishing or download mechanism is implied. A fresh checkout or CI +worker must provision the separate package before library-dependent checks. +Automatic CI acquisition remains pending a published source location. The default loader +rejects a content mismatch. The revision records provenance; archives do not +require Git. Content identity, rather than an unchecked Git HEAD, governs load. + +`PSRS_STDLIB_ROOT` explicitly selects an unlocked development package. An invalid +selection fails without falling back. Installed executables currently require +this variable when their build-time checkout and lock are unavailable. +The driver exposes the selected package metadata and caches the parsed sources +for the process lifetime. Changes during initial loading are rejected; restart +the process after editing a development package. + +The manifest declares binding protocol version 1, Unicode scalar/UTF-8 strings, +and signed i32 integers. Unsupported or missing protocol fields are errors. +The existing import-closure selection and compiler-provided module ownership +remain in the driver and resolver respectively. + +## Reproducible content identity + +The `fnv1a64-v1:` identifier is a reproducibility fingerprint, not a cryptographic +integrity check. Starting at FNV-1a's 64-bit offset basis, hash the bytes +`psrs-stdlib-content-v1` followed by NUL. Sort all relative file paths from +`lib/`, `conformance/`, `manifest.json`, and `upstream-lock.json`. For each, +hash its UTF-8 path, NUL, file length as unsigned 64-bit little-endian bytes, +and the exact file bytes. FNV multiplication wraps at 64 bits. Package symlinks +and special files are rejected. The upstream lock retains cryptographic hashes. + +The CLI obtains the fingerprint from the driver's selected package, including +an override. This changes the diagnosis cohort identity from the previous +absolute-path fingerprint; old and new snapshots are not the same cohort. + +## Evidence and remaining work + +Audit reports must compare the complete package set to the package's pinned +upstreams. Scalar oracle generation reads case data from the library package, +checks upstream revisions and clean checkouts, retains raw official results, +and records explicit target representation differences. + +Runtime reports identify compiler and Wasmtime binaries, input sources, package +content, generated Wasm, exact commands, timeouts, exit codes, and stdout/stderr +bytes. Compile failure, launch failure, timeout, and an observation mismatch +cannot pass. Missing Wasmtime is an error. Scalar observations cover only the +implemented bindings; they do not establish whole-library FFI correctness. + +The package manifest remains `incomplete`. A separate repository does not imply +release readiness, full compile acceptance, or complete runtime support. Future +publishing must add acquisition, license packaging, release compatibility, and +broader value-sensitive conformance evidence before claiming those properties. diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index e215ef9e..f1460fb6 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -349,7 +349,7 @@ application world, and embedding stay in [canonical ABI and WIT](canonical-abi-and-wit.md). ```text -stdlib/lib/ +psrs-stdlib/lib/ Prelude.purs the Effect interface: pure, bind, runEffect, trap Data/Function.purs const, flip, apply, applyFlipped, on, $, # Data/Semigroup.purs class Semigroup, append, <> diff --git a/docs/design/backend/wasm/wasi-platform-library.md b/docs/design/backend/wasm/wasi-platform-library.md index 509f2530..fe913a99 100644 --- a/docs/design/backend/wasm/wasi-platform-library.md +++ b/docs/design/backend/wasm/wasi-platform-library.md @@ -145,7 +145,7 @@ consolidated capability layout: `WASI.Resource`, `WASI.IO`, `WASI.Console`, | Feature | Owner | State | | --- | --- | --- | -| On-disk `stdlib/lib` and the trusted prefix | WASI-10 | Done. The driver reads `stdlib/lib/trusted`. | +| On-disk `psrs-stdlib/lib` and the trusted prefix | WASI-10 | Done. The driver reads `psrs-stdlib/lib/trusted`. | | Exported wrappers | This library, [DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md) | Every service wrapper, plus the `WASI` umbrella. Raw imports stay unexported. | | `wasi:cli/exit.exit` (`status: result`) | Not wrapped | One canonical `i32`, and still not a library wrapper. See below. | | `Effect` as `foreign import data` | [Effects](../fp/effects.md) | Trusted library binding carries the resolved constructor and operation identities. Effect lowering turns applications into generic one-parameter closures, and import wrappers come only from plans formed from checked external schemes before `Effect` erasure. | @@ -232,8 +232,8 @@ observes the trailing constant, which exists to give the entry its declared ### The platform library -The platform library is source code under `stdlib/lib`, read from disk and -resolved, type-checked, and linked like any module. `stdlib/lib/trusted` fixes +The platform library is source code under `psrs-stdlib/lib`, read from disk and +resolved, type-checked, and linked like any module. `psrs-stdlib/lib/trusted` fixes the trusted prefix order (`Prelude`, `Data.Function`, `Data.Semigroup`, `Data.Monoid`, `Data.Eq`, `Data.Ord`, `Data.Semiring`, `Data.Show`, `Effect`, `Effect.Console`, `Test.Assert`, `Data.Maybe`, `Data.Either`, `Data.Tuple`, `Data.Foldable`, `WASI.Resource`, `WASI.IO`, `WASI.Clock`, `WASI.Random`, `WASI.Console`, `WASI.Process`, `WASI.FileSystem`, `WASI.Network`, `WASI`). `Data.Function` declares the application operators and their fixities; `Data.Semigroup` @@ -383,7 +383,7 @@ Responsibilities and required entry points: encode, call `command_world` and `componentize`, validate with the target's features, and return the component and its WAT form. - The WASI library must be ordinary PureScript source resolved, type-checked, - and linked like any other module. The driver loads it from `stdlib/lib` + and linked like any other module. The driver loads it from `psrs-stdlib/lib` rather than embedding it, and defines `log`, `error`, `now`, `randomBytes`, `randomU64`, `exitWithCode`, and `arguments` over WIT imports; the portable `Prelude` must @@ -449,7 +449,7 @@ wrapped. `WASI.Process.arguments` and `WASI.Process.environment` wrap with execution tests. `WASI.Network` wraps the socket services and lowers; it has no execution test, and HTTP/TLS are not implemented, so their capability flags stay disabled in the default profile. The standard library is read from -`stdlib/lib` at runtime (`stdlib/lib/trusted` lists `Prelude`, `Data.Function`, +`psrs-stdlib/lib` at runtime (`psrs-stdlib/lib/trusted` lists `Prelude`, `Data.Function`, `Data.Semigroup`, `Data.Monoid`, `Data.Eq`, `Data.Ord`, `Data.Semiring`, `Data.Show`, `Effect`, `Effect.Console`, `Test.Assert`, `Data.Maybe`, `Data.Either`, `Data.Tuple`, `Data.Foldable`, `WASI.Resource`, `WASI.IO`, `WASI.Clock`, `WASI.Random`, `WASI.Console`, `WASI.Process`, `WASI.FileSystem`, `WASI.Network`, and `WASI` in trusted-prefix order). The driver discovers user modules from the entry files' directories (`psrs_driver::load_program_files`): it indexes sibling `.purs` diff --git a/docs/implementation/stdlib/package-split-2026-10-06/report.md b/docs/implementation/stdlib/package-split-2026-10-06/report.md new file mode 100644 index 00000000..8beb6f40 --- /dev/null +++ b/docs/implementation/stdlib/package-split-2026-10-06/report.md @@ -0,0 +1,45 @@ +# Independent stdlib package checkpoint + +The library subtree was extracted into the local `psrs-stdlib` repository with +its Git history. All 216 library files (215 `.purs` modules and `lib/trusted`) +matched the compiler copy byte for byte before that copy was removed. Package +metadata, upstream pins, conformance cases, and repository guidance were then +committed as `a08b4c8`. The compiler's `stdlib.lock.json` selects that package +revision and content fingerprint. No remote repository, push, or PR was created. + +The standalone component in `tools/stdlib-conformance` accepts package and +executable paths. Source audit and scalar cases ran against the external package. +The audit covered all 41 pinned packages: 195 identical modules, 11 modified +modules, nine platform additions, no omitted upstream modules, and no detected +direct same-argument self-recursions. These counts describe differences; they do +not approve every adaptation or prove full FFI implementation. + +Validation: + +- Package identity/protocol/dirty-content tests: three passed. +- Trusted on-disk loader: one passed after removing the compiler source copy. +- Primitive foreign tests with mandatory Wasmtime: seven passed. +- Let-constraint regressions: 14 passed. +- Official `purs` Symbol differential: one passed, using the unchanged official + `.purs` and its pinned upstream JavaScript companion (fixture trailing blank line + omitted). +- Independent official scalar oracle: 20 bindings, 46 cases; actual Wasmtime + exit 42, empty stdout and stderr. `scalar-run.json` records binaries, input + hashes, commands, package identity, Wasm hash, and observations. Signed i32 + normalization remains an explicit representation difference in the oracle. +- Invalid package overrides and incorrect exit-code goldens failed explicitly. +- CLI build, formatting, and workspace clippy with warnings denied passed. +- Python syntax compilation and Node syntax checking passed. The component + also ran successfully after copying it outside the compiler checkout and + against a Git-free archive of the locked library package. + +Full compile acceptance remains failed: `/tmp/psrs-stdlib-all.purs` reported +233 P8 library-linking diagnostics; the first was the missing target +implementation of `Control.Apply.arrayApply`. `summary.json` records this +measurement. No full workspace tests or full scoreboard were run. No roadmap +runtime figures were changed. + +Independent source acquisition for fresh checkouts/CI and remote publication +remain pending. The package's development status is incomplete. Full stdlib +compilation and value-sensitive runtime/FFI correctness remain separate open +obligations; the scalar subset is not a whole-library acceptance claim. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md new file mode 100644 index 00000000..52b32234 --- /dev/null +++ b/docs/workflow/stdlib-conformance.md @@ -0,0 +1,50 @@ +# Standard-library conformance commands + +The standalone component is in `tools/stdlib-conformance`. It requires Python +3.9 or newer; scalar oracle generation also requires Node with ES module +support. Run it directly without installing dependencies: + +```sh +export PYTHONPATH=tools/stdlib-conformance/src +python3 -m stdlib_conformance --help +``` + +A pinned complete source audit accepts the independent package and upstream +checkout directories. Supply the lock to reject a different upstream baseline: + +```sh +python3 -m stdlib_conformance audit \ + --vendor ../psrs-stdlib/lib \ + --inventory ../psrs-stdlib/upstream-lock.json \ + --upstream /private/tmp/ps-pkgs \ + --upstream /private/tmp/purescript-prelude \ + --upstream /private/tmp/psrs-stdlib-audit-20261006/upstream \ + --out /tmp/psrs-stdlib-audit +``` + +The audit produces evidence for review; completing a report does not approve +its differences. Check the actual pinned checkout locations before running. +Generate and execute the currently implemented scalar cases: + +```sh +python3 -m stdlib_conformance scalar-oracle \ + --vendor ../psrs-stdlib/lib \ + --inventory ../psrs-stdlib/upstream-lock.json \ + --cases ../psrs-stdlib/conformance/scalars.json \ + --upstream purescript-prelude=/private/tmp/purescript-prelude \ + --upstream purescript-integers=/private/tmp/ps-pkgs/purescript-integers \ + --out /tmp/psrs-stdlib-oracle +python3 -m stdlib_conformance run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-stdlib-oracle/Golden.purs \ + --input /tmp/psrs-stdlib-oracle/Main.purs \ + --expected-exit 42 --out /tmp/psrs-stdlib-runtime +``` + +`run.json` separates compilation and execution. The default expected output is +empty stdout/stderr; use `--expected-stdout` and `--expected-stderr` files for +other byte-exact goldens. `--wasmtime` selects an executable, never an optional +skip. No runner command publishes or modifies upstream checkouts. + +See [the repository boundary](../design/D-17-stdlib-and-conformance-boundaries.md) +for ownership, package locking, and the limits of this evidence. diff --git a/docs/workflow/stdlib-vendoring.md b/docs/workflow/stdlib-vendoring.md index 72ce2a5a..cd6ce47d 100644 --- a/docs/workflow/stdlib-vendoring.md +++ b/docs/workflow/stdlib-vendoring.md @@ -1,6 +1,6 @@ # Standard-library source fidelity -The vendored standard library preserves the official PureScript source contract. +The independent `psrs-stdlib` package preserves the official PureScript source contract. The only permitted semantic differences have a concrete Wasm/WASI target or DEC-16 Unicode scalar/UTF-8 representation justification. This policy governs both new imports and repairs of the existing library. @@ -88,3 +88,11 @@ tests for each restored interaction, and capture comparable compile diagnoses. Update roadmap measurements only after the required full scoreboard run. Do not claim completion while any required API, binding, source-restoration obligation, or behavior evidence remains missing. + +## Independent package workflow + +The library owns source revisions, upstream pins, target adaptations, and case +data. The compiler owns checked binding protocols and source loading. Follow +[the repository boundary](../design/D-17-stdlib-and-conformance-boundaries.md) +and [the conformance commands](stdlib-conformance.md) for locked consumption, +source audits, official scalar oracles, and mandatory runtime observations. diff --git a/docs/workflow/tools/audit-stdlib-vendor.py b/docs/workflow/tools/audit-stdlib-vendor.py index c93f0a86..ba89e903 100644 --- a/docs/workflow/tools/audit-stdlib-vendor.py +++ b/docs/workflow/tools/audit-stdlib-vendor.py @@ -1,233 +1,10 @@ #!/usr/bin/env python3 -"""Compare vendored modules with locally available, tagged upstream checkouts. - -This is an inventory, not an allowlist or a PureScript semantic verifier. -It never modifies library sources and never downloads missing dependencies. -""" - -import argparse -import collections -import difflib -import hashlib -import json +"""Compatibility entry for the standalone stdlib conformance component.""" from pathlib import Path -import re -import subprocess - - -def git(root, *args): - return subprocess.check_output( - ["git", "-C", str(root), *args], text=True - ).strip() - - -def digest(data): - return hashlib.sha256(data).hexdigest() - - -def append_diff(patch, original, vendored, before_path, after_path): - differences = difflib.unified_diff( - original.splitlines(keepends=True), vendored.splitlines(keepends=True), - fromfile=before_path, tofile=after_path, - ) - for line in differences: - patch.append(line if line.endswith("\n") else line + "\n\\ No newline at end of file\n") - - -def foreign_declarations(text): - lines = text.splitlines() - declarations = [] - covered = set() - for index, line in enumerate(lines): - match = re.match(r"^foreign import (?!data\b)([\w']+)\b", line) - if not match: - continue - end = index + 1 - while end < len(lines) and lines[end].startswith((" ", "\t")): - end += 1 - covered.update(range(index, end)) - declarations.append({ - "name": match[1], - "line": index + 1, - "declaration": " ".join(part.strip() for part in lines[index:end]), - }) - return declarations, covered - - -def self_recursions(text): - result = [] - for number, line in enumerate(text.splitlines(), 1): - match = re.fullmatch( - r"([A-Za-z_][\w']*(?:\s+[A-Za-z_][\w']*)*)\s*=\s*(.*?)\s*", - line, - ) - if match and match[1].split() == match[2].split(): - result.append({"name": match[1].split()[0], "line": number, "equation": line}) - return result - - -def ordinary_removals(before, after, foreign_lines): - """Report changed original code outside value FFI declaration spans. - - This deliberately reports eta expansion and signature/layout changes too. - A reported removal requires review; it does not automatically prove a bug. - """ - old, new = before.splitlines(), after.splitlines() - result = [] - for kind, start, end, _, _ in difflib.SequenceMatcher( - None, old, new, autojunk=False - ).get_opcodes(): - if kind not in ("delete", "replace"): - continue - for index in range(start, end): - line = old[index] - if index not in foreign_lines and line.strip() and not line.lstrip().startswith("--"): - result.append({"line": index + 1, "text": line}) - return result - - -def main(): - parser = argparse.ArgumentParser(description=__doc__) - parser.add_argument("--vendor", type=Path, required=True) - parser.add_argument("--upstream", type=Path, action="append", required=True, - help="A git checkout with src/, or a directory of those checkouts") - parser.add_argument("--out", type=Path, required=True) - args = parser.parse_args() - args.out.mkdir(parents=True, exist_ok=True) - roots = [] - for root in args.upstream: - if (root / "src").is_dir(): - roots.append(root) - else: - roots.extend(child for child in sorted(root.iterdir()) if (child / "src").is_dir()) - - packages, sources = [], {} - for root in roots: - if git(root, "status", "--porcelain"): - raise SystemExit(f"upstream checkout is dirty: {root}") - package = { - "name": root.name, - "checkout": str(root.resolve()), - "commit": git(root, "rev-parse", "HEAD"), - "tag": git(root, "describe", "--tags", "--exact-match"), - "remote": git(root, "remote", "get-url", "origin"), - } - packages.append(package) - for path in sorted((root / "src").rglob("*.purs")): - relative = path.relative_to(root / "src").as_posix() - if relative in sources: - raise SystemExit(f"duplicate upstream source: {relative}") - sources[relative] = (path, package) - - modules, patch = [], [] - for path in sorted(args.vendor.rglob("*.purs")): - relative = path.relative_to(args.vendor).as_posix() - data = path.read_bytes() - text = data.decode("utf-8") - row = { - "path": relative, - "vendored_sha256": digest(data), - "vendored_lines": len(text.splitlines()), - "self_recursions": self_recursions(text), - } - if relative not in sources: - row["status"] = "platform_addition" if relative.startswith("WASI/") or relative == "WASI.purs" else "baseline_unavailable" - modules.append(row) - continue - upstream, package = sources[relative] - original_data = upstream.read_bytes() - original = original_data.decode("utf-8") - row.update({ - "package": package["name"], - "tag": package["tag"], - "commit": package["commit"], - "upstream_sha256": digest(original_data), - "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, - "status": "identical" if data == original_data else "newline_only" if original.splitlines() == text.splitlines() else "modified", - }) - declarations, covered = foreign_declarations(original) - names = {declaration["name"] for declaration in declarations} - recursive_names = {recursion["name"] for recursion in row["self_recursions"]} - retained_foreign_names = set(re.findall( - r'^foreign import (?:"[^"\n]*"\s+)?(?!data\b)([\w\x27]+)\b', text, re.M - )) - for declaration in declarations: - name = declaration["name"] - declaration["vendored_status"] = ( - "foreign_declaration_retained" if name in retained_foreign_names else - "direct_self_recursion" if name in recursive_names else - "nonrecursive_replacement" if re.search(r"^" + re.escape(name) + r"\s*::", text, re.M) else - "declaration_removed" - ) - row["upstream_value_foreign_declarations"] = declarations - for recursion in row["self_recursions"]: - recursion["replaces_upstream_foreign"] = recursion["name"] in names - row["changed_original_code_outside_value_ffi"] = ordinary_removals(original, text, covered) - if data != original_data: - append_diff(patch, original, text, - package["name"] + "@" + package["tag"] + "/src/" + relative, - "stdlib/lib/" + relative) - modules.append(row) - - absent_modules = [] - absent_paths = sorted(set(sources) - {row["path"] for row in modules}) - for relative in absent_paths: - path, package = sources[relative] - data = path.read_bytes() - absent_modules.append({ - "path": relative, - "package": package["name"], - "tag": package["tag"], - "commit": package["commit"], - "upstream_sha256": digest(data), - "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, - }) - append_diff(patch, data.decode("utf-8"), "", - package["name"] + "@" + package["tag"] + "/src/" + relative, - "/dev/null") - - counts = dict(collections.Counter(row["status"] for row in modules)) - counts.update({ - "vendored_modules": len(modules), - "packages": len(packages), - "direct_self_recursions": sum(len(row["self_recursions"]) for row in modules), - "modules_with_direct_self_recursions": sum(bool(row["self_recursions"]) for row in modules), - "upstream_modules_absent_from_vendor": absent_paths, - "upstream_value_foreign_declarations": dict(collections.Counter( - declaration["vendored_status"] for row in modules - for declaration in row.get("upstream_value_foreign_declarations", []) - )), - }) - repository = args.vendor.resolve().parents[1] - result = { - "schema_version": 1, - "compiler_revision": git(repository, "rev-parse", "HEAD"), - "counts": counts, - "packages": packages, - "modules": modules, - "absent_modules": absent_modules, - "limits": [ - "Only supplied upstream checkouts are compared; baseline_unavailable is not a pass.", - "Self-recursion detection covers exact top-level same-argument equations only.", - "The script records differences without approving target adaptations or proving semantic equivalence.", - "The official compiler support dependency ranges do not uniquely pin package patch versions.", - ], - } - (args.out / "inventory.json").write_text(json.dumps(result, ensure_ascii=False, indent=2) + "\n") - (args.out / "official-vs-vendored.diff").write_text("".join(patch)) - table = ["# Vendored module inventory", "", "Generated by `audit-stdlib-vendor.py`. Status is comparison evidence, not approval.", "", - "| Module path | Official package/tag | Comparison | Direct self-recursions |", "| --- | --- | --- | --- |"] - for row in modules: - origin = row.get("package", "unavailable") + (" " + row["tag"] if "tag" in row else "") - table.append(f"| `{row['path']}` | {origin} | {row['status']} | {len(row['self_recursions'])} |") - if absent_modules: - table.extend(["", "## Official modules absent from the vendored library", "", - "| Module path | Official package/tag |", "| --- | --- |"]) - for row in absent_modules: - table.append(f"| `{row['path']}` | {row['package']} {row['tag']} |") - (args.out / "modules.md").write_text("\n".join(table) + "\n") - print(json.dumps(counts, ensure_ascii=False, indent=2)) +import sys +sys.path.insert(0, str(Path(__file__).resolve().parents[3] / "tools/stdlib-conformance/src")) +from stdlib_conformance.audit import main if __name__ == "__main__": main() diff --git a/docs/workflow/tools/stdlib-scalar-oracle.mjs b/docs/workflow/tools/stdlib-scalar-oracle.mjs index 873a6dce..1502fb0f 100644 --- a/docs/workflow/tools/stdlib-scalar-oracle.mjs +++ b/docs/workflow/tools/stdlib-scalar-oracle.mjs @@ -1,101 +1,16 @@ -// Generate source-signature and behavior fixtures from pinned official FFI. -import { readFile, writeFile, mkdir } from 'node:fs/promises'; -import { execFileSync } from 'node:child_process'; -import { createHash } from 'node:crypto'; -import { resolve, join } from 'node:path'; -import { pathToFileURL } from 'node:url'; - -const [prelude, integers, output] = process.argv.slice(2).map(value => resolve(value)); -if (!prelude || !integers || !output) throw Error('usage: node stdlib-scalar-oracle.mjs PRELUDE INTEGERS OUTPUT'); -const repository = resolve(import.meta.dirname, '../../..'); -const inventory = JSON.parse(await readFile(join(repository, - 'docs/implementation/stdlib/vendor-restoration-2026-10-06/inventory.json'), 'utf8')); -const roots = { 'purescript-prelude': prelude, 'purescript-integers': integers }; -for (const [packageName, root] of Object.entries(roots)) { - const pin = inventory.packages.find(value => value.name === packageName); - if (execFileSync('git', ['-C', root, 'rev-parse', 'HEAD'], { encoding: 'utf8' }).trim() !== pin.commit) - throw Error(`unexpected upstream revision: ${packageName}`); - if (execFileSync('git', ['-C', root, 'status', '--porcelain'], { encoding: 'utf8' }).trim()) - throw Error(`dirty upstream: ${packageName}`); -} -const specifications = [ - ['Data/Int.purs', 'toNumber', [[42], [-2147483648], [2147483647]]], - ['Data/Int/Bits.purs', 'and', [[63, 42], [-1, 42]]], - ['Data/Int/Bits.purs', 'or', [[32, 10], [-1, 0]]], - ['Data/Int/Bits.purs', 'xor', [[63, 21], [-1, 0]]], - ['Data/Int/Bits.purs', 'shl', [[21, 1], [21, 33], [1, -1]]], - ['Data/Int/Bits.purs', 'shr', [[-84, 1], [-84, 33], [1, -1]]], - ['Data/Int/Bits.purs', 'zshr', [[-1, 1], [-1, 0], [-1, 32]]], - ['Data/Int/Bits.purs', 'complement', [[-43], [-2147483648]]], - ['Data/Eq.purs', 'eqBooleanImpl', [[true, true], [true, false]]], - ['Data/Eq.purs', 'eqIntImpl', [[42, 42], [-2147483648, 2147483647]]], - ['Data/Eq.purs', 'eqNumberImpl', [[0, -0], [NaN, NaN], [Infinity, Infinity]]], - ['Data/Eq.purs', 'eqCharImpl', [['λ', 'λ'], ['😀', '😀'], ['λ', '😀']]], - ['Data/Ring.purs', 'intSub', [[44, 2], [-2147483648, 1]]], - ['Data/Ring.purs', 'numSub', [[44, 2], [-0, 0]]], - ['Data/Semiring.purs', 'intAdd', [[40, 2], [2147483647, 1]]], - ['Data/Semiring.purs', 'numAdd', [[40, 2], [Infinity, -Infinity]]], - ['Data/Semiring.purs', 'numMul', [[21, 2], [-0, 2]]], - ['Data/HeytingAlgebra.purs', 'boolConj', [[true, true], [true, false]]], - ['Data/HeytingAlgebra.purs', 'boolDisj', [[false, true], [false, false]]], - ['Data/HeytingAlgebra.purs', 'boolNot', [[true], [false]]], -]; -const hashes = new Map(), declarations = [], observations = [], checks = []; -function marker(value) { - if (typeof value !== 'number') return value; - if (Number.isNaN(value)) return 'NaN'; - if (Object.is(value, -0)) return '-0'; - if (!Number.isFinite(value)) return String(value); - return value; -} -function literal(value, type) { - if (typeof value === 'boolean') return String(value); - if (typeof value === 'string') return `'${value}'`; - if (Number.isNaN(value)) return '(numberDiv 0.0 0.0)'; - if (!Number.isFinite(value)) return `(numberDiv ${value < 0 ? '(numberNeg 1.0)' : '1.0'} 0.0)`; - const negative = value < 0 || Object.is(value, -0); - const magnitude = String(Math.abs(value)); - if (type === 'Number') { - const number = magnitude.includes('.') ? magnitude : magnitude + '.0'; - return negative ? `(numberNeg ${number})` : number; - } - if (value === -2147483648) return '(intSub (intNeg 2147483647) 1)'; - return negative ? `(intNeg ${magnitude})` : magnitude; -} -for (const [file, name, cases] of specifications) { - const metadata = inventory.modules.find(value => value.path === file); - const upstream = join(roots[metadata.package], 'src', file.replace('.purs', '.js')); - const js = await readFile(upstream); - hashes.set(upstream, createHash('sha256').update(js).digest('hex')); - const functions = await import(pathToFileURL(upstream)); - const vendor = await readFile(join(repository, 'stdlib/lib', file), 'utf8'); - const declaration = vendor.split('\n').find(line => line.startsWith('foreign import "psrs:intrinsic#') && line.includes(`" ${name} ::`)); - if (!declaration) throw Error(`missing explicit target binding: ${file}.${name}`); - declarations.push(declaration); - const types = declaration.split('::')[1].trim().split(' -> '); - const resultType = types.at(-1); - for (const args of cases) { - let expected = functions[name]; - for (const argument of args) expected = expected(argument); - // Wasm Int is signed i32; record the raw JS observation separately. - const target = resultType === 'Int' ? expected | 0 : expected; - const call = `(Golden.${name} ${args.map((value, i) => literal(value, types[i])).join(' ')})`; - let condition; - if (resultType === 'Number' && Number.isNaN(target)) condition = `(booleanNot (numberEq ${call} ${call}))`; - else if (resultType === 'Number' && Object.is(target, -0)) - condition = `(numberEq (numberDiv 1.0 ${call}) (numberDiv (numberNeg 1.0) 0.0))`; - else condition = `(${resultType === 'Int' ? 'intEq' : resultType === 'Boolean' ? 'booleanEq' : 'numberEq'} ${call} ${literal(target, resultType)})`; - observations.push({ module: file, name, arguments: args.map(marker), official_result: marker(expected), target_result: marker(target), representation_difference: !Object.is(expected, target) }); - checks.push(condition); - } -} -await mkdir(output, { recursive: true }); -await writeFile(join(output, 'Golden.purs'), 'module Golden where\n' + declarations.join('\n') + '\n'); -function conjunction(values) { - if (values.length === 1) return values[0]; - const middle = Math.floor(values.length / 2); - return `(booleanAnd ${conjunction(values.slice(0, middle))} ${conjunction(values.slice(middle))})`; -} -await writeFile(join(output, 'Main.purs'), 'module Main where\nimport Golden as Golden\nmain = if ' + conjunction(checks) + ' then 42 else 1\n'); -await writeFile(join(output, 'observations.json'), JSON.stringify({ node: process.version, inputs: [...hashes].map(([path, sha256]) => ({ path, sha256 })), observations }, null, 2) + '\n'); -console.log(`${declarations.length} bindings, ${checks.length} cases`); +// Compatibility entrypoint; the implementation accepts independent package paths. +import { readFileSync } from 'node:fs'; +import { resolve } from 'node:path'; +import { spawnSync } from 'node:child_process'; +const [prelude, integers, out] = process.argv.slice(2); +if (!prelude || !integers || !out) throw Error('usage: node stdlib-scalar-oracle.mjs PRELUDE INTEGERS OUTPUT'); +const compilerRoot = resolve(import.meta.dirname, '../../..'); +const lock = JSON.parse(readFileSync(resolve(compilerRoot, 'stdlib.lock.json'), 'utf8')); +const root = process.env.PSRS_STDLIB_ROOT ?? resolve(compilerRoot, lock.path); +const script = resolve(compilerRoot, 'tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs'); +const result = spawnSync(process.execPath, [script, '--vendor', resolve(root, 'lib'), + '--inventory', resolve(root, 'upstream-lock.json'), '--cases', resolve(root, 'conformance/scalars.json'), + '--upstream', `purescript-prelude=${resolve(prelude)}`, '--upstream', `purescript-integers=${resolve(integers)}`, + '--out', resolve(out)], { stdio: 'inherit' }); +if (result.error) throw result.error; +process.exit(result.status ?? 1); diff --git a/stdlib.lock.json b/stdlib.lock.json new file mode 100644 index 00000000..c24b5ca4 --- /dev/null +++ b/stdlib.lock.json @@ -0,0 +1,6 @@ +{ + "schema_version": 1, + "path": "../psrs-stdlib", + "revision": "a08b4c8e300234b51b5c4f1128705eb95ab84a37", + "source_fingerprint": "fnv1a64-v1:cc98c3102452f8ad" +} diff --git a/stdlib/lib/Control/Alt.purs b/stdlib/lib/Control/Alt.purs deleted file mode 100644 index a8132706..00000000 --- a/stdlib/lib/Control/Alt.purs +++ /dev/null @@ -1,42 +0,0 @@ -module Control.Alt - ( class Alt, alt, (<|>) - , module Data.Functor - ) where - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Semigroup (append) - --- | The `Alt` type class identifies an associative operation on a type --- | constructor. It is similar to `Semigroup`, except that it applies to --- | types of kind `* -> *`, like `Array` or `List`, rather than concrete types --- | `String` or `Number`. --- | --- | `Alt` instances are required to satisfy the following laws: --- | --- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)` --- | - Distributivity: `f <$> (x <|> y) == (f <$> x) <|> (f <$> y)` --- | --- | For example, the `Array` (`[]`) type is an instance of `Alt`, where --- | `(<|>)` is defined to be concatenation. --- | --- | A common use case is to select the first "valid" item, or, if all items --- | are "invalid", the last "invalid" item. --- | --- | For example: --- | --- | ```purescript --- | import Control.Alt ((<|>)) --- | import Data.Maybe (Maybe(..) --- | import Data.Either (Either(..)) --- | --- | Nothing <|> Just 1 <|> Just 2 == Just 1 --- | Left "err" <|> Right 1 <|> Right 2 == Right 1 --- | Left "err 1" <|> Left "err 2" <|> Left "err 3" == Left "err 3" --- | ``` -class Functor f <= Alt f where - alt :: forall a. f a -> f a -> f a - -infixr 3 alt as <|> - -instance altArray :: Alt Array where - alt = append diff --git a/stdlib/lib/Control/Alternative.purs b/stdlib/lib/Control/Alternative.purs deleted file mode 100644 index 5bec9c77..00000000 --- a/stdlib/lib/Control/Alternative.purs +++ /dev/null @@ -1,50 +0,0 @@ -module Control.Alternative - ( class Alternative - , guard - , module Control.Alt - , module Control.Applicative - , module Control.Apply - , module Control.Plus - , module Data.Functor - ) where - -import Control.Alt (class Alt, alt, (<|>)) -import Control.Applicative (class Applicative, pure, liftA1, unless, when) -import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Plus (class Plus, empty) - -import Data.Unit (Unit, unit) -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) - --- | The `Alternative` type class has no members of its own; it just specifies --- | that the type constructor has both `Applicative` and `Plus` instances. --- | --- | Types which have `Alternative` instances should also satisfy the following --- | laws: --- | --- | - Distributivity: `(f <|> g) <*> x == (f <*> x) <|> (g <*> x)` --- | - Annihilation: `empty <*> f = empty` -class (Applicative f, Plus f) <= Alternative f - -instance alternativeArray :: Alternative Array - --- | Fail using `Plus` if a condition does not hold, or --- | succeed using `Applicative` if it does. --- | --- | For example: --- | --- | ```purescript --- | import Prelude --- | import Control.Alternative (guard) --- | import Data.Array ((..)) --- | --- | factors :: Int -> Array Int --- | factors n = do --- | a <- 1..n --- | b <- 1..n --- | guard $ a * b == n --- | pure a --- | ``` -guard :: forall m. Alternative m => Boolean -> m Unit -guard true = pure unit -guard false = empty diff --git a/stdlib/lib/Control/Applicative.purs b/stdlib/lib/Control/Applicative.purs deleted file mode 100644 index 6d444460..00000000 --- a/stdlib/lib/Control/Applicative.purs +++ /dev/null @@ -1,70 +0,0 @@ -module Control.Applicative - ( class Applicative - , pure - , liftA1 - , unless - , when - , module Control.Apply - , module Data.Functor - ) where - -import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Unit (Unit, unit) -import Type.Proxy (Proxy(..)) - --- | The `Applicative` type class extends the [`Apply`](#apply) type class --- | with a `pure` function, which can be used to create values of type `f a` --- | from values of type `a`. --- | --- | Where [`Apply`](#apply) provides the ability to lift functions of two or --- | more arguments to functions whose arguments are wrapped using `f`, and --- | [`Functor`](#functor) provides the ability to lift functions of one --- | argument, `pure` can be seen as the function which lifts functions of --- | _zero_ arguments. That is, `Applicative` functors support a lifting --- | operation for any number of function arguments. --- | --- | Instances must satisfy the following laws in addition to the `Apply` --- | laws: --- | --- | - Identity: `(pure identity) <*> v = v` --- | - Composition: `pure (<<<) <*> f <*> g <*> h = f <*> (g <*> h)` --- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)` --- | - Interchange: `u <*> (pure y) = (pure (_ $ y)) <*> u` -class Apply f <= Applicative f where - pure :: forall a. a -> f a - -instance applicativeFn :: Applicative ((->) r) where - pure x _ = x - -instance applicativeArray :: Applicative Array where - pure x = [ x ] - -instance applicativeProxy :: Applicative Proxy where - pure _ = Proxy - --- | `liftA1` provides a default implementation of `(<$>)` for any --- | [`Applicative`](#applicative) functor, without using `(<$>)` as provided --- | by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass --- | relationship. --- | --- | `liftA1` can therefore be used to write [`Functor`](#functor) instances --- | as follows: --- | --- | ```purescript --- | instance functorF :: Functor F where --- | map = liftA1 --- | ``` -liftA1 :: forall f a b. Applicative f => (a -> b) -> f a -> f b -liftA1 f a = pure f <*> a - --- | Perform an applicative action when a condition is true. -when :: forall m. Applicative m => Boolean -> m Unit -> m Unit -when true m = m -when false _ = pure unit - --- | Perform an applicative action unless a condition is true. -unless :: forall m. Applicative m => Boolean -> m Unit -> m Unit -unless false m = m -unless true _ = pure unit diff --git a/stdlib/lib/Control/Apply.purs b/stdlib/lib/Control/Apply.purs deleted file mode 100644 index 6cde1c85..00000000 --- a/stdlib/lib/Control/Apply.purs +++ /dev/null @@ -1,104 +0,0 @@ -module Control.Apply - ( class Apply - , apply - , (<*>) - , applyFirst - , (<*) - , applySecond - , (*>) - , lift2 - , lift3 - , lift4 - , lift5 - , module Data.Functor - ) where - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Function (const) -import Control.Category (identity) -import Type.Proxy (Proxy(..)) - --- | The `Apply` class provides the `(<*>)` which is used to apply a function --- | to an argument under a type constructor. --- | --- | `Apply` can be used to lift functions of two or more arguments to work on --- | values wrapped with the type constructor `f`. It might also be understood --- | in terms of the `lift2` function: --- | --- | ```purescript --- | lift2 :: forall f a b c. Apply f => (a -> b -> c) -> f a -> f b -> f c --- | lift2 f a b = f <$> a <*> b --- | ``` --- | --- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts --- | the function application operator `($)` to arguments wrapped with the --- | type constructor `f`. --- | --- | Put differently... --- | ``` --- | foo = --- | functionTakingNArguments <$> computationProducingArg1 --- | <*> computationProducingArg2 --- | <*> ... --- | <*> computationProducingArgN --- | ``` --- | --- | Instances must satisfy the following law in addition to the `Functor` --- | laws: --- | --- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)` --- | --- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor. -class Functor f <= Apply f where - apply :: forall a b. f (a -> b) -> f a -> f b - -infixl 4 apply as <*> - -instance applyFn :: Apply ((->) r) where - apply f g x = f x (g x) - -instance applyArray :: Apply Array where - apply = arrayApply - -foreign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b - -instance applyProxy :: Apply Proxy where - apply _ _ = Proxy - --- | Combine two effectful actions, keeping only the result of the first. -applyFirst :: forall a b f. Apply f => f a -> f b -> f a -applyFirst a b = const <$> a <*> b - -infixl 4 applyFirst as <* - --- | Combine two effectful actions, keeping only the result of the second. -applySecond :: forall a b f. Apply f => f a -> f b -> f b -applySecond a b = const identity <$> a <*> b - -infixl 4 applySecond as *> - --- | Lift a function of two arguments to a function which accepts and returns --- | values wrapped with the type constructor `f`. --- | --- | ```purescript --- | lift2 add (Just 1) (Just 2) == Just 3 --- | lift2 add Nothing (Just 2) == Nothing --- |``` --- | -lift2 :: forall a b c f. Apply f => (a -> b -> c) -> f a -> f b -> f c -lift2 f a b = f <$> a <*> b - --- | Lift a function of three arguments to a function which accepts and returns --- | values wrapped with the type constructor `f`. -lift3 :: forall a b c d f. Apply f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d -lift3 f a b c = f <$> a <*> b <*> c - --- | Lift a function of four arguments to a function which accepts and returns --- | values wrapped with the type constructor `f`. -lift4 :: forall a b c d e f. Apply f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e -lift4 f a b c d = f <$> a <*> b <*> c <*> d - --- | Lift a function of five arguments to a function which accepts and returns --- | values wrapped with the type constructor `f`. -lift5 :: forall a b c d e f g. Apply f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g -lift5 f a b c d e = f <$> a <*> b <*> c <*> d <*> e diff --git a/stdlib/lib/Control/Biapplicative.purs b/stdlib/lib/Control/Biapplicative.purs deleted file mode 100644 index b6e01ac6..00000000 --- a/stdlib/lib/Control/Biapplicative.purs +++ /dev/null @@ -1,12 +0,0 @@ -module Control.Biapplicative where - -import Control.Biapply (class Biapply) -import Data.Tuple (Tuple(..)) - --- | `Biapplicative` captures type constructors of two arguments which support lifting of --- | functions of zero or more arguments, in the sense of `Applicative`. -class Biapply w <= Biapplicative w where - bipure :: forall a b. a -> b -> w a b - -instance biapplicativeTuple :: Biapplicative Tuple where - bipure = Tuple diff --git a/stdlib/lib/Control/Biapply.purs b/stdlib/lib/Control/Biapply.purs deleted file mode 100644 index 6bb247cb..00000000 --- a/stdlib/lib/Control/Biapply.purs +++ /dev/null @@ -1,59 +0,0 @@ -module Control.Biapply where - -import Data.Function (const, identity) - -import Data.Bifunctor (class Bifunctor, bimap) -import Data.Tuple (Tuple(..)) - --- | A convenience operator which can be used to apply the result of `bipure` in --- | the style of `Applicative`: --- | --- | ```purescript --- | bipure f g <<$>> x <<*>> y --- | ``` -infixl 4 identity as <<$>> - --- | `Biapply` captures type constructors of two arguments which support lifting of --- | functions of one or more arguments, in the sense of `Apply`. -class Bifunctor w <= Biapply w where - biapply :: forall a b c d. w (a -> b) (c -> d) -> w a c -> w b d - -infixl 4 biapply as <<*>> - --- | Keep the results of the second computation. -biapplyFirst :: forall w a b c d. Biapply w => w a b -> w c d -> w c d -biapplyFirst a b = bimap (const identity) (const identity) <<$>> a <<*>> b - -infixl 4 biapplyFirst as *>> - --- | Keep the results of the first computation. -biapplySecond :: forall w a b c d. Biapply w => w a b -> w c d -> w a b -biapplySecond a b = bimap const const <<$>> a <<*>> b - -infixl 4 biapplySecond as <<* - --- | Lift a function of two arguments. -bilift2 - :: forall w a b c d e f - . Biapply w - => (a -> b -> c) - -> (d -> e -> f) - -> w a d - -> w b e - -> w c f -bilift2 f g a b = bimap f g <<$>> a <<*>> b - --- | Lift a function of three arguments. -bilift3 - :: forall w a b c d e f g h - . Biapply w - => (a -> b -> c -> d) - -> (e -> f -> g -> h) - -> w a e - -> w b f - -> w c g - -> w d h -bilift3 f g a b c = bimap f g <<$>> a <<*>> b <<*>> c - -instance biapplyTuple :: Biapply Tuple where - biapply (Tuple f g) (Tuple a b) = Tuple (f a) (g b) diff --git a/stdlib/lib/Control/Bind.purs b/stdlib/lib/Control/Bind.purs deleted file mode 100644 index c6d8a6ae..00000000 --- a/stdlib/lib/Control/Bind.purs +++ /dev/null @@ -1,150 +0,0 @@ -module Control.Bind - ( class Bind - , bind - , (>>=) - , bindFlipped - , (=<<) - , class Discard - , discard - , join - , composeKleisli - , (>=>) - , composeKleisliFlipped - , (<=<) - , ifM - , module Data.Functor - , module Control.Apply - , module Control.Applicative - ) where - -import Control.Applicative (class Applicative, liftA1, pure, unless, when) -import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Category (identity) - -import Data.Function (flip) -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Unit (Unit) -import Type.Proxy (Proxy(..)) - --- | The `Bind` type class extends the [`Apply`](#apply) type class with a --- | "bind" operation `(>>=)` which composes computations in sequence, using --- | the return value of one computation to determine the next computation. --- | --- | The `>>=` operator can also be expressed using `do` notation, as follows: --- | --- | ```purescript --- | x >>= f = do y <- x --- | f y --- | ``` --- | --- | where the function argument of `f` is given the name `y`. --- | --- | Instances must satisfy the following laws in addition to the `Apply` --- | laws: --- | --- | - Associativity: `(x >>= f) >>= g = x >>= (\k -> f k >>= g)` --- | - Apply Superclass: `apply f x = f >>= \f’ -> map f’ x` --- | --- | Associativity tells us that we can regroup operations which use `do` --- | notation so that we can unambiguously write, for example: --- | --- | ```purescript --- | do x <- m1 --- | y <- m2 x --- | m3 x y --- | ``` -class Apply m <= Bind m where - bind :: forall a b. m a -> (a -> m b) -> m b - -infixl 1 bind as >>= - --- | `bindFlipped` is `bind` with its arguments reversed. For example: --- | --- | ```purescript --- | print =<< random --- | ``` -bindFlipped :: forall m a b. Bind m => (a -> m b) -> m a -> m b -bindFlipped = flip bind - -infixr 1 bindFlipped as =<< - -instance bindFn :: Bind ((->) r) where - bind m f x = f (m x) x - --- | The `bind`/`>>=` function for `Array` works by applying a function to --- | each element in the array, and flattening the results into a single, --- | new array. --- | --- | Array's `bind`/`>>=` works like a nested for loop. Each `bind` adds --- | another level of nesting in the loop. For example: --- | ``` --- | foo :: Array String --- | foo = --- | ["a", "b"] >>= \eachElementInArray1 -> --- | ["c", "d"] >>= \eachElementInArray2 --- | pure (eachElementInArray1 <> eachElementInArray2) --- | --- | -- In other words... --- | foo --- | -- ... is the same as... --- | [ ("a" <> "c"), ("a" <> "d"), ("b" <> "c"), ("b" <> "d") ] --- | -- which simplifies to... --- | [ "ac", "ad", "bc", "bd" ] --- | ``` -instance bindArray :: Bind Array where - bind = arrayBind - -foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b - -instance bindProxy :: Bind Proxy where - bind _ _ = Proxy - --- | A class for types whose values can safely be discarded --- | in a `do` notation block. --- | --- | An example is the `Unit` type, since there is only one --- | possible value which can be returned. -class Discard a where - discard :: forall f b. Bind f => f a -> (a -> f b) -> f b - -instance discardUnit :: Discard Unit where - discard = bind - -instance discardProxy :: Discard (Proxy a) where - discard = bind - --- | Collapse two applications of a monadic type constructor into one. -join :: forall a m. Bind m => m (m a) -> m a -join m = m >>= identity - --- | Forwards Kleisli composition. --- | --- | For example: --- | --- | ```purescript --- | import Data.Array (head, tail) --- | --- | third = tail >=> tail >=> head --- | ``` -composeKleisli :: forall a b c m. Bind m => (a -> m b) -> (b -> m c) -> a -> m c -composeKleisli f g a = f a >>= g - -infixr 1 composeKleisli as >=> - --- | Backwards Kleisli composition. -composeKleisliFlipped :: forall a b c m. Bind m => (b -> m c) -> (a -> m b) -> a -> m c -composeKleisliFlipped f g a = f =<< g a - -infixr 1 composeKleisliFlipped as <=< - --- | Execute a monadic action if a condition holds. --- | --- | For example: --- | --- | ```purescript --- | main = ifM ((< 0.5) <$> random) --- | (trace "Heads") --- | (trace "Tails") --- | ``` -ifM :: forall a m. Bind m => m Boolean -> m a -> m a -> m a -ifM cond t f = cond >>= \cond' -> if cond' then t else f diff --git a/stdlib/lib/Control/Category.purs b/stdlib/lib/Control/Category.purs deleted file mode 100644 index c2f224a4..00000000 --- a/stdlib/lib/Control/Category.purs +++ /dev/null @@ -1,22 +0,0 @@ -module Control.Category - ( class Category - , identity - , module Control.Semigroupoid - ) where - -import Control.Semigroupoid (class Semigroupoid, compose, (<<<), (>>>)) - --- | `Category`s consist of objects and composable morphisms between them, and --- | as such are [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids` --- | must have an identity element. --- | --- | Instances must satisfy the following law in addition to the --- | `Semigroupoid` law: --- | --- | - Identity: `identity <<< p = p <<< identity = p` -class Category :: forall k. (k -> k -> Type) -> Constraint -class Semigroupoid a <= Category a where - identity :: forall t. a t t - -instance categoryFn :: Category (->) where - identity x = x diff --git a/stdlib/lib/Control/Comonad.purs b/stdlib/lib/Control/Comonad.purs deleted file mode 100644 index d471e2db..00000000 --- a/stdlib/lib/Control/Comonad.purs +++ /dev/null @@ -1,21 +0,0 @@ -module Control.Comonad - ( class Comonad, extract - , module Control.Extend - , module Data.Functor - ) where - -import Control.Extend (class Extend, duplicate, extend, (<<=), (=<=), (=>=), (=>>)) - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) - --- | `Comonad` extends the `Extend` class with the `extract` function --- | which extracts a value, discarding the comonadic context. --- | --- | `Comonad` is the dual of `Monad`, and `extract` is the dual of `pure`. --- | --- | Laws: --- | --- | - Left Identity: `extract <<= xs = xs` --- | - Right Identity: `extract (f <<= xs) = f xs` -class Extend w <= Comonad w where - extract :: forall a. w a -> a diff --git a/stdlib/lib/Control/Extend.purs b/stdlib/lib/Control/Extend.purs deleted file mode 100644 index 367ccd55..00000000 --- a/stdlib/lib/Control/Extend.purs +++ /dev/null @@ -1,59 +0,0 @@ -module Control.Extend - ( class Extend, extend, (<<=), extendFlipped, (=>>) - , composeCoKleisli, (=>=) - , composeCoKleisliFlipped, (=<=) - , duplicate - , module Data.Functor - ) where - -import Control.Category (identity) - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Semigroup (class Semigroup, (<>)) - --- | The `Extend` class defines the extension operator `(<<=)` --- | which extends a local context-dependent computation to --- | a global computation. --- | --- | `Extend` is the dual of `Bind`, and `(<<=)` is the dual of --- | `(>>=)`. --- | --- | Laws: --- | --- | - Associativity: `extend f <<< extend g = extend (f <<< extend g)` -class Functor w <= Extend w where - extend :: forall b a. (w a -> b) -> w a -> w b - -instance extendFn :: Semigroup w => Extend ((->) w) where - extend f g w = f \w' -> g (w <> w') - -foreign import arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b - -instance extendArray :: Extend Array where - extend = arrayExtend - -infixr 1 extend as <<= - --- | A version of `extend` with its arguments flipped. -extendFlipped :: forall b a w. Extend w => w a -> (w a -> b) -> w b -extendFlipped w f = f <<= w - -infixl 1 extendFlipped as =>> - --- | Forwards co-Kleisli composition. -composeCoKleisli :: forall b a w c. Extend w => (w a -> b) -> (w b -> c) -> w a -> c -composeCoKleisli f g w = g (f <<= w) - -infixr 1 composeCoKleisli as =>= - --- | Backwards co-Kleisli composition. -composeCoKleisliFlipped :: forall b a w c. Extend w => (w b -> c) -> (w a -> b) -> w a -> c -composeCoKleisliFlipped f g w = f (g <<= w) - -infixr 1 composeCoKleisliFlipped as =<= - --- | Duplicate a comonadic context. --- | --- | `duplicate` is dual to `Control.Bind.join`. -duplicate :: forall a w. Extend w => w a -> w (w a) -duplicate = extend identity diff --git a/stdlib/lib/Control/Lazy.purs b/stdlib/lib/Control/Lazy.purs deleted file mode 100644 index 3434d091..00000000 --- a/stdlib/lib/Control/Lazy.purs +++ /dev/null @@ -1,25 +0,0 @@ -module Control.Lazy where - -import Data.Unit (Unit, unit) - --- | The `Lazy` class represents types which allow evaluation of values --- | to be _deferred_. --- | --- | Usually, this means that a type contains a function arrow which can --- | be used to delay evaluation. -class Lazy l where - defer :: (Unit -> l) -> l - -instance lazyFn :: Lazy (a -> b) where - defer f = \x -> f unit x - -instance lazyUnit :: Lazy Unit where - defer _ = unit - --- | `fix` defines a value as the fixed point of a function. --- | --- | The `Lazy` instance allows us to generate the result lazily. -fix :: forall l. Lazy l => (l -> l) -> l -fix f = go - where - go = defer \_ -> f go diff --git a/stdlib/lib/Control/Monad.purs b/stdlib/lib/Control/Monad.purs deleted file mode 100644 index 3d8400ae..00000000 --- a/stdlib/lib/Control/Monad.purs +++ /dev/null @@ -1,86 +0,0 @@ -module Control.Monad - ( class Monad - , liftM1 - , whenM - , unlessM - , ap - , module Data.Functor - , module Control.Apply - , module Control.Applicative - , module Control.Bind - ) where - -import Control.Applicative (class Applicative, liftA1, pure, unless, when) -import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Bind (class Bind, bind, ifM, join, (<=<), (=<<), (>=>), (>>=)) - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) -import Data.Unit (Unit) -import Type.Proxy (Proxy) - --- | The `Monad` type class combines the operations of the `Bind` and --- | `Applicative` type classes. Therefore, `Monad` instances represent type --- | constructors which support sequential composition, and also lifting of --- | functions of arbitrary arity. --- | --- | Instances must satisfy the following laws in addition to the --- | `Applicative` and `Bind` laws: --- | --- | - Left Identity: `pure x >>= f = f x` --- | - Right Identity: `x >>= pure = x` -class (Applicative m, Bind m) <= Monad m - -instance monadFn :: Monad ((->) r) - -instance monadArray :: Monad Array - -instance monadProxy :: Monad Proxy - --- | `liftM1` provides a default implementation of `(<$>)` for any --- | [`Monad`](#monad), without using `(<$>)` as provided by the --- | [`Functor`](#functor)-[`Monad`](#monad) superclass relationship. --- | --- | `liftM1` can therefore be used to write [`Functor`](#functor) instances --- | as follows: --- | --- | ```purescript --- | instance functorF :: Functor F where --- | map = liftM1 --- | ``` -liftM1 :: forall m a b. Monad m => (a -> b) -> m a -> m b -liftM1 f a = do - a' <- a - pure (f a') - --- | Perform a monadic action when a condition is true, where the conditional --- | value is also in a monadic context. -whenM :: forall m. Monad m => m Boolean -> m Unit -> m Unit -whenM mb m = do - b <- mb - when b m - --- | Perform a monadic action unless a condition is true, where the conditional --- | value is also in a monadic context. -unlessM :: forall m. Monad m => m Boolean -> m Unit -> m Unit -unlessM mb m = do - b <- mb - unless b m - --- | `ap` provides a default implementation of `(<*>)` for any `Monad`, without --- | using `(<*>)` as provided by the `Apply`-`Monad` superclass relationship. --- | --- | `ap` can therefore be used to write `Apply` instances as follows: --- | --- | ```purescript --- | instance applyF :: Apply F where --- | apply = ap --- | ``` --- Note: Only a `Bind` constraint is needed, but this can --- produce loops when used with other default implementations --- (i.e. `liftA1`). --- See https://github.com/purescript/purescript-prelude/issues/232 -ap :: forall m a b. Monad m => m (a -> b) -> m a -> m b -ap f a = do - f' <- f - a' <- a - pure (f' a') diff --git a/stdlib/lib/Control/Monad/Gen.purs b/stdlib/lib/Control/Monad/Gen.purs deleted file mode 100644 index 3ceee57d..00000000 --- a/stdlib/lib/Control/Monad/Gen.purs +++ /dev/null @@ -1,132 +0,0 @@ -module Control.Monad.Gen - ( module Control.Monad.Gen.Class - , choose - , oneOf - , frequency - , elements - , unfoldable - , suchThat - , filtered - ) where - -import Prelude - -import Control.Monad.Gen.Class (class MonadGen, Size, chooseBool, chooseFloat, chooseInt, resize, sized) -import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) -import Data.Foldable (foldMap, foldr, length) -import Data.Maybe (Maybe(..)) -import Data.Monoid.Additive (Additive(..)) -import Data.Newtype (alaF, un) -import Data.Semigroup.Foldable (class Foldable1, foldMap1) -import Data.Semigroup.Last (Last(..)) -import Data.Tuple (Tuple(..), fst, snd) -import Data.Unfoldable (class Unfoldable, unfoldr) - -data LL a = Cons a (LL a) | Nil - --- | Creates a generator that outputs a value chosen from one of two existing --- | existing generators with even probability. -choose :: forall m a. MonadGen m => m a -> m a -> m a -choose genA genB = chooseBool >>= if _ then genA else genB - --- | Creates a generator that outputs a value chosen from a selection of --- | existing generators with uniform probability. -oneOf :: forall m f a. MonadGen m => Foldable1 f => f (m a) -> m a -oneOf xs = do - n <- chooseInt 0 (length xs - 1) - fromIndex n xs - -newtype FreqSemigroup a = FreqSemigroup (Number -> Tuple (Maybe Number) a) - -freqSemigroup :: forall a. Tuple Number a -> FreqSemigroup a -freqSemigroup (Tuple weight x) = - FreqSemigroup \pos -> - if pos >= weight - then Tuple (Just (pos - weight)) x - else Tuple Nothing x - -getFreqVal :: forall a. FreqSemigroup a -> Number -> a -getFreqVal (FreqSemigroup f) = snd <<< f - -instance semigroupFreqSemigroup :: Semigroup (FreqSemigroup a) where - append (FreqSemigroup f) (FreqSemigroup g) = - FreqSemigroup \pos -> - case f pos of - Tuple (Just pos') _ -> g pos' - result -> result - --- | Creates a generator that outputs a value chosen from a selection of --- | existing generators, where the selection has weight values for the --- | probability of choice for each generator. The probability values will be --- | normalised. -frequency - :: forall m f a - . MonadGen m - => Foldable1 f - => f (Tuple Number (m a)) - -> m a -frequency xs = - let total = alaF Additive foldMap fst xs - in chooseFloat 0.0 total >>= getFreqVal (foldMap1 freqSemigroup xs) - --- | Creates a generator that outputs a value chosen from a selection with --- | uniform probability. -elements :: forall m f a. MonadGen m => Foldable1 f => f a -> m a -elements xs = do - n <- chooseInt 0 (length xs - 1) - pure $ fromIndex n xs - --- | Creates a generator that produces unfoldable structures based on an --- | existing generator for the elements. --- | --- | The size of the unfoldable will be determined by the current size state --- | for the generator. To generate an unfoldable structure of a particular --- | size, use the `resize` function from the `MonadGen` class first. -unfoldable - :: forall m f a - . MonadRec m - => MonadGen m - => Unfoldable f - => m a - -> m (f a) -unfoldable gen = unfoldr unfold <$> sized (tailRecM loopGen <<< Tuple Nil) - where - loopGen :: Tuple (LL a) Int -> m (Step (Tuple (LL a) Int) (LL a)) - loopGen (Tuple acc n) - | n <= 0 = - pure $ Done acc - | otherwise = do - x <- gen - pure $ Loop (Tuple (Cons x acc) (n - 1)) - unfold :: LL a -> Maybe (Tuple a (LL a)) - unfold = case _ of - Nil -> Nothing - Cons x xs -> Just (Tuple x xs) - --- | Creates a generator that repeatedly run another generator until its output --- | matches a given predicate. This will never halt if the predicate always --- | fails. -suchThat :: forall m a. MonadRec m => MonadGen m => m a -> (a -> Boolean) -> m a -suchThat gen pred = filtered $ gen <#> \a -> if pred a then Just a else Nothing - --- | Creates a generator that repeatedly run another generator until it produces --- | `Just` node. This will never halt if the input generator always produces `Nothing`. -filtered :: forall m a. MonadRec m => MonadGen m => m (Maybe a) -> m a -filtered gen = tailRecM go unit - where - go :: Unit -> m (Step Unit a) - go _ = gen <#> \a -> case a of - Nothing -> Loop unit - Just a' -> Done a' - --- | Internal: get the Foldable element at index i. --- | If the index is <= 0, return the first element. --- | If it's >= length, return the last. -fromIndex :: forall f a. Foldable1 f => Int -> f a -> a -fromIndex i xs = go i (foldr Cons Nil xs) - where - go _ (Cons a Nil) = a - go j (Cons a _) | j <= 0 = a - go j (Cons _ as) = go (j - 1) as - -- next case is "impossible", but serves as proof of non-emptyness - go _ Nil = un Last (foldMap1 Last xs) diff --git a/stdlib/lib/Control/Monad/Gen/Class.purs b/stdlib/lib/Control/Monad/Gen/Class.purs deleted file mode 100644 index 3a972c7a..00000000 --- a/stdlib/lib/Control/Monad/Gen/Class.purs +++ /dev/null @@ -1,29 +0,0 @@ -module Control.Monad.Gen.Class where - -import Prelude - --- | A class for random generator implementations. --- | --- | Instances should provide implementations for the generation functions --- | that return choices with uniform probability. --- | --- | See also `Gen` in `purescript-quickcheck`, which implements this --- | type class. -class Monad m <= MonadGen m where - - -- | Chooses an integer in the specified (inclusive) range. - chooseInt :: Int -> Int -> m Int - - -- | Chooses an floating point number in the specified (inclusive) range. - chooseFloat :: Number -> Number -> m Number - - -- | Chooses a random boolean value. - chooseBool :: m Boolean - - -- | Modifies the size state for a random generator. - resize :: forall a. (Size -> Size) -> m a -> m a - - -- | Runs a generator, passing in the current size state. - sized :: forall a. (Size -> m a) -> m a - -type Size = Int diff --git a/stdlib/lib/Control/Monad/Gen/Common.purs b/stdlib/lib/Control/Monad/Gen/Common.purs deleted file mode 100644 index f1d76ae5..00000000 --- a/stdlib/lib/Control/Monad/Gen/Common.purs +++ /dev/null @@ -1,67 +0,0 @@ -module Control.Monad.Gen.Common where - -import Prelude - -import Control.Apply (lift2) -import Control.Monad.Gen (class MonadGen, chooseFloat, resize, unfoldable) -import Control.Monad.Rec.Class (class MonadRec) -import Data.Either (Either(..)) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) -import Data.NonEmpty (NonEmpty, (:|)) -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable) - --- | Creates a generator that outputs `Either` values, choosing a value from a --- | `Left` or the `Right` with even probability. -genEither :: forall m a b. MonadGen m => m a -> m b -> m (Either a b) -genEither = genEither' 0.5 - --- | Creates a generator that outputs `Either` values, choosing a value from a --- | `Left` or the `Right` with adjustable bias. As the bias value increases, --- | the chance of returning a `Left` value rises. A bias ≤ 0.0 will always --- | return `Right`, a bias ≥ 1.0 will always return `Left`. -genEither' :: forall m a b. MonadGen m => Number -> m a -> m b -> m (Either a b) -genEither' bias genA genB = do - n <- chooseFloat 0.0 1.0 - if n < bias then Left <$> genA else Right <$> genB - --- | Creates a generator that outputs `Identity` values, choosing a value from --- | another generator for the inner value. -genIdentity :: forall m a. Functor m => m a -> m (Identity a) -genIdentity = map Identity - --- | Creates a generator that outputs `Maybe` values, choosing a value from --- | another generator for the inner value. The generator has a 75% chance of --- | returning a `Just` over a `Nothing`. -genMaybe :: forall m a. MonadGen m => m a -> m (Maybe a) -genMaybe = genMaybe' 0.75 - --- | Creates a generator that outputs `Maybe` values, choosing a value from --- | another generator for the inner value, with an adjustable bias for how --- | often `Just` is returned vs `Nothing`. A bias ≤ 0.0 will always --- | return `Nothing`, a bias ≥ 1.0 will always return `Just`. -genMaybe' :: forall m a. MonadGen m => Number -> m a -> m (Maybe a) -genMaybe' bias gen = do - n <- chooseFloat 0.0 1.0 - if n < bias then Just <$> gen else pure Nothing - --- | Creates a generator that outputs `Tuple` values, choosing values from a --- | pair of generators for each slot in the tuple. -genTuple :: forall m a b. Apply m => m a -> m b -> m (Tuple a b) -genTuple = lift2 Tuple - --- | Creates a generator that outputs `NonEmpty` values, choosing values from a --- | generator for each of the items. --- | --- | The size of the value will be determined by the current size state --- | for the generator. To generate a value of a particular size, use the --- | `resize` function from the `MonadGen` class first. -genNonEmpty - :: forall m a f - . MonadRec m - => MonadGen m - => Unfoldable f - => m a - -> m (NonEmpty f a) -genNonEmpty gen = (:|) <$> gen <*> resize (max 0 <<< (_ - 1)) (unfoldable gen) diff --git a/stdlib/lib/Control/Monad/Rec/Class.purs b/stdlib/lib/Control/Monad/Rec/Class.purs deleted file mode 100644 index b80de6b8..00000000 --- a/stdlib/lib/Control/Monad/Rec/Class.purs +++ /dev/null @@ -1,191 +0,0 @@ -module Control.Monad.Rec.Class - ( Step(..) - , class MonadRec - , tailRec - , tailRec2 - , tailRec3 - , tailRecM - , tailRecM2 - , tailRecM3 - , forever - , whileJust - , untilJust - , loop2 - , loop3 - ) where - -import Prelude - -import Data.Bifunctor (class Bifunctor) -import Data.Either (Either(..)) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) -import Effect (Effect, untilE) -import Effect.Ref as Ref -import Partial.Unsafe (unsafePartial) - --- | The result of a computation: either `Loop` containing the updated --- | accumulator, or `Done` containing the final result of the computation. -data Step a b = Loop a | Done b - -derive instance functorStep :: Functor (Step a) - -instance bifunctorStep :: Bifunctor Step where - bimap f _ (Loop a) = Loop (f a) - bimap _ g (Done b) = Done (g b) - --- | This type class captures those monads which support tail recursion in --- | constant stack space. --- | --- | The `tailRecM` function takes a step function, and applies that step --- | function recursively until a pure value of type `b` is found. --- | --- | Instances are provided for standard monad transformers. --- | --- | For example: --- | --- | ```purescript --- | loopWriter :: Int -> WriterT (Additive Int) Effect Unit --- | loopWriter n = tailRecM go n --- | where --- | go 0 = do --- | traceM "Done!" --- | pure (Done unit) --- | go i = do --- | tell $ Additive i --- | pure (Loop (i - 1)) --- | ``` -class Monad m <= MonadRec m where - tailRecM :: forall a b. (a -> m (Step a b)) -> a -> m b - --- | Create a tail-recursive function of two arguments which uses constant stack space. --- | --- | The `loop2` helper function provides a curried alternative to the `Loop` --- | constructor for this function. -tailRecM2 - :: forall m a b c - . MonadRec m - => (a -> b -> m (Step { a :: a, b :: b } c)) - -> a - -> b - -> m c -tailRecM2 f a b = tailRecM (\o -> f o.a o.b) { a, b } - --- | Create a tail-recursive function of three arguments which uses constant stack space. --- | --- | The `loop3` helper function provides a curried alternative to the `Loop` --- | constructor for this function. -tailRecM3 - :: forall m a b c d - . MonadRec m - => (a -> b -> c -> m (Step { a :: a, b :: b, c :: c } d)) - -> a - -> b - -> c - -> m d -tailRecM3 f a b c = tailRecM (\o -> f o.a o.b o.c) { a, b, c } - --- | Create a pure tail-recursive function of one argument --- | --- | For example: --- | --- | ```purescript --- | pow :: Int -> Int -> Int --- | pow n p = tailRec go { accum: 1, power: p } --- | where --- | go :: _ -> Step _ Int --- | go { accum: acc, power: 0 } = Done acc --- | go { accum: acc, power: p } = Loop { accum: acc * n, power: p - 1 } --- | ``` -tailRec :: forall a b. (a -> Step a b) -> a -> b -tailRec f = go <<< f - where - go (Loop a) = go (f a) - go (Done b) = b - --- | Create a pure tail-recursive function of two arguments --- | --- | The `loop2` helper function provides a curried alternative to the `Loop` --- | constructor for this function. -tailRec2 :: forall a b c. (a -> b -> Step { a :: a, b :: b } c) -> a -> b -> c -tailRec2 f a b = tailRec (\o -> f o.a o.b) { a, b } - --- | Create a pure tail-recursive function of three arguments --- | --- | The `loop3` helper function provides a curried alternative to the `Loop` --- | constructor for this function. -tailRec3 :: forall a b c d. (a -> b -> c -> Step { a :: a, b :: b, c :: c } d) -> a -> b -> c -> d -tailRec3 f a b c = tailRec (\o -> f o.a o.b o.c) { a, b, c } - -instance monadRecIdentity :: MonadRec Identity where - tailRecM f = Identity <<< tailRec (runIdentity <<< f) - where runIdentity (Identity x) = x - -instance monadRecEffect :: MonadRec Effect where - tailRecM f a = do - r <- Ref.new =<< f a - untilE do - Ref.read r >>= case _ of - Loop a' -> do - e <- f a' - _ <- Ref.write e r - pure false - Done _ -> pure true - fromDone <$> Ref.read r - where - fromDone :: forall a b. Step a b -> b - fromDone = unsafePartial \(Done b) -> b - -instance monadRecFunction :: MonadRec ((->) e) where - tailRecM f a0 e = tailRec (\a -> f a e) a0 - -instance monadRecEither :: MonadRec (Either e) where - tailRecM f a0 = - let - g (Left e) = Done (Left e) - g (Right (Loop a)) = Loop (f a) - g (Right (Done b)) = Done (Right b) - in tailRec g (f a0) - -instance monadRecMaybe :: MonadRec Maybe where - tailRecM f a0 = - let - g Nothing = Done Nothing - g (Just (Loop a)) = Loop (f a) - g (Just (Done b)) = Done (Just b) - in tailRec g (f a0) - --- | `forever` runs an action indefinitely, using the `MonadRec` instance to --- | ensure constant stack usage. --- | --- | For example: --- | --- | ```purescript --- | main = forever $ trace "Hello, World!" --- | ``` -forever :: forall m a b. MonadRec m => m a -> m b -forever ma = tailRecM (\u -> Loop u <$ ma) unit - --- | While supplied computation evaluates to `Just _`, it will be --- | executed repeatedly and results will be combined using monoid instance. -whileJust :: forall a m. Monoid a => MonadRec m => m (Maybe a) -> m a -whileJust m = mempty # tailRecM \v -> m <#> case _ of - Nothing -> Done v - Just x -> Loop $ v <> x - --- | Supplied computation will be executed repeatedly until it evaluates --- | to `Just value` and then that `value` will be returned. -untilJust :: forall a m. MonadRec m => m (Maybe a) -> m a -untilJust m = unit # tailRecM \_ -> m <#> case _ of - Nothing -> Loop unit - Just x -> Done x - --- | A curried version of the `Loop` constructor, provided as a convenience for --- | use with `tailRec2` and `tailRecM2`. -loop2 :: forall a b c. a -> b -> Step { a :: a, b :: b } c -loop2 a b = Loop { a, b } - --- | A curried version of the `Loop` constructor, provided as a convenience for --- | use with `tailRec3` and `tailRecM3`. -loop3 :: forall a b c d. a -> b -> c -> Step { a :: a, b :: b, c :: c } d -loop3 a b c = Loop { a, b, c } diff --git a/stdlib/lib/Control/Monad/ST.purs b/stdlib/lib/Control/Monad/ST.purs deleted file mode 100644 index b8b11fd4..00000000 --- a/stdlib/lib/Control/Monad/ST.purs +++ /dev/null @@ -1,3 +0,0 @@ -module Control.Monad.ST (module Internal) where - -import Control.Monad.ST.Internal (ST, Region, run, while, for, foreach) as Internal diff --git a/stdlib/lib/Control/Monad/ST/Class.purs b/stdlib/lib/Control/Monad/ST/Class.purs deleted file mode 100644 index 692b317c..00000000 --- a/stdlib/lib/Control/Monad/ST/Class.purs +++ /dev/null @@ -1,17 +0,0 @@ -module Control.Monad.ST.Class where - -import Prelude - -import Control.Monad.ST (ST) -import Control.Monad.ST.Global (Global) -import Control.Monad.ST.Global as Global -import Effect (Effect) - -class Monad m <= MonadST s m | m -> s where - liftST :: ST s ~> m - -instance monadSTEffect :: MonadST Global Effect where - liftST = Global.toEffect - -instance monadSTST :: MonadST s (ST s) where - liftST = identity diff --git a/stdlib/lib/Control/Monad/ST/Global.purs b/stdlib/lib/Control/Monad/ST/Global.purs deleted file mode 100644 index 58a822ab..00000000 --- a/stdlib/lib/Control/Monad/ST/Global.purs +++ /dev/null @@ -1,18 +0,0 @@ -module Control.Monad.ST.Global - ( Global - , toEffect - ) where - -import Prelude - -import Control.Monad.ST (ST, Region) -import Effect (Effect) -import Unsafe.Coerce (unsafeCoerce) - --- | This region allows `ST` computations to be converted into `Effect` --- | computations so they can be run in a global context. -foreign import data Global :: Region - --- | Converts an `ST` computation into an `Effect` computation. -toEffect :: ST Global ~> Effect -toEffect = unsafeCoerce diff --git a/stdlib/lib/Control/Monad/ST/Internal.purs b/stdlib/lib/Control/Monad/ST/Internal.purs deleted file mode 100644 index a0c4dcfa..00000000 --- a/stdlib/lib/Control/Monad/ST/Internal.purs +++ /dev/null @@ -1,136 +0,0 @@ -module Control.Monad.ST.Internal - ( Region - , ST - , run - , while - , for - , foreach - , STRef - , new - , read - , modify' - , modify - , write - ) where - -import Prelude - -import Control.Apply (lift2) -import Control.Monad.Rec.Class (class MonadRec, Step(..)) -import Partial.Unsafe (unsafePartial) - --- | `ST` is concerned with _restricted_ mutation. Mutation is restricted to a --- | _region_ of mutable references. This kind is inhabited by phantom types --- | which represent regions in the type system. -foreign import data Region :: Type - --- | The `ST` type constructor allows _local mutation_, i.e. mutation which --- | does not "escape" into the surrounding computation. --- | --- | An `ST` computation is parameterized by a phantom type which is used to --- | restrict the set of reference cells it is allowed to access. --- | --- | The `run` function can be used to run a computation in the `ST` monad. -foreign import data ST :: Region -> Type -> Type - -type role ST nominal representational - -foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b - -foreign import pure_ :: forall r a. a -> ST r a - -foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b - -instance functorST :: Functor (ST r) where - map = map_ - -instance applyST :: Apply (ST r) where - apply = ap - -instance applicativeST :: Applicative (ST r) where - pure = pure_ - -instance bindST :: Bind (ST r) where - bind = bind_ - -instance monadST :: Monad (ST r) - -instance monadRecST :: MonadRec (ST r) where - tailRecM f a = do - r <- new =<< f a - while (isLooping <$> read r) do - read r >>= case _ of - Loop a' -> do - e <- f a' - void (write e r) - Done _ -> pure unit - fromDone <$> read r - where - fromDone :: forall a b. Step a b -> b - fromDone = unsafePartial \(Done b) -> b - - isLooping = case _ of - Loop _ -> true - _ -> false - -instance semigroupST :: Semigroup a => Semigroup (ST r a) where - append = lift2 append - -instance monoidST :: Monoid a => Monoid (ST r a) where - mempty = pure mempty - --- | Run an `ST` computation. --- | --- | Note: the type of `run` uses a rank-2 type to constrain the phantom --- | type `r`, such that the computation must not leak any mutable references --- | to the surrounding computation. It may cause problems to apply this --- | function using the `$` operator. The recommended approach is to use --- | parentheses instead. -foreign import run :: forall a. (forall r. ST r a) -> a - --- | Loop while a condition is `true`. --- | --- | `while b m` is ST computation which runs the ST computation `b`. If its --- | result is `true`, it runs the ST computation `m` and loops. If not, the --- | computation ends. -foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit - --- | Loop over a consecutive collection of numbers --- | --- | `ST.for lo hi f` runs the computation returned by the function `f` for each --- | of the inputs between `lo` (inclusive) and `hi` (exclusive). -foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit - --- | Loop over an array of values. --- | --- | `ST.foreach xs f` runs the computation returned by the function `f` for each --- | of the inputs `xs`. -foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit - --- | The type `STRef r a` represents a mutable reference holding a value of --- | type `a`, which can be used with the `ST r` effect. -foreign import data STRef :: Region -> Type -> Type - -type role STRef nominal representational - --- | Create a new mutable reference. -foreign import new :: forall a r. a -> ST r (STRef r a) - --- | Read the current value of a mutable reference. -foreign import read :: forall a r. STRef r a -> ST r a - --- | Update the value of a mutable reference by applying a function --- | to the current value, computing a new state value for the reference and --- | a return value. -modify' :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b -modify' = modifyImpl - -foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b - --- | Modify the value of a mutable reference by applying a function to the --- | current value. The modified value is returned. -modify :: forall r a. (a -> a) -> STRef r a -> ST r a -modify f = modify' \s -> let s' = f s in { state: s', value: s' } - --- | Set the value of a mutable reference. -foreign import write :: forall a r. a -> STRef r a -> ST r a diff --git a/stdlib/lib/Control/Monad/ST/Ref.purs b/stdlib/lib/Control/Monad/ST/Ref.purs deleted file mode 100644 index 1759d9fb..00000000 --- a/stdlib/lib/Control/Monad/ST/Ref.purs +++ /dev/null @@ -1,3 +0,0 @@ -module Control.Monad.ST.Ref (module Internal) where - -import Control.Monad.ST.Internal (STRef, new, read, modify, modify', write) as Internal diff --git a/stdlib/lib/Control/Monad/ST/Uncurried.purs b/stdlib/lib/Control/Monad/ST/Uncurried.purs deleted file mode 100644 index 2eced884..00000000 --- a/stdlib/lib/Control/Monad/ST/Uncurried.purs +++ /dev/null @@ -1,101 +0,0 @@ --- | This module defines types for STf uncurried functions, as well as --- | functions for converting back and forth between them. --- | --- | The general naming scheme for functions and types in this module is as --- | follows: --- | --- | * `STFn{N}` means, an uncurried function which accepts N arguments and --- | performs some STs. The first N arguments are the actual function's --- | argument. The last type argument is the return type. --- | * `runSTFn{N}` takes an `STFn` of N arguments, and converts it into --- | the normal PureScript form: a curried function which returns an ST --- | action. --- | * `mkSTFn{N}` is the inverse of `runSTFn{N}`. It can be useful for --- | callbacks. --- | - -module Control.Monad.ST.Uncurried where - -import Control.Monad.ST.Internal (ST, Region) - -foreign import data STFn1 :: Type -> Region -> Type -> Type - -type role STFn1 representational nominal representational - -foreign import data STFn2 :: Type -> Type -> Region -> Type -> Type - -type role STFn2 representational representational nominal representational - -foreign import data STFn3 :: Type -> Type -> Type -> Region -> Type -> Type - -type role STFn3 representational representational representational nominal representational - -foreign import data STFn4 :: Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn4 representational representational representational representational nominal representational - -foreign import data STFn5 :: Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn5 representational representational representational representational representational nominal representational - -foreign import data STFn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn6 representational representational representational representational representational representational nominal representational - -foreign import data STFn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn7 representational representational representational representational representational representational representational nominal representational - -foreign import data STFn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn8 representational representational representational representational representational representational representational representational nominal representational - -foreign import data STFn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn9 representational representational representational representational representational representational representational representational representational nominal representational - -foreign import data STFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type - -type role STFn10 representational representational representational representational representational representational representational representational representational representational nominal representational - -foreign import mkSTFn1 :: forall a t r. - (a -> ST t r) -> STFn1 a t r -foreign import mkSTFn2 :: forall a b t r. - (a -> b -> ST t r) -> STFn2 a b t r -foreign import mkSTFn3 :: forall a b c t r. - (a -> b -> c -> ST t r) -> STFn3 a b c t r -foreign import mkSTFn4 :: forall a b c d t r. - (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r -foreign import mkSTFn5 :: forall a b c d e t r. - (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r -foreign import mkSTFn6 :: forall a b c d e f t r. - (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r -foreign import mkSTFn7 :: forall a b c d e f g t r. - (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r -foreign import mkSTFn8 :: forall a b c d e f g h t r. - (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r -foreign import mkSTFn9 :: forall a b c d e f g h i t r. - (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r -foreign import mkSTFn10 :: forall a b c d e f g h i j t r. - (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r - -foreign import runSTFn1 :: forall a t r. - STFn1 a t r -> a -> ST t r -foreign import runSTFn2 :: forall a b t r. - STFn2 a b t r -> a -> b -> ST t r -foreign import runSTFn3 :: forall a b c t r. - STFn3 a b c t r -> a -> b -> c -> ST t r -foreign import runSTFn4 :: forall a b c d t r. - STFn4 a b c d t r -> a -> b -> c -> d -> ST t r -foreign import runSTFn5 :: forall a b c d e t r. - STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r -foreign import runSTFn6 :: forall a b c d e f t r. - STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r -foreign import runSTFn7 :: forall a b c d e f g t r. - STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r -foreign import runSTFn8 :: forall a b c d e f g h t r. - STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r -foreign import runSTFn9 :: forall a b c d e f g h i t r. - STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r -foreign import runSTFn10 :: forall a b c d e f g h i j t r. - STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r diff --git a/stdlib/lib/Control/MonadPlus.purs b/stdlib/lib/Control/MonadPlus.purs deleted file mode 100644 index 83f71abc..00000000 --- a/stdlib/lib/Control/MonadPlus.purs +++ /dev/null @@ -1,32 +0,0 @@ -module Control.MonadPlus - ( class MonadPlus - , module Control.Alt - , module Control.Alternative - , module Control.Applicative - , module Control.Apply - , module Control.Bind - , module Control.Monad - , module Control.Plus - , module Data.Functor - ) where - -import Control.Alt (class Alt, alt, (<|>)) -import Control.Alternative (class Alternative, guard) -import Control.Applicative (class Applicative, pure, liftA1, unless, when) -import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Bind (class Bind, bind, ifM, join, (<=<), (=<<), (>=>), (>>=)) -import Control.Monad (class Monad, ap, liftM1) -import Control.Plus (class Plus, empty) - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) - --- | The `MonadPlus` type class has no members of its own; it just specifies --- | that the type has both `Monad` and `Alternative` instances. --- | --- | Types which have `MonadPlus` instances should also satisfy the following --- | law: --- | --- | - Distributivity: `(x <|> y) >>= f == (x >>= f) <|> (y >>= f)` -class (Monad m, Alternative m) <= MonadPlus m - -instance monadPlusArray :: MonadPlus Array diff --git a/stdlib/lib/Control/Plus.purs b/stdlib/lib/Control/Plus.purs deleted file mode 100644 index f8724ea6..00000000 --- a/stdlib/lib/Control/Plus.purs +++ /dev/null @@ -1,27 +0,0 @@ -module Control.Plus - ( class Plus, empty - , module Control.Alt - , module Data.Functor - ) where - -import Control.Alt (class Alt, alt, (<|>)) - -import Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>)) - --- | The `Plus` type class extends the `Alt` type class with a value that --- | should be the left and right identity for `(<|>)`. --- | --- | It is similar to `Monoid`, except that it applies to types of --- | kind `* -> *`, like `Array` or `List`, rather than concrete types like --- | `String` or `Number`. --- | --- | `Plus` instances should satisfy the following laws: --- | --- | - Left identity: `empty <|> x == x` --- | - Right identity: `x <|> empty == x` --- | - Annihilation: `f <$> empty == empty` -class Alt f <= Plus f where - empty :: forall a. f a - -instance plusArray :: Plus Array where - empty = [] diff --git a/stdlib/lib/Control/Semigroupoid.purs b/stdlib/lib/Control/Semigroupoid.purs deleted file mode 100644 index a529e0f7..00000000 --- a/stdlib/lib/Control/Semigroupoid.purs +++ /dev/null @@ -1,25 +0,0 @@ -module Control.Semigroupoid where - --- | A `Semigroupoid` is similar to a [`Category`](#category) but does not --- | require an identity element `identity`, just composable morphisms. --- | --- | `Semigroupoid`s must satisfy the following law: --- | --- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r` --- | --- | One example of a `Semigroupoid` is the function type constructor `(->)`, --- | with `(<<<)` defined as function composition. -class Semigroupoid :: forall k. (k -> k -> Type) -> Constraint -class Semigroupoid a where - compose :: forall b c d. a c d -> a b c -> a b d - -instance semigroupoidFn :: Semigroupoid (->) where - compose f g x = f (g x) - -infixr 9 compose as <<< - --- | Forwards composition, or `compose` with its arguments reversed. -composeFlipped :: forall a b c d. Semigroupoid a => a b c -> a c d -> a b d -composeFlipped f g = compose g f - -infixr 9 composeFlipped as >>> diff --git a/stdlib/lib/Data/Array.purs b/stdlib/lib/Data/Array.purs deleted file mode 100644 index 431f942a..00000000 --- a/stdlib/lib/Data/Array.purs +++ /dev/null @@ -1,1371 +0,0 @@ --- | Helper functions for working with immutable Javascript arrays. --- | --- | _Note_: Depending on your use-case, you may prefer to use `Data.List` or --- | `Data.Sequence` instead, which might give better performance for certain --- | use cases. This module is useful when integrating with JavaScript libraries --- | which use arrays, but immutable arrays are not a practical data structure --- | for many use cases due to their poor asymptotics. --- | --- | In addition to the functions in this module, Arrays have a number of --- | useful instances: --- | --- | * `Functor`, which provides `map :: forall a b. (a -> b) -> Array a -> --- | Array b` --- | * `Apply`, which provides `(<*>) :: forall a b. Array (a -> b) -> Array a --- | -> Array b`. This function works a bit like a Cartesian product; the --- | result array is constructed by applying each function in the first --- | array to each value in the second, so that the result array ends up with --- | a length equal to the product of the two arguments' lengths. --- | * `Bind`, which provides `(>>=) :: forall a b. (a -> Array b) -> Array a --- | -> Array b` (this is the same as `concatMap`). --- | * `Semigroup`, which provides `(<>) :: forall a. Array a -> Array a -> --- | Array a`, for concatenating arrays. --- | * `Foldable`, which provides a slew of functions for *folding* (also known --- | as *reducing*) arrays down to one value. For example, --- | `Data.Foldable.or` tests whether an array of `Boolean` values contains --- | at least one `true` value. --- | * `Traversable`, which provides the PureScript version of a for-loop, --- | allowing you to STAI.iterate over an array and accumulate effects. --- | -module Data.Array - ( fromFoldable - , toUnfoldable - , singleton - , (..) - , range - , replicate - , some - , many - - , null - , length - - , (:) - , cons - , snoc - , insert - , insertBy - - , head - , last - , tail - , init - , uncons - , unsnoc - - , (!!) - , index - , elem - , notElem - , elemIndex - , elemLastIndex - , find - , findMap - , findIndex - , findLastIndex - , insertAt - , deleteAt - , updateAt - , updateAtIndices - , modifyAt - , modifyAtIndices - , alterAt - - , intersperse - , reverse - , concat - , concatMap - , filter - , partition - , splitAt - , filterA - , mapMaybe - , catMaybes - , mapWithIndex - , foldl - , foldr - , foldMap - , fold - , intercalate - , transpose - , scanl - , scanr - - , sort - , sortBy - , sortWith - , slice - , take - , takeEnd - , takeWhile - , drop - , dropEnd - , dropWhile - , span - , group - , groupAll - , groupBy - , groupAllBy - - , nub - , nubEq - , nubBy - , nubByEq - , union - , unionBy - , delete - , deleteBy - - , (\\) - , difference - , intersect - , intersectBy - - , zipWith - , zipWithA - , zip - , unzip - - , any - , all - - , foldM - , foldRecM - - , unsafeIndex - ) where - -import Prelude - -import Control.Alt ((<|>)) -import Control.Alternative (class Alternative) -import Control.Lazy (class Lazy, defer) -import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2) -import Control.Monad.ST as ST -import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) -import Data.Array.ST as STA -import Data.Array.ST.Iterator as STAI -import Data.Foldable (class Foldable, traverse_) -import Data.Foldable as F -import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn5, runFn2, runFn3, runFn4, runFn5) -import Data.FunctorWithIndex as FWI -import Data.Maybe (Maybe(..), maybe, isJust, fromJust, isNothing) -import Data.Traversable (sequence, traverse) -import Data.Tuple (Tuple(..), fst, snd) -import Data.Unfoldable (class Unfoldable, unfoldr) -import Partial.Unsafe (unsafePartial) - --- | Convert an `Array` into an `Unfoldable` structure. -toUnfoldable :: forall f. Unfoldable f => Array ~> f -toUnfoldable xs = unfoldr f 0 - where - len = length xs - f i - | i < len = Just (Tuple (unsafePartial (unsafeIndex xs i)) (i + 1)) - | otherwise = Nothing - --- | Convert a `Foldable` structure into an `Array`. --- | --- | ```purescript --- | fromFoldable (Just 1) = [1] --- | fromFoldable (Nothing) = [] --- | ``` --- | -fromFoldable :: forall f. Foldable f => f ~> Array -fromFoldable = runFn2 fromFoldableImpl F.foldr - -foreign import fromFoldableImpl - :: forall f a - . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a) - --- | Create an array of one element --- | ```purescript --- | singleton 2 = [2] --- | ``` -singleton :: forall a. a -> Array a -singleton a = [ a ] - --- | Create an array containing a range of integers, including both endpoints. --- | ```purescript --- | range 2 5 = [2, 3, 4, 5] --- | ``` -range :: Int -> Int -> Array Int -range = runFn2 rangeImpl - -foreign import rangeImpl :: Fn2 Int Int (Array Int) - --- | Create an array containing a value repeated the specified number of times. --- | ```purescript --- | replicate 2 "Hi" = ["Hi", "Hi"] --- | ``` -replicate :: forall a. Int -> a -> Array a -replicate = runFn2 replicateImpl - -foreign import replicateImpl :: forall a. Fn2 Int a (Array a) - --- | An infix synonym for `range`. --- | ```purescript --- | 2 .. 5 = [2, 3, 4, 5] --- | ``` -infix 8 range as .. - --- | Attempt a computation multiple times, requiring at least one success. --- | --- | The `Lazy` constraint is used to generate the result lazily, to ensure --- | termination. -some :: forall f a. Alternative f => Lazy (f (Array a)) => f a -> f (Array a) -some v = (:) <$> v <*> defer (\_ -> many v) - --- | Attempt a computation multiple times, returning as many successful results --- | as possible (possibly zero). --- | --- | The `Lazy` constraint is used to generate the result lazily, to ensure --- | termination. -many :: forall f a. Alternative f => Lazy (f (Array a)) => f a -> f (Array a) -many v = some v <|> pure [] - --------------------------------------------------------------------------------- --- Array size ------------------------------------------------------------------ --------------------------------------------------------------------------------- - --- | Test whether an array is empty. --- | ```purescript --- | null [] = true --- | null [1, 2] = false --- | ``` -null :: forall a. Array a -> Boolean -null xs = length xs == 0 - --- | Get the number of elements in an array. --- | ```purescript --- | length ["Hello", "World"] = 2 --- | ``` -foreign import length :: forall a. Array a -> Int - --------------------------------------------------------------------------------- --- Extending arrays ------------------------------------------------------------ --------------------------------------------------------------------------------- - --- | Attaches an element to the front of an array, creating a new array. --- | --- | ```purescript --- | cons 1 [2, 3, 4] = [1, 2, 3, 4] --- | ``` --- | --- | Note, the running time of this function is `O(n)`. -cons :: forall a. a -> Array a -> Array a -cons x xs = [ x ] <> xs - --- | An infix alias for `cons`. --- | --- | ```purescript --- | 1 : [2, 3, 4] = [1, 2, 3, 4] --- | ``` --- | --- | Note, the running time of this function is `O(n)`. -infixr 6 cons as : - --- | Append an element to the end of an array, creating a new array. --- | --- | ```purescript --- | snoc [1, 2, 3] 4 = [1, 2, 3, 4] --- | ``` --- | -snoc :: forall a. Array a -> a -> Array a -snoc xs x = ST.run (STA.withArray (STA.push x) xs) - --- | Insert an element into a sorted array. --- | --- | ```purescript --- | insert 10 [1, 2, 20, 21] = [1, 2, 10, 20, 21] --- | ``` --- | -insert :: forall a. Ord a => a -> Array a -> Array a -insert = insertBy compare - --- | Insert an element into a sorted array, using the specified function to --- | determine the ordering of elements. --- | --- | ```purescript --- | invertCompare a b = invert $ compare a b --- | --- | insertBy invertCompare 10 [21, 20, 2, 1] = [21, 20, 10, 2, 1] --- | ``` --- | -insertBy :: forall a. (a -> a -> Ordering) -> a -> Array a -> Array a -insertBy cmp x ys = - let - i = maybe 0 (_ + 1) (findLastIndex (\y -> cmp x y == GT) ys) - in - unsafePartial (fromJust (insertAt i x ys)) - --------------------------------------------------------------------------------- --- Non-indexed reads ----------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Get the first element in an array, or `Nothing` if the array is empty --- | --- | Running time: `O(1)`. --- | --- | ```purescript --- | head [1, 2] = Just 1 --- | head [] = Nothing --- | ``` --- | -head :: forall a. Array a -> Maybe a -head xs = xs !! 0 - --- | Get the last element in an array, or `Nothing` if the array is empty --- | --- | Running time: `O(1)`. --- | --- | ```purescript --- | last [1, 2] = Just 2 --- | last [] = Nothing --- | ``` --- | -last :: forall a. Array a -> Maybe a -last xs = xs !! (length xs - 1) - --- | Get all but the first element of an array, creating a new array, or --- | `Nothing` if the array is empty --- | --- | ```purescript --- | tail [1, 2, 3, 4] = Just [2, 3, 4] --- | tail [] = Nothing --- | ``` --- | --- | Running time: `O(n)` where `n` is the length of the array -tail :: forall a. Array a -> Maybe (Array a) -tail = runFn3 unconsImpl (const Nothing) (\_ xs -> Just xs) - --- | Get all but the last element of an array, creating a new array, or --- | `Nothing` if the array is empty. --- | --- | ```purescript --- | init [1, 2, 3, 4] = Just [1, 2, 3] --- | init [] = Nothing --- | ``` --- | --- | Running time: `O(n)` where `n` is the length of the array -init :: forall a. Array a -> Maybe (Array a) -init xs - | null xs = Nothing - | otherwise = Just (slice zero (length xs - one) xs) - --- | Break an array into its first element and remaining elements. --- | --- | Using `uncons` provides a way of writing code that would use cons patterns --- | in Haskell or pre-PureScript 0.7: --- | ``` purescript --- | f (x : xs) = something --- | f [] = somethingElse --- | ``` --- | Becomes: --- | ``` purescript --- | f arr = case uncons arr of --- | Just { head: x, tail: xs } -> something --- | Nothing -> somethingElse --- | ``` -uncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a } -uncons = runFn3 unconsImpl (const Nothing) \x xs -> Just { head: x, tail: xs } - -foreign import unconsImpl - :: forall a b - . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b - --- | Break an array into its last element and all preceding elements. --- | --- | ```purescript --- | unsnoc [1, 2, 3] = Just {init: [1, 2], last: 3} --- | unsnoc [] = Nothing --- | ``` --- | --- | Running time: `O(n)` where `n` is the length of the array -unsnoc :: forall a. Array a -> Maybe { init :: Array a, last :: a } -unsnoc xs = { init: _, last: _ } <$> init xs <*> last xs - --------------------------------------------------------------------------------- --- Indexed operations ---------------------------------------------------------- --------------------------------------------------------------------------------- - --- | This function provides a safe way to read a value at a particular index --- | from an array. --- | --- | ```purescript --- | sentence = ["Hello", "World", "!"] --- | --- | index sentence 0 = Just "Hello" --- | index sentence 7 = Nothing --- | ``` --- | -index :: forall a. Array a -> Int -> Maybe a -index = runFn4 indexImpl Just Nothing - -foreign import indexImpl - :: forall a - . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a) - --- | An infix version of `index`. --- | --- | ```purescript --- | sentence = ["Hello", "World", "!"] --- | --- | sentence !! 0 = Just "Hello" --- | sentence !! 7 = Nothing --- | ``` --- | -infixl 8 index as !! - --- | Returns true if the array has the given element. -elem :: forall a. Eq a => a -> Array a -> Boolean -elem a arr = isJust $ elemIndex a arr - --- | Returns true if the array does not have the given element. -notElem :: forall a. Eq a => a -> Array a -> Boolean -notElem a arr = isNothing $ elemIndex a arr - --- | Find the index of the first element equal to the specified element. --- | --- | ```purescript --- | elemIndex "a" ["a", "b", "a", "c"] = Just 0 --- | elemIndex "Earth" ["Hello", "World", "!"] = Nothing --- | ``` --- | -elemIndex :: forall a. Eq a => a -> Array a -> Maybe Int -elemIndex x = findIndex (_ == x) - --- | Find the index of the last element equal to the specified element. --- | --- | ```purescript --- | elemLastIndex "a" ["a", "b", "a", "c"] = Just 2 --- | elemLastIndex "Earth" ["Hello", "World", "!"] = Nothing --- | ``` --- | -elemLastIndex :: forall a. Eq a => a -> Array a -> Maybe Int -elemLastIndex x = findLastIndex (_ == x) - --- | Find the first element for which a predicate holds. --- | --- | ```purescript --- | find (contains $ Pattern "b") ["a", "bb", "b", "d"] = Just "bb" --- | find (contains $ Pattern "x") ["a", "bb", "b", "d"] = Nothing --- | ``` -find :: forall a. (a -> Boolean) -> Array a -> Maybe a -find f xs = unsafePartial (unsafeIndex xs) <$> findIndex f xs - --- | Find the first element in a data structure which satisfies --- | a predicate mapping. -findMap :: forall a b. (a -> Maybe b) -> Array a -> Maybe b -findMap = runFn4 findMapImpl Nothing isJust - -foreign import findMapImpl - :: forall a b - . Fn4 - (forall c. Maybe c) - (forall c. Maybe c -> Boolean) - (a -> Maybe b) - (Array a) - (Maybe b) - --- | Find the first index for which a predicate holds. --- | --- | ```purescript --- | findIndex (contains $ Pattern "b") ["a", "bb", "b", "d"] = Just 1 --- | findIndex (contains $ Pattern "x") ["a", "bb", "b", "d"] = Nothing --- | ``` --- | -findIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int -findIndex = runFn4 findIndexImpl Just Nothing - -foreign import findIndexImpl - :: forall a - . Fn4 - (forall b. b -> Maybe b) - (forall b. Maybe b) - (a -> Boolean) - (Array a) - (Maybe Int) - --- | Find the last index for which a predicate holds. --- | --- | ```purescript --- | findLastIndex (contains $ Pattern "b") ["a", "bb", "b", "d"] = Just 2 --- | findLastIndex (contains $ Pattern "x") ["a", "bb", "b", "d"] = Nothing --- | ``` --- | -findLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int -findLastIndex = runFn4 findLastIndexImpl Just Nothing - -foreign import findLastIndexImpl - :: forall a - . Fn4 - (forall b. b -> Maybe b) - (forall b. Maybe b) - (a -> Boolean) - (Array a) - (Maybe Int) - --- | Insert an element at the specified index, creating a new array, or --- | returning `Nothing` if the index is out of bounds. --- | --- | ```purescript --- | insertAt 2 "!" ["Hello", "World"] = Just ["Hello", "World", "!"] --- | insertAt 10 "!" ["Hello"] = Nothing --- | ``` --- | -insertAt :: forall a. Int -> a -> Array a -> Maybe (Array a) -insertAt = runFn5 _insertAt Just Nothing - -foreign import _insertAt - :: forall a - . Fn5 - (forall b. b -> Maybe b) - (forall b. Maybe b) - Int - a - (Array a) - (Maybe (Array a)) - --- | Delete the element at the specified index, creating a new array, or --- | returning `Nothing` if the index is out of bounds. --- | --- | ```purescript --- | deleteAt 0 ["Hello", "World"] = Just ["World"] --- | deleteAt 10 ["Hello", "World"] = Nothing --- | ``` --- | -deleteAt :: forall a. Int -> Array a -> Maybe (Array a) -deleteAt = runFn4 _deleteAt Just Nothing - -foreign import _deleteAt - :: forall a - . Fn4 - (forall b. b -> Maybe b) - (forall b. Maybe b) - Int - (Array a) - (Maybe (Array a)) - --- | Change the element at the specified index, creating a new array, or --- | returning `Nothing` if the index is out of bounds. --- | --- | ```purescript --- | updateAt 1 "World" ["Hello", "Earth"] = Just ["Hello", "World"] --- | updateAt 10 "World" ["Hello", "Earth"] = Nothing --- | ``` --- | -updateAt :: forall a. Int -> a -> Array a -> Maybe (Array a) -updateAt = runFn5 _updateAt Just Nothing - -foreign import _updateAt - :: forall a - . Fn5 - (forall b. b -> Maybe b) - (forall b. Maybe b) - Int - a - (Array a) - (Maybe (Array a)) - --- | Apply a function to the element at the specified index, creating a new --- | array, or returning `Nothing` if the index is out of bounds. --- | --- | ```purescript --- | modifyAt 1 toUpper ["Hello", "World"] = Just ["Hello", "WORLD"] --- | modifyAt 10 toUpper ["Hello", "World"] = Nothing --- | ``` --- | -modifyAt :: forall a. Int -> (a -> a) -> Array a -> Maybe (Array a) -modifyAt i f xs = maybe Nothing go (xs !! i) - where - go x = updateAt i (f x) xs - --- | Update or delete the element at the specified index by applying a --- | function to the current value, returning a new array or `Nothing` if the --- | index is out-of-bounds. --- | --- | ```purescript --- | alterAt 1 (stripSuffix $ Pattern "!") ["Hello", "World!"] --- | = Just ["Hello", "World"] --- | --- | alterAt 1 (stripSuffix $ Pattern "!!!!!") ["Hello", "World!"] --- | = Just ["Hello"] --- | --- | alterAt 10 (stripSuffix $ Pattern "!") ["Hello", "World!"] = Nothing --- | ``` --- | -alterAt :: forall a. Int -> (a -> Maybe a) -> Array a -> Maybe (Array a) -alterAt i f xs = maybe Nothing go (xs !! i) - where - go x = case f x of - Nothing -> deleteAt i xs - Just x' -> updateAt i x' xs - --------------------------------------------------------------------------------- --- Transformations ------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Inserts the given element in between each element in the array. The array --- | must have two or more elements for this operation to take effect. --- | --- | ```purescript --- | intersperse " " [ "a", "b" ] == [ "a", " ", "b" ] --- | intersperse 0 [ 1, 2, 3, 4, 5 ] == [ 1, 0, 2, 0, 3, 0, 4, 0, 5 ] --- | ``` --- | --- | If the array has less than two elements, the input array is returned. --- | ```purescript --- | intersperse " " [] == [] --- | intersperse " " ["a"] == ["a"] --- | ``` -intersperse :: forall a. a -> Array a -> Array a -intersperse a arr = case length arr of - len - | len < 2 -> arr - | otherwise -> STA.run do - let unsafeGetElem idx = unsafePartial (unsafeIndex arr idx) - out <- STA.new - _ <- STA.push (unsafeGetElem 0) out - ST.for 1 len \idx -> do - _ <- STA.push a out - void (STA.push (unsafeGetElem idx) out) - pure out - --- | Reverse an array, creating a new array. --- | --- | ```purescript --- | reverse [] = [] --- | reverse [1, 2, 3] = [3, 2, 1] --- | ``` --- | -foreign import reverse :: forall a. Array a -> Array a - --- | Flatten an array of arrays, creating a new array. --- | --- | ```purescript --- | concat [[1, 2, 3], [], [4, 5, 6]] = [1, 2, 3, 4, 5, 6] --- | ``` --- | -foreign import concat :: forall a. Array (Array a) -> Array a - --- | Apply a function to each element in an array, and flatten the results --- | into a single, new array. --- | --- | ```purescript --- | concatMap (split $ Pattern " ") ["Hello World", "other thing"] --- | = ["Hello", "World", "other", "thing"] --- | ``` --- | -concatMap :: forall a b. (a -> Array b) -> Array a -> Array b -concatMap = flip bind - --- | Filter an array, keeping the elements which satisfy a predicate function, --- | creating a new array. --- | --- | ```purescript --- | filter (_ > 0) [-1, 4, -5, 7] = [4, 7] --- | ``` --- | -filter :: forall a. (a -> Boolean) -> Array a -> Array a -filter = runFn2 filterImpl - -foreign import filterImpl - :: forall a - . Fn2 (a -> Boolean) (Array a) (Array a) - --- | Partition an array using a predicate function, creating a set of --- | new arrays. One for the values satisfying the predicate function --- | and one for values that don't. --- | --- | ```purescript --- | partition (_ > 0) [-1, 4, -5, 7] = { yes: [4, 7], no: [-1, -5] } --- | ``` --- | -partition - :: forall a - . (a -> Boolean) - -> Array a - -> { yes :: Array a, no :: Array a } -partition = runFn2 partitionImpl - -foreign import partitionImpl - :: forall a - . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a } - --- | Splits an array into two subarrays, where `before` contains the elements --- | up to (but not including) the given index, and `after` contains the rest --- | of the elements, from that index on. --- | --- | ```purescript --- | >>> splitAt 3 [1, 2, 3, 4, 5] --- | { before: [1, 2, 3], after: [4, 5] } --- | ``` --- | --- | Thus, the length of `(splitAt i arr).before` will equal either `i` or --- | `length arr`, if that is shorter. (Or if `i` is negative the length will --- | be 0.) --- | --- | ```purescript --- | splitAt 2 ([] :: Array Int) == { before: [], after: [] } --- | splitAt 3 [1, 2, 3, 4, 5] == { before: [1, 2, 3], after: [4, 5] } --- | ``` -splitAt :: forall a. Int -> Array a -> { before :: Array a, after :: Array a } -splitAt i xs | i <= 0 = { before: [], after: xs } -splitAt i xs = { before: slice 0 i xs, after: slice i (length xs) xs } - --- | Filter where the predicate returns a `Boolean` in some `Applicative`. --- | --- | ```purescript --- | powerSet :: forall a. Array a -> Array (Array a) --- | powerSet = filterA (const [true, false]) --- | ``` -filterA :: forall a f. Applicative f => (a -> f Boolean) -> Array a -> f (Array a) -filterA p = - traverse (\x -> Tuple x <$> p x) - >>> map (mapMaybe (\(Tuple x b) -> if b then Just x else Nothing)) - --- | Apply a function to each element in an array, keeping only the results --- | which contain a value, creating a new array. --- | --- | ```purescript --- | parseEmail :: String -> Maybe Email --- | parseEmail = ... --- | --- | mapMaybe parseEmail ["a.com", "hello@example.com", "--"] --- | = [Email {user: "hello", domain: "example.com"}] --- | ``` --- | -mapMaybe :: forall a b. (a -> Maybe b) -> Array a -> Array b -mapMaybe f = concatMap (maybe [] singleton <<< f) - --- | Filter an array of optional values, keeping only the elements which contain --- | a value, creating a new array. --- | --- | ```purescript --- | catMaybes [Nothing, Just 2, Nothing, Just 4] = [2, 4] --- | ``` --- | -catMaybes :: forall a. Array (Maybe a) -> Array a -catMaybes = mapMaybe identity - --- | Apply a function to each element in an array, supplying a generated --- | zero-based index integer along with the element, creating an array --- | with the new elements. --- | --- | ```purescript --- | prefixIndex index element = show index <> element --- | --- | mapWithIndex prefixIndex ["Hello", "World"] = ["0Hello", "1World"] --- | ``` --- | -mapWithIndex :: forall a b. (Int -> a -> b) -> Array a -> Array b -mapWithIndex = FWI.mapWithIndex - --- | Change the elements at the specified indices in index/value pairs. --- | Out-of-bounds indices will have no effect. --- | --- | ```purescript --- | updates = [Tuple 0 "Hi", Tuple 2 "." , Tuple 10 "foobar"] --- | --- | updateAtIndices updates ["Hello", "World", "!"] = ["Hi", "World", "."] --- | ``` --- | -updateAtIndices :: forall t a. Foldable t => t (Tuple Int a) -> Array a -> Array a -updateAtIndices us xs = - ST.run (STA.withArray (\res -> traverse_ (\(Tuple i a) -> STA.poke i a res) us) xs) - --- | Apply a function to the element at the specified indices, --- | creating a new array. Out-of-bounds indices will have no effect. --- | --- | ```purescript --- | indices = [1, 3] --- | modifyAtIndices indices toUpper ["Hello", "World", "and", "others"] --- | = ["Hello", "WORLD", "and", "OTHERS"] --- | ``` --- | -modifyAtIndices :: forall t a. Foldable t => t Int -> (a -> a) -> Array a -> Array a -modifyAtIndices is f xs = - ST.run (STA.withArray (\res -> traverse_ (\i -> STA.modify i f res) is) xs) - -foldl :: forall a b. (b -> a -> b) -> b -> Array a -> b -foldl = F.foldl - -foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b -foldr = F.foldr - -foldMap :: forall a m. Monoid m => (a -> m) -> Array a -> m -foldMap = F.foldMap - -fold :: forall m. Monoid m => Array m -> m -fold = F.fold - -intercalate :: forall a. Monoid a => a -> Array a -> a -intercalate = F.intercalate - --- | The 'transpose' function transposes the rows and columns of its argument. --- | For example, --- | --- | ```purescript --- | transpose --- | [ [1, 2, 3] --- | , [4, 5, 6] --- | ] == --- | [ [1, 4] --- | , [2, 5] --- | , [3, 6] --- | ] --- | ``` --- | --- | If some of the rows are shorter than the following rows, their elements are skipped: --- | --- | ```purescript --- | transpose --- | [ [10, 11] --- | , [20] --- | , [30, 31, 32] --- | ] == --- | [ [10, 20, 30] --- | , [11, 31] --- | , [32] --- | ] --- | ``` -transpose :: forall a. Array (Array a) -> Array (Array a) -transpose xs = go 0 [] - where - go :: Int -> Array (Array a) -> Array (Array a) - go idx allArrays = case buildNext idx of - Nothing -> allArrays - Just next -> go (idx + 1) (snoc allArrays next) - - buildNext :: Int -> Maybe (Array a) - buildNext idx = do - xs # flip foldl Nothing \acc nextArr -> do - maybe acc (\el -> Just $ maybe [ el ] (flip snoc el) acc) $ index nextArr idx - --- | Fold a data structure from the left, keeping all intermediate results --- | instead of only the final result. Note that the initial value does not --- | appear in the result (unlike Haskell's `Prelude.scanl`). --- | --- | ``` --- | scanl (+) 0 [1,2,3] = [1,3,6] --- | scanl (-) 10 [1,2,3] = [9,7,4] --- | ``` -scanl :: forall a b. (b -> a -> b) -> b -> Array a -> Array b -scanl = runFn3 scanlImpl - -foreign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b) - --- | Fold a data structure from the right, keeping all intermediate results --- | instead of only the final result. Note that the initial value does not --- | appear in the result (unlike Haskell's `Prelude.scanr`). --- | --- | ``` --- | scanr (+) 0 [1,2,3] = [6,5,3] --- | scanr (flip (-)) 10 [1,2,3] = [4,5,7] --- | ``` -scanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b -scanr = runFn3 scanrImpl - -foreign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b) - --------------------------------------------------------------------------------- --- Sorting --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Sort the elements of an array in increasing order, creating a new array. --- | Sorting is stable: the order of equal elements is preserved. --- | --- | ```purescript --- | sort [2, -3, 1] = [-3, 1, 2] --- | ``` --- | -sort :: forall a. Ord a => Array a -> Array a -sort xs = sortBy compare xs - --- | Sort the elements of an array in increasing order, where elements are --- | compared using the specified partial ordering, creating a new array. --- | Sorting is stable: the order of elements is preserved if they are equal --- | according to the specified partial ordering. --- | --- | ```purescript --- | compareLength a b = compare (length a) (length b) --- | sortBy compareLength [[1, 2, 3], [7, 9], [-2]] = [[-2],[7,9],[1,2,3]] --- | ``` --- | -sortBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a -sortBy comp = runFn3 sortByImpl comp case _ of - GT -> 1 - EQ -> 0 - LT -> -1 - --- | Sort the elements of an array in increasing order, where elements are --- | sorted based on a projection. Sorting is stable: the order of elements is --- | preserved if they are equal according to the projection. --- | --- | ```purescript --- | sortWith (_.age) [{name: "Alice", age: 42}, {name: "Bob", age: 21}] --- | = [{name: "Bob", age: 21}, {name: "Alice", age: 42}] --- | ``` --- | -sortWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a -sortWith f = sortBy (comparing f) - -foreign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a) - --------------------------------------------------------------------------------- --- Subarrays ------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Extract a subarray by a start and end index. --- | --- | ```purescript --- | letters = ["a", "b", "c"] --- | slice 1 3 letters = ["b", "c"] --- | slice 5 7 letters = [] --- | slice 4 1 letters = [] --- | ``` --- | -slice :: forall a. Int -> Int -> Array a -> Array a -slice = runFn3 sliceImpl - -foreign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a) - --- | Keep only a number of elements from the start of an array, creating a new --- | array. --- | --- | ```purescript --- | letters = ["a", "b", "c"] --- | --- | take 2 letters = ["a", "b"] --- | take 100 letters = ["a", "b", "c"] --- | ``` --- | -take :: forall a. Int -> Array a -> Array a -take n xs = if n < 1 then [] else slice 0 n xs - --- | Keep only a number of elements from the end of an array, creating a new --- | array. --- | --- | ```purescript --- | letters = ["a", "b", "c"] --- | --- | takeEnd 2 letters = ["b", "c"] --- | takeEnd 100 letters = ["a", "b", "c"] --- | ``` --- | -takeEnd :: forall a. Int -> Array a -> Array a -takeEnd n xs = drop (length xs - n) xs - --- | Calculate the longest initial subarray for which all element satisfy the --- | specified predicate, creating a new array. --- | --- | ```purescript --- | takeWhile (_ > 0) [4, 1, 0, -4, 5] = [4, 1] --- | takeWhile (_ > 0) [-1, 4] = [] --- | ``` --- | -takeWhile :: forall a. (a -> Boolean) -> Array a -> Array a -takeWhile p xs = (span p xs).init - --- | Drop a number of elements from the start of an array, creating a new array. --- | --- | ```purescript --- | letters = ["a", "b", "c", "d"] --- | --- | drop 2 letters = ["c", "d"] --- | drop 10 letters = [] --- | ``` --- | -drop :: forall a. Int -> Array a -> Array a -drop n xs = if n < 1 then xs else slice n (length xs) xs - --- | Drop a number of elements from the end of an array, creating a new array. --- | --- | ```purescript --- | letters = ["a", "b", "c", "d"] --- | --- | dropEnd 2 letters = ["a", "b"] --- | dropEnd 10 letters = [] --- | ``` --- | -dropEnd :: forall a. Int -> Array a -> Array a -dropEnd n xs = take (length xs - n) xs - --- | Remove the longest initial subarray for which all element satisfy the --- | specified predicate, creating a new array. --- | --- | ```purescript --- | dropWhile (_ < 0) [-3, -1, 0, 4, -6] = [0, 4, -6] --- | ``` --- | -dropWhile :: forall a. (a -> Boolean) -> Array a -> Array a -dropWhile p xs = (span p xs).rest - --- | Split an array into two parts: --- | --- | 1. the longest initial subarray for which all elements satisfy the --- | specified predicate --- | 2. the remaining elements --- | --- | ```purescript --- | span (\n -> n % 2 == 1) [1,3,2,4,5] == { init: [1,3], rest: [2,4,5] } --- | ``` --- | --- | Running time: `O(n)`. -span - :: forall a - . (a -> Boolean) - -> Array a - -> { init :: Array a, rest :: Array a } -span p arr = - case breakIndex of - Just 0 -> - { init: [], rest: arr } - Just i -> - { init: slice 0 i arr, rest: slice i (length arr) arr } - Nothing -> - { init: arr, rest: [] } - where - breakIndex = go 0 - go i = - -- This looks like a good opportunity to use the Monad Maybe instance, - -- but it's important to write out an explicit case expression here in - -- order to ensure that TCO is triggered. - case index arr i of - Just x -> if p x then go (i + 1) else Just i - Nothing -> Nothing - --- | Group equal, consecutive elements of an array into arrays. --- | --- | ```purescript --- | group [1, 1, 2, 2, 1] == [NonEmptyArray [1, 1], NonEmptyArray [2, 2], NonEmptyArray [1]] --- | ``` -group :: forall a. Eq a => Array a -> Array (NonEmptyArray a) -group xs = groupBy eq xs - --- | Group equal elements of an array into arrays. --- | --- | ```purescript --- | groupAll [1, 1, 2, 2, 1] == [NonEmptyArray [1, 1, 1], NonEmptyArray [2, 2]] --- | ``` -groupAll :: forall a. Ord a => Array a -> Array (NonEmptyArray a) -groupAll = groupAllBy compare - --- | Group equal, consecutive elements of an array into arrays, using the --- | specified equivalence relation to determine equality. --- | --- | ```purescript --- | groupBy (\a b -> odd a && odd b) [1, 3, 2, 4, 3, 3] --- | = [NonEmptyArray [1, 3], NonEmptyArray [2], NonEmptyArray [4], NonEmptyArray [3, 3]] --- | ``` --- | -groupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmptyArray a) -groupBy op xs = - ST.run do - result <- STA.new - iter <- STAI.iterator (xs !! _) - STAI.iterate iter \x -> void do - sub <- STA.new - _ <- STA.push x sub - STAI.pushWhile (op x) iter sub - grp <- STA.unsafeFreeze sub - STA.push (NonEmptyArray grp) result - STA.unsafeFreeze result - --- | Group equal elements of an array into arrays, using the specified --- | comparison function to determine equality. --- | --- | ```purescript --- | groupAllBy (comparing Down) [1, 3, 2, 4, 3, 3] --- | = [NonEmptyArray [4], NonEmptyArray [3, 3, 3], NonEmptyArray [2], NonEmptyArray [1]] --- | ``` --- | -groupAllBy :: forall a. (a -> a -> Ordering) -> Array a -> Array (NonEmptyArray a) -groupAllBy cmp = groupBy (\x y -> cmp x y == EQ) <<< sortBy cmp - --- | Remove the duplicates from an array, creating a new array. --- | --- | ```purescript --- | nub [1, 2, 1, 3, 3] = [1, 2, 3] --- | ``` --- | -nub :: forall a. Ord a => Array a -> Array a -nub = nubBy compare - --- | Remove the duplicates from an array, creating a new array. --- | --- | This less efficient version of `nub` only requires an `Eq` instance. --- | --- | ```purescript --- | nubEq [1, 2, 1, 3, 3] = [1, 2, 3] --- | ``` --- | -nubEq :: forall a. Eq a => Array a -> Array a -nubEq = nubByEq eq - --- | Remove the duplicates from an array, where element equality is determined --- | by the specified ordering, creating a new array. --- | --- | ```purescript --- | nubBy compare [1, 3, 4, 2, 2, 1] == [1, 3, 4, 2] --- | ``` --- | -nubBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a -nubBy comp xs = case head indexedAndSorted of - Nothing -> [] - Just x -> map snd $ sortWith fst $ ST.run do - -- TODO: use NonEmptyArrays here to avoid partial functions - result <- STA.unsafeThaw $ singleton x - ST.foreach indexedAndSorted \pair@(Tuple _ x') -> do - lst <- snd <<< unsafePartial (fromJust <<< last) <$> STA.unsafeFreeze result - when (comp lst x' /= EQ) $ void $ STA.push pair result - STA.unsafeFreeze result - where - indexedAndSorted :: Array (Tuple Int a) - indexedAndSorted = sortBy (\x y -> comp (snd x) (snd y)) - (mapWithIndex Tuple xs) - --- | Remove the duplicates from an array, where element equality is determined --- | by the specified equivalence relation, creating a new array. --- | --- | This less efficient version of `nubBy` only requires an equivalence --- | relation. --- | --- | ```purescript --- | mod3eq a b = a `mod` 3 == b `mod` 3 --- | nubByEq mod3eq [1, 3, 4, 5, 6] = [1, 3, 5] --- | ``` --- | -nubByEq :: forall a. (a -> a -> Boolean) -> Array a -> Array a -nubByEq eq xs = ST.run do - arr <- STA.new - ST.foreach xs \x -> do - e <- not <<< any (_ `eq` x) <$> (STA.unsafeFreeze arr) - when e $ void $ STA.push x arr - STA.unsafeFreeze arr - --- | Calculate the union of two arrays. Note that duplicates in the first array --- | are preserved while duplicates in the second array are removed. --- | --- | Running time: `O(n^2)` --- | --- | ```purescript --- | union [1, 2, 1, 1] [3, 3, 3, 4] = [1, 2, 1, 1, 3, 4] --- | ``` --- | -union :: forall a. Eq a => Array a -> Array a -> Array a -union = unionBy (==) - --- | Calculate the union of two arrays, using the specified function to --- | determine equality of elements. Note that duplicates in the first array --- | are preserved while duplicates in the second array are removed. --- | --- | ```purescript --- | mod3eq a b = a `mod` 3 == b `mod` 3 --- | unionBy mod3eq [1, 5, 1, 2] [3, 4, 3, 3] = [1, 5, 1, 2, 3] --- | ``` --- | -unionBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a -unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs - --- | Delete the first element of an array which is equal to the specified value, --- | creating a new array. --- | --- | ```purescript --- | delete 7 [1, 7, 3, 7] = [1, 3, 7] --- | delete 7 [1, 2, 3] = [1, 2, 3] --- | ``` --- | --- | Running time: `O(n)` -delete :: forall a. Eq a => a -> Array a -> Array a -delete = deleteBy eq - --- | Delete the first element of an array which matches the specified value, --- | under the equivalence relation provided in the first argument, creating a --- | new array. --- | --- | ```purescript --- | mod3eq a b = a `mod` 3 == b `mod` 3 --- | deleteBy mod3eq 6 [1, 3, 4, 3] = [1, 4, 3] --- | ``` --- | -deleteBy :: forall a. (a -> a -> Boolean) -> a -> Array a -> Array a -deleteBy _ _ [] = [] -deleteBy eq x ys = maybe ys (\i -> unsafePartial $ fromJust (deleteAt i ys)) (findIndex (eq x) ys) - --- | Delete the first occurrence of each element in the second array from the --- | first array, creating a new array. --- | --- | ```purescript --- | difference [2, 1] [2, 3] = [1] --- | ``` --- | --- | Running time: `O(n*m)`, where n is the length of the first array, and m is --- | the length of the second. -difference :: forall a. Eq a => Array a -> Array a -> Array a -difference = foldr delete - -infix 5 difference as \\ - --- | Calculate the intersection of two arrays, creating a new array. Note that --- | duplicates in the first array are preserved while duplicates in the second --- | array are removed. --- | --- | ```purescript --- | intersect [1, 1, 2] [2, 2, 1] = [1, 1, 2] --- | ``` --- | -intersect :: forall a. Eq a => Array a -> Array a -> Array a -intersect = intersectBy eq - --- | Calculate the intersection of two arrays, using the specified equivalence --- | relation to compare elements, creating a new array. Note that duplicates --- | in the first array are preserved while duplicates in the second array are --- | removed. --- | --- | ```purescript --- | mod3eq a b = a `mod` 3 == b `mod` 3 --- | intersectBy mod3eq [1, 2, 3] [4, 6, 7] = [1, 3] --- | ``` --- | -intersectBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a -intersectBy eq xs ys = filter (\x -> isJust (findIndex (eq x) ys)) xs - --- | Apply a function to pairs of elements at the same index in two arrays, --- | collecting the results in a new array. --- | --- | If one array is longer, elements will be discarded from the longer array. --- | --- | For example --- | --- | ```purescript --- | zipWith (*) [1, 2, 3] [4, 5, 6, 7] == [4, 10, 18] --- | ``` -zipWith - :: forall a b c - . (a -> b -> c) - -> Array a - -> Array b - -> Array c -zipWith = runFn3 zipWithImpl - -foreign import zipWithImpl - :: forall a b c - . Fn3 - (a -> b -> c) - (Array a) - (Array b) - (Array c) - --- | A generalization of `zipWith` which accumulates results in some --- | `Applicative` functor. --- | --- | ```purescript --- | sndChars = zipWithA (\a b -> charAt 2 (a <> b)) --- | sndChars ["a", "b"] ["A", "B"] = Nothing -- since "aA" has no 3rd char --- | sndChars ["aa", "b"] ["AA", "BBB"] = Just ['A', 'B'] --- | ``` --- | -zipWithA - :: forall m a b c - . Applicative m - => (a -> b -> m c) - -> Array a - -> Array b - -> m (Array c) -zipWithA f xs ys = sequence (zipWith f xs ys) - --- | Takes two arrays and returns an array of corresponding pairs. --- | If one input array is short, excess elements of the longer array are --- | discarded. --- | --- | ```purescript --- | zip [1, 2, 3] ["a", "b"] = [Tuple 1 "a", Tuple 2 "b"] --- | ``` --- | -zip :: forall a b. Array a -> Array b -> Array (Tuple a b) -zip = zipWith Tuple - --- | Transforms an array of pairs into an array of first components and an --- | array of second components. --- | --- | ```purescript --- | unzip [Tuple 1 "a", Tuple 2 "b"] = Tuple [1, 2] ["a", "b"] --- | ``` --- | -unzip :: forall a b. Array (Tuple a b) -> Tuple (Array a) (Array b) -unzip xs = - ST.run do - fsts <- STA.new - snds <- STA.new - iter <- STAI.iterator (xs !! _) - STAI.iterate iter \(Tuple fst snd) -> do - void $ STA.push fst fsts - void $ STA.push snd snds - fsts' <- STA.unsafeFreeze fsts - snds' <- STA.unsafeFreeze snds - pure $ Tuple fsts' snds' - --- | Returns true if at least one array element satisfies the given predicate, --- | iterating the array only as necessary and stopping as soon as the predicate --- | yields true. --- | --- | ```purescript --- | any (_ > 0) [] = False --- | any (_ > 0) [-1, 0, 1] = True --- | any (_ > 0) [-1, -2, -3] = False --- | ``` -any :: forall a. (a -> Boolean) -> Array a -> Boolean -any = runFn2 anyImpl - -foreign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean - --- | Returns true if all the array elements satisfy the given predicate. --- | iterating the array only as necessary and stopping as soon as the predicate --- | yields false. --- | --- | ```purescript --- | all (_ > 0) [] = True --- | all (_ > 0) [1, 2, 3] = True --- | all (_ > 0) [-1, -2, -3] = False --- | ``` -all :: forall a. (a -> Boolean) -> Array a -> Boolean -all = runFn2 allImpl - -foreign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean - --- | Perform a fold using a monadic step function. --- | --- | ```purescript --- | foldM (\x y -> Just (x + y)) 0 [1, 4] = Just 5 --- | ``` -foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> Array a -> m b -foldM f b = runFn3 unconsImpl (\_ -> pure b) (\a as -> f b a >>= \b' -> foldM f b' as) - -foldRecM :: forall m a b. MonadRec m => (b -> a -> m b) -> b -> Array a -> m b -foldRecM f b array = tailRecM2 go b 0 - where - go res i - | i >= length array = pure (Done res) - | otherwise = do - res' <- f res (unsafePartial (unsafeIndex array i)) - pure (Loop { a: res', b: i + 1 }) - --- | Find the element of an array at the specified index. --- | --- | ```purescript --- | unsafePartial $ unsafeIndex ["a", "b", "c"] 1 = "b" --- | ``` --- | --- | Using `unsafeIndex` with an out-of-range index will not immediately raise a runtime error. --- | Instead, the result will be undefined. Most attempts to subsequently use the result will --- | cause a runtime error, of course, but this is not guaranteed, and is dependent on the backend; --- | some programs will continue to run as if nothing is wrong. For example, in the JavaScript backend, --- | the expression `unsafePartial (unsafeIndex [true] 1)` has type `Boolean`; --- | since this expression evaluates to `undefined`, attempting to use it in an `if` statement will cause --- | the else branch to be taken. -unsafeIndex :: forall a. Partial => Array a -> Int -> a -unsafeIndex = runFn2 unsafeIndexImpl - -foreign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a diff --git a/stdlib/lib/Data/Array/NonEmpty.purs b/stdlib/lib/Data/Array/NonEmpty.purs deleted file mode 100644 index e69a7bf1..00000000 --- a/stdlib/lib/Data/Array/NonEmpty.purs +++ /dev/null @@ -1,598 +0,0 @@ -module Data.Array.NonEmpty - ( module Internal - , fromArray - , fromNonEmpty - , toArray - , toNonEmpty - - , fromFoldable - , fromFoldable1 - , toUnfoldable - , toUnfoldable1 - , singleton - , (..), range - , replicate - , some - - , length - - , (:), cons - , cons' - , snoc - , snoc' - , appendArray - , prependArray - , insert - , insertBy - - , head - , last - , tail - , init - , uncons - , unsnoc - - , (!!), index - , elem - , notElem - , elemIndex - , elemLastIndex - , find - , findMap - , findIndex - , findLastIndex - , insertAt - , deleteAt - , updateAt - , updateAtIndices - , modifyAt - , modifyAtIndices - , alterAt - - , intersperse - , reverse - , concat - , concatMap - , filter - , partition - , splitAt - , filterA - , mapMaybe - , catMaybes - , mapWithIndex - , foldl1 - , foldr1 - , foldMap1 - , fold1 - , intercalate - , transpose - , transpose' - , scanl - , scanr - - , sort - , sortBy - , sortWith - , slice - , take - , takeEnd - , takeWhile - , drop - , dropEnd - , dropWhile - , span - , group - , groupAll - , groupBy - , groupAllBy - - , nub - , nubBy - , nubEq - , nubByEq - , union - , union' - , unionBy - , unionBy' - , delete - , deleteBy - - , (\\), difference - , difference' - , intersect - , intersect' - , intersectBy - , intersectBy' - - , zipWith - , zipWithA - , zip - , unzip - - , any - , all - - , foldM - , foldRecM - - , unsafeIndex - ) where - -import Prelude - -import Control.Alternative (class Alternative) -import Control.Lazy (class Lazy) -import Control.Monad.Rec.Class (class MonadRec) -import Data.Array as A -import Data.Array.NonEmpty.Internal (NonEmptyArray(..)) -import Data.Array.NonEmpty.Internal (NonEmptyArray) as Internal -import Data.Bifunctor (bimap) -import Data.Foldable (class Foldable) -import Data.Maybe (Maybe(..), fromJust) -import Data.NonEmpty (NonEmpty, (:|)) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Foldable as F -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable) -import Data.Unfoldable1 (class Unfoldable1, unfoldr1) -import Partial.Unsafe (unsafePartial) -import Safe.Coerce (coerce) -import Unsafe.Coerce (unsafeCoerce) - --- | Internal - adapt an Array transform to NonEmptyArray --- --- Note that this is unsafe: if the transform returns an empty array, this can --- explode at runtime. -unsafeAdapt :: forall a b. (Array a -> Array b) -> NonEmptyArray a -> NonEmptyArray b -unsafeAdapt f = unsafeFromArray <<< adaptAny f - --- | Internal - adapt an Array transform to NonEmptyArray, --- with polymorphic result. --- --- Note that this is unsafe: if the transform returns an empty array, this can --- explode at runtime. -adaptAny :: forall a b. (Array a -> b) -> NonEmptyArray a -> b -adaptAny f = f <<< toArray - --- | Internal - adapt Array functions returning Maybes to NonEmptyArray -adaptMaybe :: forall a b. (Array a -> Maybe b) -> NonEmptyArray a -> b -adaptMaybe f = unsafePartial $ fromJust <<< f <<< toArray - -fromArray :: forall a. Array a -> Maybe (NonEmptyArray a) -fromArray xs - | A.length xs > 0 = Just (unsafeFromArray xs) - | otherwise = Nothing - --- | INTERNAL -unsafeFromArray :: forall a. Array a -> NonEmptyArray a -unsafeFromArray = NonEmptyArray - -unsafeFromArrayF :: forall f a. f (Array a) -> f (NonEmptyArray a) -unsafeFromArrayF = unsafeCoerce - -fromNonEmpty :: forall a. NonEmpty Array a -> NonEmptyArray a -fromNonEmpty (x :| xs) = cons' x xs - -toArray :: forall a. NonEmptyArray a -> Array a -toArray (NonEmptyArray xs) = xs - -toNonEmpty :: forall a. NonEmptyArray a -> NonEmpty Array a -toNonEmpty = uncons >>> \{head: x, tail: xs} -> x :| xs - -fromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyArray a) -fromFoldable = fromArray <<< A.fromFoldable - -fromFoldable1 :: forall f a. Foldable1 f => f a -> NonEmptyArray a -fromFoldable1 = unsafeFromArray <<< A.fromFoldable - -toUnfoldable :: forall f a. Unfoldable f => NonEmptyArray a -> f a -toUnfoldable = adaptAny A.toUnfoldable - -toUnfoldable1 :: forall f a. Unfoldable1 f => NonEmptyArray a -> f a -toUnfoldable1 xs = unfoldr1 f 0 - where - len = length xs - f i = Tuple (unsafePartial unsafeIndex xs i) $ - if i < (len - 1) then Just (i + 1) else Nothing - -singleton :: forall a. a -> NonEmptyArray a -singleton = unsafeFromArray <<< A.singleton - -range :: Int -> Int -> NonEmptyArray Int -range x y = unsafeFromArray $ A.range x y - -infix 8 range as .. - --- | Replicate an item at least once -replicate :: forall a. Int -> a -> NonEmptyArray a -replicate i x = unsafeFromArray $ A.replicate (max 1 i) x - -some - :: forall f a - . Alternative f - => Lazy (f (Array a)) - => f a -> f (NonEmptyArray a) -some = unsafeFromArrayF <<< A.some - -length :: forall a. NonEmptyArray a -> Int -length = adaptAny A.length - -cons :: forall a. a -> NonEmptyArray a -> NonEmptyArray a -cons x = unsafeAdapt $ A.cons x - -infixr 6 cons as : - -cons' :: forall a. a -> Array a -> NonEmptyArray a -cons' x xs = unsafeFromArray $ A.cons x xs - -snoc :: forall a. NonEmptyArray a -> a -> NonEmptyArray a -snoc xs x = unsafeFromArray $ A.snoc (toArray xs) x - -snoc' :: forall a. Array a -> a -> NonEmptyArray a -snoc' xs x = unsafeFromArray $ A.snoc xs x - -appendArray :: forall a. NonEmptyArray a -> Array a -> NonEmptyArray a -appendArray xs ys = unsafeFromArray $ toArray xs <> ys - -prependArray :: forall a. Array a -> NonEmptyArray a -> NonEmptyArray a -prependArray xs ys = unsafeFromArray $ xs <> toArray ys - -insert :: forall a. Ord a => a -> NonEmptyArray a -> NonEmptyArray a -insert x = unsafeAdapt $ A.insert x - -insertBy :: forall a. (a -> a -> Ordering) -> a -> NonEmptyArray a -> NonEmptyArray a -insertBy f x = unsafeAdapt $ A.insertBy f x - -head :: forall a. NonEmptyArray a -> a -head = adaptMaybe A.head - -last :: forall a. NonEmptyArray a -> a -last = adaptMaybe A.last - -tail :: forall a. NonEmptyArray a -> Array a -tail = adaptMaybe A.tail - -init :: forall a. NonEmptyArray a -> Array a -init = adaptMaybe A.init - -uncons :: forall a. NonEmptyArray a -> { head :: a, tail :: Array a } -uncons = adaptMaybe A.uncons - -unsnoc :: forall a. NonEmptyArray a -> { init :: Array a, last :: a } -unsnoc = adaptMaybe A.unsnoc - -index :: forall a. NonEmptyArray a -> Int -> Maybe a -index = adaptAny A.index - -infixl 8 index as !! - -elem :: forall a. Eq a => a -> NonEmptyArray a -> Boolean -elem x = adaptAny $ A.elem x - -notElem :: forall a. Eq a => a -> NonEmptyArray a -> Boolean -notElem x = adaptAny $ A.notElem x - -elemIndex :: forall a. Eq a => a -> NonEmptyArray a -> Maybe Int -elemIndex x = adaptAny $ A.elemIndex x - -elemLastIndex :: forall a. Eq a => a -> NonEmptyArray a -> Maybe Int -elemLastIndex x = adaptAny $ A.elemLastIndex x - -find :: forall a. (a -> Boolean) -> NonEmptyArray a -> Maybe a -find p = adaptAny $ A.find p - -findMap :: forall a b. (a -> Maybe b) -> NonEmptyArray a -> Maybe b -findMap p = adaptAny $ A.findMap p - -findIndex :: forall a. (a -> Boolean) -> NonEmptyArray a -> Maybe Int -findIndex p = adaptAny $ A.findIndex p - -findLastIndex :: forall a. (a -> Boolean) -> NonEmptyArray a -> Maybe Int -findLastIndex x = adaptAny $ A.findLastIndex x - -insertAt :: forall a. Int -> a -> NonEmptyArray a -> Maybe (NonEmptyArray a) -insertAt i x = unsafeFromArrayF <<< A.insertAt i x <<< toArray - -deleteAt :: forall a. Int -> NonEmptyArray a -> Maybe (Array a) -deleteAt i = adaptAny $ A.deleteAt i - -updateAt :: forall a. Int -> a -> NonEmptyArray a -> Maybe (NonEmptyArray a) -updateAt i x = unsafeFromArrayF <<< A.updateAt i x <<< toArray - -updateAtIndices :: forall t a. Foldable t => t (Tuple Int a) -> NonEmptyArray a -> NonEmptyArray a -updateAtIndices pairs = unsafeAdapt $ A.updateAtIndices pairs - -modifyAt :: forall a. Int -> (a -> a) -> NonEmptyArray a -> Maybe (NonEmptyArray a) -modifyAt i f = unsafeFromArrayF <<< A.modifyAt i f <<< toArray - -modifyAtIndices :: forall t a. Foldable t => t Int -> (a -> a) -> NonEmptyArray a -> NonEmptyArray a -modifyAtIndices is f = unsafeAdapt $ A.modifyAtIndices is f - -alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyArray a -> Maybe (Array a) -alterAt i f = A.alterAt i f <<< toArray - -intersperse :: forall a. a -> NonEmptyArray a -> NonEmptyArray a -intersperse x = unsafeAdapt $ A.intersperse x - -reverse :: forall a. NonEmptyArray a -> NonEmptyArray a -reverse = unsafeAdapt A.reverse - -concat :: forall a. NonEmptyArray (NonEmptyArray a) -> NonEmptyArray a -concat = unsafeFromArray <<< A.concat <<< toArray <<< map toArray - -concatMap :: forall a b. (a -> NonEmptyArray b) -> NonEmptyArray a -> NonEmptyArray b -concatMap = flip bind - -filter :: forall a. (a -> Boolean) -> NonEmptyArray a -> Array a -filter f = adaptAny $ A.filter f - -partition - :: forall a - . (a -> Boolean) - -> NonEmptyArray a - -> { yes :: Array a, no :: Array a} -partition f = adaptAny $ A.partition f - -filterA - :: forall a f - . Applicative f - => (a -> f Boolean) - -> NonEmptyArray a - -> f (Array a) -filterA f = adaptAny $ A.filterA f - -splitAt :: forall a. Int -> NonEmptyArray a -> { before :: Array a, after :: Array a } -splitAt i xs = A.splitAt i $ toArray xs - -mapMaybe :: forall a b. (a -> Maybe b) -> NonEmptyArray a -> Array b -mapMaybe f = adaptAny $ A.mapMaybe f - -catMaybes :: forall a. NonEmptyArray (Maybe a) -> Array a -catMaybes = adaptAny A.catMaybes - -mapWithIndex :: forall a b. (Int -> a -> b) -> NonEmptyArray a -> NonEmptyArray b -mapWithIndex f = unsafeAdapt $ A.mapWithIndex f - -foldl1 :: forall a. (a -> a -> a) -> NonEmptyArray a -> a -foldl1 = F.foldl1 - -foldr1 :: forall a. (a -> a -> a) -> NonEmptyArray a -> a -foldr1 = F.foldr1 - -foldMap1 :: forall a m. Semigroup m => (a -> m) -> NonEmptyArray a -> m -foldMap1 = F.foldMap1 - -fold1 :: forall m. Semigroup m => NonEmptyArray m -> m -fold1 = F.fold1 - -intercalate :: forall a. Semigroup a => a -> NonEmptyArray a -> a -intercalate = F.intercalate - --- | The 'transpose' function transposes the rows and columns of its argument. --- | For example, --- | --- | ```purescript --- | transpose --- | (NonEmptyArray [ NonEmptyArray [1, 2, 3] --- | , NonEmptyArray [4, 5, 6] --- | ]) == --- | (NonEmptyArray [ NonEmptyArray [1, 4] --- | , NonEmptyArray [2, 5] --- | , NonEmptyArray [3, 6] --- | ]) --- | ``` --- | --- | If some of the rows are shorter than the following rows, their elements are skipped: --- | --- | ```purescript --- | transpose --- | (NonEmptyArray [ NonEmptyArray [10, 11] --- | , NonEmptyArray [20] --- | , NonEmptyArray [30, 31, 32] --- | ]) == --- | (NomEmptyArray [ NonEmptyArray [10, 20, 30] --- | , NonEmptyArray [11, 31] --- | , NonEmptyArray [32] --- | ]) --- | ``` -transpose :: forall a. NonEmptyArray (NonEmptyArray a) -> NonEmptyArray (NonEmptyArray a) -transpose = - (coerce :: (Array (Array a)) -> (NonEmptyArray (NonEmptyArray a))) - <<< A.transpose <<< coerce - --- | `transpose`' is identical to `transpose` other than that the inner arrays are each --- | a standard `Array` and not a `NonEmptyArray`. However, the result is wrapped in a --- | `Maybe` to cater for the case where the inner `Array` is empty and must return `Nothing`. -transpose' :: forall a. NonEmptyArray (Array a) -> Maybe (NonEmptyArray (Array a)) -transpose' = fromArray <<< A.transpose <<< coerce - -scanl :: forall a b. (b -> a -> b) -> b -> NonEmptyArray a -> NonEmptyArray b -scanl f x = unsafeAdapt $ A.scanl f x - -scanr :: forall a b. (a -> b -> b) -> b -> NonEmptyArray a -> NonEmptyArray b -scanr f x = unsafeAdapt $ A.scanr f x - -sort :: forall a. Ord a => NonEmptyArray a -> NonEmptyArray a -sort = unsafeAdapt A.sort - -sortBy :: forall a. (a -> a -> Ordering) -> NonEmptyArray a -> NonEmptyArray a -sortBy f = unsafeAdapt $ A.sortBy f - -sortWith :: forall a b. Ord b => (a -> b) -> NonEmptyArray a -> NonEmptyArray a -sortWith f = unsafeAdapt $ A.sortWith f - -slice :: forall a. Int -> Int -> NonEmptyArray a -> Array a -slice start end = adaptAny $ A.slice start end - -take :: forall a. Int -> NonEmptyArray a -> Array a -take i = adaptAny $ A.take i - -takeEnd :: forall a. Int -> NonEmptyArray a -> Array a -takeEnd i = adaptAny $ A.takeEnd i - -takeWhile :: forall a. (a -> Boolean) -> NonEmptyArray a -> Array a -takeWhile f = adaptAny $ A.takeWhile f - -drop :: forall a. Int -> NonEmptyArray a -> Array a -drop i = adaptAny $ A.drop i - -dropEnd :: forall a. Int -> NonEmptyArray a -> Array a -dropEnd i = adaptAny $ A.dropEnd i - -dropWhile :: forall a. (a -> Boolean) -> NonEmptyArray a -> Array a -dropWhile f = adaptAny $ A.dropWhile f - -span - :: forall a - . (a -> Boolean) - -> NonEmptyArray a - -> { init :: Array a, rest :: Array a } -span f = adaptAny $ A.span f - --- | Group equal, consecutive elements of an array into arrays. --- | --- | ```purescript --- | group (NonEmptyArray [1, 1, 2, 2, 1]) == --- | NonEmptyArray [NonEmptyArray [1, 1], NonEmptyArray [2, 2], NonEmptyArray [1]] --- | ``` -group :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) -group = unsafeAdapt $ A.group - --- | Group equal elements of an array into arrays. --- | --- | ```purescript --- | groupAll (NonEmptyArray [1, 1, 2, 2, 1]) == --- | NonEmptyArray [NonEmptyArray [1, 1, 1], NonEmptyArray [2, 2]] --- | ` -groupAll :: forall a. Ord a => NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) -groupAll = groupAllBy compare - --- | Group equal, consecutive elements of an array into arrays, using the --- | specified equivalence relation to determine equality. --- | --- | ```purescript --- | groupBy (\a b -> odd a && odd b) (NonEmptyArray [1, 3, 2, 4, 3, 3]) --- | = NonEmptyArray [NonEmptyArray [1, 3], NonEmptyArray [2], NonEmptyArray [4], NonEmptyArray [3, 3]] --- | ``` --- | -groupBy :: forall a. (a -> a -> Boolean) -> NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) -groupBy op = unsafeAdapt $ A.groupBy op - --- | Group equal elements of an array into arrays, using the specified --- | comparison function to determine equality. --- | --- | ```purescript --- | groupAllBy (comparing Down) (NonEmptyArray [1, 3, 2, 4, 3, 3]) --- | = NonEmptyArray [NonEmptyArray [4], NonEmptyArray [3, 3, 3], NonEmptyArray [2], NonEmptyArray [1]] --- | ``` -groupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyArray a -> NonEmptyArray (NonEmptyArray a) -groupAllBy op = unsafeAdapt $ A.groupAllBy op - -nub :: forall a. Ord a => NonEmptyArray a -> NonEmptyArray a -nub = unsafeAdapt A.nub - -nubEq :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray a -nubEq = unsafeAdapt A.nubEq - -nubBy :: forall a. (a -> a -> Ordering) -> NonEmptyArray a -> NonEmptyArray a -nubBy f = unsafeAdapt $ A.nubBy f - -nubByEq :: forall a. (a -> a -> Boolean) -> NonEmptyArray a -> NonEmptyArray a -nubByEq f = unsafeAdapt $ A.nubByEq f - -union :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray a -> NonEmptyArray a -union = unionBy (==) - -union' :: forall a. Eq a => NonEmptyArray a -> Array a -> NonEmptyArray a -union' = unionBy' (==) - -unionBy - :: forall a - . (a -> a -> Boolean) - -> NonEmptyArray a - -> NonEmptyArray a - -> NonEmptyArray a -unionBy eq xs = unionBy' eq xs <<< toArray - -unionBy' - :: forall a - . (a -> a -> Boolean) - -> NonEmptyArray a - -> Array a - -> NonEmptyArray a -unionBy' eq xs = unsafeFromArray <<< A.unionBy eq (toArray xs) - -delete :: forall a. Eq a => a -> NonEmptyArray a -> Array a -delete x = adaptAny $ A.delete x - -deleteBy :: forall a. (a -> a -> Boolean) -> a -> NonEmptyArray a -> Array a -deleteBy f x = adaptAny $ A.deleteBy f x - -difference :: forall a. Eq a => NonEmptyArray a -> NonEmptyArray a -> Array a -difference xs = adaptAny $ difference' xs - -difference' :: forall a. Eq a => NonEmptyArray a -> Array a -> Array a -difference' xs = A.difference $ toArray xs - -intersect :: forall a . Eq a => NonEmptyArray a -> NonEmptyArray a -> Array a -intersect = intersectBy eq - -intersect' :: forall a . Eq a => NonEmptyArray a -> Array a -> Array a -intersect' = intersectBy' eq - -intersectBy - :: forall a - . (a -> a -> Boolean) - -> NonEmptyArray a - -> NonEmptyArray a - -> Array a -intersectBy eq xs = intersectBy' eq xs <<< toArray - -intersectBy' - :: forall a - . (a -> a -> Boolean) - -> NonEmptyArray a - -> Array a - -> Array a -intersectBy' eq xs = A.intersectBy eq (toArray xs) - -infix 5 difference as \\ - -zipWith - :: forall a b c - . (a -> b -> c) - -> NonEmptyArray a - -> NonEmptyArray b - -> NonEmptyArray c -zipWith f xs ys = unsafeFromArray $ A.zipWith f (toArray xs) (toArray ys) - - -zipWithA - :: forall m a b c - . Applicative m - => (a -> b -> m c) - -> NonEmptyArray a - -> NonEmptyArray b - -> m (NonEmptyArray c) -zipWithA f xs ys = unsafeFromArrayF $ A.zipWithA f (toArray xs) (toArray ys) - -zip :: forall a b. NonEmptyArray a -> NonEmptyArray b -> NonEmptyArray (Tuple a b) -zip xs ys = unsafeFromArray $ toArray xs `A.zip` toArray ys - -unzip :: forall a b. NonEmptyArray (Tuple a b) -> Tuple (NonEmptyArray a) (NonEmptyArray b) -unzip = bimap unsafeFromArray unsafeFromArray <<< A.unzip <<< toArray - -any :: forall a. (a -> Boolean) -> NonEmptyArray a -> Boolean -any p = adaptAny $ A.any p - -all :: forall a. (a -> Boolean) -> NonEmptyArray a -> Boolean -all p = adaptAny $ A.all p - -foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyArray a -> m b -foldM f acc = adaptAny $ A.foldM f acc - -foldRecM :: forall m a b. MonadRec m => (b -> a -> m b) -> b -> NonEmptyArray a -> m b -foldRecM f acc = adaptAny $ A.foldRecM f acc - -unsafeIndex :: forall a. Partial => NonEmptyArray a -> Int -> a -unsafeIndex = adaptAny A.unsafeIndex diff --git a/stdlib/lib/Data/Array/NonEmpty/Internal.purs b/stdlib/lib/Data/Array/NonEmpty/Internal.purs deleted file mode 100644 index 752ada6e..00000000 --- a/stdlib/lib/Data/Array/NonEmpty/Internal.purs +++ /dev/null @@ -1,84 +0,0 @@ --- | This module exports the `NonEmptyArray` constructor. --- | --- | It is **NOT** intended for public use and is **NOT** versioned. --- | --- | Its content may change **in any way**, **at any time** and --- | **without notice**. - -module Data.Array.NonEmpty.Internal (NonEmptyArray(..)) where - -import Prelude - -import Control.Alt (class Alt) -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable) -import Data.FoldableWithIndex (class FoldableWithIndex) -import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3) -import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.Ord (class Ord1) -import Data.Semigroup.Foldable (class Foldable1, foldMap1DefaultL) -import Data.Semigroup.Traversable (class Traversable1, sequence1Default) -import Data.Traversable (class Traversable) -import Data.TraversableWithIndex (class TraversableWithIndex) -import Data.Unfoldable1 (class Unfoldable1) - --- | An array that is known not to be empty. --- | --- | You can use the constructor to create a `NonEmptyArray` that isn't --- | non-empty, breaking the guarantee behind this newtype. It is --- | provided as an escape hatch mainly for the `Data.Array.NonEmpty` --- | and `Data.Array` modules. Use this at your own risk when you know --- | what you are doing. -newtype NonEmptyArray a = NonEmptyArray (Array a) - -instance showNonEmptyArray :: Show a => Show (NonEmptyArray a) where - show (NonEmptyArray xs) = "(NonEmptyArray " <> show xs <> ")" - -derive newtype instance eqNonEmptyArray :: Eq a => Eq (NonEmptyArray a) -derive newtype instance eq1NonEmptyArray :: Eq1 NonEmptyArray - -derive newtype instance ordNonEmptyArray :: Ord a => Ord (NonEmptyArray a) -derive newtype instance ord1NonEmptyArray :: Ord1 NonEmptyArray - -derive newtype instance semigroupNonEmptyArray :: Semigroup (NonEmptyArray a) - -derive newtype instance functorNonEmptyArray :: Functor NonEmptyArray -derive newtype instance functorWithIndexNonEmptyArray :: FunctorWithIndex Int NonEmptyArray - -derive newtype instance foldableNonEmptyArray :: Foldable NonEmptyArray -derive newtype instance foldableWithIndexNonEmptyArray :: FoldableWithIndex Int NonEmptyArray - -instance foldable1NonEmptyArray :: Foldable1 NonEmptyArray where - foldMap1 = foldMap1DefaultL - foldr1 = runFn2 foldr1Impl - foldl1 = runFn2 foldl1Impl - -derive newtype instance unfoldable1NonEmptyArray :: Unfoldable1 NonEmptyArray -derive newtype instance traversableNonEmptyArray :: Traversable NonEmptyArray -derive newtype instance traversableWithIndexNonEmptyArray :: TraversableWithIndex Int NonEmptyArray - -instance traversable1NonEmptyArray :: Traversable1 NonEmptyArray where - traverse1 f = runFn3 traverse1Impl apply map f - sequence1 = sequence1Default - -derive newtype instance applyNonEmptyArray :: Apply NonEmptyArray - -derive newtype instance applicativeNonEmptyArray :: Applicative NonEmptyArray - -derive newtype instance bindNonEmptyArray :: Bind NonEmptyArray - -derive newtype instance monadNonEmptyArray :: Monad NonEmptyArray - -derive newtype instance altNonEmptyArray :: Alt NonEmptyArray - --- we use FFI here to avoid the unncessary copy created by `tail` -foreign import foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a -foreign import foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a - -foreign import traverse1Impl - :: forall m a b - . Fn3 - (forall a' b'. (m (a' -> b') -> m a' -> m b')) - (forall a' b'. (a' -> b') -> m a' -> m b') - (a -> m b) - (NonEmptyArray a -> m (NonEmptyArray b)) diff --git a/stdlib/lib/Data/Array/Partial.purs b/stdlib/lib/Data/Array/Partial.purs deleted file mode 100644 index c3aa1561..00000000 --- a/stdlib/lib/Data/Array/Partial.purs +++ /dev/null @@ -1,35 +0,0 @@ --- | Partial helper functions for working with immutable arrays. -module Data.Array.Partial - ( head - , tail - , last - , init - ) where - -import Prelude - -import Data.Array (length, slice, unsafeIndex) - --- | Get the first element of a non-empty array. --- | --- | Running time: `O(1)`. -head :: forall a. Partial => Array a -> a -head xs = unsafeIndex xs 0 - --- | Get all but the first element of a non-empty array. --- | --- | Running time: `O(n)`, where `n` is the length of the array. -tail :: forall a. Partial => Array a -> Array a -tail xs = slice 1 (length xs) xs - --- | Get the last element of a non-empty array. --- | --- | Running time: `O(1)`. -last :: forall a. Partial => Array a -> a -last xs = unsafeIndex xs (length xs - 1) - --- | Get all but the last element of a non-empty array. --- | --- | Running time: `O(n)`, where `n` is the length of the array. -init :: forall a. Partial => Array a -> Array a -init xs = slice 0 (length xs - 1) xs diff --git a/stdlib/lib/Data/Array/ST.purs b/stdlib/lib/Data/Array/ST.purs deleted file mode 100644 index 158e4104..00000000 --- a/stdlib/lib/Data/Array/ST.purs +++ /dev/null @@ -1,262 +0,0 @@ --- | Helper functions for working with mutable arrays using the `ST` effect. --- | --- | This module can be used when performance is important and mutation is a local effect. - -module Data.Array.ST - ( STArray(..) - , Assoc - , run - , withArray - , new - , peek - , poke - , modify - , length - , pop - , push - , pushAll - , shift - , unshift - , unshiftAll - , splice - , sort - , sortBy - , sortWith - , freeze - , thaw - , clone - , unsafeFreeze - , unsafeThaw - , toAssocArray - ) where - -import Prelude - -import Control.Monad.ST (ST, Region) -import Control.Monad.ST as ST -import Control.Monad.ST.Uncurried (STFn1, STFn2, STFn3, STFn4, runSTFn1, runSTFn2, runSTFn3, runSTFn4) -import Data.Maybe (Maybe(..)) - --- | A reference to a mutable array. --- | --- | The first type parameter represents the memory region which the array belongs to. --- | The second type parameter defines the type of elements of the mutable array. --- | --- | The runtime representation of a value of type `STArray h a` is the same as that of `Array a`, --- | except that mutation is allowed. -foreign import data STArray :: Region -> Type -> Type - -type role STArray nominal representational - --- | An element and its index. -type Assoc a = { value :: a, index :: Int } - --- | A safe way to create and work with a mutable array before returning an --- | immutable array for later perusal. This function avoids copying the array --- | before returning it - it uses unsafeFreeze internally, but this wrapper is --- | a safe interface to that function. -run :: forall a. (forall h. ST h (STArray h a)) -> Array a -run st = ST.run (st >>= unsafeFreeze) - --- | Perform an effect requiring a mutable array on a copy of an immutable array, --- | safely returning the result as an immutable array. -withArray - :: forall h a b - . (STArray h a -> ST h b) - -> Array a - -> ST h (Array a) -withArray f xs = do - result <- thaw xs - _ <- f result - unsafeFreeze result - --- | O(1). Convert a mutable array to an immutable array, without copying. The mutable --- | array must not be mutated afterwards. -unsafeFreeze :: forall h a. STArray h a -> ST h (Array a) -unsafeFreeze = runSTFn1 unsafeFreezeImpl - -foreign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) - --- | O(1) Convert an immutable array to a mutable array, without copying. The input --- | array must not be used afterward. -unsafeThaw :: forall h a. Array a -> ST h (STArray h a) -unsafeThaw = runSTFn1 unsafeThawImpl - -foreign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a) - --- | Create a new, empty mutable array. -foreign import new :: forall h a. ST h (STArray h a) - -thaw - :: forall h a - . Array a - -> ST h (STArray h a) -thaw = runSTFn1 thawImpl - --- | Create a mutable copy of an immutable array. -foreign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a) - --- | Make a mutable copy of a mutable array. -clone - :: forall h a - . STArray h a - -> ST h (STArray h a) -clone = runSTFn1 cloneImpl - -foreign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a) - --- | Sort a mutable array in place. Sorting is stable: the order of equal --- | elements is preserved. -sort :: forall a h. Ord a => STArray h a -> ST h (STArray h a) -sort = sortBy compare - --- | Remove the first element from an array and return that element. -shift :: forall h a. STArray h a -> ST h (Maybe a) -shift = runSTFn3 shiftImpl Just Nothing - -foreign import shiftImpl - :: forall h a - . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) - --- | Sort a mutable array in place using a comparison function. Sorting is --- | stable: the order of elements is preserved if they are equal according to --- | the comparison function. -sortBy - :: forall a h - . (a -> a -> Ordering) - -> STArray h a - -> ST h (STArray h a) -sortBy comp = runSTFn3 sortByImpl comp case _ of - GT -> 1 - EQ -> 0 - LT -> -1 - -foreign import sortByImpl - :: forall a h - . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a) - --- | Sort a mutable array in place based on a projection. Sorting is stable: the --- | order of elements is preserved if they are equal according to the projection. -sortWith - :: forall a b h - . Ord b - => (a -> b) - -> STArray h a - -> ST h (STArray h a) -sortWith f = sortBy (comparing f) - --- | Create an immutable copy of a mutable array. -freeze - :: forall h a - . STArray h a - -> ST h (Array a) -freeze = runSTFn1 freezeImpl - -foreign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a) - --- | Read the value at the specified index in a mutable array. -peek - :: forall h a - . Int - -> STArray h a - -> ST h (Maybe a) -peek = runSTFn4 peekImpl Just Nothing - -foreign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r - -poke - :: forall h a - . Int - -> a - -> STArray h a - -> ST h Boolean -poke = runSTFn3 pokeImpl - --- | Change the value at the specified index in a mutable array. -foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean - -foreign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int - --- | Get the number of elements in a mutable array. -length :: forall h a. STArray h a -> ST h Int -length = runSTFn1 lengthImpl - --- | Remove the last element from an array and return that element. -pop :: forall h a. STArray h a -> ST h (Maybe a) -pop = runSTFn3 popImpl Just Nothing - -foreign import popImpl - :: forall h a - . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a) - --- | Append an element to the end of a mutable array. Returns the new length of --- | the array. -push :: forall h a. a -> (STArray h a) -> ST h Int -push = runSTFn2 pushImpl - -foreign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int - --- | Append the values in an immutable array to the end of a mutable array. --- | Returns the new length of the mutable array. -pushAll - :: forall h a - . Array a - -> STArray h a - -> ST h Int -pushAll = runSTFn2 pushAllImpl - -foreign import pushAllImpl - :: forall h a - . STFn2 (Array a) (STArray h a) h Int - --- | Append an element to the front of a mutable array. Returns the new length of --- | the array. -unshift :: forall h a. a -> STArray h a -> ST h Int -unshift a = runSTFn2 unshiftAllImpl [ a ] - --- | Append the values in an immutable array to the front of a mutable array. --- | Returns the new length of the mutable array. -unshiftAll - :: forall h a - . Array a - -> STArray h a - -> ST h Int -unshiftAll = runSTFn2 unshiftAllImpl - -foreign import unshiftAllImpl - :: forall h a - . STFn2 (Array a) (STArray h a) h Int - --- | Mutate the element at the specified index using the supplied function. -modify :: forall h a. Int -> (a -> a) -> STArray h a -> ST h Boolean -modify i f xs = do - entry <- peek i xs - case entry of - Just x -> poke i (f x) xs - Nothing -> pure false - --- | Remove and/or insert elements from/into a mutable array at the specified index. -splice - :: forall h a - . Int - -> Int - -> Array a - -> STArray h a - -> ST h (Array a) -splice = runSTFn4 spliceImpl - -foreign import spliceImpl - :: forall h a - . STFn4 Int Int (Array a) (STArray h a) h (Array a) - --- | Create an immutable copy of a mutable array, where each element --- | is labelled with its index in the original array. -toAssocArray - :: forall h a - . STArray h a - -> ST h (Array (Assoc a)) -toAssocArray = runSTFn1 toAssocArrayImpl - -foreign import toAssocArrayImpl - :: forall h a - . STFn1 (STArray h a) h (Array (Assoc a)) diff --git a/stdlib/lib/Data/Array/ST/Iterator.purs b/stdlib/lib/Data/Array/ST/Iterator.purs deleted file mode 100644 index 09daf0ed..00000000 --- a/stdlib/lib/Data/Array/ST/Iterator.purs +++ /dev/null @@ -1,80 +0,0 @@ -module Data.Array.ST.Iterator - ( Iterator - , iterator - , iterate - , next - , peek - , exhausted - , pushWhile - , pushAll - ) where - -import Prelude -import Control.Monad.ST (ST) -import Control.Monad.ST as ST -import Control.Monad.ST.Ref (STRef) -import Control.Monad.ST.Ref as STRef -import Data.Array.ST (STArray) -import Data.Array.ST as STA - -import Data.Maybe (Maybe(..), isNothing) - --- | This type provides a slightly easier way of iterating over an array's --- | elements in an STArray computation, without having to keep track of --- | indices. -data Iterator r a = Iterator (Int -> Maybe a) (STRef r Int) - --- | Make an Iterator given an indexing function into an array (or anything --- | else). If `xs :: Array a`, the standard way to create an iterator over --- | `xs` is to use `iterator (xs !! _)`, where `(!!)` comes from `Data.Array`. -iterator :: forall r a. (Int -> Maybe a) -> ST r (Iterator r a) -iterator f = - Iterator f <$> STRef.new 0 - --- | Perform an action once for each item left in an iterator. If the action --- | itself also advances the same iterator, `iterate` will miss those items --- | out. -iterate :: forall r a. Iterator r a -> (a -> ST r Unit) -> ST r Unit -iterate iter f = do - break <- STRef.new false - ST.while (not <$> STRef.read break) do - mx <- next iter - case mx of - Just x -> f x - Nothing -> void $ STRef.write true break - --- | Get the next item out of an iterator, advancing it. Returns Nothing if the --- | Iterator is exhausted. -next :: forall r a. Iterator r a -> ST r (Maybe a) -next (Iterator f currentIndex) = do - i <- STRef.read currentIndex - _ <- STRef.modify (_ + 1) currentIndex - pure (f i) - --- | Get the next item out of an iterator without advancing it. -peek :: forall r a. Iterator r a -> ST r (Maybe a) -peek (Iterator f currentIndex) = do - i <- STRef.read currentIndex - pure (f i) - --- | Check whether an iterator has been exhausted. -exhausted :: forall r a. Iterator r a -> ST r Boolean -exhausted = map isNothing <<< peek - --- | Extract elements from an iterator and push them on to an STArray for as --- | long as those elements satisfy a given predicate. -pushWhile :: forall r a. (a -> Boolean) -> Iterator r a -> STArray r a -> ST r Unit -pushWhile p iter array = do - break <- STRef.new false - ST.while (not <$> STRef.read break) do - mx <- peek iter - case mx of - Just x | p x -> do - _ <- STA.push x array - void $ next iter - _ -> - void $ STRef.write true break - --- | Push the entire remaining contents of an iterator onto an STArray. -pushAll :: forall r a. Iterator r a -> STArray r a -> ST r Unit -pushAll = pushWhile (const true) diff --git a/stdlib/lib/Data/Array/ST/Partial.purs b/stdlib/lib/Data/Array/ST/Partial.purs deleted file mode 100644 index f492b6ed..00000000 --- a/stdlib/lib/Data/Array/ST/Partial.purs +++ /dev/null @@ -1,36 +0,0 @@ --- | Partial functions for working with mutable arrays using the `ST` effect. --- | --- | This module is particularly helpful when performance is very important. - -module Data.Array.ST.Partial - ( peek - , poke - ) where - -import Control.Monad.ST (ST) -import Control.Monad.ST.Uncurried (STFn2, STFn3, runSTFn2, runSTFn3) -import Data.Array.ST (STArray) -import Data.Unit (Unit) - --- | Read the value at the specified index in a mutable array. -peek - :: forall h a - . Partial - => Int - -> STArray h a - -> ST h a -peek = runSTFn2 peekImpl - -foreign import peekImpl :: forall h a. STFn2 Int (STArray h a) h a - --- | Change the value at the specified index in a mutable array. -poke - :: forall h a - . Partial - => Int - -> a - -> STArray h a - -> ST h Unit -poke = runSTFn3 pokeImpl - -foreign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Unit diff --git a/stdlib/lib/Data/Bifoldable.purs b/stdlib/lib/Data/Bifoldable.purs deleted file mode 100644 index 9b187231..00000000 --- a/stdlib/lib/Data/Bifoldable.purs +++ /dev/null @@ -1,198 +0,0 @@ -module Data.Bifoldable where - -import Prelude - -import Control.Apply (applySecond) -import Data.Const (Const(..)) -import Data.Either (Either(..)) -import Data.Foldable (class Foldable, foldr, foldl, foldMap) -import Data.Functor.Clown (Clown(..)) -import Data.Functor.Flip (Flip(..)) -import Data.Functor.Joker (Joker(..)) -import Data.Functor.Product2 (Product2(..)) -import Data.Monoid.Conj (Conj(..)) -import Data.Monoid.Disj (Disj(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Endo (Endo(..)) -import Data.Newtype (unwrap) -import Data.Tuple (Tuple(..)) - --- | `Bifoldable` represents data structures with two type arguments which can be --- | folded. --- | --- | A fold for such a structure requires two step functions, one for each type --- | argument. Type class instances should choose the appropriate step function based --- | on the type of the element encountered at each point of the fold. --- | --- | Default implementations are provided by the following functions: --- | --- | - `bifoldrDefault` --- | - `bifoldlDefault` --- | - `bifoldMapDefaultR` --- | - `bifoldMapDefaultL` --- | --- | Note: some combinations of the default implementations are unsafe to --- | use together - causing a non-terminating mutually recursive cycle. --- | These combinations are documented per function. -class Bifoldable p where - bifoldr :: forall a b c. (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c - bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c - bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m - -instance bifoldableClown :: Foldable f => Bifoldable (Clown f) where - bifoldr l _ u (Clown f) = foldr l u f - bifoldl l _ u (Clown f) = foldl l u f - bifoldMap l _ (Clown f) = foldMap l f - -instance bifoldableJoker :: Foldable f => Bifoldable (Joker f) where - bifoldr _ r u (Joker f) = foldr r u f - bifoldl _ r u (Joker f) = foldl r u f - bifoldMap _ r (Joker f) = foldMap r f - -instance bifoldableFlip :: Bifoldable p => Bifoldable (Flip p) where - bifoldr r l u (Flip p) = bifoldr l r u p - bifoldl r l u (Flip p) = bifoldl l r u p - bifoldMap r l (Flip p) = bifoldMap l r p - -instance bifoldableProduct2 :: (Bifoldable f, Bifoldable g) => Bifoldable (Product2 f g) where - bifoldr l r u m = bifoldrDefault l r u m - bifoldl l r u m = bifoldlDefault l r u m - bifoldMap l r (Product2 f g) = bifoldMap l r f <> bifoldMap l r g - -instance bifoldableEither :: Bifoldable Either where - bifoldr f _ z (Left a) = f a z - bifoldr _ g z (Right b) = g b z - bifoldl f _ z (Left a) = f z a - bifoldl _ g z (Right b) = g z b - bifoldMap f _ (Left a) = f a - bifoldMap _ g (Right b) = g b - -instance bifoldableTuple :: Bifoldable Tuple where - bifoldMap f g (Tuple a b) = f a <> g b - bifoldr f g z (Tuple a b) = f a (g b z) - bifoldl f g z (Tuple a b) = g (f z a) b - -instance bifoldableConst :: Bifoldable Const where - bifoldr f _ z (Const a) = f a z - bifoldl f _ z (Const a) = f z a - bifoldMap f _ (Const a) = f a - --- | A default implementation of `bifoldr` using `bifoldMap`. --- | --- | Note: when defining a `Bifoldable` instance, this function is unsafe to --- | use in combination with `bifoldMapDefaultR`. -bifoldrDefault - :: forall p a b c - . Bifoldable p - => (a -> c -> c) - -> (b -> c -> c) - -> c - -> p a b - -> c -bifoldrDefault f g z p = unwrap (bifoldMap (Endo <<< f) (Endo <<< g) p) z - --- | A default implementation of `bifoldl` using `bifoldMap`. --- | --- | Note: when defining a `Bifoldable` instance, this function is unsafe to --- | use in combination with `bifoldMapDefaultL`. -bifoldlDefault - :: forall p a b c - . Bifoldable p - => (c -> a -> c) - -> (c -> b -> c) - -> c - -> p a b - -> c -bifoldlDefault f g z p = - unwrap - (unwrap - (bifoldMap (Dual <<< Endo <<< flip f) (Dual <<< Endo <<< flip g) p)) - z - --- | A default implementation of `bifoldMap` using `bifoldr`. --- | --- | Note: when defining a `Bifoldable` instance, this function is unsafe to --- | use in combination with `bifoldrDefault`. -bifoldMapDefaultR - :: forall p m a b - . Bifoldable p - => Monoid m - => (a -> m) - -> (b -> m) - -> p a b - -> m -bifoldMapDefaultR f g = bifoldr (append <<< f) (append <<< g) mempty - --- | A default implementation of `bifoldMap` using `bifoldl`. --- | --- | Note: when defining a `Bifoldable` instance, this function is unsafe to --- | use in combination with `bifoldlDefault`. -bifoldMapDefaultL - :: forall p m a b - . Bifoldable p - => Monoid m - => (a -> m) - -> (b -> m) - -> p a b - -> m -bifoldMapDefaultL f g = bifoldl (\m a -> m <> f a) (\m b -> m <> g b) mempty - - --- | Fold a data structure, accumulating values in a monoidal type. -bifold :: forall t m. Bifoldable t => Monoid m => t m m -> m -bifold = bifoldMap identity identity - --- | Traverse a data structure, accumulating effects using an `Applicative` functor, --- | ignoring the final result. -bitraverse_ - :: forall t f a b c d - . Bifoldable t - => Applicative f - => (a -> f c) - -> (b -> f d) - -> t a b - -> f Unit -bitraverse_ f g = bifoldr (applySecond <<< f) (applySecond <<< g) (pure unit) - --- | A version of `bitraverse_` with the data structure as the first argument. -bifor_ - :: forall t f a b c d - . Bifoldable t - => Applicative f - => t a b - -> (a -> f c) - -> (b -> f d) - -> f Unit -bifor_ t f g = bitraverse_ f g t - --- | Collapse a data structure, collecting effects using an `Applicative` functor, --- | ignoring the final result. -bisequence_ - :: forall t f a b - . Bifoldable t - => Applicative f - => t (f a) (f b) - -> f Unit -bisequence_ = bitraverse_ identity identity - --- | Test whether a predicate holds at any position in a data structure. -biany - :: forall t a b c - . Bifoldable t - => BooleanAlgebra c - => (a -> c) - -> (b -> c) - -> t a b - -> c -biany p q = unwrap <<< bifoldMap (Disj <<< p) (Disj <<< q) - --- | Test whether a predicate holds at all positions in a data structure. -biall - :: forall t a b c - . Bifoldable t - => BooleanAlgebra c - => (a -> c) - -> (b -> c) - -> t a b - -> c -biall p q = unwrap <<< bifoldMap (Conj <<< p) (Conj <<< q) diff --git a/stdlib/lib/Data/Bifunctor.purs b/stdlib/lib/Data/Bifunctor.purs deleted file mode 100644 index 83287326..00000000 --- a/stdlib/lib/Data/Bifunctor.purs +++ /dev/null @@ -1,46 +0,0 @@ -module Data.Bifunctor where - -import Control.Category (identity) -import Data.Const (Const(..)) -import Data.Either (Either(..)) -import Data.Tuple (Tuple(..)) -import Data.Unit (Unit, unit) -import Data.Function (const) - --- | A `Bifunctor` is a `Functor` from the pair category `(Type, Type)` to `Type`. --- | --- | A type constructor with two type arguments can be made into a `Bifunctor` if --- | both of its type arguments are covariant. --- | --- | The `bimap` function maps a pair of functions over the two type arguments --- | of the bifunctor. --- | --- | Laws: --- | --- | - Identity: `bimap identity identity == identity` --- | - Composition: `bimap f1 g1 <<< bimap f2 g2 == bimap (f1 <<< f2) (g1 <<< g2)` --- | -class Bifunctor f where - bimap :: forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d - --- | Map a function over the first type argument of a `Bifunctor`. -lmap :: forall f a b c. Bifunctor f => (a -> b) -> f a c -> f b c -lmap f = bimap f identity - --- | Map a function over the second type arguments of a `Bifunctor`. -rmap :: forall f a b c. Bifunctor f => (b -> c) -> f a b -> f a c -rmap = bimap identity - --- | The bivoid function is used to ignore the types wrapped by a Bifunctor. -bivoid :: forall f a b. Bifunctor f => f a b -> f Unit Unit -bivoid = bimap (const unit) (const unit) - -instance bifunctorEither :: Bifunctor Either where - bimap f _ (Left l) = Left (f l) - bimap _ g (Right r) = Right (g r) - -instance bifunctorTuple :: Bifunctor Tuple where - bimap f g (Tuple x y) = Tuple (f x) (g y) - -instance bifunctorConst :: Bifunctor Const where - bimap f _ (Const a) = Const (f a) diff --git a/stdlib/lib/Data/Bifunctor/Join.purs b/stdlib/lib/Data/Bifunctor/Join.purs deleted file mode 100644 index bbf8c756..00000000 --- a/stdlib/lib/Data/Bifunctor/Join.purs +++ /dev/null @@ -1,31 +0,0 @@ -module Data.Bifunctor.Join where - -import Prelude - -import Control.Biapplicative (class Biapplicative, bipure) -import Control.Biapply (class Biapply, (<<*>>)) - -import Data.Bifunctor (class Bifunctor, bimap) -import Data.Newtype (class Newtype) - --- | Turns a `Bifunctor` into a `Functor` by equating the two type arguments. -newtype Join :: forall k. (k -> k -> Type) -> k -> Type -newtype Join p a = Join (p a a) - -derive instance newtypeJoin :: Newtype (Join p a) _ - -derive newtype instance eqJoin :: Eq (p a a) => Eq (Join p a) - -derive newtype instance ordJoin :: Ord (p a a) => Ord (Join p a) - -instance showJoin :: Show (p a a) => Show (Join p a) where - show (Join x) = "(Join " <> show x <> ")" - -instance bifunctorJoin :: Bifunctor p => Functor (Join p) where - map f (Join a) = Join (bimap f f a) - -instance biapplyJoin :: Biapply p => Apply (Join p) where - apply (Join f) (Join a) = Join (f <<*>> a) - -instance biapplicativeJoin :: Biapplicative p => Applicative (Join p) where - pure a = Join (bipure a a) diff --git a/stdlib/lib/Data/Bitraversable.purs b/stdlib/lib/Data/Bitraversable.purs deleted file mode 100644 index 6760549f..00000000 --- a/stdlib/lib/Data/Bitraversable.purs +++ /dev/null @@ -1,136 +0,0 @@ -module Data.Bitraversable - ( class Bitraversable, bitraverse, bisequence - , bitraverseDefault - , bisequenceDefault - , ltraverse - , rtraverse - , bifor - , lfor - , rfor - , module Data.Bifoldable - ) where - -import Prelude - -import Data.Bifoldable (class Bifoldable, biall, biany, bifold, bifoldMap, bifoldMapDefaultL, bifoldMapDefaultR, bifoldl, bifoldlDefault, bifoldr, bifoldrDefault, bifor_, bisequence_, bitraverse_) -import Data.Traversable (class Traversable, traverse, sequence) -import Data.Bifunctor (class Bifunctor, bimap) -import Data.Const (Const(..)) -import Data.Either (Either(..)) -import Data.Functor.Clown (Clown(..)) -import Data.Functor.Flip (Flip(..)) -import Data.Functor.Joker (Joker(..)) -import Data.Functor.Product2 (Product2(..)) -import Data.Tuple (Tuple(..)) - --- | `Bitraversable` represents data structures with two type arguments which can be --- | traversed. --- | --- | A traversal for such a structure requires two functions, one for each type --- | argument. Type class instances should choose the appropriate function based --- | on the type of the element encountered at each point of the traversal. --- | --- | Default implementations are provided by the following functions: --- | --- | - `bitraverseDefault` --- | - `bisequenceDefault` -class (Bifunctor t, Bifoldable t) <= Bitraversable t where - bitraverse :: forall f a b c d. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) - bisequence :: forall f a b. Applicative f => t (f a) (f b) -> f (t a b) - -instance bitraversableClown :: Traversable f => Bitraversable (Clown f) where - bitraverse l _ (Clown f) = Clown <$> traverse l f - bisequence (Clown f) = Clown <$> sequence f - -instance bitraversableJoker :: Traversable f => Bitraversable (Joker f) where - bitraverse _ r (Joker f) = Joker <$> traverse r f - bisequence (Joker f) = Joker <$> sequence f - -instance bitraversableFlip :: Bitraversable p => Bitraversable (Flip p) where - bitraverse r l (Flip p) = Flip <$> bitraverse l r p - bisequence (Flip p) = Flip <$> bisequence p - -instance bitraversableProduct2 :: (Bitraversable f, Bitraversable g) => Bitraversable (Product2 f g) where - bitraverse l r (Product2 f g) = Product2 <$> bitraverse l r f <*> bitraverse l r g - bisequence (Product2 f g) = Product2 <$> bisequence f <*> bisequence g - -instance bitraversableEither :: Bitraversable Either where - bitraverse f _ (Left a) = Left <$> f a - bitraverse _ g (Right b) = Right <$> g b - bisequence (Left a) = Left <$> a - bisequence (Right b) = Right <$> b - -instance bitraversableTuple :: Bitraversable Tuple where - bitraverse f g (Tuple a b) = Tuple <$> f a <*> g b - bisequence (Tuple a b) = Tuple <$> a <*> b - -instance bitraversableConst :: Bitraversable Const where - bitraverse f _ (Const a) = Const <$> f a - bisequence (Const a) = Const <$> a - -ltraverse - :: forall t b c a f - . Bitraversable t - => Applicative f - => (a -> f c) - -> t a b - -> f (t c b) -ltraverse f = bitraverse f pure - -rtraverse - :: forall t b c a f - . Bitraversable t - => Applicative f - => (b -> f c) - -> t a b - -> f (t a c) -rtraverse = bitraverse pure - --- | A default implementation of `bitraverse` using `bisequence` and `bimap`. -bitraverseDefault - :: forall t f a b c d - . Bitraversable t - => Applicative f - => (a -> f c) - -> (b -> f d) - -> t a b - -> f (t c d) -bitraverseDefault f g t = bisequence (bimap f g t) - --- | A default implementation of `bisequence` using `bitraverse`. -bisequenceDefault - :: forall t f a b - . Bitraversable t - => Applicative f - => t (f a) (f b) - -> f (t a b) -bisequenceDefault = bitraverse identity identity - --- | Traverse a data structure, accumulating effects and results using an `Applicative` functor. -bifor - :: forall t f a b c d - . Bitraversable t - => Applicative f - => t a b - -> (a -> f c) - -> (b -> f d) - -> f (t c d) -bifor t f g = bitraverse f g t - -lfor - :: forall t b c a f - . Bitraversable t - => Applicative f - => t a b - -> (a -> f c) - -> f (t c b) -lfor t f = bitraverse f pure t - -rfor - :: forall t b c a f - . Bitraversable t - => Applicative f - => t a b - -> (b -> f c) - -> f (t a c) -rfor t f = bitraverse pure f t diff --git a/stdlib/lib/Data/Boolean.purs b/stdlib/lib/Data/Boolean.purs deleted file mode 100644 index 9b4f6909..00000000 --- a/stdlib/lib/Data/Boolean.purs +++ /dev/null @@ -1,10 +0,0 @@ -module Data.Boolean where - --- | An alias for `true`, which can be useful in guard clauses: --- | --- | ```purescript --- | max x y | x >= y = x --- | | otherwise = y --- | ``` -otherwise :: Boolean -otherwise = true diff --git a/stdlib/lib/Data/BooleanAlgebra.purs b/stdlib/lib/Data/BooleanAlgebra.purs deleted file mode 100644 index 622caee5..00000000 --- a/stdlib/lib/Data/BooleanAlgebra.purs +++ /dev/null @@ -1,43 +0,0 @@ -module Data.BooleanAlgebra - ( class BooleanAlgebra - , module Data.HeytingAlgebra - , class BooleanAlgebraRecord - ) where - -import Data.HeytingAlgebra (class HeytingAlgebra, class HeytingAlgebraRecord, ff, tt, implies, conj, disj, not, (&&), (||)) -import Data.Symbol (class IsSymbol) -import Data.Unit (Unit) -import Prim.Row as Row -import Prim.RowList as RL -import Type.Proxy (Proxy) - --- | The `BooleanAlgebra` type class represents types that behave like boolean --- | values. --- | --- | Instances should satisfy the following laws in addition to the --- | `HeytingAlgebra` law: --- | --- | - Excluded middle: --- | - `a || not a = tt` -class HeytingAlgebra a <= BooleanAlgebra a - -instance booleanAlgebraBoolean :: BooleanAlgebra Boolean -instance booleanAlgebraUnit :: BooleanAlgebra Unit -instance booleanAlgebraFn :: BooleanAlgebra b => BooleanAlgebra (a -> b) -instance booleanAlgebraRecord :: (RL.RowToList row list, BooleanAlgebraRecord list row row) => BooleanAlgebra (Record row) -instance booleanAlgebraProxy :: BooleanAlgebra (Proxy a) - --- | A class for records where all fields have `BooleanAlgebra` instances, used --- | to implement the `BooleanAlgebra` instance for records. -class BooleanAlgebraRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class HeytingAlgebraRecord rowlist row subrow <= BooleanAlgebraRecord rowlist row subrow | rowlist -> subrow - -instance booleanAlgebraRecordNil :: BooleanAlgebraRecord RL.Nil row () - -instance booleanAlgebraRecordCons :: - ( IsSymbol key - , Row.Cons key focus subrowTail subrow - , BooleanAlgebraRecord rowlistTail row subrowTail - , BooleanAlgebra focus - ) => - BooleanAlgebraRecord (RL.Cons key focus rowlistTail) row subrow diff --git a/stdlib/lib/Data/Bounded.purs b/stdlib/lib/Data/Bounded.purs deleted file mode 100644 index 91fec94d..00000000 --- a/stdlib/lib/Data/Bounded.purs +++ /dev/null @@ -1,105 +0,0 @@ -module Data.Bounded - ( class Bounded - , bottom - , top - , module Data.Ord - , class BoundedRecord - , bottomRecord - , topRecord - ) where - -import Data.Ord (class Ord, class OrdRecord, Ordering(..), compare, (<), (<=), (>), (>=)) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit, unit) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeSet) -import Type.Proxy (Proxy(..)) - --- | The `Bounded` type class represents totally ordered types that have an --- | upper and lower boundary. --- | --- | Instances should satisfy the following law in addition to the `Ord` laws: --- | --- | - Bounded: `bottom <= a <= top` -class Ord a <= Bounded a where - top :: a - bottom :: a - -instance boundedBoolean :: Bounded Boolean where - top = true - bottom = false - --- | The `Bounded` `Int` instance has `top :: Int` equal to 2^31 - 1, --- | and `bottom :: Int` equal to -2^31, since these are the largest and smallest --- | integers representable by twos-complement 32-bit integers, respectively. -instance boundedInt :: Bounded Int where - top = topInt - bottom = bottomInt - -foreign import topInt :: Int -foreign import bottomInt :: Int - --- | Characters fall within the Unicode range. -instance boundedChar :: Bounded Char where - top = topChar - bottom = bottomChar - -foreign import topChar :: Char -foreign import bottomChar :: Char - -instance boundedOrdering :: Bounded Ordering where - top = GT - bottom = LT - -instance boundedUnit :: Bounded Unit where - top = unit - bottom = unit - -foreign import topNumber :: Number -foreign import bottomNumber :: Number - -instance boundedNumber :: Bounded Number where - top = topNumber - bottom = bottomNumber - -instance boundedProxy :: Bounded (Proxy a) where - bottom = Proxy - top = Proxy - -class BoundedRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class OrdRecord rowlist row <= BoundedRecord rowlist row subrow | rowlist -> subrow where - topRecord :: Proxy rowlist -> Proxy row -> Record subrow - bottomRecord :: Proxy rowlist -> Proxy row -> Record subrow - -instance boundedRecordNil :: BoundedRecord RL.Nil row () where - topRecord _ _ = {} - bottomRecord _ _ = {} - -instance boundedRecordCons :: - ( IsSymbol key - , Bounded focus - , Row.Cons key focus rowTail row - , Row.Cons key focus subrowTail subrow - , BoundedRecord rowlistTail row subrowTail - ) => - BoundedRecord (RL.Cons key focus rowlistTail) row subrow where - topRecord _ rowProxy = insert top tail - where - key = reflectSymbol (Proxy :: Proxy key) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = topRecord (Proxy :: Proxy rowlistTail) rowProxy - - bottomRecord _ rowProxy = insert bottom tail - where - key = reflectSymbol (Proxy :: Proxy key) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = bottomRecord (Proxy :: Proxy rowlistTail) rowProxy - -instance boundedRecord :: - ( RL.RowToList row list - , BoundedRecord list row row - ) => - Bounded (Record row) where - top = topRecord (Proxy :: Proxy list) (Proxy :: Proxy row) - bottom = bottomRecord (Proxy :: Proxy list) (Proxy :: Proxy row) diff --git a/stdlib/lib/Data/Bounded/Generic.purs b/stdlib/lib/Data/Bounded/Generic.purs deleted file mode 100644 index c7e2e2ed..00000000 --- a/stdlib/lib/Data/Bounded/Generic.purs +++ /dev/null @@ -1,56 +0,0 @@ -module Data.Bounded.Generic - ( class GenericBottom - , genericBottom' - , genericBottom - , class GenericTop - , genericTop' - , genericTop - ) where - -import Data.Generic.Rep - -import Data.Bounded (class Bounded, bottom, top) - -class GenericBottom a where - genericBottom' :: a - -instance genericBottomNoArguments :: GenericBottom NoArguments where - genericBottom' = NoArguments - -instance genericBottomArgument :: Bounded a => GenericBottom (Argument a) where - genericBottom' = Argument bottom - -instance genericBottomSum :: GenericBottom a => GenericBottom (Sum a b) where - genericBottom' = Inl genericBottom' - -instance genericBottomProduct :: (GenericBottom a, GenericBottom b) => GenericBottom (Product a b) where - genericBottom' = Product genericBottom' genericBottom' - -instance genericBottomConstructor :: GenericBottom a => GenericBottom (Constructor name a) where - genericBottom' = Constructor genericBottom' - -class GenericTop a where - genericTop' :: a - -instance genericTopNoArguments :: GenericTop NoArguments where - genericTop' = NoArguments - -instance genericTopArgument :: Bounded a => GenericTop (Argument a) where - genericTop' = Argument top - -instance genericTopSum :: GenericTop b => GenericTop (Sum a b) where - genericTop' = Inr genericTop' - -instance genericTopProduct :: (GenericTop a, GenericTop b) => GenericTop (Product a b) where - genericTop' = Product genericTop' genericTop' - -instance genericTopConstructor :: GenericTop a => GenericTop (Constructor name a) where - genericTop' = Constructor genericTop' - --- | A `Generic` implementation of the `bottom` member from the `Bounded` type class. -genericBottom :: forall a rep. Generic a rep => GenericBottom rep => a -genericBottom = to genericBottom' - --- | A `Generic` implementation of the `top` member from the `Bounded` type class. -genericTop :: forall a rep. Generic a rep => GenericTop rep => a -genericTop = to genericTop' diff --git a/stdlib/lib/Data/Char.purs b/stdlib/lib/Data/Char.purs deleted file mode 100644 index bb413b7d..00000000 --- a/stdlib/lib/Data/Char.purs +++ /dev/null @@ -1,16 +0,0 @@ --- | A type and functions for single characters. -module Data.Char - ( toCharCode - , fromCharCode - ) where - -import Data.Enum (fromEnum, toEnum) -import Data.Maybe (Maybe) - --- | Returns the numeric Unicode value of the character. -toCharCode :: Char -> Int -toCharCode = fromEnum - --- | Constructs a character from the given Unicode numeric value. -fromCharCode :: Int -> Maybe Char -fromCharCode = toEnum diff --git a/stdlib/lib/Data/Char/Gen.purs b/stdlib/lib/Data/Char/Gen.purs deleted file mode 100644 index 838ff29d..00000000 --- a/stdlib/lib/Data/Char/Gen.purs +++ /dev/null @@ -1,35 +0,0 @@ -module Data.Char.Gen where - -import Prelude - -import Control.Monad.Gen (class MonadGen, chooseInt, oneOf) -import Data.Enum (toEnumWithDefaults) -import Data.NonEmpty ((:|)) - --- | Generates a character of the Unicode basic multilingual plane. -genUnicodeChar :: forall m. MonadGen m => m Char -genUnicodeChar = toEnumWithDefaults bottom top <$> chooseInt 0 65536 - --- | Generates a character in the ASCII character set, excluding control codes. -genAsciiChar :: forall m. MonadGen m => m Char -genAsciiChar = toEnumWithDefaults bottom top <$> chooseInt 32 127 - --- | Generates a character in the ASCII character set. -genAsciiChar' :: forall m. MonadGen m => m Char -genAsciiChar' = toEnumWithDefaults bottom top <$> chooseInt 0 127 - --- | Generates a character that is a numeric digit. -genDigitChar :: forall m. MonadGen m => m Char -genDigitChar = toEnumWithDefaults bottom top <$> chooseInt 48 57 - --- | Generates a character from the basic latin alphabet. -genAlpha :: forall m. MonadGen m => m Char -genAlpha = oneOf (genAlphaLowercase :| [genAlphaUppercase]) - --- | Generates a lowercase character from the basic latin alphabet. -genAlphaLowercase :: forall m. MonadGen m => m Char -genAlphaLowercase = toEnumWithDefaults bottom top <$> chooseInt 97 122 - --- | Generates an uppercase character from the basic latin alphabet. -genAlphaUppercase :: forall m. MonadGen m => m Char -genAlphaUppercase = toEnumWithDefaults bottom top <$> chooseInt 65 90 diff --git a/stdlib/lib/Data/CommutativeRing.purs b/stdlib/lib/Data/CommutativeRing.purs deleted file mode 100644 index 38e6e27e..00000000 --- a/stdlib/lib/Data/CommutativeRing.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.CommutativeRing - ( class CommutativeRing - , module Data.Ring - , module Data.Semiring - , class CommutativeRingRecord - ) where - -import Data.Ring (class Ring, class RingRecord) -import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) -import Data.Symbol (class IsSymbol) -import Data.Unit (Unit) -import Prim.Row as Row -import Prim.RowList as RL -import Type.Proxy (Proxy) - --- | The `CommutativeRing` class is for rings where multiplication is --- | commutative. --- | --- | Instances must satisfy the following law in addition to the `Ring` --- | laws: --- | --- | - Commutative multiplication: `a * b = b * a` -class Ring a <= CommutativeRing a - -instance commutativeRingInt :: CommutativeRing Int -instance commutativeRingNumber :: CommutativeRing Number -instance commutativeRingUnit :: CommutativeRing Unit -instance commutativeRingFn :: CommutativeRing b => CommutativeRing (a -> b) -instance commutativeRingRecord :: (RL.RowToList row list, CommutativeRingRecord list row row) => CommutativeRing (Record row) -instance commutativeRingProxy :: CommutativeRing (Proxy a) - --- | A class for records where all fields have `CommutativeRing` instances, used --- | to implement the `CommutativeRing` instance for records. -class RingRecord rowlist row subrow <= CommutativeRingRecord rowlist row subrow | rowlist -> subrow - -instance commutativeRingRecordNil :: CommutativeRingRecord RL.Nil row () - -instance commutativeRingRecordCons :: - ( IsSymbol key - , Row.Cons key focus subrowTail subrow - , CommutativeRingRecord rowlistTail row subrowTail - , CommutativeRing focus - ) => - CommutativeRingRecord (RL.Cons key focus rowlistTail) row subrow diff --git a/stdlib/lib/Data/Compactable.purs b/stdlib/lib/Data/Compactable.purs deleted file mode 100644 index 2e6be9de..00000000 --- a/stdlib/lib/Data/Compactable.purs +++ /dev/null @@ -1,164 +0,0 @@ -module Data.Compactable - ( class Compactable - , compact - , separate - , compactDefault - , separateDefault - , applyMaybe - , applyEither - , bindMaybe - , bindEither - ) where - -import Control.Alternative (empty, (<|>)) -import Control.Applicative (class Apply, apply, pure) -import Control.Apply ((<*>)) -import Control.Bind (class Bind, bind, join) -import Control.Monad.ST as ST -import Data.Array ((!!)) -import Data.Array.ST as STA -import Data.Array.ST.Iterator as STAI -import Data.Either (Either(Right, Left), hush, note) -import Data.Foldable (foldl, foldr) -import Data.Function (($)) -import Data.Functor (class Functor, map, (<$>)) -import Data.List as List -import Data.Map as Map -import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid, mempty) -import Data.Tuple (Tuple(..)) -import Prelude (class Ord, const, discard, unit, void, (<<<)) - --- | `Compactable` represents data structures which can be _compacted_/_filtered_. --- | This is a generalization of catMaybes as a new function `compact`. `compact` --- | has relations with `Functor`, `Applicative`, `Monad`, `Plus`, and `Traversable` --- | in that we can use these classes to provide the ability to operate on a data type --- | by eliminating intermediate Nothings. This is useful for representing the --- | filtering out of values, or failure. --- | --- | To be compactable alone, no laws must be satisfied other than the type signature. --- | --- | If the data type is also a Functor the following should hold: --- | --- | - Functor Identity: `compact <<< map Just ≡ id` --- | --- | According to Kmett, (Compactable f, Functor f) is a functor from the --- | kleisli category of Maybe to the category of Hask. --- | `Kleisli Maybe -> Hask`. --- | --- | If the data type is also `Applicative` the following should hold: --- | --- | - `compact <<< (pure Just <*> _) ≡ id` --- | - `applyMaybe (pure Just) ≡ id` --- | - `compact ≡ applyMaybe (pure id)` --- | --- | If the data type is also a `Monad` the following should hold: --- | --- | - `flip bindMaybe (pure <<< Just) ≡ id` --- | - `compact <<< (pure <<< (Just (=<<))) ≡ id` --- | - `compact ≡ flip bindMaybe pure` --- | --- | If the data type is also `Plus` the following should hold: --- | --- | - `compact empty ≡ empty` --- | - `compact (const Nothing <$> xs) ≡ empty` - -class Compactable f where - compact :: forall a. - f (Maybe a) -> f a - - separate :: forall l r. - f (Either l r) -> { left :: f l, right :: f r } - -compactDefault :: forall f a. Functor f => Compactable f => - f (Maybe a) -> f a -compactDefault = _.right <<< separate <<< map (note unit) - -separateDefault :: forall f l r. Functor f => Compactable f => - f (Either l r) -> { left :: f l, right :: f r} -separateDefault xs = { left: compact $ (hush <<< swapEither) <$> xs - , right: compact $ hush <$> xs - } - where - swapEither e = case e of - Left x -> Right x - Right y -> Left y - -instance compactableMaybe :: Compactable Maybe where - compact = join - - separate Nothing = { left: Nothing, right: Nothing } - separate (Just e) = case e of - Left l -> { left: Just l, right: Nothing } - Right r -> { left: Nothing, right: Just r } - -instance compactableEither :: Monoid m => Compactable (Either m) where - compact (Left m) = Left m - compact (Right m) = case m of - Just v -> Right v - Nothing -> Left mempty - - separate (Left x) = { left: Left x, right: Left x } - separate (Right e) = case e of - Left l -> { left: Right l, right: Left mempty } - Right r -> { left: Left mempty, right: Right r } - -instance compactableArray :: Compactable Array where - compact xs = ST.run do - result <- STA.new - iter <- STAI.iterator (xs !! _) - - STAI.iterate iter $ void <<< case _ of - Nothing -> pure 0 - Just j -> STA.push j result - - STA.unsafeFreeze result - - separate xs = ST.run do - ls <- STA.new - rs <- STA.new - iter <- STAI.iterator (xs !! _) - - STAI.iterate iter $ void <<< case _ of - Left l -> STA.push l ls - Right r -> STA.push r rs - - {left: _, right: _} <$> STA.unsafeFreeze ls <*> STA.unsafeFreeze rs - -instance compactableList :: Compactable List.List where - compact = List.catMaybes - separate = foldl go { left: empty, right: empty } where - go acc = case _ of - Left l -> acc { left = acc.left <|> pure l } - Right r -> acc { right = acc.right <|> pure r } - -instance compactableMap :: Ord k => Compactable (Map.Map k) where - compact = foldr select Map.empty <<< mapToList - where - select (Tuple k x) m = Map.alter (const x) k m - - separate = foldr select { left: Map.empty, right: Map.empty } <<< mapToList - where - select (Tuple k v) { left, right } = case v of - Left l -> { left: Map.insert k l left, right } - Right r -> { left: left, right: Map.insert k r right } - -mapToList :: forall k v. Ord k => - Map.Map k v -> List.List (Tuple k v) -mapToList = Map.toUnfoldable - -applyMaybe :: forall f a b. Apply f => Compactable f => - f (a -> Maybe b) -> f a -> f b -applyMaybe p = compact <<< apply p - -applyEither :: forall f a l r. Apply f => Compactable f => - f (a -> Either l r) -> f a -> { left :: f l, right :: f r } -applyEither p = separate <<< apply p - -bindMaybe :: forall m a b. Bind m => Compactable m => - m a -> (a -> m (Maybe b)) -> m b -bindMaybe x = compact <<< bind x - -bindEither :: forall m a l r. Bind m => Compactable m => - m a -> (a -> m (Either l r)) -> { left :: m l, right :: m r } -bindEither x = separate <<< bind x diff --git a/stdlib/lib/Data/Comparison.purs b/stdlib/lib/Data/Comparison.purs deleted file mode 100644 index 9f9132d2..00000000 --- a/stdlib/lib/Data/Comparison.purs +++ /dev/null @@ -1,25 +0,0 @@ -module Data.Comparison where - -import Prelude - -import Data.Function (on) -import Data.Functor.Contravariant (class Contravariant) -import Data.Newtype (class Newtype) - --- | An adaptor allowing `>$<` to map over the inputs of a comparison function. -newtype Comparison a = Comparison (a -> a -> Ordering) - -derive instance newtypeComparison :: Newtype (Comparison a) _ - -instance contravariantComparison :: Contravariant Comparison where - cmap f (Comparison g) = Comparison (g `on` f) - -instance semigroupComparison :: Semigroup (Comparison a) where - append (Comparison p) (Comparison q) = Comparison (p <> q) - -instance monoidComparison :: Monoid (Comparison a) where - mempty = Comparison (\_ _ -> EQ) - --- | The default comparison for any values with an `Ord` instance. -defaultComparison :: forall a. Ord a => Comparison a -defaultComparison = Comparison compare diff --git a/stdlib/lib/Data/Const.purs b/stdlib/lib/Data/Const.purs deleted file mode 100644 index eeeccba2..00000000 --- a/stdlib/lib/Data/Const.purs +++ /dev/null @@ -1,63 +0,0 @@ -module Data.Const where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) - --- | The `Const` type constructor, which wraps its first type argument --- | and ignores its second. That is, `Const a b` is isomorphic to `a` --- | for any `b`. --- | --- | `Const` has some useful instances. For example, the `Applicative` --- | instance allows us to collect results using a `Monoid` while --- | ignoring return values. -newtype Const :: forall k. Type -> k -> Type -newtype Const a b = Const a - -derive instance newtypeConst :: Newtype (Const a b) _ - -derive newtype instance eqConst :: Eq a => Eq (Const a b) - -derive instance eq1Const :: Eq a => Eq1 (Const a) - -derive newtype instance ordConst :: Ord a => Ord (Const a b) - -derive instance ord1Const :: Ord a => Ord1 (Const a) - -derive newtype instance boundedConst :: Bounded a => Bounded (Const a b) - -instance showConst :: Show a => Show (Const a b) where - show (Const x) = "(Const " <> show x <> ")" - -instance semigroupoidConst :: Semigroupoid Const where - compose _ (Const x) = Const x - -derive newtype instance semigroupConst :: Semigroup a => Semigroup (Const a b) - -derive newtype instance monoidConst :: Monoid a => Monoid (Const a b) - -derive newtype instance semiringConst :: Semiring a => Semiring (Const a b) - -derive newtype instance ringConst :: Ring a => Ring (Const a b) - -derive newtype instance euclideanRingConst :: EuclideanRing a => EuclideanRing (Const a b) - -derive newtype instance commutativeRingConst :: CommutativeRing a => CommutativeRing (Const a b) - -derive newtype instance heytingAlgebraConst :: HeytingAlgebra a => HeytingAlgebra (Const a b) - -derive newtype instance booleanAlgebraConst :: BooleanAlgebra a => BooleanAlgebra (Const a b) - -derive instance functorConst :: Functor (Const a) - -instance invariantConst :: Invariant (Const a) where - imap = imapF - -instance applyConst :: Semigroup a => Apply (Const a) where - apply (Const x) (Const y) = Const (x <> y) - -instance applicativeConst :: Monoid a => Applicative (Const a) where - pure _ = Const mempty diff --git a/stdlib/lib/Data/Decidable.purs b/stdlib/lib/Data/Decidable.purs deleted file mode 100644 index ce910de1..00000000 --- a/stdlib/lib/Data/Decidable.purs +++ /dev/null @@ -1,29 +0,0 @@ -module Data.Decidable where - -import Prelude - -import Data.Comparison (Comparison(..)) -import Data.Decide (class Decide) -import Data.Divisible (class Divisible) -import Data.Equivalence (Equivalence(..)) -import Data.Op (Op(..)) -import Data.Predicate (Predicate(..)) - --- | `Decidable` is the contravariant analogue of `Alternative`. -class (Decide f, Divisible f) <= Decidable f where - lose :: forall a. (a -> Void) -> f a - -instance decidableComparison :: Decidable Comparison where - lose f = Comparison \a _ -> absurd (f a) - -instance decidableEquivalence :: Decidable Equivalence where - lose f = Equivalence \a -> absurd (f a) - -instance decidablePredicate :: Decidable Predicate where - lose f = Predicate \a -> absurd (f a) - -instance decidableOp :: Monoid r => Decidable (Op r) where - lose f = Op \a -> absurd (f a) - -lost :: forall f. Decidable f => f Void -lost = lose identity diff --git a/stdlib/lib/Data/Decide.purs b/stdlib/lib/Data/Decide.purs deleted file mode 100644 index 746f3323..00000000 --- a/stdlib/lib/Data/Decide.purs +++ /dev/null @@ -1,42 +0,0 @@ -module Data.Decide where - -import Prelude - -import Data.Comparison (Comparison(..)) -import Data.Divide (class Divide) -import Data.Either (Either(..), either) -import Data.Equivalence (Equivalence(..)) -import Data.Op (Op(..)) -import Data.Predicate (Predicate(..)) - --- | `Decide` is the contravariant analogue of `Alt`. -class Divide f <= Decide f where - choose :: forall a b c. (a -> Either b c) -> f b -> f c -> f a - -instance chooseComparison :: Decide Comparison where - choose f (Comparison g) (Comparison h) = Comparison \a b -> case f a of - Left c -> case f b of - Left d -> g c d - Right _ -> LT - Right c -> case f b of - Left _ -> GT - Right d -> h c d - -instance chooseEquivalence :: Decide Equivalence where - choose f (Equivalence g) (Equivalence h) = Equivalence \a b -> case f a of - Left c -> case f b of - Left d -> g c d - Right _ -> false - Right c -> case f b of - Left _ -> false - Right d -> h c d - -instance choosePredicate :: Decide Predicate where - choose f (Predicate g) (Predicate h) = Predicate (either g h <<< f) - -instance chooseOp :: Semigroup r => Decide (Op r) where - choose f (Op g) (Op h) = Op (either g h <<< f) - --- | `chosen = choose id` -chosen :: forall f a b. Decide f => f a -> f b -> f (Either a b) -chosen = choose identity diff --git a/stdlib/lib/Data/Distributive.purs b/stdlib/lib/Data/Distributive.purs deleted file mode 100644 index a4a83e45..00000000 --- a/stdlib/lib/Data/Distributive.purs +++ /dev/null @@ -1,67 +0,0 @@ -module Data.Distributive where - -import Prelude - -import Data.Identity (Identity(..)) -import Data.Newtype (unwrap) -import Data.Tuple (Tuple(..), snd) -import Type.Equality (class TypeEquals, from) - --- | Categorical dual of `Traversable`: --- | --- | - `distribute` is the dual of `sequence` - it zips an arbitrary collection --- | of containers. --- | - `collect` is the dual of `traverse` - it traverses an arbitrary --- | collection of values. --- | --- | Laws: --- | --- | - `distribute = collect identity` --- | - `distribute <<< distribute = identity` --- | - `collect f = distribute <<< map f` --- | - `map f = unwrap <<< collect (Identity <<< f)` --- | - `map distribute <<< collect f = unwrap <<< collect (Compose <<< f)` -class Functor f <= Distributive f where - distribute :: forall a g. Functor g => g (f a) -> f (g a) - collect :: forall a b g. Functor g => (a -> f b) -> g a -> f (g b) - -instance distributiveIdentity :: Distributive Identity where - distribute = Identity <<< map unwrap - collect f = Identity <<< map (unwrap <<< f) - -instance distributiveFunction :: Distributive ((->) e) where - distribute a e = map (_ $ e) a - collect f = distribute <<< map f - -instance distributiveTuple :: TypeEquals a Unit => Distributive (Tuple a) where - collect = collectDefault - distribute = Tuple (from unit) <<< map snd - --- | A default implementation of `distribute`, based on `collect`. -distributeDefault - :: forall a f g - . Distributive f - => Functor g - => g (f a) - -> f (g a) -distributeDefault = collect identity - --- | A default implementation of `collect`, based on `distribute`. -collectDefault - :: forall a b f g - . Distributive f - => Functor g - => (a -> f b) - -> g a - -> f (g b) -collectDefault f = distribute <<< map f - --- | Zip an arbitrary collection of containers and summarize the results -cotraverse - :: forall a b f g - . Distributive f - => Functor g - => (g a -> b) - -> g (f a) - -> f b -cotraverse f = map f <<< distribute diff --git a/stdlib/lib/Data/Divide.purs b/stdlib/lib/Data/Divide.purs deleted file mode 100644 index 4581dcc9..00000000 --- a/stdlib/lib/Data/Divide.purs +++ /dev/null @@ -1,46 +0,0 @@ -module Data.Divide where - -import Prelude - -import Data.Comparison (Comparison(..)) -import Data.Equivalence (Equivalence(..)) -import Data.Functor.Contravariant (class Contravariant) -import Data.Op (Op(..)) -import Data.Predicate (Predicate(..)) -import Data.Tuple (Tuple(..)) - --- | `Divide` is the contravariant analogue of `Apply`. --- | --- | For example, to test equality of `Point`s, we can use the `Divide` instance --- | for `Equivalence`: --- | --- | ```purescript --- | type Point = Tuple Int Int --- | --- | pointEquiv :: Equivalence Point --- | pointEquiv = divided defaultEquivalence defaultEquivalence --- | ``` -class Contravariant f <= Divide f where - divide :: forall a b c. (a -> Tuple b c) -> f b -> f c -> f a - -instance divideComparison :: Divide Comparison where - divide f (Comparison g) (Comparison h) = Comparison \a b -> case f a of - Tuple a' a'' -> case f b of - Tuple b' b'' -> g a' b' <> h a'' b'' - -instance divideEquivalence :: Divide Equivalence where - divide f (Equivalence g) (Equivalence h) = Equivalence \a b -> case f a of - Tuple a' a'' -> case f b of - Tuple b' b'' -> g a' b' && h a'' b'' - -instance dividePredicate :: Divide Predicate where - divide f (Predicate g) (Predicate h) = Predicate \a -> case f a of - Tuple b c -> g b && h c - -instance divideOp :: Semigroup r => Divide (Op r) where - divide f (Op g) (Op h) = Op \a -> case f a of - Tuple b c -> g b <> h c - --- | `divided = divide id` -divided :: forall f a b. Divide f => f a -> f b -> f (Tuple a b) -divided = divide identity diff --git a/stdlib/lib/Data/Divisible.purs b/stdlib/lib/Data/Divisible.purs deleted file mode 100644 index d717b4ac..00000000 --- a/stdlib/lib/Data/Divisible.purs +++ /dev/null @@ -1,25 +0,0 @@ -module Data.Divisible where - -import Prelude - -import Data.Comparison (Comparison(..)) -import Data.Divide (class Divide) -import Data.Equivalence (Equivalence(..)) -import Data.Op (Op(..)) -import Data.Predicate (Predicate(..)) - --- | `Divisible` is the contravariant analogue of `Applicative`. -class Divide f <= Divisible f where - conquer :: forall a. f a - -instance divisibleComparison :: Divisible Comparison where - conquer = Comparison $ \_ _ -> EQ - -instance divisibleEquivalence :: Divisible Equivalence where - conquer = Equivalence $ \_ _ -> true - -instance divisiblePredicate :: Divisible Predicate where - conquer = Predicate (const true) - -instance divisibleOp :: (Monoid r) => Divisible (Op r) where - conquer = Op $ const mempty diff --git a/stdlib/lib/Data/DivisionRing.purs b/stdlib/lib/Data/DivisionRing.purs deleted file mode 100644 index 227f7a94..00000000 --- a/stdlib/lib/Data/DivisionRing.purs +++ /dev/null @@ -1,55 +0,0 @@ -module Data.DivisionRing - ( class DivisionRing - , recip - , leftDiv - , rightDiv - , module Data.Ring - , module Data.Semiring - ) where - -import Data.EuclideanRing ((/)) -import Data.Ring (class Ring, negate, sub) -import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) - --- | The `DivisionRing` class is for non-zero rings in which every non-zero --- | element has a multiplicative inverse. Division rings are sometimes also --- | called *skew fields*. --- | --- | Instances must satisfy the following laws in addition to the `Ring` laws: --- | --- | - Non-zero ring: `one /= zero` --- | - Non-zero multiplicative inverse: `recip a * a = a * recip a = one` for --- | all non-zero `a` --- | --- | The result of `recip zero` is left undefined; individual instances may --- | choose how to handle this case. --- | --- | If a type has both `DivisionRing` and `CommutativeRing` instances, then --- | it is a field and should have a `Field` instance. -class Ring a <= DivisionRing a where - recip :: a -> a - --- | Left division, defined as `leftDiv a b = recip b * a`. Left and right --- | division are distinct in this module because a `DivisionRing` is not --- | necessarily commutative. --- | --- | If the type `a` is also a `EuclideanRing`, then this function is --- | equivalent to `div` from the `EuclideanRing` class. When working --- | abstractly, `div` should generally be preferred, unless you know that you --- | need your code to work with noncommutative rings. -leftDiv :: forall a. DivisionRing a => a -> a -> a -leftDiv a b = recip b * a - --- | Right division, defined as `rightDiv a b = a * recip b`. Left and right --- | division are distinct in this module because a `DivisionRing` is not --- | necessarily commutative. --- | --- | If the type `a` is also a `EuclideanRing`, then this function is --- | equivalent to `div` from the `EuclideanRing` class. When working --- | abstractly, `div` should generally be preferred, unless you know that you --- | need your code to work with noncommutative rings. -rightDiv :: forall a. DivisionRing a => a -> a -> a -rightDiv a b = a * recip b - -instance divisionringNumber :: DivisionRing Number where - recip x = 1.0 / x diff --git a/stdlib/lib/Data/Either.purs b/stdlib/lib/Data/Either.purs deleted file mode 100644 index 3940d936..00000000 --- a/stdlib/lib/Data/Either.purs +++ /dev/null @@ -1,294 +0,0 @@ -module Data.Either where - -import Prelude - -import Control.Alt (class Alt, (<|>)) -import Control.Extend (class Extend) -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.Generic.Rep (class Generic) -import Data.Maybe (Maybe(..), maybe, maybe') -import Data.Ord (class Ord1) - --- | The `Either` type is used to represent a choice between two types of value. --- | --- | A common use case for `Either` is error handling, where `Left` is used to --- | carry an error value and `Right` is used to carry a success value. -data Either a b = Left a | Right b - --- | The `Functor` instance allows functions to transform the contents of a --- | `Right` with the `<$>` operator: --- | --- | ``` purescript --- | f <$> Right x == Right (f x) --- | ``` --- | --- | `Left` values are untouched: --- | --- | ``` purescript --- | f <$> Left y == Left y --- | ``` -derive instance functorEither :: Functor (Either a) - -derive instance genericEither :: Generic (Either a b) _ - -instance invariantEither :: Invariant (Either a) where - imap = imapF - --- | The `Apply` instance allows functions contained within a `Right` to --- | transform a value contained within a `Right` using the `(<*>)` operator: --- | --- | ``` purescript --- | Right f <*> Right x == Right (f x) --- | ``` --- | --- | `Left` values are left untouched: --- | --- | ``` purescript --- | Left f <*> Right x == Left f --- | Right f <*> Left y == Left y --- | ``` --- | --- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used to transform a --- | pure function to take `Either`-typed arguments so `f :: a -> b -> c` --- | becomes `f :: Either l a -> Either l b -> Either l c`: --- | --- | ``` purescript --- | f <$> Right x <*> Right y == Right (f x y) --- | ``` --- | --- | The `Left`-preserving behaviour of both operators means the result of --- | an expression like the above but where any one of the values is `Left` --- | means the whole result becomes `Left` also, taking the first `Left` value --- | found: --- | --- | ``` purescript --- | f <$> Left x <*> Right y == Left x --- | f <$> Right x <*> Left y == Left y --- | f <$> Left x <*> Left y == Left x --- | ``` -instance applyEither :: Apply (Either e) where - apply (Left e) _ = Left e - apply (Right f) r = f <$> r - --- | The `Applicative` instance enables lifting of values into `Either` with the --- | `pure` function: --- | --- | ``` purescript --- | pure x :: Either _ _ == Right x --- | ``` --- | --- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s --- | `pure` can be used to pass a mixture of `Either` and non-`Either` typed --- | values to a function that does not usually expect them, by using `pure` --- | for any value that is not already `Either` typed: --- | --- | ``` purescript --- | f <$> Right x <*> pure y == Right (f x y) --- | ``` --- | --- | Even though `pure = Right` it is recommended to use `pure` in situations --- | like this as it allows the choice of `Applicative` to be changed later --- | without having to go through and replace `Right` with a new constructor. -instance applicativeEither :: Applicative (Either e) where - pure = Right - --- | The `Alt` instance allows for a choice to be made between two `Either` --- | values with the `<|>` operator, where the first `Right` encountered --- | is taken. --- | --- | ``` purescript --- | Right x <|> Right y == Right x --- | Left x <|> Right y == Right y --- | Left x <|> Left y == Left y --- | ``` -instance altEither :: Alt (Either e) where - alt (Left _) r = r - alt l _ = l - --- | The `Bind` instance allows sequencing of `Either` values and functions that --- | return an `Either` by using the `>>=` operator: --- | --- | ``` purescript --- | Left x >>= f = Left x --- | Right x >>= f = f x --- | ``` --- | --- | `Either`'s "do notation" can be understood to work like this: --- | ``` purescript --- | x :: forall e a. Either e a --- | x = -- --- | --- | y :: forall e b. Either e b --- | y = -- --- | --- | foo :: forall e a. (a -> b -> c) -> Either e c --- | foo f = do --- | x' <- x --- | y' <- y --- | pure (f x' y') --- | ``` --- | --- | ...which is equivalent to... --- | --- | ``` purescript --- | x >>= (\x' -> y >>= (\y' -> pure (f x' y'))) --- | ``` --- | --- | ...and is the same as writing... --- | --- | ``` --- | foo :: forall e a. (a -> b -> c) -> Either e c --- | foo f = case x of --- | Left e -> --- | Left e --- | Right x -> case y of --- | Left e -> --- | Left e --- | Right y -> --- | Right (f x y) --- | ``` -instance bindEither :: Bind (Either e) where - bind = either (\e _ -> Left e) (\a f -> f a) - --- | The `Monad` instance guarantees that there are both `Applicative` and --- | `Bind` instances for `Either`. -instance monadEither :: Monad (Either e) - --- | The `Extend` instance allows sequencing of `Either` values and functions --- | that accept an `Either` and return a non-`Either` result using the --- | `<<=` operator. --- | --- | ``` purescript --- | f <<= Left x = Left x --- | f <<= Right x = Right (f (Right x)) --- | ``` -instance extendEither :: Extend (Either e) where - extend _ (Left y) = Left y - extend f x = Right (f x) - --- | The `Show` instance allows `Either` values to be rendered as a string with --- | `show` whenever there is an `Show` instance for both type the `Either` can --- | contain. -instance showEither :: (Show a, Show b) => Show (Either a b) where - show (Left x) = "(Left " <> show x <> ")" - show (Right y) = "(Right " <> show y <> ")" - --- | The `Eq` instance allows `Either` values to be checked for equality with --- | `==` and inequality with `/=` whenever there is an `Eq` instance for both --- | types the `Either` can contain. -derive instance eqEither :: (Eq a, Eq b) => Eq (Either a b) - -derive instance eq1Either :: Eq a => Eq1 (Either a) - --- | The `Ord` instance allows `Either` values to be compared with --- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for --- | both types the `Either` can contain. --- | --- | Any `Left` value is considered to be less than a `Right` value. -derive instance ordEither :: (Ord a, Ord b) => Ord (Either a b) - -derive instance ord1Either :: Ord a => Ord1 (Either a) - -instance boundedEither :: (Bounded a, Bounded b) => Bounded (Either a b) where - top = Right top - bottom = Left bottom - -instance semigroupEither :: (Semigroup b) => Semigroup (Either a b) where - append x y = append <$> x <*> y - --- | Takes two functions and an `Either` value, if the value is a `Left` the --- | inner value is applied to the first function, if the value is a `Right` --- | the inner value is applied to the second function. --- | --- | ``` purescript --- | either f g (Left x) == f x --- | either f g (Right y) == g y --- | ``` -either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c -either f _ (Left a) = f a -either _ g (Right b) = g b - --- | Combine two alternatives. -choose :: forall m a b. Alt m => m a -> m b -> m (Either a b) -choose a b = Left <$> a <|> Right <$> b - --- | Returns `true` when the `Either` value was constructed with `Left`. -isLeft :: forall a b. Either a b -> Boolean -isLeft = either (const true) (const false) - --- | Returns `true` when the `Either` value was constructed with `Right`. -isRight :: forall a b. Either a b -> Boolean -isRight = either (const false) (const true) - --- | A function that extracts the value from the `Left` data constructor. --- | The first argument is a default value, which will be returned in the --- | case where a `Right` is passed to `fromLeft`. -fromLeft :: forall a b. a -> Either a b -> a -fromLeft _ (Left a) = a -fromLeft default _ = default - --- | Similar to `fromLeft` but for use in cases where the default value may be --- | expensive to compute. As PureScript is not lazy, the standard `fromLeft` --- | has to evaluate the default value before returning the result, --- | whereas here the value is only computed when the `Either` is known --- | to be `Right`. -fromLeft' :: forall a b. (Unit -> a) -> Either a b -> a -fromLeft' _ (Left a) = a -fromLeft' default _ = default unit - --- | A function that extracts the value from the `Right` data constructor. --- | The first argument is a default value, which will be returned in the --- | case where a `Left` is passed to `fromRight`. -fromRight :: forall a b. b -> Either a b -> b -fromRight _ (Right b) = b -fromRight default _ = default - --- | Similar to `fromRight` but for use in cases where the default value may be --- | expensive to compute. As PureScript is not lazy, the standard `fromRight` --- | has to evaluate the default value before returning the result, --- | whereas here the value is only computed when the `Either` is known --- | to be `Left`. -fromRight' :: forall a b. (Unit -> b) -> Either a b -> b -fromRight' _ (Right b) = b -fromRight' default _ = default unit - --- | Takes a default and a `Maybe` value, if the value is a `Just`, turn it into --- | a `Right`, if the value is a `Nothing` use the provided default as a `Left` --- | --- | ```purescript --- | note "default" Nothing = Left "default" --- | note "default" (Just 1) = Right 1 --- | ``` -note :: forall a b. a -> Maybe b -> Either a b -note a = maybe (Left a) Right - --- | Similar to `note`, but for use in cases where the default value may be --- | expensive to compute. --- | --- | ```purescript --- | note' (\_ -> "default") Nothing = Left "default" --- | note' (\_ -> "default") (Just 1) = Right 1 --- | ``` -note' :: forall a b. (Unit -> a) -> Maybe b -> Either a b -note' f = maybe' (Left <<< f) Right - --- | Turns an `Either` into a `Maybe`, by throwing potential `Left` values away and converting --- | them into `Nothing`. `Right` values get turned into `Just`s. --- | --- | ```purescript --- | hush (Left "ParseError") = Nothing --- | hush (Right 42) = Just 42 --- | ``` -hush :: forall a b. Either a b -> Maybe b -hush = either (const Nothing) Just - --- | Turns an `Either` into a `Maybe`, by throwing potential `Right` values away and converting --- | them into `Nothing`. `Left` values get turned into `Just`s. --- | --- | ```purescript --- | blush (Left "ParseError") = Just "Parse Error" --- | blush (Right 42) = Nothing --- | ``` -blush :: forall a b. Either a b -> Maybe a -blush = either Just (const Nothing) diff --git a/stdlib/lib/Data/Either/Inject.purs b/stdlib/lib/Data/Either/Inject.purs deleted file mode 100644 index 502d4649..00000000 --- a/stdlib/lib/Data/Either/Inject.purs +++ /dev/null @@ -1,23 +0,0 @@ -module Data.Either.Inject where - -import Prelude - -import Data.Either (Either(..), either) -import Data.Maybe (Maybe(..)) - -class Inject a b where - inj :: a -> b - prj :: b -> Maybe a - -instance injectReflexive :: Inject a a where - inj = identity - prj = Just - -else instance injectLeft :: Inject a (Either a b) where - inj = Left - prj = either Just (const Nothing) - -else instance injectRight :: Inject a b => Inject a (Either c b) where - inj = Right <<< inj - prj = either (const Nothing) prj - diff --git a/stdlib/lib/Data/Either/Nested.purs b/stdlib/lib/Data/Either/Nested.purs deleted file mode 100644 index f4ee9318..00000000 --- a/stdlib/lib/Data/Either/Nested.purs +++ /dev/null @@ -1,278 +0,0 @@ --- | Utilities for n-eithers: sums types with more than two terms built from nested eithers. --- | --- | Nested eithers arise naturally in sum combinators. You shouldn't --- | represent sum data using nested eithers, but if combinators you're working with --- | create them, utilities in this module will allow to to more easily work --- | with them, including translating to and from more traditional sum types. --- | --- | ```purescript --- | data Color = Red Number | Green Number | Blue Number --- | --- | fromEither3 :: Either3 Number Number Number -> Color --- | fromEither3 = either3 Red Green Blue --- | --- | toEither3 :: Color -> Either3 Number Number Number --- | toEither3 (Red v) = in1 v --- | toEither3 (Green v) = in2 v --- | toEither3 (Blue v) = in3 v --- | ``` -module Data.Either.Nested - ( type (\/), (\/) - , in1, in2, in3, in4, in5, in6, in7, in8, in9, in10 - , at1, at2, at3, at4, at5, at6, at7, at8, at9, at10 - , Either1, Either2, Either3, Either4, Either5, Either6, Either7, Either8, Either9, Either10 - , either1, either2, either3, either4, either5, either6, either7, either8, either9, either10 - ) where - -import Data.Either (Either(..), either) -import Data.Void (Void, absurd) - -infixr 6 type Either as \/ - --- | The `\/` operator alias for the `either` function allows easy matching on nested Eithers. For example, consider the function --- | --- | ```purescript --- | f :: (Int \/ String \/ Boolean) -> String --- | f (Left x) = show x --- | f (Right (Left y)) = y --- | f (Right (Right z)) = if z then "Yes" else "No" --- | ``` --- | --- | The `\/` operator alias allows us to rewrite this function as --- | --- | ```purescript --- | f :: (Int \/ String \/ Boolean) -> String --- | f = show \/ identity \/ if _ then "Yes" else "No" --- | ``` -infixr 6 either as \/ - -type Either1 a = a \/ Void -type Either2 a b = a \/ b \/ Void -type Either3 a b c = a \/ b \/ c \/ Void -type Either4 a b c d = a \/ b \/ c \/ d \/ Void -type Either5 a b c d e = a \/ b \/ c \/ d \/ e \/ Void -type Either6 a b c d e f = a \/ b \/ c \/ d \/ e \/ f \/ Void -type Either7 a b c d e f g = a \/ b \/ c \/ d \/ e \/ f \/ g \/ Void -type Either8 a b c d e f g h = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ Void -type Either9 a b c d e f g h i = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ Void -type Either10 a b c d e f g h i j = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ Void - -in1 :: forall a z. a -> a \/ z -in1 = Left - -in2 :: forall a b z. b -> a \/ b \/ z -in2 v = Right (Left v) - -in3 :: forall a b c z. c -> a \/ b \/ c \/ z -in3 v = Right (Right (Left v)) - -in4 :: forall a b c d z. d -> a \/ b \/ c \/ d \/ z -in4 v = Right (Right (Right (Left v))) - -in5 :: forall a b c d e z. e -> a \/ b \/ c \/ d \/ e \/ z -in5 v = Right (Right (Right (Right (Left v)))) - -in6 :: forall a b c d e f z. f -> a \/ b \/ c \/ d \/ e \/ f \/ z -in6 v = Right (Right (Right (Right (Right (Left v))))) - -in7 :: forall a b c d e f g z. g -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ z -in7 v = Right (Right (Right (Right (Right (Right (Left v)))))) - -in8 :: forall a b c d e f g h z. h -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ z -in8 v = Right (Right (Right (Right (Right (Right (Right (Left v))))))) - -in9 :: forall a b c d e f g h i z. i -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ z -in9 v = Right (Right (Right (Right (Right (Right (Right (Right (Left v)))))))) - -in10 :: forall a b c d e f g h i j z. j -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ z -in10 v = Right (Right (Right (Right (Right (Right (Right (Right (Right (Left v))))))))) - -at1 :: forall r a z. r -> (a -> r) -> a \/ z -> r -at1 b f y = case y of - Left r -> f r - _ -> b - -at2 :: forall r a b z. r -> (b -> r) -> a \/ b \/ z -> r -at2 b f y = case y of - Right (Left r) -> f r - _ -> b - -at3 :: forall r a b c z. r -> (c -> r) -> a \/ b \/ c \/ z -> r -at3 b f y = case y of - Right (Right (Left r)) -> f r - _ -> b - -at4 :: forall r a b c d z. r -> (d -> r) -> a \/ b \/ c \/ d \/ z -> r -at4 b f y = case y of - Right (Right (Right (Left r))) -> f r - _ -> b - -at5 :: forall r a b c d e z. r -> (e -> r) -> a \/ b \/ c \/ d \/ e \/ z -> r -at5 b f y = case y of - Right (Right (Right (Right (Left r)))) -> f r - _ -> b - -at6 :: forall r a b c d e f z. r -> (f -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ z -> r -at6 b f y = case y of - Right (Right (Right (Right (Right (Left r))))) -> f r - _ -> b - -at7 :: forall r a b c d e f g z. r -> (g -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ z -> r -at7 b f y = case y of - Right (Right (Right (Right (Right (Right (Left r)))))) -> f r - _ -> b - -at8 :: forall r a b c d e f g h z. r -> (h -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ z -> r -at8 b f y = case y of - Right (Right (Right (Right (Right (Right (Right (Left r))))))) -> f r - _ -> b - -at9 :: forall r a b c d e f g h i z. r -> (i -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ z -> r -at9 b f y = case y of - Right (Right (Right (Right (Right (Right (Right (Right (Left r)))))))) -> f r - _ -> b - -at10 :: forall r a b c d e f g h i j z. r -> (j -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ z -> r -at10 b f y = case y of - Right (Right (Right (Right (Right (Right (Right (Right (Right (Left r))))))))) -> f r - _ -> b - -either1 :: forall a. Either1 a -> a -either1 y = case y of - Left r -> r - Right _1 -> absurd _1 - -either2 :: forall r a b. (a -> r) -> (b -> r) -> Either2 a b -> r -either2 a b y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> absurd _2 - -either3 :: forall r a b c. (a -> r) -> (b -> r) -> (c -> r) -> Either3 a b c -> r -either3 a b c y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> absurd _3 - -either4 :: forall r a b c d. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> Either4 a b c d -> r -either4 a b c d y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> absurd _4 - -either5 :: forall r a b c d e. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> Either5 a b c d e -> r -either5 a b c d e y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> case _4 of - Left r -> e r - Right _5 -> absurd _5 - -either6 :: forall r a b c d e f. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> Either6 a b c d e f -> r -either6 a b c d e f y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> case _4 of - Left r -> e r - Right _5 -> case _5 of - Left r -> f r - Right _6 -> absurd _6 - -either7 :: forall r a b c d e f g. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> Either7 a b c d e f g -> r -either7 a b c d e f g y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> case _4 of - Left r -> e r - Right _5 -> case _5 of - Left r -> f r - Right _6 -> case _6 of - Left r -> g r - Right _7 -> absurd _7 - -either8 :: forall r a b c d e f g h. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> (h -> r) -> Either8 a b c d e f g h -> r -either8 a b c d e f g h y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> case _4 of - Left r -> e r - Right _5 -> case _5 of - Left r -> f r - Right _6 -> case _6 of - Left r -> g r - Right _7 -> case _7 of - Left r -> h r - Right _8 -> absurd _8 - -either9 :: forall r a b c d e f g h i. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> (h -> r) -> (i -> r) -> Either9 a b c d e f g h i -> r -either9 a b c d e f g h i y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> case _4 of - Left r -> e r - Right _5 -> case _5 of - Left r -> f r - Right _6 -> case _6 of - Left r -> g r - Right _7 -> case _7 of - Left r -> h r - Right _8 -> case _8 of - Left r -> i r - Right _9 -> absurd _9 - -either10 :: forall r a b c d e f g h i j. (a -> r) -> (b -> r) -> (c -> r) -> (d -> r) -> (e -> r) -> (f -> r) -> (g -> r) -> (h -> r) -> (i -> r) -> (j -> r) -> Either10 a b c d e f g h i j -> r -either10 a b c d e f g h i j y = case y of - Left r -> a r - Right _1 -> case _1 of - Left r -> b r - Right _2 -> case _2 of - Left r -> c r - Right _3 -> case _3 of - Left r -> d r - Right _4 -> case _4 of - Left r -> e r - Right _5 -> case _5 of - Left r -> f r - Right _6 -> case _6 of - Left r -> g r - Right _7 -> case _7 of - Left r -> h r - Right _8 -> case _8 of - Left r -> i r - Right _9 -> case _9 of - Left r -> j r - Right _10 -> absurd _10 diff --git a/stdlib/lib/Data/Enum.purs b/stdlib/lib/Data/Enum.purs deleted file mode 100644 index 0d4b0976..00000000 --- a/stdlib/lib/Data/Enum.purs +++ /dev/null @@ -1,321 +0,0 @@ -module Data.Enum - ( class Enum, succ, pred - , class BoundedEnum, cardinality, toEnum, fromEnum - , toEnumWithDefaults - , Cardinality(..) - , enumFromTo - , enumFromThenTo - , upFrom - , upFromIncluding - , downFrom - , downFromIncluding - , defaultSucc - , defaultPred - , defaultCardinality - , defaultToEnum - , defaultFromEnum - ) where - -import Prelude - -import Control.MonadPlus (guard) -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), maybe, fromJust) -import Data.Newtype (class Newtype) -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, singleton, unfoldr) -import Data.Unfoldable1 (class Unfoldable1, unfoldr1) -import Partial.Unsafe (unsafePartial) - --- | Type class for enumerations. --- | --- | Laws: --- | - Successor: `all (a < _) (succ a)` --- | - Predecessor: `all (_ < a) (pred a)` --- | - Succ retracts pred: `pred >=> succ >=> pred = pred` --- | - Pred retracts succ: `succ >=> pred >=> succ = succ` --- | - Non-skipping succ: `b <= a || any (_ <= b) (succ a)` --- | - Non-skipping pred: `a <= b || any (b <= _) (pred a)` --- | --- | The retraction laws can intuitively be understood as saying that `succ` is --- | the opposite of `pred`; if you apply `succ` and then `pred` to something, --- | you should end up with what you started with (although of course this --- | doesn't apply if you tried to `succ` the last value in an enumeration and --- | therefore got `Nothing` out). --- | --- | The non-skipping laws can intuitively be understood as saying that `succ` --- | shouldn't skip over any elements of your type. For example, _without_ the --- | non-skipping laws, it would be permissible to write an `Enum Int` instance --- | where `succ x = Just (x+2)`, and similarly `pred x = Just (x-2)`. -class Ord a <= Enum a where - succ :: a -> Maybe a - pred :: a -> Maybe a - -instance enumBoolean :: Enum Boolean where - succ false = Just true - succ _ = Nothing - pred true = Just false - pred _= Nothing - -instance enumInt :: Enum Int where - succ n = if n < top then Just (n + 1) else Nothing - pred n = if n > bottom then Just (n - 1) else Nothing - -instance enumChar :: Enum Char where - succ = defaultSucc charToEnum toCharCode - pred = defaultPred charToEnum toCharCode - -instance enumUnit :: Enum Unit where - succ = const Nothing - pred = const Nothing - -instance enumOrdering :: Enum Ordering where - succ LT = Just EQ - succ EQ = Just GT - succ GT = Nothing - pred LT = Nothing - pred EQ = Just LT - pred GT = Just EQ - -instance enumMaybe :: BoundedEnum a => Enum (Maybe a) where - succ Nothing = Just (Just bottom) - succ (Just a) = Just <$> succ a - pred Nothing = Nothing - pred (Just a) = Just (pred a) - -instance enumEither :: (BoundedEnum a, BoundedEnum b) => Enum (Either a b) where - succ (Left a) = maybe (Just (Right bottom)) (Just <<< Left) (succ a) - succ (Right b) = maybe Nothing (Just <<< Right) (succ b) - pred (Left a) = maybe Nothing (Just <<< Left) (pred a) - pred (Right b) = maybe (Just (Left top)) (Just <<< Right) (pred b) - -instance enumTuple :: (Enum a, BoundedEnum b) => Enum (Tuple a b) where - succ (Tuple a b) = maybe (flip Tuple bottom <$> succ a) (Just <<< Tuple a) (succ b) - pred (Tuple a b) = maybe (flip Tuple top <$> pred a) (Just <<< Tuple a) (pred b) - --- | Type class for finite enumerations. --- | --- | This should not be considered a part of a numeric hierarchy, as in Haskell. --- | Rather, this is a type class for small, ordered sum types with --- | statically-determined cardinality and the ability to easily compute --- | successor and predecessor elements like `DayOfWeek`. --- | --- | Laws: --- | --- | - ```succ bottom >>= succ >>= succ ... succ [cardinality - 1 times] == top``` --- | - ```pred top >>= pred >>= pred ... pred [cardinality - 1 times] == bottom``` --- | - ```forall a > bottom: pred a >>= succ == Just a``` --- | - ```forall a < top: succ a >>= pred == Just a``` --- | - ```forall a > bottom: fromEnum <$> pred a = pred (fromEnum a)``` --- | - ```forall a < top: fromEnum <$> succ a = succ (fromEnum a)``` --- | - ```e1 `compare` e2 == fromEnum e1 `compare` fromEnum e2``` --- | - ```toEnum (fromEnum a) = Just a``` -class (Bounded a, Enum a) <= BoundedEnum a where - cardinality :: Cardinality a - toEnum :: Int -> Maybe a - fromEnum :: a -> Int - -instance boundedEnumBoolean :: BoundedEnum Boolean where - cardinality = Cardinality 2 - toEnum 0 = Just false - toEnum 1 = Just true - toEnum _ = Nothing - fromEnum false = 0 - fromEnum true = 1 - -instance boundedEnumChar :: BoundedEnum Char where - cardinality = Cardinality (toCharCode top - toCharCode bottom) - toEnum = charToEnum - fromEnum = toCharCode - -instance boundedEnumUnit :: BoundedEnum Unit where - cardinality = Cardinality 1 - toEnum 0 = Just unit - toEnum _ = Nothing - fromEnum = const 0 - -instance boundedEnumOrdering :: BoundedEnum Ordering where - cardinality = Cardinality 3 - toEnum 0 = Just LT - toEnum 1 = Just EQ - toEnum 2 = Just GT - toEnum _ = Nothing - fromEnum LT = 0 - fromEnum EQ = 1 - fromEnum GT = 2 - --- | Like `toEnum` but returns the first argument if `x` is less than --- | `fromEnum bottom` and the second argument if `x` is greater than --- | `fromEnum top`. --- | --- | ``` purescript --- | toEnumWithDefaults False True (-1) -- False --- | toEnumWithDefaults False True 0 -- False --- | toEnumWithDefaults False True 1 -- True --- | toEnumWithDefaults False True 2 -- True --- | ``` -toEnumWithDefaults :: forall a. BoundedEnum a => a -> a -> Int -> a -toEnumWithDefaults low high x = case toEnum x of - Just enum -> enum - Nothing -> if x < fromEnum (bottom :: a) then low else high - --- | A type for the size of finite enumerations. -newtype Cardinality :: forall k. k -> Type -newtype Cardinality a = Cardinality Int - -type role Cardinality representational - -derive instance newtypeCardinality :: Newtype (Cardinality a) _ -derive newtype instance eqCardinality :: Eq (Cardinality a) -derive newtype instance ordCardinality :: Ord (Cardinality a) - -instance showCardinality :: Show (Cardinality a) where - show (Cardinality n) = "(Cardinality " <> show n <> ")" - --- | Returns a contiguous sequence of elements from the first value to the --- | second value (inclusive). --- | --- | ``` purescript --- | enumFromTo 0 3 = [0, 1, 2, 3] --- | enumFromTo 'c' 'a' = ['c', 'b', 'a'] --- | ``` --- | --- | The example shows `Array` return values, but the result can be any type --- | with an `Unfoldable1` instance. -enumFromTo :: forall a u. Enum a => Unfoldable1 u => a -> a -> u a -enumFromTo = case _, _ of - from, to - | from == to -> singleton from - | from < to -> unfoldr1 (go succ (<=) to) from - | otherwise -> unfoldr1 (go pred (>=) to) from - where - go step op to a = Tuple a (step a >>= \a' -> guard (a' `op` to) $> a') - --- | Returns a sequence of elements from the first value, taking steps --- | according to the difference between the first and second value, up to --- | (but not exceeding) the third value. --- | --- | ``` purescript --- | enumFromThenTo 0 2 6 = [0, 2, 4, 6] --- | enumFromThenTo 0 3 5 = [0, 3] --- | ``` --- | --- | Note that there is no `BoundedEnum` instance for integers, they're just --- | being used here for illustrative purposes to help clarify the behaviour. --- | --- | The example shows `Array` return values, but the result can be any type --- | with an `Unfoldable1` instance. -enumFromThenTo :: forall f a. Unfoldable f => Functor f => BoundedEnum a => a -> a -> a -> f a -enumFromThenTo = unsafePartial \a b c -> - let - a' = fromEnum a - b' = fromEnum b - c' = fromEnum c - in - (toEnum >>> fromJust) <$> unfoldr (go (b' - a') c') a' - where - go step to e - | e <= to = Just (Tuple e (e + step)) - | otherwise = Nothing - --- | Produces all successors of an `Enum` value, excluding the start value. -upFrom :: forall a u. Enum a => Unfoldable u => a -> u a -upFrom = unfoldr (map diag <<< succ) - --- | Produces all successors of an `Enum` value, including the start value. --- | --- | `upFromIncluding bottom` will return all values in an `Enum`. -upFromIncluding :: ∀ a u. Enum a => Unfoldable1 u => a -> u a -upFromIncluding = unfoldr1 (Tuple <*> succ) - --- | Produces all predecessors of an `Enum` value, excluding the start value. -downFrom :: forall a u. Enum a => Unfoldable u => a -> u a -downFrom = unfoldr (map diag <<< pred) - --- | Produces all predecessors of an `Enum` value, including the start value. --- | --- | `downFromIncluding top` will return all values in an `Enum`, in reverse --- | order. -downFromIncluding :: forall a u. Enum a => Unfoldable1 u => a -> u a -downFromIncluding = unfoldr1 (Tuple <*> pred) - --- | Provides a default implementation for `succ`, given a function that maps --- | integers to values in the `Enum`, and a function that maps values in the --- | `Enum` back to integers. The integer mapping must agree in both directions --- | for this to implement a law-abiding `succ`. --- | --- | If a `BoundedEnum` instance exists for `a`, the `toEnum` and `fromEnum` --- | functions can be used here: --- | --- | ``` purescript --- | succ = defaultSucc toEnum fromEnum --- | ``` -defaultSucc :: forall a. (Int -> Maybe a) -> (a -> Int) -> a -> Maybe a -defaultSucc toEnum' fromEnum' a = toEnum' (fromEnum' a + 1) - --- | Provides a default implementation for `pred`, given a function that maps --- | integers to values in the `Enum`, and a function that maps values in the --- | `Enum` back to integers. The integer mapping must agree in both directions --- | for this to implement a law-abiding `pred`. --- | --- | If a `BoundedEnum` instance exists for `a`, the `toEnum` and `fromEnum` --- | functions can be used here: --- | --- | ``` purescript --- | pred = defaultPred toEnum fromEnum --- | ``` -defaultPred :: forall a. (Int -> Maybe a) -> (a -> Int) -> a -> Maybe a -defaultPred toEnum' fromEnum' a = toEnum' (fromEnum' a - 1) - --- | Provides a default implementation for `cardinality`. --- | --- | Runs in `O(n)` where `n` is `fromEnum top` -defaultCardinality :: forall a. Bounded a => Enum a => Cardinality a -defaultCardinality = Cardinality $ go 1 (bottom :: a) where - go i x = - case succ x of - Just x' -> go (i + 1) x' - Nothing -> i - --- | Provides a default implementation for `toEnum`. --- | --- | - Assumes `fromEnum bottom = 0`. --- | - Cannot be used in conjuction with `defaultSucc`. --- | --- | Runs in `O(n)` where `n` is `fromEnum a`. -defaultToEnum :: forall a. Bounded a => Enum a => Int -> Maybe a -defaultToEnum i' = - if i' < 0 - then Nothing - else go i' bottom - where - go i x = - if i == 0 - then Just x - -- We avoid using >>= here because it foils tail-call optimization - else case succ x of - Just x' -> go (i - 1) x' - Nothing -> Nothing - --- | Provides a default implementation for `fromEnum`. --- | --- | - Assumes `toEnum 0 = Just bottom`. --- | - Cannot be used in conjuction with `defaultPred`. --- | --- | Runs in `O(n)` where `n` is `fromEnum a`. -defaultFromEnum :: forall a. Enum a => a -> Int -defaultFromEnum = go 0 where - go i x = - case pred x of - Just x' -> go (i + 1) x' - Nothing -> i - -diag :: forall a. a -> Tuple a a -diag a = Tuple a a - -charToEnum :: Int -> Maybe Char -charToEnum n | n >= toCharCode bottom && n <= toCharCode top = Just (fromCharCode n) -charToEnum _ = Nothing - -foreign import toCharCode :: Char -> Int -foreign import fromCharCode :: Int -> Char diff --git a/stdlib/lib/Data/Enum/Gen.purs b/stdlib/lib/Data/Enum/Gen.purs deleted file mode 100644 index 86caebd1..00000000 --- a/stdlib/lib/Data/Enum/Gen.purs +++ /dev/null @@ -1,18 +0,0 @@ -module Data.Enum.Gen where - -import Prelude - -import Control.Monad.Gen (class MonadGen, elements) -import Data.Enum (class BoundedEnum, succ, enumFromTo) -import Data.Maybe (Maybe(..)) -import Data.NonEmpty ((:|)) - --- | Create a random generator for a finite enumeration. -genBoundedEnum :: forall m a. MonadGen m => BoundedEnum a => m a -genBoundedEnum = - case succ bottom of - Just a → - let possibilities = enumFromTo a top :: Array a - in elements (bottom :| possibilities) - Nothing → - pure bottom diff --git a/stdlib/lib/Data/Enum/Generic.purs b/stdlib/lib/Data/Enum/Generic.purs deleted file mode 100644 index 0d59cca7..00000000 --- a/stdlib/lib/Data/Enum/Generic.purs +++ /dev/null @@ -1,118 +0,0 @@ -module Data.Enum.Generic where - -import Prelude - -import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum) -import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to) -import Data.Bounded.Generic (class GenericBottom, class GenericTop, genericBottom', genericTop') -import Data.Maybe (Maybe(..)) -import Data.Newtype (unwrap) - -class GenericEnum a where - genericPred' :: a -> Maybe a - genericSucc' :: a -> Maybe a - -instance genericEnumNoArguments :: GenericEnum NoArguments where - genericPred' _ = Nothing - genericSucc' _ = Nothing - -instance genericEnumArgument :: Enum a => GenericEnum (Argument a) where - genericPred' (Argument a) = Argument <$> pred a - genericSucc' (Argument a) = Argument <$> succ a - -instance genericEnumConstructor :: GenericEnum a => GenericEnum (Constructor name a) where - genericPred' (Constructor a) = Constructor <$> genericPred' a - genericSucc' (Constructor a) = Constructor <$> genericSucc' a - -instance genericEnumSum :: (GenericEnum a, GenericTop a, GenericEnum b, GenericBottom b) => GenericEnum (Sum a b) where - genericPred' = case _ of - Inl a -> Inl <$> genericPred' a - Inr b -> case genericPred' b of - Nothing -> Just (Inl genericTop') - Just b' -> Just (Inr b') - genericSucc' = case _ of - Inl a -> case genericSucc' a of - Nothing -> Just (Inr genericBottom') - Just a' -> Just (Inl a') - Inr b -> Inr <$> genericSucc' b - -instance genericEnumProduct :: (GenericEnum a, GenericTop a, GenericBottom a, GenericEnum b, GenericTop b, GenericBottom b) => GenericEnum (Product a b) where - genericPred' (Product a b) = case genericPred' b of - Just p -> Just $ Product a p - Nothing -> flip Product genericTop' <$> genericPred' a - genericSucc' (Product a b) = case genericSucc' b of - Just s -> Just $ Product a s - Nothing -> flip Product genericBottom' <$> genericSucc' a - - --- | A `Generic` implementation of the `pred` member from the `Enum` type class. -genericPred :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a -genericPred = map to <<< genericPred' <<< from - --- | A `Generic` implementation of the `succ` member from the `Enum` type class. -genericSucc :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a -genericSucc = map to <<< genericSucc' <<< from - -class GenericBoundedEnum a where - genericCardinality' :: Cardinality a - genericToEnum' :: Int -> Maybe a - genericFromEnum' :: a -> Int - -instance genericBoundedEnumNoArguments :: GenericBoundedEnum NoArguments where - genericCardinality' = Cardinality 1 - genericToEnum' i = if i == 0 then Just NoArguments else Nothing - genericFromEnum' _ = 0 - -instance genericBoundedEnumArgument :: BoundedEnum a => GenericBoundedEnum (Argument a) where - genericCardinality' = Cardinality (unwrap (cardinality :: Cardinality a)) - genericToEnum' i = Argument <$> toEnum i - genericFromEnum' (Argument a) = fromEnum a - -instance genericBoundedEnumConstructor :: GenericBoundedEnum a => GenericBoundedEnum (Constructor name a) where - genericCardinality' = Cardinality (unwrap (genericCardinality' :: Cardinality a)) - genericToEnum' i = Constructor <$> genericToEnum' i - genericFromEnum' (Constructor a) = genericFromEnum' a - -instance genericBoundedEnumSum :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Sum a b) where - genericCardinality' = - Cardinality - $ unwrap (genericCardinality' :: Cardinality a) - + unwrap (genericCardinality' :: Cardinality b) - genericToEnum' n = to genericCardinality' - where - to :: Cardinality a -> Maybe (Sum a b) - to (Cardinality ca) - | n >= 0 && n < ca = Inl <$> genericToEnum' n - | otherwise = Inr <$> genericToEnum' (n - ca) - genericFromEnum' = case _ of - Inl a -> genericFromEnum' a - Inr b -> genericFromEnum' b + unwrap (genericCardinality' :: Cardinality a) - - -instance genericBoundedEnumProduct :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Product a b) where - genericCardinality' = - Cardinality - $ unwrap (genericCardinality' :: Cardinality a) - * unwrap (genericCardinality' :: Cardinality b) - genericToEnum' n = to genericCardinality' - where to :: Cardinality b -> Maybe (Product a b) - to (Cardinality cb) = Product <$> (genericToEnum' $ n `div` cb) <*> (genericToEnum' $ n `mod` cb) - genericFromEnum' = from genericCardinality' - where from :: Cardinality b -> (Product a b) -> Int - from (Cardinality cb) (Product a b) = genericFromEnum' a * cb + genericFromEnum' b - - --- | A `Generic` implementation of the `cardinality` member from the --- | `BoundedEnum` type class. -genericCardinality :: forall a rep. Generic a rep => GenericBoundedEnum rep => Cardinality a -genericCardinality = Cardinality (unwrap (genericCardinality' :: Cardinality rep)) - --- | A `Generic` implementation of the `toEnum` member from the `BoundedEnum` --- | type class. -genericToEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => Int -> Maybe a -genericToEnum = map to <<< genericToEnum' - --- | A `Generic` implementation of the `fromEnum` member from the `BoundedEnum` --- | type class. -genericFromEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => a -> Int -genericFromEnum = genericFromEnum' <<< from diff --git a/stdlib/lib/Data/Eq.purs b/stdlib/lib/Data/Eq.purs deleted file mode 100644 index b4bbbf4b..00000000 --- a/stdlib/lib/Data/Eq.purs +++ /dev/null @@ -1,115 +0,0 @@ -module Data.Eq - ( class Eq - , eq - , (==) - , notEq - , (/=) - , class Eq1 - , eq1 - , notEq1 - , class EqRecord - , eqRecord - ) where - -import Data.HeytingAlgebra ((&&)) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit) -import Data.Void (Void) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeGet) -import Type.Proxy (Proxy(..)) - --- | The `Eq` type class represents types which support decidable equality. --- | --- | `Eq` instances should satisfy the following laws: --- | --- | - Reflexivity: `x == x = true` --- | - Symmetry: `x == y = y == x` --- | - Transitivity: if `x == y` and `y == z` then `x == z` --- | --- | **Note:** The `Number` type is not an entirely law abiding member of this --- | class due to the presence of `NaN`, since `NaN /= NaN`. Additionally, --- | computing with `Number` can result in a loss of precision, so sometimes --- | values that should be equivalent are not. -class Eq a where - eq :: a -> a -> Boolean - -infix 4 eq as == - --- | `notEq` tests whether one value is _not equal_ to another. Shorthand for --- | `not (eq x y)`. -notEq :: forall a. Eq a => a -> a -> Boolean -notEq x y = (x == y) == false - -infix 4 notEq as /= - -instance eqBoolean :: Eq Boolean where - eq = eqBooleanImpl - -instance eqInt :: Eq Int where - eq = eqIntImpl - -instance eqNumber :: Eq Number where - eq = eqNumberImpl - -instance eqChar :: Eq Char where - eq = eqCharImpl - -instance eqString :: Eq String where - eq = eqStringImpl - -instance eqUnit :: Eq Unit where - eq _ _ = true - -instance eqVoid :: Eq Void where - eq _ _ = true - -instance eqArray :: Eq a => Eq (Array a) where - eq = eqArrayImpl eq - -instance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) where - eq = eqRecord (Proxy :: Proxy list) - -instance eqProxy :: Eq (Proxy a) where - eq _ _ = true - -foreign import "psrs:intrinsic#booleanEq" eqBooleanImpl :: Boolean -> Boolean -> Boolean -foreign import "psrs:intrinsic#intEq" eqIntImpl :: Int -> Int -> Boolean -foreign import "psrs:intrinsic#numberEq" eqNumberImpl :: Number -> Number -> Boolean -foreign import "psrs:intrinsic#charEq" eqCharImpl :: Char -> Char -> Boolean -foreign import eqStringImpl :: String -> String -> Boolean - -foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean - --- | The `Eq1` type class represents type constructors with decidable equality. -class Eq1 f where - eq1 :: forall a. Eq a => f a -> f a -> Boolean - -instance eq1Array :: Eq1 Array where - eq1 = eq - -notEq1 :: forall f a. Eq1 f => Eq a => f a -> f a -> Boolean -notEq1 x y = (x `eq1` y) == false - --- | A class for records where all fields have `Eq` instances, used to implement --- | the `Eq` instance for records. -class EqRecord :: RL.RowList Type -> Row Type -> Constraint -class EqRecord rowlist row where - eqRecord :: Proxy rowlist -> Record row -> Record row -> Boolean - -instance eqRowNil :: EqRecord RL.Nil row where - eqRecord _ _ _ = true - -instance eqRowCons :: - ( EqRecord rowlistTail row - , Row.Cons key focus rowTail row - , IsSymbol key - , Eq focus - ) => - EqRecord (RL.Cons key focus rowlistTail) row where - eqRecord _ ra rb = (get ra == get rb) && tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - tail = eqRecord (Proxy :: Proxy rowlistTail) ra rb diff --git a/stdlib/lib/Data/Eq/Generic.purs b/stdlib/lib/Data/Eq/Generic.purs deleted file mode 100644 index 1c9e1386..00000000 --- a/stdlib/lib/Data/Eq/Generic.purs +++ /dev/null @@ -1,35 +0,0 @@ -module Data.Eq.Generic - ( class GenericEq - , genericEq' - , genericEq - ) where - -import Prelude (class Eq, (==), (&&)) -import Data.Generic.Rep - -class GenericEq a where - genericEq' :: a -> a -> Boolean - -instance genericEqNoConstructors :: GenericEq NoConstructors where - genericEq' _ _ = true - -instance genericEqNoArguments :: GenericEq NoArguments where - genericEq' _ _ = true - -instance genericEqSum :: (GenericEq a, GenericEq b) => GenericEq (Sum a b) where - genericEq' (Inl a1) (Inl a2) = genericEq' a1 a2 - genericEq' (Inr b1) (Inr b2) = genericEq' b1 b2 - genericEq' _ _ = false - -instance genericEqProduct :: (GenericEq a, GenericEq b) => GenericEq (Product a b) where - genericEq' (Product a1 b1) (Product a2 b2) = genericEq' a1 a2 && genericEq' b1 b2 - -instance genericEqConstructor :: GenericEq a => GenericEq (Constructor name a) where - genericEq' (Constructor a1) (Constructor a2) = genericEq' a1 a2 - -instance genericEqArgument :: Eq a => GenericEq (Argument a) where - genericEq' (Argument a1) (Argument a2) = a1 == a2 - --- | A `Generic` implementation of the `eq` member from the `Eq` type class. -genericEq :: forall a rep. Generic a rep => GenericEq rep => a -> a -> Boolean -genericEq x y = genericEq' (from x) (from y) diff --git a/stdlib/lib/Data/Equivalence.purs b/stdlib/lib/Data/Equivalence.purs deleted file mode 100644 index bbd062ed..00000000 --- a/stdlib/lib/Data/Equivalence.purs +++ /dev/null @@ -1,31 +0,0 @@ -module Data.Equivalence where - -import Prelude - -import Data.Comparison (Comparison(..)) -import Data.Function (on) -import Data.Functor.Contravariant (class Contravariant) -import Data.Newtype (class Newtype) - --- | An adaptor allowing `>$<` to map over the inputs of an equivalence --- | relation. -newtype Equivalence a = Equivalence (a -> a -> Boolean) - -derive instance newtypeEquivalence :: Newtype (Equivalence a) _ - -instance contravariantEquivalence :: Contravariant Equivalence where - cmap f (Equivalence g) = Equivalence (g `on` f) - -instance semigroupEquivalence :: Semigroup (Equivalence a) where - append (Equivalence p) (Equivalence q) = Equivalence (\a b -> p a b && q a b) - -instance monoidEquivalence :: Monoid (Equivalence a) where - mempty = Equivalence (\_ _ -> true) - --- | The default equivalence relation for any values with an `Eq` instance. -defaultEquivalence :: forall a. Eq a => Equivalence a -defaultEquivalence = Equivalence eq - --- | An equivalence relation for any `Comparison`. -comparisonEquivalence :: forall a. Comparison a -> Equivalence a -comparisonEquivalence (Comparison p) = Equivalence (\a b -> p a b == EQ) diff --git a/stdlib/lib/Data/EuclideanRing.purs b/stdlib/lib/Data/EuclideanRing.purs deleted file mode 100644 index b2ddbfaa..00000000 --- a/stdlib/lib/Data/EuclideanRing.purs +++ /dev/null @@ -1,100 +0,0 @@ -module Data.EuclideanRing - ( class EuclideanRing - , degree - , div - , mod - , (/) - , gcd - , lcm - , module Data.CommutativeRing - , module Data.Ring - , module Data.Semiring - ) where - -import Data.BooleanAlgebra ((||)) -import Data.CommutativeRing (class CommutativeRing) -import Data.Eq (class Eq, (==)) -import Data.Ring (class Ring, sub, (-)) -import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) - --- | The `EuclideanRing` class is for commutative rings that support division. --- | The mathematical structure this class is based on is sometimes also called --- | a *Euclidean domain*. --- | --- | Instances must satisfy the following laws in addition to the `Ring` --- | laws: --- | --- | - Integral domain: `one /= zero`, and if `a` and `b` are both nonzero then --- | so is their product `a * b` --- | - Euclidean function `degree`: --- | - Nonnegativity: For all nonzero `a`, `degree a >= 0` --- | - Quotient/remainder: For all `a` and `b`, where `b` is nonzero, --- | let `q = a / b` and ``r = a `mod` b``; then `a = q*b + r`, and also --- | either `r = zero` or `degree r < degree b` --- | - Submultiplicative euclidean function: --- | - For all nonzero `a` and `b`, `degree a <= degree (a * b)` --- | --- | The behaviour of division by `zero` is unconstrained by these laws, --- | meaning that individual instances are free to choose how to behave in this --- | case. Similarly, there are no restrictions on what the result of --- | `degree zero` is; it doesn't make sense to ask for `degree zero` in the --- | same way that it doesn't make sense to divide by `zero`, so again, --- | individual instances may choose how to handle this case. --- | --- | For any `EuclideanRing` which is also a `Field`, one valid choice --- | for `degree` is simply `const 1`. In fact, unless there's a specific --- | reason not to, `Field` types should normally use this definition of --- | `degree`. --- | --- | The `EuclideanRing Int` instance is one of the most commonly used --- | `EuclideanRing` instances and deserves a little more discussion. In --- | particular, there are a few different sensible law-abiding implementations --- | to choose from, with slightly different behaviour in the presence of --- | negative dividends or divisors. The most common definitions are "truncating" --- | division, where the result of `a / b` is rounded towards 0, and "Knuthian" --- | or "flooring" division, where the result of `a / b` is rounded towards --- | negative infinity. A slightly less common, but arguably more useful, option --- | is "Euclidean" division, which is defined so as to ensure that ``a `mod` b`` --- | is always nonnegative. With Euclidean division, `a / b` rounds towards --- | negative infinity if the divisor is positive, and towards positive infinity --- | if the divisor is negative. Note that all three definitions are identical if --- | we restrict our attention to nonnegative dividends and divisors. --- | --- | In versions 1.x, 2.x, and 3.x of the Prelude, the `EuclideanRing Int` --- | instance used truncating division. As of 4.x, the `EuclideanRing Int` --- | instance uses Euclidean division. Additional functions `quot` and `rem` are --- | supplied if truncating division is desired. -class CommutativeRing a <= EuclideanRing a where - degree :: a -> Int - div :: a -> a -> a - mod :: a -> a -> a - -infixl 7 div as / - -instance euclideanRingInt :: EuclideanRing Int where - degree = intDegree - div = intDiv - mod = intMod - -instance euclideanRingNumber :: EuclideanRing Number where - degree _ = 1 - div = numDiv - mod _ _ = 0.0 - -foreign import intDegree :: Int -> Int -foreign import intDiv :: Int -> Int -> Int -foreign import intMod :: Int -> Int -> Int - -foreign import numDiv :: Number -> Number -> Number - --- | The *greatest common divisor* of two values. -gcd :: forall a. Eq a => EuclideanRing a => a -> a -> a -gcd a b = - if b == zero then a - else gcd b (a `mod` b) - --- | The *least common multiple* of two values. -lcm :: forall a. Eq a => EuclideanRing a => a -> a -> a -lcm a b = - if a == zero || b == zero then zero - else a * b / gcd a b diff --git a/stdlib/lib/Data/Exists.purs b/stdlib/lib/Data/Exists.purs deleted file mode 100644 index ada29d22..00000000 --- a/stdlib/lib/Data/Exists.purs +++ /dev/null @@ -1,57 +0,0 @@ -module Data.Exists where - -import Unsafe.Coerce (unsafeCoerce) - --- | This type constructor can be used to existentially quantify over a type. --- | --- | Specifically, the type `Exists f` is isomorphic to the existential type `exists a. f a`. --- | --- | Existential types can be encoded using universal types (`forall`) for endofunctors in more general --- | categories. The benefit of this library is that, by using the FFI, we can create an efficient --- | representation of the existential by simply hiding type information. --- | --- | For example, consider the type `exists s. Tuple s (s -> Tuple s a)` which represents infinite streams --- | of elements of type `a`. --- | --- | This type can be constructed by creating a type constructor `StreamF` as follows: --- | --- | ```purescript --- | data StreamF a s = StreamF s (s -> Tuple s a) --- | ``` --- | --- | We can then define the type of streams using `Exists`: --- | --- | ```purescript --- | type Stream a = Exists (StreamF a) --- | ``` -foreign import data Exists :: forall k. (k -> Type) -> Type - -type role Exists representational - --- | The `mkExists` function is used to introduce a value of type `Exists f`, by providing a value of --- | type `f a`, for some type `a` which will be hidden in the existentially-quantified type. --- | --- | For example, to create a value of type `Stream Number`, we might use `mkExists` as follows: --- | --- | ```purescript --- | nats :: Stream Number --- | nats = mkExists $ StreamF 0 (\n -> Tuple (n + 1) n) --- | ``` -mkExists :: forall f a. f a -> Exists f -mkExists = unsafeCoerce - --- | The `runExists` function is used to eliminate a value of type `Exists f`. The rank 2 type ensures --- | that the existentially-quantified type does not escape its scope. Since the function is required --- | to work for _any_ type `a`, it will work for the existentially-quantified type. --- | --- | For example, we can write a function to obtain the head of a stream by using `runExists` as follows: --- | --- | ```purescript --- | head :: forall a. Stream a -> a --- | head = runExists head' --- | where --- | head' :: forall s. StreamF a s -> a --- | head' (StreamF s f) = snd (f s) --- | ``` -runExists :: forall f r. (forall a. f a -> r) -> Exists f -> r -runExists = unsafeCoerce diff --git a/stdlib/lib/Data/Field.purs b/stdlib/lib/Data/Field.purs deleted file mode 100644 index 113b714d..00000000 --- a/stdlib/lib/Data/Field.purs +++ /dev/null @@ -1,41 +0,0 @@ -module Data.Field - ( class Field - , module Data.DivisionRing - , module Data.CommutativeRing - , module Data.EuclideanRing - , module Data.Ring - , module Data.Semiring - ) where - -import Data.DivisionRing (class DivisionRing, recip) -import Data.CommutativeRing (class CommutativeRing) -import Data.EuclideanRing (class EuclideanRing, degree, div, mod, (/), gcd, lcm) -import Data.Ring (class Ring, negate, sub) -import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) - --- | The `Field` class is for types that are (commutative) fields. --- | --- | Mathematically, a field is a ring which is commutative and in which every --- | nonzero element has a multiplicative inverse; these conditions correspond --- | to the `CommutativeRing` and `DivisionRing` classes in PureScript --- | respectively. However, the `Field` class has `EuclideanRing` and --- | `DivisionRing` as superclasses, which seems like a stronger requirement --- | (since `CommutativeRing` is a superclass of `EuclideanRing`). In fact, it --- | is not stronger, since any type which has law-abiding `CommutativeRing` --- | and `DivisionRing` instances permits exactly one law-abiding --- | `EuclideanRing` instance. We use a `EuclideanRing` superclass here in --- | order to ensure that a `Field` constraint on a function permits you to use --- | `div` on that type, since `div` is a member of `EuclideanRing`. --- | --- | This class has no laws or members of its own; it exists as a convenience, --- | so a single constraint can be used when field-like behaviour is expected. --- | --- | This module also defines a single `Field` instance for any type which has --- | both `EuclideanRing` and `DivisionRing` instances. Any other instance --- | would overlap with this instance, so no other `Field` instances should be --- | defined in libraries. Instead, simply define `EuclideanRing` and --- | `DivisionRing` instances, and this will permit your type to be used with a --- | `Field` constraint. -class (EuclideanRing a, DivisionRing a) <= Field a - -instance field :: (EuclideanRing a, DivisionRing a) => Field a diff --git a/stdlib/lib/Data/Filterable.purs b/stdlib/lib/Data/Filterable.purs deleted file mode 100644 index 860d213f..00000000 --- a/stdlib/lib/Data/Filterable.purs +++ /dev/null @@ -1,229 +0,0 @@ -module Data.Filterable - ( class Filterable - , partitionMap - , partition - , filterMap - , filter - , eitherBool - , partitionDefault - , partitionDefaultFilter - , partitionDefaultFilterMap - , partitionMapDefault - , maybeBool - , filterDefault - , filterDefaultPartition - , filterDefaultPartitionMap - , filterMapDefault - , cleared - , module Data.Compactable - ) where - -import Control.Bind ((=<<)) -import Control.Category ((<<<)) -import Data.Array (partition, mapMaybe, filter) as Array -import Data.Compactable (class Compactable, compact, separate) -import Data.Either (Either(..)) -import Data.Foldable (foldl, foldr) -import Data.Functor (class Functor, map) -import Data.HeytingAlgebra (not) -import Data.List (List(..), filter, mapMaybe) as List -import Data.Map (Map, empty, insert, alter, toUnfoldable) as Map -import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid, mempty) -import Data.Semigroup ((<>)) -import Data.Tuple (Tuple(..)) -import Prelude (const, class Ord) - --- | `Filterable` represents data structures which can be _partitioned_/_filtered_. --- | --- | - `partitionMap` - partition a data structure based on an either predicate. --- | - `partition` - partition a data structure based on boolean predicate. --- | - `filterMap` - map over a data structure and filter based on a maybe. --- | - `filter` - filter a data structure based on a boolean. --- | --- | Laws: --- | - Functor Relation: `filterMap identity ≡ compact` --- | - Functor Identity: `filterMap Just ≡ identity` --- | - Kleisli Composition: `filterMap (l <=< r) ≡ filterMap l <<< filterMap r` --- | --- | - `filter ≡ filterMap <<< maybeBool` --- | - `filterMap p ≡ filter (isJust <<< p)` --- | --- | - Functor Relation: `partitionMap identity ≡ separate` --- | - Functor Identity 1: `_.right <<< partitionMap Right ≡ identity` --- | - Functor Identity 2: `_.left <<< partitionMap Left ≡ identity` --- | --- | - `f <<< partition ≡ partitionMap <<< eitherBool` where `f = \{ no, yes } -> { left: no, right: yes }` --- | - `f <<< partitionMap p ≡ partition (isRight <<< p)` where `f = \{ left, right } -> { no: left, yes: right}` --- | --- | Default implementations are provided by the following functions: --- | --- | - `partitionDefault` --- | - `partitionDefaultFilter` --- | - `partitionDefaultFilterMap` --- | - `partitionMapDefault` --- | - `filterDefault` --- | - `filterDefaultPartition` --- | - `filterDefaultPartitionMap` --- | - `filterMapDefault` -class (Compactable f, Functor f) <= Filterable f where - partitionMap :: forall a l r. - (a -> Either l r) -> f a -> { left :: f l, right :: f r } - - partition :: forall a. - (a -> Boolean) -> f a -> { no :: f a, yes :: f a } - - filterMap :: forall a b. - (a -> Maybe b) -> f a -> f b - - filter :: forall a. - (a -> Boolean) -> f a -> f a - --- | Upgrade a boolean-style predicate to an either-style predicate mapping. -eitherBool :: forall a. - (a -> Boolean) -> a -> Either a a -eitherBool p x = if p x then Right x else Left x - --- | Upgrade a boolean-style predicate to a maybe-style predicate mapping. -maybeBool :: forall a. - (a -> Boolean) -> a -> Maybe a -maybeBool p x = if p x then Just x else Nothing - --- | A default implementation of `partitionMap` using `separate`. Note that this is --- | almost certainly going to be suboptimal compared to direct implementations. -partitionMapDefault :: forall f a l r. Filterable f => - (a -> Either l r) -> f a -> { left :: f l, right :: f r } -partitionMapDefault p = separate <<< map p - --- | A default implementation of `partition` using `partitionMap`. -partitionDefault :: forall f a. Filterable f => - (a -> Boolean) -> f a -> { no :: f a, yes :: f a } -partitionDefault p xs = - let o = partitionMap (eitherBool p) xs - in {no: o.left, yes: o.right} - --- | A default implementation of `partition` using `filter`. Note that this is --- | almost certainly going to be suboptimal compared to direct implementations. -partitionDefaultFilter :: forall f a. Filterable f => - (a -> Boolean) -> f a -> { no :: f a, yes :: f a } -partitionDefaultFilter p xs = { yes: filter p xs, no: filter (not p) xs } - --- | A default implementation of `filterMap` using `separate`. Note that this is --- | almost certainly going to be suboptimal compared to direct implementations. -filterMapDefault :: forall f a b. Filterable f => - (a -> Maybe b) -> f a -> f b -filterMapDefault p = compact <<< map p - --- | A default implementation of `partition` using `filterMap`. Note that this --- | is almost certainly going to be suboptimal compared to direct --- | implementations. -partitionDefaultFilterMap :: forall f a. Filterable f => - (a -> Boolean) -> f a -> { no :: f a, yes :: f a } -partitionDefaultFilterMap p xs = - { yes: filterMap (maybeBool p) xs - , no: filterMap (maybeBool (not p)) xs - } - --- | A default implementation of `filter` using `filterMap`. -filterDefault :: forall f a. Filterable f => - (a -> Boolean) -> f a -> f a -filterDefault = filterMap <<< maybeBool - --- | A default implementation of `filter` using `partition`. -filterDefaultPartition :: forall f a. Filterable f => - (a -> Boolean) -> f a -> f a -filterDefaultPartition p xs = (partition p xs).yes - --- | A default implementation of `filter` using `partitionMap`. -filterDefaultPartitionMap :: forall f a. Filterable f => - (a -> Boolean) -> f a -> f a -filterDefaultPartitionMap p xs = (partitionMap (eitherBool p) xs).right - --- | Filter out all values. -cleared :: forall f a b. Filterable f => - f a -> f b -cleared = filterMap (const Nothing) - -instance filterableArray :: Filterable Array where - partitionMap p = foldl go {left: [], right: []} where - go acc x = case p x of - Left l -> acc { left = acc.left <> [l] } - Right r -> acc { right = acc.right <> [r] } - - partition = Array.partition - - filterMap = Array.mapMaybe - - filter = Array.filter - -instance filterableMaybe :: Filterable Maybe where - partitionMap _ Nothing = { left: Nothing, right: Nothing } - partitionMap p (Just x) = case p x of - Left a -> { left: Just a, right: Nothing } - Right b -> { left: Nothing, right: Just b } - - partition p = partitionDefault p - - filterMap = (=<<) - - filter p = filterDefault p - -instance filterableEither :: Monoid m => Filterable (Either m) where - partitionMap _ (Left x) = { left: Left x, right: Left x } - partitionMap p (Right x) = case p x of - Left a -> { left: Right a, right: Left mempty } - Right b -> { left: Left mempty, right: Right b } - - partition p = partitionDefault p - - filterMap _ (Left l) = Left l - filterMap p (Right r) = case p r of - Nothing -> Left mempty - Just x -> Right x - - filter p = filterDefault p - -instance filterableList :: Filterable List.List where - -- partitionMap :: forall a l r. (a -> Either l r) -> List a -> { left :: List l, right :: List r } - partitionMap p xs = foldr select { left: List.Nil, right: List.Nil } xs - where - select x { left, right } = case p x of - Left l -> { left: List.Cons l left, right } - Right r -> { left, right: List.Cons r right } - - -- partition :: forall a. (a -> Boolean) -> List a -> { no :: List a, yes :: List a } - partition p xs = foldr select { no: List.Nil, yes: List.Nil } xs - where - -- select :: (a -> Boolean) -> a -> { no :: List a, yes :: List a } -> { no :: List a, yes :: List a } - select x { no, yes } = if p x - then { no, yes: List.Cons x yes } - else { no: List.Cons x no, yes } - - -- filterMap :: forall a b. (a -> Maybe b) -> List a -> List b - filterMap p = List.mapMaybe p - - -- filter :: forall a. (a -> Boolean) -> List a -> List a - filter = List.filter - -instance filterableMap :: Ord k => Filterable (Map.Map k) where - partitionMap p xs = - foldr select { left: Map.empty, right: Map.empty } (toList xs) - where - toList :: forall v. Map.Map k v -> List.List (Tuple k v) - toList = Map.toUnfoldable - - select (Tuple k x) { left, right } = case p x of - Left l -> { left: Map.insert k l left, right } - Right r -> { left, right: Map.insert k r right } - - partition p = partitionDefault p - - filterMap p xs = - foldr select Map.empty (toList xs) - where - toList :: forall v. Map.Map k v -> List.List (Tuple k v) - toList = Map.toUnfoldable - - select (Tuple k x) m = Map.alter (const (p x)) k m - - filter p = filterDefault p diff --git a/stdlib/lib/Data/Foldable.purs b/stdlib/lib/Data/Foldable.purs deleted file mode 100644 index cf160adb..00000000 --- a/stdlib/lib/Data/Foldable.purs +++ /dev/null @@ -1,471 +0,0 @@ -module Data.Foldable - ( class Foldable, foldr, foldl, foldMap - , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR - , fold - , foldM - , traverse_ - , for_ - , sequence_ - , oneOf - , oneOfMap - , intercalate - , surroundMap - , surround - , and - , or - , all - , any - , sum - , product - , elem - , notElem - , indexl - , indexr - , find - , findMap - , maximum - , maximumBy - , minimum - , minimumBy - , null - , length - , lookup - ) where - -import Prelude - -import Control.Plus (class Plus, alt, empty) -import Data.Const (Const) -import Data.Either (Either(..)) -import Data.Functor.App (App(..)) -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Coproduct (Coproduct, coproduct) -import Data.Functor.Product (Product(..)) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) -import Data.Maybe.First (First(..)) -import Data.Maybe.Last (Last(..)) -import Data.Monoid.Additive (Additive(..)) -import Data.Monoid.Conj (Conj(..)) -import Data.Monoid.Disj (Disj(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Endo (Endo(..)) -import Data.Monoid.Multiplicative (Multiplicative(..)) -import Data.Newtype (alaF, unwrap) -import Data.Tuple (Tuple(..)) - --- | `Foldable` represents data structures which can be _folded_. --- | --- | - `foldr` folds a structure from the right --- | - `foldl` folds a structure from the left --- | - `foldMap` folds a structure by accumulating values in a `Monoid` --- | --- | Default implementations are provided by the following functions: --- | --- | - `foldrDefault` --- | - `foldlDefault` --- | - `foldMapDefaultR` --- | - `foldMapDefaultL` --- | --- | Note: some combinations of the default implementations are unsafe to --- | use together - causing a non-terminating mutually recursive cycle. --- | These combinations are documented per function. -class Foldable f where - foldr :: forall a b. (a -> b -> b) -> b -> f a -> b - foldl :: forall a b. (b -> a -> b) -> b -> f a -> b - foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m - --- | A default implementation of `foldr` using `foldMap`. --- | --- | Note: when defining a `Foldable` instance, this function is unsafe to use --- | in combination with `foldMapDefaultR`. -foldrDefault - :: forall f a b - . Foldable f - => (a -> b -> b) - -> b - -> f a - -> b -foldrDefault c u xs = unwrap (foldMap (Endo <<< c) xs) u - --- | A default implementation of `foldl` using `foldMap`. --- | --- | Note: when defining a `Foldable` instance, this function is unsafe to use --- | in combination with `foldMapDefaultL`. -foldlDefault - :: forall f a b - . Foldable f - => (b -> a -> b) - -> b - -> f a - -> b -foldlDefault c u xs = unwrap (unwrap (foldMap (Dual <<< Endo <<< flip c) xs)) u - --- | A default implementation of `foldMap` using `foldr`. --- | --- | Note: when defining a `Foldable` instance, this function is unsafe to use --- | in combination with `foldrDefault`. -foldMapDefaultR - :: forall f a m - . Foldable f - => Monoid m - => (a -> m) - -> f a - -> m -foldMapDefaultR f = foldr (\x acc -> f x <> acc) mempty - --- | A default implementation of `foldMap` using `foldl`. --- | --- | Note: when defining a `Foldable` instance, this function is unsafe to use --- | in combination with `foldlDefault`. -foldMapDefaultL - :: forall f a m - . Foldable f - => Monoid m - => (a -> m) - -> f a - -> m -foldMapDefaultL f = foldl (\acc x -> acc <> f x) mempty - -instance foldableArray :: Foldable Array where - foldr = foldrArray - foldl = foldlArray - foldMap = foldMapDefaultR - -foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b -foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b - -instance foldableMaybe :: Foldable Maybe where - foldr _ z Nothing = z - foldr f z (Just x) = x `f` z - foldl _ z Nothing = z - foldl f z (Just x) = z `f` x - foldMap _ Nothing = mempty - foldMap f (Just x) = f x - -instance foldableFirst :: Foldable First where - foldr f z (First x) = foldr f z x - foldl f z (First x) = foldl f z x - foldMap f (First x) = foldMap f x - -instance foldableLast :: Foldable Last where - foldr f z (Last x) = foldr f z x - foldl f z (Last x) = foldl f z x - foldMap f (Last x) = foldMap f x - -instance foldableAdditive :: Foldable Additive where - foldr f z (Additive x) = x `f` z - foldl f z (Additive x) = z `f` x - foldMap f (Additive x) = f x - -instance foldableDual :: Foldable Dual where - foldr f z (Dual x) = x `f` z - foldl f z (Dual x) = z `f` x - foldMap f (Dual x) = f x - -instance foldableDisj :: Foldable Disj where - foldr f z (Disj x) = f x z - foldl f z (Disj x) = f z x - foldMap f (Disj x) = f x - -instance foldableConj :: Foldable Conj where - foldr f z (Conj x) = f x z - foldl f z (Conj x) = f z x - foldMap f (Conj x) = f x - -instance foldableMultiplicative :: Foldable Multiplicative where - foldr f z (Multiplicative x) = x `f` z - foldl f z (Multiplicative x) = z `f` x - foldMap f (Multiplicative x) = f x - -instance foldableEither :: Foldable (Either a) where - foldr _ z (Left _) = z - foldr f z (Right x) = f x z - foldl _ z (Left _) = z - foldl f z (Right x) = f z x - foldMap _ (Left _) = mempty - foldMap f (Right x) = f x - -instance foldableTuple :: Foldable (Tuple a) where - foldr f z (Tuple _ x) = f x z - foldl f z (Tuple _ x) = f z x - foldMap f (Tuple _ x) = f x - -instance foldableIdentity :: Foldable Identity where - foldr f z (Identity x) = f x z - foldl f z (Identity x) = f z x - foldMap f (Identity x) = f x - -instance foldableConst :: Foldable (Const a) where - foldr _ z _ = z - foldl _ z _ = z - foldMap _ _ = mempty - -instance foldableProduct :: (Foldable f, Foldable g) => Foldable (Product f g) where - foldr f z (Product (Tuple fa ga)) = foldr f (foldr f z ga) fa - foldl f z (Product (Tuple fa ga)) = foldl f (foldl f z fa) ga - foldMap f (Product (Tuple fa ga)) = foldMap f fa <> foldMap f ga - -instance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f g) where - foldr f z = coproduct (foldr f z) (foldr f z) - foldl f z = coproduct (foldl f z) (foldl f z) - foldMap f = coproduct (foldMap f) (foldMap f) - -instance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) where - foldr f i (Compose fga) = foldr (flip (foldr f)) i fga - foldl f i (Compose fga) = foldl (foldl f) i fga - foldMap f (Compose fga) = foldMap (foldMap f) fga - -instance foldableApp :: Foldable f => Foldable (App f) where - foldr f i (App x) = foldr f i x - foldl f i (App x) = foldl f i x - foldMap f (App x) = foldMap f x - --- | Fold a data structure, accumulating values in some `Monoid`. -fold :: forall f m. Foldable f => Monoid m => f m -> m -fold = foldMap identity - --- | Similar to 'foldl', but the result is encapsulated in a monad. --- | --- | Note: this function is not generally stack-safe, e.g., for monads which --- | build up thunks a la `Eff`. -foldM :: forall f m a b. Foldable f => Monad m => (b -> a -> m b) -> b -> f a -> m b -foldM f b0 = foldl (\b a -> b >>= flip f a) (pure b0) - --- | Traverse a data structure, performing some effects encoded by an --- | `Applicative` functor at each value, ignoring the final result. --- | --- | For example: --- | --- | ```purescript --- | traverse_ print [1, 2, 3] --- | ``` -traverse_ - :: forall a b f m - . Applicative m - => Foldable f - => (a -> m b) - -> f a - -> m Unit -traverse_ f = foldr ((*>) <<< f) (pure unit) - --- | A version of `traverse_` with its arguments flipped. --- | --- | This can be useful when running an action written using do notation --- | for every element in a data structure: --- | --- | For example: --- | --- | ```purescript --- | for_ [1, 2, 3] \n -> do --- | print n --- | trace "squared is" --- | print (n * n) --- | ``` -for_ - :: forall a b f m - . Applicative m - => Foldable f - => f a - -> (a -> m b) - -> m Unit -for_ = flip traverse_ - --- | Perform all of the effects in some data structure in the order --- | given by the `Foldable` instance, ignoring the final result. --- | --- | For example: --- | --- | ```purescript --- | sequence_ [ trace "Hello, ", trace " world!" ] --- | ``` -sequence_ :: forall a f m. Applicative m => Foldable f => f (m a) -> m Unit -sequence_ = traverse_ identity - --- | Combines a collection of elements using the `Alt` operation. -oneOf :: forall f g a. Foldable f => Plus g => f (g a) -> g a -oneOf = foldr alt empty - --- | Folds a structure into some `Plus`. -oneOfMap :: forall f g a b. Foldable f => Plus g => (a -> g b) -> f a -> g b -oneOfMap f = foldr (alt <<< f) empty - --- | Fold a data structure, accumulating values in some `Monoid`, --- | combining adjacent elements using the specified separator. --- | --- | For example: --- | --- | ```purescript --- | > intercalate ", " ["Lorem", "ipsum", "dolor"] --- | = "Lorem, ipsum, dolor" --- | --- | > intercalate "*" ["a", "b", "c"] --- | = "a*b*c" --- | --- | > intercalate [1] [[2, 3], [4, 5], [6, 7]] --- | = [2, 3, 1, 4, 5, 1, 6, 7] --- | ``` -intercalate :: forall f m. Foldable f => Monoid m => m -> f m -> m -intercalate sep xs = (foldl go { init: true, acc: mempty } xs).acc - where - go { init: true } x = { init: false, acc: x } - go { acc: acc } x = { init: false, acc: acc <> sep <> x } - --- | `foldMap` but with each element surrounded by some fixed value. --- | --- | For example: --- | --- | ```purescript --- | > surroundMap "*" show [] --- | = "*" --- | --- | > surroundMap "*" show [1] --- | = "*1*" --- | --- | > surroundMap "*" show [1, 2] --- | = "*1*2*" --- | --- | > surroundMap "*" show [1, 2, 3] --- | = "*1*2*3*" --- | ``` -surroundMap :: forall f a m. Foldable f => Semigroup m => m -> (a -> m) -> f a -> m -surroundMap d t f = unwrap (foldMap joined f) d - where joined a = Endo \m -> d <> t a <> m - --- | `fold` but with each element surrounded by some fixed value. --- | --- | For example: --- | --- | ```purescript --- | > surround "*" [] --- | = "*" --- | --- | > surround "*" ["1"] --- | = "*1*" --- | --- | > surround "*" ["1", "2"] --- | = "*1*2*" --- | --- | > surround "*" ["1", "2", "3"] --- | = "*1*2*3*" --- | ``` -surround :: forall f m. Foldable f => Semigroup m => m -> f m -> m -surround d = surroundMap d identity - --- | The conjunction of all the values in a data structure. When specialized --- | to `Boolean`, this function will test whether all of the values in a data --- | structure are `true`. -and :: forall a f. Foldable f => HeytingAlgebra a => f a -> a -and = all identity - --- | The disjunction of all the values in a data structure. When specialized --- | to `Boolean`, this function will test whether any of the values in a data --- | structure is `true`. -or :: forall a f. Foldable f => HeytingAlgebra a => f a -> a -or = any identity - --- | `all f` is the same as `and <<< map f`; map a function over the structure, --- | and then get the conjunction of the results. -all :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b -all = alaF Conj foldMap - --- | `any f` is the same as `or <<< map f`; map a function over the structure, --- | and then get the disjunction of the results. -any :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b -any = alaF Disj foldMap - --- | Find the sum of the numeric values in a data structure. -sum :: forall a f. Foldable f => Semiring a => f a -> a -sum = foldl (+) zero - --- | Find the product of the numeric values in a data structure. -product :: forall a f. Foldable f => Semiring a => f a -> a -product = foldl (*) one - --- | Test whether a value is an element of a data structure. -elem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean -elem = any <<< (==) - --- | Test whether a value is not an element of a data structure. -notElem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean -notElem x = not <<< elem x - --- | Try to get nth element from the left in a data structure -indexl :: forall a f. Foldable f => Int -> f a -> Maybe a -indexl idx = _.elem <<< foldl go { elem: Nothing, pos: 0 } - where - go cursor a = - case cursor.elem of - Just _ -> cursor - _ -> - if cursor.pos == idx - then { elem: Just a, pos: cursor.pos } - else { pos: cursor.pos + 1, elem: cursor.elem } - --- | Try to get nth element from the right in a data structure -indexr :: forall a f. Foldable f => Int -> f a -> Maybe a -indexr idx = _.elem <<< foldr go { elem: Nothing, pos: 0 } - where - go a cursor = - case cursor.elem of - Just _ -> cursor - _ -> - if cursor.pos == idx - then { elem: Just a, pos: cursor.pos } - else { pos: cursor.pos + 1, elem: cursor.elem } - --- | Try to find an element in a data structure which satisfies a predicate. -find :: forall a f. Foldable f => (a -> Boolean) -> f a -> Maybe a -find p = foldl go Nothing - where - go Nothing x | p x = Just x - go r _ = r - --- | Try to find an element in a data structure which satisfies a predicate mapping. -findMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b -findMap p = foldl go Nothing - where - go Nothing x = p x - go r _ = r - --- | Find the largest element of a structure, according to its `Ord` instance. -maximum :: forall a f. Ord a => Foldable f => f a -> Maybe a -maximum = maximumBy compare - --- | Find the largest element of a structure, according to a given comparison --- | function. The comparison function should represent a total ordering (see --- | the `Ord` type class laws); if it does not, the behaviour is undefined. -maximumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a -maximumBy cmp = foldl max' Nothing - where - max' Nothing x = Just x - max' (Just x) y = Just (if cmp x y == GT then x else y) - --- | Find the smallest element of a structure, according to its `Ord` instance. -minimum :: forall a f. Ord a => Foldable f => f a -> Maybe a -minimum = minimumBy compare - --- | Find the smallest element of a structure, according to a given comparison --- | function. The comparison function should represent a total ordering (see --- | the `Ord` type class laws); if it does not, the behaviour is undefined. -minimumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a -minimumBy cmp = foldl min' Nothing - where - min' Nothing x = Just x - min' (Just x) y = Just (if cmp x y == LT then x else y) - --- | Test whether the structure is empty. --- | Optimized for structures that are similar to cons-lists, because there --- | is no general way to do better. -null :: forall a f. Foldable f => f a -> Boolean -null = foldr (\_ _ -> false) true - --- | Returns the size/length of a finite structure. --- | Optimized for structures that are similar to cons-lists, because there --- | is no general way to do better. -length :: forall a b f. Foldable f => Semiring b => f a -> b -length = foldl (\c _ -> add one c) zero - --- | Lookup a value in a data structure of `Tuple`s, generalizing association lists. -lookup :: forall a b f. Foldable f => Eq a => a -> f (Tuple a b) -> Maybe b -lookup a = unwrap <<< foldMap \(Tuple a' b) -> First (if a == a' then Just b else Nothing) diff --git a/stdlib/lib/Data/FoldableWithIndex.purs b/stdlib/lib/Data/FoldableWithIndex.purs deleted file mode 100644 index 258fe1e7..00000000 --- a/stdlib/lib/Data/FoldableWithIndex.purs +++ /dev/null @@ -1,370 +0,0 @@ -module Data.FoldableWithIndex - ( class FoldableWithIndex, foldrWithIndex, foldlWithIndex, foldMapWithIndex - , foldrWithIndexDefault - , foldlWithIndexDefault - , foldMapWithIndexDefaultR - , foldMapWithIndexDefaultL - , foldWithIndexM - , traverseWithIndex_ - , forWithIndex_ - , surroundMapWithIndex - , allWithIndex - , anyWithIndex - , findWithIndex - , findMapWithIndex - , foldrDefault - , foldlDefault - , foldMapDefault - ) where - -import Prelude - -import Data.Const (Const) -import Data.Either (Either(..)) -import Data.Foldable (class Foldable, foldMap, foldl, foldr) -import Data.Functor.App (App(..)) -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Coproduct (Coproduct, coproduct) -import Data.Functor.Product (Product(..)) -import Data.FunctorWithIndex (mapWithIndex) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) -import Data.Maybe.First (First) -import Data.Maybe.Last (Last) -import Data.Monoid.Additive (Additive) -import Data.Monoid.Conj (Conj(..)) -import Data.Monoid.Disj (Disj(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Endo (Endo(..)) -import Data.Monoid.Multiplicative (Multiplicative) -import Data.Newtype (unwrap) -import Data.Tuple (Tuple(..), curry) - --- | A `Foldable` with an additional index. --- | A `FoldableWithIndex` instance must be compatible with its `Foldable` --- | instance --- | ```purescript --- | foldr f = foldrWithIndex (const f) --- | foldl f = foldlWithIndex (const f) --- | foldMap f = foldMapWithIndex (const f) --- | ``` --- | --- | Default implementations are provided by the following functions: --- | --- | - `foldrWithIndexDefault` --- | - `foldlWithIndexDefault` --- | - `foldMapWithIndexDefaultR` --- | - `foldMapWithIndexDefaultL` --- | --- | Note: some combinations of the default implementations are unsafe to --- | use together - causing a non-terminating mutually recursive cycle. --- | These combinations are documented per function. -class Foldable f <= FoldableWithIndex i f | f -> i where - foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b - foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b - foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m - --- | A default implementation of `foldrWithIndex` using `foldMapWithIndex`. --- | --- | Note: when defining a `FoldableWithIndex` instance, this function is --- | unsafe to use in combination with `foldMapWithIndexDefaultR`. -foldrWithIndexDefault - :: forall i f a b - . FoldableWithIndex i f - => (i -> a -> b -> b) - -> b - -> f a - -> b -foldrWithIndexDefault c u xs = unwrap (foldMapWithIndex (\i -> Endo <<< c i) xs) u - --- | A default implementation of `foldlWithIndex` using `foldMapWithIndex`. --- | --- | Note: when defining a `FoldableWithIndex` instance, this function is --- | unsafe to use in combination with `foldMapWithIndexDefaultL`. -foldlWithIndexDefault - :: forall i f a b - . FoldableWithIndex i f - => (i -> b -> a -> b) - -> b - -> f a - -> b -foldlWithIndexDefault c u xs = unwrap (unwrap (foldMapWithIndex (\i -> Dual <<< Endo <<< flip (c i)) xs)) u - --- | A default implementation of `foldMapWithIndex` using `foldrWithIndex`. --- | --- | Note: when defining a `FoldableWithIndex` instance, this function is --- | unsafe to use in combination with `foldrWithIndexDefault`. -foldMapWithIndexDefaultR - :: forall i f a m - . FoldableWithIndex i f - => Monoid m - => (i -> a -> m) - -> f a - -> m -foldMapWithIndexDefaultR f = foldrWithIndex (\i x acc -> f i x <> acc) mempty - --- | A default implementation of `foldMapWithIndex` using `foldlWithIndex`. --- | --- | Note: when defining a `FoldableWithIndex` instance, this function is --- | unsafe to use in combination with `foldlWithIndexDefault`. -foldMapWithIndexDefaultL - :: forall i f a m - . FoldableWithIndex i f - => Monoid m - => (i -> a -> m) - -> f a - -> m -foldMapWithIndexDefaultL f = foldlWithIndex (\i acc x -> acc <> f i x) mempty - -instance foldableWithIndexArray :: FoldableWithIndex Int Array where - foldrWithIndex f z = foldr (\(Tuple i x) y -> f i x y) z <<< mapWithIndex Tuple - foldlWithIndex f z = foldl (\y (Tuple i x) -> f i y x) z <<< mapWithIndex Tuple - foldMapWithIndex = foldMapWithIndexDefaultR - -instance foldableWithIndexMaybe :: FoldableWithIndex Unit Maybe where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexFirst :: FoldableWithIndex Unit First where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexLast :: FoldableWithIndex Unit Last where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexAdditive :: FoldableWithIndex Unit Additive where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexDual :: FoldableWithIndex Unit Dual where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexDisj :: FoldableWithIndex Unit Disj where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexConj :: FoldableWithIndex Unit Conj where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexMultiplicative :: FoldableWithIndex Unit Multiplicative where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldableWithIndexEither :: FoldableWithIndex Unit (Either a) where - foldrWithIndex _ z (Left _) = z - foldrWithIndex f z (Right x) = f unit x z - foldlWithIndex _ z (Left _) = z - foldlWithIndex f z (Right x) = f unit z x - foldMapWithIndex _ (Left _) = mempty - foldMapWithIndex f (Right x) = f unit x - -instance foldableWithIndexTuple :: FoldableWithIndex Unit (Tuple a) where - foldrWithIndex f z (Tuple _ x) = f unit x z - foldlWithIndex f z (Tuple _ x) = f unit z x - foldMapWithIndex f (Tuple _ x) = f unit x - -instance foldableWithIndexIdentity :: FoldableWithIndex Unit Identity where - foldrWithIndex f z (Identity x) = f unit x z - foldlWithIndex f z (Identity x) = f unit z x - foldMapWithIndex f (Identity x) = f unit x - -instance foldableWithIndexConst :: FoldableWithIndex Void (Const a) where - foldrWithIndex _ z _ = z - foldlWithIndex _ z _ = z - foldMapWithIndex _ _ = mempty - -instance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where - foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa - foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga - foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga - -instance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where - foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z) - foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z) - foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right)) - -instance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where - foldrWithIndex f i (Compose fga) = foldrWithIndex (\a -> flip (foldrWithIndex (curry f a))) i fga - foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga - foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga - -instance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f) where - foldrWithIndex f z (App x) = foldrWithIndex f z x - foldlWithIndex f z (App x) = foldlWithIndex f z x - foldMapWithIndex f (App x) = foldMapWithIndex f x - - --- | Similar to 'foldlWithIndex', but the result is encapsulated in a monad. --- | --- | Note: this function is not generally stack-safe, e.g., for monads which --- | build up thunks a la `Eff`. -foldWithIndexM - :: forall i f m a b - . FoldableWithIndex i f - => Monad m - => (i -> a -> b -> m a) - -> a - -> f b - -> m a -foldWithIndexM f a0 = foldlWithIndex (\i ma b -> ma >>= flip (f i) b) (pure a0) - --- | Traverse a data structure with access to the index, performing some --- | effects encoded by an `Applicative` functor at each value, ignoring the --- | final result. --- | --- | For example: --- | --- | ```purescript --- | > traverseWithIndex_ (curry logShow) ["a", "b", "c"] --- | (Tuple 0 "a") --- | (Tuple 1 "b") --- | (Tuple 2 "c") --- | ``` -traverseWithIndex_ - :: forall i a b f m - . Applicative m - => FoldableWithIndex i f - => (i -> a -> m b) - -> f a - -> m Unit -traverseWithIndex_ f = foldrWithIndex (\i -> (*>) <<< f i) (pure unit) - --- | A version of `traverseWithIndex_` with its arguments flipped. --- | --- | This can be useful when running an action written using do notation --- | for every element in a data structure: --- | --- | For example: --- | --- | ```purescript --- | forWithIndex_ ["a", "b", "c"] \i x -> do --- | logShow i --- | log x --- | ``` -forWithIndex_ - :: forall i a b f m - . Applicative m - => FoldableWithIndex i f - => f a - -> (i -> a -> m b) - -> m Unit -forWithIndex_ = flip traverseWithIndex_ - --- | `foldMapWithIndex` but with each element surrounded by some fixed value. --- | --- | For example: --- | --- | ```purescript --- | > surroundMapWithIndex "*" (\i x -> show i <> x) [] --- | = "*" --- | --- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a"] --- | = "*0a*" --- | --- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b"] --- | = "*0a*1b*" --- | --- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b", "c"] --- | = "*0a*1b*2c*" --- | ``` -surroundMapWithIndex - :: forall i f a m - . FoldableWithIndex i f - => Semigroup m - => m - -> (i -> a -> m) - -> f a - -> m -surroundMapWithIndex d t f = unwrap (foldMapWithIndex joined f) d - where joined i a = Endo \m -> d <> t i a <> m - --- | `allWithIndex f` is the same as `and <<< mapWithIndex f`; map a function over the --- | structure, and then get the conjunction of the results. -allWithIndex - :: forall i a b f - . FoldableWithIndex i f - => HeytingAlgebra b - => (i -> a -> b) - -> f a - -> b -allWithIndex t = unwrap <<< foldMapWithIndex (\i -> Conj <<< t i) - --- | `anyWithIndex f` is the same as `or <<< mapWithIndex f`; map a function over the --- | structure, and then get the disjunction of the results. -anyWithIndex - :: forall i a b f - . FoldableWithIndex i f - => HeytingAlgebra b - => (i -> a -> b) - -> f a - -> b -anyWithIndex t = unwrap <<< foldMapWithIndex (\i -> Disj <<< t i) - --- | Try to find an element in a data structure which satisfies a predicate --- | with access to the index. -findWithIndex - :: forall i a f - . FoldableWithIndex i f - => (i -> a -> Boolean) - -> f a - -> Maybe { index :: i, value :: a } -findWithIndex p = foldlWithIndex go Nothing - where - go - :: i - -> Maybe { index :: i, value :: a } - -> a - -> Maybe { index :: i, value :: a } - go i Nothing x | p i x = Just { index: i, value: x } - go _ r _ = r - --- | Try to find an element in a data structure which satisfies a predicate mapping --- | with access to the index. -findMapWithIndex - :: forall i a b f - . FoldableWithIndex i f - => (i -> a -> Maybe b) - -> f a - -> Maybe b -findMapWithIndex f = foldlWithIndex go Nothing - where - go - :: i - -> Maybe b - -> a - -> Maybe b - go i Nothing x = f i x - go _ r _ = r - --- | A default implementation of `foldr` using `foldrWithIndex` -foldrDefault - :: forall i f a b - . FoldableWithIndex i f - => (a -> b -> b) -> b -> f a -> b -foldrDefault f = foldrWithIndex (const f) - --- | A default implementation of `foldl` using `foldlWithIndex` -foldlDefault - :: forall i f a b - . FoldableWithIndex i f - => (b -> a -> b) -> b -> f a -> b -foldlDefault f = foldlWithIndex (const f) - --- | A default implementation of `foldMap` using `foldMapWithIndex` -foldMapDefault - :: forall i f a m - . FoldableWithIndex i f - => Monoid m - => (a -> m) -> f a -> m -foldMapDefault f = foldMapWithIndex (const f) diff --git a/stdlib/lib/Data/Function.purs b/stdlib/lib/Data/Function.purs deleted file mode 100644 index 37ff740c..00000000 --- a/stdlib/lib/Data/Function.purs +++ /dev/null @@ -1,120 +0,0 @@ -module Data.Function - ( flip - , const - , apply - , ($) - , applyFlipped - , (#) - , applyN - , on - , module Control.Category - ) where - -import Control.Category (identity, compose, (<<<), (>>>)) -import Data.Boolean (otherwise) -import Data.Ord ((<=)) -import Data.Ring ((-)) - --- | Given a function that takes two arguments, applies the arguments --- | to the function in a swapped order. --- | --- | ```purescript --- | flip append "1" "2" == append "2" "1" == "21" --- | --- | const 1 "two" == 1 --- | --- | flip const 1 "two" == const "two" 1 == "two" --- | ``` -flip :: forall a b c. (a -> b -> c) -> b -> a -> c -flip f b a = f a b - --- | Returns its first argument and ignores its second. --- | --- | ```purescript --- | const 1 "hello" = 1 --- | ``` --- | --- | It can also be thought of as creating a function that ignores its argument: --- | --- | ```purescript --- | const 1 = \_ -> 1 --- | ``` -const :: forall a b. a -> b -> a -const a _ = a - --- | Applies a function to an argument. This is primarily used as the operator --- | `($)` which allows parentheses to be omitted in some cases, or as a --- | natural way to apply a chain of composed functions to a value. -apply :: forall a b. (a -> b) -> a -> b -apply f x = f x - --- | Applies a function to an argument: the reverse of `(#)`. --- | --- | ```purescript --- | length $ groupBy productCategory $ filter isInStock $ products --- | ``` --- | --- | is equivalent to: --- | --- | ```purescript --- | length (groupBy productCategory (filter isInStock products)) --- | ``` --- | --- | Or another alternative equivalent, applying chain of composed functions to --- | a value: --- | --- | ```purescript --- | length <<< groupBy productCategory <<< filter isInStock $ products --- | ``` -infixr 0 apply as $ - --- | Applies an argument to a function. This is primarily used as the `(#)` --- | operator, which allows parentheses to be omitted in some cases, or as a --- | natural way to apply a value to a chain of composed functions. -applyFlipped :: forall a b. a -> (a -> b) -> b -applyFlipped x f = f x - --- | Applies an argument to a function: the reverse of `($)`. --- | --- | ```purescript --- | products # filter isInStock # groupBy productCategory # length --- | ``` --- | --- | is equivalent to: --- | --- | ```purescript --- | length (groupBy productCategory (filter isInStock products)) --- | ``` --- | --- | Or another alternative equivalent, applying a value to a chain of composed --- | functions: --- | --- | ```purescript --- | products # filter isInStock >>> groupBy productCategory >>> length --- | ``` -infixl 1 applyFlipped as # - --- | `applyN f n` applies the function `f` to its argument `n` times. --- | --- | If n is less than or equal to 0, the function is not applied. --- | --- | ```purescript --- | applyN (_ + 1) 10 0 == 10 --- | ``` -applyN :: forall a. (a -> a) -> Int -> a -> a -applyN f = go - where - go n acc - | n <= 0 = acc - | otherwise = go (n - 1) (f acc) - --- | The `on` function is used to change the domain of a binary operator. --- | --- | For example, we can create a function which compares two records based on the values of their `x` properties: --- | --- | ```purescript --- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering --- | compareX = compare `on` _.x --- | ``` -on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c -on f g x y = g x `f` g y diff --git a/stdlib/lib/Data/Function/Uncurried.purs b/stdlib/lib/Data/Function/Uncurried.purs deleted file mode 100644 index a5553703..00000000 --- a/stdlib/lib/Data/Function/Uncurried.purs +++ /dev/null @@ -1,124 +0,0 @@ -module Data.Function.Uncurried where - -import Data.Unit (Unit) - --- | A function of zero arguments -foreign import data Fn0 :: Type -> Type - -type role Fn0 representational - --- | A function of one argument -type Fn1 a b = a -> b - --- | A function of two arguments -foreign import data Fn2 :: Type -> Type -> Type -> Type - -type role Fn2 representational representational representational - --- | A function of three arguments -foreign import data Fn3 :: Type -> Type -> Type -> Type -> Type - -type role Fn3 representational representational representational representational - --- | A function of four arguments -foreign import data Fn4 :: Type -> Type -> Type -> Type -> Type -> Type - -type role Fn4 representational representational representational representational representational - --- | A function of five arguments -foreign import data Fn5 :: Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role Fn5 representational representational representational representational representational representational - --- | A function of six arguments -foreign import data Fn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role Fn6 representational representational representational representational representational representational representational - --- | A function of seven arguments -foreign import data Fn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role Fn7 representational representational representational representational representational representational representational representational - --- | A function of eight arguments -foreign import data Fn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role Fn8 representational representational representational representational representational representational representational representational representational - --- | A function of nine arguments -foreign import data Fn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role Fn9 representational representational representational representational representational representational representational representational representational representational - --- | A function of ten arguments -foreign import data Fn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role Fn10 representational representational representational representational representational representational representational representational representational representational representational - --- | Create a function of no arguments -foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a - --- | Create a function of one argument -mkFn1 :: forall a b. (a -> b) -> Fn1 a b -mkFn1 f = f - --- | Create a function of two arguments from a curried function -foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c - --- | Create a function of three arguments from a curried function -foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d - --- | Create a function of four arguments from a curried function -foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e - --- | Create a function of five arguments from a curried function -foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f - --- | Create a function of six arguments from a curried function -foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g - --- | Create a function of seven arguments from a curried function -foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h - --- | Create a function of eight arguments from a curried function -foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i - --- | Create a function of nine arguments from a curried function -foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j - --- | Create a function of ten arguments from a curried function -foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k - --- | Apply a function of no arguments -foreign import runFn0 :: forall a. Fn0 a -> a - --- | Apply a function of one argument -runFn1 :: forall a b. Fn1 a b -> a -> b -runFn1 f = f - --- | Apply a function of two arguments -foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c - --- | Apply a function of three arguments -foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d - --- | Apply a function of four arguments -foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e - --- | Apply a function of five arguments -foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f - --- | Apply a function of six arguments -foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g - --- | Apply a function of seven arguments -foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h - --- | Apply a function of eight arguments -foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i - --- | Apply a function of nine arguments -foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j - --- | Apply a function of ten arguments -foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k diff --git a/stdlib/lib/Data/Functor.purs b/stdlib/lib/Data/Functor.purs deleted file mode 100644 index fb97ea8d..00000000 --- a/stdlib/lib/Data/Functor.purs +++ /dev/null @@ -1,106 +0,0 @@ -module Data.Functor - ( class Functor - , map - , (<$>) - , mapFlipped - , (<#>) - , void - , voidRight - , (<$) - , voidLeft - , ($>) - , flap - , (<@>) - ) where - -import Data.Function (const, compose) -import Data.Unit (Unit, unit) -import Type.Proxy (Proxy(..)) - --- | A `Functor` is a type constructor which supports a mapping operation --- | `map`. --- | --- | `map` can be used to turn functions `a -> b` into functions --- | `f a -> f b` whose argument and return types use the type constructor `f` --- | to represent some computational context. --- | --- | Instances must satisfy the following laws: --- | --- | - Identity: `map identity = identity` --- | - Composition: `map (f <<< g) = map f <<< map g` -class Functor f where - map :: forall a b. (a -> b) -> f a -> f b - -infixl 4 map as <$> - --- | `mapFlipped` is `map` with its arguments reversed. For example: --- | --- | ```purescript --- | [1, 2, 3] <#> \n -> n * n --- | ``` -mapFlipped :: forall f a b. Functor f => f a -> (a -> b) -> f b -mapFlipped fa f = f <$> fa - -infixl 1 mapFlipped as <#> - -instance functorFn :: Functor ((->) r) where - map = compose - -instance functorArray :: Functor Array where - map = arrayMap - -instance functorProxy :: Functor Proxy where - map _ _ = Proxy - -foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b - --- | The `void` function is used to ignore the type wrapped by a --- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type --- | information provided by the type constructor itself. --- | --- | `void` is often useful when using `do` notation to change the return type --- | of a monadic computation: --- | --- | ```purescript --- | main = forE 1 10 \n -> void do --- | print n --- | print (n * n) --- | ``` -void :: forall f a. Functor f => f a -> f Unit -void = map (const unit) - --- | Ignore the return value of a computation, using the specified return value --- | instead. -voidRight :: forall f a b. Functor f => a -> f b -> f a -voidRight x = map (const x) - -infixl 4 voidRight as <$ - --- | A version of `voidRight` with its arguments flipped. -voidLeft :: forall f a b. Functor f => f a -> b -> f b -voidLeft f x = const x <$> f - -infixl 4 voidLeft as $> - --- | Apply a value in a computational context to a value in no context. --- | --- | Generalizes `flip`. --- | --- | ```purescript --- | longEnough :: String -> Bool --- | hasSymbol :: String -> Bool --- | hasDigit :: String -> Bool --- | password :: String --- | --- | validate :: String -> Array Bool --- | validate = flap [longEnough, hasSymbol, hasDigit] --- | ``` --- | --- | ```purescript --- | flap (-) 3 4 == 1 --- | threeve <$> Just 1 <@> 'a' <*> Just true == Just (threeve 1 'a' true) --- | ``` -flap :: forall f a b. Functor f => f (a -> b) -> a -> f b -flap ff x = map (\f -> f x) ff - -infixl 4 flap as <@> diff --git a/stdlib/lib/Data/Functor/App.purs b/stdlib/lib/Data/Functor/App.purs deleted file mode 100644 index 05b12079..00000000 --- a/stdlib/lib/Data/Functor/App.purs +++ /dev/null @@ -1,56 +0,0 @@ -module Data.Functor.App where - -import Prelude - -import Control.Alt (class Alt) -import Control.Alternative (class Alternative) -import Control.Apply (lift2) -import Control.Comonad (class Comonad) -import Control.Extend (class Extend) -import Control.Lazy (class Lazy) -import Control.MonadPlus (class MonadPlus) -import Control.Plus (class Plus) -import Data.Eq (class Eq1) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) -import Unsafe.Coerce (unsafeCoerce) - -newtype App :: forall k. (k -> Type) -> k -> Type -newtype App f a = App (f a) - -hoistApp :: forall f g. (f ~> g) -> App f ~> App g -hoistApp f (App fa) = App (f fa) - -hoistLiftApp :: forall f g a. f (g a) -> f (App g a) -hoistLiftApp = unsafeCoerce -- safe as newtypes have no runtime representation - -hoistLowerApp :: forall f g a. f (App g a) -> f (g a) -hoistLowerApp = unsafeCoerce -- safe as newtypes have no runtime representation - -derive instance newtypeApp :: Newtype (App f a) _ -derive instance eqApp :: (Eq1 f, Eq a) => Eq (App f a) -derive instance eq1App :: Eq1 f => Eq1 (App f) -derive instance ordApp :: (Ord1 f, Ord a) => Ord (App f a) -derive instance ord1App :: Ord1 f => Ord1 (App f) - -instance showApp :: Show (f a) => Show (App f a) where - show (App fa) = "(App " <> show fa <> ")" - -instance semigroupApp :: (Apply f, Semigroup a) => Semigroup (App f a) where - append (App fa1) (App fa2) = App (lift2 append fa1 fa2) - -instance monoidApp :: (Applicative f, Monoid a) => Monoid (App f a) where - mempty = App (pure mempty) - -derive newtype instance functorApp :: Functor f => Functor (App f) -derive newtype instance applyApp :: Apply f => Apply (App f) -derive newtype instance applicativeApp :: Applicative f => Applicative (App f) -derive newtype instance bindApp :: Bind f => Bind (App f) -derive newtype instance monadApp :: Monad f => Monad (App f) -derive newtype instance altApp :: Alt f => Alt (App f) -derive newtype instance plusApp :: Plus f => Plus (App f) -derive newtype instance alternativeApp :: Alternative f => Alternative (App f) -derive newtype instance monadPlusApp :: MonadPlus f => MonadPlus (App f) -derive newtype instance lazyApp :: Lazy (f a) => Lazy (App f a) -derive newtype instance extendApp :: Extend f => Extend (App f) -derive newtype instance comonadApp :: Comonad f => Comonad (App f) diff --git a/stdlib/lib/Data/Functor/Clown.purs b/stdlib/lib/Data/Functor/Clown.purs deleted file mode 100644 index 7924ed76..00000000 --- a/stdlib/lib/Data/Functor/Clown.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Functor.Clown where - -import Prelude - -import Control.Biapplicative (class Biapplicative) -import Control.Biapply (class Biapply) -import Data.Bifunctor (class Bifunctor) -import Data.Functor.Contravariant (class Contravariant, cmap) -import Data.Newtype (class Newtype) -import Data.Profunctor (class Profunctor) - --- | This advanced type's usage and its relation to `Joker` is best understood --- | by reading through "Clowns to the Left, Jokers to the Right (Functional --- | Pearl)" --- | https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.475.6134&rep=rep1&type=pdf -newtype Clown :: (Type -> Type) -> Type -> Type -> Type -newtype Clown f a b = Clown (f a) - -derive instance newtypeClown :: Newtype (Clown f a b) _ - -derive newtype instance eqClown :: Eq (f a) => Eq (Clown f a b) - -derive newtype instance ordClown :: Ord (f a) => Ord (Clown f a b) - -instance showClown :: Show (f a) => Show (Clown f a b) where - show (Clown x) = "(Clown " <> show x <> ")" - -instance functorClown :: Functor (Clown f a) where - map _ (Clown a) = Clown a - -instance bifunctorClown :: Functor f => Bifunctor (Clown f) where - bimap f _ (Clown a) = Clown (map f a) - -instance biapplyClown :: Apply f => Biapply (Clown f) where - biapply (Clown fg) (Clown xy) = Clown (fg <*> xy) - -instance biapplicativeClown :: Applicative f => Biapplicative (Clown f) where - bipure a _ = Clown (pure a) - -instance profunctorClown :: Contravariant f => Profunctor (Clown f) where - dimap f _ (Clown a) = Clown (cmap f a) - -hoistClown :: forall f g a b. (f ~> g) -> Clown f a b -> Clown g a b -hoistClown f (Clown a) = Clown (f a) diff --git a/stdlib/lib/Data/Functor/Compose.purs b/stdlib/lib/Data/Functor/Compose.purs deleted file mode 100644 index 7c8b68f8..00000000 --- a/stdlib/lib/Data/Functor/Compose.purs +++ /dev/null @@ -1,58 +0,0 @@ -module Data.Functor.Compose where - -import Prelude - -import Control.Alt (class Alt, alt) -import Control.Alternative (class Alternative) -import Control.Plus (class Plus, empty) -import Data.Eq (class Eq1, eq1) -import Data.Functor.App (hoistLiftApp) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1, compare1) - --- | `Compose f g` is the composition of the two functors `f` and `g`. -newtype Compose :: forall k1 k2. (k2 -> Type) -> (k1 -> k2) -> k1 -> Type -newtype Compose f g a = Compose (f (g a)) - -bihoistCompose - :: forall f g h i - . Functor f - => (f ~> h) - -> (g ~> i) - -> Compose f g - ~> Compose h i -bihoistCompose natF natG (Compose fga) = Compose (natF (map natG fga)) - -derive instance newtypeCompose :: Newtype (Compose f g a) _ - -instance eqCompose :: (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where - eq (Compose fga1) (Compose fga2) = - eq1 (hoistLiftApp fga1) (hoistLiftApp fga2) - -derive instance eq1Compose :: (Eq1 f, Eq1 g) => Eq1 (Compose f g) - -instance ordCompose :: (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where - compare (Compose fga1) (Compose fga2) = - compare1 (hoistLiftApp fga1) (hoistLiftApp fga2) - -derive instance ord1Compose :: (Ord1 f, Ord1 g) => Ord1 (Compose f g) - -instance showCompose :: Show (f (g a)) => Show (Compose f g a) where - show (Compose fga) = "(Compose " <> show fga <> ")" - -instance functorCompose :: (Functor f, Functor g) => Functor (Compose f g) where - map f (Compose fga) = Compose $ map f <$> fga - -instance applyCompose :: (Apply f, Apply g) => Apply (Compose f g) where - apply (Compose f) (Compose x) = Compose $ apply <$> f <*> x - -instance applicativeCompose :: (Applicative f, Applicative g) => Applicative (Compose f g) where - pure = Compose <<< pure <<< pure - -instance altCompose :: (Alt f, Functor g) => Alt (Compose f g) where - alt (Compose a) (Compose b) = Compose $ alt a b - -instance plusCompose :: (Plus f, Functor g) => Plus (Compose f g) where - empty = Compose empty - -instance alternativeCompose :: (Alternative f, Applicative g) => Alternative (Compose f g) diff --git a/stdlib/lib/Data/Functor/Contravariant.purs b/stdlib/lib/Data/Functor/Contravariant.purs deleted file mode 100644 index b2a7ec65..00000000 --- a/stdlib/lib/Data/Functor/Contravariant.purs +++ /dev/null @@ -1,35 +0,0 @@ -module Data.Functor.Contravariant where - -import Prelude - -import Data.Const (Const(..)) - --- | A `Contravariant` functor can be seen as a way of changing the input type --- | of a consumer of input, in contrast to the standard covariant `Functor` --- | that can be seen as a way of changing the output type of a producer of --- | output. --- | --- | `Contravariant` instances should satisfy the following laws: --- | --- | - Identity `cmap id = id` --- | - Composition `cmap f <<< cmap g = cmap (g <<< f)` -class Contravariant f where - cmap :: forall a b. (b -> a) -> f a -> f b - -infixl 4 cmap as >$< - --- | `cmapFlipped` is `cmap` with its arguments reversed. -cmapFlipped :: forall a b f. Contravariant f => f a -> (b -> a) -> f b -cmapFlipped x f = f >$< x - -infixl 4 cmapFlipped as >#< - -coerce :: forall f a b. Contravariant f => Functor f => f a -> f b -coerce a = absurd <$> (absurd >$< a) - --- | As all `Contravariant` functors are also trivially `Invariant`, this function can be used as the `imap` implementation for any types that have an existing `Contravariant` instance. -imapC :: forall f a b. Contravariant f => (a -> b) -> (b -> a) -> f a -> f b -imapC _ f = cmap f - -instance contravariantConst :: Contravariant (Const a) where - cmap _ (Const x) = Const x diff --git a/stdlib/lib/Data/Functor/Coproduct.purs b/stdlib/lib/Data/Functor/Coproduct.purs deleted file mode 100644 index ceac080f..00000000 --- a/stdlib/lib/Data/Functor/Coproduct.purs +++ /dev/null @@ -1,76 +0,0 @@ -module Data.Functor.Coproduct where - -import Prelude - -import Control.Comonad (class Comonad, extract) -import Control.Extend (class Extend, extend) -import Data.Bifunctor (bimap) -import Data.Either (Either(..)) -import Data.Eq (class Eq1, eq1) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1, compare1) - --- | `Coproduct f g` is the coproduct of two functors `f` and `g` -newtype Coproduct :: forall k. (k -> Type) -> (k -> Type) -> k -> Type -newtype Coproduct f g a = Coproduct (Either (f a) (g a)) - --- | Left injection -left :: forall f g a. f a -> Coproduct f g a -left fa = Coproduct (Left fa) - --- | Right injection -right :: forall f g a. g a -> Coproduct f g a -right ga = Coproduct (Right ga) - --- | Eliminate a coproduct by providing eliminators for the left and --- | right components -coproduct :: forall f g a b. (f a -> b) -> (g a -> b) -> Coproduct f g a -> b -coproduct f _ (Coproduct (Left a)) = f a -coproduct _ g (Coproduct (Right b)) = g b - --- | Change the underlying functors in a coproduct -bihoistCoproduct - :: forall f g h i - . (f ~> h) - -> (g ~> i) - -> Coproduct f g - ~> Coproduct h i -bihoistCoproduct natF natG (Coproduct e) = Coproduct (bimap natF natG e) - -derive instance newtypeCoproduct :: Newtype (Coproduct f g a) _ - -instance eqCoproduct :: (Eq1 f, Eq1 g, Eq a) => Eq (Coproduct f g a) where - eq = eq1 - -instance eq1Coproduct :: (Eq1 f, Eq1 g) => Eq1 (Coproduct f g) where - eq1 (Coproduct x) (Coproduct y) = - case x, y of - Left fa, Left ga -> eq1 fa ga - Right fa, Right ga -> eq1 fa ga - _, _ -> false - -instance ordCoproduct :: (Ord1 f, Ord1 g, Ord a) => Ord (Coproduct f g a) where - compare = compare1 - -instance ord1Coproduct :: (Ord1 f, Ord1 g) => Ord1 (Coproduct f g) where - compare1 (Coproduct x) (Coproduct y) = - case x, y of - Left fa, Left ga -> compare1 fa ga - Left _, _ -> LT - _, Left _ -> GT - Right fa, Right ga -> compare1 fa ga - -instance showCoproduct :: (Show (f a), Show (g a)) => Show (Coproduct f g a) where - show (Coproduct (Left fa)) = "(left " <> show fa <> ")" - show (Coproduct (Right ga)) = "(right " <> show ga <> ")" - -instance functorCoproduct :: (Functor f, Functor g) => Functor (Coproduct f g) where - map f (Coproduct e) = Coproduct (bimap (map f) (map f) e) - -instance extendCoproduct :: (Extend f, Extend g) => Extend (Coproduct f g) where - extend f = Coproduct <<< coproduct - (Left <<< extend (f <<< Coproduct <<< Left)) - (Right <<< extend (f <<< Coproduct <<< Right)) - -instance comonadCoproduct :: (Comonad f, Comonad g) => Comonad (Coproduct f g) where - extract = coproduct extract extract diff --git a/stdlib/lib/Data/Functor/Coproduct/Inject.purs b/stdlib/lib/Data/Functor/Coproduct/Inject.purs deleted file mode 100644 index 6f8f136e..00000000 --- a/stdlib/lib/Data/Functor/Coproduct/Inject.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.Functor.Coproduct.Inject where - -import Prelude - -import Data.Either (Either(..)) -import Data.Functor.Coproduct (Coproduct(..), coproduct) -import Data.Maybe (Maybe(..)) - -class Inject :: forall k. (k -> Type) -> (k -> Type) -> Constraint -class Inject f g where - inj :: forall a. f a -> g a - prj :: forall a. g a -> Maybe (f a) - -instance injectReflexive :: Inject f f where - inj = identity - prj = Just - -else instance injectLeft :: Inject f (Coproduct f g) where - inj = Coproduct <<< Left - prj = coproduct Just (const Nothing) - -else instance injectRight :: Inject f g => Inject f (Coproduct h g) where - inj = Coproduct <<< Right <<< inj - prj = coproduct (const Nothing) prj diff --git a/stdlib/lib/Data/Functor/Coproduct/Nested.purs b/stdlib/lib/Data/Functor/Coproduct/Nested.purs deleted file mode 100644 index 9e37903e..00000000 --- a/stdlib/lib/Data/Functor/Coproduct/Nested.purs +++ /dev/null @@ -1,273 +0,0 @@ -module Data.Functor.Coproduct.Nested where - -import Prelude - -import Data.Const (Const) -import Data.Either (Either(..)) -import Data.Functor.Coproduct (Coproduct(..), coproduct, left, right) -import Data.Newtype (unwrap) - -type Coproduct1 :: forall k. (k -> Type) -> k -> Type -type Coproduct1 a = C2 a (Const Void) -type Coproduct2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct2 a b = C3 a b (Const Void) -type Coproduct3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct3 a b c = C4 a b c (Const Void) -type Coproduct4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct4 a b c d = C5 a b c d (Const Void) -type Coproduct5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct5 a b c d e = C6 a b c d e (Const Void) -type Coproduct6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct6 a b c d e f = C7 a b c d e f (Const Void) -type Coproduct7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct7 a b c d e f g = C8 a b c d e f g (Const Void) -type Coproduct8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct8 a b c d e f g h = C9 a b c d e f g h (Const Void) -type Coproduct9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct9 a b c d e f g h i = C10 a b c d e f g h i (Const Void) -type Coproduct10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Coproduct10 a b c d e f g h i j = C11 a b c d e f g h i j (Const Void) - -type C2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type -type C2 a z = Coproduct a z -type C3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C3 a b z = Coproduct a (C2 b z) -type C4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C4 a b c z = Coproduct a (C3 b c z) -type C5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C5 a b c d z = Coproduct a (C4 b c d z) -type C6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C6 a b c d e z = Coproduct a (C5 b c d e z) -type C7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C7 a b c d e f z = Coproduct a (C6 b c d e f z) -type C8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C8 a b c d e f g z = Coproduct a (C7 b c d e f g z) -type C9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C9 a b c d e f g h z = Coproduct a (C8 b c d e f g h z) -type C10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C10 a b c d e f g h i z = Coproduct a (C9 b c d e f g h i z) -type C11 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type C11 a b c d e f g h i j z = Coproduct a (C10 b c d e f g h i j z) - -infixr 6 coproduct as <\/> -infixr 6 type Coproduct as <\/> - -in1 :: forall a z. a ~> C2 a z -in1 = left - -in2 :: forall a b z. b ~> C3 a b z -in2 v = right (left v) - -in3 :: forall a b c z. c ~> C4 a b c z -in3 v = right (right (left v)) - -in4 :: forall a b c d z. d ~> C5 a b c d z -in4 v = right (right (right (left v))) - -in5 :: forall a b c d e z. e ~> C6 a b c d e z -in5 v = right (right (right (right (left v)))) - -in6 :: forall a b c d e f z. f ~> C7 a b c d e f z -in6 v = right (right (right (right (right (left v))))) - -in7 :: forall a b c d e f g z. g ~> C8 a b c d e f g z -in7 v = right (right (right (right (right (right (left v)))))) - -in8 :: forall a b c d e f g h z. h ~> C9 a b c d e f g h z -in8 v = right (right (right (right (right (right (right (left v))))))) - -in9 :: forall a b c d e f g h i z. i ~> C10 a b c d e f g h i z -in9 v = right (right (right (right (right (right (right (right (left v)))))))) - -in10 :: forall a b c d e f g h i j z. j ~> C11 a b c d e f g h i j z -in10 v = right (right (right (right (right (right (right (right (right (left v))))))))) - -at1 :: forall r x a z. r -> (a x -> r) -> C2 a z x -> r -at1 b f y = case y of - Coproduct (Left r) -> f r - _ -> b - -at2 :: forall r x a b z. r -> (b x -> r) -> C3 a b z x -> r -at2 b f y = case y of - Coproduct (Right (Coproduct (Left r))) -> f r - _ -> b - -at3 :: forall r x a b c z. r -> (c x -> r) -> C4 a b c z x -> r -at3 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Left r))))) -> f r - _ -> b - -at4 :: forall r x a b c d z. r -> (d x -> r) -> C5 a b c d z x -> r -at4 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))) -> f r - _ -> b - -at5 :: forall r x a b c d e z. r -> (e x -> r) -> C6 a b c d e z x -> r -at5 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))) -> f r - _ -> b - -at6 :: forall r x a b c d e f z. r -> (f x -> r) -> C7 a b c d e f z x -> r -at6 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))) -> f r - _ -> b - -at7 :: forall r x a b c d e f g z. r -> (g x -> r) -> C8 a b c d e f g z x -> r -at7 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))) -> f r - _ -> b - -at8 :: forall r x a b c d e f g h z. r -> (h x -> r) -> C9 a b c d e f g h z x -> r -at8 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))))) -> f r - _ -> b - -at9 :: forall r x a b c d e f g h i z. r -> (i x -> r) -> C10 a b c d e f g h i z x -> r -at9 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))))))) -> f r - _ -> b - -at10 :: forall r x a b c d e f g h i j z. r -> (j x -> r) -> C11 a b c d e f g h i j z x -> r -at10 b f y = case y of - Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Right (Coproduct (Left r))))))))))))))))))) -> f r - _ -> b - -coproduct1 :: forall a. Coproduct1 a ~> a -coproduct1 y = case y of - Coproduct (Left r) -> r - Coproduct (Right _1) -> absurd (unwrap _1) - -coproduct2 :: forall r x a b. (a x -> r) -> (b x -> r) -> Coproduct2 a b x -> r -coproduct2 a b y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> absurd (unwrap _2) - -coproduct3 :: forall r x a b c. (a x -> r) -> (b x -> r) -> (c x -> r) -> Coproduct3 a b c x -> r -coproduct3 a b c y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> absurd (unwrap _3) - -coproduct4 :: forall r x a b c d. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> Coproduct4 a b c d x -> r -coproduct4 a b c d y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> absurd (unwrap _4) - -coproduct5 :: forall r x a b c d e. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> Coproduct5 a b c d e x -> r -coproduct5 a b c d e y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> case _4 of - Coproduct (Left r) -> e r - Coproduct (Right _5) -> absurd (unwrap _5) - -coproduct6 :: forall r x a b c d e f. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> Coproduct6 a b c d e f x -> r -coproduct6 a b c d e f y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> case _4 of - Coproduct (Left r) -> e r - Coproduct (Right _5) -> case _5 of - Coproduct (Left r) -> f r - Coproduct (Right _6) -> absurd (unwrap _6) - -coproduct7 :: forall r x a b c d e f g. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> Coproduct7 a b c d e f g x -> r -coproduct7 a b c d e f g y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> case _4 of - Coproduct (Left r) -> e r - Coproduct (Right _5) -> case _5 of - Coproduct (Left r) -> f r - Coproduct (Right _6) -> case _6 of - Coproduct (Left r) -> g r - Coproduct (Right _7) -> absurd (unwrap _7) - -coproduct8 :: forall r x a b c d e f g h. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> (h x -> r) -> Coproduct8 a b c d e f g h x -> r -coproduct8 a b c d e f g h y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> case _4 of - Coproduct (Left r) -> e r - Coproduct (Right _5) -> case _5 of - Coproduct (Left r) -> f r - Coproduct (Right _6) -> case _6 of - Coproduct (Left r) -> g r - Coproduct (Right _7) -> case _7 of - Coproduct (Left r) -> h r - Coproduct (Right _8) -> absurd (unwrap _8) - -coproduct9 :: forall r x a b c d e f g h i. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> (h x -> r) -> (i x -> r) -> Coproduct9 a b c d e f g h i x -> r -coproduct9 a b c d e f g h i y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> case _4 of - Coproduct (Left r) -> e r - Coproduct (Right _5) -> case _5 of - Coproduct (Left r) -> f r - Coproduct (Right _6) -> case _6 of - Coproduct (Left r) -> g r - Coproduct (Right _7) -> case _7 of - Coproduct (Left r) -> h r - Coproduct (Right _8) -> case _8 of - Coproduct (Left r) -> i r - Coproduct (Right _9) -> absurd (unwrap _9) - -coproduct10 :: forall r x a b c d e f g h i j. (a x -> r) -> (b x -> r) -> (c x -> r) -> (d x -> r) -> (e x -> r) -> (f x -> r) -> (g x -> r) -> (h x -> r) -> (i x -> r) -> (j x -> r) -> Coproduct10 a b c d e f g h i j x -> r -coproduct10 a b c d e f g h i j y = case y of - Coproduct (Left r) -> a r - Coproduct (Right _1) -> case _1 of - Coproduct (Left r) -> b r - Coproduct (Right _2) -> case _2 of - Coproduct (Left r) -> c r - Coproduct (Right _3) -> case _3 of - Coproduct (Left r) -> d r - Coproduct (Right _4) -> case _4 of - Coproduct (Left r) -> e r - Coproduct (Right _5) -> case _5 of - Coproduct (Left r) -> f r - Coproduct (Right _6) -> case _6 of - Coproduct (Left r) -> g r - Coproduct (Right _7) -> case _7 of - Coproduct (Left r) -> h r - Coproduct (Right _8) -> case _8 of - Coproduct (Left r) -> i r - Coproduct (Right _9) -> case _9 of - Coproduct (Left r) -> j r - Coproduct (Right _10) -> absurd (unwrap _10) diff --git a/stdlib/lib/Data/Functor/Costar.purs b/stdlib/lib/Data/Functor/Costar.purs deleted file mode 100644 index edffe4e9..00000000 --- a/stdlib/lib/Data/Functor/Costar.purs +++ /dev/null @@ -1,66 +0,0 @@ -module Data.Functor.Costar where - -import Prelude - -import Control.Comonad (class Comonad, extract) -import Control.Extend (class Extend, (=<=)) -import Data.Bifunctor (class Bifunctor) -import Data.Distributive (class Distributive, distribute) -import Data.Functor.Contravariant (class Contravariant, cmap) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.Newtype (class Newtype) -import Data.Profunctor (class Profunctor, lcmap) -import Data.Profunctor.Closed (class Closed) -import Data.Profunctor.Strong (class Strong) -import Data.Tuple (Tuple(..), fst, snd) - --- | `Costar` turns a `Functor` into a `Profunctor` "backwards". --- | --- | `Costar f` is also the co-Kleisli category for `f`. -newtype Costar :: (Type -> Type) -> Type -> Type -> Type -newtype Costar f b a = Costar (f b -> a) - -derive instance newtypeCostar :: Newtype (Costar f a b) _ - -instance semigroupoidCostar :: Extend f => Semigroupoid (Costar f) where - compose (Costar f) (Costar g) = Costar (f =<= g) - -instance categoryCostar :: Comonad f => Category (Costar f) where - identity = Costar extract - -instance functorCostar :: Functor (Costar f a) where - map f (Costar g) = Costar (f <<< g) - -instance invariantCostar :: Invariant (Costar f a) where - imap = imapF - -instance applyCostar :: Apply (Costar f a) where - apply (Costar f) (Costar g) = Costar \a -> f a (g a) - -instance applicativeCostar :: Applicative (Costar f a) where - pure a = Costar \_ -> a - -instance bindCostar :: Bind (Costar f a) where - bind (Costar m) f = Costar \x -> case f (m x) of Costar g -> g x - -instance monadCostar :: Monad (Costar f a) - -instance distributiveCostar :: Distributive (Costar f a) where - distribute f = Costar \a -> map (\(Costar g) -> g a) f - collect f = distribute <<< map f - -instance bifunctorCostar :: Contravariant f => Bifunctor (Costar f) where - bimap f g (Costar h) = Costar (cmap f >>> h >>> g) - -instance profunctorCostar :: Functor f => Profunctor (Costar f) where - dimap f g (Costar h) = Costar (map f >>> h >>> g) - -instance strongCostar :: Comonad f => Strong (Costar f) where - first (Costar f) = Costar \x -> Tuple (f (map fst x)) (snd (extract x)) - second (Costar f) = Costar \x -> Tuple (fst (extract x)) (f (map snd x)) - -instance closedCostar :: Functor f => Closed (Costar f) where - closed (Costar f) = Costar \g x -> f (map (_ $ x) g) - -hoistCostar :: forall f g a b. (g ~> f) -> Costar f a b -> Costar g a b -hoistCostar f (Costar g) = Costar (lcmap f g) diff --git a/stdlib/lib/Data/Functor/Flip.purs b/stdlib/lib/Data/Functor/Flip.purs deleted file mode 100644 index baf98e14..00000000 --- a/stdlib/lib/Data/Functor/Flip.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Functor.Flip where - -import Prelude - -import Control.Biapplicative (class Biapplicative, bipure) -import Control.Biapply (class Biapply, (<<*>>)) -import Data.Bifunctor (class Bifunctor, bimap, lmap) -import Data.Functor.Contravariant (class Contravariant) -import Data.Newtype (class Newtype) -import Data.Profunctor (class Profunctor, lcmap) - --- | Flips the order of the type arguments of a `Bifunctor`. -newtype Flip :: forall k1 k2. (k1 -> k2 -> Type) -> k2 -> k1 -> Type -newtype Flip p a b = Flip (p b a) - -derive instance newtypeFlip :: Newtype (Flip p a b) _ - -derive newtype instance eqFlip :: Eq (p b a) => Eq (Flip p a b) - -derive newtype instance ordFlip :: Ord (p b a) => Ord (Flip p a b) - -instance showFlip :: Show (p a b) => Show (Flip p b a) where - show (Flip x) = "(Flip " <> show x <> ")" - -instance functorFlip :: Bifunctor p => Functor (Flip p a) where - map f (Flip a) = Flip (lmap f a) - -instance bifunctorFlip :: Bifunctor p => Bifunctor (Flip p) where - bimap f g (Flip a) = Flip (bimap g f a) - -instance biapplyFlip :: Biapply p => Biapply (Flip p) where - biapply (Flip fg) (Flip xy) = Flip (fg <<*>> xy) - -instance biapplicativeFlip :: Biapplicative p => Biapplicative (Flip p) where - bipure a b = Flip (bipure b a) - -instance contravariantFlip :: Profunctor p => Contravariant (Flip p b) where - cmap f (Flip a) = Flip (lcmap f a) - -instance semigroupoidFlip :: Semigroupoid p => Semigroupoid (Flip p) where - compose (Flip a) (Flip b) = Flip $ compose b a - -instance categoryFlip :: Category p => Category (Flip p) where - identity = Flip identity diff --git a/stdlib/lib/Data/Functor/Invariant.purs b/stdlib/lib/Data/Functor/Invariant.purs deleted file mode 100644 index d9756c6e..00000000 --- a/stdlib/lib/Data/Functor/Invariant.purs +++ /dev/null @@ -1,57 +0,0 @@ -module Data.Functor.Invariant where - -import Control.Semigroupoid ((<<<)) -import Data.Functor (class Functor, map) -import Data.Monoid.Additive (Additive(..)) -import Data.Monoid.Conj (Conj(..)) -import Data.Monoid.Disj (Disj(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Endo (Endo(..)) -import Data.Monoid.Multiplicative (Multiplicative(..)) -import Data.Monoid.Alternate (Alternate(..)) - --- | A type of functor that can be used to adapt the type of a wrapped function --- | where the parameterised type occurs in both the positive and negative --- | position, for example, `F (a -> a)`. --- | --- | An `Invariant` instance should satisfy the following laws: --- | --- | - Identity: `imap id id = id` --- | - Composition: `imap g1 g2 <<< imap f1 f2 = imap (g1 <<< f1) (f2 <<< g2)` --- | -class Invariant :: (Type -> Type) -> Constraint -class Invariant f where - imap :: forall a b. (a -> b) -> (b -> a) -> f a -> f b - -instance invariantFn :: Invariant ((->) a) where - imap = imapF - -instance invariantArray :: Invariant Array where - imap = imapF - -instance invariantAdditive :: Invariant Additive where - imap f _ (Additive x) = Additive (f x) - -instance invariantConj :: Invariant Conj where - imap f _ (Conj x) = Conj (f x) - -instance invariantDisj :: Invariant Disj where - imap f _ (Disj x) = Disj (f x) - -instance invariantDual :: Invariant Dual where - imap f _ (Dual x) = Dual (f x) - -instance invariantEndo :: Invariant (Endo Function) where - imap ab ba (Endo f) = Endo (ab <<< f <<< ba) - -instance invariantMultiplicative :: Invariant Multiplicative where - imap f _ (Multiplicative x) = Multiplicative (f x) - -instance invariantAlternate :: Invariant f => Invariant (Alternate f) where - imap f g (Alternate x) = Alternate (imap f g x) - --- | As all `Functor`s are also trivially `Invariant`, this function can be --- | used as the `imap` implementation for any types that has an existing --- | `Functor` instance. -imapF :: forall f a b. Functor f => (a -> b) -> (b -> a) -> f a -> f b -imapF f _ = map f diff --git a/stdlib/lib/Data/Functor/Joker.purs b/stdlib/lib/Data/Functor/Joker.purs deleted file mode 100644 index 97e43fbb..00000000 --- a/stdlib/lib/Data/Functor/Joker.purs +++ /dev/null @@ -1,60 +0,0 @@ -module Data.Functor.Joker where - -import Prelude - -import Control.Biapplicative (class Biapplicative) -import Control.Biapply (class Biapply) -import Data.Bifunctor (class Bifunctor) -import Data.Either (Either(..)) -import Data.Newtype (class Newtype, un) -import Data.Profunctor (class Profunctor) -import Data.Profunctor.Choice (class Choice) - --- | This advanced type's usage and its relation to `Clown` is best understood --- | by reading through "Clowns to the Left, Jokers to the Right (Functional --- | Pearl)" --- | https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.475.6134&rep=rep1&type=pdf -newtype Joker :: (Type -> Type) -> Type -> Type -> Type -newtype Joker g a b = Joker (g b) - -derive instance newtypeJoker :: Newtype (Joker f a b) _ - -derive newtype instance eqJoker :: Eq (f b) => Eq (Joker f a b) - -derive newtype instance ordJoker :: Ord (f b) => Ord (Joker f a b) - -instance showJoker :: Show (f b) => Show (Joker f a b) where - show (Joker x) = "(Joker " <> show x <> ")" - -instance functorJoker :: Functor f => Functor (Joker f a) where - map f (Joker a) = Joker (map f a) - -instance applyJoker :: Apply f => Apply (Joker f a) where - apply (Joker f) (Joker g) = Joker $ apply f g - -instance applicativeJoker :: Applicative f => Applicative (Joker f a) where - pure = Joker <<< pure - -instance bindJoker :: Bind f => Bind (Joker f a) where - bind (Joker ma) amb = Joker $ ma >>= (amb >>> un Joker) - -instance monadJoker :: Monad m => Monad (Joker m a) - -instance bifunctorJoker :: Functor g => Bifunctor (Joker g) where - bimap _ g (Joker a) = Joker (map g a) - -instance biapplyJoker :: Apply g => Biapply (Joker g) where - biapply (Joker fg) (Joker xy) = Joker (fg <*> xy) - -instance biapplicativeJoker :: Applicative g => Biapplicative (Joker g) where - bipure _ b = Joker (pure b) - -instance profunctorJoker :: Functor f => Profunctor (Joker f) where - dimap _ g (Joker a) = Joker (map g a) - -instance choiceJoker :: Functor f => Choice (Joker f) where - left (Joker f) = Joker $ map Left f - right (Joker f) = Joker $ map Right f - -hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b -hoistJoker f (Joker a) = Joker (f a) diff --git a/stdlib/lib/Data/Functor/Product.purs b/stdlib/lib/Data/Functor/Product.purs deleted file mode 100644 index 53ac8647..00000000 --- a/stdlib/lib/Data/Functor/Product.purs +++ /dev/null @@ -1,60 +0,0 @@ -module Data.Functor.Product where - -import Prelude - -import Data.Bifunctor (bimap) -import Data.Eq (class Eq1, eq1) -import Data.Newtype (class Newtype, unwrap) -import Data.Ord (class Ord1, compare1) -import Data.Tuple (Tuple(..), fst, snd) - --- | `Product f g` is the product of the two functors `f` and `g`. -newtype Product :: forall k. (k -> Type) -> (k -> Type) -> k -> Type -newtype Product f g a = Product (Tuple (f a) (g a)) - --- | Create a product. -product :: forall f g a. f a -> g a -> Product f g a -product fa ga = Product (Tuple fa ga) - -bihoistProduct - :: forall f g h i - . (f ~> h) - -> (g ~> i) - -> Product f g - ~> Product h i -bihoistProduct natF natG (Product e) = Product (bimap natF natG e) - -derive instance newtypeProduct :: Newtype (Product f g a) _ - -instance eqProduct :: (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) where - eq = eq1 - -instance eq1Product :: (Eq1 f, Eq1 g) => Eq1 (Product f g) where - eq1 (Product (Tuple l1 r1)) (Product (Tuple l2 r2)) = eq1 l1 l2 && eq1 r1 r2 - -instance ordProduct :: (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where - compare = compare1 - -instance ord1Product :: (Ord1 f, Ord1 g) => Ord1 (Product f g) where - compare1 (Product (Tuple l1 r1)) (Product (Tuple l2 r2)) = - case compare1 l1 l2 of - EQ -> compare1 r1 r2 - o -> o - -instance showProduct :: (Show (f a), Show (g a)) => Show (Product f g a) where - show (Product (Tuple fa ga)) = "(product " <> show fa <> " " <> show ga <> ")" - -instance functorProduct :: (Functor f, Functor g) => Functor (Product f g) where - map f (Product fga) = Product (bimap (map f) (map f) fga) - -instance applyProduct :: (Apply f, Apply g) => Apply (Product f g) where - apply (Product (Tuple f g)) (Product (Tuple a b)) = product (apply f a) (apply g b) - -instance applicativeProduct :: (Applicative f, Applicative g) => Applicative (Product f g) where - pure a = product (pure a) (pure a) - -instance bindProduct :: (Bind f, Bind g) => Bind (Product f g) where - bind (Product (Tuple fa ga)) f = - product (fa >>= fst <<< unwrap <<< f) (ga >>= snd <<< unwrap <<< f) - -instance monadProduct :: (Monad f, Monad g) => Monad (Product f g) diff --git a/stdlib/lib/Data/Functor/Product/Nested.purs b/stdlib/lib/Data/Functor/Product/Nested.purs deleted file mode 100644 index 8ec70a94..00000000 --- a/stdlib/lib/Data/Functor/Product/Nested.purs +++ /dev/null @@ -1,112 +0,0 @@ -module Data.Functor.Product.Nested where - -import Prelude - -import Data.Const (Const(..)) -import Data.Functor.Product (Product(..), product) -import Data.Tuple (Tuple(..)) - -type Product1 :: forall k. (k -> Type) -> k -> Type -type Product1 a = T2 a (Const Unit) -type Product2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type -type Product2 a b = T3 a b (Const Unit) -type Product3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product3 a b c = T4 a b c (Const Unit) -type Product4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product4 a b c d = T5 a b c d (Const Unit) -type Product5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product5 a b c d e= T6 a b c d e (Const Unit) -type Product6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product6 a b c d e f = T7 a b c d e f (Const Unit) -type Product7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product7 a b c d e f g = T8 a b c d e f g (Const Unit) -type Product8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product8 a b c d e f g h = T9 a b c d e f g h (Const Unit) -type Product9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product9 a b c d e f g h i = T10 a b c d e f g h i (Const Unit) -type Product10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type Product10 a b c d e f g h i j = T11 a b c d e f g h i j (Const Unit) - -type T2 :: forall k. (k -> Type) -> (k -> Type) -> k -> Type -type T2 a z = Product a z -type T3 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T3 a b z = Product a (T2 b z) -type T4 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T4 a b c z = Product a (T3 b c z) -type T5 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T5 a b c d z = Product a (T4 b c d z) -type T6 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T6 a b c d e z = Product a (T5 b c d e z) -type T7 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T7 a b c d e f z = Product a (T6 b c d e f z) -type T8 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T8 a b c d e f g z = Product a (T7 b c d e f g z) -type T9 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T9 a b c d e f g h z = Product a (T8 b c d e f g h z) -type T10 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T10 a b c d e f g h i z = Product a (T9 b c d e f g h i z) -type T11 :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> (k -> Type) -> k -> Type -type T11 a b c d e f g h i j z = Product a (T10 b c d e f g h i j z) - -infixr 6 product as -infixr 6 type Product as - -product1 :: forall a. a ~> Product1 a -product1 a = a Const unit - -product2 :: forall a b x. a x -> b x -> Product2 a b x -product2 a b = a b Const unit - -product3 :: forall a b c x. a x -> b x -> c x -> Product3 a b c x -product3 a b c = a b c Const unit - -product4 :: forall a b c d x. a x -> b x -> c x -> d x -> Product4 a b c d x -product4 a b c d = a b c d Const unit - -product5 :: forall a b c d e x. a x -> b x -> c x -> d x -> e x -> Product5 a b c d e x -product5 a b c d e = a b c d e Const unit - -product6 :: forall a b c d e f x. a x -> b x -> c x -> d x -> e x -> f x -> Product6 a b c d e f x -product6 a b c d e f = a b c d e f Const unit - -product7 :: forall a b c d e f g x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> Product7 a b c d e f g x -product7 a b c d e f g = a b c d e f g Const unit - -product8 :: forall a b c d e f g h x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> h x -> Product8 a b c d e f g h x -product8 a b c d e f g h = a b c d e f g h Const unit - -product9 :: forall a b c d e f g h i x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> h x -> i x -> Product9 a b c d e f g h i x -product9 a b c d e f g h i = a b c d e f g h i Const unit - -product10 :: forall a b c d e f g h i j x. a x -> b x -> c x -> d x -> e x -> f x -> g x -> h x -> i x -> j x -> Product10 a b c d e f g h i j x -product10 a b c d e f g h i j = a b c d e f g h i j Const unit - -get1 :: forall a z. T2 a z ~> a -get1 (Product (Tuple a _)) = a - -get2 :: forall a b z. T3 a b z ~> b -get2 (Product (Tuple _ (Product (Tuple b _)))) = b - -get3 :: forall a b c z. T4 a b c z ~> c -get3 (Product (Tuple _ (Product (Tuple _ (Product (Tuple c _)))))) = c - -get4 :: forall a b c d z. T5 a b c d z ~> d -get4 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple d _)))))))) = d - -get5 :: forall a b c d e z. T6 a b c d e z ~> e -get5 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple e _)))))))))) = e - -get6 :: forall a b c d e f z. T7 a b c d e f z ~> f -get6 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple f _)))))))))))) = f - -get7 :: forall a b c d e f g z. T8 a b c d e f g z ~> g -get7 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple g _)))))))))))))) = g - -get8 :: forall a b c d e f g h z. T9 a b c d e f g h z ~> h -get8 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple h _)))))))))))))))) = h - -get9 :: forall a b c d e f g h i z. T10 a b c d e f g h i z ~> i -get9 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple i _)))))))))))))))))) = i - -get10 :: forall a b c d e f g h i j z. T11 a b c d e f g h i j z ~> j -get10 (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple _ (Product (Tuple j _)))))))))))))))))))) = j diff --git a/stdlib/lib/Data/Functor/Product2.purs b/stdlib/lib/Data/Functor/Product2.purs deleted file mode 100644 index 5dc1fe97..00000000 --- a/stdlib/lib/Data/Functor/Product2.purs +++ /dev/null @@ -1,40 +0,0 @@ -module Data.Functor.Product2 where - -import Prelude - -import Control.Biapplicative (class Biapplicative, bipure) -import Control.Biapply (class Biapply, biapply) -import Data.Bifunctor (class Bifunctor, bimap) -import Data.Profunctor (class Profunctor, dimap) - --- | The product of two types that both take two type parameters (e.g. `Either`, --- | `Tuple, etc.) where both type parameters are the same. --- | --- | ```purescript --- | Product2 (Tuple 4 true) (Right false) :: Product2 Tuple Either Int Boolean --- | Product2 (Tuple 4 true) (Left 8) :: Product2 Tuple Either Int Boolean --- | ``` -data Product2 :: (Type -> Type -> Type) -> (Type -> Type -> Type) -> Type -> Type -> Type -data Product2 f g a b = Product2 (f a b) (g a b) - -derive instance eqProduct2 :: (Eq (f a b), Eq (g a b)) => Eq (Product2 f g a b) - -derive instance ordProduct2 :: (Ord (f a b), Ord (g a b)) => Ord (Product2 f g a b) - -instance showProduct2 :: (Show (f a b), Show (g a b)) => Show (Product2 f g a b) where - show (Product2 x y) = "(Product2 " <> show x <> " " <> show y <> ")" - -instance functorProduct2 :: (Functor (f a), Functor (g a)) => Functor (Product2 f g a) where - map f (Product2 x y) = Product2 (map f x) (map f y) - -instance bifunctorProduct2 :: (Bifunctor f, Bifunctor g) => Bifunctor (Product2 f g) where - bimap f g (Product2 x y) = Product2 (bimap f g x) (bimap f g y) - -instance biapplyProduct2 :: (Biapply f, Biapply g) => Biapply (Product2 f g) where - biapply (Product2 w x) (Product2 y z) = Product2 (biapply w y) (biapply x z) - -instance biapplicativeProduct2 :: (Biapplicative f, Biapplicative g) => Biapplicative (Product2 f g) where - bipure a b = Product2 (bipure a b) (bipure a b) - -instance profunctorProduct2 :: (Profunctor f, Profunctor g) => Profunctor (Product2 f g) where - dimap f g (Product2 x y) = Product2 (dimap f g x) (dimap f g y) diff --git a/stdlib/lib/Data/FunctorWithIndex.purs b/stdlib/lib/Data/FunctorWithIndex.purs deleted file mode 100644 index 9d9a48d0..00000000 --- a/stdlib/lib/Data/FunctorWithIndex.purs +++ /dev/null @@ -1,93 +0,0 @@ -module Data.FunctorWithIndex - ( class FunctorWithIndex, mapWithIndex, mapDefault - ) where - -import Prelude - -import Data.Bifunctor (bimap) -import Data.Const (Const(..)) -import Data.Either (Either(..)) -import Data.Functor.App (App(..)) -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Coproduct (Coproduct(..)) -import Data.Functor.Product (Product(..)) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe) -import Data.Maybe.First (First) -import Data.Maybe.Last (Last) -import Data.Monoid.Additive (Additive) -import Data.Monoid.Conj (Conj) -import Data.Monoid.Disj (Disj) -import Data.Monoid.Dual (Dual) -import Data.Monoid.Multiplicative (Multiplicative) -import Data.Tuple (Tuple, curry) - --- | A `Functor` with an additional index. --- | Instances must satisfy a modified form of the `Functor` laws --- | ```purescript --- | mapWithIndex (\_ a -> a) = identity --- | mapWithIndex f . mapWithIndex g = mapWithIndex (\i -> f i <<< g i) --- | ``` --- | and be compatible with the `Functor` instance --- | ```purescript --- | map f = mapWithIndex (const f) --- | ``` -class Functor f <= FunctorWithIndex i f | f -> i where - mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b - -foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b - -instance functorWithIndexArray :: FunctorWithIndex Int Array where - mapWithIndex = mapWithIndexArray - -instance functorWithIndexMaybe :: FunctorWithIndex Unit Maybe where - mapWithIndex f = map $ f unit - -instance functorWithIndexFirst :: FunctorWithIndex Unit First where - mapWithIndex f = map $ f unit - -instance functorWithIndexLast :: FunctorWithIndex Unit Last where - mapWithIndex f = map $ f unit - -instance functorWithIndexAdditive :: FunctorWithIndex Unit Additive where - mapWithIndex f = map $ f unit - -instance functorWithIndexDual :: FunctorWithIndex Unit Dual where - mapWithIndex f = map $ f unit - -instance functorWithIndexConj :: FunctorWithIndex Unit Conj where - mapWithIndex f = map $ f unit - -instance functorWithIndexDisj :: FunctorWithIndex Unit Disj where - mapWithIndex f = map $ f unit - -instance functorWithIndexMultiplicative :: FunctorWithIndex Unit Multiplicative where - mapWithIndex f = map $ f unit - -instance functorWithIndexEither :: FunctorWithIndex Unit (Either a) where - mapWithIndex f = map $ f unit - -instance functorWithIndexTuple :: FunctorWithIndex Unit (Tuple a) where - mapWithIndex f = map $ f unit - -instance functorWithIndexIdentity :: FunctorWithIndex Unit Identity where - mapWithIndex f (Identity a) = Identity (f unit a) - -instance functorWithIndexConst :: FunctorWithIndex Void (Const a) where - mapWithIndex _ (Const x) = Const x - -instance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where - mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga) - -instance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where - mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e) - -instance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where - mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga - -instance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f) where - mapWithIndex f (App x) = App $ mapWithIndex f x - --- | A default implementation of Functor's `map` in terms of `mapWithIndex` -mapDefault :: forall i f a b. FunctorWithIndex i f => (a -> b) -> f a -> f b -mapDefault f = mapWithIndex (const f) diff --git a/stdlib/lib/Data/Generic/Rep.purs b/stdlib/lib/Data/Generic/Rep.purs deleted file mode 100644 index c3de434a..00000000 --- a/stdlib/lib/Data/Generic/Rep.purs +++ /dev/null @@ -1,62 +0,0 @@ -module Data.Generic.Rep - ( class Generic - , to - , from - , repOf - , NoConstructors - , NoArguments(..) - , Sum(..) - , Product(..) - , Constructor(..) - , Argument(..) - ) where - -import Data.Semigroup ((<>)) -import Data.Show (class Show, show) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Void (Void) -import Type.Proxy (Proxy(..)) - --- | A representation for types with no constructors. -newtype NoConstructors = NoConstructors Void - --- | A representation for constructors with no arguments. -data NoArguments = NoArguments - -instance showNoArguments :: Show NoArguments where - show _ = "NoArguments" - --- | A representation for types with multiple constructors. -data Sum a b = Inl a | Inr b - -instance showSum :: (Show a, Show b) => Show (Sum a b) where - show (Inl a) = "(Inl " <> show a <> ")" - show (Inr b) = "(Inr " <> show b <> ")" - --- | A representation for constructors with multiple fields. -data Product a b = Product a b - -instance showProduct :: (Show a, Show b) => Show (Product a b) where - show (Product a b) = "(Product " <> show a <> " " <> show b <> ")" - --- | A representation for constructors which includes the data constructor name --- | as a type-level string. -newtype Constructor (name :: Symbol) a = Constructor a - -instance showConstructor :: (IsSymbol name, Show a) => Show (Constructor name a) where - show (Constructor a) = "(Constructor @" <> show (reflectSymbol (Proxy :: Proxy name)) <> " " <> show a <> ")" - --- | A representation for an argument in a data constructor. -newtype Argument a = Argument a - -instance showArgument :: Show a => Show (Argument a) where - show (Argument a) = "(Argument " <> show a <> ")" - --- | The `Generic` class asserts the existence of a type function from types --- | to their representations using the type constructors defined in this module. -class Generic a rep | a -> rep where - to :: rep -> a - from :: a -> rep - -repOf :: forall a rep. Generic a rep => Proxy a -> Proxy rep -repOf _ = Proxy diff --git a/stdlib/lib/Data/HeytingAlgebra.purs b/stdlib/lib/Data/HeytingAlgebra.purs deleted file mode 100644 index af402e09..00000000 --- a/stdlib/lib/Data/HeytingAlgebra.purs +++ /dev/null @@ -1,171 +0,0 @@ -module Data.HeytingAlgebra - ( class HeytingAlgebra - , tt - , ff - , implies - , conj - , disj - , not - , (&&) - , (||) - , class HeytingAlgebraRecord - , ffRecord - , ttRecord - , impliesRecord - , conjRecord - , disjRecord - , notRecord - ) where - -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit, unit) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeGet, unsafeSet) -import Type.Proxy (Proxy(..)) - --- | The `HeytingAlgebra` type class represents types that are bounded lattices with --- | an implication operator such that the following laws hold: --- | --- | - Associativity: --- | - `a || (b || c) = (a || b) || c` --- | - `a && (b && c) = (a && b) && c` --- | - Commutativity: --- | - `a || b = b || a` --- | - `a && b = b && a` --- | - Absorption: --- | - `a || (a && b) = a` --- | - `a && (a || b) = a` --- | - Idempotent: --- | - `a || a = a` --- | - `a && a = a` --- | - Identity: --- | - `a || ff = a` --- | - `a && tt = a` --- | - Implication: --- | - ``a `implies` a = tt`` --- | - ``a && (a `implies` b) = a && b`` --- | - ``b && (a `implies` b) = b`` --- | - ``a `implies` (b && c) = (a `implies` b) && (a `implies` c)`` --- | - Complemented: --- | - ``not a = a `implies` ff`` -class HeytingAlgebra a where - ff :: a - tt :: a - implies :: a -> a -> a - conj :: a -> a -> a - disj :: a -> a -> a - not :: a -> a - -infixr 3 conj as && -infixr 2 disj as || - -instance heytingAlgebraBoolean :: HeytingAlgebra Boolean where - ff = false - tt = true - implies a b = not a || b - conj = boolConj - disj = boolDisj - not = boolNot - -instance heytingAlgebraUnit :: HeytingAlgebra Unit where - ff = unit - tt = unit - implies _ _ = unit - conj _ _ = unit - disj _ _ = unit - not _ = unit - -instance heytingAlgebraFunction :: HeytingAlgebra b => HeytingAlgebra (a -> b) where - ff _ = ff - tt _ = tt - implies f g a = f a `implies` g a - conj f g a = f a && g a - disj f g a = f a || g a - not f a = not (f a) - -instance heytingAlgebraProxy :: HeytingAlgebra (Proxy a) where - conj _ _ = Proxy - disj _ _ = Proxy - implies _ _ = Proxy - ff = Proxy - not _ = Proxy - tt = Proxy - -instance heytingAlgebraRecord :: (RL.RowToList row list, HeytingAlgebraRecord list row row) => HeytingAlgebra (Record row) where - ff = ffRecord (Proxy :: Proxy list) (Proxy :: Proxy row) - tt = ttRecord (Proxy :: Proxy list) (Proxy :: Proxy row) - conj = conjRecord (Proxy :: Proxy list) - disj = disjRecord (Proxy :: Proxy list) - implies = impliesRecord (Proxy :: Proxy list) - not = notRecord (Proxy :: Proxy list) - -foreign import "psrs:intrinsic#booleanAnd" boolConj :: Boolean -> Boolean -> Boolean -foreign import "psrs:intrinsic#booleanOr" boolDisj :: Boolean -> Boolean -> Boolean -foreign import "psrs:intrinsic#booleanNot" boolNot :: Boolean -> Boolean - --- | A class for records where all fields have `HeytingAlgebra` instances, used --- | to implement the `HeytingAlgebra` instance for records. -class HeytingAlgebraRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class HeytingAlgebraRecord rowlist row subrow | rowlist -> subrow where - ffRecord :: Proxy rowlist -> Proxy row -> Record subrow - ttRecord :: Proxy rowlist -> Proxy row -> Record subrow - impliesRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - disjRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - conjRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - notRecord :: Proxy rowlist -> Record row -> Record subrow - -instance heytingAlgebraRecordNil :: HeytingAlgebraRecord RL.Nil row () where - conjRecord _ _ _ = {} - disjRecord _ _ _ = {} - ffRecord _ _ = {} - impliesRecord _ _ _ = {} - notRecord _ _ = {} - ttRecord _ _ = {} - -instance heytingAlgebraRecordCons :: - ( IsSymbol key - , Row.Cons key focus subrowTail subrow - , HeytingAlgebraRecord rowlistTail row subrowTail - , HeytingAlgebra focus - ) => - HeytingAlgebraRecord (RL.Cons key focus rowlistTail) row subrow where - conjRecord _ ra rb = insert (conj (get ra) (get rb)) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = conjRecord (Proxy :: Proxy rowlistTail) ra rb - - disjRecord _ ra rb = insert (disj (get ra) (get rb)) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = disjRecord (Proxy :: Proxy rowlistTail) ra rb - - impliesRecord _ ra rb = insert (implies (get ra) (get rb)) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = impliesRecord (Proxy :: Proxy rowlistTail) ra rb - - ffRecord _ row = insert ff tail - where - key = reflectSymbol (Proxy :: Proxy key) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = ffRecord (Proxy :: Proxy rowlistTail) row - - notRecord _ row = insert (not (get row)) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = notRecord (Proxy :: Proxy rowlistTail) row - - ttRecord _ row = insert tt tail - where - key = reflectSymbol (Proxy :: Proxy key) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = ttRecord (Proxy :: Proxy rowlistTail) row diff --git a/stdlib/lib/Data/HeytingAlgebra/Generic.purs b/stdlib/lib/Data/HeytingAlgebra/Generic.purs deleted file mode 100644 index d42e0b65..00000000 --- a/stdlib/lib/Data/HeytingAlgebra/Generic.purs +++ /dev/null @@ -1,70 +0,0 @@ -module Data.HeytingAlgebra.Generic where - -import Prelude - -import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) -import Data.HeytingAlgebra (ff, implies, tt) - -class GenericHeytingAlgebra a where - genericFF' :: a - genericTT' :: a - genericImplies' :: a -> a -> a - genericConj' :: a -> a -> a - genericDisj' :: a -> a -> a - genericNot' :: a -> a - -instance genericHeytingAlgebraNoArguments :: GenericHeytingAlgebra NoArguments where - genericFF' = NoArguments - genericTT' = NoArguments - genericImplies' _ _ = NoArguments - genericConj' _ _ = NoArguments - genericDisj' _ _ = NoArguments - genericNot' _ = NoArguments - -instance genericHeytingAlgebraArgument :: HeytingAlgebra a => GenericHeytingAlgebra (Argument a) where - genericFF' = Argument ff - genericTT' = Argument tt - genericImplies' (Argument x) (Argument y) = Argument (implies x y) - genericConj' (Argument x) (Argument y) = Argument (conj x y) - genericDisj' (Argument x) (Argument y) = Argument (disj x y) - genericNot' (Argument x) = Argument (not x) - -instance genericHeytingAlgebraProduct :: (GenericHeytingAlgebra a, GenericHeytingAlgebra b) => GenericHeytingAlgebra (Product a b) where - genericFF' = Product genericFF' genericFF' - genericTT' = Product genericTT' genericTT' - genericImplies' (Product a1 b1) (Product a2 b2) = Product (genericImplies' a1 a2) (genericImplies' b1 b2) - genericConj' (Product a1 b1) (Product a2 b2) = Product (genericConj' a1 a2) (genericConj' b1 b2) - genericDisj' (Product a1 b1) (Product a2 b2) = Product (genericDisj' a1 a2) (genericDisj' b1 b2) - genericNot' (Product a b) = Product (genericNot' a) (genericNot' b) - -instance genericHeytingAlgebraConstructor :: GenericHeytingAlgebra a => GenericHeytingAlgebra (Constructor name a) where - genericFF' = Constructor genericFF' - genericTT' = Constructor genericTT' - genericImplies' (Constructor a1) (Constructor a2) = Constructor (genericImplies' a1 a2) - genericConj' (Constructor a1) (Constructor a2) = Constructor (genericConj' a1 a2) - genericDisj' (Constructor a1) (Constructor a2) = Constructor (genericDisj' a1 a2) - genericNot' (Constructor a) = Constructor (genericNot' a) - --- | A `Generic` implementation of the `ff` member from the `HeytingAlgebra` type class. -genericFF :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -genericFF = to genericFF' - --- | A `Generic` implementation of the `tt` member from the `HeytingAlgebra` type class. -genericTT :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -genericTT = to genericTT' - --- | A `Generic` implementation of the `implies` member from the `HeytingAlgebra` type class. -genericImplies :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a -genericImplies x y = to $ from x `genericImplies'` from y - --- | A `Generic` implementation of the `conj` member from the `HeytingAlgebra` type class. -genericConj :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a -genericConj x y = to $ from x `genericConj'` from y - --- | A `Generic` implementation of the `disj` member from the `HeytingAlgebra` type class. -genericDisj :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a -genericDisj x y = to $ from x `genericDisj'` from y - --- | A `Generic` implementation of the `not` member from the `HeytingAlgebra` type class. -genericNot :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -genericNot x = to $ genericNot' (from x) \ No newline at end of file diff --git a/stdlib/lib/Data/Identity.purs b/stdlib/lib/Data/Identity.purs deleted file mode 100644 index 9ae89d50..00000000 --- a/stdlib/lib/Data/Identity.purs +++ /dev/null @@ -1,72 +0,0 @@ -module Data.Identity where - -import Prelude - -import Control.Alt (class Alt) -import Control.Comonad (class Comonad) -import Control.Extend (class Extend) -import Control.Lazy (class Lazy) -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) - -newtype Identity a = Identity a - -derive instance newtypeIdentity :: Newtype (Identity a) _ - -derive newtype instance eqIdentity :: Eq a => Eq (Identity a) - -derive newtype instance ordIdentity :: Ord a => Ord (Identity a) - -derive newtype instance boundedIdentity :: Bounded a => Bounded (Identity a) - -derive newtype instance heytingAlgebraIdentity :: HeytingAlgebra a => HeytingAlgebra (Identity a) - -derive newtype instance booleanAlgebraIdentity :: BooleanAlgebra a => BooleanAlgebra (Identity a) - -derive newtype instance semigroupIdentity :: Semigroup a => Semigroup (Identity a) - -derive newtype instance monoidIdentity :: Monoid a => Monoid (Identity a) - -derive newtype instance semiringIdentity :: Semiring a => Semiring (Identity a) - -derive newtype instance euclideanRingIdentity :: EuclideanRing a => EuclideanRing (Identity a) - -derive newtype instance ringIdentity :: Ring a => Ring (Identity a) - -derive newtype instance commutativeRingIdentity :: CommutativeRing a => CommutativeRing (Identity a) - -derive newtype instance lazyIdentity :: Lazy a => Lazy (Identity a) - -instance showIdentity :: Show a => Show (Identity a) where - show (Identity x) = "(Identity " <> show x <> ")" - -derive instance eq1Identity :: Eq1 Identity - -derive instance ord1Identity :: Ord1 Identity - -derive instance functorIdentity :: Functor Identity - -instance invariantIdentity :: Invariant Identity where - imap = imapF - -instance altIdentity :: Alt Identity where - alt x _ = x - -instance applyIdentity :: Apply Identity where - apply (Identity f) (Identity x) = Identity (f x) - -instance applicativeIdentity :: Applicative Identity where - pure = Identity - -instance bindIdentity :: Bind Identity where - bind (Identity m) f = f m - -instance monadIdentity :: Monad Identity - -instance extendIdentity :: Extend Identity where - extend f m = Identity (f m) - -instance comonadIdentity :: Comonad Identity where - extract (Identity x) = x diff --git a/stdlib/lib/Data/Int.purs b/stdlib/lib/Data/Int.purs deleted file mode 100644 index 1f9f3b76..00000000 --- a/stdlib/lib/Data/Int.purs +++ /dev/null @@ -1,257 +0,0 @@ -module Data.Int - ( fromNumber - , ceil - , floor - , trunc - , round - , toNumber - , fromString - , Radix - , radix - , binary - , octal - , decimal - , hexadecimal - , base36 - , fromStringAs - , toStringAs - , Parity(..) - , parity - , even - , odd - , quot - , rem - , pow - ) where - -import Prelude - -import Data.Int.Bits ((.&.)) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Number (isFinite) -import Data.Number as Number - --- | Creates an `Int` from a `Number` value. The number must already be an --- | integer and fall within the valid range of values for the `Int` type --- | otherwise `Nothing` is returned. -fromNumber :: Number -> Maybe Int -fromNumber = fromNumberImpl Just Nothing - -foreign import fromNumberImpl - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Number - -> Maybe Int - --- | Convert a `Number` to an `Int`, by taking the closest integer equal to or --- | less than the argument. Values outside the `Int` range are clamped, `NaN` --- | and `Infinity` values return 0. -floor :: Number -> Int -floor = unsafeClamp <<< Number.floor - --- | Convert a `Number` to an `Int`, by taking the closest integer equal to or --- | greater than the argument. Values outside the `Int` range are clamped, --- | `NaN` and `Infinity` values return 0. -ceil :: Number -> Int -ceil = unsafeClamp <<< Number.ceil - --- | Convert a `Number` to an `Int`, by dropping the decimal. --- | Values outside the `Int` range are clamped, `NaN` and `Infinity` --- | values return 0. -trunc :: Number -> Int -trunc = unsafeClamp <<< Number.trunc - --- | Convert a `Number` to an `Int`, by taking the nearest integer to the --- | argument. Values outside the `Int` range are clamped, `NaN` and `Infinity` --- | values return 0. -round :: Number -> Int -round = unsafeClamp <<< Number.round - --- | Convert an integral `Number` to an `Int`, by clamping to the `Int` range. --- | This function will return 0 if the input is `NaN` or an `Infinity`. -unsafeClamp :: Number -> Int -unsafeClamp x - | not (isFinite x) = 0 - | x >= toNumber top = top - | x <= toNumber bottom = bottom - | otherwise = fromMaybe 0 (fromNumber x) - --- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number` --- | so there is no loss of precision with this function. -foreign import "psrs:intrinsic#intToNumber" toNumber :: Int -> Number - --- | Reads an `Int` from a `String` value. The number must parse as an integer --- | and fall within the valid range of values for the `Int` type, otherwise --- | `Nothing` is returned. -fromString :: String -> Maybe Int -fromString = fromStringAs (Radix 10) - --- | A type for describing whether an integer is even or odd. --- | --- | The `Ord` instance considers `Even` to be less than `Odd`. --- | --- | The `Semiring` instance allows you to ask about the parity of the results --- | of arithmetical operations, given only the parities of the inputs. For --- | example, the sum of an odd number and an even number is odd, so --- | `Odd + Even == Odd`. This also works for multiplication, eg. the product --- | of two odd numbers is odd, and therefore `Odd * Odd == Odd`. --- | --- | More generally, we have that --- | --- | ```purescript --- | parity x + parity y == parity (x + y) --- | parity x * parity y == parity (x * y) --- | ``` --- | --- | for any integers `x`, `y`. (A mathematician would say that `parity` is a --- | *ring homomorphism*.) --- | --- | After defining addition and multiplication on `Parity` in this way, the --- | `Semiring` laws now force us to choose `zero = Even` and `one = Odd`. --- | This `Semiring` instance actually turns out to be a `Field`. -data Parity = Even | Odd - -derive instance eqParity :: Eq Parity -derive instance ordParity :: Ord Parity - -instance showParity :: Show Parity where - show Even = "Even" - show Odd = "Odd" - -instance boundedParity :: Bounded Parity where - bottom = Even - top = Odd - -instance semiringParity :: Semiring Parity where - zero = Even - add x y = if x == y then Even else Odd - one = Odd - mul Odd Odd = Odd - mul _ _ = Even - -instance ringParity :: Ring Parity where - sub = add - -instance commutativeRingParity :: CommutativeRing Parity - -instance euclideanRingParity :: EuclideanRing Parity where - degree Even = 0 - degree Odd = 1 - div x _ = x - mod _ _ = Even - -instance divisionRingParity :: DivisionRing Parity where - recip = identity - --- | Returns whether an `Int` is `Even` or `Odd`. --- | --- | ``` purescript --- | parity 0 == Even --- | parity 1 == Odd --- | ``` -parity :: Int -> Parity -parity n = if even n then Even else Odd - --- | Returns whether an `Int` is an even number. --- | --- | ``` purescript --- | even 0 == true --- | even 1 == false --- | ``` -even :: Int -> Boolean -even x = x .&. 1 == 0 - --- | The negation of `even`. --- | --- | ``` purescript --- | odd 0 == false --- | odd 1 == true --- | ``` -odd :: Int -> Boolean -odd x = x .&. 1 /= 0 - --- | The number of unique digits (including zero) used to represent integers in --- | a specific base. -newtype Radix = Radix Int - --- | The base-2 system. -binary :: Radix -binary = Radix 2 - --- | The base-8 system. -octal :: Radix -octal = Radix 8 - --- | The base-10 system. -decimal :: Radix -decimal = Radix 10 - --- | The base-16 system. -hexadecimal :: Radix -hexadecimal = Radix 16 - --- | The base-36 system. -base36 :: Radix -base36 = Radix 36 - --- | Create a `Radix` from a number between 2 and 36. -radix :: Int -> Maybe Radix -radix n | n >= 2 && n <= 36 = Just (Radix n) - | otherwise = Nothing - --- | Like `fromString`, but the integer can be specified in a different base. --- | --- | Example: --- | ``` purs --- | fromStringAs binary "100" == Just 4 --- | fromStringAs hexadecimal "ff" == Just 255 --- | ``` -fromStringAs :: Radix -> String -> Maybe Int -fromStringAs = fromStringAsImpl Just Nothing - --- | The `quot` function provides _truncating_ integer division (see the --- | documentation for the `EuclideanRing` class). It is identical to `div` in --- | the `EuclideanRing Int` instance if the dividend is positive, but will be --- | slightly different if the dividend is negative. For example: --- | --- | ```purescript --- | div 2 3 == 0 --- | quot 2 3 == 0 --- | --- | div (-2) 3 == (-1) --- | quot (-2) 3 == 0 --- | --- | div 2 (-3) == 0 --- | quot 2 (-3) == 0 --- | ``` -foreign import quot :: Int -> Int -> Int - --- | The `rem` function provides the remainder after _truncating_ integer --- | division (see the documentation for the `EuclideanRing` class). It is --- | identical to `mod` in the `EuclideanRing Int` instance if the dividend is --- | positive, but will be slightly different if the dividend is negative. For --- | example: --- | --- | ```purescript --- | mod 2 3 == 2 --- | rem 2 3 == 2 --- | --- | mod (-2) 3 == 1 --- | rem (-2) 3 == (-2) --- | --- | mod 2 (-3) == 2 --- | rem 2 (-3) == 2 --- | ``` -foreign import rem :: Int -> Int -> Int - --- | Raise an Int to the power of another Int. -foreign import pow :: Int -> Int -> Int - -foreign import fromStringAsImpl - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Radix - -> String - -> Maybe Int - -foreign import toStringAs :: Radix -> Int -> String diff --git a/stdlib/lib/Data/Int/Bits.purs b/stdlib/lib/Data/Int/Bits.purs deleted file mode 100644 index c6f17df5..00000000 --- a/stdlib/lib/Data/Int/Bits.purs +++ /dev/null @@ -1,37 +0,0 @@ --- | This module defines bitwise operations for the `Int` type. -module Data.Int.Bits - ( and, (.&.) - , or, (.|.) - , xor, (.^.) - , shl - , shr - , zshr - , complement - ) where - --- | Bitwise AND. -foreign import "psrs:intrinsic#intAnd" and :: Int -> Int -> Int - -infixl 10 and as .&. - --- | Bitwise OR. -foreign import "psrs:intrinsic#intOr" or :: Int -> Int -> Int - -infixl 10 or as .|. - --- | Bitwise XOR. -foreign import "psrs:intrinsic#intXor" xor :: Int -> Int -> Int - -infixl 10 xor as .^. - --- | Bitwise shift left. -foreign import "psrs:intrinsic#intShl" shl :: Int -> Int -> Int - --- | Bitwise shift right. -foreign import "psrs:intrinsic#intShr" shr :: Int -> Int -> Int - --- | Bitwise zero-fill shift right. -foreign import "psrs:intrinsic#intZshr" zshr :: Int -> Int -> Int - --- | Bitwise NOT. -foreign import "psrs:intrinsic#intComplement" complement :: Int -> Int diff --git a/stdlib/lib/Data/Lazy.purs b/stdlib/lib/Data/Lazy.purs deleted file mode 100644 index 9fe61171..00000000 --- a/stdlib/lib/Data/Lazy.purs +++ /dev/null @@ -1,142 +0,0 @@ -module Data.Lazy where - -import Prelude - -import Control.Comonad (class Comonad) -import Control.Extend (class Extend) -import Control.Lazy as CL -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable, foldMap, foldl, foldr) -import Data.FoldableWithIndex (class FoldableWithIndex) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.HeytingAlgebra (implies, ff, tt) -import Data.Ord (class Ord1) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Traversable (class Traversable1) -import Data.Traversable (class Traversable, traverse) -import Data.TraversableWithIndex (class TraversableWithIndex) - --- | `Lazy a` represents lazily-computed values of type `a`. --- | --- | A lazy value is computed at most once - the result is saved --- | after the first computation, and subsequent attempts to read --- | the value simply return the saved value. --- | --- | `Lazy` values can be created with `defer`, or by using the provided --- | type class instances. --- | --- | `Lazy` values can be evaluated by using the `force` function. -foreign import data Lazy :: Type -> Type - -type role Lazy representational - --- | Defer a computation, creating a `Lazy` value. -foreign import defer :: forall a. (Unit -> a) -> Lazy a - --- | Force evaluation of a `Lazy` value. -foreign import force :: forall a. Lazy a -> a - -instance semiringLazy :: Semiring a => Semiring (Lazy a) where - add a b = defer \_ -> force a + force b - zero = defer \_ -> zero - mul a b = defer \_ -> force a * force b - one = defer \_ -> one - -instance ringLazy :: Ring a => Ring (Lazy a) where - sub a b = defer \_ -> force a - force b - -instance commutativeRingLazy :: CommutativeRing a => CommutativeRing (Lazy a) - -instance euclideanRingLazy :: EuclideanRing a => EuclideanRing (Lazy a) where - degree = degree <<< force - div a b = defer \_ -> force a / force b - mod a b = defer \_ -> force a `mod` force b - -instance eqLazy :: Eq a => Eq (Lazy a) where - eq x y = (force x) == (force y) - -derive instance eq1Lazy :: Eq1 Lazy - -instance ordLazy :: Ord a => Ord (Lazy a) where - compare x y = compare (force x) (force y) - -derive instance ord1Lazy :: Ord1 Lazy - -instance boundedLazy :: Bounded a => Bounded (Lazy a) where - top = defer \_ -> top - bottom = defer \_ -> bottom - -instance semigroupLazy :: Semigroup a => Semigroup (Lazy a) where - append a b = defer \_ -> force a <> force b - -instance monoidLazy :: Monoid a => Monoid (Lazy a) where - mempty = defer \_ -> mempty - -instance heytingAlgebraLazy :: HeytingAlgebra a => HeytingAlgebra (Lazy a) where - ff = defer \_ -> ff - tt = defer \_ -> tt - implies a b = implies <$> a <*> b - conj a b = conj <$> a <*> b - disj a b = disj <$> a <*> b - not a = not <$> a - -instance booleanAlgebraLazy :: BooleanAlgebra a => BooleanAlgebra (Lazy a) - -instance functorLazy :: Functor Lazy where - map f l = defer \_ -> f (force l) - -instance functorWithIndexLazy :: FunctorWithIndex Unit Lazy where - mapWithIndex f = map $ f unit - -instance foldableLazy :: Foldable Lazy where - foldr f z l = f (force l) z - foldl f z l = f z (force l) - foldMap f l = f (force l) - -instance foldableWithIndexLazy :: FoldableWithIndex Unit Lazy where - foldrWithIndex f = foldr $ f unit - foldlWithIndex f = foldl $ f unit - foldMapWithIndex f = foldMap $ f unit - -instance foldable1Lazy :: Foldable1 Lazy where - foldMap1 f l = f (force l) - foldr1 _ l = force l - foldl1 _ l = force l - -instance traversableLazy :: Traversable Lazy where - traverse f l = defer <<< const <$> f (force l) - sequence l = defer <<< const <$> force l - -instance traversableWithIndexLazy :: TraversableWithIndex Unit Lazy where - traverseWithIndex f = traverse $ f unit - -instance traversable1Lazy :: Traversable1 Lazy where - traverse1 f l = defer <<< const <$> f (force l) - sequence1 l = defer <<< const <$> force l - -instance invariantLazy :: Invariant Lazy where - imap = imapF - -instance applyLazy :: Apply Lazy where - apply f x = defer \_ -> force f (force x) - -instance applicativeLazy :: Applicative Lazy where - pure a = defer \_ -> a - -instance bindLazy :: Bind Lazy where - bind l f = defer \_ -> force $ f (force l) - -instance monadLazy :: Monad Lazy - -instance extendLazy :: Extend Lazy where - extend f x = defer \_ -> f x - -instance comonadLazy :: Comonad Lazy where - extract = force - -instance showLazy :: Show a => Show (Lazy a) where - show x = "(defer \\_ -> " <> show (force x) <> ")" - -instance lazyLazy :: CL.Lazy (Lazy a) where - defer f = defer \_ -> force (f unit) diff --git a/stdlib/lib/Data/List.purs b/stdlib/lib/Data/List.purs deleted file mode 100644 index 38f90365..00000000 --- a/stdlib/lib/Data/List.purs +++ /dev/null @@ -1,826 +0,0 @@ --- | This module defines a type of _strict_ linked lists, and associated helper --- | functions and type class instances. --- | --- | _Note_: Depending on your use-case, you may prefer to use --- | `Data.Sequence` instead, which might give better performance for certain --- | use cases. This module is an improvement over `Data.Array` when working with --- | immutable lists of data in a purely-functional setting, but does not have --- | good random-access performance. - -module Data.List - ( module Data.List.Types - , toUnfoldable - , fromFoldable - - , singleton - , (..), range - , some - , someRec - , many - , manyRec - - , null - , length - - , snoc - , insert - , insertBy - - , head - , last - , tail - , init - , uncons - , unsnoc - - , (!!), index - , elemIndex - , elemLastIndex - , findIndex - , findLastIndex - , insertAt - , deleteAt - , updateAt - , modifyAt - , alterAt - - , reverse - , concat - , concatMap - , filter - , filterM - , mapMaybe - , catMaybes - - , sort - , sortBy - - , Pattern(..) - , stripPrefix - , slice - , take - , takeEnd - , takeWhile - , drop - , dropEnd - , dropWhile - , span - , group - , groupAll - , groupBy - , groupAllBy - , partition - - , nub - , nubBy - , nubEq - , nubByEq - , union - , unionBy - , delete - , deleteBy - , (\\), difference - , intersect - , intersectBy - - , zipWith - , zipWithA - , zip - , unzip - - , transpose - - , foldM - - , module Exports - ) where - -import Prelude - -import Control.Alt ((<|>)) -import Control.Alternative (class Alternative) -import Control.Lazy (class Lazy, defer) -import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM, tailRecM2) -import Data.Bifunctor (bimap) -import Data.Foldable (class Foldable, foldr, any, foldl) -import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports -import Data.List.Internal (emptySet, insertAndLookupBy) -import Data.List.Types (List(..), (:)) -import Data.List.Types (NonEmptyList(..)) as NEL -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.NonEmpty ((:|)) -import Data.Traversable (scanl, scanr) as Exports -import Data.Traversable (sequence) -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, unfoldr) - --- | Convert a list into any unfoldable structure. --- | --- | Running time: `O(n)` -toUnfoldable :: forall f. Unfoldable f => List ~> f -toUnfoldable = unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> uncons xs) - --- | Construct a list from a foldable structure. --- | --- | Running time: `O(n)` -fromFoldable :: forall f. Foldable f => f ~> List -fromFoldable = foldr Cons Nil - --------------------------------------------------------------------------------- --- List creation --------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Create a list with a single element. --- | --- | Running time: `O(1)` -singleton :: forall a. a -> List a -singleton a = a : Nil - --- | An infix synonym for `range`. -infix 8 range as .. - --- | Create a list containing a range of integers, including both endpoints. -range :: Int -> Int -> List Int -range start end | start == end = singleton start - | otherwise = go end start (if start > end then 1 else -1) Nil - where - go s e step rest | s == e = s : rest - | otherwise = go (s + step) e step (s : rest) - --- | Attempt a computation multiple times, requiring at least one success. --- | --- | The `Lazy` constraint is used to generate the result lazily, to ensure --- | termination. -some :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a) -some v = Cons <$> v <*> defer (\_ -> many v) - --- | A stack-safe version of `some`, at the cost of a `MonadRec` constraint. -someRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) -someRec v = Cons <$> v <*> manyRec v - --- | Attempt a computation multiple times, returning as many successful results --- | as possible (possibly zero). --- | --- | The `Lazy` constraint is used to generate the result lazily, to ensure --- | termination. -many :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a) -many v = some v <|> pure Nil - --- | A stack-safe version of `many`, at the cost of a `MonadRec` constraint. -manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) -manyRec p = tailRecM go Nil - where - go :: List a -> f (Step (List a) (List a)) - go acc = do - aa <- (Loop <$> p) <|> pure (Done unit) - pure $ bimap (_ : acc) (\_ -> reverse acc) aa - --------------------------------------------------------------------------------- --- List size ------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Test whether a list is empty. --- | --- | Running time: `O(1)` -null :: forall a. List a -> Boolean -null Nil = true -null _ = false - --- | Get the length of a list --- | --- | Running time: `O(n)` -length :: forall a. List a -> Int -length = foldl (\acc _ -> acc + 1) 0 - --------------------------------------------------------------------------------- --- Extending lists ------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Append an element to the end of a list, creating a new list. --- | --- | Running time: `O(n)` -snoc :: forall a. List a -> a -> List a -snoc xs x = foldr (:) (x : Nil) xs - --- | Insert an element into a sorted list. --- | --- | Running time: `O(n)` -insert :: forall a. Ord a => a -> List a -> List a -insert = insertBy compare - --- | Insert an element into a sorted list, using the specified function to --- | determine the ordering of elements. --- | --- | Running time: `O(n)` -insertBy :: forall a. (a -> a -> Ordering) -> a -> List a -> List a -insertBy _ x Nil = singleton x -insertBy cmp x ys@(y : ys') = - case cmp x y of - GT -> y : (insertBy cmp x ys') - _ -> x : ys - --------------------------------------------------------------------------------- --- Non-indexed reads ----------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Get the first element in a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(1)`. -head :: List ~> Maybe -head Nil = Nothing -head (x : _) = Just x - --- | Get the last element in a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(n)`. -last :: List ~> Maybe -last (x : Nil) = Just x -last (_ : xs) = last xs -last _ = Nothing - --- | Get all but the first element of a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(1)` -tail :: forall a. List a -> Maybe (List a) -tail Nil = Nothing -tail (_ : xs) = Just xs - --- | Get all but the last element of a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(n)` -init :: forall a. List a -> Maybe (List a) -init lst = _.init <$> unsnoc lst - --- | Break a list into its first element, and the remaining elements, --- | or `Nothing` if the list is empty. --- | --- | Running time: `O(1)` -uncons :: forall a. List a -> Maybe { head :: a, tail :: List a } -uncons Nil = Nothing -uncons (x : xs) = Just { head: x, tail: xs } - --- | Break a list into its last element, and the preceding elements, --- | or `Nothing` if the list is empty. --- | --- | Running time: `O(n)` -unsnoc :: forall a. List a -> Maybe { init :: List a, last :: a } -unsnoc lst = (\h -> { init: reverse h.revInit, last: h.last }) <$> go lst Nil - where - go Nil _ = Nothing - go (x : Nil) acc = Just { revInit: acc, last: x } - go (x : xs) acc = go xs (x : acc) - --------------------------------------------------------------------------------- --- Indexed operations ---------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Get the element at the specified index, or `Nothing` if the index is out-of-bounds. --- | --- | Running time: `O(n)` where `n` is the required index. -index :: forall a. List a -> Int -> Maybe a -index Nil _ = Nothing -index (a : _) 0 = Just a -index (_ : as) i = index as (i - 1) - --- | An infix synonym for `index`. -infixl 8 index as !! - --- | Find the index of the first element equal to the specified element. -elemIndex :: forall a. Eq a => a -> List a -> Maybe Int -elemIndex x = findIndex (_ == x) - --- | Find the index of the last element equal to the specified element. -elemLastIndex :: forall a. Eq a => a -> List a -> Maybe Int -elemLastIndex x = findLastIndex (_ == x) - --- | Find the first index for which a predicate holds. -findIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int -findIndex fn = go 0 - where - go :: Int -> List a -> Maybe Int - go n (x : xs) | fn x = Just n - | otherwise = go (n + 1) xs - go _ Nil = Nothing - --- | Find the last index for which a predicate holds. -findLastIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int -findLastIndex fn xs = ((length xs - 1) - _) <$> findIndex fn (reverse xs) - --- | Insert an element into a list at the specified index, returning a new --- | list or `Nothing` if the index is out-of-bounds. --- | --- | Running time: `O(n)` -insertAt :: forall a. Int -> a -> List a -> Maybe (List a) -insertAt 0 x xs = Just (x : xs) -insertAt n x (y : ys) = (y : _) <$> insertAt (n - 1) x ys -insertAt _ _ _ = Nothing - --- | Delete an element from a list at the specified index, returning a new --- | list or `Nothing` if the index is out-of-bounds. --- | --- | Running time: `O(n)` -deleteAt :: forall a. Int -> List a -> Maybe (List a) -deleteAt 0 (_ : ys) = Just ys -deleteAt n (y : ys) = (y : _) <$> deleteAt (n - 1) ys -deleteAt _ _ = Nothing - --- | Update the element at the specified index, returning a new --- | list or `Nothing` if the index is out-of-bounds. --- | --- | Running time: `O(n)` -updateAt :: forall a. Int -> a -> List a -> Maybe (List a) -updateAt 0 x ( _ : xs) = Just (x : xs) -updateAt n x (x1 : xs) = (x1 : _) <$> updateAt (n - 1) x xs -updateAt _ _ _ = Nothing - --- | Update the element at the specified index by applying a function to --- | the current value, returning a new list or `Nothing` if the index is --- | out-of-bounds. --- | --- | Running time: `O(n)` -modifyAt :: forall a. Int -> (a -> a) -> List a -> Maybe (List a) -modifyAt n f = alterAt n (Just <<< f) - --- | Update or delete the element at the specified index by applying a --- | function to the current value, returning a new list or `Nothing` if the --- | index is out-of-bounds. --- | --- | Running time: `O(n)` -alterAt :: forall a. Int -> (a -> Maybe a) -> List a -> Maybe (List a) -alterAt 0 f (y : ys) = Just $ - case f y of - Nothing -> ys - Just y' -> y' : ys -alterAt n f (y : ys) = (y : _) <$> alterAt (n - 1) f ys -alterAt _ _ _ = Nothing - --------------------------------------------------------------------------------- --- Transformations ------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Reverse a list. --- | --- | Running time: `O(n)` -reverse :: List ~> List -reverse = go Nil - where - go acc Nil = acc - go acc (x : xs) = go (x : acc) xs - --- | Flatten a list of lists. --- | --- | Running time: `O(n)`, where `n` is the total number of elements. -concat :: forall a. List (List a) -> List a -concat = (_ >>= identity) - --- | Apply a function to each element in a list, and flatten the results --- | into a single, new list. --- | --- | Running time: `O(n)`, where `n` is the total number of elements. -concatMap :: forall a b. (a -> List b) -> List a -> List b -concatMap = flip bind - --- | Filter a list, keeping the elements which satisfy a predicate function. --- | --- | Running time: `O(n)` -filter :: forall a. (a -> Boolean) -> List a -> List a -filter p = go Nil - where - go acc Nil = reverse acc - go acc (x : xs) - | p x = go (x : acc) xs - | otherwise = go acc xs - --- | Filter where the predicate returns a monadic `Boolean`. --- | --- | For example: --- | --- | ```purescript --- | powerSet :: forall a. [a] -> [[a]] --- | powerSet = filterM (const [true, false]) --- | ``` -filterM :: forall a m. Monad m => (a -> m Boolean) -> List a -> m (List a) -filterM _ Nil = pure Nil -filterM p (x : xs) = do - b <- p x - xs' <- filterM p xs - pure if b then x : xs' else xs' - --- | Apply a function to each element in a list, keeping only the results which --- | contain a value. --- | --- | Running time: `O(n)` -mapMaybe :: forall a b. (a -> Maybe b) -> List a -> List b -mapMaybe f = go Nil - where - go acc Nil = reverse acc - go acc (x : xs) = - case f x of - Nothing -> go acc xs - Just y -> go (y : acc) xs - --- | Filter a list of optional values, keeping only the elements which contain --- | a value. -catMaybes :: forall a. List (Maybe a) -> List a -catMaybes = mapMaybe identity - --------------------------------------------------------------------------------- --- Sorting --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Sort the elements of an list in increasing order. -sort :: forall a. Ord a => List a -> List a -sort xs = sortBy compare xs - --- | Sort the elements of a list in increasing order, where elements are --- | compared using the specified ordering. -sortBy :: forall a. (a -> a -> Ordering) -> List a -> List a -sortBy cmp = mergeAll <<< sequences - -- implementation lifted from http://hackage.haskell.org/package/base-4.8.0.0/docs/src/Data-OldList.html#sort - where - sequences :: List a -> List (List a) - sequences (a : b : xs) - | a `cmp` b == GT = descending b (singleton a) xs - | otherwise = ascending b (a : _) xs - sequences xs = singleton xs - - descending :: a -> List a -> List a -> List (List a) - descending a as (b : bs) - | a `cmp` b == GT = descending b (a : as) bs - descending a as bs = (a : as) : sequences bs - - ascending :: a -> (List a -> List a) -> List a -> List (List a) - ascending a as (b : bs) - | a `cmp` b /= GT = ascending b (\ys -> as (a : ys)) bs - ascending a as bs = ((as $ singleton a) : sequences bs) - - mergeAll :: List (List a) -> List a - mergeAll (x : Nil) = x - mergeAll xs = mergeAll (mergePairs xs) - - mergePairs :: List (List a) -> List (List a) - mergePairs (a : b : xs) = merge a b : mergePairs xs - mergePairs xs = xs - - merge :: List a -> List a -> List a - merge as@(a : as') bs@(b : bs') - | a `cmp` b == GT = b : merge as bs' - | otherwise = a : merge as' bs - merge Nil bs = bs - merge as Nil = as - --------------------------------------------------------------------------------- --- Sublists -------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | A newtype used in cases where there is a list to be matched. -newtype Pattern a = Pattern (List a) - -derive instance eqPattern :: Eq a => Eq (Pattern a) -derive instance ordPattern :: Ord a => Ord (Pattern a) -derive instance newtypePattern :: Newtype (Pattern a) _ - -instance showPattern :: Show a => Show (Pattern a) where - show (Pattern s) = "(Pattern " <> show s <> ")" - - --- | If the list starts with the given prefix, return the portion of the --- | list left after removing it, as a Just value. Otherwise, return Nothing. --- | * `stripPrefix (Pattern (1:Nil)) (1:2:Nil) == Just (2:Nil)` --- | * `stripPrefix (Pattern Nil) (1:Nil) == Just (1:Nil)` --- | * `stripPrefix (Pattern (2:Nil)) (1:Nil) == Nothing` --- | --- | Running time: `O(n)` where `n` is the number of elements to strip. -stripPrefix :: forall a. Eq a => Pattern a -> List a -> Maybe (List a) -stripPrefix (Pattern p') s = tailRecM2 go p' s - where - go prefix input = case prefix, input of - Cons p ps, Cons i is | p == i -> Just $ Loop { a: ps, b: is } - Nil, is -> Just $ Done is - _, _ -> Nothing - --- | Extract a sublist by a start and end index. -slice :: Int -> Int -> List ~> List -slice start end xs = take (end - start) (drop start xs) - --- | Take the specified number of elements from the front of a list. --- | --- | Running time: `O(n)` where `n` is the number of elements to take. -take :: forall a. Int -> List a -> List a -take = go Nil - where - go acc n _ | n < 1 = reverse acc - go acc _ Nil = reverse acc - go acc n (x : xs) = go (x : acc) (n - 1) xs - --- | Take the specified number of elements from the end of a list. --- | --- | Running time: `O(2n - m)` where `n` is the number of elements in list --- | and `m` is number of elements to take. -takeEnd :: forall a. Int -> List a -> List a -takeEnd n xs = drop (length xs - n) xs - --- | Take those elements from the front of a list which match a predicate. --- | --- | Running time (worst case): `O(n)` -takeWhile :: forall a. (a -> Boolean) -> List a -> List a -takeWhile p = go Nil - where - go acc (x : xs) | p x = go (x : acc) xs - go acc _ = reverse acc - --- | Drop the specified number of elements from the front of a list. --- | --- | Running time: `O(n)` where `n` is the number of elements to drop. -drop :: forall a. Int -> List a -> List a -drop n xs | n < 1 = xs -drop _ Nil = Nil -drop n (_ : xs) = drop (n - 1) xs - --- | Drop the specified number of elements from the end of a list. --- | --- | Running time: `O(2n - m)` where `n` is the number of elements in list --- | and `m` is number of elements to drop. -dropEnd :: forall a. Int -> List a -> List a -dropEnd n xs = take (length xs - n) xs - --- | Drop those elements from the front of a list which match a predicate. --- | --- | Running time (worst case): `O(n)` -dropWhile :: forall a. (a -> Boolean) -> List a -> List a -dropWhile p = go - where - go (x : xs) | p x = go xs - go xs = xs - --- | Split a list into two parts: --- | --- | 1. the longest initial segment for which all elements satisfy the specified predicate --- | 2. the remaining elements --- | --- | For example, --- | --- | ```purescript --- | span (\n -> n % 2 == 1) (1 : 3 : 2 : 4 : 5 : Nil) == { init: (1 : 3 : Nil), rest: (2 : 4 : 5 : Nil) } --- | ``` --- | --- | Running time: `O(n)` -span :: forall a. (a -> Boolean) -> List a -> { init :: List a, rest :: List a } -span p (x : xs') | p x = case span p xs' of - { init: ys, rest: zs } -> { init: x : ys, rest: zs } -span _ xs = { init: Nil, rest: xs } - --- | Group equal, consecutive elements of a list into lists. --- | --- | For example, --- | --- | ```purescript --- | group (1 : 1 : 2 : 2 : 1 : Nil) == --- | (NonEmptyList (NonEmpty 1 (1 : Nil))) : (NonEmptyList (NonEmpty 2 (2 : Nil))) : (NonEmptyList (NonEmpty 1 Nil)) : Nil --- | ``` --- | --- | Running time: `O(n)` -group :: forall a. Eq a => List a -> List (NEL.NonEmptyList a) -group = groupBy (==) - --- | Group equal elements of a list into lists. --- | --- | For example, --- | --- | ```purescript --- | groupAll (1 : 1 : 2 : 2 : 1 : Nil) == --- | (NonEmptyList (NonEmpty 1 (1 : 1 : Nil))) : (NonEmptyList (NonEmpty 2 (2 : Nil))) : Nil --- | ``` -groupAll :: forall a. Ord a => List a -> List (NEL.NonEmptyList a) -groupAll = group <<< sort - --- | Group equal, consecutive elements of a list into lists, using the specified --- | equivalence relation to determine equality. --- | --- | For example, --- | --- | ```purescript --- | groupBy (\a b -> odd a && odd b) (1 : 3 : 2 : 4 : 3 : 3 : Nil) == --- | (NonEmptyList (NonEmpty 1 (3 : Nil))) : (NonEmptyList (NonEmpty 2 Nil)) : (NonEmptyList (NonEmpty 4 Nil)) : (NonEmptyList (NonEmpty 3 (3 : Nil))) : Nil --- | ``` --- | --- | Running time: `O(n)` -groupBy :: forall a. (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) -groupBy _ Nil = Nil -groupBy eq (x : xs) = case span (eq x) xs of - { init: ys, rest: zs } -> NEL.NonEmptyList (x :| ys) : groupBy eq zs - --- | Sort, then group equal elements of a list into lists, using the provided comparison function. --- | --- | ```purescript --- | groupAllBy (compare `on` (_ `div` 10)) (32 : 31 : 21 : 22 : 11 : 33 : Nil) == --- | NonEmptyList (11 :| Nil) : NonEmptyList (21 :| 22 : Nil) : NonEmptyList (32 :| 31 : 33) : Nil --- | ``` --- | --- | Running time: `O(n log n)` -groupAllBy :: forall a. (a -> a -> Ordering) -> List a -> List (NEL.NonEmptyList a) -groupAllBy p = groupBy (\x y -> p x y == EQ) <<< sortBy p - --- | Returns a lists of elements which do and do not satisfy a predicate. --- | --- | Running time: `O(n)` -partition :: forall a. (a -> Boolean) -> List a -> { yes :: List a, no :: List a } -partition p xs = foldr select { no: Nil, yes: Nil } xs - where - select x { no, yes } = if p x - then { no, yes: x : yes } - else { no: x : no, yes } - --- | Returns all final segments of the argument, longest first. For example, --- | --- | ```purescript --- | tails (1 : 2 : 3 : Nil) == ((1 : 2 : 3 : Nil) : (2 : 3 : Nil) : (3 : Nil) : (Nil) : Nil) --- | ``` --- | Running time: `O(n)` -tails :: forall a. List a -> List (List a) -tails Nil = singleton Nil -tails list@(Cons _ tl)= list : tails tl - --------------------------------------------------------------------------------- --- Set-like operations --------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Remove duplicate elements from a list. --- | Keeps the first occurrence of each element in the input list, --- | in the same order they appear in the input list. --- | --- | ```purescript --- | nub 1:2:1:3:3:Nil == 1:2:3:Nil --- | ``` --- | --- | Running time: `O(n log n)` -nub :: forall a. Ord a => List a -> List a -nub = nubBy compare - --- | Remove duplicate elements from a list based on the provided comparison function. --- | Keeps the first occurrence of each element in the input list, --- | in the same order they appear in the input list. --- | --- | ```purescript --- | nubBy (compare `on` Array.length) ([1]:[2]:[3,4]:Nil) == [1]:[3,4]:Nil --- | ``` --- | --- | Running time: `O(n log n)` -nubBy :: forall a. (a -> a -> Ordering) -> List a -> List a -nubBy p = reverse <<< go emptySet Nil - where - go _ acc Nil = acc - go s acc (a : as) = - let { found, result: s' } = insertAndLookupBy p a s - in if found - then go s' acc as - else go s' (a : acc) as - --- | Remove duplicate elements from a list. --- | Keeps the first occurrence of each element in the input list, --- | in the same order they appear in the input list. --- | This less efficient version of `nub` only requires an `Eq` instance. --- | --- | ```purescript --- | nubEq 1:2:1:3:3:Nil == 1:2:3:Nil --- | ``` --- | --- | Running time: `O(n^2)` -nubEq :: forall a. Eq a => List a -> List a -nubEq = nubByEq eq - --- | Remove duplicate elements from a list, using the provided equivalence function. --- | Keeps the first occurrence of each element in the input list, --- | in the same order they appear in the input list. --- | This less efficient version of `nubBy` only requires an equivalence --- | function, rather than an ordering function. --- | --- | ```purescript --- | mod3eq = eq `on` \n -> mod n 3 --- | nubByEq mod3eq 1:3:4:5:6:Nil == 1:3:5:Nil --- | ``` --- | --- | Running time: `O(n^2)` -nubByEq :: forall a. (a -> a -> Boolean) -> List a -> List a -nubByEq _ Nil = Nil -nubByEq eq' (x : xs) = x : nubByEq eq' (filter (\y -> not (eq' x y)) xs) - --- | Calculate the union of two lists. --- | --- | Running time: `O(n^2)` -union :: forall a. Eq a => List a -> List a -> List a -union = unionBy (==) - --- | Calculate the union of two lists, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n^2)` -unionBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a -unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs - --- | Delete the first occurrence of an element from a list. --- | --- | Running time: `O(n)` -delete :: forall a. Eq a => a -> List a -> List a -delete = deleteBy (==) - --- | Delete the first occurrence of an element from a list, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n)` -deleteBy :: forall a. (a -> a -> Boolean) -> a -> List a -> List a -deleteBy _ _ Nil = Nil -deleteBy eq' x (y : ys) | eq' x y = ys -deleteBy eq' x (y : ys) = y : deleteBy eq' x ys - -infix 5 difference as \\ - --- | Delete the first occurrence of each element in the second list from the first list. --- | --- | Running time: `O(n^2)` -difference :: forall a. Eq a => List a -> List a -> List a -difference = foldl (flip delete) - --- | Calculate the intersection of two lists. --- | --- | Running time: `O(n^2)` -intersect :: forall a. Eq a => List a -> List a -> List a -intersect = intersectBy (==) - --- | Calculate the intersection of two lists, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n^2)` -intersectBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a -intersectBy _ Nil _ = Nil -intersectBy _ _ Nil = Nil -intersectBy eq xs ys = filter (\x -> any (eq x) ys) xs - --------------------------------------------------------------------------------- --- Zipping --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Apply a function to pairs of elements at the same positions in two lists, --- | collecting the results in a new list. --- | --- | If one list is longer, elements will be discarded from the longer list. --- | --- | For example --- | --- | ```purescript --- | zipWith (*) (1 : 2 : 3 : Nil) (4 : 5 : 6 : 7 Nil) == 4 : 10 : 18 : Nil --- | ``` --- | --- | Running time: `O(min(m, n))` -zipWith :: forall a b c. (a -> b -> c) -> List a -> List b -> List c -zipWith f xs ys = reverse $ go xs ys Nil - where - go Nil _ acc = acc - go _ Nil acc = acc - go (a : as) (b : bs) acc = go as bs $ f a b : acc - --- | A generalization of `zipWith` which accumulates results in some `Applicative` --- | functor. -zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> List a -> List b -> m (List c) -zipWithA f xs ys = sequence (zipWith f xs ys) - --- | Collect pairs of elements at the same positions in two lists. --- | --- | Running time: `O(min(m, n))` -zip :: forall a b. List a -> List b -> List (Tuple a b) -zip = zipWith Tuple - --- | Transforms a list of pairs into a list of first components and a list of --- | second components. -unzip :: forall a b. List (Tuple a b) -> Tuple (List a) (List b) -unzip = foldr (\(Tuple a b) (Tuple as bs) -> Tuple (a : as) (b : bs)) (Tuple Nil Nil) - --------------------------------------------------------------------------------- --- Transpose ------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | The 'transpose' function transposes the rows and columns of its argument. --- | For example, --- | --- | transpose ((1:2:3:Nil) : (4:5:6:Nil) : Nil) == --- | ((1:4:Nil) : (2:5:Nil) : (3:6:Nil) : Nil) --- | --- | If some of the rows are shorter than the following rows, their elements are skipped: --- | --- | transpose ((10:11:Nil) : (20:Nil) : Nil : (30:31:32:Nil) : Nil) == --- | ((10:20:30:Nil) : (11:31:Nil) : (32:Nil) : Nil) -transpose :: forall a. List (List a) -> List (List a) -transpose Nil = Nil -transpose (Nil : xss) = transpose xss -transpose ((x : xs) : xss) = - (x : mapMaybe head xss) : transpose (xs : mapMaybe tail xss) - --------------------------------------------------------------------------------- --- Folding --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Perform a fold using a monadic step function. -foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> List a -> m b -foldM _ b Nil = pure b -foldM f b (a : as) = f b a >>= \b' -> foldM f b' as diff --git a/stdlib/lib/Data/List/Internal.purs b/stdlib/lib/Data/List/Internal.purs deleted file mode 100644 index 5f5c950d..00000000 --- a/stdlib/lib/Data/List/Internal.purs +++ /dev/null @@ -1,63 +0,0 @@ -module Data.List.Internal (Set, emptySet, insertAndLookupBy) where - -import Prelude - -import Data.List.Types (List(..)) - -data Set k - = Leaf - | Two (Set k) k (Set k) - | Three (Set k) k (Set k) k (Set k) - -emptySet :: forall k. Set k -emptySet = Leaf - -data TreeContext k - = TwoLeft k (Set k) - | TwoRight (Set k) k - | ThreeLeft k (Set k) k (Set k) - | ThreeMiddle (Set k) k k (Set k) - | ThreeRight (Set k) k (Set k) k - -fromZipper :: forall k. List (TreeContext k) -> Set k -> Set k -fromZipper Nil tree = tree -fromZipper (Cons x ctx) tree = - case x of - TwoLeft k1 right -> fromZipper ctx (Two tree k1 right) - TwoRight left k1 -> fromZipper ctx (Two left k1 tree) - ThreeLeft k1 mid k2 right -> fromZipper ctx (Three tree k1 mid k2 right) - ThreeMiddle left k1 k2 right -> fromZipper ctx (Three left k1 tree k2 right) - ThreeRight left k1 mid k2 -> fromZipper ctx (Three left k1 mid k2 tree) - -data KickUp k = KickUp (Set k) k (Set k) - --- | Insert or replace a key/value pair in a map -insertAndLookupBy :: forall k. (k -> k -> Ordering) -> k -> Set k -> { found :: Boolean, result :: Set k } -insertAndLookupBy comp k orig = down Nil orig - where - down :: List (TreeContext k) -> Set k -> { found :: Boolean, result :: Set k } - down ctx Leaf = { found: false, result: up ctx (KickUp Leaf k Leaf) } - down ctx (Two left k1 right) = - case comp k k1 of - EQ -> { found: true, result: orig } - LT -> down (Cons (TwoLeft k1 right) ctx) left - _ -> down (Cons (TwoRight left k1) ctx) right - down ctx (Three left k1 mid k2 right) = - case comp k k1 of - EQ -> { found: true, result: orig } - c1 -> - case c1, comp k k2 of - _ , EQ -> { found: true, result: orig } - LT, _ -> down (Cons (ThreeLeft k1 mid k2 right) ctx) left - GT, LT -> down (Cons (ThreeMiddle left k1 k2 right) ctx) mid - _ , _ -> down (Cons (ThreeRight left k1 mid k2) ctx) right - - up :: List (TreeContext k) -> KickUp k -> Set k - up Nil (KickUp left k' right) = Two left k' right - up (Cons x ctx) kup = - case x, kup of - TwoLeft k1 right, KickUp left k' mid -> fromZipper ctx (Three left k' mid k1 right) - TwoRight left k1, KickUp mid k' right -> fromZipper ctx (Three left k1 mid k' right) - ThreeLeft k1 c k2 d, KickUp a k' b -> up ctx (KickUp (Two a k' b) k1 (Two c k2 d)) - ThreeMiddle a k1 k2 d, KickUp b k' c -> up ctx (KickUp (Two a k1 b) k' (Two c k2 d)) - ThreeRight a k1 b k2, KickUp c k' d -> up ctx (KickUp (Two a k1 b) k2 (Two c k' d)) diff --git a/stdlib/lib/Data/List/Lazy.purs b/stdlib/lib/Data/List/Lazy.purs deleted file mode 100644 index 8821753e..00000000 --- a/stdlib/lib/Data/List/Lazy.purs +++ /dev/null @@ -1,780 +0,0 @@ --- | This module defines a type of _lazy_ linked lists, and associated helper --- | functions and type class instances. --- | --- | _Note_: Depending on your use-case, you may prefer to use --- | `Data.Sequence` instead, which might give better performance for certain --- | use cases. This module is an improvement over `Data.Array` when working with --- | immutable lists of data in a purely-functional setting, but does not have --- | good random-access performance. - -module Data.List.Lazy - ( module Data.List.Lazy.Types - , toUnfoldable - , fromFoldable - - , singleton - , (..), range - , replicate - , replicateM - , some - , many - , repeat - , iterate - , cycle - - , null - , length - - , snoc - , insert - , insertBy - - , head - , last - , tail - , init - , uncons - - , (!!), index - , elemIndex - , elemLastIndex - , findIndex - , findLastIndex - , insertAt - , deleteAt - , updateAt - , modifyAt - , alterAt - - , reverse - , concat - , concatMap - , filter - , filterM - , mapMaybe - , catMaybes - - -- , sort - -- , sortBy - - , Pattern(..) - , stripPrefix - , slice - , take - , takeWhile - , drop - , dropWhile - , span - , group - -- , group' - , groupBy - , partition - - , nub - , nubBy - , nubEq - , nubByEq - , union - , unionBy - , delete - , deleteBy - , (\\), difference - , intersect - , intersectBy - - , zipWith - , zipWithA - , zip - , unzip - - , transpose - - , foldM - , foldrLazy - , scanlLazy - - , module Exports - ) where - -import Prelude - -import Control.Alt ((<|>)) -import Control.Alternative (class Alternative) -import Control.Lazy as Z -import Control.Monad.Rec.Class as Rec -import Data.Foldable (class Foldable, foldr, any, foldl) -import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports -import Data.Lazy (defer) -import Data.List.Internal (emptySet, insertAndLookupBy) -import Data.List.Lazy.Types (List(..), Step(..), step, nil, cons, (:)) -import Data.List.Lazy.Types (NonEmptyList(..)) as NEL -import Data.Maybe (Maybe(..), isNothing) -import Data.Newtype (class Newtype, unwrap) -import Data.NonEmpty ((:|)) -import Data.Traversable (scanl, scanr) as Exports -import Data.Traversable (sequence) -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, unfoldr) - --- | Convert a list into any unfoldable structure. --- | --- | Running time: `O(n)` -toUnfoldable :: forall f. Unfoldable f => List ~> f -toUnfoldable = unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> uncons xs) - --- | Construct a list from a foldable structure. --- | --- | Running time: `O(n)` -fromFoldable :: forall f. Foldable f => f ~> List -fromFoldable = foldr cons nil - -fromStep :: forall a. Step a -> List a -fromStep = List <<< pure - --------------------------------------------------------------------------------- --- List creation --------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Create a list with a single element. --- | --- | Running time: `O(1)` -singleton :: forall a. a -> List a -singleton a = cons a nil - --- | An infix synonym for `range`. -infix 8 range as .. - --- | Create a list containing a range of integers, including both endpoints. -range :: Int -> Int -> List Int -range start end - | start > end = - let g x | x >= end = Just (Tuple x (x - 1)) - | otherwise = Nothing - in unfoldr g start - | otherwise = unfoldr f start - where - f x | x <= end = Just (Tuple x (x + 1)) - | otherwise = Nothing - --- | Create a list with repeated instances of a value. -replicate :: forall a. Int -> a -> List a -replicate i xs = take i (repeat xs) - --- | Perform a monadic action `n` times collecting all of the results. -replicateM :: forall m a. Monad m => Int -> m a -> m (List a) -replicateM n m - | n < one = pure nil - | otherwise = do - a <- m - as <- replicateM (n - one) m - pure (cons a as) - --- | Attempt a computation multiple times, requiring at least one success. --- | --- | The `Lazy` constraint is used to generate the result lazily, to ensure --- | termination. -some :: forall f a. Alternative f => Z.Lazy (f (List a)) => f a -> f (List a) -some v = cons <$> v <*> Z.defer (\_ -> many v) - --- | Attempt a computation multiple times, returning as many successful results --- | as possible (possibly zero). --- | --- | The `Lazy` constraint is used to generate the result lazily, to ensure --- | termination. -many :: forall f a. Alternative f => Z.Lazy (f (List a)) => f a -> f (List a) -many v = some v <|> pure nil - --- | Create a list by repeating an element -repeat :: forall a. a -> List a -repeat x = Z.fix \xs -> cons x xs - --- | Create a list by iterating a function -iterate :: forall a. (a -> a) -> a -> List a -iterate f x = Z.fix \xs -> cons x (f <$> xs) - --- | Create a list by repeating another list -cycle :: forall a. List a -> List a -cycle xs = Z.fix \ys -> xs <> ys - --------------------------------------------------------------------------------- --- List size ------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Test whether a list is empty. --- | --- | Running time: `O(1)` -null :: forall a. List a -> Boolean -null = isNothing <<< uncons - --- | Get the length of a list --- | --- | Running time: `O(n)` -length :: forall a. List a -> Int -length = foldl (\l _ -> l + 1) 0 - --------------------------------------------------------------------------------- --- Extending lists ------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Append an element to the end of a list, creating a new list. --- | --- | Running time: `O(n)` -snoc :: forall a. List a -> a -> List a -snoc xs x = foldr cons (cons x nil) xs - --- | Insert an element into a sorted list. --- | --- | Running time: `O(n)` -insert :: forall a. Ord a => a -> List a -> List a -insert = insertBy compare - --- | Insert an element into a sorted list, using the specified function to determine the ordering --- | of elements. --- | --- | Running time: `O(n)` -insertBy :: forall a. (a -> a -> Ordering) -> a -> List a -> List a -insertBy cmp x xs = List (go <$> unwrap xs) - where - go Nil = Cons x nil - go ys@(Cons y ys') = - case cmp x y of - GT -> Cons y (insertBy cmp x ys') - _ -> Cons x (fromStep ys) - --------------------------------------------------------------------------------- --- Non-indexed reads ----------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Get the first element in a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(1)`. -head :: List ~> Maybe -head xs = _.head <$> uncons xs - --- | Get the last element in a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(n)`. -last :: List ~> Maybe -last = go <<< step - where - go (Cons x xs) - | null xs = Just x - | otherwise = go (step xs) - go _ = Nothing - --- | Get all but the first element of a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(1)` -tail :: forall a. List a -> Maybe (List a) -tail xs = _.tail <$> uncons xs - --- | Get all but the last element of a list, or `Nothing` if the list is empty. --- | --- | Running time: `O(n)` -init :: forall a. List a -> Maybe (List a) -init = go <<< step - where - go :: Step a -> Maybe (List a) - go (Cons x xs) - | null xs = Just nil - | otherwise = cons x <$> go (step xs) - go _ = Nothing - --- | Break a list into its first element, and the remaining elements, --- | or `Nothing` if the list is empty. --- | --- | Running time: `O(1)` -uncons :: forall a. List a -> Maybe { head :: a, tail :: List a } -uncons xs = case step xs of - Nil -> Nothing - Cons x xs' -> Just { head: x, tail: xs' } - --------------------------------------------------------------------------------- --- Indexed operations ---------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Get the element at the specified index, or `Nothing` if the index is out-of-bounds. --- | --- | Running time: `O(n)` where `n` is the required index. -index :: forall a. List a -> Int -> Maybe a -index xs = go (step xs) - where - go Nil _ = Nothing - go (Cons a _) 0 = Just a - go (Cons _ as) i = go (step as) (i - 1) - --- | An infix synonym for `index`. -infixl 8 index as !! - --- | Find the index of the first element equal to the specified element. -elemIndex :: forall a. Eq a => a -> List a -> Maybe Int -elemIndex x = findIndex (_ == x) - --- | Find the index of the last element equal to the specified element. -elemLastIndex :: forall a. Eq a => a -> List a -> Maybe Int -elemLastIndex x = findLastIndex (_ == x) - --- | Find the first index for which a predicate holds. -findIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int -findIndex fn = go 0 - where - go :: Int -> List a -> Maybe Int - go n list = do - o <- uncons list - if fn o.head - then pure n - else go (n + 1) o.tail - --- | Find the last index for which a predicate holds. -findLastIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int -findLastIndex fn xs = ((length xs - 1) - _) <$> findIndex fn (reverse xs) - --- | Insert an element into a list at the specified index, or append the element --- | to the end of the list if the index is out-of-bounds, returning a new list. --- | --- | Running time: `O(n)` -insertAt :: forall a. Int -> a -> List a -> List a -insertAt 0 x xs = cons x xs -insertAt n x xs = List (go <$> unwrap xs) - where - go Nil = Cons x nil - go (Cons y ys) = Cons y (insertAt (n - 1) x ys) - --- | Delete an element from a list at the specified index, returning a new list, --- | or return the original list unchanged if the index is out-of-bounds. --- | --- | Running time: `O(n)` -deleteAt :: forall a. Int -> List a -> List a -deleteAt n xs = List (go n <$> unwrap xs) - where - go _ Nil = Nil - go 0 (Cons _ ys) = step ys - go n' (Cons y ys) = Cons y (deleteAt (n' - 1) ys) - --- | Update the element at the specified index, returning a new list, --- | or return the original list unchanged if the index is out-of-bounds. --- | --- | Running time: `O(n)` -updateAt :: forall a. Int -> a -> List a -> List a -updateAt n x xs = List (go n <$> unwrap xs) - where - go _ Nil = Nil - go 0 (Cons _ ys) = Cons x ys - go n' (Cons y ys) = Cons y (updateAt (n' - 1) x ys) - --- | Update the element at the specified index by applying a function to --- | the current value, returning a new list, or return the original list unchanged --- | if the index is out-of-bounds. --- | --- | Running time: `O(n)` -modifyAt :: forall a. Int -> (a -> a) -> List a -> List a -modifyAt n f = alterAt n (Just <<< f) - --- | Update or delete the element at the specified index by applying a --- | function to the current value, returning a new list, or return the --- | original list unchanged if the index is out-of-bounds. --- | --- | Running time: `O(n)` -alterAt :: forall a. Int -> (a -> Maybe a) -> List a -> List a -alterAt n f xs = List (go n <$> unwrap xs) - where - go _ Nil = Nil - go 0 (Cons y ys) = case f y of - Nothing -> step ys - Just y' -> Cons y' ys - go n' (Cons y ys) = Cons y (alterAt (n' - 1) f ys) - --------------------------------------------------------------------------------- --- Transformations ------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Reverse a list. --- | --- | Running time: `O(n)` -reverse :: List ~> List -reverse xs = Z.defer \_ -> foldl (flip cons) nil xs - --- | Flatten a list of lists. --- | --- | Running time: `O(n)`, where `n` is the total number of elements. -concat :: forall a. List (List a) -> List a -concat = (_ >>= identity) - --- | Apply a function to each element in a list, and flatten the results --- | into a single, new list. --- | --- | Running time: `O(n)`, where `n` is the total number of elements. -concatMap :: forall a b. (a -> List b) -> List a -> List b -concatMap = flip bind - --- | Filter a list, keeping the elements which satisfy a predicate function. --- | --- | Running time: `O(n)` -filter :: forall a. (a -> Boolean) -> List a -> List a -filter p = List <<< map go <<< unwrap - where - go Nil = Nil - go (Cons x xs) - | p x = Cons x (filter p xs) - | otherwise = go (step xs) - --- | Filter where the predicate returns a monadic `Boolean`. --- | --- | For example: --- | --- | ```purescript --- | powerSet :: forall a. [a] -> [[a]] --- | powerSet = filterM (const [true, false]) --- | ``` -filterM :: forall a m. Monad m => (a -> m Boolean) -> List a -> m (List a) -filterM p list = - case uncons list of - Nothing -> pure nil - Just { head: x, tail: xs } -> do - b <- p x - xs' <- filterM p xs - pure if b then cons x xs' else xs' - - --- | Apply a function to each element in a list, keeping only the results which --- | contain a value. --- | --- | Running time: `O(n)` -mapMaybe :: forall a b. (a -> Maybe b) -> List a -> List b -mapMaybe f = List <<< map go <<< unwrap - where - go Nil = Nil - go (Cons x xs) = - case f x of - Nothing -> go (step xs) - Just y -> Cons y (mapMaybe f xs) - --- | Filter a list of optional values, keeping only the elements which contain --- | a value. -catMaybes :: forall a. List (Maybe a) -> List a -catMaybes = mapMaybe identity - --------------------------------------------------------------------------------- --- Sorting --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- Sublists -------------------------------------------------------------------- --------------------------------------------------------------------------------- - - --- | A newtype used in cases where there is a list to be matched. -newtype Pattern a = Pattern (List a) - -derive instance eqPattern :: Eq a => Eq (Pattern a) -derive instance ordPattern :: Ord a => Ord (Pattern a) -derive instance newtypePattern :: Newtype (Pattern a) _ - -instance showPattern :: Show a => Show (Pattern a) where - show (Pattern s) = "(Pattern " <> show s <> ")" - - --- | If the list starts with the given prefix, return the portion of the --- | list left after removing it, as a Just value. Otherwise, return Nothing. --- | * `stripPrefix (Pattern (fromFoldable [1])) (fromFoldable [1,2]) == Just (fromFoldable [2])` --- | * `stripPrefix (Pattern (fromFoldable [])) (fromFoldable [1]) == Just (fromFoldable [1])` --- | * `stripPrefix (Pattern (fromFoldable [2])) (fromFoldable [1]) == Nothing` --- | --- | Running time: `O(n)` where `n` is the number of elements to strip. -stripPrefix :: forall a. Eq a => Pattern a -> List a -> Maybe (List a) -stripPrefix (Pattern p') s = Rec.tailRecM2 go p' s - where - go prefix input = case step prefix of - Nil -> Just $ Rec.Done input - Cons p ps -> case step input of - Cons i is | p == i -> Just $ Rec.Loop { a: ps, b: is } - _ -> Nothing - --- | Extract a sublist by a start and end index. -slice :: Int -> Int -> List ~> List -slice start end xs = take (end - start) (drop start xs) - --- | Take the specified number of elements from the front of a list. --- | --- | Running time: `O(n)` where `n` is the number of elements to take. -take :: forall a. Int -> List a -> List a -take n = if n <= 0 - then const nil - else List <<< map (go n) <<< unwrap - where - go :: Int -> Step a -> Step a - go _ Nil = Nil - go n' (Cons x xs) = Cons x (take (n' - 1) xs) - --- | Take those elements from the front of a list which match a predicate. --- | --- | Running time (worst case): `O(n)` -takeWhile :: forall a. (a -> Boolean) -> List a -> List a -takeWhile p = List <<< map go <<< unwrap - where - go (Cons x xs) | p x = Cons x (takeWhile p xs) - go _ = Nil - --- | Drop the specified number of elements from the front of a list. --- | --- | Running time: `O(n)` where `n` is the number of elements to drop. -drop :: forall a. Int -> List a -> List a -drop n = List <<< map (go n) <<< unwrap - where - go 0 xs = xs - go _ Nil = Nil - go n' (Cons _ xs) = go (n' - 1) (step xs) - --- | Drop those elements from the front of a list which match a predicate. --- | --- | Running time (worst case): `O(n)` -dropWhile :: forall a. (a -> Boolean) -> List a -> List a -dropWhile p = go <<< step - where - go (Cons x xs) | p x = go (step xs) - go xs = fromStep xs - --- | Split a list into two parts: --- | --- | 1. the longest initial segment for which all elements satisfy the specified predicate --- | 2. the remaining elements --- | --- | For example, --- | --- | ```purescript --- | span (\n -> n % 2 == 1) (1 : 3 : 2 : 4 : 5 : Nil) == Tuple (1 : 3 : Nil) (2 : 4 : 5 : Nil) --- | ``` --- | --- | Running time: `O(n)` -span :: forall a. (a -> Boolean) -> List a -> { init :: List a, rest :: List a } -span p xs = - case uncons xs of - Just { head: x, tail: xs' } | p x -> - case span p xs' of - { init: ys, rest: zs } -> { init: cons x ys, rest: zs } - _ -> { init: nil, rest: xs } - --- | Group equal, consecutive elements of a list into lists. --- | --- | For example, --- | --- | ```purescript --- | group (1 : 1 : 2 : 2 : 1 : Nil) == (1 : 1 : Nil) : (2 : 2 : Nil) : (1 : Nil) : Nil --- | ``` --- | --- | Running time: `O(n)` -group :: forall a. Eq a => List a -> List (NEL.NonEmptyList a) -group = groupBy (==) - --- | Group equal, consecutive elements of a list into lists, using the specified --- | equivalence relation to determine equality. --- | --- | Running time: `O(n)` -groupBy :: forall a. (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) -groupBy eq = List <<< map go <<< unwrap - where - go Nil = Nil - go (Cons x xs) = - case span (eq x) xs of - { init: ys, rest: zs } -> - Cons (NEL.NonEmptyList (defer \_ -> x :| ys)) (groupBy eq zs) - --- | Returns a tuple of lists of elements which do --- | and do not satisfy a predicate, respectively. --- | --- | Running time: `O(n)` -partition :: forall a. (a -> Boolean) -> List a -> { yes :: List a, no :: List a } -partition f = foldr go {yes: nil, no: nil} - where - go x {yes: ys, no: ns} = - if f x then {yes: x : ys, no: ns} else {yes: ys, no: x : ns} - --------------------------------------------------------------------------------- --- Set-like operations --------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Remove duplicate elements from a list. --- | Keeps the first occurrence of each element in the input list, --- | in the same order they appear in the input list. --- | --- | Running time: `O(n log n)` -nub :: forall a. Ord a => List a -> List a -nub = nubBy compare - --- | Remove duplicate elements from a list based on the provided comparison function. --- | Keeps the first occurrence of each element in the input list, --- | in the same order they appear in the input list. --- | --- | Running time: `O(n log n)` -nubBy :: forall a. (a -> a -> Ordering) -> List a -> List a -nubBy p = go emptySet - where - go s (List l) = List (map (goStep s) l) - goStep _ Nil = Nil - goStep s (Cons a as) = - let { found, result: s' } = insertAndLookupBy p a s - in if found - then step (go s' as) - else Cons a (go s' as) - --- | Remove duplicate elements from a list. --- | --- | Running time: `O(n^2)` -nubEq :: forall a. Eq a => List a -> List a -nubEq = nubByEq eq - --- | Remove duplicate elements from a list, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n^2)` -nubByEq :: forall a. (a -> a -> Boolean) -> List a -> List a -nubByEq eq = List <<< map go <<< unwrap - where - go Nil = Nil - go (Cons x xs) = Cons x (nubByEq eq (filter (\y -> not (eq x y)) xs)) - --- | Calculate the union of two lists. --- | --- | Running time: `O(n^2)` -union :: forall a. Eq a => List a -> List a -> List a -union = unionBy (==) - --- | Calculate the union of two lists, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n^2)` -unionBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a -unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs - --- | Delete the first occurrence of an element from a list. --- | --- | Running time: `O(n)` -delete :: forall a. Eq a => a -> List a -> List a -delete = deleteBy (==) - --- | Delete the first occurrence of an element from a list, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n)` -deleteBy :: forall a. (a -> a -> Boolean) -> a -> List a -> List a -deleteBy eq x xs = List (go <$> unwrap xs) - where - go Nil = Nil - go (Cons y ys) | eq x y = step ys - | otherwise = Cons y (deleteBy eq x ys) - --- | Delete the first occurrence of each element in the second list from the first list. --- | --- | Running time: `O(n^2)` -difference :: forall a. Eq a => List a -> List a -> List a -difference = foldl (flip delete) -infix 5 difference as \\ - --- | Calculate the intersection of two lists. --- | --- | Running time: `O(n^2)` -intersect :: forall a. Eq a => List a -> List a -> List a -intersect = intersectBy (==) - --- | Calculate the intersection of two lists, using the specified --- | function to determine equality of elements. --- | --- | Running time: `O(n^2)` -intersectBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a -intersectBy eq xs ys = filter (\x -> any (eq x) ys) xs - --------------------------------------------------------------------------------- --- Zipping --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Apply a function to pairs of elements at the same positions in two lists, --- | collecting the results in a new list. --- | --- | If one list is longer, elements will be discarded from the longer list. --- | --- | For example --- | --- | ```purescript --- | zipWith (*) (1 : 2 : 3 : Nil) (4 : 5 : 6 : 7 Nil) == 4 : 10 : 18 : Nil --- | ``` --- | --- | Running time: `O(min(m, n))` -zipWith :: forall a b c. (a -> b -> c) -> List a -> List b -> List c -zipWith f xs ys = List (go <$> unwrap xs <*> unwrap ys) - where - go :: Step a -> Step b -> Step c - go Nil _ = Nil - go _ Nil = Nil - go (Cons a as) (Cons b bs) = Cons (f a b) (zipWith f as bs) - --- | A generalization of `zipWith` which accumulates results in some `Applicative` --- | functor. -zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> List a -> List b -> m (List c) -zipWithA f xs ys = sequence (zipWith f xs ys) - --- | Collect pairs of elements at the same positions in two lists. --- | --- | Running time: `O(min(m, n))` -zip :: forall a b. List a -> List b -> List (Tuple a b) -zip = zipWith Tuple - --- | Transforms a list of pairs into a list of first components and a list of --- | second components. -unzip :: forall a b. List (Tuple a b) -> Tuple (List a) (List b) -unzip = foldr (\(Tuple a b) (Tuple as bs) -> Tuple (cons a as) (cons b bs)) (Tuple nil nil) - --------------------------------------------------------------------------------- --- Transpose ------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | The 'transpose' function transposes the rows and columns of its argument. --- | For example, --- | --- | transpose ((1:2:3:nil) : (4:5:6:nil) : nil) == --- | ((1:4:nil) : (2:5:nil) : (3:6:nil) : nil) --- | --- | If some of the rows are shorter than the following rows, their elements are skipped: --- | --- | transpose ((10:11:nil) : (20:nil) : nil : (30:31:32:nil) : nil) == --- | ((10:20:30:nil) : (11:31:nil) : (32:nil) : nil) -transpose :: forall a. List (List a) -> List (List a) -transpose xs = - case uncons xs of - Nothing -> - xs - Just { head: h, tail: xss } -> - case uncons h of - Nothing -> - transpose xss - Just { head: x, tail: xs' } -> - (x : mapMaybe head xss) : transpose (xs' : mapMaybe tail xss) - --------------------------------------------------------------------------------- --- Folding --------------------------------------------------------------------- --------------------------------------------------------------------------------- - --- | Perform a fold using a monadic step function. -foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> List a -> m b -foldM f b xs = - case uncons xs of - Nothing -> pure b - Just { head: a, tail: as } -> - f b a >>= \b' -> foldM f b' as - --- | Perform a right fold lazily -foldrLazy :: forall a b. Z.Lazy b => (a -> b -> b) -> b -> List a -> b -foldrLazy op z = go - where - go xs = case step xs of - Cons x xs' -> Z.defer \_ -> x `op` go xs' - Nil -> z - --- | Perform a left scan lazily -scanlLazy :: forall a b. (b -> a -> b) -> b -> List a -> List b -scanlLazy f acc xs = List (go <$> unwrap xs) - where - go :: Step a -> Step b - go Nil = Nil - go (Cons x xs') = - let acc' = f acc x - in Cons acc' $ scanlLazy f acc' xs' diff --git a/stdlib/lib/Data/List/Lazy/NonEmpty.purs b/stdlib/lib/Data/List/Lazy/NonEmpty.purs deleted file mode 100644 index d5d207df..00000000 --- a/stdlib/lib/Data/List/Lazy/NonEmpty.purs +++ /dev/null @@ -1,88 +0,0 @@ -module Data.List.Lazy.NonEmpty - ( module Data.List.Lazy.Types - , toUnfoldable - , fromFoldable - , fromList - , toList - , singleton - , repeat - , iterate - , head - , last - , tail - , init - , cons - , uncons - , length - , concatMap - , appendFoldable - ) where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Lazy (force, defer) -import Data.List.Lazy ((:)) -import Data.List.Lazy as L -import Data.List.Lazy.Types (NonEmptyList(..)) -import Data.Maybe (Maybe(..), maybe, fromMaybe) -import Data.NonEmpty ((:|)) -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, unfoldr) - -toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f -toUnfoldable = - unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> L.uncons xs) <<< toList - -fromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyList a) -fromFoldable = fromList <<< L.fromFoldable - -fromList :: forall a. L.List a -> Maybe (NonEmptyList a) -fromList l = - case L.step l of - L.Nil -> Nothing - L.Cons x xs -> Just (NonEmptyList (defer \_ -> x :| xs)) - -toList :: NonEmptyList ~> L.List -toList (NonEmptyList nel) = case force nel of x :| xs -> x : xs - -singleton :: forall a. a -> NonEmptyList a -singleton = pure - -repeat :: forall a. a -> NonEmptyList a -repeat x = NonEmptyList $ defer \_ -> x :| L.repeat x - -iterate :: forall a. (a -> a) -> a -> NonEmptyList a -iterate f x = NonEmptyList $ defer \_ -> x :| L.iterate f (f x) - -head :: forall a. NonEmptyList a -> a -head (NonEmptyList nel) = case force nel of x :| _ -> x - -last :: forall a. NonEmptyList a -> a -last (NonEmptyList nel) = case force nel of x :| xs -> fromMaybe x (L.last xs) - -tail :: NonEmptyList ~> L.List -tail (NonEmptyList nel) = case force nel of _ :| xs -> xs - -init :: NonEmptyList ~> L.List -init (NonEmptyList nel) = - case force nel of - x :| xs -> - maybe L.nil (x : _) (L.init xs) - -cons :: forall a. a -> NonEmptyList a -> NonEmptyList a -cons y (NonEmptyList nel) = - NonEmptyList (defer \_ -> case force nel of x :| xs -> y :| x : xs) - -uncons :: forall a. NonEmptyList a -> { head :: a, tail :: L.List a } -uncons (NonEmptyList nel) = case force nel of x :| xs -> { head: x, tail: xs } - -length :: forall a. NonEmptyList a -> Int -length (NonEmptyList nel) = case force nel of _ :| xs -> 1 + L.length xs - -concatMap :: forall a b. (a -> NonEmptyList b) -> NonEmptyList a -> NonEmptyList b -concatMap = flip bind - -appendFoldable :: forall t a. Foldable t => NonEmptyList a -> t a -> NonEmptyList a -appendFoldable nel ys = - NonEmptyList (defer \_ -> head nel :| tail nel <> L.fromFoldable ys) diff --git a/stdlib/lib/Data/List/Lazy/Types.purs b/stdlib/lib/Data/List/Lazy/Types.purs deleted file mode 100644 index 6a4163b1..00000000 --- a/stdlib/lib/Data/List/Lazy/Types.purs +++ /dev/null @@ -1,295 +0,0 @@ -module Data.List.Lazy.Types where - -import Prelude - -import Control.Alt (class Alt) -import Control.Alternative (class Alternative) -import Control.Comonad (class Comonad) -import Control.Extend (class Extend) -import Control.Lazy as Z -import Control.MonadPlus (class MonadPlus) -import Control.Plus (class Plus) -import Data.Eq (class Eq1, eq1) -import Data.Foldable (class Foldable, foldMap, foldl, foldr) -import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndex) -import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) -import Data.Lazy (Lazy, defer, force) -import Data.Maybe (Maybe(..), maybe) -import Data.Newtype (class Newtype, unwrap) -import Data.NonEmpty (NonEmpty, (:|)) -import Data.NonEmpty as NE -import Data.Ord (class Ord1, compare1) -import Data.Traversable (class Traversable, traverse, sequence) -import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) -import Data.Tuple (Tuple(..), snd) -import Data.Unfoldable (class Unfoldable, unfoldr1) -import Data.Unfoldable1 (class Unfoldable1) - --- | A lazy linked list. -newtype List a = List (Lazy (Step a)) - --- | A list is either empty (represented by the `Nil` constructor) or non-empty, in --- | which case it consists of a head element, and another list (represented by the --- | `Cons` constructor). -data Step a = Nil | Cons a (List a) - -instance showStep :: Show a => Show (Step a) where - show Nil = "Nil" - show (Cons x xs) = "(" <> show x <> " : " <> show xs <> ")" - --- | Unwrap a lazy linked list -step :: forall a. List a -> Step a -step = force <<< unwrap - --- | The empty list. --- | --- | Running time: `O(1)` -nil :: forall a. List a -nil = List $ defer \_ -> Nil - --- | Attach an element to the front of a lazy list. --- | --- | Running time: `O(1)` -cons :: forall a. a -> List a -> List a -cons x xs = List $ defer \_ -> Cons x xs - --- | An infix alias for `cons`; attaches an element to the front of --- | a list. --- | --- | Running time: `O(1)` -infixr 6 cons as : - -derive instance newtypeList :: Newtype (List a) _ - -instance showList :: Show a => Show (List a) where - show xs = "(fromFoldable [" - <> case step xs of - Nil -> "" - Cons x xs' -> - show x <> foldl (\shown x' -> shown <> "," <> show x') "" xs' - <> "])" - -instance eqList :: Eq a => Eq (List a) where - eq = eq1 - -instance eq1List :: Eq1 List where - eq1 xs ys = go (step xs) (step ys) - where - go Nil Nil = true - go (Cons x xs') (Cons y ys') - | x == y = go (step xs') (step ys') - go _ _ = false - -instance ordList :: Ord a => Ord (List a) where - compare = compare1 - -instance ord1List :: Ord1 List where - compare1 xs ys = go (step xs) (step ys) - where - go Nil Nil = EQ - go Nil _ = LT - go _ Nil = GT - go (Cons x xs') (Cons y ys') = - case compare x y of - EQ -> go (step xs') (step ys') - other -> other - -instance lazyList :: Z.Lazy (List a) where - defer f = List $ defer (step <<< f) - -instance semigroupList :: Semigroup (List a) where - append xs ys = List (go <$> unwrap xs) - where - go Nil = step ys - go (Cons x xs') = Cons x (xs' <> ys) - -instance monoidList :: Monoid (List a) where - mempty = nil - -instance functorList :: Functor List where - map f xs = List (go <$> unwrap xs) - where - go Nil = Nil - go (Cons x xs') = Cons (f x) (f <$> xs') - -instance functorWithIndexList :: FunctorWithIndex Int List where - mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) nil - -instance foldableList :: Foldable List where - -- calls foldl on the reversed list - foldr op z xs = foldl (flip op) z (rev xs) where - rev = foldl (flip cons) nil - - foldl op = go - where - -- `go` is needed to ensure the function is tail-call optimized - go b xs = - case step xs of - Nil -> b - Cons hd tl -> go (b `op` hd) tl - - foldMap f = foldl (\b a -> b <> f a) mempty - -instance foldableWithIndexList :: FoldableWithIndex Int List where - foldrWithIndex f b xs = - -- as we climb the reversed list, we decrement the index - snd $ foldl - (\(Tuple i b') a -> Tuple (i - 1) (f (i - 1) a b')) - (Tuple len b) - revList - where - Tuple len revList = rev (Tuple 0 nil) xs - where - -- As we create our reversed list, we count elements. - rev = foldl (\(Tuple i acc) a -> Tuple (i + 1) (a : acc)) - foldlWithIndex f acc = - snd <<< foldl (\(Tuple i b) a -> Tuple (i + 1) (f i b a)) (Tuple 0 acc) - foldMapWithIndex f = foldlWithIndex (\i acc -> append acc <<< f i) mempty - -instance unfoldable1List :: Unfoldable1 List where - unfoldr1 = go where - go f b = Z.defer \_ -> case f b of - Tuple a (Just b') -> a : go f b' - Tuple a Nothing -> a : nil - -instance unfoldableList :: Unfoldable List where - unfoldr = go where - go f b = Z.defer \_ -> case f b of - Nothing -> nil - Just (Tuple a b') -> a : go f b' - -instance traversableList :: Traversable List where - traverse f = - foldr (\a b -> cons <$> f a <*> b) (pure nil) - - sequence = traverse identity - -instance traversableWithIndexList :: TraversableWithIndex Int List where - traverseWithIndex f = - foldrWithIndex (\i a b -> cons <$> f i a <*> b) (pure nil) - -instance applyList :: Apply List where - apply = ap - -instance applicativeList :: Applicative List where - pure a = a : nil - -instance bindList :: Bind List where - bind xs f = List (go <$> unwrap xs) - where - go Nil = Nil - go (Cons x xs') = step (f x <> bind xs' f) - -instance monadList :: Monad List - -instance altList :: Alt List where - alt = append - -instance plusList :: Plus List where - empty = nil - -instance alternativeList :: Alternative List - -instance monadPlusList :: MonadPlus List - -instance extendList :: Extend List where - extend f l = - case step l of - Nil -> nil - Cons _ as -> - f l : (foldr go { val: nil, acc: nil } as).val - where - go a { val, acc } = - let acc' = a : acc - in { val: f acc' : val, acc: acc' } - -newtype NonEmptyList a = NonEmptyList (Lazy (NonEmpty List a)) - -toList :: NonEmptyList ~> List -toList (NonEmptyList nel) = Z.defer \_ -> - case force nel of x :| xs -> x : xs - -derive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _ - -derive newtype instance eqNonEmptyList :: Eq a => Eq (NonEmptyList a) -derive newtype instance ordNonEmptyList :: Ord a => Ord (NonEmptyList a) - -instance eq1NonEmptyList :: Eq1 NonEmptyList where - eq1 (NonEmptyList lhs) (NonEmptyList rhs) = eq1 lhs rhs - -instance ord1NonEmptyList :: Ord1 NonEmptyList where - compare1 (NonEmptyList lhs) (NonEmptyList rhs) = compare1 lhs rhs - -instance showNonEmptyList :: Show a => Show (NonEmptyList a) where - show (NonEmptyList nel) = "(NonEmptyList " <> show nel <> ")" - -instance functorNonEmptyList :: Functor NonEmptyList where - map f (NonEmptyList nel) = NonEmptyList (map f <$> nel) - -instance applyNonEmptyList :: Apply NonEmptyList where - apply (NonEmptyList nefs) (NonEmptyList neas) = - case force nefs, force neas of - f :| fs, a :| as -> - NonEmptyList (defer \_ -> f a :| (fs <*> a : nil) <> ((f : fs) <*> as)) - -instance applicativeNonEmptyList :: Applicative NonEmptyList where - pure a = NonEmptyList (defer \_ -> NE.singleton a) - -instance bindNonEmptyList :: Bind NonEmptyList where - bind (NonEmptyList nel) f = - case force nel of - a :| as -> - case force $ unwrap $ f a of - b :| bs -> - NonEmptyList (defer \_ -> b :| bs <> bind as (toList <<< f)) - -instance monadNonEmptyList :: Monad NonEmptyList - -instance altNonEmptyList :: Alt NonEmptyList where - alt = append - -instance extendNonEmptyList :: Extend NonEmptyList where - extend f w@(NonEmptyList nel) = - case force nel of - _ :| as -> - NonEmptyList $ defer \_ -> - f w :| (foldr go { val: nil, acc: nil } as).val - where - go a { val, acc } = - { val: f (NonEmptyList (defer \_ -> a :| acc)) : val - , acc: a : acc - } - -instance comonadNonEmptyList :: Comonad NonEmptyList where - extract (NonEmptyList nel) = NE.head $ force nel - -instance semigroupNonEmptyList :: Semigroup (NonEmptyList a) where - append (NonEmptyList neas) as' = - case force neas of - a :| as -> NonEmptyList (defer \_ -> a :| as <> toList as') - -instance foldableNonEmptyList :: Foldable NonEmptyList where - foldr f b (NonEmptyList nel) = foldr f b (force nel) - foldl f b (NonEmptyList nel) = foldl f b (force nel) - foldMap f (NonEmptyList nel) = foldMap f (force nel) - -instance traversableNonEmptyList :: Traversable NonEmptyList where - traverse f (NonEmptyList nel) = - map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ traverse f (force nel) - sequence (NonEmptyList nel) = - map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ sequence (force nel) - -instance unfoldable1NonEmptyList :: Unfoldable1 NonEmptyList where - unfoldr1 f b = NonEmptyList $ defer \_ -> unfoldr1 f b - -instance functorWithIndexNonEmptyList :: FunctorWithIndex Int NonEmptyList where - mapWithIndex f (NonEmptyList ne) = NonEmptyList $ defer \_ -> mapWithIndex (f <<< maybe 0 (add 1)) $ force ne - -instance foldableWithIndexNonEmptyList :: FoldableWithIndex Int NonEmptyList where - foldMapWithIndex f (NonEmptyList ne) = foldMapWithIndex (f <<< maybe 0 (add 1)) $ force ne - foldlWithIndex f b (NonEmptyList ne) = foldlWithIndex (f <<< maybe 0 (add 1)) b $ force ne - foldrWithIndex f b (NonEmptyList ne) = foldrWithIndex (f <<< maybe 0 (add 1)) b $ force ne - -instance traversableWithIndexNonEmptyList :: TraversableWithIndex Int NonEmptyList where - traverseWithIndex f (NonEmptyList ne) = - map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ traverseWithIndex (f <<< maybe 0 (add 1)) $ force ne diff --git a/stdlib/lib/Data/List/NonEmpty.purs b/stdlib/lib/Data/List/NonEmpty.purs deleted file mode 100644 index 42fa49ec..00000000 --- a/stdlib/lib/Data/List/NonEmpty.purs +++ /dev/null @@ -1,307 +0,0 @@ -module Data.List.NonEmpty - ( module Data.List.Types - , toUnfoldable - , fromFoldable - , fromList - , toList - , singleton - , length - , cons - , cons' - , snoc - , snoc' - , head - , last - , tail - , init - , uncons - , unsnoc - , (!!), index - , elemIndex - , elemLastIndex - , findIndex - , findLastIndex - , insertAt - , updateAt - , modifyAt - , reverse - , concat - , concatMap - , filter - , filterM - , mapMaybe - , catMaybes - , appendFoldable - , sort - , sortBy - , take - , takeWhile - , drop - , dropWhile - , span - , group - , groupAll - , groupBy - , groupAllBy - , partition - , nub - , nubBy - , nubEq - , nubByEq - , union - , unionBy - , intersect - , intersectBy - , zipWith - , zipWithA - , zip - , unzip - , foldM - , module Exports - ) where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.List ((:)) -import Data.List as L -import Data.List.Types (NonEmptyList(..)) -import Data.Maybe (Maybe(..), fromMaybe, maybe) -import Data.NonEmpty ((:|)) -import Data.NonEmpty as NE -import Data.Semigroup.Traversable (sequence1) -import Data.Tuple (Tuple(..), fst, snd) -import Data.Unfoldable (class Unfoldable, unfoldr) -import Partial.Unsafe (unsafeCrashWith) - -import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports -import Data.Semigroup.Foldable (fold1, foldMap1, for1_, sequence1_, traverse1_) as Exports -import Data.Semigroup.Traversable (sequence1, traverse1, traverse1Default) as Exports -import Data.Traversable (scanl, scanr) as Exports - --- | Internal function: any operation on a list that is guaranteed not to delete --- | all elements also applies to a NEL, this function is a helper for defining --- | those cases. -wrappedOperation - :: forall a b - . String - -> (L.List a -> L.List b) - -> NonEmptyList a - -> NonEmptyList b -wrappedOperation name f (NonEmptyList (x :| xs)) = - case f (x : xs) of - x' : xs' -> NonEmptyList (x' :| xs') - L.Nil -> unsafeCrashWith ("Impossible: empty list in NonEmptyList " <> name) - --- | Like `wrappedOperation`, but for functions that operate on 2 lists. -wrappedOperation2 - :: forall a b c - . String - -> (L.List a -> L.List b -> L.List c) - -> NonEmptyList a - -> NonEmptyList b - -> NonEmptyList c -wrappedOperation2 name f (NonEmptyList (x :| xs)) (NonEmptyList (y :| ys)) = - case f (x : xs) (y : ys) of - x' : xs' -> NonEmptyList (x' :| xs') - L.Nil -> unsafeCrashWith ("Impossible: empty list in NonEmptyList " <> name) - --- | Lifts a function that operates on a list to work on a NEL. This does not --- | preserve the non-empty status of the result. -lift :: forall a b. (L.List a -> b) -> NonEmptyList a -> b -lift f (NonEmptyList (x :| xs)) = f (x : xs) - -toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f -toUnfoldable = - unfoldr (\xs -> (\rec -> Tuple rec.head rec.tail) <$> L.uncons xs) <<< toList - -fromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyList a) -fromFoldable = fromList <<< L.fromFoldable - -fromList :: forall a. L.List a -> Maybe (NonEmptyList a) -fromList L.Nil = Nothing -fromList (x : xs) = Just (NonEmptyList (x :| xs)) - -toList :: NonEmptyList ~> L.List -toList (NonEmptyList (x :| xs)) = x : xs - -singleton :: forall a. a -> NonEmptyList a -singleton = NonEmptyList <<< NE.singleton - -cons :: forall a. a -> NonEmptyList a -> NonEmptyList a -cons y (NonEmptyList (x :| xs)) = NonEmptyList (y :| x : xs) - -cons' :: forall a. a -> L.List a -> NonEmptyList a -cons' x xs = NonEmptyList (x :| xs) - -snoc :: forall a. NonEmptyList a -> a -> NonEmptyList a -snoc (NonEmptyList (x :| xs)) y = NonEmptyList (x :| L.snoc xs y) - -snoc' :: forall a. L.List a -> a -> NonEmptyList a -snoc' (x : xs) y = NonEmptyList (x :| L.snoc xs y) -snoc' L.Nil y = singleton y - -head :: forall a. NonEmptyList a -> a -head (NonEmptyList (x :| _)) = x - -last :: forall a. NonEmptyList a -> a -last (NonEmptyList (x :| xs)) = fromMaybe x (L.last xs) - -tail :: NonEmptyList ~> L.List -tail (NonEmptyList (_ :| xs)) = xs - -init :: NonEmptyList ~> L.List -init (NonEmptyList (x :| xs)) = maybe L.Nil (x : _) (L.init xs) - -uncons :: forall a. NonEmptyList a -> { head :: a, tail :: L.List a } -uncons (NonEmptyList (x :| xs)) = { head: x, tail: xs } - -unsnoc :: forall a. NonEmptyList a -> { init :: L.List a, last :: a } -unsnoc (NonEmptyList (x :| xs)) = case L.unsnoc xs of - Nothing -> { init: L.Nil, last: x } - Just un -> { init: x : un.init, last: un.last } - -length :: forall a. NonEmptyList a -> Int -length (NonEmptyList (_ :| xs)) = 1 + L.length xs - -index :: forall a. NonEmptyList a -> Int -> Maybe a -index (NonEmptyList (x :| xs)) i - | i == 0 = Just x - | otherwise = L.index xs (i - 1) - -infixl 8 index as !! - -elemIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int -elemIndex x = findIndex (_ == x) - -elemLastIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int -elemLastIndex x = findLastIndex (_ == x) - -findIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int -findIndex f (NonEmptyList (x :| xs)) - | f x = Just 0 - | otherwise = (_ + 1) <$> L.findIndex f xs - -findLastIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int -findLastIndex f (NonEmptyList (x :| xs)) = - case L.findLastIndex f xs of - Just i -> Just (i + 1) - Nothing - | f x -> Just 0 - | otherwise -> Nothing - -insertAt :: forall a. Int -> a -> NonEmptyList a -> Maybe (NonEmptyList a) -insertAt i a (NonEmptyList (x :| xs)) - | i == 0 = Just (NonEmptyList (a :| x : xs)) - | otherwise = NonEmptyList <<< (x :| _) <$> L.insertAt (i - 1) a xs - -updateAt :: forall a. Int -> a -> NonEmptyList a -> Maybe (NonEmptyList a) -updateAt i a (NonEmptyList (x :| xs)) - | i == 0 = Just (NonEmptyList (a :| xs)) - | otherwise = NonEmptyList <<< (x :| _) <$> L.updateAt (i - 1) a xs - -modifyAt :: forall a. Int -> (a -> a) -> NonEmptyList a -> Maybe (NonEmptyList a) -modifyAt i f (NonEmptyList (x :| xs)) - | i == 0 = Just (NonEmptyList (f x :| xs)) - | otherwise = NonEmptyList <<< (x :| _) <$> L.modifyAt (i - 1) f xs - -reverse :: forall a. NonEmptyList a -> NonEmptyList a -reverse = wrappedOperation "reverse" L.reverse - -filter :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a -filter = lift <<< L.filter - -filterM :: forall m a. Monad m => (a -> m Boolean) -> NonEmptyList a -> m (L.List a) -filterM = lift <<< L.filterM - -mapMaybe :: forall a b. (a -> Maybe b) -> NonEmptyList a -> L.List b -mapMaybe = lift <<< L.mapMaybe - -catMaybes :: forall a. NonEmptyList (Maybe a) -> L.List a -catMaybes = lift L.catMaybes - -concat :: forall a. NonEmptyList (NonEmptyList a) -> NonEmptyList a -concat = (_ >>= identity) - -concatMap :: forall a b. (a -> NonEmptyList b) -> NonEmptyList a -> NonEmptyList b -concatMap = flip bind - -appendFoldable :: forall t a. Foldable t => NonEmptyList a -> t a -> NonEmptyList a -appendFoldable (NonEmptyList (x :| xs)) ys = - NonEmptyList (x :| (xs <> L.fromFoldable ys)) - -sort :: forall a. Ord a => NonEmptyList a -> NonEmptyList a -sort xs = sortBy compare xs - -sortBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a -sortBy = wrappedOperation "sortBy" <<< L.sortBy - -take :: forall a. Int -> NonEmptyList a -> L.List a -take = lift <<< L.take - -takeWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a -takeWhile = lift <<< L.takeWhile - -drop :: forall a. Int -> NonEmptyList a -> L.List a -drop = lift <<< L.drop - -dropWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a -dropWhile = lift <<< L.dropWhile - -span :: forall a. (a -> Boolean) -> NonEmptyList a -> { init :: L.List a, rest :: L.List a } -span = lift <<< L.span - -group :: forall a. Eq a => NonEmptyList a -> NonEmptyList (NonEmptyList a) -group = wrappedOperation "group" L.group - -groupAll :: forall a. Ord a => NonEmptyList a -> NonEmptyList (NonEmptyList a) -groupAll = wrappedOperation "groupAll" L.groupAll - -groupBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) -groupBy = wrappedOperation "groupBy" <<< L.groupBy - -groupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) -groupAllBy = wrappedOperation "groupAllBy" <<< L.groupAllBy - -partition :: forall a. (a -> Boolean) -> NonEmptyList a -> { yes :: L.List a, no :: L.List a } -partition = lift <<< L.partition - -nub :: forall a. Ord a => NonEmptyList a -> NonEmptyList a -nub = wrappedOperation "nub" L.nub - -nubBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a -nubBy = wrappedOperation "nubBy" <<< L.nubBy - -nubEq :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -nubEq = wrappedOperation "nubEq" L.nubEq - -nubByEq :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -nubByEq = wrappedOperation "nubByEq" <<< L.nubByEq - -union :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a -union = wrappedOperation2 "union" L.union - -unionBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a -unionBy = wrappedOperation2 "unionBy" <<< L.unionBy - -intersect :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a -intersect = wrappedOperation2 "intersect" L.intersect - -intersectBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a -intersectBy = wrappedOperation2 "intersectBy" <<< L.intersectBy - -zipWith :: forall a b c. (a -> b -> c) -> NonEmptyList a -> NonEmptyList b -> NonEmptyList c -zipWith f (NonEmptyList (x :| xs)) (NonEmptyList (y :| ys)) = - NonEmptyList (f x y :| L.zipWith f xs ys) - -zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> NonEmptyList a -> NonEmptyList b -> m (NonEmptyList c) -zipWithA f xs ys = sequence1 (zipWith f xs ys) - -zip :: forall a b. NonEmptyList a -> NonEmptyList b -> NonEmptyList (Tuple a b) -zip = zipWith Tuple - -unzip :: forall a b. NonEmptyList (Tuple a b) -> Tuple (NonEmptyList a) (NonEmptyList b) -unzip ts = Tuple (map fst ts) (map snd ts) - -foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyList a -> m b -foldM f b (NonEmptyList (a :| as)) = f b a >>= \b' -> L.foldM f b' as diff --git a/stdlib/lib/Data/List/Partial.purs b/stdlib/lib/Data/List/Partial.purs deleted file mode 100644 index 7d7987f2..00000000 --- a/stdlib/lib/Data/List/Partial.purs +++ /dev/null @@ -1,30 +0,0 @@ --- | Partial helper functions for working with strict linked lists. -module Data.List.Partial where - -import Data.List (List(..)) - --- | Get the first element of a non-empty list. --- | --- | Running time: `O(1)`. -head :: forall a. Partial => List a -> a -head (Cons x _) = x - --- | Get all but the first element of a non-empty list. --- | --- | Running time: `O(1)` -tail :: forall a. Partial => List a -> List a -tail (Cons _ xs) = xs - --- | Get the last element of a non-empty list. --- | --- | Running time: `O(n)` -last :: forall a. Partial => List a -> a -last (Cons x Nil) = x -last (Cons _ xs) = last xs - --- | Get all but the last element of a non-empty list. --- | --- | Running time: `O(n)` -init :: forall a. Partial => List a -> List a -init (Cons _ Nil) = Nil -init (Cons x xs) = Cons x (init xs) diff --git a/stdlib/lib/Data/List/Types.purs b/stdlib/lib/Data/List/Types.purs deleted file mode 100644 index a44df659..00000000 --- a/stdlib/lib/Data/List/Types.purs +++ /dev/null @@ -1,264 +0,0 @@ -module Data.List.Types - ( List(..) - , (:) - , NonEmptyList(..) - , toList - , nelCons - ) where - -import Prelude - -import Control.Alt (class Alt) -import Control.Alternative (class Alternative) -import Control.Apply (lift2) -import Control.Comonad (class Comonad) -import Control.Extend (class Extend) -import Control.MonadPlus (class MonadPlus) -import Control.Plus (class Plus) -import Data.Eq (class Eq1, eq1) -import Data.Foldable (class Foldable, foldl, foldr, intercalate) -import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndex) -import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) -import Data.Maybe (Maybe(..), maybe) -import Data.Newtype (class Newtype) -import Data.NonEmpty (NonEmpty, (:|)) -import Data.NonEmpty as NE -import Data.Ord (class Ord1, compare1) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Traversable (class Traversable1, traverse1) -import Data.Traversable (class Traversable, traverse) -import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) -import Data.Tuple (Tuple(..), snd) -import Data.Unfoldable (class Unfoldable) -import Data.Unfoldable1 (class Unfoldable1) - -data List a = Nil | Cons a (List a) - -infixr 6 Cons as : - -instance showList :: Show a => Show (List a) where - show Nil = "Nil" - show xs = "(" <> intercalate " : " (show <$> xs) <> " : Nil)" - -instance eqList :: Eq a => Eq (List a) where - eq = eq1 - -instance eq1List :: Eq1 List where - eq1 xs ys = go xs ys true - where - go _ _ false = false - go Nil Nil acc = acc - go (x : xs') (y : ys') acc = go xs' ys' $ acc && (y == x) - go _ _ _ = false - -instance ordList :: Ord a => Ord (List a) where - compare = compare1 - -instance ord1List :: Ord1 List where - compare1 xs ys = go xs ys - where - go Nil Nil = EQ - go Nil _ = LT - go _ Nil = GT - go (x : xs') (y : ys') = - case compare x y of - EQ -> go xs' ys' - other -> other - -instance semigroupList :: Semigroup (List a) where - append xs ys = foldr (:) ys xs - -instance monoidList :: Monoid (List a) where - mempty = Nil - -instance functorList :: Functor List where - map = listMap - --- chunked list Functor inspired by OCaml --- https://discuss.ocaml.org/t/a-new-list-map-that-is-both-stack-safe-and-fast/865 --- chunk sizes determined through experimentation -listMap :: forall a b. (a -> b) -> List a -> List b -listMap f = chunkedRevMap Nil - where - chunkedRevMap :: List (List a) -> List a -> List b - chunkedRevMap chunksAcc chunk@(_ : _ : _ : xs) = - chunkedRevMap (chunk : chunksAcc) xs - chunkedRevMap chunksAcc xs = - reverseUnrolledMap chunksAcc $ unrolledMap xs - where - unrolledMap :: List a -> List b - unrolledMap (x1 : x2 : Nil) = f x1 : f x2 : Nil - unrolledMap (x1 : Nil) = f x1 : Nil - unrolledMap _ = Nil - - reverseUnrolledMap :: List (List a) -> List b -> List b - reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc = - reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc) - reverseUnrolledMap _ acc = acc - -instance functorWithIndexList :: FunctorWithIndex Int List where - mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) Nil - -instance foldableList :: Foldable List where - foldr f b = foldl (flip f) b <<< rev - where - rev = go Nil - where - go acc Nil = acc - go acc (x : xs) = go (x : acc) xs - foldl f = go - where - go b = case _ of - Nil -> b - a : as -> go (f b a) as - foldMap f = foldl (\acc -> append acc <<< f) mempty - -instance foldableWithIndexList :: FoldableWithIndex Int List where - foldrWithIndex f b xs = - -- as we climb the reversed list, we decrement the index - snd $ foldl - (\(Tuple i b') a -> Tuple (i - 1) (f (i - 1) a b')) - (Tuple len b) - revList - where - Tuple len revList = rev (Tuple 0 Nil) xs - where - -- As we create our reversed list, we count elements. - rev = foldl (\(Tuple i acc) a -> Tuple (i + 1) (a : acc)) - foldlWithIndex f acc = - snd <<< foldl (\(Tuple i b) a -> Tuple (i + 1) (f i b a)) (Tuple 0 acc) - foldMapWithIndex f = foldlWithIndex (\i acc -> append acc <<< f i) mempty - -instance unfoldable1List :: Unfoldable1 List where - unfoldr1 f b = go b Nil - where - go source memo = case f source of - Tuple one (Just rest) -> go rest (one : memo) - Tuple one Nothing -> foldl (flip (:)) Nil (one : memo) - -instance unfoldableList :: Unfoldable List where - unfoldr f b = go b Nil - where - go source memo = case f source of - Nothing -> (foldl (flip (:)) Nil memo) - Just (Tuple one rest) -> go rest (one : memo) - -instance traversableList :: Traversable List where - traverse f = map (foldl (flip (:)) Nil) <<< foldl (\acc -> lift2 (flip (:)) acc <<< f) (pure Nil) - sequence = traverse identity - -instance traversableWithIndexList :: TraversableWithIndex Int List where - traverseWithIndex f = - map rev - <<< foldlWithIndex (\i acc -> lift2 (flip (:)) acc <<< f i) (pure Nil) - where - rev = foldl (flip Cons) Nil - -instance applyList :: Apply List where - apply Nil _ = Nil - apply (f : fs) xs = (f <$> xs) <> (fs <*> xs) - -instance applicativeList :: Applicative List where - pure a = a : Nil - -instance bindList :: Bind List where - bind Nil _ = Nil - bind (x : xs) f = f x <> bind xs f - -instance monadList :: Monad List - -instance altList :: Alt List where - alt = append - -instance plusList :: Plus List where - empty = Nil - -instance alternativeList :: Alternative List - -instance monadPlusList :: MonadPlus List - -instance extendList :: Extend List where - extend _ Nil = Nil - extend f l@(_ : as) = - f l : (foldr go { val: Nil, acc: Nil } as).val - where - go a' { val, acc } = - let acc' = a' : acc - in { val: f acc' : val, acc: acc' } - -newtype NonEmptyList a = NonEmptyList (NonEmpty List a) - -toList :: NonEmptyList ~> List -toList (NonEmptyList (x :| xs)) = x : xs - -nelCons :: forall a. a -> NonEmptyList a -> NonEmptyList a -nelCons a (NonEmptyList (b :| bs)) = NonEmptyList (a :| b : bs) - -derive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _ - -derive newtype instance eqNonEmptyList :: Eq a => Eq (NonEmptyList a) -derive newtype instance ordNonEmptyList :: Ord a => Ord (NonEmptyList a) - -derive newtype instance eq1NonEmptyList :: Eq1 NonEmptyList -derive newtype instance ord1NonEmptyList :: Ord1 NonEmptyList - -instance showNonEmptyList :: Show a => Show (NonEmptyList a) where - show (NonEmptyList nel) = "(NonEmptyList " <> show nel <> ")" - -derive newtype instance functorNonEmptyList :: Functor NonEmptyList - -instance applyNonEmptyList :: Apply NonEmptyList where - apply (NonEmptyList (f :| fs)) (NonEmptyList (a :| as)) = - NonEmptyList (f a :| (fs <*> a : Nil) <> ((f : fs) <*> as)) - -instance applicativeNonEmptyList :: Applicative NonEmptyList where - pure = NonEmptyList <<< NE.singleton - -instance bindNonEmptyList :: Bind NonEmptyList where - bind (NonEmptyList (a :| as)) f = - case f a of - NonEmptyList (b :| bs) -> - NonEmptyList (b :| bs <> bind as (toList <<< f)) - -instance monadNonEmptyList :: Monad NonEmptyList - -instance altNonEmptyList :: Alt NonEmptyList where - alt = append - -instance extendNonEmptyList :: Extend NonEmptyList where - extend f w@(NonEmptyList (_ :| as)) = - NonEmptyList (f w :| (foldr go { val: Nil, acc: Nil } as).val) - where - go a { val, acc } = { val: f (NonEmptyList (a :| acc)) : val, acc: a : acc } - -instance comonadNonEmptyList :: Comonad NonEmptyList where - extract (NonEmptyList (a :| _)) = a - -instance semigroupNonEmptyList :: Semigroup (NonEmptyList a) where - append (NonEmptyList (a :| as)) as' = - NonEmptyList (a :| as <> toList as') - -derive newtype instance foldableNonEmptyList :: Foldable NonEmptyList - -derive newtype instance traversableNonEmptyList :: Traversable NonEmptyList - -derive newtype instance foldable1NonEmptyList :: Foldable1 NonEmptyList - -derive newtype instance unfoldable1NonEmptyList :: Unfoldable1 NonEmptyList - -instance functorWithIndexNonEmptyList :: FunctorWithIndex Int NonEmptyList where - mapWithIndex fn (NonEmptyList ne) = NonEmptyList $ mapWithIndex (fn <<< maybe 0 (add 1)) ne - -instance foldableWithIndexNonEmptyList :: FoldableWithIndex Int NonEmptyList where - foldMapWithIndex f (NonEmptyList ne) = foldMapWithIndex (f <<< maybe 0 (add 1)) ne - foldlWithIndex f b (NonEmptyList ne) = foldlWithIndex (f <<< maybe 0 (add 1)) b ne - foldrWithIndex f b (NonEmptyList ne) = foldrWithIndex (f <<< maybe 0 (add 1)) b ne - -instance traversableWithIndexNonEmptyList :: TraversableWithIndex Int NonEmptyList where - traverseWithIndex f (NonEmptyList ne) = NonEmptyList <$> traverseWithIndex (f <<< maybe 0 (add 1)) ne - -instance traversable1NonEmptyList :: Traversable1 NonEmptyList where - traverse1 f (NonEmptyList (a :| as)) = - foldl (\acc -> lift2 (flip nelCons) acc <<< f) (pure <$> f a) as - <#> case _ of NonEmptyList (x :| xs) → foldl (flip nelCons) (pure x) xs - sequence1 = traverse1 identity diff --git a/stdlib/lib/Data/List/ZipList.purs b/stdlib/lib/Data/List/ZipList.purs deleted file mode 100644 index 09e334d5..00000000 --- a/stdlib/lib/Data/List/ZipList.purs +++ /dev/null @@ -1,66 +0,0 @@ --- | This module defines the type of _zip lists_, i.e. linked lists --- | with a zippy `Applicative` instance. - -module Data.List.ZipList - ( ZipList(..) - ) where - -import Prelude - -import Control.Alt (class Alt) -import Control.Alternative (class Alternative) -import Control.Plus (class Plus) -import Data.Foldable (class Foldable) -import Data.List.Lazy (List, drop, length, repeat, zipWith) -import Data.Newtype (class Newtype) -import Data.Traversable (class Traversable) -import Partial.Unsafe (unsafeCrashWith) -import Prim.TypeError (class Fail, Text) - --- | `ZipList` is a newtype around `List` which provides a zippy --- | `Applicative` instance. -newtype ZipList a = ZipList (List a) - -instance showZipList :: Show a => Show (ZipList a) where - show (ZipList xs) = "(ZipList " <> show xs <> ")" - -derive instance newtypeZipList :: Newtype (ZipList a) _ - -derive newtype instance eqZipList :: Eq a => Eq (ZipList a) - -derive newtype instance ordZipList :: Ord a => Ord (ZipList a) - -derive newtype instance semigroupZipList :: Semigroup (ZipList a) - -derive newtype instance monoidZipList :: Monoid (ZipList a) - -derive newtype instance foldableZipList :: Foldable ZipList - -derive newtype instance traversableZipList :: Traversable ZipList - -derive newtype instance functorZipList :: Functor ZipList - -instance applyZipList :: Apply ZipList where - apply (ZipList fs) (ZipList xs) = ZipList (zipWith ($) fs xs) - -instance applicativeZipList :: Applicative ZipList where - pure = ZipList <<< repeat - -instance altZipList :: Alt ZipList where - alt (ZipList xs) (ZipList ys) = ZipList $ xs <> drop (length xs) ys - -instance plusZipList :: Plus ZipList where - empty = mempty - -instance alternativeZipList :: Alternative ZipList - -instance zipListIsNotBind - :: Fail (Text """ - ZipList is not Bind. Any implementation would break the associativity law. - - Possible alternatives: - Data.List.List - Data.List.Lazy.List - """) - => Bind ZipList where - bind = unsafeCrashWith "bind: unreachable" diff --git a/stdlib/lib/Data/Map.purs b/stdlib/lib/Data/Map.purs deleted file mode 100644 index 4aac96f7..00000000 --- a/stdlib/lib/Data/Map.purs +++ /dev/null @@ -1,65 +0,0 @@ -module Data.Map - ( module Data.Map.Internal - , keys - , SemigroupMap(..) - ) where - -import Prelude - -import Control.Alt (class Alt) -import Control.Plus (class Plus) -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable) -import Data.FoldableWithIndex (class FoldableWithIndex) -import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.Map.Internal (Map, alter, catMaybes, checkValid, delete, empty, filter, filterKeys, filterWithKey, findMax, findMin, foldSubmap, fromFoldable, fromFoldableWith, fromFoldableWithIndex, insert, insertWith, isEmpty, isSubmap, lookup, lookupGE, lookupGT, lookupLE, lookupLT, member, pop, showTree, singleton, size, submap, toUnfoldable, toUnfoldableUnordered, union, unionWith, unions, intersection, intersectionWith, difference, update, values, mapMaybeWithKey, mapMaybe, any, anyWithKey) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) -import Data.Traversable (class Traversable) -import Data.TraversableWithIndex (class TraversableWithIndex) -import Data.Set (Set, fromMap) - --- | The set of keys of the given map. --- | See also `Data.Set.fromMap`. -keys :: forall k v. Map k v -> Set k -keys = fromMap <<< void - --- | `SemigroupMap k v` provides a `Semigroup` instance for `Map k v` whose --- | definition depends on the `Semigroup` instance for the `v` type. --- | You should only use this type when you need `Data.Map` to have --- | a `Semigroup` instance. --- | --- | ```purescript --- | let --- | s :: forall key value. key -> value -> SemigroupMap key value --- | s k v = SemigroupMap (singleton k v) --- | --- | (s 1 "foo") <> (s 1 "bar") == (s 1 "foobar") --- | (s 1 (First 1)) <> (s 1 (First 2)) == (s 1 (First 1)) --- | (s 1 (Last 1)) <> (s 1 (Last 2)) == (s 1 (Last 2)) --- | ``` -newtype SemigroupMap k v = SemigroupMap (Map k v) - -derive newtype instance eq1SemigroupMap :: Eq k => Eq1 (SemigroupMap k) -derive newtype instance eqSemigroupMap :: (Eq k, Eq v) => Eq (SemigroupMap k v) -derive newtype instance ord1SemigroupMap :: Ord k => Ord1 (SemigroupMap k) -derive newtype instance ordSemigroupMap :: (Ord k, Ord v) => Ord (SemigroupMap k v) -derive instance newtypeSemigroupMap :: Newtype (SemigroupMap k v) _ -derive newtype instance showSemigroupMap :: (Show k, Show v) => Show (SemigroupMap k v) - -instance semigroupSemigroupMap :: (Ord k, Semigroup v) => Semigroup (SemigroupMap k v) where - append (SemigroupMap l) (SemigroupMap r) = SemigroupMap (unionWith append l r) - -instance monoidSemigroupMap :: (Ord k, Semigroup v) => Monoid (SemigroupMap k v) where - mempty = SemigroupMap empty - -derive newtype instance altSemigroupMap :: Ord k => Alt (SemigroupMap k) -derive newtype instance plusSemigroupMap :: Ord k => Plus (SemigroupMap k) -derive newtype instance functorSemigroupMap :: Functor (SemigroupMap k) -derive newtype instance functorWithIndexSemigroupMap :: FunctorWithIndex k (SemigroupMap k) -derive newtype instance applySemigroupMap :: Ord k => Apply (SemigroupMap k) -derive newtype instance bindSemigroupMap :: Ord k => Bind (SemigroupMap k) -derive newtype instance foldableSemigroupMap :: Foldable (SemigroupMap k) -derive newtype instance foldableWithIndexSemigroupMap :: FoldableWithIndex k (SemigroupMap k) -derive newtype instance traversableSemigroupMap :: Traversable (SemigroupMap k) -derive newtype instance traversableWithIndexSemigroupMap :: TraversableWithIndex k (SemigroupMap k) diff --git a/stdlib/lib/Data/Map/Gen.purs b/stdlib/lib/Data/Map/Gen.purs deleted file mode 100644 index 6398a2db..00000000 --- a/stdlib/lib/Data/Map/Gen.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.Map.Gen where - -import Prelude - -import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) -import Control.Monad.Rec.Class (class MonadRec) -import Data.Map (Map, fromFoldable) -import Data.Tuple (Tuple(..)) -import Data.List (List) - --- | Generates a `Map` using the specified key and value generators. -genMap - :: forall m a b - . MonadRec m - => MonadGen m - => Ord a - => m a - -> m b - -> m (Map a b) -genMap genKey genValue = sized \size -> do - newSize <- chooseInt 0 size - resize (const newSize) $ - (fromFoldable :: List (Tuple a b) -> Map a b) - <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/stdlib/lib/Data/Map/Internal.purs b/stdlib/lib/Data/Map/Internal.purs deleted file mode 100644 index 81cc3983..00000000 --- a/stdlib/lib/Data/Map/Internal.purs +++ /dev/null @@ -1,988 +0,0 @@ --- | This module defines a type of maps as height-balanced (AVL) binary trees. --- | Efficient set operations are implemented in terms of --- | - -module Data.Map.Internal - ( Map(..) - , showTree - , empty - , isEmpty - , singleton - , checkValid - , insert - , insertWith - , lookup - , lookupLE - , lookupLT - , lookupGE - , lookupGT - , findMin - , findMax - , foldSubmap - , submap - , fromFoldable - , fromFoldableWith - , fromFoldableWithIndex - , toUnfoldable - , toUnfoldableUnordered - , delete - , pop - , member - , alter - , update - , keys - , values - , union - , unionWith - , unions - , intersection - , intersectionWith - , difference - , isSubmap - , size - , filterWithKey - , filterKeys - , filter - , mapMaybeWithKey - , mapMaybe - , catMaybes - , any - , anyWithKey - , MapIter - , MapIterStep(..) - , toMapIter - , stepAsc - , stepAscCps - , stepDesc - , stepDescCps - , stepUnordered - , stepUnorderedCps - , unsafeNode - , unsafeBalancedNode - , unsafeJoinNodes - , unsafeSplit - , Split(..) - ) where - -import Prelude - -import Control.Alt (class Alt) -import Control.Plus (class Plus) -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable, foldl, foldr) -import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex) -import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn7, mkFn2, mkFn3, mkFn4, mkFn7, runFn2, runFn3, runFn4, runFn7) -import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.List (List(..), (:)) -import Data.Maybe (Maybe(..)) -import Data.Ord (class Ord1, abs) -import Data.Traversable (traverse, class Traversable) -import Data.TraversableWithIndex (class TraversableWithIndex) -import Data.Tuple (Tuple(Tuple)) -import Data.Unfoldable (class Unfoldable, unfoldr) -import Prim.TypeError (class Warn, Text) - --- | `Map k v` represents maps from keys of type `k` to values of type `v`. -data Map k v = Leaf | Node Int Int k v (Map k v) (Map k v) - -type role Map nominal representational - -instance eq1Map :: Eq k => Eq1 (Map k) where - eq1 = eq - -instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where - eq xs ys = case xs of - Leaf -> - case ys of - Leaf -> true - _ -> false - Node _ s1 _ _ _ _ -> - case ys of - Node _ s2 _ _ _ _ - | s1 == s2 -> - toMapIter xs == toMapIter ys - _ -> - false - -instance ord1Map :: Ord k => Ord1 (Map k) where - compare1 = compare - -instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where - compare xs ys = case xs of - Leaf -> - case ys of - Leaf -> EQ - _ -> LT - _ -> - case ys of - Leaf -> GT - _ -> compare (toMapIter xs) (toMapIter ys) - -instance showMap :: (Show k, Show v) => Show (Map k v) where - show as = "(fromFoldable " <> show (toUnfoldable as :: Array _) <> ")" - -instance semigroupMap :: - ( Warn (Text "Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.") - , Ord k - , Semigroup v - ) => Semigroup (Map k v) where - append = unionWith append - -instance monoidSemigroupMap :: - ( Warn (Text "Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.") - , Ord k - , Semigroup v - ) => Monoid (Map k v) where - mempty = empty - -instance altMap :: Ord k => Alt (Map k) where - alt = union - -instance plusMap :: Ord k => Plus (Map k) where - empty = empty - -instance functorMap :: Functor (Map k) where - map f = go - where - go = case _ of - Leaf -> Leaf - Node h s k v l r -> - Node h s k (f v) (go l) (go r) - -instance functorWithIndexMap :: FunctorWithIndex k (Map k) where - mapWithIndex f = go - where - go = case _ of - Leaf -> Leaf - Node h s k v l r -> - Node h s k (f k v) (go l) (go r) - -instance applyMap :: Ord k => Apply (Map k) where - apply = intersectionWith identity - -instance bindMap :: Ord k => Bind (Map k) where - bind m f = mapMaybeWithKey (\k -> lookup k <<< f) m - -instance foldableMap :: Foldable (Map k) where - foldr f z = \m -> runFn2 go m z - where - go = mkFn2 \m' z' -> case m' of - Leaf -> z' - Node _ _ _ v l r -> - runFn2 go l (f v (runFn2 go r z')) - foldl f z = \m -> runFn2 go z m - where - go = mkFn2 \z' m' -> case m' of - Leaf -> z' - Node _ _ _ v l r -> - runFn2 go (f (runFn2 go z' l) v) r - foldMap f = go - where - go = case _ of - Leaf -> mempty - Node _ _ _ v l r -> - go l <> f v <> go r - -instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where - foldrWithIndex f z = \m -> runFn2 go m z - where - go = mkFn2 \m' z' -> case m' of - Leaf -> z' - Node _ _ k v l r -> - runFn2 go l (f k v (runFn2 go r z')) - foldlWithIndex f z = \m -> runFn2 go z m - where - go = mkFn2 \z' m' -> case m' of - Leaf -> z' - Node _ _ k v l r -> - runFn2 go (f k (runFn2 go z' l) v) r - foldMapWithIndex f = go - where - go = case _ of - Leaf -> mempty - Node _ _ k v l r -> - go l <> f k v <> go r - -instance traversableMap :: Traversable (Map k) where - traverse f = go - where - go = case _ of - Leaf -> pure Leaf - Node h s k v l r -> - (\l' v' r' -> Node h s k v' l' r') - <$> go l - <*> f v - <*> go r - sequence = traverse identity - -instance traversableWithIndexMap :: TraversableWithIndex k (Map k) where - traverseWithIndex f = go - where - go = case _ of - Leaf -> pure Leaf - Node h s k v l r -> - (\l' v' r' -> Node h s k v' l' r') - <$> go l - <*> f k v - <*> go r - --- | Render a `Map` as a `String` -showTree :: forall k v. Show k => Show v => Map k v -> String -showTree = go "" - where - go ind = case _ of - Leaf -> ind <> "Leaf" - Node h _ k v l r -> - (ind <> "[" <> show h <> "] " <> show k <> " => " <> show v <> "\n") - <> (go (ind <> " ") l <> "\n") - <> (go (ind <> " ") r) - --- | An empty map -empty :: forall k v. Map k v -empty = Leaf - --- | Test if a map is empty -isEmpty :: forall k v. Map k v -> Boolean -isEmpty Leaf = true -isEmpty _ = false - --- | Create a map with one key/value pair -singleton :: forall k v. k -> v -> Map k v -singleton k v = Node 1 1 k v Leaf Leaf - --- | Check whether the underlying tree satisfies the height, size, and ordering invariants. --- | --- | This function is provided for internal use. -checkValid :: forall k v. Ord k => Map k v -> Boolean -checkValid = go - where - go = case _ of - Leaf -> true - Node h s k _ l r -> - case l of - Leaf -> - case r of - Leaf -> - true - Node rh rs rk _ _ _ -> - h == 2 && rh == 1 && s > rs && rk > k && go r - Node lh ls lk _ _ _ -> - case r of - Leaf -> - h == 2 && lh == 1 && s > ls && lk < k && go l - Node rh rs rk _ _ _ -> - h > rh && rk > k && h > lh && lk < k && abs (rh - lh) < 2 && rs + ls + 1 == s && go l && go r - --- | Look up a value for the specified key -lookup :: forall k v. Ord k => k -> Map k v -> Maybe v -lookup k = go - where - go = case _ of - Leaf -> Nothing - Node _ _ mk mv ml mr -> - case compare k mk of - LT -> go ml - GT -> go mr - EQ -> Just mv - --- | Look up a value for the specified key, or the greatest one less than it -lookupLE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupLE k = go - where - go = case _ of - Leaf -> Nothing - Node _ _ mk mv ml mr -> - case compare k mk of - LT -> go ml - GT -> - case go mr of - Nothing -> Just { key: mk, value: mv } - other -> other - EQ -> - Just { key: mk, value: mv } - --- | Look up a value for the greatest key less than the specified key -lookupLT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupLT k = go - where - go = case _ of - Leaf -> Nothing - Node _ _ mk mv ml mr -> - case compare k mk of - LT -> go ml - GT -> - case go mr of - Nothing -> Just { key: mk, value: mv } - other -> other - EQ -> - findMax ml - --- | Look up a value for the specified key, or the least one greater than it -lookupGE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupGE k = go - where - go = case _ of - Leaf -> Nothing - Node _ _ mk mv ml mr -> - case compare k mk of - LT -> - case go ml of - Nothing -> Just { key: mk, value: mv } - other -> other - GT -> go mr - EQ -> Just { key: mk, value: mv } - --- | Look up a value for the least key greater than the specified key -lookupGT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupGT k = go - where - go = case _ of - Leaf -> Nothing - Node _ _ mk mv ml mr -> - case compare k mk of - LT -> - case go ml of - Nothing -> Just { key: mk, value: mv } - other -> other - GT -> go mr - EQ -> findMin mr - --- | Returns the pair with the greatest key -findMax :: forall k v. Map k v -> Maybe { key :: k, value :: v } -findMax = case _ of - Leaf -> Nothing - Node _ _ k v _ r -> - case r of - Leaf -> Just { key: k, value: v } - _ -> findMax r - --- | Returns the pair with the least key -findMin :: forall k v. Map k v -> Maybe { key :: k, value :: v } -findMin = case _ of - Leaf -> Nothing - Node _ _ k v l _ -> - case l of - Leaf -> Just { key: k, value: v } - _ -> findMin l - --- | Fold over the entries of a given map where the key is between a lower and --- | an upper bound. Passing `Nothing` as either the lower or upper bound --- | argument means that the fold has no lower or upper bound, i.e. the fold --- | starts from (or ends with) the smallest (or largest) key in the map. --- | --- | ```purescript --- | foldSubmap (Just 1) (Just 2) (\_ v -> [v]) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == ["one", "two"] --- | --- | foldSubmap Nothing (Just 2) (\_ v -> [v]) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == ["zero", "one", "two"] --- | ``` -foldSubmap :: forall k v m. Ord k => Monoid m => Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m -foldSubmap = foldSubmapBy (<>) mempty - -foldSubmapBy :: forall k v m. Ord k => (m -> m -> m) -> m -> Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m -foldSubmapBy appendFn memptyValue kmin kmax f = - let - tooSmall = - case kmin of - Just kmin' -> - \k -> k < kmin' - Nothing -> - const false - - tooLarge = - case kmax of - Just kmax' -> - \k -> k > kmax' - Nothing -> - const false - - inBounds = - case kmin, kmax of - Just kmin', Just kmax' -> - \k -> kmin' <= k && k <= kmax' - Just kmin', Nothing -> - \k -> kmin' <= k - Nothing, Just kmax' -> - \k -> k <= kmax' - Nothing, Nothing -> - const true - - go = case _ of - Leaf -> - memptyValue - Node _ _ k v left right -> - (if tooSmall k then memptyValue else go left) - `appendFn` (if inBounds k then f k v else memptyValue) - `appendFn` (if tooLarge k then memptyValue else go right) - in - go - --- | Returns a new map containing all entries of the given map which lie --- | between a given lower and upper bound, treating `Nothing` as no bound i.e. --- | including the smallest (or largest) key in the map, no matter how small --- | (or large) it is. For example: --- | --- | ```purescript --- | submap (Just 1) (Just 2) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == fromFoldable [Tuple 1 "one", Tuple 2 "two"] --- | --- | submap Nothing (Just 2) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two"] --- | ``` --- | --- | The function is entirely specified by the following --- | property: --- | --- | ```purescript --- | Given any m :: Map k v, mmin :: Maybe k, mmax :: Maybe k, key :: k, --- | let m' = submap mmin mmax m in --- | if (maybe true (\min -> min <= key) mmin && --- | maybe true (\max -> max >= key) mmax) --- | then lookup key m == lookup key m' --- | else not (member key m') --- | ``` -submap :: forall k v. Ord k => Maybe k -> Maybe k -> Map k v -> Map k v -submap kmin kmax = foldSubmapBy union empty kmin kmax singleton - --- | Test if a key is a member of a map -member :: forall k v. Ord k => k -> Map k v -> Boolean -member k = go - where - go = case _ of - Leaf -> false - Node _ _ mk _ ml mr -> - case compare k mk of - LT -> go ml - GT -> go mr - EQ -> true - --- | Insert or replace a key/value pair in a map -insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v -insert k v = go - where - go = case _ of - Leaf -> singleton k v - Node mh ms mk mv ml mr -> - case compare k mk of - LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr - GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) - EQ -> Node mh ms k v ml mr - --- | Inserts or updates a value with the given function. --- | --- | The combining function is called with the existing value as the first --- | argument and the new value as the second argument. -insertWith :: forall k v. Ord k => (v -> v -> v) -> k -> v -> Map k v -> Map k v -insertWith app k v = go - where - go = case _ of - Leaf -> singleton k v - Node mh ms mk mv ml mr -> - case compare k mk of - LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr - GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) - EQ -> Node mh ms k (app mv v) ml mr - --- | Delete a key and its corresponding value from a map. -delete :: forall k v. Ord k => k -> Map k v -> Map k v -delete k = go - where - go = case _ of - Leaf -> Leaf - Node _ _ mk mv ml mr -> - case compare k mk of - LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr - GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) - EQ -> runFn2 unsafeJoinNodes ml mr - --- | Delete a key and its corresponding value from a map, returning the value --- | as well as the subsequent map. -pop :: forall k v. Ord k => k -> Map k v -> Maybe (Tuple v (Map k v)) -pop k m = do - let (Split x l r) = runFn3 unsafeSplit compare k m - map (\a -> Tuple a (runFn2 unsafeJoinNodes l r)) x - --- | Insert the value, delete a value, or update a value for a key in a map -alter :: forall k v. Ord k => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v -alter f k m = do - let Split v l r = runFn3 unsafeSplit compare k m - case f v of - Nothing -> - runFn2 unsafeJoinNodes l r - Just v' -> - runFn4 unsafeBalancedNode k v' l r - --- | Update or delete the value for a key in a map -update :: forall k v. Ord k => (v -> Maybe v) -> k -> Map k v -> Map k v -update f k = go - where - go = case _ of - Leaf -> Leaf - Node mh ms mk mv ml mr -> - case compare k mk of - LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr - GT -> runFn4 unsafeBalancedNode mk mv ml (go mr) - EQ -> - case f mv of - Nothing -> - runFn2 unsafeJoinNodes ml mr - Just mv' -> - Node mh ms mk mv' ml mr - --- | Convert any foldable collection of key/value pairs to a map. --- | On key collision, later values take precedence over earlier ones. -fromFoldable :: forall f k v. Ord k => Foldable f => f (Tuple k v) -> Map k v -fromFoldable = foldl (\m (Tuple k v) -> insert k v m) empty - --- | Convert any foldable collection of key/value pairs to a map. --- | On key collision, the values are configurably combined. -fromFoldableWith :: forall f k v. Ord k => Foldable f => (v -> v -> v) -> f (Tuple k v) -> Map k v -fromFoldableWith f = foldl (\m (Tuple k v) -> f' k v m) empty - where - f' = insertWith (flip f) - --- | Convert any indexed foldable collection into a map. -fromFoldableWithIndex :: forall f k v. Ord k => FoldableWithIndex k f => f v -> Map k v -fromFoldableWithIndex = foldlWithIndex (\k m v -> insert k v m) empty - --- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order -toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) -toUnfoldable = unfoldr stepUnfoldr <<< toMapIter - --- | Convert a map to an unfoldable structure of key/value pairs --- | --- | While this traversal is up to 10% faster in benchmarks than `toUnfoldable`, --- | it leaks the underlying map stucture, making it only suitable for applications --- | where order is irrelevant. --- | --- | If you are unsure, use `toUnfoldable` -toUnfoldableUnordered :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) -toUnfoldableUnordered = unfoldr stepUnfoldrUnordered <<< toMapIter - --- | Get a list of the keys contained in a map -keys :: forall k v. Map k v -> List k -keys = foldrWithIndex (\k _ acc -> k : acc) Nil - --- | Get a list of the values contained in a map -values :: forall k v. Map k v -> List v -values = foldr Cons Nil - --- | Compute the union of two maps, using the specified function --- | to combine values for duplicate keys. -unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v -unionWith app m1 m2 = runFn4 unsafeUnionWith compare app m1 m2 - --- | Compute the union of two maps, preferring values from the first map in the case --- | of duplicate keys -union :: forall k v. Ord k => Map k v -> Map k v -> Map k v -union = unionWith const - --- | Compute the union of a collection of maps -unions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v -unions = foldl union empty - --- | Compute the intersection of two maps, using the specified function --- | to combine values for duplicate keys. -intersectionWith :: forall k a b c. Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c -intersectionWith app m1 m2 = runFn4 unsafeIntersectionWith compare app m1 m2 - --- | Compute the intersection of two maps, preferring values from the first map in the case --- | of duplicate keys. -intersection :: forall k a b. Ord k => Map k a -> Map k b -> Map k a -intersection = intersectionWith const - --- | Difference of two maps. Return elements of the first map where --- | the keys do not exist in the second map. -difference :: forall k v w. Ord k => Map k v -> Map k w -> Map k v -difference m1 m2 = runFn3 unsafeDifference compare m1 m2 - --- | Test whether one map contains all of the keys and values contained in another map -isSubmap :: forall k v. Ord k => Eq v => Map k v -> Map k v -> Boolean -isSubmap = go - where - go m1 m2 = case m1 of - Leaf -> true - Node _ _ k v l r -> - case lookup k m2 of - Nothing -> false - Just v' -> - v == v' && go l m2 && go r m2 - --- | Calculate the number of key/value pairs in a map -size :: forall k v. Map k v -> Int -size = case _ of - Leaf -> 0 - Node _ s _ _ _ _ -> s - --- | Filter out those key/value pairs of a map for which a predicate --- | fails to hold. -filterWithKey :: forall k v. Ord k => (k -> v -> Boolean) -> Map k v -> Map k v -filterWithKey f = go - where - go = case _ of - Leaf -> Leaf - Node _ _ k v l r - | f k v -> - runFn4 unsafeBalancedNode k v (go l) (go r) - | otherwise -> - runFn2 unsafeJoinNodes (go l) (go r) - --- | Filter out those key/value pairs of a map for which a predicate --- | on the key fails to hold. -filterKeys :: forall k. Ord k => (k -> Boolean) -> Map k ~> Map k -filterKeys f = go - where - go = case _ of - Leaf -> Leaf - Node _ _ k v l r - | f k -> - runFn4 unsafeBalancedNode k v (go l) (go r) - | otherwise -> - runFn2 unsafeJoinNodes (go l) (go r) - --- | Filter out those key/value pairs of a map for which a predicate --- | on the value fails to hold. -filter :: forall k v. Ord k => (v -> Boolean) -> Map k v -> Map k v -filter = filterWithKey <<< const - --- | Applies a function to each key/value pair in a map, discarding entries --- | where the function returns `Nothing`. -mapMaybeWithKey :: forall k a b. Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b -mapMaybeWithKey f = go - where - go = case _ of - Leaf -> Leaf - Node _ _ k v l r -> - case f k v of - Just v' -> - runFn4 unsafeBalancedNode k v' (go l) (go r) - Nothing -> - runFn2 unsafeJoinNodes (go l) (go r) - --- | Applies a function to each value in a map, discarding entries where the --- | function returns `Nothing`. -mapMaybe :: forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b -mapMaybe = mapMaybeWithKey <<< const - --- | Filter a map of optional values, keeping only the key/value pairs which --- | contain a value, creating a new map. -catMaybes :: forall k v. Ord k => Map k (Maybe v) -> Map k v -catMaybes = mapMaybe identity - --- | Returns true if at least one map element satisfies the given predicateon the value, --- | iterating the map only as necessary and stopping as soon as the predicate --- | yields true. -any :: forall k v. (v -> Boolean) -> Map k v -> Boolean -any predicate = go - where - go = case _ of - Leaf -> false - Node _ _ _ mv ml mr -> predicate mv || go ml || go mr - --- | Returns true if at least one map element satisfies the given predicate, --- | iterating the map only as necessary and stopping as soon as the predicate --- | yields true. -anyWithKey :: forall k v. (k -> v -> Boolean) -> Map k v -> Boolean -anyWithKey predicate = go - where - go = case _ of - Leaf -> false - Node _ _ mk mv ml mr -> predicate mk mv || go ml || go mr - --- | Low-level Node constructor which maintains the height and size invariants --- | This is unsafe because it assumes the child Maps are ordered and balanced. -unsafeNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v) -unsafeNode = mkFn4 \k v l r -> case l of - Leaf -> - case r of - Leaf -> - Node 1 1 k v l r - Node h2 s2 _ _ _ _ -> - Node (1 + h2) (1 + s2) k v l r - Node h1 s1 _ _ _ _ -> - case r of - Leaf -> - Node (1 + h1) (1 + s1) k v l r - Node h2 s2 _ _ _ _ -> - Node (1 + if h1 > h2 then h1 else h2) (1 + s1 + s2) k v l r - --- | Low-level Node constructor which maintains the balance invariants. --- | This is unsafe because it assumes the child Maps are ordered. -unsafeBalancedNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v) -unsafeBalancedNode = mkFn4 \k v l r -> case l of - Leaf -> - case r of - Leaf -> - singleton k v - Node rh _ rk rv rl rr - | rh > 1 -> - runFn7 rotateLeft k v l rk rv rl rr - _ -> - runFn4 unsafeNode k v l r - Node lh _ lk lv ll lr -> - case r of - Node rh _ rk rv rl rr - | rh > lh + 1 -> - runFn7 rotateLeft k v l rk rv rl rr - | lh > rh + 1 -> - runFn7 rotateRight k v lk lv ll lr r - Leaf - | lh > 1 -> - runFn7 rotateRight k v lk lv ll lr r - _ -> - runFn4 unsafeNode k v l r - where - rotateLeft :: Fn7 k v (Map k v) k v (Map k v) (Map k v) (Map k v) - rotateLeft = mkFn7 \k v l rk rv rl rr -> case rl of - Node lh _ lk lv ll lr - | lh > height rr -> - runFn4 unsafeNode lk lv (runFn4 unsafeNode k v l ll) (runFn4 unsafeNode rk rv lr rr) - _ -> - runFn4 unsafeNode rk rv (runFn4 unsafeNode k v l rl) rr - - rotateRight :: Fn7 k v k v (Map k v) (Map k v) (Map k v) (Map k v) - rotateRight = mkFn7 \k v lk lv ll lr r -> case lr of - Node rh _ rk rv rl rr - | height ll <= rh -> - runFn4 unsafeNode rk rv (runFn4 unsafeNode lk lv ll rl) (runFn4 unsafeNode k v rr r) - _ -> - runFn4 unsafeNode lk lv ll (runFn4 unsafeNode k v lr r) - - height :: Map k v -> Int - height = case _ of - Leaf -> 0 - Node h _ _ _ _ _ -> h - --- | Low-level Node constructor from two Maps. --- | This is unsafe because it assumes the child Maps are ordered. -unsafeJoinNodes :: forall k v. Fn2 (Map k v) (Map k v) (Map k v) -unsafeJoinNodes = mkFn2 case _, _ of - Leaf, b -> b - Node _ _ lk lv ll lr, r -> do - let (SplitLast k v l) = runFn4 unsafeSplitLast lk lv ll lr - runFn4 unsafeBalancedNode k v l r - -data SplitLast k v = SplitLast k v (Map k v) - --- | Reassociates a node by moving the last node to the top. --- | This is unsafe because it assumes the key and child Maps are from --- | a balanced node. -unsafeSplitLast :: forall k v. Fn4 k v (Map k v) (Map k v) (SplitLast k v) -unsafeSplitLast = mkFn4 \k v l r -> case r of - Leaf -> SplitLast k v l - Node _ _ rk rv rl rr -> do - let (SplitLast k' v' t') = runFn4 unsafeSplitLast rk rv rl rr - SplitLast k' v' (runFn4 unsafeBalancedNode k v l t') - -data Split k v = Split (Maybe v) (Map k v) (Map k v) - --- | Reassocates a Map so the given key is at the top. --- | This is unsafe because it assumes the ordering function is appropriate. -unsafeSplit :: forall k v. Fn3 (k -> k -> Ordering) k (Map k v) (Split k v) -unsafeSplit = mkFn3 \comp k m -> case m of - Leaf -> - Split Nothing Leaf Leaf - Node _ _ mk mv ml mr -> - case comp k mk of - LT -> do - let (Split b ll lr) = runFn3 unsafeSplit comp k ml - Split b ll (runFn4 unsafeBalancedNode mk mv lr mr) - GT -> do - let (Split b rl rr) = runFn3 unsafeSplit comp k mr - Split b (runFn4 unsafeBalancedNode mk mv ml rl) rr - EQ -> - Split (Just mv) ml mr - --- | Low-level unionWith implementation. --- | This is unsafe because it assumes the ordering function is appropriate. -unsafeUnionWith :: forall k v. Fn4 (k -> k -> Ordering) (v -> v -> v) (Map k v) (Map k v) (Map k v) -unsafeUnionWith = mkFn4 \comp app l r -> case l, r of - Leaf, _ -> r - _, Leaf -> l - _, Node _ _ rk rv rl rr -> do - let (Split lv ll lr) = runFn3 unsafeSplit comp rk l - let l' = runFn4 unsafeUnionWith comp app ll rl - let r' = runFn4 unsafeUnionWith comp app lr rr - case lv of - Just lv' -> - runFn4 unsafeBalancedNode rk (app lv' rv) l' r' - Nothing -> - runFn4 unsafeBalancedNode rk rv l' r' - --- | Low-level intersectionWith implementation. --- | This is unsafe because it assumes the ordering function is appropriate. -unsafeIntersectionWith :: forall k a b c. Fn4 (k -> k -> Ordering) (a -> b -> c) (Map k a) (Map k b) (Map k c) -unsafeIntersectionWith = mkFn4 \comp app l r -> case l, r of - Leaf, _ -> Leaf - _, Leaf -> Leaf - _, Node _ _ rk rv rl rr -> do - let (Split lv ll lr) = runFn3 unsafeSplit comp rk l - let l' = runFn4 unsafeIntersectionWith comp app ll rl - let r' = runFn4 unsafeIntersectionWith comp app lr rr - case lv of - Just lv' -> - runFn4 unsafeBalancedNode rk (app lv' rv) l' r' - Nothing -> - runFn2 unsafeJoinNodes l' r' - --- | Low-level difference implementation. --- | This is unsafe because it assumes the ordering function is appropriate. -unsafeDifference :: forall k v w. Fn3 (k -> k -> Ordering) (Map k v) (Map k w) (Map k v) -unsafeDifference = mkFn3 \comp l r -> case l, r of - Leaf, _ -> Leaf - _, Leaf -> l - _, Node _ _ rk _ rl rr -> do - let (Split _ ll lr) = runFn3 unsafeSplit comp rk l - let l' = runFn3 unsafeDifference comp ll rl - let r' = runFn3 unsafeDifference comp lr rr - runFn2 unsafeJoinNodes l' r' - -data MapIterStep k v - = IterDone - | IterNext k v (MapIter k v) - --- | Low-level iteration state for a `Map`. Must be consumed using --- | an appropriate stepper. -data MapIter k v - = IterLeaf - | IterEmit k v (MapIter k v) - | IterNode (Map k v) (MapIter k v) - -instance (Eq k, Eq v) => Eq (MapIter k v) where - eq = go - where - go a b = case stepAsc a of - IterNext k1 v1 a' -> - case stepAsc b of - IterNext k2 v2 b' - | k1 == k2 && v1 == v2 -> - go a' b' - _ -> - false - IterDone -> - true - -instance (Ord k, Ord v) => Ord (MapIter k v) where - compare = go - where - go a b = case stepAsc a, stepAsc b of - IterNext k1 v1 a', IterNext k2 v2 b' -> - case compare k1 k2 of - EQ -> - case compare v1 v2 of - EQ -> - go a' b' - other -> - other - other -> - other - IterDone, b'-> - case b' of - IterDone -> - EQ - _ -> - LT - _, IterDone -> - GT - --- | Converts a Map to a MapIter for iteration using a MapStepper. -toMapIter :: forall k v. Map k v -> MapIter k v -toMapIter = flip IterNode IterLeaf - -type MapStepper k v = MapIter k v -> MapIterStep k v - -type MapStepperCps k v = forall r. (Fn3 k v (MapIter k v) r) -> (Unit -> r) -> MapIter k v -> r - --- | Steps a `MapIter` in ascending order. -stepAsc :: forall k v. MapStepper k v -stepAsc = stepAscCps (mkFn3 \k v next -> IterNext k v next) (const IterDone) - --- | Steps a `MapIter` in descending order. -stepDesc :: forall k v. MapStepper k v -stepDesc = stepDescCps (mkFn3 \k v next -> IterNext k v next) (const IterDone) - --- | Steps a `MapIter` in arbitrary order. -stepUnordered :: forall k v. MapStepper k v -stepUnordered = stepUnorderedCps (mkFn3 \k v next -> IterNext k v next) (const IterDone) - --- | Steps a `MapIter` in ascending order with a CPS encoding. -stepAscCps :: forall k v. MapStepperCps k v -stepAscCps = stepWith iterMapL - --- | Steps a `MapIter` in descending order with a CPS encoding. -stepDescCps :: forall k v. MapStepperCps k v -stepDescCps = stepWith iterMapR - --- | Steps a `MapIter` in arbitrary order with a CPS encoding. -stepUnorderedCps :: forall k v. MapStepperCps k v -stepUnorderedCps = stepWith iterMapU - -stepUnfoldr :: forall k v. MapIter k v -> Maybe (Tuple (Tuple k v) (MapIter k v)) -stepUnfoldr = stepAscCps step (\_ -> Nothing) - where - step = mkFn3 \k v next -> - Just (Tuple (Tuple k v) next) - -stepUnfoldrUnordered :: forall k v. MapIter k v -> Maybe (Tuple (Tuple k v) (MapIter k v)) -stepUnfoldrUnordered = stepUnorderedCps step (\_ -> Nothing) - where - step = mkFn3 \k v next -> - Just (Tuple (Tuple k v) next) - -stepWith :: forall k v r. (MapIter k v -> Map k v -> MapIter k v) -> (Fn3 k v (MapIter k v) r) -> (Unit -> r) -> MapIter k v -> r -stepWith f next done = go - where - go = case _ of - IterLeaf -> - done unit - IterEmit k v iter -> - runFn3 next k v iter - IterNode m iter -> - go (f iter m) - -iterMapL :: forall k v. MapIter k v -> Map k v -> MapIter k v -iterMapL = go - where - go iter = case _ of - Leaf -> iter - Node _ _ k v l r -> - case r of - Leaf -> - go (IterEmit k v iter) l - _ -> - go (IterEmit k v (IterNode r iter)) l - -iterMapR :: forall k v. MapIter k v -> Map k v -> MapIter k v -iterMapR = go - where - go iter = case _ of - Leaf -> iter - Node _ _ k v l r -> - case r of - Leaf -> - go (IterEmit k v iter) l - _ -> - go (IterEmit k v (IterNode l iter)) r - -iterMapU :: forall k v. MapIter k v -> Map k v -> MapIter k v -iterMapU iter = case _ of - Leaf -> iter - Node _ _ k v l r -> - case l of - Leaf -> - case r of - Leaf -> - IterEmit k v iter - _ -> - IterEmit k v (IterNode r iter) - _ -> - case r of - Leaf -> - IterEmit k v (IterNode l iter) - _ -> - IterEmit k v (IterNode l (IterNode r iter)) diff --git a/stdlib/lib/Data/Maybe.purs b/stdlib/lib/Data/Maybe.purs deleted file mode 100644 index 743279b1..00000000 --- a/stdlib/lib/Data/Maybe.purs +++ /dev/null @@ -1,312 +0,0 @@ -module Data.Maybe where - -import Prelude - -import Control.Alt (class Alt, (<|>)) -import Control.Alternative (class Alternative) -import Control.Extend (class Extend) -import Control.Plus (class Plus) - -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.Generic.Rep (class Generic) -import Data.Ord (class Ord1) - --- | The `Maybe` type is used to represent optional values and can be seen as --- | something like a type-safe `null`, where `Nothing` is `null` and `Just x` --- | is the non-null value `x`. -data Maybe a = Nothing | Just a - --- | The `Functor` instance allows functions to transform the contents of a --- | `Just` with the `<$>` operator: --- | --- | ``` purescript --- | f <$> Just x == Just (f x) --- | ``` --- | --- | `Nothing` values are left untouched: --- | --- | ``` purescript --- | f <$> Nothing == Nothing --- | ``` -instance functorMaybe :: Functor Maybe where - map fn (Just x) = Just (fn x) - map _ _ = Nothing - --- | The `Apply` instance allows functions contained within a `Just` to --- | transform a value contained within a `Just` using the `apply` operator: --- | --- | ``` purescript --- | Just f <*> Just x == Just (f x) --- | ``` --- | --- | `Nothing` values are left untouched: --- | --- | ``` purescript --- | Just f <*> Nothing == Nothing --- | Nothing <*> Just x == Nothing --- | ``` --- | --- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used transform a --- | pure function to take `Maybe`-typed arguments so `f :: a -> b -> c` --- | becomes `f :: Maybe a -> Maybe b -> Maybe c`: --- | --- | ``` purescript --- | f <$> Just x <*> Just y == Just (f x y) --- | ``` --- | --- | The `Nothing`-preserving behaviour of both operators means the result of --- | an expression like the above but where any one of the values is `Nothing` --- | means the whole result becomes `Nothing` also: --- | --- | ``` purescript --- | f <$> Nothing <*> Just y == Nothing --- | f <$> Just x <*> Nothing == Nothing --- | f <$> Nothing <*> Nothing == Nothing --- | ``` -instance applyMaybe :: Apply Maybe where - apply (Just fn) x = fn <$> x - apply Nothing _ = Nothing - --- | The `Applicative` instance enables lifting of values into `Maybe` with the --- | `pure` function: --- | --- | ``` purescript --- | pure x :: Maybe _ == Just x --- | ``` --- | --- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s --- | `pure` can be used to pass a mixture of `Maybe` and non-`Maybe` typed --- | values to a function that does not usually expect them, by using `pure` --- | for any value that is not already `Maybe` typed: --- | --- | ``` purescript --- | f <$> Just x <*> pure y == Just (f x y) --- | ``` --- | --- | Even though `pure = Just` it is recommended to use `pure` in situations --- | like this as it allows the choice of `Applicative` to be changed later --- | without having to go through and replace `Just` with a new constructor. -instance applicativeMaybe :: Applicative Maybe where - pure = Just - --- | The `Alt` instance allows for a choice to be made between two `Maybe` --- | values with the `<|>` operator, where the first `Just` encountered --- | is taken. --- | --- | ``` purescript --- | Just x <|> Just y == Just x --- | Nothing <|> Just y == Just y --- | Nothing <|> Nothing == Nothing --- | ``` -instance altMaybe :: Alt Maybe where - alt Nothing r = r - alt l _ = l - --- | The `Plus` instance provides a default `Maybe` value: --- | --- | ``` purescript --- | empty :: Maybe _ == Nothing --- | ``` -instance plusMaybe :: Plus Maybe where - empty = Nothing - --- | The `Alternative` instance guarantees that there are both `Applicative` and --- | `Plus` instances for `Maybe`. -instance alternativeMaybe :: Alternative Maybe - --- | The `Bind` instance allows sequencing of `Maybe` values and functions that --- | return a `Maybe` by using the `>>=` operator: --- | --- | ``` purescript --- | Just x >>= f = f x --- | Nothing >>= f = Nothing --- | ``` -instance bindMaybe :: Bind Maybe where - bind (Just x) k = k x - bind Nothing _ = Nothing - --- | The `Monad` instance guarantees that there are both `Applicative` and --- | `Bind` instances for `Maybe`. This also enables the `do` syntactic sugar: --- | --- | ``` purescript --- | do --- | x' <- x --- | y' <- y --- | pure (f x' y') --- | ``` --- | --- | Which is equivalent to: --- | --- | ``` purescript --- | x >>= (\x' -> y >>= (\y' -> pure (f x' y'))) --- | ``` --- | --- | Which is equivalent to: --- | --- | ``` purescript --- | case x of --- | Nothing -> Nothing --- | Just x' -> case y of --- | Nothing -> Nothing --- | Just y' -> Just (f x' y') --- | ``` -instance monadMaybe :: Monad Maybe - --- | The `Extend` instance allows sequencing of `Maybe` values and functions --- | that accept a `Maybe a` and return a non-`Maybe` result using the --- | `<<=` operator. --- | --- | ``` purescript --- | f <<= Nothing = Nothing --- | f <<= x = Just (f x) --- | ``` -instance extendMaybe :: Extend Maybe where - extend _ Nothing = Nothing - extend f x = Just (f x) - -instance invariantMaybe :: Invariant Maybe where - imap = imapF - --- | The `Semigroup` instance enables use of the operator `<>` on `Maybe` values --- | whenever there is a `Semigroup` instance for the type the `Maybe` contains. --- | The exact behaviour of `<>` depends on the "inner" `Semigroup` instance, --- | but generally captures the notion of appending or combining things. --- | --- | ``` purescript --- | Just x <> Just y = Just (x <> y) --- | Just x <> Nothing = Just x --- | Nothing <> Just y = Just y --- | Nothing <> Nothing = Nothing --- | ``` -instance semigroupMaybe :: Semigroup a => Semigroup (Maybe a) where - append Nothing y = y - append x Nothing = x - append (Just x) (Just y) = Just (x <> y) - -instance monoidMaybe :: Semigroup a => Monoid (Maybe a) where - mempty = Nothing - -instance semiringMaybe :: Semiring a => Semiring (Maybe a) where - zero = Nothing - one = Just one - - add Nothing y = y - add x Nothing = x - add (Just x) (Just y) = Just (add x y) - - mul x y = mul <$> x <*> y - --- | The `Eq` instance allows `Maybe` values to be checked for equality with --- | `==` and inequality with `/=` whenever there is an `Eq` instance for the --- | type the `Maybe` contains. -derive instance eqMaybe :: Eq a => Eq (Maybe a) - -instance eq1Maybe :: Eq1 Maybe where eq1 = eq - --- | The `Ord` instance allows `Maybe` values to be compared with --- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for --- | the type the `Maybe` contains. --- | --- | `Nothing` is considered to be less than any `Just` value. -derive instance ordMaybe :: Ord a => Ord (Maybe a) - -instance ord1Maybe :: Ord1 Maybe where compare1 = compare - -instance boundedMaybe :: Bounded a => Bounded (Maybe a) where - top = Just top - bottom = Nothing - --- | The `Show` instance allows `Maybe` values to be rendered as a string with --- | `show` whenever there is an `Show` instance for the type the `Maybe` --- | contains. -instance showMaybe :: Show a => Show (Maybe a) where - show (Just x) = "(Just " <> show x <> ")" - show Nothing = "Nothing" - -derive instance genericMaybe :: Generic (Maybe a) _ - --- | Takes a default value, a function, and a `Maybe` value. If the `Maybe` --- | value is `Nothing` the default value is returned, otherwise the function --- | is applied to the value inside the `Just` and the result is returned. --- | --- | ``` purescript --- | maybe x f Nothing == x --- | maybe x f (Just y) == f y --- | ``` -maybe :: forall a b. b -> (a -> b) -> Maybe a -> b -maybe b _ Nothing = b -maybe _ f (Just a) = f a - --- | Similar to `maybe` but for use in cases where the default value may be --- | expensive to compute. As PureScript is not lazy, the standard `maybe` has --- | to evaluate the default value before returning the result, whereas here --- | the value is only computed when the `Maybe` is known to be `Nothing`. --- | --- | ``` purescript --- | maybe' (\_ -> x) f Nothing == x --- | maybe' (\_ -> x) f (Just y) == f y --- | ``` -maybe' :: forall a b. (Unit -> b) -> (a -> b) -> Maybe a -> b -maybe' g _ Nothing = g unit -maybe' _ f (Just a) = f a - --- | Takes a default value, and a `Maybe` value. If the `Maybe` value is --- | `Nothing` the default value is returned, otherwise the value inside the --- | `Just` is returned. --- | --- | ``` purescript --- | fromMaybe x Nothing == x --- | fromMaybe x (Just y) == y --- | ``` -fromMaybe :: forall a. a -> Maybe a -> a -fromMaybe a = maybe a identity - --- | Similar to `fromMaybe` but for use in cases where the default value may be --- | expensive to compute. As PureScript is not lazy, the standard `fromMaybe` --- | has to evaluate the default value before returning the result, whereas here --- | the value is only computed when the `Maybe` is known to be `Nothing`. --- | --- | ``` purescript --- | fromMaybe' (\_ -> x) Nothing == x --- | fromMaybe' (\_ -> x) (Just y) == y --- | ``` -fromMaybe' :: forall a. (Unit -> a) -> Maybe a -> a -fromMaybe' a = maybe' a identity - --- | Returns `true` when the `Maybe` value was constructed with `Just`. -isJust :: forall a. Maybe a -> Boolean -isJust = maybe false (const true) - --- | Returns `true` when the `Maybe` value is `Nothing`. -isNothing :: forall a. Maybe a -> Boolean -isNothing = maybe true (const false) - --- | A partial function that extracts the value from the `Just` data --- | constructor. Passing `Nothing` to `fromJust` will throw an error at --- | runtime. -fromJust :: forall a. Partial => Maybe a -> a -fromJust (Just x) = x - --- | One or none. --- | --- | ```purescript --- | optional empty = pure Nothing --- | ``` --- | --- | The behaviour of `optional (pure x)` depends on whether the `Alt` instance --- | satisfy the left catch law (`pure a <|> b = pure a`). --- | --- | `Either e` does: --- | --- | ```purescript --- | optional (Right x) = Right (Just x) --- | ``` --- | --- | But `Array` does not: --- | --- | ```purescript --- | optional [x] = [Just x, Nothing] --- | ``` -optional :: forall f a. Alt f => Applicative f => f a -> f (Maybe a) -optional a = map Just a <|> pure Nothing diff --git a/stdlib/lib/Data/Maybe/First.purs b/stdlib/lib/Data/Maybe/First.purs deleted file mode 100644 index 2641c5cb..00000000 --- a/stdlib/lib/Data/Maybe/First.purs +++ /dev/null @@ -1,68 +0,0 @@ -module Data.Maybe.First where - -import Prelude - -import Control.Alt (class Alt) -import Control.Alternative (class Alternative) -import Control.Extend (class Extend) -import Control.Plus (class Plus) - -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant) -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) - --- | Monoid returning the first (left-most) non-`Nothing` value. --- | --- | ``` purescript --- | First (Just x) <> First (Just y) == First (Just x) --- | First Nothing <> First (Just y) == First (Just y) --- | First Nothing <> First Nothing == First Nothing --- | mempty :: First _ == First Nothing --- | ``` -newtype First a = First (Maybe a) - -derive instance newtypeFirst :: Newtype (First a) _ - -derive newtype instance eqFirst :: (Eq a) => Eq (First a) - -derive newtype instance eq1First :: Eq1 First - -derive newtype instance ordFirst :: (Ord a) => Ord (First a) - -derive newtype instance ord1First :: Ord1 First - -derive newtype instance boundedFirst :: (Bounded a) => Bounded (First a) - -derive newtype instance functorFirst :: Functor First - -derive newtype instance invariantFirst :: Invariant First - -derive newtype instance applyFirst :: Apply First - -derive newtype instance applicativeFirst :: Applicative First - -derive newtype instance bindFirst :: Bind First - -derive newtype instance monadFirst :: Monad First - -derive newtype instance extendFirst :: Extend First - -instance showFirst :: (Show a) => Show (First a) where - show (First a) = "First (" <> show a <> ")" - -instance semigroupFirst :: Semigroup (First a) where - append first@(First (Just _)) _ = first - append _ second = second - -instance monoidFirst :: Monoid (First a) where - mempty = First Nothing - -instance altFirst :: Alt First where - alt = append - -instance plusFirst :: Plus First where - empty = mempty - -instance alternativeFirst :: Alternative First diff --git a/stdlib/lib/Data/Maybe/Last.purs b/stdlib/lib/Data/Maybe/Last.purs deleted file mode 100644 index b70502cd..00000000 --- a/stdlib/lib/Data/Maybe/Last.purs +++ /dev/null @@ -1,67 +0,0 @@ -module Data.Maybe.Last where - -import Prelude - -import Control.Alt (class Alt) -import Control.Alternative (class Alternative) -import Control.Extend (class Extend) -import Control.Plus (class Plus) -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant) -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) - --- | Monoid returning the last (right-most) non-`Nothing` value. --- | --- | ``` purescript --- | Last (Just x) <> Last (Just y) == Last (Just y) --- | Last (Just x) <> Last Nothing == Last (Just x) --- | Last Nothing <> Last Nothing == Last Nothing --- | mempty :: Last _ == Last Nothing --- | ``` -newtype Last a = Last (Maybe a) - -derive instance newtypeLast :: Newtype (Last a) _ - -derive newtype instance eqLast :: (Eq a) => Eq (Last a) - -derive newtype instance eq1Last :: Eq1 Last - -derive newtype instance ordLast :: (Ord a) => Ord (Last a) - -derive newtype instance ord1Last :: Ord1 Last - -derive newtype instance boundedLast :: (Bounded a) => Bounded (Last a) - -derive newtype instance functorLast :: Functor Last - -derive newtype instance invariantLast :: Invariant Last - -derive newtype instance applyLast :: Apply Last - -derive newtype instance applicativeLast :: Applicative Last - -derive newtype instance bindLast :: Bind Last - -derive newtype instance monadLast :: Monad Last - -derive newtype instance extendLast :: Extend Last - -instance showLast :: Show a => Show (Last a) where - show (Last a) = "(Last " <> show a <> ")" - -instance semigroupLast :: Semigroup (Last a) where - append _ last@(Last (Just _)) = last - append last (Last Nothing) = last - -instance monoidLast :: Monoid (Last a) where - mempty = Last Nothing - -instance altLast :: Alt Last where - alt = append - -instance plusLast :: Plus Last where - empty = mempty - -instance alternativeLast :: Alternative Last diff --git a/stdlib/lib/Data/Monoid.purs b/stdlib/lib/Data/Monoid.purs deleted file mode 100644 index 96edcddd..00000000 --- a/stdlib/lib/Data/Monoid.purs +++ /dev/null @@ -1,120 +0,0 @@ -module Data.Monoid - ( class Monoid - , mempty - , power - , guard - , module Data.Semigroup - , class MonoidRecord - , memptyRecord - ) where - -import Data.Boolean (otherwise) -import Data.Eq ((==)) -import Data.EuclideanRing (mod, (/)) -import Data.Ord ((<=)) -import Data.Ordering (Ordering(..)) -import Data.Semigroup (class Semigroup, class SemigroupRecord, (<>)) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit, unit) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeSet) -import Type.Proxy (Proxy(..)) - --- | A `Monoid` is a `Semigroup` with a value `mempty`, which is both a --- | left and right unit for the associative operation `<>`: --- | --- | - Left unit: `(mempty <> x) = x` --- | - Right unit: `(x <> mempty) = x` --- | --- | `Monoid`s are commonly used as the result of fold operations, where --- | `<>` is used to combine individual results, and `mempty` gives the result --- | of folding an empty collection of elements. --- | --- | ### Newtypes for Monoid --- | --- | Some types (e.g. `Int`, `Boolean`) can implement multiple law-abiding --- | instances for `Monoid`. Let's use `Int` as an example --- | 1. `<>` could be `+` and `mempty` could be `0` --- | 2. `<>` could be `*` and `mempty` could be `1`. --- | --- | To clarify these ambiguous situations, one should use the newtypes --- | defined in `Data.Monoid.` modules. --- | --- | In the above ambiguous situation, we could use `Additive` --- | for the first situation or `Multiplicative` for the second one. -class Semigroup m <= Monoid m where - mempty :: m - -instance monoidUnit :: Monoid Unit where - mempty = unit - -instance monoidOrdering :: Monoid Ordering where - mempty = EQ - -instance monoidFn :: Monoid b => Monoid (a -> b) where - mempty _ = mempty - -instance monoidString :: Monoid String where - mempty = "" - -instance monoidArray :: Monoid (Array a) where - mempty = [] - -instance monoidRecord :: (RL.RowToList row list, MonoidRecord list row row) => Monoid (Record row) where - mempty = memptyRecord (Proxy :: Proxy list) - --- | Append a value to itself a certain number of times. For the --- | `Multiplicative` type, and for a non-negative power, this is the same as --- | normal number exponentiation. --- | --- | If the second argument is negative this function will return `mempty` --- | (*unlike* normal number exponentiation). The `Monoid` constraint alone --- | is not enough to write a `power` function with the property that `power x --- | n` cancels with `power x (-n)`, i.e. `power x n <> power x (-n) = mempty`. --- | For that, we would additionally need the ability to invert elements, i.e. --- | a Group. --- | --- | ```purescript --- | power [1,2] 3 == [1,2,1,2,1,2] --- | power [1,2] 1 == [1,2] --- | power [1,2] 0 == [] --- | power [1,2] (-3) == [] --- | ``` --- | -power :: forall m. Monoid m => m -> Int -> m -power x = go - where - go :: Int -> m - go p - | p <= 0 = mempty - | p == 1 = x - | p `mod` 2 == 0 = let x' = go (p / 2) in x' <> x' - | otherwise = let x' = go (p / 2) in x' <> x' <> x - --- | Allow or "truncate" a Monoid to its `mempty` value based on a condition. -guard :: forall m. Monoid m => Boolean -> m -> m -guard true a = a -guard false _ = mempty - --- | A class for records where all fields have `Monoid` instances, used to --- | implement the `Monoid` instance for records. -class MonoidRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class SemigroupRecord rowlist row subrow <= MonoidRecord rowlist row subrow | rowlist -> row subrow where - memptyRecord :: Proxy rowlist -> Record subrow - -instance monoidRecordNil :: MonoidRecord RL.Nil row () where - memptyRecord _ = {} - -instance monoidRecordCons :: - ( IsSymbol key - , Monoid focus - , Row.Cons key focus subrowTail subrow - , MonoidRecord rowlistTail row subrowTail - ) => - MonoidRecord (RL.Cons key focus rowlistTail) row subrow where - memptyRecord _ = insert mempty tail - where - key = reflectSymbol (Proxy :: Proxy key) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = memptyRecord (Proxy :: Proxy rowlistTail) diff --git a/stdlib/lib/Data/Monoid/Additive.purs b/stdlib/lib/Data/Monoid/Additive.purs deleted file mode 100644 index 62396dd6..00000000 --- a/stdlib/lib/Data/Monoid/Additive.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Monoid.Additive where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Ord (class Ord1) - --- | Monoid and semigroup for semirings under addition. --- | --- | ``` purescript --- | Additive x <> Additive y == Additive (x + y) --- | (mempty :: Additive _) == Additive zero --- | ``` -newtype Additive a = Additive a - -derive newtype instance eqAdditive :: Eq a => Eq (Additive a) -derive instance eq1Additive :: Eq1 Additive - -derive newtype instance ordAdditive :: Ord a => Ord (Additive a) -derive instance ord1Additive :: Ord1 Additive - -derive newtype instance boundedAdditive :: Bounded a => Bounded (Additive a) - -instance showAdditive :: Show a => Show (Additive a) where - show (Additive a) = "(Additive " <> show a <> ")" - -derive instance functorAdditive :: Functor Additive - -instance applyAdditive :: Apply Additive where - apply (Additive f) (Additive x) = Additive (f x) - -instance applicativeAdditive :: Applicative Additive where - pure = Additive - -instance bindAdditive :: Bind Additive where - bind (Additive x) f = f x - -instance monadAdditive :: Monad Additive - -instance semigroupAdditive :: Semiring a => Semigroup (Additive a) where - append (Additive a) (Additive b) = Additive (a + b) - -instance monoidAdditive :: Semiring a => Monoid (Additive a) where - mempty = Additive zero diff --git a/stdlib/lib/Data/Monoid/Alternate.purs b/stdlib/lib/Data/Monoid/Alternate.purs deleted file mode 100644 index 9a16f1e8..00000000 --- a/stdlib/lib/Data/Monoid/Alternate.purs +++ /dev/null @@ -1,60 +0,0 @@ -module Data.Monoid.Alternate where - -import Prelude - -import Control.Alternative (class Alt, class Plus, class Alternative, empty, (<|>)) -import Control.Comonad (class Comonad, class Extend) -import Data.Eq (class Eq1) -import Data.Newtype (class Newtype) -import Data.Ord (class Ord1) - --- | Monoid and semigroup instances corresponding to `Plus` and `Alt` instances --- | for `f` --- | --- | ``` purescript --- | Alternate fx <> Alternate fy == Alternate (fx <|> fy) --- | mempty :: Alternate _ == Alternate empty --- | ``` -newtype Alternate :: forall k. (k -> Type) -> k -> Type -newtype Alternate f a = Alternate (f a) - -derive instance newtypeAlternate :: Newtype (Alternate f a) _ - -derive newtype instance eqAlternate :: Eq (f a) => Eq (Alternate f a) - -derive newtype instance eq1Alternate :: Eq1 f => Eq1 (Alternate f) - -derive newtype instance ordAlternate :: Ord (f a) => Ord (Alternate f a) - -derive newtype instance ord1Alternate :: Ord1 f => Ord1 (Alternate f) - -derive newtype instance boundedAlternate :: Bounded (f a) => Bounded (Alternate f a) - -derive newtype instance functorAlternate :: Functor f => Functor (Alternate f) - -derive newtype instance applyAlternate :: Apply f => Apply (Alternate f) - -derive newtype instance applicativeAlternate :: Applicative f => Applicative (Alternate f) - -derive newtype instance altAlternate :: Alt f => Alt (Alternate f) - -derive newtype instance plusAlternate :: Plus f => Plus (Alternate f) - -derive newtype instance alternativeAlternate :: Alternative f => Alternative (Alternate f) - -derive newtype instance bindAlternate :: Bind f => Bind (Alternate f) - -derive newtype instance monadAlternate :: Monad f => Monad (Alternate f) - -derive newtype instance extendAlternate :: Extend f => Extend (Alternate f) - -derive newtype instance comonadAlternate :: Comonad f => Comonad (Alternate f) - -instance showAlternate :: Show (f a) => Show (Alternate f a) where - show (Alternate a) = "(Alternate " <> show a <> ")" - -instance semigroupAlternate :: Alt f => Semigroup (Alternate f a) where - append (Alternate a) (Alternate b) = Alternate (a <|> b) - -instance monoidAlternate :: Plus f => Monoid (Alternate f a) where - mempty = Alternate empty diff --git a/stdlib/lib/Data/Monoid/Conj.purs b/stdlib/lib/Data/Monoid/Conj.purs deleted file mode 100644 index 6dc93630..00000000 --- a/stdlib/lib/Data/Monoid/Conj.purs +++ /dev/null @@ -1,51 +0,0 @@ -module Data.Monoid.Conj where - -import Prelude - -import Data.Eq (class Eq1) -import Data.HeytingAlgebra (ff, tt) -import Data.Ord (class Ord1) - --- | Monoid and semigroup for conjunction. --- | --- | ``` purescript --- | Conj x <> Conj y == Conj (x && y) --- | (mempty :: Conj _) == Conj tt --- | ``` -newtype Conj a = Conj a - -derive newtype instance eqConj :: Eq a => Eq (Conj a) -derive instance eq1Conj :: Eq1 Conj - -derive newtype instance ordConj :: Ord a => Ord (Conj a) -derive instance ord1Conj :: Ord1 Conj - -derive newtype instance boundedConj :: Bounded a => Bounded (Conj a) - -instance showConj :: (Show a) => Show (Conj a) where - show (Conj a) = "(Conj " <> show a <> ")" - -derive instance functorConj :: Functor Conj - -instance applyConj :: Apply Conj where - apply (Conj f) (Conj x) = Conj (f x) - -instance applicativeConj :: Applicative Conj where - pure = Conj - -instance bindConj :: Bind Conj where - bind (Conj x) f = f x - -instance monadConj :: Monad Conj - -instance semigroupConj :: HeytingAlgebra a => Semigroup (Conj a) where - append (Conj a) (Conj b) = Conj (conj a b) - -instance monoidConj :: HeytingAlgebra a => Monoid (Conj a) where - mempty = Conj tt - -instance semiringConj :: HeytingAlgebra a => Semiring (Conj a) where - zero = Conj tt - one = Conj ff - add (Conj a) (Conj b) = Conj (conj a b) - mul (Conj a) (Conj b) = Conj (disj a b) diff --git a/stdlib/lib/Data/Monoid/Disj.purs b/stdlib/lib/Data/Monoid/Disj.purs deleted file mode 100644 index 1036c843..00000000 --- a/stdlib/lib/Data/Monoid/Disj.purs +++ /dev/null @@ -1,51 +0,0 @@ -module Data.Monoid.Disj where - -import Prelude - -import Data.Eq (class Eq1) -import Data.HeytingAlgebra (ff, tt) -import Data.Ord (class Ord1) - --- | Monoid and semigroup for disjunction. --- | --- | ``` purescript --- | Disj x <> Disj y == Disj (x || y) --- | (mempty :: Disj _) == Disj bottom --- | ``` -newtype Disj a = Disj a - -derive newtype instance eqDisj :: Eq a => Eq (Disj a) -derive instance eq1Disj :: Eq1 Disj - -derive newtype instance ordDisj :: Ord a => Ord (Disj a) -derive instance ord1Disj :: Ord1 Disj - -derive newtype instance boundedDisj :: Bounded a => Bounded (Disj a) - -instance showDisj :: Show a => Show (Disj a) where - show (Disj a) = "(Disj " <> show a <> ")" - -derive instance functorDisj :: Functor Disj - -instance applyDisj :: Apply Disj where - apply (Disj f) (Disj x) = Disj (f x) - -instance applicativeDisj :: Applicative Disj where - pure = Disj - -instance bindDisj :: Bind Disj where - bind (Disj x) f = f x - -instance monadDisj :: Monad Disj - -instance semigroupDisj :: HeytingAlgebra a => Semigroup (Disj a) where - append (Disj a) (Disj b) = Disj (disj a b) - -instance monoidDisj :: HeytingAlgebra a => Monoid (Disj a) where - mempty = Disj ff - -instance semiringDisj :: HeytingAlgebra a => Semiring (Disj a) where - zero = Disj ff - one = Disj tt - add (Disj a) (Disj b) = Disj (disj a b) - mul (Disj a) (Disj b) = Disj (conj a b) diff --git a/stdlib/lib/Data/Monoid/Dual.purs b/stdlib/lib/Data/Monoid/Dual.purs deleted file mode 100644 index 09168b88..00000000 --- a/stdlib/lib/Data/Monoid/Dual.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Monoid.Dual where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Ord (class Ord1) - --- | The dual of a monoid. --- | --- | ``` purescript --- | Dual x <> Dual y == Dual (y <> x) --- | (mempty :: Dual _) == Dual mempty --- | ``` -newtype Dual a = Dual a - -derive newtype instance eqDual :: Eq a => Eq (Dual a) -derive instance eq1Dual :: Eq1 Dual - -derive newtype instance ordDual :: Ord a => Ord (Dual a) -derive instance ord1Dual :: Ord1 Dual - -derive newtype instance boundedDual :: Bounded a => Bounded (Dual a) - -instance showDual :: Show a => Show (Dual a) where - show (Dual a) = "(Dual " <> show a <> ")" - -derive instance functorDual :: Functor Dual - -instance applyDual :: Apply Dual where - apply (Dual f) (Dual x) = Dual (f x) - -instance applicativeDual :: Applicative Dual where - pure = Dual - -instance bindDual :: Bind Dual where - bind (Dual x) f = f x - -instance monadDual :: Monad Dual - -instance semigroupDual :: Semigroup a => Semigroup (Dual a) where - append (Dual x) (Dual y) = Dual (y <> x) - -instance monoidDual :: Monoid a => Monoid (Dual a) where - mempty = Dual mempty diff --git a/stdlib/lib/Data/Monoid/Endo.purs b/stdlib/lib/Data/Monoid/Endo.purs deleted file mode 100644 index f88ba149..00000000 --- a/stdlib/lib/Data/Monoid/Endo.purs +++ /dev/null @@ -1,30 +0,0 @@ -module Data.Monoid.Endo where - -import Prelude - --- | Monoid and semigroup for category endomorphisms. --- | --- | When `c` is instantiated with `->` this composes functions of type --- | `a -> a`: --- | --- | ``` purescript --- | Endo f <> Endo g == Endo (f <<< g) --- | (mempty :: Endo _) == Endo identity --- | ``` -newtype Endo :: forall k. (k -> k -> Type) -> k -> Type -newtype Endo c a = Endo (c a a) - -derive newtype instance eqEndo :: Eq (c a a) => Eq (Endo c a) - -derive newtype instance ordEndo :: Ord (c a a) => Ord (Endo c a) - -derive newtype instance boundedEndo :: Bounded (c a a) => Bounded (Endo c a) - -instance showEndo :: Show (c a a) => Show (Endo c a) where - show (Endo x) = "(Endo " <> show x <> ")" - -instance semigroupEndo :: Semigroupoid c => Semigroup (Endo c a) where - append (Endo a) (Endo b) = Endo (a <<< b) - -instance monoidEndo :: Category c => Monoid (Endo c a) where - mempty = Endo identity diff --git a/stdlib/lib/Data/Monoid/Generic.purs b/stdlib/lib/Data/Monoid/Generic.purs deleted file mode 100644 index a73232df..00000000 --- a/stdlib/lib/Data/Monoid/Generic.purs +++ /dev/null @@ -1,27 +0,0 @@ -module Data.Monoid.Generic - ( class GenericMonoid - , genericMempty' - , genericMempty - ) where - -import Data.Monoid (class Monoid, mempty) -import Data.Generic.Rep - -class GenericMonoid a where - genericMempty' :: a - -instance genericMonoidNoArguments :: GenericMonoid NoArguments where - genericMempty' = NoArguments - -instance genericMonoidProduct :: (GenericMonoid a, GenericMonoid b) => GenericMonoid (Product a b) where - genericMempty' = Product genericMempty' genericMempty' - -instance genericMonoidConstructor :: GenericMonoid a => GenericMonoid (Constructor name a) where - genericMempty' = Constructor genericMempty' - -instance genericMonoidArgument :: Monoid a => GenericMonoid (Argument a) where - genericMempty' = Argument mempty - --- | A `Generic` implementation of the `mempty` member from the `Monoid` type class. -genericMempty :: forall a rep. Generic a rep => GenericMonoid rep => a -genericMempty = to genericMempty' diff --git a/stdlib/lib/Data/Monoid/Multiplicative.purs b/stdlib/lib/Data/Monoid/Multiplicative.purs deleted file mode 100644 index c0552a0f..00000000 --- a/stdlib/lib/Data/Monoid/Multiplicative.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Monoid.Multiplicative where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Ord (class Ord1) - --- | Monoid and semigroup for semirings under multiplication. --- | --- | ``` purescript --- | Multiplicative x <> Multiplicative y == Multiplicative (x * y) --- | (mempty :: Multiplicative _) == Multiplicative one --- | ``` -newtype Multiplicative a = Multiplicative a - -derive newtype instance eqMultiplicative :: Eq a => Eq (Multiplicative a) -derive instance eq1Multiplicative :: Eq1 Multiplicative - -derive newtype instance ordMultiplicative :: Ord a => Ord (Multiplicative a) -derive instance ord1Multiplicative :: Ord1 Multiplicative - -derive newtype instance boundedMultiplicative :: Bounded a => Bounded (Multiplicative a) - -instance showMultiplicative :: Show a => Show (Multiplicative a) where - show (Multiplicative a) = "(Multiplicative " <> show a <> ")" - -derive instance functorMultiplicative :: Functor Multiplicative - -instance applyMultiplicative :: Apply Multiplicative where - apply (Multiplicative f) (Multiplicative x) = Multiplicative (f x) - -instance applicativeMultiplicative :: Applicative Multiplicative where - pure = Multiplicative - -instance bindMultiplicative :: Bind Multiplicative where - bind (Multiplicative x) f = f x - -instance monadMultiplicative :: Monad Multiplicative - -instance semigroupMultiplicative :: Semiring a => Semigroup (Multiplicative a) where - append (Multiplicative a) (Multiplicative b) = Multiplicative (a * b) - -instance monoidMultiplicative :: Semiring a => Monoid (Multiplicative a) where - mempty = Multiplicative one diff --git a/stdlib/lib/Data/NaturalTransformation.purs b/stdlib/lib/Data/NaturalTransformation.purs deleted file mode 100644 index 682e8a12..00000000 --- a/stdlib/lib/Data/NaturalTransformation.purs +++ /dev/null @@ -1,20 +0,0 @@ -module Data.NaturalTransformation where - --- | A type for natural transformations. --- | --- | A natural transformation is a mapping between type constructors of kind --- | `k -> Type`, for any kind `k`, where the mapping operation has no ability --- | to manipulate the inner values. --- | --- | An example of this is the `fromFoldable` function provided in --- | `purescript-lists`, where some foldable structure containing values of --- | type `a` is converted into a `List a`. --- | --- | The definition of a natural transformation in category theory states that --- | `f` and `g` should be functors, but the `Functor` constraint is not --- | enforced here; that the types are of kind `k -> Type` is enough for our --- | purposes. -type NaturalTransformation :: forall k. (k -> Type) -> (k -> Type) -> Type -type NaturalTransformation f g = forall a. f a -> g a - -infixr 4 type NaturalTransformation as ~> diff --git a/stdlib/lib/Data/Newtype.purs b/stdlib/lib/Data/Newtype.purs deleted file mode 100644 index 1ac00a93..00000000 --- a/stdlib/lib/Data/Newtype.purs +++ /dev/null @@ -1,308 +0,0 @@ -module Data.Newtype where - -import Data.Monoid.Additive (Additive(..)) -import Data.Monoid.Conj (Conj(..)) -import Data.Monoid.Disj (Disj(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Endo (Endo(..)) -import Data.Monoid.Multiplicative (Multiplicative(..)) -import Data.Semigroup.First (First(..)) -import Data.Semigroup.Last (Last(..)) -import Safe.Coerce (class Coercible, coerce) - --- | A type class for `newtype`s to enable convenient wrapping and unwrapping, --- | and the use of the other functions in this module. --- | --- | The compiler can derive instances of `Newtype` automatically: --- | --- | ``` purescript --- | newtype EmailAddress = EmailAddress String --- | --- | derive instance newtypeEmailAddress :: Newtype EmailAddress _ --- | ``` --- | --- | Note that deriving for `Newtype` instances requires that the type be --- | defined as `newtype` rather than `data` declaration (even if the `data` --- | structurally fits the rules of a `newtype`), and the use of a wildcard for --- | the wrapped type. -class Newtype :: Type -> Type -> Constraint -class Coercible t a <= Newtype t a | t -> a - -wrap :: forall t a. Newtype t a => a -> t -wrap = coerce - -unwrap :: forall t a. Newtype t a => t -> a -unwrap = coerce - -instance newtypeAdditive :: Newtype (Additive a) a - -instance newtypeMultiplicative :: Newtype (Multiplicative a) a - -instance newtypeConj :: Newtype (Conj a) a - -instance newtypeDisj :: Newtype (Disj a) a - -instance newtypeDual :: Newtype (Dual a) a - -instance newtypeEndo :: Newtype (Endo c a) (c a a) - -instance newtypeFirst :: Newtype (First a) a - -instance newtypeLast :: Newtype (Last a) a - --- | Given a constructor for a `Newtype`, this returns the appropriate `unwrap` --- | function. -un :: forall t a. Newtype t a => (a -> t) -> t -> a -un _ = unwrap - --- | This combinator unwraps the newtype, applies a monomorphic function to the --- | contained value and wraps the result back in the newtype -modify :: forall t a. Newtype t a => (a -> a) -> t -> t -modify fn t = wrap (fn (unwrap t)) - --- | This combinator is for when you have a higher order function that you want --- | to use in the context of some newtype - `foldMap` being a common example: --- | --- | ``` purescript --- | ala Additive foldMap [1,2,3,4] -- 10 --- | ala Multiplicative foldMap [1,2,3,4] -- 24 --- | ala Conj foldMap [true, false] -- false --- | ala Disj foldMap [true, false] -- true --- | ``` -ala - :: forall f t a s b - . Coercible (f t) (f a) - => Newtype t a - => Newtype s b - => (a -> t) - -> ((b -> s) -> f t) - -> f a -ala _ f = coerce (f wrap) - --- | Similar to `ala` but useful for cases where you want to use an additional --- | projection with the higher order function: --- | --- | ``` purescript --- | alaF Additive foldMap String.length ["hello", "world"] -- 10 --- | alaF Multiplicative foldMap Math.abs [1.0, -2.0, 3.0, -4.0] -- 24.0 --- | ``` --- | --- | The type admits other possibilities due to the polymorphic `Functor` --- | constraints, but the case described above works because ((->) a) is a --- | `Functor`. -alaF - :: forall f g t a s b - . Coercible (f t) (f a) - => Coercible (g s) (g b) - => Newtype t a - => Newtype s b - => (a -> t) - -> (f t -> g s) - -> f a - -> g b -alaF _ = coerce - --- | Lifts a function operate over newtypes. This can be used to lift a --- | function to manipulate the contents of a single newtype, somewhat like --- | `map` does for a `Functor`: --- | --- | ``` purescript --- | newtype Label = Label String --- | derive instance newtypeLabel :: Newtype Label _ --- | --- | toUpperLabel :: Label -> Label --- | toUpperLabel = over Label String.toUpper --- | ``` --- | --- | But the result newtype is polymorphic, meaning the result can be returned --- | as an alternative newtype: --- | --- | ``` purescript --- | newtype UppercaseLabel = UppercaseLabel String --- | derive instance newtypeUppercaseLabel :: Newtype UppercaseLabel _ --- | --- | toUpperLabel' :: Label -> UppercaseLabel --- | toUpperLabel' = over Label String.toUpper --- | ``` -over - :: forall t a s b - . Newtype t a - => Newtype s b - => (a -> t) - -> (a -> b) - -> t - -> s -over _ = coerce - --- | Much like `over`, but where the lifted function operates on values in a --- | `Functor`: --- | --- | ``` purescript --- | findLabel :: String -> Array Label -> Maybe Label --- | findLabel s = overF Label (Foldable.find (_ == s)) --- | ``` --- | --- | The above example also demonstrates that the functor type is polymorphic --- | here too, the input is an `Array` but the result is a `Maybe`. -overF - :: forall f g t a s b - . Coercible (f a) (f t) - => Coercible (g b) (g s) - => Newtype t a - => Newtype s b - => (a -> t) - -> (f a -> g b) - -> f t - -> g s -overF _ = coerce - --- | The opposite of `over`: lowers a function that operates on `Newtype`d --- | values to operate on the wrapped value instead. --- | --- | ``` purescript --- | newtype Degrees = Degrees Number --- | derive instance newtypeDegrees :: Newtype Degrees _ --- | --- | newtype NormalDegrees = NormalDegrees Number --- | derive instance newtypeNormalDegrees :: Newtype NormalDegrees _ --- | --- | normaliseDegrees :: Degrees -> NormalDegrees --- | normaliseDegrees (Degrees deg) = NormalDegrees (deg % 360.0) --- | --- | asNormalDegrees :: Number -> Number --- | asNormalDegrees = under Degrees normaliseDegrees --- | ``` --- | --- | As with `over` the `Newtype` is polymorphic, as illustrated in the example --- | above - both `Degrees` and `NormalDegrees` are instances of `Newtype`, --- | so even though `normaliseDegrees` changes the result type we can still put --- | a `Number` in and get a `Number` out via `under`. -under - :: forall t a s b - . Newtype t a - => Newtype s b - => (a -> t) - -> (t -> s) - -> a - -> b -under _ = coerce - --- | Much like `under`, but where the lifted function operates on values in a --- | `Functor`: --- | --- | ``` purescript --- | newtype EmailAddress = EmailAddress String --- | derive instance newtypeEmailAddress :: Newtype EmailAddress _ --- | --- | isValid :: EmailAddress -> Boolean --- | isValid x = false -- imagine a slightly less strict predicate here --- | --- | findValidEmailString :: Array String -> Maybe String --- | findValidEmailString = underF EmailAddress (Foldable.find isValid) --- | ``` --- | --- | The above example also demonstrates that the functor type is polymorphic --- | here too, the input is an `Array` but the result is a `Maybe`. -underF - :: forall f g t a s b - . Coercible (f t) (f a) - => Coercible (g s) (g b) - => Newtype t a - => Newtype s b - => (a -> t) - -> (f t -> g s) - -> f a - -> g b -underF _ = coerce - --- | Lifts a binary function to operate over newtypes. --- | --- | ``` purescript --- | newtype Meter = Meter Int --- | derive newtype instance newtypeMeter :: Newtype Meter _ --- | newtype SquareMeter = SquareMeter Int --- | derive newtype instance newtypeSquareMeter :: Newtype SquareMeter _ --- | --- | area :: Meter -> Meter -> SquareMeter --- | area = over2 Meter (*) --- | ``` --- | --- | The above example also demonstrates that the return type is polymorphic --- | here too. -over2 - :: forall t a s b - . Newtype t a - => Newtype s b - => (a -> t) - -> (a -> a -> b) - -> t - -> t - -> s -over2 _ = coerce - --- | Much like `over2`, but where the lifted binary function operates on --- | values in a `Functor`. -overF2 - :: forall f g t a s b - . Coercible (f a) (f t) - => Coercible (g b) (g s) - => Newtype t a - => Newtype s b - => (a -> t) - -> (f a -> f a -> g b) - -> f t - -> f t - -> g s -overF2 _ = coerce - --- | The opposite of `over2`: lowers a binary function that operates on `Newtype`d --- | values to operate on the wrapped value instead. -under2 - :: forall t a s b - . Newtype t a - => Newtype s b - => (a -> t) - -> (t -> t -> s) - -> a - -> a - -> b -under2 _ = coerce - --- | Much like `under2`, but where the lifted binary function operates on --- | values in a `Functor`. -underF2 - :: forall f g t a s b - . Coercible (f t) (f a) - => Coercible (g s) (g b) - => Newtype t a - => Newtype s b - => (a -> t) - -> (f t -> f t -> g s) - -> f a - -> f a - -> g b -underF2 _ = coerce - --- | Similar to the function from the `Traversable` class, but operating within --- | a newtype instead. -traverse - :: forall f t a - . Coercible (f a) (f t) - => Newtype t a - => (a -> t) - -> (a -> f a) - -> t - -> f t -traverse _ = coerce - --- | Similar to the function from the `Distributive` class, but operating within --- | a newtype instead. -collect - :: forall f t a - . Coercible (f a) (f t) - => Newtype t a - => (a -> t) - -> (f a -> a) - -> f t - -> t -collect _ = coerce diff --git a/stdlib/lib/Data/NonEmpty.purs b/stdlib/lib/Data/NonEmpty.purs deleted file mode 100644 index 411fa856..00000000 --- a/stdlib/lib/Data/NonEmpty.purs +++ /dev/null @@ -1,174 +0,0 @@ --- | This module defines a generic non-empty data structure, which adds an --- | additional element to any container type. -module Data.NonEmpty - ( NonEmpty(..) - , singleton - , (:|) - , foldl1 - , fromNonEmpty - , oneOf - , head - , tail - ) where - -import Prelude - -import Control.Alt ((<|>)) -import Control.Alternative (class Alternative) -import Control.Plus (class Plus, empty) -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable, foldl, foldr, foldMap) -import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) -import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) -import Data.Maybe (Maybe(..), maybe) -import Data.Ord (class Ord1) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Foldable (foldl1) as Foldable1 -import Data.Traversable (class Traversable, traverse, sequence) -import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) -import Data.Tuple (uncurry) -import Data.Unfoldable (class Unfoldable, unfoldr) -import Data.Unfoldable1 (class Unfoldable1) - --- | A non-empty container of elements of type a. --- | --- | ```purescript --- | import Data.NonEmpty --- | --- | nonEmptyArray :: NonEmpty Array Int --- | nonEmptyArray = NonEmpty 1 [2,3] --- | --- | import Data.List(List(..), (:)) --- | --- | nonEmptyList :: NonEmpty List Int --- | nonEmptyList = NonEmpty 1 (2 : 3 : Nil) --- | ``` -data NonEmpty f a = NonEmpty a (f a) - --- | An infix synonym for `NonEmpty`. --- | --- | ```purescript --- | nonEmptyArray :: NonEmpty Array Int --- | nonEmptyArray = 1 :| [2,3] --- | --- | nonEmptyList :: NonEmpty List Int --- | nonEmptyList = 1 :| 2 : 3 : Nil --- | ``` -infixr 5 NonEmpty as :| - --- | Create a non-empty structure with a single value. --- | --- | ```purescript --- | import Prelude --- | --- | singleton 1 == 1 :| [] --- | singleton 1 == 1 :| Nil --- | ``` -singleton :: forall f a. Plus f => a -> NonEmpty f a -singleton a = a :| empty - --- | Fold a non-empty structure, collecting results using a binary operation. --- | --- | ```purescript --- | foldl1 (+) (1 :| [2, 3]) == 6 --- | ``` -foldl1 :: forall f a. Foldable f => (a -> a -> a) -> NonEmpty f a -> a -foldl1 = Foldable1.foldl1 - --- | Apply a function that takes the `first` element and remaining elements --- | as arguments to a non-empty container. --- | --- | For example, return the remaining elements multiplied by the first element: --- | --- | ```purescript --- | fromNonEmpty (\x xs -> map (_ * x) xs) (3 :| [2, 1]) == [6, 3] --- | ``` -fromNonEmpty :: forall f a r. (a -> f a -> r) -> NonEmpty f a -> r -fromNonEmpty f (a :| fa) = a `f` fa - --- | Returns the `alt` (`<|>`) result of: --- | - The first element lifted to the container of the remaining elements. --- | - The remaining elements. --- | --- | ```purescript --- | import Data.Maybe(Maybe(..)) --- | --- | oneOf (1 :| Nothing) == Just 1 --- | oneOf (1 :| Just 2) == Just 1 --- | --- | oneOf (1 :| [2, 3]) == [1,2,3] --- | ``` -oneOf :: forall f a. Alternative f => NonEmpty f a -> f a -oneOf (a :| fa) = pure a <|> fa - --- | Get the 'first' element of a non-empty container. --- | --- | ```purescript --- | head (1 :| [2, 3]) == 1 --- | ``` -head :: forall f a. NonEmpty f a -> a -head (x :| _) = x - --- | Get everything but the 'first' element of a non-empty container. --- | --- | ```purescript --- | tail (1 :| [2, 3]) == [2, 3] --- | ``` -tail :: forall f a. NonEmpty f a -> f a -tail (_ :| xs) = xs - -instance showNonEmpty :: (Show a, Show (f a)) => Show (NonEmpty f a) where - show (a :| fa) = "(NonEmpty " <> show a <> " " <> show fa <> ")" - -derive instance eqNonEmpty :: (Eq1 f, Eq a) => Eq (NonEmpty f a) - -derive instance eq1NonEmpty :: Eq1 f => Eq1 (NonEmpty f) - -derive instance ordNonEmpty :: (Ord1 f, Ord a) => Ord (NonEmpty f a) - -derive instance ord1NonEmpty :: Ord1 f => Ord1 (NonEmpty f) - -derive instance functorNonEmpty :: Functor f => Functor (NonEmpty f) - -instance functorWithIndex - :: FunctorWithIndex i f - => FunctorWithIndex (Maybe i) (NonEmpty f) where - mapWithIndex f (a :| fa) = f Nothing a :| mapWithIndex (f <<< Just) fa - -instance foldableNonEmpty :: Foldable f => Foldable (NonEmpty f) where - foldMap f (a :| fa) = f a <> foldMap f fa - foldl f b (a :| fa) = foldl f (f b a) fa - foldr f b (a :| fa) = f a (foldr f b fa) - -instance foldableWithIndexNonEmpty - :: (FoldableWithIndex i f) - => FoldableWithIndex (Maybe i) (NonEmpty f) where - foldMapWithIndex f (a :| fa) = f Nothing a <> foldMapWithIndex (f <<< Just) fa - foldlWithIndex f b (a :| fa) = foldlWithIndex (f <<< Just) (f Nothing b a) fa - foldrWithIndex f b (a :| fa) = f Nothing a (foldrWithIndex (f <<< Just) b fa) - -instance traversableNonEmpty :: Traversable f => Traversable (NonEmpty f) where - sequence (a :| fa) = NonEmpty <$> a <*> sequence fa - traverse f (a :| fa) = NonEmpty <$> f a <*> traverse f fa - -instance traversableWithIndexNonEmpty - :: (TraversableWithIndex i f) - => TraversableWithIndex (Maybe i) (NonEmpty f) where - traverseWithIndex f (a :| fa) = - NonEmpty <$> f Nothing a <*> traverseWithIndex (f <<< Just) fa - -instance foldable1NonEmpty :: Foldable f => Foldable1 (NonEmpty f) where - foldMap1 f (a :| fa) = foldl (\s a1 -> s <> f a1) (f a) fa - foldr1 f (a :| fa) = maybe a (f a) $ foldr (\a1 -> Just <<< maybe a1 (f a1)) Nothing fa - foldl1 f (a :| fa) = foldl f a fa - -instance unfoldable1NonEmpty :: Unfoldable f => Unfoldable1 (NonEmpty f) where - unfoldr1 f b = uncurry (:|) $ unfoldr (map f) <$> f b - --- | This is a lawful `Semigroup` instance that will behave sensibly for common nonempty --- | containers like lists and arrays. However, it's not guaranteed that `pure` will behave --- | sensibly alongside `<>` for all types, as we don't have any laws which govern their behavior. -instance semigroupNonEmpty - :: (Applicative f, Semigroup (f a)) - => Semigroup (NonEmpty f a) where - append (a1 :| f1) (a2 :| f2) = a1 :| (f1 <> pure a2 <> f2) diff --git a/stdlib/lib/Data/Number.purs b/stdlib/lib/Data/Number.purs deleted file mode 100644 index 926b2e53..00000000 --- a/stdlib/lib/Data/Number.purs +++ /dev/null @@ -1,363 +0,0 @@ --- | Functions for working with PureScripts builtin `Number` type. -module Data.Number - ( fromString - , nan - , isNaN - , infinity - , isFinite - , abs - , acos - , asin - , atan - , atan2 - , ceil - , cos - , exp - , floor - , log - , max - , min - , pow - , remainder, (%) - , round - , sign - , sin - , sqrt - , tan - , trunc - , e - , ln2 - , ln10 - , log10e - , log2e - , pi - , sqrt1_2 - , sqrt2 - , tau - ) where - -import Data.Function.Uncurried (Fn4, runFn4) -import Data.Maybe (Maybe(..)) - --- | Not a number (NaN). --- | ```purs --- | > nan --- | NaN --- | ``` -foreign import nan :: Number - --- | Test whether a number is NaN. --- | ```purs --- | > isNaN 0.0 --- | false --- | --- | > isNaN nan --- | true --- | ``` -foreign import isNaN :: Number -> Boolean - --- | Positive infinity. For negative infinity use `(-infinity)` --- | ```purs --- | > infinity --- | Infinity --- | --- | > (-infinity) --- | - Infinity --- | ``` -foreign import infinity :: Number - --- | Test whether a number is finite. --- | ```purs --- | > isFinite 0.0 --- | true --- | --- | > isFinite infinity --- | false --- | --- | > isFinite (-infinity) --- | false --- | --- | > isFinite nan --- | false --- | ``` -foreign import isFinite :: Number -> Boolean - --- | Attempt to parse a `Number` using JavaScripts `parseFloat`. Returns --- | `Nothing` if the parse fails or if the result is not a finite number. --- | --- | Example: --- | ```purs --- | > fromString "123" --- | (Just 123.0) --- | --- | > fromString "12.34" --- | (Just 12.34) --- | --- | > fromString "1e4" --- | (Just 10000.0) --- | --- | > fromString "1.2e4" --- | (Just 12000.0) --- | --- | > fromString "bad" --- | Nothing --- | ``` --- | --- | Note that `parseFloat` allows for trailing non-digit characters and --- | whitespace as a prefix: --- | ``` --- | > fromString " 1.2 ??" --- | (Just 1.2) --- | ``` -fromString :: String -> Maybe Number -fromString str = runFn4 fromStringImpl str isFinite Just Nothing - -foreign import fromStringImpl :: Fn4 String (Number -> Boolean) (forall a. a -> Maybe a) (forall a. Maybe a) (Maybe Number) - --- | Returns the absolute value of the argument. --- | ```purs --- | > x = -42.0 --- | > sign x * abs x == x --- | true --- | ``` -foreign import abs :: Number -> Number - --- | Returns the inverse cosine in radians of the argument. --- | ```purs --- | > acos 0.0 == pi / 2.0 --- | true --- | ``` -foreign import acos :: Number -> Number - --- | Returns the inverse sine in radians of the argument. --- | ```purs --- | > asin 1.0 == pi / 2.0 --- | true --- | ``` -foreign import asin :: Number -> Number - --- | Returns the inverse tangent in radians of the argument. --- | ```purs --- | > atan 1.0 == pi / 4.0 --- | true --- | ``` -foreign import atan :: Number -> Number - --- | Four-quadrant tangent inverse. Given the arguments `y` and `x`, returns --- | the inverse tangent of `y / x`, where the signs of both arguments are used --- | to determine the sign of the result. --- | If the first argument is negative, the result will be negative. --- | The result is the angle between the positive x axis and a point `(x, y)`. --- | ```purs --- | > atan2 0.0 1.0 --- | 0.0 --- | > atan2 1.0 0.0 == pi / 2.0 --- | true --- | ``` -foreign import atan2 :: Number -> Number -> Number - --- | Returns the smallest integer not smaller than the argument. --- | ```purs --- | > ceil 1.5 --- | 2.0 --- | ``` -foreign import ceil :: Number -> Number - --- | Returns the cosine of the argument, where the argument is in radians. --- | ```purs --- | > cos (pi / 4.0) == sqrt2 / 2.0 --- | true --- | ``` -foreign import cos :: Number -> Number - --- | Returns `e` exponentiated to the power of the argument. --- | ```purs --- | > exp 1.0 --- | 2.718281828459045 --- | ``` -foreign import exp :: Number -> Number - --- | Returns the largest integer not larger than the argument. --- | ```purs --- | > floor 1.5 --- | 1.0 --- | ``` -foreign import floor :: Number -> Number - --- | Returns the natural logarithm of a number. --- | ```purs --- | > log e --- | 1.0 -foreign import log :: Number -> Number - --- | Returns the largest of two numbers. Unlike `max` in Data.Ord this version --- | returns NaN if either argument is NaN. -foreign import max :: Number -> Number -> Number - --- | Returns the smallest of two numbers. Unlike `min` in Data.Ord this version --- | returns NaN if either argument is NaN. -foreign import min :: Number -> Number -> Number - --- | Return the first argument exponentiated to the power of the second argument. --- | ```purs --- | > pow 3.0 2.0 --- | 9.0 --- | > sqrt 42.0 == pow 42.0 0.5 --- | true --- | ``` - -foreign import pow :: Number -> Number -> Number - --- | Computes the remainder after division. This is the same as JavaScript's `%` operator. --- ```purs --- > 5.3 % 2.0 --- 1.2999999999999998 --- ``` -foreign import remainder :: Number -> Number -> Number - -infixl 7 remainder as % - --- | Returns the integer closest to the argument. --- | ```purs --- | > round 1.5 --- | 2.0 --- | ``` -foreign import round :: Number -> Number - --- | Returns either a positive or negative +/- 1, indicating the sign of the --- | argument. If the argument is 0, it will return a +/- 0. If the argument is --- | NaN it will return NaN. --- | ```purs --- | > x = -42.0 --- | > sign x * abs x == x --- | true --- | ``` -foreign import sign :: Number -> Number - --- | Returns the sine of the argument, where the argument is in radians. --- | ```purs --- | > sin (pi / 2.0) --- | 1.0 --- | ``` -foreign import sin :: Number -> Number - --- | Returns the square root of the argument. --- | ```purs --- | > sqrt 49.0 --- | 7.0 --- | ``` -foreign import sqrt :: Number -> Number - --- | Returns the tangent of the argument, where the argument is in radians. --- | ``` --- | > tan (pi / 4.0) --- | 0.9999999999999999 --- | ``` -foreign import tan :: Number -> Number - --- | Truncates the decimal portion of a number. Equivalent to `floor` if the --- | number is positive, and `ceil` if the number is negative. --- | ```purs --- | ceil 1.5 --- | 2.0 --- | ``` -foreign import trunc :: Number -> Number - --- | The base of the natural logarithm, also known as Euler's number or *e*. --- | ```purs --- | > log e --- | 1.0 --- | --- | > exp 1.0 == e --- | true --- | --- | > e --- | 2.718281828459045 --- | ``` -e :: Number -e = 2.718281828459045 - --- | The natural logarithm of 2. --- | ```purs --- | > log 2.0 == ln2 --- | true --- | --- | > ln2 --- | 0.6931471805599453 --- | ``` -ln2 :: Number -ln2 = 0.6931471805599453 - --- | The natural logarithm of 10. --- | ```purs --- | > log 10.0 == ln10 --- | true --- | --- | > ln10 --- | 2.302585092994046 --- | ``` -ln10 :: Number -ln10 = 2.302585092994046 - --- | Base 10 logarithm of `e`. --- | ```purs --- | > 1.0 / ln10 - log10e --- | -5.551115123125783e-17 --- | --- | > log10e --- | 0.4342944819032518 --- | ``` -log10e :: Number -log10e = 0.4342944819032518 - --- | The base 2 logarithm of `e`. --- | ```purs --- | > 1.0 / ln2 == log2e --- | true --- | --- | > log2e --- | 1.4426950408889634 --- | ``` -log2e :: Number -log2e = 1.4426950408889634 - --- | The ratio of the circumference of a circle to its diameter. --- | ```purs --- | > pi --- | 3.141592653589793 --- | ``` -pi :: Number -pi = 3.141592653589793 - --- | The square root of one half. --- | ```purs --- | > sqrt 0.5 == sqrt1_2 --- | true --- | --- | > sqrt1_2 --- | 0.7071067811865476 --- | ``` -sqrt1_2 :: Number -sqrt1_2 = 0.7071067811865476 - --- | The square root of two. --- | ```purs --- | > sqrt 2.0 == sqrt2 --- | true --- | --- | > sqrt2 --- | 1.4142135623730951 --- | ``` -sqrt2 :: Number -sqrt2 = 1.4142135623730951 - --- | The ratio of the circumference of a circle to its radius. --- | ```purs --- | > 2.0 * pi == tau --- | true --- | --- | > tau --- | 6.283185307179586 --- | ``` -tau :: Number -tau = 6.283185307179586 diff --git a/stdlib/lib/Data/Number/Approximate.purs b/stdlib/lib/Data/Number/Approximate.purs deleted file mode 100644 index b8afcf55..00000000 --- a/stdlib/lib/Data/Number/Approximate.purs +++ /dev/null @@ -1,95 +0,0 @@ --- | This module defines functions for comparing numbers. -module Data.Number.Approximate - ( Fraction(..) - , eqRelative - , eqApproximate - , (~=) - , (≅) - , neqApproximate - , (≇) - , Tolerance(..) - , eqAbsolute - ) where - -import Prelude - -import Data.Number (abs) - --- | A newtype for (small) numbers, typically in the range *[0:1]*. It is used --- | as an argument for `eqRelative`. -newtype Fraction = Fraction Number - --- | Compare two `Number`s and return `true` if they are equal up to the --- | given *relative* error (`Fraction` parameter). --- | --- | This comparison is scale-invariant, i.e. if `eqRelative frac x y`, then --- | `eqRelative frac (s * x) (s * y)` for a given scale factor `s > 0.0` --- | (unless one of x, y is exactly `0.0`). --- | --- | Note that the relation that `eqRelative frac` induces on `Number` is --- | not an equivalence relation. It is reflexive and symmetric, but not --- | transitive. --- | --- | Example: --- | ``` purs --- | > (eqRelative (Fraction 0.01)) 133.7 133.0 --- | true --- | --- | > (eqRelative (Fraction 0.001)) 133.7 133.0 --- | false --- | --- | > (eqRelative (Fraction 0.01)) (0.1 + 0.2) 0.3 --- | true --- | ``` -eqRelative :: Fraction -> Number -> Number -> Boolean -eqRelative (Fraction frac) 0.0 y = abs y <= frac -eqRelative (Fraction frac) x 0.0 = abs x <= frac -eqRelative (Fraction frac) x y = abs (x - y) <= frac * abs (x + y) / 2.0 - --- | Test if two numbers are approximately equal, up to a relative difference --- | of one part in a million: --- | ``` purs --- | eqApproximate = eqRelative (Fraction 1.0e-6) --- | ``` --- | --- | Example --- | ``` purs --- | > 0.1 + 0.2 == 0.3 --- | false --- | --- | > 0.1 + 0.2 ≅ 0.3 --- | true --- | ``` -eqApproximate :: Number -> Number -> Boolean -eqApproximate = eqRelative onePPM - where - onePPM :: Fraction - onePPM = Fraction 1.0e-6 - -infix 4 eqApproximate as ~= -infix 4 eqApproximate as ≅ - --- | The complement of `eqApproximate`. -neqApproximate :: Number -> Number -> Boolean -neqApproximate x y = not (x ≅ y) - -infix 4 neqApproximate as ≇ - --- | A newtype for (small) numbers. It is used as an argument for `eqAbsolute`. -newtype Tolerance = Tolerance Number - --- | Compare two `Number`s and return `true` if they are equal up to the given --- | (absolute) tolerance value. Note that this type of comparison is *not* --- | scale-invariant. The relation induced by `(eqAbsolute (Tolerance eps))` is --- | symmetric and reflexive, but not transitive. --- | --- | Example: --- | ``` purs --- | > (eqAbsolute (Tolerance 1.0)) 133.7 133.0 --- | true --- | --- | > (eqAbsolute (Tolerance 0.1)) 133.7 133.0 --- | false --- | ``` -eqAbsolute :: Tolerance -> Number -> Number -> Boolean -eqAbsolute (Tolerance tolerance) x y = abs (x - y) <= tolerance diff --git a/stdlib/lib/Data/Number/Format.purs b/stdlib/lib/Data/Number/Format.purs deleted file mode 100644 index 6cf40809..00000000 --- a/stdlib/lib/Data/Number/Format.purs +++ /dev/null @@ -1,76 +0,0 @@ --- | A module for formatting numbers as strings. --- | --- | Usage: --- | ``` purs --- | > let x = 1234.56789 --- | --- | > toStringWith (precision 6) x --- | "1234.57" --- | --- | > toStringWith (fixed 3) x --- | "1234.568" --- | --- | > toStringWith (exponential 2) x --- | "1.23e+3" --- | ``` --- | --- | The main method of this module is the `toStringWith` function that accepts --- | a `Format` argument which can be constructed through one of the smart --- | constructors `precision`, `fixed` and `exponential`. Internally, the --- | number will be formatted with JavaScripts `toPrecision`, `toFixed` or --- | `toExponential`. -module Data.Number.Format - ( Format() - , precision - , fixed - , exponential - , toStringWith - , toString - ) where - -import Prelude - -foreign import toPrecisionNative :: Int -> Number -> String -foreign import toFixedNative :: Int -> Number -> String -foreign import toExponentialNative :: Int -> Number -> String - --- | The `Format` data type specifies how a number will be formatted. -data Format - = Precision Int - | Fixed Int - | Exponential Int - --- | Create a `toPrecision`-based format from an integer. Values smaller than --- | `1` and larger than `21` will be clamped. -precision :: Int -> Format -precision = Precision <<< clamp 1 21 - --- | Create a `toFixed`-based format from an integer. Values smaller than `0` --- | and larger than `20` will be clamped. -fixed :: Int -> Format -fixed = Fixed <<< clamp 0 20 - --- | Create a `toExponential`-based format from an integer. Values smaller than --- | `0` and larger than `20` will be clamped. -exponential :: Int -> Format -exponential = Exponential <<< clamp 0 20 - --- | Convert a number to a string with a given format. -toStringWith :: Format -> Number -> String -toStringWith (Precision p) = toPrecisionNative p -toStringWith (Fixed p) = toFixedNative p -toStringWith (Exponential p) = toExponentialNative p - --- | Convert a number to a string via JavaScript's toString method. --- | --- | ```purs --- | > toString 12.34 --- | "12.34" --- | --- | > toString 1234.0 --- | "1234" --- | --- | > toString 1.2e-10 --- | "1.2e-10" --- | ``` -foreign import toString :: Number -> String diff --git a/stdlib/lib/Data/Op.purs b/stdlib/lib/Data/Op.purs deleted file mode 100644 index 370451ab..00000000 --- a/stdlib/lib/Data/Op.purs +++ /dev/null @@ -1,22 +0,0 @@ -module Data.Op where - -import Prelude - -import Data.Functor.Contravariant (class Contravariant) -import Data.Newtype (class Newtype) - --- | The opposite of the function category. -newtype Op a b = Op (b -> a) - -derive instance newtypeOp :: Newtype (Op a b) _ -derive newtype instance semigroupOp :: Semigroup a ⇒ Semigroup (Op a b) -derive newtype instance monoidOp :: Monoid a => Monoid (Op a b) - -instance semigroupoidOp :: Semigroupoid Op where - compose (Op f) (Op g) = Op (compose g f) - -instance categoryOp :: Category Op where - identity = Op identity - -instance contravariantOp :: Contravariant (Op a) where - cmap f (Op g) = Op (g <<< f) diff --git a/stdlib/lib/Data/Ord.purs b/stdlib/lib/Data/Ord.purs deleted file mode 100644 index ed699905..00000000 --- a/stdlib/lib/Data/Ord.purs +++ /dev/null @@ -1,264 +0,0 @@ -module Data.Ord - ( class Ord - , compare - , class Ord1 - , compare1 - , lessThan - , (<) - , lessThanOrEq - , (<=) - , greaterThan - , (>) - , greaterThanOrEq - , (>=) - , comparing - , min - , max - , clamp - , between - , abs - , signum - , module Data.Ordering - , class OrdRecord - , compareRecord - ) where - -import Data.Eq (class Eq, class Eq1, class EqRecord, (/=)) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Ordering (Ordering(..)) -import Data.Ring (class Ring, zero, one, negate) -import Data.Unit (Unit) -import Data.Void (Void) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeGet) -import Type.Proxy (Proxy(..)) - --- | The `Ord` type class represents types which support comparisons with a --- | _total order_. --- | --- | `Ord` instances should satisfy the laws of total orderings: --- | --- | - Reflexivity: `a <= a` --- | - Antisymmetry: if `a <= b` and `b <= a` then `a == b` --- | - Transitivity: if `a <= b` and `b <= c` then `a <= c` --- | --- | **Note:** The `Number` type is not an entirely law abiding member of this --- | class due to the presence of `NaN`, since `NaN <= NaN` evaluates to `false` -class Eq a <= Ord a where - compare :: a -> a -> Ordering - -instance ordBoolean :: Ord Boolean where - compare = ordBooleanImpl LT EQ GT - -instance ordInt :: Ord Int where - compare = ordIntImpl LT EQ GT - -instance ordNumber :: Ord Number where - compare = ordNumberImpl LT EQ GT - -instance ordString :: Ord String where - compare = ordStringImpl LT EQ GT - -instance ordChar :: Ord Char where - compare = ordCharImpl LT EQ GT - -instance ordUnit :: Ord Unit where - compare _ _ = EQ - -instance ordVoid :: Ord Void where - compare _ _ = EQ - -instance ordProxy :: Ord (Proxy a) where - compare _ _ = EQ - -instance ordArray :: Ord a => Ord (Array a) where - compare = \xs ys -> compare 0 (ordArrayImpl toDelta xs ys) - where - toDelta x y = - case compare x y of - EQ -> 0 - LT -> 1 - GT -> -1 - -foreign import ordBooleanImpl - :: Ordering - -> Ordering - -> Ordering - -> Boolean - -> Boolean - -> Ordering - -foreign import ordIntImpl - :: Ordering - -> Ordering - -> Ordering - -> Int - -> Int - -> Ordering - -foreign import ordNumberImpl - :: Ordering - -> Ordering - -> Ordering - -> Number - -> Number - -> Ordering - -foreign import ordStringImpl - :: Ordering - -> Ordering - -> Ordering - -> String - -> String - -> Ordering - -foreign import ordCharImpl - :: Ordering - -> Ordering - -> Ordering - -> Char - -> Char - -> Ordering - -foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int - -instance ordOrdering :: Ord Ordering where - compare LT LT = EQ - compare EQ EQ = EQ - compare GT GT = EQ - compare LT _ = LT - compare EQ LT = GT - compare EQ GT = LT - compare GT _ = GT - --- | Test whether one value is _strictly less than_ another. -lessThan :: forall a. Ord a => a -> a -> Boolean -lessThan a1 a2 = case a1 `compare` a2 of - LT -> true - _ -> false - --- | Test whether one value is _strictly greater than_ another. -greaterThan :: forall a. Ord a => a -> a -> Boolean -greaterThan a1 a2 = case a1 `compare` a2 of - GT -> true - _ -> false - --- | Test whether one value is _non-strictly less than_ another. -lessThanOrEq :: forall a. Ord a => a -> a -> Boolean -lessThanOrEq a1 a2 = case a1 `compare` a2 of - GT -> false - _ -> true - --- | Test whether one value is _non-strictly greater than_ another. -greaterThanOrEq :: forall a. Ord a => a -> a -> Boolean -greaterThanOrEq a1 a2 = case a1 `compare` a2 of - LT -> false - _ -> true - -infixl 4 lessThan as < -infixl 4 lessThanOrEq as <= -infixl 4 greaterThan as > -infixl 4 greaterThanOrEq as >= - --- | Compares two values by mapping them to a type with an `Ord` instance. -comparing :: forall a b. Ord b => (a -> b) -> (a -> a -> Ordering) -comparing f x y = compare (f x) (f y) - --- | Take the minimum of two values. If they are considered equal, the first --- | argument is chosen. -min :: forall a. Ord a => a -> a -> a -min x y = - case compare x y of - LT -> x - EQ -> x - GT -> y - --- | Take the maximum of two values. If they are considered equal, the first --- | argument is chosen. -max :: forall a. Ord a => a -> a -> a -max x y = - case compare x y of - LT -> y - EQ -> x - GT -> x - --- | Clamp a value between a minimum and a maximum. For example: --- | --- | ``` purescript --- | let f = clamp 0 10 --- | f (-5) == 0 --- | f 5 == 5 --- | f 15 == 10 --- | ``` -clamp :: forall a. Ord a => a -> a -> a -> a -clamp low hi x = min hi (max low x) - --- | Test whether a value is between a minimum and a maximum (inclusive). --- | For example: --- | --- | ``` purescript --- | let f = between 0 10 --- | f 0 == true --- | f (-5) == false --- | f 5 == true --- | f 10 == true --- | f 15 == false --- | ``` -between :: forall a. Ord a => a -> a -> a -> Boolean -between low hi x - | x < low = false - | x > hi = false - | true = true - --- | The absolute value function. `abs x` is defined as `if x >= zero then x --- | else negate x`. -abs :: forall a. Ord a => Ring a => a -> a -abs x = if x >= zero then x else negate x - --- | The sign function; returns `one` if the argument is positive, --- | `negate one` if the argument is negative, or `zero` if the argument is `zero`. --- | For floating point numbers with signed zeroes, when called with a zero, --- | this function returns the argument in order to preserve the sign. --- | For any `x`, we should have `signum x * abs x == x`. -signum :: forall a. Ord a => Ring a => a -> a -signum x = - if x < zero then negate one - else if x > zero then one - else x - --- | The `Ord1` type class represents totally ordered type constructors. -class Eq1 f <= Ord1 f where - compare1 :: forall a. Ord a => f a -> f a -> Ordering - -instance ord1Array :: Ord1 Array where - compare1 = compare - -class OrdRecord :: RL.RowList Type -> Row Type -> Constraint -class EqRecord rowlist row <= OrdRecord rowlist row where - compareRecord :: Proxy rowlist -> Record row -> Record row -> Ordering - -instance ordRecordNil :: OrdRecord RL.Nil row where - compareRecord _ _ _ = EQ - -instance ordRecordCons :: - ( OrdRecord rowlistTail row - , Row.Cons key focus rowTail row - , IsSymbol key - , Ord focus - ) => - OrdRecord (RL.Cons key focus rowlistTail) row where - compareRecord _ ra rb = - if left /= EQ then left - else compareRecord (Proxy :: Proxy rowlistTail) ra rb - where - key = reflectSymbol (Proxy :: Proxy key) - unsafeGet' = unsafeGet :: String -> Record row -> focus - left = unsafeGet' key ra `compare` unsafeGet' key rb - -instance ordRecord :: - ( RL.RowToList row list - , OrdRecord list row - ) => - Ord (Record row) where - compare = compareRecord (Proxy :: Proxy list) diff --git a/stdlib/lib/Data/Ord/Down.purs b/stdlib/lib/Data/Ord/Down.purs deleted file mode 100644 index b06e30dd..00000000 --- a/stdlib/lib/Data/Ord/Down.purs +++ /dev/null @@ -1,26 +0,0 @@ -module Data.Ord.Down where - -import Prelude - -import Data.Newtype (class Newtype) -import Data.Ordering (invert) - --- | A newtype wrapper which provides a reversed `Ord` instance. For example: --- | --- | sortBy (comparing Down) [1,2,3] = [3,2,1] --- | -newtype Down a = Down a - -derive instance newtypeDown :: Newtype (Down a) _ - -derive newtype instance eqDown :: Eq a => Eq (Down a) - -instance ordDown :: Ord a => Ord (Down a) where - compare (Down x) (Down y) = invert (compare x y) - -instance boundedDown :: Bounded a => Bounded (Down a) where - top = Down bottom - bottom = Down top - -instance showDown :: Show a => Show (Down a) where - show (Down a) = "(Down " <> show a <> ")" diff --git a/stdlib/lib/Data/Ord/Generic.purs b/stdlib/lib/Data/Ord/Generic.purs deleted file mode 100644 index b1e2129c..00000000 --- a/stdlib/lib/Data/Ord/Generic.purs +++ /dev/null @@ -1,39 +0,0 @@ -module Data.Ord.Generic - ( class GenericOrd - , genericCompare' - , genericCompare - ) where - -import Prelude (class Ord, compare, Ordering(..)) -import Data.Generic.Rep - -class GenericOrd a where - genericCompare' :: a -> a -> Ordering - -instance genericOrdNoConstructors :: GenericOrd NoConstructors where - genericCompare' _ _ = EQ - -instance genericOrdNoArguments :: GenericOrd NoArguments where - genericCompare' _ _ = EQ - -instance genericOrdSum :: (GenericOrd a, GenericOrd b) => GenericOrd (Sum a b) where - genericCompare' (Inl a1) (Inl a2) = genericCompare' a1 a2 - genericCompare' (Inr b1) (Inr b2) = genericCompare' b1 b2 - genericCompare' (Inl _) (Inr _) = LT - genericCompare' (Inr _) (Inl _) = GT - -instance genericOrdProduct :: (GenericOrd a, GenericOrd b) => GenericOrd (Product a b) where - genericCompare' (Product a1 b1) (Product a2 b2) = - case genericCompare' a1 a2 of - EQ -> genericCompare' b1 b2 - other -> other - -instance genericOrdConstructor :: GenericOrd a => GenericOrd (Constructor name a) where - genericCompare' (Constructor a1) (Constructor a2) = genericCompare' a1 a2 - -instance genericOrdArgument :: Ord a => GenericOrd (Argument a) where - genericCompare' (Argument a1) (Argument a2) = compare a1 a2 - --- | A `Generic` implementation of the `compare` member from the `Ord` type class. -genericCompare :: forall a rep. Generic a rep => GenericOrd rep => a -> a -> Ordering -genericCompare x y = genericCompare' (from x) (from y) diff --git a/stdlib/lib/Data/Ord/Max.purs b/stdlib/lib/Data/Ord/Max.purs deleted file mode 100644 index a076185d..00000000 --- a/stdlib/lib/Data/Ord/Max.purs +++ /dev/null @@ -1,29 +0,0 @@ -module Data.Ord.Max where - -import Prelude - -import Data.Newtype (class Newtype) - --- | Provides a `Semigroup` based on the `max` function. If the type has a --- | `Bounded` instance, then a `Monoid` instance is provided too. For example: --- | --- | unwrap (Max 5 <> Max 6) = 6 --- | mempty :: Max Ordering = Max LT --- | -newtype Max a = Max a - -derive instance newtypeMax :: Newtype (Max a) _ - -derive newtype instance eqMax :: Eq a => Eq (Max a) - -instance ordMax :: Ord a => Ord (Max a) where - compare (Max x) (Max y) = compare x y - -instance semigroupMax :: Ord a => Semigroup (Max a) where - append (Max x) (Max y) = Max (max x y) - -instance monoidMax :: Bounded a => Monoid (Max a) where - mempty = Max bottom - -instance showMax :: Show a => Show (Max a) where - show (Max a) = "(Max " <> show a <> ")" diff --git a/stdlib/lib/Data/Ord/Min.purs b/stdlib/lib/Data/Ord/Min.purs deleted file mode 100644 index 64e6e5c1..00000000 --- a/stdlib/lib/Data/Ord/Min.purs +++ /dev/null @@ -1,29 +0,0 @@ -module Data.Ord.Min where - -import Prelude - -import Data.Newtype (class Newtype) - --- | Provides a `Semigroup` based on the `min` function. If the type has a --- | `Bounded` instance, then a `Monoid` instance is provided too. For example: --- | --- | unwrap (Min 5 <> Min 6) = 5 --- | mempty :: Min Ordering = Min GT --- | -newtype Min a = Min a - -derive instance newtypeMin :: Newtype (Min a) _ - -derive newtype instance eqMin :: Eq a => Eq (Min a) - -instance ordMin :: Ord a => Ord (Min a) where - compare (Min x) (Min y) = compare x y - -instance semigroupMin :: Ord a => Semigroup (Min a) where - append (Min x) (Min y) = Min (min x y) - -instance monoidMin :: Bounded a => Monoid (Min a) where - mempty = Min top - -instance showMin :: Show a => Show (Min a) where - show (Min a) = "(Min " <> show a <> ")" diff --git a/stdlib/lib/Data/Ordering.purs b/stdlib/lib/Data/Ordering.purs deleted file mode 100644 index f2477cd2..00000000 --- a/stdlib/lib/Data/Ordering.purs +++ /dev/null @@ -1,36 +0,0 @@ -module Data.Ordering (Ordering(..), invert) where - -import Data.Eq (class Eq) -import Data.Semigroup (class Semigroup) -import Data.Show (class Show) - --- | The `Ordering` data type represents the three possible outcomes of --- | comparing two values: --- | --- | `LT` - The first value is _less than_ the second. --- | `GT` - The first value is _greater than_ the second. --- | `EQ` - The first value is _equal to_ the second. -data Ordering = LT | GT | EQ - -instance eqOrdering :: Eq Ordering where - eq LT LT = true - eq GT GT = true - eq EQ EQ = true - eq _ _ = false - -instance semigroupOrdering :: Semigroup Ordering where - append LT _ = LT - append GT _ = GT - append EQ y = y - -instance showOrdering :: Show Ordering where - show LT = "LT" - show GT = "GT" - show EQ = "EQ" - --- | Reverses an `Ordering` value, flipping greater than for less than while --- | preserving equality. -invert :: Ordering -> Ordering -invert GT = LT -invert EQ = EQ -invert LT = GT diff --git a/stdlib/lib/Data/Predicate.purs b/stdlib/lib/Data/Predicate.purs deleted file mode 100644 index 1d292b9d..00000000 --- a/stdlib/lib/Data/Predicate.purs +++ /dev/null @@ -1,18 +0,0 @@ -module Data.Predicate where - -import Prelude - -import Data.Functor.Contravariant (class Contravariant) -import Data.Newtype (class Newtype) - --- | An adaptor allowing `>$<` to map over the inputs of a predicate. -newtype Predicate a = Predicate (a -> Boolean) - -derive instance newtypePredicate :: Newtype (Predicate a) _ - -derive newtype instance heytingAlgebraPredicate :: HeytingAlgebra (Predicate a) - -derive newtype instance booleanAlgebraPredicate :: BooleanAlgebra (Predicate a) - -instance contravariantPredicate :: Contravariant Predicate where - cmap f (Predicate g) = Predicate (g <<< f) diff --git a/stdlib/lib/Data/Profunctor.purs b/stdlib/lib/Data/Profunctor.purs deleted file mode 100644 index 29c626a8..00000000 --- a/stdlib/lib/Data/Profunctor.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Profunctor where - -import Prelude -import Data.Newtype (class Newtype, wrap, unwrap) - --- | A `Profunctor` is a `Functor` from the pair category `(Type^op, Type)` --- | to `Type`. --- | --- | In other words, a `Profunctor` is a type constructor of two type --- | arguments, which is contravariant in its first argument and covariant --- | in its second argument. --- | --- | The `dimap` function can be used to map functions over both arguments --- | simultaneously. --- | --- | A straightforward example of a profunctor is the function arrow `(->)`. --- | --- | Laws: --- | --- | - Identity: `dimap identity identity = identity` --- | - Composition: `dimap f1 g1 <<< dimap f2 g2 = dimap (f1 >>> f2) (g1 <<< g2)` -class Profunctor p where - dimap :: forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d - --- | Map a function over the (contravariant) first type argument only. -lcmap :: forall a b c p. Profunctor p => (a -> b) -> p b c -> p a c -lcmap a2b = dimap a2b identity - --- | Map a function over the (covariant) second type argument only. -rmap :: forall a b c p. Profunctor p => (b -> c) -> p a b -> p a c -rmap b2c = dimap identity b2c - --- | Lift a pure function into any `Profunctor` which is also a `Category`. -arr :: forall a b p. Category p => Profunctor p => (a -> b) -> p a b -arr f = rmap f identity - -unwrapIso :: forall p t a. Profunctor p => Newtype t a => p t t -> p a a -unwrapIso = dimap wrap unwrap - -wrapIso :: forall p t a. Profunctor p => Newtype t a => (a -> t) -> p a a -> p t t -wrapIso _ = dimap unwrap wrap - -instance profunctorFn :: Profunctor (->) where - dimap a2b c2d b2c = a2b >>> b2c >>> c2d diff --git a/stdlib/lib/Data/Profunctor/Choice.purs b/stdlib/lib/Data/Profunctor/Choice.purs deleted file mode 100644 index 2003445d..00000000 --- a/stdlib/lib/Data/Profunctor/Choice.purs +++ /dev/null @@ -1,83 +0,0 @@ -module Data.Profunctor.Choice where - -import Prelude - -import Data.Either (Either(..), either) -import Data.Profunctor (class Profunctor, rmap) - --- | The `Choice` class extends `Profunctor` with combinators for working with --- | sum types. --- | --- | `left` and `right` lift values in a `Profunctor` to act on the `Left` and --- | `Right` components of a sum, respectively. --- | --- | Looking at `Choice` through the intuition of inputs and outputs --- | yields the following type signature: --- | ``` --- | left :: forall input output a. p input output -> p (Either input a) (Either output a) --- | right :: forall input output a. p input output -> p (Either a input) (Either a output) --- | ``` --- | If we specialize the profunctor `p` to the `function` arrow, we get the following type --- | signatures: --- | ``` --- | left :: forall input output a. (input -> output) -> (Either input a) -> (Either output a) --- | right :: forall input output a. (input -> output) -> (Either a input) -> (Either a output) --- | ``` --- | When the `profunctor` is `Function` application, `left` allows you to map a function over the --- | left side of an `Either`, and `right` maps it over the right side (same as `map` would do). -class Profunctor p <= Choice p where - left :: forall a b c. p a b -> p (Either a c) (Either b c) - right :: forall a b c. p b c -> p (Either a b) (Either a c) - -instance choiceFn :: Choice (->) where - left a2b (Left a) = Left $ a2b a - left _ (Right c) = Right c - right = (<$>) - --- | Compose a value acting on a sum from two values, each acting on one of --- | the components of the sum. --- | --- | Specializing `(+++)` to function application would look like this: --- | ``` --- | (+++) :: forall a b c d. (a -> b) -> (c -> d) -> (Either a c) -> (Either b d) --- | ``` --- | We take two functions, `f` and `g`, and we transform them into a single function which --- | takes an `Either`and maps `f` over the left side and `g` over the right side. Just like --- | `bi-map` would do for the `bi-functor` instance of `Either`. -splitChoice - :: forall p a b c d - . Semigroupoid p - => Choice p - => p a b - -> p c d - -> p (Either a c) (Either b d) -splitChoice l r = left l >>> right r - -infixr 2 splitChoice as +++ - --- | Compose a value which eliminates a sum from two values, each eliminating --- | one side of the sum. --- | --- | This combinator is useful when assembling values from smaller components, --- | because it provides a way to support two different types of input. --- | --- | Specializing `(|||)` to function application would look like this: --- | ``` --- | (|||) :: forall a b c d. (a -> c) -> (b -> c) -> Either a b -> c --- | ``` --- | We take two functions, `f` and `g`, which both return the same type `c` and we transform them into a --- | single function which takes an `Either` value with the parameter type of `f` on the left side and --- | the parameter type of `g` on the right side. The function then runs either `f` or `g`, depending on --- | whether the `Either` value is a `Left` or a `Right`. --- | This allows us to bundle two different computations which both have the same result type into one --- | function which will run the approriate computation based on the parameter supplied in the `Either` value. -fanin - :: forall p a b c - . Semigroupoid p - => Choice p - => p a c - -> p b c - -> p (Either a b) c -fanin l r = rmap (either identity identity) (l +++ r) - -infixr 2 fanin as ||| diff --git a/stdlib/lib/Data/Profunctor/Closed.purs b/stdlib/lib/Data/Profunctor/Closed.purs deleted file mode 100644 index fae4b5a4..00000000 --- a/stdlib/lib/Data/Profunctor/Closed.purs +++ /dev/null @@ -1,12 +0,0 @@ -module Data.Profunctor.Closed where - -import Prelude - -import Data.Profunctor (class Profunctor) - --- | The `Closed` class extends the `Profunctor` class to work with functions. -class Profunctor p <= Closed p where - closed :: forall a b x. p a b -> p (x -> a) (x -> b) - -instance closedFunction :: Closed Function where - closed = (<<<) diff --git a/stdlib/lib/Data/Profunctor/Cochoice.purs b/stdlib/lib/Data/Profunctor/Cochoice.purs deleted file mode 100644 index 0eb9cbf0..00000000 --- a/stdlib/lib/Data/Profunctor/Cochoice.purs +++ /dev/null @@ -1,9 +0,0 @@ -module Data.Profunctor.Cochoice where - -import Data.Either (Either) -import Data.Profunctor (class Profunctor) - --- | The `Cochoice` class provides the dual operations of the `Choice` class. -class Profunctor p <= Cochoice p where - unleft :: forall a b c. p (Either a c) (Either b c) -> p a b - unright :: forall a b c. p (Either a b) (Either a c) -> p b c diff --git a/stdlib/lib/Data/Profunctor/Costrong.purs b/stdlib/lib/Data/Profunctor/Costrong.purs deleted file mode 100644 index 0e4695b5..00000000 --- a/stdlib/lib/Data/Profunctor/Costrong.purs +++ /dev/null @@ -1,9 +0,0 @@ -module Data.Profunctor.Costrong where - -import Data.Tuple (Tuple) -import Data.Profunctor (class Profunctor) - --- | The `Costrong` class provides the dual operations of the `Strong` class. -class Profunctor p <= Costrong p where - unfirst :: forall a b c. p (Tuple a c) (Tuple b c) -> p a b - unsecond :: forall a b c. p (Tuple a b) (Tuple a c) -> p b c diff --git a/stdlib/lib/Data/Profunctor/Join.purs b/stdlib/lib/Data/Profunctor/Join.purs deleted file mode 100644 index e5a047c0..00000000 --- a/stdlib/lib/Data/Profunctor/Join.purs +++ /dev/null @@ -1,28 +0,0 @@ -module Data.Profunctor.Join where - -import Prelude - -import Data.Functor.Invariant (class Invariant) -import Data.Newtype (class Newtype) -import Data.Profunctor (class Profunctor, dimap) - --- | Turns a `Profunctor` into a `Invariant` functor by equating the two type --- | arguments. -newtype Join :: forall k. (k -> k -> Type) -> k -> Type -newtype Join p a = Join (p a a) - -derive instance newtypeJoin :: Newtype (Join p a) _ -derive newtype instance eqJoin :: Eq (p a a) => Eq (Join p a) -derive newtype instance ordJoin :: Ord (p a a) => Ord (Join p a) - -instance showJoin :: Show (p a a) => Show (Join p a) where - show (Join x) = "(Join " <> show x <> ")" - -instance semigroupJoin :: Semigroupoid p => Semigroup (Join p a) where - append (Join a) (Join b) = Join (a <<< b) - -instance monoidJoin :: Category p => Monoid (Join p a) where - mempty = Join identity - -instance invariantJoin :: Profunctor p => Invariant (Join p) where - imap f g (Join a) = Join (dimap g f a) diff --git a/stdlib/lib/Data/Profunctor/Split.purs b/stdlib/lib/Data/Profunctor/Split.purs deleted file mode 100644 index 01d08db3..00000000 --- a/stdlib/lib/Data/Profunctor/Split.purs +++ /dev/null @@ -1,39 +0,0 @@ -module Data.Profunctor.Split - ( Split - , split - , unSplit - , liftSplit - , lowerSplit - , hoistSplit - ) where - -import Prelude - -import Data.Exists (Exists, mkExists, runExists) -import Data.Functor.Invariant (class Invariant, imap) -import Data.Profunctor (class Profunctor) - -newtype Split f a b = Split (Exists (SplitF f a b)) - -data SplitF f a b x = SplitF (a -> x) (x -> b) (f x) - -instance functorSplit :: Functor (Split f a) where - map f = unSplit \g h fx -> split g (f <<< h) fx - -instance profunctorSplit :: Profunctor (Split f) where - dimap f g = unSplit \h i -> split (h <<< f) (g <<< i) - -split :: forall f a b x. (a -> x) -> (x -> b) -> f x -> Split f a b -split f g fx = Split (mkExists (SplitF f g fx)) - -unSplit :: forall f a b r. (forall x. (a -> x) -> (x -> b) -> f x -> r) -> Split f a b -> r -unSplit f (Split e) = runExists (\(SplitF g h fx) -> f g h fx) e - -liftSplit :: forall f a. f a -> Split f a a -liftSplit = split identity identity - -lowerSplit :: forall f a. Invariant f => Split f a a -> f a -lowerSplit = unSplit (flip imap) - -hoistSplit :: forall f g a b. (f ~> g) -> Split f a b -> Split g a b -hoistSplit nat = unSplit (\f g -> split f g <<< nat) diff --git a/stdlib/lib/Data/Profunctor/Star.purs b/stdlib/lib/Data/Profunctor/Star.purs deleted file mode 100644 index 25ec7e9c..00000000 --- a/stdlib/lib/Data/Profunctor/Star.purs +++ /dev/null @@ -1,80 +0,0 @@ -module Data.Profunctor.Star where - -import Prelude - -import Control.Alt (class Alt, (<|>)) -import Control.Alternative (class Alternative) -import Control.MonadPlus (class MonadPlus) -import Control.Plus (class Plus, empty) - -import Data.Distributive (class Distributive, distribute, collect) -import Data.Either (Either(..), either) -import Data.Functor.Invariant (class Invariant, imap) -import Data.Newtype (class Newtype) -import Data.Profunctor (class Profunctor) -import Data.Profunctor.Choice (class Choice) -import Data.Profunctor.Closed (class Closed) -import Data.Profunctor.Strong (class Strong) -import Data.Tuple (Tuple(..)) - --- | `Star` turns a `Functor` into a `Profunctor`. --- | --- | `Star f` is also the Kleisli category for `f` -newtype Star :: forall k. (k -> Type) -> Type -> k -> Type -newtype Star f a b = Star (a -> f b) - -derive instance newtypeStar :: Newtype (Star f a b) _ - -instance semigroupoidStar :: Bind f => Semigroupoid (Star f) where - compose (Star f) (Star g) = Star \x -> g x >>= f - -instance categoryStar :: Monad f => Category (Star f) where - identity = Star pure - -instance functorStar :: Functor f => Functor (Star f a) where - map f (Star g) = Star (map f <<< g) - -instance invariantStar :: Invariant f => Invariant (Star f a) where - imap f g (Star h) = Star (imap f g <<< h) - -instance applyStar :: Apply f => Apply (Star f a) where - apply (Star f) (Star g) = Star \a -> f a <*> g a - -instance applicativeStar :: Applicative f => Applicative (Star f a) where - pure a = Star \_ -> pure a - -instance bindStar :: Bind f => Bind (Star f a) where - bind (Star m) f = Star \x -> m x >>= \a -> case f a of Star g -> g x - -instance monadStar :: Monad f => Monad (Star f a) - -instance altStar :: Alt f => Alt (Star f a) where - alt (Star f) (Star g) = Star \a -> f a <|> g a - -instance plusStar :: Plus f => Plus (Star f a) where - empty = Star \_ -> empty - -instance alternativeStar :: Alternative f => Alternative (Star f a) - -instance monadPlusStar :: MonadPlus f => MonadPlus (Star f a) - -instance distributiveStar :: Distributive f => Distributive (Star f a) where - distribute f = Star \a -> collect (\(Star g) -> g a) f - collect f = distribute <<< map f - -instance profunctorStar :: Functor f => Profunctor (Star f) where - dimap f g (Star ft) = Star (f >>> ft >>> map g) - -instance strongStar :: Functor f => Strong (Star f) where - first (Star f) = Star \(Tuple s x) -> map (_ `Tuple` x) (f s) - second (Star f) = Star \(Tuple x s) -> map (Tuple x) (f s) - -instance choiceStar :: Applicative f => Choice (Star f) where - left (Star f) = Star $ either (map Left <<< f) (pure <<< Right) - right (Star f) = Star $ either (pure <<< Left) (map Right <<< f) - -instance closedStar :: Distributive f => Closed (Star f) where - closed (Star f) = Star \g -> distribute (f <<< g) - -hoistStar :: forall f g a b. (f ~> g) -> Star f a b -> Star g a b -hoistStar f (Star g) = Star (f <<< g) diff --git a/stdlib/lib/Data/Profunctor/Strong.purs b/stdlib/lib/Data/Profunctor/Strong.purs deleted file mode 100644 index 1b4784d0..00000000 --- a/stdlib/lib/Data/Profunctor/Strong.purs +++ /dev/null @@ -1,80 +0,0 @@ -module Data.Profunctor.Strong where - -import Prelude - -import Data.Profunctor (class Profunctor, lcmap) -import Data.Tuple (Tuple(..)) - --- | The `Strong` class extends `Profunctor` with combinators for working with --- | product types. --- | --- | `first` and `second` lift values in a `Profunctor` to act on the first and --- | second components of a `Tuple`, respectively. --- | --- | Another way to think about Strong is to piggyback on the intuition of --- | inputs and outputs. Rewriting the type signature in this light then yields: --- | ``` --- | first :: forall input output a. p input output -> p (Tuple input a) (Tuple output a) --- | second :: forall input output a. p input output -> p (Tuple a input) (Tuple a output) --- | ``` --- | If we specialize the profunctor p to the function arrow, we get the following type --- | signatures, which may look a bit more familiar: --- | ``` --- | first :: forall input output a. (input -> output) -> (Tuple input a) -> (Tuple output a) --- | second :: forall input output a. (input -> output) -> (Tuple a input) -> (Tuple a output) --- | ``` --- | So, when the `profunctor` is `Function` application, `first` essentially applies your function --- | to the first element of a `Tuple`, and `second` applies it to the second element (same as `map` would do). -class Profunctor p <= Strong p where - first :: forall a b c. p a b -> p (Tuple a c) (Tuple b c) - second :: forall a b c. p b c -> p (Tuple a b) (Tuple a c) - -instance strongFn :: Strong (->) where - first a2b (Tuple a c) = Tuple (a2b a) c - second = (<$>) - --- | Compose a value acting on a `Tuple` from two values, each acting on one of --- | the components of the `Tuple`. --- | --- | Specializing `(***)` to function application would look like this: --- | ``` --- | (***) :: forall a b c d. (a -> b) -> (c -> d) -> (Tuple a c) -> (Tuple b d) --- | ``` --- | We take two functions, `f` and `g`, and we transform them into a single function which --- | takes a `Tuple` and maps `f` over the first element and `g` over the second. Just like `bi-map` --- | would do for the `bi-functor` instance of `Tuple`. -splitStrong - :: forall p a b c d - . Semigroupoid p - => Strong p - => p a b - -> p c d - -> p (Tuple a c) (Tuple b d) -splitStrong l r = first l >>> second r - -infixr 3 splitStrong as *** - --- | Compose a value which introduces a `Tuple` from two values, each introducing --- | one side of the `Tuple`. --- | --- | This combinator is useful when assembling values from smaller components, --- | because it provides a way to support two different types of output. --- | --- | Specializing `(&&&)` to function application would look like this: --- | ``` --- | (&&&) :: forall a b c. (a -> b) -> (a -> c) -> (a -> (Tuple b c)) --- | ``` --- | We take two functions, `f` and `g`, with the same parameter type and we transform them into a --- | single function which takes one parameter and returns a `Tuple` of the results of running --- | `f` and `g` on the parameter, respectively. This allows us to run two parallel computations --- | on the same input and return both results in a `Tuple`. -fanout - :: forall p a b c - . Semigroupoid p - => Strong p - => p a b - -> p a c - -> p a (Tuple b c) -fanout l r = lcmap (\a -> Tuple a a) (l *** r) - -infixr 3 fanout as &&& diff --git a/stdlib/lib/Data/Reflectable.purs b/stdlib/lib/Data/Reflectable.purs deleted file mode 100644 index fafe5278..00000000 --- a/stdlib/lib/Data/Reflectable.purs +++ /dev/null @@ -1,57 +0,0 @@ -module Data.Reflectable - ( class Reflectable - , class Reifiable - , reflectType - , reifyType - ) where - -import Data.Ord (Ordering) -import Type.Proxy (Proxy(..)) - --- | A type-class for reflectable types. --- | --- | Instances for the following kinds are solved by the compiler: --- | * Boolean --- | * Int --- | * Ordering --- | * Symbol -class Reflectable :: forall k. k -> Type -> Constraint -class Reflectable v t | v -> t where - -- | Reflect a type `v` to its term-level representation. - reflectType :: Proxy v -> t - --- | A type class for reifiable types. --- | --- | Instances of this type class correspond to the `t` synthesized --- | by the compiler when solving the `Reflectable` type class. -class Reifiable :: Type -> Constraint -class Reifiable t - -instance Reifiable Boolean -instance Reifiable Int -instance Reifiable Ordering -instance Reifiable String - --- local definition for use in `reifyType` -foreign import unsafeCoerce :: forall a b. a -> b - --- | Reify a value of type `t` such that it can be consumed by a --- | function constrained by the `Reflectable` type class. For --- | example: --- | --- | ```purs --- | twiceFromType :: forall v. Reflectable v Int => Proxy v -> Int --- | twiceFromType = (_ * 2) <<< reflectType --- | --- | twiceOfTerm :: Int --- | twiceOfTerm = reifyType 21 twiceFromType --- | ``` -reifyType :: forall t r. Reifiable t => t -> (forall v. Reflectable v t => Proxy v -> r) -> r -reifyType s f = coerce f { reflectType: \_ -> s } Proxy - where - coerce - :: (forall v. Reflectable v t => Proxy v -> r) - -> { reflectType :: Proxy _ -> t } - -> Proxy _ - -> r - coerce = unsafeCoerce diff --git a/stdlib/lib/Data/Ring.purs b/stdlib/lib/Data/Ring.purs deleted file mode 100644 index 2ff5b292..00000000 --- a/stdlib/lib/Data/Ring.purs +++ /dev/null @@ -1,78 +0,0 @@ -module Data.Ring - ( class Ring - , sub - , negate - , (-) - , module Data.Semiring - , class RingRecord - , subRecord - ) where - -import Data.Semiring (class Semiring, class SemiringRecord, add, mul, one, zero, (*), (+)) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit, unit) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeGet, unsafeSet) -import Type.Proxy (Proxy(..)) - --- | The `Ring` class is for types that support addition, multiplication, --- | and subtraction operations. --- | --- | Instances must satisfy the following laws in addition to the `Semiring` --- | laws: --- | --- | - Additive inverse: `a - a = zero` --- | - Compatibility of `sub` and `negate`: `a - b = a + (zero - b)` -class Semiring a <= Ring a where - sub :: a -> a -> a - -infixl 6 sub as - - -instance ringInt :: Ring Int where - sub = intSub - -instance ringNumber :: Ring Number where - sub = numSub - -instance ringUnit :: Ring Unit where - sub _ _ = unit - -instance ringFn :: Ring b => Ring (a -> b) where - sub f g x = f x - g x - -instance ringProxy :: Ring (Proxy a) where - sub _ _ = Proxy - -instance ringRecord :: (RL.RowToList row list, RingRecord list row row) => Ring (Record row) where - sub = subRecord (Proxy :: Proxy list) - --- | `negate x` can be used as a shorthand for `zero - x`. -negate :: forall a. Ring a => a -> a -negate a = zero - a - -foreign import "psrs:intrinsic#intSub" intSub :: Int -> Int -> Int -foreign import "psrs:intrinsic#numberSub" numSub :: Number -> Number -> Number - --- | A class for records where all fields have `Ring` instances, used to --- | implement the `Ring` instance for records. -class RingRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class SemiringRecord rowlist row subrow <= RingRecord rowlist row subrow | rowlist -> subrow where - subRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - -instance ringRecordNil :: RingRecord RL.Nil row () where - subRecord _ _ _ = {} - -instance ringRecordCons :: - ( IsSymbol key - , Row.Cons key focus subrowTail subrow - , RingRecord rowlistTail row subrowTail - , Ring focus - ) => - RingRecord (RL.Cons key focus rowlistTail) row subrow where - subRecord _ ra rb = insert (get ra - get rb) tail - where - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - tail = subRecord (Proxy :: Proxy rowlistTail) ra rb diff --git a/stdlib/lib/Data/Ring/Generic.purs b/stdlib/lib/Data/Ring/Generic.purs deleted file mode 100644 index 27c38fd6..00000000 --- a/stdlib/lib/Data/Ring/Generic.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.Ring.Generic where - -import Prelude - -import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) - -class GenericRing a where - genericSub' :: a -> a -> a - -instance genericRingNoArguments :: GenericRing NoArguments where - genericSub' _ _ = NoArguments - -instance genericRingArgument :: Ring a => GenericRing (Argument a) where - genericSub' (Argument x) (Argument y) = Argument (sub x y) - -instance genericRingProduct :: (GenericRing a, GenericRing b) => GenericRing (Product a b) where - genericSub' (Product a1 b1) (Product a2 b2) = Product (genericSub' a1 a2) (genericSub' b1 b2) - -instance genericRingConstructor :: GenericRing a => GenericRing (Constructor name a) where - genericSub' (Constructor a1) (Constructor a2) = Constructor (genericSub' a1 a2) - --- | A `Generic` implementation of the `sub` member from the `Ring` type class. -genericSub :: forall a rep. Generic a rep => GenericRing rep => a -> a -> a -genericSub x y = to $ from x `genericSub'` from y \ No newline at end of file diff --git a/stdlib/lib/Data/Semigroup.purs b/stdlib/lib/Data/Semigroup.purs deleted file mode 100644 index 28032270..00000000 --- a/stdlib/lib/Data/Semigroup.purs +++ /dev/null @@ -1,84 +0,0 @@ -module Data.Semigroup - ( class Semigroup - , append - , (<>) - , class SemigroupRecord - , appendRecord - ) where - -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit, unit) -import Data.Void (Void, absurd) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeGet, unsafeSet) -import Type.Proxy (Proxy(..)) - --- | The `Semigroup` type class identifies an associative operation on a type. --- | --- | Instances are required to satisfy the following law: --- | --- | - Associativity: `(x <> y) <> z = x <> (y <> z)` --- | --- | One example of a `Semigroup` is `String`, with `(<>)` defined as string --- | concatenation. Another example is `List a`, with `(<>)` defined as --- | list concatenation. --- | --- | ### Newtypes for Semigroup --- | --- | There are two other ways to implement an instance for this type class --- | regardless of which type is used. These instances can be used by --- | wrapping the values in one of the two newtypes below: --- | 1. `First` - Use the first argument every time: `append first _ = first`. --- | 2. `Last` - Use the last argument every time: `append _ last = last`. -class Semigroup a where - append :: a -> a -> a - -infixr 5 append as <> - -instance semigroupString :: Semigroup String where - append = concatString - -instance semigroupUnit :: Semigroup Unit where - append _ _ = unit - -instance semigroupVoid :: Semigroup Void where - append _ = absurd - -instance semigroupFn :: Semigroup s' => Semigroup (s -> s') where - append f g x = f x <> g x - -instance semigroupArray :: Semigroup (Array a) where - append = concatArray - -instance semigroupProxy :: Semigroup (Proxy a) where - append _ _ = Proxy - -instance semigroupRecord :: (RL.RowToList row list, SemigroupRecord list row row) => Semigroup (Record row) where - append = appendRecord (Proxy :: Proxy list) - -foreign import concatString :: String -> String -> String -foreign import concatArray :: forall a. Array a -> Array a -> Array a - --- | A class for records where all fields have `Semigroup` instances, used to --- | implement the `Semigroup` instance for records. -class SemigroupRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class SemigroupRecord rowlist row subrow | rowlist -> subrow where - appendRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - -instance semigroupRecordNil :: SemigroupRecord RL.Nil row () where - appendRecord _ _ _ = {} - -instance semigroupRecordCons :: - ( IsSymbol key - , Row.Cons key focus subrowTail subrow - , SemigroupRecord rowlistTail row subrowTail - , Semigroup focus - ) => - SemigroupRecord (RL.Cons key focus rowlistTail) row subrow where - appendRecord _ ra rb = insert (get ra <> get rb) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - tail = appendRecord (Proxy :: Proxy rowlistTail) ra rb diff --git a/stdlib/lib/Data/Semigroup/First.purs b/stdlib/lib/Data/Semigroup/First.purs deleted file mode 100644 index 18681bb0..00000000 --- a/stdlib/lib/Data/Semigroup/First.purs +++ /dev/null @@ -1,40 +0,0 @@ -module Data.Semigroup.First where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Ord (class Ord1) - --- | Semigroup where `append` always takes the first option. --- | --- | ``` purescript --- | First x <> First y == First x --- | ``` -newtype First a = First a - -derive newtype instance eqFirst :: Eq a => Eq (First a) -derive instance eq1First :: Eq1 First - -derive newtype instance ordFirst :: Ord a => Ord (First a) -derive instance ord1First :: Ord1 First - -derive newtype instance boundedFirst :: Bounded a => Bounded (First a) - -instance showFirst :: Show a => Show (First a) where - show (First a) = "(First " <> show a <> ")" - -derive instance functorFirst :: Functor First - -instance applyFirst :: Apply First where - apply (First f) (First x) = First (f x) - -instance applicativeFirst :: Applicative First where - pure = First - -instance bindFirst :: Bind First where - bind (First x) f = f x - -instance monadFirst :: Monad First - -instance semigroupFirst :: Semigroup (First a) where - append x _ = x diff --git a/stdlib/lib/Data/Semigroup/Foldable.purs b/stdlib/lib/Data/Semigroup/Foldable.purs deleted file mode 100644 index a7fdf36f..00000000 --- a/stdlib/lib/Data/Semigroup/Foldable.purs +++ /dev/null @@ -1,178 +0,0 @@ -module Data.Semigroup.Foldable - ( class Foldable1 - , foldMap1 - , fold1 - , foldr1 - , foldl1 - , traverse1_ - , for1_ - , sequence1_ - , foldr1Default - , foldl1Default - , foldMap1DefaultR - , foldMap1DefaultL - , intercalate - , intercalateMap - , maximum - , maximumBy - , minimum - , minimumBy - ) where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Identity (Identity(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Multiplicative (Multiplicative(..)) -import Data.Newtype (ala, alaF) -import Data.Ord.Max (Max(..)) -import Data.Ord.Min (Min(..)) -import Data.Tuple (Tuple(..)) - --- | `Foldable1` represents data structures with a minimum of one element that can be _folded_. --- | --- | - `foldr1` folds a structure from the right --- | - `foldl1` folds a structure from the left --- | - `foldMap1` folds a structure by accumulating values in a `Semigroup` --- | --- | Default implementations are provided by the following functions: --- | --- | - `foldr1Default` --- | - `foldl1Default` --- | - `foldMap1DefaultR` --- | - `foldMap1DefaultL` --- | --- | Note: some combinations of the default implementations are unsafe to --- | use together - causing a non-terminating mutually recursive cycle. --- | These combinations are documented per function. -class Foldable t <= Foldable1 t where - foldr1 :: forall a. (a -> a -> a) -> t a -> a - foldl1 :: forall a. (a -> a -> a) -> t a -> a - foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m - --- | A default implementation of `foldr1` using `foldMap1`. --- | --- | Note: when defining a `Foldable1` instance, this function is unsafe to use --- | in combination with `foldMap1DefaultR`. -foldr1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a -foldr1Default = flip (runFoldRight1 <<< foldMap1 mkFoldRight1) - --- | A default implementation of `foldl1` using `foldMap1`. --- | --- | Note: when defining a `Foldable1` instance, this function is unsafe to use --- | in combination with `foldMap1DefaultL`. -foldl1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a -foldl1Default = flip (runFoldRight1 <<< alaF Dual foldMap1 mkFoldRight1) <<< flip - --- | A default implementation of `foldMap1` using `foldr1`. --- | --- | Note: when defining a `Foldable1` instance, this function is unsafe to use --- | in combination with `foldr1Default`. -foldMap1DefaultR :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m -foldMap1DefaultR f = map f >>> foldr1 (<>) - --- | A default implementation of `foldMap1` using `foldl1`. --- | --- | Note: when defining a `Foldable1` instance, this function is unsafe to use --- | in combination with `foldl1Default`. -foldMap1DefaultL :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m -foldMap1DefaultL f = map f >>> foldl1 (<>) - -instance foldableDual :: Foldable1 Dual where - foldr1 _ (Dual x) = x - foldl1 _ (Dual x) = x - foldMap1 f (Dual x) = f x - -instance foldableMultiplicative :: Foldable1 Multiplicative where - foldr1 _ (Multiplicative x) = x - foldl1 _ (Multiplicative x) = x - foldMap1 f (Multiplicative x) = f x - -instance foldableTuple :: Foldable1 (Tuple a) where - foldMap1 f (Tuple _ x) = f x - foldr1 _ (Tuple _ x) = x - foldl1 _ (Tuple _ x) = x - -instance foldableIdentity :: Foldable1 Identity where - foldMap1 f (Identity x) = f x - foldl1 _ (Identity x) = x - foldr1 _ (Identity x) = x - --- | Fold a data structure, accumulating values in some `Semigroup`. -fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m -fold1 = foldMap1 identity - -newtype Act :: forall k. (k -> Type) -> k -> Type -newtype Act f a = Act (f a) - -getAct :: forall f a. Act f a -> f a -getAct (Act f) = f - -instance semigroupAct :: Apply f => Semigroup (Act f a) where - append (Act a) (Act b) = Act (a *> b) - --- | Traverse a data structure, performing some effects encoded by an --- | `Apply` instance at each value, ignoring the final result. -traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit -traverse1_ f t = unit <$ getAct (foldMap1 (Act <<< f) t) - --- | A version of `traverse1_` with its arguments flipped. --- | --- | This can be useful when running an action written using do notation --- | for every element in a data structure: -for1_ :: forall t f a b. Foldable1 t => Apply f => t a -> (a -> f b) -> f Unit -for1_ = flip traverse1_ - --- | Perform all of the effects in some data structure in the order --- | given by the `Foldable1` instance, ignoring the final result. -sequence1_ :: forall t f a. Foldable1 t => Apply f => t (f a) -> f Unit -sequence1_ = traverse1_ identity - -maximum :: forall f a. Ord a => Foldable1 f => f a -> a -maximum = ala Max foldMap1 - -maximumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a -maximumBy cmp = foldl1 \x y -> if cmp x y == GT then x else y - -minimum :: forall f a. Ord a => Foldable1 f => f a -> a -minimum = ala Min foldMap1 - -minimumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a -minimumBy cmp = foldl1 \x y -> if cmp x y == LT then x else y - --- | Internal. Used by intercalation functions. -newtype JoinWith a = JoinWith (a -> a) - -joinee :: forall a. JoinWith a -> a -> a -joinee (JoinWith x) = x - -instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where - append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j - --- | Fold a data structure using a `Semigroup` instance, --- | combining adjacent elements using the specified separator. -intercalate :: forall f m. Foldable1 f => Semigroup m => m -> f m -> m -intercalate = flip intercalateMap identity - --- | Fold a data structure, accumulating values in some `Semigroup`, --- | combining adjacent elements using the specified separator. -intercalateMap - :: forall f m a - . Foldable1 f - => Semigroup m - => m -> (a -> m) -> f a -> m -intercalateMap j f foldable = - joinee (foldMap1 (JoinWith <<< const <<< f) foldable) j - --- | Internal. Used by foldr1Default and foldl1Default. -data FoldRight1 a = FoldRight1 (a -> (a -> a -> a) -> a) a - -instance foldRight1Semigroup :: Semigroup (FoldRight1 a) where - append (FoldRight1 lf lr) (FoldRight1 rf rr) = FoldRight1 (\a f -> lf (f lr (rf a f)) f) rr - -mkFoldRight1 :: forall a. a -> FoldRight1 a -mkFoldRight1 = FoldRight1 const - -runFoldRight1 :: forall a. FoldRight1 a -> (a -> a -> a) -> a -runFoldRight1 (FoldRight1 f a) = f a diff --git a/stdlib/lib/Data/Semigroup/Generic.purs b/stdlib/lib/Data/Semigroup/Generic.purs deleted file mode 100644 index 5591903d..00000000 --- a/stdlib/lib/Data/Semigroup/Generic.purs +++ /dev/null @@ -1,31 +0,0 @@ -module Data.Semigroup.Generic - ( class GenericSemigroup - , genericAppend' - , genericAppend - ) where - -import Prelude (class Semigroup, append) -import Data.Generic.Rep - -class GenericSemigroup a where - genericAppend' :: a -> a -> a - -instance genericSemigroupNoConstructors :: GenericSemigroup NoConstructors where - genericAppend' a _ = a - -instance genericSemigroupNoArguments :: GenericSemigroup NoArguments where - genericAppend' a _ = a - -instance genericSemigroupProduct :: (GenericSemigroup a, GenericSemigroup b) => GenericSemigroup (Product a b) where - genericAppend' (Product a1 b1) (Product a2 b2) = - Product (genericAppend' a1 a2) (genericAppend' b1 b2) - -instance genericSemigroupConstructor :: GenericSemigroup a => GenericSemigroup (Constructor name a) where - genericAppend' (Constructor a1) (Constructor a2) = Constructor (genericAppend' a1 a2) - -instance genericSemigroupArgument :: Semigroup a => GenericSemigroup (Argument a) where - genericAppend' (Argument a1) (Argument a2) = Argument (append a1 a2) - --- | A `Generic` implementation of the `append` member from the `Semigroup` type class. -genericAppend :: forall a rep. Generic a rep => GenericSemigroup rep => a -> a -> a -genericAppend x y = to (genericAppend' (from x) (from y)) diff --git a/stdlib/lib/Data/Semigroup/Last.purs b/stdlib/lib/Data/Semigroup/Last.purs deleted file mode 100644 index 232f9989..00000000 --- a/stdlib/lib/Data/Semigroup/Last.purs +++ /dev/null @@ -1,40 +0,0 @@ -module Data.Semigroup.Last where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Ord (class Ord1) - --- | Semigroup where `append` always takes the second option. --- | --- | ``` purescript --- | Last x <> Last y == Last y --- | ``` -newtype Last a = Last a - -derive newtype instance eqLast :: Eq a => Eq (Last a) -derive instance eq1Last :: Eq1 Last - -derive newtype instance ordLast :: Ord a => Ord (Last a) -derive instance ord1Last :: Ord1 Last - -derive newtype instance boundedLast :: Bounded a => Bounded (Last a) - -instance showLast :: Show a => Show (Last a) where - show (Last a) = "(Last " <> show a <> ")" - -derive instance functorLast :: Functor Last - -instance applyLast :: Apply Last where - apply (Last f) (Last x) = Last (f x) - -instance applicativeLast :: Applicative Last where - pure = Last - -instance bindLast :: Bind Last where - bind (Last x) f = f x - -instance monadLast :: Monad Last - -instance semigroupLast :: Semigroup (Last a) where - append _ x = x diff --git a/stdlib/lib/Data/Semigroup/Traversable.purs b/stdlib/lib/Data/Semigroup/Traversable.purs deleted file mode 100644 index c01c671d..00000000 --- a/stdlib/lib/Data/Semigroup/Traversable.purs +++ /dev/null @@ -1,72 +0,0 @@ -module Data.Semigroup.Traversable where - -import Prelude - -import Data.Identity (Identity(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Multiplicative (Multiplicative(..)) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Traversable (class Traversable) -import Data.Tuple (Tuple(..)) - --- | `Traversable1` represents data structures with a minimum of one element that can be _traversed_, --- | accumulating results and effects in some `Applicative` functor. --- | --- | - `traverse1` runs an action for every element in a data structure, --- | and accumulates the results. --- | - `sequence1` runs the actions _contained_ in a data structure, --- | and accumulates the results. --- | --- | The `traverse1` and `sequence1` functions should be compatible in the --- | following sense: --- | --- | - `traverse1 f xs = sequence1 (f <$> xs)` --- | - `sequence1 = traverse1 identity` --- | --- | `Traversable1` instances should also be compatible with the corresponding --- | `Foldable1` instances, in the following sense: --- | --- | - `foldMap1 f = runConst <<< traverse1 (Const <<< f)` --- | --- | Default implementations are provided by the following functions: --- | --- | - `traverse1Default` --- | - `sequence1Default` -class (Foldable1 t, Traversable t) <= Traversable1 t where - traverse1 :: forall a b f. Apply f => (a -> f b) -> t a -> f (t b) - sequence1 :: forall b f. Apply f => t (f b) -> f (t b) - -instance traversableDual :: Traversable1 Dual where - traverse1 f (Dual x) = Dual <$> f x - sequence1 = sequence1Default - -instance traversableMultiplicative :: Traversable1 Multiplicative where - traverse1 f (Multiplicative x) = Multiplicative <$> f x - sequence1 = sequence1Default - -instance traversableTuple :: Traversable1 (Tuple a) where - traverse1 f (Tuple x y) = Tuple x <$> f y - sequence1 (Tuple x y) = Tuple x <$> y - -instance traversableIdentity :: Traversable1 Identity where - traverse1 f (Identity x) = Identity <$> f x - sequence1 (Identity x) = Identity <$> x - --- | A default implementation of `traverse1` using `sequence1`. -traverse1Default - :: forall t a b m - . Traversable1 t - => Apply m - => (a -> m b) - -> t a - -> m (t b) -traverse1Default f ta = sequence1 (f <$> ta) - --- | A default implementation of `sequence1` using `traverse1`. -sequence1Default - :: forall t a m - . Traversable1 t - => Apply m - => t (m a) - -> m (t a) -sequence1Default = traverse1 identity diff --git a/stdlib/lib/Data/Semiring.purs b/stdlib/lib/Data/Semiring.purs deleted file mode 100644 index 79638568..00000000 --- a/stdlib/lib/Data/Semiring.purs +++ /dev/null @@ -1,140 +0,0 @@ -module Data.Semiring - ( class Semiring - , add - , (+) - , zero - , mul - , (*) - , one - , class SemiringRecord - , addRecord - , mulRecord - , oneRecord - , zeroRecord - ) where - -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit, unit) -import Prim.Row as Row -import Prim.RowList as RL -import Record.Unsafe (unsafeGet, unsafeSet) -import Type.Proxy (Proxy(..)) - --- | The `Semiring` class is for types that support an addition and --- | multiplication operation. --- | --- | Instances must satisfy the following laws: --- | --- | - Commutative monoid under addition: --- | - Associativity: `(a + b) + c = a + (b + c)` --- | - Identity: `zero + a = a + zero = a` --- | - Commutative: `a + b = b + a` --- | - Monoid under multiplication: --- | - Associativity: `(a * b) * c = a * (b * c)` --- | - Identity: `one * a = a * one = a` --- | - Multiplication distributes over addition: --- | - Left distributivity: `a * (b + c) = (a * b) + (a * c)` --- | - Right distributivity: `(a + b) * c = (a * c) + (b * c)` --- | - Annihilation: `zero * a = a * zero = zero` --- | --- | **Note:** The `Number` and `Int` types are not fully law abiding --- | members of this class hierarchy due to the potential for arithmetic --- | overflows, and in the case of `Number`, the presence of `NaN` and --- | `Infinity` values. The behaviour is unspecified in these cases. -class Semiring a where - add :: a -> a -> a - zero :: a - mul :: a -> a -> a - one :: a - -infixl 6 add as + -infixl 7 mul as * - -instance semiringInt :: Semiring Int where - add = intAdd - zero = 0 - mul = intMul - one = 1 - -instance semiringNumber :: Semiring Number where - add = numAdd - zero = 0.0 - mul = numMul - one = 1.0 - -instance semiringFn :: Semiring b => Semiring (a -> b) where - add f g x = f x + g x - zero = \_ -> zero - mul f g x = f x * g x - one = \_ -> one - -instance semiringUnit :: Semiring Unit where - add _ _ = unit - zero = unit - mul _ _ = unit - one = unit - -instance semiringProxy :: Semiring (Proxy a) where - add _ _ = Proxy - mul _ _ = Proxy - one = Proxy - zero = Proxy - -instance semiringRecord :: (RL.RowToList row list, SemiringRecord list row row) => Semiring (Record row) where - add = addRecord (Proxy :: Proxy list) - mul = mulRecord (Proxy :: Proxy list) - one = oneRecord (Proxy :: Proxy list) (Proxy :: Proxy row) - zero = zeroRecord (Proxy :: Proxy list) (Proxy :: Proxy row) - -foreign import "psrs:intrinsic#intAdd" intAdd :: Int -> Int -> Int -foreign import intMul :: Int -> Int -> Int -foreign import "psrs:intrinsic#numberAdd" numAdd :: Number -> Number -> Number -foreign import "psrs:intrinsic#numberMul" numMul :: Number -> Number -> Number - --- | A class for records where all fields have `Semiring` instances, used to --- | implement the `Semiring` instance for records. -class SemiringRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint -class SemiringRecord rowlist row subrow | rowlist -> subrow where - addRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - mulRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow - oneRecord :: Proxy rowlist -> Proxy row -> Record subrow - zeroRecord :: Proxy rowlist -> Proxy row -> Record subrow - -instance semiringRecordNil :: SemiringRecord RL.Nil row () where - addRecord _ _ _ = {} - mulRecord _ _ _ = {} - oneRecord _ _ = {} - zeroRecord _ _ = {} - -instance semiringRecordCons :: - ( IsSymbol key - , Row.Cons key focus subrowTail subrow - , SemiringRecord rowlistTail row subrowTail - , Semiring focus - ) => - SemiringRecord (RL.Cons key focus rowlistTail) row subrow where - addRecord _ ra rb = insert (get ra + get rb) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - tail = addRecord (Proxy :: Proxy rowlistTail) ra rb - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - - mulRecord _ ra rb = insert (get ra * get rb) tail - where - key = reflectSymbol (Proxy :: Proxy key) - get = unsafeGet key :: Record row -> focus - tail = mulRecord (Proxy :: Proxy rowlistTail) ra rb - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - - oneRecord _ _ = insert one tail - where - key = reflectSymbol (Proxy :: Proxy key) - tail = oneRecord (Proxy :: Proxy rowlistTail) (Proxy :: Proxy row) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow - - zeroRecord _ _ = insert zero tail - where - key = reflectSymbol (Proxy :: Proxy key) - tail = zeroRecord (Proxy :: Proxy rowlistTail) (Proxy :: Proxy row) - insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow diff --git a/stdlib/lib/Data/Semiring/Generic.purs b/stdlib/lib/Data/Semiring/Generic.purs deleted file mode 100644 index 6bf60d17..00000000 --- a/stdlib/lib/Data/Semiring/Generic.purs +++ /dev/null @@ -1,51 +0,0 @@ -module Data.Semiring.Generic where - -import Prelude - -import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) - -class GenericSemiring a where - genericAdd' :: a -> a -> a - genericZero' :: a - genericMul' :: a -> a -> a - genericOne' :: a - -instance genericSemiringNoArguments :: GenericSemiring NoArguments where - genericAdd' _ _ = NoArguments - genericZero' = NoArguments - genericMul' _ _ = NoArguments - genericOne' = NoArguments - -instance genericSemiringArgument :: Semiring a => GenericSemiring (Argument a) where - genericAdd' (Argument x) (Argument y) = Argument (add x y) - genericZero' = Argument zero - genericMul' (Argument x) (Argument y) = Argument (mul x y) - genericOne' = Argument one - -instance genericSemiringProduct :: (GenericSemiring a, GenericSemiring b) => GenericSemiring (Product a b) where - genericAdd' (Product a1 b1) (Product a2 b2) = Product (genericAdd' a1 a2) (genericAdd' b1 b2) - genericZero' = Product genericZero' genericZero' - genericMul' (Product a1 b1) (Product a2 b2) = Product (genericMul' a1 a2) (genericMul' b1 b2) - genericOne' = Product genericOne' genericOne' - -instance genericSemiringConstructor :: GenericSemiring a => GenericSemiring (Constructor name a) where - genericAdd' (Constructor a1) (Constructor a2) = Constructor (genericAdd' a1 a2) - genericZero' = Constructor genericZero' - genericMul' (Constructor a1) (Constructor a2) = Constructor (genericMul' a1 a2) - genericOne' = Constructor genericOne' - --- | A `Generic` implementation of the `zero` member from the `Semiring` type class. -genericZero :: forall a rep. Generic a rep => GenericSemiring rep => a -genericZero = to genericZero' - --- | A `Generic` implementation of the `one` member from the `Semiring` type class. -genericOne :: forall a rep. Generic a rep => GenericSemiring rep => a -genericOne = to genericOne' - --- | A `Generic` implementation of the `add` member from the `Semiring` type class. -genericAdd :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a -genericAdd x y = to $ from x `genericAdd'` from y - --- | A `Generic` implementation of the `mul` member from the `Semiring` type class. -genericMul :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a -genericMul x y = to $ from x `genericMul'` from y \ No newline at end of file diff --git a/stdlib/lib/Data/Set.purs b/stdlib/lib/Data/Set.purs deleted file mode 100644 index ef35ff62..00000000 --- a/stdlib/lib/Data/Set.purs +++ /dev/null @@ -1,188 +0,0 @@ --- | This module defines a type of sets as height-balanced (AVL) binary trees. --- | Efficient set operations are implemented in terms of --- | - -module Data.Set - ( Set - , fromFoldable - , toUnfoldable - , empty - , isEmpty - , singleton - , map - , checkValid - , insert - , member - , delete - , toggle - , size - , findMin - , findMax - , union - , unions - , difference - , subset - , properSubset - , intersection - , filter - , mapMaybe - , catMaybes - , toMap - , fromMap - ) where - -import Prelude hiding (map) - -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable, foldMap, foldl, foldr) -import Data.List (List) -import Data.List as List -import Data.Map.Internal as M -import Data.Maybe (Maybe(..), maybe) -import Data.Ord (class Ord1) -import Data.Unfoldable (class Unfoldable) -import Prelude as Prelude -import Safe.Coerce (coerce) - --- | `Set a` represents a set of values of type `a` -newtype Set a = Set (M.Map a Unit) - --- | Create a set from a foldable structure. -fromFoldable :: forall f a. Foldable f => Ord a => f a -> Set a -fromFoldable = foldl (\m a -> insert a m) empty - --- | Convert a set to an unfoldable structure. -toUnfoldable :: forall f a. Unfoldable f => Set a -> f a -toUnfoldable = List.toUnfoldable <<< toList - -toList :: forall a. Set a -> List a -toList (Set m) = M.keys m - -instance eqSet :: Eq a => Eq (Set a) where - eq (Set m1) (Set m2) = m1 == m2 - -instance eq1Set :: Eq1 Set where - eq1 = eq - -instance showSet :: Show a => Show (Set a) where - show s = "(fromFoldable " <> show (toUnfoldable s :: Array a) <> ")" - -instance ordSet :: Ord a => Ord (Set a) where - compare s1 s2 = compare (toList s1) (toList s2) - -instance ord1Set :: Ord1 Set where - compare1 = compare - -instance monoidSet :: Ord a => Monoid (Set a) where - mempty = empty - -instance semigroupSet :: Ord a => Semigroup (Set a) where - append = union - -instance foldableSet :: Foldable Set where - foldMap f = foldMap f <<< toList - foldl f x = foldl f x <<< toList - foldr f x = foldr f x <<< toList - --- | An empty set -empty :: forall a. Set a -empty = Set M.empty - --- | Test if a set is empty -isEmpty :: forall a. Set a -> Boolean -isEmpty = coerce (M.isEmpty :: M.Map a Unit -> _) - --- | Create a set with one element -singleton :: forall a. a -> Set a -singleton a = Set (M.singleton a unit) - --- | Maps over the values in a set. --- | --- | This operation is not structure-preserving for sets, so is not a valid --- | `Functor`. An example case: mapping `const x` over a set with `n > 0` --- | elements will result in a set with one element. -map :: forall a b. Ord b => (a -> b) -> Set a -> Set b -map f = foldl (\m a -> insert (f a) m) empty - --- | Check whether the underlying tree satisfies the height, size, and ordering invariants. --- | --- | This function is provided for internal use. -checkValid :: forall a. Ord a => Set a -> Boolean -checkValid = coerce (M.checkValid :: M.Map a Unit -> _) - --- | Test if a value is a member of a set -member :: forall a. Ord a => a -> Set a -> Boolean -member = coerce (M.member :: _ -> M.Map a Unit -> _) - --- | Insert a value into a set -insert :: forall a. Ord a => a -> Set a -> Set a -insert a (Set m) = Set (M.insert a unit m) - --- | Delete a value from a set -delete :: forall a. Ord a => a -> Set a -> Set a -delete = coerce (M.delete :: _ -> M.Map a Unit -> _) - --- | Insert a value into a set if it is not already present, if it is present, delete it. -toggle :: forall a. Ord a => a -> Set a -> Set a -toggle a (Set m) = Set (M.alter (maybe (Just unit) (\_ -> Nothing)) a m) - --- | Find the size of a set -size :: forall a. Set a -> Int -size = coerce (M.size :: M.Map a Unit -> _) - -findMin :: forall a. Set a -> Maybe a -findMin (Set m) = Prelude.map _.key (M.findMin m) - -findMax :: forall a. Set a -> Maybe a -findMax (Set m) = Prelude.map _.key (M.findMax m) - --- | Form the union of two sets --- | --- | Running time: `O(n + m)` -union :: forall a. Ord a => Set a -> Set a -> Set a -union = coerce (M.union :: M.Map a Unit -> _ -> _) - --- | Form the union of a collection of sets -unions :: forall f a. Foldable f => Ord a => f (Set a) -> Set a -unions = foldl union empty - --- | Form the set difference -difference :: forall a. Ord a => Set a -> Set a -> Set a -difference = coerce (M.difference :: M.Map a Unit -> M.Map a Unit -> _) - --- | True if and only if every element in the first set --- | is an element of the second set -subset :: forall a. Ord a => Set a -> Set a -> Boolean -subset s1 s2 = isEmpty $ s1 `difference` s2 - --- | True if and only if the first set is a subset of the second set --- | and the sets are not equal -properSubset :: forall a. Ord a => Set a -> Set a -> Boolean -properSubset s1 s2 = size s1 /= size s2 && subset s1 s2 - --- | The set of elements which are in both the first and second set -intersection :: forall a. Ord a => Set a -> Set a -> Set a -intersection = coerce (M.intersection :: M.Map a Unit -> M.Map a Unit -> _) - --- | Filter out those values of a set for which a predicate on the value fails --- | to hold. -filter :: forall a. Ord a => (a -> Boolean) -> Set a -> Set a -filter = coerce (M.filterKeys :: _ -> M.Map a Unit -> _) - --- | Applies a function to each value in a set, discarding entries where the --- | function returns `Nothing`. -mapMaybe :: forall a b. Ord b => (a -> Maybe b) -> Set a -> Set b -mapMaybe f = foldr (\a acc -> maybe acc (\b -> insert b acc) (f a)) empty - --- | Filter a set of optional values, discarding values that contain `Nothing` -catMaybes :: forall a. Ord a => Set (Maybe a) -> Set a -catMaybes = mapMaybe identity - --- | A set is a map with no value attached to each key. -toMap :: forall a. Set a -> M.Map a Unit -toMap (Set s) = s - --- | A map with no value attached to each key is a set. --- | See also `Data.Map.keys`. -fromMap :: forall a. M.Map a Unit -> Set a -fromMap = Set diff --git a/stdlib/lib/Data/Set/NonEmpty.purs b/stdlib/lib/Data/Set/NonEmpty.purs deleted file mode 100644 index a4c2deee..00000000 --- a/stdlib/lib/Data/Set/NonEmpty.purs +++ /dev/null @@ -1,163 +0,0 @@ -module Data.Set.NonEmpty - ( NonEmptySet - , singleton - , cons - , fromSet - , fromFoldable - , fromFoldable1 - , toSet - , toUnfoldable - , toUnfoldable1 - , map - , member - , insert - , delete - , size - , min - , max - , unionSet - , difference - , subset - , properSubset - , intersection - , filter - , mapMaybe - ) where - -import Prelude hiding (map) - -import Data.Array.NonEmpty (NonEmptyArray) -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable) -import Data.Function.Uncurried (mkFn3) -import Data.List.NonEmpty (NonEmptyList) -import Data.Map.Internal as Internal -import Data.Maybe (Maybe(..), fromJust) -import Data.Ord (class Ord1) -import Data.Semigroup.Foldable (class Foldable1, foldMap1, foldr1, foldl1) -import Data.Set (Set) -import Data.Set as Set -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, class Unfoldable1, unfoldr1) -import Partial.Unsafe (unsafeCrashWith, unsafePartial) -import Safe.Coerce (coerce) - --- | `NonEmptySet a` represents a non-empty set of values of type `a` -newtype NonEmptySet a = NonEmptySet (Set a) - -derive newtype instance eqNonEmptySet :: Eq a => Eq (NonEmptySet a) -derive newtype instance eq1NonEmptySet :: Eq1 NonEmptySet -derive newtype instance ordNonEmptySet :: Ord a => Ord (NonEmptySet a) -derive newtype instance ord1NonEmptySet :: Ord1 NonEmptySet -derive newtype instance semigroupNonEmptySet :: Ord a => Semigroup (NonEmptySet a) -derive newtype instance foldableNonEmptySet :: Foldable NonEmptySet - -instance foldable1NonEmptySet :: Foldable1 NonEmptySet where - foldMap1 f = foldMap1 f <<< (toUnfoldable1 :: forall a. NonEmptySet a -> NonEmptyList a) - foldr1 f = foldr1 f <<< (toUnfoldable1 :: forall a. NonEmptySet a -> NonEmptyList a) - foldl1 f = foldl1 f <<< (toUnfoldable1 :: forall a. NonEmptySet a -> NonEmptyList a) - -instance showNonEmptySet :: Show a => Show (NonEmptySet a) where - show s = "(fromFoldable1 " <> show (toUnfoldable1 s :: NonEmptyArray a) <> ")" - --- | Create a set with one element. -singleton :: forall a. a -> NonEmptySet a -singleton = coerce (Set.singleton :: a -> _) - --- | Creates a `NonEmptySet` from an item and a `Set`. -cons :: forall a. Ord a => a -> Set a -> NonEmptySet a -cons = coerce (Set.insert :: a -> _) - --- | Attempts to create a non-empty set from a possibly-empty set. -fromSet :: forall a. Set a -> Maybe (NonEmptySet a) -fromSet s = if Set.isEmpty s then Nothing else Just (NonEmptySet s) - --- | Create a set from a foldable structure. -fromFoldable :: forall f a. Foldable f => Ord a => f a -> Maybe (NonEmptySet a) -fromFoldable = fromSet <<< Set.fromFoldable - --- | Create a set from a non-empty foldable structure. -fromFoldable1 :: forall f a. Foldable1 f => Ord a => f a -> NonEmptySet a -fromFoldable1 = foldMap1 singleton - --- | Forgets the non-empty property of a set, giving a normal possibly-empty --- | set. -toSet :: forall a. NonEmptySet a -> Set a -toSet (NonEmptySet s) = s - --- | Convert a set to an unfoldable structure. -toUnfoldable :: forall f a. Unfoldable f => NonEmptySet a -> f a -toUnfoldable = coerce (Set.toUnfoldable :: Set a -> f a) - --- | Convert a set to a non-empty unfoldable structure. -toUnfoldable1 :: forall f a. Unfoldable1 f => NonEmptySet a -> f a -toUnfoldable1 = unfoldr1 (stepNext <$> _) <<< stepHead <<< Internal.toMapIter <<< Set.toMap <<< coerce - where - stepHead = Internal.stepAscCps (mkFn3 \k _ next -> Tuple k next) \_ -> unsafeCrashWith "toUnfoldable1: impossible" - stepNext = Internal.stepAscCps (mkFn3 \k _ next -> Just (Tuple k next)) \_ -> Nothing - --- | Maps over the values in a set. --- | --- | This operation is not structure-preserving for sets, so is not a valid --- | `Functor`. An example case: mapping `const x` over a set with `n > 0` --- | elements will result in a set with one element. -map :: forall a b. Ord b => (a -> b) -> NonEmptySet a -> NonEmptySet b -map = coerce (Set.map :: (a -> b) -> _) - --- | Test if a value is a member of a set. -member :: forall a. Ord a => a -> NonEmptySet a -> Boolean -member = coerce (Set.member :: a -> _) - --- | Insert a value into a set. -insert :: forall a. Ord a => a -> NonEmptySet a -> NonEmptySet a -insert = coerce (Set.insert :: a -> _) - --- | Delete a value from a non-empty set. If this would empty the set, the --- | result is `Nothing`. -delete :: forall a. Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a) -delete a (NonEmptySet s) = fromSet (Set.delete a s) - --- | Find the size of a set. -size :: forall a. NonEmptySet a -> Int -size = coerce (Set.size :: Set a -> _) - --- | The minimum value in the set. -min :: forall a. NonEmptySet a -> a -min (NonEmptySet s) = unsafePartial (fromJust (Set.findMin s)) - --- | The maximum value in the set. -max :: forall a. NonEmptySet a -> a -max (NonEmptySet s) = unsafePartial (fromJust (Set.findMax s)) - --- | Form the union of a set and the non-empty set. -unionSet :: forall a. Ord a => Set a -> NonEmptySet a -> NonEmptySet a -unionSet = coerce (append :: _ -> Set a -> _) - --- | Form the set difference. `Nothing` if the first is a subset of the second. -difference :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Maybe (NonEmptySet a) -difference (NonEmptySet s1) (NonEmptySet s2) = fromSet (Set.difference s1 s2) - --- | True if and only if every element in the first set is an element of the --- | second set. -subset :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Boolean -subset = coerce (Set.subset :: Set a -> _) - --- | True if and only if the first set is a subset of the second set and the --- | sets are not equal. -properSubset :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Boolean -properSubset = coerce (Set.properSubset :: Set a -> _) - --- | The set of elements which are in both the first and second set. `Nothing` --- | if the sets are disjoint. -intersection :: forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Maybe (NonEmptySet a) -intersection (NonEmptySet s1) (NonEmptySet s2) = fromSet (Set.intersection s1 s2) - --- | Filter out those values of a set for which a predicate on the value fails --- | to hold. -filter :: forall a. Ord a => (a -> Boolean) -> NonEmptySet a -> Set a -filter = coerce (Set.filter :: _ -> Set a -> _) - --- | Applies a function to each value in a set, discarding entries where the --- | function returns `Nothing`. -mapMaybe :: forall a b. Ord b => (a -> Maybe b) -> NonEmptySet a -> Set b -mapMaybe = coerce (Set.mapMaybe :: _ -> Set a -> Set b) diff --git a/stdlib/lib/Data/Show.purs b/stdlib/lib/Data/Show.purs deleted file mode 100644 index 93c62076..00000000 --- a/stdlib/lib/Data/Show.purs +++ /dev/null @@ -1,97 +0,0 @@ -module Data.Show - ( class Show - , show - , class ShowRecordFields - , showRecordFields - ) where - -import Data.Semigroup ((<>)) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Data.Unit (Unit) -import Data.Void (Void, absurd) -import Prim.Row (class Nub) -import Prim.RowList as RL -import Record.Unsafe (unsafeGet) -import Type.Proxy (Proxy(..)) - --- | The `Show` type class represents those types which can be converted into --- | a human-readable `String` representation. --- | --- | While not required, it is recommended that for any expression `x`, the --- | string `show x` be executable PureScript code which evaluates to the same --- | value as the expression `x`. -class Show a where - show :: a -> String - -instance showUnit :: Show Unit where - show _ = "unit" - -instance showBoolean :: Show Boolean where - show true = "true" - show false = "false" - -instance showInt :: Show Int where - show = showIntImpl - -instance showNumber :: Show Number where - show = showNumberImpl - -instance showChar :: Show Char where - show = showCharImpl - -instance showString :: Show String where - show = showStringImpl - -instance showArray :: Show a => Show (Array a) where - show = showArrayImpl show - -instance showProxy :: Show (Proxy a) where - show _ = "Proxy" - -instance showVoid :: Show Void where - show = absurd - -instance showRecord :: - ( Nub rs rs - , RL.RowToList rs ls - , ShowRecordFields ls rs - ) => - Show (Record rs) where - show record = "{" <> showRecordFields (Proxy :: Proxy ls) record <> "}" - --- | A class for records where all fields have `Show` instances, used to --- | implement the `Show` instance for records. -class ShowRecordFields :: RL.RowList Type -> Row Type -> Constraint -class ShowRecordFields rowlist row where - showRecordFields :: Proxy rowlist -> Record row -> String - -instance showRecordFieldsNil :: ShowRecordFields RL.Nil row where - showRecordFields _ _ = "" -else -instance showRecordFieldsConsNil :: - ( IsSymbol key - , Show focus - ) => - ShowRecordFields (RL.Cons key focus RL.Nil) row where - showRecordFields _ record = " " <> key <> ": " <> show focus <> " " - where - key = reflectSymbol (Proxy :: Proxy key) - focus = unsafeGet key record :: focus -else -instance showRecordFieldsCons :: - ( IsSymbol key - , ShowRecordFields rowlistTail row - , Show focus - ) => - ShowRecordFields (RL.Cons key focus rowlistTail) row where - showRecordFields _ record = " " <> key <> ": " <> show focus <> "," <> tail - where - key = reflectSymbol (Proxy :: Proxy key) - focus = unsafeGet key record :: focus - tail = showRecordFields (Proxy :: Proxy rowlistTail) record - -foreign import showIntImpl :: Int -> String -foreign import showNumberImpl :: Number -> String -foreign import showCharImpl :: Char -> String -foreign import showStringImpl :: String -> String -foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String diff --git a/stdlib/lib/Data/Show/Generic.purs b/stdlib/lib/Data/Show/Generic.purs deleted file mode 100644 index 297986a4..00000000 --- a/stdlib/lib/Data/Show/Generic.purs +++ /dev/null @@ -1,57 +0,0 @@ -module Data.Show.Generic - ( class GenericShow - , genericShow' - , genericShow - , class GenericShowArgs - , genericShowArgs - ) where - -import Prelude (class Show, show, (<>)) -import Data.Generic.Rep -import Data.Symbol (class IsSymbol, reflectSymbol) -import Type.Proxy (Proxy(..)) - -class GenericShow a where - genericShow' :: a -> String - -class GenericShowArgs a where - genericShowArgs :: a -> Array String - -instance genericShowNoConstructors :: GenericShow NoConstructors where - genericShow' a = genericShow' a - -instance genericShowArgsNoArguments :: GenericShowArgs NoArguments where - genericShowArgs _ = [] - -instance genericShowSum :: (GenericShow a, GenericShow b) => GenericShow (Sum a b) where - genericShow' (Inl a) = genericShow' a - genericShow' (Inr b) = genericShow' b - -instance genericShowArgsProduct :: - ( GenericShowArgs a - , GenericShowArgs b - ) => - GenericShowArgs (Product a b) where - genericShowArgs (Product a b) = genericShowArgs a <> genericShowArgs b - -instance genericShowConstructor :: - ( GenericShowArgs a - , IsSymbol name - ) => - GenericShow (Constructor name a) where - genericShow' (Constructor a) = - case genericShowArgs a of - [] -> ctor - args -> "(" <> intercalate " " ([ ctor ] <> args) <> ")" - where - ctor :: String - ctor = reflectSymbol (Proxy :: Proxy name) - -instance genericShowArgsArgument :: Show a => GenericShowArgs (Argument a) where - genericShowArgs (Argument a) = [ show a ] - --- | A `Generic` implementation of the `show` member from the `Show` type class. -genericShow :: forall a rep. Generic a rep => GenericShow rep => a -> String -genericShow x = genericShow' (from x) - -foreign import intercalate :: String -> Array String -> String diff --git a/stdlib/lib/Data/String.purs b/stdlib/lib/Data/String.purs deleted file mode 100644 index 742f2650..00000000 --- a/stdlib/lib/Data/String.purs +++ /dev/null @@ -1,10 +0,0 @@ -module Data.String - ( module Data.String.Common - , module Data.String.CodePoints - , module Data.String.Pattern - ) where - -import Data.String.CodePoints - -import Data.String.Common (joinWith, localeCompare, null, replace, replaceAll, split, toLower, toUpper, trim) -import Data.String.Pattern (Pattern(..), Replacement(..)) diff --git a/stdlib/lib/Data/String/CaseInsensitive.purs b/stdlib/lib/Data/String/CaseInsensitive.purs deleted file mode 100644 index 3783164d..00000000 --- a/stdlib/lib/Data/String/CaseInsensitive.purs +++ /dev/null @@ -1,22 +0,0 @@ -module Data.String.CaseInsensitive where - -import Prelude - -import Data.Newtype (class Newtype) -import Data.String (toLower) - --- | A newtype for case insensitive string comparisons and ordering. -newtype CaseInsensitiveString = CaseInsensitiveString String - -instance eqCaseInsensitiveString :: Eq CaseInsensitiveString where - eq (CaseInsensitiveString s1) (CaseInsensitiveString s2) = - toLower s1 == toLower s2 - -instance ordCaseInsensitiveString :: Ord CaseInsensitiveString where - compare (CaseInsensitiveString s1) (CaseInsensitiveString s2) = - compare (toLower s1) (toLower s2) - -instance showCaseInsensitiveString :: Show CaseInsensitiveString where - show (CaseInsensitiveString s) = "(CaseInsensitiveString " <> show s <> ")" - -derive instance newtypeCaseInsensitiveString :: Newtype CaseInsensitiveString _ diff --git a/stdlib/lib/Data/String/CodePoints.purs b/stdlib/lib/Data/String/CodePoints.purs deleted file mode 100644 index 65e0b55b..00000000 --- a/stdlib/lib/Data/String/CodePoints.purs +++ /dev/null @@ -1,436 +0,0 @@ --- | These functions allow PureScript strings to be treated as if they were --- | sequences of Unicode code points instead of their true underlying --- | implementation (sequences of UTF-16 code units). For nearly all uses of --- | strings, these functions should be preferred over the ones in --- | `Data.String.CodeUnits`. -module Data.String.CodePoints - ( module Exports - , CodePoint - , codePointFromChar - , singleton - , fromCodePointArray - , toCodePointArray - , codePointAt - , uncons - , length - , countPrefix - , indexOf - , indexOf' - , lastIndexOf - , lastIndexOf' - , take - -- , takeRight - , takeWhile - , drop - -- , dropRight - , dropWhile - -- , slice - , splitAt - ) where - -import Prelude - -import Data.Array as Array -import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), defaultPred, defaultSucc, fromEnum, toEnum, toEnumWithDefaults) -import Data.Int (hexadecimal, toStringAs) -import Data.Maybe (Maybe(..)) -import Data.String.CodeUnits (contains, stripPrefix, stripSuffix) as Exports -import Data.String.CodeUnits as CU -import Data.String.Common (toUpper) -import Data.String.Pattern (Pattern) -import Data.String.Unsafe as Unsafe -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (unfoldr) - --- | CodePoint is an `Int` bounded between `0` and `0x10FFFF`, corresponding to --- | Unicode code points. -newtype CodePoint = CodePoint Int - -derive instance eqCodePoint :: Eq CodePoint -derive instance ordCodePoint :: Ord CodePoint - -instance showCodePoint :: Show CodePoint where - show (CodePoint i) = "(CodePoint 0x" <> toUpper (toStringAs hexadecimal i) <> ")" - -instance boundedCodePoint :: Bounded CodePoint where - bottom = CodePoint 0 - top = CodePoint 0x10FFFF - -instance enumCodePoint :: Enum CodePoint where - succ = defaultSucc toEnum fromEnum - pred = defaultPred toEnum fromEnum - -instance boundedEnumCodePoint :: BoundedEnum CodePoint where - cardinality = Cardinality (0x10FFFF + 1) - fromEnum (CodePoint n) = n - toEnum n - | n >= 0 && n <= 0x10FFFF = Just (CodePoint n) - | otherwise = Nothing - --- | Creates a `CodePoint` from a given `Char`. --- | --- | ```purescript --- | >>> codePointFromChar 'B' --- | CodePoint 0x42 -- represents 'B' --- | ``` --- | -codePointFromChar :: Char -> CodePoint -codePointFromChar = fromEnum >>> CodePoint - --- | Creates a string containing just the given code point. Operates in --- | constant space and time. --- | --- | ```purescript --- | >>> map singleton (toEnum 0x1D400) --- | Just "𝐀" --- | ``` --- | -singleton :: CodePoint -> String -singleton = _singleton singletonFallback - -foreign import _singleton - :: (CodePoint -> String) - -> CodePoint - -> String - -singletonFallback :: CodePoint -> String -singletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp -singletonFallback (CodePoint cp) = - let lead = ((cp - 0x10000) / 0x400) + 0xD800 in - let trail = (cp - 0x10000) `mod` 0x400 + 0xDC00 in - fromCharCode lead <> fromCharCode trail - --- | Creates a string from an array of code points. Operates in space and time --- | linear to the length of the array. --- | --- | ```purescript --- | >>> codePointArray = toCodePointArray "c 𝐀" --- | >>> codePointArray --- | [CodePoint 0x63, CodePoint 0x20, CodePoint 0x1D400] --- | >>> fromCodePointArray codePointArray --- | "c 𝐀" --- | ``` --- | -fromCodePointArray :: Array CodePoint -> String -fromCodePointArray = _fromCodePointArray singletonFallback - -foreign import _fromCodePointArray - :: (CodePoint -> String) - -> Array CodePoint - -> String - --- | Creates an array of code points from a string. Operates in space and time --- | linear to the length of the string. --- | --- | ```purescript --- | >>> codePointArray = toCodePointArray "b 𝐀𝐀" --- | >>> codePointArray --- | [CodePoint 0x62, CodePoint 0x20, CodePoint 0x1D400, CodePoint 0x1D400] --- | >>> map singleton codePointArray --- | ["b", " ", "𝐀", "𝐀"] --- | ``` --- | -toCodePointArray :: String -> Array CodePoint -toCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0 - -foreign import _toCodePointArray - :: (String -> Array CodePoint) - -> (String -> CodePoint) - -> String - -> Array CodePoint - -toCodePointArrayFallback :: String -> Array CodePoint -toCodePointArrayFallback s = unfoldr unconsButWithTuple s - -unconsButWithTuple :: String -> Maybe (Tuple CodePoint String) -unconsButWithTuple s = (\{ head, tail } -> Tuple head tail) <$> uncons s - --- | Returns the first code point of the string after dropping the given number --- | of code points from the beginning, if there is such a code point. Operates --- | in constant space and in time linear to the given index. --- | --- | ```purescript --- | >>> codePointAt 1 "𝐀𝐀𝐀𝐀" --- | Just (CodePoint 0x1D400) -- represents "𝐀" --- | -- compare to Data.String: --- | >>> charAt 1 "𝐀𝐀𝐀𝐀" --- | Just '�' --- | ``` --- | -codePointAt :: Int -> String -> Maybe CodePoint -codePointAt n _ | n < 0 = Nothing -codePointAt 0 "" = Nothing -codePointAt 0 s = Just (unsafeCodePointAt0 s) -codePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s - -foreign import _codePointAt - :: (Int -> String -> Maybe CodePoint) - -> (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> (String -> CodePoint) - -> Int - -> String - -> Maybe CodePoint - -codePointAtFallback :: Int -> String -> Maybe CodePoint -codePointAtFallback n s = case uncons s of - Just { head, tail } -> if n == 0 then Just head else codePointAtFallback (n - 1) tail - _ -> Nothing - --- | Returns a record with the first code point and the remaining code points --- | of the string. Returns `Nothing` if the string is empty. Operates in --- | constant space and time. --- | --- | ```purescript --- | >>> uncons "𝐀𝐀 c 𝐀" --- | Just { head: CodePoint 0x1D400, tail: "𝐀 c 𝐀" } --- | >>> uncons "" --- | Nothing --- | ``` --- | -uncons :: String -> Maybe { head :: CodePoint, tail :: String } -uncons s = case CU.length s of - 0 -> Nothing - 1 -> Just { head: CodePoint (fromEnum (Unsafe.charAt 0 s)), tail: "" } - _ -> - let - cu0 = fromEnum (Unsafe.charAt 0 s) - cu1 = fromEnum (Unsafe.charAt 1 s) - in - if isLead cu0 && isTrail cu1 - then Just { head: unsurrogate cu0 cu1, tail: CU.drop 2 s } - else Just { head: CodePoint cu0, tail: CU.drop 1 s } - --- | Returns the number of code points in the string. Operates in constant --- | space and in time linear to the length of the string. --- | --- | ```purescript --- | >>> length "b 𝐀𝐀 c 𝐀" --- | 8 --- | -- compare to Data.String: --- | >>> length "b 𝐀𝐀 c 𝐀" --- | 11 --- | ``` --- | -length :: String -> Int -length = Array.length <<< toCodePointArray - --- | Returns the number of code points in the leading sequence of code points --- | which all match the given predicate. Operates in constant space and in --- | time linear to the length of the string. --- | --- | ```purescript --- | >>> countPrefix (\c -> fromEnum c == 0x1D400) "𝐀𝐀 b c 𝐀" --- | 2 --- | ``` --- | -countPrefix :: (CodePoint -> Boolean) -> String -> Int -countPrefix = _countPrefix countFallback unsafeCodePointAt0 - -foreign import _countPrefix - :: ((CodePoint -> Boolean) -> String -> Int) - -> (String -> CodePoint) - -> (CodePoint -> Boolean) - -> String - -> Int - -countFallback :: (CodePoint -> Boolean) -> String -> Int -countFallback p s = countTail p s 0 - -countTail :: (CodePoint -> Boolean) -> String -> Int -> Int -countTail p s accum = case uncons s of - Just { head, tail } -> if p head then countTail p tail (accum + 1) else accum - _ -> accum - --- | Returns the number of code points preceding the first match of the given --- | pattern in the string. Returns `Nothing` when no matches are found. --- | --- | ```purescript --- | >>> indexOf (Pattern "𝐀") "b 𝐀𝐀 c 𝐀" --- | Just 2 --- | >>> indexOf (Pattern "o") "b 𝐀𝐀 c 𝐀" --- | Nothing --- | ``` --- | -indexOf :: Pattern -> String -> Maybe Int -indexOf p s = (\i -> length (CU.take i s)) <$> CU.indexOf p s - --- | Returns the number of code points preceding the first match of the given --- | pattern in the string. Pattern matches preceding the given index will be --- | ignored. Returns `Nothing` when no matches are found. --- | --- | ```purescript --- | >>> indexOf' (Pattern "𝐀") 4 "b 𝐀𝐀 c 𝐀" --- | Just 7 --- | >>> indexOf' (Pattern "o") 4 "b 𝐀𝐀 c 𝐀" --- | Nothing --- | ``` --- | -indexOf' :: Pattern -> Int -> String -> Maybe Int -indexOf' p i s = - let s' = drop i s in - (\k -> i + length (CU.take k s')) <$> CU.indexOf p s' - --- | Returns the number of code points preceding the last match of the given --- | pattern in the string. Returns `Nothing` when no matches are found. --- | --- | ```purescript --- | >>> lastIndexOf (Pattern "𝐀") "b 𝐀𝐀 c 𝐀" --- | Just 7 --- | >>> lastIndexOf (Pattern "o") "b 𝐀𝐀 c 𝐀" --- | Nothing --- | ``` --- | -lastIndexOf :: Pattern -> String -> Maybe Int -lastIndexOf p s = (\i -> length (CU.take i s)) <$> CU.lastIndexOf p s - --- | Returns the number of code points preceding the first match of the given --- | pattern in the string. Pattern matches following the given index will be --- | ignored. --- | --- | Giving a negative index is equivalent to giving 0 and giving an index --- | greater than the number of code points in the string is equivalent to --- | searching in the whole string. --- | --- | Returns `Nothing` when no matches are found. --- | --- | ```purescript --- | >>> lastIndexOf' (Pattern "𝐀") (-1) "b 𝐀𝐀 c 𝐀" --- | Nothing --- | >>> lastIndexOf' (Pattern "𝐀") 0 "b 𝐀𝐀 c 𝐀" --- | Nothing --- | >>> lastIndexOf' (Pattern "𝐀") 5 "b 𝐀𝐀 c 𝐀" --- | Just 3 --- | >>> lastIndexOf' (Pattern "𝐀") 8 "b 𝐀𝐀 c 𝐀" --- | Just 7 --- | >>> lastIndexOf' (Pattern "o") 5 "b 𝐀𝐀 c 𝐀" --- | Nothing --- | ``` --- | -lastIndexOf' :: Pattern -> Int -> String -> Maybe Int -lastIndexOf' p i s = - let i' = CU.length (take i s) in - (\k -> length (CU.take k s)) <$> CU.lastIndexOf' p i' s - --- | Returns a string containing the given number of code points from the --- | beginning of the given string. If the string does not have that many code --- | points, returns the empty string. Operates in constant space and in time --- | linear to the given number. --- | --- | ```purescript --- | >>> take 3 "b 𝐀𝐀 c 𝐀" --- | "b 𝐀" --- | -- compare to Data.String: --- | >>> take 3 "b 𝐀𝐀 c 𝐀" --- | "b �" --- | ``` --- | -take :: Int -> String -> String -take = _take takeFallback - -foreign import _take :: (Int -> String -> String) -> Int -> String -> String - -takeFallback :: Int -> String -> String -takeFallback n _ | n < 1 = "" -takeFallback n s = case uncons s of - Just { head, tail } -> singleton head <> takeFallback (n - 1) tail - _ -> s - --- | Returns a string containing the leading sequence of code points which all --- | match the given predicate from the string. Operates in constant space and --- | in time linear to the length of the string. --- | --- | ```purescript --- | >>> takeWhile (\c -> fromEnum c == 0x1D400) "𝐀𝐀 b c 𝐀" --- | "𝐀𝐀" --- | ``` --- | -takeWhile :: (CodePoint -> Boolean) -> String -> String -takeWhile p s = take (countPrefix p s) s - --- | Drops the given number of code points from the beginning of the string. If --- | the string does not have that many code points, returns the empty string. --- | Operates in constant space and in time linear to the given number. --- | --- | ```purescript --- | >>> drop 5 "𝐀𝐀 b c" --- | "c" --- | -- compared to Data.String: --- | >>> drop 5 "𝐀𝐀 b c" --- | "b c" -- because "𝐀" occupies 2 code units --- | ``` --- | -drop :: Int -> String -> String -drop n s = CU.drop (CU.length (take n s)) s - --- | Drops the leading sequence of code points which all match the given --- | predicate from the string. Operates in constant space and in time linear --- | to the length of the string. --- | --- | ```purescript --- | >>> dropWhile (\c -> fromEnum c == 0x1D400) "𝐀𝐀 b c 𝐀" --- | " b c 𝐀" --- | ``` --- | -dropWhile :: (CodePoint -> Boolean) -> String -> String -dropWhile p s = drop (countPrefix p s) s - --- | Splits a string into two substrings, where `before` contains the code --- | points up to (but not including) the given index, and `after` contains the --- | rest of the string, from that index on. --- | --- | ```purescript --- | >>> splitAt 3 "b 𝐀𝐀 c 𝐀" --- | { before: "b 𝐀", after: "𝐀 c 𝐀" } --- | ``` --- | --- | Thus the length of `(splitAt i s).before` will equal either `i` or --- | `length s`, if that is shorter. (Or if `i` is negative the length will be --- | 0.) --- | --- | In code: --- | ```purescript --- | length (splitAt i s).before == min (max i 0) (length s) --- | (splitAt i s).before <> (splitAt i s).after == s --- | splitAt i s == {before: take i s, after: drop i s} --- | ``` -splitAt :: Int -> String -> { before :: String, after :: String } -splitAt i s = - let before = take i s in - { before - -- inline drop i s to reuse the result of take i s - , after: CU.drop (CU.length before) s - } - -unsurrogate :: Int -> Int -> CodePoint -unsurrogate lead trail = CodePoint ((lead - 0xD800) * 0x400 + (trail - 0xDC00) + 0x10000) - -isLead :: Int -> Boolean -isLead cu = 0xD800 <= cu && cu <= 0xDBFF - -isTrail :: Int -> Boolean -isTrail cu = 0xDC00 <= cu && cu <= 0xDFFF - -fromCharCode :: Int -> String -fromCharCode = CU.singleton <<< toEnumWithDefaults bottom top - --- WARN: this function expects the String parameter to be non-empty -unsafeCodePointAt0 :: String -> CodePoint -unsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback - -foreign import _unsafeCodePointAt0 - :: (String -> CodePoint) - -> String - -> CodePoint - -unsafeCodePointAt0Fallback :: String -> CodePoint -unsafeCodePointAt0Fallback s = - let - cu0 = fromEnum (Unsafe.charAt 0 s) - in - if isLead cu0 && CU.length s > 1 - then - let cu1 = fromEnum (Unsafe.charAt 1 s) in - if isTrail cu1 then unsurrogate cu0 cu1 else CodePoint cu0 - else - CodePoint cu0 diff --git a/stdlib/lib/Data/String/CodeUnits.purs b/stdlib/lib/Data/String/CodeUnits.purs deleted file mode 100644 index 5fed21fd..00000000 --- a/stdlib/lib/Data/String/CodeUnits.purs +++ /dev/null @@ -1,332 +0,0 @@ -module Data.String.CodeUnits - ( stripPrefix - , stripSuffix - , contains - , singleton - , fromCharArray - , toCharArray - , charAt - , toChar - , uncons - , length - , countPrefix - , indexOf - , indexOf' - , lastIndexOf - , lastIndexOf' - , take - , takeRight - , takeWhile - , drop - , dropRight - , dropWhile - , slice - , splitAt - ) where - -import Prelude - -import Data.Maybe (Maybe(..), isJust) -import Data.String.Pattern (Pattern(..)) -import Data.String.Unsafe as U - -------------------------------------------------------------------------------- --- `stripPrefix`, `stripSuffix`, and `contains` are CodeUnit/CodePoint agnostic --- as they are based on patterns rather than lengths/indices, but they need to --- be defined in here to avoid a circular module dependency -------------------------------------------------------------------------------- - --- | If the string starts with the given prefix, return the portion of the --- | string left after removing it, as a `Just` value. Otherwise, return `Nothing`. --- | --- | ```purescript --- | stripPrefix (Pattern "http:") "http://purescript.org" == Just "//purescript.org" --- | stripPrefix (Pattern "http:") "https://purescript.org" == Nothing --- | ``` -stripPrefix :: Pattern -> String -> Maybe String -stripPrefix (Pattern prefix) str = - let { before, after } = splitAt (length prefix) str in - if before == prefix then Just after else Nothing - --- | If the string ends with the given suffix, return the portion of the --- | string left after removing it, as a `Just` value. Otherwise, return --- | `Nothing`. --- | --- | ```purescript --- | stripSuffix (Pattern ".exe") "psc.exe" == Just "psc" --- | stripSuffix (Pattern ".exe") "psc" == Nothing --- | ``` -stripSuffix :: Pattern -> String -> Maybe String -stripSuffix (Pattern suffix) str = - let { before, after } = splitAt (length str - length suffix) str in - if after == suffix then Just before else Nothing - --- | Checks whether the pattern appears in the given string. --- | --- | ```purescript --- | contains (Pattern "needle") "haystack with needle" == true --- | contains (Pattern "needle") "haystack" == false --- | ``` -contains :: Pattern -> String -> Boolean -contains pat = isJust <<< indexOf pat - -------------------------------------------------------------------------------- --- all functions past this point are CodeUnit specific -------------------------------------------------------------------------------- - --- | Returns a string of length `1` containing the given character. --- | --- | ```purescript --- | singleton 'l' == "l" --- | ``` --- | -foreign import singleton :: Char -> String - --- | Converts an array of characters into a string. --- | --- | ```purescript --- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == "Hello" --- | ``` -foreign import fromCharArray :: Array Char -> String - --- | Converts the string into an array of characters. --- | --- | ```purescript --- | toCharArray "Hello☺\n" == ['H','e','l','l','o','☺','\n'] --- | ``` -foreign import toCharArray :: String -> Array Char - --- | Returns the character at the given index, if the index is within bounds. --- | --- | ```purescript --- | charAt 2 "Hello" == Just 'l' --- | charAt 10 "Hello" == Nothing --- | ``` --- | -charAt :: Int -> String -> Maybe Char -charAt = _charAt Just Nothing - -foreign import _charAt - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Int - -> String - -> Maybe Char - --- | Converts the string to a character, if the length of the string is --- | exactly `1`. --- | --- | ```purescript --- | toChar "l" == Just 'l' --- | toChar "Hi" == Nothing -- since length is not 1 --- | ``` -toChar :: String -> Maybe Char -toChar = _toChar Just Nothing - -foreign import _toChar - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> String - -> Maybe Char - --- | Returns the first character and the rest of the string, --- | if the string is not empty. --- | --- | ```purescript --- | uncons "" == Nothing --- | uncons "Hello World" == Just { head: 'H', tail: "ello World" } --- | ``` --- | -uncons :: String -> Maybe { head :: Char, tail :: String } -uncons "" = Nothing -uncons s = Just { head: U.charAt zero s, tail: drop one s } - --- | Returns the number of characters the string is composed of. --- | --- | ```purescript --- | length "Hello World" == 11 --- | ``` --- | -foreign import length :: String -> Int - --- | Returns the number of contiguous characters at the beginning --- | of the string for which the predicate holds. --- | --- | ```purescript --- | countPrefix (_ /= ' ') "Hello World" == 5 -- since length "Hello" == 5 --- | ``` --- | -foreign import countPrefix :: (Char -> Boolean) -> String -> Int - --- | Returns the index of the first occurrence of the pattern in the --- | given string. Returns `Nothing` if there is no match. --- | --- | ```purescript --- | indexOf (Pattern "c") "abcdc" == Just 2 --- | indexOf (Pattern "c") "aaa" == Nothing --- | ``` --- | -indexOf :: Pattern -> String -> Maybe Int -indexOf = _indexOf Just Nothing - -foreign import _indexOf - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Pattern - -> String - -> Maybe Int - --- | Returns the index of the first occurrence of the pattern in the --- | given string, starting at the specified index. Returns `Nothing` if there is --- | no match. --- | --- | ```purescript --- | indexOf' (Pattern "a") 2 "ababa" == Just 2 --- | indexOf' (Pattern "a") 3 "ababa" == Just 4 --- | ``` --- | -indexOf' :: Pattern -> Int -> String -> Maybe Int -indexOf' = _indexOfStartingAt Just Nothing - -foreign import _indexOfStartingAt - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Pattern - -> Int - -> String - -> Maybe Int - --- | Returns the index of the last occurrence of the pattern in the --- | given string. Returns `Nothing` if there is no match. --- | --- | ```purescript --- | lastIndexOf (Pattern "c") "abcdc" == Just 4 --- | lastIndexOf (Pattern "c") "aaa" == Nothing --- | ``` --- | -lastIndexOf :: Pattern -> String -> Maybe Int -lastIndexOf = _lastIndexOf Just Nothing - -foreign import _lastIndexOf - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Pattern - -> String - -> Maybe Int - --- | Returns the index of the last occurrence of the pattern in the --- | given string, starting at the specified index and searching --- | backwards towards the beginning of the string. --- | --- | Starting at a negative index is equivalent to starting at 0 and --- | starting at an index greater than the string length is equivalent --- | to searching in the whole string. --- | --- | Returns `Nothing` if there is no match. --- | --- | ```purescript --- | lastIndexOf' (Pattern "a") (-1) "ababa" == Just 0 --- | lastIndexOf' (Pattern "a") 1 "ababa" == Just 0 --- | lastIndexOf' (Pattern "a") 3 "ababa" == Just 2 --- | lastIndexOf' (Pattern "a") 4 "ababa" == Just 4 --- | lastIndexOf' (Pattern "a") 5 "ababa" == Just 4 --- | ``` --- | -lastIndexOf' :: Pattern -> Int -> String -> Maybe Int -lastIndexOf' = _lastIndexOfStartingAt Just Nothing - -foreign import _lastIndexOfStartingAt - :: (forall a. a -> Maybe a) - -> (forall a. Maybe a) - -> Pattern - -> Int - -> String - -> Maybe Int - --- | Returns the first `n` characters of the string. --- | --- | ```purescript --- | take 5 "Hello World" == "Hello" --- | ``` --- | -foreign import take :: Int -> String -> String - --- | Returns the last `n` characters of the string. --- | --- | ```purescript --- | takeRight 5 "Hello World" == "World" --- | ``` --- | -takeRight :: Int -> String -> String -takeRight i s = drop (length s - i) s - --- | Returns the longest prefix (possibly empty) of characters that satisfy --- | the predicate. --- | --- | ```purescript --- | takeWhile (_ /= ':') "http://purescript.org" == "http" --- | ``` --- | -takeWhile :: (Char -> Boolean) -> String -> String -takeWhile p s = take (countPrefix p s) s - --- | Returns the string without the first `n` characters. --- | --- | ```purescript --- | drop 6 "Hello World" == "World" --- | ``` --- | -foreign import drop :: Int -> String -> String - --- | Returns the string without the last `n` characters. --- | --- | ```purescript --- | dropRight 6 "Hello World" == "Hello" --- | ``` --- | -dropRight :: Int -> String -> String -dropRight i s = take (length s - i) s - --- | Returns the suffix remaining after `takeWhile`. --- | --- | ```purescript --- | dropWhile (_ /= '.') "Test.purs" == ".purs" --- | ``` --- | -dropWhile :: (Char -> Boolean) -> String -> String -dropWhile p s = drop (countPrefix p s) s - --- | Returns the substring at indices `[begin, end)`. --- | If either index is negative, it is normalised to `length s - index`, --- | where `s` is the input string. `""` is returned if either --- | index is out of bounds or if `begin > end` after normalisation. --- | --- | ```purescript --- | slice 0 0 "purescript" == "" --- | slice 0 1 "purescript" == "p" --- | slice 3 6 "purescript" == "esc" --- | slice (-4) (-1) "purescript" == "rip" --- | slice (-4) 3 "purescript" == "" --- | ``` -foreign import slice :: Int -> Int -> String -> String - --- | Splits a string into two substrings, where `before` contains the --- | characters up to (but not including) the given index, and `after` contains --- | the rest of the string, from that index on. --- | --- | ```purescript --- | splitAt 2 "Hello World" == { before: "He", after: "llo World"} --- | splitAt 10 "Hi" == { before: "Hi", after: ""} --- | ``` --- | --- | Thus the length of `(splitAt i s).before` will equal either `i` or --- | `length s`, if that is shorter. (Or if `i` is negative the length will be --- | 0.) --- | --- | In code: --- | ```purescript --- | length (splitAt i s).before == min (max i 0) (length s) --- | (splitAt i s).before <> (splitAt i s).after == s --- | splitAt i s == {before: take i s, after: drop i s} --- | ``` -foreign import splitAt :: Int -> String -> { before :: String, after :: String } diff --git a/stdlib/lib/Data/String/Common.purs b/stdlib/lib/Data/String/Common.purs deleted file mode 100644 index 9e3132e6..00000000 --- a/stdlib/lib/Data/String/Common.purs +++ /dev/null @@ -1,96 +0,0 @@ -module Data.String.Common - ( null - , localeCompare - , replace - , replaceAll - , split - , toLower - , toUpper - , trim - , joinWith - ) where - -import Prelude - -import Data.String.Pattern (Pattern, Replacement) - --- | Returns `true` if the given string is empty. --- | --- | ```purescript --- | null "" == true --- | null "Hi" == false --- | ``` -null :: String -> Boolean -null s = s == "" - --- | Compare two strings in a locale-aware fashion. This is in contrast to --- | the `Ord` instance on `String` which treats strings as arrays of code --- | units: --- | --- | ```purescript --- | "ä" `localeCompare` "b" == LT --- | "ä" `compare` "b" == GT --- | ``` -localeCompare :: String -> String -> Ordering -localeCompare = _localeCompare LT EQ GT - -foreign import _localeCompare - :: Ordering - -> Ordering - -> Ordering - -> String - -> String - -> Ordering - --- | Replaces the first occurence of the pattern with the replacement string. --- | --- | ```purescript --- | replace (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b <= c" --- | ``` -foreign import replace :: Pattern -> Replacement -> String -> String - --- | Replaces all occurences of the pattern with the replacement string. --- | --- | ```purescript --- | replaceAll (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b ≤ c" --- | ``` -foreign import replaceAll :: Pattern -> Replacement -> String -> String - --- | Returns the substrings of the second string separated along occurences --- | of the first string. --- | --- | ```purescript --- | split (Pattern " ") "hello world" == ["hello", "world"] --- | ``` -foreign import split :: Pattern -> String -> Array String - --- | Returns the argument converted to lowercase. --- | --- | ```purescript --- | toLower "hElLo" == "hello" --- | ``` -foreign import toLower :: String -> String - --- | Returns the argument converted to uppercase. --- | --- | ```purescript --- | toUpper "Hello" == "HELLO" --- | ``` -foreign import toUpper :: String -> String - --- | Removes whitespace from the beginning and end of a string, including --- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2) --- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3). --- | --- | ```purescript --- | trim " Hello \n World\n\t " == "Hello \n World" --- | ``` -foreign import trim :: String -> String - --- | Joins the strings in the array together, inserting the first argument --- | as separator between them. --- | --- | ```purescript --- | joinWith ", " ["apple", "banana", "orange"] == "apple, banana, orange" --- | ``` -foreign import joinWith :: String -> Array String -> String diff --git a/stdlib/lib/Data/String/Gen.purs b/stdlib/lib/Data/String/Gen.purs deleted file mode 100644 index 845b5e80..00000000 --- a/stdlib/lib/Data/String/Gen.purs +++ /dev/null @@ -1,43 +0,0 @@ -module Data.String.Gen where - -import Prelude - -import Control.Monad.Gen (class MonadGen, chooseInt, unfoldable, sized, resize) -import Control.Monad.Rec.Class (class MonadRec) -import Data.Char.Gen as CG -import Data.String.CodeUnits as SCU - --- | Generates a string using the specified character generator. -genString :: forall m. MonadRec m => MonadGen m => m Char -> m String -genString genChar = sized \size -> do - newSize <- chooseInt 1 (max 1 size) - resize (const newSize) $ SCU.fromCharArray <$> unfoldable genChar - --- | Generates a string using characters from the Unicode basic multilingual --- | plain. -genUnicodeString :: forall m. MonadRec m => MonadGen m => m String -genUnicodeString = genString CG.genUnicodeChar - --- | Generates a string using the ASCII character set, excluding control codes. -genAsciiString :: forall m. MonadRec m => MonadGen m => m String -genAsciiString = genString CG.genAsciiChar - --- | Generates a string using the ASCII character set. -genAsciiString' :: forall m. MonadRec m => MonadGen m => m String -genAsciiString' = genString CG.genAsciiChar' - --- | Generates a string made up of numeric digits. -genDigitString :: forall m. MonadRec m => MonadGen m => m String -genDigitString = genString CG.genDigitChar - --- | Generates a string using characters from the basic Latin alphabet. -genAlphaString :: forall m. MonadRec m => MonadGen m => m String -genAlphaString = genString CG.genAlpha - --- | Generates a string using lowercase characters from the basic Latin alphabet. -genAlphaLowercaseString :: forall m. MonadRec m => MonadGen m => m String -genAlphaLowercaseString = genString CG.genAlphaLowercase - --- | Generates a string using uppercase characters from the basic Latin alphabet. -genAlphaUppercaseString :: forall m. MonadRec m => MonadGen m => m String -genAlphaUppercaseString = genString CG.genAlphaUppercase diff --git a/stdlib/lib/Data/String/NonEmpty.purs b/stdlib/lib/Data/String/NonEmpty.purs deleted file mode 100644 index 6b6210c7..00000000 --- a/stdlib/lib/Data/String/NonEmpty.purs +++ /dev/null @@ -1,9 +0,0 @@ -module Data.String.NonEmpty - ( module Data.String.Pattern - , module Data.String.NonEmpty.Internal - , module Data.String.NonEmpty.CodePoints - ) where - -import Data.String.NonEmpty.Internal (NonEmptyString, class MakeNonEmpty, NonEmptyReplacement(..), appendString, contains, fromString, join1With, joinWith, joinWith1, localeCompare, nes, prependString, replace, replaceAll, stripPrefix, stripSuffix, toLower, toString, toUpper, trim, unsafeFromString) -import Data.String.Pattern (Pattern(..)) -import Data.String.NonEmpty.CodePoints diff --git a/stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs b/stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs deleted file mode 100644 index d1c1719e..00000000 --- a/stdlib/lib/Data/String/NonEmpty/CaseInsensitive.purs +++ /dev/null @@ -1,22 +0,0 @@ -module Data.String.NonEmpty.CaseInsensitive where - -import Prelude - -import Data.Newtype (class Newtype) -import Data.String.NonEmpty (NonEmptyString, toLower) - --- | A newtype for case insensitive string comparisons and ordering. -newtype CaseInsensitiveNonEmptyString = CaseInsensitiveNonEmptyString NonEmptyString - -instance eqCaseInsensitiveNonEmptyString :: Eq CaseInsensitiveNonEmptyString where - eq (CaseInsensitiveNonEmptyString s1) (CaseInsensitiveNonEmptyString s2) = - toLower s1 == toLower s2 - -instance ordCaseInsensitiveNonEmptyString :: Ord CaseInsensitiveNonEmptyString where - compare (CaseInsensitiveNonEmptyString s1) (CaseInsensitiveNonEmptyString s2) = - compare (toLower s1) (toLower s2) - -instance showCaseInsensitiveNonEmptyString :: Show CaseInsensitiveNonEmptyString where - show (CaseInsensitiveNonEmptyString s) = "(CaseInsensitiveNonEmptyString " <> show s <> ")" - -derive instance newtypeCaseInsensitiveNonEmptyString :: Newtype CaseInsensitiveNonEmptyString _ diff --git a/stdlib/lib/Data/String/NonEmpty/CodePoints.purs b/stdlib/lib/Data/String/NonEmpty/CodePoints.purs deleted file mode 100644 index 7b5328ab..00000000 --- a/stdlib/lib/Data/String/NonEmpty/CodePoints.purs +++ /dev/null @@ -1,138 +0,0 @@ -module Data.String.NonEmpty.CodePoints - ( fromCodePointArray - , fromNonEmptyCodePointArray - , singleton - , cons - , snoc - , fromFoldable1 - , toCodePointArray - , toNonEmptyCodePointArray - , codePointAt - , indexOf - , indexOf' - , lastIndexOf - , lastIndexOf' - , uncons - , length - , take - -- takeRight - , takeWhile - , drop - -- dropRight - , dropWhile - , countPrefix - , splitAt - ) where - -import Prelude - -import Data.Array.NonEmpty (NonEmptyArray) -import Data.Array.NonEmpty as NEA -import Data.Maybe (Maybe(..), fromJust) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Foldable as F1 -import Data.String.CodePoints (CodePoint) -import Data.String.CodePoints as CP -import Data.String.NonEmpty.Internal (NonEmptyString(..), fromString) -import Data.String.Pattern (Pattern) -import Partial.Unsafe (unsafePartial) - --- For internal use only. Do not export. -toNonEmptyString :: String -> NonEmptyString -toNonEmptyString = NonEmptyString - --- For internal use only. Do not export. -fromNonEmptyString :: NonEmptyString -> String -fromNonEmptyString (NonEmptyString s) = s - --- For internal use only. Do not export. -liftS :: forall r. (String -> r) -> NonEmptyString -> r -liftS f (NonEmptyString s) = f s - -fromCodePointArray :: Array CodePoint -> Maybe NonEmptyString -fromCodePointArray = case _ of - [] -> Nothing - cs -> Just (toNonEmptyString (CP.fromCodePointArray cs)) - -fromNonEmptyCodePointArray :: NonEmptyArray CodePoint -> NonEmptyString -fromNonEmptyCodePointArray = unsafePartial fromJust <<< fromCodePointArray <<< NEA.toArray - -singleton :: CodePoint -> NonEmptyString -singleton = toNonEmptyString <<< CP.singleton - -cons :: CodePoint -> String -> NonEmptyString -cons c s = toNonEmptyString (CP.singleton c <> s) - -snoc :: CodePoint -> String -> NonEmptyString -snoc c s = toNonEmptyString (s <> CP.singleton c) - -fromFoldable1 :: forall f. Foldable1 f => f CodePoint -> NonEmptyString -fromFoldable1 = F1.foldMap1 singleton - -toCodePointArray :: NonEmptyString -> Array CodePoint -toCodePointArray = CP.toCodePointArray <<< fromNonEmptyString - -toNonEmptyCodePointArray :: NonEmptyString -> NonEmptyArray CodePoint -toNonEmptyCodePointArray = unsafePartial fromJust <<< NEA.fromArray <<< toCodePointArray - -codePointAt :: Int -> NonEmptyString -> Maybe CodePoint -codePointAt = liftS <<< CP.codePointAt - -indexOf :: Pattern -> NonEmptyString -> Maybe Int -indexOf = liftS <<< CP.indexOf - -indexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int -indexOf' pat = liftS <<< CP.indexOf' pat - -lastIndexOf :: Pattern -> NonEmptyString -> Maybe Int -lastIndexOf = liftS <<< CP.lastIndexOf - -lastIndexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int -lastIndexOf' pat = liftS <<< CP.lastIndexOf' pat - -uncons :: NonEmptyString -> { head :: CodePoint, tail :: Maybe NonEmptyString } -uncons nes = - let - s = fromNonEmptyString nes - in - { head: unsafePartial fromJust (CP.codePointAt 0 s) - , tail: fromString (CP.drop 1 s) - } - -length :: NonEmptyString -> Int -length = CP.length <<< fromNonEmptyString - -take :: Int -> NonEmptyString -> Maybe NonEmptyString -take i nes = - let - s = fromNonEmptyString nes - in - if i < 1 - then Nothing - else Just (toNonEmptyString (CP.take i s)) - -takeWhile :: (CodePoint -> Boolean) -> NonEmptyString -> Maybe NonEmptyString -takeWhile f = fromString <<< liftS (CP.takeWhile f) - -drop :: Int -> NonEmptyString -> Maybe NonEmptyString -drop i nes = - let - s = fromNonEmptyString nes - in - if i >= CP.length s - then Nothing - else Just (toNonEmptyString (CP.drop i s)) - -dropWhile :: (CodePoint -> Boolean) -> NonEmptyString -> Maybe NonEmptyString -dropWhile f = fromString <<< liftS (CP.dropWhile f) - -countPrefix :: (CodePoint -> Boolean) -> NonEmptyString -> Int -countPrefix = liftS <<< CP.countPrefix - -splitAt - :: Int - -> NonEmptyString - -> { before :: Maybe NonEmptyString, after :: Maybe NonEmptyString } -splitAt i nes = - case CP.splitAt i (fromNonEmptyString nes) of - { before, after } -> { before: fromString before, after: fromString after } diff --git a/stdlib/lib/Data/String/NonEmpty/CodeUnits.purs b/stdlib/lib/Data/String/NonEmpty/CodeUnits.purs deleted file mode 100644 index af3de430..00000000 --- a/stdlib/lib/Data/String/NonEmpty/CodeUnits.purs +++ /dev/null @@ -1,308 +0,0 @@ -module Data.String.NonEmpty.CodeUnits - ( fromCharArray - , fromNonEmptyCharArray - , singleton - , cons - , snoc - , fromFoldable1 - , toCharArray - , toNonEmptyCharArray - , charAt - , toChar - , indexOf - , indexOf' - , lastIndexOf - , lastIndexOf' - , uncons - , length - , take - , takeRight - , takeWhile - , drop - , dropRight - , dropWhile - , countPrefix - , splitAt - ) where - -import Prelude - -import Data.Array.NonEmpty (NonEmptyArray) -import Data.Array.NonEmpty as NEA -import Data.Maybe (Maybe(..), fromJust) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Foldable as F1 -import Data.String.CodeUnits as CU -import Data.String.NonEmpty.Internal (NonEmptyString(..), fromString) -import Data.String.Pattern (Pattern) -import Data.String.Unsafe as U -import Partial.Unsafe (unsafePartial) -import Unsafe.Coerce (unsafeCoerce) - --- For internal use only. Do not export. -toNonEmptyString :: String -> NonEmptyString -toNonEmptyString = NonEmptyString - --- For internal use only. Do not export. -fromNonEmptyString :: NonEmptyString -> String -fromNonEmptyString (NonEmptyString s) = s - --- For internal use only. Do not export. -liftS :: forall r. (String -> r) -> NonEmptyString -> r -liftS f (NonEmptyString s) = f s - --- | Creates a `NonEmptyString` from a character array `String`, returning --- | `Nothing` if the input is empty. --- | --- | ```purescript --- | fromCharArray [] = Nothing --- | fromCharArray ['a', 'b', 'c'] = Just (NonEmptyString "abc") --- | ``` -fromCharArray :: Array Char -> Maybe NonEmptyString -fromCharArray = case _ of - [] -> Nothing - cs -> Just (toNonEmptyString (CU.fromCharArray cs)) - -fromNonEmptyCharArray :: NonEmptyArray Char -> NonEmptyString -fromNonEmptyCharArray = unsafePartial fromJust <<< fromCharArray <<< NEA.toArray - --- | Creates a `NonEmptyString` from a character. -singleton :: Char -> NonEmptyString -singleton = toNonEmptyString <<< CU.singleton - --- | Creates a `NonEmptyString` from a string by prepending a character. --- | --- | ```purescript --- | cons 'a' "bc" = NonEmptyString "abc" --- | cons 'a' "" = NonEmptyString "a" --- | ``` -cons :: Char -> String -> NonEmptyString -cons c s = toNonEmptyString (CU.singleton c <> s) - --- | Creates a `NonEmptyString` from a string by appending a character. --- | --- | ```purescript --- | snoc 'c' "ab" = NonEmptyString "abc" --- | snoc 'a' "" = NonEmptyString "a" --- | ``` -snoc :: Char -> String -> NonEmptyString -snoc c s = toNonEmptyString (s <> CU.singleton c) - --- | Creates a `NonEmptyString` from a `Foldable1` container carrying --- | characters. -fromFoldable1 :: forall f. Foldable1 f => f Char -> NonEmptyString -fromFoldable1 = F1.fold1 <<< coe - where - coe ∷ f Char -> f NonEmptyString - coe = unsafeCoerce - --- | Converts the `NonEmptyString` into an array of characters. --- | --- | ```purescript --- | toCharArray (NonEmptyString "Hello☺\n") == ['H','e','l','l','o','☺','\n'] --- | ``` -toCharArray :: NonEmptyString -> Array Char -toCharArray = CU.toCharArray <<< fromNonEmptyString - --- | Converts the `NonEmptyString` into a non-empty array of characters. -toNonEmptyCharArray :: NonEmptyString -> NonEmptyArray Char -toNonEmptyCharArray = unsafePartial fromJust <<< NEA.fromArray <<< toCharArray - --- | Returns the character at the given index, if the index is within bounds. --- | --- | ```purescript --- | charAt 2 (NonEmptyString "Hello") == Just 'l' --- | charAt 10 (NonEmptyString "Hello") == Nothing --- | ``` -charAt :: Int -> NonEmptyString -> Maybe Char -charAt = liftS <<< CU.charAt - --- | Converts the `NonEmptyString` to a character, if the length of the string --- | is exactly `1`. --- | --- | ```purescript --- | toChar "H" == Just 'H' --- | toChar "Hi" == Nothing --- | ``` -toChar :: NonEmptyString -> Maybe Char -toChar = CU.toChar <<< fromNonEmptyString - --- | Returns the index of the first occurrence of the pattern in the --- | given string. Returns `Nothing` if there is no match. --- | --- | ```purescript --- | indexOf (Pattern "c") (NonEmptyString "abcdc") == Just 2 --- | indexOf (Pattern "c") (NonEmptyString "aaa") == Nothing --- | ``` -indexOf :: Pattern -> NonEmptyString -> Maybe Int -indexOf = liftS <<< CU.indexOf - --- | Returns the index of the first occurrence of the pattern in the --- | given string, starting at the specified index. Returns `Nothing` if there is --- | no match. --- | --- | ```purescript --- | indexOf' (Pattern "a") 2 (NonEmptyString "ababa") == Just 2 --- | indexOf' (Pattern "a") 3 (NonEmptyString "ababa") == Just 4 --- | ``` -indexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int -indexOf' pat = liftS <<< CU.indexOf' pat - --- | Returns the index of the last occurrence of the pattern in the --- | given string. Returns `Nothing` if there is no match. --- | --- | ```purescript --- | lastIndexOf (Pattern "c") (NonEmptyString "abcdc") == Just 4 --- | lastIndexOf (Pattern "c") (NonEmptyString "aaa") == Nothing --- | ``` -lastIndexOf :: Pattern -> NonEmptyString -> Maybe Int -lastIndexOf = liftS <<< CU.lastIndexOf - --- | Returns the index of the last occurrence of the pattern in the --- | given string, starting at the specified index and searching --- | backwards towards the beginning of the string. --- | --- | Starting at a negative index is equivalent to starting at 0 and --- | starting at an index greater than the string length is equivalent --- | to searching in the whole string. --- | --- | Returns `Nothing` if there is no match. --- | --- | ```purescript --- | lastIndexOf' (Pattern "a") (-1) (NonEmptyString "ababa") == Just 0 --- | lastIndexOf' (Pattern "a") 1 (NonEmptyString "ababa") == Just 0 --- | lastIndexOf' (Pattern "a") 3 (NonEmptyString "ababa") == Just 2 --- | lastIndexOf' (Pattern "a") 4 (NonEmptyString "ababa") == Just 4 --- | lastIndexOf' (Pattern "a") 5 (NonEmptyString "ababa") == Just 4 --- | ``` -lastIndexOf' :: Pattern -> Int -> NonEmptyString -> Maybe Int -lastIndexOf' pat = liftS <<< CU.lastIndexOf' pat - --- | Returns the first character and the rest of the string. --- | --- | ```purescript --- | uncons "a" == { head: 'a', tail: Nothing } --- | uncons "Hello World" == { head: 'H', tail: Just (NonEmptyString "ello World") } --- | ``` -uncons :: NonEmptyString -> { head :: Char, tail :: Maybe NonEmptyString } -uncons nes = - let - s = fromNonEmptyString nes - in - { head: U.charAt 0 s - , tail: fromString (CU.drop 1 s) - } - --- | Returns the number of characters the string is composed of. --- | --- | ```purescript --- | length (NonEmptyString "Hello World") == 11 --- | ``` -length :: NonEmptyString -> Int -length = CU.length <<< fromNonEmptyString - --- | Returns the first `n` characters of the string. Returns `Nothing` if `n` is --- | less than 1. --- | --- | ```purescript --- | take 5 (NonEmptyString "Hello World") == Just (NonEmptyString "Hello") --- | take 0 (NonEmptyString "Hello World") == Nothing --- | ``` -take :: Int -> NonEmptyString -> Maybe NonEmptyString -take i nes = - let - s = fromNonEmptyString nes - in - if i < 1 - then Nothing - else Just (toNonEmptyString (CU.take i s)) - --- | Returns the last `n` characters of the string. Returns `Nothing` if `n` is --- | less than 1. --- | --- | ```purescript --- | take 5 (NonEmptyString "Hello World") == Just (NonEmptyString "World") --- | take 0 (NonEmptyString "Hello World") == Nothing --- | ``` -takeRight :: Int -> NonEmptyString -> Maybe NonEmptyString -takeRight i nes = - let - s = fromNonEmptyString nes - in - if i < 1 - then Nothing - else Just (toNonEmptyString (CU.takeRight i s)) - --- | Returns the longest prefix of characters that satisfy the predicate. --- | `Nothing` is returned if there is no matching prefix. --- | --- | ```purescript --- | takeWhile (_ /= ':') (NonEmptyString "http://purescript.org") == Just (NonEmptyString "http") --- | takeWhile (_ == 'a') (NonEmptyString "xyz") == Nothing --- | ``` -takeWhile :: (Char -> Boolean) -> NonEmptyString -> Maybe NonEmptyString -takeWhile f = fromString <<< liftS (CU.takeWhile f) - --- | Returns the string without the first `n` characters. Returns `Nothing` if --- | more characters are dropped than the string is long. --- | --- | ```purescript --- | drop 6 (NonEmptyString "Hello World") == Just (NonEmptyString "World") --- | drop 20 (NonEmptyString "Hello World") == Nothing --- | ``` -drop :: Int -> NonEmptyString -> Maybe NonEmptyString -drop i nes = - let - s = fromNonEmptyString nes - in - if i >= CU.length s - then Nothing - else Just (toNonEmptyString (CU.drop i s)) - --- | Returns the string without the last `n` characters. Returns `Nothing` if --- | more characters are dropped than the string is long. --- | --- | ```purescript --- | dropRight 6 (NonEmptyString "Hello World") == Just (NonEmptyString "Hello") --- | dropRight 20 (NonEmptyString "Hello World") == Nothing --- | ``` -dropRight :: Int -> NonEmptyString -> Maybe NonEmptyString -dropRight i nes = - let - s = fromNonEmptyString nes - in - if i >= CU.length s - then Nothing - else Just (toNonEmptyString (CU.dropRight i s)) - --- | Returns the suffix remaining after `takeWhile`. --- | --- | ```purescript --- | dropWhile (_ /= '.') (NonEmptyString "Test.purs") == Just (NonEmptyString ".purs") --- | ``` -dropWhile :: (Char -> Boolean) -> NonEmptyString -> Maybe NonEmptyString -dropWhile f = fromString <<< liftS (CU.dropWhile f) - --- | Returns the number of contiguous characters at the beginning of the string --- | for which the predicate holds. --- | --- | ```purescript --- | countPrefix (_ /= 'o') (NonEmptyString "Hello World") == 4 --- | ``` -countPrefix :: (Char -> Boolean) -> NonEmptyString -> Int -countPrefix = liftS <<< CU.countPrefix - --- | Returns the substrings of a split at the given index, if the index is --- | within bounds. --- | --- | ```purescript --- | splitAt 2 (NonEmptyString "Hello World") == Just { before: Just (NonEmptyString "He"), after: Just (NonEmptyString "llo World") } --- | splitAt 10 (NonEmptyString "Hi") == Nothing --- | ``` -splitAt - :: Int - -> NonEmptyString - -> { before :: Maybe NonEmptyString, after :: Maybe NonEmptyString } -splitAt i nes = - case CU.splitAt i (fromNonEmptyString nes) of - { before, after } -> { before: fromString before, after: fromString after } diff --git a/stdlib/lib/Data/String/NonEmpty/Internal.purs b/stdlib/lib/Data/String/NonEmpty/Internal.purs deleted file mode 100644 index 87226543..00000000 --- a/stdlib/lib/Data/String/NonEmpty/Internal.purs +++ /dev/null @@ -1,232 +0,0 @@ --- | While most of the code in this module is safe, this module does --- | export a few partial functions and the `NonEmptyString` constructor. --- | While the partial functions are obvious from the `Partial` constraint in --- | their type signature, the `NonEmptyString` constructor can be overlooked --- | when searching for issues in one's code. See the constructor's --- | documentation for more information. -module Data.String.NonEmpty.Internal where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Foldable as F -import Data.Maybe (Maybe(..), fromJust) -import Data.Semigroup.Foldable (class Foldable1) -import Data.String as String -import Data.String.Pattern (Pattern) -import Data.Symbol (class IsSymbol, reflectSymbol) -import Prim.TypeError as TE -import Type.Proxy (Proxy) -import Unsafe.Coerce (unsafeCoerce) - --- | A string that is known not to be empty. --- | --- | You can use this constructor to create a `NonEmptyString` that isn't --- | non-empty, breaking the guarantee behind this newtype. It is --- | provided as an escape hatch mainly for the `Data.NonEmpty.CodeUnits` --- | and `Data.NonEmpty.CodePoints` modules. Use this at your own risk --- | when you know what you are doing. -newtype NonEmptyString = NonEmptyString String - -derive newtype instance eqNonEmptyString ∷ Eq NonEmptyString -derive newtype instance ordNonEmptyString ∷ Ord NonEmptyString -derive newtype instance semigroupNonEmptyString ∷ Semigroup NonEmptyString - -instance showNonEmptyString :: Show NonEmptyString where - show (NonEmptyString s) = "(NonEmptyString.unsafeFromString " <> show s <> ")" - --- | A helper class for defining non-empty string values at compile time. --- | --- | ``` purescript --- | something :: NonEmptyString --- | something = nes (Proxy :: Proxy "something") --- | ``` -class MakeNonEmpty (s :: Symbol) where - nes :: Proxy s -> NonEmptyString - -instance makeNonEmptyBad :: TE.Fail (TE.Text "Cannot create an NonEmptyString from an empty Symbol") => MakeNonEmpty "" where - nes _ = NonEmptyString "" - -else instance nonEmptyNonEmpty :: IsSymbol s => MakeNonEmpty s where - nes p = NonEmptyString (reflectSymbol p) - --- | A newtype used in cases to specify a non-empty replacement for a pattern. -newtype NonEmptyReplacement = NonEmptyReplacement NonEmptyString - -derive newtype instance eqNonEmptyReplacement :: Eq NonEmptyReplacement -derive newtype instance ordNonEmptyReplacement :: Ord NonEmptyReplacement -derive newtype instance semigroupNonEmptyReplacement ∷ Semigroup NonEmptyReplacement - -instance showNonEmptyReplacement :: Show NonEmptyReplacement where - show (NonEmptyReplacement s) = "(NonEmptyReplacement " <> show s <> ")" - --- | Creates a `NonEmptyString` from a `String`, returning `Nothing` if the --- | input is empty. --- | --- | ```purescript --- | fromString "" = Nothing --- | fromString "hello" = Just (NES.unsafeFromString "hello") --- | ``` -fromString :: String -> Maybe NonEmptyString -fromString = case _ of - "" -> Nothing - s -> Just (NonEmptyString s) - --- | A partial version of `fromString`. -unsafeFromString :: Partial => String -> NonEmptyString -unsafeFromString = fromJust <<< fromString - --- | Converts a `NonEmptyString` back into a standard `String`. -toString :: NonEmptyString -> String -toString (NonEmptyString s) = s - --- | Appends a string to this non-empty string. Since one of the strings is --- | non-empty we know the result will be too. --- | --- | ```purescript --- | appendString (NonEmptyString "Hello") " world" == NonEmptyString "Hello world" --- | appendString (NonEmptyString "Hello") "" == NonEmptyString "Hello" --- | ``` -appendString :: NonEmptyString -> String -> NonEmptyString -appendString (NonEmptyString s1) s2 = NonEmptyString (s1 <> s2) - --- | Prepends a string to this non-empty string. Since one of the strings is --- | non-empty we know the result will be too. --- | --- | ```purescript --- | prependString "be" (NonEmptyString "fore") == NonEmptyString "before" --- | prependString "" (NonEmptyString "fore") == NonEmptyString "fore" --- | ``` -prependString :: String -> NonEmptyString -> NonEmptyString -prependString s1 (NonEmptyString s2) = NonEmptyString (s1 <> s2) - --- | If the string starts with the given prefix, return the portion of the --- | string left after removing it. If the prefix does not match or there is no --- | remainder, the result will be `Nothing`. --- | --- | ```purescript --- | stripPrefix (Pattern "http:") (NonEmptyString "http://purescript.org") == Just (NonEmptyString "//purescript.org") --- | stripPrefix (Pattern "http:") (NonEmptyString "https://purescript.org") == Nothing --- | stripPrefix (Pattern "Hello!") (NonEmptyString "Hello!") == Nothing --- | ``` -stripPrefix :: Pattern -> NonEmptyString -> Maybe NonEmptyString -stripPrefix pat = fromString <=< liftS (String.stripPrefix pat) - --- | If the string ends with the given suffix, return the portion of the --- | string left after removing it. If the suffix does not match or there is no --- | remainder, the result will be `Nothing`. --- | --- | ```purescript --- | stripSuffix (Pattern ".exe") (NonEmptyString "purs.exe") == Just (NonEmptyString "purs") --- | stripSuffix (Pattern ".exe") (NonEmptyString "purs") == Nothing --- | stripSuffix (Pattern "Hello!") (NonEmptyString "Hello!") == Nothing --- | ``` -stripSuffix :: Pattern -> NonEmptyString -> Maybe NonEmptyString -stripSuffix pat = fromString <=< liftS (String.stripSuffix pat) - --- | Checks whether the pattern appears in the given string. --- | --- | ```purescript --- | contains (Pattern "needle") (NonEmptyString "haystack with needle") == true --- | contains (Pattern "needle") (NonEmptyString "haystack") == false --- | ``` -contains :: Pattern -> NonEmptyString -> Boolean -contains = liftS <<< String.contains - --- | Compare two strings in a locale-aware fashion. This is in contrast to --- | the `Ord` instance on `String` which treats strings as arrays of code --- | units: --- | --- | ```purescript --- | NonEmptyString "ä" `localeCompare` NonEmptyString "b" == LT --- | NonEmptyString "ä" `compare` NonEmptyString "b" == GT --- | ``` -localeCompare :: NonEmptyString -> NonEmptyString -> Ordering -localeCompare (NonEmptyString a) (NonEmptyString b) = String.localeCompare a b - --- | Replaces the first occurence of the pattern with the replacement string. --- | --- | ```purescript --- | replace (Pattern "<=") (NonEmptyReplacement "≤") (NonEmptyString "a <= b <= c") == NonEmptyString "a ≤ b <= c" --- | ``` -replace :: Pattern -> NonEmptyReplacement -> NonEmptyString -> NonEmptyString -replace pat (NonEmptyReplacement (NonEmptyString rep)) (NonEmptyString s) = - NonEmptyString (String.replace pat (String.Replacement rep) s) - --- | Replaces all occurences of the pattern with the replacement string. --- | --- | ```purescript --- | replaceAll (Pattern "<=") (NonEmptyReplacement "≤") (NonEmptyString "a <= b <= c") == NonEmptyString "a ≤ b ≤ c" --- | ``` -replaceAll :: Pattern -> NonEmptyReplacement -> NonEmptyString -> NonEmptyString -replaceAll pat (NonEmptyReplacement (NonEmptyString rep)) (NonEmptyString s) = - NonEmptyString (String.replaceAll pat (String.Replacement rep) s) - --- | Returns the argument converted to lowercase. --- | --- | ```purescript --- | toLower (NonEmptyString "hElLo") == NonEmptyString "hello" --- | ``` -toLower :: NonEmptyString -> NonEmptyString -toLower (NonEmptyString s) = NonEmptyString (String.toLower s) - --- | Returns the argument converted to uppercase. --- | --- | ```purescript --- | toUpper (NonEmptyString "Hello") == NonEmptyString "HELLO" --- | ``` -toUpper :: NonEmptyString -> NonEmptyString -toUpper (NonEmptyString s) = NonEmptyString (String.toUpper s) - --- | Removes whitespace from the beginning and end of a string, including --- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2) --- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3). --- | If the string is entirely made up of whitespace the result will be Nothing. --- | --- | ```purescript --- | trim (NonEmptyString " Hello \n World\n\t ") == Just (NonEmptyString "Hello \n World") --- | trim (NonEmptyString " \n") == Nothing --- | ``` -trim :: NonEmptyString -> Maybe NonEmptyString -trim (NonEmptyString s) = fromString (String.trim s) - --- | Joins the strings in a container together as a new string, inserting the --- | first argument as separator between them. The result is not guaranteed to --- | be non-empty. --- | --- | ```purescript --- | joinWith ", " [NonEmptyString "apple", NonEmptyString "banana"] == "apple, banana" --- | joinWith ", " [] == "" --- | ``` -joinWith :: forall f. Foldable f => String -> f NonEmptyString -> String -joinWith splice = F.intercalate splice <<< coe - where - coe :: f NonEmptyString -> f String - coe = unsafeCoerce - --- | Joins non-empty strings in a non-empty container together as a new --- | non-empty string, inserting a possibly empty string as separator between --- | them. The result is guaranteed to be non-empty. --- | --- | ```purescript --- | -- array syntax is used for demonstration here, it would need to be a real `Foldable1` --- | join1With ", " [NonEmptyString "apple", NonEmptyString "banana"] == NonEmptyString "apple, banana" --- | join1With "" [NonEmptyString "apple", NonEmptyString "banana"] == NonEmptyString "applebanana" --- | ``` -join1With :: forall f. Foldable1 f => String -> f NonEmptyString -> NonEmptyString -join1With splice = NonEmptyString <<< joinWith splice - --- | Joins possibly empty strings in a non-empty container together as a new --- | non-empty string, inserting a non-empty string as a separator between them. --- | The result is guaranteed to be non-empty. --- | --- | ```purescript --- | -- array syntax is used for demonstration here, it would need to be a real `Foldable1` --- | joinWith1 (NonEmptyString ", ") ["apple", "banana"] == NonEmptyString "apple, banana" --- | joinWith1 (NonEmptyString "/") ["a", "b", "", "c", ""] == NonEmptyString "a/b//c/" --- | ``` -joinWith1 :: forall f. Foldable1 f => NonEmptyString -> f String -> NonEmptyString -joinWith1 (NonEmptyString splice) = NonEmptyString <<< F.intercalate splice - -liftS :: forall r. (String -> r) -> NonEmptyString -> r -liftS f (NonEmptyString s) = f s diff --git a/stdlib/lib/Data/String/Pattern.purs b/stdlib/lib/Data/String/Pattern.purs deleted file mode 100644 index e0aea960..00000000 --- a/stdlib/lib/Data/String/Pattern.purs +++ /dev/null @@ -1,33 +0,0 @@ -module Data.String.Pattern where - -import Prelude - -import Data.Newtype (class Newtype) - --- | A newtype used in cases where there is a string to be matched. --- | --- | ```purescript --- | pursPattern = Pattern ".purs" --- | --can be used like this: --- | contains pursPattern "Test.purs" --- | == true --- | ``` --- | -newtype Pattern = Pattern String - -derive instance eqPattern :: Eq Pattern -derive instance ordPattern :: Ord Pattern -derive instance newtypePattern :: Newtype Pattern _ - -instance showPattern :: Show Pattern where - show (Pattern s) = "(Pattern " <> show s <> ")" - --- | A newtype used in cases to specify a replacement for a pattern. -newtype Replacement = Replacement String - -derive instance eqReplacement :: Eq Replacement -derive instance ordReplacement :: Ord Replacement -derive instance newtypeReplacement :: Newtype Replacement _ - -instance showReplacement :: Show Replacement where - show (Replacement s) = "(Replacement " <> show s <> ")" diff --git a/stdlib/lib/Data/String/Regex.purs b/stdlib/lib/Data/String/Regex.purs deleted file mode 100644 index aae56e1b..00000000 --- a/stdlib/lib/Data/String/Regex.purs +++ /dev/null @@ -1,131 +0,0 @@ --- | Wraps Javascript's `RegExp` object that enables matching strings with --- | patterns defined by regular expressions. --- | For details of the underlying implementation, see [RegExp Reference at MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/RegExp). -module Data.String.Regex - ( Regex(..) - , regex - , source - , flags - , renderFlags - , parseFlags - , test - , match - , replace - , replace' - , search - , split - ) where - -import Prelude - -import Data.Array.NonEmpty (NonEmptyArray) -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) -import Data.String (contains) -import Data.String.Pattern (Pattern(..)) -import Data.String.Regex.Flags (RegexFlags(..), RegexFlagsRec) - --- | Wraps Javascript `RegExp` objects. -foreign import data Regex :: Type - -foreign import showRegexImpl :: Regex -> String - -instance showRegex :: Show Regex where - show = showRegexImpl - -foreign import regexImpl - :: (String -> Either String Regex) - -> (Regex -> Either String Regex) - -> String - -> String - -> Either String Regex - --- | Constructs a `Regex` from a pattern string and flags. Fails with --- | `Left error` if the pattern contains a syntax error. -regex :: String -> RegexFlags -> Either String Regex -regex s f = regexImpl Left Right s $ renderFlags f - --- | Returns the pattern string used to construct the given `Regex`. -foreign import source :: Regex -> String - --- | Returns the `RegexFlags` used to construct the given `Regex`. -flags :: Regex -> RegexFlags -flags = RegexFlags <<< flagsImpl - --- | Returns the `RegexFlags` inner record used to construct the given `Regex`. -foreign import flagsImpl :: Regex -> RegexFlagsRec - --- | Returns the string representation of the given `RegexFlags`. -renderFlags :: RegexFlags -> String -renderFlags (RegexFlags f) = - (if f.global then "g" else "") <> - (if f.ignoreCase then "i" else "") <> - (if f.multiline then "m" else "") <> - (if f.dotAll then "s" else "") <> - (if f.sticky then "y" else "") <> - (if f.unicode then "u" else "") - --- | Parses the string representation of `RegexFlags`. -parseFlags :: String -> RegexFlags -parseFlags s = RegexFlags - { global: contains (Pattern "g") s - , ignoreCase: contains (Pattern "i") s - , multiline: contains (Pattern "m") s - , dotAll: contains (Pattern "s") s - , sticky: contains (Pattern "y") s - , unicode: contains (Pattern "u") s - } - --- | Returns `true` if the `Regex` matches the string. In contrast to --- | `RegExp.prototype.test()` in JavaScript, `test` does not affect --- | the `lastIndex` property of the Regex. -foreign import test :: Regex -> String -> Boolean - -foreign import _match - :: (forall r. r -> Maybe r) - -> (forall r. Maybe r) - -> Regex - -> String - -> Maybe (NonEmptyArray (Maybe String)) - --- | Matches the string against the `Regex` and returns an array of matches --- | if there were any. Each match has type `Maybe String`, where `Nothing` --- | represents an unmatched optional capturing group. --- | See [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/match). -match :: Regex -> String -> Maybe (NonEmptyArray (Maybe String)) -match = _match Just Nothing - --- | Replaces occurrences of the `Regex` with the first string. The replacement --- | string can include special replacement patterns escaped with `"$"`. --- | See [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/replace). -foreign import replace :: Regex -> String -> String -> String - -foreign import _replaceBy - :: (forall r. r -> Maybe r) - -> (forall r. Maybe r) - -> Regex - -> (String -> Array (Maybe String) -> String) - -> String - -> String - --- | Transforms occurrences of the `Regex` using a function of the matched --- | substring and a list of captured substrings of type `Maybe String`, --- | where `Nothing` represents an unmatched optional capturing group. --- | See the [reference](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/replace#Specifying_a_function_as_a_parameter). -replace' :: Regex -> (String -> Array (Maybe String) -> String) -> String -> String -replace' = _replaceBy Just Nothing - -foreign import _search - :: (forall r. r -> Maybe r) - -> (forall r. Maybe r) - -> Regex - -> String - -> Maybe Int - --- | Returns `Just` the index of the first match of the `Regex` in the string, --- | or `Nothing` if there is no match. -search :: Regex -> String -> Maybe Int -search = _search Just Nothing - --- | Split the string into an array of substrings along occurrences of the `Regex`. -foreign import split :: Regex -> String -> Array String diff --git a/stdlib/lib/Data/String/Regex/Flags.purs b/stdlib/lib/Data/String/Regex/Flags.purs deleted file mode 100644 index 6d7dd710..00000000 --- a/stdlib/lib/Data/String/Regex/Flags.purs +++ /dev/null @@ -1,129 +0,0 @@ -module Data.String.Regex.Flags where - -import Prelude - -import Control.MonadPlus (guard) -import Data.Newtype (class Newtype) -import Data.String (joinWith) - -type RegexFlagsRec = - { global :: Boolean - , ignoreCase :: Boolean - , multiline :: Boolean - , dotAll :: Boolean - , sticky :: Boolean - , unicode :: Boolean - } - --- | Flags that control matching. -newtype RegexFlags = RegexFlags RegexFlagsRec - -derive instance newtypeRegexFlags :: Newtype RegexFlags _ - --- | All flags set to false. -noFlags :: RegexFlags -noFlags = RegexFlags - { global: false - , ignoreCase: false - , multiline: false - , dotAll: false - , sticky: false - , unicode: false - } - --- | Only global flag set to true -global :: RegexFlags -global = RegexFlags - { global: true - , ignoreCase: false - , multiline: false - , dotAll: false - , sticky: false - , unicode: false - } - --- | Only ignoreCase flag set to true -ignoreCase :: RegexFlags -ignoreCase = RegexFlags - { global: false - , ignoreCase: true - , multiline: false - , dotAll: false - , sticky: false - , unicode: false - } - --- | Only multiline flag set to true -multiline :: RegexFlags -multiline = RegexFlags - { global: false - , ignoreCase: false - , multiline: true - , dotAll: false - , sticky: false - , unicode: false - } - --- | Only sticky flag set to true -sticky :: RegexFlags -sticky = RegexFlags - { global: false - , ignoreCase: false - , multiline: false - , dotAll: false - , sticky: true - , unicode: false - } - --- | Only unicode flag set to true -unicode :: RegexFlags -unicode = RegexFlags - { global: false - , ignoreCase: false - , multiline: false - , dotAll: false - , sticky: false - , unicode: true - } - --- | Only dotAll flag set to true -dotAll :: RegexFlags -dotAll = RegexFlags - { global: false - , ignoreCase: false - , multiline: false - , dotAll: true - , sticky: false - , unicode: false - } - -instance semigroupRegexFlags :: Semigroup RegexFlags where - append (RegexFlags x) (RegexFlags y) = RegexFlags - { global: x.global || y.global - , ignoreCase: x.ignoreCase || y.ignoreCase - , multiline: x.multiline || y.multiline - , dotAll: x.dotAll || y.dotAll - , sticky: x.sticky || y.sticky - , unicode: x.unicode || y.unicode - } - -instance monoidRegexFlags :: Monoid RegexFlags where - mempty = noFlags - -derive newtype instance eqRegexFlags :: Eq RegexFlags - -instance showRegexFlags :: Show RegexFlags where - show (RegexFlags flags) = - let - usedFlags = - [] - <> (guard flags.global $> "global") - <> (guard flags.ignoreCase $> "ignoreCase") - <> (guard flags.multiline $> "multiline") - <> (guard flags.dotAll $> "dotAll") - <> (guard flags.sticky $> "sticky") - <> (guard flags.unicode $> "unicode") - in - if usedFlags == [] - then "noFlags" - else "(" <> joinWith " <> " usedFlags <> ")" diff --git a/stdlib/lib/Data/String/Regex/Unsafe.purs b/stdlib/lib/Data/String/Regex/Unsafe.purs deleted file mode 100644 index 8afd1a29..00000000 --- a/stdlib/lib/Data/String/Regex/Unsafe.purs +++ /dev/null @@ -1,14 +0,0 @@ -module Data.String.Regex.Unsafe - ( unsafeRegex - ) where - -import Control.Category (identity) -import Data.Either (either) -import Data.String.Regex (Regex, regex) -import Data.String.Regex.Flags (RegexFlags) -import Partial.Unsafe (unsafeCrashWith) - --- | Constructs a `Regex` from a pattern string and flags. Fails with --- | an exception if the pattern contains a syntax error. -unsafeRegex :: String -> RegexFlags -> Regex -unsafeRegex s f = either unsafeCrashWith identity (regex s f) diff --git a/stdlib/lib/Data/String/Unsafe.purs b/stdlib/lib/Data/String/Unsafe.purs deleted file mode 100644 index 75f5037f..00000000 --- a/stdlib/lib/Data/String/Unsafe.purs +++ /dev/null @@ -1,15 +0,0 @@ --- | Unsafe string and character functions. -module Data.String.Unsafe - ( char - , charAt - ) where - --- | Returns the character at the given index. --- | --- | **Unsafe:** throws runtime exception if the index is out of bounds. -foreign import charAt :: Int -> String -> Char - --- | Converts a string of length `1` to a character. --- | --- | **Unsafe:** throws runtime exception if length is not `1`. -foreign import char :: String -> Char diff --git a/stdlib/lib/Data/Symbol.purs b/stdlib/lib/Data/Symbol.purs deleted file mode 100644 index 80f289e3..00000000 --- a/stdlib/lib/Data/Symbol.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.Symbol - ( class IsSymbol - , reflectSymbol - , reifySymbol - ) where - -import Type.Proxy (Proxy(..)) - --- | A class for known symbols -class IsSymbol (sym :: Symbol) where - reflectSymbol :: Proxy sym -> String - --- local definition for use in `reifySymbol` -foreign import unsafeCoerce :: forall a b. a -> b - -reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r -reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy - where - coerce - :: (forall sym1. IsSymbol sym1 => Proxy sym1 -> r) - -> { reflectSymbol :: Proxy "" -> String } - -> Proxy "" - -> r - coerce = unsafeCoerce diff --git a/stdlib/lib/Data/Traversable.purs b/stdlib/lib/Data/Traversable.purs deleted file mode 100644 index 180bf2f3..00000000 --- a/stdlib/lib/Data/Traversable.purs +++ /dev/null @@ -1,257 +0,0 @@ -module Data.Traversable - ( class Traversable, traverse, sequence - , traverseDefault, sequenceDefault - , for - , scanl - , scanr - , mapAccumL - , mapAccumR - , module Data.Foldable - , module Data.Traversable.Accum - ) where - -import Prelude - -import Control.Apply (lift2) -import Data.Const (Const(..)) -import Data.Either (Either(..)) -import Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, sequence_, sum, traverse_) -import Data.Functor.App (App(..)) -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Coproduct (Coproduct(..), coproduct) -import Data.Functor.Product (Product(..), product) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) -import Data.Maybe.First (First(..)) -import Data.Maybe.Last (Last(..)) -import Data.Monoid.Additive (Additive(..)) -import Data.Monoid.Conj (Conj(..)) -import Data.Monoid.Disj (Disj(..)) -import Data.Monoid.Dual (Dual(..)) -import Data.Monoid.Multiplicative (Multiplicative(..)) -import Data.Traversable.Accum (Accum) -import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) -import Data.Tuple (Tuple(..)) - --- | `Traversable` represents data structures which can be _traversed_, --- | accumulating results and effects in some `Applicative` functor. --- | --- | - `traverse` runs an action for every element in a data structure, --- | and accumulates the results. --- | - `sequence` runs the actions _contained_ in a data structure, --- | and accumulates the results. --- | --- | ```purescript --- | import Data.Traversable --- | import Data.Maybe --- | import Data.Int (fromNumber) --- | --- | sequence [Just 1, Just 2, Just 3] == Just [1,2,3] --- | sequence [Nothing, Just 2, Just 3] == Nothing --- | --- | traverse fromNumber [1.0, 2.0, 3.0] == Just [1,2,3] --- | traverse fromNumber [1.5, 2.0, 3.0] == Nothing --- | --- | traverse logShow [1,2,3] --- | -- prints: --- | 1 --- | 2 --- | 3 --- | --- | traverse (\x -> [x, 0]) [1,2,3] == [[1,2,3],[1,2,0],[1,0,3],[1,0,0],[0,2,3],[0,2,0],[0,0,3],[0,0,0]] --- | ``` --- | --- | The `traverse` and `sequence` functions should be compatible in the --- | following sense: --- | --- | - `traverse f xs = sequence (f <$> xs)` --- | - `sequence = traverse identity` --- | --- | `Traversable` instances should also be compatible with the corresponding --- | `Foldable` instances, in the following sense: --- | --- | - `foldMap f = runConst <<< traverse (Const <<< f)` --- | --- | Default implementations are provided by the following functions: --- | --- | - `traverseDefault` --- | - `sequenceDefault` -class (Functor t, Foldable t) <= Traversable t where - traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b) - sequence :: forall a m. Applicative m => t (m a) -> m (t a) - --- | A default implementation of `traverse` using `sequence` and `map`. -traverseDefault - :: forall t a b m - . Traversable t - => Applicative m - => (a -> m b) - -> t a - -> m (t b) -traverseDefault f ta = sequence (f <$> ta) - --- | A default implementation of `sequence` using `traverse`. -sequenceDefault - :: forall t a m - . Traversable t - => Applicative m - => t (m a) - -> m (t a) -sequenceDefault = traverse identity - -instance traversableArray :: Traversable Array where - traverse = traverseArrayImpl apply map pure - sequence = sequenceDefault - -foreign import traverseArrayImpl - :: forall m a b - . (forall x y. m (x -> y) -> m x -> m y) - -> (forall x y. (x -> y) -> m x -> m y) - -> (forall x. x -> m x) - -> (a -> m b) - -> Array a - -> m (Array b) - -instance traversableMaybe :: Traversable Maybe where - traverse _ Nothing = pure Nothing - traverse f (Just x) = Just <$> f x - sequence Nothing = pure Nothing - sequence (Just x) = Just <$> x - -instance traversableFirst :: Traversable First where - traverse f (First x) = First <$> traverse f x - sequence (First x) = First <$> sequence x - -instance traversableLast :: Traversable Last where - traverse f (Last x) = Last <$> traverse f x - sequence (Last x) = Last <$> sequence x - -instance traversableAdditive :: Traversable Additive where - traverse f (Additive x) = Additive <$> f x - sequence (Additive x) = Additive <$> x - -instance traversableDual :: Traversable Dual where - traverse f (Dual x) = Dual <$> f x - sequence (Dual x) = Dual <$> x - -instance traversableConj :: Traversable Conj where - traverse f (Conj x) = Conj <$> f x - sequence (Conj x) = Conj <$> x - -instance traversableDisj :: Traversable Disj where - traverse f (Disj x) = Disj <$> f x - sequence (Disj x) = Disj <$> x - -instance traversableMultiplicative :: Traversable Multiplicative where - traverse f (Multiplicative x) = Multiplicative <$> f x - sequence (Multiplicative x) = Multiplicative <$> x - -instance traversableEither :: Traversable (Either a) where - traverse _ (Left x) = pure (Left x) - traverse f (Right x) = Right <$> f x - sequence (Left x) = pure (Left x) - sequence (Right x) = Right <$> x - -instance traversableTuple :: Traversable (Tuple a) where - traverse f (Tuple x y) = Tuple x <$> f y - sequence (Tuple x y) = Tuple x <$> y - -instance traversableIdentity :: Traversable Identity where - traverse f (Identity x) = Identity <$> f x - sequence (Identity x) = Identity <$> x - -instance traversableConst :: Traversable (Const a) where - traverse _ (Const x) = pure (Const x) - sequence (Const x) = pure (Const x) - -instance traversableProduct :: (Traversable f, Traversable g) => Traversable (Product f g) where - traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga) - sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga) - -instance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where - traverse f = coproduct - (map (Coproduct <<< Left) <<< traverse f) - (map (Coproduct <<< Right) <<< traverse f) - sequence = coproduct - (map (Coproduct <<< Left) <<< sequence) - (map (Coproduct <<< Right) <<< sequence) - -instance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where - traverse f (Compose fga) = map Compose $ traverse (traverse f) fga - sequence = traverse identity - -instance traversableApp :: Traversable f => Traversable (App f) where - traverse f (App x) = App <$> traverse f x - sequence (App x) = App <$> sequence x - --- | A version of `traverse` with its arguments flipped. --- | --- | --- | This can be useful when running an action written using do notation --- | for every element in a data structure: --- | --- | For example: --- | --- | ```purescript --- | for [1, 2, 3] \n -> do --- | print n --- | return (n * n) --- | ``` -for - :: forall a b m t - . Applicative m - => Traversable t - => t a - -> (a -> m b) - -> m (t b) -for x f = traverse f x - --- | Fold a data structure from the left, keeping all intermediate results --- | instead of only the final result. Note that the initial value does not --- | appear in the result (unlike Haskell's `Prelude.scanl`). --- | --- | ```purescript --- | scanl (+) 0 [1,2,3] = [1,3,6] --- | scanl (-) 10 [1,2,3] = [9,7,4] --- | ``` -scanl :: forall a b f. Traversable f => (b -> a -> b) -> b -> f a -> f b -scanl f b0 xs = (mapAccumL (\b a -> let b' = f b a in { accum: b', value: b' }) b0 xs).value - --- | Fold a data structure from the left, keeping all intermediate results --- | instead of only the final result. --- | --- | Unlike `scanl`, `mapAccumL` allows the type of accumulator to differ --- | from the element type of the final data structure. -mapAccumL - :: forall a b s f - . Traversable f - => (s -> a -> Accum s b) - -> s - -> f a - -> Accum s (f b) -mapAccumL f s0 xs = stateL (traverse (\a -> StateL \s -> f s a) xs) s0 - --- | Fold a data structure from the right, keeping all intermediate results --- | instead of only the final result. Note that the initial value does not --- | appear in the result (unlike Haskell's `Prelude.scanr`). --- | --- | ```purescript --- | scanr (+) 0 [1,2,3] = [6,5,3] --- | scanr (flip (-)) 10 [1,2,3] = [4,5,7] --- | ``` -scanr :: forall a b f. Traversable f => (a -> b -> b) -> b -> f a -> f b -scanr f b0 xs = (mapAccumR (\b a -> let b' = f a b in { accum: b', value: b' }) b0 xs).value - --- | Fold a data structure from the right, keeping all intermediate results --- | instead of only the final result. --- | --- | Unlike `scanr`, `mapAccumR` allows the type of accumulator to differ --- | from the element type of the final data structure. -mapAccumR - :: forall a b s f - . Traversable f - => (s -> a -> Accum s b) - -> s - -> f a - -> Accum s (f b) -mapAccumR f s0 xs = stateR (traverse (\a -> StateR \s -> f s a) xs) s0 diff --git a/stdlib/lib/Data/Traversable/Accum.purs b/stdlib/lib/Data/Traversable/Accum.purs deleted file mode 100644 index 774b174b..00000000 --- a/stdlib/lib/Data/Traversable/Accum.purs +++ /dev/null @@ -1,5 +0,0 @@ -module Data.Traversable.Accum - ( Accum - ) where - -type Accum s a = { accum :: s, value :: a } diff --git a/stdlib/lib/Data/Traversable/Accum/Internal.purs b/stdlib/lib/Data/Traversable/Accum/Internal.purs deleted file mode 100644 index 9f9ae33d..00000000 --- a/stdlib/lib/Data/Traversable/Accum/Internal.purs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.Traversable.Accum.Internal - ( StateL(..) - , stateL - , StateR(..) - , stateR - ) where - -import Prelude -import Data.Traversable.Accum (Accum) - -newtype StateL s a = StateL (s -> Accum s a) - -stateL :: forall s a. StateL s a -> s -> Accum s a -stateL (StateL k) = k - -instance functorStateL :: Functor (StateL s) where - map f k = StateL \s -> case stateL k s of - { accum: s1, value: a } -> { accum: s1, value: f a } - -instance applyStateL :: Apply (StateL s) where - apply f x = StateL \s -> case stateL f s of - { accum: s1, value: f' } -> case stateL x s1 of - { accum: s2, value: x' } -> { accum: s2, value: f' x' } - -instance applicativeStateL :: Applicative (StateL s) where - pure a = StateL \s -> { accum: s, value: a } - - -newtype StateR s a = StateR (s -> Accum s a) - -stateR :: forall s a. StateR s a -> s -> Accum s a -stateR (StateR k) = k - -instance functorStateR :: Functor (StateR s) where - map f k = StateR \s -> case stateR k s of - { accum: s1, value: a } -> { accum: s1, value: f a } - -instance applyStateR :: Apply (StateR s) where - apply f x = StateR \s -> case stateR x s of - { accum: s1, value: x' } -> case stateR f s1 of - { accum: s2, value: f' } -> { accum: s2, value: f' x' } - -instance applicativeStateR :: Applicative (StateR s) where - pure a = StateR \s -> { accum: s, value: a } diff --git a/stdlib/lib/Data/TraversableWithIndex.purs b/stdlib/lib/Data/TraversableWithIndex.purs deleted file mode 100644 index f09d5e70..00000000 --- a/stdlib/lib/Data/TraversableWithIndex.purs +++ /dev/null @@ -1,213 +0,0 @@ -module Data.TraversableWithIndex - ( class TraversableWithIndex, traverseWithIndex - , traverseWithIndexDefault - , forWithIndex - , scanlWithIndex - , mapAccumLWithIndex - , scanrWithIndex - , mapAccumRWithIndex - , traverseDefault - , module Data.Traversable.Accum - ) where - -import Prelude - -import Control.Apply (lift2) -import Data.Const (Const(..)) -import Data.Either (Either(..)) -import Data.FoldableWithIndex (class FoldableWithIndex) -import Data.Functor.App (App(..)) -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Coproduct (Coproduct(..), coproduct) -import Data.Functor.Product (Product(..), product) -import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe) -import Data.Maybe.First (First) -import Data.Maybe.Last (Last) -import Data.Monoid.Additive (Additive) -import Data.Monoid.Conj (Conj) -import Data.Monoid.Disj (Disj) -import Data.Monoid.Dual (Dual) -import Data.Monoid.Multiplicative (Multiplicative) -import Data.Traversable (class Traversable, sequence, traverse) -import Data.Traversable.Accum (Accum) -import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) -import Data.Tuple (Tuple(..), curry) - - --- | A `Traversable` with an additional index. --- | A `TraversableWithIndex` instance must be compatible with its --- | `Traversable` instance --- | ```purescript --- | traverse f = traverseWithIndex (const f) --- | ``` --- | with its `FoldableWithIndex` instance --- | ``` --- | foldMapWithIndex f = unwrap <<< traverseWithIndex (\i -> Const <<< f i) --- | ``` --- | and with its `FunctorWithIndex` instance --- | ``` --- | mapWithIndex f = unwrap <<< traverseWithIndex (\i -> Identity <<< f i) --- | ``` --- | --- | A default implementation is provided by `traverseWithIndexDefault`. -class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) <= TraversableWithIndex i t | t -> i where - traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) - --- | A default implementation of `traverseWithIndex` using `sequence` and `mapWithIndex`. -traverseWithIndexDefault - :: forall i t a b m - . TraversableWithIndex i t - => Applicative m - => (i -> a -> m b) - -> t a - -> m (t b) -traverseWithIndexDefault f = sequence <<< mapWithIndex f - -instance traversableWithIndexArray :: TraversableWithIndex Int Array where - traverseWithIndex = traverseWithIndexDefault - -instance traversableWithIndexMaybe :: TraversableWithIndex Unit Maybe where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexFirst :: TraversableWithIndex Unit First where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexLast :: TraversableWithIndex Unit Last where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexAdditive :: TraversableWithIndex Unit Additive where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexDual :: TraversableWithIndex Unit Dual where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexConj :: TraversableWithIndex Unit Conj where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexDisj :: TraversableWithIndex Unit Disj where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexMultiplicative :: TraversableWithIndex Unit Multiplicative where - traverseWithIndex f = traverse $ f unit - -instance traversableWithIndexEither :: TraversableWithIndex Unit (Either a) where - traverseWithIndex _ (Left x) = pure (Left x) - traverseWithIndex f (Right x) = Right <$> f unit x - -instance traversableWithIndexTuple :: TraversableWithIndex Unit (Tuple a) where - traverseWithIndex f (Tuple x y) = Tuple x <$> f unit y - -instance traversableWithIndexIdentity :: TraversableWithIndex Unit Identity where - traverseWithIndex f (Identity x) = Identity <$> f unit x - -instance traversableWithIndexConst :: TraversableWithIndex Void (Const a) where - traverseWithIndex _ (Const x) = pure (Const x) - -instance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where - traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga) - -instance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where - traverseWithIndex f = coproduct - (map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left)) - (map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right)) - -instance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where - traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga - -instance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f) where - traverseWithIndex f (App x) = App <$> traverseWithIndex f x - --- | A version of `traverseWithIndex` with its arguments flipped. --- | --- | --- | This can be useful when running an action written using do notation --- | for every element in a data structure: --- | --- | For example: --- | --- | ```purescript --- | for [1, 2, 3] \i x -> do --- | logShow i --- | pure (x * x) --- | ``` -forWithIndex - :: forall i a b m t - . Applicative m - => TraversableWithIndex i t - => t a - -> (i -> a -> m b) - -> m (t b) -forWithIndex = flip traverseWithIndex - --- | Fold a data structure from the left with access to the indices, keeping --- | all intermediate results instead of only the final result. Note that the --- | initial value does not appear in the result (unlike Haskell's --- | `Prelude.scanl`). --- | --- | ```purescript --- | scanlWithIndex (\i y x -> i + y + x) 0 [1, 2, 3] = [1, 4, 9] --- | ``` -scanlWithIndex - :: forall i a b f - . TraversableWithIndex i f - => (i -> b -> a -> b) - -> b - -> f a - -> f b -scanlWithIndex f b0 xs = - (mapAccumLWithIndex (\i b a -> let b' = f i b a in { accum: b', value: b' }) b0 xs).value - --- | Fold a data structure from the left with access to the indices, keeping --- | all intermediate results instead of only the final result. --- | --- | Unlike `scanlWithIndex`, `mapAccumLWithIndex` allows the type of accumulator to differ --- | from the element type of the final data structure. -mapAccumLWithIndex - :: forall i a b s f - . TraversableWithIndex i f - => (i -> s -> a -> Accum s b) - -> s - -> f a - -> Accum s (f b) -mapAccumLWithIndex f s0 xs = stateL (traverseWithIndex (\i a -> StateL \s -> f i s a) xs) s0 - --- | Fold a data structure from the right with access to the indices, keeping --- | all intermediate results instead of only the final result. Note that the --- | initial value does not appear in the result (unlike Haskell's `Prelude.scanr`). --- | --- | ```purescript --- | scanrWithIndex (\i x y -> i + x + y) 0 [1, 2, 3] = [9, 8, 5] --- | ``` -scanrWithIndex - :: forall i a b f - . TraversableWithIndex i f - => (i -> a -> b -> b) - -> b - -> f a - -> f b -scanrWithIndex f b0 xs = - (mapAccumRWithIndex (\i b a -> let b' = f i a b in { accum: b', value: b' }) b0 xs).value - --- | Fold a data structure from the right with access to the indices, keeping --- | all intermediate results instead of only the final result. --- | --- | Unlike `scanrWithIndex`, `imapAccumRWithIndex` allows the type of accumulator to differ --- | from the element type of the final data structure. -mapAccumRWithIndex - :: forall i a b s f - . TraversableWithIndex i f - => (i -> s -> a -> Accum s b) - -> s - -> f a - -> Accum s (f b) -mapAccumRWithIndex f s0 xs = stateR (traverseWithIndex (\i a -> StateR \s -> f i s a) xs) s0 - --- | A default implementation of `traverse` in terms of `traverseWithIndex` -traverseDefault - :: forall i t a b m - . TraversableWithIndex i t - => Applicative m - => (a -> m b) -> t a -> m (t b) -traverseDefault f = traverseWithIndex (const f) diff --git a/stdlib/lib/Data/Tuple.purs b/stdlib/lib/Data/Tuple.purs deleted file mode 100644 index ffbacc97..00000000 --- a/stdlib/lib/Data/Tuple.purs +++ /dev/null @@ -1,135 +0,0 @@ --- | A data type and functions for working with ordered pairs. -module Data.Tuple where - -import Prelude - -import Control.Comonad (class Comonad) -import Control.Extend (class Extend) -import Control.Lazy (class Lazy, defer) -import Data.Eq (class Eq1) -import Data.Functor.Invariant (class Invariant, imapF) -import Data.Generic.Rep (class Generic) -import Data.HeytingAlgebra (implies, ff, tt) -import Data.Ord (class Ord1) - --- | A simple product type for wrapping a pair of component values. -data Tuple a b = Tuple a b - --- | Allows `Tuple`s to be rendered as a string with `show` whenever there are --- | `Show` instances for both component types. -instance showTuple :: (Show a, Show b) => Show (Tuple a b) where - show (Tuple a b) = "(Tuple " <> show a <> " " <> show b <> ")" - --- | Allows `Tuple`s to be checked for equality with `==` and `/=` whenever --- | there are `Eq` instances for both component types. -derive instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b) - -derive instance eq1Tuple :: Eq a => Eq1 (Tuple a) - --- | Allows `Tuple`s to be compared with `compare`, `>`, `>=`, `<` and `<=` --- | whenever there are `Ord` instances for both component types. To obtain --- | the result, the `fst`s are `compare`d, and if they are `EQ`ual, the --- | `snd`s are `compare`d. -derive instance ordTuple :: (Ord a, Ord b) => Ord (Tuple a b) - -derive instance ord1Tuple :: Ord a => Ord1 (Tuple a) - -instance boundedTuple :: (Bounded a, Bounded b) => Bounded (Tuple a b) where - top = Tuple top top - bottom = Tuple bottom bottom - -instance semigroupoidTuple :: Semigroupoid Tuple where - compose (Tuple _ c) (Tuple a _) = Tuple a c - --- | The `Semigroup` instance enables use of the associative operator `<>` on --- | `Tuple`s whenever there are `Semigroup` instances for the component --- | types. The `<>` operator is applied pairwise, so: --- | ```purescript --- | (Tuple a1 b1) <> (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2) --- | ``` -instance semigroupTuple :: (Semigroup a, Semigroup b) => Semigroup (Tuple a b) where - append (Tuple a1 b1) (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2) - -instance monoidTuple :: (Monoid a, Monoid b) => Monoid (Tuple a b) where - mempty = Tuple mempty mempty - -instance semiringTuple :: (Semiring a, Semiring b) => Semiring (Tuple a b) where - add (Tuple x1 y1) (Tuple x2 y2) = Tuple (add x1 x2) (add y1 y2) - one = Tuple one one - mul (Tuple x1 y1) (Tuple x2 y2) = Tuple (mul x1 x2) (mul y1 y2) - zero = Tuple zero zero - -instance ringTuple :: (Ring a, Ring b) => Ring (Tuple a b) where - sub (Tuple x1 y1) (Tuple x2 y2) = Tuple (sub x1 x2) (sub y1 y2) - -instance commutativeRingTuple :: (CommutativeRing a, CommutativeRing b) => CommutativeRing (Tuple a b) - -instance heytingAlgebraTuple :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAlgebra (Tuple a b) where - tt = Tuple tt tt - ff = Tuple ff ff - implies (Tuple x1 y1) (Tuple x2 y2) = Tuple (x1 `implies` x2) (y1 `implies` y2) - conj (Tuple x1 y1) (Tuple x2 y2) = Tuple (conj x1 x2) (conj y1 y2) - disj (Tuple x1 y1) (Tuple x2 y2) = Tuple (disj x1 x2) (disj y1 y2) - not (Tuple x y) = Tuple (not x) (not y) - -instance booleanAlgebraTuple :: (BooleanAlgebra a, BooleanAlgebra b) => BooleanAlgebra (Tuple a b) - --- | The `Functor` instance allows functions to transform the contents of a --- | `Tuple` with the `<$>` operator, applying the function to the second --- | component, so: --- | ```purescript --- | f <$> (Tuple x y) = Tuple x (f y) --- | ```` -derive instance functorTuple :: Functor (Tuple a) - -derive instance genericTuple :: Generic (Tuple a b) _ - -instance invariantTuple :: Invariant (Tuple a) where - imap = imapF - --- | The `Apply` instance allows functions to transform the contents of a --- | `Tuple` with the `<*>` operator whenever there is a `Semigroup` instance --- | for the `fst` component, so: --- | ```purescript --- | (Tuple a1 f) <*> (Tuple a2 x) == Tuple (a1 <> a2) (f x) --- | ``` -instance applyTuple :: (Semigroup a) => Apply (Tuple a) where - apply (Tuple a1 f) (Tuple a2 x) = Tuple (a1 <> a2) (f x) - -instance applicativeTuple :: (Monoid a) => Applicative (Tuple a) where - pure = Tuple mempty - -instance bindTuple :: (Semigroup a) => Bind (Tuple a) where - bind (Tuple a1 b) f = case f b of - Tuple a2 c -> Tuple (a1 <> a2) c - -instance monadTuple :: (Monoid a) => Monad (Tuple a) - -instance extendTuple :: Extend (Tuple a) where - extend f t@(Tuple a _) = Tuple a (f t) - -instance comonadTuple :: Comonad (Tuple a) where - extract = snd - -instance lazyTuple :: (Lazy a, Lazy b) => Lazy (Tuple a b) where - defer f = Tuple (defer $ \_ -> fst (f unit)) (defer $ \_ -> snd (f unit)) - --- | Returns the first component of a tuple. -fst :: forall a b. Tuple a b -> a -fst (Tuple a _) = a - --- | Returns the second component of a tuple. -snd :: forall a b. Tuple a b -> b -snd (Tuple _ b) = b - --- | Turn a function that expects a tuple into a function of two arguments. -curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c -curry f a b = f (Tuple a b) - --- | Turn a function of two arguments into a function that expects a tuple. -uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c -uncurry f (Tuple a b) = f a b - --- | Exchange the first and second components of a tuple. -swap :: forall a b. Tuple a b -> Tuple b a -swap (Tuple a b) = Tuple b a diff --git a/stdlib/lib/Data/Tuple/Nested.purs b/stdlib/lib/Data/Tuple/Nested.purs deleted file mode 100644 index 156547ad..00000000 --- a/stdlib/lib/Data/Tuple/Nested.purs +++ /dev/null @@ -1,294 +0,0 @@ --- | Tuples that are not restricted to two elements. --- | --- | Here is an example of a 3-tuple: --- | --- | --- | ```purescript --- | > tuple = tuple3 1 "2" 3.0 --- | > tuple --- | (Tuple 1 (Tuple "2" (Tuple 3.0 unit))) --- | ``` --- | --- | Notice that a tuple is a nested structure not unlike a list. The type of `tuple` is this: --- | --- | ```purescript --- | > :t tuple --- | Tuple Int (Tuple String (Tuple Number Unit)) --- | ``` --- | --- | That, however, can be abbreviated with the `Tuple3` type: --- | --- | ```purescript --- | Tuple3 Int String Number --- | ``` --- | --- | All tuple functions are numbered from 1 to 10. That is, there's --- | a `get1` and a `get10`. --- | --- | The `getN` functions accept tuples of length N or greater: --- | --- | ```purescript --- | get1 tuple = 1 --- | get3 tuple = 3 --- | get4 tuple -- type error. `get4` requires a longer tuple. --- | ``` --- | --- | The same is true of the `overN` functions: --- | --- | ```purescript --- | over2 negate (tuple3 1 2 3) = tuple3 1 (-2) 3 --- | ``` --- | - --- | `uncurryN` can be used to convert a function that takes `N` arguments to one that takes an N-tuple: --- | --- | ```purescript --- | uncurry2 (+) (tuple2 1 2) = 3 --- | ``` --- | --- | The reverse `curryN` function converts functions that take --- | N-tuples (which are rare) to functions that take `N` arguments. --- | --- | --------------- --- | In addition to types like `Tuple3`, there are also types like --- | `T3`. Whereas `Tuple3` describes a tuple with exactly three --- | elements, `T3` describes a tuple of length *two or longer*. More --- | specifically, `T3` requires two element plus a "tail" that may be --- | `unit` or more tuple elements. Use types like `T3` when you want to --- | create a set of functions for arbitrary tuples. See the source for how that's done. --- | -module Data.Tuple.Nested where - -import Prelude -import Data.Tuple (Tuple(..)) - --- | Shorthand for constructing n-tuples as nested pairs. --- | `a /\ b /\ c /\ d /\ unit` becomes `Tuple a (Tuple b (Tuple c (Tuple d unit)))` -infixr 6 Tuple as /\ - --- | Shorthand for constructing n-tuple types as nested pairs. --- | `forall a b c d. a /\ b /\ c /\ d /\ Unit` becomes --- | `forall a b c d. Tuple a (Tuple b (Tuple c (Tuple d Unit)))` -infixr 6 type Tuple as /\ - -type Tuple1 a = T2 a Unit -type Tuple2 a b = T3 a b Unit -type Tuple3 a b c = T4 a b c Unit -type Tuple4 a b c d = T5 a b c d Unit -type Tuple5 a b c d e= T6 a b c d e Unit -type Tuple6 a b c d e f = T7 a b c d e f Unit -type Tuple7 a b c d e f g = T8 a b c d e f g Unit -type Tuple8 a b c d e f g h = T9 a b c d e f g h Unit -type Tuple9 a b c d e f g h i = T10 a b c d e f g h i Unit -type Tuple10 a b c d e f g h i j = T11 a b c d e f g h i j Unit - -type T2 a z = Tuple a z -type T3 a b z = Tuple a (T2 b z) -type T4 a b c z = Tuple a (T3 b c z) -type T5 a b c d z = Tuple a (T4 b c d z) -type T6 a b c d e z = Tuple a (T5 b c d e z) -type T7 a b c d e f z = Tuple a (T6 b c d e f z) -type T8 a b c d e f g z = Tuple a (T7 b c d e f g z) -type T9 a b c d e f g h z = Tuple a (T8 b c d e f g h z) -type T10 a b c d e f g h i z = Tuple a (T9 b c d e f g h i z) -type T11 a b c d e f g h i j z = Tuple a (T10 b c d e f g h i j z) - --- | Creates a singleton tuple. -tuple1 :: forall a. a -> Tuple1 a -tuple1 a = a /\ unit - --- | Given 2 values, creates a 2-tuple. -tuple2 :: forall a b. a -> b -> Tuple2 a b -tuple2 a b = a /\ b /\ unit - --- | Given 3 values, creates a nested 3-tuple. -tuple3 :: forall a b c. a -> b -> c -> Tuple3 a b c -tuple3 a b c = a /\ b /\ c /\ unit - --- | Given 4 values, creates a nested 4-tuple. -tuple4 :: forall a b c d. a -> b -> c -> d -> Tuple4 a b c d -tuple4 a b c d = a /\ b /\ c /\ d /\ unit - --- | Given 5 values, creates a nested 5-tuple. -tuple5 :: forall a b c d e. a -> b -> c -> d -> e -> Tuple5 a b c d e -tuple5 a b c d e = a /\ b /\ c /\ d /\ e /\ unit - --- | Given 6 values, creates a nested 6-tuple. -tuple6 :: forall a b c d e f. a -> b -> c -> d -> e -> f -> Tuple6 a b c d e f -tuple6 a b c d e f = a /\ b /\ c /\ d /\ e /\ f /\ unit - --- | Given 7 values, creates a nested 7-tuple. -tuple7 :: forall a b c d e f g. a -> b -> c -> d -> e -> f -> g -> Tuple7 a b c d e f g -tuple7 a b c d e f g = a /\ b /\ c /\ d /\ e /\ f /\ g /\ unit - --- | Given 8 values, creates a nested 8-tuple. -tuple8 :: forall a b c d e f g h. a -> b -> c -> d -> e -> f -> g -> h -> Tuple8 a b c d e f g h -tuple8 a b c d e f g h = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ unit - --- | Given 9 values, creates a nested 9-tuple. -tuple9 :: forall a b c d e f g h i. a -> b -> c -> d -> e -> f -> g -> h -> i -> Tuple9 a b c d e f g h i -tuple9 a b c d e f g h i = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ unit - --- | Given 10 values, creates a nested 10-tuple. -tuple10 :: forall a b c d e f g h i j. a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Tuple10 a b c d e f g h i j -tuple10 a b c d e f g h i j = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ unit - --- | Given at least a singleton tuple, gets the first value. -get1 :: forall a z. T2 a z -> a -get1 (a /\ _) = a - --- | Given at least a 2-tuple, gets the second value. -get2 :: forall a b z. T3 a b z -> b -get2 (_ /\ b /\ _) = b - --- | Given at least a 3-tuple, gets the third value. -get3 :: forall a b c z. T4 a b c z -> c -get3 (_ /\ _ /\ c /\ _) = c - --- | Given at least a 4-tuple, gets the fourth value. -get4 :: forall a b c d z. T5 a b c d z -> d -get4 (_ /\ _ /\ _ /\ d /\ _) = d - --- | Given at least a 5-tuple, gets the fifth value. -get5 :: forall a b c d e z. T6 a b c d e z -> e -get5 (_ /\ _ /\ _ /\ _ /\ e /\ _) = e - --- | Given at least a 6-tuple, gets the sixth value. -get6 :: forall a b c d e f z. T7 a b c d e f z -> f -get6 (_ /\ _ /\ _ /\ _ /\ _ /\ f /\ _) = f - --- | Given at least a 7-tuple, gets the seventh value. -get7 :: forall a b c d e f g z. T8 a b c d e f g z -> g -get7 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ g /\ _) = g - --- | Given at least an 8-tuple, gets the eigth value. -get8 :: forall a b c d e f g h z. T9 a b c d e f g h z -> h -get8 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ h /\ _) = h - --- | Given at least a 9-tuple, gets the ninth value. -get9 :: forall a b c d e f g h i z. T10 a b c d e f g h i z -> i -get9 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ i /\ _) = i - --- | Given at least a 10-tuple, gets the tenth value. -get10 :: forall a b c d e f g h i j z. T11 a b c d e f g h i j z -> j -get10 (_ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ j /\ _) = j - --- | Given at least a singleton tuple, modifies the first value. -over1 :: forall a r z. (a -> r) -> T2 a z -> T2 r z -over1 o (a /\ z) = o a /\ z - --- | Given at least a 2-tuple, modifies the second value. -over2 :: forall a b r z. (b -> r) -> T3 a b z -> T3 a r z -over2 o (a /\ b /\ z) = a /\ o b /\ z - --- | Given at least a 3-tuple, modifies the third value. -over3 :: forall a b c r z. (c -> r) -> T4 a b c z -> T4 a b r z -over3 o (a /\ b /\ c /\ z) = a /\ b /\ o c /\ z - --- | Given at least a 4-tuple, modifies the fourth value. -over4 :: forall a b c d r z. (d -> r) -> T5 a b c d z -> T5 a b c r z -over4 o (a /\ b /\ c /\ d /\ z) = a /\ b /\ c /\ o d /\ z - --- | Given at least a 5-tuple, modifies the fifth value. -over5 :: forall a b c d e r z. (e -> r) -> T6 a b c d e z -> T6 a b c d r z -over5 o (a /\ b /\ c /\ d /\ e /\ z) = a /\ b /\ c /\ d /\ o e /\ z - --- | Given at least a 6-tuple, modifies the sixth value. -over6 :: forall a b c d e f r z. (f -> r) -> T7 a b c d e f z -> T7 a b c d e r z -over6 o (a /\ b /\ c /\ d /\ e /\ f /\ z) = a /\ b /\ c /\ d /\ e /\ o f /\ z - --- | Given at least a 7-tuple, modifies the seventh value. -over7 :: forall a b c d e f g r z. (g -> r) -> T8 a b c d e f g z -> T8 a b c d e f r z -over7 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ o g /\ z - --- | Given at least an 8-tuple, modifies the eighth value. -over8 :: forall a b c d e f g h r z. (h -> r) -> T9 a b c d e f g h z -> T9 a b c d e f g r z -over8 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ g /\ o h /\ z - --- | Given at least a 9-tuple, modifies the ninth value. -over9 :: forall a b c d e f g h i r z. (i -> r) -> T10 a b c d e f g h i z -> T10 a b c d e f g h r z -over9 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ o i /\ z - --- | Given at least a 10-tuple, modifies the tenth value. -over10 :: forall a b c d e f g h i j r z. (j -> r) -> T11 a b c d e f g h i j z -> T11 a b c d e f g h i r z -over10 o (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ z) = a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ o j /\ z - --- | Given a function of 1 argument, returns a function that accepts a singleton tuple. -uncurry1 :: forall a r z. (a -> r) -> T2 a z -> r -uncurry1 f (a /\ _) = f a - --- | Given a function of 2 arguments, returns a function that accepts a 2-tuple. -uncurry2 :: forall a b r z. (a -> b -> r) -> T3 a b z -> r -uncurry2 f (a /\ b /\ _) = f a b - --- | Given a function of 3 arguments, returns a function that accepts a 3-tuple. -uncurry3 :: forall a b c r z. (a -> b -> c -> r) -> T4 a b c z -> r -uncurry3 f (a /\ b /\ c /\ _) = f a b c - --- | Given a function of 4 arguments, returns a function that accepts a 4-tuple. -uncurry4 :: forall a b c d r z. (a -> b -> c -> d -> r) -> T5 a b c d z -> r -uncurry4 f (a /\ b /\ c /\ d /\ _) = f a b c d - --- | Given a function of 5 arguments, returns a function that accepts a 5-tuple. -uncurry5 :: forall a b c d e r z. (a -> b -> c -> d -> e -> r) -> T6 a b c d e z -> r -uncurry5 f (a /\ b /\ c /\ d /\ e /\ _) = f a b c d e - --- | Given a function of 6 arguments, returns a function that accepts a 6-tuple. -uncurry6 :: forall a b c d e f r z. (a -> b -> c -> d -> e -> f -> r) -> T7 a b c d e f z -> r -uncurry6 f' (a /\ b /\ c /\ d /\ e /\ f /\ _) = f' a b c d e f - --- | Given a function of 7 arguments, returns a function that accepts a 7-tuple. -uncurry7 :: forall a b c d e f g r z. (a -> b -> c -> d -> e -> f -> g -> r) -> T8 a b c d e f g z -> r -uncurry7 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ _) = f' a b c d e f g - --- | Given a function of 8 arguments, returns a function that accepts an 8-tuple. -uncurry8 :: forall a b c d e f g h r z. (a -> b -> c -> d -> e -> f -> g -> h -> r) -> T9 a b c d e f g h z -> r -uncurry8 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ _) = f' a b c d e f g h - --- | Given a function of 9 arguments, returns a function that accepts a 9-tuple. -uncurry9 :: forall a b c d e f g h i r z. (a -> b -> c -> d -> e -> f -> g -> h -> i -> r) -> T10 a b c d e f g h i z -> r -uncurry9 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ _) = f' a b c d e f g h i - --- | Given a function of 10 arguments, returns a function that accepts a 10-tuple. -uncurry10 :: forall a b c d e f g h i j r z. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> r) -> T11 a b c d e f g h i j z -> r -uncurry10 f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ _) = f' a b c d e f g h i j - --- | Given a function that accepts at least a singleton tuple, returns a function of 1 argument. -curry1 :: forall a r z. z -> (T2 a z -> r) -> a -> r -curry1 z f a = f (a /\ z) - --- | Given a function that accepts at least a 2-tuple, returns a function of 2 arguments. -curry2 :: forall a b r z. z -> (T3 a b z -> r) -> a -> b -> r -curry2 z f a b = f (a /\ b /\ z) - --- | Given a function that accepts at least a 3-tuple, returns a function of 3 arguments. -curry3 :: forall a b c r z. z -> (T4 a b c z -> r) -> a -> b -> c -> r -curry3 z f a b c = f (a /\ b /\ c /\ z) - --- | Given a function that accepts at least a 4-tuple, returns a function of 4 arguments. -curry4 :: forall a b c d r z. z -> (T5 a b c d z -> r) -> a -> b -> c -> d -> r -curry4 z f a b c d = f (a /\ b /\ c /\ d /\ z) - --- | Given a function that accepts at least a 5-tuple, returns a function of 5 arguments. -curry5 :: forall a b c d e r z. z -> (T6 a b c d e z -> r) -> a -> b -> c -> d -> e -> r -curry5 z f a b c d e = f (a /\ b /\ c /\ d /\ e /\ z) - --- | Given a function that accepts at least a 6-tuple, returns a function of 6 arguments. -curry6 :: forall a b c d e f r z. z -> (T7 a b c d e f z -> r) -> a -> b -> c -> d -> e -> f -> r -curry6 z f' a b c d e f = f' (a /\ b /\ c /\ d /\ e /\ f /\ z) - --- | Given a function that accepts at least a 7-tuple, returns a function of 7 arguments. -curry7 :: forall a b c d e f g r z. z -> (T8 a b c d e f g z -> r) -> a -> b -> c -> d -> e -> f -> g -> r -curry7 z f' a b c d e f g = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ z) - --- | Given a function that accepts at least an 8-tuple, returns a function of 8 arguments. -curry8 :: forall a b c d e f g h r z. z -> (T9 a b c d e f g h z -> r) -> a -> b -> c -> d -> e -> f -> g -> h -> r -curry8 z f' a b c d e f g h = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ z) - --- | Given a function that accepts at least a 9-tuple, returns a function of 9 arguments. -curry9 :: forall a b c d e f g h i r z. z -> (T10 a b c d e f g h i z -> r) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> r -curry9 z f' a b c d e f g h i = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ z) - --- | Given a function that accepts at least a 10-tuple, returns a function of 10 arguments. -curry10 :: forall a b c d e f g h i j r z. z -> (T11 a b c d e f g h i j z -> r) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> r -curry10 z f' a b c d e f g h i j = f' (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ z) diff --git a/stdlib/lib/Data/Unfoldable.purs b/stdlib/lib/Data/Unfoldable.purs deleted file mode 100644 index fd115c1a..00000000 --- a/stdlib/lib/Data/Unfoldable.purs +++ /dev/null @@ -1,103 +0,0 @@ --- | This module provides a type class for _unfoldable functors_, i.e. --- | functors which support an `unfoldr` operation. --- | --- | This allows us to unify various operations on arrays, lists, --- | sequences, etc. - -module Data.Unfoldable - ( class Unfoldable, unfoldr - , replicate - , replicateA - , none - , fromMaybe - , module Data.Unfoldable1 - ) where - -import Prelude - -import Data.Maybe (Maybe(..), isNothing, fromJust) -import Data.Traversable (class Traversable, sequence) -import Data.Tuple (Tuple(..), fst, snd) -import Data.Unfoldable1 (class Unfoldable1, unfoldr1, singleton, range, iterateN, replicate1, replicate1A) -import Partial.Unsafe (unsafePartial) - --- | This class identifies (possibly empty) data structures which can be --- | _unfolded_. --- | --- | The generating function `f` in `unfoldr f` is understood as follows: --- | --- | - If `f b` is `Nothing`, then `unfoldr f b` should be empty. --- | - If `f b` is `Just (Tuple a b1)`, then `unfoldr f b` should consist of `a` --- | appended to the result of `unfoldr f b1`. --- | --- | Note that it is not possible to give `Unfoldable` instances to types which --- | represent structures which are guaranteed to be non-empty, such as --- | `NonEmptyArray`: consider what `unfoldr (const Nothing)` should produce. --- | Structures which are guaranteed to be non-empty can instead be given --- | `Unfoldable1` instances. -class Unfoldable1 t <= Unfoldable t where - unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> t a - -instance unfoldableArray :: Unfoldable Array where - unfoldr = unfoldrArrayImpl isNothing (unsafePartial fromJust) fst snd - -instance unfoldableMaybe :: Unfoldable Maybe where - unfoldr f b = fst <$> f b - -foreign import unfoldrArrayImpl - :: forall a b - . (forall x. Maybe x -> Boolean) - -> (forall x. Maybe x -> x) - -> (forall x y. Tuple x y -> x) - -> (forall x y. Tuple x y -> y) - -> (b -> Maybe (Tuple a b)) - -> b - -> Array a - --- | Replicate a value some natural number of times. --- | For example: --- | --- | ``` purescript --- | replicate 2 "foo" == (["foo", "foo"] :: Array String) --- | ``` -replicate :: forall f a. Unfoldable f => Int -> a -> f a -replicate n v = unfoldr step n - where - step :: Int -> Maybe (Tuple a Int) - step i = - if i <= 0 then Nothing - else Just (Tuple v (i - 1)) - --- | Perform an Applicative action `n` times, and accumulate all the results. --- | --- | ``` purescript --- | > replicateA 5 (randomInt 1 10) :: Effect (Array Int) --- | [1,3,2,7,5] --- | ``` -replicateA - :: forall m f a - . Applicative m - => Unfoldable f - => Traversable f - => Int - -> m a - -> m (f a) -replicateA n m = sequence (replicate n m) - --- | The container with no elements - unfolded with zero iterations. --- | For example: --- | --- | ``` purescript --- | none == ([] :: Array Unit) --- | ``` -none :: forall f a. Unfoldable f => f a -none = unfoldr (const Nothing) unit - --- | Convert a Maybe to any Unfoldable, such as lists or arrays. --- | --- | ``` purescript --- | fromMaybe (Nothing :: Maybe Int) == [] --- | fromMaybe (Just 1) == [1] --- | ``` -fromMaybe :: forall f a. Unfoldable f => Maybe a -> f a -fromMaybe = unfoldr (\b -> flip Tuple Nothing <$> b) diff --git a/stdlib/lib/Data/Unfoldable1.purs b/stdlib/lib/Data/Unfoldable1.purs deleted file mode 100644 index 2eb285b3..00000000 --- a/stdlib/lib/Data/Unfoldable1.purs +++ /dev/null @@ -1,131 +0,0 @@ -module Data.Unfoldable1 - ( class Unfoldable1, unfoldr1 - , replicate1 - , replicate1A - , singleton - , range - , iterateN - ) where - -import Prelude - -import Data.Maybe (Maybe(..), fromJust, isNothing) -import Data.Semigroup.Traversable (class Traversable1, sequence1) -import Data.Tuple (Tuple(..), fst, snd) -import Partial.Unsafe (unsafePartial) - --- | This class identifies data structures which can be _unfolded_. --- | --- | The generating function `f` in `unfoldr1 f` corresponds to the `uncons` --- | operation of a non-empty list or array; it always returns a value, and --- | then optionally a value to continue unfolding from. --- | --- | Note that, in order to provide an `Unfoldable1 t` instance, `t` need not --- | be a type which is guaranteed to be non-empty. For example, the fact that --- | lists can be empty does not prevent us from providing an --- | `Unfoldable1 List` instance. However, the result of `unfoldr1` should --- | always be non-empty. --- | --- | Every type which has an `Unfoldable` instance can be given an --- | `Unfoldable1` instance (and, in fact, is required to, because --- | `Unfoldable1` is a superclass of `Unfoldable`). However, there are types --- | which have `Unfoldable1` instances but cannot have `Unfoldable` instances. --- | In particular, types which are guaranteed to be non-empty, such as --- | `NonEmptyList`, cannot be given `Unfoldable` instances. --- | --- | The utility of this class, then, is that it provides an `Unfoldable`-like --- | interface while still permitting instances for guaranteed-non-empty types --- | like `NonEmptyList`. -class Unfoldable1 t where - unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a - -instance unfoldable1Array :: Unfoldable1 Array where - unfoldr1 = unfoldr1ArrayImpl isNothing (unsafePartial fromJust) fst snd - -instance unfoldable1Maybe :: Unfoldable1 Maybe where - unfoldr1 f b = Just (fst (f b)) - -foreign import unfoldr1ArrayImpl - :: forall a b - . (forall x. Maybe x -> Boolean) - -> (forall x. Maybe x -> x) - -> (forall x y. Tuple x y -> x) - -> (forall x y. Tuple x y -> y) - -> (b -> Tuple a (Maybe b)) - -> b - -> Array a - --- | Replicate a value `n` times. At least one value will be produced, so values --- | `n` less than 1 will be treated as 1. --- | --- | ``` purescript --- | replicate1 2 "foo" == (NEL.cons "foo" (NEL.singleton "foo") :: NEL.NonEmptyList String) --- | replicate1 0 "foo" == (NEL.singleton "foo" :: NEL.NonEmptyList String) --- | ``` -replicate1 :: forall f a. Unfoldable1 f => Int -> a -> f a -replicate1 n v = unfoldr1 step (n - 1) - where - step :: Int -> Tuple a (Maybe Int) - step i - | i <= 0 = Tuple v Nothing - | otherwise = Tuple v (Just (i - 1)) - --- | Perform an `Apply` action `n` times (at least once, so values `n` less --- | than 1 will be treated as 1), and accumulate the results. --- | --- | ``` purescript --- | > replicate1A 2 (randomInt 1 10) :: Effect (NEL.NonEmptyList Int) --- | (NonEmptyList (NonEmpty 8 (2 : Nil))) --- | > replicate1A 0 (randomInt 1 10) :: Effect (NEL.NonEmptyList Int) --- | (NonEmptyList (NonEmpty 4 Nil)) --- | ``` -replicate1A - :: forall m f a - . Apply m - => Unfoldable1 f - => Traversable1 f - => Int - -> m a - -> m (f a) -replicate1A n m = sequence1 (replicate1 n m) - --- | Contain a single value. For example: --- | --- | ``` purescript --- | singleton "foo" == (NEL.singleton "foo" :: NEL.NonEmptyList String) --- | ``` -singleton :: forall f a. Unfoldable1 f => a -> f a -singleton = replicate1 1 - --- | Create an `Unfoldable1` containing a range of values, including both --- | endpoints. --- | --- | ``` purescript --- | range 0 0 == (NEL.singleton 0 :: NEL.NonEmptyList Int) --- | range 1 2 == (NEL.cons 1 (NEL.singleton 2) :: NEL.NonEmptyList Int) --- | range 2 0 == (NEL.cons 2 (NEL.cons 1 (NEL.singleton 0)) :: NEL.NonEmptyList Int) --- | ``` -range :: forall f. Unfoldable1 f => Int -> Int -> f Int -range start end = - let delta = if end >= start then 1 else -1 in unfoldr1 (go delta) start - where - go delta i = - let i' = i + delta - in Tuple i (if i == end then Nothing else Just i') - --- | Create an `Unfoldable1` by repeated application of a function to a seed value. --- | For example: --- | --- | ``` purescript --- | (iterateN 5 (_ + 1) 0 :: Array Int) == [0, 1, 2, 3, 4] --- | (iterateN 5 (_ + 1) 0 :: NonEmptyArray Int) == NonEmptyArray [0, 1, 2, 3, 4] --- | --- | (iterateN 0 (_ + 1) 0 :: Array Int) == [0] --- | (iterateN 0 (_ + 1) 0 :: NonEmptyArray Int) == NonEmptyArray [0] --- | ``` -iterateN :: forall f a. Unfoldable1 f => Int -> (a -> a) -> a -> f a -iterateN n f s = unfoldr1 go $ Tuple s (n - 1) - where - go (Tuple x n') = Tuple x - if n' > 0 then Just $ Tuple (f x) $ n' - 1 - else Nothing diff --git a/stdlib/lib/Data/Unit.purs b/stdlib/lib/Data/Unit.purs deleted file mode 100644 index 2e5e2721..00000000 --- a/stdlib/lib/Data/Unit.purs +++ /dev/null @@ -1,5 +0,0 @@ --- | `Unit` is a compiler builtin, the same type as an unqualified --- | `Unit`. This module re-exports that builtin and the `unit` --- | primitive so `import Data.Unit` matches the official library --- | without declaring a second unit type. -module Data.Unit (Unit, unit) where diff --git a/stdlib/lib/Data/Void.purs b/stdlib/lib/Data/Void.purs deleted file mode 100644 index dd6f3088..00000000 --- a/stdlib/lib/Data/Void.purs +++ /dev/null @@ -1,34 +0,0 @@ -module Data.Void (Void, absurd) where - --- | An uninhabited data type. In other words, one can never create --- | a runtime value of type `Void` because no such value exists. --- | --- | `Void` is useful to eliminate the possibility of a value being created. --- | For example, a value of type `Either Void Boolean` can never have --- | a Left value created in PureScript. --- | --- | This should not be confused with the keyword `void` that commonly appears in --- | C-family languages, such as Java: --- | ``` --- | public class Foo { --- | void doSomething() { System.out.println("hello world!"); } --- | } --- | ``` --- | --- | In PureScript, one often uses `Unit` to achieve similar effects as --- | the `void` of C-family languages above. -newtype Void = Void Void - --- | Eliminator for the `Void` type. --- | Useful for stating that some code branch is impossible because you've --- | "acquired" a value of type `Void` (which you can't). --- | --- | ```purescript --- | rightOnly :: forall t . Either Void t -> t --- | rightOnly (Left v) = absurd v --- | rightOnly (Right t) = t --- | ``` -absurd :: forall a. Void -> a -absurd a = spin a - where - spin (Void b) = spin b diff --git a/stdlib/lib/Data/Witherable.purs b/stdlib/lib/Data/Witherable.purs deleted file mode 100644 index 1dfa232f..00000000 --- a/stdlib/lib/Data/Witherable.purs +++ /dev/null @@ -1,162 +0,0 @@ -module Data.Witherable - ( class Witherable - , wilt - , wither - , partitionMapByWilt - , filterMapByWither - , traverseByWither - , wilted - , withered - , witherDefault - , wiltDefault - , module Data.Filterable - ) where - -import Control.Applicative (class Applicative, (<*>), pure) -import Control.Category ((<<<), identity) -import Data.Compactable (compact, separate) -import Data.Either (Either(..)) -import Data.Filterable (class Filterable) -import Data.Functor (map, (<$>)) -import Data.Identity (Identity(..)) -import Data.List (List(..), (:)) -import Data.List as List -import Data.Map as Map -import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid, mempty) -import Data.Newtype (unwrap) -import Data.Traversable (class Traversable, traverse) -import Data.Tuple (Tuple(..)) -import Prelude (class Ord) - --- | `Witherable` represents data structures which can be _partitioned_ with --- | effects in some `Applicative` functor. --- | --- | - `wilt` - partition a structure with effects --- | - `wither` - filter a structure with effects --- | --- | Laws: --- | --- | - Naturality: `t <<< wither f ≡ wither (t <<< f)` --- | - Identity: `wither (pure <<< Just) ≡ pure` --- | - Composition: `Compose <<< map (wither f) <<< wither g ≡ wither (Compose <<< map (wither f) <<< g)` --- | - Multipass partition: `wilt p ≡ map separate <<< traverse p` --- | - Multipass filter: `wither p ≡ map compact <<< traverse p` --- | --- | Superclass equivalences: --- | --- | - `partitionMap p = runIdentity <<< wilt (Identity <<< p)` --- | - `filterMap p = runIdentity <<< wither (Identity <<< p)` --- | - `traverse f ≡ wither (map Just <<< f)` --- | --- | Default implementations are provided by the following functions: --- | --- | - `wiltDefault` --- | - `witherDefault` --- | - `partitionMapByWilt` --- | - `filterMapByWither` --- | - `traverseByWither` -class (Filterable t, Traversable t) <= Witherable t where - wilt :: forall m a l r. Applicative m => - (a -> m (Either l r)) -> t a -> m { left :: t l, right :: t r } - - wither :: forall m a b. Applicative m => - (a -> m (Maybe b)) -> t a -> m (t b) - --- | A default implementation of `wilt` using `separate` -wiltDefault :: forall t m a l r. Witherable t => Applicative m => - (a -> m (Either l r)) -> t a -> m { left :: t l, right :: t r } -wiltDefault p = map separate <<< traverse p - --- | A default implementation of `wither` using `compact`. -witherDefault :: forall t m a b. Witherable t => Applicative m => - (a -> m (Maybe b)) -> t a -> m (t b) -witherDefault p = map compact <<< traverse p - --- | A default implementation of `partitionMap` given a `Witherable`. -partitionMapByWilt :: forall t a l r. Witherable t => - (a -> Either l r) -> t a -> { left :: t l, right :: t r } -partitionMapByWilt p = unwrap <<< wilt (Identity <<< p) - --- | A default implementation of `filterMap` given a `Witherable`. -filterMapByWither :: forall t a b. Witherable t => - (a -> Maybe b) -> t a -> t b -filterMapByWither p = unwrap <<< wither (Identity <<< p) - --- | A default implementation of `traverse` given a `Witherable`. -traverseByWither :: forall t m a b. Witherable t => Applicative m => - (a -> m b) -> t a -> m (t b) -traverseByWither f = wither (map Just <<< f) - --- | Partition between `Left` and `Right` values - with effects in `m`. -wilted :: forall t m l r. Witherable t => Applicative m => - t (m (Either l r)) -> m { left :: t l, right :: t r } -wilted = wilt identity - --- | Filter out all the `Nothing` values - with effects in `m`. -withered :: forall t m x. Witherable t => Applicative m => - t (m (Maybe x)) -> m (t x) -withered = wither identity - -instance witherableArray :: Witherable Array where - wilt = wiltDefault - wither = witherDefault - -instance witherableList :: Witherable List where - wilt p = map rev <<< List.foldl go (pure { left: Nil, right: Nil }) where - rev { left, right } = { left: List.reverse left, right: List.reverse right } - go acc x = (\{left, right} -> - case _ of - Left l -> { left: l : left, right } - Right r -> { left, right: r : right } - ) <$> acc <*> p x - - wither p = map List.reverse <<< List.foldl go (pure Nil) where - go acc x = (\comp -> - case _ of - Nothing -> comp - Just j -> j : comp - ) <$> acc <*> p x - -instance witherableMap :: Ord k => Witherable (Map.Map k) where - wilt p = List.foldl go (pure { left: Map.empty, right: Map.empty }) <<< toList - where - toList :: forall v. Ord k => Map.Map k v -> List.List (Tuple k v) - toList = Map.toUnfoldable - - go acc (Tuple k x) = (\{left, right} -> - case _ of - Left l -> { left: Map.insert k l left, right } - Right r -> { left, right: Map.insert k r right } - ) <$> acc <*> p x - - wither p = List.foldl go (pure Map.empty) <<< toList - where - toList :: forall v. Ord k => Map.Map k v -> List.List (Tuple k v) - toList = Map.toUnfoldable - - go acc (Tuple k x) = (\comp -> - case _ of - Nothing -> comp - Just j -> Map.insert k j comp - ) <$> acc <*> p x - -instance witherableMaybe :: Witherable Maybe where - wilt _ Nothing = pure { left: Nothing, right: Nothing } - wilt p (Just x) = map convert (p x) where - convert (Left l) = { left: Just l, right: Nothing } - convert (Right r) = { left: Nothing, right: Just r } - - wither _ Nothing = pure Nothing - wither p (Just x) = p x - -instance witherableEither :: Monoid m => Witherable (Either m) where - wilt _ (Left el) = pure { left: Left el, right: Left el } - wilt p (Right er) = map convert (p er) where - convert (Left l) = { left: Right l, right: Left mempty } - convert (Right r) = { left: Left mempty, right: Right r } - - wither _ (Left el) = pure (Left el) - wither p (Right er) = map convert (p er) where - convert Nothing = Left mempty - convert (Just r) = Right r diff --git a/stdlib/lib/Effect.purs b/stdlib/lib/Effect.purs deleted file mode 100644 index fa53e4f6..00000000 --- a/stdlib/lib/Effect.purs +++ /dev/null @@ -1,72 +0,0 @@ --- | This module provides the `Effect` type, which is used to represent --- | _native_ effects. The `Effect` type provides a typed API for effectful --- | computations, while at the same time generating efficient JavaScript. -module Effect - ( Effect - , untilE, whileE, forE, foreachE - ) where - -import Prelude - -import Control.Apply (lift2) - --- | A native effect. The type parameter denotes the return type of running the --- | effect, that is, an `Effect Int` is a possibly-effectful computation which --- | eventually produces a value of the type `Int` when it finishes. --- The Wasm state-token type and core instances are owned by Prelude. - --- Target adapters retain the private upstream operation contracts. -pureE :: forall a. a -> Effect a -pureE = pure - -bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b -bindE = bind - --- | The `Semigroup` instance for effects allows you to run two effects, one --- | after the other, and then combine their results using the result type's --- | `Semigroup` instance. -instance semigroupEffect :: Semigroup a => Semigroup (Effect a) where - append = lift2 append - --- | If you have a `Monoid a` instance, then `mempty :: Effect a` is defined as --- | `pure mempty`. -instance monoidEffect :: Monoid a => Monoid (Effect a) where - mempty = pureE mempty - --- | Loop until a condition becomes `true`. --- | --- | `untilE b` is an effectful computation which repeatedly runs the effectful --- | computation `b`, until its return value is `true`. -untilE :: Effect Boolean -> Effect Unit -untilE action = bind action \done -> - if done then pure unit else untilE action - --- | Loop while a condition is `true`. --- | --- | `whileE b m` is effectful computation which runs the effectful computation --- | `b`. If its result is `true`, it runs the effectful computation `m` and --- | loops. If not, the computation ends. -whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit -whileE condition action = bind condition \continue -> - if continue then bind action (\_ -> whileE condition action) else pure unit - --- | Loop over a consecutive collection of numbers. --- | --- | `forE lo hi f` runs the computation returned by the function `f` for each --- | of the inputs between `lo` (inclusive) and `hi` (exclusive). -forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit -forE lower upper action = - if lower < upper then bind (action lower) (\_ -> forE (lower + 1) upper action) - else pure unit - --- | Loop over an array of values. --- | --- | `foreachE xs f` runs the computation returned by the function `f` for each --- | of the inputs `xs`. -foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit -foreachE values action = go 0 - where - go index = - if intLt index (arrayLength values) - then bind (action (arrayIndex values index)) (\_ -> go (intAdd index 1)) - else pure unit diff --git a/stdlib/lib/Effect/Class.purs b/stdlib/lib/Effect/Class.purs deleted file mode 100644 index 6bdbd6bd..00000000 --- a/stdlib/lib/Effect/Class.purs +++ /dev/null @@ -1,19 +0,0 @@ -module Effect.Class where - -import Control.Category (identity) -import Control.Monad (class Monad) -import Effect (Effect) - --- | The `MonadEffect` class captures those monads which support native effects. --- | --- | Instances are provided for `Effect` itself, and the standard monad --- | transformers. --- | --- | `liftEffect` can be used in any appropriate monad transformer stack to lift an --- | action of type `Effect a` into the monad. --- | -class Monad m <= MonadEffect m where - liftEffect :: forall a. Effect a -> m a - -instance monadEffectEffect :: MonadEffect Effect where - liftEffect = identity diff --git a/stdlib/lib/Effect/Class/Console.purs b/stdlib/lib/Effect/Class/Console.purs deleted file mode 100644 index 8f22f8e5..00000000 --- a/stdlib/lib/Effect/Class/Console.purs +++ /dev/null @@ -1,49 +0,0 @@ -module Effect.Class.Console where - -import Data.Function ((<<<)) -import Data.Show (class Show) -import Data.Unit (Unit) -import Effect.Class (class MonadEffect, liftEffect) -import Effect.Console as EffConsole - -log :: forall m. MonadEffect m => String -> m Unit -log = liftEffect <<< EffConsole.log - -logShow :: forall m a. MonadEffect m => Show a => a -> m Unit -logShow = liftEffect <<< EffConsole.logShow - -warn :: forall m. MonadEffect m => String -> m Unit -warn = liftEffect <<< EffConsole.warn - -warnShow :: forall m a. MonadEffect m => Show a => a -> m Unit -warnShow = liftEffect <<< EffConsole.warnShow - -error :: forall m. MonadEffect m => String -> m Unit -error = liftEffect <<< EffConsole.error - -errorShow :: forall m a. MonadEffect m => Show a => a -> m Unit -errorShow = liftEffect <<< EffConsole.errorShow - -info :: forall m. MonadEffect m => String -> m Unit -info = liftEffect <<< EffConsole.info - -infoShow :: forall m a. MonadEffect m => Show a => a -> m Unit -infoShow = liftEffect <<< EffConsole.infoShow - -debug :: forall m. MonadEffect m => String -> m Unit -debug = liftEffect <<< EffConsole.debug - -debugShow :: forall m a. MonadEffect m => Show a => a -> m Unit -debugShow = liftEffect <<< EffConsole.debugShow - -time :: forall m. MonadEffect m => String -> m Unit -time = liftEffect <<< EffConsole.time - -timeLog :: forall m. MonadEffect m => String -> m Unit -timeLog = liftEffect <<< EffConsole.timeLog - -timeEnd :: forall m. MonadEffect m => String -> m Unit -timeEnd = liftEffect <<< EffConsole.timeEnd - -clear :: forall m. MonadEffect m => m Unit -clear = liftEffect EffConsole.clear diff --git a/stdlib/lib/Effect/Console.purs b/stdlib/lib/Effect/Console.purs deleted file mode 100644 index a5ab3949..00000000 --- a/stdlib/lib/Effect/Console.purs +++ /dev/null @@ -1,69 +0,0 @@ -module Effect.Console where - -import Effect (Effect) -import WASI.Console as Console - -import Data.Show (class Show, show) -import Data.Unit (Unit) - --- | Write a message to the console. --- WASI routes log to its log stream operation. -log :: String -> Effect Unit -log = Console.log - --- | Write a value to the console, using its `Show` instance to produce a --- | `String`. -logShow :: forall a. Show a => a -> Effect Unit -logShow a = log (show a) - --- | Write an warning to the console. --- WASI routes warn to its warn stream operation. -warn :: String -> Effect Unit -warn = Console.warn - --- | Write an warning value to the console, using its `Show` instance to produce --- | a `String`. -warnShow :: forall a. Show a => a -> Effect Unit -warnShow a = warn (show a) - --- | Write an error to the console. --- WASI routes error to its error stream operation. -error :: String -> Effect Unit -error = Console.error - --- | Write an error value to the console, using its `Show` instance to produce a --- | `String`. -errorShow :: forall a. Show a => a -> Effect Unit -errorShow a = error (show a) - --- | Write an info message to the console. --- WASI routes info to its log stream operation. -info :: String -> Effect Unit -info = Console.log - --- | Write an info value to the console, using its `Show` instance to produce a --- | `String`. -infoShow :: forall a. Show a => a -> Effect Unit -infoShow a = info (show a) - --- | Write an debug message to the console. --- WASI routes debug to its log stream operation. -debug :: String -> Effect Unit -debug = Console.log - --- | Write an debug value to the console, using its `Show` instance to produce a --- | `String`. -debugShow :: forall a. Show a => a -> Effect Unit -debugShow a = debug (show a) - --- | Start a named timer. -foreign import time :: String -> Effect Unit - --- | Print the time since a named timer started in milliseconds. -foreign import timeLog :: String -> Effect Unit - --- | Stop a named timer and print time since it started in milliseconds. -foreign import timeEnd :: String -> Effect Unit - --- | Clears the console -foreign import clear :: Effect Unit diff --git a/stdlib/lib/Effect/Ref.purs b/stdlib/lib/Effect/Ref.purs deleted file mode 100644 index 115238ee..00000000 --- a/stdlib/lib/Effect/Ref.purs +++ /dev/null @@ -1,73 +0,0 @@ --- | This module defines the `Ref` type for mutable value references, as well --- | as actions for working with them. --- | --- | You'll notice that all of the functions that operate on a `Ref` (e.g. --- | `new`, `read`, `write`) return their result wrapped in an `Effect`. --- | Working with mutable references is considered effectful in PureScript --- | because of the principle of purity: functions should not have side --- | effects, and should return the same result when called with the same --- | arguments. If a `Ref` could be written to without using `Effect`, that --- | would cause a side effect (the effect of changing the result of subsequent --- | reads for that `Ref`). If there were a function for reading the current --- | value of a `Ref` without the result being wrapped in `Effect`, the result --- | of calling that function would change each time a new value was written to --- | the `Ref`. Even creating a new `Ref` is effectful: if there were a --- | function for creating a new `Ref` with the type `forall s. s -> Ref s`, --- | then calling that function twice with the same argument would not give the --- | same result in each case, since you'd end up with two distinct references --- | which could be updated independently of each other. --- | --- | _Note_: `Control.Monad.ST` provides a pure alternative to `Ref` when --- | mutation is restricted to a local scope. -module Effect.Ref - ( Ref - , new - , newWithSelf - , read - , modify' - , modify - , modify_ - , write - ) where - -import Prelude - -import Effect (Effect) - --- | A value of type `Ref a` represents a mutable reference --- | which holds a value of type `a`. -foreign import data Ref :: Type -> Type - -type role Ref representational - --- | Create a new mutable reference containing the specified value. -foreign import _new :: forall s. s -> Effect (Ref s) - -new :: forall s. s -> Effect (Ref s) -new = _new - --- | Create a new mutable reference containing a value that can refer to the --- | `Ref` being created. -foreign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s) - --- | Read the current value of a mutable reference. -foreign import read :: forall s. Ref s -> Effect s - --- | Update the value of a mutable reference by applying a function --- | to the current value. -modify' :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b -modify' = modifyImpl - -foreign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b - --- | Update the value of a mutable reference by applying a function --- | to the current value. The updated value is returned. -modify :: forall s. (s -> s) -> Ref s -> Effect s -modify f = modify' \s -> let s' = f s in { state: s', value: s' } - --- | A version of `modify` which does not return the updated value. -modify_ :: forall s. (s -> s) -> Ref s -> Effect Unit -modify_ f s = void $ modify f s - --- | Update the value of a mutable reference to the specified value. -foreign import write :: forall s. s -> Ref s -> Effect Unit diff --git a/stdlib/lib/Effect/Uncurried.purs b/stdlib/lib/Effect/Uncurried.purs deleted file mode 100644 index 7ed42e85..00000000 --- a/stdlib/lib/Effect/Uncurried.purs +++ /dev/null @@ -1,286 +0,0 @@ --- | This module defines types for effectful uncurried functions, as well as --- | functions for converting back and forth between them. --- | --- | This makes it possible to give a PureScript type to JavaScript functions --- | such as this one: --- | --- | ```javascript --- | function logMessage(level, message) { --- | console.log(level + ": " + message); --- | } --- | ``` --- | --- | In particular, note that `logMessage` performs effects immediately after --- | receiving all of its parameters, so giving it the type `Data.Function.Fn2 --- | String String Unit`, while convenient, would effectively be a lie. --- | --- | One way to handle this would be to convert the function into the normal --- | PureScript form (namely, a curried function returning an Effect action), --- | and performing the marshalling in JavaScript, in the FFI module, like this: --- | --- | ```purescript --- | -- In the PureScript file: --- | foreign import logMessage :: String -> String -> Effect Unit --- | ``` --- | --- | ```javascript --- | // In the FFI file: --- | exports.logMessage = function(level) { --- | return function(message) { --- | return function() { --- | logMessage(level, message); --- | }; --- | }; --- | }; --- | ``` --- | --- | This method, unfortunately, turns out to be both tiresome and error-prone. --- | This module offers an alternative solution. By providing you with: --- | --- | * the ability to give the real `logMessage` function a PureScript type, --- | and --- | * functions for converting between this form and the normal PureScript --- | form, --- | --- | the FFI boilerplate is no longer needed. The previous example becomes: --- | --- | ```purescript --- | -- In the PureScript file: --- | foreign import logMessageImpl :: EffectFn2 String String Unit --- | ``` --- | --- | ```javascript --- | // In the FFI file: --- | exports.logMessageImpl = logMessage --- | ``` --- | --- | You can then use `runEffectFn2` to provide a nicer version: --- | --- | ```purescript --- | logMessage :: String -> String -> Effect Unit --- | logMessage = runEffectFn2 logMessageImpl --- | ``` --- | --- | (note that this has the same type as the original `logMessage`). --- | --- | Effectively, we have reduced the risk of errors by moving as much code into --- | PureScript as possible, so that we can leverage the type system. Hopefully, --- | this is a little less tiresome too. --- | --- | Here's a slightly more advanced example. Here, because we are using --- | callbacks, we need to use `mkEffectFn{N}` as well. --- | --- | Suppose our `logMessage` changes so that it sometimes sends details of the --- | message to some external server, and in those cases, we want the resulting --- | `HttpResponse` (for whatever reason). --- | --- | ```javascript --- | function logMessage(level, message, callback) { --- | console.log(level + ": " + message); --- | if (level > LogLevel.WARN) { --- | LogAggregatorService.post("/logs", { --- | level: level, --- | message: message --- | }, callback); --- | } else { --- | callback(null); --- | } --- | } --- | ``` --- | --- | The import then looks like this: --- | ```purescript --- | foreign import logMessageImpl --- | EffectFn3 --- | String --- | String --- | (EffectFn1 (Nullable HttpResponse) Unit) --- | Unit --- | ``` --- | --- | And, as before, the FFI file is extremely simple: --- | --- | ```javascript --- | exports.logMessageImpl = logMessage --- | ``` --- | --- | Finally, we use `runEffectFn{N}` and `mkEffectFn{N}` for a more comfortable --- | PureScript version: --- | --- | ```purescript --- | logMessage :: --- | String -> --- | String -> --- | (Nullable HttpResponse -> Effect Unit) -> --- | Effect Unit --- | logMessage level message callback = --- | runEffectFn3 logMessageImpl level message (mkEffectFn1 callback) --- | ``` --- | --- | The general naming scheme for functions and types in this module is as --- | follows: --- | --- | * `EffectFn{N}` means, an uncurried function which accepts N arguments and --- | performs some effects. The first N arguments are the actual function's --- | argument. The last type argument is the return type. --- | * `runEffectFn{N}` takes an `EffectFn` of N arguments, and converts it into --- | the normal PureScript form: a curried function which returns an Effect --- | action. --- | * `mkEffectFn{N}` is the inverse of `runEffectFn{N}`. It can be useful for --- | callbacks. --- | - -module Effect.Uncurried where - -import Data.Monoid (class Monoid, class Semigroup, mempty, (<>)) -import Effect (Effect) - -foreign import data EffectFn1 :: Type -> Type -> Type - -type role EffectFn1 representational representational - -foreign import data EffectFn2 :: Type -> Type -> Type -> Type - -type role EffectFn2 representational representational representational - -foreign import data EffectFn3 :: Type -> Type -> Type -> Type -> Type - -type role EffectFn3 representational representational representational representational - -foreign import data EffectFn4 :: Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn4 representational representational representational representational representational - -foreign import data EffectFn5 :: Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn5 representational representational representational representational representational representational - -foreign import data EffectFn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn6 representational representational representational representational representational representational representational - -foreign import data EffectFn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn7 representational representational representational representational representational representational representational representational - -foreign import data EffectFn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn8 representational representational representational representational representational representational representational representational representational - -foreign import data EffectFn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn9 representational representational representational representational representational representational representational representational representational representational - -foreign import data EffectFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type - -type role EffectFn10 representational representational representational representational representational representational representational representational representational representational representational - -foreign import mkEffectFn1 :: forall a r. - (a -> Effect r) -> EffectFn1 a r -foreign import mkEffectFn2 :: forall a b r. - (a -> b -> Effect r) -> EffectFn2 a b r -foreign import mkEffectFn3 :: forall a b c r. - (a -> b -> c -> Effect r) -> EffectFn3 a b c r -foreign import mkEffectFn4 :: forall a b c d r. - (a -> b -> c -> d -> Effect r) -> EffectFn4 a b c d r -foreign import mkEffectFn5 :: forall a b c d e r. - (a -> b -> c -> d -> e -> Effect r) -> EffectFn5 a b c d e r -foreign import mkEffectFn6 :: forall a b c d e f r. - (a -> b -> c -> d -> e -> f -> Effect r) -> EffectFn6 a b c d e f r -foreign import mkEffectFn7 :: forall a b c d e f g r. - (a -> b -> c -> d -> e -> f -> g -> Effect r) -> EffectFn7 a b c d e f g r -foreign import mkEffectFn8 :: forall a b c d e f g h r. - (a -> b -> c -> d -> e -> f -> g -> h -> Effect r) -> EffectFn8 a b c d e f g h r -foreign import mkEffectFn9 :: forall a b c d e f g h i r. - (a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r) -> EffectFn9 a b c d e f g h i r -foreign import mkEffectFn10 :: forall a b c d e f g h i j r. - (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r) -> EffectFn10 a b c d e f g h i j r - -foreign import runEffectFn1 :: forall a r. - EffectFn1 a r -> a -> Effect r -foreign import runEffectFn2 :: forall a b r. - EffectFn2 a b r -> a -> b -> Effect r -foreign import runEffectFn3 :: forall a b c r. - EffectFn3 a b c r -> a -> b -> c -> Effect r -foreign import runEffectFn4 :: forall a b c d r. - EffectFn4 a b c d r -> a -> b -> c -> d -> Effect r -foreign import runEffectFn5 :: forall a b c d e r. - EffectFn5 a b c d e r -> a -> b -> c -> d -> e -> Effect r -foreign import runEffectFn6 :: forall a b c d e f r. - EffectFn6 a b c d e f r -> a -> b -> c -> d -> e -> f -> Effect r -foreign import runEffectFn7 :: forall a b c d e f g r. - EffectFn7 a b c d e f g r -> a -> b -> c -> d -> e -> f -> g -> Effect r -foreign import runEffectFn8 :: forall a b c d e f g h r. - EffectFn8 a b c d e f g h r -> a -> b -> c -> d -> e -> f -> g -> h -> Effect r -foreign import runEffectFn9 :: forall a b c d e f g h i r. - EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r -foreign import runEffectFn10 :: forall a b c d e f g h i j r. - EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r - --- The reason these are written eta-expanded instead of as: --- ``` --- append f1 f2 = mkEffectFnN $ runEffectFnN f1 <> runEffectFnN f2 --- ``` --- is to help the compiler recognize that it can emit uncurried --- JS functions (which are more efficient), when an appended --- EffectFn is applied to all its arguments - -instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where - append f1 f2 = mkEffectFn1 \a -> runEffectFn1 f1 a <> runEffectFn1 f2 a - -instance semigroupEffectFn2 :: Semigroup r => Semigroup (EffectFn2 a b r) where - append f1 f2 = mkEffectFn2 \a b -> runEffectFn2 f1 a b <> runEffectFn2 f2 a b - -instance semigroupEffectFn3 :: Semigroup r => Semigroup (EffectFn3 a b c r) where - append f1 f2 = mkEffectFn3 \a b c -> runEffectFn3 f1 a b c <> runEffectFn3 f2 a b c - -instance semigroupEffectFn4 :: Semigroup r => Semigroup (EffectFn4 a b c d r) where - append f1 f2 = mkEffectFn4 \a b c d -> runEffectFn4 f1 a b c d <> runEffectFn4 f2 a b c d - -instance semigroupEffectFn5 :: Semigroup r => Semigroup (EffectFn5 a b c d e r) where - append f1 f2 = mkEffectFn5 \a b c d e -> runEffectFn5 f1 a b c d e <> runEffectFn5 f2 a b c d e - -instance semigroupEffectFn6 :: Semigroup r => Semigroup (EffectFn6 a b c d e f r) where - append f1 f2 = mkEffectFn6 \a b c d e f -> runEffectFn6 f1 a b c d e f <> runEffectFn6 f2 a b c d e f - -instance semigroupEffectFn7 :: Semigroup r => Semigroup (EffectFn7 a b c d e f g r) where - append f1 f2 = mkEffectFn7 \a b c d e f g -> runEffectFn7 f1 a b c d e f g <> runEffectFn7 f2 a b c d e f g - -instance semigroupEffectFn8 :: Semigroup r => Semigroup (EffectFn8 a b c d e f g h r) where - append f1 f2 = mkEffectFn8 \a b c d e f g h -> runEffectFn8 f1 a b c d e f g h <> runEffectFn8 f2 a b c d e f g h - -instance semigroupEffectFn9 :: Semigroup r => Semigroup (EffectFn9 a b c d e f g h i r) where - append f1 f2 = mkEffectFn9 \a b c d e f g h i -> runEffectFn9 f1 a b c d e f g h i <> runEffectFn9 f2 a b c d e f g h i - -instance semigroupEffectFn10 :: Semigroup r => Semigroup (EffectFn10 a b c d e f g h i j r) where - append f1 f2 = mkEffectFn10 \a b c d e f g h i j -> runEffectFn10 f1 a b c d e f g h i j <> runEffectFn10 f2 a b c d e f g h i j - -instance monoidEffectFn1 :: Monoid r => Monoid (EffectFn1 a r) where - mempty = mkEffectFn1 \_ -> mempty - -instance monoidEffectFn2 :: Monoid r => Monoid (EffectFn2 a b r) where - mempty = mkEffectFn2 \_ _ -> mempty - -instance monoidEffectFn3 :: Monoid r => Monoid (EffectFn3 a b c r) where - mempty = mkEffectFn3 \_ _ _ -> mempty - -instance monoidEffectFn4 :: Monoid r => Monoid (EffectFn4 a b c d r) where - mempty = mkEffectFn4 \_ _ _ _ -> mempty - -instance monoidEffectFn5 :: Monoid r => Monoid (EffectFn5 a b c d e r) where - mempty = mkEffectFn5 \_ _ _ _ _ -> mempty - -instance monoidEffectFn6 :: Monoid r => Monoid (EffectFn6 a b c d e f r) where - mempty = mkEffectFn6 \_ _ _ _ _ _ -> mempty - -instance monoidEffectFn7 :: Monoid r => Monoid (EffectFn7 a b c d e f g r) where - mempty = mkEffectFn7 \_ _ _ _ _ _ _ -> mempty - -instance monoidEffectFn8 :: Monoid r => Monoid (EffectFn8 a b c d e f g h r) where - mempty = mkEffectFn8 \_ _ _ _ _ _ _ _ -> mempty - -instance monoidEffectFn9 :: Monoid r => Monoid (EffectFn9 a b c d e f g h i r) where - mempty = mkEffectFn9 \_ _ _ _ _ _ _ _ _ -> mempty - -instance monoidEffectFn10 :: Monoid r => Monoid (EffectFn10 a b c d e f g h i j r) where - mempty = mkEffectFn10 \_ _ _ _ _ _ _ _ _ _ -> mempty diff --git a/stdlib/lib/Effect/Unsafe.purs b/stdlib/lib/Effect/Unsafe.purs deleted file mode 100644 index 79614d81..00000000 --- a/stdlib/lib/Effect/Unsafe.purs +++ /dev/null @@ -1,8 +0,0 @@ -module Effect.Unsafe where - -import Effect (Effect) - --- | Run an effectful computation. --- | --- | *Note*: use of this function can result in arbitrary side-effects. -foreign import unsafePerformEffect :: forall a. Effect a -> a diff --git a/stdlib/lib/Partial.purs b/stdlib/lib/Partial.purs deleted file mode 100644 index 22e2b076..00000000 --- a/stdlib/lib/Partial.purs +++ /dev/null @@ -1,15 +0,0 @@ --- | Some partial helper functions. See the README for more documentation. -module Partial - ( crash - , crashWith - ) where - --- | A partial function which crashes on any input with a default message. -crash :: forall a. Partial => a -crash = crashWith "Partial.crash: partial function" - --- | A partial function which crashes on any input with the specified message. -crashWith :: forall a. Partial => String -> a -crashWith = _crashWith - -foreign import _crashWith :: forall a. String -> a diff --git a/stdlib/lib/Partial/Unsafe.purs b/stdlib/lib/Partial/Unsafe.purs deleted file mode 100644 index 2221d09b..00000000 --- a/stdlib/lib/Partial/Unsafe.purs +++ /dev/null @@ -1,24 +0,0 @@ --- | Utilities for working with partial functions. --- | See the README for more documentation. -module Partial.Unsafe - ( unsafePartial - , unsafeCrashWith - ) where - -import Partial (crashWith) - --- Note: this function's type signature is more like --- `(Unit -> a) -> a`. However, we would need to use --- `unsafeCoerce` to make this compile, incurring --- either a dependency or reimplementing it here. --- Rather than doing that, we'll use a type signature --- of `a -> b` instead. -foreign import _unsafePartial :: forall a b. a -> b - --- | Discharge a partiality constraint, unsafely. -unsafePartial :: forall a. (Partial => a) -> a -unsafePartial = _unsafePartial - --- | A function which crashes with the specified error message. -unsafeCrashWith :: forall a. String -> a -unsafeCrashWith msg = unsafePartial (crashWith msg) diff --git a/stdlib/lib/Prelude.purs b/stdlib/lib/Prelude.purs deleted file mode 100644 index 1aefdb1d..00000000 --- a/stdlib/lib/Prelude.purs +++ /dev/null @@ -1,104 +0,0 @@ --- | The primitive surface the rest of the library and the corpus build on. --- | --- | The class hierarchy is the official `purescript-prelude` v6.0.1 re-export --- | list. `Effect` stays in this module: `check_run_effect_scope` resolves --- | `Prelude.runEffect`, and `psrs_core::effect::operations` synthesizes --- | `effectPure`, `effectBind`, `runEffect`, and `trap` from the `psrs:effect` --- | bindings declared here. The class methods `pure` and `bind` are the --- | official `Applicative` and `Bind` methods; the `Effect` instances call --- | those bindings, so creating an action still does not run it. --- | --- | `unit` is not declared here. `Unit` is a builtin, re-exported through --- | `Data.Unit`, and the one `Unit` value is `Intrinsic::Unit`. -module Prelude - ( Effect - , runEffect - , trap - , module Control.Applicative - , module Control.Apply - , module Control.Bind - , module Control.Category - , module Control.Monad - , module Control.Semigroupoid - , module Data.Boolean - , module Data.BooleanAlgebra - , module Data.Bounded - , module Data.CommutativeRing - , module Data.DivisionRing - , module Data.Eq - , module Data.EuclideanRing - , module Data.Field - , module Data.Function - , module Data.Functor - , module Data.HeytingAlgebra - , module Data.Monoid - , module Data.NaturalTransformation - , module Data.Ord - , module Data.Ordering - , module Data.Ring - , module Data.Semigroup - , module Data.Semiring - , module Data.Show - , module Data.Unit - , module Data.Void - ) where - -import Control.Applicative (class Applicative, pure, liftA1, unless, when) -import Control.Apply (class Apply, apply, (*>), (<*), (<*>)) -import Control.Bind (class Bind, bind, class Discard, discard, ifM, join, (<=<), (=<<), (>=>), (>>=)) -import Control.Category (class Category, identity) -import Control.Monad (class Monad, liftM1, unlessM, whenM, ap) -import Control.Semigroupoid (class Semigroupoid, compose, (<<<), (>>>)) - -import Data.Boolean (otherwise) -import Data.BooleanAlgebra (class BooleanAlgebra) -import Data.Bounded (class Bounded, bottom, top) -import Data.CommutativeRing (class CommutativeRing) -import Data.DivisionRing (class DivisionRing, recip) -import Data.Eq (class Eq, eq, notEq, (/=), (==)) -import Data.EuclideanRing (class EuclideanRing, degree, div, mod, (/), gcd, lcm) -import Data.Field (class Field) -import Data.Function (const, flip, ($), (#)) -import Data.Functor (class Functor, flap, map, void, ($>), (<#>), (<$), (<$>), (<@>)) -import Data.HeytingAlgebra (class HeytingAlgebra, conj, disj, not, (&&), (||)) -import Data.Monoid (class Monoid, mempty) -import Data.NaturalTransformation (type (~>)) -import Data.Ord (class Ord, compare, (<), (<=), (>), (>=), comparing, min, max, clamp, between) -import Data.Ordering (Ordering(..)) -import Data.Ring (class Ring, negate, sub, (-)) -import Data.Semigroup (class Semigroup, append, (<>)) -import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+)) -import Data.Show (class Show, show) -import Data.Unit (Unit, unit) -import Data.Void (Void, absurd) - -foreign import data Effect :: Type -> Type -type role Effect representational - --- | Builds an `Effect` that returns `value`. Lowering replaces this binding; --- | the `Applicative` instance is what user code calls `pure`. -foreign import "psrs:effect#pure" effectPure :: forall a. a -> Effect a - --- | Sequences two effects. The `Bind` instance is what user code calls `bind`. -foreign import "psrs:effect#bind" effectBind :: forall a b. Effect a -> (a -> Effect b) -> Effect b - -foreign import "psrs:effect#run" runEffect :: forall a. Effect a -> a - --- | The effect that escapes instead of returning. An uncaught failure on this --- | target is a guest trap, so this is the one operation whose result never --- | exists; it is how a library reports an assertion that did not hold. -foreign import "psrs:effect#trap" trap :: Effect Unit - -instance functorEffect :: Functor Effect where - map = liftA1 - -instance applyEffect :: Apply Effect where - apply = ap - -instance applicativeEffect :: Applicative Effect where - pure = effectPure - -instance bindEffect :: Bind Effect where - bind = effectBind - -instance monadEffect :: Monad Effect diff --git a/stdlib/lib/Record/Unsafe.purs b/stdlib/lib/Record/Unsafe.purs deleted file mode 100644 index adeaade7..00000000 --- a/stdlib/lib/Record/Unsafe.purs +++ /dev/null @@ -1,27 +0,0 @@ --- | The functions in this module are highly unsafe as they treat records like --- | stringly-keyed maps and can coerce the row of labels that a record has. --- | --- | These function are intended for situations where there is some other way of --- | proving things about the structure of the record - for example, when using --- | `RowToList`. **They should never be used for general record manipulation.** -module Record.Unsafe where - --- | Checks if a record has a key, using a string for the key. -foreign import unsafeHas :: forall r1. String -> Record r1 -> Boolean - --- | Unsafely gets a value from a record, using a string for the key. --- | --- | If the key does not exist this will cause a runtime error elsewhere. -foreign import unsafeGet :: forall r a. String -> Record r -> a - --- | Unsafely sets a value on a record, using a string for the key. --- | --- | The output record's row is unspecified so can be coerced to any row. If the --- | output type is incorrect it will cause a runtime error elsewhere. -foreign import unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2 - --- | Unsafely removes a value on a record, using a string for the key. --- | --- | The output record's row is unspecified so can be coerced to any row. If the --- | output type is incorrect it will cause a runtime error elsewhere. -foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2 diff --git a/stdlib/lib/Safe/Coerce.purs b/stdlib/lib/Safe/Coerce.purs deleted file mode 100644 index 2f4babe6..00000000 --- a/stdlib/lib/Safe/Coerce.purs +++ /dev/null @@ -1,27 +0,0 @@ -module Safe.Coerce - ( module Prim.Coerce - , coerce - ) where - -import Prim.Coerce (class Coercible) -import Unsafe.Coerce (unsafeCoerce) - --- | Coerce a value of one type to a value of some other type, without changing --- | its runtime representation. This function behaves identically to --- | `unsafeCoerce` at runtime. Unlike `unsafeCoerce`, it is safe, because the --- | `Coercible` constraint prevents any use of this function from compiling --- | unless the compiler can prove that the two types have the same runtime --- | representation. --- | --- | One application for this function is to avoid doing work that you know is a --- | no-op because of newtypes. For example, if you have an `Array (Conj a)` and you --- | want an `Array (Disj a)`, you could do `Data.Array.map (un Conj >>> Disj)`, but --- | this performs an unnecessary traversal of the array, with O(n) cost. --- | `coerce` accomplishes the same with only O(1) cost: --- | --- | ```purescript --- | mapConjToDisj :: forall a. Array (Conj a) -> Array (Disj a) --- | mapConjToDisj = coerce --- | ``` -coerce :: forall a b. Coercible a b => a -> b -coerce = unsafeCoerce diff --git a/stdlib/lib/Test/Assert.purs b/stdlib/lib/Test/Assert.purs deleted file mode 100644 index 92d9858c..00000000 --- a/stdlib/lib/Test/Assert.purs +++ /dev/null @@ -1,137 +0,0 @@ -module Test.Assert - ( assert - , assert' - , assertEqual - , assertEqual' - , assertFalse - , assertFalse' - , assertThrows - , assertThrows' - , assertTrue - , assertTrue' - ) where - -import Prelude - -import Effect (Effect) -import Effect.Console (error) - --- | Throws a runtime exception with message "Assertion failed" when the boolean --- | value is false. -assert :: Boolean -> Effect Unit -assert = assert' "Assertion failed" - --- | Throws a runtime exception with the specified message when the boolean --- | value is false. -assert' :: String -> Boolean -> Effect Unit -assert' = assertImpl - --- Wasm/WASI implementation: failure writes its message before trapping. -assertImpl :: String -> Boolean -> Effect Unit -assertImpl message condition = - if condition then pure unit - else do - _ <- error message - trap - --- | Throws a runtime exception with message "Assertion failed: An error should --- | have been thrown", unless the argument throws an exception when evaluated. --- | --- | This function is specifically for testing unsafe pure code; for example, --- | to make sure that an exception is thrown if a precondition is not --- | satisfied. Functions which use `Effect a` can be --- | tested with `catchException` instead. -assertThrows :: forall a. (Unit -> a) -> Effect Unit -assertThrows = - assertThrows' "Assertion failed: An error should have been thrown" - --- | Throws a runtime exception with the specified message, unless the argument --- | throws an exception when evaluated. --- | --- | This function is specifically for testing unsafe pure code; for example, --- | to make sure that an exception is thrown if a precondition is not --- | satisfied. Functions which use `Effect a` can be --- | tested with `catchException` instead. -assertThrows' - :: forall a - . String - -> (Unit -> a) - -> Effect Unit -assertThrows' msg fn = assert' msg =<< checkThrows fn - -foreign import checkThrows - :: forall a - . (Unit -> a) - -> Effect Boolean - --- | Compares the `expected` and `actual` values for equality and --- | throws a runtime exception when the values are not equal. --- | --- | The message indicates the expected value and the actual value. -assertEqual - :: forall a - . Eq a - => Show a - => { actual :: a, expected :: a } - -> Effect Unit -assertEqual = assertEqual' "" - --- | Compares the `expected` and `actual` values for equality and throws a --- | runtime exception with the specified message when the values are not equal. --- | --- | The message also indicates the expected value and the actual value. -assertEqual' - :: forall a - . Eq a - => Show a - => String - -> { actual :: a, expected :: a } - -> Effect Unit -assertEqual' userMessage {actual, expected} = do - unless result $ error message - assert' message result - where - message = (if userMessage == "" then "" else userMessage <> "\n") - <> "Expected: " <> show expected - <> "\nActual: " <> show actual - result = actual == expected - --- | Throws a runtime exception when the value is `false`. --- | --- | The message indicates the expected value (`true`) --- | and the actual value (`false`). -assertTrue - :: Boolean - -> Effect Unit -assertTrue actual = assertEqual { actual, expected: true } - --- | Throws a runtime exception with the specified message when the value is --- | `false`. --- | --- | The message also indicates the expected value (`true`) --- | and the actual value (`false`). -assertTrue' - :: String - -> Boolean - -> Effect Unit -assertTrue' message actual = assertEqual' message { actual, expected: true } - --- | Throws a runtime exception when the value is `true`. --- | --- | The message indicates the expected value (`false`) --- | and the actual value (`true`). -assertFalse - :: Boolean - -> Effect Unit -assertFalse actual = assertEqual { actual, expected: false } - --- | Throws a runtime exception with the specified message when the value is --- | `true`. --- | --- | The message also indicates the expected value (`false`) --- | and the actual value (`true`). -assertFalse' - :: String - -> Boolean - -> Effect Unit -assertFalse' message actual = assertEqual' message { actual, expected: false } diff --git a/stdlib/lib/Type/Data/Boolean.purs b/stdlib/lib/Type/Data/Boolean.purs deleted file mode 100644 index b56d8a26..00000000 --- a/stdlib/lib/Type/Data/Boolean.purs +++ /dev/null @@ -1,66 +0,0 @@ -module Type.Data.Boolean - ( module Prim.Boolean - , class IsBoolean - , reflectBoolean - , reifyBoolean - , class And - , and - , class Or - , or - , class Not - , not - , class If - , if_ - ) where - -import Prim.Boolean (True, False) -import Type.Proxy (Proxy(..)) - --- | Class for reflecting a type level `Boolean` at the value level -class IsBoolean :: Boolean -> Constraint -class IsBoolean bool where - reflectBoolean :: Proxy bool -> Boolean - -instance isBooleanTrue :: IsBoolean True where reflectBoolean _ = true -instance isBooleanFalse :: IsBoolean False where reflectBoolean _ = false - --- | Use a value level `Boolean` as a type-level `Boolean` -reifyBoolean :: forall r. Boolean -> (forall o. IsBoolean o => Proxy o -> r) -> r -reifyBoolean true f = f (Proxy :: Proxy True) -reifyBoolean false f = f (Proxy :: Proxy False) - --- | And two `Boolean` types together -class And :: Boolean -> Boolean -> Boolean -> Constraint -class And lhs rhs out | lhs rhs -> out -instance andTrue :: And True rhs rhs -instance andFalse :: And False rhs False - -and :: forall l r o. And l r o => Proxy l -> Proxy r -> Proxy o -and _ _ = Proxy - --- | Or two `Boolean` types together -class Or :: Boolean -> Boolean -> Boolean -> Constraint -class Or lhs rhs output | lhs rhs -> output -instance orTrue :: Or True rhs True -instance orFalse :: Or False rhs rhs - -or :: forall l r o. Or l r o => Proxy l -> Proxy r -> Proxy o -or _ _ = Proxy - --- | Not a `Boolean` -class Not :: Boolean -> Boolean -> Constraint -class Not bool output | bool -> output -instance notTrue :: Not True False -instance notFalse :: Not False True - -not :: forall i o. Not i o => Proxy i -> Proxy o -not _ = Proxy - --- | If - dispatch based on a boolean -class If :: forall k. Boolean -> k -> k -> k -> Constraint -class If bool onTrue onFalse output | bool onTrue onFalse -> output -instance ifTrue :: If True onTrue onFalse onTrue -instance ifFalse :: If False onTrue onFalse onFalse - -if_ :: forall b t e o. If b t e o => Proxy b -> Proxy t -> Proxy e -> Proxy o -if_ _ _ _ = Proxy diff --git a/stdlib/lib/Type/Data/Ordering.purs b/stdlib/lib/Type/Data/Ordering.purs deleted file mode 100644 index 5dd15cb2..00000000 --- a/stdlib/lib/Type/Data/Ordering.purs +++ /dev/null @@ -1,69 +0,0 @@ -module Type.Data.Ordering - ( module PO - , class IsOrdering - , reflectOrdering - , reifyOrdering - , class Append - , append - , class Invert - , invert - , class Equals - , equals - ) where - -import Prim.Ordering (LT, EQ, GT, Ordering) as PO -import Data.Ordering (Ordering(..)) -import Type.Data.Boolean (True, False) -import Type.Proxy (Proxy(..)) - --- | Class for reflecting a type level `Ordering` at the value level -class IsOrdering :: PO.Ordering -> Constraint -class IsOrdering ordering where - reflectOrdering :: Proxy ordering -> Ordering - -instance isOrderingLT :: IsOrdering PO.LT where reflectOrdering _ = LT -instance isOrderingEQ :: IsOrdering PO.EQ where reflectOrdering _ = EQ -instance isOrderingGT :: IsOrdering PO.GT where reflectOrdering _ = GT - --- | Use a value level `Ordering` as a type-level `Ordering` -reifyOrdering :: forall r. Ordering -> (forall o. IsOrdering o => Proxy o -> r) -> r -reifyOrdering LT f = f (Proxy :: Proxy PO.LT) -reifyOrdering EQ f = f (Proxy :: Proxy PO.EQ) -reifyOrdering GT f = f (Proxy :: Proxy PO.GT) - --- | Append two `Ordering` types together --- | Reflective of the semigroup for value level `Ordering` -class Append :: PO.Ordering -> PO.Ordering -> PO.Ordering -> Constraint -class Append lhs rhs output | lhs -> rhs output -instance appendOrderingLT :: Append PO.LT rhs PO.LT -instance appendOrderingEQ :: Append PO.EQ rhs rhs -instance appendOrderingGT :: Append PO.GT rhs PO.GT - -append :: forall l r o. Append l r o => Proxy l -> Proxy r -> Proxy o -append _ _ = Proxy - --- | Invert an `Ordering` -class Invert :: PO.Ordering -> PO.Ordering -> Constraint -class Invert ordering result | ordering -> result -instance invertOrderingLT :: Invert PO.LT PO.GT -instance invertOrderingEQ :: Invert PO.EQ PO.EQ -instance invertOrderingGT :: Invert PO.GT PO.LT - -invert :: forall i o. Invert i o => Proxy i -> Proxy o -invert _ = Proxy - -class Equals :: PO.Ordering -> PO.Ordering -> Boolean -> Constraint -class Equals lhs rhs out | lhs rhs -> out - -instance equalsEQEQ :: Equals PO.EQ PO.EQ True -instance equalsLTLT :: Equals PO.LT PO.LT True -instance equalsGTGT :: Equals PO.GT PO.GT True -instance equalsEQLT :: Equals PO.EQ PO.LT False -instance equalsEQGT :: Equals PO.EQ PO.GT False -instance equalsLTEQ :: Equals PO.LT PO.EQ False -instance equalsLTGT :: Equals PO.LT PO.GT False -instance equalsGTLT :: Equals PO.GT PO.LT False -instance equalsGTEQ :: Equals PO.GT PO.EQ False - -equals :: forall l r o. Equals l r o => Proxy l -> Proxy r -> Proxy o -equals _ _ = Proxy diff --git a/stdlib/lib/Type/Data/Symbol.purs b/stdlib/lib/Type/Data/Symbol.purs deleted file mode 100644 index 535ae49c..00000000 --- a/stdlib/lib/Type/Data/Symbol.purs +++ /dev/null @@ -1,35 +0,0 @@ -module Type.Data.Symbol - ( module Prim.Symbol - , module Data.Symbol - , append - , compare - , uncons - , class Equals - , equals - ) where - -import Prim.Symbol (class Append, class Compare, class Cons) -import Data.Symbol (class IsSymbol, reflectSymbol, reifySymbol) -import Type.Data.Ordering (EQ) -import Type.Data.Ordering (class Equals) as Ordering -import Type.Proxy (Proxy(..)) - -compare :: forall l r o. Compare l r o => Proxy l -> Proxy r -> Proxy o -compare _ _ = Proxy - -append :: forall l r o. Append l r o => Proxy l -> Proxy r -> Proxy o -append _ _ = Proxy - -uncons :: forall h t s. Cons h t s => Proxy s -> {head :: Proxy h, tail :: Proxy t} -uncons _ = {head : Proxy, tail : Proxy} - -class Equals :: Symbol -> Symbol -> Boolean -> Constraint -class Equals lhs rhs out | lhs rhs -> out - -instance equalsSymbol - :: (Compare lhs rhs ord, - Ordering.Equals EQ ord out) - => Equals lhs rhs out - -equals :: forall l r o. Equals l r o => Proxy l -> Proxy r -> Proxy o -equals _ _ = Proxy diff --git a/stdlib/lib/Type/Equality.purs b/stdlib/lib/Type/Equality.purs deleted file mode 100644 index 686655b5..00000000 --- a/stdlib/lib/Type/Equality.purs +++ /dev/null @@ -1,35 +0,0 @@ -module Type.Equality - ( class TypeEquals - , proof - , to - , from - ) where - -import Prim.Coerce (class Coercible) - --- | This type class asserts that types `a` and `b` --- | are equal. --- | --- | The functional dependencies and the single --- | instance below will force the two type arguments --- | to unify when either one is known. --- | --- | Note: any instance will necessarily overlap with --- | `refl` below, so instances of this class should --- | not be defined in libraries. -class TypeEquals :: forall k. k -> k -> Constraint -class Coercible a b <= TypeEquals a b | a -> b, b -> a where - proof :: forall p. p a -> p b - -instance refl :: TypeEquals a a where - proof a = a - -newtype To a b = To (a -> b) - -to :: forall a b. TypeEquals a b => a -> b -to = case proof (To (\a -> a)) of To f -> f - -newtype From a b = From (b -> a) - -from :: forall a b. TypeEquals a b => b -> a -from = case proof (From (\a -> a)) of From f -> f diff --git a/stdlib/lib/Type/Function.purs b/stdlib/lib/Type/Function.purs deleted file mode 100644 index 78440ad5..00000000 --- a/stdlib/lib/Type/Function.purs +++ /dev/null @@ -1,23 +0,0 @@ -module Type.Function where - --- | Polymorphic Type application --- | --- | For example... --- | ``` --- | APPLY Maybe Int == Maybe $ Int == Maybe Int --- | ``` -type APPLY :: forall a b. (a -> b) -> a -> b -type APPLY f a = f a - -infixr 0 type APPLY as $ - --- | Reversed polymorphic Type application --- | --- | For example... --- | ``` --- | FLIP Int Maybe == Int # Maybe == Maybe Int --- | ``` -type FLIP :: forall a b. a -> (a -> b) -> b -type FLIP a f = f a - -infixl 1 type FLIP as # diff --git a/stdlib/lib/Type/Prelude.purs b/stdlib/lib/Type/Prelude.purs deleted file mode 100644 index f67d0a26..00000000 --- a/stdlib/lib/Type/Prelude.purs +++ /dev/null @@ -1,17 +0,0 @@ -module Type.Prelude - ( module Type.Data.Boolean - , module Type.Data.Ordering - , module Type.Data.Symbol - , module Type.Equality - , module Type.Proxy - , module Type.Row - , module Type.RowList - ) where - -import Type.Data.Boolean (True, False, class IsBoolean, reflectBoolean, reifyBoolean) -import Type.Data.Ordering (Ordering, LT, EQ, GT, class IsOrdering, reflectOrdering, reifyOrdering) -import Type.Proxy (Proxy(..)) -import Type.Data.Symbol (class IsSymbol, reflectSymbol, reifySymbol, class Compare, compare, class Append, append) -import Type.Equality (class TypeEquals, from, to) -import Type.Row (class Union, class Lacks) -import Type.RowList (class RowToList, class ListToRow) diff --git a/stdlib/lib/Type/Proxy.purs b/stdlib/lib/Type/Proxy.purs deleted file mode 100644 index a3782fdd..00000000 --- a/stdlib/lib/Type/Proxy.purs +++ /dev/null @@ -1,53 +0,0 @@ --- | The `Proxy` type and values are for situations where type information is --- | required for an input to determine the type of an output, but where it is --- | not possible or convenient to provide a _value_ for the input. --- | --- | A hypothetical example: if you have a class that is used to handle the --- | result of an AJAX request, you may want to use this information to set the --- | expected content type of the request, so you might have a class something --- | like this: --- | --- | ``` purescript --- | class AjaxResponse a where --- | responseType :: a -> ResponseType --- | fromResponse :: Foreign -> a --- | ``` --- | --- | The problem here is `responseType` requires a value of type `a`, but we --- | won't have a value of that type until the request has been completed. The --- | solution is to use a `Proxy` type instead: --- | --- | ``` purescript --- | class AjaxResponse a where --- | responseType :: Proxy a -> ResponseType --- | fromResponse :: Foreign -> a --- | ``` --- | --- | We can now call `responseType (Proxy :: Proxy SomeContentType)` to produce --- | a `ResponseType` for `SomeContentType` without having to construct some --- | empty version of `SomeContentType` first. In situations like this where --- | the `Proxy` type can be statically determined, it is recommended to pull --- | out the definition to the top level and make a declaration like: --- | --- | ``` purescript --- | _SomeContentType :: Proxy SomeContentType --- | _SomeContentType = Proxy --- | ``` --- | --- | That way the proxy value can be used as `responseType _SomeContentType` --- | for improved readability. However, this is not always possible, sometimes --- | the type required will be determined by a type variable. As PureScript has --- | scoped type variables, we can do things like this: --- | --- | ``` purescript --- | makeRequest :: URL -> ResponseType -> Aff _ Foreign --- | makeRequest = ... --- | --- | fetchData :: forall a. (AjaxResponse a) => URL -> Aff _ a --- | fetchData url = fromResponse <$> makeRequest url (responseType (Proxy :: Proxy a)) --- | ``` -module Type.Proxy where - --- | Proxy type for all `kind`s. -data Proxy :: forall k. k -> Type -data Proxy a = Proxy diff --git a/stdlib/lib/Type/Row.purs b/stdlib/lib/Type/Row.purs deleted file mode 100644 index 101cb9d5..00000000 --- a/stdlib/lib/Type/Row.purs +++ /dev/null @@ -1,22 +0,0 @@ -module Type.Row - ( module Prim.Row - , RowApply - , type (+) - ) where - -import Prim.Row (class Lacks, class Nub, class Cons, class Union) - --- | Type application for rows. -type RowApply :: forall k. (Row k -> Row k) -> Row k -> Row k -type RowApply f a = f a - --- | Applies a type alias of open rows to a set of rows. The primary use case --- | this operator is as convenient sugar for combining open rows without --- | parentheses. --- | ```purescript --- | type Rows1 r = (a :: Int, b :: String | r) --- | type Rows2 r = (c :: Boolean | r) --- | type Rows3 r = (Rows1 + Rows2 + r) --- | type Rows4 r = (d :: String | Rows1 + Rows2 + r) --- | ``` -infixr 0 type RowApply as + diff --git a/stdlib/lib/Type/Row/Homogeneous.purs b/stdlib/lib/Type/Row/Homogeneous.purs deleted file mode 100644 index 69e1cb73..00000000 --- a/stdlib/lib/Type/Row/Homogeneous.purs +++ /dev/null @@ -1,23 +0,0 @@ -module Type.Row.Homogeneous - ( class Homogeneous - , class HomogeneousRowList - ) where - -import Type.Equality (class TypeEquals) -import Type.RowList (class RowToList, Cons, Nil, RowList) - --- | Ensure that every field in a row has the same type. -class Homogeneous :: forall k. Row k -> k -> Constraint -class Homogeneous row fieldType | row -> fieldType -instance homogeneous - :: ( RowToList row fields - , HomogeneousRowList fields fieldType ) - => Homogeneous row fieldType - -class HomogeneousRowList :: forall k. RowList k -> k -> Constraint -class HomogeneousRowList rowList fieldType | rowList -> fieldType -instance homogeneousRowListCons - :: ( HomogeneousRowList tail fieldType - , TypeEquals fieldType fieldType2 ) - => HomogeneousRowList (Cons symbol fieldType tail) fieldType2 -instance homogeneousRowListNil :: HomogeneousRowList Nil fieldType diff --git a/stdlib/lib/Type/RowList.purs b/stdlib/lib/Type/RowList.purs deleted file mode 100644 index 5a555422..00000000 --- a/stdlib/lib/Type/RowList.purs +++ /dev/null @@ -1,82 +0,0 @@ -module Type.RowList - ( module Prim.RowList - , class ListToRow - , class RowListRemove - , class RowListSet - , class RowListNub - , class RowListAppend - ) where - -import Prim.Row as Row -import Prim.RowList (RowList, Cons, Nil, class RowToList) -import Type.Equality (class TypeEquals) -import Type.Data.Symbol as Symbol -import Type.Data.Boolean as Boolean - --- | Convert a RowList to a row of types. --- | The inverse of this operation is `RowToList`. -class ListToRow :: forall k. RowList k -> Row k -> Constraint -class ListToRow list row | list -> row - -instance listToRowNil - :: ListToRow Nil () - -instance listToRowCons - :: ( ListToRow tail tailRow - , Row.Cons label ty tailRow row ) - => ListToRow (Cons label ty tail) row - --- | Remove all occurences of a given label from a RowList -class RowListRemove :: forall k. Symbol -> RowList k -> RowList k -> Constraint -class RowListRemove label input output | label input -> output - -instance rowListRemoveNil - :: RowListRemove label Nil Nil - -instance rowListRemoveCons - :: ( RowListRemove label tail tailOutput - , Symbol.Equals label key eq - , Boolean.If eq - tailOutput - (Cons key head tailOutput) - output - ) - => RowListRemove label (Cons key head tail) output - --- | Add a label to a RowList after removing other occurences. -class RowListSet :: forall k. Symbol -> k -> RowList k -> RowList k -> Constraint -class RowListSet label typ input output | label typ input -> output - -instance rowListSetImpl - :: ( TypeEquals label label' - , TypeEquals typ typ' - , RowListRemove label input lacking ) - => RowListSet label typ input (Cons label' typ' lacking) - --- | Remove label duplicates, keeps earlier occurrences. -class RowListNub :: forall k. RowList k -> RowList k -> Constraint -class RowListNub input output | input -> output - -instance rowListNubNil - :: RowListNub Nil Nil - -instance rowListNubCons - :: ( TypeEquals label label' - , TypeEquals head head' - , TypeEquals nubbed nubbed' - , RowListRemove label tail removed - , RowListNub removed nubbed ) - => RowListNub (Cons label head tail) (Cons label' head' nubbed') - --- Append two row lists together -class RowListAppend :: forall k. RowList k -> RowList k -> RowList k -> Constraint -class RowListAppend lhs rhs out | lhs rhs -> out - -instance rowListAppendNil - :: TypeEquals rhs out - => RowListAppend Nil rhs out - -instance rowListAppendCons - :: ( RowListAppend tail rhs out' - , TypeEquals (Cons label head out') out ) - => RowListAppend (Cons label head tail) rhs out diff --git a/stdlib/lib/Unsafe/Coerce.purs b/stdlib/lib/Unsafe/Coerce.purs deleted file mode 100644 index 6acc04db..00000000 --- a/stdlib/lib/Unsafe/Coerce.purs +++ /dev/null @@ -1,27 +0,0 @@ - -module Unsafe.Coerce - ( unsafeCoerce - ) where - --- | A _highly unsafe_ function, which can be used to persuade the type system that --- | any type is the same as any other type. When using this function, it is your --- | (that is, the caller's) responsibility to ensure that the underlying --- | representation for both types is the same. --- | --- | Because this function is extraordinarily flexible, type inference --- | can greatly suffer. It is highly recommended to define specializations of --- | this function rather than using it as-is. For example: --- | --- | ```purescript --- | fromBoolean :: Boolean -> Json --- | fromBoolean = unsafeCoerce --- | ``` --- | --- | This way, you won't have any nasty surprises due to the inferred type being --- | different to what you expected. --- | --- | After the v0.14.0 PureScript release, some of what was accomplished via --- | `unsafeCoerce` can now be accomplished via `coerce` from --- | `purescript-safe-coerce`. See that library's documentation for more --- | context. -foreign import unsafeCoerce :: forall a b. a -> b diff --git a/stdlib/lib/WASI.purs b/stdlib/lib/WASI.purs deleted file mode 100644 index 42e78885..00000000 --- a/stdlib/lib/WASI.purs +++ /dev/null @@ -1,102 +0,0 @@ --- | The WASI umbrella. A program that wants the common capabilities can --- | `import WASI` and use the consolidated public API. The filesystem and --- | socket surfaces are re-exported explicitly so their `error-code` enums do --- | not collide; their constructors stay available from the focused modules. -module WASI - ( module WASI.Resource - , module WASI.IO - , module WASI.Console - , module WASI.Clock - , module WASI.Random - , module WASI.Process - , Descriptor - , DirectoryEntryStream - , FileError(..) - , DescriptorType(..) - , Advice(..) - , NewTimestamp(..) - , preopens - , preopen - , openAt - , openRead - , openWrite - , openAppend - , readFile - , writeFile - , readViaStream - , writeViaStream - , appendViaStream - , writeString - , readString - , metadataHash - , metadataHashAt - , getFlags - , getType - , readlinkAt - , isSameObject - , createDirectoryAt - , removeDirectoryAt - , unlinkFileAt - , renameAt - , symlinkAt - , sync - , syncData - , setSize - , setTimes - , setTimesAt - , advise - , linkAt - , stat - , statAt - , readDirectory - , readDirectoryEntry - , dropDirectoryEntryStream - , filesystemErrorCode - , dropDescriptor - , withDescriptor - , Network - , TcpSocket - , UdpSocket - , IncomingDatagramStream - , OutgoingDatagramStream - , NetworkError(..) - , IpAddressFamily(..) - , IpSocketAddress(..) - , ShutdownType(..) - , instanceNetwork - , createTcpSocket - , createUdpSocket - , tcpStartBind - , tcpFinishBind - , tcpStartConnect - , tcpFinishConnect - , tcpStartListen - , tcpFinishListen - , tcpAccept - , tcpIsListening - , tcpAddressFamily - , tcpLocalAddress - , tcpRemoteAddress - , tcpShutdown - , tcpKeepAliveIdleTime - , udpStartBind - , udpFinishBind - , udpAddressFamily - , udpLocalAddress - , udpRemoteAddress - , udpSocketStream - , dropNetwork - , dropTcpSocket - , dropUdpSocket - , dropIncomingDatagramStream - , dropOutgoingDatagramStream - ) where - -import WASI.Resource -import WASI.IO -import WASI.Console -import WASI.Clock -import WASI.Random -import WASI.Process -import WASI.FileSystem -import WASI.Network diff --git a/stdlib/lib/WASI/Clock.purs b/stdlib/lib/WASI/Clock.purs deleted file mode 100644 index 1c96ea65..00000000 --- a/stdlib/lib/WASI/Clock.purs +++ /dev/null @@ -1,14 +0,0 @@ --- | Idiomatic wrappers over `wasi:clocks`: the monotonic and wall clocks, and --- | the two clock subscriptions that yield a `Resource Pollable`. -module WASI.Clock (now, wallNow, wallResolution, subscribeInstant, subscribeDuration) where - -import Prelude -import WASI.IO (Pollable) -import WASI.Resource (Resource) - -foreign import "wasi:clocks/monotonic-clock#now" now :: Effect (Int) -foreign import "wasi:clocks/wall-clock#now" wallNow :: Effect ({ seconds :: Int, nanoseconds :: Int }) -foreign import "wasi:clocks/wall-clock#resolution" wallResolution :: Effect ({ seconds :: Int, nanoseconds :: Int }) -foreign import "wasi:clocks/monotonic-clock#subscribe-instant" subscribeInstant :: Int -> Effect (Resource Pollable) -foreign import "wasi:clocks/monotonic-clock#subscribe-duration" subscribeDuration :: Int -> Effect (Resource Pollable) - diff --git a/stdlib/lib/WASI/Console.purs b/stdlib/lib/WASI/Console.purs deleted file mode 100644 index eb713d30..00000000 --- a/stdlib/lib/WASI/Console.purs +++ /dev/null @@ -1,33 +0,0 @@ --- | Convenience output over `WASI.IO`: write a line to standard output or --- | standard error and drop the stream. A failed write is ignored so the --- | public signature stays `String -> Effect Unit`. --- | --- | A WIT `list` is `Array Int`, not `String`, so the wrapper converts the --- | message through the canonical UTF-8 bytes --- | ([DEC-16](../../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). --- --- | `warn` joins `error` on the same stream. The platform layer owns the choice --- | of stream so `Effect.Console` stays a thin binding over it rather than a --- | second place that decides where a diagnostic goes --- | ([DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md)). -module WASI.Console (log, warn, error) where - -import Prelude -import WASI.IO (blockingWriteAndFlush, dropOutputStream, getStderr, getStdout) - -log :: String -> Effect Unit -log s = do - handle <- getStdout - _ <- blockingWriteAndFlush handle (stringToBytes s) - _ <- blockingWriteAndFlush handle (stringToBytes "\n") - dropOutputStream handle - -warn :: String -> Effect Unit -warn s = error s - -error :: String -> Effect Unit -error s = do - handle <- getStderr - _ <- blockingWriteAndFlush handle (stringToBytes s) - _ <- blockingWriteAndFlush handle (stringToBytes "\n") - dropOutputStream handle diff --git a/stdlib/lib/WASI/FileSystem.purs b/stdlib/lib/WASI/FileSystem.purs deleted file mode 100644 index 834f871e..00000000 --- a/stdlib/lib/WASI/FileSystem.purs +++ /dev/null @@ -1,270 +0,0 @@ --- | Idiomatic wrappers over `wasi:filesystem`. Raw imports stay module --- | private; the public API is expressed with `Resource a` handles and library --- | types (`Maybe`, `Either`, closed records, and an `error-code` ADT). Every --- | `result` maps to `Either` with the error on `Left`. -module WASI.FileSystem - ( Descriptor - , DirectoryEntryStream - , FileError(..) - , DescriptorType(..) - , Advice(..) - , NewTimestamp(..) - , preopens - , preopen - , openAt - , openRead - , openWrite - , openAppend - , readFile - , writeFile - , readViaStream - , writeViaStream - , appendViaStream - , writeString - , readString - , metadataHash - , metadataHashAt - , getFlags - , getType - , readlinkAt - , isSameObject - , createDirectoryAt - , removeDirectoryAt - , unlinkFileAt - , renameAt - , symlinkAt - , sync - , syncData - , setSize - , setTimes - , setTimesAt - , advise - , linkAt - , stat - , statAt - , readDirectory - , readDirectoryEntry - , dropDirectoryEntryStream - , filesystemErrorCode - , dropDescriptor - , withDescriptor - ) where - -import Prelude -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) -import WASI.IO (Error, InputStream, OutputStream, StreamError(..), blockingRead, blockingWriteAndFlush, dropError, dropInputStream, dropOutputStream) -import WASI.Resource (Resource) - --- | The opaque phantom naming a filesystem descriptor resource. -foreign import data Descriptor :: Type - --- | The opaque phantom naming a directory-entry stream resource. -foreign import data DirectoryEntryStream :: Type - --- | `error-code` returned by filesystem operations, mapped from the WIT enum. -data FileError - = Access - | WouldBlock - | Already - | BadDescriptor - | Busy - | Deadlock - | Quota - | Exist - | FileTooLarge - | IllegalByteSequence - | InProgress - | Interrupted - | Invalid - | Io - | IsDirectory - | Loop - | TooManyLinks - | MessageSize - | NameTooLong - | NoDevice - | NoEntry - | NoLock - | InsufficientMemory - | InsufficientSpace - | NotDirectory - | NotEmpty - | NotRecoverable - | Unsupported - | NoTty - | NoSuchDevice - | Overflow - | NotPermitted - | Pipe - | ReadOnly - | InvalidSeek - | TextFileBusy - | CrossDevice - --- | `descriptor-type`, mapped from the WIT enum. -data DescriptorType - = Unknown - | BlockDevice - | CharacterDevice - | Directory - | Fifo - | SymbolicLink - | RegularFile - | Socket - --- | `advice`, mapped from the WIT enum. -data Advice = Normal | Sequential | Random | WillNeed | DontNeed | NoReuse - --- | `new-timestamp` taken by `setTimes` and `setTimesAt`: leave the timestamp --- | unchanged, set it to now, or set it to a given `datetime`. -data NewTimestamp - = NoChange - | Now - | Timestamp { seconds :: Int, nanoseconds :: Int } - -defaultPathFlags :: { symlinkFollow :: Boolean } -defaultPathFlags = { symlinkFollow: true } - -defaultOpenFlags :: { create :: Boolean, directory :: Boolean, exclusive :: Boolean, truncate :: Boolean } -defaultOpenFlags = { create: false, directory: false, exclusive: false, truncate: false } - -defaultDescriptorFlags :: { read :: Boolean, write :: Boolean, fileIntegritySync :: Boolean, dataIntegritySync :: Boolean, requestedWriteSync :: Boolean, mutateDirectory :: Boolean } -defaultDescriptorFlags = { read: false, write: false, fileIntegritySync: false, dataIntegritySync: false, requestedWriteSync: false, mutateDirectory: false } - -foreign import "wasi:filesystem/preopens#get-directories" preopens :: Effect (Array { _1 :: Resource Descriptor, _2 :: String }) - --- | The preopened directories. The canonical ABI fixes a tuple's field names --- | to `_1`/`_2`, so each element carries the descriptor first and its path --- | second; `preopen` returns the friendlier named record for one entry. --- | The preopened directory at `index`, as a named record. -preopen :: Int -> Effect { descriptor :: Resource Descriptor, path :: String } -preopen index = - map (\entries -> - let entry = arrayIndex entries index in - { descriptor: entry._1, path: entry._2 } - ) preopens - -foreign import "wasi:filesystem/types#[method]descriptor.open-at" openAt :: Resource Descriptor -> { symlinkFollow :: Boolean } -> String -> { create :: Boolean, directory :: Boolean, exclusive :: Boolean, truncate :: Boolean } -> { read :: Boolean, write :: Boolean, fileIntegritySync :: Boolean, dataIntegritySync :: Boolean, requestedWriteSync :: Boolean, mutateDirectory :: Boolean } -> Effect (Either FileError (Resource Descriptor)) - -openRead :: Resource Descriptor -> String -> Effect (Either FileError (Resource Descriptor)) -openRead descriptor path = - openAt descriptor defaultPathFlags path defaultOpenFlags (defaultDescriptorFlags { read = true }) - -openWrite :: Resource Descriptor -> String -> Effect (Either FileError (Resource Descriptor)) -openWrite descriptor path = - openAt descriptor defaultPathFlags path (defaultOpenFlags { create = true, truncate = true }) (defaultDescriptorFlags { write = true }) - -openAppend :: Resource Descriptor -> String -> Effect (Either FileError (Resource Descriptor)) -openAppend descriptor path = - openAt descriptor defaultPathFlags path defaultOpenFlags (defaultDescriptorFlags { write = true }) - --- | Reads up to `length` bytes at `offset`. A WIT `list` is `Array Int`, --- | not `String`, so the payload carries uninterpreted bytes --- | ([DEC-16](../../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). -foreign import "wasi:filesystem/types#[method]descriptor.read" readRaw :: Resource Descriptor -> Int -> Int -> Effect (Either FileError { _1 :: Array Int, _2 :: Boolean }) - --- | Reads up to `length` bytes at `offset`. `Right` is the decoded byte --- | sequence, `Left` a `FileError`. -readFile :: Resource Descriptor -> Int -> Int -> Effect (Either FileError String) -readFile descriptor length offset = - bind (readRaw descriptor length offset) (\result -> - case result of - Right value -> - let bytes = value._1 - in pure (Right (bytesToString bytes)) - Left err -> pure (Left err)) - -foreign import "wasi:filesystem/types#[method]descriptor.write" writeFile :: Resource Descriptor -> Array Int -> Int -> Effect (Either FileError Int) - -foreign import "wasi:filesystem/types#[method]descriptor.read-via-stream" readViaStream :: Resource Descriptor -> Int -> Effect (Either FileError (Resource InputStream)) -foreign import "wasi:filesystem/types#[method]descriptor.write-via-stream" writeViaStream :: Resource Descriptor -> Int -> Effect (Either FileError (Resource OutputStream)) -foreign import "wasi:filesystem/types#[method]descriptor.append-via-stream" appendViaStream :: Resource Descriptor -> Effect (Either FileError (Resource OutputStream)) - -foreign import "wasi:filesystem/types#filesystem-error-code" filesystemErrorCode :: Resource Error -> Effect (Maybe FileError) - --- | Recovers a filesystem `error-code` from a stream operation failure. The --- | `Error` handle is borrowed by the WIT call. --- | Writes `contents` through an output stream. `Nothing` means the write --- | succeeded; `Just` is the error from opening the stream. The `Either` --- | returned by `blockingWriteAndFlush` is ignored here. -writeString :: Resource Descriptor -> String -> Effect (Maybe FileError) -writeString descriptor contents = - bind (writeViaStream descriptor 0) (\opened -> - case opened of - Left err -> pure (Just err) - Right stream -> - bind (blockingWriteAndFlush stream (stringToBytes contents)) (\ignored -> - bind (dropOutputStream stream) (\ignoredStream -> - pure Nothing))) - --- | Reads up to `length` bytes through an input stream. -readString :: Resource Descriptor -> Int -> Effect (Either FileError String) -readString descriptor length = - bind (readViaStream descriptor 0) (\opened -> - case opened of - Left err -> pure (Left err) - Right stream -> - bind (blockingRead stream length) (\contents -> - bind (dropInputStream stream) (\ignored -> - case contents of - Right bytes -> pure (Right (bytesToString bytes)) - Left (LastOperationFailed err) -> - bind (filesystemErrorCode err) (\code -> - bind (dropError err) (\ignoredError -> - case code of - Just fileError -> pure (Left fileError) - Nothing -> pure (Left Io))) - Left Closed -> pure (Left Io)))) - -foreign import "wasi:filesystem/types#[method]descriptor.metadata-hash" metadataHash :: Resource Descriptor -> Effect (Either FileError { lower :: Int, upper :: Int }) -foreign import "wasi:filesystem/types#[method]descriptor.metadata-hash-at" metadataHashAt :: Resource Descriptor -> { symlinkFollow :: Boolean } -> String -> Effect (Either FileError { lower :: Int, upper :: Int }) - -foreign import "wasi:filesystem/types#[method]descriptor.get-flags" getFlags :: Resource Descriptor -> Effect (Either FileError { read :: Boolean, write :: Boolean, fileIntegritySync :: Boolean, dataIntegritySync :: Boolean, requestedWriteSync :: Boolean, mutateDirectory :: Boolean }) - -foreign import "wasi:filesystem/types#[method]descriptor.get-type" getType :: Resource Descriptor -> Effect (Either FileError DescriptorType) - -foreign import "wasi:filesystem/types#[method]descriptor.readlink-at" readlinkAt :: Resource Descriptor -> String -> Effect (Either FileError String) - -foreign import "wasi:filesystem/types#[method]descriptor.is-same-object" isSameObject :: Resource Descriptor -> Resource Descriptor -> Effect (Boolean) - -foreign import "wasi:filesystem/types#[method]descriptor.stat" stat :: Resource Descriptor -> Effect (Either FileError { type :: DescriptorType, linkCount :: Int, size :: Int, dataAccessTimestamp :: Maybe { seconds :: Int, nanoseconds :: Int }, dataModificationTimestamp :: Maybe { seconds :: Int, nanoseconds :: Int }, statusChangeTimestamp :: Maybe { seconds :: Int, nanoseconds :: Int } }) -foreign import "wasi:filesystem/types#[method]descriptor.stat-at" statAt :: Resource Descriptor -> { symlinkFollow :: Boolean } -> String -> Effect (Either FileError { type :: DescriptorType, linkCount :: Int, size :: Int, dataAccessTimestamp :: Maybe { seconds :: Int, nanoseconds :: Int }, dataModificationTimestamp :: Maybe { seconds :: Int, nanoseconds :: Int }, statusChangeTimestamp :: Maybe { seconds :: Int, nanoseconds :: Int } }) - --- | The attributes of an open file or directory. --- | The attributes of a file or directory named by a relative path. -foreign import "wasi:filesystem/types#[method]descriptor.read-directory" readDirectory :: Resource Descriptor -> Effect (Either FileError (Resource DirectoryEntryStream)) -foreign import "wasi:filesystem/types#[method]directory-entry-stream.read-directory-entry" readDirectoryEntry :: Resource DirectoryEntryStream -> Effect (Either FileError (Maybe { type :: DescriptorType, name :: String })) -foreign import "wasi:filesystem/types#[resource-drop]directory-entry-stream" dropDirectoryEntryStream :: Resource DirectoryEntryStream -> Effect (Unit) - --- | Opens a fresh stream over the entries of a directory. --- | Reads the next entry from a directory stream. `Nothing` reports the end of --- | the stream. --- The remaining operations report `result<_, error-code>`, which DEC-13 maps --- to `Either FileError Unit`: `Right unit` on success, `Left` the error. -foreign import "wasi:filesystem/types#[method]descriptor.create-directory-at" createDirectoryAt :: Resource Descriptor -> String -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.remove-directory-at" removeDirectoryAt :: Resource Descriptor -> String -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.unlink-file-at" unlinkFileAt :: Resource Descriptor -> String -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.rename-at" renameAt :: Resource Descriptor -> String -> Resource Descriptor -> String -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.symlink-at" symlinkAt :: Resource Descriptor -> String -> String -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.sync" sync :: Resource Descriptor -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.sync-data" syncData :: Resource Descriptor -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.set-size" setSize :: Resource Descriptor -> Int -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.advise" advise :: Resource Descriptor -> Int -> Int -> Advice -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.link-at" linkAt :: Resource Descriptor -> { symlinkFollow :: Boolean } -> String -> Resource Descriptor -> String -> Effect (Either FileError Unit) - -foreign import "wasi:filesystem/types#[method]descriptor.set-times" setTimes :: Resource Descriptor -> NewTimestamp -> NewTimestamp -> Effect (Either FileError Unit) -foreign import "wasi:filesystem/types#[method]descriptor.set-times-at" setTimesAt :: Resource Descriptor -> { symlinkFollow :: Boolean } -> String -> NewTimestamp -> NewTimestamp -> Effect (Either FileError Unit) - --- | Adjusts the access and modification timestamps of an open file or --- | directory. `Right unit` reports success; `Left` is the `FileError`. --- | Adjusts the timestamps of a file or directory named by a relative path. -foreign import "wasi:filesystem/types#[resource-drop]descriptor" dropDescriptor :: Resource Descriptor -> Effect (Unit) - --- | Runs `action` with `descriptor`, then drops it. The descriptor is always --- | released once `action` completes. -withDescriptor :: forall a. Resource Descriptor -> (Resource Descriptor -> Effect a) -> Effect a -withDescriptor descriptor action = - bind (action descriptor) \result -> - bind (dropDescriptor descriptor) \_ -> - pure result diff --git a/stdlib/lib/WASI/IO.purs b/stdlib/lib/WASI/IO.purs deleted file mode 100644 index 2c31a297..00000000 --- a/stdlib/lib/WASI/IO.purs +++ /dev/null @@ -1,67 +0,0 @@ --- | Idiomatic wrappers over `wasi:io`. This module merges the former --- | `WASI.Streams`, `WASI.Poll`, `WASI.Error`, and `WASI.Stdin`: the streams, --- | the pollable, and the error resource. Raw imports stay module private; the --- | public API uses `Resource a` for every handle and `Data.Either` for every --- | `result`, with the error on `Left`. -module WASI.IO - ( InputStream - , OutputStream - , Pollable - , Error - , StreamError(..) - , getStdin - , getStdout - , getStderr - , read - , blockingRead - , skip - , blockingSkip - , write - , blockingWriteAndFlush - , flush - , subscribeInputStream - , subscribeOutputStream - , toDebugString - , poll - , ready - , block - , dropInputStream - , dropOutputStream - , dropPollable - , dropError - ) where - -import Prelude -import Data.Either (Either) -import WASI.Resource (Resource) - --- | Opaque phantom types naming the resources a `Resource` may wrap. They are --- | not handle types themselves: every value is a `Resource X`. -foreign import data InputStream :: Type -foreign import data OutputStream :: Type -foreign import data Pollable :: Type -foreign import data Error :: Type - -data StreamError = LastOperationFailed (Resource Error) | Closed - -foreign import "wasi:cli/stdin#get-stdin" getStdin :: Effect (Resource InputStream) -foreign import "wasi:cli/stdout#get-stdout" getStdout :: Effect (Resource OutputStream) -foreign import "wasi:cli/stderr#get-stderr" getStderr :: Effect (Resource OutputStream) -foreign import "wasi:io/streams#[method]input-stream.read" read :: Resource InputStream -> Int -> Effect (Either StreamError (Array Int)) -foreign import "wasi:io/streams#[method]input-stream.blocking-read" blockingRead :: Resource InputStream -> Int -> Effect (Either StreamError (Array Int)) -foreign import "wasi:io/streams#[method]input-stream.skip" skip :: Resource InputStream -> Int -> Effect (Either StreamError Int) -foreign import "wasi:io/streams#[method]input-stream.blocking-skip" blockingSkip :: Resource InputStream -> Int -> Effect (Either StreamError Int) -foreign import "wasi:io/streams#[method]output-stream.write" write :: Resource OutputStream -> Array Int -> Effect (Either StreamError Unit) -foreign import "wasi:io/streams#[method]output-stream.blocking-write-and-flush" blockingWriteAndFlush :: Resource OutputStream -> Array Int -> Effect (Either StreamError Unit) -foreign import "wasi:io/streams#[method]output-stream.flush" flush :: Resource OutputStream -> Effect (Either StreamError Unit) -foreign import "wasi:io/streams#[method]input-stream.subscribe" subscribeInputStream :: Resource InputStream -> Effect (Resource Pollable) -foreign import "wasi:io/streams#[method]output-stream.subscribe" subscribeOutputStream :: Resource OutputStream -> Effect (Resource Pollable) -foreign import "wasi:io/error#[method]error.to-debug-string" toDebugString :: Resource Error -> Effect (String) -foreign import "wasi:io/poll#poll" poll :: Array (Resource Pollable) -> Effect (Array Int) -foreign import "wasi:io/poll#[method]pollable.ready" ready :: Resource Pollable -> Effect (Boolean) -foreign import "wasi:io/poll#[method]pollable.block" block :: Resource Pollable -> Effect (Unit) -foreign import "wasi:io/streams#[resource-drop]input-stream" dropInputStream :: Resource InputStream -> Effect (Unit) -foreign import "wasi:io/streams#[resource-drop]output-stream" dropOutputStream :: Resource OutputStream -> Effect (Unit) -foreign import "wasi:io/poll#[resource-drop]pollable" dropPollable :: Resource Pollable -> Effect (Unit) -foreign import "wasi:io/error#[resource-drop]error" dropError :: Resource Error -> Effect (Unit) - diff --git a/stdlib/lib/WASI/Network.purs b/stdlib/lib/WASI/Network.purs deleted file mode 100644 index ba1a55e0..00000000 --- a/stdlib/lib/WASI/Network.purs +++ /dev/null @@ -1,130 +0,0 @@ --- | Idiomatic wrappers over `wasi:sockets`. Raw imports stay module private; --- | the public API is expressed with `Resource a` handles and library types --- | (`Maybe`, `Either`, closed records, and ADTs). Every `result` maps to --- | `Either` with the error on `Left`. --- | --- | The address-returning methods (`local-address`, `remote-address`) and the --- | datagram stream operation are exposed; their canonical memory layout is --- | modeled by the backend. -module WASI.Network - ( Network - , TcpSocket - , UdpSocket - , IncomingDatagramStream - , OutgoingDatagramStream - , NetworkError(..) - , IpAddressFamily(..) - , IpSocketAddress(..) - , ShutdownType(..) - , instanceNetwork - , createTcpSocket - , createUdpSocket - , tcpStartBind - , tcpFinishBind - , tcpStartConnect - , tcpFinishConnect - , tcpStartListen - , tcpFinishListen - , tcpAccept - , tcpIsListening - , tcpAddressFamily - , tcpLocalAddress - , tcpRemoteAddress - , tcpShutdown - , tcpKeepAliveIdleTime - , udpStartBind - , udpFinishBind - , udpAddressFamily - , udpLocalAddress - , udpRemoteAddress - , udpSocketStream - , dropNetwork - , dropTcpSocket - , dropUdpSocket - , dropIncomingDatagramStream - , dropOutgoingDatagramStream - ) where - -import Prelude -import Data.Either (Either(..)) -import Data.Maybe (Maybe) -import WASI.IO (InputStream, OutputStream) -import WASI.Resource (Resource) - --- | Opaque phantom types naming the socket resources a `Resource` may wrap. -foreign import data Network :: Type -foreign import data TcpSocket :: Type -foreign import data UdpSocket :: Type -foreign import data IncomingDatagramStream :: Type -foreign import data OutgoingDatagramStream :: Type - --- | `error-code`, mapped from the WIT enum. -data NetworkError - = Unknown - | AccessDenied - | NotSupported - | InvalidArgument - | OutOfMemory - | Timeout - | ConcurrencyConflict - | NotInProgress - | WouldBlock - | InvalidState - | NewSocketLimit - | AddressNotBindable - | AddressInUse - | RemoteUnreachable - | ConnectionRefused - | ConnectionReset - | ConnectionAborted - | DatagramTooLarge - | NameUnresolvable - | TemporaryResolverFailure - | PermanentResolverFailure - --- | `ip-address-family`, mapped from the WIT enum. -data IpAddressFamily = Ipv4 | Ipv6 - --- | `ip-socket-address`, mapped from the WIT variant. The constructor names --- | are library-chosen; the ABI matches variant cases by position. -data IpSocketAddress - = IpV4SocketAddress { port :: Int, address :: { _1 :: Int, _2 :: Int, _3 :: Int, _4 :: Int } } - | IpV6SocketAddress { port :: Int, flowInfo :: Int, address :: { _1 :: Int, _2 :: Int, _3 :: Int, _4 :: Int, _5 :: Int, _6 :: Int, _7 :: Int, _8 :: Int }, scopeId :: Int } - --- | `shutdown-type`, mapped from the WIT enum. -data ShutdownType = Receive | Send | Both - -foreign import "wasi:sockets/instance-network#instance-network" instanceNetwork :: Effect (Resource Network) - -foreign import "wasi:sockets/tcp-create-socket#create-tcp-socket" createTcpSocket :: IpAddressFamily -> Effect (Either NetworkError (Resource TcpSocket)) -foreign import "wasi:sockets/udp-create-socket#create-udp-socket" createUdpSocket :: IpAddressFamily -> Effect (Either NetworkError (Resource UdpSocket)) - -foreign import "wasi:sockets/tcp#[method]tcp-socket.start-bind" tcpStartBind :: Resource TcpSocket -> Resource Network -> IpSocketAddress -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/tcp#[method]tcp-socket.finish-bind" tcpFinishBind :: Resource TcpSocket -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/tcp#[method]tcp-socket.start-connect" tcpStartConnect :: Resource TcpSocket -> Resource Network -> IpSocketAddress -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/tcp#[method]tcp-socket.start-listen" tcpStartListen :: Resource TcpSocket -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/tcp#[method]tcp-socket.finish-listen" tcpFinishListen :: Resource TcpSocket -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/tcp#[method]tcp-socket.shutdown" tcpShutdown :: Resource TcpSocket -> ShutdownType -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/tcp#[method]tcp-socket.finish-connect" tcpFinishConnect :: Resource TcpSocket -> Effect (Either NetworkError { _1 :: Resource InputStream, _2 :: Resource OutputStream }) -foreign import "wasi:sockets/tcp#[method]tcp-socket.accept" tcpAccept :: Resource TcpSocket -> Effect (Either NetworkError { _1 :: Resource TcpSocket, _2 :: Resource InputStream, _3 :: Resource OutputStream }) -foreign import "wasi:sockets/tcp#[method]tcp-socket.is-listening" tcpIsListening :: Resource TcpSocket -> Effect (Boolean) -foreign import "wasi:sockets/tcp#[method]tcp-socket.address-family" tcpAddressFamily :: Resource TcpSocket -> Effect (IpAddressFamily) -foreign import "wasi:sockets/tcp#[method]tcp-socket.local-address" tcpLocalAddress :: Resource TcpSocket -> Effect (Either NetworkError IpSocketAddress) -foreign import "wasi:sockets/tcp#[method]tcp-socket.remote-address" tcpRemoteAddress :: Resource TcpSocket -> Effect (Either NetworkError IpSocketAddress) -foreign import "wasi:sockets/tcp#[method]tcp-socket.keep-alive-idle-time" tcpKeepAliveIdleTime :: Resource TcpSocket -> Effect (Either NetworkError Int) - -foreign import "wasi:sockets/udp#[method]udp-socket.start-bind" udpStartBind :: Resource UdpSocket -> Resource Network -> IpSocketAddress -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/udp#[method]udp-socket.finish-bind" udpFinishBind :: Resource UdpSocket -> Effect (Either NetworkError Unit) -foreign import "wasi:sockets/udp#[method]udp-socket.address-family" udpAddressFamily :: Resource UdpSocket -> Effect (IpAddressFamily) -foreign import "wasi:sockets/udp#[method]udp-socket.local-address" udpLocalAddress :: Resource UdpSocket -> Effect (Either NetworkError IpSocketAddress) -foreign import "wasi:sockets/udp#[method]udp-socket.remote-address" udpRemoteAddress :: Resource UdpSocket -> Effect (Either NetworkError IpSocketAddress) -foreign import "wasi:sockets/udp#[method]udp-socket.stream" udpSocketStream :: Resource UdpSocket -> Maybe IpSocketAddress -> Effect (Either NetworkError { _1 :: Resource IncomingDatagramStream, _2 :: Resource OutgoingDatagramStream }) - --- | Connects the UDP socket to an optional remote address and returns the --- | incoming and outgoing datagram streams. -foreign import "wasi:sockets/network#[resource-drop]network" dropNetwork :: Resource Network -> Effect (Unit) -foreign import "wasi:sockets/tcp#[resource-drop]tcp-socket" dropTcpSocket :: Resource TcpSocket -> Effect (Unit) -foreign import "wasi:sockets/udp#[resource-drop]udp-socket" dropUdpSocket :: Resource UdpSocket -> Effect (Unit) -foreign import "wasi:sockets/udp#[resource-drop]incoming-datagram-stream" dropIncomingDatagramStream :: Resource IncomingDatagramStream -> Effect (Unit) -foreign import "wasi:sockets/udp#[resource-drop]outgoing-datagram-stream" dropOutgoingDatagramStream :: Resource OutgoingDatagramStream -> Effect (Unit) - diff --git a/stdlib/lib/WASI/Process.purs b/stdlib/lib/WASI/Process.purs deleted file mode 100644 index 4eedc626..00000000 --- a/stdlib/lib/WASI/Process.purs +++ /dev/null @@ -1,13 +0,0 @@ --- | Idiomatic wrappers over `wasi:cli`: process exit and the command-line --- | arguments and environment. This module merges the former `WASI.Exit` and --- | `WASI.Environment`. -module WASI.Process (exitWithCode, arguments, environment) where - -import Prelude - -foreign import "wasi:cli/exit#exit-with-code" exitWithCode :: Int -> Effect (Unit) -foreign import "wasi:cli/environment#get-arguments" arguments :: Effect (Array String) -foreign import "wasi:cli/environment#get-environment" environment :: Effect (Array { _1 :: String, _2 :: String }) - --- | The environment variables, each a `(name, value)` pair. The canonical ABI --- | fixes a tuple's field names to `_1`/`_2`. diff --git a/stdlib/lib/WASI/Random.purs b/stdlib/lib/WASI/Random.purs deleted file mode 100644 index a10c7e8f..00000000 --- a/stdlib/lib/WASI/Random.purs +++ /dev/null @@ -1,16 +0,0 @@ -module WASI.Random - ( randomBytes - , randomU64 - , insecureBytes - , insecureU64 - , insecureSeed - ) where - -import Prelude - -foreign import "wasi:random/random#get-random-bytes" randomBytes :: Int -> Effect (Array Int) -foreign import "wasi:random/random#get-random-u64" randomU64 :: Effect (Int) -foreign import "wasi:random/insecure#get-insecure-random-bytes" insecureBytes :: Int -> Effect (Array Int) -foreign import "wasi:random/insecure#get-insecure-random-u64" insecureU64 :: Effect (Int) -foreign import "wasi:random/insecure-seed#insecure-seed" insecureSeed :: Effect ({ _1 :: Int, _2 :: Int }) - diff --git a/stdlib/lib/WASI/Resource.purs b/stdlib/lib/WASI/Resource.purs deleted file mode 100644 index eaec8e64..00000000 --- a/stdlib/lib/WASI/Resource.purs +++ /dev/null @@ -1,14 +0,0 @@ -module WASI.Resource (Resource(..), unResource, withResource) where - -import Prelude - -newtype Resource a = Resource Int - -unResource :: forall a. Resource a -> Int -unResource (Resource index) = index - -withResource :: forall a b. (Resource a -> Effect Unit) -> Resource a -> (Resource a -> Effect b) -> Effect b -withResource release resource action = - bind (action resource) \result -> - bind (release resource) \_ -> - pure result diff --git a/stdlib/lib/trusted b/stdlib/lib/trusted deleted file mode 100644 index 23289f93..00000000 --- a/stdlib/lib/trusted +++ /dev/null @@ -1,218 +0,0 @@ -# Trusted standard-library modules, in load order. -# Official sources retain their public contracts; target adaptations follow -# docs/workflow/stdlib-vendoring.md. Unsupported foreign values are not stubbed. -Prelude -Control.Alt -Control.Alternative -Control.Applicative -Control.Apply -Control.Biapplicative -Control.Biapply -Control.Bind -Control.Category -Control.Comonad -Control.Extend -Control.Lazy -Control.Monad -Control.Monad.Gen -Control.Monad.Gen.Class -Control.Monad.Gen.Common -Control.Monad.Rec.Class -Control.Monad.ST -Control.Monad.ST.Class -Control.Monad.ST.Global -Control.Monad.ST.Internal -Control.Monad.ST.Ref -Control.Monad.ST.Uncurried -Control.MonadPlus -Control.Plus -Control.Semigroupoid -Data.Array -Data.Array.NonEmpty -Data.Array.NonEmpty.Internal -Data.Array.Partial -Data.Array.ST -Data.Array.ST.Iterator -Data.Array.ST.Partial -Data.Bifoldable -Data.Bifunctor -Data.Bifunctor.Join -Data.Bitraversable -Data.Boolean -Data.BooleanAlgebra -Data.Bounded -Data.Bounded.Generic -Data.Char -Data.Char.Gen -Data.CommutativeRing -Data.Compactable -Data.Comparison -Data.Const -Data.Decidable -Data.Decide -Data.Distributive -Data.Divide -Data.Divisible -Data.DivisionRing -Data.Either -Data.Either.Inject -Data.Either.Nested -Data.Enum -Data.Enum.Gen -Data.Enum.Generic -Data.Eq -Data.Eq.Generic -Data.Equivalence -Data.EuclideanRing -Data.Exists -Data.Field -Data.Filterable -Data.Foldable -Data.FoldableWithIndex -Data.Function -Data.Function.Uncurried -Data.Functor -Data.Functor.App -Data.Functor.Clown -Data.Functor.Compose -Data.Functor.Contravariant -Data.Functor.Coproduct -Data.Functor.Coproduct.Inject -Data.Functor.Coproduct.Nested -Data.Functor.Costar -Data.Functor.Flip -Data.Functor.Invariant -Data.Functor.Joker -Data.Functor.Product -Data.Functor.Product.Nested -Data.Functor.Product2 -Data.FunctorWithIndex -Data.Generic.Rep -Data.HeytingAlgebra -Data.HeytingAlgebra.Generic -Data.Identity -Data.Int -Data.Int.Bits -Data.Lazy -Data.List -Data.List.Internal -Data.List.Lazy -Data.List.Lazy.NonEmpty -Data.List.Lazy.Types -Data.List.NonEmpty -Data.List.Partial -Data.List.Types -Data.List.ZipList -Data.Map -Data.Map.Gen -Data.Map.Internal -Data.Maybe -Data.Maybe.First -Data.Maybe.Last -Data.Monoid -Data.Monoid.Additive -Data.Monoid.Alternate -Data.Monoid.Conj -Data.Monoid.Disj -Data.Monoid.Dual -Data.Monoid.Endo -Data.Monoid.Generic -Data.Monoid.Multiplicative -Data.NaturalTransformation -Data.Newtype -Data.NonEmpty -Data.Number -Data.Number.Approximate -Data.Number.Format -Data.Op -Data.Ord -Data.Ord.Down -Data.Ord.Generic -Data.Ord.Max -Data.Ord.Min -Data.Ordering -Data.Predicate -Data.Profunctor -Data.Profunctor.Choice -Data.Profunctor.Closed -Data.Profunctor.Cochoice -Data.Profunctor.Costrong -Data.Profunctor.Join -Data.Profunctor.Split -Data.Profunctor.Star -Data.Profunctor.Strong -Data.Reflectable -Data.Ring -Data.Ring.Generic -Data.Semigroup -Data.Semigroup.First -Data.Semigroup.Foldable -Data.Semigroup.Generic -Data.Semigroup.Last -Data.Semigroup.Traversable -Data.Semiring -Data.Semiring.Generic -Data.Set -Data.Set.NonEmpty -Data.Show -Data.Show.Generic -Data.String -Data.String.CaseInsensitive -Data.String.CodePoints -Data.String.CodeUnits -Data.String.Common -Data.String.Gen -Data.String.NonEmpty -Data.String.NonEmpty.CaseInsensitive -Data.String.NonEmpty.CodePoints -Data.String.NonEmpty.CodeUnits -Data.String.NonEmpty.Internal -Data.String.Pattern -Data.String.Regex -Data.String.Regex.Flags -Data.String.Regex.Unsafe -Data.String.Unsafe -Data.Symbol -Data.Traversable -Data.Traversable.Accum -Data.Traversable.Accum.Internal -Data.TraversableWithIndex -Data.Tuple -Data.Tuple.Nested -Data.Unfoldable -Data.Unfoldable1 -Data.Unit -Data.Void -Data.Witherable -Effect -Effect.Class -Effect.Class.Console -Effect.Console -Effect.Ref -Effect.Uncurried -Effect.Unsafe -Partial -Partial.Unsafe -Record.Unsafe -Safe.Coerce -Test.Assert -Type.Data.Boolean -Type.Data.Ordering -Type.Data.Symbol -Type.Equality -Type.Function -Type.Prelude -Type.Proxy -Type.Row -Type.Row.Homogeneous -Type.RowList -Unsafe.Coerce -WASI.Resource -WASI.IO -WASI.Clock -WASI.Random -WASI.Console -WASI.Process -WASI.FileSystem -WASI.Network -WASI diff --git a/tools/stdlib-conformance/pyproject.toml b/tools/stdlib-conformance/pyproject.toml new file mode 100644 index 00000000..bf142dba --- /dev/null +++ b/tools/stdlib-conformance/pyproject.toml @@ -0,0 +1,19 @@ +[build-system] +requires = ["setuptools>=68"] +build-backend = "setuptools.build_meta" + +[project] +name = "psrs-stdlib-conformance" +version = "0.1.0" +description = "Independent PureScript source fidelity and target conformance tools" +requires-python = ">=3.9" +dependencies = [] + +[project.scripts] +psrs-stdlib-conformance = "stdlib_conformance.cli:main" + +[tool.setuptools.packages.find] +where = ["src"] + +[tool.setuptools.package-data] +stdlib_conformance = ["*.mjs"] diff --git a/tools/stdlib-conformance/src/stdlib_conformance/__init__.py b/tools/stdlib-conformance/src/stdlib_conformance/__init__.py new file mode 100644 index 00000000..045d6956 --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/__init__.py @@ -0,0 +1 @@ +"""Conformance tools with no compiler-library or workspace dependency.""" diff --git a/tools/stdlib-conformance/src/stdlib_conformance/__main__.py b/tools/stdlib-conformance/src/stdlib_conformance/__main__.py new file mode 100644 index 00000000..eb53e2f3 --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/__main__.py @@ -0,0 +1,3 @@ +from .cli import main + +raise SystemExit(main()) diff --git a/tools/stdlib-conformance/src/stdlib_conformance/audit.py b/tools/stdlib-conformance/src/stdlib_conformance/audit.py new file mode 100644 index 00000000..1da23ba5 --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/audit.py @@ -0,0 +1,245 @@ +#!/usr/bin/env python3 +"""Compare vendored modules with locally available, tagged upstream checkouts. + +This is an inventory, not an allowlist or a PureScript semantic verifier. +It never modifies library sources and never downloads missing dependencies. +""" + +import argparse +import collections +import difflib +import hashlib +import json +from pathlib import Path +import re +import subprocess + + +def git(root, *args): + return subprocess.check_output( + ["git", "-C", str(root), *args], text=True, stderr=subprocess.PIPE + ).strip() + + +def digest(data): + return hashlib.sha256(data).hexdigest() + + +def append_diff(patch, original, vendored, before_path, after_path): + differences = difflib.unified_diff( + original.splitlines(keepends=True), vendored.splitlines(keepends=True), + fromfile=before_path, tofile=after_path, + ) + for line in differences: + patch.append(line if line.endswith("\n") else line + "\n\\ No newline at end of file\n") + + +def foreign_declarations(text): + lines = text.splitlines() + declarations = [] + covered = set() + for index, line in enumerate(lines): + match = re.match(r"^foreign import (?!data\b)([\w']+)\b", line) + if not match: + continue + end = index + 1 + while end < len(lines) and lines[end].startswith((" ", "\t")): + end += 1 + covered.update(range(index, end)) + declarations.append({ + "name": match[1], + "line": index + 1, + "declaration": " ".join(part.strip() for part in lines[index:end]), + }) + return declarations, covered + + +def self_recursions(text): + result = [] + for number, line in enumerate(text.splitlines(), 1): + match = re.fullmatch( + r"([A-Za-z_][\w']*(?:\s+[A-Za-z_][\w']*)*)\s*=\s*(.*?)\s*", + line, + ) + if match and match[1].split() == match[2].split(): + result.append({"name": match[1].split()[0], "line": number, "equation": line}) + return result + + +def ordinary_removals(before, after, foreign_lines): + """Report changed original code outside value FFI declaration spans. + + This deliberately reports eta expansion and signature/layout changes too. + A reported removal requires review; it does not automatically prove a bug. + """ + old, new = before.splitlines(), after.splitlines() + result = [] + for kind, start, end, _, _ in difflib.SequenceMatcher( + None, old, new, autojunk=False + ).get_opcodes(): + if kind not in ("delete", "replace"): + continue + for index in range(start, end): + line = old[index] + if index not in foreign_lines and line.strip() and not line.lstrip().startswith("--"): + result.append({"line": index + 1, "text": line}) + return result + + +def main(argv=None): + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument("--vendor", type=Path, required=True) + parser.add_argument("--upstream", type=Path, action="append", required=True, + help="A git checkout with src/, or a directory of those checkouts") + parser.add_argument("--out", type=Path, required=True) + parser.add_argument("--inventory", type=Path, help="Pinned upstream package inventory") + args = parser.parse_args(argv) + pins = json.loads(args.inventory.read_text())["packages"] if args.inventory else None + args.out.mkdir(parents=True, exist_ok=True) + roots = [] + for root in args.upstream: + if (root / "src").is_dir(): + roots.append(root) + else: + roots.extend(child for child in sorted(root.iterdir()) if (child / "src").is_dir()) + + packages, sources = [], {} + for root in roots: + if git(root, "status", "--porcelain"): + raise SystemExit(f"upstream checkout is dirty: {root}") + package = { + "name": root.name, + "checkout": str(root.resolve()), + "commit": git(root, "rev-parse", "HEAD"), + "tag": git(root, "describe", "--tags", "--exact-match"), + "remote": git(root, "remote", "get-url", "origin"), + } + if pins is not None: + pin = next((pin for pin in pins if pin["name"] == package["name"]), None) + if pin is None or any(pin[key] != package[key] for key in ("commit", "tag", "remote")): + raise SystemExit(f"upstream checkout differs from package pin: {root}") + packages.append(package) + for path in sorted((root / "src").rglob("*.purs")): + relative = path.relative_to(root / "src").as_posix() + if relative in sources: + raise SystemExit(f"duplicate upstream source: {relative}") + sources[relative] = (path, package) + + if pins is not None and {pin["name"] for pin in pins} != {package["name"] for package in packages}: + raise SystemExit("upstream checkout set does not cover every pinned package") + + modules, patch = [], [] + for path in sorted(args.vendor.rglob("*.purs")): + relative = path.relative_to(args.vendor).as_posix() + data = path.read_bytes() + text = data.decode("utf-8") + row = { + "path": relative, + "vendored_sha256": digest(data), + "vendored_lines": len(text.splitlines()), + "self_recursions": self_recursions(text), + } + if relative not in sources: + row["status"] = "platform_addition" if relative.startswith("WASI/") or relative == "WASI.purs" else "baseline_unavailable" + modules.append(row) + continue + upstream, package = sources[relative] + original_data = upstream.read_bytes() + original = original_data.decode("utf-8") + row.update({ + "package": package["name"], + "tag": package["tag"], + "commit": package["commit"], + "upstream_sha256": digest(original_data), + "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, + "status": "identical" if data == original_data else "newline_only" if original.splitlines() == text.splitlines() else "modified", + }) + declarations, covered = foreign_declarations(original) + names = {declaration["name"] for declaration in declarations} + recursive_names = {recursion["name"] for recursion in row["self_recursions"]} + retained_foreign_names = set(re.findall( + r'^foreign import (?:"[^"\n]*"\s+)?(?!data\b)([\w\x27]+)\b', text, re.M + )) + for declaration in declarations: + name = declaration["name"] + declaration["vendored_status"] = ( + "foreign_declaration_retained" if name in retained_foreign_names else + "direct_self_recursion" if name in recursive_names else + "nonrecursive_replacement" if re.search(r"^" + re.escape(name) + r"\s*::", text, re.M) else + "declaration_removed" + ) + row["upstream_value_foreign_declarations"] = declarations + for recursion in row["self_recursions"]: + recursion["replaces_upstream_foreign"] = recursion["name"] in names + row["changed_original_code_outside_value_ffi"] = ordinary_removals(original, text, covered) + if data != original_data: + append_diff(patch, original, text, + package["name"] + "@" + package["tag"] + "/src/" + relative, + "vendor/" + relative) + modules.append(row) + + absent_modules = [] + absent_paths = sorted(set(sources) - {row["path"] for row in modules}) + for relative in absent_paths: + path, package = sources[relative] + data = path.read_bytes() + absent_modules.append({ + "path": relative, + "package": package["name"], + "tag": package["tag"], + "commit": package["commit"], + "upstream_sha256": digest(data), + "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, + }) + append_diff(patch, data.decode("utf-8"), "", + package["name"] + "@" + package["tag"] + "/src/" + relative, + "/dev/null") + + counts = dict(collections.Counter(row["status"] for row in modules)) + counts.update({ + "vendored_modules": len(modules), + "packages": len(packages), + "direct_self_recursions": sum(len(row["self_recursions"]) for row in modules), + "modules_with_direct_self_recursions": sum(bool(row["self_recursions"]) for row in modules), + "upstream_modules_absent_from_vendor": absent_paths, + "upstream_value_foreign_declarations": dict(collections.Counter( + declaration["vendored_status"] for row in modules + for declaration in row.get("upstream_value_foreign_declarations", []) + )), + }) + try: + vendor_revision = git(args.vendor.resolve(), "rev-parse", "HEAD") + except subprocess.CalledProcessError: + vendor_revision = None + result = { + "schema_version": 2, + "vendor_revision": vendor_revision, + "counts": counts, + "packages": packages, + "modules": modules, + "absent_modules": absent_modules, + "limits": [ + "Only supplied upstream checkouts are compared; baseline_unavailable is not a pass.", + "Self-recursion detection covers exact top-level same-argument equations only.", + "The script records differences without approving target adaptations or proving semantic equivalence.", + "The official compiler support dependency ranges do not uniquely pin package patch versions.", + ], + } + (args.out / "inventory.json").write_text(json.dumps(result, ensure_ascii=False, indent=2) + "\n") + (args.out / "official-vs-vendored.diff").write_text("".join(patch)) + table = ["# Vendored module inventory", "", "Generated by `audit-stdlib-vendor.py`. Status is comparison evidence, not approval.", "", + "| Module path | Official package/tag | Comparison | Direct self-recursions |", "| --- | --- | --- | --- |"] + for row in modules: + origin = row.get("package", "unavailable") + (" " + row["tag"] if "tag" in row else "") + table.append(f"| `{row['path']}` | {origin} | {row['status']} | {len(row['self_recursions'])} |") + if absent_modules: + table.extend(["", "## Official modules absent from the vendored library", "", + "| Module path | Official package/tag |", "| --- | --- |"]) + for row in absent_modules: + table.append(f"| `{row['path']}` | {row['package']} {row['tag']} |") + (args.out / "modules.md").write_text("\n".join(table) + "\n") + print(json.dumps(counts, ensure_ascii=False, indent=2)) + + +if __name__ == "__main__": + main() diff --git a/tools/stdlib-conformance/src/stdlib_conformance/cli.py b/tools/stdlib-conformance/src/stdlib_conformance/cli.py new file mode 100644 index 00000000..59cad367 --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/cli.py @@ -0,0 +1,23 @@ +"""Standalone command boundary for source and runtime evidence.""" + +import argparse +from pathlib import Path +import subprocess + +from . import audit + + +def main(argv=None): + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument("command", choices=["audit", "scalar-oracle", "run"]) + parser.add_argument("arguments", nargs=argparse.REMAINDER) + args = parser.parse_args(argv) + remaining = args.arguments + if args.command == "audit": + audit.main(remaining) + return 0 + if args.command == "scalar-oracle": + script = Path(__file__).with_name("scalar_oracle.mjs") + return subprocess.call(["node", str(script), *remaining]) + from .runner import main as run + return run(remaining) diff --git a/tools/stdlib-conformance/src/stdlib_conformance/package.py b/tools/stdlib-conformance/src/stdlib_conformance/package.py new file mode 100644 index 00000000..275cde1f --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/package.py @@ -0,0 +1,37 @@ +"""Portable package content identity shared with the compiler loader.""" + +from pathlib import Path + + +def fingerprint(root): + root = Path(root) + paths = [Path('manifest.json'), Path('upstream-lock.json')] + for directory in ('lib', 'conformance'): + if (root / directory).is_symlink(): + raise ValueError(f'package symlinks are unsupported: {directory}') + if not (root / directory).is_dir(): + raise ValueError(f'missing package directory: {directory}') + for path in (root / directory).rglob('*'): + if path.is_symlink(): + raise ValueError(f'package symlinks are unsupported: {path}') + if path.is_file(): + paths.append(path.relative_to(root)) + elif not path.is_dir(): + raise ValueError(f'expected regular package file: {path}') + value = 0xcbf29ce484222325 + + def feed(data): + nonlocal value + for byte in data: + value = ((value ^ byte) * 0x100000001b3) & ((1 << 64) - 1) + + feed(b'psrs-stdlib-content-v1\0') + for path in sorted(paths): + if (root / path).is_symlink(): + raise ValueError(f'package symlinks are unsupported: {path}') + data = (root / path).read_bytes() + feed(path.as_posix().encode('utf-8')) + feed(b'\0') + feed(len(data).to_bytes(8, 'little')) + feed(data) + return f'fnv1a64-v1:{value:016x}' diff --git a/tools/stdlib-conformance/src/stdlib_conformance/runner.py b/tools/stdlib-conformance/src/stdlib_conformance/runner.py new file mode 100644 index 00000000..207b3546 --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/runner.py @@ -0,0 +1,106 @@ +"""Run compiler and mandatory Wasmtime through public executable boundaries.""" + +import argparse +import base64 +import hashlib +import json +import os +from pathlib import Path +import shutil +import subprocess +import time + +from .package import fingerprint + + +def digest(data): + return hashlib.sha256(data).hexdigest() + + +def output(data): + return {'base64': base64.b64encode(data).decode('ascii'), 'sha256': digest(data)} + + +def invoke(argv, timeout, env=None): + start = time.monotonic() + try: + result = subprocess.run(argv, capture_output=True, timeout=timeout, env=env) + record = {'status': 'completed', 'exit_code': result.returncode, + 'stdout': output(result.stdout), 'stderr': output(result.stderr)} + except subprocess.TimeoutExpired as error: + record = {'status': 'timeout', 'stdout': output(error.stdout or b''), + 'stderr': output(error.stderr or b'')} + except OSError as error: + record = {'status': 'launch_failed', 'error': str(error)} + return {**record, 'argv': argv, 'elapsed_seconds': time.monotonic() - start} + + +def executable(value): + resolved = shutil.which(value) + if resolved is None: + raise ValueError(f'executable unavailable: {value}') + return str(Path(resolved).resolve()) + + +def main(argv=None): + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument('--compiler', required=True) + parser.add_argument('--stdlib-root', required=True, type=Path) + parser.add_argument('--wasmtime', default='wasmtime') + parser.add_argument('--input', action='append', required=True, type=Path) + parser.add_argument('--out', required=True, type=Path) + parser.add_argument('--timeout', default=180, type=float) + parser.add_argument('--expected-exit', default=42, type=int) + parser.add_argument('--expected-stdout', type=Path) + parser.add_argument('--expected-stderr', type=Path) + args = parser.parse_args(argv) + args.out.mkdir(parents=True, exist_ok=True) + report_path = args.out / 'run.json' + report = {'schema_version': 1, 'accepted': False} + try: + if args.timeout <= 0: + raise ValueError('timeout must be positive') + compiler = executable(args.compiler) + runtime = executable(args.wasmtime) + root = args.stdlib_root.resolve(strict=True) + package = json.loads((root / 'manifest.json').read_text()) + if package.get('schema_version') != 1 or package.get('name') != 'psrs-stdlib': + raise ValueError('unsupported stdlib package manifest') + before = fingerprint(root) + report['stdlib'] = {'root': str(root), 'source_fingerprint': before} + report['compiler'] = {'path': compiler, 'sha256': digest(Path(compiler).read_bytes())} + report['runtime'] = {'path': runtime, 'sha256': digest(Path(runtime).read_bytes()), + 'version': invoke([runtime, '--version'], args.timeout)} + version = report['runtime']['version'] + if version['status'] != 'completed' or version['exit_code'] != 0: + raise ValueError('runtime version query failed') + inputs = [path.resolve(strict=True) for path in args.input] + report['inputs'] = [{'path': str(path), 'sha256': digest(path.read_bytes())} for path in inputs] + expected = {'exit_code': args.expected_exit, + 'stdout': output(args.expected_stdout.read_bytes() if args.expected_stdout else b''), + 'stderr': output(args.expected_stderr.read_bytes() if args.expected_stderr else b'')} + report['expected'] = expected + wasm = (args.out / 'program.wasm').resolve() + # Stale output can never serve as evidence for a failed build. + wasm.unlink(missing_ok=True) + env = {**os.environ, 'PSRS_STDLIB_ROOT': str(root)} + build = invoke([compiler, 'build', *map(str, inputs), '-o', str(wasm)], args.timeout, env) + report['compilation'] = build + if build['status'] == 'completed' and build['exit_code'] == 0: + report['wasm'] = {'path': str(wasm), 'sha256': digest(wasm.read_bytes())} + run = invoke([runtime, str(wasm)], args.timeout) + report['execution'] = run + report['accepted'] = (run['status'] == 'completed' and + all(run[key] == value for key, value in expected.items())) + after = fingerprint(root) + report['stdlib']['unchanged_during_run'] = before == after + report['inputs_unchanged_during_run'] = all( + digest(Path(row['path']).read_bytes()) == row['sha256'] for row in report['inputs']) + if before != after or not report['inputs_unchanged_during_run']: + report['accepted'] = False + except (OSError, ValueError, KeyError) as error: + report['error'] = str(error) + report['accepted'] = False + report_path.write_text(json.dumps(report, indent=2) + '\n') + print(f'{report_path}: {"accepted" if report["accepted"] else "failed"}') + return 0 if report['accepted'] else 1 diff --git a/tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs b/tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs new file mode 100644 index 00000000..730191f3 --- /dev/null +++ b/tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs @@ -0,0 +1,102 @@ +// Generate source-signature and behavior fixtures from pinned official FFI. +import { readFile, writeFile, mkdir } from 'node:fs/promises'; +import { execFileSync } from 'node:child_process'; +import { createHash } from 'node:crypto'; +import { resolve, join } from 'node:path'; +import { pathToFileURL } from 'node:url'; +import { parseArgs } from 'node:util'; + +const { values } = parseArgs({ options: Object.fromEntries( + ['vendor', 'inventory', 'cases', 'out', 'upstream'].map(name => [name, { type: 'string', multiple: name === 'upstream' }])) }); +for (const name of ['vendor', 'inventory', 'cases', 'out']) + if (!values[name]) throw Error(`missing --${name}`); +const output = resolve(values.out); +const inventory = JSON.parse(await readFile(values.inventory, 'utf8')); +const caseManifest = JSON.parse(await readFile(values.cases, 'utf8')); +if (caseManifest.schema_version !== 1 || caseManifest.target_int_representation !== 'signed-i32') + throw Error('unsupported scalar conformance contract'); +const roots = Object.fromEntries((values.upstream ?? []).map(value => { + const split = value.indexOf('='); + if (split < 1) throw Error('upstream must be PACKAGE=CHECKOUT'); + return [value.slice(0, split), resolve(value.slice(split + 1))]; +})); +for (const [packageName, root] of Object.entries(roots)) { + const pin = inventory.packages.find(value => value.name === packageName); + if (!pin) throw Error(`unknown upstream package: ${packageName}`); + if (execFileSync('git', ['-C', root, 'rev-parse', 'HEAD'], { encoding: 'utf8' }).trim() !== pin.commit) + throw Error(`unexpected upstream revision: ${packageName}`); + if (execFileSync('git', ['-C', root, 'status', '--porcelain'], { encoding: 'utf8' }).trim()) + throw Error(`dirty upstream: ${packageName}`); +} +function decode(value) { + if (typeof value !== 'object' || value === null) return value; + const special = { NaN, Infinity, '-Infinity': -Infinity, '-0': -0 }; + if (Object.keys(value).length !== 1 || !Object.hasOwn(special, value.number)) + throw Error('invalid special numeric input'); + return special[value.number]; +} +const specifications = caseManifest.bindings.map(row => [row.module, row.name, row.arguments.map(args => args.map(decode))]); +const hashes = new Map(), declarations = [], observations = [], checks = []; +function marker(value) { + if (typeof value !== 'number') return value; + if (Number.isNaN(value)) return 'NaN'; + if (Object.is(value, -0)) return '-0'; + if (!Number.isFinite(value)) return String(value); + return value; +} +function literal(value, type) { + if (typeof value === 'boolean') return String(value); + if (typeof value === 'string') return `'${value}'`; + if (Number.isNaN(value)) return '(numberDiv 0.0 0.0)'; + if (!Number.isFinite(value)) return `(numberDiv ${value < 0 ? '(numberNeg 1.0)' : '1.0'} 0.0)`; + const negative = value < 0 || Object.is(value, -0); + const magnitude = String(Math.abs(value)); + if (type === 'Number') { + const number = magnitude.includes('.') ? magnitude : magnitude + '.0'; + return negative ? `(numberNeg ${number})` : number; + } + if (value === -2147483648) return '(intSub (intNeg 2147483647) 1)'; + return negative ? `(intNeg ${magnitude})` : magnitude; +} +for (const [file, name, cases] of specifications) { + const metadata = inventory.modules.find(value => value.path === file); + if (!metadata || !roots[metadata.package]) throw Error(`missing upstream root for ${file}`); + const upstream = join(roots[metadata.package], 'src', file.replace('.purs', '.js')); + const js = await readFile(upstream); + hashes.set(upstream, createHash('sha256').update(js).digest('hex')); + const functions = await import(pathToFileURL(upstream)); + const vendor = await readFile(join(values.vendor, file), 'utf8'); + const declaration = vendor.split('\n').find(line => line.startsWith('foreign import "psrs:intrinsic#') && line.includes(`" ${name} ::`)); + if (!declaration) throw Error(`missing explicit target binding: ${file}.${name}`); + declarations.push(declaration); + const types = declaration.split('::')[1].trim().split(' -> '); + if (types.some(type => !['Int', 'Number', 'Boolean', 'Char'].includes(type))) + throw Error(`unsupported scalar signature: ${declaration}`); + const resultType = types.at(-1); + for (const args of cases) { + if (args.length !== types.length - 1) throw Error(`argument arity mismatch: ${file}.${name}`); + let expected = functions[name]; + for (const argument of args) expected = expected(argument); + // Wasm Int is signed i32; record the raw JS observation separately. + const target = resultType === 'Int' ? expected | 0 : expected; + const call = `(Golden.${name} ${args.map((value, i) => literal(value, types[i])).join(' ')})`; + let condition; + if (resultType === 'Number' && Number.isNaN(target)) condition = `(booleanNot (numberEq ${call} ${call}))`; + else if (resultType === 'Number' && Object.is(target, -0)) + condition = `(numberEq (numberDiv 1.0 ${call}) (numberDiv (numberNeg 1.0) 0.0))`; + else condition = `(${resultType === 'Int' ? 'intEq' : resultType === 'Boolean' ? 'booleanEq' : 'numberEq'} ${call} ${literal(target, resultType)})`; + observations.push({ module: file, name, arguments: args.map(marker), official_result: marker(expected), target_result: marker(target), representation_difference: !Object.is(expected, target) }); + checks.push(condition); + } +} +await mkdir(output, { recursive: true }); +await writeFile(join(output, 'Golden.purs'), 'module Golden where\n' + declarations.join('\n') + '\n'); +function conjunction(values) { + if (values.length === 0) throw Error("no scalar observations were generated"); + if (values.length === 1) return values[0]; + const middle = Math.floor(values.length / 2); + return `(booleanAnd ${conjunction(values.slice(0, middle))} ${conjunction(values.slice(middle))})`; +} +await writeFile(join(output, 'Main.purs'), 'module Main where\nimport Golden as Golden\nmain = if ' + conjunction(checks) + ' then 42 else 1\n'); +await writeFile(join(output, 'observations.json'), JSON.stringify({ node: process.version, inputs: [...hashes].map(([path, sha256]) => ({ path, sha256 })), observations }, null, 2) + '\n'); +console.log(`${declarations.length} bindings, ${checks.length} cases`); From 476675fde73245d6e998484f8ea905f8105741be Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 17:33:24 +0800 Subject: [PATCH 039/148] Implement polymorphic array application with checked callback invocation --- .../psrs-backend/src/bindings/primitives.rs | 23 +- crates/psrs-backend/src/cc/lower/array.rs | 60 +++ .../psrs-backend/src/cc/lower/array_apply.rs | 79 ++++ crates/psrs-backend/src/cc/lower/intrinsic.rs | 3 + crates/psrs-backend/src/cc/lower/mod.rs | 1 + crates/psrs-backend/src/cc/mod.rs | 12 + .../psrs-backend/src/cc/verify/ops/arrays.rs | 147 ++++++ crates/psrs-backend/src/cc/verify/ops/mod.rs | 12 +- .../psrs-backend/src/mir/lower/array_apply.rs | 418 ++++++++++++++++++ .../src/mir/lower/array_assignments.rs | 22 + .../psrs-backend/src/mir/lower/assignments.rs | 1 + crates/psrs-backend/src/mir/lower/mod.rs | 1 + .../src/mir/reachable/assignments.rs | 18 + crates/psrs-core/src/lib.rs | 4 +- crates/psrs-core/src/types.rs | 55 +++ crates/psrs-core/src/verify/expr/arrays.rs | 35 ++ crates/psrs-core/src/verify/expr/intrinsic.rs | 3 + crates/psrs-core/src/verify/mod.rs | 16 +- .../src/tests/primitive_foreign.rs | 165 ++++++- .../tests/fixtures/stdlib-array/Golden.purs | 2 + .../tests/fixtures/stdlib-array/Main.purs | 13 + .../fixtures/stdlib-array/observations.json | 87 ++++ crates/psrs-hir/src/intrinsic/mod.rs | 7 +- crates/psrs-hir/src/intrinsic/registry.rs | 13 + .../backend/wasm/primitive-ffi-and-stdlib.md | 33 ++ .../stdlib/array-apply-2026-10-06/report.md | 51 +++ docs/workflow/stdlib-conformance.md | 17 + stdlib.lock.json | 4 +- 28 files changed, 1274 insertions(+), 28 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/array_apply.rs create mode 100644 crates/psrs-backend/src/mir/lower/array_apply.rs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array/Main.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array/observations.json create mode 100644 docs/implementation/stdlib/array-apply-2026-10-06/report.md diff --git a/crates/psrs-backend/src/bindings/primitives.rs b/crates/psrs-backend/src/bindings/primitives.rs index a011bbff..1c222ca9 100644 --- a/crates/psrs-backend/src/bindings/primitives.rs +++ b/crates/psrs-backend/src/bindings/primitives.rs @@ -1,7 +1,7 @@ //! Discharges explicit primitive bindings into verified ordinary Core functions. use crate::BackendError; -use psrs_core::{Binder, Declaration, Expr, ExprKind, Module, arrow_parts}; +use psrs_core::{Binder, Declaration, Expr, ExprKind, Module, arrow_parts, scheme_parts}; use psrs_hir::{ExternalKind, IntrinsicCategory, LocalId}; #[cfg(test)] @@ -66,14 +66,27 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), }; if !matches!( intrinsic.descriptor().category, - IntrinsicCategory::UnaryScalar | IntrinsicCategory::BinaryScalar + IntrinsicCategory::UnaryScalar + | IntrinsicCategory::BinaryScalar + | IntrinsicCategory::ArrayLength + | IntrinsicCategory::ArrayIndex + | IntrinsicCategory::ArrayUpdate + | IntrinsicCategory::ArrayAppend + | IntrinsicCategory::ArrayApply + | IntrinsicCategory::StringToBytes + | IntrinsicCategory::BytesToString ) { return Err(error(format!( "primitive binding `{}` has no foreign-function implementation yet", intrinsic.descriptor().name ))); } - let mut result = checked.ty; + let Some((quantified, body_type)) = scheme_parts(&candidate.types, checked.ty) else { + return Err(error( + "primitive binding has an invalid checked scheme".into(), + )); + }; + let mut result = body_type; let mut parameters = Vec::new(); let mut arrows = Vec::new(); while let Some((parameter, tail)) = arrow_parts(&candidate.types, result) { @@ -121,8 +134,8 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), symbol: external.symbol, name: external.name, name_span: span, - quantified: Vec::new(), - ty: checked.ty, + quantified, + ty: body_type, value, span, }; diff --git a/crates/psrs-backend/src/cc/lower/array.rs b/crates/psrs-backend/src/cc/lower/array.rs index d44cafb5..1431ed8f 100644 --- a/crates/psrs-backend/src/cc/lower/array.rs +++ b/crates/psrs-backend/src/cc/lower/array.rs @@ -80,6 +80,66 @@ impl FunctionLowerer<'_> { Ok(destination) } + pub(super) fn lower_array_apply( + &mut self, + expression: &Expr, + functions: &Expr, + values: &Expr, + ty: ValueShape, + assignments: &mut Vec, + ) -> Result> { + let representations = + [functions.ty, values.ty, expression.ty].map(|ty| self.array_types.get(&ty).copied()); + let [ + Some(functions_representation), + Some(values_representation), + Some(result_representation), + ] = representations + else { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "arrayApply has no checked array representation", + )]); + }; + let Some(super::super::Representation::Array { + element: + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(signature), + }), + }) = self + .representations + .representation(functions_representation) + else { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "arrayApply has no checked callback signature", + )]); + }; + let signature = *signature; + let invoker = self.array_apply_invoker(functions.ty, values.ty, expression.span)?; + let functions = self.lower_value(functions, assignments)?; + let values = self.lower_value(values, assignments)?; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::ArrayApply { + destination, + functions, + values, + functions_representation, + values_representation, + result_representation, + signature, + invoker, + }, + span: expression.span, + }); + Ok(destination) + } + pub(super) fn lower_array_append( &mut self, expression: &Expr, diff --git a/crates/psrs-backend/src/cc/lower/array_apply.rs b/crates/psrs-backend/src/cc/lower/array_apply.rs new file mode 100644 index 00000000..1c6ba7b5 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/array_apply.rs @@ -0,0 +1,79 @@ +//! A checked unary invocation through the common application/partial-call path. +use super::FunctionLowerer; +use super::lambda::LambdaLowering; +use crate::BackendError; +use crate::cc::Function; +use psrs_core::{Expr, ExprKind, TypeId, arrow_parts}; +use psrs_hir::{LocalId, SymbolId}; +use psrs_span::TextRange; + +impl FunctionLowerer<'_> { + pub(super) fn array_apply_invoker( + &mut self, + functions: TypeId, + values: TypeId, + span: TextRange, + ) -> Result> { + let error = || { + vec![BackendError::invalid_ir( + "P8 closure conversion", + span, + "arrayApply has an invalid checked source function type", + )] + }; + let function_type = + super::super::layout::array_element_type(self.module, functions).ok_or_else(error)?; + let argument_type = + super::super::layout::array_element_type(self.module, values).ok_or_else(error)?; + let (_, result_type) = arrow_parts(&self.module.types, function_type).ok_or_else(error)?; + let mut nested = self.child_lowerer(); + let callback_shape = nested.value_shape(function_type, span)?; + let argument_shape = nested.value_shape(argument_type, span)?; + let result_shape = nested.value_shape(result_type, span)?; + let callback = nested.fresh(callback_shape); + let argument = nested.fresh(argument_shape); + nested.locals.insert(LocalId(0), callback); + nested.locals.insert(LocalId(1), argument); + nested.local_types.insert(LocalId(0), function_type); + nested.local_types.insert(LocalId(1), argument_type); + let call = Expr { + kind: ExprKind::Application( + Box::new(Expr { + kind: ExprKind::Local(LocalId(0)), + ty: function_type, + span, + }), + Box::new(Expr { + kind: ExprKind::Local(LocalId(1)), + ty: argument_type, + span, + }), + ), + ty: result_type, + span, + }; + let mut assignments = Vec::new(); + let result = nested.lower_value(&call, &mut assignments)?; + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let function = Function { + symbol, + name: "array_apply_invoke".into(), + parameters: vec![callback, argument], + values: nested.values, + assignments, + result, + result_type: result_shape, + span, + }; + super::super::verify::verify_function(&function, self.signatures, self.representations)?; + let FunctionLowerer { + warnings, + generated, + .. + } = nested; + self.warnings.extend(warnings); + self.generated.extend(generated); + self.generated.push(function); + Ok(symbol) + } +} diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 57ab1d29..9fdd71f8 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -65,6 +65,9 @@ impl FunctionLowerer<'_> { Intrinsic::ArrayAppend => { self.lower_array_append(expression, &arguments[0], &arguments[1], ty, assignments) } + Intrinsic::ArrayApply => { + self.lower_array_apply(expression, &arguments[0], &arguments[1], ty, assignments) + } Intrinsic::StringToBytes => { self.lower_string_to_bytes(expression, &arguments[0], ty, assignments) } diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 2318be23..75b1d683 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -12,6 +12,7 @@ use std::collections::{HashMap, HashSet}; use std::rc::Rc; mod array; +mod array_apply; mod call; mod constructor; mod conversion; diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 3d758843..15da19ba 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -172,6 +172,18 @@ pub enum AssignmentKind { left: ValueId, right: ValueId, }, + /// Apply every callback to every argument in function-major order. + /// The representations and callback signature describe the checked ABI. + ArrayApply { + destination: ValueId, + functions: ValueId, + values: ValueId, + invoker: SymbolId, + functions_representation: ReprId, + values_representation: ReprId, + result_representation: ReprId, + signature: SignatureId, + }, /// A source `String`'s canonical UTF-8 bytes as an `Array Int`. A source /// string is a sequence of Unicode scalar values, so this is lossless. StringToBytes { diff --git a/crates/psrs-backend/src/cc/verify/ops/arrays.rs b/crates/psrs-backend/src/cc/verify/ops/arrays.rs index a7a3ab29..a64745eb 100644 --- a/crates/psrs-backend/src/cc/verify/ops/arrays.rs +++ b/crates/psrs-backend/src/cc/verify/ops/arrays.rs @@ -16,6 +16,8 @@ pub(super) fn verify_array_assignment( declared: &HashMap, table: &RepresentationTable, uses: &mut Vec, + signatures: &HashMap, + complete: bool, ) -> Result<(), Vec> { match &assignment.kind { AssignmentKind::ArrayNew { @@ -130,7 +132,152 @@ pub(super) fn verify_array_assignment( )?; uses.extend([*left, *right]); } + AssignmentKind::ArrayApply { + destination, + functions, + values, + functions_representation, + values_representation, + result_representation, + signature, + invoker, + } => { + verify_embedded_destination(assignment, *destination)?; + let callback = + verify_array_representation(table, *functions_representation, assignment)?; + let argument = verify_array_representation(table, *values_representation, assignment)?; + let result = verify_array_representation(table, *result_representation, assignment)?; + let contract = table_signature(table, *signature, assignment)?; + if callback != closure_shape(*signature) + || contract.parameters.first() != Some(&argument) + { + return Err(assignment_error( + assignment, + "arrayApply callback ABI does not match its array elements", + )); + } + if complete { + let expected = crate::cc::Signature { + parameters: vec![callback, argument], + result, + }; + if signatures.get(invoker) != Some(&expected) { + return Err(assignment_error( + assignment, + "arrayApply invoker is missing or has an incompatible ABI", + )); + } + } + verify_array_value( + declared, + *functions, + table, + Some(*functions_representation), + assignment, + )?; + verify_array_value( + declared, + *values, + table, + Some(*values_representation), + assignment, + )?; + require_destination( + declared, + assignment, + repr_shape(*result_representation), + "arrayApply has an incompatible result shape", + )?; + uses.extend([*functions, *values]); + } _ => unreachable!("array verifier received another assignment"), } Ok(()) } + +#[cfg(test)] +mod tests { + use super::*; + use crate::cc::{ReprId, Signature, SignatureId}; + use psrs_hir::{ModuleId, SymbolId}; + use psrs_span::TextRange; + + #[test] + fn array_apply_requires_a_real_invoker_with_the_checked_abi() { + let callback = closure_shape(SignatureId(0)); + let table = RepresentationTable { + signatures: vec![Signature { + parameters: vec![ValueShape::Integer], + result: ValueShape::Number, + }], + representations: vec![ + Representation::Array { element: callback }, + Representation::Array { + element: ValueShape::Integer, + }, + Representation::Array { + element: ValueShape::Number, + }, + ], + ..Default::default() + }; + let invoker = SymbolId::new(ModuleId(9), 1); + let assignment = Assignment { + destination: ValueId(2), + span: TextRange::new(0, 1), + kind: AssignmentKind::ArrayApply { + destination: ValueId(2), + functions: ValueId(0), + values: ValueId(1), + functions_representation: ReprId(0), + values_representation: ReprId(1), + result_representation: ReprId(2), + signature: SignatureId(0), + invoker, + }, + }; + let declared = (0..3) + .map(|id| (ValueId(id), repr_shape(ReprId(id)))) + .collect(); + let mut signatures = HashMap::new(); + assert!( + verify_array_assignment( + &assignment, + &declared, + &table, + &mut Vec::new(), + &signatures, + true + ) + .is_err() + ); + signatures.insert( + invoker, + Signature { + parameters: vec![callback, ValueShape::Integer], + result: ValueShape::Integer, + }, + ); + assert!( + verify_array_assignment( + &assignment, + &declared, + &table, + &mut Vec::new(), + &signatures, + true + ) + .is_err() + ); + signatures.get_mut(&invoker).unwrap().result = ValueShape::Number; + verify_array_assignment( + &assignment, + &declared, + &table, + &mut Vec::new(), + &signatures, + true, + ) + .unwrap(); + } +} diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index 654ee6a2..5397d324 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -334,8 +334,16 @@ pub(super) fn verify_assignments( | AssignmentKind::ArrayGet { .. } | AssignmentKind::ArrayClone { .. } | AssignmentKind::ArraySet { .. } - | AssignmentKind::ArrayAppend { .. } => { - arrays::verify_array_assignment(assignment, declared, table, &mut uses)?; + | AssignmentKind::ArrayAppend { .. } + | AssignmentKind::ArrayApply { .. } => { + arrays::verify_array_assignment( + assignment, + declared, + table, + &mut uses, + signatures, + functions.is_some(), + )?; } AssignmentKind::StringToBytes { representation, diff --git a/crates/psrs-backend/src/mir/lower/array_apply.rs b/crates/psrs-backend/src/mir/lower/array_apply.rs new file mode 100644 index 00000000..27567692 --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/array_apply.rs @@ -0,0 +1,418 @@ +//! Linear array application with the callback ABI supplied by checked CC. +use super::aggregate::{nullable_reference_shape, reference_type, representation_shape}; +use super::{BlockId, FunctionLowerer, layout_error}; +use crate::BackendError; +use crate::cc::ReprId; +use crate::mir::instruction::Instruction; +use crate::mir::{NumericOp, Terminator}; +use crate::types::{ValueId, ValueType}; +use psrs_hir::SymbolId; +use psrs_span::TextRange; + +struct ArrayLoop { + index: ValueId, + header: BlockId, + body: BlockId, + exit: BlockId, +} + +impl FunctionLowerer<'_> { + #[allow(clippy::too_many_arguments)] + pub(super) fn lower_array_apply( + &mut self, + current: BlockId, + destination: ValueId, + functions: ValueId, + values: ValueId, + functions_repr: ReprId, + values_repr: ReprId, + result_repr: ReprId, + invoker: SymbolId, + span: TextRange, + ) -> Result> { + // Non-null references crossing structured control labels require + // defaultable storage locals. Logical views are restored at use sites. + let functions = self.array_apply_storage(current, functions, functions_repr, span)?; + let values = self.array_apply_storage(current, values, values_repr, span)?; + let functions_length = self.fresh(ValueType::I32); + let values_length = self.fresh(ValueType::I32); + for (destination, value) in [(functions_length, functions), (values_length, values)] { + self.append_instruction( + current, + Instruction::ArrayLen { + destination, + value, + span, + }, + span, + )?; + } + let zero = self.array_apply_constant(current, 0, span)?; + // Source array lengths are signed Int. Reject unrepresentable lengths + // and products, rather than wrapping and silently dropping callbacks. + for length in [functions_length, values_length] { + let negative = self.array_apply_numeric( + current, + NumericOp::I32LtS, + length, + zero, + ValueType::Boolean, + span, + )?; + self.append_instruction( + current, + Instruction::TrapIf { + condition: negative, + span, + }, + span, + )?; + } + let total = self.array_apply_numeric( + current, + NumericOp::I32Mul, + functions_length, + values_length, + ValueType::I32, + span, + )?; + let empty = self.array_apply_numeric( + current, + NumericOp::I32Eq, + values_length, + zero, + ValueType::Boolean, + span, + )?; + let guard = self.new_block(Vec::new()); + let allocate = self.new_block(Vec::new()); + self.set_terminator( + current, + Terminator::Branch { + condition: empty, + then_block: allocate, + else_block: guard, + span, + }, + span, + )?; + let quotient = self.array_apply_numeric( + guard, + NumericOp::I32DivS, + total, + values_length, + ValueType::I32, + span, + )?; + let overflow = self.array_apply_numeric( + guard, + NumericOp::I32Ne, + quotient, + functions_length, + ValueType::Boolean, + span, + )?; + self.append_instruction( + guard, + Instruction::TrapIf { + condition: overflow, + span, + }, + span, + )?; + self.set_terminator( + guard, + Terminator::Jump { + target: allocate, + arguments: Vec::new(), + span, + }, + span, + )?; + + let destination_shape = representation_shape(result_repr); + let array = self.fresh( + self.layout + .value_type(&nullable_reference_shape(destination_shape)) + .map_err(|error| layout_error(span, error))?, + ); + let type_index = self + .layout + .repr_index(result_repr) + .map_err(|error| layout_error(span, error))?; + self.append_instruction( + allocate, + Instruction::ArrayNewSized { + destination: array, + type_index, + length: total, + span, + }, + span, + )?; + let outer = self.array_apply_loop(allocate, functions_length, span)?; + let callback_shape = self + .layout + .array_element(functions_repr) + .map_err(|error| layout_error(span, error))?; + let argument_shape = self + .layout + .array_element(values_repr) + .map_err(|error| layout_error(span, error))?; + let result_shape = self + .layout + .array_element(result_repr) + .map_err(|error| layout_error(span, error))?; + let callback = self.fresh( + self.layout + .value_type(&callback_shape) + .map_err(|error| layout_error(span, error))?, + ); + self.lower_array_get( + outer.body, + callback, + functions_repr, + functions, + outer.index, + span, + )?; + // Match the official loop: cache the function once for this complete + // value traversal, including when the values array is empty. + let cached_shape = nullable_reference_shape(callback_shape); + let cached = self.fresh( + self.layout + .value_type(&cached_shape) + .map_err(|error| layout_error(span, error))?, + ); + self.append_instruction( + outer.body, + Instruction::RefCast { + destination: cached, + value: callback, + reference: reference_type(&cached_shape, self.layout, span)?, + span, + }, + span, + )?; + let base = self.array_apply_numeric( + outer.body, + NumericOp::I32Mul, + outer.index, + values_length, + ValueType::I32, + span, + )?; + let inner = self.array_apply_loop(outer.body, values_length, span)?; + let callback = self.fresh( + self.layout + .value_type(&callback_shape) + .map_err(|error| layout_error(span, error))?, + ); + self.append_instruction( + inner.body, + Instruction::RefCast { + destination: callback, + value: cached, + reference: reference_type(&callback_shape, self.layout, span)?, + span, + }, + span, + )?; + let argument = self.fresh( + self.layout + .value_type(&argument_shape) + .map_err(|error| layout_error(span, error))?, + ); + let result = self.fresh( + self.layout + .value_type(&result_shape) + .map_err(|error| layout_error(span, error))?, + ); + self.lower_array_get(inner.body, argument, values_repr, values, inner.index, span)?; + self.append_instruction( + inner.body, + Instruction::Call { + destination: result, + function: invoker, + arguments: vec![callback, argument], + span, + }, + span, + )?; + let index = self.array_apply_numeric( + inner.body, + NumericOp::I32Add, + base, + inner.index, + ValueType::I32, + span, + )?; + self.append_instruction( + inner.body, + Instruction::ArraySet { + type_index, + value: array, + index, + new_value: result, + span, + }, + span, + )?; + self.array_apply_advance(inner.body, &inner, span)?; + self.array_apply_advance(inner.exit, &outer, span)?; + let exit = outer.exit; + self.append_instruction( + exit, + Instruction::RefCast { + destination, + value: array, + reference: reference_type(&destination_shape, self.layout, span)?, + span, + }, + span, + )?; + Ok(exit) + } + + fn array_apply_loop( + &mut self, + start: BlockId, + length: ValueId, + span: TextRange, + ) -> Result> { + let index = self.fresh(ValueType::I32); + let header = self.new_block(vec![index]); + let body = self.new_block(Vec::new()); + let exit = self.new_block(Vec::new()); + let zero = self.array_apply_constant(start, 0, span)?; + self.set_terminator( + start, + Terminator::Jump { + target: header, + arguments: vec![zero], + span, + }, + span, + )?; + let condition = self.array_apply_numeric( + header, + NumericOp::I32LtS, + index, + length, + ValueType::Boolean, + span, + )?; + self.set_terminator( + header, + Terminator::Branch { + condition, + then_block: body, + else_block: exit, + span, + }, + span, + )?; + Ok(ArrayLoop { + index, + header, + body, + exit, + }) + } + + fn array_apply_advance( + &mut self, + block: BlockId, + loop_: &ArrayLoop, + span: TextRange, + ) -> Result<(), Vec> { + let one = self.array_apply_constant(block, 1, span)?; + let next = self.array_apply_numeric( + block, + NumericOp::I32Add, + loop_.index, + one, + ValueType::I32, + span, + )?; + self.set_terminator( + block, + Terminator::Jump { + target: loop_.header, + arguments: vec![next], + span, + }, + span, + ) + } + + fn array_apply_storage( + &mut self, + block: BlockId, + value: ValueId, + representation: ReprId, + span: TextRange, + ) -> Result> { + let shape = nullable_reference_shape(representation_shape(representation)); + let destination = self.fresh( + self.layout + .value_type(&shape) + .map_err(|error| layout_error(span, error))?, + ); + self.append_instruction( + block, + Instruction::RefCast { + destination, + value, + reference: reference_type(&shape, self.layout, span)?, + span, + }, + span, + )?; + Ok(destination) + } + + fn array_apply_constant( + &mut self, + block: BlockId, + value: i32, + span: TextRange, + ) -> Result> { + let destination = self.fresh(ValueType::I32); + self.append_instruction( + block, + Instruction::Constant { + destination, + value, + span, + }, + span, + )?; + Ok(destination) + } + + #[allow(clippy::too_many_arguments)] + fn array_apply_numeric( + &mut self, + block: BlockId, + op: NumericOp, + left: ValueId, + right: ValueId, + ty: ValueType, + span: TextRange, + ) -> Result> { + let destination = self.fresh(ty); + self.append_instruction( + block, + Instruction::Primitive { + destination, + op, + left, + right, + span, + }, + span, + )?; + Ok(destination) + } +} diff --git a/crates/psrs-backend/src/mir/lower/array_assignments.rs b/crates/psrs-backend/src/mir/lower/array_assignments.rs index 8700108a..7f02475c 100644 --- a/crates/psrs-backend/src/mir/lower/array_assignments.rs +++ b/crates/psrs-backend/src/mir/lower/array_assignments.rs @@ -57,6 +57,28 @@ impl FunctionLowerer<'_> { assignment.span, )?; } + AssignmentKind::ArrayApply { + destination, + functions, + values, + functions_representation, + values_representation, + result_representation, + invoker, + .. + } => { + current = self.lower_array_apply( + current, + *destination, + *functions, + *values, + *functions_representation, + *values_representation, + *result_representation, + *invoker, + assignment.span, + )?; + } AssignmentKind::StringToBytes { destination, representation, diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 1a59d604..6c082198 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -188,6 +188,7 @@ impl FunctionLowerer<'_> { AssignmentKind::ArrayNew { .. } | AssignmentKind::ArrayLen { .. } | AssignmentKind::ArrayAppend { .. } + | AssignmentKind::ArrayApply { .. } | AssignmentKind::StringToBytes { .. } | AssignmentKind::BytesToString { .. } | AssignmentKind::ArrayGet { .. } diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index 3d6dcf85..fa48437b 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -13,6 +13,7 @@ use psrs_span::TextRange; use std::collections::HashMap; mod aggregate; +mod array_apply; mod array_assignments; mod assignment_array; mod assignment_string; diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index ffa5dca8..a4fa18c4 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -42,6 +42,24 @@ pub(super) fn add_assignments( AssignmentKind::IndirectCall { signature, .. } => { add_signature(*signature, signatures, signature_work); } + AssignmentKind::ArrayApply { + signature, + functions_representation, + values_representation, + result_representation, + invoker, + .. + } => { + direct_calls.insert(*invoker); + add_signature(*signature, signatures, signature_work); + for representation in [ + functions_representation, + values_representation, + result_representation, + ] { + add_representation(*representation, representations, representation_work); + } + } AssignmentKind::RepresentationTest { reference, .. } | AssignmentKind::RepresentationCast { reference, .. } => add_reference( reference, diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index d118d226..02593c36 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -13,7 +13,9 @@ mod verify; pub use link::{link, prune_unreachable}; pub use pattern::{Literal, Pattern, PatternKind}; pub use records::{record_row, row_fields}; -pub use types::{Type, TypeConstructor, TypeId, arrow_parts, closure_parts, forall_parts}; +pub use types::{ + Type, TypeConstructor, TypeId, arrow_parts, closure_parts, forall_parts, scheme_parts, +}; use psrs_hir::{ CaseBranchCoverage, ExternalSymbol, Intrinsic, LocalId, ModuleId, SymbolId, diff --git a/crates/psrs-core/src/types.rs b/crates/psrs-core/src/types.rs index c14f48f1..ff63e91e 100644 --- a/crates/psrs-core/src/types.rs +++ b/crates/psrs-core/src/types.rs @@ -113,3 +113,58 @@ pub fn forall_parts(types: &[Type], id: TypeId) -> Option<(&[TypeVariableId], Ty _ => None, } } + +/// Reads a binding's leading lexical quantifiers without crossing an arrow. +/// Returns `None` for a dangling or cyclic spine; callers must report invalid IR. +/// The variable identities and their order are preserved for declaration scope. +pub fn scheme_parts(types: &[Type], mut id: TypeId) -> Option<(Vec, TypeId)> { + let mut quantified = Vec::new(); + let mut seen = std::collections::HashSet::new(); + while seen.insert(id) { + match types.get(id.0 as usize)? { + Type::ForAll { variables, body } => { + quantified.extend_from_slice(variables); + id = *body; + } + _ => return Some((quantified, id)), + } + } + None +} + +#[cfg(test)] +mod scheme_tests { + use super::*; + + #[test] + fn binding_scheme_preserves_variables_and_stops_before_a_result_quantifier() { + let a = TypeVariableId(7); + let b = TypeVariableId(8); + let types = vec![ + Type::Constructor(TypeConstructor::Function), + Type::Variable(a), + Type::Variable(b), + Type::ForAll { + variables: vec![b], + body: TypeId(2), + }, + Type::Application(TypeId(0), TypeId(1)), + Type::Application(TypeId(4), TypeId(3)), + Type::ForAll { + variables: vec![a], + body: TypeId(5), + }, + ]; + assert_eq!(scheme_parts(&types, TypeId(6)), Some((vec![a], TypeId(5)))); + } + + #[test] + fn invalid_scheme_spines_are_rejected_without_fresh_unknowns() { + let types = vec![Type::ForAll { + variables: vec![TypeVariableId(0)], + body: TypeId(0), + }]; + assert!(scheme_parts(&types, TypeId(0)).is_none()); + assert!(scheme_parts(&types, TypeId(1)).is_none()); + } +} diff --git a/crates/psrs-core/src/verify/expr/arrays.rs b/crates/psrs-core/src/verify/expr/arrays.rs index 31225591..99534ba3 100644 --- a/crates/psrs-core/src/verify/expr/arrays.rs +++ b/crates/psrs-core/src/verify/expr/arrays.rs @@ -58,6 +58,41 @@ impl Context<'_> { ); } + pub(super) fn verify_array_apply( + &mut self, + expression: &Expr, + functions: &Expr, + values: &Expr, + ) { + self.expr(functions, None); + self.expr(values, None); + let shapes = array_element(functions.ty, self.module) + .and_then(|ty| crate::arrow_parts(&self.module.types, ty)) + .zip(array_element(values.ty, self.module)) + .zip(array_element(expression.ty, self.module)); + let Some((((parameter, result), element), output)) = shapes else { + self.errors.push(error(self.owner, expression.span, + "arrayApply expects an array of unary functions, an argument array, and an array result")); + return; + }; + compatible( + parameter, + element, + self.module, + self.owner, + values.span, + self.errors, + ); + compatible( + result, + output, + self.module, + self.owner, + expression.span, + self.errors, + ); + } + pub(super) fn verify_array_index(&mut self, expression: &Expr, array: &Expr, index: &Expr) { let Some(element_type) = array_element(array.ty, self.module) else { self.errors.push(error( diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 56d5b854..1bfb1b1f 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -28,6 +28,9 @@ impl Context<'_> { Intrinsic::ArrayAppend => { self.verify_array_append(expression, &arguments[0], &arguments[1]) } + Intrinsic::ArrayApply => { + self.verify_array_apply(expression, &arguments[0], &arguments[1]) + } Intrinsic::StringToBytes => self.verify_string_to_bytes(expression, &arguments[0]), Intrinsic::BytesToString => self.verify_bytes_to_string(expression, &arguments[0]), _ => match intrinsic.descriptor().category { diff --git a/crates/psrs-core/src/verify/mod.rs b/crates/psrs-core/src/verify/mod.rs index 29fa9f7e..b9788703 100644 --- a/crates/psrs-core/src/verify/mod.rs +++ b/crates/psrs-core/src/verify/mod.rs @@ -161,18 +161,6 @@ pub(crate) fn module(module: &Module, source: Option<&Module>) -> Result<(), Vec } fn external_scheme(module: &Module, ty: TypeId) -> Option { - let mut current = ty; - let mut quantified = Vec::new(); - let mut seen = std::collections::HashSet::new(); - while seen.insert(current) { - let Some((variables, body)) = crate::forall_parts(&module.types, current) else { - return Some(SchemeType { - ty: current, - quantified, - }); - }; - quantified.extend_from_slice(variables); - current = body; - } - None + let (quantified, ty) = crate::scheme_parts(&module.types, ty)?; + Some(SchemeType { ty, quantified }) } diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index 25f82219..efbdf678 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -37,9 +37,10 @@ fn primitive_foreign_binding_names_are_registry_operations() { #[test] fn primitive_foreign_bindings_keep_unimplemented_categories_explicit() { - let source = "module Main where\nforeign import \"psrs:intrinsic#arrayLength\" size :: forall a. Array a -> Int\nmain = 0\n"; + let source = + "module Main where\nforeign import \"psrs:intrinsic#unit\" singleton :: Unit\nmain = 0\n"; let errors = compile_program_sources(&[("Main.purs", source)]) - .expect_err("array foreign lowering is not implemented yet"); + .expect_err("nullary foreign lowering is not implemented yet"); assert!( errors .iter() @@ -107,3 +108,163 @@ fn primitive_foreign_bindings_match_pinned_official_scalar_observations() { }; assert_eq!(output.status.code(), Some(42), "{output:?}"); } + +#[test] +fn primitive_foreign_array_schemes_execute_multiple_element_instantiations() { + let native = r#"module Native where +foreign import "psrs:intrinsic#arrayLength" size :: forall a. Array a -> Int +foreign import "psrs:intrinsic#arrayIndex" at :: forall a. Array a -> Int -> a +foreign import "psrs:intrinsic#arrayUpdate" replace :: forall a. Array a -> Int -> a -> Array a +foreign import "psrs:intrinsic#arrayAppend" append :: forall a. Array a -> Array a -> Array a +"#; + let main = r#"module Main where +import Native +apply f x = f x +main = + let + original = [1, 2] + joined = append original [40] + changed = replace joined 0 9 + texts = append ["λ"] ["😀"] + records = replace [{ value: 1 }] 0 { value: 42 } + in if booleanAnd (intEq (size joined) 3) + (booleanAnd (intEq (at original 0) 1) + (booleanAnd (intEq (at joined 0) 1) + (booleanAnd (intEq (at changed 0) 9) + (booleanAnd (intEq (apply (at joined) 2) 40) + (booleanAnd (numberEq (at [1.0, 2.0] 1) 2.0) + (booleanAnd (intEq (size texts) 2) + (booleanAnd (intEq (arrayLength (stringToBytes (at texts 1))) 4) + (intEq (at records 0).value 42)))))))) then 42 else 1 +"#; + let Some(output) = run_program_with_wasmtime(&[("Native.purs", native), ("Main.purs", main)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn primitive_foreign_array_contracts_reject_inconsistent_quantified_elements() { + for (operation, ty) in [ + ( + "arrayApply", + "forall a b. Array (a -> b) -> Array b -> Array b", + ), + ( + "arrayApply", + "forall a b. Array (a -> b) -> Array a -> Array a", + ), + ("arrayAppend", "forall a b. Array a -> Array b -> Array a"), + ("arrayIndex", "forall a b. Array a -> Int -> b"), + ("arrayUpdate", "forall a b. Array a -> Int -> b -> Array a"), + ("arrayLength", "forall a. Array a -> a"), + ] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#{operation}\" f :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("wrong array binding contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking"), + "{errors:?}" + ); + } +} + +#[test] +fn primitive_foreign_array_apply_preserves_callback_order_and_captures() { + let source = r#"module Main where +foreign import "psrs:intrinsic#arrayApply" cartesian :: forall a b. Array (a -> b) -> Array a -> Array b +add offset x = intAdd offset x +main = + let + input = [10, 20] + result = cartesian [add 1, \x -> intMul x 2] input + numbers = cartesian [\x -> numberAdd (intToNumber x) 0.5] [4, 8] + records = cartesian [\x -> { value: intAdd x 2 }] [40] + nested = cartesian [\x -> [x, intAdd x 1]] [5, 9] + emptyValues = cartesian [\x -> arrayIndex ([] :: Array Int) x] [] + emptyFunctions = cartesian ([] :: Array (Int -> Int)) [1, 2] + in if booleanAnd (intEq (arrayLength result) 4) + (booleanAnd (intEq (arrayIndex result 0) 11) + (booleanAnd (intEq (arrayIndex result 1) 21) + (booleanAnd (intEq (arrayIndex result 2) 20) + (booleanAnd (intEq (arrayIndex result 3) 40) + (booleanAnd (numberEq (arrayIndex numbers 1) 8.5) + (booleanAnd (intEq (arrayIndex records 0).value 42) + (booleanAnd (intEq (arrayIndex (arrayIndex nested 1) 1) 10) + (booleanAnd (intEq (arrayLength emptyValues) 0) + (booleanAnd (intEq (arrayLength emptyFunctions) 0) + (intEq (arrayIndex input 0) 10)))))))))) then 42 else 1 +"#; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn array_apply_returns_curried_functions_through_both_entry_points() { + for operation in ["foreignApply", "arrayApply"] { + let source = format!( + r#"module Main where +foreign import "psrs:intrinsic#arrayApply" foreignApply :: forall a b. Array (a -> b) -> Array a -> Array b +add x y = intAdd x y +main = (arrayIndex ({operation} [add] [40]) 0) 2 +"# + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + } +} + +#[test] +fn array_apply_traps_before_wrapping_an_unrepresentable_result_length() { + let source = r#"module Main where +foreign import "psrs:intrinsic#arrayApply" cartesian :: forall a b. Array (a -> b) -> Array a -> Array b +double n xs = if intEq n 0 then xs else double (intSub n 1) (arrayAppend xs xs) +main = arrayLength (cartesian (double 16 [\x -> x]) (double 16 [0])) +"#; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert!( + !output.status.success(), + "the 2^32 product must trap, not return an empty array" + ); + assert!( + String::from_utf8_lossy(&output.stderr).contains("unreachable"), + "{output:?}" + ); +} + +#[test] +fn primitive_foreign_array_apply_matches_pinned_official_observations() { + let golden = include_str!("../../tests/fixtures/stdlib-array/Golden.purs"); + let declaration = golden.lines().nth(1).unwrap(); + let module = crate::prelude::sources() + .unwrap() + .iter() + .find(|module| module.module_name == "Control.Apply") + .unwrap(); + assert!( + module.text.lines().any(|line| line == declaration), + "fixture must retain the actual library binding" + ); + let sources = [ + ("Golden.purs", golden), + ( + "Main.purs", + include_str!("../../tests/fixtures/stdlib-array/Main.purs"), + ), + ]; + let Some(output) = run_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs b/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs new file mode 100644 index 00000000..d4385f4b --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs @@ -0,0 +1,2 @@ +module Golden where +foreign import "psrs:intrinsic#arrayApply" arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-array/Main.purs new file mode 100644 index 00000000..59a6c07e --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array/Main.purs @@ -0,0 +1,13 @@ +module Main where +import Golden as Golden +main = + let + r0 = Golden.arrayApply [((\offset -> \x -> intAdd offset x) 1), (\x -> intMul x 2)] [10, 20] + r1 = Golden.arrayApply [(\x -> numberAdd (intToNumber x) 0.5)] [4, 8] + r2 = Golden.arrayApply [(\x -> { value: intAdd x 2 })] [40] + r3 = Golden.arrayApply [(\x -> [x, intAdd x 1])] [5, 9] + r4 = Golden.arrayApply [(\x -> if intEq x 1 then "λ" else "😀")] [1, 2] + r5 = Golden.arrayApply [(\x -> arrayIndex ([] :: Array Int) x)] [] + r6 = Golden.arrayApply ([] :: Array (Int -> Int)) [1, 2] + curried = Golden.arrayApply [(\x -> \y -> intAdd x y)] [40] + in if (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength r0) 4) (booleanAnd (intEq (arrayIndex r0 0) 11) (intEq (arrayIndex r0 1) 21))) (booleanAnd (booleanAnd (intEq (arrayIndex r0 2) 20) (intEq (arrayIndex r0 3) 40)) (booleanAnd (intEq (arrayLength r1) 2) (numberEq (arrayIndex r1 0) 4.5)))) (booleanAnd (booleanAnd (numberEq (arrayIndex r1 1) 8.5) (booleanAnd (intEq (arrayLength r2) 1) (intEq ((arrayIndex r2 0)).value 42))) (booleanAnd (booleanAnd (intEq (arrayLength r3) 2) (intEq (arrayLength (arrayIndex r3 0)) 2)) (booleanAnd (intEq (arrayIndex (arrayIndex r3 0) 0) 5) (intEq (arrayIndex (arrayIndex r3 0) 1) 6))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength (arrayIndex r3 1)) 2) (booleanAnd (intEq (arrayIndex (arrayIndex r3 1) 0) 9) (intEq (arrayIndex (arrayIndex r3 1) 1) 10))) (booleanAnd (booleanAnd (intEq (arrayLength r4) 2) (intEq (arrayLength (stringToBytes (arrayIndex r4 0))) 2)) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 0)) 0) 206) (intEq (arrayIndex (stringToBytes (arrayIndex r4 0)) 1) 187)))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength (stringToBytes (arrayIndex r4 1))) 4) (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 0) 240)) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 1) 159) (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 2) 152))) (booleanAnd (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 3) 128) (intEq (arrayLength r5) 0)) (booleanAnd (intEq (arrayLength r6) 0) (intEq ((arrayIndex curried 0) 2) 42)))))) then 42 else 1 diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array/observations.json b/crates/psrs-driver/tests/fixtures/stdlib-array/observations.json new file mode 100644 index 00000000..8838e0f6 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array/observations.json @@ -0,0 +1,87 @@ +{ + "node": "v26.10.0", + "upstream_commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "official_js_sha256": "ddebe14d1c07db99d7c2bf659d823c35fb65409c977be0f297be3215d5e01966", + "observations": [ + { + "name": "order_and_capture", + "values": [ + 10, + 20 + ], + "result": [ + 11, + 21, + 20, + 40 + ] + }, + { + "name": "number_results", + "values": [ + 4, + 8 + ], + "result": [ + 4.5, + 8.5 + ] + }, + { + "name": "records", + "values": [ + 40 + ], + "result": [ + { + "value": 42 + } + ] + }, + { + "name": "nested_arrays", + "values": [ + 5, + 9 + ], + "result": [ + [ + 5, + 6 + ], + [ + 9, + 10 + ] + ] + }, + { + "name": "utf8_results", + "values": [ + 1, + 2 + ], + "result": [ + "λ", + "😀" + ] + }, + { + "name": "empty_values", + "values": [], + "result": [] + }, + { + "name": "empty_functions", + "values": [ + 1, + 2 + ], + "result": [] + }, + { + "name": "returned_function", + "result": 42 + } + ] +} diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index a4e442b9..1527cd5c 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -97,6 +97,8 @@ pub enum Intrinsic { /// proof; it is a representation-preserving cast at the value's erased /// boundary. UnsafeCoerce, + /// Apply each function to each value, in function-major order. + ArrayApply, } impl Intrinsic { @@ -119,7 +121,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 61] = [ + pub const ALL: [Intrinsic; 62] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -181,6 +183,7 @@ impl Intrinsic { Intrinsic::Unit, Intrinsic::ArrayAppend, Intrinsic::UnsafeCoerce, + Intrinsic::ArrayApply, ]; } @@ -189,7 +192,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::UnsafeCoerce as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::ArrayApply as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index a533f2aa..e0b55b9f 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -30,6 +30,8 @@ pub enum IntrinsicCategory { ArrayUpdate, /// `Array.append`: `forall a. Array a -> Array a -> Array a`. ArrayAppend, + /// `forall a b. Array (a -> b) -> Array a -> Array b`. + ArrayApply, /// A source `String` to its canonical UTF-8 bytes. StringToBytes, /// Canonical UTF-8 bytes back to a source `String`. @@ -142,6 +144,7 @@ descriptors! { Unit => "unit", 0, Nullary, scheme::unit; ArrayAppend => "arrayAppend", 2, ArrayAppend, scheme::array_append; UnsafeCoerce => "__psrs_unsafe_coerce", 1, Coercion, scheme::unsafe_coerce; + ArrayApply => "arrayApply", 2, ArrayApply, scheme::array_apply; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that @@ -324,6 +327,16 @@ mod scheme { ) } + pub(super) fn array_apply() -> Type { + forall( + &["a", "b"], + arrow( + array(arrow(variable("a"), variable("b"))), + arrow(array(variable("a")), array(variable("b"))), + ), + ) + } + pub(super) fn string_to_bytes() -> Type { arrow(builtin(BuiltinType::String), array(int())) } diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index f1460fb6..e32a683c 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -601,3 +601,36 @@ These source instances do not change native tuple syntax or WIT tuple layout. `string`, and tuples. - Issue #56, whose request to grow compiler source types for `Maybe`, `Either`, and tuples this contract replaces. The user-facing types remain library types. + +## Polymorphic primitive foreign functions + +An explicit primitive binding retains its checked source signature. P8 reads +its leading lexical quantifiers through Core's shared scheme operation and +moves their identities into the generated declaration scope. It peels only the +body's leading arrows, preserves the declared element relationships, and uses +Core's intrinsic verifier before publishing the generated function. Unsupported +categories and malformed signatures still fail, including unused declarations. +This supports the existing array and UTF-8 byte primitives as ordinary foreign +functions without weakening their type contracts. + +`arrayApply` has scheme `forall a b. Array (a -> b) -> Array a -> Array b`. +Core verifies both element relationships. CC records the three array +representations, the actual callback signature, and an invocation helper. +The helper consumes exactly one source argument through the common application +lowering, including partial application when the callback returns a function. +The full CC verifier requires that helper to exist with the checked input/output +ABI; per-function verification defers helper existence to that module check. +Reachability retains the helper, callback signature, and array representations. + +MIR allocates once and emits nested loops in function-major order. Each function +is cached for its entire value traversal; inputs are preserved. Nullable storage +views permit references to cross structured control labels and are refined at +use sites. These refinements preserve the existing calling convention; callable +adaptation remains owned by the common checked conversion/application protocol. +Negative source lengths and products outside signed i32 capacity trap before +allocation or callbacks. Empty inputs invoke no callbacks. + +The library owns its pinned JS oracle and source binding in `psrs-stdlib`; +see its `docs/array-apply.md` and `conformance/arrays.mjs`. Whole-library compile +acceptance and runtime/FFI acceptance remain independent of this operation's +focused behavior evidence. diff --git a/docs/implementation/stdlib/array-apply-2026-10-06/report.md b/docs/implementation/stdlib/array-apply-2026-10-06/report.md new file mode 100644 index 00000000..49e61275 --- /dev/null +++ b/docs/implementation/stdlib/array-apply-2026-10-06/report.md @@ -0,0 +1,51 @@ +# Polymorphic array application checkpoint + +The target implements `Control.Apply.arrayApply` through the explicit registry +binding `psrs:intrinsic#arrayApply`. The independent library revision is +`b367cd7cc4b2e9f5933bffb9938a1cdbe221fd8f`. Its only additional official-source +difference is the foreign binding string; the signature and pure declarations +remain unchanged. The upstream remains pinned prelude v6.0.1 at +`f4cad0ae8106185c9ab407f43cf9abf05c256af4`. + +The prerequisite is a general primitive foreign-function link contract: leading +quantifier identities move into the generated declaration's scope, while the +body retains its checked type relationships. Existing array/byte operations +share their Core verification and backend implementation. Unsupported categories +still fail, and linking retains its complete rollback contract. + +Array application carries its callback signature, array representations, and +invoker through CC. The invoker uses the common application/partial-call path, +including returned functions. The full CC verifier checks its actual ABI and +reachability retains it. MIR allocates once and emits function-major nested +loops, caching each function for its entire inner traversal. It preserves both +inputs and traps on unrepresentable lengths before allocation or callbacks. + +Evidence: + +- Driver primitive foreign tests: 13 passed with mandatory Wasmtime. They cover + captures, callback/result order, Int/Number/String/record/nested-array values, + empty arrays, returned curried functions through both entry points, invalid + signatures, and an overflowing `2^32` result length that must trap. +- Official JS oracle: eight cases and 29 value checks; Wasmtime exit 42 with + empty stdout and stderr. `run.json` records binary/source/package/Wasm hashes + and commands; `observations.json` records the pinned official observations. +- CC invalid-invoker test: one passed; missing helpers and incorrect result ABIs + are rejected by the complete check. +- Primitive transactional/link-identity tests: three passed. +- Core scheme scope/malformed-spine tests: two passed. +- Intrinsic descriptor/arity test: one passed. +- Let-constraint regressions: 14 passed. +- CLI build, formatting, and workspace clippy with warnings denied passed. +- Full source audit: 41 packages, 215 modules, 194 exact, 12 modified, nine + platform additions, no missing upstream modules, no detected direct + same-argument self-recursions. Audit counts do not approve every adaptation. + +The full stdlib reproducer remains failed. P8 missing-library-implementation +reports decreased from 233 to 232; the first is now `Control.Bind.arrayBind`. +The input file is unchanged, but package content and its diagnosis cohort +fingerprint changed deliberately; these are migration measurements, not an +unchanged-cohort comparison or an official-suite scoreboard update. + +No full workspace tests or full scoreboard were run. Whole-library compile and +runtime/FFI acceptance, remaining implementations, and independent CI package +acquisition remain open. No push, PR, or issue operation was performed. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 52b32234..2420ea45 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -48,3 +48,20 @@ skip. No runner command publishes or modifies upstream checkouts. See [the repository boundary](../design/D-17-stdlib-and-conformance-boundaries.md) for ownership, package locking, and the limits of this evidence. + +The library owns non-scalar case generators as well. For array application: + +```sh +node ../psrs-stdlib/conformance/arrays.mjs \ + /private/tmp/purescript-prelude /tmp/psrs-array-oracle +python3 -m stdlib_conformance run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-array-oracle/Golden.purs \ + --input /tmp/psrs-array-oracle/Main.purs \ + --out /tmp/psrs-array-runtime +``` + +The generator verifies the clean upstream revision, evaluates the official JS +function, copies the actual vendored binding signature, and emits value checks. +Keep generators and cases in the library package; the independent runtime runner +continues to consume executable and source paths without compiler-internal APIs. diff --git a/stdlib.lock.json b/stdlib.lock.json index c24b5ca4..91465a90 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "a08b4c8e300234b51b5c4f1128705eb95ab84a37", - "source_fingerprint": "fnv1a64-v1:cc98c3102452f8ad" + "revision": "b367cd7cc4b2e9f5933bffb9938a1cdbe221fd8f", + "source_fingerprint": "fnv1a64-v1:aca9437f2fcdd5a8" } From 2a407648784a34bb6cb9a72eb8ff85f0aff6196f Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 17:44:31 +0800 Subject: [PATCH 040/148] Consume library-owned Node conformance tools and remove compiler copies --- AGENTS.md | 7 +- .../D-17-stdlib-and-conformance-boundaries.md | 13 +- docs/workflow/stdlib-conformance.md | 22 +- docs/workflow/stdlib-vendoring.md | 6 +- docs/workflow/tools/audit-stdlib-vendor.py | 10 - docs/workflow/tools/stdlib-scalar-oracle.mjs | 16 -- stdlib.lock.json | 2 +- tools/stdlib-conformance/pyproject.toml | 19 -- .../src/stdlib_conformance/__init__.py | 1 - .../src/stdlib_conformance/__main__.py | 3 - .../src/stdlib_conformance/audit.py | 245 ------------------ .../src/stdlib_conformance/cli.py | 23 -- .../src/stdlib_conformance/package.py | 37 --- .../src/stdlib_conformance/runner.py | 106 -------- .../src/stdlib_conformance/scalar_oracle.mjs | 102 -------- 15 files changed, 31 insertions(+), 581 deletions(-) delete mode 100644 docs/workflow/tools/audit-stdlib-vendor.py delete mode 100644 docs/workflow/tools/stdlib-scalar-oracle.mjs delete mode 100644 tools/stdlib-conformance/pyproject.toml delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/__init__.py delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/__main__.py delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/audit.py delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/cli.py delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/package.py delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/runner.py delete mode 100644 tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs diff --git a/AGENTS.md b/AGENTS.md index 2cdf61cf..129e533d 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -48,9 +48,10 @@ uncommitted work. APIs execute, that every declaration survives backend lowering, or that FFI behavior agrees with its contract. -- Use the standalone [conformance commands](docs/workflow/stdlib-conformance.md) - for source and runtime comparisons. The tool consumes executable and package - paths; it must not depend on compiler-internal representations. +- Use the library-owned Node [conformance commands](docs/workflow/stdlib-conformance.md) + in `psrs-stdlib/tools/` for source and runtime comparisons. Maintain tool code + and case engines in that repository; keep compiler locks and Rust tests here. + The tool consumes executable and package paths; it must not depend on compiler-internal representations. ### Commit granularity diff --git a/docs/design/D-17-stdlib-and-conformance-boundaries.md b/docs/design/D-17-stdlib-and-conformance-boundaries.md index b9f9ac93..d405ced1 100644 --- a/docs/design/D-17-stdlib-and-conformance-boundaries.md +++ b/docs/design/D-17-stdlib-and-conformance-boundaries.md @@ -15,10 +15,13 @@ evidence, supported binding protocols, lowering, and runtime representation. Library source changes cannot compensate for compiler defects. Follow the [source-fidelity contract](../workflow/stdlib-vendoring.md). -`tools/stdlib-conformance` is a standalone Python/Node component. It compares +`psrs-stdlib/tools/conformance.mjs` is a library-owned Node component. It compares source inventories, evaluates pinned upstream JavaScript implementations, and runs a compiler executable and Wasmtime. Inputs are package paths, manifests, -case data, and executable paths. It has no compiler-internal Rust dependency. +case data, and executable paths. It uses Node built-ins, requires no npm +installation, and has no compiler-internal Rust dependency. Its implementation +and tests evolve with the library; the compiler retains package locking and +Rust integration tests. A future cargo xtask may invoke these commands without becoming their owner. ## Package selection @@ -47,11 +50,13 @@ remain in the driver and resolver respectively. The `fnv1a64-v1:` identifier is a reproducibility fingerprint, not a cryptographic integrity check. Starting at FNV-1a's 64-bit offset basis, hash the bytes -`psrs-stdlib-content-v1` followed by NUL. Sort all relative file paths from -`lib/`, `conformance/`, `manifest.json`, and `upstream-lock.json`. For each, +`psrs-stdlib-content-v1` followed by NUL. Sort relative paths lexicographically +by UTF-8 path components from `lib/`, `conformance/`, `manifest.json`, and `upstream-lock.json`. For each, hash its UTF-8 path, NUL, file length as unsigned 64-bit little-endian bytes, and the exact file bytes. FNV multiplication wraps at 64 bits. Package symlinks and special files are rejected. The upstream lock retains cryptographic hashes. +Tooling and docs are outside this package content fingerprint; record the library tool revision with evidence. +Moving tools does not change the source/case fingerprint. The CLI obtains the fingerprint from the driver's selected package, including an override. This changes the diagnosis cohort identity from the previous diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 2420ea45..3e2e882b 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -1,19 +1,17 @@ # Standard-library conformance commands -The standalone component is in `tools/stdlib-conformance`. It requires Python -3.9 or newer; scalar oracle generation also requires Node with ES module -support. Run it directly without installing dependencies: +The library-owned Node component is `../psrs-stdlib/tools/conformance.mjs`. +It requires Node 22.7 or newer and has no npm dependencies. Run it directly: ```sh -export PYTHONPATH=tools/stdlib-conformance/src -python3 -m stdlib_conformance --help +node ../psrs-stdlib/tools/conformance.mjs --help ``` A pinned complete source audit accepts the independent package and upstream checkout directories. Supply the lock to reject a different upstream baseline: ```sh -python3 -m stdlib_conformance audit \ +node ../psrs-stdlib/tools/conformance.mjs audit \ --vendor ../psrs-stdlib/lib \ --inventory ../psrs-stdlib/upstream-lock.json \ --upstream /private/tmp/ps-pkgs \ @@ -27,14 +25,14 @@ its differences. Check the actual pinned checkout locations before running. Generate and execute the currently implemented scalar cases: ```sh -python3 -m stdlib_conformance scalar-oracle \ +node ../psrs-stdlib/tools/conformance.mjs scalar-oracle \ --vendor ../psrs-stdlib/lib \ --inventory ../psrs-stdlib/upstream-lock.json \ --cases ../psrs-stdlib/conformance/scalars.json \ --upstream purescript-prelude=/private/tmp/purescript-prelude \ --upstream purescript-integers=/private/tmp/ps-pkgs/purescript-integers \ --out /tmp/psrs-stdlib-oracle -python3 -m stdlib_conformance run \ +node ../psrs-stdlib/tools/conformance.mjs run \ --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ --input /tmp/psrs-stdlib-oracle/Golden.purs \ --input /tmp/psrs-stdlib-oracle/Main.purs \ @@ -54,7 +52,7 @@ The library owns non-scalar case generators as well. For array application: ```sh node ../psrs-stdlib/conformance/arrays.mjs \ /private/tmp/purescript-prelude /tmp/psrs-array-oracle -python3 -m stdlib_conformance run \ +node ../psrs-stdlib/tools/conformance.mjs run \ --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ --input /tmp/psrs-array-oracle/Golden.purs \ --input /tmp/psrs-array-oracle/Main.purs \ @@ -65,3 +63,9 @@ The generator verifies the clean upstream revision, evaluates the official JS function, copies the actual vendored binding signature, and emits value checks. Keep generators and cases in the library package; the independent runtime runner continues to consume executable and source paths without compiler-internal APIs. + +Tool changes and their tests belong in `psrs-stdlib`; run `npm test` there. +The compiler retains its package lock and Rust regression tests. A cargo xtask +wrapper, if added, should delegate to this CLI. The former Python component and +compiler-local compatibility scripts were removed after report-equivalent Node +validation. Historical evidence retains the commands used at that time. diff --git a/docs/workflow/stdlib-vendoring.md b/docs/workflow/stdlib-vendoring.md index cd6ce47d..cba61d46 100644 --- a/docs/workflow/stdlib-vendoring.md +++ b/docs/workflow/stdlib-vendoring.md @@ -20,8 +20,10 @@ compiler and tooling source. Do not split official modules to satisfy that rule. The initial complete audit and pinned comparison baselines are recorded in [the source audit](../implementation/stdlib/vendor-audit-2026-10-06/report.md). That audit describes revision 67369ba, including defects; it is not an approved -patch manifest. Its repeatable inventory tool is -[audit-stdlib-vendor.py](tools/audit-stdlib-vendor.py). +patch manifest. The current repeatable inventory tool is owned by `psrs-stdlib`: +see [the Node conformance commands](stdlib-conformance.md). Historical reports +retain their original Python commands; the Node port preserves their evidence +fields and uses Git for unified patch generation. The [restoration checkpoint](../implementation/stdlib/vendor-restoration-2026-10-06/report.md) records restored sources, remaining target adaptations, and missing foreign diff --git a/docs/workflow/tools/audit-stdlib-vendor.py b/docs/workflow/tools/audit-stdlib-vendor.py deleted file mode 100644 index ba89e903..00000000 --- a/docs/workflow/tools/audit-stdlib-vendor.py +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/env python3 -"""Compatibility entry for the standalone stdlib conformance component.""" -from pathlib import Path -import sys - -sys.path.insert(0, str(Path(__file__).resolve().parents[3] / "tools/stdlib-conformance/src")) -from stdlib_conformance.audit import main - -if __name__ == "__main__": - main() diff --git a/docs/workflow/tools/stdlib-scalar-oracle.mjs b/docs/workflow/tools/stdlib-scalar-oracle.mjs deleted file mode 100644 index 1502fb0f..00000000 --- a/docs/workflow/tools/stdlib-scalar-oracle.mjs +++ /dev/null @@ -1,16 +0,0 @@ -// Compatibility entrypoint; the implementation accepts independent package paths. -import { readFileSync } from 'node:fs'; -import { resolve } from 'node:path'; -import { spawnSync } from 'node:child_process'; -const [prelude, integers, out] = process.argv.slice(2); -if (!prelude || !integers || !out) throw Error('usage: node stdlib-scalar-oracle.mjs PRELUDE INTEGERS OUTPUT'); -const compilerRoot = resolve(import.meta.dirname, '../../..'); -const lock = JSON.parse(readFileSync(resolve(compilerRoot, 'stdlib.lock.json'), 'utf8')); -const root = process.env.PSRS_STDLIB_ROOT ?? resolve(compilerRoot, lock.path); -const script = resolve(compilerRoot, 'tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs'); -const result = spawnSync(process.execPath, [script, '--vendor', resolve(root, 'lib'), - '--inventory', resolve(root, 'upstream-lock.json'), '--cases', resolve(root, 'conformance/scalars.json'), - '--upstream', `purescript-prelude=${resolve(prelude)}`, '--upstream', `purescript-integers=${resolve(integers)}`, - '--out', resolve(out)], { stdio: 'inherit' }); -if (result.error) throw result.error; -process.exit(result.status ?? 1); diff --git a/stdlib.lock.json b/stdlib.lock.json index 91465a90..3950e6c9 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "b367cd7cc4b2e9f5933bffb9938a1cdbe221fd8f", + "revision": "073e32581dfe21ef7191ac906b36ba5445b3152a", "source_fingerprint": "fnv1a64-v1:aca9437f2fcdd5a8" } diff --git a/tools/stdlib-conformance/pyproject.toml b/tools/stdlib-conformance/pyproject.toml deleted file mode 100644 index bf142dba..00000000 --- a/tools/stdlib-conformance/pyproject.toml +++ /dev/null @@ -1,19 +0,0 @@ -[build-system] -requires = ["setuptools>=68"] -build-backend = "setuptools.build_meta" - -[project] -name = "psrs-stdlib-conformance" -version = "0.1.0" -description = "Independent PureScript source fidelity and target conformance tools" -requires-python = ">=3.9" -dependencies = [] - -[project.scripts] -psrs-stdlib-conformance = "stdlib_conformance.cli:main" - -[tool.setuptools.packages.find] -where = ["src"] - -[tool.setuptools.package-data] -stdlib_conformance = ["*.mjs"] diff --git a/tools/stdlib-conformance/src/stdlib_conformance/__init__.py b/tools/stdlib-conformance/src/stdlib_conformance/__init__.py deleted file mode 100644 index 045d6956..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/__init__.py +++ /dev/null @@ -1 +0,0 @@ -"""Conformance tools with no compiler-library or workspace dependency.""" diff --git a/tools/stdlib-conformance/src/stdlib_conformance/__main__.py b/tools/stdlib-conformance/src/stdlib_conformance/__main__.py deleted file mode 100644 index eb53e2f3..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/__main__.py +++ /dev/null @@ -1,3 +0,0 @@ -from .cli import main - -raise SystemExit(main()) diff --git a/tools/stdlib-conformance/src/stdlib_conformance/audit.py b/tools/stdlib-conformance/src/stdlib_conformance/audit.py deleted file mode 100644 index 1da23ba5..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/audit.py +++ /dev/null @@ -1,245 +0,0 @@ -#!/usr/bin/env python3 -"""Compare vendored modules with locally available, tagged upstream checkouts. - -This is an inventory, not an allowlist or a PureScript semantic verifier. -It never modifies library sources and never downloads missing dependencies. -""" - -import argparse -import collections -import difflib -import hashlib -import json -from pathlib import Path -import re -import subprocess - - -def git(root, *args): - return subprocess.check_output( - ["git", "-C", str(root), *args], text=True, stderr=subprocess.PIPE - ).strip() - - -def digest(data): - return hashlib.sha256(data).hexdigest() - - -def append_diff(patch, original, vendored, before_path, after_path): - differences = difflib.unified_diff( - original.splitlines(keepends=True), vendored.splitlines(keepends=True), - fromfile=before_path, tofile=after_path, - ) - for line in differences: - patch.append(line if line.endswith("\n") else line + "\n\\ No newline at end of file\n") - - -def foreign_declarations(text): - lines = text.splitlines() - declarations = [] - covered = set() - for index, line in enumerate(lines): - match = re.match(r"^foreign import (?!data\b)([\w']+)\b", line) - if not match: - continue - end = index + 1 - while end < len(lines) and lines[end].startswith((" ", "\t")): - end += 1 - covered.update(range(index, end)) - declarations.append({ - "name": match[1], - "line": index + 1, - "declaration": " ".join(part.strip() for part in lines[index:end]), - }) - return declarations, covered - - -def self_recursions(text): - result = [] - for number, line in enumerate(text.splitlines(), 1): - match = re.fullmatch( - r"([A-Za-z_][\w']*(?:\s+[A-Za-z_][\w']*)*)\s*=\s*(.*?)\s*", - line, - ) - if match and match[1].split() == match[2].split(): - result.append({"name": match[1].split()[0], "line": number, "equation": line}) - return result - - -def ordinary_removals(before, after, foreign_lines): - """Report changed original code outside value FFI declaration spans. - - This deliberately reports eta expansion and signature/layout changes too. - A reported removal requires review; it does not automatically prove a bug. - """ - old, new = before.splitlines(), after.splitlines() - result = [] - for kind, start, end, _, _ in difflib.SequenceMatcher( - None, old, new, autojunk=False - ).get_opcodes(): - if kind not in ("delete", "replace"): - continue - for index in range(start, end): - line = old[index] - if index not in foreign_lines and line.strip() and not line.lstrip().startswith("--"): - result.append({"line": index + 1, "text": line}) - return result - - -def main(argv=None): - parser = argparse.ArgumentParser(description=__doc__) - parser.add_argument("--vendor", type=Path, required=True) - parser.add_argument("--upstream", type=Path, action="append", required=True, - help="A git checkout with src/, or a directory of those checkouts") - parser.add_argument("--out", type=Path, required=True) - parser.add_argument("--inventory", type=Path, help="Pinned upstream package inventory") - args = parser.parse_args(argv) - pins = json.loads(args.inventory.read_text())["packages"] if args.inventory else None - args.out.mkdir(parents=True, exist_ok=True) - roots = [] - for root in args.upstream: - if (root / "src").is_dir(): - roots.append(root) - else: - roots.extend(child for child in sorted(root.iterdir()) if (child / "src").is_dir()) - - packages, sources = [], {} - for root in roots: - if git(root, "status", "--porcelain"): - raise SystemExit(f"upstream checkout is dirty: {root}") - package = { - "name": root.name, - "checkout": str(root.resolve()), - "commit": git(root, "rev-parse", "HEAD"), - "tag": git(root, "describe", "--tags", "--exact-match"), - "remote": git(root, "remote", "get-url", "origin"), - } - if pins is not None: - pin = next((pin for pin in pins if pin["name"] == package["name"]), None) - if pin is None or any(pin[key] != package[key] for key in ("commit", "tag", "remote")): - raise SystemExit(f"upstream checkout differs from package pin: {root}") - packages.append(package) - for path in sorted((root / "src").rglob("*.purs")): - relative = path.relative_to(root / "src").as_posix() - if relative in sources: - raise SystemExit(f"duplicate upstream source: {relative}") - sources[relative] = (path, package) - - if pins is not None and {pin["name"] for pin in pins} != {package["name"] for package in packages}: - raise SystemExit("upstream checkout set does not cover every pinned package") - - modules, patch = [], [] - for path in sorted(args.vendor.rglob("*.purs")): - relative = path.relative_to(args.vendor).as_posix() - data = path.read_bytes() - text = data.decode("utf-8") - row = { - "path": relative, - "vendored_sha256": digest(data), - "vendored_lines": len(text.splitlines()), - "self_recursions": self_recursions(text), - } - if relative not in sources: - row["status"] = "platform_addition" if relative.startswith("WASI/") or relative == "WASI.purs" else "baseline_unavailable" - modules.append(row) - continue - upstream, package = sources[relative] - original_data = upstream.read_bytes() - original = original_data.decode("utf-8") - row.update({ - "package": package["name"], - "tag": package["tag"], - "commit": package["commit"], - "upstream_sha256": digest(original_data), - "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, - "status": "identical" if data == original_data else "newline_only" if original.splitlines() == text.splitlines() else "modified", - }) - declarations, covered = foreign_declarations(original) - names = {declaration["name"] for declaration in declarations} - recursive_names = {recursion["name"] for recursion in row["self_recursions"]} - retained_foreign_names = set(re.findall( - r'^foreign import (?:"[^"\n]*"\s+)?(?!data\b)([\w\x27]+)\b', text, re.M - )) - for declaration in declarations: - name = declaration["name"] - declaration["vendored_status"] = ( - "foreign_declaration_retained" if name in retained_foreign_names else - "direct_self_recursion" if name in recursive_names else - "nonrecursive_replacement" if re.search(r"^" + re.escape(name) + r"\s*::", text, re.M) else - "declaration_removed" - ) - row["upstream_value_foreign_declarations"] = declarations - for recursion in row["self_recursions"]: - recursion["replaces_upstream_foreign"] = recursion["name"] in names - row["changed_original_code_outside_value_ffi"] = ordinary_removals(original, text, covered) - if data != original_data: - append_diff(patch, original, text, - package["name"] + "@" + package["tag"] + "/src/" + relative, - "vendor/" + relative) - modules.append(row) - - absent_modules = [] - absent_paths = sorted(set(sources) - {row["path"] for row in modules}) - for relative in absent_paths: - path, package = sources[relative] - data = path.read_bytes() - absent_modules.append({ - "path": relative, - "package": package["name"], - "tag": package["tag"], - "commit": package["commit"], - "upstream_sha256": digest(data), - "upstream_url": package["remote"].removesuffix(".git") + "/blob/" + package["commit"] + "/src/" + relative, - }) - append_diff(patch, data.decode("utf-8"), "", - package["name"] + "@" + package["tag"] + "/src/" + relative, - "/dev/null") - - counts = dict(collections.Counter(row["status"] for row in modules)) - counts.update({ - "vendored_modules": len(modules), - "packages": len(packages), - "direct_self_recursions": sum(len(row["self_recursions"]) for row in modules), - "modules_with_direct_self_recursions": sum(bool(row["self_recursions"]) for row in modules), - "upstream_modules_absent_from_vendor": absent_paths, - "upstream_value_foreign_declarations": dict(collections.Counter( - declaration["vendored_status"] for row in modules - for declaration in row.get("upstream_value_foreign_declarations", []) - )), - }) - try: - vendor_revision = git(args.vendor.resolve(), "rev-parse", "HEAD") - except subprocess.CalledProcessError: - vendor_revision = None - result = { - "schema_version": 2, - "vendor_revision": vendor_revision, - "counts": counts, - "packages": packages, - "modules": modules, - "absent_modules": absent_modules, - "limits": [ - "Only supplied upstream checkouts are compared; baseline_unavailable is not a pass.", - "Self-recursion detection covers exact top-level same-argument equations only.", - "The script records differences without approving target adaptations or proving semantic equivalence.", - "The official compiler support dependency ranges do not uniquely pin package patch versions.", - ], - } - (args.out / "inventory.json").write_text(json.dumps(result, ensure_ascii=False, indent=2) + "\n") - (args.out / "official-vs-vendored.diff").write_text("".join(patch)) - table = ["# Vendored module inventory", "", "Generated by `audit-stdlib-vendor.py`. Status is comparison evidence, not approval.", "", - "| Module path | Official package/tag | Comparison | Direct self-recursions |", "| --- | --- | --- | --- |"] - for row in modules: - origin = row.get("package", "unavailable") + (" " + row["tag"] if "tag" in row else "") - table.append(f"| `{row['path']}` | {origin} | {row['status']} | {len(row['self_recursions'])} |") - if absent_modules: - table.extend(["", "## Official modules absent from the vendored library", "", - "| Module path | Official package/tag |", "| --- | --- |"]) - for row in absent_modules: - table.append(f"| `{row['path']}` | {row['package']} {row['tag']} |") - (args.out / "modules.md").write_text("\n".join(table) + "\n") - print(json.dumps(counts, ensure_ascii=False, indent=2)) - - -if __name__ == "__main__": - main() diff --git a/tools/stdlib-conformance/src/stdlib_conformance/cli.py b/tools/stdlib-conformance/src/stdlib_conformance/cli.py deleted file mode 100644 index 59cad367..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/cli.py +++ /dev/null @@ -1,23 +0,0 @@ -"""Standalone command boundary for source and runtime evidence.""" - -import argparse -from pathlib import Path -import subprocess - -from . import audit - - -def main(argv=None): - parser = argparse.ArgumentParser(description=__doc__) - parser.add_argument("command", choices=["audit", "scalar-oracle", "run"]) - parser.add_argument("arguments", nargs=argparse.REMAINDER) - args = parser.parse_args(argv) - remaining = args.arguments - if args.command == "audit": - audit.main(remaining) - return 0 - if args.command == "scalar-oracle": - script = Path(__file__).with_name("scalar_oracle.mjs") - return subprocess.call(["node", str(script), *remaining]) - from .runner import main as run - return run(remaining) diff --git a/tools/stdlib-conformance/src/stdlib_conformance/package.py b/tools/stdlib-conformance/src/stdlib_conformance/package.py deleted file mode 100644 index 275cde1f..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/package.py +++ /dev/null @@ -1,37 +0,0 @@ -"""Portable package content identity shared with the compiler loader.""" - -from pathlib import Path - - -def fingerprint(root): - root = Path(root) - paths = [Path('manifest.json'), Path('upstream-lock.json')] - for directory in ('lib', 'conformance'): - if (root / directory).is_symlink(): - raise ValueError(f'package symlinks are unsupported: {directory}') - if not (root / directory).is_dir(): - raise ValueError(f'missing package directory: {directory}') - for path in (root / directory).rglob('*'): - if path.is_symlink(): - raise ValueError(f'package symlinks are unsupported: {path}') - if path.is_file(): - paths.append(path.relative_to(root)) - elif not path.is_dir(): - raise ValueError(f'expected regular package file: {path}') - value = 0xcbf29ce484222325 - - def feed(data): - nonlocal value - for byte in data: - value = ((value ^ byte) * 0x100000001b3) & ((1 << 64) - 1) - - feed(b'psrs-stdlib-content-v1\0') - for path in sorted(paths): - if (root / path).is_symlink(): - raise ValueError(f'package symlinks are unsupported: {path}') - data = (root / path).read_bytes() - feed(path.as_posix().encode('utf-8')) - feed(b'\0') - feed(len(data).to_bytes(8, 'little')) - feed(data) - return f'fnv1a64-v1:{value:016x}' diff --git a/tools/stdlib-conformance/src/stdlib_conformance/runner.py b/tools/stdlib-conformance/src/stdlib_conformance/runner.py deleted file mode 100644 index 207b3546..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/runner.py +++ /dev/null @@ -1,106 +0,0 @@ -"""Run compiler and mandatory Wasmtime through public executable boundaries.""" - -import argparse -import base64 -import hashlib -import json -import os -from pathlib import Path -import shutil -import subprocess -import time - -from .package import fingerprint - - -def digest(data): - return hashlib.sha256(data).hexdigest() - - -def output(data): - return {'base64': base64.b64encode(data).decode('ascii'), 'sha256': digest(data)} - - -def invoke(argv, timeout, env=None): - start = time.monotonic() - try: - result = subprocess.run(argv, capture_output=True, timeout=timeout, env=env) - record = {'status': 'completed', 'exit_code': result.returncode, - 'stdout': output(result.stdout), 'stderr': output(result.stderr)} - except subprocess.TimeoutExpired as error: - record = {'status': 'timeout', 'stdout': output(error.stdout or b''), - 'stderr': output(error.stderr or b'')} - except OSError as error: - record = {'status': 'launch_failed', 'error': str(error)} - return {**record, 'argv': argv, 'elapsed_seconds': time.monotonic() - start} - - -def executable(value): - resolved = shutil.which(value) - if resolved is None: - raise ValueError(f'executable unavailable: {value}') - return str(Path(resolved).resolve()) - - -def main(argv=None): - parser = argparse.ArgumentParser(description=__doc__) - parser.add_argument('--compiler', required=True) - parser.add_argument('--stdlib-root', required=True, type=Path) - parser.add_argument('--wasmtime', default='wasmtime') - parser.add_argument('--input', action='append', required=True, type=Path) - parser.add_argument('--out', required=True, type=Path) - parser.add_argument('--timeout', default=180, type=float) - parser.add_argument('--expected-exit', default=42, type=int) - parser.add_argument('--expected-stdout', type=Path) - parser.add_argument('--expected-stderr', type=Path) - args = parser.parse_args(argv) - args.out.mkdir(parents=True, exist_ok=True) - report_path = args.out / 'run.json' - report = {'schema_version': 1, 'accepted': False} - try: - if args.timeout <= 0: - raise ValueError('timeout must be positive') - compiler = executable(args.compiler) - runtime = executable(args.wasmtime) - root = args.stdlib_root.resolve(strict=True) - package = json.loads((root / 'manifest.json').read_text()) - if package.get('schema_version') != 1 or package.get('name') != 'psrs-stdlib': - raise ValueError('unsupported stdlib package manifest') - before = fingerprint(root) - report['stdlib'] = {'root': str(root), 'source_fingerprint': before} - report['compiler'] = {'path': compiler, 'sha256': digest(Path(compiler).read_bytes())} - report['runtime'] = {'path': runtime, 'sha256': digest(Path(runtime).read_bytes()), - 'version': invoke([runtime, '--version'], args.timeout)} - version = report['runtime']['version'] - if version['status'] != 'completed' or version['exit_code'] != 0: - raise ValueError('runtime version query failed') - inputs = [path.resolve(strict=True) for path in args.input] - report['inputs'] = [{'path': str(path), 'sha256': digest(path.read_bytes())} for path in inputs] - expected = {'exit_code': args.expected_exit, - 'stdout': output(args.expected_stdout.read_bytes() if args.expected_stdout else b''), - 'stderr': output(args.expected_stderr.read_bytes() if args.expected_stderr else b'')} - report['expected'] = expected - wasm = (args.out / 'program.wasm').resolve() - # Stale output can never serve as evidence for a failed build. - wasm.unlink(missing_ok=True) - env = {**os.environ, 'PSRS_STDLIB_ROOT': str(root)} - build = invoke([compiler, 'build', *map(str, inputs), '-o', str(wasm)], args.timeout, env) - report['compilation'] = build - if build['status'] == 'completed' and build['exit_code'] == 0: - report['wasm'] = {'path': str(wasm), 'sha256': digest(wasm.read_bytes())} - run = invoke([runtime, str(wasm)], args.timeout) - report['execution'] = run - report['accepted'] = (run['status'] == 'completed' and - all(run[key] == value for key, value in expected.items())) - after = fingerprint(root) - report['stdlib']['unchanged_during_run'] = before == after - report['inputs_unchanged_during_run'] = all( - digest(Path(row['path']).read_bytes()) == row['sha256'] for row in report['inputs']) - if before != after or not report['inputs_unchanged_during_run']: - report['accepted'] = False - except (OSError, ValueError, KeyError) as error: - report['error'] = str(error) - report['accepted'] = False - report_path.write_text(json.dumps(report, indent=2) + '\n') - print(f'{report_path}: {"accepted" if report["accepted"] else "failed"}') - return 0 if report['accepted'] else 1 diff --git a/tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs b/tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs deleted file mode 100644 index 730191f3..00000000 --- a/tools/stdlib-conformance/src/stdlib_conformance/scalar_oracle.mjs +++ /dev/null @@ -1,102 +0,0 @@ -// Generate source-signature and behavior fixtures from pinned official FFI. -import { readFile, writeFile, mkdir } from 'node:fs/promises'; -import { execFileSync } from 'node:child_process'; -import { createHash } from 'node:crypto'; -import { resolve, join } from 'node:path'; -import { pathToFileURL } from 'node:url'; -import { parseArgs } from 'node:util'; - -const { values } = parseArgs({ options: Object.fromEntries( - ['vendor', 'inventory', 'cases', 'out', 'upstream'].map(name => [name, { type: 'string', multiple: name === 'upstream' }])) }); -for (const name of ['vendor', 'inventory', 'cases', 'out']) - if (!values[name]) throw Error(`missing --${name}`); -const output = resolve(values.out); -const inventory = JSON.parse(await readFile(values.inventory, 'utf8')); -const caseManifest = JSON.parse(await readFile(values.cases, 'utf8')); -if (caseManifest.schema_version !== 1 || caseManifest.target_int_representation !== 'signed-i32') - throw Error('unsupported scalar conformance contract'); -const roots = Object.fromEntries((values.upstream ?? []).map(value => { - const split = value.indexOf('='); - if (split < 1) throw Error('upstream must be PACKAGE=CHECKOUT'); - return [value.slice(0, split), resolve(value.slice(split + 1))]; -})); -for (const [packageName, root] of Object.entries(roots)) { - const pin = inventory.packages.find(value => value.name === packageName); - if (!pin) throw Error(`unknown upstream package: ${packageName}`); - if (execFileSync('git', ['-C', root, 'rev-parse', 'HEAD'], { encoding: 'utf8' }).trim() !== pin.commit) - throw Error(`unexpected upstream revision: ${packageName}`); - if (execFileSync('git', ['-C', root, 'status', '--porcelain'], { encoding: 'utf8' }).trim()) - throw Error(`dirty upstream: ${packageName}`); -} -function decode(value) { - if (typeof value !== 'object' || value === null) return value; - const special = { NaN, Infinity, '-Infinity': -Infinity, '-0': -0 }; - if (Object.keys(value).length !== 1 || !Object.hasOwn(special, value.number)) - throw Error('invalid special numeric input'); - return special[value.number]; -} -const specifications = caseManifest.bindings.map(row => [row.module, row.name, row.arguments.map(args => args.map(decode))]); -const hashes = new Map(), declarations = [], observations = [], checks = []; -function marker(value) { - if (typeof value !== 'number') return value; - if (Number.isNaN(value)) return 'NaN'; - if (Object.is(value, -0)) return '-0'; - if (!Number.isFinite(value)) return String(value); - return value; -} -function literal(value, type) { - if (typeof value === 'boolean') return String(value); - if (typeof value === 'string') return `'${value}'`; - if (Number.isNaN(value)) return '(numberDiv 0.0 0.0)'; - if (!Number.isFinite(value)) return `(numberDiv ${value < 0 ? '(numberNeg 1.0)' : '1.0'} 0.0)`; - const negative = value < 0 || Object.is(value, -0); - const magnitude = String(Math.abs(value)); - if (type === 'Number') { - const number = magnitude.includes('.') ? magnitude : magnitude + '.0'; - return negative ? `(numberNeg ${number})` : number; - } - if (value === -2147483648) return '(intSub (intNeg 2147483647) 1)'; - return negative ? `(intNeg ${magnitude})` : magnitude; -} -for (const [file, name, cases] of specifications) { - const metadata = inventory.modules.find(value => value.path === file); - if (!metadata || !roots[metadata.package]) throw Error(`missing upstream root for ${file}`); - const upstream = join(roots[metadata.package], 'src', file.replace('.purs', '.js')); - const js = await readFile(upstream); - hashes.set(upstream, createHash('sha256').update(js).digest('hex')); - const functions = await import(pathToFileURL(upstream)); - const vendor = await readFile(join(values.vendor, file), 'utf8'); - const declaration = vendor.split('\n').find(line => line.startsWith('foreign import "psrs:intrinsic#') && line.includes(`" ${name} ::`)); - if (!declaration) throw Error(`missing explicit target binding: ${file}.${name}`); - declarations.push(declaration); - const types = declaration.split('::')[1].trim().split(' -> '); - if (types.some(type => !['Int', 'Number', 'Boolean', 'Char'].includes(type))) - throw Error(`unsupported scalar signature: ${declaration}`); - const resultType = types.at(-1); - for (const args of cases) { - if (args.length !== types.length - 1) throw Error(`argument arity mismatch: ${file}.${name}`); - let expected = functions[name]; - for (const argument of args) expected = expected(argument); - // Wasm Int is signed i32; record the raw JS observation separately. - const target = resultType === 'Int' ? expected | 0 : expected; - const call = `(Golden.${name} ${args.map((value, i) => literal(value, types[i])).join(' ')})`; - let condition; - if (resultType === 'Number' && Number.isNaN(target)) condition = `(booleanNot (numberEq ${call} ${call}))`; - else if (resultType === 'Number' && Object.is(target, -0)) - condition = `(numberEq (numberDiv 1.0 ${call}) (numberDiv (numberNeg 1.0) 0.0))`; - else condition = `(${resultType === 'Int' ? 'intEq' : resultType === 'Boolean' ? 'booleanEq' : 'numberEq'} ${call} ${literal(target, resultType)})`; - observations.push({ module: file, name, arguments: args.map(marker), official_result: marker(expected), target_result: marker(target), representation_difference: !Object.is(expected, target) }); - checks.push(condition); - } -} -await mkdir(output, { recursive: true }); -await writeFile(join(output, 'Golden.purs'), 'module Golden where\n' + declarations.join('\n') + '\n'); -function conjunction(values) { - if (values.length === 0) throw Error("no scalar observations were generated"); - if (values.length === 1) return values[0]; - const middle = Math.floor(values.length / 2); - return `(booleanAnd ${conjunction(values.slice(0, middle))} ${conjunction(values.slice(middle))})`; -} -await writeFile(join(output, 'Main.purs'), 'module Main where\nimport Golden as Golden\nmain = if ' + conjunction(checks) + ' then 42 else 1\n'); -await writeFile(join(output, 'observations.json'), JSON.stringify({ node: process.version, inputs: [...hashes].map(([path, sha256]) => ({ path, sha256 })), observations }, null, 2) + '\n'); -console.log(`${declarations.length} bindings, ${checks.length} cases`); From 53f133b6f456912e164e033bcee354874c72584a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 18:33:49 +0800 Subject: [PATCH 041/148] Implement stdlib array algorithms over checked storage primitives --- AGENTS.md | 5 + .../psrs-backend/src/bindings/primitives.rs | 29 +- crates/psrs-backend/src/cc/lower/array.rs | 60 --- .../psrs-backend/src/cc/lower/array_apply.rs | 79 ---- .../src/cc/lower/array_storage.rs | 69 +++ crates/psrs-backend/src/cc/lower/intrinsic.rs | 13 +- crates/psrs-backend/src/cc/lower/mod.rs | 2 +- crates/psrs-backend/src/cc/mod.rs | 18 +- .../psrs-backend/src/cc/verify/ops/arrays.rs | 165 +------ crates/psrs-backend/src/cc/verify/ops/mod.rs | 11 +- .../src/mir/instruction/methods.rs | 3 + .../psrs-backend/src/mir/instruction/mod.rs | 8 + .../psrs-backend/src/mir/lower/array_apply.rs | 418 ------------------ .../src/mir/lower/array_assignments.rs | 75 +++- .../psrs-backend/src/mir/lower/assignments.rs | 2 +- crates/psrs-backend/src/mir/lower/mod.rs | 1 - crates/psrs-backend/src/mir/opt/effects.rs | 2 + crates/psrs-backend/src/mir/opt/values.rs | 10 + .../src/mir/reachable/assignments.rs | 19 +- .../psrs-backend/src/mir/verify/capability.rs | 1 + .../src/mir/verify/instruction/arrays.rs | 47 ++ .../src/mir/verify/instruction/mod.rs | 3 + .../src/mir/verify/tests/arrays.rs | 25 ++ .../src/wasm/lower/structure/instructions.rs | 12 + crates/psrs-core/src/lib.rs | 2 + crates/psrs-core/src/locals.rs | 126 ++++++ crates/psrs-core/src/opt/effects.rs | 2 + crates/psrs-core/src/opt/util.rs | 123 +----- crates/psrs-core/src/primitive.rs | 155 +++++++ crates/psrs-core/src/verify/expr/arrays.rs | 43 +- crates/psrs-core/src/verify/expr/intrinsic.rs | 8 +- .../src/tests/primitive_foreign.rs | 130 +++++- .../fixtures/stdlib-array-bind/Golden.purs | 4 + .../fixtures/stdlib-array-bind/Main.purs | 16 + .../stdlib-array-bind/observations.json | 102 +++++ .../tests/fixtures/stdlib-array/Golden.purs | 4 +- crates/psrs-hir/src/intrinsic/mod.rs | 13 +- crates/psrs-hir/src/intrinsic/registry.rs | 18 +- .../DEC-11-primitive-ffi-stdlib-wrappers.md | 17 + .../D-17-stdlib-and-conformance-boundaries.md | 3 + .../backend/wasm/primitive-ffi-and-stdlib.md | 78 ++-- .../source-array-kernels-2026-10-06/report.md | 61 +++ docs/workflow/stdlib-conformance.md | 16 + stdlib.lock.json | 4 +- 44 files changed, 1002 insertions(+), 1000 deletions(-) delete mode 100644 crates/psrs-backend/src/cc/lower/array_apply.rs create mode 100644 crates/psrs-backend/src/cc/lower/array_storage.rs delete mode 100644 crates/psrs-backend/src/mir/lower/array_apply.rs create mode 100644 crates/psrs-core/src/locals.rs create mode 100644 crates/psrs-core/src/primitive.rs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-bind/Golden.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-bind/Main.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-bind/observations.json create mode 100644 docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md diff --git a/AGENTS.md b/AGENTS.md index 129e533d..cbe8b726 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -48,6 +48,11 @@ uncommitted work. APIs execute, that every declaration survives backend lowering, or that FFI behavior agrees with its contract. +- Prefer small checked runtime/storage primitives and ordinary target library + wrappers. Keep stdlib algorithms, traversal order, and callbacks in + `psrs-stdlib`; missing JS FFI alone does not justify a whole-function intrinsic. + Validate primitive values at their checked use types before ABI erasure; + copying a polymorphic array argument cannot preserve an in-place write. - Use the library-owned Node [conformance commands](docs/workflow/stdlib-conformance.md) in `psrs-stdlib/tools/` for source and runtime comparisons. Maintain tool code and case engines in that repository; keep compiler locks and Rust tests here. diff --git a/crates/psrs-backend/src/bindings/primitives.rs b/crates/psrs-backend/src/bindings/primitives.rs index 1c222ca9..3555e7c8 100644 --- a/crates/psrs-backend/src/bindings/primitives.rs +++ b/crates/psrs-backend/src/bindings/primitives.rs @@ -42,6 +42,10 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), let mut probe = module.clone(); probe.declarations.clear(); probe.entry = None; + let operations = bindings + .iter() + .map(|(external, intrinsic)| (external.symbol, *intrinsic)) + .collect(); for (external, intrinsic) in bindings { let span = external .signature @@ -72,7 +76,8 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), | IntrinsicCategory::ArrayIndex | IntrinsicCategory::ArrayUpdate | IntrinsicCategory::ArrayAppend - | IntrinsicCategory::ArrayApply + | IntrinsicCategory::ArrayFill + | IntrinsicCategory::ArrayWrite | IntrinsicCategory::StringToBytes | IntrinsicCategory::BytesToString ) { @@ -168,6 +173,28 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), } probe.declarations.clear(); } + psrs_core::primitive::expand_primitive_globals(&mut candidate, &operations).map_err( + |errors| { + errors + .into_iter() + .map(|error| { + BackendError::invalid_ir("P8 primitive linking", error.span, error.message) + .with_module(error.module) + }) + .collect::>() + }, + )?; + candidate + .verify_with_source(source.unwrap_or(&candidate)) + .map_err(|errors| { + errors + .into_iter() + .map(|error| { + BackendError::invalid_ir("P8 primitive linking", error.span, error.message) + .with_module(error.module) + }) + .collect::>() + })?; *module = candidate; Ok(()) } diff --git a/crates/psrs-backend/src/cc/lower/array.rs b/crates/psrs-backend/src/cc/lower/array.rs index 1431ed8f..d44cafb5 100644 --- a/crates/psrs-backend/src/cc/lower/array.rs +++ b/crates/psrs-backend/src/cc/lower/array.rs @@ -80,66 +80,6 @@ impl FunctionLowerer<'_> { Ok(destination) } - pub(super) fn lower_array_apply( - &mut self, - expression: &Expr, - functions: &Expr, - values: &Expr, - ty: ValueShape, - assignments: &mut Vec, - ) -> Result> { - let representations = - [functions.ty, values.ty, expression.ty].map(|ty| self.array_types.get(&ty).copied()); - let [ - Some(functions_representation), - Some(values_representation), - Some(result_representation), - ] = representations - else { - return Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "arrayApply has no checked array representation", - )]); - }; - let Some(super::super::Representation::Array { - element: - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Closure(signature), - }), - }) = self - .representations - .representation(functions_representation) - else { - return Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "arrayApply has no checked callback signature", - )]); - }; - let signature = *signature; - let invoker = self.array_apply_invoker(functions.ty, values.ty, expression.span)?; - let functions = self.lower_value(functions, assignments)?; - let values = self.lower_value(values, assignments)?; - let destination = self.fresh(ty); - assignments.push(Assignment { - destination, - kind: AssignmentKind::ArrayApply { - destination, - functions, - values, - functions_representation, - values_representation, - result_representation, - signature, - invoker, - }, - span: expression.span, - }); - Ok(destination) - } - pub(super) fn lower_array_append( &mut self, expression: &Expr, diff --git a/crates/psrs-backend/src/cc/lower/array_apply.rs b/crates/psrs-backend/src/cc/lower/array_apply.rs deleted file mode 100644 index 1c6ba7b5..00000000 --- a/crates/psrs-backend/src/cc/lower/array_apply.rs +++ /dev/null @@ -1,79 +0,0 @@ -//! A checked unary invocation through the common application/partial-call path. -use super::FunctionLowerer; -use super::lambda::LambdaLowering; -use crate::BackendError; -use crate::cc::Function; -use psrs_core::{Expr, ExprKind, TypeId, arrow_parts}; -use psrs_hir::{LocalId, SymbolId}; -use psrs_span::TextRange; - -impl FunctionLowerer<'_> { - pub(super) fn array_apply_invoker( - &mut self, - functions: TypeId, - values: TypeId, - span: TextRange, - ) -> Result> { - let error = || { - vec![BackendError::invalid_ir( - "P8 closure conversion", - span, - "arrayApply has an invalid checked source function type", - )] - }; - let function_type = - super::super::layout::array_element_type(self.module, functions).ok_or_else(error)?; - let argument_type = - super::super::layout::array_element_type(self.module, values).ok_or_else(error)?; - let (_, result_type) = arrow_parts(&self.module.types, function_type).ok_or_else(error)?; - let mut nested = self.child_lowerer(); - let callback_shape = nested.value_shape(function_type, span)?; - let argument_shape = nested.value_shape(argument_type, span)?; - let result_shape = nested.value_shape(result_type, span)?; - let callback = nested.fresh(callback_shape); - let argument = nested.fresh(argument_shape); - nested.locals.insert(LocalId(0), callback); - nested.locals.insert(LocalId(1), argument); - nested.local_types.insert(LocalId(0), function_type); - nested.local_types.insert(LocalId(1), argument_type); - let call = Expr { - kind: ExprKind::Application( - Box::new(Expr { - kind: ExprKind::Local(LocalId(0)), - ty: function_type, - span, - }), - Box::new(Expr { - kind: ExprKind::Local(LocalId(1)), - ty: argument_type, - span, - }), - ), - ty: result_type, - span, - }; - let mut assignments = Vec::new(); - let result = nested.lower_value(&call, &mut assignments)?; - let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); - let function = Function { - symbol, - name: "array_apply_invoke".into(), - parameters: vec![callback, argument], - values: nested.values, - assignments, - result, - result_type: result_shape, - span, - }; - super::super::verify::verify_function(&function, self.signatures, self.representations)?; - let FunctionLowerer { - warnings, - generated, - .. - } = nested; - self.warnings.extend(warnings); - self.generated.extend(generated); - self.generated.push(function); - Ok(symbol) - } -} diff --git a/crates/psrs-backend/src/cc/lower/array_storage.rs b/crates/psrs-backend/src/cc/lower/array_storage.rs new file mode 100644 index 00000000..b37e0017 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/array_storage.rs @@ -0,0 +1,69 @@ +//! Low-level initialized allocation and unsafe writes; library code owns loops. +use super::FunctionLowerer; +use crate::BackendError; +use crate::cc::{Assignment, AssignmentKind, ValueId, ValueShape}; +use psrs_core::Expr; + +impl FunctionLowerer<'_> { + pub(super) fn lower_array_fill( + &mut self, + expression: &Expr, + length: &Expr, + value: &Expr, + ty: ValueShape, + assignments: &mut Vec, + ) -> Result> { + let representation = *self.array_types.get(&expression.ty).ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "arrayFill has no checked array representation", + )] + })?; + let length = self.lower_value(length, assignments)?; + let value = self.lower_value(value, assignments)?; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + span: expression.span, + kind: AssignmentKind::ArrayFill { + destination, + representation, + length, + value, + }, + }); + Ok(destination) + } + pub(super) fn lower_array_write( + &mut self, + expression: &Expr, + array: &Expr, + index: &Expr, + new_value: &Expr, + assignments: &mut Vec, + ) -> Result> { + let representation = *self.array_types.get(&array.ty).ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "arrayWrite has no checked array representation", + )] + })?; + let value = self.lower_value(array, assignments)?; + let index = self.lower_value(index, assignments)?; + let new_value = self.lower_value(new_value, assignments)?; + assignments.push(Assignment { + destination: value, + span: expression.span, + kind: AssignmentKind::ArraySet { + destination: value, + representation, + value, + index, + new_value, + }, + }); + Ok(value) + } +} diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 9fdd71f8..04264c30 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -62,12 +62,19 @@ impl FunctionLowerer<'_> { }); Ok(destination) } + Intrinsic::ArrayFill => { + self.lower_array_fill(expression, &arguments[0], &arguments[1], ty, assignments) + } + Intrinsic::ArrayWrite => self.lower_array_write( + expression, + &arguments[0], + &arguments[1], + &arguments[2], + assignments, + ), Intrinsic::ArrayAppend => { self.lower_array_append(expression, &arguments[0], &arguments[1], ty, assignments) } - Intrinsic::ArrayApply => { - self.lower_array_apply(expression, &arguments[0], &arguments[1], ty, assignments) - } Intrinsic::StringToBytes => { self.lower_string_to_bytes(expression, &arguments[0], ty, assignments) } diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 75b1d683..9fb6d1c8 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -12,7 +12,7 @@ use std::collections::{HashMap, HashSet}; use std::rc::Rc; mod array; -mod array_apply; +mod array_storage; mod call; mod constructor; mod conversion; diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 15da19ba..803594ea 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -159,6 +159,12 @@ pub enum AssignmentKind { representation: ReprId, elements: Vec, }, + ArrayFill { + destination: ValueId, + representation: ReprId, + length: ValueId, + value: ValueId, + }, ArrayLen { destination: ValueId, value: ValueId, @@ -172,18 +178,6 @@ pub enum AssignmentKind { left: ValueId, right: ValueId, }, - /// Apply every callback to every argument in function-major order. - /// The representations and callback signature describe the checked ABI. - ArrayApply { - destination: ValueId, - functions: ValueId, - values: ValueId, - invoker: SymbolId, - functions_representation: ReprId, - values_representation: ReprId, - result_representation: ReprId, - signature: SignatureId, - }, /// A source `String`'s canonical UTF-8 bytes as an `Array Int`. A source /// string is a sequence of Unicode scalar values, so this is lossless. StringToBytes { diff --git a/crates/psrs-backend/src/cc/verify/ops/arrays.rs b/crates/psrs-backend/src/cc/verify/ops/arrays.rs index a64745eb..000a47f7 100644 --- a/crates/psrs-backend/src/cc/verify/ops/arrays.rs +++ b/crates/psrs-backend/src/cc/verify/ops/arrays.rs @@ -16,8 +16,6 @@ pub(super) fn verify_array_assignment( declared: &HashMap, table: &RepresentationTable, uses: &mut Vec, - signatures: &HashMap, - complete: bool, ) -> Result<(), Vec> { match &assignment.kind { AssignmentKind::ArrayNew { @@ -50,6 +48,24 @@ pub(super) fn verify_array_assignment( )?; uses.extend(elements.iter().copied()); } + AssignmentKind::ArrayFill { + destination, + representation, + length, + value, + } => { + verify_embedded_destination(assignment, *destination)?; + let element = verify_array_representation(table, *representation, assignment)?; + require_value_shape(declared, *length, ValueShape::Integer, assignment)?; + require_value_shape(declared, *value, element, assignment)?; + require_destination( + declared, + assignment, + repr_shape(*representation), + "arrayFill has an incompatible result shape", + )?; + uses.extend([*length, *value]); + } AssignmentKind::ArrayLen { destination, value } => { verify_embedded_destination(assignment, *destination)?; verify_array_value(declared, *value, table, None, assignment)?; @@ -132,152 +148,7 @@ pub(super) fn verify_array_assignment( )?; uses.extend([*left, *right]); } - AssignmentKind::ArrayApply { - destination, - functions, - values, - functions_representation, - values_representation, - result_representation, - signature, - invoker, - } => { - verify_embedded_destination(assignment, *destination)?; - let callback = - verify_array_representation(table, *functions_representation, assignment)?; - let argument = verify_array_representation(table, *values_representation, assignment)?; - let result = verify_array_representation(table, *result_representation, assignment)?; - let contract = table_signature(table, *signature, assignment)?; - if callback != closure_shape(*signature) - || contract.parameters.first() != Some(&argument) - { - return Err(assignment_error( - assignment, - "arrayApply callback ABI does not match its array elements", - )); - } - if complete { - let expected = crate::cc::Signature { - parameters: vec![callback, argument], - result, - }; - if signatures.get(invoker) != Some(&expected) { - return Err(assignment_error( - assignment, - "arrayApply invoker is missing or has an incompatible ABI", - )); - } - } - verify_array_value( - declared, - *functions, - table, - Some(*functions_representation), - assignment, - )?; - verify_array_value( - declared, - *values, - table, - Some(*values_representation), - assignment, - )?; - require_destination( - declared, - assignment, - repr_shape(*result_representation), - "arrayApply has an incompatible result shape", - )?; - uses.extend([*functions, *values]); - } _ => unreachable!("array verifier received another assignment"), } Ok(()) } - -#[cfg(test)] -mod tests { - use super::*; - use crate::cc::{ReprId, Signature, SignatureId}; - use psrs_hir::{ModuleId, SymbolId}; - use psrs_span::TextRange; - - #[test] - fn array_apply_requires_a_real_invoker_with_the_checked_abi() { - let callback = closure_shape(SignatureId(0)); - let table = RepresentationTable { - signatures: vec![Signature { - parameters: vec![ValueShape::Integer], - result: ValueShape::Number, - }], - representations: vec![ - Representation::Array { element: callback }, - Representation::Array { - element: ValueShape::Integer, - }, - Representation::Array { - element: ValueShape::Number, - }, - ], - ..Default::default() - }; - let invoker = SymbolId::new(ModuleId(9), 1); - let assignment = Assignment { - destination: ValueId(2), - span: TextRange::new(0, 1), - kind: AssignmentKind::ArrayApply { - destination: ValueId(2), - functions: ValueId(0), - values: ValueId(1), - functions_representation: ReprId(0), - values_representation: ReprId(1), - result_representation: ReprId(2), - signature: SignatureId(0), - invoker, - }, - }; - let declared = (0..3) - .map(|id| (ValueId(id), repr_shape(ReprId(id)))) - .collect(); - let mut signatures = HashMap::new(); - assert!( - verify_array_assignment( - &assignment, - &declared, - &table, - &mut Vec::new(), - &signatures, - true - ) - .is_err() - ); - signatures.insert( - invoker, - Signature { - parameters: vec![callback, ValueShape::Integer], - result: ValueShape::Integer, - }, - ); - assert!( - verify_array_assignment( - &assignment, - &declared, - &table, - &mut Vec::new(), - &signatures, - true - ) - .is_err() - ); - signatures.get_mut(&invoker).unwrap().result = ValueShape::Number; - verify_array_assignment( - &assignment, - &declared, - &table, - &mut Vec::new(), - &signatures, - true, - ) - .unwrap(); - } -} diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index 5397d324..9a327187 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -335,15 +335,8 @@ pub(super) fn verify_assignments( | AssignmentKind::ArrayClone { .. } | AssignmentKind::ArraySet { .. } | AssignmentKind::ArrayAppend { .. } - | AssignmentKind::ArrayApply { .. } => { - arrays::verify_array_assignment( - assignment, - declared, - table, - &mut uses, - signatures, - functions.is_some(), - )?; + | AssignmentKind::ArrayFill { .. } => { + arrays::verify_array_assignment(assignment, declared, table, &mut uses)?; } AssignmentKind::StringToBytes { representation, diff --git a/crates/psrs-backend/src/mir/instruction/methods.rs b/crates/psrs-backend/src/mir/instruction/methods.rs index c96d5aab..11c37761 100644 --- a/crates/psrs-backend/src/mir/instruction/methods.rs +++ b/crates/psrs-backend/src/mir/instruction/methods.rs @@ -29,6 +29,7 @@ impl Instruction { | Self::ArrayNew { destination, .. } | Self::ArrayNewDefault { destination, .. } | Self::ArrayNewSized { destination, .. } + | Self::ArrayNewFilled { destination, .. } | Self::ArrayGet { destination, .. } | Self::ArrayGetU { destination, .. } | Self::ArrayClone { destination, .. } @@ -109,6 +110,7 @@ impl Instruction { } => arguments.clone(), Self::ArrayNewDefault { length, source, .. } => vec![*length, *source], Self::ArrayNewSized { length, .. } => vec![*length], + Self::ArrayNewFilled { length, value, .. } => vec![*length, *value], Self::StructSet { value, new_value, .. } => vec![*value, *new_value], @@ -183,6 +185,7 @@ impl Instruction { | Self::ArrayNew { span, .. } | Self::ArrayNewDefault { span, .. } | Self::ArrayNewSized { span, .. } + | Self::ArrayNewFilled { span, .. } | Self::ArrayGet { span, .. } | Self::ArrayGetU { span, .. } | Self::ArrayClone { span, .. } diff --git a/crates/psrs-backend/src/mir/instruction/mod.rs b/crates/psrs-backend/src/mir/instruction/mod.rs index 54430977..a7b6a3d1 100644 --- a/crates/psrs-backend/src/mir/instruction/mod.rs +++ b/crates/psrs-backend/src/mir/instruction/mod.rs @@ -190,6 +190,14 @@ pub enum Instruction { length: ValueId, span: TextRange, }, + /// Fresh fully initialized allocation; the element must fit the storage type. + ArrayNewFilled { + destination: ValueId, + type_index: DefinedTypeId, + length: ValueId, + value: ValueId, + span: TextRange, + }, ArrayGet { destination: ValueId, type_index: DefinedTypeId, diff --git a/crates/psrs-backend/src/mir/lower/array_apply.rs b/crates/psrs-backend/src/mir/lower/array_apply.rs deleted file mode 100644 index 27567692..00000000 --- a/crates/psrs-backend/src/mir/lower/array_apply.rs +++ /dev/null @@ -1,418 +0,0 @@ -//! Linear array application with the callback ABI supplied by checked CC. -use super::aggregate::{nullable_reference_shape, reference_type, representation_shape}; -use super::{BlockId, FunctionLowerer, layout_error}; -use crate::BackendError; -use crate::cc::ReprId; -use crate::mir::instruction::Instruction; -use crate::mir::{NumericOp, Terminator}; -use crate::types::{ValueId, ValueType}; -use psrs_hir::SymbolId; -use psrs_span::TextRange; - -struct ArrayLoop { - index: ValueId, - header: BlockId, - body: BlockId, - exit: BlockId, -} - -impl FunctionLowerer<'_> { - #[allow(clippy::too_many_arguments)] - pub(super) fn lower_array_apply( - &mut self, - current: BlockId, - destination: ValueId, - functions: ValueId, - values: ValueId, - functions_repr: ReprId, - values_repr: ReprId, - result_repr: ReprId, - invoker: SymbolId, - span: TextRange, - ) -> Result> { - // Non-null references crossing structured control labels require - // defaultable storage locals. Logical views are restored at use sites. - let functions = self.array_apply_storage(current, functions, functions_repr, span)?; - let values = self.array_apply_storage(current, values, values_repr, span)?; - let functions_length = self.fresh(ValueType::I32); - let values_length = self.fresh(ValueType::I32); - for (destination, value) in [(functions_length, functions), (values_length, values)] { - self.append_instruction( - current, - Instruction::ArrayLen { - destination, - value, - span, - }, - span, - )?; - } - let zero = self.array_apply_constant(current, 0, span)?; - // Source array lengths are signed Int. Reject unrepresentable lengths - // and products, rather than wrapping and silently dropping callbacks. - for length in [functions_length, values_length] { - let negative = self.array_apply_numeric( - current, - NumericOp::I32LtS, - length, - zero, - ValueType::Boolean, - span, - )?; - self.append_instruction( - current, - Instruction::TrapIf { - condition: negative, - span, - }, - span, - )?; - } - let total = self.array_apply_numeric( - current, - NumericOp::I32Mul, - functions_length, - values_length, - ValueType::I32, - span, - )?; - let empty = self.array_apply_numeric( - current, - NumericOp::I32Eq, - values_length, - zero, - ValueType::Boolean, - span, - )?; - let guard = self.new_block(Vec::new()); - let allocate = self.new_block(Vec::new()); - self.set_terminator( - current, - Terminator::Branch { - condition: empty, - then_block: allocate, - else_block: guard, - span, - }, - span, - )?; - let quotient = self.array_apply_numeric( - guard, - NumericOp::I32DivS, - total, - values_length, - ValueType::I32, - span, - )?; - let overflow = self.array_apply_numeric( - guard, - NumericOp::I32Ne, - quotient, - functions_length, - ValueType::Boolean, - span, - )?; - self.append_instruction( - guard, - Instruction::TrapIf { - condition: overflow, - span, - }, - span, - )?; - self.set_terminator( - guard, - Terminator::Jump { - target: allocate, - arguments: Vec::new(), - span, - }, - span, - )?; - - let destination_shape = representation_shape(result_repr); - let array = self.fresh( - self.layout - .value_type(&nullable_reference_shape(destination_shape)) - .map_err(|error| layout_error(span, error))?, - ); - let type_index = self - .layout - .repr_index(result_repr) - .map_err(|error| layout_error(span, error))?; - self.append_instruction( - allocate, - Instruction::ArrayNewSized { - destination: array, - type_index, - length: total, - span, - }, - span, - )?; - let outer = self.array_apply_loop(allocate, functions_length, span)?; - let callback_shape = self - .layout - .array_element(functions_repr) - .map_err(|error| layout_error(span, error))?; - let argument_shape = self - .layout - .array_element(values_repr) - .map_err(|error| layout_error(span, error))?; - let result_shape = self - .layout - .array_element(result_repr) - .map_err(|error| layout_error(span, error))?; - let callback = self.fresh( - self.layout - .value_type(&callback_shape) - .map_err(|error| layout_error(span, error))?, - ); - self.lower_array_get( - outer.body, - callback, - functions_repr, - functions, - outer.index, - span, - )?; - // Match the official loop: cache the function once for this complete - // value traversal, including when the values array is empty. - let cached_shape = nullable_reference_shape(callback_shape); - let cached = self.fresh( - self.layout - .value_type(&cached_shape) - .map_err(|error| layout_error(span, error))?, - ); - self.append_instruction( - outer.body, - Instruction::RefCast { - destination: cached, - value: callback, - reference: reference_type(&cached_shape, self.layout, span)?, - span, - }, - span, - )?; - let base = self.array_apply_numeric( - outer.body, - NumericOp::I32Mul, - outer.index, - values_length, - ValueType::I32, - span, - )?; - let inner = self.array_apply_loop(outer.body, values_length, span)?; - let callback = self.fresh( - self.layout - .value_type(&callback_shape) - .map_err(|error| layout_error(span, error))?, - ); - self.append_instruction( - inner.body, - Instruction::RefCast { - destination: callback, - value: cached, - reference: reference_type(&callback_shape, self.layout, span)?, - span, - }, - span, - )?; - let argument = self.fresh( - self.layout - .value_type(&argument_shape) - .map_err(|error| layout_error(span, error))?, - ); - let result = self.fresh( - self.layout - .value_type(&result_shape) - .map_err(|error| layout_error(span, error))?, - ); - self.lower_array_get(inner.body, argument, values_repr, values, inner.index, span)?; - self.append_instruction( - inner.body, - Instruction::Call { - destination: result, - function: invoker, - arguments: vec![callback, argument], - span, - }, - span, - )?; - let index = self.array_apply_numeric( - inner.body, - NumericOp::I32Add, - base, - inner.index, - ValueType::I32, - span, - )?; - self.append_instruction( - inner.body, - Instruction::ArraySet { - type_index, - value: array, - index, - new_value: result, - span, - }, - span, - )?; - self.array_apply_advance(inner.body, &inner, span)?; - self.array_apply_advance(inner.exit, &outer, span)?; - let exit = outer.exit; - self.append_instruction( - exit, - Instruction::RefCast { - destination, - value: array, - reference: reference_type(&destination_shape, self.layout, span)?, - span, - }, - span, - )?; - Ok(exit) - } - - fn array_apply_loop( - &mut self, - start: BlockId, - length: ValueId, - span: TextRange, - ) -> Result> { - let index = self.fresh(ValueType::I32); - let header = self.new_block(vec![index]); - let body = self.new_block(Vec::new()); - let exit = self.new_block(Vec::new()); - let zero = self.array_apply_constant(start, 0, span)?; - self.set_terminator( - start, - Terminator::Jump { - target: header, - arguments: vec![zero], - span, - }, - span, - )?; - let condition = self.array_apply_numeric( - header, - NumericOp::I32LtS, - index, - length, - ValueType::Boolean, - span, - )?; - self.set_terminator( - header, - Terminator::Branch { - condition, - then_block: body, - else_block: exit, - span, - }, - span, - )?; - Ok(ArrayLoop { - index, - header, - body, - exit, - }) - } - - fn array_apply_advance( - &mut self, - block: BlockId, - loop_: &ArrayLoop, - span: TextRange, - ) -> Result<(), Vec> { - let one = self.array_apply_constant(block, 1, span)?; - let next = self.array_apply_numeric( - block, - NumericOp::I32Add, - loop_.index, - one, - ValueType::I32, - span, - )?; - self.set_terminator( - block, - Terminator::Jump { - target: loop_.header, - arguments: vec![next], - span, - }, - span, - ) - } - - fn array_apply_storage( - &mut self, - block: BlockId, - value: ValueId, - representation: ReprId, - span: TextRange, - ) -> Result> { - let shape = nullable_reference_shape(representation_shape(representation)); - let destination = self.fresh( - self.layout - .value_type(&shape) - .map_err(|error| layout_error(span, error))?, - ); - self.append_instruction( - block, - Instruction::RefCast { - destination, - value, - reference: reference_type(&shape, self.layout, span)?, - span, - }, - span, - )?; - Ok(destination) - } - - fn array_apply_constant( - &mut self, - block: BlockId, - value: i32, - span: TextRange, - ) -> Result> { - let destination = self.fresh(ValueType::I32); - self.append_instruction( - block, - Instruction::Constant { - destination, - value, - span, - }, - span, - )?; - Ok(destination) - } - - #[allow(clippy::too_many_arguments)] - fn array_apply_numeric( - &mut self, - block: BlockId, - op: NumericOp, - left: ValueId, - right: ValueId, - ty: ValueType, - span: TextRange, - ) -> Result> { - let destination = self.fresh(ty); - self.append_instruction( - block, - Instruction::Primitive { - destination, - op, - left, - right, - span, - }, - span, - )?; - Ok(destination) - } -} diff --git a/crates/psrs-backend/src/mir/lower/array_assignments.rs b/crates/psrs-backend/src/mir/lower/array_assignments.rs index 7f02475c..169d4ff8 100644 --- a/crates/psrs-backend/src/mir/lower/array_assignments.rs +++ b/crates/psrs-backend/src/mir/lower/array_assignments.rs @@ -33,6 +33,59 @@ impl FunctionLowerer<'_> { }, assignment.span, )?, + AssignmentKind::ArrayFill { + destination, + representation, + length, + value, + } => { + // A negative source Int is an error, not an unsigned huge allocation. + let zero = self.fresh(crate::types::ValueType::I32); + self.append_instruction( + current, + Instruction::Constant { + destination: zero, + value: 0, + span: assignment.span, + }, + assignment.span, + )?; + let negative = self.fresh(crate::types::ValueType::Boolean); + self.append_instruction( + current, + Instruction::Primitive { + destination: negative, + op: crate::mir::NumericOp::I32LtS, + left: *length, + right: zero, + span: assignment.span, + }, + assignment.span, + )?; + self.append_instruction( + current, + Instruction::TrapIf { + condition: negative, + span: assignment.span, + }, + assignment.span, + )?; + let type_index = self + .layout + .repr_index(*representation) + .map_err(|error| layout_error(assignment.span, error))?; + self.append_instruction( + current, + Instruction::ArrayNewFilled { + destination: *destination, + type_index, + length: *length, + value: *value, + span: assignment.span, + }, + assignment.span, + )?; + } AssignmentKind::ArrayLen { destination, value } => self.append_instruction( current, Instruction::ArrayLen { @@ -57,28 +110,6 @@ impl FunctionLowerer<'_> { assignment.span, )?; } - AssignmentKind::ArrayApply { - destination, - functions, - values, - functions_representation, - values_representation, - result_representation, - invoker, - .. - } => { - current = self.lower_array_apply( - current, - *destination, - *functions, - *values, - *functions_representation, - *values_representation, - *result_representation, - *invoker, - assignment.span, - )?; - } AssignmentKind::StringToBytes { destination, representation, diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 6c082198..7ab7c0fc 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -188,7 +188,7 @@ impl FunctionLowerer<'_> { AssignmentKind::ArrayNew { .. } | AssignmentKind::ArrayLen { .. } | AssignmentKind::ArrayAppend { .. } - | AssignmentKind::ArrayApply { .. } + | AssignmentKind::ArrayFill { .. } | AssignmentKind::StringToBytes { .. } | AssignmentKind::BytesToString { .. } | AssignmentKind::ArrayGet { .. } diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index fa48437b..3d6dcf85 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -13,7 +13,6 @@ use psrs_span::TextRange; use std::collections::HashMap; mod aggregate; -mod array_apply; mod array_assignments; mod assignment_array; mod assignment_string; diff --git a/crates/psrs-backend/src/mir/opt/effects.rs b/crates/psrs-backend/src/mir/opt/effects.rs index bb1065c3..8bfe3d45 100644 --- a/crates/psrs-backend/src/mir/opt/effects.rs +++ b/crates/psrs-backend/src/mir/opt/effects.rs @@ -44,6 +44,7 @@ pub(super) fn classify(instruction: &Instruction) -> InstructionEffects { | I::ArrayNewData { .. } | I::ArrayNewDefault { .. } | I::ArrayNewSized { .. } + | I::ArrayNewFilled { .. } | I::ArrayGet { .. } | I::ArrayGetU { .. } | I::ArrayClone { .. } @@ -66,6 +67,7 @@ pub(super) fn classify(instruction: &Instruction) -> InstructionEffects { | I::ArrayNewData { .. } | I::ArrayNewDefault { .. } | I::ArrayNewSized { .. } + | I::ArrayNewFilled { .. } | I::ArrayClone { .. } ), ..InstructionEffects::default() diff --git a/crates/psrs-backend/src/mir/opt/values.rs b/crates/psrs-backend/src/mir/opt/values.rs index 5154bc90..31a1eb18 100644 --- a/crates/psrs-backend/src/mir/opt/values.rs +++ b/crates/psrs-backend/src/mir/opt/values.rs @@ -224,6 +224,16 @@ pub(crate) fn remap_instruction( replace(destination); replace(length); } + I::ArrayNewFilled { + destination, + length, + value, + .. + } => { + replace(destination); + replace(length); + replace(value); + } I::CallRef { destination, function, diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index a4fa18c4..2f79a133 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -42,24 +42,6 @@ pub(super) fn add_assignments( AssignmentKind::IndirectCall { signature, .. } => { add_signature(*signature, signatures, signature_work); } - AssignmentKind::ArrayApply { - signature, - functions_representation, - values_representation, - result_representation, - invoker, - .. - } => { - direct_calls.insert(*invoker); - add_signature(*signature, signatures, signature_work); - for representation in [ - functions_representation, - values_representation, - result_representation, - ] { - add_representation(*representation, representations, representation_work); - } - } AssignmentKind::RepresentationTest { reference, .. } | AssignmentKind::RepresentationCast { reference, .. } => add_reference( reference, @@ -80,6 +62,7 @@ pub(super) fn add_assignments( | AssignmentKind::VariantTag { representation, .. } | AssignmentKind::VariantGet { representation, .. } | AssignmentKind::ArrayNew { representation, .. } + | AssignmentKind::ArrayFill { representation, .. } | AssignmentKind::ArrayGet { representation, .. } | AssignmentKind::ArrayClone { representation, .. } | AssignmentKind::ArraySet { representation, .. } diff --git a/crates/psrs-backend/src/mir/verify/capability.rs b/crates/psrs-backend/src/mir/verify/capability.rs index 7076b245..176a8a44 100644 --- a/crates/psrs-backend/src/mir/verify/capability.rs +++ b/crates/psrs-backend/src/mir/verify/capability.rs @@ -163,6 +163,7 @@ fn mark_instruction(instruction: &mir::Instruction, required: &mut RequiredCapab | Instruction::ArrayNew { .. } | Instruction::ArrayNewDefault { .. } | Instruction::ArrayNewSized { .. } + | Instruction::ArrayNewFilled { .. } | Instruction::ArrayGet { .. } | Instruction::ArrayGetU { .. } | Instruction::ArrayClone { .. } diff --git a/crates/psrs-backend/src/mir/verify/instruction/arrays.rs b/crates/psrs-backend/src/mir/verify/instruction/arrays.rs index a1ef2337..7b954451 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/arrays.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/arrays.rs @@ -380,3 +380,50 @@ pub(super) fn verify_len( } Ok(()) } + +/// Initialized allocation never creates a default/null logical source element. +pub(super) fn verify_array_new_filled( + function: &Function, + instruction: &Instruction, + definitions: &HashMap, + defined: &[&DefinedType], +) -> Result<(), Vec> { + let Instruction::ArrayNewFilled { + destination, + type_index, + length, + value, + span, + } = instruction + else { + unreachable!("filled array verifier received another instruction") + }; + let Some(CompositeType::Array(element)) = composite_at(defined, *type_index) else { + return Err(mir_error(*span, "MIR array.new type is not an array")); + }; + if require_value(definitions, *length, *span)? != ValueType::I32 { + return Err(mir_error(*span, "MIR array.new length must be i32")); + } + if !value_type_assignable( + require_value(definitions, *value, *span)?, + storage_value_type(&element.storage) + .ok_or_else(|| mir_error(*span, "MIR array element storage is not representable"))?, + ) { + return Err(mir_error( + *span, + "MIR array.new initializer does not match element storage", + )); + } + if !is_array_reference( + value_type(function, *destination) + .ok_or_else(|| mir_error(*span, "MIR array.new result has no value type"))?, + *type_index, + defined, + ) { + return Err(mir_error( + *span, + "MIR array.new result must match its array type", + )); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/verify/instruction/mod.rs b/crates/psrs-backend/src/mir/verify/instruction/mod.rs index 30b59bbc..beddd227 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/mod.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/mod.rs @@ -378,6 +378,9 @@ pub(super) fn verify_instruction( Instruction::ArrayGet { .. } => { arrays::verify_array_get(function, instruction, false, definitions, defined)? } + Instruction::ArrayNewFilled { .. } => { + arrays::verify_array_new_filled(function, instruction, definitions, defined)?; + } Instruction::ArrayGetU { .. } => { arrays::verify_array_get(function, instruction, true, definitions, defined)? } diff --git a/crates/psrs-backend/src/mir/verify/tests/arrays.rs b/crates/psrs-backend/src/mir/verify/tests/arrays.rs index 90090bf8..306ce3ff 100644 --- a/crates/psrs-backend/src/mir/verify/tests/arrays.rs +++ b/crates/psrs-backend/src/mir/verify/tests/arrays.rs @@ -300,3 +300,28 @@ fn rejects_array_clone_of_an_immutable_array() { "{errors:?}" ); } + +#[test] +fn filled_arrays_require_a_checked_initializer_and_integer_length() { + use crate::types::{DefinedTypeId, StorageType}; + for (storage, length, accepted) in [ + (StorageType::I32, ValueType::I32, true), + (StorageType::F64, ValueType::I32, false), + (StorageType::I32, ValueType::F64, false), + ] { + let (mut function, types) = array_conversion_function(storage, length, ValueType::I32); + function.blocks[0].instructions[2] = Instruction::ArrayNewFilled { + destination: ValueId(3), + type_index: DefinedTypeId(0), + length: ValueId(1), + value: ValueId(0), + span: span(), + }; + let result = verify_module(&module_with_function(function, types)); + assert_eq!( + result.is_ok(), + accepted, + "{storage:?}/{length:?}: {result:?}" + ); + } +} diff --git a/crates/psrs-backend/src/wasm/lower/structure/instructions.rs b/crates/psrs-backend/src/wasm/lower/structure/instructions.rs index fd7ea514..222269ca 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/instructions.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/instructions.rs @@ -297,6 +297,18 @@ impl Structurer<'_> { } => { self.emit_array_new_default(body, *destination, *type_index, *length, *span)? } + MirInstruction::ArrayNewFilled { + destination, + type_index, + length, + value, + span, + } => { + self.load(body, *value, *span)?; + self.load(body, *length, *span)?; + body.push(Op::Leaf(Instruction::ArrayNew(type_index.0))); + self.store(body, *destination, *span)?; + } MirInstruction::ArrayGet { destination, type_index, diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 02593c36..471f62f9 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -2,9 +2,11 @@ pub mod dictionary; pub mod effect; mod instantiation; mod link; +mod locals; mod lower; pub mod opt; mod pattern; +pub mod primitive; mod records; pub use instantiation::Instantiation; mod types; diff --git a/crates/psrs-core/src/locals.rs b/crates/psrs-core/src/locals.rs new file mode 100644 index 00000000..699d7029 --- /dev/null +++ b/crates/psrs-core/src/locals.rs @@ -0,0 +1,126 @@ +//! Shared collision-free local allocation for Core rewrites. +use crate::{Expr, ExprKind, LocalId, Pattern, PatternKind}; +use std::collections::HashSet; + +pub(crate) struct FreshLocals { + next: Option, +} + +impl FreshLocals { + pub fn for_declaration(expression: &Expr) -> Self { + let mut ids = HashSet::new(); + collect_ids(expression, &mut ids); + Self { + next: ids + .iter() + .map(|id| id.0) + .max() + .map_or(Some(0), |value| value.checked_add(1)), + } + } + + pub fn fresh(&mut self) -> Option { + let id = LocalId(self.next?); + self.next = id.0.checked_add(1); + Some(id) + } +} + +fn collect_ids(expression: &Expr, ids: &mut HashSet) { + match &expression.kind { + ExprKind::Local(id) => { + ids.insert(*id); + } + ExprKind::Lambda { binder, body } => { + ids.insert(binder.id); + collect_ids(body, ids); + } + ExprKind::Let { bindings, body } => { + for binding in bindings { + ids.insert(binding.binder.id); + collect_ids(&binding.value, ids); + } + collect_ids(body, ids); + } + ExprKind::Case { + scrutinee, + branches, + } => { + collect_ids(scrutinee, ids); + for branch in branches { + collect_pattern_ids(&branch.pattern, ids); + collect_ids(&branch.value, ids); + } + } + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => { + for argument in arguments { + collect_ids(argument, ids); + } + } + ExprKind::Record { fields } => { + for (_, value) in fields { + collect_ids(value, ids); + } + } + ExprKind::RecordUpdate { record, fields } => { + collect_ids(record, ids); + for (_, value) in fields { + collect_ids(value, ids); + } + } + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } => collect_ids(record, ids), + ExprKind::Application(left, right) => { + collect_ids(left, ids); + collect_ids(right, ids); + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + collect_ids(condition, ids); + collect_ids(then_branch, ids); + collect_ids(else_branch, ids); + } + ExprKind::Global(_) + | ExprKind::Integer(_) + | ExprKind::Number(_) + | ExprKind::Boolean(_) + | ExprKind::String(_) + | ExprKind::Char(_) => {} + ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + } +} + +fn collect_pattern_ids(pattern: &Pattern, ids: &mut HashSet) { + match &pattern.kind { + PatternKind::Var { id, .. } => { + ids.insert(*id); + } + PatternKind::Named { id, pattern } => { + ids.insert(*id); + collect_pattern_ids(pattern, ids); + } + PatternKind::Array { elements } => { + for element in elements { + collect_pattern_ids(element, ids); + } + } + PatternKind::Constructor { arguments, .. } => { + for argument in arguments { + collect_pattern_ids(argument, ids); + } + } + PatternKind::Record { fields } => { + for (_, field) in fields { + collect_pattern_ids(field, ids); + } + } + PatternKind::Wildcard | PatternKind::Literal { .. } => {} + } +} diff --git a/crates/psrs-core/src/opt/effects.rs b/crates/psrs-core/src/opt/effects.rs index 39ca6c23..5b7fe219 100644 --- a/crates/psrs-core/src/opt/effects.rs +++ b/crates/psrs-core/src/opt/effects.rs @@ -119,6 +119,8 @@ fn intrinsic_may_trap(intrinsic: Intrinsic) -> bool { intrinsic, Intrinsic::ArrayIndex | Intrinsic::ArrayUpdate + | Intrinsic::ArrayFill + | Intrinsic::ArrayWrite | Intrinsic::StringToBytes | Intrinsic::BytesToString | Intrinsic::I32DivS diff --git a/crates/psrs-core/src/opt/util.rs b/crates/psrs-core/src/opt/util.rs index de8770bf..2f752974 100644 --- a/crates/psrs-core/src/opt/util.rs +++ b/crates/psrs-core/src/opt/util.rs @@ -1,29 +1,7 @@ use crate::{Binding, Expr, ExprKind, LocalId, Module, Pattern, PatternKind}; use std::collections::{HashMap, HashSet}; -pub(super) struct FreshLocals { - next: Option, -} - -impl FreshLocals { - pub fn for_declaration(expression: &Expr) -> Self { - let mut ids = HashSet::new(); - collect_ids(expression, &mut ids); - Self { - next: ids - .iter() - .map(|id| id.0) - .max() - .map_or(Some(0), |value| value.checked_add(1)), - } - } - - pub fn fresh(&mut self) -> Option { - let id = LocalId(self.next?); - self.next = id.0.checked_add(1); - Some(id) - } -} +pub(super) use crate::locals::FreshLocals; pub(super) fn count_nodes(expression: &Expr) -> usize { 1 + match &expression.kind { @@ -290,102 +268,3 @@ fn pattern_ids(pattern: &Pattern) -> Vec { collect(pattern, &mut ids); ids } - -fn collect_ids(expression: &Expr, ids: &mut HashSet) { - match &expression.kind { - ExprKind::Local(id) => { - ids.insert(*id); - } - ExprKind::Lambda { binder, body } => { - ids.insert(binder.id); - collect_ids(body, ids); - } - ExprKind::Let { bindings, body } => { - for binding in bindings { - ids.insert(binding.binder.id); - collect_ids(&binding.value, ids); - } - collect_ids(body, ids); - } - ExprKind::Case { - scrutinee, - branches, - } => { - collect_ids(scrutinee, ids); - for branch in branches { - collect_pattern_ids(&branch.pattern, ids); - collect_ids(&branch.value, ids); - } - } - ExprKind::Constructor { arguments, .. } - | ExprKind::IntrinsicCall { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => { - for argument in arguments { - collect_ids(argument, ids); - } - } - ExprKind::Record { fields } => { - for (_, value) in fields { - collect_ids(value, ids); - } - } - ExprKind::RecordUpdate { record, fields } => { - collect_ids(record, ids); - for (_, value) in fields { - collect_ids(value, ids); - } - } - ExprKind::FieldAccess { record, .. } - | ExprKind::RepresentationCast { value: record, .. } => collect_ids(record, ids), - ExprKind::Application(left, right) => { - collect_ids(left, ids); - collect_ids(right, ids); - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - collect_ids(condition, ids); - collect_ids(then_branch, ids); - collect_ids(else_branch, ids); - } - ExprKind::Global(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::Boolean(_) - | ExprKind::String(_) - | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} - } -} - -fn collect_pattern_ids(pattern: &Pattern, ids: &mut HashSet) { - match &pattern.kind { - PatternKind::Var { id, .. } => { - ids.insert(*id); - } - PatternKind::Named { id, pattern } => { - ids.insert(*id); - collect_pattern_ids(pattern, ids); - } - PatternKind::Array { elements } => { - for element in elements { - collect_pattern_ids(element, ids); - } - } - PatternKind::Constructor { arguments, .. } => { - for argument in arguments { - collect_pattern_ids(argument, ids); - } - } - PatternKind::Record { fields } => { - for (_, field) in fields { - collect_pattern_ids(field, ids); - } - } - PatternKind::Wildcard | PatternKind::Literal { .. } => {} - } -} diff --git a/crates/psrs-core/src/primitive.rs b/crates/psrs-core/src/primitive.rs new file mode 100644 index 00000000..643544e9 --- /dev/null +++ b/crates/psrs-core/src/primitive.rs @@ -0,0 +1,155 @@ +//! Instantiate checked primitive callable values before runtime ABI erasure. +//! +//! This is mandatory elaboration, not budgeted optimization. Primitive globals +//! must use the checked type at each occurrence; adapting a polymorphic array +//! wrapper by copying its inputs would change mutation and reference identity. +use crate::locals::FreshLocals; +use crate::{Binder, Expr, ExprKind, Module, Type, VerifyError, arrow_parts, scheme_parts}; +use psrs_hir::{Intrinsic, SymbolId}; +use std::collections::HashMap; + +/// The caller supplies verified Core and validated operation identities. Work +/// on a candidate and verify the complete result before publishing it; failures +/// may leave this candidate partially rewritten. +pub fn expand_primitive_globals( + module: &mut Module, + primitives: &HashMap, +) -> Result<(), Vec> { + for declaration in &mut module.declarations { + let mut fresh = FreshLocals::for_declaration(&declaration.value); + rewrite( + &mut declaration.value, + &module.types, + primitives, + &mut fresh, + ) + .map_err(|message| { + vec![VerifyError { + module: declaration.symbol.module, + span: declaration.span, + message, + }] + })?; + } + Ok(()) +} + +fn rewrite( + expression: &mut Expr, + types: &[Type], + primitives: &HashMap, + fresh: &mut FreshLocals, +) -> Result<(), &'static str> { + match &mut expression.kind { + ExprKind::Global(symbol) => { + if let Some(intrinsic) = primitives.get(symbol) { + let (_, mut cursor) = scheme_parts(types, expression.ty) + .ok_or("primitive value has an invalid checked scheme")?; + let mut parameters = Vec::new(); + for index in 0..intrinsic.descriptor().arity { + let (parameter, result) = arrow_parts(types, cursor) + .ok_or("primitive value has an invalid checked function type")?; + let binder = Binder { + id: fresh + .fresh() + .ok_or("cannot allocate a primitive parameter")?, + name: format!("primitive_argument_{index}"), + ty: parameter, + span: expression.span, + }; + parameters.push((binder, cursor)); + cursor = result; + } + let mut body = Expr { + kind: ExprKind::IntrinsicCall { + intrinsic: *intrinsic, + arguments: parameters + .iter() + .map(|(binder, _)| Expr { + kind: ExprKind::Local(binder.id), + ty: binder.ty, + span: expression.span, + }) + .collect(), + }, + ty: cursor, + span: expression.span, + }; + for (binder, ty) in parameters.into_iter().rev() { + body = Expr { + kind: ExprKind::Lambda { + binder, + body: Box::new(body), + }, + ty, + span: expression.span, + }; + } + // Keep the occurrence's outer forall and its checked identities. + body.ty = expression.ty; + *expression = body; + } + } + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => { + for argument in arguments { + rewrite(argument, types, primitives, fresh)?; + } + } + ExprKind::Record { fields } => { + for (_, value) in fields { + rewrite(value, types, primitives, fresh)?; + } + } + ExprKind::RecordUpdate { record, fields } => { + rewrite(record, types, primitives, fresh)?; + for (_, value) in fields { + rewrite(value, types, primitives, fresh)?; + } + } + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } + | ExprKind::Lambda { body: record, .. } => rewrite(record, types, primitives, fresh)?, + ExprKind::Application(function, argument) => { + rewrite(function, types, primitives, fresh)?; + rewrite(argument, types, primitives, fresh)?; + } + ExprKind::Let { bindings, body } => { + for binding in bindings { + rewrite(&mut binding.value, types, primitives, fresh)?; + } + rewrite(body, types, primitives, fresh)?; + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + rewrite(condition, types, primitives, fresh)?; + rewrite(then_branch, types, primitives, fresh)?; + rewrite(else_branch, types, primitives, fresh)?; + } + ExprKind::Case { + scrutinee, + branches, + } => { + rewrite(scrutinee, types, primitives, fresh)?; + for branch in branches { + rewrite(&mut branch.value, types, primitives, fresh)?; + } + } + ExprKind::Local(_) + | ExprKind::Integer(_) + | ExprKind::Number(_) + | ExprKind::Boolean(_) + | ExprKind::String(_) + | ExprKind::Char(_) + | ExprKind::Unit + | ExprKind::StateToken + | ExprKind::Trap => {} + } + Ok(()) +} diff --git a/crates/psrs-core/src/verify/expr/arrays.rs b/crates/psrs-core/src/verify/expr/arrays.rs index 99534ba3..c17bd4a9 100644 --- a/crates/psrs-core/src/verify/expr/arrays.rs +++ b/crates/psrs-core/src/verify/expr/arrays.rs @@ -58,39 +58,20 @@ impl Context<'_> { ); } - pub(super) fn verify_array_apply( - &mut self, - expression: &Expr, - functions: &Expr, - values: &Expr, - ) { - self.expr(functions, None); - self.expr(values, None); - let shapes = array_element(functions.ty, self.module) - .and_then(|ty| crate::arrow_parts(&self.module.types, ty)) - .zip(array_element(values.ty, self.module)) - .zip(array_element(expression.ty, self.module)); - let Some((((parameter, result), element), output)) = shapes else { - self.errors.push(error(self.owner, expression.span, - "arrayApply expects an array of unary functions, an argument array, and an array result")); + pub(super) fn verify_array_fill(&mut self, expression: &Expr, length: &Expr, value: &Expr) { + self.expr( + length, + Some(primitive_type_id(self.module, TypeConstructor::Int)), + ); + let Some(element) = array_element(expression.ty, self.module) else { + self.errors.push(error( + self.owner, + expression.span, + "arrayFill must return an Array", + )); return; }; - compatible( - parameter, - element, - self.module, - self.owner, - values.span, - self.errors, - ); - compatible( - result, - output, - self.module, - self.owner, - expression.span, - self.errors, - ); + self.expr(value, Some(element)); } pub(super) fn verify_array_index(&mut self, expression: &Expr, array: &Expr, index: &Expr) { diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 1bfb1b1f..7fc79d96 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -22,15 +22,15 @@ impl Context<'_> { Intrinsic::ArrayIndex => { self.verify_array_index(expression, &arguments[0], &arguments[1]) } - Intrinsic::ArrayUpdate => { + Intrinsic::ArrayFill => { + self.verify_array_fill(expression, &arguments[0], &arguments[1]) + } + Intrinsic::ArrayWrite | Intrinsic::ArrayUpdate => { self.verify_array_update(expression, &arguments[0], &arguments[1], &arguments[2]) } Intrinsic::ArrayAppend => { self.verify_array_append(expression, &arguments[0], &arguments[1]) } - Intrinsic::ArrayApply => { - self.verify_array_apply(expression, &arguments[0], &arguments[1]) - } Intrinsic::StringToBytes => self.verify_string_to_bytes(expression, &arguments[0]), Intrinsic::BytesToString => self.verify_bytes_to_string(expression, &arguments[0]), _ => match intrinsic.descriptor().category { diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index efbdf678..c1bc4e36 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -1,5 +1,10 @@ use super::*; +fn run_library_program_with_wasmtime(sources: &[(&str, &str)]) -> Option { + let (sources, _) = crate::prelude::prepend(sources).unwrap(); + run_program_with_wasmtime(&sources) +} + #[test] fn primitive_foreign_bindings_validate_unused_operand_and_result_types() { for ty in [ @@ -56,7 +61,7 @@ fn primitive_foreign_bindings_keep_unimplemented_categories_explicit() { #[test] fn primitive_foreign_bindings_execute_as_first_class_functions() { let source = "module Main where\nforeign import \"psrs:intrinsic#intToNumber\" convert :: Int -> Number\nforeign import \"psrs:intrinsic#numberAdd\" add :: Number -> Number -> Number\nforeign import \"psrs:intrinsic#numberEq\" equal :: Number -> Number -> Boolean\napply f x = f x\nmain = if equal (apply (add (convert 40)) 2.0) 42.0 then 42 else 1\n"; - let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { return; }; assert_eq!(output.status.code(), Some(42), "{output:?}"); @@ -66,7 +71,8 @@ fn primitive_foreign_bindings_execute_as_first_class_functions() { fn primitive_foreign_bindings_preserve_cross_module_operator_identity() { let native = "module Native where\nforeign import \"psrs:intrinsic#intAdd\" sum :: Int -> Int -> Int\ninfixl 6 sum as %%\n"; let main = "module Main where\nimport Native\nmain = 40 %% 2\n"; - let Some(output) = run_program_with_wasmtime(&[("Native.purs", native), ("Main.purs", main)]) + let Some(output) = + run_library_program_with_wasmtime(&[("Native.purs", native), ("Main.purs", main)]) else { return; }; @@ -103,7 +109,7 @@ fn primitive_foreign_bindings_match_pinned_official_scalar_observations() { "oracle fixture must retain the actual vendored binding: {declaration}" ); } - let Some(output) = run_program_with_wasmtime(&sources) else { + let Some(output) = run_library_program_with_wasmtime(&sources) else { return; }; assert_eq!(output.status.code(), Some(42), "{output:?}"); @@ -137,7 +143,8 @@ main = (booleanAnd (intEq (arrayLength (stringToBytes (at texts 1))) 4) (intEq (at records 0).value 42)))))))) then 42 else 1 "#; - let Some(output) = run_program_with_wasmtime(&[("Native.purs", native), ("Main.purs", main)]) + let Some(output) = + run_library_program_with_wasmtime(&[("Native.purs", native), ("Main.purs", main)]) else { return; }; @@ -147,14 +154,10 @@ main = #[test] fn primitive_foreign_array_contracts_reject_inconsistent_quantified_elements() { for (operation, ty) in [ - ( - "arrayApply", - "forall a b. Array (a -> b) -> Array b -> Array b", - ), - ( - "arrayApply", - "forall a b. Array (a -> b) -> Array a -> Array a", - ), + ("arrayFill", "forall a b. Int -> a -> Array b"), + ("arrayFill", "forall a. a -> a -> Array a"), + ("arrayWrite", "forall a b. Array a -> Int -> b -> Array a"), + ("arrayWrite", "forall a b. Array a -> Int -> a -> Array b"), ("arrayAppend", "forall a b. Array a -> Array b -> Array a"), ("arrayIndex", "forall a b. Array a -> Int -> b"), ("arrayUpdate", "forall a b. Array a -> Int -> b -> Array a"), @@ -175,9 +178,10 @@ fn primitive_foreign_array_contracts_reject_inconsistent_quantified_elements() { } #[test] -fn primitive_foreign_array_apply_preserves_callback_order_and_captures() { +fn library_array_apply_preserves_callback_order_and_captures() { let source = r#"module Main where -foreign import "psrs:intrinsic#arrayApply" cartesian :: forall a b. Array (a -> b) -> Array a -> Array b +import PSRS.Array (arrayApply) +cartesian = arrayApply add offset x = intAdd offset x main = let @@ -200,23 +204,24 @@ main = (booleanAnd (intEq (arrayLength emptyFunctions) 0) (intEq (arrayIndex input 0) 10)))))))))) then 42 else 1 "#; - let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { return; }; assert_eq!(output.status.code(), Some(42), "{output:?}"); } #[test] -fn array_apply_returns_curried_functions_through_both_entry_points() { +fn library_array_apply_returns_curried_functions_through_aliases() { for operation in ["foreignApply", "arrayApply"] { let source = format!( r#"module Main where -foreign import "psrs:intrinsic#arrayApply" foreignApply :: forall a b. Array (a -> b) -> Array a -> Array b +import PSRS.Array (arrayApply) +foreignApply = arrayApply add x y = intAdd x y main = (arrayIndex ({operation} [add] [40]) 0) 2 "# ); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", &source)]) else { return; }; assert_eq!(output.status.code(), Some(42), "{output:?}"); @@ -226,11 +231,12 @@ main = (arrayIndex ({operation} [add] [40]) 0) 2 #[test] fn array_apply_traps_before_wrapping_an_unrepresentable_result_length() { let source = r#"module Main where -foreign import "psrs:intrinsic#arrayApply" cartesian :: forall a b. Array (a -> b) -> Array a -> Array b +import PSRS.Array (arrayApply) +cartesian = arrayApply double n xs = if intEq n 0 then xs else double (intSub n 1) (arrayAppend xs xs) main = arrayLength (cartesian (double 16 [\x -> x]) (double 16 [0])) "#; - let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { return; }; assert!( @@ -238,15 +244,18 @@ main = arrayLength (cartesian (double 16 [\x -> x]) (double 16 [0])) "the 2^32 product must trap, not return an empty array" ); assert!( - String::from_utf8_lossy(&output.stderr).contains("unreachable"), + String::from_utf8_lossy(&output.stderr).contains("out of bounds array access"), "{output:?}" ); } #[test] -fn primitive_foreign_array_apply_matches_pinned_official_observations() { +fn library_array_apply_matches_pinned_official_observations() { let golden = include_str!("../../tests/fixtures/stdlib-array/Golden.purs"); - let declaration = golden.lines().nth(1).unwrap(); + let declaration = golden + .lines() + .find(|line| line.starts_with("arrayApply ::")) + .unwrap(); let module = crate::prelude::sources() .unwrap() .iter() @@ -263,7 +272,80 @@ fn primitive_foreign_array_apply_matches_pinned_official_observations() { include_str!("../../tests/fixtures/stdlib-array/Main.purs"), ), ]; - let Some(output) = run_program_with_wasmtime(&sources) else { + let Some(output) = run_library_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn primitive_array_fill_and_write_preserve_initialization_and_aliases() { + let source = r#"module Main where +foreign import "psrs:intrinsic#arrayFill" filled :: forall a. Int -> a -> Array a +foreign import "psrs:intrinsic#arrayWrite" write :: forall a. Array a -> Int -> a -> Array a +main = + let + xs = filled 3 1 + put = write xs 1 + ys = put 42 + ignored = arrayWrite xs 2 9 + texts = filled 2 "😀" + records = filled 2 { value: 42 } + functions = filled 2 (\x -> intAdd x 2) + empty = filled 0 "λ" + in if booleanAnd (intEq (arrayLength xs) 3) + (booleanAnd (intEq (arrayIndex xs 1) 42) + (booleanAnd (intEq (arrayIndex ys 1) 42) + (booleanAnd (intEq (arrayIndex xs 2) 9) + (booleanAnd (intEq (arrayLength (stringToBytes (arrayIndex texts 1))) 4) + (booleanAnd (intEq (arrayIndex records 1).value 42) + (booleanAnd (intEq ((arrayIndex functions 1) 40) 42) + (intEq (arrayLength empty) 0))))))) then 42 else 1 +"#; + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn primitive_array_fill_and_write_trap_on_invalid_lengths_or_indices() { + for body in [ + "arrayLength (filled (intNeg 1) 0)", + "arrayLength (write [1] 1 2)", + "arrayLength (write [1] (intNeg 1) 2)", + ] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#arrayFill\" filled :: forall a. Int -> a -> Array a\nforeign import \"psrs:intrinsic#arrayWrite\" write :: forall a. Array a -> Int -> a -> Array a\nmain = {body}\n" + ); + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert!(!output.status.success(), "{body}: {output:?}"); + } +} + +#[test] +fn library_array_bind_matches_pinned_official_observations() { + let golden = include_str!("../../tests/fixtures/stdlib-array-bind/Golden.purs"); + let signature = golden + .lines() + .find(|line| line.starts_with("arrayBind ::")) + .unwrap(); + let modules = crate::prelude::sources().unwrap(); + let native = modules + .iter() + .find(|module| module.module_name == "Control.Bind") + .unwrap(); + assert!(native.text.lines().any(|line| line == signature)); + let sources = [ + ("Golden.purs", golden), + ( + "Main.purs", + include_str!("../../tests/fixtures/stdlib-array-bind/Main.purs"), + ), + ]; + let Some(output) = run_library_program_with_wasmtime(&sources) else { return; }; assert_eq!(output.status.code(), Some(42), "{output:?}"); diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-bind/Golden.purs b/crates/psrs-driver/tests/fixtures/stdlib-array-bind/Golden.purs new file mode 100644 index 00000000..0ef6c1e8 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-bind/Golden.purs @@ -0,0 +1,4 @@ +module Golden where +import PSRS.Array as Target.Array +arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b +arrayBind = Target.Array.arrayBind diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-bind/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-array-bind/Main.purs new file mode 100644 index 00000000..a9864abc --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-bind/Main.purs @@ -0,0 +1,16 @@ +module Main where +import Golden as Golden +main = + let + r0 = Golden.arrayBind [4, 0, 9] ((\offset -> \x -> if intEq x 0 then [] else [intAdd offset x, intMul x 2]) 1) + r1 = Golden.arrayBind [4, 8] (\x -> [numberAdd (intToNumber x) 0.5]) + r2 = Golden.arrayBind [40] (\x -> [{ value: intAdd x 2 }]) + r3 = Golden.arrayBind [1, 2] (\x -> [[x], [intAdd x 10]]) + r4 = Golden.arrayBind [1, 2] (\x -> [if intEq x 1 then "λ" else "😀"]) + r5 = Golden.arrayBind [] (\x -> [arrayIndex ([] :: Array Int) x]) + r6 = Golden.arrayBind [1, 2] (\x -> ([] :: Array Int)) + curried = Golden.arrayBind [40] (\x -> [\y -> intAdd x y]) + shared = arrayFill 2 0 + mutate x = let first = arrayWrite shared 0 x in arrayWrite first 1 (intAdd (arrayIndex first 1) 1) + observed = Golden.arrayBind [10,20] mutate + in if (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength r0) 4) (intEq (arrayIndex r0 0) 5)) (booleanAnd (intEq (arrayIndex r0 1) 8) (intEq (arrayIndex r0 2) 10))) (booleanAnd (booleanAnd (intEq (arrayIndex r0 3) 18) (intEq (arrayLength r1) 2)) (booleanAnd (numberEq (arrayIndex r1 0) 4.5) (booleanAnd (numberEq (arrayIndex r1 1) 8.5) (intEq (arrayLength r2) 1))))) (booleanAnd (booleanAnd (booleanAnd (intEq ((arrayIndex r2 0)).value 42) (intEq (arrayLength r3) 4)) (booleanAnd (intEq (arrayLength (arrayIndex r3 0)) 1) (intEq (arrayIndex (arrayIndex r3 0) 0) 1))) (booleanAnd (booleanAnd (intEq (arrayLength (arrayIndex r3 1)) 1) (intEq (arrayIndex (arrayIndex r3 1) 0) 11)) (booleanAnd (intEq (arrayLength (arrayIndex r3 2)) 1) (booleanAnd (intEq (arrayIndex (arrayIndex r3 2) 0) 2) (intEq (arrayLength (arrayIndex r3 3)) 1)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex (arrayIndex r3 3) 0) 12) (intEq (arrayLength r4) 2)) (booleanAnd (intEq (arrayLength (stringToBytes (arrayIndex r4 0))) 2) (intEq (arrayIndex (stringToBytes (arrayIndex r4 0)) 0) 206))) (booleanAnd (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 0)) 1) 187) (intEq (arrayLength (stringToBytes (arrayIndex r4 1))) 4)) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 0) 240) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 1) 159) (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 2) 152))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 3) 128) (intEq (arrayLength r5) 0)) (booleanAnd (intEq (arrayLength r6) 0) (booleanAnd (intEq ((arrayIndex curried 0) 2) 42) (intEq (arrayLength observed) 4)))) (booleanAnd (booleanAnd (intEq (arrayIndex observed 0) 10) (intEq (arrayIndex observed 1) 1)) (booleanAnd (intEq (arrayIndex observed 2) 20) (booleanAnd (intEq (arrayIndex observed 3) 2) (intEq (arrayIndex shared 1) 2))))))) then 42 else 1 diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-bind/observations.json b/crates/psrs-driver/tests/fixtures/stdlib-array-bind/observations.json new file mode 100644 index 00000000..f4ce4bf3 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-bind/observations.json @@ -0,0 +1,102 @@ +{ + "node": "v26.10.0", + "upstream_commit": "f4cad0ae8106185c9ab407f43cf9abf05c256af4", + "official_js_sha256": "f05d5b14753a4b190b448fda0bfac66f97765bf5835f55c8e9c22dcbe5188543", + "observations": [ + { + "name": "variable_chunks_and_capture", + "values": [ + 4, + 0, + 9 + ], + "result": [ + 5, + 8, + 10, + 18 + ] + }, + { + "name": "number_results", + "values": [ + 4, + 8 + ], + "result": [ + 4.5, + 8.5 + ] + }, + { + "name": "records", + "values": [ + 40 + ], + "result": [ + { + "value": 42 + } + ] + }, + { + "name": "nested_arrays", + "values": [ + 1, + 2 + ], + "result": [ + [ + 1 + ], + [ + 11 + ], + [ + 2 + ], + [ + 12 + ] + ] + }, + { + "name": "utf8_results", + "values": [ + 1, + 2 + ], + "result": [ + "λ", + "😀" + ] + }, + { + "name": "empty_input", + "values": [], + "result": [] + }, + { + "name": "empty_chunks", + "values": [ + 1, + 2 + ], + "result": [] + }, + { + "name": "returned_function", + "result": 42 + }, + { + "name": "callback_count_and_shared_chunk_snapshot", + "result": [ + 10, + 1, + 20, + 2 + ], + "calls": 2 + } + ] +} diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs b/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs index d4385f4b..ed23a02d 100644 --- a/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs +++ b/crates/psrs-driver/tests/fixtures/stdlib-array/Golden.purs @@ -1,2 +1,4 @@ module Golden where -foreign import "psrs:intrinsic#arrayApply" arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b +import PSRS.Array as Target.Array +arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b +arrayApply = Target.Array.arrayApply diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 1527cd5c..23b58af5 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -97,8 +97,10 @@ pub enum Intrinsic { /// proof; it is a representation-preserving cast at the value's erased /// boundary. UnsafeCoerce, - /// Apply each function to each value, in function-major order. - ArrayApply, + /// Allocate a fresh array fully initialized with one checked element. + ArrayFill, + /// Unsafe in-place write; returns the same array. Library internals only. + ArrayWrite, } impl Intrinsic { @@ -121,7 +123,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 62] = [ + pub const ALL: [Intrinsic; 63] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -183,7 +185,8 @@ impl Intrinsic { Intrinsic::Unit, Intrinsic::ArrayAppend, Intrinsic::UnsafeCoerce, - Intrinsic::ArrayApply, + Intrinsic::ArrayFill, + Intrinsic::ArrayWrite, ]; } @@ -192,7 +195,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::ArrayApply as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::ArrayWrite as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index e0b55b9f..a777ea97 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -30,8 +30,10 @@ pub enum IntrinsicCategory { ArrayUpdate, /// `Array.append`: `forall a. Array a -> Array a -> Array a`. ArrayAppend, - /// `forall a b. Array (a -> b) -> Array a -> Array b`. - ArrayApply, + /// `forall a. Int -> a -> Array a`. + ArrayFill, + /// `forall a. Array a -> Int -> a -> Array a`, in place. + ArrayWrite, /// A source `String` to its canonical UTF-8 bytes. StringToBytes, /// Canonical UTF-8 bytes back to a source `String`. @@ -144,7 +146,8 @@ descriptors! { Unit => "unit", 0, Nullary, scheme::unit; ArrayAppend => "arrayAppend", 2, ArrayAppend, scheme::array_append; UnsafeCoerce => "__psrs_unsafe_coerce", 1, Coercion, scheme::unsafe_coerce; - ArrayApply => "arrayApply", 2, ArrayApply, scheme::array_apply; + ArrayFill => "arrayFill", 2, ArrayFill, scheme::array_fill; + ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that @@ -327,13 +330,10 @@ mod scheme { ) } - pub(super) fn array_apply() -> Type { + pub(super) fn array_fill() -> Type { forall( - &["a", "b"], - arrow( - array(arrow(variable("a"), variable("b"))), - arrow(array(variable("a")), array(variable("b"))), - ), + &["a"], + arrow(int(), arrow(variable("a"), array(variable("a")))), ) } diff --git a/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md b/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md index d9353f9a..766ba4a4 100644 --- a/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md +++ b/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md @@ -106,3 +106,20 @@ and supersedes this record's mechanism clause and its rule against recognizing wraps foreign imports in ordinary PureScript, and the compiler does not grow a parallel type vocabulary. The amendment above that admitted non-byte `Array` lists is subsumed by DEC-13. + +## Amendment — source target implementations over array storage primitives + +Array algorithms belong in the target standard library. Wasm requires concrete +allocation and element-storage operations, but it does not require compiler +implementations of `arrayApply` or `arrayBind`. These implementation slots may +use ordinary PureScript source over private `arrayFill`, `arrayWrite`, length +and index primitives while preserving the official signatures, exports and +other pure declarations. Mutating primitives require fresh buffer ownership; +fully initialized allocation avoids exposing invalid default reference slots. +The compiler owns checked primitive identity, typed occurrence elaboration, +representation and Wasm encoding. The library owns loops, callback sequencing, +snapshot/flatten behavior and overflow policy. Mandatory primitive elaboration +must retain aliasing instead of copying arrays through a polymorphic wrapper. +This amendment does not authorize rewriting valid official pure definitions, +introducing per-function naming heuristics, or treating unimplemented FFI as an +empty result. Source diffs and official behavior evidence remain required. diff --git a/docs/design/D-17-stdlib-and-conformance-boundaries.md b/docs/design/D-17-stdlib-and-conformance-boundaries.md index d405ced1..d47dac4c 100644 --- a/docs/design/D-17-stdlib-and-conformance-boundaries.md +++ b/docs/design/D-17-stdlib-and-conformance-boundaries.md @@ -12,6 +12,9 @@ compiler's `stdlib/` subtree history; the move preserves source bytes. The compiler owns language semantics, checked foreign binding identity and type evidence, supported binding protocols, lowering, and runtime representation. +The library owns array algorithms over small runtime/storage primitives; +checked primitive calls and allocation/write semantics belong to the compiler. +Whole stdlib functions are not automatically intrinsic candidates. Library source changes cannot compensate for compiler defects. Follow the [source-fidelity contract](../workflow/stdlib-vendoring.md). diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index e32a683c..b395068d 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -602,35 +602,53 @@ These source instances do not change native tuple syntax or WIT tuple layout. - Issue #56, whose request to grow compiler source types for `Maybe`, `Either`, and tuples this contract replaces. The user-facing types remain library types. -## Polymorphic primitive foreign functions +## Primitive callable and array storage boundaries An explicit primitive binding retains its checked source signature. P8 reads -its leading lexical quantifiers through Core's shared scheme operation and -moves their identities into the generated declaration scope. It peels only the -body's leading arrows, preserves the declared element relationships, and uses -Core's intrinsic verifier before publishing the generated function. Unsupported -categories and malformed signatures still fail, including unused declarations. -This supports the existing array and UTF-8 byte primitives as ordinary foreign -functions without weakening their type contracts. - -`arrayApply` has scheme `forall a b. Array (a -> b) -> Array a -> Array b`. -Core verifies both element relationships. CC records the three array -representations, the actual callback signature, and an invocation helper. -The helper consumes exactly one source argument through the common application -lowering, including partial application when the callback returns a function. -The full CC verifier requires that helper to exist with the checked input/output -ABI; per-function verification defers helper existence to that module check. -Reachability retains the helper, callback signature, and array representations. - -MIR allocates once and emits nested loops in function-major order. Each function -is cached for its entire value traversal; inputs are preserved. Nullable storage -views permit references to cross structured control labels and are refined at -use sites. These refinements preserve the existing calling convention; callable -adaptation remains owned by the common checked conversion/application protocol. -Negative source lengths and products outside signed i32 capacity trap before -allocation or callbacks. Empty inputs invoke no callbacks. - -The library owns its pinned JS oracle and source binding in `psrs-stdlib`; -see its `docs/array-apply.md` and `conformance/arrays.mjs`. Whole-library compile -acceptance and runtime/FFI acceptance remain independent of this operation's -focused behavior evidence. +leading lexical quantifiers through Core's shared scheme operation, preserves +their identities in the declaration scope, and verifies the generated primitive +body. Unsupported categories and invalid signatures fail even when unused. +The complete candidate is published only after successful verification. + +Core then expands each checked primitive global occurrence into a typed lambda +at that occurrence's already checked type. This is mandatory elaboration, +independent of P7 optimization budgets. Shared Core local allocation prevents +capture. It handles bare values and partial/saturated applications with the +ordinary lambda/application path. A polymorphic array wrapper followed by an +array-mapping ABI adapter is insufficient for mutation: the adapter can copy the +array and direct writes at the copy. Occurrence expansion retains the exact +array representation required by the call, including aliases and partial calls. + +The compiler provides small storage operations, not one intrinsic per stdlib +algorithm. `arrayFill :: forall a. Int -> a -> Array a` allocates a fresh array +fully initialized with one checked value; a negative length traps. Its MIR form +validates the length, initializer, storage and destination types and lowers to +Wasm GC `array.new`. It never exposes uninitialized or default-null logical +elements. `arrayWrite :: forall a. Array a -> Int -> a -> Array a` is an unsafe +in-place write and returns the same array; invalid indices trap. Core checks +all element relationships and MIR preserves the write as an observable effect. +The raw writes are private to target library code with fresh output ownership. + +`psrs-stdlib/lib/PSRS/Array.purs` owns `arrayApply` and `arrayBind`. Original +Prelude exports and public signatures remain; only their foreign implementation +slots delegate to this target module. Class/instance and other pure code remain +official. No compiler registry entry, CC operation, callback invoker or MIR loop +is dedicated to either algorithm. Recursion and callbacks use ordinary checked +PureScript calls, closure adaptation and tail-call lowering. + +The library applies functions in function-major order, caching each function +for its value traversal and invoking it once per pair. Bind visits inputs in +order, invokes each callback once, snapshots its returned array immediately, +and flattens the snapshots. The immediate shallow copy preserves the official +behavior when a later callback mutates a previously returned array. Storage and +copy work are linear in input/result size. Array apply checks signed-i32 product +capacity before callbacks; bind checks cumulative capacity before accepting a +chunk. Allocation exhaustion and unrepresentable sizes trap as target resource +boundaries. Empty inputs invoke no callbacks. + +Primitive additions require a runtime/storage justification and checked contracts. +Missing JS FFI alone does not justify a new whole-function intrinsic. Generic +Wasm/WASI adaptation belongs in source library code whenever these operations +and ordinary language features can express it. See the independent package's +`docs/array-kernels.md` and official JS generators for behavior evidence. Focused +observations do not establish whole-library compile or runtime/FFI acceptance. diff --git a/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md b/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md new file mode 100644 index 00000000..f5c7b0f4 --- /dev/null +++ b/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md @@ -0,0 +1,61 @@ +# Library array algorithms and checked storage checkpoint + +The compiler no longer owns whole-function array application or binding kernels. +The independent `psrs-stdlib` revision is `23ba4b9de6ba310a8c77e4c6a1e5cd56d68c528e`. It owns ordinary +PureScript `PSRS.Array` implementations and explicit target provenance. Official +`Control.Apply` and `Control.Bind` only add an import and replace their foreign +slots with target aliases; their public signatures and other pure code remain. + +The compiler adds initialized `arrayFill` and unsafe in-place `arrayWrite`. +Core validates element identities, CC carries checked representations and values, +MIR validates length/initializer/storage/destination and lowers initialized +allocation directly to Wasm GC `array.new`. Writes use existing array stores. +No callback or traversal algorithm is hidden inside these primitives. The old +`ArrayApply` registry/CC/MIR operation and callback invoker were removed. + +A general primitive linking defect was exposed by mutation: a polymorphic +foreign wrapper adapted its concrete input by copying the array, so a write +changed the copy. Mandatory Core occurrence elaboration now expands every +validated primitive global using its checked occurrence type before ABI erasure, +including first-class and partial uses. The common collision-free Core local +allocator is shared with optimization. Complete candidate verification and +rollback remain required; unused incorrect primitive signatures still fail. + +Validation: + +- Mandatory Wasmtime driver primitive/library regressions: 16 passed. They + include first-class/partial bindings, array aliases and unused writes, + initialized references/records/closures, invalid lengths/indices and element + relationships, captures, returned functions, empty arrays and product overflow. +- Official JS observations: 8 apply cases/29 checks and 9 bind cases/37 checks, + both exit 42 with empty output. Bind includes callback count and immediate + snapshots of a shared mutable array. The 46-case scalar oracle also passed. + The independent library owns the generators, observations and runtime reports + in `docs/evidence/source-array-kernels-2026-10-06/`. +- Malformed MIR filled-array test: passed; wrong initializer or noninteger + length is rejected, and a valid initialized allocation is accepted. +- Transactional primitive linking tests: 3 passed. +- Core optimization regressions after sharing local allocation: 24 passed. +- Intrinsic descriptor arity test: passed. +- Locked trusted-library loader regression: passed; Prelude remains first. +- Let-constraint regressions: 14 passed. +- Library-owned Node tooling regressions: 8 passed. +- CLI rebuild, formatting, and workspace clippy with warnings denied passed. +- Complete pinned audit: 41 packages, 216 modules, 193 exact, 13 modified and + 10 explicitly recorded target additions; no absent official module and no + detected exact direct same-argument recursion. The audit is comparison + evidence, not blanket approval of every adaptation. + +The unchanged full reproducer still fails. Unsupported-library P8 reports fell +from 232 to 231 and the first is `Control.Extend.arrayExtend`. The snapshot +`diagnose.json` records the 38.937-second development run and complete diagnostics. +Package content changed from `fnv1a64-v1:aca9437f2fcdd5a8` to +`fnv1a64-v1:9c725bfe5140502e`, so these are explicit migration measurements, +not an unchanged-cohort `diagnose --compare` result or a suite scoreboard update. + +Remaining work includes full stdlib compile/runtime/FFI acceptance, unsupported +bindings and layouts, general polymorphic array identity/mutation interactions, +and independent CI package acquisition. Physical array mapping can still copy +across ordinary polymorphic function boundaries; these private builder tests +prove no broader alias guarantee. No full workspace tests or full scoreboard +were run. No push, PR or issue operation was performed. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 3e2e882b..608f8674 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -69,3 +69,19 @@ The compiler retains its package lock and Rust regression tests. A cargo xtask wrapper, if added, should delegate to this CLI. The former Python component and compiler-local compatibility scripts were removed after report-equivalent Node validation. Historical evidence retains the commands used at that time. + +For library array binding, generate the independent official observations and +run them through the same executable boundary: + +```sh +node ../psrs-stdlib/conformance/array-bind.mjs \ + /private/tmp/purescript-prelude /tmp/psrs-bind-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-bind-oracle/Golden.purs \ + --input /tmp/psrs-bind-oracle/Main.purs --out /tmp/psrs-bind-runtime +``` + +Both array algorithms are PureScript target library implementations. The oracle +fixtures copy the official public signature and import that implementation; +there is no whole-function compiler intrinsic for either operation. diff --git a/stdlib.lock.json b/stdlib.lock.json index 3950e6c9..2d287ae4 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "073e32581dfe21ef7191ac906b36ba5445b3152a", - "source_fingerprint": "fnv1a64-v1:aca9437f2fcdd5a8" + "revision": "23ba4b9de6ba310a8c77e4c6a1e5cd56d68c528e", + "source_fingerprint": "fnv1a64-v1:9c725bfe5140502e" } From c35e1e9dae8559306c07c8dd1e7405714a1e2ec3 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 19:02:37 +0800 Subject: [PATCH 042/148] Consume library array extend and update the stdlib lock The stdlib package revision e8b21f7 implements Control.Extend.arrayExtend in ordinary PureScript over the checked storage primitives. The compiler lock now records that revision and its fnv1a64 content fingerprint. Add the pinned official-observation fixture and a focused Wasmtime regression that keeps the golden signature aligned with the vendored Control.Extend module. The full reproducer still fails: unsupported-library P8 diagnostics fall from 231 to 230 and the first is Control.Monad.ST.Internal.map_. --- .../src/tests/primitive_foreign.rs | 26 +++++++++++ .../fixtures/stdlib-array-extend/Golden.purs | 4 ++ .../fixtures/stdlib-array-extend/Main.purs | 18 ++++++++ .../DEC-11-primitive-ffi-stdlib-wrappers.md | 3 +- .../backend/wasm/primitive-ffi-and-stdlib.md | 14 ++++-- .../source-array-kernels-2026-10-06/report.md | 44 +++++++++++-------- stdlib.lock.json | 4 +- 7 files changed, 88 insertions(+), 25 deletions(-) create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-extend/Golden.purs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-extend/Main.purs diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index c1bc4e36..0487f9ca 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -350,3 +350,29 @@ fn library_array_bind_matches_pinned_official_observations() { }; assert_eq!(output.status.code(), Some(42), "{output:?}"); } + +#[test] +fn library_array_extend_matches_pinned_official_observations() { + let golden = include_str!("../../tests/fixtures/stdlib-array-extend/Golden.purs"); + let signature = golden + .lines() + .find(|line| line.starts_with("arrayExtend ::")) + .unwrap(); + let modules = crate::prelude::sources().unwrap(); + let native = modules + .iter() + .find(|module| module.module_name == "Control.Extend") + .unwrap(); + assert!(native.text.lines().any(|line| line == signature)); + let sources = [ + ("Golden.purs", golden), + ( + "Main.purs", + include_str!("../../tests/fixtures/stdlib-array-extend/Main.purs"), + ), + ]; + let Some(output) = run_library_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-extend/Golden.purs b/crates/psrs-driver/tests/fixtures/stdlib-array-extend/Golden.purs new file mode 100644 index 00000000..c2c49899 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-extend/Golden.purs @@ -0,0 +1,4 @@ +module Golden where +import PSRS.Array as Target.Array +arrayExtend :: forall a b. (Array a -> b) -> Array a -> Array b +arrayExtend = Target.Array.arrayExtend diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-extend/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-array-extend/Main.purs new file mode 100644 index 00000000..a02f58dd --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-extend/Main.purs @@ -0,0 +1,18 @@ +module Main where +import Golden as Golden +main = + let + r0 = Golden.arrayExtend (\suffix -> intAdd (arrayIndex suffix 0) (arrayLength suffix)) [10, 20, 30] + r1 = Golden.arrayExtend (\suffix -> numberAdd (intToNumber (arrayIndex suffix 0)) 0.5) [4, 8] + r2 = Golden.arrayExtend (\suffix -> { value: intAdd ((arrayIndex suffix 0).value) 2 }) [{ value: 40 }] + r3 = Golden.arrayExtend (\suffix -> [arrayLength suffix, arrayIndex (arrayIndex suffix 0) 0]) [[1], [2]] + r4 = Golden.arrayExtend (\suffix -> if intEq (arrayLength suffix) 2 then "λ" else "😀") [1, 2] + r5 = Golden.arrayExtend (\suffix -> arrayIndex ([] :: Array Int) 0) [] + closures = Golden.arrayExtend (\suffix -> \n -> intAdd (arrayIndex suffix 0) n) [40, 41] + counter = arrayFill 1 0 + bump suffix = let first = arrayWrite counter 0 (intAdd (arrayIndex counter 0) 1) in intAdd (arrayIndex first 0) (arrayLength suffix) + counted = Golden.arrayExtend bump [10, 20, 30] + sourceArray = [1, 2, 3] + scribble suffix = let first = arrayWrite suffix 0 (intAdd (arrayIndex suffix 0) 100) in arrayIndex first 0 + scribbled = Golden.arrayExtend scribble sourceArray + in if (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength r0) 3) (intEq (arrayIndex r0 0) 13)) (booleanAnd (intEq (arrayIndex r0 1) 22) (booleanAnd (intEq (arrayIndex r0 2) 31) (intEq (arrayLength r1) 2)))) (booleanAnd (booleanAnd (numberEq (arrayIndex r1 0) 4.5) (numberEq (arrayIndex r1 1) 8.5)) (booleanAnd (intEq (arrayLength r2) 1) (booleanAnd (intEq ((arrayIndex r2 0)).value 42) (intEq (arrayLength r3) 2))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength (arrayIndex r3 0)) 2) (intEq (arrayIndex (arrayIndex r3 0) 0) 2)) (booleanAnd (intEq (arrayIndex (arrayIndex r3 0) 1) 1) (booleanAnd (intEq (arrayLength (arrayIndex r3 1)) 2) (intEq (arrayIndex (arrayIndex r3 1) 0) 1)))) (booleanAnd (booleanAnd (intEq (arrayIndex (arrayIndex r3 1) 1) 2) (intEq (arrayLength r4) 2)) (booleanAnd (intEq (arrayLength (stringToBytes (arrayIndex r4 0))) 2) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 0)) 0) 206) (intEq (arrayIndex (stringToBytes (arrayIndex r4 0)) 1) 187)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength (stringToBytes (arrayIndex r4 1))) 4) (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 0) 240)) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 1) 159) (booleanAnd (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 2) 152) (intEq (arrayIndex (stringToBytes (arrayIndex r4 1)) 3) 128)))) (booleanAnd (booleanAnd (intEq (arrayLength r5) 0) (intEq ((arrayIndex closures 0) 2) 42)) (booleanAnd (intEq ((arrayIndex closures 1) 1) 42) (booleanAnd (intEq (arrayLength counted) 3) (intEq (arrayIndex counted 0) 4))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex counted 1) 4) (intEq (arrayIndex counted 2) 4)) (booleanAnd (intEq (arrayIndex counter 0) 3) (booleanAnd (intEq (arrayLength scribbled) 3) (intEq (arrayIndex scribbled 0) 101)))) (booleanAnd (booleanAnd (intEq (arrayIndex scribbled 1) 102) (booleanAnd (intEq (arrayIndex scribbled 2) 103) (intEq (arrayLength sourceArray) 3))) (booleanAnd (intEq (arrayIndex sourceArray 0) 1) (booleanAnd (intEq (arrayIndex sourceArray 1) 2) (intEq (arrayIndex sourceArray 2) 3))))))) then 42 else 1 diff --git a/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md b/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md index 766ba4a4..df2efe06 100644 --- a/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md +++ b/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md @@ -111,7 +111,8 @@ lists is subsumed by DEC-13. Array algorithms belong in the target standard library. Wasm requires concrete allocation and element-storage operations, but it does not require compiler -implementations of `arrayApply` or `arrayBind`. These implementation slots may +implementations of `arrayApply`, `arrayBind` or `arrayExtend`. These +implementation slots may use ordinary PureScript source over private `arrayFill`, `arrayWrite`, length and index primitives while preserving the official signatures, exports and other pure declarations. Mutating primitives require fresh buffer ownership; diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index b395068d..abb2fe6f 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -629,18 +629,24 @@ in-place write and returns the same array; invalid indices trap. Core checks all element relationships and MIR preserves the write as an observable effect. The raw writes are private to target library code with fresh output ownership. -`psrs-stdlib/lib/PSRS/Array.purs` owns `arrayApply` and `arrayBind`. Original -Prelude exports and public signatures remain; only their foreign implementation +`psrs-stdlib/lib/PSRS/Array.purs` owns `arrayApply`, `arrayBind` and +`arrayExtend`. Original +Prelude and Control exports and public signatures remain; only their foreign +implementation slots delegate to this target module. Class/instance and other pure code remain official. No compiler registry entry, CC operation, callback invoker or MIR loop -is dedicated to either algorithm. Recursion and callbacks use ordinary checked +is dedicated to any of these algorithms. Recursion and callbacks use ordinary +checked PureScript calls, closure adaptation and tail-call lowering. The library applies functions in function-major order, caching each function for its value traversal and invoking it once per pair. Bind visits inputs in order, invokes each callback once, snapshots its returned array immediately, and flattens the snapshots. The immediate shallow copy preserves the official -behavior when a later callback mutates a previously returned array. Storage and +behavior when a later callback mutates a previously returned array. Extend +visits indices in increasing order, invokes its callback once per index, and +passes a fresh shallow suffix copy, so callback mutation cannot change the source +array. Storage and copy work are linear in input/result size. Array apply checks signed-i32 product capacity before callbacks; bind checks cumulative capacity before accepting a chunk. Allocation exhaustion and unrepresentable sizes trap as target resource diff --git a/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md b/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md index f5c7b0f4..511bbcd2 100644 --- a/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md +++ b/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md @@ -1,10 +1,12 @@ # Library array algorithms and checked storage checkpoint -The compiler no longer owns whole-function array application or binding kernels. -The independent `psrs-stdlib` revision is `23ba4b9de6ba310a8c77e4c6a1e5cd56d68c528e`. It owns ordinary -PureScript `PSRS.Array` implementations and explicit target provenance. Official -`Control.Apply` and `Control.Bind` only add an import and replace their foreign -slots with target aliases; their public signatures and other pure code remain. +The compiler no longer owns whole-function array application, binding or +extension kernels. The independent `psrs-stdlib` revision is +`4ab3ef60b0d21dfca210e93881d596dd1cae339a`. It owns ordinary PureScript +`PSRS.Array` implementations and explicit target provenance. Official +`Control.Apply`, `Control.Bind` and `Control.Extend` only add an import and +replace their foreign slots with target aliases; their public signatures and +other pure code remain. The compiler adds initialized `arrayFill` and unsafe in-place `arrayWrite`. Core validates element identities, CC carries checked representations and values, @@ -23,15 +25,19 @@ rollback remain required; unused incorrect primitive signatures still fail. Validation: -- Mandatory Wasmtime driver primitive/library regressions: 16 passed. They - include first-class/partial bindings, array aliases and unused writes, +- Mandatory Wasmtime driver primitive/library regressions: 17 passed, including + the new `arrayExtend` oracle and the earlier apply, bind and primitive checks. + They include first-class/partial bindings, array aliases and unused writes, initialized references/records/closures, invalid lengths/indices and element relationships, captures, returned functions, empty arrays and product overflow. -- Official JS observations: 8 apply cases/29 checks and 9 bind cases/37 checks, - both exit 42 with empty output. Bind includes callback count and immediate - snapshots of a shared mutable array. The 46-case scalar oracle also passed. - The independent library owns the generators, observations and runtime reports - in `docs/evidence/source-array-kernels-2026-10-06/`. +- Official JS observations: 8 apply cases/29 checks, 9 bind cases/37 checks and + 9 extend cases/41 checks, all exit 42 with empty output. Bind includes callback + count and immediate snapshots of a shared mutable array; extend includes suffix + content and order, callback count and order, empty input, returned closures and + that mutating a received suffix does not alias the source array. The 46-case + scalar oracle also passed. The independent library owns the generators, + observations and runtime reports in + `docs/evidence/source-array-kernels-2026-10-06/`. - Malformed MIR filled-array test: passed; wrong initializer or noninteger length is rejected, and a valid initialized allocation is accepted. - Transactional primitive linking tests: 3 passed. @@ -40,17 +46,19 @@ Validation: - Locked trusted-library loader regression: passed; Prelude remains first. - Let-constraint regressions: 14 passed. - Library-owned Node tooling regressions: 8 passed. -- CLI rebuild, formatting, and workspace clippy with warnings denied passed. -- Complete pinned audit: 41 packages, 216 modules, 193 exact, 13 modified and +- CLI rebuild, formatting, and workspace clippy with warnings denied passed in the + previous checkpoint; the extend change adds library source, a fixture and a + focused regression only. +- Complete pinned audit: 41 packages, 216 modules, 192 exact, 14 modified and 10 explicitly recorded target additions; no absent official module and no detected exact direct same-argument recursion. The audit is comparison evidence, not blanket approval of every adaptation. The unchanged full reproducer still fails. Unsupported-library P8 reports fell -from 232 to 231 and the first is `Control.Extend.arrayExtend`. The snapshot -`diagnose.json` records the 38.937-second development run and complete diagnostics. -Package content changed from `fnv1a64-v1:aca9437f2fcdd5a8` to -`fnv1a64-v1:9c725bfe5140502e`, so these are explicit migration measurements, +from 231 to 230 and the first is now `Control.Monad.ST.Internal.map_`. The +snapshot `diagnose.json` records the development run and complete diagnostics. +Package content changed from `fnv1a64-v1:9c725bfe5140502e` to +`fnv1a64-v1:e4195415d1de337c`, so these are explicit migration measurements, not an unchanged-cohort `diagnose --compare` result or a suite scoreboard update. Remaining work includes full stdlib compile/runtime/FFI acceptance, unsupported diff --git a/stdlib.lock.json b/stdlib.lock.json index 2d287ae4..72dc1e34 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "23ba4b9de6ba310a8c77e4c6a1e5cd56d68c528e", - "source_fingerprint": "fnv1a64-v1:9c725bfe5140502e" + "revision": "4ab3ef60b0d21dfca210e93881d596dd1cae339a", + "source_fingerprint": "fnv1a64-v1:e4195415d1de337c" } From acfd784bb0a43d20334496b597ba451d96545c5b Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 19:36:11 +0800 Subject: [PATCH 043/148] Consume library ST computations and update the stdlib lock The stdlib package revision 567c00d implements Control.Monad.ST over a Prelude-free target module with checked storage primitives. The compiler lock now records that revision and its fnv1a64 content fingerprint. Add the pinned official-observation fixture and a focused Wasmtime regression that keeps the vendored Control.Monad.ST signatures aligned. The full reproducer still fails: unsupported-library P8 diagnostics fall from 230 to 199 and the first is Data.Array.fromFoldableImpl. --- .../src/tests/primitive_foreign.rs | 44 ++++++++++++++ .../tests/fixtures/stdlib-st/Main.purs | 35 ++++++++++++ .../DEC-11-primitive-ffi-stdlib-wrappers.md | 10 ++++ .../backend/wasm/primitive-ffi-and-stdlib.md | 12 ++++ .../stdlib/st-2026-10-06/report.md | 57 +++++++++++++++++++ stdlib.lock.json | 4 +- 6 files changed, 160 insertions(+), 2 deletions(-) create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-st/Main.purs create mode 100644 docs/implementation/stdlib/st-2026-10-06/report.md diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index 0487f9ca..03febd4b 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -351,6 +351,50 @@ fn library_array_bind_matches_pinned_official_observations() { assert_eq!(output.status.code(), Some(42), "{output:?}"); } +#[test] +fn library_st_matches_pinned_official_observations() { + let modules = crate::prelude::sources().unwrap(); + let internal = modules + .iter() + .find(|module| module.module_name == "Control.Monad.ST.Internal") + .unwrap(); + for signature in [ + "run :: forall a. (forall r. ST r a) -> a", + "while :: forall r a. ST r Boolean -> ST r a -> ST r Unit", + "for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit", + "foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit", + "new :: forall a r. a -> ST r (STRef r a)", + "read :: forall a r. STRef r a -> ST r a", + "modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b", + "write :: forall a r. a -> STRef r a -> ST r a", + ] { + assert!( + internal.text.lines().any(|line| line == signature), + "missing official ST signature: {signature}" + ); + } + let uncurried = modules + .iter() + .find(|module| module.module_name == "Control.Monad.ST.Uncurried") + .unwrap(); + for signature in [ + "mkSTFn1 :: forall a t r.", + "runSTFn1 :: forall a t r.", + "mkSTFn10 :: forall a b c d e f g h i j t r.", + "runSTFn10 :: forall a b c d e f g h i j t r.", + ] { + assert!( + uncurried.text.lines().any(|line| line == signature), + "missing official STFn signature: {signature}" + ); + } + let source = include_str!("../../tests/fixtures/stdlib-st/Main.purs"); + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + #[test] fn library_array_extend_matches_pinned_official_observations() { let golden = include_str!("../../tests/fixtures/stdlib-array-extend/Golden.purs"); diff --git a/crates/psrs-driver/tests/fixtures/stdlib-st/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-st/Main.purs new file mode 100644 index 00000000..0ee6c4cd --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-st/Main.purs @@ -0,0 +1,35 @@ +module Main where +import PSRS.ST as S + +c0 :: forall r. S.Action r Int +c0 = S.bindAction (S.mapAction (\x -> intAdd 1 x) (S.pureAction 40)) (\x -> S.pureAction (intAdd x 1)) + +c1 :: forall r. S.Action r Int +c1 = S.bindAction (S.newCell 40) \ref -> S.bindAction (S.modifyCell (\x -> { state: intAdd x 1, value: intAdd x 2 }) ref) \_ -> S.readCell ref + +c2 :: forall r. S.Action r Int +c2 = S.bindAction (S.newCell 0) \ref -> S.bindAction (S.writeCell 7 ref) \w -> S.bindAction (S.readCell ref) \r -> S.pureAction (intAdd w r) + +c3 :: forall r. S.Action r Int +c3 = S.bindAction (S.newCell 1) \a -> S.bindAction (S.newCell 2) \b -> S.bindAction (S.writeCell 10 a) \_ -> S.bindAction (S.writeCell 20 b) \_ -> S.bindAction (S.readCell a) \x -> S.bindAction (S.readCell b) \y -> S.pureAction (intAdd x y) + +c4 :: forall r. S.Action r Int +c4 = S.bindAction (S.newCell 0) \count -> S.bindAction (S.whileAction (S.mapAction (\c -> intLt c 3) (S.readCell count)) (S.bindAction (S.readCell count) \c -> S.writeCell (intAdd c 1) count)) \_ -> S.readCell count + +c5 :: forall r. S.Action r Int +c5 = S.bindAction (S.newCell 0) \total -> S.bindAction (S.forAction 0 5 (\i -> S.bindAction (S.readCell total) \t -> S.writeCell (intAdd t i) total)) \_ -> S.readCell total + +c6 :: forall r. S.Action r Int +c6 = S.bindAction (S.newCell 0) \total -> S.bindAction (S.foreachAction [1, 2, 3] (\i -> S.bindAction (S.readCell total) \t -> S.bindAction (S.writeCell (intAdd t i) total) \_ -> S.pureAction unit)) \_ -> S.readCell total + +c7 :: forall r. S.Action r Int +c7 = S.bindAction (S.newCell 5) \total -> S.bindAction (S.foreachAction [] (\_ -> S.bindAction (S.pureAction unit) (\_ -> S.bindAction (S.pureAction (arrayIndex ([] :: Array Int) 0)) \_ -> S.pureAction unit))) \_ -> S.readCell total + +c8 :: forall r. S.Action r Int +c8 = S.bindAction (S.newCell 5) \total -> S.bindAction (S.forAction 5 5 (\_ -> S.bindAction (S.pureAction unit) (\_ -> S.bindAction (S.pureAction (arrayIndex ([] :: Array Int) 0)) \_ -> S.pureAction unit))) \_ -> S.readCell total + +c9 :: forall r. S.Action r Int +c9 = S.bindAction (S.newCell 5) \total -> S.bindAction (S.whileAction (S.pureAction false) (S.bindAction (S.pureAction unit) (\_ -> S.bindAction (S.pureAction (arrayIndex ([] :: Array Int) 0)) \_ -> S.pureAction unit))) \_ -> S.readCell total + +main = + if (booleanAnd (booleanAnd (booleanAnd (intEq (S.runAction c0) 42) (intEq (S.runAction c1) 41)) (booleanAnd (intEq (S.runAction c2) 14) (booleanAnd (intEq (S.runAction c3) 30) (intEq (S.runAction c4) 3)))) (booleanAnd (booleanAnd (intEq (S.runAction c5) 10) (intEq (S.runAction c6) 6)) (booleanAnd (intEq (S.runAction c7) 5) (booleanAnd (intEq (S.runAction c8) 5) (intEq (S.runAction c9) 5))))) then 42 else 1 diff --git a/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md b/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md index df2efe06..143aeb76 100644 --- a/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md +++ b/docs/decision/DEC-11-primitive-ffi-stdlib-wrappers.md @@ -124,3 +124,13 @@ must retain aliasing instead of copying arrays through a polymorphic wrapper. This amendment does not authorize rewriting valid official pure definitions, introducing per-function naming heuristics, or treating unimplemented FFI as an empty result. Source diffs and official behavior evidence remain required. + +The same boundary covers mutable references. `Control.Monad.ST` keeps its +official `ST`/`STRef` newtypes and class instances in the library module, because +a class instance whose type is imported from another module is an orphan that +this compiler does not resolve. A Prelude-free target module owns the suspended +action, the fresh cell over the private storage primitives, and the loops; the +official module's operations are thin adapters. A representation that differs +from the compiler's scalar-token `Effect` closure makes `unsafeCoerce`-based +conversions such as `Control.Monad.ST.Global.toEffect` linked but unsound, and +that limit must be recorded rather than hidden. diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index abb2fe6f..78915e0e 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -658,3 +658,15 @@ Wasm/WASI adaptation belongs in source library code whenever these operations and ordinary language features can express it. See the independent package's `docs/array-kernels.md` and official JS generators for behavior evidence. Focused observations do not establish whole-library compile or runtime/FFI acceptance. + +`Control.Monad.ST` follows the same boundary without a new intrinsic. The target +module `PSRS.ST` represents an action as a suspended `Unit -> a` thunk and a +reference as a fresh one-element mutable array over the private storage +primitives. `Control.Monad.ST.Internal` keeps the official `ST`/`STRef` newtypes +and every class instance, because this compiler does not resolve an instance +whose type is imported from another module; each operation is a thin adapter over +the target module. `STFn{N}` stays abstract as a newtype over the curried action +so rank-2 `STFn` arguments typecheck. The target's `ST` thunk and the compiler's +scalar-token `Effect` closure are not representationally equal, so +`Control.Monad.ST.Global.toEffect`'s `unsafeCoerce` is linked but not sound. See +the independent package's `docs/st.md`. diff --git a/docs/implementation/stdlib/st-2026-10-06/report.md b/docs/implementation/stdlib/st-2026-10-06/report.md new file mode 100644 index 00000000..77cc62c7 --- /dev/null +++ b/docs/implementation/stdlib/st-2026-10-06/report.md @@ -0,0 +1,57 @@ +# ST computations and references checkpoint + +The compiler gains no `ST` intrinsic. `Control.Monad.ST.Internal` and +`Control.Monad.ST.Uncurried` keep their official signatures, exports, classes, +instances and other pure code; their foreign implementation slots delegate to +the ordinary PureScript target module `PSRS.ST`. The independent `psrs-stdlib` +revision is `d3a33494c85f2b5d61a9c73d20509049b9e62746` with content fingerprint +`fnv1a64-v1:5b51b652c77ed0b7`. + +`PSRS.ST` represents an `ST` action as `Action r a`, a suspended `Unit -> a` +thunk, and an `ST` reference as `Cell r a`, a fresh one-element mutable array +over the existing private `arrayFill`, `arrayWrite` and `arrayIndex` primitives. +`Control.Monad.ST.Internal` declares `ST`/`STRef` as newtypes over those and +keeps every class instance; the instances cannot move to `PSRS.ST` because this +compiler does not resolve an instance whose type comes from another module +(orphan). Each operation is therefore a thin adapter, and the exercised +algorithm lives in the Prelude-free target module. `STFn{N}` stays abstract as a +newtype over the curried action so `Data.Array.ST`'s rank-2 uses typecheck. + +Validation: + +- Mandatory Wasmtime driver regressions: 18 passed, including the new + `library_st_matches_pinned_official_observations` and the earlier apply, bind, + extend and primitive checks. +- Official JS observations: the pinned `Control/Monad/ST/Internal.js` generates + ten ST cases with ten observable checks covering `pure`/`map`/`bind`, fresh + distinct cells, read, write, modify, `while`, `for`, `foreach`, and empty + inputs that must not invoke their callbacks. The mandatory runner executes the + Prelude-free target fixture under Wasmtime with exit 42 and empty output. + Observations and the runtime report are retained under + `docs/evidence/st-2026-10-06/`. +- Library-owned Node tooling regressions: 8 passed. +- Complete pinned audit: 41 packages, 217 modules, 190 exact, 16 modified and + 11 explicitly recorded target additions; no absent official module and no + detected exact direct same-argument recursion. The audit is comparison + evidence, not blanket approval of every adaptation. +- Formatting and strict workspace clippy with warnings denied passed. + +The full reproducer still fails. Unsupported-library P8 reports fell from 230 to +199 and the first is now `Data.Array.fromFoldableImpl`; no +`Control.Monad.ST.Internal` or `Control.Monad.ST.Uncurried` foreign value +remains. The snapshot `diagnose.json` records the development run and complete +diagnostics. Package content changed from `fnv1a64-v1:e4195415d1de337c` to +`fnv1a64-v1:5b51b652c77ed0b7`, so these are explicit migration measurements, not +an unchanged-cohort `diagnose --compare` result or a suite scoreboard update. + +Two limits are recorded rather than hidden. First, the target's `ST r a` is a +thunk over `Unit` while the compiler's `Effect a` is a closure over a scalar +state token, so `Control.Monad.ST.Global.toEffect`'s `unsafeCoerce` is linked +but not sound on this target and is not exercised. Second, physical array +copying across general polymorphic function boundaries remains a compiler +obligation; the cell newtypes are parameterized so the exercised paths preserve +identity, which does not prove a broader alias guarantee. Runtime execution of +the official wrapper modules is not separately observable until the rest of the +Prelude closure links; the tested target module has no Prelude dependency. No +full workspace tests or full scoreboard were run. No push, PR or issue operation +was performed. diff --git a/stdlib.lock.json b/stdlib.lock.json index 72dc1e34..83d03d5b 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "4ab3ef60b0d21dfca210e93881d596dd1cae339a", - "source_fingerprint": "fnv1a64-v1:e4195415d1de337c" + "revision": "d3a33494c85f2b5d61a9c73d20509049b9e62746", + "source_fingerprint": "fnv1a64-v1:5b51b652c77ed0b7" } From 88a5b2e38ccc85202488892571b7054fa893c1cd Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 19:40:43 +0800 Subject: [PATCH 044/148] Track the evidence-free stdlib revision and stop tracking diagnosis snapshots The stdlib history no longer contains docs/evidence, so the lock records the rewritten revision (same content fingerprint). Raw diagnose.json snapshots are local and regenerable and are no longer tracked. --- .gitignore | 14 ++++++++++++++ .../source-array-kernels-2026-10-06/report.md | 8 ++++---- docs/implementation/stdlib/st-2026-10-06/report.md | 6 +++--- stdlib.lock.json | 2 +- 4 files changed, 22 insertions(+), 8 deletions(-) diff --git a/.gitignore b/.gitignore index 720459a2..7653088b 100644 --- a/.gitignore +++ b/.gitignore @@ -4,5 +4,19 @@ node_modules/ dist/ +# Raw diagnosis snapshots are local, machine-specific and regenerable. +diagnose.json + +# Generated stdlib diagnosis, oracle and runtime reports stay local. +/docs/implementation/stdlib/**/diagnosis.json +/docs/implementation/stdlib/**/next-blocker.json +/docs/implementation/stdlib/**/run.json +/docs/implementation/stdlib/**/validation.json +/docs/implementation/stdlib/**/observations.json +/docs/implementation/stdlib/**/*-run.json +/docs/implementation/stdlib/**/diagnosis-checkpoints.json +/docs/implementation/stdlib/**/import-summary.json +/docs/implementation/stdlib/**/summary.json + __pycache__/ *.egg-info/ diff --git a/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md b/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md index 511bbcd2..ba273041 100644 --- a/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md +++ b/docs/implementation/stdlib/source-array-kernels-2026-10-06/report.md @@ -2,7 +2,7 @@ The compiler no longer owns whole-function array application, binding or extension kernels. The independent `psrs-stdlib` revision is -`4ab3ef60b0d21dfca210e93881d596dd1cae339a`. It owns ordinary PureScript +`e8b21f78b31d4317f330c9886571d94ebe96e24d`. It owns ordinary PureScript `PSRS.Array` implementations and explicit target provenance. Official `Control.Apply`, `Control.Bind` and `Control.Extend` only add an import and replace their foreign slots with target aliases; their public signatures and @@ -35,9 +35,9 @@ Validation: count and immediate snapshots of a shared mutable array; extend includes suffix content and order, callback count and order, empty input, returned closures and that mutating a received suffix does not alias the source array. The 46-case - scalar oracle also passed. The independent library owns the generators, - observations and runtime reports in - `docs/evidence/source-array-kernels-2026-10-06/`. + scalar oracle also passed. The independent library owns the generators and + writes the observations and runtime reports to a local, git-ignored + directory. - Malformed MIR filled-array test: passed; wrong initializer or noninteger length is rejected, and a valid initialized allocation is accepted. - Transactional primitive linking tests: 3 passed. diff --git a/docs/implementation/stdlib/st-2026-10-06/report.md b/docs/implementation/stdlib/st-2026-10-06/report.md index 77cc62c7..9c131ee0 100644 --- a/docs/implementation/stdlib/st-2026-10-06/report.md +++ b/docs/implementation/stdlib/st-2026-10-06/report.md @@ -4,7 +4,7 @@ The compiler gains no `ST` intrinsic. `Control.Monad.ST.Internal` and `Control.Monad.ST.Uncurried` keep their official signatures, exports, classes, instances and other pure code; their foreign implementation slots delegate to the ordinary PureScript target module `PSRS.ST`. The independent `psrs-stdlib` -revision is `d3a33494c85f2b5d61a9c73d20509049b9e62746` with content fingerprint +revision is `567c00dd9d4c7dc53814f12aaf2aaf6e5b4f34d9` with content fingerprint `fnv1a64-v1:5b51b652c77ed0b7`. `PSRS.ST` represents an `ST` action as `Action r a`, a suspended `Unit -> a` @@ -27,8 +27,8 @@ Validation: distinct cells, read, write, modify, `while`, `for`, `foreach`, and empty inputs that must not invoke their callbacks. The mandatory runner executes the Prelude-free target fixture under Wasmtime with exit 42 and empty output. - Observations and the runtime report are retained under - `docs/evidence/st-2026-10-06/`. + Observations and the runtime report are written to a local, git-ignored + directory. - Library-owned Node tooling regressions: 8 passed. - Complete pinned audit: 41 packages, 217 modules, 190 exact, 16 modified and 11 explicitly recorded target additions; no absent official module and no diff --git a/stdlib.lock.json b/stdlib.lock.json index 83d03d5b..bc818818 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "d3a33494c85f2b5d61a9c73d20509049b9e62746", + "revision": "fd1fb9adce2650b3bc01b8cbd91d145dfc841d28", "source_fingerprint": "fnv1a64-v1:5b51b652c77ed0b7" } From 0b9636cd0c87a145853a45b0fe3e98503358684d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 19:50:03 +0800 Subject: [PATCH 045/148] Consume library uncurried functions and update the stdlib lock The stdlib package revision b405ddd implements Data.Function.Uncurried over abstract curried newtypes. The compiler lock now records that revision and its fnv1a64 content fingerprint. Add the pinned official-observation fixture and a focused Wasmtime regression that keeps the vendored signatures aligned. The full reproducer still fails: unsupported-library P8 diagnostics fall from 199 to 179 and the first remains Data.Array.fromFoldableImpl. --- .../src/tests/primitive_foreign.rs | 25 ++++++++++++ .../tests/fixtures/stdlib-uncurried/Main.purs | 40 +++++++++++++++++++ .../backend/wasm/primitive-ffi-and-stdlib.md | 7 ++++ .../stdlib/uncurried-2026-10-06/report.md | 34 ++++++++++++++++ stdlib.lock.json | 4 +- 5 files changed, 108 insertions(+), 2 deletions(-) create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-uncurried/Main.purs create mode 100644 docs/implementation/stdlib/uncurried-2026-10-06/report.md diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index 03febd4b..39c77c5a 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -395,6 +395,31 @@ fn library_st_matches_pinned_official_observations() { assert_eq!(output.status.code(), Some(42), "{output:?}"); } +#[test] +fn library_uncurried_matches_pinned_official_observations() { + let modules = crate::prelude::sources().unwrap(); + let uncurried = modules + .iter() + .find(|module| module.module_name == "Data.Function.Uncurried") + .unwrap(); + for signature in [ + "mkFn0 :: forall a. (Unit -> a) -> Fn0 a", + "mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c", + "runFn0 :: forall a. Fn0 a -> a", + "runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k", + ] { + assert!( + uncurried.text.lines().any(|line| line == signature), + "missing official signature: {signature}" + ); + } + let source = include_str!("../../tests/fixtures/stdlib-uncurried/Main.purs"); + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + #[test] fn library_array_extend_matches_pinned_official_observations() { let golden = include_str!("../../tests/fixtures/stdlib-array-extend/Golden.purs"); diff --git a/crates/psrs-driver/tests/fixtures/stdlib-uncurried/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-uncurried/Main.purs new file mode 100644 index 00000000..0994d550 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-uncurried/Main.purs @@ -0,0 +1,40 @@ +module Main where +import Data.Function.Uncurried as S + +c0 :: Int +c0 = S.runFn0 (S.mkFn0 (\_ -> 42)) + +c1 :: Int +c1 = S.runFn2 (S.mkFn2 (\a1 a2 -> intAdd (a1) a2)) 1 2 + +c2 :: Int +c2 = S.runFn3 (S.mkFn3 (\a1 a2 a3 -> intAdd (intAdd (a1) a2) a3)) 1 2 3 + +c3 :: Int +c3 = S.runFn4 (S.mkFn4 (\a1 a2 a3 a4 -> intAdd (intAdd (intAdd (a1) a2) a3) a4)) 1 2 3 4 + +c4 :: Int +c4 = S.runFn5 (S.mkFn5 (\a1 a2 a3 a4 a5 -> intAdd (intAdd (intAdd (intAdd (a1) a2) a3) a4) a5)) 1 2 3 4 5 + +c5 :: Int +c5 = S.runFn6 (S.mkFn6 (\a1 a2 a3 a4 a5 a6 -> intAdd (intAdd (intAdd (intAdd (intAdd (a1) a2) a3) a4) a5) a6)) 1 2 3 4 5 6 + +c6 :: Int +c6 = S.runFn7 (S.mkFn7 (\a1 a2 a3 a4 a5 a6 a7 -> intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (a1) a2) a3) a4) a5) a6) a7)) 1 2 3 4 5 6 7 + +c7 :: Int +c7 = S.runFn8 (S.mkFn8 (\a1 a2 a3 a4 a5 a6 a7 a8 -> intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (a1) a2) a3) a4) a5) a6) a7) a8)) 1 2 3 4 5 6 7 8 + +c8 :: Int +c8 = S.runFn9 (S.mkFn9 (\a1 a2 a3 a4 a5 a6 a7 a8 a9 -> intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (a1) a2) a3) a4) a5) a6) a7) a8) a9)) 1 2 3 4 5 6 7 8 9 + +c9 :: Int +c9 = S.runFn10 (S.mkFn10 (\a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 -> intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (intAdd (a1) a2) a3) a4) a5) a6) a7) a8) a9) a10)) 1 2 3 4 5 6 7 8 9 10 + +apply2 :: forall a b c. S.Fn2 a b c -> a -> b -> c +apply2 f a b = S.runFn2 f a b +c10 :: Int +c10 = apply2 (S.mkFn2 (\a b -> intAdd a b)) 40 2 + +main = + if (booleanAnd (booleanAnd (booleanAnd (intEq c0 42) (intEq c1 3)) (booleanAnd (intEq c2 6) (booleanAnd (intEq c3 10) (intEq c4 15)))) (booleanAnd (booleanAnd (intEq c5 21) (booleanAnd (intEq c6 28) (intEq c7 36))) (booleanAnd (intEq c8 45) (booleanAnd (intEq c9 55) (intEq c10 42))))) then 42 else 1 diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index 78915e0e..5f5243cc 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -670,3 +670,10 @@ so rank-2 `STFn` arguments typecheck. The target's `ST` thunk and the compiler's scalar-token `Effect` closure are not representationally equal, so `Control.Monad.ST.Global.toEffect`'s `unsafeCoerce` is linked but not sound. See the independent package's `docs/st.md`. + +Uncurried functions follow the same representation rule. `Data.Function.Uncurried` +keeps `Fn1` as a synonym and represents `Fn0` and `Fn2`..`Fn10` as abstract +newtypes over the curried function, so `mkFn{N}`/`runFn{N}` adapt currying and +rank-2 arguments stay abstract. This is a prerequisite for `Data.Array`, whose +foreign signatures use `Fn2` and `Fn3`. See the independent package's +`docs/function-uncurried.md`. diff --git a/docs/implementation/stdlib/uncurried-2026-10-06/report.md b/docs/implementation/stdlib/uncurried-2026-10-06/report.md new file mode 100644 index 00000000..4542edbd --- /dev/null +++ b/docs/implementation/stdlib/uncurried-2026-10-06/report.md @@ -0,0 +1,34 @@ +# Uncurried functions checkpoint + +The compiler gains no `Fn` intrinsic. `Data.Function.Uncurried` keeps its +official signatures and exports; `Fn1` stays the synonym `a -> b`, and `Fn0` and +`Fn2` through `Fn10` become abstract newtypes over the corresponding curried +function. `mkFn{N}` and `runFn{N}` adapt currying only, and keeping each type +abstract preserves rank-2 arguments. This unblocks `Data.Array`, whose foreign +signatures use `Fn2` and `Fn3`. The independent `psrs-stdlib` revision is +`b405dddf67a902387dda316cdf331f2cc82db5ce` with content fingerprint +`fnv1a64-v1:03a4b91b0b29e0ec`. + +Validation: + +- Mandatory Wasmtime driver regressions passed, including the new + `library_uncurried_matches_pinned_official_observations` and the earlier apply, + bind, extend, ST and primitive checks. +- Official JS observations: the pinned `Data/Function/Uncurried.js` generates + eleven cases with eleven observable checks covering the + `runFn{N} (mkFn{N} f)` round trip for `N = 0` and `N = 2..10` plus a + first-class `Fn2` passed through an ordinary function. The mandatory runner + executes the Prelude-free fixture under Wasmtime with exit 42 and empty output. +- Library-owned Node tooling regressions: 8 passed. +- Complete pinned audit: 41 packages, 217 modules, 189 exact, 17 modified and + 11 explicitly recorded target additions; no absent official module and no + detected exact direct same-argument recursion. +- Formatting and strict workspace clippy with warnings denied passed. + +The full reproducer still fails. Unsupported-library P8 reports fell from 199 to +179 and the first is still `Data.Array.fromFoldableImpl`; no +`Data.Function.Uncurried` foreign value remains. Package content changed from +`fnv1a64-v1:5b51b652c77ed0b7` to `fnv1a64-v1:03a4b91b0b29e0ec`. Remaining work in +this chain includes the `Data.Array` algorithms, `Data.Array.NonEmpty.Internal`, +and the mutable `Data.Array.ST` group. No full workspace tests or full scoreboard +were run. No push, PR or issue operation was performed. diff --git a/stdlib.lock.json b/stdlib.lock.json index bc818818..3fb62be8 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "fd1fb9adce2650b3bc01b8cbd91d145dfc841d28", - "source_fingerprint": "fnv1a64-v1:5b51b652c77ed0b7" + "revision": "b405dddf67a902387dda316cdf331f2cc82db5ce", + "source_fingerprint": "fnv1a64-v1:03a4b91b0b29e0ec" } From fdb9f8e7c8f4562867478efda38a441a7b2ca76d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Tue, 6 Oct 2026 20:52:18 +0800 Subject: [PATCH 046/148] Consume library array operations and update the stdlib lock The stdlib package revision 332c69b implements Data.Array and Data.Array.NonEmpty.Internal over the Prelude-free PSRS.Array target module. The compiler lock now records that revision and its fnv1a64 content fingerprint. Add the pinned official-observation fixture and a focused Wasmtime regression that keeps the vendored signatures aligned. The full reproducer still fails: unsupported-library P8 diagnostics fall from 179 to 152 and the first is Data.Array.ST.unsafeFreezeImpl. --- .../src/tests/primitive_foreign.rs | 38 ++++++++++ .../tests/fixtures/stdlib-array-ops/Main.purs | 70 +++++++++++++++++++ .../backend/wasm/primitive-ffi-and-stdlib.md | 12 ++++ .../array-operations-2026-10-06/report.md | 54 ++++++++++++++ stdlib.lock.json | 4 +- 5 files changed, 176 insertions(+), 2 deletions(-) create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-ops/Main.purs create mode 100644 docs/implementation/stdlib/array-operations-2026-10-06/report.md diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index 39c77c5a..7e041989 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -420,6 +420,44 @@ fn library_uncurried_matches_pinned_official_observations() { assert_eq!(output.status.code(), Some(42), "{output:?}"); } +#[test] +fn library_array_operations_match_pinned_official_observations() { + let modules = crate::prelude::sources().unwrap(); + let array = modules + .iter() + .find(|module| module.module_name == "Data.Array") + .unwrap(); + for signature in [ + "length :: forall a. Array a -> Int", + "reverse :: forall a. Array a -> Array a", + "concat :: forall a. Array (Array a) -> Array a", + "sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a)", + ] { + assert!( + array.text.lines().any(|line| line == signature), + "missing official signature: {signature}" + ); + } + let non_empty = modules + .iter() + .find(|module| module.module_name == "Data.Array.NonEmpty.Internal") + .unwrap(); + for signature in [ + "foldr1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + "foldl1Impl :: forall a. Fn2 (a -> a -> a) (NonEmptyArray a) a", + ] { + assert!( + non_empty.text.lines().any(|line| line == signature), + "missing official signature: {signature}" + ); + } + let source = include_str!("../../tests/fixtures/stdlib-array-ops/Main.purs"); + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + #[test] fn library_array_extend_matches_pinned_official_observations() { let golden = include_str!("../../tests/fixtures/stdlib-array-extend/Golden.purs"); diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-ops/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-array-ops/Main.purs new file mode 100644 index 00000000..4db55ffc --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-ops/Main.purs @@ -0,0 +1,70 @@ +module Main where +import PSRS.Array as A + +arrayFoldr :: forall a b. (a -> b -> b) -> b -> Array a -> b +arrayFoldr f b xs = go 0 + where + go i = if intLt i (A.lengthImpl xs) then f (A.unsafeIndexImpl xs i) (go (intAdd i 1)) else b + +c0 = A.rangeImpl 2 5 + +c1 = A.rangeImpl 5 2 + +c2 = A.rangeImpl 3 3 + +c3 = A.replicateImpl 3 7 + +c4 = A.replicateImpl 0 7 + +c5 = A.fromFoldableImpl arrayFoldr [1, 2, 3] + +c6 = A.lengthImpl [1, 2, 3] + +c7 = A.unconsImpl (\_ -> 0) (\x xs -> intAdd x (A.lengthImpl xs)) [1, 2, 3] + +c8 = A.unconsImpl (\_ -> 42) (\_ _ -> 0) ([] :: Array Int) + +c9 = A.reverseImpl [1, 2, 3] + +c10 = A.reverseImpl ([] :: Array Int) + +c11 = A.concatImpl [[1, 2], [], [3]] + +c12 = A.concatImpl ([] :: Array (Array Int)) + +c13 = A.filterImpl (\x -> intLt 1 x) [0, 2, 1, 3] + +c14 = A.filterImpl (\x -> intLt 9 x) [0, 2, 1, 3] + +c15 = A.partitionImpl (\x -> intLt 1 x) [0, 2, 1, 3] + +c16 = A.scanlImpl (\acc x -> intAdd acc x) 0 [1, 2, 3] + +c17 = A.scanlImpl (\acc x -> intAdd acc x) 0 ([] :: Array Int) + +c18 = A.scanrImpl (\x acc -> intAdd x acc) 0 [1, 2, 3] + +c19 = A.sortByImpl (\x y -> intSub x y) (\c -> c) [3, 1, 2] + +c20 = A.sortByImpl (\x y -> intSub x.key y.key) (\c -> c) [{ key: 1, id: 0 }, { key: 1, id: 1 }, { key: 0, id: 2 }] + +c21 = A.sliceImpl 1 3 [0, 1, 2, 3] + +c22 = A.sliceImpl (intSub 0 2) 4 [0, 1, 2, 3] + +c23 = A.sliceImpl 3 1 [0, 1, 2, 3] + +c24 = A.zipWithImpl (\x y -> intAdd x y) [1, 2, 3] [10, 20] + +c25 = A.anyImpl (\x -> intLt 2 x) [0, 1, 2, 3] + +c26 = A.anyImpl (\x -> intLt 2 x) [0, 1] + +c27 = A.allImpl (\x -> intLt 0 x) [1, 2] + +c28 = A.allImpl (\x -> intLt 0 x) [1, 0] + +c29 = A.unsafeIndexImpl [1, 2, 3] 1 + +main = + if (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength c0) 4) (intEq (arrayIndex c0 0) 2)) (booleanAnd (intEq (arrayIndex c0 1) 3) (intEq (arrayIndex c0 2) 4))) (booleanAnd (booleanAnd (intEq (arrayIndex c0 3) 5) (intEq (arrayLength c1) 4)) (booleanAnd (intEq (arrayIndex c1 0) 5) (booleanAnd (intEq (arrayIndex c1 1) 4) (intEq (arrayIndex c1 2) 3))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex c1 3) 2) (intEq (arrayLength c2) 1)) (booleanAnd (intEq (arrayIndex c2 0) 3) (booleanAnd (intEq (arrayLength c3) 3) (intEq (arrayIndex c3 0) 7)))) (booleanAnd (booleanAnd (intEq (arrayIndex c3 1) 7) (intEq (arrayIndex c3 2) 7)) (booleanAnd (intEq (arrayLength c4) 0) (booleanAnd (intEq (arrayLength c5) 3) (intEq (arrayIndex c5 0) 1)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex c5 1) 2) (intEq (arrayIndex c5 2) 3)) (booleanAnd (intEq c6 3) (booleanAnd (intEq c7 3) (intEq c8 42)))) (booleanAnd (booleanAnd (intEq (arrayLength c9) 3) (intEq (arrayIndex c9 0) 3)) (booleanAnd (intEq (arrayIndex c9 1) 2) (booleanAnd (intEq (arrayIndex c9 2) 1) (intEq (arrayLength c10) 0))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength c11) 3) (intEq (arrayIndex c11 0) 1)) (booleanAnd (intEq (arrayIndex c11 1) 2) (booleanAnd (intEq (arrayIndex c11 2) 3) (intEq (arrayLength c12) 0)))) (booleanAnd (booleanAnd (intEq (arrayLength c13) 2) (intEq (arrayIndex c13 0) 2)) (booleanAnd (intEq (arrayIndex c13 1) 3) (booleanAnd (intEq (arrayLength c14) 0) (intEq (arrayLength (c15).yes) 2))))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex (c15).yes 0) 2) (intEq (arrayIndex (c15).yes 1) 3)) (booleanAnd (intEq (arrayLength (c15).no) 2) (booleanAnd (intEq (arrayIndex (c15).no 0) 0) (intEq (arrayIndex (c15).no 1) 1)))) (booleanAnd (booleanAnd (intEq (arrayLength c16) 3) (intEq (arrayIndex c16 0) 1)) (booleanAnd (intEq (arrayIndex c16 1) 3) (booleanAnd (intEq (arrayIndex c16 2) 6) (intEq (arrayLength c17) 0))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength c18) 3) (intEq (arrayIndex c18 0) 6)) (booleanAnd (intEq (arrayIndex c18 1) 5) (booleanAnd (intEq (arrayIndex c18 2) 3) (intEq (arrayLength c19) 3)))) (booleanAnd (booleanAnd (intEq (arrayIndex c19 0) 1) (intEq (arrayIndex c19 1) 2)) (booleanAnd (intEq (arrayIndex c19 2) 3) (booleanAnd (intEq (arrayLength c20) 3) (intEq ((arrayIndex c20 0)).key 0)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq ((arrayIndex c20 0)).id 2) (intEq ((arrayIndex c20 1)).key 1)) (booleanAnd (intEq ((arrayIndex c20 1)).id 0) (booleanAnd (intEq ((arrayIndex c20 2)).key 1) (intEq ((arrayIndex c20 2)).id 1)))) (booleanAnd (booleanAnd (intEq (arrayLength c21) 2) (intEq (arrayIndex c21 0) 1)) (booleanAnd (intEq (arrayIndex c21 1) 2) (booleanAnd (intEq (arrayLength c22) 2) (intEq (arrayIndex c22 0) 2))))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex c22 1) 3) (intEq (arrayLength c23) 0)) (booleanAnd (intEq (arrayLength c24) 2) (booleanAnd (intEq (arrayIndex c24 0) 11) (intEq (arrayIndex c24 1) 22)))) (booleanAnd (booleanAnd (booleanEq c25 true) (booleanEq c26 false)) (booleanAnd (booleanEq c27 true) (booleanAnd (booleanEq c28 false) (intEq c29 2)))))))) then 42 else 1 diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index 5f5243cc..b4aed26c 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -677,3 +677,15 @@ newtypes over the curried function, so `mkFn{N}`/`runFn{N}` adapt currying and rank-2 arguments stay abstract. This is a prerequisite for `Data.Array`, whose foreign signatures use `Fn2` and `Fn3`. See the independent package's `docs/function-uncurried.md`. + +`Data.Array`'s algorithms follow the same boundary. The Prelude-free target +module `PSRS.Array` owns them over the private storage primitives; the official +module delegates each foreign slot. Slots whose private signature carries a +rank-2 `Maybe` constructor or observer are written monomorphically and the loop +is inlined, leaving the public API unchanged, and `Data.Array.NonEmpty.Internal`'s +`traverse1` is implemented in the `Traversable1` instance over the `Applicative` +dictionary. See the independent package's `docs/array-operations.md`. A compiler +obligation is recorded there: a recursive loop that writes to its output array +only in one `if` branch produced wrong results; loops must write in a single +tail call and select only the value in the branch. `unsafeIndex` out of range +traps rather than returning JavaScript `undefined`. diff --git a/docs/implementation/stdlib/array-operations-2026-10-06/report.md b/docs/implementation/stdlib/array-operations-2026-10-06/report.md new file mode 100644 index 00000000..286a0113 --- /dev/null +++ b/docs/implementation/stdlib/array-operations-2026-10-06/report.md @@ -0,0 +1,54 @@ +# Array operations checkpoint + +`Data.Array` and `Data.Array.NonEmpty.Internal` keep their official signatures, +exports and other pure code; their foreign implementation slots now delegate to +`PSRS.Array` or are implemented inline. `PSRS.Array` owns the target algorithms +over the private `arrayFill`, `arrayWrite`, `arrayIndex`, `arrayLength` and +integer primitives: range, replicate, `fromFoldable`, length, uncons, reverse, +concat, filter, partition, `scanl`/`scanr`, a stable merge sort, slice, +`zipWith`, `any`, `all` and `unsafeIndex`. The independent `psrs-stdlib` +revision is `332c69b16f240254f74375b7babed7f752f7361a` with content fingerprint +`fnv1a64-v1:3ab22be17dbadc5c`. + +Two kinds of foreign slot could not be delegated directly. `Data.Array`'s +`index`, `findMap`, `findIndex`, `findLastIndex`, `insertAt`, `deleteAt` and +`updateAt` take rank-2 `Maybe` constructors or observers; their private foreign +signatures are written monomorphically and the loops are implemented inline over +the target helpers, leaving the public API unchanged. `Data.Array.NonEmpty.Internal`'s +`foldr1`/`foldl1` are inline `Fn2` wrappers and `traverse1` is implemented +directly in the `Traversable1` instance using the `Applicative` dictionary, +because its `apply`/`map` arguments are rank-2. + +A compiler behavior is recorded rather than hidden: a recursive loop that writes +into its output array only in one branch of an `if` produced wrong results, while +the same loop written as a single tail call with the write in a `let` and only +the selected value chosen by the branch is correct. `PSRS.Array`'s loops use the +single-tail-call shape. The evaluation/alias behavior is a compiler obligation, +not a property of valid official source. `unsafeIndex` out of range traps +instead of returning JavaScript `undefined`, an explicit target difference. + +Validation: + +- Mandatory Wasmtime driver regressions passed, including the new + `library_array_operations_match_pinned_official_observations` and the earlier + apply, bind, extend, ST, uncurried and primitive checks. +- Official JS observations: the pinned `Data/Array.js` generates thirty cases + with seventy-nine observable checks covering every delegated algorithm, + boundary and empty inputs, negative and clamped slices, stable sorting and + out-of-range access. The mandatory runner executes the Prelude-free target + fixture under Wasmtime with exit 42 and empty output. +- Library-owned Node tooling regressions: 8 passed. +- Complete pinned audit: 41 packages, 217 modules, 189 exact, 19 modified and + 11 explicitly recorded target additions; three value foreign declarations are + recorded as removed because their functionality moved into an inlined caller + or instance. No absent official module and no detected exact direct + same-argument recursion. +- Formatting and strict workspace clippy with warnings denied passed. + +The full reproducer still fails. Unsupported-library P8 reports fell from 179 to +152 and the first is now `Data.Array.ST.unsafeFreezeImpl`; no `Data.Array` or +`Data.Array.NonEmpty.Internal` foreign value remains. Package content changed +from `fnv1a64-v1:03a4b91b0b29e0ec` to `fnv1a64-v1:3ab22be17dbadc5c`. Remaining +work in this chain is the mutable `Data.Array.ST` and `Data.Array.ST.Partial` +group. No full workspace tests or full scoreboard were run. No push, PR or issue +operation was performed. diff --git a/stdlib.lock.json b/stdlib.lock.json index 3fb62be8..1791df4f 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "b405dddf67a902387dda316cdf331f2cc82db5ce", - "source_fingerprint": "fnv1a64-v1:03a4b91b0b29e0ec" + "revision": "332c69b16f240254f74375b7babed7f752f7361a", + "source_fingerprint": "fnv1a64-v1:3ab22be17dbadc5c" } From f2d4b0c2f478fc8248c89e09608d678e52d98096 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 01:15:31 +0800 Subject: [PATCH 047/148] Land library reachability, local row instantiation and aggregate protocols This is the compiler side of the public Data.Array / mutable Data.Array.ST slice. Core linking keeps a static library import and its checked signature only when the executable graph reaches it, while explicit primitive and WIT declarations keep source-wide protocol validation. Unsafe.Coerce is a compiler-provided module whose unsafeCoerce lowers to a checked RepresentationCast. Superclass dictionary fields become Unit -> Dict thunks forced at selection, so mutually referring instances no longer recurse before a method runs. Checked row residuals are retained as instantiation evidence and a finite closed use of a nonrecursive row-polymorphic local lambda is materialized before CC layout; the reusable type substitution moves to psrs-core::instantiation. The array and record layout owners register canonical erased-slot protocols for the aggregate layouts a module contains. A checked report-only Partial scope adds a marked trap fallback. Contiguous qualified symbolic operators resolve, so Data.Array.(..) and A.: parse and lower. Partial application splits into global and indirect paths. Tests add declaration_calls, the shared array-callback fixture, and the unused-static-import reachability case. stdlib.lock.json points at the committed library revision 01d6cd4 with fingerprint b2890fecd9c42aa3. --- .../psrs-backend/src/bindings/primitives.rs | 31 +- .../src/{boundary.rs => boundary/mod.rs} | 33 ++ crates/psrs-backend/src/boundary/newtypes.rs | 120 ++++++ .../psrs-backend/src/cc/case/coverage/mod.rs | 12 +- .../psrs-backend/src/cc/layout/declaration.rs | 74 ++++ crates/psrs-backend/src/cc/layout/mod.rs | 4 + .../psrs-backend/src/cc/layout/protocols.rs | 59 +++ crates/psrs-backend/src/cc/layout/scalar.rs | 85 +--- .../psrs-backend/src/cc/lower/call/helpers.rs | 15 +- .../call/{partial.rs => partial/global.rs} | 403 ++++++------------ .../src/cc/lower/call/partial/indirect.rs | 222 ++++++++++ .../src/cc/lower/call/partial/mod.rs | 40 ++ .../src/cc/lower/conversion/mod.rs | 58 +-- .../src/cc/lower/conversion/scalars.rs | 159 +++++++ .../src/cc/lower/conversion/transport.rs | 66 ++- .../src/cc/lower/dictionary/tests.rs | 39 +- crates/psrs-backend/src/cc/mod.rs | 12 +- .../psrs-core/src/instantiation/local_rows.rs | 350 +++++++++++++++ .../mod.rs} | 39 +- .../types => instantiation}/substitution.rs | 40 +- crates/psrs-core/src/lib.rs | 2 +- crates/psrs-core/src/link/mod.rs | 18 + crates/psrs-core/src/locals/alpha.rs | 238 +++++++++++ .../src/{locals.rs => locals/mod.rs} | 3 + crates/psrs-core/src/lower/dictionary.rs | 50 ++- crates/psrs-core/src/opt/inline/alpha.rs | 239 +---------- .../psrs-core/src/opt/specialize/types/mod.rs | 4 +- crates/psrs-core/src/primitive.rs | 60 ++- crates/psrs-core/src/tests/dictionaries.rs | 13 +- crates/psrs-core/src/tests/instantiation.rs | 44 ++ crates/psrs-core/src/verify/scopes/expr.rs | 8 +- .../src/verify/types/matching/evidence.rs | 1 + .../src/verify/types/matching/mod.rs | 14 +- .../src/verify/types/matching/rows.rs | 7 +- .../src/tests/declaration_calls.rs | 200 +++++++++ .../src/tests/dictionary_audit/negative.rs | 5 +- .../psrs-driver/src/tests/library_foreign.rs | 15 + crates/psrs-driver/src/tests/mod.rs | 1 + .../src/tests/primitive_foreign.rs | 13 + .../fixtures/stdlib-array-callbacks/Main.purs | 53 +++ crates/psrs-hir/src/expr.rs | 3 + .../psrs-resolve/src/resolver/names/util.rs | 21 +- .../psrs-syntax/src/parser/expr/atom/mod.rs | 10 +- .../src/parser/expr/atom/postfix.rs | 6 +- crates/psrs-syntax/src/parser/expr/mod.rs | 21 + .../psrs-syntax/src/parser/expr/qualified.rs | 51 +++ crates/psrs-syntax/src/parser/tests.rs | 28 ++ crates/psrs-thir/src/evidence.rs | 1 + crates/psrs-thir/src/tests.rs | 14 +- crates/psrs-thir/src/verify/mod.rs | 10 +- .../src/typecheck/classes/evidence/typing.rs | 7 +- .../src/typecheck/classes/instance.rs | 23 +- .../src/typecheck/infer/case.rs | 39 ++ .../D-17-stdlib-and-conformance-boundaries.md | 8 + .../backend/fp/polymorphism-and-erasure.md | 26 +- .../backend/fp/representation-and-evidence.md | 25 +- .../fp/type-classes-and-dictionaries.md | 17 +- .../stdlib/array-public-2026-10-07/report.md | 75 ++++ docs/workflow/stdlib-conformance.md | 15 + stdlib.lock.json | 4 +- 60 files changed, 2523 insertions(+), 730 deletions(-) rename crates/psrs-backend/src/{boundary.rs => boundary/mod.rs} (87%) create mode 100644 crates/psrs-backend/src/boundary/newtypes.rs create mode 100644 crates/psrs-backend/src/cc/layout/declaration.rs create mode 100644 crates/psrs-backend/src/cc/layout/protocols.rs rename crates/psrs-backend/src/cc/lower/call/{partial.rs => partial/global.rs} (51%) create mode 100644 crates/psrs-backend/src/cc/lower/call/partial/indirect.rs create mode 100644 crates/psrs-backend/src/cc/lower/call/partial/mod.rs create mode 100644 crates/psrs-core/src/instantiation/local_rows.rs rename crates/psrs-core/src/{instantiation.rs => instantiation/mod.rs} (54%) rename crates/psrs-core/src/{opt/specialize/types => instantiation}/substitution.rs (92%) create mode 100644 crates/psrs-core/src/locals/alpha.rs rename crates/psrs-core/src/{locals.rs => locals/mod.rs} (98%) create mode 100644 crates/psrs-driver/src/tests/declaration_calls.rs create mode 100644 crates/psrs-driver/tests/fixtures/stdlib-array-callbacks/Main.purs create mode 100644 crates/psrs-syntax/src/parser/expr/qualified.rs create mode 100644 docs/implementation/stdlib/array-public-2026-10-07/report.md diff --git a/crates/psrs-backend/src/bindings/primitives.rs b/crates/psrs-backend/src/bindings/primitives.rs index 3555e7c8..9a1a9652 100644 --- a/crates/psrs-backend/src/bindings/primitives.rs +++ b/crates/psrs-backend/src/bindings/primitives.rs @@ -2,7 +2,7 @@ use crate::BackendError; use psrs_core::{Binder, Declaration, Expr, ExprKind, Module, arrow_parts, scheme_parts}; -use psrs_hir::{ExternalKind, IntrinsicCategory, LocalId}; +use psrs_hir::{ExternalKind, Intrinsic, IntrinsicCategory, LocalId}; #[cfg(test)] mod tests; @@ -80,7 +80,8 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), | IntrinsicCategory::ArrayWrite | IntrinsicCategory::StringToBytes | IntrinsicCategory::BytesToString - ) { + ) && intrinsic != Intrinsic::UnsafeCoerce + { return Err(error(format!( "primitive binding `{}` has no foreign-function implementation yet", intrinsic.descriptor().name @@ -110,21 +111,19 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), intrinsic.descriptor().name ))); } - let mut value = Expr { - kind: ExprKind::IntrinsicCall { - intrinsic, - arguments: parameters - .iter() - .map(|binder| Expr { - kind: ExprKind::Local(binder.id), - ty: binder.ty, - span, - }) - .collect(), - }, - ty: result, + let mut value = psrs_core::primitive::primitive_value( + intrinsic, + parameters + .iter() + .map(|binder| Expr { + kind: ExprKind::Local(binder.id), + ty: binder.ty, + span, + }) + .collect(), + result, span, - }; + ); for (binder, ty) in parameters.into_iter().zip(arrows).rev() { value = Expr { kind: ExprKind::Lambda { diff --git a/crates/psrs-backend/src/boundary.rs b/crates/psrs-backend/src/boundary/mod.rs similarity index 87% rename from crates/psrs-backend/src/boundary.rs rename to crates/psrs-backend/src/boundary/mod.rs index 4a118ab1..c76296c3 100644 --- a/crates/psrs-backend/src/boundary.rs +++ b/crates/psrs-backend/src/boundary/mod.rs @@ -11,6 +11,8 @@ use psrs_core::{Instantiation, Module as CoreModule, TypeConstructor, TypeId}; use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; +mod newtypes; + /// A representation owner's policy for the runtime form of a source /// constructor. It records the constructor's fixed calling-convention /// parameters; the payload is the value's declared result. @@ -22,6 +24,15 @@ pub(crate) enum RepresentationPolicy { /// The owner registered explicit fixed parameters (the Effect runtime /// token). The payload remains the application's result. Fixed(Vec), + /// Domains of a transparent newtype's checked callable field. A domain + /// is either independent of constructor arguments or one fixed argument. + Newtype(Vec), +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(crate) enum ProtocolParameter { + Fixed(TypeId), + Argument(usize), } /// The registry of representation owners, keyed by source constructor. @@ -37,6 +48,21 @@ pub(crate) struct RepresentationRegistry { } impl RepresentationRegistry { + /// The checked newtype field owns its erased callable representation. + /// Register only domains expressible without inventing source type nodes. + pub(crate) fn register_newtypes(&mut self, module: &CoreModule) { + for id in &module.newtype_ids { + if self.policies.contains_key(&TypeConstructor::User(*id)) { + continue; + } + if let Some(parameters) = newtypes::parameters(module, *id) { + self.register( + TypeConstructor::User(*id), + RepresentationPolicy::Newtype(parameters), + ); + } + } + } /// The built-in owners. `Function` is representation-directed by its own /// checked instantiation arguments. pub(crate) fn new() -> Self { @@ -63,6 +89,13 @@ impl RepresentationRegistry { Some(match self.policies.get(&constructor)? { RepresentationPolicy::InstantiationArguments => arguments.to_vec(), RepresentationPolicy::Fixed(parameters) => parameters.clone(), + RepresentationPolicy::Newtype(parameters) => parameters + .iter() + .map(|parameter| match parameter { + ProtocolParameter::Fixed(ty) => Some(*ty), + ProtocolParameter::Argument(index) => arguments.get(*index).copied(), + }) + .collect::>>()?, }) } } diff --git a/crates/psrs-backend/src/boundary/newtypes.rs b/crates/psrs-backend/src/boundary/newtypes.rs new file mode 100644 index 00000000..70974a67 --- /dev/null +++ b/crates/psrs-backend/src/boundary/newtypes.rs @@ -0,0 +1,120 @@ +//! Callable protocols derived from checked transparent newtype fields. +use super::ProtocolParameter; +use psrs_core::{Module, Type, TypeConstructor, TypeId}; +use psrs_hir::{TypeId as HirTypeId, TypeVariableId}; +use std::collections::{HashMap, HashSet}; + +pub(super) fn parameters(module: &Module, id: HirTypeId) -> Option> { + let constructor = module + .constructors + .iter() + .find(|constructor| constructor.type_id == id)?; + if constructor.field_types.len() != 1 { + return None; + } + let bindings = constructor + .parameters + .iter() + .enumerate() + .map(|(index, variable)| (*variable, ProtocolParameter::Argument(index))) + .collect(); + let mut visiting = HashSet::from([id]); + callable(module, constructor.field_types[0], &bindings, &mut visiting) +} + +fn callable( + module: &Module, + mut ty: TypeId, + bindings: &HashMap, + visiting: &mut HashSet, +) -> Option> { + while let Some((_, body)) = psrs_core::forall_parts(&module.types, ty) { + ty = body; + } + if let Some((parameters, _)) = psrs_core::closure_parts(&module.types, ty) { + return parameters + .iter() + .map(|ty| domain(module, *ty, bindings)) + .collect(); + } + let mut parameters = Vec::new(); + let mut cursor = ty; + while let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, cursor) { + parameters.push(domain(module, parameter, bindings)?); + cursor = result; + if psrs_core::forall_parts(&module.types, cursor).is_some() { + break; + } + } + if !parameters.is_empty() { + return Some(parameters); + } + let (TypeConstructor::User(id), arguments) = module.applied_constructor(ty)? else { + return None; + }; + if !module.newtype_ids.contains(&id) || !visiting.insert(id) { + return None; + } + let constructor = module + .constructors + .iter() + .find(|constructor| constructor.type_id == id)?; + if constructor.field_types.len() != 1 || constructor.parameters.len() != arguments.len() { + return None; + } + let nested = constructor + .parameters + .iter() + .zip(arguments) + .map(|(variable, argument)| Some((*variable, domain(module, argument, bindings)?))) + .collect::>>()?; + let result = callable(module, constructor.field_types[0], &nested, visiting); + visiting.remove(&id); + result +} + +fn domain( + module: &Module, + ty: TypeId, + bindings: &HashMap, +) -> Option { + if let Some(Type::Variable(variable)) = module.types.get(ty.0 as usize) { + return bindings.get(variable).cloned(); + } + closed(module, ty, &HashSet::new(), &mut HashSet::new()).then_some(ProtocolParameter::Fixed(ty)) +} + +fn closed( + module: &Module, + ty: TypeId, + bound: &HashSet, + active: &mut HashSet, +) -> bool { + if !active.insert(ty) { + return false; + } + let result = match module.types.get(ty.0 as usize) { + Some(Type::Variable(variable)) => bound.contains(variable), + Some(Type::Application(function, argument)) => { + closed(module, *function, bound, active) && closed(module, *argument, bound, active) + } + Some(Type::RowExtend { ty, tail, .. }) => { + closed(module, *ty, bound, active) && closed(module, *tail, bound, active) + } + Some(Type::ForAll { variables, body }) => { + let mut bound = bound.clone(); + bound.extend(variables); + closed(module, *body, &bound, active) + } + Some(Type::Closure { parameters, result }) => { + parameters + .iter() + .all(|ty| closed(module, *ty, bound, active)) + && closed(module, *result, bound, active) + } + Some(_) => true, + None => false, + }; + active.remove(&ty); + result +} diff --git a/crates/psrs-backend/src/cc/case/coverage/mod.rs b/crates/psrs-backend/src/cc/case/coverage/mod.rs index 96b27599..42d95b86 100644 --- a/crates/psrs-backend/src/cc/case/coverage/mod.rs +++ b/crates/psrs-backend/src/cc/case/coverage/mod.rs @@ -44,7 +44,12 @@ pub(super) fn analyze( } let matrix = branches .iter() - .filter(|branch| branch.coverage == CaseBranchCoverage::Source) + .filter(|branch| { + matches!( + branch.coverage, + CaseBranchCoverage::Source | CaseBranchCoverage::PartialFallback + ) + }) .map(|branch| vec![coverage_pattern(&branch.pattern)]) .collect::>>(); let query = vec![SurfacePattern::Any { ty: scrutinee_type }]; @@ -54,7 +59,10 @@ pub(super) fn analyze( let mut prior = Vec::new(); let mut redundant_branches = Vec::new(); for (index, branch) in branches.iter().enumerate() { - if branch.coverage == CaseBranchCoverage::Generated { + if matches!( + branch.coverage, + CaseBranchCoverage::Generated | CaseBranchCoverage::PartialFallback + ) { continue; } let query = vec![coverage_pattern(&branch.pattern)]; diff --git a/crates/psrs-backend/src/cc/layout/declaration.rs b/crates/psrs-backend/src/cc/layout/declaration.rs new file mode 100644 index 00000000..61247b40 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/declaration.rs @@ -0,0 +1,74 @@ +//! The syntactic calling boundary of a checked Core declaration. + +use crate::BackendError; +use psrs_core::{Declaration, ExprKind, Module, TypeId}; +use psrs_span::TextRange; + +pub(in crate::cc) struct DeclarationCall { + pub parameters: Vec<(TypeId, TextRange)>, + pub result: TypeId, +} + +/// Only the leading lambdas belong to this declaration's call. A case, let, +/// alias, quantified result or explicit closure result produces a value whose +/// own parameters must be called separately. +pub(in crate::cc) fn declaration_call_parts( + module: &Module, + declaration: &Declaration, +) -> Result> { + let mut ty = super::unquantified_type(module, declaration.ty); + let mut value = &declaration.value; + let mut parameters = Vec::new(); + if let Some((closure_parameters, result)) = psrs_core::closure_parts(&module.types, ty) { + let mut peeled = 0; + for parameter in closure_parameters { + let ExprKind::Lambda { binder, body } = &value.kind else { + break; + }; + if !module.types_equivalent(binder.ty, *parameter) { + return Err(vec![BackendError::new( + "P8 closure conversion", + binder.span, + "lambda binder type differs from the function parameter type", + )]); + } + parameters.push((binder.ty, binder.span)); + value = body; + peeled += 1; + } + if peeled == closure_parameters.len() { + ty = result; + } else if peeled != 0 { + return Err(vec![BackendError::new( + "P8 closure conversion", + declaration.span, + "closure declaration is missing a parameter", + )]); + } + } + while let ExprKind::Lambda { binder, body } = &value.kind { + if psrs_core::closure_parts(&module.types, ty).is_some() { + break; + } + let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, ty) else { + break; + }; + if !module.types_equivalent(parameter, binder.ty) { + return Err(vec![BackendError::new( + "P8 closure conversion", + binder.span, + "lambda binder type differs from the function parameter type", + )]); + } + parameters.push((binder.ty, binder.span)); + ty = result; + value = body; + if psrs_core::forall_parts(&module.types, ty).is_some() { + break; + } + } + Ok(DeclarationCall { + parameters, + result: ty, + }) +} diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index d4233dce..38728629 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -8,13 +8,16 @@ use std::collections::{HashMap, HashSet}; mod aggregate; mod captures; +mod declaration; mod functions; +pub(crate) mod protocols; mod scalar; #[cfg(test)] mod tests; use captures::module_has_integer_capture; +pub(super) use declaration::declaration_call_parts; pub(crate) use functions::function_signature; pub(super) use scalar::{declaration_shape, is_abstract_type, scalar_type}; @@ -287,6 +290,7 @@ pub(super) fn type_layout( representations.set(id, Representation::Variant { cases }); } + protocols::append(&mut representations); let function_slot = crate::boundary::function_slot_protocol(&mut representations); Ok(TypeLayout { function_slot, diff --git a/crates/psrs-backend/src/cc/layout/protocols.rs b/crates/psrs-backend/src/cc/layout/protocols.rs new file mode 100644 index 00000000..54a6cac0 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/protocols.rs @@ -0,0 +1,59 @@ +//! Aggregate owners' canonical protocols for bare polymorphic value slots. +use super::super::{RefShape, Reference, ReprId, Representation, RepresentationTable, ValueShape}; + +pub(super) fn append(table: &mut RepresentationTable) { + let erased = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }); + // Register the canonical erased-element array only for a module that has an + // array layout to normalize. A bare slot can hold an array only when a + // concrete array type exists, so a program without arrays must not gain a + // dead representation that would claim a newtype allocated storage. + let has_array = table + .representations + .iter() + .any(|representation| matches!(representation, Representation::Array { .. })); + if has_array + && !table.representations.iter().any(|representation| + matches!(representation, Representation::Array { element } if *element == erased)) + { + let id = table.reserve(); + table.set(id, Representation::Array { element: erased }); + } + let labels = table + .product_labels + .values() + .cloned() + .collect::>(); + for labels in labels { + if table.product_labels.iter().any(|(id, existing)| { + *existing == labels + && matches!(table.representation(*id), Some(Representation::Product { fields }) + if fields.len() == labels.len() && fields.iter().all(|field| *field == erased)) + }) { + continue; + } + let id = table.reserve(); + table.set( + id, + Representation::Product { + fields: vec![erased; labels.len()], + }, + ); + table.set_product_labels(id, labels); + } +} + +pub(crate) fn record(table: &RepresentationTable, labels: &[String]) -> Option { + let erased = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }); + table.product_labels.iter().find_map(|(id, existing)| { + (*existing == labels + && matches!(table.representation(*id), Some(Representation::Product { fields }) + if fields.len() == labels.len() && fields.iter().all(|field| *field == erased))) + .then_some(*id) + }) +} diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index 05b674a3..064a6e59 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -4,7 +4,6 @@ use super::{ }; use crate::BackendError; use crate::cc::{RefShape, Reference, ReprId, Signature, SignatureId, ValueShape}; -use psrs_core::ExprKind; use psrs_core::{Module as CoreModule, Type, TypeConstructor, TypeId}; use psrs_hir::TypeId as HirTypeId; use psrs_span::TextRange; @@ -21,85 +20,25 @@ pub(crate) fn declaration_shape( record_types: &HashMap, function_types: &HashMap, ) -> Result> { - // Declaration-level quantifiers describe the polymorphic value, not an - // extra runtime layer around its closure. Strip only those leading - // quantifiers; a quantifier in a result type remains a separate closure. - let mut ty = unquantified_type(module, declaration.ty); - let mut parameters = Vec::new(); - let mut value = &declaration.value; - if let Some((closure_parameters, result)) = psrs_core::closure_parts(&module.types, ty) { - // The value is this closure when it binds the closure's parameter - // list. An alias of a closure value contributes no parameters. - let closure_parameters = closure_parameters.to_vec(); - let mut peeled = 0; - for parameter_ty in &closure_parameters { - let ExprKind::Lambda { binder, body } = &value.kind else { - break; - }; - if !module.types_equivalent(binder.ty, *parameter_ty) { - return Err(vec![BackendError::new( - "P8 closure conversion", - binder.span, - "lambda binder type differs from the function parameter type", - )]); - } - parameters.push(scalar_type( + let call = super::declaration_call_parts(module, declaration)?; + let ty = call.result; + let parameters = call + .parameters + .into_iter() + .map(|(ty, span)| { + scalar_type( module, - binder.ty, - binder.span, + ty, + span, enum_types, aggregate_types, newtype_ids, array_types, record_types, function_types, - )?); - value = body; - peeled += 1; - } - if peeled == closure_parameters.len() { - ty = result; - } else if peeled != 0 { - return Err(vec![BackendError::new( - "P8 closure conversion", - declaration.span, - "closure declaration is missing a parameter", - )]); - } - } - while let ExprKind::Lambda { binder, body } = &value.kind { - // A closure result is a value of this function. Its parameter list is - // not part of this signature. - if psrs_core::closure_parts(&module.types, ty).is_some() { - break; - } - let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, ty) else { - break; - }; - if !module.types_equivalent(parameter, binder.ty) { - return Err(vec![BackendError::new( - "P8 closure conversion", - binder.span, - "lambda binder type differs from the function parameter type", - )]); - } - ty = result; - parameters.push(scalar_type( - module, - binder.ty, - binder.span, - enum_types, - aggregate_types, - newtype_ids, - array_types, - record_types, - function_types, - )?); - value = body; - if psrs_core::forall_parts(&module.types, ty).is_some() { - break; - } - } + ) + }) + .collect::, _>>()?; if is_callable_type(module, ty) { return Ok(Signature { parameters, diff --git a/crates/psrs-backend/src/cc/lower/call/helpers.rs b/crates/psrs-backend/src/cc/lower/call/helpers.rs index 51a1813c..98caeccb 100644 --- a/crates/psrs-backend/src/cc/lower/call/helpers.rs +++ b/crates/psrs-backend/src/cc/lower/call/helpers.rs @@ -160,11 +160,16 @@ pub(super) fn declaration_parameter_types( else { return Vec::new(); }; - function_arrow_parameters(module, declaration.ty).0 + super::super::super::layout::declaration_call_parts(module, declaration) + .expect("declaration calling boundary was checked before expression lowering") + .parameters + .into_iter() + .map(|(ty, _)| ty) + .collect() } /// The value type a declaration produces after its ordinary arguments: its -/// declared type with every arrow peeled, stopping before a callable +/// declared type with its leading lambda parameters peeled, stopping before a callable /// constructor's hidden parameters. For `discard :: Effect a -> (a -> Effect /// b) -> Effect b` this is `Effect b`, not the value `b` inside the effect. pub(super) fn declaration_result_type( @@ -175,7 +180,11 @@ pub(super) fn declaration_result_type( .declarations .iter() .find(|declaration| declaration.symbol == symbol)?; - Some(function_arrow_parameters(module, declaration.ty).1) + Some( + super::super::super::layout::declaration_call_parts(module, declaration) + .expect("declaration calling boundary was checked before expression lowering") + .result, + ) } /// The result type of a (possibly curried) function type: the value produced diff --git a/crates/psrs-backend/src/cc/lower/call/partial.rs b/crates/psrs-backend/src/cc/lower/call/partial/global.rs similarity index 51% rename from crates/psrs-backend/src/cc/lower/call/partial.rs rename to crates/psrs-backend/src/cc/lower/call/partial/global.rs index d7654f2f..3c9473f7 100644 --- a/crates/psrs-backend/src/cc/lower/call/partial.rs +++ b/crates/psrs-backend/src/cc/lower/call/partial/global.rs @@ -1,43 +1,7 @@ -use super::super::super::layout::{function_arrow_parameters, function_type_signature}; -use super::super::super::{ - Assignment, AssignmentKind, Function, RefShape, Reference, SignatureId, ValueConversion, - ValueId, -}; -use super::super::lambda::LambdaLowering; -use super::super::{FunctionLowerer, Signature, ValueShape}; -use super::helpers::{ - callable_parameter_types, callable_result_type, closure_value_type, closure_value_type_for, - conversion_reconstructs_aggregate, function_result_type, persist_reference, restore_reference, -}; -use crate::BackendError; -use psrs_core::Expr; -use psrs_core::TypeId; -use psrs_hir::SymbolId; - -pub(super) struct PartialApplication<'a> { - pub(super) expression: &'a Expr, - pub(super) function: SymbolId, - pub(super) source_signature: &'a Signature, - pub(super) arguments: Vec<&'a Expr>, - pub(super) result_type: ValueShape, - pub(super) callable_type: TypeId, -} - -/// An under-applied callee that is not a top-level declaration: a local -/// closure or a dictionary method reached through a field access. The supplied -/// arguments are captured and the remaining parameters are exposed by a -/// generated closure that calls the callee indirectly. -pub(super) struct IndirectPartialApplication<'a> { - pub(super) expression: &'a Expr, - pub(super) head: &'a Expr, - pub(super) arguments: Vec<&'a Expr>, - pub(super) signature: &'a Signature, - pub(super) signature_id: SignatureId, - pub(super) result_type: ValueShape, -} +use super::*; impl FunctionLowerer<'_> { - pub(super) fn lower_partial_global_application( + pub(in crate::cc::lower::call) fn lower_partial_global_application( &mut self, application: PartialApplication<'_>, assignments: &mut Vec, @@ -76,6 +40,27 @@ impl FunctionLowerer<'_> { "partial application has an incomplete declaration signature", )]); } + let declaration = self + .module + .declarations + .iter() + .find(|item| item.symbol == function); + let evidence = declaration.and_then(|declaration| { + self.boundary.checked_instantiation( + declaration.ty, + &declaration.quantified, + callable_type, + ) + }); + let (use_parameters, _) = function_arrow_parameters(self.module, callable_type); + let remaining_count = source_signature.parameters.len() - arguments.len(); + if target_signature.parameters.len() < remaining_count { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application target omits a declaration parameter", + )]); + } let capture_conversions = arguments .iter() .enumerate() @@ -83,12 +68,13 @@ impl FunctionLowerer<'_> { let source_type = declared_parameters[index]; let expected = source_signature.parameters[index]; let source_shape = self.value_shape(argument.ty, argument.span)?; - let conversion = self.typed_conversion( + let conversion = self.typed_conversion_with_instantiation( argument.ty, source_type, source_shape, expected, expression.span, + evidence.as_ref(), )?; Ok((source_shape, conversion)) }) @@ -165,17 +151,30 @@ impl FunctionLowerer<'_> { // but the callee's declaration may store a polymorphic parameter erased. // Convert it the way a saturated call does; an identity conversion when // the shapes already agree keeps the monomorphic case unchanged. - for (index, parameter) in remaining_parameters.into_iter().enumerate() { + for (index, parameter) in remaining_parameters + .iter() + .copied() + .take(remaining_count) + .enumerate() + { let position = captured.len() + index; let source_type = declared_parameters[position]; let source_shape = remaining_shapes[index]; let expected = source_signature.parameters[position]; - let conversion = nested.typed_conversion( - source_type, + let use_type = use_parameters.get(position).copied().ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application parameter has no checked use type", + )] + })?; + let conversion = nested.typed_conversion_with_instantiation( + use_type, source_type, source_shape, expected, expression.span, + evidence.as_ref(), )?; let converted = nested.emit_conversion( parameter, @@ -196,15 +195,105 @@ impl FunctionLowerer<'_> { }, span: expression.span, }); + let (result, source_result_shape, source_result_type) = if remaining_parameters.len() + > remaining_count + { + let source_type = callable_result_type(self.module, function, callable_type) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application result has no declaration type", + )] + })?; + // Peel only the declaration's checked ordinary call prefix. Any + // remaining arrows belong to the value returned by that call. + let mut cursor = callable_type; + for _ in 0..source_signature.parameters.len() { + while let Some((_, body)) = psrs_core::forall_parts(&self.module.types, cursor) { + cursor = body; + } + let (_, tail) = + psrs_core::arrow_parts(&self.module.types, cursor).ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application calling prefix has no checked use arrow", + )] + })?; + cursor = tail; + } + let returned_signature = + function_type_signature(self.module, self.function_types, cursor).ok_or_else( + || { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application returned callable has no signature", + )] + }, + )?; + let returned = self + .representations + .signature(returned_signature) + .cloned() + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application returned callable signature is absent", + )] + })?; + let tail_parameters = &remaining_parameters[remaining_count..]; + if returned.parameters != remaining_shapes[remaining_count..] { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "partial application returned callable parameters disagree with its target", + )]); + } + let returned_shape = closure_value_type_for(returned_signature); + let conversion = nested.typed_conversion_with_instantiation( + source_type, + cursor, + source_signature.result, + returned_shape, + expression.span, + evidence.as_ref(), + )?; + let callable = nested.emit_conversion( + result, + source_signature.result, + returned_shape, + conversion, + expression.span, + &mut nested_assignments, + ); + let destination = nested.fresh(returned.result); + nested_assignments.push(Assignment { + destination, + kind: AssignmentKind::IndirectCall { + function: callable, + signature: returned_signature, + arguments: tail_parameters.to_vec(), + }, + span: expression.span, + }); + let use_result = function_result_type(self.module, cursor); + (destination, returned.result, Some(use_result)) + } else { + (result, source_signature.result, None) + }; // The callee's declaration result is the un-instantiated shape, but the // closure signature is the partially applied expression's result. A // polymorphic declaration such as `pure :: a -> Effect a` returns an // erased value while the expression's result is concrete, so convert // before the generated function returns. - let result_conversion = if source_signature.result == target_signature.result { + let result_conversion = if source_result_shape == target_signature.result { ValueConversion::Identity } else { - let source_result_type = callable_result_type(self.module, function, callable_type) + let source_result_type = source_result_type + .or_else(|| callable_result_type(self.module, function, callable_type)) .ok_or_else(|| { vec![BackendError::new( "P8 closure conversion", @@ -213,17 +302,18 @@ impl FunctionLowerer<'_> { )] })?; let destination_result_type = function_result_type(self.module, expression.ty); - nested.typed_conversion( + nested.typed_conversion_with_instantiation( source_result_type, destination_result_type, - source_signature.result, + source_result_shape, target_signature.result, expression.span, + evidence.as_ref(), )? }; let converted_result = nested.emit_conversion( result, - source_signature.result, + source_result_shape, target_signature.result, result_conversion, expression.span, @@ -288,223 +378,4 @@ impl FunctionLowerer<'_> { )]) } } - - /// Under-application of a local closure or dictionary method. Mirrors - /// [`Self::lower_partial_global_application`] but calls the captured callee - /// value indirectly instead of a declaration symbol. - pub(super) fn lower_indirect_partial_application( - &mut self, - application: IndirectPartialApplication<'_>, - assignments: &mut Vec, - ) -> Result> { - let IndirectPartialApplication { - expression, - head, - arguments, - signature, - signature_id, - result_type, - } = application; - let Some(target_signature_id) = - function_type_signature(self.module, self.function_types, expression.ty) - else { - return Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "partial application has no runtime function type", - )]); - }; - let Some(target_signature) = self.representations.signature(target_signature_id).cloned() - else { - return Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "partial application has no target call signature", - )]); - }; - let source_parameter_types = function_arrow_parameters(self.module, head.ty).0; - if source_parameter_types.len() != signature.parameters.len() { - return Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "partial application has an incomplete callee signature", - )]); - } - - // Convert each supplied argument to the callee's expected parameter - // shape; each becomes a capture of the generated closure. - let mut capture_conversions = Vec::with_capacity(arguments.len()); - for (index, argument) in arguments.iter().enumerate() { - let expected = signature.parameters[index]; - let source_shape = self.value_shape(argument.ty, argument.span)?; - let conversion = self.typed_conversion( - argument.ty, - source_parameter_types[index], - source_shape, - expected, - expression.span, - )?; - capture_conversions.push((source_shape, conversion)); - } - - let callee = self.lower_value(head, assignments)?; - let callee_type = self - .values - .iter() - .find(|declaration| declaration.id == callee) - .map(|declaration| declaration.ty) - .ok_or_else(|| { - vec![BackendError::new( - "P8 closure conversion", - expression.span, - "partial application callee has no runtime type", - )] - })?; - let mut captured = Vec::with_capacity(arguments.len() + 1); - captured.push(callee); - for (index, argument) in arguments.iter().enumerate() { - let value = self.lower_value(argument, assignments)?; - let expected = signature.parameters[index]; - let (source_shape, conversion) = capture_conversions[index].clone(); - let converted = self.emit_conversion( - value, - source_shape, - expected, - conversion, - expression.span, - assignments, - ); - captured.push(converted); - } - - let mut nested = self.child_lowerer(); - let closure_parameter = nested.fresh(closure_value_type()); - let mut parameters = vec![closure_parameter]; - let mut remaining_parameters = Vec::with_capacity(target_signature.parameters.len()); - for expected in &target_signature.parameters { - let parameter = nested.fresh(*expected); - parameters.push(parameter); - remaining_parameters.push(parameter); - } - let mut nested_assignments = Vec::with_capacity(signature.parameters.len() + 1); - let mut call_arguments = Vec::with_capacity(signature.parameters.len()); - let callee_capture = nested.fresh(callee_type); - nested_assignments.push(Assignment { - destination: callee_capture, - kind: AssignmentKind::ClosureGetCapture { - closure: closure_parameter, - index: 0, - }, - span: expression.span, - }); - for (index, expected) in signature.parameters[..arguments.len()].iter().enumerate() { - let destination = nested.fresh(*expected); - nested_assignments.push(Assignment { - destination, - kind: AssignmentKind::ClosureGetCapture { - closure: closure_parameter, - index: (index + 1) as u32, - }, - span: expression.span, - }); - call_arguments.push(destination); - } - // A remaining parameter carries the expression's concrete shape, but - // the callee stores its parameter erased. Convert it the way the - // declaration partial application does. - for (index, parameter) in remaining_parameters.into_iter().enumerate() { - let position = arguments.len() + index; - let source_type = source_parameter_types[position]; - let source_shape = target_signature.parameters[index]; - let expected = signature.parameters[position]; - let conversion = nested.typed_conversion( - source_type, - source_type, - source_shape, - expected, - expression.span, - )?; - let converted = nested.emit_conversion( - parameter, - source_shape, - expected, - conversion, - expression.span, - &mut nested_assignments, - ); - call_arguments.push(converted); - } - if signature.result != target_signature.result { - return Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "partial application result does not match the callee result", - )]); - } - let result = nested.fresh(signature.result); - nested_assignments.push(Assignment { - destination: result, - kind: AssignmentKind::IndirectCall { - function: callee_capture, - signature: signature_id, - arguments: call_arguments, - }, - span: expression.span, - }); - - let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); - let generated = Function { - symbol, - name: format!("partial_indirect_{}", expression.span.start), - parameters, - values: nested.values, - assignments: nested_assignments, - result, - result_type: target_signature.result, - span: expression.span, - }; - crate::cc::verify::verify_function(&generated, self.signatures, self.representations)?; - self.generated.extend(nested.generated); - self.generated.push(generated); - - let closure = self.fresh(closure_value_type_for(target_signature_id)); - assignments.push(Assignment { - destination: closure, - kind: AssignmentKind::FunctionRef { - function: symbol, - signature: target_signature_id, - captures: captured, - }, - span: expression.span, - }); - if result_type == closure_value_type_for(target_signature_id) { - Ok(closure) - } else if result_type - == ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Erased, - }) - { - let erased = self.fresh(result_type); - assignments.push(Assignment { - destination: erased, - kind: AssignmentKind::RepresentationCast { - destination: erased, - value: closure, - reference: Reference { - nullable: false, - heap: RefShape::Erased, - }, - }, - span: expression.span, - }); - Ok(erased) - } else { - Err(vec![BackendError::new( - "P8 closure conversion", - expression.span, - "partial application result has the wrong runtime type", - )]) - } - } } diff --git a/crates/psrs-backend/src/cc/lower/call/partial/indirect.rs b/crates/psrs-backend/src/cc/lower/call/partial/indirect.rs new file mode 100644 index 00000000..76599bf7 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/call/partial/indirect.rs @@ -0,0 +1,222 @@ +use super::*; + +impl FunctionLowerer<'_> { + /// Under-application of a local closure or dictionary method. Mirrors + /// [`Self::lower_partial_global_application`] but calls the captured callee + /// value indirectly instead of a declaration symbol. + pub(in crate::cc::lower::call) fn lower_indirect_partial_application( + &mut self, + application: IndirectPartialApplication<'_>, + assignments: &mut Vec, + ) -> Result> { + let IndirectPartialApplication { + expression, + head, + arguments, + signature, + signature_id, + result_type, + } = application; + let Some(target_signature_id) = + function_type_signature(self.module, self.function_types, expression.ty) + else { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application has no runtime function type", + )]); + }; + let Some(target_signature) = self.representations.signature(target_signature_id).cloned() + else { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application has no target call signature", + )]); + }; + let source_parameter_types = function_arrow_parameters(self.module, head.ty).0; + if source_parameter_types.len() != signature.parameters.len() { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application has an incomplete callee signature", + )]); + } + + // Convert each supplied argument to the callee's expected parameter + // shape; each becomes a capture of the generated closure. + let mut capture_conversions = Vec::with_capacity(arguments.len()); + for (index, argument) in arguments.iter().enumerate() { + let expected = signature.parameters[index]; + let source_shape = self.value_shape(argument.ty, argument.span)?; + let conversion = self.typed_conversion( + argument.ty, + source_parameter_types[index], + source_shape, + expected, + expression.span, + )?; + capture_conversions.push((source_shape, conversion)); + } + + let callee = self.lower_value(head, assignments)?; + let callee_type = self + .values + .iter() + .find(|declaration| declaration.id == callee) + .map(|declaration| declaration.ty) + .ok_or_else(|| { + vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application callee has no runtime type", + )] + })?; + let mut captured = Vec::with_capacity(arguments.len() + 1); + captured.push(callee); + for (index, argument) in arguments.iter().enumerate() { + let value = self.lower_value(argument, assignments)?; + let expected = signature.parameters[index]; + let (source_shape, conversion) = capture_conversions[index].clone(); + let converted = self.emit_conversion( + value, + source_shape, + expected, + conversion, + expression.span, + assignments, + ); + captured.push(converted); + } + + let mut nested = self.child_lowerer(); + let closure_parameter = nested.fresh(closure_value_type()); + let mut parameters = vec![closure_parameter]; + let mut remaining_parameters = Vec::with_capacity(target_signature.parameters.len()); + for expected in &target_signature.parameters { + let parameter = nested.fresh(*expected); + parameters.push(parameter); + remaining_parameters.push(parameter); + } + let mut nested_assignments = Vec::with_capacity(signature.parameters.len() + 1); + let mut call_arguments = Vec::with_capacity(signature.parameters.len()); + let callee_capture = nested.fresh(callee_type); + nested_assignments.push(Assignment { + destination: callee_capture, + kind: AssignmentKind::ClosureGetCapture { + closure: closure_parameter, + index: 0, + }, + span: expression.span, + }); + for (index, expected) in signature.parameters[..arguments.len()].iter().enumerate() { + let destination = nested.fresh(*expected); + nested_assignments.push(Assignment { + destination, + kind: AssignmentKind::ClosureGetCapture { + closure: closure_parameter, + index: (index + 1) as u32, + }, + span: expression.span, + }); + call_arguments.push(destination); + } + // A remaining parameter carries the expression's concrete shape, but + // the callee stores its parameter erased. Convert it the way the + // declaration partial application does. + for (index, parameter) in remaining_parameters.into_iter().enumerate() { + let position = arguments.len() + index; + let source_type = source_parameter_types[position]; + let source_shape = target_signature.parameters[index]; + let expected = signature.parameters[position]; + let conversion = nested.typed_conversion( + source_type, + source_type, + source_shape, + expected, + expression.span, + )?; + let converted = nested.emit_conversion( + parameter, + source_shape, + expected, + conversion, + expression.span, + &mut nested_assignments, + ); + call_arguments.push(converted); + } + if signature.result != target_signature.result { + return Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application result does not match the callee result", + )]); + } + let result = nested.fresh(signature.result); + nested_assignments.push(Assignment { + destination: result, + kind: AssignmentKind::IndirectCall { + function: callee_capture, + signature: signature_id, + arguments: call_arguments, + }, + span: expression.span, + }); + + let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); + let generated = Function { + symbol, + name: format!("partial_indirect_{}", expression.span.start), + parameters, + values: nested.values, + assignments: nested_assignments, + result, + result_type: target_signature.result, + span: expression.span, + }; + crate::cc::verify::verify_function(&generated, self.signatures, self.representations)?; + self.generated.extend(nested.generated); + self.generated.push(generated); + + let closure = self.fresh(closure_value_type_for(target_signature_id)); + assignments.push(Assignment { + destination: closure, + kind: AssignmentKind::FunctionRef { + function: symbol, + signature: target_signature_id, + captures: captured, + }, + span: expression.span, + }); + if result_type == closure_value_type_for(target_signature_id) { + Ok(closure) + } else if result_type + == ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }) + { + let erased = self.fresh(result_type); + assignments.push(Assignment { + destination: erased, + kind: AssignmentKind::RepresentationCast { + destination: erased, + value: closure, + reference: Reference { + nullable: false, + heap: RefShape::Erased, + }, + }, + span: expression.span, + }); + Ok(erased) + } else { + Err(vec![BackendError::new( + "P8 closure conversion", + expression.span, + "partial application result has the wrong runtime type", + )]) + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/call/partial/mod.rs b/crates/psrs-backend/src/cc/lower/call/partial/mod.rs new file mode 100644 index 00000000..05fd9860 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/call/partial/mod.rs @@ -0,0 +1,40 @@ +use super::super::super::layout::{function_arrow_parameters, function_type_signature}; +use super::super::super::{ + Assignment, AssignmentKind, Function, RefShape, Reference, SignatureId, ValueConversion, + ValueId, +}; +use super::super::lambda::LambdaLowering; +use super::super::{FunctionLowerer, Signature, ValueShape}; +use super::helpers::{ + callable_parameter_types, callable_result_type, closure_value_type, closure_value_type_for, + conversion_reconstructs_aggregate, function_result_type, persist_reference, restore_reference, +}; +use crate::BackendError; +use psrs_core::Expr; +use psrs_core::TypeId; +use psrs_hir::SymbolId; + +pub(super) struct PartialApplication<'a> { + pub(super) expression: &'a Expr, + pub(super) function: SymbolId, + pub(super) source_signature: &'a Signature, + pub(super) arguments: Vec<&'a Expr>, + pub(super) result_type: ValueShape, + pub(super) callable_type: TypeId, +} + +/// An under-applied callee that is not a top-level declaration: a local +/// closure or a dictionary method reached through a field access. The supplied +/// arguments are captured and the remaining parameters are exposed by a +/// generated closure that calls the callee indirectly. +pub(super) struct IndirectPartialApplication<'a> { + pub(super) expression: &'a Expr, + pub(super) head: &'a Expr, + pub(super) arguments: Vec<&'a Expr>, + pub(super) signature: &'a Signature, + pub(super) signature_id: SignatureId, + pub(super) result_type: ValueShape, +} + +mod global; +mod indirect; diff --git a/crates/psrs-backend/src/cc/lower/conversion/mod.rs b/crates/psrs-backend/src/cc/lower/conversion/mod.rs index 5a2863d6..6487d467 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/mod.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/mod.rs @@ -3,8 +3,8 @@ use super::super::layout::{ user_type_id, }; use super::super::{ - AggregateConvert, Assignment, AssignmentKind, BoxKind, RecoveryEvidence, RefShape, Reference, - ReprId, ValueConversion, ValueId, ValueShape, + AggregateConvert, Assignment, AssignmentKind, RecoveryEvidence, RefShape, Reference, ReprId, + ValueConversion, ValueId, ValueShape, }; use super::FunctionLowerer; use crate::BackendError; @@ -130,56 +130,10 @@ impl FunctionLowerer<'_> { ); } if is_abstract_type(self.module, destination_type) { - if let ValueShape::Reference(Reference { - heap: RefShape::Closure(signature), - .. - }) = source_shape - { - let adapter = self.erase_function_slot(signature, span)?; - return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); - } - return match source_shape { - ValueShape::Integer | ValueShape::Boolean => self - .box_plan(BoxKind::Integer, self.boxed_integer_type, span) - .map(|boxed| sequence(vec![boxed, ValueConversion::EraseReference])), - ValueShape::Number => self - .box_plan(BoxKind::Number, self.boxed_number_type, span) - .map(|boxed| sequence(vec![boxed, ValueConversion::EraseReference])), - // A `String` is already a GC reference in the `eq` hierarchy, so - // it is erased and recovered by cast, not by the integer box. - ValueShape::String | ValueShape::Reference(_) => { - Ok(ValueConversion::EraseReference) - } - }; + return self.erase_payload(source_shape, span); } if is_abstract_type(self.module, source_type) { - if let ValueShape::Reference(Reference { - heap: RefShape::Closure(signature), - .. - }) = destination_shape - { - return self.recover_function_slot(signature, span); - } - return match destination_shape { - ValueShape::Integer | ValueShape::Boolean => self.unbox_plan( - BoxKind::Integer, - self.boxed_integer_type, - destination_shape, - span, - ), - ValueShape::Number => self.unbox_plan( - BoxKind::Number, - self.boxed_number_type, - destination_shape, - span, - ), - ValueShape::String | ValueShape::Reference(_) => { - Ok(ValueConversion::RecoverReference { - destination: destination_shape, - evidence: RecoveryEvidence::TypeInstantiation, - }) - } - }; + return self.recover_payload(destination_shape, span); } // An abstract aggregate value and the concrete variant representation of // the same declaration are related by a reference cast (DEC-13). @@ -385,6 +339,10 @@ impl FunctionLowerer<'_> { && is_abstract_type(self.module, template_type) && matches!(target_shape, ValueShape::Reference(reference) if !matches!(reference.heap, RefShape::Closure(_))) && target_shape != erased_shape() + && !matches!(target_shape, ValueShape::Reference(Reference { heap: RefShape::Repr(id), .. }) + if matches!(self.representations.representation(id), Some(crate::cc::Representation::Array { .. }))) + && !matches!(target_shape, ValueShape::Reference(Reference { heap: RefShape::Repr(id), .. }) + if self.representations.product_labels(id).is_some()) { return Ok(ValueConversion::RecoverReference { destination: target_shape, diff --git a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs index 5283f772..553ec4e2 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs @@ -15,6 +15,12 @@ impl FunctionLowerer<'_> { if shape == erased_shape() { return Ok(ValueConversion::Identity); } + if let Some(plan) = self.array_payload(shape, true, span)? { + return Ok(plan); + } + if let Some(plan) = self.record_payload(shape, true, span)? { + return Ok(plan); + } if let ValueShape::Reference(Reference { heap: RefShape::Closure(signature), .. @@ -43,6 +49,12 @@ impl FunctionLowerer<'_> { if shape == erased_shape() { return Ok(ValueConversion::Identity); } + if let Some(plan) = self.array_payload(shape, false, span)? { + return Ok(plan); + } + if let Some(plan) = self.record_payload(shape, false, span)? { + return Ok(plan); + } if let ValueShape::Reference(Reference { heap: RefShape::Closure(signature), .. @@ -66,6 +78,153 @@ impl FunctionLowerer<'_> { } } + fn array_payload( + &mut self, + shape: ValueShape, + entering: bool, + span: TextRange, + ) -> Result, Vec> { + let ValueShape::Reference(Reference { + heap: RefShape::Repr(concrete), + .. + }) = shape + else { + return Ok(None); + }; + let Some(crate::cc::Representation::Array { element }) = + self.representations.representation(concrete) + else { + return Ok(None); + }; + let element_shape = *element; + let protocol = self.representations.representations.iter().position(|representation| + matches!(representation, crate::cc::Representation::Array { element } if *element == erased_shape())) + .map(|index| ReprId(index as u32)) + .ok_or_else(|| conversion_error(span, "Array owner has no erased storage protocol"))?; + let protocol_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(protocol), + }); + if concrete == protocol { + return Ok(Some(if entering { + ValueConversion::EraseReference + } else { + ValueConversion::RecoverReference { + destination: shape, + evidence: RecoveryEvidence::TypeInstantiation, + } + })); + } + if entering { + let element = self.erase_payload(element_shape, span)?; + Ok(Some(sequence(vec![ + ValueConversion::ArrayMap { + source: concrete, + target: protocol, + element: Box::new(element), + }, + ValueConversion::EraseReference, + ]))) + } else { + let element = self.recover_payload(element_shape, span)?; + Ok(Some(sequence(vec![ + ValueConversion::RecoverReference { + destination: protocol_shape, + evidence: RecoveryEvidence::TypeInstantiation, + }, + ValueConversion::ArrayMap { + source: protocol, + target: concrete, + element: Box::new(element), + }, + ]))) + } + } + + fn record_payload( + &mut self, + shape: ValueShape, + entering: bool, + span: TextRange, + ) -> Result, Vec> { + let ValueShape::Reference(Reference { + heap: RefShape::Repr(concrete), + .. + }) = shape + else { + return Ok(None); + }; + let Some(labels) = self + .representations + .product_labels(concrete) + .map(<[String]>::to_vec) + else { + return Ok(None); + }; + let Some(crate::cc::Representation::Product { fields }) = + self.representations.representation(concrete) + else { + return Err(conversion_error( + span, + "record owner labels do not name a product", + )); + }; + let fields = fields.clone(); + let protocol = + super::super::super::layout::protocols::record(self.representations, &labels) + .ok_or_else(|| { + conversion_error(span, "record owner has no erased field protocol") + })?; + if concrete == protocol { + return Ok(Some(if entering { + ValueConversion::EraseReference + } else { + ValueConversion::RecoverReference { + destination: shape, + evidence: RecoveryEvidence::TypeInstantiation, + } + })); + } + let plans = fields + .into_iter() + .map(|field| { + if entering { + self.erase_payload(field, span) + } else { + self.recover_payload(field, span) + } + }) + .collect::, _>>()?; + Ok(Some(if entering { + sequence(vec![ + ValueConversion::ProductMap { + source: concrete, + target: protocol, + labels, + fields: plans, + }, + ValueConversion::EraseReference, + ]) + } else { + let protocol_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(protocol), + }); + sequence(vec![ + ValueConversion::RecoverReference { + destination: protocol_shape, + evidence: RecoveryEvidence::TypeInstantiation, + }, + ValueConversion::ProductMap { + source: protocol, + target: concrete, + labels, + fields: plans, + }, + ]) + })) + } + pub(super) fn box_plan( &self, kind: BoxKind, diff --git a/crates/psrs-backend/src/cc/lower/conversion/transport.rs b/crates/psrs-backend/src/cc/lower/conversion/transport.rs index 80f18d9b..920cbce6 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/transport.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/transport.rs @@ -6,7 +6,7 @@ use crate::{ BackendError, cc::{RecoveryEvidence, RefShape, Reference, ValueConversion, ValueShape}, }; -use psrs_core::{Instantiation, Type, TypeId}; +use psrs_core::{Instantiation, Type, TypeConstructor, TypeId}; use psrs_span::TextRange; fn abstract_head(module: &psrs_core::Module, ty: TypeId) -> Option { @@ -40,6 +40,70 @@ impl FunctionLowerer<'_> { span: TextRange, evidence: Option<&Instantiation<'_>>, ) -> Result, Vec> { + let source_head = abstract_head(self.module, source); + let target_head = abstract_head(self.module, target); + let array_boundary = match ( + source_head, + target_head, + super::super::super::layout::array_element_type(self.module, source), + super::super::super::layout::array_element_type(self.module, target), + ) { + (Some(variable), None, _, Some(element)) => Some((variable, false, target, element)), + (None, Some(variable), Some(element), _) => Some((variable, true, source, element)), + _ => None, + }; + if let Some((variable, entering, concrete_type, element_type)) = array_boundary { + let (constructor, fixed) = evidence + .and_then(|proof| proof.constructor(variable)) + .ok_or_else(|| { + conversion_error(span, "array constructor transport has no checked binding") + })?; + if constructor != TypeConstructor::Array || !fixed.is_empty() { + return Err(conversion_error( + span, + "array transport binding is not the unary Array constructor", + )); + } + let erased_element = super::erased_shape(); + let protocol = self.representations.representations.iter().position(|representation| + matches!(representation, crate::cc::Representation::Array { element } if *element == erased_element)) + .map(|index| crate::cc::ReprId(index as u32)) + .ok_or_else(|| conversion_error(span, "Array owner has no erased storage protocol"))?; + let concrete = self + .array_types + .get(&concrete_type) + .copied() + .ok_or_else(|| conversion_error(span, "array transport has no concrete layout"))?; + let element_shape = self.value_shape(element_type, span)?; + let protocol_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(protocol), + }); + return Ok(Some(if entering { + let element = self.erase_payload(element_shape, span)?; + sequence(vec![ + ValueConversion::ArrayMap { + source: concrete, + target: protocol, + element: Box::new(element), + }, + ValueConversion::EraseReference, + ]) + } else { + let element = self.recover_payload(element_shape, span)?; + sequence(vec![ + ValueConversion::RecoverReference { + destination: protocol_shape, + evidence: RecoveryEvidence::TypeInstantiation, + }, + ValueConversion::ArrayMap { + source: protocol, + target: concrete, + element: Box::new(element), + }, + ]) + })); + } let boundary = match ( abstract_head(self.module, source), abstract_head(self.module, target), diff --git a/crates/psrs-backend/src/cc/lower/dictionary/tests.rs b/crates/psrs-backend/src/cc/lower/dictionary/tests.rs index 3ed0f514..cc49f9e3 100644 --- a/crates/psrs-backend/src/cc/lower/dictionary/tests.rs +++ b/crates/psrs-backend/src/cc/lower/dictionary/tests.rs @@ -28,8 +28,12 @@ fn typed_thir_instance_and_superclass_evidence_lower_to_ordinary_products() { panic!("expected method selection to remain an ordinary Core projection"); }; assert_eq!(field, "isPositive"); - let psrs_core::ExprKind::FieldAccess { record, field } = &record.kind else { - panic!("expected superclass evidence to remain an ordinary Core projection"); + let psrs_core::ExprKind::Application(thunk, unit) = &record.kind else { + panic!("expected superclass selection to force its thunk"); + }; + assert!(matches!(unit.kind, psrs_core::ExprKind::Unit)); + let psrs_core::ExprKind::FieldAccess { record, field } = &thunk.kind else { + panic!("expected superclass selection to project its thunk"); }; assert_eq!(field, "super"); assert!(matches!( @@ -69,9 +73,18 @@ fn typed_thir_instance_and_superclass_evidence_lower_to_ordinary_products() { for (argument, field) in ord_arguments.iter().zip(fields) { assert_eq!(value_shape(make_ord, *argument), Some(*field)); } + let ValueShape::Reference(crate::cc::Reference { + heap: crate::cc::RefShape::Closure(thunk), + .. + }) = fields[2] + else { + panic!("superclass field must be a callable thunk"); + }; + let thunk = cc.representations.signature(thunk).unwrap(); + assert_eq!(thunk.parameters, vec![ValueShape::Integer]); assert_eq!( - value_shape(make_ord, ord_arguments[2]), - Some(make_ord.values[make_ord.parameters[0].0 as usize].ty) + thunk.result, + make_ord.values[make_ord.parameters[0].0 as usize].ty ); let main = cc @@ -166,12 +179,15 @@ fn dictionary_evidence_module() -> thir::Module { ]; let method = push_arrow(&mut types, integer, boolean); let eq_dictionary = push_record(&mut types, vec![("isPositive".into(), method)]); + let unit = thir::TypeId(types.len() as u32); + types.push(thir::Type::Constructor(thir::TypeConstructor::Unit)); + let superclass_thunk = push_arrow(&mut types, unit, eq_dictionary); let ord_dictionary = push_record( &mut types, vec![ ("compare".into(), method), ("rank".into(), method), - ("super".into(), eq_dictionary), + ("super".into(), superclass_thunk), ], ); let make_ord_type = push_arrow(&mut types, eq_dictionary, ord_dictionary); @@ -253,7 +269,18 @@ fn dictionary_evidence_module() -> thir::Module { ), ( "super".into(), - typed(thir::ExprKind::Local(LocalId(2)), eq_dictionary, span), + typed( + thir::ExprKind::Lambda { + binder: binder(4, "superclass_unit", unit, span), + body: Box::new(typed( + thir::ExprKind::Local(LocalId(2)), + eq_dictionary, + span, + )), + }, + superclass_thunk, + span, + ), ), ]), ord_dictionary, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 803594ea..90bed3e7 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -266,11 +266,21 @@ pub(crate) fn lower_module_with_relations( mut module: CoreModule, bindings: ExternalBindings, source: Option<&CoreModule>, - registry: RepresentationRegistry, + mut registry: RepresentationRegistry, ) -> Result> { crate::bindings::lower_primitives(&mut module, source)?; bindings.validate_core(&module)?; + module = psrs_core::instantiate_local_rows(module, source).map_err(|errors| { + errors + .into_iter() + .map(|error| { + BackendError::new("P8 local row instantiation", error.span, error.message) + .with_module(error.module) + }) + .collect::>() + })?; let relations = source.unwrap_or(&module); + registry.register_newtypes(relations); if let Err(errors) = module.verify_with_source(relations) { return Err(annotate_errors( errors diff --git a/crates/psrs-core/src/instantiation/local_rows.rs b/crates/psrs-core/src/instantiation/local_rows.rs new file mode 100644 index 00000000..227490a0 --- /dev/null +++ b/crates/psrs-core/src/instantiation/local_rows.rs @@ -0,0 +1,350 @@ +//! Lower finite closed uses of row-polymorphic local lambdas through checked +//! instantiation. Residual open uses retain their source scheme and remain an +//! explicit unsupported layout at the representation boundary. +use crate::locals::{FreshLocals, clone_with_fresh_locals}; +use crate::{ + Binding, Expr, ExprKind, LocalId, Module, Pattern, PatternKind, Type, TypeId, VerifyError, +}; +use std::collections::{HashMap, HashSet}; + +/// Materializes closed row instantiations of nonrecursive local lambdas. +/// This preparation has no optimization budget: every eligible closed use is +/// lowered. It changes only lambda creation, preserving evaluation and capture +/// of surrounding computations. Core checks the input and transformed output. +pub fn instantiate_local_rows( + mut module: Module, + source: Option<&Module>, +) -> Result> { + module.verify_with_source(source.unwrap_or(&module))?; + for index in 0..module.declarations.len() { + let mut expression = module.declarations[index].value.clone(); + let mut fresh = FreshLocals::for_declaration(&expression); + rewrite( + &mut expression, + &mut module, + &mut fresh, + &mut HashMap::new(), + ); + module.declarations[index].value = expression; + } + module.verify_with_source(source.unwrap_or(&module))?; + Ok(module) +} + +fn rewrite( + expr: &mut Expr, + module: &mut Module, + fresh: &mut FreshLocals, + scope: &mut HashMap, +) { + if let ExprKind::Local(id) = expr.kind { + if let Some(binding) = scope.get(&id).cloned() + && let Some(value) = instantiate(module, &binding, expr.ty, fresh) + { + *expr = value; + rewrite(expr, module, fresh, scope); + } + return; + } + match &mut expr.kind { + ExprKind::Lambda { binder, body } => { + let previous = scope.remove(&binder.id); + rewrite(body, module, fresh, scope); + if let Some(binding) = previous { + scope.insert(binder.id, binding); + } + } + ExprKind::Let { bindings, body } => { + let dependencies = bindings + .iter() + .map(|binding| { + ( + binding.binder.id, + bindings + .iter() + .filter(|other| uses(&binding.value, other.binder.id)) + .map(|other| other.binder.id) + .collect::>(), + ) + }) + .collect::>(); + let mut previous = Vec::new(); + for binding in bindings.iter() { + previous.push((binding.binder.id, scope.remove(&binding.binder.id))); + // Restrict this preparation to nonrecursive lambdas. Keeping a + // recursive source binding is an explicit layout obligation. + let recursive = + dependencies + .get(&binding.binder.id) + .is_some_and(|dependencies_from_binding| { + dependencies_from_binding.iter().any(|id| { + reaches(*id, binding.binder.id, &dependencies, &mut HashSet::new()) + }) + }); + if !recursive + && !quantifiers(module, binding).is_empty() + && matches!(binding.value.kind, ExprKind::Lambda { .. }) + { + scope.insert(binding.binder.id, binding.clone()); + } + } + for binding in bindings.iter_mut() { + rewrite(&mut binding.value, module, fresh, scope); + } + rewrite(body, module, fresh, scope); + let removable = bindings + .iter() + .filter(|binding| { + scope.contains_key(&binding.binder.id) + && !uses(body, binding.binder.id) + && !bindings + .iter() + .any(|other| uses(&other.value, binding.binder.id)) + }) + .map(|binding| binding.binder.id) + .collect::>(); + bindings.retain(|binding| !removable.contains(&binding.binder.id)); + for (id, binding) in previous { + scope.remove(&id); + if let Some(binding) = binding { + scope.insert(id, binding); + } + } + } + ExprKind::Case { + scrutinee, + branches, + } => { + rewrite(scrutinee, module, fresh, scope); + for branch in branches { + let mut ids = Vec::new(); + pattern_ids(&branch.pattern, &mut ids); + let previous = ids + .into_iter() + .map(|id| (id, scope.remove(&id))) + .collect::>(); + rewrite(&mut branch.value, module, fresh, scope); + for (id, binding) in previous { + if let Some(binding) = binding { + scope.insert(id, binding); + } + } + } + } + _ => { + for child in children(expr) { + rewrite(child, module, fresh, scope); + } + } + } +} + +fn instantiate( + module: &mut Module, + binding: &Binding, + use_type: TypeId, + fresh: &mut FreshLocals, +) -> Option { + let rows = { + let quantified = quantifiers(module, binding); + let proof = module.checked_instantiation(binding.binder.ty, &quantified, use_type)?; + quantified + .iter() + .map(|variable| { + let row = proof.row(*variable)?; + if row.tail.is_some() { + return None; + } + Some((*variable, row.fields)) + }) + .collect::>>()? + }; + let mut replacements = HashMap::new(); + let empty = module + .types + .iter() + .position(|ty| matches!(ty, Type::RowEmpty))?; + for (variable, fields) in rows { + let mut tail = TypeId(empty as u32); + for (label, ty) in fields.into_iter().rev() { + let node = Type::RowExtend { label, ty, tail }; + tail = if let Some(index) = module.types.iter().position(|ty| *ty == node) { + TypeId(index as u32) + } else { + let id = TypeId(u32::try_from(module.types.len()).ok()?); + module.types.push(node); + id + }; + } + replacements.insert(variable, tail); + } + let value = super::substitution::instantiate_expression(module, &binding.value, &replacements)?; + clone_with_fresh_locals(&value, fresh) +} + +fn quantifiers(module: &Module, binding: &Binding) -> Vec { + let mut variables = binding.quantified.clone(); + let mut ty = binding.binder.ty; + while let Some(Type::ForAll { + variables: bound, + body, + }) = module.types.get(ty.0 as usize) + { + variables.extend(bound); + ty = *body; + } + variables +} + +fn children(expr: &mut Expr) -> Vec<&mut Expr> { + match &mut expr.kind { + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => arguments.iter_mut().collect(), + ExprKind::Record { fields } => fields.iter_mut().map(|(_, value)| value).collect(), + ExprKind::RecordUpdate { record, fields } => std::iter::once(record.as_mut()) + .chain(fields.iter_mut().map(|(_, value)| value)) + .collect(), + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } => vec![record], + ExprKind::Application(function, argument) => vec![function, argument], + ExprKind::Lambda { body, .. } => vec![body], + ExprKind::Let { bindings, body } => bindings + .iter_mut() + .map(|binding| &mut binding.value) + .chain(std::iter::once(body.as_mut())) + .collect(), + ExprKind::If { + condition, + then_branch, + else_branch, + } => vec![condition, then_branch, else_branch], + ExprKind::Case { + scrutinee, + branches, + } => std::iter::once(scrutinee.as_mut()) + .chain(branches.iter_mut().map(|branch| &mut branch.value)) + .collect(), + ExprKind::Local(_) + | ExprKind::Global(_) + | ExprKind::Integer(_) + | ExprKind::Number(_) + | ExprKind::Boolean(_) + | ExprKind::String(_) + | ExprKind::Char(_) + | ExprKind::Unit + | ExprKind::StateToken + | ExprKind::Trap => Vec::new(), + } +} + +fn uses(expr: &Expr, id: LocalId) -> bool { + // The traversal is scope aware, including malformed/reused local identities + // accepted as lexical shadowing by Core's verifier. + match &expr.kind { + ExprKind::Local(found) => *found == id, + ExprKind::Lambda { binder, .. } if binder.id == id => false, + ExprKind::Let { bindings, .. } + if bindings.iter().any(|binding| binding.binder.id == id) => + { + false + } + ExprKind::Case { + scrutinee, + branches, + } => { + uses(scrutinee, id) + || branches.iter().any(|branch| { + let mut ids = Vec::new(); + pattern_ids(&branch.pattern, &mut ids); + !ids.contains(&id) && uses(&branch.value, id) + }) + } + _ => children_ref(expr).into_iter().any(|child| uses(child, id)), + } +} + +fn reaches( + current: LocalId, + target: LocalId, + dependencies: &HashMap>, + seen: &mut HashSet, +) -> bool { + current == target + || (seen.insert(current) + && dependencies.get(¤t).is_some_and(|next| { + next.iter() + .any(|id| reaches(*id, target, dependencies, seen)) + })) +} + +fn children_ref(expr: &Expr) -> Vec<&Expr> { + match &expr.kind { + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => arguments.iter().collect(), + ExprKind::Record { fields } => fields.iter().map(|(_, value)| value).collect(), + ExprKind::RecordUpdate { record, fields } => std::iter::once(record.as_ref()) + .chain(fields.iter().map(|(_, value)| value)) + .collect(), + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } => vec![record], + ExprKind::Application(function, argument) => vec![function, argument], + ExprKind::Lambda { body, .. } => vec![body], + ExprKind::Let { bindings, body } => bindings + .iter() + .map(|binding| &binding.value) + .chain(std::iter::once(body.as_ref())) + .collect(), + ExprKind::If { + condition, + then_branch, + else_branch, + } => vec![condition, then_branch, else_branch], + ExprKind::Case { + scrutinee, + branches, + } => std::iter::once(scrutinee.as_ref()) + .chain(branches.iter().map(|branch| &branch.value)) + .collect(), + ExprKind::Local(_) + | ExprKind::Global(_) + | ExprKind::Integer(_) + | ExprKind::Number(_) + | ExprKind::Boolean(_) + | ExprKind::String(_) + | ExprKind::Char(_) + | ExprKind::Unit + | ExprKind::StateToken + | ExprKind::Trap => Vec::new(), + } +} + +fn pattern_ids(pattern: &Pattern, ids: &mut Vec) { + match &pattern.kind { + PatternKind::Var { id, .. } => ids.push(*id), + PatternKind::Named { id, pattern } => { + ids.push(*id); + pattern_ids(pattern, ids); + } + PatternKind::Array { elements } + | PatternKind::Constructor { + arguments: elements, + .. + } => { + for pattern in elements { + pattern_ids(pattern, ids); + } + } + PatternKind::Record { fields } => { + for (_, pattern) in fields { + pattern_ids(pattern, ids); + } + } + PatternKind::Wildcard | PatternKind::Literal { .. } => {} + } +} diff --git a/crates/psrs-core/src/instantiation.rs b/crates/psrs-core/src/instantiation/mod.rs similarity index 54% rename from crates/psrs-core/src/instantiation.rs rename to crates/psrs-core/src/instantiation/mod.rs index 4e46f730..e94f9f5c 100644 --- a/crates/psrs-core/src/instantiation.rs +++ b/crates/psrs-core/src/instantiation/mod.rs @@ -1,4 +1,7 @@ -//! Read-only instantiation evidence from the Core checking relation. +//! Read-only instantiation evidence and checked materialization. +mod local_rows; +pub(crate) mod substitution; +pub use local_rows::instantiate_local_rows; use crate::{Module, Type, TypeConstructor, TypeId}; use psrs_hir::TypeVariableId; @@ -9,6 +12,15 @@ use std::collections::{HashMap, HashSet}; pub struct Instantiation<'a> { pub(crate) module: &'a Module, pub(crate) replacements: HashMap, + pub(crate) rows: HashMap, +} + +/// A checked row residual, including solutions with no existing arena node. +/// Field and tail ids refer to the immutable source module of the evidence. +#[derive(Clone, Debug)] +pub struct RowInstantiation { + pub fields: Vec<(String, TypeId)>, + pub tail: Option, } impl std::fmt::Debug for Instantiation<'_> { @@ -16,11 +28,36 @@ impl std::fmt::Debug for Instantiation<'_> { formatter .debug_struct("Instantiation") .field("replacements", &self.replacements) + .field("rows", &self.rows) .finish() } } impl Instantiation<'_> { + /// Returns the checking owner's solution for a quantified row variable. + /// A residual is retained even when its fields have no arena row node. + pub fn row(&self, variable: TypeVariableId) -> Option { + if let Some(row) = self.rows.get(&variable) { + return Some(row.clone()); + } + let mut current = *self.replacements.get(&variable)?; + let mut seen = HashSet::new(); + loop { + if !seen.insert(current) { + return None; + } + if let Some(Type::Variable(variable)) = self.module.types.get(current.0 as usize) { + if let Some(row) = self.rows.get(variable) { + return Some(row.clone()); + } + current = *self.replacements.get(variable)?; + } else { + let (fields, tail) = crate::row_fields(&self.module.types, current)?; + return Some(RowInstantiation { fields, tail }); + } + } + } + /// Resolves an abstract constructor to its checked constructor application. /// Fixed arguments belong to the borrowed source arena. An unsolved head, /// row solution or substitution cycle is not a constructor identity. diff --git a/crates/psrs-core/src/opt/specialize/types/substitution.rs b/crates/psrs-core/src/instantiation/substitution.rs similarity index 92% rename from crates/psrs-core/src/opt/specialize/types/substitution.rs rename to crates/psrs-core/src/instantiation/substitution.rs index c7f228b2..314429fd 100644 --- a/crates/psrs-core/src/opt/specialize/types/substitution.rs +++ b/crates/psrs-core/src/instantiation/substitution.rs @@ -4,7 +4,7 @@ use crate::{ use psrs_hir::{SymbolId, TypeVariableId}; use std::collections::{HashMap, HashSet}; -pub(in crate::opt::specialize) fn instantiate_declaration( +pub(crate) fn instantiate_declaration( module: &mut Module, declaration: &Declaration, replacements: &HashMap, @@ -30,6 +30,7 @@ pub(in crate::opt::specialize) fn instantiate_declaration( shadowed: HashSet::new(), renamed: HashMap::new(), active: HashSet::new(), + discharged: HashSet::new(), }; let ty = substitution.type_id(declaration.ty)?; let value = substitution.expression(&declaration.value)?; @@ -44,6 +45,35 @@ pub(in crate::opt::specialize) fn instantiate_declaration( }) } +pub(super) fn instantiate_expression( + module: &mut Module, + expression: &Expr, + replacements: &HashMap, +) -> Option { + let mut replacement_free_variables = HashSet::new(); + for id in replacements.values() { + free_variables( + module, + *id, + &mut HashSet::new(), + &mut HashSet::new(), + &mut replacement_free_variables, + ); + } + let used_variables = all_variables(module); + TypeSubstitution { + module, + replacements, + replacement_free_variables, + used_variables, + shadowed: HashSet::new(), + renamed: HashMap::new(), + active: HashSet::new(), + discharged: replacements.keys().copied().collect(), + } + .expression(expression) +} + struct TypeSubstitution<'a> { module: &'a mut Module, replacements: &'a HashMap, @@ -52,6 +82,7 @@ struct TypeSubstitution<'a> { shadowed: HashSet, renamed: HashMap, active: HashSet, + discharged: HashSet, } impl TypeSubstitution<'_> { @@ -77,6 +108,13 @@ impl TypeSubstitution<'_> { let argument = self.type_id(argument)?; self.intern(Type::Application(function, argument))? } + Type::ForAll { variables, body } + if variables + .iter() + .all(|variable| self.discharged.contains(variable)) => + { + self.type_id(body)? + } Type::ForAll { variables, body } => { let mut renamed_variables = variables.clone(); let mut previous_renamings = Vec::new(); diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 471f62f9..0963e15b 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -8,7 +8,7 @@ pub mod opt; mod pattern; pub mod primitive; mod records; -pub use instantiation::Instantiation; +pub use instantiation::{Instantiation, RowInstantiation, instantiate_local_rows}; mod types; mod verify; diff --git a/crates/psrs-core/src/link/mod.rs b/crates/psrs-core/src/link/mod.rs index 3baff42c..52390e2b 100644 --- a/crates/psrs-core/src/link/mod.rs +++ b/crates/psrs-core/src/link/mod.rs @@ -260,6 +260,24 @@ pub fn prune_unreachable(module: &mut Module, root: SymbolId) { module .declarations .retain(|declaration| reachable.contains(&declaration.symbol)); + // Static library imports follow the same executable dependency graph as + // library declarations. Target protocols (WIT and explicit primitives) + // retain their source-wide conformance obligations even when unused. + let discarded_imports = module + .externals + .iter() + .filter(|external| { + matches!(external.kind, psrs_hir::ExternalKind::Library { .. }) + && !reachable.contains(&external.symbol) + }) + .map(|external| external.symbol) + .collect::>(); + module + .externals + .retain(|external| !discarded_imports.contains(&external.symbol)); + module + .external_types + .retain(|external| !discarded_imports.contains(&external.symbol)); // A reachable constructor keeps every case of its type so the variant // layout stays complete. Unused library types drop out with their cases. used_types.extend( diff --git a/crates/psrs-core/src/locals/alpha.rs b/crates/psrs-core/src/locals/alpha.rs new file mode 100644 index 00000000..f61bd99a --- /dev/null +++ b/crates/psrs-core/src/locals/alpha.rs @@ -0,0 +1,238 @@ +use super::FreshLocals; +use crate::{Binding, CaseBranch, Expr, ExprKind, Pattern, PatternKind}; +use psrs_hir::LocalId; +use std::collections::HashMap; + +pub(crate) fn clone_with_fresh_locals(expression: &Expr, fresh: &mut FreshLocals) -> Option { + clone_expr(expression, fresh, &mut HashMap::new()) +} + +fn clone_expr( + expression: &Expr, + fresh: &mut FreshLocals, + locals: &mut HashMap, +) -> Option { + let kind = match &expression.kind { + ExprKind::Local(id) => ExprKind::Local(locals.get(id).copied().unwrap_or(*id)), + ExprKind::Global(symbol) => ExprKind::Global(*symbol), + ExprKind::Constructor { symbol, arguments } => ExprKind::Constructor { + symbol: *symbol, + arguments: arguments + .iter() + .map(|argument| clone_expr(argument, fresh, locals)) + .collect::>>()?, + }, + ExprKind::IntrinsicCall { + intrinsic, + arguments, + } => ExprKind::IntrinsicCall { + intrinsic: *intrinsic, + arguments: arguments + .iter() + .map(|argument| clone_expr(argument, fresh, locals)) + .collect::>>()?, + }, + ExprKind::Integer(value) => ExprKind::Integer(*value), + ExprKind::Number(value) => ExprKind::Number(value.clone()), + ExprKind::Boolean(value) => ExprKind::Boolean(*value), + ExprKind::String(value) => ExprKind::String(value.clone()), + ExprKind::Char(value) => ExprKind::Char(*value), + ExprKind::Unit => ExprKind::Unit, + ExprKind::StateToken => ExprKind::StateToken, + ExprKind::Trap => ExprKind::Trap, + ExprKind::Array { elements } => ExprKind::Array { + elements: elements + .iter() + .map(|element| clone_expr(element, fresh, locals)) + .collect::>>()?, + }, + ExprKind::Record { fields } => ExprKind::Record { + fields: fields + .iter() + .map(|(label, value)| Some((label.clone(), clone_expr(value, fresh, locals)?))) + .collect::>>()?, + }, + ExprKind::RecordUpdate { record, fields } => ExprKind::RecordUpdate { + record: Box::new(clone_expr(record, fresh, locals)?), + fields: fields + .iter() + .map(|(label, value)| Some((label.clone(), clone_expr(value, fresh, locals)?))) + .collect::>>()?, + }, + ExprKind::FieldAccess { record, field } => ExprKind::FieldAccess { + record: Box::new(clone_expr(record, fresh, locals)?), + field: field.clone(), + }, + ExprKind::RepresentationCast { + value, + source_type, + target_type, + } => ExprKind::RepresentationCast { + value: Box::new(clone_expr(value, fresh, locals)?), + source_type: *source_type, + target_type: *target_type, + }, + ExprKind::Application(function, argument) => ExprKind::Application( + Box::new(clone_expr(function, fresh, locals)?), + Box::new(clone_expr(argument, fresh, locals)?), + ), + ExprKind::Lambda { binder, body } => { + let renamed = fresh.fresh()?; + let previous = locals.insert(binder.id, renamed); + let body = clone_expr(body, fresh, locals)?; + restore_local(locals, binder.id, previous); + ExprKind::Lambda { + binder: crate::Binder { + id: renamed, + name: binder.name.clone(), + ty: binder.ty, + span: binder.span, + }, + body: Box::new(body), + } + } + ExprKind::Let { bindings, body } => { + let mut renamed = Vec::with_capacity(bindings.len()); + let mut previous = Vec::with_capacity(bindings.len()); + for binding in bindings { + let id = fresh.fresh()?; + previous.push((binding.binder.id, locals.insert(binding.binder.id, id))); + renamed.push(id); + } + let bindings = bindings + .iter() + .zip(renamed) + .map(|(binding, id)| { + Some(Binding { + binder: crate::Binder { + id, + name: binding.binder.name.clone(), + ty: binding.binder.ty, + span: binding.binder.span, + }, + quantified: binding.quantified.clone(), + value: clone_expr(&binding.value, fresh, locals)?, + span: binding.span, + }) + }) + .collect::>>()?; + let body = clone_expr(body, fresh, locals)?; + restore_locals(locals, previous); + ExprKind::Let { + bindings, + body: Box::new(body), + } + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => ExprKind::If { + condition: Box::new(clone_expr(condition, fresh, locals)?), + then_branch: Box::new(clone_expr(then_branch, fresh, locals)?), + else_branch: Box::new(clone_expr(else_branch, fresh, locals)?), + }, + ExprKind::Case { + scrutinee, + branches, + } => ExprKind::Case { + scrutinee: Box::new(clone_expr(scrutinee, fresh, locals)?), + branches: branches + .iter() + .map(|branch| { + let mut previous = Vec::new(); + let pattern = clone_pattern(&branch.pattern, fresh, locals, &mut previous)?; + let value = clone_expr(&branch.value, fresh, locals)?; + restore_locals(locals, previous); + Some(CaseBranch { + pattern, + value, + span: branch.span, + coverage: branch.coverage, + }) + }) + .collect::>>()?, + }, + }; + Some(Expr { + kind, + ty: expression.ty, + span: expression.span, + }) +} + +fn clone_pattern( + pattern: &Pattern, + fresh: &mut FreshLocals, + locals: &mut HashMap, + previous: &mut Vec<(LocalId, Option)>, +) -> Option { + let kind = match &pattern.kind { + PatternKind::Wildcard => PatternKind::Wildcard, + PatternKind::Literal { value } => PatternKind::Literal { + value: value.clone(), + }, + PatternKind::Array { elements } => PatternKind::Array { + elements: elements + .iter() + .map(|element| clone_pattern(element, fresh, locals, previous)) + .collect::>>()?, + }, + PatternKind::Named { id, pattern } => { + let renamed = fresh.fresh()?; + previous.push((*id, locals.insert(*id, renamed))); + PatternKind::Named { + id: renamed, + pattern: Box::new(clone_pattern(pattern, fresh, locals, previous)?), + } + } + PatternKind::Var { id, ty } => { + let renamed = fresh.fresh()?; + previous.push((*id, locals.insert(*id, renamed))); + PatternKind::Var { + id: renamed, + ty: *ty, + } + } + PatternKind::Constructor { symbol, arguments } => PatternKind::Constructor { + symbol: *symbol, + arguments: arguments + .iter() + .map(|argument| clone_pattern(argument, fresh, locals, previous)) + .collect::>>()?, + }, + PatternKind::Record { fields } => PatternKind::Record { + fields: fields + .iter() + .map(|(label, pattern)| { + Some(( + label.clone(), + clone_pattern(pattern, fresh, locals, previous)?, + )) + }) + .collect::>>()?, + }, + }; + Some(Pattern { + kind, + ty: pattern.ty, + span: pattern.span, + }) +} + +fn restore_local(locals: &mut HashMap, id: LocalId, previous: Option) { + if let Some(previous) = previous { + locals.insert(id, previous); + } else { + locals.remove(&id); + } +} + +fn restore_locals( + locals: &mut HashMap, + previous: Vec<(LocalId, Option)>, +) { + for (id, old) in previous.into_iter().rev() { + restore_local(locals, id, old); + } +} diff --git a/crates/psrs-core/src/locals.rs b/crates/psrs-core/src/locals/mod.rs similarity index 98% rename from crates/psrs-core/src/locals.rs rename to crates/psrs-core/src/locals/mod.rs index 699d7029..39298d26 100644 --- a/crates/psrs-core/src/locals.rs +++ b/crates/psrs-core/src/locals/mod.rs @@ -1,4 +1,7 @@ //! Shared collision-free local allocation for Core rewrites. +mod alpha; +pub(crate) use alpha::clone_with_fresh_locals; + use crate::{Expr, ExprKind, LocalId, Pattern, PatternKind}; use std::collections::HashSet; diff --git a/crates/psrs-core/src/lower/dictionary.rs b/crates/psrs-core/src/lower/dictionary.rs index 91952f02..ee2e6c31 100644 --- a/crates/psrs-core/src/lower/dictionary.rs +++ b/crates/psrs-core/src/lower/dictionary.rs @@ -29,16 +29,46 @@ pub(super) fn lower_evidence( // dictionary type the evidence already carries. ExprKind::Record { fields: Vec::new() } } - EvidenceKind::Superclass { parent, field } => ExprKind::FieldAccess { - record: Box::new(lower_evidence( - parent, - types, - externals, - constructors, - context, - )?), - field: field.clone(), - }, + EvidenceKind::Superclass { parent, field } => { + let fields = psrs_thir::record_fields(types, parent.ty).ok_or(LowerError { + span, + message: "superclass evidence parent is not a dictionary record", + })?; + let field_type = fields + .iter() + .find(|(label, _)| label == field) + .map(|(_, ty)| *ty) + .ok_or(LowerError { + span, + message: "superclass dictionary has no selected field", + })?; + let (parameter, _) = psrs_thir::arrow_parts(types, field_type).ok_or(LowerError { + span, + message: "superclass dictionary field is not a thunk", + })?; + let function = Expr { + kind: ExprKind::FieldAccess { + record: Box::new(lower_evidence( + parent, + types, + externals, + constructors, + context, + )?), + field: field.clone(), + }, + ty: TypeId(field_type.0), + span, + }; + ExprKind::Application( + Box::new(function), + Box::new(Expr { + kind: ExprKind::Unit, + ty: TypeId(parameter.0), + span, + }), + ) + } EvidenceKind::Instance { constructor, constructor_type, diff --git a/crates/psrs-core/src/opt/inline/alpha.rs b/crates/psrs-core/src/opt/inline/alpha.rs index 8f4484f3..375f6a04 100644 --- a/crates/psrs-core/src/opt/inline/alpha.rs +++ b/crates/psrs-core/src/opt/inline/alpha.rs @@ -1,238 +1 @@ -use super::super::util::FreshLocals; -use crate::{Binding, CaseBranch, Expr, ExprKind, Pattern, PatternKind}; -use psrs_hir::LocalId; -use std::collections::HashMap; - -pub(super) fn clone_with_fresh_locals(expression: &Expr, fresh: &mut FreshLocals) -> Option { - clone_expr(expression, fresh, &mut HashMap::new()) -} - -fn clone_expr( - expression: &Expr, - fresh: &mut FreshLocals, - locals: &mut HashMap, -) -> Option { - let kind = match &expression.kind { - ExprKind::Local(id) => ExprKind::Local(locals.get(id).copied().unwrap_or(*id)), - ExprKind::Global(symbol) => ExprKind::Global(*symbol), - ExprKind::Constructor { symbol, arguments } => ExprKind::Constructor { - symbol: *symbol, - arguments: arguments - .iter() - .map(|argument| clone_expr(argument, fresh, locals)) - .collect::>>()?, - }, - ExprKind::IntrinsicCall { - intrinsic, - arguments, - } => ExprKind::IntrinsicCall { - intrinsic: *intrinsic, - arguments: arguments - .iter() - .map(|argument| clone_expr(argument, fresh, locals)) - .collect::>>()?, - }, - ExprKind::Integer(value) => ExprKind::Integer(*value), - ExprKind::Number(value) => ExprKind::Number(value.clone()), - ExprKind::Boolean(value) => ExprKind::Boolean(*value), - ExprKind::String(value) => ExprKind::String(value.clone()), - ExprKind::Char(value) => ExprKind::Char(*value), - ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, - ExprKind::Trap => ExprKind::Trap, - ExprKind::Array { elements } => ExprKind::Array { - elements: elements - .iter() - .map(|element| clone_expr(element, fresh, locals)) - .collect::>>()?, - }, - ExprKind::Record { fields } => ExprKind::Record { - fields: fields - .iter() - .map(|(label, value)| Some((label.clone(), clone_expr(value, fresh, locals)?))) - .collect::>>()?, - }, - ExprKind::RecordUpdate { record, fields } => ExprKind::RecordUpdate { - record: Box::new(clone_expr(record, fresh, locals)?), - fields: fields - .iter() - .map(|(label, value)| Some((label.clone(), clone_expr(value, fresh, locals)?))) - .collect::>>()?, - }, - ExprKind::FieldAccess { record, field } => ExprKind::FieldAccess { - record: Box::new(clone_expr(record, fresh, locals)?), - field: field.clone(), - }, - ExprKind::RepresentationCast { - value, - source_type, - target_type, - } => ExprKind::RepresentationCast { - value: Box::new(clone_expr(value, fresh, locals)?), - source_type: *source_type, - target_type: *target_type, - }, - ExprKind::Application(function, argument) => ExprKind::Application( - Box::new(clone_expr(function, fresh, locals)?), - Box::new(clone_expr(argument, fresh, locals)?), - ), - ExprKind::Lambda { binder, body } => { - let renamed = fresh.fresh()?; - let previous = locals.insert(binder.id, renamed); - let body = clone_expr(body, fresh, locals)?; - restore_local(locals, binder.id, previous); - ExprKind::Lambda { - binder: crate::Binder { - id: renamed, - name: binder.name.clone(), - ty: binder.ty, - span: binder.span, - }, - body: Box::new(body), - } - } - ExprKind::Let { bindings, body } => { - let mut renamed = Vec::with_capacity(bindings.len()); - let mut previous = Vec::with_capacity(bindings.len()); - for binding in bindings { - let id = fresh.fresh()?; - previous.push((binding.binder.id, locals.insert(binding.binder.id, id))); - renamed.push(id); - } - let bindings = bindings - .iter() - .zip(renamed) - .map(|(binding, id)| { - Some(Binding { - binder: crate::Binder { - id, - name: binding.binder.name.clone(), - ty: binding.binder.ty, - span: binding.binder.span, - }, - quantified: binding.quantified.clone(), - value: clone_expr(&binding.value, fresh, locals)?, - span: binding.span, - }) - }) - .collect::>>()?; - let body = clone_expr(body, fresh, locals)?; - restore_locals(locals, previous); - ExprKind::Let { - bindings, - body: Box::new(body), - } - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => ExprKind::If { - condition: Box::new(clone_expr(condition, fresh, locals)?), - then_branch: Box::new(clone_expr(then_branch, fresh, locals)?), - else_branch: Box::new(clone_expr(else_branch, fresh, locals)?), - }, - ExprKind::Case { - scrutinee, - branches, - } => ExprKind::Case { - scrutinee: Box::new(clone_expr(scrutinee, fresh, locals)?), - branches: branches - .iter() - .map(|branch| { - let mut previous = Vec::new(); - let pattern = clone_pattern(&branch.pattern, fresh, locals, &mut previous)?; - let value = clone_expr(&branch.value, fresh, locals)?; - restore_locals(locals, previous); - Some(CaseBranch { - pattern, - value, - span: branch.span, - coverage: branch.coverage, - }) - }) - .collect::>>()?, - }, - }; - Some(Expr { - kind, - ty: expression.ty, - span: expression.span, - }) -} - -fn clone_pattern( - pattern: &Pattern, - fresh: &mut FreshLocals, - locals: &mut HashMap, - previous: &mut Vec<(LocalId, Option)>, -) -> Option { - let kind = match &pattern.kind { - PatternKind::Wildcard => PatternKind::Wildcard, - PatternKind::Literal { value } => PatternKind::Literal { - value: value.clone(), - }, - PatternKind::Array { elements } => PatternKind::Array { - elements: elements - .iter() - .map(|element| clone_pattern(element, fresh, locals, previous)) - .collect::>>()?, - }, - PatternKind::Named { id, pattern } => { - let renamed = fresh.fresh()?; - previous.push((*id, locals.insert(*id, renamed))); - PatternKind::Named { - id: renamed, - pattern: Box::new(clone_pattern(pattern, fresh, locals, previous)?), - } - } - PatternKind::Var { id, ty } => { - let renamed = fresh.fresh()?; - previous.push((*id, locals.insert(*id, renamed))); - PatternKind::Var { - id: renamed, - ty: *ty, - } - } - PatternKind::Constructor { symbol, arguments } => PatternKind::Constructor { - symbol: *symbol, - arguments: arguments - .iter() - .map(|argument| clone_pattern(argument, fresh, locals, previous)) - .collect::>>()?, - }, - PatternKind::Record { fields } => PatternKind::Record { - fields: fields - .iter() - .map(|(label, pattern)| { - Some(( - label.clone(), - clone_pattern(pattern, fresh, locals, previous)?, - )) - }) - .collect::>>()?, - }, - }; - Some(Pattern { - kind, - ty: pattern.ty, - span: pattern.span, - }) -} - -fn restore_local(locals: &mut HashMap, id: LocalId, previous: Option) { - if let Some(previous) = previous { - locals.insert(id, previous); - } else { - locals.remove(&id); - } -} - -fn restore_locals( - locals: &mut HashMap, - previous: Vec<(LocalId, Option)>, -) { - for (id, old) in previous.into_iter().rev() { - restore_local(locals, id, old); - } -} +pub(super) use crate::locals::clone_with_fresh_locals; diff --git a/crates/psrs-core/src/opt/specialize/types/mod.rs b/crates/psrs-core/src/opt/specialize/types/mod.rs index 17601f3a..ac373c5c 100644 --- a/crates/psrs-core/src/opt/specialize/types/mod.rs +++ b/crates/psrs-core/src/opt/specialize/types/mod.rs @@ -1,5 +1,3 @@ -mod substitution; - use crate::{Declaration, Module, Type, TypeConstructor, TypeId}; use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; @@ -52,7 +50,7 @@ pub(super) fn match_instantiation( Some((replacements, key)) } -pub(super) use substitution::instantiate_declaration; +pub(super) use crate::instantiation::substitution::instantiate_declaration; fn type_key(module: &Module, id: TypeId, active: &mut HashSet) -> Option { if !active.insert(id) { diff --git a/crates/psrs-core/src/primitive.rs b/crates/psrs-core/src/primitive.rs index 643544e9..2a1040e7 100644 --- a/crates/psrs-core/src/primitive.rs +++ b/crates/psrs-core/src/primitive.rs @@ -4,10 +4,40 @@ //! must use the checked type at each occurrence; adapting a polymorphic array //! wrapper by copying its inputs would change mutation and reference identity. use crate::locals::FreshLocals; -use crate::{Binder, Expr, ExprKind, Module, Type, VerifyError, arrow_parts, scheme_parts}; +use crate::{Binder, Expr, ExprKind, Module, Type, TypeId, VerifyError, arrow_parts, scheme_parts}; use psrs_hir::{Intrinsic, SymbolId}; +use psrs_span::TextRange; use std::collections::HashMap; +/// The value operation of a checked explicit primitive. Unsafe coercion is a +/// representation boundary, matching source coercion lowering, not a target +/// arithmetic instruction. The caller validates its signature and operands. +pub fn primitive_value( + intrinsic: Intrinsic, + arguments: Vec, + result: TypeId, + span: TextRange, +) -> Expr { + let kind = if intrinsic == Intrinsic::UnsafeCoerce && arguments.len() == 1 { + let value = arguments.into_iter().next().expect("one checked operand"); + ExprKind::RepresentationCast { + source_type: value.ty, + target_type: result, + value: Box::new(value), + } + } else { + ExprKind::IntrinsicCall { + intrinsic, + arguments, + } + }; + Expr { + kind, + ty: result, + span, + } +} + /// The caller supplies verified Core and validated operation identities. Work /// on a candidate and verify the complete result before publishing it; failures /// may leave this candidate partially rewritten. @@ -60,21 +90,19 @@ fn rewrite( parameters.push((binder, cursor)); cursor = result; } - let mut body = Expr { - kind: ExprKind::IntrinsicCall { - intrinsic: *intrinsic, - arguments: parameters - .iter() - .map(|(binder, _)| Expr { - kind: ExprKind::Local(binder.id), - ty: binder.ty, - span: expression.span, - }) - .collect(), - }, - ty: cursor, - span: expression.span, - }; + let mut body = primitive_value( + *intrinsic, + parameters + .iter() + .map(|(binder, _)| Expr { + kind: ExprKind::Local(binder.id), + ty: binder.ty, + span: expression.span, + }) + .collect(), + cursor, + expression.span, + ); for (binder, ty) in parameters.into_iter().rev() { body = Expr { kind: ExprKind::Lambda { diff --git a/crates/psrs-core/src/tests/dictionaries.rs b/crates/psrs-core/src/tests/dictionaries.rs index 1cbf9d06..782d3e0b 100644 --- a/crates/psrs-core/src/tests/dictionaries.rs +++ b/crates/psrs-core/src/tests/dictionaries.rs @@ -56,9 +56,12 @@ fn lowering_erases_instance_and_superclass_evidence_to_calls_and_projections() { ]; let i32_to_boolean = push_arrow(&mut types, thir::TypeId(0), thir::TypeId(1)); let dictionary = push_record(&mut types, vec![("isPositive", i32_to_boolean)]); + let unit = thir::TypeId(types.len() as u32); + types.push(thir::Type::Constructor(thir::TypeConstructor::Unit)); + let superclass_thunk = push_arrow(&mut types, unit, dictionary); let parent_dictionary = push_record( &mut types, - vec![("rank", thir::TypeId(0)), ("super", dictionary)], + vec![("rank", thir::TypeId(0)), ("super", superclass_thunk)], ); let identity_type = push_arrow(&mut types, parent_dictionary, parent_dictionary); let main_type = push_arrow(&mut types, parent_dictionary, thir::TypeId(1)); @@ -183,8 +186,12 @@ fn lowering_erases_instance_and_superclass_evidence_to_calls_and_projections() { panic!("expected method selection to be an ordinary field projection"); }; assert_eq!(field, "isPositive"); - let ExprKind::FieldAccess { record, field } = &record.kind else { - panic!("expected superclass evidence to be an ordinary field projection"); + let ExprKind::Application(thunk, unit) = &record.kind else { + panic!("expected superclass selection to force its thunk"); + }; + assert!(matches!(unit.kind, ExprKind::Unit)); + let ExprKind::FieldAccess { record, field } = &thunk.kind else { + panic!("expected superclass selection to project its thunk"); }; assert_eq!(field, "super"); assert!(matches!(record.kind, ExprKind::Application(_, _))); diff --git a/crates/psrs-core/src/tests/instantiation.rs b/crates/psrs-core/src/tests/instantiation.rs index 853bea9f..c9961161 100644 --- a/crates/psrs-core/src/tests/instantiation.rs +++ b/crates/psrs-core/src/tests/instantiation.rs @@ -121,6 +121,7 @@ fn constructor_binding_rejects_unsolved_variables_and_cycles() { let solved_module = bare(types); let solved = Instantiation { module: &solved_module, + rows: HashMap::new(), replacements: HashMap::from([(variable, function_int)]), }; assert_eq!( @@ -130,6 +131,7 @@ fn constructor_binding_rejects_unsolved_variables_and_cycles() { let unsolved = Instantiation { module: &solved_module, + rows: HashMap::new(), replacements: HashMap::from([(variable, TypeId(1))]), }; assert_eq!(unsolved.constructor(variable), None); @@ -137,6 +139,7 @@ fn constructor_binding_rejects_unsolved_variables_and_cycles() { let cyclic_module = bare(vec![Type::Application(TypeId(0), TypeId(0))]); let cyclic = Instantiation { module: &cyclic_module, + rows: HashMap::new(), replacements: HashMap::from([(variable, TypeId(0))]), }; assert_eq!(cyclic.constructor(variable), None); @@ -190,3 +193,44 @@ fn type_level_literals_match_by_value_in_invariant_applications() { ); } } + +#[test] +fn row_evidence_retains_residuals_without_an_arena_node() { + let variable = TypeVariableId(40); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::RowEmpty, + Type::Variable(variable), + Type::Constructor(TypeConstructor::Record), + ]; + let generic_row = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: "b".into(), + ty: TypeId(0), + tail: TypeId(2), + }); + let generic = apply(&mut types, TypeId(3), generic_row); + let mut row = TypeId(1); + for label in ["c", "b", "a"] { + let id = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: label.into(), + ty: TypeId(0), + tail: row, + }); + row = id; + } + let concrete = apply(&mut types, TypeId(3), row); + let module = bare(types); + let evidence = module + .checked_instantiation(generic, &[variable], concrete) + .unwrap(); + let residual = evidence.row(variable).unwrap(); + assert_eq!( + residual.fields, + vec![("a".into(), TypeId(0)), ("c".into(), TypeId(0))] + ); + assert_eq!(residual.tail, None); + assert_eq!(evidence.constructor(variable), None); + assert_eq!(evidence.row(TypeVariableId(41)).map(|row| row.fields), None); +} diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index a43961b8..43f35ea8 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -29,8 +29,14 @@ pub(super) fn scoped_expr( // check, and neither mentions a binder. ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} ExprKind::Constructor { arguments, .. } => { + // Constructor lowering collapses a THIR application spine. Its + // result quantifiers still bind the corresponding free variables + // in instantiated constructor fields, just as for Application. + let binders = leading_foralls(module, expression.ty); for argument in arguments { - scoped_expr(argument, module, scope, errors); + let mut argument_scope = scope.clone(); + open_child_binders(argument, &binders, module, &mut argument_scope, errors); + scoped_expr(argument, module, &mut argument_scope, errors); } } ExprKind::IntrinsicCall { arguments, .. } => { diff --git a/crates/psrs-core/src/verify/types/matching/evidence.rs b/crates/psrs-core/src/verify/types/matching/evidence.rs index b8ef9741..db40af70 100644 --- a/crates/psrs-core/src/verify/types/matching/evidence.rs +++ b/crates/psrs-core/src/verify/types/matching/evidence.rs @@ -23,5 +23,6 @@ pub(crate) fn instantiation<'a>( Some(Instantiation { module, replacements: matcher.replacements, + rows: matcher.row_forms, }) } diff --git a/crates/psrs-core/src/verify/types/matching/mod.rs b/crates/psrs-core/src/verify/types/matching/mod.rs index f0f64517..e7f23340 100644 --- a/crates/psrs-core/src/verify/types/matching/mod.rs +++ b/crates/psrs-core/src/verify/types/matching/mod.rs @@ -234,11 +234,11 @@ impl TypeMatcher<'_> { variables: expected_variables, body: expected_body, } = expected_type + && actual_variables.len() == expected_variables.len() { - if actual_variables.len() != expected_variables.len() - || actual_variables - .iter() - .any(|variable| self.alpha.contains_key(variable)) + if actual_variables + .iter() + .any(|variable| self.alpha.contains_key(variable)) { self.active .remove(&(Variance::Subsumption, actual, expected)); @@ -265,6 +265,12 @@ impl TypeMatcher<'_> { .remove(&(Variance::Subsumption, actual, expected)); return false; } + // A more general actual value can instantiate only some of its + // binders, retaining the expected rank-N universal. For example, + // `forall a b. (a -> b -> b) -> b -> f a -> b` can be used at + // `forall b. (Int -> b -> b) -> b -> f Int -> b`. Expected binders + // remain rigid in the recursive relation; their count is not an + // arity restriction on value subsumption. let added = actual_variables .iter() .copied() diff --git a/crates/psrs-core/src/verify/types/matching/rows.rs b/crates/psrs-core/src/verify/types/matching/rows.rs index 2d8d54f5..1464247f 100644 --- a/crates/psrs-core/src/verify/types/matching/rows.rs +++ b/crates/psrs-core/src/verify/types/matching/rows.rs @@ -5,12 +5,7 @@ use crate::{Type, TypeId, record_row}; use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; -/// A row variable instantiated to a residual that has no single type-table node. -#[derive(Clone, Debug)] -pub(super) struct RowForm { - fields: Vec<(String, TypeId)>, - tail: Option, -} +pub(super) use crate::instantiation::RowInstantiation as RowForm; enum TailKind { Closed, diff --git a/crates/psrs-driver/src/tests/declaration_calls.rs b/crates/psrs-driver/src/tests/declaration_calls.rs new file mode 100644 index 00000000..1c3a411d --- /dev/null +++ b/crates/psrs-driver/src/tests/declaration_calls.rs @@ -0,0 +1,200 @@ +use super::run_with_wasmtime; + +#[test] +fn an_explicit_partial_scope_returns_values_and_traps_on_missing_cases() { + for (argument, expected) in [("Just 42", Some(42)), ("Nothing", None)] { + let source = format!( + r#"module Main where +import Partial.Unsafe (unsafePartial) +data Maybe a = Nothing | Just a +extract :: Partial => Maybe Int -> Int +extract (Just x) = x +main :: Int +main = unsafePartial (extract ({argument})) +"# + ); + let Some(output) = run_with_wasmtime(&source) else { + return; + }; + if let Some(code) = expected { + assert_eq!(output.status.code(), Some(code), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); + } else { + assert!(!output.status.success(), "{output:?}"); + assert!( + String::from_utf8_lossy(&output.stderr).contains("unreachable"), + "{output:?}" + ); + } + } +} + +#[test] +fn partial_application_calls_the_declaration_and_then_its_returned_function() { + let source = r#"module Main where +data Box a = Box a +invoke :: forall a b c. Int -> Box (a -> b -> c) -> a -> b -> c +invoke _ (Box f) x y = f x y +add x y = intAdd x y +main :: Int +main = + let pending = invoke 0 + result = pending (Box add) 40 2 + in result +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn polymorphic_constructor_fields_keep_application_quantifier_scope() { + let source = r#"module Main where +data Maybe a = Nothing | Just a +newtype Parser a = Parser (Int -> Maybe a) +constant x _ = x +dictionary :: { empty :: forall a. Parser a } +dictionary = { empty: Parser (constant Nothing) } +main :: Int +main = case (dictionary.empty :: Parser Int) of + Parser p -> case p 0 of + Nothing -> 42 + Just _ -> 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn constructor_patterns_return_functions_at_the_checked_calling_boundary() { + let source = r#"module Main where +newtype Fn2 a b c = Fn2 (a -> b -> c) +runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c +runFn2 (Fn2 f) a b = f a b +alias = runFn2 +add x y = intAdd x y +main :: Int +main = + let wrapped = Fn2 add + partial = runFn2 wrapped 40 + returned = runFn2 wrapped + throughAlias = alias wrapped + in if booleanAnd (intEq (runFn2 wrapped 40 2) 42) + (booleanAnd (intEq (partial 2) 42) + (booleanAnd (intEq (returned 40 2) 42) + (intEq (throughAlias 40 2) 42))) then 42 else 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty(), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn superclass_dictionary_construction_is_delayed_until_selection() { + let source = r#"module Main where +class Base a where + base :: a -> Int +class Base a <= Child a where + child :: a -> Int +helper :: forall a. Child a => a -> Int +helper = child +instance baseInt :: Base Int where + base = helper +instance childInt :: Child Int where + child x = intAdd x 2 +main :: Int +main = base 40 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn abstract_array_constructor_transport_converts_element_storage() { + let source = r#"module Main where +class Build f where + build :: forall a. Array a -> f a + consume :: forall a. f a -> Array a +instance buildArray :: Build Array where + build xs = xs + consume xs = xs +roundTrip :: forall f. Build f => f Int -> Array Int +roundTrip = consume +main :: Int +main = case (roundTrip (build [42] :: Array Int)) of + [x] -> x + _ -> 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn generic_value_slots_preserve_nested_array_element_protocols() { + let source = r#"module Main where +data Box a = Box a +box :: forall a. a -> Box a +box x = Box x +hold :: forall a. Array a -> Box (Array a) +hold xs = box xs +main :: Int +main = case hold [[42]] of + Box [[x]] -> x + _ -> 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn closed_uses_of_a_local_row_lambda_keep_distinct_fields_and_captures() { + let source = r#"module Main where +main :: Int +main = + let captured = 2 + select :: forall r. { value :: Int | r } -> Int + select { value: x } = intAdd x captured + first = select { value: 20, left: true } + second = select { value: 18, right: [1,2] } + in intAdd first second +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn generic_value_slots_preserve_records_with_array_fields() { + let source = r#"module Main where +data Box a = Box a +box :: forall a. a -> Box a +box x = Box x +hold :: forall a. Array a -> Box { head :: a, tail :: Array a } +hold xs = box { head: arrayIndex xs 0, tail: xs } +main :: Int +main = case hold [42] of + Box record -> if intEq record.head (arrayIndex record.tail 0) then record.head else 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/dictionary_audit/negative.rs b/crates/psrs-driver/src/tests/dictionary_audit/negative.rs index 27f37ea7..28b3fae8 100644 --- a/crates/psrs-driver/src/tests/dictionary_audit/negative.rs +++ b/crates/psrs-driver/src/tests/dictionary_audit/negative.rs @@ -35,11 +35,14 @@ impl Types { thir::Type::RowEmpty, thir::Type::RowExtend { label: "isPositive".into(), - ty: self.method, + ty: thir::TypeId(11), tail: thir::TypeId(5), }, thir::Type::Constructor(thir::TypeConstructor::Record), thir::Type::Application(thir::TypeId(7), thir::TypeId(6)), + thir::Type::Constructor(thir::TypeConstructor::Unit), + thir::Type::Application(thir::TypeId(2), thir::TypeId(9)), + thir::Type::Application(thir::TypeId(10), self.method), ] } } diff --git a/crates/psrs-driver/src/tests/library_foreign.rs b/crates/psrs-driver/src/tests/library_foreign.rs index 8954dbaf..f55a6254 100644 --- a/crates/psrs-driver/src/tests/library_foreign.rs +++ b/crates/psrs-driver/src/tests/library_foreign.rs @@ -112,3 +112,18 @@ fn an_unimplemented_library_foreign_value_is_an_explicit_linking_error() { "{errors:?}" ); } + +#[test] +fn an_unused_static_library_import_does_not_require_a_target_implementation() { + let sources = [ + ( + "Native.purs", + "module Native where\nforeign import missing :: Int -> Int\nanswer :: Int\nanswer = 42\n", + ), + ( + "Main.purs", + "module Main where\nimport Native\nmain = answer\n", + ), + ]; + crate::compile_program_sources(&sources).expect("only reached static imports require linking"); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 5f189c25..d0aa52df 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -9,6 +9,7 @@ mod closure_protocol; mod coercion; mod data_function; mod data_tuple; +mod declaration_calls; mod deriving; mod diagnosis_trace; mod effect_arity; diff --git a/crates/psrs-driver/src/tests/primitive_foreign.rs b/crates/psrs-driver/src/tests/primitive_foreign.rs index 7e041989..fbda1c31 100644 --- a/crates/psrs-driver/src/tests/primitive_foreign.rs +++ b/crates/psrs-driver/src/tests/primitive_foreign.rs @@ -458,6 +458,19 @@ fn library_array_operations_match_pinned_official_observations() { assert_eq!(output.status.code(), Some(42), "{output:?}"); } +#[test] +fn library_array_callbacks_match_pinned_official_observations() { + let source = include_str!("../../tests/fixtures/stdlib-array-callbacks/Main.purs"); + let Some(output) = run_library_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!( + output.stdout.is_empty() && output.stderr.is_empty(), + "{output:?}" + ); +} + #[test] fn library_array_extend_matches_pinned_official_observations() { let golden = include_str!("../../tests/fixtures/stdlib-array-extend/Golden.purs"); diff --git a/crates/psrs-driver/tests/fixtures/stdlib-array-callbacks/Main.purs b/crates/psrs-driver/tests/fixtures/stdlib-array-callbacks/Main.purs new file mode 100644 index 00000000..550573f8 --- /dev/null +++ b/crates/psrs-driver/tests/fixtures/stdlib-array-callbacks/Main.purs @@ -0,0 +1,53 @@ +module Main where +import PSRS.Array as A +main = + let + state0 = arrayFill 2 0 + visit0 x = let counted = arrayWrite state0 0 (intAdd (arrayIndex state0 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result0 = A.filterImpl (\x -> let next = visit0 x in if intLt 0 (arrayIndex next 0) then intLt 1 x else false) ([1, 2, 3] :: Array Int) + state1 = arrayFill 2 0 + visit1 x = let counted = arrayWrite state1 0 (intAdd (arrayIndex state1 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result1 = A.filterImpl (\x -> let next = visit1 x in if intLt 0 (arrayIndex next 0) then intLt 0 x else false) ([1, 2, 3] :: Array Int) + state2 = arrayFill 2 0 + visit2 x = let counted = arrayWrite state2 0 (intAdd (arrayIndex state2 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result2 = A.filterImpl (\x -> let next = visit2 x in if intLt 0 (arrayIndex next 0) then intLt 9 x else false) ([1, 2, 3] :: Array Int) + state3 = arrayFill 2 0 + visit3 x = let counted = arrayWrite state3 0 (intAdd (arrayIndex state3 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result3 = A.filterImpl (\x -> let next = visit3 x in if intLt 0 (arrayIndex next 0) then intLt 0 x else false) ([] :: Array Int) + state4 = arrayFill 2 0 + visit4 x = let counted = arrayWrite state4 0 (intAdd (arrayIndex state4 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result4 = A.partitionImpl (\x -> let next = visit4 x in if intLt 0 (arrayIndex next 0) then intLt 1 x else false) ([1, 2, 3] :: Array Int) + state5 = arrayFill 2 0 + visit5 x = let counted = arrayWrite state5 0 (intAdd (arrayIndex state5 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result5 = A.partitionImpl (\x -> let next = visit5 x in if intLt 0 (arrayIndex next 0) then intLt 0 x else false) ([1, 2, 3] :: Array Int) + state6 = arrayFill 2 0 + visit6 x = let counted = arrayWrite state6 0 (intAdd (arrayIndex state6 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result6 = A.partitionImpl (\x -> let next = visit6 x in if intLt 0 (arrayIndex next 0) then intLt 9 x else false) ([1, 2, 3] :: Array Int) + state7 = arrayFill 2 0 + visit7 x = let counted = arrayWrite state7 0 (intAdd (arrayIndex state7 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result7 = A.partitionImpl (\x -> let next = visit7 x in if intLt 0 (arrayIndex next 0) then intLt 0 x else false) ([] :: Array Int) + state8 = arrayFill 2 0 + visit8 x = let counted = arrayWrite state8 0 (intAdd (arrayIndex state8 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result8 = A.zipWithImpl (\x y -> let next = visit8 x in intAdd (intMul (arrayIndex next 0) 0) (intAdd x y)) ([1, 2, 3] :: Array Int) ([10, 20] :: Array Int) + state9 = arrayFill 2 0 + visit9 x = let counted = arrayWrite state9 0 (intAdd (arrayIndex state9 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result9 = A.zipWithImpl (\x y -> let next = visit9 x in intAdd (intMul (arrayIndex next 0) 0) (intAdd x y)) ([1] :: Array Int) ([10, 20] :: Array Int) + state10 = arrayFill 2 0 + visit10 x = let counted = arrayWrite state10 0 (intAdd (arrayIndex state10 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result10 = A.zipWithImpl (\x y -> let next = visit10 x in intAdd (intMul (arrayIndex next 0) 0) (intAdd x y)) ([] :: Array Int) ([10] :: Array Int) + state11 = arrayFill 2 0 + visit11 x = let counted = arrayWrite state11 0 (intAdd (arrayIndex state11 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result11 = A.zipWithImpl (\x y -> let next = visit11 x in intAdd (intMul (arrayIndex next 0) 0) (intAdd x y)) ([1] :: Array Int) ([] :: Array Int) + state12 = arrayFill 2 0 + visit12 x = let counted = arrayWrite state12 0 (intAdd (arrayIndex state12 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result12 = A.anyImpl (\x -> let next = visit12 x in if intLt 0 (arrayIndex next 0) then intLt 1 x else false) ([1, 2, 3] :: Array Int) + state13 = arrayFill 2 0 + visit13 x = let counted = arrayWrite state13 0 (intAdd (arrayIndex state13 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result13 = A.allImpl (\x -> let next = visit13 x in if intLt 0 (arrayIndex next 0) then intLt 1 x else false) ([3, 1, 2] :: Array Int) + state14 = arrayFill 2 0 + visit14 x = let counted = arrayWrite state14 0 (intAdd (arrayIndex state14 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result14 = A.anyImpl (\x -> let next = visit14 x in if intLt 0 (arrayIndex next 0) then intLt 0 x else false) ([] :: Array Int) + state15 = arrayFill 2 0 + visit15 x = let counted = arrayWrite state15 0 (intAdd (arrayIndex state15 0) 1) in arrayWrite counted 1 (intAdd (intMul (arrayIndex counted 1) 10) x) + result15 = A.allImpl (\x -> let next = visit15 x in if intLt 0 (arrayIndex next 0) then intLt 0 x else false) ([] :: Array Int) + in if (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength result0) 2) (intEq (arrayIndex result0 0) 2)) (booleanAnd (intEq (arrayIndex result0 1) 3) (intEq (arrayIndex state0 0) 3))) (booleanAnd (booleanAnd (intEq (arrayIndex state0 1) 123) (intEq (arrayLength result1) 3)) (booleanAnd (intEq (arrayIndex result1 0) 1) (intEq (arrayIndex result1 1) 2)))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex result1 2) 3) (intEq (arrayIndex state1 0) 3)) (booleanAnd (intEq (arrayIndex state1 1) 123) (intEq (arrayLength result2) 0))) (booleanAnd (booleanAnd (intEq (arrayIndex state2 0) 3) (intEq (arrayIndex state2 1) 123)) (booleanAnd (intEq (arrayLength result3) 0) (booleanAnd (intEq (arrayIndex state3 0) 0) (intEq (arrayIndex state3 1) 0)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength (result4).yes) 2) (intEq (arrayIndex (result4).yes 0) 2)) (booleanAnd (intEq (arrayIndex (result4).yes 1) 3) (intEq (arrayLength (result4).no) 1))) (booleanAnd (booleanAnd (intEq (arrayIndex (result4).no 0) 1) (intEq (arrayIndex state4 0) 3)) (booleanAnd (intEq (arrayIndex state4 1) 123) (intEq (arrayLength (result5).yes) 3)))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex (result5).yes 0) 1) (intEq (arrayIndex (result5).yes 1) 2)) (booleanAnd (intEq (arrayIndex (result5).yes 2) 3) (intEq (arrayLength (result5).no) 0))) (booleanAnd (booleanAnd (intEq (arrayIndex state5 0) 3) (intEq (arrayIndex state5 1) 123)) (booleanAnd (intEq (arrayLength (result6).yes) 0) (booleanAnd (intEq (arrayLength (result6).no) 3) (intEq (arrayIndex (result6).no 0) 1))))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayIndex (result6).no 1) 2) (intEq (arrayIndex (result6).no 2) 3)) (booleanAnd (intEq (arrayIndex state6 0) 3) (intEq (arrayIndex state6 1) 123))) (booleanAnd (booleanAnd (intEq (arrayLength (result7).yes) 0) (intEq (arrayLength (result7).no) 0)) (booleanAnd (intEq (arrayIndex state7 0) 0) (intEq (arrayIndex state7 1) 0)))) (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength result8) 2) (intEq (arrayIndex result8 0) 11)) (booleanAnd (intEq (arrayIndex result8 1) 22) (intEq (arrayIndex state8 0) 2))) (booleanAnd (booleanAnd (intEq (arrayIndex state8 1) 12) (intEq (arrayLength result9) 1)) (booleanAnd (intEq (arrayIndex result9 0) 11) (booleanAnd (intEq (arrayIndex state9 0) 1) (intEq (arrayIndex state9 1) 1)))))) (booleanAnd (booleanAnd (booleanAnd (booleanAnd (intEq (arrayLength result10) 0) (intEq (arrayIndex state10 0) 0)) (booleanAnd (intEq (arrayIndex state10 1) 0) (intEq (arrayLength result11) 0))) (booleanAnd (booleanAnd (intEq (arrayIndex state11 0) 0) (intEq (arrayIndex state11 1) 0)) (booleanAnd (booleanEq result12 true) (booleanAnd (intEq (arrayIndex state12 0) 2) (intEq (arrayIndex state12 1) 12))))) (booleanAnd (booleanAnd (booleanAnd (booleanEq result13 false) (intEq (arrayIndex state13 0) 2)) (booleanAnd (intEq (arrayIndex state13 1) 31) (booleanEq result14 false))) (booleanAnd (booleanAnd (intEq (arrayIndex state14 0) 0) (intEq (arrayIndex state14 1) 0)) (booleanAnd (booleanEq result15 true) (booleanAnd (intEq (arrayIndex state15 0) 0) (intEq (arrayIndex state15 1) 0)))))))) then 42 else 1 diff --git a/crates/psrs-hir/src/expr.rs b/crates/psrs-hir/src/expr.rs index 54d4c55b..e9191ada 100644 --- a/crates/psrs-hir/src/expr.rs +++ b/crates/psrs-hir/src/expr.rs @@ -148,6 +148,9 @@ pub enum CaseBranchCoverage { Guarded, /// A generated fallthrough or guard test is excluded from diagnostics. Generated, + /// A checked explicit `Partial` scope authorizes this generated trap + /// fallback. Source syntax and desugaring never produce this marker. + PartialFallback, } #[derive(Clone, Debug, PartialEq, Eq)] diff --git a/crates/psrs-resolve/src/resolver/names/util.rs b/crates/psrs-resolve/src/resolver/names/util.rs index c9514f88..f044fe53 100644 --- a/crates/psrs-resolve/src/resolver/names/util.rs +++ b/crates/psrs-resolve/src/resolver/names/util.rs @@ -23,10 +23,21 @@ pub(in crate::resolver) fn split_qualified(text: &str) -> Option<(&str, &str)> { return is_module_qualifier(qualifier) .then_some((qualifier, &text[index + 2..text.len() - 1])); } + // A symbolic member can itself contain dots. Walk module components + // from the left rather than mistaking the last operator dot for a separator. + for (index, _) in text.match_indices('.') { + let qualifier = &text[..index]; + let member = &text[index + 1..]; + if is_module_qualifier(qualifier) + && !member.is_empty() + && !member.chars().next().is_some_and(char::is_uppercase) + { + return Some((qualifier, member)); + } + } let index = text.rfind('.')?; - let qualifier = &text[..index]; - let member = &text[index + 1..]; - (is_module_qualifier(qualifier) && !member.is_empty()).then_some((qualifier, member)) + (is_module_qualifier(&text[..index]) && index + 1 < text.len()) + .then_some((&text[..index], &text[index + 1..])) } fn is_module_qualifier(qualifier: &str) -> bool { @@ -91,5 +102,9 @@ mod tests { split_qualified("Data.Int.Bits.(.&.)"), Some(("Data.Int.Bits", ".&.")) ); + assert_eq!(split_qualified("A..."), Some(("A", ".."))); + assert_eq!(split_qualified("Foo.Bar..&."), Some(("Foo.Bar", ".&."))); + assert_eq!(split_qualified("Data.Array"), Some(("Data", "Array"))); + assert_eq!(split_qualified("A."), None); } } diff --git a/crates/psrs-syntax/src/parser/expr/atom/mod.rs b/crates/psrs-syntax/src/parser/expr/atom/mod.rs index f17b12f9..1355f5f2 100644 --- a/crates/psrs-syntax/src/parser/expr/atom/mod.rs +++ b/crates/psrs-syntax/src/parser/expr/atom/mod.rs @@ -29,7 +29,7 @@ impl<'a> Parser<'a> { }; continue; } - if !self.starts_atom() { + if self.qualified_operator().is_some() || !self.starts_atom() { break; } let argument = self.parse_postfix_atom()?; @@ -306,6 +306,14 @@ impl<'a> Parser<'a> { self.bump(); let operator_token = self.current().clone(); let operator = match operator_token.kind { + LayoutTokenKind::Raw(RawTokenKind::Colon) => { + self.bump(); + ":".to_owned() + } + LayoutTokenKind::Raw(RawTokenKind::DotDot) => { + self.bump(); + "..".to_owned() + } LayoutTokenKind::Raw(RawTokenKind::Operator(text)) | LayoutTokenKind::Raw(RawTokenKind::LowerIdent(text)) | LayoutTokenKind::Raw(RawTokenKind::UpperIdent(text)) => { diff --git a/crates/psrs-syntax/src/parser/expr/atom/postfix.rs b/crates/psrs-syntax/src/parser/expr/atom/postfix.rs index a9b9c15f..e1221c0c 100644 --- a/crates/psrs-syntax/src/parser/expr/atom/postfix.rs +++ b/crates/psrs-syntax/src/parser/expr/atom/postfix.rs @@ -51,7 +51,11 @@ impl Parser<'_> { }; continue; } - if self.current().kind == LayoutTokenKind::Raw(RawTokenKind::LBrace) { + // Empty braces are a record argument, never a record update. + // Nonempty updates must contain at least one assignment. + if self.current().kind == LayoutTokenKind::Raw(RawTokenKind::LBrace) + && self.peek(1).kind != LayoutTokenKind::Raw(RawTokenKind::RBrace) + { let checkpoint = self.cursor; match self.parse_record_update(function.clone()) { Ok(updated) => { diff --git a/crates/psrs-syntax/src/parser/expr/mod.rs b/crates/psrs-syntax/src/parser/expr/mod.rs index 884f0b0c..1219dfe2 100644 --- a/crates/psrs-syntax/src/parser/expr/mod.rs +++ b/crates/psrs-syntax/src/parser/expr/mod.rs @@ -1,6 +1,7 @@ mod atom; mod compound; mod pattern; +mod qualified; use crate::{LayoutTokenKind, RawTokenKind}; use psrs_cst::{CstName, Expr, ExprKind}; @@ -68,6 +69,26 @@ impl<'a> Parser<'a> { left = combined; continue; } + if let Some((operator, precedence, tokens)) = self.qualified_operator() { + if precedence < min_precedence { + break; + } + for _ in 0..tokens { + self.bump(); + } + let right = + self.parse_expression_impl(precedence + 1, allow_backtick, allow_section)?; + let span = TextRange::new(left.span.start, right.span.end); + left = Expr { + kind: ExprKind::Operator { + operator, + left: Box::new(left), + right: Box::new(right), + }, + span, + }; + continue; + } let (operator, operator_span) = match &self.current().kind { LayoutTokenKind::Raw(RawTokenKind::Operator(operator)) if operator != "@" => { (operator.clone(), self.current().span) diff --git a/crates/psrs-syntax/src/parser/expr/qualified.rs b/crates/psrs-syntax/src/parser/expr/qualified.rs new file mode 100644 index 00000000..45b589d7 --- /dev/null +++ b/crates/psrs-syntax/src/parser/expr/qualified.rs @@ -0,0 +1,51 @@ +use super::*; + +impl Parser<'_> { + /// Recognizes a contiguous module qualifier followed by a symbolic name. + /// The lexer maximally munches the final dot with the operator (`A.!!`). + pub(super) fn qualified_operator(&self) -> Option<(CstName, u8, usize)> { + let LayoutTokenKind::Raw(RawTokenKind::UpperIdent(first)) = &self.current().kind else { + return None; + }; + let start = self.current().span.start; + let mut end = self.current().span.end; + let mut qualifier = first.clone(); + let mut offset = 1; + loop { + let token = self.peek(offset); + if token.span.start != end { + return None; + } + if token.kind == LayoutTokenKind::Raw(RawTokenKind::Dot) { + let part = self.peek(offset + 1); + if let LayoutTokenKind::Raw(RawTokenKind::UpperIdent(name)) = &part.kind { + if part.span.start != token.span.end { + return None; + } + qualifier.push('.'); + qualifier.push_str(name); + end = part.span.end; + offset += 2; + continue; + } + } + let text = match &token.kind { + LayoutTokenKind::Raw(RawTokenKind::Operator(text)) => text.as_str(), + LayoutTokenKind::Raw(RawTokenKind::DotDot) => "..", + _ => return None, + }; + let operator = text.strip_prefix('.')?; + if operator.is_empty() || operator == "@" { + return None; + } + return Some(( + CstName::new( + format!("{qualifier}.{operator}"), + TextRange::new(start, token.span.end), + ), + precedence(operator), + offset + 1, + )); + } + } +} diff --git a/crates/psrs-syntax/src/parser/tests.rs b/crates/psrs-syntax/src/parser/tests.rs index 9b0e4aab..5b5a9316 100644 --- a/crates/psrs-syntax/src/parser/tests.rs +++ b/crates/psrs-syntax/src/parser/tests.rs @@ -3,6 +3,23 @@ use crate::{add_layout, lex}; use psrs_cst::{Declaration, ExprKind, PatternKind, TypeExprKind, ValueRhs}; use psrs_span::SourceFile; +#[test] +fn parses_qualified_symbolic_operators_with_symbolic_dots_and_sections() { + let module = parse("module Main where\na = 2 A... 5\nb = 4 Foo.Bar.-#- 10\nc = (_ A.!! 1)\nd = (2 A.: _)\ne = A.(..) 2 5\nf = A.(:) 2 []\n").unwrap(); + for (declaration, expected) in module.declarations[..2].iter().zip(["A...", "Foo.Bar.-#-"]) { + let ExprKind::Operator { operator, .. } = &plain_value(as_value(declaration)).kind else { + panic!("expected qualified infix operator"); + }; + assert_eq!(operator.text, expected); + } + for declaration in &module.declarations[2..4] { + assert!(matches!( + plain_value(as_value(declaration)).kind, + ExprKind::OperatorSection { .. } + )); + } +} + fn parse(source: &str) -> Result { let source_file = SourceFile::new("test.purs", source); let (tokens, errors) = lex(source); @@ -449,3 +466,14 @@ fn record_projection_and_update_bind_before_value_application() { } } } + +#[test] +fn empty_braces_are_a_record_argument() { + let module = parse("module Main where\nforce action = action {}\n").unwrap(); + let expression = plain_value(as_value(&module.declarations[0])); + let ExprKind::Application(function, argument) = &expression.kind else { + panic!("expected an application: {expression:?}"); + }; + assert!(matches!(&function.kind, ExprKind::Name(name) if name.text == "action")); + assert!(matches!(&argument.kind, ExprKind::Record { fields, .. } if fields.is_empty())); +} diff --git a/crates/psrs-thir/src/evidence.rs b/crates/psrs-thir/src/evidence.rs index f9aaf506..d400a569 100644 --- a/crates/psrs-thir/src/evidence.rs +++ b/crates/psrs-thir/src/evidence.rs @@ -42,6 +42,7 @@ pub enum EvidenceKind { /// A dictionary value already bound by the class elaborator. Global(SymbolId), /// A dictionary obtained from a superclass field of another dictionary. + /// Selects and forces a checked Unit thunk in the parent dictionary. Superclass { parent: Box, field: String, diff --git a/crates/psrs-thir/src/tests.rs b/crates/psrs-thir/src/tests.rs index e0d20644..7e026bd4 100644 --- a/crates/psrs-thir/src/tests.rs +++ b/crates/psrs-thir/src/tests.rs @@ -233,11 +233,14 @@ fn verifier_accepts_alpha_equivalent_superclass_field_types() { Type::Application(TypeId(11), TypeId(10)), Type::RowExtend { label: "super".into(), - ty: TypeId(12), + ty: TypeId(18), tail: TypeId(0), }, Type::Constructor(TypeConstructor::Record), Type::Application(TypeId(14), TypeId(13)), + Type::Constructor(TypeConstructor::Unit), + Type::Application(TypeId(2), TypeId(16)), + Type::Application(TypeId(17), TypeId(12)), ], newtype_ids: Vec::new(), opaque_ids: Vec::new(), @@ -273,6 +276,15 @@ fn verifier_accepts_alpha_equivalent_superclass_field_types() { }; assert!(module.verify().is_ok()); + let mut invalid = module; + invalid.types[16] = Type::Constructor(TypeConstructor::Boolean); + assert!( + invalid + .verify() + .unwrap_err() + .iter() + .any(|error| error.message == "superclass evidence field has the wrong type") + ); } /// A module carrying `Proxy 1` and `Proxy 2` and one global reference at each. diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index ca1cd88c..8d08b9c0 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -278,7 +278,15 @@ fn verify_evidence(evidence: &Evidence, module: &Module, errors: &mut Vec {} + Some((_, field_ty)) + if crate::arrow_parts(types, *field_ty).is_some_and( + |(parameter, result)| { + matches!( + types.get(parameter.0 as usize), + Some(Type::Constructor(crate::TypeConstructor::Unit)) + ) && semantics::types_equal(result, evidence.ty, module) + }, + ) => {} _ => errors.push(VerifyError { span: evidence.span, message: "superclass evidence field has the wrong type", diff --git a/crates/psrs-typecheck/src/typecheck/classes/evidence/typing.rs b/crates/psrs-typecheck/src/typecheck/classes/evidence/typing.rs index a32b285e..da7ce507 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/evidence/typing.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/evidence/typing.rs @@ -49,7 +49,7 @@ impl Checker { } /// The dictionary record type for a class constraint: one field per - /// superclass (holding that superclass's dictionary) followed by one field + /// superclass (holding a Unit thunk for that superclass's dictionary) followed by one field /// per method, with the class parameters substituted. pub(in crate::typecheck) fn dictionary_type( &mut self, @@ -71,7 +71,10 @@ impl Checker { self.superclass_constraints(constraint.class_id, &constraint.arguments) { let field_ty = self.dictionary_type(&super_constraint); - fields.push((field, field_ty)); + fields.push(( + field, + arrow(InferType::Constructor(TypeConstructor::Unit), field_ty), + )); } for method in &class.methods { let mut method_variables = variables.clone(); diff --git a/crates/psrs-typecheck/src/typecheck/classes/instance.rs b/crates/psrs-typecheck/src/typecheck/classes/instance.rs index c399adc5..38abe7b8 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/instance.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/instance.rs @@ -101,11 +101,30 @@ impl Checker { { let super_dictionary = self.dictionary_type(&super_constraint); let wanted = self.push_wanted(super_constraint, super_dictionary.clone()); + // Superclass construction must be delayed: method closures may + // reference a subclass instance whose superclass is this instance. + let parameter = InferType::Constructor(TypeConstructor::Unit); + let id = LocalId(self.state.next_dictionary_local); + self.state.next_dictionary_local += 1; fields.push(( field, InferredExpr { - kind: InferredExprKind::Evidence(wanted), - ty: super_dictionary, + kind: InferredExprKind::Lambda { + binder: InferredBinder { + binder: LocalBinder { + id, + name: "superclass_unit".into(), + span: instance.span, + }, + scheme: Scheme::monomorphic(parameter.clone()), + }, + body: Box::new(InferredExpr { + kind: InferredExprKind::Evidence(wanted), + ty: super_dictionary.clone(), + span: instance.span, + }), + }, + ty: arrow(parameter, super_dictionary), span: instance.span, }, )); diff --git a/crates/psrs-typecheck/src/typecheck/infer/case.rs b/crates/psrs-typecheck/src/typecheck/infer/case.rs index e00e4bbe..8c7d76e2 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/case.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/case.rs @@ -40,6 +40,14 @@ impl Checker { let mut result_ty = expected; let mut inferred = Vec::with_capacity(branches.len()); for branch in branches { + if branch.coverage == hir::CaseBranchCoverage::PartialFallback { + self.state.errors.push(TypeCheckError::new( + TypeCheckErrorKind::InvalidHir, + branch.span, + "partial fallback authorization must be issued by type checking", + )); + return None; + } let mut inserted = Vec::new(); let pattern = self.check_pattern(&branch.pattern, &scrutinee.ty, &mut inserted)?; let value = self.infer_expr_with_expected(&branch.value, result_ty.clone())?; @@ -58,6 +66,37 @@ impl Checker { }); } let ty = result_ty.unwrap_or_else(|| self.fresh()); + // Report-only Partial has no runtime dictionary, but its checked + // authorization must survive erasure. Reuse the generated empty-case + // failure representation used by guard desugaring; the marked fallback + // contributes coverage and never hides redundant source alternatives. + if !branches.is_empty() + && self.scope.givens.iter().any(|(constraint, _)| { + constraint.class_id == hir::TypeId::PRIM_PARTIAL && constraint.arguments.is_empty() + }) + { + inferred.push(InferredCaseBranch { + pattern: InferredPattern { + kind: InferredPatternKind::Wildcard, + ty: scrutinee.ty.clone(), + span, + }, + value: InferredExpr { + kind: InferredExprKind::Case { + scrutinee: Box::new(InferredExpr { + kind: InferredExprKind::Integer(0), + ty: InferType::Constructor(TypeConstructor::Int), + span, + }), + branches: Vec::new(), + }, + ty: ty.clone(), + span, + }, + span, + coverage: hir::CaseBranchCoverage::PartialFallback, + }); + } Some(InferredExpr { kind: InferredExprKind::Case { scrutinee: Box::new(scrutinee), diff --git a/docs/design/D-17-stdlib-and-conformance-boundaries.md b/docs/design/D-17-stdlib-and-conformance-boundaries.md index d47dac4c..d85de9ca 100644 --- a/docs/design/D-17-stdlib-and-conformance-boundaries.md +++ b/docs/design/D-17-stdlib-and-conformance-boundaries.md @@ -18,6 +18,14 @@ Whole stdlib functions are not automatically intrinsic candidates. Library source changes cannot compensate for compiler defects. Follow the [source-fidelity contract](../workflow/stdlib-vendoring.md). +Executable Core linking retains static library foreign declarations and their +checked signatures only when reached from the entry, just as it retains ordinary +library values. A reached unimplemented binding remains a linking error. +Explicit primitive and WIT declarations retain source-wide protocol validation, +including unused declarations. This executable reachability contract does not +establish library support: inventories and public API execution cases must expose +missing implementations independently of dead-code removal. + `psrs-stdlib/tools/conformance.mjs` is a library-owned Node component. It compares source inventories, evaluates pinned upstream JavaScript implementations, and runs a compiler executable and Wasmtime. Inputs are package paths, manifests, diff --git a/docs/design/backend/fp/polymorphism-and-erasure.md b/docs/design/backend/fp/polymorphism-and-erasure.md index 8f57b915..54e33483 100644 --- a/docs/design/backend/fp/polymorphism-and-erasure.md +++ b/docs/design/backend/fp/polymorphism-and-erasure.md @@ -397,12 +397,11 @@ adapt(value, checked_boundary, producer_policy, consumer_requirement): report a source-spanned unsupported conversion ``` -Supplying a value to a bare erased parameter may erase an aggregate reference -without copying it, as in `Hold a`. Supplying it to a generic aggregate such -as `Array a` may need `AggregateConvert` first. Recovery from an erased ADT -field likewise depends on the declared field template: `a` can recover a -concrete reference directly, while `Array a` first recovers its canonical -array and then maps to a concrete array when required. Aggregate conversions +Supplying arrays and ordinary closed records to a bare erased parameter uses +their owner's canonical element or field protocol. Generic aggregate parameters +and erased ADT fields use the same recursive conversions. Recovery reads the +canonical storage before constructing the consumer's concrete layout. Nominal +references retain the identity policy established by their producer. Aggregate conversions are never implemented as `RepresentationCast`s between distinct nominal layouts. @@ -615,6 +614,21 @@ adapter is invoked, and each adapter call unboxes its argument exactly once. reach the ABI boundary; ABI adaptation happens on concrete canonical signatures only. +### Closed local row instantiations + +Before CC layout, checked nonrecursive local lambdas with row quantifiers may +be expanded at finite closed uses. The Core checking relation owns each row +solution, including residual fields with no existing type-arena node. Explicit +materialization appends row nodes without changing the source arena's existing +identities; capture-avoiding substitution discharges the scheme's quantifiers +and freshens local identities. This preparation is independent of optimization +budgets and preserves evaluation of captured computations. + +An unresolved use, recursive binding, or scheme with additional unresolved +quantifiers retains its full source scheme. Open runtime rows remain an explicit +unsupported layout; this preparation does not define an open-row ABI or narrow +the source model. Input and output Core verification remain mandatory. + ## Open questions and future work - **Dictionaries end to end.** Type-class elaboration must produce the diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index 73074b09..b85c3362 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -186,6 +186,26 @@ reachable representation and does not merge by physical shape. This preserves single erased layout for a parameterized data type. Open rows have no canonical product and remain unsupported. +### Aggregates in bare polymorphic slots + +The Array owner normalizes an array entering a bare variable or abstract Array +constructor slot to an array of non-null erased elements. The closed-record +owner normalizes a record to a product with the same ordered logical labels +and one non-null erased field per label. These protocols apply recursively to +nested arrays, records, and callable fields. Recovery first reads the owner's +canonical storage, then converts each element or field to the checked use +representation. A direct cast to the consumer's specialized aggregate layout +cannot establish this contract. + +Canonical protocols are registered by the layout owner for the aggregate +layouts a module contains before conversion planning; a module with no array or +record layout gains no protocol representation. Arrays and ordinary records have +no observable identity, so these conversions may construct new aggregates. +Mutable cells and other nominal references keep their owner's identity protocol; +they are not reconstructed as records. Checked storage primitives consume their +checked use representations before ABI erasure, preserving writes to the owning +storage object. + ### Bare polymorphic function slots A bare type variable stores functions using one registered unary protocol: @@ -487,8 +507,9 @@ cast is needed. array, and stores that reference in the variant's canonical field. `unwrap` reads the canonical layout directly, and the outer boundary maps it back to `Array Int`. No runtime tag and no nominal array cast is used. A bare-variable -field such as `data Hold a = Hold a` instead stores the concrete reference -directly in the erased slot and needs no array map. +field such as `data Hold a = Hold a` also uses the Array owner's erased-element +protocol when its checked value is an array. It maps specialized arrays before +storing them and maps them back on recovery. ## Boundaries and interfaces diff --git a/docs/design/backend/fp/type-classes-and-dictionaries.md b/docs/design/backend/fp/type-classes-and-dictionaries.md index d198156f..557cf499 100644 --- a/docs/design/backend/fp/type-classes-and-dictionaries.md +++ b/docs/design/backend/fp/type-classes-and-dictionaries.md @@ -61,9 +61,9 @@ Dict(C, a) = { m_1 : τ_1(a), ..., m_n : τ_n(a), - super_1 : Dict(S_1, a), + super_1 : Unit -> Dict(S_1, a), ..., - super_k : Dict(S_k, a), + super_k : Unit -> Dict(S_k, a), } ``` @@ -73,8 +73,12 @@ index, not by a target offset. An **instance** `instance C T` supplies one dictionary value of type `Dict(C, T)`: each method field is a closure (or the top-level method -implementation), and each superclass field is a dictionary value that the -instance provides. An instance with an **instance context**, such as +implementation), and each superclass field is a checked `Unit -> Dict(S_j, T)` thunk that +the instance provides. Construction must not evaluate these thunks: a method +implementation may reference a subclass instance whose superclass is this +instance. Eager superclass construction would make valid mutually referring +instance values recurse before any method executes. Selection forces the thunk +with the unique builtin `Unit` value. An instance with an **instance context**, such as `instance eqList :: Eq a => Eq (List a)`, is a function from its context dictionaries to its dictionary. @@ -182,13 +186,14 @@ Core lowering turns this evidence into dictionary values and projections: ```text lower_evidence(Given(local)) = local -lower_evidence(Superclass(parent, field)) = Project(field, lower_evidence(parent)) +lower_evidence(Superclass(parent, field)) = Apply(Project(field, lower_evidence(parent)), Unit) lower_evidence(Instance(instance, context)) = Apply(instance_dictionary_constructor(instance), map(lower_evidence, context)) ``` An instance dictionary constructor builds a record from its method values and -superclass dictionaries. A constrained declaration becomes a lambda over its +superclass thunks. THIR verification checks each thunk's Unit domain and selected +dictionary result; Core lowering emits ordinary projection and application. A constrained declaration becomes a lambda over its given dictionaries. Method and superclass field indices are fixed by the class record and checked by the Core and CC verifiers. This lowering cannot choose a different instance or resolve a new constraint. diff --git a/docs/implementation/stdlib/array-public-2026-10-07/report.md b/docs/implementation/stdlib/array-public-2026-10-07/report.md new file mode 100644 index 00000000..061040c3 --- /dev/null +++ b/docs/implementation/stdlib/array-public-2026-10-07/report.md @@ -0,0 +1,75 @@ +# Public `Data.Array` and mutable `Data.Array.ST` checkpoint + +This slice makes the public `Data.Array` API executable end to end and lands the +mutable `Data.Array.ST`/`Data.Array.ST.Partial` group. It extends the +[array operations](../array-operations-2026-10-06/report.md) and +[ST](../st-2026-10-06/report.md) checkpoints. The independent +`psrs-stdlib` revision is `332c69b16f240254f74375b7babed7f752f7361a` with content +fingerprint `fnv1a64-v1:f3b995062d3662ba`. + +The mutable array representation changes from an opaque foreign data type to +`newtype STArray h a = STArray (STRef h (Array a))`, an alias of the shared +`Control.Monad.ST.Internal` cell. Every `Data.Array.ST` foreign slot is replaced +by a source adapter over `PSRS.Array.Mutable`, which owns the fixed-length array +algorithms over the private `arrayFill`, `arrayWrite`, `arrayIndex`, +`arrayLength`, `arrayAppend` and integer primitives. `Data.Array.ST` keeps its +official signatures, exports and pure code; the rank-2 `shift`/`pop` observers +are wrapped through `mkSTFnN` and an `unsafeCoerce` bridge. + +Several compiler prerequisites are part of this slice rather than the library: + +- **Executable library reachability.** `Core::prune_unreachable` now drops a + static library import and its checked signature unless the executable + dependency graph reaches it, while explicit primitive and WIT declarations keep + their source-wide protocol validation. This is the contract recorded in + [D-17](../../../design/D-17-stdlib-and-conformance-boundaries.md). +- **`Unsafe.Coerce` as a checked primitive.** `Unsafe.Coerce` is a + compiler-provided module now; `unsafeCoerce` lowers to a checked + `RepresentationCast` instead of a source body that cannot compile. +- **Superclass dictionary thunks.** A superclass field is a `Unit -> Dict` + thunk, forced at selection, so mutually referring instance values no longer + recurse before a method runs. +- **Closed local row instantiations.** Checked row residuals are retained as + instantiation evidence even when they have no single type-arena node, and a + finite closed use of a nonrecursive row-polymorphic local lambda is + materialized before CC layout. The reusable type substitution moved to + `psrs-core::instantiation`. +- **Aggregate protocols for bare polymorphic slots.** The array and record + layout owners register canonical erased-element array and erased-field product + protocols before conversion planning; the array protocol is registered only + when an array layout exists. Newtype callable fields get their own protocol. +- **Partial authorization.** A checked report-only `Partial` scope adds a + marked trap fallback that survives erasure and contributes coverage instead of + hiding redundant source alternatives. +- **Qualified symbolic operators.** Contiguous module qualifiers followed by a + symbolic name resolve, so `Data.Array.(..)`, `A.:`, `A.!!` and + `Foo.Bar.-#-` parse, resolve and lower. + +Validation: + +- Mandatory Wasmtime driver regressions for the touched areas pass: + `library_array_callbacks_match_pinned_official_observations` (the new + sixteen-case/69-value callback fixture), the earlier apply/bind/extend/ST/ + uncurried/primitive array checks, `declaration_calls`, `library_foreign`, + `cc_ir_audit` and `generic_aggregate_audit`. +- Public API oracle: `conformance/array-public-cases.mjs` covers all 93 public + `Data.Array` exports with 105 cases and 396 checks. The library-owned + `array-public-oracle` command pinned all 41 upstream packages, evaluated the + pinned official JavaScript, and wrote `Main.purs`. The mandatory runner + compiled it on the target and executed the artifact under Wasmtime with exit + 42 and empty stdout/stderr. `public-run.json` records the binary/source/package + hashes and `observations.json` records the coverage. +- Library-owned Node tooling regressions: 8 passed. +- `cargo fmt --all --check` and `cargo clippy --workspace --all-targets -- -D + warnings` pass. + +The slice introduces no new driver-library failure: the driver suite returns to +its pre-slice set and the 174 cases this work unblocks stay green. The +`Data.Array.ST.Partial` missing final newline is repaired. + +Two limits are recorded rather than hidden. Open runtime rows remain an explicit +unsupported layout, so the same machinery does not define an open-row ABI. The +`Data.Show` foreign slots still have no target binding, so programs that reach +`show` fail at P8 library linking; that gap predates this slice and is unchanged. +The full reproducer was not re-measured, so no unsupported-library count is +published here. No push, PR or issue operation was performed. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 608f8674..177e89d1 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -85,3 +85,18 @@ node ../psrs-stdlib/tools/conformance.mjs run \ Both array algorithms are PureScript target library implementations. The oracle fixtures copy the official public signature and import that implementation; there is no whole-function compiler intrinsic for either operation. + +For array callback counts, visit order and short-circuiting: + +```sh +node ../psrs-stdlib/conformance/array-callbacks.mjs \ + /private/tmp/ps-pkgs/purescript-arrays /tmp/psrs-array-callback-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-array-callback-oracle/Main.purs \ + --out /tmp/psrs-array-callback-runtime +``` + +These observations execute target helpers. Public `Data.Array` wrapper execution +remains blocked by unsupported `Data.Array.ST` bindings in its import closure; +helper acceptance does not establish public API or whole-library acceptance. diff --git a/stdlib.lock.json b/stdlib.lock.json index 1791df4f..67344762 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "332c69b16f240254f74375b7babed7f752f7361a", - "source_fingerprint": "fnv1a64-v1:3ab22be17dbadc5c" + "revision": "01d6cd406cdce68a7ea1ec4c26a44793ead34571", + "source_fingerprint": "fnv1a64-v1:b2890fecd9c42aa3" } From d7af51470d6a755e067d6db74dcb913eb751396b Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 02:01:48 +0800 Subject: [PATCH 048/148] Report ScopeConflict for a duplicated import qualifier `purs` rejects two imports that share an explicit `as` qualifier with ScopeConflict, independently of any qualified lookup or re-export. Detect the repeated alias while the import scope is built, so `failing/ConflictingQualifiedImports2` agrees and the L2 board measures M2 at 72/72. The same annotations run measures passing resolution at 402/413, and the roadmap and README record both. --- README.md | 2 +- crates/psrs-resolve/src/resolver/names/mod.rs | 14 +++++++++++++- docs/design/D-04-suite-roadmap.md | 12 ++++++------ 3 files changed, 20 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 8550d17a..34dac748 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ what remains in each layer. | Gate | Measured | Scope | | --- | --- | --- | | L0/L1 lexing, layout, parsing | 904/908 | non-FFI `layout`, `passing`, `failing`, `warning` files; the four differences are recorded DEC-16 intentional differences | -| L2 resolution | 71/72 failing, 386/413 passing | official `errorCode`s; 23 passing files stop at P3 and 4 at P0 | +| L2 resolution | 72/72 failing, 402/413 passing | official `errorCode`s; 6 passing files stop at P3, 4 at P0, and 1 in the harness | | L3 kinds | 39/48 failing | official kind `errorCode`s | | L4 types | 39/50 failing | official `errorCode`s | | L5 classes | 58/81 failing | official `errorCode`s | diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index 11afe1c4..c4edcdb0 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -51,13 +51,25 @@ impl Resolver { imports: Vec, export_items: Option, fixities: Vec, - errors: Vec, + mut errors: Vec, ) -> Self { let mut unqualified: HashMap> = HashMap::new(); let mut qualified: HashMap> = HashMap::new(); let mut imported_types: HashMap> = HashMap::new(); let mut qualified_types: HashMap> = HashMap::new(); + let mut aliases: HashMap = HashMap::new(); for import in &imports { + // Two imports cannot share one explicit qualifier; `purs` reports + // this as a scope conflict before any qualified lookup or re-export. + if let Some(alias) = &import.alias + && aliases.insert(alias.clone(), ()).is_some() + { + errors.push(ResolveError::named( + ResolveErrorKind::ScopeConflict, + alias.clone(), + import.span, + )); + } // An import with an `as` alias is qualified-only; without one it // also brings the names into unqualified scope. if import.alias.is_none() { diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index f0f2a971..e9d63d1b 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -390,12 +390,12 @@ fails, and a type synonym for the record fails identically. Changing the argumen shape would change the API the corpus calls, so the two functions stay out and the defect is filed as #137. That leaves 2 `passing` cases blocked on them. -**Latest full-board remeasurement (2026-10-04, annotations oracle):** M2 -failing agreement is **71/72**; `failing/ConflictingQualifiedImports2.purs` -expects `ScopeConflict` but produces `ExportConflict`. Passing modules resolve -in **386/413** cases; the other 27 stop at P3 (23) or P0 (4). Nineteen sibling -modules load successfully, and no case is blocked because the loader cannot use -an imported sibling. +**Latest full-board remeasurement (2026-10-07, annotations oracle):** M2 +failing agreement is **72/72**; a duplicated explicit import qualifier now +reports `ScopeConflict`, so `failing/ConflictingQualifiedImports2.purs` agrees. +Passing modules resolve in **402/413** cases; the other 11 stop at P3 (6), P0 +(4), or in the harness (1). Nineteen sibling modules load successfully, and no +case is blocked because the loader cannot use an imported sibling. ### M3 — Kinds and higher-kinded types From dc82948061e052ff79a29d19a02199913e87ec23 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 02:01:48 +0800 Subject: [PATCH 049/148] Move module roots into mod.rs for the source-layout rule `bindings/primitives`, `cc/lower/array`, `driver/prelude`, `thir/tests`, and `typecheck/generalize` each had a same-named submodule directory, which the repository source-layout check rejects. Move each root to `mod.rs` and keep its submodules in place. `array/storage.rs` widens two helpers to `pub(in crate::cc::lower)` because its caller is now a sibling of `array`. --- .../src/bindings/{primitives.rs => primitives/mod.rs} | 0 crates/psrs-backend/src/cc/lower/{array.rs => array/mod.rs} | 2 ++ .../src/cc/lower/{array_storage.rs => array/storage.rs} | 6 +++--- crates/psrs-backend/src/cc/lower/mod.rs | 1 - crates/psrs-driver/src/{prelude.rs => prelude/mod.rs} | 0 crates/psrs-thir/src/{tests.rs => tests/mod.rs} | 0 .../src/typecheck/{generalize.rs => generalize/mod.rs} | 0 7 files changed, 5 insertions(+), 4 deletions(-) rename crates/psrs-backend/src/bindings/{primitives.rs => primitives/mod.rs} (100%) rename crates/psrs-backend/src/cc/lower/{array.rs => array/mod.rs} (99%) rename crates/psrs-backend/src/cc/lower/{array_storage.rs => array/storage.rs} (94%) rename crates/psrs-driver/src/{prelude.rs => prelude/mod.rs} (100%) rename crates/psrs-thir/src/{tests.rs => tests/mod.rs} (100%) rename crates/psrs-typecheck/src/typecheck/{generalize.rs => generalize/mod.rs} (100%) diff --git a/crates/psrs-backend/src/bindings/primitives.rs b/crates/psrs-backend/src/bindings/primitives/mod.rs similarity index 100% rename from crates/psrs-backend/src/bindings/primitives.rs rename to crates/psrs-backend/src/bindings/primitives/mod.rs diff --git a/crates/psrs-backend/src/cc/lower/array.rs b/crates/psrs-backend/src/cc/lower/array/mod.rs similarity index 99% rename from crates/psrs-backend/src/cc/lower/array.rs rename to crates/psrs-backend/src/cc/lower/array/mod.rs index d44cafb5..8619614b 100644 --- a/crates/psrs-backend/src/cc/lower/array.rs +++ b/crates/psrs-backend/src/cc/lower/array/mod.rs @@ -1,3 +1,5 @@ +mod storage; + use super::super::{Assignment, AssignmentKind, RefShape, Reference, ValueId, ValueShape}; use super::FunctionLowerer; use crate::BackendError; diff --git a/crates/psrs-backend/src/cc/lower/array_storage.rs b/crates/psrs-backend/src/cc/lower/array/storage.rs similarity index 94% rename from crates/psrs-backend/src/cc/lower/array_storage.rs rename to crates/psrs-backend/src/cc/lower/array/storage.rs index b37e0017..c51fd976 100644 --- a/crates/psrs-backend/src/cc/lower/array_storage.rs +++ b/crates/psrs-backend/src/cc/lower/array/storage.rs @@ -1,11 +1,11 @@ //! Low-level initialized allocation and unsafe writes; library code owns loops. -use super::FunctionLowerer; +use super::super::FunctionLowerer; use crate::BackendError; use crate::cc::{Assignment, AssignmentKind, ValueId, ValueShape}; use psrs_core::Expr; impl FunctionLowerer<'_> { - pub(super) fn lower_array_fill( + pub(in crate::cc::lower) fn lower_array_fill( &mut self, expression: &Expr, length: &Expr, @@ -35,7 +35,7 @@ impl FunctionLowerer<'_> { }); Ok(destination) } - pub(super) fn lower_array_write( + pub(in crate::cc::lower) fn lower_array_write( &mut self, expression: &Expr, array: &Expr, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 9fb6d1c8..2318be23 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -12,7 +12,6 @@ use std::collections::{HashMap, HashSet}; use std::rc::Rc; mod array; -mod array_storage; mod call; mod constructor; mod conversion; diff --git a/crates/psrs-driver/src/prelude.rs b/crates/psrs-driver/src/prelude/mod.rs similarity index 100% rename from crates/psrs-driver/src/prelude.rs rename to crates/psrs-driver/src/prelude/mod.rs diff --git a/crates/psrs-thir/src/tests.rs b/crates/psrs-thir/src/tests/mod.rs similarity index 100% rename from crates/psrs-thir/src/tests.rs rename to crates/psrs-thir/src/tests/mod.rs diff --git a/crates/psrs-typecheck/src/typecheck/generalize.rs b/crates/psrs-typecheck/src/typecheck/generalize/mod.rs similarity index 100% rename from crates/psrs-typecheck/src/typecheck/generalize.rs rename to crates/psrs-typecheck/src/typecheck/generalize/mod.rs From f9445fcd57da69e0a774b3dfe1e5be78aac9957f Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 02:01:48 +0800 Subject: [PATCH 050/148] Adjust tests to the migrated standard library The library now owns operators and modules these tests used to take from the compiler: import `-`/`/` explicitly or use the scalar intrinsics, rename the user `Data.Boolean` module so it no longer collides with the library module, fold through the scalar `intAdd`, expect the official `Test.Assert` rendering, and treat `psrs:` bindings as compiler primitives rather than host imports. `Data.Int.Bits` is a library module now, so its test prepends the library, and the Euclidean `div` operator returns 0 for a zero divisor instead of trapping. --- crates/psrs-driver/src/tests/assertions.rs | 8 +++--- crates/psrs-driver/src/tests/functions.rs | 1 + crates/psrs-driver/src/tests/guards.rs | 18 ++++++------- crates/psrs-driver/src/tests/integration.rs | 4 ++- crates/psrs-driver/src/tests/operators/mod.rs | 4 +-- .../src/tests/polymorphism_erasure_audit.rs | 2 +- crates/psrs-driver/src/tests/scalars.rs | 25 +++++++++++++------ crates/psrs-driver/src/tests/wasi/wrappers.rs | 9 ++++--- 8 files changed, 41 insertions(+), 30 deletions(-) diff --git a/crates/psrs-driver/src/tests/assertions.rs b/crates/psrs-driver/src/tests/assertions.rs index 55500844..78ba5c25 100644 --- a/crates/psrs-driver/src/tests/assertions.rs +++ b/crates/psrs-driver/src/tests/assertions.rs @@ -129,11 +129,9 @@ fn assert_true_and_assert_false_report_the_value_that_did_not_hold() { return; }; // The message names the value that did not hold, the way the official - // module's `assertTrue` does. - assert_trapped_after_message( - &output, - "Assertion failed: Expected: true\nActual: false\n", - ); + // module's `assertTrue` does: `assertEqual'` renders `Expected`/`Actual` + // without an extra prefix. + assert_trapped_after_message(&output, "Expected: true\nActual: false\n"); } /// The renderings `Data.Show` produces, so this fails if `logShow` grows a diff --git a/crates/psrs-driver/src/tests/functions.rs b/crates/psrs-driver/src/tests/functions.rs index 24d79242..6fbe2a28 100644 --- a/crates/psrs-driver/src/tests/functions.rs +++ b/crates/psrs-driver/src/tests/functions.rs @@ -197,6 +197,7 @@ fn runs_a_recursive_polymorphic_reference_identity() { // optimizer must prune that dead arm before verifying. let source = r#"module Main where import Data.Eq ((==)) +import Data.Ring ((-)) lastArr :: forall a. Int -> Array a -> Array a lastArr n x = if n == 0 then x else lastArr (n - 1) x main = arrayIndex (lastArr 3 [40, 42]) 1 diff --git a/crates/psrs-driver/src/tests/guards.rs b/crates/psrs-driver/src/tests/guards.rs index 358a6fbc..c949251f 100644 --- a/crates/psrs-driver/src/tests/guards.rs +++ b/crates/psrs-driver/src/tests/guards.rs @@ -382,12 +382,13 @@ fn official_guard_and_case_sources_lower_through_p2() { #[test] fn user_defined_false_otherwise_does_not_prove_guard_coverage() { - let constants = "module Boolean.Constants (otherwise) where\nimport Prelude\notherwise :: Boolean\notherwise = false\n"; - let boolean = "module Data.Boolean (otherwise) where\nimport Boolean.Constants (otherwise)\n"; - let main = "module Main where\nimport Prelude\nimport Data.Boolean (otherwise)\nread n\n | otherwise = n\nmain = read 1\n"; + let constants = + "module Boolean.Constants (otherwise) where\notherwise :: Boolean\notherwise = false\n"; + let alias = "module Boolean.Alias (otherwise) where\nimport Boolean.Constants (otherwise)\n"; + let main = "module Main where\nimport Boolean.Alias (otherwise)\nread n\n | otherwise = n\nmain = read 1\n"; let errors = compile_program_sources_with_prelude(&[ ("Boolean.Constants.purs", constants), - ("Data.Boolean.purs", boolean), + ("Boolean.Alias.purs", alias), ("Main.purs", main), ]) .expect_err("an arbitrary binding named otherwise is not a coverage proof"); @@ -403,13 +404,12 @@ fn user_defined_false_otherwise_does_not_prove_guard_coverage() { #[test] fn cross_module_true_alias_is_a_verified_unconditional_guard() { - let constants = - "module Boolean.Constants (truth) where\nimport Prelude\ntruth :: Boolean\ntruth = true\n"; - let boolean = "module Data.Boolean (otherwise) where\nimport Prelude\nimport Boolean.Constants (truth)\notherwise :: Boolean\notherwise = truth\n"; - let main = "module Main where\nimport Prelude\nimport Data.Boolean (otherwise)\nread n\n | otherwise = n\nmain = read 11\n"; + let constants = "module Boolean.Constants (truth) where\ntruth :: Boolean\ntruth = true\n"; + let alias = "module Boolean.Alias (otherwise) where\nimport Boolean.Constants (truth)\notherwise :: Boolean\notherwise = truth\n"; + let main = "module Main where\nimport Boolean.Alias (otherwise)\nread n\n | otherwise = n\nmain = read 11\n"; let artifact = compile_program_sources_with_prelude(&[ ("Boolean.Constants.purs", constants), - ("Data.Boolean.purs", boolean), + ("Boolean.Alias.purs", alias), ("Main.purs", main), ]) .expect("resolved aliases to true prove guard coverage"); diff --git a/crates/psrs-driver/src/tests/integration.rs b/crates/psrs-driver/src/tests/integration.rs index eecc4aa2..c0ef058d 100644 --- a/crates/psrs-driver/src/tests/integration.rs +++ b/crates/psrs-driver/src/tests/integration.rs @@ -96,7 +96,9 @@ fn compiles_if_expression_through_cfg_to_structured_wasm() { #[test] fn folds_top_level_scalar_references_to_constants() { - let source = "module Main where\nimport Prelude\nanswer = 40\nmain = answer + 2\n"; + // `intAdd` is the scalar integer primitive; the library `+` is a class + // method and is not a constant-foldable scalar operation. + let source = "module Main where\nanswer = 40\nmain = intAdd answer 2\n"; let artifact = compile_source("Main.purs", source).unwrap(); assert!(artifact.wat.contains("i32.const 42")); } diff --git a/crates/psrs-driver/src/tests/operators/mod.rs b/crates/psrs-driver/src/tests/operators/mod.rs index 2c6a1f4e..1b1a8a78 100644 --- a/crates/psrs-driver/src/tests/operators/mod.rs +++ b/crates/psrs-driver/src/tests/operators/mod.rs @@ -6,7 +6,7 @@ use super::*; const FIXITY_SOURCE: &str = "module Main where\n\ infixr 4 subtract as <+>\n\ - subtract x y = x - y\n\ + subtract x y = intSub x y\n\ main = 10 <+> 3 <+> 2\n"; #[test] @@ -457,7 +457,7 @@ fn ambiguous_imported_fixity_targets_report_scope_conflicts() { fn rejects_ambiguous_fixity_groups_for_values_patterns_and_types() { let cases = [ ( - "module Main where\ninfixl 5 subtract as <+>\ninfixr 5 subtract as <*>\nsubtract x y = x - y\nmain = 1 <+> 2 <*> 3\n", + "module Main where\ninfixl 5 subtract as <+>\ninfixr 5 subtract as <*>\nsubtract x y = intSub x y\nmain = 1 <+> 2 <*> 3\n", "operators of the same precedence have mixed associativity", ), ( diff --git a/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs b/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs index bd743c1a..39015ae1 100644 --- a/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs +++ b/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs @@ -269,7 +269,7 @@ fn linked_modules_round_trip_an_erased_high_bit_int() { ); let consumer = ( "Main.purs", - "module Main where\nimport Producer\nmain = identity 2000000000 - 1999999958\n", + "module Main where\nimport Producer\nmain = intSub (identity 2000000000) 1999999958\n", ); let core = lower_program_to_core(&[producer, consumer]) .expect("the linked erased program should lower to Core"); diff --git a/crates/psrs-driver/src/tests/scalars.rs b/crates/psrs-driver/src/tests/scalars.rs index 204723a0..26af68a3 100644 --- a/crates/psrs-driver/src/tests/scalars.rs +++ b/crates/psrs-driver/src/tests/scalars.rs @@ -135,6 +135,7 @@ import Data.Int.Bits ((.&.)) main = if intEq (6 .&. 3) 2 then 0 else 1 "#; let sources = [("Main.purs", main)]; + let (sources, _) = crate::prelude::prepend(&sources).expect("the standard library should load"); let Some(output) = super::run_program_with_wasmtime(&sources) else { eprintln!("skipping execution: wasmtime is not installed"); return; @@ -322,13 +323,21 @@ fn assert_runtime_trap(source: &str, needle: &str) { } #[test] -fn truncated_and_floor_division_trap_on_zero_divisor_and_signed_overflow() { - assert_runtime_trap( - "module Main where\nmain = 1 / 0\n", - "integer divide by zero", - ); +fn truncated_and_floor_division_zero_and_signed_overflow() { + // `Data.EuclideanRing`'s Euclidean `div` (`/`) returns 0 for a zero divisor, + // matching the official purescript-prelude implementation, so it does not + // trap. The truncating `%` operator and the explicit `intDiv`/`intMod` + // intrinsics reach the trapping Wasm instructions. + let Some(output) = + super::run_with_wasmtime("module Main where\nimport Prelude\nmain = 1 / 0\n") + else { + eprintln!("skipping execution: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); + assert_runtime_trap( - "module Main where\nmain = 1 % 0\n", + "module Main where\nimport Prelude\nmain = 1 % 0\n", "integer divide by zero", ); assert_runtime_trap( @@ -340,11 +349,11 @@ fn truncated_and_floor_division_trap_on_zero_divisor_and_signed_overflow() { "integer divide by zero", ); assert_runtime_trap( - "module Main where\nmain = ((intNeg 2147483647) - 1) / (intNeg 1)\n", + "module Main where\nimport Prelude\nmain = ((intNeg 2147483647) - 1) / (intNeg 1)\n", "integer overflow", ); assert_runtime_trap( - "module Main where\nmain = intDiv ((intNeg 2147483647) - 1) (intNeg 1)\n", + "module Main where\nimport Prelude\nmain = intDiv ((intNeg 2147483647) - 1) (intNeg 1)\n", "integer overflow", ); } diff --git a/crates/psrs-driver/src/tests/wasi/wrappers.rs b/crates/psrs-driver/src/tests/wasi/wrappers.rs index 4915c115..2ddb4d28 100644 --- a/crates/psrs-driver/src/tests/wasi/wrappers.rs +++ b/crates/psrs-driver/src/tests/wasi/wrappers.rs @@ -240,10 +240,11 @@ fn raw_foreign_value_names(text: &str) -> Vec { let Some(close) = rest.find('"') else { continue; }; - // `psrs:effect` names the abstract effect operations (`pure`, `bind`, - // `runEffect`). Those are the public library interface, not a private - // host import hidden behind a wrapper. - if rest[..close].starts_with("psrs:effect#") { + // `psrs:` names compiler bindings (`psrs:effect` abstract effect + // operations, `psrs:intrinsic` checked primitives). Those are the + // public library interface, not a private host import hidden behind a + // wrapper; only `wasi:` bindings name host imports. + if rest[..close].starts_with("psrs:") { continue; } let after = rest[close + 1..].trim_start(); From 3e78ff128ae2131e0750f9699605e363489d01d3 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 02:58:01 +0800 Subject: [PATCH 051/148] Preserve canonical aggregate protocols across WIT variant payloads --- .../src/cc/lower/conversion/scalars.rs | 249 ++------------ crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/payload.rs | 324 ++++++++++++++++++ .../aggregate/erased_storage.rs | 127 +++++++ .../src/mir/indirect_tests/aggregate/mod.rs | 2 +- crates/psrs-backend/src/mir/layout/mod.rs | 14 +- .../src/mir/lower/aggregate/mod.rs | 2 +- crates/psrs-backend/src/mir/lower/mod.rs | 4 +- .../src/mir/reachable/assignments.rs | 2 +- crates/psrs-backend/src/mir/reachable/mod.rs | 69 +--- .../src/mir/reachable/projection.rs | 105 ++++++ .../src/mir/wit/aggregate/decode.rs | 27 +- .../psrs-backend/src/mir/wit/aggregate/mod.rs | 16 +- .../src/mir/wit/aggregate/parameter.rs | 63 +++- .../psrs-backend/src/mir/wit/call_lowerer.rs | 16 + .../src/mir/wit/function_lowerer.rs | 28 ++ crates/psrs-driver/src/tests/wasi/mod.rs | 1 + crates/psrs-driver/src/tests/wasi/payloads.rs | 32 ++ .../backend/fp/representation-and-evidence.md | 10 + .../backend/wit-erased-payloads.md | 85 +++++ 20 files changed, 856 insertions(+), 321 deletions(-) create mode 100644 crates/psrs-backend/src/cc/payload.rs create mode 100644 crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs create mode 100644 crates/psrs-backend/src/mir/reachable/projection.rs create mode 100644 crates/psrs-driver/src/tests/wasi/payloads.rs create mode 100644 docs/implementation/backend/wit-erased-payloads.md diff --git a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs index 553ec4e2..07661582 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs @@ -1,8 +1,8 @@ use super::super::FunctionLowerer; -use super::{conversion_error, erased_shape, sequence}; +use super::conversion_error; use crate::{ BackendError, - cc::{BoxKind, RecoveryEvidence, RefShape, Reference, ReprId, ValueConversion, ValueShape}, + cc::{BoxKind, ReprId, ValueConversion, ValueShape}, }; use psrs_span::TextRange; @@ -12,33 +12,7 @@ impl FunctionLowerer<'_> { shape: ValueShape, span: TextRange, ) -> Result> { - if shape == erased_shape() { - return Ok(ValueConversion::Identity); - } - if let Some(plan) = self.array_payload(shape, true, span)? { - return Ok(plan); - } - if let Some(plan) = self.record_payload(shape, true, span)? { - return Ok(plan); - } - if let ValueShape::Reference(Reference { - heap: RefShape::Closure(signature), - .. - }) = shape - { - let adapter = self.erase_function_slot(signature, span)?; - return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); - } - let boxed = match shape { - ValueShape::Integer | ValueShape::Boolean => { - self.box_plan(BoxKind::Integer, self.boxed_integer_type, span)? - } - ValueShape::Number => self.box_plan(BoxKind::Number, self.boxed_number_type, span)?, - ValueShape::String | ValueShape::Reference(_) => { - return Ok(ValueConversion::EraseReference); - } - }; - Ok(sequence(vec![boxed, ValueConversion::EraseReference])) + crate::cc::payload::PayloadPlanner::erase_payload(self, shape, span) } pub(super) fn recover_payload( @@ -46,212 +20,33 @@ impl FunctionLowerer<'_> { shape: ValueShape, span: TextRange, ) -> Result> { - if shape == erased_shape() { - return Ok(ValueConversion::Identity); - } - if let Some(plan) = self.array_payload(shape, false, span)? { - return Ok(plan); - } - if let Some(plan) = self.record_payload(shape, false, span)? { - return Ok(plan); - } - if let ValueShape::Reference(Reference { - heap: RefShape::Closure(signature), - .. - }) = shape - { - return self.recover_function_slot(signature, span); - } - match shape { - ValueShape::Integer | ValueShape::Boolean => { - self.unbox_plan(BoxKind::Integer, self.boxed_integer_type, shape, span) - } - ValueShape::Number => { - self.unbox_plan(BoxKind::Number, self.boxed_number_type, shape, span) - } - ValueShape::String | ValueShape::Reference(_) => { - Ok(ValueConversion::RecoverReference { - destination: shape, - evidence: RecoveryEvidence::TypeInstantiation, - }) - } - } + crate::cc::payload::PayloadPlanner::recover_payload(self, shape, span) } +} - fn array_payload( - &mut self, - shape: ValueShape, - entering: bool, - span: TextRange, - ) -> Result, Vec> { - let ValueShape::Reference(Reference { - heap: RefShape::Repr(concrete), - .. - }) = shape - else { - return Ok(None); - }; - let Some(crate::cc::Representation::Array { element }) = - self.representations.representation(concrete) - else { - return Ok(None); - }; - let element_shape = *element; - let protocol = self.representations.representations.iter().position(|representation| - matches!(representation, crate::cc::Representation::Array { element } if *element == erased_shape())) - .map(|index| ReprId(index as u32)) - .ok_or_else(|| conversion_error(span, "Array owner has no erased storage protocol"))?; - let protocol_shape = ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(protocol), - }); - if concrete == protocol { - return Ok(Some(if entering { - ValueConversion::EraseReference - } else { - ValueConversion::RecoverReference { - destination: shape, - evidence: RecoveryEvidence::TypeInstantiation, - } - })); - } - if entering { - let element = self.erase_payload(element_shape, span)?; - Ok(Some(sequence(vec![ - ValueConversion::ArrayMap { - source: concrete, - target: protocol, - element: Box::new(element), - }, - ValueConversion::EraseReference, - ]))) - } else { - let element = self.recover_payload(element_shape, span)?; - Ok(Some(sequence(vec![ - ValueConversion::RecoverReference { - destination: protocol_shape, - evidence: RecoveryEvidence::TypeInstantiation, - }, - ValueConversion::ArrayMap { - source: protocol, - target: concrete, - element: Box::new(element), - }, - ]))) +impl crate::cc::payload::PayloadPlanner for FunctionLowerer<'_> { + fn payload_table(&self) -> &crate::cc::RepresentationTable { + self.representations + } + fn payload_box(&self, kind: BoxKind) -> Option { + match kind { + BoxKind::Integer => self.boxed_integer_type, + BoxKind::Number => self.boxed_number_type, } } - - fn record_payload( + fn payload_callable( &mut self, - shape: ValueShape, + signature: crate::cc::SignatureId, entering: bool, span: TextRange, - ) -> Result, Vec> { - let ValueShape::Reference(Reference { - heap: RefShape::Repr(concrete), - .. - }) = shape - else { - return Ok(None); - }; - let Some(labels) = self - .representations - .product_labels(concrete) - .map(<[String]>::to_vec) - else { - return Ok(None); - }; - let Some(crate::cc::Representation::Product { fields }) = - self.representations.representation(concrete) - else { - return Err(conversion_error( - span, - "record owner labels do not name a product", - )); - }; - let fields = fields.clone(); - let protocol = - super::super::super::layout::protocols::record(self.representations, &labels) - .ok_or_else(|| { - conversion_error(span, "record owner has no erased field protocol") - })?; - if concrete == protocol { - return Ok(Some(if entering { - ValueConversion::EraseReference - } else { - ValueConversion::RecoverReference { - destination: shape, - evidence: RecoveryEvidence::TypeInstantiation, - } - })); - } - let plans = fields - .into_iter() - .map(|field| { - if entering { - self.erase_payload(field, span) - } else { - self.recover_payload(field, span) - } - }) - .collect::, _>>()?; - Ok(Some(if entering { - sequence(vec![ - ValueConversion::ProductMap { - source: concrete, - target: protocol, - labels, - fields: plans, - }, - ValueConversion::EraseReference, - ]) - } else { - let protocol_shape = ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(protocol), - }); - sequence(vec![ - ValueConversion::RecoverReference { - destination: protocol_shape, - evidence: RecoveryEvidence::TypeInstantiation, - }, - ValueConversion::ProductMap { - source: protocol, - target: concrete, - labels, - fields: plans, - }, - ]) - })) - } - - pub(super) fn box_plan( - &self, - kind: BoxKind, - representation: Option, - span: TextRange, ) -> Result> { - representation - .map(|representation| ValueConversion::BoxScalar { - kind, - representation, - }) - .ok_or_else(|| conversion_error(span, "erased scalar has no box representation")) + if entering { + self.erase_function_slot(signature, span) + } else { + self.recover_function_slot(signature, span) + } } - - pub(super) fn unbox_plan( - &self, - kind: BoxKind, - representation: Option, - destination: ValueShape, - span: TextRange, - ) -> Result> { - representation - .map(|representation| ValueConversion::UnboxScalar { - kind, - representation, - destination, - }) - .ok_or_else(|| conversion_error(span, "erased scalar has no box representation")) + fn payload_error(&self, span: TextRange, message: &'static str) -> Vec { + conversion_error(span, message) } } diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 90bed3e7..d5bce023 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -11,6 +11,7 @@ mod case; mod convert; mod layout; mod lower; +pub(crate) mod payload; mod projection; mod representation; mod scalar; diff --git a/crates/psrs-backend/src/cc/payload.rs b/crates/psrs-backend/src/cc/payload.rs new file mode 100644 index 00000000..94d0dad7 --- /dev/null +++ b/crates/psrs-backend/src/cc/payload.rs @@ -0,0 +1,324 @@ +//! Shared conversion planning for bare polymorphic storage slots. +//! CC and canonical ABI adapters use the same recursive owner protocols. + +use super::{ + BoxKind, RecoveryEvidence, RefShape, Reference, ReprId, RepresentationTable, SignatureId, + ValueConversion, ValueShape, +}; +use crate::BackendError; +use psrs_span::TextRange; + +pub(crate) trait PayloadPlanner { + fn payload_table(&self) -> &RepresentationTable; + fn payload_box(&self, kind: BoxKind) -> Option; + fn payload_callable( + &mut self, + signature: SignatureId, + entering: bool, + span: TextRange, + ) -> Result>; + fn payload_error(&self, span: TextRange, message: &'static str) -> Vec; + + fn erase_payload( + &mut self, + shape: ValueShape, + span: TextRange, + ) -> Result> { + if shape == erased_shape() { + return Ok(ValueConversion::Identity); + } + if let Some(plan) = self.array_payload(shape, true, span)? { + return Ok(plan); + } + if let Some(plan) = self.record_payload(shape, true, span)? { + return Ok(plan); + } + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = shape + { + let adapter = self.payload_callable(signature, true, span)?; + return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); + } + let boxed = match shape { + ValueShape::Integer | ValueShape::Boolean => { + self.box_plan(BoxKind::Integer, self.payload_box(BoxKind::Integer), span)? + } + ValueShape::Number => { + self.box_plan(BoxKind::Number, self.payload_box(BoxKind::Number), span)? + } + ValueShape::String | ValueShape::Reference(_) => { + return Ok(ValueConversion::EraseReference); + } + }; + Ok(sequence(vec![boxed, ValueConversion::EraseReference])) + } + + fn recover_payload( + &mut self, + shape: ValueShape, + span: TextRange, + ) -> Result> { + if shape == erased_shape() { + return Ok(ValueConversion::Identity); + } + if let Some(plan) = self.array_payload(shape, false, span)? { + return Ok(plan); + } + if let Some(plan) = self.record_payload(shape, false, span)? { + return Ok(plan); + } + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = shape + { + return self.payload_callable(signature, false, span); + } + match shape { + ValueShape::Integer | ValueShape::Boolean => self.unbox_plan( + BoxKind::Integer, + self.payload_box(BoxKind::Integer), + shape, + span, + ), + ValueShape::Number => self.unbox_plan( + BoxKind::Number, + self.payload_box(BoxKind::Number), + shape, + span, + ), + ValueShape::String | ValueShape::Reference(_) => { + Ok(ValueConversion::RecoverReference { + destination: shape, + evidence: RecoveryEvidence::TypeInstantiation, + }) + } + } + } + + fn array_payload( + &mut self, + shape: ValueShape, + entering: bool, + span: TextRange, + ) -> Result, Vec> { + let ValueShape::Reference(Reference { + heap: RefShape::Repr(concrete), + .. + }) = shape + else { + return Ok(None); + }; + let Some(crate::cc::Representation::Array { element }) = + self.payload_table().representation(concrete) + else { + return Ok(None); + }; + let element_shape = *element; + let protocol = self.payload_table().representations.iter().position(|representation| + matches!(representation, crate::cc::Representation::Array { element } if *element == erased_shape())) + .map(|index| ReprId(index as u32)) + .ok_or_else(|| self.payload_error(span, "Array owner has no erased storage protocol"))?; + let protocol_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(protocol), + }); + if concrete == protocol { + return Ok(Some(if entering { + ValueConversion::EraseReference + } else { + ValueConversion::RecoverReference { + destination: shape, + evidence: RecoveryEvidence::TypeInstantiation, + } + })); + } + if entering { + let element = self.erase_payload(element_shape, span)?; + Ok(Some(sequence(vec![ + ValueConversion::ArrayMap { + source: concrete, + target: protocol, + element: Box::new(element), + }, + ValueConversion::EraseReference, + ]))) + } else { + let element = self.recover_payload(element_shape, span)?; + Ok(Some(sequence(vec![ + ValueConversion::RecoverReference { + destination: protocol_shape, + evidence: RecoveryEvidence::TypeInstantiation, + }, + ValueConversion::ArrayMap { + source: protocol, + target: concrete, + element: Box::new(element), + }, + ]))) + } + } + + fn record_payload( + &mut self, + shape: ValueShape, + entering: bool, + span: TextRange, + ) -> Result, Vec> { + let ValueShape::Reference(Reference { + heap: RefShape::Repr(concrete), + .. + }) = shape + else { + return Ok(None); + }; + let Some(labels) = self + .payload_table() + .product_labels(concrete) + .map(<[String]>::to_vec) + else { + return Ok(None); + }; + let Some(crate::cc::Representation::Product { fields }) = + self.payload_table().representation(concrete) + else { + return Err(self.payload_error(span, "record owner labels do not name a product")); + }; + let fields = fields.clone(); + let protocol = super::layout::protocols::record(self.payload_table(), &labels) + .ok_or_else(|| self.payload_error(span, "record owner has no erased field protocol"))?; + if concrete == protocol { + return Ok(Some(if entering { + ValueConversion::EraseReference + } else { + ValueConversion::RecoverReference { + destination: shape, + evidence: RecoveryEvidence::TypeInstantiation, + } + })); + } + let plans = fields + .into_iter() + .map(|field| { + if entering { + self.erase_payload(field, span) + } else { + self.recover_payload(field, span) + } + }) + .collect::, _>>()?; + Ok(Some(if entering { + sequence(vec![ + ValueConversion::ProductMap { + source: concrete, + target: protocol, + labels, + fields: plans, + }, + ValueConversion::EraseReference, + ]) + } else { + let protocol_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(protocol), + }); + sequence(vec![ + ValueConversion::RecoverReference { + destination: protocol_shape, + evidence: RecoveryEvidence::TypeInstantiation, + }, + ValueConversion::ProductMap { + source: protocol, + target: concrete, + labels, + fields: plans, + }, + ]) + })) + } + + fn box_plan( + &self, + kind: BoxKind, + representation: Option, + span: TextRange, + ) -> Result> { + representation + .map(|representation| ValueConversion::BoxScalar { + kind, + representation, + }) + .ok_or_else(|| self.payload_error(span, "erased scalar has no box representation")) + } + + fn unbox_plan( + &self, + kind: BoxKind, + representation: Option, + destination: ValueShape, + span: TextRange, + ) -> Result> { + representation + .map(|representation| ValueConversion::UnboxScalar { + kind, + representation, + destination, + }) + .ok_or_else(|| self.payload_error(span, "erased scalar has no box representation")) + } +} + +fn erased_shape() -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }) +} + +fn sequence(steps: Vec) -> ValueConversion { + match steps.len() { + 0 => ValueConversion::Identity, + 1 => steps.into_iter().next().expect("one conversion step"), + _ => ValueConversion::Sequence(steps), + } +} + +/// The canonical ABI admits no callable values; aggregate storage still uses +/// the same owner plans as CC. Reachability and MIR lowering share this planner. +pub(crate) struct StoragePayloadPlanner<'a>(pub(crate) &'a RepresentationTable); + +impl PayloadPlanner for StoragePayloadPlanner<'_> { + fn payload_table(&self) -> &RepresentationTable { + self.0 + } + fn payload_box(&self, kind: crate::cc::BoxKind) -> Option { + let shape = match kind { + crate::cc::BoxKind::Integer => crate::cc::ValueShape::Integer, + crate::cc::BoxKind::Number => crate::cc::ValueShape::Number, + }; + self.0 + .representations + .iter() + .position( + |repr| matches!(repr, crate::cc::Representation::Box { value } if *value == shape), + ) + .map(|index| ReprId(index as u32)) + } + fn payload_callable( + &mut self, + _signature: crate::cc::SignatureId, + _entering: bool, + span: TextRange, + ) -> Result> { + Err(vec![BackendError::new( + "P9 MIR lowering", + span, + "callable values have no canonical ABI payload conversion", + )]) + } + fn payload_error(&self, span: TextRange, message: &'static str) -> Vec { + vec![BackendError::new("P9 MIR lowering", span, message)] + } +} diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs new file mode 100644 index 00000000..18bf5d2e --- /dev/null +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs @@ -0,0 +1,127 @@ +//! ABI arrays and records cross bare slots in both directions. +use super::*; +use crate::cc::{ + Assignment, AssignmentKind, External, ExternalProjection, GuestLayout, Signature, ValueDecl, +}; +use crate::types::ValueId; +use psrs_hir::SymbolId; + +fn roundtrip(array: bool, include_protocol: bool) -> (cc::Module, ExternalBindings, Resolve) { + let (mut module, mut bindings, _) = if array { + option_list_record_fixture() + } else { + nested_record_fixture() + }; + let result_shape = module.externals[0].signature.as_ref().unwrap().result; + let mut guest = cc::guest_layout(result_shape, &module.representations).unwrap(); + let GuestLayout::Variant { repr, cases } = &mut guest else { + panic!("variant fixture") + }; + cases[1].fields[0].stored = erased(); + let Representation::Variant { cases: stored } = + &mut module.representations.representations[repr.0 as usize] + else { + panic!("variant storage") + }; + stored[1].fields[0] = erased(); + // The canonical protocol is registered by CC's layout owner. It is only + // reachable through ABI storage conversion, never through a source value. + if include_protocol { + let products = module.representations.product_labels.clone(); + for (_, labels) in products { + let id = module.representations.reserve(); + module.representations.set( + id, + Representation::Product { + fields: vec![erased(); labels.len()], + }, + ); + module.representations.set_product_labels(id, labels); + } + if array { + let id = module.representations.reserve(); + module + .representations + .set(id, Representation::Array { element: erased() }); + } + } + let id = module.representations.reserve(); + module.representations.set( + id, + Representation::Box { + value: ValueShape::Integer, + }, + ); + module.externals[0].projection = Some(ExternalProjection { + parameters: vec![], + result: Some(guest.clone()), + }); + let get = module.externals[0].symbol; + let take = SymbolId::new(get.module, get.index + 1); + module.externals.push(External { + symbol: take, + signature: Some(Signature { + parameters: vec![result_shape], + result: ValueShape::Integer, + }), + projection: Some(ExternalProjection { + parameters: vec![guest], + result: None, + }), + }); + let mut binding = bindings.imports[0].clone(); + binding.symbol = take; + binding.function = "take".into(); + bindings.imports.push(binding); + let main = &mut module.functions[0]; + main.values.push(ValueDecl { + id: ValueId(3), + ty: ValueShape::Integer, + }); + main.assignments.push(Assignment { + destination: ValueId(3), + kind: AssignmentKind::DirectCall { + function: take, + arguments: vec![ValueId(0)], + }, + span: module.span, + }); + main.result = ValueId(3); + let payload = if array { "list" } else { "pair" }; + let mut resolve = Resolve::default(); + resolve.push_str("storage.wit", &format!( + "package wasi:io@0.2.12; interface streams {{ record pair {{ x: s32, y: bool }} get: func() -> option<{payload}>; take: func(value: option<{payload}>) -> s32; }}" + )).unwrap(); + (module, bindings, resolve) +} + +#[test] +fn erased_record_array_payload_roundtrips_through_canonical_storage() { + let (module, bindings, resolve) = roundtrip(true, true); + lower_and_validate(module, bindings, resolve); +} + +#[test] +fn erased_record_payload_roundtrips_through_canonical_storage() { + let (module, bindings, resolve) = roundtrip(false, true); + lower_and_validate(module, bindings, resolve); +} + +#[test] +fn erased_payload_without_an_owner_protocol_is_rejected() { + let (module, bindings, resolve) = roundtrip(true, false); + let target = TargetCapabilities { + wasi_cli: false, + ..TargetCapabilities::default() + }; + let registry = abi::WasiRegistry::from_resolve(resolve, target); + let Err(errors) = lower_module_with_registry(module, bindings, target, registry) else { + panic!("a missing storage protocol must be rejected"); + }; + assert!( + errors + .iter() + .any(|error| error.message.contains("storage protocol")), + "{errors:?}" + ); +} diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/mod.rs index 95e7409a..b9c9e799 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/mod.rs @@ -2,6 +2,7 @@ //! record and variant payloads. mod collections; +mod erased_storage; mod fixtures; mod indirect; mod large; @@ -10,7 +11,6 @@ mod nested; mod record_fields; mod resource_result; mod scalars; - use super::lower_module_with_registry; use crate::ExternalBindings; use crate::TargetCapabilities; diff --git a/crates/psrs-backend/src/mir/layout/mod.rs b/crates/psrs-backend/src/mir/layout/mod.rs index 796736df..011559f2 100644 --- a/crates/psrs-backend/src/mir/layout/mod.rs +++ b/crates/psrs-backend/src/mir/layout/mod.rs @@ -368,9 +368,10 @@ impl PlannedLayout { } } -#[derive(Clone, Copy, Debug)] +#[derive(Clone, Debug)] pub(crate) enum LayoutError { UnknownRepresentation, + InvalidPayloadConversion(String), UnknownSignature, UnknownField, MissingIntegerBox, @@ -382,6 +383,17 @@ pub(crate) enum LayoutError { UnsupportedValue, } +impl std::fmt::Display for LayoutError { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + match self { + Self::InvalidPayloadConversion(message) => { + write!(f, "invalid payload storage conversion: {message}") + } + other => write!(f, "{other:?}"), + } + } +} + /// The concrete Wasm value type behind a MIR value type. `Boolean` and `I32` /// share `i32`, so signatures that differ only there must share a function type. fn concrete_value_type(value: ValueType) -> ValueType { diff --git a/crates/psrs-backend/src/mir/lower/aggregate/mod.rs b/crates/psrs-backend/src/mir/lower/aggregate/mod.rs index 3f86363a..918f313d 100644 --- a/crates/psrs-backend/src/mir/lower/aggregate/mod.rs +++ b/crates/psrs-backend/src/mir/lower/aggregate/mod.rs @@ -33,7 +33,7 @@ impl FunctionLowerer<'_> { Ok(block) } - fn lower_value_conversion( + pub(in crate::mir) fn lower_value_conversion( &mut self, block: BlockId, value: ValueId, diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index 3d6dcf85..7d1af3ac 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -28,7 +28,7 @@ fn layout_error(span: TextRange, error: LayoutError) -> Vec { vec![BackendError::new( "P9 MIR lowering", span, - format!("invalid concrete layout request: {error:?}"), + format!("invalid concrete layout request: {error}"), )] } @@ -118,7 +118,7 @@ pub(super) struct FunctionLowerer<'a> { next_value: u32, wit_imports: &'a HashMap, scalar_helpers: &'a ScalarHelpers, - layout: &'a PlannedLayout, + pub(in crate::mir) layout: &'a PlannedLayout, conversion_helpers: Option<&'a mut ConversionHelpers>, literals: Option<&'a mut StringLiterals>, } diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index 2f79a133..1440350e 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -148,7 +148,7 @@ pub(super) fn add_assignments( } } -fn add_conversion( +pub(super) fn add_conversion( conversion: &ValueConversion, direct_calls: &mut HashSet, representations: &mut HashSet, diff --git a/crates/psrs-backend/src/mir/reachable/mod.rs b/crates/psrs-backend/src/mir/reachable/mod.rs index 1f957f32..db5d105c 100644 --- a/crates/psrs-backend/src/mir/reachable/mod.rs +++ b/crates/psrs-backend/src/mir/reachable/mod.rs @@ -1,73 +1,18 @@ //! Reachability analysis for target-neutral CC layout requirements. mod assignments; +mod projection; use super::layout::LayoutError; use crate::cc::{ - GuestLayout, Module as CcModule, RefShape, Reference, ReprId, Representation, - RepresentationTable, Signature, SignatureId, ValueShape, + Module as CcModule, RefShape, Reference, ReprId, Representation, RepresentationTable, + Signature, SignatureId, ValueShape, }; use std::collections::{HashMap, HashSet}; use assignments::add_assignments; -/// Adds every representation the instance-aware projection names. The concrete -/// `value` node of an erased parameter field references a nested representation -/// the abstract signature does not reach, so the projection is what keeps a -/// nested `option` payload's struct and array types planned. -fn add_projection( - layout: &GuestLayout, - representations: &mut HashSet, - signatures: &mut HashSet, - representation_work: &mut Vec, - signature_work: &mut Vec, -) { - match layout { - GuestLayout::Scalar { shape } | GuestLayout::Boxed { shape } => add_value( - shape, - representations, - signatures, - representation_work, - signature_work, - ), - GuestLayout::Product { repr, fields, .. } => { - add_representation(*repr, representations, representation_work); - for field in fields { - add_projection( - &field.value, - representations, - signatures, - representation_work, - signature_work, - ); - } - } - GuestLayout::Variant { repr, cases } => { - add_representation(*repr, representations, representation_work); - for case in cases { - for field in &case.fields { - add_projection( - &field.value, - representations, - signatures, - representation_work, - signature_work, - ); - } - } - } - GuestLayout::Array { repr, element } => { - add_representation(*repr, representations, representation_work); - add_projection( - &element.value, - representations, - signatures, - representation_work, - signature_work, - ); - } - } -} +use projection::add_projection; pub(super) struct ReachableHandles { pub(super) representations: Vec, @@ -142,20 +87,22 @@ impl ReachableHandles { for parameter in &projection.parameters { add_projection( parameter, + &module.representations, &mut representations, &mut signatures, &mut representation_work, &mut signature_work, - ); + )?; } if let Some(result) = &projection.result { add_projection( result, + &module.representations, &mut representations, &mut signatures, &mut representation_work, &mut signature_work, - ); + )?; } } } diff --git a/crates/psrs-backend/src/mir/reachable/projection.rs b/crates/psrs-backend/src/mir/reachable/projection.rs new file mode 100644 index 00000000..7978090d --- /dev/null +++ b/crates/psrs-backend/src/mir/reachable/projection.rs @@ -0,0 +1,105 @@ +//! Reachability of concrete ABI projections and their storage conversion plans. +use super::*; +use crate::cc::{ + Field, GuestLayout, + payload::{PayloadPlanner, StoragePayloadPlanner}, +}; +use psrs_span::TextRange; + +/// Adds every representation the instance-aware projection names. The concrete +/// `value` node of an erased parameter field references a nested representation +/// the abstract signature does not reach, so the projection is what keeps a +/// nested `option` payload's struct and array types planned. +pub(super) fn add_projection( + layout: &GuestLayout, + table: &RepresentationTable, + representations: &mut HashSet, + signatures: &mut HashSet, + representation_work: &mut Vec, + signature_work: &mut Vec, +) -> Result<(), LayoutError> { + match layout { + GuestLayout::Scalar { shape } | GuestLayout::Boxed { shape } => add_value( + shape, + representations, + signatures, + representation_work, + signature_work, + ), + GuestLayout::Product { repr, fields, .. } => { + add_representation(*repr, representations, representation_work); + for field in fields { + add_field( + field, + table, + representations, + signatures, + representation_work, + signature_work, + )?; + } + } + GuestLayout::Variant { repr, cases } => { + add_representation(*repr, representations, representation_work); + for case in cases { + for field in &case.fields { + add_field( + field, + table, + representations, + signatures, + representation_work, + signature_work, + )?; + } + } + } + GuestLayout::Array { repr, element } => { + add_representation(*repr, representations, representation_work); + add_field( + element, + table, + representations, + signatures, + representation_work, + signature_work, + )?; + } + } + Ok(()) +} + +fn add_field( + field: &Field, + table: &RepresentationTable, + representations: &mut HashSet, + signatures: &mut HashSet, + representation_work: &mut Vec, + signature_work: &mut Vec, +) -> Result<(), LayoutError> { + add_projection( + &field.value, + table, + representations, + signatures, + representation_work, + signature_work, + )?; + if matches!(field.stored, ValueShape::Reference(reference) if reference.heap == RefShape::Erased) + && matches!( + field.value, + GuestLayout::Array { .. } | GuestLayout::Product { .. } + ) + { + let plan = StoragePayloadPlanner(table) + .erase_payload(field.value.shape(), TextRange::new(0, 0)) + .map_err(|errors| LayoutError::InvalidPayloadConversion(errors[0].message.clone()))?; + assignments::add_conversion( + &plan, + &mut HashSet::new(), + representations, + representation_work, + ); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs index 0b293582..a40f1824 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs @@ -48,13 +48,16 @@ pub(super) fn build_payload( return Ok((Some(value), block)); } let (value, block) = build_concrete(lowerer, kind, value_node, address, offset, block, span)?; - // The storage slot is either the concrete representation (`stored` names - // the same repr, so no cast) or an erased/aggregate supertype. Cast the - // built reference to the declared storage slot. - let value = if erased { - cast_reference(lowerer, value, &stored, block, span)? + // Bare polymorphic slots store the aggregate owner's canonical protocol, + // rather than a reference to the specialized aggregate. + let (block, value) = if matches!(stored, ValueShape::Reference(reference) + if reference.heap == RefShape::Erased) + { + lowerer.wit_payload_conversion(block, value, value_node.shape(), true, span)? + } else if erased { + (block, cast_reference(lowerer, value, &stored, block, span)?) } else { - value + (block, value) }; Ok((Some(value), block)) } @@ -383,23 +386,17 @@ fn read_record( .iter() .position(|candidate| candidate == &label) .ok_or_else(|| unsupported(span))?; - let (value, next) = build_concrete( + let (value, next) = build_payload( lowerer, &wit_field.ty, &product[index].value, + product[index].stored, address, offset + field_offset, block, span, )?; - // The concrete node builds the nested representation; the record's - // storage slot may be an erased or aggregate supertype that needs a - // cast before the struct is built. - let value = if is_erased(product[index].stored) { - cast_reference(lowerer, value, &product[index].stored, next, span)? - } else { - value - }; + let value = value.ok_or_else(|| unsupported(span))?; values[index] = Some(value); block = next; } diff --git a/crates/psrs-backend/src/mir/wit/aggregate/mod.rs b/crates/psrs-backend/src/mir/wit/aggregate/mod.rs index f36936f0..492178a2 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/mod.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/mod.rs @@ -312,10 +312,10 @@ pub(super) fn recover_payload( kind: &CanonicalType, block: BlockId, span: TextRange, -) -> Result<(ValueId, crate::cc::GuestLayout), Vec> { +) -> Result<(ValueId, crate::cc::GuestLayout, BlockId), Vec> { // A concrete storage slot already stores the source value. if !is_erased(field.stored) { - return Ok((value, field.value.clone())); + return Ok((value, field.value.clone(), block)); } // An erased slot holds a reference (scalar box or erased aggregate). // Recover the concrete source value from the projected node; when the node @@ -327,6 +327,16 @@ pub(super) fn recover_payload( } else { field.value.clone() }; + if matches!(field.stored, ValueShape::Reference(reference) if reference.heap == RefShape::Erased) + && matches!( + concrete, + GuestLayout::Array { .. } | GuestLayout::Product { .. } + ) + { + let (block, recovered) = + lowerer.wit_payload_conversion(block, value, concrete.shape(), false, span)?; + return Ok((recovered, concrete, block)); + } let recovered = match &concrete { crate::cc::GuestLayout::Scalar { shape } => match shape { ValueShape::Integer => unbox_scalar(lowerer, value, false, block, span)?, @@ -337,7 +347,7 @@ pub(super) fn recover_payload( }, other => cast_reference(lowerer, value, &other.shape(), block, span)?, }; - Ok((recovered, concrete)) + Ok((recovered, concrete, block)) } /// Whether a projected node is the storage fallback rather than a concrete diff --git a/crates/psrs-backend/src/mir/wit/aggregate/parameter.rs b/crates/psrs-backend/src/mir/wit/aggregate/parameter.rs index d85c4e2d..7de8bc6e 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/parameter.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/parameter.rs @@ -38,11 +38,6 @@ pub(in crate::mir) fn lower_variant_parameter( .map(|_| lowerer.wit_new_block(Vec::new())) .collect::>(); let default = lowerer.wit_new_block(Vec::new()); - let merge_parameters = joined - .iter() - .map(|ty| lowerer.fresh_wit_value(*ty)) - .collect::>(); - let merge = lowerer.wit_new_block(merge_parameters.clone()); lowerer.wit_switch( current, tag, @@ -56,6 +51,7 @@ pub(in crate::mir) fn lower_variant_parameter( )?; lowerer.wit_jump(default, case_blocks[0], Vec::new(), span)?; + let mut lowered_cases = Vec::new(); for (source_index, _) in case_kinds.iter().enumerate() { let block = case_blocks[source_index]; // The switch is keyed by the guest tag; the selected payload is the @@ -66,7 +62,7 @@ pub(in crate::mir) fn lower_variant_parameter( (Some(payload), Some(case_field)) => (payload, case_field), _ => { let zeros = zero_arguments(lowerer, &joined, block, span)?; - lowerer.wit_jump(block, merge, zeros, span)?; + lowered_cases.push((block, zeros, Vec::new())); continue; } }; @@ -75,23 +71,72 @@ pub(in crate::mir) fn lower_variant_parameter( .ok_or_else(|| unsupported(span))?; let erased = lowerer.fresh_wit_value(field_type); lowerer.wit_variant_get(block, erased, repr, source_index as u32, 0, argument, span)?; - let (value, payload_guest) = + let (value, payload_guest, block) = recover_payload(lowerer, erased, case_field, payload, block, span)?; let mut case_flat = Vec::new(); + let mut case_frees = Vec::new(); let end = lower_parameter( lowerer, value, Some(&payload_guest), payload, &mut case_flat, - frees, + &mut case_frees, block, span, )?; let arguments = pad_to(lowerer, case_flat, &joined, end, span)?; + lowered_cases.push((end, arguments, case_frees)); + } + merge_cases(lowerer, lowered_cases, &joined, flat, frees, span) +} + +/// A branch's buffers remain live through the host call. Merge their pointer, +/// byte length and element count as well as the flattened canonical payload. +/// Inactive branches supply null/zero, so post-call frees are dominated and +/// free no storage for an unselected case, including nested variants. +fn merge_cases( + lowerer: &mut L, + cases: Vec<(BlockId, Vec, Vec)>, + joined: &[ValueType], + flat: &mut Vec, + frees: &mut Vec, + span: TextRange, +) -> Result> { + let payload = joined + .iter() + .map(|ty| lowerer.fresh_wit_value(*ty)) + .collect::>(); + let free_count = cases.iter().map(|(_, _, frees)| frees.len()).sum::(); + let free_parameters = (0..free_count * 3) + .map(|_| lowerer.fresh_wit_value(ValueType::I32)) + .collect::>(); + let merge = lowerer.wit_new_block(payload.iter().chain(&free_parameters).copied().collect()); + let mut offset = 0; + for (end, mut arguments, case_frees) in cases { + let zero = zero_argument(lowerer, ValueType::I32, end, span)?; + let mut free_arguments = vec![zero; free_parameters.len()]; + let count = case_frees.len(); + for (index, mut pending) in case_frees.into_iter().enumerate() { + let slot = (offset + index) * 3; + free_arguments[slot] = pending.pointer; + free_arguments[slot + 1] = pending.length; + free_arguments[slot + 2] = pending + .elements + .as_ref() + .map_or(zero, |elements| elements.count); + pending.pointer = free_parameters[slot]; + pending.length = free_parameters[slot + 1]; + if let Some(elements) = &mut pending.elements { + elements.count = free_parameters[slot + 2]; + } + frees.push(pending); + } + offset += count; + arguments.extend(free_arguments); lowerer.wit_jump(end, merge, arguments, span)?; } - flat.extend(merge_parameters); + flat.extend(payload); Ok(merge) } diff --git a/crates/psrs-backend/src/mir/wit/call_lowerer.rs b/crates/psrs-backend/src/mir/wit/call_lowerer.rs index 726c364c..050b5841 100644 --- a/crates/psrs-backend/src/mir/wit/call_lowerer.rs +++ b/crates/psrs-backend/src/mir/wit/call_lowerer.rs @@ -125,6 +125,22 @@ pub(crate) trait WitCallLowerer { None } + /// Converts an aggregate into or out of its bare-slot storage protocol. + fn wit_payload_conversion( + &mut self, + _block: BlockId, + _value: ValueId, + _shape: ValueShape, + _entering: bool, + span: TextRange, + ) -> Result<(BlockId, ValueId), Vec> { + Err(vec![BackendError::new( + "P9 MIR lowering", + span, + "canonical aggregate payload has no storage conversion", + )]) + } + /// The concrete GC type of a representation handle. fn wit_repr_index(&self, _repr: crate::cc::ReprId) -> Option { None diff --git a/crates/psrs-backend/src/mir/wit/function_lowerer.rs b/crates/psrs-backend/src/mir/wit/function_lowerer.rs index a0f86314..2344ae2e 100644 --- a/crates/psrs-backend/src/mir/wit/function_lowerer.rs +++ b/crates/psrs-backend/src/mir/wit/function_lowerer.rs @@ -169,6 +169,34 @@ impl WitCallLowerer for FunctionLowerer<'_> { self.resolved_guest_layout(shape) } + fn wit_payload_conversion( + &mut self, + block: BlockId, + value: ValueId, + shape: crate::cc::ValueShape, + entering: bool, + span: TextRange, + ) -> Result<(BlockId, ValueId), Vec> { + use crate::cc::payload::PayloadPlanner; + let mut planner = + crate::cc::payload::StoragePayloadPlanner(self.layout.representation_table()); + let plan = if entering { + planner.erase_payload(shape, span)? + } else { + planner.recover_payload(shape, span)? + }; + let source = if entering { + shape + } else { + crate::cc::ValueShape::Reference(crate::cc::Reference { + nullable: false, + heap: crate::cc::RefShape::Erased, + }) + }; + let (block, value, _) = self.lower_value_conversion(block, value, source, &plan, span)?; + Ok((block, value)) + } + fn wit_repr_index(&self, repr: crate::cc::ReprId) -> Option { self.resolved_repr_index(repr) } diff --git a/crates/psrs-driver/src/tests/wasi/mod.rs b/crates/psrs-driver/src/tests/wasi/mod.rs index 8ad8306c..bd516729 100644 --- a/crates/psrs-driver/src/tests/wasi/mod.rs +++ b/crates/psrs-driver/src/tests/wasi/mod.rs @@ -2,6 +2,7 @@ use super::*; mod do_notation; mod filesystem; +mod payloads; mod wat; mod where_clause; use wat::*; diff --git a/crates/psrs-driver/src/tests/wasi/payloads.rs b/crates/psrs-driver/src/tests/wasi/payloads.rs new file mode 100644 index 00000000..046753ec --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/payloads.rs @@ -0,0 +1,32 @@ +use super::*; + +#[test] +fn wit_result_bytes_recover_values_and_empty_arrays_when_wasmtime_is_available() { + let source = r#"module Main where +import Prelude +import Data.Either (Either(..)) +import WASI.IO (getStdin, blockingRead) +main = + let stream = runEffect getStdin in + let empty = runEffect (blockingRead stream 0) in + case empty of + Left _ -> 1 + Right zero -> + let result = runEffect (blockingRead stream 4) in + case result of + Left _ -> 2 + Right bytes -> + if arrayLength zero == 0 && arrayLength bytes == 4 + && arrayIndex bytes 0 == 0 && arrayIndex bytes 1 == 255 + && arrayIndex bytes 2 == 128 && arrayIndex bytes 3 == 42 + then 42 + else 3 +"#; + let Some(output) = run_with_wasmtime_stdin(source, &[0, 255, 128, 42, 99]) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty(), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index b85c3362..c96c9912 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -206,6 +206,14 @@ they are not reconstructed as records. Checked storage primitives consume their checked use representations before ABI erasure, preserving writes to the owning storage object. +Canonical ABI adapters follow the same owner protocols for aggregates in +bare erased fields. Decoding first constructs the checked concrete value, then +normalizes it before storing the field; parameter lowering recovers the checked +concrete value before flattening it. CC conversion and ABI lowering share the +recursive storage conversion planner. Layout reachability traverses these ABI +conversion plans before assigning target types, retaining their protocol +representations and scalar boxes. Missing owner protocols are errors. + ### Bare polymorphic function slots A bare type variable stores functions using one registered unary protocol: @@ -441,6 +449,8 @@ implementation target is split across the topic owners: ```text cc/lower/conversion/ the planner and emission: scalar, reference, callable and aggregate leaves, and the generated adapters +cc/payload.rs bare-slot storage plans shared by CC and canonical ABI +mir/reachable/ projection and storage-plan layout requirements cc/layout/ constructor policies for the local constructors (Function, Array, data, newtype) and signature interning cc/verify/ conversion-plan endpoint, capture and call-signature checks diff --git a/docs/implementation/backend/wit-erased-payloads.md b/docs/implementation/backend/wit-erased-payloads.md new file mode 100644 index 00000000..01d8431b --- /dev/null +++ b/docs/implementation/backend/wit-erased-payloads.md @@ -0,0 +1,85 @@ +# WIT Aggregates in Erased Payload Slots + +Measured on 2026-10-07. + +**Design:** [Runtime representation and checked boundaries](../../design/backend/fp/representation-and-evidence.md#aggregates-in-bare-polymorphic-slots) + +## Starting point and boundary + +Baseline: `11db1757c20b76b5231e033395f000714f279baa`, branch +`stdlib/vendor-core-libraries`, clean worktree. The locked standard library +was unchanged throughout this compiler repair. + +`PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::wasi:: -- --nocapture` +ran 145 tests: 142 passed and three trapped with `cast failure`: + +- `filesystem::stats_and_reads_a_directory_through_preopens_when_wasmtime_is_available` +- `filesystem::writes_and_reads_a_file_through_preopens_when_wasmtime_is_available` +- `wrappers::reads_stdin_with_blocking_read_when_wasmtime_is_available` + +The minimal source reads five stdin bytes through `WASI.IO.blockingRead`, +extracts `Right bytes`, and returns `arrayIndex bytes 0`. Both before and after +compile diagnosis accepted this source. Identical source inputs and the locked +library were confirmed by `diagnose --compare`; no observed pass-status change +was reported. Compile acceptance did not establish runtime correctness. + +The mismatch was at canonical ABI decoding into the generic variant field. +The decoder constructed a specialized array or record and cast its reference +into the erased slot. Source constructors normalize these values into the +aggregate owner's canonical erased-element or erased-field storage protocol. +The checked consumer therefore tried to recover a protocol value from a +specialized aggregate. + +## Repair + +- CC and canonical ABI adapters share `cc::payload::PayloadPlanner` for recursive + scalar boxing and array/record normalization and recovery. Nominal references + retain their identity behavior. +- Decoded aggregate payloads normalize before entering bare erased fields. + Variant parameter lowering recovers the concrete checked value before ABI + flattening. Conversion control-flow exits are propagated to their consumers. +- ABI projection reachability traverses the same storage conversion plans before + target layouts are assigned, retaining protocol layouts and required boxes. + Missing owner protocols produce an error. +- Variant parameter branches pass call-local buffer pointers, byte lengths and + element counts through the merge block. Inactive cases pass null and zero; + post-call cleanup no longer uses branch-local values outside their dominance + scope. Nested variant cleanup composes through the same merge mechanism. + +## Evidence and limits + +Runtime evidence requires Wasmtime, using version `49.0.2` in this run. The +existing stdin test asserts `hello\n`; file tests assert file contents and +console output, including nested record/option payloads. The new +`payloads::wit_result_bytes_recover_values_and_empty_arrays_when_wasmtime_is_available` +asserts empty-array length and exact byte values `0`, `255`, `128`, `42`, then +returns 42 with empty stdout and stderr. Arbitrary bytes are tested as +`Array Int`, without requiring valid UTF-8. + +Three backend regressions cover record and record-array ABI result-to-parameter +round trips and rejection of a missing owner protocol. These lower, optimize, +encode and validate Wasm; they do not execute a synthetic host import. Actual +runtime evidence comes from the driver tests above. + +Focused validation commands: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::wasi:: -- --nocapture +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib cc:: -- --nocapture +cargo test -p psrs-backend --lib mir:: -- --nocapture +cargo test -p psrs-cli --test source_layout +cargo fmt --all --check +cargo clippy --workspace --all-targets -- -D warnings +``` + +The final WASI selection passed 146 tests (the original 145 plus the new byte +payload regression), with zero failures or ignored tests. The standalone stdin +reproducer returned 104 for `hello`, with empty stdout and stderr. Its Wasm +SHA-256 was `a9a672b121379ebd7c3cd26518953bb9c5365fd3ff6a0382b75e0e4003fa7dbf`. + +The CC selection passed 114 tests. The MIR selection passed 188 tests, including +all three new regressions. Source-layout validation, formatting, and workspace clippy passed. +Full workspace tests and corpus scoreboards were +not run; the user requested focused validation. This is acceptance for this ABI +repair, not completion of the broader backend or unrelated Show, row-evidence, +or ambiguity work. From df3626ea0d17a92d5bcd9c9f1e7d04bdffcbfe80 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 02:58:19 +0800 Subject: [PATCH 052/148] Keep local bindings monomorphic through declaration ambiguity checks --- .../src/opt/inline/global/analysis.rs | 22 +- .../psrs-core/src/opt/inline/global/call.rs | 6 +- crates/psrs-core/src/opt/inline/local.rs | 12 +- crates/psrs-core/src/opt/tests/rank_inline.rs | 4 +- crates/psrs-core/src/tests/rank_n.rs | 73 ++++ crates/psrs-core/src/verify/scopes/expr.rs | 6 +- .../psrs-driver/src/tests/let_constraints.rs | 11 +- .../src/tests/polymorphism_erasure_audit.rs | 28 +- crates/psrs-driver/tests/upstream/mod.rs | 1 + .../tests/upstream/residual_constraints.rs | 81 +++++ crates/psrs-thir/src/rank_n_tests.rs | 70 ++++ crates/psrs-thir/src/scope/mod.rs | 6 +- .../src/typecheck/classes/solve/entry.rs | 11 +- .../src/typecheck/infer/let_expr.rs | 313 ++---------------- .../psrs-typecheck/src/typecheck/tests/mod.rs | 12 +- .../frontend/type-system/type-inference.md | 49 +-- .../residual-ambiguity-observations.json | 63 ++++ .../frontend/residual-ambiguity.md | 72 ++++ 18 files changed, 464 insertions(+), 376 deletions(-) create mode 100644 crates/psrs-driver/tests/upstream/residual_constraints.rs create mode 100644 docs/implementation/frontend/residual-ambiguity-observations.json create mode 100644 docs/implementation/frontend/residual-ambiguity.md diff --git a/crates/psrs-core/src/opt/inline/global/analysis.rs b/crates/psrs-core/src/opt/inline/global/analysis.rs index f1e2f03c..055c7509 100644 --- a/crates/psrs-core/src/opt/inline/global/analysis.rs +++ b/crates/psrs-core/src/opt/inline/global/analysis.rs @@ -1,5 +1,5 @@ use crate::{Expr, ExprKind, Type, TypeId}; -use psrs_hir::{SymbolId, TypeVariableId}; +use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; pub(super) fn application_parts(expression: &Expr) -> (&Expr, Vec<&Expr>) { @@ -39,26 +39,6 @@ fn type_has_forall(id: TypeId, types: &[Type], seen: &mut HashSet) -> bo } } -/// Leading quantifiers of an expression type. A beta-reduced let keeps this -/// type, and Core opens those binders for the let body only. Bindings need the -/// same binders in `quantified` when the inlined callee or its argument -/// mentions them. -pub(in crate::opt::inline) fn leading_foralls( - mut id: TypeId, - types: &[Type], -) -> Vec { - let mut binders = Vec::new(); - let mut seen = HashSet::new(); - while let Some(Type::ForAll { variables, body }) = types.get(id.0 as usize) { - if !seen.insert(id) { - break; - } - binders.extend(variables.iter().copied()); - id = *body; - } - binders -} - pub(in crate::opt::inline) fn expr_introduces_type_binders( expression: &Expr, types: &[Type], diff --git a/crates/psrs-core/src/opt/inline/global/call.rs b/crates/psrs-core/src/opt/inline/global/call.rs index 0c371f39..0916dcdc 100644 --- a/crates/psrs-core/src/opt/inline/global/call.rs +++ b/crates/psrs-core/src/opt/inline/global/call.rs @@ -1,8 +1,6 @@ use super::super::super::util::{FreshLocals, count_nodes, substitute_locals}; use super::super::alpha::clone_with_fresh_locals; -use super::analysis::{ - application_parts, function_arity, introduces_type_binders, leading_foralls, -}; +use super::analysis::{application_parts, function_arity, introduces_type_binders}; use crate::{Binder, Binding, Declaration, Expr, ExprKind, Type}; use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; @@ -68,7 +66,7 @@ pub(super) fn inline_named_global( ty: parameter.ty, span: parameter.span, }, - quantified: leading_foralls(application.ty, types), + quantified: Vec::new(), value: argument.clone(), span: application.span, }); diff --git a/crates/psrs-core/src/opt/inline/local.rs b/crates/psrs-core/src/opt/inline/local.rs index ef5638e0..87a3b5cf 100644 --- a/crates/psrs-core/src/opt/inline/local.rs +++ b/crates/psrs-core/src/opt/inline/local.rs @@ -1,5 +1,5 @@ use super::super::util::{FreshLocals, count_nodes, next_locals, substitute_locals}; -use super::global::analysis::{expr_introduces_type_binders, leading_foralls}; +use super::global::analysis::expr_introduces_type_binders; use crate::{Binding, Expr, ExprKind, Module, Type}; use std::collections::HashMap; @@ -132,12 +132,8 @@ fn inline_expr( span: expression.span, }; let body = substitute_locals(&body, &HashMap::from([(binder.id, replacement)])); - // The result type's leading quantifiers covered both the - // callee and the argument. The let body reopens them from - // its type; the binding does not, so they have to be named - // here. Newtype deriving casts an entire quantified method - // under an unknown constructor, and that variable occurs in - // the wrapped dictionary's type. + // The enclosing let's result quantifiers scope both its + // argument binding and body; the binding stays monomorphic. ExprKind::Let { bindings: vec![Binding { binder: crate::Binder { @@ -146,7 +142,7 @@ fn inline_expr( ty: binder.ty, span: binder.span, }, - quantified: leading_foralls(expression.ty, types), + quantified: Vec::new(), value: argument, span: expression.span, }], diff --git a/crates/psrs-core/src/opt/tests/rank_inline.rs b/crates/psrs-core/src/opt/tests/rank_inline.rs index fa3d3efe..3df81edc 100644 --- a/crates/psrs-core/src/opt/tests/rank_inline.rs +++ b/crates/psrs-core/src/opt/tests/rank_inline.rs @@ -177,7 +177,7 @@ fn global_inline_keeps_a_forall_signature_with_an_empty_quantified_list() { } #[test] -fn local_inline_keeps_a_result_quantifier_on_the_binding() { +fn local_inline_keeps_a_result_quantifier_on_the_enclosing_let() { let variable = TypeId(0); let int_type = TypeId(1); let mut types = vec![ @@ -229,5 +229,5 @@ fn local_inline_keeps_a_result_quantifier_on_the_binding() { let ExprKind::Let { bindings, .. } = &optimized.declarations[0].value.kind else { panic!("the coercion lambda should beta-reduce: {optimized:?}"); }; - assert_eq!(bindings[0].quantified, vec![TypeVariableId(0)]); + assert!(bindings[0].quantified.is_empty()); } diff --git a/crates/psrs-core/src/tests/rank_n.rs b/crates/psrs-core/src/tests/rank_n.rs index 766ec086..12535e70 100644 --- a/crates/psrs-core/src/tests/rank_n.rs +++ b/crates/psrs-core/src/tests/rank_n.rs @@ -350,3 +350,76 @@ fn verifier_rejects_an_empty_forall() { "forall binders must be non-empty, unique, and lexically distinct", ); } + +#[test] +fn quantified_let_scopes_its_locals_and_rejects_unbound_local_variables() { + for unbound in [false, true] { + let outer = TypeVariableId(10); + let inner = if unbound { TypeVariableId(11) } else { outer }; + let mut types = vec![Type::Variable(outer), Type::Variable(inner)]; + let outer_arrow = arrow(&mut types, TypeId(0), TypeId(0)); + let inner_arrow = arrow(&mut types, TypeId(1), TypeId(1)); + let quantified = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![outer], + body: outer_arrow, + }); + let binder = Binder { + id: LocalId(0), + name: "ident".into(), + ty: inner_arrow, + span: SPAN, + }; + let local_value = Expr { + kind: ExprKind::Lambda { + binder: Binder { + id: LocalId(1), + name: "x".into(), + ty: TypeId(1), + span: SPAN, + }, + body: Box::new(Expr { + kind: ExprKind::Local(LocalId(1)), + ty: TypeId(1), + span: SPAN, + }), + }, + ty: inner_arrow, + span: SPAN, + }; + let value = Expr { + kind: ExprKind::Let { + bindings: vec![Binding { + binder, + quantified: Vec::new(), + value: local_value, + span: SPAN, + }], + body: Box::new(Expr { + kind: ExprKind::Local(LocalId(0)), + ty: outer_arrow, + span: SPAN, + }), + }, + ty: quantified, + span: SPAN, + }; + let module = module( + types, + vec![declaration(0, "main", Vec::new(), quantified, value)], + ); + if unbound { + assert!( + module + .verify() + .unwrap_err() + .iter() + .any(|error| error.message == "type variable is outside its quantifier scope") + ); + } else { + module + .verify() + .expect("the enclosing forall scopes monomorphic local definitions"); + } + } +} diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index 43f35ea8..04a1c19b 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -107,8 +107,10 @@ pub(super) fn scoped_expr( scoped_expr(body, module, &mut body_scope, errors); } ExprKind::Let { bindings, body } => { + let mut body_scope = scope.clone(); + open_expression_binders(expression, module, &mut body_scope, errors); for binding in bindings { - let mut binding_scope = scope.clone(); + let mut binding_scope = body_scope.clone(); enter( &binding.quantified, &mut binding_scope, @@ -127,8 +129,6 @@ pub(super) fn scoped_expr( ); scoped_expr(&binding.value, module, &mut binding_scope, errors); } - let mut body_scope = scope.clone(); - open_expression_binders(expression, module, &mut body_scope, errors); scoped_expr(body, module, &mut body_scope, errors); } ExprKind::If { diff --git a/crates/psrs-driver/src/tests/let_constraints.rs b/crates/psrs-driver/src/tests/let_constraints.rs index 6613a4f0..9ef9c6ea 100644 --- a/crates/psrs-driver/src/tests/let_constraints.rs +++ b/crates/psrs-driver/src/tests/let_constraints.rs @@ -1,7 +1,6 @@ -//! Constraints inferred inside a local binding stay with that binding when the -//! enclosing declaration has a signature. The use instantiates them, so a -//! monad that is still unknown while the binding is checked can be `Maybe` at -//! the call. +//! Monomorphic local bindings share unknowns and constraints with the enclosing +//! declaration. A local call can determine a previously unknown monad as `Maybe`; +//! the enclosing declaration solves the resulting obligation. fn assert_checks(source: &str) { crate::check_program(&[("Main.purs", source)]) @@ -9,7 +8,7 @@ fn assert_checks(source: &str) { } #[test] -fn a_signed_function_generalizes_constraints_of_its_where_binding() { +fn a_signed_function_solves_constraints_of_its_where_binding() { let source = r#" module Main where @@ -270,7 +269,7 @@ main = 0 } #[test] -fn a_solved_local_dictionary_uses_the_local_schemes_quantified_variables() { +fn a_solved_local_dictionary_uses_the_enclosing_methods_quantified_variables() { assert_checks( r#" module Main where diff --git a/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs b/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs index 39015ae1..51128a3a 100644 --- a/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs +++ b/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs @@ -286,18 +286,18 @@ fn linked_modules_round_trip_an_erased_high_bit_int() { } #[test] -fn a_locally_generalized_binding_instantiates_at_int() { - // `id` is generalized at the local `let`, so its runtime value is erased. +fn an_explicitly_polymorphic_local_binding_instantiates_at_int() { + // `id` declares a local polymorphic annotation, so its runtime value is erased. // The `id 42` use must box the erased argument and recover the integer // result exactly as a top-level polymorphic declaration would. - let source = "module Main where\nmain = let id = \\x -> x in id 42\n"; + let source = "module Main where\nmain = let id = (\\x -> x) :: forall a. a -> a in id 42\n"; expect_exit("local_polymorphic_int", source, 42); } #[test] -fn a_locally_generalized_binding_instantiates_at_two_types() { +fn an_explicitly_polymorphic_local_binding_instantiates_at_two_types() { // The same erased local value is recovered at `String` and at `Int`. - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let id = \\x -> x in runEffect (do\n log (id \"hello\")\n pure (id 42))\n"; + let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let id = (\\x -> x) :: forall a. a -> a in runEffect (do\n log (id \"hello\")\n pure (id 42))\n"; let artifact = compile_source("Main.purs", source).expect("the two-type local use should compile"); match execute_component("local_polymorphic_two_types", &artifact.wasm) { @@ -311,29 +311,30 @@ fn a_locally_generalized_binding_instantiates_at_two_types() { } #[test] -fn a_locally_generalized_binding_passes_to_a_polymorphic_function() { +fn an_explicitly_polymorphic_local_binding_passes_to_a_polymorphic_function() { // `apply :: forall a. (a -> a) -> a -> a` receives the erased local value, // so the argument and result cross the erased boundary at the concrete type. - let source = "module Main where\napply :: forall a. (a -> a) -> a -> a\napply f x = f x\nmain = let id = \\x -> x in apply id 42\n"; + let source = "module Main where\napply :: forall a. (a -> a) -> a -> a\napply f x = f x\nmain = let id = (\\x -> x) :: forall a. a -> a in apply id 42\n"; expect_exit("local_polymorphic_argument", source, 42); } #[test] -fn a_curried_locally_generalized_binding_instantiates() { - // A locally generalized curried function with an argument: the flattened +fn a_curried_explicitly_polymorphic_local_binding_instantiates() { + // An explicitly polymorphic local curried function with an argument: the flattened // erased source has two parameters, matching the concrete use. - let source = "module Main where\nmain = let const = \\x -> \\y -> x in const 42 \"ignored\"\n"; + let source = "module Main where\nmain = let const = (\\x -> \\y -> x) :: forall a b. a -> b -> a in const 42 \"ignored\"\n"; expect_exit("local_polymorphic_curried", source, 42); } #[test] -fn a_locally_generalized_identity_instantiates_at_a_function_type() { +fn an_explicitly_polymorphic_local_identity_instantiates_at_a_function_type() { // `(id id) 42`: the outer `id` is instantiated at `Int -> Int`, so its // flattened use type `(Int -> Int) -> (Int -> Int)` is wider than the // erased source `a -> a`. The recursive adapter must eta-expand, call the // erased source with the inner `id`, recover the result at `Int -> Int`, // and apply `42`. - let source = "module Main where\nmain = let id = \\x -> x in (id id) 42\n"; + let source = + "module Main where\nmain = let id = (\\x -> x) :: forall a. a -> a in (id id) 42\n"; expect_exit("local_polymorphic_function_type_identity", source, 42); } @@ -342,8 +343,7 @@ fn a_local_polymorphic_value_is_applied_after_a_function_type_instantiation() { // The same eta-expansion reached with a concrete function argument: // `id` is instantiated at `Int -> Int`, applied to `\y -> y + 1`, and the // recovered function is applied to `41`. - let source = - "module Main where\nimport Prelude\nmain = let id = \\x -> x in (id (\\y -> y + 1)) 41\n"; + let source = "module Main where\nimport Prelude\nmain = let id = (\\x -> x) :: forall a. a -> a in (id (\\y -> y + 1)) 41\n"; expect_exit("local_polymorphic_function_type_argument", source, 42); } diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 4efef3d7..733c06b9 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -6,6 +6,7 @@ mod deriving; mod library_foreign; mod rank_n; mod reports; +mod residual_constraints; mod rows; mod symbol_reflection; diff --git a/crates/psrs-driver/tests/upstream/residual_constraints.rs b/crates/psrs-driver/tests/upstream/residual_constraints.rs new file mode 100644 index 00000000..37287b64 --- /dev/null +++ b/crates/psrs-driver/tests/upstream/residual_constraints.rs @@ -0,0 +1,81 @@ +use super::{purs_available, purs_error_codes, purs_sources_output}; +use psrs_driver::check_source; + +#[test] +fn local_binding_constraints_and_annotations_match_official_purs() { + if !purs_available() { + eprintln!("skipping: purs is not installed"); + return; + } + for (name, body, expected) in [ + ( + "unused-constrained-local", + "class C a where\n method :: a -> a\nf y = let g x = method x in y\n", + Some("AmbiguousTypeVariables"), + ), + ( + "used-constrained-local", + "class C a where\n method :: a -> a\nf y = let g x = method x in g y\n", + None, + ), + ( + "unannotated-local", + "f = let ident x = x in { a: ident 1, b: ident true }\n", + Some("TypesDoNotUnify"), + ), + ( + "annotated-local", + "f = let ident = (\\x -> x) :: forall a. a -> a in { a: ident 1, b: ident true }\n", + None, + ), + ( + "annotated-constrained-local", + "class C a where\n method :: a -> a\nf y = let g = (\\x -> method x) :: forall a. C a => a -> a in y\n", + None, + ), + ( + "fundep-determined-local", + "class C a b | a -> b where\n method :: a -> b\nf x = let g y = method y in g x\n", + None, + ), + ] { + let source = format!("module Main where\n{body}"); + let official = purs_sources_output(name, &[("Main.purs", &source)]); + let local = check_source("Main.purs", &source); + assert_eq!( + official.status.success(), + expected.is_none(), + "{name}: {official:?}" + ); + match expected { + Some(code) => { + assert!( + purs_error_codes(&official) + .iter() + .any(|found| found == code), + "{name}: {official:?}" + ); + let errors = local.expect_err(name); + assert!( + errors.iter().any(|error| error.code == Some(code)), + "{name}: {errors:?}" + ); + } + None => local.unwrap_or_else(|errors| panic!("{name}: {errors:?}")), + } + } +} + +#[test] +fn official_constraint_inference_case_reports_its_annotated_ambiguity() { + let source = include_str!("../../../../tests/upstream/failing/ConstraintInference.purs"); + assert!(source.contains("@shouldFailWith AmbiguousTypeVariables")); + let errors = check_source("ConstraintInference.purs", source) + .expect_err("the inferred result does not determine Show's argument"); + assert!( + errors + .iter() + .any(|error| error.code == Some("AmbiguousTypeVariables")), + "{errors:?}" + ); +} diff --git a/crates/psrs-thir/src/rank_n_tests.rs b/crates/psrs-thir/src/rank_n_tests.rs index ec2705af..0e717419 100644 --- a/crates/psrs-thir/src/rank_n_tests.rs +++ b/crates/psrs-thir/src/rank_n_tests.rs @@ -392,3 +392,73 @@ fn verifier_rejects_two_residuals_for_one_row_variable() { "global reference is not a valid scheme instance", ); } + +#[test] +fn quantified_let_scopes_its_locals_and_rejects_unbound_local_variables() { + for unbound in [false, true] { + let outer = TypeVariableId(10); + let inner = if unbound { TypeVariableId(11) } else { outer }; + let mut types = vec![Type::Variable(outer), Type::Variable(inner)]; + let outer_arrow = arrow(&mut types, TypeId(0), TypeId(0)); + let inner_arrow = arrow(&mut types, TypeId(1), TypeId(1)); + let quantified = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![outer], + body: outer_arrow, + }); + let binder = Binder { + id: LocalId(0), + name: "ident".into(), + ty: inner_arrow, + span: SPAN, + }; + let local_value = Expr { + kind: ExprKind::Lambda { + binder: Binder { + id: LocalId(1), + name: "x".into(), + ty: TypeId(1), + span: SPAN, + }, + body: Box::new(Expr { + kind: ExprKind::Local(LocalId(1)), + ty: TypeId(1), + span: SPAN, + }), + }, + ty: inner_arrow, + span: SPAN, + }; + let value = Expr { + kind: ExprKind::Let { + bindings: vec![Binding { + binder, + quantified: Vec::new(), + value: local_value, + span: SPAN, + }], + body: Box::new(Expr { + kind: ExprKind::Local(LocalId(0)), + ty: outer_arrow, + span: SPAN, + }), + }, + ty: quantified, + span: SPAN, + }; + let module = module(types, vec![declaration(0, Vec::new(), quantified, value)]); + if unbound { + assert!( + module + .verify() + .unwrap_err() + .iter() + .any(|error| error.message == "type variable is outside its quantifier scope") + ); + } else { + module + .verify() + .expect("the enclosing forall scopes monomorphic local definitions"); + } + } +} diff --git a/crates/psrs-thir/src/scope/mod.rs b/crates/psrs-thir/src/scope/mod.rs index 05bf57c1..c3292bba 100644 --- a/crates/psrs-thir/src/scope/mod.rs +++ b/crates/psrs-thir/src/scope/mod.rs @@ -305,8 +305,10 @@ fn verify_expr_scope( verify_expr_scope(body, types, &mut body_scope, errors); } ExprKind::Let { bindings, body } => { + let mut body_scope = scope.clone(); + open_expression_binders(expression, types, &mut body_scope, errors); for binding in bindings { - let mut binding_scope = scope.clone(); + let mut binding_scope = body_scope.clone(); enter_binders( &binding.quantified, &mut binding_scope, @@ -324,8 +326,6 @@ fn verify_expr_scope( ); verify_expr_scope(&binding.value, types, &mut binding_scope, errors); } - let mut body_scope = scope.clone(); - open_expression_binders(expression, types, &mut body_scope, errors); verify_expr_scope(body, types, &mut body_scope, errors); } ExprKind::If { diff --git a/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs b/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs index 41602b45..43da20a0 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/solve/entry.rs @@ -60,12 +60,6 @@ pub(in crate::typecheck) enum UnsolvedPolicy { /// quantify, so it is still `NoInstance`: generalizing it would hide a /// missing instance rather than defer it. Retain, - /// Every undischarged obligation is returned to the caller and none is - /// reported here. A nested `let` uses this to choose which constraints - /// become the binding's dictionary parameters and which stay with the - /// enclosing declaration. The enclosing solve still reports an obligation - /// this pass left unsolved. - Defer, } impl Checker { @@ -157,15 +151,14 @@ impl Checker { /// Whether `unsolved` keeps this constraint instead of reporting it. /// - /// `Defer` keeps every undischarged obligation so a caller can decide which - /// scope owns it. `Retain` keeps one only while it can still be quantified. + /// `Retain` keeps one only while it can still be quantified by the + /// enclosing declaration. pub(in crate::typecheck) fn policy_keeps_unsolved( &self, unsolved: UnsolvedPolicy, constraint: &WantedConstraint, ) -> bool { match unsolved { - UnsolvedPolicy::Defer => true, UnsolvedPolicy::Retain => self.can_generalize_constraint(constraint), UnsolvedPolicy::RequireSolved => false, } diff --git a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs index 5e8a9493..8ce1636a 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs @@ -1,15 +1,11 @@ -//! Local `let` and `where` bindings. +//! Local `let` and `where` bindings share the enclosing declaration's unknowns. //! -//! A binding is generalized before its body so each use instantiates it. The -//! constraints inferred from the binding are part of that scheme when every -//! flexible variable they mention was allocated inside the binding and one -//! binding's type determines them. Other undischarged constraints stay on the -//! enclosing declaration: an outer unknown can still be solved by a later use, -//! and a recursive group does not quantify a variable an open constraint shares. +//! Unannotated locals are monomorphic, including their class obligations. +//! Solving and generalization belong to the enclosing declaration. An explicit +//! polymorphic annotation retains its checked quantifiers and is instantiated +//! independently at each local use. -use super::super::classes::{UnsolvedPolicy, collect_infer_variables}; use super::super::*; -use std::collections::HashSet; impl Checker { pub(in crate::typecheck) fn infer_let_expression( @@ -18,285 +14,46 @@ impl Checker { body: &hir::Expr, expected: Option, ) -> Option<(InferredExprKind, InferType)> { - // Binding bodies are inferred one level deeper, so their unknowns are - // generalized against this level; the body is checked back at it. - let outer_level = self.state.level; - let (inferred_bindings, body) = self.in_nested_level(|checker| { - let wanted_start = checker.state.wanted.len(); + let previous_locals = self.scope.locals.clone(); + let result = self.with_scope(|checker| { let mut binders = Vec::with_capacity(bindings.len()); for binding in bindings { - let ty = checker.fresh(); + let scheme = Scheme::monomorphic(checker.fresh()); checker .scope .locals - .insert(binding.binder.id, Scheme::monomorphic(ty.clone())); + .insert(binding.binder.id, scheme.clone()); binders.push(InferredBinder { binder: binding.binder.clone(), - scheme: Scheme::monomorphic(ty), + scheme, }); } - let mut inferred_bindings = Vec::with_capacity(bindings.len()); - for (binding, binder) in bindings.iter().zip(binders) { - if let Some(value) = checker.infer_expr(&binding.value) { - checker.unify(binder.scheme.ty.clone(), value.ty.clone(), binding.span); - inferred_bindings.push(InferredBinding { - binder, - value, - span: binding.span, - }); - } - } - checker.generalize_let_bindings( - bindings, - &mut inferred_bindings, - outer_level, - wanted_start, - ); - checker.state.level = outer_level; - let body = checker.infer_expr_with_expected(body, expected); - for binding in bindings { - checker.scope.locals.remove(&binding.binder.id); + let mut inferred = Vec::with_capacity(bindings.len()); + for (binding, mut binder) in bindings.iter().zip(binders) { + let value = checker.infer_expr(&binding.value)?; + checker.unify(binder.scheme.ty, value.ty.clone(), binding.span); + binder.scheme = Scheme::monomorphic(value.ty.clone()); + checker + .scope + .locals + .insert(binding.binder.id, binder.scheme.clone()); + inferred.push(InferredBinding { + binder, + value, + span: binding.span, + }); } - (inferred_bindings, body) + let body = checker.infer_expr_with_expected(body, expected)?; + let ty = body.ty.clone(); + Some(( + InferredExprKind::Let { + bindings: inferred, + body: Box::new(body), + }, + ty, + )) }); - let body = body?; - let ty = body.ty.clone(); - Some(( - InferredExprKind::Let { - bindings: inferred_bindings, - body: Box::new(body), - }, - ty, - )) - } - - /// Splits the constraints the bindings raised. Ones determined by a single - /// binding become its dictionary parameters; the rest keep their unknowns - /// shared with the enclosing scope. - fn generalize_let_bindings( - &mut self, - bindings: &[hir::LocalBinding], - inferred: &mut [InferredBinding], - outer_level: u32, - wanted_start: usize, - ) { - let unsolved = self.solve_wanted_constraints(None, wanted_start, UnsolvedPolicy::Defer); - let recursive = bindings_are_recursive(bindings); - let binding_variables = inferred - .iter() - .map(|binding| { - let mut variables = HashSet::new(); - collect_infer_variables( - &self.resolve_type(binding.binder.scheme.ty.clone()), - &mut variables, - ); - variables - }) - .collect::>(); - let mut owned = vec![Vec::new(); inferred.len()]; - let mut lowered = HashSet::new(); - for index in unsolved { - let variables = self.constraint_variables(index); - let deep = self.deep_variables(&variables, outer_level); - let shares_outer = variables - .iter() - .any(|variable| !deep.contains(variable) && !self.state.rigid.contains(variable)); - if deep.is_empty() || recursive || shares_outer { - lowered.extend(deep); - continue; - } - let owners = binding_variables - .iter() - .enumerate() - .filter(|(_, binding_vars)| { - deep.iter().all(|variable| binding_vars.contains(variable)) - }) - .map(|(index, _)| index) - .collect::>(); - if let [owner] = owners.as_slice() { - let rigid_visible = variables - .iter() - .filter(|variable| self.state.rigid.contains(variable)) - .all(|variable| binding_variables[*owner].contains(variable)); - if rigid_visible { - owned[*owner].push(index); - continue; - } - } - lowered.extend(deep); - } - loop { - let mut changed = false; - for bucket in &mut owned { - let mut kept = Vec::new(); - for index in bucket.drain(..) { - let deep = self.deep_variables(&self.constraint_variables(index), outer_level); - if deep.iter().any(|variable| lowered.contains(variable)) { - lowered.extend(deep); - changed = true; - } else { - kept.push(index); - } - } - *bucket = kept; - } - if !changed { - break; - } - } - for variable in &lowered { - // Leave the unknown at the enclosing level so this binding does not - // quantify it while an undischarged constraint still mentions it. - self.state.levels.insert(*variable, outer_level); - } - for (binding, residual) in inferred.iter_mut().zip(owned) { - let monotype = binding.binder.scheme.ty.clone(); - self.check_residual_ambiguity( - &self.residual_wanted(&residual), - &monotype, - &binding.binder.binder.name, - binding.span, - ); - let parameters = self.abstract_dictionaries(&residual); - let constraints = self.retained_constraints(&residual); - let mut scheme = self.generalize(&[], &monotype, &constraints, outer_level); - binding.value = self.wrap_dictionary_lambdas( - std::mem::replace( - &mut binding.value, - InferredExpr { - kind: InferredExprKind::Integer(0), - ty: monotype, - span: binding.span, - }, - ), - ¶meters, - ); - scheme = self.generalize_body(scheme, &binding.value, outer_level); - self.scope - .locals - .insert(binding.binder.binder.id, scheme.clone()); - scheme.ty = binding.value.ty.clone(); - binding.binder.scheme = scheme; - } - } - - fn constraint_variables(&self, index: usize) -> HashSet { - let mut variables = HashSet::new(); - let Some(constraint) = self.state.wanted.get(index) else { - return variables; - }; - for argument in &constraint.arguments { - collect_infer_variables(&self.resolve_type(argument.clone()), &mut variables); - } - variables - } - - fn deep_variables(&self, variables: &HashSet, outer_level: u32) -> HashSet { - variables - .iter() - .copied() - .filter(|variable| { - !self.state.rigid.contains(variable) - && self - .state - .levels - .get(variable) - .copied() - .unwrap_or(TOP_LEVEL) - > outer_level - }) - .collect() - } -} - -fn bindings_are_recursive(bindings: &[hir::LocalBinding]) -> bool { - let ids = bindings - .iter() - .map(|binding| binding.binder.id) - .collect::>(); - bindings - .iter() - .any(|binding| expr_mentions(&binding.value, &ids)) -} - -fn expr_mentions(expression: &hir::Expr, ids: &HashSet) -> bool { - match &expression.kind { - hir::ExprKind::Local(id) => ids.contains(id), - hir::ExprKind::Application(function, argument) => { - expr_mentions(function, ids) || expr_mentions(argument, ids) - } - hir::ExprKind::Operator { left, right, .. } => { - expr_mentions(left, ids) || expr_mentions(right, ids) - } - hir::ExprKind::Negate { - function, - expression, - .. - } => expr_mentions(function, ids) || expr_mentions(expression, ids), - hir::ExprKind::Typed { expression, .. } - | hir::ExprKind::TypeApplication { expression, .. } - | hir::ExprKind::FieldAccess { expression, .. } => expr_mentions(expression, ids), - hir::ExprKind::Array(elements) => { - elements.iter().any(|element| expr_mentions(element, ids)) - } - hir::ExprKind::Record(fields) | hir::ExprKind::MatchProduct(fields) => { - fields.iter().any(|(_, value)| expr_mentions(value, ids)) - } - hir::ExprKind::RecordUpdate { expression, fields } => { - expr_mentions(expression, ids) - || fields.iter().any(|(_, value)| expr_mentions(value, ids)) - } - hir::ExprKind::OperatorChain { operands, .. } => { - operands.iter().any(|operand| expr_mentions(operand, ids)) - } - hir::ExprKind::OperatorSection { operand, .. } => expr_mentions(operand, ids), - hir::ExprKind::Lambda { body, .. } => expr_mentions(body, ids), - hir::ExprKind::Let { bindings, body } => { - bindings - .iter() - .any(|binding| expr_mentions(&binding.value, ids)) - || expr_mentions(body, ids) - } - hir::ExprKind::If { - condition, - then_branch, - else_branch, - } => { - expr_mentions(condition, ids) - || expr_mentions(then_branch, ids) - || expr_mentions(else_branch, ids) - } - hir::ExprKind::Case { - scrutinee, - branches, - } => { - expr_mentions(scrutinee, ids) - || branches - .iter() - .any(|branch| expr_mentions(&branch.value, ids)) - } - hir::ExprKind::Guarded(clauses) => clauses.iter().any(|clause| { - expr_mentions(&clause.value, ids) - || clause.guards.iter().any(|guard| guard_mentions(guard, ids)) - || clause - .where_bindings - .iter() - .any(|binding| expr_mentions(&binding.value, ids)) - }), - hir::ExprKind::Global(_) - | hir::ExprKind::Integer(_) - | hir::ExprKind::Number(_) - | hir::ExprKind::String(_) - | hir::ExprKind::Char(_) => false, - } -} - -fn guard_mentions(guard: &hir::Guard, ids: &HashSet) -> bool { - match guard { - hir::Guard::Boolean(expression) => expr_mentions(expression, ids), - hir::Guard::Pattern { value, .. } => expr_mentions(value, ids), - hir::Guard::Let { bindings, .. } => bindings - .iter() - .any(|binding| expr_mentions(&binding.value, ids)), + self.scope.locals = previous_locals; + result } } diff --git a/crates/psrs-typecheck/src/typecheck/tests/mod.rs b/crates/psrs-typecheck/src/typecheck/tests/mod.rs index 8505a079..ac1e7094 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/mod.rs @@ -287,7 +287,7 @@ fn rejects_a_body_that_does_not_match_its_signature() { } #[test] -fn generalizes_let_bound_functions() { +fn unannotated_let_bound_functions_are_monomorphic() { let let_expression = expr( HirExprKind::Let { bindings: vec![hir::LocalBinding { @@ -322,9 +322,13 @@ fn generalizes_let_bound_functions() { let resolved = module(vec![declaration(0, "main", 19, let_expression)], false); let resolved = psrs_desugar::desugar_module(resolved).unwrap(); - let typed = typecheck_module(resolved).unwrap(); - assert_eq!(typed.declarations[0].quantified.len(), 1); - typed.verify().unwrap(); + let errors = typecheck_module(resolved).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.kind == TypeCheckErrorKind::OccursCheck), + "{errors:?}" + ); } #[test] diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index 5e971e4d..dddd3858 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -14,7 +14,7 @@ This document owns schemes, instantiation, generalization, bidirectional checkin ## Background -HM inference explains unannotated let polymorphism, but PureScript additionally supports `forall` beneath arrows, constrained types, explicit type application, and row-polymorphic records. A use of a polymorphic value instantiates its `forall`; checking against an expected `forall` skolemizes it and rejects escaping skolems. Subsumption handles function variance and inserts dictionary evidence at permitted expression boundaries. Recursive declarations are checked as dependency groups; signatures supply polymorphic recursion where accepted by the source language. +HM inference supplies declaration generalization; unannotated local bindings remain monomorphic. PureScript additionally supports `forall` beneath arrows, constrained types, explicit type application, and row-polymorphic records. A use of a polymorphic value instantiates its `forall`; checking against an expected `forall` skolemizes it and rejects escaping skolems. Subsumption handles function variance and inserts dictionary evidence at permitted expression boundaries. Recursive declarations are checked as dependency groups; signatures supply polymorphic recursion where accepted by the source language. ## Model @@ -57,13 +57,13 @@ This contextual boundary check does not change ordinary function subsumption. Lexical givens and their superclass projections discharge a wanted only when all resolved argument types already agree. Dictionary lookup does not unify an unconstrained wanted variable with a given's skolem: that would prematurely -choose the type of a local binding before its uses instantiate it. Functional +choose the type of an unannotated local binding before its uses constrain it. Functional dependency improvement remains the owner of permitted argument refinement, including dependencies exposed by the instantiated superclass closure of each lexical given. For example, under `BoundedEnum a` with an `Ord a` superclass, a local integer -stepper's `Ord ?state` must stay residual until generalized or fixed by its -integer seed; the superclass dictionary proves `Ord a`, not `Ord ?state`. +stepper's `Ord ?state` must stay residual until its enclosing declaration +generalizes it or it is fixed by its integer seed; the superclass dictionary proves `Ord a`, not `Ord ?state`. Infer a recursive SCC with shared placeholders, respecting explicit signatures, then solve and generalize only variables permitted by the environment and remaining constraints. Use kind-correct constructor and pattern types; type-check case alternatives, literals, arrays, record operations, newtypes, and foreign imports. Visible type application `e @T` substitutes `T` for the operand's outermost quantifier after a kind check and is erased, and `e @_` consumes that quantifier without choosing a type. Typed holes follow the official source rules. A quantified kind argument is instantiated implicitly, because no source form applies one to a type constructor. Build THIR only after zonking, ambiguity checks, and evidence elaboration. @@ -213,7 +213,7 @@ Every THIR expression and binder has a kind-valid type; every reference is resol ## Worked example -`apply :: (forall a. a -> a) -> Int` requires an argument polymorphic at the call site. `apply (\x -> x)` checks the lambda against a skolemized `forall a. a -> a`; a monomorphic `Int -> Int` argument fails. By contrast, `let id = \x -> x in id id` generalizes `id` and instantiates its two uses independently. +`apply :: (forall a. a -> a) -> Int` requires an argument polymorphic at the call site. `apply (\x -> x)` checks the lambda against a skolemized `forall a. a -> a`; a monomorphic `Int -> Int` argument fails. A local binding needs an explicit polymorphic annotation for independent instantiation: `let id = (\x -> x) :: forall a. a -> a in id id`. An unannotated local identity is monomorphic, so self-application is an infinite type. For `class C a where method :: a -> a`, the declaration `f x = method x` has one wanted `C ?a` that no instance discharges. Generalization retains it, checks that `?a` occurs in `f`'s result type `?a -> ?a`, quantifies `?a` with kind `Type`, and gives `f` the scheme `forall a. C a => a -> a` with one dictionary parameter. `f 1` then instantiates that scheme and solves `C Int` at the use, while `f (\y -> y)` is rejected for lacking `C (Int -> Int)` if no such instance exists. @@ -294,25 +294,26 @@ explicit THIR scope for internal types without choosing a default type or adding evidence for an unsolved obligation; unused binders in the public type remain meaningful when the implementation mentions them. -A solved obligation in a local binding may mention a variable that its local -scheme quantifies. An enclosing declaration's ambiguity check treats that -variable as already bound, even when the local's result does not escape into -the enclosing type. This does not determine an unknown that the local scheme -never quantified: such a variable remains subject to the enclosing ambiguity -check. Generalization's recorded binder identities distinguish the two cases. - -A local `let` or `where` binding is a nested generalization, not an obligation -of the enclosing signature. Before the binding is quantified, its new wanteds -are solved under `Defer`: nothing is reported yet. A constraint whose flexible -variables were all allocated inside that binding, and that exactly one binding's -type determines, is retained on the binding. It becomes dictionary parameters, -and each use instantiates it, so `go succ` can solve `Bind Maybe` after `succ` -fixes the monad. A constraint that still mentions an outer unknown stays -unsolved for the enclosing declaration. A recursive local group does not -quantify a variable an undischarged constraint still shares; that constraint -stays with the enclosing declaration, the same rule that refuses polymorphic -recursion at the top level. An abstracted dictionary is a nested binding's -parameter, so the enclosing ambiguity check does not measure it again. +Unannotated local `let` and `where` bindings are monomorphic, as in official +PureScript's `inferLetBinding`. They share the enclosing declaration's inference +unknowns and wanted constraints. Local uses can solve those unknowns before the +enclosing binding group solves, checks ambiguity, and generalizes. A local's +unused class obligation is still an obligation of that declaration: `f y = let +g x = method x in y` is ambiguous when `method :: C a => a -> a`, because the +result of `f` does not determine `a`. Functional dependencies use the same +closure over all retained constraints before deciding ambiguity. + +An explicit polymorphic local annotation owns its checked quantifiers and +constraint dictionaries. Each use instantiates that declared type; it does not +share the unannotated-binding unknowns. An enclosing body traversal preserves +these structural binders and must not capture them again. When a checked `let` +expression carries a leading `forall`, its binders scope both local definitions +and the body in THIR and Core. Beta reduction retains the quantifier on the +whole `let`; its argument binding remains monomorphic rather than rebinding +the same type variable. Local bindings do not infer a qualified scheme or abstract unsolved dictionaries independently of +the enclosing declaration. This also prevents implicit polymorphic recursion +in a local recursive group. + The scheme records the kind of each quantified variable, read through the kind owner, so an instantiation carries the declaration's own polymorphism rather than reading it back from the solver table. diff --git a/docs/implementation/frontend/residual-ambiguity-observations.json b/docs/implementation/frontend/residual-ambiguity-observations.json new file mode 100644 index 00000000..5802b3d7 --- /dev/null +++ b/docs/implementation/frontend/residual-ambiguity-observations.json @@ -0,0 +1,63 @@ +{ + "schema_version": 1, + "date": "2026-10-07", + "diagnoses": { + "d": { + "before": { + "compiler": { + "head": "11db1757c20b76b5231e033395f000714f279baa", + "dirty": true, + "working_tree_fingerprint": "fnv1a64:35c7343b32dd42cc", + "binary_fingerprint": "fnv1a64:6e3f9e8e06b2a857" + }, + "cohort": { + "mode": "file", + "corpus": null, + "filter": null, + "limit": null, + "timeout_seconds": 30, + "trusted_stdlib_fingerprint": "fnv1a64-v1:b2890fecd9c42aa3" + }, + "input_fingerprint": "fnv1a64:6b1b440f4fc6ba6b", + "status": "passed", + "first_blocker": null, + "diagnostics": [] + }, + "after": { + "compiler": { + "head": "11db1757c20b76b5231e033395f000714f279baa", + "dirty": true, + "working_tree_fingerprint": "fnv1a64:790e9733c3f1e58b", + "binary_fingerprint": "fnv1a64:0532bc7848f9b3ae" + }, + "cohort": { + "mode": "file", + "corpus": null, + "filter": null, + "limit": null, + "timeout_seconds": 30, + "trusted_stdlib_fingerprint": "fnv1a64-v1:b2890fecd9c42aa3" + }, + "input_fingerprint": "fnv1a64:6b1b440f4fc6ba6b", + "status": "failed", + "first_blocker": { + "stage": "P5 typecheck", + "category": "AmbiguousTypeVariables", + "message": "ambiguous constraint C _T3 in the type inferred for `f`: _T3 is not determined by the result type or a functional dependency" + }, + "diagnostics": [ + { + "origin": "source", + "source": "/tmp/psrs-d-ambiguity.purs", + "stage": "P5 typecheck", + "start": 55, + "end": 56, + "code": "AmbiguousTypeVariables", + "kind": null, + "message": "ambiguous constraint C _T3 in the type inferred for `f`: _T3 is not determined by the result type or a functional dependency" + } + ] + } + } + } +} diff --git a/docs/implementation/frontend/residual-ambiguity.md b/docs/implementation/frontend/residual-ambiguity.md new file mode 100644 index 00000000..5c80904b --- /dev/null +++ b/docs/implementation/frontend/residual-ambiguity.md @@ -0,0 +1,72 @@ +# Residual ambiguity through local bindings + +Measured on 2026-10-07. + +## Contract and change + +The declaration checker owns residual solving, functional-dependency closure, +ambiguity checks, and generalization. Unannotated `let` and `where` bindings are +monomorphic and share its unknowns and wanted constraints. Official +`TypeChecker/Types.hs::inferLetBinding` uses this contract too. + +Previously local inference generalized an unused constraint into a local +dictionary parameter. Consequently `f y = let g x = method x in y`, with +`method :: C a => a -> a`, hid the ambiguous `C a` from the enclosing check. +Local inference now retains that obligation for the declaration checker; +the existing ambiguity check reports `AmbiguousTypeVariables` before +generalization. Explicit local `forall` annotations retain polymorphism. +Lexical local environments are restored on both successful and failed inference. + +A checked leading `forall` on a whole `let` scopes its definitions as well as +its body. THIR and Core verify this scope. Beta reduction preserves the binder +on the enclosing expression instead of repeating it on the generated local +binding. Direct IR tests accept that scope and reject unrelated free variables. +Erasure fixtures that previously relied on implicit local polymorphism now +declare their `forall` explicitly, preserving the runtime behavior they test. + +## Comparable evidence + +The baseline is HEAD `11db1757c20b76b5231e033395f000714f279baa` with the preceding +WIT payload changes in the working tree. The package stays pinned to revision +`01d6cd406cdce68a7ea1ec4c26a44793ead34571`, fingerprint +`fnv1a64-v1:b2890fecd9c42aa3`. No package sources or lock entries changed. + +`residual-ambiguity-observations.json` retains the input and compiler identities from +the single-file diagnosis snapshots. The ambiguity fixture adds `main = 0` to +the source in `reports_ambiguous_variables_before_generalizing`, so an absent +entry point does not mask the erroneous acceptance. + +| Check | Baseline | Result | +| --- | --- | --- | +| Ambiguity fixture diagnosis | Passed compilation | P5 `AmbiguousTypeVariables` | +| `residual_constraints` integration tests | 7 passed, 1 failed | 8 passed | +| Local-constraint driver tests | Existing acceptance fixtures | 14 passed | +| Typechecker unit tests | Existing cases | 135 passed | +| THIR tests, including quantified-local rejection | Existing cases | 28 passed | +| Official differential | Six local-binding sources | All six agree on acceptance and diagnostic code | +| `failing/ConstraintInference.purs` | Annotated `AmbiguousTypeVariables` | Same diagnostic from P5 | +| Polymorphism erasure runtime audit | Implicit-polymorphism fixtures corrected | 21 passed | + +The six differential sources cover unused and used constraints, conflicting +monomorphic uses, an explicit polymorphic local, an explicitly constrained local, +and functional-dependency determination. They run through the installed official +`purs`; the corpus assertion uses the official case's annotation separately. +`PolykindGeneralizationLet.purs` remains blocked by an existing P5 kind mismatch +before reaching its annotated type error; this work does not claim coverage of +that case or completion of polymorphic kind support. + +Reproduce with: + +```sh +cargo test -p psrs-driver --test residual_constraints +cargo test -p psrs-typecheck --lib +cargo test -p psrs-thir --lib +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib let_constraints:: +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib polymorphism_erasure_audit:: +PURESCRIPT_REPO=/Users/biu/Projects/purescript cargo test -p psrs-driver --test upstream residual_constraints:: -- --nocapture +``` + +The L2 rerun remains 72/72 failing agreement and 402/413 passing resolution. +The 11 blocked passing cases remain P3: 6, P0: 4, harness loading: 1. +D-04 and README therefore retain their measurements. The full workspace test +suite was deliberately omitted under the user's focused-validation instruction. From 4e85c35027f20801e3d2097d72998c810f89f8a6 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 02:58:25 +0800 Subject: [PATCH 053/148] Check bare row arguments through the shared instantiation relation --- crates/psrs-core/src/tests/instantiation.rs | 164 ++++++++++++++++++ .../src/verify/types/matching/invariant.rs | 18 +- .../src/verify/types/matching/mod.rs | 18 +- .../src/verify/types/matching/rows.rs | 91 ++++++---- .../frontend/type-system/rows-and-records.md | 10 ++ .../core-row-instantiation-observations.json | 71 ++++++++ .../frontend/core-row-instantiation.md | 59 +++++++ 7 files changed, 363 insertions(+), 68 deletions(-) create mode 100644 docs/implementation/frontend/core-row-instantiation-observations.json create mode 100644 docs/implementation/frontend/core-row-instantiation.md diff --git a/crates/psrs-core/src/tests/instantiation.rs b/crates/psrs-core/src/tests/instantiation.rs index c9961161..cbcc0569 100644 --- a/crates/psrs-core/src/tests/instantiation.rs +++ b/crates/psrs-core/src/tests/instantiation.rs @@ -234,3 +234,167 @@ fn row_evidence_retains_residuals_without_an_arena_node() { assert_eq!(evidence.constructor(variable), None); assert_eq!(evidence.row(TypeVariableId(41)).map(|row| row.fields), None); } + +fn row(types: &mut Vec, fields: &[(&str, TypeId)], tail: TypeId) -> TypeId { + fields.iter().rev().fold(tail, |tail, (label, ty)| { + let id = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: (*label).into(), + ty: *ty, + tail, + }); + id + }) +} + +#[test] +fn nominal_row_arguments_preserve_checked_residuals_and_label_order_independence() { + let variable = TypeVariableId(40); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Boolean), + Type::RowEmpty, + Type::Variable(variable), + ]; + let generic_row = row(&mut types, &[("y", TypeId(0))], TypeId(3)); + let generic = nominal(&mut types, 1, generic_row); + let concrete_row = row( + &mut types, + &[("a", TypeId(0)), ("b", TypeId(1)), ("y", TypeId(0))], + TypeId(2), + ); + let concrete = nominal(&mut types, 1, concrete_row); + let reordered_row = row( + &mut types, + &[("y", TypeId(0)), ("b", TypeId(1)), ("a", TypeId(0))], + TypeId(2), + ); + let reordered = nominal(&mut types, 1, reordered_row); + let generic_arrow = arrow(&mut types, generic, generic); + let consistent_arrow = arrow(&mut types, concrete, reordered); + let different_row = row( + &mut types, + &[("y", TypeId(0)), ("b", TypeId(0)), ("a", TypeId(0))], + TypeId(2), + ); + let different = nominal(&mut types, 1, different_row); + let inconsistent_arrow = arrow(&mut types, concrete, different); + let missing_row = row(&mut types, &[("a", TypeId(0))], TypeId(2)); + let missing = nominal(&mut types, 1, missing_row); + let duplicate_row = row(&mut types, &[("y", TypeId(0)), ("y", TypeId(0))], TypeId(2)); + let duplicate = nominal(&mut types, 1, duplicate_row); + let module = bare(types); + let evidence = module + .checked_instantiation(generic_arrow, &[variable], consistent_arrow) + .unwrap(); + let mut residual = evidence.row(variable).unwrap(); + residual.fields.sort_by(|left, right| left.0.cmp(&right.0)); + assert_eq!( + residual.fields, + vec![("a".into(), TypeId(0)), ("b".into(), TypeId(1))] + ); + assert_eq!(residual.tail, None); + assert!( + module + .checked_instantiation(concrete, &[], reordered) + .is_some() + ); + assert!( + module + .checked_instantiation(generic_arrow, &[variable], inconsistent_arrow) + .is_none() + ); + assert!( + module + .checked_instantiation(generic, &[], concrete) + .is_none(), + "rigid tails cannot absorb fields" + ); + assert!( + module + .checked_instantiation(generic, &[variable], missing) + .is_none() + ); + let duplicate_evidence = module + .checked_instantiation(generic, &[variable], duplicate) + .unwrap(); + assert_eq!( + duplicate_evidence.row(variable).unwrap().fields, + vec![("y".into(), TypeId(0))] + ); +} + +#[test] +fn nominal_row_arguments_preserve_duplicate_label_occurrence_order() { + let variable = TypeVariableId(41); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Boolean), + Type::RowEmpty, + Type::Variable(variable), + ]; + let scheme_row = row(&mut types, &[("a", TypeId(0)), ("a", TypeId(1))], TypeId(3)); + let scheme = nominal(&mut types, 1, scheme_row); + let matching_row = row( + &mut types, + &[("z", TypeId(0)), ("a", TypeId(0)), ("a", TypeId(1))], + TypeId(2), + ); + let matching = nominal(&mut types, 1, matching_row); + let reversed_row = row( + &mut types, + &[("a", TypeId(1)), ("a", TypeId(0)), ("z", TypeId(0))], + TypeId(2), + ); + let reversed = nominal(&mut types, 1, reversed_row); + let module = bare(types); + let evidence = module + .checked_instantiation(scheme, &[variable], matching) + .unwrap(); + assert_eq!( + evidence.row(variable).unwrap().fields, + vec![("z".into(), TypeId(0))] + ); + assert!( + module + .checked_instantiation(scheme, &[variable], reversed) + .is_none() + ); +} + +#[test] +fn repeated_residual_fields_use_the_checked_relation_for_nested_row_arguments() { + let variable = TypeVariableId(42); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Boolean), + Type::RowEmpty, + Type::Variable(variable), + ]; + let nested_left = row(&mut types, &[("a", TypeId(0)), ("b", TypeId(1))], TypeId(2)); + let nested_left = nominal(&mut types, 2, nested_left); + let nested_right = row(&mut types, &[("b", TypeId(1)), ("a", TypeId(0))], TypeId(2)); + let nested_right = nominal(&mut types, 2, nested_right); + let scheme_row = row(&mut types, &[("y", TypeId(0))], TypeId(3)); + let scheme = nominal(&mut types, 1, scheme_row); + let scheme = arrow(&mut types, scheme, scheme); + let domain_row = row( + &mut types, + &[("x", nested_left), ("y", TypeId(0))], + TypeId(2), + ); + let domain = nominal(&mut types, 1, domain_row); + let codomain_row = row( + &mut types, + &[("y", TypeId(0)), ("x", nested_right)], + TypeId(2), + ); + let codomain = nominal(&mut types, 1, codomain_row); + let instance = arrow(&mut types, domain, codomain); + let module = bare(types); + assert!( + module + .checked_instantiation(scheme, &[variable], instance) + .is_some() + ); +} diff --git a/crates/psrs-core/src/verify/types/matching/invariant.rs b/crates/psrs-core/src/verify/types/matching/invariant.rs index 24eb503d..6385cebf 100644 --- a/crates/psrs-core/src/verify/types/matching/invariant.rs +++ b/crates/psrs-core/src/verify/types/matching/invariant.rs @@ -164,22 +164,8 @@ impl TypeMatcher<'_> { ) } } - (Type::RowEmpty, Type::RowEmpty) => true, - ( - Type::RowExtend { - label: left_label, - ty: left_ty, - tail: left_tail, - }, - Type::RowExtend { - label: right_label, - ty: right_ty, - tail: right_tail, - }, - ) => { - left_label == right_label - && self.relate(*left_ty, *right_ty, Variance::Invariant, false) - && self.relate(*left_tail, *right_tail, Variance::Invariant, false) + (Type::RowEmpty | Type::RowExtend { .. }, Type::RowEmpty | Type::RowExtend { .. }) => { + self.relate_rows(source, target, Variance::Invariant) } _ => false, }; diff --git a/crates/psrs-core/src/verify/types/matching/mod.rs b/crates/psrs-core/src/verify/types/matching/mod.rs index e7f23340..887c1627 100644 --- a/crates/psrs-core/src/verify/types/matching/mod.rs +++ b/crates/psrs-core/src/verify/types/matching/mod.rs @@ -363,22 +363,8 @@ impl TypeMatcher<'_> { self.relate(actual, expected, Variance::Invariant, false) } } - (Type::RowEmpty, Type::RowEmpty) => true, - ( - Type::RowExtend { - label: actual_label, - ty: actual_ty, - tail: actual_tail, - }, - Type::RowExtend { - label: expected_label, - ty: expected_ty, - tail: expected_tail, - }, - ) => { - actual_label == expected_label - && self.relate(*actual_ty, *expected_ty, Variance::Subsumption, true) - && self.relate(*actual_tail, *expected_tail, Variance::Invariant, false) + (Type::RowEmpty | Type::RowExtend { .. }, Type::RowEmpty | Type::RowExtend { .. }) => { + self.relate_rows(actual, expected, Variance::Invariant) } _ => false, }; diff --git a/crates/psrs-core/src/verify/types/matching/rows.rs b/crates/psrs-core/src/verify/types/matching/rows.rs index 1464247f..4d971076 100644 --- a/crates/psrs-core/src/verify/types/matching/rows.rs +++ b/crates/psrs-core/src/verify/types/matching/rows.rs @@ -1,4 +1,3 @@ -use super::super::types_compatible; use super::helpers::collect_free_variables; use super::{TypeMatcher, Variance}; use crate::{Type, TypeId, record_row}; @@ -31,30 +30,68 @@ impl TypeMatcher<'_> { ) else { return false; }; + for row in [actual_row, expected_row] { + let Some((fields, _)) = self.flatten_row(row) else { + return false; + }; + let mut labels = HashSet::new(); + if fields.iter().any(|(label, _)| !labels.insert(label)) { + return false; + } + } + self.relate_rows(actual_row, expected_row, variance) + } + + /// Bare rows in nominal arguments use the same checked residual relation as + /// records. The caller owns variance; nominal row arguments are invariant. + pub(super) fn relate_rows( + &mut self, + actual: TypeId, + expected: TypeId, + variance: Variance, + ) -> bool { let (Some((actual_fields, actual_tail)), Some((expected_fields, expected_tail))) = - (self.flatten_row(actual_row), self.flatten_row(expected_row)) + (self.flatten_row(actual), self.flatten_row(expected)) else { return false; }; - let Some(mut expected_fields) = index_fields(expected_fields) else { - return false; - }; + let mut expected_fields = expected_fields; + let mut actual_fields = actual_fields; + // Preserve duplicate-label occurrence order while ignoring the order + // of distinct labels. Bare rows may contain duplicates (e.g. Union). + actual_fields.sort_by(|left, right| left.0.cmp(&right.0)); + expected_fields.sort_by(|left, right| left.0.cmp(&right.0)); + let (mut actual_index, mut expected_index) = (0, 0); let mut actual_rest = Vec::new(); - let mut seen = HashSet::new(); - for (label, actual_ty) in actual_fields { - if !seen.insert(label.clone()) { - return false; - } - if let Some(expected_ty) = expected_fields.remove(&label) { - let instantiate = variance == Variance::Subsumption; - if !self.relate(actual_ty, expected_ty, variance, instantiate) { - return false; + let mut expected_rest = Vec::new(); + while actual_index < actual_fields.len() && expected_index < expected_fields.len() { + let actual_field = &actual_fields[actual_index]; + let expected_field = &expected_fields[expected_index]; + match actual_field.0.cmp(&expected_field.0) { + std::cmp::Ordering::Equal => { + if !self.relate( + actual_field.1, + expected_field.1, + variance, + variance == Variance::Subsumption, + ) { + return false; + } + actual_index += 1; + expected_index += 1; + } + std::cmp::Ordering::Less => { + actual_rest.push(actual_field.clone()); + actual_index += 1; + } + std::cmp::Ordering::Greater => { + expected_rest.push(expected_field.clone()); + expected_index += 1; } - } else { - actual_rest.push((label, actual_ty)); } } - let expected_rest = expected_fields.into_iter().collect::>(); + actual_rest.extend(actual_fields[actual_index..].iter().cloned()); + expected_rest.extend(expected_fields[expected_index..].iter().cloned()); self.finish_row(actual_rest, actual_tail, expected_rest, expected_tail) } @@ -189,15 +226,7 @@ impl TypeMatcher<'_> { } fn types_equal(&mut self, left: TypeId, right: TypeId) -> bool { - let mut alpha = self.alpha.clone(); - types_compatible(left, right, self.module, &mut HashSet::new(), &mut alpha) - && types_compatible( - right, - left, - self.module, - &mut HashSet::new(), - &mut self.alpha.clone(), - ) + self.relate(left, right, Variance::Invariant, false) } fn flatten_row(&self, mut row: TypeId) -> Option { @@ -257,16 +286,6 @@ impl TypeMatcher<'_> { } } -fn index_fields(fields: Vec<(String, TypeId)>) -> Option> { - let mut indexed = HashMap::new(); - for (label, ty) in fields { - if indexed.insert(label, ty).is_some() { - return None; - } - } - Some(indexed) -} - fn same_labels(left: &[(String, TypeId)], right: &[(String, TypeId)]) -> bool { let mut left = left.to_vec(); let mut right = right.to_vec(); diff --git a/docs/design/frontend/type-system/rows-and-records.md b/docs/design/frontend/type-system/rows-and-records.md index f66dac10..ee9db3d5 100644 --- a/docs/design/frontend/type-system/rows-and-records.md +++ b/docs/design/frontend/type-system/rows-and-records.md @@ -103,6 +103,16 @@ Row equality is independent of source label order; matched fields have equal che P5 receives kind-checked row expressions and resolved record operations from HIR. It supplies type equations and evidence to [type inference](type-inference.md) and emits verified THIR. Row normalization and the primitive row relations are internal to P5 and share the kind and evidence contracts of [kinds](kinds.md) and [classes](classes-and-evidence.md); a later stage receives only checked row types. The backend chooses record and variant representation only after Core lowering. +Core checks bare rows inside nominal type arguments with the same label-based +row relation as record rows. Nominal arguments stay invariant: fields must have +matching types, repeated bare-row labels retain their occurrence order, closed +rows must have the same label occurrences, and rigid tails cannot +absorb extra fields. Only quantified flexible tails receive checked residual +substitutions. Those residuals remain in instantiation evidence even when no +existing type-arena node represents them; later local-row materialization uses +that evidence rather than reconstructing the match. + + ## Open questions and future work Use official tests to pin down duplicate-label diagnostics, record-update edge cases, and primitive row improvement order; [primitives](prim.md) owns the rules those tests exercise. [DEC-04](../../../decision/DEC-04-official-test-suite-roadmap.md) tracks implementation coverage. diff --git a/docs/implementation/frontend/core-row-instantiation-observations.json b/docs/implementation/frontend/core-row-instantiation-observations.json new file mode 100644 index 00000000..f5e0180a --- /dev/null +++ b/docs/implementation/frontend/core-row-instantiation-observations.json @@ -0,0 +1,71 @@ +{ + "schema_version": 1, + "date": "2026-10-07", + "diagnoses": { + "c": { + "before": { + "compiler": { + "head": "11db1757c20b76b5231e033395f000714f279baa", + "dirty": true, + "working_tree_fingerprint": "fnv1a64:35c7343b32dd42cc", + "binary_fingerprint": "fnv1a64:6e3f9e8e06b2a857" + }, + "cohort": { + "mode": "file", + "corpus": null, + "filter": null, + "limit": null, + "timeout_seconds": 30, + "trusted_stdlib_fingerprint": "fnv1a64-v1:b2890fecd9c42aa3" + }, + "input_fingerprint": "fnv1a64:e4f7f9a8beba4416", + "status": "failed", + "first_blocker": { + "stage": "P7 Core verification", + "category": "uncoded", + "message": "Core expression type is inconsistent with its context" + }, + "diagnostics": [ + { + "origin": "source", + "source": "/tmp/psrs-c-union.purs", + "stage": "P7 Core verification", + "start": 476, + "end": 482, + "code": null, + "kind": null, + "message": "Core expression type is inconsistent with its context" + } + ] + }, + "after": { + "compiler": { + "head": "11db1757c20b76b5231e033395f000714f279baa", + "dirty": true, + "working_tree_fingerprint": "fnv1a64:790e9733c3f1e58b", + "binary_fingerprint": "fnv1a64:0532bc7848f9b3ae" + }, + "cohort": { + "mode": "file", + "corpus": null, + "filter": null, + "limit": null, + "timeout_seconds": 30, + "trusted_stdlib_fingerprint": "fnv1a64-v1:b2890fecd9c42aa3" + }, + "input_fingerprint": "fnv1a64:e4f7f9a8beba4416", + "status": "passed", + "first_blocker": null, + "diagnostics": [] + } + } + }, + "runtime": { + "fixture": "crates/psrs-driver/tests/prim_row/deferred_execution.rs::SOURCE", + "wasm_sha256": "d172428ce1bf5735e67b9c055de0906a864e23b1df0502028f941f266c775d42", + "wasmtime_version": "wasmtime 49.0.2 (3c8a3e79a 2026-10-02)", + "exit_code": 42, + "stdout": "", + "stderr": "" + } +} diff --git a/docs/implementation/frontend/core-row-instantiation.md b/docs/implementation/frontend/core-row-instantiation.md new file mode 100644 index 00000000..ab60c18f --- /dev/null +++ b/docs/implementation/frontend/core-row-instantiation.md @@ -0,0 +1,59 @@ +# Checked instantiation of bare row arguments + +Measured on 2026-10-07. + +## Contract and change + +Core's checked type relation owns declaration instantiation and the residual +row substitutions consumed by local-row materialization. A row beneath a nominal +constructor, such as `Proxy (y :: Int | r)`, is invariant but still matches by +label. Distinct label order is irrelevant; duplicate bare-row labels retain +their occurrence order. Closed and rigid rows cannot absorb unmatched fields. + +Previously Core compared bare `RowExtend` nodes positionally, although record +rows already had a residual relation and P5 accepted the nominal argument. +The inferred nested `Union` use consequently failed at P7 when `y` moved behind +`a` and `b` in the concrete row. Both invariant and subsumption entry points now +delegate bare rows to the shared row relation. Record-specific duplicate checks +stay at the record boundary. Residual field equality also uses the shared +invariant relation, including nested nominal row arguments. + +The matcher retains a checked residual even when no arena node represents it. +No verifier check was bypassed, and no Union-specific backend conversion was +added. Tests verify reordered fields, duplicate-label occurrence order, +consistent repeated residuals, nested row fields, rigid-tail rejection, +missing-field rejection, and incompatible field types. + +## Evidence + +The baseline is HEAD `11db1757c20b76b5231e033395f000714f279baa` with the preceding +WIT payload repair in the working tree. The locked package remains revision +`01d6cd406cdce68a7ea1ec4c26a44793ead34571`, fingerprint +`fnv1a64-v1:b2890fecd9c42aa3`. +`core-row-instantiation-observations.json` records the comparable single-file diagnosis and +the executed Wasm artifact separately. + +| Check | Baseline | Result | +| --- | --- | --- | +| Nested Union diagnosis | P7 Core type/context mismatch, span 476–482 | Compilation accepted | +| Nested Union Wasmtime execution | Blocked at Core verification | Exit 42, empty stdout/stderr | +| `prim_row` integration tests | Nested execution failed | 12 passed | +| Core unit and optimizer tests | Existing cases | 87 passed | +| Rank-N source/runtime tests | Existing cases | 2 passed | +| Cross-declaration runtime tests | Existing cases | 9 passed | + +The complete fixture is `tests/prim_row/deferred_execution.rs::SOURCE`. +Its inferred constraint requires `Union (y :: Int | left) right output`; `main` +instantiates it with `left = (a :: Int)`, `right = (b :: Boolean)`, and the +three-field output. The test requires Wasmtime when `PSRS_REQUIRE_WASMTIME=1`. + +```sh +cargo test -p psrs-core --lib +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test prim_row +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test rank_n +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib declaration_calls:: +``` + +The preceding WIT payload fix is checked separately with the 146 WASI driver +tests. Formatting, source layout, and workspace clippy are integration checks; +the full workspace test suite was omitted by the user's explicit instruction. From d74e092535ae120f1b964738c0d1503c1fdf4d6c Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 05:22:12 +0800 Subject: [PATCH 054/148] Land unified target linking for the formatter slice Own the pinned WIT and the formatter artifact in psrs-runtime, add the independent psrs-linker crate (definitions, plan, verify, compose), and thread one checked link plan from requirement closure through artifact verification, Wasm emission, and component assembly. The backend's target_runtime and linking modules convert optimized MIR into linker-owned records and map structured link failures to source diagnostics. - psrs-runtime: catalog of WIT sources, default world, artifact bytes, provenance/digest, and storage contract; the formatter sits behind a feature so metadata-only consumers do not compile target code. Pinned WIT assets move from psrs-backend/wit to psrs-runtime/wit. - psrs-linker: WIT loading and the shared resolved-world context, artifact contract verification, provider closure and memory/initialization planning, component composition, and final import closure. It depends on WIT/Wasm tooling and the runtime catalog, never on compiler IR crates. - psrs-backend: new linking module and plan-aware Wasm lowering; the old component and linker prototypes are removed. The numberToString intrinsic selects the pinned artifact through the plan, and ABI resolution borrows the linker's single resolved context. - Tests: target-only plan/compose suites, artifact contract rejection cases, and an end-to-end formatter execution test through the checked plan under Wasmtime. The runtime artifact is rebuilt and its digest refreshed. - Docs: DEC-18 accepted; the linking design and acceptance record updated; stale component.rs references repointed to psrs-linker and psrs-runtime. --- Cargo.lock | 96 ++++ Cargo.toml | 12 + crates/psrs-backend/Cargo.toml | 2 + .../psrs-backend/src/abi/canonical/tests.rs | 2 +- crates/psrs-backend/src/abi/definitions.rs | 57 ++ crates/psrs-backend/src/abi/mod.rs | 41 +- crates/psrs-backend/src/abi/validation.rs | 2 +- crates/psrs-backend/src/cc/lower/intrinsic.rs | 10 + crates/psrs-backend/src/cc/mod.rs | 4 + crates/psrs-backend/src/cc/verify/ops/mod.rs | 10 + crates/psrs-backend/src/component.rs | 327 ------------ crates/psrs-backend/src/lib.rs | 3 +- crates/psrs-backend/src/linking/mod.rs | 334 ++++++++++++ crates/psrs-backend/src/mir/gc_tests/mod.rs | 4 +- .../src/mir/lower/assignment_string/mod.rs | 2 +- .../psrs-backend/src/mir/lower/assignments.rs | 8 + crates/psrs-backend/src/mir/lower/mod.rs | 1 + .../src/mir/lower/number_string.rs | 62 +++ crates/psrs-backend/src/mir/mod.rs | 18 + .../src/mir/number_format_tests.rs | 176 ++++++ .../src/mir/reachable/assignments.rs | 1 + crates/psrs-backend/src/mir/tests.rs | 3 +- crates/psrs-backend/src/pipeline/emission.rs | 119 +++-- crates/psrs-backend/src/pipeline/mod.rs | 31 +- crates/psrs-backend/src/target_runtime.rs | 127 +++++ crates/psrs-backend/src/trace.rs | 10 + crates/psrs-backend/src/wasm/lower/mod.rs | 49 +- .../src/wasm/lower/post_return/tests.rs | 15 +- crates/psrs-backend/src/wasm/mod.rs | 1 + crates/psrs-cli/src/diagnose/trace/build.rs | 1 + crates/psrs-core/src/verify/types/mod.rs | 3 +- .../psrs-driver/src/tests/diagnosis_trace.rs | 42 ++ crates/psrs-driver/src/tests/show.rs | 64 +++ crates/psrs-hir/src/intrinsic/mod.rs | 6 +- crates/psrs-hir/src/intrinsic/registry.rs | 5 + crates/psrs-linker/Cargo.toml | 16 + crates/psrs-linker/src/compose.rs | 127 +++++ crates/psrs-linker/src/definitions.rs | 303 +++++++++++ crates/psrs-linker/src/digest.rs | 14 + crates/psrs-linker/src/error.rs | 97 ++++ crates/psrs-linker/src/lib.rs | 36 ++ crates/psrs-linker/src/plan.rs | 396 ++++++++++++++ crates/psrs-linker/src/runtime.rs | 108 ++++ crates/psrs-linker/src/target.rs | 207 ++++++++ crates/psrs-linker/src/verify/mod.rs | 86 +++ crates/psrs-linker/src/verify/parse.rs | 367 +++++++++++++ crates/psrs-linker/src/verify/tests.rs | 119 +++++ crates/psrs-linker/tests/compose.rs | 129 +++++ crates/psrs-linker/tests/plan.rs | 246 +++++++++ crates/psrs-runtime/Cargo.toml | 25 + .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 0 -> 14239 bytes crates/psrs-runtime/examples/package.rs | 66 +++ crates/psrs-runtime/src/catalog.rs | 194 +++++++ crates/psrs-runtime/src/formatter.rs | 59 +++ crates/psrs-runtime/src/lib.rs | 70 +++ crates/psrs-runtime/tools/build.sh | 10 + .../wit/deps/cli.wit | 0 .../wit/deps/clocks.wit | 0 .../wit/deps/filesystem.wit | 0 .../wit/deps/io.wit | 0 .../wit/deps/random.wit | 0 .../wit/deps/sockets.wit | 0 .../wit/psrs-app.wit | 0 .../decision/DEC-18-unified-target-linking.md | 108 ++++ docs/design/backend/00-ir-boundaries.md | 11 +- docs/design/backend/README.md | 1 + .../backend/wasm/canonical-abi-and-wit.md | 34 +- .../wasm/canonical-abi-compositional.md | 4 +- .../backend/wasm/encoding-and-structuring.md | 11 +- ...inear-memory-and-canonical-abi-boundary.md | 6 + .../backend/wasm/linking-and-runtime.md | 499 ++++++++++++++++++ .../backend/wasm/primitive-ffi-and-stdlib.md | 20 + .../backend/wasm/wasi-platform-library.md | 105 ++-- docs/feature/F-02-portable-programs.md | 3 +- docs/implementation/backend/effects.md | 3 +- .../linear-memory-and-canonical-abi.md | 2 +- .../backend/linking-and-runtime.md | 89 ++++ docs/implementation/backend/wasi-platform.md | 8 +- 78 files changed, 4749 insertions(+), 478 deletions(-) create mode 100644 crates/psrs-backend/src/abi/definitions.rs delete mode 100644 crates/psrs-backend/src/component.rs create mode 100644 crates/psrs-backend/src/linking/mod.rs create mode 100644 crates/psrs-backend/src/mir/lower/number_string.rs create mode 100644 crates/psrs-backend/src/mir/number_format_tests.rs create mode 100644 crates/psrs-backend/src/target_runtime.rs create mode 100644 crates/psrs-linker/Cargo.toml create mode 100644 crates/psrs-linker/src/compose.rs create mode 100644 crates/psrs-linker/src/definitions.rs create mode 100644 crates/psrs-linker/src/digest.rs create mode 100644 crates/psrs-linker/src/error.rs create mode 100644 crates/psrs-linker/src/lib.rs create mode 100644 crates/psrs-linker/src/plan.rs create mode 100644 crates/psrs-linker/src/runtime.rs create mode 100644 crates/psrs-linker/src/target.rs create mode 100644 crates/psrs-linker/src/verify/mod.rs create mode 100644 crates/psrs-linker/src/verify/parse.rs create mode 100644 crates/psrs-linker/src/verify/tests.rs create mode 100644 crates/psrs-linker/tests/compose.rs create mode 100644 crates/psrs-linker/tests/plan.rs create mode 100644 crates/psrs-runtime/Cargo.toml create mode 100755 crates/psrs-runtime/artifact/psrs_runtime.wasm create mode 100644 crates/psrs-runtime/examples/package.rs create mode 100644 crates/psrs-runtime/src/catalog.rs create mode 100644 crates/psrs-runtime/src/formatter.rs create mode 100644 crates/psrs-runtime/src/lib.rs create mode 100644 crates/psrs-runtime/tools/build.sh rename crates/{psrs-backend => psrs-runtime}/wit/deps/cli.wit (100%) rename crates/{psrs-backend => psrs-runtime}/wit/deps/clocks.wit (100%) rename crates/{psrs-backend => psrs-runtime}/wit/deps/filesystem.wit (100%) rename crates/{psrs-backend => psrs-runtime}/wit/deps/io.wit (100%) rename crates/{psrs-backend => psrs-runtime}/wit/deps/random.wit (100%) rename crates/{psrs-backend => psrs-runtime}/wit/deps/sockets.wit (100%) rename crates/{psrs-backend => psrs-runtime}/wit/psrs-app.wit (100%) create mode 100644 docs/decision/DEC-18-unified-target-linking.md create mode 100644 docs/design/backend/wasm/linking-and-runtime.md create mode 100644 docs/implementation/backend/linking-and-runtime.md diff --git a/Cargo.lock b/Cargo.lock index 5d284311..c23029b7 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -41,6 +41,15 @@ version = "2.13.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "3ded4057c258ba199e2d26386d3af3780957ecaee6c4ef4041c6b4b8b97c0b06" +[[package]] +name = "block-buffer" +version = "0.10.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3078c7629b62d3f0439517fa394996acacc5cbc91c5a20d8c658e77abd503a71" +dependencies = [ + "generic-array", +] + [[package]] name = "cc" version = "1.4.7" @@ -67,6 +76,35 @@ dependencies = [ "stacker", ] +[[package]] +name = "cpufeatures" +version = "0.2.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "59ed5838eebb26a2bb2e58f6d5b5316989ae9d08bab10e0e6d103e656d1b0280" +dependencies = [ + "libc", +] + +[[package]] +name = "crypto-common" +version = "0.1.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "78c8292055d1c1df0cce5d180393dc8cce0abec0a7102adb6c7b1eef6016d60a" +dependencies = [ + "generic-array", + "typenum", +] + +[[package]] +name = "digest" +version = "0.10.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9ed9a281f7bc9b7576e61468ba615a66a5c8cfdff42420a70aa82701a3b1e292" +dependencies = [ + "block-buffer", + "crypto-common", +] + [[package]] name = "equivalent" version = "1.0.2" @@ -85,6 +123,16 @@ version = "0.2.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "77ce24cb58228fbb8aa041425bb1050850ac19177686ea6e0f41a70416f56fdb" +[[package]] +name = "generic-array" +version = "0.14.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" +dependencies = [ + "typenum", + "version_check", +] + [[package]] name = "hashbrown" version = "0.14.5" @@ -208,6 +256,8 @@ version = "0.1.0" dependencies = [ "psrs-core", "psrs-hir", + "psrs-linker", + "psrs-runtime", "psrs-span", "psrs-thir", "wasm-encoder", @@ -293,6 +343,19 @@ dependencies = [ "psrs-syntax", ] +[[package]] +name = "psrs-linker" +version = "0.1.0" +dependencies = [ + "psrs-runtime", + "sha2", + "wasm-encoder", + "wasmparser", + "wasmprinter", + "wit-component", + "wit-parser", +] + [[package]] name = "psrs-resolve" version = "0.1.0" @@ -302,6 +365,16 @@ dependencies = [ "psrs-span", ] +[[package]] +name = "psrs-runtime" +version = "0.1.0" +dependencies = [ + "ryu-js", + "wasm-encoder", + "wasmparser", + "wasmprinter", +] + [[package]] name = "psrs-span" version = "0.1.0" @@ -346,6 +419,12 @@ dependencies = [ "proc-macro2", ] +[[package]] +name = "ryu-js" +version = "1.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dd29631678d6fb0903b69223673e122c32e9ae559d0960a38d574695ebc0ea15" + [[package]] name = "semver" version = "1.0.28" @@ -395,6 +474,17 @@ dependencies = [ "zmij", ] +[[package]] +name = "sha2" +version = "0.10.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a7507d819769d01a365ab707794a4084392c824f54a7a6a7862f8c3d0892b283" +dependencies = [ + "cfg-if", + "cpufeatures", + "digest", +] + [[package]] name = "shlex" version = "2.0.1" @@ -445,6 +535,12 @@ dependencies = [ "winapi-util", ] +[[package]] +name = "typenum" +version = "1.20.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b6f5e870be6c3b371b77fe0ee0bafb859fa4964b4404c27de1d380043c4dda20" + [[package]] name = "unicode-ident" version = "1.0.26" diff --git a/Cargo.toml b/Cargo.toml index 1d1e355c..0f265293 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -11,6 +11,8 @@ members = [ "crates/psrs-desugar", "crates/psrs-core", "crates/psrs-backend", + "crates/psrs-linker", + "crates/psrs-runtime", "crates/psrs-driver", "crates/psrs-syntax", "crates/psrs-cli", @@ -35,8 +37,18 @@ psrs-kind = { path = "crates/psrs-kind" } psrs-desugar = { path = "crates/psrs-desugar" } psrs-core = { path = "crates/psrs-core" } psrs-backend = { path = "crates/psrs-backend" } +psrs-linker = { path = "crates/psrs-linker" } +psrs-runtime = { path = "crates/psrs-runtime" } psrs-driver = { path = "crates/psrs-driver" } psrs-syntax = { path = "crates/psrs-syntax" } wasm-encoder = "=0.245.1" wasmparser = "=0.245.1" wasmprinter = "=0.245.1" + +[profile.target-runtime] +inherits = "release" +panic = "abort" +opt-level = "s" +lto = true +codegen-units = 1 +strip = true diff --git a/crates/psrs-backend/Cargo.toml b/crates/psrs-backend/Cargo.toml index 503c3bc2..9152e6e9 100644 --- a/crates/psrs-backend/Cargo.toml +++ b/crates/psrs-backend/Cargo.toml @@ -8,6 +8,8 @@ license.workspace = true psrs-core.workspace = true psrs-hir.workspace = true psrs-span.workspace = true +psrs-linker.workspace = true +psrs-runtime = { workspace = true, default-features = false, features = ["catalog"] } wasm-encoder.workspace = true wasmparser.workspace = true wasmprinter.workspace = true diff --git a/crates/psrs-backend/src/abi/canonical/tests.rs b/crates/psrs-backend/src/abi/canonical/tests.rs index 5dc5ce0f..d3c4d126 100644 --- a/crates/psrs-backend/src/abi/canonical/tests.rs +++ b/crates/psrs-backend/src/abi/canonical/tests.rs @@ -70,7 +70,7 @@ fn assert_matches_oracle(resolve: &Resolve, function: &Function) { #[test] fn flatten_matches_wasm_signature_for_every_wasi_function() { let mut resolve = Resolve::default(); - crate::component::load_vendored_wasi(&mut resolve).expect("vendored WASI should load"); + crate::abi::load_wit(&mut resolve).expect("vendored WASI should load"); let mut checked = 0; for (_, interface) in resolve.interfaces.iter() { diff --git a/crates/psrs-backend/src/abi/definitions.rs b/crates/psrs-backend/src/abi/definitions.rs new file mode 100644 index 00000000..356382e4 --- /dev/null +++ b/crates/psrs-backend/src/abi/definitions.rs @@ -0,0 +1,57 @@ +//! Pinned WIT loading and permitted-interface derivation. + +use std::collections::HashSet; +use wit_parser::Resolve; + +/// Pushes the runtime catalog's pinned WIT into `resolve` in dependency order. +pub(crate) fn load_wit(resolve: &mut Resolve) -> Result<(), String> { + for source in psrs_runtime::WASI_WIT { + resolve + .push_str(source.path, source.contents) + .map_err(|error| format!("invalid vendored WIT `{}`: {error}", source.path))?; + } + let app = psrs_runtime::APP_WIT; + resolve + .push_str(app.path, app.contents) + .map_err(|error| format!("invalid application WIT: {error}"))?; + Ok(()) +} + +/// The canonical ids the default world permits. A resolve that omits the +/// application world (an isolated ABI fixture) admits every interface it +/// defines; production resolves always include the world. +pub(super) fn supported_interfaces(resolve: &Resolve) -> HashSet { + let world = resolve + .packages + .iter() + .find(|(_, package)| { + package.name.namespace == psrs_runtime::DEFAULT_WORLD.package_namespace + && package.name.name == psrs_runtime::DEFAULT_WORLD.package_name + }) + .and_then(|(_, package)| { + package + .worlds + .get(psrs_runtime::DEFAULT_WORLD.world) + .copied() + }); + let mut supported = HashSet::new(); + match world { + Some(world) => { + for item in resolve.worlds[world].imports.values() { + if let wit_parser::WorldItem::Interface { id, .. } = item + && let Some(canonical) = resolve.id_of(*id) + { + supported.insert(canonical); + } + } + } + None => { + for (id, _) in resolve.interfaces.iter() { + if let Some(canonical) = resolve.id_of(id) { + supported.insert(canonical); + } + } + } + } + supported +} diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index d4cc20bc..41470b4d 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -6,11 +6,13 @@ use crate::TargetCapabilities; use crate::types::ValueType; use psrs_hir::{ModuleId, SymbolId}; -use std::collections::HashMap; +use std::collections::{HashMap, HashSet}; +use std::sync::Arc; use wit_parser::Resolve; use wit_parser::abi::AbiVariant; pub(crate) mod canonical; +mod definitions; mod handles; pub(crate) mod layout; pub(crate) mod link; @@ -22,10 +24,13 @@ use canonical::{ CanonicalType, FnAbi, Ownership, function_abi, function_abi_from_types, resolve as resolve_canonical, }; +pub(crate) use definitions::load_wit; +use definitions::supported_interfaces; pub use handles::{HandleMode, HandleResource}; #[cfg(test)] pub(crate) use link::intern_source_type; -use validation::{unsupported_shape, wasi_interface_enabled}; +use validation::unsupported_shape; +pub(crate) use validation::wasi_interface_enabled; /// Maps a resolved WIT core value type to the backend's value type. fn value_type(ty: wit_parser::abi::WasmType) -> Result { @@ -98,11 +103,15 @@ pub(crate) const VALIDATE_STEP_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRIN /// string boundary. Any other intrinsic-symbol allocator (for example the /// aggregate conversion helpers, which allocate downward from `u32::MAX`) must /// skip these. -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 4] = [ +pub(crate) const NUMBER_TO_STRING_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 5); + +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 5] = [ REALLOC_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, VALIDATE_STEP_SYMBOL, + NUMBER_TO_STRING_SYMBOL, ]; /// WASI interfaces and functions the backend itself references. The standard @@ -163,10 +172,12 @@ impl WasiImport { /// Resolves WASI imports against the vendored WIT, interning each distinct /// `(module, name)` to a stable [`SymbolId`]. pub struct WasiRegistry { - resolve: Resolve, + resolve: Arc, imports: Vec, keys: HashMap<(String, String), usize>, target: TargetCapabilities, + /// Canonical ids of the interfaces the default world permits. + supported: HashSet, } impl WasiRegistry { @@ -175,11 +186,20 @@ impl WasiRegistry { const SYMBOL_BASE: u32 = 1 << 20; pub(crate) fn from_resolve(resolve: Resolve, target: TargetCapabilities) -> Self { + Self::from_shared_resolve(Arc::new(resolve), target) + } + + /// Builds a registry over the linker's resolved-world context. The same + /// parsed definitions are shared, so interface identities are not + /// regenerated. + pub(crate) fn from_shared_resolve(resolve: Arc, target: TargetCapabilities) -> Self { + let supported = supported_interfaces(&resolve); Self { resolve, imports: Vec::new(), keys: HashMap::new(), target, + supported, } } @@ -187,10 +207,11 @@ impl WasiRegistry { Self::load_with_capabilities(TargetCapabilities::default()) } - /// Loads the vendored WIT with the service families enabled by `target`. + /// Loads the pinned WIT from the runtime catalog with the service families + /// enabled by `target`. pub fn load_with_capabilities(target: TargetCapabilities) -> Result { let mut resolve = Resolve::default(); - crate::component::load_vendored_wasi(&mut resolve)?; + load_wit(&mut resolve)?; Ok(Self::from_resolve(resolve, target)) } @@ -279,7 +300,7 @@ impl WasiRegistry { }) }) .or_else(|| { - (!crate::component::component_interface_supported(&module)).then(|| { + (!self.supported.contains(&module)).then(|| { format!( "WASI interface `{module}` is not in the current component capability profile" ) @@ -356,6 +377,12 @@ impl WasiRegistry { &self.imports } + /// A shared handle to the parsed definitions this registry resolves + /// against. Isolated lowering fixtures wrap it in a permissive context. + pub(crate) fn shared_resolve(&self) -> Arc { + Arc::clone(&self.resolve) + } + /// The core import module and field for an interned import symbol. This is /// the only place the WIT interface and function names are resolved. pub fn symbol_name(&self, symbol: SymbolId) -> Option<(&str, &str)> { diff --git a/crates/psrs-backend/src/abi/validation.rs b/crates/psrs-backend/src/abi/validation.rs index 50e09d2f..1d6610dc 100644 --- a/crates/psrs-backend/src/abi/validation.rs +++ b/crates/psrs-backend/src/abi/validation.rs @@ -136,7 +136,7 @@ pub(super) fn enum_cases( ) } -pub(super) fn wasi_interface_enabled(target: TargetCapabilities, module: &str) -> bool { +pub(crate) fn wasi_interface_enabled(target: TargetCapabilities, module: &str) -> bool { let package_path = module .split_once('/') .map_or(module, |(package, _)| package); diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 04264c30..6d21ac79 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -21,6 +21,16 @@ impl FunctionLowerer<'_> { assignments: &mut Vec, ) -> Result> { match intrinsic { + Intrinsic::NumberToString => { + let value = self.lower_value(&arguments[0], assignments)?; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::NumberToString { value }, + span: expression.span, + }); + Ok(destination) + } Intrinsic::ArrayIndex => { let array = &arguments[0]; let Some(representation) = self.array_types.get(&array.ty).copied() else { diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index d5bce023..bcb1f37b 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -186,6 +186,10 @@ pub enum AssignmentKind { representation: ReprId, value: ValueId, }, + /// ECMAScript binary64 formatting; ordinary library wrappers own Show. + NumberToString { + value: ValueId, + }, /// An `Array Int` read as a source `String`. Every element must be a /// canonical byte and the bytes must be well-formed UTF-8. BytesToString { diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index 9a327187..a908ae98 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -85,6 +85,16 @@ pub(super) fn verify_assignments( verify_binary_operation(*op, *left, *right, assignment, declared)?; uses.extend([*left, *right]); } + AssignmentKind::NumberToString { value } => { + require_value_shape(declared, *value, ValueShape::Number, assignment)?; + require_destination( + declared, + assignment, + ValueShape::String, + "numberToString produces String", + )?; + uses.push(*value); + } AssignmentKind::Unary { op, value } => { verify_unary_operation(*op, *value, assignment, declared)?; uses.push(*value); diff --git a/crates/psrs-backend/src/component.rs b/crates/psrs-backend/src/component.rs deleted file mode 100644 index 93ee886d..00000000 --- a/crates/psrs-backend/src/component.rs +++ /dev/null @@ -1,327 +0,0 @@ -//! Component Model encoding. A core module produced by the Wasm lowering is -//! componentized with `wit-component`, using WIT metadata that describes the -//! world the module implements. See -//! `docs/decision/DEC-06-runtime-interface-via-wit.md`. - -use wit_component::{ComponentEncoder, StringEncoding, embed_component_metadata}; -use wit_parser::{Resolve, WorldId}; - -/// Vendored WASI 0.2.12 WIT, matching the `wasi:cli/run@0.2.12` export that the -/// pinned `wasmtime` baseline expects. Pushed into the `Resolve` in dependency -/// order before the application world. -pub(crate) const WASI_DEPS: &[(&str, &str)] = &[ - ("wasi/io.wit", include_str!("../wit/deps/io.wit")), - ("wasi/clocks.wit", include_str!("../wit/deps/clocks.wit")), - ("wasi/random.wit", include_str!("../wit/deps/random.wit")), - ( - "wasi/filesystem.wit", - include_str!("../wit/deps/filesystem.wit"), - ), - ("wasi/sockets.wit", include_str!("../wit/deps/sockets.wit")), - ("wasi/cli.wit", include_str!("../wit/deps/cli.wit")), -]; - -/// The application world: a WASI command that only exports `wasi:cli/run`. -const APP_WIT: &str = include_str!("../wit/psrs-app.wit"); - -/// Interfaces that the current component world imports and the backend can -/// lower through its canonical ABI adapter. Keep this list next to the world -/// declaration so ABI discovery and component encoding share one contract. -pub(crate) const COMPONENT_INTERFACES: &[&str] = &[ - "wasi:io/error@0.2.12", - "wasi:io/poll@0.2.12", - "wasi:io/streams@0.2.12", - "wasi:clocks/monotonic-clock@0.2.12", - "wasi:clocks/wall-clock@0.2.12", - "wasi:random/random@0.2.12", - "wasi:random/insecure@0.2.12", - "wasi:random/insecure-seed@0.2.12", - "wasi:cli/environment@0.2.12", - "wasi:cli/exit@0.2.12", - "wasi:cli/stdin@0.2.12", - "wasi:cli/stdout@0.2.12", - "wasi:cli/stderr@0.2.12", - "wasi:cli/terminal-input@0.2.12", - "wasi:cli/terminal-output@0.2.12", - "wasi:cli/terminal-stdin@0.2.12", - "wasi:cli/terminal-stdout@0.2.12", - "wasi:cli/terminal-stderr@0.2.12", - "wasi:filesystem/types@0.2.12", - "wasi:filesystem/preopens@0.2.12", - "wasi:sockets/network@0.2.12", - "wasi:sockets/instance-network@0.2.12", - "wasi:sockets/udp@0.2.12", - "wasi:sockets/udp-create-socket@0.2.12", - "wasi:sockets/tcp@0.2.12", - "wasi:sockets/tcp-create-socket@0.2.12", - "wasi:sockets/ip-name-lookup@0.2.12", -]; - -pub(crate) fn component_interface_supported(module: &str) -> bool { - COMPONENT_INTERFACES.contains(&module) -} - -/// Pushes the vendored WASI WIT into `resolve` in dependency order. -pub(crate) fn load_vendored_wasi(resolve: &mut Resolve) -> Result<(), String> { - for (path, contents) in WASI_DEPS { - resolve - .push_str(path, contents) - .map_err(|error| format!("invalid vendored WIT `{path}`: {error}"))?; - } - Ok(()) -} - -/// Resolves the `psrs:app` command world against the vendored WASI WIT. -pub fn command_world() -> Result<(Resolve, WorldId), String> { - let mut resolve = Resolve::default(); - load_vendored_wasi(&mut resolve)?; - let package = resolve - .push_str("psrs-app.wit", APP_WIT) - .map_err(|error| format!("invalid application WIT: {error}"))?; - let world = resolve.packages[package] - .worlds - .get("command") - .copied() - .ok_or_else(|| "application WIT is missing the `command` world".to_string())?; - Ok((resolve, world)) -} - -/// Lifts a core module into a component for `world`. The core module must -/// implement the world at the canonical ABI level. -pub fn componentize(core: &[u8], resolve: &Resolve, world: WorldId) -> Result, String> { - let mut bytes = core.to_vec(); - embed_component_metadata(&mut bytes, resolve, world, StringEncoding::UTF8) - .map_err(|error| format!("failed to embed component metadata: {error}"))?; - ComponentEncoder::default() - .module(&bytes) - .map_err(|error| format!("failed to read the core module: {error}"))? - .validate(true) - .encode() - .map_err(|error| format!("failed to encode the component: {error:#}")) -} - -#[cfg(test)] -mod tests { - use super::*; - use crate::wasm::{ - DataIndex, DataSegment, Export, ExportIndex, ExportKind, FuncType, Function, FunctionIndex, - Import, Memory, MemoryIndex, Module, Op, TypeIndex, - }; - use psrs_hir::{ModuleId, SymbolId}; - use psrs_span::TextRange; - use wasm_encoder::{Instruction, ValType}; - use wit_parser::{WorldItem, WorldKey}; - - fn core_module_exporting_run() -> Vec { - let span = TextRange::new(0, 1); - let module = Module { - name: "App".into(), - imports: Vec::new(), - types: vec![FuncType { - parameters: Vec::new(), - results: vec![ValType::I32], - }], - type_defs: Vec::new(), - functions: vec![Function { - symbol: SymbolId::new(ModuleId(0), 0), - name: crate::abi::RUN_CORE_EXPORT.into(), - type_index: TypeIndex(0), - parameters: Vec::new(), - locals: Vec::new(), - body: vec![Op::Leaf(Instruction::I32Const(0))], - span, - }], - memories: Vec::new(), - data: Vec::new(), - exports: vec![Export { - name: crate::abi::RUN_CORE_EXPORT.into(), - kind: ExportKind::Function, - index: ExportIndex::Function(FunctionIndex(0)), - }], - entry: None, - realloc: None, - globals: Vec::new(), - helpers: Vec::new(), - span, - }; - crate::wasm::encode_module(&module).expect("encoding the core module") - } - - #[test] - fn componentizes_a_command_exporting_run() { - let (resolve, world) = command_world().expect("WASI and application WIT should load"); - let core = core_module_exporting_run(); - let component = componentize(&core, &resolve, world).expect("componentizing"); - crate::validator() - .validate_all(&component) - .expect("the component should validate"); - let text = wasmprinter::print_bytes(&component).expect("printing the component"); - assert!( - text.contains("(component") && text.contains("wasi:cli/run@0.2.12"), - "the component should export the WASI run interface: {text}" - ); - } - - #[test] - fn component_world_matches_the_capability_profile() { - let (resolve, world) = command_world().expect("WASI and application WIT should load"); - let mut actual = resolve.worlds[world] - .imports - .values() - .filter_map(|item| match item { - WorldItem::Interface { id, .. } => resolve.id_of(*id), - WorldItem::Function(_) | WorldItem::Type { .. } => None, - }) - .collect::>(); - let mut expected = COMPONENT_INTERFACES.to_vec(); - actual.sort_unstable(); - expected.sort_unstable(); - assert_eq!(actual, expected); - for key in resolve.worlds[world].imports.keys() { - assert!( - matches!(key, WorldKey::Interface(_)), - "the command world should import only named interfaces" - ); - } - } - - #[test] - fn runs_the_command_when_wasmtime_is_available() { - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - eprintln!("skipping: wasmtime is not installed"); - return; - } - let (resolve, world) = command_world().expect("WASI and application WIT should load"); - let core = core_module_exporting_run(); - let component = componentize(&core, &resolve, world).expect("componentizing"); - let path = std::env::temp_dir().join(format!("psrs-command-{}.wasm", std::process::id())); - std::fs::write(&path, &component).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - let _ = std::fs::remove_file(&path); - assert!( - output.status.success(), - "wasmtime failed to run the component: {output:?}" - ); - } - - fn core_module_printing() -> Vec { - let span = TextRange::new(0, 1); - let module = Module { - name: "Print".into(), - imports: vec![ - Import { - module: "wasi:cli/stdout@0.2.12".into(), - name: "get-stdout".into(), - type_index: TypeIndex(0), - }, - Import { - module: "wasi:io/streams@0.2.12".into(), - name: "[method]output-stream.blocking-write-and-flush".into(), - type_index: TypeIndex(1), - }, - ], - types: vec![ - FuncType { - parameters: Vec::new(), - results: vec![ValType::I32], - }, - FuncType { - parameters: vec![ValType::I32; 4], - results: Vec::new(), - }, - FuncType { - parameters: Vec::new(), - results: vec![ValType::I32], - }, - ], - type_defs: Vec::new(), - functions: vec![Function { - symbol: SymbolId::new(ModuleId(0), 0), - name: crate::abi::RUN_CORE_EXPORT.into(), - type_index: TypeIndex(2), - parameters: Vec::new(), - locals: vec![ValType::I32], - body: vec![ - Op::Leaf(Instruction::Call(0)), - Op::Leaf(Instruction::LocalSet(0)), - Op::Leaf(Instruction::LocalGet(0)), - Op::Leaf(Instruction::I32Const(100)), - Op::Leaf(Instruction::I32Const(6)), - Op::Leaf(Instruction::I32Const(0)), - Op::Leaf(Instruction::Call(1)), - Op::Leaf(Instruction::I32Const(0)), - ], - span, - }], - memories: vec![Memory { - id: crate::types::MemoryId(0), - index: MemoryIndex(0), - minimum: 1, - maximum: None, - }], - data: vec![DataSegment { - id: crate::types::DataId(0), - index: DataIndex(0), - mode: crate::wasm::DataMode::Active { offset: 100 }, - bytes: b"hello\n".to_vec(), - }], - exports: vec![ - Export { - name: crate::abi::RUN_CORE_EXPORT.into(), - kind: ExportKind::Function, - index: ExportIndex::Function(FunctionIndex(2)), - }, - Export { - name: "memory".into(), - kind: ExportKind::Memory, - index: ExportIndex::Memory(MemoryIndex(0)), - }, - ], - entry: None, - realloc: None, - globals: Vec::new(), - helpers: Vec::new(), - span, - }; - crate::wasm::encode_module(&module).expect("encoding the core module") - } - - #[test] - fn prints_via_wasi_stdout_when_wasmtime_is_available() { - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - eprintln!("skipping: wasmtime is not installed"); - return; - } - let (resolve, world) = command_world().expect("WASI and application WIT should load"); - let core = core_module_printing(); - let component = componentize(&core, &resolve, world).expect("componentizing"); - crate::validator() - .validate_all(&component) - .expect("the component should validate"); - let path = std::env::temp_dir().join(format!("psrs-print-{}.wasm", std::process::id())); - std::fs::write(&path, &component).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - let _ = std::fs::remove_file(&path); - assert!( - output.status.success(), - "wasmtime failed to run the component: {output:?}" - ); - assert_eq!(output.stdout, b"hello\n"); - } -} diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index fca133da..1171373b 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -3,10 +3,11 @@ mod bindings; mod boundary; pub mod capability; pub mod cc; -pub mod component; mod effects; +mod linking; pub mod mir; mod pipeline; +mod target_runtime; pub mod trace; pub mod types; pub mod wasm; diff --git a/crates/psrs-backend/src/linking/mod.rs b/crates/psrs-backend/src/linking/mod.rs new file mode 100644 index 00000000..6c27e3ed --- /dev/null +++ b/crates/psrs-backend/src/linking/mod.rs @@ -0,0 +1,334 @@ +//! Checked IR-to-linker requests and diagnostic mapping. +//! +//! The backend converts its optimized MIR imports and target capability +//! profile into linker-owned target records, runs the independent planner, and +//! attaches language diagnostics to any structured link failure. The resulting +//! plan is consumed by both Wasm emission and component assembly. + +use crate::abi::{self, WasiRegistry, names}; +use crate::mir; +use crate::target_runtime; +use crate::{BackendError, TargetCapabilities}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_linker::{ + ArtifactReference, BindingRequirement, Boundary, CheckedLinkPlan, CoreSignature, CoreType, + MemoryDemand, Provider, RequirementId, ResolvedWorldContext, TargetLinkInput, TargetPolicy, +}; +use psrs_span::TextRange; +use std::collections::{BTreeMap, HashMap}; +use std::sync::{Arc, OnceLock}; + +/// A checked plan together with the backend's requirement identity mappings. +pub(crate) struct LinkPlan { + pub context: Arc, + pub plan: CheckedLinkPlan, + /// The planned core import `(module, field)` for each MIR import symbol. + pub imports: HashMap, +} + +/// The default resolved-world context, parsed once per process. +pub(crate) fn default_context() -> Result, Vec> { + static CONTEXT: OnceLock, String>> = OnceLock::new(); + match CONTEXT.get_or_init(|| { + psrs_linker::resolve_default_definitions() + .map(Arc::new) + .map_err(|error| error.to_string()) + }) { + Ok(context) => Ok(Arc::clone(context)), + Err(message) => Err(definitions_error(message)), + } +} + +fn definitions_error(message: &str) -> Vec { + vec![BackendError::new( + "P9 target definitions", + TextRange::new(0, 0), + message, + )] +} + +/// Builds and checks the target link plan for an optimized MIR module. +pub(crate) fn plan_for_module( + context: &Arc, + module: &mir::Module, + wasi: &mut WasiRegistry, + target: TargetCapabilities, +) -> Result> { + let mut requirements = Vec::new(); + let mut symbols: Vec<(SymbolId, RequirementId)> = Vec::new(); + let mut spans: HashMap)> = HashMap::new(); + let mut artifacts: BTreeMap = BTreeMap::new(); + let mut next = 0_u32; + let owner = module.entry.map(|entry| entry.module); + + for import in &module.imports { + let id = RequirementId(next); + next += 1; + // Generated helpers are roots even though no source foreign declaration + // names them; they are lowered locally and need no external provider. + if let Some(name) = local_symbol_name(import.symbol) { + let requirement = BindingRequirement { + id, + origin: format!("generated.{name}"), + boundary: Boundary::RawCore { + module: "generated".into(), + field: name.into(), + }, + expected: None, + provider: Provider::Generated, + }; + spans.insert(requirement.origin.clone(), (module.span, owner)); + requirements.push(requirement); + continue; + } + if let Some(implementation) = target_runtime::for_symbol(import.symbol) { + let requirement = implementation.requirement(id); + artifacts + .entry(implementation.artifact.id.to_string()) + .or_insert_with(|| implementation.artifact_reference()); + spans.insert(requirement.origin.clone(), (module.span, owner)); + requirements.push(requirement); + symbols.push((import.symbol, id)); + } else if let Some((interface, field)) = wasi.symbol_name(import.symbol) { + let interface = interface.to_string(); + let field = field.to_string(); + let signature = core_signature(import, module.span)?; + let requirement = BindingRequirement { + id, + origin: format!("{interface}.{field}"), + boundary: Boundary::ResolvedWit { + interface: interface.clone(), + function: field, + }, + expected: Some(signature), + provider: Provider::HostInterface { interface }, + }; + spans.insert(requirement.origin.clone(), (module.span, owner)); + requirements.push(requirement); + symbols.push((import.symbol, id)); + } else { + return Err(vec![BackendError::new( + "P9 target linking", + module.span, + "a MIR import symbol has no selected provider", + )]); + } + } + + // The synthesized command entry exits through WASI; the plan owns that + // capability even though no source foreign declaration names it. + if target.wasi_cli && module.entry.is_some() { + let exit = wasi + .import(names::EXIT, names::EXIT_WITH_CODE) + .map_err(|message| { + vec![BackendError::new("P9 target linking", module.span, message)] + })?; + let id = RequirementId(next); + let requirement = BindingRequirement { + id, + origin: format!("{}.{}", exit.module, exit.name), + boundary: Boundary::ResolvedWit { + interface: exit.module.clone(), + function: exit.name.clone(), + }, + expected: Some(CoreSignature { + parameters: exit + .parameters + .iter() + .copied() + .map(core_value_type) + .collect(), + result: exit.result.map(core_value_type), + }), + provider: Provider::HostInterface { + interface: exit.module.clone(), + }, + }; + spans.insert(requirement.origin.clone(), (module.span, owner)); + requirements.push(requirement); + symbols.push((exit.symbol, id)); + } + + let input = TargetLinkInput { + requirements, + artifacts: artifacts.into_values().collect(), + policy: TargetPolicy { + permitted_host_interfaces: permitted_host_interfaces(context, target), + }, + memory: memory_demand(), + }; + let plan = + psrs_linker::plan(context, input).map_err(|errors| map_link_errors(&errors, &spans))?; + + let imports = symbols + .into_iter() + .filter_map(|(symbol, id)| { + plan.import(id) + .map(|binding| (symbol, (binding.module.clone(), binding.field.clone()))) + }) + .collect(); + + Ok(LinkPlan { + context: Arc::clone(context), + plan, + imports, + }) +} + +/// Assembles the component from a checked plan. +pub(crate) fn compose( + link: &LinkPlan, + application: &[u8], + span: TextRange, + owner: Option, +) -> Result, Vec> { + psrs_linker::compose(&link.context, &link.plan, application) + .map(|artifact| artifact.bytes) + .map_err(|errors| { + errors + .0 + .into_iter() + .map(|error| { + attach( + BackendError::new("P11 component", span, error.to_string()), + owner, + ) + }) + .collect() + }) +} + +fn local_symbol_name(symbol: SymbolId) -> Option<&'static str> { + match symbol { + abi::REALLOC_SYMBOL => Some("realloc"), + abi::STRING_TO_BYTES_SYMBOL => Some("string_to_bytes"), + abi::BYTES_TO_STRING_SYMBOL => Some("bytes_to_string"), + abi::VALIDATE_STEP_SYMBOL => Some("validate_step"), + _ => None, + } +} + +fn core_signature( + import: &mir::Import, + span: TextRange, +) -> Result> { + let mut parameters = Vec::with_capacity(import.parameters.len()); + for ty in &import.parameters { + let Some(ty) = core_value_type_opt(*ty) else { + return Err(vec![BackendError::invalid_ir( + "P9 target linking", + span, + "a host import has a non-scalar canonical parameter", + )]); + }; + parameters.push(ty); + } + let result = match import.result { + Some(ty) => Some(core_value_type_opt(ty).ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 target linking", + span, + "a host import has a non-scalar canonical result", + )] + })?), + None => None, + }; + Ok(CoreSignature { parameters, result }) +} + +fn core_value_type(ty: crate::types::ValueType) -> CoreType { + core_value_type_opt(ty).expect("a canonical ABI import is scalar") +} + +fn core_value_type_opt(ty: crate::types::ValueType) -> Option { + match ty { + crate::types::ValueType::I32 | crate::types::ValueType::Boolean => Some(CoreType::I32), + crate::types::ValueType::I64 => Some(CoreType::I64), + crate::types::ValueType::F32 => Some(CoreType::F32), + crate::types::ValueType::F64 => Some(CoreType::F64), + crate::types::ValueType::Ref(_) => None, + } +} + +fn memory_demand() -> MemoryDemand { + MemoryDemand { + canonical_scratch: (abi::PRINT_SCRATCH as u32, abi::SCRATCH_END), + allocator_state: (abi::HEAP_STATE, abi::HEAP_STATE + abi::HEAP_STATE_SIZE), + base_heap_start: abi::HEAP_START, + heap_alignment: abi::MIN_BLOCK, + } +} + +/// The canonical ids the selected target profile permits: the world's import +/// interfaces, with the capability-family gate applied to WASI services only. +fn permitted_host_interfaces( + context: &ResolvedWorldContext, + target: TargetCapabilities, +) -> Vec { + context + .world_imports() + .iter() + .filter(|interface| { + !interface.starts_with("wasi:") || abi::wasi_interface_enabled(target, interface) + }) + .cloned() + .collect() +} + +fn map_link_errors( + errors: &psrs_linker::LinkErrors, + spans: &HashMap)>, +) -> Vec { + errors + .0 + .iter() + .map(|error| { + let (span, owner) = error + .subject + .as_ref() + .and_then(|subject| spans.get(subject)) + .copied() + .unwrap_or((TextRange::new(0, 0), None)); + attach( + BackendError::new("P11 target linking", span, error.to_string()), + owner, + ) + }) + .collect() +} + +fn attach(error: BackendError, owner: Option) -> BackendError { + match owner { + Some(module) => error.with_module(module), + None => error, + } +} + +#[cfg(test)] +pub(crate) fn empty_plan(context: &ResolvedWorldContext) -> CheckedLinkPlan { + psrs_linker::plan( + context, + TargetLinkInput { + requirements: Vec::new(), + artifacts: Vec::new(), + policy: TargetPolicy::default(), + memory: memory_demand(), + }, + ) + .expect("an empty plan is valid") +} + +#[cfg(test)] +pub(crate) fn compose_core(core: &[u8]) -> Result, String> { + let context = default_context().map_err(|errors| { + errors + .into_iter() + .map(|error| error.message) + .collect::>() + .join("; ") + })?; + let plan = empty_plan(&context); + psrs_linker::compose(&context, &plan, core) + .map(|artifact| artifact.bytes) + .map_err(|errors| errors.to_string()) +} diff --git a/crates/psrs-backend/src/mir/gc_tests/mod.rs b/crates/psrs-backend/src/mir/gc_tests/mod.rs index 4754f8f7..f493a80f 100644 --- a/crates/psrs-backend/src/mir/gc_tests/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/mod.rs @@ -63,9 +63,7 @@ fn run_gc_output(mir: &crate::mir::Module) -> Option { eprintln!("skipping: wasmtime is unusable"); return None; } - let (resolve, world) = crate::component::command_world().expect("WASI WIT should load"); - let component = crate::component::componentize(&core, &resolve, world) - .expect("componentizing the GC module"); + let component = crate::linking::compose_core(&core).expect("componentizing the GC module"); let path = std::env::temp_dir().join(format!( "psrs-gc-{}-{}.wasm", std::process::id(), diff --git a/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs b/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs index 5151214d..af5a534c 100644 --- a/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs +++ b/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs @@ -278,7 +278,7 @@ impl FunctionLowerer<'_> { Ok(capacity) } - fn constant( + pub(super) fn constant( &mut self, block: BlockId, value: i32, diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 7ab7c0fc..f2dd1b38 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -100,6 +100,14 @@ impl FunctionLowerer<'_> { )?; self.append_instruction(current, instruction, assignment.span)?; } + AssignmentKind::NumberToString { value } => { + self.lower_number_to_string( + current, + assignment.destination, + *value, + assignment.span, + )?; + } AssignmentKind::Unary { op, value } => self.append_instruction( current, Instruction::UnaryPrimitive { diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index 7d1af3ac..fbb7a614 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -18,6 +18,7 @@ mod assignment_array; mod assignment_string; mod assignments; mod conversion_helpers; +mod number_string; mod tail; mod variant; pub(super) use conversion_helpers::ConversionHelpers; diff --git a/crates/psrs-backend/src/mir/lower/number_string.rs b/crates/psrs-backend/src/mir/lower/number_string.rs new file mode 100644 index 00000000..8a11e1e9 --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/number_string.rs @@ -0,0 +1,62 @@ +//! Checked raw runtime formatting followed by canonical UTF-8 recovery. +use super::*; + +impl FunctionLowerer<'_> { + pub(super) fn lower_number_to_string( + &mut self, + block: BlockId, + destination: ValueId, + value: ValueId, + span: TextRange, + ) -> Result<(), Vec> { + let implementation = + crate::target_runtime::implementation(psrs_hir::Intrinsic::NumberToString) + .expect("NumberToString has a registered target implementation"); + let zero = self.constant(block, 0, span)?; + let align = self.constant(block, 1, span)?; + let capacity = self.constant(block, implementation.abi.output_capacity as i32, span)?; + let buffer = self.fresh(ValueType::I32); + self.append_instruction( + block, + Instruction::Call { + destination: buffer, + function: crate::abi::REALLOC_SYMBOL, + arguments: vec![zero, zero, align, capacity], + span, + }, + span, + )?; + let length = self.fresh(ValueType::I32); + self.append_instruction( + block, + Instruction::Call { + destination: length, + function: implementation.symbol, + arguments: vec![value, buffer, capacity], + span, + }, + span, + )?; + self.append_instruction( + block, + Instruction::Call { + destination, + function: crate::abi::BYTES_TO_STRING_SYMBOL, + arguments: vec![buffer, length], + span, + }, + span, + )?; + let discarded = self.fresh(ValueType::I32); + self.append_instruction( + block, + Instruction::Call { + destination: discarded, + function: crate::abi::REALLOC_SYMBOL, + arguments: vec![buffer, capacity, align, zero], + span, + }, + span, + ) + } +} diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 2e39decf..18f932be 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -35,6 +35,8 @@ mod gc_tests; #[cfg(test)] mod indirect_tests; #[cfg(test)] +mod number_format_tests; +#[cfg(test)] mod tests; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] @@ -185,6 +187,19 @@ pub fn lower_module_with_bindings( lower_module_after_binding_validation(module, bindings, target, wasi) } +/// Lowers CC to MIR over the linker's shared resolved definitions, so the +/// registry borrows the same parsed WIT rather than loading a second copy. +pub fn lower_module_with_bindings_and_resolve( + module: cc::Module, + bindings: crate::ExternalBindings, + target: TargetCapabilities, + resolve: std::sync::Arc, +) -> Result<(Module, WasiRegistry), Vec> { + bindings.validate_cc(&module)?; + let wasi = WasiRegistry::from_shared_resolve(resolve, target); + lower_module_after_binding_validation(module, bindings, target, wasi) +} + #[cfg(test)] pub(crate) fn lower_module_with_registry( module: cc::Module, @@ -333,6 +348,9 @@ fn lower_module_after_binding_validation( result: Some(ValueType::I32), }); } + if used.contains(&crate::target_runtime::NUMBER_FORMAT.symbol) { + imports.push(crate::target_runtime::NUMBER_FORMAT.import()); + } // The canonical ABI boundary transcodes between the GC string's UTF-16 and // the component's UTF-8. The adapter calls these reserved helpers, which P10 // synthesizes as ordinary Wasm functions; they are never core imports. diff --git a/crates/psrs-backend/src/mir/number_format_tests.rs b/crates/psrs-backend/src/mir/number_format_tests.rs new file mode 100644 index 00000000..ebc97952 --- /dev/null +++ b/crates/psrs-backend/src/mir/number_format_tests.rs @@ -0,0 +1,176 @@ +//! End-to-end formatter artifact execution through the checked plan. + +use super::{BasicBlock, BlockId, Function, Import, Instruction, Module, Terminator}; +use crate::types::{ValueDecl, ValueId, ValueType}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; + +fn span() -> TextRange { + TextRange::new(0, 1) +} + +fn registry() -> crate::abi::WasiRegistry { + crate::abi::WasiRegistry::load().expect("the vendored WASI WIT should load") +} + +/// A MIR function that allocates a bounded buffer, calls the embedded +/// formatter artifact's raw export, and returns the initialized byte length. +fn number_format_module() -> Module { + Module { + name: "NumberFormat".into(), + entry: Some(SymbolId::new(ModuleId(0), 0)), + types: Vec::new(), + strings: Vec::new(), + layout: None, + imports: vec![ + Import { + symbol: crate::abi::REALLOC_SYMBOL, + parameters: vec![ValueType::I32; 4], + result: Some(ValueType::I32), + }, + Import { + symbol: crate::abi::NUMBER_TO_STRING_SYMBOL, + parameters: vec![ValueType::F64, ValueType::I32, ValueType::I32], + result: Some(ValueType::I32), + }, + ], + functions: vec![Function { + id: crate::types::FunctionId(0), + symbol: SymbolId::new(ModuleId(0), 0), + name: "main".into(), + parameters: Vec::new(), + values: vec![ + ValueDecl { + id: ValueId(0), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(1), + ty: ValueType::F64, + }, + ValueDecl { + id: ValueId(2), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(3), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(4), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(5), + ty: ValueType::I32, + }, + ], + entry: BlockId(0), + blocks: vec![BasicBlock { + id: BlockId(0), + parameters: Vec::new(), + instructions: vec![ + Instruction::NumberConstant { + destination: ValueId(1), + value: "1e21".into(), + span: span(), + }, + Instruction::Constant { + destination: ValueId(3), + value: 0, + span: span(), + }, + Instruction::Constant { + destination: ValueId(4), + value: 1, + span: span(), + }, + Instruction::Constant { + destination: ValueId(5), + value: psrs_runtime::NUMBER_CAPACITY as i32, + span: span(), + }, + Instruction::Call { + destination: ValueId(2), + function: crate::abi::REALLOC_SYMBOL, + arguments: vec![ValueId(3), ValueId(3), ValueId(4), ValueId(5)], + span: span(), + }, + Instruction::Call { + destination: ValueId(0), + function: crate::abi::NUMBER_TO_STRING_SYMBOL, + arguments: vec![ValueId(1), ValueId(2), ValueId(5)], + span: span(), + }, + ], + terminator: Some(Terminator::Return { + value: ValueId(0), + span: span(), + }), + }], + result: ValueId(0), + result_type: ValueType::I32, + span: span(), + }], + span: span(), + } +} + +/// Lowers and runs a MIR module through the default world's checked plan, +/// attaching the runtime artifact through component composition. +fn run_with_checked_plan(mir: &Module) -> Option { + let target = crate::TargetCapabilities::default(); + let context = crate::linking::default_context().expect("the default world resolves"); + let mut wasi = registry(); + let link = crate::linking::plan_for_module(&context, mir, &mut wasi, target) + .expect("the formatter module should plan"); + assert!( + !link.plan.artifacts().is_empty(), + "the formatter plan should select the runtime artifact" + ); + let wasm = crate::wasm::lower_module_with_plan(mir, &mut wasi, target, &link) + .expect("the formatter module should lower"); + let core = crate::wasm::encode_module(&wasm).expect("encoding the formatter module"); + crate::validator_for(target) + .validate_all(&core) + .expect("the core module should validate"); + let component = crate::linking::compose(&link, &core, mir.span, None) + .expect("the formatter component should compose"); + crate::validator_for(target) + .validate_all(&component) + .expect("the component should validate"); + + if std::process::Command::new("wasmtime") + .arg("--version") + .output() + .is_err() + { + eprintln!("skipping: wasmtime is not installed"); + return None; + } + let path = std::env::temp_dir().join(format!("psrs-format-{}.wasm", std::process::id())); + std::fs::write(&path, &component).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + let _ = std::fs::remove_file(&path); + Some(output) +} + +/// The formatter artifact is selected by the checked plan, shares the +/// application's memory above the allocator boundary, and returns the +/// initialized token length through the command exit code. +#[test] +fn formats_a_number_through_the_runtime_artifact() { + let mir = number_format_module(); + let Some(output) = run_with_checked_plan(&mir) else { + return; + }; + assert_eq!( + output.status.code(), + Some(5), + "1e21 formats to the 5-byte token \"1e+21\": {output:?}" + ); +} diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index 1440350e..9dfaabdc 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -134,6 +134,7 @@ pub(super) fn add_assignments( | AssignmentKind::StringConstant(_) | AssignmentKind::Primitive { .. } | AssignmentKind::Unary { .. } + | AssignmentKind::NumberToString { .. } | AssignmentKind::ArrayLen { .. } | AssignmentKind::Unreachable => {} AssignmentKind::ClosureGetCapture { .. } => { diff --git a/crates/psrs-backend/src/mir/tests.rs b/crates/psrs-backend/src/mir/tests.rs index 4f4368d4..eb3b603d 100644 --- a/crates/psrs-backend/src/mir/tests.rs +++ b/crates/psrs-backend/src/mir/tests.rs @@ -283,8 +283,7 @@ fn runs_a_mir_gc_struct_under_wasmtime() { eprintln!("skipping: wasmtime is not installed"); return; } - let (resolve, world) = crate::component::command_world().expect("WASI WIT should load"); - let component = crate::component::componentize(&core, &resolve, world).expect("componentizing"); + let component = crate::linking::compose_core(&core).expect("componentizing"); let path = std::env::temp_dir().join(format!("psrs-mir-gc-{}.wasm", std::process::id())); std::fs::write(&path, &component).unwrap(); let output = std::process::Command::new("wasmtime") diff --git a/crates/psrs-backend/src/pipeline/emission.rs b/crates/psrs-backend/src/pipeline/emission.rs index 9cc732ba..3bc5fdd8 100644 --- a/crates/psrs-backend/src/pipeline/emission.rs +++ b/crates/psrs-backend/src/pipeline/emission.rs @@ -1,6 +1,6 @@ use super::*; -use crate::component; +use crate::linking; pub(crate) struct EmittedWasm { pub module: crate::wasm::Module, @@ -23,6 +23,42 @@ pub(crate) fn emit( value: format!("{target:?}"), }] }; + let context = linking::default_context().map_err(|errors| annotate_errors(errors, owner))?; + let mut plan_call = trace.as_deref_mut().map(|trace| { + trace.begin( + "backend.target.plan", + &[ + mir_id.expect("traced MIR before target planning"), + wasi_id.expect("traced WASI registry before target planning"), + ], + TraceValidationCoverage::Composite, + target_parameter(), + ) + }); + let link = match linking::plan_for_module(&context, mir, wasi, target) { + Ok(link) => link, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), plan_call) { + trace.reject(call, errors.len()); + } + return Err(annotate_errors(errors, owner)); + } + }; + if let Some(call) = plan_call.as_mut() { + annotate_plan(call, &link); + } + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), plan_call) { + trace.complete( + call, + &[TraceRepresentation::LinkPlan], + &[TraceValidationSpec::output( + "psrs_linker::plan", + 0, + TraceValidationCoverage::Composite, + )], + ); + } + let wasm_call = trace.as_deref_mut().map(|trace| { trace.begin( "backend.wasm.lower", @@ -34,7 +70,7 @@ pub(crate) fn emit( target_parameter(), ) }); - let module = match crate::wasm::lower_module_with_capabilities(mir, wasi, target) { + let module = match crate::wasm::lower_module_with_plan(mir, wasi, target, &link) { Ok(module) => module, Err(errors) => { if let (Some(trace), Some(call)) = (trace.as_deref_mut(), wasm_call) { @@ -49,7 +85,7 @@ pub(crate) fn emit( call, &[TraceRepresentation::WasmModule], &[TraceValidationSpec::output( - "wasm::lower_module_with_capabilities", + "wasm::lower_module_with_plan", 0, TraceValidationCoverage::Composite, )], @@ -86,59 +122,21 @@ pub(crate) fn emit( None }; - let resolve_call = trace.as_deref_mut().map(|trace| { - trace.begin( - "backend.component.resolve_world", - &[], - TraceValidationCoverage::NotObserved, - vec![TraceParameter { - key: "wit_source", - value: "vendored".into(), - }], - ) - }); - let (resolve, world) = match component::command_world() { - Ok(result) => result, - Err(message) => { - if let (Some(trace), Some(call)) = (trace.as_deref_mut(), resolve_call) { - trace.reject(call, 1); - } - return Err(annotate_errors( - vec![BackendError::new("P11 component", mir.span, message)], - owner, - )); - } - }; - let world_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), resolve_call) { - trace - .complete(call, &[TraceRepresentation::WitWorld], &[]) - .first() - .copied() - } else { - None - }; - let component_call = trace.as_deref_mut().map(|trace| { trace.begin( "backend.component.assemble", - &[ - core_id.expect("traced core Wasm before component assembly"), - world_id.expect("traced WIT world before component assembly"), - ], + &[core_id.expect("traced core Wasm before component assembly")], TraceValidationCoverage::Composite, Vec::new(), ) }); - let binary = match component::componentize(&core, &resolve, world) { + let binary = match linking::compose(&link, &core, mir.span, owner) { Ok(binary) => binary, - Err(message) => { + Err(errors) => { if let (Some(trace), Some(call)) = (trace.as_deref_mut(), component_call) { - trace.reject(call, 1); + trace.reject(call, errors.len()); } - return Err(annotate_errors( - vec![BackendError::new("P11 component", mir.span, message)], - owner, - )); + return Err(annotate_errors(errors, owner)); } }; let component_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), component_call) { @@ -147,7 +145,7 @@ pub(crate) fn emit( call, &[TraceRepresentation::ComponentBinary], &[TraceValidationSpec::output( - "wit_component::ComponentEncoder::validate_and_encode", + "psrs_linker::compose", 0, TraceValidationCoverage::Composite, )], @@ -231,3 +229,30 @@ pub(crate) fn emit( wat, }) } + +/// Records the checked plan's lineage: selected providers, artifact digests, +/// memory boundary, and the planned external world. +fn annotate_plan(call: &mut crate::trace::TraceCall, link: &linking::LinkPlan) { + let plan = &link.plan; + call.add_parameter("requirements", plan.bindings().len().to_string()); + call.add_parameter("artifacts", plan.artifacts().len().to_string()); + call.add_parameter( + "selected_providers", + plan.bindings() + .iter() + .map(|binding| format!("{}={}.{}", binding.origin, binding.module, binding.field)) + .collect::>() + .join(";"), + ); + call.add_parameter( + "artifact_digests", + plan.artifacts() + .iter() + .map(|artifact| format!("{}={}", artifact.id, artifact.sha256)) + .collect::>() + .join(";"), + ); + call.add_parameter("external_world", plan.external_world().join(";")); + call.add_parameter("heap_start", plan.memory().heap_start.to_string()); + call.add_parameter("minimum_pages", plan.memory().minimum_pages.to_string()); +} diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs index 2a5e3e75..c9242911 100644 --- a/crates/psrs-backend/src/pipeline/mod.rs +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -233,16 +233,29 @@ pub(crate) fn compile_with_context_inner( target_parameter(), ) }); - let (mir, mut wasi) = - match mir::lower_module_with_bindings(cc.clone(), lowered_cc.externals, target) { - Ok(result) => result, - Err(errors) => { - if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_call) { - trace.reject(call, errors.len()); - } - return Err(errors); + let context = match crate::linking::default_context() { + Ok(context) => context, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_call) { + trace.reject(call, errors.len()); } - }; + return Err(annotate_errors(errors, cc.entry.map(|entry| entry.module))); + } + }; + let (mir, mut wasi) = match mir::lower_module_with_bindings_and_resolve( + cc.clone(), + lowered_cc.externals, + target, + context.shared_resolve(), + ) { + Ok(result) => result, + Err(errors) => { + if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_call) { + trace.reject(call, errors.len()); + } + return Err(errors); + } + }; let (mut mir, mir_ids) = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), mir_call) { let outputs = trace.complete( call, diff --git a/crates/psrs-backend/src/target_runtime.rs b/crates/psrs-backend/src/target_runtime.rs new file mode 100644 index 00000000..94d9fc5a --- /dev/null +++ b/crates/psrs-backend/src/target_runtime.rs @@ -0,0 +1,127 @@ +//! The embedded target library's implementation catalog entry. +//! +//! This module maps a checked language intrinsic to its embedded artifact +//! export and converts it into a linker-owned requirement. The runtime package +//! owns the raw contract; `psrs-linker` owns verification and planning. + +use psrs_hir::{Intrinsic, SymbolId}; +use psrs_linker::{ + ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, Provider, + RequirementId, +}; + +/// Connects a checked language intrinsic to its embedded implementation. +pub(crate) struct Implementation { + pub intrinsic: Intrinsic, + pub symbol: SymbolId, + pub abi: &'static psrs_runtime::FormatterAbi, + pub artifact: &'static psrs_runtime::RuntimeArtifact, +} + +pub(crate) const NUMBER_FORMAT: Implementation = Implementation { + intrinsic: Intrinsic::NumberToString, + symbol: crate::abi::NUMBER_TO_STRING_SYMBOL, + abi: &psrs_runtime::NUMBER_FORMAT, + artifact: &psrs_runtime::NUMBER_FORMATTER, +}; + +/// The registered implementation for a checked intrinsic, if any. +pub(crate) fn implementation(intrinsic: Intrinsic) -> Option<&'static Implementation> { + (intrinsic == NUMBER_FORMAT.intrinsic).then_some(&NUMBER_FORMAT) +} + +/// The registered implementation for a MIR import symbol, if any. +pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static Implementation> { + (symbol == NUMBER_FORMAT.symbol).then_some(&NUMBER_FORMAT) +} + +impl Implementation { + pub fn import(&self) -> crate::mir::Import { + crate::mir::Import { + symbol: self.symbol, + parameters: self + .abi + .parameters + .iter() + .copied() + .map(value_type) + .collect(), + result: Some(value_type(self.abi.result)), + } + } + + pub fn signature(&self) -> CoreSignature { + CoreSignature { + parameters: self.abi.parameters.iter().copied().map(core_type).collect(), + result: Some(core_type(self.abi.result)), + } + } + + /// The linker requirement for this artifact export. + pub fn requirement(&self, id: RequirementId) -> BindingRequirement { + let signature = self.signature(); + BindingRequirement { + id, + origin: format!("{:?}", self.intrinsic), + boundary: Boundary::RawCore { + module: self.artifact.module_name.to_string(), + field: self.abi.export.to_string(), + }, + expected: Some(signature.clone()), + provider: Provider::ArtifactExport { + artifact: self.artifact.id.to_string(), + export: self.abi.export.to_string(), + signature, + }, + } + } + + /// The pinned artifact and typed contract for this implementation. + pub fn artifact_reference(&self) -> ArtifactReference { + ArtifactReference { + contract: psrs_linker::runtime::contract(self.artifact), + bytes: self.artifact.bytes.to_vec(), + } + } +} + +fn core_type(ty: psrs_runtime::RawType) -> CoreType { + match ty { + psrs_runtime::RawType::I32 => CoreType::I32, + psrs_runtime::RawType::I64 => CoreType::I64, + psrs_runtime::RawType::F32 => CoreType::F32, + psrs_runtime::RawType::F64 => CoreType::F64, + } +} + +fn value_type(ty: psrs_runtime::RawType) -> crate::types::ValueType { + match ty { + psrs_runtime::RawType::I32 => crate::types::ValueType::I32, + psrs_runtime::RawType::I64 => crate::types::ValueType::I64, + psrs_runtime::RawType::F32 => crate::types::ValueType::F32, + psrs_runtime::RawType::F64 => crate::types::ValueType::F64, + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn the_number_formatter_maps_to_a_raw_artifact_requirement() { + let formatter = implementation(Intrinsic::NumberToString).unwrap(); + let requirement = formatter.requirement(RequirementId(0)); + assert_eq!( + requirement.boundary, + Boundary::RawCore { + module: psrs_runtime::MODULE_NAME.into(), + field: psrs_runtime::NUMBER_EXPORT.into(), + } + ); + assert!(matches!( + requirement.provider, + Provider::ArtifactExport { .. } + )); + assert!(implementation(Intrinsic::I32Add).is_none()); + } +} diff --git a/crates/psrs-backend/src/trace.rs b/crates/psrs-backend/src/trace.rs index a320fcb4..b5fb4fbe 100644 --- a/crates/psrs-backend/src/trace.rs +++ b/crates/psrs-backend/src/trace.rs @@ -21,6 +21,8 @@ pub enum TraceRepresentation { WatText, WitWorld, WasiRegistry, + /// The checked target link plan produced after MIR optimization. + LinkPlan, } #[derive(Clone, Copy, Debug, PartialEq, Eq)] @@ -196,6 +198,14 @@ pub(crate) struct TraceCall { parameters: Vec, } +impl TraceCall { + /// Records an additional lineage parameter after the pass has produced a + /// result but before it is completed or rejected. + pub(crate) fn add_parameter(&mut self, key: &'static str, value: String) { + self.parameters.push(TraceParameter { key, value }); + } +} + impl TraceRecorder { pub(crate) fn new() -> Self { let initial_core = TraceArtifactId(0); diff --git a/crates/psrs-backend/src/wasm/lower/mod.rs b/crates/psrs-backend/src/wasm/lower/mod.rs index 31f71430..286efb26 100644 --- a/crates/psrs-backend/src/wasm/lower/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/mod.rs @@ -36,11 +36,29 @@ pub fn lower_module( lower_module_with_capabilities(module, wasi, TargetCapabilities::default()) } -/// Lowers MIR using an explicit target capability profile. +/// Lowers MIR using an explicit target capability profile. Isolated callers +/// that already resolved custom WIT use a permissive context over their own +/// definitions; the production pipeline calls [`lower_module_with_plan`] with +/// the default world's checked plan. pub fn lower_module_with_capabilities( module: &mir::Module, wasi: &mut abi::WasiRegistry, target: TargetCapabilities, +) -> Result> { + let context = std::sync::Arc::new(psrs_linker::ResolvedWorldContext::permissive( + wasi.shared_resolve(), + )); + let link = crate::linking::plan_for_module(&context, module, wasi, target)?; + lower_module_with_plan(module, wasi, target, &link) +} + +/// Lowers MIR using the memory and import plan of one checked link plan. The +/// emitter cannot choose libraries or derive storage; it consumes the plan. +pub(crate) fn lower_module_with_plan( + module: &mir::Module, + wasi: &mut abi::WasiRegistry, + target: TargetCapabilities, + link: &crate::linking::LinkPlan, ) -> Result> { mir::verify_module_with_capabilities(module, target)?; let Some(entry_symbol) = module.entry else { @@ -113,13 +131,13 @@ pub fn lower_module_with_capabilities( .map(|ty| vec![val_type(ty)]) .unwrap_or_default(), }); - let (module_name, field) = wasi.symbol_name(import.symbol).ok_or_else(|| { - wasm_error(module.span, "a MIR import symbol has no ABI registry entry") + let (module_name, field) = link.imports.get(&import.symbol).ok_or_else(|| { + wasm_error(module.span, "a MIR import symbol has no checked provider") })?; import_indices.insert(import.symbol, FunctionIndex(imports.len() as u32)); imports.push(Import { - module: module_name.to_string(), - name: field.to_string(), + module: module_name.clone(), + name: field.clone(), type_index, }); } @@ -136,6 +154,13 @@ pub fn lower_module_with_capabilities( message, )] })?; + let (exit_module, exit_field) = + link.imports.get(&exit.symbol).cloned().ok_or_else(|| { + wasm_error( + module.span, + "the command entry exit has no checked provider", + ) + })?; let exit_type_index = TypeIndex(defined + types.len() as u32); types.push(FuncType { parameters: exit.parameters.iter().map(|ty| val_type(*ty)).collect(), @@ -143,8 +168,8 @@ pub fn lower_module_with_capabilities( }); let index = FunctionIndex(imports.len() as u32); imports.push(Import { - module: exit.module, - name: exit.name, + module: exit_module, + name: exit_field, type_index: exit_type_index, }); Some(index) @@ -248,9 +273,11 @@ pub fn lower_module_with_capabilities( index: ExportIndex::Function(index), }); // The heap-state segment holds the free-list head (null) and the bump - // break (the first allocatable address). + // break (the first allocatable address). The allocator boundary is the + // one the checked plan reserved, after every artifact region. + let heap_start = link.plan.memory().heap_start; let mut state = 0_u32.to_le_bytes().to_vec(); - state.extend_from_slice(&abi::HEAP_START.to_le_bytes()); + state.extend_from_slice(&heap_start.to_le_bytes()); data.push(DataSegment { id: DataId(data.len() as u32), index: DataIndex(data.len() as u32), @@ -259,8 +286,10 @@ pub fn lower_module_with_capabilities( }, bytes: state, }); - minimum = (u64::from(abi::HEAP_START)).div_ceil(0x10000) + 1; + minimum = link.plan.memory().minimum_pages; realloc = Some(build_realloc(realloc_type, module.span)); + } else if !link.plan.artifacts().is_empty() { + minimum = link.plan.memory().minimum_pages; } let helpers = if needs_helpers { let string_type = string_type.expect("a needed codec has a GC string type"); diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests.rs index d19b8a1c..7f296648 100644 --- a/crates/psrs-backend/src/wasm/lower/post_return/tests.rs +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests.rs @@ -7,7 +7,6 @@ use super::{ BufferExport, post_return_name, synthesize_buffer_post_return, synthesize_owned_handle_post_return, }; -use crate::component::componentize; use psrs_hir::{ModuleId, SymbolId}; use psrs_span::TextRange; use wasm_encoder::{Instruction, ValType}; @@ -17,6 +16,16 @@ fn span() -> TextRange { TextRange::new(0, 1) } +/// Composes a fixture core module against its own custom world and an empty +/// checked plan; these fixtures declare no artifact requirements. +fn componentize(core: &[u8], resolve: Resolve, world: WorldId) -> Result, String> { + let context = psrs_linker::ResolvedWorldContext::from_resolve(resolve, world); + let plan = crate::linking::empty_plan(&context); + psrs_linker::compose(&context, &plan, core) + .map(|artifact| artifact.bytes) + .map_err(|errors| errors.to_string()) +} + #[test] fn post_return_drops_an_owned_export_handle() { let wit = r#" @@ -118,7 +127,7 @@ fn post_return_drops_an_owned_export_handle() { span: span(), }; let core = crate::wasm::encode_module(&module).expect("encoding the core module"); - let component = componentize(&core, &resolve, world).expect("componentizing post-return"); + let component = componentize(&core, resolve, world).expect("componentizing post-return"); crate::validator() .validate_all(&component) .expect("the component should validate"); @@ -412,7 +421,7 @@ fn component_attaches_the_buffer_post_return() { let binary = crate::wasm::encode_module(&module).expect("Wasm encodes"); let (resolve, world) = string_world(); let component = - componentize(&binary, &resolve, world).expect("componentizing the string export"); + componentize(&binary, resolve, world).expect("componentizing the string export"); crate::validator() .validate_all(&component) .expect("the component should validate"); diff --git a/crates/psrs-backend/src/wasm/mod.rs b/crates/psrs-backend/src/wasm/mod.rs index a5d3f0fd..370e10f6 100644 --- a/crates/psrs-backend/src/wasm/mod.rs +++ b/crates/psrs-backend/src/wasm/mod.rs @@ -13,6 +13,7 @@ mod verify; mod tests; pub use encode::encode_module; +pub(crate) use lower::lower_module_with_plan; pub use lower::{lower_module, lower_module_with_capabilities}; /// Final index domains assigned by P10. These are deliberately distinct from diff --git a/crates/psrs-cli/src/diagnose/trace/build.rs b/crates/psrs-cli/src/diagnose/trace/build.rs index b1efe1b7..b48e2249 100644 --- a/crates/psrs-cli/src/diagnose/trace/build.rs +++ b/crates/psrs-cli/src/diagnose/trace/build.rs @@ -17,6 +17,7 @@ fn representation_key(value: TraceRepresentation) -> &'static str { TraceRepresentation::WatText => "wat_text", TraceRepresentation::WitWorld => "wit_world", TraceRepresentation::WasiRegistry => "wasi_registry", + TraceRepresentation::LinkPlan => "link_plan", } } diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index ab9ae981..f4fbf6fb 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -73,13 +73,14 @@ pub(super) fn primitive_types(intrinsic: Intrinsic, module: &Module) -> (TypeId, } pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (TypeId, TypeId) { - use TypeConstructor::{Boolean, Char, Int, Number}; + use TypeConstructor::{Boolean, Char, Int, Number, String}; let (operand, result) = match intrinsic { Intrinsic::IntNeg | Intrinsic::IntComplement => (Int, Int), Intrinsic::NumberNeg => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), + Intrinsic::NumberToString => (Number, String), Intrinsic::BooleanToInt => (Boolean, Int), Intrinsic::IntToBoolean => (Int, Boolean), Intrinsic::CharToInt => (Char, Int), diff --git a/crates/psrs-driver/src/tests/diagnosis_trace.rs b/crates/psrs-driver/src/tests/diagnosis_trace.rs index 76d7f559..048645da 100644 --- a/crates/psrs-driver/src/tests/diagnosis_trace.rs +++ b/crates/psrs-driver/src/tests/diagnosis_trace.rs @@ -121,6 +121,48 @@ fn frontend_rejection_has_diagnostics_but_no_backend_trace_or_core_output() { assert_eq!(frontend.diagnostic_indices.len(), report.diagnostics.len()); } +#[test] +fn target_plan_records_provider_and_memory_lineage() { + let source = "module Main where\nmain = 42\n"; + let report = compile_program_sources_with_prelude_diagnosis(&[("Main.purs", source)], false); + assert!( + report.artifact.is_some(), + "program should compile: {:?}", + report.diagnostics + ); + let trace = report.backend_trace.expect("backend pass trace"); + let plan = trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.target.plan") + .expect("the checked plan is an observed execution"); + assert_eq!(plan.status, TracePassStatus::Completed); + let parameter = |key: &str| { + plan.parameters + .iter() + .find(|parameter| parameter.key == key) + .map(|parameter| parameter.value.as_str()) + }; + assert_eq!(parameter("artifacts"), Some("0")); + assert_eq!(parameter("heap_start"), Some("24")); + assert!( + parameter("selected_providers") + .expect("selected providers are recorded") + .contains("wasi:cli/exit"), + "{:?}", + plan.parameters + ); + assert!( + parameter("external_world") + .expect("the external world is recorded") + .contains("wasi:cli/exit"), + ); + assert!(trace.artifacts.iter().any(|artifact| { + artifact.representation == TraceRepresentation::LinkPlan + && artifact.state == TraceArtifactState::Produced + })); +} + #[test] fn target_rejection_keeps_prior_artifacts_and_maps_errors_to_its_execution() { let prepared = crate::prepare_sources(&[("Main.purs", "module Main where\nmain = 42\n")]) diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index ad3af3ad..1ed1024a 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -89,6 +89,70 @@ main = let ignored = runEffect checks in 0 ); } +#[test] +fn formatter_plan_records_the_pinned_artifact_digest() { + let source = r#" +module Main where + +import Prelude +import Effect.Console (log) + +main = let ignored = log (show 1.0e21) in 0 +"#; + let report = compile_program_sources_with_prelude_diagnosis(&[("Main.purs", source)], false); + assert!( + report.artifact.is_some(), + "show should compile: {:?}", + report.diagnostics + ); + let trace = report.backend_trace.expect("backend pass trace"); + let plan = trace + .executions + .iter() + .find(|execution| execution.pass_key == "backend.target.plan") + .expect("the checked plan is an observed execution"); + let parameter = |key: &str| { + plan.parameters + .iter() + .find(|parameter| parameter.key == key) + .map(|parameter| parameter.value.as_str()) + }; + assert_eq!(parameter("artifacts"), Some("1")); + let digests = parameter("artifact_digests").expect("artifact digests are recorded"); + assert!(digests.contains("psrs:runtime-number-format"), "{digests}"); + assert!( + parameter("selected_providers") + .expect("selected providers are recorded") + .contains("NumberToString"), + ); +} + +#[test] +fn formats_many_numbers_without_exhausting_the_runtime_stack() { + // The formatter is nonrecursive; a large array of numbers calls its raw + // export once per element through the same private stack region. + let mut elements = String::new(); + for index in 0..64 { + if index > 0 { + elements.push(','); + } + elements.push_str(&format!("{index}.5")); + } + let source = format!( + "module Main where\n\nimport Prelude\nimport Effect.Console (log)\n\nmain = let ignored = runEffect (log (show [{elements}])) in 0\n" + ); + let Some(output) = run_with_wasmtime(&source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); + let stdout = String::from_utf8_lossy(&output.stdout); + assert!( + stdout.starts_with("[0.5,1.5,") && stdout.ends_with("63.5]\n"), + "stdout should hold every formatted element: {stdout}" + ); +} + #[test] fn a_type_without_show_is_rejected() { let source = r#" diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 23b58af5..7fae986a 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -101,6 +101,7 @@ pub enum Intrinsic { ArrayFill, /// Unsafe in-place write; returns the same array. Library internals only. ArrayWrite, + NumberToString, } impl Intrinsic { @@ -123,7 +124,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 63] = [ + pub const ALL: [Intrinsic; 64] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -187,6 +188,7 @@ impl Intrinsic { Intrinsic::UnsafeCoerce, Intrinsic::ArrayFill, Intrinsic::ArrayWrite, + Intrinsic::NumberToString, ]; } @@ -195,7 +197,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::ArrayWrite as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::NumberToString as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index a777ea97..5943641a 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -148,6 +148,7 @@ descriptors! { UnsafeCoerce => "__psrs_unsafe_coerce", 1, Coercion, scheme::unsafe_coerce; ArrayFill => "arrayFill", 2, ArrayFill, scheme::array_fill; ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; + NumberToString => "numberToString", 1, UnaryScalar, scheme::number_string; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that @@ -279,6 +280,10 @@ mod scheme { unary(BuiltinType::Int, BuiltinType::Number) } + pub(super) fn number_string() -> Type { + unary(BuiltinType::Number, BuiltinType::String) + } + pub(super) fn number_int() -> Type { unary(BuiltinType::Number, BuiltinType::Int) } diff --git a/crates/psrs-linker/Cargo.toml b/crates/psrs-linker/Cargo.toml new file mode 100644 index 00000000..b48bbe73 --- /dev/null +++ b/crates/psrs-linker/Cargo.toml @@ -0,0 +1,16 @@ +[package] +name = "psrs-linker" +version.workspace = true +edition.workspace = true +license.workspace = true + +[dependencies] +psrs-runtime = { workspace = true, default-features = false, features = ["catalog"] } +sha2 = "=0.10.9" +wasm-encoder.workspace = true +wasmparser.workspace = true +wit-component = "=0.245.1" +wit-parser = "=0.245.1" + +[dev-dependencies] +wasmprinter.workspace = true diff --git a/crates/psrs-linker/src/compose.rs b/crates/psrs-linker/src/compose.rs new file mode 100644 index 00000000..cbbaca84 --- /dev/null +++ b/crates/psrs-linker/src/compose.rs @@ -0,0 +1,127 @@ +//! Component composition and final import-closure verification. + +use crate::definitions::ResolvedWorldContext; +use crate::error::{LinkErrors, LinkStage}; +use crate::plan::CheckedLinkPlan; +use wasmparser::{Parser, Payload}; +use wit_component::{ComponentEncoder, LibraryInfo, StringEncoding, embed_component_metadata}; + +/// The final composed component and the host interfaces it still imports. +#[derive(Clone, Debug)] +pub struct LinkedArtifact { + pub bytes: Vec, + pub external_world: Vec, +} + +/// Composes an encoded application with the plan's verified libraries. +/// +/// The final component's unresolved imports must be a subset of the plan's +/// external world; the private runtime import must be closed. +pub fn compose( + context: &ResolvedWorldContext, + plan: &CheckedLinkPlan, + application: &[u8], +) -> Result { + let stage = LinkStage::Compose; + let mut bytes = application.to_vec(); + embed_component_metadata( + &mut bytes, + context.resolve(), + context.world(), + StringEncoding::UTF8, + ) + .map_err(|error| { + LinkErrors::plain( + stage, + format!("failed to embed component metadata: {error}"), + ) + })?; + let mut encoder = ComponentEncoder::default() + .module(&bytes) + .map_err(|error| { + LinkErrors::plain(stage, format!("failed to read the core module: {error}")) + })?; + for artifact in plan.artifacts() { + encoder = encoder + .library( + &artifact.module_name, + &artifact.bytes, + LibraryInfo { + instantiate_after_shims: artifact.instantiate_after_shims, + arguments: Vec::new(), + }, + ) + .map_err(|error| { + LinkErrors::one( + stage, + &artifact.id, + format!("failed to attach artifact: {error:#}"), + ) + })?; + } + let output = encoder.validate(true).encode().map_err(|error| { + LinkErrors::plain(stage, format!("failed to encode the component: {error:#}")) + })?; + wasmparser::Validator::new() + .validate_all(&output) + .map_err(|error| { + LinkErrors::plain( + stage, + format!("composed component failed validation: {error}"), + ) + })?; + + let imports = component_imports(&output)?; + for import in &imports { + if import == psrs_runtime::MODULE_NAME { + return Err(LinkErrors::plain( + stage, + "the private runtime import was not closed inside the component", + )); + } + // Interface imports are named by canonical id and must be permitted by + // the world; type and function imports belong to those interfaces. + if import.contains('/') && !context.imports_interface(import) { + return Err(LinkErrors::one( + stage, + import.clone(), + "component imports an interface outside the permitted external world", + )); + } + } + Ok(LinkedArtifact { + bytes: output, + external_world: imports, + }) +} + +fn component_imports(bytes: &[u8]) -> Result, LinkErrors> { + let mut imports = Vec::new(); + let mut depth = 0_usize; + for payload in Parser::new(0).parse_all(bytes) { + match payload.map_err(|error| { + LinkErrors::plain( + LinkStage::Compose, + format!("failed to parse component: {error}"), + ) + })? { + Payload::ComponentSection { .. } | Payload::ModuleSection { .. } => depth += 1, + Payload::End(_) => depth = depth.saturating_sub(1), + Payload::ComponentImportSection(reader) if depth == 0 => { + // Only the outermost component's import section lists + // unresolved host imports; nested shims have their own. + for import in reader { + let import = import.map_err(|error| { + LinkErrors::plain( + LinkStage::Compose, + format!("failed to read component import: {error}"), + ) + })?; + imports.push(import.name.0.to_string()); + } + } + _ => {} + } + } + Ok(imports) +} diff --git a/crates/psrs-linker/src/definitions.rs b/crates/psrs-linker/src/definitions.rs new file mode 100644 index 00000000..27e1d0d5 --- /dev/null +++ b/crates/psrs-linker/src/definitions.rs @@ -0,0 +1,303 @@ +//! WIT definition loading and the immutable resolved-world context. +//! +//! One resolved context is shared by backend ABI lowering and linker provider +//! validation. It is held behind an `Arc` so the backend can borrow it without +//! parsing a second copy or regenerating interface identities. + +use crate::error::{LinkErrors, LinkStage}; +use psrs_runtime::{APP_WIT, DEFAULT_WORLD, WASI_WIT, WitSource, WorldIdentity}; +use std::collections::{BTreeSet, HashMap, HashSet}; +use std::sync::Arc; +use wit_parser::{ + Handle, InterfaceId, Resolve, Type, TypeDefKind, TypeId, TypeOwner, WorldId, WorldItem, +}; + +/// One immutable resolved world shared by ABI lowering and provider validation. +pub struct ResolvedWorldContext { + resolve: Arc, + world: Option, + imports: Vec, + exports: Vec, +} + +impl ResolvedWorldContext { + /// Wraps an already-resolved `Resolve`/`WorldId` pair. Used by isolated + /// target tests with custom WIT fixtures. + pub fn from_resolve(resolve: Resolve, world: WorldId) -> Self { + let (imports, exports) = collect_interfaces(&resolve, world); + Self { + resolve: Arc::new(resolve), + world: Some(world), + imports, + exports, + } + } + + /// A context that permits every interface the resolve defines. Isolated ABI + /// fixtures use it; it has no world and cannot be composed. + pub fn permissive(resolve: Arc) -> Self { + let mut imports = resolve + .interfaces + .iter() + .filter_map(|(id, _)| resolve.id_of(id)) + .collect::>(); + imports.sort(); + Self { + resolve, + world: None, + imports, + exports: Vec::new(), + } + } + + /// The resolved definitions. Backend canonical flattening reads through + /// this borrow; it never loads a second copy. + pub fn resolve(&self) -> &Resolve { + &self.resolve + } + + /// A shared handle to the same resolved definitions. The backend's ABI + /// registry keeps this handle instead of cloning the `Resolve`. + pub fn shared_resolve(&self) -> Arc { + Arc::clone(&self.resolve) + } + + pub fn world(&self) -> WorldId { + self.world.expect("a permissive context has no world") + } + + /// Canonical ids of interfaces the default world imports. + pub fn world_imports(&self) -> &[String] { + &self.imports + } + + /// Canonical ids of interfaces the default world exports. + pub fn world_exports(&self) -> &[String] { + &self.exports + } + + /// Whether the world imports the named canonical interface. + pub fn imports_interface(&self, canonical: &str) -> bool { + self.imports.iter().any(|id| id == canonical) + } + + /// The allowed residual host capabilities: the transitive WIT dependency + /// closure of `seeds` within the resolved world. + pub fn host_closure(&self, seeds: &BTreeSet) -> Vec { + let resolve = &self.resolve; + let mut owner = HashMap::::new(); + for (id, ty) in resolve.types.iter() { + if let TypeOwner::Interface(interface) = ty.owner { + owner.insert(id, interface); + } + } + let mut pending = Vec::new(); + let mut seen = HashSet::::new(); + for (id, _) in resolve.interfaces.iter() { + if let Some(canonical) = resolve.id_of(id) + && seeds.contains(&canonical) + && seen.insert(id) + { + pending.push(id); + } + } + while let Some(interface) = pending.pop() { + let mut referenced = Vec::new(); + for ty in resolve.interfaces[interface].types.values() { + walk_type(resolve, &Type::Id(*ty), &mut referenced); + } + for function in resolve.interfaces[interface].functions.values() { + for param in &function.params { + walk_type(resolve, ¶m.ty, &mut referenced); + } + if let Some(ty) = &function.result { + walk_type(resolve, ty, &mut referenced); + } + } + for ty in referenced { + if let Some(dependency) = owner.get(&ty) + && seen.insert(*dependency) + { + pending.push(*dependency); + } + } + } + let mut ids = seen + .into_iter() + .filter_map(|id| resolve.id_of(id)) + .collect::>(); + ids.sort(); + ids + } +} + +fn walk_type(resolve: &Resolve, ty: &Type, out: &mut Vec) { + if let Type::Id(id) = ty { + out.push(*id); + walk_kind(resolve, &resolve.types[*id].kind, out); + } +} + +fn walk_kind(resolve: &Resolve, kind: &TypeDefKind, out: &mut Vec) { + match kind { + TypeDefKind::Record(record) => { + for field in &record.fields { + walk_type(resolve, &field.ty, out); + } + } + TypeDefKind::Tuple(tuple) => { + for ty in &tuple.types { + walk_type(resolve, ty, out); + } + } + TypeDefKind::Variant(variant) => { + for case in &variant.cases { + if let Some(ty) = &case.ty { + walk_type(resolve, ty, out); + } + } + } + TypeDefKind::Option(ty) | TypeDefKind::List(ty) => walk_type(resolve, ty, out), + TypeDefKind::Result(result) => { + if let Some(ty) = &result.ok { + walk_type(resolve, ty, out); + } + if let Some(ty) = &result.err { + walk_type(resolve, ty, out); + } + } + TypeDefKind::Map(key, value) => { + walk_type(resolve, key, out); + walk_type(resolve, value, out); + } + TypeDefKind::FixedLengthList(ty, _) => walk_type(resolve, ty, out), + TypeDefKind::Future(Some(ty)) | TypeDefKind::Stream(Some(ty)) => { + walk_type(resolve, ty, out) + } + TypeDefKind::Type(ty) => walk_type(resolve, ty, out), + TypeDefKind::Handle(Handle::Own(id) | Handle::Borrow(id)) => { + walk_type(resolve, &Type::Id(*id), out); + } + _ => {} + } +} + +/// Resolves the supplied WIT sources into one world context. +/// +/// The application package must declare the requested world; a mismatch is a +/// hard error rather than a silent fallback. +pub fn resolve_definitions( + wasi: &[WitSource], + app: WitSource, + world: WorldIdentity, +) -> Result { + let mut resolve = Resolve::default(); + for source in wasi { + resolve + .push_str(source.path, source.contents) + .map_err(|error| { + LinkErrors::one( + LinkStage::Definitions, + source.path, + format!("invalid WIT source: {error}"), + ) + })?; + } + let package = resolve.push_str(app.path, app.contents).map_err(|error| { + LinkErrors::one( + LinkStage::Definitions, + app.path, + format!("invalid application WIT: {error}"), + ) + })?; + let declared = &resolve.packages[package].name; + if declared.namespace != world.package_namespace || declared.name != world.package_name { + return Err(LinkErrors::one( + LinkStage::Definitions, + app.path, + format!( + "application WIT declares `{}:{}`, not `{}:{}`", + declared.namespace, declared.name, world.package_namespace, world.package_name + ), + )); + } + let world_id = resolve.packages[package] + .worlds + .get(world.world) + .copied() + .ok_or_else(|| { + LinkErrors::one( + LinkStage::Definitions, + format!("{}:{}", world.package_namespace, world.package_name), + format!("application WIT is missing the `{}` world", world.world), + ) + })?; + let (imports, exports) = collect_interfaces(&resolve, world_id); + Ok(ResolvedWorldContext { + resolve: Arc::new(resolve), + world: Some(world_id), + imports, + exports, + }) +} + +/// Resolves the runtime's pinned default world. +pub fn resolve_default_definitions() -> Result { + resolve_definitions(WASI_WIT, APP_WIT, DEFAULT_WORLD) +} + +fn collect_interfaces(resolve: &Resolve, world: WorldId) -> (Vec, Vec) { + let mut imports = Vec::new(); + let mut exports = Vec::new(); + for item in resolve.worlds[world].imports.values() { + if let WorldItem::Interface { id, .. } = item + && let Some(id) = resolve.id_of(*id) + { + imports.push(id); + } + } + for item in resolve.worlds[world].exports.values() { + if let WorldItem::Interface { id, .. } = item + && let Some(id) = resolve.id_of(*id) + { + exports.push(id); + } + } + imports.sort(); + exports.sort(); + (imports, exports) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn default_world_resolves_and_exports_the_command() { + let context = resolve_default_definitions().expect("the pinned WIT should resolve"); + assert!( + context + .world_imports() + .iter() + .any(|id| id == "wasi:cli/stdout@0.2.12") + ); + assert!( + context + .world_exports() + .iter() + .any(|id| id == "wasi:cli/run@0.2.12") + ); + assert!(context.imports_interface("wasi:io/streams@0.2.12")); + assert!(!context.imports_interface("wasi:http/outgoing-handler@0.2.12")); + } + + #[test] + fn a_world_identity_mismatch_is_rejected() { + let bogus = WorldIdentity { + package_namespace: "other", + package_name: "app", + world: "command", + }; + assert!(resolve_definitions(WASI_WIT, APP_WIT, bogus).is_err()); + } +} diff --git a/crates/psrs-linker/src/digest.rs b/crates/psrs-linker/src/digest.rs new file mode 100644 index 00000000..ba411cf6 --- /dev/null +++ b/crates/psrs-linker/src/digest.rs @@ -0,0 +1,14 @@ +//! SHA-256 digests for pinned artifact bytes. + +use sha2::{Digest, Sha256}; + +/// The lowercase hexadecimal SHA-256 of `bytes`. +pub fn sha256_hex(bytes: &[u8]) -> String { + let digest = Sha256::digest(bytes); + let mut out = String::with_capacity(64); + for byte in digest { + use std::fmt::Write; + let _ = write!(out, "{byte:02x}"); + } + out +} diff --git a/crates/psrs-linker/src/error.rs b/crates/psrs-linker/src/error.rs new file mode 100644 index 00000000..25b4dcdd --- /dev/null +++ b/crates/psrs-linker/src/error.rs @@ -0,0 +1,97 @@ +//! Structured link failures. The linker never publishes a partial plan or a +//! composed artifact when any check fails. + +use std::fmt; + +/// The linking stage that rejected an input. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum LinkStage { + /// WIT definition loading and world resolution. + Definitions, + /// Requirement/provider closure. + Requirements, + /// Artifact contract validation. + Verify, + /// Memory reservation and instantiation planning. + Memory, + /// Component composition and final import closure. + Compose, +} + +impl LinkStage { + fn label(self) -> &'static str { + match self { + LinkStage::Definitions => "definitions", + LinkStage::Requirements => "requirements", + LinkStage::Verify => "verify", + LinkStage::Memory => "memory", + LinkStage::Compose => "compose", + } + } +} + +/// One structured link failure carrying the owning subject identity. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct LinkError { + pub stage: LinkStage, + /// The requirement origin, artifact id, or interface the failure names. + pub subject: Option, + pub message: String, +} + +/// A nonempty collection of link failures. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct LinkErrors(pub Vec); + +impl LinkErrors { + pub fn new(errors: Vec) -> Self { + debug_assert!(!errors.is_empty(), "a link failure has at least one cause"); + Self(errors) + } + + pub fn one(stage: LinkStage, subject: impl Into, message: impl Into) -> Self { + Self(vec![LinkError { + stage, + subject: Some(subject.into()), + message: message.into(), + }]) + } + + pub fn plain(stage: LinkStage, message: impl Into) -> Self { + Self(vec![LinkError { + stage, + subject: None, + message: message.into(), + }]) + } +} + +impl From for LinkErrors { + fn from(error: LinkError) -> Self { + Self(vec![error]) + } +} + +impl fmt::Display for LinkError { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + write!(f, "{}: ", self.stage.label())?; + if let Some(subject) = &self.subject { + write!(f, "{subject}: ")?; + } + write!(f, "{}", self.message) + } +} + +impl fmt::Display for LinkErrors { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + for (index, error) in self.0.iter().enumerate() { + if index > 0 { + writeln!(f)?; + } + write!(f, "{error}")?; + } + Ok(()) + } +} + +impl std::error::Error for LinkErrors {} diff --git a/crates/psrs-linker/src/lib.rs b/crates/psrs-linker/src/lib.rs new file mode 100644 index 00000000..5826611f --- /dev/null +++ b/crates/psrs-linker/src/lib.rs @@ -0,0 +1,36 @@ +//! Independent checked target linker. +//! +//! This crate owns WIT definition loading and the resolved-world identity, +//! provider closure and artifact contract validation, the immutable checked +//! link plan, and component composition. It consumes linker-owned target +//! records and the `psrs-runtime` catalog; it depends on no compiler IR crate. +//! +//! The conceptual API is: +//! +//! ```text +//! resolve_definitions(...) -> ResolvedWorldContext +//! plan(context, TargetLinkInput) -> CheckedLinkPlan +//! compose(context, plan, encoded_application) -> LinkedArtifact +//! ``` + +mod compose; +mod definitions; +mod digest; +mod error; +pub mod plan; +pub mod runtime; +mod target; +mod verify; + +pub use compose::{LinkedArtifact, compose}; +pub use definitions::{ResolvedWorldContext, resolve_default_definitions, resolve_definitions}; +pub use digest::sha256_hex; +pub use error::{LinkError, LinkErrors, LinkStage}; +pub use plan::{CheckedLinkPlan, MemoryPlan, ResolvedBinding, plan}; +pub use target::{ + ArtifactContract, ArtifactKind, ArtifactReference, BindingRequirement, Boundary, CoreSignature, + CoreType, DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, + ImportKind, InitializationContract, MemoryDemand, Provider, RequirementId, StorageContract, + StorageRegion, TargetLinkInput, TargetPolicy, +}; +pub use verify::{VerifiedArtifact, verify_artifact}; diff --git a/crates/psrs-linker/src/plan.rs b/crates/psrs-linker/src/plan.rs new file mode 100644 index 00000000..d02c17a2 --- /dev/null +++ b/crates/psrs-linker/src/plan.rs @@ -0,0 +1,396 @@ +//! Provider closure, artifact verification, and memory/instantiation planning. + +use crate::definitions::ResolvedWorldContext; +use crate::error::{LinkErrors, LinkStage}; +use crate::target::{ + ArtifactContract, ArtifactKind, Boundary, CoreSignature, Provider, RequirementId, + StorageRegion, TargetLinkInput, +}; +use crate::verify::{VerifiedArtifact, verify_artifact}; +use std::collections::{BTreeMap, BTreeSet}; + +/// A requirement bound to its verified provider. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ResolvedBinding { + pub requirement: RequirementId, + pub origin: String, + pub module: String, + pub field: String, + pub signature: CoreSignature, +} + +/// The checked memory ownership and allocator boundary. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct MemoryPlan { + pub heap_start: u32, + pub heap_alignment: u32, + pub minimum_pages: u64, + /// Every owned region, sorted by start address. + pub reservations: Vec, +} + +/// One immutable checked target link plan. +/// +/// Construction is private to successful planning, so every live requirement +/// has exactly one verified provider and the memory and external world are +/// internally consistent. +#[derive(Clone, Debug)] +pub struct CheckedLinkPlan { + bindings: Vec, + artifacts: Vec, + memory: MemoryPlan, + external_world: Vec, + digests: Vec, +} + +impl CheckedLinkPlan { + /// The binding for a requirement, when it contributes a core import. + pub fn import(&self, requirement: RequirementId) -> Option<&ResolvedBinding> { + self.bindings + .iter() + .find(|binding| binding.requirement == requirement) + } + + pub fn bindings(&self) -> &[ResolvedBinding] { + &self.bindings + } + + pub fn artifacts(&self) -> &[VerifiedArtifact] { + &self.artifacts + } + + pub fn memory(&self) -> &MemoryPlan { + &self.memory + } + + /// The permitted residual host interfaces, sorted. + pub fn external_world(&self) -> &[String] { + &self.external_world + } + + pub fn digests(&self) -> &[String] { + &self.digests + } +} + +/// Plans a checked link from a resolved world and target input. +pub fn plan( + context: &ResolvedWorldContext, + input: TargetLinkInput, +) -> Result { + let TargetLinkInput { + requirements, + artifacts: artifact_refs, + memory: memory_demand, + policy, + } = input; + let stage = LinkStage::Requirements; + let mut errors = Vec::new(); + + let mut requirement_ids = BTreeSet::new(); + for requirement in &requirements { + if !requirement_ids.insert(requirement.id) { + errors.push(crate::error::LinkError { + stage, + subject: Some(requirement.origin.clone()), + message: "duplicate requirement identity".into(), + }); + } + } + + let mut artifacts: BTreeMap = BTreeMap::new(); + for artifact in &artifact_refs { + let id = artifact.contract.id.clone(); + if artifacts.insert(id.clone(), artifact.clone()).is_some() { + errors.push(crate::error::LinkError { + stage, + subject: Some(id), + message: "duplicate artifact identity".into(), + }); + } + } + if !errors.is_empty() { + return Err(LinkErrors::new(errors)); + } + + let mut verified: BTreeMap = BTreeMap::new(); + let mut used_artifacts = BTreeSet::new(); + let mut external = BTreeSet::new(); + // A core import identity resolves to exactly one provider and signature. + let mut claims = BTreeMap::<(String, String), (CoreSignature, String)>::new(); + let mut bindings = Vec::new(); + + for requirement in &requirements { + match &requirement.provider { + Provider::Generated => {} + Provider::ArtifactExport { + artifact, + export, + signature, + } => { + let reference = artifacts.get(artifact).ok_or_else(|| { + LinkErrors::one( + stage, + &requirement.origin, + format!("absent artifact `{artifact}`"), + ) + })?; + let Boundary::RawCore { module, field } = &requirement.boundary else { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "an artifact export requires a raw-core boundary", + )); + }; + if module != &reference.contract.module_name || field != export { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "artifact boundary does not name the selected export", + )); + } + let declared = artifact_export(&reference.contract, export).ok_or_else(|| { + LinkErrors::one( + stage, + &requirement.origin, + format!("artifact `{artifact}` does not declare export `{export}`"), + ) + })?; + if declared != *signature || requirement.expected.as_ref() != Some(signature) { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "artifact export signature disagrees with the checked requirement", + )); + } + if !verified.contains_key(artifact) { + let value = verify_artifact(&reference.contract, &reference.bytes)?; + verified.insert(artifact.clone(), value); + } + used_artifacts.insert(artifact.clone()); + claim( + &mut claims, + (module.clone(), field.clone()), + signature.clone(), + artifact, + &mut errors, + )?; + bindings.push(ResolvedBinding { + requirement: requirement.id, + origin: requirement.origin.clone(), + module: module.clone(), + field: field.clone(), + signature: signature.clone(), + }); + } + Provider::HostInterface { interface } => { + if !policy + .permitted_host_interfaces + .iter() + .any(|permitted| permitted == interface) + { + return Err(LinkErrors::one( + stage, + &requirement.origin, + format!( + "host interface `{interface}` is not permitted by the selected target profile" + ), + )); + } + let Some(expected) = requirement.expected.clone() else { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "a host binding requires a checked raw signature", + )); + }; + let (module, field) = match &requirement.boundary { + Boundary::ResolvedWit { + interface: name, + function, + } if name == interface => (name.clone(), function.clone()), + _ => { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "host binding must cross the selected WIT interface", + )); + } + }; + external.insert(interface.clone()); + claim( + &mut claims, + (module.clone(), field.clone()), + expected.clone(), + interface, + &mut errors, + )?; + bindings.push(ResolvedBinding { + requirement: requirement.id, + origin: requirement.origin.clone(), + module, + field, + signature: expected, + }); + } + } + } + if !errors.is_empty() { + return Err(LinkErrors::new(errors)); + } + + let memory = plan_memory(&artifact_refs, &memory_demand, &used_artifacts, &verified)?; + + let mut digests = verified + .values() + .map(|value| value.sha256.clone()) + .collect::>(); + digests.sort(); + digests.dedup(); + + Ok(CheckedLinkPlan { + bindings, + artifacts: verified.into_values().collect(), + memory, + external_world: context.host_closure(&external), + digests, + }) +} + +fn artifact_export(contract: &ArtifactContract, export: &str) -> Option { + contract.exports.iter().find_map(|declared| { + (declared.name == export && declared.kind == crate::target::ExportKind::Func) + .then(|| declared.signature.clone()) + .flatten() + }) +} + +fn claim( + claims: &mut BTreeMap<(String, String), (CoreSignature, String)>, + key: (String, String), + signature: CoreSignature, + provider: &str, + errors: &mut Vec, +) -> Result<(), LinkErrors> { + if let Some((existing, existing_provider)) = claims.get(&key) { + if existing != &signature || existing_provider != provider { + return Err(LinkErrors::one( + LinkStage::Requirements, + format!("{}.{}", key.0, key.1), + "ambiguous or conflicting providers for one import identity", + )); + } + return Ok(()); + } + claims.insert(key, (signature, provider.to_string())); + let _ = errors; + Ok(()) +} + +fn plan_memory( + artifacts: &[crate::target::ArtifactReference], + demand: &crate::target::MemoryDemand, + used_artifacts: &BTreeSet, + verified: &BTreeMap, +) -> Result { + let stage = LinkStage::Memory; + let mut reservations = vec![ + region("canonical-scratch", demand.canonical_scratch), + region("allocator-state", demand.allocator_state), + ]; + let mut heap_start = demand.base_heap_start; + let mut minimum_pages = u64::from(heap_start).div_ceil(0x1_0000) + 1; + + for id in used_artifacts { + let artifact = verified.get(id).expect("a used artifact is verified"); + let contract = artifacts + .iter() + .find(|reference| &reference.contract.id == id) + .map(|reference| &reference.contract) + .ok_or_else(|| LinkErrors::one(stage, id, "verified artifact has no contract"))?; + let Some(storage) = &contract.storage else { + continue; + }; + if contract.kind == ArtifactKind::CoreModule && storage.stack.end <= storage.stack.start { + return Err(LinkErrors::one( + stage, + id, + "artifact stack reservation is empty", + )); + } + if storage.stack.end - storage.stack.start < storage.stack_bound_bytes { + return Err(LinkErrors::one( + stage, + id, + "artifact stack reservation is smaller than its reviewed bound", + )); + } + reservations.push(StorageRegion { + owner: id.clone(), + start: storage.static_data.start, + end: storage.static_data.end, + }); + reservations.push(StorageRegion { + owner: id.clone(), + start: storage.stack.start, + end: storage.stack.end, + }); + heap_start = heap_start.max(storage.heap_start); + minimum_pages = minimum_pages.max(storage.minimum_pages); + let _ = artifact; + } + + reservations.sort_by_key(|region| (region.start, region.end)); + for pair in reservations.windows(2) { + if pair[1].start < pair[0].end { + return Err(LinkErrors::one( + stage, + pair[1].owner.clone(), + format!( + "reservation [{}, {}) overlaps `{}` at [{}, {})", + pair[1].start, pair[1].end, pair[0].owner, pair[0].start, pair[0].end + ), + )); + } + } + let alignment = demand.heap_alignment; + if alignment == 0 || !heap_start.is_multiple_of(alignment) { + return Err(LinkErrors::plain( + stage, + "allocator boundary is not aligned to its block granularity", + )); + } + if let Some(last) = reservations.last() + && last.end > heap_start + { + return Err(LinkErrors::one( + stage, + last.owner.clone(), + "a reservation extends past the allocator boundary", + )); + } + if u64::from(heap_start) > minimum_pages * 0x1_0000 { + return Err(LinkErrors::plain( + stage, + "declared minimum pages do not cover the allocator boundary", + )); + } + // The allocator does not grow memory; it needs at least one page of heap + // beyond the boundary where every reserved region ends. + minimum_pages = minimum_pages.max(u64::from(heap_start).div_ceil(0x1_0000) + 1); + + Ok(MemoryPlan { + heap_start, + heap_alignment: alignment, + minimum_pages, + reservations, + }) +} + +fn region(owner: &str, range: (u32, u32)) -> StorageRegion { + StorageRegion { + owner: owner.to_string(), + start: range.0, + end: range.1, + } +} diff --git a/crates/psrs-linker/src/runtime.rs b/crates/psrs-linker/src/runtime.rs new file mode 100644 index 00000000..24f2ff02 --- /dev/null +++ b/crates/psrs-linker/src/runtime.rs @@ -0,0 +1,108 @@ +//! Converts runtime catalog data into linker-owned artifact contracts. +//! +//! The runtime package owns the raw declaration; the linker owns the typed +//! contract it verifies and plans against. + +use crate::target::{ + ArtifactContract, ArtifactKind, CoreSignature, CoreType, DeclaredExport, DeclaredGlobal, + DeclaredImport, DeclaredTable, ExportKind, ImportKind, InitializationContract, StorageContract, + StorageRegion, +}; +use psrs_runtime::{RawType, RuntimeArtifact}; + +/// Maps a catalog artifact into the contract its bytes must satisfy. +pub fn contract(artifact: &RuntimeArtifact) -> ArtifactContract { + ArtifactContract { + id: artifact.id.to_string(), + kind: ArtifactKind::CoreModule, + module_name: artifact.module_name.to_string(), + sha256: artifact.provenance.sha256.to_string(), + provenance: format!( + "{} {} via {} ({} {}): {}", + artifact.provenance.dependency, + artifact.provenance.dependency_revision, + artifact.provenance.rust_toolchain, + artifact.provenance.target, + artifact.provenance.profile, + artifact.provenance.recipe, + ), + required_features: artifact + .required_features + .iter() + .map(|feature| (*feature).to_string()) + .collect(), + imports: artifact + .imports + .iter() + .map(|import| DeclaredImport { + module: import.module.to_string(), + field: import.field.to_string(), + kind: ImportKind::Memory, + }) + .collect(), + exports: artifact + .function_exports + .iter() + .map(|export| DeclaredExport { + name: export.name.to_string(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: export.parameters.iter().copied().map(core_type).collect(), + result: export.result.map(core_type), + }), + }) + .chain(artifact.global_exports.iter().map(|name| DeclaredExport { + name: (*name).to_string(), + kind: ExportKind::Global, + signature: None, + })) + .collect(), + tables: artifact + .tables + .iter() + .map(|table| DeclaredTable { + element: table.element.to_string(), + minimum: table.minimum, + maximum: table.maximum, + }) + .collect(), + globals: artifact + .globals + .iter() + .map(|(mutable, initial)| DeclaredGlobal { + mutable: *mutable, + initial: *initial, + }) + .collect(), + storage: Some(StorageContract { + static_data: StorageRegion { + owner: artifact.id.to_string(), + start: artifact.storage.static_data.0, + end: artifact.storage.static_data.1, + }, + stack: StorageRegion { + owner: artifact.id.to_string(), + start: artifact.storage.stack.0, + end: artifact.storage.stack.1, + }, + heap_start: artifact.storage.heap_start, + minimum_pages: artifact.storage.minimum_pages, + stack_bound_bytes: artifact.storage.stack_bound_bytes, + stack_bound_evidence: artifact.storage.stack_bound_evidence.to_string(), + }), + initialization: InitializationContract { + start_forbidden: artifact.start_forbidden, + data_range: artifact.data_range, + }, + instantiate_after_shims: artifact.instantiate_after_shims, + } +} + +fn core_type(ty: RawType) -> CoreType { + match ty { + RawType::I32 => CoreType::I32, + RawType::I64 => CoreType::I64, + RawType::F32 => CoreType::F32, + RawType::F64 => CoreType::F64, + } +} diff --git a/crates/psrs-linker/src/target.rs b/crates/psrs-linker/src/target.rs new file mode 100644 index 00000000..ad740f98 --- /dev/null +++ b/crates/psrs-linker/src/target.rs @@ -0,0 +1,207 @@ +//! Linker-owned target records. +//! +//! The backend converts checked IR requirements into these records. They carry +//! no compiler IR nodes, language `TypeId`s, or MIR bodies, so plan and +//! composition tests can construct artifacts without compiling PureScript. + +/// A requirement identity assigned by the producer. The backend keeps the map +/// from this identity to a source symbol and span for diagnostics. +#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord, Hash)] +pub struct RequirementId(pub u32); + +/// The scalar subset of the core-Wasm value model a target signature uses. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum CoreType { + I32, + I64, + F32, + F64, +} + +/// A core-Wasm function signature. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct CoreSignature { + pub parameters: Vec, + pub result: Option, +} + +/// The boundary a requirement crosses. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum Boundary { + /// A private core-module import, closed inside the component. + RawCore { module: String, field: String }, + /// A WIT interface import resolved through the world. + ResolvedWit { interface: String, function: String }, +} + +/// The selected implementation for a requirement. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum Provider { + /// A compiler-generated local operation or helper; no import results. + Generated, + /// An export of a pinned core-Wasm artifact. + ArtifactExport { + artifact: String, + export: String, + signature: CoreSignature, + }, + /// A host interface retained in the component's external world. + HostInterface { interface: String }, +} + +/// One live executable requirement and its selected provider. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct BindingRequirement { + pub id: RequirementId, + /// A stable origin label for diagnostics, for example `numberToString` or + /// `wasi:cli/stdout.get-stdout`. + pub origin: String, + pub boundary: Boundary, + /// The expected raw core signature, when the requirement crosses a raw or + /// WIT boundary. `None` for a generated helper that never leaves the module. + pub expected: Option, + pub provider: Provider, +} + +/// Whether an artifact is a core module or a component. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum ArtifactKind { + CoreModule, +} + +/// The kind of a declared artifact import. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum ImportKind { + Memory, + Function, +} + +/// An import the artifact's contract declares. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DeclaredImport { + pub module: String, + pub field: String, + pub kind: ImportKind, +} + +/// An export the artifact's contract declares. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DeclaredExport { + pub name: String, + pub kind: ExportKind, + /// The function signature when `kind` is `Func`. + pub signature: Option, +} + +/// The kind of a declared export. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum ExportKind { + Func, + Global, +} + +/// A table the artifact's contract declares. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DeclaredTable { + pub element: String, + pub minimum: u32, + pub maximum: Option, +} + +/// A global the artifact's contract declares. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DeclaredGlobal { + pub mutable: bool, + /// The constant `i32` initial value. + pub initial: u32, +} + +/// A declared private execution-storage region. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct StorageRegion { + pub owner: String, + pub start: u32, + pub end: u32, +} + +/// An artifact's private execution storage and allocator boundary. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct StorageContract { + pub static_data: StorageRegion, + pub stack: StorageRegion, + pub heap_start: u32, + pub minimum_pages: u64, + /// A reviewed upper bound on stack bytes for the supported calling pattern. + pub stack_bound_bytes: u32, + /// Where the stack bound comes from; a reviewed build assumption names its + /// pending stress evidence rather than claiming analysis that did not run. + pub stack_bound_evidence: String, +} + +/// Constraints on an artifact's initialization. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct InitializationContract { + pub start_forbidden: bool, + /// Every active data segment must lie in this half-open range. + pub data_range: (u32, u32), +} + +/// The declared contract an executable artifact must satisfy. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ArtifactContract { + pub id: String, + pub kind: ArtifactKind, + /// The private core-module import identity the artifact uses. + pub module_name: String, + /// SHA-256 of the artifact bytes. + pub sha256: String, + /// Human-readable pinned provenance (dependency, toolchain, recipe). + pub provenance: String, + pub required_features: Vec, + pub imports: Vec, + pub exports: Vec, + pub tables: Vec, + pub globals: Vec, + pub storage: Option, + pub initialization: InitializationContract, + /// Whether the artifact must be instantiated after the call shims. + pub instantiate_after_shims: bool, +} + +/// A pinned artifact and the contract it must satisfy. +#[derive(Clone, Debug)] +pub struct ArtifactReference { + pub contract: ArtifactContract, + pub bytes: Vec, +} + +/// The target policy the backend converts from its capability profile. +#[derive(Clone, Debug, Default, PartialEq, Eq)] +pub struct TargetPolicy { + /// Canonical ids of the host interfaces the selected target profile permits. + /// The backend derives these from the resolved world and the capability + /// families, so the linker never parses backend capability types. + pub permitted_host_interfaces: Vec, +} + +/// The canonical ABI memory layout demanded by the application. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct MemoryDemand { + /// The reserved canonical scratch region `[start, end)`. + pub canonical_scratch: (u32, u32), + /// The allocator-state region `[start, end)`. + pub allocator_state: (u32, u32), + /// The application's allocator start before any artifact reservation. + pub base_heap_start: u32, + /// The allocator block granularity the heap start must satisfy. + pub heap_alignment: u32, +} + +/// The complete checked input to [`crate::plan::plan`]. +#[derive(Clone, Debug)] +pub struct TargetLinkInput { + pub requirements: Vec, + pub artifacts: Vec, + pub policy: TargetPolicy, + pub memory: MemoryDemand, +} diff --git a/crates/psrs-linker/src/verify/mod.rs b/crates/psrs-linker/src/verify/mod.rs new file mode 100644 index 00000000..63576b2c --- /dev/null +++ b/crates/psrs-linker/src/verify/mod.rs @@ -0,0 +1,86 @@ +//! Artifact contract validation over the actual bytes. +//! +//! The contract declares what a pinned artifact must contain. Verification +//! parses the real module and rejects any stale digest, unexplained export, +//! import, table, global, feature, data range, or initialization path. + +use crate::error::{LinkErrors, LinkStage}; +use crate::target::{ArtifactContract, ArtifactKind}; +use wasmparser::WasmFeatures; + +mod parse; +#[cfg(test)] +mod tests; + +use parse::{check_contract, parse_core_module}; + +/// A verified core artifact ready for planning and composition. +#[derive(Clone, Debug)] +pub struct VerifiedArtifact { + pub id: String, + pub module_name: String, + pub sha256: String, + pub bytes: Vec, + pub instantiate_after_shims: bool, +} + +/// Validates `bytes` against `contract`, returning the verified artifact. +pub fn verify_artifact( + contract: &ArtifactContract, + bytes: &[u8], +) -> Result { + let stage = LinkStage::Verify; + let id = &contract.id; + if contract.kind != ArtifactKind::CoreModule { + return Err(LinkErrors::one( + stage, + id, + "only core-module artifacts are supported", + )); + } + let digest = crate::sha256_hex(bytes); + if digest != contract.sha256 { + return Err(LinkErrors::one( + stage, + id, + format!( + "artifact digest mismatch: declared {}, actual {digest}", + contract.sha256 + ), + )); + } + let parsed = parse_core_module(bytes).map_err(|message| LinkErrors::one(stage, id, message))?; + let features = wasm_features(&contract.required_features) + .map_err(|message| LinkErrors::one(stage, id, message))?; + wasmparser::Validator::new_with_features(features) + .validate_all(bytes) + .map_err(|error| { + LinkErrors::one(stage, id, format!("artifact is not valid Wasm: {error}")) + })?; + check_contract(contract, &parsed)?; + Ok(VerifiedArtifact { + id: contract.id.clone(), + module_name: contract.module_name.clone(), + sha256: digest, + bytes: bytes.to_vec(), + instantiate_after_shims: contract.instantiate_after_shims, + }) +} + +fn wasm_features(names: &[String]) -> Result { + let mut features = WasmFeatures::MVP; + for name in names { + features |= match name.as_str() { + "mutable-globals" => WasmFeatures::MUTABLE_GLOBAL, + "sign-extension" => WasmFeatures::SIGN_EXTENSION, + "saturating-float-to-int" => WasmFeatures::SATURATING_FLOAT_TO_INT, + "multi-value" => WasmFeatures::MULTI_VALUE, + "bulk-memory" => WasmFeatures::BULK_MEMORY, + "reference-types" => WasmFeatures::REFERENCE_TYPES, + "function-references" => WasmFeatures::FUNCTION_REFERENCES, + "gc" => WasmFeatures::GC, + other => return Err(format!("unknown required Wasm feature `{other}`")), + }; + } + Ok(features) +} diff --git a/crates/psrs-linker/src/verify/parse.rs b/crates/psrs-linker/src/verify/parse.rs new file mode 100644 index 00000000..59b179fb --- /dev/null +++ b/crates/psrs-linker/src/verify/parse.rs @@ -0,0 +1,367 @@ +//! Parsing a core module and comparing it with a declared contract. + +use crate::error::{LinkErrors, LinkStage}; +use crate::target::{ + ArtifactContract, CoreSignature, CoreType, DeclaredExport, ExportKind, ImportKind, +}; +use wasmparser::{CompositeInnerType, ExternalKind, Operator, Parser, Payload, TypeRef, ValType}; + +pub(super) fn check_contract( + contract: &ArtifactContract, + parsed: &ParsedCore, +) -> Result<(), LinkErrors> { + let stage = LinkStage::Verify; + let id = &contract.id; + + if parsed.imports.len() != contract.imports.len() + || parsed + .imports + .iter() + .zip(&contract.imports) + .any(|(a, b)| a.module != b.module || a.field != b.field || a.kind != b.kind) + { + return Err(LinkErrors::one( + stage, + id, + "artifact imports do not match the declared contract", + )); + } + + let mut declared_exports: Vec<&DeclaredExport> = contract.exports.iter().collect(); + for export in &parsed.exports { + let Some(index) = declared_exports + .iter() + .position(|declared| declared.name == export.name && declared.kind == export.kind) + else { + return Err(LinkErrors::one( + stage, + id, + format!("artifact has an undeclared export `{}`", export.name), + )); + }; + let declared = declared_exports.swap_remove(index); + if declared.kind == ExportKind::Func && declared.signature != export.signature { + return Err(LinkErrors::one( + stage, + id, + format!("export `{}` has an unexpected signature", export.name), + )); + } + } + if let Some(missing) = declared_exports.first() { + return Err(LinkErrors::one( + stage, + id, + format!("artifact is missing declared export `{}`", missing.name), + )); + } + + if tables_differ(parsed, contract) { + return Err(LinkErrors::one( + stage, + id, + "artifact tables do not match the declared contract", + )); + } + if globals_differ(parsed, contract) { + return Err(LinkErrors::one( + stage, + id, + "artifact globals do not match the declared contract", + )); + } + if parsed.has_elements { + return Err(LinkErrors::one( + stage, + id, + "artifact element segments are not declared", + )); + } + for (start, length) in &parsed.data_ranges { + let end = start + .checked_add(*length) + .ok_or_else(|| LinkErrors::one(stage, id, "artifact data range overflows"))?; + let (low, high) = contract.initialization.data_range; + if *start < low || end > high { + return Err(LinkErrors::one( + stage, + id, + "artifact data outside its declared initialization range", + )); + } + } + if contract.initialization.start_forbidden && parsed.has_start { + return Err(LinkErrors::one( + stage, + id, + "artifact defines a start function, which its contract forbids", + )); + } + Ok(()) +} + +#[derive(Debug)] +struct ParsedImport { + module: String, + field: String, + kind: ImportKind, +} + +struct ParsedExport { + name: String, + kind: ExportKind, + signature: Option, +} + +struct ParsedTable { + element: String, + minimum: u32, + maximum: Option, +} + +struct ParsedGlobal { + mutable: bool, + initial: u32, +} + +pub(super) struct ParsedCore { + imports: Vec, + exports: Vec, + tables: Vec, + globals: Vec, + data_ranges: Vec<(u32, u32)>, + has_start: bool, + has_elements: bool, +} + +impl ParsedTable { + fn matches(&self, declared: &crate::target::DeclaredTable) -> bool { + self.element == declared.element + && self.minimum == declared.minimum + && self.maximum == declared.maximum + } +} + +fn tables_differ(parsed: &ParsedCore, contract: &ArtifactContract) -> bool { + parsed.tables.len() != contract.tables.len() + || parsed + .tables + .iter() + .zip(&contract.tables) + .any(|(a, b)| !a.matches(b)) +} + +fn globals_differ(parsed: &ParsedCore, contract: &ArtifactContract) -> bool { + parsed.globals.len() != contract.globals.len() + || parsed + .globals + .iter() + .zip(&contract.globals) + .any(|(a, b)| a.mutable != b.mutable || a.initial != b.initial) +} + +pub(super) fn parse_core_module(bytes: &[u8]) -> Result { + let mut types = Vec::new(); + let mut imported_functions = Vec::new(); + let mut defined_functions = Vec::new(); + let mut imports = Vec::new(); + let mut exports = Vec::new(); + let mut tables = Vec::new(); + let mut globals = Vec::new(); + let mut data_ranges = Vec::new(); + let mut memories = 0_u32; + let mut has_start = false; + let mut has_elements = false; + + for payload in Parser::new(0).parse_all(bytes) { + match payload.map_err(|error| error.to_string())? { + Payload::TypeSection(reader) => { + for group in reader { + for ty in group.map_err(|error| error.to_string())?.into_types() { + if let CompositeInnerType::Func(func) = ty.composite_type.inner { + types.push(func); + } else { + return Err("artifact defines a non-function composite type".into()); + } + } + } + } + Payload::ImportSection(reader) => { + for import in reader.into_imports() { + let import = import.map_err(|error| error.to_string())?; + match import.ty { + TypeRef::Memory(memory) => { + if memory.memory64 || memory.shared { + return Err("artifact imports an unsupported memory".into()); + } + imports.push(ParsedImport { + module: import.module.to_string(), + field: import.name.to_string(), + kind: ImportKind::Memory, + }); + } + TypeRef::Func(index) => { + imported_functions.push(index); + imports.push(ParsedImport { + module: import.module.to_string(), + field: import.name.to_string(), + kind: ImportKind::Function, + }); + } + _ => return Err("artifact imports an unsupported item".into()), + } + } + } + Payload::FunctionSection(reader) => { + for ty in reader { + defined_functions.push(ty.map_err(|error| error.to_string())?); + } + } + Payload::TableSection(reader) => { + for table in reader { + let table = table.map_err(|error| error.to_string())?; + let element = if table.ty.element_type == wasmparser::RefType::FUNCREF { + "funcref" + } else if table.ty.element_type == wasmparser::RefType::EXTERNREF { + "externref" + } else { + return Err("artifact defines an unsupported table element type".into()); + }; + tables.push(ParsedTable { + element: element.into(), + minimum: table.ty.initial as u32, + maximum: table.ty.maximum.map(|value| value as u32), + }); + } + } + Payload::GlobalSection(reader) => { + for global in reader { + let global = global.map_err(|error| error.to_string())?; + if global.ty.content_type != ValType::I32 || global.ty.shared { + return Err("artifact defines an unsupported global".into()); + } + let initial = constant_i32(&global.init_expr)?; + globals.push(ParsedGlobal { + mutable: global.ty.mutable, + initial, + }); + } + } + Payload::ExportSection(reader) => { + for export in reader { + let export = export.map_err(|error| error.to_string())?; + match export.kind { + ExternalKind::Func => { + let signature = function_signature( + export.index, + &imported_functions, + &defined_functions, + &types, + )?; + exports.push(ParsedExport { + name: export.name.to_string(), + kind: ExportKind::Func, + signature: Some(signature), + }); + } + ExternalKind::Global => exports.push(ParsedExport { + name: export.name.to_string(), + kind: ExportKind::Global, + signature: None, + }), + _ => { + return Err(format!( + "artifact export `{}` has an undeclared kind", + export.name + )); + } + } + } + } + Payload::DataSection(reader) => { + for data in reader { + let data = data.map_err(|error| error.to_string())?; + let wasmparser::DataKind::Active { + memory_index: 0, + offset_expr, + } = data.kind + else { + return Err("artifact has unsupported or passive data storage".into()); + }; + let offset = constant_i32(&offset_expr)?; + data_ranges.push((offset, data.data.len() as u32)); + } + } + Payload::MemorySection(_) => memories += 1, + Payload::StartSection { .. } => has_start = true, + Payload::ElementSection(_) => has_elements = true, + _ => {} + } + } + if memories > 0 { + return Err("artifact defines its own memory instead of importing one".into()); + } + if !imported_functions.is_empty() { + return Err("artifact function imports are not supported".into()); + } + Ok(ParsedCore { + imports, + exports, + tables, + globals, + data_ranges, + has_start, + has_elements, + }) +} + +fn constant_i32(expr: &wasmparser::ConstExpr<'_>) -> Result { + let mut ops = expr.get_operators_reader(); + let value = match ops.read().map_err(|error| error.to_string())? { + Operator::I32Const { value } => value as u32, + _ => return Err("artifact constant is not an i32".into()), + }; + if !matches!( + ops.read().map_err(|error| error.to_string())?, + Operator::End + ) { + return Err("artifact constant has extra operators".into()); + } + Ok(value) +} + +fn function_signature( + index: u32, + imported_functions: &[u32], + defined_functions: &[u32], + types: &[wasmparser::FuncType], +) -> Result { + let type_index = if (index as usize) < imported_functions.len() { + imported_functions[index as usize] + } else { + let defined = index as usize - imported_functions.len(); + *defined_functions + .get(defined) + .ok_or("artifact export refers to an unknown function")? + }; + let ty = types + .get(type_index as usize) + .ok_or("artifact function has no type")?; + let convert = |ty: ValType| match ty { + ValType::I32 => Some(CoreType::I32), + ValType::I64 => Some(CoreType::I64), + ValType::F32 => Some(CoreType::F32), + ValType::F64 => Some(CoreType::F64), + _ => None, + }; + let mut parameters = Vec::with_capacity(ty.params().len()); + for param in ty.params() { + parameters.push(convert(*param).ok_or("artifact parameter is not a scalar")?); + } + let result = match ty.results() { + [] => None, + [single] => Some(convert(*single).ok_or("artifact result is not a scalar")?), + _ => return Err("artifact function has multiple results".into()), + }; + Ok(CoreSignature { parameters, result }) +} diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs new file mode 100644 index 00000000..70412058 --- /dev/null +++ b/crates/psrs-linker/src/verify/tests.rs @@ -0,0 +1,119 @@ +//! Contract-verification tests. + +use super::*; +use crate::target::{ + ArtifactContract, ArtifactKind, CoreSignature, CoreType, DeclaredExport, DeclaredGlobal, + DeclaredImport, DeclaredTable, ExportKind, ImportKind, InitializationContract, StorageContract, + StorageRegion, +}; + +fn number_format_contract() -> ArtifactContract { + ArtifactContract { + id: "psrs:runtime-number-format".into(), + kind: ArtifactKind::CoreModule, + module_name: psrs_runtime::MODULE_NAME.into(), + sha256: psrs_runtime::NUMBER_FORMATTER.provenance.sha256.into(), + provenance: "test".into(), + required_features: [ + "mutable-globals", + "sign-extension", + "bulk-memory", + "reference-types", + ] + .into_iter() + .map(str::to_string) + .collect(), + imports: vec![DeclaredImport { + module: psrs_runtime::MEMORY_MODULE.into(), + field: psrs_runtime::MEMORY_FIELD.into(), + kind: ImportKind::Memory, + }], + exports: vec![ + DeclaredExport { + name: psrs_runtime::NUMBER_FORMAT.export.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + }), + }, + DeclaredExport { + name: psrs_runtime::HEAP_BASE_EXPORT.into(), + kind: ExportKind::Global, + signature: None, + }, + ], + tables: vec![DeclaredTable { + element: "funcref".into(), + minimum: 1, + maximum: Some(1), + }], + globals: vec![ + DeclaredGlobal { + mutable: true, + initial: psrs_runtime::HEAP_START, + }, + DeclaredGlobal { + mutable: false, + initial: psrs_runtime::HEAP_START, + }, + ], + storage: Some(StorageContract { + static_data: StorageRegion { + owner: "number-format".into(), + start: psrs_runtime::RESERVED_START, + end: psrs_runtime::STACK_BOTTOM, + }, + stack: StorageRegion { + owner: "number-format".into(), + start: psrs_runtime::STACK_BOTTOM, + end: psrs_runtime::HEAP_START, + }, + heap_start: psrs_runtime::HEAP_START, + minimum_pages: 3, + stack_bound_bytes: 4096, + stack_bound_evidence: "reviewed pinned build assumption; stress evidence pending" + .into(), + }), + initialization: InitializationContract { + start_forbidden: true, + data_range: (psrs_runtime::RESERVED_START, psrs_runtime::STACK_BOTTOM), + }, + instantiate_after_shims: true, + } +} + +#[test] +fn embedded_artifact_satisfies_its_contract() { + let contract = number_format_contract(); + verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + .expect("the pinned artifact should verify"); +} + +#[test] +fn a_stale_digest_is_rejected() { + let mut contract = number_format_contract(); + contract.sha256 = "0".repeat(64); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); +} + +#[test] +fn an_undeclared_export_is_rejected() { + let mut contract = number_format_contract(); + contract.exports.remove(1); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); +} + +#[test] +fn an_undeclared_import_is_rejected() { + let mut contract = number_format_contract(); + contract.imports.clear(); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); +} + +#[test] +fn an_overlapping_data_range_is_rejected() { + let mut contract = number_format_contract(); + contract.initialization.data_range = (0, 16); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); +} diff --git a/crates/psrs-linker/tests/compose.rs b/crates/psrs-linker/tests/compose.rs new file mode 100644 index 00000000..15ba7a57 --- /dev/null +++ b/crates/psrs-linker/tests/compose.rs @@ -0,0 +1,129 @@ +//! Target-only composition tests: the core module is built with `wasm-encoder` +//! and no compiler IR participates. + +use psrs_linker::{ + ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, MemoryDemand, + Provider, RequirementId, TargetLinkInput, TargetPolicy, plan, resolve_default_definitions, +}; +use wasm_encoder::{ + CodeSection, EntityType, ExportKind, ExportSection, Function, FunctionSection, ImportSection, + Instruction, MemorySection, MemoryType, Module, TypeSection, ValType, +}; + +fn core_module() -> Vec { + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], [ValType::I32]); + types + .ty() + .function([ValType::F64, ValType::I32, ValType::I32], [ValType::I32]); + module.section(&types); + let mut imports = ImportSection::new(); + imports.import( + psrs_runtime::MODULE_NAME, + psrs_runtime::NUMBER_EXPORT, + EntityType::Function(1), + ); + module.section(&imports); + let mut functions = FunctionSection::new(); + functions.function(0); + module.section(&functions); + let mut memories = MemorySection::new(); + memories.memory(MemoryType { + minimum: 4, + maximum: None, + memory64: false, + shared: false, + page_size_log2: None, + }); + module.section(&memories); + let mut exports = ExportSection::new(); + exports.export("memory", ExportKind::Memory, 0); + exports.export("wasi:cli/run@0.2.12#run", ExportKind::Func, 1); + module.section(&exports); + let mut code = CodeSection::new(); + let mut body = Function::new([]); + body.instruction(&Instruction::I32Const(0)); + body.instruction(&Instruction::End); + code.function(&body); + module.section(&code); + module.finish() +} + +fn input() -> TargetLinkInput { + TargetLinkInput { + requirements: vec![BindingRequirement { + id: RequirementId(0), + origin: "NumberToString".into(), + boundary: Boundary::RawCore { + module: psrs_runtime::MODULE_NAME.into(), + field: psrs_runtime::NUMBER_EXPORT.into(), + }, + expected: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + }), + provider: Provider::ArtifactExport { + artifact: psrs_runtime::NUMBER_FORMATTER.id.into(), + export: psrs_runtime::NUMBER_EXPORT.into(), + signature: CoreSignature { + parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + }, + }, + }], + artifacts: vec![ArtifactReference { + contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_FORMATTER), + bytes: psrs_runtime::NUMBER_FORMATTER.bytes.to_vec(), + }], + policy: TargetPolicy::default(), + memory: MemoryDemand { + canonical_scratch: (0, 16), + allocator_state: (16, 24), + base_heap_start: 24, + heap_alignment: 8, + }, + } +} + +#[test] +fn composition_attaches_the_library_and_closes_the_private_import() { + let context = resolve_default_definitions().unwrap(); + let link = plan(&context, input()).expect("the plan should be valid"); + let core = core_module(); + let composed = + psrs_linker::compose(&context, &link, &core).expect("composition should succeed"); + wasmparser::Validator::new() + .validate_all(&composed.bytes) + .expect("the composed component should validate"); + assert!( + !composed + .external_world + .iter() + .any(|id| id == psrs_runtime::MODULE_NAME), + "the private runtime import must be closed: {:?}", + composed.external_world + ); +} + +#[test] +fn composition_without_the_artifact_fails_closed() { + let context = resolve_default_definitions().unwrap(); + // A plan with no provider cannot close the core module's runtime import. + let link = plan( + &context, + TargetLinkInput { + requirements: Vec::new(), + artifacts: Vec::new(), + policy: TargetPolicy::default(), + memory: MemoryDemand { + canonical_scratch: (0, 16), + allocator_state: (16, 24), + base_heap_start: 24, + heap_alignment: 8, + }, + }, + ) + .unwrap(); + assert!(psrs_linker::compose(&context, &link, &core_module()).is_err()); +} diff --git a/crates/psrs-linker/tests/plan.rs b/crates/psrs-linker/tests/plan.rs new file mode 100644 index 00000000..dea0be60 --- /dev/null +++ b/crates/psrs-linker/tests/plan.rs @@ -0,0 +1,246 @@ +//! Target-only linker tests: no compiler IR is constructed. + +use psrs_linker::{ + ArtifactContract, ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, + MemoryDemand, Provider, RequirementId, TargetLinkInput, TargetPolicy, plan, + resolve_default_definitions, +}; + +fn memory() -> MemoryDemand { + MemoryDemand { + canonical_scratch: (0, 16), + allocator_state: (16, 24), + base_heap_start: 24, + heap_alignment: 8, + } +} + +fn input( + requirements: Vec, + artifacts: Vec, +) -> TargetLinkInput { + let permitted = resolve_default_definitions() + .map(|context| context.world_imports().to_vec()) + .unwrap_or_default(); + TargetLinkInput { + requirements, + artifacts, + policy: TargetPolicy { + permitted_host_interfaces: permitted, + }, + memory: memory(), + } +} + +fn formatter_artifact() -> ArtifactReference { + ArtifactReference { + contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_FORMATTER), + bytes: psrs_runtime::NUMBER_FORMATTER.bytes.to_vec(), + } +} + +fn formatter_requirement() -> BindingRequirement { + BindingRequirement { + id: RequirementId(0), + origin: "NumberToString".into(), + boundary: Boundary::RawCore { + module: psrs_runtime::MODULE_NAME.into(), + field: psrs_runtime::NUMBER_EXPORT.into(), + }, + expected: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + }), + provider: Provider::ArtifactExport { + artifact: psrs_runtime::NUMBER_FORMATTER.id.into(), + export: psrs_runtime::NUMBER_EXPORT.into(), + signature: CoreSignature { + parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + }, + }, + } +} + +fn stdout_requirement(id: u32) -> BindingRequirement { + BindingRequirement { + id: RequirementId(id), + origin: "wasi:cli/stdout.get-stdout".into(), + boundary: Boundary::ResolvedWit { + interface: "wasi:cli/stdout@0.2.12".into(), + function: "get-stdout".into(), + }, + expected: Some(CoreSignature { + parameters: Vec::new(), + result: Some(CoreType::I32), + }), + provider: Provider::HostInterface { + interface: "wasi:cli/stdout@0.2.12".into(), + }, + } +} + +#[test] +fn a_live_formatter_requirement_reserves_storage_and_closes_the_private_import() { + let context = resolve_default_definitions().unwrap(); + let link = plan( + &context, + input( + vec![formatter_requirement(), stdout_requirement(1)], + vec![formatter_artifact()], + ), + ) + .expect("the formatter plan should be valid"); + + assert_eq!(link.artifacts().len(), 1); + assert_eq!(link.memory().heap_start, psrs_runtime::HEAP_START); + assert!(link.memory().minimum_pages >= 4); + assert_eq!( + link.import(RequirementId(0)).unwrap().module, + psrs_runtime::MODULE_NAME + ); + // The external world is the transitive closure of the used host interface. + assert!( + link.external_world() + .iter() + .any(|id| id == "wasi:cli/stdout@0.2.12") + ); + assert!( + link.external_world() + .iter() + .any(|id| id == "wasi:io/streams@0.2.12") + ); + assert!( + !link + .external_world() + .iter() + .any(|id| id == psrs_runtime::MODULE_NAME) + ); + assert_eq!(link.digests().len(), 1); + assert_eq!( + link.digests()[0], + psrs_runtime::NUMBER_FORMATTER.provenance.sha256 + ); +} + +#[test] +fn an_unused_implementation_contributes_neither_bytes_nor_storage() { + let context = resolve_default_definitions().unwrap(); + let link = plan(&context, input(Vec::new(), Vec::new())).expect("an empty plan is valid"); + assert!(link.artifacts().is_empty()); + assert!(link.memory().heap_start < psrs_runtime::HEAP_START); +} + +#[test] +fn a_missing_artifact_provider_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let result = plan(&context, input(vec![formatter_requirement()], Vec::new())); + assert!(result.is_err(), "an absent artifact must not resolve"); +} + +#[test] +fn a_host_interface_outside_the_world_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let requirement = BindingRequirement { + id: RequirementId(0), + origin: "wasi:http/outgoing-handler.handle".into(), + boundary: Boundary::ResolvedWit { + interface: "wasi:http/outgoing-handler@0.2.12".into(), + function: "handle".into(), + }, + expected: Some(CoreSignature { + parameters: Vec::new(), + result: Some(CoreType::I32), + }), + provider: Provider::HostInterface { + interface: "wasi:http/outgoing-handler@0.2.12".into(), + }, + }; + assert!( + plan(&context, input(vec![requirement], Vec::new())).is_err(), + "a definition outside the world must not satisfy a live import" + ); +} + +#[test] +fn a_world_interface_disabled_by_the_target_profile_is_rejected() { + let context = resolve_default_definitions().unwrap(); + // `wasi:cli/stdout` is in the world but not in this restricted policy. + let result = plan( + &context, + TargetLinkInput { + requirements: vec![stdout_requirement(0)], + artifacts: Vec::new(), + policy: TargetPolicy { + permitted_host_interfaces: vec!["wasi:io/streams@0.2.12".into()], + }, + memory: memory(), + }, + ); + assert!( + result.is_err(), + "the target capability profile must gate a world interface" + ); +} + +#[test] +fn a_reservation_overlapping_canonical_state_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let mut artifact = formatter_artifact(); + let storage = artifact.contract.storage.as_mut().unwrap(); + storage.static_data.start = 16; + let result = plan( + &context, + input(vec![formatter_requirement()], vec![artifact]), + ); + assert!(result.is_err(), "overlapping reservations must be rejected"); +} + +#[test] +fn conflicting_providers_for_one_import_identity_are_rejected() { + let context = resolve_default_definitions().unwrap(); + let mut other = formatter_requirement(); + other.id = RequirementId(1); + other.origin = "NumberToStringAgain".into(); + other.provider = Provider::ArtifactExport { + artifact: psrs_runtime::NUMBER_FORMATTER.id.into(), + export: psrs_runtime::NUMBER_EXPORT.into(), + signature: CoreSignature { + // A deliberately different signature for the same import identity. + parameters: vec![CoreType::F64, CoreType::I32], + result: Some(CoreType::I32), + }, + }; + assert!( + plan( + &context, + input( + vec![formatter_requirement(), other], + vec![formatter_artifact()] + ) + ) + .is_err(), + "two signatures for one import identity must be rejected" + ); +} + +/// A definition-only contract is not an executable provider; verification of a +/// mismatched contract must fail before any plan is published. +#[test] +fn a_definition_contract_does_not_satisfy_execution() { + let mut contract: ArtifactContract = + psrs_linker::runtime::contract(&psrs_runtime::NUMBER_FORMATTER); + contract.exports.clear(); + let artifact = ArtifactReference { + contract, + bytes: psrs_runtime::NUMBER_FORMATTER.bytes.to_vec(), + }; + let context = resolve_default_definitions().unwrap(); + assert!( + plan( + &context, + input(vec![formatter_requirement()], vec![artifact]) + ) + .is_err() + ); +} diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml new file mode 100644 index 00000000..7992defe --- /dev/null +++ b/crates/psrs-runtime/Cargo.toml @@ -0,0 +1,25 @@ +[package] +name = "psrs-runtime" +version.workspace = true +edition.workspace = true +license.workspace = true + +[lib] +crate-type = ["cdylib", "rlib"] + +[features] +default = ["catalog", "formatter"] +# Immutable host-consumed catalog data: WIT sources, world identity, artifact +# bytes and provenance. Compiles no executable target code. +catalog = [] +# The executable formatter export. The Wasm artifact build enables only this +# feature; the default native build enables both. +formatter = ["dep:ryu-js"] + +[dependencies] +ryu-js = { version = "=1.0.2", default-features = false, optional = true } + +[dev-dependencies] +wasm-encoder = { workspace = true, features = ["wasmparser"] } +wasmprinter.workspace = true +wasmparser.workspace = true diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm new file mode 100755 index 0000000000000000000000000000000000000000..e8c226fc846a3d8f47fc8f3b92fe9d5c234df9a1 GIT binary patch literal 14239 zcmb7o2Rzkp^#5JvHSXqKF4v7hWY1DADtnJ4GqU%Vy+@%U3E3knLW(3B2pN@`ksT6A zQsMu(`i{Q8*YEXzy?!6BkLUBe&w0){&pGEg&jDoZ?Ft5gKwt`^6*vrJ1q}`h1BY4B zhK5leaHtg|3_u~lR1o;2{tl(G0Ys1$O;{-KfUID^7zTo{f}wV9ezdN3uI^re5D*l~ z1P6g3P#6s@9UVObj0Wrh27_r?Az@%jcsLV040JHiks$~-UsoGDFH0YHOK%@9M>l&A z7;b6lU}x=NX=Cke2L&_Eu)(1q5IhJ14uyn46iE;Yw-z%9q6mC~TF6i(aI8}J@5jTC z8AO3n7%224s1nG44C5eyNFWq#sh&`bQR1(9ee2qzL)016`0DFG^! zAhBfNS2USk34~w(sMDYWGCi3AApZrDXa%6`WP0jg6-;KNjt(S761`znFtDe6kSFCS z$eRpCFp{8D8b}68)g$UeI#5BPp@ex?2LGdB9nkQHa0562mCFcDiua$ zApMrw53K%e`EPr}!M~+}{<8lmKnJ+bkpU9~pyA+PG9C3J9!#Pmfv5&k1pO=-q0*37GLp=}FKz@rnnE$H~SPsZ!psoc|!kmC_Q7?HA2*?Ji3}E^P>n<}K44ew; z3#2hM7Z1L{VL)CWoXHTX3#j=h8DC1-XZ7TPQBC`wKR{yc|98qNo1P|7M`PC&N8 zoB?b4N?w7e);Lji|Nqu7QgAxdQUDl26JAQW>_P#Npry`dfie)r0|W97NG>NH7(njL ztXt>-Ud>P-LiGoqJ(&_fy?_Jff>DQ=nm2$PdR@TzP~arrUCm=0uA0UM=eA6*sT z4-z!^|0Du10yr>0z?p$WU;z9C40H#%&7?F33I~og&B4fG3~+&fEz$6>keGmo!+D@o zrSJnPw3Lz^=0bv(I#I+lc<3k)9@xRIlo-RwG$a=406)hJ`ol3~CICFhp92;+`8N}w z1rB(U;^#tQ0))W;VZfZkqDP_wvhcTg%y7V5hCdAjL{Kvk82&aBFpX+0bu)lc8Xyyx zNi1X}A%0Afhv?mV(>2E_0OkgQ>0#YAJ75s;M`0umNd>RPZ zZ>4{Ur8&p|s%HS5ETufG|C<6RaB`^f4iwNFC}087{P*?&-@^YA#_D{A8N>vE11{zP zvKP>=N6lttPYT%ElLDjA0Cs_+bUA>+$Up&mQpbZ`P-xC@Pawl5EKd$aO^=6QsK;!<$JSWDvbCOUW%%n#8FY!KhV}!o6&_3 zD$4Q)nwwU9l}H7d{{Z{OpM5>xWcmZ_xR=LAWrY8M-B@`KrDBYKU_j-iLJWUEl`}9Z zME@_;8m&M@=>A1=uhLQx+JBLh*B~lF^DnYUM+IR20<#Ak&;x)1lwrWj48|N(M*@BZ zj`Y8E6>vL9m0Cq9I8~sI0%MpHnSp|(mMI`SP83=-pbFAaz-NJi1t!rt0fliMBo6|p z)C?DO0;&~I0|5#J;zfozA%Fq}q#L!A{pKgpIU%T}nT`b02J|pc^9{HMfeX@!B1&TT z1wW`EwA3{R2?9t0s6gQ%Qx_hnqz0Z^=BbK+EO8>is9gsfn8BPV#{dI>1Uq0PGgE5b zgMgcm0s%_l?`7074lJZVsjmhH^=>;5#SGk)fB~=r1E{6~S2S>o|5i(_34ddN9e`Z$ z-^P%E+dvourfwTXRSqUG|K$*>7l5Jx$p705K=}tc9pGl8gNK2^VL)*grW^&XRgfwN zupZbH^^WECB}2SP5NF_Gp9KN7Qeg@M)o3vAL3J>2ty8a5UQRmr@c00fi$0-vO+EN5EbHKo5c+2V4v^6C`Ic6mU5Z zK4}O77(mhxCK8kaJ`UytW)NuzJ1{^gOit1e3@~Dx5I`=ufoXw#0>^~fU9bYZ1quB3 zCv7Ouy+M^o@zmxpluQd;!C>l)Av72$f}~iWS)_J_K%+`x2nC3=hE)Ix)KpS@bTCl3 z=%@`Jj06s)Y7Y$#mVwg4wZT9KL=6NK=vqC2C_t$VHUuc@Q0J;xAc)W^GAurt2f#?M z_}^_A1OVfCz)C=ucF=AARtlktgI_ZSQ~xA@!Q+jsy}j+cd>q}~NSCY~UF>Y-Nf)g> ztS>tH1d>iFkS=;z``F3LYa3}Poz}Nhrsz_X)eKD!P;U_rZ!d3QFJCtwM^`%$Z?B6Y zm)yNvt$lp#ypDN!gMdd81P1W}BOG{XfLG1!lA{|SS@`b{ZEI~&QBg5baZw3TNl__L zX;B$bSy4GLQ86(waWM%oNiiugX)zfwSur_rQE@SGad8Q8NpUH0X>l2GS#dcDQ3){# zaR~_tNeL+lX$ct#SqV8wQAsgLaY+eDNl7V5X-OGLSxGr5Q7JJgaVZHYNhv8QX(<^g zSt&VbQE4%0acK!@Nogr*X=xd0S!p>LQ5i8AaTy62Nf{{_X&D(ASs6K5QCTrraajpj zNm(gbX;~RrSy?$bz(hGfy&ND~4p=4!K*09?e1IhR&x85T3SpL3FB9_r8elAr2-_zThqfATBNXN&&HpUU<8G47A` zl83jPIscu9Ps;>8L;gF@8;LQI{DZ$!+upT}<6pYMHLJOE|MDwdX$T3$3I@llQTW}7k^%tK5q?u{O7BG z#SiwR4(CSG(D3lDc*Im$Wp|w+&zAg-pW?zu05o`HIjjG7{FYMUjz(&Acv&m`=AZF) zd@w@_?At*d@Q07}Lv1-6O_U$99q^~d+eC8J=Hmq4ygrCWz2HysC8B!v*SN@o_*ri~ zs%R~`@N7fiA~k+_7vv1Pw-@jPnIGm<{?59y0#6#O@}{2$Y*FLUl$Tj2JR8u-{%zH+OPSU zwxKUrIFO3>R8#UO6P}DucPIP?t+9x4LLL2eLl$PykaW!1Cc<*(y8G$zul)2U-6mXI z>Jhv@SG#d2af!sgivwl?+c_FBlknK_IOXRjAZrpg17`R%U zYJDlr(F@&b`$^XAQ%337*PT-zp*rlJTlhP=mO}K9Uf)w@pWARX_yux?)~*ezpZzJv z(!7hZd7Duiq0gI z!|8UfFuQ>kTlzTbF-y(R;M6FbLVmpEp)!E4A z?c(cO#c?g|t#3gguBmt;rDJgLmQBMWHFT0DXIk9yqsPypa?Oz#merwq$Up(RrHXo6 zx&~|}vb2W-H|!lcGxR}0jcm66uD`W_;}U&}*5Rs`u3NWSV`dspBg0>PnRY)X+a(?* za%7w@14{}K8BKDFy}WPnb6xNAFM?!si#;2SWR)dHj`R)eB%%#pMKPz1xFutw0{ea& zixszGzy9@Xe&~xJBboEIyzb2|M$eER0uV>whfp%0HTC5VK}lnL24=mt zVn`+Y?!;W6R9nT=WBdcFqqIlY6BtEY+Rk;uafmtD2OUx_LcQ`G8^@j`b6|)ag>uSq z{^1OA)lIHmWc=JiCVGrx`m{!esQ?43Gk5YPT}-95xl0P?$RoRt1!%8zwGy@_pR;v` zwE0^Llh{*S-lya&>EZJ#t-n-XspcAe_A$^#><#N2JjCP^n=rah(w4n>w*x()eW7Z} z{5u;|DP&S$_tCjDo4OGj-)}@EHI}3DCw&^Ti5?y13{9x(;{y$yT6*(PK25oXBnLKs z{WG)j`Nfke$8zHes+EX|oAB4qqmRH>f}f@FRjHv|*OS5D>^6G&E_~f_V}Fl}uly3> z-Repa@%DU}$aRDBU4@KTS;k!a?&6s`+~zp))y)`%>n+5UU-|4-??3C~LVhjud=r}I z3x35F@TOvsJ+uQ##y-2ztFIvc(DZRO z;X&5ZfKR5uPYo{dq91PMBMRHsha5bzYL>!2u^sk)h0)xsWQx*ke?K#|l=GQ&7thMR zx;Wsz)AcE-wtY+BBm&K~X#KL=|HQ{Na|!QyEzGTXs~?R|(vu3Eq(G@W*7!ZHo$q$X zF1u;IPy&5*e8g>8m({%gi|K_H6S@x$2}p-9$}HW2yyv#C@|0hAW%&ZyH#JIV=se@};SI0v#e9$=eUJxh!zx})lk5-m$wqPGHXLqd6jWjL^GC$3kM;SbyDqjH4JXl%wf?KrBo zXwf^mUXj1fDTmObPT8>6b(+Y`vlJc|Ny|>e^#x5%H3`Su8BAh4{zzGvvyEw`JM9Fz z@M6Zoa|88kLkswS+Zm_hi~E`9f2-Itzi+h z*XeoUNR;bpf%nf;Qt#z)O0#Mh);PX2NmstX;pusO)G}d;Al;y9;-%tAc^KfWG3e2a zh?*gMN>1<9TQJt0q}AHP@Mc+;efgodkn1v+t~#wi*aj)w9nN0*Jo~KLT)6TQLXvXj z2J`comG?e`23eDEOoX2McZBcwVGPQ8hSoI?zj6I^mY{&zEzOExEnXEEqG}tbft3q1-ZTR)tCJQo=0!Cs~Dy_-p6NaVKXiaC4X6)sJY%lnIK^X8xAo56tA1{haWU$| zl(_`?Snd~&+9PqtDz(|*CQ?t!cg}pa$=TqSHz5=4jd>n2Ubynk9Fk!g?I(o-R|;HW z_WrEC)&9$!?`=B{%vRspuTzn8fAeSeu>@~UtK@$F8Dvs{PC&@17O76;PVIB7*^qG3 z#i0u+Ldx9&}A&NosJDDhr*QIoK;XfgY&GXZs&jL@e^ zzl3rJ=XVvA&KXbRxpdAA6N3v2@7-|_*p?DPEZ7{=;xoH)#q4GKrjN1=CiiDx-kRq< z_b>i+qWYNA__&~3s!rNj@Xtomk1v_tllb%^&J27E{SgukSzTiD%ob z7aYsG$s=_%CBkxU--*aodp@3bPZE52r>1#r$_8a;?pa=?5ZN{=ljF3U@e|it&y2hvG73MB@qkiaK@>ir(gV(L&qB|vt@x;~h_dRiuHYuU%!Hv3A z%e!+scZ<$zoPXEyGsYgv;zziwaza~dvPQis$i9ux zm9XAZKHoo?Sgl=IIsFiEyizC}%N=u5_`J>VF#94#eOP9C?9$<157*^;nWspEvLWkFkai*5)ysf!QJKAZ5GAf*784t>V9cKkE*q?u5pbtF^rGxK_)Z%jj{ z(<8Hu;DHX=+fAvc!G)Qi7p3=w-@n*-srXTnEjBM}^no6?oPo^4@2Q6%L_-y@D(XfZ zG>zpm0EZ00I>ACys z<5J1>$fczDe!7O}>IQgwVtXwQZg!39h1v`sp)lD?Sc0pZL(52l!>!6>oiEe=*Ob0G zGG7o>&~?kz#XT(IXU1YSR!u6L@z-AbS&b>{A0a$24sD*)So7Qlrj(;0kJr*>5cvX< zOOkZ6eO`Xq&VuqBSVl<-8PYW##hMmH+dywah<)l{lyB~MKj8$5*Yk7;qIA8zoS^~A zUD=Iu?Y)_e8L0HeY8E^{oDq7VGyL&0JXF)+s{6cr09T(}NWT#Q0kv%R=)R+dTTqJ6 zR#_ooo`3tI8A|&;E7zd>8TPOM-mhL{nn?d9GHxkNGRxhYyQ`mAiJE^_Ylxfxwegjq zf2r`9m`qAe-ZjEd#6+&MAHTUK^aLwy+~; z@Z|5$l#XA;9W*STcvfg}C&Zlcd?Y%UKI$v0| z84>?AEuqVet>vLGuNYINM?tyRkCn^nM86x^5AKv&#uhVL276!CMj1X-wvD~Ey{O&m zXVxz|gL5n~++FnD$}b2v^n$hA<^(Sp?$tQT72EaubdVoRBO&Bv1>*BKmN1xpV8!e? zTx7ZJRo(`H!899dg@l#4^;(o(=~(k6*XwY*62xIHR|^w9y#c4E^#0m=eV7_Mdg&^+;+UBA zSD2YyC?WaO3yP3koVUTyo@Q0362db@THpVqqwZ4D$-Hx11{iIL=ZCS$QMNP3v^&@4 z?eSzqUys|KMZ33~tb?4U+PJZ*YO$b>*vULh$d!VlqiDkI@zSRO{J1XDY>_0tKKA_Z z!GZOg_sx!bMEw*tgmT-a9*Q!)ql4!=EZ&lhu|bFWtR7m8DYUG<7rOc^Q=UEN+M2Q z)=ZLuk&K2Gg=oaUtj#eqQTa9QzriQoOXsN}v!y^xpc8VV`pX zJwjRY(yd0)uQ3-{!DlZk7%_%ZVWIQ<&B*wdU%ek1Gvft^xhJ_c1#p7jH&QQE>T(Ay zyiwnj8Pg&h&mcT?zK+IE#}n6I=zf@HP~fSd^=Id1U*UDxF2b8?UJ5ReFq!8-GU znWDN*Ichk2xfWJw)wDnA)z3L=$i}Q1vbYaNQ_tCFTWU@)uq!k8tJAd zj}j!drvI{sJf7uGJ@jh66X!E`tobJxTEQvdQ+a~>GG~|euA#z*56c_5ohvb$J;=)i zC(5sw-nLuoXu4!Cs)!?WcfbAo8MOZ~&`~ksL_f#6#s1t@y45N1RZ3?+pAE87`jmxt zvuxiW!fkf@S-fvOn~EoO+Js8{v7hIRqE`gksX9>GebFxy}9w5 z0G|s2IU#i(-JZPe$nFgUD1uqPNZQ0^uSLyP zd-owm@k8n*E!d|YA;K4S^G__|JFgI|YRGRNyJef6oR1Mj{1D*@xNwxgB@w!Q)uQwS z=KE!Vn-YF-I#-yBnDl@K{@YmH<);R(RpV(oTB2Uu;U06))jIbzT-f(wwz1doXJ|xJ zk(Ha+hXDOxi>`kbuVW=FmB)lUt1+bqZDY+}6Gs%Hix)Kz(9$0wce%jFCCHOI95rbZLghTaE zV^hoU=u|MrvV3WQ%7+2x_-{7G`TFZ-2_c33ax3ptb3${|lF-uH941t`hxb zba(Z0#dh}8lI2Xzw<|1NtS7!m-+qk_XGA`$G6<}t;H`9@e5>KMr}u#*y%%n?KU-I_ zXK@~{pC=&YUc)OHo7=v!r=f}&$FHS+F(szn33EuW8z|Bufx{5Bs#j#yM=7^`XiydIZ>V9s&q8tJO|vd$9py|Fl*aFVS_ zJ}CdO*?F&H!Z)H-u-&JB9_u8$x>uc?l&F*gMV@B3UR$#L{=WKLKzYtjSq@k}rETSU z$d+4_uu-i@2NqgyZ=c|6`}|zCiT{zqF37>v;*s%qSJ$sE`M$svra8tBt(?KpJxP2f z%f(-~tBF&4U^Iwy*>lUb(lF2w8%DAuetw{X&ZxDrKOMs!nZ#L~-}>E)wekqzk&{dn zcnHU(ooUtXW&G%am5~tdYZX*FuDut^WwIspx*6>{D^IMb0K=i|m4Zh{MEnwUY}kww zB;6s?kDHCqo6p^t8c+#kpKAMiI<9}_diYj7XpKnMWRk4N_-6cz#tnq~&kZ)(&M8mO zyRzUdch<3UzmA}Xm@a*kXfFNHta)D`*{XyKIUF4)@Jm0vt1#IRPKaS=sq7zY>MARz ziyHBBug*cwRuZ@@-j7Wb4?H!wUt`0qlc=hpQKK5FN4Z^@{FDPfn*ZkAJ5$&0vEC2H z#S%Eo<%swG$jc@tW`-9lmfMjC!9FX~NQ*Bor4N@>mct(4n~THGIbSCw5>>>cCp z1~dFb1M>`hbEk|^gpJA7N6>NWm1AFY(-Ey(gr(C(9et|WkI$KnO_bPO!;+k%Tt?q` zUaXq=z{br*LG~hZtN3F%b5&u`P1}oE9Pn}WCkD7d7_f}*@{<(dWahO*Nyn0w2Z!pAmf+*vZCM>P;z zZyh2rpyxV6bF*Lbwortl{-40*nU15#M$YZJ?QzWG7m46_%vzPt^_mwKcJ3jB7$zM` zJ_V~8E{D6P@z)V}-_994GQ;GgwFIYt?hDB(S z=Z@`jgulCP2J`+BUwOspB(c>FcS%J_t)GAEjj@8!E%p6nWMLjuNsAKy$Rxda6Cqx~ z`Edc_Fx)F=9q9k7UD50_&QKph3iPyI6yE7_=*60%Vs&#elN%h0gU$SWu*PP@!4mZk zC$Ew8cCjzMO{fI3v2Yg<_7$~CU#ZAkukG(bsdqbW+rF-bBi+vF>eRDx9Y3-5LKpaV zR_R8d_o-AS_O7lCnXy2IS215Z+Qk(W(Bn!UTfeoJ-F0tby3=^6lWR7sspn{)0ng!d zk5D1~JoZSnbdLnDyM%`mhwavV>d-m9@dVar-|Z_RC+QdCVz}8X@-BNxU$bO9e2aE9 zR|Y>dhrem|T@n8-`V7r_m=H#D`E13#m!J;_8JdABnTHT(Cr+K#EV6&S$osDTY|0>> zwzel{=%fA!cjLsfT(2^W>=8zd(`(~_c%e{7e0waybmT6wVAfI~<%}q6inJ#o2;E#7 z!CBW-?7TTLVsQj3ayNbT_AI}RUP4OMw8koe&G+;4wk%7|5{u@&+m&dJKtWT&4dIa* z1Fs>z8RNUyV@79HS)T-6ecv|O7;)MV8QcsX3%!|wP0P->(nsIKks&gK*+-W6`_)Vh zdAT0L1zwp{-Y?bLxwd&fV5{W`GP!DZaPJgnJLhWSdGbYD&XGi0C2@%wFx$E%wxQtx za5$r~lG{zem8J_5sn3t13ZZhAY_M;yE87cy5#FMRQQ5+pm5vr(Em@qeRF#$3vS$;A z5)9e5c4u((bdFi5moybEtcF+DM4UI6MtoinX`IP>UVg(*u8`Y2&Ik^$!5(XO^S?mt z4{6(9b#7)x=k0_9_#D^k<_#UWjIs>o(z4#$5$IxOXcVjZMG3pe&KS|1#`AVK@5K?` zSCT!EX#dv%hJBA(?cJGNm3gXUxOY5-CyLX0xJ^A0`?O4U*gL+qgy>BSg#~TqpE_Cj z0}Wpj=~_DWWdGU2Z1LT|ZSEo7%{)@8*d^&7xc1$S>-YfT1p=Yx$U}>t72s|cUyRjU z@a1X-gB$E!kL?TA%@LV-X)kJ&R=B?Uq@8kF6d`Pkc){YpNnzD9R2bEoJ>s_^2Tlq>BZ{#dupxK zcaM4n2q2eCJ`OECS-M0N-aPAjnb`N<- zozJE|?Iy+2`l^*QO*iMqx5OoZ@(TN~MFp+z{q$^c6Kter9^*&ik8Fo`yj@Yn=~pft zbv)F*+$R5}ef2VtI61_X&=mQ)S<=P~Vsev>oqbA!&PJ;E*SGo^aOEV*bkjC)Bs>0i z+D4p=G+K=7!&X$s8FklR@6Xe|yry)7op2ONo9kvG%69M0KxvjfI(2g3M0W@ufsb8` zv*h|Rm*RY>=!rd|YGdH}+32!nc934|(=IWMH!nJ>BXbP8(7pAAy-FXE`V1v(1D!Et z+(oIJCm}rJK6DSK6y@(2;B}eRyTSF?Z5k`Q{m(fiOerHhLzckgcbU2%{a;a1h~WvQ zvTI7B$)*nl8*j*c#-lYDNi2}7CqL}0eOIz>#ju{B4?mfuV7J(D?nf3O6EP>m46^;+ z=~m2?oVt^mOjtftl=*SzO;Tf_r=s=PNo+Hx?uVwdyC-%czh)A!`-r2~by?4wd^?f{ zNYBih#W)fO0ywAi=Yw#TMTc6OHf;XoCS<&S|G4`}?zkh7_Q#{Sq_FA$!I9JEq#Z}aDWsUA2y!BUAe7| zy&lT$UmE_J_EK=5=AoA(6F#@l8*uO(qla)xm2=^dn}+AP&kuog3ru;Lo_ucL4nSb> z*weR1BQQjdy)WDMcSaEyf2YfsEM>N*duA{Bk6mU)d{Mss={e1po>xMQEFnkl;oGxW zp7hI@F}kVEH4@6C_ZNRD-%UC6!A(PRLCgEwAuGRXz zlb2f>?+ziX8L<+V6vH=LyVEm-)+W6P?-2SPy_fVaRenBqw#N2R>Kb9(wCEvA%%Q_) zT{a*5C`rPqRX?~f(jUp?a!9~3J>~?`wE~3X{W)*fy2qs3DnBg) z_hPLDZc5l&WI!`4YE7U}^0mKCo0(rMc^}O(a_{FdXXjN>=X>g$F*W@s(VI48wztEF zAAfP1?LR!$?c2T-fr`CS^m3Ukw|-dQOhQg+HqqHbm*(>nyWp8MSUy{94O_zIXbxZ9 zw4rlSj#l8EO_Y!RHyihr-nf9%BEkF_`dsE^7Ll!F_?wqbtzEGwCHA>T8V)@iCs=di z_vHs!9MG-;fr>#wR_wRNZe5F-W8&uJNt5U_t~-OCL9<8`huI%!DGTHUq{zOne_wP> zeF~j;&$;Zb2^#n%(i*nOCe629nDaQj5OL*qCCN zJ`54^OGnmTjXpT46L}VKI*ZpL%j-xe@>}9mEtH7>QzNpgZN=;{e?N{la~#6-=c%LL zn&0Uz+7ZD7$5kM-z({?Au8ULh7Zx7vz$*!!_G3P*`J8x>8m^x|+>Nnq`l^DX;Wbr! zPc=kDHjzk4J?8Rc$we$fFY12iiVnwfX3w>g=G+yojI8|P38UDYqN_=EZ1~3}^h_lF zw?W7>`C!zEFJFaBnWuY3A8m6er{5g^_4V2Mv_hT7hYm{|6p6xRm`k50bZ;GwkXt~) zmN?gWe;KEyPLknLDTSQ#qEn+K8j%I&r#|Aw4n--{nudK?DR`}2D{hFoASWx* z(BAD3I1nCN0?23I^QuTYXTH-1i*yLuJ^#q5LrG z20Cdt8D(QoPp#14X({-ew_K2Rgs_d9lmky$Rc*;N2thR+(mOmpPMM-Yr8}J+Zpqoqp~)=u`R@ku~z}iHv*&E zf`pe824ArmW8H;4m8|=3cP7S)mC>WgWcGX7P7Yev#>y3R6n(gs>I1)=j5jD6tB$ul z1u|!kGq>j7cX|J@`kbq7Pi6?ZDBXeCuG;GE+*MUV&;=3hD3wnNjZf;DqCE4et!uup zOXnnt35kC@Cf&C1WYKgBy>9Ivi6*wpC1ed}ocgxLeO_Bg>TbxZsQi0VQ{vx~@YrJG zZPH$T_TrcOn(aI8m~tX&r%sGR{SkkPM^>6CVj}%P+iHV_@)q-a_=`{c1ocS^u!+UI z)bk>uJuK-H=3Om2xH7cyxg#-Dzn}gIg8bloR$vBSKC6gmV_j(%A;JQyW?k8+HF|FI zdpoxqHcLZ=F5=M3;i~Da8&V6r$fK2SPG-?4n5sz{$C4G?I36dw@5bKQopybOq=|gB zfxVbN>yBjKtK)T~$YdQ)Mh;{RhBcU8jHUCH;(PG|$H_9wB5@7#abPfYTUX{z01nQ1 zDrL;C$;X%ZrJ@k~4`jegvH4Wq?N80Bh4#~?&p3r?%o-JmLP=e38o0HpA#A*`V9VYR zWB0eLM;APj98k2bFK?-Kt%rWPk5te``4Dqk?o89>KfPtrUbzg%%(8;voNc;~6en-SmZ%Vz%a28h^f^MK!QDmXxn_UwxqNA#`)VndLd! zq^KN)#_=KvXV;fdY~Gok+oPKhJ;6#r4v1jg{5-YHcsl?hVA+ z_F~~auC6vgRVSEJ?|qh*F6T$_DgNZQw4+@(mJl^h?^#mHebR^@4dys1_!w(s3{6(( ua, + ) -> Result<(), wasm_encoder::reencode::Error> { + let values = section.into_iter().collect::, _>>()?; + if values.len() != 2 || !values[0].ty.mutable || values[1].ty.mutable { + return Err(wasm_encoder::reencode::Error::UserError( + "runtime must define exactly the stack pointer and heap boundary".into(), + )); + } + for (index, global) in values.into_iter().enumerate() { + let mut ops = global.init_expr.get_operators_reader(); + let expected = if index == 0 { 65536 } else { 131072 }; + if global.ty.content_type != wasmparser::ValType::I32 + || !matches!(ops.read()?, Operator::I32Const { value } if value >= 65536 && value <= expected) + || !matches!(ops.read()?, Operator::End) + { + return Err(wasm_encoder::reencode::Error::UserError( + "runtime linker layout does not match the reservation recipe".into(), + )); + } + globals.global( + self.global_type(global.ty)?, + &ConstExpr::i32_const(psrs_runtime::HEAP_START as i32), + ); + } + Ok(()) + } + + fn memory_type( + &mut self, + memory: wasmparser::MemoryType, + ) -> Result> { + let mut memory = wasm_encoder::reencode::utils::memory_type(self, memory); + memory.minimum = u64::from(psrs_runtime::HEAP_START / 65536); + Ok(memory) + } +} + +fn main() -> Result<(), Box> { + let args: Vec<_> = env::args().collect(); + if args.len() != 3 { + return Err("usage: package ".into()); + } + let bytes = fs::read(&args[1])?; + wasmparser::Validator::new().validate_all(&bytes)?; + let mut module = Module::new(); + Reservation + .parse_core_module(&mut module, Parser::new(0), &bytes) + .map_err(|error| std::io::Error::other(error.to_string()))?; + let output = module.finish(); + wasmparser::Validator::new().validate_all(&output)?; + fs::write(&args[2], output)?; + Ok(()) +} diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs new file mode 100644 index 00000000..861c3cf4 --- /dev/null +++ b/crates/psrs-runtime/src/catalog.rs @@ -0,0 +1,194 @@ +//! Immutable target catalog consumed by the linker and backend. +//! +//! The catalog returns plain data: WIT source paths and bytes, a world +//! identity, and a pinned artifact's bytes plus declared raw contract and +//! provenance. It never returns a `wit_parser::Resolve`, compiler IR, or +//! link-plan value, and it compiles no executable target code, so a native +//! consumer can read it without linking the formatter. + +use crate::RawType; + +/// One pinned WIT source file: its catalog path and exact contents. +#[derive(Clone, Copy, Debug)] +pub struct WitSource { + pub path: &'static str, + pub contents: &'static str, +} + +/// The default world the command artifact implements. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct WorldIdentity { + pub package_namespace: &'static str, + pub package_name: &'static str, + pub world: &'static str, +} + +/// The `psrs:app/command` default world. +pub const DEFAULT_WORLD: WorldIdentity = WorldIdentity { + package_namespace: "psrs", + package_name: "app", + world: "command", +}; + +/// Vendored WASI 0.2.12 WIT in dependency order. +pub const WASI_WIT: &[WitSource] = &[ + WitSource { + path: "wasi/io.wit", + contents: include_str!("../wit/deps/io.wit"), + }, + WitSource { + path: "wasi/clocks.wit", + contents: include_str!("../wit/deps/clocks.wit"), + }, + WitSource { + path: "wasi/random.wit", + contents: include_str!("../wit/deps/random.wit"), + }, + WitSource { + path: "wasi/filesystem.wit", + contents: include_str!("../wit/deps/filesystem.wit"), + }, + WitSource { + path: "wasi/sockets.wit", + contents: include_str!("../wit/deps/sockets.wit"), + }, + WitSource { + path: "wasi/cli.wit", + contents: include_str!("../wit/deps/cli.wit"), + }, +]; + +/// The application world source. +pub const APP_WIT: WitSource = WitSource { + path: "psrs-app.wit", + contents: include_str!("../wit/psrs-app.wit"), +}; + +/// Reviewed provenance for a pinned compiler-owned runtime artifact. +#[derive(Clone, Copy, Debug)] +pub struct ArtifactProvenance { + /// The pinned dependency whose behavior the artifact implements. + pub dependency: &'static str, + /// The exact dependency revision. + pub dependency_revision: &'static str, + /// The Rust toolchain that produced the artifact. + pub rust_toolchain: &'static str, + /// The Rust target triple. + pub target: &'static str, + /// The Cargo profile. + pub profile: &'static str, + /// The linker flags and preparation recipe. + pub recipe: &'static str, + /// SHA-256 of the prepared artifact bytes. + pub sha256: &'static str, +} + +/// A function export the artifact declares. +#[derive(Clone, Copy, Debug)] +pub struct RawExport { + pub name: &'static str, + pub parameters: &'static [RawType], + pub result: Option, +} + +/// An import the artifact declares. +#[derive(Clone, Copy, Debug)] +pub struct RawImport { + pub module: &'static str, + pub field: &'static str, +} + +/// A table the artifact declares. +#[derive(Clone, Copy, Debug)] +pub struct RawTable { + pub element: &'static str, + pub minimum: u32, + pub maximum: Option, +} + +/// Private execution storage and the allocator boundary an artifact requires. +#[derive(Clone, Copy, Debug)] +pub struct RawStorage { + pub static_data: (u32, u32), + pub stack: (u32, u32), + pub heap_start: u32, + pub minimum_pages: u64, + /// A reviewed upper bound on stack bytes for supported calling behavior. + pub stack_bound_bytes: u32, + /// Where the bound comes from, including pending evidence. + pub stack_bound_evidence: &'static str, +} + +/// A pinned core-Wasm artifact and its declared raw contract. +#[derive(Clone, Copy, Debug)] +pub struct RuntimeArtifact { + pub id: &'static str, + /// The private core-module import identity the artifact uses. + pub module_name: &'static str, + /// The artifact's core-Wasm bytes. + pub bytes: &'static [u8], + pub provenance: ArtifactProvenance, + pub required_features: &'static [&'static str], + pub imports: &'static [RawImport], + pub function_exports: &'static [RawExport], + pub global_exports: &'static [&'static str], + pub tables: &'static [RawTable], + /// Declared globals as `(mutable, constant i32 initial)`. + pub globals: &'static [(bool, u32)], + pub storage: RawStorage, + pub start_forbidden: bool, + pub data_range: (u32, u32), + pub instantiate_after_shims: bool, +} + +/// The `numberToString` formatter artifact, produced by `tools/build.sh`. +pub const NUMBER_FORMATTER: RuntimeArtifact = RuntimeArtifact { + id: "psrs:runtime-number-format", + module_name: crate::MODULE_NAME, + bytes: include_bytes!("../artifact/psrs_runtime.wasm"), + provenance: ArtifactProvenance { + dependency: "ryu-js", + dependency_revision: "1.0.2", + rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", + target: "wasm32-unknown-unknown", + profile: "target-runtime", + recipe: "tools/build.sh: --import-memory --global-base=65536 \ + -zstack-size=65536 --export=__heap_base, then package", + sha256: "6ed6f666ff48d5ce12d9ffef106edd4cb2fd0629b2ebd033e0b549414c664694", + }, + required_features: &[ + "mutable-globals", + "sign-extension", + "saturating-float-to-int", + "multi-value", + "bulk-memory", + "reference-types", + ], + imports: &[RawImport { + module: crate::MEMORY_MODULE, + field: crate::MEMORY_FIELD, + }], + function_exports: &[RawExport { + name: crate::NUMBER_EXPORT, + parameters: &[RawType::F64, RawType::I32, RawType::I32], + result: Some(RawType::I32), + }], + global_exports: &[crate::HEAP_BASE_EXPORT], + tables: &[RawTable { + element: "funcref", + minimum: 1, + maximum: Some(1), + }], + globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], + storage: RawStorage { + static_data: (crate::RESERVED_START, crate::STACK_BOTTOM), + stack: (crate::STACK_BOTTOM, crate::HEAP_START), + heap_start: crate::HEAP_START, + minimum_pages: 3, + stack_bound_bytes: 4096, + stack_bound_evidence: "reviewed pinned nonrecursive build assumption; stress evidence pending", + }, + start_forbidden: true, + data_range: (crate::RESERVED_START, crate::STACK_BOTTOM), + instantiate_after_shims: false, +}; diff --git a/crates/psrs-runtime/src/formatter.rs b/crates/psrs-runtime/src/formatter.rs new file mode 100644 index 00000000..7aff0f39 --- /dev/null +++ b/crates/psrs-runtime/src/formatter.rs @@ -0,0 +1,59 @@ +//! The executable ECMAScript binary64 formatter built for the Wasm target. + +/// Formats a binary64 value using ECMAScript Number::toString semantics. +/// +/// # Safety +/// `output` must point to `capacity` writable bytes in the caller's memory, +/// disjoint from this library's static data and stack. The returned length +/// identifies initialized ASCII bytes; no allocation or retained pointer occurs. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_to_string(value: f64, output: *mut u8, capacity: usize) -> usize { + assert!(capacity >= crate::NUMBER_CAPACITY); + if value.is_finite() { + // SAFETY: format64 requires 25 writable bytes and a finite input. + return unsafe { ryu_js::raw::format64(value, output) }; + } + let text = if value.is_nan() { + "NaN" + } else if value.is_sign_negative() { + "-Infinity" + } else { + "Infinity" + }; + // SAFETY: the caller owns the destination and the checked capacity fits it. + unsafe { core::ptr::copy_nonoverlapping(text.as_ptr(), output, text.len()) }; + text.len() +} + +#[cfg(target_arch = "wasm32")] +#[panic_handler] +fn panic(_: &core::panic::PanicInfo<'_>) -> ! { + core::arch::wasm32::unreachable() +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn formats_special_values_and_notation_boundaries() { + for (value, expected) in [ + (-0.0, "0"), + (f64::NAN, "NaN"), + (f64::INFINITY, "Infinity"), + (f64::NEG_INFINITY, "-Infinity"), + (1e-6, "0.000001"), + (1e-7, "1e-7"), + (1e20, "100000000000000000000"), + (1e21, "1e+21"), + (f64::from_bits(1), "5e-324"), + (f64::MAX, "1.7976931348623157e+308"), + ] { + let mut output = [0xff; crate::NUMBER_CAPACITY]; + // SAFETY: the buffer owns all 32 bytes for the duration of the call. + let length = unsafe { number_to_string(value, output.as_mut_ptr(), output.len()) }; + assert_eq!(&output[..length], expected.as_bytes()); + assert!(output[length..].iter().all(|byte| *byte == 0xff)); + } + } +} diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs new file mode 100644 index 00000000..aa5a6f4c --- /dev/null +++ b/crates/psrs-runtime/src/lib.rs @@ -0,0 +1,70 @@ +//! The target runtime package. +//! +//! This crate has two distinct build entry points: +//! +//! - The [`catalog`] module (feature `catalog`) exposes immutable, host-consumed +//! metadata: pinned WIT source bytes, the default command-world identity, and +//! the compiler-owned formatter artifact with its provenance and storage +//! contract. It links no executable target code. +//! - The `formatter` module (feature `formatter`) compiles the executable +//! formatter export, built for `wasm32-unknown-unknown` and embedded as the +//! pinned artifact. It embeds neither WIT text nor the catalog. +//! +//! The compiler depends on this crate with `default-features = false, +//! features = ["catalog"]`; the Wasm artifact build uses +//! `--no-default-features --features formatter`. + +#![cfg_attr(all(feature = "formatter", target_arch = "wasm32"), no_std)] + +#[cfg(feature = "catalog")] +pub mod catalog; +#[cfg(feature = "catalog")] +pub use catalog::*; + +#[cfg(feature = "formatter")] +mod formatter; +#[cfg(feature = "formatter")] +pub use formatter::number_to_string; + +/// Maximum capacity required by an ECMAScript binary64 token. +pub const NUMBER_CAPACITY: usize = 32; +/// Private core-module import identity used by the compiler. +pub const MODULE_NAME: &str = "psrs:runtime"; +/// Exported raw formatting function. +pub const NUMBER_EXPORT: &str = "number_to_string"; +/// Lower addresses remain owned by the application's canonical ABI. +pub const RESERVED_START: u32 = 65536; +/// Static data must end before the separately reserved 64 KiB stack. +pub const STACK_BOTTOM: u32 = 131072; +/// The caller's allocator begins after the private stack. +pub const HEAP_START: u32 = 196608; +/// The runtime imports the application's canonical memory. +pub const MEMORY_MODULE: &str = "env"; +/// The runtime's memory import field. +pub const MEMORY_FIELD: &str = "memory"; +/// The runtime exports its heap boundary for the preparer to relocate. +pub const HEAP_BASE_EXPORT: &str = "__heap_base"; + +/// Raw scalar types in the runtime's core-Wasm function ABI. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum RawType { + I32, + I64, + F32, + F64, +} + +/// The caller allocates this bounded output, recovers UTF-8, then releases it. +pub struct FormatterAbi { + pub export: &'static str, + pub parameters: [RawType; 3], + pub result: RawType, + pub output_capacity: usize, +} + +pub const NUMBER_FORMAT: FormatterAbi = FormatterAbi { + export: NUMBER_EXPORT, + parameters: [RawType::F64, RawType::I32, RawType::I32], + result: RawType::I32, + output_capacity: NUMBER_CAPACITY, +}; diff --git a/crates/psrs-runtime/tools/build.sh b/crates/psrs-runtime/tools/build.sh new file mode 100644 index 00000000..0134925c --- /dev/null +++ b/crates/psrs-runtime/tools/build.sh @@ -0,0 +1,10 @@ +#!/bin/sh +set -eu +cd "$(dirname "$0")/../../.." +cargo rustc --locked -p psrs-runtime --lib --no-default-features --features formatter \ + --target wasm32-unknown-unknown --profile target-runtime -- \ + -C link-arg=--import-memory -C link-arg=--global-base=65536 \ + -C link-arg=-zstack-size=65536 -C link-arg=--export=__heap_base +cargo run --locked -p psrs-runtime --example package -- \ + target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ + crates/psrs-runtime/artifact/psrs_runtime.wasm diff --git a/crates/psrs-backend/wit/deps/cli.wit b/crates/psrs-runtime/wit/deps/cli.wit similarity index 100% rename from crates/psrs-backend/wit/deps/cli.wit rename to crates/psrs-runtime/wit/deps/cli.wit diff --git a/crates/psrs-backend/wit/deps/clocks.wit b/crates/psrs-runtime/wit/deps/clocks.wit similarity index 100% rename from crates/psrs-backend/wit/deps/clocks.wit rename to crates/psrs-runtime/wit/deps/clocks.wit diff --git a/crates/psrs-backend/wit/deps/filesystem.wit b/crates/psrs-runtime/wit/deps/filesystem.wit similarity index 100% rename from crates/psrs-backend/wit/deps/filesystem.wit rename to crates/psrs-runtime/wit/deps/filesystem.wit diff --git a/crates/psrs-backend/wit/deps/io.wit b/crates/psrs-runtime/wit/deps/io.wit similarity index 100% rename from crates/psrs-backend/wit/deps/io.wit rename to crates/psrs-runtime/wit/deps/io.wit diff --git a/crates/psrs-backend/wit/deps/random.wit b/crates/psrs-runtime/wit/deps/random.wit similarity index 100% rename from crates/psrs-backend/wit/deps/random.wit rename to crates/psrs-runtime/wit/deps/random.wit diff --git a/crates/psrs-backend/wit/deps/sockets.wit b/crates/psrs-runtime/wit/deps/sockets.wit similarity index 100% rename from crates/psrs-backend/wit/deps/sockets.wit rename to crates/psrs-runtime/wit/deps/sockets.wit diff --git a/crates/psrs-backend/wit/psrs-app.wit b/crates/psrs-runtime/wit/psrs-app.wit similarity index 100% rename from crates/psrs-backend/wit/psrs-app.wit rename to crates/psrs-runtime/wit/psrs-app.wit diff --git a/docs/decision/DEC-18-unified-target-linking.md b/docs/decision/DEC-18-unified-target-linking.md new file mode 100644 index 00000000..9dcfff53 --- /dev/null +++ b/docs/decision/DEC-18-unified-target-linking.md @@ -0,0 +1,108 @@ +# DEC-18 — Unified Target Linking + +**Status:** Accepted; implemented for the core-Wasm formatter slice. General +guest WIT provider composition remains unimplemented. +**Date:** 2026-10-07. + +## Context and constraints + +Language intrinsics, library foreign declarations, WIT interfaces, and executable +Wasm libraries meet at the target boundary. Giving each a separate name table, +dependency scan, or component attachment path obscures who provides a function, +which signature was checked, and which memory its pointers address. + +`numberToString :: Number -> String` exposes this problem. Adding `ryu-js` to the +native compiler does not implement runtime formatting in generated programs. +An embedded implementation also needs checked raw calls, output recovery, +storage reservations, dependency closure, and safe instantiation ordering. +These are linking obligations, not incidental details of component encoding. + +WIT packages supply interface definitions. Executable providers may be a host +or a guest component. A definition being available does not discharge an import. +Existing source typing, representation evidence, resource ownership, and the +WASI host policy must survive provider selection. + +## Decision + +Define one target-linking contract, specified in +[linking and runtime](../design/backend/wasm/linking-and-runtime.md). +Use a single checked link plan for implementation selection, artifact dependency +closure, memory layout, instantiation, and final import verification. + +The owners remain distinct: + +- HIR owns intrinsic identities and language schemes; Core checks their uses. +- The library owns PureScript wrappers and algorithms. +- The runtime package owns pinned WIT definitions, the default command world, + executable artifacts, and their raw contracts/provenance. Its data API has no + dependency on compiler IR or backend types. Move `psrs-backend/wit/` into + `psrs-runtime/wit/`; both ABI resolution and componentization consume this + single catalog. +- The target implementation catalog maps intrinsic identities to direct + instructions, generated helpers, or artifact-backed implementations. +- `psrs-linker` owns WIT definition loading and resolved-world identity. The + backend validates source/WIT types and lowers canonical calls using that same + world context. Provider bindings select host or guest implementations explicitly. +- The independent target linker validates these contracts together and produces an immutable + plan consumed by Wasm emission and component assembly. + +Source-module linking remains with the driver. It passes checked declarations +and package provenance to the backend; it does not resolve target exports. +The link plan is target metadata alongside MIR, not another language IR or a +WIT type system inside Core. + +WIT loading and target composition belong in `psrs-linker`; source/canonical +validation and language-value recovery remain in the backend. Runtime asset +ownership must not move compiler passes into target execution code. Metadata and +target-code build entry points are separate; consuming the catalog alone does +not link the formatter into the native compiler. Interface membership comes from +the resolved world rather than a second handwritten interface whitelist. + +Use the selected `ryu-js` route as the first artifact-backed intrinsic. Its +implementation accepts binary64 and a caller-owned output buffer, writes an +ECMAScript token, and returns initialized byte length. MIR copies UTF-8 into a +GC String and frees the buffer. The library owns the official `Show` `.0` rule, +character/string escaping, and ordinary array callback traversal. + +The formatter is a core-Wasm library with an explicit shared-memory contract. +Its Rust stack and static data are private execution storage, not a language +heap. The linker must validate their reservation and the allocator boundary +before emission; output recovery must preserve DEC-16 and DEC-10 ownership. +Guest components use their own canonical ABI memory and resource identities; +the linker must not impose the core helper's shared-memory model on them. + +Embed pinned compiler-owned runtime artifacts, including source, dependency, +toolchain, recipe, and artifact hashes. Normal compiler builds do not compile +target Rust or download runtime libraries. WIT definitions and independently +supplied guest artifacts require equally explicit provenance and binding data. +There is no implicit dependency discovery, provider fallback, or network fetch. + +## Consequences + +The linker is an independent crate with a checked target API. The dependency +direction is `backend -> linker -> runtime`, with backend also consuming runtime +catalog data. The linker depends on WIT/Wasm tooling and target records, never +backend or compiler IR crates. The backend converts IR requirements and maps +structured linker errors to source diagnostics. Component encoding executes +the plan; it does not rediscover dependencies by import-name heuristics. +Each requirement has a provider, source origin, verified boundary, and lifetime. +Unused definitions do not automatically add imports, code, or capabilities. +Required initializer dependencies remain live even without ordinary call edges. + +DEC-06 remains the host-interface decision: a private embedded helper import is +closed inside the component and never becomes a project-specific host ABI. +This proposal extends DEC-09/DEC-10 to admit explicitly reserved target-library +execution storage, while retaining Wasm GC as the only language heap and bounded +ownership for buffers carrying language values. + +Arbitrary object-file relocation, runtime dynamic loading, ABI coercion between +incompatible versions, and shared GC objects across separately built libraries +are not implied by this decision. Artifact composition must respect each chosen +boundary. Additional supported input formats need their own conversion and +verification contracts. + +The existing uncommitted Show/runtime prototype is not evidence that this +contract is implemented. Its late attachment, duplicated checks, and fixed +reservation must be reconciled with the checked plan before acceptance. General +guest WIT component linking remains unimplemented; the design preserves its +requirements rather than describing the prototype as a complete linker. diff --git a/docs/design/backend/00-ir-boundaries.md b/docs/design/backend/00-ir-boundaries.md index 029ff0a7..a4d999a7 100644 --- a/docs/design/backend/00-ir-boundaries.md +++ b/docs/design/backend/00-ir-boundaries.md @@ -127,6 +127,14 @@ the selected target. P10 may optimize while preserving MIR types and the order and multiplicity of potentially effectful calls. It structures control flow and assigns final indices mechanically; it must not choose a representation. +The draft [linking and runtime](wasm/linking-and-runtime.md) contract adds +checked target requirements alongside MIR and a link plan before Wasm emission. +The plan is metadata, not another language IR. It joins implementation/provider +selection, memory ownership, and component composition without moving WIT names +into CC or reinterpreting source types after ABI lowering. P10 and P11 consume +the same checked plan for the formatter slice; general guest providers are not +yet implemented. + ## Model ### Boundary @@ -320,7 +328,8 @@ lib.rs crate surface: `compile` / `compile_with_target`, `ExternalBin capability.rs `TargetCapabilities` and validator feature mapping types.rs shared Wasm value/type model abi/ WIT registry, canonical ABI classification, checked source signatures -component.rs component packaging +linking/ checked target requirements and plan/diagnostic mapping +target_runtime.rs intrinsic-to-artifact implementation catalog cc/ CC IR (functional) mod.rs `Module`, `Function`, `Assignment`, `AssignmentKind`, lowering entry representation.rs `ReprId`, `ValueShape`, `Reference`, `RefShape`, `Representation`, `RepresentationTable` diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index a3c720a5..26e84602 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -63,6 +63,7 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [encoding-and-structuring.md](wasm/encoding-and-structuring.md) | Structured Wasm encoding and binary emission | 00-ir-boundaries | | [capability-profile.md](wasm/capability-profile.md) | Target capability profile and gating | encoding-and-structuring | | [canonical-abi-and-wit.md](wasm/canonical-abi-and-wit.md) | WIT bindings and canonical ABI adaptation | encoding-and-structuring | +| [linking-and-runtime.md](wasm/linking-and-runtime.md) | Intrinsic implementations, WIT providers, checked target link plans, and artifact composition (Draft) | primitive FFI, canonical-abi-and-wit | | [linear-memory-and-canonical-abi-boundary.md](wasm/linear-memory-and-canonical-abi-boundary.md) | Linear memory as the ABI boundary | canonical-abi-and-wit | | [wasi-platform-library.md](wasm/wasi-platform-library.md) | Component packaging and WASI services | canonical-abi-and-wit | diff --git a/docs/design/backend/wasm/canonical-abi-and-wit.md b/docs/design/backend/wasm/canonical-abi-and-wit.md index 6493c492..99dd880d 100644 --- a/docs/design/backend/wasm/canonical-abi-and-wit.md +++ b/docs/design/backend/wasm/canonical-abi-and-wit.md @@ -7,6 +7,19 @@ ## Scope +Executable provider selection and artifact dependency closure are owned by the +draft [linking and runtime](linking-and-runtime.md) design. Resolving a WIT +interface checks a definition; it does not prove that a host or guest implements +it. ABI lowering supplies checked source/WIT and resource-ownership contracts to +the linker. Changing providers does not authorize a new source-type projection +or pointer/handle reinterpretation. + +The same proposal moves compiler-owned WIT source assets and the default world +to `psrs-runtime`, exposed through its immutable target catalog. `psrs-linker` +loads definitions and supplies one resolved-world context; the backend validates +source/WIT contracts and lowers canonical calls against that context. ABI lookup and +component assembly consume the same catalog. + This document owns source WIT bindings, the ABI registry, argument classification and flattening, result recovery, signature validation, and the ownership rules at the boundary. It does not own the linear-memory layout and allocator used by @@ -477,9 +490,12 @@ backend/src/ parameters/ mod.rs direct parameter flattening, records, flags indirect.rs Canonical ABI parameter-record layout and stores - component.rs vendored WIT loading and component packaging + linking/ checked target requirements and plan/diagnostic mapping ``` +WIT definition loading and component packaging now live in `psrs-linker`, over +the pinned definitions owned by `psrs-runtime/wit/`. + `abi.rs` and `abi/` own resolving source WIT bindings and must define: - `ExternalBindings` — the side table of the Model section, holding one @@ -531,20 +547,22 @@ It flattens arguments into canonical parameters, appends the return pointer when record and flags flattening. Every adaptation instruction must be an ordinary MIR operation, and no WIT name, interface, or canonical signature may enter MIR. -`component.rs` owns vendored WIT loading and packaging and must provide: +`psrs-linker` owns WIT definition loading and composition and provides: ```rust -pub fn load_vendored_wasi(resolve: &mut Resolve) -> Result<(), String>; -pub fn command_world() -> Result<(Resolve, WorldId), String>; -pub fn componentize(core: &[u8], resolve: &Resolve, world: WorldId) -> Result, String>; +pub fn resolve_default_definitions() -> Result; +pub fn compose(context: &ResolvedWorldContext, plan: &CheckedLinkPlan, application: &[u8]) + -> Result; ``` -It also owns the supported-interface set. `abi.rs` owns the +The backend's `abi` module loads the same pinned WIT from the `psrs-runtime` +catalog for isolated ABI fixtures and derives the supported-interface set from +the resolved default world. `abi` owns the `wasi_interface_enabled(target, interface)` package gate consulted before resolving a WASI import ([capability profile](capability-profile.md)). Dependencies must stay one-directional: `abi` and `mir/wit` may depend on -`capability` and shared types; `component` may depend on `abi` and `capability`; -none may depend on the front end. +`capability` and shared types; the backend `linking` module may depend on `abi` +and `capability`; none may depend on the front end. ## Invariants and verification diff --git a/docs/design/backend/wasm/canonical-abi-compositional.md b/docs/design/backend/wasm/canonical-abi-compositional.md index 5a4396b8..9baa37b8 100644 --- a/docs/design/backend/wasm/canonical-abi-compositional.md +++ b/docs/design/backend/wasm/canonical-abi-compositional.md @@ -706,8 +706,8 @@ the free plan frees the record after the call. lowering into loops and leaf loads/stores carrying the `MemoryId` and `MemArg` ([linear memory and the canonical ABI boundary](linear-memory-and-canonical-abi-boundary.md)). - **To the componentizer.** `FnAbi` must match `Resolve::wasm_signature` so - `componentize` links the core import - (`crates/psrs-backend/src/component.rs:74`). + `psrs_linker::compose` links the core import + (`crates/psrs-linker/src/compose.rs`). - **To the allocator.** The generic parameter record and return area allocate and free through `cabi_realloc`, following [canonical buffer allocation and lifetime](canonical-buffer-allocation-and-lifetime.md). diff --git a/docs/design/backend/wasm/encoding-and-structuring.md b/docs/design/backend/wasm/encoding-and-structuring.md index 36c5bc04..64b3f3ae 100644 --- a/docs/design/backend/wasm/encoding-and-structuring.md +++ b/docs/design/backend/wasm/encoding-and-structuring.md @@ -18,7 +18,9 @@ emission. It does not own: - concrete scalar, GC, and closure layouts, which MIR fixes; - canonical ABI adaptation, which is [canonical ABI and WIT](canonical-abi-and-wit.md); - target capability policy, which is the [capability profile](capability-profile.md); -- component packaging and WASI services, which is the +- target-provider selection, memory reservations, and artifact composition, + specified by the draft [linking and runtime](linking-and-runtime.md) design; +- the command world and WASI services, specified by the [WASI platform library](wasi-platform-library.md). ## Background @@ -208,6 +210,13 @@ table is installed; the segment exists only to satisfy the declaration rule. ### Data segments and the allocator +Under the [target linking contract](linking-and-runtime.md), P10 consumes +checked memory reservations and an allocator boundary from the same link plan +used by component assembly. It does not choose libraries or derive storage +ownership by scanning import names. This plan integration is implemented for +the formatter slice; the emitter consumes the plan's import names, heap start, +and minimum pages. + String literals are collected once, deduplicated by content, and placed in passive data segments. Each distinct literal used by the module is interned in one mutable `(ref null $string)` global: the first evaluation materializes the diff --git a/docs/design/backend/wasm/linear-memory-and-canonical-abi-boundary.md b/docs/design/backend/wasm/linear-memory-and-canonical-abi-boundary.md index f968b4f7..46bec911 100644 --- a/docs/design/backend/wasm/linear-memory-and-canonical-abi-boundary.md +++ b/docs/design/backend/wasm/linear-memory-and-canonical-abi-boundary.md @@ -7,6 +7,12 @@ ## Scope +The [linking and runtime](linking-and-runtime.md) design extends the +canonical-only contract with explicit artifact-owned static data and execution +stacks. The linker reserves these regions outside canonical scratch, allocator +state, and transient allocations; the formatter slice implements this. This does +not add a linear language heap. + This document owns the address model, the string and byte-list representation, the scratch return area, data-segment use, and the MIR byte-operation contract at the boundary. It does not own canonical ABI adaptation itself diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md new file mode 100644 index 00000000..ff907f9d --- /dev/null +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -0,0 +1,499 @@ +# Linking and Runtime Implementations + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) +**Status:** Implemented for the core-Wasm formatter slice. General guest WIT +provider composition remains unsupported; see the open questions below. +**Prerequisites:** [IR boundaries](../00-ir-boundaries.md), +[primitive FFI](primitive-ffi-and-stdlib.md), +[canonical ABI and WIT](canonical-abi-and-wit.md), +[linear memory](linear-memory-and-canonical-abi-boundary.md), and +[DEC-06](../../../decision/DEC-06-runtime-interface-via-wit.md). +**Summary:** One checked target link plan connects language intrinsics, executable +runtime implementations, WIT interface providers, and component packaging. It +owns dependency closure, export/import agreement, memory reservations, and +instantiation order. Source typing, library algorithms, canonical adaptation, +and Wasm encoding retain their existing owners. + +## Scope + +This document owns target implementation selection and linking after checked +source-module assembly: the catalog, requirement closure, provider bindings, +artifact verification, link plan, and execution of that plan. It includes both +private core-Wasm runtime libraries and providers of WIT interfaces. + +It does not own PureScript name resolution, type inference, stdlib algorithms, +WIT syntax, GC layouts, or control-flow structuring. It consumes their checked +results. The driver continues to assemble source modules from the locked stdlib +package. The linker never repairs invalid typing with raw ABI compatibility. + +## Background + +### Definitions, declarations, and implementations + +| Input | Supplies | Does not establish | +| --- | --- | --- | +| PureScript source package | declarations, classes, instances, pure functions, typed foreign declarations | an executable implementation for every foreign value | +| Intrinsic registry | primitive identity, semantics, arity, language scheme | a particular raw ABI or artifact provider | +| WIT package | interfaces, worlds, function and resource types, definition dependencies | code implementing those interfaces | +| Core-Wasm library | typed raw exports and executable code, with memory/table requirements | compatibility with source types or a WIT interface | +| Guest component | component exports and imports, resource identities, executable implementation | permission to leave its dependencies as host imports | +| Host provider | implementations made available by the selected target world | arbitrary imports inferred from names or ABI shape | + +A WIT-defined library can have host or guest implementation providers. Its WIT +package and its executable artifact are separate dependency records. A package +version resolves definitions; a selected provider discharges execution needs. + +Core-module linking here means typed module composition inside a component. +It does not imply merging instruction streams or accepting native object-file +relocations. WIT component composition uses canonical lift/lower boundaries. +These differ from source-module linking, which unifies checked language +declarations before backend lowering. + +### Intrinsic implementations + +The same checked intrinsic may be realized by a direct Wasm instruction, a +compiler-generated helper, or a runtime artifact. These are implementation +choices under one language contract. `numberToString` returns a source String; +its runtime's pointer and length are not that source signature. A whole `Show` +implementation must not migrate into the compiler just because its numerical +leaf requires target code. + +## Model + +### Identities and checked inputs + +Use stable identities within their owning domain. An intrinsic uses its HIR +identity, source values use resolved symbols, WIT interfaces/types use resolved +package identities, and executable artifacts use an identity plus a content +digest. Final Wasm indices and readable names are encoding results. + +Canonical WIT names include package/interface/version identity. World aliases +are resolved through WIT before binding; strings and unversioned prefixes are +not authoritative identities. Pins choose exact definitions and artifacts. +Compatibility across versions requires an explicit adapter or rule with +evidence; the linker does not guess it from equal flattened signatures. + +The source-to-WIT contract retains source TypeId, representation evidence, +canonical widths/layouts, and own/borrow rules as described in DEC-12/DEC-13. +The linker consumes that contract; it does not create another source-type mirror. + +### Implementation catalog and requirements + +The following are logical contracts, not a demand for placeholder crates: + +```text +IntrinsicImplementation = { + intrinsic_id, semantic_contract_version, + implementation: Direct | GeneratedHelper | ArtifactExport, + requirements, recovery_protocol +} + +ArtifactContract = { + artifact_id, kind: CoreModule | Component, + digest, provenance, required_features, + verified_exports, required_imports, + storage_contract, initialization_contract +} + +BindingRequirement = { + origin: source_symbol/span | generated_operation/parent_origin, + boundary: CheckedPrimitive | ResolvedWit | RawCore, + expected_contract, + provider: Generated | ArtifactExport | HostInterface +} + +LinkPlan = { + selected_implementations, verified_artifacts, resolved_bindings, + memory_plan, instantiation_steps, external_world, + requirement_origins, input_digests +} +``` + +Catalog metadata has one owner. Lowerers request an implementation by checked +identity and consume its ABI/recovery descriptor. Artifact inspection verifies +that descriptor against real exports; it does not independently define it. +The public library API and source scheme remain with the library and HIR. + +Every executable requirement resolves to exactly one selected provider. +Explicitly compatible sharing is allowed, but duplicate or ambiguous providers +are errors. A provider's own requirements participate in the same closure. +Generated helpers and command-entry imports are roots even when absent from +source foreign declarations. + +### Storage and initialization + +Every shared-memory region records a memory identity, range/alignment, owner, +lifetime, and access protocol. Distinguish canonical scratch and allocator state, +runtime static data, runtime stack, and allocator-managed transient buffers. +Reservations are nonoverlapping; ranges and required memory pages are checked +for overflow and supported bounds. The allocator starts after all reserved +regions and cannot return their bytes. + +Separate guest components normally own separate memories. Their canonical ABI +conversion copies/lifts values through each provider's memory and realloc/ +post-return protocol. Equal pointer widths do not make pointers transferable. +Resource handles retain provider and resource-type identity; method families and +constructors/destructors cannot be split across incompatible provider instances. + +Instantiation steps distinguish dependency creation, memory aliases, function +shims, shim resolution, declared initialization, and command invocation. A call +cycle may use a supported shim protocol only if initialization cannot invoke an +unresolved shim. Unsupported eager cycles, start functions, or initialization +side effects are explicit errors. No command runs until linking succeeds. + +## Design + +### One plan, distinct stages + +```mermaid +flowchart TD + source["Locked source package"] --> checked["Checked Core + external declarations"] + intrinsic["Intrinsic semantics"] --> selection["Select target implementation"] + checked --> selection + wit["Pinned WIT definitions"] --> binding["Resolved source / WIT contract"] + checked --> binding + selection --> mir["MIR calls + explicit target requirements"] + binding --> mir + artifacts["Verified executable providers"] --> plan["Checked target link plan"] + mir --> plan + plan --> emission["Wasm emission uses memory / import plan"] + emission --> assembly["Linker assembles and verifies artifacts"] + plan --> assembly + assembly --> output["Component + permitted external world"] +``` + +P8 checks source declarations against primitive or WIT contracts and selects +implementation identities. P9 lowers recovery and ownership operations to MIR, +retaining explicit target requirements beside it. After MIR optimization, +planning closes reachable requirements and verifies artifact contracts before +P10 lays out memory or assigns imports. P10/P11 consume the same immutable plan. +Final binary inspection checks conformance to that plan; it never reconstructs +semantic bindings or chooses providers from emitted strings. + +If optimization changes requirements, rebuild the plan from the checked inputs +and new reachability result. An emitter cannot independently add another helper +or host capability. Catalog feature requirements must be visible before emission. + +### WIT providers and world construction + +#### Runtime package owns target definitions + +Move the compiler-owned WIT assets from `psrs-backend/wit/` to +`psrs-runtime/wit/`, including both the pinned WASI dependency definitions and +`psrs-app.wit`. They describe the distributed target contract and default world; +their version, hashes, source provenance, and dependency set belong with the +runtime package. Owning these definitions does not mean the package implements +WASI host services. + +The runtime package exposes immutable catalog data: WIT source names/bytes, +package pins, default-world identity, artifact bytes/digests, and raw export/ +storage contracts. The backend consumes this data rather than using cross-crate +`include_str!`/`include_bytes!` paths or maintaining a second embedded copy. +The same catalog supplies ABI resolution and component-world construction. + +The independent `psrs-linker` owns WIT catalog loading, resolved world identities, +provider contracts, and target composition. The backend owns source-signature +checks, canonical call planning, representation recovery, and language-to-target +capability requirements. The runtime package depends on neither compiler IR crates +nor backend/linker machinery; its metadata API returns data, not `Resolve`, MIR, +or link-plan values. Target execution +code and host-consumed catalog metadata have distinct build entry points so +reading WIT assets does not require compiling the formatter into the native +compiler or embedding WIT text in the executable target module. + +The resolved default world supplies interface membership. Capability policy is +checked separately against the selected target profile. Do not retain a second +handwritten `COMPONENT_INTERFACES` list as an independent source of permitted +interface identities. The final external world is still the live provider +closure, not every interface mentioned in the package's default world. + +#### Select executable providers + +Resolve all needed WIT definitions for type checking, but select executable +providers only for reachable interfaces and retained initialization needs. +Provider bindings are explicit build inputs: current compiler-owned WASI bindings +select host interfaces; future guest bindings select pinned component exports. +Merely placing WIT files in a directory never selects a provider. + +For a host binding, verify that the selected target world permits that interface +and leave it in the final external world. For a guest binding, verify its export +against the resolved interface, bind the application import to that export, +and recursively resolve the guest's imports. Guest dependencies that remain host +capabilities must also be permitted and reported. A guest cannot hide an extra +filesystem/network capability from the plan. + +Source-value conversion remains owned by backend ABI lowering. The linker uses +component tooling's canonical lift/lower operations for typed composition; it +does not reconstruct source layouts. WIT package inclusion, resource identity, +string encoding, ownership, realloc and export post-return are checked before +composition. Resource equivalence follows explicit instance/type aliases, +not method names. Conflicting pins or unresolved provider exports fail before +artifact emission. There is no silent host fallback when a guest binding fails. + +### Artifact-backed intrinsic calls + +Artifact exports use explicit raw signatures and recovery protocols. A raw +runtime accepts only representations declared by its contract; source GC +references cannot cross an independently built core library boundary without a +checked shared representation contract. The formatter needs scalars and bytes, +so it does not require shared GC types or a WIT wrapper. + +The `numberToString` implementation uses pinned `ryu-js` 1.0.2 in a small Rust +target crate. The caller supplies a 32-byte buffer, and the raw export has +`(f64, i32, i32) -> i32`: value, pointer, capacity, then initialized length. +The runtime writes ASCII, allocates nothing, and retains no pointer. Its +contract includes negative zero, NaN/infinities, notation boundaries, and +ECMAScript shortest-decimal choices. The library applies the official Show rule +for appending `.0`; that rule is not part of the token primitive. + +MIR allocates the buffer, calls the provider, validates/recovers UTF-8 into a GC +String, and frees the buffer on normal completion. The contract guarantees length +fits capacity; an unchecked arbitrary library cannot inherit this guarantee. +Traps abort the command; there is no promise to resume with a reusable allocator +after a runtime trap. Retained GC Strings must survive subsequent buffer reuse. + +### Shared runtime storage and artifact preparation + +The selected formatter reservation is static data in `[65536, 131072)`, a 64 KiB +private stack in `[131072, 196608)`, and application allocation beginning at +196608. Low addresses retain canonical scratch/allocator-state ownership. +When the formatter is absent, its reservation is absent too. + +These values belong to the artifact storage contract, not scattered allocator +constants. The preparer verifies the linked Rust layout before relocating the +identified stack-pointer and heap-boundary globals. It preserves data offsets, +checks imported memory bounds, and records the resulting bytes/digest. The +consumer verifies actual globals, imports, exports, data ranges, feature needs, +and forbidden initialization against that contract. An unexplained table or +other export/import must be understood and declared, not blanket-accepted. + +The pinned nonrecursive formatter's maximum stack use must be established by +artifact analysis or an explicit reviewed build assumption plus stress evidence. +Checking the initial stack pointer alone does not prove a bound. Reentrancy, +callbacks, memory growth, or a different runtime provider requires revisiting +the storage contract. Additional artifacts need disjoint reservations or an +explicit shared allocator; the linker must not reuse this fixed region blindly. + +This extends the strict "canonical ABI only" linear-memory clause of DEC-09/10 +to permit declared private runtime execution storage. Language values remain on +the GC heap; transient buffer ownership and canonical resource rules persist. + +### Reproducibility and rejected alternatives + +Compiler-owned runtime artifacts are embedded with pinned dependency and source +identities, Rust toolchain/target, build profile, linker flags, preparation recipe, +and SHA-256 of final bytes. Regeneration must reproduce those bytes or explicitly +update the reviewed provenance. Normal compiler builds use the checked artifact. +The stdlib lock still owns source-package revision/fingerprint; target artifacts +and WIT definitions have distinct records included in compile lineage. + +Rejected: native-only formatting, full JS-engine embedding for one primitive, +late attachment triggered by import names, duplicated per-consumer ABI tables, +universal shared-memory composition, and treating WIT definitions as executable +providers. These either fail to execute the source contract or discard a boundary +that the linker must verify. + +## Algorithms + +1. Load locked source, WIT, implementation catalog, and artifact provenance. + Reject stale or conflicting identities; perform no implicit downloads. +2. Validate source primitive/WIT schemes at the Core boundary and retain binding + origins and representation/ownership evidence through P9. +3. Lower target operations and result recovery to MIR. Emit explicit provider, + helper, allocator, and capability requirements alongside the lowered module. +4. After optimization, close live requirements, provider dependencies, and + required initializers. Reject absent or ambiguous implementations. +5. Validate actual artifact signatures/features, WIT exports/resource identities, + and initialization contracts. Check allowed residual host imports. +6. Compute memory owners/reservations and a legal instantiation schedule. Publish + a checked immutable plan only when all checks succeed. +7. Emit application Wasm using that plan. Verify emitted imports, memory, helper + exports, and required initialization against it. +8. Execute planned composition, validate the final component, and compare its + unresolved imports with the planned external world. Record artifact digests + and origins; return errors without publishing a successful artifact on failure. + +## Code map + +### Independent linker crate + +Create `psrs-linker` when implementing this contract. It has a real input/output +boundary: verified target definitions and requirements enter; a checked link plan +and composed artifact leave. Its responsibilities do not require PureScript +syntax, type inference, Core, CC, MIR, or backend-specific symbols. + +The dependency direction is: + +```mermaid +flowchart LR + driver["psrs-driver"] --> backend["psrs-backend"] + backend --> linker["psrs-linker"] + backend --> runtime["psrs-runtime catalog"] + linker --> runtime + backend --> ir["Core / HIR / shared utilities"] + linker --> tools["WIT / Wasm tools"] +``` + +`psrs-linker` must not depend on `psrs-backend`, `psrs-core`, `psrs-hir`, or MIR +definitions. In particular, no `for_mir(&mir::Module)` API belongs in it. The +backend converts its checked requirements into linker-owned target records; +it keeps the mapping from requirement identity to source symbols/spans. The +linker returns structured errors with requirement/artifact identities, and the +backend attaches language diagnostics and compile-stage attribution. Linker-only +tests can construct target artifacts without compiling PureScript. + +WIT definition loading and default-world resolution move from backend component +glue into `psrs-linker`. It returns one immutable resolved-world context consumed +by both backend ABI lowering and linker provider validation. Backend code may +use `wit-parser` operations on that context for canonical flattening; it does +not load a second copy or regenerate interface identities. Provider artifacts +must agree with the context and pinned definitions before plan publication. + +The target organization is: + +```text +psrs-hir/intrinsic/ semantic identities and source schemes +psrs-core/verify/ checked uses and external schemes +psrs-backend/bindings/ source contract + implementation requirements +psrs-backend/abi/ source/WIT validation, canonical conversion, ownership +psrs-backend/target_runtime/ intrinsic-to-provider selection using runtime catalog +psrs-backend/linking/ checked IR-to-linker requests and diagnostic mapping +psrs-backend/mir/ raw calls, value recovery, explicit lifetimes +psrs-backend/wasm/ planned memory/import emission and encoding +psrs-linker/definitions/ WIT loading and immutable resolved-world context +psrs-linker/plan/ provider closure, memory and initialization planning +psrs-linker/compose/ ComponentEncoder integration and final validation +psrs-linker/verify/ artifact contracts and emitted-plan agreement +psrs-runtime/ immutable target catalog and target code +psrs-runtime/wit/ pinned definitions and default command world +psrs-runtime/artifact/ core-Wasm bytes, contracts and build provenance +psrs-stdlib/lib/ public APIs and ordinary PureScript wrappers +psrs-stdlib/conformance/ pinned official-JS observations and case engines +``` + +These are owners, not instructions to add empty crates or split every file. +The formatter slice is implemented in `psrs-linker` (`definitions`, `plan`, +`verify`, `compose`, `runtime`), `psrs-runtime` (catalog plus `wit/` and +`artifact/`), and the backend's `target_runtime` and `linking` modules. The +earlier backend-local `linker/` prototype and the backend `component` module +have been removed; WIT loading and composition now live in `psrs-linker`. + +### API and trust boundary + +The intended API is conceptually: + +```text +resolve_definitions(runtime_catalog, pinned_wit_inputs) + -> Result +plan(context, TargetLinkInput) + -> Result +compose(plan, encoded_application) + -> Result +``` + +`TargetLinkInput` contains linker-owned requirement identities, target signatures, +provider selections, artifact references, storage demands, initialization roots, +and the permitted target features/host interfaces. It contains no compiler IR +nodes or language TypeIds. The backend explicitly converts its capability profile +to this target policy rather than making the linker import backend types. + +The linker trusts the backend's source-type and representation checks; it does +not claim to repeat them. It checks raw contracts, WIT provider agreement, storage, +features, and composition itself. Core-binary-only callers must supply +an explicit binding/artifact contract; they cannot bypass planning by scanning +imports. Wasm emission and component assembly both require the same checked plan. +The plan exposes verified memory/import data needed by emission, while keeping +construction private to successful planning. Artifact preparation is a build +tool, not a compiler emission pass. + +## Invariants and verification + +- Each live foreign/primitive/helper requirement has one checked provider and + a diagnostic origin. Raw signature equality never proves source compatibility. +- WIT definitions and executable provider closure are separately complete. + Host imports equal the permitted residual capabilities, not every loaded WIT + interface and not merely the source application's direct imports. +- The same plan controls raw imports, memory ownership, initialization, and + final composition. No late encoding path changes it silently. +- Each shared pointer belongs to the planned memory/region; buffers obey + allocation/recovery/release protocols. Component pointers and resource handles + do not cross unrelated providers by integer reinterpretation. +- Artifact bytes and requirements match recorded digests/features. Storage and + initializer checks are distinct from assumptions about algorithm correctness, + stack depth, termination, and effects; trusted assumptions are recorded. +- An unneeded provider contributes neither bytes nor its host dependencies. + Observable initializer effects are retained by explicit policy and live edges. +- Failed binding, preparation, planning, composition, or validation does not + produce a successful artifact or an empty fallback implementation. + +Validation covers malformed source bindings, raw artifact ABI/storage failures, +WIT version/provider/resource conflicts, legal and illegal initialization +dependencies, and final import closure. Runtime evidence must combine formatting, +buffer reuse, GC retention, and WASI calls to exercise the shared-memory boundary. +Acceptance obligations are tracked in +[the implementation record](../../../implementation/backend/linking-and-runtime.md). + +## Worked example + +For `log (show 1.0e21)`, the library Show instance calls its token primitive. +Core checks `Number -> String`. The catalog selects the formatter artifact; MIR +allocates output, calls its raw export, recovers the GC String, and releases +output. The library receives `"1e+21"` and leaves it unchanged. Console output +uses the independently checked WASI streams binding and canonical buffers. + +The plan includes formatter storage and the reachable WASI host services. The +application is instantiated with call shims and owns canonical memory. The +runtime is then instantiated with that memory; its data initializes only its +reserved range. Shims are resolved before the command runs. Formatting's private +core import is closed; WASI interfaces remain in the external world. A live +String remains valid after the formatter buffer is freed and reused by stdout. + +If the streams interface instead has an explicitly selected guest WIT provider, +that provider is composed through its interface, memory, and resource instance. +Its own allowed host dependencies join the external world. This is not achieved +by passing the application's output buffer pointer into the guest memory. + +## Boundaries and interfaces + +The driver supplies source package provenance and checked declarations. HIR/Core +supply primitive identities/types. ABI lowering supplies checked source/WIT +contracts and recovery operations. MIR optimization preserves their identities +and updates live requirements. The linker supplies a checked target plan; Wasm +encoding supplies conforming bytes. Component assembly consumes both and emits +the validated final artifact with the planned external world. + +Compile diagnosis should record selected provider identities, WIT/artifact +digests, plan inputs, checks, and failures as explicit lineage alongside MIR and +binary artifacts. Runtime observations remain separate evidence. A valid link +plan proves binding/layout checks, not official-library semantic conformance. + +## Open questions and future work + +The concrete manifest syntax and CLI for independently supplied WIT providers +are not yet selected. Their ownership and checked-plan obligations are defined +above; general component loading remains unsupported until that entry point and +its verification exist. Do not imply a new supported CLI flag in documentation. + +Runtime stack-bound evidence and the exact artifact-provenance representation +must be settled before accepting the formatter implementation. Relocatable +object files, dynamic loading, async/WASI 0.3 composition, recursive or reentrant +runtime libraries, and cross-module GC sharing require explicit extensions. + +Existing WIT/WASI binding code precedes this plan model. The formatter slice now +carries one checked plan from requirement closure through artifact verification, +Wasm emission, and component assembly, with a target-only linker test suite and +an end-to-end formatter execution test. The stack bound is still a reviewed +pinned-build assumption pending stress evidence, and general guest WIT component +linking remains unimplemented; no general-linker claim follows from the +formatter slice. + +## References + +- [DEC-18 — Unified Target Linking](../../../decision/DEC-18-unified-target-linking.md). +- [DEC-12 — Resolved WIT Bindings](../../../decision/DEC-12-resolved-wit-bindings.md), + [DEC-13 — WIT to Source Mapping](../../../decision/DEC-13-wit-to-source-type-mapping.md), + [DEC-14 — Resource Ownership](../../../decision/DEC-14-resource-handle-ownership.md). +- [Component Model explainer](https://github.com/WebAssembly/component-model/blob/main/design/mvp/Explainer.md) + and [WIT specification](https://github.com/WebAssembly/component-model/blob/main/design/mvp/WIT.md) + for interface definitions, canonical boundaries, and typed composition. +- [ryu-js](https://github.com/boa-dev/ryu-js) for the selected formatter implementation. diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index b4aed26c..d908aba3 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -71,6 +71,26 @@ mapping does not learn them. ## Model +### Intrinsic target implementations and linking + +`psrs:intrinsic#` selects a checked language primitive, not a raw runtime +function. An implementation may be a direct Wasm operation, a generated helper, +or an embedded target-library export. Backend implementation descriptors join +the HIR identity to the raw export signature and recovery protocol; a target +link plan verifies reachable imports, validates the runtime artifact, reserves +shared-memory regions, and schedules instantiation. See +[the linking design](linking-and-runtime.md) and +[DEC-18](../../../decision/DEC-18-unified-target-linking.md). The formatter slice +implements this contract. + +For `numberToString :: Number -> String`, the runtime receives a binary64 value +and a caller-owned 32-byte output buffer, returns its initialized UTF-8 length, +and retains nothing. MIR recovers a GC String and releases the temporary buffer. +The linker packages the pinned formatter and closes the private import inside +the emitted component. `Data.Show` keeps the official `.0` wrapper and ordinary +PureScript escaping and array callbacks in the library. The formatter's raw +signature is never substituted for the primitive's language signature. + ### The primitive set A foreign import the lowerer accepts uses only these source types: diff --git a/docs/design/backend/wasm/wasi-platform-library.md b/docs/design/backend/wasm/wasi-platform-library.md index fe913a99..70880d25 100644 --- a/docs/design/backend/wasm/wasi-platform-library.md +++ b/docs/design/backend/wasm/wasi-platform-library.md @@ -7,6 +7,17 @@ ## Scope +The proposed [target linker](linking-and-runtime.md) owns artifact providers, +dependency closure, storage, and composition schedules. This document owns the +WASI command world and service policy. Private runtime imports must be closed +inside the final component; only permitted residual host interfaces appear in +its external world. General guest WIT provider composition is not yet supported. + +Pinned WIT dependencies and the default command-world source are planned runtime +package assets. `psrs-linker` resolves them, and the backend supplies its target +capability policy and checked canonical call requirements; +catalog ownership does not make `psrs-runtime` the implementation of WASI. + This document owns the artifact shape, the application world, componentization with `wit-component`, the enabled WASI services, and validation and execution of the component. It does not own canonical ABI adaptation and call lowering @@ -86,12 +97,11 @@ world command { `wasi:io/streams` transitively pulls in the support interfaces `wasi:io/error@0.2.12` and `wasi:io/poll@0.2.12`. The `wasi:cli` terminal and `sockets/ip-name-lookup` interfaces are accepted but not wrapped by the platform -library. `component.rs` records the -full resolved set in `COMPONENT_INTERFACES`, next to the world, so ABI discovery -and component encoding share one contract; a test asserts the resolved world -matches that list exactly and imports only named interfaces. The vendored WASI -0.2.12 WIT is loaded in dependency order by `load_vendored_wasi`, and -`command_world` resolves `psrs:app` against it. +library. The `psrs-linker` resolved default world records the full set, and the +backend derives the permitted interface set from it, so ABI discovery and +component encoding share one contract; a test asserts the resolved world imports +only named interfaces. The pinned WASI 0.2.12 WIT is loaded from the +`psrs-runtime` catalog by `psrs-linker::resolve_default_definitions`. ### Enabled services @@ -187,17 +197,18 @@ pruned so an unused service adds no import. ### Componentization -`componentize(core, resolve, world)` embeds component metadata describing the -world the core module implements, then encodes the component: +`compose(context, plan, core)` embeds component metadata describing the +world the core module implements, attaches the plan's verified libraries, then +encodes the component: ```text -componentize(core, resolve, world): +compose(context, plan, core): bytes = core - embed_component_metadata(bytes, resolve, world, StringEncoding::UTF8) - ComponentEncoder::default() - .module(bytes)? - .validate(true) - .encode() + embed_component_metadata(bytes, context.resolve(), context.world(), StringEncoding::UTF8) + encoder = ComponentEncoder::default().module(bytes)? + for artifact in plan.artifacts(): + encoder = encoder.library(artifact.module_name, artifact.bytes, ...)? + encoder.validate(true).encode() ``` `embed_component_metadata` records how the core module's `(module, field)` @@ -293,11 +304,12 @@ that contract into the component world. ```text compile(program, target): cc = lower Typed Core to CC with ExternalBindings - (mir, wasi) = lower CC to MIR, resolving and validating WIT bindings + context = psrs_linker::resolve_default_definitions() + (mir, wasi) = lower CC to MIR over context's shared resolve wasm = structure MIR, synthesize the run entry, allocate indices core = encode_module(wasm) - (resolve, w) = command_world() - component = componentize(core, resolve, w) + plan = psrs_linker::plan(context, target requirements + artifacts) + component = psrs_linker::compose(context, plan, core) validate_all(component) with features from `target` wat = wasmprinter::print_bytes(component) return Artifact { wasm: component, wat } @@ -338,11 +350,17 @@ representation the imports ride on stays in [effects](../fp/effects.md). ```text -crates/psrs-backend/ +crates/psrs-runtime/ wit/psrs-app.wit wit/deps/ - src/ - component.rs + artifact/psrs_runtime.wasm +crates/psrs-linker/ + definitions.rs WIT loading and resolved-world context + plan.rs provider closure, memory and initialization planning + verify/ artifact contracts and emitted-plan agreement + compose.rs component assembly and final import closure +crates/psrs-backend/src/ + linking/ checked requirements and diagnostic mapping abi.rs abi/wasi.rs wasm/lower/mod.rs @@ -353,20 +371,15 @@ crates/psrs-driver/src/wasi.rs Responsibilities and required entry points: -- `component.rs` owns the application world and componentization. It must define - the `psrs:app` `command` world, the resolved interface set - `COMPONENT_INTERFACES`, the command entry name `RUN_CORE_EXPORT`, and the two - required entry points: - - `fn command_world() -> (Resolve, WorldId)`: load the vendored WASI 0.2.12 - WIT in dependency order and resolve `psrs:app` against it. - - `fn componentize(core: &[u8], resolve: &Resolve, world: WorldId) -> Result>`: - embed component metadata with `StringEncoding::UTF8`, lift the core module's - imports and exports, and validate the encoded component. The enabled service - set is the `psrs-app` `command` world: `wasi:io/error`, `wasi:io/poll`, - `wasi:io/streams`, `wasi:clocks/monotonic-clock`, `wasi:clocks/wall-clock`, - `wasi:random/random`, `wasi:random/insecure`, `wasi:random/insecure-seed`, - `wasi:cli/environment`, `wasi:cli/exit`, `wasi:cli/stdin`, - `wasi:cli/stdout`, `wasi:cli/stderr`, `wasi:filesystem/types`, +- `psrs-runtime/wit/` owns the `psrs:app` `command` world and the pinned WASI + 0.2.12 WIT; `psrs-linker` resolves it and owns componentization. The backend + `linking` module supplies the target policy and checked requirements and maps + link failures to source diagnostics. The enabled service set is the + `psrs-app` `command` world: `wasi:io/error`, `wasi:io/poll`, + `wasi:io/streams`, `wasi:clocks/monotonic-clock`, `wasi:clocks/wall-clock`, + `wasi:random/random`, `wasi:random/insecure`, `wasi:random/insecure-seed`, + `wasi:cli/environment`, `wasi:cli/exit`, `wasi:cli/stdin`, + `wasi:cli/stdout`, `wasi:cli/stderr`, `wasi:filesystem/types`, `wasi:filesystem/preopens`, `wasi:sockets/network`, `wasi:sockets/instance-network`, `wasi:sockets/udp`, `wasi:sockets/udp-create-socket`, `wasi:sockets/tcp`, and @@ -379,9 +392,10 @@ Responsibilities and required entry points: per-service host function. - `wasm/lower/mod.rs` must synthesize the `run` entry that calls `main`, passes the result to `wasi:cli/exit.exit-with-code`, and returns `0`. -- `lib.rs` must own the build pipeline: lower to CC, lower to MIR, structure, - encode, call `command_world` and `componentize`, validate with the target's - features, and return the component and its WAT form. +- `lib.rs` must own the build pipeline: lower to CC, lower to MIR over the + resolved-world context, structure, encode, build and check the target link + plan, compose, validate with the target's features, and return the component + and its WAT form. - The WASI library must be ordinary PureScript source resolved, type-checked, and linked like any other module. The driver loads it from `psrs-stdlib/lib` rather than embedding it, and defines `log`, `error`, `now`, `randomBytes`, @@ -389,15 +403,16 @@ Responsibilities and required entry points: `Prelude` must not import WASI. - `psrs-cli/src/main.rs` must expose `psrs build`, `psrs wat`, and `psrs dump`. -- `wit/psrs-app.wit` and `wit/deps/` own the vendored WASI 0.2.12 WIT sources. +- `psrs-runtime/wit/psrs-app.wit` and `psrs-runtime/wit/deps/` own the pinned + WASI 0.2.12 WIT sources. ## Invariants and verification The component test suite checks that the resolved application world imports -exactly `COMPONENT_INTERFACES` and only named interfaces, that a minimal core -module componentizes and validates, and, when `wasmtime` is available, that -`wasmtime run` executes the component. The build pipeline validates the encoded -component with the profile's features before returning it +only named interfaces, that a minimal core module composes and validates, and, +when `wasmtime` is available, that `wasmtime run` executes the component. The +build pipeline validates the encoded component with the profile's features +before returning it ([capability profile](capability-profile.md)). Observable behavior is checked by execution tests that run the component under the pinned runtime and compare standard output and the process exit code; structural validation alone is not @@ -413,7 +428,7 @@ produces the Canonical ABI call shown in [canonical ABI and WIT](canonical-abi-and-wit.md), and the string literal lives in a data segment ([linear memory boundary](linear-memory-and-canonical-abi-boundary.md)). The generated command wrapper runs the selected action once and returns zero. -`componentize` lifts the core module: the component imports +`compose` lifts the core module: the component imports `wasi:cli/stdout@0.2.12` and `wasi:io/streams@0.2.12` (plus their support interfaces) and exports `wasi:cli/run@0.2.12`. `wasmtime run hello.wasm` calls `run`, which writes `hello\n` and exits successfully. @@ -425,8 +440,8 @@ interfaces) and exports `wasi:cli/run@0.2.12`. `wasmtime run hello.wasm` calls - **Output:** a validated component artifact and its WAT form. - **To the ABI layer:** the world and the interface set it may import; a service outside the world is rejected before MIR emits a call. -- **To the driver:** `command_world` and `componentize`; the CLI writes the - artifact and the WAT form. +- **To the driver:** the compiled component artifact; the CLI writes the + artifact and the WAT form. WIT loading and composition live in `psrs-linker`. ## Open questions and future work diff --git a/docs/feature/F-02-portable-programs.md b/docs/feature/F-02-portable-programs.md index 893f5292..687d1ae7 100644 --- a/docs/feature/F-02-portable-programs.md +++ b/docs/feature/F-02-portable-programs.md @@ -1,7 +1,8 @@ # F-02 — Build Portable Program Artifacts **Status:** In progress -**Design:** [wasm encoding — Wasm Lowering](../design/backend/wasm/encoding-and-structuring.md) +**Design:** [wasm encoding — Wasm Lowering](../design/backend/wasm/encoding-and-structuring.md), +[linking and runtime (Draft)](../design/backend/wasm/linking-and-runtime.md) ## User need diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index 89a15b5b..5aa9af87 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -338,7 +338,8 @@ EF-09: Gaps: direct lexical reference restriction is not capability isolation; a runner passed from the selected entry to a helper may be invoked there. EF-10: - Implementation: crates/psrs-backend/src/component.rs, + Implementation: crates/psrs-backend/src/linking/mod.rs, + crates/psrs-linker/src/compose.rs, crates/psrs-backend/src/wasm/lower/mod.rs (entry wrapper), crates/psrs-driver/src/tests/effects.rs (component execution) Tests: every executed test above runs the produced component under diff --git a/docs/implementation/backend/linear-memory-and-canonical-abi.md b/docs/implementation/backend/linear-memory-and-canonical-abi.md index 743b07e9..893a2f85 100644 --- a/docs/implementation/backend/linear-memory-and-canonical-abi.md +++ b/docs/implementation/backend/linear-memory-and-canonical-abi.md @@ -263,7 +263,7 @@ ABI-06: ```text ABI-07: - Implementation: crates/psrs-backend/src/component.rs (wit-component lift). + Implementation: crates/psrs-linker/src/compose.rs (wit-component lift). Tests: psrs-driver tests::integration::emits_a_wasi_command_component; tests::wasi::runs_main_as_a_wasi_component_when_wasmtime_is_available. Input boundary: encoded core module. diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md new file mode 100644 index 00000000..84882d75 --- /dev/null +++ b/docs/implementation/backend/linking-and-runtime.md @@ -0,0 +1,89 @@ +# Linking and Runtime Acceptance + +**Design:** [Linking and Runtime](../../design/backend/wasm/linking-and-runtime.md). +**Decision:** [DEC-18 (Accepted)](../../decision/DEC-18-unified-target-linking.md). +**Status:** Implemented for the core-Wasm formatter slice; guest WIT provider +composition remains unsupported. +**Recorded:** 2026-10-07; implementation evidence recorded 2026-10-07. + +This is the acceptance contract for unified target linking. The formatter slice +now carries one checked plan from requirement closure through artifact +verification, Wasm emission, and component assembly. Requirements marked +`Partial` have a recorded assumption or a narrower evidence scope; requirements +marked `Unverified` are not implemented. + +| ID | Requirement | Required evidence | Status | +| --- | --- | --- | --- | +| LK-01 | A checked language intrinsic selects one catalog implementation; raw ABI does not replace its scheme | Accepted use plus malformed source/Core operand/result rejection; registry and implementation identities agree | Verified (formatter) | +| LK-02 | Direct operations, generated helpers, artifact exports, and entry-generated imports participate in one requirement closure | Composed source/MIR examples, missing-provider rejection, unused implementation omission, initializer reachability | Verified (formatter) | +| LK-03 | Artifact signatures, digests, features, imports, exports, tables, and initialization match declared contracts | Valid artifact plus independently malformed signature, stale digest, unexpected import/feature/table/start and missing-export rejection | Verified | +| LK-04 | One immutable checked plan drives emission and component assembly | API and trace evidence; deliberately mismatched emitted imports/memory rejected; no late import-name provider selection | Verified | +| LK-05 | Shared memory reservations and allocator boundaries cannot overlap or overflow | Malformed ranges/bounds rejected; runtime formatting interleaved with WASI allocation, output and memory growth | Verified (formatter); memory growth not exercised | +| LK-06 | Formatter output is recovered into a GC String before temporary bytes are released | Retain earlier strings across many later formats and WASI calls, asserting exact contents; bounded buffer reuse evidence | Verified (formatter) | +| LK-07 | Runtime stack use fits its declared region under supported calling behavior | Recorded static bound or reviewed pinned-build assumption with stress evidence; unsupported reentrancy/initialization explicitly rejected | Partial: reviewed bound and sequential stress recorded; reentrancy not rejected | +| LK-08 | Instantiation closes function/memory dependencies before execution | Run a legitimate shim cycle; reject unresolved/eager initializer cycles; inspect that private runtime imports are absent from the final external world | Verified (formatter) | +| LK-09 | WIT definition resolution and executable provider selection remain separate | A definition-only package does not satisfy a live import; pinned host/guest binding selection, version/provider conflicts and missing exports tested | Unverified: guest providers unsupported | +| LK-10 | Guest WIT composition preserves provider memory, canonical ownership and resource identity | Cross-component string/list/result execution, post-return/free behavior, resource constructor/method/destructor coherence; incompatible providers rejected | Unverified: guest providers unsupported | +| LK-11 | The external world contains exactly permitted residual host capabilities | Used/unused service tests, guest transitive host dependency tests, disallowed capability and silent-fallback rejection | Partial: world membership, target-profile gating, and private-import closure checked; exact planned-set equality and guest transitive deps pending | +| LK-12 | Runtime artifact regeneration and compile lineage are reproducible | Pinned source/dependency/toolchain/recipe manifest, artifact hashes, repeat-build agreement, plan inputs and selected providers recorded in diagnosis | Partial: provenance/digest and plan lineage recorded; repeat-build agreement pending | +| LK-13 | Public Show executes with official semantics and preserved pure source/API | Pinned official source audit and JS oracle for Int, Number, Char, String, arrays and callback order; mandatory Wasmtime with byte-exact outputs | Partial: Wasmtime byte-exact Show set verified; library JS oracle external | +| LK-14 | Runtime owns one WIT/artifact catalog; linker owns definition resolution; backend owns source/ABI validation | Move pinned WIT/default-world assets without byte drift; ABI lookup and composition use one resolved context; reject pin drift; no compiler dependencies or formatter code in metadata-only consumption | Verified | +| LK-15 | Independent linker crate consumes target records without compiler IR dependencies | Dependency-graph audit; target-only plan/composition tests; backend request conversion and source-diagnostic attribution; no MIR/backend/HIR/Core types in linker APIs | Verified | + +## Formatter behavior cases + +The library-owned oracle must cover signed-i32 extrema; negative zero; finite, +NaN and infinite Number values; notation boundaries and neighboring values; +subnormal/minimum/maximum binary64 values; shortest-decimal tie choices; named +and decimal control escapes; decimal-escape termination before digits; quote and +backslash escaping; Unicode scalars/UTF-8; empty and nested arrays; and ordinary +callback order/multiplicity. Include mixed use with console output and retained +strings so a correct token alone cannot hide an incorrect memory boundary. + +Use `psrs-stdlib/conformance/` and its public executable-based runner for official +JS comparisons. Compiler regression tests additionally cover malformed Core, +MIR, raw artifacts, plans, and component contracts. Source import acceptance, +Wasm validation, execution, and official oracle agreement are separate evidence. + +## Evidence + +- `psrs-linker` target-only unit and integration tests: artifact contract + verification (`verify::tests`), definition resolution (`definitions::tests`), + provider closure/memory planning and target-policy gating (`tests/plan.rs`), + and composition (`tests/compose.rs`). +- `psrs-runtime` formatter token tests and catalog digest. +- `psrs-backend` `mir::number_format_tests::formats_a_number_through_the_runtime_artifact` + executes the formatter artifact through the checked plan under Wasmtime and + asserts the initialized token length through the command exit code. +- `psrs-driver` `tests::show::show_renders_the_instances_the_corpus_prints` + executes `Data.Show` under Wasmtime and asserts byte-exact stdout across Int, + Number (including `1e+21` and `1e-5`), Char, String escapes, unit, booleans, + and arrays, interleaving formatting with WASI output and retained strings. + `tests::show::formats_many_numbers_without_exhausting_the_runtime_stack` + formats a 64-element Number array through the same private stack region. + Memory growth is not exercised; the application allocator is pre-sized by the + plan. +- `psrs-driver` `tests::diagnosis_trace::target_plan_records_provider_and_memory_lineage` + and `tests::show::formatter_plan_records_the_pinned_artifact_digest` assert the + compile diagnosis records the selected providers, artifact digests, memory + boundary, and planned external world. +- Workspace validation: `cargo fmt --all --check`, `cargo clippy --workspace + --all-targets -- -D warnings`, and `cargo test --workspace` (with + `PSRS_STDLIB_ROOT` for the dirty stdlib checkout). One pre-existing + `psrs-resolve` unit failure reproduces at `HEAD`. + +## Current continuation state + +The formatter slice is implemented and verified to the extent above. Remaining +work: + +- A measured runtime stack bound or an explicit rejection of reentrant calling + for the formatter (LK-07). +- Repeat-build agreement for the artifact provenance (LK-12). +- The library-owned official `Show` oracle and source/API audit (LK-13), in + `psrs-stdlib`. +- Guest WIT provider loading, resource identity, and composition (LK-09..LK-11), + including the shared allocator and explicit instantiation steps a second + artifact would need. + +Do not label the overall topic complete after only the formatter slice. diff --git a/docs/implementation/backend/wasi-platform.md b/docs/implementation/backend/wasi-platform.md index 1fd18a61..225b286e 100644 --- a/docs/implementation/backend/wasi-platform.md +++ b/docs/implementation/backend/wasi-platform.md @@ -66,9 +66,11 @@ Revision: `81b2eee` plus the DEC-10 re-verification in this worktree. Runtime: ```text WASI-01: - Implementation: crates/psrs-backend/src/component.rs. - Tests: component::tests::{componentizes_a_command_exporting_run, - component_world_matches_the_capability_profile}; + Implementation: crates/psrs-linker/src/compose.rs, + crates/psrs-runtime/wit/. + Tests: psrs-linker tests/compose.rs::composition_attaches_the_library_and_closes_the_private_import, + tests/plan.rs; + psrs-backend mir::number_format_tests::formats_a_number_through_the_runtime_artifact; psrs-driver tests::integration::emits_a_wasi_command_component. Input boundary: encoded core module. Commands: cargo test -p psrs-backend component; From 129e6e385e8cdd84826291d43b3985bdeb753f01 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 06:27:33 +0800 Subject: [PATCH 055/148] Measure the runtime stack bound and check artifact reproducibility - Replace the reviewed formatter stack assumption with a static call-graph frame analysis in `psrs-linker::measure_stack_bound`. `verify_artifact` computes the bound from the real bytes and requires the declared contract to cover it; a recursive graph or an indirect/imported call is rejected. The pinned artifact measures 160 bytes, and a test keeps the declared bound and the analysis in agreement. - Add `ArtifactKind::Component` and reject guest component providers explicitly, so an unsupported provider fails closed instead of silently falling back to a host interface. - Add `tools/check-reproducible.sh`, which rebuilds the artifact and requires it to reproduce the committed bytes, and record the stack bound in the plan lineage. - Add LK-09 tests for version-pin drift and definition-only providers. - Update the acceptance record: LK-07 and LK-12 become Verified, LK-09 becomes Partial, and a status legend explains the `Verified (formatter)` scope. --- crates/psrs-backend/src/pipeline/emission.rs | 12 + crates/psrs-linker/src/lib.rs | 2 + crates/psrs-linker/src/runtime.rs | 1 + crates/psrs-linker/src/stack.rs | 217 ++++++++++++++++++ crates/psrs-linker/src/target.rs | 9 +- crates/psrs-linker/src/verify/mod.rs | 38 ++- crates/psrs-linker/src/verify/tests.rs | 19 +- crates/psrs-linker/tests/plan.rs | 24 ++ crates/psrs-runtime/src/catalog.rs | 7 +- .../psrs-runtime/tools/check-reproducible.sh | 21 ++ .../backend/wasm/linking-and-runtime.md | 10 +- .../backend/linking-and-runtime.md | 45 ++-- 12 files changed, 371 insertions(+), 34 deletions(-) create mode 100644 crates/psrs-linker/src/stack.rs create mode 100755 crates/psrs-runtime/tools/check-reproducible.sh diff --git a/crates/psrs-backend/src/pipeline/emission.rs b/crates/psrs-backend/src/pipeline/emission.rs index 3bc5fdd8..88262a8d 100644 --- a/crates/psrs-backend/src/pipeline/emission.rs +++ b/crates/psrs-backend/src/pipeline/emission.rs @@ -253,6 +253,18 @@ fn annotate_plan(call: &mut crate::trace::TraceCall, link: &linking::LinkPlan) { .join(";"), ); call.add_parameter("external_world", plan.external_world().join(";")); + call.add_parameter( + "stack_bounds", + plan.artifacts() + .iter() + .filter_map(|artifact| { + artifact + .stack_bound_bytes + .map(|bound| format!("{}={bound}", artifact.id)) + }) + .collect::>() + .join(";"), + ); call.add_parameter("heap_start", plan.memory().heap_start.to_string()); call.add_parameter("minimum_pages", plan.memory().minimum_pages.to_string()); } diff --git a/crates/psrs-linker/src/lib.rs b/crates/psrs-linker/src/lib.rs index 5826611f..99590c9c 100644 --- a/crates/psrs-linker/src/lib.rs +++ b/crates/psrs-linker/src/lib.rs @@ -19,6 +19,7 @@ mod digest; mod error; pub mod plan; pub mod runtime; +mod stack; mod target; mod verify; @@ -27,6 +28,7 @@ pub use definitions::{ResolvedWorldContext, resolve_default_definitions, resolve pub use digest::sha256_hex; pub use error::{LinkError, LinkErrors, LinkStage}; pub use plan::{CheckedLinkPlan, MemoryPlan, ResolvedBinding, plan}; +pub use stack::{StackBound, measure_stack_bound}; pub use target::{ ArtifactContract, ArtifactKind, ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, diff --git a/crates/psrs-linker/src/runtime.rs b/crates/psrs-linker/src/runtime.rs index 24f2ff02..8bf91375 100644 --- a/crates/psrs-linker/src/runtime.rs +++ b/crates/psrs-linker/src/runtime.rs @@ -87,6 +87,7 @@ pub fn contract(artifact: &RuntimeArtifact) -> ArtifactContract { }, heap_start: artifact.storage.heap_start, minimum_pages: artifact.storage.minimum_pages, + stack_pointer_global: artifact.storage.stack_pointer_global, stack_bound_bytes: artifact.storage.stack_bound_bytes, stack_bound_evidence: artifact.storage.stack_bound_evidence.to_string(), }), diff --git a/crates/psrs-linker/src/stack.rs b/crates/psrs-linker/src/stack.rs new file mode 100644 index 00000000..7c6a83ce --- /dev/null +++ b/crates/psrs-linker/src/stack.rs @@ -0,0 +1,217 @@ +//! Static linear-stack bound analysis for a nonrecursive core artifact. +//! +//! Each function's prologue subtracts its frame size from the stack-pointer +//! global. The maximum bytes an artifact can use is the largest sum of frame +//! sizes along any call path. A call graph with a cycle is not a supported +//! artifact and is rejected rather than bounded. + +use wasmparser::{Operator, Parser, Payload}; + +/// A measured upper bound on linear-stack bytes. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct StackBound { + pub bytes: u32, +} + +/// Measures the static stack bound of a core module. +/// +/// `stack_pointer_global` is the mutable global whose prologue adjustment +/// reserves a frame. Indirect calls and calls into imported functions make the +/// bound unknown, so they are errors rather than silent under-approximations. +pub fn measure_stack_bound(bytes: &[u8], stack_pointer_global: u32) -> Result { + let mut frames = Vec::new(); + let mut callees = Vec::new(); + let mut imported_functions = 0_usize; + + for payload in Parser::new(0).parse_all(bytes) { + match payload.map_err(|error| error.to_string())? { + Payload::ImportSection(reader) => { + for import in reader.into_imports() { + if matches!( + import.map_err(|error| error.to_string())?.ty, + wasmparser::TypeRef::Func(_) + ) { + imported_functions += 1; + } + } + } + Payload::CodeSectionEntry(body) => { + let (frame, calls) = analyze_body(&body, stack_pointer_global)?; + frames.push(frame); + callees.push(calls); + } + _ => {} + } + } + + let count = frames.len(); + let mut memo = vec![None::; count]; + let mut visiting = vec![false; count]; + let mut bound = 0_u32; + for index in 0..count { + bound = bound.max(visit( + index, + &frames, + &callees, + &mut memo, + &mut visiting, + imported_functions, + )?); + } + Ok(StackBound { bytes: bound }) +} + +fn analyze_body( + body: &wasmparser::FunctionBody<'_>, + stack_pointer_global: u32, +) -> Result<(u32, Vec), String> { + let mut frame = 0_u32; + let mut calls = Vec::new(); + let mut pending_stack_pointer = false; + let mut pending_frame = None; + let mut operators = body + .get_operators_reader() + .map_err(|error| error.to_string())?; + while !operators.eof() { + match operators.read().map_err(|error| error.to_string())? { + Operator::GlobalGet { global_index } if global_index == stack_pointer_global => { + pending_stack_pointer = true; + pending_frame = None; + } + Operator::I32Const { value } if pending_stack_pointer => { + pending_frame = Some(value.max(0) as u32); + } + Operator::I32Sub if pending_stack_pointer => { + if let Some(value) = pending_frame.take() { + frame = frame.max(value); + } + } + Operator::Call { function_index } => { + calls.push(function_index); + pending_stack_pointer = false; + pending_frame = None; + } + Operator::ReturnCall { function_index } => { + calls.push(function_index); + pending_stack_pointer = false; + pending_frame = None; + } + Operator::CallIndirect { .. } | Operator::ReturnCallIndirect { .. } => { + return Err("an indirect call makes the stack bound unknown".into()); + } + _ => { + pending_stack_pointer = false; + pending_frame = None; + } + } + } + Ok((frame, calls)) +} + +fn visit( + index: usize, + frames: &[u32], + callees: &[Vec], + memo: &mut [Option], + visiting: &mut [bool], + imported_functions: usize, +) -> Result { + if let Some(value) = memo[index] { + return Ok(value); + } + if visiting[index] { + return Err("a recursive call graph is not a supported runtime library".into()); + } + visiting[index] = true; + let mut deepest = 0_u32; + for callee in &callees[index] { + let callee = *callee as usize; + if callee < imported_functions { + return Err("a call into an imported function makes the stack bound unknown".into()); + } + let defined = callee - imported_functions; + if defined < frames.len() { + deepest = deepest.max(visit( + defined, + frames, + callees, + memo, + visiting, + imported_functions, + )?); + } + } + visiting[index] = false; + let total = frames[index] + .checked_add(deepest) + .ok_or("stack bound overflows")?; + memo[index] = Some(total); + Ok(total) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn the_runtime_artifact_has_a_measured_static_bound() { + let bound = measure_stack_bound(psrs_runtime::NUMBER_FORMATTER.bytes, 0) + .expect("the formatter is nonrecursive"); + assert_eq!( + bound.bytes, + psrs_runtime::NUMBER_FORMATTER.storage.stack_bound_bytes, + "the declared stack bound must match the static analysis" + ); + } + + #[test] + fn a_recursive_graph_is_rejected() { + // Two mutually recursive functions, each reserving a frame. + let bytes = recursive_module(); + assert!(measure_stack_bound(&bytes, 0).is_err()); + } + + fn recursive_module() -> Vec { + use wasm_encoder::{ + CodeSection, Function, FunctionSection, GlobalSection, GlobalType, Instruction, Module, + TypeSection, ValType, + }; + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], []); + module.section(&types); + let mut functions = FunctionSection::new(); + functions.function(0); + functions.function(0); + module.section(&functions); + let mut globals = GlobalSection::new(); + globals.global( + GlobalType { + val_type: ValType::I32, + mutable: true, + shared: false, + }, + &wasm_encoder::ConstExpr::i32_const(1024), + ); + module.section(&globals); + let mut code = CodeSection::new(); + let mut first = Function::new([]); + first.instruction(&Instruction::GlobalGet(0)); + first.instruction(&Instruction::I32Const(32)); + first.instruction(&Instruction::I32Sub); + first.instruction(&Instruction::GlobalSet(0)); + first.instruction(&Instruction::Call(1)); + first.instruction(&Instruction::End); + code.function(&first); + let mut second = Function::new([]); + second.instruction(&Instruction::GlobalGet(0)); + second.instruction(&Instruction::I32Const(32)); + second.instruction(&Instruction::I32Sub); + second.instruction(&Instruction::GlobalSet(0)); + second.instruction(&Instruction::Call(0)); + second.instruction(&Instruction::End); + code.function(&second); + module.section(&code); + module.finish() + } +} diff --git a/crates/psrs-linker/src/target.rs b/crates/psrs-linker/src/target.rs index ad740f98..5beccce8 100644 --- a/crates/psrs-linker/src/target.rs +++ b/crates/psrs-linker/src/target.rs @@ -67,6 +67,9 @@ pub struct BindingRequirement { #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub enum ArtifactKind { CoreModule, + /// A guest component provider. Composition is not yet supported; the linker + /// rejects it rather than silently falling back to a host interface. + Component, } /// The kind of a declared artifact import. @@ -131,10 +134,12 @@ pub struct StorageContract { pub stack: StorageRegion, pub heap_start: u32, pub minimum_pages: u64, + /// The index of the mutable stack-pointer global the artifact uses. + pub stack_pointer_global: u32, /// A reviewed upper bound on stack bytes for the supported calling pattern. pub stack_bound_bytes: u32, - /// Where the stack bound comes from; a reviewed build assumption names its - /// pending stress evidence rather than claiming analysis that did not run. + /// Where the stack bound comes from; a measured static bound names the + /// analysis, while a reviewed build assumption names its pending evidence. pub stack_bound_evidence: String, } diff --git a/crates/psrs-linker/src/verify/mod.rs b/crates/psrs-linker/src/verify/mod.rs index 63576b2c..e1445622 100644 --- a/crates/psrs-linker/src/verify/mod.rs +++ b/crates/psrs-linker/src/verify/mod.rs @@ -22,6 +22,8 @@ pub struct VerifiedArtifact { pub sha256: String, pub bytes: Vec, pub instantiate_after_shims: bool, + /// The measured static stack bound, when the artifact declares storage. + pub stack_bound_bytes: Option, } /// Validates `bytes` against `contract`, returning the verified artifact. @@ -31,12 +33,15 @@ pub fn verify_artifact( ) -> Result { let stage = LinkStage::Verify; let id = &contract.id; - if contract.kind != ArtifactKind::CoreModule { - return Err(LinkErrors::one( - stage, - id, - "only core-module artifacts are supported", - )); + match contract.kind { + ArtifactKind::CoreModule => {} + ArtifactKind::Component => { + return Err(LinkErrors::one( + stage, + id, + "guest component providers are not yet supported; there is no silent host fallback", + )); + } } let digest = crate::sha256_hex(bytes); if digest != contract.sha256 { @@ -58,12 +63,33 @@ pub fn verify_artifact( LinkErrors::one(stage, id, format!("artifact is not valid Wasm: {error}")) })?; check_contract(contract, &parsed)?; + let stack_bound_bytes = match &contract.storage { + Some(storage) => { + let measured = crate::measure_stack_bound(bytes, storage.stack_pointer_global) + .map_err(|message| { + LinkErrors::one(stage, id, format!("stack analysis failed: {message}")) + })?; + if measured.bytes > storage.stack_bound_bytes { + return Err(LinkErrors::one( + stage, + id, + format!( + "artifact stack use {} exceeds its declared {} bytes", + measured.bytes, storage.stack_bound_bytes + ), + )); + } + Some(measured.bytes) + } + None => None, + }; Ok(VerifiedArtifact { id: contract.id.clone(), module_name: contract.module_name.clone(), sha256: digest, bytes: bytes.to_vec(), instantiate_after_shims: contract.instantiate_after_shims, + stack_bound_bytes, }) } diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index 70412058..b1eaf528 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -71,8 +71,11 @@ fn number_format_contract() -> ArtifactContract { }, heap_start: psrs_runtime::HEAP_START, minimum_pages: 3, - stack_bound_bytes: 4096, - stack_bound_evidence: "reviewed pinned build assumption; stress evidence pending" + stack_pointer_global: 0, + stack_bound_bytes: psrs_runtime::NUMBER_FORMATTER.storage.stack_bound_bytes, + stack_bound_evidence: psrs_runtime::NUMBER_FORMATTER + .storage + .stack_bound_evidence .into(), }), initialization: InitializationContract { @@ -90,6 +93,18 @@ fn embedded_artifact_satisfies_its_contract() { .expect("the pinned artifact should verify"); } +#[test] +fn a_guest_component_provider_is_rejected_without_a_host_fallback() { + let mut contract = number_format_contract(); + contract.kind = ArtifactKind::Component; + let error = verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + .expect_err("guest components are not composable yet"); + assert!( + error.to_string().contains("no silent host fallback"), + "{error}" + ); +} + #[test] fn a_stale_digest_is_rejected() { let mut contract = number_format_contract(); diff --git a/crates/psrs-linker/tests/plan.rs b/crates/psrs-linker/tests/plan.rs index dea0be60..0cccb404 100644 --- a/crates/psrs-linker/tests/plan.rs +++ b/crates/psrs-linker/tests/plan.rs @@ -183,6 +183,30 @@ fn a_world_interface_disabled_by_the_target_profile_is_rejected() { ); } +#[test] +fn a_different_world_version_does_not_satisfy_a_pinned_import() { + let context = resolve_default_definitions().unwrap(); + let requirement = BindingRequirement { + id: RequirementId(0), + origin: "wasi:cli/stdout@0.2.11.get-stdout".into(), + boundary: Boundary::ResolvedWit { + interface: "wasi:cli/stdout@0.2.11".into(), + function: "get-stdout".into(), + }, + expected: Some(CoreSignature { + parameters: Vec::new(), + result: Some(CoreType::I32), + }), + provider: Provider::HostInterface { + interface: "wasi:cli/stdout@0.2.11".into(), + }, + }; + assert!( + plan(&context, input(vec![requirement], Vec::new())).is_err(), + "a pinned import version must match the resolved world exactly" + ); +} + #[test] fn a_reservation_overlapping_canonical_state_is_rejected() { let context = resolve_default_definitions().unwrap(); diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index 861c3cf4..87dcf3e8 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -113,6 +113,8 @@ pub struct RawStorage { pub stack: (u32, u32), pub heap_start: u32, pub minimum_pages: u64, + /// The mutable stack-pointer global the artifact uses. + pub stack_pointer_global: u32, /// A reviewed upper bound on stack bytes for supported calling behavior. pub stack_bound_bytes: u32, /// Where the bound comes from, including pending evidence. @@ -185,8 +187,9 @@ pub const NUMBER_FORMATTER: RuntimeArtifact = RuntimeArtifact { stack: (crate::STACK_BOTTOM, crate::HEAP_START), heap_start: crate::HEAP_START, minimum_pages: 3, - stack_bound_bytes: 4096, - stack_bound_evidence: "reviewed pinned nonrecursive build assumption; stress evidence pending", + stack_pointer_global: 0, + stack_bound_bytes: 160, + stack_bound_evidence: "static call-graph frame analysis of the pinned artifact (psrs-linker::measure_stack_bound)", }, start_forbidden: true, data_range: (crate::RESERVED_START, crate::STACK_BOTTOM), diff --git a/crates/psrs-runtime/tools/check-reproducible.sh b/crates/psrs-runtime/tools/check-reproducible.sh new file mode 100755 index 00000000..4239f1a9 --- /dev/null +++ b/crates/psrs-runtime/tools/check-reproducible.sh @@ -0,0 +1,21 @@ +#!/bin/sh +# Rebuilds the runtime artifact and checks that it reproduces the committed +# bytes. A mismatch means the reviewed provenance digest must be updated +# explicitly; this check never rewrites the artifact. +set -eu +cd "$(dirname "$0")/../../.." +tmp=$(mktemp -d) +trap 'rm -rf "$tmp"' EXIT +cargo rustc --locked -p psrs-runtime --lib --no-default-features --features formatter \ + --target wasm32-unknown-unknown --profile target-runtime -- \ + -C link-arg=--import-memory -C link-arg=--global-base=65536 \ + -C link-arg=-zstack-size=65536 -C link-arg=--export=__heap_base +cargo run --locked -p psrs-runtime --example package -- \ + target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ + "$tmp/psrs_runtime.wasm" +if cmp -s "$tmp/psrs_runtime.wasm" crates/psrs-runtime/artifact/psrs_runtime.wasm; then + echo "runtime artifact reproduces byte-for-byte" +else + echo "runtime artifact differs from the committed bytes; update the reviewed provenance" >&2 + exit 1 +fi diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index ff907f9d..98dc66b1 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -474,10 +474,12 @@ are not yet selected. Their ownership and checked-plan obligations are defined above; general component loading remains unsupported until that entry point and its verification exist. Do not imply a new supported CLI flag in documentation. -Runtime stack-bound evidence and the exact artifact-provenance representation -must be settled before accepting the formatter implementation. Relocatable -object files, dynamic loading, async/WASI 0.3 composition, recursive or reentrant -runtime libraries, and cross-module GC sharing require explicit extensions. +The runtime stack bound is measured by a static call-graph analysis of the +pinned nonrecursive artifact, and the artifact-provenance representation is +settled as a catalog record; repeat builds are checked against the committed +bytes. Relocatable object files, dynamic loading, async/WASI 0.3 composition, +recursive or reentrant runtime libraries, and cross-module GC sharing require +explicit extensions. Existing WIT/WASI binding code precedes this plan model. The formatter slice now carries one checked plan from requirement closure through artifact verification, diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index 84882d75..ce7e3d9b 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -8,9 +8,15 @@ composition remains unsupported. This is the acceptance contract for unified target linking. The formatter slice now carries one checked plan from requirement closure through artifact -verification, Wasm emission, and component assembly. Requirements marked -`Partial` have a recorded assumption or a narrower evidence scope; requirements -marked `Unverified` are not implemented. +verification, Wasm emission, and component assembly. + +Status vocabulary: + +- `Verified` — the requirement is established for the supported target contract. +- `Verified (formatter)` — established only for the core-Wasm formatter slice; + the general contract, in particular guest WIT providers, is not covered. +- `Partial` — a recorded subset or assumption; the named evidence is missing. +- `Unverified` — not implemented. | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | @@ -20,12 +26,12 @@ marked `Unverified` are not implemented. | LK-04 | One immutable checked plan drives emission and component assembly | API and trace evidence; deliberately mismatched emitted imports/memory rejected; no late import-name provider selection | Verified | | LK-05 | Shared memory reservations and allocator boundaries cannot overlap or overflow | Malformed ranges/bounds rejected; runtime formatting interleaved with WASI allocation, output and memory growth | Verified (formatter); memory growth not exercised | | LK-06 | Formatter output is recovered into a GC String before temporary bytes are released | Retain earlier strings across many later formats and WASI calls, asserting exact contents; bounded buffer reuse evidence | Verified (formatter) | -| LK-07 | Runtime stack use fits its declared region under supported calling behavior | Recorded static bound or reviewed pinned-build assumption with stress evidence; unsupported reentrancy/initialization explicitly rejected | Partial: reviewed bound and sequential stress recorded; reentrancy not rejected | +| LK-07 | Runtime stack use fits its declared region under supported calling behavior | Recorded static bound or reviewed pinned-build assumption with stress evidence; unsupported reentrancy/initialization explicitly rejected | Verified (formatter): static call-graph bound plus recursion rejection and stress | | LK-08 | Instantiation closes function/memory dependencies before execution | Run a legitimate shim cycle; reject unresolved/eager initializer cycles; inspect that private runtime imports are absent from the final external world | Verified (formatter) | -| LK-09 | WIT definition resolution and executable provider selection remain separate | A definition-only package does not satisfy a live import; pinned host/guest binding selection, version/provider conflicts and missing exports tested | Unverified: guest providers unsupported | +| LK-09 | WIT definition resolution and executable provider selection remain separate | A definition-only package does not satisfy a live import; pinned host/guest binding selection, version/provider conflicts and missing exports tested | Partial: host selection, version/conflict, definition-only and explicit guest fail-closed verified; guest binding selection pending | | LK-10 | Guest WIT composition preserves provider memory, canonical ownership and resource identity | Cross-component string/list/result execution, post-return/free behavior, resource constructor/method/destructor coherence; incompatible providers rejected | Unverified: guest providers unsupported | -| LK-11 | The external world contains exactly permitted residual host capabilities | Used/unused service tests, guest transitive host dependency tests, disallowed capability and silent-fallback rejection | Partial: world membership, target-profile gating, and private-import closure checked; exact planned-set equality and guest transitive deps pending | -| LK-12 | Runtime artifact regeneration and compile lineage are reproducible | Pinned source/dependency/toolchain/recipe manifest, artifact hashes, repeat-build agreement, plan inputs and selected providers recorded in diagnosis | Partial: provenance/digest and plan lineage recorded; repeat-build agreement pending | +| LK-11 | The external world contains exactly permitted residual host capabilities | Used/unused service tests, guest transitive host dependency tests, disallowed capability and silent-fallback rejection | Partial: world membership, target-profile gating, private-import closure, and guest fail-closed verified; exact planned-set equality and guest transitive deps pending | +| LK-12 | Runtime artifact regeneration and compile lineage are reproducible | Pinned source/dependency/toolchain/recipe manifest, artifact hashes, repeat-build agreement, plan inputs and selected providers recorded in diagnosis | Verified: provenance, plan lineage, and `tools/check-reproducible.sh` byte agreement | | LK-13 | Public Show executes with official semantics and preserved pure source/API | Pinned official source audit and JS oracle for Int, Number, Char, String, arrays and callback order; mandatory Wasmtime with byte-exact outputs | Partial: Wasmtime byte-exact Show set verified; library JS oracle external | | LK-14 | Runtime owns one WIT/artifact catalog; linker owns definition resolution; backend owns source/ABI validation | Move pinned WIT/default-world assets without byte drift; ABI lookup and composition use one resolved context; reject pin drift; no compiler dependencies or formatter code in metadata-only consumption | Verified | | LK-15 | Independent linker crate consumes target records without compiler IR dependencies | Dependency-graph audit; target-only plan/composition tests; backend request conversion and source-diagnostic attribution; no MIR/backend/HIR/Core types in linker APIs | Verified | @@ -48,10 +54,13 @@ Wasm validation, execution, and official oracle agreement are separate evidence. ## Evidence - `psrs-linker` target-only unit and integration tests: artifact contract - verification (`verify::tests`), definition resolution (`definitions::tests`), - provider closure/memory planning and target-policy gating (`tests/plan.rs`), - and composition (`tests/compose.rs`). -- `psrs-runtime` formatter token tests and catalog digest. + verification and the measured stack bound (`verify::tests`, `stack::tests`), + definition resolution (`definitions::tests`), provider closure, target-policy + gating, version-pin drift and memory planning (`tests/plan.rs`), and + composition (`tests/compose.rs`). +- `psrs-runtime` formatter token tests, catalog digest, and + `tools/check-reproducible.sh`, which rebuilds the artifact and requires it to + reproduce the committed bytes. - `psrs-backend` `mir::number_format_tests::formats_a_number_through_the_runtime_artifact` executes the formatter artifact through the checked plan under Wasmtime and asserts the initialized token length through the command exit code. @@ -66,7 +75,7 @@ Wasm validation, execution, and official oracle agreement are separate evidence. - `psrs-driver` `tests::diagnosis_trace::target_plan_records_provider_and_memory_lineage` and `tests::show::formatter_plan_records_the_pinned_artifact_digest` assert the compile diagnosis records the selected providers, artifact digests, memory - boundary, and planned external world. + boundary, stack bounds, and planned external world. - Workspace validation: `cargo fmt --all --check`, `cargo clippy --workspace --all-targets -- -D warnings`, and `cargo test --workspace` (with `PSRS_STDLIB_ROOT` for the dirty stdlib checkout). One pre-existing @@ -77,13 +86,13 @@ Wasm validation, execution, and official oracle agreement are separate evidence. The formatter slice is implemented and verified to the extent above. Remaining work: -- A measured runtime stack bound or an explicit rejection of reentrant calling - for the formatter (LK-07). -- Repeat-build agreement for the artifact provenance (LK-12). - The library-owned official `Show` oracle and source/API audit (LK-13), in `psrs-stdlib`. -- Guest WIT provider loading, resource identity, and composition (LK-09..LK-11), - including the shared allocator and explicit instantiation steps a second - artifact would need. +- Guest WIT provider binding selection, resource identity, and cross-component + composition (LK-09..LK-11). This needs a component-to-component linker; the + pinned `wit-component` exposes core-module linking only, so the linker rejects + guest component providers explicitly rather than falling back to a host + interface. It also needs the shared allocator and explicit instantiation steps + a second provider would require. Do not label the overall topic complete after only the formatter slice. From f1fe2d0839a8a329083ab3788d7c07c3c49ab875 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 06:29:53 +0800 Subject: [PATCH 056/148] Broaden the compiler-side Show boundary evidence MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Cover NaN, ±Infinity, negative zero, the 1e-6/1e-7 and 1e20 notation boundaries, the minimum subnormal, the empty array, and a nested array in a byte-exact Wasmtime test. The library-owned official JS oracle remains external to this checkout. --- crates/psrs-driver/src/tests/show.rs | 50 +++++++++++++++++++ .../backend/linking-and-runtime.md | 3 ++ 2 files changed, 53 insertions(+) diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index 1ed1024a..882761fe 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -127,6 +127,56 @@ main = let ignored = log (show 1.0e21) in 0 ); } +#[test] +fn show_covers_number_and_aggregate_boundaries() { + let source = r#" +module Main where + +import Prelude +import Effect.Console (log) + +checks :: Effect Unit +checks = do + log (show (0.0 / 0.0)) + log (show (1.0 / 0.0)) + log (show ((0.0 - 1.0) / 0.0)) + log (show (numberNeg 0.0)) + log (show 1.0e-6) + log (show 1.0e-7) + log (show 1.0e20) + log (show 5.0e-324) + log (show ([] :: Array Int)) + log (show [[1, 2], [3]]) + pure unit + +main = let ignored = runEffect checks in 0 +"#; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); + let stdout = String::from_utf8_lossy(&output.stdout); + let expected = concat!( + "NaN\n", + "Infinity\n", + "-Infinity\n", + "0.0\n", + "0.000001\n", + "1e-7\n", + "100000000000000000000.0\n", + "5e-324\n", + "[]\n", + "[[1,2],[3]]\n", + ); + assert_eq!( + stdout.as_ref(), + expected, + "stdout:\n{stdout}\nstderr:\n{}", + String::from_utf8_lossy(&output.stderr) + ); +} + #[test] fn formats_many_numbers_without_exhausting_the_runtime_stack() { // The formatter is nonrecursive; a large array of numbers calls its raw diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index ce7e3d9b..466528b2 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -68,6 +68,9 @@ Wasm validation, execution, and official oracle agreement are separate evidence. executes `Data.Show` under Wasmtime and asserts byte-exact stdout across Int, Number (including `1e+21` and `1e-5`), Char, String escapes, unit, booleans, and arrays, interleaving formatting with WASI output and retained strings. + `tests::show::show_covers_number_and_aggregate_boundaries` adds NaN, + ±Infinity, negative zero, the `1e-6`/`1e-7` and `1e20` notation boundaries, + the minimum subnormal, the empty array, and a nested array. `tests::show::formats_many_numbers_without_exhausting_the_runtime_stack` formats a 64-element Number array through the same private stack region. Memory growth is not exercised; the application allocator is pre-sized by the From 3ede6330c97cee97570d072b76f6339705c9aa70 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 07:57:25 +0800 Subject: [PATCH 057/148] Compose pinned guest interfaces through checked target plans Add synchronous whole-interface component composition with explicit provider pins, transitive dependency closure and a manifest-driven CLI entry point. Preserve canonical memory and resource ownership through the pinned in-memory composition graph. Verify application imports, memory initialization and WIT context against the core plan; derive exact residual imports through canonical signature projection and enforce the runtime stack frame protocol. Record the supported boundary and remaining obligations with focused execution evidence. --- Cargo.lock | 160 +++++++++++ crates/psrs-backend/src/abi/validation.rs | 18 +- crates/psrs-backend/src/capability.rs | 23 +- crates/psrs-backend/src/linking/mod.rs | 29 -- crates/psrs-backend/src/mir/gc_tests/mod.rs | 9 +- crates/psrs-backend/src/mir/opt/imports.rs | 77 ++++- crates/psrs-backend/src/mir/tests.rs | 10 +- crates/psrs-backend/src/wasm/lower/mod.rs | 47 ++-- .../lower/post_return/tests/composition.rs | 45 +++ .../post_return/{tests.rs => tests/mod.rs} | 61 ++-- .../src/wasm/lower/realloc/block.rs | 10 +- .../src/wasm/lower/realloc/tests.rs | 43 ++- crates/psrs-cli/Cargo.toml | 4 + crates/psrs-cli/src/build.rs | 145 ++++++++++ crates/psrs-cli/src/diagnose/mod.rs | 37 +++ crates/psrs-cli/src/link.rs | 160 +++++++++++ crates/psrs-cli/src/main.rs | 98 +------ crates/psrs-cli/tests/link.rs | 188 +++++++++++++ crates/psrs-driver/src/lib.rs | 1 + crates/psrs-driver/src/tests/show.rs | 21 ++ crates/psrs-driver/src/tests/wasi/mod.rs | 70 ++--- crates/psrs-linker/Cargo.toml | 6 + crates/psrs-linker/src/application.rs | 160 +++++++++++ crates/psrs-linker/src/closure.rs | 105 +++++++ crates/psrs-linker/src/compose.rs | 44 ++- crates/psrs-linker/src/definitions.rs | 108 +------ crates/psrs-linker/src/guest/graph.rs | 188 +++++++++++++ crates/psrs-linker/src/guest/mod.rs | 70 +++++ crates/psrs-linker/src/lib.rs | 3 + crates/psrs-linker/src/plan.rs | 58 +++- crates/psrs-linker/src/stack.rs | 265 ++++++++++++++++-- crates/psrs-linker/src/target.rs | 4 +- crates/psrs-linker/src/verify/mod.rs | 2 +- crates/psrs-linker/src/verify/parse.rs | 20 ++ crates/psrs-linker/src/verify/tests.rs | 72 ++++- crates/psrs-linker/tests/compose.rs | 84 ++++++ crates/psrs-linker/tests/guest/fixtures.rs | 173 ++++++++++++ crates/psrs-linker/tests/guest/mod.rs | 210 ++++++++++++++ crates/psrs-linker/tests/plan.rs | 79 ++++-- .../decision/DEC-18-unified-target-linking.md | 17 +- .../backend/wasm/linking-and-runtime.md | 86 ++++-- docs/feature/F-02-portable-programs.md | 26 +- .../backend/linking-and-runtime.md | 204 ++++++++++---- .../backend/linking-evidence/locked-show.json | 18 ++ docs/workflow/component-linking.md | 106 +++++++ stdlib.lock.json | 4 +- 46 files changed, 2878 insertions(+), 490 deletions(-) create mode 100644 crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs rename crates/psrs-backend/src/wasm/lower/post_return/{tests.rs => tests/mod.rs} (89%) create mode 100644 crates/psrs-cli/src/build.rs create mode 100644 crates/psrs-cli/src/link.rs create mode 100644 crates/psrs-cli/tests/link.rs create mode 100644 crates/psrs-linker/src/application.rs create mode 100644 crates/psrs-linker/src/closure.rs create mode 100644 crates/psrs-linker/src/guest/graph.rs create mode 100644 crates/psrs-linker/src/guest/mod.rs create mode 100644 crates/psrs-linker/tests/guest/fixtures.rs create mode 100644 crates/psrs-linker/tests/guest/mod.rs create mode 100644 docs/implementation/backend/linking-evidence/locked-show.json create mode 100644 docs/workflow/component-linking.md diff --git a/Cargo.lock b/Cargo.lock index c23029b7..152b6e47 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -41,6 +41,15 @@ version = "2.13.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "3ded4057c258ba199e2d26386d3af3780957ecaee6c4ef4041c6b4b8b97c0b06" +[[package]] +name = "bitmaps" +version = "2.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "031043d04099746d8db04daf1fa424b2bc8bd69d92b25962dcde24da39ab64a2" +dependencies = [ + "typenum", +] + [[package]] name = "block-buffer" version = "0.10.4" @@ -50,6 +59,12 @@ dependencies = [ "generic-array", ] +[[package]] +name = "bumpalo" +version = "3.20.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "72f5acc6cb2ba439de613abc23857ec3d78374d8ed5ac84e9d11336e87da8649" + [[package]] name = "cc" version = "1.4.7" @@ -117,6 +132,12 @@ version = "0.1.13" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "ef25905e51abafe4dcea6c15fec58c57b601cdbd0ee53d22ea1d3016c587d39b" +[[package]] +name = "fixedbitset" +version = "0.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0ce7134b9999ecaf8bcd65542e436736ef32ddca1b3e06094cb6ec5755203b80" + [[package]] name = "foldhash" version = "0.2.0" @@ -160,12 +181,32 @@ version = "0.17.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "ed5909b6e89a2db4456e54cd5f673791d7eca6732202bbf2a9cc504fe2f9b84a" +[[package]] +name = "heck" +version = "0.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" + [[package]] name = "id-arena" version = "2.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "3d3067d79b975e8844ca9eb072e16b31c3c1c36928edf9c6789548c524d0d954" +[[package]] +name = "im-rc" +version = "15.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "af1955a75fa080c677d3972822ec4bad316169ab1cfc6c257a942c2265dbe5fe" +dependencies = [ + "bitmaps", + "rand_core", + "rand_xoshiro", + "sized-chunks", + "typenum", + "version_check", +] + [[package]] name = "indexmap" version = "2.14.2" @@ -223,6 +264,16 @@ version = "1.21.4" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "9f7c3e4beb33f85d45ae3e3a1792185706c8e16d043238c593331cc7cd313b50" +[[package]] +name = "petgraph" +version = "0.6.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b4c5cc86750666a3ed20bdaf5ca2a0344f9c67674cae0515bec2da16fbaa47db" +dependencies = [ + "fixedbitset", + "indexmap", +] + [[package]] name = "proc-macro2" version = "1.0.107" @@ -274,11 +325,13 @@ dependencies = [ "psrs-ast", "psrs-driver", "psrs-hir", + "psrs-linker", "psrs-resolve", "psrs-span", "psrs-syntax", "serde", "serde_json", + "wat", ] [[package]] @@ -349,9 +402,11 @@ version = "0.1.0" dependencies = [ "psrs-runtime", "sha2", + "wasm-compose", "wasm-encoder", "wasmparser", "wasmprinter", + "wat", "wit-component", "wit-parser", ] @@ -419,6 +474,27 @@ dependencies = [ "proc-macro2", ] +[[package]] +name = "rand_core" +version = "0.6.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ec0be4795e2f6a28069bec0b5ff3e2ac9bafc99e6a9a7dc3547996c5c816922c" + +[[package]] +name = "rand_xoshiro" +version = "0.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6f97cdb2a36ed4183de61b2f824cc45c9f1037f28afe0a322e9fff4c108b5aaa" +dependencies = [ + "rand_core", +] + +[[package]] +name = "ryu" +version = "1.0.23" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9774ba4a74de5f7b1c1451ed6cd5285a32eddb5cccb8cc655a4e50009e06477f" + [[package]] name = "ryu-js" version = "1.0.2" @@ -474,6 +550,19 @@ dependencies = [ "zmij", ] +[[package]] +name = "serde_yaml" +version = "0.9.34+deprecated" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6a8b1a1a2ebf674015cc02edccce75287f1a0130d394307b36743c2f5d504b47" +dependencies = [ + "indexmap", + "itoa", + "ryu", + "serde", + "unsafe-libyaml", +] + [[package]] name = "sha2" version = "0.10.9" @@ -491,6 +580,22 @@ version = "2.0.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "f8fadd59c855ef2080decdef8ff161eb6661b86933c9d82e5ba29dc602a55aba" +[[package]] +name = "sized-chunks" +version = "0.6.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "16d69225bde7a69b235da73377861095455d298f2b970996eec25ddbb42b3d1e" +dependencies = [ + "bitmaps", + "typenum", +] + +[[package]] +name = "smallvec" +version = "1.16.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f9395f0f0eee849a9b707b2f06bb92a6a422090e2123bb2ef8e87a0e61892a8e" + [[package]] name = "stacker" version = "0.1.25" @@ -547,18 +652,51 @@ version = "1.0.26" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "d245f478577f809a851594d02313b640fb437e0bb33866753cff937863096954" +[[package]] +name = "unicode-width" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b4ac048d71ede7ee76d585517add45da530660ef4390e49b098733c6e897f254" + [[package]] name = "unicode-xid" version = "0.2.6" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "ebc1c04c71510c7f702b52b7c350734c9ff1295c464a03335b00bb84fc54f853" +[[package]] +name = "unsafe-libyaml" +version = "0.2.11" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "673aac59facbab8a9007c7f6108d11f63b603f7cabff99fabf650fea5c32b861" + [[package]] name = "version_check" version = "0.9.5" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" +[[package]] +name = "wasm-compose" +version = "0.245.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5fd23d12cc95c451c1306db5bc63075fbebb612bb70c53b4237b1ce5bc178343" +dependencies = [ + "anyhow", + "heck", + "im-rc", + "indexmap", + "log", + "petgraph", + "serde", + "serde_derive", + "serde_yaml", + "smallvec", + "wasm-encoder", + "wasmparser", + "wat", +] + [[package]] name = "wasm-encoder" version = "0.245.1" @@ -605,6 +743,28 @@ dependencies = [ "wasmparser", ] +[[package]] +name = "wast" +version = "245.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "28cf1149285569120b8ce39db8b465e8a2b55c34cbb586bd977e43e2bc7300bf" +dependencies = [ + "bumpalo", + "leb128fmt", + "memchr", + "unicode-width", + "wasm-encoder", +] + +[[package]] +name = "wat" +version = "1.245.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cd48d1679b6858988cb96b154dda0ec5bbb09275b71db46057be37332d5477be" +dependencies = [ + "wast", +] + [[package]] name = "winapi-util" version = "0.1.11" diff --git a/crates/psrs-backend/src/abi/validation.rs b/crates/psrs-backend/src/abi/validation.rs index 1d6610dc..e34a4954 100644 --- a/crates/psrs-backend/src/abi/validation.rs +++ b/crates/psrs-backend/src/abi/validation.rs @@ -137,21 +137,5 @@ pub(super) fn enum_cases( } pub(crate) fn wasi_interface_enabled(target: TargetCapabilities, module: &str) -> bool { - let package_path = module - .split_once('/') - .map_or(module, |(package, _)| package); - let package = package_path - .split_once('@') - .map_or(package_path, |(package, _)| package); - match package { - "wasi:cli" => target.wasi_cli, - "wasi:io" => target.wasi_io, - "wasi:clocks" => target.wasi_clocks, - "wasi:random" => target.wasi_random, - "wasi:filesystem" => target.wasi_filesystem, - "wasi:sockets" => target.wasi_sockets, - "wasi:http" => target.wasi_http, - "wasi:tls" => target.wasi_tls, - _ => false, - } + target.wasi_interface_enabled(module) } diff --git a/crates/psrs-backend/src/capability.rs b/crates/psrs-backend/src/capability.rs index 735f45f7..129083e1 100644 --- a/crates/psrs-backend/src/capability.rs +++ b/crates/psrs-backend/src/capability.rs @@ -92,8 +92,29 @@ impl TargetCapabilities { } } + /// Whether the selected profile permits a WASI interface family. + pub fn wasi_interface_enabled(self, module: &str) -> bool { + let package_path = module + .split_once('/') + .map_or(module, |(package, _)| package); + let package = package_path + .split_once('@') + .map_or(package_path, |(package, _)| package); + match package { + "wasi:cli" => self.wasi_cli, + "wasi:io" => self.wasi_io, + "wasi:clocks" => self.wasi_clocks, + "wasi:random" => self.wasi_random, + "wasi:filesystem" => self.wasi_filesystem, + "wasi:sockets" => self.wasi_sockets, + "wasi:http" => self.wasi_http, + "wasi:tls" => self.wasi_tls, + _ => false, + } + } + /// Converts the profile to the validator feature set. - pub(crate) fn wasm_features(self) -> wasmparser::WasmFeatures { + pub fn wasm_features(self) -> wasmparser::WasmFeatures { use wasmparser::WasmFeatures; let mut features = WasmFeatures::MVP; diff --git a/crates/psrs-backend/src/linking/mod.rs b/crates/psrs-backend/src/linking/mod.rs index 6c27e3ed..368543a8 100644 --- a/crates/psrs-backend/src/linking/mod.rs +++ b/crates/psrs-backend/src/linking/mod.rs @@ -303,32 +303,3 @@ fn attach(error: BackendError, owner: Option) -> BackendError { None => error, } } - -#[cfg(test)] -pub(crate) fn empty_plan(context: &ResolvedWorldContext) -> CheckedLinkPlan { - psrs_linker::plan( - context, - TargetLinkInput { - requirements: Vec::new(), - artifacts: Vec::new(), - policy: TargetPolicy::default(), - memory: memory_demand(), - }, - ) - .expect("an empty plan is valid") -} - -#[cfg(test)] -pub(crate) fn compose_core(core: &[u8]) -> Result, String> { - let context = default_context().map_err(|errors| { - errors - .into_iter() - .map(|error| error.message) - .collect::>() - .join("; ") - })?; - let plan = empty_plan(&context); - psrs_linker::compose(&context, &plan, core) - .map(|artifact| artifact.bytes) - .map_err(|errors| errors.to_string()) -} diff --git a/crates/psrs-backend/src/mir/gc_tests/mod.rs b/crates/psrs-backend/src/mir/gc_tests/mod.rs index f493a80f..83d10c68 100644 --- a/crates/psrs-backend/src/mir/gc_tests/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/mod.rs @@ -39,7 +39,10 @@ fn run_gc(mir: &crate::mir::Module, expected_code: i32) { fn run_gc_output(mir: &crate::mir::Module) -> Option { let target = crate::TargetCapabilities::default(); let mut wasi = wasi(); - let wasm = crate::wasm::lower_module_with_capabilities(mir, &mut wasi, target) + let context = crate::linking::default_context().expect("default target context"); + let link = crate::linking::plan_for_module(&context, mir, &mut wasi, target) + .expect("checked GC target plan"); + let wasm = crate::wasm::lower_module_with_plan(mir, &mut wasi, target, &link) .expect("the GC MIR should lower to Wasm"); let core = crate::wasm::encode_module(&wasm).expect("encoding GC Wasm"); crate::validator_for(target) @@ -63,7 +66,9 @@ fn run_gc_output(mir: &crate::mir::Module) -> Option { eprintln!("skipping: wasmtime is unusable"); return None; } - let component = crate::linking::compose_core(&core).expect("componentizing the GC module"); + let component = + crate::linking::compose(&link, &core, mir.span, mir.entry.map(|entry| entry.module)) + .expect("componentizing the GC module"); let path = std::env::temp_dir().join(format!( "psrs-gc-{}-{}.wasm", std::process::id(), diff --git a/crates/psrs-backend/src/mir/opt/imports.rs b/crates/psrs-backend/src/mir/opt/imports.rs index 267517c9..072db211 100644 --- a/crates/psrs-backend/src/mir/opt/imports.rs +++ b/crates/psrs-backend/src/mir/opt/imports.rs @@ -1,13 +1,14 @@ -//! Removes prevalidated imports no longer referenced by optimized code. +//! Projects executable functions and imports from the command entry closure. use super::cfg; use crate::mir::{Instruction, Module}; use psrs_hir::SymbolId; -use std::collections::HashSet; +use std::collections::{HashMap, HashSet}; pub(super) fn project_reachable(module: &mut Module) { - let mut referenced = HashSet::::new(); + let mut edges = HashMap::new(); for function in &module.functions { + let mut referenced = HashSet::::new(); let reachable = cfg::reachable_blocks(function.entry, &function.blocks); for block in &function.blocks { if !reachable.contains(&block.id) { @@ -37,7 +38,35 @@ pub(super) fn project_reachable(module: &mut Module) { referenced.insert(*function); } } + edges.insert(function.symbol, referenced); } + // Modules without an entry expose all their definitions. Command modules + // expose only the entry and functions it can call or capture as values. + if let Some(entry) = module.entry { + let mut pending = vec![entry]; + let mut live = HashSet::new(); + while let Some(symbol) = pending.pop() { + if live.insert(symbol) + && let Some(references) = edges.get(&symbol) + { + pending.extend(references.iter().copied()); + } + } + module + .functions + .retain(|function| live.contains(&function.symbol)); + // FunctionId is a module position; call and capture identities remain + // SymbolIds and are unaffected by compacting the function vector. + for (position, function) in module.functions.iter_mut().enumerate() { + function.id = crate::types::FunctionId(position as u32); + } + } + let referenced = module + .functions + .iter() + .flat_map(|function| &edges[&function.symbol]) + .copied() + .collect::>(); module .imports .retain(|import| referenced.contains(&import.symbol)); @@ -53,12 +82,11 @@ mod tests { use psrs_hir::{ModuleId, SymbolId}; use psrs_span::TextRange; - #[test] - fn retains_imports_referenced_by_closure_construction() { + fn fixture() -> Module { let entry = SymbolId::new(ModuleId(0), 0); let imported = SymbolId::new(ModuleId(1), 0); let span = TextRange::new(0, 1); - let mut module = Module { + Module { name: "ImportProjectionTest".into(), types: Vec::new(), strings: Vec::new(), @@ -109,11 +137,44 @@ mod tests { }], entry: Some(entry), span, - }; + } + } + #[test] + fn retains_imports_referenced_by_closure_construction() { + let mut module = fixture(); project_reachable(&mut module); + assert_eq!(module.imports.len(), 1); + assert_eq!(module.imports[0].symbol, SymbolId::new(ModuleId(1), 0)); + } + #[test] + fn only_command_entry_reachability_can_discard_definitions() { + let mut module = fixture(); + let dead_import = SymbolId::new(ModuleId(2), 0); + let mut dead = module.functions[0].clone(); + dead.symbol = SymbolId::new(ModuleId(0), 1); + dead.id = FunctionId(0); + module.functions[0].id = FunctionId(1); + let Instruction::ClosureNew { function, .. } = &mut dead.blocks[0].instructions[0] else { + panic!("fixture constructs a closure"); + }; + *function = dead_import; + module.functions.insert(0, dead); + module.imports.push(Import { + symbol: dead_import, + parameters: Vec::new(), + result: None, + }); + let mut library = module.clone(); + library.entry = None; + project_reachable(&mut library); + assert_eq!(library.functions.len(), 2); + assert_eq!(library.imports.len(), 2); + project_reachable(&mut module); + assert_eq!(module.functions.len(), 1); + assert_eq!(module.functions[0].id, FunctionId(0)); assert_eq!(module.imports.len(), 1); - assert_eq!(module.imports[0].symbol, imported); + assert_eq!(module.imports[0].symbol, SymbolId::new(ModuleId(1), 0)); } } diff --git a/crates/psrs-backend/src/mir/tests.rs b/crates/psrs-backend/src/mir/tests.rs index eb3b603d..0d2141b7 100644 --- a/crates/psrs-backend/src/mir/tests.rs +++ b/crates/psrs-backend/src/mir/tests.rs @@ -269,7 +269,13 @@ fn runs_a_mir_gc_struct_under_wasmtime() { span: span(), }; - let wasm = crate::wasm::lower_module(&mir, &mut registry()).expect("lowering to Wasm"); + let context = crate::linking::default_context().expect("resolved world"); + let mut wasi = registry(); + let target = crate::TargetCapabilities::default(); + let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target) + .expect("checked target plan"); + let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link) + .expect("lowering to Wasm"); let core = crate::wasm::encode_module(&wasm).expect("encoding"); crate::validator() .validate_all(&core) @@ -283,7 +289,7 @@ fn runs_a_mir_gc_struct_under_wasmtime() { eprintln!("skipping: wasmtime is not installed"); return; } - let component = crate::linking::compose_core(&core).expect("componentizing"); + let component = crate::linking::compose(&link, &core, mir.span, None).expect("componentizing"); let path = std::env::temp_dir().join(format!("psrs-mir-gc-{}.wasm", std::process::id())); std::fs::write(&path, &component).unwrap(); let output = std::process::Command::new("wasmtime") diff --git a/crates/psrs-backend/src/wasm/lower/mod.rs b/crates/psrs-backend/src/wasm/lower/mod.rs index 286efb26..2709aac6 100644 --- a/crates/psrs-backend/src/wasm/lower/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/mod.rs @@ -154,25 +154,29 @@ pub(crate) fn lower_module_with_plan( message, )] })?; - let (exit_module, exit_field) = - link.imports.get(&exit.symbol).cloned().ok_or_else(|| { - wasm_error( - module.span, - "the command entry exit has no checked provider", - ) - })?; - let exit_type_index = TypeIndex(defined + types.len() as u32); - types.push(FuncType { - parameters: exit.parameters.iter().map(|ty| val_type(*ty)).collect(), - results: Vec::new(), - }); - let index = FunctionIndex(imports.len() as u32); - imports.push(Import { - module: exit_module, - name: exit_field, - type_index: exit_type_index, - }); - Some(index) + if let Some(index) = import_indices.get(&exit.symbol) { + Some(*index) + } else { + let (exit_module, exit_field) = + link.imports.get(&exit.symbol).cloned().ok_or_else(|| { + wasm_error( + module.span, + "the command entry exit has no checked provider", + ) + })?; + let exit_type_index = TypeIndex(defined + types.len() as u32); + types.push(FuncType { + parameters: exit.parameters.iter().map(|ty| val_type(*ty)).collect(), + results: Vec::new(), + }); + let index = FunctionIndex(imports.len() as u32); + imports.push(Import { + module: exit_module, + name: exit_field, + type_index: exit_type_index, + }); + Some(index) + } } else { None }; @@ -258,7 +262,7 @@ pub(crate) fn lower_module_with_plan( index: ExportIndex::Memory(MemoryIndex(0)), }, ]; - let mut minimum = 1; + let minimum = link.plan.memory().minimum_pages; let mut realloc = None; if needs_realloc { let realloc_type = TypeIndex(defined + types.len() as u32); @@ -286,10 +290,7 @@ pub(crate) fn lower_module_with_plan( }, bytes: state, }); - minimum = link.plan.memory().minimum_pages; realloc = Some(build_realloc(realloc_type, module.span)); - } else if !link.plan.artifacts().is_empty() { - minimum = link.plan.memory().minimum_pages; } let helpers = if needs_helpers { let string_type = string_type.expect("a needed codec has a GC string type"); diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs new file mode 100644 index 00000000..4c8515d7 --- /dev/null +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs @@ -0,0 +1,45 @@ +use super::{Module, Resolve, WorldId}; + +/// Fixtures explicitly declare their imports, then emit the checked minimum. +pub(super) fn componentize( + mut module: Module, + resolve: Resolve, + world: WorldId, + requirements: Vec, +) -> Result, String> { + use psrs_linker::{MemoryDemand, TargetLinkInput, TargetPolicy}; + let context = psrs_linker::ResolvedWorldContext::from_resolve(resolve, world); + let plan = psrs_linker::plan( + &context, + TargetLinkInput { + policy: TargetPolicy { + permitted_host_interfaces: requirements + .iter() + .filter_map(|requirement| match &requirement.provider { + psrs_linker::Provider::HostInterface { interface } => { + Some(interface.clone()) + } + _ => None, + }) + .collect(), + }, + requirements, + artifacts: Vec::new(), + memory: MemoryDemand { + canonical_scratch: (0, crate::abi::SCRATCH_SIZE), + allocator_state: ( + crate::abi::HEAP_STATE, + crate::abi::HEAP_STATE + crate::abi::HEAP_STATE_SIZE, + ), + base_heap_start: crate::abi::HEAP_START, + heap_alignment: crate::abi::MIN_BLOCK, + }, + }, + ) + .map_err(|error| error.to_string())?; + module.memories[0].minimum = plan.memory().minimum_pages; + let core = crate::wasm::encode_module(&module).map_err(|error| format!("{error:?}"))?; + psrs_linker::compose(&context, &plan, &core) + .map(|artifact| artifact.bytes) + .map_err(|errors| errors.to_string()) +} diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs similarity index 89% rename from crates/psrs-backend/src/wasm/lower/post_return/tests.rs rename to crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs index 7f296648..1a3b5b8d 100644 --- a/crates/psrs-backend/src/wasm/lower/post_return/tests.rs +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs @@ -16,15 +16,8 @@ fn span() -> TextRange { TextRange::new(0, 1) } -/// Composes a fixture core module against its own custom world and an empty -/// checked plan; these fixtures declare no artifact requirements. -fn componentize(core: &[u8], resolve: Resolve, world: WorldId) -> Result, String> { - let context = psrs_linker::ResolvedWorldContext::from_resolve(resolve, world); - let plan = crate::linking::empty_plan(&context); - psrs_linker::compose(&context, &plan, core) - .map(|artifact| artifact.bytes) - .map_err(|errors| errors.to_string()) -} +mod composition; +use composition::componentize; #[test] fn post_return_drops_an_owned_export_handle() { @@ -33,10 +26,13 @@ fn post_return_drops_an_owned_export_handle() { interface types { resource thing; } + interface api { + use types.{thing}; + take: func() -> thing; + } world guest { import types; - use types.{thing}; - export take: func() -> thing; + export api; } "#; let mut resolve = Resolve::default(); @@ -48,12 +44,20 @@ fn post_return_drops_an_owned_export_handle() { .get("guest") .copied() .expect("guest world"); - let export = match &resolve.worlds[world].exports.values().next() { - Some(WorldItem::Function(function)) => function.name.clone(), - other => panic!("expected one function export, found {other:?}"), + let (key, item) = resolve.worlds[world].exports.iter().next().unwrap(); + let WorldItem::Interface { id, .. } = item else { + panic!("interface export"); }; - assert_eq!(export, "take"); - assert_eq!(post_return_name(&export), "cabi_post_take"); + let export = format!( + "{}#{}", + resolve.name_world_key(key), + resolve.interfaces[*id].functions["take"].name + ); + assert_eq!(export, "fixture:handles/api@0.1.0#take"); + assert_eq!( + post_return_name(&export), + "cabi_post_fixture:handles/api@0.1.0#take" + ); let drop_type = TypeIndex(0); let take_type = TypeIndex(1); @@ -68,7 +72,7 @@ fn post_return_drops_an_owned_export_handle() { ); assert_eq!(post_signature.parameters, vec![ValType::I32]); assert!(post_signature.results.is_empty()); - assert_eq!(post_export.name, "cabi_post_take"); + assert_eq!(post_export.name, post_return_name(&export)); let module = Module { name: "Handles".into(), @@ -126,8 +130,22 @@ fn post_return_drops_an_owned_export_handle() { helpers: Vec::new(), span: span(), }; - let core = crate::wasm::encode_module(&module).expect("encoding the core module"); - let component = componentize(&core, resolve, world).expect("componentizing post-return"); + let interface = "fixture:handles/types@0.1.0".to_string(); + let requirement = psrs_linker::BindingRequirement { + id: psrs_linker::RequirementId(0), + origin: "owned handle post-return".into(), + boundary: psrs_linker::Boundary::ResolvedWit { + interface: interface.clone(), + function: "[resource-drop]thing".into(), + }, + expected: Some(psrs_linker::CoreSignature { + parameters: vec![psrs_linker::CoreType::I32], + result: None, + }), + provider: psrs_linker::Provider::HostInterface { interface }, + }; + let component = componentize(module, resolve, world, vec![requirement]) + .expect("componentizing post-return"); crate::validator() .validate_all(&component) .expect("the component should validate"); @@ -137,7 +155,7 @@ fn post_return_drops_an_owned_export_handle() { "post-return should lower to canon resource.drop: {text}" ); assert!( - text.contains("cabi_post_take") || text.contains("post-return"), + text.contains("cabi_post_fixture:handles/api@0.1.0#take") || text.contains("post-return"), "the export should have a post-return: {text}" ); } @@ -418,10 +436,9 @@ fn buffer_post_return_frees_the_returned_string() { #[test] fn component_attaches_the_buffer_post_return() { let module = buffer_post_return_module(); - let binary = crate::wasm::encode_module(&module).expect("Wasm encodes"); let (resolve, world) = string_world(); let component = - componentize(&binary, resolve, world).expect("componentizing the string export"); + componentize(module, resolve, world, Vec::new()).expect("componentizing the string export"); crate::validator() .validate_all(&component) .expect("the component should validate"); diff --git a/crates/psrs-backend/src/wasm/lower/realloc/block.rs b/crates/psrs-backend/src/wasm/lower/realloc/block.rs index 9d074ed6..435c987b 100644 --- a/crates/psrs-backend/src/wasm/lower/realloc/block.rs +++ b/crates/psrs-backend/src/wasm/lower/realloc/block.rs @@ -45,8 +45,13 @@ pub(super) fn emit_allocate(asm: &mut Asm) { get(asm, L_PNODE); get(asm, L_NODE); asm.leaf(Instruction::I32Sub); + set(asm, L_FRONT); + get(asm, L_FRONT); get(asm, NEW_LEN); asm.leaf(Instruction::I32Add); + set(asm, L_TMP2); + local_trap_if_wrapped(asm, L_TMP2, L_FRONT); + get(asm, L_TMP2); set(asm, L_FRONT); checked_align_up_const(asm, L_FRONT, abi::MIN_BLOCK); // front <= size: this block fits @@ -96,8 +101,6 @@ fn emit_bump(asm: &mut Asm) { get(asm, L_BREAK); asm.leaf(Instruction::I32Sub); set(asm, L_TMP); - word_store(asm, L_BREAK, 0, L_TMP); - word_store(asm, L_BREAK, 4, NEW_LEN); // pages = ceil(END / 65536) get(asm, L_END); constant(asm, 16); @@ -125,6 +128,9 @@ fn emit_bump(asm: &mut Asm) { asm.leaf(Instruction::Unreachable); asm.end(); asm.end(); + // Commit metadata only after the entire block is addressable. + word_store(asm, L_BREAK, 0, L_TMP); + word_store(asm, L_BREAK, 4, NEW_LEN); state_store(asm, 4, L_END); } diff --git a/crates/psrs-backend/src/wasm/lower/realloc/tests.rs b/crates/psrs-backend/src/wasm/lower/realloc/tests.rs index 99bad80f..5fb4c1f9 100644 --- a/crates/psrs-backend/src/wasm/lower/realloc/tests.rs +++ b/crates/psrs-backend/src/wasm/lower/realloc/tests.rs @@ -9,7 +9,7 @@ use psrs_hir::{ModuleId, SymbolId}; use psrs_span::TextRange; use wasm_encoder::{Instruction as I, MemArg, ValType}; -const CHECK_COUNT: u32 = 8; +const CHECK_COUNT: u32 = 10; const REALLOC_INDEX: u32 = CHECK_COUNT; fn mm(align: u32) -> MemArg { @@ -224,6 +224,39 @@ fn check_bounded_growth() -> Body { asm.into_body() } +fn check_page_boundary_growth() -> Body { + let mut asm = Asm::new(); + let length = (65536 - abi::HEAP_START - abi::HEADER_SIZE) as i32; + allocate_into(&mut asm, 0, length, 8); + get(&mut asm, 0); + constant(&mut asm, 123); + asm.leaf(I::I32Store8(mm(0))); + allocate_into(&mut asm, 1, 16, 8); + asm.leaf(I::MemorySize(0)); + constant(&mut asm, 2); + asm.leaf(I::I32Eq); + get(&mut asm, 0); + asm.leaf(I::I32Load8U(mm(0))); + constant(&mut asm, 123); + asm.leaf(I::I32Eq); + asm.leaf(I::I32And); + free_call(&mut asm, 1, 16); + allocate_into(&mut asm, 2, 16, 8); + equal(&mut asm, 1, 2); + asm.leaf(I::I32And); + asm.into_body() +} + +fn free_block_size_overflow() -> Body { + let mut asm = Asm::new(); + allocate_into(&mut asm, 0, 16, 8); + free_call(&mut asm, 0, 16); + realloc_call(&mut asm, 0, 0, 8, -8); + asm.leaf(I::Drop); + constant(&mut asm, 0); + asm.into_body() +} + fn function(name: &str, body: Body, locals: usize) -> Function { Function { symbol: SymbolId::new(ModuleId(0), 0), @@ -250,6 +283,12 @@ fn fixture() -> Module { function("grow_failure", grow_failure(), 0), function("address_overflow", address_overflow(), 0), function("check_bounded_growth", check_bounded_growth(), 2), + function( + "check_page_boundary_growth", + check_page_boundary_growth(), + 3, + ), + function("free_block_size_overflow", free_block_size_overflow(), 1), ]; let realloc_type = TypeIndex(1); functions.push(build_realloc(realloc_type, span())); @@ -358,6 +397,7 @@ fn realloc_reclaims_reuses_coalesces_aligns_and_traps() { "check_reuse_and_coalesce", "check_alignment_and_resize", "check_bounded_growth", + "check_page_boundary_growth", ] { let output = run(export); assert!(output.status.success(), "{export} trapped: {output:?}"); @@ -373,6 +413,7 @@ fn realloc_reclaims_reuses_coalesces_aligns_and_traps() { "mismatched_length", "grow_failure", "address_overflow", + "free_block_size_overflow", ] { let output = run(export); assert!(!output.status.success(), "{export} unexpectedly succeeded"); diff --git a/crates/psrs-cli/Cargo.toml b/crates/psrs-cli/Cargo.toml index bf16680c..b1657efc 100644 --- a/crates/psrs-cli/Cargo.toml +++ b/crates/psrs-cli/Cargo.toml @@ -11,9 +11,13 @@ path = "src/main.rs" [dependencies] psrs-ast.workspace = true psrs-driver.workspace = true +psrs-linker.workspace = true psrs-hir.workspace = true psrs-resolve.workspace = true psrs-span.workspace = true psrs-syntax.workspace = true serde = { version = "1", features = ["derive"] } serde_json = "1" + +[dev-dependencies] +wat = "=1.245.1" diff --git a/crates/psrs-cli/src/build.rs b/crates/psrs-cli/src/build.rs new file mode 100644 index 00000000..e8d38252 --- /dev/null +++ b/crates/psrs-cli/src/build.rs @@ -0,0 +1,145 @@ +//! Source compilation with optional explicit guest composition and joined lineage. +use super::*; + +pub(super) fn run(command: &str, raw_args: Vec) -> Result<(), String> { + let mut paths = Vec::new(); + let mut output_path = None; + let mut manifest_path = None; + let mut report_path = None; + let mut index = 0; + while index < raw_args.len() { + match raw_args[index].as_str() { + "--manifest" | "--report" if command == "build" => { + let slot = if raw_args[index] == "--manifest" { + &mut manifest_path + } else { + &mut report_path + }; + if slot.is_some() { + return Err(usage()); + } + *slot = Some(raw_args.get(index + 1).ok_or_else(usage)?.clone()); + index += 2; + } + "-o" => { + if output_path.is_some() { + return Err(usage()); + } + let Some(output) = raw_args.get(index + 1) else { + return Err(usage()); + }; + output_path = Some(output.clone()); + index += 2; + } + path if path.starts_with('-') => return Err(usage()), + path => { + paths.push(path.to_owned()); + index += 1; + } + } + } + if paths.is_empty() { + return Err(usage()); + } + + let sources = psrs_driver::load_program_files(&paths)?; + let inputs = sources + .iter() + .map(|(path, text)| (path.as_str(), text.as_str())) + .collect::>(); + let mut source_lineage = None; + let compilation = if report_path.is_some() { + let report = psrs_driver::compile_program_sources_with_prelude_diagnosis(&inputs, false); + source_lineage = Some(diagnose::build_lineage(&sources, &report)?); + report.artifact.ok_or(report.diagnostics) + } else { + psrs_driver::compile_program_sources_with_prelude(&inputs) + }; + let artifact = match compilation { + Ok(artifact) => artifact, + Err(errors) => { + for error in errors { + // A diagnostic in a standard-library module names a file the + // caller did not pass, so there is no snippet to print, and + // naming the first source instead would blame a file the caller + // wrote for the library's error. + let Some((path, text)) = error + .source + .source_index() + .and_then(|source| sources.get(source)) + else { + eprintln!( + "{}: {} [{}]: {}", + match error.source { + psrs_driver::DiagnosticOrigin::Library => "standard library", + _ => "program", + }, + error.diagnostic.message, + error.diagnostic.stage, + error.diagnostic.code.unwrap_or("no error code") + ); + continue; + }; + let source = SourceFile::new(path.as_str(), text.as_str()); + print_coded_diagnostic( + &source, + error.diagnostic.span, + error.diagnostic.stage, + error.diagnostic.code, + &error.diagnostic.message, + ); + } + return Err(String::new()); + } + }; + print_warnings(&artifact.warnings, &sources); + if command == "wat" { + if let Some(output) = output_path { + fs::write(&output, artifact.wat).map_err(|error| format!("{output}: {error}"))?; + } else { + print!("{}", artifact.wat); + } + } else { + let output = output_path.unwrap_or_else(|| { + std::path::Path::new(&paths[0]) + .with_extension("wasm") + .to_string_lossy() + .into_owned() + }); + let application_sha256 = psrs_linker::sha256_hex(&artifact.wasm); + let (bytes, composition) = if let Some(manifest) = manifest_path { + match link::compose(&artifact.wasm, &manifest, false) { + Ok((bytes, evidence)) => (bytes, Some(evidence)), + Err(error) => { + if let Some(path) = &report_path { + link::write_report( + path, + &serde_json::json!({ + "schema_version": 1, "status": "rejected", + "source_compilation": source_lineage, + "application_sha256": application_sha256, + "composition": { "status": "rejected", "diagnostic": error }, + }), + )?; + } + return Err(error); + } + } + } else { + (artifact.wasm, None) + }; + if let Some(path) = report_path { + link::write_report( + &path, + &serde_json::json!({ + "schema_version": 1, "status": "completed", "source_compilation": source_lineage, + "application_sha256": application_sha256, "composition": composition, + "output_sha256": psrs_linker::sha256_hex(&bytes), + }), + )?; + } + fs::write(&output, bytes).map_err(|error| format!("{output}: {error}"))?; + println!("wrote {output}"); + } + Ok(()) +} diff --git a/crates/psrs-cli/src/diagnose/mod.rs b/crates/psrs-cli/src/diagnose/mod.rs index e57e4f13..158aac71 100644 --- a/crates/psrs-cli/src/diagnose/mod.rs +++ b/crates/psrs-cli/src/diagnose/mod.rs @@ -405,3 +405,40 @@ fn diagnose(options: Options) -> Result { } Ok(snapshot) } + +/// Reuse the diagnosis schema for the source side of a build/link report. +pub(super) fn build_lineage( + sources: &[(String, String)], + report: &psrs_driver::CompilationReport, +) -> Result { + let inputs = sources + .iter() + .map(|(name, text)| SourceInput { + name: name.clone(), + text: text.clone(), + }) + .collect::>(); + let trace = from_report( + &inputs, + true, + &fingerprint_sources(&inputs), + &trusted_stdlib_fingerprint()?, + false, + report, + )?; + let mut value = serde_json::to_value(&trace).map_err(|error| error.to_string())?; + if let Some(artifact) = &report.artifact { + let outputs = trace + .artifacts + .iter() + .filter(|artifact| artifact.representation == "component_binary") + .collect::>(); + let [output] = outputs.as_slice() else { + return Err("source build must produce exactly one component trace artifact".into()); + }; + value["component_output"] = serde_json::json!({ + "artifact": output.id, "sha256": psrs_linker::sha256_hex(&artifact.wasm), + }); + } + Ok(value) +} diff --git a/crates/psrs-cli/src/link.rs b/crates/psrs-cli/src/link.rs new file mode 100644 index 00000000..9da49091 --- /dev/null +++ b/crates/psrs-cli/src/link.rs @@ -0,0 +1,160 @@ +//! Explicit pinned guest-provider composition for an application component. +use psrs_linker::guest::{ + ComponentLinkInput, ComponentReference, GuestBinding, compose_component, plan_components, +}; +use serde::Deserialize; +use std::{fs, path::Path}; + +#[derive(Deserialize)] +#[serde(deny_unknown_fields)] +struct Manifest { + schema_version: u32, + application_sha256: Option, + providers: Vec, + bindings: Vec, + permitted_host_interfaces: Vec, +} + +#[derive(Deserialize)] +#[serde(deny_unknown_fields)] +struct Artifact { + id: String, + path: String, + sha256: String, +} + +#[derive(Deserialize)] +#[serde(deny_unknown_fields)] +struct Binding { + interface: String, + provider: String, + export: Option, +} + +pub fn run(args: Vec) -> Result<(), String> { + let mut application = None; + let mut manifest = None; + let mut output = None; + let mut report = None; + let mut args = args.into_iter(); + while let Some(arg) = args.next() { + let slot = match arg.as_str() { + "--manifest" => &mut manifest, + "-o" => &mut output, + "--report" => &mut report, + value if !value.starts_with('-') && application.is_none() => { + application = Some(arg); + continue; + } + _ => return Err(usage()), + }; + if slot.is_some() { + return Err(usage()); + } + *slot = Some(args.next().ok_or_else(usage)?); + } + let application = application.ok_or_else(usage)?; + let manifest_path = manifest.ok_or_else(usage)?; + let output = output.ok_or_else(usage)?; + let application_bytes = read(&application)?; + let (bytes, evidence) = compose(&application_bytes, &manifest_path, true)?; + if let Some(report) = report { + write_report(&report, &evidence)?; + } + fs::write(&output, bytes).map_err(|error| format!("{output}: {error}")) +} + +/// Compiler-produced roots are pinned by the bytes emitted in this invocation. +/// Standalone inputs require an explicit manifest root pin. +pub(super) fn compose( + application_bytes: &[u8], + manifest_path: &str, + require_root_pin: bool, +) -> Result<(Vec, serde_json::Value), String> { + let manifest_bytes = read(manifest_path)?; + let manifest: Manifest = serde_json::from_slice(&manifest_bytes) + .map_err(|error| format!("{manifest_path}: {error}"))?; + if manifest.schema_version != 1 { + return Err("unsupported link manifest schema".into()); + } + let target = psrs_driver::TargetCapabilities::default(); + let world = psrs_linker::resolve_default_definitions().map_err(|error| error.to_string())?; + for interface in &manifest.permitted_host_interfaces { + if interface.starts_with("wasi:") + && (!world.imports_interface(interface) || !target.wasi_interface_enabled(interface)) + { + return Err(format!( + "host interface `{interface}` is outside the selected target profile" + )); + } + } + let base = Path::new(manifest_path) + .parent() + .unwrap_or_else(|| Path::new(".")); + let guests = manifest + .providers + .into_iter() + .map(|artifact| { + let path = base.join(&artifact.path); + Ok(ComponentReference { + id: artifact.id, + sha256: artifact.sha256, + bytes: fs::read(&path).map_err(|error| format!("{}: {error}", path.display()))?, + }) + }) + .collect::, String>>()?; + let bindings = manifest + .bindings + .into_iter() + .map(|binding| GuestBinding { + export: binding.export.unwrap_or_else(|| binding.interface.clone()), + interface: binding.interface, + artifact: binding.provider, + }) + .collect(); + let plan = plan_components(ComponentLinkInput { + application: ComponentReference { + id: "application".into(), + sha256: match manifest.application_sha256 { + Some(pin) => pin, + None if !require_root_pin => psrs_linker::sha256_hex(application_bytes), + None => return Err("link requires application_sha256".into()), + }, + bytes: application_bytes.to_vec(), + }, + guests, + bindings, + policy: psrs_linker::TargetPolicy { + permitted_host_interfaces: manifest.permitted_host_interfaces, + }, + features: target.wasm_features(), + }) + .map_err(|error| error.to_string())?; + let linked = compose_component(&plan, application_bytes).map_err(|error| error.to_string())?; + let evidence = serde_json::json!({ + "schema_version":1,"manifest_sha256":psrs_linker::sha256_hex(&manifest_bytes),"component_artifacts":plan.component_artifacts(), + "bindings":plan.bindings().iter().map(|binding| serde_json::json!({ + "consumer":binding.consumer,"interface":binding.interface, + "provider":binding.provider,"export":binding.export, + })).collect::>(), + "target_features":plan.features().bits(), + "external_world":linked.external_world,"output_sha256":psrs_linker::sha256_hex(&linked.bytes), + }); + Ok((linked.bytes, evidence)) +} + +pub(super) fn write_report(path: &str, evidence: &serde_json::Value) -> Result<(), String> { + fs::write( + path, + serde_json::to_vec_pretty(evidence).map_err(|error| error.to_string())?, + ) + .map_err(|error| format!("{path}: {error}")) +} + +fn read(path: &str) -> Result, String> { + fs::read(path).map_err(|error| format!("{path}: {error}")) +} + +fn usage() -> String { + "usage: psrs link application.wasm --manifest providers.json -o linked.wasm [--report report.json]".into() +} diff --git a/crates/psrs-cli/src/main.rs b/crates/psrs-cli/src/main.rs index 66a05c35..71f187e1 100644 --- a/crates/psrs-cli/src/main.rs +++ b/crates/psrs-cli/src/main.rs @@ -2,7 +2,9 @@ use psrs_span::{SourceFile, TextRange}; use psrs_syntax::{LayoutTokenKind, RawToken, RawTokenKind, add_layout, lex, parse_module}; use std::{env, fs, process::ExitCode}; +mod build; mod diagnose; +mod link; fn main() -> ExitCode { match run() { @@ -32,6 +34,9 @@ fn run() -> Result<(), String> { if command == "diagnose" { return diagnose::run(args.collect()); } + if command == "link" { + return link::run(args.collect()); + } if command == "check-program" { let paths: Vec = args.collect(); if paths.is_empty() { @@ -59,7 +64,7 @@ fn run() -> Result<(), String> { return dump_ir(&stage, &path); } if matches!(command.as_str(), "build" | "wat") { - return compile_program(&command, args.collect()); + return build::run(&command, args.collect()); } let Some(path) = args.next() else { return Err(usage()); @@ -179,97 +184,8 @@ fn run() -> Result<(), String> { Ok(()) } -fn compile_program(command: &str, raw_args: Vec) -> Result<(), String> { - let mut paths = Vec::new(); - let mut output_path = None; - let mut index = 0; - while index < raw_args.len() { - match raw_args[index].as_str() { - "-o" => { - if output_path.is_some() { - return Err(usage()); - } - let Some(output) = raw_args.get(index + 1) else { - return Err(usage()); - }; - output_path = Some(output.clone()); - index += 2; - } - path if path.starts_with('-') => return Err(usage()), - path => { - paths.push(path.to_owned()); - index += 1; - } - } - } - if paths.is_empty() { - return Err(usage()); - } - - let sources = psrs_driver::load_program_files(&paths)?; - let inputs = sources - .iter() - .map(|(path, text)| (path.as_str(), text.as_str())) - .collect::>(); - let artifact = match psrs_driver::compile_program_sources_with_prelude(&inputs) { - Ok(artifact) => artifact, - Err(errors) => { - for error in errors { - // A diagnostic in a standard-library module names a file the - // caller did not pass, so there is no snippet to print, and - // naming the first source instead would blame a file the caller - // wrote for the library's error. - let Some((path, text)) = error - .source - .source_index() - .and_then(|source| sources.get(source)) - else { - eprintln!( - "{}: {} [{}]: {}", - match error.source { - psrs_driver::DiagnosticOrigin::Library => "standard library", - _ => "program", - }, - error.diagnostic.message, - error.diagnostic.stage, - error.diagnostic.code.unwrap_or("no error code") - ); - continue; - }; - let source = SourceFile::new(path.as_str(), text.as_str()); - print_coded_diagnostic( - &source, - error.diagnostic.span, - error.diagnostic.stage, - error.diagnostic.code, - &error.diagnostic.message, - ); - } - return Err(String::new()); - } - }; - print_warnings(&artifact.warnings, &sources); - if command == "wat" { - if let Some(output) = output_path { - fs::write(&output, artifact.wat).map_err(|error| format!("{output}: {error}"))?; - } else { - print!("{}", artifact.wat); - } - } else { - let output = output_path.unwrap_or_else(|| { - std::path::Path::new(&paths[0]) - .with_extension("wasm") - .to_string_lossy() - .into_owned() - }); - fs::write(&output, artifact.wasm).map_err(|error| format!("{output}: {error}"))?; - println!("wrote {output}"); - } - Ok(()) -} - fn usage() -> String { - "usage: psrs \n psrs check-program ...\n psrs check-program-kinds ...\n psrs build ... [-o output.wasm]\n psrs wat ... [-o output.wat]\n psrs dump \n psrs diagnose [--input FILE]... [--trace] [--out report.json]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--trace] [--out report.json]\n psrs diagnose --compare OLD.json NEW.json".into() + "usage: psrs \n psrs check-program ...\n psrs check-program-kinds ...\n psrs build ... [-o output.wasm] [--manifest providers.json] [--report report.json]\n psrs link application.wasm --manifest providers.json -o linked.wasm [--report report.json]\n psrs wat ... [-o output.wat]\n psrs dump \n psrs diagnose [--input FILE]... [--trace] [--out report.json]\n psrs diagnose --corpus passing [--filter TEXT] [--limit N] [--trace] [--out report.json]\n psrs diagnose --compare OLD.json NEW.json".into() } fn check_program(paths: &[String], kinds: bool) -> Result<(), String> { diff --git a/crates/psrs-cli/tests/link.rs b/crates/psrs-cli/tests/link.rs new file mode 100644 index 00000000..5ab0a39a --- /dev/null +++ b/crates/psrs-cli/tests/link.rs @@ -0,0 +1,188 @@ +use std::{fs, process::Command}; + +const API: &str = "test:cli/api@1.0.0"; + +#[test] +fn link_uses_manifest_relative_pins_and_reports_the_closed_graph() { + let root = std::env::temp_dir().join(format!("psrs-cli-link-{}", std::process::id())); + let package = root.join("package"); + fs::create_dir_all(&package).unwrap(); + let application = wat::parse_str(format!( + r#"(component + (type $api (instance (export "value" (func (result u32))))) + (import "{API}" (instance $api (type $api))) + (export "{API}" (instance $api)))"# + )) + .unwrap(); + let provider = wat::parse_str(format!( + r#"(component + (core module $m (func (export "value") (result i32) i32.const 42)) + (core instance $m (instantiate $m)) + (func $value (result u32) (canon lift (core func $m "value"))) + (instance $api (export "value" (func $value))) + (export "{API}" (instance $api)))"# + )) + .unwrap(); + let app_path = root.join("app.wasm"); + let manifest_path = package.join("providers.json"); + let output_path = root.join("linked.wasm"); + let report_path = root.join("report.json"); + fs::write(&app_path, &application).unwrap(); + fs::write(package.join("provider.wasm"), &provider).unwrap(); + let mut manifest = serde_json::json!({ + "schema_version":1,"application_sha256":psrs_linker::sha256_hex(&application), + "providers":[{"id":"provider","path":"provider.wasm","sha256":psrs_linker::sha256_hex(&provider)}], + "bindings":[{"interface":API,"provider":"provider"}],"permitted_host_interfaces":[], + }); + fs::write(&manifest_path, serde_json::to_vec(&manifest).unwrap()).unwrap(); + let run = || { + Command::new(env!("CARGO_BIN_EXE_psrs")) + .arg("link") + .arg(&app_path) + .arg("--manifest") + .arg(&manifest_path) + .arg("-o") + .arg(&output_path) + .arg("--report") + .arg(&report_path) + .output() + .unwrap() + }; + let result = run(); + assert!(result.status.success(), "{result:?}"); + let report: serde_json::Value = + serde_json::from_slice(&fs::read(&report_path).unwrap()).unwrap(); + assert_eq!(report["external_world"], serde_json::json!([])); + assert_eq!(report["component_artifacts"].as_array().unwrap().len(), 2); + assert_eq!( + report["output_sha256"], + psrs_linker::sha256_hex(&fs::read(&output_path).unwrap()) + ); + fs::remove_file(&output_path).unwrap(); + fs::remove_file(&report_path).unwrap(); + manifest["providers"][0]["sha256"] = "0".repeat(64).into(); + fs::write(&manifest_path, serde_json::to_vec(&manifest).unwrap()).unwrap(); + let result = run(); + assert!(!result.status.success()); + assert!(String::from_utf8_lossy(&result.stderr).contains("digest")); + assert!(!output_path.exists()); + assert!(!report_path.exists()); + manifest["providers"][0]["sha256"] = psrs_linker::sha256_hex(&provider).into(); + manifest["permitted_host_interfaces"] = + serde_json::json!(["wasi:http/outgoing-handler@0.2.12"]); + fs::write(&manifest_path, serde_json::to_vec(&manifest).unwrap()).unwrap(); + let result = run(); + assert!(!result.status.success()); + assert!(String::from_utf8_lossy(&result.stderr).contains("target profile")); + assert!(!output_path.exists()); + fs::remove_dir_all(root).unwrap(); +} + +#[test] +fn source_build_composes_a_guest_and_joins_the_exact_artifact_lineage() { + let root = std::env::temp_dir().join(format!("psrs-cli-build-link-{}", std::process::id())); + fs::create_dir_all(&root).unwrap(); + let interface = "wasi:random/insecure-seed@0.2.12"; + let provider = wat::parse_str(format!( + r#"(component + (core module $m + (memory (export "memory") 1) + (func (export "insecure-seed") (result i32) + i32.const 0 i64.const 5 i64.store + i32.const 8 i64.const 37 i64.store i32.const 0)) + (core instance $m (instantiate $m)) + (func $seed (result (tuple u64 u64)) + (canon lift (core func $m "insecure-seed") (memory $m "memory"))) + (instance $api (export "insecure-seed" (func $seed))) + (export "{interface}" (instance $api)))"# + )) + .unwrap(); + fs::write(root.join("seed.wasm"), &provider).unwrap(); + fs::write(root.join("Main.purs"), "module Main where\nimport Prelude\nimport WASI.Random (insecureSeed)\nmain = let seed = runEffect insecureSeed in seed._1 + seed._2\n").unwrap(); + let mut manifest = serde_json::json!({ + "schema_version":1, + "providers":[{"id":"seed", "path":"seed.wasm", "sha256":psrs_linker::sha256_hex(&provider)}], + "bindings":[{"interface":interface, "provider":"seed"}], + "permitted_host_interfaces":["wasi:cli/exit@0.2.12"], + }); + let manifest_path = root.join("providers.json"); + let output = root.join("linked.wasm"); + let report = root.join("report.json"); + fs::write(&manifest_path, serde_json::to_vec(&manifest).unwrap()).unwrap(); + let run = || { + Command::new(env!("CARGO_BIN_EXE_psrs")) + .arg("build") + .arg(root.join("Main.purs")) + .arg("--manifest") + .arg(&manifest_path) + .arg("-o") + .arg(&output) + .arg("--report") + .arg(&report) + .output() + .unwrap() + }; + let result = run(); + assert!(result.status.success(), "{result:?}"); + let evidence: serde_json::Value = serde_json::from_slice(&fs::read(&report).unwrap()).unwrap(); + assert_eq!( + evidence["composition"]["component_artifacts"][0][1], + evidence["application_sha256"] + ); + assert_eq!( + evidence["composition"]["output_sha256"], + evidence["output_sha256"] + ); + assert_eq!( + evidence["output_sha256"], + psrs_linker::sha256_hex(&fs::read(&output).unwrap()) + ); + assert_eq!( + evidence["source_compilation"]["component_output"]["sha256"], + evidence["application_sha256"] + ); + let output_id = &evidence["source_compilation"]["component_output"]["artifact"]; + assert!( + evidence["source_compilation"]["artifacts"] + .as_array() + .unwrap() + .iter() + .any(|artifact| &artifact["id"] == output_id + && artifact["representation"] == "component_binary") + ); + let executions = evidence["source_compilation"]["executions"] + .as_array() + .unwrap(); + assert!( + executions + .iter() + .any(|pass| pass["pass_key"] == "backend.target.plan"), + "{executions:?}" + ); + let executed = Command::new("wasmtime") + .arg("run") + .arg(&output) + .output() + .expect("Wasmtime required"); + assert_eq!(executed.status.code(), Some(42), "{executed:?}"); + assert!(executed.stdout.is_empty()); + assert!(executed.stderr.is_empty()); + fs::remove_file(&output).unwrap(); + fs::remove_file(&report).unwrap(); + manifest["application_sha256"] = "0".repeat(64).into(); + fs::write(&manifest_path, serde_json::to_vec(&manifest).unwrap()).unwrap(); + let result = run(); + assert!(!result.status.success()); + assert!(String::from_utf8_lossy(&result.stderr).contains("digest")); + assert!(!output.exists()); + let rejection: serde_json::Value = serde_json::from_slice(&fs::read(&report).unwrap()).unwrap(); + assert_eq!(rejection["status"], "rejected"); + assert!( + rejection["composition"]["diagnostic"] + .as_str() + .unwrap() + .contains("digest") + ); + assert!(rejection.get("output_sha256").is_none()); + fs::remove_dir_all(root).unwrap(); +} diff --git a/crates/psrs-driver/src/lib.rs b/crates/psrs-driver/src/lib.rs index 391c18fb..2ab22ab2 100644 --- a/crates/psrs-driver/src/lib.rs +++ b/crates/psrs-driver/src/lib.rs @@ -7,6 +7,7 @@ pub use prelude::{StandardLibraryInfo, standard_library_info}; mod program; pub use diagnostics::{CompilationReport, FrontendPassTrace, IrDumpArtifacts, PartialIrDumps}; +pub use psrs_backend::TargetCapabilities; pub use psrs_backend::trace::*; pub use loader::{ diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index 882761fe..0da351f2 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -224,3 +224,24 @@ main = show Box "expected NoInstanceFound, got {errors:?}" ); } + +#[test] +fn retained_show_strings_survive_wasi_allocation_and_memory_growth() { + // The formatter's initial heap has one page. A 70,000-byte canonical + // random result must grow shared memory while the GC String stays live. + let source = r#"module Main where +import Prelude +import Effect.Console (log) +import WASI.Random (randomBytes) +main = let retained = show 1.0e21 + first = runEffect (log retained) + large = runEffect (randomBytes 70000) + next = runEffect (log (show 5.0e-324)) + last = runEffect (log retained) + in if arrayLength large == 70000 && retained == "1e+21" then 42 else 1 +"#; + let output = run_with_wasmtime(source).expect("Wasmtime required for growth evidence"); + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"1e+21\n5e-324\n1e+21\n"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/wasi/mod.rs b/crates/psrs-driver/src/tests/wasi/mod.rs index bd516729..ca067969 100644 --- a/crates/psrs-driver/src/tests/wasi/mod.rs +++ b/crates/psrs-driver/src/tests/wasi/mod.rs @@ -428,59 +428,27 @@ fn rejects_an_import_of_unexported_exit_with_code_raw() { ); } -/// The library `exit-with-code` import sits in the effect closure, and -/// `runEffect` reaches it with `call_ref`. A stored action must not -/// `call_ref` from the entry. The synthesized command entry calls a separate -/// `exit-with-code` import with `main`'s code; `imported_func` names the -/// library import, which is emitted first. +/// Source and command entry share one checked exit import. Stored actions do +/// not invoke their closure; forced actions exit with their own observable code. #[test] fn stored_exit_with_code_leaves_exit_with_code_inside_the_effect_closure() { - let stored = "module Main where\n\ - import WASI.Process\n\ - main = let action = exitWithCode 0 in 0\n"; - let forced = "module Main where\n\ - import Prelude\n\ - import WASI.Process\n\ - main = let value = runEffect (exitWithCode 0) in 0\n"; - let stored_wat = compile_source("Main.purs", stored) - .expect("a stored exitWithCode action should compile") - .wat; - let forced_wat = compile_source("Main.purs", forced) - .expect("runEffect (exitWithCode 0) should compile") - .wat; - - let stored_core = core_main(&stored_wat); - let forced_core = core_main(&forced_wat); - let stored_import = imported_func(stored_core, "wasi:cli/exit@0.2.12", "exit-with-code"); - let forced_import = imported_func(forced_core, "wasi:cli/exit@0.2.12", "exit-with-code"); - let stored_entry = exported_func(stored_core, "wasi:cli/run@0.2.12#run"); - let forced_entry = exported_func(forced_core, "wasi:cli/run@0.2.12#run"); - let stored_funcs = core_functions(stored_core); - let forced_funcs = core_functions(forced_core); - - let stored_from_entry = reachable_by_call(&stored_funcs, stored_entry); - assert!( - !calls_import(&stored_funcs, &stored_from_entry, stored_import), - "the command entry must not call the library exit-with-code when the action is not run" - ); - assert!( - !has_call_ref(&stored_funcs, &stored_from_entry), - "storing the action must not run the effect" - ); - assert!( - import_is_reached_only_from_a_closure(&stored_funcs, stored_entry, stored_import), - "exit-with-code must be inside the effect closure" - ); - - let forced_from_entry = reachable_by_call(&forced_funcs, forced_entry); - assert!( - has_call_ref(&forced_funcs, &forced_from_entry), - "runEffect must invoke the closure from the command entry" - ); - assert!( - import_is_reached_only_from_a_closure(&forced_funcs, forced_entry, forced_import), - "runEffect still calls exit-with-code from the closure, not the entry" - ); + let stored = + "module Main where\nimport WASI.Process\nmain = let action = exitWithCode 99 in 0\n"; + let forced = "module Main where\nimport Prelude\nimport WASI.Process\nmain = let value = runEffect (exitWithCode 99) in 0\n"; + for (source, invokes_action, expected_exit) in [(stored, false, 0), (forced, true, 99)] { + let artifact = compile_source("Main.purs", source).expect("exit action should compile"); + let core = core_main(&artifact.wat); + let entry = exported_func(core, "wasi:cli/run@0.2.12#run"); + let functions = core_functions(core); + let reachable = reachable_by_call(&functions, entry); + assert_eq!(has_call_ref(&functions, &reachable), invokes_action); + // Source and synthesized command exit share one checked import. Values + // distinguish forcing the stored action from normal command completion. + let output = run_with_wasmtime(source).expect("Wasmtime required for exit sequencing"); + assert_eq!(output.status.code(), Some(expected_exit), "{output:?}"); + assert!(output.stdout.is_empty()); + assert!(output.stderr.is_empty(), "{output:?}"); + } } #[test] diff --git a/crates/psrs-linker/Cargo.toml b/crates/psrs-linker/Cargo.toml index b48bbe73..3bc06b14 100644 --- a/crates/psrs-linker/Cargo.toml +++ b/crates/psrs-linker/Cargo.toml @@ -4,6 +4,10 @@ version.workspace = true edition.workspace = true license.workspace = true +[[test]] +name = "guest" +path = "tests/guest/mod.rs" + [dependencies] psrs-runtime = { workspace = true, default-features = false, features = ["catalog"] } sha2 = "=0.10.9" @@ -11,6 +15,8 @@ wasm-encoder.workspace = true wasmparser.workspace = true wit-component = "=0.245.1" wit-parser = "=0.245.1" +wasm-compose = "=0.245.1" [dev-dependencies] wasmprinter.workspace = true +wat = "=1.245.1" diff --git a/crates/psrs-linker/src/application.rs b/crates/psrs-linker/src/application.rs new file mode 100644 index 00000000..83c5009d --- /dev/null +++ b/crates/psrs-linker/src/application.rs @@ -0,0 +1,160 @@ +//! Verify encoded application contracts before executing a checked link plan. +use crate::{CheckedLinkPlan, CoreSignature, CoreType, LinkErrors, LinkStage}; +use wasmparser::{CompositeInnerType, Operator, Parser, Payload, TypeRef, ValType}; + +pub(crate) fn verify(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), LinkErrors> { + check(plan, bytes).map_err(|message| LinkErrors::plain(LinkStage::Compose, message)) +} + +fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { + wasmparser::Validator::new() + .validate_all(bytes) + .map_err(|error| error.to_string())?; + let mut types = Vec::new(); + let mut seen = std::collections::BTreeSet::new(); + let mut memory = None; + let mut data = Vec::new(); + for payload in Parser::new(0).parse_all(bytes) { + match payload.map_err(|error| error.to_string())? { + Payload::TypeSection(reader) => { + for group in reader { + for ty in group.map_err(|error| error.to_string())?.into_types() { + types.push(match ty.composite_type.inner { + CompositeInnerType::Func(ty) => Some(ty), + _ => None, + }); + } + } + } + Payload::ImportSection(reader) => { + for import in reader.into_imports() { + let import = import.map_err(|error| error.to_string())?; + let TypeRef::Func(index) = import.ty else { + return Err("application imports an unplanned non-function item".into()); + }; + let binding = plan + .bindings() + .iter() + .find(|binding| { + binding.module == import.module && binding.field == import.name + }) + .ok_or_else(|| { + format!( + "application has an unplanned import `{}.{}`", + import.module, import.name + ) + })?; + let ty = types + .get(index as usize) + .and_then(Option::as_ref) + .ok_or("application import has no function signature")?; + let signature = CoreSignature { + parameters: ty + .params() + .iter() + .copied() + .map(scalar) + .collect::>()?, + result: match ty.results() { + [] => None, + [ty] => Some(scalar(*ty)?), + _ => { + return Err( + "application import has unsupported multiple results".into() + ); + } + }, + }; + if signature != binding.signature { + return Err( + "application import signature disagrees with the checked plan".into(), + ); + } + if !seen.insert((binding.module.clone(), binding.field.clone())) { + return Err("application duplicates a planned import".into()); + } + } + } + Payload::MemorySection(reader) => { + for ty in reader { + let ty = ty.map_err(|error| error.to_string())?; + if memory.replace(ty).is_some() || ty.memory64 || ty.shared { + return Err("application memory differs from the checked plan".into()); + } + } + } + Payload::DataSection(reader) => { + for segment in reader { + let segment = segment.map_err(|error| error.to_string())?; + if let wasmparser::DataKind::Active { + memory_index, + offset_expr, + } = segment.kind + { + let mut ops = offset_expr.get_operators_reader(); + let Operator::I32Const { value } = + ops.read().map_err(|error| error.to_string())? + else { + return Err("application data offset is not constant".into()); + }; + if memory_index != 0 + || !matches!( + ops.read().map_err(|error| error.to_string())?, + Operator::End + ) + { + return Err("application data has an unplanned initialization".into()); + } + data.push((value as u32, segment.data)); + } + } + } + Payload::StartSection { .. } => { + return Err("application start precedes planned shim resolution".into()); + } + _ => {} + } + } + for binding in plan.bindings() { + if !seen.contains(&(binding.module.clone(), binding.field.clone())) { + return Err(format!( + "application omits planned import `{}.{}`", + binding.module, binding.field + )); + } + } + if memory.is_some_and(|memory| memory.initial < plan.memory().minimum_pages) + || (!plan.artifacts().is_empty() && memory.is_none()) + { + return Err("application memory does not cover the checked reservations".into()); + } + for (start, bytes) in data { + let end = start + .checked_add(u32::try_from(bytes.len()).map_err(|_| "data length overflows")?) + .ok_or("application data range overflows")?; + let scratch = plan.memory().canonical_scratch; + let allocator = plan.memory().allocator_state; + if start >= allocator.0 && end <= allocator.1 { + if start != allocator.0 + || bytes.len() != 8 + || bytes[..4] != [0; 4] + || bytes[4..] != plan.memory().heap_start.to_le_bytes() + { + return Err("application allocator state disagrees with the checked plan".into()); + } + } else if start < scratch.0 || end > scratch.1 { + return Err("application active data overlaps an unowned region".into()); + } + } + Ok(()) +} + +fn scalar(ty: ValType) -> Result { + match ty { + ValType::I32 => Ok(CoreType::I32), + ValType::I64 => Ok(CoreType::I64), + ValType::F32 => Ok(CoreType::F32), + ValType::F64 => Ok(CoreType::F64), + _ => Err("a target import has an unchecked reference representation".into()), + } +} diff --git a/crates/psrs-linker/src/closure.rs b/crates/psrs-linker/src/closure.rs new file mode 100644 index 00000000..e4411e62 --- /dev/null +++ b/crates/psrs-linker/src/closure.rs @@ -0,0 +1,105 @@ +//! Derive the component tooling's executable import closure from planned calls. +//! +//! A live resource alias can require its defining interface, while unused +//! functions in that interface do not introduce their own type dependencies. +//! The encoder owns this projection; walking all WIT types over-approximates it. +use crate::plan::ResolvedBinding; +use crate::{CoreType, LinkErrors, LinkStage, ResolvedWorldContext}; +use wasm_encoder::{ + CodeSection, EntityType, ExportKind, ExportSection, Function, FunctionSection, ImportSection, + Instruction, MemorySection, MemoryType, Module, TypeSection, ValType, +}; + +pub(crate) fn host_imports( + context: &ResolvedWorldContext, + bindings: &[ResolvedBinding], +) -> Result, LinkErrors> { + let hosts: Vec<_> = bindings + .iter() + .filter(|binding| context.imports_interface(&binding.module)) + .collect(); + let Some(world) = context.composition_world() else { + let mut imports: Vec<_> = hosts.iter().map(|binding| binding.module.clone()).collect(); + imports.sort(); + imports.dedup(); + return Ok(imports); + }; + if hosts.is_empty() { + return Ok(Vec::new()); + } + let mut module = Module::new(); + let mut types = TypeSection::new(); + let mut imports = ImportSection::new(); + let mut seen = std::collections::BTreeSet::new(); + let mut count = 0_u32; + for binding in hosts { + if !seen.insert((&binding.module, &binding.field)) { + continue; + } + types.ty().function( + binding.signature.parameters.iter().copied().map(scalar), + binding.signature.result.map(scalar), + ); + imports.import(&binding.module, &binding.field, EntityType::Function(count)); + count += 1; + } + types.ty().function([ValType::I32; 4], [ValType::I32]); + module.section(&types); + module.section(&imports); + let mut functions = FunctionSection::new(); + functions.function(count); + module.section(&functions); + let mut memories = MemorySection::new(); + memories.memory(MemoryType { + minimum: 1, + maximum: None, + memory64: false, + shared: false, + page_size_log2: None, + }); + module.section(&memories); + let mut exports = ExportSection::new(); + exports.export("memory", ExportKind::Memory, 0); + exports.export("cabi_realloc", ExportKind::Func, count); + module.section(&exports); + let mut function = Function::new([]); + function.instruction(&Instruction::Unreachable); + function.instruction(&Instruction::End); + let mut code = CodeSection::new(); + code.function(&function); + module.section(&code); + // This module is a nonexecuted signature projection, not an implementation. + // Export requirements are irrelevant to the import-only projection. + let mut resolve = context.resolve().clone(); + resolve.worlds[world].exports.clear(); + let mut bytes = module.finish(); + wit_component::embed_component_metadata( + &mut bytes, + &resolve, + world, + wit_component::StringEncoding::UTF8, + ) + .map_err(error)?; + let component = wit_component::ComponentEncoder::default() + .module(&bytes) + .map_err(error)? + .validate(true) + .encode() + .map_err(error)?; + crate::compose::component_imports(&component) +} + +fn scalar(ty: CoreType) -> ValType { + match ty { + CoreType::I32 => ValType::I32, + CoreType::I64 => ValType::I64, + CoreType::F32 => ValType::F32, + CoreType::F64 => ValType::F64, + } +} +fn error(error: impl std::fmt::Display) -> LinkErrors { + LinkErrors::plain( + LinkStage::Requirements, + format!("planned WIT call projection is invalid: {error}"), + ) +} diff --git a/crates/psrs-linker/src/compose.rs b/crates/psrs-linker/src/compose.rs index cbbaca84..c2b32569 100644 --- a/crates/psrs-linker/src/compose.rs +++ b/crates/psrs-linker/src/compose.rs @@ -15,7 +15,7 @@ pub struct LinkedArtifact { /// Composes an encoded application with the plan's verified libraries. /// -/// The final component's unresolved imports must be a subset of the plan's +/// The final component's unresolved imports must equal the plan's /// external world; the private runtime import must be closed. pub fn compose( context: &ResolvedWorldContext, @@ -23,19 +23,28 @@ pub fn compose( application: &[u8], ) -> Result { let stage = LinkStage::Compose; - let mut bytes = application.to_vec(); - embed_component_metadata( - &mut bytes, - context.resolve(), - context.world(), - StringEncoding::UTF8, - ) - .map_err(|error| { + if !plan.uses_context(context) { + return Err(LinkErrors::plain( + stage, + "WIT context differs from the checked plan", + )); + } + let world = context.composition_world().ok_or_else(|| { LinkErrors::plain( stage, - format!("failed to embed component metadata: {error}"), + "definition-only context cannot compose an executable component", ) })?; + crate::application::verify(plan, application)?; + let mut bytes = application.to_vec(); + embed_component_metadata(&mut bytes, context.resolve(), world, StringEncoding::UTF8).map_err( + |error| { + LinkErrors::plain( + stage, + format!("failed to embed component metadata: {error}"), + ) + }, + )?; let mut encoder = ComponentEncoder::default() .module(&bytes) .map_err(|error| { @@ -81,7 +90,7 @@ pub fn compose( } // Interface imports are named by canonical id and must be permitted by // the world; type and function imports belong to those interfaces. - if import.contains('/') && !context.imports_interface(import) { + if !plan.external_world().contains(import) { return Err(LinkErrors::one( stage, import.clone(), @@ -89,13 +98,22 @@ pub fn compose( )); } } + if imports != plan.external_world() { + return Err(LinkErrors::plain( + stage, + format!( + "component import closure differs from the checked plan: expected {:?}, actual {imports:?}", + plan.external_world() + ), + )); + } Ok(LinkedArtifact { bytes: output, external_world: imports, }) } -fn component_imports(bytes: &[u8]) -> Result, LinkErrors> { +pub(crate) fn component_imports(bytes: &[u8]) -> Result, LinkErrors> { let mut imports = Vec::new(); let mut depth = 0_usize; for payload in Parser::new(0).parse_all(bytes) { @@ -123,5 +141,7 @@ fn component_imports(bytes: &[u8]) -> Result, LinkErrors> { _ => {} } } + imports.sort(); + imports.dedup(); Ok(imports) } diff --git a/crates/psrs-linker/src/definitions.rs b/crates/psrs-linker/src/definitions.rs index 27e1d0d5..9b6d64e4 100644 --- a/crates/psrs-linker/src/definitions.rs +++ b/crates/psrs-linker/src/definitions.rs @@ -6,11 +6,8 @@ use crate::error::{LinkErrors, LinkStage}; use psrs_runtime::{APP_WIT, DEFAULT_WORLD, WASI_WIT, WitSource, WorldIdentity}; -use std::collections::{BTreeSet, HashMap, HashSet}; use std::sync::Arc; -use wit_parser::{ - Handle, InterfaceId, Resolve, Type, TypeDefKind, TypeId, TypeOwner, WorldId, WorldItem, -}; +use wit_parser::{Resolve, WorldId, WorldItem}; /// One immutable resolved world shared by ABI lowering and provider validation. pub struct ResolvedWorldContext { @@ -65,6 +62,9 @@ impl ResolvedWorldContext { pub fn world(&self) -> WorldId { self.world.expect("a permissive context has no world") } + pub(crate) fn composition_world(&self) -> Option { + self.world + } /// Canonical ids of interfaces the default world imports. pub fn world_imports(&self) -> &[String] { @@ -80,106 +80,6 @@ impl ResolvedWorldContext { pub fn imports_interface(&self, canonical: &str) -> bool { self.imports.iter().any(|id| id == canonical) } - - /// The allowed residual host capabilities: the transitive WIT dependency - /// closure of `seeds` within the resolved world. - pub fn host_closure(&self, seeds: &BTreeSet) -> Vec { - let resolve = &self.resolve; - let mut owner = HashMap::::new(); - for (id, ty) in resolve.types.iter() { - if let TypeOwner::Interface(interface) = ty.owner { - owner.insert(id, interface); - } - } - let mut pending = Vec::new(); - let mut seen = HashSet::::new(); - for (id, _) in resolve.interfaces.iter() { - if let Some(canonical) = resolve.id_of(id) - && seeds.contains(&canonical) - && seen.insert(id) - { - pending.push(id); - } - } - while let Some(interface) = pending.pop() { - let mut referenced = Vec::new(); - for ty in resolve.interfaces[interface].types.values() { - walk_type(resolve, &Type::Id(*ty), &mut referenced); - } - for function in resolve.interfaces[interface].functions.values() { - for param in &function.params { - walk_type(resolve, ¶m.ty, &mut referenced); - } - if let Some(ty) = &function.result { - walk_type(resolve, ty, &mut referenced); - } - } - for ty in referenced { - if let Some(dependency) = owner.get(&ty) - && seen.insert(*dependency) - { - pending.push(*dependency); - } - } - } - let mut ids = seen - .into_iter() - .filter_map(|id| resolve.id_of(id)) - .collect::>(); - ids.sort(); - ids - } -} - -fn walk_type(resolve: &Resolve, ty: &Type, out: &mut Vec) { - if let Type::Id(id) = ty { - out.push(*id); - walk_kind(resolve, &resolve.types[*id].kind, out); - } -} - -fn walk_kind(resolve: &Resolve, kind: &TypeDefKind, out: &mut Vec) { - match kind { - TypeDefKind::Record(record) => { - for field in &record.fields { - walk_type(resolve, &field.ty, out); - } - } - TypeDefKind::Tuple(tuple) => { - for ty in &tuple.types { - walk_type(resolve, ty, out); - } - } - TypeDefKind::Variant(variant) => { - for case in &variant.cases { - if let Some(ty) = &case.ty { - walk_type(resolve, ty, out); - } - } - } - TypeDefKind::Option(ty) | TypeDefKind::List(ty) => walk_type(resolve, ty, out), - TypeDefKind::Result(result) => { - if let Some(ty) = &result.ok { - walk_type(resolve, ty, out); - } - if let Some(ty) = &result.err { - walk_type(resolve, ty, out); - } - } - TypeDefKind::Map(key, value) => { - walk_type(resolve, key, out); - walk_type(resolve, value, out); - } - TypeDefKind::FixedLengthList(ty, _) => walk_type(resolve, ty, out), - TypeDefKind::Future(Some(ty)) | TypeDefKind::Stream(Some(ty)) => { - walk_type(resolve, ty, out) - } - TypeDefKind::Type(ty) => walk_type(resolve, ty, out), - TypeDefKind::Handle(Handle::Own(id) | Handle::Borrow(id)) => { - walk_type(resolve, &Type::Id(*id), out); - } - _ => {} - } } /// Resolves the supplied WIT sources into one world context. diff --git a/crates/psrs-linker/src/guest/graph.rs b/crates/psrs-linker/src/guest/graph.rs new file mode 100644 index 00000000..7fbe26af --- /dev/null +++ b/crates/psrs-linker/src/guest/graph.rs @@ -0,0 +1,188 @@ +use super::{CheckedComponentPlan, ComponentLinkInput, ComponentReference, ResolvedGuestBinding}; +use crate::{LinkErrors, LinkStage, LinkedArtifact}; +use std::collections::{BTreeMap, BTreeSet}; +use wasm_compose::graph::{Component, CompositionGraph, EncodeOptions}; +use wasmparser::{ComponentTypeRef, Validator}; + +/// Close executable component dependencies without files, automatic discovery, +/// or a host fallback for an explicitly selected guest provider. +pub fn plan_components(input: ComponentLinkInput) -> Result { + build(input).map_err(|message| LinkErrors::plain(LinkStage::Requirements, message)) +} + +fn build(input: ComponentLinkInput) -> Result { + let ComponentLinkInput { + application, + guests, + bindings, + policy, + features, + } = input; + let mut references = BTreeMap::new(); + for reference in std::iter::once(application.clone()).chain(guests) { + if references.insert(reference.id.clone(), reference).is_some() { + return Err("duplicate component artifact identity".into()); + } + } + let mut selections = BTreeMap::new(); + for binding in bindings { + if binding.export != binding.interface { + return Err("guest exports must match the pinned canonical interface identity; implicit version adaptation is unsupported".into()); + } + if selections + .insert(binding.interface.clone(), binding) + .is_some() + { + return Err("duplicate or conflicting guest interface provider".into()); + } + } + let mut graph = CompositionGraph::new(); + let mut validator = Validator::new_with_features(features); + let mut instances = BTreeMap::new(); + let mut pending = vec![application.id.clone()]; + let mut used = BTreeSet::new(); + let mut edges = Vec::new(); + let mut external = BTreeSet::new(); + while let Some(id) = pending.pop() { + if !used.insert(id.clone()) { + continue; + } + let reference = references + .get(&id) + .ok_or_else(|| format!("absent selected guest artifact `{id}`"))?; + verify_digest(reference)?; + if id != application.id { + // Provider initialization has no executable-start contract in v1. + for payload in wasmparser::Parser::new(0).parse_all(&reference.bytes) { + match payload.map_err(|error| error.to_string())? { + wasmparser::Payload::StartSection { .. } + | wasmparser::Payload::ComponentStartSection { .. } => { + return Err(format!( + "guest `{id}` has unsupported executable initialization" + )); + } + _ => {} + } + } + } + let component = Component::from_bytes(&mut validator, id.clone(), reference.bytes.clone()) + .map_err(|error| format!("component `{id}` is not executable: {error:#}"))?; + let imports = component + .imports() + .map(|(index, name, ty)| (index, name.to_owned(), ty)) + .collect::>(); + let component_id = graph + .add_component(component) + .map_err(|error| error.to_string())?; + let instance = graph + .instantiate(component_id) + .map_err(|error| error.to_string())?; + instances.insert(id.clone(), (component_id, instance)); + for (index, name, ty) in imports { + if !matches!(ty, ComponentTypeRef::Instance(_)) { + return Err(format!( + "component `{id}` imports unsupported non-interface `{name}`" + )); + } + if let Some(binding) = selections.get(&name) { + if binding.artifact == application.id { + return Err("the root application cannot provide a guest dependency".into()); + } + pending.push(binding.artifact.clone()); + edges.push(( + id.clone(), + index, + binding.artifact.clone(), + binding.export.clone(), + )); + } else if policy.permitted_host_interfaces.contains(&name) { + external.insert(name); + } else { + return Err(format!( + "unresolved or disallowed component interface `{name}` required by `{id}`" + )); + } + } + } + let mut selected_bindings = Vec::new(); + for (target, import, source, export) in edges { + selected_bindings.push(ResolvedGuestBinding { + consumer: target.clone(), + interface: export.clone(), + provider: source.clone(), + export: export.clone(), + }); + let (component_id, source_instance) = instances[&source]; + let target_instance = instances[&target].1; + let export_index = graph + .get_component(component_id) + .unwrap() + .export_by_name(&export) + .map(|(index, _, _)| index) + .ok_or_else(|| format!("guest `{source}` omits selected export `{export}`"))?; + graph + .connect(source_instance, Some(export_index), target_instance, import) + .map_err(|error| { + format!("incompatible guest binding `{source}.{export}`: {error:#}") + })?; + } + // Graph encoding validates resource remapping, dependency ordering and all + // canonical instance connections. Cycles are rejected, never made host imports. + let bytes = graph + .encode(EncodeOptions { + define_components: true, + export: Some(instances[&application.id].1), + validate: true, + }) + .map_err(|error| format!("component graph cannot be composed: {error:#}"))?; + let actual = crate::compose::component_imports(&bytes).map_err(|error| error.to_string())?; + let expected: Vec<_> = external.into_iter().collect(); + if actual != expected { + return Err(format!( + "component import closure differs from the plan: expected {expected:?}, actual {actual:?}" + )); + } + let artifacts: Vec<_> = used + .iter() + .map(|id| (id.clone(), references[id].sha256.clone())) + .collect(); + Validator::new_with_features(features) + .validate_all(&bytes) + .map_err(|error| error.to_string())?; + Ok(CheckedComponentPlan { + application_digest: application.sha256, + bytes, + artifacts, + external_world: expected, + bindings: selected_bindings, + features, + }) +} + +fn verify_digest(reference: &ComponentReference) -> Result<(), String> { + if crate::sha256_hex(&reference.bytes) != reference.sha256 { + return Err(format!( + "component `{}` digest does not match its pin", + reference.id + )); + } + Ok(()) +} + +/// Execute a component plan only for the exact application it checked. +pub fn compose_component( + plan: &CheckedComponentPlan, + application: &[u8], +) -> Result { + let component = plan; + if crate::sha256_hex(application) != component.application_digest { + return Err(LinkErrors::plain( + LinkStage::Compose, + "application bytes differ from the checked component plan", + )); + } + Ok(LinkedArtifact { + bytes: component.bytes.clone(), + external_world: plan.external_world().to_vec(), + }) +} diff --git a/crates/psrs-linker/src/guest/mod.rs b/crates/psrs-linker/src/guest/mod.rs new file mode 100644 index 00000000..db96ba40 --- /dev/null +++ b/crates/psrs-linker/src/guest/mod.rs @@ -0,0 +1,70 @@ +//! Explicit, in-memory composition of pinned guest WIT interface providers. +mod graph; +pub use graph::{compose_component, plan_components}; + +/// A pinned, executable component; definitions alone are not providers. +#[derive(Clone, Debug)] +pub struct ComponentReference { + pub id: String, + pub sha256: String, + pub bytes: Vec, +} + +/// Bind the whole imported interface to one export of one guest instance. +/// This preserves a resource's constructor/method/destructor identity. +#[derive(Clone, Debug)] +pub struct GuestBinding { + pub interface: String, + pub artifact: String, + pub export: String, +} + +/// Target-only entry point for an already typed application component. +/// Core-module callers still use `plan` and `compose` before this boundary. +#[derive(Clone, Debug)] +pub struct ComponentLinkInput { + pub application: ComponentReference, + pub guests: Vec, + pub bindings: Vec, + pub policy: crate::TargetPolicy, + /// The selected target's validator feature policy, applied to every input. + pub features: wasmparser::WasmFeatures, +} + +/// One live whole-interface edge in the executable graph. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ResolvedGuestBinding { + pub consumer: String, + pub interface: String, + pub provider: String, + pub export: String, +} + +/// A checked, closed component graph; construction is private to planning. +/// Component memories stay inside their owners and have no core memory plan. +#[derive(Clone, Debug)] +pub struct CheckedComponentPlan { + pub(crate) application_digest: String, + pub(crate) bytes: Vec, + pub(crate) artifacts: Vec<(String, String)>, + pub(crate) external_world: Vec, + pub(crate) bindings: Vec, + pub(crate) features: wasmparser::WasmFeatures, +} + +impl CheckedComponentPlan { + /// Selected component identities and pins, including the root application. + pub fn component_artifacts(&self) -> &[(String, String)] { + &self.artifacts + } + pub fn bindings(&self) -> &[ResolvedGuestBinding] { + &self.bindings + } + pub fn features(&self) -> wasmparser::WasmFeatures { + self.features + } + /// Exact residual host interface imports after graph closure. + pub fn external_world(&self) -> &[String] { + &self.external_world + } +} diff --git a/crates/psrs-linker/src/lib.rs b/crates/psrs-linker/src/lib.rs index 99590c9c..0c01f509 100644 --- a/crates/psrs-linker/src/lib.rs +++ b/crates/psrs-linker/src/lib.rs @@ -13,10 +13,13 @@ //! compose(context, plan, encoded_application) -> LinkedArtifact //! ``` +mod application; +mod closure; mod compose; mod definitions; mod digest; mod error; +pub mod guest; pub mod plan; pub mod runtime; mod stack; diff --git a/crates/psrs-linker/src/plan.rs b/crates/psrs-linker/src/plan.rs index d02c17a2..1e4895c2 100644 --- a/crates/psrs-linker/src/plan.rs +++ b/crates/psrs-linker/src/plan.rs @@ -27,6 +27,8 @@ pub struct MemoryPlan { pub minimum_pages: u64, /// Every owned region, sorted by start address. pub reservations: Vec, + pub(crate) canonical_scratch: (u32, u32), + pub(crate) allocator_state: (u32, u32), } /// One immutable checked target link plan. @@ -41,9 +43,17 @@ pub struct CheckedLinkPlan { memory: MemoryPlan, external_world: Vec, digests: Vec, + context: ( + std::sync::Arc, + Option, + ), } impl CheckedLinkPlan { + pub(crate) fn uses_context(&self, context: &ResolvedWorldContext) -> bool { + std::sync::Arc::ptr_eq(&self.context.0, &context.shared_resolve()) + && self.context.1 == context.composition_world() + } /// The binding for a requirement, when it contributes a core import. pub fn import(&self, requirement: RequirementId) -> Option<&ResolvedBinding> { self.bindings @@ -115,7 +125,6 @@ pub fn plan( let mut verified: BTreeMap = BTreeMap::new(); let mut used_artifacts = BTreeSet::new(); - let mut external = BTreeSet::new(); // A core import identity resolves to exactly one provider and signature. let mut claims = BTreeMap::<(String, String), (CoreSignature, String)>::new(); let mut bindings = Vec::new(); @@ -184,6 +193,13 @@ pub fn plan( }); } Provider::HostInterface { interface } => { + if !context.imports_interface(interface) { + return Err(LinkErrors::one( + stage, + &requirement.origin, + format!("host interface `{interface}` is outside the resolved world"), + )); + } if !policy .permitted_host_interfaces .iter() @@ -217,7 +233,6 @@ pub fn plan( )); } }; - external.insert(interface.clone()); claim( &mut claims, (module.clone(), field.clone()), @@ -248,12 +263,25 @@ pub fn plan( digests.sort(); digests.dedup(); + let external = crate::closure::host_imports(context, &bindings)?; + for interface in &external { + if !context.imports_interface(interface) + || !policy.permitted_host_interfaces.contains(interface) + { + return Err(LinkErrors::one( + stage, + interface, + "component resource dependency is outside the selected world or target profile", + )); + } + } Ok(CheckedLinkPlan { bindings, artifacts: verified.into_values().collect(), memory, - external_world: context.host_closure(&external), + external_world: external, digests, + context: (context.shared_resolve(), context.composition_world()), }) } @@ -341,6 +369,12 @@ fn plan_memory( } reservations.sort_by_key(|region| (region.start, region.end)); + if reservations.iter().any(|region| region.start > region.end) { + return Err(LinkErrors::plain( + stage, + "storage reservation has reversed bounds", + )); + } for pair in reservations.windows(2) { if pair[1].start < pair[0].end { return Err(LinkErrors::one( @@ -354,7 +388,7 @@ fn plan_memory( } } let alignment = demand.heap_alignment; - if alignment == 0 || !heap_start.is_multiple_of(alignment) { + if !alignment.is_power_of_two() || !heap_start.is_multiple_of(alignment) { return Err(LinkErrors::plain( stage, "allocator boundary is not aligned to its block granularity", @@ -369,21 +403,35 @@ fn plan_memory( "a reservation extends past the allocator boundary", )); } + if minimum_pages > 65536 { + return Err(LinkErrors::plain( + stage, + "memory plan exceeds wasm32 limits", + )); + } if u64::from(heap_start) > minimum_pages * 0x1_0000 { return Err(LinkErrors::plain( stage, "declared minimum pages do not cover the allocator boundary", )); } - // The allocator does not grow memory; it needs at least one page of heap + // The allocator grows memory on demand; reserve one initial page of heap // beyond the boundary where every reserved region ends. minimum_pages = minimum_pages.max(u64::from(heap_start).div_ceil(0x1_0000) + 1); + if minimum_pages > 65536 { + return Err(LinkErrors::plain( + stage, + "memory plan exceeds wasm32 limits", + )); + } Ok(MemoryPlan { heap_start, heap_alignment: alignment, minimum_pages, reservations, + canonical_scratch: demand.canonical_scratch, + allocator_state: demand.allocator_state, }) } diff --git a/crates/psrs-linker/src/stack.rs b/crates/psrs-linker/src/stack.rs index 7c6a83ce..d8e33b51 100644 --- a/crates/psrs-linker/src/stack.rs +++ b/crates/psrs-linker/src/stack.rs @@ -19,6 +19,22 @@ pub struct StackBound { /// reserves a frame. Indirect calls and calls into imported functions make the /// bound unknown, so they are errors rather than silent under-approximations. pub fn measure_stack_bound(bytes: &[u8], stack_pointer_global: u32) -> Result { + // Exception and suspension proposals require a separate frame-unwind + // proof. They cannot enter this normal-return-only analysis. + use wasmparser::WasmFeatures as F; + let features = F::MVP + | F::MUTABLE_GLOBAL + | F::SIGN_EXTENSION + | F::SATURATING_FLOAT_TO_INT + | F::MULTI_VALUE + | F::BULK_MEMORY + | F::REFERENCE_TYPES + | F::FUNCTION_REFERENCES + | F::GC + | F::TAIL_CALL; + wasmparser::Validator::new_with_features(features) + .validate_all(bytes) + .map_err(|error| error.to_string())?; let mut frames = Vec::new(); let mut callees = Vec::new(); let mut imported_functions = 0_usize; @@ -65,45 +81,143 @@ fn analyze_body( body: &wasmparser::FunctionBody<'_>, stack_pointer_global: u32, ) -> Result<(u32, Vec), String> { - let mut frame = 0_u32; let mut calls = Vec::new(); - let mut pending_stack_pointer = false; - let mut pending_frame = None; - let mut operators = body + let mut reader = body .get_operators_reader() .map_err(|error| error.to_string())?; - while !operators.eof() { - match operators.read().map_err(|error| error.to_string())? { - Operator::GlobalGet { global_index } if global_index == stack_pointer_global => { - pending_stack_pointer = true; - pending_frame = None; - } - Operator::I32Const { value } if pending_stack_pointer => { - pending_frame = Some(value.max(0) as u32); + let mut operators = Vec::new(); + while !reader.eof() { + operators.push(reader.read().map_err(|error| error.to_string())?); + } + let (frame, frame_local, prologue_end) = match operators.as_slice() { + [ + Operator::GlobalGet { global_index }, + Operator::I32Const { value }, + Operator::I32Sub, + Operator::LocalTee { local_index }, + Operator::GlobalSet { + global_index: target, + }, + .., + ] if *global_index == stack_pointer_global + && *target == stack_pointer_global + && *value > 0 => + { + (*value as u32, Some(*local_index), 5) + } + [ + Operator::GlobalGet { global_index }, + Operator::I32Const { value }, + Operator::I32Sub, + Operator::GlobalSet { + global_index: target, + }, + .., + ] if *global_index == stack_pointer_global + && *target == stack_pointer_global + && *value > 0 => + { + (*value as u32, None, 4) + } + _ => (0, None, 0), + }; + let mut depth = 0_u32; + let mut restored = false; + let mut index = prologue_end; + while index < operators.len() { + match &operators[index] { + Operator::GlobalGet { global_index } if *global_index == stack_pointer_global => { + if frame_local.is_none() + && frame > 0 + && depth == 0 + && !restored + && matches!(operators.get(index + 1), Some(Operator::I32Const { value }) if *value as u32 == frame) + && matches!(operators.get(index + 2), Some(Operator::I32Add)) + && matches!(operators.get(index + 3), Some(Operator::GlobalSet { global_index }) if *global_index == stack_pointer_global) + { + restored = true; + index += 4; + continue; + } + return Err("unrecognized stack-pointer access makes the bound unknown".into()); } - Operator::I32Sub if pending_stack_pointer => { - if let Some(value) = pending_frame.take() { - frame = frame.max(value); + Operator::LocalGet { local_index } if Some(*local_index) == frame_local => { + if depth == 0 + && !restored + && matches!(operators.get(index + 1), Some(Operator::I32Const { value }) if *value as u32 == frame) + && matches!(operators.get(index + 2), Some(Operator::I32Add)) + && matches!(operators.get(index + 3), Some(Operator::GlobalSet { global_index }) if *global_index == stack_pointer_global) + { + restored = true; + index += 4; + continue; } } + Operator::GlobalSet { global_index } if *global_index == stack_pointer_global => { + return Err("unrecognized stack-pointer write makes the bound unknown".into()); + } + Operator::LocalSet { local_index } | Operator::LocalTee { local_index } + if Some(*local_index) == frame_local => + { + return Err("the saved stack frame is overwritten".into()); + } Operator::Call { function_index } => { - calls.push(function_index); - pending_stack_pointer = false; - pending_frame = None; + calls.push(*function_index); } Operator::ReturnCall { function_index } => { - calls.push(function_index); - pending_stack_pointer = false; - pending_frame = None; + if frame > 0 && !restored { + return Err("return bypasses stack restoration".into()); + } + calls.push(*function_index); } - Operator::CallIndirect { .. } | Operator::ReturnCallIndirect { .. } => { + Operator::CallIndirect { .. } + | Operator::ReturnCallIndirect { .. } + | Operator::CallRef { .. } + | Operator::ReturnCallRef { .. } => { return Err("an indirect call makes the stack bound unknown".into()); } - _ => { - pending_stack_pointer = false; - pending_frame = None; + Operator::Block { .. } | Operator::Loop { .. } | Operator::If { .. } => { + if restored { + return Err("control flow after stack restoration is unsupported".into()); + } + depth += 1; + } + Operator::End if depth > 0 => depth -= 1, + Operator::Return if frame > 0 && !restored => { + return Err("return bypasses stack restoration".into()); + } + Operator::Br { relative_depth } + | Operator::BrIf { relative_depth } + | Operator::BrOnNull { relative_depth } + | Operator::BrOnNonNull { relative_depth } + | Operator::BrOnCast { relative_depth, .. } + | Operator::BrOnCastFail { relative_depth, .. } + if frame > 0 && !restored && *relative_depth >= depth => + { + return Err("branch bypasses stack restoration".into()); } + Operator::BrTable { targets } + if frame > 0 + && !restored + && (targets.default() >= depth + || targets + .targets() + .any(|target| target.is_ok_and(|target| target >= depth))) => + { + return Err("branch bypasses stack restoration".into()); + } + _ => {} } + index += 1; + } + if frame > 0 + && !restored + && !matches!( + operators.as_slice(), + [.., Operator::Unreachable, Operator::End] + ) + { + return Err("a returning function does not restore its stack frame".into()); } Ok((frame, calls)) } @@ -139,6 +253,8 @@ fn visit( visiting, imported_functions, )?); + } else { + return Err("callee is outside the analyzed module".into()); } } visiting[index] = false; @@ -168,7 +284,96 @@ mod tests { fn a_recursive_graph_is_rejected() { // Two mutually recursive functions, each reserving a frame. let bytes = recursive_module(); - assert!(measure_stack_bound(&bytes, 0).is_err()); + assert!( + measure_stack_bound(&bytes, 0) + .unwrap_err() + .contains("recursive call graph") + ); + } + + #[test] + fn unrecognized_stack_writes_and_unbalanced_frames_are_rejected() { + use wasm_encoder::Instruction as I; + let prologue = [ + I::GlobalGet(0), + I::I32Const(32), + I::I32Sub, + I::LocalTee(0), + I::GlobalSet(0), + ]; + for suffix in [ + vec![I::I32Const(1), I::GlobalSet(0)], + vec![I::Return], + vec![I::Br(0)], + vec![I::I32Const(9), I::LocalSet(0)], + vec![I::GlobalGet(0), I::I32Const(32), I::I32Sub, I::GlobalSet(0)], + vec![], + ] { + let mut ops = prologue.to_vec(); + ops.extend(suffix); + assert!(measure_stack_bound(&single_function(&ops), 0).is_err()); + } + assert!( + measure_stack_bound(&single_function(&[I::I32Const(5), I::GlobalSet(0)]), 0).is_err() + ); + } + + #[test] + fn a_reference_branch_cannot_bypass_an_otherwise_valid_restoration() { + use wasm_encoder::Instruction as I; + let ops = [ + I::GlobalGet(0), + I::I32Const(32), + I::I32Sub, + I::LocalTee(0), + I::GlobalSet(0), + I::RefNull(wasm_encoder::HeapType::FUNC), + I::BrOnNull(0), + I::Drop, + I::LocalGet(0), + I::I32Const(32), + I::I32Add, + I::GlobalSet(0), + ]; + let bytes = single_function(&ops); + wasmparser::Validator::new() + .validate_all(&bytes) + .expect("valid module"); + assert!( + measure_stack_bound(&bytes, 0) + .unwrap_err() + .contains("branch bypasses") + ); + } + + fn single_function(ops: &[wasm_encoder::Instruction<'_>]) -> Vec { + use wasm_encoder::*; + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], []); + module.section(&types); + let mut functions = FunctionSection::new(); + functions.function(0); + module.section(&functions); + let mut globals = GlobalSection::new(); + globals.global( + GlobalType { + val_type: ValType::I32, + mutable: true, + shared: false, + }, + &ConstExpr::i32_const(1024), + ); + module.section(&globals); + let mut function = Function::new([(1, ValType::I32)]); + for op in ops { + function.instruction(op); + } + function.instruction(&Instruction::End); + let mut code = CodeSection::new(); + code.function(&function); + module.section(&code); + module.finish() } fn recursive_module() -> Vec { @@ -201,6 +406,10 @@ mod tests { first.instruction(&Instruction::I32Sub); first.instruction(&Instruction::GlobalSet(0)); first.instruction(&Instruction::Call(1)); + first.instruction(&Instruction::GlobalGet(0)); + first.instruction(&Instruction::I32Const(32)); + first.instruction(&Instruction::I32Add); + first.instruction(&Instruction::GlobalSet(0)); first.instruction(&Instruction::End); code.function(&first); let mut second = Function::new([]); @@ -209,6 +418,10 @@ mod tests { second.instruction(&Instruction::I32Sub); second.instruction(&Instruction::GlobalSet(0)); second.instruction(&Instruction::Call(0)); + second.instruction(&Instruction::GlobalGet(0)); + second.instruction(&Instruction::I32Const(32)); + second.instruction(&Instruction::I32Add); + second.instruction(&Instruction::GlobalSet(0)); second.instruction(&Instruction::End); code.function(&second); module.section(&code); diff --git a/crates/psrs-linker/src/target.rs b/crates/psrs-linker/src/target.rs index 5beccce8..14224757 100644 --- a/crates/psrs-linker/src/target.rs +++ b/crates/psrs-linker/src/target.rs @@ -67,8 +67,8 @@ pub struct BindingRequirement { #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub enum ArtifactKind { CoreModule, - /// A guest component provider. Composition is not yet supported; the linker - /// rejects it rather than silently falling back to a host interface. + /// A typed guest component provider. Use `guest::plan_components`; a + /// component cannot satisfy a raw-core artifact contract. Component, } diff --git a/crates/psrs-linker/src/verify/mod.rs b/crates/psrs-linker/src/verify/mod.rs index e1445622..a4930845 100644 --- a/crates/psrs-linker/src/verify/mod.rs +++ b/crates/psrs-linker/src/verify/mod.rs @@ -39,7 +39,7 @@ pub fn verify_artifact( return Err(LinkErrors::one( stage, id, - "guest component providers are not yet supported; there is no silent host fallback", + "component artifacts require typed component planning, not a raw-core contract; there is no silent host fallback", )); } } diff --git a/crates/psrs-linker/src/verify/parse.rs b/crates/psrs-linker/src/verify/parse.rs index 59b179fb..f7f89632 100644 --- a/crates/psrs-linker/src/verify/parse.rs +++ b/crates/psrs-linker/src/verify/parse.rs @@ -70,6 +70,26 @@ pub(super) fn check_contract( "artifact globals do not match the declared contract", )); } + if let Some(storage) = &contract.storage { + let pointer = parsed + .globals + .get(storage.stack_pointer_global as usize) + .ok_or_else(|| LinkErrors::one(stage, id, "stack pointer global is absent"))?; + if !pointer.mutable + || pointer.initial != storage.stack.end + || storage.stack.start >= storage.stack.end + || storage.static_data.start > storage.static_data.end + || contract.initialization.data_range.0 < storage.static_data.start + || contract.initialization.data_range.1 > storage.static_data.end + || storage.stack_bound_bytes > storage.stack.end - storage.stack.start + { + return Err(LinkErrors::one( + stage, + id, + "execution storage disagrees with the artifact stack pointer or initialization", + )); + } + } if parsed.has_elements { return Err(LinkErrors::one( stage, diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index b1eaf528..2f099473 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -94,11 +94,11 @@ fn embedded_artifact_satisfies_its_contract() { } #[test] -fn a_guest_component_provider_is_rejected_without_a_host_fallback() { +fn a_component_contract_cannot_use_raw_core_verification() { let mut contract = number_format_contract(); contract.kind = ArtifactKind::Component; let error = verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) - .expect_err("guest components are not composable yet"); + .expect_err("component bytes cannot satisfy a raw-core contract"); assert!( error.to_string().contains("no silent host fallback"), "{error}" @@ -132,3 +132,71 @@ fn an_overlapping_data_range_is_rejected() { contract.initialization.data_range = (0, 16); assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); } + +#[test] +fn storage_cannot_name_an_absent_immutable_or_displaced_stack_pointer() { + for index in [1, 99] { + let mut contract = number_format_contract(); + contract.storage.as_mut().unwrap().stack_pointer_global = index; + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + } + let mut contract = number_format_contract(); + contract.storage.as_mut().unwrap().stack.end += 8; + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); +} + +#[test] +fn independent_export_table_and_feature_contract_drift_is_rejected() { + let mut contract = number_format_contract(); + contract.exports[0].signature.as_mut().unwrap().parameters[0] = CoreType::F32; + assert!( + verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + .unwrap_err() + .to_string() + .contains("signature") + ); + let mut contract = number_format_contract(); + let mut missing = contract.exports[0].clone(); + missing.name = "absent-export".into(); + contract.exports.push(missing); + assert!( + verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + .unwrap_err() + .to_string() + .contains("missing declared export") + ); + let mut contract = number_format_contract(); + contract.tables[0].minimum = 0; + assert!( + verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + .unwrap_err() + .to_string() + .contains("tables") + ); + let mut contract = number_format_contract(); + contract.required_features.clear(); + assert!( + verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + .unwrap_err() + .to_string() + .contains("not valid Wasm") + ); +} + +#[test] +fn a_valid_but_undeclared_eager_initializer_is_rejected() { + let text = wasmprinter::print_bytes(psrs_runtime::NUMBER_FORMATTER.bytes).unwrap(); + let prefix = text.trim_end().strip_suffix(')').unwrap(); + let bytes = wat::parse_str(format!("{prefix}(func $eager) (start $eager))")).unwrap(); + wasmparser::Validator::new() + .validate_all(&bytes) + .expect("valid initializer module"); + let mut contract = number_format_contract(); + contract.sha256 = crate::sha256_hex(&bytes); + assert!( + verify_artifact(&contract, &bytes) + .unwrap_err() + .to_string() + .contains("start function") + ); +} diff --git a/crates/psrs-linker/tests/compose.rs b/crates/psrs-linker/tests/compose.rs index 15ba7a57..6d319d4b 100644 --- a/crates/psrs-linker/tests/compose.rs +++ b/crates/psrs-linker/tests/compose.rs @@ -127,3 +127,87 @@ fn composition_without_the_artifact_fails_closed() { .unwrap(); assert!(psrs_linker::compose(&context, &link, &core_module()).is_err()); } + +#[test] +fn composition_rejects_a_different_resolved_context() { + let context = resolve_default_definitions().unwrap(); + let link = plan(&context, input()).unwrap(); + let other = resolve_default_definitions().unwrap(); + let error = psrs_linker::compose(&other, &link, &core_module()).unwrap_err(); + assert!(error.to_string().contains("context differs")); +} + +#[test] +fn composition_rejects_memory_and_signature_drift_from_the_plan() { + let context = resolve_default_definitions().unwrap(); + let link = plan(&context, input()).unwrap(); + let core = core_module(); + // Structural rewrites preserve module validity while violating the plan. + let text = wasmprinter::print_bytes(&core).unwrap(); + let small = wat::parse_str(text.replace("(memory (;0;) 4)", "(memory (;0;) 1)")).unwrap(); + assert_ne!(small, core); + assert!( + psrs_linker::compose(&context, &link, &small) + .unwrap_err() + .to_string() + .contains("memory") + ); + let changed = + wat::parse_str(text.replace("(param f64 i32 i32)", "(param f32 i32 i32)")).unwrap(); + assert_ne!(changed, core); + assert!( + psrs_linker::compose(&context, &link, &changed) + .unwrap_err() + .to_string() + .contains("signature") + ); +} + +#[test] +fn a_host_resource_return_uses_the_executable_interface_closure() { + let context = resolve_default_definitions().unwrap(); + let mut input = input(); + input.artifacts.clear(); + input.requirements = vec![BindingRequirement { + id: RequirementId(0), + origin: "get-stdout".into(), + boundary: Boundary::ResolvedWit { + interface: "wasi:cli/stdout@0.2.12".into(), + function: "get-stdout".into(), + }, + expected: Some(CoreSignature { + parameters: vec![], + result: Some(CoreType::I32), + }), + provider: Provider::HostInterface { + interface: "wasi:cli/stdout@0.2.12".into(), + }, + }]; + input.policy.permitted_host_interfaces = context.world_imports().to_vec(); + let link = plan(&context, input).unwrap(); + let core = wat::parse_str( + r#"(module + (import "wasi:cli/stdout@0.2.12" "get-stdout" (func (result i32))) + (memory (export "memory") 2) + (func (export "wasi:cli/run@0.2.12#run") (result i32) call 0 drop i32.const 0))"#, + ) + .unwrap(); + let linked = psrs_linker::compose(&context, &link, &core).unwrap(); + assert_eq!(linked.external_world, link.external_world()); +} + +#[test] +fn composition_rejects_unowned_data_and_a_wrong_allocator_boundary() { + let context = resolve_default_definitions().unwrap(); + let link = plan(&context, input()).unwrap(); + let text = wasmprinter::print_bytes(core_module()).unwrap(); + let prefix = text.trim_end().strip_suffix(')').unwrap(); + for segment in [ + r#"(data (i32.const 131072) "x")"#, + r#"(data (i32.const 16) "\00\00\00\00\00\00\00\00")"#, + ] { + let bytes = wat::parse_str(format!("{prefix}{segment})")).unwrap(); + let error = psrs_linker::compose(&context, &link, &bytes).unwrap_err(); + assert!(error.to_string().contains("application"), "{error}"); + } +} diff --git a/crates/psrs-linker/tests/guest/fixtures.rs b/crates/psrs-linker/tests/guest/fixtures.rs new file mode 100644 index 00000000..d186cb79 --- /dev/null +++ b/crates/psrs-linker/tests/guest/fixtures.rs @@ -0,0 +1,173 @@ +use wit_parser::Resolve; +pub const INTERFACE: &str = "test:lib/api@1.0.0"; + +const WIT: &str = r#" +package test:lib@1.0.0; +interface api { + echo: func(value: string) -> string; + bytes: func() -> result, u32>; + posts: func() -> u32; + drops: func() -> u32; + resource token { + constructor(value: u32); + get: func() -> u32; + } +} +world provider { export api; } +world application { import api; export wasi:cli/run@0.2.12; } +"#; + +fn encode(wit: &str, world: &str, wat: &str) -> Vec { + let mut resolve = Resolve::default(); + for source in psrs_runtime::WASI_WIT { + resolve.push_str(source.path, source.contents).unwrap(); + } + let package = resolve.push_str("fixture.wit", wit).unwrap(); + let world = resolve.packages[package].worlds[world]; + let mut bytes = wat::parse_str(wat).unwrap(); + wit_component::embed_component_metadata( + &mut bytes, + &resolve, + world, + wit_component::StringEncoding::UTF8, + ) + .unwrap(); + wit_component::ComponentEncoder::default() + .module(&bytes) + .unwrap() + .validate(true) + .encode() + .unwrap() +} + +pub fn components() -> (Vec, Vec) { + ( + encode(WIT, "application", APPLICATION), + encode(WIT, "provider", PROVIDER), + ) +} + +pub fn incompatible_provider() -> Vec { + // A valid provider with the same name but a different checked echo shape. + let wit = WIT.replace( + "echo: func(value: string) -> string;", + "echo: func(value: u32) -> u32;", + ); + let wat = PROVIDER.replace("(param $p i32) (param $n i32) (result i32)\n i32.const 0 local.get $p i32.store\n i32.const 4 local.get $n i32.store\n i32.const 0", "(param $p i32) (result i32) local.get $p"); + let wat = wat.replace( + "(func (export \"cabi_post_test:lib/api@1.0.0#echo\") (param i32) call $post)", + "", + ); + encode(&wit, "provider", &wat) +} + +const PROVIDER: &str = r#" +(module + (import "[export]test:lib/api@1.0.0" "[resource-new]token" (func $new (param i32) (result i32))) + (memory (export "memory") 2) + (global $posts (mut i32) (i32.const 0)) + (global $drops (mut i32) (i32.const 0)) + (func (export "cabi_realloc") (param i32 i32 i32 i32) (result i32) i32.const 4096) + (func (export "test:lib/api@1.0.0#echo") (param $p i32) (param $n i32) (result i32) + i32.const 0 local.get $p i32.store + i32.const 4 local.get $n i32.store + i32.const 0) + (func (export "test:lib/api@1.0.0#bytes") (result i32) + i32.const 256 i32.const 104 i32.store8 + i32.const 257 i32.const 105 i32.store8 + i32.const 258 i32.const 33 i32.store8 + i32.const 0 i32.const 0 i32.store + i32.const 4 i32.const 256 i32.store + i32.const 8 i32.const 3 i32.store + i32.const 0) + (func $post + global.get $posts i32.const 1 i32.add global.set $posts + i32.const 4096 i32.const 0 i32.const 32 memory.fill + i32.const 256 i32.const 0 i32.const 3 memory.fill) + (func (export "cabi_post_test:lib/api@1.0.0#echo") (param i32) call $post) + (func (export "cabi_post_test:lib/api@1.0.0#bytes") (param i32) call $post) + (func (export "test:lib/api@1.0.0#posts") (result i32) global.get $posts) + (func (export "test:lib/api@1.0.0#drops") (result i32) global.get $drops) + (func (export "test:lib/api@1.0.0#[constructor]token") (param i32) (result i32) local.get 0 call $new) + (func (export "test:lib/api@1.0.0#[method]token.get") (param i32) (result i32) local.get 0) + (func (export "test:lib/api@1.0.0#[dtor]token") (param i32) + local.get 0 i32.const 39 i32.ne if unreachable end + global.get $drops i32.const 1 i32.add global.set $drops)) +"#; + +const APPLICATION: &str = r#" +(module + (import "test:lib/api@1.0.0" "echo" (func $echo (param i32 i32 i32))) + (import "test:lib/api@1.0.0" "bytes" (func $bytes (param i32))) + (import "test:lib/api@1.0.0" "posts" (func $posts (result i32))) + (import "test:lib/api@1.0.0" "drops" (func $drops (result i32))) + (import "test:lib/api@1.0.0" "[constructor]token" (func $new (param i32) (result i32))) + (import "test:lib/api@1.0.0" "[method]token.get" (func $get (param i32) (result i32))) + (import "test:lib/api@1.0.0" "[resource-drop]token" (func $drop (param i32))) + (memory (export "memory") 2) + (data (i32.const 1024) "firsté") + (data (i32.const 2048) "second🙂") + (global $bump (mut i32) (i32.const 4096)) + (func (export "cabi_realloc") (param i32 i32 i32 i32) (result i32) (local $p i32) + global.get $bump local.tee $p local.get 3 i32.add global.set $bump local.get $p) + (func $eq (param $a i32) (param $b i32) (param $n i32) (local $i i32) + block loop + local.get $i local.get $n i32.eq br_if 1 + local.get $a local.get $i i32.add i32.load8_u + local.get $b local.get $i i32.add i32.load8_u i32.ne if unreachable end + local.get $i i32.const 1 i32.add local.set $i br 0 + end end) + (func (export "wasi:cli/run@0.2.12#run") (result i32) (local $token i32) + i32.const 1024 i32.const 7 i32.const 64 call $echo + i32.const 2048 i32.const 10 i32.const 80 call $echo + i32.const 68 i32.load i32.const 7 i32.ne if unreachable end + i32.const 84 i32.load i32.const 10 i32.ne if unreachable end + i32.const 64 i32.load i32.const 1024 i32.const 7 call $eq + i32.const 80 i32.load i32.const 2048 i32.const 10 call $eq + i32.const 128 call $bytes + i32.const 128 i32.load if unreachable end + i32.const 136 i32.load i32.const 3 i32.ne if unreachable end + i32.const 132 i32.load i32.load8_u i32.const 104 i32.ne if unreachable end + i32.const 132 i32.load i32.load8_u offset=2 i32.const 33 i32.ne if unreachable end + call $posts i32.const 3 i32.ne if unreachable end + i32.const 39 call $new local.tee $token call $get i32.const 39 i32.ne if unreachable end + local.get $token call $drop + call $drops i32.const 1 i32.ne if unreachable end + i32.const 0)) +"#; + +pub fn forwarding_component(import: &str, export: &str) -> Vec { + wat::parse_str(format!( + r#"(component + (type $api (instance (export "value" (func (result u32))))) + (import "{import}" (instance $value (type $api))) + (export "{export}" (instance $value)))"# + )) + .unwrap() +} + +pub fn constant_component(export: &str) -> Vec { + wat::parse_str(format!( + r#"(component + (core module $m (func (export "value") (result i32) i32.const 42)) + (core instance $m (instantiate $m)) + (func $value (result u32) (canon lift (core func $m "value"))) + (instance $api (export "value" (func $value))) + (export "{export}" (instance $api)))"# + )) + .unwrap() +} + +pub fn definition_only_package() -> Vec { + let mut resolve = Resolve::default(); + let package = resolve + .push_str( + "definitions.wit", + r#" + package test:lib@1.0.0; + interface api { value: func() -> u32; } + "#, + ) + .unwrap(); + wit_component::encode(&resolve, package).unwrap() +} diff --git a/crates/psrs-linker/tests/guest/mod.rs b/crates/psrs-linker/tests/guest/mod.rs new file mode 100644 index 00000000..4602006f --- /dev/null +++ b/crates/psrs-linker/tests/guest/mod.rs @@ -0,0 +1,210 @@ +mod fixtures; +use psrs_linker::guest::{ + ComponentLinkInput, ComponentReference, GuestBinding, compose_component, plan_components, +}; +use psrs_linker::{TargetPolicy, sha256_hex}; + +fn reference(id: &str, bytes: Vec) -> ComponentReference { + ComponentReference { + id: id.into(), + sha256: sha256_hex(&bytes), + bytes, + } +} + +fn fixture_input() -> ComponentLinkInput { + let (application, provider) = fixtures::components(); + ComponentLinkInput { + application: reference("application", application), + guests: vec![reference("provider", provider)], + bindings: vec![GuestBinding { + interface: fixtures::INTERFACE.into(), + artifact: "provider".into(), + export: fixtures::INTERFACE.into(), + }], + policy: TargetPolicy::default(), + features: wasmparser::WasmFeatures::default(), + } +} + +#[test] +fn strings_lists_results_post_return_and_resource_lifetimes_execute() { + let input = fixture_input(); + let application = input.application.bytes.clone(); + let plan = plan_components(input).expect("typed guest interfaces should connect"); + assert!(plan.external_world().is_empty()); + let linked = compose_component(&plan, &application).unwrap(); + let path = std::env::temp_dir().join(format!("psrs-guest-{}.wasm", std::process::id())); + std::fs::write(&path, &linked.bytes).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .expect("Wasmtime is required for guest composition acceptance"); + std::fs::remove_file(&path).unwrap(); + assert!(output.status.success(), "{output:?}"); + assert!(output.stdout.is_empty()); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn stale_guest_and_changed_application_are_rejected() { + let mut input = fixture_input(); + input.guests[0].sha256 = "0".repeat(64); + assert!( + plan_components(input) + .unwrap_err() + .to_string() + .contains("digest") + ); + let input = fixture_input(); + let plan = plan_components(input).unwrap(); + assert!(compose_component(&plan, b"other application").is_err()); +} + +#[test] +fn missing_guest_and_version_drift_never_fall_back_to_the_host() { + let mut input = fixture_input(); + input.guests.clear(); + input + .policy + .permitted_host_interfaces + .push(fixtures::INTERFACE.into()); + assert!(plan_components(input).is_err()); + let mut input = fixture_input(); + input.bindings[0].export = "test:lib/api@2.0.0".into(); + assert!(plan_components(input).is_err()); +} + +#[test] +fn an_incompatible_guest_interface_is_rejected() { + let mut input = fixture_input(); + let bytes = fixtures::incompatible_provider(); + input.guests[0] = reference("provider", bytes); + assert!(plan_components(input).is_err()); +} + +const API: &str = "test:graph/api@1.0.0"; +const DEP: &str = "test:graph/dependency@1.0.0"; +const HOST: &str = "test:graph/host@1.0.0"; + +fn graph_input() -> ComponentLinkInput { + ComponentLinkInput { + application: reference("application", fixtures::forwarding_component(API, API)), + guests: vec![reference( + "provider", + fixtures::forwarding_component(HOST, API), + )], + bindings: vec![GuestBinding { + interface: API.into(), + artifact: "provider".into(), + export: API.into(), + }], + policy: TargetPolicy { + permitted_host_interfaces: vec![HOST.into()], + }, + features: wasmparser::WasmFeatures::default(), + } +} + +#[test] +fn only_used_guest_dependencies_contribute_exact_residual_host_imports() { + let mut input = graph_input(); + // Unreachable artifacts are neither validated nor included in the closure. + input + .guests + .push(reference("unused", b"not an executable component".to_vec())); + let plan = plan_components(input).unwrap(); + assert_eq!(plan.external_world(), &[HOST]); + assert_eq!(plan.component_artifacts().len(), 2); + let mut input = graph_input(); + input.policy.permitted_host_interfaces.clear(); + assert!( + plan_components(input) + .unwrap_err() + .to_string() + .contains(HOST) + ); +} + +#[test] +fn transitive_guest_dependencies_close_without_host_fallback() { + let mut input = graph_input(); + input.guests[0] = reference("provider", fixtures::forwarding_component(DEP, API)); + input + .guests + .push(reference("dependency", fixtures::constant_component(DEP))); + input.bindings.push(GuestBinding { + interface: DEP.into(), + artifact: "dependency".into(), + export: DEP.into(), + }); + let plan = plan_components(input).unwrap(); + assert!(plan.external_world().is_empty()); + assert_eq!(plan.component_artifacts().len(), 3); +} + +#[test] +fn provider_conflicts_missing_exports_and_dependency_cycles_fail_closed() { + let mut input = graph_input(); + input.bindings.push(input.bindings[0].clone()); + assert!( + plan_components(input) + .unwrap_err() + .to_string() + .contains("conflicting") + ); + let mut input = graph_input(); + input.guests[0] = reference("provider", fixtures::constant_component(DEP)); + assert!( + plan_components(input) + .unwrap_err() + .to_string() + .contains("omits selected export") + ); + let mut input = graph_input(); + input.guests[0] = reference("provider", fixtures::forwarding_component(DEP, API)); + input.guests.push(reference( + "dependency", + fixtures::forwarding_component(API, DEP), + )); + input.bindings.push(GuestBinding { + interface: DEP.into(), + artifact: "dependency".into(), + export: DEP.into(), + }); + assert!(plan_components(input).is_err()); +} + +#[test] +fn component_features_are_validated_against_the_selected_profile() { + let mut input = graph_input(); + input + .features + .remove(wasmparser::WasmFeatures::COMPONENT_MODEL); + assert!(plan_components(input).is_err()); +} + +#[test] +fn definition_bytes_cannot_supply_an_executable_interface() { + let mut input = fixture_input(); + input.guests[0] = reference("provider", fixtures::definition_only_package()); + assert!(plan_components(input).is_err()); +} + +#[test] +fn guest_executable_initialization_requires_an_explicit_contract() { + let mut input = fixture_input(); + let provider = wat::parse_str(format!( + r#"(component + (core module $m (func $start) (start $start)) + (core instance $m (instantiate $m)) + (instance $api) + (export "{}" (instance $api)))"#, + fixtures::INTERFACE + )) + .unwrap(); + input.guests = vec![reference("provider", provider)]; + let error = plan_components(input).unwrap_err().to_string(); + assert!(error.contains("initialization"), "{error}"); +} diff --git a/crates/psrs-linker/tests/plan.rs b/crates/psrs-linker/tests/plan.rs index 0cccb404..f2606bfe 100644 --- a/crates/psrs-linker/tests/plan.rs +++ b/crates/psrs-linker/tests/plan.rs @@ -99,22 +99,11 @@ fn a_live_formatter_requirement_reserves_storage_and_closes_the_private_import() link.import(RequirementId(0)).unwrap().module, psrs_runtime::MODULE_NAME ); - // The external world is the transitive closure of the used host interface. - assert!( - link.external_world() - .iter() - .any(|id| id == "wasi:cli/stdout@0.2.12") - ); - assert!( - link.external_world() - .iter() - .any(|id| id == "wasi:io/streams@0.2.12") - ); - assert!( - !link - .external_world() - .iter() - .any(|id| id == psrs_runtime::MODULE_NAME) + // The encoder retains only the live resource owner, not unused methods' + // dependencies (`error` and `poll` belong to other streams operations). + assert_eq!( + link.external_world(), + &["wasi:cli/stdout@0.2.12", "wasi:io/streams@0.2.12"] ); assert_eq!(link.digests().len(), 1); assert_eq!( @@ -268,3 +257,61 @@ fn a_definition_contract_does_not_satisfy_execution() { .is_err() ); } + +#[test] +fn the_policy_cannot_introduce_an_interface_absent_from_the_world() { + let context = resolve_default_definitions().unwrap(); + let mut requirement = stdout_requirement(0); + let interface = "wasi:cli/stdout@99.0.0"; + requirement.boundary = Boundary::ResolvedWit { + interface: interface.into(), + function: "get-stdout".into(), + }; + requirement.provider = Provider::HostInterface { + interface: interface.into(), + }; + let mut input = input(vec![requirement], Vec::new()); + input + .policy + .permitted_host_interfaces + .push(interface.into()); + assert!( + plan(&context, input) + .unwrap_err() + .to_string() + .contains("outside the resolved world") + ); +} + +#[test] +fn impossible_memory_demands_are_rejected_before_arithmetic() { + let context = resolve_default_definitions().unwrap(); + for (range, alignment) in [((16, 0), 8), ((0, 16), 3), ((0, 16), 0)] { + let mut input = input(Vec::new(), Vec::new()); + input.memory.canonical_scratch = range; + input.memory.heap_alignment = alignment; + assert!(plan(&context, input).is_err()); + } + let mut artifact = formatter_artifact(); + artifact.contract.storage.as_mut().unwrap().minimum_pages = u64::MAX; + assert!( + plan( + &context, + input(vec![formatter_requirement()], vec![artifact]) + ) + .is_err() + ); +} + +#[test] +fn a_resource_owner_disabled_by_policy_cannot_hide_behind_a_live_method() { + let context = resolve_default_definitions().unwrap(); + let mut input = input(vec![stdout_requirement(0)], Vec::new()); + input.policy.permitted_host_interfaces = vec!["wasi:cli/stdout@0.2.12".into()]; + assert!( + plan(&context, input) + .unwrap_err() + .to_string() + .contains("resource dependency") + ); +} diff --git a/docs/decision/DEC-18-unified-target-linking.md b/docs/decision/DEC-18-unified-target-linking.md index 9dcfff53..837b964a 100644 --- a/docs/decision/DEC-18-unified-target-linking.md +++ b/docs/decision/DEC-18-unified-target-linking.md @@ -1,7 +1,8 @@ # DEC-18 — Unified Target Linking -**Status:** Accepted; implemented for the core-Wasm formatter slice. General -guest WIT provider composition remains unimplemented. +**Status:** Accepted; core-Wasm formatter linking and explicit synchronous +guest interface composition are implemented. + **Date:** 2026-10-07. ## Context and constraints @@ -101,8 +102,10 @@ are not implied by this decision. Artifact composition must respect each chosen boundary. Additional supported input formats need their own conversion and verification contracts. -The existing uncommitted Show/runtime prototype is not evidence that this -contract is implemented. Its late attachment, duplicated checks, and fixed -reservation must be reconciled with the checked plan before acceptance. General -guest WIT component linking remains unimplemented; the design preserves its -requirements rather than describing the prototype as a complete linker. +The formatter implementation now carries one checked core link plan through +emission and composition. Explicit synchronous guest interface composition uses +a checked component graph after source-to-component lowering; it preserves +component-owned memory and canonical ownership rather than applying core memory +reservations to separate components. Its supported entry point and remaining +obligations are recorded in the design and acceptance checklist. Neither slice +establishes arbitrary dynamic component loading or shared GC representations. diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index 98dc66b1..eca966ac 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -1,8 +1,9 @@ # Linking and Runtime Implementations **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) -**Status:** Implemented for the core-Wasm formatter slice. General guest WIT -provider composition remains unsupported; see the open questions below. +**Status:** Core-Wasm formatter linking and explicit synchronous guest interface +composition are implemented; general loading extensions remain future work. + **Prerequisites:** [IR boundaries](../00-ir-boundaries.md), [primitive FFI](primitive-ffi-and-stdlib.md), [canonical ABI and WIT](canonical-abi-and-wit.md), @@ -212,7 +213,7 @@ closure, not every interface mentioned in the package's default world. Resolve all needed WIT definitions for type checking, but select executable providers only for reachable interfaces and retained initialization needs. Provider bindings are explicit build inputs: current compiler-owned WASI bindings -select host interfaces; future guest bindings select pinned component exports. +select host interfaces; explicit component bindings select pinned guest exports. Merely placing WIT files in a directory never selects a provider. For a host binding, verify that the selected target world permits that interface @@ -270,9 +271,17 @@ other export/import must be understood and declared, not blanket-accepted. The pinned nonrecursive formatter's maximum stack use must be established by artifact analysis or an explicit reviewed build assumption plus stress evidence. Checking the initial stack pointer alone does not prove a bound. Reentrancy, -callbacks, memory growth, or a different runtime provider requires revisiting -the storage contract. Additional artifacts need disjoint reservations or an -explicit shared allocator; the linker must not reuse this fixed region blindly. +callbacks, or a different runtime provider requires revisiting the storage +contract. For the current allocator, successful memory growth preserves existing +addresses and bytes: reservations stay below the fixed heap boundary and the +runtime stack pointer does not move. Block metadata is committed only after +growth succeeds, with unsigned overflow checks before capacity calculations. +Allocator execution checks the exact page boundary, growth failure and wrapped +free-list sizes; source execution interleaves a 70,000-byte canonical WASI +allocation with formatting and retained GC Strings. This establishes growth +under the current nonreentrant calling protocol. Additional artifacts need +disjoint reservations or an explicit shared allocator; the linker must not reuse +this fixed region blindly. This extends the strict "canonical ABI only" linear-memory clause of DEC-09/10 to permit declared private runtime execution storage. Language values remain on @@ -467,12 +476,54 @@ digests, plan inputs, checks, and failures as explicit lineage alongside MIR and binary artifacts. Runtime observations remain separate evidence. A valid link plan proves binding/layout checks, not official-library semantic conformance. -## Open questions and future work - -The concrete manifest syntax and CLI for independently supplied WIT providers -are not yet selected. Their ownership and checked-plan obligations are defined -above; general component loading remains unsupported until that entry point and -its verification exist. Do not imply a new supported CLI flag in documentation. +## Supported component entry and future work + +The initial guest entry point is `psrs link application.wasm --manifest +providers.json -o linked.wasm [--report report.json]`. It consumes an already +validated application component, pinned executable guest components and explicit +whole-interface bindings. The version-1 manifest and report are specified in +[Explicit Component Linking](../../../workflow/component-linking.md). +`psrs build` owns source compilation and accepts `--manifest` explicitly after +completing the checked core runtime plan. It computes the produced application's +pin rather than requiring the user to predict its bytes. An optional supplied +root pin is still checked. `--report` joins the source diagnosis artifact to +component composition by exact digest. Standalone `psrs link` requires all pins; +neither command discovers providers. + +`psrs-linker::guest::plan_components` uses the pinned `wasm-compose` 0.245.1 +in-memory graph API. Every participating component is parsed with the same +validator so cross-component resource identities share one type universe. +Closure starts at the application, follows explicit guest edges, and retains +only permitted unbound interface instances as host imports. Unused candidates +are omitted. Duplicate bindings, digest drift, incompatible interfaces, missing +exports and instantiation cycles fail closed. An explicitly selected guest +never falls back to the host. Canonical adaptation preserves each component's +memory, realloc and post-return operations through typed instance connections. + +The core `CheckedLinkPlan` remains bound to one immutable resolved WIT context, +raw import signatures and memory reservations. Composition independently checks +the actual application's imports, minimum memory and active initialization +before attaching core libraries. Component composition uses a distinct sealed +`CheckedComponentPlan`: its memories remain component-owned, so it does not +fabricate an application-wide linear memory plan. The component plan holds the +validated graph encoding, exact root digest, selected binding edges, artifact +pins, validator feature policy and residual host imports. Emission accepts only +the root bytes checked by that plan. Both plans are linker-owned target records; +neither contains compiler IR or reinterprets source types. + +Guest graph closure requires exact equality with the encoded outer imports. +WIT type dependencies are not independent executable capabilities. The core-to-component path derives the same projection by encoding the planned +WIT function signatures in a nonexecuted import-only module. The authoritative +component encoder determines resource-owner imports, without expanding unused +interface methods. Final composition independently requires exact import-set +equality with this projection. Every retained resource owner must also satisfy +world membership and target policy. + +Only synchronous whole-interface instance imports with matching canonical +interface names are supported by the initial entry point. Non-interface +imports, implicit version adaptation, partial method providers, cyclic +instantiation, dynamic discovery and asynchronous composition require explicit +extensions. A definition-only WIT package is not an executable provider. The runtime stack bound is measured by a static call-graph analysis of the pinned nonrecursive artifact, and the artifact-provenance representation is @@ -484,10 +535,13 @@ explicit extensions. Existing WIT/WASI binding code precedes this plan model. The formatter slice now carries one checked plan from requirement closure through artifact verification, Wasm emission, and component assembly, with a target-only linker test suite and -an end-to-end formatter execution test. The stack bound is still a reviewed -pinned-build assumption pending stress evidence, and general guest WIT component -linking remains unimplemented; no general-linker claim follows from the -formatter slice. +an end-to-end formatter execution test. The stack bound is measured over a restricted +frame protocol: one constant prologue, an immutable saved frame and checked restoration before returning. +Unrecognized stack-pointer access, indirect/imported calls, recursion, exception +unwinding and suspension are rejected. The declared stack-pointer global must +be mutable and initialize at the reserved stack top. These checks establish the +formatter bound; they do not establish arbitrary runtime-library memory safety. +Guest execution evidence is recorded separately from the formatter slice. ## References diff --git a/docs/feature/F-02-portable-programs.md b/docs/feature/F-02-portable-programs.md index 687d1ae7..aa9ce7d6 100644 --- a/docs/feature/F-02-portable-programs.md +++ b/docs/feature/F-02-portable-programs.md @@ -25,6 +25,28 @@ Existing Node.js APIs and JavaScript FFI modules are not supported compatibility targets. Programs that use unsupported syntax, types, or platform services receive source-oriented diagnostics rather than a malformed artifact. +An already built application component can select pinned guest implementations +for its interface imports: + +```sh +psrs link main.wasm --manifest providers.json -o linked.wasm --report link.json +``` + +The manifest selects each guest by interface name and artifact digest. Paths are +relative to the manifest. The linker follows the selected guests' dependencies, +rejects incompatible exports or missing providers, and reports the exact host +interfaces left unresolved. An explicitly selected guest does not fall back to +a host implementation. The initial interface binding is synchronous and covers +one whole interface, preserving resource lifetime and provider-owned memory. +Source `build` can explicitly select the same providers with `--manifest` and +emit a joined source/component report with `--report`. The compiler pins its +produced root bytes; externally supplied application components require a root +pin in the manifest. Guest executable initialization is rejected until it has +an explicit checked effect contract. + +See [Explicit Component Linking](../workflow/component-linking.md) for the +manifest format and supported boundary. + The compiler selects `Main.main` when that declaration exists; otherwise it requires exactly one top-level declaration named `main`. The selected entry takes no arguments and may return `Int` or `Effect Unit`. An integer result @@ -136,7 +158,7 @@ function calls. ## Acceptance criteria -- A supported source program produces a validated core Wasm module at the +- A supported source program produces a validated WASI component at the requested output path. - The compiler prints WAT or writes it at the requested output path. - The WASI artifact runs in a compatible runtime and preserves observable @@ -145,6 +167,8 @@ function calls. trap. - Unsupported constructs fail with a source-oriented diagnostic. - Each added platform service has documented behavior and executable tests. +- Explicit guest linking verifies artifact pins and interface compatibility, + preserves canonical ownership, and reports the permitted residual host imports. ## Initial scope diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index 466528b2..3b5d9fab 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -1,42 +1,40 @@ # Linking and Runtime Acceptance -**Design:** [Linking and Runtime](../../design/backend/wasm/linking-and-runtime.md). -**Decision:** [DEC-18 (Accepted)](../../decision/DEC-18-unified-target-linking.md). -**Status:** Implemented for the core-Wasm formatter slice; guest WIT provider -composition remains unsupported. -**Recorded:** 2026-10-07; implementation evidence recorded 2026-10-07. +**Design:** [Linking and Runtime](../../design/backend/wasm/linking-and-runtime.md). +**Decision:** [DEC-18 (Accepted)](../../decision/DEC-18-unified-target-linking.md). +**Status:** LK-01 through LK-15 verified for the supported stable synchronous +target contract, including source-build guest composition and locked Show. -This is the acceptance contract for unified target linking. The formatter slice -now carries one checked plan from requirement closure through artifact -verification, Wasm emission, and component assembly. +**Recorded:** 2026-10-07; implementation evidence recorded 2026-10-07. -Status vocabulary: +This is the acceptance contract for unified target linking. The core plan carries +requirements through artifact verification, Wasm emission and core component +assembly. The checked guest graph composes that produced component, preserving +its artifact lineage and the exact final host capability set. -- `Verified` — the requirement is established for the supported target contract. -- `Verified (formatter)` — established only for the core-Wasm formatter slice; - the general contract, in particular guest WIT providers, is not covered. -- `Partial` — a recorded subset or assumption; the named evidence is missing. -- `Unverified` — not implemented. +`Verified` means the complete required evidence is established for the supported +stable target contract. Future formats or target proposals remain explicit +design extensions; this status does not grant support to rejected inputs. | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | -| LK-01 | A checked language intrinsic selects one catalog implementation; raw ABI does not replace its scheme | Accepted use plus malformed source/Core operand/result rejection; registry and implementation identities agree | Verified (formatter) | -| LK-02 | Direct operations, generated helpers, artifact exports, and entry-generated imports participate in one requirement closure | Composed source/MIR examples, missing-provider rejection, unused implementation omission, initializer reachability | Verified (formatter) | +| LK-01 | A checked language intrinsic selects one catalog implementation; raw ABI does not replace its scheme | Accepted use plus malformed source/Core operand/result rejection; registry and implementation identities agree | Verified | +| LK-02 | Direct operations, generated helpers, artifact exports, and entry-generated imports participate in one requirement closure | Composed source/MIR examples, missing-provider rejection, unused implementation omission, initializer reachability | Verified | | LK-03 | Artifact signatures, digests, features, imports, exports, tables, and initialization match declared contracts | Valid artifact plus independently malformed signature, stale digest, unexpected import/feature/table/start and missing-export rejection | Verified | | LK-04 | One immutable checked plan drives emission and component assembly | API and trace evidence; deliberately mismatched emitted imports/memory rejected; no late import-name provider selection | Verified | -| LK-05 | Shared memory reservations and allocator boundaries cannot overlap or overflow | Malformed ranges/bounds rejected; runtime formatting interleaved with WASI allocation, output and memory growth | Verified (formatter); memory growth not exercised | -| LK-06 | Formatter output is recovered into a GC String before temporary bytes are released | Retain earlier strings across many later formats and WASI calls, asserting exact contents; bounded buffer reuse evidence | Verified (formatter) | -| LK-07 | Runtime stack use fits its declared region under supported calling behavior | Recorded static bound or reviewed pinned-build assumption with stress evidence; unsupported reentrancy/initialization explicitly rejected | Verified (formatter): static call-graph bound plus recursion rejection and stress | -| LK-08 | Instantiation closes function/memory dependencies before execution | Run a legitimate shim cycle; reject unresolved/eager initializer cycles; inspect that private runtime imports are absent from the final external world | Verified (formatter) | -| LK-09 | WIT definition resolution and executable provider selection remain separate | A definition-only package does not satisfy a live import; pinned host/guest binding selection, version/provider conflicts and missing exports tested | Partial: host selection, version/conflict, definition-only and explicit guest fail-closed verified; guest binding selection pending | -| LK-10 | Guest WIT composition preserves provider memory, canonical ownership and resource identity | Cross-component string/list/result execution, post-return/free behavior, resource constructor/method/destructor coherence; incompatible providers rejected | Unverified: guest providers unsupported | -| LK-11 | The external world contains exactly permitted residual host capabilities | Used/unused service tests, guest transitive host dependency tests, disallowed capability and silent-fallback rejection | Partial: world membership, target-profile gating, private-import closure, and guest fail-closed verified; exact planned-set equality and guest transitive deps pending | -| LK-12 | Runtime artifact regeneration and compile lineage are reproducible | Pinned source/dependency/toolchain/recipe manifest, artifact hashes, repeat-build agreement, plan inputs and selected providers recorded in diagnosis | Verified: provenance, plan lineage, and `tools/check-reproducible.sh` byte agreement | -| LK-13 | Public Show executes with official semantics and preserved pure source/API | Pinned official source audit and JS oracle for Int, Number, Char, String, arrays and callback order; mandatory Wasmtime with byte-exact outputs | Partial: Wasmtime byte-exact Show set verified; library JS oracle external | +| LK-05 | Shared memory reservations and allocator boundaries cannot overlap or overflow | Malformed ranges/bounds rejected; runtime formatting interleaved with WASI allocation, output and memory growth | Verified | +| LK-06 | Formatter output is recovered into a GC String before temporary bytes are released | Retain earlier strings across many later formats and WASI calls, asserting exact contents; bounded buffer reuse evidence | Verified | +| LK-07 | Runtime stack use fits its declared region under supported calling behavior | Recorded static bound with stress evidence; unsupported reentrancy/initialization explicitly rejected | Verified | +| LK-08 | Instantiation closes function/memory dependencies before execution | Run a legitimate shim cycle; reject unresolved/eager initializer cycles; inspect that private runtime imports are absent from the final external world | Verified | +| LK-09 | WIT definition resolution and executable provider selection remain separate | A definition-only package does not satisfy a live import; pinned host/guest binding selection, version/provider conflicts and missing exports tested | Verified | +| LK-10 | Guest WIT composition preserves provider memory, canonical ownership and resource identity | Cross-component string/list/result execution, post-return/free behavior, resource constructor/method/destructor coherence; incompatible providers rejected | Verified | +| LK-11 | The external world contains exactly permitted residual host capabilities | Used/unused service tests, guest transitive host dependency tests, disallowed capability and silent-fallback rejection | Verified | +| LK-12 | Runtime artifact regeneration and compile lineage are reproducible | Pinned source/dependency/toolchain/recipe manifest, artifact hashes, repeat-build agreement, plan inputs and selected providers recorded in diagnosis | Verified | +| LK-13 | Public Show executes with official semantics and preserved pure source/API | Pinned official source audit and JS oracle for Int, Number, Char, String, arrays and callback order; mandatory Wasmtime with byte-exact outputs | Verified | | LK-14 | Runtime owns one WIT/artifact catalog; linker owns definition resolution; backend owns source/ABI validation | Move pinned WIT/default-world assets without byte drift; ABI lookup and composition use one resolved context; reject pin drift; no compiler dependencies or formatter code in metadata-only consumption | Verified | | LK-15 | Independent linker crate consumes target records without compiler IR dependencies | Dependency-graph audit; target-only plan/composition tests; backend request conversion and source-diagnostic attribution; no MIR/backend/HIR/Core types in linker APIs | Verified | -## Formatter behavior cases +## Public Show behavior cases The library-owned oracle must cover signed-i32 extrema; negative zero; finite, NaN and infinite Number values; notation boundaries and neighboring values; @@ -57,7 +55,23 @@ Wasm validation, execution, and official oracle agreement are separate evidence. verification and the measured stack bound (`verify::tests`, `stack::tests`), definition resolution (`definitions::tests`), provider closure, target-policy gating, version-pin drift and memory planning (`tests/plan.rs`), and - composition (`tests/compose.rs`). + composition (`tests/compose.rs`). The composition boundary rejects different + WIT contexts, actual signature/memory drift, unowned data and incorrect + allocator initialization. `closure.rs` projects actual WIT call signatures + through the same encoder used by final composition: `get-stdout` retains its + `streams` resource owner, without expanding unused `error`/`poll` methods. +- `psrs-linker` `tests/guest/` validates pinned whole-interface binding graphs, + transitive guest/host closure, unused candidates, conflicts, missing exports, + incompatible function shapes, definition-only packages, dependency cycles and + target feature restrictions. Mandatory Wasmtime execution passes UTF-8 strings + twice across distinct memories, checks earlier values after provider + post-return clears its buffer, verifies a byte-list result and three + post-return calls, then checks resource constructor/method/destructor coherence. +- `psrs-cli` `tests/link.rs` verifies manifest-relative provider paths, selected + pins, exact host closure and report/output digest agreement; stale bytes and + WASI interfaces outside the target profile fail before files are emitted. + [Explicit Component Linking](../../workflow/component-linking.md) specifies + this entry point. Source build reports join diagnosis and graph lineage. - `psrs-runtime` formatter token tests, catalog digest, and `tools/check-reproducible.sh`, which rebuilds the artifact and requires it to reproduce the committed bytes. @@ -79,23 +93,119 @@ Wasm validation, execution, and official oracle agreement are separate evidence. and `tests::show::formatter_plan_records_the_pinned_artifact_digest` assert the compile diagnosis records the selected providers, artifact digests, memory boundary, stack bounds, and planned external world. -- Workspace validation: `cargo fmt --all --check`, `cargo clippy --workspace - --all-targets -- -D warnings`, and `cargo test --workspace` (with - `PSRS_STDLIB_ROOT` for the dirty stdlib checkout). One pre-existing - `psrs-resolve` unit failure reproduces at `HEAD`. - -## Current continuation state - -The formatter slice is implemented and verified to the extent above. Remaining -work: - -- The library-owned official `Show` oracle and source/API audit (LK-13), in - `psrs-stdlib`. -- Guest WIT provider binding selection, resource identity, and cross-component - composition (LK-09..LK-11). This needs a component-to-component linker; the - pinned `wit-component` exposes core-module linking only, so the linker rejects - guest component providers explicitly rather than falling back to a host - interface. It also needs the shared allocator and explicit instantiation steps - a second provider would require. - -Do not label the overall topic complete after only the formatter slice. +- Validation for this continuation uses focused linker, CLI, backend formatter + and source-level Show/diagnosis tests, required Wasmtime execution, formatting, + workspace Clippy and byte-for-byte runtime regeneration. Full workspace tests + are omitted under the user's explicit validation scope; this record does not + claim a new workspace-wide acceptance measurement. + +### Continuation validation + +Measured with mandatory Wasmtime execution and `PSRS_STDLIB_ROOT` pointing to +the development stdlib checkout where source-level tests require it: + +| Command or focused filter | Result | +| --- | --- | +| `cargo test -p psrs-linker` | 42 passed: 15 unit, 6 core composition, 9 guest composition, 12 plan | +| `cargo test -p psrs-cli --test link --test source_layout` | 2 passed | +| `cargo test -p psrs-backend --lib mir::number_format_tests` | 1 passed | +| `cargo test -p psrs-backend --lib mir::gc_tests` | 22 passed | +| `cargo test -p psrs-driver --lib tests::show::` | 5 passed | +| `cargo test -p psrs-driver --lib tests::wasi::wrappers::` | 19 passed | +| `cargo test -p psrs-driver --lib tests::diagnosis_trace::target_plan_records_provider_and_memory_lineage` | 1 passed | +| `cargo fmt --all --check` | Passed | +| `cargo clippy --workspace --all-targets -- -D warnings` | Passed | +| `sh crates/psrs-runtime/tools/check-reproducible.sh` | Committed artifact reproduced byte-for-byte | + +The guest execution test requires Wasmtime unconditionally; backend and driver +execution runs set `PSRS_REQUIRE_WASMTIME=1`. The full workspace test suite and +new corpus scoreboard measurements are outside this continuation's validation +scope. No new source syntax or official source diagnostic is introduced. + +## Supported-contract closure + +The acceptance boundary is the stable synchronous target stated in the design: +checked direct primitives and generated helpers, the complete pinned core +runtime catalog, explicit whole-interface guest providers, and exact residual +host capabilities. Unsupported relocatable/dynamic loading, async/WASI 0.3, +partial-method bindings, version adapters, reentrant runtime libraries and eager +provider initialization remain explicit errors or future design extensions. +They are not silently accepted and are not implemented by this verification. +The normative design's general invariants remain unchanged. + +### Requirement audit + +- LK-01/02: language schemes remain HIR/Core-owned. Raw artifact signatures + cannot establish a Number-to-String use. The runtime implementation descriptor + is shared by intrinsic lowering and requirement selection. Optimized command + closure starts at the entry, retaining direct calls, tail calls, function + references and closure construction; modules without an entry retain all + definitions. Generated codecs/allocators and command exit remain explicit + roots. Unused functions no longer keep foreign service imports alive. +- LK-03/04/08: encoded application imports, memory and active initialization + are independently checked against the plan. Even a scalar-only application + emits the plan's minimum memory. Source and synthesized command exit reuse + one checked import; execution distinguishes stored/forced actions by exit + codes 0/99. Core artifact eager starts and guest + executable starts are rejected; typed component instantiation closes guest + dependencies before command invocation. Backend fixtures use their real + explicit requirements instead of an empty-plan composition bypass. +- LK-05/06/07: the allocator checks block capacity overflow and grows memory + before writing fresh metadata. Its Wasmtime fixture ends one allocation at + exactly 65536, allocates beyond that boundary, observes two pages, checks old + bytes and subsequent reuse, and rejects wrapped free-list sizes. A source + program retains `show 1e21`, performs a 70,000-byte WASI random allocation, + formats the minimum subnormal, and prints/checks the retained String again. + Growth preserves reserved addresses and the fixed runtime stack region; + measured stack analysis and byte-reproducibility remain mandatory. +- LK-09/10/11: executable guest selection is explicit and pinned, never inferred + from definition packages or raw-signature coincidence. Shared validator type + identity and typed graph connections preserve canonical ownership and + resources. Source `WASI.Random.insecureSeed` is bound to a guest returning + `(5,37)` and executes to exit 42; its unused random services disappear from + the encoded outer world. Transitive host/guest, conflicts, type/feature/version + rejection, post-return and destructor evidence remains in linker tests. +- LK-12/14/15: `build --manifest --report` records source/pass/artifact lineage, + the exact produced component artifact/digest, manifest digest, checked graph + pins/edges/profile, residual host imports and final digest. Rejected guest plans retain the source lineage and diagnostic + without a successful output digest. Standalone `link` + still requires the root pin. Runtime owns the immutable WIT/artifact catalog; + the independent linker consumes target-only records, with no compiler IR + dependencies. Both input and output byte identities join the two plan stages. The final + dependency metadata audit confirms that linker/runtime depend on no + HIR/Core/backend/driver crates. +- LK-13: the library-owned oracle verifies the exact five typed foreign-slot + delegates against clean pinned Prelude source, preserving every other source + declaration. The official JS FFI supplies 333 observations: 8 Int, 174 Number + (Show plus raw token), 41 Char, 105 String and 5 array cases. Actual Wasmtime + execution returns 42 with exact callback stdout `3\n1\n2\n` and empty stderr. + Evidence is in `psrs-stdlib/docs/evidence/show/`; its reproduction contract is + `psrs-stdlib/docs/show.md`. The compiler lock pins that completed library + revision and content fingerprint; this does not promote the entire stdlib. + +### Final validation + +All execution commands below ran with `PSRS_REQUIRE_WASMTIME=1` where applicable. +Driver/CLI final runs use the locked package, without `PSRS_STDLIB_ROOT`. +The library oracle additionally uses its explicit public development-package +runner; a separate lock-checked build runs the same 333 checks. + +| Command | Result | +| --- | --- | +| `cargo test -p psrs-backend` | 400 passed | +| `cargo test -p psrs-linker -p psrs-runtime --features psrs-runtime/formatter` | 43 linker and 1 runtime test passed | +| `cargo test -p psrs-cli --test link --test source_layout` | 3 passed | +| `cargo test -p psrs-driver --lib tests::wasi::` | 146 passed | +| `cargo test -p psrs-driver --lib tests::show::` | 6 passed | +| `cargo test -p psrs-driver --lib loads_the_standard_library_from_disk_in_trusted_order` | 1 passed | +| Library `conformance/show.mjs` and public `run` | 333 official checks accepted, exit 42, exact stdout and empty stderr | +| Lock-checked `cargo run -- build Target.purs Main.purs` and Wasmtime | 333 checks, exit 42, exact stdout and empty stderr | +| `cargo fmt --all --check` | Passed | +| `cargo clippy --workspace --all-targets -- -D warnings` | Passed | +| `sh crates/psrs-runtime/tools/check-reproducible.sh` | Byte-for-byte agreement | + +[Locked Show evidence](linking-evidence/locked-show.json) records package pins, +compiler and Wasm digests, and execution observations. Source/API evidence and +the library-owned oracle are committed with the pinned library revision. The +full workspace suite and new corpus scoreboards were not run under the explicit +validation scope; no source syntax or diagnostic behavior changed. diff --git a/docs/implementation/backend/linking-evidence/locked-show.json b/docs/implementation/backend/linking-evidence/locked-show.json new file mode 100644 index 00000000..30ec8f4c --- /dev/null +++ b/docs/implementation/backend/linking-evidence/locked-show.json @@ -0,0 +1,18 @@ +{ + "schema_version": 1, + "stdlib_lock": { + "schema_version": 1, + "path": "../psrs-stdlib", + "revision": "8aaaffad89acf7aa71da38b1405920d4f37356ef", + "source_fingerprint": "fnv1a64-v1:73d24a5e09ceea6c" + }, + "compiler_sha256": "9881768920f1295da5a679fd2b0254a7b15bfb0ddcaba7dca1c07156aef374ff", + "wasm_sha256": "ef6d1913578e840e1563a49f856692edbe2775d3fece65d7c6d4e0f9668d361b", + "official_oracle_checks": 333, + "execution": { + "exit_code": 42, + "stdout": "3\n1\n2\n", + "stderr": "" + }, + "accepted": true +} diff --git a/docs/workflow/component-linking.md b/docs/workflow/component-linking.md new file mode 100644 index 00000000..091393a8 --- /dev/null +++ b/docs/workflow/component-linking.md @@ -0,0 +1,106 @@ +# Explicit Component Linking + +**Feature:** [F-02](../feature/F-02-portable-programs.md). + +**Design:** [Linking and Runtime](../design/backend/wasm/linking-and-runtime.md). + +Use an already built synchronous application component and explicitly pinned +whole-interface guest providers: + +```sh +psrs link application.wasm --manifest providers.json -o linked.wasm --report link.json +``` + +The command composes components; it does not compile PureScript source, infer +providers from WIT files, download artifacts or discover providers by directory. +Source compilation can explicitly request the same checked composition: + +```sh +psrs build Main.purs --manifest providers.json -o linked.wasm --report build.json +``` + +`build` preserves source/stdlib checking and completes its core runtime plan +before composing the resulting application component. It does not discover +providers. For compiler-produced roots, `application_sha256` is optional: the +compiler pins the exact bytes it just emitted. If supplied, the pin must match. +Standalone `link` always requires the root pin. + +## Manifest version 1 + +```json +{ + "schema_version": 1, + "application_sha256": "<64 lowercase hexadecimal characters>", + "providers": [ + { + "id": "service", + "path": "components/service.wasm", + "sha256": "<64 lowercase hexadecimal characters>" + } + ], + "bindings": [ + { + "interface": "example:service/api@1.0.0", + "provider": "service" + } + ], + "permitted_host_interfaces": ["wasi:cli/stdout@0.2.12"] +} +``` + +Provider paths resolve relative to the manifest. The application path resolves +relative to the command's working directory. Artifact identities must be unique; +`application` is reserved for the root. Every live artifact's SHA-256 must match +its exact executable bytes. Unknown fields and schema versions are errors. + +A binding applies wherever its interface occurs in the live graph, including +transitive guest imports. An optional `export` field defaults to `interface`; +the initial format requires the two canonical names to match exactly. There is +one provider instance per selected artifact identity, shared by its consumers. +Bindings select whole interfaces, preserving the identity of resources and their +constructor, method and destructor operations. The component type checker rejects +incompatible function shapes and resource connections. + +Unbound live imports must be explicitly permitted host interfaces. The command +also checks WASI permissions against the compiler's stable target world and +capability profile. Other host interfaces form an explicit custom host contract; +the runtime must supply them. Unused candidate artifacts do not enter the graph +or report. Declaring an interface as permitted does not rescue a missing or +incompatible explicitly selected guest. + +Only instance imports and synchronous composition under the stable Wasm feature +profile are supported. Definition-only WIT packages, non-interface imports, +implicit version adaptation and cyclic instantiation cannot satisfy this entry +point. Guest executable core/component start functions are rejected: version 1 +has no provider initialization-effect contract. Declarative memory/data/global +initialization stays within the typed component; the compiler-owned application +may contain the already checked encoder's shim initialization. Provider memory stays inside that component; canonical lift/lower, +realloc and post-return carry values across the connection. + +## Report and evidence + +The optional report records schema version, selected component identities and +SHA-256 pins (including the application), live provider binding edges, validator +feature bits, the exact residual host interface imports, and the output digest. +A successful report and binary are written only after planning and validation. +With `build --report`, a rejected guest plan writes a `status: rejected` report +with its source lineage, exact application digest and composition diagnostic; +it produces no linked binary or successful output digest. Standalone `link` +reports remain successful-plan records. A report establishes artifact composition and validation, not successful execution or +source-language conformance. Standalone `link` reports are separate from +`psrs diagnose`. A `build --report` report includes the same diagnosis source/pass/artifact vocabulary, with a +`component_output` join naming the produced trace artifact and its exact SHA-256. +`application_sha256` matches that join and the composition plan's root pin; the +composition output digest matches the final file. It also records the exact +manifest digest. These links establish source-to-component lineage without +claiming runtime observations as compile verification. + +Run the resulting command component with a compatible runtime: + +```sh +wasmtime run linked.wasm +``` + +The linker tests execute cross-component strings, lists/results, post-return +buffer invalidation and resource lifetime behavior. CLI tests cover manifest +relative paths, digest rejection, closed imports and report/output agreement. diff --git a/stdlib.lock.json b/stdlib.lock.json index 67344762..c5f61159 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "01d6cd406cdce68a7ea1ec4c26a44793ead34571", - "source_fingerprint": "fnv1a64-v1:b2890fecd9c42aa3" + "revision": "8aaaffad89acf7aa71da38b1405920d4f37356ef", + "source_fingerprint": "fnv1a64-v1:73d24a5e09ceea6c" } From 7448cd7930a95ca7e0196b03c5f32cedcfd899fe Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 09:26:08 +0800 Subject: [PATCH 058/148] Resolve shared qualified imports by canonical declaration identity --- README.md | 2 +- .../src/tests/declarations/import_aliases.rs | 80 +++++++++++++++++++ .../{declarations.rs => declarations/mod.rs} | 2 + .../tests/upstream/import_aliases.rs | 71 ++++++++++++++++ crates/psrs-driver/tests/upstream/mod.rs | 1 + .../src/resolver/exports/import_scope.rs | 26 ++++++ .../psrs-resolve/src/resolver/exports/mod.rs | 4 + crates/psrs-resolve/src/resolver/names/mod.rs | 36 ++------- .../src/resolver/type_resolution.rs | 15 ++-- docs/design/D-04-suite-roadmap.md | 16 ++-- .../semantics/modules-and-resolution.md | 11 ++- 11 files changed, 217 insertions(+), 47 deletions(-) create mode 100644 crates/psrs-driver/src/tests/declarations/import_aliases.rs rename crates/psrs-driver/src/tests/{declarations.rs => declarations/mod.rs} (99%) create mode 100644 crates/psrs-driver/tests/upstream/import_aliases.rs create mode 100644 crates/psrs-resolve/src/resolver/exports/import_scope.rs diff --git a/README.md b/README.md index 34dac748..d052528b 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ what remains in each layer. | Gate | Measured | Scope | | --- | --- | --- | | L0/L1 lexing, layout, parsing | 904/908 | non-FFI `layout`, `passing`, `failing`, `warning` files; the four differences are recorded DEC-16 intentional differences | -| L2 resolution | 72/72 failing, 402/413 passing | official `errorCode`s; 6 passing files stop at P3, 4 at P0, and 1 in the harness | +| L2 resolution | 72/72 failing, 403/413 passing | official `errorCode`s; 6 passing files stop at P3 and 4 at P0; no harness blockers | | L3 kinds | 39/48 failing | official kind `errorCode`s | | L4 types | 39/50 failing | official `errorCode`s | | L5 classes | 58/81 failing | official `errorCode`s | diff --git a/crates/psrs-driver/src/tests/declarations/import_aliases.rs b/crates/psrs-driver/src/tests/declarations/import_aliases.rs new file mode 100644 index 00000000..8bc1a836 --- /dev/null +++ b/crates/psrs-driver/src/tests/declarations/import_aliases.rs @@ -0,0 +1,80 @@ +use super::*; + +#[test] +fn a_shared_qualifier_combines_disjoint_values_and_types() { + let a = "module A where\ndata Left = Left\na :: Left\na = Left\n"; + let b = "module B where\ndata Right = Right\nb :: Right\nb = Right\n"; + let facade = "module Facade (module X, left, right) where\nimport A as X\nimport B as X\nleft :: X.Left\nleft = X.a\nright :: X.Right\nright = X.Right\n"; + let main = "module Main where\nimport Facade (Left(..), Right(..), a, b)\nleft :: Left\nleft = a\nright :: Right\nright = b\n"; + resolve_program_sources(&[ + ("A.purs", a), + ("B.purs", b), + ("Facade.purs", facade), + ("Main.purs", main), + ]) + .unwrap(); +} + +#[test] +fn shared_qualifiers_preserve_identity_through_facades() { + let a = "module A where\ndata Thing = Thing\nthing :: Thing\nthing = Thing\n"; + let b = "module B (module A) where\nimport A\n"; + let main = "module Main (module X, value) where\nimport A as X\nimport B as X\nvalue :: X.Thing\nvalue = X.thing\n"; + let modules = + resolve_program_sources(&[("A.purs", a), ("B.purs", b), ("Main.purs", main)]).unwrap(); + let exports = modules[2].exports.as_ref().unwrap(); + assert_eq!(exports.types.len(), 1); + assert_eq!( + exports.types[0].reference, + psrs_hir::TypeReference::Named(modules[0].types[0].id) + ); + assert_eq!( + exports + .values + .iter() + .filter(|value| value.name == "thing") + .count(), + 1 + ); +} + +#[test] +fn an_unused_shared_qualifier_does_not_create_a_conflict() { + let a = "module A where\nthing = 1\n"; + let b = "module B where\nthing = 2\n"; + let main = "module Main where\nimport A as X\nimport B as X\nmain = 42\n"; + resolve_program_sources(&[("A.purs", a), ("B.purs", b), ("Main.purs", main)]).unwrap(); +} + +#[test] +fn shared_qualifier_conflicts_are_reported_at_use_or_reexport() { + for main in [ + "module Main where\nimport A as X\nimport B as X\nmain = X.thing\n", + "module Main (module X) where\nimport A as X\nimport B as X\n", + "module Main where\nimport A as X\nimport B as X\nvalue :: X.Thing\nvalue = X.First\n", + ] { + let a = "module A where\ndata Thing = First\nthing = 1\n"; + let b = "module B where\ndata Thing = Second\nthing = 2\n"; + let errors = resolve_program_sources(&[("A.purs", a), ("B.purs", b), ("Main.purs", main)]) + .unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("ScopeConflict")), + "{errors:?}" + ); + assert!( + !errors + .iter() + .any(|error| error.diagnostic.code == Some("ExportConflict")), + "{errors:?}" + ); + } +} + +#[test] +fn the_official_list_exports_resolve_with_the_locked_stdlib() { + let main = + "module Main where\nimport Data.List as L\nmain = L.length (L.fromFoldable [1,2,3])\n"; + check_program_lenient_with_prelude(&[("Main.purs", main)]).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/declarations.rs b/crates/psrs-driver/src/tests/declarations/mod.rs similarity index 99% rename from crates/psrs-driver/src/tests/declarations.rs rename to crates/psrs-driver/src/tests/declarations/mod.rs index 7a4e0d8c..5b3693de 100644 --- a/crates/psrs-driver/src/tests/declarations.rs +++ b/crates/psrs-driver/src/tests/declarations/mod.rs @@ -1,5 +1,7 @@ use super::*; +mod import_aliases; + #[test] fn resolves_data_constructors_and_user_types() { let source = "module Main where\ndata Maybe a = Nothing | Just a\nmain = Just 1\n"; diff --git a/crates/psrs-driver/tests/upstream/import_aliases.rs b/crates/psrs-driver/tests/upstream/import_aliases.rs new file mode 100644 index 00000000..95208908 --- /dev/null +++ b/crates/psrs-driver/tests/upstream/import_aliases.rs @@ -0,0 +1,71 @@ +use super::*; + +#[test] +fn shared_import_aliases_match_official_purs() { + if !purs_available() { + eprintln!("skipping: purs is not installed"); + return; + } + let a = "module A where\ndata Item = Item\nthing :: Item\nthing = Item\n"; + let disjoint = "module B where\ndata Other = Other\nother :: Other\nother = Other\n"; + let canonical = "module B (module A) where\nimport A\n"; + let conflicting = "module B where\ndata Item = Other\nthing :: Item\nthing = Other\n"; + for (name, b, main, expected) in [ + ( + "disjoint-reexport", + disjoint, + "module Main (module X, value) where\nimport A as X\nimport B as X\nvalue :: X.Other\nvalue = X.other\n", + true, + ), + ( + "canonical-reexport", + canonical, + "module Main (module X, value) where\nimport A as X\nimport B as X\nvalue :: X.Item\nvalue = X.thing\n", + true, + ), + ( + "unused-conflict", + conflicting, + "module Main where\nimport A as X\nimport B as X\nmain :: Int\nmain = 42\n", + true, + ), + ( + "value-conflict", + conflicting, + "module Main where\nimport A as X\nimport B as X\nmain = X.thing\n", + false, + ), + ( + "type-conflict", + conflicting, + "module Main where\nimport A as X\nimport B as X\nmain :: X.Item\nmain = X.Item\n", + false, + ), + ( + "reexport-conflict", + conflicting, + "module Main (module X) where\nimport A as X\nimport B as X\n", + false, + ), + ] { + let sources = [("A.purs", a), ("B.purs", b), ("Main.purs", main)]; + let purs = purs_sources_output(&format!("import-alias-{name}"), &sources); + assert_eq!(purs.status.success(), expected, "{name}: {purs:?}"); + let ours = psrs_driver::resolve_program_sources(&sources); + assert_eq!(ours.is_ok(), expected, "{name}: {ours:?}"); + if !expected { + assert!( + purs_error_codes(&purs) + .iter() + .any(|code| code == "ScopeConflict"), + "{name}: {purs:?}" + ); + assert!( + ours.unwrap_err() + .iter() + .any(|error| error.diagnostic.code == Some("ScopeConflict")), + "{name}" + ); + } + } +} diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 733c06b9..16bb0d14 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -3,6 +3,7 @@ use std::process::Command; mod coercion; mod deriving; +mod import_aliases; mod library_foreign; mod rank_n; mod reports; diff --git a/crates/psrs-resolve/src/resolver/exports/import_scope.rs b/crates/psrs-resolve/src/resolver/exports/import_scope.rs new file mode 100644 index 00000000..a095ec66 --- /dev/null +++ b/crates/psrs-resolve/src/resolver/exports/import_scope.rs @@ -0,0 +1,26 @@ +use super::{Resolver, ast, hir}; + +impl Resolver { + /// A pseudo-module combines import scopes, so ambiguity is checked by + /// member identity in its namespace, as it is for a qualified reference. + pub(super) fn check_reexport_scope( + &mut self, + name: &ast::Name, + imports: &[hir::Import], + ) -> bool { + let mut valid = true; + for import in imports { + for symbol in &import.symbols { + let qualified = format!("{}.{}", name.text, symbol.external_name); + valid &= self.lookup_global(&qualified, name.span).is_some(); + } + for imported in &import.types { + let qualified = format!("{}.{}", name.text, imported.name); + valid &= self + .lookup_qualified_type(&qualified, &name.text, &imported.name, name.span) + .is_some(); + } + } + valid + } +} diff --git a/crates/psrs-resolve/src/resolver/exports/mod.rs b/crates/psrs-resolve/src/resolver/exports/mod.rs index 965c5445..74517ecb 100644 --- a/crates/psrs-resolve/src/resolver/exports/mod.rs +++ b/crates/psrs-resolve/src/resolver/exports/mod.rs @@ -9,6 +9,7 @@ use psrs_hir::{ use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; +mod import_scope; mod instance_visibility; mod transitive; use instance_visibility::instance_is_public; @@ -295,6 +296,9 @@ impl Resolver { } // A shared import alias (for example the standard library's // `as Exports`) denotes the union of those modules' exports. + if matches.len() > 1 && !self.check_reexport_scope(name, &matches) { + return; + } for import in &matches { let pseudo = import.alias.is_some(); for symbol in &import.symbols { diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index c4edcdb0..b6b5d53b 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -2,7 +2,7 @@ use super::{ResolveError, ResolveErrorKind}; use psrs_ast::{self as ast, ExprKind as AstExprKind}; use psrs_hir::{ self as hir, CaseBranchCoverage, Expr, ExprKind, ExternalSymbol, LocalBinder, LocalBinding, - LocalId, ModuleId, SymbolId, TypeId, TypeReference, + LocalId, SymbolId, TypeId, TypeReference, }; use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; @@ -10,12 +10,10 @@ use std::collections::{HashMap, HashSet}; mod patterns; struct QualifiedImport { - module: ModuleId, values: HashMap, } pub(super) struct QualifiedTypeImport { - pub(super) module: ModuleId, pub(super) types: HashMap, } @@ -51,25 +49,13 @@ impl Resolver { imports: Vec, export_items: Option, fixities: Vec, - mut errors: Vec, + errors: Vec, ) -> Self { let mut unqualified: HashMap> = HashMap::new(); let mut qualified: HashMap> = HashMap::new(); let mut imported_types: HashMap> = HashMap::new(); let mut qualified_types: HashMap> = HashMap::new(); - let mut aliases: HashMap = HashMap::new(); for import in &imports { - // Two imports cannot share one explicit qualifier; `purs` reports - // this as a scope conflict before any qualified lookup or re-export. - if let Some(alias) = &import.alias - && aliases.insert(alias.clone(), ()).is_some() - { - errors.push(ResolveError::named( - ResolveErrorKind::ScopeConflict, - alias.clone(), - import.span, - )); - } // An import with an `as` alias is qualified-only; without one it // also brings the names into unqualified scope. if import.alias.is_none() { @@ -98,10 +84,7 @@ impl Resolver { qualified .entry(qualifier.clone()) .or_default() - .push(QualifiedImport { - module: import.module, - values, - }); + .push(QualifiedImport { values }); let types = import .types .iter() @@ -110,10 +93,7 @@ impl Resolver { qualified_types .entry(qualifier) .or_default() - .push(QualifiedTypeImport { - module: import.module, - types, - }); + .push(QualifiedTypeImport { types }); } if !imports.iter().any(|import| import.module_name == "Prim") { for &(name, builtin) in &util::PRIM_TYPES { @@ -424,15 +404,15 @@ impl Resolver { self.report(ResolveErrorKind::UnknownName, text.to_string(), span); return None; }; - let mut found: Option<(ModuleId, SymbolId)> = None; + let mut found: Option = None; let mut conflict = false; for candidate in candidates { let Some(symbol) = candidate.values.get(member) else { continue; }; match found { - None => found = Some((candidate.module, *symbol)), - Some((module, existing)) if module != candidate.module || existing != *symbol => { + None => found = Some(*symbol), + Some(existing) if existing != *symbol => { conflict = true; } _ => {} @@ -442,7 +422,7 @@ impl Resolver { self.report_conflict(text.to_string(), span); return None; } - if let Some((_, symbol)) = found { + if let Some(symbol) = found { return Some(symbol); } self.report(ResolveErrorKind::UnknownName, text.to_string(), span); diff --git a/crates/psrs-resolve/src/resolver/type_resolution.rs b/crates/psrs-resolve/src/resolver/type_resolution.rs index e65854d2..bd11a032 100644 --- a/crates/psrs-resolve/src/resolver/type_resolution.rs +++ b/crates/psrs-resolve/src/resolver/type_resolution.rs @@ -4,7 +4,7 @@ use super::names::{ use super::{PlannedType, ResolveErrorKind}; use psrs_ast as ast; use psrs_hir::{ - self as hir, ModuleId, Type as HirType, TypeDeclarationKind, TypeId, TypeKind as HirTypeKind, + self as hir, Type as HirType, TypeDeclarationKind, TypeId, TypeKind as HirTypeKind, TypeReference, }; use psrs_span::TextRange; @@ -195,8 +195,7 @@ impl Resolver { .iter() .any(|import| import.module_name == "Prim" && import.alias.as_deref() == Some("Prim")); let default_prim = if qualifier == "Prim" && !has_explicit_prim_qualifier { - prim_type(member) - .map(|builtin| (ModuleId::COMPILER_PRELUDE, TypeReference::Builtin(builtin))) + prim_type(member).map(TypeReference::Builtin) } else { None }; @@ -205,17 +204,15 @@ impl Resolver { self.report(ResolveErrorKind::UnknownTypeName, text.to_owned(), span); return None; } - let mut found: Option<(ModuleId, TypeReference)> = default_prim; + let mut found: Option = default_prim; let mut conflict = false; for candidate in candidates.into_iter().flatten() { let Some(reference) = candidate.types.get(member) else { continue; }; match found { - None => found = Some((candidate.module, *reference)), - Some((module, existing)) - if module != candidate.module || existing != *reference => - { + None => found = Some(*reference), + Some(existing) if existing != *reference => { conflict = true; } _ => {} @@ -225,7 +222,7 @@ impl Resolver { self.report_conflict(text.to_owned(), span); return None; } - if let Some((_, reference)) = found { + if let Some(reference) = found { return Some(reference); } self.report(ResolveErrorKind::UnknownTypeName, text.to_owned(), span); diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index e9d63d1b..3ba14fb9 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -391,10 +391,12 @@ shape would change the API the corpus calls, so the two functions stay out and t defect is filed as #137. That leaves 2 `passing` cases blocked on them. **Latest full-board remeasurement (2026-10-07, annotations oracle):** M2 -failing agreement is **72/72**; a duplicated explicit import qualifier now -reports `ScopeConflict`, so `failing/ConflictingQualifiedImports2.purs` agrees. -Passing modules resolve in **402/413** cases; the other 11 stop at P3 (6), P0 -(4), or in the harness (1). Nineteen sibling modules load successfully, and no +failing agreement is **72/72**. Shared explicit import qualifiers combine names +by declaration identity; an ambiguous member of a pseudo-module re-export +reports `ScopeConflict`, so `failing/ConflictingQualifiedImports2.purs` agrees +without rejecting the official `Data.List` shared `as Exports` imports. +Passing modules resolve in **403/413** cases; the other 10 stop at P3 (6) or P0 +(4), with no harness blockers. Nineteen sibling modules load successfully, and no case is blocked because the loader cannot use an imported sibling. ### M3 — Kinds and higher-kinded types @@ -1085,7 +1087,7 @@ for matrix status. | --- | --- | --- | --- | | L0 | Layout goldens | 15/15 official parse outcomes agree (12 accepted, 3 rejected), enforced by regression tests. | 15/15 agreement, with all layout cases covered by regression tests. | | L1 | Non-excluded parse behavior | 904/908 agreement using the annotations oracle; `passing` 410/413, `failing` 412/413, `warning` 67/67, `layout` 15/15, with the four remaining cases recorded as DEC-16 intentional differences | 100% agreement apart from the DEC-16 intentional differences. | -| L2 | Module, import, export, and name resolution | 71/72 failing cases. `passing` resolution is **386/413**; the remaining 27 stop at P3 (23) or P0 (4), with no missing-library or unusable-sibling blockers. The sole failing mismatch expects `ScopeConflict` and produces `ExportConflict`. Remeasured with all boards on 2026-10-04 after vendoring v0.15.16. | The mapped resolution cases and all required passing-module cases agree. | +| L2 | Module, import, export, and name resolution | **72/72** failing cases. `passing` resolution is **403/413**; the remaining 10 stop at P3 (6) or P0 (4), with no harness, missing-library, or unusable-sibling blockers. Remeasured with the annotations oracle on 2026-10-07 after the shared-import-qualifier repair. | The mapped resolution cases and all required passing-module cases agree. | | L3 | Kinds and higher-kinded types | 39/48 failing cases: `KindsDoNotUnify` 16/24, `PartiallyAppliedSynonym` 12/12, `CycleInTypeSynonym` 4/4, `CycleInKindDeclaration` 2/2, `InfiniteKind` 2/2, and `UndefinedTypeVariable` 3/4. | 100% agreement for the mapped kind cases. | | L4 | Core type checking | 39/50 failing cases. The remaining mismatches include kind diagnostics reported in place of `ExpectedType`, missing `EscapedSkolem`, `VisibleTypeApplications1`, and five `Coercible` cases reported as `NoInstanceFound`. | 100% agreement for the mapped type cases. | | L5 | Classes and instances | 75/97 failing cases: `OverlappingInstances` 8/8, `NoInstanceFound` 46/53, `MissingClassMember` 2/2, `InvalidNewtypeInstance` 6/6, `DuplicateInstance` 1/1, `InvalidInstanceHead` 1/7, `ClassInstanceArityMismatch` 4/4, `CannotDeriveInvalidConstructorArg` 7/7; `PossiblyInfiniteInstance` 0/1, `OrphanInstance` 0/7, `DuplicateTypeClass` 0/1. Remeasured on 2026-10-06. | 100% agreement for the mapped class cases. | @@ -1131,7 +1133,7 @@ resolved, type checked, and represented in Typed Core as required. | ID | Feature | Current support | Status | Next landing | | --- | --- | --- | --- | --- | | FE-01 | Lexing, Unicode tokens, comments, literals, and layout | Lexer and layout agree with the L1 annotations scoreboard at 904/908, including 15/15 layout cases. The four differences are the DEC-16 intentional differences: a supplementary scalar is accepted as one `Char` (`failing/2434.purs`), and an unpaired surrogate escape is rejected in `StringEscapes.purs` and the two `StringEdgeCases` files. A paired surrogate escape decodes as one scalar, and no surrogate becomes U+FFFD. Parse agreement does not verify string values. | Partial | Cover the remaining literal forms the corpus exercises. | -| FE-02 | Module headers, imports, exports, qualified names, aliases, and hiding | Module graph, stable module IDs, value/type/constructor/class imports and exports, fixity aliases, virtual `Prim.*` type/class interfaces, instance dictionary identities, per-branch instance exports, and unary minus through ordinary `negate` resolution work in a subset; the latest full-board run agrees on 71/72 mapped failing cases. `passing` resolution is **386/413**; 23 cases stop at P3 and 4 at P0. A re-exported operator alias carries its target's identity and does not require the target's name unless the target is declared in the re-exporting module. Class-only imports do not import methods into the value namespace; selective imports still receive visible instances through the module dependency graph. P3 checks explicit signatures and declaration dependencies; P5 checks inferred public schemes by stable type identity. `Prim.undefined` has a compiler-owned identity, type, and interface export, but Core lowering still rejects it because no runtime representation is defined. The [primitives topic](frontend/type-system/prim.md) owns the `Prim.*` inventory, the evidence-class dispatch order, relation outcomes, and diagnostic behavior; #120 adds the missing relation and report paths. Broader pattern-binding support remains incomplete. | Partial | Complete pattern-binding support; add the `Prim.undefined` runtime representation and continue official-suite coverage for primitive solving. | +| FE-02 | Module headers, imports, exports, qualified names, aliases, and hiding | Module graph, stable module IDs, value/type/constructor/class imports and exports, fixity aliases, virtual `Prim.*` type/class interfaces, instance dictionary identities, per-branch instance exports, and unary minus through ordinary `negate` resolution work in a subset; the 2026-10-07 annotations run agrees on **72/72** mapped failing cases. `passing` resolution is **403/413**; 6 cases stop at P3 and 4 at P0, with no harness blockers. Shared qualifiers combine disjoint members and preserve canonical declaration identity; ambiguous qualified lookup or pseudo-module re-export reports `ScopeConflict`. A re-exported operator alias carries its target's identity and does not require the target's name unless the target is declared in the re-exporting module. Class-only imports do not import methods into the value namespace; selective imports still receive visible instances through the module dependency graph. P3 checks explicit signatures and declaration dependencies; P5 checks inferred public schemes by stable type identity. `Prim.undefined` has a compiler-owned identity, type, and interface export, but Core lowering still rejects it because no runtime representation is defined. The [primitives topic](frontend/type-system/prim.md) owns the `Prim.*` inventory, the evidence-class dispatch order, relation outcomes, and diagnostic behavior; #120 adds the missing relation and report paths. Broader pattern-binding support remains incomplete. | Partial | Complete pattern-binding support; add the `Prim.undefined` runtime representation and continue official-suite coverage for primitive solving. | | FE-03 | Value declarations, signatures, recursive groups, pattern bindings, and `where` | Named declarations, signatures, recursive local groups, and top-level SCC inference work; selected local pattern declarations, including `LetPattern`, lower through the pattern pipeline. The full declaration and `where` forms are not end-to-end. | Partial | Complete remaining pattern declarations and local `where` blocks. | | FE-04 | Declaration forms: `data`, `newtype`, `type`, `class`, `instance`, `derive`, `foreign`, roles, fixities, and kind signatures | Data/newtype roles are inferred and checked, foreign role signatures enter the checked kind environment, and source role errors retain spans. Instance declarations resolve into dictionary-scoped members; signatures associate with consecutive equations, reject orphan/repeated declaration groups, and check against the class method specialized by the instance head. Deriving and several declaration forms remain incomplete. | Partial | Complete the remaining declaration-form semantics; deriving is tracked under FE-22. | | FE-05 | Expressions: application, operators, lambdas, `if`, `let`, `case`, records, arrays, literals, sections, `do`, and `ado` | Application, value and type operators with resolved fixities, the `Data.Function` application operators `$` and `#` with their official associativity and precedence, unary minus through the ordinary in-scope `negate` value, lambdas, `if`, `let`, `case`, scalar arrays, empty array literals whose element type is determined, records, and selected literals work; `do`/`ado` lower to bind, discard, and `let`. The ascription `e :: T` is checked against its written type and remains explicit through Typed Core. Sections lower through P4 and have runtime coverage. Remaining literal and expression forms are open. | Partial | Complete the remaining literal and expression forms. | @@ -1149,7 +1151,7 @@ resolved, type checked, and represented in Typed Core as required. | FE-17 | Visible type application, typed binders, type wildcards, holes, and advanced annotations | Typed binders preserve and check scoped annotations, and each source type wildcard receives fresh kind/type variables through the shared type spine. Type-level `String` and `Int` literals are ordinary spine nodes: a signature may contain them, they unify by value, and they survive into THIR where the verifier compares them. A wildcard in a value signature is solved by unification and is accepted in every shape `purs` accepts; a wildcard in an instance head is rejected as `InvalidInstanceHead`, while one in an instance context stays legal. The `1664.purs` wildcard binder lowers through P2. Visible term type application, wildcard warning/error behavior, higher-kinded application, and non-generalized hole diagnostics remain incomplete. The `Type`, `Constraint`, and `Symbol` heads are accepted as ordinary type constructors with their declared primitive kinds. Official's CST has no kind-application node; its kind checker synthesizes `KindApp` while instantiating a polymorphic kind, and this compiler performs that instantiation in the kind solver, so its source type spine needs no `KindApplication` node. The source forms that do name a kind or type explicitly are separate nodes. #87 lands both of the forms that blocked P2: a negative type-level integer prefix is the negative literal on the shared spine, and a visible type application `e @T` is elaborated by the checker, which substitutes the written argument for the operand's outermost quantifier after checking it against that quantifier's kind, and is erased at runtime. No P2 surface-lowering case remains. Three limits are recorded rather than approximated. A chained application `f @A @B` is reported, because the quantifiers an application leaves behind are scheme variables here and choosing between them needs the scheme to record which variables a visible application has consumed. A visible application on a class-method head is unresolved, which is `failing/ClassHeadNoVTA3.purs`. And this compiler's CST does not carry the binder visibility that official's `CST/Convert.hs` derives from `forall @a.`, so a plain `forall a.` binder is selectable where `purs` rejects it — the permissive direction, and the remaining half of `failing/VisibleTypeApplications1.purs`. `CannotApplyExpressionOfTypeOnType` and `CannotSkipTypeApplication` are the mapped codes. The primitive row relations themselves all have rules, and the row-side gap that remains is the rigid-tail unification defect under FE-13. | Partial | Model `forall` binder visibility so a visible application matches official, then resolve chained applications and class-method heads. | | FE-18 | Higher-rank types, subsumption, impredicativity, and higher-rank `forall` | Bidirectional checking preserves nested quantifiers, checks directional function/record subsumption, and rejects escaping skolems and specialized universal arguments. Source and GC execution cases cover rank-2 through rank-4, fields, returned and captured values, recursive annotations, higher-kinded parameters, and nested constraints. See the [rank-N acceptance record](../implementation/frontend/rank-n.md) for verification evidence and the official differential battery. | Partial | Reconcile the complete official higher-rank/skolem corpus, including its library dependencies and separate higher-rank kind requirements; track visible type application and diagnostic agreement. | | FE-19 | Foreign declarations and target-aware external names | Source-declared WIT bindings are resolved for the supported backend path. `foreign import data` is a nominal opaque type with no constructors; a nullary one maps to a WIT resource. THIR and Core keep it as `Constructor(User(id))` plus `opaque_ids`, distinct from `Int` (`lowers_an_opaque_foreign_type_to_core_without_collapsing_it_to_int`). JavaScript FFI is not a frontend target. CC/MIR handle layout is not done. | Partial | Finish target-aware foreign value rules beyond the supported WIT subset. Resource lifetime and handle layout stay in the backend. | -| FE-20 | Warnings, holes, source spans, and official diagnostic codes | Source spans exist and resolution, kind, type, and class `errorCode`s are measured: L1 904/908, L2 71/72, L3 39/48, L4 39/50, L5 75/97. L4 per-code agreement is `TypesDoNotUnify` 34/41, `IntOutOfRange` 1/1, `InfiniteType` 2/2, `ExpectedType` 0/2, `EscapedSkolem` 1/2, `CannotApplyExpressionOfTypeOnType` 1/2, and `AmbiguousTypeVariables` 1/1. `MultipleErrors.purs` repeats its annotation, so code-occurrence counts sum to 40/51 while case agreement remains 39/50. Pattern-binder diagnostics match the annotated duplicate-name cases; warning coverage and complete diagnostic agreement remain open. Non-generalized hole diagnostics remain tracked under FE-17. | Partial | Add the missing class checks (#97) and track warning-code agreement separately from acceptance errors. | +| FE-20 | Warnings, holes, source spans, and official diagnostic codes | Source spans exist and resolution, kind, type, and class `errorCode`s are measured: L1 904/908, L2 72/72 (remeasured 2026-10-07), L3 39/48, L4 39/50, L5 75/97. L4 per-code agreement is `TypesDoNotUnify` 34/41, `IntOutOfRange` 1/1, `InfiniteType` 2/2, `ExpectedType` 0/2, `EscapedSkolem` 1/2, `CannotApplyExpressionOfTypeOnType` 1/2, and `AmbiguousTypeVariables` 1/1. `MultipleErrors.purs` repeats its annotation, so code-occurrence counts sum to 40/51 while case agreement remains 39/50. Pattern-binder diagnostics match the annotated duplicate-name cases; warning coverage and complete diagnostic agreement remain open. Non-generalized hole diagnostics remain tracked under FE-17. | Partial | Add the missing class checks (#97) and track warning-code agreement separately from acceptance errors. | | FE-21 | Typed Core normalization and CoreFn/optimization compatibility | Typed Core lowering and verification work for the supported subset; official optimize output is not yet a target. | Partial | Add Core optimization passes and an explicit optimize compatibility track. | | FE-22 | Deriving and newtype-based derivation | Every structural family generates ordinary checked instance members through one identity registry and syntax builder. All mapping families, folds, and traversals consume shared usage/variance analysis, including record fields, given higher-kinded dictionaries, and scoped forall parameters. Source tests cover every deriving diagnostic; differential batteries cover 18 original rules, 17 remaining-family/context/scoped cases, and six diagnostic cases. 25 Wasmtime cases cover all structural classes, Generic tag/field round trips, function Contravariant, polymorphic newtype adapters, applied-variable Eq1/Ord1 dispatch, both fold directions, sequencing, and multi-field traversal. L5 is 75/97, with deriving-specific `InvalidNewtypeInstance` 6/6 and `CannotDeriveInvalidConstructorArg` 7/7. | Partial | Shared declaration checks still mismatch the official orphan and invalid record/synonym instance-head cases, including `3405`, `3510`, and `InvalidDerivedInstance2`. See the [deriving design](frontend/type-system/deriving.md) and [acceptance record](../implementation/frontend/deriving.md). | diff --git a/docs/design/frontend/semantics/modules-and-resolution.md b/docs/design/frontend/semantics/modules-and-resolution.md index 2d0ddc63..ae54b30c 100644 --- a/docs/design/frontend/semantics/modules-and-resolution.md +++ b/docs/design/frontend/semantics/modules-and-resolution.md @@ -57,8 +57,15 @@ The driver loads the transitive source graph, checks duplicate module names and cycles according to the source language's module rules, then resolves modules in dependency order. P3 first registers declarations and their namespaces, then resolves bodies so same-module references and recursive groups can name -their final IDs. Qualified lookup uses only the named imported module; -unqualified lookup combines local declarations and permitted imports and +their final IDs. Qualified lookup combines the selected names from all imports +under that qualifier. Several imports may share an explicit alias. A member is +ambiguous only when its namespace contains distinct declaration identities; +multiple paths to the same declaration remain one member. Merely declaring a +shared qualifier is not an error. A `module X` re-export checks each member of +the combined scope by the same qualified lookup relation and reports +`ScopeConflict` for an ambiguous member, while disjoint members form a union. + +Unqualified lookup combines local declarations and permitted imports and rejects ambiguity. Instance dictionary names follow the module's declared-identifier conflict From 5394cfcba637809c9fdbf264e55f03f72c92652b Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 09:26:08 +0800 Subject: [PATCH 059/148] Avoid unused guard continuations and pin checked Bounded values --- crates/psrs-desugar/src/expr.rs | 26 +++++--- .../src/tests/guard_coverage/constrained.rs | 61 +++++++++++++++++++ .../mod.rs} | 2 + .../tests/upstream/guard_continuations.rs | 52 ++++++++++++++++ crates/psrs-driver/tests/upstream/mod.rs | 1 + docs/design/frontend/semantics/desugaring.md | 6 +- docs/workflow/stdlib-conformance.md | 18 ++++++ stdlib.lock.json | 4 +- 8 files changed, 157 insertions(+), 13 deletions(-) create mode 100644 crates/psrs-driver/src/tests/guard_coverage/constrained.rs rename crates/psrs-driver/src/tests/{guard_coverage.rs => guard_coverage/mod.rs} (99%) create mode 100644 crates/psrs-driver/tests/upstream/guard_continuations.rs diff --git a/crates/psrs-desugar/src/expr.rs b/crates/psrs-desugar/src/expr.rs index 8e9d4c5d..2a8eb98f 100644 --- a/crates/psrs-desugar/src/expr.rs +++ b/crates/psrs-desugar/src/expr.rs @@ -141,8 +141,10 @@ impl Desugarer { fn case(&mut self, scrutinee: Expr, mut branches: Vec, span: TextRange) -> Expr { let mut scrutinee = self.expr(scrutinee); - let has_guards = branches.iter().any(|branch| is_guarded_rhs(&branch.value)); - if !has_guards { + let first_guard = branches + .iter() + .position(|branch| is_guarded_rhs(&branch.value)); + let Some(first_guard) = first_guard else { return Expr { kind: ExprKind::Case { scrutinee: Box::new(scrutinee), @@ -156,7 +158,7 @@ impl Desugarer { }, span, }; - } + }; if !branches .iter() @@ -175,7 +177,11 @@ impl Desugarer { // product is captured too: passing it would instantiate polymorphic // fields across fallthrough rows. An empty token keeps helpers lazy. let temp = self.local_binder("case_scrutinee", span); - let helper_binders = (1..=branches.len() + 1) + // Only rows after the first guarded row can be entered through a + // fallthrough helper. Earlier rows are checked directly at the case's + // expected result type, and must not acquire unused inferred copies. + let first_helper_row = first_guard + 1; + let helper_binders = (first_helper_row..=branches.len()) .map(|index| self.local_binder(&format!("guard_fallthrough_{index}"), span)) .collect::>(); let mut bindings = Vec::with_capacity(helper_binders.len()); @@ -185,8 +191,8 @@ impl Desugarer { span, }; - for row_index in 0..=branches.len() { - let next_functions = helper_binders[row_index + 1..] + for (helper_index, row_index) in (first_helper_row..=branches.len()).enumerate() { + let next_functions = helper_binders[helper_index + 1..] .iter() .map(|_| self.local_binder("next_guard", span)) .collect::>(); @@ -239,7 +245,7 @@ impl Desugarer { .collect::>(); let value = wrap_lambdas(parameters, body, span); bindings.push(LocalBinding { - binder: helper_binders[row_index].clone(), + binder: helper_binders[helper_index].clone(), value, span, }); @@ -255,10 +261,10 @@ impl Desugarer { branch.coverage = CaseBranchCoverage::Source; } if is_guarded_rhs(&branch.value) { - let start = index + 2; + let next_helper = index - first_guard; let failure = apply( - self.local_expr(&helper_binders[start - 1], branch.span), - helper_binders[start..] + self.local_expr(&helper_binders[next_helper], branch.span), + helper_binders[next_helper + 1..] .iter() .map(|binder| self.local_expr(binder, branch.span)) .chain(std::iter::once(Expr { diff --git a/crates/psrs-driver/src/tests/guard_coverage/constrained.rs b/crates/psrs-driver/src/tests/guard_coverage/constrained.rs new file mode 100644 index 00000000..6c531a25 --- /dev/null +++ b/crates/psrs-driver/src/tests/guard_coverage/constrained.rs @@ -0,0 +1,61 @@ +use super::*; + +#[test] +fn guarded_polymorphic_results_use_the_enclosing_dictionary() { + let prefix = "module Main where\nclass Build f where\n build :: forall a. a -> f a\ndata Box a = Box a\ninstance buildBox :: Build Box where\n build = Box\nchoose :: forall f a. Build f => Boolean -> a -> f a\n"; + for (body, flag) in [ + ( + "choose = case _, _ of\n flag, value\n | flag -> build value\n | true -> build value\n", + "true", + ), + ( + "choose = case _, _ of\n flag, value\n | flag -> build value\n | true -> build value\n", + "false", + ), + ( + "choose flag value = case flag of\n false -> build value\n true | flag -> build value\n true -> build value\n", + "true", + ), + ( + "choose flag value = case flag of\n true | false -> build value\n _ -> build value\n", + "true", + ), + ] { + let source = format!( + "{prefix}{body}main :: Int\nmain = case (choose {flag} 42 :: Box Int) of\n Box value -> value\n" + ); + let Some(output) = run_with_wasmtime(&source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{body}: {output:?}"); + } +} + +#[test] +fn official_guarded_library_declarations_typecheck() { + let source = "module Main where\nimport Data.Enum\nimport Data.Enum.Generic\nimport Data.List.Lazy\nmain :: Int\nmain = 42\n"; + check_program_types_lenient_with_prelude(&[("Main.purs", source)]).unwrap(); +} + +#[test] +fn official_enum_ranges_execute_ascending_descending_and_equal_guards() { + let source = "module Main where\nimport Prelude\nimport Data.Enum (enumFromTo)\nmain :: Int\nmain = if enumFromTo 1 3 == [1,2,3] && enumFromTo 3 1 == [3,2,1] && enumFromTo 2 2 == [2] then 42 else 1\n"; + let Some(output) = run_with_wasmtime(source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn guarded_results_do_not_invent_a_missing_dictionary() { + let source = "module Main where\nclass Build f where\n build :: forall a. a -> f a\nchoose :: forall f a. Boolean -> a -> f a\nchoose = case _, _ of\n flag, value\n | flag -> build value\n | true -> build value\nmain :: Int\nmain = 42\n"; + let errors = check_source("Main.purs", source).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.code == Some("NoInstanceFound")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/guard_coverage.rs b/crates/psrs-driver/src/tests/guard_coverage/mod.rs similarity index 99% rename from crates/psrs-driver/src/tests/guard_coverage.rs rename to crates/psrs-driver/src/tests/guard_coverage/mod.rs index f02deaca..10ce423a 100644 --- a/crates/psrs-driver/src/tests/guard_coverage.rs +++ b/crates/psrs-driver/src/tests/guard_coverage/mod.rs @@ -1,5 +1,7 @@ use super::*; +mod constrained; + #[test] fn shadowed_boolean_case_guard_reports_its_source_row_and_keeps_first_match() { let source = "module Main where\nchoose input guard = case input of\n true -> 11\n true | guard -> 22\n false -> 33\nmain = choose true false\n"; diff --git a/crates/psrs-driver/tests/upstream/guard_continuations.rs b/crates/psrs-driver/tests/upstream/guard_continuations.rs new file mode 100644 index 00000000..120ce730 --- /dev/null +++ b/crates/psrs-driver/tests/upstream/guard_continuations.rs @@ -0,0 +1,52 @@ +use super::*; + +#[test] +fn guarded_polymorphic_results_match_official_purs() { + if !purs_available() { + eprintln!("skipping: purs is not installed"); + return; + } + for (name, constraint, body, accepted) in [ + ( + "single-row", + "Build f => ", + "choose = case _, _ of\n flag, value\n | flag -> build value\n | true -> build value\n", + true, + ), + ( + "later-guard", + "Build f => ", + "choose flag value = case flag of\n false -> build value\n true | flag -> build value\n true -> build value\n", + true, + ), + ( + "missing-dictionary", + "", + "choose = case _, _ of\n flag, value\n | flag -> build value\n | true -> build value\n", + false, + ), + ] { + let source = format!( + "module Main where\nclass Build f where\n build :: forall a. a -> f a\nchoose :: forall f a. {constraint}Boolean -> a -> f a\n{body}main :: Int\nmain = 42\n" + ); + let sources = [("Main.purs", source.as_str())]; + let purs = purs_sources_output(&format!("guard-result-{name}"), &sources); + assert_eq!(purs.status.success(), accepted, "{name}: {purs:?}"); + let ours = psrs_driver::check_program_types_lenient(&sources); + assert_eq!(ours.is_ok(), accepted, "{name}: {ours:?}"); + if !accepted { + assert!( + purs_error_codes(&purs) + .iter() + .any(|code| code == "NoInstanceFound"), + "{name}: {purs:?}" + ); + assert!( + ours.unwrap_err() + .iter() + .any(|error| error.diagnostic.code == Some("NoInstanceFound")), + "{name}" + ); + } + } +} diff --git a/crates/psrs-driver/tests/upstream/mod.rs b/crates/psrs-driver/tests/upstream/mod.rs index 16bb0d14..afed3bb3 100644 --- a/crates/psrs-driver/tests/upstream/mod.rs +++ b/crates/psrs-driver/tests/upstream/mod.rs @@ -3,6 +3,7 @@ use std::process::Command; mod coercion; mod deriving; +mod guard_continuations; mod import_aliases; mod library_foreign; mod rank_n; diff --git a/docs/design/frontend/semantics/desugaring.md b/docs/design/frontend/semantics/desugaring.md index 350855e2..115be3c7 100644 --- a/docs/design/frontend/semantics/desugaring.md +++ b/docs/design/frontend/semantics/desugaring.md @@ -112,7 +112,11 @@ A failed guard proceeds to the next guard without evaluating that guard's body. A generated temporary binds an expression once when duplication would change evaluation. The saved scrutinee is bound in an outer `let`, and fallthrough helpers share an inner `let` with the case. They refer to outer locals and the saved product -directly. Separating the saved value from the helper binding group preserves +directly. Helpers exist only for rows after the first guarded row, including the +final failure continuation. Earlier rows are checked directly as case branches +and have no unused helper copies: such copies would create additional inferred +class obligations without the original branch's expected result type. +Separating the saved value from the helper binding group preserves its scope without making that group recursive. Its calls pass an empty token to delay evaluation, rather than passing the product's polymorphic fields through a newly inferred helper parameter. Passing one of those locals in as a value diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 177e89d1..29f2bb7c 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -47,6 +47,24 @@ skip. No runner command publishes or modifies upstream checkouts. See [the repository boundary](../design/D-17-stdlib-and-conformance-boundaries.md) for ownership, package locking, and the limits of this evidence. +For public Bounded values and Enum range interactions: + +```sh +node ../psrs-stdlib/conformance/bounded.mjs \ + /private/tmp/purescript-prelude /tmp/psrs-bounded-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-bounded-oracle/Main.purs \ + --input /tmp/psrs-bounded-oracle/Target.purs \ + --expected-exit 42 --out /tmp/psrs-bounded-runtime +``` + +The generator verifies the six typed foreign-slot delegates against the pinned +source and reads its official JS bounds. Char's U+10FFFF target upper bound is +an explicit DEC-16 difference from JS's U+FFFF; the three Enum range observations +are integration checks. The library records these distinctions in +`docs/bounded.md` and `docs/evidence/bounded/`. + The library owns non-scalar case generators as well. For array application: ```sh diff --git a/stdlib.lock.json b/stdlib.lock.json index c5f61159..a9baa480 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "8aaaffad89acf7aa71da38b1405920d4f37356ef", - "source_fingerprint": "fnv1a64-v1:73d24a5e09ceea6c" + "revision": "18987e3fec9025830ce576e4815a6d7cf58bacb4", + "source_fingerprint": "fnv1a64-v1:b7f12516354db01c" } From b197f3d0856062219df9c3a394077b7054b64521 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 09:26:08 +0800 Subject: [PATCH 060/148] Terminate recursive product coverage and record stdlib acceptance --- .../src/cc/case/coverage/engine.rs | 127 +++++++++--------- .../psrs-backend/src/cc/case/coverage/mod.rs | 4 +- .../src/cc/case/coverage/render.rs | 64 +++++++++ .../src/cc/case/coverage/tests/mod.rs | 3 +- .../case/coverage/tests/recursive_products.rs | 87 ++++++++++++ .../src/tests/pattern_matching_audit.rs | 16 +++ docs/design/backend/fp/pattern-matching.md | 19 ++- .../backend/pattern-matching.md | 15 ++- .../compile-progress-2026-10-07/report.md | 97 +++++++++++++ 9 files changed, 363 insertions(+), 69 deletions(-) create mode 100644 crates/psrs-backend/src/cc/case/coverage/render.rs create mode 100644 crates/psrs-backend/src/cc/case/coverage/tests/recursive_products.rs create mode 100644 docs/implementation/stdlib/compile-progress-2026-10-07/report.md diff --git a/crates/psrs-backend/src/cc/case/coverage/engine.rs b/crates/psrs-backend/src/cc/case/coverage/engine.rs index 2c528092..dc607efc 100644 --- a/crates/psrs-backend/src/cc/case/coverage/engine.rs +++ b/crates/psrs-backend/src/cc/case/coverage/engine.rs @@ -69,6 +69,29 @@ fn useful_inner( return useful_array_any(module, matrix, query, tail, *ty, element_type, active); } if let Some(shapes) = signature(module, *ty) { + // An incomplete signature uses the default matrix. Expanding every + // constructor here grows unconstrained recursive product columns + // forever, even when the matrix is empty. Only a complete set of + // observed heads needs field-by-field specialization. + let missing = shapes + .iter() + .filter(|shape| { + !matrix + .iter() + .filter_map(|row| row.first()) + .any(|pattern| head_of(pattern).as_ref() == Some(&shape.head)) + }) + .collect::>(); + if !missing.is_empty() { + let witness = useful_with_active(module, &default_matrix(matrix), tail, active)?; + for shape in missing { + if let Some(head) = inhabited_shape(module, shape, &mut Default::default()) { + return Some(std::iter::once(head).chain(witness).collect()); + } + } + // Missing uninhabited constructors leave observed fields to + // check; their partial patterns can still expose a witness. + } for shape in shapes { let specialized = specialize(matrix, &shape); let mut specialized_query = expanded_any(&shape, matrix, query); @@ -117,6 +140,48 @@ fn useful_inner( }) } +/// Constructs a finite inhabitant independently of the pattern matrix. The +/// active path is keyed by type, so recursive products cannot grow a sequence +/// of distinct query states while looking for a base constructor. +fn inhabited_type( + module: &Module, + ty: TypeId, + active: &mut std::collections::HashSet, +) -> Option { + let ty = crate::cc::layout::unquantified_type(module, ty); + if !active.insert(ty) { + return None; + } + let result = if array_element(module, ty).is_some() { + Some(SurfacePattern::Array { + elements: Vec::new(), + ty, + span: TextRange::default(), + }) + } else if let Some(shapes) = signature(module, ty) { + shapes + .iter() + .find_map(|shape| inhabited_shape(module, shape, active)) + } else { + Some(SurfacePattern::Any { ty }) + }; + active.remove(&ty); + result +} + +fn inhabited_shape( + module: &Module, + shape: &Shape, + active: &mut std::collections::HashSet, +) -> Option { + let fields = shape + .fields + .iter() + .map(|(_, ty)| inhabited_type(module, *ty, active)) + .collect::>>()?; + Some(reconstruct(shape, fields)) +} + fn useful_array_any( module: &Module, matrix: &Matrix, @@ -418,65 +483,3 @@ fn reconstruct(shape: &Shape, arguments: Vec) -> SurfacePattern }, } } - -pub(super) fn render(module: &Module, pattern: &SurfacePattern) -> String { - match pattern { - SurfacePattern::Any { .. } | SurfacePattern::Var { .. } => "_".to_owned(), - SurfacePattern::Literal { value, .. } => render_literal(value), - SurfacePattern::Array { elements, .. } => format!( - "[{}]", - elements - .iter() - .map(|element| render(module, element)) - .collect::>() - .join(", ") - ), - SurfacePattern::Constructor { - symbol, arguments, .. - } => { - let name = module - .constructors - .iter() - .find(|constructor| constructor.symbol == *symbol) - .map_or_else( - || format!("Constructor{}", symbol.index), - |constructor| constructor.name.clone(), - ); - if arguments.is_empty() { - name - } else { - let arguments = arguments - .iter() - .map(|argument| match argument { - SurfacePattern::Any { .. } => "_".to_owned(), - SurfacePattern::Constructor { arguments, .. } if arguments.is_empty() => { - render(module, argument) - } - nested => format!("({})", render(module, nested)), - }) - .collect::>() - .join(" "); - format!("{name} {arguments}") - } - } - SurfacePattern::Record { fields, .. } => format!( - "{{ {} }}", - fields - .iter() - .map(|(label, value)| format!("{label}: {}", render(module, value))) - .collect::>() - .join(", ") - ), - SurfacePattern::Named { pattern, .. } => render(module, pattern), - } -} - -fn render_literal(literal: &Literal) -> String { - match literal { - Literal::Integer(value) => value.to_string(), - Literal::Number(value) => value.clone(), - Literal::String(value) => format!("{value:?}"), - Literal::Char(value) => format!("{value:?}"), - Literal::Boolean(value) => value.to_string(), - } -} diff --git a/crates/psrs-backend/src/cc/case/coverage/mod.rs b/crates/psrs-backend/src/cc/case/coverage/mod.rs index 42d95b86..7514dede 100644 --- a/crates/psrs-backend/src/cc/case/coverage/mod.rs +++ b/crates/psrs-backend/src/cc/case/coverage/mod.rs @@ -24,7 +24,9 @@ impl CoverageReport { } mod engine; -use engine::{render, useful}; +mod render; +use engine::useful; +use render::render; pub(super) fn analyze( module: &Module, diff --git a/crates/psrs-backend/src/cc/case/coverage/render.rs b/crates/psrs-backend/src/cc/case/coverage/render.rs new file mode 100644 index 00000000..2a47ab8b --- /dev/null +++ b/crates/psrs-backend/src/cc/case/coverage/render.rs @@ -0,0 +1,64 @@ +use super::super::decision::SurfacePattern; +use psrs_core::{Literal, Module}; + +pub(super) fn render(module: &Module, pattern: &SurfacePattern) -> String { + match pattern { + SurfacePattern::Any { .. } | SurfacePattern::Var { .. } => "_".to_owned(), + SurfacePattern::Literal { value, .. } => render_literal(value), + SurfacePattern::Array { elements, .. } => format!( + "[{}]", + elements + .iter() + .map(|element| render(module, element)) + .collect::>() + .join(", ") + ), + SurfacePattern::Constructor { + symbol, arguments, .. + } => { + let name = module + .constructors + .iter() + .find(|constructor| constructor.symbol == *symbol) + .map_or_else( + || format!("Constructor{}", symbol.index), + |constructor| constructor.name.clone(), + ); + if arguments.is_empty() { + name + } else { + let arguments = arguments + .iter() + .map(|argument| match argument { + SurfacePattern::Any { .. } => "_".to_owned(), + SurfacePattern::Constructor { arguments, .. } if arguments.is_empty() => { + render(module, argument) + } + nested => format!("({})", render(module, nested)), + }) + .collect::>() + .join(" "); + format!("{name} {arguments}") + } + } + SurfacePattern::Record { fields, .. } => format!( + "{{ {} }}", + fields + .iter() + .map(|(label, value)| format!("{label}: {}", render(module, value))) + .collect::>() + .join(", ") + ), + SurfacePattern::Named { pattern, .. } => render(module, pattern), + } +} + +fn render_literal(literal: &Literal) -> String { + match literal { + Literal::Integer(value) => value.to_string(), + Literal::Number(value) => value.clone(), + Literal::String(value) => format!("{value:?}"), + Literal::Char(value) => format!("{value:?}"), + Literal::Boolean(value) => value.to_string(), + } +} diff --git a/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs b/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs index c02202ad..ce165c86 100644 --- a/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs @@ -4,6 +4,7 @@ use psrs_hir::{LocalId, ModuleId, SymbolId, TypeId as HirTypeId}; use psrs_span::TextRange; use std::rc::Rc; +mod recursive_products; mod scalar_array; fn symbol(index: u32) -> SymbolId { @@ -295,7 +296,7 @@ fn recursive_adt_analysis_finds_a_finite_uncovered_witness() { }, )); let report = analyze(&module, TypeId(0), &[cons_nil]); - assert_eq!(report.witness.as_deref(), Some("Cons (Cons Nil)")); + assert_eq!(report.witness.as_deref(), Some("Nil")); } #[derive(Clone, Debug)] diff --git a/crates/psrs-backend/src/cc/case/coverage/tests/recursive_products.rs b/crates/psrs-backend/src/cc/case/coverage/tests/recursive_products.rs new file mode 100644 index 00000000..d5a849ed --- /dev/null +++ b/crates/psrs-backend/src/cc/case/coverage/tests/recursive_products.rs @@ -0,0 +1,87 @@ +use super::*; + +#[test] +fn recursive_products_terminate_in_either_constructor_order() { + for node_first in [true, false] { + let mut constructors = vec![ + constructor(0, "Node", 0, vec![TypeId(1), TypeId(0), TypeId(0)]), + constructor(1, "Leaf", 0, Vec::new()), + ]; + if !node_first { + constructors.reverse(); + } + let module = module( + vec![ + Type::Constructor(TypeConstructor::User(hir_type_id(0))), + Type::Constructor(TypeConstructor::Int), + ], + constructors, + ); + let node = || { + pat( + 0, + PatternKind::Constructor { + symbol: symbol(0), + arguments: vec![ + pat(1, PatternKind::Wildcard), + pat(0, PatternKind::Wildcard), + pat(0, PatternKind::Wildcard), + ], + }, + ) + }; + let incomplete = analyze(&module, TypeId(0), &[branch(node())]); + assert!(!incomplete.exhaustive, "{incomplete:?}"); + assert_eq!(incomplete.witness.as_deref(), Some("Leaf")); + assert!(incomplete.redundant_branches.is_empty()); + let complete = analyze( + &module, + TypeId(0), + &[branch(node()), branch(nullary(1, 0)), branch(node())], + ); + assert!(complete.exhaustive, "{complete:?}"); + assert_eq!(complete.redundant_branches, vec![2]); + } +} + +#[test] +fn an_uninhabited_recursive_product_does_not_invent_a_witness() { + let module = module( + vec![Type::Constructor(TypeConstructor::User(hir_type_id(0)))], + vec![constructor(0, "Loop", 0, vec![TypeId(0), TypeId(0)])], + ); + let report = analyze(&module, TypeId(0), &[]); + assert!(report.exhaustive, "{report:?}"); + assert!(report.witness.is_none()); +} + +#[test] +fn missing_uninhabited_heads_do_not_hide_observed_field_gaps() { + let module = module( + vec![ + Type::Constructor(TypeConstructor::User(hir_type_id(0))), + Type::Constructor(TypeConstructor::User(hir_type_id(1))), + Type::Constructor(TypeConstructor::Boolean), + ], + vec![ + constructor(0, "Impossible", 0, vec![TypeId(1)]), + constructor(1, "Present", 0, vec![TypeId(2)]), + constructor(2, "Loop", 1, vec![TypeId(1)]), + ], + ); + let present_true = pat( + 0, + PatternKind::Constructor { + symbol: symbol(1), + arguments: vec![pat( + 2, + PatternKind::Literal { + value: psrs_core::Literal::Boolean(true), + }, + )], + }, + ); + let report = analyze(&module, TypeId(0), &[branch(present_true)]); + assert!(!report.exhaustive, "{report:?}"); + assert_eq!(report.witness.as_deref(), Some("Present (false)")); +} diff --git a/crates/psrs-driver/src/tests/pattern_matching_audit.rs b/crates/psrs-driver/src/tests/pattern_matching_audit.rs index b00802b4..560e5b31 100644 --- a/crates/psrs-driver/src/tests/pattern_matching_audit.rs +++ b/crates/psrs-driver/src/tests/pattern_matching_audit.rs @@ -211,6 +211,22 @@ fn recursive_pattern_compilation_terminates_and_stays_first_match() { assert_eq!(output.status.code(), Some(42)); } +/// PM-10: a recursive product grows the specialization query unless missing +/// constructor signatures use the default matrix before witness construction. +#[test] +fn recursive_binary_products_execute_in_either_constructor_order() { + for declaration in ["Node Int Tree Tree | Leaf", "Leaf | Node Int Tree Tree"] { + let source = format!( + "module Main where\ndata Tree = {declaration}\nread tree = case tree of\n Node n Leaf Leaf -> n\n Node _ _ _ -> 1\n Leaf -> 0\nmain = read (Node 42 Leaf Leaf)\n" + ); + let Some(output) = run_with_wasmtime(&source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{source}"); + } +} + /// PM-11: the optimizer and Wasm lowering preserve the selected branch value /// and keep the source-associated redundancy warning. #[test] diff --git a/docs/design/backend/fp/pattern-matching.md b/docs/design/backend/fp/pattern-matching.md index a9face55..cf2ec8c7 100644 --- a/docs/design/backend/fp/pattern-matching.md +++ b/docs/design/backend/fp/pattern-matching.md @@ -216,6 +216,16 @@ frontend diagnostics; the compiler never silently emits a partial decision. Coverage is checked where the pattern matrix is built, so a rejected program keeps its source span. +For an irrefutable query over a finite signature, check the default matrix first +when the matrix does not observe every constructor, then construct a finite +inhabitant of a missing constructor. A complete signature specializes every +constructor; if all missing constructors are uninhabited, specialization still +checks the observed constructors for uncovered fields. Witness construction tracks types +along the current field path, so recursive products cannot expand the query +indefinitely. A recursive type without a finite constructor inhabitant does not +justify an uncovered witness. Constructor enumeration order must not affect +termination or first-match behavior. + ### Rejected alternatives - **Ordered backtracking matcher (nested if-chain).** The current lowering @@ -305,8 +315,13 @@ useful(matrix, query): return useful(specialize(matrix, 0, exact_length(length(elements))), elements ++ query[1..]) Irrefutable: - if matrix has a full first-column signature S: - // Boolean and closed ADT signatures enumerate every head. + if column has a finite signature S: + if matrix does not observe all of S: + if not useful(default(matrix, 0), query[1..]): + return false + if some missing shape in S has a finite inhabitant: + return true + // Missing empty constructors cannot hide observed gaps. for shape in S: if useful(specialize(matrix, 0, shape), wildcards(field_count(shape)) ++ query[1..]): diff --git a/docs/implementation/backend/pattern-matching.md b/docs/implementation/backend/pattern-matching.md index 3c71dd32..b9deb07c 100644 --- a/docs/implementation/backend/pattern-matching.md +++ b/docs/implementation/backend/pattern-matching.md @@ -149,8 +149,9 @@ PM-03: Gaps: none. PM-04: - Implementation: cc/case/coverage/mod.rs `analyze`, `useful`, `useful_with_active` - (cycle-safe), `signature`, `specialize`, `default_matrix`, `render`; + Implementation: cc/case/coverage/mod.rs `analyze`; coverage/engine.rs `useful`, + `useful_with_active` (cycle-safe), `signature`, `specialize`, `default_matrix`, + and finite witness construction; coverage/render.rs `render`; cc/case/mod.rs `require_exhaustive`/`report_redundant_branches`. Tests: coverage::tests::reports_the_missing_nullary_constructor, ::recognizes_exhaustive_nested_constructor_patterns, @@ -160,6 +161,10 @@ PM-04: ::recursive_adt_analysis_finds_a_finite_uncovered_witness, ::recursive_coverage_agrees_with_a_bounded_first_match_oracle (all small recursive matrices against a bounded oracle); + ::recursive_products::recursive_products_terminate_in_either_constructor_order + checks missing `Leaf` witnesses and redundant binary-tree rows; + ::recursive_products::an_uninhabited_recursive_product_does_not_invent_a_witness + rejects infinite recursive products as witness candidates; decision::compile::oracle_tests::coverage_agrees_with_the_first_match_oracle; adts::reports_a_missing_nested_constructor_as_a_coverage_witness checks the nested witness and exact case-expression span; @@ -269,7 +274,9 @@ PM-09: Gaps: none. PM-10: - Implementation: coverage/mod.rs cycle-safe `useful_with_active`; + Implementation: coverage/engine.rs default-matrix recursion for incomplete + signatures, cycle-safe `useful_with_active`, and type-path-scoped finite + witness construction; compile/mod.rs memoization and the all-irrefutable-column base case. Tests: coverage::tests::recursive_adt_wildcard_coverage_terminates, ::recursive_adt_analysis_finds_a_finite_uncovered_witness, @@ -277,6 +284,8 @@ PM-10: oracle_tests and oracle_record_tests (whole small matrices); pattern_matching_audit::recursive_pattern_compilation_terminates_and_stays_first_match executes a depth-four recursive ADT; adts::runs_nested_non_parameterized_gc_aggregates. + pattern_matching_audit::recursive_binary_products_execute_in_either_constructor_order + executes nested binary-tree patterns with either constructor ordering. Input boundary: verified Core and source. Commands: common commands. Result: pass; the recursive execution case ran under Wasmtime. diff --git a/docs/implementation/stdlib/compile-progress-2026-10-07/report.md b/docs/implementation/stdlib/compile-progress-2026-10-07/report.md new file mode 100644 index 00000000..2dd8b3f1 --- /dev/null +++ b/docs/implementation/stdlib/compile-progress-2026-10-07/report.md @@ -0,0 +1,97 @@ +# Stdlib compilation progress + +This slice repairs three compiler contracts and implements the public Bounded +foreign slots in the independent library. It starts at compiler `7f93266` and +stdlib `8aaaffa`. The final library pin is +`18987e3fec9025830ce576e4815a6d7cf58bacb4`, content fingerprint +`fnv1a64-v1:b7f12516354db01c`. + +## Compiler contracts + +- P3 qualified scopes combine disjoint imports. Ambiguity depends on canonical + declaration identity at lookup or pseudo-module re-export, rather than a + blanket ban on shared aliases. Six official-purs differential cases cover + disjoint members, repeated canonical declarations, unused conflicting scopes, + and value/type/re-export ambiguity. +- P4 guard lowering creates fallthrough helpers only for rows that can be + entered after the first guarded row. Previously unused copies introduced + fresh inferred result constraints in Data.Enum, Data.Enum.Generic and + Data.List.Lazy. The repair preserves scoped dictionary checking; a missing + dictionary is still rejected. Three official-purs cases and value-sensitive + guarded/fallthrough executions cover the boundary. +- P8 coverage analysis checks the default matrix for incomplete finite + signatures before constructing a finite missing witness. Witness construction + tracks the type path, so binary recursive products cannot continually grow + the query columns. Missing uninhabited constructors still require analysis of + observed fields. Core tests cover either constructor order, redundancy, + missing witnesses, and uninhabited recursive products. Source execution + covers both binary-tree constructor orders. Data.Map.singleton/size now + compiles and returns 42 under Wasmtime; the prior reproducer aborted with a + stack overflow in usefulness recursion. + +## Library boundary + +Data.Bounded changes only its six typed foreign slots and one target import. +PSRS.Bounded owns i32 bounds and binary64 infinities over existing checked +scalar primitives. The official pure code, APIs, classes and instances remain. +DEC-16 justifies Char's U+10FFFF scalar upper bound instead of JS's U+FFFF. +The pinned-source generator verifies the exact allowed transformation and reads +actual upstream JS constants. The 18 checks include three Enum integration +observations, which are not claimed as an upstream Enum differential oracle. +`bounded-run.json` records Wasmtime exit 42 and empty stdout/stderr. + +## Validation and limits + +The L2 annotations scoreboard reports M2 72/72 and passing resolution 403/413. +The ten remaining blockers are six P3 and four P0; there are no missing-library +or harness-loading blockers. Nineteen sibling modules load successfully. +The package audit covers 224 modules in 41 packages: 172 identical, 34 modified, +18 target additions, no upstream module omitted, and no direct-self-recursion +replacement. Audit categories do not by themselves approve target differences. +Library Node tooling tests: 8 passed. + +`diagnosis-checkpoints.json` distinguishes the initial P3 failure (165 +diagnostics), alias-only P5 failure (7 diagnostics), and the guard-fixed full +import acceptance (137559 ms with a 240-second cohort). The same 211-import +source with unused integer main timed out under 120 seconds after the coverage +repair. Different timeout cohorts and library fingerprints are not presented as +compatible diagnosis comparisons. The final locked-package remeasurement passes in 172290 ms under the +240-second cohort, with no diagnostics. It retains the same input fingerprint. + +Compile acceptance of an unused main does not prove every exported API executes +or every declaration is retained in the executable. The focused List.length, +Set.singleton/size, Map.singleton/size and Enum range executions establish only +those paths. The final locked-package String and Int parsing probes still fail explicitly +at P8 library linking: `Data.String.CodeUnits.length` and +`Data.Int.fromStringAsImpl` have no target implementation (9489 ms and +13615 ms). Some Number operations, Lazy and Effect.Ref also retain foreign slots +without target support in the earlier survey. This slice does not close the entire stdlib. + +The real Map runtime fixture is: + +```purescript +module Main where +import Prelude +import Data.Map as M +main :: Int +main = if M.size (M.singleton 1 2) == 1 then 42 else 1 +``` + +Formatting and strict workspace clippy pass. The backend library suite passes +403 tests; the driver library suite passes 685 tests with the three failures +below (mandatory Wasmtime, 233.18 seconds). The trusted-order loader and all +new guard/recursive-product runtime regressions pass. The original HEAD independently +reproduces three driver-library failures: `constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number` and +`compiles_if_expression_through_cfg_to_structured_wasm`. Their optimized-artifact +assertions are a pre-existing validation baseline, not a passing full workspace. +The complete `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` +run finishes with 1658 passed, 3 failed and 5 ignored tests, exit 101. +The run also reports E0463 dependency-artifact load failures in backend and +driver rustdoc targets. A sequential +`cargo test -p psrs-backend -p psrs-driver --doc` recheck passes, exit 0, +without source changes. These artifact errors do not remain unresolved. All +other targets and doc-tests pass. +The 19 upstream differential groups pass. Ignored scoreboards remain +unmeasured here except for the separately executed L2 board. `validation.json` +records the result and the independently verified baseline failures. From e730c1b232db3f83a359c13b3006ad717fc32617 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 09:41:26 +0800 Subject: [PATCH 061/148] Pin scalar String slicing with projected FFI and runtime evidence --- .../DEC-16-scalar-strings-and-utf8-storage.md | 12 ++-- .../string-slicing-2026-10-07/report.md | 58 +++++++++++++++++++ docs/workflow/stdlib-conformance.md | 18 ++++++ stdlib.lock.json | 4 +- 4 files changed, 86 insertions(+), 6 deletions(-) create mode 100644 docs/implementation/stdlib/string-slicing-2026-10-07/report.md diff --git a/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md b/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md index e073e826..854f2083 100644 --- a/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md +++ b/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md @@ -140,10 +140,14 @@ The migration has landed: intentional differences, and L1 parse agreement is 904/908 with exactly those four cases as the remainder. -One part of the target is not implemented: there is no source-level string -length, indexing, or slicing operation yet, so scalar-value boundaries are -enforced inside the storage and boundary paths only. Adding those operations is -where the scalar/byte distinction first becomes visible to source. +Source-level scalar length, take, drop, slice and splitAt now execute through +Data.String.CodeUnits foreign-slot delegates to the independent PSRS.String +library. The library scans validated canonical UTF-8 and maps scalar indices +to byte boundaries before copying a range through PSRS.Array.sliceImpl. The +448-case pinned-FFI projection oracle makes the intentional scalar/UTF-16 +difference explicit; see the [acceptance checkpoint](../implementation/stdlib/string-slicing-2026-10-07/report.md). +Other foreign slots, including character indexing and predicate traversal, +remain unsupported. This does not establish the full String API. This record is the semantic authority. The design documents state the contract, including diff --git a/docs/implementation/stdlib/string-slicing-2026-10-07/report.md b/docs/implementation/stdlib/string-slicing-2026-10-07/report.md new file mode 100644 index 00000000..a262610b --- /dev/null +++ b/docs/implementation/stdlib/string-slicing-2026-10-07/report.md @@ -0,0 +1,58 @@ +# Scalar String length and slicing checkpoint + +The compiler prerequisite topics are committed as 138da4e (canonical qualified +scopes), cdeefed (guard continuations and Bounded pin), and 4aa5b51 (recursive +product coverage). This follow-up changes no Rust compiler mechanism. + +The independent library pin is c8020c00e227f256c0a365e22d5ebcbd1601607a, +content fingerprint fnv1a64-v1:6d4f0e0ccbe37bc0. Data.String.CodeUnits keeps +all official exports, signatures and pure declarations. Its five foreign slots +length, take, drop, slice and splitAt delegate to PSRS.String. The library scans +validated canonical UTF-8 at scalar boundaries, copies through the existing +PSRS.Array.sliceImpl, and validates output with bytesToString. It adds no +whole-function intrinsic and keeps mutation primitives private to the array +storage owner. Prelude remains first in trusted loading. + +DEC-16 makes these source indices Unicode scalar indices, not bytes or UTF-16 +units. The pinned official FFI executes against a one-BMP-unit-per-scalar +projection, then output maps back to original scalars. Raw UTF-16 results and +the FFI digest are recorded separately in the library's observations. This is +an explicit target difference, not raw-JS equality on supplementary text. + +Validation: + +- 448 projected-FFI/runtime observations return 42 under Wasmtime 49.0.2 with + empty stdout/stderr. Cases cover NUL, combining characters, all UTF-8 width + transitions, supplementary scalars, U+10FFFF, empty/reversed/negative ranges, + oversized indices and both signed i32 extrema. The unchanged takeRight and + dropRight wrappers also execute. The final package run is in run.json. +- The same String-length probe changes from explicit P8 missing binding to + compile acceptance (4794 ms). Library fingerprints differ, so this is not + presented as a compatible diagnose --compare result. diagnosis.json records + both observations. +- The source audit covers 225 modules in 41 pinned packages: 171 identical, + 35 modified and 19 platform additions, no missing upstream module and no + direct-self-recursion replacement. The exact five-slot transformation is + checked by the oracle generator; aggregate audit categories alone do not + approve differences. +- Library Node tooling: 8 passed. Development-root and locked-root trusted-order + loader checks pass. Mandatory Wasmtime driver string regressions: 16 passed. +- Formatting and diff checks pass. No Rust source changes were made in this + slice, so the full workspace/clippy checks from the prerequisite checkpoint + were not repeated. That checkpoint still records three independently + reproduced driver-library baseline failures. + +A separate finite-expression resource limit remains open. An ordinary module +with Prelude and `main = if true && ... && true then 42 else 1` (448 operands) +compiles with official purs but aborts our compiler with stack overflow even +against the preceding Bounded-only package. A native backtrace on the ungrouped +String oracle locates repeated P5 infer_application / infer_expr_with_expected +frames. The oracle groups its checks into helpers of at most 24 observations; +this fixture organization validates all 448 values and does not repair the +compiler traversal limit. The next compiler follow-up must address the common +expression traversal rather than specialize on String or Boolean names. + +Character indexing, predicate traversal, searching and other String slots +remain explicitly unsupported. This slice does not claim full String or +stdlib API/runtime closure, and the full 211-import reproducer was not +remeasured after this library change. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 29f2bb7c..e2f8d9b2 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -118,3 +118,21 @@ node ../psrs-stdlib/tools/conformance.mjs run \ These observations execute target helpers. Public `Data.Array` wrapper execution remains blocked by unsupported `Data.Array.ST` bindings in its import closure; helper acceptance does not establish public API or whole-library acceptance. + +For scalar string length and slicing: + +```sh +node ../psrs-stdlib/conformance/string-slicing.mjs \ + /private/tmp/ps-pkgs/purescript-strings /tmp/psrs-string-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-string-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-string-runtime +``` + +The generator verifies the five typed foreign-slot delegates and evaluates the +pinned official FFI on a one-BMP-unit-per-scalar projection. Scalar results map +back to original text; raw UTF-16 observations are recorded separately. +Negative-relative/clamping policies remain official, while DEC-16 intentionally +changes index units. This is a projected oracle, not raw-JS equality on +supplementary characters. Case engines and evidence live in the library package. diff --git a/stdlib.lock.json b/stdlib.lock.json index a9baa480..16680a2f 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "18987e3fec9025830ce576e4815a6d7cf58bacb4", - "source_fingerprint": "fnv1a64-v1:b7f12516354db01c" + "revision": "c8020c00e227f256c0a365e22d5ebcbd1601607a", + "source_fingerprint": "fnv1a64-v1:6d4f0e0ccbe37bc0" } From 716752718598705c1991c95b000d425efd3c463d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 14:43:14 +0800 Subject: [PATCH 062/148] Guard deep expression walks and consume intrinsic spines Preserve fixity and argument order while growing recursive traversal, clone and equality stacks. Move saturated intrinsic arguments instead of cloning the lowered remainder. Record required Wasmtime regression and ungrouped String evidence, plus the 211-import compile checkpoint. Full workspace validation has 1664 passing tests and the same three recorded baseline failures; formatting and strict clippy pass. --- Cargo.lock | 3 + Cargo.toml | 1 + crates/psrs-ast/src/expr/chain.rs | 64 ++++++ crates/psrs-ast/src/expr/mod.rs | 2 + crates/psrs-ast/src/lib.rs | 55 +---- crates/psrs-backend/src/cc/layout/captures.rs | 12 ++ .../src/cc/layout/functions/reachable.rs | 9 + .../src/cc/lower/lambda/captures.rs | 8 + crates/psrs-backend/src/cc/lower/mod.rs | 8 + .../psrs-core/src/instantiation/local_rows.rs | 9 + .../src/instantiation/substitution.rs | 4 + crates/psrs-core/src/lib.rs | 28 ++- crates/psrs-core/src/link/mod.rs | 16 ++ crates/psrs-core/src/lower/mod.rs | 55 +++-- crates/psrs-core/src/opt/dead.rs | 10 +- crates/psrs-core/src/opt/effects.rs | 4 + .../src/opt/inline/global/analysis.rs | 12 ++ crates/psrs-core/src/opt/inline/global/mod.rs | 23 +++ crates/psrs-core/src/opt/inline/local.rs | 12 ++ crates/psrs-core/src/opt/simplify/mod.rs | 6 +- crates/psrs-core/src/opt/specialize/calls.rs | 12 ++ crates/psrs-core/src/opt/specialize/mod.rs | 4 + crates/psrs-core/src/opt/util.rs | 12 ++ crates/psrs-core/src/primitive.rs | 9 + crates/psrs-core/src/tests/deep_expr.rs | 30 +++ crates/psrs-core/src/tests/mod.rs | 1 + crates/psrs-core/src/verify/expr/mod.rs | 4 + crates/psrs-core/src/verify/scopes/expr.rs | 9 + crates/psrs-desugar/src/expr.rs | 4 + crates/psrs-desugar/src/lib.rs | 4 + .../psrs-driver/src/tests/long_expression.rs | 37 ++++ crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-hir/src/expr.rs | 27 ++- crates/psrs-hir/src/tests.rs | 26 +++ crates/psrs-hir/src/verify/mod.rs | 12 ++ crates/psrs-hir/src/verify/normalized.rs | 4 + .../src/check/infer/pattern_annotations.rs | 4 + crates/psrs-resolve/src/resolver/names/mod.rs | 4 + crates/psrs-span/Cargo.toml | 1 + crates/psrs-span/src/lib.rs | 32 +++ crates/psrs-thir/src/lib.rs | 28 ++- crates/psrs-thir/src/scope/expr.rs | 195 ++++++++++++++++++ crates/psrs-thir/src/scope/mod.rs | 183 +--------------- crates/psrs-thir/src/tests/deep_expr.rs | 30 +++ crates/psrs-thir/src/tests/mod.rs | 1 + crates/psrs-thir/src/verify/mod.rs | 4 + crates/psrs-thir/src/verify/semantics/mod.rs | 4 + .../psrs-typecheck/src/typecheck/finalize.rs | 11 + .../src/typecheck/infer/expected.rs | 10 + .../psrs-typecheck/src/typecheck/infer/mod.rs | 4 + crates/psrs-typecheck/src/typecheck/order.rs | 4 + .../deep-expression-2026-10-07/report.md | 73 +++++++ .../string-slicing-2026-10-07/report.md | 21 +- 53 files changed, 884 insertions(+), 262 deletions(-) create mode 100644 crates/psrs-ast/src/expr/chain.rs create mode 100644 crates/psrs-core/src/tests/deep_expr.rs create mode 100644 crates/psrs-driver/src/tests/long_expression.rs create mode 100644 crates/psrs-thir/src/scope/expr.rs create mode 100644 crates/psrs-thir/src/tests/deep_expr.rs create mode 100644 docs/implementation/stdlib/deep-expression-2026-10-07/report.md diff --git a/Cargo.lock b/Cargo.lock index 152b6e47..8be7e674 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -433,6 +433,9 @@ dependencies = [ [[package]] name = "psrs-span" version = "0.1.0" +dependencies = [ + "stacker", +] [[package]] name = "psrs-syntax" diff --git a/Cargo.toml b/Cargo.toml index 0f265293..9c8165d4 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -44,6 +44,7 @@ psrs-syntax = { path = "crates/psrs-syntax" } wasm-encoder = "=0.245.1" wasmparser = "=0.245.1" wasmprinter = "=0.245.1" +stacker = "0.1.22" [profile.target-runtime] inherits = "release" diff --git a/crates/psrs-ast/src/expr/chain.rs b/crates/psrs-ast/src/expr/chain.rs new file mode 100644 index 00000000..4d1b72d1 --- /dev/null +++ b/crates/psrs-ast/src/expr/chain.rs @@ -0,0 +1,64 @@ +use crate::{LowerError, Operator, lower_expr, lower_name}; +use psrs_cst::{self as cst, ExprKind as CstExprKind}; +use psrs_span::TextRange; + +use super::{Expr, ExprKind}; + +pub(crate) fn lower_operator_chain( + operator: cst::CstName, + left: cst::Expr, + right: cst::Expr, + span: TextRange, +) -> Result { + let mut operands = Vec::new(); + let mut operators = Vec::new(); + collect_operator_chain(left, &mut operands, &mut operators)?; + operators.push(Operator { + name: lower_name(operator.clone()), + span: operator.span, + }); + collect_operator_chain(right, &mut operands, &mut operators)?; + Ok(Expr { + kind: ExprKind::OperatorChain { + operands, + operators, + }, + span, + }) +} + +fn collect_operator_chain( + expression: cst::Expr, + operands: &mut Vec, + operators: &mut Vec, +) -> Result<(), LowerError> { + psrs_span::with_sufficient_stack(|| { + collect_operator_chain_inner(expression, operands, operators) + }) +} + +fn collect_operator_chain_inner( + expression: cst::Expr, + operands: &mut Vec, + operators: &mut Vec, +) -> Result<(), LowerError> { + let span = expression.span; + match expression.kind { + CstExprKind::Operator { + operator, + left, + right, + } => { + collect_operator_chain(*left, operands, operators)?; + operators.push(Operator { + name: lower_name(operator.clone()), + span: operator.span, + }); + collect_operator_chain(*right, operands, operators) + } + kind => { + operands.push(lower_expr(cst::Expr { kind, span })?); + Ok(()) + } + } +} diff --git a/crates/psrs-ast/src/expr/mod.rs b/crates/psrs-ast/src/expr/mod.rs index 09712085..d22e0268 100644 --- a/crates/psrs-ast/src/expr/mod.rs +++ b/crates/psrs-ast/src/expr/mod.rs @@ -3,8 +3,10 @@ use psrs_cst as cst; use psrs_span::TextRange; use std::collections::HashSet; +mod chain; mod guards; mod records; +pub(super) use chain::lower_operator_chain; pub use guards::{Guard, GuardedExpr}; pub(super) use guards::{ lower_case_patterns, lower_case_scrutinees, lower_guard, lower_guarded_rhs, lower_if, diff --git a/crates/psrs-ast/src/lib.rs b/crates/psrs-ast/src/lib.rs index 029deebe..3417c7bb 100644 --- a/crates/psrs-ast/src/lib.rs +++ b/crates/psrs-ast/src/lib.rs @@ -184,6 +184,10 @@ pub(crate) fn check_argument_names(parameters: &[cst::Pattern]) -> Option Result { + psrs_span::with_sufficient_stack(|| lower_expr_inner(expression)) +} + +fn lower_expr_inner(expression: cst::Expr) -> Result { let span = expression.span; let cst_kind = match expression.kind { CstExprKind::Let { @@ -226,7 +230,7 @@ pub(crate) fn lower_expr(expression: cst::Expr) -> Result { operator, left, right, - } => return lower_operator_chain(operator, *left, *right, span), + } => return expr::lower_operator_chain(operator, *left, *right, span), CstExprKind::OperatorSection { operator, operand, @@ -422,55 +426,6 @@ fn lower_lambda(binder: Binder, body: Expr) -> Expr { } } -fn lower_operator_chain( - operator: cst::CstName, - left: cst::Expr, - right: cst::Expr, - span: TextRange, -) -> Result { - let mut operands = Vec::new(); - let mut operators = Vec::new(); - collect_operator_chain(left, &mut operands, &mut operators)?; - operators.push(Operator { - name: lower_name(operator.clone()), - span: operator.span, - }); - collect_operator_chain(right, &mut operands, &mut operators)?; - Ok(Expr { - kind: ExprKind::OperatorChain { - operands, - operators, - }, - span, - }) -} - -fn collect_operator_chain( - expression: cst::Expr, - operands: &mut Vec, - operators: &mut Vec, -) -> Result<(), LowerError> { - let span = expression.span; - match expression.kind { - CstExprKind::Operator { - operator, - left, - right, - } => { - collect_operator_chain(*left, operands, operators)?; - operators.push(Operator { - name: lower_name(operator.clone()), - span: operator.span, - }); - collect_operator_chain(*right, operands, operators) - } - kind => { - operands.push(lower_expr(cst::Expr { kind, span })?); - Ok(()) - } - } -} - /// Tuple component labels. A tuple is the closed record `{ _1, _2, ... }`. pub(crate) fn tuple_label(index: usize) -> String { format!("_{}", index + 1) diff --git a/crates/psrs-backend/src/cc/layout/captures.rs b/crates/psrs-backend/src/cc/layout/captures.rs index a0cf8d8b..63b20289 100644 --- a/crates/psrs-backend/src/cc/layout/captures.rs +++ b/crates/psrs-backend/src/cc/layout/captures.rs @@ -11,6 +11,10 @@ pub(super) fn module_has_integer_capture(module: &CoreModule) -> bool { } fn expression_has_integer_capture(expression: &Expr, module: &CoreModule) -> bool { + psrs_span::with_sufficient_stack(|| expression_has_integer_capture_inner(expression, module)) +} + +fn expression_has_integer_capture_inner(expression: &Expr, module: &CoreModule) -> bool { match &expression.kind { ExprKind::Lambda { binder, body } => { let mut bound = HashSet::from([binder.id]); @@ -79,6 +83,14 @@ fn free_integer_local( expression: &Expr, module: &CoreModule, bound: &mut HashSet, +) -> bool { + psrs_span::with_sufficient_stack(|| free_integer_local_inner(expression, module, bound)) +} + +fn free_integer_local_inner( + expression: &Expr, + module: &CoreModule, + bound: &mut HashSet, ) -> bool { match &expression.kind { ExprKind::Local(id) => { diff --git a/crates/psrs-backend/src/cc/layout/functions/reachable.rs b/crates/psrs-backend/src/cc/layout/functions/reachable.rs index e818a691..79788f60 100644 --- a/crates/psrs-backend/src/cc/layout/functions/reachable.rs +++ b/crates/psrs-backend/src/cc/layout/functions/reachable.rs @@ -38,6 +38,15 @@ fn record_expr( expression: &Expr, visiting: &mut HashSet, referenced: &mut HashSet, +) { + psrs_span::with_sufficient_stack(|| record_expr_inner(module, expression, visiting, referenced)) +} + +fn record_expr_inner( + module: &CoreModule, + expression: &Expr, + visiting: &mut HashSet, + referenced: &mut HashSet, ) { record_type(module, expression.ty, visiting, referenced); match &expression.kind { diff --git a/crates/psrs-backend/src/cc/lower/lambda/captures.rs b/crates/psrs-backend/src/cc/lower/lambda/captures.rs index 52cbef5f..16f0a4d2 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/captures.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/captures.rs @@ -13,6 +13,14 @@ pub(in crate::cc::lower) fn collect_captures( expression: &Expr, bound: &mut HashSet, captures: &mut Vec, +) { + psrs_span::with_sufficient_stack(|| collect_captures_inner(expression, bound, captures)) +} + +fn collect_captures_inner( + expression: &Expr, + bound: &mut HashSet, + captures: &mut Vec, ) { match &expression.kind { ExprKind::Local(local) => { diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 2318be23..60d260f8 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -235,6 +235,14 @@ impl FunctionLowerer<'_> { &mut self, expression: &Expr, assignments: &mut Vec, + ) -> Result> { + psrs_span::with_sufficient_stack(|| self.lower_value_inner_entry(expression, assignments)) + } + + fn lower_value_inner_entry( + &mut self, + expression: &Expr, + assignments: &mut Vec, ) -> Result> { let ty = scalar_type( self.module, diff --git a/crates/psrs-core/src/instantiation/local_rows.rs b/crates/psrs-core/src/instantiation/local_rows.rs index 227490a0..128e8d28 100644 --- a/crates/psrs-core/src/instantiation/local_rows.rs +++ b/crates/psrs-core/src/instantiation/local_rows.rs @@ -36,6 +36,15 @@ fn rewrite( module: &mut Module, fresh: &mut FreshLocals, scope: &mut HashMap, +) { + psrs_span::with_sufficient_stack(|| rewrite_inner(expr, module, fresh, scope)) +} + +fn rewrite_inner( + expr: &mut Expr, + module: &mut Module, + fresh: &mut FreshLocals, + scope: &mut HashMap, ) { if let ExprKind::Local(id) = expr.kind { if let Some(binding) = scope.get(&id).cloned() diff --git a/crates/psrs-core/src/instantiation/substitution.rs b/crates/psrs-core/src/instantiation/substitution.rs index 314429fd..9c2de0af 100644 --- a/crates/psrs-core/src/instantiation/substitution.rs +++ b/crates/psrs-core/src/instantiation/substitution.rs @@ -198,6 +198,10 @@ impl TypeSubstitution<'_> { } fn expression(&mut self, expression: &Expr) -> Option { + psrs_span::with_sufficient_stack(|| self.expression_inner(expression)) + } + + fn expression_inner(&mut self, expression: &Expr) -> Option { let kind = match &expression.kind { ExprKind::Local(id) => ExprKind::Local(*id), ExprKind::Global(symbol) => ExprKind::Global(*symbol), diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 0963e15b..0f83235f 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -118,7 +118,7 @@ pub struct Binding { pub span: TextRange, } -#[derive(Clone, Debug, PartialEq, Eq)] +#[derive(Debug, Eq)] pub struct Expr { pub kind: ExprKind, pub ty: TypeId, @@ -204,6 +204,32 @@ pub enum ExprKind { }, } +impl Clone for Expr { + fn clone(&self) -> Self { + psrs_span::with_sufficient_stack(|| clone_expr(self)) + } +} + +impl PartialEq for Expr { + fn eq(&self, other: &Self) -> bool { + psrs_span::with_sufficient_stack(|| expr_eq(self, other)) + } +} + +#[inline(never)] +fn clone_expr(expression: &Expr) -> Expr { + Expr { + kind: expression.kind.clone(), + ty: expression.ty, + span: expression.span, + } +} + +#[inline(never)] +fn expr_eq(left: &Expr, right: &Expr) -> bool { + left.ty == right.ty && left.span == right.span && left.kind == right.kind +} + #[derive(Clone, Debug, PartialEq, Eq)] pub struct CaseBranch { pub pattern: Pattern, diff --git a/crates/psrs-core/src/link/mod.rs b/crates/psrs-core/src/link/mod.rs index 52390e2b..999faaa2 100644 --- a/crates/psrs-core/src/link/mod.rs +++ b/crates/psrs-core/src/link/mod.rs @@ -184,6 +184,10 @@ fn shift_declaration(declaration: Declaration, offset: u32, variable_offset: u32 } fn shift_expr(expression: Expr, offset: u32, variable_offset: u32) -> Expr { + psrs_span::with_sufficient_stack(|| shift_expr_inner(expression, offset, variable_offset)) +} + +fn shift_expr_inner(expression: Expr, offset: u32, variable_offset: u32) -> Expr { Expr { kind: shift::shift_kind(expression.kind, offset, variable_offset), ty: shift_id(expression.ty, offset), @@ -354,6 +358,18 @@ fn collect_references( module: &Module, used_types: &mut HashSet, visited_types: &mut HashSet, +) { + psrs_span::with_sufficient_stack(|| { + collect_references_inner(expression, out, module, used_types, visited_types) + }) +} + +fn collect_references_inner( + expression: &Expr, + out: &mut Vec, + module: &Module, + used_types: &mut HashSet, + visited_types: &mut HashSet, ) { collect_core_type_ids(expression.ty, module, used_types, visited_types); match &expression.kind { diff --git a/crates/psrs-core/src/lower/mod.rs b/crates/psrs-core/src/lower/mod.rs index 69dd4db8..ddea5b85 100644 --- a/crates/psrs-core/src/lower/mod.rs +++ b/crates/psrs-core/src/lower/mod.rs @@ -35,6 +35,18 @@ fn lower_expr( constructors: &HashMap, source_types: &[psrs_thir::Type], context: &mut module::LowerContext, +) -> Result { + psrs_span::with_sufficient_stack(|| { + lower_expr_inner(expression, externals, constructors, source_types, context) + }) +} + +fn lower_expr_inner( + expression: TypedExpr, + externals: &HashMap, + constructors: &HashMap, + source_types: &[psrs_thir::Type], + context: &mut module::LowerContext, ) -> Result { let span = expression.span; let ty = TypeId(expression.ty.0); @@ -223,14 +235,14 @@ fn lower_expr( // A saturated intrinsic application becomes one IntrinsicCall. The // registry's arity decides saturation, and the per-intrinsic // handling lives in the intrinsic module rather than here. - if let Some((symbol, args)) = flatten_intrinsic(&function, argument.clone(), externals) - && let Some(ExternalKind::Intrinsic(intrinsic)) = externals.get(&symbol) - && args.len() == intrinsic.descriptor().arity as usize - { + // The right argument is already the lowered remainder of the spine. + // Move that spine into the intrinsic call; cloning it recurses while + // these lowering frames are still live. + if let Some(intrinsic) = saturated_intrinsic(&function, externals) { return Ok(Expr { kind: ExprKind::IntrinsicCall { - intrinsic: *intrinsic, - arguments: args, + intrinsic, + arguments: unfold_application(function, argument), }, ty, span, @@ -436,23 +448,36 @@ fn constructor_application<'a>( }) } -fn flatten_intrinsic( +fn saturated_intrinsic( function: &Expr, - final_argument: Expr, externals: &HashMap, -) -> Option<(SymbolId, Vec)> { - let mut arguments = vec![final_argument]; +) -> Option { + let mut count = 1usize; let mut head = function; - while let ExprKind::Application(next, argument) = &head.kind { - arguments.push((**argument).clone()); + while let ExprKind::Application(next, _) = &head.kind { + count += 1; head = next; } let ExprKind::Global(symbol) = head.kind else { return None; }; - if !matches!(externals.get(&symbol), Some(ExternalKind::Intrinsic(_))) { - return None; + match externals.get(&symbol) { + Some(ExternalKind::Intrinsic(intrinsic)) + if count == intrinsic.descriptor().arity as usize => + { + Some(*intrinsic) + } + _ => None, + } +} + +fn unfold_application(function: Expr, final_argument: Expr) -> Vec { + let mut arguments = vec![final_argument]; + let mut head = function; + while let ExprKind::Application(next, argument) = head.kind { + arguments.push(*argument); + head = *next; } arguments.reverse(); - Some((symbol, arguments)) + arguments } diff --git a/crates/psrs-core/src/opt/dead.rs b/crates/psrs-core/src/opt/dead.rs index a0d0730f..22a13ff8 100644 --- a/crates/psrs-core/src/opt/dead.rs +++ b/crates/psrs-core/src/opt/dead.rs @@ -11,7 +11,11 @@ pub(super) fn run(mut module: Module) -> Module { module } -fn eliminate_expr(mut expression: Expr) -> Expr { +fn eliminate_expr(expression: Expr) -> Expr { + psrs_span::with_sufficient_stack(|| eliminate_expr_inner(expression)) +} + +fn eliminate_expr_inner(mut expression: Expr) -> Expr { expression.kind = match expression.kind { ExprKind::Constructor { symbol, arguments } => ExprKind::Constructor { symbol, @@ -160,6 +164,10 @@ fn live_bindings(bindings: &[Binding], body: &Expr) -> Vec { } fn collect_refs(expression: &Expr, references: &mut HashSet) { + psrs_span::with_sufficient_stack(|| collect_refs_inner(expression, references)) +} + +fn collect_refs_inner(expression: &Expr, references: &mut HashSet) { match &expression.kind { ExprKind::Local(id) => { references.insert(*id); diff --git a/crates/psrs-core/src/opt/effects.rs b/crates/psrs-core/src/opt/effects.rs index 5b7fe219..7abd8a24 100644 --- a/crates/psrs-core/src/opt/effects.rs +++ b/crates/psrs-core/src/opt/effects.rs @@ -22,6 +22,10 @@ impl Effects { } pub(super) fn summarize(expression: &Expr) -> Effects { + psrs_span::with_sufficient_stack(|| summarize_inner(expression)) +} + +fn summarize_inner(expression: &Expr) -> Effects { match &expression.kind { ExprKind::Local(_) | ExprKind::Integer(_) diff --git a/crates/psrs-core/src/opt/inline/global/analysis.rs b/crates/psrs-core/src/opt/inline/global/analysis.rs index 055c7509..2ec48a3c 100644 --- a/crates/psrs-core/src/opt/inline/global/analysis.rs +++ b/crates/psrs-core/src/opt/inline/global/analysis.rs @@ -43,6 +43,10 @@ pub(in crate::opt::inline) fn expr_introduces_type_binders( expression: &Expr, types: &[Type], ) -> bool { + psrs_span::with_sufficient_stack(|| expr_introduces_type_binders_inner(expression, types)) +} + +fn expr_introduces_type_binders_inner(expression: &Expr, types: &[Type]) -> bool { if type_has_forall(expression.ty, types, &mut HashSet::new()) { return true; } @@ -158,6 +162,10 @@ pub(super) fn is_recursive(root: SymbolId, graph: &HashMap bool { + psrs_span::with_sufficient_stack(|| contains_case_inner(expression)) +} + +fn contains_case_inner(expression: &Expr) -> bool { match &expression.kind { ExprKind::Case { .. } => true, ExprKind::Constructor { arguments, .. } @@ -195,6 +203,10 @@ pub(super) fn contains_case(expression: &Expr) -> bool { } pub(super) fn collect_globals(expression: &Expr, out: &mut Vec) { + psrs_span::with_sufficient_stack(|| collect_globals_inner(expression, out)) +} + +fn collect_globals_inner(expression: &Expr, out: &mut Vec) { match &expression.kind { ExprKind::Global(symbol) => out.push(*symbol), ExprKind::Constructor { arguments, .. } diff --git a/crates/psrs-core/src/opt/inline/global/mod.rs b/crates/psrs-core/src/opt/inline/global/mod.rs index f4040259..1cde4dac 100644 --- a/crates/psrs-core/src/opt/inline/global/mod.rs +++ b/crates/psrs-core/src/opt/inline/global/mod.rs @@ -53,6 +53,29 @@ pub(super) fn run(mut module: Module, max_body_nodes: usize, sites_left: &mut us #[allow(clippy::too_many_arguments)] fn inline_expr( + expression: Expr, + fresh: &mut FreshLocals, + sites_left: &mut usize, + max_body_nodes: usize, + declarations: &HashMap, + recursive: &HashSet, + types: &[Type], +) -> Expr { + psrs_span::with_sufficient_stack(|| { + inline_expr_inner( + expression, + fresh, + sites_left, + max_body_nodes, + declarations, + recursive, + types, + ) + }) +} + +#[allow(clippy::too_many_arguments)] +fn inline_expr_inner( mut expression: Expr, fresh: &mut FreshLocals, sites_left: &mut usize, diff --git a/crates/psrs-core/src/opt/inline/local.rs b/crates/psrs-core/src/opt/inline/local.rs index 87a3b5cf..432ab47a 100644 --- a/crates/psrs-core/src/opt/inline/local.rs +++ b/crates/psrs-core/src/opt/inline/local.rs @@ -25,6 +25,18 @@ pub(super) fn run(mut module: Module, max_inline_nodes: usize, sites_left: &mut } fn inline_expr( + expression: Expr, + fresh: &mut FreshLocals, + sites_left: &mut usize, + max_body_nodes: usize, + types: &[Type], +) -> Expr { + psrs_span::with_sufficient_stack(|| { + inline_expr_inner(expression, fresh, sites_left, max_body_nodes, types) + }) +} + +fn inline_expr_inner( mut expression: Expr, fresh: &mut FreshLocals, sites_left: &mut usize, diff --git a/crates/psrs-core/src/opt/simplify/mod.rs b/crates/psrs-core/src/opt/simplify/mod.rs index 18d32d98..224eb9b8 100644 --- a/crates/psrs-core/src/opt/simplify/mod.rs +++ b/crates/psrs-core/src/opt/simplify/mod.rs @@ -15,7 +15,11 @@ pub(super) fn run(mut module: Module) -> Module { module } -fn simplify_expr(mut expression: Expr, fresh: &mut FreshLocals) -> Expr { +fn simplify_expr(expression: Expr, fresh: &mut FreshLocals) -> Expr { + psrs_span::with_sufficient_stack(|| simplify_expr_inner(expression, fresh)) +} + +fn simplify_expr_inner(mut expression: Expr, fresh: &mut FreshLocals) -> Expr { expression.kind = match expression.kind { ExprKind::Constructor { symbol, arguments } => ExprKind::Constructor { symbol, diff --git a/crates/psrs-core/src/opt/specialize/calls.rs b/crates/psrs-core/src/opt/specialize/calls.rs index cfb50597..f2aeb3f5 100644 --- a/crates/psrs-core/src/opt/specialize/calls.rs +++ b/crates/psrs-core/src/opt/specialize/calls.rs @@ -9,6 +9,18 @@ pub(super) fn rewrite( declarations: &HashMap, state: &mut State, pending: &mut Vec, +) -> Expr { + psrs_span::with_sufficient_stack(|| { + rewrite_inner(expression, module, declarations, state, pending) + }) +} + +fn rewrite_inner( + expression: Expr, + module: &mut Module, + declarations: &HashMap, + state: &mut State, + pending: &mut Vec, ) -> Expr { let mut expression = expression; expression.kind = match expression.kind { diff --git a/crates/psrs-core/src/opt/specialize/mod.rs b/crates/psrs-core/src/opt/specialize/mod.rs index a1976d40..dd13c7e6 100644 --- a/crates/psrs-core/src/opt/specialize/mod.rs +++ b/crates/psrs-core/src/opt/specialize/mod.rs @@ -160,6 +160,10 @@ pub(super) fn retain_live(mut module: Module, generated: &HashSet) -> } fn collect_references(expression: &crate::Expr, out: &mut Vec) { + psrs_span::with_sufficient_stack(|| collect_references_inner(expression, out)) +} + +fn collect_references_inner(expression: &crate::Expr, out: &mut Vec) { match &expression.kind { crate::ExprKind::Global(symbol) => out.push(*symbol), crate::ExprKind::Constructor { arguments, .. } diff --git a/crates/psrs-core/src/opt/util.rs b/crates/psrs-core/src/opt/util.rs index 2f752974..49432fef 100644 --- a/crates/psrs-core/src/opt/util.rs +++ b/crates/psrs-core/src/opt/util.rs @@ -4,6 +4,10 @@ use std::collections::{HashMap, HashSet}; pub(super) use crate::locals::FreshLocals; pub(super) fn count_nodes(expression: &Expr) -> usize { + psrs_span::with_sufficient_stack(|| count_nodes_inner(expression)) +} + +fn count_nodes_inner(expression: &Expr) -> usize { 1 + match &expression.kind { ExprKind::Local(_) | ExprKind::Global(_) @@ -76,6 +80,14 @@ fn substitute_inner( expression: &Expr, substitutions: &HashMap, shadowed: &mut HashSet, +) -> Expr { + psrs_span::with_sufficient_stack(|| substitute_inner_walk(expression, substitutions, shadowed)) +} + +fn substitute_inner_walk( + expression: &Expr, + substitutions: &HashMap, + shadowed: &mut HashSet, ) -> Expr { if let ExprKind::Local(id) = &expression.kind && !shadowed.contains(id) diff --git a/crates/psrs-core/src/primitive.rs b/crates/psrs-core/src/primitive.rs index 2a1040e7..7f608d28 100644 --- a/crates/psrs-core/src/primitive.rs +++ b/crates/psrs-core/src/primitive.rs @@ -69,6 +69,15 @@ fn rewrite( types: &[Type], primitives: &HashMap, fresh: &mut FreshLocals, +) -> Result<(), &'static str> { + psrs_span::with_sufficient_stack(|| rewrite_inner(expression, types, primitives, fresh)) +} + +fn rewrite_inner( + expression: &mut Expr, + types: &[Type], + primitives: &HashMap, + fresh: &mut FreshLocals, ) -> Result<(), &'static str> { match &mut expression.kind { ExprKind::Global(symbol) => { diff --git a/crates/psrs-core/src/tests/deep_expr.rs b/crates/psrs-core/src/tests/deep_expr.rs new file mode 100644 index 00000000..50371b6e --- /dev/null +++ b/crates/psrs-core/src/tests/deep_expr.rs @@ -0,0 +1,30 @@ +use super::*; + +/// Clone and equality follow a deep application spine on a heap stack. +/// Ordinary recursive destruction also fits the worker stack at this depth. +#[test] +fn deep_application_clone_equality_and_drop_stay_within_a_worker_stack() { + let mut expression = Expr { + kind: ExprKind::Boolean(true), + ty: TypeId(0), + span: TextRange::default(), + }; + for _ in 0..800 { + expression = Expr { + kind: ExprKind::Application( + Box::new(Expr { + kind: ExprKind::Boolean(false), + ty: TypeId(0), + span: TextRange::default(), + }), + Box::new(expression), + ), + ty: TypeId(0), + span: TextRange::default(), + }; + } + let cloned = expression.clone(); + assert_eq!(expression, cloned); + drop(cloned); + drop(expression); +} diff --git a/crates/psrs-core/src/tests/mod.rs b/crates/psrs-core/src/tests/mod.rs index 2c35ff5e..d7526094 100644 --- a/crates/psrs-core/src/tests/mod.rs +++ b/crates/psrs-core/src/tests/mod.rs @@ -1,6 +1,7 @@ use super::*; use psrs_hir::{Intrinsic, LocalId, ModuleId, SymbolId}; +mod deep_expr; mod effects; mod external_types; mod instantiation; diff --git a/crates/psrs-core/src/verify/expr/mod.rs b/crates/psrs-core/src/verify/expr/mod.rs index aeb2e03e..0af086dd 100644 --- a/crates/psrs-core/src/verify/expr/mod.rs +++ b/crates/psrs-core/src/verify/expr/mod.rs @@ -38,6 +38,10 @@ fn viewed<'a>(physical: &'a Module, source: Option<&'a Module>, ids: &[TypeId]) impl Context<'_> { fn expr(&mut self, expression: &Expr, expected: Option) { + psrs_span::with_sufficient_stack(|| self.expr_inner(expression, expected)) + } + + fn expr_inner(&mut self, expression: &Expr, expected: Option) { verify_type( expression.ty, self.module, diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index 04a1c19b..f9891011 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -8,6 +8,15 @@ pub(super) fn scoped_expr( module: &Module, scope: &mut HashSet, errors: &mut Vec, +) { + psrs_span::with_sufficient_stack(|| scoped_expr_inner(expression, module, scope, errors)) +} + +fn scoped_expr_inner( + expression: &Expr, + module: &Module, + scope: &mut HashSet, + errors: &mut Vec, ) { scoped_type( expression.ty, diff --git a/crates/psrs-desugar/src/expr.rs b/crates/psrs-desugar/src/expr.rs index 2a8eb98f..8f5cf830 100644 --- a/crates/psrs-desugar/src/expr.rs +++ b/crates/psrs-desugar/src/expr.rs @@ -32,6 +32,10 @@ impl Desugarer { } pub(super) fn expr(&mut self, expression: Expr) -> Expr { + psrs_span::with_sufficient_stack(|| self.expr_inner(expression)) + } + + fn expr_inner(&mut self, expression: Expr) -> Expr { let span = expression.span; let kind = match expression.kind { ExprKind::OperatorChain { .. } | ExprKind::OperatorSection { .. } => { diff --git a/crates/psrs-desugar/src/lib.rs b/crates/psrs-desugar/src/lib.rs index 687faab7..f360c904 100644 --- a/crates/psrs-desugar/src/lib.rs +++ b/crates/psrs-desugar/src/lib.rs @@ -110,6 +110,10 @@ pub fn desugar_module_with_true_symbols( } fn desugar_expr(expression: Expr) -> Expr { + psrs_span::with_sufficient_stack(|| desugar_expr_inner(expression)) +} + +fn desugar_expr_inner(expression: Expr) -> Expr { let span = expression.span; let kind = match expression.kind { ExprKind::Operator { diff --git a/crates/psrs-driver/src/tests/long_expression.rs b/crates/psrs-driver/src/tests/long_expression.rs new file mode 100644 index 00000000..4caef151 --- /dev/null +++ b/crates/psrs-driver/src/tests/long_expression.rs @@ -0,0 +1,37 @@ +use super::*; + +/// Official `purs` accepts this right-nested `infixr` chain. The expression +/// walks have to follow the spine on a heap stack; a native stack proportional +/// to the chain length aborts the compiler. +#[test] +fn long_boolean_conjunction_chain_returns_42() { + let chain = std::iter::repeat_n("true", 448) + .collect::>() + .join(" && "); + let source = format!("module Main where\nimport Prelude\nmain = if {chain} then 42 else 1\n"); + let Some(output) = run_with_wasmtime(&source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty(), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn long_right_associative_subtraction_preserves_grouping() { + let chain = std::iter::repeat_n("1", 448) + .collect::>() + .join(" <-> "); + let source = format!( + "module Main where\nimport Prelude\ninfixr 6 difference as <->\n\ + difference x y = x - y\nmain = if ({chain}) == 0 then 42 else 1\n" + ); + let Some(output) = run_with_wasmtime(&source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty(), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index d0aa52df..3d6d541d 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -143,6 +143,7 @@ mod backend; mod declarations; mod integration; mod kinds; +mod long_expression; mod resolution; mod typecheck; mod wasi; diff --git a/crates/psrs-hir/src/expr.rs b/crates/psrs-hir/src/expr.rs index e9191ada..dd11f667 100644 --- a/crates/psrs-hir/src/expr.rs +++ b/crates/psrs-hir/src/expr.rs @@ -25,7 +25,7 @@ pub struct LocalBinding { pub span: TextRange, } -#[derive(Clone, Debug, PartialEq, Eq)] +#[derive(Debug, Eq)] pub struct Expr { pub kind: ExprKind, pub span: TextRange, @@ -112,6 +112,31 @@ pub enum ExprKind { Guarded(Vec), } +impl Clone for Expr { + fn clone(&self) -> Self { + psrs_span::with_sufficient_stack(|| clone_expr(self)) + } +} + +impl PartialEq for Expr { + fn eq(&self, other: &Self) -> bool { + psrs_span::with_sufficient_stack(|| expr_eq(self, other)) + } +} + +#[inline(never)] +fn clone_expr(expression: &Expr) -> Expr { + Expr { + kind: expression.kind.clone(), + span: expression.span, + } +} + +#[inline(never)] +fn expr_eq(left: &Expr, right: &Expr) -> bool { + left.span == right.span && left.kind == right.kind +} + #[derive(Clone, Debug, PartialEq, Eq)] pub struct ResolvedOperator { pub symbol: SymbolId, diff --git a/crates/psrs-hir/src/tests.rs b/crates/psrs-hir/src/tests.rs index ab567c13..98a6f5c8 100644 --- a/crates/psrs-hir/src/tests.rs +++ b/crates/psrs-hir/src/tests.rs @@ -1,5 +1,31 @@ use super::*; +/// Clone and equality follow a deep application spine on a heap stack. +/// Ordinary recursive destruction also fits the worker stack at this depth. +#[test] +fn deep_application_clone_equality_and_drop_stay_within_a_worker_stack() { + let mut expression = Expr { + kind: ExprKind::Char('t'), + span: TextRange::default(), + }; + for _ in 0..800 { + expression = Expr { + kind: ExprKind::Application( + Box::new(Expr { + kind: ExprKind::Char('f'), + span: TextRange::default(), + }), + Box::new(expression), + ), + span: TextRange::default(), + }; + } + let cloned = expression.clone(); + assert_eq!(expression, cloned); + drop(cloned); + drop(expression); +} + fn class_type(module: ModuleId, index: u32) -> TypeDeclaration { TypeDeclaration { id: TypeId::new(module, index), diff --git a/crates/psrs-hir/src/verify/mod.rs b/crates/psrs-hir/src/verify/mod.rs index 1e5a5f7a..b917c2c3 100644 --- a/crates/psrs-hir/src/verify/mod.rs +++ b/crates/psrs-hir/src/verify/mod.rs @@ -17,6 +17,18 @@ pub(crate) fn verify_expr( visible_locals: &mut HashSet, declared_locals: &mut HashSet, errors: &mut Vec, +) { + psrs_span::with_sufficient_stack(|| { + verify_expr_inner(expression, globals, visible_locals, declared_locals, errors) + }) +} + +fn verify_expr_inner( + expression: &Expr, + globals: &HashSet, + visible_locals: &mut HashSet, + declared_locals: &mut HashSet, + errors: &mut Vec, ) { match &expression.kind { ExprKind::Local(id) if !visible_locals.contains(id) => errors.push(VerifyError { diff --git a/crates/psrs-hir/src/verify/normalized.rs b/crates/psrs-hir/src/verify/normalized.rs index 65bb9604..18dcc228 100644 --- a/crates/psrs-hir/src/verify/normalized.rs +++ b/crates/psrs-hir/src/verify/normalized.rs @@ -19,6 +19,10 @@ pub(crate) fn normalized(module: &crate::Module) -> Result<(), Vec> } fn check_normalized_expr(expression: &Expr, errors: &mut Vec) { + psrs_span::with_sufficient_stack(|| check_normalized_expr_inner(expression, errors)) +} + +fn check_normalized_expr_inner(expression: &Expr, errors: &mut Vec) { match &expression.kind { ExprKind::Guarded(clauses) => { errors.push(VerifyError { diff --git a/crates/psrs-kind/src/check/infer/pattern_annotations.rs b/crates/psrs-kind/src/check/infer/pattern_annotations.rs index 3b6ad5a7..aefc54d9 100644 --- a/crates/psrs-kind/src/check/infer/pattern_annotations.rs +++ b/crates/psrs-kind/src/check/infer/pattern_annotations.rs @@ -19,6 +19,10 @@ impl Checker<'_> { } fn check_expression_annotations(&mut self, expression: &psrs_hir::Expr) { + psrs_span::with_sufficient_stack(|| self.check_expression_annotations_inner(expression)) + } + + fn check_expression_annotations_inner(&mut self, expression: &psrs_hir::Expr) { use psrs_hir::ExprKind; match &expression.kind { ExprKind::Typed { expression, ty } | ExprKind::TypeApplication { expression, ty } => { diff --git a/crates/psrs-resolve/src/resolver/names/mod.rs b/crates/psrs-resolve/src/resolver/names/mod.rs index b6b5d53b..6170e63f 100644 --- a/crates/psrs-resolve/src/resolver/names/mod.rs +++ b/crates/psrs-resolve/src/resolver/names/mod.rs @@ -149,6 +149,10 @@ impl Resolver { } pub(super) fn resolve_expr(&mut self, expression: ast::Expr) -> Option { + psrs_span::with_sufficient_stack(|| self.resolve_expr_inner(expression)) + } + + fn resolve_expr_inner(&mut self, expression: ast::Expr) -> Option { let span = expression.span; let kind = match expression.kind { AstExprKind::Name(name) => { diff --git a/crates/psrs-span/Cargo.toml b/crates/psrs-span/Cargo.toml index 407dafba..02ce342f 100644 --- a/crates/psrs-span/Cargo.toml +++ b/crates/psrs-span/Cargo.toml @@ -5,3 +5,4 @@ edition.workspace = true license.workspace = true [dependencies] +stacker.workspace = true diff --git a/crates/psrs-span/src/lib.rs b/crates/psrs-span/src/lib.rs index 9ccb8717..6ebd852d 100644 --- a/crates/psrs-span/src/lib.rs +++ b/crates/psrs-span/src/lib.rs @@ -91,6 +91,19 @@ impl SourceFile { } } +/// Runs `work` where a nested expression spine cannot exhaust the native stack. +/// +/// Fixity resolution rebuilds a flat operator chain as a nested application or +/// operator spine. Walks, clones, and equality of that spine follow the source +/// length. Each recursive entry checks the remaining stack and continues on a +/// fresh heap segment before the platform stack is exhausted. The red zone +/// covers one walker frame and the unguarded callees that run before the next +/// entry. +#[inline(never)] +pub fn with_sufficient_stack(work: impl FnOnce() -> R) -> R { + stacker::maybe_grow(256 * 1024, 8 * 1024 * 1024, work) +} + impl fmt::Display for TextRange { fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { write!(f, "{}..{}", self.start, self.end) @@ -101,6 +114,25 @@ impl fmt::Display for TextRange { mod tests { use super::*; + #[test] + fn deep_expression_walk_grows_onto_a_heap_stack() { + fn descend(depth: usize) -> usize { + with_sufficient_stack(|| { + let padding = std::hint::black_box([depth as u8; 24 * 1024]); + let here = usize::from(padding[depth % padding.len()]); + if depth == 0 { + here + } else { + here + descend(depth - 1) + } + }) + } + + let depth = 300; + let expected = (0..=depth).map(|value| value % 256).sum(); + assert_eq!(descend(depth), expected); + } + #[test] fn maps_byte_offsets_to_unicode_columns() { let source = SourceFile::new("test", "α\nxyz"); diff --git a/crates/psrs-thir/src/lib.rs b/crates/psrs-thir/src/lib.rs index 91e12866..ab5add63 100644 --- a/crates/psrs-thir/src/lib.rs +++ b/crates/psrs-thir/src/lib.rs @@ -250,7 +250,7 @@ pub struct Binding { pub span: TextRange, } -#[derive(Clone, Debug, PartialEq, Eq)] +#[derive(Debug, Eq)] pub struct Expr { pub kind: ExprKind, pub ty: TypeId, @@ -318,6 +318,32 @@ pub enum ExprKind { }, } +impl Clone for Expr { + fn clone(&self) -> Self { + psrs_span::with_sufficient_stack(|| clone_expr(self)) + } +} + +impl PartialEq for Expr { + fn eq(&self, other: &Self) -> bool { + psrs_span::with_sufficient_stack(|| expr_eq(self, other)) + } +} + +#[inline(never)] +fn clone_expr(expression: &Expr) -> Expr { + Expr { + kind: expression.kind.clone(), + ty: expression.ty, + span: expression.span, + } +} + +#[inline(never)] +fn expr_eq(left: &Expr, right: &Expr) -> bool { + left.ty == right.ty && left.span == right.span && left.kind == right.kind +} + #[derive(Clone, Debug, PartialEq, Eq)] pub struct CaseBranch { pub pattern: Pattern, diff --git a/crates/psrs-thir/src/scope/expr.rs b/crates/psrs-thir/src/scope/expr.rs new file mode 100644 index 00000000..d52b6d45 --- /dev/null +++ b/crates/psrs-thir/src/scope/expr.rs @@ -0,0 +1,195 @@ +use super::{ + enter_binders, leading_foralls, open_child_binders, open_expression_binders, + verify_evidence_scope, verify_pattern_scope, verify_type_scope, +}; +use crate::{Expr, ExprKind, Type, VerifyError}; +use psrs_hir::TypeVariableId; +use std::collections::HashSet; + +pub(super) fn verify_expr_scope( + expression: &Expr, + types: &[Type], + scope: &mut HashSet, + errors: &mut Vec, +) { + psrs_span::with_sufficient_stack(|| verify_expr_scope_inner(expression, types, scope, errors)) +} + +fn verify_expr_scope_inner( + expression: &Expr, + types: &[Type], + scope: &mut HashSet, + errors: &mut Vec, +) { + verify_type_scope( + expression.ty, + types, + scope, + expression.span, + &mut HashSet::new(), + errors, + ); + match &expression.kind { + ExprKind::Local(_) + | ExprKind::Global(_) + | ExprKind::Integer(_) + | ExprKind::Number(_) + | ExprKind::Boolean(_) + | ExprKind::String(_) + | ExprKind::Char(_) => {} + ExprKind::Array(elements) => { + let binders = leading_foralls(types, expression.ty); + for element in elements { + let mut element_scope = scope.clone(); + open_child_binders(element, &binders, types, &mut element_scope, errors); + verify_expr_scope(element, types, &mut element_scope, errors); + } + } + ExprKind::Record(fields) => { + let field_types = crate::record_fields(types, expression.ty).unwrap_or_default(); + for (label, value) in fields { + let binders = field_types + .iter() + .find(|(field_label, _)| field_label == label) + .map(|(_, ty)| leading_foralls(types, *ty)) + .unwrap_or_default(); + let mut field_scope = scope.clone(); + open_child_binders(value, &binders, types, &mut field_scope, errors); + verify_expr_scope(value, types, &mut field_scope, errors); + } + } + ExprKind::RecordUpdate { expression, fields } => { + verify_expr_scope(expression, types, scope, errors); + for (_, value) in fields { + verify_expr_scope(value, types, scope, errors); + } + } + ExprKind::FieldAccess { + expression: record, .. + } => { + let binders = leading_foralls(types, expression.ty); + let mut record_scope = scope.clone(); + open_child_binders(record, &binders, types, &mut record_scope, errors); + verify_expr_scope(record, types, &mut record_scope, errors) + } + ExprKind::Evidence(evidence) => verify_evidence_scope(evidence, types, scope, errors), + ExprKind::Coerce { + value, + evidence, + source_type, + target_type, + } => { + verify_expr_scope(value, types, scope, errors); + verify_evidence_scope(evidence, types, scope, errors); + verify_type_scope( + *source_type, + types, + scope, + evidence.span, + &mut HashSet::new(), + errors, + ); + verify_type_scope( + *target_type, + types, + scope, + evidence.span, + &mut HashSet::new(), + errors, + ); + } + ExprKind::UnsafeCoerce { + value, + source_type, + target_type, + .. + } => { + verify_expr_scope(value, types, scope, errors); + verify_type_scope( + *source_type, + types, + scope, + expression.span, + &mut HashSet::new(), + errors, + ); + verify_type_scope( + *target_type, + types, + scope, + expression.span, + &mut HashSet::new(), + errors, + ); + } + ExprKind::Application(function, argument) => { + let binders = leading_foralls(types, expression.ty); + let mut function_scope = scope.clone(); + open_child_binders(function, &binders, types, &mut function_scope, errors); + verify_expr_scope(function, types, &mut function_scope, errors); + let mut argument_scope = scope.clone(); + open_child_binders(argument, &binders, types, &mut argument_scope, errors); + verify_expr_scope(argument, types, &mut argument_scope, errors); + } + ExprKind::Lambda { binder, body } => { + let mut body_scope = scope.clone(); + open_expression_binders(expression, types, &mut body_scope, errors); + verify_type_scope( + binder.ty, + types, + &body_scope, + binder.span, + &mut HashSet::new(), + errors, + ); + verify_expr_scope(body, types, &mut body_scope, errors); + } + ExprKind::Let { bindings, body } => { + let mut body_scope = scope.clone(); + open_expression_binders(expression, types, &mut body_scope, errors); + for binding in bindings { + let mut binding_scope = body_scope.clone(); + enter_binders( + &binding.quantified, + &mut binding_scope, + binding.span, + "binding quantifiers must be unique and lexically distinct", + errors, + ); + verify_type_scope( + binding.binder.ty, + types, + &binding_scope, + binding.binder.span, + &mut HashSet::new(), + errors, + ); + verify_expr_scope(&binding.value, types, &mut binding_scope, errors); + } + verify_expr_scope(body, types, &mut body_scope, errors); + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + verify_expr_scope(condition, types, scope, errors); + let mut branch_scope = scope.clone(); + open_expression_binders(expression, types, &mut branch_scope, errors); + verify_expr_scope(then_branch, types, &mut branch_scope, errors); + verify_expr_scope(else_branch, types, &mut branch_scope, errors); + } + ExprKind::Case { + scrutinee, + branches, + } => { + verify_expr_scope(scrutinee, types, scope, errors); + let mut branch_scope = scope.clone(); + open_expression_binders(expression, types, &mut branch_scope, errors); + for branch in branches { + verify_pattern_scope(&branch.pattern, types, &branch_scope, errors); + verify_expr_scope(&branch.value, types, &mut branch_scope, errors); + } + } + } +} diff --git a/crates/psrs-thir/src/scope/mod.rs b/crates/psrs-thir/src/scope/mod.rs index c3292bba..712bb110 100644 --- a/crates/psrs-thir/src/scope/mod.rs +++ b/crates/psrs-thir/src/scope/mod.rs @@ -1,12 +1,14 @@ use crate::{ - Evidence, EvidenceKind, Expr, ExprKind, Module, Pattern, PatternKind, Type, TypeId, VerifyError, + Evidence, EvidenceKind, Expr, Module, Pattern, PatternKind, Type, TypeId, VerifyError, }; use psrs_hir::TypeVariableId; use psrs_span::TextRange; use std::collections::HashSet; +mod expr; mod free_type_variables; mod polymorphic; +use expr::verify_expr_scope; use polymorphic::{leading_foralls, open_child_binders}; pub(super) fn verify_module(module: &Module) -> Vec { @@ -175,185 +177,6 @@ fn enter_binders( scope.extend(local); } -fn verify_expr_scope( - expression: &Expr, - types: &[Type], - scope: &mut HashSet, - errors: &mut Vec, -) { - verify_type_scope( - expression.ty, - types, - scope, - expression.span, - &mut HashSet::new(), - errors, - ); - match &expression.kind { - ExprKind::Local(_) - | ExprKind::Global(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::Boolean(_) - | ExprKind::String(_) - | ExprKind::Char(_) => {} - ExprKind::Array(elements) => { - let binders = leading_foralls(types, expression.ty); - for element in elements { - let mut element_scope = scope.clone(); - open_child_binders(element, &binders, types, &mut element_scope, errors); - verify_expr_scope(element, types, &mut element_scope, errors); - } - } - ExprKind::Record(fields) => { - let field_types = crate::record_fields(types, expression.ty).unwrap_or_default(); - for (label, value) in fields { - let binders = field_types - .iter() - .find(|(field_label, _)| field_label == label) - .map(|(_, ty)| leading_foralls(types, *ty)) - .unwrap_or_default(); - let mut field_scope = scope.clone(); - open_child_binders(value, &binders, types, &mut field_scope, errors); - verify_expr_scope(value, types, &mut field_scope, errors); - } - } - ExprKind::RecordUpdate { expression, fields } => { - verify_expr_scope(expression, types, scope, errors); - for (_, value) in fields { - verify_expr_scope(value, types, scope, errors); - } - } - ExprKind::FieldAccess { - expression: record, .. - } => { - let binders = leading_foralls(types, expression.ty); - let mut record_scope = scope.clone(); - open_child_binders(record, &binders, types, &mut record_scope, errors); - verify_expr_scope(record, types, &mut record_scope, errors) - } - ExprKind::Evidence(evidence) => verify_evidence_scope(evidence, types, scope, errors), - ExprKind::Coerce { - value, - evidence, - source_type, - target_type, - } => { - verify_expr_scope(value, types, scope, errors); - verify_evidence_scope(evidence, types, scope, errors); - verify_type_scope( - *source_type, - types, - scope, - evidence.span, - &mut HashSet::new(), - errors, - ); - verify_type_scope( - *target_type, - types, - scope, - evidence.span, - &mut HashSet::new(), - errors, - ); - } - ExprKind::UnsafeCoerce { - value, - source_type, - target_type, - .. - } => { - verify_expr_scope(value, types, scope, errors); - verify_type_scope( - *source_type, - types, - scope, - expression.span, - &mut HashSet::new(), - errors, - ); - verify_type_scope( - *target_type, - types, - scope, - expression.span, - &mut HashSet::new(), - errors, - ); - } - ExprKind::Application(function, argument) => { - let binders = leading_foralls(types, expression.ty); - let mut function_scope = scope.clone(); - open_child_binders(function, &binders, types, &mut function_scope, errors); - verify_expr_scope(function, types, &mut function_scope, errors); - let mut argument_scope = scope.clone(); - open_child_binders(argument, &binders, types, &mut argument_scope, errors); - verify_expr_scope(argument, types, &mut argument_scope, errors); - } - ExprKind::Lambda { binder, body } => { - let mut body_scope = scope.clone(); - open_expression_binders(expression, types, &mut body_scope, errors); - verify_type_scope( - binder.ty, - types, - &body_scope, - binder.span, - &mut HashSet::new(), - errors, - ); - verify_expr_scope(body, types, &mut body_scope, errors); - } - ExprKind::Let { bindings, body } => { - let mut body_scope = scope.clone(); - open_expression_binders(expression, types, &mut body_scope, errors); - for binding in bindings { - let mut binding_scope = body_scope.clone(); - enter_binders( - &binding.quantified, - &mut binding_scope, - binding.span, - "binding quantifiers must be unique and lexically distinct", - errors, - ); - verify_type_scope( - binding.binder.ty, - types, - &binding_scope, - binding.binder.span, - &mut HashSet::new(), - errors, - ); - verify_expr_scope(&binding.value, types, &mut binding_scope, errors); - } - verify_expr_scope(body, types, &mut body_scope, errors); - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - verify_expr_scope(condition, types, scope, errors); - let mut branch_scope = scope.clone(); - open_expression_binders(expression, types, &mut branch_scope, errors); - verify_expr_scope(then_branch, types, &mut branch_scope, errors); - verify_expr_scope(else_branch, types, &mut branch_scope, errors); - } - ExprKind::Case { - scrutinee, - branches, - } => { - verify_expr_scope(scrutinee, types, scope, errors); - let mut branch_scope = scope.clone(); - open_expression_binders(expression, types, &mut branch_scope, errors); - for branch in branches { - verify_pattern_scope(&branch.pattern, types, &branch_scope, errors); - verify_expr_scope(&branch.value, types, &mut branch_scope, errors); - } - } - } -} - fn open_expression_binders( expression: &Expr, types: &[Type], diff --git a/crates/psrs-thir/src/tests/deep_expr.rs b/crates/psrs-thir/src/tests/deep_expr.rs new file mode 100644 index 00000000..50371b6e --- /dev/null +++ b/crates/psrs-thir/src/tests/deep_expr.rs @@ -0,0 +1,30 @@ +use super::*; + +/// Clone and equality follow a deep application spine on a heap stack. +/// Ordinary recursive destruction also fits the worker stack at this depth. +#[test] +fn deep_application_clone_equality_and_drop_stay_within_a_worker_stack() { + let mut expression = Expr { + kind: ExprKind::Boolean(true), + ty: TypeId(0), + span: TextRange::default(), + }; + for _ in 0..800 { + expression = Expr { + kind: ExprKind::Application( + Box::new(Expr { + kind: ExprKind::Boolean(false), + ty: TypeId(0), + span: TextRange::default(), + }), + Box::new(expression), + ), + ty: TypeId(0), + span: TextRange::default(), + }; + } + let cloned = expression.clone(); + assert_eq!(expression, cloned); + drop(cloned); + drop(expression); +} diff --git a/crates/psrs-thir/src/tests/mod.rs b/crates/psrs-thir/src/tests/mod.rs index 7e026bd4..c81e25ed 100644 --- a/crates/psrs-thir/src/tests/mod.rs +++ b/crates/psrs-thir/src/tests/mod.rs @@ -455,3 +455,4 @@ fn verifier_rejects_coercion_evidence_for_a_different_boundary() { } mod constructed_dictionary; +mod deep_expr; diff --git a/crates/psrs-thir/src/verify/mod.rs b/crates/psrs-thir/src/verify/mod.rs index 8d08b9c0..c8c813ae 100644 --- a/crates/psrs-thir/src/verify/mod.rs +++ b/crates/psrs-thir/src/verify/mod.rs @@ -98,6 +98,10 @@ pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { } fn verify_expr(expression: &Expr, module: &Module, errors: &mut Vec) { + psrs_span::with_sufficient_stack(|| verify_expr_inner(expression, module, errors)) +} + +fn verify_expr_inner(expression: &Expr, module: &Module, errors: &mut Vec) { let types = &module.types; verify_type_id(expression.ty, types.len(), expression.span, errors); match &expression.kind { diff --git a/crates/psrs-thir/src/verify/semantics/mod.rs b/crates/psrs-thir/src/verify/semantics/mod.rs index 9b73e203..5ed65a91 100644 --- a/crates/psrs-thir/src/verify/semantics/mod.rs +++ b/crates/psrs-thir/src/verify/semantics/mod.rs @@ -68,6 +68,10 @@ impl Context<'_> { } fn expr(&mut self, expression: &Expr, expected: Option) { + psrs_span::with_sufficient_stack(|| self.expr_inner(expression, expected)) + } + + fn expr_inner(&mut self, expression: &Expr, expected: Option) { if let Some(expected) = expected { self.compatible(expression.ty, expected, expression.span); } diff --git a/crates/psrs-typecheck/src/typecheck/finalize.rs b/crates/psrs-typecheck/src/typecheck/finalize.rs index db4f202c..5ac1c3d8 100644 --- a/crates/psrs-typecheck/src/typecheck/finalize.rs +++ b/crates/psrs-typecheck/src/typecheck/finalize.rs @@ -6,6 +6,17 @@ impl Checker { expression: InferredExpr, interner: &mut TypeInterner, generics: &HashSet, + ) -> Option { + psrs_span::with_sufficient_stack(|| { + self.finalize_expr_inner(expression, interner, generics) + }) + } + + fn finalize_expr_inner( + &mut self, + expression: InferredExpr, + interner: &mut TypeInterner, + generics: &HashSet, ) -> Option { let mut active_generics = generics.clone(); let mut scope = self.resolve_type(expression.ty.clone()); diff --git a/crates/psrs-typecheck/src/typecheck/infer/expected.rs b/crates/psrs-typecheck/src/typecheck/infer/expected.rs index aa9fc2ef..cc0f3c11 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/expected.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/expected.rs @@ -8,6 +8,16 @@ impl Checker { &mut self, expression: &hir::Expr, expected: Option, + ) -> Option { + psrs_span::with_sufficient_stack(|| { + self.infer_expr_with_expected_inner(expression, expected) + }) + } + + fn infer_expr_with_expected_inner( + &mut self, + expression: &hir::Expr, + expected: Option, ) -> Option { let Some(expected) = expected else { return self.infer_expr(expression); diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index a15478fa..0dcf3767 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -82,6 +82,10 @@ impl Checker { } pub(super) fn infer_expr(&mut self, expression: &hir::Expr) -> Option { + psrs_span::with_sufficient_stack(|| self.infer_expr_inner(expression)) + } + + fn infer_expr_inner(&mut self, expression: &hir::Expr) -> Option { let span = expression.span; let (kind, ty) = match &expression.kind { hir::ExprKind::Local(id) => match self.scope.locals.get(id).cloned() { diff --git a/crates/psrs-typecheck/src/typecheck/order.rs b/crates/psrs-typecheck/src/typecheck/order.rs index d8217b40..89aa3296 100644 --- a/crates/psrs-typecheck/src/typecheck/order.rs +++ b/crates/psrs-typecheck/src/typecheck/order.rs @@ -49,6 +49,10 @@ pub(super) fn declaration_order(module: &hir::Module) -> Vec { } fn collect_globals(expression: &hir::Expr, out: &mut Vec) { + psrs_span::with_sufficient_stack(|| collect_globals_inner(expression, out)) +} + +fn collect_globals_inner(expression: &hir::Expr, out: &mut Vec) { match &expression.kind { hir::ExprKind::Local(_) | hir::ExprKind::Integer(_) diff --git a/docs/implementation/stdlib/deep-expression-2026-10-07/report.md b/docs/implementation/stdlib/deep-expression-2026-10-07/report.md new file mode 100644 index 00000000..8631c409 --- /dev/null +++ b/docs/implementation/stdlib/deep-expression-2026-10-07/report.md @@ -0,0 +1,73 @@ +# Deep expression traversal checkpoint + +Starting point: compiler 502930d on stdlib/vendor-core-libraries, with an +uncommitted compiler repair handed over for review. The independent library +remains pinned to c8020c00e227f256c0a365e22d5ebcbd1601607a, fingerprint +fnv1a64-v1:6d4f0e0ccbe37bc0. No library sources are changed by this topic. + +## Boundary and repair + +The ordinary Prelude expression `true && ... && true` with 448 operands was +accepted by official purs but aborted this compiler. The ungrouped String +oracle exposed recursive P5 inference frames; on a 2 MiB worker stack, a later +backtrace located Expr::clone within Core lower_expr_inner. Saturated intrinsic +lowering cloned the already lowered right remainder while ancestor frames +were still live. + +The owning contracts are P4 fixity and P6 checked intrinsic lowering in +[D-01](../../../design/D-01-frontend-and-ir-boundaries.md). Fixity and evaluation +order are preserved: operator association still determines the application +tree. Intrinsic recognition still requires a registered global head and exact +descriptor arity. The saturated path consumes the application spine and +reverses its collected arguments into source order, avoiding recursive copies. +Partial and oversaturated calls continue through ordinary application lowering. + +Expression entry points in lowering, checking, verification, optimization and +capture analysis use psrs_span::with_sufficient_stack. It checks a 256 KiB red +zone and continues on an 8 MiB heap stack segment. Recursive entries must pass +through the wrapper; checking only once at the pass root is insufficient. +HIR, THIR and Core Expr clone and equality use the same mechanism at each node. +The change introduces no Boolean/String name exception, re-association or new +runtime primitive. It does not claim arbitrary-depth safety for every tree +operation: ordinary derived destruction and Debug formatting are unchanged; +destruction is exercised at depth 800. + +## Validation + +`PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` completes with +1664 passed, 3 failed and 5 ignored. The three failures are the same previously +reproduced [baseline assertions](../compile-progress-2026-10-07/validation.json): +dictionary parameter ordering expects a pruned function name, polymorphic +Number identity expects an unused f64 value in WAT, and a constant conditional +expects a br_if after optimization. Driver-library results are 687 passed and +3 failed. All other workspace targets, including documentation tests, pass. +The full log is /private/tmp/psrs-stack-workspace-20261007.log. + +`cargo fmt --all --check`, `git diff --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. validation.json +records the commands, aggregate outcomes and the unchanged baseline failures. + +Runtime evidence for the original ungrouped String +fixture is in string-run.json; all 448 projected FFI value checks execute under +Wasmtime 49.0.2 and return 42 with empty stdout/stderr. This extends the grouped +String checkpoint without changing its scalar-indexing oracle or source +fidelity claim. + +The additional right-associative subtraction test uses 448 operands: its +expected result is 0; left association would produce -446. Official purs +accepts the same source; subtraction-run.json records Wasmtime execution. +Both new driver tests pass within the full required-runtime workspace run. +HIR, THIR and Core tests exercise cloning, equality +and destruction of an 800-node application spine, and psrs-span directly +exercises stack growth with large recursive frames. + +The 211-module import fixture passes in 114081 ms with a 240-second timeout, +zero exclusions, crashes or timeouts. import-summary.json records the compiler, +input and library fingerprints and captured pass/validation records. An unused integer +entry point establishes import compilation only, not execution of every +declaration or full standard-library runtime closure. + +Fresh follow-up probes reach explicit P8 missing-binding diagnostics for +Data.Int.fromStringAsImpl and Data.String.CodeUnits._charAt. Those target-library +implementation boundaries remain open; this compiler repair does not replace +them with successful-looking placeholders. diff --git a/docs/implementation/stdlib/string-slicing-2026-10-07/report.md b/docs/implementation/stdlib/string-slicing-2026-10-07/report.md index a262610b..7d4fbc7d 100644 --- a/docs/implementation/stdlib/string-slicing-2026-10-07/report.md +++ b/docs/implementation/stdlib/string-slicing-2026-10-07/report.md @@ -2,7 +2,7 @@ The compiler prerequisite topics are committed as 138da4e (canonical qualified scopes), cdeefed (guard continuations and Bounded pin), and 4aa5b51 (recursive -product coverage). This follow-up changes no Rust compiler mechanism. +product coverage). The String library slice changes no Rust compiler mechanism. The independent library pin is c8020c00e227f256c0a365e22d5ebcbd1601607a, content fingerprint fnv1a64-v1:6d4f0e0ccbe37bc0. Data.String.CodeUnits keeps @@ -42,17 +42,14 @@ Validation: were not repeated. That checkpoint still records three independently reproduced driver-library baseline failures. -A separate finite-expression resource limit remains open. An ordinary module -with Prelude and `main = if true && ... && true then 42 else 1` (448 operands) -compiles with official purs but aborts our compiler with stack overflow even -against the preceding Bounded-only package. A native backtrace on the ungrouped -String oracle locates repeated P5 infer_application / infer_expr_with_expected -frames. The oracle groups its checks into helpers of at most 24 observations; -this fixture organization validates all 448 values and does not repair the -compiler traversal limit. The next compiler follow-up must address the common -expression traversal rather than specialize on String or Boolean names. +The finite-expression stack overflow recorded for this checkpoint is repaired +by the [compiler follow-up](../deep-expression-2026-10-07/report.md). +The original ungrouped 448-observation String fixture now compiles and returns +42 with empty stdout/stderr under the same library fingerprint. The library +generator retains its grouped fixture; no library source or oracle result was +changed to accommodate the compiler repair. Character indexing, predicate traversal, searching and other String slots remain explicitly unsupported. This slice does not claim full String or -stdlib API/runtime closure, and the full 211-import reproducer was not -remeasured after this library change. +stdlib API/runtime closure. The later compiler follow-up separately remeasures +the full 211-import reproducer under this library pin. From cd32f399e646e2dfff18bcdcec185d3061074aca Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 16:22:59 +0800 Subject: [PATCH 063/148] Pin scalar String character indexing and conversion Consume the independent library charAt and toChar implementation with unchanged official wrappers and rank-N signatures. Record scalar UTF-8 decoding, projected pinned-FFI observations, ordinary builder behavior and locked Wasmtime execution. Validation: 269 public observations plus six helper checks return 42; all 448 slicing checks also pass. Node tests 9, loader checks and mandatory String driver regressions pass. Rust source is unchanged; full workspace and clippy are not repeated for this library slice. --- .../DEC-16-scalar-strings-and-utf8-storage.md | 12 +++- .../string-characters-2026-10-07/report.md | 60 +++++++++++++++++++ docs/workflow/stdlib-conformance.md | 17 ++++++ stdlib.lock.json | 4 +- 4 files changed, 88 insertions(+), 5 deletions(-) create mode 100644 docs/implementation/stdlib/string-characters-2026-10-07/report.md diff --git a/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md b/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md index 854f2083..087174bc 100644 --- a/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md +++ b/docs/decision/DEC-16-scalar-strings-and-utf8-storage.md @@ -146,8 +146,14 @@ library. The library scans validated canonical UTF-8 and maps scalar indices to byte boundaries before copying a range through PSRS.Array.sliceImpl. The 448-case pinned-FFI projection oracle makes the intentional scalar/UTF-16 difference explicit; see the [acceptance checkpoint](../implementation/stdlib/string-slicing-2026-10-07/report.md). -Other foreign slots, including character indexing and predicate traversal, -remain unsupported. This does not establish the full String API. +Scalar charAt and toChar now also execute through typed foreign-slot delegates. +The private library decoder reconstructs one scalar from validated canonical +UTF-8 before using the existing Int-to-Char identity primitive. The original +rank-N constructors and public pure wrappers are preserved. Their 269 projected +FFI observations and 6 builder checks are recorded in the +[character checkpoint](../implementation/stdlib/string-characters-2026-10-07/report.md). +Other foreign slots, including unsafe character indexing and predicate +traversal, remain unsupported. This does not establish the full String API. This record is the semantic authority. The design documents state the contract, including @@ -158,4 +164,4 @@ including [rows and records](../design/frontend/type-system/rows-and-records.md), [classes and evidence](../design/frontend/type-system/classes-and-evidence.md), [module resolution](../design/frontend/semantics/modules-and-resolution.md), -and [frontend and IR boundaries](../design/D-01-frontend-and-ir-boundaries.md). \ No newline at end of file +and [frontend and IR boundaries](../design/D-01-frontend-and-ir-boundaries.md). diff --git a/docs/implementation/stdlib/string-characters-2026-10-07/report.md b/docs/implementation/stdlib/string-characters-2026-10-07/report.md new file mode 100644 index 00000000..936641c4 --- /dev/null +++ b/docs/implementation/stdlib/string-characters-2026-10-07/report.md @@ -0,0 +1,60 @@ +# Scalar String character checkpoint + +Starting compiler: fafda68, with a clean worktree. The independent library moves +from c8020c00e227f256c0a365e22d5ebcbd1601607a to +d6ab1527e1711eb3c712f5d7bc70e5079bb8eaee, content fingerprint +fnv1a64-v1:17383a9270e6c69e. This compiler commit updates its lock, the DEC-16 +implementation status and the conformance workflow; no Rust source changes. + +## Owner and source fidelity + +Data.String.CodeUnits.charAt and toChar retain their official pure wrappers, +exports and rank-N constructor signatures. The _charAt and _toChar foreign +slots delegate to PSRS.String.charAtImpl and toCharImpl. The library owns scalar +position traversal and private canonical UTF-8 decoding over existing checked +primitives. At each decoder call, the validated String producer and scalar +boundary scan establish bounds and prove a scalar result before intToChar's +identity representation conversion. No compiler name exception or new primitive +is added. + +The shared library source verifier compares the entire module against the +clean pinned purescript-strings v6.0.1 source at +3d3e2f7197d4f7aacb15e854ee9a645489555fff, permitting exactly the seven foreign +delegates and their target import. All official pure declarations are preserved. +The source audit covers 225 modules in 41 packages: 171 identical, 35 modified, +19 target additions, zero missing upstream modules and zero direct recursive +foreign placeholders. Aggregate audit categories do not approve source changes; +the exact transformation and DEC-16 behavior evidence govern these two slots. + +## Verification + +- 269 public charAt/toChar observations execute the pinned official FFI on a + one-BMP-unit-per-scalar projection, then map Maybe results back to the original + scalar. Raw JS observations are retained separately, including surrogate + halves and raw _toChar rejection of supplementary text. This explicitly + follows DEC-16 and does not claim raw-JS equality on supplementary strings. +- 6 target-helper checks exercise local rank-N builders, including builders + that discard successful values. The generated 275-term conjunction compiles + and returns 42 under Wasmtime 49.0.2 with empty stdout/stderr. The final direct + build unsets PSRS_STDLIB_ROOT and consumes stdlib.lock.json; run.json records + the lock, input/compiler/Wasm digests and actual runtime result. +- The preceding 448 length/slicing observations also return 42 against the same + package fingerprint. The library retains all observation data and both runtime + reports under docs/evidence/string-characters/. +- Node tooling: 9 passed, no skips. Both development-root and normal locked-root + trusted-order loader tests pass; Prelude remains first. Mandatory Wasmtime + String driver regressions: 16 passed. +- The same minimal supplementary-charAt probe changes from explicit P8 missing + _charAt support to compilation success (4820 ms) through the locked loader. + diagnosis.json records both snapshots. The library fingerprints differ, so + these are not presented as a compatible diagnose --compare result. +- Formatting and diff checks pass. Full workspace/clippy were not repeated for + this library-only slice. The preceding compiler checkpoint records 1664 pass, + 3 independently established baseline failures and 5 ignored tests, with strict + clippy passing; those results do not claim full verification of the new pin. + +The 211-import fixture is not remeasured for this library pin. Unsafe character +indexing, character arrays, predicate traversal, searching and other foreign +slots are outside this checkpoint. A fresh Int.fromString probe still reaches +the explicit P8 missing Data.Int.fromStringAsImpl implementation. This slice +does not establish full String or standard-library API/runtime acceptance. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index e2f8d9b2..fae3e7f0 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -136,3 +136,20 @@ back to original text; raw UTF-16 observations are recorded separately. Negative-relative/clamping policies remain official, while DEC-16 intentionally changes index units. This is a projected oracle, not raw-JS equality on supplementary characters. Case engines and evidence live in the library package. + +For scalar character indexing and single-character conversion: + +```sh +node ../psrs-stdlib/conformance/string-characters.mjs \ + /private/tmp/ps-pkgs/purescript-strings /tmp/psrs-character-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-character-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-character-runtime +``` + +The shared String source verifier checks all seven typed foreign-slot delegates. +The character engine records 269 pinned-FFI projection observations separately +from 6 target-helper rank-N builder checks. Supplementary scalars intentionally +differ from raw JS code units under DEC-16; raw official results remain in the +observations. Public charAt and toChar wrappers execute unchanged. diff --git a/stdlib.lock.json b/stdlib.lock.json index 16680a2f..76e1f59b 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "c8020c00e227f256c0a365e22d5ebcbd1601607a", - "source_fingerprint": "fnv1a64-v1:6d4f0e0ccbe37bc0" + "revision": "d6ab1527e1711eb3c712f5d7bc70e5079bb8eaee", + "source_fingerprint": "fnv1a64-v1:17383a9270e6c69e" } From 366a10880ae4d4e898975a81ab497a9098d520a1 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 16:48:07 +0800 Subject: [PATCH 064/148] Pin strict Int parsing and corrected quotient ownership --- .../stdlib/int-parsing-2026-10-07/report.md | 67 +++++++++++++++++++ docs/workflow/stdlib-conformance.md | 26 +++++++ stdlib.lock.json | 4 +- 3 files changed, 95 insertions(+), 2 deletions(-) create mode 100644 docs/implementation/stdlib/int-parsing-2026-10-07/report.md diff --git a/docs/implementation/stdlib/int-parsing-2026-10-07/report.md b/docs/implementation/stdlib/int-parsing-2026-10-07/report.md new file mode 100644 index 00000000..18a07a2f --- /dev/null +++ b/docs/implementation/stdlib/int-parsing-2026-10-07/report.md @@ -0,0 +1,67 @@ +# Int parsing checkpoint + +Starting compiler: 559695c. The library moves from +d6ab1527e1711eb3c712f5d7bc70e5079bb8eaee to +1ad9a1a9fba01f35c694d877fd4890f8d2e46cb9, with fingerprint fnv1a64-v1:f728b54c2aadd888. This compiler +commit updates its package lock and acceptance evidence; no Rust source changes. + +## Owner and source fidelity + +Data.Int's private fromStringAsImpl slot delegates to PSRS.Int.Parse. Data.Int +owns unwrapping its opaque Radix. Official exports, pure public wrappers, +instances and rank-N constructor signatures remain unchanged. The library +verifies the entire module against the clean purescript-integers v6.0.0 checkout +at 54d712b25c594833083d15dc9ff2418eb9c52822, allowing exactly this delegate +and the previous toNumber native binding. + +The target library implements strict ASCII digit grammar over UTF-8 bytes. +A nonpositive accumulator supports MIN without wrapping; checks before multiply +and subtract reject overflow. The threshold uses truncating intQuot, rather +than the compiler's floor intDiv operation. There is no new intrinsic or +compiler exception for library names. + +The same quotient-owner error existed in PSRS.Int: its Euclidean sign adjustment +was applied to an already rounded intDiv result. The old pinned library's public +`div (-7) 3 == -3` fixture compiled but returned 1. The helper now binds intQuot +and retains its existing raw remainder, zero handling and single library-owned +Euclidean correction. Backend primitive semantics are unchanged. + +## Verification + +- 836 pinned official parsing FFI observations cover all bases 2 through 36, + both i32 boundaries and adjacent rejection, signs, leading zeros, upper/lower + ASCII letters, invalid digits, prefix-looking input, whitespace, non-ASCII, + embedded NUL and long overflow strings. Public fromString/fromStringAs and + named radix constants execute. Six public radix-factory checks and four local + rank-N builder checks are recorded separately: 846 checks in total. +- 209 public degree/div/mod observations agree with pinned Prelude FFI for + representable i32 results, including zero divisors, negative divisors and + boundary values. MIN / -1 is recorded as an unrepresentable JS result; + target signed division still traps, so this is not a raw-JS equality claim + for that input. +- Both generated programs return 42 with empty stdout and stderr. Development + reports show the package unchanged during each run. run.json additionally + records direct builds through stdlib.lock.json with PSRS_STDLIB_ROOT unset, + compiler/input/Wasm digests and actual Wasmtime output. +- Node tooling: 10 passed, zero skips. Mandatory Wasmtime driver scalar tests: + 16 passed. Development-root and normal locked trusted-order loader tests: + one passed each; Prelude remains first. +- Source audit: 226 modules, 41 packages; 171 identical, 35 modified, 20 target + additions, zero missing upstream modules and zero direct recursive foreign + placeholders. These aggregate counts do not approve other source differences. +- The same minimal public Int.fromString probe changes from explicit P8 missing + fromStringAsImpl support to Passed through the locked package. diagnosis.json + retains both snapshots; differing fingerprints preclude a compatible + diagnose --compare claim. +- Formatting and diff checks pass. Full workspace/clippy were not repeated for + this library-only slice. The preceding compiler checkpoint recorded 1664 pass, + 3 established baseline assertion failures and 5 ignored tests, with strict + clippy passing. Those results do not establish full verification of this pin. + +No full import cohort or suite scoreboard is remeasured. This checkpoint does +not establish full Data.Int or standard-library support. Formatting integers +and other remaining foreign slots are outside its scope. + +A fresh public `Int.toStringAs Int.hexadecimal 42` probe reaches P8 library +linking with explicit missing Data.Int.toStringAs support. next-blocker.json +records the new pinned package and this continuation point. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index fae3e7f0..1f51189d 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -153,3 +153,29 @@ The character engine records 269 pinned-FFI projection observations separately from 6 target-helper rank-N builder checks. Supplementary scalars intentionally differ from raw JS code units under DEC-16; raw official results remain in the observations. Public charAt and toChar wrappers execute unchanged. + +For strict public integer parsing and Euclidean arithmetic: + +```sh +node ../psrs-stdlib/conformance/int-parsing.mjs \ + /private/tmp/ps-pkgs/purescript-integers /tmp/psrs-int-parsing-oracle +node ../psrs-stdlib/conformance/int-arithmetic.mjs \ + /private/tmp/purescript-prelude /tmp/psrs-int-arithmetic-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-int-parsing-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-int-parsing-runtime +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-int-arithmetic-oracle/Main.purs \ + --expected-exit 42 --out /tmp/psrs-int-arithmetic-runtime +``` + +The parsing engine verifies the entire pinned Data.Int source, permitting only +its two typed foreign-slot adaptations. It records 836 actual official FFI +observations separately from 6 public Radix rejections and 4 target rank-N builder +checks. The arithmetic engine records 209 representable public degree/div/mod +observations. MIN / -1 produces an unrepresentable JS quotient and remains a +Wasm division trap; that observation is recorded separately from value agreement. +Both algorithms use raw truncating intQuot; the target library owns grammar, +overflow rejection and Euclidean sign correction. diff --git a/stdlib.lock.json b/stdlib.lock.json index 76e1f59b..04920ffe 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "d6ab1527e1711eb3c712f5d7bc70e5079bb8eaee", - "source_fingerprint": "fnv1a64-v1:17383a9270e6c69e" + "revision": "1ad9a1a9fba01f35c694d877fd4890f8d2e46cb9", + "source_fingerprint": "fnv1a64-v1:f728b54c2aadd888" } From 5b72ee600195ddb384850d8cbe98dbcace43969c Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 16:54:16 +0800 Subject: [PATCH 065/148] Pin radix Int formatting and shared decimal conversion --- .../int-formatting-2026-10-07/report.md | 65 +++++++++++++++++++ docs/workflow/stdlib-conformance.md | 18 +++++ stdlib.lock.json | 4 +- 3 files changed, 85 insertions(+), 2 deletions(-) create mode 100644 docs/implementation/stdlib/int-formatting-2026-10-07/report.md diff --git a/docs/implementation/stdlib/int-formatting-2026-10-07/report.md b/docs/implementation/stdlib/int-formatting-2026-10-07/report.md new file mode 100644 index 00000000..e7b2bfbf --- /dev/null +++ b/docs/implementation/stdlib/int-formatting-2026-10-07/report.md @@ -0,0 +1,65 @@ +# Int formatting checkpoint + +Starting compiler: dab23d7, with a clean worktree. The independent library moves +from 1ad9a1a9fba01f35c694d877fd4890f8d2e46cb9 to 02929696a90db4a8277151aab9a8c0a9978f8aa3, +content fingerprint fnv1a64-v1:83cdad11334226e0. This compiler commit changes +its lock and conformance documentation; no Rust source changes. + +## Owner and source fidelity + +Data.Int unwraps its opaque checked Radix and delegates the toStringAs foreign +slot to PSRS.Int.Format. Its signature, exports and all official pure declarations +remain unchanged. The entire module is checked against clean pinned +purescript-integers v6.0.0 at 54d712b25c594833083d15dc9ff2418eb9c52822; +the verifier permits exactly the native toNumber binding, parsing delegate and +formatting delegate with their target imports. + +The library owns radix digit extraction over raw truncating intQuot and signed +remainder. Keeping the accumulator nonpositive supports MIN without overflow. +A checked base in 2..36 proves remainder digits in 0..35, all output bytes ASCII +and termination within 32 digits. Zero produces one digit and negatives one +leading minus. Existing array append and checked bytesToString primitives +assemble canonical UTF-8; no new compiler intrinsic or library-name exception +is added. The previous PSRS.Show decimal digit implementation now calls the +same intBytes operation with fixed base 10, including numeric control escapes. + +## Verification + +- 857 public toStringAs observations agree byte-for-byte with the actual pinned + official Data.Int.js FFI across all bases 2..36, MIN/MAX and adjacent values, + zero, signs, digit transitions and powers of each base. +- 857 public parse/format round trips, 15 official Data.Show.js showInt comparisons + and 5 named-radix checks bring the generated fixture to 1734 checks. Each + group is bounded to 24 conjunction terms to limit fixture nesting; the + separate deep-expression compiler regression remains its own evidence. +- The generated program returns 42 with empty stdout/stderr in both development + and locked-package builds. run.json records direct build with PSRS_STDLIB_ROOT + unset, lock/input/compiler/Wasm digests and actual Wasmtime execution. The + development runner confirms the package unchanged during execution. +- The preceding 846 parsing checks return 42 with empty output against the same + package fingerprint. Observation and runtime data live in the library under + docs/evidence/int-formatting/. +- Node tooling: 10 passed, zero skips. Mandatory Wasmtime Show driver tests: + 6 passed, including number/aggregate boundaries, control escaping, retained + strings through allocation and memory growth. Development and locked trusted + loader tests: one passed each; Prelude remains first. +- Source audit: 227 modules in 41 packages; 171 identical, 35 modified, 21 target + additions, zero absent upstream modules and zero direct recursive foreign + placeholders. Exact source verification and behavior evidence approve this + slot; aggregate inventory categories do not approve other changes. +- The same public hexadecimal formatting probe changes from explicit P8 missing + Data.Int.toStringAs implementation to Passed through the locked loader. + diagnosis.json retains both snapshots; different package fingerprints preclude + a compatible diagnose --compare claim. +- Formatting and diff checks pass. Full workspace/clippy were not rerun for this + library-only slice. The preceding Rust checkpoint recorded 1664 passed, + 3 established baseline assertion failures and 5 ignored, with strict clippy + passing. That earlier run does not validate this entire new library pin. + +No import cohort or official suite scoreboard is remeasured. This checkpoint +establishes public integer formatting behavior for the tested values, not full +Data.Int or standard-library support. + +A fresh public `Int.fromNumber 42.0` probe reaches P8 library linking with +explicit missing Data.Int.fromNumberImpl support. next-blocker.json records +this continuation point under the new locked package. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 1f51189d..62942c07 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -179,3 +179,21 @@ observations. MIN / -1 produces an unrepresentable JS quotient and remains a Wasm division trap; that observation is recorded separately from value agreement. Both algorithms use raw truncating intQuot; the target library owns grammar, overflow rejection and Euclidean sign correction. + +For public radix integer formatting and its shared decimal Show implementation: + +```sh +node ../psrs-stdlib/conformance/int-formatting.mjs \ + /private/tmp/ps-pkgs/purescript-integers /private/tmp/purescript-prelude \ + /tmp/psrs-int-formatting-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-int-formatting-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-int-formatting-runtime +``` + +The generator compares 857 public formatting results and 15 showInt results +against their actual pinned official JS functions, and records 857 parse/format +round trips and 5 named-base checks separately. All 2..36 bases and signed-i32 +boundaries execute. The shared Data.Int source verifier now permits exactly +three typed foreign-slot adaptations; all official pure declarations remain. diff --git a/stdlib.lock.json b/stdlib.lock.json index 04920ffe..94dcb992 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "1ad9a1a9fba01f35c694d877fd4890f8d2e46cb9", - "source_fingerprint": "fnv1a64-v1:f728b54c2aadd888" + "revision": "02929696a90db4a8277151aab9a8c0a9978f8aa3", + "source_fingerprint": "fnv1a64-v1:83cdad11334226e0" } From 78dfeefdd26e0fadc87e9e71d69e9bc46312c973 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 17:01:16 +0800 Subject: [PATCH 066/148] Pin checked Number-to-Int conversion and boundary evidence --- .../stdlib/int-number-2026-10-07/report.md | 66 +++++++++++++++++++ docs/workflow/stdlib-conformance.md | 18 +++++ stdlib.lock.json | 4 +- 3 files changed, 86 insertions(+), 2 deletions(-) create mode 100644 docs/implementation/stdlib/int-number-2026-10-07/report.md diff --git a/docs/implementation/stdlib/int-number-2026-10-07/report.md b/docs/implementation/stdlib/int-number-2026-10-07/report.md new file mode 100644 index 00000000..159efc93 --- /dev/null +++ b/docs/implementation/stdlib/int-number-2026-10-07/report.md @@ -0,0 +1,66 @@ +# Checked Number-to-Int checkpoint + +Starting compiler: deb8304, with a clean worktree. The independent library moves +from 02929696a90db4a8277151aab9a8c0a9978f8aa3 to 3e3736dec40e873da6930d4864e7db4b525570ce, +content fingerprint fnv1a64-v1:5e7c1b9bf50e4915. This compiler commit changes +its lock and conformance evidence; no Rust source changes. + +## Owner and source fidelity + +Data.Int.fromNumber remains its official pure wrapper. The private fromNumberImpl +foreign slot delegates to PSRS.Int.Number with its full rank-N constructor +signature. The source verifier checks the entire official purescript-integers +v6.0.0 module at 54d712b25c594833083d15dc9ff2418eb9c52822. It permits +exactly four typed foreign-slot adaptations and their target imports: native +toNumber, parsing, formatting and checked Number conversion. All other pure +functions, exports, signatures, classes, instances and opaque Radix remain. + +The target library widens the existing total saturating numberToInt result and +checks exact Number equality before calling the success builder. Every i32 is +exactly representable in f64. Fractions and overflow fail equality; infinities +differ from finite bounds and NaN is unequal to every widened result. This +proves success exactly for integral, in-range inputs without relying on a +trapping conversion. No new intrinsic or compiler name exception is added. + +Both Number zero signs are accepted. Int has a single signed-i32 zero, so +widening its result canonicalizes negative zero to positive Number zero. The +official JS implementation can preserve negative Number zero inside its Int; +observations retain that representation difference explicitly rather than +claiming identical signed-zero bits. + +## Verification + +- 94 public fromNumber observations agree with the actual pinned Data.Int.js + FFI as Maybe Int values. Cases cover both i32 endpoints, immediately adjacent + IEEE-754 values on either side, fractions, subnormals, signed zeros, huge finite + values, unsigned and 53-bit boundaries, NaN and positive/negative infinity. +- Eleven public toNumber/fromNumber round trips and six local rank-N builder + checks are recorded separately: 111 checks total. Development and direct + locked builds return 42 with empty stdout/stderr. run.json records the direct + build with PSRS_STDLIB_ROOT unset, input/compiler/Wasm digests and actual + Wasmtime result. The development runner records immutable package content. +- The preceding 1734 public formatting/parse-round-trip checks return 42 with + empty output against the same package fingerprint. Library observations and + runtime evidence live under docs/evidence/int-number/. +- Node tooling: 10 passed, zero skips. Mandatory Wasmtime driver scalar tests: + 16 passed. Development and locked trusted-order loader tests: one passed each; + Prelude remains first. +- Source audit: 228 modules in 41 packages; 171 identical, 35 modified, 22 target + additions, zero missing upstream modules and zero direct recursive foreign + placeholders. Aggregate categories do not approve other source differences. +- The same public fromNumber 42.0 probe changes from explicit P8 missing + Data.Int.fromNumberImpl support to Passed through the locked package. + diagnosis.json retains both snapshots; differing fingerprints preclude a + compatible diagnose --compare result. +- Formatting and diff checks pass. Full workspace/clippy were not rerun for this + library-only slice. The preceding Rust checkpoint recorded 1664 passed, + 3 established baseline assertion failures and 5 ignored, with strict clippy + passing; that historical run does not validate the entire new library pin. + +No full import cohort or official suite scoreboard is remeasured. This checkpoint +does not establish all Data.Int APIs; its rounding/clamping wrappers require +additional Data.Number implementations and independent behavior evidence. + +A fresh public `Int.trunc 42.9` probe first reaches explicit P8 missing +Data.Number.isFinite support. next-blocker.json records this continuation +point under the new locked package. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 62942c07..aae9452d 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -197,3 +197,21 @@ against their actual pinned official JS functions, and records 857 parse/format round trips and 5 named-base checks separately. All 2..36 bases and signed-i32 boundaries execute. The shared Data.Int source verifier now permits exactly three typed foreign-slot adaptations; all official pure declarations remain. + +For checked public Number-to-Int conversion: + +```sh +node ../psrs-stdlib/conformance/int-number.mjs \ + /private/tmp/ps-pkgs/purescript-integers /tmp/psrs-int-number-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-int-number-oracle/Main.purs \ + --expected-exit 42 --out /tmp/psrs-int-number-runtime +``` + +The engine records 94 pinned official FFI observations, 11 toNumber/fromNumber +round trips and 6 target rank-N builder checks separately. It covers adjacent +IEEE-754 values at i32 boundaries, fractions, subnormals, signed zeros, overflow, +NaN and infinities. Target Int canonicalizes both Number zero signs to integer +zero; official negative-zero metadata is retained. The shared source verifier +now permits exactly four typed foreign-slot adaptations. diff --git a/stdlib.lock.json b/stdlib.lock.json index 94dcb992..18ad5933 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "02929696a90db4a8277151aab9a8c0a9978f8aa3", - "source_fingerprint": "fnv1a64-v1:83cdad11334226e0" + "revision": "3e3736dec40e873da6930d4864e7db4b525570ce", + "source_fingerprint": "fnv1a64-v1:5e7c1b9bf50e4915" } From 820de13e9a28e7bc6b83992346da2398e8480aae Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 17:45:52 +0800 Subject: [PATCH 067/148] Support Number truncation and pin official Int wrapper behavior --- crates/psrs-backend/src/cc/lower/scalar.rs | 1 + crates/psrs-backend/src/cc/scalar.rs | 1 + crates/psrs-backend/src/cc/verify/scalar.rs | 2 +- .../psrs-backend/src/cc/verify/tests/mod.rs | 9 ++- crates/psrs-backend/src/mir/gc_tests/mod.rs | 1 + .../src/mir/gc_tests/number_trunc.rs | 79 +++++++++++++++++++ crates/psrs-backend/src/mir/numeric.rs | 2 + .../src/mir/verify/instruction/unary.rs | 2 +- .../psrs-backend/src/mir/verify/tests/mod.rs | 23 ++++-- .../src/wasm/lower/structure/unary.rs | 4 + crates/psrs-core/src/verify/types/mod.rs | 2 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_trunc.rs | 42 ++++++++++ crates/psrs-hir/src/intrinsic/mod.rs | 7 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + docs/design/D-15-compiler-builtins.md | 5 ++ .../backend/fp/scalars-and-primitives.md | 13 ++- .../backend/scalars-and-primitives.md | 35 ++++++++ .../stdlib/number-trunc-2026-10-07.md | 73 +++++++++++++++++ docs/workflow/stdlib-conformance.md | 19 +++++ stdlib.lock.json | 4 +- 21 files changed, 310 insertions(+), 16 deletions(-) create mode 100644 crates/psrs-backend/src/mir/gc_tests/number_trunc.rs create mode 100644 crates/psrs-driver/src/tests/number_trunc.rs create mode 100644 docs/implementation/stdlib/number-trunc-2026-10-07.md diff --git a/crates/psrs-backend/src/cc/lower/scalar.rs b/crates/psrs-backend/src/cc/lower/scalar.rs index 76c4c7f7..2aa28d56 100644 --- a/crates/psrs-backend/src/cc/lower/scalar.rs +++ b/crates/psrs-backend/src/cc/lower/scalar.rs @@ -55,6 +55,7 @@ pub(super) fn lower_unary_op(value: Intrinsic) -> UnaryOp { Intrinsic::IntNeg => UnaryOp::IntNeg, Intrinsic::IntComplement => UnaryOp::IntComplement, Intrinsic::NumberNeg => UnaryOp::NumberNeg, + Intrinsic::NumberTrunc => UnaryOp::NumberTrunc, Intrinsic::BooleanNot => UnaryOp::BooleanNot, Intrinsic::IntToNumber => UnaryOp::IntToNumber, Intrinsic::NumberToInt => UnaryOp::NumberToInt, diff --git a/crates/psrs-backend/src/cc/scalar.rs b/crates/psrs-backend/src/cc/scalar.rs index 023fce67..7a2e8188 100644 --- a/crates/psrs-backend/src/cc/scalar.rs +++ b/crates/psrs-backend/src/cc/scalar.rs @@ -5,6 +5,7 @@ pub enum UnaryOp { IntNeg, IntComplement, NumberNeg, + NumberTrunc, BooleanNot, IntToNumber, NumberToInt, diff --git a/crates/psrs-backend/src/cc/verify/scalar.rs b/crates/psrs-backend/src/cc/verify/scalar.rs index 2ae57ef3..86d1b771 100644 --- a/crates/psrs-backend/src/cc/verify/scalar.rs +++ b/crates/psrs-backend/src/cc/verify/scalar.rs @@ -49,7 +49,7 @@ pub(super) fn verify_unary_operation( IntNeg | IntComplement | CharToInt | IntToChar => { (ValueShape::Integer, ValueShape::Integer) } - NumberNeg => (ValueShape::Number, ValueShape::Number), + NumberNeg | NumberTrunc => (ValueShape::Number, ValueShape::Number), BooleanNot => (ValueShape::Boolean, ValueShape::Boolean), IntToNumber => (ValueShape::Integer, ValueShape::Number), NumberToInt => (ValueShape::Number, ValueShape::Integer), diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index 8e3256ba..f623bba8 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -244,7 +244,14 @@ fn rejects_a_unary_operation_with_the_wrong_operand_shape() { span: TextRange::new(0, 1), }; - assert!(verify_function(&function, &HashMap::new(), &table()).is_err()); + for op in [ + super::super::UnaryOp::NumberNeg, + super::super::UnaryOp::NumberTrunc, + ] { + let mut function = function.clone(); + function.assignments[0].kind = AssignmentKind::Unary { op, value: input }; + assert!(verify_function(&function, &HashMap::new(), &table()).is_err()); + } } #[test] diff --git a/crates/psrs-backend/src/mir/gc_tests/mod.rs b/crates/psrs-backend/src/mir/gc_tests/mod.rs index 83d10c68..3d57eeba 100644 --- a/crates/psrs-backend/src/mir/gc_tests/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/mod.rs @@ -10,6 +10,7 @@ mod array; mod binary_matrix; mod div_mod; mod erased; +mod number_trunc; mod rank_n; mod scalar; mod unary; diff --git a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs new file mode 100644 index 00000000..b2e5b60d --- /dev/null +++ b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs @@ -0,0 +1,79 @@ +use super::*; + +#[test] +fn optimized_and_unoptimized_number_trunc_preserve_zero_sign_and_range() { + use crate::cc::{BinaryOp, UnaryOp, ValueDecl}; + use ValueShape::{Boolean as B, Integer as I, Number as N}; + let symbol = SymbolId::new(ModuleId(0), 0); + let unary = |destination, op, value| Assignment { + destination: ValueId(destination), + kind: AssignmentKind::Unary { + op, + value: ValueId(value), + }, + span: span(), + }; + let number = |destination, value: f64| Assignment { + destination: ValueId(destination), + kind: AssignmentKind::NumberConstant(value.to_string()), + span: span(), + }; + let binary = |destination, op, left, right| Assignment { + destination: ValueId(destination), + kind: AssignmentKind::Primitive { + op, + left: ValueId(left), + right: ValueId(right), + }, + span: span(), + }; + let module = CcModule { + name: "NumberTruncDifferential".into(), + externals: Vec::new(), + representations: RepresentationTable::default(), + functions: vec![CcFunction { + symbol, + name: "main".into(), + parameters: Vec::new(), + values: [N, N, N, N, N, B, N, N, N, B, B, I, I, I] + .into_iter() + .enumerate() + .map(|(id, ty)| ValueDecl { + id: ValueId(id as u32), + ty, + }) + .collect(), + assignments: vec![ + number(0, -0.9), + unary(1, UnaryOp::NumberTrunc, 0), + number(2, 1.0), + binary(3, BinaryOp::NumberDiv, 2, 1), + number(4, 0.0), + binary(5, BinaryOp::NumberLt, 3, 4), + number(6, 4294967296.5), + unary(7, UnaryOp::NumberTrunc, 6), + number(8, 4294967296.0), + binary(9, BinaryOp::NumberEq, 7, 8), + binary(10, BinaryOp::BooleanAnd, 5, 9), + unary(11, UnaryOp::BooleanToInt, 10), + Assignment { + destination: ValueId(12), + kind: AssignmentKind::Constant(41), + span: span(), + }, + binary(13, BinaryOp::IntAdd, 11, 12), + ], + result: ValueId(13), + result_type: I, + span: span(), + }], + entry: Some(symbol), + span: span(), + }; + let target = crate::TargetCapabilities::default(); + let (mir, _) = crate::mir::lower_module_with_capabilities(module, target) + .expect("Number truncation should lower to MIR"); + run_gc(&mir, 42); + let optimized = crate::mir::opt::optimize(mir, target).expect("valid optimization"); + run_gc(&optimized, 42); +} diff --git a/crates/psrs-backend/src/mir/numeric.rs b/crates/psrs-backend/src/mir/numeric.rs index 933c9ec7..b6ec43e0 100644 --- a/crates/psrs-backend/src/mir/numeric.rs +++ b/crates/psrs-backend/src/mir/numeric.rs @@ -7,6 +7,7 @@ pub enum UnaryOp { I32Neg, I32Complement, F64Neg, + F64Trunc, BoolNot, I32ToF64, F64ToF32, @@ -23,6 +24,7 @@ impl From for UnaryOp { CcUnaryOp::IntNeg => Self::I32Neg, CcUnaryOp::IntComplement => Self::I32Complement, CcUnaryOp::NumberNeg => Self::F64Neg, + CcUnaryOp::NumberTrunc => Self::F64Trunc, CcUnaryOp::BooleanNot => Self::BoolNot, CcUnaryOp::IntToNumber => Self::I32ToF64, CcUnaryOp::NumberToInt => Self::F64ToI32Sat, diff --git a/crates/psrs-backend/src/mir/verify/instruction/unary.rs b/crates/psrs-backend/src/mir/verify/instruction/unary.rs index bc02e871..d5e83a35 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/unary.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/unary.rs @@ -24,7 +24,7 @@ pub(super) fn verify_unary( UnaryOp::I32Neg | UnaryOp::I32Complement | UnaryOp::I32Identity => { (ValueType::I32, ValueType::I32) } - UnaryOp::F64Neg => (ValueType::F64, ValueType::F64), + UnaryOp::F64Neg | UnaryOp::F64Trunc => (ValueType::F64, ValueType::F64), UnaryOp::BoolNot => (ValueType::Boolean, ValueType::Boolean), UnaryOp::I32ToF64 => (ValueType::I32, ValueType::F64), UnaryOp::F64ToF32 => (ValueType::F64, ValueType::F32), diff --git a/crates/psrs-backend/src/mir/verify/tests/mod.rs b/crates/psrs-backend/src/mir/verify/tests/mod.rs index dc875863..0bd6b7fc 100644 --- a/crates/psrs-backend/src/mir/verify/tests/mod.rs +++ b/crates/psrs-backend/src/mir/verify/tests/mod.rs @@ -98,13 +98,22 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { result_type: ValueType::I32, span: span(), }; - let errors = verify_module(&module_with_function(function, Vec::new())).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("unary operand or result type")), - "{errors:?}" - ); + for op in [crate::mir::UnaryOp::F64Neg, crate::mir::UnaryOp::F64Trunc] { + let mut function = function.clone(); + function.blocks[0].instructions[0] = Instruction::UnaryPrimitive { + destination: output, + op, + value: input, + span: span(), + }; + let errors = verify_module(&module_with_function(function, Vec::new())).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("unary operand or result type")), + "{errors:?}" + ); + } } #[test] diff --git a/crates/psrs-backend/src/wasm/lower/structure/unary.rs b/crates/psrs-backend/src/wasm/lower/structure/unary.rs index b7eb76d2..9f6ef5e9 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/unary.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/unary.rs @@ -27,6 +27,10 @@ impl Structurer<'_> { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::F64Neg)); } + UnaryOp::F64Trunc => { + body.push(Op::Leaf(Instruction::LocalGet(value_local))); + body.push(Op::Leaf(Instruction::F64Trunc)); + } UnaryOp::BoolNot => { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::I32Eqz)); diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index f4fbf6fb..19b2a4a7 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -76,7 +76,7 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T use TypeConstructor::{Boolean, Char, Int, Number, String}; let (operand, result) = match intrinsic { Intrinsic::IntNeg | Intrinsic::IntComplement => (Int, Int), - Intrinsic::NumberNeg => (Number, Number), + Intrinsic::NumberNeg | Intrinsic::NumberTrunc => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 3d6d541d..63171137 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -19,6 +19,7 @@ mod functor; mod guard_coverage; mod let_constraints; mod library_foreign; +mod number_trunc; mod operators; mod partial_application; mod primitive_foreign; diff --git a/crates/psrs-driver/src/tests/number_trunc.rs b/crates/psrs-driver/src/tests/number_trunc.rs new file mode 100644 index 00000000..6cc23e09 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_trunc.rs @@ -0,0 +1,42 @@ +use super::*; + +#[test] +fn number_trunc_preserves_number_range_nonfinite_values_and_signed_zero() { + let source = r#" +module Main where +foreign import "psrs:intrinsic#numberTrunc" truncate :: Number -> Number +foreign import "psrs:intrinsic#numberDiv" divide :: Number -> Number -> Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +foreign import "psrs:intrinsic#numberEq" equal :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#numberNe" unequal :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#booleanAnd" and :: Boolean -> Boolean -> Boolean +fraction = and (equal (truncate 42.9) 42.0) (equal (truncate (negative 42.9)) (negative 42.0)) +large = and (equal (truncate 4294967296.5) 4294967296.0) (equal (truncate (negative 4294967296.5)) (negative 4294967296.0)) +zeros = and (equal (divide 1.0 (truncate 0.5)) (divide 1.0 0.0)) (equal (divide 1.0 (truncate (negative 0.5))) (divide (negative 1.0) 0.0)) +nonfinite = and (equal (truncate (divide 1.0 0.0)) (divide 1.0 0.0)) (and (equal (truncate (divide (negative 1.0) 0.0)) (divide (negative 1.0) 0.0)) (unequal (truncate (divide 0.0 0.0)) (truncate (divide 0.0 0.0)))) +main = if and fraction (and large (and zeros nonfinite)) then 42 else 1 +"#; + let mir = lower_source_to_mir(source); + assert!(format!("{mir:#?}").contains("F64Trunc")); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_trunc_checks_foreign_operand_and_result_contracts() { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberTrunc\" truncate :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("truncation requires Number operand and result"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 7fae986a..5a32ae3e 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -102,6 +102,8 @@ pub enum Intrinsic { /// Unsafe in-place write; returns the same array. Library internals only. ArrayWrite, NumberToString, + /// Truncate an IEEE-754 Number toward zero, retaining its Number representation. + NumberTrunc, } impl Intrinsic { @@ -124,7 +126,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 64] = [ + pub const ALL: [Intrinsic; 65] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -189,6 +191,7 @@ impl Intrinsic { Intrinsic::ArrayFill, Intrinsic::ArrayWrite, Intrinsic::NumberToString, + Intrinsic::NumberTrunc, ]; } @@ -197,7 +200,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::NumberToString as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::NumberTrunc as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 5943641a..a838185f 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -104,6 +104,7 @@ descriptors! { IntNeg => "intNeg", 1, UnaryScalar, scheme::int_int; IntComplement => "intComplement", 1, UnaryScalar, scheme::int_int; NumberNeg => "numberNeg", 1, UnaryScalar, scheme::number_number; + NumberTrunc => "numberTrunc", 1, UnaryScalar, scheme::number_number; BooleanNot => "booleanNot", 1, UnaryScalar, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, UnaryScalar, scheme::int_number; NumberToInt => "numberToInt", 1, UnaryScalar, scheme::number_int; diff --git a/docs/design/D-15-compiler-builtins.md b/docs/design/D-15-compiler-builtins.md index 6a8224e4..f1d511f6 100644 --- a/docs/design/D-15-compiler-builtins.md +++ b/docs/design/D-15-compiler-builtins.md @@ -381,6 +381,11 @@ its schemes, and each representation's intrinsic module owns the per-operation verification, folding, and lowering. Core has no per-operation expression node and no scalar `Primitive`/`UnaryPrimitive` enum. +`numberTrunc :: Number -> Number` is a unary scalar primitive. Core and each +backend representation check its operand/result contract before lowering to +Wasm `f64.trunc`. It retains Number range, signed zeros and nonfinite behavior; +integer saturation and library clamping remain separate operations. + The surface operators `+`, `*`, `==`, `/=`, `<`, `<=`, `>`, and `>=` are now library classes — `Data.Semiring`, `Data.Eq`, `Data.Ord` — over internal primitives, and `Prelude` re-exports them, matching official PureScript. A source diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index c76391d9..86e987ef 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -157,6 +157,7 @@ chosen mapping is: | `IntNeg` | `I32Neg` | `0 - x` | | `IntComplement` | `I32Complement` | `x ^ -1` | | `NumberNeg` | `F64Neg` | `f64.neg` | +| `NumberTrunc` | `F64Trunc` | `f64.trunc` | | `BooleanNot` | `BoolNot` | `i32.eqz` | | `IntToNumber` | `I32ToF64` | `f64.convert_i32_s` | | `NumberToInt` | `F64ToI32Sat` | saturating sequence (below) | @@ -205,6 +206,16 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. are representation identities, and the source layer is responsible for the validity of the scalar value. +### Number truncation + +`NumberTrunc` (`numberTrunc :: Number -> Number`) lowers to `f64.trunc`: +finite values round toward zero without converting to i32. It preserves zero +signs and infinities; NaN produces NaN without a payload-bit guarantee. Core, +CC and MIR verify Number/F64 operand and result types. The primitive remains +available for constant operands even when the MIR optimizer does not fold it. +The library uses it for the official Data.Number.trunc foreign slot; public +Int.trunc retains its official finite check and range clamping wrapper. + ### Conversions - `IntToNumber` is `f64.convert_i32_s`. @@ -454,7 +465,7 @@ combinations through Wasm GC and check the combined boolean result. The CC and MIR vocabularies, lowerings, and verifiers implement the full unary and binary set above. The source bootstrap exposes the operations that do not already have symbolic integer syntax as specialized functions: `intNeg`, -`intComplement`, `numberNeg`, `booleanNot`, the six conversion names from the +`intComplement`, `numberNeg`, `numberTrunc`, `booleanNot`, the six conversion names from the table (`intToNumber`, `numberToInt`, `booleanToInt`, `intToBoolean`, `charToInt`, and `intToChar`), `intDiv`, `intMod`, the six integer bitwise and shift names, all `number*`, `boolean*`, and `char*` binary names in the diff --git a/docs/implementation/backend/scalars-and-primitives.md b/docs/implementation/backend/scalars-and-primitives.md index 53a9de59..3e029d12 100644 --- a/docs/implementation/backend/scalars-and-primitives.md +++ b/docs/implementation/backend/scalars-and-primitives.md @@ -377,3 +377,38 @@ Implementation deviation: the worked example names the helpers `__psrs_euclidean_int_div`/`__psrs_euclidean_int_mod`. The names are cosmetic and the tests assert the emitted names; the design's symbol-allocation and operand contract are satisfied. + +## Number truncation extension (2026-10-07) + +This extension adds NumberTrunc to SP-03 and SP-07; the existing NumberToInt +saturation contract remains separate. The HIR registry owns numberTrunc's +Number -> Number scheme. Core verification, CC lowering/verification and MIR +numeric lowering/verification preserve that contract; Wasm emits f64.trunc. +These mappings are in intrinsic/registry.rs, core/verify/types/mod.rs, +cc/lower/scalar.rs, cc/verify/scalar.rs, mir/numeric.rs, +mir/verify/instruction/unary.rs and wasm/lower/structure/unary.rs. + +SP-07 and SP-12 execution is supplied by driver tests/number_trunc.rs:: +number_trunc_preserves_number_range_nonfinite_values_and_signed_zero and +backend mir/gc_tests/number_trunc.rs:: +optimized_and_unoptimized_number_trunc_preserve_zero_sign_and_range. +The source test executes fractions, values beyond i32, both zero signs, +NaN and infinities. The CC fixture executes both unoptimized and optimized +MIR, observes negative zero by reciprocal sign, and retains a Number beyond +i32 range. Both artifacts return 42 under Wasmtime 49.0.2. + +SP-11 rejection evidence extends the existing CC/MIR malformed unary operand +tests to NumberTrunc/F64Trunc. The source test +number_trunc_checks_foreign_operand_and_result_contracts additionally rejects +unused wrong operand, result and polymorphic foreign schemes. The tested +revision is c13a078 plus this extension; local raw reports remain regenerable. + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::number_trunc +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend optimized_and_unoptimized_number_trunc +``` + +Both focused commands pass (2 source tests and 1 optimization test; execution +is mandatory). Integrated validation and the unchanged standard-library wrapper +checks are recorded in the [checkpoint](../stdlib/number-trunc-2026-10-07.md). +This extension does not claim support for other Number rounding operations. diff --git a/docs/implementation/stdlib/number-trunc-2026-10-07.md b/docs/implementation/stdlib/number-trunc-2026-10-07.md new file mode 100644 index 00000000..6aa34b6a --- /dev/null +++ b/docs/implementation/stdlib/number-trunc-2026-10-07.md @@ -0,0 +1,73 @@ +# Number classification and truncation checkpoint + +Starting compiler: c13a078, with a clean worktree. The library advances from +3e3736d to 0e3273498523ab81742ad0751efce5fde55e9794, fingerprint fnv1a64-v1:9ff76cd44757e7e6. + +The compiler adds the generic unary numberTrunc :: Number -> Number primitive, +with authoritative HIR registry metadata and Core, CC and MIR type verification. +It lowers to f64.trunc, preserving Number range and signed zeros; NaN remains +NaN without a payload guarantee. New runtime evidence observes fractions, +values beyond i32 range, zero signs, NaN and infinities. Incorrect foreign +operand/result schemes and malformed CC/MIR operands are rejected. + +Data.Number.trunc binds that primitive and isFinite delegates to the library's +IEEE-754 self-subtraction/equality check. The full official purescript-numbers +v9.0.1 source at 27d54effdd2c0e7a86fe356b1cd813dca5981c2d is verified, +allowing exactly these two foreign adaptations and their target import. +Data.Int and its public trunc/unsafeClamp wrappers remain unchanged. The +library owns finite classification and integer clamping, while the compiler +owns the scalar primitive and target encoding. + +## Evidence + +The pinned official FFI engine generates 147 public Number.isFinite, +Number.trunc and Int.trunc checks across 49 inputs. Number expectations execute +the actual official JS FFI; Int clamping expectations compose the unchanged +pinned PureScript rules. Programs built through development and locked roots both execute with exit +42 and empty stdout/stderr. The locked build removes PSRS_STDLIB_ROOT and +records compiler, source and Wasm digests locally. The original Int.trunc 42.9 +probe changes from P8 missing isFinite and trunc bindings to Passed. Differing +library fingerprints preclude a compatible diagnose --compare claim. + +Node tooling: 10 passed, zero skips. Source audit: 229 modules in 41 packages; +170 identical, 36 modified, 23 target additions, zero missing upstream modules +and zero direct recursive foreign placeholders. The development trusted-order +loader passes; Prelude remains first. Two focused mandatory-Wasmtime compiler +tests pass. Strict workspace clippy and formatting pass. + +Combined validation: 1667 passed, 3 established baseline failures, 5 ignored. +The workspace commands cover 1666 passing tests; the additional post-audit +backend optimization test passes separately. Repeated target results are not +counted twice. Driver lib reports 689 passed and the same three pre-existing +artifact assertions: constrained_dictionary_parameters_precede_ordinary_arguments, +runs_a_polymorphic_identity_with_a_number, and +compiles_if_expression_through_cfg_to_structured_wasm. Failure names and messages +match the preceding deep-expression checkpoint. These remain failures; this is +not a green workspace result. + +The default workspace command stops at driver lib, so the remaining targets +were explicitly executed: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test --workspace +cargo test --workspace --exclude psrs-driver +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test '*' +cargo test -p psrs-driver --doc +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend optimized_and_unoptimized_number_trunc +cargo clippy --workspace --all-targets -- -D warnings +cargo fmt --all --check +``` + +The backend optimization fixture executes both pipelines with exact exit 42, +observing negative zero through its reciprocal and preserving Number range +beyond i32. The scalar acceptance checklist records the SP-03/SP-07/SP-11/SP-12 +mapping and evidence. All remaining crate, integration and doc tests pass; +the locked trusted-order loader also passes. Wasmtime version: 49.0.2. + +Raw observations and reports remain untracked local artifacts. Reproduce with +[the conformance workflow](../../workflow/stdlib-conformance.md). This checkpoint +does not measure the full import cohort or an official-suite scoreboard and +does not establish all Number or standard-library APIs. + +A fresh public `Int.floor 42.9` probe still reaches explicit P8 missing +Data.Number.floor support; other rounding operations remain a continuation. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index aae9452d..7fe58c75 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -215,3 +215,22 @@ IEEE-754 values at i32 boundaries, fractions, subnormals, signed zeros, overflow NaN and infinities. Target Int canonicalizes both Number zero signs to integer zero; official negative-zero metadata is retained. The shared source verifier now permits exactly four typed foreign-slot adaptations. + +For finite Number classification and Number/Int truncation: + +```sh +node ../psrs-stdlib/conformance/number-trunc.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /private/tmp/ps-pkgs/purescript-integers \ + /tmp/psrs-number-trunc-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-trunc-oracle/Main.purs \ + --expected-exit 42 --out /tmp/psrs-number-trunc-runtime +``` + +The engine verifies both pinned full-module transformations. It executes actual +Number isFinite/trunc FFI for 49 inputs and composes Int clamp expectations from +unchanged official source rules, producing 147 public API checks. Reciprocal +observations distinguish Number zero signs; Int uses its single integer zero. +Raw snapshots and runtime reports remain local and regenerable; commit only +source, case engines and concise acceptance reports. diff --git a/stdlib.lock.json b/stdlib.lock.json index 18ad5933..470267d2 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "3e3736dec40e873da6930d4864e7db4b525570ce", - "source_fingerprint": "fnv1a64-v1:5e7c1b9bf50e4915" + "revision": "0e3273498523ab81742ad0751efce5fde55e9794", + "source_fingerprint": "fnv1a64-v1:9ff76cd44757e7e6" } From 660d1c50d19594a2f9edf69d9ebf1c4bcd969881 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 18:40:54 +0800 Subject: [PATCH 068/148] Support checked Number rounding and pin official public wrapper behavior --- crates/psrs-backend/src/cc/lower/scalar.rs | 2 + crates/psrs-backend/src/cc/scalar.rs | 2 + crates/psrs-backend/src/cc/verify/scalar.rs | 4 +- .../psrs-backend/src/cc/verify/tests/mod.rs | 2 + .../src/mir/gc_tests/number_trunc.rs | 18 ++- crates/psrs-backend/src/mir/numeric.rs | 4 + .../src/mir/verify/instruction/unary.rs | 4 +- .../psrs-backend/src/mir/verify/tests/mod.rs | 7 +- .../src/wasm/lower/structure/unary.rs | 8 ++ crates/psrs-core/src/verify/types/mod.rs | 5 +- crates/psrs-driver/src/tests/mod.rs | 1 + .../psrs-driver/src/tests/number_rounding.rs | 70 ++++++++++++ crates/psrs-hir/src/intrinsic/mod.rs | 10 +- crates/psrs-hir/src/intrinsic/registry.rs | 2 + docs/design/D-15-compiler-builtins.md | 8 +- .../backend/fp/scalars-and-primitives.md | 13 ++- .../backend/scalars-and-primitives.md | 14 +++ .../stdlib/number-rounding-2026-10-07.md | 105 ++++++++++++++++++ docs/workflow/stdlib-conformance.md | 20 ++++ stdlib.lock.json | 4 +- 20 files changed, 286 insertions(+), 17 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_rounding.rs create mode 100644 docs/implementation/stdlib/number-rounding-2026-10-07.md diff --git a/crates/psrs-backend/src/cc/lower/scalar.rs b/crates/psrs-backend/src/cc/lower/scalar.rs index 2aa28d56..a0c93694 100644 --- a/crates/psrs-backend/src/cc/lower/scalar.rs +++ b/crates/psrs-backend/src/cc/lower/scalar.rs @@ -56,6 +56,8 @@ pub(super) fn lower_unary_op(value: Intrinsic) -> UnaryOp { Intrinsic::IntComplement => UnaryOp::IntComplement, Intrinsic::NumberNeg => UnaryOp::NumberNeg, Intrinsic::NumberTrunc => UnaryOp::NumberTrunc, + Intrinsic::NumberFloor => UnaryOp::NumberFloor, + Intrinsic::NumberCeil => UnaryOp::NumberCeil, Intrinsic::BooleanNot => UnaryOp::BooleanNot, Intrinsic::IntToNumber => UnaryOp::IntToNumber, Intrinsic::NumberToInt => UnaryOp::NumberToInt, diff --git a/crates/psrs-backend/src/cc/scalar.rs b/crates/psrs-backend/src/cc/scalar.rs index 7a2e8188..aa815179 100644 --- a/crates/psrs-backend/src/cc/scalar.rs +++ b/crates/psrs-backend/src/cc/scalar.rs @@ -6,6 +6,8 @@ pub enum UnaryOp { IntComplement, NumberNeg, NumberTrunc, + NumberFloor, + NumberCeil, BooleanNot, IntToNumber, NumberToInt, diff --git a/crates/psrs-backend/src/cc/verify/scalar.rs b/crates/psrs-backend/src/cc/verify/scalar.rs index 86d1b771..330a5d19 100644 --- a/crates/psrs-backend/src/cc/verify/scalar.rs +++ b/crates/psrs-backend/src/cc/verify/scalar.rs @@ -49,7 +49,9 @@ pub(super) fn verify_unary_operation( IntNeg | IntComplement | CharToInt | IntToChar => { (ValueShape::Integer, ValueShape::Integer) } - NumberNeg | NumberTrunc => (ValueShape::Number, ValueShape::Number), + NumberNeg | NumberTrunc | NumberFloor | NumberCeil => { + (ValueShape::Number, ValueShape::Number) + } BooleanNot => (ValueShape::Boolean, ValueShape::Boolean), IntToNumber => (ValueShape::Integer, ValueShape::Number), NumberToInt => (ValueShape::Number, ValueShape::Integer), diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index f623bba8..f126226a 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -247,6 +247,8 @@ fn rejects_a_unary_operation_with_the_wrong_operand_shape() { for op in [ super::super::UnaryOp::NumberNeg, super::super::UnaryOp::NumberTrunc, + super::super::UnaryOp::NumberFloor, + super::super::UnaryOp::NumberCeil, ] { let mut function = function.clone(); function.assignments[0].kind = AssignmentKind::Unary { op, value: input }; diff --git a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs index b2e5b60d..d43ce39a 100644 --- a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs +++ b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs @@ -2,6 +2,16 @@ use super::*; #[test] fn optimized_and_unoptimized_number_trunc_preserve_zero_sign_and_range() { + check_number_rounding(crate::cc::UnaryOp::NumberTrunc, -0.9, 4294967296.0); +} + +#[test] +fn optimized_and_unoptimized_number_floor_and_ceil_preserve_sign_and_range() { + check_number_rounding(crate::cc::UnaryOp::NumberFloor, -0.0, 4294967296.0); + check_number_rounding(crate::cc::UnaryOp::NumberCeil, -0.9, 4294967297.0); +} + +fn check_number_rounding(operation: crate::cc::UnaryOp, input: f64, expected: f64) { use crate::cc::{BinaryOp, UnaryOp, ValueDecl}; use ValueShape::{Boolean as B, Integer as I, Number as N}; let symbol = SymbolId::new(ModuleId(0), 0); @@ -44,15 +54,15 @@ fn optimized_and_unoptimized_number_trunc_preserve_zero_sign_and_range() { }) .collect(), assignments: vec![ - number(0, -0.9), - unary(1, UnaryOp::NumberTrunc, 0), + number(0, input), + unary(1, operation, 0), number(2, 1.0), binary(3, BinaryOp::NumberDiv, 2, 1), number(4, 0.0), binary(5, BinaryOp::NumberLt, 3, 4), number(6, 4294967296.5), - unary(7, UnaryOp::NumberTrunc, 6), - number(8, 4294967296.0), + unary(7, operation, 6), + number(8, expected), binary(9, BinaryOp::NumberEq, 7, 8), binary(10, BinaryOp::BooleanAnd, 5, 9), unary(11, UnaryOp::BooleanToInt, 10), diff --git a/crates/psrs-backend/src/mir/numeric.rs b/crates/psrs-backend/src/mir/numeric.rs index b6ec43e0..ad0195bf 100644 --- a/crates/psrs-backend/src/mir/numeric.rs +++ b/crates/psrs-backend/src/mir/numeric.rs @@ -8,6 +8,8 @@ pub enum UnaryOp { I32Complement, F64Neg, F64Trunc, + F64Floor, + F64Ceil, BoolNot, I32ToF64, F64ToF32, @@ -25,6 +27,8 @@ impl From for UnaryOp { CcUnaryOp::IntComplement => Self::I32Complement, CcUnaryOp::NumberNeg => Self::F64Neg, CcUnaryOp::NumberTrunc => Self::F64Trunc, + CcUnaryOp::NumberFloor => Self::F64Floor, + CcUnaryOp::NumberCeil => Self::F64Ceil, CcUnaryOp::BooleanNot => Self::BoolNot, CcUnaryOp::IntToNumber => Self::I32ToF64, CcUnaryOp::NumberToInt => Self::F64ToI32Sat, diff --git a/crates/psrs-backend/src/mir/verify/instruction/unary.rs b/crates/psrs-backend/src/mir/verify/instruction/unary.rs index d5e83a35..fcfc9f19 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/unary.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/unary.rs @@ -24,7 +24,9 @@ pub(super) fn verify_unary( UnaryOp::I32Neg | UnaryOp::I32Complement | UnaryOp::I32Identity => { (ValueType::I32, ValueType::I32) } - UnaryOp::F64Neg | UnaryOp::F64Trunc => (ValueType::F64, ValueType::F64), + UnaryOp::F64Neg | UnaryOp::F64Trunc | UnaryOp::F64Floor | UnaryOp::F64Ceil => { + (ValueType::F64, ValueType::F64) + } UnaryOp::BoolNot => (ValueType::Boolean, ValueType::Boolean), UnaryOp::I32ToF64 => (ValueType::I32, ValueType::F64), UnaryOp::F64ToF32 => (ValueType::F64, ValueType::F32), diff --git a/crates/psrs-backend/src/mir/verify/tests/mod.rs b/crates/psrs-backend/src/mir/verify/tests/mod.rs index 0bd6b7fc..90d01fde 100644 --- a/crates/psrs-backend/src/mir/verify/tests/mod.rs +++ b/crates/psrs-backend/src/mir/verify/tests/mod.rs @@ -98,7 +98,12 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { result_type: ValueType::I32, span: span(), }; - for op in [crate::mir::UnaryOp::F64Neg, crate::mir::UnaryOp::F64Trunc] { + for op in [ + crate::mir::UnaryOp::F64Neg, + crate::mir::UnaryOp::F64Trunc, + crate::mir::UnaryOp::F64Floor, + crate::mir::UnaryOp::F64Ceil, + ] { let mut function = function.clone(); function.blocks[0].instructions[0] = Instruction::UnaryPrimitive { destination: output, diff --git a/crates/psrs-backend/src/wasm/lower/structure/unary.rs b/crates/psrs-backend/src/wasm/lower/structure/unary.rs index 9f6ef5e9..ea92aa34 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/unary.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/unary.rs @@ -31,6 +31,14 @@ impl Structurer<'_> { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::F64Trunc)); } + UnaryOp::F64Floor => { + body.push(Op::Leaf(Instruction::LocalGet(value_local))); + body.push(Op::Leaf(Instruction::F64Floor)); + } + UnaryOp::F64Ceil => { + body.push(Op::Leaf(Instruction::LocalGet(value_local))); + body.push(Op::Leaf(Instruction::F64Ceil)); + } UnaryOp::BoolNot => { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::I32Eqz)); diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 19b2a4a7..88c990d5 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -76,7 +76,10 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T use TypeConstructor::{Boolean, Char, Int, Number, String}; let (operand, result) = match intrinsic { Intrinsic::IntNeg | Intrinsic::IntComplement => (Int, Int), - Intrinsic::NumberNeg | Intrinsic::NumberTrunc => (Number, Number), + Intrinsic::NumberNeg + | Intrinsic::NumberTrunc + | Intrinsic::NumberFloor + | Intrinsic::NumberCeil => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 63171137..049797b9 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -19,6 +19,7 @@ mod functor; mod guard_coverage; mod let_constraints; mod library_foreign; +mod number_rounding; mod number_trunc; mod operators; mod partial_application; diff --git a/crates/psrs-driver/src/tests/number_rounding.rs b/crates/psrs-driver/src/tests/number_rounding.rs new file mode 100644 index 00000000..909fbbac --- /dev/null +++ b/crates/psrs-driver/src/tests/number_rounding.rs @@ -0,0 +1,70 @@ +use super::*; + +#[test] +fn number_floor_and_ceil_preserve_range_nonfinite_values_and_signed_zero() { + for (binding, instruction, positive, negative, large, zero_input) in [ + ( + "numberFloor", + "F64Floor", + "42.0", + "43.0", + "4294967296.0", + "0.5", + ), + ( + "numberCeil", + "F64Ceil", + "43.0", + "42.0", + "4294967297.0", + "(negative 0.5)", + ), + ] { + let zero_sign = if binding == "numberFloor" { + "1.0" + } else { + "(negative 1.0)" + }; + let source = format!( + r#" +module Main where +foreign import "psrs:intrinsic#{binding}" rounding :: Number -> Number +foreign import "psrs:intrinsic#numberDiv" divide :: Number -> Number -> Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +foreign import "psrs:intrinsic#numberEq" equal :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#numberNe" unequal :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#booleanAnd" and :: Boolean -> Boolean -> Boolean +fraction = and (equal (rounding 42.9) {positive}) (equal (rounding (negative 42.9)) (negative {negative})) +large = equal (rounding 4294967296.5) {large} +zeros = and (equal (divide 1.0 (rounding {zero_input})) (divide {zero_sign} 0.0)) (equal (divide 1.0 (rounding (negative 0.0))) (divide (negative 1.0) 0.0)) +nonfinite = and (equal (rounding (divide 1.0 0.0)) (divide 1.0 0.0)) (and (equal (rounding (divide (negative 1.0) 0.0)) (divide (negative 1.0) 0.0)) (unequal (rounding (divide 0.0 0.0)) (rounding (divide 0.0 0.0)))) +main = if and fraction (and large (and zeros nonfinite)) then 42 else 1 +"# + ); + let mir = lower_source_to_mir(&source); + assert!(format!("{mir:#?}").contains(instruction)); + let Some(output) = run_with_wasmtime(&source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{binding}: {output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); + } +} + +#[test] +fn number_floor_and_ceil_reject_invalid_foreign_contracts() { + for binding in ["numberFloor", "numberCeil"] { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#{binding}\" rounding :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("rounding requires Number operand and result"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } + } +} diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 5a32ae3e..3372d055 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -104,6 +104,10 @@ pub enum Intrinsic { NumberToString, /// Truncate an IEEE-754 Number toward zero, retaining its Number representation. NumberTrunc, + /// Round a Number toward negative infinity. + NumberFloor, + /// Round a Number toward positive infinity. + NumberCeil, } impl Intrinsic { @@ -126,7 +130,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 65] = [ + pub const ALL: [Intrinsic; 67] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -192,6 +196,8 @@ impl Intrinsic { Intrinsic::ArrayWrite, Intrinsic::NumberToString, Intrinsic::NumberTrunc, + Intrinsic::NumberFloor, + Intrinsic::NumberCeil, ]; } @@ -200,7 +206,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::NumberTrunc as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::NumberCeil as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index a838185f..948f4386 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -105,6 +105,8 @@ descriptors! { IntComplement => "intComplement", 1, UnaryScalar, scheme::int_int; NumberNeg => "numberNeg", 1, UnaryScalar, scheme::number_number; NumberTrunc => "numberTrunc", 1, UnaryScalar, scheme::number_number; + NumberFloor => "numberFloor", 1, UnaryScalar, scheme::number_number; + NumberCeil => "numberCeil", 1, UnaryScalar, scheme::number_number; BooleanNot => "booleanNot", 1, UnaryScalar, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, UnaryScalar, scheme::int_number; NumberToInt => "numberToInt", 1, UnaryScalar, scheme::number_int; diff --git a/docs/design/D-15-compiler-builtins.md b/docs/design/D-15-compiler-builtins.md index f1d511f6..795509a3 100644 --- a/docs/design/D-15-compiler-builtins.md +++ b/docs/design/D-15-compiler-builtins.md @@ -381,9 +381,11 @@ its schemes, and each representation's intrinsic module owns the per-operation verification, folding, and lowering. Core has no per-operation expression node and no scalar `Primitive`/`UnaryPrimitive` enum. -`numberTrunc :: Number -> Number` is a unary scalar primitive. Core and each -backend representation check its operand/result contract before lowering to -Wasm `f64.trunc`. It retains Number range, signed zeros and nonfinite behavior; +`numberTrunc`, `numberFloor` and `numberCeil` are unary scalar primitives +with the checked scheme `Number -> Number`. Core and each backend representation +check their operand/result contracts before lowering to Wasm `f64.trunc`, +`f64.floor` and `f64.ceil`, respectively. They retain Number range, signed zeros +and nonfinite behavior; integer saturation and library clamping remain separate operations. The surface operators `+`, `*`, `==`, `/=`, `<`, `<=`, `>`, and `>=` are now diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index 86e987ef..0bc62f66 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -158,6 +158,7 @@ chosen mapping is: | `IntComplement` | `I32Complement` | `x ^ -1` | | `NumberNeg` | `F64Neg` | `f64.neg` | | `NumberTrunc` | `F64Trunc` | `f64.trunc` | +| `NumberFloor` / `NumberCeil` | `F64Floor` / `F64Ceil` | `f64.floor` / `f64.ceil` | | `BooleanNot` | `BoolNot` | `i32.eqz` | | `IntToNumber` | `I32ToF64` | `f64.convert_i32_s` | | `NumberToInt` | `F64ToI32Sat` | saturating sequence (below) | @@ -206,7 +207,7 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. are representation identities, and the source layer is responsible for the validity of the scalar value. -### Number truncation +### Number integral rounding `NumberTrunc` (`numberTrunc :: Number -> Number`) lowers to `f64.trunc`: finite values round toward zero without converting to i32. It preserves zero @@ -216,6 +217,14 @@ available for constant operands even when the MIR optimizer does not fold it. The library uses it for the official Data.Number.trunc foreign slot; public Int.trunc retains its official finite check and range clamping wrapper. +`NumberFloor` and `NumberCeil` have the same Number/F64 type contract and +nonfinite/zero-sign guarantees, with rounding toward negative and positive +infinity, respectively. They lower directly to `f64.floor` and `f64.ceil`, +without an integer representation boundary. The library owns ECMAScript +round-to-nearest with ties toward positive infinity: this differs from Wasm +`f64.nearest` and cannot be replaced by adding 0.5 before flooring. Public +Int.floor/ceil/round retain their unchanged finite checks and clamping wrappers. + ### Conversions - `IntToNumber` is `f64.convert_i32_s`. @@ -465,7 +474,7 @@ combinations through Wasm GC and check the combined boolean result. The CC and MIR vocabularies, lowerings, and verifiers implement the full unary and binary set above. The source bootstrap exposes the operations that do not already have symbolic integer syntax as specialized functions: `intNeg`, -`intComplement`, `numberNeg`, `numberTrunc`, `booleanNot`, the six conversion names from the +`intComplement`, `numberNeg`, `numberTrunc`, `numberFloor`, `numberCeil`, `booleanNot`, the six conversion names from the table (`intToNumber`, `numberToInt`, `booleanToInt`, `intToBoolean`, `charToInt`, and `intToChar`), `intDiv`, `intMod`, the six integer bitwise and shift names, all `number*`, `boolean*`, and `char*` binary names in the diff --git a/docs/implementation/backend/scalars-and-primitives.md b/docs/implementation/backend/scalars-and-primitives.md index 3e029d12..5001693d 100644 --- a/docs/implementation/backend/scalars-and-primitives.md +++ b/docs/implementation/backend/scalars-and-primitives.md @@ -412,3 +412,17 @@ Both focused commands pass (2 source tests and 1 optimization test; execution is mandatory). Integrated validation and the unchanged standard-library wrapper checks are recorded in the [checkpoint](../stdlib/number-trunc-2026-10-07.md). This extension does not claim support for other Number rounding operations. + +### Number floor and ceiling extension + +NumberFloor/NumberCeil extend SP-03 and SP-07 through the authoritative HIR +registry and Core/CC/MIR operand/result checks, lowering to f64.floor/f64.ceil. +Existing CC and MIR malformed-unary tests cover both operations. Driver +`tests::number_rounding` executes fractions, Number range beyond i32, nonfinite +values and reciprocal observations of signed zero, and rejects invalid foreign +schemes. Backend `optimized_and_unoptimized_number_floor_and_ceil_preserve_sign_and_range` +executes both optimization paths. These primitives discharge rounding only; +library Int clamping and the ECMAScript round tie policy remain library-owned. + +This extension does not establish completion of the scalar topic or add MIR +constant folding for these operations. diff --git a/docs/implementation/stdlib/number-rounding-2026-10-07.md b/docs/implementation/stdlib/number-rounding-2026-10-07.md new file mode 100644 index 00000000..759c39a5 --- /dev/null +++ b/docs/implementation/stdlib/number-rounding-2026-10-07.md @@ -0,0 +1,105 @@ +# Number and Int rounding acceptance + +## Scope and ownership + +Starting compiler revision: 820de13 on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was 0e3273498523ab81742ad0751efce5fde55e9794 +(fnv1a64-v1:9ff76cd44757e7e6). A fresh diagnosis of Int.floor 42.9 failed at +P8 library linking: Data.Number.floor had no target implementation. + +The compiler now owns the generic checked numberFloor/numberCeil primitives, +not library algorithms or Int range policy. Their stable identities are +appended to the HIR registry, preserving existing IDs. Core, CC and MIR check +Number/F64 operands and results; Wasm encodes f64.floor/f64.ceil. Existing +malformed unary-operation tests cover both additions. Driver source tests +execute nonfinite values, fractions, signed zero and Number range above i32, +and reject incorrect foreign binding schemes. Backend tests execute both MIR +optimization paths. No new constant folding is claimed. + +The independent library owns the actual ECMAScript round implementation in +PSRS.Number: preserve zero signs in [-0.5, 0], otherwise compare the fractional +part with 0.5 before adding one to the floor. This avoids both Wasm nearest's +ties-to-even and the precision loss from flooring value + 0.5. The +[ECMAScript contract](https://tc39.es/ecma262/2023/multipage/numbers-and-dates.html#sec-math.round) +is checked against actual pinned official JS results. Full-module source +transformations preserve all official pure declarations and signatures. +Data.Int's floor/ceil/round/unsafeClamp wrappers are unchanged. + +## Package and behavior evidence + +Locked package: 2ee2d1fdaff8a2841824cd1bb5d3fb864f594630 +(fnv1a64-v1:801317111aa80a8f). The package owns source adaptations, provenance, +the Node oracle and source-verifier test; the compiler retains its lock and +Rust regression tests. + +```sh +node ../psrs-stdlib/conformance/number-rounding.mjs \ + /private/tmp/ps-pkgs/purescript-numbers \ + /private/tmp/ps-pkgs/purescript-integers /tmp/psrs-rounding-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-rounding-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-rounding-runtime +# Also build directly with PSRS_STDLIB_ROOT unset, then execute the artifact. +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-rounding-oracle/Main.purs -o /tmp/psrs-rounding-locked.wasm +wasmtime /tmp/psrs-rounding-locked.wasm +``` + +- 69 inputs, 207 rounded observations and 414 public Number/Int checks pass: + both signs of zero, subnormals, nonfinite values, half-integer ties and their + adjacent values, Int boundaries/overflow, values around 2^52 and maximal + finite Number values. Development-package and locked-package executions + return 42 with empty stdout/stderr. +- The preceding 147 public isFinite/trunc checks still pass with exit 42 and + empty stdout/stderr. Node tooling: 11 passed, zero skipped. +- Complete source audit: 229 modules across 41 packages, 170 identical, + 36 modified and 23 target additions, no absent upstream modules and no + direct recursive foreign placeholders. All 229 stored vendored hashes match + their actual files, including one pre-existing stale ST.Partial hash corrected + without changing its source. +- Fresh locked diagnosis of the original Int.floor case passes. Its library + fingerprint differs from the baseline, so this is a replay across a package + update, not a same-fingerprint diagnose --compare result. + +Raw JSON reports and Wasm artifacts remain local under /private/tmp. They are +not committed. See the library's docs/number-rounding.md for source ownership +and its conformance command contract. + +## Rust validation + +cargo fmt --all --check and cargo clippy --workspace --all-targets -- -D warnings +pass. The two new driver source/foreign-contract tests pass under mandatory +Wasmtime. The two backend optimized/unoptimized rounding tests also pass, +including negative-zero floor operands. + +PSRS_REQUIRE_WASMTIME=1 cargo test --workspace initially encountered storage +exhaustion while writing test components. Old regenerable incremental caches +were removed, then the entire workspace was rerun with --no-fail-fast. Completed +unit and integration tests record 1670 passed, 3 established failures and +5 ignored. Two doc targets encountered missing dependency artifacts; after +cargo clean -p psrs-runtime, cargo test --workspace --doc passes serially. +All 52 target suites are accounted for after that recovery. + +The three established driver failures match the preceding checkpoint: +dictionary_audit::execution::constrained_dictionary_parameters_precede_ordinary_arguments +(MIR constrained function), tests::functions::runs_a_polymorphic_identity_with_a_number +(the optimized WAT no longer contains an unused f64), and +tests::integration::compiles_if_expression_through_cfg_to_structured_wasm +(the optimized constant branch no longer contains br_if). Full workspace +validation is therefore not green. No official scoreboard measurement was run. + +The subsequent metadata-only ST.Partial hash refresh preserves all Purs source; +the final package is rechecked through the trusted-loader test and both locked +public API programs. Raw environment-failed logs remain local for diagnosis. + +## Remaining work + +This is rounding acceptance, not whole-standard-library acceptance. A fresh +public Number.fromString "42.5" reproducer currently stops at P7 Core +verification: Core expression type is inconsistent with its context. The +library-origin span covers runFn4 fromStringImpl in the unchanged official +wrapper. Root cause has not yet been established; do not replace that wrapper +or classify this as a missing parsing FFI implementation until Core checking +is resolved. Other Number FFI remains unsupported. No scoreboard or gate +measurement is changed by this focused behavior evidence. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 7fe58c75..eb1b960a 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -234,3 +234,23 @@ unchanged official source rules, producing 147 public API checks. Reciprocal observations distinguish Number zero signs; Int uses its single integer zero. Raw snapshots and runtime reports remain local and regenerable; commit only source, case engines and concise acceptance reports. + +For Number rounding and unchanged public Int clamping wrappers: + +```sh +node ../psrs-stdlib/conformance/number-rounding.mjs \ + /private/tmp/ps-pkgs/purescript-numbers \ + /private/tmp/ps-pkgs/purescript-integers /tmp/psrs-rounding-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-rounding-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-rounding-runtime +``` + +The generator invokes the pinned official floor/ceil/round FFI, preserving +negative zero through reciprocal observations and testing adjacent values at +half-integer ties and Int bounds. Wasm floor/ceil are small checked primitives; +ECMAScript round tie behavior belongs to ordinary PureScript in PSRS.Number. +Official Data.Int pure wrappers remain unchanged. Raw generated reports are +local and ignored; summarized acceptance lives in the library's +`docs/number-rounding.md` and the compiler's topic report. diff --git a/stdlib.lock.json b/stdlib.lock.json index 470267d2..673b3fe1 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "0e3273498523ab81742ad0751efce5fde55e9794", - "source_fingerprint": "fnv1a64-v1:9ff76cd44757e7e6" + "revision": "2ee2d1fdaff8a2841824cd1bb5d3fb864f594630", + "source_fingerprint": "fnv1a64-v1:801317111aa80a8f" } From a3ea5e8caca576f2774a4ef61c254b0e004c69d2 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 20:10:44 +0800 Subject: [PATCH 069/148] Preserve explicit polymorphic arguments in checked Core instantiation --- .../mod.rs} | 2 + .../src/tests/instantiation/polymorphic.rs | 139 ++++++++++++++++++ .../src/verify/types/matching/constructors.rs | 10 +- .../src/verify/types/matching/invariant.rs | 10 +- crates/psrs-driver/src/tests/data_function.rs | 21 +++ .../frontend/type-system/type-inference.md | 7 + ...plicit-polymorphic-arguments-2026-10-07.md | 83 +++++++++++ .../stdlib/number-rounding-2026-10-07.md | 13 +- 8 files changed, 266 insertions(+), 19 deletions(-) rename crates/psrs-core/src/tests/{instantiation.rs => instantiation/mod.rs} (99%) create mode 100644 crates/psrs-core/src/tests/instantiation/polymorphic.rs create mode 100644 docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md diff --git a/crates/psrs-core/src/tests/instantiation.rs b/crates/psrs-core/src/tests/instantiation/mod.rs similarity index 99% rename from crates/psrs-core/src/tests/instantiation.rs rename to crates/psrs-core/src/tests/instantiation/mod.rs index cbcc0569..88db4ca1 100644 --- a/crates/psrs-core/src/tests/instantiation.rs +++ b/crates/psrs-core/src/tests/instantiation/mod.rs @@ -2,6 +2,8 @@ //! before representation lowering rewrites a constructor application. use super::*; + +mod polymorphic; use psrs_hir::{ModuleId, TypeId as HirTypeId, TypeVariableId}; use std::collections::HashMap; diff --git a/crates/psrs-core/src/tests/instantiation/polymorphic.rs b/crates/psrs-core/src/tests/instantiation/polymorphic.rs new file mode 100644 index 00000000..982e0a52 --- /dev/null +++ b/crates/psrs-core/src/tests/instantiation/polymorphic.rs @@ -0,0 +1,139 @@ +//! Explicit quantified arguments survive checked nominal instantiation. + +use super::*; + +#[test] +fn a_polymorphic_nominal_argument_cannot_contain_the_parameter_being_solved() { + let parameter = TypeVariableId(10); + let bound = TypeVariableId(11); + let mut types = vec![Type::Variable(parameter), Type::Variable(bound)]; + let body = arrow(&mut types, TypeId(0), TypeId(1)); + let poly = forall(&mut types, vec![bound], body); + let scheme = nominal(&mut types, 1, TypeId(0)); + let instance = nominal(&mut types, 1, poly); + let module = bare(types); + assert!( + module + .checked_instantiation(scheme, &[parameter], instance) + .is_none() + ); + assert!( + module + .checked_instantiation(instance, &[parameter], scheme) + .is_none() + ); +} + +#[test] +fn nominal_parameters_retain_explicit_polymorphic_arguments() { + let parameter = TypeVariableId(10); + let bound = TypeVariableId(11); + let renamed = TypeVariableId(12); + let mut types = vec![ + Type::Variable(parameter), + Type::Variable(bound), + Type::Variable(renamed), + Type::Constructor(TypeConstructor::Int), + ]; + let body = arrow(&mut types, TypeId(1), TypeId(1)); + let poly = forall(&mut types, vec![bound], body); + let body = arrow(&mut types, TypeId(2), TypeId(2)); + let alpha = forall(&mut types, vec![renamed], body); + let mono = arrow(&mut types, TypeId(3), TypeId(3)); + let abstract_box = nominal(&mut types, 1, TypeId(0)); + let poly_box = nominal(&mut types, 1, poly); + let mono_box = nominal(&mut types, 1, mono); + let scheme = arrow(&mut types, abstract_box, abstract_box); + let alpha_box = nominal(&mut types, 1, alpha); + let instance = arrow(&mut types, poly_box, alpha_box); + let inconsistent = arrow(&mut types, poly_box, mono_box); + let module = bare(types); + + let evidence = module + .checked_instantiation(scheme, &[parameter], instance) + .expect("an explicitly polymorphic argument is retained under a nominal constructor"); + assert!(module.types_equivalent(evidence.replacements[¶meter], poly)); + assert!( + module + .checked_instantiation(scheme, &[parameter], inconsistent) + .is_none() + ); + assert!( + module + .checked_instantiation(abstract_box, &[], poly_box) + .is_none() + ); + assert!( + module + .checked_instantiation(poly_box, &[], mono_box) + .is_none() + ); + assert!( + module + .checked_instantiation(mono_box, &[], poly_box) + .is_none() + ); +} + +#[test] +fn constructor_fields_preserve_an_explicit_universal_argument() { + let parameter = TypeVariableId(10); + let bound = TypeVariableId(11); + let mut types = vec![ + Type::Variable(parameter), + Type::Variable(bound), + Type::Constructor(TypeConstructor::Int), + ]; + let body = arrow(&mut types, TypeId(1), TypeId(1)); + let poly = forall(&mut types, vec![bound], body); + let mono = arrow(&mut types, TypeId(2), TypeId(2)); + let boxed = nominal(&mut types, 1, poly); + let constructor = SymbolId::new(ModuleId(0), 1); + for (field, accepted) in [(poly, true), (mono, false)] { + let mut types = types.clone(); + let ty = arrow(&mut types, field, boxed); + let mut module = bare(types); + module.constructors.push(ConstructorInfo { + symbol: constructor, + name: "Box".into(), + type_id: HirTypeId::new(ModuleId(0), 1), + tag: 0, + field_count: 1, + field_types: vec![TypeId(0)], + parameters: vec![parameter], + }); + module.declarations.push(Declaration { + symbol: SymbolId::new(ModuleId(0), 0), + name: "box".into(), + name_span: SPAN, + quantified: Vec::new(), + ty, + span: SPAN, + value: Expr { + ty, + span: SPAN, + kind: ExprKind::Lambda { + binder: Binder { + id: LocalId(0), + name: "value".into(), + ty: field, + span: SPAN, + }, + body: Box::new(Expr { + ty: boxed, + span: SPAN, + kind: ExprKind::Constructor { + symbol: constructor, + arguments: vec![Expr { + kind: ExprKind::Local(LocalId(0)), + ty: field, + span: SPAN, + }], + }, + }), + }, + }, + }); + assert_eq!(module.verify().is_ok(), accepted, "{module:?}"); + } +} diff --git a/crates/psrs-core/src/verify/types/matching/constructors.rs b/crates/psrs-core/src/verify/types/matching/constructors.rs index b6aa581b..978ff464 100644 --- a/crates/psrs-core/src/verify/types/matching/constructors.rs +++ b/crates/psrs-core/src/verify/types/matching/constructors.rs @@ -1,5 +1,5 @@ use super::{TypeMatcher, Variance}; -use crate::{Module, Type, TypeId}; +use crate::{Module, TypeId}; use std::collections::{HashMap, HashSet}; pub(in crate::verify) fn constructor_fields_match( @@ -23,12 +23,8 @@ pub(in crate::verify) fn constructor_fields_match( // A parameter may never appear as its own type node. Nullary constructors // still quantify it, and the pattern's type arguments are that instantiation. for (parameter, argument) in parameters.iter().zip(type_arguments) { - if matches!( - module.types.get(argument.0 as usize), - Some(Type::ForAll { .. }) - ) { - return false; - } + // Checked explicit arguments may themselves be universal types. Keep + // those binders intact when checking the constructor's field instances. if !matcher.bind_flexible(*parameter, *argument) { return false; } diff --git a/crates/psrs-core/src/verify/types/matching/invariant.rs b/crates/psrs-core/src/verify/types/matching/invariant.rs index 6385cebf..f580d017 100644 --- a/crates/psrs-core/src/verify/types/matching/invariant.rs +++ b/crates/psrs-core/src/verify/types/matching/invariant.rs @@ -52,11 +52,10 @@ impl TypeMatcher<'_> { { matches!(target_type, Type::Variable(other) if self.alpha_variables_match(*variable, *other)) } else if self.flexible.contains(variable) { - if matches!(target_type, Type::ForAll { .. }) { - false - } else { - self.bind_flexible(*variable, target) - } + // Replay an explicit checked type argument as a whole, including + // its quantifiers. Nominal invariance still checks every later + // occurrence against this same binding. + self.bind_flexible(*variable, target) } else { match target_type { Type::Variable(actual) if self.flexible.contains(actual) => { @@ -72,7 +71,6 @@ impl TypeMatcher<'_> { if let Type::Variable(variable) = target_type { let result = !self.alpha.values().any(|bound| bound == variable) && self.flexible.contains(variable) - && !matches!(source_type, Type::ForAll { .. }) && self.bind_flexible(*variable, source); self.active.remove(&(Variance::Invariant, source, target)); return result; diff --git a/crates/psrs-driver/src/tests/data_function.rs b/crates/psrs-driver/src/tests/data_function.rs index 2f6d0d42..da911c6b 100644 --- a/crates/psrs-driver/src/tests/data_function.rs +++ b/crates/psrs-driver/src/tests/data_function.rs @@ -7,6 +7,27 @@ use super::*; +#[test] +fn uncurried_foreign_signatures_retain_polymorphic_arguments_in_core() { + // Like Data.Number.fromStringImpl, this foreign signature supplies a + // checked universal argument to a parameterized uncurried newtype. + let source = r#" +module Main where +newtype Fn2 a b c = Fn2 (a -> b -> c) +run :: forall a b c. Fn2 a b c -> a -> b -> c +run (Fn2 f) a b = f a b +identity :: forall a. a -> a +identity x = x +foreign import choose :: Fn2 (forall a. a -> a) Int Int +main :: Int +main = run choose identity 42 +"#; + let core = lower_program_to_core(&[("Main.purs", source)]) + .expect("an explicit universal argument survives scheme instantiation"); + core.verify() + .expect("the checked foreign call remains valid Core"); +} + #[test] fn the_application_operators_resolve_through_the_library_re_export() { let source = r#" diff --git a/docs/design/frontend/type-system/type-inference.md b/docs/design/frontend/type-system/type-inference.md index dddd3858..6dc6eef3 100644 --- a/docs/design/frontend/type-system/type-inference.md +++ b/docs/design/frontend/type-system/type-inference.md @@ -110,6 +110,13 @@ polymorphic expression before solving the unknown, following the official checker's rule. Explicit polymorphic fields and annotations supply the boundaries at which a polymorphic value may be retained. +Core replays those checked explicit instantiations, including universal types +used as nominal constructor arguments. Its shared type matcher binds only the +declaration's flexible parameters and retains a replacement's complete `ForAll` +structure. Repeated occurrences must agree, constructor fields use the same +bindings, and nominal slots remain invariant. This replay does not change P5's +rule for solving unconstrained inference unknowns. + Rejected alternatives: pure HM cannot check higher-rank signatures; unifying a `forall` as though it were a monotype is unsound; generalizing recursive uses before group checking admits unsound polymorphic recursion; and carrying solver cells into THIR breaks the P5 boundary. Demanding that a signatureless declaration's constraints already be solved is rejected because it makes a hand-written signature a precondition for inferring a qualified type. Letting each feature module check kinds for itself is rejected because whether an operation is kind-corrected would then depend on the caller's path. ## Algorithms diff --git a/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md b/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md new file mode 100644 index 00000000..b675cbc9 --- /dev/null +++ b/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md @@ -0,0 +1,83 @@ +# Explicit polymorphic arguments in Core + +## Contract and repair + +The unchanged public `Data.Number.fromString "42.5"` wrapper stopped at P7 +Core verification. Its foreign implementation has a `Fn4` signature containing +explicit universal callback and result arguments. P5 retained those arguments, +but Core's shared invariant matcher rejected any flexible nominal parameter +whose replacement was `ForAll`. Constructor field checking had the same blanket +restriction. + +Core now retains the whole checked explicit replacement, including its binders. +The shared binding operation still owns occurrence checking and consistency +between repeated parameters. Nominal positions remain invariant; neither +direction admits replacing a universal slot with a specialized function. The +constructor checker uses the same operation for its explicit arguments and +field templates. No inference rule, official source, or library lock changes. + +The minimal checked-instantiation regression failed before the repair. Positive +and negative tests cover alpha-equivalent replacements, repeated-parameter +consistency, rigid parameters, specialized functions, constructor fields, and +occurrences hidden beneath quantifiers. A reduced source foreign declaration +with an uncurried newtype and a universal argument now survives Core lowering. +Existing rank-N source acceptance/rejection and mandatory Wasmtime execution +tests both pass, including rejection of inferred impredicative constructors. + +## Comparable public replay + +Both diagnoses use library revision +`2ee2d1fdaff8a2841824cd1bb5d3fb864f594630` and fingerprint +`fnv1a64-v1:801317111aa80a8f`: + +```purescript +module Main where +import Prelude +import Data.Number as Number +import Data.Maybe (Maybe(..)) +main :: Int +main = case Number.fromString "42.5" of + Just value -> if value == 42.5 then 42 else 1 + Nothing -> 1 +``` + +| Checkpoint | First blocker | +| --- | --- | +| Before | P7 Core verification: expression type inconsistent with context | +| After | P8 library linking: `Data.Number.fromStringImpl` has no target implementation | + +Raw diagnosis snapshots, replay inputs, and validation logs remain under +`/private/tmp/psrs-polymorphic-*` and `/private/tmp/psrs-number-parsing-*`. +They are not committed. This replay establishes removal of the P7 blocker; +it does not establish parsing behavior or whole-library compilation. + +## Rust validation + +`cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. +Focused Core tests and the reduced source +regression pass. `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test rank_n` +passes both source and execution tests. + +`CARGO_INCREMENTAL=0 PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` +completes all 52 target suites, including doc tests: 1674 passed, three existing +failures, and five ignored. The failures match the preceding checkpoint: + +- `dictionary_audit::execution::constrained_dictionary_parameters_precede_ordinary_arguments`: + the test cannot find its expected MIR constrained function. +- `tests::functions::runs_a_polymorphic_identity_with_a_number`: + its optimized WAT does not contain the asserted `f64` token. +- `tests::integration::compiles_if_expression_through_cfg_to_structured_wasm`: + its optimized constant branch does not contain the asserted `br_if` token. + +Full workspace validation is not green. No official scoreboard or gate +measurement is changed. + +## Remaining work + +Implement the missing parsing target with the official pure wrapper preserved. +The library owns prefix recognition and callback behavior; a checked decimal +conversion primitive may own correctly rounded binary64 conversion. Validate +against the pinned official JS FFI, including whitespace, accepted decimal +prefixes, malformed exponents, overflow, underflow, and signed zero. Other +Number foreign slots and whole-standard-library behavior remain separate work. diff --git a/docs/implementation/stdlib/number-rounding-2026-10-07.md b/docs/implementation/stdlib/number-rounding-2026-10-07.md index 759c39a5..f8e93592 100644 --- a/docs/implementation/stdlib/number-rounding-2026-10-07.md +++ b/docs/implementation/stdlib/number-rounding-2026-10-07.md @@ -97,9 +97,10 @@ public API programs. Raw environment-failed logs remain local for diagnosis. This is rounding acceptance, not whole-standard-library acceptance. A fresh public Number.fromString "42.5" reproducer currently stops at P7 Core -verification: Core expression type is inconsistent with its context. The -library-origin span covers runFn4 fromStringImpl in the unchanged official -wrapper. Root cause has not yet been established; do not replace that wrapper -or classify this as a missing parsing FFI implementation until Core checking -is resolved. Other Number FFI remains unsupported. No scoreboard or gate -measurement is changed by this focused behavior evidence. +verification at the rounding checkpoint. The subsequent +[explicit-polymorphic-argument repair](explicit-polymorphic-arguments-2026-10-07.md) +resolves that mismatch with the official wrapper unchanged. The same locked +reproducer now stops at P8 library linking because `Data.Number.fromStringImpl` +has no target implementation. Parsing behavior and other Number FFI remain +unverified. No scoreboard or gate measurement is changed by this focused +behavior evidence. From 131a1fe37ed14eebf4b2acb592cb745ebc811808 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 21:04:54 +0800 Subject: [PATCH 070/148] Support checked decimal conversion and official Number parsing behavior --- crates/psrs-backend/src/abi/mod.rs | 6 +- crates/psrs-backend/src/cc/lower/intrinsic.rs | 10 + crates/psrs-backend/src/cc/mod.rs | 4 + crates/psrs-backend/src/cc/verify/ops/mod.rs | 10 + .../psrs-backend/src/cc/verify/tests/mod.rs | 1 + .../src/cc/verify/tests/number_decimal.rs | 41 ++++ .../psrs-backend/src/mir/lower/assignments.rs | 8 + .../src/mir/lower/number_string.rs | 40 ++- crates/psrs-backend/src/mir/mod.rs | 6 +- .../src/mir/reachable/assignments.rs | 1 + crates/psrs-backend/src/mir/wit/mod.rs | 1 + .../src/mir/wit/parameters/mod.rs | 2 +- crates/psrs-backend/src/target_runtime.rs | 21 +- crates/psrs-core/src/opt/effects.rs | 3 + crates/psrs-core/src/verify/types/mod.rs | 1 + crates/psrs-driver/src/tests/mod.rs | 1 + .../psrs-driver/src/tests/number_decimal.rs | 102 ++++++++ crates/psrs-driver/src/tests/show.rs | 6 +- crates/psrs-hir/src/intrinsic/mod.rs | 7 +- crates/psrs-hir/src/intrinsic/registry.rs | 5 + crates/psrs-linker/src/lib.rs | 6 +- crates/psrs-linker/src/runtime.rs | 15 +- .../src/{stack.rs => stack/mod.rs} | 230 ++++-------------- crates/psrs-linker/src/stack/tests.rs | 215 ++++++++++++++++ crates/psrs-linker/src/target.rs | 9 + crates/psrs-linker/src/verify/parse.rs | 36 ++- crates/psrs-linker/src/verify/tests.rs | 70 ++++-- crates/psrs-linker/tests/compose.rs | 6 +- crates/psrs-linker/tests/plan.rs | 14 +- crates/psrs-runtime/Cargo.toml | 2 +- .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 14239 -> 35910 bytes crates/psrs-runtime/src/catalog.rs | 49 ++-- crates/psrs-runtime/src/decimal.rs | 67 +++++ crates/psrs-runtime/src/lib.rs | 28 ++- .../backend/fp/scalars-and-primitives.md | 26 ++ .../backend/wasm/linking-and-runtime.md | 22 +- ...plicit-polymorphic-arguments-2026-10-07.md | 4 + .../stdlib/number-parsing-2026-10-07.md | 115 +++++++++ .../stdlib/number-rounding-2026-10-07.md | 4 + stdlib.lock.json | 4 +- 40 files changed, 925 insertions(+), 273 deletions(-) create mode 100644 crates/psrs-backend/src/cc/verify/tests/number_decimal.rs create mode 100644 crates/psrs-driver/src/tests/number_decimal.rs rename crates/psrs-linker/src/{stack.rs => stack/mod.rs} (58%) create mode 100644 crates/psrs-linker/src/stack/tests.rs create mode 100644 crates/psrs-runtime/src/decimal.rs create mode 100644 docs/implementation/stdlib/number-parsing-2026-10-07.md diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index 41470b4d..37c86cef 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -106,12 +106,16 @@ pub(crate) const VALIDATE_STEP_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRIN pub(crate) const NUMBER_TO_STRING_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 5); -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 5] = [ +pub(crate) const NUMBER_FROM_DECIMAL_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 6); + +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 6] = [ REALLOC_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, VALIDATE_STEP_SYMBOL, NUMBER_TO_STRING_SYMBOL, + NUMBER_FROM_DECIMAL_SYMBOL, ]; /// WASI interfaces and functions the backend itself references. The standard diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 6d21ac79..0f3043f2 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -31,6 +31,16 @@ impl FunctionLowerer<'_> { }); Ok(destination) } + Intrinsic::NumberFromDecimal => { + let value = self.lower_value(&arguments[0], assignments)?; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::NumberFromDecimal { value }, + span: expression.span, + }); + Ok(destination) + } Intrinsic::ArrayIndex => { let array = &arguments[0]; let Some(representation) = self.array_types.get(&array.ty).copied() else { diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index bcb1f37b..257864e7 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -190,6 +190,10 @@ pub enum AssignmentKind { NumberToString { value: ValueId, }, + /// Checked complete-decimal conversion through the numeric runtime. + NumberFromDecimal { + value: ValueId, + }, /// An `Array Int` read as a source `String`. Every element must be a /// canonical byte and the bytes must be well-formed UTF-8. BytesToString { diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index a908ae98..8b87199d 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -95,6 +95,16 @@ pub(super) fn verify_assignments( )?; uses.push(*value); } + AssignmentKind::NumberFromDecimal { value } => { + require_value_shape(declared, *value, ValueShape::String, assignment)?; + require_destination( + declared, + assignment, + ValueShape::Number, + "numberFromDecimal produces Number", + )?; + uses.push(*value); + } AssignmentKind::Unary { op, value } => { verify_unary_operation(*op, *value, assignment, declared)?; uses.push(*value); diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index f126226a..43cc91ee 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -6,6 +6,7 @@ use psrs_span::TextRange; mod adaptation; mod dictionary; mod effects; +mod number_decimal; mod string_eq; mod structure; mod variant; diff --git a/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs b/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs new file mode 100644 index 00000000..b15f2cba --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs @@ -0,0 +1,41 @@ +use super::*; + +#[test] +fn decimal_conversion_checks_both_shapes_before_abi_erasure() { + let input = super::super::super::ValueId(0); + let output = super::super::super::ValueId(1); + for (operand, result, valid) in [ + (ValueShape::String, ValueShape::Number, true), + (ValueShape::Integer, ValueShape::Number, false), + (ValueShape::Number, ValueShape::Number, false), + (ValueShape::String, ValueShape::Integer, false), + ] { + let function = Function { + symbol: symbol(0), + name: "decimal".into(), + parameters: vec![input], + values: vec![ + ValueDecl { + id: input, + ty: operand, + }, + ValueDecl { + id: output, + ty: result, + }, + ], + assignments: vec![Assignment { + destination: output, + kind: AssignmentKind::NumberFromDecimal { value: input }, + span: TextRange::new(0, 1), + }], + result: output, + result_type: result, + span: TextRange::new(0, 1), + }; + assert_eq!( + verify_function(&function, &HashMap::new(), &table()).is_ok(), + valid + ); + } +} diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index f2dd1b38..cc8e1bb7 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -108,6 +108,14 @@ impl FunctionLowerer<'_> { assignment.span, )?; } + AssignmentKind::NumberFromDecimal { value } => { + self.lower_number_from_decimal( + current, + assignment.destination, + *value, + assignment.span, + )?; + } AssignmentKind::Unary { op, value } => self.append_instruction( current, Instruction::UnaryPrimitive { diff --git a/crates/psrs-backend/src/mir/lower/number_string.rs b/crates/psrs-backend/src/mir/lower/number_string.rs index 8a11e1e9..92214f15 100644 --- a/crates/psrs-backend/src/mir/lower/number_string.rs +++ b/crates/psrs-backend/src/mir/lower/number_string.rs @@ -2,6 +2,44 @@ use super::*; impl FunctionLowerer<'_> { + pub(super) fn lower_number_from_decimal( + &mut self, + block: BlockId, + destination: ValueId, + value: ValueId, + span: TextRange, + ) -> Result<(), Vec> { + let implementation = + crate::target_runtime::implementation(psrs_hir::Intrinsic::NumberFromDecimal) + .expect("NumberFromDecimal has a registered target implementation"); + let mut arguments = Vec::new(); + let mut frees = Vec::new(); + // The same canonical UTF-8 copy and release protocol serves WIT calls + // and this private raw runtime call. The runtime retains no pointer. + crate::mir::wit::lower_string(self, value, &mut arguments, &mut frees, block, span)?; + self.append_instruction( + block, + Instruction::Call { + destination, + function: implementation.symbol, + arguments, + span, + }, + span, + )?; + for pending in frees { + crate::mir::wit::free_buffer( + self, + pending.pointer, + pending.length, + pending.align, + block, + span, + )?; + } + Ok(()) + } + pub(super) fn lower_number_to_string( &mut self, block: BlockId, @@ -14,7 +52,7 @@ impl FunctionLowerer<'_> { .expect("NumberToString has a registered target implementation"); let zero = self.constant(block, 0, span)?; let align = self.constant(block, 1, span)?; - let capacity = self.constant(block, implementation.abi.output_capacity as i32, span)?; + let capacity = self.constant(block, psrs_runtime::NUMBER_CAPACITY as i32, span)?; let buffer = self.fresh(ValueType::I32); self.append_instruction( block, diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 18f932be..fb16e695 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -348,8 +348,10 @@ fn lower_module_after_binding_validation( result: Some(ValueType::I32), }); } - if used.contains(&crate::target_runtime::NUMBER_FORMAT.symbol) { - imports.push(crate::target_runtime::NUMBER_FORMAT.import()); + for implementation in crate::target_runtime::IMPLEMENTATIONS { + if used.contains(&implementation.symbol) { + imports.push(implementation.import()); + } } // The canonical ABI boundary transcodes between the GC string's UTF-16 and // the component's UTF-8. The adapter calls these reserved helpers, which P10 diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index 9dfaabdc..aac94a2a 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -135,6 +135,7 @@ pub(super) fn add_assignments( | AssignmentKind::Primitive { .. } | AssignmentKind::Unary { .. } | AssignmentKind::NumberToString { .. } + | AssignmentKind::NumberFromDecimal { .. } | AssignmentKind::ArrayLen { .. } | AssignmentKind::Unreachable => {} AssignmentKind::ClosureGetCapture { .. } => { diff --git a/crates/psrs-backend/src/mir/wit/mod.rs b/crates/psrs-backend/src/mir/wit/mod.rs index efc251ef..a7cb4e8f 100644 --- a/crates/psrs-backend/src/mir/wit/mod.rs +++ b/crates/psrs-backend/src/mir/wit/mod.rs @@ -18,6 +18,7 @@ mod parameters; pub(super) use bind::BoundFn; pub(super) use call_lowerer::WitCallLowerer; pub(super) use handles::verify_function; +pub(super) use parameters::lower_string; use super::{BlockId, instruction::Instruction}; use crate::BackendError; diff --git a/crates/psrs-backend/src/mir/wit/parameters/mod.rs b/crates/psrs-backend/src/mir/wit/parameters/mod.rs index 378e2b42..dfb45df4 100644 --- a/crates/psrs-backend/src/mir/wit/parameters/mod.rs +++ b/crates/psrs-backend/src/mir/wit/parameters/mod.rs @@ -198,7 +198,7 @@ pub(super) fn lower_parameter( /// Copies a GC string's canonical UTF-8 bytes into a fresh linear buffer. The /// helper returns the address of a length prefix; the canonical exchange passes /// the payload pointer and byte length, and the buffer is freed after the call. -fn lower_string( +pub(in crate::mir) fn lower_string( lowerer: &mut L, argument: ValueId, flat: &mut Vec, diff --git a/crates/psrs-backend/src/target_runtime.rs b/crates/psrs-backend/src/target_runtime.rs index 94d9fc5a..efe1413e 100644 --- a/crates/psrs-backend/src/target_runtime.rs +++ b/crates/psrs-backend/src/target_runtime.rs @@ -14,7 +14,7 @@ use psrs_linker::{ pub(crate) struct Implementation { pub intrinsic: Intrinsic, pub symbol: SymbolId, - pub abi: &'static psrs_runtime::FormatterAbi, + pub abi: &'static psrs_runtime::NumericAbi, pub artifact: &'static psrs_runtime::RuntimeArtifact, } @@ -22,17 +22,30 @@ pub(crate) const NUMBER_FORMAT: Implementation = Implementation { intrinsic: Intrinsic::NumberToString, symbol: crate::abi::NUMBER_TO_STRING_SYMBOL, abi: &psrs_runtime::NUMBER_FORMAT, - artifact: &psrs_runtime::NUMBER_FORMATTER, + artifact: &psrs_runtime::NUMBER_RUNTIME, }; +pub(crate) const NUMBER_PARSE: Implementation = Implementation { + intrinsic: Intrinsic::NumberFromDecimal, + symbol: crate::abi::NUMBER_FROM_DECIMAL_SYMBOL, + abi: &psrs_runtime::NUMBER_PARSE, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const IMPLEMENTATIONS: [&Implementation; 2] = [&NUMBER_FORMAT, &NUMBER_PARSE]; + /// The registered implementation for a checked intrinsic, if any. pub(crate) fn implementation(intrinsic: Intrinsic) -> Option<&'static Implementation> { - (intrinsic == NUMBER_FORMAT.intrinsic).then_some(&NUMBER_FORMAT) + IMPLEMENTATIONS + .into_iter() + .find(|implementation| intrinsic == implementation.intrinsic) } /// The registered implementation for a MIR import symbol, if any. pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static Implementation> { - (symbol == NUMBER_FORMAT.symbol).then_some(&NUMBER_FORMAT) + IMPLEMENTATIONS + .into_iter() + .find(|implementation| symbol == implementation.symbol) } impl Implementation { diff --git a/crates/psrs-core/src/opt/effects.rs b/crates/psrs-core/src/opt/effects.rs index 7abd8a24..65d33422 100644 --- a/crates/psrs-core/src/opt/effects.rs +++ b/crates/psrs-core/src/opt/effects.rs @@ -118,6 +118,7 @@ fn combine_all(effects: impl IntoIterator) -> Effects { /// Whether an intrinsic can trap. The byte conversions validate their input, /// the array operations can trap on a missing or out-of-range index, and the /// truncating and Euclidean division operations trap on a zero divisor. +/// Numeric string conversions can trap while allocating transient buffers. fn intrinsic_may_trap(intrinsic: Intrinsic) -> bool { matches!( intrinsic, @@ -127,6 +128,8 @@ fn intrinsic_may_trap(intrinsic: Intrinsic) -> bool { | Intrinsic::ArrayWrite | Intrinsic::StringToBytes | Intrinsic::BytesToString + | Intrinsic::NumberFromDecimal + | Intrinsic::NumberToString | Intrinsic::I32DivS | Intrinsic::I32RemS | Intrinsic::IntDiv diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 88c990d5..8f71a1c8 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -84,6 +84,7 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), Intrinsic::NumberToString => (Number, String), + Intrinsic::NumberFromDecimal => (String, Number), Intrinsic::BooleanToInt => (Boolean, Int), Intrinsic::IntToBoolean => (Int, Boolean), Intrinsic::CharToInt => (Char, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 049797b9..7facf851 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -19,6 +19,7 @@ mod functor; mod guard_coverage; mod let_constraints; mod library_foreign; +mod number_decimal; mod number_rounding; mod number_trunc; mod operators; diff --git a/crates/psrs-driver/src/tests/number_decimal.rs b/crates/psrs-driver/src/tests/number_decimal.rs new file mode 100644 index 00000000..e0a4ccc5 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_decimal.rs @@ -0,0 +1,102 @@ +use super::*; + +#[test] +fn public_number_from_string_executes_the_official_uncurried_wrapper() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +import Data.Maybe (Maybe(..)) +main :: Int +main = case Number.fromString "42.5" of + Just value -> if value == 42.5 then 42 else 1 + Nothing -> 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn complete_decimal_conversion_preserves_rounding_range_and_zero_signs() { + let source = r#" +module Main where +foreign import "psrs:intrinsic#numberFromDecimal" parse :: String -> Number +foreign import "psrs:intrinsic#numberEq" equal :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#numberDiv" divide :: Number -> Number -> Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +foreign import "psrs:intrinsic#booleanAnd" both :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#numberNe" unequal :: Number -> Number -> Boolean +invalid value = let number = parse value in unequal number number +precision = both (equal (parse "9007199254740993") 9007199254740992.0) + (equal (parse "1.00000000000000011102230246251565404236316680908203125") 1.0) +range = both (equal (parse "5e-324") 5.0e-324) (equal (parse "1e309") (divide 1.0 0.0)) +zeros = equal (divide 1.0 (parse "-1e-9999")) (divide (negative 1.0) 0.0) +grammar = both (invalid "42.5tail") (both (invalid "Infinity") (both (invalid " 42.5") (invalid "1e+"))) +main = if both precision (both range (both zeros grammar)) then 42 else 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn decimal_foreign_bindings_require_string_operand_and_number_result() { + for ty in [ + "Int -> Number", + "String -> Int", + "Number -> Number", + "forall a. a -> a", + ] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberFromDecimal\" parse :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("invalid decimal primitive contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} + +#[test] +fn explicit_type_applications_retain_universal_newtype_arguments() { + let source = r#" +module Main where +newtype Wrapper a b = Wrapper (a -> b) +make :: forall @a @b. (a -> b) -> Wrapper a b +make f = Wrapper f +makePoly :: forall @b. ((forall a. a -> a) -> b) -> Wrapper (forall a. a -> a) b +makePoly = make @(forall a. a -> a) +apply :: (forall a. a -> a) -> Int +apply f = if f true then f 42 else 1 +wrapped :: Wrapper (forall a. a -> a) Int +wrapped = makePoly @Int apply +run :: forall a b. Wrapper a b -> a -> b +run (Wrapper f) value = f value +main :: Int +main = run wrapped (\x -> x) +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); + let invalid = r#" +module Main where +data Box a = Box a +make :: forall @a. a -> Box a +make value = Box value +wrapped :: Box (forall a. a -> a) +wrapped = make @(forall a. a -> a) (\x -> 42) +main :: Int +main = 42 +"#; + assert!(compile_source("Main.purs", invalid).is_err()); +} diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index 0da351f2..b4b8f7d1 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -119,7 +119,11 @@ main = let ignored = log (show 1.0e21) in 0 }; assert_eq!(parameter("artifacts"), Some("1")); let digests = parameter("artifact_digests").expect("artifact digests are recorded"); - assert!(digests.contains("psrs:runtime-number-format"), "{digests}"); + assert!(digests.contains("psrs:runtime-number"), "{digests}"); + assert!( + digests.contains("c6d50a6b005471bca9777562860cd8a3b2fc1ba5227126f755ee0d10297408de"), + "{digests}" + ); assert!( parameter("selected_providers") .expect("selected providers are recorded") diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 3372d055..33026e31 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -108,6 +108,8 @@ pub enum Intrinsic { NumberFloor, /// Round a Number toward positive infinity. NumberCeil, + /// Convert a complete ASCII decimal token to binary64; invalid tokens return NaN. + NumberFromDecimal, } impl Intrinsic { @@ -130,7 +132,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 67] = [ + pub const ALL: [Intrinsic; 68] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -198,6 +200,7 @@ impl Intrinsic { Intrinsic::NumberTrunc, Intrinsic::NumberFloor, Intrinsic::NumberCeil, + Intrinsic::NumberFromDecimal, ]; } @@ -206,7 +209,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::NumberCeil as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::NumberFromDecimal as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 948f4386..4b9ce4de 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -152,6 +152,7 @@ descriptors! { ArrayFill => "arrayFill", 2, ArrayFill, scheme::array_fill; ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; NumberToString => "numberToString", 1, UnaryScalar, scheme::number_string; + NumberFromDecimal => "numberFromDecimal", 1, UnaryScalar, scheme::string_number; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that @@ -283,6 +284,10 @@ mod scheme { unary(BuiltinType::Int, BuiltinType::Number) } + pub(super) fn string_number() -> Type { + unary(BuiltinType::String, BuiltinType::Number) + } + pub(super) fn number_string() -> Type { unary(BuiltinType::Number, BuiltinType::String) } diff --git a/crates/psrs-linker/src/lib.rs b/crates/psrs-linker/src/lib.rs index 0c01f509..85a8ce87 100644 --- a/crates/psrs-linker/src/lib.rs +++ b/crates/psrs-linker/src/lib.rs @@ -34,8 +34,8 @@ pub use plan::{CheckedLinkPlan, MemoryPlan, ResolvedBinding, plan}; pub use stack::{StackBound, measure_stack_bound}; pub use target::{ ArtifactContract, ArtifactKind, ArtifactReference, BindingRequirement, Boundary, CoreSignature, - CoreType, DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, - ImportKind, InitializationContract, MemoryDemand, Provider, RequirementId, StorageContract, - StorageRegion, TargetLinkInput, TargetPolicy, + CoreType, DeclaredElement, DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, + ExportKind, ImportKind, InitializationContract, MemoryDemand, Provider, RequirementId, + StorageContract, StorageRegion, TargetLinkInput, TargetPolicy, }; pub use verify::{VerifiedArtifact, verify_artifact}; diff --git a/crates/psrs-linker/src/runtime.rs b/crates/psrs-linker/src/runtime.rs index 8bf91375..97162a00 100644 --- a/crates/psrs-linker/src/runtime.rs +++ b/crates/psrs-linker/src/runtime.rs @@ -4,15 +4,24 @@ //! contract it verifies and plans against. use crate::target::{ - ArtifactContract, ArtifactKind, CoreSignature, CoreType, DeclaredExport, DeclaredGlobal, - DeclaredImport, DeclaredTable, ExportKind, ImportKind, InitializationContract, StorageContract, - StorageRegion, + ArtifactContract, ArtifactKind, CoreSignature, CoreType, DeclaredElement, DeclaredExport, + DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, ImportKind, InitializationContract, + StorageContract, StorageRegion, }; use psrs_runtime::{RawType, RuntimeArtifact}; /// Maps a catalog artifact into the contract its bytes must satisfy. pub fn contract(artifact: &RuntimeArtifact) -> ArtifactContract { ArtifactContract { + elements: artifact + .elements + .iter() + .map(|element| DeclaredElement { + table: element.table, + offset: element.offset, + functions: element.functions.to_vec(), + }) + .collect(), id: artifact.id.to_string(), kind: ArtifactKind::CoreModule, module_name: artifact.module_name.to_string(), diff --git a/crates/psrs-linker/src/stack.rs b/crates/psrs-linker/src/stack/mod.rs similarity index 58% rename from crates/psrs-linker/src/stack.rs rename to crates/psrs-linker/src/stack/mod.rs index d8e33b51..3a55970e 100644 --- a/crates/psrs-linker/src/stack.rs +++ b/crates/psrs-linker/src/stack/mod.rs @@ -2,8 +2,8 @@ //! //! Each function's prologue subtracts its frame size from the stack-pointer //! global. The maximum bytes an artifact can use is the largest sum of frame -//! sizes along any call path. A call graph with a cycle is not a supported -//! artifact and is rejected rather than bounded. +//! sizes along a path reachable from an exported function or start function. +//! Reachable cycles and indirect calls are rejected rather than bounded. use wasmparser::{Operator, Parser, Payload}; @@ -18,6 +18,8 @@ pub struct StackBound { /// `stack_pointer_global` is the mutable global whose prologue adjustment /// reserves a frame. Indirect calls and calls into imported functions make the /// bound unknown, so they are errors rather than silent under-approximations. +/// Exported tables are also rejected: callers could otherwise enter a private +/// function through them. Modules with no entry points are analyzed in full. pub fn measure_stack_bound(bytes: &[u8], stack_pointer_global: u32) -> Result { // Exception and suspension proposals require a separate frame-unwind // proof. They cannot enter this normal-return-only analysis. @@ -35,8 +37,8 @@ pub fn measure_stack_bound(bytes: &[u8], stack_pointer_global: u32) -> Result Result { - let (frame, calls) = analyze_body(&body, stack_pointer_global)?; - frames.push(frame); - callees.push(calls); + bodies.push(analyze_body(&body, stack_pointer_global)); } + Payload::ExportSection(reader) => { + for export in reader { + let export = export.map_err(|error| error.to_string())?; + match export.kind { + wasmparser::ExternalKind::Func => roots.push(export.index), + wasmparser::ExternalKind::Table => { + return Err( + "an exported table makes runtime entry points unknown".into() + ); + } + _ => {} + } + } + } + Payload::StartSection { func, .. } => roots.push(func), _ => {} } } - let count = frames.len(); + let count = bodies.len(); + // A private function can only execute through an entry point's call graph. + // Unsupported indirect calls are still rejected on every reachable path. + // Definition-only test modules retain conservative whole-module analysis. + if roots.is_empty() { + roots.extend((0..count).map(|index| index as u32 + imported_functions as u32)); + } let mut memo = vec![None::; count]; let mut visiting = vec![false; count]; let mut bound = 0_u32; - for index in 0..count { + for root in roots { + let index = (root as usize) + .checked_sub(imported_functions) + .filter(|index| *index < count) + .ok_or("an imported or unknown entry point makes the stack bound unknown")?; bound = bound.max(visit( index, - &frames, - &callees, + &bodies, &mut memo, &mut visiting, imported_functions, @@ -224,8 +248,7 @@ fn analyze_body( fn visit( index: usize, - frames: &[u32], - callees: &[Vec], + bodies: &[Result<(u32, Vec), String>], memo: &mut [Option], visiting: &mut [bool], imported_functions: usize, @@ -237,194 +260,25 @@ fn visit( return Err("a recursive call graph is not a supported runtime library".into()); } visiting[index] = true; + let (frame, callees) = bodies[index].as_ref().map_err(Clone::clone)?; let mut deepest = 0_u32; - for callee in &callees[index] { + for callee in callees { let callee = *callee as usize; if callee < imported_functions { return Err("a call into an imported function makes the stack bound unknown".into()); } let defined = callee - imported_functions; - if defined < frames.len() { - deepest = deepest.max(visit( - defined, - frames, - callees, - memo, - visiting, - imported_functions, - )?); + if defined < bodies.len() { + deepest = deepest.max(visit(defined, bodies, memo, visiting, imported_functions)?); } else { return Err("callee is outside the analyzed module".into()); } } visiting[index] = false; - let total = frames[index] - .checked_add(deepest) - .ok_or("stack bound overflows")?; + let total = frame.checked_add(deepest).ok_or("stack bound overflows")?; memo[index] = Some(total); Ok(total) } #[cfg(test)] -mod tests { - use super::*; - - #[test] - fn the_runtime_artifact_has_a_measured_static_bound() { - let bound = measure_stack_bound(psrs_runtime::NUMBER_FORMATTER.bytes, 0) - .expect("the formatter is nonrecursive"); - assert_eq!( - bound.bytes, - psrs_runtime::NUMBER_FORMATTER.storage.stack_bound_bytes, - "the declared stack bound must match the static analysis" - ); - } - - #[test] - fn a_recursive_graph_is_rejected() { - // Two mutually recursive functions, each reserving a frame. - let bytes = recursive_module(); - assert!( - measure_stack_bound(&bytes, 0) - .unwrap_err() - .contains("recursive call graph") - ); - } - - #[test] - fn unrecognized_stack_writes_and_unbalanced_frames_are_rejected() { - use wasm_encoder::Instruction as I; - let prologue = [ - I::GlobalGet(0), - I::I32Const(32), - I::I32Sub, - I::LocalTee(0), - I::GlobalSet(0), - ]; - for suffix in [ - vec![I::I32Const(1), I::GlobalSet(0)], - vec![I::Return], - vec![I::Br(0)], - vec![I::I32Const(9), I::LocalSet(0)], - vec![I::GlobalGet(0), I::I32Const(32), I::I32Sub, I::GlobalSet(0)], - vec![], - ] { - let mut ops = prologue.to_vec(); - ops.extend(suffix); - assert!(measure_stack_bound(&single_function(&ops), 0).is_err()); - } - assert!( - measure_stack_bound(&single_function(&[I::I32Const(5), I::GlobalSet(0)]), 0).is_err() - ); - } - - #[test] - fn a_reference_branch_cannot_bypass_an_otherwise_valid_restoration() { - use wasm_encoder::Instruction as I; - let ops = [ - I::GlobalGet(0), - I::I32Const(32), - I::I32Sub, - I::LocalTee(0), - I::GlobalSet(0), - I::RefNull(wasm_encoder::HeapType::FUNC), - I::BrOnNull(0), - I::Drop, - I::LocalGet(0), - I::I32Const(32), - I::I32Add, - I::GlobalSet(0), - ]; - let bytes = single_function(&ops); - wasmparser::Validator::new() - .validate_all(&bytes) - .expect("valid module"); - assert!( - measure_stack_bound(&bytes, 0) - .unwrap_err() - .contains("branch bypasses") - ); - } - - fn single_function(ops: &[wasm_encoder::Instruction<'_>]) -> Vec { - use wasm_encoder::*; - let mut module = Module::new(); - let mut types = TypeSection::new(); - types.ty().function([], []); - module.section(&types); - let mut functions = FunctionSection::new(); - functions.function(0); - module.section(&functions); - let mut globals = GlobalSection::new(); - globals.global( - GlobalType { - val_type: ValType::I32, - mutable: true, - shared: false, - }, - &ConstExpr::i32_const(1024), - ); - module.section(&globals); - let mut function = Function::new([(1, ValType::I32)]); - for op in ops { - function.instruction(op); - } - function.instruction(&Instruction::End); - let mut code = CodeSection::new(); - code.function(&function); - module.section(&code); - module.finish() - } - - fn recursive_module() -> Vec { - use wasm_encoder::{ - CodeSection, Function, FunctionSection, GlobalSection, GlobalType, Instruction, Module, - TypeSection, ValType, - }; - let mut module = Module::new(); - let mut types = TypeSection::new(); - types.ty().function([], []); - module.section(&types); - let mut functions = FunctionSection::new(); - functions.function(0); - functions.function(0); - module.section(&functions); - let mut globals = GlobalSection::new(); - globals.global( - GlobalType { - val_type: ValType::I32, - mutable: true, - shared: false, - }, - &wasm_encoder::ConstExpr::i32_const(1024), - ); - module.section(&globals); - let mut code = CodeSection::new(); - let mut first = Function::new([]); - first.instruction(&Instruction::GlobalGet(0)); - first.instruction(&Instruction::I32Const(32)); - first.instruction(&Instruction::I32Sub); - first.instruction(&Instruction::GlobalSet(0)); - first.instruction(&Instruction::Call(1)); - first.instruction(&Instruction::GlobalGet(0)); - first.instruction(&Instruction::I32Const(32)); - first.instruction(&Instruction::I32Add); - first.instruction(&Instruction::GlobalSet(0)); - first.instruction(&Instruction::End); - code.function(&first); - let mut second = Function::new([]); - second.instruction(&Instruction::GlobalGet(0)); - second.instruction(&Instruction::I32Const(32)); - second.instruction(&Instruction::I32Sub); - second.instruction(&Instruction::GlobalSet(0)); - second.instruction(&Instruction::Call(0)); - second.instruction(&Instruction::GlobalGet(0)); - second.instruction(&Instruction::I32Const(32)); - second.instruction(&Instruction::I32Add); - second.instruction(&Instruction::GlobalSet(0)); - second.instruction(&Instruction::End); - code.function(&second); - module.section(&code); - module.finish() - } -} +mod tests; diff --git a/crates/psrs-linker/src/stack/tests.rs b/crates/psrs-linker/src/stack/tests.rs new file mode 100644 index 00000000..c6c044c6 --- /dev/null +++ b/crates/psrs-linker/src/stack/tests.rs @@ -0,0 +1,215 @@ +use super::*; + +#[test] +fn bounds_cover_exported_entry_points_and_every_reachable_private_function() { + for (export, call_private, export_table, accepted) in [ + (0, false, false, true), + (1, false, false, false), + (0, true, false, false), + (0, false, true, false), + ] { + let bytes = entry_module(export, call_private, export_table); + assert_eq!(measure_stack_bound(&bytes, 0).is_ok(), accepted); + } +} + +fn entry_module(export: u32, call_private: bool, export_table: bool) -> Vec { + use wasm_encoder::*; + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], []); + module.section(&types); + let mut functions = FunctionSection::new(); + functions.function(0); + functions.function(0); + module.section(&functions); + let mut tables = TableSection::new(); + tables.table(TableType { + element_type: RefType::FUNCREF, + minimum: 1, + maximum: Some(1), + table64: false, + shared: false, + }); + module.section(&tables); + let mut exports = ExportSection::new(); + exports.export("entry", ExportKind::Func, export); + if export_table { + exports.export("table", ExportKind::Table, 0); + } + module.section(&exports); + let mut code = CodeSection::new(); + let mut entry = Function::new([]); + if call_private { + entry.instruction(&Instruction::Call(1)); + } + entry.instruction(&Instruction::End); + code.function(&entry); + let mut private = Function::new([]); + private.instruction(&Instruction::I32Const(0)); + private.instruction(&Instruction::CallIndirect { + type_index: 0, + table_index: 0, + }); + private.instruction(&Instruction::End); + code.function(&private); + module.section(&code); + module.finish() +} + +#[test] +fn the_runtime_artifact_has_a_measured_static_bound() { + let bound = measure_stack_bound(psrs_runtime::NUMBER_RUNTIME.bytes, 0) + .expect("the numeric runtime is nonrecursive"); + assert_eq!( + bound.bytes, + psrs_runtime::NUMBER_RUNTIME.storage.stack_bound_bytes, + "the declared stack bound must match the static analysis" + ); +} + +#[test] +fn a_recursive_graph_is_rejected() { + // Two mutually recursive functions, each reserving a frame. + let bytes = recursive_module(); + assert!( + measure_stack_bound(&bytes, 0) + .unwrap_err() + .contains("recursive call graph") + ); +} + +#[test] +fn unrecognized_stack_writes_and_unbalanced_frames_are_rejected() { + use wasm_encoder::Instruction as I; + let prologue = [ + I::GlobalGet(0), + I::I32Const(32), + I::I32Sub, + I::LocalTee(0), + I::GlobalSet(0), + ]; + for suffix in [ + vec![I::I32Const(1), I::GlobalSet(0)], + vec![I::Return], + vec![I::Br(0)], + vec![I::I32Const(9), I::LocalSet(0)], + vec![I::GlobalGet(0), I::I32Const(32), I::I32Sub, I::GlobalSet(0)], + vec![], + ] { + let mut ops = prologue.to_vec(); + ops.extend(suffix); + assert!(measure_stack_bound(&single_function(&ops), 0).is_err()); + } + assert!(measure_stack_bound(&single_function(&[I::I32Const(5), I::GlobalSet(0)]), 0).is_err()); +} + +#[test] +fn a_reference_branch_cannot_bypass_an_otherwise_valid_restoration() { + use wasm_encoder::Instruction as I; + let ops = [ + I::GlobalGet(0), + I::I32Const(32), + I::I32Sub, + I::LocalTee(0), + I::GlobalSet(0), + I::RefNull(wasm_encoder::HeapType::FUNC), + I::BrOnNull(0), + I::Drop, + I::LocalGet(0), + I::I32Const(32), + I::I32Add, + I::GlobalSet(0), + ]; + let bytes = single_function(&ops); + wasmparser::Validator::new() + .validate_all(&bytes) + .expect("valid module"); + assert!( + measure_stack_bound(&bytes, 0) + .unwrap_err() + .contains("branch bypasses") + ); +} + +fn single_function(ops: &[wasm_encoder::Instruction<'_>]) -> Vec { + use wasm_encoder::*; + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], []); + module.section(&types); + let mut functions = FunctionSection::new(); + functions.function(0); + module.section(&functions); + let mut globals = GlobalSection::new(); + globals.global( + GlobalType { + val_type: ValType::I32, + mutable: true, + shared: false, + }, + &ConstExpr::i32_const(1024), + ); + module.section(&globals); + let mut function = Function::new([(1, ValType::I32)]); + for op in ops { + function.instruction(op); + } + function.instruction(&Instruction::End); + let mut code = CodeSection::new(); + code.function(&function); + module.section(&code); + module.finish() +} + +fn recursive_module() -> Vec { + use wasm_encoder::{ + CodeSection, Function, FunctionSection, GlobalSection, GlobalType, Instruction, Module, + TypeSection, ValType, + }; + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], []); + module.section(&types); + let mut functions = FunctionSection::new(); + functions.function(0); + functions.function(0); + module.section(&functions); + let mut globals = GlobalSection::new(); + globals.global( + GlobalType { + val_type: ValType::I32, + mutable: true, + shared: false, + }, + &wasm_encoder::ConstExpr::i32_const(1024), + ); + module.section(&globals); + let mut code = CodeSection::new(); + let mut first = Function::new([]); + first.instruction(&Instruction::GlobalGet(0)); + first.instruction(&Instruction::I32Const(32)); + first.instruction(&Instruction::I32Sub); + first.instruction(&Instruction::GlobalSet(0)); + first.instruction(&Instruction::Call(1)); + first.instruction(&Instruction::GlobalGet(0)); + first.instruction(&Instruction::I32Const(32)); + first.instruction(&Instruction::I32Add); + first.instruction(&Instruction::GlobalSet(0)); + first.instruction(&Instruction::End); + code.function(&first); + let mut second = Function::new([]); + second.instruction(&Instruction::GlobalGet(0)); + second.instruction(&Instruction::I32Const(32)); + second.instruction(&Instruction::I32Sub); + second.instruction(&Instruction::GlobalSet(0)); + second.instruction(&Instruction::Call(0)); + second.instruction(&Instruction::GlobalGet(0)); + second.instruction(&Instruction::I32Const(32)); + second.instruction(&Instruction::I32Add); + second.instruction(&Instruction::GlobalSet(0)); + second.instruction(&Instruction::End); + code.function(&second); + module.section(&code); + module.finish() +} diff --git a/crates/psrs-linker/src/target.rs b/crates/psrs-linker/src/target.rs index 14224757..923a473f 100644 --- a/crates/psrs-linker/src/target.rs +++ b/crates/psrs-linker/src/target.rs @@ -119,6 +119,14 @@ pub struct DeclaredGlobal { pub initial: u32, } +/// An explicitly declared active function-table initializer. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DeclaredElement { + pub table: u32, + pub offset: u32, + pub functions: Vec, +} + /// A declared private execution-storage region. #[derive(Clone, Debug, PartialEq, Eq)] pub struct StorageRegion { @@ -166,6 +174,7 @@ pub struct ArtifactContract { pub imports: Vec, pub exports: Vec, pub tables: Vec, + pub elements: Vec, pub globals: Vec, pub storage: Option, pub initialization: InitializationContract, diff --git a/crates/psrs-linker/src/verify/parse.rs b/crates/psrs-linker/src/verify/parse.rs index f7f89632..e0aa8199 100644 --- a/crates/psrs-linker/src/verify/parse.rs +++ b/crates/psrs-linker/src/verify/parse.rs @@ -90,11 +90,11 @@ pub(super) fn check_contract( )); } } - if parsed.has_elements { + if parsed.elements != contract.elements { return Err(LinkErrors::one( stage, id, - "artifact element segments are not declared", + "artifact element segments do not match the declared contract", )); } for (start, length) in &parsed.data_ranges { @@ -151,7 +151,7 @@ pub(super) struct ParsedCore { globals: Vec, data_ranges: Vec<(u32, u32)>, has_start: bool, - has_elements: bool, + elements: Vec, } impl ParsedTable { @@ -191,7 +191,7 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { let mut data_ranges = Vec::new(); let mut memories = 0_u32; let mut has_start = false; - let mut has_elements = false; + let mut elements = Vec::new(); for payload in Parser::new(0).parse_all(bytes) { match payload.map_err(|error| error.to_string())? { @@ -314,7 +314,31 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { } Payload::MemorySection(_) => memories += 1, Payload::StartSection { .. } => has_start = true, - Payload::ElementSection(_) => has_elements = true, + Payload::ElementSection(reader) => { + for element in reader { + let element = element.map_err(|error| error.to_string())?; + let wasmparser::ElementKind::Active { + table_index, + offset_expr, + } = element.kind + else { + return Err( + "artifact has unsupported passive or declarative elements".into() + ); + }; + let wasmparser::ElementItems::Functions(functions) = element.items else { + return Err("artifact has unsupported element expressions".into()); + }; + elements.push(crate::DeclaredElement { + table: table_index.unwrap_or(0), + offset: constant_i32(&offset_expr)?, + functions: functions + .into_iter() + .collect::, _>>() + .map_err(|error| error.to_string())?, + }); + } + } _ => {} } } @@ -331,7 +355,7 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { globals, data_ranges, has_start, - has_elements, + elements, }) } diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index 2f099473..98aad046 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -9,10 +9,15 @@ use crate::target::{ fn number_format_contract() -> ArtifactContract { ArtifactContract { - id: "psrs:runtime-number-format".into(), + elements: vec![crate::DeclaredElement { + table: 0, + offset: 1, + functions: vec![19], + }], + id: "psrs:runtime-number".into(), kind: ArtifactKind::CoreModule, module_name: psrs_runtime::MODULE_NAME.into(), - sha256: psrs_runtime::NUMBER_FORMATTER.provenance.sha256.into(), + sha256: psrs_runtime::NUMBER_RUNTIME.provenance.sha256.into(), provenance: "test".into(), required_features: [ "mutable-globals", @@ -42,11 +47,19 @@ fn number_format_contract() -> ArtifactContract { kind: ExportKind::Global, signature: None, }, + DeclaredExport { + name: psrs_runtime::DECIMAL_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::I32, CoreType::I32], + result: Some(CoreType::F64), + }), + }, ], tables: vec![DeclaredTable { element: "funcref".into(), - minimum: 1, - maximum: Some(1), + minimum: 2, + maximum: Some(2), }], globals: vec![ DeclaredGlobal { @@ -72,8 +85,8 @@ fn number_format_contract() -> ArtifactContract { heap_start: psrs_runtime::HEAP_START, minimum_pages: 3, stack_pointer_global: 0, - stack_bound_bytes: psrs_runtime::NUMBER_FORMATTER.storage.stack_bound_bytes, - stack_bound_evidence: psrs_runtime::NUMBER_FORMATTER + stack_bound_bytes: psrs_runtime::NUMBER_RUNTIME.storage.stack_bound_bytes, + stack_bound_evidence: psrs_runtime::NUMBER_RUNTIME .storage .stack_bound_evidence .into(), @@ -89,15 +102,34 @@ fn number_format_contract() -> ArtifactContract { #[test] fn embedded_artifact_satisfies_its_contract() { let contract = number_format_contract(); - verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) .expect("the pinned artifact should verify"); } +#[test] +fn element_initializers_must_match_the_complete_declared_contract() { + for change in 0..4 { + let mut contract = number_format_contract(); + match change { + 0 => contract.elements.clear(), + 1 => contract.elements[0].offset += 1, + 2 => contract.elements[0].table += 1, + _ => contract.elements[0].functions[0] += 1, + } + assert!( + verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) + .unwrap_err() + .to_string() + .contains("element segments") + ); + } +} + #[test] fn a_component_contract_cannot_use_raw_core_verification() { let mut contract = number_format_contract(); contract.kind = ArtifactKind::Component; - let error = verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + let error = verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) .expect_err("component bytes cannot satisfy a raw-core contract"); assert!( error.to_string().contains("no silent host fallback"), @@ -109,28 +141,28 @@ fn a_component_contract_cannot_use_raw_core_verification() { fn a_stale_digest_is_rejected() { let mut contract = number_format_contract(); contract.sha256 = "0".repeat(64); - assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes).is_err()); } #[test] fn an_undeclared_export_is_rejected() { let mut contract = number_format_contract(); contract.exports.remove(1); - assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes).is_err()); } #[test] fn an_undeclared_import_is_rejected() { let mut contract = number_format_contract(); contract.imports.clear(); - assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes).is_err()); } #[test] fn an_overlapping_data_range_is_rejected() { let mut contract = number_format_contract(); contract.initialization.data_range = (0, 16); - assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes).is_err()); } #[test] @@ -138,11 +170,11 @@ fn storage_cannot_name_an_absent_immutable_or_displaced_stack_pointer() { for index in [1, 99] { let mut contract = number_format_contract(); contract.storage.as_mut().unwrap().stack_pointer_global = index; - assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes).is_err()); } let mut contract = number_format_contract(); contract.storage.as_mut().unwrap().stack.end += 8; - assert!(verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes).is_err()); + assert!(verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes).is_err()); } #[test] @@ -150,7 +182,7 @@ fn independent_export_table_and_feature_contract_drift_is_rejected() { let mut contract = number_format_contract(); contract.exports[0].signature.as_mut().unwrap().parameters[0] = CoreType::F32; assert!( - verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) .unwrap_err() .to_string() .contains("signature") @@ -160,7 +192,7 @@ fn independent_export_table_and_feature_contract_drift_is_rejected() { missing.name = "absent-export".into(); contract.exports.push(missing); assert!( - verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) .unwrap_err() .to_string() .contains("missing declared export") @@ -168,7 +200,7 @@ fn independent_export_table_and_feature_contract_drift_is_rejected() { let mut contract = number_format_contract(); contract.tables[0].minimum = 0; assert!( - verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) .unwrap_err() .to_string() .contains("tables") @@ -176,7 +208,7 @@ fn independent_export_table_and_feature_contract_drift_is_rejected() { let mut contract = number_format_contract(); contract.required_features.clear(); assert!( - verify_artifact(&contract, psrs_runtime::NUMBER_FORMATTER.bytes) + verify_artifact(&contract, psrs_runtime::NUMBER_RUNTIME.bytes) .unwrap_err() .to_string() .contains("not valid Wasm") @@ -185,7 +217,7 @@ fn independent_export_table_and_feature_contract_drift_is_rejected() { #[test] fn a_valid_but_undeclared_eager_initializer_is_rejected() { - let text = wasmprinter::print_bytes(psrs_runtime::NUMBER_FORMATTER.bytes).unwrap(); + let text = wasmprinter::print_bytes(psrs_runtime::NUMBER_RUNTIME.bytes).unwrap(); let prefix = text.trim_end().strip_suffix(')').unwrap(); let bytes = wat::parse_str(format!("{prefix}(func $eager) (start $eager))")).unwrap(); wasmparser::Validator::new() diff --git a/crates/psrs-linker/tests/compose.rs b/crates/psrs-linker/tests/compose.rs index 6d319d4b..c31aedd4 100644 --- a/crates/psrs-linker/tests/compose.rs +++ b/crates/psrs-linker/tests/compose.rs @@ -64,7 +64,7 @@ fn input() -> TargetLinkInput { result: Some(CoreType::I32), }), provider: Provider::ArtifactExport { - artifact: psrs_runtime::NUMBER_FORMATTER.id.into(), + artifact: psrs_runtime::NUMBER_RUNTIME.id.into(), export: psrs_runtime::NUMBER_EXPORT.into(), signature: CoreSignature { parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], @@ -73,8 +73,8 @@ fn input() -> TargetLinkInput { }, }], artifacts: vec![ArtifactReference { - contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_FORMATTER), - bytes: psrs_runtime::NUMBER_FORMATTER.bytes.to_vec(), + contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_RUNTIME), + bytes: psrs_runtime::NUMBER_RUNTIME.bytes.to_vec(), }], policy: TargetPolicy::default(), memory: MemoryDemand { diff --git a/crates/psrs-linker/tests/plan.rs b/crates/psrs-linker/tests/plan.rs index f2606bfe..78b067e3 100644 --- a/crates/psrs-linker/tests/plan.rs +++ b/crates/psrs-linker/tests/plan.rs @@ -34,8 +34,8 @@ fn input( fn formatter_artifact() -> ArtifactReference { ArtifactReference { - contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_FORMATTER), - bytes: psrs_runtime::NUMBER_FORMATTER.bytes.to_vec(), + contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_RUNTIME), + bytes: psrs_runtime::NUMBER_RUNTIME.bytes.to_vec(), } } @@ -52,7 +52,7 @@ fn formatter_requirement() -> BindingRequirement { result: Some(CoreType::I32), }), provider: Provider::ArtifactExport { - artifact: psrs_runtime::NUMBER_FORMATTER.id.into(), + artifact: psrs_runtime::NUMBER_RUNTIME.id.into(), export: psrs_runtime::NUMBER_EXPORT.into(), signature: CoreSignature { parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], @@ -108,7 +108,7 @@ fn a_live_formatter_requirement_reserves_storage_and_closes_the_private_import() assert_eq!(link.digests().len(), 1); assert_eq!( link.digests()[0], - psrs_runtime::NUMBER_FORMATTER.provenance.sha256 + psrs_runtime::NUMBER_RUNTIME.provenance.sha256 ); } @@ -216,7 +216,7 @@ fn conflicting_providers_for_one_import_identity_are_rejected() { other.id = RequirementId(1); other.origin = "NumberToStringAgain".into(); other.provider = Provider::ArtifactExport { - artifact: psrs_runtime::NUMBER_FORMATTER.id.into(), + artifact: psrs_runtime::NUMBER_RUNTIME.id.into(), export: psrs_runtime::NUMBER_EXPORT.into(), signature: CoreSignature { // A deliberately different signature for the same import identity. @@ -242,11 +242,11 @@ fn conflicting_providers_for_one_import_identity_are_rejected() { #[test] fn a_definition_contract_does_not_satisfy_execution() { let mut contract: ArtifactContract = - psrs_linker::runtime::contract(&psrs_runtime::NUMBER_FORMATTER); + psrs_linker::runtime::contract(&psrs_runtime::NUMBER_RUNTIME); contract.exports.clear(); let artifact = ArtifactReference { contract, - bytes: psrs_runtime::NUMBER_FORMATTER.bytes.to_vec(), + bytes: psrs_runtime::NUMBER_RUNTIME.bytes.to_vec(), }; let context = resolve_default_definitions().unwrap(); assert!( diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml index 7992defe..d0cb79c9 100644 --- a/crates/psrs-runtime/Cargo.toml +++ b/crates/psrs-runtime/Cargo.toml @@ -12,7 +12,7 @@ default = ["catalog", "formatter"] # Immutable host-consumed catalog data: WIT sources, world identity, artifact # bytes and provenance. Compiles no executable target code. catalog = [] -# The executable formatter export. The Wasm artifact build enables only this +# The executable numeric exports. The Wasm artifact build enables only this # feature; the default native build enables both. formatter = ["dep:ryu-js"] diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index e8c226fc846a3d8f47fc8f3b92fe9d5c234df9a1..3bdb9f27f144a0199ccb81b07c2e69986f415839 100755 GIT binary patch delta 22143 zcmb`u30zIx_dkBlx%0hUO$ZgYD?~zu4598-Au=U0q#4~z%|$vv!*?efG50+H1Yn+H3D~pSYc6F@zAacG-?& z7>2vZTM;CQlU6j6DsU2`8oZCnj-2EJ71WOY`uJd0ba;jePU1dRO!Q1mVGKMRovTKU z7*5dW3?>U>bGRHHhsl)TV}mdbha)RTXW+YVf?&!LBrfvxmEn;XRj_8!6nD67x3PD& z-0Zw_yQQ7It;2TfZ5S>$(CWI=(#6%;VaFDX;8|L3wYT17X=CkTPs2GZ924O@T#?(g zemD)ocxOqRV34@?XiOyMC?wP|LZ8qV;D&rmfUD62m>Qji8t7UWCS-_KNJRa(lZd;R z590(3k(oru6pdKI2buz=tLTWYufU0q^Pr~*GvZ?g81?BU)mSn#o`5dGC2Dj5O+-qB zG(N`T2?znEF2Lo6{uwABG-+%B0o;_;SkNz$lc-|?*3nF(=?DDjqMv?r(HB3ufUYcH zC<}<6TnrNsvOEC@E5}eHV1g_UG(;Co7d86P<=7G9@F_!;1WeH@Od`O?)7V0e7!$C? zn4D6?c6%fOoeZIJ~52NM{BgR6X9$`WR`A38hN~lOC z)}W%F7>|kxv?Ai(frwVxESwfGnl2%-&PRmO)o|M7i}cO(Axr^X0t%t?1T+DtO(I}P zKR`}}Xcz%^Mw$kBQ77}6-r6XDL# zz{PkaG&+JXjb!)$QUs1d8khwW_shx2$MNU)?YM^jV z`OXD8!6xZGNXr@|fe8sJxQg_ggh0tvh)>3=>ghtdi06)cM*#Kedb+4z)=7wiGEvEN zL{l)}rUo%VfIF(O!O?K!Xf(jA0GGh@lUyS{4KR%x@o{ioU#1bC0CFtoMZuc`w5l6O zI#mI(xYI(Q$wqE25#ka$1GXhlI}SoY zfC5NJ)Cd7BQ;iEg&ZB``=u6QS?PD$nMgSfOa3Zxa@WKEA4?IpFBj);o_qqFctMP#` z4De+x2I2WD0CboLpMwQ4kqBrpqU>h_e5Hg0{JF4uK^N>L@CVj{TpcJPH)nuQ5N`Da zy#L@rkW#TcrK~W-3jf0j91RdJ`HM6x5J;}4_9`%d27y+p1AnOsFhbtz%LIlXIrz8^ z0c~I_sRk&)ky|0EAQG5CY{5CubfC<>|6c7d$HK%hV^uyQE?V5<>xeJK7A#n=+izBgEl2wGtXDh8D! ztWZOkBF;a(Vr&&35DY{J&@R#~`0@%q3wdIY7+c9FaRCiLK`jLKbP6cY0DKu}j|WEs zwo*oX3`~d?Oh7wQuvCkV6zo8i13=lg3nDC70zq6%3WxwPd4NJWlYl)yz%YUM3#$`h zl)6brAya_hxI|fv1M8qUs&N77fI_r$G91;IAPNLuBR)d_ywS?kWGGjlmH^NZpg_j< z12Mf}_u_(llpFkBDy3B5h#(0295$1{V8aHYbU+l_kA!(JO$OAFEcHW58Wf^&6I}nKmBn1SDgjCQIF~A{EqKdLyI&6g~{9sxD0vJI<3|T-}M3PA3BFfH) zH%>9Zc~MM=^f*L%pbTCtbq2tX2EkTiiL}(%peB)~h@@H|`SJDj#UaWotD!JF#2w+6 ziPQ_KLVa{6O2LFw=SWyNgfIxSq?|mZbF>1fV@M4^b5i4g=DF|>DV!#vqY1DvIjQk} zw$1y$) zjLMfvL@fjD;UWwaK&^u^yMPZml#;{-*29JM2w5P-KPw`g1Q$W6GLY#2H^NcK5qU#A`rS%F4ssZY zkoW^$;%_7q5FP&N`3uRwpN)XbrhtiPs1X#oKa>E$h!&(Z9E1ZYg29(0(sKe58f8l8 zEWmR5M*@_fiD2IWR11I>PWczrNc?Fepb@-|(h~%4H8wH;9JWCduqlg5aOw}_6D&$A z0|9|>1$}j~AYM=!Kv4m0(Gm*2;0@AP3ppr?=HPWMB9=SI&UAMc?c49qb^^n)|MZdn zvy=X(^MCaHH;RM=KA<5SQhrEQF%%R~3dw@p5oCj7E(eszb{F;U`^j>GN2-*F_W6=@ zIApmawX><+4K0Nw`Uz2&a0O)|hOmcGOThnG0)>nL^}-nX|GrF=mNG?@x?vDo2$?EH zi1>#P;15OtZl%JhAm#j#?H|!V#Q;T0-w5Q$8U%n3g;+M~kcL+rpiSjo2&x>gB|3L; zKp}sihg|Bf3V@RQ9eIK1pDxe^q~8dZ94frRK>=h$v?$xcCh?mHwPBzofKDO25|rNA zJRJC?DHxoV!DXQzg%w^hfwM?B5=w7?L|k<7gG@lD z4kUC@GYfo{YK9hAAZQYfc<5m4EfFw;z)TcYjqQM37>aFRA2NrlKdi9- zxYUqRmC~Rie+5PSCO}Frp(MZzch$n0p3xyYLncOFP@QyvA}&NJIXRGN;3A5~>){Yw z>G?T~DZK@OO;#epL2QBDNDK!rB}L5+y8rO8L^qR}Bj()7VF zkXS%4f}{ccP)pfEwD=NEZPCUL%DX%;X?#GbjbY5CIph1De?a zNdC~)3Mk>gj>1BxFGOGFUxZ2NsSjK^VxPa73I*5g^i54ou zM_vna=s+JZiVo@=l!(hvVoyS63n_mX&69!TA1FXSnhP3%voswgk{l6?M4IEtz^;wf ziDdp~sc2(_L9lMnp$x@JIsmc{NaKMYk2(XvqT%Kg=ujCDG_q0h#zx5r(iV%_=a3?V zbkKun%0duNhWz)MsHtcg92TUKawz-&ZLWxoHZBeX(E(bJw!qOA{AfI=l`k#}j=j`a ze)Mb^<}Kih@5L4O{rvIy{c>+1-(Tzt5jZF;zQmXGLuV_rjk6$C7x|J*WH|&6WIX;% z3@QQ^QYlI_Vc(#m0uCrJ8sNZ!>ljc6QVw;5MLB&&Jzb6m*hNih97xdM0tZq+0bQzq zfo95+sD%Trcv4)!nTn)_fr6!Xvy_ftBFOh2xZ(}qiYwjRxCjz(BwuScIsFyS|u4o!)e%`OJ>9n0waqGj5G=~Lc|IIRzQc$1F4uU+DF2L0|r{85a|nt zErd)ssRaWRAwe8ilfW77vlsG_AZXzOJ21M!rG!As7ZR{|a4s_t1j8}VC>O;jxJV~J zJ>anfQUnD=6hNh#67`di|8r1$L)#yB8`?HF5Ft@UOkX7A!X-G!3m8U61OllLZMISg z;Pee7QJNttkU{`4Kuv5%m?9(6GNSI#(dt=nDx@44j&qP^Dk2rIko!O!1n5y`F+>YO z7}{`9qbQh3U9ZzbVNAG#=iTSReFVIR@L`}64oUckF%%a;aX8u~{{DhQ$XBQV(1`}Y znia(+ly{siB@qb?*> zh(9+|+>iSqQphX8)Kmn7Xa+Q3jgXH}AqN_$Bd-jKA28BUO^OcA?`Vh=A_F`jz)}}# zh%ej%fl(n?55%`WniTLv95{u8bnO34Z~w2G@<~BFiRkn16!bg6c5UV3LD8ld8u?OLCsP|ut^{X1kRK%<3hgL zAj)a^l&g{$<*N+jt1y%%^;K#pp*Dyo81(y<7q}?mEGy*>X89dUApwD`6}lnmL}+11 z*DI8Rds(I!+}KpeP=@oYoIn=dS*ghmL|U|?0ZS6}fFQvWV*=T|FociX7B07BykW27 z7{UTU-!Us$*y)U73 zfKpvZOQ~=VV3uNlKA;mCyxa)Q&wHHN#a{ygGx#_OzWA?J6bB)HC4eDZTqG_Bxc@dCJiuk5oB)C= zyfTAAhI%nWg0p~Wc@aDY4Pq+pjjrV&6VH++mz2RFyNB7hE{^hFslkCb(mlkpfA$;c zNdWv4b_iqxP%OOl5#aCwZ^)lnG%ZXUyqP*2!TT}|xJX3r%>+W0c)hpSU^RFE0xk8C zTLU#vgOfC05f3#3L0HMK1u^qb$P#0w;9G=<=Bi06xdv)JGvM|>0u6)?(W^ST^d+72 zl^(n+gzN`#ghUtdArU8v5hu?eyw-$S)8%V`=peV2eu2YY$si_9gAdx^afpZFm&N^k zzk0uSTKb9aoQ$n#Obt(a3Zw}GjQVtuKtg(Wn}%TmTpJ_AasmEm8q*K95|~54i$DVm z&SCHw7!Gn*@4p5e_y8GraSgjBfbBT=3LSaoY-BrRNem^cV3j!-E-f&W;Ic(X5lAJD znl$VzHJcj!pG2te2&ZPqKLt!Vj)0~?45MPB^zIlOaVZ#*G9V0q3q}|NjQ~OzsbQoH zkDx?3%62Q2)let^G4>JvfCPr4Yg}rW^mgnI90p5+7=VaIY7hbxJAkS>9Fz<8!W4Mr z1fme4D}*ui1_|;GX&^wip%AQan!ac*buuJGis=3hvYD`Fa55Y~97ArBP+$FY9DL}&Ryde#RAWJsxhhc!05mxr~% znFJhp40y5tVsNH-dVqlGUo8BWt0R6{ko`tf@~-nM@^KuF3chq+Nj@HNOlCSc)McB4 zt-Ziuhn>Brz{SCOmk0#|RG@DKbZ*}1ERae8l!4k7*R3#9PC64L z_}}LJ*J%-zGGoZe&TcNQwv%mUPoFYn)^xj>_BJ}!Q)kb%x0!CU+1_TB{j}+`r)b;Q zPMM)?KhxTF`s8g6HqO@0UXyKiI@?cnakiZdKS7%8uzlBL_)*f-&D&g2iGG}9>0<9R z$=L<_|Ddn;|DVAwYiAdGL>j|r_~oxMX%k2sp3#RZEik)*vY94*kQ*m0;{&84^~JJO zgKu<(*hcBn7G(uHPeVpbb?HRLlF%7_vC5$nLe~AC@`XP8${HuNmo&|r^@4)jI_!ptX zFDHLb`UVX{{u%_dv0+e$4;yFG*s!U{@#PeTDGgH{rY_JFOcTr%7-_7~*r2gxipvz= zDIv2?&Ptz^KdVZ=LBCUANy!UDmog>)u-bvL0qLU9v*5U2<5G z=6uJw#hFX)(cELQXO~}uU#?%h9}%n(ygb+=GA^<_^3zEbhV;uI81S1iCc%I=Hw+v- zu-NcK<6!WJbEswxi-|huY&L=V2s$07Q{4oCvA~QlAIE6Y*))uSv!pa|5{R=|Y>E_% zNpNT!Iz^Ah#_3EBi=e3D9E?SyvzauCHZWwe;4Ko9VnAmx*)$f;U=tJ!^G%JI-SL$7C?fm95zPK2$;!YN*9CEIT(&JVJ=XUE{sKI zU<@_}vpF!3l7q%Vb1|4sXX2cJ<+7Os6Mp4Khfx@ZAze8KZZZf^8VqC5S!}5i=&&*- zPLOOC4P&uroB^eRAZ!}Oq|=xTusH|bKT5R>tHl{K0%sFU4yXdBOVxyy&0;b!4o;(k zQZN?$xDeTafc4XW5c(Y=jRs;sxTRHYLZ2;7$7ne2L;mT z1cQUoXi}xpm^2oL#b$#gIXDX^I1C(kO7#ois6hFl6X zK?5`}Xf!~t)Xa1`9e!mB0A~XiKps*D%qEyj76C?+x*~WWoerP}h=GgHkW$cm$iC4V zy#Y7EA>M!sU<4icG=s?i-5?TRXg0>d2E2;_;K6Z-2FRgVY=VUmU^s9-8VqO92YikI z-(r9<0qzLDIH(OQh=KKCJj@yJL>wHBMS@)cR}`Q@eE?i=O8^qs7$SodD}Z=58zKXO z4gee(9&iTH0agU~hILEb7F>V>D+P3-5P@I}hyV{}gB!6Rgo2L@00^Q9CO(JM*SFNWc*#wi_~c6@<9d!}{F9>&%}WlQP-c1kFmg)NDPNZ3|K`QE z{cjc>%Z)i=VzB$o+c77GvPUZ`|8gchvn0XWL%s_JHGS=x(ziS=dgFmk_N5uAD>qHk zDkKX>FD$scS@ZCV{fh5q_2k|OYoqh^L=z5RiD$^G;2oT+0&xd z8PyiX2gNnl+yeGzEM=~`^g4cbb=1Lq5uC{TA37Jfj2f|cxVZO2LO1Wnt#=;=%OzQz zh*Rjp;=T+mf+xi+l#@QTm+}HW|&!6?#MQ?DQK9i z6P9vI)h})Ock-axhdr9L`3tfYzBi7p#ogLk&S~k|o26wr9^aueM(xhDOAEUX7PUS) z$-K_>-{Fv7ayr(1;*K#~gGC?tV=5N3?qZfyJhxjLFyU^r#@bDia3+0Lfx`Uuac;f^ zpW43CXR;Y(j>nEPJB7!8n6!0TnSpV@_p?6c+JPGkB2?90^^%f~%e$AJKL2a0^N_1{ z!7#m$XG( z+rsU8J@;KZHP7TR`(o|0s{DzZWgogC_8WB_I2Uq@ZS^&OjM~`tS)FY30Ex}@{k*Hg7)b{agm_jdOW)l36N4Hw1|k6RKyo9ea`Q`@);er$QWtk&I7 zy%%r3p_hC&;=Aai@X(_*?Ow#0&$6Wabx*fd3mhLCteGAxGK@)0^K?9@$n}$X>?rCy zx~9mqc1@XMOx5Vn$})LJowoLrLv6VMMa2_m>#2Mo&RmX6ef)Xq;JWX7Sj*p@^E>qF znrT&*-qWhD&+Z5}hN@?pH*f7f87ixP`F>GU>{Fd>Gmj>Wx^a!emK&|r+aGGM@W2)F zQ1Vm_8SbO>A3ypp4~c#EX4^`=si87=hU)$#!!k$RJMuPs3;8s8-g)ERxGyo|3@)DZ z5WTFCzZchV}fTzO^G`pDOs@2#Dj6_nqJI9Td#1XR-e3#w)aJ_$&%Cf)= zgM|yoz&iq)E1NI%k2@<&ts63Ya7%AWo(&e)|8dEcJ4uUr!GddtOL zR;s@FP|ajkwyasD=84s0{3-m~B8inzg6RaG-dB;!{fXXC4P2j1nmv5C?U)7H zC2Z5)J~R2FJwb8i1sxIdx+=!y`J|i8@Va7~JHw6i9vl6_eEQ_WX4jXTnLEZWTsbR$ z=uW)1J?-M@%EKL_J%lG)>npB%r4HF-WU1ulekdv-{LaYXZ3pl6@N_H`2DkSt&fT+l z)Rs2iAJzU}hOSHTQfV5Y|K4}p>)ibh%+Jr{RB4CG1%+i@ZM$@z)fsz$r`LCBNLqIN zyW~*;cO=*rvbwtPgKU7A;!tVKi!8(d)Q6o zk6%x%xoc@vYsU==J8nF(ckEp<;g#;j10>VzcznmFjXO(Tl6RgMUrrjisI_EK+T<^X zv)29$QMI}^_L=&}XOX%e*H-6Pcqz=?Z_dtr%$|44y?vkh6(yz0Gdn8mWR?WGuikoQ z` ztd^@~%AACgqMYM1N*J)@SB0NL*2Ub^-2HmNwa8DWA}%TI*|2l|`VDQ{Dn6e)CO%oyF)@~rtnECGT{y+R z(A3Xwf@go(io#{u#%*((+BEFcXRImiPSm-->Aa$mY-DVa&g&=-4zx+$Fyn0$$pFT9|}#b1h7q0e*W?!{K&6Q zH)|!>q*QEqu;-V0sqIVWdsYRB^HN{<`fVTieckEGg<{VS{3E7AtrOYrT)PewJtbGI z*}QUB^9HZGhew5P8#gIz%eR+Pjhvo3`sSEEKl?-_5Bq$q_}JZ=fcQj>2UUX-n|-_X zUiekwmr{QB64O`VuF!g$h4Q?Mi4S`AS+WIdeI31QM`)LIB$b}b(q*{nOnF=R)2h%T zE$mC_$wN$egP+ffbgyL$sm=cQ#XxJ(5VKw~yyMpA!&(e^rC4JX6RjZ)%5FJb9iB$D z8;dP$<2~0uvU$*$F+nMYJH2zdcll7KgS`QRGIkG&3-FDKH<@?--3*II3TuZyFiLrq z$4RJKXXWR5ur4Dm!2Cf>%aS{KyJjWc*JM_WUhU!6f3&7yoY7gP?H+dV#PMc!WRAG@ zqS8{bTz5o8hlh(~-l)b1P0s_-N6^ z73u2H?!nCA9nX$DUCTMqp#C^h_l{Cx&7+j=z{gF#T(a)m(xw8{BQ);AZ>dX1soh;# z6SqmzewTk$pzEViTO2S!=|Xp1y|M={AC>#Nyb@twp05R8z#ri?JXxV~ppop7XFp9co>CZOG|AwXZIbHtp~j(Mljge*X*+3rx-W1leObu5<9T-< zju>aqaO>B2y#ud5cIsvenaH(YV+Y!x?S`4zkfV+ zO32_j*YOLZ=IX4HyiEw!E4UaN^zr)fah0X-4C9i*EO<_k1B0``9UqyZu*AB%JNZn#^hJWIYvxxE5e@gFIM#Gb~@Y$ zG`cEI?$BSp(qdi@*O7jCy!ktYl@sL8p39c0e|O`J?1=B7>CSnr2i|urjEHx69`WkS zADrls?*J8YfeV&?4Uviw+Zui~8B!^EPIHLc6+R*WvZ z&=bS{aXS2dlixX;z3SUCp3g2e&NcdO_|iGqqB^>C$w9x|kg36WhaH#8f8FPueLCIF zeyZN&)E&$-X3l3$SO+{V?CTq}$CO)sz%9@a|D_n9V`FepO4f=x0naNuQZJ zdY1g6iSfy2f3DOe@86=In;0-;{r8)T-px}y(7C@?`2M+zNzC!D&n)@oo72zceR%cY zp4I&8m+$Awb?8M`rHqYbF@7A;9#z&9*;13=ziJn`*vRAKuZJgOe|@yBjhmL#*?zb+ zr>}g!srQb&irXcjjxCeU+4b$Q-KxxWC?tPmxs;vVUHxmG)_k>}82JQa&^^ zt}q%wDPZnL&A`5eA^$jGL;_~>RO)$$*Cf-DcKyHh&@)HfZSq@Y^wI=Gs9)we$_ zCG*Oayfx~I;j#Pp@2rYz6^4&~>#(i;*th=Ia-k=W-AeELdgQw8mytbsM=CD+{mO}U zbh&uR`(jde=#;|v#sWKUqk9c6o?G1ecG)|lanQFSJ~{EsA;;7?;@w?$9Z!W{o+O`Z zoLOdi=RwT2>j4HHR=aEMPCdy@*~2Qn?bLkO*n1np(k9S(ai(3J%0hW9ixaoYzRgLk zIq_s3zcHrPYx;gK&+LN_OK&VYBB$DKTxs=jNu`{Qf8Oks<`bM>R`*?PAK4eV;G9N~ zeMk1PV>jlHOHCr@?T)OT+S)hXMmWzU@ap)W%~dMH1~)<6PV=%*N&&4L-0edS|y>Z8u9Y zr}ctHPUqM+`Gmo&bT&QfS?eVK)+*NwL(QFcmK!;qFAqNzu7KS+%+syR zf2+iNwma8grjmaCj%rR}8d-lTFl=4Z5QeIpge$JfX-&Pcx@T>u)@TLe{YI&AcJ`}3 zw{&Y={*fMCFN}#;Sm-l;m%7J~m*3YEL}>bWuG8rpUgqA~dw6}0+1%&LKCGoV#(NBI z>N)>$v?DKE_^$otfuN{$r>{M0Z!-+hNw;h{Ve0nlJCPkUIQzpeqVl=?J~HLO&nvXo zX~Pr7#@#4f_4v#xmiJkM*jmfQT}IQkzh81L!e8rM1$p4P)*2c8#9cc>t~OnbD}0%> z>YAhMin~iIFO40Q%*s4=FFDyrF%c8^O!jmsSFhT%zg$Bmcr*4WM0ZVCj~4muOwUx= z$-dY@=L*N^UOz@=S6=IXFehGLb2(WMu&*w6Y(ig3ap2-|xo>ZDzGS_ddR0B{PTd!+ zy%kUS3$!ib_1?9Y<@24rROYQX8oAdssKzq2d&1G`W422Z-Mp(8U3vZ7;Y8ku*Yk@m z1l&<3P6(f^GPtqTI<`7mO_;}vi02%iZok%tN3tZ=%_#f3L zQbHqk8C-Lizv0NBMt1j&8{sZjgQMQl2VI(?pvud+c1?HDXOF_L8;f>s()?6*Q6t58 zL|1KF_U92iot*QtMowMTAlSy!c$4+|NU7~JvTTf{>7mHctaV2QWzJgfv*_g7navqq zZHq2st$b3}b!xqzmVt0s%sA!e_4Xm%+YGfEyB&wf7I$~C5A~ZX+f|+pQNH!;L5Ggk z;S9aW!g)SM&Tl-92B!IUXV%H)OR7|#4BF6|7umWhzbc?5`$n9?!j_nGEwj&!Yb8_E zZ7wgYBV$JE4YCUgx!4%@AahRqa6Z`pPSYioLHyD zm@6(#vCPrdwl^D-b=Sm;S*h?Pe5QQyd`mN>5Z`;e#-hVd^4~n(F(`M!sf+P92c0^9 zzFM;3F!zC-8~sJO+bV-QUenskI&6na&MR*+>21 z?OQHA9Jy}hrCD8OXJ<}2YT1mx4B9;T)(fL;j%9BO@^rPW4-bha=jkrV7(LoUd0XnC zy|d4cVDq_~jliq*FNmUmM=dSESY$@dS6}juE5BeR$uL(gExJ*6rVXl zn5267jY*iVdwj;%?++@bEQnV$Z`{G*S73ght_1%2X&N+a$Ek|Li+o-k&Asn>+Go01 zjoq0|9?wphyN_Wil%3u;f!1fN6SeYI$HVi1(cc-uuYQFMesfmox*6OZTy&gVFvH6^ zS`vP9+@bI&?D+QUk^7Zo=Q48LE>8TO=ZoF>INP>C;c%I{X~&*tt}EhIkI^?(d>H!k z+r!oo^5J&urh)@s3zAgwzXYALj>_3ICF#VxRzG_`-u z;_O77sc9ZpO9LPET72brWzdS9oT`H0M~0IOas%~#^rfj+ z^7=nqSX?)I$T^45??tukh1GrUo~xJytsi9Ia^={$Y#ov1u7lcBqPl~)TeW{yTl>p< zkX7mPz4LT5`8R$Qh<7*DMixIdQFfrahfSS##bMh8M&Zl=xr^6tEIzK6G}?cm^1_T; z$*WbJr`7w`$ZFaTe`Btcdp|XCnZBZR=|kO@%a0t}q2Sj#R-2unvfhqccXro2_>)Ne z-8HXj;B$ANr0!$k{@<5+_~%djKabQ?`G3@V{$1BU`S1FQ(tp?0zx=EI=Z&Pa6@D*N zQ1q_>8jchapCmT&*6ll0;{ z${~L>+?rHy=HfqfeaP~7FaD`FAEb}Ijb3mLd~7mqeelfuUBi5LE9H)@d-A6qma${1 zXF%YediGkb-q5Y7f9eTjdsVgajfcM*;{6BfTd!Q_|GQp(Zg|+Wb34!duFsJbd>I#7 zS^c~2&x!2zoUONSpswGHZ}HYb{=c$}*0lXEW* zVcpqNeXNA4%f&4bJYSSQ;znT?ReuyP@=Fl^%8FR`XjJz#7_6xMVa1z7y}<>j9&h$k ziTpLDX++5K;U7=~JH5uDXlBj5tM@y@QN5`mVSOgNbsATeo(om|)ANi!4!^yiEGsv< z3F`M4cTaBLxv_Om^;DlwsGk{)?QcB%xpBn)VvEbb?$AWvGYvbYoKCQrJmVF-g3g>N z;ME$wAkLkdrxuK1)2oDE#*&7QqZSNe92tKBeyTxgUfdPEbkC!eMqQtuVfylx?hP_? zW$&tg)^vXogq2Hr9k@Z~OtFs6oQOf`*lxq!bbf2dR^OKN#90q&eV;szF$_y|7Iis& z*lc_Dz>0+dq~^1vg)6r$OVXb!ldS%9i)Bt&SgbwkP0flWHTSmHh`ztgCcpH@8MN>lU#0c^!t8wFL-5Yl$}j`>xTNkcC)kqGF}rw8 zec8393-9TCA`FGcmBx-+9v5aGIZ7AJiKPkvl^!-?Z+~%RKD#x>~^fJ{N93)Wi5qDXNy$YJ66pb*L(Ak_8Hsuh9w=g zDQU?|yH$GCEe$tCN;+NVr&ctF>NL*o$a(B`%|KHj#Prvj%LW$Zsdh^rz8{(s?L?*& zJhw8QquN>|+Zc9NyU(b_>|jAdP-5bFMb#^!qQV&4^mNC;>32!rMD*GV#U?OS?h)!y^8NzJGLgBv+38ny8$~lT^UO(ZTGb1m95{D z<(thQH)xyhTfX}7>=2KSZuRkMw=d2+Z*A+awA`t7dxYYhmRTe34xdv%vz$|Hyx7yc zcl2$0{rE-c^gWFw)mlrGPPw1d)3D=zusN>kB>tglaWm3y`P9OD=X5c9euRg;>sK$k zw?1tKp%ntl=6p%<*4WCC%W4!4$NDt8zmXVr-YE7VlhjI|wCkNdGx)@ik-2b1tMCoOl49Xog3q}OL^JW5~XZ1eMw$(nq4=kD0UrDk7Z8W-9{$)4=p z&TG?~dHhPu%MdbSQ{h2Tq58u2vbV6eKF2Pt&6(JCw5{FzwduE#6PxC}Y=1j*OU{<@ zlec||HCNjZaM-nDKlb32S7D%2$@!L#Th7a;o%Lm|d(zf&WY-A04*XeEWR+mi&OyzW z%mc#uri+3a>dC=J7#!^v9m&(@?_ZfV20T{ zj*czKls%BuKreHwc|$YocPyR~Ynr4oBp}zw@45fbexpurvbo0g_!j$Nb_(xySOyO{ zzx?AqpAsv*P@l@>i#3Q?a}FcopXFxHo%`C+E}g z#LdM~VP5#?L%gZE`#@kIyRyN%O9NA$>)5Stauliw zeGeX+_-ys!#W#LsycTROU*}KDZFx`DZKfjKAGp0t-zckNy>+l1LU;FL{Z|J-+%>Ijm z#SP2N=9hekS+TWVlZ#`lcR%gb^O)R83+OjC@9ik+c~a9OYu20Qzopn>QeIletQx-` zrW5j_F2x_~*_b^c%Fp`K9@q7e4KIV{&33hR%WM46aa`W%N2Jn+;Dz_EDYRHzO~cpR zow>V%RJd9t%uYW#=Q8)Y*(;ljG^KZ>X2Q@Mj+KeFW6Yklk*8i-x-UNYmUlJ&*8!jP z?R#&0=xxaqg|J-wixfl62di9ux7%*`gNx;%W6nRhv}4^{%lO#BIHMQ&pU*!Hv8>qH zp-cCDJi6`BYIFXgYkOXdX)$I9swO69O3uq2Pad)60-1PcEP2~U~ z-K+n2TA-M1(e=QfH%vp*aBZMqbA&Wm2_%>d@24%6SP>m0TPqJhiclC_ZuE=oyWQzWN%PTj-v>o)?JsGb%6r zod2lQV3o_Wjp>=zS$J{hsbsqziDD3Y&d}kzRc@Sjymjx_Rl{Lvhu9n9V$M1rFZ*UV zZ`|6`t1}P9+Ug|*3g#YP65#pm&FTyta&Ap%szzl=L-NpUWeK^~KaN-W`QfKuU9~G! z63!TGw_osno#)Nm)6rutUrcN=wu>8Vy({{Py-`8Os2BV=i+O?Tykvd~``3PGO*XsF zydsnOq%yFD**8gjf=1`Vrk-=#Q_8mv z4V62!W`vhpVrW62fx})B-|@rDpv|f-{K(~u)Tq+>eRpO`%*M?=@_pAUrNMi?n7+wB zU=ww9!PVnN!69u`p03-YBJ%T+R&N%WU$`_5J9fW(_biFSy_VvYlb)Z}F8RsW6U%%f z5`I$p{4|vct1R(QXOpvGxW$h;qHEka&y5dHR12!Uh_b&Qp|xpOM^7sk6XW}x zRwcMO(YN@B<_iiP61?I99{Q6lWj2`XeUq&dZ*t6UZ)Lwb>$#_7m7(?inKNW2{n&r# zW!0MFyOJxtFNzax7o0en!_#-SN($3brWnI=s<)V#CC#@?Pw%k=l(QcPY$C-AQm!#Lu zt`|1)?+?!}yZ`7wWQt~n;hM^ZL$4=Q&tw`WUkle!s?(ewwLLcP`mI0}`R1AQhN_$+ zJ>~I(W1l~|$US;S$kh*zIjLH{j#Mz-WO8Lmy3DOL+nQk@cyJZL)jps%fUW2S}Nn!zFbiwjB1iGlM|#<&i1i*$_rxT0aW$9Iio3X|_o zzBBi2fAp$DJJXIo-Q`%ge@`#3zIg8Y44xS-XHvG!c74yFhn+mNC(F|C)vvxUoa?!< z<*i%t;6NwtzUgf}8TQea-)=O$|1^bfk|0W+J&g2@SDBt-DEDwhJV!x((TkBLjYkCs zHCz42sdS@sZo6@Wl|{~0$DGDQy#q>XOj1<4uYGwdW;Uu;hipETZly3r=d)*Zi{JSN zzQe7=j^3Je*QY3n8`amd5=M0^1Z?=W^wQ6ht5nZVS$t<)&ao|@roDPG*C09ZsrQNA zi)Z)Zo%%6D&mC%JvL}g7Eeq(diqaSrvMloq`;gaB^5&ay6RzcbO8R)lyz)?6-IcG; zFS>4VxFC1lUa9!;=cJ>t<2zGcC2X(A&}-OHl_mGB`16E^=3LG%rI5%&{q>QbJF~vB zI+rf_+3@sa&M5A@?x>I-c0=SY6dKDKBqlFi>Yo2`X3>a8BetJXG&^$N@}+5O`>pM2 z2d&HfCz^G?IpIjUhG(B>%>Fv}*HjNl&hz~N^0^5&RE5)m3-pFC62nI~*ESkYJJ+gr zAzfC>FG+XkMMmf#{p3%9CY9s6M~78xP`!OgL2hMdi(tO%w~5mWFEx6;9J+dpqk5{z z(Ge&0b2>xP4~MM&ek14Ly%B=aduP*~qt9O)f5k;T!#|<<^UdHjr0m>hBVEsgY1K8| zaT?aE6n)S>C_Ko1w|CNHpCd1Roa+7Hla|}s7o!}O-=Mw5^FUA1$Xfez^GTuW1hW@2 z93wVrOgmsXE-*AIXin`Kn$cC4Ph`@}k6Sow! z?H$x7ho|{H3?ALiJlAYH*y7IVG=1Z#^jSJz7FECTUYEV6toC00d`8)Vi_i8c*Y8Xi z(amKS zw&1y2X6xD(;1x;%Y|)Nmicb!_qA`kU_ZOT>Hom{OaM-fsCk6ppOU`H>Sb56uWZP-A z`-2|8?`|;E{k&>_`s)bV74e;>u>1-oZq|F7q0g=^u!+zej z&l_*6{QB~>gQvKaWI4Shb^I4yo2LSe41>FcaXp5%tEYXe$desEwJu6ObD@`#cWMdw zxad*pIx@gwQB_rXNc-Yl!5xbSPZ^csy1u`7&8Mv!gC|Qi4*xm!fxLGA&bCQ@F1Z#r zo`zbO`=$Hz-!lEBT|VaP)O(*@CncI~B6Cx`=jZLbq<3?Q!koJwW>_{oP_EWEP?NlS z(-H&U%lkIe*xvW`+FZJFxXvcC_)#`fOA8pU>q!0SNpYoDB<0CHeV;WKK0UJHdT8Ku z+XFo-ul03(i&=j0!INu`uuTysA5M!~bG-Qe4%YH!&b}E}OUto^ZN8HOxaBrBOJ9qV zzVwuskF(AnceikFVNF%b`&hnkukU`ULR4XoBQ~1u7yYQ9g;28P}i`EX; zjBT%eR+*E-DrH_0t9Gx7D*v!RW~A>-*TK!Vhh5J-iPFk3=s--)#QBUzzQ%r(w(~l=_lSX?y zZIB&i9@=lPY4XV}A&cBwlUq5mYvG~-K3#g!l2q51KCF|L`k~S?s8m`?x~bCFf077; z&picOs`RfrMwRw=@1jy*8Bd6zgkST|MCF;t5!<2EZ#p^U43uFbZx%d;a{Ab>jxq}{ z-&ZreN<|B>_$LR}x=eRpfR!)Xvi*Ac0&Lz;w7vC-da delta 532 zcmYLGF>4e-6n^i`?C#ypVm4@E;eoR!Q7)&+6$geGgo$7$*m!8QcY%v$O)l~7w2HSI z3o&Jw#zIJ`c$EYj3+=>8`~en0EJZBDPVh}qI56*<_rC9a^M?8Ooc1@DpflJ&06-JA zF^9I;&U4J${wQ|~M{UZvO53i;M;Av<#w6_ZlADnNBq2RN2ufw?;T9tL6O^MVib&;f z1VNSJ-ouTRZa*Dvrh{RBt#=ntrRlwHXDeOl47vitZ>N<2uy62s__vVeH}4;XMVdY( z6H=Nc6njb2G+zrD2ewX)>9Y3CA!HhBqEsy}gDx#YT(%Er7DM}jl1V4{#e)CbXF698 zwbXu1=*t3_|H6F0z2JH|FYs7@l-r6p&tBKWjWflLyaJ%nP^N{J<~yw4H#nS!V#kg} zix`BgIhd30>C+SYQ!XIc3tmRA#@2cX(!pDARZe+YW=Rl9#WtvYzCDY5+XxrXw`<`e zj)&nC$3I~mJzG_GoabY8(ZN`)Iyf24I9QA-4sJ)4v&Yl1y%xGZk?L8?KAmgY-T4`hzrP6w>y6j5{{UA;eOv$l diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index 87dcf3e8..64959a8a 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -106,6 +106,14 @@ pub struct RawTable { pub maximum: Option, } +/// An active initializer for a private function table. +#[derive(Clone, Copy, Debug)] +pub struct RawElement { + pub table: u32, + pub offset: u32, + pub functions: &'static [u32], +} + /// Private execution storage and the allocator boundary an artifact requires. #[derive(Clone, Copy, Debug)] pub struct RawStorage { @@ -135,6 +143,7 @@ pub struct RuntimeArtifact { pub function_exports: &'static [RawExport], pub global_exports: &'static [&'static str], pub tables: &'static [RawTable], + pub elements: &'static [RawElement], /// Declared globals as `(mutable, constant i32 initial)`. pub globals: &'static [(bool, u32)], pub storage: RawStorage, @@ -143,20 +152,20 @@ pub struct RuntimeArtifact { pub instantiate_after_shims: bool, } -/// The `numberToString` formatter artifact, produced by `tools/build.sh`. -pub const NUMBER_FORMATTER: RuntimeArtifact = RuntimeArtifact { - id: "psrs:runtime-number-format", +/// Numeric formatting and decimal conversion, produced by `tools/build.sh`. +pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { + id: "psrs:runtime-number", module_name: crate::MODULE_NAME, bytes: include_bytes!("../artifact/psrs_runtime.wasm"), provenance: ArtifactProvenance { - dependency: "ryu-js", - dependency_revision: "1.0.2", + dependency: "ryu-js and Rust core::num::dec2flt", + dependency_revision: "ryu-js 1.0.2; Rust 1.99.0", rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", target: "wasm32-unknown-unknown", profile: "target-runtime", recipe: "tools/build.sh: --import-memory --global-base=65536 \ -zstack-size=65536 --export=__heap_base, then package", - sha256: "6ed6f666ff48d5ce12d9ffef106edd4cb2fd0629b2ebd033e0b549414c664694", + sha256: "c6d50a6b005471bca9777562860cd8a3b2fc1ba5227126f755ee0d10297408de", }, required_features: &[ "mutable-globals", @@ -170,16 +179,28 @@ pub const NUMBER_FORMATTER: RuntimeArtifact = RuntimeArtifact { module: crate::MEMORY_MODULE, field: crate::MEMORY_FIELD, }], - function_exports: &[RawExport { - name: crate::NUMBER_EXPORT, - parameters: &[RawType::F64, RawType::I32, RawType::I32], - result: Some(RawType::I32), - }], + function_exports: &[ + RawExport { + name: crate::NUMBER_EXPORT, + parameters: &[RawType::F64, RawType::I32, RawType::I32], + result: Some(RawType::I32), + }, + RawExport { + name: crate::DECIMAL_EXPORT, + parameters: &[RawType::I32, RawType::I32], + result: Some(RawType::F64), + }, + ], global_exports: &[crate::HEAP_BASE_EXPORT], tables: &[RawTable { element: "funcref", - minimum: 1, - maximum: Some(1), + minimum: 2, + maximum: Some(2), + }], + elements: &[RawElement { + table: 0, + offset: 1, + functions: &[19], }], globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], storage: RawStorage { @@ -188,7 +209,7 @@ pub const NUMBER_FORMATTER: RuntimeArtifact = RuntimeArtifact { heap_start: crate::HEAP_START, minimum_pages: 3, stack_pointer_global: 0, - stack_bound_bytes: 160, + stack_bound_bytes: 1680, stack_bound_evidence: "static call-graph frame analysis of the pinned artifact (psrs-linker::measure_stack_bound)", }, start_forbidden: true, diff --git a/crates/psrs-runtime/src/decimal.rs b/crates/psrs-runtime/src/decimal.rs new file mode 100644 index 00000000..a9e0fae5 --- /dev/null +++ b/crates/psrs-runtime/src/decimal.rs @@ -0,0 +1,67 @@ +//! Allocation-free conversion of a complete ASCII decimal token to binary64. + +/// Converts a complete signed decimal token, with an optional decimal exponent. +/// Invalid tokens return NaN. Prefix recognition and callback behavior belong +/// to the target library. The pinned Rust parser rounds to the nearest binary64. +/// +/// # Safety +/// `input` must identify `length` readable bytes in the caller's memory for the +/// duration of the call. No pointer is retained and no allocation occurs. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_from_decimal(input: *const u8, length: usize) -> f64 { + // SAFETY: the caller provides a readable buffer for this call. + let bytes = unsafe { core::slice::from_raw_parts(input, length) }; + if bytes + .iter() + .any(|byte| !matches!(byte, b'0'..=b'9' | b'+' | b'-' | b'.' | b'e' | b'E')) + { + return f64::NAN; + } + // SAFETY: every accepted byte is ASCII. + let token = unsafe { core::str::from_utf8_unchecked(bytes) }; + token.parse().unwrap_or(f64::NAN) +} + +#[cfg(test)] +mod tests { + use super::*; + + fn parse(token: &str) -> f64 { + // SAFETY: the string owns the readable input for the call. + unsafe { number_from_decimal(token.as_ptr(), token.len()) } + } + + #[test] + fn rounds_decimal_boundaries_and_preserves_negative_zero() { + for (token, expected) in [ + ("42.5", 42.5), + ("-0", -0.0), + ("-1e-9999", -0.0), + ("1e309", f64::INFINITY), + ("5e-324", f64::from_bits(1)), + ("2.4703282292062327e-324", 0.0), + ("2.4703282292062328e-324", f64::from_bits(1)), + ("9007199254740993", 9007199254740992.0), + ( + "1.00000000000000011102230246251565404236316680908203125", + 1.0, + ), + ( + "1.000000000000000111022302462515654042363166809082031251", + f64::from_bits(1.0_f64.to_bits() + 1), + ), + ] { + assert_eq!(parse(token).to_bits(), expected.to_bits(), "{token}"); + } + } + + #[test] + fn rejects_partial_nondecimal_and_non_ascii_tokens() { + for token in [ + "", "+", ".", "1e", "1e+", "42.5tail", " 42", "42 ", "0x2a", "inf", "Infinity", "NaN", + "１", + ] { + assert!(parse(token).is_nan(), "{token}"); + } + } +} diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index aa5a6f4c..118e5807 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -6,8 +6,8 @@ //! metadata: pinned WIT source bytes, the default command-world identity, and //! the compiler-owned formatter artifact with its provenance and storage //! contract. It links no executable target code. -//! - The `formatter` module (feature `formatter`) compiles the executable -//! formatter export, built for `wasm32-unknown-unknown` and embedded as the +//! - Feature `formatter` compiles the numeric formatting and complete-decimal +//! conversion exports, built for `wasm32-unknown-unknown` and embedded as the //! pinned artifact. It embeds neither WIT text nor the catalog. //! //! The compiler depends on this crate with `default-features = false, @@ -21,9 +21,13 @@ pub mod catalog; #[cfg(feature = "catalog")] pub use catalog::*; +#[cfg(feature = "formatter")] +mod decimal; #[cfg(feature = "formatter")] mod formatter; #[cfg(feature = "formatter")] +pub use decimal::number_from_decimal; +#[cfg(feature = "formatter")] pub use formatter::number_to_string; /// Maximum capacity required by an ECMAScript binary64 token. @@ -32,6 +36,8 @@ pub const NUMBER_CAPACITY: usize = 32; pub const MODULE_NAME: &str = "psrs:runtime"; /// Exported raw formatting function. pub const NUMBER_EXPORT: &str = "number_to_string"; +/// Exported raw complete-decimal conversion function. +pub const DECIMAL_EXPORT: &str = "number_from_decimal"; /// Lower addresses remain owned by the application's canonical ABI. pub const RESERVED_START: u32 = 65536; /// Static data must end before the separately reserved 64 KiB stack. @@ -54,17 +60,21 @@ pub enum RawType { F64, } -/// The caller allocates this bounded output, recovers UTF-8, then releases it. -pub struct FormatterAbi { +/// A raw numeric runtime function's checked core-Wasm signature. +pub struct NumericAbi { pub export: &'static str, - pub parameters: [RawType; 3], + pub parameters: &'static [RawType], pub result: RawType, - pub output_capacity: usize, } -pub const NUMBER_FORMAT: FormatterAbi = FormatterAbi { +pub const NUMBER_FORMAT: NumericAbi = NumericAbi { export: NUMBER_EXPORT, - parameters: [RawType::F64, RawType::I32, RawType::I32], + parameters: &[RawType::F64, RawType::I32, RawType::I32], result: RawType::I32, - output_capacity: NUMBER_CAPACITY, +}; + +pub const NUMBER_PARSE: NumericAbi = NumericAbi { + export: DECIMAL_EXPORT, + parameters: &[RawType::I32, RawType::I32], + result: RawType::F64, }; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index 0bc62f66..b8afe25b 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -225,6 +225,32 @@ round-to-nearest with ties toward positive infinity: this differs from Wasm `f64.nearest` and cannot be replaced by adding 0.5 before flooring. Public Int.floor/ceil/round retain their unchanged finite checks and clamping wrappers. +### Complete decimal conversion + +`NumberFromDecimal` (`numberFromDecimal :: String -> Number`) converts a complete +ASCII signed decimal token, with an optional decimal exponent, to binary64. +It uses the pinned Rust core parser's nearest-representable rounding, including +ties to even, signed underflow zero, and overflow to signed infinity. Empty, +partial, nondecimal, non-ASCII, and whitespace-containing tokens produce NaN. +`Infinity` and `NaN` spellings are outside this primitive's grammar. + +Core and CC validate String input and Number output before ABI erasure. MIR +copies canonical UTF-8 to a transient linear-memory buffer using the shared +string boundary protocol, calls the checked numeric-runtime export, and frees +the buffer. The runtime allocates nothing and retains no pointer. Its artifact +contract declares both numeric exports and private table initialization; +static stack analysis covers every path reachable from its entry points. +The compiler preserves potentially trapping canonical-buffer allocation for +both numeric formatting and conversion, even when the result is unused. + +The library owns ECMAScript whitespace, longest-prefix recognition, rollback of +an incomplete exponent, `Infinity` recognition, and ordinary predicate/builder +calls. It preserves the official public `Data.Number.fromString` wrapper and +the foreign slot's rank-N `Fn4` signature. Whole parsing functions are not +compiler intrinsics. The contracts are +[ECMAScript parseFloat](https://tc39.es/ecma262/multipage/global-object.html#sec-parsefloat-string) +and [Rust f64::from_str](https://doc.rust-lang.org/std/primitive.f64.html#impl-FromStr-for-f64). + ### Conversions - `IntToNumber` is `f64.convert_i32_s`. diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index eca966ac..528468ce 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -268,7 +268,17 @@ consumer verifies actual globals, imports, exports, data ranges, feature needs, and forbidden initialization against that contract. An unexplained table or other export/import must be understood and declared, not blanket-accepted. -The pinned nonrecursive formatter's maximum stack use must be established by +The numeric runtime also exports complete-decimal binary64 conversion. Its +contract declares active function-table initializers by table index, constant +offset and complete function-index sequence; different or unsupported element +segments are rejected. Stack analysis begins at exported functions and the +start function and includes every reachable private callee. Private unreachable +formatting helpers do not create entry points. Exported tables are rejected +because they would expose additional entry points; reachable indirect calls, +imported calls, recursion and unrecognized frames remain errors. Definition-only +modules with no entry points retain conservative whole-module analysis. + +The pinned nonrecursive numeric runtime's maximum stack use must be established by artifact analysis or an explicit reviewed build assumption plus stress evidence. Checking the initial stack pointer alone does not prove a bound. Reentrancy, callbacks, or a different runtime provider requires revisiting the storage @@ -532,16 +542,16 @@ bytes. Relocatable object files, dynamic loading, async/WASI 0.3 composition, recursive or reentrant runtime libraries, and cross-module GC sharing require explicit extensions. -Existing WIT/WASI binding code precedes this plan model. The formatter slice now +Existing WIT/WASI binding code precedes this plan model. The numeric runtime slice now carries one checked plan from requirement closure through artifact verification, Wasm emission, and component assembly, with a target-only linker test suite and -an end-to-end formatter execution test. The stack bound is measured over a restricted +end-to-end formatter and decimal-conversion execution tests. The stack bound is measured over a restricted frame protocol: one constant prologue, an immutable saved frame and checked restoration before returning. -Unrecognized stack-pointer access, indirect/imported calls, recursion, exception +Reachable unrecognized stack-pointer access, indirect/imported calls, recursion, exception unwinding and suspension are rejected. The declared stack-pointer global must be mutable and initialize at the reserved stack top. These checks establish the -formatter bound; they do not establish arbitrary runtime-library memory safety. -Guest execution evidence is recorded separately from the formatter slice. +numeric runtime bound; they do not establish arbitrary runtime-library memory safety. +Guest execution evidence is recorded separately from the numeric runtime slice. ## References diff --git a/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md b/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md index b675cbc9..79827574 100644 --- a/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md +++ b/docs/implementation/stdlib/explicit-polymorphic-arguments-2026-10-07.md @@ -81,3 +81,7 @@ conversion primitive may own correctly rounded binary64 conversion. Validate against the pinned official JS FFI, including whitespace, accepted decimal prefixes, malformed exponents, overflow, underflow, and signed zero. Other Number foreign slots and whole-standard-library behavior remain separate work. + +The subsequent [Number parsing acceptance](number-parsing-2026-10-07.md) +implements and executes that missing target. The replay and measurements above +describe this earlier Core checkpoint. diff --git a/docs/implementation/stdlib/number-parsing-2026-10-07.md b/docs/implementation/stdlib/number-parsing-2026-10-07.md new file mode 100644 index 00000000..921ce30d --- /dev/null +++ b/docs/implementation/stdlib/number-parsing-2026-10-07.md @@ -0,0 +1,115 @@ +# Number parsing acceptance + +## Contract and ownership + +Starting compiler revision: a3ea5e8 on stdlib/vendor-core-libraries, with a +clean worktree. The starting library was 2ee2d1fdaff8a2841824cd1bb5d3fb864f594630 +(fnv1a64-v1:801317111aa80a8f). The unchanged public Number.fromString "42.5" +wrapper reached P8 library linking, where Data.Number.fromStringImpl had no +target implementation. The preceding +[Core repair](explicit-polymorphic-arguments-2026-10-07.md) owns its explicit +polymorphic instantiation; this change adds no inference or Coercible rule. + +The compiler owns numberFromDecimal :: String -> Number. It accepts a complete +ASCII decimal token, returns NaN for invalid tokens, and uses the pinned Rust +core binary64 converter for rounding, overflow and signed underflow. HIR/Core +check the String/Number contract; CC rejects incorrect operands and results +before erasure. MIR uses the existing canonical UTF-8 copy/release protocol to +call the raw runtime export with pointer and length. No pointer is retained. +Allocation failure remains a trap, including when the result is unused. + +The independent library owns PSRS.Number.Parse: ECMAScript whitespace, +longest-prefix recognition, incomplete-exponent rollback, Infinity/NaN, and +the supplied predicate and polymorphic result callbacks. These are ordinary +target-library functions. The official pure public wrapper and foreign slot's +signature are preserved. Explicit type applications and intermediate functions +with explicit signatures construct Fn4 while retaining both universal arguments. The reduced +wrapper executes in psrs and compiles with official purs; a specialized value +cannot satisfy a universal argument. + +The shared numeric runtime retains numberToString and adds numberFromDecimal. +Its reproducible artifact SHA-256 is +c6d50a6b005471bca9777562860cd8a3b2fc1ba5227126f755ee0d10297408de. +The linker checks the declared private table and active initializer exactly. +Static stack analysis follows exported/start entry points, rejects reachable +indirect calls, imported calls and recursion, and rejects exported tables. +Unreachable private formatting helpers do not establish execution paths. +The measured stack bound is 1680 bytes within the existing 65536-byte reserve. +Existing nonreentrant storage and allocator boundaries remain in force. + +## Package and behavior evidence + +Locked package: 4c4795a9c87496242398554b83f665062e3af2fd +(fnv1a64-v1:5e52e376007f1a23). Source adaptations, provenance, source verifier, +and Node oracle belong to psrs-stdlib; the compiler retains its lock, primitive, +linker contracts, runtime artifact, and Rust regressions. + +```sh +node ../psrs-stdlib/conformance/number-parsing.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-parsing-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-parsing-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-parsing-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-parsing-oracle/Main.purs -o /tmp/psrs-parsing-locked.wasm +wasmtime /tmp/psrs-parsing-locked.wasm +``` + +The pinned official JS FFI supplies 304 checks: 244 public inputs and 60 +callback, uncurried and partial-application checks. Coverage includes every +ECMAScript whitespace code point, rejected lookalikes, incomplete exponents, +trailing text, nonfinite results, negative zero, subnormals, exact rounding +ties, long tokens, and 128 deterministic generated decimal cases. Custom +predicates and builders exercise accepted/rejected NaN and Infinity paths. +Both explicit-package and locked-package executions return 42 with empty +stdout/stderr. All 414 public Number/Int rounding checks also pass against the +final package. A fresh +locked-package diagnosis of the original public reproducer passes. Since the +package fingerprint changed, this is replay across a package update rather +than a same-fingerprint diagnose --compare measurement. + +The full source inventory covers 230 modules across 41 pinned packages: +170 identical, 36 modified, 24 target additions, no absent upstream modules, +and no direct recursive foreign placeholders. This inventory does not approve +all pre-existing adaptations or establish whole-library runtime behavior. +The Node tooling tests pass: 11 passed, zero skipped. The numeric runtime +rebuild is byte-for-byte reproducible. Raw reports, logs, oracle programs, and +execution artifacts remain under /private/tmp and are not committed. + +## Rust validation + +The four focused driver regressions pass with mandatory Wasmtime: official +public wrapper execution, decimal precision/range/zero signs, invalid foreign +schemes, and explicit universal newtype arguments. Native runtime tests cover +decimal grammar and rounding boundaries. CC malformed-operation checks and +linker tests cover element-contract mismatches and reachable stack paths. + +`cargo fmt --all --check`, `git diff --check`, and +`CARGO_INCREMENTAL=0 cargo clippy --workspace --all-targets -- -D warnings` +pass. All 230 vendored source hashes match the final package's inventory. + +`CARGO_INCREMENTAL=0 PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` +completes all 52 target suites, including doc tests: 1683 passed, three existing +failures, and five ignored. The failures match the preceding Core checkpoint: + +- `dictionary_audit::execution::constrained_dictionary_parameters_precede_ordinary_arguments`: + the test cannot find its expected MIR constrained function. +- `tests::functions::runs_a_polymorphic_identity_with_a_number`: + its optimized WAT does not contain the asserted f64 token. +- `tests::integration::compiles_if_expression_through_cfg_to_structured_wasm`: + its optimized constant branch does not contain the asserted br_if token. + +The first full run additionally exposed a stale formatter-artifact identity +assertion. It now checks the numeric artifact identity and its pinned digest; +both its focused rerun and the complete workspace rerun pass that regression. +Full workspace validation is therefore not green because of the three baseline +failures, with no new failing test in the completed rerun. + +## Remaining work + +This establishes the parsing slice. It does not establish complete stdlib +compilation, source fidelity of every adaptation, or behavior of every API. +A fresh public Number.abs (-42.5) case stops at P8 library linking because +Data.Number.abs has no target implementation. Other Number foreign slots +remain separate work. No official scoreboard or gate measurement changes. diff --git a/docs/implementation/stdlib/number-rounding-2026-10-07.md b/docs/implementation/stdlib/number-rounding-2026-10-07.md index f8e93592..dd58b83c 100644 --- a/docs/implementation/stdlib/number-rounding-2026-10-07.md +++ b/docs/implementation/stdlib/number-rounding-2026-10-07.md @@ -104,3 +104,7 @@ reproducer now stops at P8 library linking because `Data.Number.fromStringImpl` has no target implementation. Parsing behavior and other Number FFI remain unverified. No scoreboard or gate measurement is changed by this focused behavior evidence. + +The subsequent [Number parsing acceptance](number-parsing-2026-10-07.md) +implements and executes the parser. The blockers above describe the rounding +and Core checkpoints, before that package update. diff --git a/stdlib.lock.json b/stdlib.lock.json index 673b3fe1..d90dffd9 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "2ee2d1fdaff8a2841824cd1bb5d3fb864f594630", - "source_fingerprint": "fnv1a64-v1:801317111aa80a8f" + "revision": "4c4795a9c87496242398554b83f665062e3af2fd", + "source_fingerprint": "fnv1a64-v1:5e52e376007f1a23" } From b263b14bed07db3355ba522181e351b5e0387381 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 21:23:29 +0800 Subject: [PATCH 071/148] Implement checked Number absolute value with public behavior evidence --- crates/psrs-backend/src/cc/lower/scalar.rs | 1 + crates/psrs-backend/src/cc/scalar.rs | 1 + crates/psrs-backend/src/cc/verify/scalar.rs | 2 +- .../psrs-backend/src/cc/verify/tests/mod.rs | 1 + .../src/mir/gc_tests/number_trunc.rs | 60 ++++++++++-- crates/psrs-backend/src/mir/numeric.rs | 2 + .../src/mir/verify/instruction/unary.rs | 8 +- .../psrs-backend/src/mir/verify/tests/mod.rs | 1 + .../src/wasm/lower/structure/unary.rs | 4 + crates/psrs-core/src/verify/types/mod.rs | 3 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_abs.rs | 50 ++++++++++ crates/psrs-hir/src/intrinsic/mod.rs | 7 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + .../backend/fp/scalars-and-primitives.md | 9 ++ .../stdlib/number-abs-2026-10-07.md | 98 +++++++++++++++++++ .../stdlib/number-parsing-2026-10-07.md | 4 + docs/workflow/stdlib-conformance.md | 18 ++++ stdlib.lock.json | 4 +- 19 files changed, 258 insertions(+), 17 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_abs.rs create mode 100644 docs/implementation/stdlib/number-abs-2026-10-07.md diff --git a/crates/psrs-backend/src/cc/lower/scalar.rs b/crates/psrs-backend/src/cc/lower/scalar.rs index a0c93694..c5dd512b 100644 --- a/crates/psrs-backend/src/cc/lower/scalar.rs +++ b/crates/psrs-backend/src/cc/lower/scalar.rs @@ -55,6 +55,7 @@ pub(super) fn lower_unary_op(value: Intrinsic) -> UnaryOp { Intrinsic::IntNeg => UnaryOp::IntNeg, Intrinsic::IntComplement => UnaryOp::IntComplement, Intrinsic::NumberNeg => UnaryOp::NumberNeg, + Intrinsic::NumberAbs => UnaryOp::NumberAbs, Intrinsic::NumberTrunc => UnaryOp::NumberTrunc, Intrinsic::NumberFloor => UnaryOp::NumberFloor, Intrinsic::NumberCeil => UnaryOp::NumberCeil, diff --git a/crates/psrs-backend/src/cc/scalar.rs b/crates/psrs-backend/src/cc/scalar.rs index aa815179..47013e83 100644 --- a/crates/psrs-backend/src/cc/scalar.rs +++ b/crates/psrs-backend/src/cc/scalar.rs @@ -5,6 +5,7 @@ pub enum UnaryOp { IntNeg, IntComplement, NumberNeg, + NumberAbs, NumberTrunc, NumberFloor, NumberCeil, diff --git a/crates/psrs-backend/src/cc/verify/scalar.rs b/crates/psrs-backend/src/cc/verify/scalar.rs index 330a5d19..b722d703 100644 --- a/crates/psrs-backend/src/cc/verify/scalar.rs +++ b/crates/psrs-backend/src/cc/verify/scalar.rs @@ -49,7 +49,7 @@ pub(super) fn verify_unary_operation( IntNeg | IntComplement | CharToInt | IntToChar => { (ValueShape::Integer, ValueShape::Integer) } - NumberNeg | NumberTrunc | NumberFloor | NumberCeil => { + NumberAbs | NumberNeg | NumberTrunc | NumberFloor | NumberCeil => { (ValueShape::Number, ValueShape::Number) } BooleanNot => (ValueShape::Boolean, ValueShape::Boolean), diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index 43cc91ee..5f9ed7f9 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -246,6 +246,7 @@ fn rejects_a_unary_operation_with_the_wrong_operand_shape() { }; for op in [ + super::super::UnaryOp::NumberAbs, super::super::UnaryOp::NumberNeg, super::super::UnaryOp::NumberTrunc, super::super::UnaryOp::NumberFloor, diff --git a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs index d43ce39a..5f644e8f 100644 --- a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs +++ b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs @@ -2,16 +2,51 @@ use super::*; #[test] fn optimized_and_unoptimized_number_trunc_preserve_zero_sign_and_range() { - check_number_rounding(crate::cc::UnaryOp::NumberTrunc, -0.9, 4294967296.0); + check_number_unary( + crate::cc::UnaryOp::NumberTrunc, + -0.9, + 4294967296.5, + 4294967296.0, + true, + ); } #[test] fn optimized_and_unoptimized_number_floor_and_ceil_preserve_sign_and_range() { - check_number_rounding(crate::cc::UnaryOp::NumberFloor, -0.0, 4294967296.0); - check_number_rounding(crate::cc::UnaryOp::NumberCeil, -0.9, 4294967297.0); + check_number_unary( + crate::cc::UnaryOp::NumberFloor, + -0.0, + 4294967296.5, + 4294967296.0, + true, + ); + check_number_unary( + crate::cc::UnaryOp::NumberCeil, + -0.9, + 4294967296.5, + 4294967297.0, + true, + ); } -fn check_number_rounding(operation: crate::cc::UnaryOp, input: f64, expected: f64) { +#[test] +fn optimized_and_unoptimized_number_abs_clear_zero_sign_and_preserve_magnitude() { + check_number_unary( + crate::cc::UnaryOp::NumberAbs, + -0.0, + -4294967296.5, + 4294967296.5, + false, + ); +} + +fn check_number_unary( + operation: crate::cc::UnaryOp, + input: f64, + large: f64, + expected: f64, + negative: bool, +) { use crate::cc::{BinaryOp, UnaryOp, ValueDecl}; use ValueShape::{Boolean as B, Integer as I, Number as N}; let symbol = SymbolId::new(ModuleId(0), 0); @@ -38,7 +73,7 @@ fn check_number_rounding(operation: crate::cc::UnaryOp, input: f64, expected: f6 span: span(), }; let module = CcModule { - name: "NumberTruncDifferential".into(), + name: "NumberUnaryDifferential".into(), externals: Vec::new(), representations: RepresentationTable::default(), functions: vec![CcFunction { @@ -59,8 +94,17 @@ fn check_number_rounding(operation: crate::cc::UnaryOp, input: f64, expected: f6 number(2, 1.0), binary(3, BinaryOp::NumberDiv, 2, 1), number(4, 0.0), - binary(5, BinaryOp::NumberLt, 3, 4), - number(6, 4294967296.5), + binary( + 5, + if negative { + BinaryOp::NumberLt + } else { + BinaryOp::NumberGt + }, + 3, + 4, + ), + number(6, large), unary(7, operation, 6), number(8, expected), binary(9, BinaryOp::NumberEq, 7, 8), @@ -82,7 +126,7 @@ fn check_number_rounding(operation: crate::cc::UnaryOp, input: f64, expected: f6 }; let target = crate::TargetCapabilities::default(); let (mir, _) = crate::mir::lower_module_with_capabilities(module, target) - .expect("Number truncation should lower to MIR"); + .expect("Number unary operation should lower to MIR"); run_gc(&mir, 42); let optimized = crate::mir::opt::optimize(mir, target).expect("valid optimization"); run_gc(&optimized, 42); diff --git a/crates/psrs-backend/src/mir/numeric.rs b/crates/psrs-backend/src/mir/numeric.rs index ad0195bf..e3dad222 100644 --- a/crates/psrs-backend/src/mir/numeric.rs +++ b/crates/psrs-backend/src/mir/numeric.rs @@ -7,6 +7,7 @@ pub enum UnaryOp { I32Neg, I32Complement, F64Neg, + F64Abs, F64Trunc, F64Floor, F64Ceil, @@ -26,6 +27,7 @@ impl From for UnaryOp { CcUnaryOp::IntNeg => Self::I32Neg, CcUnaryOp::IntComplement => Self::I32Complement, CcUnaryOp::NumberNeg => Self::F64Neg, + CcUnaryOp::NumberAbs => Self::F64Abs, CcUnaryOp::NumberTrunc => Self::F64Trunc, CcUnaryOp::NumberFloor => Self::F64Floor, CcUnaryOp::NumberCeil => Self::F64Ceil, diff --git a/crates/psrs-backend/src/mir/verify/instruction/unary.rs b/crates/psrs-backend/src/mir/verify/instruction/unary.rs index fcfc9f19..b8e0ae1b 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/unary.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/unary.rs @@ -24,9 +24,11 @@ pub(super) fn verify_unary( UnaryOp::I32Neg | UnaryOp::I32Complement | UnaryOp::I32Identity => { (ValueType::I32, ValueType::I32) } - UnaryOp::F64Neg | UnaryOp::F64Trunc | UnaryOp::F64Floor | UnaryOp::F64Ceil => { - (ValueType::F64, ValueType::F64) - } + UnaryOp::F64Abs + | UnaryOp::F64Neg + | UnaryOp::F64Trunc + | UnaryOp::F64Floor + | UnaryOp::F64Ceil => (ValueType::F64, ValueType::F64), UnaryOp::BoolNot => (ValueType::Boolean, ValueType::Boolean), UnaryOp::I32ToF64 => (ValueType::I32, ValueType::F64), UnaryOp::F64ToF32 => (ValueType::F64, ValueType::F32), diff --git a/crates/psrs-backend/src/mir/verify/tests/mod.rs b/crates/psrs-backend/src/mir/verify/tests/mod.rs index 90d01fde..a1581441 100644 --- a/crates/psrs-backend/src/mir/verify/tests/mod.rs +++ b/crates/psrs-backend/src/mir/verify/tests/mod.rs @@ -99,6 +99,7 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { span: span(), }; for op in [ + crate::mir::UnaryOp::F64Abs, crate::mir::UnaryOp::F64Neg, crate::mir::UnaryOp::F64Trunc, crate::mir::UnaryOp::F64Floor, diff --git a/crates/psrs-backend/src/wasm/lower/structure/unary.rs b/crates/psrs-backend/src/wasm/lower/structure/unary.rs index ea92aa34..6299eead 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/unary.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/unary.rs @@ -23,6 +23,10 @@ impl Structurer<'_> { body.push(Op::Leaf(Instruction::I32Const(-1))); body.push(Op::Leaf(Instruction::I32Xor)); } + UnaryOp::F64Abs => { + body.push(Op::Leaf(Instruction::LocalGet(value_local))); + body.push(Op::Leaf(Instruction::F64Abs)); + } UnaryOp::F64Neg => { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::F64Neg)); diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 8f71a1c8..cd2a77e1 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -79,7 +79,8 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T Intrinsic::NumberNeg | Intrinsic::NumberTrunc | Intrinsic::NumberFloor - | Intrinsic::NumberCeil => (Number, Number), + | Intrinsic::NumberCeil + | Intrinsic::NumberAbs => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 7facf851..e003d4ea 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -19,6 +19,7 @@ mod functor; mod guard_coverage; mod let_constraints; mod library_foreign; +mod number_abs; mod number_decimal; mod number_rounding; mod number_trunc; diff --git a/crates/psrs-driver/src/tests/number_abs.rs b/crates/psrs-driver/src/tests/number_abs.rs new file mode 100644 index 00000000..8d293728 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_abs.rs @@ -0,0 +1,50 @@ +use super::*; + +#[test] +fn public_number_abs_preserves_magnitude_and_canonicalizes_negative_zero() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +apply f value = f value +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negate positiveInfinity +nan = 0.0 / 0.0 +checks = Number.abs (-42.5) == 42.5 + && Number.abs 42.5 == 42.5 + && Number.abs (-4294967296.5) == 4294967296.5 + && Number.abs (-5.0e-324) == 5.0e-324 + && Number.abs (-1.7976931348623157e308) == 1.7976931348623157e308 + && 1.0 / Number.abs (negate 0.0) == positiveInfinity + && 1.0 / Number.abs 0.0 == positiveInfinity + && Number.abs negativeInfinity == positiveInfinity + && Number.abs positiveInfinity == positiveInfinity + && Number.abs nan /= Number.abs nan + && apply Number.abs (-42.0) == 42.0 +main :: Int +main = if checks then 42 else 1 +"#; + let mir = lower_source_to_mir(source); + assert!(format!("{mir:#?}").contains("F64Abs")); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_abs_requires_number_operand_and_result() { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberAbs\" magnitude :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("absolute value requires a checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 33026e31..8131f1b2 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -110,6 +110,8 @@ pub enum Intrinsic { NumberCeil, /// Convert a complete ASCII decimal token to binary64; invalid tokens return NaN. NumberFromDecimal, + /// Clear the binary64 sign bit, including negative zero and NaN. + NumberAbs, } impl Intrinsic { @@ -132,7 +134,7 @@ impl Intrinsic { /// Every variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 68] = [ + pub const ALL: [Intrinsic; 69] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::I32Add, @@ -201,6 +203,7 @@ impl Intrinsic { Intrinsic::NumberFloor, Intrinsic::NumberCeil, Intrinsic::NumberFromDecimal, + Intrinsic::NumberAbs, ]; } @@ -209,7 +212,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::NumberFromDecimal as u32 as usize + 1, + Intrinsic::ALL.len() == Intrinsic::NumberAbs as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 4b9ce4de..0e0c88a6 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -106,6 +106,7 @@ descriptors! { NumberNeg => "numberNeg", 1, UnaryScalar, scheme::number_number; NumberTrunc => "numberTrunc", 1, UnaryScalar, scheme::number_number; NumberFloor => "numberFloor", 1, UnaryScalar, scheme::number_number; + NumberAbs => "numberAbs", 1, UnaryScalar, scheme::number_number; NumberCeil => "numberCeil", 1, UnaryScalar, scheme::number_number; BooleanNot => "booleanNot", 1, UnaryScalar, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, UnaryScalar, scheme::int_number; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index b8afe25b..470d77b6 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -157,6 +157,7 @@ chosen mapping is: | `IntNeg` | `I32Neg` | `0 - x` | | `IntComplement` | `I32Complement` | `x ^ -1` | | `NumberNeg` | `F64Neg` | `f64.neg` | +| `NumberAbs` | `F64Abs` | `f64.abs` | | `NumberTrunc` | `F64Trunc` | `f64.trunc` | | `NumberFloor` / `NumberCeil` | `F64Floor` / `F64Ceil` | `f64.floor` / `f64.ceil` | | `BooleanNot` | `BoolNot` | `i32.eqz` | @@ -191,6 +192,14 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. ### Number arithmetic - Arithmetic maps to the four `f64` operations and negation to `f64.neg`. +- `NumberAbs` (`numberAbs :: Number -> Number`) lowers to `f64.abs`, clearing + the sign bit without changing the magnitude or NaN payload. Negative zero + becomes positive zero, either infinity becomes positive infinity, and NaN + remains NaN. Core, CC and MIR require Number/F64 operands and results. This + implements the official Data.Number.abs foreign slot; no integer conversion + or library-name recognition is involved. The primitive remains explicit for + constant operands; no new constant folding is claimed. See the + [WebAssembly absolute-value semantics](https://webassembly.github.io/spec/core/exec/numerics.html#op-fabs). - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. - The current vocabulary has no `Number` remainder. If the standard library diff --git a/docs/implementation/stdlib/number-abs-2026-10-07.md b/docs/implementation/stdlib/number-abs-2026-10-07.md new file mode 100644 index 00000000..c07ebec7 --- /dev/null +++ b/docs/implementation/stdlib/number-abs-2026-10-07.md @@ -0,0 +1,98 @@ +# Number absolute-value acceptance + +## Contract and implementation + +Starting compiler revision: 131a1fe on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was 4c4795a9c87496242398554b83f665062e3af2fd +(fnv1a64-v1:5e52e376007f1a23). A fresh Number.abs (-42.5) diagnosis stopped at +P8 library linking because Data.Number.abs had no target implementation. + +The compiler now owns numberAbs :: Number -> Number. Its HIR identity is +appended, preserving existing intrinsic IDs. Core and CC require Number +operand/result types, MIR requires F64, and Wasm emits f64.abs. Incorrect +foreign binding schemes are rejected before ABI erasure. Existing malformed +CC/MIR unary-operation checks cover the new operation. No additional runtime +artifact, host binding, library-name recognition, integer conversion, or +constant folding is introduced. + +The independent library changes only the foreign slot's explicit binding: +`foreign import "psrs:intrinsic#numberAbs" abs :: Number -> Number`. +Its signature, exports, and all official pure declarations remain unchanged. +The complete-module source verifier checks this transformation against pinned +purescript-numbers v9.0.1 (27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +Wasm absolute value clears the sign bit while preserving finite magnitudes +and NaN payloads. Negative zero becomes positive zero, either infinity becomes +positive infinity, and NaN remains NaN. The public oracle checks NaN value +behavior rather than a JS payload identity. See the +[Wasm scalar contract](../../design/backend/fp/scalars-and-primitives.md). + +## Package and runtime evidence + +Locked package: e0679521275277c0b005b2509d9e0a8570715c5e +(fnv1a64-v1:4e357ed0c7f9f10f). + +```sh +node ../psrs-stdlib/conformance/number-abs.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-abs-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-abs-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-abs-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-number-abs-oracle/Main.purs -o /tmp/psrs-number-abs-locked.wasm +wasmtime /tmp/psrs-number-abs-locked.wasm +``` + +The actual pinned official JS abs produces 153 input observations and 306 +checks, exercising direct public calls and higher-order calls. Inputs include +both zero signs, subnormals, minimum normal values, fractions, magnitudes +beyond i32, maximal finite values, infinities, NaN, and 128 deterministically +generated binary64 patterns. Reciprocal observations distinguish zero signs. +Both development-package and locked-package executions return 42 with empty +stdout/stderr. The final package also passes the existing 304 parsing checks +and 414 public Number/Int rounding checks, returning 42 with empty output. + +The complete source inventory records 230 modules across 41 packages: +170 identical, 36 modified and 24 target additions, no absent upstream modules +and no direct recursive foreign placeholders. This inventory does not approve +all existing adaptations or establish behavior of every API. Node tooling: +11 passed, none skipped. All 230 vendored source hashes match their inventory. +Raw reports, generated inputs, runtime artifacts and +validation logs remain local under /private/tmp and are not committed. + +## Rust validation + +The two new driver regressions pass with mandatory Wasmtime: public behavior +and rejection of invalid foreign contracts. Backend execution passes with +optimization enabled and disabled, checking negative-zero canonicalization +and a negative magnitude beyond i32. + +`CARGO_INCREMENTAL=0 PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` +completes all 52 target suites, including doc tests: 1686 passed, three existing +failures, and five ignored. The failures match the preceding checkpoint: + +- `dictionary_audit::execution::constrained_dictionary_parameters_precede_ordinary_arguments`: + the test cannot find its expected MIR constrained function. +- `tests::functions::runs_a_polymorphic_identity_with_a_number`: + its optimized WAT does not contain the asserted f64 token. +- `tests::integration::compiles_if_expression_through_cfg_to_structured_wasm`: + its optimized constant branch does not contain the asserted br_if token. + +Full workspace validation is not green because of these baseline failures. +There is no new failing test in this run. + +`cargo fmt --all --check`, `git diff --check`, and +`CARGO_INCREMENTAL=0 cargo clippy --workspace --all-targets -- -D warnings` +pass. + +## Remaining work + +The original public abs reproducer now compiles. The package fingerprint +changed, so this is replay across a package update rather than a comparable +same-fingerprint diagnose --compare measurement. + +A fresh Number.sqrt 4.0 reproducer stops at P8 library linking because +Data.Number.sqrt has no target implementation. This is absolute-value +acceptance, not complete Number FFI or whole-standard-library acceptance. +No official scoreboard or gate measurement changes. diff --git a/docs/implementation/stdlib/number-parsing-2026-10-07.md b/docs/implementation/stdlib/number-parsing-2026-10-07.md index 921ce30d..7393ed88 100644 --- a/docs/implementation/stdlib/number-parsing-2026-10-07.md +++ b/docs/implementation/stdlib/number-parsing-2026-10-07.md @@ -113,3 +113,7 @@ compilation, source fidelity of every adaptation, or behavior of every API. A fresh public Number.abs (-42.5) case stops at P8 library linking because Data.Number.abs has no target implementation. Other Number foreign slots remain separate work. No official scoreboard or gate measurement changes. + +The subsequent [absolute-value acceptance](number-abs-2026-10-07.md) resolves +the abs blocker with a checked scalar operation and public JS comparisons. +The measurements above describe the preceding parsing checkpoint. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index eb1b960a..07938947 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -254,3 +254,21 @@ ECMAScript round tie behavior belongs to ordinary PureScript in PSRS.Number. Official Data.Int pure wrappers remain unchanged. Raw generated reports are local and ignored; summarized acceptance lives in the library's `docs/number-rounding.md` and the compiler's topic report. + +For Number absolute value through direct and higher-order public calls: + +```sh +node ../psrs-stdlib/conformance/number-abs.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-abs-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-abs-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-abs-runtime +``` + +The generator checks the complete pinned Data.Number source transformation +and invokes its actual JS abs FFI. Reciprocal observations distinguish zero +signs. Cases include binary64 subnormals, nonfinite values, magnitudes beyond +i32, and deterministic generated bit patterns. The compiler's checked +numberAbs primitive selects f64.abs; the library retains its original public +Number signature and pure declarations. diff --git a/stdlib.lock.json b/stdlib.lock.json index d90dffd9..f3a0ec96 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "4c4795a9c87496242398554b83f665062e3af2fd", - "source_fingerprint": "fnv1a64-v1:5e52e376007f1a23" + "revision": "e0679521275277c0b005b2509d9e0a8570715c5e", + "source_fingerprint": "fnv1a64-v1:4e357ed0c7f9f10f" } From 0aab025fa92e16c8acd031d841e7975051a9ff24 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 22:57:33 +0800 Subject: [PATCH 072/148] Separate intrinsic semantics from target implementations HIR owns language identities, schemes, and effects. The backend selects one direct, generated, or artifact implementation, and linking checks each MIR import against the provider ABI. Euclidean division stays in the library. Retired floor bindings are rejected. The lock pins the library commit that uses a truncating quotient for array storage. --- .../src/bindings/primitives/mod.rs | 2 +- crates/psrs-backend/src/cc/lower/intrinsic.rs | 106 +++--- .../psrs-backend/src/cc/lower/letrec/tests.rs | 4 +- crates/psrs-backend/src/cc/lower/mod.rs | 1 - crates/psrs-backend/src/cc/lower/scalar.rs | 73 ---- crates/psrs-backend/src/cc/mod.rs | 11 +- crates/psrs-backend/src/cc/scalar.rs | 2 - crates/psrs-backend/src/cc/verify/ops/mod.rs | 45 ++- crates/psrs-backend/src/cc/verify/scalar.rs | 4 +- .../src/cc/verify/tests/number_decimal.rs | 46 ++- crates/psrs-backend/src/lib.rs | 1 + crates/psrs-backend/src/linking/mod.rs | 35 +- crates/psrs-backend/src/linking/tests.rs | 123 +++++++ .../src/mir/gc_tests/binary_matrix/mod.rs | 16 +- .../src/mir/gc_tests/div_mod/mod.rs | 277 --------------- .../src/mir/gc_tests/div_mod/switch.rs | 260 -------------- crates/psrs-backend/src/mir/gc_tests/mod.rs | 1 - crates/psrs-backend/src/mir/gc_tests/unary.rs | 2 +- .../psrs-backend/src/mir/lower/assignments.rs | 39 ++- .../src/mir/lower/conversion_helpers.rs | 6 +- crates/psrs-backend/src/mir/lower/mod.rs | 6 +- .../src/mir/lower/number_string.rs | 100 ------ .../src/mir/lower/runtime_call.rs | 127 +++++++ .../psrs-backend/src/mir/lower/wit_tests.rs | 1 - crates/psrs-backend/src/mir/mod.rs | 58 ++-- crates/psrs-backend/src/mir/numeric.rs | 1 - .../src/mir/reachable/assignments.rs | 3 +- crates/psrs-backend/src/mir/scalar_helpers.rs | 327 ------------------ .../src/target_intrinsics/generated.rs | 84 +++++ .../psrs-backend/src/target_intrinsics/mod.rs | 117 +++++++ .../src/target_intrinsics/tests.rs | 44 +++ .../src/target_runtime/language.rs | 85 +++++ .../mod.rs} | 46 ++- .../src/target_runtime/protocol_tests.rs | 79 +++++ .../psrs-backend/src/wasm/lower/codec/mod.rs | 40 +-- crates/psrs-backend/src/wasm/lower/mod.rs | 24 +- crates/psrs-core/src/opt/effects.rs | 34 +- crates/psrs-core/src/opt/simplify/mod.rs | 36 +- .../psrs-core/src/opt/tests/global_inline.rs | 16 +- crates/psrs-core/src/opt/tests/mod.rs | 14 +- crates/psrs-core/src/verify/expr/intrinsic.rs | 2 +- crates/psrs-core/src/verify/types/mod.rs | 24 +- crates/psrs-desugar/src/tests.rs | 4 +- .../dictionary_audit/fixtures/methods.rs | 4 +- .../src/tests/intrinsic_contracts.rs | 78 +++++ crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/scalars.rs | 82 ++--- crates/psrs-hir/src/intrinsic/effects.rs | 34 ++ crates/psrs-hir/src/intrinsic/mod.rs | 179 +++++----- crates/psrs-hir/src/intrinsic/registry.rs | 64 ++-- crates/psrs-resolve/src/resolver/tests.rs | 2 +- crates/psrs-runtime/src/lib.rs | 30 +- .../psrs-typecheck/src/typecheck/tests/mod.rs | 2 +- docs/design/D-15-compiler-builtins.md | 74 ++-- docs/design/backend/00-ir-boundaries.md | 2 +- .../backend/fp/intrinsic-implementations.md | 83 +++++ docs/design/backend/fp/mir.md | 8 +- .../backend/fp/scalars-and-primitives.md | 179 +++------- .../backend/wasm/linking-and-runtime.md | 17 +- .../backend/control-flow-and-tail-calls.md | 2 +- .../intrinsic-implementations-2026-10-07.md | 99 ++++++ .../backend/linking-and-runtime.md | 14 + docs/implementation/backend/mir.md | 2 +- .../backend/scalars-and-primitives.md | 65 +--- stdlib.lock.json | 4 +- 65 files changed, 1577 insertions(+), 1774 deletions(-) delete mode 100644 crates/psrs-backend/src/cc/lower/scalar.rs create mode 100644 crates/psrs-backend/src/linking/tests.rs delete mode 100644 crates/psrs-backend/src/mir/gc_tests/div_mod/mod.rs delete mode 100644 crates/psrs-backend/src/mir/gc_tests/div_mod/switch.rs delete mode 100644 crates/psrs-backend/src/mir/lower/number_string.rs create mode 100644 crates/psrs-backend/src/mir/lower/runtime_call.rs delete mode 100644 crates/psrs-backend/src/mir/scalar_helpers.rs create mode 100644 crates/psrs-backend/src/target_intrinsics/generated.rs create mode 100644 crates/psrs-backend/src/target_intrinsics/mod.rs create mode 100644 crates/psrs-backend/src/target_intrinsics/tests.rs create mode 100644 crates/psrs-backend/src/target_runtime/language.rs rename crates/psrs-backend/src/{target_runtime.rs => target_runtime/mod.rs} (76%) create mode 100644 crates/psrs-backend/src/target_runtime/protocol_tests.rs create mode 100644 crates/psrs-driver/src/tests/intrinsic_contracts.rs create mode 100644 crates/psrs-hir/src/intrinsic/effects.rs create mode 100644 docs/design/backend/fp/intrinsic-implementations.md create mode 100644 docs/implementation/backend/intrinsic-implementations-2026-10-07.md diff --git a/crates/psrs-backend/src/bindings/primitives/mod.rs b/crates/psrs-backend/src/bindings/primitives/mod.rs index 9a1a9652..1579fcfd 100644 --- a/crates/psrs-backend/src/bindings/primitives/mod.rs +++ b/crates/psrs-backend/src/bindings/primitives/mod.rs @@ -70,7 +70,7 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), }; if !matches!( intrinsic.descriptor().category, - IntrinsicCategory::UnaryScalar + IntrinsicCategory::Unary | IntrinsicCategory::BinaryScalar | IntrinsicCategory::ArrayLength | IntrinsicCategory::ArrayIndex diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 0f3043f2..8ef2fd2f 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -6,10 +6,12 @@ use super::super::{Assignment, AssignmentKind, ValueId, ValueShape}; use super::FunctionLowerer; -use super::scalar::{lower_binary_op, lower_unary_op}; use crate::BackendError; +use crate::target_intrinsics::{ + GeneratedOperation as G, Implementation, ScalarOperation, implementation, +}; use psrs_core::Expr; -use psrs_hir::{Intrinsic, IntrinsicCategory}; +use psrs_hir::Intrinsic; impl FunctionLowerer<'_> { pub(super) fn lower_intrinsic( @@ -20,28 +22,24 @@ impl FunctionLowerer<'_> { ty: ValueShape, assignments: &mut Vec, ) -> Result> { - match intrinsic { - Intrinsic::NumberToString => { - let value = self.lower_value(&arguments[0], assignments)?; - let destination = self.fresh(ty); - assignments.push(Assignment { - destination, - kind: AssignmentKind::NumberToString { value }, - span: expression.span, - }); - Ok(destination) - } - Intrinsic::NumberFromDecimal => { - let value = self.lower_value(&arguments[0], assignments)?; + match implementation(intrinsic) { + Implementation::Artifact(_) => { + let values = arguments + .iter() + .map(|argument| self.lower_value(argument, assignments)) + .collect::, _>>()?; let destination = self.fresh(ty); assignments.push(Assignment { destination, - kind: AssignmentKind::NumberFromDecimal { value }, + kind: AssignmentKind::RuntimeCall { + intrinsic, + arguments: values, + }, span: expression.span, }); Ok(destination) } - Intrinsic::ArrayIndex => { + Implementation::Generated(G::ArrayIndex) => { let array = &arguments[0]; let Some(representation) = self.array_types.get(&array.ty).copied() else { return Err(vec![BackendError::new( @@ -65,14 +63,14 @@ impl FunctionLowerer<'_> { }); Ok(destination) } - Intrinsic::ArrayUpdate => self.lower_array_update( + Implementation::Generated(G::ArrayUpdate) => self.lower_array_update( expression, &arguments[0], &arguments[1], &arguments[2], assignments, ), - Intrinsic::ArrayLength => { + Implementation::Generated(G::ArrayLength) => { let value = self.lower_value(&arguments[0], assignments)?; let destination = self.fresh(ty); assignments.push(Assignment { @@ -82,26 +80,26 @@ impl FunctionLowerer<'_> { }); Ok(destination) } - Intrinsic::ArrayFill => { + Implementation::Generated(G::ArrayFill) => { self.lower_array_fill(expression, &arguments[0], &arguments[1], ty, assignments) } - Intrinsic::ArrayWrite => self.lower_array_write( + Implementation::Generated(G::ArrayWrite) => self.lower_array_write( expression, &arguments[0], &arguments[1], &arguments[2], assignments, ), - Intrinsic::ArrayAppend => { + Implementation::Generated(G::ArrayAppend) => { self.lower_array_append(expression, &arguments[0], &arguments[1], ty, assignments) } - Intrinsic::StringToBytes => { + Implementation::Generated(G::StringToBytes) => { self.lower_string_to_bytes(expression, &arguments[0], ty, assignments) } - Intrinsic::BytesToString => { + Implementation::Generated(G::BytesToString) => { self.lower_bytes_to_string(expression, &arguments[0], ty, assignments) } - Intrinsic::UnsafeCoerce => { + Implementation::Generated(G::UnsafeCoerce) => { let argument = &arguments[0]; let source_type = argument.ty; let source_shape = self.value_shape(source_type, expression.span)?; @@ -122,41 +120,33 @@ impl FunctionLowerer<'_> { assignments, )) } - _ => match intrinsic.descriptor().category { - IntrinsicCategory::BinaryScalar => { - let left = self.lower_value(&arguments[0], assignments)?; - let right = self.lower_value(&arguments[1], assignments)?; - let destination = self.fresh(ty); - assignments.push(Assignment { - destination, - kind: AssignmentKind::Primitive { - op: lower_binary_op(intrinsic), - left, - right, - }, - span: expression.span, - }); - Ok(destination) - } - IntrinsicCategory::UnaryScalar => { - let value = self.lower_value(&arguments[0], assignments)?; - let destination = self.fresh(ty); - assignments.push(Assignment { - destination, - kind: AssignmentKind::Unary { - op: lower_unary_op(intrinsic), - value, - }, - span: expression.span, - }); - Ok(destination) - } - _ => Err(vec![BackendError::new( + Implementation::Direct(operation) => { + let destination = self.fresh(ty); + let kind = match operation { + ScalarOperation::Unary(op) => AssignmentKind::Unary { + op, + value: self.lower_value(&arguments[0], assignments)?, + }, + ScalarOperation::Binary(op) => AssignmentKind::Primitive { + op, + left: self.lower_value(&arguments[0], assignments)?, + right: self.lower_value(&arguments[1], assignments)?, + }, + }; + assignments.push(Assignment { + destination, + kind, + span: expression.span, + }); + Ok(destination) + } + Implementation::Elaborated | Implementation::Unsupported => { + Err(vec![BackendError::invalid_ir( "P8 closure conversion", expression.span, - "intrinsic has no closure-conversion lowering", - )]), - }, + "intrinsic requires elaboration or has no runtime implementation", + )]) + } } } } diff --git a/crates/psrs-backend/src/cc/lower/letrec/tests.rs b/crates/psrs-backend/src/cc/lower/letrec/tests.rs index 582528ef..20962fc0 100644 --- a/crates/psrs-backend/src/cc/lower/letrec/tests.rs +++ b/crates/psrs-backend/src/cc/lower/letrec/tests.rs @@ -360,7 +360,7 @@ fn call_recursive( ) -> Expr { let decremented = expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Sub, + intrinsic: Intrinsic::IntSub, arguments: vec![local(parameter, int, start + 1), integer(1, int, start + 2)], }, int, @@ -381,7 +381,7 @@ fn call_recursive( fn eq_zero(local_id: LocalId, int: TypeId, boolean: TypeId, start: u32) -> Expr { expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Eq, + intrinsic: Intrinsic::IntEq, arguments: vec![local(local_id, int, start), integer(0, int, start + 1)], }, boolean, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 60d260f8..a6e72836 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -23,7 +23,6 @@ mod lambda; mod letrec; mod literals; mod record; -mod scalar; mod string_bytes; mod symbols; use call::ApplicationLowering; diff --git a/crates/psrs-backend/src/cc/lower/scalar.rs b/crates/psrs-backend/src/cc/lower/scalar.rs deleted file mode 100644 index c5dd512b..00000000 --- a/crates/psrs-backend/src/cc/lower/scalar.rs +++ /dev/null @@ -1,73 +0,0 @@ -//! P8 conversion from Core intrinsic identities to CC-owned scalar operations. - -use crate::cc::{BinaryOp, UnaryOp}; -use psrs_hir::Intrinsic; - -pub(super) fn lower_binary_op(value: Intrinsic) -> BinaryOp { - match value { - Intrinsic::I32Add => BinaryOp::IntAdd, - Intrinsic::I32Sub => BinaryOp::IntSub, - Intrinsic::I32Mul => BinaryOp::IntMul, - Intrinsic::I32DivS => BinaryOp::IntQuot, - Intrinsic::I32RemS => BinaryOp::IntRem, - Intrinsic::IntDiv => BinaryOp::IntDiv, - Intrinsic::IntMod => BinaryOp::IntMod, - Intrinsic::IntAnd => BinaryOp::IntAnd, - Intrinsic::IntOr => BinaryOp::IntOr, - Intrinsic::IntXor => BinaryOp::IntXor, - Intrinsic::IntShl => BinaryOp::IntShl, - Intrinsic::IntShr => BinaryOp::IntShr, - Intrinsic::IntZshr => BinaryOp::IntZshr, - Intrinsic::I32Eq => BinaryOp::IntEq, - Intrinsic::I32Ne => BinaryOp::IntNe, - Intrinsic::I32LtS => BinaryOp::IntLt, - Intrinsic::I32LeS => BinaryOp::IntLe, - Intrinsic::I32GtS => BinaryOp::IntGt, - Intrinsic::I32GeS => BinaryOp::IntGe, - Intrinsic::NumberAdd => BinaryOp::NumberAdd, - Intrinsic::NumberSub => BinaryOp::NumberSub, - Intrinsic::NumberMul => BinaryOp::NumberMul, - Intrinsic::NumberDiv => BinaryOp::NumberDiv, - Intrinsic::NumberEq => BinaryOp::NumberEq, - Intrinsic::NumberNe => BinaryOp::NumberNe, - Intrinsic::NumberLt => BinaryOp::NumberLt, - Intrinsic::NumberLe => BinaryOp::NumberLe, - Intrinsic::NumberGt => BinaryOp::NumberGt, - Intrinsic::NumberGe => BinaryOp::NumberGe, - Intrinsic::BooleanAnd => BinaryOp::BooleanAnd, - Intrinsic::BooleanOr => BinaryOp::BooleanOr, - Intrinsic::BooleanEq => BinaryOp::BooleanEq, - Intrinsic::BooleanNe => BinaryOp::BooleanNe, - Intrinsic::CharEq => BinaryOp::CharEq, - Intrinsic::CharNe => BinaryOp::CharNe, - Intrinsic::CharLt => BinaryOp::CharLt, - Intrinsic::CharLe => BinaryOp::CharLe, - Intrinsic::CharGt => BinaryOp::CharGt, - Intrinsic::CharGe => BinaryOp::CharGe, - _ => unreachable!( - "lower_binary_op is only called for a binary scalar intrinsic, got {value:?}" - ), - } -} - -pub(super) fn lower_unary_op(value: Intrinsic) -> UnaryOp { - match value { - Intrinsic::IntNeg => UnaryOp::IntNeg, - Intrinsic::IntComplement => UnaryOp::IntComplement, - Intrinsic::NumberNeg => UnaryOp::NumberNeg, - Intrinsic::NumberAbs => UnaryOp::NumberAbs, - Intrinsic::NumberTrunc => UnaryOp::NumberTrunc, - Intrinsic::NumberFloor => UnaryOp::NumberFloor, - Intrinsic::NumberCeil => UnaryOp::NumberCeil, - Intrinsic::BooleanNot => UnaryOp::BooleanNot, - Intrinsic::IntToNumber => UnaryOp::IntToNumber, - Intrinsic::NumberToInt => UnaryOp::NumberToInt, - Intrinsic::BooleanToInt => UnaryOp::BooleanToInt, - Intrinsic::IntToBoolean => UnaryOp::IntToBoolean, - Intrinsic::CharToInt => UnaryOp::CharToInt, - Intrinsic::IntToChar => UnaryOp::IntToChar, - _ => unreachable!( - "lower_unary_op is only called for a unary scalar intrinsic, got {value:?}" - ), - } -} diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 257864e7..6b9ff192 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -186,13 +186,10 @@ pub enum AssignmentKind { representation: ReprId, value: ValueId, }, - /// ECMAScript binary64 formatting; ordinary library wrappers own Show. - NumberToString { - value: ValueId, - }, - /// Checked complete-decimal conversion through the numeric runtime. - NumberFromDecimal { - value: ValueId, + /// Artifact-backed operation with checked language arguments before ABI erasure. + RuntimeCall { + intrinsic: psrs_hir::Intrinsic, + arguments: Vec, }, /// An `Array Int` read as a source `String`. Every element must be a /// canonical byte and the bytes must be well-formed UTF-8. diff --git a/crates/psrs-backend/src/cc/scalar.rs b/crates/psrs-backend/src/cc/scalar.rs index 47013e83..57428726 100644 --- a/crates/psrs-backend/src/cc/scalar.rs +++ b/crates/psrs-backend/src/cc/scalar.rs @@ -25,8 +25,6 @@ pub enum BinaryOp { IntMul, IntQuot, IntRem, - IntDiv, - IntMod, IntAnd, IntOr, IntXor, diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index 8b87199d..d5371bf6 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -85,25 +85,40 @@ pub(super) fn verify_assignments( verify_binary_operation(*op, *left, *right, assignment, declared)?; uses.extend([*left, *right]); } - AssignmentKind::NumberToString { value } => { - require_value_shape(declared, *value, ValueShape::Number, assignment)?; - require_destination( - declared, - assignment, - ValueShape::String, - "numberToString produces String", - )?; - uses.push(*value); - } - AssignmentKind::NumberFromDecimal { value } => { - require_value_shape(declared, *value, ValueShape::String, assignment)?; + AssignmentKind::RuntimeCall { + intrinsic, + arguments, + } => { + let crate::target_intrinsics::Implementation::Artifact(provider) = + crate::target_intrinsics::implementation(*intrinsic) + else { + return Err(assignment_error( + assignment, + "runtime call has no artifact implementation", + )); + }; + provider + .validate_protocol() + .map_err(|error| assignment_error(assignment, error))?; + let (parameters, result) = provider + .language_signature() + .map_err(|error| assignment_error(assignment, error))?; + if arguments.len() != parameters.len() { + return Err(assignment_error( + assignment, + "runtime call has an incompatible argument count", + )); + } + for (value, expected) in arguments.iter().zip(parameters) { + require_value_shape(declared, *value, expected, assignment)?; + } require_destination( declared, assignment, - ValueShape::Number, - "numberFromDecimal produces Number", + result, + "runtime call has an incompatible result shape", )?; - uses.push(*value); + uses.extend(arguments.iter().copied()); } AssignmentKind::Unary { op, value } => { verify_unary_operation(*op, *value, assignment, declared)?; diff --git a/crates/psrs-backend/src/cc/verify/scalar.rs b/crates/psrs-backend/src/cc/verify/scalar.rs index b722d703..64d774f6 100644 --- a/crates/psrs-backend/src/cc/verify/scalar.rs +++ b/crates/psrs-backend/src/cc/verify/scalar.rs @@ -14,8 +14,8 @@ pub(super) fn verify_binary_operation( use BinaryOp::*; let (operand, result) = match op { - IntAdd | IntSub | IntMul | IntQuot | IntRem | IntDiv | IntMod | IntAnd | IntOr | IntXor - | IntShl | IntShr | IntZshr => (ValueShape::Integer, ValueShape::Integer), + IntAdd | IntSub | IntMul | IntQuot | IntRem | IntAnd | IntOr | IntXor | IntShl | IntShr + | IntZshr => (ValueShape::Integer, ValueShape::Integer), IntEq | IntNe | IntLt | IntLe | IntGt | IntGe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe => (ValueShape::Integer, ValueShape::Boolean), NumberAdd | NumberSub | NumberMul | NumberDiv => (ValueShape::Number, ValueShape::Number), diff --git a/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs b/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs index b15f2cba..a9389f4f 100644 --- a/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs +++ b/crates/psrs-backend/src/cc/verify/tests/number_decimal.rs @@ -26,7 +26,10 @@ fn decimal_conversion_checks_both_shapes_before_abi_erasure() { ], assignments: vec![Assignment { destination: output, - kind: AssignmentKind::NumberFromDecimal { value: input }, + kind: AssignmentKind::RuntimeCall { + intrinsic: psrs_hir::Intrinsic::NumberFromDecimal, + arguments: vec![input], + }, span: TextRange::new(0, 1), }], result: output, @@ -39,3 +42,44 @@ fn decimal_conversion_checks_both_shapes_before_abi_erasure() { ); } } + +#[test] +fn runtime_calls_reject_wrong_arity_and_non_artifact_identities() { + use psrs_hir::Intrinsic; + let input = super::super::super::ValueId(0); + let output = super::super::super::ValueId(1); + for (intrinsic, arguments) in [ + (Intrinsic::NumberFromDecimal, vec![]), + (Intrinsic::NumberFromDecimal, vec![input, input]), + (Intrinsic::NumberAbs, vec![input]), + (Intrinsic::Undefined, vec![]), + ] { + let function = Function { + symbol: symbol(0), + name: "invalid_runtime_call".into(), + parameters: vec![input], + values: vec![ + ValueDecl { + id: input, + ty: ValueShape::String, + }, + ValueDecl { + id: output, + ty: ValueShape::Number, + }, + ], + assignments: vec![Assignment { + destination: output, + kind: AssignmentKind::RuntimeCall { + intrinsic, + arguments, + }, + span: TextRange::new(0, 1), + }], + result: output, + result_type: ValueShape::Number, + span: TextRange::new(0, 1), + }; + assert!(verify_function(&function, &HashMap::new(), &table()).is_err()); + } +} diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 1171373b..58290b1d 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -7,6 +7,7 @@ mod effects; mod linking; pub mod mir; mod pipeline; +mod target_intrinsics; mod target_runtime; pub mod trace; pub mod types; diff --git a/crates/psrs-backend/src/linking/mod.rs b/crates/psrs-backend/src/linking/mod.rs index 368543a8..209850c9 100644 --- a/crates/psrs-backend/src/linking/mod.rs +++ b/crates/psrs-backend/src/linking/mod.rs @@ -66,7 +66,14 @@ pub(crate) fn plan_for_module( next += 1; // Generated helpers are roots even though no source foreign declaration // names them; they are lowered locally and need no external provider. - if let Some(name) = local_symbol_name(import.symbol) { + if let Some(name) = crate::target_intrinsics::generated::name(import.symbol) { + crate::target_intrinsics::generated::verify(module, import).map_err(|message| { + vec![BackendError::invalid_ir( + "P9 target linking", + module.span, + message, + )] + })?; let requirement = BindingRequirement { id, origin: format!("generated.{name}"), @@ -82,7 +89,14 @@ pub(crate) fn plan_for_module( continue; } if let Some(implementation) = target_runtime::for_symbol(import.symbol) { - let requirement = implementation.requirement(id); + implementation.validate_protocol().map_err(|message| { + vec![BackendError::invalid_ir( + "P9 target linking", + module.span, + message, + )] + })?; + let requirement = implementation.requirement(id, core_signature(import, module.span)?); artifacts .entry(implementation.artifact.id.to_string()) .or_insert_with(|| implementation.artifact_reference()); @@ -198,16 +212,6 @@ pub(crate) fn compose( }) } -fn local_symbol_name(symbol: SymbolId) -> Option<&'static str> { - match symbol { - abi::REALLOC_SYMBOL => Some("realloc"), - abi::STRING_TO_BYTES_SYMBOL => Some("string_to_bytes"), - abi::BYTES_TO_STRING_SYMBOL => Some("bytes_to_string"), - abi::VALIDATE_STEP_SYMBOL => Some("validate_step"), - _ => None, - } -} - fn core_signature( import: &mir::Import, span: TextRange, @@ -218,7 +222,7 @@ fn core_signature( return Err(vec![BackendError::invalid_ir( "P9 target linking", span, - "a host import has a non-scalar canonical parameter", + "a raw import has a non-scalar canonical parameter", )]); }; parameters.push(ty); @@ -228,7 +232,7 @@ fn core_signature( vec![BackendError::invalid_ir( "P9 target linking", span, - "a host import has a non-scalar canonical result", + "a raw import has a non-scalar canonical result", )] })?), None => None, @@ -303,3 +307,6 @@ fn attach(error: BackendError, owner: Option) -> BackendError { None => error, } } + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/linking/tests.rs b/crates/psrs-backend/src/linking/tests.rs new file mode 100644 index 00000000..efc249f1 --- /dev/null +++ b/crates/psrs-backend/src/linking/tests.rs @@ -0,0 +1,123 @@ +use super::*; +use crate::types::{ + CompositeType, DefinedType, DefinedTypeId, FieldType, HeapType, RecGroup, RefType, StorageType, + ValueType, +}; + +fn module(import: mir::Import) -> mir::Module { + mir::Module { + name: "ConsumerAbi".into(), + entry: None, + types: vec![], + strings: vec![], + imports: vec![import], + functions: vec![], + layout: None, + span: TextRange::new(0, 1), + } +} + +fn plans(module: &mir::Module) -> bool { + plan_for_module( + &default_context().unwrap(), + module, + &mut WasiRegistry::load().unwrap(), + TargetCapabilities::default(), + ) + .is_ok() +} + +#[test] +fn actual_artifact_consumer_signatures_are_checked_before_emission() { + for provider in crate::target_intrinsics::artifacts() { + assert!(plans(&module(provider.import()))); + let good = provider.import(); + let mut invalid = Vec::new(); + let mut wrong = good.clone(); + wrong.parameters[0] = if wrong.parameters[0] == ValueType::I32 { + ValueType::F64 + } else { + ValueType::I32 + }; + invalid.push(wrong); + let mut wrong = good.clone(); + wrong.parameters.pop(); + invalid.push(wrong); + let mut wrong = good.clone(); + wrong.result = None; + invalid.push(wrong); + let mut wrong = good.clone(); + wrong.result = Some(ValueType::I64); + invalid.push(wrong); + let mut wrong = good; + wrong.parameters[0] = ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Any, + }); + invalid.push(wrong); + for import in invalid { + let module = module(import); + // MIR's local call contract can be consistent while its provider ABI is wrong. + crate::mir::verify_module(&module).unwrap(); + assert!(!plans(&module)); + assert!( + crate::wasm::lower_module(&module, &mut WasiRegistry::load().unwrap()).is_err() + ); + } + } +} + +#[test] +fn generated_bindings_match_the_shared_body_signature_and_string_layout() { + let string = Some(DefinedTypeId(0)); + for symbol in [ + abi::REALLOC_SYMBOL, + abi::STRING_TO_BYTES_SYMBOL, + abi::BYTES_TO_STRING_SYMBOL, + abi::VALIDATE_STEP_SYMBOL, + ] { + let mut good = + module(crate::target_intrinsics::generated::signature(symbol, string).unwrap()); + good.types.push(RecGroup(vec![DefinedType { + final_type: true, + supertype: None, + composite: CompositeType::Array(FieldType { + storage: StorageType::I8, + mutable: true, + }), + }])); + // validate_step is synthesized together with codecs and requires their string type. + if symbol == abi::VALIDATE_STEP_SYMBOL { + good.imports.push( + crate::target_intrinsics::generated::signature(abi::STRING_TO_BYTES_SYMBOL, string) + .unwrap(), + ); + } + assert!(plans(&good), "{symbol:?}"); + let mut wrong = good.clone(); + wrong.imports[0].result = None; + assert!(!plans(&wrong)); + let mut wrong = good.clone(); + wrong.imports[0].parameters.push(ValueType::I32); + assert!(!plans(&wrong)); + if symbol == abi::STRING_TO_BYTES_SYMBOL || symbol == abi::BYTES_TO_STRING_SYMBOL { + let mut wrong = good.clone(); + wrong.types[0].0[0].composite = CompositeType::Array(FieldType { + storage: StorageType::I32, + mutable: true, + }); + assert!(!plans(&wrong)); + let mut wrong = good; + let ty = if symbol == abi::STRING_TO_BYTES_SYMBOL { + &mut wrong.imports[0].parameters[0] + } else { + wrong.imports[0].result.as_mut().unwrap() + }; + *ty = ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Index(DefinedTypeId(0)), + }); + assert!(!plans(&wrong)); + } + } +} diff --git a/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs b/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs index 2525ed3c..9faea64e 100644 --- a/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs @@ -90,20 +90,6 @@ fn verifies_and_executes_every_cc_binary_scalar_variant_on_both_targets() { ValueShape::Integer, Expected::Integer(1), ), - ( - BinaryOp::IntDiv, - 0, - 1, - ValueShape::Integer, - Expected::Integer(3), - ), - ( - BinaryOp::IntMod, - 0, - 1, - ValueShape::Integer, - Expected::Integer(1), - ), ( BinaryOp::IntAnd, 0, @@ -482,6 +468,6 @@ fn verifies_and_executes_every_cc_binary_scalar_variant_on_both_targets() { crate::TargetCapabilities::default(), ) .expect("the complete binary scalar module should lower for GC"); - assert_eq!(gc_mir.functions.len(), 3); + assert_eq!(gc_mir.functions.len(), 1); run_gc(&gc_mir, 0); } diff --git a/crates/psrs-backend/src/mir/gc_tests/div_mod/mod.rs b/crates/psrs-backend/src/mir/gc_tests/div_mod/mod.rs deleted file mode 100644 index f20f256c..00000000 --- a/crates/psrs-backend/src/mir/gc_tests/div_mod/mod.rs +++ /dev/null @@ -1,277 +0,0 @@ -use super::*; - -mod switch; - -#[test] -fn lowers_euclidean_integer_division_and_modulo_on_both_targets() { - use crate::cc::BinaryOp; - - let symbol = SymbolId::new(ModuleId(0), 0); - let values = (0..42) - .map(|id| crate::cc::ValueDecl { - id: ValueId(id), - ty: if (24..=38).contains(&id) { - ValueShape::Boolean - } else { - ValueShape::Integer - }, - }) - .collect(); - let constant = |destination, value| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Constant(value), - span: span(), - }; - let binary = |destination, op, left, right| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Primitive { - op, - left: ValueId(left), - right: ValueId(right), - }, - span: span(), - }; - let module = CcModule { - name: "EuclideanScalars".into(), - externals: Vec::new(), - representations: RepresentationTable::default(), - functions: vec![CcFunction { - symbol, - name: "main".into(), - parameters: Vec::new(), - values, - assignments: vec![ - constant(0, -5), - constant(1, 3), - binary(2, BinaryOp::IntDiv, 0, 1), - binary(3, BinaryOp::IntMod, 0, 1), - constant(4, 5), - constant(5, -3), - binary(6, BinaryOp::IntDiv, 4, 5), - binary(7, BinaryOp::IntMod, 4, 5), - constant(8, -5), - constant(9, -3), - binary(10, BinaryOp::IntDiv, 8, 9), - binary(11, BinaryOp::IntMod, 8, 9), - constant(12, 6), - constant(13, -3), - binary(14, BinaryOp::IntDiv, 12, 13), - binary(15, BinaryOp::IntMod, 12, 13), - constant(16, -2), - constant(17, 1), - constant(18, -2), - constant(19, -1), - constant(20, 1), - constant(21, -2), - constant(22, -2), - constant(23, 0), - binary(24, BinaryOp::IntEq, 2, 16), - binary(25, BinaryOp::IntEq, 3, 17), - binary(26, BinaryOp::IntEq, 6, 18), - binary(27, BinaryOp::IntEq, 7, 19), - binary(28, BinaryOp::IntEq, 10, 20), - binary(29, BinaryOp::IntEq, 11, 21), - binary(30, BinaryOp::IntEq, 14, 22), - binary(31, BinaryOp::IntEq, 15, 23), - binary(32, BinaryOp::BooleanAnd, 24, 25), - binary(33, BinaryOp::BooleanAnd, 32, 26), - binary(34, BinaryOp::BooleanAnd, 33, 27), - binary(35, BinaryOp::BooleanAnd, 34, 28), - binary(36, BinaryOp::BooleanAnd, 35, 29), - binary(37, BinaryOp::BooleanAnd, 36, 30), - binary(38, BinaryOp::BooleanAnd, 37, 31), - Assignment { - destination: ValueId(39), - kind: AssignmentKind::If { - condition: ValueId(38), - then_assignments: vec![constant(40, 3)], - then_value: ValueId(40), - else_assignments: vec![constant(41, -1)], - else_value: ValueId(41), - }, - span: span(), - }, - ], - result: ValueId(39), - result_type: ValueShape::Integer, - span: span(), - }], - entry: Some(symbol), - span: span(), - }; - - let (gc_mir, _) = crate::mir::lower_module_with_capabilities( - module.clone(), - crate::TargetCapabilities::default(), - ) - .expect("Euclidean scalar CC should lower for the GC target"); - assert_eq!(gc_mir.functions.len(), 3); - assert_eq!(gc_mir.functions[1].name, "__psrs_euclidean_int_div"); - assert_eq!(gc_mir.functions[2].name, "__psrs_euclidean_int_mod"); - assert!( - gc_mir.functions[0] - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter(|instruction| matches!(instruction, Instruction::Call { .. })) - .count() - >= 8 - ); - run_gc(&gc_mir, 3); -} - -#[test] -fn does_not_emit_helpers_without_division_or_modulo() { - use crate::cc::BinaryOp; - - let symbol = SymbolId::new(ModuleId(0), 0); - let values = (0..=3) - .map(|id| crate::cc::ValueDecl { - id: ValueId(id), - ty: ValueShape::Integer, - }) - .collect(); - let module = CcModule { - name: "NoEuclideanScalars".into(), - externals: Vec::new(), - representations: RepresentationTable::default(), - functions: vec![CcFunction { - symbol, - name: "main".into(), - parameters: Vec::new(), - values, - assignments: vec![ - Assignment { - destination: ValueId(0), - kind: AssignmentKind::Constant(7), - span: span(), - }, - Assignment { - destination: ValueId(1), - kind: AssignmentKind::Constant(2), - span: span(), - }, - Assignment { - destination: ValueId(2), - kind: AssignmentKind::Primitive { - op: BinaryOp::IntAdd, - left: ValueId(0), - right: ValueId(1), - }, - span: span(), - }, - Assignment { - destination: ValueId(3), - kind: AssignmentKind::Primitive { - op: BinaryOp::IntQuot, - left: ValueId(0), - right: ValueId(1), - }, - span: span(), - }, - ], - result: ValueId(2), - result_type: ValueShape::Integer, - span: span(), - }], - entry: Some(symbol), - span: span(), - }; - - let (gc_mir, _) = - crate::mir::lower_module_with_capabilities(module, crate::TargetCapabilities::default()) - .expect("truncated quotient must not require a floor helper"); - assert_eq!(gc_mir.functions.len(), 1); - run_gc(&gc_mir, 9); -} - -#[test] -fn skips_helper_symbols_used_by_module_functions() { - use crate::cc::BinaryOp; - - let colliding = SymbolId::new(ModuleId(0), u32::MAX); - let values = (0..=4) - .map(|id| crate::cc::ValueDecl { - id: ValueId(id), - ty: ValueShape::Integer, - }) - .collect(); - let module = CcModule { - name: "CollidingScalarSymbols".into(), - externals: Vec::new(), - representations: RepresentationTable::default(), - functions: vec![CcFunction { - symbol: colliding, - name: "main".into(), - parameters: Vec::new(), - values, - assignments: vec![ - Assignment { - destination: ValueId(0), - kind: AssignmentKind::Constant(7), - span: span(), - }, - Assignment { - destination: ValueId(1), - kind: AssignmentKind::Constant(2), - span: span(), - }, - Assignment { - destination: ValueId(2), - kind: AssignmentKind::Primitive { - op: BinaryOp::IntDiv, - left: ValueId(0), - right: ValueId(1), - }, - span: span(), - }, - Assignment { - destination: ValueId(3), - kind: AssignmentKind::Primitive { - op: BinaryOp::IntMod, - left: ValueId(0), - right: ValueId(1), - }, - span: span(), - }, - Assignment { - destination: ValueId(4), - kind: AssignmentKind::Primitive { - op: BinaryOp::IntAdd, - left: ValueId(2), - right: ValueId(3), - }, - span: span(), - }, - ], - result: ValueId(4), - result_type: ValueShape::Integer, - span: span(), - }], - entry: Some(colliding), - span: span(), - }; - - let (gc_mir, _) = - crate::mir::lower_module_with_capabilities(module, crate::TargetCapabilities::default()) - .expect("the helper allocator must skip the colliding module symbol"); - assert_eq!(gc_mir.functions.len(), 3); - let helpers = gc_mir - .functions - .iter() - .filter(|function| function.name.starts_with("__psrs_euclidean")) - .collect::>(); - assert_eq!(helpers.len(), 2); - let mut symbols = std::collections::HashSet::new(); - for helper in helpers { - assert_ne!( - helper.symbol, colliding, - "a generated helper reused a module symbol" - ); - assert!( - symbols.insert(helper.symbol), - "generated helpers share a symbol" - ); - } - run_gc(&gc_mir, 4); -} diff --git a/crates/psrs-backend/src/mir/gc_tests/div_mod/switch.rs b/crates/psrs-backend/src/mir/gc_tests/div_mod/switch.rs deleted file mode 100644 index 3f0d5514..00000000 --- a/crates/psrs-backend/src/mir/gc_tests/div_mod/switch.rs +++ /dev/null @@ -1,260 +0,0 @@ -use super::*; - -#[test] -fn detects_division_and_modulo_nested_in_tag_switch_cases() { - use crate::cc::{BinaryOp, TagCase}; - - let symbol = SymbolId::new(ModuleId(0), 0); - let values = (0..=7) - .map(|id| crate::cc::ValueDecl { - id: ValueId(id), - ty: ValueShape::Integer, - }) - .collect(); - let constant = |destination, value| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Constant(value), - span: span(), - }; - let binary = |destination, op, left, right| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Primitive { - op, - left: ValueId(left), - right: ValueId(right), - }, - span: span(), - }; - let module = CcModule { - name: "NestedEuclideanScalars".into(), - externals: Vec::new(), - representations: RepresentationTable::default(), - functions: vec![CcFunction { - symbol, - name: "main".into(), - parameters: Vec::new(), - values, - assignments: vec![ - constant(0, 0), - Assignment { - destination: ValueId(7), - kind: AssignmentKind::TagSwitch { - value: ValueId(0), - cases: vec![TagCase { - tag: 0, - assignments: vec![ - constant(1, 7), - constant(2, 2), - binary(3, BinaryOp::IntDiv, 1, 2), - binary(4, BinaryOp::IntMod, 1, 2), - binary(5, BinaryOp::IntAdd, 3, 4), - ], - value: ValueId(5), - }], - default_assignments: vec![constant(6, 0)], - default_value: ValueId(6), - }, - span: span(), - }, - ], - result: ValueId(7), - result_type: ValueShape::Integer, - span: span(), - }], - entry: Some(symbol), - span: span(), - }; - - let (gc_mir, _) = - crate::mir::lower_module_with_capabilities(module, crate::TargetCapabilities::default()) - .expect("division nested in a tag switch must still generate its helper"); - assert_eq!(gc_mir.functions.len(), 3); - assert!( - gc_mir - .functions - .iter() - .any(|function| function.name == "__psrs_euclidean_int_div"), - "the nested divide must allocate the div helper" - ); - assert!( - gc_mir - .functions - .iter() - .any(|function| function.name == "__psrs_euclidean_int_mod"), - "the nested modulo must allocate the mod helper" - ); - run_gc(&gc_mir, 4); -} - -#[test] -fn detects_modulo_nested_in_a_tag_switch_default_arm() { - use crate::cc::{BinaryOp, TagCase}; - - let symbol = SymbolId::new(ModuleId(0), 0); - let values = (0..=8) - .map(|id| crate::cc::ValueDecl { - id: ValueId(id), - ty: ValueShape::Integer, - }) - .collect(); - let constant = |destination, value| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Constant(value), - span: span(), - }; - let binary = |destination, op, left, right| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Primitive { - op, - left: ValueId(left), - right: ValueId(right), - }, - span: span(), - }; - let module = CcModule { - name: "DefaultEuclideanScalars".into(), - externals: Vec::new(), - representations: RepresentationTable::default(), - functions: vec![CcFunction { - symbol, - name: "main".into(), - parameters: Vec::new(), - values, - assignments: vec![ - constant(0, 1), - Assignment { - destination: ValueId(8), - kind: AssignmentKind::TagSwitch { - value: ValueId(0), - cases: vec![TagCase { - tag: 0, - assignments: vec![ - constant(1, 7), - constant(2, 2), - binary(3, BinaryOp::IntDiv, 1, 2), - ], - value: ValueId(3), - }], - default_assignments: vec![ - constant(4, 7), - constant(5, 2), - binary(6, BinaryOp::IntMod, 4, 5), - ], - default_value: ValueId(6), - }, - span: span(), - }, - ], - result: ValueId(8), - result_type: ValueShape::Integer, - span: span(), - }], - entry: Some(symbol), - span: span(), - }; - - let (gc_mir, _) = - crate::mir::lower_module_with_capabilities(module, crate::TargetCapabilities::default()) - .expect("modulo in a tag switch default arm must still generate its helper"); - assert_eq!(gc_mir.functions.len(), 3); - assert!( - gc_mir - .functions - .iter() - .any(|function| function.name == "__psrs_euclidean_int_div") - ); - assert!( - gc_mir - .functions - .iter() - .any(|function| function.name == "__psrs_euclidean_int_mod") - ); - run_gc(&gc_mir, 1); -} - -#[test] -fn generates_helpers_for_division_and_modulo_inside_tag_switch_arms() { - use crate::cc::{BinaryOp, TagCase}; - - let symbol = SymbolId::new(ModuleId(0), 0); - let values = (0..=8) - .map(|id| crate::cc::ValueDecl { - id: ValueId(id), - ty: ValueShape::Integer, - }) - .collect(); - let constant = |destination, value| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Constant(value), - span: span(), - }; - let binary = |destination, op, left, right| Assignment { - destination: ValueId(destination), - kind: AssignmentKind::Primitive { - op, - left: ValueId(left), - right: ValueId(right), - }, - span: span(), - }; - let module = CcModule { - name: "TagSwitchScalars".into(), - externals: Vec::new(), - representations: RepresentationTable::default(), - functions: vec![CcFunction { - symbol, - name: "main".into(), - parameters: Vec::new(), - values, - assignments: vec![ - constant(0, 0), - Assignment { - destination: ValueId(5), - kind: AssignmentKind::TagSwitch { - value: ValueId(0), - cases: vec![TagCase { - tag: 0, - assignments: vec![ - constant(2, 7), - constant(3, 3), - binary(4, BinaryOp::IntDiv, 2, 3), - ], - value: ValueId(4), - }], - default_assignments: vec![ - constant(6, 7), - constant(7, 3), - binary(8, BinaryOp::IntMod, 6, 7), - ], - default_value: ValueId(8), - }, - span: span(), - }, - ], - result: ValueId(5), - result_type: ValueShape::Integer, - span: span(), - }], - entry: Some(symbol), - span: span(), - }; - - let (gc_mir, _) = - crate::mir::lower_module_with_capabilities(module, crate::TargetCapabilities::default()) - .expect("division and modulo inside a tag switch should lower"); - assert!( - gc_mir - .functions - .iter() - .any(|function| function.name == "__psrs_euclidean_int_div"), - "the IntDiv helper must be generated for a case arm" - ); - assert!( - gc_mir - .functions - .iter() - .any(|function| function.name == "__psrs_euclidean_int_mod"), - "the IntMod helper must be generated for the default arm" - ); - run_gc(&gc_mir, 2); -} diff --git a/crates/psrs-backend/src/mir/gc_tests/mod.rs b/crates/psrs-backend/src/mir/gc_tests/mod.rs index 3d57eeba..e325fcb5 100644 --- a/crates/psrs-backend/src/mir/gc_tests/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/mod.rs @@ -8,7 +8,6 @@ use std::sync::atomic::{AtomicU32, Ordering}; mod array; mod binary_matrix; -mod div_mod; mod erased; mod number_trunc; mod rank_n; diff --git a/crates/psrs-backend/src/mir/gc_tests/unary.rs b/crates/psrs-backend/src/mir/gc_tests/unary.rs index 04699681..7f4af630 100644 --- a/crates/psrs-backend/src/mir/gc_tests/unary.rs +++ b/crates/psrs-backend/src/mir/gc_tests/unary.rs @@ -75,7 +75,7 @@ fn lowers_unary_and_conversion_operations_on_both_targets() { span: span(), }; let module = CcModule { - name: "UnaryScalars".into(), + name: "Unarys".into(), externals: Vec::new(), representations: RepresentationTable::default(), functions: vec![CcFunction { diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index cc8e1bb7..e9473448 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -91,28 +91,31 @@ impl FunctionLowerer<'_> { )?; continue; } - let instruction = self.scalar_helpers.binary_instruction( - *op, - assignment.destination, - *left, - *right, - assignment.span, - )?; + let operation = super::super::NumericOp::try_from(*op).map_err(|op| { + vec![BackendError::invalid_ir( + "P9 MIR lowering", + assignment.span, + format!("unsupported scalar operation {op:?}"), + )] + })?; + let instruction = Instruction::Primitive { + destination: assignment.destination, + op: operation, + left: *left, + right: *right, + span: assignment.span, + }; self.append_instruction(current, instruction, assignment.span)?; } - AssignmentKind::NumberToString { value } => { - self.lower_number_to_string( - current, - assignment.destination, - *value, - assignment.span, - )?; - } - AssignmentKind::NumberFromDecimal { value } => { - self.lower_number_from_decimal( + AssignmentKind::RuntimeCall { + intrinsic, + arguments, + } => { + self.lower_runtime_call( current, assignment.destination, - *value, + *intrinsic, + arguments, assignment.span, )?; } diff --git a/crates/psrs-backend/src/mir/lower/conversion_helpers.rs b/crates/psrs-backend/src/mir/lower/conversion_helpers.rs index 9ba12a19..8b452693 100644 --- a/crates/psrs-backend/src/mir/lower/conversion_helpers.rs +++ b/crates/psrs-backend/src/mir/lower/conversion_helpers.rs @@ -1,5 +1,4 @@ use crate::cc::{self, AggregateConvert, ValueConversion}; -use crate::mir::Function; use crate::types::ValueId; use psrs_hir::{ModuleId, SymbolId}; use psrs_span::TextRange; @@ -15,13 +14,12 @@ pub(in crate::mir) struct ConversionHelpers { } impl ConversionHelpers { - pub(in crate::mir) fn new(module: &cc::Module, scalar_helpers: &[Function]) -> Self { + pub(in crate::mir) fn new(module: &cc::Module) -> Self { let mut used: HashSet = module .functions .iter() .map(|function| function.symbol) .chain(module.externals.iter().map(|external| external.symbol)) - .chain(scalar_helpers.iter().map(|function| function.symbol)) .collect(); // Intrinsic symbols are allocated downward from `u32::MAX`; the // canonical ABI and codec reserve the top indices. @@ -134,7 +132,7 @@ mod tests { entry: None, span: TextRange::new(0, 1), }; - let mut helpers = ConversionHelpers::new(&module, &[]); + let mut helpers = ConversionHelpers::new(&module); let span = TextRange::new(0, 1); let first = array_conversion(ValueConversion::Identity); let different = array_conversion(ValueConversion::EraseReference); diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index fbb7a614..9ada99e1 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -6,7 +6,6 @@ use super::{BasicBlock, BlockId, Function, Terminator}; use crate::BackendError; use crate::cc::{self, AssignmentKind}; use crate::mir::instruction::Instruction; -use crate::mir::scalar_helpers::ScalarHelpers; use crate::types::{FunctionId, HeapType, ValueDecl, ValueId, ValueType}; use psrs_hir::SymbolId; use psrs_span::TextRange; @@ -18,7 +17,7 @@ mod assignment_array; mod assignment_string; mod assignments; mod conversion_helpers; -mod number_string; +mod runtime_call; mod tail; mod variant; pub(super) use conversion_helpers::ConversionHelpers; @@ -46,7 +45,6 @@ pub(super) fn lower_function( source: &cc::Function, id: FunctionId, wit_imports: &HashMap, - scalar_helpers: &ScalarHelpers, layout: &PlannedLayout, conversion_helpers: Option<&mut ConversionHelpers>, literals: Option<&mut StringLiterals>, @@ -80,7 +78,6 @@ pub(super) fn lower_function( .max() .map_or(0, |max| max + 1), wit_imports, - scalar_helpers, layout, conversion_helpers, literals, @@ -118,7 +115,6 @@ pub(super) struct FunctionLowerer<'a> { values: Vec, next_value: u32, wit_imports: &'a HashMap, - scalar_helpers: &'a ScalarHelpers, pub(in crate::mir) layout: &'a PlannedLayout, conversion_helpers: Option<&'a mut ConversionHelpers>, literals: Option<&'a mut StringLiterals>, diff --git a/crates/psrs-backend/src/mir/lower/number_string.rs b/crates/psrs-backend/src/mir/lower/number_string.rs deleted file mode 100644 index 92214f15..00000000 --- a/crates/psrs-backend/src/mir/lower/number_string.rs +++ /dev/null @@ -1,100 +0,0 @@ -//! Checked raw runtime formatting followed by canonical UTF-8 recovery. -use super::*; - -impl FunctionLowerer<'_> { - pub(super) fn lower_number_from_decimal( - &mut self, - block: BlockId, - destination: ValueId, - value: ValueId, - span: TextRange, - ) -> Result<(), Vec> { - let implementation = - crate::target_runtime::implementation(psrs_hir::Intrinsic::NumberFromDecimal) - .expect("NumberFromDecimal has a registered target implementation"); - let mut arguments = Vec::new(); - let mut frees = Vec::new(); - // The same canonical UTF-8 copy and release protocol serves WIT calls - // and this private raw runtime call. The runtime retains no pointer. - crate::mir::wit::lower_string(self, value, &mut arguments, &mut frees, block, span)?; - self.append_instruction( - block, - Instruction::Call { - destination, - function: implementation.symbol, - arguments, - span, - }, - span, - )?; - for pending in frees { - crate::mir::wit::free_buffer( - self, - pending.pointer, - pending.length, - pending.align, - block, - span, - )?; - } - Ok(()) - } - - pub(super) fn lower_number_to_string( - &mut self, - block: BlockId, - destination: ValueId, - value: ValueId, - span: TextRange, - ) -> Result<(), Vec> { - let implementation = - crate::target_runtime::implementation(psrs_hir::Intrinsic::NumberToString) - .expect("NumberToString has a registered target implementation"); - let zero = self.constant(block, 0, span)?; - let align = self.constant(block, 1, span)?; - let capacity = self.constant(block, psrs_runtime::NUMBER_CAPACITY as i32, span)?; - let buffer = self.fresh(ValueType::I32); - self.append_instruction( - block, - Instruction::Call { - destination: buffer, - function: crate::abi::REALLOC_SYMBOL, - arguments: vec![zero, zero, align, capacity], - span, - }, - span, - )?; - let length = self.fresh(ValueType::I32); - self.append_instruction( - block, - Instruction::Call { - destination: length, - function: implementation.symbol, - arguments: vec![value, buffer, capacity], - span, - }, - span, - )?; - self.append_instruction( - block, - Instruction::Call { - destination, - function: crate::abi::BYTES_TO_STRING_SYMBOL, - arguments: vec![buffer, length], - span, - }, - span, - )?; - let discarded = self.fresh(ValueType::I32); - self.append_instruction( - block, - Instruction::Call { - destination: discarded, - function: crate::abi::REALLOC_SYMBOL, - arguments: vec![buffer, capacity, align, zero], - span, - }, - span, - ) - } -} diff --git a/crates/psrs-backend/src/mir/lower/runtime_call.rs b/crates/psrs-backend/src/mir/lower/runtime_call.rs new file mode 100644 index 00000000..6ece156b --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/runtime_call.rs @@ -0,0 +1,127 @@ +//! Language-value transport selected by the artifact's checked value protocol. +use super::*; +use crate::target_intrinsics::{Implementation, implementation}; +use psrs_runtime::RawCallProtocol; + +impl FunctionLowerer<'_> { + pub(super) fn lower_runtime_call( + &mut self, + block: BlockId, + destination: ValueId, + intrinsic: psrs_hir::Intrinsic, + arguments: &[ValueId], + span: TextRange, + ) -> Result<(), Vec> { + let Implementation::Artifact(provider) = implementation(intrinsic) else { + return Err(vec![BackendError::invalid_ir( + "P9 MIR lowering", + span, + "runtime call has no artifact provider", + )]); + }; + provider + .validate_protocol() + .map_err(|error| vec![BackendError::invalid_ir("P9 MIR lowering", span, error)])?; + match provider.abi.protocol { + RawCallProtocol::Scalars => { + self.emit_artifact_call(block, destination, provider, arguments.to_vec(), span) + } + RawCallProtocol::Utf8Input => { + let mut raw = Vec::new(); + let mut frees = Vec::new(); + crate::mir::wit::lower_string( + self, + arguments[0], + &mut raw, + &mut frees, + block, + span, + )?; + self.emit_artifact_call(block, destination, provider, raw, span)?; + for pending in frees { + crate::mir::wit::free_buffer( + self, + pending.pointer, + pending.length, + pending.align, + block, + span, + )?; + } + Ok(()) + } + RawCallProtocol::Utf8Output { capacity } => { + let zero = self.constant(block, 0, span)?; + let align = self.constant(block, 1, span)?; + let capacity = self.constant(block, capacity as i32, span)?; + let buffer = self.fresh(ValueType::I32); + self.append_instruction( + block, + Instruction::Call { + destination: buffer, + function: crate::abi::REALLOC_SYMBOL, + arguments: vec![zero, zero, align, capacity], + span, + }, + span, + )?; + let length = self.fresh(ValueType::I32); + let mut raw = arguments.to_vec(); + raw.extend([buffer, capacity]); + self.emit_artifact_call(block, length, provider, raw, span)?; + self.append_instruction( + block, + Instruction::Call { + destination, + function: crate::abi::BYTES_TO_STRING_SYMBOL, + arguments: vec![buffer, length], + span, + }, + span, + )?; + crate::mir::wit::free_buffer(self, buffer, capacity, 1, block, span) + } + } + } + + fn emit_artifact_call( + &mut self, + block: BlockId, + destination: ValueId, + provider: &crate::target_runtime::ArtifactImplementation, + arguments: Vec, + span: TextRange, + ) -> Result<(), Vec> { + if provider.abi.result.is_some() { + self.append_instruction( + block, + Instruction::Call { + destination, + function: provider.symbol, + arguments, + span, + }, + span, + ) + } else { + self.append_instruction( + block, + Instruction::CallVoid { + function: provider.symbol, + arguments, + span, + }, + span, + )?; + self.append_instruction( + block, + Instruction::Constant { + destination, + value: 0, + span, + }, + span, + ) + } + } +} diff --git a/crates/psrs-backend/src/mir/lower/wit_tests.rs b/crates/psrs-backend/src/mir/lower/wit_tests.rs index d3ad36d6..3d23ab57 100644 --- a/crates/psrs-backend/src/mir/lower/wit_tests.rs +++ b/crates/psrs-backend/src/mir/lower/wit_tests.rs @@ -36,7 +36,6 @@ fn gc_wit_record_projection_uses_the_planned_product_type() { }], next_value: 1, wit_imports: &HashMap::new(), - scalar_helpers: &ScalarHelpers::default(), layout: &layout, literals: None, }; diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index fb16e695..043988a4 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -15,14 +15,12 @@ mod numeric; pub mod opt; mod planner; mod reachable; -mod scalar_helpers; mod verify; mod wit; use literals::StringLiterals; use lower::lower_function; use planner::{GcPlanner, RepresentationPlanner}; -use scalar_helpers::lower_scalar_helpers; pub use instruction::{Instruction, ListDirection}; pub use numeric::{NumericOp, UnaryOp}; @@ -284,9 +282,7 @@ fn lower_module_after_binding_validation( module.entry.map(|entry| entry.module), ) })?; - let (scalar_helpers, generated_helpers) = - lower_scalar_helpers(&module, module.functions.len() as u32); - let mut conversion_helpers = lower::ConversionHelpers::new(&module, &generated_helpers); + let mut conversion_helpers = lower::ConversionHelpers::new(&module); let mut literals = StringLiterals::default(); let mut functions = Vec::with_capacity(module.functions.len()); for (id, function) in module.functions.iter().enumerate() { @@ -294,7 +290,6 @@ fn lower_module_after_binding_validation( function, FunctionId(id as u32), &wit_imports, - &scalar_helpers, &layout, Some(&mut conversion_helpers), Some(&mut literals), @@ -308,14 +303,12 @@ fn lower_module_after_binding_validation( })?; functions.push(lowered); } - functions.extend(generated_helpers); let first_helper_id = functions.len() as u32; for (offset, helper) in conversion_helpers.into_functions().iter().enumerate() { let lowered = lower_function( helper, FunctionId(first_helper_id + offset as u32), &wit_imports, - &scalar_helpers, &layout, None, Some(&mut literals), @@ -342,19 +335,18 @@ fn lower_module_after_binding_validation( .iter() .any(|import| used.contains(&import.symbol) && import.has_indirect_parameters()) { - imports.push(Import { - symbol: crate::abi::REALLOC_SYMBOL, - parameters: vec![ValueType::I32; 4], - result: Some(ValueType::I32), - }); + imports.push( + crate::target_intrinsics::generated::signature(crate::abi::REALLOC_SYMBOL, None) + .expect("allocator signature has no layout dependency"), + ); } - for implementation in crate::target_runtime::IMPLEMENTATIONS { + for implementation in crate::target_intrinsics::artifacts() { if used.contains(&implementation.symbol) { imports.push(implementation.import()); } } - // The canonical ABI boundary transcodes between the GC string's UTF-16 and - // the component's UTF-8. The adapter calls these reserved helpers, which P10 + // The canonical ABI boundary copies canonical UTF-8 between GC strings and + // component linear buffers. The adapter calls these reserved helpers, which P10 // synthesizes as ordinary Wasm functions; they are never core imports. if used.contains(&crate::abi::STRING_TO_BYTES_SYMBOL) || used.contains(&crate::abi::BYTES_TO_STRING_SYMBOL) @@ -371,19 +363,27 @@ fn lower_module_after_binding_validation( module.entry.map(|entry| entry.module), ) })?; - if used.contains(&crate::abi::STRING_TO_BYTES_SYMBOL) { - imports.push(Import { - symbol: crate::abi::STRING_TO_BYTES_SYMBOL, - parameters: vec![string_type], - result: Some(ValueType::I32), - }); - } - if used.contains(&crate::abi::BYTES_TO_STRING_SYMBOL) { - imports.push(Import { - symbol: crate::abi::BYTES_TO_STRING_SYMBOL, - parameters: vec![ValueType::I32, ValueType::I32], - result: Some(string_type), - }); + let ValueType::Ref(crate::types::RefType { + nullable: false, + heap: crate::types::HeapType::Index(string_id), + }) = string_type + else { + return Err(vec![BackendError::invalid_ir( + "P9 MIR lowering", + module.span, + "string layout must be a nonnullable concrete GC reference", + )]); + }; + for symbol in [ + crate::abi::STRING_TO_BYTES_SYMBOL, + crate::abi::BYTES_TO_STRING_SYMBOL, + ] { + if used.contains(&symbol) { + imports.push( + crate::target_intrinsics::generated::signature(symbol, Some(string_id)) + .expect("codec has its checked string layout"), + ); + } } } let strings = literals.into_strings(); diff --git a/crates/psrs-backend/src/mir/numeric.rs b/crates/psrs-backend/src/mir/numeric.rs index e3dad222..114b1540 100644 --- a/crates/psrs-backend/src/mir/numeric.rs +++ b/crates/psrs-backend/src/mir/numeric.rs @@ -86,7 +86,6 @@ impl TryFrom for NumericOp { BinaryOp::IntMul => Self::I32Mul, BinaryOp::IntQuot => Self::I32DivS, BinaryOp::IntRem => Self::I32RemS, - BinaryOp::IntDiv | BinaryOp::IntMod => return Err(value), BinaryOp::IntAnd => Self::I32And, BinaryOp::IntOr => Self::I32Or, BinaryOp::IntXor => Self::I32Xor, diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index aac94a2a..d737bb0b 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -134,8 +134,7 @@ pub(super) fn add_assignments( | AssignmentKind::StringConstant(_) | AssignmentKind::Primitive { .. } | AssignmentKind::Unary { .. } - | AssignmentKind::NumberToString { .. } - | AssignmentKind::NumberFromDecimal { .. } + | AssignmentKind::RuntimeCall { .. } | AssignmentKind::ArrayLen { .. } | AssignmentKind::Unreachable => {} AssignmentKind::ClosureGetCapture { .. } => { diff --git a/crates/psrs-backend/src/mir/scalar_helpers.rs b/crates/psrs-backend/src/mir/scalar_helpers.rs deleted file mode 100644 index 77a5fa0e..00000000 --- a/crates/psrs-backend/src/mir/scalar_helpers.rs +++ /dev/null @@ -1,327 +0,0 @@ -use crate::cc::{self, AssignmentKind, BinaryOp}; -use crate::mir::{BasicBlock, BlockId, Function, Instruction, NumericOp, Terminator}; -use crate::types::{FunctionId, ValueDecl, ValueId, ValueType}; -use crate::{BackendError, mir}; -use psrs_hir::{ModuleId, SymbolId}; -use psrs_span::TextRange; -use std::collections::HashSet; - -#[derive(Clone, Copy, Debug, Default)] -pub(super) struct ScalarHelpers { - pub(super) int_div: Option, - pub(super) int_mod: Option, -} - -impl ScalarHelpers { - pub(super) fn binary_instruction( - &self, - op: BinaryOp, - destination: ValueId, - left: ValueId, - right: ValueId, - span: TextRange, - ) -> Result> { - let helper = match op { - BinaryOp::IntDiv => self.int_div, - BinaryOp::IntMod => self.int_mod, - _ => None, - }; - if let Some(function) = helper { - return Ok(Instruction::Call { - destination, - function, - arguments: vec![left, right], - span, - }); - } - let op = mir::NumericOp::try_from(op).map_err(|unlowered| { - vec![BackendError::invalid_ir( - "P9 MIR lowering", - span, - format!("missing MIR helper for scalar operation {unlowered:?}"), - )] - })?; - Ok(Instruction::Primitive { - destination, - op, - left, - right, - span, - }) - } -} - -pub(super) fn lower_scalar_helpers( - module: &cc::Module, - first_function_id: u32, -) -> (ScalarHelpers, Vec) { - let needs_int_div = module - .functions - .iter() - .any(|function| contains_operation(&function.assignments, BinaryOp::IntDiv)); - let needs_int_mod = module - .functions - .iter() - .any(|function| contains_operation(&function.assignments, BinaryOp::IntMod)); - let mut used_symbols = module - .functions - .iter() - .map(|function| function.symbol) - .chain(module.externals.iter().map(|external| external.symbol)) - .collect::>(); - // Intrinsic symbols may be allocated downward from `u32::MAX`; never take - // one the canonical ABI or codec reserves. - used_symbols.extend(crate::abi::RESERVED_ABI_SYMBOLS); - let symbol_module = module - .functions - .first() - .map_or(ModuleId::INTRINSICS, |function| function.symbol.module); - let int_div = needs_int_div.then(|| allocate_symbol(symbol_module, &mut used_symbols)); - let int_mod = needs_int_mod.then(|| allocate_symbol(symbol_module, &mut used_symbols)); - let helpers = ScalarHelpers { int_div, int_mod }; - let mut functions = Vec::new(); - let mut next_id = first_function_id; - if let Some(symbol) = int_div { - functions.push(euclidean_helper( - FunctionId(next_id), - symbol, - EuclideanOperation::Divide, - module.span, - )); - next_id += 1; - } - if let Some(symbol) = int_mod { - functions.push(euclidean_helper( - FunctionId(next_id), - symbol, - EuclideanOperation::Modulo, - module.span, - )); - } - (helpers, functions) -} - -fn allocate_symbol(module: ModuleId, used: &mut HashSet) -> SymbolId { - let mut index = u32::MAX; - loop { - let symbol = SymbolId::new(module, index); - if used.insert(symbol) { - return symbol; - } - index = index - .checked_sub(1) - .expect("generated scalar helper symbol space exhausted"); - } -} - -fn contains_operation(assignments: &[cc::Assignment], needle: BinaryOp) -> bool { - assignments.iter().any(|assignment| match &assignment.kind { - AssignmentKind::Primitive { op, .. } => *op == needle, - AssignmentKind::If { - then_assignments, - else_assignments, - .. - } => { - contains_operation(then_assignments, needle) - || contains_operation(else_assignments, needle) - } - AssignmentKind::TagSwitch { - cases, - default_assignments, - .. - } => { - cases - .iter() - .any(|case| contains_operation(&case.assignments, needle)) - || contains_operation(default_assignments, needle) - } - _ => false, - }) -} - -#[derive(Clone, Copy)] -enum EuclideanOperation { - Divide, - Modulo, -} - -fn euclidean_helper( - id: FunctionId, - symbol: SymbolId, - operation: EuclideanOperation, - span: TextRange, -) -> Function { - let a = ValueId(0); - let b = ValueId(1); - let remainder = ValueId(2); - let zero = ValueId(3); - let nonzero_remainder = ValueId(4); - let remainder_negative = ValueId(5); - let divisor_negative = ValueId(6); - let signs_differ = ValueId(7); - let should_adjust = ValueId(8); - let result = ValueId(9); - let mut values = (0..=9) - .map(|id| ValueDecl { - id: ValueId(id), - ty: ValueType::I32, - }) - .collect::>(); - values[4].ty = ValueType::Boolean; - values[5].ty = ValueType::Boolean; - values[6].ty = ValueType::Boolean; - values[7].ty = ValueType::Boolean; - values[8].ty = ValueType::Boolean; - - let mut entry_instructions = vec![ - primitive(remainder, NumericOp::I32RemS, a, b, span), - Instruction::Constant { - destination: zero, - value: 0, - span, - }, - primitive(nonzero_remainder, NumericOp::I32Ne, remainder, zero, span), - primitive(remainder_negative, NumericOp::I32LtS, remainder, zero, span), - primitive(divisor_negative, NumericOp::I32LtS, b, zero, span), - primitive( - signs_differ, - NumericOp::BoolNe, - remainder_negative, - divisor_negative, - span, - ), - primitive( - should_adjust, - NumericOp::BoolAnd, - nonzero_remainder, - signs_differ, - span, - ), - ]; - let (adjust_value, unchanged_value, name) = match operation { - EuclideanOperation::Divide => { - let quotient = ValueId(10); - let one = ValueId(11); - let adjusted = ValueId(12); - let unchanged = ValueId(13); - values.extend([ - ValueDecl { - id: quotient, - ty: ValueType::I32, - }, - ValueDecl { - id: one, - ty: ValueType::I32, - }, - ValueDecl { - id: adjusted, - ty: ValueType::I32, - }, - ValueDecl { - id: unchanged, - ty: ValueType::I32, - }, - ]); - let adjusted_instructions = vec![ - primitive(quotient, NumericOp::I32DivS, a, b, span), - Instruction::Constant { - destination: one, - value: 1, - span, - }, - primitive(adjusted, NumericOp::I32Sub, quotient, one, span), - ]; - let unchanged_instructions = vec![primitive(unchanged, NumericOp::I32DivS, a, b, span)]; - ( - (adjusted, adjusted_instructions), - (unchanged, unchanged_instructions), - "__psrs_euclidean_int_div", - ) - } - EuclideanOperation::Modulo => { - let adjusted = ValueId(10); - values.push(ValueDecl { - id: adjusted, - ty: ValueType::I32, - }); - ( - ( - adjusted, - vec![primitive(adjusted, NumericOp::I32Add, remainder, b, span)], - ), - (remainder, Vec::new()), - "__psrs_euclidean_int_mod", - ) - } - }; - let merge = BlockId(3); - Function { - id, - symbol, - name: name.into(), - parameters: vec![a, b], - values, - entry: BlockId(0), - blocks: vec![ - BasicBlock { - id: BlockId(0), - parameters: Vec::new(), - instructions: std::mem::take(&mut entry_instructions), - terminator: Some(Terminator::Branch { - condition: should_adjust, - then_block: BlockId(1), - else_block: BlockId(2), - span, - }), - }, - BasicBlock { - id: BlockId(1), - parameters: Vec::new(), - instructions: adjust_value.1, - terminator: Some(Terminator::Jump { - target: merge, - arguments: vec![adjust_value.0], - span, - }), - }, - BasicBlock { - id: BlockId(2), - parameters: Vec::new(), - instructions: unchanged_value.1, - terminator: Some(Terminator::Jump { - target: merge, - arguments: vec![unchanged_value.0], - span, - }), - }, - BasicBlock { - id: merge, - parameters: vec![result], - instructions: Vec::new(), - terminator: Some(Terminator::Return { - value: result, - span, - }), - }, - ], - result, - result_type: ValueType::I32, - span, - } -} - -fn primitive( - destination: ValueId, - op: NumericOp, - left: ValueId, - right: ValueId, - span: TextRange, -) -> Instruction { - Instruction::Primitive { - destination, - op, - left, - right, - span, - } -} diff --git a/crates/psrs-backend/src/target_intrinsics/generated.rs b/crates/psrs-backend/src/target_intrinsics/generated.rs new file mode 100644 index 00000000..6a61cfb0 --- /dev/null +++ b/crates/psrs-backend/src/target_intrinsics/generated.rs @@ -0,0 +1,84 @@ +//! Reserved generated bindings and their concrete MIR contracts. +use crate::types::{CompositeType, DefinedTypeId, HeapType, RefType, StorageType, ValueType}; +use crate::{abi, mir}; +use psrs_hir::SymbolId; + +pub(crate) fn name(symbol: SymbolId) -> Option<&'static str> { + match symbol { + abi::REALLOC_SYMBOL => Some("realloc"), + abi::STRING_TO_BYTES_SYMBOL => Some("string_to_bytes"), + abi::BYTES_TO_STRING_SYMBOL => Some("bytes_to_string"), + abi::VALIDATE_STEP_SYMBOL => Some("validate_step"), + _ => None, + } +} + +/// Shared by the planner and the helper emitter, independent of a consumer call. +pub(crate) fn signature(symbol: SymbolId, string: Option) -> Option { + let string = || { + string.map(|index| { + ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(index), + }) + }) + }; + let (parameters, result) = match symbol { + abi::REALLOC_SYMBOL => (vec![ValueType::I32; 4], ValueType::I32), + abi::STRING_TO_BYTES_SYMBOL => (vec![string()?], ValueType::I32), + abi::BYTES_TO_STRING_SYMBOL => (vec![ValueType::I32; 2], string()?), + abi::VALIDATE_STEP_SYMBOL => (vec![ValueType::I32; 2], ValueType::I32), + _ => return None, + }; + Some(mir::Import { + symbol, + parameters, + result: Some(result), + }) +} + +pub(crate) fn verify(module: &mir::Module, import: &mir::Import) -> Result<(), String> { + let string = string_type_from_imports(module); + let expected = signature(import.symbol, string) + .ok_or("generated helper has no concrete string representation")?; + if *import != expected { + return Err("generated helper consumer signature differs from its provider".into()); + } + if matches!( + import.symbol, + abi::STRING_TO_BYTES_SYMBOL | abi::BYTES_TO_STRING_SYMBOL | abi::VALIDATE_STEP_SYMBOL + ) { + let index = string.ok_or("generated codec has no string type")?; + let ty = module + .types + .iter() + .flat_map(|group| &group.0) + .nth(index.0 as usize) + .ok_or("generated codec references an unknown string type")?; + if !matches!(ty.composite, CompositeType::Array(field) + if field.mutable && field.storage == StorageType::I8) + { + return Err("generated codec requires a mutable GC byte array".into()); + } + } + Ok(()) +} + +/// The GC string defined-type index, read from a reserved helper import. +pub(crate) fn string_type_from_imports(module: &crate::mir::Module) -> Option { + for import in &module.imports { + if import.symbol != crate::abi::STRING_TO_BYTES_SYMBOL + && import.symbol != crate::abi::BYTES_TO_STRING_SYMBOL + { + continue; + } + for ty in import.parameters.iter().chain(import.result.iter()) { + if let ValueType::Ref(reference) = ty + && let HeapType::Index(index) = reference.heap + { + return Some(index); + } + } + } + None +} diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs new file mode 100644 index 00000000..6abc51e9 --- /dev/null +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -0,0 +1,117 @@ +//! Exhaustive target implementation selection for checked language identities. +pub(crate) mod generated; +use crate::cc::{BinaryOp, UnaryOp}; +use crate::target_runtime::{self, ArtifactImplementation}; +use psrs_hir::Intrinsic; + +#[derive(Clone, Copy, Debug)] +pub(crate) enum ScalarOperation { + Unary(UnaryOp), + Binary(BinaryOp), +} + +#[derive(Clone, Copy, Debug)] +pub(crate) enum GeneratedOperation { + ArrayLength, + ArrayIndex, + ArrayUpdate, + ArrayAppend, + ArrayFill, + ArrayWrite, + StringToBytes, + BytesToString, + UnsafeCoerce, +} + +pub(crate) enum Implementation { + Direct(ScalarOperation), + Generated(GeneratedOperation), + Artifact(&'static ArtifactImplementation), + Elaborated, + Unsupported, +} + +pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { + use Implementation::*; + match intrinsic { + Intrinsic::IntAdd => Direct(ScalarOperation::Binary(BinaryOp::IntAdd)), + Intrinsic::IntSub => Direct(ScalarOperation::Binary(BinaryOp::IntSub)), + Intrinsic::IntMul => Direct(ScalarOperation::Binary(BinaryOp::IntMul)), + Intrinsic::IntQuot => Direct(ScalarOperation::Binary(BinaryOp::IntQuot)), + Intrinsic::IntRem => Direct(ScalarOperation::Binary(BinaryOp::IntRem)), + Intrinsic::IntAnd => Direct(ScalarOperation::Binary(BinaryOp::IntAnd)), + Intrinsic::IntOr => Direct(ScalarOperation::Binary(BinaryOp::IntOr)), + Intrinsic::IntXor => Direct(ScalarOperation::Binary(BinaryOp::IntXor)), + Intrinsic::IntShl => Direct(ScalarOperation::Binary(BinaryOp::IntShl)), + Intrinsic::IntShr => Direct(ScalarOperation::Binary(BinaryOp::IntShr)), + Intrinsic::IntZshr => Direct(ScalarOperation::Binary(BinaryOp::IntZshr)), + Intrinsic::IntEq => Direct(ScalarOperation::Binary(BinaryOp::IntEq)), + Intrinsic::IntNe => Direct(ScalarOperation::Binary(BinaryOp::IntNe)), + Intrinsic::IntLt => Direct(ScalarOperation::Binary(BinaryOp::IntLt)), + Intrinsic::IntLe => Direct(ScalarOperation::Binary(BinaryOp::IntLe)), + Intrinsic::IntGt => Direct(ScalarOperation::Binary(BinaryOp::IntGt)), + Intrinsic::IntGe => Direct(ScalarOperation::Binary(BinaryOp::IntGe)), + Intrinsic::NumberAdd => Direct(ScalarOperation::Binary(BinaryOp::NumberAdd)), + Intrinsic::NumberSub => Direct(ScalarOperation::Binary(BinaryOp::NumberSub)), + Intrinsic::NumberMul => Direct(ScalarOperation::Binary(BinaryOp::NumberMul)), + Intrinsic::NumberDiv => Direct(ScalarOperation::Binary(BinaryOp::NumberDiv)), + Intrinsic::NumberEq => Direct(ScalarOperation::Binary(BinaryOp::NumberEq)), + Intrinsic::NumberNe => Direct(ScalarOperation::Binary(BinaryOp::NumberNe)), + Intrinsic::NumberLt => Direct(ScalarOperation::Binary(BinaryOp::NumberLt)), + Intrinsic::NumberLe => Direct(ScalarOperation::Binary(BinaryOp::NumberLe)), + Intrinsic::NumberGt => Direct(ScalarOperation::Binary(BinaryOp::NumberGt)), + Intrinsic::NumberGe => Direct(ScalarOperation::Binary(BinaryOp::NumberGe)), + Intrinsic::BooleanAnd => Direct(ScalarOperation::Binary(BinaryOp::BooleanAnd)), + Intrinsic::BooleanOr => Direct(ScalarOperation::Binary(BinaryOp::BooleanOr)), + Intrinsic::BooleanEq => Direct(ScalarOperation::Binary(BinaryOp::BooleanEq)), + Intrinsic::BooleanNe => Direct(ScalarOperation::Binary(BinaryOp::BooleanNe)), + Intrinsic::CharEq => Direct(ScalarOperation::Binary(BinaryOp::CharEq)), + Intrinsic::CharNe => Direct(ScalarOperation::Binary(BinaryOp::CharNe)), + Intrinsic::CharLt => Direct(ScalarOperation::Binary(BinaryOp::CharLt)), + Intrinsic::CharLe => Direct(ScalarOperation::Binary(BinaryOp::CharLe)), + Intrinsic::CharGt => Direct(ScalarOperation::Binary(BinaryOp::CharGt)), + Intrinsic::CharGe => Direct(ScalarOperation::Binary(BinaryOp::CharGe)), + Intrinsic::IntNeg => Direct(ScalarOperation::Unary(UnaryOp::IntNeg)), + Intrinsic::IntComplement => Direct(ScalarOperation::Unary(UnaryOp::IntComplement)), + Intrinsic::NumberNeg => Direct(ScalarOperation::Unary(UnaryOp::NumberNeg)), + Intrinsic::NumberAbs => Direct(ScalarOperation::Unary(UnaryOp::NumberAbs)), + Intrinsic::NumberTrunc => Direct(ScalarOperation::Unary(UnaryOp::NumberTrunc)), + Intrinsic::NumberFloor => Direct(ScalarOperation::Unary(UnaryOp::NumberFloor)), + Intrinsic::NumberCeil => Direct(ScalarOperation::Unary(UnaryOp::NumberCeil)), + Intrinsic::BooleanNot => Direct(ScalarOperation::Unary(UnaryOp::BooleanNot)), + Intrinsic::IntToNumber => Direct(ScalarOperation::Unary(UnaryOp::IntToNumber)), + Intrinsic::NumberToInt => Direct(ScalarOperation::Unary(UnaryOp::NumberToInt)), + Intrinsic::BooleanToInt => Direct(ScalarOperation::Unary(UnaryOp::BooleanToInt)), + Intrinsic::IntToBoolean => Direct(ScalarOperation::Unary(UnaryOp::IntToBoolean)), + Intrinsic::CharToInt => Direct(ScalarOperation::Unary(UnaryOp::CharToInt)), + Intrinsic::IntToChar => Direct(ScalarOperation::Unary(UnaryOp::IntToChar)), + Intrinsic::ArrayLength => Generated(GeneratedOperation::ArrayLength), + Intrinsic::ArrayIndex => Generated(GeneratedOperation::ArrayIndex), + Intrinsic::ArrayUpdate => Generated(GeneratedOperation::ArrayUpdate), + Intrinsic::ArrayAppend => Generated(GeneratedOperation::ArrayAppend), + Intrinsic::ArrayFill => Generated(GeneratedOperation::ArrayFill), + Intrinsic::ArrayWrite => Generated(GeneratedOperation::ArrayWrite), + Intrinsic::StringToBytes => Generated(GeneratedOperation::StringToBytes), + Intrinsic::BytesToString => Generated(GeneratedOperation::BytesToString), + Intrinsic::UnsafeCoerce => Generated(GeneratedOperation::UnsafeCoerce), + Intrinsic::NumberToString => Artifact(&target_runtime::NUMBER_FORMAT), + Intrinsic::NumberFromDecimal => Artifact(&target_runtime::NUMBER_PARSE), + Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { + Elaborated + } + Intrinsic::Undefined => Unsupported, + } +} + +/// Artifact providers are derived from the exhaustive selection, never registered twice. +pub(crate) fn artifacts() -> impl Iterator { + Intrinsic::ALL + .into_iter() + .filter_map(|intrinsic| match implementation(intrinsic) { + Implementation::Artifact(provider) => Some(provider), + _ => None, + }) +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs new file mode 100644 index 00000000..39aa0b46 --- /dev/null +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -0,0 +1,44 @@ +use super::*; + +#[test] +fn every_active_identity_has_an_explicit_implementation() { + for intrinsic in Intrinsic::ALL { + match implementation(intrinsic) { + Implementation::Direct(ScalarOperation::Unary(_)) => { + assert_eq!(intrinsic.descriptor().arity, 1) + } + Implementation::Direct(ScalarOperation::Binary(_)) => { + assert_eq!(intrinsic.descriptor().arity, 2) + } + Implementation::Artifact(provider) => { + assert_eq!(provider.intrinsic, intrinsic); + provider.validate_protocol().unwrap(); + assert_eq!( + provider.language_signature().unwrap().0.len(), + intrinsic.descriptor().arity as usize + ); + } + Implementation::Unsupported => assert_eq!(intrinsic, Intrinsic::Undefined), + Implementation::Generated(_) | Implementation::Elaborated => {} + } + } + assert!(Intrinsic::from_binding("intDiv").is_none()); + assert!(Intrinsic::from_binding("intMod").is_none()); +} + +#[test] +fn language_renaming_preserves_stable_symbols_and_retired_slots() { + for (intrinsic, id) in [ + (Intrinsic::IntAdd, 2), + (Intrinsic::IntQuot, 5), + (Intrinsic::IntRem, 6), + (Intrinsic::IntToChar, 25), + (Intrinsic::IntAnd, 28), + (Intrinsic::NumberAbs, 68), + ] { + assert_eq!(intrinsic.symbol().index, id); + } + for intrinsic in Intrinsic::ALL { + assert!(!Intrinsic::RESERVED_IDS.contains(&(intrinsic as u32))); + } +} diff --git a/crates/psrs-backend/src/target_runtime/language.rs b/crates/psrs-backend/src/target_runtime/language.rs new file mode 100644 index 00000000..676a96c4 --- /dev/null +++ b/crates/psrs-backend/src/target_runtime/language.rs @@ -0,0 +1,85 @@ +use super::*; +use crate::cc::ValueShape; +use psrs_hir::{BuiltinType, TypeKind}; +use psrs_runtime::RawCallProtocol; + +impl ArtifactImplementation { + pub(crate) fn language_signature(&self) -> Result<(Vec, ValueShape), String> { + let mut ty = (self.intrinsic.descriptor().scheme)(); + let mut parameters = Vec::new(); + while let TypeKind::Function { parameter, result } = ty.kind { + parameters.push(shape(¶meter.kind)?); + ty = *result; + } + Ok((parameters, shape(&ty.kind)?)) + } + + /// The value protocol must implement the checked language scheme and raw ABI. + pub(crate) fn validate_protocol(&self) -> Result<(), String> { + let (parameters, result) = self.language_signature()?; + let expected = match self.abi.protocol { + RawCallProtocol::Scalars => CoreSignature { + parameters: parameters.into_iter().map(raw).collect::>()?, + result: self.raw_result(result)?, + }, + RawCallProtocol::Utf8Input if parameters == [ValueShape::String] => CoreSignature { + parameters: vec![CoreType::I32, CoreType::I32], + result: self.raw_result(result)?, + }, + RawCallProtocol::Utf8Output { capacity } + if parameters.len() == 1 + && result == ValueShape::String + && capacity > 0 + && capacity <= i32::MAX as usize => + { + CoreSignature { + parameters: vec![raw(parameters[0])?, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + } + } + _ => return Err("artifact value protocol cannot implement its language scheme".into()), + }; + if expected != self.signature() { + return Err("artifact value protocol does not match its raw ABI".into()); + } + if !matches!(self.abi.protocol, RawCallProtocol::Scalars) + && !self.intrinsic.descriptor().effects.may_trap + { + return Err("buffer allocation requires a possibly trapping language contract".into()); + } + Ok(()) + } +} + +fn shape(kind: &TypeKind) -> Result { + match kind { + TypeKind::Constructor(BuiltinType::Int) => Ok(ValueShape::Integer), + TypeKind::Constructor(BuiltinType::Number) => Ok(ValueShape::Number), + TypeKind::Constructor(BuiltinType::Boolean) => Ok(ValueShape::Boolean), + TypeKind::Constructor(BuiltinType::Char) => Ok(ValueShape::Integer), + TypeKind::Constructor(BuiltinType::Unit) => Ok(ValueShape::Integer), + TypeKind::Constructor(BuiltinType::String) => Ok(ValueShape::String), + _ => Err("artifact calls require a supported closed language scheme".into()), + } +} + +fn raw(shape: ValueShape) -> Result { + match shape { + ValueShape::Integer | ValueShape::Boolean => Ok(CoreType::I32), + ValueShape::Number => Ok(CoreType::F64), + _ => Err("a raw scalar protocol cannot transport a GC value".into()), + } +} +impl ArtifactImplementation { + fn raw_result(&self, result: ValueShape) -> Result, String> { + let mut ty = (self.intrinsic.descriptor().scheme)(); + while let TypeKind::Function { result, .. } = ty.kind { + ty = *result; + } + if matches!(ty.kind, TypeKind::Constructor(BuiltinType::Unit)) { + Ok(None) + } else { + raw(result).map(Some) + } + } +} diff --git a/crates/psrs-backend/src/target_runtime.rs b/crates/psrs-backend/src/target_runtime/mod.rs similarity index 76% rename from crates/psrs-backend/src/target_runtime.rs rename to crates/psrs-backend/src/target_runtime/mod.rs index efe1413e..3e7ed747 100644 --- a/crates/psrs-backend/src/target_runtime.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -5,50 +5,40 @@ //! owns the raw contract; `psrs-linker` owns verification and planning. use psrs_hir::{Intrinsic, SymbolId}; +mod language; use psrs_linker::{ ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, Provider, RequirementId, }; /// Connects a checked language intrinsic to its embedded implementation. -pub(crate) struct Implementation { +pub(crate) struct ArtifactImplementation { pub intrinsic: Intrinsic, pub symbol: SymbolId, - pub abi: &'static psrs_runtime::NumericAbi, + pub abi: &'static psrs_runtime::RawFunctionAbi, pub artifact: &'static psrs_runtime::RuntimeArtifact, } -pub(crate) const NUMBER_FORMAT: Implementation = Implementation { +pub(crate) const NUMBER_FORMAT: ArtifactImplementation = ArtifactImplementation { intrinsic: Intrinsic::NumberToString, symbol: crate::abi::NUMBER_TO_STRING_SYMBOL, abi: &psrs_runtime::NUMBER_FORMAT, artifact: &psrs_runtime::NUMBER_RUNTIME, }; -pub(crate) const NUMBER_PARSE: Implementation = Implementation { +pub(crate) const NUMBER_PARSE: ArtifactImplementation = ArtifactImplementation { intrinsic: Intrinsic::NumberFromDecimal, symbol: crate::abi::NUMBER_FROM_DECIMAL_SYMBOL, abi: &psrs_runtime::NUMBER_PARSE, artifact: &psrs_runtime::NUMBER_RUNTIME, }; -pub(crate) const IMPLEMENTATIONS: [&Implementation; 2] = [&NUMBER_FORMAT, &NUMBER_PARSE]; - -/// The registered implementation for a checked intrinsic, if any. -pub(crate) fn implementation(intrinsic: Intrinsic) -> Option<&'static Implementation> { - IMPLEMENTATIONS - .into_iter() - .find(|implementation| intrinsic == implementation.intrinsic) -} - /// The registered implementation for a MIR import symbol, if any. -pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static Implementation> { - IMPLEMENTATIONS - .into_iter() - .find(|implementation| symbol == implementation.symbol) +pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementation> { + crate::target_intrinsics::artifacts().find(|implementation| symbol == implementation.symbol) } -impl Implementation { +impl ArtifactImplementation { pub fn import(&self) -> crate::mir::Import { crate::mir::Import { symbol: self.symbol, @@ -59,19 +49,19 @@ impl Implementation { .copied() .map(value_type) .collect(), - result: Some(value_type(self.abi.result)), + result: self.abi.result.map(value_type), } } pub fn signature(&self) -> CoreSignature { CoreSignature { parameters: self.abi.parameters.iter().copied().map(core_type).collect(), - result: Some(core_type(self.abi.result)), + result: self.abi.result.map(core_type), } } /// The linker requirement for this artifact export. - pub fn requirement(&self, id: RequirementId) -> BindingRequirement { + pub fn requirement(&self, id: RequirementId, consumer: CoreSignature) -> BindingRequirement { let signature = self.signature(); BindingRequirement { id, @@ -80,7 +70,7 @@ impl Implementation { module: self.artifact.module_name.to_string(), field: self.abi.export.to_string(), }, - expected: Some(signature.clone()), + expected: Some(consumer), provider: Provider::ArtifactExport { artifact: self.artifact.id.to_string(), export: self.abi.export.to_string(), @@ -122,8 +112,8 @@ mod tests { #[test] fn the_number_formatter_maps_to_a_raw_artifact_requirement() { - let formatter = implementation(Intrinsic::NumberToString).unwrap(); - let requirement = formatter.requirement(RequirementId(0)); + let formatter = &NUMBER_FORMAT; + let requirement = formatter.requirement(RequirementId(0), formatter.signature()); assert_eq!( requirement.boundary, Boundary::RawCore { @@ -135,6 +125,12 @@ mod tests { requirement.provider, Provider::ArtifactExport { .. } )); - assert!(implementation(Intrinsic::I32Add).is_none()); + assert!(matches!( + crate::target_intrinsics::implementation(Intrinsic::IntAdd), + crate::target_intrinsics::Implementation::Direct(_) + )); } } + +#[cfg(test)] +mod protocol_tests; diff --git a/crates/psrs-backend/src/target_runtime/protocol_tests.rs b/crates/psrs-backend/src/target_runtime/protocol_tests.rs new file mode 100644 index 00000000..80369185 --- /dev/null +++ b/crates/psrs-backend/src/target_runtime/protocol_tests.rs @@ -0,0 +1,79 @@ +use super::*; +use psrs_runtime::{RawCallProtocol, RawFunctionAbi, RawType}; + +fn provider(intrinsic: Intrinsic, abi: &'static RawFunctionAbi) -> ArtifactImplementation { + ArtifactImplementation { + intrinsic, + symbol: NUMBER_FORMAT.symbol, + abi, + artifact: &psrs_runtime::NUMBER_RUNTIME, + } +} + +#[test] +fn scalar_and_void_protocols_require_matching_closed_language_schemes() { + const SCALAR: RawFunctionAbi = RawFunctionAbi { + export: "scalar", + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, + }; + const VOID: RawFunctionAbi = RawFunctionAbi { + export: "void", + parameters: &[], + result: None, + protocol: RawCallProtocol::Scalars, + }; + provider(Intrinsic::NumberAbs, &SCALAR) + .validate_protocol() + .unwrap(); + provider(Intrinsic::Unit, &VOID) + .validate_protocol() + .unwrap(); + assert!( + provider(Intrinsic::NumberAbs, &VOID) + .validate_protocol() + .is_err() + ); + assert!( + provider(Intrinsic::NumberToString, &SCALAR) + .validate_protocol() + .is_err() + ); + assert!( + provider(Intrinsic::ArrayLength, &SCALAR) + .validate_protocol() + .is_err() + ); +} + +#[test] +fn buffer_protocols_require_matching_shapes_raw_types_and_bounded_capacity() { + const UNBOUNDED: RawFunctionAbi = RawFunctionAbi { + export: "format", + parameters: &[RawType::F64, RawType::I32, RawType::I32], + result: Some(RawType::I32), + protocol: RawCallProtocol::Utf8Output { capacity: 0 }, + }; + const WRONG_WIDTH: RawFunctionAbi = RawFunctionAbi { + export: "parse", + parameters: &[RawType::I32, RawType::I64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Utf8Input, + }; + assert!( + provider(Intrinsic::NumberToString, &UNBOUNDED) + .validate_protocol() + .is_err() + ); + assert!( + provider(Intrinsic::NumberFromDecimal, &WRONG_WIDTH) + .validate_protocol() + .is_err() + ); + assert!( + provider(Intrinsic::NumberAbs, &psrs_runtime::NUMBER_PARSE) + .validate_protocol() + .is_err() + ); +} diff --git a/crates/psrs-backend/src/wasm/lower/codec/mod.rs b/crates/psrs-backend/src/wasm/lower/codec/mod.rs index 8858c926..39c6d62a 100644 --- a/crates/psrs-backend/src/wasm/lower/codec/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/codec/mod.rs @@ -24,48 +24,20 @@ mod encode; #[cfg(test)] mod tests; -use crate::types::{DefinedTypeId, HeapType, ValueType}; +use crate::types::DefinedTypeId; use crate::wasm::{FuncType, Function, FunctionIndex, TypeIndex}; use psrs_span::TextRange; -use wasm_encoder::ValType; /// The three function types used by the boundary helpers. -pub(super) fn signatures(string_ref: ValType) -> (FuncType, FuncType, FuncType) { +pub(super) fn signatures(string: DefinedTypeId) -> (FuncType, FuncType, FuncType) { + use crate::abi; ( - FuncType { - parameters: vec![string_ref], - results: vec![ValType::I32], - }, - FuncType { - parameters: vec![ValType::I32, ValType::I32], - results: vec![string_ref], - }, - FuncType { - parameters: vec![ValType::I32, ValType::I32], - results: vec![ValType::I32], - }, + super::generated_signature(abi::STRING_TO_BYTES_SYMBOL, Some(string)), + super::generated_signature(abi::BYTES_TO_STRING_SYMBOL, Some(string)), + super::generated_signature(abi::VALIDATE_STEP_SYMBOL, Some(string)), ) } -/// The GC string defined-type index, read from a reserved helper import. -pub(super) fn string_type_from_imports(module: &crate::mir::Module) -> Option { - for import in &module.imports { - if import.symbol != crate::abi::STRING_TO_BYTES_SYMBOL - && import.symbol != crate::abi::BYTES_TO_STRING_SYMBOL - { - continue; - } - for ty in import.parameters.iter().chain(import.result.iter()) { - if let ValueType::Ref(reference) = ty - && let HeapType::Index(index) = reference.heap - { - return Some(index); - } - } - } - None -} - /// Builds `string_to_bytes`, `bytes_to_string`, and `validate_step` in that order. pub(super) fn synthesize( string_type: DefinedTypeId, diff --git a/crates/psrs-backend/src/wasm/lower/mod.rs b/crates/psrs-backend/src/wasm/lower/mod.rs index 2709aac6..8ebec736 100644 --- a/crates/psrs-backend/src/wasm/lower/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/mod.rs @@ -7,7 +7,7 @@ use crate::BackendError; use crate::abi::{self, names}; use crate::capability::TargetCapabilities; use crate::mir::{self, Function as MirFunction}; -use crate::types::{DataId, HeapType, MemoryId, ValueId, ValueType}; +use crate::types::{DataId, DefinedTypeId, MemoryId, ValueId, ValueType}; use psrs_hir::SymbolId; use psrs_span::TextRange; use std::collections::HashMap; @@ -205,7 +205,7 @@ pub(crate) fn lower_module_with_plan( // The GC string type index is carried by the reserved helper imports' value // types, so the synthesized codec names the same concrete type MIR does. let string_type = if needs_helpers { - let string_type = codec::string_type_from_imports(module) + let string_type = crate::target_intrinsics::generated::string_type_from_imports(module) .ok_or_else(|| wasm_error(module.span, "the string codec has no GC string type"))?; function_indices.insert( abi::STRING_TO_BYTES_SYMBOL, @@ -266,10 +266,7 @@ pub(crate) fn lower_module_with_plan( let mut realloc = None; if needs_realloc { let realloc_type = TypeIndex(defined + types.len() as u32); - types.push(FuncType { - parameters: vec![ValType::I32; 4], - results: vec![ValType::I32], - }); + types.push(generated_signature(abi::REALLOC_SYMBOL, None)); let index = indices.realloc.expect("a needed realloc has an index"); exports.push(Export { name: "cabi_realloc".into(), @@ -294,11 +291,7 @@ pub(crate) fn lower_module_with_plan( } let helpers = if needs_helpers { let string_type = string_type.expect("a needed codec has a GC string type"); - let string_ref = val_type(ValueType::Ref(crate::types::RefType { - nullable: false, - heap: HeapType::Index(string_type), - })); - let (stb, bts, step) = codec::signatures(string_ref); + let (stb, bts, step) = codec::signatures(string_type); let stb_type = TypeIndex(defined + types.len() as u32); types.push(stb); let bts_type = TypeIndex(defined + types.len() as u32); @@ -450,3 +443,12 @@ pub(super) fn wasm_error(span: TextRange, message: &'static str) -> Vec) -> FuncType { + let signature = crate::target_intrinsics::generated::signature(symbol, string) + .expect("the selected generated helper has a concrete signature"); + FuncType { + parameters: signature.parameters.into_iter().map(val_type).collect(), + results: signature.result.into_iter().map(val_type).collect(), + } +} diff --git a/crates/psrs-core/src/opt/effects.rs b/crates/psrs-core/src/opt/effects.rs index 65d33422..592e861c 100644 --- a/crates/psrs-core/src/opt/effects.rs +++ b/crates/psrs-core/src/opt/effects.rs @@ -1,11 +1,11 @@ use crate::{Expr, ExprKind}; -use psrs_hir::Intrinsic; /// Conservative evaluation effects relevant to call-by-value rewrites. #[derive(Clone, Copy, Debug, Default, PartialEq, Eq)] pub(super) struct Effects { pub may_call: bool, pub may_trap: bool, + pub may_write: bool, } impl Effects { @@ -13,11 +13,12 @@ impl Effects { Self { may_call: self.may_call || other.may_call, may_trap: self.may_trap || other.may_trap, + may_write: self.may_write || other.may_write, } } pub fn inert(self) -> bool { - !self.may_call && !self.may_trap + !self.may_call && !self.may_trap && !self.may_write } } @@ -49,6 +50,7 @@ fn summarize_inner(expression: &Expr) -> Effects { ExprKind::Global(_) => Effects { may_call: true, may_trap: true, + may_write: true, }, // Creating a closure does not run its body. Function identity is not // observable in Core, and capture reads are inert local lookups. @@ -64,8 +66,10 @@ fn summarize_inner(expression: &Expr) -> Effects { arguments, } => { let arguments = combine_all(arguments.iter().map(summarize)); + let effects = intrinsic.descriptor().effects; Effects { - may_trap: intrinsic_may_trap(*intrinsic) || arguments.may_trap, + may_trap: effects.may_trap || arguments.may_trap, + may_write: effects.may_write || arguments.may_write, ..arguments } } @@ -80,6 +84,7 @@ fn summarize_inner(expression: &Expr) -> Effects { ExprKind::Application(_, _) => Effects { may_call: true, may_trap: true, + may_write: true, }, ExprKind::Let { bindings, body } => combine_all( bindings @@ -115,32 +120,11 @@ fn combine_all(effects: impl IntoIterator) -> Effects { .fold(Effects::default(), Effects::combine) } -/// Whether an intrinsic can trap. The byte conversions validate their input, -/// the array operations can trap on a missing or out-of-range index, and the -/// truncating and Euclidean division operations trap on a zero divisor. -/// Numeric string conversions can trap while allocating transient buffers. -fn intrinsic_may_trap(intrinsic: Intrinsic) -> bool { - matches!( - intrinsic, - Intrinsic::ArrayIndex - | Intrinsic::ArrayUpdate - | Intrinsic::ArrayFill - | Intrinsic::ArrayWrite - | Intrinsic::StringToBytes - | Intrinsic::BytesToString - | Intrinsic::NumberFromDecimal - | Intrinsic::NumberToString - | Intrinsic::I32DivS - | Intrinsic::I32RemS - | Intrinsic::IntDiv - | Intrinsic::IntMod - ) -} - #[cfg(test)] mod tests { use super::*; use crate::TypeId; + use psrs_hir::Intrinsic; fn intrinsic(intrinsic: Intrinsic, arguments: Vec) -> Expr { Expr { diff --git a/crates/psrs-core/src/opt/simplify/mod.rs b/crates/psrs-core/src/opt/simplify/mod.rs index 224eb9b8..5b4477d5 100644 --- a/crates/psrs-core/src/opt/simplify/mod.rs +++ b/crates/psrs-core/src/opt/simplify/mod.rs @@ -312,19 +312,19 @@ fn fold_intrinsic( return None; }; let folded = match intrinsic { - Intrinsic::I32Add => ExprKind::Integer(left.wrapping_add(*right)), - Intrinsic::I32Sub => ExprKind::Integer(left.wrapping_sub(*right)), - Intrinsic::I32Mul => ExprKind::Integer(left.wrapping_mul(*right)), + Intrinsic::IntAdd => ExprKind::Integer(left.wrapping_add(*right)), + Intrinsic::IntSub => ExprKind::Integer(left.wrapping_sub(*right)), + Intrinsic::IntMul => ExprKind::Integer(left.wrapping_mul(*right)), // checked_{div,rem} returns None for both trapping cases: zero divisor // and signed overflow. Leaving the operation intact preserves the trap. - Intrinsic::I32DivS => ExprKind::Integer(left.checked_div(*right)?), - Intrinsic::I32RemS => ExprKind::Integer(left.checked_rem(*right)?), - Intrinsic::I32Eq => ExprKind::Boolean(left == right), - Intrinsic::I32Ne => ExprKind::Boolean(left != right), - Intrinsic::I32LtS => ExprKind::Boolean(left < right), - Intrinsic::I32LeS => ExprKind::Boolean(left <= right), - Intrinsic::I32GtS => ExprKind::Boolean(left > right), - Intrinsic::I32GeS => ExprKind::Boolean(left >= right), + Intrinsic::IntQuot => ExprKind::Integer(left.checked_div(*right)?), + Intrinsic::IntRem => ExprKind::Integer(left.checked_rem(*right)?), + Intrinsic::IntEq => ExprKind::Boolean(left == right), + Intrinsic::IntNe => ExprKind::Boolean(left != right), + Intrinsic::IntLt => ExprKind::Boolean(left < right), + Intrinsic::IntLe => ExprKind::Boolean(left <= right), + Intrinsic::IntGt => ExprKind::Boolean(left > right), + Intrinsic::IntGe => ExprKind::Boolean(left >= right), _ => return None, }; Some(Expr { @@ -346,15 +346,15 @@ fn intrinsic_identity( span, }; match (intrinsic, &left.kind, &right.kind) { - (Intrinsic::I32Add, _, ExprKind::Integer(0)) - | (Intrinsic::I32Sub, _, ExprKind::Integer(0)) - | (Intrinsic::I32Mul, _, ExprKind::Integer(1)) => Some(with_span(left.clone(), span)), - (Intrinsic::I32Add, ExprKind::Integer(0), _) - | (Intrinsic::I32Mul, ExprKind::Integer(1), _) => Some(with_span(right.clone(), span)), - (Intrinsic::I32Mul, ExprKind::Integer(0), _) if effects::summarize(right).inert() => { + (Intrinsic::IntAdd, _, ExprKind::Integer(0)) + | (Intrinsic::IntSub, _, ExprKind::Integer(0)) + | (Intrinsic::IntMul, _, ExprKind::Integer(1)) => Some(with_span(left.clone(), span)), + (Intrinsic::IntAdd, ExprKind::Integer(0), _) + | (Intrinsic::IntMul, ExprKind::Integer(1), _) => Some(with_span(right.clone(), span)), + (Intrinsic::IntMul, ExprKind::Integer(0), _) if effects::summarize(right).inert() => { Some(zero(left.ty)) } - (Intrinsic::I32Mul, _, ExprKind::Integer(0)) if effects::summarize(left).inert() => { + (Intrinsic::IntMul, _, ExprKind::Integer(0)) if effects::summarize(left).inert() => { Some(zero(right.ty)) } _ => None, diff --git a/crates/psrs-core/src/opt/tests/global_inline.rs b/crates/psrs-core/src/opt/tests/global_inline.rs index 1a2e1114..9462cd83 100644 --- a/crates/psrs-core/src/opt/tests/global_inline.rs +++ b/crates/psrs-core/src/opt/tests/global_inline.rs @@ -40,7 +40,7 @@ fn named_global_inlining_binds_arguments_once_before_effects_and_preserves_spans }], body: Box::new(expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Add, + intrinsic: Intrinsic::IntAdd, arguments: vec![call, expression(ExprKind::Local(LocalId(0)), 0, 40, 45)], }, int_type.0, @@ -80,7 +80,7 @@ fn named_global_inlining_binds_arguments_once_before_effects_and_preserves_spans quantified: Vec::new(), value: expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::IntDiv, + intrinsic: Intrinsic::IntQuot, arguments: vec![ expression(ExprKind::Integer(1), 0, 70, 71), expression(ExprKind::Integer(0), 0, 72, 73), @@ -117,7 +117,7 @@ fn named_global_inlining_binds_arguments_once_before_effects_and_preserves_spans panic!("the caller binding should remain in scope") }; let ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Add, + intrinsic: Intrinsic::IntAdd, arguments, .. } = &body.kind @@ -146,7 +146,7 @@ fn named_global_inlining_binds_arguments_once_before_effects_and_preserves_spans assert!(matches!( callee_bindings[0].value.kind, ExprKind::IntrinsicCall { - intrinsic: Intrinsic::IntDiv, + intrinsic: Intrinsic::IntQuot, .. } )); @@ -257,11 +257,11 @@ fn evaluate( return Err(()); }; match intrinsic { - Intrinsic::I32Add => Ok(Value::Integer(left.wrapping_add(right))), - Intrinsic::IntDiv if right != 0 => { - left.checked_div_euclid(right).map(Value::Integer).ok_or(()) + Intrinsic::IntAdd => Ok(Value::Integer(left.wrapping_add(right))), + Intrinsic::IntQuot if right != 0 => { + left.checked_div(right).map(Value::Integer).ok_or(()) } - Intrinsic::IntDiv => Err(()), + Intrinsic::IntQuot => Err(()), _ => Err(()), } } diff --git a/crates/psrs-core/src/opt/tests/mod.rs b/crates/psrs-core/src/opt/tests/mod.rs index 71139148..dc0a6629 100644 --- a/crates/psrs-core/src/opt/tests/mod.rs +++ b/crates/psrs-core/src/opt/tests/mod.rs @@ -130,7 +130,7 @@ fn trace_call(function_type: u32, int_type: u32, argument: i32, start: u32) -> E fn folds_wrapping_integer_arithmetic_and_keeps_the_operation_span() { let value = expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Add, + intrinsic: Intrinsic::IntAdd, arguments: vec![ expression(ExprKind::Integer(i32::MAX), 0, 5, 6), expression(ExprKind::Integer(1), 0, 9, 10), @@ -160,7 +160,7 @@ fn folds_wrapping_integer_arithmetic_and_keeps_the_operation_span() { fn leaves_constant_division_that_would_trap() { let value = expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32DivS, + intrinsic: Intrinsic::IntQuot, arguments: vec![ expression(ExprKind::Integer(1), 0, 5, 6), expression(ExprKind::Integer(0), 0, 9, 10), @@ -182,7 +182,7 @@ fn leaves_constant_division_that_would_trap() { assert!(matches!( result.declarations[0].value.kind, ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32DivS, + intrinsic: Intrinsic::IntQuot, .. } )); @@ -201,7 +201,7 @@ fn retains_an_unused_euclidean_division_that_may_trap() { quantified: Vec::new(), value: expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::IntDiv, + intrinsic: Intrinsic::IntQuot, arguments: vec![ expression(ExprKind::Integer(1), 0, 13, 14), expression(ExprKind::Integer(0), 0, 17, 18), @@ -237,7 +237,7 @@ fn retains_an_unused_euclidean_division_that_may_trap() { assert!(matches!( bindings[0].value.kind, ExprKind::IntrinsicCall { - intrinsic: Intrinsic::IntDiv, + intrinsic: Intrinsic::IntQuot, .. } )); @@ -250,7 +250,7 @@ fn algebraic_zero_does_not_remove_an_effectful_operand() { let function_type = arrow_type(&mut types, int_type, int_type); let value = expression( ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Mul, + intrinsic: Intrinsic::IntMul, arguments: vec![ trace_call(function_type.0, int_type.0, 4, 5), expression(ExprKind::Integer(0), int_type.0, 14, 15), @@ -268,7 +268,7 @@ fn algebraic_zero_does_not_remove_an_effectful_operand() { assert!(matches!( result.declarations[0].value.kind, ExprKind::IntrinsicCall { - intrinsic: Intrinsic::I32Mul, + intrinsic: Intrinsic::IntMul, .. } )); diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 7fc79d96..454f90a7 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -47,7 +47,7 @@ impl Context<'_> { self.errors, ); } - IntrinsicCategory::UnaryScalar => { + IntrinsicCategory::Unary => { let (operand, result) = unary_primitive_types(intrinsic, self.module); self.expr(&arguments[0], Some(operand)); compatible( diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index cd2a77e1..2d4882f2 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -23,25 +23,23 @@ pub(super) fn verify_type( pub(super) fn primitive_types(intrinsic: Intrinsic, module: &Module) -> (TypeId, TypeId) { use TypeConstructor::{Boolean, Char, Int, Number}; let (operand_type, result_type) = match intrinsic { - Intrinsic::I32Add - | Intrinsic::I32Sub - | Intrinsic::I32Mul - | Intrinsic::I32DivS - | Intrinsic::I32RemS - | Intrinsic::IntDiv - | Intrinsic::IntMod + Intrinsic::IntAdd + | Intrinsic::IntSub + | Intrinsic::IntMul + | Intrinsic::IntQuot + | Intrinsic::IntRem | Intrinsic::IntAnd | Intrinsic::IntOr | Intrinsic::IntXor | Intrinsic::IntShl | Intrinsic::IntShr | Intrinsic::IntZshr => (Int, Int), - Intrinsic::I32Eq - | Intrinsic::I32Ne - | Intrinsic::I32LtS - | Intrinsic::I32LeS - | Intrinsic::I32GtS - | Intrinsic::I32GeS => (Int, Boolean), + Intrinsic::IntEq + | Intrinsic::IntNe + | Intrinsic::IntLt + | Intrinsic::IntLe + | Intrinsic::IntGt + | Intrinsic::IntGe => (Int, Boolean), Intrinsic::CharEq | Intrinsic::CharNe | Intrinsic::CharLt diff --git a/crates/psrs-desugar/src/tests.rs b/crates/psrs-desugar/src/tests.rs index 3598370d..fd23b302 100644 --- a/crates/psrs-desugar/src/tests.rs +++ b/crates/psrs-desugar/src/tests.rs @@ -5,14 +5,14 @@ use psrs_span::TextRange; #[test] fn lowers_operator_to_applications_and_preserves_source_ranges() { let module_id = ModuleId(0); - let operator_id = Intrinsic::I32Add.symbol(); + let operator_id = Intrinsic::IntAdd.symbol(); let module = hir::Module { id: module_id, name: "Main".into(), externals: vec![hir::ExternalSymbol { symbol: operator_id, name: "+".into(), - kind: ExternalKind::Intrinsic(Intrinsic::I32Add), + kind: ExternalKind::Intrinsic(Intrinsic::IntAdd), signature: None, }], imports: Vec::new(), diff --git a/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs b/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs index cc13a951..5cfdd828 100644 --- a/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs +++ b/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs @@ -332,8 +332,8 @@ pub(crate) fn recursive_instance_module() -> (thir::Module, SymbolId) { id: module_id, name: "Main".into(), externals: vec![ - intrinsic(int_sub, "intSub", Intrinsic::I32Sub), - intrinsic(int_le, "intLe", Intrinsic::I32LeS), + intrinsic(int_sub, "intSub", Intrinsic::IntSub), + intrinsic(int_le, "intLe", Intrinsic::IntLe), ], external_types: Vec::new(), types, diff --git a/crates/psrs-driver/src/tests/intrinsic_contracts.rs b/crates/psrs-driver/src/tests/intrinsic_contracts.rs new file mode 100644 index 00000000..69618e23 --- /dev/null +++ b/crates/psrs-driver/src/tests/intrinsic_contracts.rs @@ -0,0 +1,78 @@ +use super::*; + +#[test] +fn retired_arithmetic_bindings_are_rejected() { + for name in ["intDiv", "intMod"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#{name}\" old :: Int -> Int -> Int\nmain = old 3 (-2)\n" + ); + let errors = + crate::check_program(&[("Main.purs", source.as_str())]).expect_err("retired binding"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.message.contains(&format!("`{name}`"))), + "{errors:?}" + ); + let source = format!("module Main where\nmain = {name} 3 2\n"); + assert!(crate::check_program(&[("Main.purs", source.as_str())]).is_err()); + } +} + +#[test] +fn official_euclidean_policy_executes_for_both_signs_and_zero() { + let source = r#"module Main where +import Prelude +import Data.EuclideanRing as E + +check a b q r = E.div a b == q && E.mod a b == r +checkHigher f a b expected = f a b == expected +main = if check 5 3 1 2 + && check (-5) 3 (-2) 1 + && check 5 (-3) (-1) 2 + && check (-5) (-3) 2 1 + && check 3 (-2) (-1) 1 + && check (-3) 2 (-2) 1 + && check 6 (-3) (-2) 0 + && check (-6) (-3) 2 0 + && check 1 0 0 0 && check (-1) 0 0 0 && check 0 0 0 0 + && checkHigher E.div 3 (-2) (-1) + && checkHigher E.mod 3 (-2) 1 + then 42 else 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty(), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn balanced_public_array_traversal_uses_the_truncating_storage_leaf() { + let source = r#"module Main where +import Prelude +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse) + +large = case traverse (\x -> Just (x + 1)) [1,2,3,4,5,6,7,8,9] of + Just xs -> arrayLength xs == 9 && arrayIndex xs 0 == 2 + && arrayIndex xs 4 == 6 && arrayIndex xs 8 == 10 + Nothing -> false +empty = case traverse (\x -> Just (x + 1)) [] of + Just xs -> arrayLength xs == 0 + Nothing -> false +failure = case traverse (\x -> if x == 5 then Nothing else Just x) [1,2,3,4,5,6,7,8,9] of + Nothing -> true + Just _ -> false +main = if large && empty && failure then 42 else 1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!( + output.stdout.is_empty() && output.stderr.is_empty(), + "{output:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index e003d4ea..ecfa1d74 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -17,6 +17,7 @@ mod effects; mod foldable; mod functor; mod guard_coverage; +mod intrinsic_contracts; mod let_constraints; mod library_foreign; mod number_abs; diff --git a/crates/psrs-driver/src/tests/scalars.rs b/crates/psrs-driver/src/tests/scalars.rs index 26af68a3..6d2b9a5a 100644 --- a/crates/psrs-driver/src/tests/scalars.rs +++ b/crates/psrs-driver/src/tests/scalars.rs @@ -9,10 +9,10 @@ subtractInt left right = left - right checkIntArithmetic = booleanAnd (equalInt (40 + 2) 42) (booleanAnd (equalInt (7 - 2) 5) (booleanAnd (equalInt (6 * 7) 42) (booleanAnd (equalInt (10 / 3) 3) (equalInt (10 % 3) 1)))) checkIntWrapping = equalInt (2147483647 + 1) (subtractInt (intNeg 2147483647) 1) -checkIntFloor = booleanAnd (equalInt (intDiv (intNeg 5) 3) (intNeg 2)) (equalInt (intMod (intNeg 5) 3) 1) +checkIntEuclidean = booleanAnd (equalInt (div (intNeg 5) 3) (intNeg 2)) (equalInt (mod (intNeg 5) 3) 1) checkIntBits = booleanAnd (equalInt (intAnd 6 3) 2) (booleanAnd (equalInt (intOr 4 1) 5) (booleanAnd (equalInt (intXor 6 3) 5) (booleanAnd (equalInt (intShl 3 2) 12) (booleanAnd (equalInt (intShr (intNeg 8) 1) (intNeg 4)) (equalInt (intZshr (intNeg 1) 1) 2147483647))))) checkIntComparisons = booleanAnd (5 == 5) (booleanAnd (5 /= 6) (booleanAnd (4 < 5) (booleanAnd (5 <= 5) (booleanAnd (6 > 5) (5 >= 5))))) -checkInt = booleanAnd checkIntArithmetic (booleanAnd checkIntWrapping (booleanAnd checkIntFloor (booleanAnd checkIntBits checkIntComparisons))) +checkInt = booleanAnd checkIntArithmetic (booleanAnd checkIntWrapping (booleanAnd checkIntEuclidean (booleanAnd checkIntBits checkIntComparisons))) checkIntUnary = booleanAnd (equalInt (intNeg 5) (subtractInt 0 5)) (equalInt (intComplement 0) (intNeg 1)) checkNumberUnary = booleanAnd (numberEq (numberNeg 1.5) (numberSub 0.0 1.5)) (numberEq (intToNumber 5) 5.0) @@ -70,25 +70,23 @@ fn scalar_intrinsics_are_reachable_from_source_and_execute_with_documented_seman "IntToBoolean", "CharToInt", "IntToChar", - "IntDiv", - "IntMod", - "I32Add", - "I32Sub", - "I32Mul", - "I32DivS", - "I32RemS", + "IntAdd", + "IntSub", + "IntMul", + "IntQuot", + "IntRem", "IntAnd", "IntOr", "IntXor", "IntShl", "IntShr", "IntZshr", - "I32Eq", - "I32Ne", - "I32LtS", - "I32LeS", - "I32GtS", - "I32GeS", + "IntEq", + "IntNe", + "IntLt", + "IntLe", + "IntGt", + "IntGe", "NumberAdd", "NumberSub", "NumberMul", @@ -145,20 +143,21 @@ main = if intEq (6 .&. 3) 2 then 0 else 1 const CASE_HELPER_SOURCE: &str = "\ module Main where +import Prelude data Choice = First | Second pick choice = case choice of - First -> intDiv 7 2 - Second -> intMod 7 2 + First -> div 7 2 + Second -> mod 7 2 main = pick First "; #[test] -fn generates_floor_helpers_for_division_nested_in_case_branches() { +fn executes_library_euclidean_division_nested_in_case_branches() { let stages = crate::compile_main_stages(CASE_HELPER_SOURCE) - .expect("case-nested division must generate its helper before MIR lowering"); + .expect("case-nested library division must lower through MIR"); assert!( stages.cc.functions.iter().any(|function| { function.assignments.iter().any(|assignment| { @@ -170,18 +169,6 @@ fn generates_floor_helpers_for_division_nested_in_case_branches() { }), "the case must lower to a tag switch" ); - for helper in ["__psrs_euclidean_int_div", "__psrs_euclidean_int_mod"] { - assert_eq!( - stages - .mir - .functions - .iter() - .filter(|function| function.name == helper) - .count(), - 1, - "expected exactly one {helper}" - ); - } let Some(output) = super::run_with_wasmtime(CASE_HELPER_SOURCE) else { eprintln!("skipping execution: wasmtime is not installed"); return; @@ -189,7 +176,7 @@ fn generates_floor_helpers_for_division_nested_in_case_branches() { assert_eq!( output.status.code(), Some(3), - "floor div 7 2 through a case branch must be 3: {output:?}" + "library div 7 2 through a case branch must be 3: {output:?}" ); } @@ -323,11 +310,9 @@ fn assert_runtime_trap(source: &str, needle: &str) { } #[test] -fn truncated_and_floor_division_zero_and_signed_overflow() { - // `Data.EuclideanRing`'s Euclidean `div` (`/`) returns 0 for a zero divisor, - // matching the official purescript-prelude implementation, so it does not - // trap. The truncating `%` operator and the explicit `intDiv`/`intMod` - // intrinsics reach the trapping Wasm instructions. +fn truncating_and_library_euclidean_division_zero_and_signed_overflow() { + // Library division/modulo handle zero before evaluating raw quotient/remainder. + // Truncating primitives preserve the Wasm divide-by-zero and overflow traps. let Some(output) = super::run_with_wasmtime("module Main where\nimport Prelude\nmain = 1 / 0\n") else { @@ -341,11 +326,7 @@ fn truncated_and_floor_division_zero_and_signed_overflow() { "integer divide by zero", ); assert_runtime_trap( - "module Main where\nmain = intDiv 1 0\n", - "integer divide by zero", - ); - assert_runtime_trap( - "module Main where\nmain = intMod 1 0\n", + "module Main where\nmain = intQuot 1 0\n", "integer divide by zero", ); assert_runtime_trap( @@ -353,28 +334,25 @@ fn truncated_and_floor_division_zero_and_signed_overflow() { "integer overflow", ); assert_runtime_trap( - "module Main where\nimport Prelude\nmain = intDiv ((intNeg 2147483647) - 1) (intNeg 1)\n", + "module Main where\nimport Prelude\nmain = intQuot ((intNeg 2147483647) - 1) (intNeg 1)\n", "integer overflow", ); } #[test] fn runs_division_and_modulo_inside_a_case_arm() { - // Floor division and modulo are lowered through generated helpers. The - // primitive operations only appear inside the match arms, so helper - // detection must walk the tag switch. + // Public arithmetic composes library branches with truncating primitives. + // Both case arms must retain the library policy through normal lowering. let source = r#"module Main where import Prelude data Tag = A | B compute t = case t of - A -> intDiv 7 3 - B -> intMod 7 3 + A -> div 7 3 + B -> mod 7 3 main = compute A + compute B + 39 "#; - let compilation = compile_source_with_dumps("Main.purs", source) - .expect("lowering division and modulo inside a case arm"); - assert!(compilation.dumps.mir.contains("__psrs_euclidean_int_div")); - assert!(compilation.dumps.mir.contains("__psrs_euclidean_int_mod")); + compile_source("Main.purs", source) + .expect("lowering library division and modulo inside a case arm"); let Some(output) = super::run_with_wasmtime(source) else { eprintln!("skipping execution: wasmtime is not installed"); return; diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs new file mode 100644 index 00000000..8c6741f8 --- /dev/null +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -0,0 +1,34 @@ +//! Conservative semantic effects, independent of a target provider. +use super::Intrinsic; + +#[derive(Clone, Copy, Debug, Default, PartialEq, Eq)] +pub struct IntrinsicEffects { + pub may_trap: bool, + pub may_write: bool, +} + +impl IntrinsicEffects { + pub(super) fn for_intrinsic(intrinsic: Intrinsic) -> Self { + use Intrinsic::*; + match intrinsic { + ArrayWrite => Self { + may_trap: true, + may_write: true, + }, + IntQuot | IntRem | ArrayIndex | ArrayUpdate | StringToBytes | BytesToString + | Undefined | ArrayAppend | UnsafeCoerce | ArrayFill | NumberToString + | NumberFromDecimal => Self { + may_trap: true, + may_write: false, + }, + BoolTrue | BoolFalse | IntAdd | IntSub | IntMul | IntEq | IntNe | IntLt | IntLe + | IntGt | IntGe | ArrayLength | IntNeg | IntComplement | NumberNeg | BooleanNot + | IntToNumber | NumberToInt | BooleanToInt | IntToBoolean | CharToInt | IntToChar + | IntAnd | IntOr | IntXor | IntShl | IntShr | IntZshr | NumberAdd | NumberSub + | NumberMul | NumberDiv | NumberEq | NumberNe | NumberLt | NumberLe | NumberGt + | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe + | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor + | NumberCeil | NumberAbs => Self::default(), + } + } +} diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 8131f1b2..9286beb3 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -6,8 +6,10 @@ //! category, and type scheme — lives in [`registry`], and each pass interprets //! it in its own representation. +mod effects; mod registry; +pub use effects::IntrinsicEffects; pub use registry::{IntrinsicCategory, IntrinsicDescriptor}; use crate::{ModuleId, SymbolId}; @@ -15,103 +17,101 @@ use crate::{ModuleId, SymbolId}; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] #[repr(u32)] pub enum Intrinsic { - BoolTrue, - BoolFalse, - I32Add, - I32Sub, - I32Mul, - I32DivS, - I32RemS, - I32Eq, - I32Ne, - I32LtS, - I32LeS, - I32GtS, - I32GeS, - ArrayLength, - ArrayIndex, - ArrayUpdate, - IntNeg, - IntComplement, - NumberNeg, - BooleanNot, - IntToNumber, - NumberToInt, - BooleanToInt, - IntToBoolean, - CharToInt, - IntToChar, - IntDiv, - IntMod, - IntAnd, - IntOr, - IntXor, - IntShl, - IntShr, - IntZshr, - NumberAdd, - NumberSub, - NumberMul, - NumberDiv, - NumberEq, - NumberNe, - NumberLt, - NumberLe, - NumberGt, - NumberGe, - BooleanAnd, - BooleanOr, - BooleanEq, - BooleanNe, - CharEq, - CharNe, - CharLt, - CharLe, - CharGt, - CharGe, + BoolTrue = 0, + BoolFalse = 1, + IntAdd = 2, + IntSub = 3, + IntMul = 4, + IntQuot = 5, + IntRem = 6, + IntEq = 7, + IntNe = 8, + IntLt = 9, + IntLe = 10, + IntGt = 11, + IntGe = 12, + ArrayLength = 13, + ArrayIndex = 14, + ArrayUpdate = 15, + IntNeg = 16, + IntComplement = 17, + NumberNeg = 18, + BooleanNot = 19, + IntToNumber = 20, + NumberToInt = 21, + BooleanToInt = 22, + IntToBoolean = 23, + CharToInt = 24, + IntToChar = 25, + IntAnd = 28, + IntOr = 29, + IntXor = 30, + IntShl = 31, + IntShr = 32, + IntZshr = 33, + NumberAdd = 34, + NumberSub = 35, + NumberMul = 36, + NumberDiv = 37, + NumberEq = 38, + NumberNe = 39, + NumberLt = 40, + NumberLe = 41, + NumberGt = 42, + NumberGe = 43, + BooleanAnd = 44, + BooleanOr = 45, + BooleanEq = 46, + BooleanNe = 47, + CharEq = 48, + CharNe = 49, + CharLt = 50, + CharLe = 51, + CharGt = 52, + CharGe = 53, /// A source `String`'s canonical UTF-8 bytes as an `Array Int`. A source /// string is a sequence of Unicode scalar values, so this is lossless and /// never fails /// ([DEC-16](../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). - StringToBytes, + StringToBytes = 54, /// An `Array Int` as a source `String`. Each element must be a canonical /// byte and the bytes must be well-formed UTF-8; either violation traps /// rather than producing replacement text. - BytesToString, + BytesToString = 55, /// Source-level `Safe.Coerce.coerce`, elaborated to a checked coercion. - Coerce, + Coerce = 56, /// The compiler-provided partial value `Prim.undefined`, whose type is /// `forall a. a`. It has no runtime representation yet, so the stages that /// would have to choose one report it instead of inventing it. - Undefined, + Undefined = 57, /// The one `Unit` value, written `unit` or `()`. A compiler primitive rather /// than a nullary constructor, because `Unit` is a builtin type here. - Unit, + Unit = 58, /// Source-level `Array.append`: concatenates two arrays of the same element /// type into a fresh array. A compiler primitive because building an array /// of a computed length has no source spelling; the library's /// `Semigroup (Array a)` instance and `Semigroup String` are its users. - ArrayAppend, + ArrayAppend = 59, /// Source-level `Unsafe.Coerce.unsafeCoerce`, the unchecked representation /// coercion (`unsafeCoerce#`). Unlike `Coerce` it carries no `Coercible` /// proof; it is a representation-preserving cast at the value's erased /// boundary. - UnsafeCoerce, + UnsafeCoerce = 60, /// Allocate a fresh array fully initialized with one checked element. - ArrayFill, + ArrayFill = 61, /// Unsafe in-place write; returns the same array. Library internals only. - ArrayWrite, - NumberToString, + ArrayWrite = 62, + NumberToString = 63, /// Truncate an IEEE-754 Number toward zero, retaining its Number representation. - NumberTrunc, + NumberTrunc = 64, /// Round a Number toward negative infinity. - NumberFloor, + NumberFloor = 65, /// Round a Number toward positive infinity. - NumberCeil, + NumberCeil = 66, /// Convert a complete ASCII decimal token to binary64; invalid tokens return NaN. - NumberFromDecimal, + NumberFromDecimal = 67, /// Clear the binary64 sign bit, including negative zero and NaN. - NumberAbs, + NumberAbs = 68, } impl Intrinsic { @@ -132,22 +132,25 @@ impl Intrinsic { .find(|value| value.descriptor().name == name) } - /// Every variant, in discriminant order. `bootstrap_externals` builds the + /// Retired floor-division identities; these slots must never be reused. + pub const RESERVED_IDS: [u32; 2] = [26, 27]; + + /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 69] = [ + pub const ALL: [Intrinsic; 67] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, - Intrinsic::I32Add, - Intrinsic::I32Sub, - Intrinsic::I32Mul, - Intrinsic::I32DivS, - Intrinsic::I32RemS, - Intrinsic::I32Eq, - Intrinsic::I32Ne, - Intrinsic::I32LtS, - Intrinsic::I32LeS, - Intrinsic::I32GtS, - Intrinsic::I32GeS, + Intrinsic::IntAdd, + Intrinsic::IntSub, + Intrinsic::IntMul, + Intrinsic::IntQuot, + Intrinsic::IntRem, + Intrinsic::IntEq, + Intrinsic::IntNe, + Intrinsic::IntLt, + Intrinsic::IntLe, + Intrinsic::IntGt, + Intrinsic::IntGe, Intrinsic::ArrayLength, Intrinsic::ArrayIndex, Intrinsic::ArrayUpdate, @@ -161,8 +164,6 @@ impl Intrinsic { Intrinsic::IntToBoolean, Intrinsic::CharToInt, Intrinsic::IntToChar, - Intrinsic::IntDiv, - Intrinsic::IntMod, Intrinsic::IntAnd, Intrinsic::IntOr, Intrinsic::IntXor, @@ -207,15 +208,17 @@ impl Intrinsic { ]; } -// `ALL` lists every discriminant exactly once: its length is the highest -// discriminant plus one, and the values are unique. A new variant therefore +// Active and reserved identities cover every stable discriminant exactly once. +// Retired identities cannot be reused by a later operation. A new variant therefore // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() == Intrinsic::NumberAbs as u32 as usize + 1, + Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() + == Intrinsic::NumberAbs as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); - let mut seen: u128 = 0; + let mut seen: u128 = + (1u128 << Intrinsic::RESERVED_IDS[0]) | (1u128 << Intrinsic::RESERVED_IDS[1]); let mut index = 0; while index < Intrinsic::ALL.len() { let bit = 1u128 << (Intrinsic::ALL[index] as u32); diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 0e0c88a6..31cbe799 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -8,7 +8,7 @@ //! through the exhaustive `descriptor` match, so a variant cannot be registered //! silently. -use super::Intrinsic; +use super::{Intrinsic, IntrinsicEffects}; use crate::{BuiltinType, Type, TypeId, TypeKind, TypeParameter}; use psrs_span::TextRange; @@ -18,8 +18,8 @@ use psrs_span::TextRange; pub enum IntrinsicCategory { /// A nullary value: `true`, `false`, `unit`. Nullary, - /// One scalar argument and a scalar result. - UnaryScalar, + /// One language argument and a language result. + Unary, /// Two scalar arguments and a scalar result. BinaryScalar, /// `Array.length`: `forall a. Array a -> Int`. @@ -58,6 +58,7 @@ pub struct IntrinsicDescriptor { /// count of `scheme`. pub arity: u8, pub category: IntrinsicCategory, + pub effects: IntrinsicEffects, /// A non-capturing constructor, so the descriptor table can be `const`. pub scheme: fn() -> Type, } @@ -76,6 +77,7 @@ macro_rules! descriptors { name: $name, arity: $arity, category: IntrinsicCategory::$category, + effects: IntrinsicEffects::for_intrinsic(intrinsic), scheme: $scheme, }, )* @@ -87,36 +89,34 @@ macro_rules! descriptors { descriptors! { BoolTrue => "true", 0, Nullary, scheme::boolean; BoolFalse => "false", 0, Nullary, scheme::boolean; - I32Add => "intAdd", 2, BinaryScalar, scheme::int_int_int; - I32Sub => "intSub", 2, BinaryScalar, scheme::int_int_int; - I32Mul => "intMul", 2, BinaryScalar, scheme::int_int_int; - I32DivS => "intQuot", 2, BinaryScalar, scheme::int_int_int; - I32RemS => "%", 2, BinaryScalar, scheme::int_int_int; - I32Eq => "intEq", 2, BinaryScalar, scheme::int_int_bool; - I32Ne => "intNe", 2, BinaryScalar, scheme::int_int_bool; - I32LtS => "intLt", 2, BinaryScalar, scheme::int_int_bool; - I32LeS => "intLe", 2, BinaryScalar, scheme::int_int_bool; - I32GtS => "intGt", 2, BinaryScalar, scheme::int_int_bool; - I32GeS => "intGe", 2, BinaryScalar, scheme::int_int_bool; + IntAdd => "intAdd", 2, BinaryScalar, scheme::int_int_int; + IntSub => "intSub", 2, BinaryScalar, scheme::int_int_int; + IntMul => "intMul", 2, BinaryScalar, scheme::int_int_int; + IntQuot => "intQuot", 2, BinaryScalar, scheme::int_int_int; + IntRem => "%", 2, BinaryScalar, scheme::int_int_int; + IntEq => "intEq", 2, BinaryScalar, scheme::int_int_bool; + IntNe => "intNe", 2, BinaryScalar, scheme::int_int_bool; + IntLt => "intLt", 2, BinaryScalar, scheme::int_int_bool; + IntLe => "intLe", 2, BinaryScalar, scheme::int_int_bool; + IntGt => "intGt", 2, BinaryScalar, scheme::int_int_bool; + IntGe => "intGe", 2, BinaryScalar, scheme::int_int_bool; ArrayLength => "arrayLength", 1, ArrayLength, scheme::array_length; ArrayIndex => "arrayIndex", 2, ArrayIndex, scheme::array_index; ArrayUpdate => "arrayUpdate", 3, ArrayUpdate, scheme::array_update; - IntNeg => "intNeg", 1, UnaryScalar, scheme::int_int; - IntComplement => "intComplement", 1, UnaryScalar, scheme::int_int; - NumberNeg => "numberNeg", 1, UnaryScalar, scheme::number_number; - NumberTrunc => "numberTrunc", 1, UnaryScalar, scheme::number_number; - NumberFloor => "numberFloor", 1, UnaryScalar, scheme::number_number; - NumberAbs => "numberAbs", 1, UnaryScalar, scheme::number_number; - NumberCeil => "numberCeil", 1, UnaryScalar, scheme::number_number; - BooleanNot => "booleanNot", 1, UnaryScalar, scheme::boolean_boolean; - IntToNumber => "intToNumber", 1, UnaryScalar, scheme::int_number; - NumberToInt => "numberToInt", 1, UnaryScalar, scheme::number_int; - BooleanToInt => "booleanToInt", 1, UnaryScalar, scheme::boolean_int; - IntToBoolean => "intToBoolean", 1, UnaryScalar, scheme::int_boolean; - CharToInt => "charToInt", 1, UnaryScalar, scheme::char_int; - IntToChar => "intToChar", 1, UnaryScalar, scheme::int_char; - IntDiv => "intDiv", 2, BinaryScalar, scheme::int_int_int; - IntMod => "intMod", 2, BinaryScalar, scheme::int_int_int; + IntNeg => "intNeg", 1, Unary, scheme::int_int; + IntComplement => "intComplement", 1, Unary, scheme::int_int; + NumberNeg => "numberNeg", 1, Unary, scheme::number_number; + NumberTrunc => "numberTrunc", 1, Unary, scheme::number_number; + NumberFloor => "numberFloor", 1, Unary, scheme::number_number; + NumberAbs => "numberAbs", 1, Unary, scheme::number_number; + NumberCeil => "numberCeil", 1, Unary, scheme::number_number; + BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; + IntToNumber => "intToNumber", 1, Unary, scheme::int_number; + NumberToInt => "numberToInt", 1, Unary, scheme::number_int; + BooleanToInt => "booleanToInt", 1, Unary, scheme::boolean_int; + IntToBoolean => "intToBoolean", 1, Unary, scheme::int_boolean; + CharToInt => "charToInt", 1, Unary, scheme::char_int; + IntToChar => "intToChar", 1, Unary, scheme::int_char; IntAnd => "intAnd", 2, BinaryScalar, scheme::int_int_int; IntOr => "intOr", 2, BinaryScalar, scheme::int_int_int; IntXor => "intXor", 2, BinaryScalar, scheme::int_int_int; @@ -152,8 +152,8 @@ descriptors! { UnsafeCoerce => "__psrs_unsafe_coerce", 1, Coercion, scheme::unsafe_coerce; ArrayFill => "arrayFill", 2, ArrayFill, scheme::array_fill; ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; - NumberToString => "numberToString", 1, UnaryScalar, scheme::number_string; - NumberFromDecimal => "numberFromDecimal", 1, UnaryScalar, scheme::string_number; + NumberToString => "numberToString", 1, Unary, scheme::number_string; + NumberFromDecimal => "numberFromDecimal", 1, Unary, scheme::string_number; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that diff --git a/crates/psrs-resolve/src/resolver/tests.rs b/crates/psrs-resolve/src/resolver/tests.rs index b318da85..55e06f4f 100644 --- a/crates/psrs-resolve/src/resolver/tests.rs +++ b/crates/psrs-resolve/src/resolver/tests.rs @@ -115,7 +115,7 @@ fn resolves_bootstrap_integer_add_to_intrinsic_id() { resolve_module_with_externals(module, ModuleId(0), &bootstrap_externals()).unwrap(); assert!(matches!( resolved.declarations[0].value.kind, - ExprKind::Operator { operator, .. } if operator == Intrinsic::I32Add.symbol() + ExprKind::Operator { operator, .. } if operator == Intrinsic::IntAdd.symbol() )); resolved.verify().unwrap(); } diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 118e5807..07e7c641 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -60,21 +60,37 @@ pub enum RawType { F64, } -/// A raw numeric runtime function's checked core-Wasm signature. -pub struct NumericAbi { +/// Language-value transport and normal-return ownership for a raw export. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum RawCallProtocol { + /// Scalar arguments/results only; Unit results use a void export. + Scalars, + /// Borrowed canonical UTF-8 bytes; caller copies, then releases on return. + Utf8Input, + /// Caller-owned bounded UTF-8 output; caller recovers and releases on return. + Utf8Output { capacity: usize }, +} + +/// An artifact export's raw signature and language-value transport protocol. +pub struct RawFunctionAbi { pub export: &'static str, pub parameters: &'static [RawType], - pub result: RawType, + pub result: Option, + pub protocol: RawCallProtocol, } -pub const NUMBER_FORMAT: NumericAbi = NumericAbi { +pub const NUMBER_FORMAT: RawFunctionAbi = RawFunctionAbi { export: NUMBER_EXPORT, parameters: &[RawType::F64, RawType::I32, RawType::I32], - result: RawType::I32, + result: Some(RawType::I32), + protocol: RawCallProtocol::Utf8Output { + capacity: NUMBER_CAPACITY, + }, }; -pub const NUMBER_PARSE: NumericAbi = NumericAbi { +pub const NUMBER_PARSE: RawFunctionAbi = RawFunctionAbi { export: DECIMAL_EXPORT, parameters: &[RawType::I32, RawType::I32], - result: RawType::F64, + result: Some(RawType::F64), + protocol: RawCallProtocol::Utf8Input, }; diff --git a/crates/psrs-typecheck/src/typecheck/tests/mod.rs b/crates/psrs-typecheck/src/typecheck/tests/mod.rs index ac1e7094..7ac11502 100644 --- a/crates/psrs-typecheck/src/typecheck/tests/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/tests/mod.rs @@ -75,7 +75,7 @@ fn integer(value: &str, start: u32) -> HirExpr { #[test] fn infers_functions_arithmetic_conditionals_and_intrinsic_booleans() { - let add = Intrinsic::I32Add.symbol(); + let add = Intrinsic::IntAdd.symbol(); let true_symbol = Intrinsic::BoolTrue.symbol(); let increment = expr( HirExprKind::Lambda { diff --git a/docs/design/D-15-compiler-builtins.md b/docs/design/D-15-compiler-builtins.md index 795509a3..fbfe9fdf 100644 --- a/docs/design/D-15-compiler-builtins.md +++ b/docs/design/D-15-compiler-builtins.md @@ -72,27 +72,18 @@ knows": ### Intrinsics on the Wasm target -For the Wasm target the intrinsics are the compiler's curated vocabulary of -primitive operations at the machine layer — the operations the standard library -is allowed to rely on directly. Each is realized by the backend from one or more -Wasm instructions (scalar, GC `array`/`struct`/`ref`, or bulk memory), from a -short helper sequence, or from no instruction at all. The correspondence is -many-to-many, so the set is not literally a subset of the instruction list: - -- One instruction, one intrinsic: `i32.add` for `i32Add`. -- One instruction, several intrinsics: `i32.lt_s` serves `i32LtS` and `charLt`. -- One intrinsic, several instructions: `arrayAppend` is `array.new_default` plus - two element-copy loops; `intDiv` is `i32.div_s` with a sign-correction helper. -- No instruction: `charToInt` and `intToChar` are the identity; `true`, `false`, - and `unit` are constants; `Coerce` has no runtime form. - -The set is a project decision, not a projection of the instruction list. It holds -exactly the operations the standard library needs that the source language cannot -express and no host capability provides. That places it at the machine layer and -below the Canonical ABI, which is why it cannot be a WIT call; the encoding of -each operation belongs to the backend -([Wasm encoding and structuring](backend/wasm/encoding-and-structuring.md)), not -to this registry. +The registry describes checked language operations, not Wasm opcode names. +`IntAdd`, `IntQuot`, and `NumberAbs` have language schemes; MIR selects +`I32Add`, `I32DivS`, and `F64Abs`. A primitive may require one instruction, +a sequence, a generated representation operation, or a pinned artifact export. +Constants and checked coercions can have no runtime instruction. + +The backend's exhaustive implementation catalog owns that selection; runtime +metadata owns raw export signatures and value protocols. See +[intrinsic implementations](backend/fp/intrinsic-implementations.md). Library +algorithms remain ordinary target library functions. In particular, public +Euclidean division/modulo are library policy over truncating primitives; +retired floor intrinsic IDs 26 and 27 are never reused. ### Why intrinsics are compiler-owned here @@ -159,13 +150,14 @@ pub struct IntrinsicDescriptor { pub name: &'static str, pub arity: u8, pub category: IntrinsicCategory, + pub effects: IntrinsicEffects, // conservative traps and mutation /// A non-capturing constructor, so the table can be `const`. pub scheme: fn() -> Type, // an HIR Type } pub enum IntrinsicCategory { Nullary, // true, false, unit - UnaryScalar, + Unary, // one language argument; not necessarily a scalar BinaryScalar, ArrayLength, ArrayIndex, @@ -207,12 +199,12 @@ registry and the registry on `core`. | P3 Resolve | `name`, `scheme` | `ExternalSymbol { signature: Some(scheme) }` | | P5 Type check | `scheme`, instantiated | the intrinsic's `InferType`; `Coercion` takes a special path | | P6 Core lowering | `intrinsic`, `arity`, `category` | one `ExprKind::IntrinsicCall` | -| P8/P9 Backend | its own tables only | CC `AssignmentKind` and MIR instructions | +| P8/P9 Backend | checked identity and scheme; target implementation catalog | CC `AssignmentKind` and MIR instructions | -The backend does not consult the registry: by the time it runs, Core has already -expressed the operation in its own terms, and the backend lowers those with its -own representation tables. The registry tells the front-end stages *what* the -operation is. +The registry defines the language contract. The backend reads that contract to +verify artifact-call values before ABI erasure, and its implementation catalog +selects how to realize it. HIR contains no target lowering or raw ABI dependency. +Core optimizations consume the registry's conservative trap and mutation effects. ### Why lowering is not in the registry @@ -392,20 +384,20 @@ The surface operators `+`, `*`, `==`, `/=`, `<`, `<=`, `>`, and `>=` are now library classes — `Data.Semiring`, `Data.Eq`, `Data.Ord` — over internal primitives, and `Prelude` re-exports them, matching official PureScript. A source that uses them imports `Prelude`. Each instance eta-expands its intrinsic -(`eq x y = intEq x y`) because a first-class intrinsic reference is not lowerable. - -`-` is the `Data.Ring` operator and `/` is the `Data.EuclideanRing` operator, -both re-exported from `Prelude`. The primitives under them are `intSub` -(wrapping subtraction) and `intQuot` (truncating division). `intDiv` and -`intMod` stay the Euclidean pair the `Int` instance calls. `%` is still the -truncating remainder primitive; the library spells that operation `mod`. - -`Show` is a library class in `Data.Show`, re-exported from `Prelude`, over the -same primitives. It does not add an intrinsic: integer, character, and string -rendering are written in the source language, and `Number` rendering is too. -That `Number` spelling is not a correctly rounded ECMAScript conversion. A pure -numeric formatter with canonical inputs and outputs is the open capability -question above, not a new `Intrinsic`. +(`eq x y = intEq x y`); unsaturated intrinsic uses also elaborate through +checked eta expansion before backend lowering. + +`-` and `/` are the library `Data.Ring` and `Data.EuclideanRing` operators. +The target library implements the official Int Euclidean policy using `intSub`, +`intQuot`, and truncating `%`. Compiler `intDiv/intMod` are retired because their +floor policy differed for negative divisors and zero. `mod` remains the public +nonnegative Euclidean remainder, rather than an alias for `%`. + +`Show` remains a library class. Integer, character, and string wrappers stay +library-owned; Number conversion uses the checked `NumberToString` primitive +whose target implementation is the pinned correctly rounded formatter artifact. +The parser likewise exposes a small conversion leaf while public validation and +`Maybe` construction remain in the unchanged official wrapper. ## References diff --git a/docs/design/backend/00-ir-boundaries.md b/docs/design/backend/00-ir-boundaries.md index a4d999a7..fe5975be 100644 --- a/docs/design/backend/00-ir-boundaries.md +++ b/docs/design/backend/00-ir-boundaries.md @@ -346,7 +346,7 @@ mir/ MIR verify/ MIR verifier wit/ canonical ABI adaptation for WIT calls reachable.rs reachability of representation requirements - scalar_helpers.rs, numeric.rs scalar operations and helpers + numeric.rs concrete scalar operations wasm/ thin structured Wasm target mod.rs Wasm IR: `Module`, `Op`, `Function`, `Export`, `DataSegment` encode.rs binary encoding diff --git a/docs/design/backend/fp/intrinsic-implementations.md b/docs/design/backend/fp/intrinsic-implementations.md new file mode 100644 index 00000000..3985e16e --- /dev/null +++ b/docs/design/backend/fp/intrinsic-implementations.md @@ -0,0 +1,83 @@ +# Intrinsic semantic and target implementation contracts + +**Feature:** [F-02](../../../feature/F-02-portable-programs.md) + +**Related design:** [IR boundaries](../../D-01-frontend-and-ir-boundaries.md), +[scalars](scalars-and-primitives.md), and +[target linking](../wasm/linking-and-runtime.md). + +## Semantic identity + +HIR owns stable intrinsic identities, language schemes, arity, and conservative +semantic effects. Names describe language values: IntAdd, IntQuot, IntRem, +NumberAbs, and StringToBytes. Machine widths and signed opcodes belong to MIR, +where IntAdd selects I32Add and NumberAbs selects F64Abs. Renaming a language +operation must preserve its symbol ID. Retired IDs remain reserved and cannot +be reused or bootstrapped as callable operations. + +An intrinsic need not correspond to one machine opcode. Opaque representation +operations and correctly rounded numerical conversion are valid primitive +boundaries. Library algorithms and policies remain ordinary library functions. +Integer Euclidean div/mod, including negative-divisor and zero-divisor policy, +belong to psrs-stdlib over checked truncating IntQuot/IntRem. The former compiler +IntDiv/IntMod floor algorithms are retired, not aliases for the official API. +Their IDs are reserved. The official source functions and bindings remain intact. + +The vocabulary also includes values and compile-time operations. Checked +coercions and unsupported partial values must be classified explicitly; they +must not fall through to a scalar emitter or acquire a fabricated runtime body. + +## Target selection + +The backend owns one exhaustive implementation selection keyed by intrinsic +identity. A supported runtime operation selects one of: + +- Direct: a CC scalar operation selecting a MIR opcode or instruction sequence. +- Generated: a representation operation lowered to checked local IR, including + storage operations, codecs and explicit conversion plans. +- Artifact: a pinned executable export with a raw signature and value protocol. + +Compile-time operations and unsupported values have separate explicit cases. +HIR must not depend on the backend, runtime code, or raw target ABI. Runtime +metadata must not depend on compiler IR. The backend performs the conversion +between language contracts, CC shapes, MIR values and the runtime catalog. + +Adding a supported intrinsic requires an implementation case. Missing cases +must fail compilation or report unsupported behavior, never panic in a generic +scalar fallback. Operation effects have one semantic owner; optimization must +retain possible traps and mutations independently of the selected provider. + +## Artifact calls + +CC retains an intrinsic identity and checked arguments for an artifact call. +Before erasure, the verifier checks operand and result shapes against the +intrinsic's closed language scheme. MIR consumes the selected value protocol: +raw scalars, a borrowed canonical UTF-8 input buffer, or caller-owned bounded +UTF-8 output. Protocol metadata records capacity and normal-return release. +Existing reviewed codecs implement representation conversion; the linker does +not reconstruct language layouts. Unsupported schemes or protocols are errors. + +The import signature in actual MIR is the consumer's contract. Target planning +must compare it with the selected export ABI, then verify the export against +real artifact bytes. Setting both expected and provided signatures from the +catalog does not establish compatibility with the consumer. Arity, operand +width, result type, and GC references require rejection tests at this boundary. + +Generated bindings must likewise satisfy the signature of the generated body; +reserved symbols identify a provider, not evidence that an arbitrary signature +is correct. Wasm emission consumes the checked selection and memory plan. + +Artifact provenance, digest, initialization, private storage, memory ownership, +and reachable stack bounds remain governed by the target-linking design. A trap +aborts the command; successful raw calls release transient buffers and retain +no pointer. A direct implementation contributes no artifact dependency. + +## Acceptance + +Verify stable IDs and reserved slots, exhaustive target selection, checked +source shapes, malformed MIR imports, and actual export contracts. Execute +direct operations and artifact calls, including unsaturated source uses, +signed zeros, nonfinite values, retained strings and buffer reuse. Compare +public integer div/mod against pinned official JS on all sign combinations, +zero divisors and representable bounds. Unrepresentable quotient overflow +remains an explicit Wasm trap. Retired floor bindings must be unavailable. diff --git a/docs/design/backend/fp/mir.md b/docs/design/backend/fp/mir.md index bff4d039..a39d08a8 100644 --- a/docs/design/backend/fp/mir.md +++ b/docs/design/backend/fp/mir.md @@ -298,8 +298,8 @@ lower_if(cond, then_assignments, then_value, else_assignments, else_value): ``` A direct call becomes `Call`/`CallVoid`; a closure call becomes `ClosureCall`. -The scalar helpers of `scalar_helpers` are appended as extra functions when the -module uses floor division or modulo. +Artifact calls use the shared raw-scalar or UTF-8 transport protocol in +`lower/runtime_call.rs`. Public division/modulo remain ordinary library code. ### Dominance @@ -339,7 +339,7 @@ mir/ verify/ MIR verifier wit/ canonical ABI adaptation for WIT calls reachable.rs reachability of representation requirements - scalar_helpers.rs, numeric.rs scalar operations and helpers + numeric.rs concrete scalar operations ``` **Required types.** `mir/mod.rs` MUST define `Module`, `Function`, @@ -357,7 +357,7 @@ pub enum Terminator { Return, Jump, Branch, Switch, ReturnCall, ReturnCallRef } `mir/instruction.rs` MUST define `Instruction` so every variant carries a destination `ValueId`, its operand `ValueId`s, and a source span. The scalar -vocabularies live in `mir/numeric.rs` and `mir/scalar_helpers.rs` +vocabularies live in `mir/numeric.rs` ([scalars and primitives](scalars-and-primitives.md)); `mir/layout/` owns `PlannedLayout` and every concrete GC layout ([data representation](data-representation.md)); `mir/wit/` owns canonical ABI diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index 470d77b6..f17bfe15 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -3,7 +3,7 @@ **Feature:** F-02 **Status:** Stable (design) **Prerequisites:** [CC IR](cc-ir.md) and [MIR](mir.md); two's-complement -integer arithmetic, IEEE-754 binary64, floor division, and the Wasm numeric +integer arithmetic, IEEE-754 binary64, Euclidean division, and the Wasm numeric instruction set. Read [IR boundaries](../00-ir-boundaries.md) first. **Summary:** Scalars are the unboxed Wasm value types the backend uses for `Int`, `Number`, `Boolean`, `Char`, and `Unit`; `String` is a GC array of @@ -11,16 +11,14 @@ canonical UTF-8 bytes ([DEC-16](../../../decision/DEC-16-scalar-strings-and-utf8-storage.md)), copied only at the canonical ABI boundary, and not a scalar. This document fixes the complete unary and binary operation -vocabulary, the concrete Wasm lowering of every operation, the module-local -floor division and modulo helpers, and the saturating `Number`-to-`Int` +vocabulary, the concrete Wasm lowering of every operation, the library-owned Euclidean division policy, and the saturating `Number`-to-`Int` conversion. It is the reference a frontend uses to lower every built-in scalar operator without adding representation special cases. ## Scope This document owns the scalar value model shared by CC and MIR, the unary and -binary operation vocabularies and their lowering, the generated floor -helpers, the saturating float-to-int sequence, and scalar verification. It does +binary operation vocabularies and their lowering, the boundary to library arithmetic, the saturating float-to-int sequence, and scalar verification. It does not own the byte-oriented string and ABI boundary (see [linear memory and the canonical ABI boundary](../wasm/linear-memory-and-canonical-abi-boundary.md) and @@ -37,12 +35,13 @@ the Wasm `i32.add`/`sub`/`mul` behavior. The official compiler realizes `Int` on JavaScript with `| 0`, giving the same wrapping semantics; that behavior is the reference. -**Truncated versus floor division.** Truncated division rounds toward zero -and its remainder takes the sign of the dividend. `Data.Int`'s `div` rounds -toward negative infinity, and `mod` satisfies `a = b * div a b + mod a b`: -for nonzero `b`, the remainder is zero or has the sign of `b` and magnitude -less than `|b|`. Wasm `i32.div_s`/`i32.rem_s` provide the truncated pair, so -the floor pair is computed by a helper. +**Truncated versus Euclidean division.** The primitive quotient truncates toward +zero and its remainder takes the dividend's sign. Official `Data.EuclideanRing` +`div/mod` instead satisfy `a = b * div a b + mod a b` with a nonnegative +remainder below `abs b` for nonzero divisors; both return zero for divisor zero. +The ordinary target library implements that policy using the truncating +primitives. For example, `div 3 (-2) = -1` and `mod 3 (-2) = 1`. +The compiler does not provide a second floor-division policy. **IEEE-754 binary64.** `Number` is an IEEE-754 binary64 value. The ordered comparisons follow the usual rules: a `NaN` is unequal to everything including @@ -92,7 +91,7 @@ CC UnaryOp = IntNeg | IntComplement | NumberNeg | BooleanNot | CharToInt | IntToChar CC BinaryOp = IntAdd | IntSub | IntMul - | IntQuot | IntRem | IntDiv | IntMod + | IntQuot | IntRem | IntAnd | IntOr | IntXor | IntShl | IntShr | IntZshr | IntEq | IntNe | IntLt | IntLe | IntGt | IntGe | NumberAdd | NumberSub | NumberMul | NumberDiv @@ -129,8 +128,8 @@ reachable from the CC vocabulary. - `StringEq` takes two `ValueShape::String` values and produces `Boolean`. Canonical UTF-8 byte length and contents define equality; object identity is not observable. -- floor helpers are ordinary MIR functions with `i32` parameters and - result, generated only when the module contains `IntDiv` or `IntMod`. +- Euclidean division and modulo remain ordinary library functions, composed + from checked primitive arithmetic and conditionals. ## Design @@ -144,7 +143,6 @@ chosen mapping is: | --- | --- | --- | | `IntAdd` / `IntSub` / `IntMul` | `I32Add` / `I32Sub` / `I32Mul` | `i32.add` / `i32.sub` / `i32.mul` | | `IntQuot` / `IntRem` | `I32DivS` / `I32RemS` | `i32.div_s` / `i32.rem_s` | -| `IntDiv` / `IntMod` | helper `Call` | module-local MIR function | | `IntAnd` / `IntOr` / `IntXor` | `I32And` / `I32Or` / `I32Xor` | `i32.and` / `i32.or` / `i32.xor` | | `IntShl` / `IntShr` / `IntZshr` | `I32Shl` / `I32ShrS` / `I32ShrU` | `i32.shl` / `i32.shr_s` / `i32.shr_u` | | `IntEq`..`IntGe` | `I32Eq`..`I32GeS` | `i32.eq`/`ne`/`lt_s`/`le_s`/`gt_s`/`ge_s` | @@ -183,9 +181,8 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. dividend. Division or remainder by zero traps because the Wasm instruction traps; `i32.div_s` also traps on `i32.min / -1`, and that is the defined two's-complement overflow behavior. -- `IntDiv`/`IntMod` use floor division and a remainder with the divisor's sign, - matching `Data.Int`; they are computed by - the helpers below. +- Public `div/mod` belong to the library and use nonnegative Euclidean + remainders and explicit zero handling; see the background above. - Comparisons are signed; shifts and bitwise operations act on the 32-bit pattern. @@ -273,9 +270,9 @@ and [Rust f64::from_str](https://doc.rust-lang.org/std/primitive.f64.html#impl-F ### Rejected alternatives -- **Map `IntDiv`/`IntMod` to `i32.div_s`/`i32.rem_s`.** Rejected: these are - truncated, not floor, and produce the wrong remainder sign for negative - operands (`-5` by `3` would give remainder `-2` instead of `1`). +- **Compiler-owned Euclidean or floor helpers.** Rejected: public arithmetic + policy belongs to ordinary library definitions. The old `intDiv/intMod` + bindings implemented a different signed-divisor policy and are retired. - **Trapping `Number`-to-`Int`.** Rejected: an out-of-range or `NaN` operand would trap a type-correct program. The saturating lowering keeps the conversion total. @@ -305,63 +302,25 @@ The emitter builds this as nested `if` expressions over `f64.le`, `f64.ge`, and `f64.ne` and calls the trapping `i32.trunc_f64_s` only inside the safe range, so it never traps. -### Floor division and modulo +### Library division and modulo -Both helpers read their operands as `i32` parameters `a` and `b`. They first -compute the truncated remainder and decide whether an adjustment is needed: - -```text -r = a rem_s b # truncated remainder -nonzero = r != 0 -remainder_neg = r < 0 -divisor_neg = b < 0 -adjust = nonzero && (remainder_neg != divisor_neg) - -# divide: -if adjust: a div_s b - 1 else: a div_s b - -# modulo: -if adjust: r + b else: r -``` - -The adjustment changes a quotient or remainder only when the truncated remainder -and the divisor have opposite signs. Thus `a = b * div a b + mod a b`, with -`mod a b` taking the sign of `b` (or zero). This is floor division; the -nonnegative-remainder convention is a different rule. Both paths -execute `a rem_s b` (and `a div_s b` for the divide helper), so `b = 0` traps as -the underlying instruction does. This matches the official `Data.Int` -semantics. - -### Helper generation and linking - -```text -lower_scalar_helpers(module, first_function_id): - needs_div = any assignment (including nested if branches) is IntDiv - needs_mod = any assignment is IntMod - symbol_module = first function's module, else the intrinsics module - allocate each needed helper symbol downward from u32::MAX, skipping symbols - used by the module's functions and externals - emit each helper as an ordinary MIR Function with consecutive FunctionIds - starting at first_function_id -``` - -Each helper is a four-block MIR function (entry, then-block, else-block, merge -block) with a `Branch`, two `Jump`s with the computed value, and a `Return`. The -helper symbols are held beside the module in `ScalarHelpers`; when lowering an -`IntDiv`/`IntMod` assignment, P9 emits an `Instruction::Call` to the -corresponding helper instead of a `Primitive`. A module that uses neither -operation generates neither helper. +The official pure wrappers retain their source signatures and branches. The +Wasm-specific foreign delegates expose truncating quotient/remainder and wrapping +arithmetic. Their callers implement Euclidean adjustment and zero handling. +There is no `IntDiv` or `IntMod` CC operation or generated MIR helper. Retired +intrinsic IDs 26 and 27 remain reserved; the names are rejected rather than +being silently rebound to a different policy. ## Code map -The scalar design is owned by three module groups: the MIR operation -vocabularies, the MIR helper generator, and the Wasm emission modules. The -intended structure is: +The language vocabulary, exhaustive target selection, concrete MIR operations, +and Wasm emission have separate owners. See +[intrinsic implementations](intrinsic-implementations.md). The structure is: ```text mir/numeric.rs UnaryOp and NumericOp; CC -> MIR operation selection -mir/scalar_helpers.rs floor helper detection, generation, and - helper symbol allocation +target_intrinsics/ exhaustive language-to-target selection +mir/lower/runtime_call.rs artifact protocol adaptation wasm/lower/structure/ops.rs binary NumericOp -> wasm_encoder::Instruction, plus reference and memory operand helpers wasm/lower/structure/unary.rs UnaryOp emission, including the saturating @@ -375,30 +334,19 @@ vocabularies and the total conversion from the CC vocabularies: pub enum UnaryOp { I32Neg, I32Complement, F64Neg, BoolNot, I32ToF64, F64ToF32, F32ToF64, F64ToI32Sat, BoolToI32, I32ToBool, I32Identity } pub enum NumericOp { I32Add, I32Sub, I32Mul, I32DivS, I32RemS, I32And, I32Or, I32Xor, I32Shl, I32ShrS, I32ShrU, I32Eq, I32Ne, I32LtS, I32LeS, I32GtS, I32GeS, BoolAnd, BoolOr, BoolEq, BoolNe, F64Add, F64Sub, F64Mul, F64Div, F64Eq, F64Ne, F64Lt, F64Le, F64Gt, F64Ge } impl From for UnaryOp; // total -impl TryFrom for NumericOp; // IntDiv/IntMod have no instruction +impl TryFrom for NumericOp; // StringEq is lowered as a byte comparison ``` Every CC unary operation MUST map to exactly one `UnaryOp`, and every CC binary -operation except `IntDiv` and `IntMod` MUST map to exactly one `NumericOp`. - -**Helper generation.** `mir/scalar_helpers.rs` MUST detect the -helper-requiring operations, allocate their symbols, and emit the helpers: +operation except `StringEq` MUST map to exactly one `NumericOp`. String equality +uses its checked GC byte-array lowering. -```rust -pub fn lower_scalar_helpers(module: &cc::Module, first_function_id: u32) -> (ScalarHelpers, Vec); -impl ScalarHelpers { - pub fn binary_instruction(&self, op: cc::BinaryOp, destination: ValueId, left: ValueId, right: ValueId, span: TextRange) -> Result>; -} -``` - -`lower_scalar_helpers` MUST emit each needed helper as an ordinary `Function` -with consecutive `FunctionId`s starting at `first_function_id`, MUST allocate -each helper symbol downward from `u32::MAX` while skipping symbols already used -by the module's functions and externals, and MUST return the symbol table. A -module that uses neither `IntDiv` nor `IntMod` MUST generate no helper. -`ScalarHelpers::binary_instruction` MUST select a `Call` to the matching -generated helper for `IntDiv`/`IntMod` and MUST otherwise select the -corresponding `Primitive` from `mir/numeric.rs`. +**Implementation selection.** `target_intrinsics::implementation` MUST classify +all active HIR identities exhaustively as direct operations, generated operations, +artifact exports, elaborated values, or explicit unsupported values. This table +selects the implementation; the consuming pass performs its own typed conversion. +Artifact adaptation validates the language scheme before erasure, and linking +checks the actual MIR consumer signature against the provider. **Wasm emission.** `wasm/lower/structure/ops.rs` MUST expose: @@ -439,8 +387,7 @@ exactly; the MIR verifier checks each lowered operation's operand and result produce `Boolean`; - unary negation/complement match their operand and result types; - `I32ToF64` is `I32 -> F64`, `F64ToI32Sat` is `F64 -> I32`, `BoolToI32` is - `Boolean -> I32`, and `I32ToBool` is `I32 -> Boolean`; and -- the floor helper signatures are `(I32, I32) -> I32`. + `Boolean -> I32`, and `I32ToBool` is `I32 -> Boolean`. A mismatch is reported with the operation's source span. Every operation in this vocabulary is part of the core WebAssembly baseline; the target capability @@ -448,34 +395,12 @@ gate needs no new proposal for it. ## Worked example -floor division of `-5` by `3`. The CC fragment - -```text -v0 = -5 -v1 = 3 -v2 = IntDiv(v0, v1) -v3 = IntMod(v0, v1) -result = v2 + v3*... // in source, `div (-5) 3` and `mod (-5) 3` -``` - -has both operations replaced by helper calls, and the module gains -`__psrs_floor_int_div` and `__psrs_floor_int_mod`. Tracing the divide -helper: - -```text -a = -5, b = 3 -r = -5 rem_s 3 = -2 -nonzero = true -remainder_neg = true -divisor_neg = false -adjust = true -result = (-5 div_s 3) - 1 = -1 - 1 = -2 -``` - -The modulo helper computes `r + b = -2 + 3 = 1`. Substituting into -`a = b * div a b + mod a b` gives `-5 = 3 * (-2) + 1`, the floor identity. -The `div_mod` and `binary_matrix` fixtures execute this and the other sign -combinations through Wasm GC and check the combined boolean result. +For `a = -5` and `b = 3`, raw quotient/remainder produce `-1` and `-2`. +The library adjusts them to `div a b = -2` and `mod a b = 1`, satisfying +`-5 = 3 * (-2) + 1`. For `a = 3` and `b = -2`, the raw remainder is already +nonnegative: the library returns quotient `-1` and remainder `1`. +For `b = 0`, the wrapper returns zero before executing either trapping primitive. +Source tests exercise these wrappers through case branches and all operand signs. ## Boundaries and interfaces @@ -494,15 +419,15 @@ combinations through Wasm GC and check the combined boolean result. ## Open questions and future work - **`Number` remainder.** If a source `mod` for `Number` is added, its exact - semantics (JavaScript `%` versus floor) and helper must be fixed here. + semantics (JavaScript `%` versus Euclidean policy) must be owned by the + library wrapper rather than a new compiler arithmetic operation. - **Saturating-capability switch.** The profile enables the saturating float-to-int proposal; if the sequence were replaced by `i32.trunc_sat_f64_s` the capability gate would have to require it. - **`i64`/`f32` source types.** Adding them is a vocabulary extension with no change to the operand/result model. -- **Fast paths for known-sign constants.** The helper could inline the - adjustment when both operands are statically non-negative; this is an - optimization that must preserve the floor result. +- **Fast paths for known-sign constants.** Ordinary library code may inline its + adjustment when operands are known, preserving the Euclidean result. ## Implementation notes @@ -511,7 +436,7 @@ and binary set above. The source bootstrap exposes the operations that do not already have symbolic integer syntax as specialized functions: `intNeg`, `intComplement`, `numberNeg`, `numberTrunc`, `numberFloor`, `numberCeil`, `booleanNot`, the six conversion names from the table (`intToNumber`, `numberToInt`, `booleanToInt`, `intToBoolean`, -`charToInt`, and `intToChar`), `intDiv`, `intMod`, the six integer bitwise +`charToInt`, and `intToChar`), the six integer bitwise and shift names, all `number*`, `boolean*`, and `char*` binary names in the table. The existing symbols `+`, `-`, `*`, `/`, `%`, `==`, `/=`, `<`, `<=`, `>`, and @@ -519,7 +444,7 @@ The existing symbols `+`, `-`, `*`, `/`, `%`, `==`, `/=`, `<`, `<=`, `>`, and Fully saturated intrinsic applications lower to typed Core unary or binary primitives; Core verification checks their exact scalar operand and result types before P8 maps them into CC. A source-level driver fixture compiles every -operation and executes the documented floor, conversion, comparison, and +operation and executes the documented Euclidean, conversion, comparison, and wrapping behaviors through Wasmtime when it is available. ## References diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index 528468ce..6f274888 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -375,7 +375,8 @@ psrs-hir/intrinsic/ semantic identities and source schemes psrs-core/verify/ checked uses and external schemes psrs-backend/bindings/ source contract + implementation requirements psrs-backend/abi/ source/WIT validation, canonical conversion, ownership -psrs-backend/target_runtime/ intrinsic-to-provider selection using runtime catalog +psrs-backend/target_intrinsics/ exhaustive implementation selection +psrs-backend/target_runtime/ artifact language/transport contracts using runtime metadata psrs-backend/linking/ checked IR-to-linker requests and diagnostic mapping psrs-backend/mir/ raw calls, value recovery, explicit lifetimes psrs-backend/wasm/ planned memory/import emission and encoding @@ -563,3 +564,17 @@ Guest execution evidence is recorded separately from the numeric runtime slice. and [WIT specification](https://github.com/WebAssembly/component-model/blob/main/design/mvp/WIT.md) for interface definitions, canonical boundaries, and typed composition. - [ryu-js](https://github.com/boa-dev/ryu-js) for the selected formatter implementation. + +### Consumer signatures and implementation selection + +The exhaustive [intrinsic implementation catalog](../fp/intrinsic-implementations.md) +owns direct/generated/artifact selection. HIR owns language schemes and semantic +effects; the runtime owns raw export contracts and transport protocols. CC keeps +the intrinsic identity on artifact calls until MIR discharges value transport. + +An artifact requirement's expected signature MUST come from the actual MIR +consumer import, independently of the runtime provider descriptor. The planner +checks it against both the provider contract and the actual artifact export. +Generated allocator/codec imports MUST likewise match the shared generated-body +signature and concrete GC byte-array representation. Internally consistent MIR +call typing alone does not establish either provider boundary. diff --git a/docs/implementation/backend/control-flow-and-tail-calls.md b/docs/implementation/backend/control-flow-and-tail-calls.md index bf186b8f..a9627b0b 100644 --- a/docs/implementation/backend/control-flow-and-tail-calls.md +++ b/docs/implementation/backend/control-flow-and-tail-calls.md @@ -103,7 +103,7 @@ CF-01: CF-13: Implementation: crates/psrs-backend/src/mir/mod.rs (Terminator::Branch has no merge_block); mir/lower/assignments.rs, mir/lower/aggregate/array.rs, - mir/scalar_helpers.rs (producers no longer set it); mir/cfg.rs + mir/lower/assignments.rs; mir/cfg.rs (common_join/join_blocks derive joins from CFG edges); mir/verify/function.rs (merge check removed, target-parameter check kept); mir/opt/constants.rs (join parameters preserved); wasm/lower/structure/cfg/mod.rs and diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md new file mode 100644 index 00000000..87027234 --- /dev/null +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -0,0 +1,99 @@ +# Intrinsic implementation separation acceptance — 2026-10-07 + +## Contract and baseline + +The governing contracts are [intrinsic implementations](../../design/backend/fp/intrinsic-implementations.md), +[D-15](../../design/D-15-compiler-builtins.md), +[scalars](../../design/backend/fp/scalars-and-primitives.md), and +[DEC-18](../../decision/DEC-18-unified-target-linking.md). +The compiler baseline was clean `b263b14` on `stdlib/vendor-core-libraries`; +the library baseline was `e0679521275277c0b005b2509d9e0a8570715c5e`. + +A focused source diagnosis accepted the old explicit `intDiv/intMod` bindings. +Execution demonstrated that they returned floor-policy results different from +public official Euclidean arithmetic for negative divisors. This was a duplicate +compiler policy, not a reason to rewrite official library functions. + +A separate malformed-MIR reproducer declared a formatter consumer with +`(i32, i32, i32) -> i32`, and made its call agree with that declaration. +MIR verification and Wasm lowering both accepted it before this change. After +this change local MIR verification still accepts the internally consistent +call, but target planning rejects it against the formatter's actual +`(f64, i32, i32) -> i32` provider. Both direct Wasm lowering and the checked-plan +path enforce this boundary. Baseline reports, raw programs and logs remain +outside the repository under `/private/tmp/psrs-intrinsic-*`. + +## Implemented ownership + +- HIR owns stable language identities, schemes, arity and conservative trap/mutation effects. +- The exhaustive backend catalog selects direct, generated or artifact implementations, with explicit elaborated/unsupported cases. Artifact enumeration derives from this selection. +- CC verifies artifact arguments and results before erasure. MIR adapts calls through a shared raw-scalar/UTF-8 protocol instead of per-numeric-operation assignments. +- Runtime metadata owns raw export ABI, output capacity and borrowed/caller-owned buffer protocols. Existing runtime executable bytes are retained. +- Linking derives expected ABI from actual MIR imports. Generated allocator/codec signatures are shared by MIR import production, provider verification and emission. + +Language `Int*` names replace HIR machine spellings while preserving active +symbol IDs. Retired floor IDs 26 and 27 cannot be reused or resolved as bindings. +The old CC operations, MIR helpers and helper-only tests are removed. Public +Euclidean division/modulo remain in ordinary library source, including zero +handling. Two target-only array helpers use `intQuot` for nonnegative lengths +and positive divisors; their official source callers remain unchanged. + +## Verification + +Measured on 2026-10-07 against compiler `b263b14` plus this change, with the +lock at library `7cace2a6b4808b36b01559e88d3ebc351a3b7426` +(`fnv1a64-v1:1fd8c04ec63c6ff0`). Wasmtime is 49.0.2. Cargo commands used +`CARGO_INCREMENTAL=0`. Runtime checks also used `PSRS_REQUIRE_WASMTIME=1`. +Raw logs stay outside the repository under `/private/tmp/psrs-intrinsic-*`. + +Compiler checks: + +- `cargo fmt --all --check` passed on the final Rust sources. +- `cargo clippy --workspace --all-targets -- -D warnings` passed. +- `cargo test -p psrs-backend --lib`: 408 passed. +- `cargo test -p psrs-driver --lib tests::scalars`: 16 passed. This includes + the repaired case-arm division test. It no longer requires a compiler floor + helper. +- `cargo test -p psrs-driver --lib intrinsic`: 7 passed. Retired `intDiv` and + `intMod` bindings are rejected. Public Euclidean division and modulo run for + both signs, zero divisors, and a higher-order call. A balanced public + `Maybe` traversal covers nine elements, an empty input, and a failed element. +- `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` finished all + 52 targets: 1690 passed, 3 failed, 5 ignored. The only failing target is + `psrs-driver --lib`, and its three failures are the established baseline: + `constrained_dictionary_parameters_precede_ordinary_arguments` (the expected + constrained MIR function is absent), + `runs_a_polymorphic_identity_with_a_number` (optimized WAT has no `f64`), + and `compiles_if_expression_through_cfg_to_structured_wasm` (optimized WAT + has no `br_if`). No new failure appeared. +- `crates/psrs-runtime/tools/check-reproducible.sh` rebuilt the runtime + artifact and found it byte-for-byte identical to the committed Wasm. +- A direct malformed formatter consumer, `(i32, i32, i32) -> i32`, still + passes local MIR verification. Target planning and Wasm lowering both reject + it against the formatter export `(f64, i32, i32) -> i32`. + +These checks do not by themselves establish library behavior. Source fidelity, +compilation, and runtime agreement are separate. + +Library evidence, with the package fingerprint unchanged during each run: + +- Source audit of the locked package: 170 identical, 36 modified, 24 platform + additions, 230 modules, and no upstream module absent from the vendor. The + audit records differences. It does not approve them. +- `npm test` in `psrs-stdlib`: 11 passed. +- The library-owned Node runner accepted these oracles. Integer arithmetic has + 209 official observations; the unrepresentable JavaScript quotient of the + signed minimum divided by `-1` is excluded, and the raw Wasm primitive traps. + Public Show has 333 observations, with stdout exactly `3\n1\n2\n`, empty + stderr, and exit 42. `Number.abs` has 306 checks, decimal parsing 304 + observations, and Number/Int rounding 414 checks. Array application has 8 + cases and 29 equality checks. Array algorithms, including sorting, have 30 + cases and 79 equality checks. Every non-Show command exits 42 with empty + stdout and stderr. +- The integer oracle built from the locked package, without a development + package override, is sha256 + `020e5fbf004c167f74f3a149a8f40d84bb0f9a68424187db5f9f42d960194674`. Wasmtime + executed that artifact with exit 42 and empty stdout and stderr. + +This refactor does not establish whole-stdlib runtime completion. `Data.Number.sqrt` +remains blocked by unsupported target FFI. diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index 3b5d9fab..3f182c62 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -209,3 +209,17 @@ compiler and Wasm digests, and execution observations. Source/API evidence and the library-owned oracle are committed with the pinned library revision. The full workspace suite and new corpus scoreboards were not run under the explicit validation scope; no source syntax or diagnostic behavior changed. + +## Intrinsic selection and consumer ABI correction (2026-10-07) + +The backend now owns an exhaustive intrinsic implementation catalog, including +direct operations and generated representation operations as well as artifacts. +Artifact enumeration derives from that selection. The runtime supplies raw +signatures and value protocols, while CC/MIR own checked language adaptation. + +Artifact requirements use actual MIR consumer signatures, independently of the +provider descriptor. The earlier formatter path supplied both signatures from +the provider catalog and therefore did not verify the consumer. New rejection +fixtures cover parameter width/count, missing/wrong results and GC references; +reserved generated helpers also reject wrong signatures and string layouts. +See [the measured acceptance record](intrinsic-implementations-2026-10-07.md). diff --git a/docs/implementation/backend/mir.md b/docs/implementation/backend/mir.md index 06346212..62888163 100644 --- a/docs/implementation/backend/mir.md +++ b/docs/implementation/backend/mir.md @@ -173,7 +173,7 @@ MIR-04: ```text MIR-05: Implementation: mir/instruction.rs (destination/operands/span), - mir/numeric.rs, mir/scalar_helpers.rs, mir/verify/instruction/*. + mir/numeric.rs, mir/verify/instruction/*. Tests: mir::gc_tests::binary_matrix:: verifies_and_executes_every_cc_binary_scalar_variant_on_both_targets; mir::gc_tests::unary:: diff --git a/docs/implementation/backend/scalars-and-primitives.md b/docs/implementation/backend/scalars-and-primitives.md index 5001693d..ac11bb45 100644 --- a/docs/implementation/backend/scalars-and-primitives.md +++ b/docs/implementation/backend/scalars-and-primitives.md @@ -38,12 +38,12 @@ Verified requires exact test and executed result evidence. | SP-02 | `String` keeps a separate semantic CC shape and is a GC byte sequence, linearized only at the canonical ABI boundary. | Positive string literal/import use and verifier rejection of numeric operations on String values. | Verified | | SP-03 | Every specified CC unary/binary primitive has an exact MIR instruction or helper lowering. | Exhaustive operation table matching the design vocabulary; reject missing opcode mappings and wrong operand/result types. | Verified | | SP-04 | Integer add/subtract/multiply and bitwise operations wrap at 32 bits; shift counts follow the specified modulo-32 behavior. | Source or verified Core execution at overflow/underflow and shift counts 0, 31, 32, 33; compare exact bits/results. | Verified | -| SP-05 | Integer quotient/remainder truncate toward zero and trap for divisor zero and signed minimum divided by -1. | Positive signed combinations and expected-trap component cases; distinguish quotient/remainder from floor division/modulo. | Verified | -| SP-06 | Integer division/modulo helpers implement floor quotient and divisor-signed remainder without introducing unrelated traps. | Positive/negative dividend-divisor matrix, zero/overflow trap cases, helper interning, and execution with multiple call sites. | Verified | +| SP-05 | Integer quotient/remainder truncate toward zero and trap for divisor zero and signed minimum divided by -1. | Positive signed combinations and expected-trap component cases; distinguish raw primitives from library Euclidean division/modulo. | Verified | +| SP-06 | Library division/modulo own nonnegative Euclidean remainder and zero handling; no duplicate compiler arithmetic policy remains. | Source execution for all signs, negative divisors, zero divisors, and case branches; retired bindings rejected. | Verified | | SP-07 | Number arithmetic, comparisons, and unary operations retain Wasm/IEEE semantics including NaN and signed zero. | Value-sensitive f64 execution, bitwise inspection when sign of zero matters, and expected NaN comparison behavior. | Verified | | SP-08 | Boolean and character operations use their canonical shape and reject invalid values at appropriate boundaries. | True/false logical cases, Unicode scalar boundary cases, and malformed CC/MIR operation fixtures. | Verified | | SP-09 | `NumberToInt` truncates with saturation for finite overflow, infinities, and NaN; `IntToNumber` follows exact signed conversion. | Execute thresholds around both i32 limits, fractions, infinities, NaN, and full-width integers; assert exact results. | Verified | -| SP-10 | Generated helpers are emitted only when reachable, with collision-free symbols and deterministic scans through nested expressions. | Compare modules with/without div/mod/conversion, nested `If` uses, user-symbol collisions, and repeated calls. | Verified | +| SP-10 | Generated helpers are emitted only when reachable, with collision-free symbols and deterministic scans through nested expressions. | Conversion helper reachability/collisions and reserved generated binding signatures; public div/mod use ordinary library lowering. | Verified | | SP-11 | CC and MIR verifiers enforce exact scalar operand/result and helper-call signatures before encoding. | Negative full-module fixtures for mixed Int/Number, Boolean/i32 confusion, String arithmetic, wrong conversion types, and malformed helper calls. | Verified | | SP-12 | Normal optimization and Wasm encoding preserve values and expected traps under the selected target profile. | Execute optimized/unoptimized representative operations, validate core module/component, and compare against a reference arithmetic oracle. | Verified | | SP-13 | `stringToBytes` is lossless and `bytesToString` checks its input: every element must be a canonical byte and the sequence must be well-formed UTF-8, with a violation trapping rather than producing replacement text ([DEC-16](../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). | Executed round-trip over ASCII, two-byte, four-byte, and empty text; the exact encoded bytes; an out-of-range element; and a malformed UTF-8 sequence. | Verified | @@ -159,7 +159,7 @@ SP-02: ```text SP-03: Implementation: cc/scalar.rs (full CC vocabularies), mir/numeric.rs - (`From`, `TryFrom`), mir/scalar_helpers.rs, + (`From`, `TryFrom`), target_intrinsics/, wasm/lower/structure/ops.rs::primitive, wasm/lower/structure/unary.rs Tests: mir/gc_tests/binary_matrix::verifies_and_executes_every_cc_binary_scalar_variant_on_both_targets (all CC binary variants), mir/gc_tests/unary::lowers_unary_and_conversion_operations_on_both_targets @@ -189,38 +189,14 @@ SP-04: ```text SP-05: - Implementation: mir/numeric.rs IntQuot/IntRem -> I32DivS/I32RemS; - wasm/lower/structure/ops.rs - Tests: mir/gc_tests/binary_matrix (IntQuot 7 2 = 3, IntRem 7 2 = 1); - driver tests/scalars.rs::truncated_and_floor_division_trap_on_zero_divisor_and_signed_overflow - asserts runtime traps `integer divide by zero` for `1 / 0`, `1 % 0`, - `intDiv 1 0`, `intMod 1 0` and `integer overflow` for - `i32.min / -1` through both `intQuot` and `intDiv` - Input boundary: source and executed Wasm - Commands: common commands above - Result: pass; executed under Wasmtime - Revision: cc5d0f4 + uncommitted - Gaps: none + Updated obligation (2026-10-07): Raw IntQuot/% remain truncating; zero and quotient overflow trap. Public library div/mod handle zero. The previous record incorrectly claimed public division traps on zero. + Evidence: intrinsic-implementations-2026-10-07.md ``` ```text SP-06: - Implementation: mir/scalar_helpers.rs (`lower_scalar_helpers`, - `contains_operation`, `euclidean_helper`, `ScalarHelpers::binary_instruction`) - Tests: mir/gc_tests/div_mod::lowers_euclidean_integer_division_and_modulo_on_both_targets - (all four dividend/divisor sign combinations, expected 3), - ...::detects_division_and_modulo_nested_in_tag_switch_cases (case-nested - `intDiv`/`intMod` lower and execute to 4), - driver tests/scalars.rs::generates_floor_helpers_for_division_nested_in_case_branches - (asserts both helpers exist once and `7 div 2 = 3` at runtime) - Input boundary: CC fixtures and source - Commands: common commands above - Result: pass; executed under Wasmtime; before the `contains_operation` - fix the nested case failed with `missing MIR helper for scalar operation - IntDiv` - Revision: cc5d0f4 + uncommitted (fix: recurse into `TagSwitch` cases and the - default arm, not only `If`/`Primitive`) - Gaps: none + Updated obligation (2026-10-07): The former compiler floor helpers have been removed. Their old signed-divisor tests did not prove official Euclidean behavior. Replacement source evidence covers the ordinary library wrappers and retired bindings. + Evidence: intrinsic-implementations-2026-10-07.md ``` ```text @@ -278,21 +254,8 @@ SP-09: ```text SP-10: - Implementation: mir/scalar_helpers.rs `lower_scalar_helpers` - Tests: mir/gc_tests/div_mod::does_not_emit_helpers_without_division_or_modulo - (a module using only IntAdd/IntQuot keeps one function); - ...::skips_helper_symbols_used_by_module_functions (a module symbol at - `(ModuleId(0), u32::MAX)` forces the allocator to skip it; helper symbols - stay distinct); ...::detects_division_and_modulo_nested_in_tag_switch_cases - (nested case); ...::detects_modulo_nested_in_a_tag_switch_default_arm - (nested default arm); ...::lowers_euclidean_integer_division_and_modulo_on_both_targets - (repeated call sites) - Input boundary: CC fixtures - Commands: common commands above - Result: pass; executed under Wasmtime - Revision: cc5d0f4 + uncommitted - Gaps: none. Conversion helpers named in the matrix belong to - generic-aggregate-erasure and are unchanged. + Updated obligation (2026-10-07): Scalar division no longer generates helpers. Conversion reachability remains in its owning generic-erasure topic. Reserved allocator/codec providers share signatures with the emitter and reject malformed MIR consumers. + Evidence: intrinsic-implementations-2026-10-07.md ``` ```text @@ -372,11 +335,9 @@ SP-13: - There is still no source-level string length or index operation, so a converted string can only be observed through `stringToBytes`. -Implementation deviation: the worked example names the helpers -`__psrs_floor_int_div`/`__psrs_floor_int_mod`, while the code emits -`__psrs_euclidean_int_div`/`__psrs_euclidean_int_mod`. The names are cosmetic -and the tests assert the emitted names; the design's symbol-allocation and -operand contract are satisfied. +The former floor-helper evidence was superseded on 2026-10-07. Public Euclidean +arithmetic now remains library-owned; see +[intrinsic implementation acceptance](intrinsic-implementations-2026-10-07.md). ## Number truncation extension (2026-10-07) diff --git a/stdlib.lock.json b/stdlib.lock.json index f3a0ec96..1083d565 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "e0679521275277c0b005b2509d9e0a8570715c5e", - "source_fingerprint": "fnv1a64-v1:4e357ed0c7f9f10f" + "revision": "7cace2a6b4808b36b01559e88d3ebc351a3b7426", + "source_fingerprint": "fnv1a64-v1:1fd8c04ec63c6ff0" } From b3003929076fed6ca111d4e5d351f69c577ae790 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 23:21:01 +0800 Subject: [PATCH 073/148] Support checked Number square root with public behavior evidence numberSqrt lowers to f64.sqrt and keeps the official Data.Number.sqrt signature. Negative zero stays negative zero, and negative inputs produce NaN. The lock pins the library binding and its source verifier. --- crates/psrs-backend/src/cc/scalar.rs | 1 + crates/psrs-backend/src/cc/verify/scalar.rs | 2 +- .../psrs-backend/src/cc/verify/tests/mod.rs | 1 + .../src/mir/gc_tests/number_trunc.rs | 11 +++ crates/psrs-backend/src/mir/numeric.rs | 2 + .../src/mir/verify/instruction/unary.rs | 1 + .../psrs-backend/src/mir/verify/tests/mod.rs | 1 + .../psrs-backend/src/target_intrinsics/mod.rs | 1 + .../src/target_intrinsics/tests.rs | 1 + .../src/wasm/lower/structure/unary.rs | 4 + crates/psrs-core/src/verify/types/mod.rs | 3 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_sqrt.rs | 51 ++++++++++++ crates/psrs-hir/src/intrinsic/effects.rs | 2 +- crates/psrs-hir/src/intrinsic/mod.rs | 8 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + .../backend/fp/scalars-and-primitives.md | 8 ++ .../intrinsic-implementations-2026-10-07.md | 5 +- .../stdlib/number-sqrt-2026-10-07.md | 83 +++++++++++++++++++ docs/workflow/stdlib-conformance.md | 15 ++++ stdlib.lock.json | 4 +- 21 files changed, 197 insertions(+), 9 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_sqrt.rs create mode 100644 docs/implementation/stdlib/number-sqrt-2026-10-07.md diff --git a/crates/psrs-backend/src/cc/scalar.rs b/crates/psrs-backend/src/cc/scalar.rs index 57428726..c0e19713 100644 --- a/crates/psrs-backend/src/cc/scalar.rs +++ b/crates/psrs-backend/src/cc/scalar.rs @@ -6,6 +6,7 @@ pub enum UnaryOp { IntComplement, NumberNeg, NumberAbs, + NumberSqrt, NumberTrunc, NumberFloor, NumberCeil, diff --git a/crates/psrs-backend/src/cc/verify/scalar.rs b/crates/psrs-backend/src/cc/verify/scalar.rs index 64d774f6..4bfef14e 100644 --- a/crates/psrs-backend/src/cc/verify/scalar.rs +++ b/crates/psrs-backend/src/cc/verify/scalar.rs @@ -49,7 +49,7 @@ pub(super) fn verify_unary_operation( IntNeg | IntComplement | CharToInt | IntToChar => { (ValueShape::Integer, ValueShape::Integer) } - NumberAbs | NumberNeg | NumberTrunc | NumberFloor | NumberCeil => { + NumberAbs | NumberSqrt | NumberNeg | NumberTrunc | NumberFloor | NumberCeil => { (ValueShape::Number, ValueShape::Number) } BooleanNot => (ValueShape::Boolean, ValueShape::Boolean), diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index 5f9ed7f9..cac15013 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -247,6 +247,7 @@ fn rejects_a_unary_operation_with_the_wrong_operand_shape() { for op in [ super::super::UnaryOp::NumberAbs, + super::super::UnaryOp::NumberSqrt, super::super::UnaryOp::NumberNeg, super::super::UnaryOp::NumberTrunc, super::super::UnaryOp::NumberFloor, diff --git a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs index 5f644e8f..c0a2e918 100644 --- a/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs +++ b/crates/psrs-backend/src/mir/gc_tests/number_trunc.rs @@ -29,6 +29,17 @@ fn optimized_and_unoptimized_number_floor_and_ceil_preserve_sign_and_range() { ); } +#[test] +fn optimized_and_unoptimized_number_sqrt_preserves_negative_zero_and_exact_squares() { + check_number_unary( + crate::cc::UnaryOp::NumberSqrt, + -0.0, + 4294967296.0, + 65536.0, + true, + ); +} + #[test] fn optimized_and_unoptimized_number_abs_clear_zero_sign_and_preserve_magnitude() { check_number_unary( diff --git a/crates/psrs-backend/src/mir/numeric.rs b/crates/psrs-backend/src/mir/numeric.rs index 114b1540..3569121e 100644 --- a/crates/psrs-backend/src/mir/numeric.rs +++ b/crates/psrs-backend/src/mir/numeric.rs @@ -8,6 +8,7 @@ pub enum UnaryOp { I32Complement, F64Neg, F64Abs, + F64Sqrt, F64Trunc, F64Floor, F64Ceil, @@ -28,6 +29,7 @@ impl From for UnaryOp { CcUnaryOp::IntComplement => Self::I32Complement, CcUnaryOp::NumberNeg => Self::F64Neg, CcUnaryOp::NumberAbs => Self::F64Abs, + CcUnaryOp::NumberSqrt => Self::F64Sqrt, CcUnaryOp::NumberTrunc => Self::F64Trunc, CcUnaryOp::NumberFloor => Self::F64Floor, CcUnaryOp::NumberCeil => Self::F64Ceil, diff --git a/crates/psrs-backend/src/mir/verify/instruction/unary.rs b/crates/psrs-backend/src/mir/verify/instruction/unary.rs index b8e0ae1b..6b98b774 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/unary.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/unary.rs @@ -25,6 +25,7 @@ pub(super) fn verify_unary( (ValueType::I32, ValueType::I32) } UnaryOp::F64Abs + | UnaryOp::F64Sqrt | UnaryOp::F64Neg | UnaryOp::F64Trunc | UnaryOp::F64Floor diff --git a/crates/psrs-backend/src/mir/verify/tests/mod.rs b/crates/psrs-backend/src/mir/verify/tests/mod.rs index a1581441..ed88bf2c 100644 --- a/crates/psrs-backend/src/mir/verify/tests/mod.rs +++ b/crates/psrs-backend/src/mir/verify/tests/mod.rs @@ -100,6 +100,7 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { }; for op in [ crate::mir::UnaryOp::F64Abs, + crate::mir::UnaryOp::F64Sqrt, crate::mir::UnaryOp::F64Neg, crate::mir::UnaryOp::F64Trunc, crate::mir::UnaryOp::F64Floor, diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 6abc51e9..43d02f6c 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -75,6 +75,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::IntComplement => Direct(ScalarOperation::Unary(UnaryOp::IntComplement)), Intrinsic::NumberNeg => Direct(ScalarOperation::Unary(UnaryOp::NumberNeg)), Intrinsic::NumberAbs => Direct(ScalarOperation::Unary(UnaryOp::NumberAbs)), + Intrinsic::NumberSqrt => Direct(ScalarOperation::Unary(UnaryOp::NumberSqrt)), Intrinsic::NumberTrunc => Direct(ScalarOperation::Unary(UnaryOp::NumberTrunc)), Intrinsic::NumberFloor => Direct(ScalarOperation::Unary(UnaryOp::NumberFloor)), Intrinsic::NumberCeil => Direct(ScalarOperation::Unary(UnaryOp::NumberCeil)), diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 39aa0b46..8513ecda 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -35,6 +35,7 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::IntToChar, 25), (Intrinsic::IntAnd, 28), (Intrinsic::NumberAbs, 68), + (Intrinsic::NumberSqrt, 69), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-backend/src/wasm/lower/structure/unary.rs b/crates/psrs-backend/src/wasm/lower/structure/unary.rs index 6299eead..347d69a6 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/unary.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/unary.rs @@ -27,6 +27,10 @@ impl Structurer<'_> { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::F64Abs)); } + UnaryOp::F64Sqrt => { + body.push(Op::Leaf(Instruction::LocalGet(value_local))); + body.push(Op::Leaf(Instruction::F64Sqrt)); + } UnaryOp::F64Neg => { body.push(Op::Leaf(Instruction::LocalGet(value_local))); body.push(Op::Leaf(Instruction::F64Neg)); diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 2d4882f2..d214fe8c 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -78,7 +78,8 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T | Intrinsic::NumberTrunc | Intrinsic::NumberFloor | Intrinsic::NumberCeil - | Intrinsic::NumberAbs => (Number, Number), + | Intrinsic::NumberAbs + | Intrinsic::NumberSqrt => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index ecfa1d74..e50a60eb 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -23,6 +23,7 @@ mod library_foreign; mod number_abs; mod number_decimal; mod number_rounding; +mod number_sqrt; mod number_trunc; mod operators; mod partial_application; diff --git a/crates/psrs-driver/src/tests/number_sqrt.rs b/crates/psrs-driver/src/tests/number_sqrt.rs new file mode 100644 index 00000000..bd22d695 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_sqrt.rs @@ -0,0 +1,51 @@ +use super::*; + +#[test] +fn public_number_sqrt_matches_ieee_squares_zero_signs_and_nonfinite_values() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +apply f value = f value +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negative positiveInfinity +nan = 0.0 / 0.0 +checks = Number.sqrt 4.0 == 2.0 + && Number.sqrt 9.0 == 3.0 + && Number.sqrt 4294967296.0 == 65536.0 + && Number.sqrt 0.0 == 0.0 + && 1.0 / Number.sqrt 0.0 == positiveInfinity + && 1.0 / Number.sqrt (negative 0.0) == negativeInfinity + && Number.sqrt positiveInfinity == positiveInfinity + && Number.sqrt (-1.0) /= Number.sqrt (-1.0) + && Number.sqrt negativeInfinity /= Number.sqrt negativeInfinity + && Number.sqrt nan /= Number.sqrt nan + && apply Number.sqrt 4.0 == 2.0 +main :: Int +main = if checks then 42 else 1 +"#; + let mir = lower_source_to_mir(source); + assert!(format!("{mir:#?}").contains("F64Sqrt")); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_sqrt_requires_number_operand_and_result() { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberSqrt\" root :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("square root requires a checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 8c6741f8..7791a46d 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -28,7 +28,7 @@ impl IntrinsicEffects { | NumberMul | NumberDiv | NumberEq | NumberNe | NumberLt | NumberLe | NumberGt | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor - | NumberCeil | NumberAbs => Self::default(), + | NumberCeil | NumberAbs | NumberSqrt => Self::default(), } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 9286beb3..4c1f25e2 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -112,6 +112,9 @@ pub enum Intrinsic { NumberFromDecimal = 67, /// Clear the binary64 sign bit, including negative zero and NaN. NumberAbs = 68, + /// IEEE-754 square root. Negative finite inputs and NaN produce NaN. + /// Negative zero remains negative zero. The operation does not trap. + NumberSqrt = 69, } impl Intrinsic { @@ -137,7 +140,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 67] = [ + pub const ALL: [Intrinsic; 68] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -205,6 +208,7 @@ impl Intrinsic { Intrinsic::NumberCeil, Intrinsic::NumberFromDecimal, Intrinsic::NumberAbs, + Intrinsic::NumberSqrt, ]; } @@ -214,7 +218,7 @@ impl Intrinsic { const _: () = { assert!( Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberAbs as u32 as usize + 1, + == Intrinsic::NumberSqrt as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 31cbe799..44157bf3 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -109,6 +109,7 @@ descriptors! { NumberTrunc => "numberTrunc", 1, Unary, scheme::number_number; NumberFloor => "numberFloor", 1, Unary, scheme::number_number; NumberAbs => "numberAbs", 1, Unary, scheme::number_number; + NumberSqrt => "numberSqrt", 1, Unary, scheme::number_number; NumberCeil => "numberCeil", 1, Unary, scheme::number_number; BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, Unary, scheme::int_number; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index f17bfe15..562a0f2d 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -156,6 +156,7 @@ chosen mapping is: | `IntComplement` | `I32Complement` | `x ^ -1` | | `NumberNeg` | `F64Neg` | `f64.neg` | | `NumberAbs` | `F64Abs` | `f64.abs` | +| `NumberSqrt` | `F64Sqrt` | `f64.sqrt` | | `NumberTrunc` | `F64Trunc` | `f64.trunc` | | `NumberFloor` / `NumberCeil` | `F64Floor` / `F64Ceil` | `f64.floor` / `f64.ceil` | | `BooleanNot` | `BoolNot` | `i32.eqz` | @@ -197,6 +198,13 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. or library-name recognition is involved. The primitive remains explicit for constant operands; no new constant folding is claimed. See the [WebAssembly absolute-value semantics](https://webassembly.github.io/spec/core/exec/numerics.html#op-fabs). +- `NumberSqrt` (`numberSqrt :: Number -> Number`) lowers to `f64.sqrt`. It + follows IEEE-754 square root: exact squares stay exact, positive infinity + stays positive infinity, a negative finite value or negative infinity becomes + NaN, NaN stays NaN, and negative zero stays negative zero. The operation does + not trap. It implements the official Data.Number.sqrt foreign slot and is not + folded when its operand is constant. See the + [WebAssembly square-root semantics](https://webassembly.github.io/spec/core/exec/numerics.html#op-fsqrt). - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. - The current vocabulary has no `Number` remainder. If the standard library diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md index 87027234..9df75e86 100644 --- a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -95,5 +95,6 @@ Library evidence, with the package fingerprint unchanged during each run: `020e5fbf004c167f74f3a149a8f40d84bb0f9a68424187db5f9f42d960194674`. Wasmtime executed that artifact with exit 42 and empty stdout and stderr. -This refactor does not establish whole-stdlib runtime completion. `Data.Number.sqrt` -remains blocked by unsupported target FFI. +This refactor does not establish whole-stdlib runtime completion. Number +square root has a separate checked `f64.sqrt` acceptance. Other Number foreign +slots, including `Data.Number.acos`, remain without target support. diff --git a/docs/implementation/stdlib/number-sqrt-2026-10-07.md b/docs/implementation/stdlib/number-sqrt-2026-10-07.md new file mode 100644 index 00000000..658f4bd1 --- /dev/null +++ b/docs/implementation/stdlib/number-sqrt-2026-10-07.md @@ -0,0 +1,83 @@ +# Number square-root acceptance + +## Contract and implementation + +Starting compiler revision: 0aab025 on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was +7cace2a6b4808b36b01559e88d3ebc351a3b7426 +(fnv1a64-v1:1fd8c04ec63c6ff0). A fresh Number.sqrt 4.0 diagnosis stopped at +P8 library linking because Data.Number.sqrt had no target implementation. + +The compiler now owns numberSqrt :: Number -> Number. Its HIR identity is +appended as 69, preserving existing intrinsic IDs. Core and CC require Number +operand and result types, MIR requires F64, and Wasm emits f64.sqrt. Incorrect +foreign binding schemes are rejected before ABI erasure. The operation does not +trap: a negative finite value or negative infinity becomes NaN, NaN stays NaN, +positive infinity stays positive infinity, and negative zero stays negative +zero. No additional runtime artifact, host binding, library-name recognition, +or constant folding is introduced. + +The independent library changes only the foreign slot's explicit binding: +`foreign import "psrs:intrinsic#numberSqrt" sqrt :: Number -> Number`. +Its signature, exports, and all official pure declarations remain unchanged. +The complete-module source verifier checks this transformation against pinned +purescript-numbers v9.0.1 (27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +## Package and runtime evidence + +Locked package: ef004e75998995ea8ac00840e36c1d9b71226b25 +(fnv1a64-v1:19dabd2d6d4033b4). + +```sh +node ../psrs-stdlib/conformance/number-sqrt.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-sqrt-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-sqrt-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-sqrt-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-number-sqrt-oracle/Main.purs -o /tmp/psrs-number-sqrt-locked.wasm +wasmtime run /tmp/psrs-number-sqrt-locked.wasm +``` + +The actual pinned official JS sqrt produces 155 input observations and 310 +checks, exercising direct public calls and higher-order calls. Inputs include +both zero signs, subnormals, minimum normal values, exact squares, magnitudes +beyond i32, maximal finite values, infinities, NaN, and 128 deterministically +generated binary64 patterns. Reciprocal observations distinguish zero signs. +Both the development-package run and the locked-package artifact +(sha256 1098509065918c064f27cbe5a6d75508a08b7de5d304a565c94796d680f73a0e) +return 42 with empty stdout and stderr. Wasmtime is 49.0.2. + +The same public sqrt 4.0 probe now passes against the locked package. A fresh +Number.acos 1.0 probe stops at P8 library linking because Data.Number.acos has +no target implementation. The package fingerprint changed, so the before and +after diagnoses are not a same-fingerprint compare. + +The complete source inventory records 230 modules across 41 packages: +170 identical, 36 modified and 24 target additions, no absent upstream modules +and no direct recursive foreign placeholders. This inventory does not approve +all existing adaptations. Node tooling: 11 passed, none skipped. + +## Rust validation + +Backend execution of f64.sqrt passes with optimization enabled and disabled, +checking that the square root of negative zero stays negative and that the +square root of 2^32 is 65536. Two driver regressions pass with mandatory +Wasmtime: public behavior, including a higher-order call, and rejection of +invalid foreign contracts. `cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. + +`PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` finishes all +52 targets: 1693 passed, 3 failed, 5 ignored. The only failing target is +`psrs-driver --lib`. Its three failures are the established baseline: +`constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number`, and +`compiles_if_expression_through_cfg_to_structured_wasm`. No new failure +appeared. Full workspace validation is not green because of those baseline +failures. + +## Remaining work + +This is square-root acceptance, not complete Number FFI or whole-standard-library +acceptance. No official scoreboard or gate measurement changes. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 07938947..3e36542a 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -272,3 +272,18 @@ signs. Cases include binary64 subnormals, nonfinite values, magnitudes beyond i32, and deterministic generated bit patterns. The compiler's checked numberAbs primitive selects f64.abs; the library retains its original public Number signature and pure declarations. + +For Number square root through the same public-call shape: + +```sh +node ../psrs-stdlib/conformance/number-sqrt.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-sqrt-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-sqrt-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-sqrt-runtime +``` + +The generator invokes the pinned official sqrt FFI. Negative zero stays +negative zero, and negative inputs produce NaN. The compiler's checked +numberSqrt primitive selects f64.sqrt. diff --git a/stdlib.lock.json b/stdlib.lock.json index 1083d565..bb8598ba 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "7cace2a6b4808b36b01559e88d3ebc351a3b7426", - "source_fingerprint": "fnv1a64-v1:1fd8c04ec63c6ff0" + "revision": "ef004e75998995ea8ac00840e36c1d9b71226b25", + "source_fingerprint": "fnv1a64-v1:19dabd2d6d4033b4" } From 450759c51af698e7f48e522a3bae4f371d6aafe8 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 7 Oct 2026 23:51:53 +0800 Subject: [PATCH 074/148] Support checked Number inverse cosine with public behavior evidence numberAcos calls the pinned libm export in the numeric runtime and keeps the official Data.Number.acos signature. Finite inputs in [-1, 1] match the pinned Math.acos results. The lock pins the library binding and its source verifier. --- Cargo.lock | 7 ++ crates/psrs-backend/src/abi/mod.rs | 5 +- .../psrs-backend/src/target_intrinsics/mod.rs | 1 + .../src/target_intrinsics/tests.rs | 1 + crates/psrs-backend/src/target_runtime/mod.rs | 7 ++ crates/psrs-core/src/verify/types/mod.rs | 3 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_acos.rs | 60 ++++++++++++ crates/psrs-driver/src/tests/show.rs | 2 +- crates/psrs-hir/src/intrinsic/effects.rs | 2 +- crates/psrs-hir/src/intrinsic/mod.rs | 8 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + crates/psrs-linker/src/verify/tests.rs | 10 +- crates/psrs-runtime/Cargo.toml | 3 +- .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 35910 -> 37421 bytes crates/psrs-runtime/src/acos.rs | 44 +++++++++ crates/psrs-runtime/src/catalog.rs | 13 ++- crates/psrs-runtime/src/lib.rs | 20 +++- .../backend/fp/scalars-and-primitives.md | 8 ++ .../intrinsic-implementations-2026-10-07.md | 6 +- .../stdlib/number-acos-2026-10-07.md | 89 ++++++++++++++++++ docs/workflow/stdlib-conformance.md | 16 ++++ stdlib.lock.json | 4 +- 23 files changed, 292 insertions(+), 19 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_acos.rs create mode 100644 crates/psrs-runtime/src/acos.rs create mode 100644 docs/implementation/stdlib/number-acos-2026-10-07.md diff --git a/Cargo.lock b/Cargo.lock index 8be7e674..10d3b2f9 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -237,6 +237,12 @@ version = "0.2.189" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "3eaf3ede3fee6db1a4c2ee091bf8a8b4dccdc6d17f656fb07896ee72867612f2" +[[package]] +name = "libm" +version = "0.2.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f9fbbcab51052fe104eb5e5d351cf728d30a5be1fe14d9be8a3b097481fb97de" + [[package]] name = "log" version = "0.4.34" @@ -424,6 +430,7 @@ dependencies = [ name = "psrs-runtime" version = "0.1.0" dependencies = [ + "libm", "ryu-js", "wasm-encoder", "wasmparser", diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index 37c86cef..0e3dadad 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -109,13 +109,16 @@ pub(crate) const NUMBER_TO_STRING_SYMBOL: SymbolId = pub(crate) const NUMBER_FROM_DECIMAL_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 6); -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 6] = [ +pub(crate) const NUMBER_ACOS_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 7); + +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 7] = [ REALLOC_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, VALIDATE_STEP_SYMBOL, NUMBER_TO_STRING_SYMBOL, NUMBER_FROM_DECIMAL_SYMBOL, + NUMBER_ACOS_SYMBOL, ]; /// WASI interfaces and functions the backend itself references. The standard diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 43d02f6c..c4c20b44 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -97,6 +97,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::UnsafeCoerce => Generated(GeneratedOperation::UnsafeCoerce), Intrinsic::NumberToString => Artifact(&target_runtime::NUMBER_FORMAT), Intrinsic::NumberFromDecimal => Artifact(&target_runtime::NUMBER_PARSE), + Intrinsic::NumberAcos => Artifact(&target_runtime::NUMBER_ACOS), Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 8513ecda..147df361 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -36,6 +36,7 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::IntAnd, 28), (Intrinsic::NumberAbs, 68), (Intrinsic::NumberSqrt, 69), + (Intrinsic::NumberAcos, 70), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index 3e7ed747..c6ade938 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -33,6 +33,13 @@ pub(crate) const NUMBER_PARSE: ArtifactImplementation = ArtifactImplementation { artifact: &psrs_runtime::NUMBER_RUNTIME, }; +pub(crate) const NUMBER_ACOS: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberAcos, + symbol: crate::abi::NUMBER_ACOS_SYMBOL, + abi: &psrs_runtime::NUMBER_ACOS, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + /// The registered implementation for a MIR import symbol, if any. pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementation> { crate::target_intrinsics::artifacts().find(|implementation| symbol == implementation.symbol) diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index d214fe8c..8f3080f4 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -79,7 +79,8 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T | Intrinsic::NumberFloor | Intrinsic::NumberCeil | Intrinsic::NumberAbs - | Intrinsic::NumberSqrt => (Number, Number), + | Intrinsic::NumberSqrt + | Intrinsic::NumberAcos => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index e50a60eb..3c9c192f 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -21,6 +21,7 @@ mod intrinsic_contracts; mod let_constraints; mod library_foreign; mod number_abs; +mod number_acos; mod number_decimal; mod number_rounding; mod number_sqrt; diff --git a/crates/psrs-driver/src/tests/number_acos.rs b/crates/psrs-driver/src/tests/number_acos.rs new file mode 100644 index 00000000..1226d5e7 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_acos.rs @@ -0,0 +1,60 @@ +use super::*; + +#[test] +fn public_number_acos_matches_domain_boundaries_and_rejects_exterior_values() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +apply f value = f value +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negative positiveInfinity +nan = 0.0 / 0.0 +checks = Number.acos 1.0 == 0.0 + && 1.0 / Number.acos 1.0 == positiveInfinity + && Number.acos (-1.0) == 3.141592653589793 + && Number.acos 0.0 == 1.5707963267948966 + && Number.acos (negative 0.0) == 1.5707963267948966 + && Number.acos 0.5 == 1.0471975511965979 + && Number.acos (-0.5) == 2.0943951023931957 + && Number.acos 2.0 /= Number.acos 2.0 + && Number.acos (-2.0) /= Number.acos (-2.0) + && Number.acos positiveInfinity /= Number.acos positiveInfinity + && Number.acos negativeInfinity /= Number.acos negativeInfinity + && Number.acos nan /= Number.acos nan + && apply Number.acos 1.0 == 0.0 +main :: Int +main = if checks then 42 else 1 +"#; + let artifact = compile_program_sources_with_prelude(&[("Main.purs", source)]) + .expect("inverse cosine should compile"); + assert!( + artifact + .wasm + .windows(b"number_acos".len()) + .any(|window| window == b"number_acos"), + "the numeric runtime export should be linked" + ); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_acos_requires_number_operand_and_result() { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberAcos\" angle :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("inverse cosine requires a checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index b4b8f7d1..1aabe6c2 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -121,7 +121,7 @@ main = let ignored = log (show 1.0e21) in 0 let digests = parameter("artifact_digests").expect("artifact digests are recorded"); assert!(digests.contains("psrs:runtime-number"), "{digests}"); assert!( - digests.contains("c6d50a6b005471bca9777562860cd8a3b2fc1ba5227126f755ee0d10297408de"), + digests.contains("092c1aca5a1270c0c792568da6c230ebdd25fcf536e64f17729315db75e3c683"), "{digests}" ); assert!( diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 7791a46d..bbc95f40 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -28,7 +28,7 @@ impl IntrinsicEffects { | NumberMul | NumberDiv | NumberEq | NumberNe | NumberLt | NumberLe | NumberGt | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor - | NumberCeil | NumberAbs | NumberSqrt => Self::default(), + | NumberCeil | NumberAbs | NumberSqrt | NumberAcos => Self::default(), } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 4c1f25e2..92f5fb71 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -115,6 +115,9 @@ pub enum Intrinsic { /// IEEE-754 square root. Negative finite inputs and NaN produce NaN. /// Negative zero remains negative zero. The operation does not trap. NumberSqrt = 69, + /// Inverse cosine in radians. Finite inputs outside [-1, 1], infinities, + /// and NaN produce NaN. The operation does not trap. + NumberAcos = 70, } impl Intrinsic { @@ -140,7 +143,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 68] = [ + pub const ALL: [Intrinsic; 69] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -209,6 +212,7 @@ impl Intrinsic { Intrinsic::NumberFromDecimal, Intrinsic::NumberAbs, Intrinsic::NumberSqrt, + Intrinsic::NumberAcos, ]; } @@ -218,7 +222,7 @@ impl Intrinsic { const _: () = { assert!( Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberSqrt as u32 as usize + 1, + == Intrinsic::NumberAcos as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 44157bf3..74935052 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -110,6 +110,7 @@ descriptors! { NumberFloor => "numberFloor", 1, Unary, scheme::number_number; NumberAbs => "numberAbs", 1, Unary, scheme::number_number; NumberSqrt => "numberSqrt", 1, Unary, scheme::number_number; + NumberAcos => "numberAcos", 1, Unary, scheme::number_number; NumberCeil => "numberCeil", 1, Unary, scheme::number_number; BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, Unary, scheme::int_number; diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index 98aad046..db8f9c46 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -12,7 +12,7 @@ fn number_format_contract() -> ArtifactContract { elements: vec![crate::DeclaredElement { table: 0, offset: 1, - functions: vec![19], + functions: vec![22], }], id: "psrs:runtime-number".into(), kind: ArtifactKind::CoreModule, @@ -55,6 +55,14 @@ fn number_format_contract() -> ArtifactContract { result: Some(CoreType::F64), }), }, + DeclaredExport { + name: psrs_runtime::ACOS_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, ], tables: vec![DeclaredTable { element: "funcref".into(), diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml index d0cb79c9..76225027 100644 --- a/crates/psrs-runtime/Cargo.toml +++ b/crates/psrs-runtime/Cargo.toml @@ -14,10 +14,11 @@ default = ["catalog", "formatter"] catalog = [] # The executable numeric exports. The Wasm artifact build enables only this # feature; the default native build enables both. -formatter = ["dep:ryu-js"] +formatter = ["dep:ryu-js", "dep:libm"] [dependencies] ryu-js = { version = "=1.0.2", default-features = false, optional = true } +libm = { version = "=0.2.15", optional = true } [dev-dependencies] wasm-encoder = { workspace = true, features = ["wasmparser"] } diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index 3bdb9f27f144a0199ccb81b07c2e69986f415839..6b1287fa5ad054e4e02791401d9a06f20c0f4148 100755 GIT binary patch delta 2356 zcmbsqZFCgX_1!l!JG(pC>?DMclH~Nw1Pw_frfp8~SlTedDvH*EHCm4KBvFE7BjyuM zDNAM{Ap`_N82mt?ZZ>FIbUn%ns1TAUAoxMCQY&qm#v-kSDzUZ|4u_`q&1OM=wd$L* z_uY5zefQn(J@hDzZKoQkYFZ405cpYoCABQDDh12gz#^3pf>2jZla-r81yORzZsHLH zui{Pd%Caw&_=(r+RntTX>VZ<1pITsq!zqeIoK3!7RPJB0`0nb)imH3+ng~o7KP_ym zTU@cA`ktD_Rre99j#HcKDw>)bYwo|72uel8qUx&pio2_tss-?LU6lQq-oXVq0wIcv zFrs?x6ljBQ*j><`;nJwWs9(W1MWfXCpjA{AyNH%#PG&A+gajEB2yWeD66Q9EI@xZZ zg^+D;rCJ&n7)620yrVR)D4U7QRUokG0zv*ULKDF9a>3MO*TSQBteJ6hde6kC8r|nx!4Rx?rrV590489~u@Q5e#h5$R!f!B-L1s7WNRVSXbx5_kJH`QwVGNmC5q+8G!u$P~%iR{ODwq+ zLop@?4Okj8OWWIY+HaENV{V3KhfE0RbZ$1IOj(`eU<_N^`Xic{0tzD0m<{C?Y^2m+}H#!F}tvh_l{EwC~(mkH>19uN?-?t@;ggs)NXpJgco21*L5D2# zN&Nbr@X&BYU)m9iCkhjSHI&Q%W`iawZXg`O2J3CS?ozc8r?|R%Fky*26Ec3!gZ*Y& z<=K7(OFNB=0gea*8W~lw!v+MA4>`e-_;_Qrx_~`E%rQHbVq|WXf&~IjR_q+QOn0~Q zsf`m`^s)5QV$k@oaGdRsPUEN0^y49VW(a$r==4$X0W65f$3C2mWqJ)Hj}WZ7*~tMt7Rb4N9I3eI7HxiB7buOT!WBPYZ}05B$U z!712le^l^oNU>RA9>PH39GGNx7T%gVBx(}g+Y)9kZ_HD4sD_QImMkY?{G$^$k2 zhoU-gr#a$kdi>UDQ$gtiApGxC8R(0zF7CR@n)kx!&WE25Ja_)t-LYlQ%z8Rw$C+Oq z?%na!rYFPOn|f-ai@Jl6`X`qEV%@fFTX#MF_G6=4CTzL((dtL+hYvh-Zga`zTKiX< zPInb|E!nug)7v@!!5tg^v;MaA&paSMuwdPRwO6cN+wt+5+t&=V7qxF$?OwgC?eDEs zt?#XxyXwfw>sG!Jo@s^YSn96uHSQP Q_oUsla#uX_&XRBa7o>gEpa1{> delta 822 zcmY*XO=uHA6rMLbyPMs~&*s0;MkZVT+B7D%imeBAOAjIxL=nXbNvf%K+q5OA0lg$t z=uM^0MG(AL@uVPoD)pd(y(uC^Ayg2oSS?6z9;DzTDToYw@9}-#{Jb~s=>lH9kK0kc zTm*y=l>IqetwJ>?Rht2-Xg*P{?ucQD$clVZnQG_U9!_NZi#J1MEw&f=6!~@F!I$sMOQ*}fc zVZeU|Q~Yj-3U(yaC-6aNNZ^mqZvQGViA5_38J}Q~hIgxcSNJ@9=9TaO`A!Tse-SQ| zdL!wLyl*Cs8Z~gJL5ag<2DVjGtd*uE89Upu%*I{;_?^L>L4W|i(7qsWtNjQBoWt=~ z1nT^EA}%m&o)b83cE;=EsQArB;bMt8Ezv&7wsa(L3MmY~?Zs F{{jnczlQ(- diff --git a/crates/psrs-runtime/src/acos.rs b/crates/psrs-runtime/src/acos.rs new file mode 100644 index 00000000..58a4ff0f --- /dev/null +++ b/crates/psrs-runtime/src/acos.rs @@ -0,0 +1,44 @@ +//! Inverse cosine of one binary64 value. +//! +//! The pinned `libm` 0.2.15 routine is the fdlibm polynomial. On finite inputs +//! in the closed interval [-1, 1] it matches the official JavaScript +//! `Math.acos` results used by purescript-numbers. Inputs outside that +//! interval, infinities, and NaN produce NaN. The operation does not trap. +//! NaN payloads are not part of the public contract. + +/// Returns the inverse cosine in radians. +fn acos(value: f64) -> f64 { + libm::acos(value) +} + +/// C ABI export of [`acos`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_acos(value: f64) -> f64 { + acos(value) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn matches_domain_boundaries_and_rejects_values_outside_the_interval() { + for (input, bits) in [ + (1.0, 0), + (-1.0, 0x400921fb54442d18), + (0.0, 0x3ff921fb54442d18), + (-0.0, 0x3ff921fb54442d18), + (0.5, 0x3ff0c152382d7366), + (-0.5, 0x4000c152382d7366), + ] { + assert_eq!(acos(input).to_bits(), bits, "{input}"); + } + for input in [2.0, -2.0, f64::INFINITY, f64::NEG_INFINITY, f64::NAN] { + assert!(acos(input).is_nan(), "{input}"); + } + } +} diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index 64959a8a..b143a862 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -158,14 +158,14 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { module_name: crate::MODULE_NAME, bytes: include_bytes!("../artifact/psrs_runtime.wasm"), provenance: ArtifactProvenance { - dependency: "ryu-js and Rust core::num::dec2flt", - dependency_revision: "ryu-js 1.0.2; Rust 1.99.0", + dependency: "ryu-js, libm, and Rust core::num::dec2flt", + dependency_revision: "ryu-js 1.0.2; libm 0.2.15; Rust 1.99.0", rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", target: "wasm32-unknown-unknown", profile: "target-runtime", recipe: "tools/build.sh: --import-memory --global-base=65536 \ -zstack-size=65536 --export=__heap_base, then package", - sha256: "c6d50a6b005471bca9777562860cd8a3b2fc1ba5227126f755ee0d10297408de", + sha256: "092c1aca5a1270c0c792568da6c230ebdd25fcf536e64f17729315db75e3c683", }, required_features: &[ "mutable-globals", @@ -190,6 +190,11 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { parameters: &[RawType::I32, RawType::I32], result: Some(RawType::F64), }, + RawExport { + name: crate::ACOS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, ], global_exports: &[crate::HEAP_BASE_EXPORT], tables: &[RawTable { @@ -200,7 +205,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { elements: &[RawElement { table: 0, offset: 1, - functions: &[19], + functions: &[22], }], globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], storage: RawStorage { diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 07e7c641..9da499f6 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -6,9 +6,10 @@ //! metadata: pinned WIT source bytes, the default command-world identity, and //! the compiler-owned formatter artifact with its provenance and storage //! contract. It links no executable target code. -//! - Feature `formatter` compiles the numeric formatting and complete-decimal -//! conversion exports, built for `wasm32-unknown-unknown` and embedded as the -//! pinned artifact. It embeds neither WIT text nor the catalog. +//! - Feature `formatter` compiles the numeric formatting, complete-decimal +//! conversion, and inverse-cosine exports, built for `wasm32-unknown-unknown` +//! and embedded as the pinned artifact. It embeds neither WIT text nor the +//! catalog. //! //! The compiler depends on this crate with `default-features = false, //! features = ["catalog"]`; the Wasm artifact build uses @@ -21,11 +22,15 @@ pub mod catalog; #[cfg(feature = "catalog")] pub use catalog::*; +#[cfg(feature = "formatter")] +mod acos; #[cfg(feature = "formatter")] mod decimal; #[cfg(feature = "formatter")] mod formatter; #[cfg(feature = "formatter")] +pub use acos::number_acos; +#[cfg(feature = "formatter")] pub use decimal::number_from_decimal; #[cfg(feature = "formatter")] pub use formatter::number_to_string; @@ -38,6 +43,8 @@ pub const MODULE_NAME: &str = "psrs:runtime"; pub const NUMBER_EXPORT: &str = "number_to_string"; /// Exported raw complete-decimal conversion function. pub const DECIMAL_EXPORT: &str = "number_from_decimal"; +/// Exported raw inverse-cosine function. +pub const ACOS_EXPORT: &str = "number_acos"; /// Lower addresses remain owned by the application's canonical ABI. pub const RESERVED_START: u32 = 65536; /// Static data must end before the separately reserved 64 KiB stack. @@ -94,3 +101,10 @@ pub const NUMBER_PARSE: RawFunctionAbi = RawFunctionAbi { result: Some(RawType::F64), protocol: RawCallProtocol::Utf8Input, }; + +pub const NUMBER_ACOS: RawFunctionAbi = RawFunctionAbi { + export: ACOS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index 562a0f2d..c7ce0c60 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -205,6 +205,14 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. not trap. It implements the official Data.Number.sqrt foreign slot and is not folded when its operand is constant. See the [WebAssembly square-root semantics](https://webassembly.github.io/spec/core/exec/numerics.html#op-fsqrt). +- `NumberAcos` (`numberAcos :: Number -> Number`) has no Wasm opcode. Core and + CC require Number operands and results, then MIR calls the checked scalar + export `number_acos` in the numeric runtime. The pinned libm 0.2.15 fdlibm + polynomial returns radians. Finite inputs outside [-1, 1], infinities, and + NaN produce NaN, and the operation does not trap. NaN payloads are not a + public guarantee. It implements the official Data.Number.acos foreign slot. + A whole inverse-cosine algorithm does not become a compiler intrinsic, and + the result is not folded when its operand is constant. - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. - The current vocabulary has no `Number` remainder. If the standard library diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md index 9df75e86..c59def0d 100644 --- a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -96,5 +96,7 @@ Library evidence, with the package fingerprint unchanged during each run: executed that artifact with exit 42 and empty stdout and stderr. This refactor does not establish whole-stdlib runtime completion. Number -square root has a separate checked `f64.sqrt` acceptance. Other Number foreign -slots, including `Data.Number.acos`, remain without target support. +square root has a separate checked `f64.sqrt` acceptance, and Number inverse +cosine has a separate checked scalar-runtime acceptance. Other Number foreign +slots, including `Data.Number.asin`, remain without target support until a +fresh diagnosis names the next blocker. diff --git a/docs/implementation/stdlib/number-acos-2026-10-07.md b/docs/implementation/stdlib/number-acos-2026-10-07.md new file mode 100644 index 00000000..877e36b9 --- /dev/null +++ b/docs/implementation/stdlib/number-acos-2026-10-07.md @@ -0,0 +1,89 @@ +# Number inverse-cosine acceptance + +## Contract and implementation + +Starting compiler revision: b300392 on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was +ef004e75998995ea8ac00840e36c1d9b71226b25 +(fnv1a64-v1:19dabd2d6d4033b4). A fresh Number.acos 1.0 diagnosis stopped at +P8 library linking because Data.Number.acos had no target implementation. + +Wasm has no inverse-cosine instruction, so this is not an `f64.sqrt`-style +opcode. The compiler owns numberAcos :: Number -> Number. Its HIR identity is +appended as 70, preserving existing intrinsic IDs. Core and CC require Number +operand and result types. MIR calls the scalar export `number_acos` in the +shared numeric runtime. Incorrect foreign binding schemes are rejected before +ABI erasure. + +The export is pinned libm 0.2.15, the fdlibm polynomial. Finite inputs in the +closed interval [-1, 1] match the official JavaScript Math.acos results used +by purescript-numbers. Finite inputs outside that interval, infinities, and +NaN produce NaN. The operation does not trap. NaN payloads are not part of the +public contract. No constant folding is introduced. A whole inverse-cosine +algorithm does not become a compiler intrinsic. + +The numeric runtime retains number_to_string and number_from_decimal and adds +number_acos. Its reproducible artifact SHA-256 is +092c1aca5a1270c0c792568da6c230ebdd25fcf536e64f17729315db75e3c683. +The private table still has two funcref slots. The active initializer now +points at function 22. Static stack analysis accepts the artifact and still +measures 1680 bytes inside the existing 65536-byte reserve. + +The independent library changes only the foreign slot's explicit binding: +`foreign import "psrs:intrinsic#numberAcos" acos :: Number -> Number`. +Its signature, exports, and all official pure declarations remain unchanged. +The complete-module source verifier checks this transformation against pinned +purescript-numbers v9.0.1 (27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +## Package and runtime evidence + +Locked package: e05d4f765c949d50832b7d01b5cf992b5efc903e +(fnv1a64-v1:eccd4891551858bb). + +```sh +node ../psrs-stdlib/conformance/number-acos.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-acos-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-acos-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-acos-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-number-acos-oracle/Main.purs -o /tmp/psrs-number-acos-locked.wasm +wasmtime run /tmp/psrs-number-acos-locked.wasm +``` + +The actual pinned official JS acos produces 149 input observations and 298 +checks, exercising direct public calls and higher-order calls. Inputs include +both zero signs, the closed interval endpoints, values one ulp outside that +interval, subnormals, nonfinite values, and 128 deterministically generated +binary64 patterns. A zero result is distinguished by its reciprocal. NaN +checks do not require a payload. Both the development-package run and the +locked-package artifact +(sha256 2b2ba1dd721be0b84db2b7a8eeb5385c974ea701fbd2cdb4a4fa656b5e02abb2) +return 42 with empty stdout and stderr. Wasmtime is 49.0.2. + +The same public acos 1.0 probe now passes against the locked package, in +8522 ms. A fresh Number.asin 0.0 probe stops at P8 library linking because +Data.Number.asin has no target implementation. The package fingerprint +changed, so the before and after diagnoses are not a same-fingerprint compare. + +Node tooling: 11 passed, none skipped. The numeric runtime rebuild is +byte-for-byte reproducible. + +## Rust validation + +Two driver regressions pass with mandatory Wasmtime: public behavior, +including a higher-order call and the linked `number_acos` export, and +rejection of invalid foreign contracts. The runtime unit test checks the +fdlibm boundary bit patterns. `cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. + +`PSRS_REQUIRE_WASMTIME=1 CARGO_INCREMENTAL=0 cargo test --workspace --offline --no-fail-fast` +finishes all 52 targets: 1696 passed, 3 failed, 5 ignored. The only failing +target is `psrs-driver --lib`. Its three failures are the established +baseline: `constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number`, and +`compiles_if_expression_through_cfg_to_structured_wasm`. No new failure +appeared. Full workspace validation is not green because of those baseline +failures. This change does not establish complete Number FFI support or +whole-standard-library runtime behavior. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 3e36542a..3ded47f2 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -287,3 +287,19 @@ node ../psrs-stdlib/tools/conformance.mjs run \ The generator invokes the pinned official sqrt FFI. Negative zero stays negative zero, and negative inputs produce NaN. The compiler's checked numberSqrt primitive selects f64.sqrt. + +For Number inverse cosine through the same public-call shape: + +```sh +node ../psrs-stdlib/conformance/number-acos.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-acos-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-acos-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-acos-runtime +``` + +The generator invokes the pinned official acos FFI. Finite inputs in [-1, 1] +match that FFI. Values outside the interval produce NaN. The compiler's +checked numberAcos primitive calls the scalar numeric-runtime export. Wasm +has no inverse-cosine instruction. diff --git a/stdlib.lock.json b/stdlib.lock.json index bb8598ba..204637bc 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "ef004e75998995ea8ac00840e36c1d9b71226b25", - "source_fingerprint": "fnv1a64-v1:19dabd2d6d4033b4" + "revision": "e05d4f765c949d50832b7d01b5cf992b5efc903e", + "source_fingerprint": "fnv1a64-v1:eccd4891551858bb" } From 957b1334a3774a96366d8b95f388e3f0ebbe6c8a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Thu, 8 Oct 2026 00:24:43 +0800 Subject: [PATCH 075/148] Support checked Number inverse sine with public behavior evidence numberAsin calls the pinned libm export in the numeric runtime and keeps the official Data.Number.asin signature. Negative zero stays negative zero. The lock pins the library binding and its source verifier. --- crates/psrs-backend/src/abi/mod.rs | 5 +- .../psrs-backend/src/target_intrinsics/mod.rs | 1 + .../src/target_intrinsics/tests.rs | 1 + crates/psrs-backend/src/target_runtime/mod.rs | 7 ++ crates/psrs-core/src/verify/types/mod.rs | 3 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_asin.rs | 60 ++++++++++++ crates/psrs-driver/src/tests/show.rs | 2 +- crates/psrs-hir/src/intrinsic/effects.rs | 2 +- crates/psrs-hir/src/intrinsic/mod.rs | 9 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + crates/psrs-linker/src/verify/tests.rs | 10 +- .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 37421 -> 38042 bytes crates/psrs-runtime/src/asin.rs | 44 +++++++++ crates/psrs-runtime/src/catalog.rs | 9 +- crates/psrs-runtime/src/lib.rs | 15 ++- .../backend/fp/scalars-and-primitives.md | 6 ++ .../intrinsic-implementations-2026-10-07.md | 6 +- .../stdlib/number-asin-2026-10-08.md | 89 ++++++++++++++++++ docs/workflow/stdlib-conformance.md | 16 ++++ stdlib.lock.json | 4 +- 21 files changed, 276 insertions(+), 15 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_asin.rs create mode 100644 crates/psrs-runtime/src/asin.rs create mode 100644 docs/implementation/stdlib/number-asin-2026-10-08.md diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index 0e3dadad..e29c20c4 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -111,7 +111,9 @@ pub(crate) const NUMBER_FROM_DECIMAL_SYMBOL: SymbolId = pub(crate) const NUMBER_ACOS_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 7); -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 7] = [ +pub(crate) const NUMBER_ASIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 8); + +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 8] = [ REALLOC_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, @@ -119,6 +121,7 @@ pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 7] = [ NUMBER_TO_STRING_SYMBOL, NUMBER_FROM_DECIMAL_SYMBOL, NUMBER_ACOS_SYMBOL, + NUMBER_ASIN_SYMBOL, ]; /// WASI interfaces and functions the backend itself references. The standard diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index c4c20b44..b9f296d1 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -98,6 +98,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::NumberToString => Artifact(&target_runtime::NUMBER_FORMAT), Intrinsic::NumberFromDecimal => Artifact(&target_runtime::NUMBER_PARSE), Intrinsic::NumberAcos => Artifact(&target_runtime::NUMBER_ACOS), + Intrinsic::NumberAsin => Artifact(&target_runtime::NUMBER_ASIN), Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 147df361..6a6ace98 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -37,6 +37,7 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::NumberAbs, 68), (Intrinsic::NumberSqrt, 69), (Intrinsic::NumberAcos, 70), + (Intrinsic::NumberAsin, 71), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index c6ade938..4c36eb2c 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -40,6 +40,13 @@ pub(crate) const NUMBER_ACOS: ArtifactImplementation = ArtifactImplementation { artifact: &psrs_runtime::NUMBER_RUNTIME, }; +pub(crate) const NUMBER_ASIN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberAsin, + symbol: crate::abi::NUMBER_ASIN_SYMBOL, + abi: &psrs_runtime::NUMBER_ASIN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + /// The registered implementation for a MIR import symbol, if any. pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementation> { crate::target_intrinsics::artifacts().find(|implementation| symbol == implementation.symbol) diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 8f3080f4..0f1ffdfe 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -80,7 +80,8 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T | Intrinsic::NumberCeil | Intrinsic::NumberAbs | Intrinsic::NumberSqrt - | Intrinsic::NumberAcos => (Number, Number), + | Intrinsic::NumberAcos + | Intrinsic::NumberAsin => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 3c9c192f..8de7a09d 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -22,6 +22,7 @@ mod let_constraints; mod library_foreign; mod number_abs; mod number_acos; +mod number_asin; mod number_decimal; mod number_rounding; mod number_sqrt; diff --git a/crates/psrs-driver/src/tests/number_asin.rs b/crates/psrs-driver/src/tests/number_asin.rs new file mode 100644 index 00000000..ec9c8583 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_asin.rs @@ -0,0 +1,60 @@ +use super::*; + +#[test] +fn public_number_asin_matches_domain_boundaries_zero_signs_and_exterior_values() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +apply f value = f value +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negative positiveInfinity +nan = 0.0 / 0.0 +checks = Number.asin 0.0 == 0.0 + && 1.0 / Number.asin 0.0 == positiveInfinity + && 1.0 / Number.asin (negative 0.0) == negativeInfinity + && Number.asin 1.0 == 1.5707963267948966 + && Number.asin (-1.0) == negative 1.5707963267948966 + && Number.asin 0.5 == 0.5235987755982989 + && Number.asin (-0.5) == negative 0.5235987755982989 + && Number.asin 2.0 /= Number.asin 2.0 + && Number.asin (-2.0) /= Number.asin (-2.0) + && Number.asin positiveInfinity /= Number.asin positiveInfinity + && Number.asin negativeInfinity /= Number.asin negativeInfinity + && Number.asin nan /= Number.asin nan + && apply Number.asin 0.0 == 0.0 +main :: Int +main = if checks then 42 else 1 +"#; + let artifact = compile_program_sources_with_prelude(&[("Main.purs", source)]) + .expect("inverse sine should compile"); + assert!( + artifact + .wasm + .windows(b"number_asin".len()) + .any(|window| window == b"number_asin"), + "the numeric runtime export should be linked" + ); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_asin_requires_number_operand_and_result() { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberAsin\" angle :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("inverse sine requires a checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index 1aabe6c2..c23cd18c 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -121,7 +121,7 @@ main = let ignored = log (show 1.0e21) in 0 let digests = parameter("artifact_digests").expect("artifact digests are recorded"); assert!(digests.contains("psrs:runtime-number"), "{digests}"); assert!( - digests.contains("092c1aca5a1270c0c792568da6c230ebdd25fcf536e64f17729315db75e3c683"), + digests.contains("7e697803a15ed67e812051d78036e50a1213401296e48895d6cb7dceb27f36f7"), "{digests}" ); assert!( diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index bbc95f40..4c98a16a 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -28,7 +28,7 @@ impl IntrinsicEffects { | NumberMul | NumberDiv | NumberEq | NumberNe | NumberLt | NumberLe | NumberGt | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor - | NumberCeil | NumberAbs | NumberSqrt | NumberAcos => Self::default(), + | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin => Self::default(), } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 92f5fb71..0542a4d1 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -118,6 +118,10 @@ pub enum Intrinsic { /// Inverse cosine in radians. Finite inputs outside [-1, 1], infinities, /// and NaN produce NaN. The operation does not trap. NumberAcos = 70, + /// Inverse sine in radians. Finite inputs outside [-1, 1], infinities, + /// and NaN produce NaN. Negative zero remains negative zero. The operation + /// does not trap. + NumberAsin = 71, } impl Intrinsic { @@ -143,7 +147,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 69] = [ + pub const ALL: [Intrinsic; 70] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -213,6 +217,7 @@ impl Intrinsic { Intrinsic::NumberAbs, Intrinsic::NumberSqrt, Intrinsic::NumberAcos, + Intrinsic::NumberAsin, ]; } @@ -222,7 +227,7 @@ impl Intrinsic { const _: () = { assert!( Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberAcos as u32 as usize + 1, + == Intrinsic::NumberAsin as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 74935052..19d30226 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -111,6 +111,7 @@ descriptors! { NumberAbs => "numberAbs", 1, Unary, scheme::number_number; NumberSqrt => "numberSqrt", 1, Unary, scheme::number_number; NumberAcos => "numberAcos", 1, Unary, scheme::number_number; + NumberAsin => "numberAsin", 1, Unary, scheme::number_number; NumberCeil => "numberCeil", 1, Unary, scheme::number_number; BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, Unary, scheme::int_number; diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index db8f9c46..facef381 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -12,7 +12,7 @@ fn number_format_contract() -> ArtifactContract { elements: vec![crate::DeclaredElement { table: 0, offset: 1, - functions: vec![22], + functions: vec![24], }], id: "psrs:runtime-number".into(), kind: ArtifactKind::CoreModule, @@ -63,6 +63,14 @@ fn number_format_contract() -> ArtifactContract { result: Some(CoreType::F64), }), }, + DeclaredExport { + name: psrs_runtime::ASIN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, ], tables: vec![DeclaredTable { element: "funcref".into(), diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index 6b1287fa5ad054e4e02791401d9a06f20c0f4148..64b8bf0f9189f40388354cb18fa575469f9c1e2e 100755 GIT binary patch delta 928 zcmYLGZA%nU6u#%)nVsF8eVK80)y>_!yV9#IYcHlkq$B&G7la~-pkUIn+AUpElPJkW zK`7`&ZUh{>xVLCvSYh=Te7CVh$siXelC=u1S|+0|?=oICeE=Q+=F&V6v3PTZr{ zu6wIjQpP0Np*V?)jZbYDZkN@bGu@qCeP+jzY(IhJQ-8XL(7+OQtS{Sb9_>1k?(R56 zn6`8~kTv@U`qDkeiKLq5iLQ=bv$LbWi-Ai4Vt@*j?#c8@Mu_SloM`Ie=254C%EK^J zLkvyS!&#^j4`D2*#Hh-tUo~<$$=G6i9F;V$*g@;cBiv!UCm9awm^1EbCEVFcw1~Ju z*F#i1p)tLf@C_6GV_#?uVty7bVL4dDNQu|PRzuW2%sv3fA|+o2*`Ae;Ng*efGBL#? zshn}(jto~anoG2~8^I;U+=CS^4=h3of^j7i_Zm>l2&lE-w3}5Ez+q2$wn8Yv!O%*6 z*Tz-!OG~=*-YSUL4&P}2w>azH>2Sv-E^#sMyJYXx!r+>d7+ip1HY6-xb(FRg7pFLm z+ydL_B`H$+zBO}lQ@r!t7>+R)vNW-dK#MPjaZ^jTcy zvXxIMhk~0|-yPq^3CD{<9;Ib#I*t!x<*{S5Vioe%asewwJjM4w`Ib!4!*}#Rkz85@ zv@XWAiw%}vU84L%&0?K`RjT<KrRI7YEmbcn zfB^#r^l_^B#W}qfBI1j_5yuxTdj;SZ9|PMJKbDm^i1|Q5Tn(yt+Zk-ccq`b3@pEt% zbTJbe#JIWqHR!fd5umz`B$)$t7!yQ;5P9{ds+1ErRfKMpN8jQ8cT@V(7NfQF% iO>z**L|fe+{GY6=fin9=T^5`H&J3Q>f_BrUALd_I2H$f4 delta 625 zcmXYsJ!q3b7{~8_?`Lvp-it|^H0j4R#gDW?o3_|a;#)yb5b9Edf-h;C+P>JPCb14K zLB*jUR?eXaf=VkWILLv6TZf8H7IkoNs~}D~IE&Y`%kQ4&e$R9K@9|6edXug{VqKlo zFfH40N#xC@`IawsIn#M^1IcuLBYJz&me83Z{-N z;jO6!-T|J_iS;HLK5ByUHu*ETqW^w5RnmKFsrNveywrYLbG^k+?c=(3GZ!_dGN0ke zVs=&YY4!^|)#ymlgh!aL1VX=Q`(MAC+>;ymDJ_5Jw}F&;)0G6$a;JM!Gwc~dT0QT% zWg)4$kG`UatB=S3K_4HAix%Q?cyJ3@`EBsF&NDrf1!A&M>eJjPT|h?el>#K>+2K`i d`EGbp*KDK@Tn&y?;U f64 { + libm::asin(value) +} + +/// C ABI export of [`asin`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_asin(value: f64) -> f64 { + asin(value) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn matches_domain_boundaries_and_rejects_values_outside_the_interval() { + for (input, bits) in [ + (0.0, 0), + (-0.0, 0x8000000000000000), + (1.0, 0x3ff921fb54442d18), + (-1.0, 0xbff921fb54442d18), + (0.5, 0x3fe0c152382d7366), + (-0.5, 0xbfe0c152382d7366), + ] { + assert_eq!(asin(input).to_bits(), bits, "{input}"); + } + for input in [2.0, -2.0, f64::INFINITY, f64::NEG_INFINITY, f64::NAN] { + assert!(asin(input).is_nan(), "{input}"); + } + } +} diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index b143a862..c1a4af4d 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -165,7 +165,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { profile: "target-runtime", recipe: "tools/build.sh: --import-memory --global-base=65536 \ -zstack-size=65536 --export=__heap_base, then package", - sha256: "092c1aca5a1270c0c792568da6c230ebdd25fcf536e64f17729315db75e3c683", + sha256: "7e697803a15ed67e812051d78036e50a1213401296e48895d6cb7dceb27f36f7", }, required_features: &[ "mutable-globals", @@ -195,6 +195,11 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { parameters: &[RawType::F64], result: Some(RawType::F64), }, + RawExport { + name: crate::ASIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, ], global_exports: &[crate::HEAP_BASE_EXPORT], tables: &[RawTable { @@ -205,7 +210,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { elements: &[RawElement { table: 0, offset: 1, - functions: &[22], + functions: &[24], }], globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], storage: RawStorage { diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 9da499f6..c774ee13 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -7,7 +7,7 @@ //! the compiler-owned formatter artifact with its provenance and storage //! contract. It links no executable target code. //! - Feature `formatter` compiles the numeric formatting, complete-decimal -//! conversion, and inverse-cosine exports, built for `wasm32-unknown-unknown` +//! conversion, and inverse trigonometric exports, built for `wasm32-unknown-unknown` //! and embedded as the pinned artifact. It embeds neither WIT text nor the //! catalog. //! @@ -25,12 +25,16 @@ pub use catalog::*; #[cfg(feature = "formatter")] mod acos; #[cfg(feature = "formatter")] +mod asin; +#[cfg(feature = "formatter")] mod decimal; #[cfg(feature = "formatter")] mod formatter; #[cfg(feature = "formatter")] pub use acos::number_acos; #[cfg(feature = "formatter")] +pub use asin::number_asin; +#[cfg(feature = "formatter")] pub use decimal::number_from_decimal; #[cfg(feature = "formatter")] pub use formatter::number_to_string; @@ -45,6 +49,8 @@ pub const NUMBER_EXPORT: &str = "number_to_string"; pub const DECIMAL_EXPORT: &str = "number_from_decimal"; /// Exported raw inverse-cosine function. pub const ACOS_EXPORT: &str = "number_acos"; +/// Exported raw inverse-sine function. +pub const ASIN_EXPORT: &str = "number_asin"; /// Lower addresses remain owned by the application's canonical ABI. pub const RESERVED_START: u32 = 65536; /// Static data must end before the separately reserved 64 KiB stack. @@ -108,3 +114,10 @@ pub const NUMBER_ACOS: RawFunctionAbi = RawFunctionAbi { result: Some(RawType::F64), protocol: RawCallProtocol::Scalars, }; + +pub const NUMBER_ASIN: RawFunctionAbi = RawFunctionAbi { + export: ASIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index c7ce0c60..db33e71d 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -213,6 +213,12 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. public guarantee. It implements the official Data.Number.acos foreign slot. A whole inverse-cosine algorithm does not become a compiler intrinsic, and the result is not folded when its operand is constant. +- `NumberAsin` (`numberAsin :: Number -> Number`) uses the same checked + scalar-runtime boundary. The pinned libm 0.2.15 fdlibm polynomial returns + radians and preserves the sign of zero. Finite inputs outside [-1, 1], + infinities, and NaN produce NaN, and the operation does not trap. NaN + payloads are not a public guarantee. It implements the official + Data.Number.asin foreign slot and is not folded when its operand is constant. - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. - The current vocabulary has no `Number` remainder. If the standard library diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md index c59def0d..09a4e86a 100644 --- a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -96,7 +96,7 @@ Library evidence, with the package fingerprint unchanged during each run: executed that artifact with exit 42 and empty stdout and stderr. This refactor does not establish whole-stdlib runtime completion. Number -square root has a separate checked `f64.sqrt` acceptance, and Number inverse -cosine has a separate checked scalar-runtime acceptance. Other Number foreign -slots, including `Data.Number.asin`, remain without target support until a +square root has a separate checked `f64.sqrt` acceptance. Number inverse +cosine and inverse sine each have a separate checked scalar-runtime +acceptance. Other Number foreign slots remain without target support until a fresh diagnosis names the next blocker. diff --git a/docs/implementation/stdlib/number-asin-2026-10-08.md b/docs/implementation/stdlib/number-asin-2026-10-08.md new file mode 100644 index 00000000..1e55bc4e --- /dev/null +++ b/docs/implementation/stdlib/number-asin-2026-10-08.md @@ -0,0 +1,89 @@ +# Number inverse-sine acceptance + +## Contract and implementation + +Starting compiler revision: 450759c on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was +e05d4f765c949d50832b7d01b5cf992b5efc903e +(fnv1a64-v1:eccd4891551858bb). A fresh Number.asin 0.0 diagnosis stopped at +P8 library linking because Data.Number.asin had no target implementation. + +Wasm has no inverse-sine instruction. The compiler owns +numberAsin :: Number -> Number. Its HIR identity is appended as 71, preserving +existing intrinsic IDs. Core and CC require Number operand and result types. +MIR calls the scalar export `number_asin` in the shared numeric runtime. +Incorrect foreign binding schemes are rejected before ABI erasure. + +The export is pinned libm 0.2.15, the fdlibm polynomial. Finite inputs in the +closed interval [-1, 1] match the official JavaScript Math.asin results used +by purescript-numbers, and negative zero stays negative zero. Finite inputs +outside that interval, infinities, and NaN produce NaN. The operation does not +trap. NaN payloads are not part of the public contract. No constant folding is +introduced. A whole inverse-sine algorithm does not become a compiler +intrinsic. + +The numeric runtime retains its formatter, decimal conversion, and inverse +cosine exports and adds number_asin. Its reproducible artifact SHA-256 is +7e697803a15ed67e812051d78036e50a1213401296e48895d6cb7dceb27f36f7. +The private table still has two funcref slots. The active initializer now +points at function 24. Static stack analysis accepts the artifact and still +measures 1680 bytes inside the existing 65536-byte reserve. + +The independent library changes only the foreign slot's explicit binding: +`foreign import "psrs:intrinsic#numberAsin" asin :: Number -> Number`. +Its signature, exports, and all official pure declarations remain unchanged. +The complete-module source verifier checks this transformation against pinned +purescript-numbers v9.0.1 (27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +## Package and runtime evidence + +Locked package: 30f22bdb3b207d908ed00ac779d7b0a0a32cb00d +(fnv1a64-v1:db4b18f8950a407f). + +```sh +node ../psrs-stdlib/conformance/number-asin.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-asin-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-asin-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-asin-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-number-asin-oracle/Main.purs -o /tmp/psrs-number-asin-locked.wasm +wasmtime run /tmp/psrs-number-asin-locked.wasm +``` + +The actual pinned official JS asin produces 149 input observations and 298 +checks, exercising direct public calls and higher-order calls. Inputs include +both zero signs, the closed interval endpoints, values one ulp outside that +interval, subnormals, nonfinite values, and 128 deterministically generated +binary64 patterns. Reciprocal observations distinguish zero signs. NaN checks +do not require a payload. Both the development-package run and the +locked-package artifact +(sha256 c41a980e0e75412e84e217c37643145d71873e0164fd27a3cfbdb9a0305cb011) +return 42 with empty stdout and stderr. Wasmtime is 49.0.2. + +The same public asin 0.0 probe now passes against the locked package, in +7825 ms. A fresh Number.atan 0.0 probe stops at P8 library linking because +Data.Number.atan has no target implementation. The package fingerprint +changed, so the before and after diagnoses are not a same-fingerprint compare. + +Node tooling: 11 passed, none skipped. The numeric runtime rebuild is +byte-for-byte reproducible. + +## Rust validation + +Two driver regressions pass with mandatory Wasmtime: public behavior, +including zero signs, a higher-order call, and the linked `number_asin` +export, and rejection of invalid foreign contracts. The runtime unit test +checks the fdlibm boundary bit patterns. `cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. + +`PSRS_REQUIRE_WASMTIME=1 CARGO_INCREMENTAL=0 cargo test --workspace --offline --no-fail-fast` +finishes all 52 targets: 1699 passed, 3 failed, 5 ignored. The only failing +target is `psrs-driver --lib`. Its three failures are the established +baseline: `constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number`, and +`compiles_if_expression_through_cfg_to_structured_wasm`. No new failure +appeared. Full workspace validation is not green because of those baseline +failures. This change does not establish complete Number FFI support or +whole-standard-library runtime behavior. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 3ded47f2..4dffc23e 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -303,3 +303,19 @@ The generator invokes the pinned official acos FFI. Finite inputs in [-1, 1] match that FFI. Values outside the interval produce NaN. The compiler's checked numberAcos primitive calls the scalar numeric-runtime export. Wasm has no inverse-cosine instruction. + +For Number inverse sine through the same public-call shape: + +```sh +node ../psrs-stdlib/conformance/number-asin.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-asin-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-asin-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-asin-runtime +``` + +The generator invokes the pinned official asin FFI. Finite inputs in [-1, 1] +match that FFI, and negative zero stays negative zero. Values outside the +interval produce NaN. The compiler's checked numberAsin primitive calls the +scalar numeric-runtime export. Wasm has no inverse-sine instruction. diff --git a/stdlib.lock.json b/stdlib.lock.json index 204637bc..6e91f3f9 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "e05d4f765c949d50832b7d01b5cf992b5efc903e", - "source_fingerprint": "fnv1a64-v1:eccd4891551858bb" + "revision": "30f22bdb3b207d908ed00ac779d7b0a0a32cb00d", + "source_fingerprint": "fnv1a64-v1:db4b18f8950a407f" } From e8b5b9a02335c3db07489494333e6f5dd35dcc2e Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Thu, 8 Oct 2026 00:45:58 +0800 Subject: [PATCH 076/148] Support checked Number inverse tangent with public behavior evidence numberAtan calls a scalar numeric-runtime export and keeps the official Data.Number.atan signature. Returned bits match pinned libm 0.2.15, including zero signs and both infinities. The Wasm copy does not touch the stack pointer. The lock pins the library binding and its source verifier. --- crates/psrs-backend/src/abi/mod.rs | 5 +- .../psrs-backend/src/target_intrinsics/mod.rs | 1 + .../src/target_intrinsics/tests.rs | 1 + crates/psrs-backend/src/target_runtime/mod.rs | 7 + crates/psrs-core/src/verify/types/mod.rs | 3 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_atan.rs | 56 +++++++ crates/psrs-driver/src/tests/show.rs | 2 +- crates/psrs-hir/src/intrinsic/effects.rs | 4 +- crates/psrs-hir/src/intrinsic/mod.rs | 9 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + crates/psrs-linker/src/verify/tests.rs | 10 +- .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 38042 -> 38613 bytes crates/psrs-runtime/src/atan.rs | 144 ++++++++++++++++++ crates/psrs-runtime/src/catalog.rs | 9 +- crates/psrs-runtime/src/lib.rs | 13 ++ .../backend/fp/scalars-and-primitives.md | 10 ++ .../intrinsic-implementations-2026-10-07.md | 6 +- .../stdlib/number-atan-2026-10-08.md | 99 ++++++++++++ docs/workflow/stdlib-conformance.md | 16 ++ stdlib.lock.json | 4 +- 21 files changed, 387 insertions(+), 14 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_atan.rs create mode 100644 crates/psrs-runtime/src/atan.rs create mode 100644 docs/implementation/stdlib/number-atan-2026-10-08.md diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index e29c20c4..34a0dce4 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -113,7 +113,9 @@ pub(crate) const NUMBER_ACOS_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSI pub(crate) const NUMBER_ASIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 8); -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 8] = [ +pub(crate) const NUMBER_ATAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 9); + +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 9] = [ REALLOC_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, @@ -122,6 +124,7 @@ pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 8] = [ NUMBER_FROM_DECIMAL_SYMBOL, NUMBER_ACOS_SYMBOL, NUMBER_ASIN_SYMBOL, + NUMBER_ATAN_SYMBOL, ]; /// WASI interfaces and functions the backend itself references. The standard diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index b9f296d1..f3ab4283 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -99,6 +99,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::NumberFromDecimal => Artifact(&target_runtime::NUMBER_PARSE), Intrinsic::NumberAcos => Artifact(&target_runtime::NUMBER_ACOS), Intrinsic::NumberAsin => Artifact(&target_runtime::NUMBER_ASIN), + Intrinsic::NumberAtan => Artifact(&target_runtime::NUMBER_ATAN), Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 6a6ace98..b912e8b3 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -38,6 +38,7 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::NumberSqrt, 69), (Intrinsic::NumberAcos, 70), (Intrinsic::NumberAsin, 71), + (Intrinsic::NumberAtan, 72), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index 4c36eb2c..8dc1e2a7 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -47,6 +47,13 @@ pub(crate) const NUMBER_ASIN: ArtifactImplementation = ArtifactImplementation { artifact: &psrs_runtime::NUMBER_RUNTIME, }; +pub(crate) const NUMBER_ATAN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberAtan, + symbol: crate::abi::NUMBER_ATAN_SYMBOL, + abi: &psrs_runtime::NUMBER_ATAN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + /// The registered implementation for a MIR import symbol, if any. pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementation> { crate::target_intrinsics::artifacts().find(|implementation| symbol == implementation.symbol) diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 0f1ffdfe..2fbef65e 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -81,7 +81,8 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T | Intrinsic::NumberAbs | Intrinsic::NumberSqrt | Intrinsic::NumberAcos - | Intrinsic::NumberAsin => (Number, Number), + | Intrinsic::NumberAsin + | Intrinsic::NumberAtan => (Number, Number), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 8de7a09d..24f925d0 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -23,6 +23,7 @@ mod library_foreign; mod number_abs; mod number_acos; mod number_asin; +mod number_atan; mod number_decimal; mod number_rounding; mod number_sqrt; diff --git a/crates/psrs-driver/src/tests/number_atan.rs b/crates/psrs-driver/src/tests/number_atan.rs new file mode 100644 index 00000000..99548090 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_atan.rs @@ -0,0 +1,56 @@ +use super::*; + +#[test] +fn public_number_atan_matches_zero_signs_unit_slopes_and_infinities() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +apply f value = f value +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negative positiveInfinity +nan = 0.0 / 0.0 +checks = Number.atan 0.0 == 0.0 + && 1.0 / Number.atan 0.0 == positiveInfinity + && 1.0 / Number.atan (negative 0.0) == negativeInfinity + && Number.atan 1.0 == 0.7853981633974483 + && Number.atan (-1.0) == negative 0.7853981633974483 + && Number.atan positiveInfinity == 1.5707963267948966 + && Number.atan negativeInfinity == negative 1.5707963267948966 + && Number.atan nan /= Number.atan nan + && apply Number.atan 0.0 == 0.0 +main :: Int +main = if checks then 42 else 1 +"#; + let artifact = compile_program_sources_with_prelude(&[("Main.purs", source)]) + .expect("inverse tangent should compile"); + assert!( + artifact + .wasm + .windows(b"number_atan".len()) + .any(|window| window == b"number_atan"), + "the numeric runtime export should be linked" + ); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_atan_requires_number_operand_and_result() { + for ty in ["Int -> Number", "Number -> Int", "forall a. a -> a"] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberAtan\" angle :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("inverse tangent requires a checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index c23cd18c..f0ebd693 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -121,7 +121,7 @@ main = let ignored = log (show 1.0e21) in 0 let digests = parameter("artifact_digests").expect("artifact digests are recorded"); assert!(digests.contains("psrs:runtime-number"), "{digests}"); assert!( - digests.contains("7e697803a15ed67e812051d78036e50a1213401296e48895d6cb7dceb27f36f7"), + digests.contains("41064c763782dc2a184cfc1a47e0816e8dc0b9f8ea465320cc7c294b60807afe"), "{digests}" ); assert!( diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 4c98a16a..d2ebd2b7 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -28,7 +28,9 @@ impl IntrinsicEffects { | NumberMul | NumberDiv | NumberEq | NumberNe | NumberLt | NumberLe | NumberGt | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor - | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin => Self::default(), + | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin | NumberAtan => { + Self::default() + } } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 0542a4d1..1b3dbad9 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -122,6 +122,10 @@ pub enum Intrinsic { /// and NaN produce NaN. Negative zero remains negative zero. The operation /// does not trap. NumberAsin = 71, + /// Inverse tangent in radians. Positive and negative infinity produce + /// positive and negative pi/2. Negative zero remains negative zero. NaN + /// produces NaN. The operation does not trap. + NumberAtan = 72, } impl Intrinsic { @@ -147,7 +151,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 70] = [ + pub const ALL: [Intrinsic; 71] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -218,6 +222,7 @@ impl Intrinsic { Intrinsic::NumberSqrt, Intrinsic::NumberAcos, Intrinsic::NumberAsin, + Intrinsic::NumberAtan, ]; } @@ -227,7 +232,7 @@ impl Intrinsic { const _: () = { assert!( Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberAsin as u32 as usize + 1, + == Intrinsic::NumberAtan as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 19d30226..fd6d871a 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -112,6 +112,7 @@ descriptors! { NumberSqrt => "numberSqrt", 1, Unary, scheme::number_number; NumberAcos => "numberAcos", 1, Unary, scheme::number_number; NumberAsin => "numberAsin", 1, Unary, scheme::number_number; + NumberAtan => "numberAtan", 1, Unary, scheme::number_number; NumberCeil => "numberCeil", 1, Unary, scheme::number_number; BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, Unary, scheme::int_number; diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index facef381..8c51be71 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -12,7 +12,7 @@ fn number_format_contract() -> ArtifactContract { elements: vec![crate::DeclaredElement { table: 0, offset: 1, - functions: vec![24], + functions: vec![25], }], id: "psrs:runtime-number".into(), kind: ArtifactKind::CoreModule, @@ -71,6 +71,14 @@ fn number_format_contract() -> ArtifactContract { result: Some(CoreType::F64), }), }, + DeclaredExport { + name: psrs_runtime::ATAN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, ], tables: vec![DeclaredTable { element: "funcref".into(), diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index 64b8bf0f9189f40388354cb18fa575469f9c1e2e..c2074d01ad2b0bd82012268f26e3e22a22a6a458 100755 GIT binary patch delta 1739 zcmZux4@^~67(f5+dyjYD<6Y#>L-E0R7g7P)6EJmVdt7|AkvacnmTfOc5U+v)FI(2+ zY0Novh8pAqRdr*yGE!NOXzDmu)3~KByuSLijdhiq z5mUyckuBk-NaM!(4M>v1;o9oTt>LQ5rfQ0l>=2xVW@T+RHvr)$OeQ&wCd{#AZf+s=KSrp`ii!MYdUM59*34O4 zmH7Ay1vcxmL#N_>@lfZV!z+u1kM+gkp}Nk<@w+Ds6EjYr=1Cw|8`OTmZ<~ zgg=);DOc4S3y-zIL2kRZoNQ>%e1UcOFx-8Hh_=9+^{(MpRNrqfs*-fLN4uan#kNqE4{EpUU*NnFwU~Ll*P#-CxU)LJaADQej=NUb}q`axmtG%Q<6oP%)vg< zM$&*DA_X{G3=)5ekK43Sr1PY5#2w{G@d-k63$x+ywtULxQv~`!(AzXoUpfe zv7F9;SZ~m!(*|1DQ?LuH5uH=cv=Ov)b;T*xI~QQ5_}ID4>x9X%RCZ9Rc3pLA*t95+ z3vrTIBfkV0PRK<-hvf}GpLNXuTIccs-RtrtCpHNo4s)W|#b>V5cu+LDx2OAHZJ^bm%S(6m-KuJ zb>W1QH&w@O73vB#U7MDZI(Uoe+OGxUdP{D!rk%#Fd(e4irlyJ_R%DdAe%v`p&<28i zyCw-PW)%Hf;P95aJ^~kN#vl-5jW>77zUxe7n!L@LIvl|JuZz9jHDv!!;)Yj~j^1L* z6p^3VDBZheqFCldX~aZEWU7axw+sPxYvs7novbf0_8KRBsTgO9 z{_Jj`dd_^DX~c8RG2T67&4EqZ0o~({#2k!`(FSW6x`)KBywwCgSMp|M9~xo{;bw!{ zn+xiuLCdMGIXT^=WEj~`^bqN{VWy-Q7iRvBrAHPV$gh^9UN}RFCj6I)!b;W z#2sjqi6B5 z)0NVOqeH>Ooq03(;r*RI$W3>~`G>)us{?9t;r2!LSJFyn^z2-8=G)Qjd+b}s`2&lL zt51$#yx8cQADmrW3xUIMF|UPpCcG1TE8x^g{HK7q$&0}H%PA99_d$|wN)2!Iap`Yy O6HYh}7?<_0^Zx={xXX|L delta 1112 zcmZ8gUu;uV7(d_nb8pw%u6OM^+O36iTkY1t0;2eK^1KJHOxe zednAn=lt*qe*0s*bewG3h>xAviTAQ&*Ah=f4!u&?pD)?trDDN;F@IpHFm@0Tb4{Ho z+S40alJ-JU zenYJ`FW|Nc_}9Bj)5^10yy2Ch>7hp69+pvFi9G=evch5tZ?LBo_G`TgpVPj^*XCtX z9|R^xbq79^7xWY`x2})VsE<>}(gW1sgag+ct~+Lnv;%|CB2NU4C=3Oo3hxhY2A>=b zKC3F83HEt=1Sb@V){Mf**5sCjIl2oW4&n`mQ_e&k9ehcwu9Cw7X11cHt9Cifv8l<= zTbE%;7DBH@6Dq@Ow4x_vs8-;{l~zJskZ@z>VF15eY}>8*Q&d%z-$oYQ1L41v>OS8- z2N04!NB8Z%eVjR2qME@m$FHV*N4=(+2~M)awEXx{kHk`VXqC*WF%m@TvbtEhMIG^L z?^F+=k4SS}#nTqnGxge&WX%dx)y3M4)hsHz&otASOG;dnZH zrAAX!7)LCo&I4QFYE2%EkK(I8$y!{n-+!ZKo4l{H#LiVc_D<(_?3BmcVpj-9FL@Lh zoN;hOSrgwkf@E@JE$CMA0zij*c2fjkgRJmV3iH+ju)%%Ts!&|7N;{MArq?rjz3FrP1VRp7gP1C)Uy#ws42EDjB&)AAOmMQ!CKZH(sz5j)DWtnl`2bM2D zy!WE1hU=#VnGrW{&}JLeD<0im$CYLIP;NW4%3?09Q05+kxUA)dLrYa^F_kO0!$(CcOHCX zOMj0tY=qD=YILh{Z@s8^WZn7;#kseZ&iIdQ_oDt(O4L)`k%>>)Kk_s*lNa1@;bQi0 Dw^|pD diff --git a/crates/psrs-runtime/src/atan.rs b/crates/psrs-runtime/src/atan.rs new file mode 100644 index 00000000..94346b61 --- /dev/null +++ b/crates/psrs-runtime/src/atan.rs @@ -0,0 +1,144 @@ +//! Inverse tangent of one binary64 value. +//! +//! The polynomial is the fdlibm routine pinned by libm 0.2.15. On every finite +//! input, and on both infinities, it matches the official JavaScript +//! `Math.atan` results used by purescript-numbers, including the sign of zero. +//! NaN produces NaN. The operation does not trap. NaN payloads are not part of +//! the public contract. +//! +//! The original routine forces an `f32` evaluation on subnormal inputs to raise +//! the host underflow flag. Wasm has no floating-point status flags, and that +//! evaluation writes below the stack pointer without reserving the frame. This +//! copy returns the same bits and does not touch the stack pointer. + +/// Returns the inverse tangent in radians. +/// +/// The decimal coefficients are copied from libm 0.2.15. Their extra digits +/// and the split pi/2 terms belong to that polynomial. +#[allow(clippy::excessive_precision, clippy::approx_constant)] +fn atan(value: f64) -> f64 { + const ATANHI: [f64; 4] = [ + 4.63647609000806093515e-01, + 7.85398163397448278999e-01, + 9.82793723247329054082e-01, + 1.57079632679489655800e+00, + ]; + const ATANLO: [f64; 4] = [ + 2.26987774529616870924e-17, + 3.06161699786838301793e-17, + 1.39033110312309984516e-17, + 6.12323399573676603587e-17, + ]; + const AT: [f64; 11] = [ + 3.33333333333329318027e-01, + -1.99999999998764832476e-01, + 1.42857142725034663711e-01, + -1.11111104054623557880e-01, + 9.09088713343650656196e-02, + -7.69187620504482999495e-02, + 6.66107313738753120669e-02, + -5.83357013379057348645e-02, + 4.97687799461593236017e-02, + -3.65315727442169155270e-02, + 1.62858201153657823623e-02, + ]; + + let mut x = value; + let mut ix = (x.to_bits() >> 32) as u32; + let sign = ix >> 31; + ix &= 0x7fff_ffff; + if ix >= 0x4410_0000 { + if x.is_nan() { + return x; + } + let z = ATANHI[3] + f64::from_bits(0x0380_0000); + return if sign != 0 { -z } else { z }; + } + let id = if ix < 0x3fdc_0000 { + if ix < 0x3e40_0000 { + return x; + } + -1 + } else { + x = x.abs(); + if ix < 0x3ff3_0000 { + if ix < 0x3fe6_0000 { + x = (2. * x - 1.) / (2. + x); + 0 + } else { + x = (x - 1.) / (x + 1.); + 1 + } + } else if ix < 0x4003_8000 { + x = (x - 1.5) / (1. + 1.5 * x); + 2 + } else { + x = -1. / x; + 3 + } + }; + let z = x * x; + let w = z * z; + let s1 = z * (AT[0] + w * (AT[2] + w * (AT[4] + w * (AT[6] + w * (AT[8] + w * AT[10]))))); + let s2 = w * (AT[1] + w * (AT[3] + w * (AT[5] + w * (AT[7] + w * AT[9])))); + if id < 0 { + return x - x * (s1 + s2); + } + let z = ATANHI[id as usize] - (x * (s1 + s2) - ATANLO[id as usize] - x); + if sign != 0 { -z } else { z } +} + +/// C ABI export of [`atan`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_atan(value: f64) -> f64 { + atan(value) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn matches_zero_signs_unit_slopes_and_infinities() { + for (input, bits) in [ + (0.0, 0), + (-0.0, 0x8000000000000000), + (1.0, 0x3fe921fb54442d18), + (-1.0, 0xbfe921fb54442d18), + (f64::INFINITY, 0x3ff921fb54442d18), + (f64::NEG_INFINITY, 0xbff921fb54442d18), + ] { + assert_eq!(atan(input).to_bits(), bits, "{input}"); + } + assert!(atan(f64::NAN).is_nan()); + } + + #[test] + fn matches_libm_bits_including_subnormals() { + for input in [ + f64::from_bits(1), + f64::from_bits(0x000f_ffff_ffff_ffff), + f64::from_bits(0x0010_0000_0000_0000), + 1e-20, + -1e-20, + 0.4375, + -0.4375, + 0.7, + 1.1875, + 2.4375, + 1e20, + f64::MAX, + -f64::MAX, + ] { + assert_eq!( + atan(input).to_bits(), + libm::atan(input).to_bits(), + "{input}" + ); + } + } +} diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index c1a4af4d..dd5fe666 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -165,7 +165,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { profile: "target-runtime", recipe: "tools/build.sh: --import-memory --global-base=65536 \ -zstack-size=65536 --export=__heap_base, then package", - sha256: "7e697803a15ed67e812051d78036e50a1213401296e48895d6cb7dceb27f36f7", + sha256: "41064c763782dc2a184cfc1a47e0816e8dc0b9f8ea465320cc7c294b60807afe", }, required_features: &[ "mutable-globals", @@ -200,6 +200,11 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { parameters: &[RawType::F64], result: Some(RawType::F64), }, + RawExport { + name: crate::ATAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, ], global_exports: &[crate::HEAP_BASE_EXPORT], tables: &[RawTable { @@ -210,7 +215,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { elements: &[RawElement { table: 0, offset: 1, - functions: &[24], + functions: &[25], }], globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], storage: RawStorage { diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index c774ee13..1c5256ef 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -27,6 +27,8 @@ mod acos; #[cfg(feature = "formatter")] mod asin; #[cfg(feature = "formatter")] +mod atan; +#[cfg(feature = "formatter")] mod decimal; #[cfg(feature = "formatter")] mod formatter; @@ -35,6 +37,8 @@ pub use acos::number_acos; #[cfg(feature = "formatter")] pub use asin::number_asin; #[cfg(feature = "formatter")] +pub use atan::number_atan; +#[cfg(feature = "formatter")] pub use decimal::number_from_decimal; #[cfg(feature = "formatter")] pub use formatter::number_to_string; @@ -51,6 +55,8 @@ pub const DECIMAL_EXPORT: &str = "number_from_decimal"; pub const ACOS_EXPORT: &str = "number_acos"; /// Exported raw inverse-sine function. pub const ASIN_EXPORT: &str = "number_asin"; +/// Exported raw inverse-tangent function. +pub const ATAN_EXPORT: &str = "number_atan"; /// Lower addresses remain owned by the application's canonical ABI. pub const RESERVED_START: u32 = 65536; /// Static data must end before the separately reserved 64 KiB stack. @@ -121,3 +127,10 @@ pub const NUMBER_ASIN: RawFunctionAbi = RawFunctionAbi { result: Some(RawType::F64), protocol: RawCallProtocol::Scalars, }; + +pub const NUMBER_ATAN: RawFunctionAbi = RawFunctionAbi { + export: ATAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index db33e71d..f2aca6f0 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -219,6 +219,16 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. infinities, and NaN produce NaN, and the operation does not trap. NaN payloads are not a public guarantee. It implements the official Data.Number.asin foreign slot and is not folded when its operand is constant. +- `NumberAtan` (`numberAtan :: Number -> Number`) uses the same checked + scalar-runtime boundary. The runtime copies the pinned libm 0.2.15 fdlibm + polynomial and returns radians, preserving the sign of zero. Inputs whose + magnitude is below 2^-27, including subnormals, return unchanged. The copy + omits the host underflow flag because Wasm has no floating-point status + flags and must not write below the stack pointer. Positive and negative + infinity produce positive and negative pi/2. NaN produces NaN, and the + operation does not trap. NaN payloads are not a public guarantee. It + implements the official Data.Number.atan foreign slot and is not folded + when its operand is constant. - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. - The current vocabulary has no `Number` remainder. If the standard library diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md index 09a4e86a..0c87db03 100644 --- a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -97,6 +97,6 @@ Library evidence, with the package fingerprint unchanged during each run: This refactor does not establish whole-stdlib runtime completion. Number square root has a separate checked `f64.sqrt` acceptance. Number inverse -cosine and inverse sine each have a separate checked scalar-runtime -acceptance. Other Number foreign slots remain without target support until a -fresh diagnosis names the next blocker. +cosine, inverse sine, and inverse tangent each have a separate checked +scalar-runtime acceptance. Other Number foreign slots remain without target +support until a fresh diagnosis names the next blocker. diff --git a/docs/implementation/stdlib/number-atan-2026-10-08.md b/docs/implementation/stdlib/number-atan-2026-10-08.md new file mode 100644 index 00000000..c86d289e --- /dev/null +++ b/docs/implementation/stdlib/number-atan-2026-10-08.md @@ -0,0 +1,99 @@ +# Number inverse-tangent acceptance + +## Contract and implementation + +Starting compiler revision: 957b133 on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was +30f22bdb3b207d908ed00ac779d7b0a0a32cb00d +(fnv1a64-v1:db4b18f8950a407f). A fresh Number.atan 0.0 diagnosis stopped at +P8 library linking because Data.Number.atan had no target implementation. + +Wasm has no inverse-tangent instruction. The compiler owns +numberAtan :: Number -> Number. Its HIR identity is appended as 72, preserving +existing intrinsic IDs. Core and CC require Number operand and result types. +MIR calls the scalar export `number_atan` in the shared numeric runtime. +Incorrect foreign binding schemes are rejected before ABI erasure. + +The export copies the fdlibm polynomial pinned by libm 0.2.15 and returns the +same bits, including subnormals. Every finite input matches the official +JavaScript Math.atan results used by purescript-numbers, and negative zero +stays negative zero. Positive infinity is pi/2 and negative infinity is +negative pi/2. NaN produces NaN. The operation does not trap. NaN payloads +are not part of the public contract. No constant folding is introduced. A +whole inverse-tangent algorithm does not become a compiler intrinsic. + +The published libm routine forces an f32 evaluation on subnormal inputs so a +host can raise the underflow flag. That evaluation writes below the stack +pointer without reserving a frame, which makes the linker's static stack +bound unknown. Wasm has no floating-point status flags. The runtime copy +returns the input unchanged when its magnitude is below 2^-27 and does not +touch the stack pointer. + +The numeric runtime retains its formatter, decimal conversion, inverse-cosine, +and inverse-sine exports and adds number_atan. Its reproducible artifact +SHA-256 is +41064c763782dc2a184cfc1a47e0816e8dc0b9f8ea465320cc7c294b60807afe. +The private table still has two funcref slots. The active initializer now +points at function 25. Static stack analysis accepts the artifact and still +measures 1680 bytes inside the existing 65536-byte reserve. + +The independent library changes only the foreign slot's explicit binding: +`foreign import "psrs:intrinsic#numberAtan" atan :: Number -> Number`. +Its signature, exports, and all official pure declarations remain unchanged. +The complete-module source verifier checks this transformation against pinned +purescript-numbers v9.0.1 (27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +## Package and runtime evidence + +Locked package: f2cdf0341ccb166ed827723ee305095780e3b2b6 +(fnv1a64-v1:369a7661425142dc). + +```sh +node ../psrs-stdlib/conformance/number-atan.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-atan-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-atan-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-atan-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-number-atan-oracle/Main.purs -o /tmp/psrs-number-atan-locked.wasm +wasmtime run /tmp/psrs-number-atan-locked.wasm +``` + +The actual pinned official JS atan produces 149 input observations and 298 +checks, exercising direct public calls and higher-order calls. Inputs include +both zero signs, unit slopes, both infinities, subnormals, nonfinite values, +and 128 deterministically generated binary64 patterns. Reciprocal observations +distinguish zero signs. NaN checks do not require a payload. Both the +development-package run and the locked-package artifact +(sha256 00008e3259148e8c40d65d0198e06c8f333143f69102fc034f30e888bc462b0c) +return 42 with empty stdout and stderr. Wasmtime is 49.0.2. + +The same public atan 0.0 probe now passes against the locked package, in +7701 ms. A fresh Number.atan2 0.0 1.0 probe stops at P8 library linking +because Data.Number.atan2 has no target implementation (7360 ms). Both new +diagnoses use fnv1a64-v1:369a7661425142dc. The earlier atan failure used +fnv1a64-v1:db4b18f8950a407f, so the before and after diagnoses are not a +same-fingerprint compare. + +Node tooling: 11 passed, none skipped. The numeric runtime rebuild is +byte-for-byte reproducible. + +## Rust validation + +Two driver regressions pass with mandatory Wasmtime: public behavior, +including zero signs, both infinities, a higher-order call, and the linked +`number_atan` export, and rejection of invalid foreign contracts. The runtime +unit tests check the public boundary bit patterns and agreement with +libm::atan, including subnormals. `cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. + +`PSRS_REQUIRE_WASMTIME=1 CARGO_INCREMENTAL=0 cargo test --workspace --offline --no-fail-fast` +finishes all 52 targets: 1703 passed, 3 failed, 5 ignored. The only failing +target is `psrs-driver --lib`. Its three failures are the established +baseline: `constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number`, and +`compiles_if_expression_through_cfg_to_structured_wasm`. No new failure +appeared. Full workspace validation is not green because of those baseline +failures. This change does not establish complete Number FFI support or +whole-standard-library runtime behavior. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 4dffc23e..d71a9e04 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -319,3 +319,19 @@ The generator invokes the pinned official asin FFI. Finite inputs in [-1, 1] match that FFI, and negative zero stays negative zero. Values outside the interval produce NaN. The compiler's checked numberAsin primitive calls the scalar numeric-runtime export. Wasm has no inverse-sine instruction. + +For Number inverse tangent through the same public-call shape: + +```sh +node ../psrs-stdlib/conformance/number-atan.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-atan-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-atan-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-atan-runtime +``` + +The generator invokes the pinned official atan FFI. Every finite input and +both infinities match that FFI, and negative zero stays negative zero. NaN +produces NaN. The compiler's checked numberAtan primitive calls the scalar +numeric-runtime export. Wasm has no inverse-tangent instruction. diff --git a/stdlib.lock.json b/stdlib.lock.json index 6e91f3f9..3dd27936 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "30f22bdb3b207d908ed00ac779d7b0a0a32cb00d", - "source_fingerprint": "fnv1a64-v1:db4b18f8950a407f" + "revision": "f2cdf0341ccb166ed827723ee305095780e3b2b6", + "source_fingerprint": "fnv1a64-v1:369a7661425142dc" } From 4e53f83a1db33b129ef70c6b094dc7a6ebb64510 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Thu, 8 Oct 2026 01:16:44 +0800 Subject: [PATCH 077/148] Support checked Number four-quadrant inverse tangent with public behavior evidence --- crates/psrs-backend/src/abi/mod.rs | 5 +- .../psrs-backend/src/target_intrinsics/mod.rs | 1 + .../src/target_intrinsics/tests.rs | 1 + crates/psrs-backend/src/target_runtime/mod.rs | 7 + crates/psrs-core/src/verify/types/mod.rs | 3 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_atan2.rs | 69 ++++++ crates/psrs-driver/src/tests/show.rs | 2 +- crates/psrs-hir/src/intrinsic/effects.rs | 5 +- crates/psrs-hir/src/intrinsic/mod.rs | 9 +- crates/psrs-hir/src/intrinsic/registry.rs | 1 + crates/psrs-linker/src/verify/tests.rs | 10 +- .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 38613 -> 39117 bytes crates/psrs-runtime/src/atan.rs | 2 +- crates/psrs-runtime/src/atan2.rs | 202 ++++++++++++++++++ crates/psrs-runtime/src/catalog.rs | 9 +- crates/psrs-runtime/src/lib.rs | 13 ++ .../backend/fp/scalars-and-primitives.md | 12 ++ .../intrinsic-implementations-2026-10-07.md | 7 +- .../stdlib/number-atan2-2026-10-08.md | 99 +++++++++ docs/workflow/stdlib-conformance.md | 17 ++ stdlib.lock.json | 4 +- 22 files changed, 462 insertions(+), 17 deletions(-) create mode 100644 crates/psrs-driver/src/tests/number_atan2.rs create mode 100644 crates/psrs-runtime/src/atan2.rs create mode 100644 docs/implementation/stdlib/number-atan2-2026-10-08.md diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index 34a0dce4..6e379b18 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -115,7 +115,9 @@ pub(crate) const NUMBER_ASIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSI pub(crate) const NUMBER_ATAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 9); -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 9] = [ +pub(crate) const NUMBER_ATAN2_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 10); + +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 10] = [ REALLOC_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, @@ -125,6 +127,7 @@ pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 9] = [ NUMBER_ACOS_SYMBOL, NUMBER_ASIN_SYMBOL, NUMBER_ATAN_SYMBOL, + NUMBER_ATAN2_SYMBOL, ]; /// WASI interfaces and functions the backend itself references. The standard diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index f3ab4283..47b9aaa4 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -100,6 +100,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::NumberAcos => Artifact(&target_runtime::NUMBER_ACOS), Intrinsic::NumberAsin => Artifact(&target_runtime::NUMBER_ASIN), Intrinsic::NumberAtan => Artifact(&target_runtime::NUMBER_ATAN), + Intrinsic::NumberAtan2 => Artifact(&target_runtime::NUMBER_ATAN2), Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index b912e8b3..b05836b1 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -39,6 +39,7 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::NumberAcos, 70), (Intrinsic::NumberAsin, 71), (Intrinsic::NumberAtan, 72), + (Intrinsic::NumberAtan2, 73), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index 8dc1e2a7..feadc792 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -54,6 +54,13 @@ pub(crate) const NUMBER_ATAN: ArtifactImplementation = ArtifactImplementation { artifact: &psrs_runtime::NUMBER_RUNTIME, }; +pub(crate) const NUMBER_ATAN2: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberAtan2, + symbol: crate::abi::NUMBER_ATAN2_SYMBOL, + abi: &psrs_runtime::NUMBER_ATAN2, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + /// The registered implementation for a MIR import symbol, if any. pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementation> { crate::target_intrinsics::artifacts().find(|implementation| symbol == implementation.symbol) diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index 2fbef65e..c77e5258 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -49,7 +49,8 @@ pub(super) fn primitive_types(intrinsic: Intrinsic, module: &Module) -> (TypeId, Intrinsic::NumberAdd | Intrinsic::NumberSub | Intrinsic::NumberMul - | Intrinsic::NumberDiv => (Number, Number), + | Intrinsic::NumberDiv + | Intrinsic::NumberAtan2 => (Number, Number), Intrinsic::NumberEq | Intrinsic::NumberNe | Intrinsic::NumberLt diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 24f925d0..2c04c83a 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -24,6 +24,7 @@ mod number_abs; mod number_acos; mod number_asin; mod number_atan; +mod number_atan2; mod number_decimal; mod number_rounding; mod number_sqrt; diff --git a/crates/psrs-driver/src/tests/number_atan2.rs b/crates/psrs-driver/src/tests/number_atan2.rs new file mode 100644 index 00000000..a086ad11 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_atan2.rs @@ -0,0 +1,69 @@ +use super::*; + +#[test] +fn public_number_atan2_matches_quadrants_zero_signs_and_infinities() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +apply f y x = f y x +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negative positiveInfinity +nan = 0.0 / 0.0 +checks = Number.atan2 0.0 1.0 == 0.0 + && 1.0 / Number.atan2 0.0 1.0 == positiveInfinity + && 1.0 / Number.atan2 (negative 0.0) 1.0 == negativeInfinity + && Number.atan2 0.0 (negative 1.0) == 3.141592653589793 + && Number.atan2 (negative 0.0) (negative 1.0) == negative 3.141592653589793 + && Number.atan2 1.0 0.0 == 1.5707963267948966 + && Number.atan2 (negative 1.0) 0.0 == negative 1.5707963267948966 + && Number.atan2 1.0 (negative 0.0) == 1.5707963267948966 + && Number.atan2 1.0 positiveInfinity == 0.0 + && 1.0 / Number.atan2 (negative 1.0) positiveInfinity == negativeInfinity + && Number.atan2 1.0 negativeInfinity == 3.141592653589793 + && Number.atan2 positiveInfinity positiveInfinity == 0.7853981633974483 + && Number.atan2 positiveInfinity negativeInfinity == 2.356194490192345 + && Number.atan2 negativeInfinity negativeInfinity == negative 2.356194490192345 + && Number.atan2 0.1 (negative 1.0e-20) == 1.5707963267948966 + && Number.atan2 nan 1.0 /= Number.atan2 nan 1.0 + && Number.atan2 1.0 nan /= Number.atan2 1.0 nan + && apply Number.atan2 0.0 1.0 == 0.0 +main :: Int +main = if checks then 42 else 1 +"#; + let artifact = compile_program_sources_with_prelude(&[("Main.purs", source)]) + .expect("four-quadrant inverse tangent should compile"); + assert!( + artifact + .wasm + .windows(b"number_atan2".len()) + .any(|window| window == b"number_atan2"), + "the numeric runtime export should be linked" + ); + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_atan2_requires_number_operands_and_result() { + for ty in [ + "Int -> Number -> Number", + "Number -> Number -> Int", + "forall a. a -> a -> a", + ] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#numberAtan2\" angle :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("four-quadrant inverse tangent requires a checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking") + ); + } +} diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index f0ebd693..6fe3a588 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -121,7 +121,7 @@ main = let ignored = log (show 1.0e21) in 0 let digests = parameter("artifact_digests").expect("artifact digests are recorded"); assert!(digests.contains("psrs:runtime-number"), "{digests}"); assert!( - digests.contains("41064c763782dc2a184cfc1a47e0816e8dc0b9f8ea465320cc7c294b60807afe"), + digests.contains("e295fd40bcb247ee77b8890107b2dea74838ded7b383895ce8db7c428d0e7ac2"), "{digests}" ); assert!( diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index d2ebd2b7..dcb26a7c 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -28,9 +28,8 @@ impl IntrinsicEffects { | NumberMul | NumberDiv | NumberEq | NumberNe | NumberLt | NumberLe | NumberGt | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor - | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin | NumberAtan => { - Self::default() - } + | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin | NumberAtan + | NumberAtan2 => Self::default(), } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 1b3dbad9..d70c3d79 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -126,6 +126,10 @@ pub enum Intrinsic { /// positive and negative pi/2. Negative zero remains negative zero. NaN /// produces NaN. The operation does not trap. NumberAtan = 72, + /// Four-quadrant inverse tangent of `y` then `x`, in radians. The signs + /// of both arguments select the quadrant. Negative zero is preserved when + /// the result is zero. Either NaN produces NaN. The operation does not trap. + NumberAtan2 = 73, } impl Intrinsic { @@ -151,7 +155,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 71] = [ + pub const ALL: [Intrinsic; 72] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -223,6 +227,7 @@ impl Intrinsic { Intrinsic::NumberAcos, Intrinsic::NumberAsin, Intrinsic::NumberAtan, + Intrinsic::NumberAtan2, ]; } @@ -232,7 +237,7 @@ impl Intrinsic { const _: () = { assert!( Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberAtan as u32 as usize + 1, + == Intrinsic::NumberAtan2 as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index fd6d871a..b2410650 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -113,6 +113,7 @@ descriptors! { NumberAcos => "numberAcos", 1, Unary, scheme::number_number; NumberAsin => "numberAsin", 1, Unary, scheme::number_number; NumberAtan => "numberAtan", 1, Unary, scheme::number_number; + NumberAtan2 => "numberAtan2", 2, BinaryScalar, scheme::number_number_number; NumberCeil => "numberCeil", 1, Unary, scheme::number_number; BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, Unary, scheme::int_number; diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index 8c51be71..23f97164 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -12,7 +12,7 @@ fn number_format_contract() -> ArtifactContract { elements: vec![crate::DeclaredElement { table: 0, offset: 1, - functions: vec![25], + functions: vec![27], }], id: "psrs:runtime-number".into(), kind: ArtifactKind::CoreModule, @@ -79,6 +79,14 @@ fn number_format_contract() -> ArtifactContract { result: Some(CoreType::F64), }), }, + DeclaredExport { + name: psrs_runtime::ATAN2_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::F64], + result: Some(CoreType::F64), + }), + }, ], tables: vec![DeclaredTable { element: "funcref".into(), diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index c2074d01ad2b0bd82012268f26e3e22a22a6a458..f83eadeca7e190932b885b824900e606ff4cec7a 100755 GIT binary patch delta 1603 zcmZ8hZ)_Ar6rVRcv%BrypDoubz0%UzYbmxs5Do;z&~8&SAgB<I1ixS=B&acIwYDFuQL>ttSn-I&7!)y}A0$DDsR^Pcd_^JncDt?UUhcg&^M3E| zyqOhanhhr$etV9(209|VU#Uk9D0FLHBMcy3x$Z`l7MM_n$dl@Yi~zBo7>mZPw4!rzq6Yt^Q(be zH(`-EB(7Eyo(PxC`|~|r*_S)^b#~wg~CzQr7Z#kXnXE&tE6ZF2GU}T5Xy-mNZ>ZaDuU%VMLEX7@b|SRqagG-kqXUL29_yb53{&2 z=dA^;L&OtN>SrNzp&Yc!-NRVJ<6GzB-f6Z#sFoH1zfQghOH%B%r%_MB&jQp5Y{k28 zm|*#^z?~LT7*I?U+O*x}nTCn6>Cw69MeLe@Hy=o69<>T#W2l|Y`Q|V~j{;j5n%-#^ zWa7Uoxj`9*#j>azD=)REA!yvNiv?z{vB!s*Y06#f;fh+J+Bb+Jpi$A&C9Op0t;DRA zqpS&p{DxU&KHxS2{?*-Mb*Qs=D$o^RR!0K6r+5SE@_ZXTJ|fTYg+9B=clvC#+UT=A z>RI?+R%?%fE_Z59{YM`%N0bV7P?Xx2CN7Xec4E-6?_oqLsI5CfGj(r9+s~4QU=FsM z;m`=|JZc;>BD0b85Rs=NgGl4iB+@0(Wnjqd(HH%2Q_m$*dM5O$ut3$TP9e=*g?HJANctiza5!uZPkG_KOB} z-;FPVTCdXV1Bl8KWt-J#nxR{HF>%7%x8M%$dV9);0T#$#lDjtFKE<6z1v}=~cqFYK z^E+?W3Z+potx}vO6e{sH+*e-3{|7` zSrn(q^S+3K$^|%fLA8GfK(b~>2)b2s4j|=C)g}O{WKoPG?XcECmG`z)WH2LNYN$av z)bKpg%MFe2tGwG#4V7MM=>+9d*O{5{&Nu!Ad^!-nT-L$)T}&w+NO4*YK~DL+~BEL2E!Z5<@NrnNnwR|I%-p*Qx(QZO!@1$+++1!fezE97%Q6rMLb`|o(yaU8pL9M9UNiIY|ZnxrXE==esfN(EGC;ovwlCE1dM#3oAl z^NLy(N-IP=lmp^`D!089TD0QS615kU3&Kcn0L6e%kWd6tBq|OSQkk_wk=T{q_ujns zX7+vG>{p-R?>@o3s8pT?gb*xtj^Sz*s$){M1yDs}aBk~@Lo-;CBqA%ShIHW>rV%n! zwIhryWEh4WIrqhu?c<6$^Xl~Y#C);z;%phg{ir-OgYf;RQkp>$k3ei6u{Y~0v&C{{ zero0=B%8(J41OrQ5H~{5PN^c9Ro!d{gP@`r9t551*3saIW7hTn&RfR=xNAKSfMfRr@PyqH zZhx%U=L*HP%BSobxbZ#T7CHG)T1;TKDC^IfVr<+R8w%d$voByX@n+WeH|IAZa{wkU zM4trHKO21q3y5{s0BrtY{Q3Cx3$mM+1X~nSd@`$@4wMion2AiZu})m}+rVbNweIgt zd>OQo2Go6hZqgnu}9i)8A}mfQ+^ODIIOw%qsbNpmgD>wKvHFx2@{f4=uplRP4> zu;4X#1r1DyD!I&{(h0lU|EB*kmVf_|*b)DY!Mh;;-Ev>wF(J!0#RL)l>%*5I#n0>- z%Xv3ts$F!nkQCeiMNq04x!Pg#vs z;>ey7=-)4x;`qBeS4&wd(Dde{{4D%%x=zzozFA)AP^l Q*^l|$ f64 { +pub(crate) fn atan(value: f64) -> f64 { const ATANHI: [f64; 4] = [ 4.63647609000806093515e-01, 7.85398163397448278999e-01, diff --git a/crates/psrs-runtime/src/atan2.rs b/crates/psrs-runtime/src/atan2.rs new file mode 100644 index 00000000..2e7910f3 --- /dev/null +++ b/crates/psrs-runtime/src/atan2.rs @@ -0,0 +1,202 @@ +//! Four-quadrant inverse tangent of two binary64 values. +//! +//! The reduction follows the fdlibm cutoff: an exponent gap above 60 uses a +//! signed half-pi, and a negative `x` with an exponent gap below -60 uses a +//! zero before the pi adjustment. Moderate ratios call this crate's inverse +//! tangent, which matches libm `atan` and does not touch the stack pointer. +//! libm 0.2.15's own `atan2` uses a wider gap and differs from official +//! `Math.atan2` by one ulp on some of those large ratios. +//! +//! The argument order is `(y, x)`, matching official `Math.atan2` and +//! `Data.Number.atan2`. Either NaN produces NaN. The operation does not trap. +//! NaN payloads are not part of the public contract. + +use super::atan::atan; + +/// Returns the angle from the positive x axis to `(x, y)`, in radians. +/// +/// The split pi terms are the fdlibm constants. Their extra digits belong to +/// that reduction. +#[allow(clippy::excessive_precision, clippy::approx_constant)] +fn atan2(y: f64, x: f64) -> f64 { + const PI: f64 = 3.1415926535897931160E+00; + const PI_LO: f64 = 1.2246467991473531772E-16; + const PI_OVER_2: f64 = 1.5707963267948965580E+00; + + if x.is_nan() || y.is_nan() { + return x + y; + } + let mut ix = (x.to_bits() >> 32) as u32; + let lx = x.to_bits() as u32; + let mut iy = (y.to_bits() >> 32) as u32; + let ly = y.to_bits() as u32; + if (ix.wrapping_sub(0x3ff0_0000) | lx) == 0 { + return atan(y); + } + let mut quadrant = ((iy >> 31) & 1) | ((ix >> 30) & 2); + ix &= 0x7fff_ffff; + iy &= 0x7fff_ffff; + + if (iy | ly) == 0 { + return match quadrant { + 0 | 1 => y, + 2 => PI, + _ => -PI, + }; + } + if (ix | lx) == 0 { + return if quadrant & 1 != 0 { + -PI / 2.0 + } else { + PI / 2.0 + }; + } + if ix == 0x7ff0_0000 { + if iy == 0x7ff0_0000 { + return match quadrant { + 0 => PI / 4.0, + 1 => -PI / 4.0, + 2 => 3.0 * PI / 4.0, + _ => -3.0 * PI / 4.0, + }; + } + return match quadrant { + 0 => 0.0, + 1 => -0.0, + 2 => PI, + _ => -PI, + }; + } + if iy == 0x7ff0_0000 { + return if quadrant & 1 != 0 { + -PI / 2.0 + } else { + PI / 2.0 + }; + } + let exponent_gap = (iy as i32).wrapping_sub(ix as i32) >> 20; + let reduced = if exponent_gap > 60 { + quadrant &= 1; + PI_OVER_2 + 0.5 * PI_LO + } else if quadrant & 2 != 0 && exponent_gap < -60 { + 0.0 + } else { + atan((y / x).abs()) + }; + match quadrant { + 0 => reduced, + 1 => -reduced, + 2 => PI - (reduced - PI_LO), + _ => (reduced - PI_LO) - PI, + } +} + +/// C ABI export of [`atan2`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_atan2(y: f64, x: f64) -> f64 { + atan2(y, x) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn matches_quadrant_zeros_and_infinities() { + for (y, x, bits) in [ + (0.0, 1.0, 0), + (-0.0, 1.0, 0x8000_0000_0000_0000), + (0.0, -1.0, 0x4009_21fb_5444_2d18), + (-0.0, -1.0, 0xc009_21fb_5444_2d18), + (1.0, 0.0, 0x3ff9_21fb_5444_2d18), + (-1.0, 0.0, 0xbff9_21fb_5444_2d18), + (1.0, -0.0, 0x3ff9_21fb_5444_2d18), + (-1.0, -0.0, 0xbff9_21fb_5444_2d18), + (0.0, 0.0, 0), + (-0.0, 0.0, 0x8000_0000_0000_0000), + (0.0, -0.0, 0x4009_21fb_5444_2d18), + (-0.0, -0.0, 0xc009_21fb_5444_2d18), + (f64::INFINITY, f64::INFINITY, 0x3fe9_21fb_5444_2d18), + (f64::INFINITY, f64::NEG_INFINITY, 0x4002_d97c_7f33_21d2), + (f64::NEG_INFINITY, f64::INFINITY, 0xbfe9_21fb_5444_2d18), + (f64::NEG_INFINITY, f64::NEG_INFINITY, 0xc002_d97c_7f33_21d2), + (1.0, f64::INFINITY, 0), + (-1.0, f64::INFINITY, 0x8000_0000_0000_0000), + (1.0, f64::NEG_INFINITY, 0x4009_21fb_5444_2d18), + (-1.0, f64::NEG_INFINITY, 0xc009_21fb_5444_2d18), + (f64::INFINITY, 1.0, 0x3ff9_21fb_5444_2d18), + (f64::NEG_INFINITY, -1.0, 0xbff9_21fb_5444_2d18), + (1.0, 1.0, 0x3fe9_21fb_5444_2d18), + (1.0, -1.0, 0x4002_d97c_7f33_21d2), + (-1.0, 1.0, 0xbfe9_21fb_5444_2d18), + (-1.0, -1.0, 0xc002_d97c_7f33_21d2), + ] { + assert_eq!(atan2(y, x).to_bits(), bits, "{y}, {x}"); + } + assert!(atan2(f64::NAN, 1.0).is_nan()); + assert!(atan2(1.0, f64::NAN).is_nan()); + } + + #[test] + fn matches_moderate_ratios_with_libm_and_large_ratios_with_half_pi() { + for (y, x, bits) in [ + (0.1, -1e-20, 0x3ff9_21fb_5444_2d18), + (-0.1, -1e-20, 0xbff9_21fb_5444_2d18), + (1.0, -1e-20, 0x3ff9_21fb_5444_2d18), + (f64::MIN_POSITIVE, -1.0, 0x4009_21fb_5444_2d18), + ] { + assert_eq!(atan2(y, x).to_bits(), bits, "{y}, {x}"); + } + let mut samples = vec![ + (0.0, 1.0), + (-0.0, -1.0), + (f64::from_bits(1), 1.0), + (1.0, f64::from_bits(1)), + (f64::from_bits(1), f64::from_bits(1)), + (f64::from_bits(0x000f_ffff_ffff_ffff), 1.0), + (1e-20, -1.0), + (1.5, 1.0), + (3.0, 2.0), + (2.0, -1.0), + (-2.0, -1.0), + ]; + let mut state = 0x5eed_5a17u32; + for _ in 0..256 { + let y = f64::from_bits(next_bits(&mut state)); + let x = f64::from_bits(next_bits(&mut state)); + if exponent_gap(y, x).abs() <= 60 && y.is_finite() && x.is_finite() && x != 0.0 { + samples.push((y, x)); + } + } + for (y, x) in samples { + assert_eq!( + atan2(y, x).to_bits(), + libm::atan2(y, x).to_bits(), + "{y}, {x}" + ); + } + } + + fn exponent_gap(y: f64, x: f64) -> i32 { + let ix = (x.to_bits() >> 32) as u32 & 0x7fff_ffff; + let iy = (y.to_bits() >> 32) as u32 & 0x7fff_ffff; + (iy as i32).wrapping_sub(ix as i32) >> 20 + } + + fn next_bits(state: &mut u32) -> u64 { + let low = step(state); + let high = step(state); + u64::from(low) | (u64::from(high) << 32) + } + + fn step(state: &mut u32) -> u32 { + *state ^= state.wrapping_shl(13); + *state ^= state.wrapping_shr(17); + *state ^= state.wrapping_shl(5); + *state + } +} diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index dd5fe666..2b318732 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -165,7 +165,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { profile: "target-runtime", recipe: "tools/build.sh: --import-memory --global-base=65536 \ -zstack-size=65536 --export=__heap_base, then package", - sha256: "41064c763782dc2a184cfc1a47e0816e8dc0b9f8ea465320cc7c294b60807afe", + sha256: "e295fd40bcb247ee77b8890107b2dea74838ded7b383895ce8db7c428d0e7ac2", }, required_features: &[ "mutable-globals", @@ -205,6 +205,11 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { parameters: &[RawType::F64], result: Some(RawType::F64), }, + RawExport { + name: crate::ATAN2_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, ], global_exports: &[crate::HEAP_BASE_EXPORT], tables: &[RawTable { @@ -215,7 +220,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { elements: &[RawElement { table: 0, offset: 1, - functions: &[25], + functions: &[27], }], globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], storage: RawStorage { diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 1c5256ef..4f9af00b 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -29,6 +29,8 @@ mod asin; #[cfg(feature = "formatter")] mod atan; #[cfg(feature = "formatter")] +mod atan2; +#[cfg(feature = "formatter")] mod decimal; #[cfg(feature = "formatter")] mod formatter; @@ -39,6 +41,8 @@ pub use asin::number_asin; #[cfg(feature = "formatter")] pub use atan::number_atan; #[cfg(feature = "formatter")] +pub use atan2::number_atan2; +#[cfg(feature = "formatter")] pub use decimal::number_from_decimal; #[cfg(feature = "formatter")] pub use formatter::number_to_string; @@ -57,6 +61,8 @@ pub const ACOS_EXPORT: &str = "number_acos"; pub const ASIN_EXPORT: &str = "number_asin"; /// Exported raw inverse-tangent function. pub const ATAN_EXPORT: &str = "number_atan"; +/// Exported raw four-quadrant inverse-tangent function. +pub const ATAN2_EXPORT: &str = "number_atan2"; /// Lower addresses remain owned by the application's canonical ABI. pub const RESERVED_START: u32 = 65536; /// Static data must end before the separately reserved 64 KiB stack. @@ -134,3 +140,10 @@ pub const NUMBER_ATAN: RawFunctionAbi = RawFunctionAbi { result: Some(RawType::F64), protocol: RawCallProtocol::Scalars, }; + +pub const NUMBER_ATAN2: RawFunctionAbi = RawFunctionAbi { + export: ATAN2_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index f2aca6f0..1824525d 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -229,6 +229,18 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. operation does not trap. NaN payloads are not a public guarantee. It implements the official Data.Number.atan foreign slot and is not folded when its operand is constant. +- `NumberAtan2` (`numberAtan2 :: Number -> Number -> Number`) uses the same + checked scalar-runtime boundary with two Number arguments. The argument + order is `y` then `x`, matching official `Math.atan2`. The runtime follows + the fdlibm exponent-gap cutoff of 60 and calls the checked inverse-tangent + export for moderate ratios. An exponent gap above 60 returns a signed + half-pi, and a negative `x` whose gap is below -60 contributes zero before + the pi adjustment. libm 0.2.15's own two-argument routine uses a wider gap + and is not the oracle. Returned bits match official `Math.atan2`, including + the sign of zero. Either NaN produces NaN, and the operation does not trap. + NaN payloads are not a public guarantee. It implements the official + Data.Number.atan2 foreign slot and is not folded when its operands are + constant. Wasm has no two-argument inverse-tangent instruction. - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. - The current vocabulary has no `Number` remainder. If the standard library diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md index 0c87db03..86fa55d3 100644 --- a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -97,6 +97,7 @@ Library evidence, with the package fingerprint unchanged during each run: This refactor does not establish whole-stdlib runtime completion. Number square root has a separate checked `f64.sqrt` acceptance. Number inverse -cosine, inverse sine, and inverse tangent each have a separate checked -scalar-runtime acceptance. Other Number foreign slots remain without target -support until a fresh diagnosis names the next blocker. +cosine, inverse sine, inverse tangent, and four-quadrant inverse tangent +each have a separate checked scalar-runtime acceptance. Other Number foreign +slots remain without target support until a fresh diagnosis names the next +blocker. diff --git a/docs/implementation/stdlib/number-atan2-2026-10-08.md b/docs/implementation/stdlib/number-atan2-2026-10-08.md new file mode 100644 index 00000000..2abfc5bb --- /dev/null +++ b/docs/implementation/stdlib/number-atan2-2026-10-08.md @@ -0,0 +1,99 @@ +# Number four-quadrant inverse-tangent acceptance + +## Contract and implementation + +Starting compiler revision: e8b5b9a on stdlib/vendor-core-libraries, with a +clean worktree. The starting package was +f2cdf0341ccb166ed827723ee305095780e3b2b6 +(fnv1a64-v1:369a7661425142dc). The preceding inverse-tangent diagnosis recorded +that Number.atan2 0.0 1.0 stopped at P8 library linking because +Data.Number.atan2 had no target implementation. + +Wasm has no two-argument inverse-tangent instruction. The compiler owns +numberAtan2 :: Number -> Number -> Number. Its HIR identity is appended as 73, +preserving existing intrinsic IDs. Core and CC require Number operands and a +Number result. MIR calls the scalar export `number_atan2` in the shared +numeric runtime. Incorrect foreign binding schemes are rejected before ABI +erasure. + +The argument order is `y` then `x`, matching official Math.atan2. The export +uses the fdlibm exponent-gap cutoff of 60. A larger gap returns a signed +half-pi, and a negative `x` with a gap below -60 contributes zero before the +pi adjustment. Moderate ratios call the checked inverse-tangent primitive. +libm 0.2.15's own atan2 uses a wider gap. On 5721 pairs, that routine had 31 +finite mismatches against Math.atan2, all one ulp. The cutoff of 60 had 0 +finite mismatches and 0 NaN-payload mismatches on the same pairs. The pairs +were the edge product, an exponent sweep, and 256 random binary64 patterns. +Either NaN produces NaN. The operation does not trap. NaN payloads are not +part of the public contract. No constant folding is introduced. A whole +inverse-tangent algorithm does not become a compiler intrinsic. + +The numeric runtime retains its formatter, decimal conversion, inverse-cosine, +inverse-sine, and inverse-tangent exports and adds number_atan2. Its +reproducible artifact SHA-256 is +e295fd40bcb247ee77b8890107b2dea74838ded7b383895ce8db7c428d0e7ac2. +The private table still has two funcref slots. The active initializer now +points at function 27. Static stack analysis accepts the artifact and still +measures 1680 bytes inside the existing 65536-byte reserve. + +The independent library changes only the foreign slot's explicit binding: +`foreign import "psrs:intrinsic#numberAtan2" atan2 :: Number -> Number -> Number`. +Its signature, exports, and all official pure declarations remain unchanged. +The complete-module source verifier checks this transformation against pinned +purescript-numbers v9.0.1 (27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +## Package and runtime evidence + +Locked package: 767ffd7f5bbdbf1a2e1bc568b2dce88deeb5ce88 +(fnv1a64-v1:fe305ab57e585eca). + +```sh +node ../psrs-stdlib/conformance/number-atan2.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-atan2-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-atan2-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-atan2-runtime +env -u PSRS_STDLIB_ROOT ./target/debug/psrs build \ + /tmp/psrs-number-atan2-oracle/Main.purs -o /tmp/psrs-number-atan2-locked.wasm +wasmtime run /tmp/psrs-number-atan2-locked.wasm +``` + +The actual pinned official JS atan2 produces 289 input observations and 578 +checks, exercising direct public calls and higher-order calls. Inputs include +quadrant boundaries, both zero signs, both infinities, subnormals, large +ratios, nonfinite values, and 64 deterministically generated binary64 pairs. +Reciprocal observations distinguish zero signs. NaN checks do not require a +payload. Both the development-package run and the locked-package artifact +(sha256 59a9f6c3a30e84e307ef4d9b1ed970805c3026933ba7e87fde7cd9400e46883a) +return 42 with empty stdout and stderr. Wasmtime is 49.0.2. + +The same public atan2 0.0 1.0 probe now passes against the locked package, in +7758 ms. A fresh Number.cos 0.0 probe stops at P8 library linking because +Data.Number.cos has no target implementation (7575 ms). Both new diagnoses use +fnv1a64-v1:fe305ab57e585eca. The earlier atan2 failure used +fnv1a64-v1:369a7661425142dc, so the before and after diagnoses are not a +same-fingerprint compare. + +Node tooling: 11 passed, none skipped. The numeric runtime rebuild is +byte-for-byte reproducible. + +## Rust validation + +Two driver regressions pass with mandatory Wasmtime: public behavior, +including quadrant boundaries, zero signs, infinities, a large ratio, a +higher-order call, and the linked `number_atan2` export, and rejection of +invalid foreign contracts. The runtime unit tests check the public boundary +bit patterns, agreement with libm::atan2 on moderate ratios, and the large +ratio results that match Math.atan2. `cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. + +`PSRS_REQUIRE_WASMTIME=1 CARGO_INCREMENTAL=0 cargo test --workspace --offline --no-fail-fast` +finishes all 52 targets: 1707 passed, 3 failed, 5 ignored. The only failing +target is `psrs-driver --lib`. Its three failures are the established +baseline: `constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number`, and +`compiles_if_expression_through_cfg_to_structured_wasm`. No new failure +appeared. Full workspace validation is not green because of those baseline +failures. This change does not establish complete Number FFI support or +whole-standard-library runtime behavior. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index d71a9e04..527714ba 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -335,3 +335,20 @@ The generator invokes the pinned official atan FFI. Every finite input and both infinities match that FFI, and negative zero stays negative zero. NaN produces NaN. The compiler's checked numberAtan primitive calls the scalar numeric-runtime export. Wasm has no inverse-tangent instruction. + +For Number four-quadrant inverse tangent through the same public-call shape: + +```sh +node ../psrs-stdlib/conformance/number-atan2.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-atan2-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-atan2-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-atan2-runtime +``` + +The generator invokes the pinned official atan2 FFI. The arguments are `y` +then `x`. Quadrant boundaries, both zero signs, both infinities, and large +ratios match that FFI. Either NaN produces NaN. The compiler's checked +numberAtan2 primitive calls one scalar numeric-runtime export with two +Number arguments. Wasm has no two-argument inverse-tangent instruction. diff --git a/stdlib.lock.json b/stdlib.lock.json index 3dd27936..ede8d76a 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "f2cdf0341ccb166ed827723ee305095780e3b2b6", - "source_fingerprint": "fnv1a64-v1:369a7661425142dc" + "revision": "767ffd7f5bbdbf1a2e1bc568b2dce88deeb5ce88", + "source_fingerprint": "fnv1a64-v1:fe305ab57e585eca" } From d62332221185be898c1cac4699c1897eb297ce8c Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Thu, 8 Oct 2026 22:08:16 +0800 Subject: [PATCH 078/148] Support remaining Number primitives with upstream libm Add checked scalar implementations for the thirteen remaining Data.Number foreigns, including nullary numeric constants and the NaN predicate. Use unmodified libm 0.2.15 with red-zone use disabled for the runtime and its dependencies so static stack verification can measure explicit frames. Consolidate thin math exports in number.rs while retaining the existing atan2 compatibility implementation. Rebuild the artifact and update its checked catalog, trace digest, and acceptance documentation. Validation: formatting, strict workspace Clippy, artifact byte reproduction, all runtime/linker tests, and public Number/Show runtime checks passed. Official-FFI oracle runs passed 298 atan checks and 2680 remaining Number checks, retaining the documented one-ULP exclusions. Runtime integration used the explicit development psrs-stdlib package. The full workspace run retains three documented baseline driver failures; all other targets pass. --- crates/psrs-backend/src/abi/mod.rs | 51 +-- crates/psrs-backend/src/abi/reserved.rs | 77 ++++ .../src/bindings/primitives/mod.rs | 1 + crates/psrs-backend/src/linking/tests.rs | 40 +- .../psrs-backend/src/target_intrinsics/mod.rs | 13 + .../src/target_intrinsics/tests.rs | 2 + crates/psrs-backend/src/target_runtime/mod.rs | 91 +++++ crates/psrs-core/src/verify/expr/intrinsic.rs | 25 +- crates/psrs-core/src/verify/types/mod.rs | 15 +- crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/number_atan.rs | 6 +- .../src/tests/number_elementary.rs | 107 ++++++ crates/psrs-driver/src/tests/show.rs | 2 +- crates/psrs-hir/src/intrinsic/effects.rs | 4 +- crates/psrs-hir/src/intrinsic/mod.rs | 51 ++- crates/psrs-hir/src/intrinsic/registry.rs | 23 +- crates/psrs-linker/src/verify/tests.rs | 133 ++++++- crates/psrs-runtime/Cargo.toml | 2 +- .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 39117 -> 49204 bytes crates/psrs-runtime/src/acos.rs | 44 --- crates/psrs-runtime/src/asin.rs | 44 --- crates/psrs-runtime/src/atan.rs | 144 ------- crates/psrs-runtime/src/atan2.rs | 74 +--- crates/psrs-runtime/src/catalog.rs | 71 +++- crates/psrs-runtime/src/lib.rs | 140 ++++++- crates/psrs-runtime/src/number.rs | 351 ++++++++++++++++++ crates/psrs-runtime/tools/build.sh | 3 + .../psrs-runtime/tools/check-reproducible.sh | 3 + .../backend/fp/scalars-and-primitives.md | 49 ++- .../intrinsic-implementations-2026-10-07.md | 8 +- .../stdlib/number-atan-2026-10-08.md | 4 + .../stdlib/number-rest-2026-10-08.md | 112 ++++++ .../stdlib/runtime-libm-2026-10-08.md | 147 ++++++++ docs/workflow/stdlib-conformance.md | 20 + 34 files changed, 1443 insertions(+), 415 deletions(-) create mode 100644 crates/psrs-backend/src/abi/reserved.rs create mode 100644 crates/psrs-driver/src/tests/number_elementary.rs delete mode 100644 crates/psrs-runtime/src/acos.rs delete mode 100644 crates/psrs-runtime/src/asin.rs delete mode 100644 crates/psrs-runtime/src/atan.rs create mode 100644 crates/psrs-runtime/src/number.rs create mode 100644 docs/implementation/stdlib/number-rest-2026-10-08.md create mode 100644 docs/implementation/stdlib/runtime-libm-2026-10-08.md diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index 6e379b18..78f32d93 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -16,10 +16,13 @@ mod definitions; mod handles; pub(crate) mod layout; pub(crate) mod link; +mod reserved; #[cfg(test)] mod tests; mod validation; +pub(crate) use reserved::*; + use canonical::{ CanonicalType, FnAbi, Ownership, function_abi, function_abi_from_types, resolve as resolve_canonical, @@ -82,54 +85,6 @@ pub const HEADER_SIZE: u32 = 8; /// (`i64`/`f64`), so block headers and payloads stay aligned. pub const MIN_BLOCK: u32 = 8; -/// Reserved MIR symbol for the allocator synthesized after ABI memory layout -/// is known. Calls to this symbol become calls to the local `cabi_realloc` -/// function during Wasm lowering; it is never emitted as a core import. -pub(crate) const REALLOC_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 1); - -/// Reserved symbols for the string boundary helpers at the canonical ABI. -/// P10 synthesizes them as ordinary local Wasm functions; like -/// `REALLOC_SYMBOL` they are never emitted as core imports. -pub(crate) const STRING_TO_BYTES_SYMBOL: SymbolId = - SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 2); -pub(crate) const BYTES_TO_STRING_SYMBOL: SymbolId = - SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 3); - -/// Reserved MIR symbol for the synthesized `validate_step` helper. Like the -/// other boundary symbols it is never a core import. -pub(crate) const VALIDATE_STEP_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 4); - -/// Intrinsic symbols the MIR lowering reserves for the canonical ABI and the -/// string boundary. Any other intrinsic-symbol allocator (for example the -/// aggregate conversion helpers, which allocate downward from `u32::MAX`) must -/// skip these. -pub(crate) const NUMBER_TO_STRING_SYMBOL: SymbolId = - SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 5); - -pub(crate) const NUMBER_FROM_DECIMAL_SYMBOL: SymbolId = - SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 6); - -pub(crate) const NUMBER_ACOS_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 7); - -pub(crate) const NUMBER_ASIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 8); - -pub(crate) const NUMBER_ATAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 9); - -pub(crate) const NUMBER_ATAN2_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 10); - -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 10] = [ - REALLOC_SYMBOL, - STRING_TO_BYTES_SYMBOL, - BYTES_TO_STRING_SYMBOL, - VALIDATE_STEP_SYMBOL, - NUMBER_TO_STRING_SYMBOL, - NUMBER_FROM_DECIMAL_SYMBOL, - NUMBER_ACOS_SYMBOL, - NUMBER_ASIN_SYMBOL, - NUMBER_ATAN_SYMBOL, - NUMBER_ATAN2_SYMBOL, -]; - /// WASI interfaces and functions the backend itself references. The standard /// library names its own imports in source. pub mod names { diff --git a/crates/psrs-backend/src/abi/reserved.rs b/crates/psrs-backend/src/abi/reserved.rs new file mode 100644 index 00000000..633a90fa --- /dev/null +++ b/crates/psrs-backend/src/abi/reserved.rs @@ -0,0 +1,77 @@ +//! Symbols reserved from the high end of the intrinsic-symbol space. +//! +//! Allocators that count downward from `u32::MAX` must skip this set. The +//! numeric-runtime symbols are ordinary MIR imports of artifact exports. The +//! allocator and string-boundary symbols are synthesized locally and are never +//! core imports. + +use psrs_hir::{ModuleId, SymbolId}; + +/// Reserved MIR symbol for the allocator synthesized after ABI memory layout +/// is known. Calls to this symbol become calls to the local `cabi_realloc` +/// function during Wasm lowering; it is never emitted as a core import. +pub(crate) const REALLOC_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 1); + +/// Reserved symbols for the string boundary helpers at the canonical ABI. +/// P10 synthesizes them as ordinary local Wasm functions; like +/// `REALLOC_SYMBOL` they are never emitted as core imports. +pub(crate) const STRING_TO_BYTES_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 2); +pub(crate) const BYTES_TO_STRING_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 3); + +/// Reserved MIR symbol for the synthesized `validate_step` helper. Like the +/// other boundary symbols it is never a core import. +pub(crate) const VALIDATE_STEP_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 4); + +pub(crate) const NUMBER_TO_STRING_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 5); +pub(crate) const NUMBER_FROM_DECIMAL_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 6); +pub(crate) const NUMBER_ACOS_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 7); +pub(crate) const NUMBER_ASIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 8); +pub(crate) const NUMBER_ATAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 9); +pub(crate) const NUMBER_ATAN2_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 10); +pub(crate) const NUMBER_SIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 11); +pub(crate) const NUMBER_COS_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 12); +pub(crate) const NUMBER_TAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 13); +pub(crate) const NUMBER_EXP_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 14); +pub(crate) const NUMBER_LOG_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 15); +pub(crate) const NUMBER_POW_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 16); +pub(crate) const NUMBER_MIN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 17); +pub(crate) const NUMBER_MAX_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 18); +pub(crate) const NUMBER_SIGN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 19); +pub(crate) const NUMBER_REMAINDER_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 20); +pub(crate) const NUMBER_IS_NAN_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 21); +pub(crate) const NUMBER_NAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 22); +pub(crate) const NUMBER_INFINITY_SYMBOL: SymbolId = + SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 23); + +/// Every symbol this allocator must not reuse. +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 23] = [ + REALLOC_SYMBOL, + STRING_TO_BYTES_SYMBOL, + BYTES_TO_STRING_SYMBOL, + VALIDATE_STEP_SYMBOL, + NUMBER_TO_STRING_SYMBOL, + NUMBER_FROM_DECIMAL_SYMBOL, + NUMBER_ACOS_SYMBOL, + NUMBER_ASIN_SYMBOL, + NUMBER_ATAN_SYMBOL, + NUMBER_ATAN2_SYMBOL, + NUMBER_SIN_SYMBOL, + NUMBER_COS_SYMBOL, + NUMBER_TAN_SYMBOL, + NUMBER_EXP_SYMBOL, + NUMBER_LOG_SYMBOL, + NUMBER_POW_SYMBOL, + NUMBER_MIN_SYMBOL, + NUMBER_MAX_SYMBOL, + NUMBER_SIGN_SYMBOL, + NUMBER_REMAINDER_SYMBOL, + NUMBER_IS_NAN_SYMBOL, + NUMBER_NAN_SYMBOL, + NUMBER_INFINITY_SYMBOL, +]; diff --git a/crates/psrs-backend/src/bindings/primitives/mod.rs b/crates/psrs-backend/src/bindings/primitives/mod.rs index 1579fcfd..961c9855 100644 --- a/crates/psrs-backend/src/bindings/primitives/mod.rs +++ b/crates/psrs-backend/src/bindings/primitives/mod.rs @@ -81,6 +81,7 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), | IntrinsicCategory::StringToBytes | IntrinsicCategory::BytesToString ) && intrinsic != Intrinsic::UnsafeCoerce + && !matches!(intrinsic, Intrinsic::NumberNaN | Intrinsic::NumberInfinity) { return Err(error(format!( "primitive binding `{}` has no foreign-function implementation yet", diff --git a/crates/psrs-backend/src/linking/tests.rs b/crates/psrs-backend/src/linking/tests.rs index efc249f1..ea523bc4 100644 --- a/crates/psrs-backend/src/linking/tests.rs +++ b/crates/psrs-backend/src/linking/tests.rs @@ -33,27 +33,35 @@ fn actual_artifact_consumer_signatures_are_checked_before_emission() { assert!(plans(&module(provider.import()))); let good = provider.import(); let mut invalid = Vec::new(); - let mut wrong = good.clone(); - wrong.parameters[0] = if wrong.parameters[0] == ValueType::I32 { - ValueType::F64 + if good.parameters.is_empty() { + // A numeric constant has no parameter to retarget. An added argument is + // the arity mismatch that a unary export expresses by dropping one. + let mut wrong = good.clone(); + wrong.parameters.push(ValueType::F64); + invalid.push(wrong); } else { - ValueType::I32 - }; - invalid.push(wrong); - let mut wrong = good.clone(); - wrong.parameters.pop(); - invalid.push(wrong); + let mut wrong = good.clone(); + wrong.parameters[0] = if wrong.parameters[0] == ValueType::I32 { + ValueType::F64 + } else { + ValueType::I32 + }; + invalid.push(wrong); + let mut wrong = good.clone(); + wrong.parameters.pop(); + invalid.push(wrong); + let mut wrong = good.clone(); + wrong.parameters[0] = ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Any, + }); + invalid.push(wrong); + } let mut wrong = good.clone(); wrong.result = None; invalid.push(wrong); - let mut wrong = good.clone(); - wrong.result = Some(ValueType::I64); - invalid.push(wrong); let mut wrong = good; - wrong.parameters[0] = ValueType::Ref(RefType { - nullable: true, - heap: HeapType::Any, - }); + wrong.result = Some(ValueType::I64); invalid.push(wrong); for import in invalid { let module = module(import); diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 47b9aaa4..817b7a4e 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -101,6 +101,19 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::NumberAsin => Artifact(&target_runtime::NUMBER_ASIN), Intrinsic::NumberAtan => Artifact(&target_runtime::NUMBER_ATAN), Intrinsic::NumberAtan2 => Artifact(&target_runtime::NUMBER_ATAN2), + Intrinsic::NumberSin => Artifact(&target_runtime::NUMBER_SIN), + Intrinsic::NumberCos => Artifact(&target_runtime::NUMBER_COS), + Intrinsic::NumberTan => Artifact(&target_runtime::NUMBER_TAN), + Intrinsic::NumberExp => Artifact(&target_runtime::NUMBER_EXP), + Intrinsic::NumberLog => Artifact(&target_runtime::NUMBER_LOG), + Intrinsic::NumberPow => Artifact(&target_runtime::NUMBER_POW), + Intrinsic::NumberMin => Artifact(&target_runtime::NUMBER_MIN), + Intrinsic::NumberMax => Artifact(&target_runtime::NUMBER_MAX), + Intrinsic::NumberSign => Artifact(&target_runtime::NUMBER_SIGN), + Intrinsic::NumberRemainder => Artifact(&target_runtime::NUMBER_REMAINDER), + Intrinsic::NumberIsNaN => Artifact(&target_runtime::NUMBER_IS_NAN), + Intrinsic::NumberNaN => Artifact(&target_runtime::NUMBER_NAN), + Intrinsic::NumberInfinity => Artifact(&target_runtime::NUMBER_INFINITY), Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index b05836b1..138257ba 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -40,6 +40,8 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::NumberAsin, 71), (Intrinsic::NumberAtan, 72), (Intrinsic::NumberAtan2, 73), + (Intrinsic::NumberSin, 74), + (Intrinsic::NumberInfinity, 86), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index feadc792..6521364d 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -61,6 +61,97 @@ pub(crate) const NUMBER_ATAN2: ArtifactImplementation = ArtifactImplementation { artifact: &psrs_runtime::NUMBER_RUNTIME, }; +pub(crate) const NUMBER_SIN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberSin, + symbol: crate::abi::NUMBER_SIN_SYMBOL, + abi: &psrs_runtime::NUMBER_SIN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_COS: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberCos, + symbol: crate::abi::NUMBER_COS_SYMBOL, + abi: &psrs_runtime::NUMBER_COS, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_TAN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberTan, + symbol: crate::abi::NUMBER_TAN_SYMBOL, + abi: &psrs_runtime::NUMBER_TAN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_EXP: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberExp, + symbol: crate::abi::NUMBER_EXP_SYMBOL, + abi: &psrs_runtime::NUMBER_EXP, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_LOG: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberLog, + symbol: crate::abi::NUMBER_LOG_SYMBOL, + abi: &psrs_runtime::NUMBER_LOG, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_POW: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberPow, + symbol: crate::abi::NUMBER_POW_SYMBOL, + abi: &psrs_runtime::NUMBER_POW, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_MIN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberMin, + symbol: crate::abi::NUMBER_MIN_SYMBOL, + abi: &psrs_runtime::NUMBER_MIN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_MAX: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberMax, + symbol: crate::abi::NUMBER_MAX_SYMBOL, + abi: &psrs_runtime::NUMBER_MAX, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_SIGN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberSign, + symbol: crate::abi::NUMBER_SIGN_SYMBOL, + abi: &psrs_runtime::NUMBER_SIGN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_REMAINDER: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberRemainder, + symbol: crate::abi::NUMBER_REMAINDER_SYMBOL, + abi: &psrs_runtime::NUMBER_REMAINDER, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_IS_NAN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberIsNaN, + symbol: crate::abi::NUMBER_IS_NAN_SYMBOL, + abi: &psrs_runtime::NUMBER_IS_NAN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_NAN: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberNaN, + symbol: crate::abi::NUMBER_NAN_SYMBOL, + abi: &psrs_runtime::NUMBER_NAN, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + +pub(crate) const NUMBER_INFINITY: ArtifactImplementation = ArtifactImplementation { + intrinsic: Intrinsic::NumberInfinity, + symbol: crate::abi::NUMBER_INFINITY_SYMBOL, + abi: &psrs_runtime::NUMBER_INFINITY, + artifact: &psrs_runtime::NUMBER_RUNTIME, +}; + /// The registered implementation for a MIR import symbol, if any. pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementation> { crate::target_intrinsics::artifacts().find(|implementation| symbol == implementation.symbol) diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 454f90a7..92b3da9c 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -5,9 +5,10 @@ //! rules as the expressions they replaced. A mismatch is a lowering bug rather //! than a source error, so every check is an internal verification error. -use super::super::types::{primitive_types, unary_primitive_types}; -use super::{Context, compatible}; -use crate::Expr; +use super::super::types::{primitive_type_id, primitive_types, unary_primitive_types}; +use super::super::{compatible, error}; +use super::Context; +use crate::{Expr, TypeConstructor}; use psrs_hir::{Intrinsic, IntrinsicCategory}; impl Context<'_> { @@ -33,6 +34,24 @@ impl Context<'_> { } Intrinsic::StringToBytes => self.verify_string_to_bytes(expression, &arguments[0]), Intrinsic::BytesToString => self.verify_bytes_to_string(expression, &arguments[0]), + Intrinsic::NumberNaN | Intrinsic::NumberInfinity => { + if !arguments.is_empty() { + self.errors.push(error( + self.owner, + expression.span, + "a numeric constant has no arguments", + )); + } + let result = primitive_type_id(self.module, TypeConstructor::Number); + compatible( + result, + expression.ty, + self.module, + self.owner, + expression.span, + self.errors, + ); + } _ => match intrinsic.descriptor().category { IntrinsicCategory::BinaryScalar => { let (operand, result) = primitive_types(intrinsic, self.module); diff --git a/crates/psrs-core/src/verify/types/mod.rs b/crates/psrs-core/src/verify/types/mod.rs index c77e5258..a75007b1 100644 --- a/crates/psrs-core/src/verify/types/mod.rs +++ b/crates/psrs-core/src/verify/types/mod.rs @@ -50,7 +50,11 @@ pub(super) fn primitive_types(intrinsic: Intrinsic, module: &Module) -> (TypeId, | Intrinsic::NumberSub | Intrinsic::NumberMul | Intrinsic::NumberDiv - | Intrinsic::NumberAtan2 => (Number, Number), + | Intrinsic::NumberAtan2 + | Intrinsic::NumberPow + | Intrinsic::NumberMin + | Intrinsic::NumberMax + | Intrinsic::NumberRemainder => (Number, Number), Intrinsic::NumberEq | Intrinsic::NumberNe | Intrinsic::NumberLt @@ -83,7 +87,14 @@ pub(super) fn unary_primitive_types(intrinsic: Intrinsic, module: &Module) -> (T | Intrinsic::NumberSqrt | Intrinsic::NumberAcos | Intrinsic::NumberAsin - | Intrinsic::NumberAtan => (Number, Number), + | Intrinsic::NumberAtan + | Intrinsic::NumberSin + | Intrinsic::NumberCos + | Intrinsic::NumberTan + | Intrinsic::NumberExp + | Intrinsic::NumberLog + | Intrinsic::NumberSign => (Number, Number), + Intrinsic::NumberIsNaN => (Number, Boolean), Intrinsic::BooleanNot => (Boolean, Boolean), Intrinsic::IntToNumber => (Int, Number), Intrinsic::NumberToInt => (Number, Int), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 2c04c83a..e9a6eb87 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -26,6 +26,7 @@ mod number_asin; mod number_atan; mod number_atan2; mod number_decimal; +mod number_elementary; mod number_rounding; mod number_sqrt; mod number_trunc; diff --git a/crates/psrs-driver/src/tests/number_atan.rs b/crates/psrs-driver/src/tests/number_atan.rs index 99548090..c5608766 100644 --- a/crates/psrs-driver/src/tests/number_atan.rs +++ b/crates/psrs-driver/src/tests/number_atan.rs @@ -11,7 +11,11 @@ apply f value = f value positiveInfinity = 1.0 / 0.0 negativeInfinity = negative positiveInfinity nan = 0.0 / 0.0 -checks = Number.atan 0.0 == 0.0 +tiny = 5.0e-324 +checks = tiny > 0.0 + && Number.atan tiny == tiny + && Number.atan (negative tiny) == negative tiny + && Number.atan 0.0 == 0.0 && 1.0 / Number.atan 0.0 == positiveInfinity && 1.0 / Number.atan (negative 0.0) == negativeInfinity && Number.atan 1.0 == 0.7853981633974483 diff --git a/crates/psrs-driver/src/tests/number_elementary.rs b/crates/psrs-driver/src/tests/number_elementary.rs new file mode 100644 index 00000000..4c2e3591 --- /dev/null +++ b/crates/psrs-driver/src/tests/number_elementary.rs @@ -0,0 +1,107 @@ +use super::*; + +#[test] +fn public_number_elementary_functions_match_javascript_special_cases() { + let source = r#" +module Main where +import Prelude +import Data.Number as Number +foreign import "psrs:intrinsic#numberNeg" negative :: Number -> Number +positiveInfinity = 1.0 / 0.0 +negativeInfinity = negative positiveInfinity +zero = Number.sin 0.0 == 0.0 + && 1.0 / Number.sin 0.0 == positiveInfinity + && 1.0 / Number.sin (negative 0.0) == negativeInfinity + && Number.cos 0.0 == 1.0 + && Number.tan 0.0 == 0.0 + && 1.0 / Number.tan (negative 0.0) == negativeInfinity + && Number.exp 0.0 == 1.0 + && Number.log 1.0 == 0.0 + && Number.log positiveInfinity == positiveInfinity + && Number.log 0.0 == negativeInfinity + && Number.isNaN (Number.log (negative 1.0)) + && Number.isNaN Number.nan + && Number.isNaN (Number.cos positiveInfinity) + && not (Number.isNaN 0.0) + && not (Number.isNaN Number.infinity) + && Number.infinity == positiveInfinity + && negative Number.infinity == negativeInfinity + && Number.min 1.0 2.0 == 1.0 + && Number.max 1.0 2.0 == 2.0 + && 1.0 / Number.min (negative 0.0) 0.0 == negativeInfinity + && 1.0 / Number.max (negative 0.0) 0.0 == positiveInfinity + && 1.0 / Number.max (negative 0.0) (negative 0.0) == negativeInfinity + && Number.isNaN (Number.min Number.nan 1.0) + && Number.isNaN (Number.max 1.0 Number.nan) + && Number.pow 3.0 2.0 == 9.0 + && Number.pow Number.nan 0.0 == 1.0 + && Number.isNaN (Number.pow 1.0 Number.nan) + && Number.isNaN (Number.pow 1.0 Number.infinity) + && Number.isNaN (Number.pow (negative 1.0) negativeInfinity) + && Number.remainder 5.3 2.0 == 1.2999999999999998 + && 1.0 / Number.remainder (negative 1.0) 1.0 == negativeInfinity + && Number.isNaN (Number.remainder 1.0 0.0) + && Number.isNaN (Number.remainder positiveInfinity 1.0) + && Number.sign 4.0 == 1.0 + && Number.sign (negative 4.0) == negative 1.0 + && Number.sign Number.infinity == 1.0 + && Number.sign negativeInfinity == negative 1.0 + && 1.0 / Number.sign (negative 0.0) == negativeInfinity + && Number.isNaN (Number.sign Number.nan) +main :: Int +main = if zero then 42 else 1 +"#; + let artifact = compile_program_sources_with_prelude(&[("Main.purs", source)]) + .expect("remaining Number foreigns should compile"); + for export in [ + "number_sin", + "number_cos", + "number_tan", + "number_exp", + "number_log", + "number_pow", + "number_min", + "number_max", + "number_sign", + "number_remainder", + "number_is_nan", + "number_nan", + "number_infinity", + ] { + assert!( + artifact + .wasm + .windows(export.len()) + .any(|window| window == export.as_bytes()), + "{export} should be linked" + ); + } + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stdout.is_empty() && output.stderr.is_empty()); +} + +#[test] +fn number_constants_and_predicates_require_their_checked_types() { + for (binding, ty) in [ + ("numberNan", "Int"), + ("numberInfinity", "Int"), + ("numberIsNaN", "Number -> Number"), + ("numberRemainder", "Int -> Number -> Number"), + ("numberPow", "forall a. a -> a -> a"), + ] { + let source = format!( + "module Main where\nforeign import \"psrs:intrinsic#{binding}\" value :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("the binding requires its checked Number contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking"), + "{binding} {ty}: {errors:?}" + ); + } +} diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index 6fe3a588..02e94bd7 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -121,7 +121,7 @@ main = let ignored = log (show 1.0e21) in 0 let digests = parameter("artifact_digests").expect("artifact digests are recorded"); assert!(digests.contains("psrs:runtime-number"), "{digests}"); assert!( - digests.contains("e295fd40bcb247ee77b8890107b2dea74838ded7b383895ce8db7c428d0e7ac2"), + digests.contains("75cdd69833e058d014942eafdcd668eb9150e8d098a791871c327daf7bb20c73"), "{digests}" ); assert!( diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index dcb26a7c..4613d5e7 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -29,7 +29,9 @@ impl IntrinsicEffects { | NumberGe | BooleanAnd | BooleanOr | BooleanEq | BooleanNe | CharEq | CharNe | CharLt | CharLe | CharGt | CharGe | Coerce | Unit | NumberTrunc | NumberFloor | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin | NumberAtan - | NumberAtan2 => Self::default(), + | NumberAtan2 | NumberSin | NumberCos | NumberTan | NumberExp | NumberLog + | NumberPow | NumberMin | NumberMax | NumberSign | NumberRemainder | NumberIsNaN + | NumberNaN | NumberInfinity => Self::default(), } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index d70c3d79..8a8a3822 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -130,6 +130,40 @@ pub enum Intrinsic { /// of both arguments select the quadrant. Negative zero is preserved when /// the result is zero. Either NaN produces NaN. The operation does not trap. NumberAtan2 = 73, + /// Sine in radians. Infinities produce NaN. The operation does not trap. + NumberSin = 74, + /// Cosine in radians. Infinities produce NaN. The operation does not trap. + NumberCos = 75, + /// Tangent in radians. Infinities produce NaN. The operation does not trap. + NumberTan = 76, + /// Base-e exponential. Overflow produces infinity and underflow produces + /// zero. NaN produces NaN. The operation does not trap. + NumberExp = 77, + /// Natural logarithm. A negative finite input produces NaN, and + /// either signed zero produces negative infinity. The operation does not trap. + NumberLog = 78, + /// Exponentiation. A NaN exponent, or ±1 raised to an infinity, produces + /// NaN. An exponent of zero produces 1, including a NaN base. The + /// operation does not trap. + NumberPow = 79, + /// The smaller number. Either NaN produces NaN. A zero result is negative + /// when either zero is negative. The operation does not trap. + NumberMin = 80, + /// The larger number. Either NaN produces NaN. A zero result is negative + /// only when both zeros are negative. The operation does not trap. + NumberMax = 81, + /// Sign: NaN and both zeros are unchanged, and every other value becomes + /// ±1. The operation does not trap. + NumberSign = 82, + /// JavaScript remainder. The sign follows the dividend. Division by zero + /// or an infinite dividend produces NaN. The operation does not trap. + NumberRemainder = 83, + /// NaN predicate. The Boolean result is true for every NaN payload. + NumberIsNaN = 84, + /// Canonical NaN value. + NumberNaN = 85, + /// Positive infinity. + NumberInfinity = 86, } impl Intrinsic { @@ -155,7 +189,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. `bootstrap_externals` builds the /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 72] = [ + pub const ALL: [Intrinsic; 85] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -228,6 +262,19 @@ impl Intrinsic { Intrinsic::NumberAsin, Intrinsic::NumberAtan, Intrinsic::NumberAtan2, + Intrinsic::NumberSin, + Intrinsic::NumberCos, + Intrinsic::NumberTan, + Intrinsic::NumberExp, + Intrinsic::NumberLog, + Intrinsic::NumberPow, + Intrinsic::NumberMin, + Intrinsic::NumberMax, + Intrinsic::NumberSign, + Intrinsic::NumberRemainder, + Intrinsic::NumberIsNaN, + Intrinsic::NumberNaN, + Intrinsic::NumberInfinity, ]; } @@ -237,7 +284,7 @@ impl Intrinsic { const _: () = { assert!( Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberAtan2 as u32 as usize + 1, + == Intrinsic::NumberInfinity as u32 as usize + 1, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index b2410650..eaa19d2f 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -16,7 +16,7 @@ use psrs_span::TextRange; /// term it is, not how any one stage emits it. #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub enum IntrinsicCategory { - /// A nullary value: `true`, `false`, `unit`. + /// A nullary value: `true`, `false`, `unit`, or a numeric constant. Nullary, /// One language argument and a language result. Unary, @@ -114,6 +114,19 @@ descriptors! { NumberAsin => "numberAsin", 1, Unary, scheme::number_number; NumberAtan => "numberAtan", 1, Unary, scheme::number_number; NumberAtan2 => "numberAtan2", 2, BinaryScalar, scheme::number_number_number; + NumberSin => "numberSin", 1, Unary, scheme::number_number; + NumberCos => "numberCos", 1, Unary, scheme::number_number; + NumberTan => "numberTan", 1, Unary, scheme::number_number; + NumberExp => "numberExp", 1, Unary, scheme::number_number; + NumberLog => "numberLog", 1, Unary, scheme::number_number; + NumberPow => "numberPow", 2, BinaryScalar, scheme::number_number_number; + NumberMin => "numberMin", 2, BinaryScalar, scheme::number_number_number; + NumberMax => "numberMax", 2, BinaryScalar, scheme::number_number_number; + NumberSign => "numberSign", 1, Unary, scheme::number_number; + NumberRemainder => "numberRemainder", 2, BinaryScalar, scheme::number_number_number; + NumberIsNaN => "numberIsNaN", 1, Unary, scheme::number_bool; + NumberNaN => "numberNan", 0, Nullary, scheme::number; + NumberInfinity => "numberInfinity", 0, Nullary, scheme::number; NumberCeil => "numberCeil", 1, Unary, scheme::number_number; BooleanNot => "booleanNot", 1, Unary, scheme::boolean_boolean; IntToNumber => "intToNumber", 1, Unary, scheme::int_number; @@ -282,6 +295,14 @@ mod scheme { unary(BuiltinType::Number, BuiltinType::Number) } + pub(super) fn number_bool() -> Type { + unary(BuiltinType::Number, BuiltinType::Boolean) + } + + pub(super) fn number() -> Type { + builtin(BuiltinType::Number) + } + pub(super) fn boolean_boolean() -> Type { unary(BuiltinType::Boolean, BuiltinType::Boolean) } diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index 23f97164..c574648c 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -12,22 +12,18 @@ fn number_format_contract() -> ArtifactContract { elements: vec![crate::DeclaredElement { table: 0, offset: 1, - functions: vec![27], + functions: vec![54], }], id: "psrs:runtime-number".into(), kind: ArtifactKind::CoreModule, module_name: psrs_runtime::MODULE_NAME.into(), sha256: psrs_runtime::NUMBER_RUNTIME.provenance.sha256.into(), provenance: "test".into(), - required_features: [ - "mutable-globals", - "sign-extension", - "bulk-memory", - "reference-types", - ] - .into_iter() - .map(str::to_string) - .collect(), + required_features: psrs_runtime::NUMBER_RUNTIME + .required_features + .iter() + .map(|feature| (*feature).to_string()) + .collect(), imports: vec![DeclaredImport { module: psrs_runtime::MEMORY_MODULE.into(), field: psrs_runtime::MEMORY_FIELD.into(), @@ -87,6 +83,110 @@ fn number_format_contract() -> ArtifactContract { result: Some(CoreType::F64), }), }, + DeclaredExport { + name: psrs_runtime::SIN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::COS_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::TAN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::EXP_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::LOG_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::POW_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::MIN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::MAX_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::SIGN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::REMAINDER_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::F64], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::IS_NAN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![CoreType::F64], + result: Some(CoreType::I32), + }), + }, + DeclaredExport { + name: psrs_runtime::NAN_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![], + result: Some(CoreType::F64), + }), + }, + DeclaredExport { + name: psrs_runtime::INFINITY_EXPORT.into(), + kind: ExportKind::Func, + signature: Some(CoreSignature { + parameters: vec![], + result: Some(CoreType::F64), + }), + }, ], tables: vec![DeclaredTable { element: "funcref".into(), @@ -252,7 +352,18 @@ fn a_valid_but_undeclared_eager_initializer_is_rejected() { let text = wasmprinter::print_bytes(psrs_runtime::NUMBER_RUNTIME.bytes).unwrap(); let prefix = text.trim_end().strip_suffix(')').unwrap(); let bytes = wat::parse_str(format!("{prefix}(func $eager) (start $eager))")).unwrap(); - wasmparser::Validator::new() + // The pinned numeric artifact uses saturating truncation. The default + // validator leaves that proposal off, so this check uses the same feature + // set as static stack analysis. + use wasmparser::WasmFeatures as F; + let features = F::MVP + | F::MUTABLE_GLOBAL + | F::SIGN_EXTENSION + | F::SATURATING_FLOAT_TO_INT + | F::MULTI_VALUE + | F::BULK_MEMORY + | F::REFERENCE_TYPES; + wasmparser::Validator::new_with_features(features) .validate_all(&bytes) .expect("valid initializer module"); let mut contract = number_format_contract(); diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml index 76225027..063b0da0 100644 --- a/crates/psrs-runtime/Cargo.toml +++ b/crates/psrs-runtime/Cargo.toml @@ -18,7 +18,7 @@ formatter = ["dep:ryu-js", "dep:libm"] [dependencies] ryu-js = { version = "=1.0.2", default-features = false, optional = true } -libm = { version = "=0.2.15", optional = true } +libm = { version = "=0.2.15", default-features = false, optional = true } [dev-dependencies] wasm-encoder = { workspace = true, features = ["wasmparser"] } diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index f83eadeca7e190932b885b824900e606ff4cec7a..2a08c5558f3893fca29206279e469af92b703be1 100755 GIT binary patch delta 11848 zcmcIq4RjRMy}x&6_9L0yWD^nyMC8tZ5J@4Rd__Kz2`fIdsHkA|wS^=E$c8{j0-^>c zl9W=dwYYsMc|Nuxr4@7#O;_y2YOUo+3`Qyy+tL#(=`ku%2l&-v(G`uHH@Z7X>jw|7l3&-U5$;r2?U z&BkrTZeuIeHrZC~wq4(zw5#pxiUso(RaG@r_4xy;ruj8A)nHb(&O+fFG*vZM!*B!* zEiZpWenEbAcHu}CW=ej3{-~l|J)@WZS}D-iZ)&WmYhF=ZyP<{gbg!j;JyX)X*6Q_4 z4S6%sJCAAEZkN{iyiVPgCgzXl@j^S0>yFp2UtPbxzV&(*410H4R;&lWEN{`e4Qp7o z*J-TY!t`_pScJR|tqFUbrVZDzoQMmsxvsIge*LPtW|r%ryr!jo&3YE`rV}}NUWcg3 z_tv&6Rt&?96-{LcDokbyedy{RYcTwST8L3b@p_MI#zP}tt!sd1@958 zr=$0)AZ-uC{|RPo8fIs&o~Gc0tw%X;bFnyK8wyY))S+jjQ zq6M8KLH zSTg3pA82!d6t|R^P=#h4W9u3$-de^UjPD9u%^!>(4@}1Yf?zK{5q~LI&I{r>Suy@f z{Q4}D7j)m9wOT72CA63k2x&SXaN)F$jAm+<(psWC`Ko66!2_GHGlD|3w#E)w zMU98dED>n1jck#HdBmjF2J7`#L9H%)M#y4DSgn-DB3pz3^wRWsVa&)Os`V0u?Kg6C z5fVA&5KPDl#*C2AEeV78V1`9-NtoflSZb^A#jGvB0FblQN>}}C0w#i3hW#+2tCb>0 zgi8q={-qKa4bifY2ov})IIR<8{UUS}AnRZdGzkYY6a&sij#4SIVO}tX9f^%145D&elA9K!PAU7%BH0D~O@~s6Q_3ub zi2@-3h$5moOl%BG;>{3f)d8X~G6o|1gR zMqmrb2PYsu+ZweA>aFOOVg$hd(P=dMD^_0^)-d9bkzQnmLLFlG=)+5w})uaL-w>>>0ZsRyhxQNYx0@CSp{M!r_5w7jD?0 zuh8cxwg_#+PB@pOP%5}H8U!g9g*~q@P$6=_Wf2bZG|O-g62e_VJz$Kc{XMBmpMt(0 zjKon4T>@$3ifmhIqSSn;PGPV^=*{3$2&6*^+DHlfppF)i9s|9!Zl#4{guqJzjN@Dg zWi<+=kfiz=-K0LOhbJCq5Z=@M|XO#Kp_7J)Iv&)Q3Zt9iu~LsHE~3h6$oG z7Z6!7P*9@0@~XBUHo(I0iM&r#-eXH)V6!7b)ruPdG3JZ$y$A;uG6W2G)XM-OiIGc5HPo4H!{zqqsiVR91}u( zzc(X&QbXW#o>AywD-94x%~)rI-9?U4KvS}%af7WCB;@@mX)pn?SsPb_=5 zr2}8HrNE&}B4qLg@WU?xi;GEG!3+`LaJY6Hn})3Z*EOq17pMP zUT`tsblR%wge6&VC|F2vh)JF#%~3>}>~bJubKvO6o$UA-W*m|ZyHqK*$ms%dql<|f zzEU-T(ICwY(oNh;-o zS`2PjwE`RU2Vg#6NF)omH5j-U%EqnjTP_W&>A-2Fnlk9_fuU z0kPQqRWo+v&SIvs#*8WJR8 zn<{%5Q1tE%WJZkD6uL4)t%5bBPe3RZD7oL%cA7979hVbtsw#dcd>w+fRl$_gXN%B& z*wIT)!dCTrRG-8S7%FXP#!4)m+3mqAB@}0e!OsTS^010soPfAW>@-yX?i*B>Vw$?w zAg2YVfg6S<_};Y1W|GD<9nvDF#Nw68H8TGFh#5qI|0&q<~kYDBB*-%;5ji< zvkErH_M1NNssD7<)W24wFfuq;vC+EcP}iUe&Wjy@M=0lZboRRJ9OzA$Q1j^KdDqYU zp!~i0DPe>29xruXZk)(QEash@u+Ap`2?x{&?90ExzWMEMpLm)9lm!^T}+{d z_k}JD4)zX`K0!Z&F(i3H@KUu1b{v-=PKeD*l!&En%+VB8>&U1%fr zmJ|t=GBvOwx|lFu_Bioes4lKx7AQwHBD56lN84V0{@M%v{LcJT^!>X_Z~p5$*B%6G zFc{r>df(MY$3C$j6@9t-&}cisC-;IGzdRAi%gei|0-Q*ugqlnc5_DV%2{awd2#^0? z9Be}38*w1&IYki)>GMa#T|&V@Lj|7B7X+(cPcSA7BY45G-ya~_&4cIT5VL#r>Mjt zc1lT`t$_+?m_kR9c;<%~(;5wFs*ZL+&(x6p&s45qyw1=q)zdAT(D`R6*Wb}C6+#>V zU6RKPy6(zNjn_vWQ4(*)C+1y0eJ<`sWV&8r>QziAGUeu;A#bmwOulHVneC0mkL2BE zKNR%A-E8xb%b_fGT7#)LR>KoNN+__}uph9bt_AT~CtvDm*Q5nOB=zWzKa?FbPaZz@ zBiz@}bnS@(>B9Z{afwib3bbZJ0p$foWyl?Mc$hwTh;{ZFTqv;RT*klf4U~svQRKlz zmS^;utQ4jpINoSvBY+ADKfFjbMW%}2n% zN~tPW2q<5)LCJEA8aaZEP)Zvf3Pc(yJ>oR?p8|onAa2 z<|YDUf$FJ;o@v(>g)>=TsY3v#*=>K$m*_nGv-sX!cFyrL@JUAHZMy41WY*SUt0g+_ zv|;F^@6uv8CfCuQJUn4hm}+u9>&u63@i?hg*;m`dMhh7S3BV&bD}!DA!_ae>h`VX@ zwhddH!L9yb=(&p>ZUH@D;KXZ|eI}64D~4EpG<9+Q?*_3~L(PhJHKes#o+x?gUPzOa&@O zA2@kaO`4k9#juuyv&Q+6-{?;ZpMf*|!iICdZt0kcg^-~MeGF8l&<4ow3D0oRFE z^rbmF4<7&GS3Rld@Ap02bI;$51(<#R6?eB^w(WL=3z!d@QwWRn|3+{EgXRW75g7zg zAgxqYAUaf)$}_(4gKDm=S@-?nu1?pSfr@HU3d0u)k~jLG{0l^lJ1SR&74%+w^oBP| z$M5K?rIg>ZB#GY&w&%BV6qu>WiZ;e2nE?b=ES)yx<;db6$`#Hj)vU)}f914Fp_WF$ zg8iYoBnP@1*x@y7;f0wHsHduiQ8g`XjSQjzi@2YW+9K?-5C9F>e` zlxg@#F*p`@w;)kycv=_ri&q0WJHHmqF8x)xffZS zlfys4FpfQD`@`hnXjL3_fd`?@}n?-q>J-AZ2H^)h%a*H>3O*ZWVqM z$t+6j-D$E&hccUgI0sxz7J*EcM67g(Z*PlH?JK zXVWI_TWAw%_6^?XH7kKUnKx8^ImWO*L=Obqc>$768WSTIfPuj^uEaw*3iGlb6E*;N zdUJaXH!~+5wckcUg6VQNQMr(kLW&-+8(VA!iw)QlnU~op^8|}!bXBp@#4{2?r`hmX z&t8Yr8AD)F!KRoO%b+BF+rAtp_VQa_{MXdWpbH3HNaJWR7>mVNgAx-?bP$HZ^p~oA zZ)DhF^dEdfqqB|d*WMwNo^<|eMv&Vo0!}1p=3#X{l*!_oV}P7!S7f%_YvzkQGS7KE zGG=S)=rxs85?Y*}6p;i*k`A$$5^?DdRwgixRWQ|gB2Q+>WVG?M>0k7NOE0{*WZToo zf$Ls-Dt_^f=g4MoYwWLAw!T2kB@=I3x@_6Y)EvBT!)w27e2tpw`Sdx8X2Q%*457nl zm;AKF3-%>MB$>n{>^>3p|nN!n=N`WRs-EE#I2=m4u@P0&ShRfIuR_(|6*w>eLx$1$x}`7>&%P-_u>W3&0O5M- z$@&s|pxlskG6_}Y5PSkBm&wlnMa{0)Cr%I(@I*-(xg8*eTsW2ZoXRXRM}!nGnszQi zM}s_e8jetC7l&O6tUsc31_^}HF0YwPJLKtl0HJiD8?yK!@^p&+JI-Y`{SVdPY)Ip4 zi*K?_QzT>og>Q_UlP+#0GiyKXZn4QloE%CL|y)r+1N!lldTbm}I zM2vcT@4$Jv2l8pEy*6^|n9n9oqjq6O|LG@RyPBHu&h^KSPTWq-(^hx!?~?bSDZdHR zmoNfgjwZE2AvQ4iLBTz+2RacL@4pn2?T&njf4->H!3HqX4YpKs`%!V`OD${)F;qWr%R9KwGG|xJBTa zuof+fKgYAb1!dLnfDAbeErYsV2Fps#K6V*k0XlLgJgb_lgvP|*<)uMQ`c0w6i5L$)0psL1ZY#5LP_Q9RdbbWK*vb##q|v7|3o(#ds`kHuyb3(?gWu@3 zzo{ij0w(LiZABVK`Q(ulRL)9LQQb{Bn0`#rd@|X<Qyi<5G#HJ8J{g}M7U6w7n?rs9&Kp)mx7f( zJR&lEd%*_{i?k{kP&=!FF!~x+1v6J|6{_%WHMQ-O4dbmItj3|ECo=xMc+bShQo+0` zz5@pz;4oRcs(7nGZ(rbXU>3@2R2q|b(LcMxDRR(+4=$$oMGay~x`0XvdRJHBMV` z4B;V@pE(N?Uh8ner0kgrU7u6*!)=t(ol?t@`FIA9G<`kZQ?v#v4<3O)11hariIN!2 z@+H9pHQLgoPQ7{bp1E|?{7K=1atvEPoni>T<3eZ!uyIxp2!eTNaa5es)p28a3OdO> z7;f536-@Ano^i{H6Lt_<66F>>j|MnSyv3XGe$kY8*Qjep9q97K&Q(d1;B2lpgFBF@ z(o0x+(YO(>e4xdwcPG2!@_zUHqDOe>;dTugk5aG-DB76w^YJ!b`UdnFWr}$Am?@!W zGj7MX55Muqn5xk0fTR*6!Y8YEeEwa>G~_AzX2S;-@-p6aEWV(4xzhDc{ElMFci;mp zQWk%`xY_snx2SdHS5_3*xRX-j4skxCdzCSQ z^O^B2=DqkocKmEUvwPY2K23b`mV8CbZ*8NO8G@F4MQm_T-6-D^`{b?o%#y1VTy7~T zne*ve+67D=U2qg7R>i{WU~0_5y9o`E^P$UBj7Awj)pMBj=uyr37~GFcVcoBn{JY{i zaa4;;?QSdmg8OzJqvnlM>U_Q@LEY5&JLmm^m&b28f93d{hkPQKLf(ZE3Jw%x6xa(p zV-38iIWmEqa%LP;b{>jwbII1|FO)=SR-#zGluO9=`oB=M)5L`p(0=`?>PBxm~ub zrLMW9tfqcb+0@$V<~1A2n(Nlos zwXxklwPmXtH>{f4+`^cOeJ4Qm zb^LtzEp}gUof3a~uCCz*>wbCelauYYF>e)m3-F_PDt^Xy*HJeb^8nK z{jsOnx%YaG|ep5Hc$Wj!;AExK$!yJvL;oATZY_Pa@&*gNk( z!RFuiA^WU6z;3_dW_GgSJvMIN3Ksm{t!$dQoZWb85gWL#fr&?-XR|)(Vn=^HmVLi^ z7Yi2Ke`P<|UB?myE7+}-Ygzj%gKSdE66W_$XHPFLWKaF7h28k}O4jh>KJbE7!hls! zV@kA@7}kE*q7(CQUAgqxEqFVUwRaQ`l;c_{&beU@_08=^XW`1meq2A3t_)>Y_u4D3 zrEI{xal*ZV?MI$p`2LsQrVYGLrF!7)iukSNmEHfb`e%H4352!+W8cAV5`JF)X0%6S z^dCZ7P(NO?_D@TyTU+ZIn_5Nd22oqRu6ENpsF-M7TPM}J-nK^{v|wlN2&JtJPoY&CZYv_F1w2;+AUtKb!*G&=Jv*>HEkV)-lsY?wi0%qiZ`_qu4gonnnjdQnq1f3*3!7PdCkU_ zrp?4-q`C37#*TRV#@6-3D`(QYNk#t8UpE;c+D*owlkT8z(P(DL3y&34@8{12h@e&? zF?NqF4uBw^m?`?)IMU1&eVE{j19SoAi{IF3K@OP2VkVQlm3i4g&Dvq6^b&uvr2#5` zsw`KT4jPRLDtT22F!^ZJlmey+;;f-C7kntJi1d={s^;o~XGo#QBURRl{X?eWIIzaY zf4|3^Ac;^0gPLF#i-&1BOC%fTVX_Z(poY9yWD>kf^Pr89l{$i{17tI; z29O8nE;u90*lNUk*b;i9OD0)FX7P8;N78xzv%_(&3R*!(k?GYi6eBi;2(Juz7S8#; zi(A9Ek9T1*MM5bO^sb*^#|X+VqTGwN#IZ#>0V#c#mYv?I z={saaE7L5rexHU>PZ?YghopeiGT>;&4ty+e#S3M0EIA-W_PgW)9@@&?&d>uROio7Tcdt>2%1&&5tupBhm z6u4J)U>dM z*-|%Ks7a*1s8hs(x5NI7OxmJX{xR!11mxw}iy>e?GN+s3ad_@lFtVKq0?gimcDyM^ z9(l4pe{8Q3D`i+VK?U6&R(Clq!FCi?7l-wx(bKw3g%)V1QK$W9cxe>Almi-ILu#4_n z-mEBhF`ba)b%$WGJW{tRGBT_Pb;wk8d?}dlU{kz@@n^TLUE!%FU}Gv)j?$4~8LFQJ z*>Yih1YxZHS(qeG)V~nyOL9{|TT8@*V&uu(h7Aw#a^>!ZWsoP64H3w-;gvQ}^IUx+ z-+trO5(xZo3V`5i$hDDEAb0mf?W3<<2Yf-Fl7Fp=*pr&hl-cKcK7yGWP_Gf6!#dn0 zxHI$zh==}1A46O?wCwNwIXk2EH*#_vu6?5KOU2BvJ0N9z2A!`&@fWxqXT;w5v0eHf Do f64 { - libm::acos(value) -} - -/// C ABI export of [`acos`]. -/// -/// # Safety -/// Every binary64 bit pattern is a valid argument. The function reads no -/// caller memory and retains no pointer. -#[unsafe(no_mangle)] -pub unsafe extern "C" fn number_acos(value: f64) -> f64 { - acos(value) -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn matches_domain_boundaries_and_rejects_values_outside_the_interval() { - for (input, bits) in [ - (1.0, 0), - (-1.0, 0x400921fb54442d18), - (0.0, 0x3ff921fb54442d18), - (-0.0, 0x3ff921fb54442d18), - (0.5, 0x3ff0c152382d7366), - (-0.5, 0x4000c152382d7366), - ] { - assert_eq!(acos(input).to_bits(), bits, "{input}"); - } - for input in [2.0, -2.0, f64::INFINITY, f64::NEG_INFINITY, f64::NAN] { - assert!(acos(input).is_nan(), "{input}"); - } - } -} diff --git a/crates/psrs-runtime/src/asin.rs b/crates/psrs-runtime/src/asin.rs deleted file mode 100644 index 9b354b97..00000000 --- a/crates/psrs-runtime/src/asin.rs +++ /dev/null @@ -1,44 +0,0 @@ -//! Inverse sine of one binary64 value. -//! -//! The pinned `libm` 0.2.15 routine is the fdlibm polynomial. On finite inputs -//! in the closed interval [-1, 1] it matches the official JavaScript -//! `Math.asin` results used by purescript-numbers, including the sign of zero. -//! Inputs outside that interval, infinities, and NaN produce NaN. The operation -//! does not trap. NaN payloads are not part of the public contract. - -/// Returns the inverse sine in radians. -fn asin(value: f64) -> f64 { - libm::asin(value) -} - -/// C ABI export of [`asin`]. -/// -/// # Safety -/// Every binary64 bit pattern is a valid argument. The function reads no -/// caller memory and retains no pointer. -#[unsafe(no_mangle)] -pub unsafe extern "C" fn number_asin(value: f64) -> f64 { - asin(value) -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn matches_domain_boundaries_and_rejects_values_outside_the_interval() { - for (input, bits) in [ - (0.0, 0), - (-0.0, 0x8000000000000000), - (1.0, 0x3ff921fb54442d18), - (-1.0, 0xbff921fb54442d18), - (0.5, 0x3fe0c152382d7366), - (-0.5, 0xbfe0c152382d7366), - ] { - assert_eq!(asin(input).to_bits(), bits, "{input}"); - } - for input in [2.0, -2.0, f64::INFINITY, f64::NEG_INFINITY, f64::NAN] { - assert!(asin(input).is_nan(), "{input}"); - } - } -} diff --git a/crates/psrs-runtime/src/atan.rs b/crates/psrs-runtime/src/atan.rs deleted file mode 100644 index ccebc89a..00000000 --- a/crates/psrs-runtime/src/atan.rs +++ /dev/null @@ -1,144 +0,0 @@ -//! Inverse tangent of one binary64 value. -//! -//! The polynomial is the fdlibm routine pinned by libm 0.2.15. On every finite -//! input, and on both infinities, it matches the official JavaScript -//! `Math.atan` results used by purescript-numbers, including the sign of zero. -//! NaN produces NaN. The operation does not trap. NaN payloads are not part of -//! the public contract. -//! -//! The original routine forces an `f32` evaluation on subnormal inputs to raise -//! the host underflow flag. Wasm has no floating-point status flags, and that -//! evaluation writes below the stack pointer without reserving the frame. This -//! copy returns the same bits and does not touch the stack pointer. - -/// Returns the inverse tangent in radians. -/// -/// The decimal coefficients are copied from libm 0.2.15. Their extra digits -/// and the split pi/2 terms belong to that polynomial. -#[allow(clippy::excessive_precision, clippy::approx_constant)] -pub(crate) fn atan(value: f64) -> f64 { - const ATANHI: [f64; 4] = [ - 4.63647609000806093515e-01, - 7.85398163397448278999e-01, - 9.82793723247329054082e-01, - 1.57079632679489655800e+00, - ]; - const ATANLO: [f64; 4] = [ - 2.26987774529616870924e-17, - 3.06161699786838301793e-17, - 1.39033110312309984516e-17, - 6.12323399573676603587e-17, - ]; - const AT: [f64; 11] = [ - 3.33333333333329318027e-01, - -1.99999999998764832476e-01, - 1.42857142725034663711e-01, - -1.11111104054623557880e-01, - 9.09088713343650656196e-02, - -7.69187620504482999495e-02, - 6.66107313738753120669e-02, - -5.83357013379057348645e-02, - 4.97687799461593236017e-02, - -3.65315727442169155270e-02, - 1.62858201153657823623e-02, - ]; - - let mut x = value; - let mut ix = (x.to_bits() >> 32) as u32; - let sign = ix >> 31; - ix &= 0x7fff_ffff; - if ix >= 0x4410_0000 { - if x.is_nan() { - return x; - } - let z = ATANHI[3] + f64::from_bits(0x0380_0000); - return if sign != 0 { -z } else { z }; - } - let id = if ix < 0x3fdc_0000 { - if ix < 0x3e40_0000 { - return x; - } - -1 - } else { - x = x.abs(); - if ix < 0x3ff3_0000 { - if ix < 0x3fe6_0000 { - x = (2. * x - 1.) / (2. + x); - 0 - } else { - x = (x - 1.) / (x + 1.); - 1 - } - } else if ix < 0x4003_8000 { - x = (x - 1.5) / (1. + 1.5 * x); - 2 - } else { - x = -1. / x; - 3 - } - }; - let z = x * x; - let w = z * z; - let s1 = z * (AT[0] + w * (AT[2] + w * (AT[4] + w * (AT[6] + w * (AT[8] + w * AT[10]))))); - let s2 = w * (AT[1] + w * (AT[3] + w * (AT[5] + w * (AT[7] + w * AT[9])))); - if id < 0 { - return x - x * (s1 + s2); - } - let z = ATANHI[id as usize] - (x * (s1 + s2) - ATANLO[id as usize] - x); - if sign != 0 { -z } else { z } -} - -/// C ABI export of [`atan`]. -/// -/// # Safety -/// Every binary64 bit pattern is a valid argument. The function reads no -/// caller memory and retains no pointer. -#[unsafe(no_mangle)] -pub unsafe extern "C" fn number_atan(value: f64) -> f64 { - atan(value) -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn matches_zero_signs_unit_slopes_and_infinities() { - for (input, bits) in [ - (0.0, 0), - (-0.0, 0x8000000000000000), - (1.0, 0x3fe921fb54442d18), - (-1.0, 0xbfe921fb54442d18), - (f64::INFINITY, 0x3ff921fb54442d18), - (f64::NEG_INFINITY, 0xbff921fb54442d18), - ] { - assert_eq!(atan(input).to_bits(), bits, "{input}"); - } - assert!(atan(f64::NAN).is_nan()); - } - - #[test] - fn matches_libm_bits_including_subnormals() { - for input in [ - f64::from_bits(1), - f64::from_bits(0x000f_ffff_ffff_ffff), - f64::from_bits(0x0010_0000_0000_0000), - 1e-20, - -1e-20, - 0.4375, - -0.4375, - 0.7, - 1.1875, - 2.4375, - 1e20, - f64::MAX, - -f64::MAX, - ] { - assert_eq!( - atan(input).to_bits(), - libm::atan(input).to_bits(), - "{input}" - ); - } - } -} diff --git a/crates/psrs-runtime/src/atan2.rs b/crates/psrs-runtime/src/atan2.rs index 2e7910f3..faa176c3 100644 --- a/crates/psrs-runtime/src/atan2.rs +++ b/crates/psrs-runtime/src/atan2.rs @@ -1,22 +1,13 @@ //! Four-quadrant inverse tangent of two binary64 values. //! -//! The reduction follows the fdlibm cutoff: an exponent gap above 60 uses a -//! signed half-pi, and a negative `x` with an exponent gap below -60 uses a -//! zero before the pi adjustment. Moderate ratios call this crate's inverse -//! tangent, which matches libm `atan` and does not touch the stack pointer. -//! libm 0.2.15's own `atan2` uses a wider gap and differs from official -//! `Math.atan2` by one ulp on some of those large ratios. -//! -//! The argument order is `(y, x)`, matching official `Math.atan2` and -//! `Data.Number.atan2`. Either NaN produces NaN. The operation does not trap. -//! NaN payloads are not part of the public contract. - -use super::atan::atan; +//! Moderate ratios call upstream `libm` 0.2.15 inverse tangent. An +//! exponent gap above 60 returns a signed half-pi, and a negative `x` with a +//! gap below -60 contributes zero before the pi adjustment. That cutoff +//! matches official `Math.atan2`. The argument order is `(y, x)`. Either NaN +//! produces NaN. The operation does not trap. NaN payloads are not part of +//! the public contract. /// Returns the angle from the positive x axis to `(x, y)`, in radians. -/// -/// The split pi terms are the fdlibm constants. Their extra digits belong to -/// that reduction. #[allow(clippy::excessive_precision, clippy::approx_constant)] fn atan2(y: f64, x: f64) -> f64 { const PI: f64 = 3.1415926535897931160E+00; @@ -31,7 +22,7 @@ fn atan2(y: f64, x: f64) -> f64 { let mut iy = (y.to_bits() >> 32) as u32; let ly = y.to_bits() as u32; if (ix.wrapping_sub(0x3ff0_0000) | lx) == 0 { - return atan(y); + return libm::atan(y); } let mut quadrant = ((iy >> 31) & 1) | ((ix >> 30) & 2); ix &= 0x7fff_ffff; @@ -81,7 +72,7 @@ fn atan2(y: f64, x: f64) -> f64 { } else if quadrant & 2 != 0 && exponent_gap < -60 { 0.0 } else { - atan((y / x).abs()) + libm::atan((y / x).abs()) }; match quadrant { 0 => reduced, @@ -142,7 +133,7 @@ mod tests { } #[test] - fn matches_moderate_ratios_with_libm_and_large_ratios_with_half_pi() { + fn large_negative_x_ratios_return_a_signed_half_pi() { for (y, x, bits) in [ (0.1, -1e-20, 0x3ff9_21fb_5444_2d18), (-0.1, -1e-20, 0xbff9_21fb_5444_2d18), @@ -151,52 +142,5 @@ mod tests { ] { assert_eq!(atan2(y, x).to_bits(), bits, "{y}, {x}"); } - let mut samples = vec![ - (0.0, 1.0), - (-0.0, -1.0), - (f64::from_bits(1), 1.0), - (1.0, f64::from_bits(1)), - (f64::from_bits(1), f64::from_bits(1)), - (f64::from_bits(0x000f_ffff_ffff_ffff), 1.0), - (1e-20, -1.0), - (1.5, 1.0), - (3.0, 2.0), - (2.0, -1.0), - (-2.0, -1.0), - ]; - let mut state = 0x5eed_5a17u32; - for _ in 0..256 { - let y = f64::from_bits(next_bits(&mut state)); - let x = f64::from_bits(next_bits(&mut state)); - if exponent_gap(y, x).abs() <= 60 && y.is_finite() && x.is_finite() && x != 0.0 { - samples.push((y, x)); - } - } - for (y, x) in samples { - assert_eq!( - atan2(y, x).to_bits(), - libm::atan2(y, x).to_bits(), - "{y}, {x}" - ); - } - } - - fn exponent_gap(y: f64, x: f64) -> i32 { - let ix = (x.to_bits() >> 32) as u32 & 0x7fff_ffff; - let iy = (y.to_bits() >> 32) as u32 & 0x7fff_ffff; - (iy as i32).wrapping_sub(ix as i32) >> 20 - } - - fn next_bits(state: &mut u32) -> u64 { - let low = step(state); - let high = step(state); - u64::from(low) | (u64::from(high) << 32) - } - - fn step(state: &mut u32) -> u32 { - *state ^= state.wrapping_shl(13); - *state ^= state.wrapping_shr(17); - *state ^= state.wrapping_shl(5); - *state } } diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs index 2b318732..206b1e4f 100644 --- a/crates/psrs-runtime/src/catalog.rs +++ b/crates/psrs-runtime/src/catalog.rs @@ -163,9 +163,9 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", target: "wasm32-unknown-unknown", profile: "target-runtime", - recipe: "tools/build.sh: --import-memory --global-base=65536 \ + recipe: "tools/build.sh: RUSTFLAGS=-C no-redzone=yes; --import-memory --global-base=65536 \ -zstack-size=65536 --export=__heap_base, then package", - sha256: "e295fd40bcb247ee77b8890107b2dea74838ded7b383895ce8db7c428d0e7ac2", + sha256: "75cdd69833e058d014942eafdcd668eb9150e8d098a791871c327daf7bb20c73", }, required_features: &[ "mutable-globals", @@ -210,6 +210,71 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { parameters: &[RawType::F64, RawType::F64], result: Some(RawType::F64), }, + RawExport { + name: crate::SIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::COS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::TAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::EXP_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::LOG_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::POW_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::MIN_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::MAX_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::SIGN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::REMAINDER_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::IS_NAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::I32), + }, + RawExport { + name: crate::NAN_EXPORT, + parameters: &[], + result: Some(RawType::F64), + }, + RawExport { + name: crate::INFINITY_EXPORT, + parameters: &[], + result: Some(RawType::F64), + }, ], global_exports: &[crate::HEAP_BASE_EXPORT], tables: &[RawTable { @@ -220,7 +285,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { elements: &[RawElement { table: 0, offset: 1, - functions: &[27], + functions: &[54], }], globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], storage: RawStorage { diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 4f9af00b..f6aa8bf9 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -7,9 +7,12 @@ //! the compiler-owned formatter artifact with its provenance and storage //! contract. It links no executable target code. //! - Feature `formatter` compiles the numeric formatting, complete-decimal -//! conversion, and inverse trigonometric exports, built for `wasm32-unknown-unknown` +//! conversion, and numeric exports, built for `wasm32-unknown-unknown` //! and embedded as the pinned artifact. It embeds neither WIT text nor the //! catalog. +//! Scalar math exports and numeric semantic wrappers live in `number`; +//! `atan2` retains its separate compatibility algorithm. Decimal parsing +//! and number formatting each have their own implementation module. //! //! The compiler depends on this crate with `default-features = false, //! features = ["catalog"]`; the Wasm artifact build uses @@ -22,12 +25,6 @@ pub mod catalog; #[cfg(feature = "catalog")] pub use catalog::*; -#[cfg(feature = "formatter")] -mod acos; -#[cfg(feature = "formatter")] -mod asin; -#[cfg(feature = "formatter")] -mod atan; #[cfg(feature = "formatter")] mod atan2; #[cfg(feature = "formatter")] @@ -35,17 +32,19 @@ mod decimal; #[cfg(feature = "formatter")] mod formatter; #[cfg(feature = "formatter")] -pub use acos::number_acos; -#[cfg(feature = "formatter")] -pub use asin::number_asin; -#[cfg(feature = "formatter")] -pub use atan::number_atan; +mod number; #[cfg(feature = "formatter")] pub use atan2::number_atan2; #[cfg(feature = "formatter")] pub use decimal::number_from_decimal; #[cfg(feature = "formatter")] pub use formatter::number_to_string; +#[cfg(feature = "formatter")] +pub use number::{ + number_acos, number_asin, number_atan, number_cos, number_exp, number_infinity, number_is_nan, + number_log, number_max, number_min, number_nan, number_pow, number_remainder, number_sign, + number_sin, number_tan, +}; /// Maximum capacity required by an ECMAScript binary64 token. pub const NUMBER_CAPACITY: usize = 32; @@ -63,6 +62,32 @@ pub const ASIN_EXPORT: &str = "number_asin"; pub const ATAN_EXPORT: &str = "number_atan"; /// Exported raw four-quadrant inverse-tangent function. pub const ATAN2_EXPORT: &str = "number_atan2"; +/// Exported raw sine function. +pub const SIN_EXPORT: &str = "number_sin"; +/// Exported raw cosine function. +pub const COS_EXPORT: &str = "number_cos"; +/// Exported raw tangent function. +pub const TAN_EXPORT: &str = "number_tan"; +/// Exported raw base-e exponential function. +pub const EXP_EXPORT: &str = "number_exp"; +/// Exported raw natural-logarithm function. +pub const LOG_EXPORT: &str = "number_log"; +/// Exported raw exponentiation function. +pub const POW_EXPORT: &str = "number_pow"; +/// Exported raw minimum function. +pub const MIN_EXPORT: &str = "number_min"; +/// Exported raw maximum function. +pub const MAX_EXPORT: &str = "number_max"; +/// Exported raw sign function. +pub const SIGN_EXPORT: &str = "number_sign"; +/// Exported raw JavaScript remainder function. +pub const REMAINDER_EXPORT: &str = "number_remainder"; +/// Exported raw NaN predicate. The result is an `i32` 0 or 1. +pub const IS_NAN_EXPORT: &str = "number_is_nan"; +/// Exported raw canonical NaN. +pub const NAN_EXPORT: &str = "number_nan"; +/// Exported raw positive infinity. +pub const INFINITY_EXPORT: &str = "number_infinity"; /// Lower addresses remain owned by the application's canonical ABI. pub const RESERVED_START: u32 = 65536; /// Static data must end before the separately reserved 64 KiB stack. @@ -147,3 +172,94 @@ pub const NUMBER_ATAN2: RawFunctionAbi = RawFunctionAbi { result: Some(RawType::F64), protocol: RawCallProtocol::Scalars, }; + +pub const NUMBER_SIN: RawFunctionAbi = RawFunctionAbi { + export: SIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_COS: RawFunctionAbi = RawFunctionAbi { + export: COS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_TAN: RawFunctionAbi = RawFunctionAbi { + export: TAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_EXP: RawFunctionAbi = RawFunctionAbi { + export: EXP_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_LOG: RawFunctionAbi = RawFunctionAbi { + export: LOG_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_POW: RawFunctionAbi = RawFunctionAbi { + export: POW_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_MIN: RawFunctionAbi = RawFunctionAbi { + export: MIN_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_MAX: RawFunctionAbi = RawFunctionAbi { + export: MAX_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_SIGN: RawFunctionAbi = RawFunctionAbi { + export: SIGN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_REMAINDER: RawFunctionAbi = RawFunctionAbi { + export: REMAINDER_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_IS_NAN: RawFunctionAbi = RawFunctionAbi { + export: IS_NAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::I32), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_NAN: RawFunctionAbi = RawFunctionAbi { + export: NAN_EXPORT, + parameters: &[], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_INFINITY: RawFunctionAbi = RawFunctionAbi { + export: INFINITY_EXPORT, + parameters: &[], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; diff --git a/crates/psrs-runtime/src/number.rs b/crates/psrs-runtime/src/number.rs new file mode 100644 index 00000000..a8e40af5 --- /dev/null +++ b/crates/psrs-runtime/src/number.rs @@ -0,0 +1,351 @@ +//! Scalar math exports and JavaScript numeric semantics. +//! +//! Elementary operations call `libm` 0.2.15. Minimum, maximum, sign, +//! remainder, NaN, infinity, and `isNaN` follow the official JavaScript +//! `Math` and `%` contracts. Remainder calls `libm::fmod`. None of these +//! operations trap. NaN payloads are not part of the public contract, except +//! that `isNaN` is true for every NaN. + +/// Returns the smaller value. Either NaN produces NaN. If either zero is +/// negative, a zero result is negative zero. +fn minimum(left: f64, right: f64) -> f64 { + if left.is_nan() || right.is_nan() { + return f64::NAN; + } + if left == 0.0 && right == 0.0 { + return f64::from_bits(left.to_bits() | right.to_bits()); + } + if left < right { left } else { right } +} + +/// Returns the larger value. Either NaN produces NaN. A zero result is +/// negative zero only when both zeros are negative. +fn maximum(left: f64, right: f64) -> f64 { + if left.is_nan() || right.is_nan() { + return f64::NAN; + } + if left == 0.0 && right == 0.0 { + return f64::from_bits(left.to_bits() & right.to_bits()); + } + if left > right { left } else { right } +} + +/// JavaScript `%`: the exact remainder, with a zero result taking the +/// dividend's sign. Division by zero or an infinite dividend produces NaN. +fn remainder(dividend: f64, divisor: f64) -> f64 { + libm::fmod(dividend, divisor) +} + +/// JavaScript `Math.pow`. An exponent of zero yields 1, including a NaN base. +/// A NaN exponent, and ±1 raised to an infinity, yield NaN. The C `pow` +/// convention returns 1 for those two shapes. +fn power(base: f64, exponent: f64) -> f64 { + if exponent.is_nan() || (base.abs() == 1.0 && exponent.is_infinite()) { + return f64::NAN; + } + libm::pow(base, exponent) +} + +/// `Math.sign`: NaN and both zeros are unchanged. Infinities become ±1. +fn sign(value: f64) -> f64 { + if value.is_nan() || value == 0.0 { + value + } else if value > 0.0 { + 1.0 + } else { + -1.0 + } +} + +/// C ABI export of inverse cosine, in radians. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_acos(value: f64) -> f64 { + libm::acos(value) +} + +/// C ABI export of inverse sine, in radians. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_asin(value: f64) -> f64 { + libm::asin(value) +} + +/// C ABI export of inverse tangent, in radians. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_atan(value: f64) -> f64 { + libm::atan(value) +} + +/// C ABI export of sine. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_sin(value: f64) -> f64 { + libm::sin(value) +} + +/// C ABI export of cosine. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_cos(value: f64) -> f64 { + libm::cos(value) +} + +/// C ABI export of tangent. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_tan(value: f64) -> f64 { + libm::tan(value) +} + +/// C ABI export of the base-e exponential. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_exp(value: f64) -> f64 { + libm::exp(value) +} + +/// C ABI export of the natural logarithm. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_log(value: f64) -> f64 { + libm::log(value) +} + +/// C ABI export of exponentiation. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_pow(base: f64, exponent: f64) -> f64 { + power(base, exponent) +} + +/// C ABI export of [`minimum`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_min(left: f64, right: f64) -> f64 { + minimum(left, right) +} + +/// C ABI export of [`maximum`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_max(left: f64, right: f64) -> f64 { + maximum(left, right) +} + +/// C ABI export of [`sign`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_sign(value: f64) -> f64 { + sign(value) +} + +/// C ABI export of [`remainder`]. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_remainder(dividend: f64, divisor: f64) -> f64 { + remainder(dividend, divisor) +} + +/// C ABI export of the NaN predicate. The result is `1` or `0`. +/// +/// # Safety +/// Every binary64 bit pattern is a valid argument. The function reads no +/// caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_is_nan(value: f64) -> i32 { + i32::from(value.is_nan()) +} + +/// C ABI export of canonical NaN. +/// +/// # Safety +/// The function reads no caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_nan() -> f64 { + f64::NAN +} + +/// C ABI export of positive infinity. +/// +/// # Safety +/// The function reads no caller memory and retains no pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn number_infinity() -> f64 { + f64::INFINITY +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn acos_matches_domain_boundaries_and_rejects_values_outside_the_interval() { + for (input, bits) in [ + (1.0, 0), + (-1.0, 0x400921fb54442d18), + (0.0, 0x3ff921fb54442d18), + (-0.0, 0x3ff921fb54442d18), + (0.5, 0x3ff0c152382d7366), + (-0.5, 0x4000c152382d7366), + ] { + assert_eq!(unsafe { number_acos(input) }.to_bits(), bits, "{input}"); + } + for input in [2.0, -2.0, f64::INFINITY, f64::NEG_INFINITY, f64::NAN] { + assert!(unsafe { number_acos(input) }.is_nan(), "{input}"); + } + } + + #[test] + fn asin_matches_domain_boundaries_and_rejects_values_outside_the_interval() { + for (input, bits) in [ + (0.0, 0), + (-0.0, 0x8000000000000000), + (1.0, 0x3ff921fb54442d18), + (-1.0, 0xbff921fb54442d18), + (0.5, 0x3fe0c152382d7366), + (-0.5, 0xbfe0c152382d7366), + ] { + assert_eq!(unsafe { number_asin(input) }.to_bits(), bits, "{input}"); + } + for input in [2.0, -2.0, f64::INFINITY, f64::NEG_INFINITY, f64::NAN] { + assert!(unsafe { number_asin(input) }.is_nan(), "{input}"); + } + } + + #[test] + fn atan_matches_zero_signs_unit_slopes_and_infinities() { + for (input, bits) in [ + (0.0, 0), + (-0.0, 0x8000000000000000), + (f64::from_bits(1), 1), + (f64::from_bits(0x8000_0000_0000_0001), 0x8000_0000_0000_0001), + (f64::MIN_POSITIVE, f64::MIN_POSITIVE.to_bits()), + (1.0, 0x3fe921fb54442d18), + (-1.0, 0xbfe921fb54442d18), + (f64::INFINITY, 0x3ff921fb54442d18), + (f64::NEG_INFINITY, 0xbff921fb54442d18), + ] { + assert_eq!(unsafe { number_atan(input) }.to_bits(), bits, "{input}"); + } + assert!(unsafe { number_atan(f64::NAN) }.is_nan()); + } + + #[test] + fn minimum_and_maximum_propagate_nan_and_select_zero_signs() { + let negative_zero = -0.0; + assert_eq!(minimum(1.0, 2.0).to_bits(), 1.0_f64.to_bits()); + assert_eq!(maximum(1.0, 2.0).to_bits(), 2.0_f64.to_bits()); + assert_eq!( + minimum(negative_zero, 0.0).to_bits(), + negative_zero.to_bits() + ); + assert_eq!( + minimum(0.0, negative_zero).to_bits(), + negative_zero.to_bits() + ); + assert_eq!(maximum(negative_zero, 0.0).to_bits(), 0.0_f64.to_bits()); + assert_eq!( + maximum(negative_zero, negative_zero).to_bits(), + negative_zero.to_bits() + ); + assert!(minimum(f64::NAN, 1.0).is_nan()); + assert!(maximum(1.0, f64::NAN).is_nan()); + assert_eq!( + minimum(f64::NEG_INFINITY, 1.0).to_bits(), + f64::NEG_INFINITY.to_bits() + ); + assert_eq!( + maximum(f64::INFINITY, 1.0).to_bits(), + f64::INFINITY.to_bits() + ); + } + + #[test] + fn remainder_follows_the_dividend_and_rejects_zero_divisors() { + let negative_zero = -0.0_f64; + assert_eq!(remainder(5.3, 2.0).to_bits(), 0x3ff4_cccc_cccc_cccc); + assert_eq!(remainder(-5.3, 2.0).to_bits(), 0xbff4_cccc_cccc_cccc); + assert_eq!(remainder(5.3, -2.0).to_bits(), 0x3ff4_cccc_cccc_cccc); + assert_eq!(remainder(-1.0, 1.0).to_bits(), negative_zero.to_bits()); + assert_eq!(remainder(1.0, 0.1).to_bits(), 0x3fb9_9999_9999_9996); + assert_eq!(remainder(1.0, f64::INFINITY).to_bits(), 1.0_f64.to_bits()); + assert_eq!( + remainder(negative_zero, 1.0).to_bits(), + negative_zero.to_bits() + ); + assert!(remainder(f64::INFINITY, 1.0).is_nan()); + assert!(remainder(1.0, 0.0).is_nan()); + assert!(remainder(1.0, negative_zero).is_nan()); + assert!(remainder(f64::NAN, 1.0).is_nan()); + } + + #[test] + fn sign_preserves_zeros_and_nan_and_collapses_infinities() { + let negative_zero = -0.0; + assert_eq!(sign(0.0).to_bits(), 0.0_f64.to_bits()); + assert_eq!(sign(negative_zero).to_bits(), negative_zero.to_bits()); + assert!(sign(f64::NAN).is_nan()); + assert_eq!(sign(42.0).to_bits(), 1.0_f64.to_bits()); + assert_eq!(sign(-42.0).to_bits(), (-1.0_f64).to_bits()); + assert_eq!(sign(f64::INFINITY).to_bits(), 1.0_f64.to_bits()); + assert_eq!(sign(f64::NEG_INFINITY).to_bits(), (-1.0_f64).to_bits()); + } + + #[test] + fn constants_power_and_nan_predicate_match_javascript() { + assert_eq!(unsafe { number_nan() }.to_bits(), 0x7ff8_0000_0000_0000); + assert_eq!( + unsafe { number_infinity() }.to_bits(), + 0x7ff0_0000_0000_0000 + ); + assert_eq!(unsafe { number_is_nan(f64::NAN) }, 1); + assert_eq!(unsafe { number_is_nan(f64::INFINITY) }, 0); + assert_eq!(unsafe { number_is_nan(0.0) }, 0); + assert!(power(1.0, f64::NAN).is_nan()); + assert!(power(1.0, f64::INFINITY).is_nan()); + assert!(power(-1.0, f64::NEG_INFINITY).is_nan()); + assert_eq!(power(f64::NAN, 0.0).to_bits(), 1.0_f64.to_bits()); + assert_eq!(power(2.0, 3.0).to_bits(), 8.0_f64.to_bits()); + } +} diff --git a/crates/psrs-runtime/tools/build.sh b/crates/psrs-runtime/tools/build.sh index 0134925c..720d76b9 100644 --- a/crates/psrs-runtime/tools/build.sh +++ b/crates/psrs-runtime/tools/build.sh @@ -1,6 +1,9 @@ #!/bin/sh set -eu cd "$(dirname "$0")/../../.." +# Apply to dependencies as well: libm force_eval uses stack temporaries. +# Explicit frames let the linker measure their storage without a red zone. +RUSTFLAGS="${RUSTFLAGS:-} -C no-redzone=yes" \ cargo rustc --locked -p psrs-runtime --lib --no-default-features --features formatter \ --target wasm32-unknown-unknown --profile target-runtime -- \ -C link-arg=--import-memory -C link-arg=--global-base=65536 \ diff --git a/crates/psrs-runtime/tools/check-reproducible.sh b/crates/psrs-runtime/tools/check-reproducible.sh index 4239f1a9..74c2eaa2 100755 --- a/crates/psrs-runtime/tools/check-reproducible.sh +++ b/crates/psrs-runtime/tools/check-reproducible.sh @@ -6,6 +6,9 @@ set -eu cd "$(dirname "$0")/../../.." tmp=$(mktemp -d) trap 'rm -rf "$tmp"' EXIT +# Apply to dependencies as well: libm force_eval uses stack temporaries. +# Explicit frames let the linker measure their storage without a red zone. +RUSTFLAGS="${RUSTFLAGS:-} -C no-redzone=yes" \ cargo rustc --locked -p psrs-runtime --lib --no-default-features --features formatter \ --target wasm32-unknown-unknown --profile target-runtime -- \ -C link-arg=--import-memory -C link-arg=--global-base=65536 \ diff --git a/docs/design/backend/fp/scalars-and-primitives.md b/docs/design/backend/fp/scalars-and-primitives.md index 1824525d..69dc7f40 100644 --- a/docs/design/backend/fp/scalars-and-primitives.md +++ b/docs/design/backend/fp/scalars-and-primitives.md @@ -207,8 +207,8 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. [WebAssembly square-root semantics](https://webassembly.github.io/spec/core/exec/numerics.html#op-fsqrt). - `NumberAcos` (`numberAcos :: Number -> Number`) has no Wasm opcode. Core and CC require Number operands and results, then MIR calls the checked scalar - export `number_acos` in the numeric runtime. The pinned libm 0.2.15 fdlibm - polynomial returns radians. Finite inputs outside [-1, 1], infinities, and + export `number_acos` in the numeric runtime. The pinned upstream libm 0.2.15 + routine returns radians. Finite inputs outside [-1, 1], infinities, and NaN produce NaN, and the operation does not trap. NaN payloads are not a public guarantee. It implements the official Data.Number.acos foreign slot. A whole inverse-cosine algorithm does not become a compiler intrinsic, and @@ -220,13 +220,13 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. payloads are not a public guarantee. It implements the official Data.Number.asin foreign slot and is not folded when its operand is constant. - `NumberAtan` (`numberAtan :: Number -> Number`) uses the same checked - scalar-runtime boundary. The runtime copies the pinned libm 0.2.15 fdlibm - polynomial and returns radians, preserving the sign of zero. Inputs whose - magnitude is below 2^-27, including subnormals, return unchanged. The copy - omits the host underflow flag because Wasm has no floating-point status - flags and must not write below the stack pointer. Positive and negative - infinity produce positive and negative pi/2. NaN produces NaN, and the - operation does not trap. NaN payloads are not a public guarantee. It + scalar-runtime boundary. The runtime calls pinned upstream libm 0.2.15 + and returns radians, preserving the sign of zero. Inputs whose magnitude + is below 2^-27, including subnormals, return unchanged. The artifact build + applies `-C no-redzone=yes` to the runtime and its dependencies, so `force_eval` temporaries reserve explicit stack frames + that the linker can measure. This routine is neither copied nor patched. + Positive and negative infinity produce positive and negative pi/2. NaN + produces NaN, and the operation does not trap. NaN payloads are not a public guarantee. It implements the official Data.Number.atan foreign slot and is not folded when its operand is constant. - `NumberAtan2` (`numberAtan2 :: Number -> Number -> Number`) uses the same @@ -241,12 +241,35 @@ scalar sequence one byte sequence, so byte equality is scalar String equality. NaN payloads are not a public guarantee. It implements the official Data.Number.atan2 foreign slot and is not folded when its operands are constant. Wasm has no two-argument inverse-tangent instruction. +- `NumberSin`, `NumberCos`, `NumberTan`, and `NumberExp` use the same checked + scalar-runtime boundary. The runtime calls pinned upstream libm 0.2.15 + with red-zone use disabled for the artifact and its dependencies. + Returned bits follow those routines. On a measured sample they usually + match official `Math`, and some inputs still differ by one ulp. Infinities + produce NaN for the three trigonometric operations. Exponential overflow produces infinity and + underflow produces zero. NaN produces NaN. None of these operations trap, + and none are folded when an operand is constant. Wasm has no sine, cosine, + tangent, or exponential instruction. +- `NumberLog` and `NumberPow` call pinned libm 0.2.15. `NumberPow` then + applies the JavaScript exceptions libm does not: a NaN exponent produces + NaN, and ±1 raised to an infinity produces NaN. An exponent of zero still + produces 1, including a NaN base. A negative logarithm argument produces + NaN, and either signed zero produces negative infinity. Neither operation + traps. +- `NumberMin` and `NumberMax` return NaN when either argument is NaN. A zero + minimum is negative when either zero is negative. A zero maximum is negative + only when both zeros are negative. They are not IEEE `minNum`. +- `NumberSign` returns NaN and both zeros unchanged, and every other finite or + infinite value becomes ±1. +- `NumberRemainder` is JavaScript `%`: the exact remainder, with a zero result + taking the dividend's sign. An infinite dividend or a zero divisor produces + NaN. It does not trap. +- `NumberIsNaN` is `Number -> Boolean` and is true for every NaN payload. + `NumberNaN` and `NumberInfinity` are nullary Number constants. Only these two + nullary primitives are accepted as foreign bindings. Negative infinity is + negation of `NumberInfinity`. - Comparisons use the ordered `f64` operations; `NumberEq`/`NumberNe` are `f64.eq`/`f64.ne`, so `NaN` is unequal to itself and `+0 = -0`. -- The current vocabulary has no `Number` remainder. If the standard library - exposes one, it needs a helper that realizes the required semantics (for - example the JavaScript `%` semantics `x - trunc(x / y) * y`), decided when - that operation is added. ### Boolean and character operations diff --git a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md index 86fa55d3..943bbfc6 100644 --- a/docs/implementation/backend/intrinsic-implementations-2026-10-07.md +++ b/docs/implementation/backend/intrinsic-implementations-2026-10-07.md @@ -98,6 +98,8 @@ Library evidence, with the package fingerprint unchanged during each run: This refactor does not establish whole-stdlib runtime completion. Number square root has a separate checked `f64.sqrt` acceptance. Number inverse cosine, inverse sine, inverse tangent, and four-quadrant inverse tangent -each have a separate checked scalar-runtime acceptance. Other Number foreign -slots remain without target support until a fresh diagnosis names the next -blocker. +each have a separate checked scalar-runtime acceptance. The remaining +Data.Number foreigns — sine, cosine, tangent, exponential, logarithm, +power, minimum, maximum, remainder, sign, `isNaN`, NaN, and infinity — have +one shared scalar-runtime acceptance. This does not establish whole-stdlib +runtime completion. A fresh diagnosis still has to name the next module. diff --git a/docs/implementation/stdlib/number-atan-2026-10-08.md b/docs/implementation/stdlib/number-atan-2026-10-08.md index c86d289e..41b97fe8 100644 --- a/docs/implementation/stdlib/number-atan-2026-10-08.md +++ b/docs/implementation/stdlib/number-atan-2026-10-08.md @@ -1,5 +1,9 @@ # Number inverse-tangent acceptance +The implementation and artifact measurements below describe the earlier local +copy. The current runtime calls unmodified libm 0.2.15 with red-zone use +disabled; see [the runtime migration](runtime-libm-2026-10-08.md). + ## Contract and implementation Starting compiler revision: 957b133 on stdlib/vendor-core-libraries, with a diff --git a/docs/implementation/stdlib/number-rest-2026-10-08.md b/docs/implementation/stdlib/number-rest-2026-10-08.md new file mode 100644 index 00000000..e652548a --- /dev/null +++ b/docs/implementation/stdlib/number-rest-2026-10-08.md @@ -0,0 +1,112 @@ +# Remaining Number foreign acceptance + +The implementation and artifact measurements below describe the earlier local +copies. The current runtime calls unmodified libm 0.2.15 with red-zone use +disabled; see [the runtime migration](runtime-libm-2026-10-08.md). + +## Contract and implementation + +Starting compiler revision: 4e53f83 on stdlib/vendor-core-libraries. The starting +package was 767ffd7f5bbdbf1a2e1bc568b2dce88deeb5ce88 +(fnv1a64-v1:fe305ab57e585eca). The preceding four-quadrant inverse-tangent +diagnosis recorded that Number.cos 0.0 stopped at P8 library linking because +Data.Number.cos had no target implementation. + +This batch binds the thirteen remaining Data.Number foreign slots in one +scalar runtime. Wasm has no sine, cosine, tangent, exponential, logarithm, or +power instruction. Minimum and maximum stay in that runtime as well. HIR +identities are appended from 74 through 86, preserving existing intrinsic IDs, +including retired floor IDs 26 and 27. Core and CC require the checked Number +schemes. `isNaN` is Number to Boolean. `nan` and `infinity` are the only +nullary foreign primitives, and an empty parameter list stays empty. MIR calls +the scalar exports below. Incorrect foreign binding schemes are rejected +before ABI erasure. + +None of the thirteen operations trap. NaN payloads are not a public contract, +except that `isNaN` is true for every NaN. No constant folding is introduced. +A whole numeric library does not become a compiler intrinsic. Each binding is +one scalar export: + +| Binding | Export | Behavior | +| --- | --- | --- | +| numberSin, numberCos, numberTan, numberExp | number_sin, number_cos, number_tan, number_exp | Local copy of the pinned libm 0.2.15 fdlibm routines. `force_eval` is omitted because it stores below the stack pointer. Returned bits follow those routines. Infinities produce NaN for the three trigonometric operations. Exponential overflow produces infinity and underflow produces zero. | +| numberLog | number_log | `libm::log`. A negative argument produces NaN. Either signed zero produces negative infinity. | +| numberPow | number_pow | `libm::pow`, then the JavaScript exceptions: a NaN exponent produces NaN, and ±1 raised to an infinity produces NaN. An exponent of zero still produces 1, including a NaN base. | +| numberMin, numberMax | number_min, number_max | NaN if either argument is NaN. A zero minimum is negative when either zero is negative. A zero maximum is negative only when both zeros are negative. This is not IEEE minNum. | +| numberSign | number_sign | NaN and both zeros are unchanged. Every other finite or infinite value becomes ±1. | +| numberRemainder | number_remainder | JavaScript `%` through `libm::fmod`: the exact remainder, with a zero result taking the dividend's sign. An infinite dividend or a zero divisor produces NaN. | +| numberIsNaN | number_is_nan | Number to Boolean, returned as i32 0 or 1. | +| numberNan, numberInfinity | number_nan, number_infinity | Canonical NaN `0x7ff8000000000000` and positive infinity. Negative infinity is negation. | + +On the oracle input set below, the built artifact and the pinned official +Number FFI disagree by one ulp on exactly eight inputs, and on no other input +in that set. A separate 2000-draw sample from seed `0x5eed5a17` (2000 unary +values, then 2000 pairs on the continued stream) has further one-ulp gaps and +no larger gaps: sine 17, cosine 17, tangent 13, and logarithm 1. Exponential, +sign, `isNaN`, minimum, maximum, power, and remainder had zero one-ulp +disagreements in that sample. The eight oracle gaps are not patched. The +sample does not establish bit identity with `Math` for every input. + +The numeric runtime retains its earlier exports and adds these thirteen. Its +reproducible artifact SHA-256 is +2323f3ed445e17fb19a4c6832dd0470afe98cd83d74102a0d17dfca36fbfbbe6. +The artifact is 48836 bytes. The private table still has two funcref slots. +The active initializer now points at function 49. Static stack analysis +accepts the artifact and still measures 1680 bytes inside the existing +65536-byte reserve. Argument reduction for magnitudes that need the 64-bit +coefficient table is compiled only for the host; the wasm32 artifact uses the +32-bit table. Host bit checks of that reduction are not the wasm oracle. + +The independent library changes only the thirteen foreign slots' explicit +bindings, for example +`foreign import "psrs:intrinsic#numberCos" cos :: Number -> Number`. +Signatures, exports, and all official pure declarations remain unchanged, +including `isFinite`, `fromString`, and `round`. The complete-module source +verifier checks this transformation against pinned purescript-numbers v9.0.1 +(27d54effdd2c0e7a86fe356b1cd813dca5981c2d). + +## Package and runtime evidence + +The lock is still 767ffd7f5bbdbf1a2e1bc568b2dce88deeb5ce88 +(fnv1a64-v1:fe305ab57e585eca). The development package used below is that +commit plus the thirteen uncommitted bindings. Its content fingerprint is +fnv1a64-v1:bca0ace40bd0ccac. That fingerprint is not the lock, and it does +not match the earlier cosine diagnosis, so the two diagnoses are not a +same-fingerprint compare. + +```sh +node ../psrs-stdlib/conformance/number-rest.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-rest-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-rest-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-rest-runtime +``` + +The pinned official FFI produces 1340 observations and 2680 checks. Each +asserted check is a direct public call and a higher-order call. Inputs are +the nonfinite values, both zero signs, selected magnitudes, and 24 +deterministically generated binary64 values; binary operations use the first +16 of those values as anchors. NaN checks use inequality. Zero results use a +reciprocal so the sign is visible. The eight one-ulp inputs are recorded in +`observations.json` and are not asserted. Compilation took 44.7 seconds. +Wasmtime 49.0.2 executed the artifact +(sha256 c94db1569cdb01741b5aa3c72bd1b358d5e29d974beff0dc1b5becdea9f6851c) +in 1.34 seconds, with exit 42 and empty stdout and stderr. + +A public probe that calls sine, cosine, tangent, exponential, logarithm, +`isNaN`, NaN, infinity, minimum, maximum, power, remainder, and sign passes +against the same development package, in 18668 ms. Node source verification +of the thirteen bindings passed. `cargo fmt --all --check` and +`cargo clippy --workspace --all-targets -- -D warnings` passed on the final +sources. One workspace run, with `PSRS_STDLIB_ROOT` set to the development +package and `PSRS_REQUIRE_WASMTIME=1`, finished with exit 101. Its driver +library target had 713 passed and 3 failed, and those three are the existing +baseline: a missing constrained MIR function, optimized WAT without `f64`, +and optimized WAT without `br_if`. The same run rejected a flat +`rem_pio2_large.rs` sibling; that file now lives at `fdlibm/rem_pio2/large.rs`, +and `cargo test -p psrs-cli --test source_layout` then passed. The workspace +suite was not repeated after that move or after the artifact digest update. +This acceptance does not establish whole-stdlib runtime completion. The lock +still names the previous package, so a locked-package load does not see +these bindings until that package is committed and the lock is updated. diff --git a/docs/implementation/stdlib/runtime-libm-2026-10-08.md b/docs/implementation/stdlib/runtime-libm-2026-10-08.md new file mode 100644 index 00000000..94d2eeb6 --- /dev/null +++ b/docs/implementation/stdlib/runtime-libm-2026-10-08.md @@ -0,0 +1,147 @@ +# Numeric runtime: upstream libm without a red zone + +## Contract and implementation + +The numeric runtime pins unmodified `libm` 0.2.15 instead of `fpmath` 0.1.1. +Inverse sine, inverse cosine, inverse tangent, sine, cosine, tangent, +exponential, logarithm, and power call the dependency directly. Remainder +calls `libm::fmod`, replacing the private significand-reduction implementation. +The JavaScript `pow` exceptions, signed-zero minimum/maximum, sign, and NaN +classification remain runtime-owned semantic wrappers. The existing `atan2` +wrapper retains its documented exponent-gap cutoff of 60 for compatibility; +this migration does not change that policy to `libm::atan2`. + +`force_eval` uses a volatile read of a temporary to force floating-point +exception evaluation. LLVM can place that temporary below the stack pointer +without publishing a frame (a red zone). The current linker intentionally +rejects that unrecognized access rather than reporting an incomplete bound. +Both artifact build scripts now apply `RUSTFLAGS=-C no-redzone=yes` to the +runtime **and its dependencies**. The generated code reserves explicit frames, +so the existing stack analyzer can measure them. No upstream math source or +linker verification rule is changed, and `force_eval` is retained. + +The governing scalar contracts are in +[scalars and primitives](../../design/backend/fp/scalars-and-primitives.md). +Node comparison still distinguishes special-value semantics from ordinary +finite one-ulp differences; this change claims no universal Node bit identity. +The earlier local-copy reports are historical measurements, not measurements +of this artifact. + +## Baseline and artifact evidence + +The starting checkout was `stdlib/vendor-core-libraries` at +`4e53f83a1db33b129ef70c6b094dc7a6ebb64510`, with existing uncommitted work. +Before this change, the embedded fpmath artifact failed +`stack::tests::the_runtime_artifact_has_a_measured_static_bound` with +`unrecognized stack-pointer write makes the bound unknown`. + +An isolated upstream libm probe separately reproduced the original red-zone +rejection: the default build failed with `unrecognized stack-pointer access`, +while the build with red-zone use disabled passed. The two probe builds agreed +on 110198 executed Wasm calls across eleven functions, using boundary values +and a deterministic 10000-value binary64 sample (seed `0x5eed5a17`). NaNs were +compared by class; all other results were compared by bits. This checks the +build-option change on that sample, not exhaustive numerical accuracy. + +The rebuilt, packaged runtime artifact is 49204 bytes, with SHA-256 +`75cdd69833e058d014942eafdcd668eb9150e8d098a791871c327daf7bb20c73`. +Its measured stack bound is 1680 bytes within the 65536-byte stack reserve. +The private table has two slots, with function 54 initialized at slot 1. +Catalog provenance and the verifier fixture record the new artifact identity. +`tools/check-reproducible.sh` reproduced the packaged artifact byte-for-byte. + +## Validation + +`cargo test -p psrs-runtime -p psrs-linker` passed: 12 runtime tests and +45 linker tests across the library, compose, guest, and plan targets. +The public `Data.Number.atan` regression now executes both signs of the +smallest subnormal through the compiler and Wasmtime, checking that the +positive input is nonzero and both results preserve their exact values. + +With `PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib` and +`PSRS_REQUIRE_WASMTIME=1`, `cargo test -p psrs-driver --lib number_` passed +36 tests, including the public subnormal regression. The development package +is used explicitly because the existing lock does not yet expose all thirteen +remaining Number foreign bindings. No stdlib source or compiler lock change +is part of this migration. + +The library-owned official-FFI oracle commands are: + +```sh +node ../psrs-stdlib/conformance/number-atan.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /private/tmp/psrs-libm-atan-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /private/tmp/psrs-libm-atan-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /private/tmp/psrs-libm-atan-runtime +node ../psrs-stdlib/conformance/number-rest.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /private/tmp/psrs-libm-rest-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /private/tmp/psrs-libm-rest-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /private/tmp/psrs-libm-rest-runtime +``` + +Both oracle runs passed against development-package fingerprint +`fnv1a64-v1:bca0ace40bd0ccac` using Wasmtime 49.0.2, with exit 42 and empty +stdout/stderr. Atan exercised 149 inputs through 298 direct/higher-order checks; +the remaining functions exercised 1340 observations through 2680 checks. +The latter generator retains its eight documented one-ulp exclusions, so the +result is scoped to its asserted checks. The emitted application SHA-256 values +were `6a2264410e33b1518f9486ef484c1ec888a225e40c41decad763dfea1045107a` +for atan and `ec8c88cf6acb8dc4865c061f1aa9b5248b23ff13e12988ba319dc6592a71c7e0` for the remaining functions. + +Formatting (`cargo fmt --all --check`), strict workspace Clippy +(`cargo clippy --workspace --all-targets -- -D warnings`), shell syntax checks, +and `git diff --check` passed. + +The full workspace command was run with the same development package and +mandatory Wasmtime: + +```sh +PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib PSRS_REQUIRE_WASMTIME=1 \ + cargo test --workspace --no-fail-fast +``` + +It exited 101. The driver library had 712 passing tests and four failures; +all other workspace test targets passed. One failure was the Show trace test's +old literal artifact digest. That assertion was updated to the rebuilt digest. +The other three match the previously recorded baseline: + +- `dictionary_audit::execution::constrained_dictionary_parameters_precede_ordinary_arguments`: + the expected constrained MIR function is absent. +- `tests::functions::runs_a_polymorphic_identity_with_a_number`: + optimized WAT does not contain the asserted `f64` text. +- `tests::integration::compiles_if_expression_through_cfg_to_structured_wasm`: + optimized WAT does not contain the asserted `br_if` text. + +The initial migration did not immediately repeat the full workspace suite +after the digest-only test correction. The structure cleanup below records +the subsequent full rerun. + +After that correction, +`PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::show::` +passed all six tests, including the pinned-digest trace assertion and the +repeated-formatting stack test. The remaining three baseline failures were +not changed by this work. The complete workspace log is +`/private/tmp/psrs-libm-workspace-tests.log`; oracle execution reports are in +the two output directories shown above. + +## Module structure cleanup + +The thin inverse-cosine, inverse-sine, and inverse-tangent exports and their +existing boundary tests are consolidated in `src/number.rs`, alongside the +other scalar math exports and numeric semantic wrappers. The three one-function +modules are removed. Public Rust re-exports and raw Wasm export names are +preserved. The custom `atan2` compatibility algorithm remains in `src/atan2.rs` +and calls `libm::atan` directly; decimal parsing and formatting remain separate. +The rebuild after this cleanup reproduces the same packaged artifact +byte-for-byte, preserving its digest, layout, and stack-bound evidence. + +After the cleanup, formatting, strict workspace Clippy, and artifact +reproducibility checks passed. The full workspace command above was repeated +with mandatory Wasmtime and exited 101 solely for the same three baseline +failures: the driver library had 713 passed and 3 failed; all other workspace +targets passed. All 12 runtime tests passed, including the three relocated +inverse-function tests. The complete rerun log is +`/private/tmp/psrs-runtime-structure-tests.log`. diff --git a/docs/workflow/stdlib-conformance.md b/docs/workflow/stdlib-conformance.md index 527714ba..9e777ed5 100644 --- a/docs/workflow/stdlib-conformance.md +++ b/docs/workflow/stdlib-conformance.md @@ -352,3 +352,23 @@ then `x`. Quadrant boundaries, both zero signs, both infinities, and large ratios match that FFI. Either NaN produces NaN. The compiler's checked numberAtan2 primitive calls one scalar numeric-runtime export with two Number arguments. Wasm has no two-argument inverse-tangent instruction. + +For the remaining Number foreigns through the same public-call shape: + +```sh +node ../psrs-stdlib/conformance/number-rest.mjs \ + /private/tmp/ps-pkgs/purescript-numbers /tmp/psrs-number-rest-oracle +node ../psrs-stdlib/tools/conformance.mjs run \ + --compiler ./target/debug/psrs --stdlib-root ../psrs-stdlib \ + --input /tmp/psrs-number-rest-oracle/Main.purs \ + --expected-exit 42 --timeout 240 --out /tmp/psrs-number-rest-runtime +``` + +The generator invokes the pinned official FFI for `nan`, `isNaN`, `infinity`, +`cos`, `exp`, `log`, `max`, `min`, `pow`, `remainder`, `sign`, `sin`, and +`tan`. Each asserted check uses a direct public call and a higher-order call. +NaN results use inequality. Zero results use a reciprocal so the sign is +visible. Eight measured inputs where fdlibm 0.2.15 differs from that Node by +one ulp are recorded in `observations.json` and are not asserted. A separate +2000-draw sample still finds further one-ulp trigonometric gaps, so this +oracle does not establish bit identity for every input. From eb9f86a0af795d90d26a950af4a3e00f3bdec19a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Thu, 8 Oct 2026 22:25:13 +0800 Subject: [PATCH 079/148] Check driver regression contracts before optimization --- .../src/tests/dictionary_audit/execution.rs | 47 ++++++++--- .../dictionary_audit/fixtures/ordering.rs | 80 +++++++++++-------- crates/psrs-driver/src/tests/functions.rs | 37 ++++++--- crates/psrs-driver/src/tests/integration.rs | 44 +++++++--- docs/implementation/backend/optimization.md | 32 ++++++++ .../backend/type-classes-and-dictionaries.md | 12 ++- .../stdlib/runtime-libm-2026-10-08.md | 6 ++ 7 files changed, 189 insertions(+), 69 deletions(-) diff --git a/crates/psrs-driver/src/tests/dictionary_audit/execution.rs b/crates/psrs-driver/src/tests/dictionary_audit/execution.rs index d49f763b..bfeab79d 100644 --- a/crates/psrs-driver/src/tests/dictionary_audit/execution.rs +++ b/crates/psrs-driver/src/tests/dictionary_audit/execution.rs @@ -78,7 +78,7 @@ fn recursive_instance_context_executes() { /// are its dictionaries, in declared order, before the ordinary argument. #[test] fn constrained_dictionary_parameters_precede_ordinary_arguments() { - let (fixture, entry) = ordered_dictionaries_module(); + let (fixture, entry) = ordered_dictionaries_module(false); let mut core = psrs_core::lower_module(fixture).expect("ordered dictionary fixture lowers"); core.entry = Some(entry); let declaration = core @@ -98,9 +98,10 @@ fn constrained_dictionary_parameters_precede_ordinary_arguments() { "dictionary parameters must lead the ordinary argument" ); - let (fixture, entry) = ordered_dictionaries_module(); - let stages = compile_fixture("ordered_dictionaries", fixture, entry); - let cc_function = stages + core.verify().expect("ordered dictionary Core verifies"); + let backend_input = + psrs_backend::cc::lower_module(core).expect("ordered dictionary Core lowers to CC"); + let cc_function = backend_input .cc .functions .iter() @@ -130,16 +131,44 @@ fn constrained_dictionary_parameters_precede_ordinary_arguments() { psrs_backend::cc::ValueShape::Integer, "the ordinary argument must follow the dictionaries" ); - let mir_function = stages - .mir + // Optimization may inline and remove this function. Inspect the calling + // convention at the lowering boundary where it is established. + let (mir, _) = psrs_backend::mir::lower_module_with_bindings( + backend_input.cc, + backend_input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .expect("ordered dictionary CC lowers to MIR"); + let mir_function = mir .functions .iter() .find(|function| function.name == "constrained") .expect("MIR constrained function"); - assert_eq!(mir_function.parameters.len(), 3); + let parameter_types = mir_function + .parameters + .iter() + .map(|parameter| { + &mir_function + .values + .iter() + .find(|value| value.id == *parameter) + .expect("declared MIR parameter value") + .ty + }) + .collect::>(); + assert_eq!(parameter_types.len(), 3); + assert!( + parameter_types[..2] + .iter() + .all(|ty| matches!(ty, psrs_backend::types::ValueType::Ref(_))), + "dictionary references must lead the MIR parameters: {parameter_types:?}" + ); + assert_eq!(*parameter_types[2], psrs_backend::types::ValueType::I32); - let (fixture, entry) = ordered_dictionaries_module(); - expect_fixture_exit("ordered_dictionaries", fixture, entry, 42); + for (second_accepts, expected) in [(false, 42), (true, 0)] { + let (fixture, entry) = ordered_dictionaries_module(second_accepts); + expect_fixture_exit("ordered_dictionaries", fixture, entry, expected); + } } /// DICT-06, DICT-10: a `let`-bound dictionary is constructed once in the diff --git a/crates/psrs-driver/src/tests/dictionary_audit/fixtures/ordering.rs b/crates/psrs-driver/src/tests/dictionary_audit/fixtures/ordering.rs index bb595aa7..43ce60d2 100644 --- a/crates/psrs-driver/src/tests/dictionary_audit/fixtures/ordering.rs +++ b/crates/psrs-driver/src/tests/dictionary_audit/fixtures/ordering.rs @@ -7,8 +7,9 @@ use psrs_thir as thir; /// A constrained binding with two dictionary parameters ahead of its ordinary /// argument: `f :: A -> B -> Int -> Int`. The dictionary order is observable -/// because each dictionary uses a distinct method label. -pub(crate) fn ordered_dictionaries_module() -> (thir::Module, SymbolId) { +/// because the first method returns true while the second returns the supplied +/// Boolean. Both dictionary arguments contribute to the result. +pub(crate) fn ordered_dictionaries_module(second_accepts: bool) -> (thir::Module, SymbolId) { let module_id = ModuleId(0); let main = SymbolId::new(module_id, 0); let a_dict = SymbolId::new(module_id, 1); @@ -54,12 +55,53 @@ pub(crate) fn ordered_dictionaries_module() -> (thir::Module, SymbolId) { let b_dict_value = typed( thir::ExprKind::Record(vec![( "b".into(), - typed(thir::ExprKind::Global(is_positive), method, span), + typed( + thir::ExprKind::Lambda { + binder: binder(0, "value", integer, span), + body: Box::new(typed( + thir::ExprKind::Boolean(second_accepts), + boolean, + span, + )), + }, + method, + span, + ), )]), dict_b, span, ); - // `\da -> \db -> \x -> if da.a x then x else 0` + let method_call = |local, dictionary_type, field: &str| { + typed( + thir::ExprKind::Application( + Box::new(typed( + thir::ExprKind::FieldAccess { + expression: Box::new(typed( + thir::ExprKind::Local(LocalId(local)), + dictionary_type, + span, + )), + field: field.into(), + }, + method, + span, + )), + Box::new(typed(thir::ExprKind::Local(LocalId(2)), integer, span)), + ), + boolean, + span, + ) + }; + let second_check = typed( + thir::ExprKind::If { + condition: Box::new(method_call(1, dict_b, "b")), + then_branch: Box::new(typed(thir::ExprKind::Integer(0), integer, span)), + else_branch: Box::new(typed(thir::ExprKind::Local(LocalId(2)), integer, span)), + }, + integer, + span, + ); + // `\da -> \db -> \x -> if da.a x then (if db.b x then 0 else x) else 0` let constrained_value = typed( thir::ExprKind::Lambda { binder: binder(0, "da", dict_a, span), @@ -71,34 +113,8 @@ pub(crate) fn ordered_dictionaries_module() -> (thir::Module, SymbolId) { binder: binder(2, "x", integer, span), body: Box::new(typed( thir::ExprKind::If { - condition: Box::new(typed( - thir::ExprKind::Application( - Box::new(typed( - thir::ExprKind::FieldAccess { - expression: Box::new(typed( - thir::ExprKind::Local(LocalId(0)), - dict_a, - span, - )), - field: "a".into(), - }, - method, - span, - )), - Box::new(typed( - thir::ExprKind::Local(LocalId(2)), - integer, - span, - )), - ), - boolean, - span, - )), - then_branch: Box::new(typed( - thir::ExprKind::Local(LocalId(2)), - integer, - span, - )), + condition: Box::new(method_call(0, dict_a, "a")), + then_branch: Box::new(second_check), else_branch: Box::new(typed( thir::ExprKind::Integer(0), integer, diff --git a/crates/psrs-driver/src/tests/functions.rs b/crates/psrs-driver/src/tests/functions.rs index 6fbe2a28..a9e2243a 100644 --- a/crates/psrs-driver/src/tests/functions.rs +++ b/crates/psrs-driver/src/tests/functions.rs @@ -107,20 +107,35 @@ main = identity 42 #[test] fn runs_a_polymorphic_identity_with_a_number() { - let source = r#"module Main where + for (input, expected) in [("1.5", 42), ("2.5", 1)] { + let source = format!( + r#"module Main where +foreign import "psrs:intrinsic#numberEq" equalNumber :: Number -> Number -> Boolean identity :: forall a. a -> a identity value = value use :: Number -> Int -use value = 42 -main = use (identity 1.5) -"#; - let artifact = compile_source("Main.purs", source).expect("lowering a polymorphic Number"); - assert!(artifact.wat.contains("f64")); - let Some(output) = run_with_wasmtime(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); +use value = if equalNumber value 1.5 then 42 else 1 +main = use (identity {input}) +"# + ); + // The optimized artifact may fold the identity and comparison. Number + // representation belongs to MIR lowering, before those optimizations. + let mir = lower_source_to_mir(&source); + assert!( + mir.functions + .iter() + .flat_map(|function| &function.blocks) + .flat_map(|block| &block.instructions) + .any(|instruction| matches!( + instruction, + psrs_backend::mir::Instruction::NumberConstant { value, .. } if value == input + )) + ); + let Some(output) = run_with_wasmtime(&source) else { + return; + }; + assert_eq!(output.status.code(), Some(expected), "{input}: {output:?}"); + } } #[test] diff --git a/crates/psrs-driver/src/tests/integration.rs b/crates/psrs-driver/src/tests/integration.rs index c0ef058d..1bc1e86d 100644 --- a/crates/psrs-driver/src/tests/integration.rs +++ b/crates/psrs-driver/src/tests/integration.rs @@ -79,19 +79,37 @@ fn captures_number_values_in_closures() { #[test] fn compiles_if_expression_through_cfg_to_structured_wasm() { - let source = - "module Main where\nchoose condition = if condition then 9 else 2\nmain = choose true\n"; - let artifact = compile_source("Main.purs", source).unwrap(); - // The unified reducible structurer lowers a diamond to nested `block` - // regions with depth-relative branches, not a result-typed `if`. - assert!(artifact.wat.contains("block")); - assert!(artifact.wat.contains("br_if")); - assert!(artifact.wasm.len() > 8); - let Some(output) = run_with_wasmtime(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(9)); + for (condition, expected) in [("true", 9), ("false", 2)] { + let source = format!( + "module Main where\n\ + apply :: (Boolean -> Int) -> Boolean -> Int\n\ + apply f condition = f condition\n\ + choose condition = if condition then 9 else 2\n\ + main = apply choose {condition}\n" + ); + // Inspect the diamond at MIR lowering, and pass `choose` as a function + // value so the current optimizer retains its runtime branch body. + // The final encoding is free to choose any equivalent control flow. + let mir = lower_source_to_mir(&source); + let choose = mir + .functions + .iter() + .find(|function| function.name == "choose") + .expect("unoptimized choose function"); + assert!(choose.blocks.iter().any(|block| matches!( + block.terminator, + Some(psrs_backend::mir::Terminator::Branch { then_block, else_block, .. }) + if then_block != else_block + ))); + let Some(output) = run_with_wasmtime(&source) else { + return; + }; + assert_eq!( + output.status.code(), + Some(expected), + "{condition}: {output:?}" + ); + } } #[test] diff --git a/docs/implementation/backend/optimization.md b/docs/implementation/backend/optimization.md index d69facb6..d431272b 100644 --- a/docs/implementation/backend/optimization.md +++ b/docs/implementation/backend/optimization.md @@ -248,3 +248,35 @@ The optimization topic's own obligations are Verified. The broader BE-12 row stays `Partial` until both stages reach the official `M8-O` optimization and `CoreFn` compatibility gate and named-global/cross-module specialization coverage grows under explicit linkage rules. + +## Driver assertions at optimization boundaries + +The driver regressions `constrained_dictionary_parameters_precede_ordinary_arguments`, +`runs_a_polymorphic_identity_with_a_number`, and +`compiles_if_expression_through_cfg_to_structured_wasm` inspect signatures, +Number literals, and branch edges at their pre-optimization lowering boundary. +They do not require optimized MIR to retain an inlined function or final WAT +to retain `f64`/`br_if` text after equivalent simplification. + +Runtime cases consume the Number result (1.5 and 2.5 select distinct exits), +execute both Boolean branches through a function value, and vary the second +dictionary method so dropping or swapping a dictionary affects the result. +The dictionary requirement evidence is recorded under DICT-03 in +[type classes and dictionaries](type-classes-and-dictionaries.md). + +Validation on 2026-10-08, starting at compiler revision `d623322`: + +```sh +PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib PSRS_REQUIRE_WASMTIME=1 \ + cargo test --workspace --no-fail-fast +cargo fmt --all --check +cargo clippy --workspace --all-targets -- -D warnings +``` + +All three formerly failing regressions passed individually with mandatory +Wasmtime. The full workspace command then exited 0: the driver library passed +all 716 tests, and every other workspace test target passed. Formatting and +strict Clippy passed. The explicit development package matches the package +used for the earlier three-failure baseline; this is not a claim that the +uncommitted library contents match `stdlib.lock.json`. The full workspace log +is `/private/tmp/psrs-three-regressions-workspace.log`. diff --git a/docs/implementation/backend/type-classes-and-dictionaries.md b/docs/implementation/backend/type-classes-and-dictionaries.md index 43f5c5e2..29bcc37e 100644 --- a/docs/implementation/backend/type-classes-and-dictionaries.md +++ b/docs/implementation/backend/type-classes-and-dictionaries.md @@ -139,10 +139,14 @@ DICT-03: Core lambda parameters in source order; cc/lower/call/application.rs evaluates callee then arguments left to right. Tests: dictionary_audit::execution::constrained_dictionary_parameters_precede_ordinary_arguments - asserts the Core lambda binder order [da, db, x], compiles the program, and - executes it under Wasmtime to exit 42. - Input boundary: verified Typed Core. - Result: pass; executed. + asserts Core binder order [da, db, x] and checks the dictionary-reference, + dictionary-reference, integer signature in CC and MIR before optimization. + The first method returns true; varying the second method between false + and true makes optimized execution return 42 and 0 respectively, so both + dictionary positions affect the result. An optimized artifact is not + required to retain the constrained function after inlining. + Input boundary: verified Typed Core, pre-optimization CC and MIR. + Result: pass; both dictionary variants executed under mandatory Wasmtime. Gaps: none. DICT-04: Implementation: crates/psrs-core/src/lower/dictionary.rs (Instance applies the diff --git a/docs/implementation/stdlib/runtime-libm-2026-10-08.md b/docs/implementation/stdlib/runtime-libm-2026-10-08.md index 94d2eeb6..02c5a305 100644 --- a/docs/implementation/stdlib/runtime-libm-2026-10-08.md +++ b/docs/implementation/stdlib/runtime-libm-2026-10-08.md @@ -145,3 +145,9 @@ failures: the driver library had 713 passed and 3 failed; all other workspace targets passed. All 12 runtime tests passed, including the three relocated inverse-function tests. The complete rerun log is `/private/tmp/psrs-runtime-structure-tests.log`. + +The three historical test failures above were subsequently corrected by +checking structure before optimization and strengthening runtime cases; see +[driver assertions at optimization boundaries](../backend/optimization.md#driver-assertions-at-optimization-boundaries) +for the subsequent passing workspace validation. That test-only follow-up +does not change this runtime artifact. From d89c8701de3998d51b3c4dc9e59d8db988c5d1cd Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Thu, 8 Oct 2026 22:26:03 +0800 Subject: [PATCH 080/148] Pin stdlib with remaining Number math bindings --- stdlib.lock.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/stdlib.lock.json b/stdlib.lock.json index ede8d76a..cf1aaa9f 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "767ffd7f5bbdbf1a2e1bc568b2dce88deeb5ce88", - "source_fingerprint": "fnv1a64-v1:fe305ab57e585eca" + "revision": "1e01310daa7e56de5ed379029d6a24dcf39e879c", + "source_fingerprint": "fnv1a64-v1:bca0ace40bd0ccac" } From 9da4fd18535476c87c87373400a209c245fa22b1 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Fri, 9 Oct 2026 03:00:47 +0800 Subject: [PATCH 081/148] Replace synthesized realloc with a checked runtime allocator Resolve runtime operations through a checked unit dependency graph and use one pinned dlmalloc provider for canonical allocation and memory growth. Bind its lazy initialization to an application-owned constant heap getter, verify that getter before composition, and remove the generated allocator. Organize the runtime into ABI contracts, catalog metadata, numeric code and allocator code while preserving its public exports. Reproduce both pinned artifacts through their build scripts and record the integrated evidence. Validation: mandatory-Wasmtime workspace tests, workspace Clippy, runtime all-feature tests and Clippy, formatting, and byte-for-byte reproduction of both artifacts passed. Corpus scoreboards were not remeasured; remaining allocator acceptance obligations are documented separately. --- Cargo.lock | 12 + crates/psrs-backend/src/abi/mod.rs | 13 +- crates/psrs-backend/src/abi/reserved.rs | 17 +- crates/psrs-backend/src/linking/mod.rs | 40 +- crates/psrs-backend/src/pipeline/emission.rs | 9 + crates/psrs-backend/src/target_runtime/mod.rs | 37 +- crates/psrs-backend/src/wasm/encode.rs | 3 + crates/psrs-backend/src/wasm/lower/asm.rs | 4 - .../psrs-backend/src/wasm/lower/codec/mod.rs | 22 +- .../psrs-backend/src/wasm/lower/extent/mod.rs | 28 +- .../src/wasm/lower/extent/tests/mod.rs | 9 +- crates/psrs-backend/src/wasm/lower/mod.rs | 82 ++-- .../wasm/lower/post_return/tests/buffer.rs | 281 +++++++++++ .../lower/post_return/tests/composition.rs | 27 +- .../src/wasm/lower/post_return/tests/mod.rs | 246 +--------- .../src/wasm/lower/realloc/block.rs | 312 ------------ .../src/wasm/lower/realloc/mod.rs | 290 ++--------- .../src/wasm/lower/realloc/tests.rs | 422 ---------------- crates/psrs-backend/src/wasm/mod.rs | 4 + crates/psrs-backend/src/wasm/verify.rs | 21 +- .../psrs-driver/src/tests/diagnosis_trace.rs | 2 +- crates/psrs-driver/src/tests/show.rs | 11 +- crates/psrs-linker/src/application.rs | 62 +++ crates/psrs-linker/src/graph/mod.rs | 382 +++++++++++++++ crates/psrs-linker/src/graph/select.rs | 183 +++++++ crates/psrs-linker/src/lib.rs | 15 +- crates/psrs-linker/src/plan.rs | 450 +++++++++--------- crates/psrs-linker/src/runtime.rs | 66 ++- crates/psrs-linker/src/stack/mod.rs | 52 +- crates/psrs-linker/src/stack/tests.rs | 18 + crates/psrs-linker/src/target.rs | 76 ++- crates/psrs-linker/src/verify/mod.rs | 26 +- crates/psrs-linker/src/verify/parse.rs | 37 +- crates/psrs-linker/src/verify/tests.rs | 5 +- crates/psrs-linker/tests/compose.rs | 27 +- crates/psrs-linker/tests/graph.rs | 355 ++++++++++++++ crates/psrs-linker/tests/heap_getter.rs | 168 +++++++ crates/psrs-linker/tests/plan.rs | 90 ++-- crates/psrs-runtime/Cargo.toml | 8 +- .../psrs-runtime/artifact/psrs_allocator.wasm | Bin 0 -> 8062 bytes .../psrs-runtime/artifact/psrs_runtime.wasm | Bin 49204 -> 49212 bytes crates/psrs-runtime/src/abi/allocator.rs | 27 ++ crates/psrs-runtime/src/abi/mod.rs | 43 ++ crates/psrs-runtime/src/abi/number.rs | 189 ++++++++ .../psrs-runtime/src/allocator/algorithm.rs | 242 ++++++++++ crates/psrs-runtime/src/allocator/mod.rs | 8 + crates/psrs-runtime/src/allocator/phase.rs | 40 ++ .../psrs-runtime/src/allocator/provision.rs | 60 +++ crates/psrs-runtime/src/allocator/wasm.rs | 162 +++++++ crates/psrs-runtime/src/catalog.rs | 303 ------------ crates/psrs-runtime/src/catalog/allocator.rs | 107 +++++ crates/psrs-runtime/src/catalog/mod.rs | 25 + crates/psrs-runtime/src/catalog/model.rs | 152 ++++++ crates/psrs-runtime/src/catalog/number.rs | 244 ++++++++++ crates/psrs-runtime/src/catalog/package.rs | 42 ++ crates/psrs-runtime/src/catalog/wit.rs | 57 +++ crates/psrs-runtime/src/lib.rs | 279 ++--------- crates/psrs-runtime/src/{ => number}/atan2.rs | 0 .../psrs-runtime/src/{ => number}/decimal.rs | 0 .../src/{formatter.rs => number/format.rs} | 10 +- .../src/{number.rs => number/math.rs} | 0 crates/psrs-runtime/src/number/mod.rs | 15 + crates/psrs-runtime/src/panic.rs | 6 + crates/psrs-runtime/tools/build-allocator.sh | 14 + crates/psrs-runtime/tools/build.sh | 2 +- .../psrs-runtime/tools/check-reproducible.sh | 30 +- docs/design/backend/README.md | 2 + ...anonical-buffer-allocation-and-lifetime.md | 5 + .../wasm/canonical-realloc-runtime-adapter.md | 273 +++++++++++ ...re-object-linking-and-compilation-units.md | 358 ++++++++++++++ .../backend/wasm/linking-and-runtime.md | 43 +- .../backend/linking-and-runtime.md | 67 +++ 72 files changed, 4448 insertions(+), 2269 deletions(-) create mode 100644 crates/psrs-backend/src/wasm/lower/post_return/tests/buffer.rs delete mode 100644 crates/psrs-backend/src/wasm/lower/realloc/block.rs delete mode 100644 crates/psrs-backend/src/wasm/lower/realloc/tests.rs create mode 100644 crates/psrs-linker/src/graph/mod.rs create mode 100644 crates/psrs-linker/src/graph/select.rs create mode 100644 crates/psrs-linker/tests/graph.rs create mode 100644 crates/psrs-linker/tests/heap_getter.rs create mode 100644 crates/psrs-runtime/artifact/psrs_allocator.wasm create mode 100644 crates/psrs-runtime/src/abi/allocator.rs create mode 100644 crates/psrs-runtime/src/abi/mod.rs create mode 100644 crates/psrs-runtime/src/abi/number.rs create mode 100644 crates/psrs-runtime/src/allocator/algorithm.rs create mode 100644 crates/psrs-runtime/src/allocator/mod.rs create mode 100644 crates/psrs-runtime/src/allocator/phase.rs create mode 100644 crates/psrs-runtime/src/allocator/provision.rs create mode 100644 crates/psrs-runtime/src/allocator/wasm.rs delete mode 100644 crates/psrs-runtime/src/catalog.rs create mode 100644 crates/psrs-runtime/src/catalog/allocator.rs create mode 100644 crates/psrs-runtime/src/catalog/mod.rs create mode 100644 crates/psrs-runtime/src/catalog/model.rs create mode 100644 crates/psrs-runtime/src/catalog/number.rs create mode 100644 crates/psrs-runtime/src/catalog/package.rs create mode 100644 crates/psrs-runtime/src/catalog/wit.rs rename crates/psrs-runtime/src/{ => number}/atan2.rs (100%) rename crates/psrs-runtime/src/{ => number}/decimal.rs (100%) rename crates/psrs-runtime/src/{formatter.rs => number/format.rs} (88%) rename crates/psrs-runtime/src/{number.rs => number/math.rs} (100%) create mode 100644 crates/psrs-runtime/src/number/mod.rs create mode 100644 crates/psrs-runtime/src/panic.rs create mode 100755 crates/psrs-runtime/tools/build-allocator.sh create mode 100644 docs/design/backend/wasm/canonical-realloc-runtime-adapter.md create mode 100644 docs/design/backend/wasm/core-object-linking-and-compilation-units.md diff --git a/Cargo.lock b/Cargo.lock index 10d3b2f9..9d379de5 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -120,6 +120,17 @@ dependencies = [ "crypto-common", ] +[[package]] +name = "dlmalloc" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ad5208a115eaba24916f7456929832e310a81518c641f93fee4f89aa93aa3675" +dependencies = [ + "cfg-if", + "libc", + "windows-sys", +] + [[package]] name = "equivalent" version = "1.0.2" @@ -430,6 +441,7 @@ dependencies = [ name = "psrs-runtime" version = "0.1.0" dependencies = [ + "dlmalloc", "libm", "ryu-js", "wasm-encoder", diff --git a/crates/psrs-backend/src/abi/mod.rs b/crates/psrs-backend/src/abi/mod.rs index 78f32d93..bf0e0233 100644 --- a/crates/psrs-backend/src/abi/mod.rs +++ b/crates/psrs-backend/src/abi/mod.rs @@ -63,17 +63,16 @@ pub const SCRATCH_SIZE: u32 = 16; /// The first linear-memory offset after the scratch region. pub const SCRATCH_END: u32 = PRINT_SCRATCH as u32 + SCRATCH_SIZE; -/// The start of the allocator's heap-state segment: two pointer-width words -/// holding the free-list head and the bump break. It follows the scratch region. +/// Former generated-allocator state address. The runtime provider keeps no +/// state here, so the range is empty and the planner skips it. pub const HEAP_STATE: u32 = SCRATCH_END; -/// The byte size of the heap-state segment: a free-list head word and a bump -/// break word, each one wasm32 pointer word. -pub const HEAP_STATE_SIZE: u32 = 2 * WORD_SIZE; +/// The generated heap-state segment is not reserved. +pub const HEAP_STATE_SIZE: u32 = 0; /// The first address the canonical allocator may hand out. It is aligned to the -/// block granularity so every block header stays aligned. -pub const HEAP_START: u32 = (HEAP_STATE + HEAP_STATE_SIZE).next_multiple_of(MIN_BLOCK); +/// block granularity and begins immediately after the scratch region. +pub const HEAP_START: u32 = SCRATCH_END.next_multiple_of(MIN_BLOCK); /// A wasm32 address word. pub const WORD_SIZE: u32 = 4; diff --git a/crates/psrs-backend/src/abi/reserved.rs b/crates/psrs-backend/src/abi/reserved.rs index 633a90fa..be4f0594 100644 --- a/crates/psrs-backend/src/abi/reserved.rs +++ b/crates/psrs-backend/src/abi/reserved.rs @@ -2,14 +2,15 @@ //! //! Allocators that count downward from `u32::MAX` must skip this set. The //! numeric-runtime symbols are ordinary MIR imports of artifact exports. The -//! allocator and string-boundary symbols are synthesized locally and are never -//! core imports. +//! allocator symbol is a runtime operation lowered through a local forwarder. +//! String-boundary symbols are synthesized locally and are never core imports. use psrs_hir::{ModuleId, SymbolId}; -/// Reserved MIR symbol for the allocator synthesized after ABI memory layout -/// is known. Calls to this symbol become calls to the local `cabi_realloc` -/// function during Wasm lowering; it is never emitted as a core import. +/// Reserved MIR symbol for canonical `cabi_realloc`. +/// +/// Linking selects the allocator runtime unit. Wasm lowering imports that +/// export and emits a local forwarder; codecs and cleanup call the forwarder. pub(crate) const REALLOC_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 1); /// Reserved symbols for the string boundary helpers at the canonical ABI. @@ -49,9 +50,13 @@ pub(crate) const NUMBER_NAN_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSIC pub(crate) const NUMBER_INFINITY_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 23); +/// Reserved symbol for the application-owned constant heap getter. +pub(crate) const HEAP_BASE_SYMBOL: SymbolId = SymbolId::new(ModuleId::INTRINSICS, u32::MAX - 24); + /// Every symbol this allocator must not reuse. -pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 23] = [ +pub(crate) const RESERVED_ABI_SYMBOLS: [SymbolId; 24] = [ REALLOC_SYMBOL, + HEAP_BASE_SYMBOL, STRING_TO_BYTES_SYMBOL, BYTES_TO_STRING_SYMBOL, VALIDATE_STEP_SYMBOL, diff --git a/crates/psrs-backend/src/linking/mod.rs b/crates/psrs-backend/src/linking/mod.rs index 209850c9..0f119684 100644 --- a/crates/psrs-backend/src/linking/mod.rs +++ b/crates/psrs-backend/src/linking/mod.rs @@ -11,11 +11,11 @@ use crate::target_runtime; use crate::{BackendError, TargetCapabilities}; use psrs_hir::{ModuleId, SymbolId}; use psrs_linker::{ - ArtifactReference, BindingRequirement, Boundary, CheckedLinkPlan, CoreSignature, CoreType, - MemoryDemand, Provider, RequirementId, ResolvedWorldContext, TargetLinkInput, TargetPolicy, + BindingRequirement, Boundary, CheckedLinkPlan, CoreSignature, CoreType, MemoryDemand, Provider, + RequirementId, ResolvedWorldContext, TargetLinkInput, TargetPolicy, }; use psrs_span::TextRange; -use std::collections::{BTreeMap, HashMap}; +use std::collections::HashMap; use std::sync::{Arc, OnceLock}; /// A checked plan together with the backend's requirement identity mappings. @@ -57,13 +57,38 @@ pub(crate) fn plan_for_module( let mut requirements = Vec::new(); let mut symbols: Vec<(SymbolId, RequirementId)> = Vec::new(); let mut spans: HashMap)> = HashMap::new(); - let mut artifacts: BTreeMap = BTreeMap::new(); let mut next = 0_u32; let owner = module.entry.map(|entry| entry.module); for import in &module.imports { let id = RequirementId(next); next += 1; + if import.symbol == abi::REALLOC_SYMBOL { + crate::target_intrinsics::generated::verify(module, import).map_err(|message| { + vec![BackendError::invalid_ir( + "P9 target linking", + module.span, + message, + )] + })?; + let requirement = BindingRequirement { + id, + origin: psrs_runtime::ALLOCATOR_REALLOC_OP.name.into(), + boundary: Boundary::RawCore { + module: psrs_runtime::ALLOCATOR_MODULE.into(), + field: psrs_runtime::REALLOC_EXPORT.into(), + }, + expected: Some(core_signature(import, module.span)?), + provider: Provider::RuntimeOperation { + name: psrs_runtime::ALLOCATOR_REALLOC_OP.name.into(), + version: psrs_runtime::ALLOCATOR_REALLOC_OP.version.into(), + }, + }; + spans.insert(requirement.origin.clone(), (module.span, owner)); + requirements.push(requirement); + symbols.push((import.symbol, id)); + continue; + } // Generated helpers are roots even though no source foreign declaration // names them; they are lowered locally and need no external provider. if let Some(name) = crate::target_intrinsics::generated::name(import.symbol) { @@ -97,9 +122,6 @@ pub(crate) fn plan_for_module( )] })?; let requirement = implementation.requirement(id, core_signature(import, module.span)?); - artifacts - .entry(implementation.artifact.id.to_string()) - .or_insert_with(|| implementation.artifact_reference()); spans.insert(requirement.origin.clone(), (module.span, owner)); requirements.push(requirement); symbols.push((import.symbol, id)); @@ -165,7 +187,7 @@ pub(crate) fn plan_for_module( let input = TargetLinkInput { requirements, - artifacts: artifacts.into_values().collect(), + units: psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME), policy: TargetPolicy { permitted_host_interfaces: permitted_host_interfaces(context, target), }, @@ -260,6 +282,8 @@ fn memory_demand() -> MemoryDemand { allocator_state: (abi::HEAP_STATE, abi::HEAP_STATE + abi::HEAP_STATE_SIZE), base_heap_start: abi::HEAP_START, heap_alignment: abi::MIN_BLOCK, + growth_owner: psrs_runtime::ALLOCATOR_UNIT.id.into(), + maximum_pages: None, } } diff --git a/crates/psrs-backend/src/pipeline/emission.rs b/crates/psrs-backend/src/pipeline/emission.rs index 88262a8d..cb660060 100644 --- a/crates/psrs-backend/src/pipeline/emission.rs +++ b/crates/psrs-backend/src/pipeline/emission.rs @@ -267,4 +267,13 @@ fn annotate_plan(call: &mut crate::trace::TraceCall, link: &linking::LinkPlan) { ); call.add_parameter("heap_start", plan.memory().heap_start.to_string()); call.add_parameter("minimum_pages", plan.memory().minimum_pages.to_string()); + call.add_parameter("growth_owner", plan.growth_owner().to_string()); + call.add_parameter( + "runtime_units", + plan.units() + .iter() + .map(|unit| unit.id.clone()) + .collect::>() + .join(";"), + ); } diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index 6521364d..7abf60e9 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -6,10 +6,7 @@ use psrs_hir::{Intrinsic, SymbolId}; mod language; -use psrs_linker::{ - ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, Provider, - RequirementId, -}; +use psrs_linker::{BindingRequirement, Boundary, CoreSignature, CoreType, Provider, RequirementId}; /// Connects a checked language intrinsic to its embedded implementation. pub(crate) struct ArtifactImplementation { @@ -179,9 +176,11 @@ impl ArtifactImplementation { } } - /// The linker requirement for this artifact export. + /// The linker requirement for this runtime operation. + /// + /// `consumer` is the MIR call signature. Planning rejects it unless it + /// matches the catalog operation independently. pub fn requirement(&self, id: RequirementId, consumer: CoreSignature) -> BindingRequirement { - let signature = self.signature(); BindingRequirement { id, origin: format!("{:?}", self.intrinsic), @@ -190,20 +189,24 @@ impl ArtifactImplementation { field: self.abi.export.to_string(), }, expected: Some(consumer), - provider: Provider::ArtifactExport { - artifact: self.artifact.id.to_string(), - export: self.abi.export.to_string(), - signature, + provider: Provider::RuntimeOperation { + name: self.operation().name.to_string(), + version: self.operation().version.to_string(), }, } } - /// The pinned artifact and typed contract for this implementation. - pub fn artifact_reference(&self) -> ArtifactReference { - ArtifactReference { - contract: psrs_linker::runtime::contract(self.artifact), - bytes: self.artifact.bytes.to_vec(), - } + fn operation(&self) -> &'static psrs_runtime::ProvidedOperation { + psrs_runtime::PSRS_RUNTIME + .units + .iter() + .filter(|unit| unit.variant.id == self.artifact.id) + .find_map(|unit| { + unit.provided + .iter() + .find(|operation| operation.abi.export == self.abi.export) + }) + .expect("the runtime catalog publishes this intrinsic operation") } } @@ -242,7 +245,7 @@ mod tests { ); assert!(matches!( requirement.provider, - Provider::ArtifactExport { .. } + Provider::RuntimeOperation { .. } )); assert!(matches!( crate::target_intrinsics::implementation(Intrinsic::IntAdd), diff --git a/crates/psrs-backend/src/wasm/encode.rs b/crates/psrs-backend/src/wasm/encode.rs index 475599cb..7fd32315 100644 --- a/crates/psrs-backend/src/wasm/encode.rs +++ b/crates/psrs-backend/src/wasm/encode.rs @@ -73,6 +73,7 @@ pub fn encode_module(module: &Module) -> Result, Vec> { for global in &module.globals { let init = match global.init { GlobalInit::RefNull(heap) => ConstExpr::ref_null(heap), + GlobalInit::I32(value) => ConstExpr::i32_const(value as i32), }; globals.global( GlobalType { @@ -92,10 +93,12 @@ pub fn encode_module(module: &Module) -> Result, Vec> { let kind = match export.kind { ExportKind::Function => WasmExportKind::Func, ExportKind::Memory => WasmExportKind::Memory, + ExportKind::Global => WasmExportKind::Global, }; let index = match export.index { ExportIndex::Function(index) => index.0, ExportIndex::Memory(index) => index.0, + ExportIndex::Global(index) => index.0, }; exports.export(&export.name, kind, index); } diff --git a/crates/psrs-backend/src/wasm/lower/asm.rs b/crates/psrs-backend/src/wasm/lower/asm.rs index 4ad8e2da..31d72acb 100644 --- a/crates/psrs-backend/src/wasm/lower/asm.rs +++ b/crates/psrs-backend/src/wasm/lower/asm.rs @@ -75,10 +75,6 @@ impl Asm { self.stack.push(id); } - pub(crate) fn else_(&mut self) { - self.leaf(Instruction::Else); - } - pub(crate) fn end(&mut self) { self.leaf(Instruction::End); self.stack.pop(); diff --git a/crates/psrs-backend/src/wasm/lower/codec/mod.rs b/crates/psrs-backend/src/wasm/lower/codec/mod.rs index 39c6d62a..7872363a 100644 --- a/crates/psrs-backend/src/wasm/lower/codec/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/codec/mod.rs @@ -32,9 +32,9 @@ use psrs_span::TextRange; pub(super) fn signatures(string: DefinedTypeId) -> (FuncType, FuncType, FuncType) { use crate::abi; ( - super::generated_signature(abi::STRING_TO_BYTES_SYMBOL, Some(string)), - super::generated_signature(abi::BYTES_TO_STRING_SYMBOL, Some(string)), - super::generated_signature(abi::VALIDATE_STEP_SYMBOL, Some(string)), + generated_signature(abi::STRING_TO_BYTES_SYMBOL, Some(string)), + generated_signature(abi::BYTES_TO_STRING_SYMBOL, Some(string)), + generated_signature(abi::VALIDATE_STEP_SYMBOL, Some(string)), ) } @@ -54,3 +54,19 @@ pub(super) fn synthesize( decode::validate_step(validate_step_type, span), ] } + +fn generated_signature( + symbol: psrs_hir::SymbolId, + string: Option, +) -> FuncType { + let signature = crate::target_intrinsics::generated::signature(symbol, string) + .expect("the selected generated helper has a concrete signature"); + FuncType { + parameters: signature + .parameters + .into_iter() + .map(super::val_type) + .collect(), + results: signature.result.into_iter().map(super::val_type).collect(), + } +} diff --git a/crates/psrs-backend/src/wasm/lower/extent/mod.rs b/crates/psrs-backend/src/wasm/lower/extent/mod.rs index ef2c2c2b..6a4e2049 100644 --- a/crates/psrs-backend/src/wasm/lower/extent/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/extent/mod.rs @@ -4,7 +4,7 @@ mod access; mod address; use crate::BackendError; -use crate::abi::{HEAP_START, HEAP_STATE, SCRATCH_END}; +use crate::abi::SCRATCH_END; use crate::mir; const WASM32_ADDRESS_SPACE: u64 = 1_u64 << 32; @@ -14,8 +14,6 @@ const PASS: &str = "P10 Wasm structuring"; enum RegionKind { /// The reserved canonical return-area scratch. Scratch, - /// The allocator's free-list head and bump break. - HeapState, } #[derive(Clone, Copy, Debug)] @@ -27,13 +25,12 @@ struct Region { impl Region { fn writable(self) -> bool { - // Both regions are allocator-owned and read/write. - matches!(self.kind, RegionKind::Scratch | RegionKind::HeapState) + matches!(self.kind, RegionKind::Scratch) } } -/// Checks statically knowable MIR memory intervals against the ABI scratch and -/// heap-state regions. Dynamic reads retain WebAssembly's runtime bounds checks. +/// Checks statically knowable MIR memory intervals against the ABI scratch +/// region. Dynamic reads retain WebAssembly's runtime bounds checks. /// Dynamic writes must point into a buffer returned by the ABI allocator. GC /// string literals are not MIR-addressable and define no region. pub(super) fn verify_static_access_extents(module: &mir::Module) -> Result<(), Vec> { @@ -61,18 +58,11 @@ pub(super) fn verify_static_access_extents(module: &mir::Module) -> Result<(), V } fn build_regions() -> Vec { - vec![ - Region { - start: 0, - end: u64::from(SCRATCH_END), - kind: RegionKind::Scratch, - }, - Region { - start: u64::from(HEAP_STATE), - end: u64::from(HEAP_START), - kind: RegionKind::HeapState, - }, - ] + vec![Region { + start: 0, + end: u64::from(SCRATCH_END), + kind: RegionKind::Scratch, + }] } pub(super) fn function_error( diff --git a/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs b/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs index fb27a4bd..4fd089c3 100644 --- a/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs @@ -124,7 +124,7 @@ fn allows_reads_and_writes_inside_the_scratch_region() { } #[test] -fn allows_reads_and_writes_inside_the_heap_state_region() { +fn rejects_reads_and_writes_at_the_old_heap_state_address() { let function = function( vec![ decl(0, ValueType::I32), @@ -170,7 +170,12 @@ fn allows_reads_and_writes_inside_the_heap_state_region() { ValueId(3), ); - verify(function).expect("heap state is a readable and writable ABI region"); + let errors = verify(function).expect_err("the old heap-state address is not reserved"); + assert!( + errors[0] + .message + .contains("outside the canonical ABI regions") + ); } #[test] diff --git a/crates/psrs-backend/src/wasm/lower/mod.rs b/crates/psrs-backend/src/wasm/lower/mod.rs index 8ebec736..22e12d2a 100644 --- a/crates/psrs-backend/src/wasm/lower/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/mod.rs @@ -1,13 +1,13 @@ use super::convert::val_type; use super::{ - DataIndex, DataMode, DataSegment, Entry, Export, ExportIndex, ExportKind, FuncType, - FunctionIndex, Import, Memory, MemoryIndex, Module, Op, TypeIndex, + Entry, Export, ExportIndex, ExportKind, FuncType, FunctionIndex, Import, Memory, MemoryIndex, + Module, Op, TypeIndex, }; use crate::BackendError; use crate::abi::{self, names}; use crate::capability::TargetCapabilities; use crate::mir::{self, Function as MirFunction}; -use crate::types::{DataId, DefinedTypeId, MemoryId, ValueId, ValueType}; +use crate::types::{MemoryId, ValueId, ValueType}; use psrs_hir::SymbolId; use psrs_span::TextRange; use std::collections::HashMap; @@ -24,7 +24,7 @@ mod structure; use function::types::collect_function_types; use function::{ListLocals, lower_function}; -use realloc::build_realloc; +use realloc::forward_realloc; use runtime::{collect_literal_globals, collect_strings}; /// Structures MIR control flow and builds the thin Wasm IR. The ABI registry @@ -85,7 +85,7 @@ pub(crate) fn lower_module_with_plan( )); } - let (mut data, string_lengths) = collect_strings(module); + let (data, string_lengths) = collect_strings(module); let literal_globals = collect_literal_globals(module); if !literal_globals.globals.is_empty() && !target.mutable_globals { return Err(wasm_error( @@ -119,7 +119,7 @@ pub(crate) fn lower_module_with_plan( for import in &module.imports { if matches!( import.symbol, - abi::REALLOC_SYMBOL | abi::STRING_TO_BYTES_SYMBOL | abi::BYTES_TO_STRING_SYMBOL + abi::STRING_TO_BYTES_SYMBOL | abi::BYTES_TO_STRING_SYMBOL ) { continue; } @@ -245,11 +245,9 @@ pub(crate) fn lower_module_with_plan( let main_index = FunctionIndex(import_count + entry_function.id.0); - // `cabi_realloc` backs guest allocations for indirect parameter records and - // host allocations for returned lists/strings. Export it so the component - // host can allocate returned buffers. The bump allocator's free pointer - // lives after string data, and each allocation has a four-byte length - // prefix before its returned payload pointer. + // `cabi_realloc` backs guest allocations and host allocations for returned + // lists and strings. The export is a forwarder to the allocator runtime + // unit. The constant getter publishes the checked heap boundary. let mut exports = vec![ Export { name: abi::RUN_CORE_EXPORT.into(), @@ -263,33 +261,28 @@ pub(crate) fn lower_module_with_plan( }, ]; let minimum = link.plan.memory().minimum_pages; + let globals = literal_globals.globals; let mut realloc = None; if needs_realloc { - let realloc_type = TypeIndex(defined + types.len() as u32); - types.push(generated_signature(abi::REALLOC_SYMBOL, None)); + let import_index = *import_indices.get(&abi::REALLOC_SYMBOL).ok_or_else(|| { + wasm_error( + module.span, + "cabi_realloc has no checked allocator provider", + ) + })?; + let realloc_type = imports + .get(import_index.0 as usize) + .ok_or_else(|| wasm_error(module.span, "cabi_realloc import is missing"))? + .type_index; let index = indices.realloc.expect("a needed realloc has an index"); exports.push(Export { - name: "cabi_realloc".into(), + name: psrs_runtime::REALLOC_EXPORT.into(), kind: ExportKind::Function, index: ExportIndex::Function(index), }); - // The heap-state segment holds the free-list head (null) and the bump - // break (the first allocatable address). The allocator boundary is the - // one the checked plan reserved, after every artifact region. - let heap_start = link.plan.memory().heap_start; - let mut state = 0_u32.to_le_bytes().to_vec(); - state.extend_from_slice(&heap_start.to_le_bytes()); - data.push(DataSegment { - id: DataId(data.len() as u32), - index: DataIndex(data.len() as u32), - mode: DataMode::Active { - offset: abi::HEAP_STATE, - }, - bytes: state, - }); - realloc = Some(build_realloc(realloc_type, module.span)); + realloc = Some(forward_realloc(realloc_type, import_index.0, module.span)); } - let helpers = if needs_helpers { + let mut helpers = if needs_helpers { let string_type = string_type.expect("a needed codec has a GC string type"); let (stb, bts, step) = codec::signatures(string_type); let stb_type = TypeIndex(defined + types.len() as u32); @@ -311,6 +304,24 @@ pub(crate) fn lower_module_with_plan( Vec::new() }; + if needs_realloc { + let boundary = + link.plan.memory().heap_getter.as_ref().ok_or_else(|| { + wasm_error(module.span, "the allocator provider has no heap getter") + })?; + let index = FunctionIndex(entry_index.0 + 2 + helpers.len() as u32); + exports.push(Export { + name: boundary.field.clone(), + kind: ExportKind::Function, + index: ExportIndex::Function(index), + }); + helpers.push(realloc::heap_getter( + entry_type, + link.plan.memory().heap_start, + module.span, + )); + } + // `wasi:cli/run` returns a scalar, so the command export contributes no // post-return. The synthesis entry points stay reachable so an export // mechanism can populate the descriptor lists without dead code. @@ -328,7 +339,7 @@ pub(crate) fn lower_module_with_plan( minimum, maximum: None, }], - globals: literal_globals.globals, + globals, data, exports, entry: Some(Entry { @@ -443,12 +454,3 @@ pub(super) fn wasm_error(span: TextRange, message: &'static str) -> Vec) -> FuncType { - let signature = crate::target_intrinsics::generated::signature(symbol, string) - .expect("the selected generated helper has a concrete signature"); - FuncType { - parameters: signature.parameters.into_iter().map(val_type).collect(), - results: signature.result.into_iter().map(val_type).collect(), - } -} diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests/buffer.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests/buffer.rs new file mode 100644 index 00000000..06aefb25 --- /dev/null +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests/buffer.rs @@ -0,0 +1,281 @@ +//! String-export fixture whose `cabi_realloc` forwards to the allocator unit. + +use super::super::super::asm::{Asm, constant, get, memarg, set}; +use super::super::{BufferExport, synthesize_buffer_post_return}; +use crate::wasm::{ + Body, Export, ExportIndex, ExportKind, FuncType, Function, FunctionIndex, Import, Memory, + MemoryIndex, Module, Op, TypeIndex, +}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; +use wasm_encoder::{Instruction, ValType}; +use wit_parser::{Resolve, WorldId}; + +const IMPORT_REALLOC: u32 = 0; +const GET_STRING_INDEX: u32 = 1; +const POST_RETURN_INDEX: u32 = 2; +const REALLOC_INDEX: u32 = 3; +const DRIVER_INDEX: u32 = 4; + +const GET_STRING_TYPE: TypeIndex = TypeIndex(0); +const POST_RETURN_TYPE: TypeIndex = TypeIndex(1); +const REALLOC_TYPE: TypeIndex = TypeIndex(2); + +const STRING_LEN: i32 = 5; +const RETURN_AREA_SIZE: u32 = 8; +const RETURN_AREA_ALIGN: u32 = 4; +const CYCLES: i32 = 1_000; + +fn span() -> TextRange { + TextRange::new(0, 1) +} + +fn call_realloc(asm: &mut Asm, old: i32, old_len: i32, align: i32, new_len: i32) { + constant(asm, old); + constant(asm, old_len); + constant(asm, align); + constant(asm, new_len); + asm.leaf(Instruction::Call(REALLOC_INDEX)); +} + +fn get_string_body() -> Body { + let mut asm = Asm::new(); + call_realloc(&mut asm, 0, 0, 1, STRING_LEN); + set(&mut asm, 0); + for (offset, byte) in b"hello".iter().enumerate() { + get(&mut asm, 0); + if offset != 0 { + constant(&mut asm, offset as i32); + asm.leaf(Instruction::I32Add); + } + constant(&mut asm, i32::from(*byte)); + asm.leaf(Instruction::I32Store8(memarg(0))); + } + call_realloc( + &mut asm, + 0, + 0, + RETURN_AREA_ALIGN as i32, + RETURN_AREA_SIZE as i32, + ); + set(&mut asm, 1); + get(&mut asm, 1); + get(&mut asm, 0); + asm.leaf(Instruction::I32Store(memarg(0))); + get(&mut asm, 1); + constant(&mut asm, STRING_LEN); + asm.leaf(Instruction::I32Store(memarg(4))); + get(&mut asm, 1); + asm.into_body() +} + +fn driver_body() -> Body { + let mut asm = Asm::new(); + asm.leaf(Instruction::Call(GET_STRING_INDEX)); + set(&mut asm, 2); + get(&mut asm, 2); + asm.leaf(Instruction::Call(POST_RETURN_INDEX)); + asm.leaf(Instruction::MemorySize(0)); + set(&mut asm, 1); + constant(&mut asm, CYCLES); + set(&mut asm, 0); + let done = asm.label(); + let again = asm.label(); + asm.block(done); + asm.loop_(again); + get(&mut asm, 0); + asm.leaf(Instruction::I32Eqz); + asm.br_if(done); + asm.leaf(Instruction::Call(GET_STRING_INDEX)); + set(&mut asm, 2); + get(&mut asm, 2); + asm.leaf(Instruction::Call(POST_RETURN_INDEX)); + get(&mut asm, 0); + constant(&mut asm, 1); + asm.leaf(Instruction::I32Sub); + set(&mut asm, 0); + asm.br(again); + asm.end(); + asm.end(); + asm.leaf(Instruction::MemorySize(0)); + get(&mut asm, 1); + asm.leaf(Instruction::I32Eq); + asm.into_body() +} + +fn forward_realloc() -> Function { + Function { + symbol: SymbolId::new(ModuleId(0), REALLOC_INDEX), + name: psrs_runtime::REALLOC_EXPORT.into(), + type_index: REALLOC_TYPE, + parameters: vec![ValType::I32; 4], + locals: Vec::new(), + body: vec![ + Op::Leaf(Instruction::LocalGet(0)), + Op::Leaf(Instruction::LocalGet(1)), + Op::Leaf(Instruction::LocalGet(2)), + Op::Leaf(Instruction::LocalGet(3)), + Op::Leaf(Instruction::Call(IMPORT_REALLOC)), + ], + span: span(), + } +} + +fn function( + name: &str, + symbol: u32, + type_index: TypeIndex, + locals: usize, + body: Vec, +) -> Function { + Function { + symbol: SymbolId::new(ModuleId(0), symbol), + name: name.into(), + type_index, + parameters: Vec::new(), + locals: vec![ValType::I32; locals], + body, + span: span(), + } +} + +/// A core module exporting `get-string`, its post-return, and a reclaim driver. +pub(super) fn buffer_post_return_module() -> Module { + let (_, post_function, post_export) = synthesize_buffer_post_return( + &BufferExport { + core_name: "get-string".into(), + symbol: SymbolId::new(ModuleId(0), 1), + buffer_align: 1, + return_area_size: RETURN_AREA_SIZE, + return_area_align: RETURN_AREA_ALIGN, + }, + POST_RETURN_TYPE, + FunctionIndex(POST_RETURN_INDEX), + FunctionIndex(REALLOC_INDEX), + span(), + ); + Module { + name: "StringExport".into(), + imports: vec![Import { + module: psrs_runtime::ALLOCATOR_MODULE.into(), + name: psrs_runtime::REALLOC_EXPORT.into(), + type_index: REALLOC_TYPE, + }], + types: vec![ + FuncType { + parameters: Vec::new(), + results: vec![ValType::I32], + }, + FuncType { + parameters: vec![ValType::I32], + results: Vec::new(), + }, + FuncType { + parameters: vec![ValType::I32; 4], + results: vec![ValType::I32], + }, + ], + type_defs: Vec::new(), + functions: vec![ + function( + "get-string", + GET_STRING_INDEX, + GET_STRING_TYPE, + 2, + get_string_body(), + ), + post_function, + forward_realloc(), + function( + "check-reclaim", + DRIVER_INDEX, + GET_STRING_TYPE, + 3, + driver_body(), + ), + ], + memories: vec![Memory { + id: crate::types::MemoryId(0), + index: MemoryIndex(0), + minimum: 1, + maximum: None, + }], + data: Vec::new(), + exports: vec![ + Export { + name: "get-string".into(), + kind: ExportKind::Function, + index: ExportIndex::Function(FunctionIndex(GET_STRING_INDEX)), + }, + post_export, + Export { + name: psrs_runtime::REALLOC_EXPORT.into(), + kind: ExportKind::Function, + index: ExportIndex::Function(FunctionIndex(REALLOC_INDEX)), + }, + Export { + name: "check-reclaim".into(), + kind: ExportKind::Function, + index: ExportIndex::Function(FunctionIndex(DRIVER_INDEX)), + }, + Export { + name: "memory".into(), + kind: ExportKind::Memory, + index: ExportIndex::Memory(MemoryIndex(0)), + }, + Export { + name: psrs_runtime::HEAP_BOUNDARY_IMPORT.into(), + kind: ExportKind::Function, + index: ExportIndex::Function(FunctionIndex(DRIVER_INDEX + 1)), + }, + ], + entry: None, + realloc: None, + globals: Vec::new(), + helpers: vec![crate::wasm::lower::realloc::heap_getter( + GET_STRING_TYPE, + 0, + span(), + )], + span: span(), + } +} + +pub(super) fn string_world() -> (Resolve, WorldId) { + let wit = r#" + package fixture:strings@0.1.0; + world guest { + export get-string: func() -> string; + export check-reclaim: func() -> s32; + } + "#; + let mut resolve = Resolve::default(); + let package = resolve + .push_str("strings.wit", wit) + .expect("the string fixture should resolve"); + let world = resolve.packages[package] + .worlds + .get("guest") + .copied() + .expect("guest world"); + (resolve, world) +} + +pub(super) fn allocator_requirement() -> psrs_linker::BindingRequirement { + psrs_linker::BindingRequirement { + id: psrs_linker::RequirementId(0), + origin: psrs_runtime::ALLOCATOR_REALLOC_OP.name.into(), + boundary: psrs_linker::Boundary::RawCore { + module: psrs_runtime::ALLOCATOR_MODULE.into(), + field: psrs_runtime::REALLOC_EXPORT.into(), + }, + expected: Some(psrs_linker::CoreSignature { + parameters: vec![psrs_linker::CoreType::I32; 4], + result: Some(psrs_linker::CoreType::I32), + }), + provider: psrs_linker::Provider::RuntimeOperation { + name: psrs_runtime::ALLOCATOR_REALLOC_OP.name.into(), + version: psrs_runtime::ALLOCATOR_REALLOC_OP.version.into(), + }, + } +} diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs index 4c8515d7..315b2842 100644 --- a/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs @@ -24,20 +24,37 @@ pub(super) fn componentize( .collect(), }, requirements, - artifacts: Vec::new(), + units: psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME), memory: MemoryDemand { canonical_scratch: (0, crate::abi::SCRATCH_SIZE), - allocator_state: ( - crate::abi::HEAP_STATE, - crate::abi::HEAP_STATE + crate::abi::HEAP_STATE_SIZE, - ), + allocator_state: (crate::abi::HEAP_START, crate::abi::HEAP_START), base_heap_start: crate::abi::HEAP_START, heap_alignment: crate::abi::MIN_BLOCK, + growth_owner: psrs_runtime::ALLOCATOR_UNIT.id.into(), + maximum_pages: None, }, }, ) .map_err(|error| error.to_string())?; module.memories[0].minimum = plan.memory().minimum_pages; + if let Some(boundary) = plan.memory().heap_getter.as_ref() { + let export = module + .exports + .iter() + .find(|export| export.name == boundary.field) + .ok_or_else(|| format!("missing heap export `{}`", boundary.field))?; + let crate::wasm::ExportIndex::Function(_) = export.index else { + return Err("the heap boundary export is not a function".into()); + }; + let getter = module + .helpers + .iter_mut() + .find(|function| function.name == boundary.field) + .ok_or("the heap boundary getter is missing")?; + getter.body = vec![crate::wasm::Op::Leaf(wasm_encoder::Instruction::I32Const( + plan.memory().heap_start as i32, + ))]; + } let core = crate::wasm::encode_module(&module).map_err(|error| format!("{error:?}"))?; psrs_linker::compose(&context, &plan, &core) .map(|artifact| artifact.bytes) diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs index 1a3b5b8d..b1eb69fe 100644 --- a/crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests/mod.rs @@ -1,12 +1,8 @@ use super::super::super::{ - DataIndex, DataMode, DataSegment, Export, ExportIndex, ExportKind, FuncType, Function, - FunctionIndex, Import, Memory, MemoryIndex, Module, Op, TypeIndex, -}; -use super::super::asm::{Asm, constant, get, memarg, set}; -use super::{ - BufferExport, post_return_name, synthesize_buffer_post_return, - synthesize_owned_handle_post_return, + Export, ExportIndex, ExportKind, FuncType, Function, FunctionIndex, Import, Memory, + MemoryIndex, Module, Op, TypeIndex, }; +use super::{post_return_name, synthesize_owned_handle_post_return}; use psrs_hir::{ModuleId, SymbolId}; use psrs_span::TextRange; use wasm_encoder::{Instruction, ValType}; @@ -16,7 +12,9 @@ fn span() -> TextRange { TextRange::new(0, 1) } +mod buffer; mod composition; +use buffer::{allocator_requirement, buffer_post_return_module, string_world}; use composition::componentize; #[test] @@ -160,228 +158,6 @@ fn post_return_drops_an_owned_export_handle() { ); } -const GET_STRING_INDEX: u32 = 0; -const POST_RETURN_INDEX: u32 = 1; -const REALLOC_INDEX: u32 = 2; -const DRIVER_INDEX: u32 = 3; - -const GET_STRING_TYPE: TypeIndex = TypeIndex(0); -const POST_RETURN_TYPE: TypeIndex = TypeIndex(1); -const REALLOC_TYPE: TypeIndex = TypeIndex(2); - -const STRING_LEN: i32 = 5; -const RETURN_AREA_SIZE: u32 = 8; -const RETURN_AREA_ALIGN: u32 = 4; -const CYCLES: i32 = 1_000; - -fn call_realloc(asm: &mut Asm, old: i32, old_len: i32, align: i32, new_len: i32) { - constant(asm, old); - constant(asm, old_len); - constant(asm, align); - constant(asm, new_len); - asm.leaf(Instruction::Call(REALLOC_INDEX)); -} - -/// Allocates the string buffer and the return area, writes `hello` and the -/// `(pointer, length)` pair, and returns the return-area pointer. This is -/// the shape of an export lifted through a canonical return area. -fn get_string_body() -> super::super::super::Body { - let mut asm = Asm::new(); - call_realloc(&mut asm, 0, 0, 1, STRING_LEN); - set(&mut asm, 0); - for (offset, byte) in b"hello".iter().enumerate() { - get(&mut asm, 0); - if offset != 0 { - constant(&mut asm, offset as i32); - asm.leaf(Instruction::I32Add); - } - constant(&mut asm, i32::from(*byte)); - asm.leaf(Instruction::I32Store8(memarg(0))); - } - call_realloc( - &mut asm, - 0, - 0, - RETURN_AREA_ALIGN as i32, - RETURN_AREA_SIZE as i32, - ); - set(&mut asm, 1); - get(&mut asm, 1); - get(&mut asm, 0); - asm.leaf(Instruction::I32Store(memarg(0))); - get(&mut asm, 1); - constant(&mut asm, STRING_LEN); - asm.leaf(Instruction::I32Store(memarg(4))); - get(&mut asm, 1); - asm.into_body() -} - -/// Calls the export and then its post-return `CYCLES` times, and reports -/// whether linear memory stayed at one page. Reclaimed buffers are reused. -fn driver_body() -> super::super::super::Body { - let mut asm = Asm::new(); - constant(&mut asm, CYCLES); - set(&mut asm, 0); - let done = asm.label(); - let again = asm.label(); - asm.block(done); - asm.loop_(again); - get(&mut asm, 0); - asm.leaf(Instruction::I32Eqz); - asm.br_if(done); - asm.leaf(Instruction::Call(GET_STRING_INDEX)); - set(&mut asm, 1); - get(&mut asm, 1); - asm.leaf(Instruction::Call(POST_RETURN_INDEX)); - get(&mut asm, 0); - constant(&mut asm, 1); - asm.leaf(Instruction::I32Sub); - set(&mut asm, 0); - asm.br(again); - asm.end(); - asm.end(); - asm.leaf(Instruction::MemorySize(0)); - constant(&mut asm, 1); - asm.leaf(Instruction::I32Eq); - asm.into_body() -} - -fn function( - name: &str, - symbol: u32, - type_index: TypeIndex, - locals: usize, - body: Vec, -) -> Function { - Function { - symbol: SymbolId::new(ModuleId(0), symbol), - name: name.into(), - type_index, - parameters: Vec::new(), - locals: vec![ValType::I32; locals], - body, - span: span(), - } -} - -/// A core module exporting `get-string` (string result), its synthesized -/// `cabi_post_get-string`, and a driver that runs the pair in a loop. -fn buffer_post_return_module() -> Module { - let (_, post_function, post_export) = synthesize_buffer_post_return( - &BufferExport { - core_name: "get-string".into(), - symbol: SymbolId::new(ModuleId(0), 1), - buffer_align: 1, - return_area_size: RETURN_AREA_SIZE, - return_area_align: RETURN_AREA_ALIGN, - }, - POST_RETURN_TYPE, - FunctionIndex(POST_RETURN_INDEX), - FunctionIndex(REALLOC_INDEX), - span(), - ); - let mut state = 0_u32.to_le_bytes().to_vec(); - state.extend_from_slice(&crate::abi::HEAP_START.to_le_bytes()); - Module { - name: "StringExport".into(), - imports: Vec::new(), - types: vec![ - FuncType { - parameters: Vec::new(), - results: vec![ValType::I32], - }, - FuncType { - parameters: vec![ValType::I32], - results: Vec::new(), - }, - FuncType { - parameters: vec![ValType::I32; 4], - results: vec![ValType::I32], - }, - ], - type_defs: Vec::new(), - functions: vec![ - function( - "get-string", - GET_STRING_INDEX, - GET_STRING_TYPE, - 2, - get_string_body(), - ), - post_function, - super::super::realloc::build_realloc(REALLOC_TYPE, span()), - function( - "check_post_return_reclaims", - DRIVER_INDEX, - GET_STRING_TYPE, - 2, - driver_body(), - ), - ], - memories: vec![Memory { - id: crate::types::MemoryId(0), - index: MemoryIndex(0), - minimum: 1, - maximum: Some(2), - }], - data: vec![DataSegment { - id: crate::types::DataId(0), - index: DataIndex(0), - mode: DataMode::Active { - offset: crate::abi::HEAP_STATE, - }, - bytes: state, - }], - exports: vec![ - Export { - name: "get-string".into(), - kind: ExportKind::Function, - index: ExportIndex::Function(FunctionIndex(GET_STRING_INDEX)), - }, - post_export, - Export { - name: "cabi_realloc".into(), - kind: ExportKind::Function, - index: ExportIndex::Function(FunctionIndex(REALLOC_INDEX)), - }, - Export { - name: "check_post_return_reclaims".into(), - kind: ExportKind::Function, - index: ExportIndex::Function(FunctionIndex(DRIVER_INDEX)), - }, - Export { - name: "memory".into(), - kind: ExportKind::Memory, - index: ExportIndex::Memory(MemoryIndex(0)), - }, - ], - entry: None, - realloc: None, - globals: Vec::new(), - helpers: Vec::new(), - span: span(), - } -} - -fn string_world() -> (Resolve, WorldId) { - let wit = r#" - package fixture:strings@0.1.0; - world guest { - export get-string: func() -> string; - } - "#; - let mut resolve = Resolve::default(); - let package = resolve - .push_str("strings.wit", wit) - .expect("the string fixture should resolve"); - let world = resolve.packages[package] - .worlds - .get("guest") - .copied() - .expect("guest world"); - (resolve, world) -} - fn require_wasmtime() -> bool { match std::process::Command::new("wasmtime") .arg("--version") @@ -411,16 +187,18 @@ fn buffer_post_return_frees_the_returned_string() { if !require_wasmtime() { return; } - + let (resolve, world) = string_world(); + let component = componentize(module, resolve, world, vec![allocator_requirement()]) + .expect("componentizing the reclaim driver"); let path = std::env::temp_dir().join(format!( "psrs-buffer-post-return-{}.wasm", std::process::id() )); - std::fs::write(&path, binary).expect("write post-return test module"); + std::fs::write(&path, component).expect("write post-return test module"); let output = std::process::Command::new("wasmtime") .arg("run") .arg("--invoke") - .arg("check_post_return_reclaims") + .arg("check-reclaim()") .arg(&path) .output() .expect("run post-return test module"); @@ -437,8 +215,8 @@ fn buffer_post_return_frees_the_returned_string() { fn component_attaches_the_buffer_post_return() { let module = buffer_post_return_module(); let (resolve, world) = string_world(); - let component = - componentize(module, resolve, world, Vec::new()).expect("componentizing the string export"); + let component = componentize(module, resolve, world, vec![allocator_requirement()]) + .expect("componentizing the string export"); crate::validator() .validate_all(&component) .expect("the component should validate"); diff --git a/crates/psrs-backend/src/wasm/lower/realloc/block.rs b/crates/psrs-backend/src/wasm/lower/realloc/block.rs deleted file mode 100644 index 435c987b..00000000 --- a/crates/psrs-backend/src/wasm/lower/realloc/block.rs +++ /dev/null @@ -1,312 +0,0 @@ -//! Block allocation, free-list reuse, and coalescing for `cabi_realloc`. - -use super::*; -use crate::abi; -use wasm_encoder::Instruction; - -/// Allocates `NEW_LEN` bytes aligned to `ALIGN` (rounded up to the block -/// granularity) and leaves the payload pointer in `L_P`. -pub(super) fn emit_allocate(asm: &mut Asm) { - // a = max(align, MIN_BLOCK) - let small = asm.label(); - get(asm, ALIGN); - constant(asm, abi::MIN_BLOCK as i32); - asm.leaf(Instruction::I32LtU); - asm.if_(small); - constant(asm, abi::MIN_BLOCK as i32); - set(asm, L_A); - asm.else_(); - get(asm, ALIGN); - set(asm, L_A); - asm.end(); - - constant(asm, 0); - set(asm, L_PREV); - state_load(asm, 0); - set(asm, L_NODE); - - let found = asm.label(); - let scan = asm.label(); - asm.block(found); - asm.loop_(scan); - get(asm, L_NODE); - asm.leaf(Instruction::I32Eqz); - asm.br_if(found); - word_load(asm, L_NODE, 0); - set(asm, L_SIZE); - // P = align_up(NODE + HEADER, a) - get(asm, L_NODE); - constant(asm, abi::HEADER_SIZE as i32); - asm.leaf(Instruction::I32Add); - set(asm, L_PNODE); - local_trap_if_wrapped(asm, L_PNODE, L_NODE); - checked_align_up(asm, L_PNODE, L_A); - // front = align_up((P - NODE) + NEW_LEN, MIN_BLOCK) - get(asm, L_PNODE); - get(asm, L_NODE); - asm.leaf(Instruction::I32Sub); - set(asm, L_FRONT); - get(asm, L_FRONT); - get(asm, NEW_LEN); - asm.leaf(Instruction::I32Add); - set(asm, L_TMP2); - local_trap_if_wrapped(asm, L_TMP2, L_FRONT); - get(asm, L_TMP2); - set(asm, L_FRONT); - checked_align_up_const(asm, L_FRONT, abi::MIN_BLOCK); - // front <= size: this block fits - get(asm, L_FRONT); - get(asm, L_SIZE); - asm.leaf(Instruction::I32LeU); - asm.br_if(found); - get(asm, L_NODE); - set(asm, L_PREV); - word_load(asm, L_NODE, 4); - set(asm, L_NODE); - asm.br(scan); - asm.end(); - asm.end(); - - let bump = asm.label(); - get(asm, L_NODE); - asm.leaf(Instruction::I32Eqz); - asm.if_(bump); - emit_bump(asm); - asm.else_(); - emit_reuse(asm); - asm.end(); -} - -/// Carves a fresh block off the bump end, growing memory when needed, and -/// leaves the payload pointer in `L_P`. -fn emit_bump(asm: &mut Asm) { - state_load(asm, 4); - set(asm, L_BREAK); - // P = align_up(BREAK + HEADER, a) - get(asm, L_BREAK); - constant(asm, abi::HEADER_SIZE as i32); - asm.leaf(Instruction::I32Add); - set(asm, L_P); - local_trap_if_wrapped(asm, L_P, L_BREAK); - checked_align_up(asm, L_P, L_A); - // END = align_up(P + NEW_LEN, MIN_BLOCK) - get(asm, L_P); - get(asm, NEW_LEN); - asm.leaf(Instruction::I32Add); - set(asm, L_END); - local_trap_if_wrapped(asm, L_END, L_P); - checked_align_up_const(asm, L_END, abi::MIN_BLOCK); - // block_size = END - BREAK - get(asm, L_END); - get(asm, L_BREAK); - asm.leaf(Instruction::I32Sub); - set(asm, L_TMP); - // pages = ceil(END / 65536) - get(asm, L_END); - constant(asm, 16); - asm.leaf(Instruction::I32ShrU); - get(asm, L_END); - constant(asm, 0xffff); - asm.leaf(Instruction::I32And); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Add); - set(asm, L_PAGES); - let grow = asm.label(); - get(asm, L_PAGES); - asm.leaf(Instruction::MemorySize(0)); - asm.leaf(Instruction::I32GtU); - asm.if_(grow); - get(asm, L_PAGES); - asm.leaf(Instruction::MemorySize(0)); - asm.leaf(Instruction::I32Sub); - asm.leaf(Instruction::MemoryGrow(0)); - constant(asm, -1); - asm.leaf(Instruction::I32Eq); - let failed = asm.label(); - asm.if_(failed); - asm.leaf(Instruction::Unreachable); - asm.end(); - asm.end(); - // Commit metadata only after the entire block is addressable. - word_store(asm, L_BREAK, 0, L_TMP); - word_store(asm, L_BREAK, 4, NEW_LEN); - state_store(asm, 4, L_END); -} - -/// Takes the first-fitting block `L_NODE`, splitting off the tail when the -/// remainder can hold another block, and leaves the payload pointer in `L_P`. -fn emit_reuse(asm: &mut Asm) { - let split = asm.label(); - get(asm, L_SIZE); - get(asm, L_FRONT); - asm.leaf(Instruction::I32Sub); - constant(asm, abi::MIN_BLOCK as i32); - asm.leaf(Instruction::I32GeU); - asm.if_(split); - get(asm, L_NODE); - get(asm, L_FRONT); - asm.leaf(Instruction::I32Add); - set(asm, L_TAIL); - get(asm, L_SIZE); - get(asm, L_FRONT); - asm.leaf(Instruction::I32Sub); - set(asm, L_TMP); - word_store(asm, L_TAIL, 0, L_TMP); - word_load(asm, L_NODE, 4); - set(asm, L_TMP2); - word_store(asm, L_TAIL, 4, L_TMP2); - link_replace(asm, L_TAIL); - word_store(asm, L_NODE, 0, L_FRONT); - asm.else_(); - word_load(asm, L_NODE, 4); - set(asm, L_TMP2); - link_replace(asm, L_TMP2); - asm.end(); - word_store(asm, L_NODE, 4, NEW_LEN); - get(asm, L_PNODE); - set(asm, L_P); -} - -/// Makes `PREV.next` (or the free-list head when `PREV == 0`) point at `L_NODE`. -fn link_replace(asm: &mut Asm, new_node: u32) { - let head = asm.label(); - get(asm, L_PREV); - asm.leaf(Instruction::I32Eqz); - asm.if_(head); - state_store(asm, 0, new_node); - asm.else_(); - word_store(asm, L_PREV, 4, new_node); - asm.end(); -} - -/// Frees the payload pointer in `fp`, coalescing with adjacent free blocks. -pub(super) fn emit_free(asm: &mut Asm, fp: u32) { - get(asm, fp); - constant(asm, abi::HEADER_SIZE as i32); - asm.leaf(Instruction::I32Sub); - set(asm, L_H); - word_load(asm, L_H, 0); - set(asm, L_SIZE); - - constant(asm, 0); - set(asm, L_PREV); - state_load(asm, 0); - set(asm, L_NODE); - let done = asm.label(); - let scan = asm.label(); - asm.block(done); - asm.loop_(scan); - get(asm, L_NODE); - asm.leaf(Instruction::I32Eqz); - asm.br_if(done); - get(asm, L_NODE); - get(asm, L_H); - asm.leaf(Instruction::I32GeU); - asm.br_if(done); - get(asm, L_NODE); - set(asm, L_PREV); - word_load(asm, L_NODE, 4); - set(asm, L_NODE); - asm.br(scan); - asm.end(); - asm.end(); - - // Merge with the following free block when adjacent. - let has_next = asm.label(); - get(asm, L_NODE); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Eqz); - asm.if_(has_next); - let adjacent_next = asm.label(); - get(asm, L_H); - get(asm, L_SIZE); - asm.leaf(Instruction::I32Add); - get(asm, L_NODE); - asm.leaf(Instruction::I32Eq); - asm.if_(adjacent_next); - word_load(asm, L_NODE, 0); - set(asm, L_TMP); - get(asm, L_SIZE); - get(asm, L_TMP); - asm.leaf(Instruction::I32Add); - set(asm, L_SIZE); - word_load(asm, L_NODE, 4); - set(asm, L_NODE); - asm.end(); - asm.end(); - - // Merge with the preceding free block when adjacent, otherwise insert. - let has_prev = asm.label(); - get(asm, L_PREV); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Eqz); - asm.if_(has_prev); - let adjacent_prev = asm.label(); - get(asm, L_PREV); - word_load(asm, L_PREV, 0); - asm.leaf(Instruction::I32Add); - get(asm, L_H); - asm.leaf(Instruction::I32Eq); - asm.if_(adjacent_prev); - word_load(asm, L_PREV, 0); - get(asm, L_SIZE); - asm.leaf(Instruction::I32Add); - set(asm, L_TMP); - word_store(asm, L_PREV, 0, L_TMP); - word_store(asm, L_PREV, 4, L_NODE); - asm.else_(); - emit_insert(asm); - asm.end(); - asm.else_(); - emit_insert(asm); - asm.end(); -} - -/// Inserts the free block at `L_H` before `L_NODE` in the address-ordered list. -fn emit_insert(asm: &mut Asm) { - word_store(asm, L_H, 0, L_SIZE); - word_store(asm, L_H, 4, L_NODE); - link_replace(asm, L_H); -} - -/// Rounds the local `value` up to the power-of-two `align` local, trapping on -/// pointer-width overflow. -fn checked_align_up(asm: &mut Asm, value: u32, align: u32) { - get(asm, value); - get(asm, align); - constant(asm, 1); - asm.leaf(Instruction::I32Sub); - asm.leaf(Instruction::I32Add); - set(asm, L_TMP); - local_trap_if_wrapped(asm, L_TMP, value); - get(asm, L_TMP); - constant(asm, 0); - get(asm, align); - asm.leaf(Instruction::I32Sub); - asm.leaf(Instruction::I32And); - set(asm, value); -} - -/// Rounds the local `value` up to the power-of-two constant `align`, trapping on -/// pointer-width overflow. -fn checked_align_up_const(asm: &mut Asm, value: u32, align: u32) { - get(asm, value); - constant(asm, (align - 1) as i32); - asm.leaf(Instruction::I32Add); - set(asm, L_TMP); - local_trap_if_wrapped(asm, L_TMP, value); - get(asm, L_TMP); - constant(asm, (0i32).wrapping_sub(align as i32)); - asm.leaf(Instruction::I32And); - set(asm, value); -} - -/// Traps when `result` is numerically below `source`, i.e. an add wrapped. -fn local_trap_if_wrapped(asm: &mut Asm, result: u32, source: u32) { - trap_if(asm, |a| { - get(a, result); - get(a, source); - a.leaf(Instruction::I32LtU); - }); -} diff --git a/crates/psrs-backend/src/wasm/lower/realloc/mod.rs b/crates/psrs-backend/src/wasm/lower/realloc/mod.rs index 2ad13028..a8e384d4 100644 --- a/crates/psrs-backend/src/wasm/lower/realloc/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/realloc/mod.rs @@ -1,274 +1,44 @@ -//! The synthesized linear-memory allocator used by canonical ABI lowering. +//! Local forwarder for the allocator runtime unit's `cabi_realloc`. //! -//! `cabi_realloc` implements the full canonical `(old_ptr, old_len, align, -//! new_len) -> pointer` contract: it allocates an aligned block, frees when the -//! new length is zero, and resizes with copy otherwise. Freed blocks go on an -//! address-ordered free list and are coalesced with their neighbors, so a -//! request reuses reclaimed storage instead of exhausting memory. The block -//! layout and ownership rules are fixed by -//! `docs/design/backend/wasm/canonical-buffer-allocation-and-lifetime.md`. +//! Codecs, cleanup, and the component host call this function. It forwards the +//! canonical arguments to the imported provider and returns that provider's +//! pointer. The provider owns allocation, freeing, and resizing. -use super::super::{Function, TypeIndex}; -use super::asm::*; +use super::super::{Function, Op, TypeIndex}; use crate::abi; use psrs_span::TextRange; -use wasm_encoder::{Instruction, MemArg, ValType}; - -mod block; - -use block::{emit_allocate, emit_free}; - -pub(super) const OLD_PTR: u32 = 0; -pub(super) const OLD_LEN: u32 = 1; -pub(super) const ALIGN: u32 = 2; -pub(super) const NEW_LEN: u32 = 3; - -// Scratch locals. Parameters occupy 0..4, so the first scratch local is 4. -pub(super) const L_A: u32 = 4; -pub(super) const L_PREV: u32 = 5; -pub(super) const L_NODE: u32 = 6; -pub(super) const L_SIZE: u32 = 7; -pub(super) const L_PNODE: u32 = 8; -pub(super) const L_FRONT: u32 = 9; -pub(super) const L_TAIL: u32 = 10; -pub(super) const L_P: u32 = 11; -pub(super) const L_END: u32 = 12; -pub(super) const L_PAGES: u32 = 13; -pub(super) const L_BREAK: u32 = 14; -pub(super) const L_SRC: u32 = 15; -pub(super) const L_DST: u32 = 16; -pub(super) const L_BYTE: u32 = 17; -pub(super) const L_COUNT: u32 = 18; -pub(super) const L_H: u32 = 19; -pub(super) const L_CAP: u32 = 20; -pub(super) const L_TMP: u32 = 21; -pub(super) const L_TMP2: u32 = 22; -pub(super) const LOCAL_COUNT: usize = 19; - -pub(super) const WORD_ALIGN: u32 = 2; -pub(super) const BYTE_ALIGN: u32 = 0; - -/// Builds the reclaiming `cabi_realloc` used by canonical ABI boundary buffers, -/// including indirect parameter records and returned lists/strings. -pub(super) fn build_realloc(type_index: TypeIndex, span: TextRange) -> Function { - let mut asm = Asm::new(); - - // Alignment is an unsigned, nonzero power of two. Validate it even for a - // zero-sized allocation so malformed calls trap consistently. - trap_if(&mut asm, |a| { - get(a, ALIGN); - a.leaf(Instruction::I32Eqz); - get(a, ALIGN); - constant(a, 1); - a.leaf(Instruction::I32Sub); - get(a, ALIGN); - a.leaf(Instruction::I32And); - a.leaf(Instruction::I32Eqz); - a.leaf(Instruction::I32Eqz); - a.leaf(Instruction::I32Or); - }); - - // new_len == 0 frees the old block (when any) and returns null. - let zero_length = asm.label(); - get(&mut asm, NEW_LEN); - asm.leaf(Instruction::I32Eqz); - asm.if_(zero_length); - { - let has_old = asm.label(); - get(&mut asm, OLD_PTR); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Eqz); - asm.if_(has_old); - emit_free(&mut asm, OLD_PTR); - asm.end(); - constant(&mut asm, 0); - asm.leaf(Instruction::Return); - } - asm.end(); - - // A non-null old pointer must describe a complete block whose stored length - // agrees with the caller's. If the block already has capacity and alignment - // for the new length, resize in place. - let old_nonnull = asm.label(); - get(&mut asm, OLD_PTR); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Eqz); - asm.if_(old_nonnull); - { - trap_if(&mut asm, |a| { - get(a, OLD_PTR); - constant(a, abi::HEADER_SIZE as i32); - a.leaf(Instruction::I32LtU); - }); - trap_if(&mut asm, |a| { - get(a, OLD_PTR); - constant(a, 4); - a.leaf(Instruction::I32Sub); - a.leaf(Instruction::I32Load(word_memarg())); - get(a, OLD_LEN); - a.leaf(Instruction::I32Ne); - }); - get(&mut asm, OLD_PTR); - constant(&mut asm, abi::HEADER_SIZE as i32); - asm.leaf(Instruction::I32Sub); - set(&mut asm, L_H); - word_load(&mut asm, L_H, 0); - set(&mut asm, L_SIZE); - get(&mut asm, L_SIZE); - constant(&mut asm, abi::HEADER_SIZE as i32); - asm.leaf(Instruction::I32Sub); - set(&mut asm, L_CAP); - - let fits_in_place = asm.label(); - get(&mut asm, NEW_LEN); - get(&mut asm, L_CAP); - asm.leaf(Instruction::I32LeU); - get(&mut asm, OLD_PTR); - get(&mut asm, ALIGN); - constant(&mut asm, 1); - asm.leaf(Instruction::I32Sub); - asm.leaf(Instruction::I32And); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32And); - asm.if_(fits_in_place); - { - get(&mut asm, OLD_PTR); - constant(&mut asm, 4); - asm.leaf(Instruction::I32Sub); - get(&mut asm, NEW_LEN); - asm.leaf(Instruction::I32Store(word_memarg())); - get(&mut asm, OLD_PTR); - asm.leaf(Instruction::Return); - } - asm.end(); - } - asm.end(); - - // A null old pointer requires an empty old length. - trap_if(&mut asm, |a| { - get(a, OLD_PTR); - a.leaf(Instruction::I32Eqz); - get(a, OLD_LEN); - a.leaf(Instruction::I32Eqz); - a.leaf(Instruction::I32Eqz); - a.leaf(Instruction::I32And); - }); - - emit_allocate(&mut asm); - - let has_old_bytes = asm.label(); - get(&mut asm, OLD_PTR); - asm.leaf(Instruction::I32Eqz); - asm.leaf(Instruction::I32Eqz); - asm.if_(has_old_bytes); - { - let old_is_smaller = asm.label(); - get(&mut asm, OLD_LEN); - get(&mut asm, NEW_LEN); - asm.leaf(Instruction::I32LtU); - asm.if_(old_is_smaller); - get(&mut asm, OLD_LEN); - set(&mut asm, L_COUNT); - asm.else_(); - get(&mut asm, NEW_LEN); - set(&mut asm, L_COUNT); - asm.end(); - get(&mut asm, OLD_PTR); - set(&mut asm, L_SRC); - get(&mut asm, L_P); - set(&mut asm, L_DST); - let done = asm.label(); - let next = asm.label(); - asm.block(done); - asm.loop_(next); - get(&mut asm, L_COUNT); - asm.leaf(Instruction::I32Eqz); - asm.br_if(done); - get(&mut asm, L_SRC); - asm.leaf(Instruction::I32Load8U(byte_memarg())); - set(&mut asm, L_BYTE); - get(&mut asm, L_DST); - get(&mut asm, L_BYTE); - asm.leaf(Instruction::I32Store8(byte_memarg())); - advance(&mut asm, L_SRC, 1); - advance(&mut asm, L_DST, 1); - get(&mut asm, L_COUNT); - constant(&mut asm, 1); - asm.leaf(Instruction::I32Sub); - set(&mut asm, L_COUNT); - asm.br(next); - asm.end(); - asm.end(); - emit_free(&mut asm, OLD_PTR); - } - asm.end(); - - get(&mut asm, L_P); +use wasm_encoder::{Instruction, ValType}; +/// Builds the forwarding `cabi_realloc`. +/// +/// `import` is the core function index of the allocator unit's export. +pub(super) fn forward_realloc(type_index: TypeIndex, import: u32, span: TextRange) -> Function { Function { - symbol: crate::abi::REALLOC_SYMBOL, - name: "cabi_realloc".into(), + symbol: abi::REALLOC_SYMBOL, + name: psrs_runtime::REALLOC_EXPORT.into(), type_index, parameters: vec![ValType::I32; 4], - locals: vec![ValType::I32; LOCAL_COUNT], - body: asm.into_body(), + locals: Vec::new(), + body: vec![ + Op::Leaf(Instruction::LocalGet(0)), + Op::Leaf(Instruction::LocalGet(1)), + Op::Leaf(Instruction::LocalGet(2)), + Op::Leaf(Instruction::LocalGet(3)), + Op::Leaf(Instruction::Call(import)), + ], span, } } -pub(super) fn word_memarg() -> MemArg { - MemArg { - offset: 0, - align: WORD_ALIGN, - memory_index: 0, - } -} - -pub(super) fn byte_memarg() -> MemArg { - MemArg { - offset: 0, - align: BYTE_ALIGN, - memory_index: 0, - } -} - -pub(super) fn word_load(asm: &mut Asm, base: u32, offset: u32) { - get(asm, base); - if offset != 0 { - constant(asm, offset as i32); - asm.leaf(Instruction::I32Add); - } - asm.leaf(Instruction::I32Load(word_memarg())); -} - -pub(super) fn word_store(asm: &mut Asm, base: u32, offset: u32, value: u32) { - get(asm, base); - if offset != 0 { - constant(asm, offset as i32); - asm.leaf(Instruction::I32Add); +/// Returns the checked application's constant boundary without using linear memory. +pub(super) fn heap_getter(type_index: TypeIndex, heap_start: u32, span: TextRange) -> Function { + Function { + symbol: abi::HEAP_BASE_SYMBOL, + name: psrs_runtime::HEAP_BOUNDARY_IMPORT.into(), + type_index, + parameters: Vec::new(), + locals: Vec::new(), + body: vec![Op::Leaf(Instruction::I32Const(heap_start as i32))], + span, } - get(asm, value); - asm.leaf(Instruction::I32Store(word_memarg())); } - -pub(super) fn state_load(asm: &mut Asm, offset: u32) { - constant(asm, (abi::HEAP_STATE + offset) as i32); - asm.leaf(Instruction::I32Load(word_memarg())); -} - -pub(super) fn state_store(asm: &mut Asm, offset: u32, value: u32) { - constant(asm, (abi::HEAP_STATE + offset) as i32); - get(asm, value); - asm.leaf(Instruction::I32Store(word_memarg())); -} - -pub(super) fn trap_if(asm: &mut Asm, condition: impl FnOnce(&mut Asm)) { - condition(asm); - let failed = asm.label(); - asm.if_(failed); - asm.leaf(Instruction::Unreachable); - asm.end(); -} - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-backend/src/wasm/lower/realloc/tests.rs b/crates/psrs-backend/src/wasm/lower/realloc/tests.rs deleted file mode 100644 index 5fb4c1f9..00000000 --- a/crates/psrs-backend/src/wasm/lower/realloc/tests.rs +++ /dev/null @@ -1,422 +0,0 @@ -use super::*; -use crate::types::{DataId, MemoryId}; -use crate::wasm::lower::asm::{Asm, constant, get, set}; -use crate::wasm::{ - Body, DataIndex, DataMode, DataSegment, Export, ExportIndex, ExportKind, FuncType, Function, - FunctionIndex, Memory, MemoryIndex, Module, -}; -use psrs_hir::{ModuleId, SymbolId}; -use psrs_span::TextRange; -use wasm_encoder::{Instruction as I, MemArg, ValType}; - -const CHECK_COUNT: u32 = 10; -const REALLOC_INDEX: u32 = CHECK_COUNT; - -fn mm(align: u32) -> MemArg { - MemArg { - offset: 0, - align, - memory_index: 0, - } -} - -fn span() -> TextRange { - TextRange::new(0, 1) -} - -fn realloc_call(asm: &mut Asm, old: i32, old_len: i32, align: i32, new_len: i32) { - constant(asm, old); - constant(asm, old_len); - constant(asm, align); - constant(asm, new_len); - asm.leaf(I::Call(REALLOC_INDEX)); -} - -fn allocate_into(asm: &mut Asm, local: u32, n: i32, align: i32) { - realloc_call(asm, 0, 0, align, n); - set(asm, local); -} - -fn free_call(asm: &mut Asm, pointer: u32, len: i32) { - get(asm, pointer); - constant(asm, len); - constant(asm, 1); - constant(asm, 0); - asm.leaf(I::Call(REALLOC_INDEX)); - asm.leaf(I::Drop); -} - -fn equal(asm: &mut Asm, left: u32, right: u32) { - get(asm, left); - get(asm, right); - asm.leaf(I::I32Eq); -} - -/// Allocates, frees, and confirms the freed block is reused and that two -/// adjacent freed blocks coalesce into one larger block. -fn check_reuse_and_coalesce() -> Body { - let mut asm = Asm::new(); - allocate_into(&mut asm, 0, 16, 8); - allocate_into(&mut asm, 1, 16, 8); - // The two bump allocations are distinct. - get(&mut asm, 0); - get(&mut asm, 1); - asm.leaf(I::I32Ne); - - free_call(&mut asm, 0, 16); - allocate_into(&mut asm, 2, 16, 8); - // The freed block is reused. - equal(&mut asm, 2, 0); - asm.leaf(I::I32And); - - free_call(&mut asm, 1, 16); - free_call(&mut asm, 2, 16); - allocate_into(&mut asm, 3, 32, 8); - // The two adjacent freed blocks coalesced into the first one. - equal(&mut asm, 3, 0); - asm.leaf(I::I32And); - asm.into_body() -} - -/// Confirms alignment and in-place resize, then a grow-with-copy resize. -fn check_alignment_and_resize() -> Body { - let mut asm = Asm::new(); - allocate_into(&mut asm, 0, 3, 1); - for (offset, value) in [(0, 0x12), (1, 0x34), (2, 0x56)] { - get(&mut asm, 0); - if offset != 0 { - constant(&mut asm, offset); - asm.leaf(I::I32Add); - } - constant(&mut asm, value); - asm.leaf(I::I32Store8(mm(0))); - } - - // Seed the accumulator. - constant(&mut asm, 1); - - // In-place resize within capacity keeps the pointer and the bytes. - get(&mut asm, 0); - constant(&mut asm, 3); - constant(&mut asm, 16); - constant(&mut asm, 5); - asm.leaf(I::Call(REALLOC_INDEX)); - set(&mut asm, 1); - get(&mut asm, 1); - get(&mut asm, 0); - asm.leaf(I::I32Eq); - asm.leaf(I::I32And); - get(&mut asm, 1); - constant(&mut asm, 15); - asm.leaf(I::I32And); - asm.leaf(I::I32Eqz); - asm.leaf(I::I32And); - - // Resize past capacity reallocates, copies the old bytes, and aligns. - get(&mut asm, 1); - constant(&mut asm, 5); - constant(&mut asm, 8); - constant(&mut asm, 32); - asm.leaf(I::Call(REALLOC_INDEX)); - set(&mut asm, 2); - get(&mut asm, 2); - constant(&mut asm, 7); - asm.leaf(I::I32And); - asm.leaf(I::I32Eqz); - asm.leaf(I::I32And); - for (offset, expected) in [(0, 0x12), (1, 0x34), (2, 0x56)] { - get(&mut asm, 2); - if offset != 0 { - constant(&mut asm, offset); - asm.leaf(I::I32Add); - } - asm.leaf(I::I32Load8U(mm(0))); - constant(&mut asm, expected); - asm.leaf(I::I32Eq); - asm.leaf(I::I32And); - } - // The length prefix records the resized length. - get(&mut asm, 2); - constant(&mut asm, 4); - asm.leaf(I::I32Sub); - asm.leaf(I::I32Load(mm(2))); - constant(&mut asm, 32); - asm.leaf(I::I32Eq); - asm.leaf(I::I32And); - asm.into_body() -} - -fn bad_alignment() -> Body { - let mut asm = Asm::new(); - realloc_call(&mut asm, 0, 0, 3, 1); - asm.leaf(I::Drop); - constant(&mut asm, 0); - asm.into_body() -} - -fn null_with_length() -> Body { - let mut asm = Asm::new(); - realloc_call(&mut asm, 0, 7, 4, 8); - asm.leaf(I::Drop); - constant(&mut asm, 0); - asm.into_body() -} - -fn mismatched_length() -> Body { - let mut asm = Asm::new(); - allocate_into(&mut asm, 0, 8, 4); - get(&mut asm, 0); - constant(&mut asm, 9); - constant(&mut asm, 4); - constant(&mut asm, 16); - asm.leaf(I::Call(REALLOC_INDEX)); - asm.leaf(I::Drop); - constant(&mut asm, 0); - asm.into_body() -} - -fn grow_failure() -> Body { - let mut asm = Asm::new(); - // Exceeds the memory maximum, so memory.grow returns -1. - realloc_call(&mut asm, 0, 0, 4, 200_000); - asm.leaf(I::Drop); - constant(&mut asm, 0); - asm.into_body() -} - -fn address_overflow() -> Body { - let mut asm = Asm::new(); - // Force the bump break to the top of the wasm32 address space. - constant(&mut asm, (abi::HEAP_STATE + 4) as i32); - constant(&mut asm, -8); - asm.leaf(I::I32Store(mm(2))); - realloc_call(&mut asm, 0, 0, 4, 16); - asm.leaf(I::Drop); - constant(&mut asm, 0); - asm.into_body() -} - -/// Allocates and frees in a loop far past one page's worth of blocks, then -/// reports whether linear memory grew. Reclamation keeps it at one page. -fn check_bounded_growth() -> Body { - let mut asm = Asm::new(); - constant(&mut asm, 10_000); - set(&mut asm, 1); - let done = asm.label(); - let again = asm.label(); - asm.block(done); - asm.loop_(again); - get(&mut asm, 1); - asm.leaf(I::I32Eqz); - asm.br_if(done); - allocate_into(&mut asm, 0, 16, 8); - free_call(&mut asm, 0, 16); - get(&mut asm, 1); - constant(&mut asm, 1); - asm.leaf(I::I32Sub); - set(&mut asm, 1); - asm.br(again); - asm.end(); - asm.end(); - asm.leaf(I::MemorySize(0)); - constant(&mut asm, 1); - asm.leaf(I::I32Eq); - asm.into_body() -} - -fn check_page_boundary_growth() -> Body { - let mut asm = Asm::new(); - let length = (65536 - abi::HEAP_START - abi::HEADER_SIZE) as i32; - allocate_into(&mut asm, 0, length, 8); - get(&mut asm, 0); - constant(&mut asm, 123); - asm.leaf(I::I32Store8(mm(0))); - allocate_into(&mut asm, 1, 16, 8); - asm.leaf(I::MemorySize(0)); - constant(&mut asm, 2); - asm.leaf(I::I32Eq); - get(&mut asm, 0); - asm.leaf(I::I32Load8U(mm(0))); - constant(&mut asm, 123); - asm.leaf(I::I32Eq); - asm.leaf(I::I32And); - free_call(&mut asm, 1, 16); - allocate_into(&mut asm, 2, 16, 8); - equal(&mut asm, 1, 2); - asm.leaf(I::I32And); - asm.into_body() -} - -fn free_block_size_overflow() -> Body { - let mut asm = Asm::new(); - allocate_into(&mut asm, 0, 16, 8); - free_call(&mut asm, 0, 16); - realloc_call(&mut asm, 0, 0, 8, -8); - asm.leaf(I::Drop); - constant(&mut asm, 0); - asm.into_body() -} - -fn function(name: &str, body: Body, locals: usize) -> Function { - Function { - symbol: SymbolId::new(ModuleId(0), 0), - name: name.into(), - type_index: TypeIndex(0), - parameters: Vec::new(), - locals: vec![ValType::I32; locals], - body, - span: span(), - } -} - -fn fixture() -> Module { - let mut functions = vec![ - function("check_reuse_and_coalesce", check_reuse_and_coalesce(), 4), - function( - "check_alignment_and_resize", - check_alignment_and_resize(), - 3, - ), - function("bad_alignment", bad_alignment(), 0), - function("null_with_length", null_with_length(), 0), - function("mismatched_length", mismatched_length(), 1), - function("grow_failure", grow_failure(), 0), - function("address_overflow", address_overflow(), 0), - function("check_bounded_growth", check_bounded_growth(), 2), - function( - "check_page_boundary_growth", - check_page_boundary_growth(), - 3, - ), - function("free_block_size_overflow", free_block_size_overflow(), 1), - ]; - let realloc_type = TypeIndex(1); - functions.push(build_realloc(realloc_type, span())); - - let mut state = 0_u32.to_le_bytes().to_vec(); - state.extend_from_slice(&abi::HEAP_START.to_le_bytes()); - - let mut exports: Vec = functions - .iter() - .enumerate() - .map(|(index, function)| Export { - name: function.name.clone(), - kind: ExportKind::Function, - index: ExportIndex::Function(FunctionIndex(index as u32)), - }) - .collect(); - exports.push(Export { - name: "memory".into(), - kind: ExportKind::Memory, - index: ExportIndex::Memory(MemoryIndex(0)), - }); - - Module { - name: "ReallocExecutionTest".into(), - imports: Vec::new(), - types: vec![ - FuncType { - parameters: Vec::new(), - results: vec![ValType::I32], - }, - FuncType { - parameters: vec![ValType::I32; 4], - results: vec![ValType::I32], - }, - ], - type_defs: Vec::new(), - functions, - memories: vec![Memory { - id: MemoryId(0), - index: MemoryIndex(0), - minimum: 1, - maximum: Some(2), - }], - data: vec![DataSegment { - id: DataId(0), - index: DataIndex(0), - mode: DataMode::Active { - offset: abi::HEAP_STATE, - }, - bytes: state, - }], - exports, - entry: None, - realloc: None, - globals: Vec::new(), - helpers: Vec::new(), - span: span(), - } -} - -fn require_wasmtime() -> bool { - match std::process::Command::new("wasmtime") - .arg("--version") - .output() - { - Ok(_) => true, - Err(_) if std::env::var("PSRS_REQUIRE_WASMTIME").as_deref() == Ok("1") => { - panic!("PSRS_REQUIRE_WASMTIME=1 but wasmtime is not installed"); - } - Err(_) => { - eprintln!("skipping allocator execution: wasmtime is not installed"); - false - } - } -} - -#[test] -fn realloc_reclaims_reuses_coalesces_aligns_and_traps() { - let module = fixture(); - super::super::super::verify::verify_module(&module).expect("thin Wasm module verifies"); - let binary = super::super::super::encode_module(&module).expect("Wasm encodes"); - crate::validator() - .validate_all(&binary) - .expect("allocator module validates"); - - if !require_wasmtime() { - return; - } - - use std::sync::atomic::{AtomicU32, Ordering}; - static COUNTER: AtomicU32 = AtomicU32::new(0); - let id = COUNTER.fetch_add(1, Ordering::Relaxed); - let path = std::env::temp_dir().join(format!("psrs-realloc-{}-{id}.wasm", std::process::id())); - std::fs::write(&path, binary).expect("write allocator test module"); - let run = |export: &str| { - std::process::Command::new("wasmtime") - .arg("run") - .arg("--invoke") - .arg(export) - .arg(&path) - .output() - .expect("run allocator test module") - }; - - for export in [ - "check_reuse_and_coalesce", - "check_alignment_and_resize", - "check_bounded_growth", - "check_page_boundary_growth", - ] { - let output = run(export); - assert!(output.status.success(), "{export} trapped: {output:?}"); - assert_eq!( - String::from_utf8_lossy(&output.stdout).trim(), - "1", - "{export} reported a failed check" - ); - } - for export in [ - "bad_alignment", - "null_with_length", - "mismatched_length", - "grow_failure", - "address_overflow", - "free_block_size_overflow", - ] { - let output = run(export); - assert!(!output.status.success(), "{export} unexpectedly succeeded"); - } - let _ = std::fs::remove_file(path); -} diff --git a/crates/psrs-backend/src/wasm/mod.rs b/crates/psrs-backend/src/wasm/mod.rs index 370e10f6..336d0a08 100644 --- a/crates/psrs-backend/src/wasm/mod.rs +++ b/crates/psrs-backend/src/wasm/mod.rs @@ -49,6 +49,8 @@ pub struct Global { pub enum GlobalInit { /// `ref.null` of the given heap type. RefNull(HeapType), + /// `i32.const`. + I32(u32), } /// A WebAssembly function signature in the thin Wasm IR. @@ -80,6 +82,7 @@ pub struct Memory { pub enum ExportKind { Function, Memory, + Global, } /// An exported item. @@ -96,6 +99,7 @@ pub struct Export { pub enum ExportIndex { Function(FunctionIndex), Memory(MemoryIndex), + Global(GlobalIndex), } /// A structured function body. diff --git a/crates/psrs-backend/src/wasm/verify.rs b/crates/psrs-backend/src/wasm/verify.rs index 25fd96c7..de0128af 100644 --- a/crates/psrs-backend/src/wasm/verify.rs +++ b/crates/psrs-backend/src/wasm/verify.rs @@ -46,13 +46,17 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { "Wasm global indices are duplicated or not deterministic", )); } - if let GlobalInit::RefNull(heap) = global.init - && global.ty - != ValType::Ref(RefType { - nullable: true, - heap_type: heap, - }) - { + let init_matches = match global.init { + GlobalInit::RefNull(heap) => { + global.ty + == ValType::Ref(RefType { + nullable: true, + heap_type: heap, + }) + } + GlobalInit::I32(_) => global.ty == ValType::I32, + }; + if !init_matches { errors.push(wasm_error( module.span, "Wasm global initializer type does not match its value type", @@ -78,6 +82,9 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { (ExportKind::Memory, ExportIndex::Memory(index)) => { (index.0 as usize) < module.memories.len() } + (ExportKind::Global, ExportIndex::Global(index)) => { + (index.0 as usize) < module.globals.len() + } _ => false, }; if !in_range { diff --git a/crates/psrs-driver/src/tests/diagnosis_trace.rs b/crates/psrs-driver/src/tests/diagnosis_trace.rs index 048645da..7610466b 100644 --- a/crates/psrs-driver/src/tests/diagnosis_trace.rs +++ b/crates/psrs-driver/src/tests/diagnosis_trace.rs @@ -144,7 +144,7 @@ fn target_plan_records_provider_and_memory_lineage() { .map(|parameter| parameter.value.as_str()) }; assert_eq!(parameter("artifacts"), Some("0")); - assert_eq!(parameter("heap_start"), Some("24")); + assert_eq!(parameter("heap_start"), Some("16")); assert!( parameter("selected_providers") .expect("selected providers are recorded") diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index 02e94bd7..cba5b70a 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -90,7 +90,7 @@ main = let ignored = runEffect checks in 0 } #[test] -fn formatter_plan_records_the_pinned_artifact_digest() { +fn formatter_plan_records_the_pinned_runtime_artifact_digests() { let source = r#" module Main where @@ -117,11 +117,16 @@ main = let ignored = log (show 1.0e21) in 0 .find(|parameter| parameter.key == key) .map(|parameter| parameter.value.as_str()) }; - assert_eq!(parameter("artifacts"), Some("1")); + assert_eq!(parameter("artifacts"), Some("2")); let digests = parameter("artifact_digests").expect("artifact digests are recorded"); assert!(digests.contains("psrs:runtime-number"), "{digests}"); + assert!(digests.contains("psrs:runtime-allocator"), "{digests}"); assert!( - digests.contains("75cdd69833e058d014942eafdcd668eb9150e8d098a791871c327daf7bb20c73"), + digests.contains("a6f556d0151e8c474c495ad4488b9a23d67bb105dda2dc84eff17eaba70bbf19"), + "{digests}" + ); + assert!( + digests.contains("458a7df7eb27038c4d6b22aa52fc8ea283c6dca41120b0c0bf31f6a851aa0260"), "{digests}" ); assert!( diff --git a/crates/psrs-linker/src/application.rs b/crates/psrs-linker/src/application.rs index 83c5009d..5fba77aa 100644 --- a/crates/psrs-linker/src/application.rs +++ b/crates/psrs-linker/src/application.rs @@ -14,6 +14,10 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { let mut seen = std::collections::BTreeSet::new(); let mut memory = None; let mut data = Vec::new(); + let mut function_types = Vec::new(); + let mut function_bodies = Vec::new(); + let mut function_exports = Vec::new(); + let mut imported_functions = 0_u32; for payload in Parser::new(0).parse_all(bytes) { match payload.map_err(|error| error.to_string())? { Payload::TypeSection(reader) => { @@ -32,6 +36,7 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { let TypeRef::Func(index) = import.ty else { return Err("application imports an unplanned non-function item".into()); }; + imported_functions += 1; let binding = plan .bindings() .iter() @@ -109,12 +114,69 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { } } } + Payload::FunctionSection(reader) => { + for ty in reader { + function_types.push(ty.map_err(|error| error.to_string())?); + } + } + Payload::CodeSectionEntry(body) => function_bodies.push(body), + Payload::ExportSection(reader) => { + for export in reader { + let export = export.map_err(|error| error.to_string())?; + if export.kind == wasmparser::ExternalKind::Func { + function_exports.push((export.name.to_string(), export.index)); + } + } + } Payload::StartSection { .. } => { return Err("application start precedes planned shim resolution".into()); } _ => {} } } + if let Some(boundary) = plan.memory().heap_getter.as_ref() { + let (_, index) = function_exports + .iter() + .find(|(name, _)| name == &boundary.field) + .ok_or("application does not export the heap getter")?; + let defined = index + .checked_sub(imported_functions) + .ok_or("application heap getter must be defined locally")? + as usize; + let ty = function_types + .get(defined) + .and_then(|index| types.get(*index as usize)) + .and_then(Option::as_ref) + .ok_or("application heap getter has no signature")?; + if !ty.params().is_empty() || ty.results() != [ValType::I32] { + return Err("application heap getter must have signature () -> i32".into()); + } + let body = function_bodies + .get(defined) + .ok_or("application heap getter has no body")?; + if body + .get_locals_reader() + .map_err(|error| error.to_string())? + .get_count() + != 0 + { + return Err("application heap getter must have no locals".into()); + } + let mut ops = body + .get_operators_reader() + .map_err(|error| error.to_string())?; + if !matches!(ops.read().map_err(|error| error.to_string())?, Operator::I32Const { value } + if value as u32 == plan.memory().heap_start) + || !matches!( + ops.read().map_err(|error| error.to_string())?, + Operator::End + ) + || !ops.eof() + { + return Err("application heap getter must return only the checked constant".into()); + } + } + for binding in plan.bindings() { if !seen.contains(&(binding.module.clone(), binding.field.clone())) { return Err(format!( diff --git a/crates/psrs-linker/src/graph/mod.rs b/crates/psrs-linker/src/graph/mod.rs new file mode 100644 index 00000000..f0c28226 --- /dev/null +++ b/crates/psrs-linker/src/graph/mod.rs @@ -0,0 +1,382 @@ +//! Resolve live requirements against offered runtime units. +//! +//! Selection is metadata-first. Byte verification runs only after every live +//! requirement has one compatible provider and the state, growth, and memory +//! identities agree. A failed route does not try another unit or artifact kind. + +mod select; + +use crate::definitions::ResolvedWorldContext; +use crate::error::{LinkErrors, LinkStage}; +use crate::plan::{InitializationStep, ProviderEdge, ResolvedBinding, SelectedUnit}; +use crate::target::{ + ArtifactReference, BindingRequirement, Boundary, CoreSignature, ExportKind, ImportKind, + Provider, RuntimeUnitOffer, TargetPolicy, +}; +use crate::verify::{VerifiedArtifact, verify_artifact}; +use std::collections::{BTreeMap, BTreeSet}; + +pub(crate) struct ClosedProviders { + pub bindings: Vec, + pub units: Vec, + pub edges: Vec, + pub initialization: Vec, + pub verified: BTreeMap, + pub artifacts: Vec, + pub growth_owner: String, + pub shared_import: Option<(String, String)>, +} + +pub(crate) fn close( + context: &ResolvedWorldContext, + requirements: &[BindingRequirement], + units: &[RuntimeUnitOffer], + policy: &TargetPolicy, + growth_owner: &str, +) -> Result { + let stage = LinkStage::Requirements; + if growth_owner.is_empty() { + return Err(LinkErrors::plain(stage, "missing growth owner")); + } + let mut requirement_ids = BTreeSet::new(); + for requirement in requirements { + if !requirement_ids.insert(requirement.id) { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "duplicate requirement identity", + )); + } + } + index_units(units)?; + + let mut selected = BTreeSet::new(); + let mut order = Vec::new(); + let mut stack = Vec::new(); + let mut edges = Vec::new(); + let mut bindings = Vec::new(); + let mut claims = BTreeMap::<(String, String), (CoreSignature, String)>::new(); + + for requirement in requirements { + match &requirement.provider { + Provider::Generated => edges.push(ProviderEdge::Generated { + requirement: requirement.id, + origin: requirement.origin.clone(), + }), + Provider::HostInterface { interface } => select::bind_host( + context, + policy, + requirement, + interface, + &mut claims, + &mut bindings, + &mut edges, + )?, + Provider::RuntimeOperation { name, version } => { + let provider = select::resolve_operation( + units, + name, + version, + requirement.expected.as_ref(), + Some(&requirement.boundary), + &requirement.origin, + )?; + let unit = &units[provider]; + let operation = select::offered(unit, name, version).expect("resolved operation"); + let Boundary::RawCore { module, field } = &requirement.boundary else { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "a runtime operation requires a raw-core boundary", + )); + }; + select::claim( + &mut claims, + (module.clone(), field.clone()), + operation.signature.clone(), + &unit.id, + )?; + edges.push(ProviderEdge::Runtime { + requirement: requirement.id, + origin: requirement.origin.clone(), + operation: name.clone(), + version: version.clone(), + unit: unit.id.clone(), + }); + bindings.push(ResolvedBinding { + requirement: requirement.id, + origin: requirement.origin.clone(), + module: module.clone(), + field: field.clone(), + signature: operation.signature.clone(), + }); + close_unit( + units, + provider, + &mut selected, + &mut order, + &mut stack, + &mut edges, + )?; + } + } + } + + let growth = growth_owner.to_string(); + check_state(units, &order, &growth)?; + let shared_import = shared_memory(units, &order)?; + let verified = verify_selected(units, &order)?; + let initialization = initialization(&verified.units); + Ok(ClosedProviders { + bindings, + units: verified.units, + edges, + initialization, + verified: verified.verified, + artifacts: verified.artifacts, + growth_owner: growth, + shared_import, + }) +} + +fn index_units(units: &[RuntimeUnitOffer]) -> Result<(), LinkErrors> { + let stage = LinkStage::Requirements; + let mut ids = BTreeSet::new(); + let mut artifacts = BTreeSet::new(); + for unit in units { + if unit.id.is_empty() || unit.semantic_contract_version.is_empty() { + return Err(LinkErrors::plain(stage, "runtime unit is missing identity")); + } + if !ids.insert(unit.id.clone()) { + return Err(LinkErrors::one(stage, &unit.id, "duplicate runtime unit")); + } + if unit.artifact.contract.id.is_empty() + || !artifacts.insert(unit.artifact.contract.id.clone()) + { + return Err(LinkErrors::one( + stage, + &unit.id, + "runtime unit is missing a unique artifact variant", + )); + } + let mut operations = BTreeSet::new(); + for operation in &unit.provided { + if operation.name.is_empty() + || operation.version.is_empty() + || operation.export.is_empty() + { + return Err(LinkErrors::one( + stage, + &unit.id, + "runtime operation is missing identity", + )); + } + if !operations.insert((operation.name.clone(), operation.version.clone())) { + return Err(LinkErrors::one( + stage, + &unit.id, + format!( + "unit advertises `{}@{}` more than once", + operation.name, operation.version + ), + )); + } + } + } + Ok(()) +} + +fn close_unit( + units: &[RuntimeUnitOffer], + index: usize, + selected: &mut BTreeSet, + order: &mut Vec, + stack: &mut Vec, + edges: &mut Vec, +) -> Result<(), LinkErrors> { + if selected.contains(&index) { + return Ok(()); + } + if stack.contains(&index) { + return Err(LinkErrors::one( + LinkStage::Requirements, + &units[index].id, + "unsupported provider cycle", + )); + } + agree_with_contract(&units[index])?; + stack.push(index); + let required = units[index].required.clone(); + let from_unit = units[index].id.clone(); + for operation in required { + let provider = select::resolve_operation( + units, + &operation.name, + &operation.version, + Some(&operation.signature), + None, + &from_unit, + )?; + edges.push(ProviderEdge::Dependency { + from_unit: from_unit.clone(), + operation: operation.name, + version: operation.version, + unit: units[provider].id.clone(), + }); + close_unit(units, provider, selected, order, stack, edges)?; + } + stack.pop(); + selected.insert(index); + order.push(index); + Ok(()) +} + +fn agree_with_contract(unit: &RuntimeUnitOffer) -> Result<(), LinkErrors> { + for operation in &unit.provided { + let matches = unit.artifact.contract.exports.iter().any(|export| { + export.kind == ExportKind::Func + && export.name == operation.export + && export.signature.as_ref() == Some(&operation.signature) + }); + if !matches { + return Err(LinkErrors::one( + LinkStage::Requirements, + &unit.id, + format!( + "operation `{}` disagrees with the artifact contract", + operation.export + ), + )); + } + } + Ok(()) +} + +fn check_state( + units: &[RuntimeUnitOffer], + order: &[usize], + growth_owner: &str, +) -> Result<(), LinkErrors> { + let stage = LinkStage::Requirements; + let mut owners = BTreeMap::new(); + let mut growth = Vec::new(); + for index in order { + let unit = &units[*index]; + if let Some(owner) = &unit.state_owner { + if owner.is_empty() { + return Err(LinkErrors::one(stage, &unit.id, "missing state owner")); + } + if owners.insert(owner.clone(), unit.id.clone()).is_some() { + return Err(LinkErrors::one( + stage, + owner.clone(), + "duplicate state owner", + )); + } + } + // The demand names one growth owner. That owner may be the generated + // allocator today or the allocator runtime unit that replaces it. + // Any other selected unit that grows the same memory conflicts. + if unit.grows_memory && unit.id != growth_owner { + growth.push(unit.id.clone()); + } + } + if !growth.is_empty() { + return Err(LinkErrors::one( + stage, + growth.join(","), + format!("conflicting growth owners; `{growth_owner}` already owns growth"), + )); + } + Ok(()) +} + +fn shared_memory( + units: &[RuntimeUnitOffer], + order: &[usize], +) -> Result, LinkErrors> { + let mut shared = None; + for index in order { + let unit = &units[*index]; + let memories: Vec<_> = unit + .artifact + .contract + .imports + .iter() + .filter(|import| matches!(import.kind, ImportKind::Memory { .. })) + .collect(); + if memories.len() > 1 { + return Err(LinkErrors::one( + LinkStage::Memory, + &unit.id, + "unsupported memory profile", + )); + } + if let Some(import) = memories.first() { + let name = (import.module.clone(), import.field.clone()); + if shared.get_or_insert_with(|| name.clone()) != &name { + return Err(LinkErrors::one( + LinkStage::Memory, + &unit.id, + "conflicting shared-memory imports", + )); + } + } + } + Ok(shared) +} + +struct VerifiedSelection { + verified: BTreeMap, + artifacts: Vec, + units: Vec, +} + +fn verify_selected( + units: &[RuntimeUnitOffer], + order: &[usize], +) -> Result { + let mut verified = BTreeMap::new(); + let mut artifacts = Vec::new(); + let mut selected = Vec::new(); + for index in order { + let unit = &units[*index]; + let id = unit.artifact.contract.id.clone(); + if !verified.contains_key(&id) { + verified.insert( + id.clone(), + verify_artifact(&unit.artifact.contract, &unit.artifact.bytes)?, + ); + } + selected.push(SelectedUnit { + id: unit.id.clone(), + artifact: id, + kind: unit.artifact.contract.kind, + state_owner: unit.state_owner.clone(), + grows_memory: unit.grows_memory, + instantiate_after_shims: unit.artifact.contract.instantiate_after_shims, + }); + artifacts.push(unit.artifact.clone()); + } + Ok(VerifiedSelection { + verified, + artifacts, + units: selected, + }) +} + +fn initialization(units: &[SelectedUnit]) -> Vec { + let mut steps = Vec::new(); + for unit in units.iter().filter(|unit| !unit.instantiate_after_shims) { + steps.push(InitializationStep::Instantiate { + unit: unit.id.clone(), + }); + } + steps.push(InitializationStep::ResolveShims); + for unit in units.iter().filter(|unit| unit.instantiate_after_shims) { + steps.push(InitializationStep::Instantiate { + unit: unit.id.clone(), + }); + } + steps +} diff --git a/crates/psrs-linker/src/graph/select.rs b/crates/psrs-linker/src/graph/select.rs new file mode 100644 index 00000000..8f05a178 --- /dev/null +++ b/crates/psrs-linker/src/graph/select.rs @@ -0,0 +1,183 @@ +//! Choose the one compatible provider for an operation or host import. + +use crate::definitions::ResolvedWorldContext; +use crate::error::{LinkErrors, LinkStage}; +use crate::plan::{ProviderEdge, ResolvedBinding}; +use crate::target::{ + ArtifactKind, BindingRequirement, Boundary, CoreSignature, RuntimeUnitOffer, TargetPolicy, +}; +use std::collections::BTreeMap; + +pub(super) fn resolve_operation( + units: &[RuntimeUnitOffer], + name: &str, + version: &str, + expected: Option<&CoreSignature>, + boundary: Option<&Boundary>, + origin: &str, +) -> Result { + let stage = LinkStage::Requirements; + let Some(expected) = expected else { + return Err(LinkErrors::one( + stage, + origin, + format!("runtime operation `{name}@{version}` has no checked signature"), + )); + }; + let mut compatible = Vec::new(); + let mut boundary_mismatch = false; + let mut kind_mismatch = false; + for (index, unit) in units.iter().enumerate() { + let Some(operation) = offered(unit, name, version) else { + continue; + }; + let signature_ok = operation.signature == *expected; + let kind_ok = unit.artifact.contract.kind == ArtifactKind::CoreModule; + let boundary_ok = match boundary { + None => true, + Some(Boundary::RawCore { module, field }) => { + module == &unit.artifact.contract.module_name && field == &operation.export + } + Some(Boundary::ResolvedWit { .. }) => false, + }; + if signature_ok && kind_ok && boundary_ok { + compatible.push(index); + } else if signature_ok && kind_ok { + boundary_mismatch = true; + } else if signature_ok { + kind_mismatch = true; + } + } + match compatible.len() { + 1 => Ok(compatible[0]), + 0 if !units + .iter() + .any(|unit| offered(unit, name, version).is_some()) => + { + Err(LinkErrors::one( + stage, + origin, + format!("no runtime unit provides `{name}@{version}`"), + )) + } + 0 if kind_mismatch && !boundary_mismatch => Err(LinkErrors::one( + stage, + origin, + format!("incompatible artifact kind for `{name}@{version}`"), + )), + 0 if boundary_mismatch => Err(LinkErrors::one( + stage, + origin, + "artifact boundary does not name the selected export", + )), + 0 => Err(LinkErrors::one( + stage, + origin, + "runtime operation signature disagrees with the checked requirement", + )), + _ => Err(LinkErrors::one( + stage, + origin, + format!("ambiguous providers for `{name}@{version}`"), + )), + } +} + +pub(super) fn offered<'a>( + unit: &'a RuntimeUnitOffer, + name: &str, + version: &str, +) -> Option<&'a crate::target::OfferedOperation> { + unit.provided + .iter() + .find(|operation| operation.name == name && operation.version == version) +} + +pub(super) fn bind_host( + context: &ResolvedWorldContext, + policy: &TargetPolicy, + requirement: &BindingRequirement, + interface: &str, + claims: &mut BTreeMap<(String, String), (CoreSignature, String)>, + bindings: &mut Vec, + edges: &mut Vec, +) -> Result<(), LinkErrors> { + let stage = LinkStage::Requirements; + if !context.imports_interface(interface) { + return Err(LinkErrors::one( + stage, + &requirement.origin, + format!("host interface `{interface}` is outside the resolved world"), + )); + } + if !policy + .permitted_host_interfaces + .iter() + .any(|permitted| permitted == interface) + { + return Err(LinkErrors::one( + stage, + &requirement.origin, + format!("host interface `{interface}` is not permitted by the selected target profile"), + )); + } + let Some(expected) = requirement.expected.clone() else { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "a host binding requires a checked raw signature", + )); + }; + let (module, field) = match &requirement.boundary { + Boundary::ResolvedWit { + interface: name, + function, + } if name == interface => (name.clone(), function.clone()), + _ => { + return Err(LinkErrors::one( + stage, + &requirement.origin, + "host binding must cross the selected WIT interface", + )); + } + }; + claim( + claims, + (module.clone(), field.clone()), + expected.clone(), + interface, + )?; + edges.push(ProviderEdge::Host { + requirement: requirement.id, + origin: requirement.origin.clone(), + interface: interface.to_string(), + }); + bindings.push(ResolvedBinding { + requirement: requirement.id, + origin: requirement.origin.clone(), + module, + field, + signature: expected, + }); + Ok(()) +} + +pub(super) fn claim( + claims: &mut BTreeMap<(String, String), (CoreSignature, String)>, + key: (String, String), + signature: CoreSignature, + provider: &str, +) -> Result<(), LinkErrors> { + if let Some((existing, existing_provider)) = claims.get(&key) { + if existing != &signature || existing_provider != provider { + return Err(LinkErrors::one( + LinkStage::Requirements, + format!("{}.{}", key.0, key.1), + "ambiguous or conflicting providers for one import identity", + )); + } + return Ok(()); + } + claims.insert(key, (signature, provider.to_string())); + Ok(()) +} diff --git a/crates/psrs-linker/src/lib.rs b/crates/psrs-linker/src/lib.rs index 85a8ce87..4ce385d1 100644 --- a/crates/psrs-linker/src/lib.rs +++ b/crates/psrs-linker/src/lib.rs @@ -19,6 +19,7 @@ mod compose; mod definitions; mod digest; mod error; +mod graph; pub mod guest; pub mod plan; pub mod runtime; @@ -30,12 +31,16 @@ pub use compose::{LinkedArtifact, compose}; pub use definitions::{ResolvedWorldContext, resolve_default_definitions, resolve_definitions}; pub use digest::sha256_hex; pub use error::{LinkError, LinkErrors, LinkStage}; -pub use plan::{CheckedLinkPlan, MemoryPlan, ResolvedBinding, plan}; +pub use plan::{ + CheckedLinkPlan, HeapBoundary, InitializationStep, LinkReport, MemoryPlan, ProviderEdge, + ResolvedBinding, SelectedUnit, plan, +}; pub use stack::{StackBound, measure_stack_bound}; pub use target::{ - ArtifactContract, ArtifactKind, ArtifactReference, BindingRequirement, Boundary, CoreSignature, - CoreType, DeclaredElement, DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, - ExportKind, ImportKind, InitializationContract, MemoryDemand, Provider, RequirementId, - StorageContract, StorageRegion, TargetLinkInput, TargetPolicy, + APPLICATION_MEMORY, ArtifactContract, ArtifactKind, ArtifactReference, BindingRequirement, + Boundary, CoreSignature, CoreType, DeclaredElement, DeclaredExport, DeclaredGlobal, + DeclaredImport, DeclaredTable, ExportKind, GENERATED_GROWTH_OWNER, ImportKind, + InitializationContract, MemoryDemand, OfferedOperation, Provider, RequiredOperation, + RequirementId, RuntimeUnitOffer, StorageContract, StorageRegion, TargetLinkInput, TargetPolicy, }; pub use verify::{VerifiedArtifact, verify_artifact}; diff --git a/crates/psrs-linker/src/plan.rs b/crates/psrs-linker/src/plan.rs index 1e4895c2..e14cfc9c 100644 --- a/crates/psrs-linker/src/plan.rs +++ b/crates/psrs-linker/src/plan.rs @@ -2,12 +2,8 @@ use crate::definitions::ResolvedWorldContext; use crate::error::{LinkErrors, LinkStage}; -use crate::target::{ - ArtifactContract, ArtifactKind, Boundary, CoreSignature, Provider, RequirementId, - StorageRegion, TargetLinkInput, -}; -use crate::verify::{VerifiedArtifact, verify_artifact}; -use std::collections::{BTreeMap, BTreeSet}; +use crate::target::{ArtifactKind, CoreSignature, RequirementId, StorageRegion, TargetLinkInput}; +use crate::verify::VerifiedArtifact; /// A requirement bound to its verified provider. #[derive(Clone, Debug, PartialEq, Eq)] @@ -19,18 +15,98 @@ pub struct ResolvedBinding { pub signature: CoreSignature, } +/// The application's exported heap boundary and the provider import it satisfies. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct HeapBoundary { + /// Core-module name of the runtime unit that imports the boundary. + pub provider_module: String, + /// Import module, for example `__main_module__`. + pub import_module: String, + /// Import field and application export name. + pub field: String, +} + /// The checked memory ownership and allocator boundary. #[derive(Clone, Debug, PartialEq, Eq)] pub struct MemoryPlan { + /// Identity of this shared memory. One plan owns one memory. + pub memory_id: String, pub heap_start: u32, pub heap_alignment: u32, pub minimum_pages: u64, + pub maximum_pages: u64, + /// The only owner allowed to grow this memory. + pub growth_owner: String, + /// The core import every selected memory-using unit shares, when any does. + pub shared_import: Option<(String, String)>, + /// The constant heap-boundary getter the selected growth owner imports. + /// + /// `provider_module` is the owner's core-module name. The application + /// exports `field`; composition aliases that export into `import_module`. + pub heap_getter: Option, /// Every owned region, sorted by start address. pub reservations: Vec, pub(crate) canonical_scratch: (u32, u32), pub(crate) allocator_state: (u32, u32), } +/// A runtime unit selected by provider closure. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct SelectedUnit { + pub id: String, + pub artifact: String, + pub kind: crate::ArtifactKind, + pub state_owner: Option, + pub grows_memory: bool, + pub instantiate_after_shims: bool, +} + +/// One edge in the checked provider graph. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum ProviderEdge { + Generated { + requirement: RequirementId, + origin: String, + }, + Runtime { + requirement: RequirementId, + origin: String, + operation: String, + version: String, + unit: String, + }, + /// A selected unit's required operation, closed to another unit. + Dependency { + from_unit: String, + operation: String, + version: String, + unit: String, + }, + Host { + requirement: RequirementId, + origin: String, + interface: String, + }, +} + +/// Checked instantiation order. Calls happen only after shim resolution. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum InitializationStep { + Instantiate { unit: String }, + ResolveShims, +} + +/// The published identities and digests of one successful plan. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct LinkReport { + pub memory_id: String, + pub growth_owner: String, + pub units: Vec, + pub initialization: Vec, + pub digests: Vec, + pub external_world: Vec, +} + /// One immutable checked target link plan. /// /// Construction is private to successful planning, so every live requirement @@ -40,6 +116,9 @@ pub struct MemoryPlan { pub struct CheckedLinkPlan { bindings: Vec, artifacts: Vec, + units: Vec, + edges: Vec, + initialization: Vec, memory: MemoryPlan, external_world: Vec, digests: Vec, @@ -81,6 +160,34 @@ impl CheckedLinkPlan { pub fn digests(&self) -> &[String] { &self.digests } + + pub fn units(&self) -> &[SelectedUnit] { + &self.units + } + + pub fn edges(&self) -> &[ProviderEdge] { + &self.edges + } + + pub fn initialization(&self) -> &[InitializationStep] { + &self.initialization + } + + pub fn growth_owner(&self) -> &str { + &self.memory.growth_owner + } + + /// Identities, initialization order, and digests for this plan. + pub fn report(&self) -> LinkReport { + LinkReport { + memory_id: self.memory.memory_id.clone(), + growth_owner: self.memory.growth_owner.clone(), + units: self.units.iter().map(|unit| unit.id.clone()).collect(), + initialization: self.initialization.clone(), + digests: self.digests.clone(), + external_world: self.external_world.clone(), + } + } } /// Plans a checked link from a resolved world and target input. @@ -90,180 +197,29 @@ pub fn plan( ) -> Result { let TargetLinkInput { requirements, - artifacts: artifact_refs, + units, memory: memory_demand, policy, } = input; let stage = LinkStage::Requirements; - let mut errors = Vec::new(); - - let mut requirement_ids = BTreeSet::new(); - for requirement in &requirements { - if !requirement_ids.insert(requirement.id) { - errors.push(crate::error::LinkError { - stage, - subject: Some(requirement.origin.clone()), - message: "duplicate requirement identity".into(), - }); - } - } - - let mut artifacts: BTreeMap = BTreeMap::new(); - for artifact in &artifact_refs { - let id = artifact.contract.id.clone(); - if artifacts.insert(id.clone(), artifact.clone()).is_some() { - errors.push(crate::error::LinkError { - stage, - subject: Some(id), - message: "duplicate artifact identity".into(), - }); - } - } - if !errors.is_empty() { - return Err(LinkErrors::new(errors)); - } - - let mut verified: BTreeMap = BTreeMap::new(); - let mut used_artifacts = BTreeSet::new(); - // A core import identity resolves to exactly one provider and signature. - let mut claims = BTreeMap::<(String, String), (CoreSignature, String)>::new(); - let mut bindings = Vec::new(); - - for requirement in &requirements { - match &requirement.provider { - Provider::Generated => {} - Provider::ArtifactExport { - artifact, - export, - signature, - } => { - let reference = artifacts.get(artifact).ok_or_else(|| { - LinkErrors::one( - stage, - &requirement.origin, - format!("absent artifact `{artifact}`"), - ) - })?; - let Boundary::RawCore { module, field } = &requirement.boundary else { - return Err(LinkErrors::one( - stage, - &requirement.origin, - "an artifact export requires a raw-core boundary", - )); - }; - if module != &reference.contract.module_name || field != export { - return Err(LinkErrors::one( - stage, - &requirement.origin, - "artifact boundary does not name the selected export", - )); - } - let declared = artifact_export(&reference.contract, export).ok_or_else(|| { - LinkErrors::one( - stage, - &requirement.origin, - format!("artifact `{artifact}` does not declare export `{export}`"), - ) - })?; - if declared != *signature || requirement.expected.as_ref() != Some(signature) { - return Err(LinkErrors::one( - stage, - &requirement.origin, - "artifact export signature disagrees with the checked requirement", - )); - } - if !verified.contains_key(artifact) { - let value = verify_artifact(&reference.contract, &reference.bytes)?; - verified.insert(artifact.clone(), value); - } - used_artifacts.insert(artifact.clone()); - claim( - &mut claims, - (module.clone(), field.clone()), - signature.clone(), - artifact, - &mut errors, - )?; - bindings.push(ResolvedBinding { - requirement: requirement.id, - origin: requirement.origin.clone(), - module: module.clone(), - field: field.clone(), - signature: signature.clone(), - }); - } - Provider::HostInterface { interface } => { - if !context.imports_interface(interface) { - return Err(LinkErrors::one( - stage, - &requirement.origin, - format!("host interface `{interface}` is outside the resolved world"), - )); - } - if !policy - .permitted_host_interfaces - .iter() - .any(|permitted| permitted == interface) - { - return Err(LinkErrors::one( - stage, - &requirement.origin, - format!( - "host interface `{interface}` is not permitted by the selected target profile" - ), - )); - } - let Some(expected) = requirement.expected.clone() else { - return Err(LinkErrors::one( - stage, - &requirement.origin, - "a host binding requires a checked raw signature", - )); - }; - let (module, field) = match &requirement.boundary { - Boundary::ResolvedWit { - interface: name, - function, - } if name == interface => (name.clone(), function.clone()), - _ => { - return Err(LinkErrors::one( - stage, - &requirement.origin, - "host binding must cross the selected WIT interface", - )); - } - }; - claim( - &mut claims, - (module.clone(), field.clone()), - expected.clone(), - interface, - &mut errors, - )?; - bindings.push(ResolvedBinding { - requirement: requirement.id, - origin: requirement.origin.clone(), - module, - field, - signature: expected, - }); - } - } - } - if !errors.is_empty() { - return Err(LinkErrors::new(errors)); - } + let closed = crate::graph::close( + context, + &requirements, + &units, + &policy, + &memory_demand.growth_owner, + )?; + let memory = plan_memory(&closed, &memory_demand)?; - let memory = plan_memory(&artifact_refs, &memory_demand, &used_artifacts, &verified)?; - - let mut digests = verified + let mut digests = closed + .verified .values() .map(|value| value.sha256.clone()) .collect::>(); digests.sort(); digests.dedup(); - let external = crate::closure::host_imports(context, &bindings)?; + let external = crate::closure::host_imports(context, &closed.bindings)?; for interface in &external { if !context.imports_interface(interface) || !policy.permitted_host_interfaces.contains(interface) @@ -276,8 +232,11 @@ pub fn plan( } } Ok(CheckedLinkPlan { - bindings, - artifacts: verified.into_values().collect(), + bindings: closed.bindings, + artifacts: closed.verified.into_values().collect(), + units: closed.units, + edges: closed.edges, + initialization: closed.initialization, memory, external_world: external, digests, @@ -285,57 +244,36 @@ pub fn plan( }) } -fn artifact_export(contract: &ArtifactContract, export: &str) -> Option { - contract.exports.iter().find_map(|declared| { - (declared.name == export && declared.kind == crate::target::ExportKind::Func) - .then(|| declared.signature.clone()) - .flatten() - }) -} - -fn claim( - claims: &mut BTreeMap<(String, String), (CoreSignature, String)>, - key: (String, String), - signature: CoreSignature, - provider: &str, - errors: &mut Vec, -) -> Result<(), LinkErrors> { - if let Some((existing, existing_provider)) = claims.get(&key) { - if existing != &signature || existing_provider != provider { - return Err(LinkErrors::one( - LinkStage::Requirements, - format!("{}.{}", key.0, key.1), - "ambiguous or conflicting providers for one import identity", - )); - } - return Ok(()); - } - claims.insert(key, (signature, provider.to_string())); - let _ = errors; - Ok(()) -} - fn plan_memory( - artifacts: &[crate::target::ArtifactReference], + closed: &crate::graph::ClosedProviders, demand: &crate::target::MemoryDemand, - used_artifacts: &BTreeSet, - verified: &BTreeMap, ) -> Result { let stage = LinkStage::Memory; - let mut reservations = vec![ - region("canonical-scratch", demand.canonical_scratch), - region("allocator-state", demand.allocator_state), - ]; + let maximum = demand.maximum_pages.unwrap_or(65536); + if maximum == 0 || maximum > 65536 { + return Err(LinkErrors::plain(stage, "unsupported memory maximum")); + } + if demand.canonical_scratch.0 > demand.canonical_scratch.1 + || demand.allocator_state.0 > demand.allocator_state.1 + { + return Err(LinkErrors::plain( + stage, + "storage reservation has reversed bounds", + )); + } + let mut reservations = Vec::new(); + if demand.canonical_scratch.0 < demand.canonical_scratch.1 { + reservations.push(region("canonical-scratch", demand.canonical_scratch)); + } + if demand.allocator_state.0 < demand.allocator_state.1 { + reservations.push(region("allocator-state", demand.allocator_state)); + } let mut heap_start = demand.base_heap_start; let mut minimum_pages = u64::from(heap_start).div_ceil(0x1_0000) + 1; - for id in used_artifacts { - let artifact = verified.get(id).expect("a used artifact is verified"); - let contract = artifacts - .iter() - .find(|reference| &reference.contract.id == id) - .map(|reference| &reference.contract) - .ok_or_else(|| LinkErrors::one(stage, id, "verified artifact has no contract"))?; + for reference in &closed.artifacts { + let id = &reference.contract.id; + let contract = &reference.contract; let Some(storage) = &contract.storage else { continue; }; @@ -365,7 +303,6 @@ fn plan_memory( }); heap_start = heap_start.max(storage.heap_start); minimum_pages = minimum_pages.max(storage.minimum_pages); - let _ = artifact; } reservations.sort_by_key(|region| (region.start, region.end)); @@ -403,10 +340,10 @@ fn plan_memory( "a reservation extends past the allocator boundary", )); } - if minimum_pages > 65536 { + if minimum_pages > maximum { return Err(LinkErrors::plain( stage, - "memory plan exceeds wasm32 limits", + "memory plan exceeds its declared maximum", )); } if u64::from(heap_start) > minimum_pages * 0x1_0000 { @@ -418,23 +355,85 @@ fn plan_memory( // The allocator grows memory on demand; reserve one initial page of heap // beyond the boundary where every reserved region ends. minimum_pages = minimum_pages.max(u64::from(heap_start).div_ceil(0x1_0000) + 1); - if minimum_pages > 65536 { + if minimum_pages > maximum { return Err(LinkErrors::plain( stage, - "memory plan exceeds wasm32 limits", + "memory plan exceeds its declared maximum", )); } Ok(MemoryPlan { + memory_id: crate::APPLICATION_MEMORY.to_string(), heap_start, heap_alignment: alignment, minimum_pages, + maximum_pages: maximum, + growth_owner: closed.growth_owner.clone(), + shared_import: closed.shared_import.clone(), + heap_getter: heap_boundary(closed, demand)?, reservations, canonical_scratch: demand.canonical_scratch, allocator_state: demand.allocator_state, }) } +fn heap_boundary( + closed: &crate::graph::ClosedProviders, + demand: &crate::target::MemoryDemand, +) -> Result, LinkErrors> { + let Some(position) = closed + .units + .iter() + .position(|unit| unit.id == demand.growth_owner) + else { + if closed + .artifacts + .iter() + .any(|artifact| artifact.contract.imports.iter().any(is_heap_getter)) + { + return Err(LinkErrors::plain( + LinkStage::Memory, + "heap getter imports require a planned runtime growth owner", + )); + } + return Ok(None); + }; + let stage = LinkStage::Memory; + let unit = &closed.units[position]; + if !unit.grows_memory { + return Err(LinkErrors::one( + stage, + &unit.id, + "the named growth owner does not grow memory", + )); + } + let contract = &closed.artifacts[position].contract; + let functions: Vec<_> = contract + .imports + .iter() + .filter(|import| matches!(import.kind, crate::ImportKind::Function(_))) + .collect(); + let [import] = functions.as_slice() else { + return Err(LinkErrors::one( + stage, + &unit.id, + "the growth owner must import exactly one constant heap-boundary getter", + )); + }; + if !is_heap_getter(import) { + return Err(LinkErrors::one( + stage, + &unit.id, + "invalid application heap getter contract", + )); + } + Ok(Some(HeapBoundary { + provider_module: contract.module_name.clone(), + import_module: import.module.clone(), + field: import.field.clone(), + })) +} + fn region(owner: &str, range: (u32, u32)) -> StorageRegion { StorageRegion { owner: owner.to_string(), @@ -442,3 +441,14 @@ fn region(owner: &str, range: (u32, u32)) -> StorageRegion { end: range.1, } } + +/// The application-bound getter protocol; composition verifies its constant body. +pub(crate) fn is_heap_getter(import: &crate::DeclaredImport) -> bool { + import.module == psrs_runtime::APPLICATION_MODULE + && import.field == psrs_runtime::HEAP_BOUNDARY_IMPORT + && import.kind + == crate::ImportKind::Function(CoreSignature { + parameters: Vec::new(), + result: Some(crate::CoreType::I32), + }) +} diff --git a/crates/psrs-linker/src/runtime.rs b/crates/psrs-linker/src/runtime.rs index 97162a00..b71e3868 100644 --- a/crates/psrs-linker/src/runtime.rs +++ b/crates/psrs-linker/src/runtime.rs @@ -4,11 +4,12 @@ //! contract it verifies and plans against. use crate::target::{ - ArtifactContract, ArtifactKind, CoreSignature, CoreType, DeclaredElement, DeclaredExport, - DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, ImportKind, InitializationContract, - StorageContract, StorageRegion, + ArtifactContract, ArtifactKind, ArtifactReference, CoreSignature, CoreType, DeclaredElement, + DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, ImportKind, + InitializationContract, OfferedOperation, RequiredOperation, RuntimeUnitOffer, StorageContract, + StorageRegion, }; -use psrs_runtime::{RawType, RuntimeArtifact}; +use psrs_runtime::{RawType, RuntimeArtifact, RuntimePackage, RuntimeUnit}; /// Maps a catalog artifact into the contract its bytes must satisfy. pub fn contract(artifact: &RuntimeArtifact) -> ArtifactContract { @@ -46,7 +47,17 @@ pub fn contract(artifact: &RuntimeArtifact) -> ArtifactContract { .map(|import| DeclaredImport { module: import.module.to_string(), field: import.field.to_string(), - kind: ImportKind::Memory, + kind: match import.kind { + psrs_runtime::RawImportKind::Memory { minimum, maximum } => { + ImportKind::Memory { minimum, maximum } + } + psrs_runtime::RawImportKind::Function { parameters, result } => { + ImportKind::Function(CoreSignature { + parameters: parameters.iter().copied().map(core_type).collect(), + result: result.map(core_type), + }) + } + }, }) .collect(), exports: artifact @@ -108,6 +119,51 @@ pub fn contract(artifact: &RuntimeArtifact) -> ArtifactContract { } } +/// Maps one catalog unit onto the offer planning resolves. +pub fn offer(unit: &RuntimeUnit) -> RuntimeUnitOffer { + RuntimeUnitOffer { + id: unit.id.to_string(), + semantic_contract_version: unit.semantic_contract_version.to_string(), + provided: unit + .provided + .iter() + .map(|operation| OfferedOperation { + name: operation.name.to_string(), + version: operation.version.to_string(), + export: operation.abi.export.to_string(), + signature: signature(operation.abi.parameters, operation.abi.result), + }) + .collect(), + required: unit + .required + .iter() + .map(|operation| RequiredOperation { + name: operation.name.to_string(), + version: operation.version.to_string(), + signature: signature(operation.parameters, operation.result), + }) + .collect(), + artifact: ArtifactReference { + contract: contract(unit.variant), + bytes: unit.variant.bytes.to_vec(), + }, + state_owner: unit.state.owner.map(str::to_string), + grows_memory: unit.state.grows_memory, + } +} + +/// Maps every unit of a catalog package. Unused units stay unselected. +pub fn package_offers(package: &RuntimePackage) -> Vec { + package.units.iter().copied().map(offer).collect() +} + +fn signature(parameters: &[RawType], result: Option) -> CoreSignature { + CoreSignature { + parameters: parameters.iter().copied().map(core_type).collect(), + result: result.map(core_type), + } +} + fn core_type(ty: RawType) -> CoreType { match ty { RawType::I32 => CoreType::I32, diff --git a/crates/psrs-linker/src/stack/mod.rs b/crates/psrs-linker/src/stack/mod.rs index 3a55970e..1062dadc 100644 --- a/crates/psrs-linker/src/stack/mod.rs +++ b/crates/psrs-linker/src/stack/mod.rs @@ -21,6 +21,16 @@ pub struct StackBound { /// Exported tables are also rejected: callers could otherwise enter a private /// function through them. Modules with no entry points are analyzed in full. pub fn measure_stack_bound(bytes: &[u8], stack_pointer_global: u32) -> Result { + measure_stack_bound_with_imports(bytes, stack_pointer_global, &[]) +} + +/// Imported function indices proven by composition to use no linear stack. +/// All other imported calls retain the conservative rejection behavior. +pub(crate) fn measure_stack_bound_with_imports( + bytes: &[u8], + stack_pointer_global: u32, + stackless_imports: &[u32], +) -> Result { // Exception and suspension proposals require a separate frame-unwind // proof. They cannot enter this normal-return-only analysis. use wasmparser::WasmFeatures as F; @@ -96,6 +106,7 @@ pub fn measure_stack_bound(bytes: &[u8], stack_pointer_global: u32) -> Result { - if depth == 0 - && !restored + let restores = !restored && matches!(operators.get(index + 1), Some(Operator::I32Const { value }) if *value as u32 == frame) && matches!(operators.get(index + 2), Some(Operator::I32Add)) - && matches!(operators.get(index + 3), Some(Operator::GlobalSet { global_index }) if *global_index == stack_pointer_global) - { - restored = true; - index += 4; + && matches!(operators.get(index + 3), Some(Operator::GlobalSet { global_index }) if *global_index == stack_pointer_global); + // LLVM leaves the epilogue inside the function's wrapper block, + // optionally reloads the return value, and returns immediately. + // That return leaves the function, so the restore covers it + // without blessing any later path. + let covers_return = match operators.get(index + 4) { + Some(Operator::Return) => Some(5), + Some(Operator::LocalGet { .. }) + if matches!(operators.get(index + 5), Some(Operator::Return)) => + { + Some(6) + } + _ => None, + }; + if restores && (depth == 0 || covers_return.is_some()) { + if depth == 0 { + restored = true; + index += 4; + } else { + index += covers_return.expect("the return is covered"); + } continue; } } @@ -252,6 +279,7 @@ fn visit( memo: &mut [Option], visiting: &mut [bool], imported_functions: usize, + stackless_imports: &[u32], ) -> Result { if let Some(value) = memo[index] { return Ok(value); @@ -265,11 +293,21 @@ fn visit( for callee in callees { let callee = *callee as usize; if callee < imported_functions { + if stackless_imports.contains(&(callee as u32)) { + continue; + } return Err("a call into an imported function makes the stack bound unknown".into()); } let defined = callee - imported_functions; if defined < bodies.len() { - deepest = deepest.max(visit(defined, bodies, memo, visiting, imported_functions)?); + deepest = deepest.max(visit( + defined, + bodies, + memo, + visiting, + imported_functions, + stackless_imports, + )?); } else { return Err("callee is outside the analyzed module".into()); } diff --git a/crates/psrs-linker/src/stack/tests.rs b/crates/psrs-linker/src/stack/tests.rs index c6c044c6..aac7b320 100644 --- a/crates/psrs-linker/src/stack/tests.rs +++ b/crates/psrs-linker/src/stack/tests.rs @@ -213,3 +213,21 @@ fn recursive_module() -> Vec { module.section(&code); module.finish() } + +#[test] +fn imported_calls_require_an_explicit_cross_module_stack_proof() { + let bytes = wat::parse_str( + r#"(module + (import "application" "constant" (func $get (result i32))) + (func (export "entry") call $get drop))"#, + ) + .unwrap(); + assert!(measure_stack_bound(&bytes, 0).is_err()); + assert_eq!( + measure_stack_bound_with_imports(&bytes, 0, &[0]) + .unwrap() + .bytes, + 0 + ); + assert!(measure_stack_bound_with_imports(&bytes, 0, &[1]).is_err()); +} diff --git a/crates/psrs-linker/src/target.rs b/crates/psrs-linker/src/target.rs index 923a473f..098dbba1 100644 --- a/crates/psrs-linker/src/target.rs +++ b/crates/psrs-linker/src/target.rs @@ -35,16 +35,15 @@ pub enum Boundary { } /// The selected implementation for a requirement. +/// +/// A runtime operation names an identity and version. Planning selects the +/// unique compatible unit; a caller-chosen artifact is not a provider. #[derive(Clone, Debug, PartialEq, Eq)] pub enum Provider { /// A compiler-generated local operation or helper; no import results. Generated, - /// An export of a pinned core-Wasm artifact. - ArtifactExport { - artifact: String, - export: String, - signature: CoreSignature, - }, + /// Resolve the unique offered unit that provides this operation. + RuntimeOperation { name: String, version: String }, /// A host interface retained in the component's external world. HostInterface { interface: String }, } @@ -73,10 +72,18 @@ pub enum ArtifactKind { } /// The kind of a declared artifact import. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] +#[derive(Clone, Debug, PartialEq, Eq)] pub enum ImportKind { - Memory, - Function, + /// A shared memory import. Limits are part of the pinned contract. + Memory { + minimum: u64, + maximum: Option, + }, + /// An `i32` global import. + Global { + mutable: bool, + }, + Function(CoreSignature), } /// An import the artifact's contract declares. @@ -198,6 +205,46 @@ pub struct TargetPolicy { pub permitted_host_interfaces: Vec, } +/// Growth owner while the backend still synthesizes `cabi_realloc`. +/// +/// The canonical realloc adapter replaces this name with one allocator runtime +/// unit. Planning accepts that unit when the demand names its identity. +pub const GENERATED_GROWTH_OWNER: &str = "psrs:allocator/generated"; + +/// Identity of the one shared application memory. +pub const APPLICATION_MEMORY: &str = "application"; + +/// One operation an offered runtime unit provides. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct OfferedOperation { + pub name: String, + pub version: String, + pub export: String, + pub signature: CoreSignature, +} + +/// An operation an offered unit requires from another provider. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct RequiredOperation { + pub name: String, + pub version: String, + pub signature: CoreSignature, +} + +/// A candidate runtime unit and the one variant it advertises. +#[derive(Clone, Debug)] +pub struct RuntimeUnitOffer { + pub id: String, + pub semantic_contract_version: String, + pub provided: Vec, + pub required: Vec, + pub artifact: ArtifactReference, + /// Private state owner. `None` means the unit owns no private state. + pub state_owner: Option, + /// The unit grows the shared memory. This conflicts with any other owner. + pub grows_memory: bool, +} + /// The canonical ABI memory layout demanded by the application. #[derive(Clone, Debug, PartialEq, Eq)] pub struct MemoryDemand { @@ -209,13 +256,22 @@ pub struct MemoryDemand { pub base_heap_start: u32, /// The allocator block granularity the heap start must satisfy. pub heap_alignment: u32, + /// The one owner allowed to grow the shared memory. + /// + /// The backend currently supplies [`GENERATED_GROWTH_OWNER`]. A selected + /// runtime unit may take this role when the demand names that unit. + pub growth_owner: String, + /// Declared maximum page count. `None` means the wasm32 limit of 65536. + pub maximum_pages: Option, } /// The complete checked input to [`crate::plan::plan`]. #[derive(Clone, Debug)] pub struct TargetLinkInput { pub requirements: Vec, - pub artifacts: Vec, + /// Candidate runtime units. Planning selects only the units a live + /// requirement or a selected unit's dependency reaches. + pub units: Vec, pub policy: TargetPolicy, pub memory: MemoryDemand, } diff --git a/crates/psrs-linker/src/verify/mod.rs b/crates/psrs-linker/src/verify/mod.rs index a4930845..c1f7dc2e 100644 --- a/crates/psrs-linker/src/verify/mod.rs +++ b/crates/psrs-linker/src/verify/mod.rs @@ -65,10 +65,28 @@ pub fn verify_artifact( check_contract(contract, &parsed)?; let stack_bound_bytes = match &contract.storage { Some(storage) => { - let measured = crate::measure_stack_bound(bytes, storage.stack_pointer_global) - .map_err(|message| { - LinkErrors::one(stage, id, format!("stack analysis failed: {message}")) - })?; + let function_imports: Vec<_> = contract + .imports + .iter() + .filter(|import| matches!(import.kind, crate::ImportKind::Function(_))) + .collect(); + let stackless_imports = if function_imports.len() == 1 + && crate::plan::is_heap_getter(function_imports[0]) + { + vec![0] + } else { + Vec::new() + }; + // Application verification discharges this cross-module obligation by + // requiring the getter to contain only i32.const and end. + let measured = crate::stack::measure_stack_bound_with_imports( + bytes, + storage.stack_pointer_global, + &stackless_imports, + ) + .map_err(|message| { + LinkErrors::one(stage, id, format!("stack analysis failed: {message}")) + })?; if measured.bytes > storage.stack_bound_bytes { return Err(LinkErrors::one( stage, diff --git a/crates/psrs-linker/src/verify/parse.rs b/crates/psrs-linker/src/verify/parse.rs index e0aa8199..69b93905 100644 --- a/crates/psrs-linker/src/verify/parse.rs +++ b/crates/psrs-linker/src/verify/parse.rs @@ -71,9 +71,13 @@ pub(super) fn check_contract( )); } if let Some(storage) = &contract.storage { + let absolute = storage.stack_pointer_global as usize; + let defined = absolute + .checked_sub(parsed.imported_globals) + .ok_or_else(|| LinkErrors::one(stage, id, "stack pointer global is an import"))?; let pointer = parsed .globals - .get(storage.stack_pointer_global as usize) + .get(defined) .ok_or_else(|| LinkErrors::one(stage, id, "stack pointer global is absent"))?; if !pointer.mutable || pointer.initial != storage.stack.end @@ -152,6 +156,7 @@ pub(super) struct ParsedCore { data_ranges: Vec<(u32, u32)>, has_start: bool, elements: Vec, + imported_globals: usize, } impl ParsedTable { @@ -192,6 +197,7 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { let mut memories = 0_u32; let mut has_start = false; let mut elements = Vec::new(); + let mut imported_globals = 0_usize; for payload in Parser::new(0).parse_all(bytes) { match payload.map_err(|error| error.to_string())? { @@ -217,7 +223,23 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { imports.push(ParsedImport { module: import.module.to_string(), field: import.name.to_string(), - kind: ImportKind::Memory, + kind: ImportKind::Memory { + minimum: memory.initial, + maximum: memory.maximum, + }, + }); + } + TypeRef::Global(global) => { + if global.content_type != ValType::I32 || global.shared { + return Err("artifact imports an unsupported global".into()); + } + imported_globals += 1; + imports.push(ParsedImport { + module: import.module.to_string(), + field: import.name.to_string(), + kind: ImportKind::Global { + mutable: global.mutable, + }, }); } TypeRef::Func(index) => { @@ -225,7 +247,12 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { imports.push(ParsedImport { module: import.module.to_string(), field: import.name.to_string(), - kind: ImportKind::Function, + kind: ImportKind::Function(function_signature( + imported_functions.len() as u32 - 1, + &imported_functions, + &[], + &types, + )?), }); } _ => return Err("artifact imports an unsupported item".into()), @@ -345,9 +372,6 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { if memories > 0 { return Err("artifact defines its own memory instead of importing one".into()); } - if !imported_functions.is_empty() { - return Err("artifact function imports are not supported".into()); - } Ok(ParsedCore { imports, exports, @@ -356,6 +380,7 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { data_ranges, has_start, elements, + imported_globals, }) } diff --git a/crates/psrs-linker/src/verify/tests.rs b/crates/psrs-linker/src/verify/tests.rs index c574648c..c556ac11 100644 --- a/crates/psrs-linker/src/verify/tests.rs +++ b/crates/psrs-linker/src/verify/tests.rs @@ -27,7 +27,10 @@ fn number_format_contract() -> ArtifactContract { imports: vec![DeclaredImport { module: psrs_runtime::MEMORY_MODULE.into(), field: psrs_runtime::MEMORY_FIELD.into(), - kind: ImportKind::Memory, + kind: ImportKind::Memory { + minimum: 3, + maximum: None, + }, }], exports: vec![ DeclaredExport { diff --git a/crates/psrs-linker/tests/compose.rs b/crates/psrs-linker/tests/compose.rs index c31aedd4..f6eab4e3 100644 --- a/crates/psrs-linker/tests/compose.rs +++ b/crates/psrs-linker/tests/compose.rs @@ -2,8 +2,8 @@ //! and no compiler IR participates. use psrs_linker::{ - ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, MemoryDemand, - Provider, RequirementId, TargetLinkInput, TargetPolicy, plan, resolve_default_definitions, + BindingRequirement, Boundary, CoreSignature, CoreType, MemoryDemand, Provider, RequirementId, + TargetLinkInput, TargetPolicy, plan, resolve_default_definitions, }; use wasm_encoder::{ CodeSection, EntityType, ExportKind, ExportSection, Function, FunctionSection, ImportSection, @@ -63,25 +63,20 @@ fn input() -> TargetLinkInput { parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], result: Some(CoreType::I32), }), - provider: Provider::ArtifactExport { - artifact: psrs_runtime::NUMBER_RUNTIME.id.into(), - export: psrs_runtime::NUMBER_EXPORT.into(), - signature: CoreSignature { - parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], - result: Some(CoreType::I32), - }, + provider: Provider::RuntimeOperation { + name: psrs_runtime::NUMBER_TO_STRING_OP.name.into(), + version: psrs_runtime::NUMBER_TO_STRING_OP.version.into(), }, }], - artifacts: vec![ArtifactReference { - contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_RUNTIME), - bytes: psrs_runtime::NUMBER_RUNTIME.bytes.to_vec(), - }], + units: vec![psrs_linker::runtime::offer(&psrs_runtime::NUMBER_UNIT)], policy: TargetPolicy::default(), memory: MemoryDemand { canonical_scratch: (0, 16), allocator_state: (16, 24), base_heap_start: 24, heap_alignment: 8, + growth_owner: psrs_linker::GENERATED_GROWTH_OWNER.into(), + maximum_pages: None, }, } } @@ -114,13 +109,15 @@ fn composition_without_the_artifact_fails_closed() { &context, TargetLinkInput { requirements: Vec::new(), - artifacts: Vec::new(), + units: Vec::new(), policy: TargetPolicy::default(), memory: MemoryDemand { canonical_scratch: (0, 16), allocator_state: (16, 24), base_heap_start: 24, heap_alignment: 8, + growth_owner: psrs_linker::GENERATED_GROWTH_OWNER.into(), + maximum_pages: None, }, }, ) @@ -167,7 +164,7 @@ fn composition_rejects_memory_and_signature_drift_from_the_plan() { fn a_host_resource_return_uses_the_executable_interface_closure() { let context = resolve_default_definitions().unwrap(); let mut input = input(); - input.artifacts.clear(); + input.units.clear(); input.requirements = vec![BindingRequirement { id: RequirementId(0), origin: "get-stdout".into(), diff --git a/crates/psrs-linker/tests/graph.rs b/crates/psrs-linker/tests/graph.rs new file mode 100644 index 00000000..c05c08b5 --- /dev/null +++ b/crates/psrs-linker/tests/graph.rs @@ -0,0 +1,355 @@ +//! Provider-graph closure. These tests build target records only. + +use psrs_linker::{ + ArtifactContract, ArtifactKind, ArtifactReference, BindingRequirement, Boundary, CoreSignature, + CoreType, DeclaredExport, ExportKind, InitializationContract, InitializationStep, MemoryDemand, + Provider, ProviderEdge, RequiredOperation, RequirementId, RuntimeUnitOffer, TargetLinkInput, + TargetPolicy, plan, resolve_default_definitions, +}; +use wasm_encoder::{ + CodeSection, ExportKind as EncodedExport, ExportSection, Function, FunctionSection, + Instruction, Module, TypeSection, ValType, +}; + +fn memory() -> MemoryDemand { + MemoryDemand { + canonical_scratch: (0, 16), + allocator_state: (16, 24), + base_heap_start: 24, + heap_alignment: 8, + growth_owner: psrs_linker::GENERATED_GROWTH_OWNER.into(), + maximum_pages: None, + } +} + +fn input(requirements: Vec, units: Vec) -> TargetLinkInput { + let permitted = resolve_default_definitions() + .map(|context| context.world_imports().to_vec()) + .unwrap_or_default(); + TargetLinkInput { + requirements, + units, + policy: TargetPolicy { + permitted_host_interfaces: permitted, + }, + memory: memory(), + } +} + +fn signature() -> CoreSignature { + CoreSignature { + parameters: Vec::new(), + result: Some(CoreType::I32), + } +} + +fn dependency_bytes() -> Vec { + let mut module = Module::new(); + let mut types = TypeSection::new(); + types.ty().function([], [ValType::I32]); + module.section(&types); + let mut functions = FunctionSection::new(); + functions.function(0); + module.section(&functions); + let mut exports = ExportSection::new(); + exports.export("dep", EncodedExport::Func, 0); + module.section(&exports); + let mut code = CodeSection::new(); + let mut body = Function::new([]); + body.instruction(&Instruction::I32Const(0)); + body.instruction(&Instruction::End); + code.function(&body); + module.section(&code); + module.finish() +} + +fn dependency_unit(id: &str, operation: &str) -> RuntimeUnitOffer { + let bytes = dependency_bytes(); + let digest = psrs_linker::sha256_hex(&bytes); + RuntimeUnitOffer { + id: id.into(), + semantic_contract_version: "1".into(), + provided: vec![psrs_linker::OfferedOperation { + name: operation.into(), + version: "1".into(), + export: "dep".into(), + signature: signature(), + }], + required: Vec::new(), + artifact: ArtifactReference { + contract: ArtifactContract { + id: format!("{id}-artifact"), + kind: ArtifactKind::CoreModule, + module_name: id.into(), + sha256: digest, + provenance: "test".into(), + required_features: Vec::new(), + imports: Vec::new(), + exports: vec![DeclaredExport { + name: "dep".into(), + kind: ExportKind::Func, + signature: Some(signature()), + }], + tables: Vec::new(), + elements: Vec::new(), + globals: Vec::new(), + storage: None, + initialization: InitializationContract { + start_forbidden: true, + data_range: (0, 0), + }, + instantiate_after_shims: false, + }, + bytes, + }, + state_owner: Some(id.into()), + grows_memory: false, + } +} + +fn number_unit() -> RuntimeUnitOffer { + psrs_linker::runtime::offer(&psrs_runtime::NUMBER_UNIT) +} + +fn formatter() -> BindingRequirement { + BindingRequirement { + id: RequirementId(0), + origin: "NumberToString".into(), + boundary: Boundary::RawCore { + module: psrs_runtime::MODULE_NAME.into(), + field: psrs_runtime::NUMBER_EXPORT.into(), + }, + expected: Some(CoreSignature { + parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], + result: Some(CoreType::I32), + }), + provider: Provider::RuntimeOperation { + name: psrs_runtime::NUMBER_TO_STRING_OP.name.into(), + version: psrs_runtime::NUMBER_TO_STRING_OP.version.into(), + }, + } +} + +fn require(unit: &mut RuntimeUnitOffer, operation: &str, expected: CoreSignature) { + unit.required.push(RequiredOperation { + name: operation.into(), + version: "1".into(), + signature: expected, + }); +} + +#[test] +fn a_required_operation_selects_its_provider_before_the_root_unit() { + let context = resolve_default_definitions().unwrap(); + let mut root = number_unit(); + require(&mut root, "psrs:dep/value", signature()); + let link = plan( + &context, + input( + vec![formatter()], + vec![root, dependency_unit("psrs:dep", "psrs:dep/value")], + ), + ) + .expect("the dependency should close"); + assert_eq!( + link.units() + .iter() + .map(|unit| unit.id.as_str()) + .collect::>(), + ["psrs:dep", "psrs:runtime/number"] + ); + assert!(link.edges().iter().any(|edge| matches!( + edge, + ProviderEdge::Dependency { unit, .. } if unit == "psrs:dep" + ))); + assert_eq!( + link.initialization(), + &[ + InitializationStep::Instantiate { + unit: "psrs:dep".into() + }, + InitializationStep::Instantiate { + unit: "psrs:runtime/number".into() + }, + InitializationStep::ResolveShims, + ] + ); + let report = link.report(); + assert_eq!(report.memory_id, psrs_linker::APPLICATION_MEMORY); + assert_eq!(report.growth_owner, psrs_linker::GENERATED_GROWTH_OWNER); + assert_eq!(report.digests.len(), 2); +} + +#[test] +fn an_unreached_unit_stays_out_of_the_plan() { + let context = resolve_default_definitions().unwrap(); + let link = plan( + &context, + input( + vec![formatter()], + vec![number_unit(), dependency_unit("psrs:dep", "psrs:dep/value")], + ), + ) + .unwrap(); + assert_eq!(link.units().len(), 1); + assert_eq!(link.artifacts().len(), 1); +} + +#[test] +fn a_missing_provider_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let error = plan(&context, input(vec![formatter()], Vec::new())) + .unwrap_err() + .to_string(); + assert!(error.contains("no runtime unit provides"), "{error}"); + assert!(!error.contains("digest"), "{error}"); +} + +#[test] +fn a_missing_dependency_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let mut root = number_unit(); + require(&mut root, "psrs:missing/op", signature()); + let error = plan(&context, input(vec![formatter()], vec![root])) + .unwrap_err() + .to_string(); + assert!( + error.contains("no runtime unit provides `psrs:missing/op@1`"), + "{error}" + ); +} + +#[test] +fn ambiguous_providers_are_not_resolved_by_trying_one() { + let context = resolve_default_definitions().unwrap(); + let mut first = dependency_unit("psrs:left", "psrs:dep/value"); + let mut second = dependency_unit("psrs:right", "psrs:dep/value"); + first.artifact.contract.module_name = "psrs:dep".into(); + second.artifact.contract.module_name = "psrs:dep".into(); + let requirement = BindingRequirement { + id: RequirementId(0), + origin: "dep".into(), + boundary: Boundary::RawCore { + module: "psrs:dep".into(), + field: "dep".into(), + }, + expected: Some(signature()), + provider: Provider::RuntimeOperation { + name: "psrs:dep/value".into(), + version: "1".into(), + }, + }; + let error = plan(&context, input(vec![requirement], vec![first, second])) + .unwrap_err() + .to_string(); + assert!(error.contains("ambiguous providers"), "{error}"); + assert!(!error.contains("digest"), "{error}"); +} + +#[test] +fn a_component_variant_is_not_substituted_for_a_raw_operation() { + let context = resolve_default_definitions().unwrap(); + let mut unit = number_unit(); + unit.artifact.contract.kind = ArtifactKind::Component; + let error = plan(&context, input(vec![formatter()], vec![unit])) + .unwrap_err() + .to_string(); + assert!(error.contains("incompatible artifact kind"), "{error}"); + assert!(!error.contains("digest"), "{error}"); +} + +#[test] +fn the_core_provider_remains_selected_beside_a_component_advertisement() { + let context = resolve_default_definitions().unwrap(); + let mut component = number_unit(); + component.id = "psrs:runtime/number-component".into(); + component.artifact.contract.id = "psrs:runtime-number-component".into(); + component.artifact.contract.kind = ArtifactKind::Component; + component.state_owner = Some("psrs:runtime/number-component".into()); + let link = plan( + &context, + input(vec![formatter()], vec![number_unit(), component]), + ) + .unwrap(); + assert_eq!(link.units().len(), 1); + assert_eq!(link.units()[0].kind, ArtifactKind::CoreModule); +} + +#[test] +fn a_provider_cycle_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let mut left = dependency_unit("psrs:left", "psrs:left/value"); + let mut right = dependency_unit("psrs:right", "psrs:right/value"); + require(&mut left, "psrs:right/value", signature()); + require(&mut right, "psrs:left/value", signature()); + let requirement = BindingRequirement { + id: RequirementId(0), + origin: "left".into(), + boundary: Boundary::RawCore { + module: "psrs:left".into(), + field: "dep".into(), + }, + expected: Some(signature()), + provider: Provider::RuntimeOperation { + name: "psrs:left/value".into(), + version: "1".into(), + }, + }; + let error = plan(&context, input(vec![requirement], vec![left, right])) + .unwrap_err() + .to_string(); + assert!(error.contains("unsupported provider cycle"), "{error}"); +} + +#[test] +fn duplicate_state_owners_are_rejected() { + let context = resolve_default_definitions().unwrap(); + let mut root = number_unit(); + require(&mut root, "psrs:dep/value", signature()); + let mut dependency = dependency_unit("psrs:dep", "psrs:dep/value"); + dependency.state_owner = root.state_owner.clone(); + let error = plan(&context, input(vec![formatter()], vec![root, dependency])) + .unwrap_err() + .to_string(); + assert!(error.contains("duplicate state owner"), "{error}"); +} + +#[test] +fn the_demand_may_name_a_runtime_unit_as_the_growth_owner() { + let context = resolve_default_definitions().unwrap(); + let allocator = psrs_linker::runtime::offer(&psrs_runtime::ALLOCATOR_UNIT); + let requirement = BindingRequirement { + id: RequirementId(0), + origin: "allocator".into(), + boundary: Boundary::RawCore { + module: psrs_runtime::ALLOCATOR_MODULE.into(), + field: psrs_runtime::REALLOC_EXPORT.into(), + }, + expected: Some(CoreSignature { + parameters: vec![CoreType::I32; 4], + result: Some(CoreType::I32), + }), + provider: Provider::RuntimeOperation { + name: psrs_runtime::ALLOCATOR_REALLOC_OP.name.into(), + version: psrs_runtime::ALLOCATOR_REALLOC_OP.version.into(), + }, + }; + let mut input = input(vec![requirement], vec![allocator]); + input.memory.growth_owner = psrs_runtime::ALLOCATOR_UNIT.id.into(); + let link = plan(&context, input).expect("the named unit should own growth"); + assert_eq!(link.growth_owner(), psrs_runtime::ALLOCATOR_UNIT.id); + assert!(link.memory().heap_getter.is_some()); +} + +#[test] +fn a_second_growth_owner_is_rejected() { + let context = resolve_default_definitions().unwrap(); + let mut root = number_unit(); + require(&mut root, "psrs:dep/value", signature()); + let mut dependency = dependency_unit("psrs:dep", "psrs:dep/value"); + dependency.grows_memory = true; + let error = plan(&context, input(vec![formatter()], vec![root, dependency])) + .unwrap_err() + .to_string(); + assert!(error.contains("conflicting growth owners"), "{error}"); +} diff --git a/crates/psrs-linker/tests/heap_getter.rs b/crates/psrs-linker/tests/heap_getter.rs new file mode 100644 index 00000000..25e4b6af --- /dev/null +++ b/crates/psrs-linker/tests/heap_getter.rs @@ -0,0 +1,168 @@ +//! Cross-module heap configuration and rejection of executable getter bodies. +use psrs_linker::{ + BindingRequirement, Boundary, CoreSignature, CoreType, MemoryDemand, Provider, RequirementId, + TargetLinkInput, TargetPolicy, plan, resolve_default_definitions, +}; + +fn input(heap_start: u32) -> TargetLinkInput { + TargetLinkInput { + requirements: vec![BindingRequirement { + id: RequirementId(0), + origin: "allocator".into(), + boundary: Boundary::RawCore { + module: psrs_runtime::ALLOCATOR_MODULE.into(), + field: psrs_runtime::REALLOC_EXPORT.into(), + }, + expected: Some(CoreSignature { + parameters: vec![CoreType::I32; 4], + result: Some(CoreType::I32), + }), + provider: Provider::RuntimeOperation { + name: psrs_runtime::ALLOCATOR_REALLOC_OP.name.into(), + version: psrs_runtime::ALLOCATOR_REALLOC_OP.version.into(), + }, + }], + units: vec![psrs_linker::runtime::offer(&psrs_runtime::ALLOCATOR_UNIT)], + policy: TargetPolicy::default(), + memory: MemoryDemand { + canonical_scratch: (0, 16384), + allocator_state: (16384, 16384), + base_heap_start: heap_start, + heap_alignment: 8, + growth_owner: psrs_runtime::ALLOCATOR_UNIT.id.into(), + maximum_pages: None, + }, + } +} + +fn application(pages: u64, getter: &str, getter_export: &str) -> Vec { + wat::parse_str(format!( + r#"(module + (import "psrs:allocator" "cabi_realloc" + (func $alloc (param i32 i32 i32 i32) (result i32))) + (memory (export "memory") {pages}) + (func (export "cabi_realloc") (param i32 i32 i32 i32) (result i32) + local.get 0 local.get 1 local.get 2 local.get 3 call $alloc) + (func (export "wasi:cli/run@0.2.12#run") (result i32) i32.const 0) + (func (export "{getter_export}") {getter}))"# + )) + .unwrap() +} + +#[test] +fn one_pinned_allocator_accepts_different_checked_heap_boundaries() { + let context = resolve_default_definitions().unwrap(); + for heap in [65536, 262144] { + let link = plan(&context, input(heap)).unwrap(); + assert_eq!(link.memory().heap_start, heap); + let core = application( + link.memory().minimum_pages, + &format!("(result i32) i32.const {heap}"), + psrs_runtime::HEAP_BOUNDARY_IMPORT, + ); + let component = psrs_linker::compose(&context, &link, &core).unwrap(); + assert!(component.external_world.is_empty()); + } +} + +#[test] +fn getter_must_be_a_local_constant_with_the_checked_signature_and_value() { + let context = resolve_default_definitions().unwrap(); + let link = plan(&context, input(65536)).unwrap(); + for getter in [ + "(result i32) i32.const 65544", + "(param i32) (result i32) i32.const 65536", + "(result i64) i64.const 65536", + "(result i32) (local i32) i32.const 65536", + "(result i32) memory.size drop i32.const 65536", + "(result i32) i32.const 1 i32.const 2 i32.store i32.const 65536", + "(result i32) i32.const 0 i32.const 0 i32.const 8 i32.const 8 call $alloc drop i32.const 65536", + ] { + let core = application( + link.memory().minimum_pages, + getter, + psrs_runtime::HEAP_BOUNDARY_IMPORT, + ); + let error = psrs_linker::compose(&context, &link, &core) + .unwrap_err() + .to_string(); + assert!(error.contains("heap getter"), "{getter}: {error}"); + } + let core = application( + link.memory().minimum_pages, + "(result i32) i32.const 65536", + "other", + ); + assert!(psrs_linker::compose(&context, &link, &core).is_err()); +} + +#[test] +fn allocator_import_signature_drift_is_rejected() { + let mut contract = psrs_linker::runtime::contract(&psrs_runtime::ALLOCATOR_RUNTIME); + let import = contract + .imports + .iter_mut() + .find(|import| matches!(import.kind, psrs_linker::ImportKind::Function(_))) + .unwrap(); + import.kind = psrs_linker::ImportKind::Function(CoreSignature { + parameters: vec![CoreType::I32], + result: Some(CoreType::I32), + }); + assert!( + psrs_linker::verify_artifact(&contract, psrs_runtime::ALLOCATOR_RUNTIME.bytes).is_err() + ); +} + +#[test] +fn allocator_executes_with_each_application_supplied_boundary() { + use std::process::Command; + if Command::new("wasmtime").arg("--version").output().is_err() { + assert_ne!(std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), Ok("1")); + eprintln!("skipping heap getter execution: wasmtime is not installed"); + return; + } + let context = resolve_default_definitions().unwrap(); + for heap in [65536, 262144] { + let link = plan(&context, input(heap)).unwrap(); + // Allocate beyond the initial page, verify bounds and scratch survival, + // resize with content preservation, then free through the same instance. + let run = format!( + r#" + (func (export "wasi:cli/run@0.2.12#run") (result i32) (local $p i32) + i32.const 32 i32.const 1234 i32.store + i32.const 0 i32.const 0 i32.const 8 i32.const 131072 call 0 local.set $p + local.get $p i32.const {heap} i32.lt_u if unreachable end + local.get $p i32.const 42 i32.store + i32.const 32 i32.load i32.const 1234 i32.ne if unreachable end + local.get $p i32.const 131072 i32.const 8 i32.const 262144 call 0 local.set $p + local.get $p i32.load i32.const 42 i32.ne if unreachable end + local.get $p i32.const 262144 i32.const 8 i32.const 0 call 0 drop + i32.const 0) + "# + ); + let core = wat::parse_str(format!( + r#"(module + (import "psrs:allocator" "cabi_realloc" (func (param i32 i32 i32 i32) (result i32))) + (memory (export "memory") {}) + (func (export "cabi_realloc") (param i32 i32 i32 i32) (result i32) + local.get 0 local.get 1 local.get 2 local.get 3 call 0) + (func (export "get_heap_base") (result i32) i32.const {heap}) + {run})"#, + link.memory().minimum_pages + )) + .unwrap(); + let component = psrs_linker::compose(&context, &link, &core).unwrap(); + let path = std::env::temp_dir().join(format!( + "psrs-heap-getter-{}-{heap}.wasm", + std::process::id() + )); + std::fs::write(&path, component.bytes).unwrap(); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + let _ = std::fs::remove_file(path); + assert!(output.status.success(), "heap {heap}: {output:?}"); + } +} diff --git a/crates/psrs-linker/tests/plan.rs b/crates/psrs-linker/tests/plan.rs index 78b067e3..cb531f12 100644 --- a/crates/psrs-linker/tests/plan.rs +++ b/crates/psrs-linker/tests/plan.rs @@ -1,9 +1,8 @@ //! Target-only linker tests: no compiler IR is constructed. use psrs_linker::{ - ArtifactContract, ArtifactReference, BindingRequirement, Boundary, CoreSignature, CoreType, - MemoryDemand, Provider, RequirementId, TargetLinkInput, TargetPolicy, plan, - resolve_default_definitions, + BindingRequirement, Boundary, CoreSignature, CoreType, MemoryDemand, Provider, RequirementId, + RuntimeUnitOffer, TargetLinkInput, TargetPolicy, plan, resolve_default_definitions, }; fn memory() -> MemoryDemand { @@ -12,19 +11,18 @@ fn memory() -> MemoryDemand { allocator_state: (16, 24), base_heap_start: 24, heap_alignment: 8, + growth_owner: psrs_linker::GENERATED_GROWTH_OWNER.into(), + maximum_pages: None, } } -fn input( - requirements: Vec, - artifacts: Vec, -) -> TargetLinkInput { +fn input(requirements: Vec, units: Vec) -> TargetLinkInput { let permitted = resolve_default_definitions() .map(|context| context.world_imports().to_vec()) .unwrap_or_default(); TargetLinkInput { requirements, - artifacts, + units, policy: TargetPolicy { permitted_host_interfaces: permitted, }, @@ -32,11 +30,8 @@ fn input( } } -fn formatter_artifact() -> ArtifactReference { - ArtifactReference { - contract: psrs_linker::runtime::contract(&psrs_runtime::NUMBER_RUNTIME), - bytes: psrs_runtime::NUMBER_RUNTIME.bytes.to_vec(), - } +fn number_unit() -> RuntimeUnitOffer { + psrs_linker::runtime::offer(&psrs_runtime::NUMBER_UNIT) } fn formatter_requirement() -> BindingRequirement { @@ -51,13 +46,9 @@ fn formatter_requirement() -> BindingRequirement { parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], result: Some(CoreType::I32), }), - provider: Provider::ArtifactExport { - artifact: psrs_runtime::NUMBER_RUNTIME.id.into(), - export: psrs_runtime::NUMBER_EXPORT.into(), - signature: CoreSignature { - parameters: vec![CoreType::F64, CoreType::I32, CoreType::I32], - result: Some(CoreType::I32), - }, + provider: Provider::RuntimeOperation { + name: psrs_runtime::NUMBER_TO_STRING_OP.name.into(), + version: psrs_runtime::NUMBER_TO_STRING_OP.version.into(), }, } } @@ -87,7 +78,7 @@ fn a_live_formatter_requirement_reserves_storage_and_closes_the_private_import() &context, input( vec![formatter_requirement(), stdout_requirement(1)], - vec![formatter_artifact()], + vec![number_unit()], ), ) .expect("the formatter plan should be valid"); @@ -159,7 +150,7 @@ fn a_world_interface_disabled_by_the_target_profile_is_rejected() { &context, TargetLinkInput { requirements: vec![stdout_requirement(0)], - artifacts: Vec::new(), + units: Vec::new(), policy: TargetPolicy { permitted_host_interfaces: vec!["wasi:io/streams@0.2.12".into()], }, @@ -199,13 +190,10 @@ fn a_different_world_version_does_not_satisfy_a_pinned_import() { #[test] fn a_reservation_overlapping_canonical_state_is_rejected() { let context = resolve_default_definitions().unwrap(); - let mut artifact = formatter_artifact(); - let storage = artifact.contract.storage.as_mut().unwrap(); + let mut unit = number_unit(); + let storage = unit.artifact.contract.storage.as_mut().unwrap(); storage.static_data.start = 16; - let result = plan( - &context, - input(vec![formatter_requirement()], vec![artifact]), - ); + let result = plan(&context, input(vec![formatter_requirement()], vec![unit])); assert!(result.is_err(), "overlapping reservations must be rejected"); } @@ -215,22 +203,15 @@ fn conflicting_providers_for_one_import_identity_are_rejected() { let mut other = formatter_requirement(); other.id = RequirementId(1); other.origin = "NumberToStringAgain".into(); - other.provider = Provider::ArtifactExport { - artifact: psrs_runtime::NUMBER_RUNTIME.id.into(), - export: psrs_runtime::NUMBER_EXPORT.into(), - signature: CoreSignature { - // A deliberately different signature for the same import identity. - parameters: vec![CoreType::F64, CoreType::I32], - result: Some(CoreType::I32), - }, - }; + other.expected = Some(CoreSignature { + // A deliberately different signature for the same import identity. + parameters: vec![CoreType::F64, CoreType::I32], + result: Some(CoreType::I32), + }); assert!( plan( &context, - input( - vec![formatter_requirement(), other], - vec![formatter_artifact()] - ) + input(vec![formatter_requirement(), other], vec![number_unit()]) ) .is_err(), "two signatures for one import identity must be rejected" @@ -241,13 +222,9 @@ fn conflicting_providers_for_one_import_identity_are_rejected() { /// mismatched contract must fail before any plan is published. #[test] fn a_definition_contract_does_not_satisfy_execution() { - let mut contract: ArtifactContract = - psrs_linker::runtime::contract(&psrs_runtime::NUMBER_RUNTIME); - contract.exports.clear(); - let artifact = ArtifactReference { - contract, - bytes: psrs_runtime::NUMBER_RUNTIME.bytes.to_vec(), - }; + let mut unit = number_unit(); + unit.artifact.contract.exports.clear(); + let artifact = unit; let context = resolve_default_definitions().unwrap(); assert!( plan( @@ -292,15 +269,14 @@ fn impossible_memory_demands_are_rejected_before_arithmetic() { input.memory.heap_alignment = alignment; assert!(plan(&context, input).is_err()); } - let mut artifact = formatter_artifact(); - artifact.contract.storage.as_mut().unwrap().minimum_pages = u64::MAX; - assert!( - plan( - &context, - input(vec![formatter_requirement()], vec![artifact]) - ) - .is_err() - ); + let mut unit = number_unit(); + unit.artifact + .contract + .storage + .as_mut() + .unwrap() + .minimum_pages = u64::MAX; + assert!(plan(&context, input(vec![formatter_requirement()], vec![unit])).is_err()); } #[test] diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml index 063b0da0..07580ac4 100644 --- a/crates/psrs-runtime/Cargo.toml +++ b/crates/psrs-runtime/Cargo.toml @@ -12,13 +12,17 @@ default = ["catalog", "formatter"] # Immutable host-consumed catalog data: WIT sources, world identity, artifact # bytes and provenance. Compiles no executable target code. catalog = [] -# The executable numeric exports. The Wasm artifact build enables only this -# feature; the default native build enables both. +# The executable number module: formatting, parsing, and scalar math. +# The feature name is retained for existing artifact build commands. formatter = ["dep:ryu-js", "dep:libm"] +# The executable canonical realloc provider. The Wasm artifact build enables +# only this feature, separate from the numeric runtime. +allocator = ["dep:dlmalloc"] [dependencies] ryu-js = { version = "=1.0.2", default-features = false, optional = true } libm = { version = "=0.2.15", default-features = false, optional = true } +dlmalloc = { version = "=0.2.14", default-features = false, optional = true } [dev-dependencies] wasm-encoder = { workspace = true, features = ["wasmparser"] } diff --git a/crates/psrs-runtime/artifact/psrs_allocator.wasm b/crates/psrs-runtime/artifact/psrs_allocator.wasm new file mode 100644 index 0000000000000000000000000000000000000000..7a4ea802aa79bf5484b061ceef1a52d56e674133 GIT binary patch literal 8062 zcmeI1PmCqkRmSVyTUD>x)y%{d4Yj&OPTl=iV-M4sW@lDBL3}PZaL>iSn2~#S@O7U~gWZ)=DoQ z{I3okj{p1xA9kNUs&DPyx_$7RFWi|cS8na>J$>cY?dv~%bN9-XwHv#$D^Kn2Jagsh z&f#uRgztICIp>25{3%0K*P*QIdK9Xnu8UBXO~b#YshcJQUsmoJhSv>irIQoijykt` zZRhIVm4n@#n>TM?E574_zr6U+zcA$Z9Vh%LQaA0(cji|&uKbqYiheJ-N7stz(_1Eq z$8^81W0>@#SZ}YnSf*wYT^!M0>gV!$-*hjSFeJos!#Bz8e+U7*uJ%6GlYS-o?X?2g zD>S?4HM{#c%~|zrD#leRHvC_F{DqTZOmFHYvDqwyV098l`He+Gek&(&#onUhA%vTG z?y76sSkUQ99@VA?0#Z$&3{Y3x3uhPDkw(SE_X@|Zp*+zoxO5gYzq7?%cs=9fZWB@m== zH0$eq6H&$bV3QuLou1vFq))p^AI6oi4NZMeBc=}NB{vbA&_)cu=^M1+u^LNhuLt-W zO>~>A%o9`H4eg(KKRR~L3)(B-iA6eLm1+Z|aX?xALYH#{_ zt6xLJoK>-+w1*G?jARBC7tWOprK5ZHGTJz zO?+SyAINj3>8B>$FQ}2h>)MCvyV13cjb56IXxqg0B1mnUKIwR(-ivyo?unkwrvHQs zD3r=!wFZd4DWMYBuy~X3rxCu;dfYRXm(ZHWbWlhJFr3{TgOW}13B9-N%(>%;Ck#r5 zLFq8G>elYwFGHkME>sd4O_@QiZW>n8`_IQ1AsgT z5whRCb`CZ37`7pr(ge_^KdZIvt;76lPFRiKSc<)(P5yWe;mBi2@vVXG^00HLX4n=T zXXhPrJK|)|$4W-L6WYJ=gjsZiR;H=B7a^qVOWapZlst)!{WKd!KasteQ+B^$Hbgry zzWmMnC+sIaXw5t<>3FFTi($~rU(!so5~4JV#k>}SJw(@+@JoBW$E)%jO5)Z1FjK1o zr1#yI@`leLELLTurFAX1QPLPKgD{3N$AYmW%BYJunX;I@(27`BLLpFi-V5zqz&)BY zimohx7n#y9wV%tT9dZG1hqsC`<-nmOi34XJjE^(oP(h4|$*N&Y#TXgGO{R+=Cup;k zuyMwDY0Y6tFH2U59k38kZzZ!;+2G{QFoA|?9hS`Q1-4V(57|ocJof%RGf^Jlqu2|V z%x21@%BUq<u|n3`x!;F)#z%thI-J7HfigOC9|Jhg<~ zw{T2J^*P6hGfex6b@{0uwN+?3#%%TKd&kYNGm5B>A5H; zPwOU_z~TKaanfN$6+qtn+m!qB0P)it-R1Rk96iT_uZ90!^7)MFRq6R!$Xq)dJjDG& ztv#8hADg6)?5CfF)zcQuTiffRLuS2_k8(rZUSd!hu{D`%I!|5`Ds^l~pXwZR=5!@( zWPJ!Z25~u4<|iwazgFR`={Ve`Z&*0|Q4W&1?b+&FTRRMUzjYwSMxA#01rF8`Ab!j` z!K^djq$2wt%mcCq3FKQiI%cXy{Jithqh@}KIpU%WNLxx^9lE+B=$Vg(BR!6_F z(~5UsbzTtgD^drP@(T<>pB;ZG@ihLM0sc!ZM?`4ksQ08l=mhI!_1S{sLme5YChEjF zpd=9FQc`qqsorepRVA~Nxn|V~CHrATX;%;Raa5gU91SizuUbt6q`UHc&|%E`(f?{j zk235~#+2M?3d4D3`%h(Pm7GS<9BO(gvhM!MB8G zsMPRS3pcyZpkk59Byq@;!giWU5qDRl#GX(Ko#sxtim7Qklq*Q_jt$3n^E5ioKQC9V zS-Q6J??jsu#;a`8A-+go51dTqt~%8YzQz^HWZ|;uf-bbG>3;X?nhI(w3#kn78ID?% zEw=A}j705N!--_m^QHWVw67qIx9Tzx^_3vCm;Y+SD^_e-#B-lg!eEpHInGtMlg#l0 z!aOKeH~gzX2bG{f+iPL9;z*+t-%4^vain7dZ~4S)vb*0C>@~Xz8fII`QEvn2Rf%cr z%*?VJVhgU_@HwaVrmtAFWK}*^l`m}pMKcS?xoRD$D|J)u>7oIpYi>eZ_bDw(=_Yhm zjx72Ol=OfAo8huX^&vBbCr2Kj;;8$13CRtkO>dVqT+Y1c^4JqSkppv;@Of#B#m>rr z*q$@FB8i$(amD=}NYfn}>{S<%OgquJ-qw!I+y@q0e|ni@b|)+-)GW`Tlgi2Add4(T z-w+BcKtf$nHEV|tdgjH`X()J(y4e|HX#dGujc4Q;q=LuG20RpRNV1!;W%^v?7=()t zJFZk!lv>cz;xnV_2|-p9ZbkDQWiIVQF30j&pXn3{RC970KUT6p!yvzR`2AhmOF~;! zlP(x>0D2hWr&?EsE>9eD{RQrUgXyok-_}g=*6^0!KRMr41d{VLQm%s#b}b+GbA?9D zV0XgaDmkpsDMd1He%{igYLE>YqLhL!FRJMCoh_yN31ho4^-kHo=Ez(h#5om*mThHm zejrN)K+R3s&s?_4joj+r*idu0!a5AoEw^9#8i~Pm<1NXUq9f}FGMZtkqpczx6I_e+ z{0F&ApIz2T0`29ZHAj+>-Q3Ox;d`Pt)jT+yA`E&d+AmdhbwrPw^&#xGME`OHrB|&TOX_X7-Ln0 zGm(+N^0b}a;v?7hEb8EdqEPM|LR-H95b_7%f{3u;cL=3b6uH(CNP<8sr~DfQyQ7kv zjPyQ;Z;A~z*7cSxqdfF6bA6b(6Il{0+#}`M(Uy!>bCCa(0|`(|0hGEi{M!S-m7=Fs zV+XRvveiQ}Bod|MW&X-DiThr;1GRpY3A2Rmn6lAh<*Ob$)KZbYfEcJ0}|%_a`4 zsb(mK;3V;AVEgU4`;D`-9Gcj2>Dh_><^>Dmeact|$uCyHSh>~2y)|E_($e)#uB*L* z1D#1i<>A@1xie3mwD01!k1+K(B~#c7if2Y>PbGb_JtnYy`>i-@daGjLXv+U@zqH<- zK?HXlJw36Q9<<-aLuQzvAhh*|a-O1n6kMkv9_HynChD|?)vL+i@EIfA1Yr!VZQx$cj4O3!HwG&4t8(s9nKD(yKs1L?ZV#E z*LR;if9+srwtIMf@Akv*dEa~AckRg^xVCxqk*kk9a`DLv*KgjkUk^U~z30F0{CnPO zljd#b4-Si+!^7Q!+1~A^fgg_cd??=HcbK=2b`SW~<@KUK z;h!vu;vdVRSmF7fP5+_O={wIZO`p&IXXdXlfByYgRTOWNyxDB`)-$s>yB)9Z9qnD; ijaQ$GAKg8;jS*h(?OzAY`Tsxv*Dc_R*U#Lq!+!uKJL(Sr literal 0 HcmV?d00001 diff --git a/crates/psrs-runtime/artifact/psrs_runtime.wasm b/crates/psrs-runtime/artifact/psrs_runtime.wasm index 2a08c5558f3893fca29206279e469af92b703be1..168cab9e5684bac895ad54184ed434b82cb7759c 100755 GIT binary patch delta 648 zcmYk3T}YEr7{}k|J@5PauFcvS5*5;!MoYI^(g)SB?TlS?GmxNW3C;~GTv=q(E+Tm^ zioPHxhh*5zSV_`FAD)5 zP>EJiEuEpnMQ#cE;d=m6BIAu=;%f7LJlxy-9$=iCd`BR~k0NJ~wfvE9D^^p!5ajuK z|885lpwubM+~-hbKLrnDc*q|{j`#z3RMFoD?|6iLgbA@XV3%#PdBy6H%v7ZiXNJbU z^KkG4PCgA@(YKZJ74J0GAIID2tKO}wkV_Q<%RCr54rM+ZYJg=v9dg68SPYHGvQZGJ zmSupX7&_LaLT;>e9c)g%R;iwG=oVtef6xN>-p7n2Sc%u4`~gY6@zfHG@~XBzw5-3) zLCnK%03>D@iaE)jv^z;O*2O=xm#Q!HcE?Wlc+Onx>5e8uE>aJwjw^SH-yI8$upqwP zy-J#zP>G=5tr$*>wf+v)_W$}Ztm)rg3=Y`AwzljSN;MVvRq~noPreMRy9Y(@&}73O DdUMH~ delta 641 zcmYk3O=uHA6vy}N>~1$EYGNp&Qk=BKm=BF&6*1IgLJnRQilC_$8dIv$sE9ShgS6zJ z5*2K5u+(}9(IR-z*vUbm(uzIgpr9yPA(d2fu!s^NmRzJhQz{O;-+S*rAI$t`GDY$! zl5-KLa5s4j!=gwAWYfYWg_SU7d5_jg+E_tc)%sv#?y};SBnnK9Q$iJ1mQJ5yknl-4 zZqXx<La-z-S1$ZrD-t1~?X-=UM zZJ=5vONoc1gni!)fF~mB@4>{?_T6~6zx@?Jo|^*uf%5~%m&hi5FR%%#>3{)6z9zWc zHdj_Mv&vd5FYh4n1mS~Wp5!bc7^P+?cKa$^+{%`Qi!vZ#>zYr zK8%wO!x!|;)%m)28XJt`?et~umX^r5x`9<5HV#3Rj~Oob#b*pJOp2ezxGdMch|!MU z0BJFDuup};MCU5lkbbUGJ?qdd#Ek!-h48)i8A-4TZ#nV<(tO>~Dr9&=R}w87>~awE z%@+U?OQjTZnm_1v^7q|~rW0rT&%_dmTC5lFO uVmL8Y`fFI*|LZ5Prhj{Jd&my9m1T=4HP+>4!;jQ|@_AU^ofZQlQ?5UWSH$`N diff --git a/crates/psrs-runtime/src/abi/allocator.rs b/crates/psrs-runtime/src/abi/allocator.rs new file mode 100644 index 00000000..869489fd --- /dev/null +++ b/crates/psrs-runtime/src/abi/allocator.rs @@ -0,0 +1,27 @@ +//! Canonical allocator bindings, raw signature, and private storage. + +use super::{RawCallProtocol, RawFunctionAbi, RawType}; + +/// Private core-module import identity of the canonical allocator. +pub const ALLOCATOR_MODULE: &str = "psrs:allocator"; +/// Exported canonical realloc function. +pub const REALLOC_EXPORT: &str = "cabi_realloc"; +/// Heap-boundary getter imported from the application. +pub const HEAP_BOUNDARY_IMPORT: &str = "get_heap_base"; +/// First byte of the allocator artifact's static data. +pub const ALLOCATOR_STATIC_START: u32 = 32768; +/// Lowest permitted allocator stack address; checked frames stay above scratch. +pub const ALLOCATOR_STACK_BOTTOM: u32 = 16384; +/// Initial stack pointer and end of the allocator stack reservation. +pub const ALLOCATOR_STACK_TOP: u32 = 32768; +/// Exclusive end of the allocator static data reservation. +pub const ALLOCATOR_STATIC_END: u32 = 65536; +/// Contract heap boundary when no later reservation extends it. +pub const ALLOCATOR_HEAP_START: u32 = 65536; + +pub const ALLOCATOR_REALLOC: RawFunctionAbi = RawFunctionAbi { + export: REALLOC_EXPORT, + parameters: &[RawType::I32, RawType::I32, RawType::I32, RawType::I32], + result: Some(RawType::I32), + protocol: RawCallProtocol::Scalars, +}; diff --git a/crates/psrs-runtime/src/abi/mod.rs b/crates/psrs-runtime/src/abi/mod.rs new file mode 100644 index 00000000..d8b141fe --- /dev/null +++ b/crates/psrs-runtime/src/abi/mod.rs @@ -0,0 +1,43 @@ +//! Raw ABI contracts shared by target implementations and the host catalog. +//! This module contains data only and embeds no artifact or WIT bytes. + +mod allocator; +mod number; + +pub use allocator::*; +pub use number::*; + +/// The runtime imports the application's canonical memory. +pub const MEMORY_MODULE: &str = "env"; +/// The runtime's memory import field. +pub const MEMORY_FIELD: &str = "memory"; +/// Core import namespace used by composition for application exports. +pub const APPLICATION_MODULE: &str = "__main_module__"; + +/// Raw scalar types in the runtime's core-Wasm function ABI. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum RawType { + I32, + I64, + F32, + F64, +} + +/// Language-value transport and normal-return ownership for a raw export. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum RawCallProtocol { + /// Scalar arguments/results only; Unit results use a void export. + Scalars, + /// Borrowed canonical UTF-8 bytes; caller copies, then releases on return. + Utf8Input, + /// Caller-owned bounded UTF-8 output; caller recovers and releases on return. + Utf8Output { capacity: usize }, +} + +/// An artifact export's raw signature and language-value transport protocol. +pub struct RawFunctionAbi { + pub export: &'static str, + pub parameters: &'static [RawType], + pub result: Option, + pub protocol: RawCallProtocol, +} diff --git a/crates/psrs-runtime/src/abi/number.rs b/crates/psrs-runtime/src/abi/number.rs new file mode 100644 index 00000000..264af8b3 --- /dev/null +++ b/crates/psrs-runtime/src/abi/number.rs @@ -0,0 +1,189 @@ +//! Numeric export identities, transport contracts, and private storage. + +use super::{RawCallProtocol, RawFunctionAbi, RawType}; + +/// Maximum capacity required by an ECMAScript binary64 token. +pub const NUMBER_CAPACITY: usize = 32; +/// Private core-module import identity used by the compiler. +pub const MODULE_NAME: &str = "psrs:runtime"; +/// Exported raw formatting function. +pub const NUMBER_EXPORT: &str = "number_to_string"; +/// Exported raw complete-decimal conversion function. +pub const DECIMAL_EXPORT: &str = "number_from_decimal"; +/// Exported raw inverse-cosine function. +pub const ACOS_EXPORT: &str = "number_acos"; +/// Exported raw inverse-sine function. +pub const ASIN_EXPORT: &str = "number_asin"; +/// Exported raw inverse-tangent function. +pub const ATAN_EXPORT: &str = "number_atan"; +/// Exported raw four-quadrant inverse-tangent function. +pub const ATAN2_EXPORT: &str = "number_atan2"; +/// Exported raw sine function. +pub const SIN_EXPORT: &str = "number_sin"; +/// Exported raw cosine function. +pub const COS_EXPORT: &str = "number_cos"; +/// Exported raw tangent function. +pub const TAN_EXPORT: &str = "number_tan"; +/// Exported raw base-e exponential function. +pub const EXP_EXPORT: &str = "number_exp"; +/// Exported raw natural-logarithm function. +pub const LOG_EXPORT: &str = "number_log"; +/// Exported raw exponentiation function. +pub const POW_EXPORT: &str = "number_pow"; +/// Exported raw minimum function. +pub const MIN_EXPORT: &str = "number_min"; +/// Exported raw maximum function. +pub const MAX_EXPORT: &str = "number_max"; +/// Exported raw sign function. +pub const SIGN_EXPORT: &str = "number_sign"; +/// Exported raw JavaScript remainder function. +pub const REMAINDER_EXPORT: &str = "number_remainder"; +/// Exported raw NaN predicate. The result is an `i32` 0 or 1. +pub const IS_NAN_EXPORT: &str = "number_is_nan"; +/// Exported raw canonical NaN. +pub const NAN_EXPORT: &str = "number_nan"; +/// Exported raw positive infinity. +pub const INFINITY_EXPORT: &str = "number_infinity"; +/// Lower addresses remain owned by the application's canonical ABI. +pub const RESERVED_START: u32 = 65536; +/// Static data must end before the separately reserved 64 KiB stack. +pub const STACK_BOTTOM: u32 = 131072; +/// The caller's allocator begins after the private stack. +pub const HEAP_START: u32 = 196608; +/// The runtime exports its heap boundary for the preparer to relocate. +pub const HEAP_BASE_EXPORT: &str = "__heap_base"; + +pub const NUMBER_FORMAT: RawFunctionAbi = RawFunctionAbi { + export: NUMBER_EXPORT, + parameters: &[RawType::F64, RawType::I32, RawType::I32], + result: Some(RawType::I32), + protocol: RawCallProtocol::Utf8Output { + capacity: NUMBER_CAPACITY, + }, +}; + +pub const NUMBER_PARSE: RawFunctionAbi = RawFunctionAbi { + export: DECIMAL_EXPORT, + parameters: &[RawType::I32, RawType::I32], + result: Some(RawType::F64), + protocol: RawCallProtocol::Utf8Input, +}; + +pub const NUMBER_ACOS: RawFunctionAbi = RawFunctionAbi { + export: ACOS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_ASIN: RawFunctionAbi = RawFunctionAbi { + export: ASIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_ATAN: RawFunctionAbi = RawFunctionAbi { + export: ATAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_ATAN2: RawFunctionAbi = RawFunctionAbi { + export: ATAN2_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_SIN: RawFunctionAbi = RawFunctionAbi { + export: SIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_COS: RawFunctionAbi = RawFunctionAbi { + export: COS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_TAN: RawFunctionAbi = RawFunctionAbi { + export: TAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_EXP: RawFunctionAbi = RawFunctionAbi { + export: EXP_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_LOG: RawFunctionAbi = RawFunctionAbi { + export: LOG_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_POW: RawFunctionAbi = RawFunctionAbi { + export: POW_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_MIN: RawFunctionAbi = RawFunctionAbi { + export: MIN_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_MAX: RawFunctionAbi = RawFunctionAbi { + export: MAX_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_SIGN: RawFunctionAbi = RawFunctionAbi { + export: SIGN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_REMAINDER: RawFunctionAbi = RawFunctionAbi { + export: REMAINDER_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_IS_NAN: RawFunctionAbi = RawFunctionAbi { + export: IS_NAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::I32), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_NAN: RawFunctionAbi = RawFunctionAbi { + export: NAN_EXPORT, + parameters: &[], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; + +pub const NUMBER_INFINITY: RawFunctionAbi = RawFunctionAbi { + export: INFINITY_EXPORT, + parameters: &[], + result: Some(RawType::F64), + protocol: RawCallProtocol::Scalars, +}; diff --git a/crates/psrs-runtime/src/allocator/algorithm.rs b/crates/psrs-runtime/src/allocator/algorithm.rs new file mode 100644 index 00000000..75a2208e --- /dev/null +++ b/crates/psrs-runtime/src/allocator/algorithm.rs @@ -0,0 +1,242 @@ +//! Canonical `cabi_realloc` steps over a caller-supplied backing store. +//! +//! Live records sit in a prefix of each backing allocation. Lookup walks those +//! trusted records. It does not form a header address from the caller's pointer. + +const RECORD: u32 = 20; + +pub trait Store { + fn allocate(&mut self, size: u32, align: u32) -> Option; + fn release(&mut self, pointer: u32, size: u32, align: u32); + fn read(&self, address: u32) -> u32; + fn write(&mut self, address: u32, value: u32); + fn copy(&mut self, from: u32, to: u32, len: u32); +} + +#[derive(Clone, Copy)] +struct Live { + backing: u32, + next: u32, + user: u32, + requested: u32, + size: u32, + align: u32, +} + +/// Runs one canonical call. `Err` is a trap. `Ok` is the returned pointer. +pub fn realloc( + store: &mut impl Store, + head: &mut u32, + old_ptr: i32, + old_len: i32, + align: i32, + new_len: i32, +) -> Result { + let align = canonical_align(align)?; + let new_len = canonical_len(new_len)?; + if new_len == 0 { + if old_ptr != 0 { + let live = find(store, *head, old_ptr)?; + if live.requested != canonical_len(old_len)? { + return Err(()); + } + unlink(store, head, live.backing); + store.release(live.backing, live.size, live.align); + } + return Ok(0); + } + if old_ptr == 0 { + if old_len != 0 { + return Err(()); + } + return Ok(insert(store, head, align, new_len)? as i32); + } + let old_len = canonical_len(old_len)?; + let live = find(store, *head, old_ptr)?; + if live.requested != old_len { + return Err(()); + } + let user = insert(store, head, align, new_len)?; + store.copy(live.user, user, old_len.min(new_len)); + unlink(store, head, live.backing); + store.release(live.backing, live.size, live.align); + Ok(user as i32) +} + +fn insert(store: &mut impl Store, head: &mut u32, align: u32, len: u32) -> Result { + let backing_align = align.max(4); + let user_offset = provision::align_u32(RECORD, align)?; + let size = user_offset.checked_add(len).ok_or(())?; + let backing = store.allocate(size, backing_align).ok_or(())?; + let user = backing.checked_add(user_offset).ok_or(())?; + if user == 0 { + store.release(backing, size, backing_align); + return Err(()); + } + store.write(backing, *head); + store.write(backing + 4, user); + store.write(backing + 8, len); + store.write(backing + 12, size); + store.write(backing + 16, backing_align); + *head = backing; + Ok(user) +} + +fn find(store: &impl Store, head: u32, old_ptr: i32) -> Result { + if old_ptr <= 0 { + return Err(()); + } + let wanted = old_ptr as u32; + let mut backing = head; + while backing != 0 { + let live = read_live(store, backing)?; + if live.user == wanted { + return Ok(live); + } + backing = live.next; + } + Err(()) +} + +fn read_live(store: &impl Store, backing: u32) -> Result { + Ok(Live { + backing, + next: store.read(backing), + user: store.read(backing + 4), + requested: store.read(backing + 8), + size: store.read(backing + 12), + align: store.read(backing + 16), + }) +} + +fn unlink(store: &mut impl Store, head: &mut u32, backing: u32) { + if *head == backing { + *head = store.read(backing); + return; + } + let mut previous = *head; + while previous != 0 { + let next = store.read(previous); + if next == backing { + store.write(previous, store.read(backing)); + return; + } + previous = next; + } +} + +fn canonical_align(align: i32) -> Result { + if align <= 0 { + return Err(()); + } + let align = align as u32; + if align.is_power_of_two() { + Ok(align) + } else { + Err(()) + } +} + +fn canonical_len(len: i32) -> Result { + u32::try_from(len).map_err(|_| ()) +} + +pub mod provision { + pub fn align_u32(value: u32, align: u32) -> Result { + if align == 0 || !align.is_power_of_two() { + return Err(()); + } + let padded = value.checked_add(align - 1).ok_or(())?; + Ok(padded & !(align - 1)) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + struct Heap { + bytes: Vec, + cursor: u32, + fail_after: u32, + allocs: u32, + } + + impl Heap { + fn new() -> Self { + Self { + bytes: vec![0; 64], + cursor: 64, + fail_after: u32::MAX, + allocs: 0, + } + } + } + + impl Store for Heap { + fn allocate(&mut self, size: u32, align: u32) -> Option { + self.allocs += 1; + if self.allocs > self.fail_after { + return None; + } + let start = provision::align_u32(self.cursor, align).ok()?; + let end = start.checked_add(size)?; + self.bytes.resize(end as usize, 0); + self.cursor = end; + Some(start) + } + + fn release(&mut self, _: u32, _: u32, _: u32) {} + + fn read(&self, address: u32) -> u32 { + let offset = address as usize; + u32::from_le_bytes(self.bytes[offset..offset + 4].try_into().unwrap()) + } + + fn write(&mut self, address: u32, value: u32) { + let offset = address as usize; + self.bytes[offset..offset + 4].copy_from_slice(&value.to_le_bytes()); + } + + fn copy(&mut self, from: u32, to: u32, len: u32) { + for index in 0..len { + let byte = self.bytes[(from + index) as usize]; + self.bytes[(to + index) as usize] = byte; + } + } + } + + #[test] + fn alignment_resize_copy_and_rejection_share_one_registry() { + let mut heap = Heap::new(); + let mut head = 0; + let first = realloc(&mut heap, &mut head, 0, 0, 8, 4).unwrap(); + heap.write(first as u32, u32::from_le_bytes(*b"abcd")); + assert_eq!(first & 7, 0); + let resized = realloc(&mut heap, &mut head, first, 4, 32, 4).unwrap(); + assert_eq!(resized & 31, 0); + assert_eq!(&heap.bytes[resized as usize..resized as usize + 4], b"abcd"); + assert!(realloc(&mut heap, &mut head, 0, 0, 3, 4).is_err()); + assert!(realloc(&mut heap, &mut head, 0, 1, 8, 4).is_err()); + assert!(realloc(&mut heap, &mut head, 32, 4, 8, 4).is_err()); + assert!(realloc(&mut heap, &mut head, resized, 3, 8, 4).is_err()); + assert_eq!(realloc(&mut heap, &mut head, resized, 4, 8, 0).unwrap(), 0); + let again = realloc(&mut heap, &mut head, 0, 0, 8, 4).unwrap(); + assert_ne!(again, 0); + } + + #[test] + fn a_failed_replacement_keeps_the_old_allocation() { + let mut heap = Heap::new(); + heap.fail_after = 1; + let mut head = 0; + let first = realloc(&mut heap, &mut head, 0, 0, 8, 4).unwrap(); + heap.bytes[first as usize] = 9; + assert!(realloc(&mut heap, &mut head, first, 4, 8, 8).is_err()); + assert_eq!(heap.bytes[first as usize], 9); + assert_eq!( + head, + first as u32 - provision::align_u32(RECORD, 8).unwrap() + ); + } +} diff --git a/crates/psrs-runtime/src/allocator/mod.rs b/crates/psrs-runtime/src/allocator/mod.rs new file mode 100644 index 00000000..0bba987d --- /dev/null +++ b/crates/psrs-runtime/src/allocator/mod.rs @@ -0,0 +1,8 @@ +//! Canonical allocation: portable validation and bookkeeping, plus a Wasm adapter. + +mod algorithm; +mod phase; +mod provision; + +#[cfg(target_arch = "wasm32")] +mod wasm; diff --git a/crates/psrs-runtime/src/allocator/phase.rs b/crates/psrs-runtime/src/allocator/phase.rs new file mode 100644 index 00000000..47467375 --- /dev/null +++ b/crates/psrs-runtime/src/allocator/phase.rs @@ -0,0 +1,40 @@ +//! Lazy provider phases. Reentry while initializing or dispatching traps. + +pub const UNINITIALIZED: u8 = 0; +pub const BUSY: u8 = 1; +pub const READY: u8 = 2; + +/// Moves `Uninitialized` to `Busy`. A second entry while busy is reentry. +pub fn enter(phase: &mut u8) -> Result { + match *phase { + UNINITIALIZED => { + *phase = BUSY; + Ok(true) + } + READY => { + *phase = BUSY; + Ok(false) + } + _ => Err(()), + } +} + +pub fn ready(phase: &mut u8) { + *phase = READY; +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn the_first_call_initializes_and_reentry_traps() { + let mut phase = UNINITIALIZED; + assert_eq!(enter(&mut phase), Ok(true)); + assert_eq!(enter(&mut phase), Err(())); + ready(&mut phase); + assert_eq!(enter(&mut phase), Ok(false)); + ready(&mut phase); + assert_eq!(phase, READY); + } +} diff --git a/crates/psrs-runtime/src/allocator/provision.rs b/crates/psrs-runtime/src/allocator/provision.rs new file mode 100644 index 00000000..9f8df9e2 --- /dev/null +++ b/crates/psrs-runtime/src/allocator/provision.rs @@ -0,0 +1,60 @@ +//! Checked acquisition of fresh segments up to `memory.size`, then `memory.grow`. +//! +//! The cursor advances only after a segment is published. A failed grow leaves +//! the cursor where it was. Returned pages are never shrunk. + +pub const PAGE: usize = 65536; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct Segment { + pub start: usize, + pub bytes: usize, + pub end: usize, + pub pages: usize, +} + +/// Plans a page-aligned segment at or above `cursor`. +/// +/// `pages` is zero when the current memory already covers the segment. +pub fn plan(cursor: usize, request: usize, mem_size: usize) -> Result { + if request == 0 || !PAGE.is_power_of_two() { + return Err(()); + } + let start = align_up(cursor, PAGE)?; + let bytes = align_up(request, PAGE)?; + let end = start.checked_add(bytes).ok_or(())?; + let pages = if end > mem_size { + end.checked_sub(mem_size).ok_or(())?.div_ceil(PAGE) + } else { + 0 + }; + Ok(Segment { + start, + bytes, + end, + pages, + }) +} + +pub fn align_up(value: usize, align: usize) -> Result { + if align == 0 || !align.is_power_of_two() { + return Err(()); + } + let padded = value.checked_add(align - 1).ok_or(())?; + Ok(padded & !(align - 1)) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn an_in_range_segment_does_not_grow_or_move_the_failed_cursor() { + let segment = plan(196_608, 100, 262_144).unwrap(); + assert_eq!(segment.pages, 0); + assert_eq!(segment.start, 196_608); + assert_eq!(segment.bytes, PAGE); + assert!(plan(196_608, PAGE, 196_608).unwrap().pages >= 1); + assert!(plan(usize::MAX - 8, PAGE, usize::MAX).is_err()); + } +} diff --git a/crates/psrs-runtime/src/allocator/wasm.rs b/crates/psrs-runtime/src/allocator/wasm.rs new file mode 100644 index 00000000..32506ecd --- /dev/null +++ b/crates/psrs-runtime/src/allocator/wasm.rs @@ -0,0 +1,162 @@ +//! Canonical realloc adapter over one `dlmalloc` 0.2.14 instance. +//! +//! The instance is created on the first call, after the heap-boundary import +//! can be read. No start function allocates. Reentry while the instance is +//! borrowed traps. + +use super::{algorithm, phase, provision}; + +use core::cell::Cell; +use dlmalloc::{Allocator, Dlmalloc}; + +const PAGE: usize = provision::PAGE; + +struct Provision { + cursor: Cell, +} + +unsafe impl Send for Provision {} + +unsafe impl Allocator for Provision { + fn alloc(&self, size: usize) -> (*mut u8, usize, u32) { + let cursor = self.cursor.get(); + let Ok(segment) = provision::plan(cursor, size, memory_bytes()) else { + return (core::ptr::null_mut(), 0, 0); + }; + if segment.pages > 0 { + let grown = core::arch::wasm32::memory_grow(0, segment.pages); + if grown == usize::MAX || segment.end > memory_bytes() { + return (core::ptr::null_mut(), 0, 0); + } + } + self.cursor.set(segment.end); + (segment.start as *mut u8, segment.bytes, 0) + } + + fn remap(&self, _: *mut u8, _: usize, _: usize, _: bool) -> *mut u8 { + core::ptr::null_mut() + } + + fn free_part(&self, _: *mut u8, _: usize, _: usize) -> bool { + false + } + + fn free(&self, _: *mut u8, _: usize) -> bool { + false + } + + fn can_release_part(&self, _: u32) -> bool { + false + } + + fn allocates_zeros(&self) -> bool { + true + } + + fn page_size(&self) -> usize { + PAGE + } +} + +struct WasmStore<'a> { + alloc: &'a mut Dlmalloc, +} + +impl algorithm::Store for WasmStore<'_> { + fn allocate(&mut self, size: u32, align: u32) -> Option { + let pointer = unsafe { self.alloc.malloc(size as usize, align as usize) }; + if pointer.is_null() { + None + } else { + Some(pointer as u32) + } + } + + fn release(&mut self, pointer: u32, size: u32, align: u32) { + unsafe { + self.alloc + .free(pointer as *mut u8, size as usize, align as usize); + } + } + + fn read(&self, address: u32) -> u32 { + unsafe { core::ptr::read_unaligned(address as *const u32) } + } + + fn write(&mut self, address: u32, value: u32) { + unsafe { core::ptr::write_unaligned(address as *mut u32, value) } + } + + fn copy(&mut self, from: u32, to: u32, len: u32) { + if len == 0 || from == to { + return; + } + unsafe { + core::ptr::copy(from as *const u8, to as *mut u8, len as usize); + } + } +} + +// The application supplies the final planned boundary through a real Wasm import. +#[link(wasm_import_module = "__main_module__")] +unsafe extern "C" { + fn get_heap_base() -> u32; +} + +// Keep one initialized storage object: its active data segment initializes +// every field without an executable BSS-zeroing start function. +struct State { + phase: u8, + head: u32, + alloc: Dlmalloc, +} + +static mut STATE: State = State { + phase: phase::UNINITIALIZED, + head: 0, + alloc: Dlmalloc::new_with_allocator(Provision { + cursor: Cell::new(0), + }), +}; + +fn memory_bytes() -> usize { + core::arch::wasm32::memory_size(0) * PAGE +} + +fn initialize(alloc: &mut Dlmalloc) -> Result<(), ()> { + let heap = unsafe { get_heap_base() } as usize; + if heap == 0 || !heap.is_multiple_of(8) || heap > memory_bytes() { + return Err(()); + } + alloc.allocator_mut().cursor.set(heap); + Ok(()) +} + +/// Canonical realloc export. A trap leaves no published replacement pointer. +#[unsafe(no_mangle)] +pub unsafe extern "C" fn cabi_realloc(old_ptr: i32, old_len: i32, align: i32, new_len: i32) -> i32 { + unsafe { + let state = &mut *core::ptr::addr_of_mut!(STATE); + let initializing = phase::enter(&mut state.phase).unwrap_or_else(|_| { + core::arch::wasm32::unreachable(); + }); + if initializing { + if initialize(&mut state.alloc).is_err() { + core::arch::wasm32::unreachable(); + } + } + let mut store = WasmStore { + alloc: &mut state.alloc, + }; + let result = algorithm::realloc( + &mut store, + &mut state.head, + old_ptr, + old_len, + align, + new_len, + ); + phase::ready(&mut state.phase); + result.unwrap_or_else(|_| core::arch::wasm32::unreachable()) + } +} diff --git a/crates/psrs-runtime/src/catalog.rs b/crates/psrs-runtime/src/catalog.rs deleted file mode 100644 index 206b1e4f..00000000 --- a/crates/psrs-runtime/src/catalog.rs +++ /dev/null @@ -1,303 +0,0 @@ -//! Immutable target catalog consumed by the linker and backend. -//! -//! The catalog returns plain data: WIT source paths and bytes, a world -//! identity, and a pinned artifact's bytes plus declared raw contract and -//! provenance. It never returns a `wit_parser::Resolve`, compiler IR, or -//! link-plan value, and it compiles no executable target code, so a native -//! consumer can read it without linking the formatter. - -use crate::RawType; - -/// One pinned WIT source file: its catalog path and exact contents. -#[derive(Clone, Copy, Debug)] -pub struct WitSource { - pub path: &'static str, - pub contents: &'static str, -} - -/// The default world the command artifact implements. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct WorldIdentity { - pub package_namespace: &'static str, - pub package_name: &'static str, - pub world: &'static str, -} - -/// The `psrs:app/command` default world. -pub const DEFAULT_WORLD: WorldIdentity = WorldIdentity { - package_namespace: "psrs", - package_name: "app", - world: "command", -}; - -/// Vendored WASI 0.2.12 WIT in dependency order. -pub const WASI_WIT: &[WitSource] = &[ - WitSource { - path: "wasi/io.wit", - contents: include_str!("../wit/deps/io.wit"), - }, - WitSource { - path: "wasi/clocks.wit", - contents: include_str!("../wit/deps/clocks.wit"), - }, - WitSource { - path: "wasi/random.wit", - contents: include_str!("../wit/deps/random.wit"), - }, - WitSource { - path: "wasi/filesystem.wit", - contents: include_str!("../wit/deps/filesystem.wit"), - }, - WitSource { - path: "wasi/sockets.wit", - contents: include_str!("../wit/deps/sockets.wit"), - }, - WitSource { - path: "wasi/cli.wit", - contents: include_str!("../wit/deps/cli.wit"), - }, -]; - -/// The application world source. -pub const APP_WIT: WitSource = WitSource { - path: "psrs-app.wit", - contents: include_str!("../wit/psrs-app.wit"), -}; - -/// Reviewed provenance for a pinned compiler-owned runtime artifact. -#[derive(Clone, Copy, Debug)] -pub struct ArtifactProvenance { - /// The pinned dependency whose behavior the artifact implements. - pub dependency: &'static str, - /// The exact dependency revision. - pub dependency_revision: &'static str, - /// The Rust toolchain that produced the artifact. - pub rust_toolchain: &'static str, - /// The Rust target triple. - pub target: &'static str, - /// The Cargo profile. - pub profile: &'static str, - /// The linker flags and preparation recipe. - pub recipe: &'static str, - /// SHA-256 of the prepared artifact bytes. - pub sha256: &'static str, -} - -/// A function export the artifact declares. -#[derive(Clone, Copy, Debug)] -pub struct RawExport { - pub name: &'static str, - pub parameters: &'static [RawType], - pub result: Option, -} - -/// An import the artifact declares. -#[derive(Clone, Copy, Debug)] -pub struct RawImport { - pub module: &'static str, - pub field: &'static str, -} - -/// A table the artifact declares. -#[derive(Clone, Copy, Debug)] -pub struct RawTable { - pub element: &'static str, - pub minimum: u32, - pub maximum: Option, -} - -/// An active initializer for a private function table. -#[derive(Clone, Copy, Debug)] -pub struct RawElement { - pub table: u32, - pub offset: u32, - pub functions: &'static [u32], -} - -/// Private execution storage and the allocator boundary an artifact requires. -#[derive(Clone, Copy, Debug)] -pub struct RawStorage { - pub static_data: (u32, u32), - pub stack: (u32, u32), - pub heap_start: u32, - pub minimum_pages: u64, - /// The mutable stack-pointer global the artifact uses. - pub stack_pointer_global: u32, - /// A reviewed upper bound on stack bytes for supported calling behavior. - pub stack_bound_bytes: u32, - /// Where the bound comes from, including pending evidence. - pub stack_bound_evidence: &'static str, -} - -/// A pinned core-Wasm artifact and its declared raw contract. -#[derive(Clone, Copy, Debug)] -pub struct RuntimeArtifact { - pub id: &'static str, - /// The private core-module import identity the artifact uses. - pub module_name: &'static str, - /// The artifact's core-Wasm bytes. - pub bytes: &'static [u8], - pub provenance: ArtifactProvenance, - pub required_features: &'static [&'static str], - pub imports: &'static [RawImport], - pub function_exports: &'static [RawExport], - pub global_exports: &'static [&'static str], - pub tables: &'static [RawTable], - pub elements: &'static [RawElement], - /// Declared globals as `(mutable, constant i32 initial)`. - pub globals: &'static [(bool, u32)], - pub storage: RawStorage, - pub start_forbidden: bool, - pub data_range: (u32, u32), - pub instantiate_after_shims: bool, -} - -/// Numeric formatting and decimal conversion, produced by `tools/build.sh`. -pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { - id: "psrs:runtime-number", - module_name: crate::MODULE_NAME, - bytes: include_bytes!("../artifact/psrs_runtime.wasm"), - provenance: ArtifactProvenance { - dependency: "ryu-js, libm, and Rust core::num::dec2flt", - dependency_revision: "ryu-js 1.0.2; libm 0.2.15; Rust 1.99.0", - rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", - target: "wasm32-unknown-unknown", - profile: "target-runtime", - recipe: "tools/build.sh: RUSTFLAGS=-C no-redzone=yes; --import-memory --global-base=65536 \ - -zstack-size=65536 --export=__heap_base, then package", - sha256: "75cdd69833e058d014942eafdcd668eb9150e8d098a791871c327daf7bb20c73", - }, - required_features: &[ - "mutable-globals", - "sign-extension", - "saturating-float-to-int", - "multi-value", - "bulk-memory", - "reference-types", - ], - imports: &[RawImport { - module: crate::MEMORY_MODULE, - field: crate::MEMORY_FIELD, - }], - function_exports: &[ - RawExport { - name: crate::NUMBER_EXPORT, - parameters: &[RawType::F64, RawType::I32, RawType::I32], - result: Some(RawType::I32), - }, - RawExport { - name: crate::DECIMAL_EXPORT, - parameters: &[RawType::I32, RawType::I32], - result: Some(RawType::F64), - }, - RawExport { - name: crate::ACOS_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::ASIN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::ATAN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::ATAN2_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::SIN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::COS_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::TAN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::EXP_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::LOG_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::POW_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::MIN_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::MAX_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::SIGN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::REMAINDER_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - }, - RawExport { - name: crate::IS_NAN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::I32), - }, - RawExport { - name: crate::NAN_EXPORT, - parameters: &[], - result: Some(RawType::F64), - }, - RawExport { - name: crate::INFINITY_EXPORT, - parameters: &[], - result: Some(RawType::F64), - }, - ], - global_exports: &[crate::HEAP_BASE_EXPORT], - tables: &[RawTable { - element: "funcref", - minimum: 2, - maximum: Some(2), - }], - elements: &[RawElement { - table: 0, - offset: 1, - functions: &[54], - }], - globals: &[(true, crate::HEAP_START), (false, crate::HEAP_START)], - storage: RawStorage { - static_data: (crate::RESERVED_START, crate::STACK_BOTTOM), - stack: (crate::STACK_BOTTOM, crate::HEAP_START), - heap_start: crate::HEAP_START, - minimum_pages: 3, - stack_pointer_global: 0, - stack_bound_bytes: 1680, - stack_bound_evidence: "static call-graph frame analysis of the pinned artifact (psrs-linker::measure_stack_bound)", - }, - start_forbidden: true, - data_range: (crate::RESERVED_START, crate::STACK_BOTTOM), - instantiate_after_shims: false, -}; diff --git a/crates/psrs-runtime/src/catalog/allocator.rs b/crates/psrs-runtime/src/catalog/allocator.rs new file mode 100644 index 00000000..eef9d8f3 --- /dev/null +++ b/crates/psrs-runtime/src/catalog/allocator.rs @@ -0,0 +1,107 @@ +//! Pinned canonical allocator artifact and its state ownership. + +use super::model::*; +use super::{VERSION, op}; +use crate::abi::RawType; + +/// Canonical realloc, produced by `tools/build-allocator.sh`. +/// +/// Static data and the stack occupy the hole below the numeric runtime. The +/// imported `get_heap_base` function carries the planned shared heap boundary, +/// so this artifact stays pinned when that boundary moves. +pub const ALLOCATOR_RUNTIME: RuntimeArtifact = RuntimeArtifact { + id: "psrs:runtime-allocator", + module_name: crate::abi::ALLOCATOR_MODULE, + bytes: include_bytes!("../../artifact/psrs_allocator.wasm"), + provenance: ArtifactProvenance { + dependency: "dlmalloc", + dependency_revision: "0.2.14 (ad5208a115eaba24916f7456929832e310a81518c641f93fee4f89aa93aa3675)", + rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", + target: "wasm32-unknown-unknown", + profile: "target-runtime", + recipe: "tools/build-allocator.sh: remap-path-prefix, no-redzone, --import-memory \ + --stack-first -zstack-size=32768 --global-base=32768; direct Rust output, \ + imports __main_module__.get_heap_base, no executable start", + sha256: "a6f556d0151e8c474c495ad4488b9a23d67bb105dda2dc84eff17eaba70bbf19", + }, + required_features: &[ + "mutable-globals", + "sign-extension", + "multi-value", + "bulk-memory", + "reference-types", + ], + imports: &[ + RawImport { + module: crate::abi::MEMORY_MODULE, + field: crate::abi::MEMORY_FIELD, + kind: RawImportKind::Memory { + minimum: 1, + maximum: None, + }, + }, + RawImport { + module: crate::abi::APPLICATION_MODULE, + field: crate::abi::HEAP_BOUNDARY_IMPORT, + kind: RawImportKind::Function { + parameters: &[], + result: Some(RawType::I32), + }, + }, + ], + function_exports: &[RawExport { + name: crate::abi::REALLOC_EXPORT, + parameters: &[RawType::I32, RawType::I32, RawType::I32, RawType::I32], + result: Some(RawType::I32), + }], + global_exports: &[], + tables: &[RawTable { + element: "funcref", + minimum: 1, + maximum: Some(1), + }], + elements: &[], + globals: &[(true, crate::abi::ALLOCATOR_STACK_TOP)], + storage: RawStorage { + static_data: ( + crate::abi::ALLOCATOR_STATIC_START, + crate::abi::ALLOCATOR_STATIC_END, + ), + stack: ( + crate::abi::ALLOCATOR_STACK_BOTTOM, + crate::abi::ALLOCATOR_STACK_TOP, + ), + heap_start: crate::abi::ALLOCATOR_HEAP_START, + minimum_pages: 1, + stack_pointer_global: 0, + stack_bound_bytes: 80, + stack_bound_evidence: "static call-graph frame analysis of the pinned artifact (psrs-linker::measure_stack_bound)", + }, + start_forbidden: true, + data_range: ( + crate::abi::ALLOCATOR_STATIC_START, + crate::abi::ALLOCATOR_STATIC_END, + ), + instantiate_after_shims: false, +}; +/// Canonical `cabi_realloc`. +pub const ALLOCATOR_REALLOC_OP: ProvidedOperation = + op("psrs:allocator/realloc", &crate::abi::ALLOCATOR_REALLOC); + +const ALLOCATOR_OPERATIONS: &[ProvidedOperation] = &[ALLOCATOR_REALLOC_OP]; + +/// The exclusive shared-memory growth owner. +/// +/// It imports the application memory and the planned constant heap getter. +/// Instantiation does not call the canonical export; the first call initializes it. +pub const ALLOCATOR_UNIT: RuntimeUnit = RuntimeUnit { + id: "psrs:runtime/allocator", + semantic_contract_version: VERSION, + provided: ALLOCATOR_OPERATIONS, + required: &[], + variant: &ALLOCATOR_RUNTIME, + state: StateOwnership { + owner: Some("psrs:runtime/allocator"), + grows_memory: true, + }, +}; diff --git a/crates/psrs-runtime/src/catalog/mod.rs b/crates/psrs-runtime/src/catalog/mod.rs new file mode 100644 index 00000000..9dc3a612 --- /dev/null +++ b/crates/psrs-runtime/src/catalog/mod.rs @@ -0,0 +1,25 @@ +//! Immutable host-consumed runtime catalog. No executable target code is built here. +//! ABI contracts live in `abi`; each unit declares its artifact and operations +//! together, while WIT sources and the package aggregate have separate owners. + +mod allocator; +mod model; +mod number; +mod package; +mod wit; + +pub use allocator::*; +pub use model::*; +pub use number::*; +pub use package::*; +pub use wit::*; + +const VERSION: &str = "1"; + +const fn op(name: &'static str, abi: &'static crate::abi::RawFunctionAbi) -> ProvidedOperation { + ProvidedOperation { + name, + version: VERSION, + abi, + } +} diff --git a/crates/psrs-runtime/src/catalog/model.rs b/crates/psrs-runtime/src/catalog/model.rs new file mode 100644 index 00000000..e62c9aed --- /dev/null +++ b/crates/psrs-runtime/src/catalog/model.rs @@ -0,0 +1,152 @@ +//! Plain metadata records consumed by the linker and backend. + +use crate::abi::{RawFunctionAbi, RawType}; + +/// Reviewed provenance for a pinned compiler-owned runtime artifact. +#[derive(Clone, Copy, Debug)] +pub struct ArtifactProvenance { + /// The pinned dependency whose behavior the artifact implements. + pub dependency: &'static str, + /// The exact dependency revision. + pub dependency_revision: &'static str, + /// The Rust toolchain that produced the artifact. + pub rust_toolchain: &'static str, + /// The Rust target triple. + pub target: &'static str, + /// The Cargo profile. + pub profile: &'static str, + /// The linker flags and preparation recipe. + pub recipe: &'static str, + /// SHA-256 of the prepared artifact bytes. + pub sha256: &'static str, +} + +/// A function export the artifact declares. +#[derive(Clone, Copy, Debug)] +pub struct RawExport { + pub name: &'static str, + pub parameters: &'static [RawType], + pub result: Option, +} + +/// The kind of a raw artifact import. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum RawImportKind { + /// A memory import and its declared limits. + Memory { minimum: u64, maximum: Option }, + /// A scalar function import. + Function { + parameters: &'static [RawType], + result: Option, + }, +} + +/// An import the artifact declares. +#[derive(Clone, Copy, Debug)] +pub struct RawImport { + pub module: &'static str, + pub field: &'static str, + pub kind: RawImportKind, +} + +/// A table the artifact declares. +#[derive(Clone, Copy, Debug)] +pub struct RawTable { + pub element: &'static str, + pub minimum: u32, + pub maximum: Option, +} + +/// An active initializer for a private function table. +#[derive(Clone, Copy, Debug)] +pub struct RawElement { + pub table: u32, + pub offset: u32, + pub functions: &'static [u32], +} + +/// Private execution storage and the allocator boundary an artifact requires. +#[derive(Clone, Copy, Debug)] +pub struct RawStorage { + pub static_data: (u32, u32), + pub stack: (u32, u32), + pub heap_start: u32, + pub minimum_pages: u64, + /// Absolute index of the mutable stack-pointer global, counting imports. + pub stack_pointer_global: u32, + /// A reviewed upper bound on stack bytes for supported calling behavior. + pub stack_bound_bytes: u32, + /// Where the bound comes from, including pending evidence. + pub stack_bound_evidence: &'static str, +} + +/// A pinned core-Wasm artifact and its declared raw contract. +#[derive(Clone, Copy, Debug)] +pub struct RuntimeArtifact { + pub id: &'static str, + /// The private core-module import identity the artifact uses. + pub module_name: &'static str, + /// The artifact's core-Wasm bytes. + pub bytes: &'static [u8], + pub provenance: ArtifactProvenance, + pub required_features: &'static [&'static str], + pub imports: &'static [RawImport], + pub function_exports: &'static [RawExport], + pub global_exports: &'static [&'static str], + pub tables: &'static [RawTable], + pub elements: &'static [RawElement], + /// Declared globals as `(mutable, constant i32 initial)`. + pub globals: &'static [(bool, u32)], + pub storage: RawStorage, + pub start_forbidden: bool, + pub data_range: (u32, u32), + pub instantiate_after_shims: bool, +} + +/// An operation a unit provides, with the raw export that implements it. +#[derive(Clone, Copy)] +pub struct ProvidedOperation { + pub name: &'static str, + pub version: &'static str, + pub abi: &'static RawFunctionAbi, +} + +/// An operation a unit requires from exactly one other provider. +#[derive(Clone, Copy)] +pub struct RequiredOperation { + pub name: &'static str, + pub version: &'static str, + pub parameters: &'static [crate::RawType], + pub result: Option, +} + +/// Who owns a unit's private state and whether it may grow shared memory. +#[derive(Clone, Copy)] +pub struct StateOwnership { + /// Stable owner identity. `None` means the unit has no private state. + pub owner: Option<&'static str>, + /// Exclusive growth of the planned shared memory. + pub grows_memory: bool, +} + +/// One runtime implementation unit and the single variant it advertises. +#[derive(Clone, Copy)] +pub struct RuntimeUnit { + pub id: &'static str, + pub semantic_contract_version: &'static str, + pub provided: &'static [ProvidedOperation], + pub required: &'static [RequiredOperation], + /// The produced core-module variant. A second variant needs an explicit + /// selection rule before it is added here. + pub variant: &'static RuntimeArtifact, + pub state: StateOwnership, +} + +/// A runtime package identity and the units it publishes. +#[derive(Clone, Copy)] +pub struct RuntimePackage { + pub id: &'static str, + pub version: &'static str, + pub provenance: &'static str, + pub units: &'static [&'static RuntimeUnit], +} diff --git a/crates/psrs-runtime/src/catalog/number.rs b/crates/psrs-runtime/src/catalog/number.rs new file mode 100644 index 00000000..cbedf450 --- /dev/null +++ b/crates/psrs-runtime/src/catalog/number.rs @@ -0,0 +1,244 @@ +//! Pinned numeric artifact and the operations it provides. + +use super::model::*; +use super::{VERSION, op}; +use crate::abi::RawType; + +/// Numeric formatting and decimal conversion, produced by `tools/build.sh`. +pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { + id: "psrs:runtime-number", + module_name: crate::abi::MODULE_NAME, + bytes: include_bytes!("../../artifact/psrs_runtime.wasm"), + provenance: ArtifactProvenance { + dependency: "ryu-js, libm, and Rust core::num::dec2flt", + dependency_revision: "ryu-js 1.0.2; libm 0.2.15; Rust 1.99.0", + rust_toolchain: "1.99.0 (b940084d7 2026-09-28)", + target: "wasm32-unknown-unknown", + profile: "target-runtime", + recipe: "tools/build.sh: RUSTFLAGS=-C no-redzone=yes; --import-memory --global-base=65536 \ + -zstack-size=65536 --export=__heap_base, then package", + sha256: "458a7df7eb27038c4d6b22aa52fc8ea283c6dca41120b0c0bf31f6a851aa0260", + }, + required_features: &[ + "mutable-globals", + "sign-extension", + "saturating-float-to-int", + "multi-value", + "bulk-memory", + "reference-types", + ], + imports: &[RawImport { + module: crate::abi::MEMORY_MODULE, + field: crate::abi::MEMORY_FIELD, + kind: RawImportKind::Memory { + minimum: 3, + maximum: None, + }, + }], + function_exports: &[ + RawExport { + name: crate::abi::NUMBER_EXPORT, + parameters: &[RawType::F64, RawType::I32, RawType::I32], + result: Some(RawType::I32), + }, + RawExport { + name: crate::abi::DECIMAL_EXPORT, + parameters: &[RawType::I32, RawType::I32], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::ACOS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::ASIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::ATAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::ATAN2_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::SIN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::COS_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::TAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::EXP_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::LOG_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::POW_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::MIN_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::MAX_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::SIGN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::REMAINDER_EXPORT, + parameters: &[RawType::F64, RawType::F64], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::IS_NAN_EXPORT, + parameters: &[RawType::F64], + result: Some(RawType::I32), + }, + RawExport { + name: crate::abi::NAN_EXPORT, + parameters: &[], + result: Some(RawType::F64), + }, + RawExport { + name: crate::abi::INFINITY_EXPORT, + parameters: &[], + result: Some(RawType::F64), + }, + ], + global_exports: &[crate::abi::HEAP_BASE_EXPORT], + tables: &[RawTable { + element: "funcref", + minimum: 2, + maximum: Some(2), + }], + elements: &[RawElement { + table: 0, + offset: 1, + functions: &[54], + }], + globals: &[ + (true, crate::abi::HEAP_START), + (false, crate::abi::HEAP_START), + ], + storage: RawStorage { + static_data: (crate::abi::RESERVED_START, crate::abi::STACK_BOTTOM), + stack: (crate::abi::STACK_BOTTOM, crate::abi::HEAP_START), + heap_start: crate::abi::HEAP_START, + minimum_pages: 3, + stack_pointer_global: 0, + stack_bound_bytes: 1680, + stack_bound_evidence: "static call-graph frame analysis of the pinned artifact (psrs-linker::measure_stack_bound)", + }, + start_forbidden: true, + data_range: (crate::abi::RESERVED_START, crate::abi::STACK_BOTTOM), + instantiate_after_shims: false, +}; + +/// `number_to_string`. +pub const NUMBER_TO_STRING_OP: ProvidedOperation = + op("psrs:number/to-string", &crate::abi::NUMBER_FORMAT); +/// `number_from_decimal`. +pub const NUMBER_FROM_DECIMAL_OP: ProvidedOperation = + op("psrs:number/from-decimal", &crate::abi::NUMBER_PARSE); +/// `number_acos`. +pub const NUMBER_ACOS_OP: ProvidedOperation = op("psrs:number/acos", &crate::abi::NUMBER_ACOS); +/// `number_asin`. +pub const NUMBER_ASIN_OP: ProvidedOperation = op("psrs:number/asin", &crate::abi::NUMBER_ASIN); +/// `number_atan`. +pub const NUMBER_ATAN_OP: ProvidedOperation = op("psrs:number/atan", &crate::abi::NUMBER_ATAN); +/// `number_atan2`. +pub const NUMBER_ATAN2_OP: ProvidedOperation = op("psrs:number/atan2", &crate::abi::NUMBER_ATAN2); +/// `number_sin`. +pub const NUMBER_SIN_OP: ProvidedOperation = op("psrs:number/sin", &crate::abi::NUMBER_SIN); +/// `number_cos`. +pub const NUMBER_COS_OP: ProvidedOperation = op("psrs:number/cos", &crate::abi::NUMBER_COS); +/// `number_tan`. +pub const NUMBER_TAN_OP: ProvidedOperation = op("psrs:number/tan", &crate::abi::NUMBER_TAN); +/// `number_exp`. +pub const NUMBER_EXP_OP: ProvidedOperation = op("psrs:number/exp", &crate::abi::NUMBER_EXP); +/// `number_log`. +pub const NUMBER_LOG_OP: ProvidedOperation = op("psrs:number/log", &crate::abi::NUMBER_LOG); +/// `number_pow`. +pub const NUMBER_POW_OP: ProvidedOperation = op("psrs:number/pow", &crate::abi::NUMBER_POW); +/// `number_min`. +pub const NUMBER_MIN_OP: ProvidedOperation = op("psrs:number/min", &crate::abi::NUMBER_MIN); +/// `number_max`. +pub const NUMBER_MAX_OP: ProvidedOperation = op("psrs:number/max", &crate::abi::NUMBER_MAX); +/// `number_sign`. +pub const NUMBER_SIGN_OP: ProvidedOperation = op("psrs:number/sign", &crate::abi::NUMBER_SIGN); +/// `number_remainder`. +pub const NUMBER_REMAINDER_OP: ProvidedOperation = + op("psrs:number/remainder", &crate::abi::NUMBER_REMAINDER); +/// `number_is_nan`. +pub const NUMBER_IS_NAN_OP: ProvidedOperation = + op("psrs:number/is-nan", &crate::abi::NUMBER_IS_NAN); +/// `number_nan`. +pub const NUMBER_NAN_OP: ProvidedOperation = op("psrs:number/nan", &crate::abi::NUMBER_NAN); +/// `number_infinity`. +pub const NUMBER_INFINITY_OP: ProvidedOperation = + op("psrs:number/infinity", &crate::abi::NUMBER_INFINITY); + +const NUMBER_OPERATIONS: &[ProvidedOperation] = &[ + NUMBER_TO_STRING_OP, + NUMBER_FROM_DECIMAL_OP, + NUMBER_ACOS_OP, + NUMBER_ASIN_OP, + NUMBER_ATAN_OP, + NUMBER_ATAN2_OP, + NUMBER_SIN_OP, + NUMBER_COS_OP, + NUMBER_TAN_OP, + NUMBER_EXP_OP, + NUMBER_LOG_OP, + NUMBER_POW_OP, + NUMBER_MIN_OP, + NUMBER_MAX_OP, + NUMBER_SIGN_OP, + NUMBER_REMAINDER_OP, + NUMBER_IS_NAN_OP, + NUMBER_NAN_OP, + NUMBER_INFINITY_OP, +]; + +/// Numeric formatting, parsing, and elementary operations. +/// +/// This unit owns its static data and stack. It imports the application memory +/// and does not grow it. The demand names the allocator that owns growth. +pub const NUMBER_UNIT: RuntimeUnit = RuntimeUnit { + id: "psrs:runtime/number", + semantic_contract_version: VERSION, + provided: NUMBER_OPERATIONS, + required: &[], + variant: &NUMBER_RUNTIME, + state: StateOwnership { + owner: Some("psrs:runtime/number"), + grows_memory: false, + }, +}; diff --git a/crates/psrs-runtime/src/catalog/package.rs b/crates/psrs-runtime/src/catalog/package.rs new file mode 100644 index 00000000..202170a7 --- /dev/null +++ b/crates/psrs-runtime/src/catalog/package.rs @@ -0,0 +1,42 @@ +//! The produced runtime package and package-level consistency checks. + +use super::{ALLOCATOR_UNIT, NUMBER_UNIT, RuntimePackage, VERSION}; + +/// The compiler-owned runtime package. +pub const PSRS_RUNTIME: RuntimePackage = RuntimePackage { + id: "psrs:runtime", + version: VERSION, + provenance: "compiler-owned catalog; each unit pins its own variant bytes and recipe", + units: &[&NUMBER_UNIT, &ALLOCATOR_UNIT], +}; + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn the_number_unit_advertises_each_pinned_export_once() { + let exports: Vec<_> = NUMBER_UNIT + .variant + .function_exports + .iter() + .map(|export| export.name) + .collect(); + let provided: Vec<_> = NUMBER_UNIT + .provided + .iter() + .map(|operation| operation.abi.export) + .collect(); + assert_eq!(exports, provided); + const { assert!(NUMBER_UNIT.required.is_empty()) }; + assert_eq!(NUMBER_UNIT.state.owner, Some(NUMBER_UNIT.id)); + const { assert!(!NUMBER_UNIT.state.grows_memory) }; + assert_eq!(PSRS_RUNTIME.units.len(), 2); + assert_eq!(PSRS_RUNTIME.units[0].id, NUMBER_UNIT.id); + assert_eq!(PSRS_RUNTIME.units[1].id, ALLOCATOR_UNIT.id); + const { assert!(ALLOCATOR_UNIT.state.grows_memory) }; + assert_eq!(ALLOCATOR_UNIT.state.owner, Some(ALLOCATOR_UNIT.id)); + assert_eq!(ALLOCATOR_UNIT.provided.len(), 1); + assert!(ALLOCATOR_UNIT.required.is_empty()); + } +} diff --git a/crates/psrs-runtime/src/catalog/wit.rs b/crates/psrs-runtime/src/catalog/wit.rs new file mode 100644 index 00000000..df00fb48 --- /dev/null +++ b/crates/psrs-runtime/src/catalog/wit.rs @@ -0,0 +1,57 @@ +//! Pinned interface sources and the default application world. + +/// One pinned WIT source file: its catalog path and exact contents. +#[derive(Clone, Copy, Debug)] +pub struct WitSource { + pub path: &'static str, + pub contents: &'static str, +} + +/// The default world the command artifact implements. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct WorldIdentity { + pub package_namespace: &'static str, + pub package_name: &'static str, + pub world: &'static str, +} + +/// The `psrs:app/command` default world. +pub const DEFAULT_WORLD: WorldIdentity = WorldIdentity { + package_namespace: "psrs", + package_name: "app", + world: "command", +}; + +/// Vendored WASI 0.2.12 WIT in dependency order. +pub const WASI_WIT: &[WitSource] = &[ + WitSource { + path: "wasi/io.wit", + contents: include_str!("../../wit/deps/io.wit"), + }, + WitSource { + path: "wasi/clocks.wit", + contents: include_str!("../../wit/deps/clocks.wit"), + }, + WitSource { + path: "wasi/random.wit", + contents: include_str!("../../wit/deps/random.wit"), + }, + WitSource { + path: "wasi/filesystem.wit", + contents: include_str!("../../wit/deps/filesystem.wit"), + }, + WitSource { + path: "wasi/sockets.wit", + contents: include_str!("../../wit/deps/sockets.wit"), + }, + WitSource { + path: "wasi/cli.wit", + contents: include_str!("../../wit/deps/cli.wit"), + }, +]; + +/// The application world source. +pub const APP_WIT: WitSource = WitSource { + path: "psrs-app.wit", + contents: include_str!("../../wit/psrs-app.wit"), +}; diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index f6aa8bf9..997ff7ac 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -1,265 +1,40 @@ -//! The target runtime package. +//! One runtime package with separate ABI, catalog, and executable module owners. //! -//! This crate has two distinct build entry points: -//! -//! - The [`catalog`] module (feature `catalog`) exposes immutable, host-consumed -//! metadata: pinned WIT source bytes, the default command-world identity, and -//! the compiler-owned formatter artifact with its provenance and storage -//! contract. It links no executable target code. -//! - Feature `formatter` compiles the numeric formatting, complete-decimal -//! conversion, and numeric exports, built for `wasm32-unknown-unknown` -//! and embedded as the pinned artifact. It embeds neither WIT text nor the -//! catalog. -//! Scalar math exports and numeric semantic wrappers live in `number`; -//! `atan2` retains its separate compatibility algorithm. Decimal parsing -//! and number formatting each have their own implementation module. -//! -//! The compiler depends on this crate with `default-features = false, -//! features = ["catalog"]`; the Wasm artifact build uses -//! `--no-default-features --features formatter`. - -#![cfg_attr(all(feature = "formatter", target_arch = "wasm32"), no_std)] +//! `abi` defines data-only raw contracts for every build. Feature `catalog` +//! exposes pinned WIT, artifact metadata, and package units to native compiler +//! consumers. Feature `formatter` builds the numeric implementation in `number`; +//! feature `allocator` builds the canonical allocator. Each Wasm artifact enables +//! exactly one executable feature and embeds no catalog assets. + +#![cfg_attr( + all( + any(feature = "formatter", feature = "allocator"), + target_arch = "wasm32" + ), + no_std +)] + +pub mod abi; +pub use abi::*; #[cfg(feature = "catalog")] pub mod catalog; #[cfg(feature = "catalog")] pub use catalog::*; -#[cfg(feature = "formatter")] -mod atan2; -#[cfg(feature = "formatter")] -mod decimal; -#[cfg(feature = "formatter")] -mod formatter; #[cfg(feature = "formatter")] mod number; #[cfg(feature = "formatter")] -pub use atan2::number_atan2; -#[cfg(feature = "formatter")] -pub use decimal::number_from_decimal; -#[cfg(feature = "formatter")] -pub use formatter::number_to_string; -#[cfg(feature = "formatter")] -pub use number::{ - number_acos, number_asin, number_atan, number_cos, number_exp, number_infinity, number_is_nan, - number_log, number_max, number_min, number_nan, number_pow, number_remainder, number_sign, - number_sin, number_tan, -}; - -/// Maximum capacity required by an ECMAScript binary64 token. -pub const NUMBER_CAPACITY: usize = 32; -/// Private core-module import identity used by the compiler. -pub const MODULE_NAME: &str = "psrs:runtime"; -/// Exported raw formatting function. -pub const NUMBER_EXPORT: &str = "number_to_string"; -/// Exported raw complete-decimal conversion function. -pub const DECIMAL_EXPORT: &str = "number_from_decimal"; -/// Exported raw inverse-cosine function. -pub const ACOS_EXPORT: &str = "number_acos"; -/// Exported raw inverse-sine function. -pub const ASIN_EXPORT: &str = "number_asin"; -/// Exported raw inverse-tangent function. -pub const ATAN_EXPORT: &str = "number_atan"; -/// Exported raw four-quadrant inverse-tangent function. -pub const ATAN2_EXPORT: &str = "number_atan2"; -/// Exported raw sine function. -pub const SIN_EXPORT: &str = "number_sin"; -/// Exported raw cosine function. -pub const COS_EXPORT: &str = "number_cos"; -/// Exported raw tangent function. -pub const TAN_EXPORT: &str = "number_tan"; -/// Exported raw base-e exponential function. -pub const EXP_EXPORT: &str = "number_exp"; -/// Exported raw natural-logarithm function. -pub const LOG_EXPORT: &str = "number_log"; -/// Exported raw exponentiation function. -pub const POW_EXPORT: &str = "number_pow"; -/// Exported raw minimum function. -pub const MIN_EXPORT: &str = "number_min"; -/// Exported raw maximum function. -pub const MAX_EXPORT: &str = "number_max"; -/// Exported raw sign function. -pub const SIGN_EXPORT: &str = "number_sign"; -/// Exported raw JavaScript remainder function. -pub const REMAINDER_EXPORT: &str = "number_remainder"; -/// Exported raw NaN predicate. The result is an `i32` 0 or 1. -pub const IS_NAN_EXPORT: &str = "number_is_nan"; -/// Exported raw canonical NaN. -pub const NAN_EXPORT: &str = "number_nan"; -/// Exported raw positive infinity. -pub const INFINITY_EXPORT: &str = "number_infinity"; -/// Lower addresses remain owned by the application's canonical ABI. -pub const RESERVED_START: u32 = 65536; -/// Static data must end before the separately reserved 64 KiB stack. -pub const STACK_BOTTOM: u32 = 131072; -/// The caller's allocator begins after the private stack. -pub const HEAP_START: u32 = 196608; -/// The runtime imports the application's canonical memory. -pub const MEMORY_MODULE: &str = "env"; -/// The runtime's memory import field. -pub const MEMORY_FIELD: &str = "memory"; -/// The runtime exports its heap boundary for the preparer to relocate. -pub const HEAP_BASE_EXPORT: &str = "__heap_base"; - -/// Raw scalar types in the runtime's core-Wasm function ABI. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum RawType { - I32, - I64, - F32, - F64, -} - -/// Language-value transport and normal-return ownership for a raw export. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum RawCallProtocol { - /// Scalar arguments/results only; Unit results use a void export. - Scalars, - /// Borrowed canonical UTF-8 bytes; caller copies, then releases on return. - Utf8Input, - /// Caller-owned bounded UTF-8 output; caller recovers and releases on return. - Utf8Output { capacity: usize }, -} - -/// An artifact export's raw signature and language-value transport protocol. -pub struct RawFunctionAbi { - pub export: &'static str, - pub parameters: &'static [RawType], - pub result: Option, - pub protocol: RawCallProtocol, -} - -pub const NUMBER_FORMAT: RawFunctionAbi = RawFunctionAbi { - export: NUMBER_EXPORT, - parameters: &[RawType::F64, RawType::I32, RawType::I32], - result: Some(RawType::I32), - protocol: RawCallProtocol::Utf8Output { - capacity: NUMBER_CAPACITY, - }, -}; - -pub const NUMBER_PARSE: RawFunctionAbi = RawFunctionAbi { - export: DECIMAL_EXPORT, - parameters: &[RawType::I32, RawType::I32], - result: Some(RawType::F64), - protocol: RawCallProtocol::Utf8Input, -}; - -pub const NUMBER_ACOS: RawFunctionAbi = RawFunctionAbi { - export: ACOS_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_ASIN: RawFunctionAbi = RawFunctionAbi { - export: ASIN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_ATAN: RawFunctionAbi = RawFunctionAbi { - export: ATAN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_ATAN2: RawFunctionAbi = RawFunctionAbi { - export: ATAN2_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_SIN: RawFunctionAbi = RawFunctionAbi { - export: SIN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_COS: RawFunctionAbi = RawFunctionAbi { - export: COS_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_TAN: RawFunctionAbi = RawFunctionAbi { - export: TAN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_EXP: RawFunctionAbi = RawFunctionAbi { - export: EXP_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_LOG: RawFunctionAbi = RawFunctionAbi { - export: LOG_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_POW: RawFunctionAbi = RawFunctionAbi { - export: POW_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_MIN: RawFunctionAbi = RawFunctionAbi { - export: MIN_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_MAX: RawFunctionAbi = RawFunctionAbi { - export: MAX_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_SIGN: RawFunctionAbi = RawFunctionAbi { - export: SIGN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; - -pub const NUMBER_REMAINDER: RawFunctionAbi = RawFunctionAbi { - export: REMAINDER_EXPORT, - parameters: &[RawType::F64, RawType::F64], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; +pub use number::*; -pub const NUMBER_IS_NAN: RawFunctionAbi = RawFunctionAbi { - export: IS_NAN_EXPORT, - parameters: &[RawType::F64], - result: Some(RawType::I32), - protocol: RawCallProtocol::Scalars, -}; +#[cfg(all(feature = "allocator", any(test, target_arch = "wasm32")))] +mod allocator; -pub const NUMBER_NAN: RawFunctionAbi = RawFunctionAbi { - export: NAN_EXPORT, - parameters: &[], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; +#[cfg(all( + any(feature = "formatter", feature = "allocator"), + target_arch = "wasm32" +))] +mod panic; -pub const NUMBER_INFINITY: RawFunctionAbi = RawFunctionAbi { - export: INFINITY_EXPORT, - parameters: &[], - result: Some(RawType::F64), - protocol: RawCallProtocol::Scalars, -}; +#[cfg(all(feature = "formatter", feature = "allocator", target_arch = "wasm32"))] +compile_error!("the formatter and allocator are separate wasm32 artifacts"); diff --git a/crates/psrs-runtime/src/atan2.rs b/crates/psrs-runtime/src/number/atan2.rs similarity index 100% rename from crates/psrs-runtime/src/atan2.rs rename to crates/psrs-runtime/src/number/atan2.rs diff --git a/crates/psrs-runtime/src/decimal.rs b/crates/psrs-runtime/src/number/decimal.rs similarity index 100% rename from crates/psrs-runtime/src/decimal.rs rename to crates/psrs-runtime/src/number/decimal.rs diff --git a/crates/psrs-runtime/src/formatter.rs b/crates/psrs-runtime/src/number/format.rs similarity index 88% rename from crates/psrs-runtime/src/formatter.rs rename to crates/psrs-runtime/src/number/format.rs index 7aff0f39..3eed1a99 100644 --- a/crates/psrs-runtime/src/formatter.rs +++ b/crates/psrs-runtime/src/number/format.rs @@ -8,7 +8,7 @@ /// identifies initialized ASCII bytes; no allocation or retained pointer occurs. #[unsafe(no_mangle)] pub unsafe extern "C" fn number_to_string(value: f64, output: *mut u8, capacity: usize) -> usize { - assert!(capacity >= crate::NUMBER_CAPACITY); + assert!(capacity >= crate::abi::NUMBER_CAPACITY); if value.is_finite() { // SAFETY: format64 requires 25 writable bytes and a finite input. return unsafe { ryu_js::raw::format64(value, output) }; @@ -25,12 +25,6 @@ pub unsafe extern "C" fn number_to_string(value: f64, output: *mut u8, capacity: text.len() } -#[cfg(target_arch = "wasm32")] -#[panic_handler] -fn panic(_: &core::panic::PanicInfo<'_>) -> ! { - core::arch::wasm32::unreachable() -} - #[cfg(test)] mod tests { use super::*; @@ -49,7 +43,7 @@ mod tests { (f64::from_bits(1), "5e-324"), (f64::MAX, "1.7976931348623157e+308"), ] { - let mut output = [0xff; crate::NUMBER_CAPACITY]; + let mut output = [0xff; crate::abi::NUMBER_CAPACITY]; // SAFETY: the buffer owns all 32 bytes for the duration of the call. let length = unsafe { number_to_string(value, output.as_mut_ptr(), output.len()) }; assert_eq!(&output[..length], expected.as_bytes()); diff --git a/crates/psrs-runtime/src/number.rs b/crates/psrs-runtime/src/number/math.rs similarity index 100% rename from crates/psrs-runtime/src/number.rs rename to crates/psrs-runtime/src/number/math.rs diff --git a/crates/psrs-runtime/src/number/mod.rs b/crates/psrs-runtime/src/number/mod.rs new file mode 100644 index 00000000..ce0005f0 --- /dev/null +++ b/crates/psrs-runtime/src/number/mod.rs @@ -0,0 +1,15 @@ +//! Executable numeric runtime: formatting, parsing, and scalar math. + +mod atan2; +mod decimal; +mod format; +mod math; + +pub use atan2::number_atan2; +pub use decimal::number_from_decimal; +pub use format::number_to_string; +pub use math::{ + number_acos, number_asin, number_atan, number_cos, number_exp, number_infinity, number_is_nan, + number_log, number_max, number_min, number_nan, number_pow, number_remainder, number_sign, + number_sin, number_tan, +}; diff --git a/crates/psrs-runtime/src/panic.rs b/crates/psrs-runtime/src/panic.rs new file mode 100644 index 00000000..52340369 --- /dev/null +++ b/crates/psrs-runtime/src/panic.rs @@ -0,0 +1,6 @@ +//! Trap-based panic behavior shared by both executable Wasm artifacts. + +#[panic_handler] +fn panic(_: &core::panic::PanicInfo<'_>) -> ! { + core::arch::wasm32::unreachable() +} diff --git a/crates/psrs-runtime/tools/build-allocator.sh b/crates/psrs-runtime/tools/build-allocator.sh new file mode 100755 index 00000000..cebd17cf --- /dev/null +++ b/crates/psrs-runtime/tools/build-allocator.sh @@ -0,0 +1,14 @@ +#!/bin/sh +set -eu +cd "$(dirname "$0")/../../.." +sysroot=$(rustc --print sysroot) +# The upper 16 KiB of the stack prefix is allocator-owned; verified frame +# bounds keep accesses above canonical scratch. Data starts above the stack. +# Paths in panic text must not capture this machine. +RUSTFLAGS="${RUSTFLAGS:-} -C no-redzone=yes --remap-path-prefix=${HOME}/.cargo/=/cargo/ --remap-path-prefix=${sysroot}=/rustc/ --remap-path-prefix=${PWD}=/psrs/" \ +cargo rustc --locked -p psrs-runtime --lib --no-default-features --features allocator \ + --target wasm32-unknown-unknown --profile target-runtime -- \ + -C link-arg=--import-memory -C link-arg=--global-base=32768 \ + -C link-arg=--stack-first -C link-arg=-zstack-size=32768 +cp target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ + "${1:-crates/psrs-runtime/artifact/psrs_allocator.wasm}" diff --git a/crates/psrs-runtime/tools/build.sh b/crates/psrs-runtime/tools/build.sh index 720d76b9..cf30f6b8 100644 --- a/crates/psrs-runtime/tools/build.sh +++ b/crates/psrs-runtime/tools/build.sh @@ -10,4 +10,4 @@ cargo rustc --locked -p psrs-runtime --lib --no-default-features --features form -C link-arg=-zstack-size=65536 -C link-arg=--export=__heap_base cargo run --locked -p psrs-runtime --example package -- \ target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ - crates/psrs-runtime/artifact/psrs_runtime.wasm + "${1:-crates/psrs-runtime/artifact/psrs_runtime.wasm}" diff --git a/crates/psrs-runtime/tools/check-reproducible.sh b/crates/psrs-runtime/tools/check-reproducible.sh index 74c2eaa2..bb0cac8a 100755 --- a/crates/psrs-runtime/tools/check-reproducible.sh +++ b/crates/psrs-runtime/tools/check-reproducible.sh @@ -1,24 +1,16 @@ #!/bin/sh -# Rebuilds the runtime artifact and checks that it reproduces the committed -# bytes. A mismatch means the reviewed provenance digest must be updated -# explicitly; this check never rewrites the artifact. +# Rebuild both runtime artifacts without overwriting the reviewed bytes. set -eu cd "$(dirname "$0")/../../.." tmp=$(mktemp -d) trap 'rm -rf "$tmp"' EXIT -# Apply to dependencies as well: libm force_eval uses stack temporaries. -# Explicit frames let the linker measure their storage without a red zone. -RUSTFLAGS="${RUSTFLAGS:-} -C no-redzone=yes" \ -cargo rustc --locked -p psrs-runtime --lib --no-default-features --features formatter \ - --target wasm32-unknown-unknown --profile target-runtime -- \ - -C link-arg=--import-memory -C link-arg=--global-base=65536 \ - -C link-arg=-zstack-size=65536 -C link-arg=--export=__heap_base -cargo run --locked -p psrs-runtime --example package -- \ - target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ - "$tmp/psrs_runtime.wasm" -if cmp -s "$tmp/psrs_runtime.wasm" crates/psrs-runtime/artifact/psrs_runtime.wasm; then - echo "runtime artifact reproduces byte-for-byte" -else - echo "runtime artifact differs from the committed bytes; update the reviewed provenance" >&2 - exit 1 -fi +sh crates/psrs-runtime/tools/build.sh "$tmp/psrs_runtime.wasm" +sh crates/psrs-runtime/tools/build-allocator.sh "$tmp/psrs_allocator.wasm" +for artifact in psrs_runtime psrs_allocator; do + if cmp -s "$tmp/$artifact.wasm" "crates/psrs-runtime/artifact/$artifact.wasm"; then + echo "$artifact reproduces byte-for-byte" + else + echo "$artifact differs from the reviewed bytes; update its provenance" >&2 + exit 1 + fi +done diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index 26e84602..5b275fe3 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -64,6 +64,8 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [capability-profile.md](wasm/capability-profile.md) | Target capability profile and gating | encoding-and-structuring | | [canonical-abi-and-wit.md](wasm/canonical-abi-and-wit.md) | WIT bindings and canonical ABI adaptation | encoding-and-structuring | | [linking-and-runtime.md](wasm/linking-and-runtime.md) | Intrinsic implementations, WIT providers, checked target link plans, and artifact composition (Draft) | primitive FFI, canonical-abi-and-wit | +| [core-object-linking-and-compilation-units.md](wasm/core-object-linking-and-compilation-units.md) | Source/Core/Wasm/component units, compiler-owned emission, structured runtime closure and bindings (Draft) | linking-and-runtime, encoding-and-structuring | +| [canonical-realloc-runtime-adapter.md](wasm/canonical-realloc-runtime-adapter.md) | Rust allocator selection, canonical adapter, and runtime-provider replacement (Draft) | canonical-buffer-allocation-and-lifetime, linking-and-runtime | | [linear-memory-and-canonical-abi-boundary.md](wasm/linear-memory-and-canonical-abi-boundary.md) | Linear memory as the ABI boundary | canonical-abi-and-wit | | [wasi-platform-library.md](wasm/wasi-platform-library.md) | Component packaging and WASI services | canonical-abi-and-wit | diff --git a/docs/design/backend/wasm/canonical-buffer-allocation-and-lifetime.md b/docs/design/backend/wasm/canonical-buffer-allocation-and-lifetime.md index 9cd46b55..42662429 100644 --- a/docs/design/backend/wasm/canonical-buffer-allocation-and-lifetime.md +++ b/docs/design/backend/wasm/canonical-buffer-allocation-and-lifetime.md @@ -7,6 +7,11 @@ ## Scope +The proposed replacement of the handwritten allocator strategy with a mature +Rust allocator is specified in [Canonical realloc runtime adapter](canonical-realloc-runtime-adapter.md). +That draft preserves this topic's buffer-lifetime and behavioral obligations; +the existing generated implementation remains in use until replacement acceptance. + This document owns the lifetime and storage of every canonical ABI buffer: the `cabi_realloc` allocator contract and its implementation strategy, block headers and alignment, free lists, coalescing and reuse, the heap-state region, memory diff --git a/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md b/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md new file mode 100644 index 00000000..6b721889 --- /dev/null +++ b/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md @@ -0,0 +1,273 @@ +# Canonical Realloc Runtime Adapter + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md)\ +**Status:** Draft\ +**Prerequisites:** [Canonical buffer allocation and lifetime](canonical-buffer-allocation-and-lifetime.md), [linking and runtime](linking-and-runtime.md), and [compilation units and runtime linking](core-object-linking-and-compilation-units.md).\ +**Summary:** Replace compiler-synthesized heap management with Rust `dlmalloc` 0.2.14 behind a small canonical adapter. Bind one allocator runtime instance to the application's memory and planned heap boundary, initialize lazily after bindings resolve, and preserve allocation, lifetime, and provenance obligations. The linker connects a pinned Core Module; there is no application object-linking prerequisite. + +## Scope + +This topic owns crate selection, canonical dispatch, memory provisioning and +initialization for the allocator runtime provider. The buffer-lifetime topic +continues to own call-local/import-result/export-result ownership and post-return. +The linker owns provider binding and the shared memory plan. + +The selected provider replaces the handwritten block/free-list strategy after +acceptance. Existing behavior remains the migration baseline. This draft does +not claim that the crate is installed, runtime integration works, or acceptance +has executed. + +## Background + +Language values live in Wasm GC. Canonical component bindings use linear-memory +buffers and request them through `cabi_realloc`. Retaining that name preserves +the interface while replacing heap management. `cabi` means Canonical ABI. + +The backend currently synthesizes `build_realloc`, initializes its own fixed +state bytes, and directs codecs and cleanup to that generated function. The +application verifier recognizes that specific state layout. Runtime replacement +must change these connected contracts together, rather than only swap a function. + +## Model + +```text +CanonicalRealloc = (old_ptr: i32, old_len: i32, align: i32, new_len: i32) -> i32 +AllocatorProvider = { + pinned_core_module, canonical_export, + memory_import, heap_getter_import, + state_and_stack_reservations, initialization_protocol, + exclusive_growth_ownership, allocation_provenance_contract +} +``` + +The target is single-threaded wasm32 with one shared linear memory between the +application and selected runtime Core instances. Here shared means the same +memory instance, not Wasm's atomic/shared-memory type. Memory64, multiple heaps, +threads and multiple allocator instances are unsupported by this contract. + +The selected crate is Rust `dlmalloc` at exact version `0.2.14`. Use one explicitly +owned `Dlmalloc` instance with a custom underlying memory provider. Lock the +crate checksum, toolchain, build recipe and output digest during implementation. +The crate's established Wasm use and configurable underlying allocator motivate +the choice; upstream documentation is not project runtime acceptance. + +## Design + +### Provider and application wiring + +```mermaid +flowchart LR + bindings[Canonical component bindings] --> entry[Application cabi_realloc forwarding export] + calls[Generated codecs and cleanup] --> entry + entry --> runtime[Allocator runtime Core Module] + runtime --> adapter[Canonical adapter] + adapter --> allocator[One Rust dlmalloc instance] + allocator --> provision[Checked memory provisioning] + provision --> memory[Application linear memory] +``` + +The allocator artifact imports the application's memory and a scalar +`__main_module__.get_heap_base: () -> i32` function. Catalog data owns the import +identity and signature; artifact verification checks the real import. The +application exports memory, the heap getter, and a canonical forwarding function. +All generated allocation/free/resize calls and canonical bindings use that +forwarder and therefore the same provider instance. + +Core library composition may use a function shim for the application/runtime +instance cycle. No start function or data initializer may call the forwarding +entry or getter. Resolve the shim before any allocation call. The composer uses +its application-export import namespace to bind the getter without host imports. + +### Layout and lazy initialization + +The target planner first reserves canonical scratch, runtime static data/stacks, +and allocator metadata, then derives one aligned `heap_start`. The application +exports a `() -> i32` function containing only `i32.const heap_start; end`. +This lets the artifact remain pinned while its heap boundary varies with the selected runtime closure. + +Provider states are `Uninitialized`, `Initializing`, and `Ready`. On the first +canonical call, call the bound getter once, validate alignment and memory coverage, +and create the allocator over the unclaimed region beginning there. Enter `Ready` +only after initialization succeeds. Reentry during initialization traps; no host +callback occurs while allocator state is mutably borrowed. Invalid input and +zero-sized calls follow the same validation contract described below. + +The provider's globals and active static data initialize only its declared +reservation. The Rust artifact is emitted directly, with LTO enabled and no +binary rewriting. Its allocator phase, registry head and `dlmalloc` instance +form one static `State` in `src/allocator/wasm.rs`, initialized by an active data +segment. The portable algorithm, phase protocol and segment planner are sibling +modules; shared binding/storage contracts live in `src/abi/allocator.rs`, and +the pinned artifact and unit metadata live in `src/catalog/allocator.rs`. The build uses +`--stack-first -zstack-size=32768 --global-base=32768`: static data owns +`[32768, 65536)`, and the permitted stack suffix is `[16384, 32768)`. +Static frame analysis must prove that execution stays in this suffix, above +canonical scratch; LLVM's unused lower stack prefix is not allocator storage. +No executable start or eager constructor is allowed. This lazy protocol avoids an initializer call before component shims resolve. + +### Memory provisioning + +Use a custom implementation of the crate's underlying `Allocator` contract, +separate from the canonical adapter. Maintain a checked acquisition cursor whose +initial value is `heap_start`; acquire suitably aligned segments from the unused +interval up to current `memory.size` before requesting additional pages. +Honor all upstream segment size/alignment/zeroing guarantees, not only requested +payload sizes. Segment ownership transfers to `dlmalloc` only on success. + +Compute page growth and address arithmetic with overflow checks. Only this +provider grows the shared memory. On `memory.grow` failure, return allocation +failure without advancing the acquisition cursor or publishing a segment; the +adapter converts failure to the required trap. Zero only ranges the provider +owns if zeroing is needed. Do not rewrite live data after growth. + +Wasm pages are retained: unsupported shrink/remap/release operations report that +they are unavailable according to the crate API. Free blocks remain reusable +inside `dlmalloc`; freeing a buffer need not shrink `memory.size`. Other runtime +units using the heap must call this provider, not claim pages through another +Rust global allocator or grow the memory independently. + +### Canonical adapter and allocation evidence + +The adapter owns canonical input validation and allocation identity; `dlmalloc` +owns bins, free lists, coalescing and block reuse. Do not recreate these algorithms. +Do not pass unchecked caller lengths/alignment into unsafe crate methods. + +Maintain runtime-owned records of live canonical allocations: user pointer, +requested length, backing pointer, backing size/alignment, and links for a live +allocation registry. Records may be stored in an aligned prefix of each backing +allocation. Locate a supplied user pointer by traversing trusted live records, +not by first dereferencing a caller-derived header address. A pointer not in the +registry traps. Validate non-null resize length against the stored requested length. + +This registry checks the canonical contract and supplies true backing layouts +for Rust deallocation. It is not a second free-list allocator. Its traversal +cost is explicit; optimize lookup only with equivalent ownership checks. It +cannot distinguish a stale numeric pointer from a new live allocation reusing +that address, and it makes no stronger temporal-safety claim. + +Use allocate/copy/free for resize when necessary, including alignment changes. +The canonical alignment argument need not equal the backing allocation's original +alignment, so it cannot blindly be used as Rust's old layout. In-place resize is +an optimization requiring correct record updates and the same failure guarantees. + +## Algorithms + +1. Validate `align` as a nonzero power of two for every call, including zero sizes. + Apply checked payload/prefix/alignment arithmetic before allocator mutation. +2. For `new_len == 0`, locate and free any non-null live allocation using its + stored backing layout, unlink its record, and return zero. Preserve the + existing free-path old-length treatment; do not pass that length to Rust. +3. For nonzero allocation with null `old_ptr`, require `old_len == 0`. Allocate + backing storage, form an aligned user range, and register it only on success. +4. For nonzero resize, require a live pointer and matching stored requested length. + Allocate a replacement with the requested alignment, copy exactly + `min(old_len, new_len)` bytes, then release the old backing allocation and + replace the live record. Allocation failure leaves the old allocation intact. +5. Translate null/failure into a trap; never publish a successful-looking pointer + or lose the old block before replacement succeeds. + +Metadata registry operations must not recursively allocate. Its records live +in the backing blocks; registry roots and acquisition state live in declared +provider storage. All internal deallocations use actual backing size/alignment. + +## Code map + +| Owner | Intended responsibility | +| --- | --- | +| Runtime allocator unit: adapter | Canonical dispatch, validation, live records, copy/free behavior | +| Runtime allocator unit: provisioning | `dlmalloc` underlying memory provider, checked cursor/growth | +| Runtime allocator unit: state | One instance, registry roots, lazy initialization and reentry guard | +| Runtime catalog | Exact bytes/digest, imports/exports, reservations, initialization and growth ownership | +| Backend lowering | Provider requirement, canonical forwarder, codecs and cleanup routing | +| Target planner/composer | Heap getter/memory binding, state ownership, shim order and emitted-byte verification | + +These are design responsibilities, not claims that modules already exist. + +## Invariants and verification + +Preserve ALC-01–ALC-07 behavioral obligations, replacing implementation-specific +free-list/header evidence with provider evidence. Lifetime lowering stays unchanged +in meaning. Dynamic-store admission recognizes the checked allocator operation +and its result extent, independently of whether the implementation is generated +or artifact-provided. + +The application verifier must stop assuming the old generated allocator's +8-byte state format when an artifact provider is selected. Check actual memory, +constant heap-getter export, forwarding signature/binding and owned data ranges against +the plan. Verify runtime state initialization in its own declared artifact contract. +Do not retain an unused old state region or permit arbitrary state bytes by default. + +Required executed evidence covers alignment, alignment-changing resize and copied +values; invalid alignment, null/length mismatch, unknown pointer and resize-length +mismatch rejection; free/reuse; growth and grow failure; old-allocation preservation; +repeated call-local/import-result cleanup; export post-return; bounds/provenance; +lazy first call and reentry; one state across canonical and generated calls; +and numeric runtime operations interleaved with allocation/growth. + +Binary validation checks signatures and target features. Imported calls normally +make static stack bounds unknown. The heap getter is the sole protocol exception: +artifact verification records a conditional zero-linear-stack contribution, +and application verification discharges it by checking the exact signature, +absence of locals, and constant-only body against the checked plan. Other imported +calls remain rejected by stack analysis. Artifact inspection checks +bindings, reservations and initialization shape. Runtime tests establish behavior; +they do not prove the Rust implementation free of all unsafe-code defects. +No obligation is Verified until its required execution actually runs. + +### Heap-getter binding evidence + +`crates/psrs-linker/tests/heap_getter.rs` composes the same pinned allocator +with application heap boundaries of 65536 and 262144 bytes. Mandatory-Wasmtime +execution exercises allocation beyond initial memory, resizing with content +preservation, freeing, and preservation of canonical scratch. Rejection cases +cover signature drift, missing exports, wrong constants, locals, memory access, +and calls from the getter. The existing backend post-return tests execute +string-buffer reclamation through the composed allocator. + +Reproduce the direct allocator artifact without overwriting the reviewed bytes: + +```sh +sh crates/psrs-runtime/tools/build-allocator.sh /tmp/psrs-allocator.wasm +cmp crates/psrs-runtime/artifact/psrs_allocator.wasm /tmp/psrs-allocator.wasm +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-linker --test heap_getter +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib wasm::lower::post_return +``` + +These checks establish the getter binding and the exercised allocator paths; +they do not close every allocator acceptance obligation listed above. + +## Worked example + +The plan reserves numeric-runtime static data/stack and allocator metadata, then +exports the resulting heap boundary from the application. Composition binds +memory/getter imports and resolves the canonical forwarding shim without calling +it during instantiation. A string codec's first allocation initializes the runtime +provider, which uses preallocated heap pages before growing memory. + +The codec writes bytes and invokes a canonical import. Call-local cleanup frees +the registered allocation through the same entry. Repeated calls reuse storage; +retained GC strings and numeric-runtime state survive heap growth. + +## Boundaries and interfaces + +The crate owns heap algorithms; the custom memory provider owns page acquisition; +the adapter owns canonical validation and allocation records; the linker owns +layout and bindings; ABI lowering owns lifetime and post-return timing. These +contracts compose without a WIT interface per runtime unit or source module. + +## Open questions and future work + +The pinned runtime build, custom provisioning, checked getter binding, and +allocator-provider lowering are implemented, and the generated allocator has +been removed. The binding and execution evidence above covers the exercised +paths, not every allocator or buffer-lifetime acceptance obligation. Complete +the remaining requirement-to-test evidence before marking this topic verified. +Measure artifact size and registry lookup cost separately. + +## References + +- [Rust dlmalloc 0.2.14](https://docs.rs/dlmalloc/0.2.14/dlmalloc/) +- [Dlmalloc instance API](https://docs.rs/dlmalloc/0.2.14/dlmalloc/struct.Dlmalloc.html) +- [Underlying allocator contract](https://docs.rs/dlmalloc/0.2.14/dlmalloc/trait.Allocator.html) +- [Canonical buffer allocation acceptance](../../../implementation/backend/canonical-buffer-allocation.md) +- [Issue #144](https://github.com/biuld/purescript-rs/issues/144) diff --git a/docs/design/backend/wasm/core-object-linking-and-compilation-units.md b/docs/design/backend/wasm/core-object-linking-and-compilation-units.md new file mode 100644 index 00000000..1d8684b5 --- /dev/null +++ b/docs/design/backend/wasm/core-object-linking-and-compilation-units.md @@ -0,0 +1,358 @@ +# Compilation Units and Runtime Linking + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md)\ +**Status:** Draft\ +**Prerequisites:** [IR boundaries](../00-ir-boundaries.md), [encoding](encoding-and-structuring.md), [linking and runtime](linking-and-runtime.md), and [canonical ABI and WIT](canonical-abi-and-wit.md).\ +**Summary:** Separate source checking, codegen grouping, Core linking, and component deployment. Give compiled source and structured runtime units one checked provider graph, implemented by the compiler and `psrs-linker`. Assemble application code in Core, lower it to MIR, assign final Wasm indices, and compose its runtime Core Modules into a component without an external application object linker. + +## Scope + +This topic owns compilation-unit boundaries and the integration of compiled +source with runtime implementations for [issue #144](https://github.com/biuld/purescript-rs/issues/144). +The linker consumes target requirements and executable artifacts; it does not +parse or typecheck PureScript source. Backend lowering owns GC representations, +closure conventions, and source-to-target evidence. WIT owns external interface +contracts. The [allocator adapter](canonical-realloc-runtime-adapter.md) owns +allocator selection and canonical allocation behavior. + +The design uses compiler-owned Core assembly and target linking. Application +objects, archives, relocations, and invocation of an external object linker are +out of scope. Runtime artifact production uses its language toolchain separately; +consuming a pinned runtime artifact does not require that toolchain at app build time. + +## Background + +The existing driver lowers source modules with `lower_module_unverified`, merges +them with `psrs_core::link`, selects/prunes the entry graph, and verifies the +linked result. The backend optimizes and emits one application Core Wasm module. +`psrs-linker` resolves WIT definitions, checks runtime providers and memory, +and composes libraries using `ComponentEncoder::library`. Its guest API composes +explicit component-interface providers separately. + +Source assembly, library composition, and guest composition are implemented +mechanisms. Persistent checked-Core caching remains a design target. The runtime +unit graph below is implemented by the `psrs-runtime` catalog and +`psrs-linker::plan`: each live operation selects one compatible unit, required +operations join that closure, and conflicting state, growth, memory identity, or +instantiation order is a planning error. A resolved source name is not proof +that an executable runtime implementation exists. + +| Operation | Input | Output | +| --- | --- | --- | +| Source/Core assembly | Lowered source modules and checked dependencies | Verified linked Core | +| Runtime Core library composition | Application plus verified runtime Core Modules | Component containing collaborating Core instances | +| Guest composition | Components and explicit interface bindings | Composed component | + +WIT files are definitions, not executable providers. An ordinary language import +creates neither a WIT interface nor a canonical ABI boundary. Private runtime +Core imports have raw checked ABIs and may share memory without canonical lifting. + +## Model + +### Independent compilation units + +| Unit | Owner | Contract | +| --- | --- | --- | +| Source module | Frontend/driver | Module identity, checked declarations, imports and semantic dependency evidence | +| Codegen unit | Compiler planner/backend | The assembled application closure; one application emission unit in this design | +| Application assembly/emission unit | Compiler Core assembler and backend | Root/export closure assembled into one verified Core module and emitted as one Core Wasm module | +| Component unit | Deployment configuration/linker | Selected WIT world, application and runtime providers | + +### Minimum units and concrete outputs + +The minimum independently checked source unit is one PureScript module, with its +imported semantic environment. Its compiler output is module Core plus dependency +contracts, not a dedicated Wasm `.o` and not WIT. A `.purs` path is not an +artifact identity. A declaration or function is a reachability/optimization item, +not an independently deployable unit. + +The minimum application Wasm emission unit is one executable dependency closure: +selected entry/export roots plus all reachable source declarations and required +representation definitions, assembled into one verified Core module. A trivial +program can have a single source module in that closure; an importing program +includes the reachable definitions it needs. This is a logical dependency closure, +not a rule that every declaration in every imported source file must be emitted. +Until explicit library export roots are implemented, command entry roots remain +the supported application mode; do not treat an absent entry as an empty program. + +A runtime implementation unit produces one independent Core Wasm module with +checked imports/exports, storage and initialization contracts. Stateful operations +that must share one instance stay in that unit. A component contains the application +Core module and selected runtime instances, exposed through one selected WIT world. +It can therefore contain several Core modules while the application has one emitter. + +A complete application build produces application Core Wasm bytes, a final +component, and a link report identifying both artifacts and their input contracts. +Persistent source-module cache bytes are a separate future compiler-owned format. +There is no application object-file intermediate in this design. + +Before publishing a source-module cache as checked, verify its local invariants +against explicit imported contracts, then recheck linked closure when composing +modules. The current unverified per-module lowering cannot directly become this +cache API. Cache keys must include source/package identities, compiler/IR schema, +semantic dependency evidence, target-sensitive assumptions, and policy versions. +Loading must remap session-local IDs through stable identities and preserve +source origins; serialized numeric IDs alone are not persistent identities. + +### Runtime packages and units + +Runtime catalog data remains owned by `psrs-runtime`; extend that catalog rather +than introduce competing backend and linker registries. + +```text +RuntimePackage = identity + version + provenance + units +RuntimeUnit = { + identity, semantic_contract_version, + provided_operations, required_operations, + artifact_variants, + state_ownership, storage_constraints, initialization_contract +} +ArtifactVariant = { + kind: CoreModule | Component, + bytes_and_digest, build_recipe, required_features, + exports_and_imports, calling_contracts +} +``` + +Units group operations that share implementation or state. They are neither +mandatorily monolithic nor one function each. Unit boundaries need not match +PureScript modules or WIT interfaces. Advertise only variants actually produced +and verified. Cross-kind alternatives require explicit semantic and state +compatibility; equal symbol names are insufficient. + +A consumer requirement includes operation identity/version, origin, expected +ABI, and provider constraints. Primitive semantics stay in HIR/library contracts; +GC representation evidence stays backend-owned. The linker consumes target-only +checked descriptors and does not invent a second source or GC type system. +Provider metadata must be checked against independently produced consumer evidence. + +```text +TargetProviderGraph = { + roots: application requirements + generated helpers + retained initialization, + selected_units_and_variants, resolved_edges, + memory_and_state_constraints, initialization_dependencies, + permitted_external_world, input_digests +} +``` + +Each live requirement has exactly one selected compatible provider. Runtime-unit +dependencies join the same graph as source-generated requirements. Duplicate +state owners, ambiguous providers, unsupported cycles, and missing metadata are +planning errors. Selection is explicit and deterministic; a failed route must +not silently choose another provider or artifact kind. + +## Design + +### Our linker and its execution routes + +```mermaid +flowchart TD + source[Source modules] --> core[Linked and verified Core] + core --> lowering[Backend lowering and target requirements] + catalog[Structured runtime catalog] --> graph[Checked target provider graph] + lowering --> graph + graph --> direct[Compiler-owned single application emission] + direct --> app[Verified application Core Wasm] + app --> libraries[Checked runtime Core library composition] + graph --> libraries + world[Selected WIT world] --> libraries + libraries --> component[Application component] + component --> guests[Optional guest-component composition] + graph --> guests +``` + +| Provider variant | Route | +| --- | --- | +| Core Module | Existing checked runtime-library composition | +| Component | Explicit guest interface composition | +| Permitted host interface | Residual import allowed by the selected world and target policy | + +`psrs_core::link` implements language-level assembly. `psrs-linker` implements +provider resolution, contract checking, memory planning, and artifact composition. +The backend implements representation lowering and final index assignment. These +are parts of our linker/compiler architecture, not delegation to an external +object linker. Existing `wasm_encoder`, `wasmparser`, and `ComponentEncoder` +provide encoding/validation machinery under these checked contracts. + +Runtime artifact production may itself use Rust/LLVM linking. The application +build consumes pinned Core module bytes and needs no runtime-source build tools. +The target linker connects Core function imports to exports through component +aliases/instances; it does not concatenate binary sections or patch call indices +inside prelinked runtime modules. + +### Source assembly and emission policy + +Source resolution, type checking, Core assembly, and target linking are different +operations with different identities. Core assembly preserves resolved symbols +and rebases module-local type IDs; backend passes introduce their own valid IDs. +Final Wasm indices belong to encoding and are not semantic identities. + +Whole-program optimization runs on verified linked Core before backend lowering. +A module cache avoids repeated frontend work; changing application dependencies +still rebuilds linked Core and application Wasm. The design does not promise +independent native-code reuse per source module. + +### How linked Core becomes Wasm + +1. **Assemble Core:** preserve resolved declaration symbols and source origins; + rebase module-local Core type/variable IDs and retain imported evidence. + Select entry/export roots, compute reachability, and verify the linked module. +2. **Optimize Core:** simplify, inline and specialize within checked budgets. + Reverify the result; generated declarations retain parent origins. +3. **Lower to CC:** make evaluation order and closure captures explicit, retaining + checked calling and representation evidence across module boundaries. +4. **Lower to MIR:** choose concrete scalar/GC layouts, recursive type dependencies, + closure signatures, explicit target calls and ABI recovery/lifetime operations. + MIR is the lowest compiler IR; verify it before encoding. +5. **Plan target providers:** close live MIR/helper/runtime requirements and plan + storage. All imported callable signatures come from independently checked + consumers and verified providers. Rebuild the plan if optimization changes them. +6. **Assign final indices:** order GC recursive type groups under the backend's + representation rules; allocate imported functions before defined functions; + map MIR function IDs, types, globals, tables and data to final Wasm indices. + Resolve direct calls, `ref.func` and typed `call_ref` through these maps. + Missing entries and incompatible shapes are errors, not inferred defaults. +7. **Structure and encode:** convert MIR CFGs to structured Wasm control flow, + encode type/import/function/table/memory/global/export/code/data sections as + required, and validate application bytes under the selected feature profile. + There is no relocation pass after these indices are assigned. +8. **Compose:** `psrs-linker` checks emitted bytes against the immutable plan, + binds private runtime imports, supplies shared memory and required globals, + resolves supported shims, and builds canonical bindings for the selected world. + Validate the component and its exact external imports before publication. + +Binary validation establishes Wasm typing, not source-level layout semantics; +backend producer evidence and IR verifiers establish the latter. Runtime Core +modules keep their own index spaces; component instance bindings connect them. + +### Runtime storage and initialization + +The graph collects all selected runtime reservations before emission. One +`MemoryPlan` owns each shared memory's identity, static data, stacks, canonical +scratch, allocator state, heap boundary/alignment, and minimum/maximum limits. +The linker verifies declared reservations against artifact bytes and rejects +overlap, overflow, unsupported memory profiles, and conflicting growth owners. +Pointer equality across distinct component memories does not establish ownership. + +The allocator provider imports the application's memory and a checked immutable +heap-boundary value. Its state, first-call initialization, and exclusive growth +protocol are specified by the adapter topic. Other runtime units must allocate +through that provider if they need the same heap; they cannot create independent +Rust global allocators over it. + +Initialization dependencies distinguish passive instantiation, shim resolution, +and calls. Current unsupported executable starts remain rejected. Lazy provider +initialization must occur only after its memory/global bindings and shims are +resolved. No initialization may invoke an unresolved dependency. Future explicit +initializers require an extended checked execution plan before use. + +### Why linking happens before application encoding + +Core retains language types, declarations, dictionaries and semantic evidence +needed for valid cross-module composition. Linking those inputs before GC layout +and index assignment lets one backend establish representation consistency. +Runtime Core modules instead expose explicitly checked target ABIs; the linker +connects their instances without reinterpreting language declarations. + +This choice is based on ownership and output contracts. It does not rely on an +unreproduced external-tool failure or claim that no external linker exists. +Application object-file linking is not part of this design. + +## Algorithms + +1. Resolve/check source dependencies, lower and assemble Core, verify the linked + result, and optimize under the selected policy. +2. Lower checked operations into target requirements with consumer ABI evidence. +3. Resolve root requirements against runtime units, recursively adding provider + dependencies and retained initialization needs. Reject ambiguous closure. +4. Verify exact artifact bytes/features/exports and establish state ownership. +5. Plan shared storage, growth ownership, and initialization/shim ordering. +6. Emit the linked application through the compiler-owned backend and validate + its Core Wasm bytes under the selected target profile. +7. Inspect application conformance to the same checked provider/memory plan. +8. Compose runtime libraries and explicit guest providers. Verify the residual + external world and final component before publishing a successful artifact. + +Optimization that changes live requirements invalidates the old plan. Preserve +requirement origins, input/output digests, tool versions, and phase-specific +errors through every step. Never infer a new semantic binding from emitted names. + +## Code map + +| Owner | Intended API/responsibility | +| --- | --- | +| Driver/compiler planner | Checked module dependencies, Core assembly, grouping/cache policy | +| Backend | Core → CC → MIR, representation evidence, CFG structuring and final Wasm emission | +| `psrs-runtime` catalog | Runtime packages/units, pinned variants, ABI/state/storage metadata | +| `psrs-linker` target planner | `plan(context, input)` resolves the provider graph and immutable execution constraints | +| Target composer | Execute checked Core library bindings and initialization protocol | +| Guest planner/composer | Explicit WIT providers and component resource/instance identity | + +These are design responsibilities. Extend existing APIs where ownership already +exists; introduce no placeholder modules merely to match this table. + +## Invariants and verification + +| Requirement | Required evidence | +| --- | --- | +| Source boundaries | Cross-module calls, imported types and captured closures execute after Core assembly; no WIT boundary per source import | +| Checked caches | Invalid imported contracts/IDs rejected; loading preserves origins and identity; dependency changes invalidate entries | +| Runtime closure | Source root reaches transitive runtime dependency; missing/ambiguous/incompatible providers rejected | +| State/storage | Duplicate allocator owners and overlapping stack/static/heap reservations rejected; growth preserves live values | +| Initialization | Dependencies bound before first call; unsupported starts and eager cycles rejected | +| Composition | Runtime Core calls and selected guest interfaces execute; private runtime imports close and external world is exact | +| Emission | Direct calls, recursive GC types, `ref.func`, typed closure calls and index maps validate and execute across source-module boundaries | +| Artifact lineage | Link report pins source/package contracts, runtime bytes, application bytes and composed component with exact digests | + +Evidence records sources, exact commands, compiler/runtime versions, feature +profile, hashes, validator and execution results, including failures. A skipped +runtime case remains unverified. Negative tests cover missing symbols/contracts, +invalid MIR references, incompatible raw ABIs and unexpected imports. No completed +runtime-unit or cache acceptance is claimed by this draft. + +## Worked example + +An application imports a PureScript library that formats a Number and emits a +string through WASI. Source checking/Core assembly resolves the library's +language declarations without WIT per source module. Lowering produces checked +requirements for numeric formatting, ABI buffer allocation, and the WASI call. + +The provider graph selects a numeric runtime unit, the allocator unit, and the +permitted host interface. It closes runtime dependencies and plans disjoint +storage. The current emitter builds one application Core Module with private +runtime function imports. Composition supplies both Core runtime instances and +shared memory bindings. The allocator initializes lazily after bindings resolve; +the application calls formatting and cleans up buffers through the same provider. +The resulting component exposes only the selected external world. + +## Boundaries and interfaces + +Core assembly links language declarations. Target planning links executable +requirements. Runtime composition connects Core instances. Component composition +connects explicit WIT interfaces. They share provenance and checked constraints, +not a universal symbol/type namespace. + +MIR remains the lowest compiler IR. Encoded Wasm is a target artifact. Runtime +unit ABI metadata cannot replace source typing or backend representation evidence. +WIT definitions never supply executable implementations by themselves. + +## Open questions and future work + +The [canonical realloc adapter](canonical-realloc-runtime-adapter.md) replaces +the generated allocator. Its pinned `dlmalloc` provider and imported immutable +heap-boundary global are not implemented. Until that unit is selected, backend +demands name `psrs:allocator/generated` as the only growth owner. Planning +already accepts a selected runtime unit when the demand names that unit, and +rejects every other selected unit that grows the same memory. Establish a persistent +checked-module format and validation contract before implementing caching. +Explicit library export roots, additional memory profiles, and executable +initialization effects each need their own checked contract. The current +implementation status must remain separate from the design above. + +## References + +- [Issue #144](https://github.com/biuld/purescript-rs/issues/144) +- [Linking and runtime](linking-and-runtime.md) +- [Canonical realloc runtime adapter](canonical-realloc-runtime-adapter.md) +- [Wasm encoding and structuring](encoding-and-structuring.md) +- [Core and MIR boundaries](../00-ir-boundaries.md) diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index 6f274888..93423913 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -50,6 +50,16 @@ relocations. WIT component composition uses canonical lift/lower boundaries. These differ from source-module linking, which unifies checked language declarations before backend lowering. +[Compilation units and runtime linking](core-object-linking-and-compilation-units.md) +specifies source/Core/Wasm/component units, compiler-owned application emission, +and the structured runtime dependency graph. Application code is assembled in +Core and encoded by our backend; runtime Core Modules are connected through +checked instance bindings, without an external application object linker. The +runtime unit graph is implemented. Persistent module caching remains a draft. +[Canonical realloc runtime adapter](canonical-realloc-runtime-adapter.md) +specifies the allocator provider, memory provisioning and lazy initialization. +That adapter is a draft and is not a claim of completed implementation. + ### Intrinsic implementations The same checked intrinsic may be realized by a direct Wasm instruction, a @@ -100,7 +110,7 @@ BindingRequirement = { origin: source_symbol/span | generated_operation/parent_origin, boundary: CheckedPrimitive | ResolvedWit | RawCore, expected_contract, - provider: Generated | ArtifactExport | HostInterface + provider: Generated | RuntimeOperation | HostInterface } LinkPlan = { @@ -110,8 +120,11 @@ LinkPlan = { } ``` -Catalog metadata has one owner. Lowerers request an implementation by checked -identity and consume its ABI/recovery descriptor. Artifact inspection verifies +Catalog metadata has one owner. A runtime operation carries an identity and +version. The planner selects one compatible catalog unit and closes that unit's +required operations; a caller-supplied artifact id is not the provider. Lowerers +request an implementation by checked identity and consume its ABI/recovery +descriptor. Artifact inspection verifies that descriptor against real exports; it does not independently define it. The public library API and source scheme remain with the library and HIR. @@ -202,6 +215,25 @@ code and host-consumed catalog metadata have distinct build entry points so reading WIT assets does not require compiling the formatter into the native compiler or embedding WIT text in the executable target module. +The package remains one crate, with four module owners: + +- `src/abi/` defines data-only raw signatures, transport protocols, binding names, + and numeric/allocator storage contracts. It embeds no artifact or WIT bytes. +- `src/catalog/` contains plain metadata records, WIT assets, package membership, + and separate numeric/allocator declarations. Each unit's operation offers and + pinned artifact contract are declared together. +- `src/number/` implements formatting, decimal parsing, and scalar math. The + existing `formatter` feature remains its build entry for compatibility. +- `src/allocator/` separates portable allocation validation, phase handling and + segment planning from the Wasm adapter and its persistent state. + +`lib.rs` selects these modules and preserves the existing root-level exports. +One Wasm-only panic handler supplies trap behavior for either executable build; +the numeric and allocator features remain mutually exclusive on Wasm. Native +compiler consumers enable only `catalog`, while each artifact build enables only +its executable feature. `tools/check-reproducible.sh` rebuilds and compares both +pinned artifacts through their respective build scripts without overwriting them. + The resolved default world supplies interface membership. Capability policy is checked separately against the selected target profile. Do not retain a second handwritten `COMPONENT_INTERFACES` list as an independent source of permitted @@ -384,7 +416,10 @@ psrs-linker/definitions/ WIT loading and immutable resolved-world context psrs-linker/plan/ provider closure, memory and initialization planning psrs-linker/compose/ ComponentEncoder integration and final validation psrs-linker/verify/ artifact contracts and emitted-plan agreement -psrs-runtime/ immutable target catalog and target code +psrs-runtime/src/abi/ shared raw ABI and storage contracts +psrs-runtime/src/catalog/ immutable assets, unit declarations and package metadata +psrs-runtime/src/number/ executable numeric runtime +psrs-runtime/src/allocator/ portable allocator algorithms and Wasm adapter psrs-runtime/wit/ pinned definitions and default command world psrs-runtime/artifact/ core-Wasm bytes, contracts and build provenance psrs-stdlib/lib/ public APIs and ordinary PureScript wrappers diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index 3f182c62..3433f78f 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -223,3 +223,70 @@ the provider catalog and therefore did not verify the consumer. New rejection fixtures cover parameter width/count, missing/wrong results and GC references; reserved generated helpers also reject wrong signatures and string layouts. See [the measured acceptance record](intrinsic-implementations-2026-10-07.md). + +## Runtime unit graph checkpoint (2026-10-09) + +`psrs-runtime` publishes one package, `psrs:runtime`, whose number unit +advertises each pinned numeric export as an operation. `psrs-linker::plan` +selects a unit from that operation's identity and version, closes required +operations, and records the selected units, edges, shared-memory import, growth +owner, and instantiation order on the checked plan. A caller-supplied artifact +id is not a provider. + +At this graph-only checkpoint, backend demands named the generated allocator, `psrs:allocator/generated`, +as the only growth owner. The [canonical realloc adapter](../../design/backend/wasm/canonical-realloc-runtime-adapter.md) +replaces that owner with one allocator runtime unit; planning accepts the +replacement when the demand names the selected unit. The `dlmalloc` provider and its heap-boundary binding were not yet implemented +at this checkpoint. Persistent checked-Core caching remains unimplemented. + +This checkpoint was measured with its locked catalog bytes. Full workspace tests +and corpus scoreboards were not run for that checkpoint. + +| Command | Result | +| --- | --- | +| `cargo test -p psrs-linker` | 56 passed: 17 unit, 6 compose, 11 graph, 10 guest, 12 plan | +| `cargo test -p psrs-runtime --lib units::` | 1 passed; the other 12 runtime tests were not re-run | +| `cargo test -p psrs-backend --lib linking::` | 2 passed | +| `cargo test -p psrs-backend --lib target_runtime::` | 3 passed | +| `cargo test -p psrs-backend --lib post_return::` | 3 passed | +| `cargo test -p psrs-backend --lib number_format_tests` | 1 passed | +| `cargo test -p psrs-driver --lib tests::diagnosis_trace::target_plan_records_provider_and_memory_lineage` | 1 passed | +| `cargo fmt --all --check` | Passed | +| `cargo clippy -p psrs-linker -p psrs-runtime -p psrs-backend --all-targets -- -D warnings` | Passed | + +## Allocator provider and runtime module integration (2026-10-09) + +Backend demands now select `psrs:runtime/allocator` as the sole memory growth +owner. The application exports a checked constant `get_heap_base: () -> i32`, +and the pinned `dlmalloc` artifact imports it through the application-export +namespace. Application verification checks the getter signature and constant-only +body against the memory plan before composition. The provider initializes lazily +on the first canonical call; all allocation, resizing, freeing and post-return +cleanup use the same instance. The synthesized free-list allocator is removed. + +The package remains one crate, with `abi`, `catalog`, `number` and `allocator` +module owners. Numeric and allocator builds share trap-based panic handling; +the catalog embeds their separately produced artifacts. The numeric artifact +was repinned after moving implementation modules changed diagnostic text and +static data offsets. The allocator artifact remained byte-for-byte identical. + +Validation of this integrated state: + +| Command | Result | +| --- | --- | +| `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace` | Passed, including 408 backend and 716 driver library tests; runtime-gated execution was mandatory | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-linker --tests` | 61 passed: 18 unit, 6 compose, 11 graph, 10 guest, 4 heap-getter, 12 plan | +| `cargo test -p psrs-runtime --all-features --lib` | 17 passed, including portable allocator algorithms | +| `cargo clippy --workspace --all-targets -- -D warnings` | Passed | +| `cargo clippy -p psrs-runtime --all-targets --all-features -- -D warnings` | Passed | +| `cargo fmt --all --check` | Passed | +| `sh crates/psrs-runtime/tools/check-reproducible.sh` | Both pinned artifacts reproduced byte-for-byte | + +The heap-getter execution cases cover distinct application heap boundaries, +allocation beyond initial memory, resizing with content preservation, freeing, +and canonical-scratch preservation. Rejection cases cover getter signature, +constant, locals, memory access and call effects. Existing backend post-return +tests execute string-buffer reclamation through the composed provider. + +Corpus scoreboards were not remeasured. This evidence does not close all +allocator and buffer-lifetime acceptance obligations or persistent Core caching. From a80525899ac13b4188e98aa1904821901ca20353 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:07:37 +0800 Subject: [PATCH 082/148] Introduce generic State primitives and runtime externals --- crates/psrs-hir/src/intrinsic/effects.rs | 2 +- crates/psrs-hir/src/intrinsic/mod.rs | 45 +- crates/psrs-hir/src/intrinsic/registry.rs | 4 + crates/psrs-hir/src/intrinsic/state.rs | 82 +++ crates/psrs-hir/src/lib.rs | 17 +- crates/psrs-hir/src/primitives/mod.rs | 2 + crates/psrs-hir/src/primitives/state.rs | 25 + crates/psrs-hir/src/primitives/tests.rs | 26 + crates/psrs-resolve/src/resolver/bootstrap.rs | 5 +- .../src/resolver/module_resolution.rs | 5 + .../psrs-typecheck/src/typecheck/infer/mod.rs | 1 + docs/design/backend/fp/effects.md | 6 + .../backend/fp/library-owned-effects.md | 654 ++++++++++++++++++ .../frontend/semantics/foreign-imports.md | 5 + docs/design/frontend/type-system/prim.md | 5 + 15 files changed, 866 insertions(+), 18 deletions(-) create mode 100644 crates/psrs-hir/src/intrinsic/state.rs create mode 100644 crates/psrs-hir/src/primitives/state.rs create mode 100644 docs/design/backend/fp/library-owned-effects.md diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 4613d5e7..03f497e3 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -11,7 +11,7 @@ impl IntrinsicEffects { pub(super) fn for_intrinsic(intrinsic: Intrinsic) -> Self { use Intrinsic::*; match intrinsic { - ArrayWrite => Self { + ArrayWrite | RunWorld | RunRegion => Self { may_trap: true, may_write: true, }, diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 8a8a3822..5dfc890a 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -8,9 +8,11 @@ mod effects; mod registry; +mod state; pub use effects::IntrinsicEffects; pub use registry::{IntrinsicCategory, IntrinsicDescriptor}; +pub use state::StateOperation; use crate::{ModuleId, SymbolId}; @@ -164,9 +166,23 @@ pub enum Intrinsic { NumberNaN = 85, /// Positive infinity. NumberInfinity = 86, + RunWorld = 87, + RunRegion = 88, } impl Intrinsic { + /// State operations are available only through explicit checked bindings. + pub fn state_operation(self) -> Option { + Some(match self { + Self::RunWorld => StateOperation::RunWorld, + Self::RunRegion => StateOperation::RunRegion, + _ => return None, + }) + } + + pub fn is_bootstrap(self) -> bool { + self.state_operation().is_none() + } pub const fn symbol(self) -> SymbolId { SymbolId::new(ModuleId::INTRINSICS, self as u32) } @@ -184,12 +200,13 @@ impl Intrinsic { .find(|value| value.descriptor().name == name) } - /// Retired floor-division identities; these slots must never be reused. - pub const RESERVED_IDS: [u32; 2] = [26, 27]; + /// Retired floor division and experimental storage intrinsic identities. + /// Storage now uses ordinary runtime bindings; slots must never be reused. + pub const RESERVED_IDS: [u32; 5] = [26, 27, 89, 90, 91]; - /// Every active variant, in discriminant order. `bootstrap_externals` builds the - /// compiler-known externals from it; the assertion below keeps it exact. - pub const ALL: [Intrinsic; 85] = [ + /// Every active variant, in discriminant order. Binding resolution uses the + /// complete list; bootstrap resolution selects only exposed operations. + pub const ALL: [Intrinsic; 87] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -275,6 +292,8 @@ impl Intrinsic { Intrinsic::NumberIsNaN, Intrinsic::NumberNaN, Intrinsic::NumberInfinity, + Intrinsic::RunWorld, + Intrinsic::RunRegion, ]; } @@ -283,13 +302,21 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() - == Intrinsic::NumberInfinity as u32 as usize + 1, + Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() == 92, "Intrinsic::ALL is out of date: update it when adding a variant", ); - let mut seen: u128 = - (1u128 << Intrinsic::RESERVED_IDS[0]) | (1u128 << Intrinsic::RESERVED_IDS[1]); + let mut seen: u128 = 0; let mut index = 0; + while index < Intrinsic::RESERVED_IDS.len() { + let bit = 1u128 << Intrinsic::RESERVED_IDS[index]; + assert!( + seen & bit == 0, + "Intrinsic::RESERVED_IDS repeats an identity" + ); + seen |= bit; + index += 1; + } + index = 0; while index < Intrinsic::ALL.len() { let bit = 1u128 << (Intrinsic::ALL[index] as u32); assert!(seen & bit == 0, "Intrinsic::ALL repeats a variant"); diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index eaa19d2f..e838bf42 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -43,6 +43,8 @@ pub enum IntrinsicCategory { Coercion, /// `Prim.undefined`: a value with no runtime representation. PartialValue, + /// An explicitly bound operation with a checked state contract. + State, } /// The metadata for one intrinsic. @@ -172,6 +174,8 @@ descriptors! { ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; NumberToString => "numberToString", 1, Unary, scheme::number_string; NumberFromDecimal => "numberFromDecimal", 1, Unary, scheme::string_number; + RunWorld => "runWorld", 1, State, super::state::run_world; + RunRegion => "runRegion", 1, State, super::state::run_region; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that diff --git a/crates/psrs-hir/src/intrinsic/state.rs b/crates/psrs-hir/src/intrinsic/state.rs new file mode 100644 index 00000000..e73ccecd --- /dev/null +++ b/crates/psrs-hir/src/intrinsic/state.rs @@ -0,0 +1,82 @@ +//! Explicit state operations and their source signatures. +use crate::{Type, TypeField, TypeId, TypeKind, TypeParameter}; +use psrs_span::TextRange; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum StateOperation { + RunWorld, + RunRegion, +} + +fn ty(kind: TypeKind) -> Type { + Type { + kind, + span: TextRange::new(0, 0), + } +} +fn variable(name: &str) -> Type { + ty(TypeKind::Variable(name.into())) +} +fn named(value: TypeId) -> Type { + ty(TypeKind::Named(value)) +} +fn apply(head: Type, argument: Type) -> Type { + ty(TypeKind::Application(Box::new(head), Box::new(argument))) +} +fn arrow(parameter: Type, result: Type) -> Type { + ty(TypeKind::Function { + parameter: Box::new(parameter), + result: Box::new(result), + }) +} +fn forall(names: &[&str], body: Type) -> Type { + ty(TypeKind::Forall { + variables: names + .iter() + .map(|name| TypeParameter { + name: (*name).into(), + name_span: TextRange::new(0, 0), + kind: None, + }) + .collect(), + body: Box::new(body), + }) +} +fn state(region: Type) -> Type { + apply(named(TypeId::PRIM_STATE), region) +} +fn step(region: Type, value: Type) -> Type { + let field = |label: &str, ty| TypeField { + label: label.into(), + label_span: TextRange::new(0, 0), + ty, + span: TextRange::new(0, 0), + }; + ty(TypeKind::Record { + fields: vec![field("state", state(region)), field("value", value)], + tail: None, + }) +} + +pub(super) fn run_world() -> Type { + let region = named(TypeId::PRIM_REAL_WORLD); + forall( + &["a"], + arrow( + arrow(state(region.clone()), step(region, variable("a"))), + variable("a"), + ), + ) +} +pub(super) fn run_region() -> Type { + forall( + &["a"], + arrow( + forall( + &["s"], + arrow(state(variable("s")), step(variable("s"), variable("a"))), + ), + variable("a"), + ), + ) +} diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index e876a9de..50b65083 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -106,16 +106,18 @@ impl TypeId { pub const PRIM_TYPE_ERROR_QUOTE_LABEL: Self = Self::new(ModuleId::INTRINSICS, 28); pub const PRIM_TYPE_ERROR_BESIDE: Self = Self::new(ModuleId::INTRINSICS, 29); pub const PRIM_TYPE_ERROR_ABOVE: Self = Self::new(ModuleId::INTRINSICS, 30); - /// The compiler-owned opaque state token an `Effect` closure takes. It has - /// no source spelling and one uninspectable value; it is the `State# - /// RealWorld` analogue of [effects](../design/backend/fp/effects.md), not a - /// source type. Its runtime shape is a scalar, but no source or later pass - /// may treat it as an `Int`. + /// Legacy compiler-owned Effect invocation trigger. It has no source + /// spelling and lowers to a scalar constant; it does not carry the generic + /// dependency semantics of PRIM_STATE. Retire after Effect/ST migration. pub const STATE_TOKEN: Self = Self::new(ModuleId::INTRINSICS, 31); + /// Generic state dependency carrier. Its region parameter has a nominal role. + pub const PRIM_STATE: Self = Self::new(ModuleId::INTRINSICS, 32); + /// Region marker for state operations on the external world. + pub const PRIM_REAL_WORLD: Self = Self::new(ModuleId::INTRINSICS, 33); } mod intrinsic; -pub use intrinsic::{Intrinsic, IntrinsicCategory, IntrinsicDescriptor}; +pub use intrinsic::{Intrinsic, IntrinsicCategory, IntrinsicDescriptor, StateOperation}; /// Symbol index base for source-declared `foreign import`s, which live in the /// reserved intrinsic module but above the intrinsic and WASI import ranges. @@ -138,6 +140,9 @@ pub enum ExternalKind { /// A source value explicitly bound to a compiler primitive. Its checked /// declaration type remains authoritative until target linking verifies it. Primitive(Intrinsic), + /// An explicitly named runtime provider/export. Source resolution records + /// identity only; target linking owns the checked ABI and implementation. + Runtime { module: String, function: String }, } impl ExternalKind { diff --git a/crates/psrs-hir/src/primitives/mod.rs b/crates/psrs-hir/src/primitives/mod.rs index 9c9f4777..a31a252f 100644 --- a/crates/psrs-hir/src/primitives/mod.rs +++ b/crates/psrs-hir/src/primitives/mod.rs @@ -7,6 +7,7 @@ use psrs_span::TextRange; mod core; mod numbers; mod rows; +mod state; mod type_error; #[cfg(test)] @@ -20,6 +21,7 @@ pub fn primitive_type_declarations() -> Vec<(&'static str, TypeDeclaration)> { rows::declarations(), numbers::declarations(), type_error::declarations(), + state::declarations(), ] .into_iter() .flatten() diff --git a/crates/psrs-hir/src/primitives/state.rs b/crates/psrs-hir/src/primitives/state.rs new file mode 100644 index 00000000..2f4bc213 --- /dev/null +++ b/crates/psrs-hir/src/primitives/state.rs @@ -0,0 +1,25 @@ +//! Target state facilities are separate from the official PureScript vocabulary. +use super::*; + +pub(super) fn declarations() -> Vec<(&'static str, TypeDeclaration)> { + vec![ + ( + "Prim.State", + foreign_type( + TypeId::PRIM_STATE, + "State", + forall_kind_result("k", vec![variable("k")], builtin(BuiltinType::Type)), + &[Role::Nominal], + ), + ), + ( + "Prim.State", + foreign_type( + TypeId::PRIM_REAL_WORLD, + "RealWorld", + builtin(BuiltinType::Type), + &[], + ), + ), + ] +} diff --git a/crates/psrs-hir/src/primitives/tests.rs b/crates/psrs-hir/src/primitives/tests.rs index 09b0c791..87e647cf 100644 --- a/crates/psrs-hir/src/primitives/tests.rs +++ b/crates/psrs-hir/src/primitives/tests.rs @@ -55,6 +55,7 @@ fn declared(owner: &str, name: &str) -> TypeDeclaration { fn every_official_primitive_member_is_declared_exactly_once() { let mut declared = primitive_type_declarations() .into_iter() + .filter(|(owner, _)| *owner != "Prim.State") .map(|(owner, declaration)| (owner.to_owned(), declaration.name.clone())) .collect::>(); declared.sort(); @@ -69,6 +70,31 @@ fn every_official_primitive_member_is_declared_exactly_once() { ); } +#[test] +fn target_state_is_opaque_and_its_region_is_nominal() { + let state = declared("Prim.State", "State"); + assert_eq!(roles(&state), vec![Role::Nominal]); + assert_eq!(state.id, TypeId::PRIM_STATE); + assert_eq!(state.kind, TypeDeclarationKind::Foreign); + assert!(state.constructors.is_empty()); + let TypeKind::Forall { variables, body } = &state.declared_kind.as_ref().unwrap().kind else { + panic!("State must quantify its region kind"); + }; + assert_eq!(variables.len(), 1); + let TypeKind::Function { parameter, result } = &body.kind else { + panic!("State must take exactly one nominal region"); + }; + assert_eq!( + parameter.kind, + TypeKind::Variable(variables[0].name.clone()) + ); + assert_eq!(result.kind, TypeKind::Constructor(BuiltinType::Type)); + let world = declared("Prim.State", "RealWorld"); + assert_eq!(world.id, TypeId::PRIM_REAL_WORLD); + assert!(roles(&world).is_empty()); + assert!(world.constructors.is_empty()); +} + #[test] fn boolean_literals_are_declared_at_the_boolean_kind() { // The official environment registers `True` and `False` at the type diff --git a/crates/psrs-resolve/src/resolver/bootstrap.rs b/crates/psrs-resolve/src/resolver/bootstrap.rs index 1c31ad5b..86dc5c02 100644 --- a/crates/psrs-resolve/src/resolver/bootstrap.rs +++ b/crates/psrs-resolve/src/resolver/bootstrap.rs @@ -4,11 +4,12 @@ use psrs_hir::{ExternalKind, ExternalSymbol, Intrinsic}; /// /// The name, arity, category, and type of each intrinsic come from its /// descriptor in `psrs-hir`, so this table is not a second source of truth. -/// `Intrinsic::ALL` is kept exact by a compile-time assertion, so every variant -/// is bootstrapped. +/// `Intrinsic::ALL` is kept exact by a compile-time assertion. Binding-only +/// operations are resolved from explicit primitive bindings, not exposed here. pub fn bootstrap_externals() -> Vec { Intrinsic::ALL .into_iter() + .filter(|intrinsic| intrinsic.is_bootstrap()) .map(|intrinsic| { let descriptor = intrinsic.descriptor(); ExternalSymbol { diff --git a/crates/psrs-resolve/src/resolver/module_resolution.rs b/crates/psrs-resolve/src/resolver/module_resolution.rs index 38b16d86..ec12303d 100644 --- a/crates/psrs-resolve/src/resolver/module_resolution.rs +++ b/crates/psrs-resolve/src/resolver/module_resolution.rs @@ -130,6 +130,11 @@ pub(crate) fn resolve_ast_module( continue; }; ExternalKind::Primitive(intrinsic) + } else if interface.starts_with("psrs:runtime-") { + ExternalKind::Runtime { + module: interface.into(), + function: function.into(), + } } else { ExternalKind::Wit { interface: interface.into(), diff --git a/crates/psrs-typecheck/src/typecheck/infer/mod.rs b/crates/psrs-typecheck/src/typecheck/infer/mod.rs index 0dcf3767..65ce7e8e 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/mod.rs @@ -154,6 +154,7 @@ impl Checker { Some( ExternalKind::Wit { .. } | ExternalKind::Library { .. } + | ExternalKind::Runtime { .. } | ExternalKind::Primitive(_), ) => { let Some(signature) = self.env.external_signatures.get(symbol).cloned() diff --git a/docs/design/backend/fp/effects.md b/docs/design/backend/fp/effects.md index 6ac01640..ccf2bbdf 100644 --- a/docs/design/backend/fp/effects.md +++ b/docs/design/backend/fp/effects.md @@ -1,5 +1,11 @@ # Effects +> **Selected revision:** [library-owned effects and state dependencies](library-owned-effects.md) +> replaces the Effect-specific token contract with a library newtype and generic +> state dependencies, with executable storage and termination owned by +> `psrs-runtime` and combinators owned by stdlib. Integrated acceptance has not migrated; +> this document retains the existing contract pending that migration. + **Feature:** F-02 **Status:** Draft (design) **Prerequisites:** [functional core](../../frontend/semantics/functional-core.md), [CC IR](cc-ir.md), and diff --git a/docs/design/backend/fp/library-owned-effects.md b/docs/design/backend/fp/library-owned-effects.md new file mode 100644 index 00000000..63f59fac --- /dev/null +++ b/docs/design/backend/fp/library-owned-effects.md @@ -0,0 +1,654 @@ +# Library-Owned Effects and State Dependencies + +**Feature:** [F-02](../../../feature/F-02-portable-programs.md) +**Status:** Draft design; newtype and state-dependency direction selected, +implementation migration in progress. Coverage is recorded in the +[implementation checklist](../../../implementation/backend/library-owned-effects.md). +**Prerequisites:** [effects](effects.md), [representation and evidence](representation-and-evidence.md), +[primitive types](../../frontend/type-system/prim.md), +[foreign imports](../../frontend/semantics/foreign-imports.md), +[primitive bindings](../wasm/primitive-ffi-and-stdlib.md), +[Core optimization](../opt/core.md), [MIR](mir.md), and +[source fidelity](../../../workflow/stdlib-vendoring.md). +**Summary:** Effect is an ordinary library newtype over a state-transforming +callable. General state primitives carry explicit sequencing dependencies +through checked Core, CC and MIR; the final encoding erases their zero-width +representation after verifying execution order. The library owns combinators, +loops, host adapters and execution policy. The runtime package owns executable +storage and termination primitives; the compiler owns their checked call and +dependency projection. A configured ordinary runner adapts +main to the command ABI without compiler recognition of Effect. + +## Scope + +This design replaces trusted Effect discovery, synthesized combinators, the +constant-token protocol, host suspension inferred from Effect result types, +and lexical runner restrictions. It also replaces PSRS.ST's Unit-triggered +representation with the same state protocol, preserving region safety. + +The synchronous state protocol covers host I/O and mutable storage. Async +scheduling, cancellation, transactions, exception recovery and the complete +GHC runtime model are separate topics. Existing mechanisms remain implemented +until migration is validated. Neither earlier foreignWrap/foreignUnwrap +intrinsics nor the earlier Unit-thunk design are part of this repair. + +## Background + +Official PureScript declares `foreign import data Effect :: Type -> Type` and +implements foreign slots using JavaScript suspended functions. The selected +Wasm adaptation replaces that declaration with a library newtype and provides +foreign-slot bodies in the target library. Preserve public signatures, exports, +roles, classes, instances and ordinary pure definitions. This is an explicit +target source adaptation, not byte-identical restoration of the opaque type. + +GHC represents IO as `newtype IO a = IO (State# RealWorld -> +(# State# RealWorld, a #))`. State# has a zero-width representation: it does +not contain a copy of the world or an incrementing counter. State-producing +operations and bind create a compiler-visible dependency chain. Their signatures, +optimizer rules and runtime boundaries jointly establish the contract. + +Our current Core synthesis creates `[STATE_TOKEN] -> a`, passes the same token +to both actions and returns no state. CC lowers StateToken to constant zero. +That is an invocation trigger, not the selected state-dependency protocol. +PSRS.ST similarly uses `Action r a = Action (Unit -> a)` today. Both must migrate; +changing Effect alone would leave ST.Global.toEffect's unsafe conversion invalid. + +## Model + +### Primitive state and ordinary library types + +The shared primitive declaration catalog owns the following proposed types, +identified by stable declaration IDs rather than spelling checks: + +```text +Prim.State.State :: forall k. k -> Type -- primitive, region role nominal +Prim.State.RealWorld :: Type -- primitive region marker +``` + +State has no source constructors, equality test, numeric value or safe coercion +between regions. RealWorld is a marker, not a mutable object. These are generic +low-level state facilities, not compiler-defined Effect or ST constructors. +The region kind is polymorphic so official `Region` and `Global :: Region` +declarations remain valid alongside `RealWorld :: Type`. Do not change the +official ST region kind to accommodate a target primitive. + +The following library definitions are schematic. Step is an ordinary structural +record alias, so primitive signatures do not depend on a library-owned record +constructor or a synthesized source declaration: + +```purescript +type Step s a = { state :: State s, value :: a } +newtype Effect a = Effect (State RealWorld -> Step RealWorld a) +type role Effect representational + +newtype Action r a = Action (State r -> Step r a) +type role Action nominal representational +``` + +Effect belongs to the Effect module, with its constructor hidden from public +exports and no added public Newtype instance. PSRS.ST owns Action. Ordinary +newtype checking and lowering own identity, field templates, constructor scope +and result-role coercions. The State region role remains nominal through +substitution and physical erasure. Constructor-hidden Coercible scope must be +checked, not assumed from export syntax. + +The callable representation contract retains the complete source field and its +constructor variables, the canonical storage field's owner, all call parameters +and its complete result type. Structured domains such as `State r` and structural +Step results must not be reduced to a fixed/argument-only parameter list or a +guessed final constructor argument. Transparent newtype storage keeps the declared +field's erased convention; a constructor application does not specialize its +physical parameter slots. Checked adapters relate concrete use types to that +convention. Nested newtypes retain their outer field application as evidence +while naming the declaration that owns the final canonical callable field. +Ordinary ADT field storage and recovery retain a checked instantiation from +the declared field template to its use type, scoped by the owning constructor's +parameters. Consumers use the Core-owned type relation; they do not infer +higher-kinded constructor bindings from an erased storage shape. + +Abstract callable-constructor transport uses the same registered physical +protocol as other consumers. For a State call, payload erasure preserves the +Step's successor field and erases only its value field; recovery converts only +that value field. The shared State call projection owns this split. Treating +the whole Step as an ordinary erased record would box or recover State and +destroy the dependency contract. Missing signatures and malformed State call +shapes reject during protocol planning. + +Source arrays use one erased-element storage representation at both concrete and +polymorphic use types. Construction and writes convert the checked element into +its payload storage protocol; indexing and patterns recover the checked element. +Passing an array through a bare variable, constructor field, callable boundary +or abstract Array constructor retains the existing storage reference. A pure +array update still copies before writing. Private text codec buffers cross an +explicit value conversion boundary and do not define source array identity. +Canonical WIT list adaptation retains the projected semantic element alongside +its erased storage, using the same payload owner protocol for records and nested +aggregates. Physical erasure must not remove the layout requirements carried by +that projection, including String storage used only by external results. + +Bare polymorphic callable storage uses the shared payload conversion protocol. +Ordinary arguments pass through erased unary curry segments. A terminal State +argument retains its logical State shape and returns a complete Step whose +payload alone uses erased storage. State is never boxed or captured by a curry +segment. The shared State call projection owns successor/payload field positions +and labels; layout planning registers terminal signatures before publishing the +immutable representation table. Recovery uses the same protocol and preserves +the checked source region and complete result, including callable payloads. + +Conversion sequences and product field conversions are expanded into CC +assignments before dependency evidence is published. Each adapter factory call +in these conversions therefore has an explicit operand and destination available +to invocation correspondence checks. +Conversion output shapes are shared with the verifier; computing a declared +output does not validate a conversion's input or semantic evidence. Array element +conversion calls still require their full loop correspondence contract. + +State-aware host bindings use the same canonical ABI adapter as ordinary WIT +bindings. Their logical CC signature retains State and the complete Step; +the guest projection describes only ordinary arguments and the Step payload. +Canonical adapter planning produces an immutable instruction subgraph before +physical emission, anchored to the source owner, call identity, destination, +ordinary operands, and checked binding. The dependency verifier checks its +actual instructions, temporary types, internal edges, and canonical import. +Only that complete checked subgraph may be contracted to one logical invocation +for source ordering and control correspondence. Its exit remains the enclosing +source continuation. Added calls, altered adaptation or cleanup, changed imports, +and entry into an adapter through an unchecked source edge must reject. +This adapter contract does not authorize a source-level loop or multiway State +control flow without its own dependency correspondence. + +A state value denotes a dependency point. An observable state operation consumes +its incoming dependency and yields a successor only on normal completion. A +pure action may return the incoming state unchanged. Successor identity is not +an observable source value and is not derived from different token bits. + +State threading is not a claim that PureScript has linear types. Constructor +privacy and rank-N regions do not alone prove unique use. Safe library code +threads one current state per executed path. General dependency verification +must establish the operation order and preserve it under transformation; +unchecked library coercions and unsafe execution remain explicit trust boundaries. + +`Effect (a -> b)` returns a function after one action; `Effect (Effect a)` +returns a second action after one action. Neither payload becomes extra +parameters of the outer state-transforming callable. + +### General primitive contracts + +Proposed registry operations are named here by responsibility; exact Rust and +binding names must follow the single intrinsic catalog. Do not add implicit +bootstrap exports of unsafe operations. + +```text +runWorld :: forall a. + (State RealWorld -> Step RealWorld a) -> a +runRegion :: forall a. + (forall s. State s -> Step s a) -> a +``` + +runWorld starts one dynamic execution, supplies its root dependency, invokes +the supplied function once and discharges its returned state before yielding +the payload. It is an unsafe execution boundary used by the library unsafe +runner and command adapter, not a purity proof. runRegion introduces a fresh +scoped region, invokes the rank-N body once and checks that the region does +not escape in the result. No arbitrary initial State literal is exposed. +Nested and repeated executions retain distinct dynamic invocation boundaries. + +Mutation and reads of mutable storage use state-aware checked primitives, for +example a private cell operation has the schematic shape: + +```text +readCell :: forall s a. Cell s a -> State s -> Step s a +writeCell :: forall s a. Cell s a -> a -> State s -> Step s Unit +``` + +Cell is library owned. Actual storage bindings use their existing checked +storage operands; a primitive scheme may not presume the identity or layout of +Cell. New storage allocation, mutable reads, writes and unsafe freezing all +participate in the dependency protocol. Pure array operations retain their +existing pure contracts; reading mutable backing storage must not be classified +as pure merely because immutable array indexing is pure. + +Generic execution primitive descriptors and checked target binding contracts +own dependency inputs/results, observable effects and trap behavior. Source +schemes, kind/role checks, Core elaboration and verifiers consume these contracts. +Backend binding metadata keeps runtime provider/export identity, source module, +span and the checked Core scheme identity beside target-neutral CC. Extraction +must retain every runtime binding; boundary validation rejects missing, +duplicated or substituted records. Keeping a raw binding record does not mean +its call has been projected or checked against a physical instruction sequence. +Returning an ordinary record containing +the same input State is not enough to implement an observable primitive: its +checked operation must establish a successor dependency. + +## Design + +### Runtime execution boundary + +Keep Effect and Action as ordinary library newtypes. The existing single +`psrs-runtime` crate owns executable low-level providers, including GC storage +allocation, mutable reads/writes and unconditional termination. Library pure, +bind and loops remain ordinary source definitions; they do not become runtime +opcodes or compiler-synthesized functions. Host services retain their checked +WIT providers and library adapters. + +The physical storage ABI passes a non-null mutable GC array of nullable eqref +payloads, signed Int indices/lengths and checked boxed values. Fill returns a +new array; read returns the stored reference; write mutates the original array +and returns no physical payload. Negative sizes and invalid indices trap. +Array identity and element reference identity survive the provider boundary. +The runtime owns a checked source/raw call projection contract. Each ordinary +operand pairs its source storage role with its declared physical ABI type; +result projection distinguishes a raw value, normal void-to-Unit adaptation, +and non-returning execution. Source/ABI arity, operand roles, payload types and +normal-return properties must agree before source checking or lowering consumes +the projection. This contract contains no compiler IR and does not itself +authorize State erasure, boxing, or invocation correspondence. A void write +produces no raw payload, and a trap produces neither a normal successor nor a +payload; lowering must represent those facts explicitly. +The target library may wrap that primitive as an ordinary suspended failure +action through its hidden newtype representation boundary. Constructing the +wrapper must not terminate or manufacture a State token. Executing it follows +the checked non-returning runtime contract; no Effect-specific intrinsic or +normal successor may be introduced to make the wrapper type-check. +At the CC boundary, the ordinary external signature must retain exactly one +final State parameter and a checked Step result. Its ordinary operand count and +payload role must agree with the runtime-owned projection. Array operands and +results require a non-null concrete array representation with canonical erased +element storage. Core checks nominal regions and source element equality before +CC selects that storage protocol. Source declarations may use concrete element +types. Only catalog Element operands and Element payloads adopt the shared +erased payload protocol; indices, arrays, Unit and non-returning results retain +their declared roles. Ordinary checked CC conversions box and recover scalars, +records and callable payloads before MIR layout planning. Callable payloads use +the same curry protocol on entry and recovery. Array operands retain the +original mutable storage reference, including nested array elements; adapting +a concrete source declaration must not copy it through an ArrayMap. +Signature validation does not establish call-site ordering or +authorize raw-call emission; checked instruction and CFG correspondence must +still account for operand conversion, payload recovery and termination. +Raw import signatures use the application's planned GC type arena. Array type +IDs come from that arena's concrete representation mapping; validating the +logical array shape alone is insufficient. Its target definition must be a +mutable array of nullable eqref. Raw element parameters and results are nullable +eqref even when the checked source payload is non-null or scalar. Normal void +and non-returning exports both have no raw result, but retain distinct result +projection contracts. Import signature planning does not replace their caller +adaptations or the checked provider identity at linking. +MIR raw runtime imports retain explicit provider/export identity alongside the +physical signature and ordinary call symbol. They do not acquire reserved +intrinsic identities. Provider/export lookup and storage-specific ABI checking +belong to external binding adaptation and target linking, not MIR semantics. +The binding adapter publishes a physical signature and a general result +convention (value, normal void-to-Unit, or non-returning). MIR verifies ordinary +call typing and immutable source-to-instruction correspondence, including the +exact checked import retained by each source invocation. It does not reconstruct +storage operations from provider names. The backend converts the application's actual GC +type arena to linker-owned closed reference contracts, retaining complete +recursion groups; provider selection compares those contracts with the offered +runtime unit. Substituting the catalog signature for the consumer's actual +types would hide ABI drift and is forbidden. +Invocation adaptation retains the checked source assignment as its anchor. +Raw operands must correspond to the original ordinary operand IDs, with explicit +checked conversions where the ABI type differs. A raw read's payload recovery +must consume that call's actual result. A normal void write must execute its +matching call before producing Unit; a Unit constant cannot stand in for the +operation. These per-invocation guarantees do not discharge whole-function +dependency and CFG correspondence or non-returning execution. +A checked non-returning ABI refines the source's abstract normal-return path at +its exact invocation. The immutable source assignment and checked import must +anchor that refinement. Emit the actual raw call followed by a bottom-value +projection and a terminating block, not Unit recovery. No ordinary continuation +instruction or normal successor may follow it. Subsequent source assignments on +that path become unreachable; sibling branches and their normal joins remain. +MIR correspondence must validate the refinement from the frozen return contract +rather than infer non-returning behavior from a function name or a void result. +The caller validates payloads at their checked use types before boxing/erasure; +the runtime cannot recover source types from eqref. An array of another physical +element type requires a representation-compatible storage design, not a copied +array passed to an in-place operation. This ABI does not require every ordinary +immutable array to use mutable storage's representation. + +The GC provider is an independent core module encoded by the runtime package, +with its own type and function index spaces and no linear memory, private +globals, start function or world-token allocation. Application and provider GC +reference types must match structurally under the checked linking contract. +GC ABI metadata is separate from the existing scalar/UTF-8 artifact metadata; +do not disguise a GC reference as an i32 handle or advertise a scalar signature +for it. The linker must validate reference types and compose the actual provider +before a source storage call can be accepted as executable. + +Storage is an ordinary explicit runtime binding, not a separate HIR intrinsic +for each export. For example: + +```purescript +foreign import "psrs:runtime-storage#array_read" readArray + :: forall s a. Array a -> Int -> State s -> Step s a +``` + +HIR retains provider/export identity and the source signature. Runtime metadata +owns physical signatures and source operand/payload relations; target linking +checks every declaration, including unused ones, before erasure. Checked state +signature evidence remains attached to the call conversion. Unknown providers, +exports and malformed contracts are errors. Do not manufacture primitive IDs +for storage operations or send runtime bindings through the WIT registry. + +State parameters and successors belong to the logical compiler contract, not +the provider's physical ABI. Core/CC/MIR keep each storage or host call observable +and ordered; only normal completion produces its successor. Runtime termination +has no normal result or successor. Runtime code cannot repair a dependency that +was erased before optimization or a call that the compiler removed as pure. + +runWorld and runRegion introduce and discharge generic compiler dependencies +around ordinary callable invocation. They need no runtime world object or +Effect-aware dispatcher. Executable helpers may live in the runtime when the +shared callable ABI requires them, but their representation must follow that +ABI. Do not force an arbitrary closure through the scalar runtime ABI. + +An operation-node interpreter would require another action representation, +allocations and a runtime dispatch protocol. It is outside this function-newtype +design. Async scheduling and cancellation remain separate work rather than +implicit guarantees of these synchronous primitives. + +### Ordinary library combinators and host adapters + +```purescript +pureE value = Effect (\state -> { state: state, value: value }) +bindE (Effect first) next = Effect (\state0 -> + case first state0 of + { state: state1, value: value } -> + case next value of + Effect second -> second state1) +``` + +pureE and bindE retain their official signatures and names. Operations, loops +and callbacks are ordinary source definitions; no pure/bind/loop intrinsic +is introduced. Official instances stay with their type in Effect. Prelude +keeps its official surface; check the resulting dependency graph for cycles. + +Construction of an action is inert. Arguments already evaluated while creating +an action remain strict. On execution, bind completes the first action, invokes +the continuation, then executes the returned action with the returned state. +Loops feed the last iteration's state to the next, including condition and +body transitions. Mutable reads and writes obey the same sequence. + +A private host binding has a state-aware source signature, for example: + +```text +hostNow :: State RealWorld -> Step RealWorld Int +``` + +A target library action adapter wraps this function in Effect. Because the +public constructor is hidden, the defining module may provide a package-internal +adapter using the existing Unsafe.Coerce, specialized to the exact newtype field +type. This is an audited unsafe library implementation boundary. The safe +public exports stay unchanged; no additional compiler visibility mode or +foreignWrap intrinsic is introduced. If implemented as a helper module, its +unsafe status and selected callable representation must be explicit. + +Effect.Unsafe.unsafePerformEffect similarly unwraps the selected representation +at this audited boundary and calls runWorld. It does not cast State to Int, +fabricate a token or bypass dependency verification. Common unsafe callable +transport must preserve the logical signature and execute correctly. + +### Checked dependencies across representations + +Typed Core preserves source State applications, roles and primitive contracts. +Its state-operation verifier checks input/output shapes, region identity, +producer provenance, normal-return state and dependency scope. Ordinary functions +are checked from their bodies; an external or abstract callable needs a checked +state signature contract. MIR retains checked source requirements in an immutable +module inventory independent of mutable per-function evidence. Every retained +function must satisfy its source requirement; deleting an optional witness must +not disable verification. Unused whole functions may be pruned without changing +the requirements of surviving functions. Missing required evidence is an error, not a fresh +state or assumed-pure operation. + +Core body evidence is tied to its immutable source arena. It derives transitions +from actual invocation nodes and tracks their argument and returned-field +provenance through ordinary aliases, record patterns and control-flow joins. +Verification checks invocation coverage and order, region/payload contracts and +branch placement in addition to standalone graph validity. A proven pure body +may pass its incoming dependency through unchanged; an unknown invocation stays +conservatively observable. Pure joins preserve aliases already evaluated before +the join. Core transformations invalidate old body evidence and recheck the +resulting source representation before later projection can consume it. + +CC makes the dependency chain explicit alongside ordinary evaluation order. +Each observable state operation defines an output dependency referring to its +input. Calls retain checked state inputs/results through dictionaries, erased +closures and higher-kinded instantiation. Conditional joins select the dependency +from the executed branch; loops carry it as a loop parameter. The returned +state must be downstream of the observable operations executed on that path. +Unknown calls and unsafe execution remain conservatively observable. + +Verification does not claim a general linear source type system. It rejects +malformed chains, region mixing and an unsupported fork that would discard or +replay a predecessor around observable operations. Branch-exclusive uses and +pure state pass-through are valid. A library closure may execute repeatedly; +each invocation threads the state supplied for that invocation. Support for a +raw-state transport shape must be checked across its actual fields, captures, +products and calls; unsupported shapes fail explicitly rather than materializing +a placeholder token or erasing the dependency. + +MIR fixes physical representation and keeps a checked dependency projection +for instructions, calls, block joins and loop edges. Dependency identities are +not Wasm value types or integer locals. Their definitions/uses are explicit MIR +structure, not a name-based side table reconstructed by the encoder. MIR +verification establishes dominance, region agreement, call contract consistency, +and control-flow preservation of the dependency chain. + +The existing representation planner owns the source/logical-to-physical mapping. +State maps to zero payload slots; Step's state field contributes no storage. +At a known state-call boundary, the result projects to the payload and requires +no Step record allocation. Common aggregate and erased transport may use an +ordinary payload container when required; it must not lose logical dependency +evidence or silently change callable conventions. No full GHC unboxed-tuple +syntax or global allocation-free claim is introduced. + +Physical parameter removal occurs only through checked signature projection, +shared by producers, consumers, partial applications and adapters. State +parameters are zero-width while their logical invocation and dependency remain. +Core owns call-boundary extraction for arrows, fixed-arity closures and quantified +results. The representation planner consumes that boundary and the checked State +signature, retaining its source arena and region while projecting only payload +types into physical slots. A signature plan alone cannot discharge invocation dependencies. +For ordinary direct and indirect calls, MIR correspondence preserves every +non-State operand identity, order and occurrence from immutable CC. It removes +only operands whose checked CC declarations have State shape. Changing an +operand to another value of the same physical type still invalidates the +certificate. ABI conversions require their own checked correspondence rather +than relaxing this ordinary-call invariant. +A nullary physical host call stays a call inside the action body, not a global +initializer. Immutable checked source Core is not mutated into a physical type +model; the lowering carries its explicit relation to CC/MIR. + +### Optimization and final erasure + +Core and MIR transformations preserve dependency edges, dynamic multiplicity, +branch/loop placement and observable call/trap behavior. Unused payloads do not +permit removal of their operation. State pass-through for a pure action is +simplifiable; a state-producing host/mutation operation is never replaced by +its input State. Inlining preserves argument order and reconnects dependencies +using fresh local identities. CSE, code motion, dead-code elimination and loop +optimizations require evidence covering both dependencies and observable effects. + +Zero-width representation does not make a state operation pure. Observable-effect +metadata remains necessary after physical projection and for calls outside the +state protocol. Dependencies do not promise rollback, thread synchronization or +replay prevention for arbitrary unsafe source code. + +After the last MIR optimizer, verify the full dependency graph and the ordered +instruction/CFG projection. The encoder may erase logical state edges only when +that projection discharges them. It preserves instruction/control order and +performs no subsequent effect-moving optimization. No State constant zero, +state counter, token object, dedicated world heap or runtime version comparison +is emitted. Verified state ordering survives as executable calls and control flow. + +### WIT boundary and generic command entry + +The ABI owner recognizes the generic checked state-binding shape using primitive +State identity and the structural Step contract. It projects the state parameter +to zero canonical arguments, flattens only ordinary host arguments/results, +and attaches the successor dependency to normal host return. Traps have no +normal successor. Dependencies cover actual host invocation and required ABI +reads/writes/cleanup so these cannot move across neighboring observable actions. +State is not a WIT resource or a canonical field. + +Parameter/result checking validates the complete logical and physical mapping, +including aggregates, handles and return pointers. Wrong regions, wrong state +result, missing state, incompatible WIT shapes and missing dependency contracts +are explicit errors. Do not drop parameters until arities happen to match. +The earlier Unit-triggered ABI extension is no longer a prerequisite for Effect. +Existing ordinary raw bindings retain their checked ABI and conservative effects; +they cannot be inserted into a state action without an explicit checked adapter. + +The package configures an ordinary runner such as +PSRS.Command.run :: Effect Unit -> Int. It invokes the unsafe library runner +once, returns zero on normal completion and propagates traps. The compiler +checks a configured monomorphic runner `T -> Int` against main's type T; +it does not inspect whether T is Effect. Load its module as an explicit root, +resolve stable identity once and build checked ordinary Core `runner main` +before pruning. Preserve Main.main precedence, unique-main fallback and Int +entries. Missing configuration, ambiguity and mismatches are explicit errors; +check-only compilation needs no executable runner. +Core entry normalization consumes resolved source identities and checked type +schemes, validates the monomorphic runner and selected entry, and constructs an +ordinary application. The generated declaration gets a fresh symbol in the +entry's source namespace and preserves its source range. Validation failure +must leave the input Core unchanged. Run this conversion before reachability +pruning so the runner, its dependencies and original main remain live. Source +loading and manifest selection belong to the driver; Core does not read package +configuration or rediscover a runner from library/type names. + +The package manifest records the runner in +`compiler_contract.command_runner`, an object containing exactly `module` and +`function` string fields. Both names must be nonempty and have no surrounding +whitespace. The manifest participates in the package content fingerprint. +Executable compilation loads the runner module from the trusted inventory as +an explicit dependency root, together with its import closure. Resolution may +select only a source declaration in that trusted prefix. Normal compilation, +IR-report compilation and traced diagnosis use the same selection path. +Check-only compilation follows the user's import closure without adding the +executable runner root; it still validates the package manifest and inventory. + +During package migration, absence of this field retains the locked package's +legacy entry path. A present but malformed or unresolved configuration is an +error and must never fall back to legacy handling. A configured runner bypasses +the old trusted Effect contract and lexical execution restrictions. This +compatibility mode is temporary; deletion of the legacy path remains part of +the Effect/ST migration. + +### ST, source adaptation and rejected alternatives + +PSRS.ST.Action migrates to State r -> Step r a with nominal region and +representational payload. Keep Cell's nominal region and existing rank-N +public run rule; discharge execution through runRegion. ST.Global.toEffect +uses the shared physical protocol only for the checked RealWorld region. +Validate the existing unsafe conversion and any explicit target adapter with +mutation and returned-value observations. Never coerce an arbitrary region +into RealWorld or let a region escape because State has no physical bits. + +The user selected this direction on 2026-10-09. The independent package records +the exact upstream declaration, diff, Wasm representation rationale, preserved +public API and changed newtype/coercion semantics in its adaptation manifest. +Do not rewrite official pure definitions to compensate for compiler defects +or report exact opaque-declaration fidelity. + +Rejected: Effect-specific type/instance rules; synthesized combinators; +name-based compiler recognition; inferred host suspension; a constant trigger +masquerading as a state dependency; a numeric world counter; ordinary record +threading without checked primitive successors; and premature state erasure. + +## Algorithms + +1. Keep a comparable compile diagnosis and inspect the owning-stage baseline. +2. Add shared primitive state declarations and checked operation/run contracts; + test region, kind, signature and provenance rejection before publishing them. +3. Extend source-to-CC/MIR conversion with explicit logical dependencies and + zero-width physical projection, including erased and higher-order calls. +4. Implement runtime-owned GC storage/termination providers and checked linking + contracts. Implement state-aware host/storage binding plans and verify their + operation successors, ABI effects, normal returns and traps. +5. Migrate Effect and ST library representations and operations together; + preserve official exports, instances, signatures and ordinary pure definitions. +6. Implement generic runner loading/type checking/Core entry normalization. + Remove old trusted Effect synthesis, suspension, context and token APIs. +7. Audit every optimizer and final encoding boundary, execute the acceptance + cases below, then update the normal stdlib lock and content fingerprint. + +## Code map + +| Owner | Responsibility | +| --- | --- | +| Shared primitive catalog / source checker | State and RealWorld identities, nominal region roles, checked primitive/run schemes and rank-N scope. | +| Primitive registry / checked Core | Generic execution-boundary dependency/effect contracts; validated elaboration and source state signatures. | +| CC / common representation planner | Explicit logical state dependencies, callable/newtype transport and checked zero-width projection. | +| MIR / verification / optimizers | Dependency graph and CFG checks, transformation legality and ordered physical projection. | +| ABI planner / final encoder | Checked state-aware host mappings; ordered invocation and verified final dependency erasure. | +| psrs-stdlib Effect / PSRS.ST / target modules | Ordinary newtypes, combinators, loops, private host/storage adapters and unsafe execution. | +| psrs-runtime | Executable GC storage and termination providers, source operand/payload relations, physical operation contracts and reproducible module encoding; no Effect type or combinator synthesis. | +| Runtime linker / provider planner | GC reference ABI matching, provider resolution and module composition without linear-memory handles or array copies. | +| Driver package / entry modules | Generic configured runner and ordinary Core entry normalization. | + +## Invariants and verification + +| Requirement | Required evidence | +| --- | --- | +| Source/API adaptation | Upstream diff and package manifest; unchanged public signatures, exports, roles, instances and ordinary pure definitions. | +| Primitive state contract | Positive unrelated state-transformer library; reject fabricated roots, wrong regions, malformed schemes/results, missing successors and unrestricted unsafe primitive exposure. | +| Newtype and region safety | Hidden-constructor coercion rejection, payload coercions, rank-N escape negatives and nominal region coercion negatives before/after erasure. | +| Complete dependency chain | Core/CC/MIR fixtures for calls, joins, loops and normal returns; reject missing evidence, stale predecessor use and unsupported forks. Verify transactional failure and source origins. | +| Common conversion | Execute higher-kinded dictionaries, erased payloads, fields, captures, arrays, returned functions and nested actions with value assertions; unrelated newtypes use the same planner. | +| Suspension and order | JS oracle versus mandatory Wasmtime: inert construction, strict factory arguments, repeated execution, ignored payloads, continuation/callback order, loop state transitions and traps. | +| Optimizer integration | Compare operation traces and values across Core/MIR passes; unused results, inlining, CSE/code motion candidates, branch joins and loops must preserve dependencies and multiplicity. | +| Zero-width projection | Inspect checked MIR and emitted signatures: no token object/integer or state field; known Step returns need no record allocation. Physical nullary calls remain dynamically repeated. | +| Host/storage boundary | Repeated zero-host-argument calls, mutable read-after-write, fresh allocation, freeze alias behavior, aggregate/handle mappings and malformed-binding rejection. | +| Entry independence | Int entry, configured Effect entry and unrelated command type; helper unsafe execution, nested runners, selection errors and trap propagation. | +| Official composition / ST | Unchanged Effect.Uncurried checking; cross-module Semigroup/Monoid execution; ST.Global.toEffect mutation and repeat tests; region and missing-instance negatives. | +| Integrated validation | Format, full workspace tests, strict clippy, relevant official differential cases and comparable full-import diagnosis. Require Wasmtime for runtime acceptance. | + +No requirement is verified by this design change. Import-only compilation is +compile acceptance, not runtime proof. Existing roadmap measurements stay unchanged. + +## Worked example + +Constructing a clock action captures its state-aware host adapter without running +it. The command runner invokes runWorld, which introduces the execution root s0. +Calling the first clock action consumes s0, performs its checked host call and +returns { state: s1, value: t1 }. bind invokes its continuation with t1 and +passes s1 to the next action. That action produces s2 and its payload. + +CC and MIR preserve s0 -> s1 -> s2 and both calls' observable effects, even if +t1 or the final payload is unused. Verification establishes ordered calls in +the actual control flow. Final encoding emits those calls in that order, with +no token arguments at the host ABI and no runtime state storage. No pass +recognizes Effect's name or synthesizes bind. + +## Boundaries and interfaces + +The package supplies library code and runner configuration under its lock. +Primitive declarations and contracts own state semantics. Source typing owns +ordinary newtype and region evidence; dependency verification owns checked +ordering; representation lowering owns zero-width projection; ABI plans own +host invocation; final encoding consumes the verified projection. No later +consumer guesses a lost state fact from arity, type spelling or layout. + +## Open questions and future work + +Exact registry names, Rust storage and package configuration fields follow the +owner audit; their semantic contracts above are fixed. Dependency transport in +unsupported shapes must fail explicitly. Async effects, exception recovery and +fine-grained independent-state optimization require separate designs. Intermediate +work uses explicit development packages; normal locked consumption must not +retain scratch paths or partially migrated Effect/ST representations. + +## References + +- [Pinned PureScript Effect](https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect.purs) + and [JavaScript implementation](https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect.js). +- [GHC IO implementation and runtime obligations](https://downloads.haskell.org/~ghc/latest/docs/libraries/ghc-internal-9.1401.0-555c/src/GHC.Internal.IO.html) + and [State's ZeroBitType representation](https://hackage-content.haskell.org/package/base-4.20.2.0/docs/GHC-Base.html). +- [Polymorphism and erasure](polymorphism-and-erasure.md), + [CC](cc-ir.md), [MIR optimization](../opt/mir.md), + [canonical ABI](../wasm/canonical-abi-and-wit.md), + [stdlib boundary](../../D-17-stdlib-and-conformance-boundaries.md). diff --git a/docs/design/frontend/semantics/foreign-imports.md b/docs/design/frontend/semantics/foreign-imports.md index 0399871c..e559272b 100644 --- a/docs/design/frontend/semantics/foreign-imports.md +++ b/docs/design/frontend/semantics/foreign-imports.md @@ -1,5 +1,10 @@ # Foreign Imports +> **Selected revision:** [library-owned effects and state dependencies](../../backend/fp/library-owned-effects.md) +> replaces the Effect-specific token contract with a library newtype and generic +> state dependencies. Implementation and acceptance evidence have not migrated; +> this document retains the existing contract pending that migration. + **Feature:** F-02 **Status:** Draft diff --git a/docs/design/frontend/type-system/prim.md b/docs/design/frontend/type-system/prim.md index bd5fded0..a083d514 100644 --- a/docs/design/frontend/type-system/prim.md +++ b/docs/design/frontend/type-system/prim.md @@ -1,5 +1,10 @@ # Primitive Interfaces and Relations +> **Selected extension:** [library-owned effects and state dependencies](../../backend/fp/library-owned-effects.md) +> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies +> and checked zero-width projection. Implementation and acceptance evidence +> have not migrated; the existing contracts below remain the implementation baseline. + **Feature:** F-02 **Status:** Draft From ba2c6e23151796e17fcd2c29f02eb0eb0f3da799 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:07:37 +0800 Subject: [PATCH 083/148] Track checked State dependencies in Core --- crates/psrs-core/src/command.rs | 129 +++++ crates/psrs-core/src/lib.rs | 7 +- crates/psrs-core/src/records.rs | 4 + crates/psrs-core/src/state/dependency/mod.rs | 213 +++++++++ .../psrs-core/src/state/dependency/tests.rs | 193 ++++++++ crates/psrs-core/src/state/flow/branches.rs | 180 +++++++ crates/psrs-core/src/state/flow/eval.rs | 233 +++++++++ crates/psrs-core/src/state/flow/mod.rs | 293 ++++++++++++ crates/psrs-core/src/state/flow/scan.rs | 78 +++ crates/psrs-core/src/state/flow/summary.rs | 66 +++ crates/psrs-core/src/state/flow/tests.rs | 450 ++++++++++++++++++ crates/psrs-core/src/state/flow/verify.rs | 198 ++++++++ crates/psrs-core/src/state/mod.rs | 76 +++ crates/psrs-core/src/state/primitive.rs | 73 +++ crates/psrs-core/src/state/tests.rs | 270 +++++++++++ crates/psrs-core/src/tests/mod.rs | 1 + crates/psrs-core/src/tests/record_scope.rs | 235 +++++++++ crates/psrs-core/src/types/call.rs | 38 ++ .../psrs-core/src/{types.rs => types/mod.rs} | 3 + crates/psrs-core/src/verify/expr/intrinsic.rs | 18 + crates/psrs-core/src/verify/expr/mod.rs | 3 +- crates/psrs-core/src/verify/mod.rs | 5 + crates/psrs-core/src/verify/scopes/expr.rs | 24 +- docs/design/backend/opt/core.md | 5 + 24 files changed, 2789 insertions(+), 6 deletions(-) create mode 100644 crates/psrs-core/src/command.rs create mode 100644 crates/psrs-core/src/state/dependency/mod.rs create mode 100644 crates/psrs-core/src/state/dependency/tests.rs create mode 100644 crates/psrs-core/src/state/flow/branches.rs create mode 100644 crates/psrs-core/src/state/flow/eval.rs create mode 100644 crates/psrs-core/src/state/flow/mod.rs create mode 100644 crates/psrs-core/src/state/flow/scan.rs create mode 100644 crates/psrs-core/src/state/flow/summary.rs create mode 100644 crates/psrs-core/src/state/flow/tests.rs create mode 100644 crates/psrs-core/src/state/flow/verify.rs create mode 100644 crates/psrs-core/src/state/mod.rs create mode 100644 crates/psrs-core/src/state/primitive.rs create mode 100644 crates/psrs-core/src/state/tests.rs create mode 100644 crates/psrs-core/src/tests/record_scope.rs create mode 100644 crates/psrs-core/src/types/call.rs rename crates/psrs-core/src/{types.rs => types/mod.rs} (99%) diff --git a/crates/psrs-core/src/command.rs b/crates/psrs-core/src/command.rs new file mode 100644 index 00000000..ccd9f8e9 --- /dev/null +++ b/crates/psrs-core/src/command.rs @@ -0,0 +1,129 @@ +//! Checked command entry adaptation through ordinary library functions. +use crate::{Declaration, Expr, ExprKind, Module, Type, TypeConstructor, VerifyError, arrow_parts}; +use psrs_hir::SymbolId; + +/// Normalize a selected entry with a source runner of type `T -> Int`. +/// Both identities must have been resolved by the caller. This neither names +/// an effect type nor synthesizes its operations. Failure leaves Core unchanged. +pub fn normalize_entry( + module: &mut Module, + entry: SymbolId, + runner: SymbolId, +) -> Result> { + module.verify()?; + let source = module + .declarations + .iter() + .find(|decl| decl.symbol == entry) + .ok_or_else(|| { + error( + module, + entry, + "selected command entry has no source declaration", + ) + })?; + let runner_decl = module + .declarations + .iter() + .find(|decl| decl.symbol == runner) + .ok_or_else(|| { + error( + module, + entry, + "configured command runner has no source declaration", + ) + })?; + if !runner_decl.quantified.is_empty() { + return Err(error( + module, + runner, + "configured command runner must be monomorphic", + )); + } + let (input, result) = arrow_parts(&module.types, runner_decl.ty).ok_or_else(|| { + error( + module, + runner, + "configured command runner must have type T -> Int", + ) + })?; + if module.types.get(result.0 as usize) != Some(&Type::Constructor(TypeConstructor::Int)) { + return Err(error( + module, + runner, + "configured command runner must return Int", + )); + } + if !source.quantified.is_empty() { + return Err(error(module, entry, "command entry must be monomorphic")); + } + if module.types.get(source.ty.0 as usize) == Some(&Type::Constructor(TypeConstructor::Int)) { + module.entry = Some(entry); + return Ok(entry); + } + if !module.types_equivalent(source.ty, input) { + return Err(error( + module, + entry, + "command entry type disagrees with the configured runner input", + )); + } + let index = module + .declarations + .iter() + .map(|decl| decl.symbol) + .chain(module.externals.iter().map(|external| external.symbol)) + .chain( + module + .constructors + .iter() + .map(|constructor| constructor.symbol), + ) + .filter(|symbol| symbol.module == entry.module) + .map(|symbol| symbol.index) + .max() + .unwrap_or(0) + .checked_add(1) + .ok_or_else(|| error(module, entry, "command entry symbol space is exhausted"))?; + let symbol = SymbolId::new(entry.module, index); + let span = source.name_span; + let global = |symbol, ty| Expr { + kind: ExprKind::Global(symbol), + ty, + span, + }; + let wrapper = Declaration { + symbol, + name: "$command_entry".into(), + name_span: span, + quantified: vec![], + ty: result, + value: Expr { + kind: ExprKind::Application( + Box::new(global(runner, runner_decl.ty)), + Box::new(global(entry, source.ty)), + ), + ty: result, + span, + }, + span, + }; + let mut candidate = module.clone(); + candidate.declarations.push(wrapper); + candidate.entry = Some(symbol); + candidate.verify()?; + *module = candidate; + Ok(symbol) +} + +fn error(module: &Module, symbol: SymbolId, message: &'static str) -> Vec { + vec![VerifyError { + module: symbol.module, + span: module + .declarations + .iter() + .find(|decl| decl.symbol == symbol) + .map_or(module.span, |decl| decl.name_span), + message, + }] +} diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 0f83235f..805c9db9 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -1,3 +1,4 @@ +pub mod command; pub mod dictionary; pub mod effect; mod instantiation; @@ -8,6 +9,7 @@ pub mod opt; mod pattern; pub mod primitive; mod records; +pub mod state; pub use instantiation::{Instantiation, RowInstantiation, instantiate_local_rows}; mod types; mod verify; @@ -16,7 +18,8 @@ pub use link::{link, prune_unreachable}; pub use pattern::{Literal, Pattern, PatternKind}; pub use records::{record_row, row_fields}; pub use types::{ - Type, TypeConstructor, TypeId, arrow_parts, closure_parts, forall_parts, scheme_parts, + Type, TypeConstructor, TypeId, arrow_parts, call_parts, closure_parts, forall_parts, + scheme_parts, }; use psrs_hir::{ @@ -309,7 +312,9 @@ impl Module { /// applied to it, in order. A non-constructor head yields `None`. pub fn applied_constructor(&self, mut id: TypeId) -> Option<(TypeConstructor, Vec)> { let mut arguments = Vec::new(); + let mut remaining = self.types.len(); while let Some(Type::Application(function, argument)) = self.types.get(id.0 as usize) { + remaining = remaining.checked_sub(1)?; arguments.push(*argument); id = *function; } diff --git a/crates/psrs-core/src/records.rs b/crates/psrs-core/src/records.rs index 0ae1bebb..7c1f9136 100644 --- a/crates/psrs-core/src/records.rs +++ b/crates/psrs-core/src/records.rs @@ -22,7 +22,11 @@ pub fn record_row(types: &[Type], id: TypeId) -> Option { /// reaches a node that is neither a row constructor nor a row variable. pub fn row_fields(types: &[Type], mut row: TypeId) -> Option { let mut fields = Vec::new(); + let mut seen = std::collections::HashSet::new(); loop { + if !seen.insert(row) { + return None; + } match types.get(row.0 as usize)? { Type::RowEmpty => return Some((fields, None)), Type::RowExtend { label, ty, tail } => { diff --git a/crates/psrs-core/src/state/dependency/mod.rs b/crates/psrs-core/src/state/dependency/mod.rs new file mode 100644 index 00000000..199d5308 --- /dev/null +++ b/crates/psrs-core/src/state/dependency/mod.rs @@ -0,0 +1,213 @@ +//! Representation-independent state flow validation. +//! +//! Block parameters represent joins and loop-carried dependencies. Each block +//! is checked using those parameters as its incoming state; edges transfer the +//! current state of each region to the corresponding successor parameter. +use psrs_span::TextRange; +use std::collections::{HashMap, HashSet}; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub struct DependencyId(pub u32); + +/// An interned checked region identity, never a physical value or type name. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub struct RegionId(pub u32); + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct Dependency { + pub id: DependencyId, + pub region: RegionId, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct Transition { + /// The defining operation in the owning representation, in execution order. + pub operation: u32, + pub input: DependencyId, + pub output: Dependency, + pub span: TextRange, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct Edge { + pub target: u32, + pub arguments: Vec, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum Terminator { + Return(Vec), + Jump(Edge), + Branch { + then_edge: Edge, + else_edge: Edge, + }, + /// Total multiway choice. Concrete predicates and case labels belong to + /// the owning representation's instruction-correspondence check. + Switch { + case_edges: Vec, + default_edge: Edge, + }, + /// A trapping path has no normal state successor. + Trap, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct Block { + pub id: u32, + pub parameters: Vec, + pub transitions: Vec, + pub terminator: Terminator, + pub span: TextRange, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct Graph { + pub entry: u32, + /// Checked function input regions, in signature order. A runner's verified + /// invocation boundary supplies roots; the graph never invents a root. + pub regions: Vec, + pub blocks: Vec, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DependencyError { + pub span: TextRange, + pub message: &'static str, +} + +impl Graph { + /// Validation is read-only. Consumers must additionally check that every + /// transition's operation identity maps to its actual checked instruction. + pub fn verify(&self) -> Result<(), DependencyError> { + let fail = |span, message| DependencyError { span, message }; + let mut blocks = HashMap::new(); + let mut definitions = HashSet::new(); + for block in &self.blocks { + if blocks.insert(block.id, block).is_some() { + return Err(fail(block.span, "duplicate state dependency block")); + } + for definition in block.parameters.iter().chain( + block + .transitions + .iter() + .map(|transition| &transition.output), + ) { + if !definitions.insert(definition.id) { + return Err(fail( + block.span, + "state dependency has multiple definitions", + )); + } + } + } + let Some(entry) = blocks.get(&self.entry) else { + return Err(fail(TextRange::new(0, 0), "state graph has no entry block")); + }; + if entry + .parameters + .iter() + .map(|value| value.region) + .collect::>() + != self.regions + { + return Err(fail( + entry.span, + "state graph entry does not match its checked regions", + )); + } + for block in &self.blocks { + let mut current = HashMap::new(); + for parameter in &block.parameters { + if current.insert(parameter.region, parameter.id).is_some() { + return Err(fail(block.span, "duplicate incoming state region")); + } + } + if current.len() != self.regions.len() + || self + .regions + .iter() + .any(|region| !current.contains_key(region)) + { + return Err(fail( + block.span, + "state block changes the checked region set", + )); + } + let mut previous_operation = None; + for transition in &block.transitions { + if previous_operation.is_some_and(|previous| previous >= transition.operation) { + return Err(fail( + transition.span, + "state transitions are not in operation order", + )); + } + previous_operation = Some(transition.operation); + if current.get(&transition.output.region) != Some(&transition.input) { + return Err(fail( + transition.span, + "state operation uses a stale or foreign dependency", + )); + } + current.insert(transition.output.region, transition.output.id); + } + let check_edge = |edge: &Edge| -> Result<(), DependencyError> { + let target = blocks + .get(&edge.target) + .ok_or_else(|| fail(block.span, "state edge has no target block"))?; + if edge.arguments.len() != target.parameters.len() { + return Err(fail( + block.span, + "state edge has an invalid parameter count", + )); + } + for (argument, parameter) in edge.arguments.iter().zip(&target.parameters) { + if current.get(¶meter.region) != Some(argument) { + return Err(fail( + block.span, + "state edge does not transfer the current dependency", + )); + } + } + Ok(()) + }; + match &block.terminator { + Terminator::Return(values) => { + if values.len() != self.regions.len() + || self + .regions + .iter() + .zip(values) + .any(|(region, value)| current.get(region) != Some(value)) + { + return Err(fail( + block.span, + "state return discards an executed operation", + )); + } + } + Terminator::Jump(edge) => check_edge(edge)?, + Terminator::Branch { + then_edge, + else_edge, + } => { + check_edge(then_edge)?; + check_edge(else_edge)?; + } + Terminator::Switch { + case_edges, + default_edge, + } => { + for edge in case_edges.iter().chain(std::iter::once(default_edge)) { + check_edge(edge)?; + } + } + Terminator::Trap => {} + } + } + Ok(()) + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-core/src/state/dependency/tests.rs b/crates/psrs-core/src/state/dependency/tests.rs new file mode 100644 index 00000000..e1fe6cc8 --- /dev/null +++ b/crates/psrs-core/src/state/dependency/tests.rs @@ -0,0 +1,193 @@ +use super::*; + +const SPAN: TextRange = TextRange::new(10, 20); +fn dependency(id: u32) -> Dependency { + Dependency { + id: DependencyId(id), + region: RegionId(0), + } +} +fn transition(input: u32, output: u32) -> Transition { + Transition { + operation: output, + input: DependencyId(input), + output: dependency(output), + span: SPAN, + } +} +fn edge(target: u32, input: u32) -> Edge { + Edge { + target, + arguments: vec![DependencyId(input)], + } +} +fn block(id: u32, incoming: u32, transitions: Vec, terminator: Terminator) -> Block { + Block { + id, + parameters: vec![dependency(incoming)], + transitions, + terminator, + span: SPAN, + } +} +fn graph(blocks: Vec) -> Graph { + Graph { + entry: 0, + regions: vec![RegionId(0)], + blocks, + } +} + +#[test] +fn rejects_stale_predecessors_and_discarded_final_state() { + let mut graph = graph(vec![block( + 0, + 0, + vec![transition(0, 1), transition(1, 2)], + Terminator::Return(vec![DependencyId(2)]), + )]); + graph.verify().unwrap(); + graph.blocks[0].transitions[1].input = DependencyId(0); + let error = graph.verify().unwrap_err(); + assert_eq!(error.span, SPAN); + assert_eq!( + error.message, + "state operation uses a stale or foreign dependency" + ); + graph.blocks[0].transitions[1].input = DependencyId(1); + graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(1)]); + assert!(graph.verify().unwrap_err().message.contains("discards")); +} + +#[test] +fn multiway_edges_transfer_current_dependencies_and_traps_have_no_join_edge() { + let mut graph = graph(vec![ + block( + 0, + 0, + vec![transition(0, 1)], + Terminator::Switch { + case_edges: vec![edge(1, 1), edge(2, 1)], + default_edge: edge(3, 1), + }, + ), + block(1, 2, vec![transition(2, 5)], Terminator::Jump(edge(4, 5))), + block(2, 3, vec![], Terminator::Trap), + block(3, 4, vec![], Terminator::Jump(edge(4, 4))), + block(4, 6, vec![], Terminator::Return(vec![DependencyId(6)])), + ]); + graph.verify().unwrap(); + for choice in 0..3 { + let original = graph.blocks[0].terminator.clone(); + let Terminator::Switch { + case_edges, + default_edge, + } = &mut graph.blocks[0].terminator + else { + panic!() + }; + let edge = if choice == 2 { + default_edge + } else { + &mut case_edges[choice] + }; + edge.arguments[0] = DependencyId(0); + assert!(graph.verify().is_err()); + graph.blocks[0].terminator = original; + } +} + +#[test] +fn branch_exclusive_operations_merge_the_executed_dependency() { + let mut graph = graph(vec![ + block( + 0, + 0, + vec![], + Terminator::Branch { + then_edge: edge(1, 0), + else_edge: edge(2, 0), + }, + ), + block(1, 1, vec![transition(1, 3)], Terminator::Jump(edge(3, 3))), + block(2, 2, vec![transition(2, 4)], Terminator::Jump(edge(3, 4))), + block( + 3, + 5, + vec![transition(5, 6)], + Terminator::Return(vec![DependencyId(6)]), + ), + ]); + graph.verify().unwrap(); + graph.blocks[2].terminator = Terminator::Jump(edge(3, 3)); + assert!( + graph + .verify() + .unwrap_err() + .message + .contains("current dependency") + ); +} + +#[test] +fn loop_carries_the_latest_state_and_traps_need_no_successor() { + let mut graph = graph(vec![ + block(0, 0, vec![], Terminator::Jump(edge(1, 0))), + block( + 1, + 1, + vec![transition(1, 2)], + Terminator::Branch { + then_edge: edge(1, 2), + else_edge: edge(2, 2), + }, + ), + block(2, 3, vec![], Terminator::Trap), + ]); + graph.verify().unwrap(); + let Terminator::Branch { then_edge, .. } = &mut graph.blocks[1].terminator else { + unreachable!() + }; + then_edge.arguments[0] = DependencyId(1); + assert!(graph.verify().is_err()); +} + +#[test] +fn rejects_wrong_region_duplicate_definitions_and_missing_roots() { + let mut graph = graph(vec![block( + 0, + 0, + vec![transition(0, 1)], + Terminator::Return(vec![DependencyId(1)]), + )]); + graph.blocks[0].transitions[0].output.region = RegionId(1); + assert!(graph.verify().is_err()); + graph.blocks[0].transitions[0].output = dependency(0); + assert!( + graph + .verify() + .unwrap_err() + .message + .contains("multiple definitions") + ); + graph.entry = 10; + assert!(graph.verify().is_err()); +} + +#[test] +fn rejects_a_projection_that_reorders_actual_operations() { + let mut graph = graph(vec![block( + 0, + 0, + vec![transition(0, 1), transition(1, 2)], + Terminator::Return(vec![DependencyId(2)]), + )]); + graph.blocks[0].transitions[0].operation = 5; + assert!( + graph + .verify() + .unwrap_err() + .message + .contains("operation order") + ); +} diff --git a/crates/psrs-core/src/state/flow/branches.rs b/crates/psrs-core/src/state/flow/branches.rs new file mode 100644 index 00000000..02e1d537 --- /dev/null +++ b/crates/psrs-core/src/state/flow/branches.rs @@ -0,0 +1,180 @@ +use super::{Block, Builder, Dependency, Path, RegionId, Terminator, Value}; +use crate::state::dependency::Edge; +use crate::{CaseBranch, Expr, Pattern, VerifyError}; +use psrs_span::TextRange; +use std::collections::HashMap; + +impl<'a> Builder<'a> { + fn fork(&mut self, path: &Path, span: TextRange) -> Path { + let input = self.fresh(); + let block = self.blocks.len(); + self.blocks.push(Block { + id: block as u32, + parameters: vec![Dependency { + id: input, + region: RegionId(0), + }], + transitions: Vec::new(), + terminator: Terminator::Trap, + span, + }); + let mut locals = path.locals.clone(); + for value in locals.values_mut() { + value.remap(path.current, input); + } + let mut aliases = path.aliases.clone(); + aliases.insert(path.current, input); + Path { + block, + current: input, + revision: path.revision, + locals, + aliases, + } + } + + pub(super) fn alternatives( + &mut self, + values: &[&'a Expr], + path: &mut Path, + span: TextRange, + ) -> Result { + let arms = values + .iter() + .map(|value| (*value, None)) + .collect::>(); + self.arms(&arms, &Value::Opaque, path, span) + } + + pub(super) fn case_alternatives( + &mut self, + value: Value, + branches: &'a [CaseBranch], + path: &mut Path, + span: TextRange, + ) -> Result { + let arms = branches + .iter() + .map(|branch| (&branch.value, Some(&branch.pattern))) + .collect::>(); + self.arms(&arms, &value, path, span) + } + + fn arms( + &mut self, + arms: &[(&'a Expr, Option<&'a Pattern>)], + scrutinee: &Value, + path: &mut Path, + span: TextRange, + ) -> Result { + psrs_span::with_sufficient_stack(|| self.arms_inner(arms, scrutinee, path, span)) + } + + fn arms_inner( + &mut self, + arms: &[(&'a Expr, Option<&'a Pattern>)], + scrutinee: &Value, + path: &mut Path, + span: TextRange, + ) -> Result { + if arms.is_empty() { + return Ok(Value::Terminated); + } + if arms.len() == 1 { + if let Some(pattern) = arms[0].1 { + self.bind(pattern, scrutinee.clone(), path)?; + } + return self.eval(arms[0].0, path); + } + let incoming = path.current; + let revision = path.revision; + let mut left = self.fork(path, span); + let mut right = self.fork(path, span); + self.blocks[path.block].terminator = Terminator::Branch { + then_edge: Edge { + target: left.block as u32, + arguments: vec![incoming], + }, + else_edge: Edge { + target: right.block as u32, + arguments: vec![incoming], + }, + }; + let mut left_scrutinee = scrutinee.clone(); + left_scrutinee.remap(incoming, left.current); + let left_value = self.arms(&arms[..1], &left_scrutinee, &mut left, span)?; + let mut right_scrutinee = scrutinee.clone(); + right_scrutinee.remap(incoming, right.current); + let right_value = self.arms(&arms[1..], &right_scrutinee, &mut right, span)?; + let live = [(left_value, left), (right_value, right)] + .into_iter() + .filter(|(value, _)| !matches!(value, Value::Terminated)) + .collect::>(); + if live.is_empty() { + return Ok(Value::Terminated); + } + let join = self.fork(path, span); + let mut merged = None; + for (value, branch) in &live { + let mut value = value.clone(); + value.resolve(branch); + self.blocks[branch.block].terminator = Terminator::Jump(Edge { + target: join.block as u32, + arguments: vec![branch.current], + }); + value.remap(branch.current, join.current); + merged = Some(match merged { + None => value, + Some(previous) => self.merge(previous, value, span)?, + }); + } + // With no observable invocation on any surviving path, incoming state + // aliases also denote the selected join dependency. Otherwise they + // remain predecessors and a subsequent use must reject. + if live.iter().all(|(_, branch)| branch.revision == revision) { + path.aliases.insert(incoming, join.current); + for value in path.locals.values_mut() { + value.remap(incoming, join.current); + } + } + path.current = join.current; + path.block = join.block; + path.revision = live + .iter() + .map(|(_, branch)| branch.revision) + .max() + .unwrap(); + Ok(merged.unwrap()) + } + + fn merge(&self, left: Value, right: Value, span: TextRange) -> Result { + Ok(match (left, right) { + (Value::State(left), Value::State(right)) if left == right => Value::State(left), + (Value::Record(left), Value::Record(mut right)) if left.len() == right.len() => { + let mut fields = HashMap::new(); + for (label, value) in left { + let other = right.remove(&label).ok_or_else(|| { + self.error(span, "state branch result changes its checked fields") + })?; + fields.insert(label, self.merge(value, other, span)?); + } + Value::Record(fields) + } + (Value::Constructor(left), Value::Constructor(right)) if left.len() == right.len() => { + Value::Constructor( + left.into_iter() + .zip(right) + .map(|(left, right)| self.merge(left, right, span)) + .collect::>()?, + ) + } + (Value::State(_), _) | (_, Value::State(_)) => { + return Err(self.error( + span, + "state branch result has incompatible producer provenance", + )); + } + _ => Value::Opaque, + }) + } +} diff --git a/crates/psrs-core/src/state/flow/eval.rs b/crates/psrs-core/src/state/flow/eval.rs new file mode 100644 index 00000000..08ac436b --- /dev/null +++ b/crates/psrs-core/src/state/flow/eval.rs @@ -0,0 +1,233 @@ +use super::{Builder, Path, Value}; +use crate::{Expr, ExprKind, Pattern, PatternKind, VerifyError}; +use std::collections::HashMap; + +impl<'a> Builder<'a> { + pub(super) fn eval( + &mut self, + expression: &'a Expr, + path: &mut Path, + ) -> Result { + psrs_span::with_sufficient_stack(|| self.eval_inner(expression, path)) + } + + fn eval_inner(&mut self, expression: &'a Expr, path: &mut Path) -> Result { + let value = match &expression.kind { + ExprKind::Local(id) => path.locals.get(id).cloned().unwrap_or(Value::Opaque), + ExprKind::Record { fields } => { + let mut values = HashMap::new(); + for (label, field) in fields { + let value = self.eval(field, path)?; + if matches!(value, Value::Terminated) { + return Ok(value); + } + values.insert(label.clone(), value); + } + Value::Record(values) + } + ExprKind::FieldAccess { record, field } => match self.eval(record, path)? { + Value::Record(mut fields) => fields.remove(field).unwrap_or(Value::Opaque), + Value::Terminated => Value::Terminated, + _ => Value::Opaque, + }, + ExprKind::RecordUpdate { record, fields } => { + let value = self.eval(record, path)?; + if matches!(value, Value::Terminated) { + return Ok(value); + } + let mut values = match value { + Value::Record(values) => values, + _ => HashMap::new(), + }; + for (label, field) in fields { + let value = self.eval(field, path)?; + if matches!(value, Value::Terminated) { + return Ok(value); + } + values.insert(label.clone(), value); + } + Value::Record(values) + } + ExprKind::Application(function, argument) => { + if matches!(self.eval(function, path)?, Value::Terminated) { + return Ok(Value::Terminated); + } + let argument_value = self.eval(argument, path)?; + if matches!(argument_value, Value::Terminated) { + return Ok(argument_value); + } + if let Some(region) = crate::state::region(self.module, argument.ty) { + if !self.module.types_equivalent(region, self.region) { + return Err(self.error(argument.span, "state call mixes checked regions")); + } + // Use the instantiated final callable, not a declaration's + // uninstantiated variables or an action constructor name. + let signature = crate::state::signature(self.module, function.ty) + .map_err(|message| self.error(function.span, message))?; + if !signature.parameters.is_empty() { + return Err(self.error( + function.span, + "state call is not at its invocation boundary", + )); + } + let input = self.state_value(&argument_value, path, argument.span)?; + let output = if super::summary::passthrough(self.module, function) { + input + } else { + self.transition(expression, input, path)? + }; + Value::Record(HashMap::from([ + ("state".into(), Value::State(output)), + ("value".into(), Value::Opaque), + ])) + } else { + Value::Opaque + } + } + ExprKind::Let { bindings, body } => { + let previous = path.locals.clone(); + for binding in bindings { + let value = self.eval(&binding.value, path)?; + if matches!(value, Value::Terminated) { + return Ok(value); + } + path.locals.insert(binding.binder.id, value); + } + let value = self.eval(body, path)?; + path.locals = previous; + value + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + if matches!(self.eval(condition, path)?, Value::Terminated) { + return Ok(Value::Terminated); + } + return self.alternatives(&[then_branch, else_branch], path, expression.span); + } + ExprKind::Case { + scrutinee, + branches, + } => { + let value = self.eval(scrutinee, path)?; + if matches!(value, Value::Terminated) { + return Ok(value); + } + if branches.len() == 1 { + let previous = path.locals.clone(); + self.bind(&branches[0].pattern, value, path)?; + let value = self.eval(&branches[0].value, path)?; + path.locals = previous; + value + } else { + return self.case_alternatives(value, branches, path, expression.span); + } + } + ExprKind::Constructor { arguments, .. } => { + let mut values = Vec::new(); + for argument in arguments { + let value = self.eval(argument, path)?; + if matches!(value, Value::Terminated) { + return Ok(value); + } + values.push(value); + } + Value::Constructor(values) + } + ExprKind::RepresentationCast { value, .. } => { + // Checked casts retain provenance only for an equivalent + // State/record contract; arbitrary unsafe transport is not a + // source of a root dependency. + let evaluated = self.eval(value, path)?; + if matches!(evaluated, Value::Terminated) + || self.module.types_equivalent(value.ty, expression.ty) + { + evaluated + } else { + Value::Opaque + } + } + ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => { + for argument in arguments { + if matches!(self.eval(argument, path)?, Value::Terminated) { + return Ok(Value::Terminated); + } + } + Value::Opaque + } + ExprKind::Trap => Value::Terminated, + // A lambda is inert here. Its own execution scope is checked by + // scan, independently of the enclosing invocation's parameter. + _ => Value::Opaque, + }; + if crate::state::region(self.module, expression.ty).is_some() + && !matches!(value, Value::State(_) | Value::Terminated) + { + return Err(self.error( + expression.span, + "state value has no checked producer provenance", + )); + } + Ok(value) + } + + pub(super) fn bind( + &self, + pattern: &Pattern, + value: Value, + path: &mut Path, + ) -> Result<(), VerifyError> { + match &pattern.kind { + PatternKind::Var { id, .. } => { + path.locals.insert(*id, value); + } + PatternKind::Named { id, pattern } => { + path.locals.insert(*id, value.clone()); + self.bind(pattern, value, path)?; + } + PatternKind::Record { fields } => { + let Value::Record(values) = value else { + // Opaque ordinary records carry no state evidence. Any + // later State use must reject rather than assume a root. + for (_, field) in fields { + self.bind(field, Value::Opaque, path)?; + } + return Ok(()); + }; + for (label, field) in fields { + self.bind( + field, + values.get(label).cloned().unwrap_or(Value::Opaque), + path, + )?; + } + } + PatternKind::Constructor { arguments, .. } => { + let values = if let Value::Constructor(values) = value { + values + } else { + Vec::new() + }; + for (index, field) in arguments.iter().enumerate() { + self.bind( + field, + values.get(index).cloned().unwrap_or(Value::Opaque), + path, + )?; + } + } + PatternKind::Array { elements } => { + for field in elements { + self.bind(field, Value::Opaque, path)?; + } + } + _ => {} + } + Ok(()) + } +} diff --git a/crates/psrs-core/src/state/flow/mod.rs b/crates/psrs-core/src/state/flow/mod.rs new file mode 100644 index 00000000..09ec7886 --- /dev/null +++ b/crates/psrs-core/src/state/flow/mod.rs @@ -0,0 +1,293 @@ +//! Checked state flow produced from immutable source Core, before projection. +//! +//! Operation identities address actual call expressions in this arena. Each +//! state lambda supplies a parameter root; evaluation never invents a state. +use super::dependency::{Block, Dependency, DependencyId, Graph, RegionId, Terminator, Transition}; +use crate::{Expr, ExprKind, Module, TypeId, VerifyError}; +use psrs_hir::{LocalId, ModuleId}; +use psrs_span::TextRange; +use std::collections::HashMap; + +mod branches; +mod eval; +mod scan; +mod summary; +#[cfg(test)] +mod tests; +mod verify; + +/// A source invocation and the dependency it consumes/produces on return. +#[derive(Debug)] +pub struct Operation<'a> { + pub expression: &'a Expr, + pub input: DependencyId, + pub output: DependencyId, +} + +/// Evidence for one lexical state-function body. Region IDs are local to this +/// function, while `region` retains its checked source type identity. +#[derive(Debug)] +pub struct FunctionFlow<'a> { + source: &'a Module, + pub owner: ModuleId, + pub lambda: &'a Expr, + pub region: TypeId, + pub graph: Graph, + pub operations: Vec>, +} + +/// Validate State-to-Step lambdas, including nested and uncalled library bodies. +/// Other raw-state callable/storage shapes still require a checked lowering +/// contract before projection; this does not publish evidence for those shapes. +/// Ordinary Core type and lexical-scope checks precede this state-flow check. +/// No source type, expression, or local identity is changed. +pub fn check(module: &Module) -> Result>, Vec> { + let mut flows = Vec::new(); + let mut errors = Vec::new(); + for declaration in &module.declarations { + scan::expression( + module, + declaration.symbol.module, + &declaration.value, + &mut flows, + &mut errors, + ); + } + if errors.is_empty() { + Ok(flows) + } else { + Err(errors) + } +} + +#[derive(Clone, Debug)] +enum Value { + Opaque, + State(DependencyId), + Record(HashMap), + Constructor(Vec), + Terminated, +} + +impl Value { + fn state(&self) -> Option { + if let Self::State(id) = self { + Some(*id) + } else { + None + } + } + + fn remap(&mut self, old: DependencyId, new: DependencyId) { + match self { + Self::State(id) if *id == old => *id = new, + Self::Record(fields) => { + for field in fields.values_mut() { + field.remap(old, new); + } + } + Self::Constructor(fields) => { + for field in fields { + field.remap(old, new); + } + } + _ => {} + } + } + + fn resolve(&mut self, path: &Path) { + match self { + Self::State(id) => *id = path.resolve(*id), + Self::Record(fields) => { + for field in fields.values_mut() { + field.resolve(path); + } + } + Self::Constructor(fields) => { + for field in fields { + field.resolve(path); + } + } + _ => {} + } + } +} + +#[derive(Clone)] +struct Path { + block: usize, + current: DependencyId, + revision: u32, + locals: HashMap, + /// Pure control-flow joins preserve the incoming dependency's meaning. + /// Edges always point to newer IDs, including aliases evaluated earlier. + aliases: HashMap, +} + +impl Path { + fn resolve(&self, mut id: DependencyId) -> DependencyId { + while let Some(next) = self.aliases.get(&id) { + debug_assert!(next.0 > id.0); + id = *next; + } + id + } +} + +struct Builder<'a> { + module: &'a Module, + owner: ModuleId, + region: TypeId, + next: u32, + blocks: Vec, + operations: Vec>, +} + +impl<'a> Builder<'a> { + fn fresh(&mut self) -> DependencyId { + let id = DependencyId(self.next); + self.next += 1; + id + } + + fn error(&self, span: TextRange, message: &'static str) -> VerifyError { + VerifyError { + module: self.owner, + span, + message, + } + } + + fn transition( + &mut self, + expression: &'a Expr, + input: DependencyId, + path: &mut Path, + ) -> Result { + if input != path.current { + return Err(self.error(expression.span, "state call consumes a stale dependency")); + } + let output = self.fresh(); + let operation = self.operations.len() as u32; + self.operations.push(Operation { + expression, + input, + output, + }); + self.blocks[path.block].transitions.push(Transition { + operation, + input, + output: Dependency { + id: output, + region: RegionId(0), + }, + span: expression.span, + }); + path.current = output; + path.revision += 1; + Ok(output) + } + + fn state_value( + &self, + value: &Value, + path: &Path, + span: TextRange, + ) -> Result { + value + .state() + .map(|id| path.resolve(id)) + .ok_or_else(|| self.error(span, "state value has no checked producer provenance")) + } + + fn returned(&self, value: &Value, path: &Path, span: TextRange) -> Result<(), VerifyError> { + let Value::Record(fields) = value else { + return Err(self.error(span, "state function result has no checked state field")); + }; + let state = fields + .get("state") + .and_then(Value::state) + .ok_or_else(|| self.error(span, "state return has no checked producer provenance"))?; + if path.resolve(state) != path.current { + return Err(self.error(span, "state return discards an executed operation")); + } + Ok(()) + } +} + +fn function<'a>( + module: &'a Module, + owner: ModuleId, + lambda: &'a Expr, +) -> Result, VerifyError> { + let flow = derive(module, owner, lambda)?; + flow.verify(module)?; + Ok(flow) +} + +fn derive<'a>( + module: &'a Module, + owner: ModuleId, + lambda: &'a Expr, +) -> Result, VerifyError> { + let ExprKind::Lambda { binder, body } = &lambda.kind else { + unreachable!() + }; + let region = super::region(module, binder.ty).expect("scan selected a checked State parameter"); + let (state, _) = super::step(module, body.ty).ok_or(VerifyError { + module: owner, + span: body.span, + message: "state function must return a closed state/value record", + })?; + if !module.types_equivalent(binder.ty, state) { + return Err(VerifyError { + module: owner, + span: body.span, + message: "state function returns a different region", + }); + } + let input = DependencyId(0); + let mut builder = Builder { + module, + owner, + region, + next: 1, + blocks: vec![Block { + id: 0, + parameters: vec![Dependency { + id: input, + region: RegionId(0), + }], + transitions: Vec::new(), + terminator: Terminator::Trap, + span: lambda.span, + }], + operations: Vec::new(), + }; + let mut path = Path { + block: 0, + current: input, + revision: 0, + locals: HashMap::from([(binder.id, Value::State(input))]), + aliases: HashMap::new(), + }; + let value = builder.eval(body, &mut path)?; + if !matches!(value, Value::Terminated) { + builder.returned(&value, &path, body.span)?; + builder.blocks[path.block].terminator = Terminator::Return(vec![path.current]); + } + let graph = Graph { + entry: 0, + regions: vec![RegionId(0)], + blocks: builder.blocks, + }; + let flow = FunctionFlow { + source: module, + owner, + lambda, + region, + graph, + operations: builder.operations, + }; + Ok(flow) +} diff --git a/crates/psrs-core/src/state/flow/scan.rs b/crates/psrs-core/src/state/flow/scan.rs new file mode 100644 index 00000000..1d1f7cfc --- /dev/null +++ b/crates/psrs-core/src/state/flow/scan.rs @@ -0,0 +1,78 @@ +use super::{FunctionFlow, function}; +use crate::{Expr, ExprKind, Module, VerifyError}; +use psrs_hir::ModuleId; + +pub(super) fn expression<'a>( + module: &'a Module, + owner: ModuleId, + value: &'a Expr, + flows: &mut Vec>, + errors: &mut Vec, +) { + psrs_span::with_sufficient_stack(|| { + if let ExprKind::Lambda { binder, body } = &value.kind + && crate::state::region(module, binder.ty).is_some() + && crate::state::step(module, body.ty).is_some() + { + match function(module, owner, value) { + Ok(flow) => flows.push(flow), + Err(error) => errors.push(error), + } + } + let mut visit = |child| expression(module, owner, child, flows, errors); + match &value.kind { + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => { + for argument in arguments { + visit(argument); + } + } + ExprKind::Record { fields } => { + for (_, field) in fields { + visit(field); + } + } + ExprKind::RecordUpdate { record, fields } => { + visit(record); + for (_, field) in fields { + visit(field); + } + } + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } => visit(record), + ExprKind::Application(function, argument) => { + visit(function); + visit(argument); + } + ExprKind::Lambda { body, .. } => visit(body), + ExprKind::Let { bindings, body } => { + for binding in bindings { + visit(&binding.value); + } + visit(body); + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + visit(condition); + visit(then_branch); + visit(else_branch); + } + ExprKind::Case { + scrutinee, + branches, + } => { + visit(scrutinee); + for branch in branches { + visit(&branch.value); + } + } + _ => {} + } + }); +} diff --git a/crates/psrs-core/src/state/flow/summary.rs b/crates/psrs-core/src/state/flow/summary.rs new file mode 100644 index 00000000..542644ce --- /dev/null +++ b/crates/psrs-core/src/state/flow/summary.rs @@ -0,0 +1,66 @@ +//! A deliberately small proof of an ordinary body's state pass-through. +//! Unknown/higher-order invocations remain observable, without name exceptions. +use crate::{Expr, ExprKind, Module}; + +pub(super) fn passthrough(module: &Module, callable: &Expr) -> bool { + let mut callable = callable; + loop { + match &callable.kind { + ExprKind::Application(function, _) => callable = function, + ExprKind::Global(symbol) => { + let Some(declaration) = module + .declarations + .iter() + .find(|value| value.symbol == *symbol) + else { + return false; + }; + return lambda(module, &declaration.value); + } + ExprKind::Lambda { .. } => return lambda(module, callable), + _ => return false, + } + } +} + +fn lambda(module: &Module, mut callable: &Expr) -> bool { + while let ExprKind::Lambda { binder, body } = &callable.kind { + if crate::state::region(module, binder.ty).is_some() { + return crate::state::step(module, body.ty).is_some() && inert(body); + } + callable = body; + } + false +} + +fn inert(value: &Expr) -> bool { + psrs_span::with_sufficient_stack(|| match &value.kind { + ExprKind::Local(_) + | ExprKind::Integer(_) + | ExprKind::Number(_) + | ExprKind::Boolean(_) + | ExprKind::String(_) + | ExprKind::Char(_) + | ExprKind::Unit + | ExprKind::Lambda { .. } => true, + ExprKind::Record { fields } => fields.iter().all(|(_, value)| inert(value)), + ExprKind::FieldAccess { record, .. } => inert(record), + ExprKind::Constructor { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => arguments.iter().all(inert), + ExprKind::Let { bindings, body } => { + bindings.iter().all(|binding| inert(&binding.value)) && inert(body) + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => inert(condition) && inert(then_branch) && inert(else_branch), + ExprKind::Case { + scrutinee, + branches, + } => inert(scrutinee) && branches.iter().all(|branch| inert(&branch.value)), + _ => false, + }) +} diff --git a/crates/psrs-core/src/state/flow/tests.rs b/crates/psrs-core/src/state/flow/tests.rs new file mode 100644 index 00000000..47561e2f --- /dev/null +++ b/crates/psrs-core/src/state/flow/tests.rs @@ -0,0 +1,450 @@ +use super::*; +use crate::{Binder, Binding, CaseBranch, Declaration, Pattern, PatternKind}; +use psrs_hir::{CaseBranchCoverage, LocalId, SymbolId}; + +fn value(kind: ExprKind, ty: u32) -> Expr { + Expr { + kind, + ty: TypeId(ty), + span: TextRange::new(10, 20), + } +} +fn local(id: u32, ty: u32) -> Expr { + value(ExprKind::Local(LocalId(id)), ty) +} +fn step(state: Expr) -> Expr { + value( + ExprKind::Record { + fields: vec![ + ("state".into(), state), + ("value".into(), value(ExprKind::Integer(42), 3)), + ], + }, + 8, + ) +} +fn binder(id: u32, ty: u32) -> Binder { + Binder { + id: LocalId(id), + name: format!("v{id}"), + ty: TypeId(ty), + span: TextRange::new(10, 20), + } +} +fn action(body: Expr) -> Expr { + value( + ExprKind::Lambda { + binder: binder(0, 2), + body: Box::new(body), + }, + 11, + ) +} +fn invocation(input: Expr) -> Expr { + value( + ExprKind::Application(Box::new(local(1, 11)), Box::new(input)), + 8, + ) +} +fn field(id: u32) -> Expr { + value( + ExprKind::FieldAccess { + record: Box::new(local(id, 8)), + field: "state".into(), + }, + 2, + ) +} +fn let_value(id: u32, expression: Expr, body: Expr) -> Expr { + let ty = expression.ty.0; + let result = body.ty.0; + value( + ExprKind::Let { + bindings: vec![Binding { + binder: binder(id, ty), + quantified: Vec::new(), + span: expression.span, + value: expression, + }], + body: Box::new(body), + }, + result, + ) +} +fn fixture(body: Expr) -> Module { + let mut module = crate::state::tests::fixture(); + module + .types + .push(crate::Type::Constructor(crate::TypeConstructor::Boolean)); + module + .types + .push(crate::Type::Application(TypeId(9), TypeId(11))); + module + .types + .push(crate::Type::Application(TypeId(13), TypeId(11))); + let action = action(body); + let body = value( + ExprKind::Lambda { + binder: binder(1, 11), + body: Box::new(action), + }, + 14, + ); + module.declarations.push(Declaration { + symbol: SymbolId::new(ModuleId(0), 0), + name: "action".into(), + name_span: body.span, + quantified: Vec::new(), + ty: TypeId(14), + span: body.span, + value: body, + }); + module +} + +#[test] +fn pure_return_uses_the_lambda_parameter_without_inventing_a_root() { + let module = fixture(step(local(0, 2))); + let flows = check(&module).unwrap(); + assert_eq!(flows.len(), 1); + assert!(flows[0].operations.is_empty()); + assert_eq!( + flows[0].graph.blocks[0].terminator, + Terminator::Return(vec![DependencyId(0)]) + ); +} + +#[test] +fn actual_calls_supply_successors_and_aliases_retain_their_producers() { + let body = let_value( + 2, + invocation(local(0, 2)), + let_value(3, invocation(field(2)), step(field(3))), + ); + let module = fixture(body); + let flows = check(&module).unwrap(); + let flow = &flows[0]; + assert_eq!(flow.operations.len(), 2); + assert_eq!(flow.operations[0].input, DependencyId(0)); + assert_eq!(flow.operations[1].input, flow.operations[0].output); + assert!( + flow.operations + .iter() + .all(|operation| matches!(operation.expression.kind, ExprKind::Application(..))) + ); + assert_eq!(flow.graph.blocks[0].transitions.len(), 2); +} + +#[test] +fn fixed_arity_state_invocation_retains_its_actual_operation_dependency() { + let mut module = fixture(invocation(local(0, 2))); + module.types[11] = crate::Type::Closure { + parameters: vec![TypeId(2)], + result: TypeId(8), + }; + module.verify().unwrap(); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 1); + assert_eq!(flows[0].operations[0].input, DependencyId(0)); + assert_eq!( + flows[0].graph.blocks[0].terminator, + Terminator::Return(vec![flows[0].operations[0].output]) + ); +} + +#[test] +fn discarded_payload_does_not_allow_discarding_a_state_operation() { + let module = fixture(let_value(2, invocation(local(0, 2)), step(local(0, 2)))); + let errors = check(&module).unwrap_err(); + assert_eq!( + errors[0].message, + "state return discards an executed operation" + ); +} + +#[test] +fn repeated_use_of_an_observable_predecessor_is_rejected() { + let module = fixture(let_value( + 2, + invocation(local(0, 2)), + let_value(3, invocation(local(0, 2)), step(field(3))), + )); + assert_eq!( + check(&module).unwrap_err()[0].message, + "state call consumes a stale dependency" + ); +} + +#[test] +fn branch_exclusive_calls_transfer_the_executed_successor_to_a_join() { + let body = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(invocation(local(0, 2))), + else_branch: Box::new(invocation(local(0, 2))), + }, + 8, + ); + let module = fixture(body); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 2); + assert_eq!(flows[0].graph.blocks.len(), 4); + flows[0].graph.verify().unwrap(); +} + +#[test] +fn a_pure_branch_join_preserves_incoming_state_aliases() { + let choice = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(value(ExprKind::Integer(1), 3)), + else_branch: Box::new(value(ExprKind::Integer(2), 3)), + }, + 3, + ); + let module = fixture(let_value(2, choice, step(local(0, 2)))); + module.verify().unwrap(); + assert!(check(&module).unwrap()[0].operations.is_empty()); +} + +#[test] +fn a_trapping_branch_has_no_normal_successor() { + let choice = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(invocation(local(0, 2))), + else_branch: Box::new(value(ExprKind::Trap, 8)), + }, + 8, + ); + let module = fixture(choice); + module.verify().unwrap(); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 1); + assert!( + flows[0] + .graph + .blocks + .iter() + .any(|block| block.terminator == Terminator::Trap) + ); +} + +#[test] +fn a_stale_return_on_one_branch_is_not_hidden_by_a_valid_other_branch() { + let choice = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(let_value(2, invocation(local(0, 2)), step(local(0, 2)))), + else_branch: Box::new(step(local(0, 2))), + }, + 8, + ); + assert!(check(&fixture(choice)).is_err()); +} + +#[test] +fn a_record_pattern_retains_the_called_operations_successor() { + let module = fixture(value( + ExprKind::Case { + scrutinee: Box::new(invocation(local(0, 2))), + branches: vec![CaseBranch { + pattern: Pattern { + ty: TypeId(8), + span: TextRange::new(10, 20), + kind: PatternKind::Record { + fields: vec![( + "state".into(), + Pattern { + ty: TypeId(2), + span: TextRange::new(10, 20), + kind: PatternKind::Var { + id: LocalId(2), + ty: TypeId(2), + }, + }, + )], + }, + }, + value: step(local(2, 2)), + span: TextRange::new(10, 20), + coverage: CaseBranchCoverage::Source, + }], + }, + 8, + )); + module.verify().unwrap(); + assert_eq!(check(&module).unwrap()[0].operations.len(), 1); +} + +#[test] +fn core_verification_rejects_a_well_typed_but_stale_state_return() { + let module = fixture(let_value(2, invocation(local(0, 2)), step(local(0, 2)))); + let errors = module.verify().unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message == "state return discards an executed operation") + ); + assert!(errors.iter().all(|error| error.module == ModuleId(0))); +} + +#[test] +fn state_values_cannot_be_fabricated_by_unknown_payloads() { + let mut module = fixture(step(local(4, 2))); + // Producer validation is also callable independently of ordinary typing; + // a dangling local must not acquire a fresh state root. + assert_eq!( + check(&module).unwrap_err()[0].message, + "state value has no checked producer provenance" + ); + module.declarations.clear(); + assert!(check(&module).unwrap().is_empty()); +} + +#[test] +fn a_structurally_valid_graph_cannot_omit_real_source_invocations() { + let module = fixture(invocation(local(0, 2))); + let mut flows = check(&module).unwrap(); + let flow = &mut flows[0]; + flow.operations.clear(); + flow.graph.blocks[0].transitions.clear(); + flow.graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(0)]); + flow.graph.verify().unwrap(); + assert_eq!( + flow.verify(&module).unwrap_err().message, + "state graph changes executing source invocation order or coverage" + ); +} + +#[test] +fn a_structurally_valid_graph_cannot_reorder_real_source_invocations() { + let module = fixture(let_value(2, invocation(local(0, 2)), invocation(field(2)))); + let mut flows = check(&module).unwrap(); + let flow = &mut flows[0]; + let first = flow.operations[0].expression; + flow.operations[0].expression = flow.operations[1].expression; + flow.operations[1].expression = first; + flow.graph.verify().unwrap(); + assert_eq!( + flow.verify(&module).unwrap_err().message, + "state graph changes executing source invocation order or coverage" + ); +} + +#[test] +fn source_evidence_cannot_be_reused_with_a_different_arena() { + let module = fixture(invocation(local(0, 2))); + let flows = check(&module).unwrap(); + let other = module.clone(); + assert_eq!( + flows[0].verify(&other).unwrap_err().message, + "state flow belongs to a different source arena" + ); +} + +#[test] +fn unreachable_calls_after_a_trap_do_not_create_successors() { + let module = fixture(let_value( + 2, + value(ExprKind::Trap, 3), + invocation(local(0, 2)), + )); + module.verify().unwrap(); + let flows = check(&module).unwrap(); + assert!(flows[0].operations.is_empty()); + assert_eq!(flows[0].graph.blocks[0].terminator, Terminator::Trap); +} + +#[test] +fn a_proven_pure_state_body_may_return_its_incoming_state_unchanged() { + let pure = value( + ExprKind::Lambda { + binder: binder(5, 2), + body: Box::new(step(local(5, 2))), + }, + 11, + ); + let call = value( + ExprKind::Application(Box::new(pure), Box::new(local(0, 2))), + 8, + ); + let module = fixture(let_value(2, call, step(local(0, 2)))); + module.verify().unwrap(); + assert!( + check(&module) + .unwrap() + .iter() + .all(|flow| flow.operations.is_empty()) + ); +} + +#[test] +fn an_invocation_after_a_branch_uses_the_selected_successor() { + let branch = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(invocation(local(0, 2))), + else_branch: Box::new(invocation(local(0, 2))), + }, + 8, + ); + let module = fixture(let_value(2, branch, invocation(field(2)))); + module.verify().unwrap(); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 3); + assert_eq!(flows[0].graph.blocks.last().unwrap().transitions.len(), 1); +} + +#[test] +fn a_valid_graph_cannot_move_a_call_to_the_other_source_branch() { + let body = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(invocation(local(0, 2))), + else_branch: Box::new(invocation(local(0, 2))), + }, + 8, + ); + let module = fixture(body); + let mut flows = check(&module).unwrap(); + let flow = &mut flows[0]; + let left = flow.graph.blocks[1].transitions.remove(0); + let right = flow.graph.blocks[2].transitions.remove(0); + flow.graph.blocks[1].transitions.push(right); + flow.graph.blocks[2].transitions.push(left); + for index in [1, 2] { + let block = &mut flow.graph.blocks[index]; + let transition = &mut block.transitions[0]; + transition.input = block.parameters[0].id; + flow.operations[transition.operation as usize].input = transition.input; + let Terminator::Jump(edge) = &mut block.terminator else { + unreachable!() + }; + edge.arguments[0] = transition.output.id; + } + flow.graph.verify().unwrap(); + assert_eq!( + flow.verify(&module).unwrap_err().message, + "state graph changes source dependency provenance or control flow" + ); +} + +#[test] +fn a_pure_payload_branch_keeps_a_previously_evaluated_state_field_valid() { + let payload = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(value(ExprKind::Integer(1), 3)), + else_branch: Box::new(value(ExprKind::Integer(2), 3)), + }, + 3, + ); + let module = fixture(value( + ExprKind::Record { + fields: vec![("state".into(), local(0, 2)), ("value".into(), payload)], + }, + 8, + )); + module.verify().unwrap(); +} diff --git a/crates/psrs-core/src/state/flow/verify.rs b/crates/psrs-core/src/state/flow/verify.rs new file mode 100644 index 00000000..1acfb052 --- /dev/null +++ b/crates/psrs-core/src/state/flow/verify.rs @@ -0,0 +1,198 @@ +use super::{FunctionFlow, Operation, RegionId}; +use crate::{Expr, ExprKind, Module, VerifyError}; +use std::collections::HashSet; + +impl FunctionFlow<'_> { + /// Check both graph validity and its correspondence to this immutable body. + /// A structurally valid graph alone is not a certificate for source calls. + pub fn verify(&self, module: &Module) -> Result<(), VerifyError> { + let fail = |span, message| VerifyError { + module: self.owner, + span, + message, + }; + if !std::ptr::eq(self.source, module) { + return Err(fail( + self.lambda.span, + "state flow belongs to a different source arena", + )); + } + self.graph + .verify() + .map_err(|error| fail(error.span, error.message))?; + let ExprKind::Lambda { binder, body } = &self.lambda.kind else { + return Err(fail(self.lambda.span, "state flow has no source lambda")); + }; + let region = crate::state::region(module, binder.ty) + .ok_or_else(|| fail(binder.span, "state flow parameter has no checked region"))?; + if !module.types_equivalent(region, self.region) { + return Err(fail(binder.span, "state flow changes its source region")); + } + if self.graph.regions != [RegionId(0)] { + return Err(fail( + binder.span, + "state graph changes its checked source region mapping", + )); + } + let mut expressions = HashSet::new(); + let mut invocations = Vec::new(); + executed(module, body, &mut expressions, &mut invocations); + let mut seen = HashSet::new(); + for block in &self.graph.blocks { + for transition in &block.transitions { + let operation = self + .operations + .get(transition.operation as usize) + .ok_or_else(|| { + fail(transition.span, "state transition has no source operation") + })?; + if !seen.insert(transition.operation) + || operation.input != transition.input + || operation.output != transition.output.id + || operation.expression.span != transition.span + { + return Err(fail( + transition.span, + "state transition disagrees with its source operation", + )); + } + self.verify_operation(module, operation, &expressions)?; + } + } + if seen.len() != self.operations.len() { + return Err(fail( + self.lambda.span, + "state graph omits a checked source operation", + )); + } + let actual = self + .operations + .iter() + .map(|operation| operation.expression as *const Expr) + .collect::>(); + if actual != invocations { + return Err(fail( + self.lambda.span, + "state graph changes executing source invocation order or coverage", + )); + } + // Re-derive the source relation so matching call identities alone + // cannot authorize different argument provenance or branch placement. + // A transformed IR needs its own correspondence verifier; it cannot + // mutate this source certificate and retain a checked claim. + let expected = super::derive(module, self.owner, self.lambda)?; + if self.graph != expected.graph { + return Err(fail( + self.lambda.span, + "state graph changes source dependency provenance or control flow", + )); + } + Ok(()) + } + + fn verify_operation( + &self, + module: &Module, + operation: &Operation<'_>, + expressions: &HashSet<*const Expr>, + ) -> Result<(), VerifyError> { + let expression = operation.expression; + let fail = |message| VerifyError { + module: self.owner, + span: expression.span, + message, + }; + if !expressions.contains(&(expression as *const Expr)) { + return Err(fail( + "state operation does not belong to its executing source body", + )); + } + let ExprKind::Application(function, argument) = &expression.kind else { + return Err(fail( + "state transition does not address an actual invocation", + )); + }; + let signature = crate::state::signature(module, function.ty).map_err(fail)?; + let (state, payload) = crate::state::step(module, expression.ty) + .ok_or_else(|| fail("state operation result has no checked Step contract"))?; + if !signature.parameters.is_empty() + || !module.types_equivalent(signature.region, self.region) + || !module.types_equivalent(signature.state, argument.ty) + || !module.types_equivalent(signature.state, state) + || !module.types_equivalent(signature.payload, payload) + { + return Err(fail( + "state operation disagrees with its checked invocation contract", + )); + } + Ok(()) + } +} + +fn executed( + module: &Module, + value: &Expr, + expressions: &mut HashSet<*const Expr>, + invocations: &mut Vec<*const Expr>, +) -> bool { + psrs_span::with_sufficient_stack(|| { + expressions.insert(value as *const Expr); + let mut visit = |value| executed(module, value, expressions, invocations); + match &value.kind { + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => arguments.iter().all(visit), + ExprKind::Record { fields } => fields.iter().all(|(_, value)| visit(value)), + ExprKind::RecordUpdate { record, fields } => { + visit(record) && fields.iter().all(|(_, value)| visit(value)) + } + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } => visit(record), + ExprKind::Application(function, argument) => { + if !visit(function) || !visit(argument) { + return false; + } + if crate::state::region(module, argument.ty).is_some() + && !super::summary::passthrough(module, function) + { + invocations.push(value as *const Expr); + } + true + } + ExprKind::Let { bindings, body } => { + bindings.iter().all(|binding| visit(&binding.value)) && visit(body) + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + if !visit(condition) { + return false; + } + let left = visit(then_branch); + let right = visit(else_branch); + left || right + } + ExprKind::Case { + scrutinee, + branches, + } => { + if !visit(scrutinee) { + return false; + } + let mut returns = false; + for branch in branches { + returns |= visit(&branch.value); + } + returns + } + // Closure creation is inert, so nested execution bodies do not + // supply transitions to this function's dependency graph. + ExprKind::Trap => false, + _ => true, + } + }) +} diff --git a/crates/psrs-core/src/state/mod.rs b/crates/psrs-core/src/state/mod.rs new file mode 100644 index 00000000..c7614c95 --- /dev/null +++ b/crates/psrs-core/src/state/mod.rs @@ -0,0 +1,76 @@ +//! Shared source contracts for state-transforming callables. +//! +//! These contracts refer only to registered primitive identities and checked +//! structural records. They do not recognize a library's action constructor. +use crate::{Module, Type, TypeConstructor, TypeId, call_parts, row_fields}; +use psrs_hir::TypeId as HirTypeId; + +pub mod dependency; +pub mod flow; +pub mod primitive; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct StateSignature { + /// Ordinary arguments evaluated before the final state invocation. + pub parameters: Vec, + pub state: TypeId, + pub region: TypeId, + pub payload: TypeId, +} + +/// Reads State's exactly one nominal region argument. A dangling or unsaturated +/// application is not a valid state value. +pub fn region(module: &Module, ty: TypeId) -> Option { + let (head, arguments) = module.applied_constructor(ty)?; + if head != TypeConstructor::User(HirTypeId::PRIM_STATE) || arguments.len() != 1 { + return None; + } + Some(arguments[0]) +} + +/// Reads the complete structural Step contract, rejecting open rows, duplicate +/// fields, extra fields and state/region mismatch. +pub fn step(module: &Module, ty: TypeId) -> Option<(TypeId, TypeId)> { + let Type::Application(head, row) = module.types.get(ty.0 as usize)? else { + return None; + }; + if module.types.get(head.0 as usize) != Some(&Type::Constructor(TypeConstructor::Record)) { + return None; + } + let (fields, tail) = row_fields(&module.types, *row)?; + if tail.is_some() || fields.len() != 2 { + return None; + } + let state = fields.iter().find(|(name, _)| name == "state")?.1; + let payload = fields.iter().find(|(name, _)| name == "value")?.1; + region(module, state)?; + Some((state, payload)) +} + +/// Validates an ordinary checked function's state input and result. No source +/// constructor or module name is interpreted as evidence. +pub fn signature(module: &Module, ty: TypeId) -> Result { + let (parameters, result) = call_parts(&module.types, ty)?; + for (index, parameter) in parameters.iter().copied().enumerate() { + if let Some(region) = region(module, parameter) { + if index + 1 != parameters.len() { + return Err("state invocation parameter must be last in its call boundary"); + } + let (result_state, payload) = step(module, result) + .ok_or("state function must return a closed state/value record")?; + if !module.types_equivalent(parameter, result_state) { + return Err("state function returns a different region"); + } + return Ok(StateSignature { + parameters: parameters[..index].to_vec(), + state: parameter, + region, + payload, + }); + } + } + Err("state function has no state invocation parameter") +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-core/src/state/primitive.rs b/crates/psrs-core/src/state/primitive.rs new file mode 100644 index 00000000..bca227f1 --- /dev/null +++ b/crates/psrs-core/src/state/primitive.rs @@ -0,0 +1,73 @@ +//! Type contracts for checked state primitives before representation erasure. +use super::signature; +use crate::{Module, Type, TypeConstructor, TypeId, scheme_parts}; +use psrs_hir::{Intrinsic, StateOperation, TypeId as HirTypeId}; +use std::collections::HashSet; + +pub fn verify( + module: &Module, + intrinsic: Intrinsic, + arguments: &[TypeId], + result: TypeId, +) -> Result<(), &'static str> { + let operation = intrinsic + .state_operation() + .ok_or("operation has no state contract")?; + if arguments.len() != intrinsic.descriptor().arity as usize { + return Err("state primitive has an invalid argument count"); + } + let checked = signature(module, arguments[0])?; + if !checked.parameters.is_empty() || !module.types_equivalent(checked.payload, result) { + return Err("state runner has an invalid callable payload"); + } + match operation { + StateOperation::RunWorld => { + if module.types.get(checked.region.0 as usize) + != Some(&Type::Constructor(TypeConstructor::User( + HirTypeId::PRIM_REAL_WORLD, + ))) + { + return Err("world runner requires the RealWorld region"); + } + } + StateOperation::RunRegion => { + let (variables, _) = scheme_parts(&module.types, arguments[0]) + .ok_or("region runner has an invalid quantified callable")?; + let Some(Type::Variable(region)) = module.types.get(checked.region.0 as usize) else { + return Err("region runner requires a quantified region"); + }; + if variables.as_slice() != [*region] { + return Err("region runner requires exactly one fresh region binder"); + } + if mentions(module, checked.payload, checked.region, &mut HashSet::new()) { + return Err("region runner result escapes its region"); + } + } + } + Ok(()) +} + +fn mentions(module: &Module, ty: TypeId, region: TypeId, seen: &mut HashSet) -> bool { + if !seen.insert(ty) { + return false; + } + if module.types_equivalent(ty, region) { + return true; + } + match module.types.get(ty.0 as usize) { + Some(Type::Application(head, argument)) => { + mentions(module, *head, region, seen) || mentions(module, *argument, region, seen) + } + Some(Type::RowExtend { ty, tail, .. }) => { + mentions(module, *ty, region, seen) || mentions(module, *tail, region, seen) + } + Some(Type::ForAll { body, .. }) => mentions(module, *body, region, seen), + Some(Type::Closure { parameters, result }) => { + parameters + .iter() + .any(|ty| mentions(module, *ty, region, seen)) + || mentions(module, *result, region, seen) + } + _ => false, + } +} diff --git a/crates/psrs-core/src/state/tests.rs b/crates/psrs-core/src/state/tests.rs new file mode 100644 index 00000000..cfcf8f6d --- /dev/null +++ b/crates/psrs-core/src/state/tests.rs @@ -0,0 +1,270 @@ +use super::*; +use psrs_hir::{ModuleId, TypeVariableId}; +use psrs_span::TextRange; + +pub(super) fn fixture() -> Module { + Module { + id: ModuleId(0), + name: "UnrelatedStateLibrary".into(), + externals: Vec::new(), + external_types: Vec::new(), + types: vec![ + Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_STATE)), + Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_REAL_WORLD)), + Type::Application(TypeId(0), TypeId(1)), + Type::Constructor(TypeConstructor::Int), + Type::RowEmpty, + Type::RowExtend { + label: "value".into(), + ty: TypeId(3), + tail: TypeId(4), + }, + Type::RowExtend { + label: "state".into(), + ty: TypeId(2), + tail: TypeId(5), + }, + Type::Constructor(TypeConstructor::Record), + Type::Application(TypeId(7), TypeId(6)), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(9), TypeId(2)), + Type::Application(TypeId(10), TypeId(8)), + ], + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: Vec::new(), + type_names: Vec::new(), + entry: None, + span: TextRange::new(0, 0), + } +} + +#[test] +fn registered_state_identity_needs_no_effect_or_library_name() { + let module = fixture(); + let signature = signature(&module, TypeId(11)).unwrap(); + assert_eq!(signature.region, TypeId(1)); + assert_eq!(signature.payload, TypeId(3)); + assert!(signature.parameters.is_empty()); +} + +#[test] +fn fixed_arity_state_closure_preserves_its_payload_boundary() { + let mut module = fixture(); + module.types.push(Type::Application(TypeId(9), TypeId(3))); + module.types.push(Type::Application(TypeId(12), TypeId(3))); + let Type::RowExtend { ty, .. } = &mut module.types[5] else { + unreachable!() + }; + *ty = TypeId(13); + module.types.push(Type::Closure { + parameters: vec![TypeId(3), TypeId(2)], + result: TypeId(8), + }); + let checked = signature(&module, TypeId(14)).unwrap(); + assert_eq!(checked.parameters, [TypeId(3)]); + assert_eq!(checked.state, TypeId(2)); + assert_eq!(checked.payload, TypeId(13)); +} + +#[test] +fn function_payload_is_not_an_extra_action_parameter() { + let mut module = fixture(); + module.types.push(Type::Application(TypeId(9), TypeId(3))); + module.types.push(Type::Application(TypeId(12), TypeId(3))); + let Type::RowExtend { ty, .. } = &mut module.types[5] else { + unreachable!() + }; + *ty = TypeId(13); + let signature = signature(&module, TypeId(11)).unwrap(); + assert_eq!(signature.payload, TypeId(13)); + assert!(signature.parameters.is_empty()); +} + +#[test] +fn step_requires_a_closed_complete_structural_contract() { + let mut module = fixture(); + module.types[4] = Type::Variable(TypeVariableId(7)); + assert!(step(&module, TypeId(8)).is_none()); + module.types[4] = Type::RowExtend { + label: "extra".into(), + ty: TypeId(3), + tail: TypeId(4), + }; + assert!( + step(&module, TypeId(8)).is_none(), + "cyclic rows must terminate with rejection" + ); + module.types[4] = Type::RowEmpty; + let Type::RowExtend { label, .. } = &mut module.types[5] else { + unreachable!() + }; + *label = "state".into(); + assert!( + step(&module, TypeId(8)).is_none(), + "duplicate labels cannot supply the payload" + ); +} + +#[test] +fn state_result_must_preserve_the_nominal_region() { + let mut module = fixture(); + module.types.push(Type::Variable(TypeVariableId(8))); + module.types.push(Type::Application(TypeId(0), TypeId(12))); + let Type::RowExtend { ty, .. } = &mut module.types[6] else { + unreachable!() + }; + *ty = TypeId(13); + assert_eq!( + signature(&module, TypeId(11)).unwrap_err(), + "state function returns a different region" + ); +} + +#[test] +fn an_unrelated_opaque_constructor_is_not_state() { + let mut module = fixture(); + module.types[0] = Type::Constructor(TypeConstructor::User(HirTypeId::new(ModuleId(3), 0))); + assert!(signature(&module, TypeId(11)).is_err()); +} + +#[test] +fn a_world_runner_checks_both_the_payload_and_the_region() { + let mut module = fixture(); + primitive::verify( + &module, + psrs_hir::Intrinsic::RunWorld, + &[TypeId(11)], + TypeId(3), + ) + .unwrap(); + assert!( + primitive::verify( + &module, + psrs_hir::Intrinsic::RunWorld, + &[TypeId(11)], + TypeId(2) + ) + .is_err() + ); + module.types[1] = Type::Variable(TypeVariableId(8)); + assert_eq!( + primitive::verify( + &module, + psrs_hir::Intrinsic::RunWorld, + &[TypeId(11)], + TypeId(3) + ) + .unwrap_err(), + "world runner requires the RealWorld region" + ); +} + +#[test] +fn a_region_runner_requires_rank_n_and_rejects_escape() { + let mut module = fixture(); + module.types[1] = Type::Variable(TypeVariableId(8)); + assert!( + primitive::verify( + &module, + psrs_hir::Intrinsic::RunRegion, + &[TypeId(11)], + TypeId(3) + ) + .is_err() + ); + module.types.push(Type::ForAll { + variables: vec![TypeVariableId(8)], + body: TypeId(11), + }); + primitive::verify( + &module, + psrs_hir::Intrinsic::RunRegion, + &[TypeId(12)], + TypeId(3), + ) + .unwrap(); + let Type::RowExtend { ty, .. } = &mut module.types[5] else { + unreachable!() + }; + *ty = TypeId(2); + assert_eq!( + primitive::verify( + &module, + psrs_hir::Intrinsic::RunRegion, + &[TypeId(12)], + TypeId(2) + ) + .unwrap_err(), + "region runner result escapes its region" + ); +} + +#[test] +fn core_verification_checks_the_world_runner_contract() { + use crate::{Binder, Declaration, Expr, ExprKind}; + use psrs_hir::{Intrinsic, LocalId, SymbolId}; + let mut module = fixture(); + let span = TextRange::new(0, 10); + let action = Expr { + ty: TypeId(11), + span, + kind: ExprKind::Lambda { + binder: Binder { + id: LocalId(0), + name: "state".into(), + ty: TypeId(2), + span, + }, + body: Box::new(Expr { + ty: TypeId(8), + span, + kind: ExprKind::Record { + fields: vec![ + ( + "state".into(), + Expr { + kind: ExprKind::Local(LocalId(0)), + ty: TypeId(2), + span, + }, + ), + ( + "value".into(), + Expr { + kind: ExprKind::Integer(42), + ty: TypeId(3), + span, + }, + ), + ], + }, + }), + }, + }; + module.declarations.push(Declaration { + symbol: SymbolId::new(ModuleId(0), 0), + name: "main".into(), + name_span: span, + quantified: Vec::new(), + ty: TypeId(3), + span, + value: crate::primitive::primitive_value( + Intrinsic::RunWorld, + vec![action], + TypeId(3), + span, + ), + }); + module.verify().unwrap(); + module.types[1] = Type::Constructor(TypeConstructor::Int); + let errors = module.verify().unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message == "world runner requires the RealWorld region"), + "{errors:?}" + ); +} diff --git a/crates/psrs-core/src/tests/mod.rs b/crates/psrs-core/src/tests/mod.rs index d7526094..4e2b303b 100644 --- a/crates/psrs-core/src/tests/mod.rs +++ b/crates/psrs-core/src/tests/mod.rs @@ -8,6 +8,7 @@ mod instantiation; mod link; mod patterns; mod rank_n; +mod record_scope; mod rows; /// Appends an arrow `parameter -> result` as the application spine and returns diff --git a/crates/psrs-core/src/tests/record_scope.rs b/crates/psrs-core/src/tests/record_scope.rs new file mode 100644 index 00000000..48b390cd --- /dev/null +++ b/crates/psrs-core/src/tests/record_scope.rs @@ -0,0 +1,235 @@ +use super::*; +use psrs_hir::{LocalId, ModuleId, SymbolId, TypeVariableId}; +use psrs_span::TextRange; + +fn fixture(unrelated: bool, sibling: bool) -> Module { + let span = TextRange::new(0, 1); + let variable = TypeVariableId(0); + let used_variable = TypeVariableId(u32::from(unrelated)); + let mut types = vec![ + Type::Variable(variable), + Type::Variable(used_variable), + Type::Constructor(TypeConstructor::Function), + Type::Constructor(TypeConstructor::Int), + ]; + let mut arrow = |argument| { + let head = TypeId(types.len() as u32); + types.push(Type::Application(TypeId(2), argument)); + let result = TypeId(types.len() as u32); + types.push(Type::Application(head, argument)); + result + }; + let value_type = arrow(TypeId(1)); + let field_body = arrow(TypeId(0)); + let int_function = arrow(TypeId(3)); + let field = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![variable], + body: field_body, + }); + let mut row = TypeId(types.len() as u32); + types.push(Type::RowEmpty); + if sibling { + let tail = row; + row = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: "sibling".into(), + ty: int_function, + tail, + }); + } + let tail = row; + row = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: "method".into(), + ty: field, + tail, + }); + let record_head = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::Record)); + let record = TypeId(types.len() as u32); + types.push(Type::Application(record_head, row)); + let declaration = |index, name: &str, quantified, ty, value| Declaration { + symbol: SymbolId::new(ModuleId(0), index), + name: name.into(), + name_span: span, + quantified, + ty, + value, + span, + }; + let identity = declaration( + 0, + "identity", + vec![used_variable], + value_type, + Expr { + kind: ExprKind::Lambda { + binder: Binder { + id: LocalId(0), + name: "value".into(), + ty: TypeId(1), + span, + }, + body: Box::new(Expr { + kind: ExprKind::Local(LocalId(0)), + ty: TypeId(1), + span, + }), + }, + ty: value_type, + span, + }, + ); + let value = || Expr { + kind: ExprKind::Global(identity.symbol), + ty: value_type, + span, + }; + let mut fields = vec![("method".into(), value())]; + if sibling { + fields.push(("sibling".into(), value())); + } + let dictionary = declaration( + 1, + "dictionary", + vec![], + record, + Expr { + kind: ExprKind::Record { fields }, + ty: record, + span, + }, + ); + Module { + id: ModuleId(0), + name: "RecordScope".into(), + types, + type_names: vec![], + externals: vec![], + external_types: vec![], + newtype_ids: vec![], + opaque_ids: vec![], + callable_types: vec![], + constructors: vec![], + declarations: vec![identity, dictionary], + entry: None, + span, + } +} + +#[test] +fn quantified_record_field_scopes_its_instantiated_method() { + fixture(false, false).verify().unwrap(); +} + +#[test] +fn record_field_quantifier_does_not_bind_an_unrelated_variable() { + assert_scope_error(fixture(true, false)); +} + +#[test] +fn record_field_quantifier_does_not_leak_to_sibling_fields() { + assert_scope_error(fixture(false, true)); +} + +fn projection(unrelated: bool, polymorphic: bool) -> Module { + let mut module = fixture(unrelated, false); + let field = module + .record_field(module.declarations[1].ty, "method") + .unwrap(); + let Type::ForAll { body, .. } = module.types[field.0 as usize] else { + panic!("quantified method expected"); + }; + for ty in &mut module.types { + if let Type::RowExtend { label, ty, .. } = ty + && label == "method" + { + *ty = body; + } + } + let selected = if polymorphic { field } else { body }; + let declaration = &mut module.declarations[1]; + let record = declaration.value.clone(); + declaration.ty = selected; + declaration.value = Expr { + kind: ExprKind::FieldAccess { + record: Box::new(record), + field: "method".into(), + }, + ty: selected, + span: declaration.span, + }; + module +} + +#[test] +fn quantified_projection_scopes_the_record_instantiation() { + projection(false, true).verify().unwrap(); +} + +#[test] +fn projection_quantifier_does_not_bind_an_unrelated_variable() { + assert_scope_error(projection(true, true)); +} + +#[test] +fn a_monomorphic_projection_does_not_introduce_type_variables() { + assert_scope_error(projection(false, false)); +} + +fn array(unrelated: bool, empty: bool) -> Module { + let mut module = fixture(unrelated, false); + let dictionary = &module.declarations[1]; + let field = module.record_field(dictionary.ty, "method").unwrap(); + let Type::ForAll { body, .. } = module.types[field.0 as usize] else { + panic!("quantified method expected"); + }; + let head = TypeId(module.types.len() as u32); + module.types.push(Type::Constructor(TypeConstructor::Array)); + let applied = TypeId(module.types.len() as u32); + module.types.push(Type::Application(head, body)); + let quantified = TypeId(module.types.len() as u32); + module.types.push(Type::ForAll { + variables: vec![TypeVariableId(0)], + body: applied, + }); + let elements = if empty { + vec![] + } else { + vec![Expr { + kind: ExprKind::Global(module.declarations[0].symbol), + ty: module.declarations[0].ty, + span: module.span, + }] + }; + let declaration = &mut module.declarations[1]; + declaration.ty = quantified; + declaration.value = Expr { + kind: ExprKind::Array { elements }, + ty: quantified, + span: module.span, + }; + module +} + +#[test] +fn quantified_array_values_scope_their_elements() { + array(false, false).verify().unwrap(); + array(false, true).verify().unwrap(); +} + +#[test] +fn an_array_quantifier_does_not_bind_an_unrelated_variable() { + assert_scope_error(array(true, false)); +} + +fn assert_scope_error(module: Module) { + let errors = module.verify().unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message == "type variable is outside its quantifier scope"), + "{errors:?}" + ); +} diff --git a/crates/psrs-core/src/types/call.rs b/crates/psrs-core/src/types/call.rs new file mode 100644 index 00000000..0c5f7917 --- /dev/null +++ b/crates/psrs-core/src/types/call.rs @@ -0,0 +1,38 @@ +//! The checked calling boundary of a Core value, before representation lowering. +use super::{TypeId, arrow_parts, closure_parts, forall_parts, scheme_parts}; +use crate::Type; +use std::collections::HashSet; + +/// A fixed-arity closure retains its result as a value. Ordinary arrows flatten +/// only up to a quantified or explicit-closure result boundary. Non-callable +/// values have no parameters; malformed spines are errors, never empty calls. +pub fn call_parts(types: &[Type], id: TypeId) -> Result<(Vec, TypeId), &'static str> { + let (_, id) = scheme_parts(types, id).ok_or("callable has a dangling or cyclic scheme")?; + if let Some((parameters, result)) = closure_parts(types, id) { + if parameters + .iter() + .chain(std::iter::once(&result)) + .any(|ty| ty.0 as usize >= types.len()) + { + return Err("closure signature has a dangling type"); + } + return Ok((parameters.to_vec(), result)); + } + let mut parameters = Vec::new(); + let mut current = id; + let mut visited = HashSet::new(); + while let Some((parameter, result)) = arrow_parts(types, current) { + if !visited.insert(current) { + return Err("callable has a cyclic arrow spine"); + } + if parameter.0 as usize >= types.len() || result.0 as usize >= types.len() { + return Err("function signature has a dangling type"); + } + parameters.push(parameter); + current = result; + if forall_parts(types, current).is_some() { + break; + } + } + Ok((parameters, current)) +} diff --git a/crates/psrs-core/src/types.rs b/crates/psrs-core/src/types/mod.rs similarity index 99% rename from crates/psrs-core/src/types.rs rename to crates/psrs-core/src/types/mod.rs index ff63e91e..c5f15259 100644 --- a/crates/psrs-core/src/types.rs +++ b/crates/psrs-core/src/types/mod.rs @@ -8,6 +8,9 @@ use psrs_hir::{TypeId as HirTypeId, TypeVariableId}; +mod call; +pub use call::call_parts; + #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub struct TypeId(pub u32); diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 92b3da9c..139ba36a 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -18,6 +18,24 @@ impl Context<'_> { intrinsic: Intrinsic, arguments: &[Expr], ) { + if intrinsic.state_operation().is_some() { + for argument in arguments { + self.expr(argument, None); + } + if let Err(message) = crate::state::primitive::verify( + self.module, + intrinsic, + &arguments + .iter() + .map(|argument| argument.ty) + .collect::>(), + expression.ty, + ) { + self.errors + .push(error(self.owner, expression.span, message)); + } + return; + } match intrinsic { Intrinsic::ArrayLength => self.verify_array_length(expression, &arguments[0]), Intrinsic::ArrayIndex => { diff --git a/crates/psrs-core/src/verify/expr/mod.rs b/crates/psrs-core/src/verify/expr/mod.rs index 0af086dd..6665db16 100644 --- a/crates/psrs-core/src/verify/expr/mod.rs +++ b/crates/psrs-core/src/verify/expr/mod.rs @@ -136,7 +136,8 @@ impl Context<'_> { arguments, } => self.verify_intrinsic(expression, *intrinsic, arguments), ExprKind::Array { elements } => { - let Some(element_type) = array_element(expression.ty, self.module) else { + let body_type = strip_leading_foralls(self.module, expression.ty); + let Some(element_type) = array_element(body_type, self.module) else { self.errors.push(error( self.owner, expression.span, diff --git a/crates/psrs-core/src/verify/mod.rs b/crates/psrs-core/src/verify/mod.rs index b9788703..ef1b4d1c 100644 --- a/crates/psrs-core/src/verify/mod.rs +++ b/crates/psrs-core/src/verify/mod.rs @@ -153,6 +153,11 @@ pub(crate) fn module(module: &Module, source: Option<&Module>) -> Result<(), Vec &mut errors, ); } + if errors.is_empty() + && let Err(state_errors) = crate::state::flow::check(module) + { + errors.extend(state_errors); + } if errors.is_empty() { Ok(()) } else { diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index f9891011..bbd318e6 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -54,13 +54,24 @@ fn scoped_expr_inner( } } ExprKind::Array { elements } => { + let binders = leading_foralls(module, expression.ty); for element in elements { - scoped_expr(element, module, scope, errors); + let mut element_scope = scope.clone(); + open_child_binders(element, &binders, module, &mut element_scope, errors); + scoped_expr(element, module, &mut element_scope, errors); } } ExprKind::Record { fields } => { - for (_, value) in fields { - scoped_expr(value, module, scope, errors); + let field_types = module.record_fields(expression.ty).unwrap_or_default(); + for (label, value) in fields { + let binders = field_types + .iter() + .find(|(field_label, _)| field_label == label) + .map(|(_, ty)| leading_foralls(module, *ty)) + .unwrap_or_default(); + let mut field_scope = scope.clone(); + open_child_binders(value, &binders, module, &mut field_scope, errors); + scoped_expr(value, module, &mut field_scope, errors); } } ExprKind::RecordUpdate { record, fields } => { @@ -69,7 +80,12 @@ fn scoped_expr_inner( scoped_expr(value, module, scope, errors); } } - ExprKind::FieldAccess { record, .. } => scoped_expr(record, module, scope, errors), + ExprKind::FieldAccess { record, .. } => { + let binders = leading_foralls(module, expression.ty); + let mut record_scope = scope.clone(); + open_child_binders(record, &binders, module, &mut record_scope, errors); + scoped_expr(record, module, &mut record_scope, errors); + } ExprKind::RepresentationCast { value, source_type, diff --git a/docs/design/backend/opt/core.md b/docs/design/backend/opt/core.md index d04239eb..47ce4688 100644 --- a/docs/design/backend/opt/core.md +++ b/docs/design/backend/opt/core.md @@ -1,5 +1,10 @@ # Typed Core Optimization +> **Selected extension:** [library-owned effects and state dependencies](../fp/library-owned-effects.md) +> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies +> and checked zero-width projection. Implementation and acceptance evidence +> have not migrated; the existing contracts below remain the implementation baseline. + **Feature:** F-02 **Status:** Draft From c3380cb1d674b9932d8b516d5b70beb74d693372 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:07:37 +0800 Subject: [PATCH 084/148] Add an independent runtime GC storage provider --- crates/psrs-runtime/Cargo.toml | 4 + crates/psrs-runtime/src/abi/mod.rs | 2 + crates/psrs-runtime/src/abi/storage/mod.rs | 113 +++++++++++ .../src/abi/storage/projection.rs | 147 +++++++++++++++ crates/psrs-runtime/src/catalog/encoded.rs | 80 ++++++++ crates/psrs-runtime/src/catalog/mod.rs | 2 + crates/psrs-runtime/src/catalog/model.rs | 1 + crates/psrs-runtime/src/catalog/package.rs | 4 + crates/psrs-runtime/src/lib.rs | 5 + crates/psrs-runtime/src/storage/mod.rs | 106 +++++++++++ crates/psrs-runtime/src/storage/tests.rs | 178 ++++++++++++++++++ 11 files changed, 642 insertions(+) create mode 100644 crates/psrs-runtime/src/abi/storage/mod.rs create mode 100644 crates/psrs-runtime/src/abi/storage/projection.rs create mode 100644 crates/psrs-runtime/src/catalog/encoded.rs create mode 100644 crates/psrs-runtime/src/storage/mod.rs create mode 100644 crates/psrs-runtime/src/storage/tests.rs diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml index 07580ac4..7bf82699 100644 --- a/crates/psrs-runtime/Cargo.toml +++ b/crates/psrs-runtime/Cargo.toml @@ -18,11 +18,15 @@ formatter = ["dep:ryu-js", "dep:libm"] # The executable canonical realloc provider. The Wasm artifact build enables # only this feature, separate from the numeric runtime. allocator = ["dep:dlmalloc"] +# Host-side encoding of the executable GC storage provider. Its target code +# uses Wasm GC directly, without a Rust heap or linear-memory handles. +gc-storage = ["dep:wasm-encoder"] [dependencies] ryu-js = { version = "=1.0.2", default-features = false, optional = true } libm = { version = "=0.2.15", default-features = false, optional = true } dlmalloc = { version = "=0.2.14", default-features = false, optional = true } +wasm-encoder = { workspace = true, optional = true } [dev-dependencies] wasm-encoder = { workspace = true, features = ["wasmparser"] } diff --git a/crates/psrs-runtime/src/abi/mod.rs b/crates/psrs-runtime/src/abi/mod.rs index d8b141fe..3fe6bd1f 100644 --- a/crates/psrs-runtime/src/abi/mod.rs +++ b/crates/psrs-runtime/src/abi/mod.rs @@ -3,9 +3,11 @@ mod allocator; mod number; +mod storage; pub use allocator::*; pub use number::*; +pub use storage::*; /// The runtime imports the application's canonical memory. pub const MEMORY_MODULE: &str = "env"; diff --git a/crates/psrs-runtime/src/abi/storage/mod.rs b/crates/psrs-runtime/src/abi/storage/mod.rs new file mode 100644 index 00000000..0c6f1024 --- /dev/null +++ b/crates/psrs-runtime/src/abi/storage/mod.rs @@ -0,0 +1,113 @@ +//! GC storage ABI, separate from scalar/linear-memory artifact contracts. +//! State dependencies have no physical parameters or results in this ABI. + +mod projection; +pub use projection::*; + +pub const STORAGE_MODULE: &str = "psrs:runtime-storage"; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum StorageType { + I32, + /// A non-null mutable Wasm GC array of nullable eqref values. + Array, + /// A nullable eqref; checked callers own boxing and payload validation. + Value, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum StorageOperation { + Fill, + Read, + Write, + Trap, +} + +/// Checked source-value relations before GC boxing and state projection. +/// Element occurrences in one binding must denote the same source type. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum StorageValue { + Int, + Unit, + Element, + Array, + /// Only a non-returning operation may have an arbitrary payload type. + Any, +} + +pub struct StorageSourceContract { + /// Ordinary parameters before the final logical State parameter. + pub parameters: &'static [StorageValue], + pub payload: StorageValue, +} + +pub struct StorageAbi { + pub export: &'static str, + pub parameters: &'static [StorageType], + pub result: Option, + /// A trap operation has no normal return, despite its physical void type. + pub returns_normally: bool, +} + +impl StorageOperation { + pub const ALL: [Self; 4] = [Self::Fill, Self::Read, Self::Write, Self::Trap]; + + pub fn from_export(export: &str) -> Option { + Self::ALL + .into_iter() + .find(|operation| operation.abi().export == export) + } + + /// State regions are generic and must agree between input and successor. + pub const fn source_contract(self) -> StorageSourceContract { + use StorageValue::*; + match self { + Self::Fill => StorageSourceContract { + parameters: &[Int, Element], + payload: Array, + }, + Self::Read => StorageSourceContract { + parameters: &[Array, Int], + payload: Element, + }, + Self::Write => StorageSourceContract { + parameters: &[Array, Int, Element], + payload: Unit, + }, + Self::Trap => StorageSourceContract { + parameters: &[], + payload: Any, + }, + } + } + + pub const fn abi(self) -> StorageAbi { + use StorageType::*; + match self { + Self::Fill => StorageAbi { + export: "array_fill", + parameters: &[I32, Value], + result: Some(Array), + returns_normally: true, + }, + Self::Read => StorageAbi { + export: "array_read", + parameters: &[Array, I32], + result: Some(Value), + returns_normally: true, + }, + Self::Write => StorageAbi { + export: "array_write", + parameters: &[Array, I32, Value], + result: None, + returns_normally: true, + }, + Self::Trap => StorageAbi { + export: "trap", + parameters: &[], + result: None, + returns_normally: false, + }, + } + } +} diff --git a/crates/psrs-runtime/src/abi/storage/projection.rs b/crates/psrs-runtime/src/abi/storage/projection.rs new file mode 100644 index 00000000..ed126001 --- /dev/null +++ b/crates/psrs-runtime/src/abi/storage/projection.rs @@ -0,0 +1,147 @@ +//! Checked source-to-raw storage call contracts, with no compiler IR dependency. +use super::{StorageAbi, StorageOperation, StorageSourceContract, StorageType, StorageValue}; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum StorageResultProjection { + /// The caller recovers a checked payload from the declared raw result. + Value(StorageType), + /// The export returns normally without a value. The caller produces Unit. + Unit, + /// The export cannot return normally; no successor or payload is produced. + Never, +} + +/// Validated correspondence between source operands and raw ABI operands. +/// This does not authorize erasure of a compiler's dependency graph or provide +/// boxing, reference validation, or instruction correspondence evidence. +pub struct StorageCallProjection { + source: StorageSourceContract, + abi: StorageAbi, + result: StorageResultProjection, +} + +impl StorageCallProjection { + pub fn checked(source: StorageSourceContract, abi: StorageAbi) -> Result { + if source.parameters.len() != abi.parameters.len() { + return Err("runtime source and physical argument counts disagree"); + } + for (source, physical) in source.parameters.iter().zip(abi.parameters) { + if !matches!( + (source, physical), + (StorageValue::Int, StorageType::I32) + | (StorageValue::Array, StorageType::Array) + | (StorageValue::Element, StorageType::Value) + ) { + return Err("runtime source operand has no declared raw storage projection"); + } + } + let result = if !abi.returns_normally { + if abi.result.is_some() || source.payload != StorageValue::Any { + return Err( + "non-returning storage export must have no raw result and an arbitrary source payload", + ); + } + StorageResultProjection::Never + } else { + match (source.payload, abi.result) { + (StorageValue::Int, Some(StorageType::I32)) => { + StorageResultProjection::Value(StorageType::I32) + } + (StorageValue::Array, Some(StorageType::Array)) => { + StorageResultProjection::Value(StorageType::Array) + } + (StorageValue::Element, Some(StorageType::Value)) => { + StorageResultProjection::Value(StorageType::Value) + } + (StorageValue::Unit, None) => StorageResultProjection::Unit, + _ => return Err("runtime source payload has no declared raw result projection"), + } + }; + Ok(Self { + source, + abi, + result, + }) + } + + pub fn source(&self) -> &StorageSourceContract { + &self.source + } + pub fn abi(&self) -> &StorageAbi { + &self.abi + } + pub fn result(&self) -> StorageResultProjection { + self.result + } + pub fn operands(&self) -> impl ExactSizeIterator + '_ { + self.source + .parameters + .iter() + .copied() + .zip(self.abi.parameters.iter().copied()) + } +} + +impl StorageOperation { + pub fn projection(self) -> Result { + StorageCallProjection::checked(self.source_contract(), self.abi()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn every_storage_export_has_an_explicit_result_projection() { + for (operation, result) in [ + ( + StorageOperation::Fill, + StorageResultProjection::Value(StorageType::Array), + ), + ( + StorageOperation::Read, + StorageResultProjection::Value(StorageType::Value), + ), + (StorageOperation::Write, StorageResultProjection::Unit), + (StorageOperation::Trap, StorageResultProjection::Never), + ] { + let plan = operation.projection().unwrap(); + assert_eq!(plan.result(), result); + assert_eq!( + plan.operands().len(), + operation.source_contract().parameters.len() + ); + assert_eq!(plan.abi().export, operation.abi().export); + } + } + + #[test] + fn rejects_operand_and_payload_contract_drift() { + let mut abi = StorageOperation::Fill.abi(); + abi.parameters = &[StorageType::Value, StorageType::I32]; + assert!( + StorageCallProjection::checked(StorageOperation::Fill.source_contract(), abi).is_err() + ); + let mut abi = StorageOperation::Write.abi(); + abi.result = Some(StorageType::I32); + assert!( + StorageCallProjection::checked(StorageOperation::Write.source_contract(), abi).is_err() + ); + let mut abi = StorageOperation::Trap.abi(); + abi.returns_normally = true; + assert!( + StorageCallProjection::checked(StorageOperation::Trap.source_contract(), abi).is_err() + ); + let mut abi = StorageOperation::Trap.abi(); + abi.result = Some(StorageType::Value); + assert!( + StorageCallProjection::checked(StorageOperation::Trap.source_contract(), abi).is_err() + ); + let mut abi = StorageOperation::Read.abi(); + abi.parameters = &[StorageType::Array]; + assert!( + StorageCallProjection::checked(StorageOperation::Read.source_contract(), abi).is_err() + ); + } +} diff --git a/crates/psrs-runtime/src/catalog/encoded.rs b/crates/psrs-runtime/src/catalog/encoded.rs new file mode 100644 index 00000000..a6e581c6 --- /dev/null +++ b/crates/psrs-runtime/src/catalog/encoded.rs @@ -0,0 +1,80 @@ +//! Host-encoded independent units with separately declared type schemas. +use crate::RawType; + +#[derive(Clone, Copy)] +pub enum EncodedHeap { + Func, + Extern, + Any, + Eq, + I31, + Struct, + Array, + Defined(u32), +} +#[derive(Clone, Copy)] +pub enum EncodedValue { + Scalar(RawType), + Ref { nullable: bool, heap: EncodedHeap }, +} +#[derive(Clone)] +pub struct EncodedOperation { + pub name: String, + pub version: &'static str, + pub export: &'static str, + pub parameters: Vec, + pub result: Option, +} + +pub struct EncodedRuntimeUnit { + pub id: &'static str, + pub version: &'static str, + pub module_name: &'static str, + pub provenance: &'static str, + pub required_features: &'static [&'static str], + /// A types-only module defining the declaration's reference index space. + pub type_schema: fn() -> Vec, + pub operations: fn() -> Vec, + pub encode: fn() -> Vec, +} + +#[cfg(feature = "gc-storage")] +pub const STORAGE_UNIT: EncodedRuntimeUnit = EncodedRuntimeUnit { + id: "psrs:runtime-storage", + version: "1", + module_name: crate::STORAGE_MODULE, + provenance: "deterministic host encoder; storage ABI 1; pinned workspace wasm-encoder", + required_features: &["gc", "reference-types"], + type_schema: crate::storage::encode_type_schema, + operations: storage_operations, + encode: crate::storage::encode_module, +}; + +#[cfg(feature = "gc-storage")] +fn storage_operations() -> Vec { + use crate::{StorageOperation, StorageType}; + let value = |ty| match ty { + StorageType::I32 => EncodedValue::Scalar(RawType::I32), + StorageType::Array => EncodedValue::Ref { + nullable: false, + heap: EncodedHeap::Defined(0), + }, + StorageType::Value => EncodedValue::Ref { + nullable: true, + heap: EncodedHeap::Eq, + }, + }; + StorageOperation::ALL + .into_iter() + .map(|operation| { + let abi = operation.abi(); + EncodedOperation { + name: format!("storage.{}", abi.export), + version: STORAGE_UNIT.version, + export: abi.export, + parameters: abi.parameters.iter().copied().map(value).collect(), + result: abi.result.map(value), + } + }) + .collect() +} diff --git a/crates/psrs-runtime/src/catalog/mod.rs b/crates/psrs-runtime/src/catalog/mod.rs index 9dc3a612..673b0511 100644 --- a/crates/psrs-runtime/src/catalog/mod.rs +++ b/crates/psrs-runtime/src/catalog/mod.rs @@ -3,6 +3,8 @@ //! together, while WIT sources and the package aggregate have separate owners. mod allocator; +mod encoded; +pub use encoded::*; mod model; mod number; mod package; diff --git a/crates/psrs-runtime/src/catalog/model.rs b/crates/psrs-runtime/src/catalog/model.rs index e62c9aed..9038c8f8 100644 --- a/crates/psrs-runtime/src/catalog/model.rs +++ b/crates/psrs-runtime/src/catalog/model.rs @@ -149,4 +149,5 @@ pub struct RuntimePackage { pub version: &'static str, pub provenance: &'static str, pub units: &'static [&'static RuntimeUnit], + pub encoded_units: &'static [&'static super::EncodedRuntimeUnit], } diff --git a/crates/psrs-runtime/src/catalog/package.rs b/crates/psrs-runtime/src/catalog/package.rs index 202170a7..91486b6e 100644 --- a/crates/psrs-runtime/src/catalog/package.rs +++ b/crates/psrs-runtime/src/catalog/package.rs @@ -8,6 +8,10 @@ pub const PSRS_RUNTIME: RuntimePackage = RuntimePackage { version: VERSION, provenance: "compiler-owned catalog; each unit pins its own variant bytes and recipe", units: &[&NUMBER_UNIT, &ALLOCATOR_UNIT], + #[cfg(feature = "gc-storage")] + encoded_units: &[&super::STORAGE_UNIT], + #[cfg(not(feature = "gc-storage"))] + encoded_units: &[], }; #[cfg(test)] diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 997ff7ac..53691373 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -5,6 +5,8 @@ //! consumers. Feature `formatter` builds the numeric implementation in `number`; //! feature `allocator` builds the canonical allocator. Each Wasm artifact enables //! exactly one executable feature and embeds no catalog assets. +//! Feature `gc-storage` exposes a host encoder for an independent GC storage +//! module; its target operations allocate no Rust or linear-memory heap. #![cfg_attr( all( @@ -17,6 +19,9 @@ pub mod abi; pub use abi::*; +#[cfg(feature = "gc-storage")] +pub mod storage; + #[cfg(feature = "catalog")] pub mod catalog; #[cfg(feature = "catalog")] diff --git a/crates/psrs-runtime/src/storage/mod.rs b/crates/psrs-runtime/src/storage/mod.rs new file mode 100644 index 00000000..ea395fe4 --- /dev/null +++ b/crates/psrs-runtime/src/storage/mod.rs @@ -0,0 +1,106 @@ +//! Executable GC storage provider owned by the runtime package. +//! +//! This host encoder produces an independent core module with its own index +//! space. The application must use the structurally matching mutable eqref +//! array type. It must validate/box payloads before erasure and preserve array +//! identity: copying a typed array to this representation is not a write ABI. +//! Compiler/linker integration requires a checked GC reference call protocol; +//! its encoded unit and separate type schema are advertised by the catalog. + +use crate::{StorageOperation, StorageType}; +use wasm_encoder::{ + BlockType, CodeSection, ExportKind, ExportSection, Function, FunctionSection, HeapType, + Instruction, Module, RefType, StorageType as FieldStorage, TypeSection, ValType, +}; + +/// Shared structural type contract; no nominal source region is stored here. +pub const ARRAY_TYPE_INDEX: u32 = 0; + +fn value_type(ty: StorageType) -> ValType { + match ty { + StorageType::I32 => ValType::I32, + StorageType::Array => ValType::Ref(RefType { + nullable: false, + heap_type: HeapType::Concrete(ARRAY_TYPE_INDEX), + }), + StorageType::Value => ValType::Ref(RefType::EQREF), + } +} + +/// The data-only declaration schema has an independent module index space. +/// Function contracts resolve their references against this schema, rather +/// than deriving declarations from executable export signatures. +pub fn encode_type_schema() -> Vec { + let mut module = Module::new(); + let mut types = TypeSection::new(); + types + .ty() + .array(&FieldStorage::Val(ValType::Ref(RefType::EQREF)), true); + module.section(&types); + module.finish() +} + +/// Encode the provider deterministically; no memory, imports, globals or start. +pub fn encode_module() -> Vec { + let mut module = Module::new(); + let mut types = TypeSection::new(); + types + .ty() + .array(&FieldStorage::Val(ValType::Ref(RefType::EQREF)), true); + let mut functions = FunctionSection::new(); + let mut exports = ExportSection::new(); + let mut code = CodeSection::new(); + for (index, operation) in StorageOperation::ALL.into_iter().enumerate() { + let abi = operation.abi(); + types.ty().function( + abi.parameters.iter().copied().map(value_type), + abi.result.into_iter().map(value_type), + ); + functions.function(index as u32 + 1); + exports.export(abi.export, ExportKind::Func, index as u32); + code.function(&body(operation)); + } + module.section(&types); + module.section(&functions); + module.section(&exports); + module.section(&code); + module.finish() +} + +fn body(operation: StorageOperation) -> Function { + let mut f = Function::new([]); + match operation { + StorageOperation::Fill => { + // Source lengths are signed Ints; a negative length must trap + // before array.new interprets it as an enormous unsigned count. + f.instruction(&Instruction::LocalGet(0)); + f.instruction(&Instruction::I32Const(0)); + f.instruction(&Instruction::I32LtS); + f.instruction(&Instruction::If(BlockType::Empty)); + f.instruction(&Instruction::Unreachable); + f.instruction(&Instruction::End); + f.instruction(&Instruction::LocalGet(1)); + f.instruction(&Instruction::LocalGet(0)); + f.instruction(&Instruction::ArrayNew(ARRAY_TYPE_INDEX)); + } + StorageOperation::Read => { + f.instruction(&Instruction::LocalGet(0)); + f.instruction(&Instruction::LocalGet(1)); + f.instruction(&Instruction::ArrayGet(ARRAY_TYPE_INDEX)); + } + StorageOperation::Write => { + f.instruction(&Instruction::LocalGet(0)); + f.instruction(&Instruction::LocalGet(1)); + f.instruction(&Instruction::LocalGet(2)); + f.instruction(&Instruction::ArraySet(ARRAY_TYPE_INDEX)); + } + StorageOperation::Trap => { + f.instruction(&Instruction::Unreachable); + } + } + f.instruction(&Instruction::End); + f +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-runtime/src/storage/tests.rs b/crates/psrs-runtime/src/storage/tests.rs new file mode 100644 index 00000000..64bf5acc --- /dev/null +++ b/crates/psrs-runtime/src/storage/tests.rs @@ -0,0 +1,178 @@ +use super::*; +use std::process::{Command, Output}; +use std::sync::atomic::{AtomicU64, Ordering}; + +const IMPORTS: &str = r#" + (type $array (array (mut eqref))) + (type $box (struct (field i32))) + (import "psrs:runtime-storage" "array_fill" + (func $fill (param i32 eqref) (result (ref $array)))) + (import "psrs:runtime-storage" "array_read" + (func $read (param (ref $array) i32) (result eqref))) + (import "psrs:runtime-storage" "array_write" + (func $write (param (ref $array) i32 eqref))) + (import "psrs:runtime-storage" "trap" (func $trap)) +"#; + +static NEXT: AtomicU64 = AtomicU64::new(0); + +fn run(body: &str) -> Option { + run_with_imports(IMPORTS, body) +} + +fn run_with_imports(imports: &str, body: &str) -> Option { + let version = Command::new("wasmtime").arg("--version").output(); + if !version.is_ok_and(|v| v.status.success()) { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "required Wasmtime is unavailable" + ); + eprintln!("skipping GC storage execution: Wasmtime is unavailable"); + return None; + } + let directory = std::env::temp_dir().join(format!( + "psrs-runtime-storage-{}-{}", + std::process::id(), + NEXT.fetch_add(1, Ordering::Relaxed), + )); + std::fs::create_dir(&directory).unwrap(); + let provider = directory.join("storage.wasm"); + let guest = directory.join("guest.wat"); + std::fs::write(&provider, encode_module()).unwrap(); + std::fs::write(&guest, format!("(module {imports} {body})")).unwrap(); + let output = Command::new("wasmtime") + .args(["run", "--preload"]) + .arg(format!("{}={}", crate::STORAGE_MODULE, provider.display())) + .args(["--invoke", "test"]) + .arg(&guest) + .output() + .unwrap(); + std::fs::remove_dir_all(directory).unwrap(); + Some(output) +} + +#[test] +fn provider_validates_without_memory_or_state_storage() { + let bytes = encode_module(); + wasmparser::Validator::new_with_features(wasmparser::WasmFeatures::all()) + .validate_all(&bytes) + .unwrap(); + assert_eq!(bytes, encode_module()); + let mut exports = Vec::new(); + for payload in wasmparser::Parser::new(0).parse_all(&bytes) { + match payload.unwrap() { + wasmparser::Payload::ExportSection(section) => { + exports.extend(section.into_iter().map(|e| e.unwrap().name.to_owned())); + } + wasmparser::Payload::MemorySection(_) + | wasmparser::Payload::GlobalSection(_) + | wasmparser::Payload::ImportSection(_) + | wasmparser::Payload::StartSection { .. } => { + panic!("GC storage must not allocate state or linear-memory handles") + } + _ => {} + } + } + assert_eq!( + exports, + StorageOperation::ALL.map(|operation| operation.abi().export) + ); +} + +#[test] +fn writes_preserve_aliases_and_repeated_reads_observe_values() { + let Some(output) = run(r#" + (func (export "test") (result i32) + (local $a (ref null $array)) (local $alias (ref null $array)) + (local $initial (ref null $box)) (local $updated (ref null $box)) + (local.set $initial (struct.new $box (i32.const 7))) + (local.set $updated (struct.new $box (i32.const 19))) + (local.set $a (call $fill (i32.const 2) (local.get $initial))) + (local.set $alias (local.get $a)) + (if (i32.ne (array.len (local.get $a)) (i32.const 2)) + (then unreachable)) + (if (i32.eqz (ref.eq (call $read (ref.as_non_null (local.get $a)) + (i32.const 1)) (local.get $initial))) (then unreachable)) + (call $write (ref.as_non_null (local.get $a)) (i32.const 1) + (local.get $updated)) + (if (i32.eqz (ref.eq (call $read (ref.as_non_null (local.get $alias)) + (i32.const 1)) (local.get $updated))) (then unreachable)) + (if (i32.ne (struct.get $box 0 + (ref.cast (ref $box) (call $read + (ref.as_non_null (local.get $alias)) (i32.const 1)))) + (i32.const 19)) (then unreachable)) + (call $write (ref.as_non_null (local.get $alias)) (i32.const 1) + (local.get $initial)) + (struct.get $box 0 (ref.cast (ref $box) + (call $read (ref.as_non_null (local.get $a)) (i32.const 1))))) + "#) else { + return; + }; + assert!( + output.status.success(), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + assert_eq!(String::from_utf8_lossy(&output.stdout).trim(), "7"); +} + +#[test] +fn zero_length_and_null_values_are_supported() { + let Some(output) = run(r#" + (func (export "test") (result i32) + (if (i32.ne (array.len (call $fill (i32.const 0) (ref.null eq))) + (i32.const 0)) (then unreachable)) + (ref.is_null (call $read (call $fill (i32.const 1) (ref.null eq)) + (i32.const 0)))) + "#) else { + return; + }; + assert!( + output.status.success(), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + assert_eq!(String::from_utf8_lossy(&output.stdout).trim(), "1"); +} + +#[test] +fn incompatible_gc_array_import_is_rejected_before_execution() { + // An immutable array is not the mutable storage representation even when + // its element type agrees. Do not adapt an in-place write by copying it. + let imports = IMPORTS.replace("(array (mut eqref))", "(array eqref)"); + let Some(output) = run_with_imports( + &imports, + "(func (export \"test\") (result i32) (i32.const 123))", + ) else { + return; + }; + assert!(!output.status.success()); + let stderr = String::from_utf8_lossy(&output.stderr); + assert!(stderr.contains("incompatible import type"), "{stderr}"); + assert!(output.stdout.is_empty()); +} + +#[test] +fn invalid_sizes_indices_and_explicit_trap_have_no_normal_return() { + for operation in [ + "(drop (call $fill (i32.const -1) (ref.null eq)))", + "(drop (call $read (call $fill (i32.const 0) (ref.null eq)) (i32.const 0)))", + "(drop (call $read (call $fill (i32.const 1) (ref.null eq)) (i32.const -1)))", + "(call $write (call $fill (i32.const 1) (ref.null eq)) (i32.const 1) (ref.null eq))", + "(call $trap)", + ] { + let Some(output) = run(&format!( + "(func (export \"test\") (result i32) {operation} (i32.const 123))" + )) else { + return; + }; + assert!(!output.status.success()); + let stderr = String::from_utf8_lossy(&output.stderr); + assert!(stderr.contains("wasm trap"), "{stderr}"); + assert!( + output.stdout.is_empty(), + "a trap must not return a fabricated payload" + ); + } +} From 12fe6bbcb97b718543cfd1f9a7b03348ea313a39 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:07:37 +0800 Subject: [PATCH 085/148] Assemble checked Core and world boundaries in the linker --- crates/psrs-linker/Cargo.toml | 2 +- crates/psrs-linker/src/application/imports.rs | 134 ++++++++ .../{application.rs => application/mod.rs} | 60 +--- crates/psrs-linker/src/application/tests.rs | 78 +++++ crates/psrs-linker/src/closure.rs | 20 +- crates/psrs-linker/src/compose.rs | 77 +++-- crates/psrs-linker/src/core_assembly.rs | 223 +++++++++++++ crates/psrs-linker/src/core_types/mod.rs | 223 +++++++++++++ crates/psrs-linker/src/core_types/tests.rs | 61 ++++ crates/psrs-linker/src/lib.rs | 5 + crates/psrs-linker/src/runtime/encoded.rs | 159 ++++++++++ .../src/{runtime.rs => runtime/mod.rs} | 12 +- crates/psrs-linker/src/target.rs | 6 +- crates/psrs-linker/src/verify/mod.rs | 5 + crates/psrs-linker/src/verify/parse.rs | 39 +-- .../psrs-linker/src/world_boundary/facade.rs | 148 +++++++++ crates/psrs-linker/src/world_boundary/mod.rs | 237 ++++++++++++++ .../psrs-linker/src/world_boundary/tests.rs | 253 +++++++++++++++ crates/psrs-linker/tests/gc_storage.rs | 294 ++++++++++++++++++ .../backend/wasm/linking-and-runtime.md | 62 ++++ 20 files changed, 1978 insertions(+), 120 deletions(-) create mode 100644 crates/psrs-linker/src/application/imports.rs rename crates/psrs-linker/src/{application.rs => application/mod.rs} (77%) create mode 100644 crates/psrs-linker/src/application/tests.rs create mode 100644 crates/psrs-linker/src/core_assembly.rs create mode 100644 crates/psrs-linker/src/core_types/mod.rs create mode 100644 crates/psrs-linker/src/core_types/tests.rs create mode 100644 crates/psrs-linker/src/runtime/encoded.rs rename crates/psrs-linker/src/{runtime.rs => runtime/mod.rs} (95%) create mode 100644 crates/psrs-linker/src/world_boundary/facade.rs create mode 100644 crates/psrs-linker/src/world_boundary/mod.rs create mode 100644 crates/psrs-linker/src/world_boundary/tests.rs create mode 100644 crates/psrs-linker/tests/gc_storage.rs diff --git a/crates/psrs-linker/Cargo.toml b/crates/psrs-linker/Cargo.toml index 3bc06b14..4728c8c7 100644 --- a/crates/psrs-linker/Cargo.toml +++ b/crates/psrs-linker/Cargo.toml @@ -9,7 +9,7 @@ name = "guest" path = "tests/guest/mod.rs" [dependencies] -psrs-runtime = { workspace = true, default-features = false, features = ["catalog"] } +psrs-runtime = { workspace = true, default-features = false, features = ["catalog", "gc-storage"] } sha2 = "=0.10.9" wasm-encoder.workspace = true wasmparser.workspace = true diff --git a/crates/psrs-linker/src/application/imports.rs b/crates/psrs-linker/src/application/imports.rs new file mode 100644 index 00000000..77d7349d --- /dev/null +++ b/crates/psrs-linker/src/application/imports.rs @@ -0,0 +1,134 @@ +//! Normalize checked function aliases for the component's unique import names. +use std::collections::BTreeMap; +use wasm_encoder::reencode::{Error, Reencode}; +use wasmparser::{Parser, Payload, TypeRef}; + +pub(crate) fn normalize(bytes: &[u8]) -> Result, String> { + let mut names = BTreeMap::new(); + let mut indices = Vec::new(); + for payload in Parser::new(0).parse_all(bytes) { + if let Payload::ImportSection(section) = payload.map_err(|e| e.to_string())? { + for import in section.into_imports() { + let import = import.map_err(|e| e.to_string())?; + if !matches!(import.ty, TypeRef::Func(_)) { + return Err( + "application import normalization requires checked functions".into(), + ); + } + let next = names.len() as u32; + let index = *names + .entry((import.module.to_owned(), import.name.to_owned())) + .or_insert(next); + indices.push(index); + } + } + } + if indices.len() == names.len() { + return Ok(bytes.to_vec()); + } + let mut encoder = Aliases { + original: indices.len() as u32, + retained: names.len() as u32, + indices, + }; + let mut module = wasm_encoder::Module::new(); + encoder + .parse_core_module(&mut module, Parser::new(0), bytes) + .map_err(|e| e.to_string())?; + let bytes = module.finish(); + wasmparser::Validator::new() + .validate_all(&bytes) + .map_err(|e| e.to_string())?; + Ok(bytes) +} + +struct Aliases { + original: u32, + retained: u32, + indices: Vec, +} + +impl Reencode for Aliases { + type Error = String; + + fn function_index(&mut self, index: u32) -> Result> { + Ok(if index < self.original { + self.indices[index as usize] + } else { + index - self.original + self.retained + }) + } + + fn parse_import_section( + &mut self, + imports: &mut wasm_encoder::ImportSection, + section: wasmparser::ImportSectionReader<'_>, + ) -> Result<(), Error> { + let mut seen = std::collections::BTreeSet::new(); + for import in section.into_imports() { + let import = import?; + if seen.insert((import.module, import.name)) { + self.parse_import(imports, import)?; + } + } + Ok(()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn alias_normalization_remaps_calls_exports_and_element_references() { + let bytes = wat::parse_str( + r#"(module + (type $f (func (result i32))) + (import "provider" "read" (func $a (type $f))) + (import "provider" "read" (func $b (type $f))) + (table 2 funcref) + (elem (i32.const 0) func $b $run) + (func $run (export "run") (type $f) call $b) + (export "alias" (func $b)))"#, + ) + .unwrap(); + let normalized = normalize(&bytes).unwrap(); + let mut imports = 0; + let mut exports = BTreeMap::new(); + let mut elements = Vec::new(); + let mut calls = Vec::new(); + for payload in Parser::new(0).parse_all(&normalized) { + match payload.unwrap() { + Payload::ImportSection(section) => imports = section.count(), + Payload::ExportSection(section) => { + for export in section { + let export = export.unwrap(); + exports.insert(export.name.to_owned(), export.index); + } + } + Payload::ElementSection(section) => { + for element in section { + let wasmparser::ElementItems::Functions(functions) = element.unwrap().items + else { + panic!("expected function references"); + }; + elements.extend(functions.into_iter().map(Result::unwrap)); + } + } + Payload::CodeSectionEntry(body) => { + for operator in body.get_operators_reader().unwrap() { + if let wasmparser::Operator::Call { function_index } = operator.unwrap() { + calls.push(function_index); + } + } + } + _ => {} + } + } + assert_eq!(imports, 1); + assert_eq!(exports["run"], 1); + assert_eq!(exports["alias"], 0); + assert_eq!(elements, [0, 1]); + assert_eq!(calls, [0]); + } +} diff --git a/crates/psrs-linker/src/application.rs b/crates/psrs-linker/src/application/mod.rs similarity index 77% rename from crates/psrs-linker/src/application.rs rename to crates/psrs-linker/src/application/mod.rs index 5fba77aa..1a21cafe 100644 --- a/crates/psrs-linker/src/application.rs +++ b/crates/psrs-linker/src/application/mod.rs @@ -1,6 +1,6 @@ //! Verify encoded application contracts before executing a checked link plan. -use crate::{CheckedLinkPlan, CoreSignature, CoreType, LinkErrors, LinkStage}; -use wasmparser::{CompositeInnerType, Operator, Parser, Payload, TypeRef, ValType}; +use crate::{CheckedLinkPlan, CoreType, LinkErrors, LinkStage}; +use wasmparser::{Operator, Parser, Payload, TypeRef}; pub(crate) fn verify(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), LinkErrors> { check(plan, bytes).map_err(|message| LinkErrors::plain(LinkStage::Compose, message)) @@ -10,7 +10,7 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { wasmparser::Validator::new() .validate_all(bytes) .map_err(|error| error.to_string())?; - let mut types = Vec::new(); + let mut types = crate::CoreTypes::default(); let mut seen = std::collections::BTreeSet::new(); let mut memory = None; let mut data = Vec::new(); @@ -22,12 +22,7 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { match payload.map_err(|error| error.to_string())? { Payload::TypeSection(reader) => { for group in reader { - for ty in group.map_err(|error| error.to_string())?.into_types() { - types.push(match ty.composite_type.inner { - CompositeInnerType::Func(ty) => Some(ty), - _ => None, - }); - } + types.push(group.map_err(|error| error.to_string())?)?; } } Payload::ImportSection(reader) => { @@ -49,35 +44,15 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { import.module, import.name ) })?; - let ty = types - .get(index as usize) - .and_then(Option::as_ref) - .ok_or("application import has no function signature")?; - let signature = CoreSignature { - parameters: ty - .params() - .iter() - .copied() - .map(scalar) - .collect::>()?, - result: match ty.results() { - [] => None, - [ty] => Some(scalar(*ty)?), - _ => { - return Err( - "application import has unsupported multiple results".into() - ); - } - }, - }; + let signature = types.signature(index)?; if signature != binding.signature { return Err( "application import signature disagrees with the checked plan".into(), ); } - if !seen.insert((binding.module.clone(), binding.field.clone())) { - return Err("application duplicates a planned import".into()); - } + // Distinct source declarations may alias one checked ABI + // export. Every occurrence must match its complete type. + seen.insert((binding.module.clone(), binding.field.clone())); } } Payload::MemorySection(reader) => { @@ -143,12 +118,11 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { .checked_sub(imported_functions) .ok_or("application heap getter must be defined locally")? as usize; - let ty = function_types + let type_index = *function_types .get(defined) - .and_then(|index| types.get(*index as usize)) - .and_then(Option::as_ref) .ok_or("application heap getter has no signature")?; - if !ty.params().is_empty() || ty.results() != [ValType::I32] { + let ty = types.signature(type_index)?; + if !ty.parameters.is_empty() || ty.result != Some(CoreType::I32) { return Err("application heap getter must have signature () -> i32".into()); } let body = function_bodies @@ -211,12 +185,6 @@ fn check(plan: &CheckedLinkPlan, bytes: &[u8]) -> Result<(), String> { Ok(()) } -fn scalar(ty: ValType) -> Result { - match ty { - ValType::I32 => Ok(CoreType::I32), - ValType::I64 => Ok(CoreType::I64), - ValType::F32 => Ok(CoreType::F32), - ValType::F64 => Ok(CoreType::F64), - _ => Err("a target import has an unchecked reference representation".into()), - } -} +pub(crate) mod imports; +#[cfg(test)] +mod tests; diff --git a/crates/psrs-linker/src/application/tests.rs b/crates/psrs-linker/src/application/tests.rs new file mode 100644 index 00000000..4110afe6 --- /dev/null +++ b/crates/psrs-linker/src/application/tests.rs @@ -0,0 +1,78 @@ +use crate::{ + BindingRequirement, Boundary, MemoryDemand, Provider, RequirementId, TargetLinkInput, + TargetPolicy, +}; + +#[test] +fn gc_application_contracts_compare_closed_types_before_composition() { + let context = crate::resolve_default_definitions().unwrap(); + let units = crate::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME).unwrap(); + let storage = units + .iter() + .find(|unit| unit.id == psrs_runtime::STORAGE_UNIT.id) + .unwrap(); + let read = storage + .provided + .iter() + .find(|op| op.export == "array_read") + .unwrap(); + let plan = crate::plan( + &context, + TargetLinkInput { + requirements: vec![BindingRequirement { + id: RequirementId(0), + origin: "storage read".into(), + boundary: Boundary::RawCore { + module: psrs_runtime::STORAGE_MODULE.into(), + field: read.export.clone(), + }, + expected: Some(read.signature.clone()), + provider: Provider::RuntimeOperation { + name: read.name.clone(), + version: read.version.clone(), + }, + }], + units, + policy: TargetPolicy::default(), + memory: MemoryDemand { + canonical_scratch: (0, 16), + allocator_state: (16, 24), + base_heap_start: 24, + heap_alignment: 8, + growth_owner: crate::GENERATED_GROWTH_OWNER.into(), + maximum_pages: None, + }, + }, + ) + .unwrap(); + let text = r#"(module + (type (struct (field i64))) + (type $a (array (mut eqref))) + (import "psrs:runtime-storage" "array_read" (func (param (ref $a) i32) (result eqref))) + (memory (export "memory") 2))"#; + super::verify(&plan, &wat::parse_str(text).unwrap()).unwrap(); + let declaration = "(import \"psrs:runtime-storage\" \"array_read\" (func (param (ref $a) i32) (result eqref)))"; + let aliases = text.replace(declaration, &format!("{declaration}\n{declaration}")); + let bytes = wat::parse_str(&aliases).unwrap(); + wasmparser::Validator::new().validate_all(&bytes).unwrap(); + super::verify(&plan, &bytes).unwrap(); + let wrong_alias = text.replace( + declaration, + &format!( + "{declaration}\n{}", + declaration.replace("(ref $a)", "(ref null $a)") + ), + ); + let error = super::verify(&plan, &wat::parse_str(wrong_alias).unwrap()).unwrap_err(); + assert!(error.to_string().contains("application import signature")); + for modified in [ + text.replace("(ref $a)", "(ref null $a)"), + text.replace("(mut eqref)", "eqref"), + ] { + let error = super::verify(&plan, &wat::parse_str(modified).unwrap()).unwrap_err(); + assert!( + error.to_string().contains("application import signature"), + "{error}" + ); + } +} diff --git a/crates/psrs-linker/src/closure.rs b/crates/psrs-linker/src/closure.rs index e4411e62..927191ac 100644 --- a/crates/psrs-linker/src/closure.rs +++ b/crates/psrs-linker/src/closure.rs @@ -37,8 +37,13 @@ pub(crate) fn host_imports( continue; } types.ty().function( - binding.signature.parameters.iter().copied().map(scalar), - binding.signature.result.map(scalar), + binding + .signature + .parameters + .iter() + .map(scalar) + .collect::, _>>()?, + binding.signature.result.as_ref().map(scalar).transpose()?, ); imports.import(&binding.module, &binding.field, EntityType::Function(count)); count += 1; @@ -89,13 +94,18 @@ pub(crate) fn host_imports( crate::compose::component_imports(&component) } -fn scalar(ty: CoreType) -> ValType { - match ty { +fn scalar(ty: &CoreType) -> Result { + Ok(match ty { CoreType::I32 => ValType::I32, CoreType::I64 => ValType::I64, CoreType::F32 => ValType::F32, CoreType::F64 => ValType::F64, - } + CoreType::V128 | CoreType::Ref(_) => { + return Err(error( + "a raw GC or SIMD contract cannot cross a WIT scalar boundary", + )); + } + }) } fn error(error: impl std::fmt::Display) -> LinkErrors { LinkErrors::plain( diff --git a/crates/psrs-linker/src/compose.rs b/crates/psrs-linker/src/compose.rs index c2b32569..194da4bd 100644 --- a/crates/psrs-linker/src/compose.rs +++ b/crates/psrs-linker/src/compose.rs @@ -36,41 +36,56 @@ pub fn compose( ) })?; crate::application::verify(plan, application)?; - let mut bytes = application.to_vec(); - embed_component_metadata(&mut bytes, context.resolve(), world, StringEncoding::UTF8).map_err( - |error| { - LinkErrors::plain( - stage, - format!("failed to embed component metadata: {error}"), - ) - }, - )?; - let mut encoder = ComponentEncoder::default() - .module(&bytes) - .map_err(|error| { - LinkErrors::plain(stage, format!("failed to read the core module: {error}")) - })?; - for artifact in plan.artifacts() { - encoder = encoder - .library( - &artifact.module_name, - &artifact.bytes, - LibraryInfo { - instantiate_after_shims: artifact.instantiate_after_shims, - arguments: Vec::new(), - }, - ) + let references = |signature: &crate::CoreSignature| { + signature + .parameters + .iter() + .chain(signature.result.iter()) + .any(|ty| matches!(ty, crate::CoreType::Ref(_))) + }; + let direct = plan + .bindings() + .iter() + .any(|binding| references(&binding.signature)) + || crate::core_assembly::canonical_libraries(plan).len() != plan.artifacts().len(); + let output = if direct { + crate::world_boundary::encode(context, plan, application)? + } else { + let mut bytes = application.to_vec(); + embed_component_metadata(&mut bytes, context.resolve(), world, StringEncoding::UTF8) .map_err(|error| { - LinkErrors::one( + LinkErrors::plain( stage, - &artifact.id, - format!("failed to attach artifact: {error:#}"), + format!("failed to embed component metadata: {error}"), ) })?; - } - let output = encoder.validate(true).encode().map_err(|error| { - LinkErrors::plain(stage, format!("failed to encode the component: {error:#}")) - })?; + let mut encoder = ComponentEncoder::default() + .module(&bytes) + .map_err(|error| { + LinkErrors::plain(stage, format!("failed to read the core module: {error:#}")) + })?; + for artifact in plan.artifacts() { + encoder = encoder + .library( + &artifact.module_name, + &artifact.bytes, + LibraryInfo { + instantiate_after_shims: artifact.instantiate_after_shims, + arguments: Vec::new(), + }, + ) + .map_err(|error| { + LinkErrors::one( + stage, + &artifact.id, + format!("failed to attach artifact: {error:#}"), + ) + })?; + } + encoder.validate(true).encode().map_err(|error| { + LinkErrors::plain(stage, format!("failed to encode the component: {error:#}")) + })? + }; wasmparser::Validator::new() .validate_all(&output) .map_err(|error| { diff --git a/crates/psrs-linker/src/core_assembly.rs b/crates/psrs-linker/src/core_assembly.rs new file mode 100644 index 00000000..a8b6a3df --- /dev/null +++ b/crates/psrs-linker/src/core_assembly.rs @@ -0,0 +1,223 @@ +//! Compiler-owned raw Core instance assembly, before canonical WIT boundaries. +use crate::{CheckedLinkPlan, LinkErrors, LinkStage}; +use std::collections::{BTreeMap, BTreeSet}; +use wasm_encoder::{ComponentBuilder, ModuleArg}; +use wasmparser::{Parser, Payload}; + +/// A provisional instance graph connecting original modules directly. +/// Canonical lift/lower and target-world closure remain separate obligations. +pub struct CoreAssembly { + component: ComponentBuilder, + application: u32, + application_module: u32, +} + +impl CoreAssembly { + pub fn application_instance(&self) -> u32 { + self.application + } + + pub fn application_module(&self) -> u32 { + self.application_module + } + + /// Consume the assembly to add canonical boundaries. This returns an encoder, + /// not a checked target artifact; callers must validate their completed graph. + pub fn into_encoder(self) -> ComponentBuilder { + self.component + } +} + +/// Provider instances and the original application module, before host +/// canonical lowering supplies application imports. +pub(crate) struct PreparedCore { + pub component: ComponentBuilder, + pub application_module: u32, + pub providers: BTreeMap, +} + +pub(crate) fn prepare_core( + plan: &CheckedLinkPlan, + application: &[u8], + canonical_libraries: &BTreeSet, +) -> Result { + crate::application::verify(plan, application)?; + // Every occurrence has been checked against its complete provider type. + // Components require unique import names, unlike standalone Core modules. + let application = crate::application::imports::normalize(application) + .map_err(|message| LinkErrors::plain(LinkStage::Compose, message))?; + let error = |message| LinkErrors::plain(LinkStage::Compose, message); + let mut pending = plan + .artifacts() + .iter() + .filter(|artifact| !canonical_libraries.contains(&artifact.module_name)) + .map(|artifact| { + Ok(( + artifact.module_name.as_str(), + artifact.bytes.as_slice(), + imports(&artifact.bytes)?, + )) + }) + .collect::, String>>() + .map_err(error)?; + let mut component = ComponentBuilder::default(); + let mut providers = BTreeMap::new(); + while !pending.is_empty() { + let ready = pending + .iter() + .position(|(_, _, imports)| imports.iter().all(|name| providers.contains_key(name))); + let Some(ready) = ready else { + let dependencies = pending + .iter() + .map(|(name, _, imports)| { + let missing = imports + .iter() + .filter(|name| !providers.contains_key(*name)) + .cloned() + .collect::>() + .join(", "); + format!("{name} -> [{missing}]") + }) + .collect::>() + .join("; "); + return Err(error(format!( + "raw provider graph has unresolved imports or cyclic provisioning: {dependencies}" + ))); + }; + let (name, bytes, imports) = pending.remove(ready); + if name == "__main_module__" || providers.contains_key(name) { + return Err(error( + "raw provider graph has duplicate or reserved module namespaces".into(), + )); + } + let module = component.core_module_raw(Some(name), bytes); + let args = imports + .iter() + .map(|name| (name.as_str(), ModuleArg::Instance(providers[name]))) + .collect::>(); + let instance = component.core_instantiate(Some(name), module, args); + providers.insert(name.to_string(), instance); + } + let application_module = component.core_module_raw(Some("__main_module__"), &application); + Ok(PreparedCore { + component, + application_module, + providers, + }) +} + +/// Assemble a closed acyclic raw provider graph without scalar function shims. +/// Host canonical lowering uses `prepare_core` and supplies host instances +/// before application instantiation. Cyclic provisioning remains unsupported. +pub fn assemble_core( + plan: &CheckedLinkPlan, + application: &[u8], +) -> Result { + if !plan.external_world().is_empty() { + return Err(LinkErrors::plain( + LinkStage::Compose, + "raw instance assembly requires a closed provider graph", + )); + } + let mut prepared = prepare_core(plan, application, &BTreeSet::new())?; + let names = + imports(application).map_err(|message| LinkErrors::plain(LinkStage::Compose, message))?; + let args = names + .iter() + .map(|name| { + prepared + .providers + .get(name) + .map(|instance| (name.as_str(), ModuleArg::Instance(*instance))) + .ok_or_else(|| { + LinkErrors::plain( + LinkStage::Compose, + "raw application has an unresolved import", + ) + }) + }) + .collect::, _>>()?; + let instance = prepared.component.core_instantiate( + Some("__main_module__"), + prepared.application_module, + args, + ); + Ok(CoreAssembly { + component: prepared.component, + application: instance, + application_module: prepared.application_module, + }) +} + +/// Reference interfaces and their consumers remain in original raw Core +/// modules. Scalar libraries retain the canonical encoder's checked memory +/// and application-shim provisioning instead of being instantiated too early. +pub(crate) fn canonical_libraries(plan: &CheckedLinkPlan) -> BTreeSet { + let references = |signature: &crate::CoreSignature| { + signature + .parameters + .iter() + .chain(signature.result.iter()) + .any(|ty| matches!(ty, crate::CoreType::Ref(_))) + }; + let mut raw = plan + .artifacts() + .iter() + .filter(|artifact| { + artifact + .exports + .iter() + .filter_map(|export| export.signature.as_ref()) + .any(references) + || artifact + .imports + .iter() + .filter_map(|import| match &import.kind { + crate::ImportKind::Function(signature) => Some(signature), + _ => None, + }) + .any(references) + }) + .map(|artifact| artifact.module_name.clone()) + .collect::>(); + loop { + let consumers = plan + .artifacts() + .iter() + .filter(|artifact| { + artifact + .imports + .iter() + .any(|import| raw.contains(&import.module)) + }) + .map(|artifact| artifact.module_name.clone()) + .collect::>(); + let before = raw.len(); + raw.extend(consumers); + if raw.len() == before { + break; + } + } + plan.artifacts() + .iter() + .filter(|artifact| !raw.contains(&artifact.module_name)) + .map(|artifact| artifact.module_name.clone()) + .collect() +} + +fn imports(bytes: &[u8]) -> Result, String> { + let mut imports = BTreeSet::new(); + for payload in Parser::new(0).parse_all(bytes) { + if let Payload::ImportSection(section) = payload.map_err(|error| error.to_string())? { + for import in section.into_imports() { + imports.insert( + import + .map_err(|error| error.to_string())? + .module + .to_string(), + ); + } + } + } + Ok(imports) +} diff --git a/crates/psrs-linker/src/core_types/mod.rs b/crates/psrs-linker/src/core_types/mod.rs new file mode 100644 index 00000000..0d7a1eca --- /dev/null +++ b/crates/psrs-linker/src/core_types/mod.rs @@ -0,0 +1,223 @@ +//! Module-independent raw signatures retaining complete GC recursion groups. +use crate::{CoreSignature, CoreType}; +use std::sync::Arc; +use wasmparser::{ + AbstractHeapType, CompositeInnerType, HeapType, PackedIndex, RecGroup, StorageType, SubType, + ValType, +}; + +/// A closed reference contract. Construction resolves module-local indices; +/// consumers cannot fabricate an unresolved reference or erase its group. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct CoreReference { + nullable: bool, + heap: Heap, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +enum Heap { + Abstract { + shared: bool, + kind: AbstractHeapType, + }, + Defined { + group: Arc<[Definition]>, + member: u32, + }, + Bound(u32), +} + +#[derive(Clone, Debug, PartialEq, Eq)] +struct Definition { + final_type: bool, + supertype: Option, + composite: Composite, +} +#[derive(Clone, Debug, PartialEq, Eq)] +enum Composite { + Function { + parameters: Vec, + results: Vec, + }, + Struct(Vec), + Array(Field), +} +#[derive(Clone, Debug, PartialEq, Eq)] +struct Field { + mutable: bool, + storage: FieldStorage, +} +#[derive(Clone, Debug, PartialEq, Eq)] +enum FieldStorage { + I8, + I16, + Value(CoreType), +} + +/// The owner of conversion from a parsed module type space to raw contracts. +#[derive(Default)] +pub struct CoreTypes { + definitions: Vec, +} + +impl CoreTypes { + pub fn from_module(bytes: &[u8]) -> Result { + wasmparser::Validator::new() + .validate_all(bytes) + .map_err(|error| error.to_string())?; + let mut types = Self::default(); + for payload in wasmparser::Parser::new(0).parse_all(bytes) { + if let wasmparser::Payload::TypeSection(section) = + payload.map_err(|error| error.to_string())? + { + for group in section { + types.push(group.map_err(|error| error.to_string())?)?; + } + } + } + Ok(types) + } + + pub(crate) fn push(&mut self, group: RecGroup) -> Result<(), String> { + let start = self.definitions.len() as u32; + let raw = group.into_types().collect::>(); + if raw.is_empty() { + return Err("raw contract has an empty recursion group".into()); + } + let end = start + raw.len() as u32; + let definitions = raw + .iter() + .map(|ty| self.definition(ty, start, end)) + .collect::, _>>()?; + let group: Arc<[Definition]> = definitions.into(); + self.definitions + .extend((0..raw.len() as u32).map(|member| Heap::Defined { + group: Arc::clone(&group), + member, + })); + Ok(()) + } + + pub fn value(&self, value: ValType) -> Result { + self.convert_value(value, 0, 0) + } + + pub fn signature(&self, index: u32) -> Result { + let Some(Heap::Defined { group, member }) = self.definitions.get(index as usize) else { + return Err("raw function has no defined type".into()); + }; + let Composite::Function { + parameters, + results, + } = &group[*member as usize].composite + else { + return Err("raw function refers to a non-function type".into()); + }; + let close = |ty: &CoreType| match ty { + CoreType::Ref(reference) => CoreType::Ref(CoreReference { + nullable: reference.nullable, + heap: match &reference.heap { + Heap::Bound(member) => Heap::Defined { + group: Arc::clone(group), + member: *member, + }, + heap => heap.clone(), + }, + }), + ty => ty.clone(), + }; + let result = match results.as_slice() { + [] => None, + [result] => Some(close(result)), + _ => return Err("raw function has multiple results".into()), + }; + Ok(CoreSignature { + parameters: parameters.iter().map(close).collect(), + result, + }) + } + + fn convert_value(&self, value: ValType, start: u32, end: u32) -> Result { + Ok(match value { + ValType::I32 => CoreType::I32, + ValType::I64 => CoreType::I64, + ValType::F32 => CoreType::F32, + ValType::F64 => CoreType::F64, + ValType::V128 => CoreType::V128, + ValType::Ref(reference) => CoreType::Ref(CoreReference { + nullable: reference.is_nullable(), + heap: self.heap(reference.heap_type(), start, end)?, + }), + }) + } + + fn heap(&self, heap: HeapType, start: u32, end: u32) -> Result { + match heap { + HeapType::Exact(_) => Err("raw exact-reference contracts are unsupported".into()), + HeapType::Abstract { shared, ty } => Ok(Heap::Abstract { shared, kind: ty }), + HeapType::Concrete(index) => { + let index = index + .as_module_index() + .ok_or("raw reference has a non-module index")?; + if (start..end).contains(&index) { + return Ok(Heap::Bound(index - start)); + } + self.definitions + .get(index as usize) + .cloned() + .ok_or_else(|| "raw reference crosses an unresolved recursion group".into()) + } + } + } + + fn definition(&self, ty: &SubType, start: u32, end: u32) -> Result { + if ty.composite_type.shared + || ty.composite_type.descriptor_idx.is_some() + || ty.composite_type.describes_idx.is_some() + { + return Err("raw shared or descriptor composite contracts are unsupported".into()); + } + let index = |index: PackedIndex| self.heap(HeapType::Concrete(index.unpack()), start, end); + let field = |field: &wasmparser::FieldType| { + Ok(Field { + mutable: field.mutable, + storage: match field.element_type { + StorageType::I8 => FieldStorage::I8, + StorageType::I16 => FieldStorage::I16, + StorageType::Val(value) => { + FieldStorage::Value(self.convert_value(value, start, end)?) + } + }, + }) + }; + let composite = match &ty.composite_type.inner { + CompositeInnerType::Func(function) => Composite::Function { + parameters: function + .params() + .iter() + .map(|ty| self.convert_value(*ty, start, end)) + .collect::>()?, + results: function + .results() + .iter() + .map(|ty| self.convert_value(*ty, start, end)) + .collect::>()?, + }, + CompositeInnerType::Struct(ty) => { + Composite::Struct(ty.fields.iter().map(field).collect::>()?) + } + CompositeInnerType::Array(ty) => Composite::Array(field(&ty.0)?), + CompositeInnerType::Cont(_) => { + return Err("raw continuation contracts are unsupported".into()); + } + }; + Ok(Definition { + final_type: ty.is_final, + supertype: ty.supertype_idx.map(index).transpose()?, + composite, + }) + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-linker/src/core_types/tests.rs b/crates/psrs-linker/src/core_types/tests.rs new file mode 100644 index 00000000..6b179155 --- /dev/null +++ b/crates/psrs-linker/src/core_types/tests.rs @@ -0,0 +1,61 @@ +use super::*; + +fn signature(source: &str, index: u32) -> CoreSignature { + CoreTypes::from_module(&wat::parse_str(source).unwrap()) + .unwrap() + .signature(index) + .unwrap() +} + +#[test] +fn gc_contracts_ignore_module_index_offsets() { + let a = signature( + "(module (type (array (mut eqref))) (type (func (param (ref 0) i32) (result eqref))))", + 1, + ); + let b = signature( + "(module (type (struct (field i64))) (type (array (mut eqref))) (type (func (param (ref 1) i32) (result eqref))))", + 2, + ); + assert_eq!(a, b); +} + +#[test] +fn gc_contracts_preserve_mutability_nullability_and_group_identity() { + let base = signature( + "(module (type (array (mut eqref))) (type (func (param (ref 0)))))", + 1, + ); + for source in [ + "(module (type (array eqref)) (type (func (param (ref 0)))))", + "(module (type (array (mut eqref))) (type (func (param (ref null 0)))))", + "(module (rec (type (array (mut eqref))) (type (struct (field i64)))) (type (func (param (ref 0)))))", + ] { + assert_ne!( + base, + signature(source, if source.contains("(rec") { 2 } else { 1 }) + ); + } +} + +#[test] +fn recursive_contracts_close_group_binders_without_module_indices() { + let a = signature( + "(module (rec (type (struct (field (ref null 1)))) (type (array (mut (ref null 0))))) (type (func (param (ref 0)))))", + 2, + ); + let b = signature( + "(module (type (array i32)) (rec (type (struct (field (ref null 2)))) (type (array (mut (ref null 1))))) (type (func (param (ref 1)))))", + 3, + ); + assert_eq!(a, b); +} + +#[test] +fn non_function_and_multiple_results_are_explicit_errors() { + let bytes = + wat::parse_str("(module (type (array i32)) (type (func (result i32 i64))))").unwrap(); + let types = CoreTypes::from_module(&bytes).unwrap(); + assert!(types.signature(0).unwrap_err().contains("non-function")); + assert!(types.signature(1).unwrap_err().contains("multiple results")); +} diff --git a/crates/psrs-linker/src/lib.rs b/crates/psrs-linker/src/lib.rs index 4ce385d1..c9d205c8 100644 --- a/crates/psrs-linker/src/lib.rs +++ b/crates/psrs-linker/src/lib.rs @@ -16,6 +16,10 @@ mod application; mod closure; mod compose; +mod core_assembly; +pub use core_assembly::{CoreAssembly, assemble_core}; +mod core_types; +pub use core_types::{CoreReference, CoreTypes}; mod definitions; mod digest; mod error; @@ -26,6 +30,7 @@ pub mod runtime; mod stack; mod target; mod verify; +mod world_boundary; pub use compose::{LinkedArtifact, compose}; pub use definitions::{ResolvedWorldContext, resolve_default_definitions, resolve_definitions}; diff --git a/crates/psrs-linker/src/runtime/encoded.rs b/crates/psrs-linker/src/runtime/encoded.rs new file mode 100644 index 00000000..fff9494c --- /dev/null +++ b/crates/psrs-linker/src/runtime/encoded.rs @@ -0,0 +1,159 @@ +//! Resolves declared encoded-unit schemas independently of executable bytes. +use crate::target::{ + ArtifactContract, ArtifactKind, ArtifactReference, CoreSignature, DeclaredExport, ExportKind, + InitializationContract, OfferedOperation, RuntimeUnitOffer, +}; +use crate::{CoreTypes, LinkErrors, LinkStage}; +use psrs_runtime::{EncodedHeap, EncodedRuntimeUnit, EncodedValue, RawType}; +use wasmparser::{AbstractHeapType, HeapType, RefType, ValType}; + +pub(super) fn offer(unit: &EncodedRuntimeUnit) -> Result { + let resolve = || -> Result { + let types = CoreTypes::from_module(&(unit.type_schema)())?; + let provided = (unit.operations)() + .into_iter() + .map(|operation| { + Ok(OfferedOperation { + name: operation.name, + version: operation.version.into(), + export: operation.export.into(), + signature: CoreSignature { + parameters: operation + .parameters + .into_iter() + .map(|ty| types.value(value(ty)?)) + .collect::>()?, + result: operation + .result + .map(|ty| types.value(value(ty)?)) + .transpose()?, + }, + }) + }) + .collect::, String>>()?; + let bytes = (unit.encode)(); + let contract = ArtifactContract { + id: unit.id.into(), + kind: ArtifactKind::CoreModule, + module_name: unit.module_name.into(), + sha256: crate::sha256_hex(&bytes), + provenance: unit.provenance.into(), + required_features: unit.required_features.iter().map(|s| (*s).into()).collect(), + imports: vec![], + exports: provided + .iter() + .map(|op| DeclaredExport { + name: op.export.clone(), + kind: ExportKind::Func, + signature: Some(op.signature.clone()), + }) + .collect(), + tables: vec![], + elements: vec![], + globals: vec![], + storage: None, + initialization: InitializationContract { + start_forbidden: true, + data_range: (0, 0), + }, + instantiate_after_shims: false, + }; + Ok(RuntimeUnitOffer { + id: unit.id.into(), + semantic_contract_version: unit.version.into(), + provided, + required: vec![], + artifact: ArtifactReference { contract, bytes }, + state_owner: None, + grows_memory: false, + }) + }; + resolve().map_err(|message| LinkErrors::one(LinkStage::Verify, unit.id, message)) +} + +fn value(value: EncodedValue) -> Result { + Ok(match value { + EncodedValue::Scalar(ty) => match ty { + RawType::I32 => ValType::I32, + RawType::I64 => ValType::I64, + RawType::F32 => ValType::F32, + RawType::F64 => ValType::F64, + }, + EncodedValue::Ref { nullable, heap } => { + let heap = match heap { + EncodedHeap::Defined(index) => { + HeapType::Concrete(wasmparser::UnpackedIndex::Module(index)) + } + heap => HeapType::Abstract { + shared: false, + ty: match heap { + EncodedHeap::Func => AbstractHeapType::Func, + EncodedHeap::Extern => AbstractHeapType::Extern, + EncodedHeap::Any => AbstractHeapType::Any, + EncodedHeap::Eq => AbstractHeapType::Eq, + EncodedHeap::I31 => AbstractHeapType::I31, + EncodedHeap::Struct => AbstractHeapType::Struct, + EncodedHeap::Array => AbstractHeapType::Array, + EncodedHeap::Defined(_) => unreachable!(), + }, + }, + }; + ValType::Ref( + RefType::new(nullable, heap).ok_or("declared reference index is out of range")?, + ) + } + }) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn storage_offer_verifies_against_independent_declared_schema() { + let units = crate::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME).unwrap(); + let storage = units + .iter() + .find(|unit| unit.id == psrs_runtime::STORAGE_UNIT.id) + .unwrap(); + crate::verify_artifact(&storage.artifact.contract, &storage.artifact.bytes).unwrap(); + assert_eq!( + storage.provided.len(), + psrs_runtime::StorageOperation::ALL.len() + ); + assert!(storage.provided.iter().any(|op| { + op.signature + .parameters + .iter() + .any(|ty| matches!(ty, crate::CoreType::Ref(_))) + })); + } + + #[test] + fn valid_bytes_with_wrong_declared_reference_contract_are_rejected() { + let mut storage = offer(&psrs_runtime::STORAGE_UNIT).unwrap(); + let export = storage + .artifact + .contract + .exports + .iter_mut() + .find(|export| { + export.signature.as_ref().is_some_and(|sig| { + sig.parameters + .iter() + .any(|ty| matches!(ty, crate::CoreType::Ref(_))) + }) + }) + .unwrap(); + let signature = export.signature.as_mut().unwrap(); + let parameter = signature + .parameters + .iter_mut() + .find(|ty| matches!(ty, crate::CoreType::Ref(_))) + .unwrap(); + *parameter = crate::CoreType::I32; + let error = crate::verify_artifact(&storage.artifact.contract, &storage.artifact.bytes) + .unwrap_err(); + assert!(error.to_string().contains("signature"), "{error}"); + } +} diff --git a/crates/psrs-linker/src/runtime.rs b/crates/psrs-linker/src/runtime/mod.rs similarity index 95% rename from crates/psrs-linker/src/runtime.rs rename to crates/psrs-linker/src/runtime/mod.rs index b71e3868..7a8635a4 100644 --- a/crates/psrs-linker/src/runtime.rs +++ b/crates/psrs-linker/src/runtime/mod.rs @@ -3,6 +3,8 @@ //! The runtime package owns the raw declaration; the linker owns the typed //! contract it verifies and plans against. +mod encoded; + use crate::target::{ ArtifactContract, ArtifactKind, ArtifactReference, CoreSignature, CoreType, DeclaredElement, DeclaredExport, DeclaredGlobal, DeclaredImport, DeclaredTable, ExportKind, ImportKind, @@ -153,8 +155,14 @@ pub fn offer(unit: &RuntimeUnit) -> RuntimeUnitOffer { } /// Maps every unit of a catalog package. Unused units stay unselected. -pub fn package_offers(package: &RuntimePackage) -> Vec { - package.units.iter().copied().map(offer).collect() +pub fn package_offers( + package: &RuntimePackage, +) -> Result, crate::LinkErrors> { + let mut units = package.units.iter().copied().map(offer).collect::>(); + for unit in package.encoded_units { + units.push(encoded::offer(unit)?); + } + Ok(units) } fn signature(parameters: &[RawType], result: Option) -> CoreSignature { diff --git a/crates/psrs-linker/src/target.rs b/crates/psrs-linker/src/target.rs index 098dbba1..ee56136f 100644 --- a/crates/psrs-linker/src/target.rs +++ b/crates/psrs-linker/src/target.rs @@ -9,13 +9,15 @@ #[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord, Hash)] pub struct RequirementId(pub u32); -/// The scalar subset of the core-Wasm value model a target signature uses. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] +/// The checked core-Wasm value contract, independent of module-local indices. +#[derive(Clone, Debug, PartialEq, Eq)] pub enum CoreType { I32, I64, F32, F64, + V128, + Ref(crate::core_types::CoreReference), } /// A core-Wasm function signature. diff --git a/crates/psrs-linker/src/verify/mod.rs b/crates/psrs-linker/src/verify/mod.rs index c1f7dc2e..3c9ef363 100644 --- a/crates/psrs-linker/src/verify/mod.rs +++ b/crates/psrs-linker/src/verify/mod.rs @@ -21,6 +21,9 @@ pub struct VerifiedArtifact { pub module_name: String, pub sha256: String, pub bytes: Vec, + /// Complete raw interfaces retained after executable contract verification. + pub imports: Vec, + pub exports: Vec, pub instantiate_after_shims: bool, /// The measured static stack bound, when the artifact declares storage. pub stack_bound_bytes: Option, @@ -106,6 +109,8 @@ pub fn verify_artifact( module_name: contract.module_name.clone(), sha256: digest, bytes: bytes.to_vec(), + imports: contract.imports.clone(), + exports: contract.exports.clone(), instantiate_after_shims: contract.instantiate_after_shims, stack_bound_bytes, }) diff --git a/crates/psrs-linker/src/verify/parse.rs b/crates/psrs-linker/src/verify/parse.rs index 69b93905..05e8a170 100644 --- a/crates/psrs-linker/src/verify/parse.rs +++ b/crates/psrs-linker/src/verify/parse.rs @@ -1,10 +1,8 @@ //! Parsing a core module and comparing it with a declared contract. use crate::error::{LinkErrors, LinkStage}; -use crate::target::{ - ArtifactContract, CoreSignature, CoreType, DeclaredExport, ExportKind, ImportKind, -}; -use wasmparser::{CompositeInnerType, ExternalKind, Operator, Parser, Payload, TypeRef, ValType}; +use crate::target::{ArtifactContract, CoreSignature, DeclaredExport, ExportKind, ImportKind}; +use wasmparser::{ExternalKind, Operator, Parser, Payload, TypeRef, ValType}; pub(super) fn check_contract( contract: &ArtifactContract, @@ -186,7 +184,7 @@ fn globals_differ(parsed: &ParsedCore, contract: &ArtifactContract) -> bool { } pub(super) fn parse_core_module(bytes: &[u8]) -> Result { - let mut types = Vec::new(); + let mut types = crate::CoreTypes::default(); let mut imported_functions = Vec::new(); let mut defined_functions = Vec::new(); let mut imports = Vec::new(); @@ -203,13 +201,7 @@ pub(super) fn parse_core_module(bytes: &[u8]) -> Result { match payload.map_err(|error| error.to_string())? { Payload::TypeSection(reader) => { for group in reader { - for ty in group.map_err(|error| error.to_string())?.into_types() { - if let CompositeInnerType::Func(func) = ty.composite_type.inner { - types.push(func); - } else { - return Err("artifact defines a non-function composite type".into()); - } - } + types.push(group.map_err(|error| error.to_string())?)?; } } Payload::ImportSection(reader) => { @@ -403,7 +395,7 @@ fn function_signature( index: u32, imported_functions: &[u32], defined_functions: &[u32], - types: &[wasmparser::FuncType], + types: &crate::CoreTypes, ) -> Result { let type_index = if (index as usize) < imported_functions.len() { imported_functions[index as usize] @@ -413,24 +405,5 @@ fn function_signature( .get(defined) .ok_or("artifact export refers to an unknown function")? }; - let ty = types - .get(type_index as usize) - .ok_or("artifact function has no type")?; - let convert = |ty: ValType| match ty { - ValType::I32 => Some(CoreType::I32), - ValType::I64 => Some(CoreType::I64), - ValType::F32 => Some(CoreType::F32), - ValType::F64 => Some(CoreType::F64), - _ => None, - }; - let mut parameters = Vec::with_capacity(ty.params().len()); - for param in ty.params() { - parameters.push(convert(*param).ok_or("artifact parameter is not a scalar")?); - } - let result = match ty.results() { - [] => None, - [single] => Some(convert(*single).ok_or("artifact result is not a scalar")?), - _ => return Err("artifact function has multiple results".into()), - }; - Ok(CoreSignature { parameters, result }) + types.signature(type_index) } diff --git a/crates/psrs-linker/src/world_boundary/facade.rs b/crates/psrs-linker/src/world_boundary/facade.rs new file mode 100644 index 00000000..6fccc476 --- /dev/null +++ b/crates/psrs-linker/src/world_boundary/facade.rs @@ -0,0 +1,148 @@ +//! Interface-only WIT input; original application instructions are never replaced. +use super::*; +use wasm_encoder::{ElementSection, ExportSection, GlobalSection, ImportSection}; + +struct Indices(Vec); +impl Reencode for Indices { + type Error = String; + fn function_index(&mut self, index: u32) -> Result> { + Ok(self.0.get(index as usize).copied().unwrap_or(index)) + } +} + +/// Preserve permitted host and registered canonical library imports while +/// replacing raw provider imports with local declarations. Import permutation +/// is reflected in all function references. +pub(super) fn boundary_module(bytes: &[u8], hosts: &[String]) -> Result, String> { + let mut imports = ImportSection::new(); + let mut private = Vec::new(); + let mut functions = FunctionSection::new(); + let mut permutation = Vec::new(); + let mut host_count = 0; + let mut has_imports = false; + for payload in Parser::new(0).parse_all(bytes) { + match payload.map_err(|e| e.to_string())? { + Payload::ImportSection(section) => { + has_imports = true; + for import in section.into_imports() { + let import = import.map_err(|e| e.to_string())?; + let TypeRef::Func(index) = import.ty else { + return Err( + "canonical boundary projection requires application-owned storage" + .into(), + ); + }; + if hosts.iter().any(|host| host == import.module) { + imports.import( + import.module, + import.name, + wasm_encoder::EntityType::Function(index), + ); + permutation.push((true, host_count)); + host_count += 1; + } else { + permutation.push((false, private.len() as u32)); + private.push(index); + } + } + for index in &private { + functions.function(*index); + } + } + Payload::FunctionSection(section) => { + for index in section { + functions.function(index.map_err(|e| e.to_string())?); + } + } + Payload::CustomSection(section) if section.name() == MARKER => { + return Err("source module uses a reserved canonical boundary marker".into()); + } + Payload::StartSection { .. } => { + return Err( + "canonical boundary cannot project an application start function".into(), + ); + } + _ => {} + } + } + let mut indices = Indices( + permutation + .into_iter() + .map(|(host, index)| if host { index } else { host_count + index }) + .collect(), + ); + let mut module = Module::new(); + let mut code = CodeSection::new(); + for _ in 0..functions.len() { + let mut body = Function::new([]); + body.instruction(&Instruction::Unreachable); + body.instruction(&Instruction::End); + code.function(&body); + } + let mut code_emitted = false; + for payload in Parser::new(0).parse_all(bytes) { + match payload.map_err(|e| e.to_string())? { + Payload::ImportSection(_) => { + if !imports.is_empty() { + module.section(&imports); + } + if !functions.is_empty() { + module.section(&functions); + } + } + Payload::FunctionSection(_) + | Payload::CodeSectionEntry(_) + | Payload::Version { .. } => {} + Payload::CodeSectionStart { .. } => { + module.section(&code); + code_emitted = true; + } + Payload::ExportSection(section) => { + let mut exports = ExportSection::new(); + indices + .parse_export_section(&mut exports, section) + .map_err(|e| e.to_string())?; + module.section(&exports); + } + Payload::GlobalSection(section) => { + let mut globals = GlobalSection::new(); + indices + .parse_global_section(&mut globals, section) + .map_err(|e| e.to_string())?; + module.section(&globals); + } + Payload::ElementSection(section) => { + let mut elements = ElementSection::new(); + indices + .parse_element_section(&mut elements, section) + .map_err(|e| e.to_string())?; + module.section(&elements); + } + Payload::End(_) => { + if !code_emitted && !functions.is_empty() { + module.section(&code); + } + } + payload => { + if let Some((id, range)) = payload.as_section() { + module.section(&RawSection { + id, + data: &bytes[range], + }); + if id == 1 && !has_imports && !functions.is_empty() { + module.section(&functions); + } + } + } + } + } + module.section(&CustomSection { + name: Cow::Borrowed(MARKER), + data: Cow::Borrowed(b"1"), + }); + let bytes = module.finish(); + wasmparser::Validator::new() + .validate_all(&bytes) + .map_err(|e| e.to_string())?; + Ok(bytes) +} diff --git a/crates/psrs-linker/src/world_boundary/mod.rs b/crates/psrs-linker/src/world_boundary/mod.rs new file mode 100644 index 00000000..817c0610 --- /dev/null +++ b/crates/psrs-linker/src/world_boundary/mod.rs @@ -0,0 +1,237 @@ +//! WIT boundary encoding kept separate from private raw Core instance assembly. +use crate::{CheckedLinkPlan, LinkErrors, LinkStage, ResolvedWorldContext}; +use std::borrow::Cow; +use wasm_encoder::reencode::{Error, Reencode, ReencodeComponent}; +use wasm_encoder::{ + CodeSection, Component, CustomSection, Function, FunctionSection, Instruction, Module, + RawSection, +}; +use wasmparser::{Parser, Payload, TypeRef}; + +const MARKER: &str = "psrs-linker:canonical-boundary"; + +pub(super) fn encode( + context: &ResolvedWorldContext, + plan: &CheckedLinkPlan, + application: &[u8], +) -> Result, LinkErrors> { + fn error(message: impl Into) -> LinkErrors { + LinkErrors::plain(LinkStage::Compose, message) + } + let libraries = crate::core_assembly::canonical_libraries(plan); + let prepared = crate::core_assembly::prepare_core(plan, application, &libraries)?; + let application_module = prepared.application_module; + let providers = prepared.providers; + let builder = prepared.component; + let modules = builder.core_module_count(); + let instances = builder.core_instance_count(); + let prefix = builder.finish(); + let mut visible = plan.external_world().to_vec(); + visible.extend(libraries.iter().cloned()); + let mut facade = boundary_module(application, &visible).map_err(error)?; + let world = context + .composition_world() + .ok_or_else(|| error("canonical boundary requires a resolved world"))?; + wit_component::embed_component_metadata( + &mut facade, + context.resolve(), + world, + wit_component::StringEncoding::UTF8, + ) + .map_err(|e| error(format!("{e:#}")))?; + let mut encoder = wit_component::ComponentEncoder::default() + .module(&facade) + .map_err(|e| error(format!("{e:#}")))?; + for artifact in plan + .artifacts() + .iter() + .filter(|artifact| libraries.contains(&artifact.module_name)) + { + encoder = encoder + .library( + &artifact.module_name, + &artifact.bytes, + wit_component::LibraryInfo { + instantiate_after_shims: artifact.instantiate_after_shims, + arguments: Vec::new(), + }, + ) + .map_err(|e| error(format!("{e:#}")))?; + } + let boundary = encoder + .validate(true) + .encode() + .map_err(|e| error(format!("{e:#}")))?; + let mut component = Component::new(); + CopyModules + .parse_component(&mut component, Parser::new(0), &prefix) + .map_err(|e| error(format!("{e:#}")))?; + let mut attach = Attach { + modules, + instances, + providers, + application_module, + depth: 0, + module_seen: false, + instance_seen: false, + source_instances: 0, + source_application: None, + }; + attach + .parse_component(&mut component, Parser::new(0), &boundary) + .map_err(|e| error(format!("{e:#}")))?; + if !attach.module_seen || !attach.instance_seen { + return Err(error( + "canonical boundary did not identify its application instance", + )); + } + Ok(component.finish()) +} + +mod facade; +use facade::boundary_module; + +struct CopyModules; +impl Reencode for CopyModules { + type Error = String; +} +impl ReencodeComponent for CopyModules { + fn parse_component_submodule( + &mut self, + component: &mut Component, + _: Parser, + bytes: &[u8], + ) -> Result<(), Error> { + component.section(&RawSection { id: 1, data: bytes }); + Ok(()) + } +} + +struct Attach { + modules: u32, + instances: u32, + providers: std::collections::BTreeMap, + application_module: u32, + depth: u32, + source_instances: u32, + source_application: Option, + module_seen: bool, + instance_seen: bool, +} +impl Reencode for Attach { + type Error = String; +} +impl ReencodeComponent for Attach { + fn push_depth(&mut self) { + self.depth += 1; + } + fn pop_depth(&mut self) { + self.depth -= 1; + } + fn module_index(&mut self, index: u32) -> u32 { + if self.depth == 0 { + self.root_module(index) + } else { + index + } + } + fn outer_module_index(&mut self, count: u32, index: u32) -> u32 { + if count == self.depth { + self.root_module(index) + } else { + index + } + } + fn instance_index(&mut self, index: u32) -> u32 { + if self.depth != 0 { + return index; + } + index + self.instances + } + fn parse_component_submodule( + &mut self, + component: &mut Component, + parser: Parser, + bytes: &[u8], + ) -> Result<(), Error> { + let marker = Parser::new(0).parse_all(bytes).any(|payload| matches!(payload, Ok(Payload::CustomSection(section)) if section.name() == MARKER && section.data() == b"1")); + if self.depth == 0 && !self.module_seen { + if !marker { + return Err(Error::UserError( + "canonical application module lacks its identity marker".into(), + )); + } + self.module_seen = true; + return Ok(()); + } + if marker { + return Err(Error::UserError( + "canonical application module identity is repeated".into(), + )); + } + wasm_encoder::reencode::component_utils::parse_component_submodule( + self, component, parser, bytes, + ) + } + fn parse_instance( + &mut self, + instances: &mut wasm_encoder::InstanceSection, + instance: wasmparser::Instance<'_>, + ) -> Result<(), Error> { + if self.depth == 0 { + let index = self.source_instances; + self.source_instances += 1; + if matches!( + instance, + wasmparser::Instance::Instantiate { + module_index: 0, + .. + } + ) { + if self.instance_seen { + return Err(Error::UserError( + "canonical application instance is repeated".into(), + )); + } + let wasmparser::Instance::Instantiate { args, .. } = instance else { + unreachable!() + }; + let mut actual = args + .iter() + .map(|arg| { + if self.providers.contains_key(arg.name) { + return Err(Error::UserError( + "canonical host and raw provider namespaces conflict".into(), + )); + } + Ok(( + arg.name, + wasm_encoder::ModuleArg::Instance(self.instance_index(arg.index)), + )) + }) + .collect::, Error>>()?; + actual.extend(self.providers.iter().map(|(name, index)| { + (name.as_str(), wasm_encoder::ModuleArg::Instance(*index)) + })); + instances.instantiate(self.application_module, actual); + self.instance_seen = true; + self.source_application = Some(index); + return Ok(()); + } + } + wasm_encoder::reencode::component_utils::parse_instance(self, instances, instance) + } +} + +impl Attach { + fn root_module(&self, index: u32) -> u32 { + if index == 0 { + self.application_module + } else { + index + self.modules - 1 + } + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-linker/src/world_boundary/tests.rs b/crates/psrs-linker/src/world_boundary/tests.rs new file mode 100644 index 00000000..0195ea60 --- /dev/null +++ b/crates/psrs-linker/src/world_boundary/tests.rs @@ -0,0 +1,253 @@ +use super::*; + +#[test] +fn facade_preserves_function_indices_and_complete_public_gc_signatures() { + let source = wat::parse_str( + r#"(module + (type $a (array (mut eqref))) + (import "private" "read" (func $read (param (ref $a) i32) (result eqref))) + (memory (export "memory") 1) + (func (export "run") (result i32) i32.const 7) + (export "read" (func $read)))"#, + ) + .unwrap(); + let facade = boundary_module(&source, &[]).unwrap(); + let original = crate::CoreTypes::from_module(&source).unwrap(); + let projected = crate::CoreTypes::from_module(&facade).unwrap(); + assert_eq!( + original.signature(1).unwrap(), + projected.signature(1).unwrap() + ); + assert_eq!( + original.signature(2).unwrap(), + projected.signature(2).unwrap() + ); + assert!( + !Parser::new(0) + .parse_all(&facade) + .any(|payload| matches!(payload, Ok(Payload::ImportSection(_)))) + ); + let mut exports = Vec::new(); + for payload in Parser::new(0).parse_all(&facade) { + if let Payload::ExportSection(section) = payload.unwrap() { + for export in section { + let export = export.unwrap(); + if export.kind == wasmparser::ExternalKind::Func { + exports.push((export.name.to_string(), export.index)); + } + } + } + } + assert!(exports.contains(&("read".into(), 0))); + assert!(exports.contains(&("run".into(), 1))); +} + +#[test] +fn an_exported_import_only_module_gets_a_valid_boundary_declaration() { + let source = wat::parse_str( + r#"(module + (import "private" "run" (func (result i32))) + (memory (export "memory") 1) + (export "run" (func 0)))"#, + ) + .unwrap(); + let projected = boundary_module(&source, &[]).unwrap(); + wasmparser::Validator::new() + .validate_all(&projected) + .unwrap(); +} + +#[test] +fn facade_retains_registered_scalar_libraries_and_relocates_raw_reference_functions() { + let source = wat::parse_str( + r#"(module + (type $array (array (mut eqref))) + (import "raw" "read" (func $read (param (ref $array) i32) (result eqref))) + (import "scalar" "allocate" (func $allocate (param i32) (result i32))) + (memory (export "memory") 1) + (export "read" (func $read)) + (export "allocate" (func $allocate)))"#, + ) + .unwrap(); + let facade = boundary_module(&source, &["scalar".into()]).unwrap(); + wasmparser::Validator::new().validate_all(&facade).unwrap(); + let mut imports = Vec::new(); + let mut exports = Vec::new(); + for payload in Parser::new(0).parse_all(&facade) { + match payload.unwrap() { + Payload::ImportSection(section) => { + for import in section.into_imports() { + imports.push(import.unwrap().module.to_owned()); + } + } + Payload::ExportSection(section) => { + for export in section { + let export = export.unwrap(); + if export.kind == wasmparser::ExternalKind::Func { + exports.push((export.name.to_owned(), export.index)); + } + } + } + _ => {} + } + } + assert_eq!(imports, ["scalar"]); + assert!(exports.contains(&("allocate".into(), 0))); + assert!(exports.contains(&("read".into(), 1))); + let original = crate::CoreTypes::from_module(&source).unwrap(); + let projected = crate::CoreTypes::from_module(&facade).unwrap(); + assert_eq!( + original.signature(1).unwrap(), + projected.signature(1).unwrap() + ); + assert_eq!( + original.signature(2).unwrap(), + projected.signature(2).unwrap() + ); +} + +#[test] +fn reserved_boundary_identity_and_storage_imports_are_rejected() { + let mut source = Module::new(); + source.section(&CustomSection { + name: Cow::Borrowed(MARKER), + data: Cow::Borrowed(b"1"), + }); + assert!( + boundary_module(&source.finish(), &[]) + .unwrap_err() + .contains("reserved") + ); + let source = wat::parse_str(r#"(module (import "env" "memory" (memory 1)))"#).unwrap(); + assert!( + boundary_module(&source, &[]) + .unwrap_err() + .contains("application-owned storage") + ); +} + +#[test] +fn index_mapping_tracks_application_identity_and_component_scopes() { + let mut attach = Attach { + modules: 4, + instances: 4, + providers: Default::default(), + application_module: 2, + depth: 0, + module_seen: true, + instance_seen: true, + source_instances: 3, + source_application: Some(1), + }; + assert_eq!(attach.module_index(0), 2); + assert_eq!(attach.module_index(1), 4); + assert_eq!(attach.instance_index(0), 4); + assert_eq!(attach.instance_index(1), 5); + assert_eq!(attach.instance_index(2), 6); + attach.push_depth(); + assert_eq!(attach.module_index(0), 0); + assert_eq!(attach.instance_index(1), 1); + assert_eq!(attach.outer_module_index(1, 0), 2); + attach.pop_depth(); +} + +#[test] +fn malformed_boundary_module_and_instance_identities_are_rejected() { + fn attach() -> Attach { + Attach { + modules: 2, + instances: 2, + providers: Default::default(), + application_module: 1, + depth: 0, + module_seen: false, + instance_seen: false, + source_instances: 0, + source_application: None, + } + } + let missing = wat::parse_str("(component (core module))").unwrap(); + let error = attach() + .parse_component(&mut Component::new(), Parser::new(0), &missing) + .unwrap_err(); + assert!(error.to_string().contains("identity marker")); + + let mut module = Module::new(); + module.section(&CustomSection { + name: Cow::Borrowed(MARKER), + data: Cow::Borrowed(b"1"), + }); + let bytes = module.finish(); + let mut component = wasm_encoder::ComponentBuilder::default(); + component.core_module_raw(None, &bytes); + component.core_module_raw(None, &bytes); + let repeated = component.finish(); + let error = attach() + .parse_component(&mut Component::new(), Parser::new(0), &repeated) + .unwrap_err(); + assert!(error.to_string().contains("identity is repeated")); + + let mut component = wasm_encoder::ComponentBuilder::default(); + let module = component.core_module_raw(None, &bytes); + component.core_instantiate(None, module, []); + component.core_instantiate(None, module, []); + let repeated = component.finish(); + let error = attach() + .parse_component(&mut Component::new(), Parser::new(0), &repeated) + .unwrap_err(); + assert!(error.to_string().contains("instance is repeated")); +} + +#[test] +fn facade_retains_host_imports_and_remaps_private_function_references() { + let source = wat::parse_str( + r#"(module + (type $a (array (mut eqref))) + (import "private" "read" (func $read (param (ref $a) i32) (result eqref))) + (import "host" "write" (func $host (param i32))) + (table 2 funcref) + (elem (i32.const 0) func $read $host) + (global (ref func) ref.func $read) + (memory (export "memory") 1) + (func (export "run") (result i32) i32.const 7) + (export "read" (func $read)) + (export "host" (func $host)))"#, + ) + .unwrap(); + let projected = boundary_module(&source, &["host".into()]).unwrap(); + let mut exports = Vec::new(); + let mut imports = Vec::new(); + let mut functions = Vec::new(); + for payload in Parser::new(0).parse_all(&projected) { + match payload.unwrap() { + Payload::ImportSection(section) => { + for import in section.into_imports() { + let import = import.unwrap(); + imports.push((import.module.to_string(), import.name.to_string())); + } + } + Payload::ExportSection(section) => { + for export in section { + let export = export.unwrap(); + if export.kind == wasmparser::ExternalKind::Func { + exports.push((export.name.to_string(), export.index)); + } + } + } + Payload::ElementSection(section) => { + for element in section { + let wasmparser::ElementItems::Functions(items) = element.unwrap().items else { + panic!("function element expected") + }; + functions.extend(items.into_iter().map(Result::unwrap)); + } + } + _ => {} + } + } + assert_eq!(imports, [("host".into(), "write".into())]); + assert_eq!(functions, [1, 0]); + assert!(exports.contains(&("host".into(), 0))); + assert!(exports.contains(&("read".into(), 1))); + assert!(exports.contains(&("run".into(), 2))); +} diff --git a/crates/psrs-linker/tests/gc_storage.rs b/crates/psrs-linker/tests/gc_storage.rs new file mode 100644 index 00000000..e6d82470 --- /dev/null +++ b/crates/psrs-linker/tests/gc_storage.rs @@ -0,0 +1,294 @@ +//! Checked GC provider selection and application composition, without compiler IR. +use psrs_linker::{ + BindingRequirement, Boundary, CoreTypes, Provider, RequirementId, TargetLinkInput, TargetPolicy, +}; + +fn application(nullable: bool) -> Vec { + application_with_expected(nullable, 78) +} + +fn application_with_expected(nullable: bool, expected: i32) -> Vec { + let array = if nullable { + "(ref null $a)" + } else { + "(ref $a)" + }; + wat::parse_str(format!(r#"(module + (type (struct (field i64))) + (type $a (array (mut eqref))) + (import "psrs:runtime-storage" "array_fill" (func $fill (param i32 eqref) (result (ref $a)))) + (import "psrs:runtime-storage" "array_write" (func $write (param {array} i32 eqref))) + (import "psrs:runtime-storage" "array_read" (func $read (param (ref $a) i32) (result eqref))) + (memory (export "memory") 2) + (func (export "wasi:cli/run@0.2.12#run") (result i32) (local $a (ref null $a)) (local $alias (ref null $a)) + i32.const 1 i32.const 7 ref.i31 call $fill local.tee $a local.set $alias + local.get $a ref.as_non_null i32.const 0 i32.const 78 ref.i31 call $write + local.get $alias ref.as_non_null i32.const 0 call $read + ref.cast (ref i31) i31.get_s i32.const {expected} i32.ne + local.get $a local.get $alias ref.eq i32.eqz i32.or))"#)).unwrap() +} + +fn setup() -> ( + psrs_linker::ResolvedWorldContext, + psrs_linker::CheckedLinkPlan, +) { + setup_in_context(psrs_linker::resolve_default_definitions().unwrap()) +} + +fn setup_in_context( + context: psrs_linker::ResolvedWorldContext, +) -> ( + psrs_linker::ResolvedWorldContext, + psrs_linker::CheckedLinkPlan, +) { + let units = psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME).unwrap(); + let storage = units + .iter() + .find(|unit| unit.id == psrs_runtime::STORAGE_UNIT.id) + .unwrap(); + let requirements = storage + .provided + .iter() + .filter(|op| op.export != "trap") + .enumerate() + .map(|(index, op)| BindingRequirement { + id: RequirementId(index as u32), + origin: op.name.clone(), + boundary: Boundary::RawCore { + module: psrs_runtime::STORAGE_MODULE.into(), + field: op.export.clone(), + }, + expected: Some(op.signature.clone()), + provider: Provider::RuntimeOperation { + name: op.name.clone(), + version: op.version.clone(), + }, + }) + .collect(); + let plan = psrs_linker::plan( + &context, + TargetLinkInput { + requirements, + units, + policy: TargetPolicy::default(), + memory: psrs_linker::MemoryDemand { + canonical_scratch: (0, 16), + allocator_state: (16, 24), + base_heap_start: 24, + heap_alignment: 8, + growth_owner: psrs_linker::GENERATED_GROWTH_OWNER.into(), + maximum_pages: None, + }, + }, + ) + .unwrap(); + (context, plan) +} + +#[test] +fn checked_provider_selection_matches_gc_contracts_and_rejects_application_drift() { + let (context, plan) = setup(); + assert_eq!(plan.artifacts().len(), 1); + let types = CoreTypes::from_module(&application(false)).unwrap(); + let units = psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME).unwrap(); + let storage = units + .iter() + .find(|unit| unit.id == psrs_runtime::STORAGE_UNIT.id) + .unwrap(); + for (index, export) in [(2, "array_fill"), (3, "array_write"), (4, "array_read")] { + let operation = storage + .provided + .iter() + .find(|op| op.export == export) + .unwrap(); + assert_eq!(types.signature(index).unwrap(), operation.signature); + } + let error = psrs_linker::compose(&context, &plan, &application(true)).unwrap_err(); + assert!( + error.to_string().contains("application import signature"), + "{error}" + ); + let error = match psrs_linker::assemble_core(&plan, &application(true)) { + Ok(_) => panic!("nullable array drift must fail before direct assembly"), + Err(error) => error, + }; + assert!( + error.to_string().contains("application import signature"), + "{error}" + ); +} + +#[test] +fn checked_storage_provider_closes_gc_imports() { + let (context, plan) = setup(); + let app = application(false); + let linked = psrs_linker::compose(&context, &plan, &app).unwrap(); + let units = psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME).unwrap(); + let provider = &units + .iter() + .find(|unit| unit.id == psrs_runtime::STORAGE_UNIT.id) + .unwrap() + .artifact + .bytes; + let mut originals = 0; + for payload in wasmparser::Parser::new(0).parse_all(&linked.bytes) { + if let wasmparser::Payload::ModuleSection { + unchecked_range, .. + } = payload.unwrap() + { + let bytes = &linked.bytes[unchecked_range]; + if bytes == app || bytes == provider { + originals += 1; + } + } + } + assert_eq!( + originals, 2, + "the component must retain both original core modules" + ); + assert!( + !linked + .external_world + .iter() + .any(|name| name == psrs_runtime::STORAGE_MODULE) + ); + let wrong = + psrs_linker::compose(&context, &plan, &application_with_expected(false, 79)).unwrap(); + execute_commands("world", [(linked.bytes, true), (wrong.bytes, false)]); +} + +fn direct_command(plan: &psrs_linker::CheckedLinkPlan, app: &[u8]) -> Vec { + use wasm_encoder::{ComponentExportKind, ComponentValType, ExportKind}; + let assembled = psrs_linker::assemble_core(plan, app).unwrap(); + let application = assembled.application_instance(); + let mut component = assembled.into_encoder(); + let run = component.core_alias_export( + None, + application, + "wasi:cli/run@0.2.12#run", + ExportKind::Func, + ); + let (result, ty) = component.type_defined(None); + ty.result(None, None); + let (signature, mut ty) = component.type_function(None); + ty.params(std::iter::empty::<(&str, ComponentValType)>()); + ty.result(Some(ComponentValType::Type(result))); + let run = component.lift_func(None, run, signature, []); + let instance = component.instance_count(); + let mut bytes = component.finish(); + use wasm_encoder::ComponentSection; + let mut instances = wasm_encoder::ComponentInstanceSection::new(); + instances.export_items([("run", ComponentExportKind::Func, run)]); + instances.append_to_component(&mut bytes); + let mut exports = wasm_encoder::ComponentExportSection::new(); + exports.export( + "wasi:cli/run@0.2.12", + ComponentExportKind::Instance, + instance, + None, + ); + exports.append_to_component(&mut bytes); + wasmparser::Validator::new().validate_all(&bytes).unwrap(); + bytes +} + +#[test] +fn direct_core_instance_assembly_executes_gc_storage_inside_a_component() { + let (_, plan) = setup(); + execute_commands( + "direct", + [ + (direct_command(&plan, &application(false)), true), + ( + direct_command(&plan, &application_with_expected(false, 79)), + false, + ), + ], + ); +} + +fn execute_commands(label: &str, cases: [(Vec, bool); 2]) { + let version = std::process::Command::new("wasmtime") + .arg("--version") + .output(); + if !version.is_ok_and(|output| output.status.success()) { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "required Wasmtime unavailable" + ); + eprintln!("skipping GC component execution: Wasmtime unavailable"); + return; + } + let path = std::env::temp_dir().join(format!( + "psrs-gc-component-{label}-{}.wasm", + std::process::id() + )); + for (bytes, success) in cases { + std::fs::write(&path, bytes).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + assert_eq!( + output.status.success(), + success, + "expected success={success}: {}", + String::from_utf8_lossy(&output.stderr) + ); + } + std::fs::remove_file(&path).unwrap(); +} + +#[test] +fn canonical_boundary_uses_the_selected_world_and_public_parameters() { + let mut resolve = wit_parser::Resolve::default(); + let package = resolve + .push_str( + "counter.wit", + "package test:counter; world counter { export check: func(offset: u32) -> u32; }", + ) + .unwrap(); + let world = resolve.packages[package].worlds["counter"]; + let context = psrs_linker::ResolvedWorldContext::from_resolve(resolve, world); + let (context, plan) = setup_in_context(context); + let text = r#"(module + (type $a (array (mut eqref))) + (import "psrs:runtime-storage" "array_fill" (func $fill (param i32 eqref) (result (ref $a)))) + (import "psrs:runtime-storage" "array_write" (func $write (param (ref $a) i32 eqref))) + (import "psrs:runtime-storage" "array_read" (func $read (param (ref $a) i32) (result eqref))) + (memory (export "memory") 2) + (func (export "check") (param $offset i32) (result i32) (local $a (ref null $a)) + i32.const 1 ref.null eq call $fill local.set $a + local.get $a ref.as_non_null i32.const 0 local.get $offset i32.const 1 i32.add ref.i31 call $write + local.get $a ref.as_non_null i32.const 0 call $read ref.cast (ref i31) i31.get_s))"#; + let app = wat::parse_str(text).unwrap(); + let linked = psrs_linker::compose(&context, &plan, &app).unwrap(); + assert!(linked.external_world.is_empty()); + let decoded = wit_component::decode(&linked.bytes).unwrap(); + let wit_component::DecodedWasm::Component(resolve, world) = decoded else { + panic!("expected executable component") + }; + let wit_parser::WorldItem::Function(function) = + &resolve.worlds[world].exports[&wit_parser::WorldKey::Name("check".into())] + else { + panic!("expected check function") + }; + assert_eq!( + function + .params + .iter() + .map(|parameter| (parameter.name.as_str(), parameter.ty)) + .collect::>(), + vec![("offset", wit_parser::Type::U32)] + ); + assert_eq!(function.result, Some(wit_parser::Type::U32)); + let wrong = text + .replace("(param $offset i32)", "(param $offset i64)") + .replace("local.get $offset", "local.get $offset i32.wrap_i64"); + let wrong = wat::parse_str(wrong).unwrap(); + wasmparser::Validator::new().validate_all(&wrong).unwrap(); + let error = psrs_linker::compose(&context, &plan, &wrong).unwrap_err(); + assert!(error.to_string().contains("type mismatch"), "{error}"); +} diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index 93423913..cc518975 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -205,6 +205,30 @@ storage contracts. The backend consumes this data rather than using cross-crate `include_str!`/`include_bytes!` paths or maintaining a second embedded copy. The same catalog supplies ABI resolution and component-world construction. +Host-encoded runtime units declare operation signatures against a separate, +types-only Wasm schema. The linker resolves that schema into closed raw types +before checking executable export signatures; it must not infer the expected +contract from those exports. Raw GC references retain nullability, field +mutability, finality, supertypes, and the complete recursion group with bound +intra-group references. Module-local type indices are resolved at the owning +boundary and are not identities across independent artifacts. GC references +remain raw Core-Wasm contracts; scalar WIT projection rejects them explicitly. + +Private provider calls connect original Core modules through typed Core instance +arguments. Canonical WIT lift/lower belongs at world boundaries, not between +those raw providers. A raw instance assembly output is provisional until its +completed component validates and agrees with the checked target-world closure. +The current direct assembler handles closed acyclic graphs. Their canonical +world boundaries use a declaration-only application projection: imported +functions become local declarations at the same indices, public signatures and +storage declarations remain intact, and implementation bodies are omitted from +WIT inspection. The projection is removed from the output; boundary aliases +connect to the original application instance. No foreign implementation or +program body is replaced in the executable artifact. Component module/instance +indices are rebased explicitly, including nested outer-module aliases. Final +validation and exact external-world closure remain required before publication. +Shared-memory cycles and host provisioning remain incomplete for this path. + The independent `psrs-linker` owns WIT catalog loading, resolved world identities, provider contracts, and target composition. The backend owns source-signature checks, canonical call planning, representation recovery, and language-to-target @@ -613,3 +637,41 @@ checks it against both the provider contract and the actual artifact export. Generated allocator/codec imports MUST likewise match the shared generated-body signature and concrete GC byte-array representation. Internally consistent MIR call typing alone does not establish either provider boundary. + +Distinct source declarations may import the same provider/export. Every encoded +occurrence must independently match the planned complete Core type; matching +aliases satisfy one provider requirement without losing source call identities. +Before embedding the application in a component, the linker merges these checked +function import aliases and remaps every function reference, including calls, +exports and element initializers. Components require unique Core import names. +The original application instructions and storage are retained; conflicting +alias types are rejected before normalization. + +### Reference providers with canonical host imports + +Private GC-reference imports connect original Core modules directly through +checked instance arguments. WIT host functions cross the Canonical ABI through +`canon lower`; their resulting Core instances and selected private provider +instances must be available before instantiating the original application. +Provider identity, type/recursion-group agreement and residual host closure +remain linker obligations. No Effect-aware runtime dispatcher participates. + +An interface-only module may describe public exports to the WIT tooling while +retaining permitted host and registered canonical library imports. It must not +replace executable application instructions. Raw provider imports become +non-executable local declarations; when +this changes imported-function indices, every function reference in exports, +globals and element segments must follow the explicit permutation. The final +component removes the interface-only module and instantiates the original +application with canonical host instances and raw provider instances. Canonical +aliases must still refer to the original public exports, memory and resources. +Validate the completed component and compare its host imports with the checked +plan before publishing it. Providers with reference-valued import or export +interfaces, and their transitive consumers, remain in the raw Core graph. +Remaining scalar-interface providers use canonical library provisioning with +their checked `instantiate_after_shims` flags. This lets the allocator obtain +the original application's memory and heap boundary through the canonical +encoder's existing shim schedule even when a GC provider is also selected. +An acyclic raw provider graph independent of application storage can be prepared +before host adaptation. Cross-partition dependencies or shared-memory cycles +without a checked provisioning schedule must still fail explicitly. From aec55c15a44185d58955a9b696c589b6e28e2071 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:07:37 +0800 Subject: [PATCH 086/148] Project checked State dependencies through CC, MIR and Wasm --- crates/psrs-backend/Cargo.toml | 2 +- .../psrs-backend/src/abi/link/conformance.rs | 41 + crates/psrs-backend/src/bindings/mod.rs | 58 +- .../src/bindings/primitives/mod.rs | 1 + .../src/bindings/runtime/call/mod.rs | 139 ++ .../src/bindings/runtime/call/tests.rs | 199 ++ .../src/bindings/runtime/metadata.rs | 226 +++ .../psrs-backend/src/bindings/runtime/mod.rs | 111 + .../src/bindings/runtime/target.rs | 167 ++ crates/psrs-backend/src/bindings/tests.rs | 5 +- crates/psrs-backend/src/boundary/mod.rs | 89 +- crates/psrs-backend/src/boundary/newtypes.rs | 120 -- .../psrs-backend/src/boundary/newtypes/mod.rs | 63 + .../src/boundary/newtypes/tests.rs | 178 ++ crates/psrs-backend/src/boundary/tests.rs | 74 + .../src/cc/case/decision/realize/mod.rs | 20 +- crates/psrs-backend/src/cc/convert.rs | 25 + .../psrs-backend/src/cc/layout/aggregate.rs | 55 +- .../src/cc/layout/functions/mod.rs | 63 +- .../src/cc/layout/functions/parts.rs | 25 + .../src/cc/layout/functions/projection/mod.rs | 76 + .../cc/layout/functions/projection/tests.rs | 166 ++ .../src/cc/layout/functions/reachable.rs | 14 + crates/psrs-backend/src/cc/layout/mod.rs | 45 +- .../psrs-backend/src/cc/layout/protocols.rs | 7 + crates/psrs-backend/src/cc/layout/scalar.rs | 3 + .../src/cc/layout/tests/arrays.rs | 48 + .../psrs-backend/src/cc/layout/tests/mod.rs | 59 +- crates/psrs-backend/src/cc/lower/array/mod.rs | 10 +- .../src/cc/lower/array/storage.rs | 21 +- .../src/cc/lower/call/application.rs | 15 +- .../psrs-backend/src/cc/lower/call/helpers.rs | 34 +- crates/psrs-backend/src/cc/lower/call/mod.rs | 23 + .../src/cc/lower/call/partial/global.rs | 13 +- .../src/cc/lower/call/partial/mod.rs | 5 +- .../psrs-backend/src/cc/lower/constructor.rs | 13 +- .../src/cc/lower/conversion/function_slot.rs | 128 +- .../src/cc/lower/conversion/mod.rs | 82 +- .../src/cc/lower/conversion/product_map.rs | 98 + .../src/cc/lower/conversion/scalars.rs | 4 +- .../src/cc/lower/conversion/state_slot.rs | 82 + .../src/cc/lower/conversion/transport.rs | 41 +- crates/psrs-backend/src/cc/lower/global.rs | 15 + crates/psrs-backend/src/cc/lower/intrinsic.rs | 51 +- .../psrs-backend/src/cc/lower/string_bytes.rs | 58 +- crates/psrs-backend/src/cc/mod.rs | 61 + crates/psrs-backend/src/cc/payload.rs | 51 +- crates/psrs-backend/src/cc/projection.rs | 14 +- crates/psrs-backend/src/cc/representation.rs | 3 + crates/psrs-backend/src/cc/state/branches.rs | 152 ++ crates/psrs-backend/src/cc/state/eval.rs | 314 +++ crates/psrs-backend/src/cc/state/execution.rs | 84 + crates/psrs-backend/src/cc/state/mod.rs | 221 ++ .../src/cc/state/projection/conversion.rs | 55 + .../src/cc/state/projection/mod.rs | 82 + .../src/cc/state/projection/slots.rs | 96 + .../src/cc/state/projection/tests.rs | 175 ++ crates/psrs-backend/src/cc/state/tests.rs | 388 ++++ crates/psrs-backend/src/cc/verify/mod.rs | 1 + .../src/cc/verify/ops/aggregate/mod.rs | 18 +- .../src/cc/verify/ops/execution.rs | 19 + crates/psrs-backend/src/cc/verify/ops/mod.rs | 9 + .../psrs-backend/src/cc/verify/ops/table.rs | 6 + crates/psrs-backend/src/lib.rs | 2 +- crates/psrs-backend/src/linking/mod.rs | 49 +- .../psrs-backend/src/linking/runtime_tests.rs | 384 ++++ crates/psrs-backend/src/linking/tests.rs | 1 + crates/psrs-backend/src/mir/binding_tests.rs | 2 + crates/psrs-backend/src/mir/cfg.rs | 5 +- .../src/mir/gc_tests/binary_matrix/mod.rs | 2 +- .../indirect_tests/aggregate/collections.rs | 1 + .../mir/indirect_tests/aggregate/fixtures.rs | 2 + .../mir/indirect_tests/aggregate/indirect.rs | 1 + .../src/mir/indirect_tests/aggregate/large.rs | 2 + .../indirect_tests/aggregate/list_record.rs | 1 + .../mir/indirect_tests/aggregate/nested.rs | 3 + .../indirect_tests/aggregate/record_fields.rs | 2 + .../aggregate/resource_result.rs | 1 + .../mir/indirect_tests/aggregate/scalars.rs | 2 + .../mir/indirect_tests/composite/fixture.rs | 1 + .../src/mir/indirect_tests/mod.rs | 1 + .../record_list/fixtures/aggregate.rs | 4 + .../record_list/fixtures/fixed.rs | 2 + .../record_list/fixtures/mod.rs | 3 + .../record_list/fixtures/variants.rs | 3 + .../record_list/fixtures/wide_flags.rs | 1 + .../psrs-backend/src/mir/layout/accessors.rs | 5 + crates/psrs-backend/src/mir/layout/groups.rs | 254 +++ crates/psrs-backend/src/mir/layout/mod.rs | 37 +- .../src/mir/layout/storage_tests.rs | 216 ++ crates/psrs-backend/src/mir/layout/tests.rs | 48 +- .../psrs-backend/src/mir/lower/assignments.rs | 30 +- crates/psrs-backend/src/mir/lower/mod.rs | 56 +- .../src/mir/lower/storage_call.rs | 61 + crates/psrs-backend/src/mir/lower/tail.rs | 5 + crates/psrs-backend/src/mir/lower/wit_call.rs | 81 + .../psrs-backend/src/mir/lower/wit_tests.rs | 4 + crates/psrs-backend/src/mir/mod.rs | 52 +- .../src/mir/number_format_tests.rs | 4 + crates/psrs-backend/src/mir/opt/cfg.rs | 26 +- crates/psrs-backend/src/mir/opt/constants.rs | 7 +- crates/psrs-backend/src/mir/opt/imports.rs | 4 + crates/psrs-backend/src/mir/opt/inline.rs | 6 + .../src/mir/opt/tests/constants.rs | 1 + .../src/mir/opt/tests/control_flow.rs | 3 + crates/psrs-backend/src/mir/opt/tests/copy.rs | 1 + .../psrs-backend/src/mir/opt/tests/inline.rs | 4 + crates/psrs-backend/src/mir/opt/tests/mod.rs | 1 + crates/psrs-backend/src/mir/opt/values.rs | 13 + .../src/mir/reachable/assignments.rs | 3 +- crates/psrs-backend/src/mir/reachable/mod.rs | 29 +- .../src/mir/reachable/projection.rs | 14 + .../psrs-backend/src/mir/runtime/context.rs | 47 + .../src/mir/runtime/function_tests.rs | 123 ++ .../src/mir/runtime/invocation/emit.rs | 95 + .../src/mir/runtime/invocation/mod.rs | 186 ++ .../src/mir/runtime/invocation/tests.rs | 150 ++ .../src/mir/runtime/invocation/verify.rs | 135 ++ crates/psrs-backend/src/mir/runtime/mod.rs | 26 + crates/psrs-backend/src/mir/runtime/tests.rs | 203 ++ .../src/mir/state/branch_tests.rs | 307 +++ crates/psrs-backend/src/mir/state/control.rs | 424 ++++ .../psrs-backend/src/mir/state/host_tests.rs | 188 ++ .../psrs-backend/src/mir/state/inventory.rs | 102 + crates/psrs-backend/src/mir/state/mod.rs | 159 ++ .../src/mir/state/operand_tests.rs | 120 ++ .../psrs-backend/src/mir/state/projection.rs | 322 +++ crates/psrs-backend/src/mir/state/runtime.rs | 122 ++ .../src/mir/state/switch_tests.rs | 330 +++ crates/psrs-backend/src/mir/state/tests.rs | 401 ++++ .../src/mir/{tests.rs => tests/lowering.rs} | 256 +-- crates/psrs-backend/src/mir/tests/mod.rs | 14 + crates/psrs-backend/src/mir/tests/runtime.rs | 157 ++ crates/psrs-backend/src/mir/tests/verify.rs | 87 + .../src/mir/verify/array_map/mod.rs | 16 +- .../src/mir/verify/array_map/tests.rs | 2 + .../psrs-backend/src/mir/verify/capability.rs | 7 + .../psrs-backend/src/mir/verify/function.rs | 21 +- .../src/mir/verify/instruction/lists.rs | 18 +- crates/psrs-backend/src/mir/verify/mod.rs | 21 +- .../src/mir/verify/tests/arrays.rs | 2 + .../src/mir/verify/tests/dictionary.rs | 3 + .../src/mir/verify/tests/dominance.rs | 2 + .../src/mir/verify/tests/effects.rs | 1 + .../psrs-backend/src/mir/verify/tests/gaps.rs | 6 + .../psrs-backend/src/mir/verify/tests/mod.rs | 9 + .../src/mir/verify/tests/scalar.rs | 4 + .../src/mir/verify/tests/structure.rs | 45 + .../src/mir/verify/tests/subtype.rs | 1 + .../src/mir/verify/tests/switch.rs | 2 + .../psrs-backend/src/mir/verify/tests/tail.rs | 4 + .../src/mir/wit/aggregate/decode.rs | 1 + .../psrs-backend/src/mir/wit/aggregate/mod.rs | 1 + .../psrs-backend/src/mir/wit/call_lowerer.rs | 8 + .../src/mir/wit/function_lowerer.rs | 7 + crates/psrs-backend/src/mir/wit/lists/mod.rs | 2 +- crates/psrs-backend/src/mir/wit/mod.rs | 84 + .../src/mir/wit/parameters/primitive.rs | 1 + crates/psrs-backend/src/mir/wit/plan.rs | 156 ++ .../psrs-backend/src/mir/wit/tests/handles.rs | 1 + .../src/target_intrinsics/generated.rs | 1 + .../psrs-backend/src/target_intrinsics/mod.rs | 4 + .../src/target_intrinsics/tests.rs | 8 + crates/psrs-backend/src/target_runtime/mod.rs | 1 + .../src/wasm/lower/extent/tests/mod.rs | 2 + .../lower/post_return/tests/composition.rs | 2 +- .../src/wasm/lower/structure/cfg/mod.rs | 19 +- .../src/wasm/lower/structure/dispatcher.rs | 7 +- .../structure/irreducible_dispatch_tests.rs | 17 + .../wasm/lower/structure/lists/aggregate.rs | 2 +- .../src/wasm/lower/structure/lists/element.rs | 14 + .../src/wasm/lower/structure/lists/mod.rs | 18 + .../src/wasm/lower/structure/lists/record.rs | 4 +- .../src/wasm/lower/structure/region.rs | 3 + .../src/wasm/lower/structure/tests.rs | 2 + crates/psrs-backend/src/wasm/mod.rs | 2 + crates/psrs-backend/src/wasm/tests.rs | 2 + crates/psrs-backend/src/wasm/type_contract.rs | 25 + docs/design/backend/fp/cc-ir.md | 41 +- docs/design/backend/fp/data-representation.md | 54 +- docs/design/backend/fp/mir.md | 76 +- .../backend/fp/representation-and-evidence.md | 43 +- docs/design/backend/opt/mir.md | 20 + .../backend/wasm/primitive-ffi-and-stdlib.md | 7 + .../backend/library-owned-effects.md | 1808 +++++++++++++++++ 185 files changed, 11700 insertions(+), 822 deletions(-) create mode 100644 crates/psrs-backend/src/bindings/runtime/call/mod.rs create mode 100644 crates/psrs-backend/src/bindings/runtime/call/tests.rs create mode 100644 crates/psrs-backend/src/bindings/runtime/metadata.rs create mode 100644 crates/psrs-backend/src/bindings/runtime/mod.rs create mode 100644 crates/psrs-backend/src/bindings/runtime/target.rs delete mode 100644 crates/psrs-backend/src/boundary/newtypes.rs create mode 100644 crates/psrs-backend/src/boundary/newtypes/mod.rs create mode 100644 crates/psrs-backend/src/boundary/newtypes/tests.rs create mode 100644 crates/psrs-backend/src/boundary/tests.rs create mode 100644 crates/psrs-backend/src/cc/layout/functions/parts.rs create mode 100644 crates/psrs-backend/src/cc/layout/functions/projection/mod.rs create mode 100644 crates/psrs-backend/src/cc/layout/functions/projection/tests.rs create mode 100644 crates/psrs-backend/src/cc/layout/tests/arrays.rs create mode 100644 crates/psrs-backend/src/cc/lower/conversion/product_map.rs create mode 100644 crates/psrs-backend/src/cc/lower/conversion/state_slot.rs create mode 100644 crates/psrs-backend/src/cc/state/branches.rs create mode 100644 crates/psrs-backend/src/cc/state/eval.rs create mode 100644 crates/psrs-backend/src/cc/state/execution.rs create mode 100644 crates/psrs-backend/src/cc/state/mod.rs create mode 100644 crates/psrs-backend/src/cc/state/projection/conversion.rs create mode 100644 crates/psrs-backend/src/cc/state/projection/mod.rs create mode 100644 crates/psrs-backend/src/cc/state/projection/slots.rs create mode 100644 crates/psrs-backend/src/cc/state/projection/tests.rs create mode 100644 crates/psrs-backend/src/cc/state/tests.rs create mode 100644 crates/psrs-backend/src/cc/verify/ops/execution.rs create mode 100644 crates/psrs-backend/src/linking/runtime_tests.rs create mode 100644 crates/psrs-backend/src/mir/layout/groups.rs create mode 100644 crates/psrs-backend/src/mir/layout/storage_tests.rs create mode 100644 crates/psrs-backend/src/mir/lower/storage_call.rs create mode 100644 crates/psrs-backend/src/mir/lower/wit_call.rs create mode 100644 crates/psrs-backend/src/mir/runtime/context.rs create mode 100644 crates/psrs-backend/src/mir/runtime/function_tests.rs create mode 100644 crates/psrs-backend/src/mir/runtime/invocation/emit.rs create mode 100644 crates/psrs-backend/src/mir/runtime/invocation/mod.rs create mode 100644 crates/psrs-backend/src/mir/runtime/invocation/tests.rs create mode 100644 crates/psrs-backend/src/mir/runtime/invocation/verify.rs create mode 100644 crates/psrs-backend/src/mir/runtime/mod.rs create mode 100644 crates/psrs-backend/src/mir/runtime/tests.rs create mode 100644 crates/psrs-backend/src/mir/state/branch_tests.rs create mode 100644 crates/psrs-backend/src/mir/state/control.rs create mode 100644 crates/psrs-backend/src/mir/state/host_tests.rs create mode 100644 crates/psrs-backend/src/mir/state/inventory.rs create mode 100644 crates/psrs-backend/src/mir/state/mod.rs create mode 100644 crates/psrs-backend/src/mir/state/operand_tests.rs create mode 100644 crates/psrs-backend/src/mir/state/projection.rs create mode 100644 crates/psrs-backend/src/mir/state/runtime.rs create mode 100644 crates/psrs-backend/src/mir/state/switch_tests.rs create mode 100644 crates/psrs-backend/src/mir/state/tests.rs rename crates/psrs-backend/src/mir/{tests.rs => tests/lowering.rs} (50%) create mode 100644 crates/psrs-backend/src/mir/tests/mod.rs create mode 100644 crates/psrs-backend/src/mir/tests/runtime.rs create mode 100644 crates/psrs-backend/src/mir/tests/verify.rs create mode 100644 crates/psrs-backend/src/mir/wit/plan.rs create mode 100644 crates/psrs-backend/src/wasm/type_contract.rs create mode 100644 docs/implementation/backend/library-owned-effects.md diff --git a/crates/psrs-backend/Cargo.toml b/crates/psrs-backend/Cargo.toml index 9152e6e9..6ea7c20c 100644 --- a/crates/psrs-backend/Cargo.toml +++ b/crates/psrs-backend/Cargo.toml @@ -9,7 +9,7 @@ psrs-core.workspace = true psrs-hir.workspace = true psrs-span.workspace = true psrs-linker.workspace = true -psrs-runtime = { workspace = true, default-features = false, features = ["catalog"] } +psrs-runtime = { workspace = true, default-features = false, features = ["catalog", "gc-storage"] } wasm-encoder.workspace = true wasmparser.workspace = true wasmprinter.workspace = true diff --git a/crates/psrs-backend/src/abi/link/conformance.rs b/crates/psrs-backend/src/abi/link/conformance.rs index 1e96556a..7c862662 100644 --- a/crates/psrs-backend/src/abi/link/conformance.rs +++ b/crates/psrs-backend/src/abi/link/conformance.rs @@ -22,9 +22,20 @@ pub(crate) fn validate_import_signature( module: &CoreModule, type_id: CoreTypeId, ) -> Result<(), String> { + // A declaration that threads its own `State` returns a `Step`, not the + // canonical result directly. The canonical function neither takes nor + // returns the state, so it is compared against the step's payload and the + // ordinary arguments that precede the state parameter. let Some((parameters, result)) = function_parts(module, type_id) else { return Err(incompatible(import)); }; + if parameters + .iter() + .any(|ty| psrs_core::state::region(module, *ty).is_some()) + { + let step = psrs_core::state::signature(module, type_id).map_err(str::to_owned)?; + return validate_state_stepping(import, module, &step); + } let all_primitive = parameters.iter().all(|id| is_primitive(module, *id)) && is_primitive(module, result); if all_primitive && parameters.len() != import.params.len() { @@ -119,6 +130,36 @@ fn validate_zipped_parameters( Ok(()) } +/// Validates a state-stepping foreign declaration: the canonical signature +/// describes the call the host actually performs, so the `State` parameter and +/// the step's successor field belong to the caller's dependency chain and are +/// not part of it. +fn validate_state_stepping( + import: &WasiImport, + module: &CoreModule, + step: &psrs_core::state::StateSignature, +) -> Result<(), String> { + if step.parameters.len() != import.params.len() { + return Err(mismatch(import)); + } + for (id, ty) in step.parameters.iter().zip(&import.params) { + if !core_matches_kind(module, *id, ty) { + return Err(format!( + "WIT import `{}` has a source parameter with an incompatible type", + import.name + )); + } + } + if core_matches_result(module, step.payload, import) { + Ok(()) + } else { + Err(format!( + "WIT import `{}` has a source result type incompatible with its canonical result", + import.name + )) + } +} + fn core_matches_result(module: &CoreModule, result: CoreTypeId, import: &WasiImport) -> bool { match &import.canonical_result { // A function with no WIT result maps to source `Unit`. diff --git a/crates/psrs-backend/src/bindings/mod.rs b/crates/psrs-backend/src/bindings/mod.rs index 13af6351..a422c492 100644 --- a/crates/psrs-backend/src/bindings/mod.rs +++ b/crates/psrs-backend/src/bindings/mod.rs @@ -7,7 +7,19 @@ use psrs_hir::{ExternalKind, ModuleId, SymbolId}; use std::collections::{HashMap, HashSet}; mod primitives; +mod runtime; pub(crate) use primitives::lower as lower_primitives; +pub(crate) use runtime::call::{ + canonical_signature as runtime_cc_signature, checked as checked_runtime_call, +}; +pub use runtime::metadata::RuntimeBinding; +pub(crate) use runtime::metadata::{ + from_core as runtime_metadata_from_core, validate_core as validate_runtime_bindings, +}; +pub(crate) use runtime::target::{ + RawCallResult, error as runtime_projection_error, plan_import as plan_runtime_import, + verify_import as verify_runtime_import, +}; /// The complete input consumed by P9. Platform binding metadata is kept beside /// CC rather than embedded in the CC module itself. @@ -21,6 +33,7 @@ pub struct BackendInput { #[derive(Clone, Debug, PartialEq, Eq, Default)] pub struct ExternalBindings { pub imports: Vec, + pub runtime: Vec, } impl ExternalBindings { @@ -60,7 +73,10 @@ impl ExternalBindings { }) }) .collect(); - Self { imports } + Self { + imports, + runtime: runtime_metadata_from_core(module), + } } /// Resolves and validates every source WIT binding against the vendored WIT @@ -121,6 +137,8 @@ impl ExternalBindings { /// cannot accidentally make a target binding disappear by supplying a /// partial table. pub(crate) fn validate_core(&self, module: &CoreModule) -> Result<(), Vec> { + validate_runtime_bindings(&self.runtime, module)?; + runtime::validate(module)?; let unsupported = module .externals .iter() @@ -200,9 +218,9 @@ impl ExternalBindings { } } - /// Checks that P9 receives the same abstract signature that CC used when - /// type-checking calls. WIT names remain in this table, while CC sees only - /// the resulting target-neutral signature. + /// Checks that the binding inventory covers CC externals exactly once. + /// Source conformance is checked against Core before CC publication; + /// unsupported runtime call projection remains an explicit boundary. pub(crate) fn validate_cc(&self, module: &cc::Module) -> Result<(), Vec> { let mut cc_externals = HashMap::new(); let mut errors = Vec::new(); @@ -233,6 +251,28 @@ impl ExternalBindings { )); } } + for binding in &self.runtime { + if !seen.insert(binding.symbol) { + errors.push( + BackendError::invalid_ir( + "P9 external binding validation", + binding.span, + "runtime external binding is duplicated or conflicts with a WIT binding", + ) + .with_module(binding.source_module), + ); + } + if !cc_externals.contains_key(&binding.symbol) { + errors.push( + BackendError::invalid_ir( + "P9 external binding validation", + binding.span, + "runtime external binding is absent from CC", + ) + .with_module(binding.source_module), + ); + } + } for external in cc_externals.values() { if !seen.contains(&external.symbol) { errors.push(BackendError::new( @@ -242,11 +282,13 @@ impl ExternalBindings { )); } } - if errors.is_empty() { - Ok(()) - } else { - Err(errors) + if !errors.is_empty() { + return Err(errors); } + for binding in &self.runtime { + runtime::call::checked(binding, module)?; + } + Ok(()) } } diff --git a/crates/psrs-backend/src/bindings/primitives/mod.rs b/crates/psrs-backend/src/bindings/primitives/mod.rs index 961c9855..cb12beaf 100644 --- a/crates/psrs-backend/src/bindings/primitives/mod.rs +++ b/crates/psrs-backend/src/bindings/primitives/mod.rs @@ -80,6 +80,7 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), | IntrinsicCategory::ArrayWrite | IntrinsicCategory::StringToBytes | IntrinsicCategory::BytesToString + | IntrinsicCategory::State ) && intrinsic != Intrinsic::UnsafeCoerce && !matches!(intrinsic, Intrinsic::NumberNaN | Intrinsic::NumberInfinity) { diff --git a/crates/psrs-backend/src/bindings/runtime/call/mod.rs b/crates/psrs-backend/src/bindings/runtime/call/mod.rs new file mode 100644 index 00000000..ea1f5c68 --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/call/mod.rs @@ -0,0 +1,139 @@ +//! Checked logical CC operands for the runtime-owned raw storage contract. +use crate::BackendError; +use crate::bindings::RuntimeBinding; +use crate::cc::{self, RefShape, Reference, Representation, ValueShape}; +use psrs_runtime::{StorageCallProjection, StorageOperation, StorageValue}; + +/// Source element equality and nominal regions are checked against Core before +/// CC publication. This boundary checks the retained logical slots and storage +/// layout; it does not authorize State erasure or prove instruction ordering. +pub(crate) fn checked( + binding: &RuntimeBinding, + module: &cc::Module, +) -> Result> { + let error = |message: &str| { + vec![ + BackendError::invalid_ir("P9 runtime projection", binding.span, message) + .with_module(binding.source_module), + ] + }; + let external = module + .externals + .iter() + .find(|external| external.symbol == binding.symbol) + .ok_or_else(|| error("runtime CC binding has no external declaration"))?; + let signature = external + .signature + .as_ref() + .ok_or_else(|| error("runtime CC binding has no logical signature"))?; + checked_signature(binding, signature, &module.representations) +} + +fn checked_signature( + binding: &RuntimeBinding, + signature: &cc::Signature, + table: &cc::RepresentationTable, +) -> Result> { + let error = |message: &str| { + vec![ + BackendError::invalid_ir("P9 runtime projection", binding.span, message) + .with_module(binding.source_module), + ] + }; + if binding.module != psrs_runtime::STORAGE_MODULE { + return Err(error("runtime CC binding has an unknown provider")); + } + let operation = StorageOperation::from_export(&binding.function) + .ok_or_else(|| error("runtime CC binding has an unknown export"))?; + let raw = operation.projection().map_err(error)?; + let state = cc::state::StateCallProjection::checked(signature, table) + .map_err(error)? + .ok_or_else(|| error("runtime CC binding requires a checked State-to-Step signature"))?; + if state.state_parameter != raw.operands().len() { + return Err(error("runtime CC and raw operand counts disagree")); + } + for (shape, role) in signature.parameters[..state.state_parameter] + .iter() + .copied() + .zip(raw.operands().map(|(source, _)| source)) + .chain([(state.payload, raw.source().payload)]) + { + match role { + StorageValue::Int | StorageValue::Unit if shape != ValueShape::Integer => { + return Err(error( + "runtime CC index, length or Unit payload must be Integer", + )); + } + StorageValue::Array => { + let ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(id), + }) = shape + else { + return Err(error( + "runtime CC array requires a non-null concrete storage reference", + )); + }; + if !matches!(table.representation(id), Some(Representation::Array { element }) + if *element == cc::payload::erased_shape()) + { + return Err(error( + "runtime CC array requires canonical erased-element storage", + )); + } + } + StorageValue::Element | StorageValue::Any if shape == ValueShape::State => { + return Err(error( + "runtime CC payload cannot materialize a State dependency", + )); + } + _ => {} + } + } + Ok(raw) +} + +/// Select the runtime-owned storage roles only after source checking. Ordinary +/// CC conversions adapt checked use types to this protocol before MIR erasure. +pub(crate) fn canonical_signature( + binding: &RuntimeBinding, + signature: &cc::Signature, + table: &cc::RepresentationTable, +) -> Result> { + let projection = checked_signature(binding, signature, table)?; + let mut result = signature.clone(); + for (shape, (role, _)) in result.parameters.iter_mut().zip(projection.operands()) { + if role == StorageValue::Element { + *shape = cc::payload::erased_shape(); + } + } + if projection.source().payload == StorageValue::Element { + let state = cc::state::StateCallProjection::checked(signature, table) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P8 runtime protocol", + binding.span, + message, + )] + })? + .expect("checked runtime signature retains State"); + let slot = state + .payload_slot_signature(signature, table) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P8 runtime protocol", + binding.span, + message, + )] + })?; + result.result = table + .signature(slot) + .expect("checked payload slot exists") + .result; + } + checked_signature(binding, &result, table)?; + Ok(result) +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/bindings/runtime/call/tests.rs b/crates/psrs-backend/src/bindings/runtime/call/tests.rs new file mode 100644 index 00000000..bb2ed221 --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/call/tests.rs @@ -0,0 +1,199 @@ +use super::*; +use crate::cc::{External, ReprId, RepresentationTable, Signature}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; + +fn reference(id: u32) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(id)), + }) +} + +fn fixture(operation: StorageOperation) -> (RuntimeBinding, cc::Module) { + let span = TextRange::new(0, 1); + let binding = RuntimeBinding { + symbol: SymbolId::new(ModuleId(1), 2), + source_module: ModuleId(1), + module: psrs_runtime::STORAGE_MODULE.into(), + function: operation.abi().export.into(), + type_id: Some(psrs_core::TypeId(0)), + span, + }; + let shape = |role| match role { + StorageValue::Int | StorageValue::Unit => ValueShape::Integer, + StorageValue::Array => reference(0), + StorageValue::Element | StorageValue::Any => cc::payload::erased_shape(), + }; + let source = operation.source_contract(); + let mut parameters = source + .parameters + .iter() + .copied() + .map(shape) + .collect::>(); + parameters.push(ValueShape::State); + let module = cc::Module { + name: "RuntimeBoundary".into(), + externals: vec![External { + symbol: binding.symbol, + signature: Some(Signature { + parameters, + result: reference(1), + }), + projection: None, + }], + representations: RepresentationTable { + representations: vec![ + Representation::Array { + element: cc::payload::erased_shape(), + }, + Representation::Product { + fields: vec![shape(source.payload), ValueShape::State], + }, + ], + ..Default::default() + }, + functions: Vec::new(), + entry: None, + span, + }; + (binding, module) +} + +#[test] +fn monomorphic_elements_use_the_payload_protocol_without_changing_other_roles() { + for operation in StorageOperation::ALL { + let (binding, mut module) = fixture(operation); + let source = operation.source_contract(); + let signature = module.externals[0].signature.as_mut().unwrap(); + for (shape, role) in signature.parameters.iter_mut().zip(source.parameters) { + if *role == StorageValue::Element { + *shape = ValueShape::Integer; + } + } + if source.payload == StorageValue::Element { + module.representations.set( + ReprId(1), + Representation::Product { + fields: vec![ValueShape::Integer, ValueShape::State], + }, + ); + } + let original = signature.clone(); + module.representations.add_signature(original.clone()); + cc::state::register_payload_slots(&mut module.representations); + let canonical = canonical_signature(&binding, &original, &module.representations).unwrap(); + for ((before, after), role) in original + .parameters + .iter() + .zip(&canonical.parameters) + .zip(source.parameters) + { + assert_eq!( + *after, + if *role == StorageValue::Element { + cc::payload::erased_shape() + } else { + *before + } + ); + } + assert_eq!(canonical.parameters.last(), Some(&ValueShape::State)); + let step = cc::state::StateCallProjection::checked(&canonical, &module.representations) + .unwrap() + .unwrap(); + assert_eq!(step.state_field, 1); + if source.payload == StorageValue::Element { + assert_eq!(step.payload, cc::payload::erased_shape()); + } else { + assert_eq!(canonical.result, original.result); + } + } +} + +#[test] +fn validates_all_raw_contracts_with_permuted_step_fields() { + for operation in StorageOperation::ALL { + let (binding, module) = fixture(operation); + let plan = checked(&binding, &module).unwrap(); + assert_eq!(plan.abi().export, operation.abi().export); + assert_eq!(plan.result(), operation.projection().unwrap().result()); + } +} + +#[test] +fn rejects_noncanonical_array_storage_before_raw_call_projection() { + for operation in [ + StorageOperation::Fill, + StorageOperation::Read, + StorageOperation::Write, + ] { + let (binding, mut module) = fixture(operation); + for representation in [ + Representation::Array { + element: ValueShape::Integer, + }, + Representation::Product { + fields: vec![cc::payload::erased_shape()], + }, + ] { + module.representations.set(ReprId(0), representation); + let errors = checked(&binding, &module).err().unwrap(); + assert!( + errors[0] + .message + .contains("canonical erased-element storage") + ); + } + } +} + +#[test] +fn rejects_logical_signature_and_provider_substitution() { + for mutation in 0..8 { + let (mut binding, mut module) = fixture(StorageOperation::Read); + let signature = module.externals[0].signature.as_mut().unwrap(); + match mutation { + 0 => binding.module = "other-runtime".into(), + 1 => binding.function = "other-export".into(), + 2 => signature.parameters.pop().map(|_| ()).unwrap(), + 3 => signature.parameters.insert(0, ValueShape::State), + 4 => signature.parameters.insert(0, ValueShape::Integer), + 5 => signature.parameters[1] = ValueShape::Boolean, + 6 => signature.result = cc::payload::erased_shape(), + _ => { + signature.parameters[0] = ValueShape::Reference(Reference { + nullable: true, + heap: RefShape::Repr(ReprId(0)), + }) + } + } + assert!(checked(&binding, &module).is_err(), "mutation {mutation}"); + } +} + +#[test] +fn rejects_payload_and_successor_layout_drift() { + for (operation, fields) in [ + ( + StorageOperation::Fill, + vec![ValueShape::Integer, ValueShape::State], + ), + ( + StorageOperation::Write, + vec![cc::payload::erased_shape(), ValueShape::State], + ), + ( + StorageOperation::Read, + vec![ValueShape::State, ValueShape::State], + ), + (StorageOperation::Read, vec![cc::payload::erased_shape()]), + ] { + let (binding, mut module) = fixture(operation); + module + .representations + .set(ReprId(1), Representation::Product { fields }); + assert!(checked(&binding, &module).is_err()); + } +} diff --git a/crates/psrs-backend/src/bindings/runtime/metadata.rs b/crates/psrs-backend/src/bindings/runtime/metadata.rs new file mode 100644 index 00000000..42a7d5c0 --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/metadata.rs @@ -0,0 +1,226 @@ +//! Lossless source runtime binding identity beside target-neutral CC. +use crate::BackendError; +use psrs_core::{Module as CoreModule, TypeId as CoreTypeId}; +use psrs_hir::{ExternalKind, ModuleId, SymbolId}; +use std::collections::{HashMap, HashSet}; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct RuntimeBinding { + pub symbol: SymbolId, + pub source_module: ModuleId, + pub module: String, + pub function: String, + /// Identity of the checked source scheme in the owning Core arena. + pub type_id: Option, + pub span: psrs_span::TextRange, +} + +pub(crate) fn from_core(module: &CoreModule) -> Vec { + module + .externals + .iter() + .filter_map(|external| { + let ExternalKind::Runtime { + module: provider, + function, + } = &external.kind + else { + return None; + }; + let checked = module + .external_types + .iter() + .find(|checked| checked.symbol == external.symbol); + Some(RuntimeBinding { + symbol: external.symbol, + source_module: checked.map_or(module.id, |checked| checked.source_module), + module: provider.clone(), + function: function.clone(), + type_id: checked.map(|checked| checked.ty), + span: external + .signature + .as_ref() + .map_or(module.span, |signature| signature.span), + }) + }) + .collect() +} + +pub(crate) fn validate_core( + bindings: &[RuntimeBinding], + module: &CoreModule, +) -> Result<(), Vec> { + let expected = from_core(module) + .into_iter() + .map(|binding| (binding.symbol, binding)) + .collect::>(); + let mut seen = HashSet::new(); + let mut errors = Vec::new(); + for binding in bindings { + let message = if !seen.insert(binding.symbol) { + Some("runtime binding is duplicated") + } else { + match expected.get(&binding.symbol) { + None => Some("runtime binding is not a source runtime import"), + Some(expected) if binding != expected => { + Some("runtime binding disagrees with its checked source identity") + } + Some(_) => None, + } + }; + if let Some(message) = message { + errors.push( + BackendError::invalid_ir("P8 external binding validation", binding.span, message) + .with_module(binding.source_module), + ); + } + } + for (symbol, binding) in expected { + if !seen.contains(&symbol) { + errors.push( + BackendError::invalid_ir( + "P8 external binding validation", + binding.span, + "source runtime import has no external binding", + ) + .with_module(binding.source_module), + ); + } + } + if errors.is_empty() { + Ok(()) + } else { + Err(errors) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::{bindings::ExternalBindings, cc}; + + fn fixture() -> CoreModule { + let mut module = crate::bindings::tests::module(Vec::new()); + module.externals.push(psrs_hir::ExternalSymbol { + symbol: SymbolId::new(module.id, 7), + name: "read".into(), + kind: ExternalKind::Runtime { + module: psrs_runtime::STORAGE_MODULE.into(), + function: "array_read".into(), + }, + signature: None, + }); + module.types.push(psrs_core::Type::Constructor( + psrs_core::TypeConstructor::Int, + )); + module.external_types.push(psrs_core::ExternalType { + symbol: module.externals[0].symbol, + source_module: ModuleId(42), + ty: CoreTypeId(0), + }); + module + } + + #[test] + fn runtime_metadata_preserves_identity_and_rejects_substitution() { + let module = fixture(); + let bindings = from_core(&module); + validate_core(&bindings, &module).unwrap(); + assert_eq!(bindings[0].source_module, ModuleId(42)); + assert_eq!(bindings[0].type_id, Some(CoreTypeId(0))); + for change in 0..4 { + let mut wrong = bindings.clone(); + match change { + 0 => wrong[0].function = "array_write".into(), + 1 => wrong[0].module = "another-provider".into(), + 2 => wrong[0].type_id = Some(CoreTypeId(1)), + _ => wrong[0].source_module = ModuleId(999), + } + assert!(validate_core(&wrong, &module).is_err()); + } + assert!(validate_core(&[], &module).is_err()); + assert!(validate_core(&[bindings[0].clone(), bindings[0].clone()], &module).is_err()); + let mut wrong = bindings; + wrong[0].symbol = SymbolId::new(module.id, 8); + assert!(validate_core(&wrong, &module).is_err()); + } + + #[test] + fn direct_cc_runtime_bindings_cannot_bypass_the_projection_boundary() { + let source = fixture(); + let binding = from_core(&source).remove(0); + let mut module = cc::Module { + name: source.name.clone(), + externals: vec![cc::External { + symbol: binding.symbol, + signature: None, + projection: None, + }], + representations: cc::RepresentationTable::default(), + functions: Vec::new(), + entry: None, + span: source.span, + }; + let bindings = ExternalBindings { + imports: Vec::new(), + runtime: vec![binding.clone()], + }; + let errors = bindings.validate_cc(&module).unwrap_err(); + assert_eq!(errors[0].pass, "P9 runtime projection"); + assert_eq!( + errors[0].message, + "runtime CC binding has no logical signature" + ); + let array = module.representations.reserve(); + module.representations.set( + array, + cc::Representation::Array { + element: cc::payload::erased_shape(), + }, + ); + let step = module.representations.reserve(); + module.representations.set( + step, + cc::Representation::Product { + fields: vec![cc::ValueShape::State, cc::payload::erased_shape()], + }, + ); + let reference = |id| { + cc::ValueShape::Reference(cc::Reference { + nullable: false, + heap: cc::RefShape::Repr(id), + }) + }; + module.externals[0].signature = Some(cc::Signature { + parameters: vec![ + reference(array), + cc::ValueShape::Integer, + cc::ValueShape::State, + ], + result: reference(step), + }); + bindings.validate_cc(&module).unwrap(); + let (lowered, _) = crate::mir::lower_module_with_bindings( + module.clone(), + bindings.clone(), + crate::TargetCapabilities::default(), + ) + .unwrap(); + assert!( + lowered.imports.is_empty(), + "unused runtime declarations do not emit imports" + ); + let mut missing = bindings.clone(); + missing.runtime.clear(); + assert_eq!( + missing.validate_cc(&module).unwrap_err()[0].pass, + "P9 external binding validation" + ); + let mut duplicate = bindings; + duplicate.runtime.push(binding); + assert_eq!( + duplicate.validate_cc(&module).unwrap_err()[0].pass, + "P9 external binding validation" + ); + } +} diff --git a/crates/psrs-backend/src/bindings/runtime/mod.rs b/crates/psrs-backend/src/bindings/runtime/mod.rs new file mode 100644 index 00000000..67e4f486 --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/mod.rs @@ -0,0 +1,111 @@ +//! Checked source contracts for ordinary runtime provider bindings. +//! Export lookup and physical operations belong to psrs-runtime, not HIR. + +use crate::BackendError; +use psrs_core::{Module, Type, TypeConstructor, state::StateSignature}; +use psrs_hir::ExternalKind; +use psrs_runtime::{StorageOperation, StorageValue}; + +pub(super) mod call; +pub(super) mod metadata; +pub(super) mod target; + +/// Validate all declarations, including unused ones, before lowering/erasure. +/// The immutable checked Core arena owns every signature identity used here. +pub(crate) fn validate(module: &Module) -> Result<(), Vec> { + for external in &module.externals { + let ExternalKind::Runtime { + module: provider, + function, + } = &external.kind + else { + continue; + }; + let checked = module + .external_types + .iter() + .find(|ty| ty.symbol == external.symbol); + let source_module = checked.map_or(module.id, |ty| ty.source_module); + let span = external + .signature + .as_ref() + .map_or(module.span, |ty| ty.span); + let error = |message| { + vec![BackendError::new("P8 runtime linking", span, message).with_module(source_module)] + }; + if provider != psrs_runtime::STORAGE_MODULE { + return Err(error(format!("unknown runtime provider `{provider}`"))); + } + let operation = StorageOperation::from_export(function).ok_or_else(|| { + error(format!( + "runtime provider `{provider}` has no export `{function}`" + )) + })?; + let checked = checked + .ok_or_else(|| error("runtime binding has no checked source signature".into()))?; + let signature = psrs_core::state::signature(module, checked.ty) + .map_err(|message| error(format!("runtime binding `{function}`: {message}")))?; + validate_contract(module, operation, &signature) + .map_err(|message| error(format!("runtime binding `{function}`: {message}")))?; + } + Ok(()) +} + +fn validate_contract( + module: &Module, + operation: StorageOperation, + signature: &StateSignature, +) -> Result<(), &'static str> { + let projection = operation.projection()?; + let source = projection.source(); + if signature.parameters.len() != source.parameters.len() { + return Err("runtime source and physical argument counts disagree"); + } + let mut element = None; + for (ty, expected) in signature + .parameters + .iter() + .copied() + .zip(projection.operands().map(|(source, _)| source)) + .chain([(signature.payload, source.payload)]) + { + let checked = match expected { + StorageValue::Int => { + if module.types.get(ty.0 as usize) != Some(&Type::Constructor(TypeConstructor::Int)) + { + return Err("runtime index or length must have checked type Int"); + } + None + } + StorageValue::Unit => { + if module.types.get(ty.0 as usize) + != Some(&Type::Constructor(TypeConstructor::Unit)) + { + return Err("runtime void operation must have checked payload Unit"); + } + None + } + StorageValue::Array => { + let (head, arguments) = module + .applied_constructor(ty) + .ok_or("runtime storage operand must be Array")?; + if head != TypeConstructor::Array || arguments.len() != 1 { + return Err("runtime storage operand must be a saturated Array"); + } + Some(arguments[0]) + } + StorageValue::Element => Some(ty), + StorageValue::Any => None, + }; + if let Some(checked) = checked { + if let Some(element) = element { + if !module.types_equivalent(element, checked) { + return Err("runtime storage element and checked payload types disagree"); + } + } else { + element = Some(checked); + } + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/bindings/runtime/target.rs b/crates/psrs-backend/src/bindings/runtime/target.rs new file mode 100644 index 00000000..165ac40a --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/target.rs @@ -0,0 +1,167 @@ +//! Storage-provider ABI adaptation at the external-binding boundary. +//! MIR consumers receive physical signatures and a general return convention. +use crate::mir::{Import, RuntimeImport, layout::PlannedLayout}; +use crate::types::{CompositeType, FieldType, HeapType, RecGroup, RefType, StorageType, ValueType}; +use crate::{BackendError, RuntimeBinding, cc}; +use psrs_runtime::{StorageResultProjection, StorageType as RawType}; + +/// Result adaptation for a checked external call, independent of its provider. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum RawCallResult { + Value, + Unit, + Never, +} + +fn matches_raw_type(raw: RawType, value: ValueType, types: &[RecGroup]) -> bool { + match (raw, value) { + (RawType::I32, ValueType::I32) => true, + ( + RawType::Value, + ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + }), + ) => true, + ( + RawType::Array, + ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(id), + }), + ) => { + let definition = types.iter().flat_map(|group| &group.0).nth(id.0 as usize); + matches!( + definition.map(|definition| &definition.composite), + Some(CompositeType::Array(FieldType { + mutable: true, + storage: StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Eq + }), + })) + ) + } + _ => false, + } +} + +pub(crate) fn verify_import(import: &Import, types: &[RecGroup]) -> Result<(), String> { + let Some(provider) = &import.runtime else { + return Ok(()); + }; + if crate::target_intrinsics::generated::name(import.symbol).is_some() + || crate::target_runtime::for_symbol(import.symbol).is_some() + { + return Err("MIR source runtime import cannot replace a reserved target binding".into()); + } + if provider.module != psrs_runtime::STORAGE_MODULE { + return Err("MIR runtime import has an unknown provider".into()); + } + let operation = psrs_runtime::StorageOperation::from_export(&provider.function) + .ok_or("MIR runtime import has an unknown export")?; + let raw = operation.projection().map_err(str::to_owned)?; + if raw.abi().parameters.len() != import.parameters.len() + || !raw + .abi() + .parameters + .iter() + .copied() + .zip(import.parameters.iter().copied()) + .all(|(raw, value)| matches_raw_type(raw, value, types)) + || match (raw.abi().result, import.result) { + (Some(raw), Some(value)) => !matches_raw_type(raw, value, types), + (None, None) => false, + _ => true, + } + { + return Err("MIR runtime import signature disagrees with its provider contract".into()); + } + Ok(()) +} + +pub(crate) fn error(binding: &RuntimeBinding, message: &str) -> Vec { + vec![ + BackendError::invalid_ir("P9 runtime projection", binding.span, message) + .with_module(binding.source_module), + ] +} + +/// Plan raw types in the application's own layout arena. This does not box +/// operands, recover results, emit calls, or authorize dependency erasure. +pub(crate) fn plan_import( + binding: &RuntimeBinding, + logical: &cc::Module, + layout: &PlannedLayout, +) -> Result<(Import, RawCallResult), Vec> { + let raw = crate::bindings::checked_runtime_call(binding, logical)?; + let signature = logical + .externals + .iter() + .find(|external| external.symbol == binding.symbol) + .and_then(|external| external.signature.as_ref()) + .unwrap(); + let state = cc::state::StateCallProjection::checked(signature, &logical.representations) + .map_err(|message| error(binding, message))? + .unwrap(); + let physical = |raw: RawType, shape: cc::ValueShape| -> Result> { + match raw { + RawType::I32 => Ok(ValueType::I32), + RawType::Value => Ok(ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + })), + RawType::Array => { + let ty = layout.value_type(&shape).map_err(|_| { + error( + binding, + "runtime array has no planned type in the application arena", + ) + })?; + let ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(_), + }) = ty + else { + return Err(error( + binding, + "runtime array has no non-null concrete target type", + )); + }; + if !matches_raw_type(raw, ty, layout.types()) { + return Err(error( + binding, + "runtime array target must be mutable nullable-eqref storage", + )); + } + Ok(ty) + } + } + }; + let parameters = raw + .operands() + .zip(&signature.parameters) + .map(|((_, raw), shape)| physical(raw, *shape)) + .collect::, _>>()?; + let result = raw + .abi() + .result + .map(|raw| physical(raw, state.payload)) + .transpose()?; + Ok(( + Import { + runtime: Some(RuntimeImport { + module: binding.module.clone(), + function: binding.function.clone(), + }), + symbol: binding.symbol, + parameters, + result, + }, + match raw.result() { + StorageResultProjection::Value(_) => RawCallResult::Value, + StorageResultProjection::Unit => RawCallResult::Unit, + StorageResultProjection::Never => RawCallResult::Never, + }, + )) +} diff --git a/crates/psrs-backend/src/bindings/tests.rs b/crates/psrs-backend/src/bindings/tests.rs index 7e11a40d..9f7b6b77 100644 --- a/crates/psrs-backend/src/bindings/tests.rs +++ b/crates/psrs-backend/src/bindings/tests.rs @@ -34,7 +34,7 @@ fn binding(symbol: SymbolId) -> ExternalBinding { } } -fn module(externals: Vec) -> CoreModule { +pub(super) fn module(externals: Vec) -> CoreModule { CoreModule { type_names: Vec::new(), id: ModuleId(1), @@ -60,6 +60,7 @@ fn errors_contain(errors: &[BackendError], fragment: &str) -> bool { fn accepts_a_complete_wit_projection() { let external = symbol(1); let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![binding(external)], }; assert!( @@ -83,6 +84,7 @@ fn rejects_a_missing_wit_binding() { fn rejects_a_duplicate_binding() { let external = symbol(1); let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![binding(external), binding(external)], }; let errors = bindings @@ -95,6 +97,7 @@ fn rejects_a_duplicate_binding() { fn rejects_a_binding_for_a_non_source_import() { let external = symbol(1); let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![binding(external)], }; let errors = bindings diff --git a/crates/psrs-backend/src/boundary/mod.rs b/crates/psrs-backend/src/boundary/mod.rs index c76296c3..e4953b10 100644 --- a/crates/psrs-backend/src/boundary/mod.rs +++ b/crates/psrs-backend/src/boundary/mod.rs @@ -12,6 +12,8 @@ use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; mod newtypes; +#[cfg(test)] +mod tests; /// A representation owner's policy for the runtime form of a source /// constructor. It records the constructor's fixed calling-convention @@ -24,15 +26,9 @@ pub(crate) enum RepresentationPolicy { /// The owner registered explicit fixed parameters (the Effect runtime /// token). The payload remains the application's result. Fixed(Vec), - /// Domains of a transparent newtype's checked callable field. A domain - /// is either independent of constructor arguments or one fixed argument. - Newtype(Vec), -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(crate) enum ProtocolParameter { - Fixed(TypeId), - Argument(usize), + /// Complete source and canonical callable fields of a transparent newtype. + /// Storage uses the declared field, without specializing its free variables. + Newtype(newtypes::NewtypeCallable), } /// The registry of representation owners, keyed by source constructor. @@ -49,16 +45,16 @@ pub(crate) struct RepresentationRegistry { impl RepresentationRegistry { /// The checked newtype field owns its erased callable representation. - /// Register only domains expressible without inventing source type nodes. + /// Preserve full domains/results without inventing or specializing nodes. pub(crate) fn register_newtypes(&mut self, module: &CoreModule) { for id in &module.newtype_ids { if self.policies.contains_key(&TypeConstructor::User(*id)) { continue; } - if let Some(parameters) = newtypes::parameters(module, *id) { + if let Some(template) = newtypes::callable(module, *id) { self.register( TypeConstructor::User(*id), - RepresentationPolicy::Newtype(parameters), + RepresentationPolicy::Newtype(template), ); } } @@ -89,15 +85,18 @@ impl RepresentationRegistry { Some(match self.policies.get(&constructor)? { RepresentationPolicy::InstantiationArguments => arguments.to_vec(), RepresentationPolicy::Fixed(parameters) => parameters.clone(), - RepresentationPolicy::Newtype(parameters) => parameters - .iter() - .map(|parameter| match parameter { - ProtocolParameter::Fixed(ty) => Some(*ty), - ProtocolParameter::Argument(index) => arguments.get(*index).copied(), - }) - .collect::>>()?, + RepresentationPolicy::Newtype(template) => template.parameters.clone(), }) } + + /// A transparent newtype's full declared storage result. Ordinary function + /// and legacy fixed-token policies obtain their result from the use type. + fn protocol_result(&self, constructor: TypeConstructor) -> Option { + match self.policies.get(&constructor)? { + RepresentationPolicy::Newtype(template) => Some(template.result), + _ => None, + } + } } /// Checked evidence and producer policies at the Core-to-CC boundary. @@ -189,6 +188,10 @@ impl<'a> BoundaryEvidence<'a> { self.registry.protocol_parameters(constructor, arguments) } + pub(crate) fn protocol_result(&self, constructor: TypeConstructor) -> Option { + self.registry.protocol_result(constructor) + } + /// Bare polymorphic function slots use one erased argument at a time. /// Multi-argument functions are curried on entry and flattened on recovery. pub(crate) fn function_slot_signature(&self) -> Option { @@ -224,7 +227,8 @@ fn scheme_quantifiers(module: &CoreModule, mut ty: TypeId) -> Vec, -) -> HashMap { + span: psrs_span::TextRange, +) -> Result, Vec> { let mut protocols = HashMap::new(); let mut interned = HashMap::::new(); let mut ids = function_types.values().copied().collect::>(); @@ -234,18 +238,45 @@ pub(crate) fn payload_erased_protocols( if protocols.contains_key(&concrete) { continue; } - let Some(parameters) = representations + let signature = representations .signature(concrete) - .map(|signature| signature.parameters.clone()) - else { - continue; + .cloned() + .ok_or_else(|| { + vec![crate::BackendError::invalid_ir( + "P8 callable protocol", + span, + "callable owner has no registered signature", + )] + })?; + let error = |message: &'static str| { + vec![crate::BackendError::invalid_ir( + "P8 callable protocol", + span, + message, + )] }; - let protocol = Signature { - parameters, - result: ValueShape::Reference(Reference { + let result = if let Some(state) = + crate::cc::state::StateCallProjection::checked(&signature, representations) + .map_err(error)? + { + let slot = state + .payload_slot_signature(&signature, representations) + .map_err(error)?; + representations + .signature(slot) + .ok_or_else(|| { + error("State callable protocol has no registered payload signature") + })? + .result + } else { + ValueShape::Reference(Reference { nullable: false, heap: RefShape::Erased, - }), + }) + }; + let protocol = Signature { + parameters: signature.parameters, + result, }; let protocol_id = if let Some(existing) = interned.get(&protocol) { *existing @@ -256,7 +287,7 @@ pub(crate) fn payload_erased_protocols( }; protocols.insert(concrete, protocol_id); } - protocols + Ok(protocols) } /// The representation owner for a function hidden by a bare type variable. diff --git a/crates/psrs-backend/src/boundary/newtypes.rs b/crates/psrs-backend/src/boundary/newtypes.rs deleted file mode 100644 index 70974a67..00000000 --- a/crates/psrs-backend/src/boundary/newtypes.rs +++ /dev/null @@ -1,120 +0,0 @@ -//! Callable protocols derived from checked transparent newtype fields. -use super::ProtocolParameter; -use psrs_core::{Module, Type, TypeConstructor, TypeId}; -use psrs_hir::{TypeId as HirTypeId, TypeVariableId}; -use std::collections::{HashMap, HashSet}; - -pub(super) fn parameters(module: &Module, id: HirTypeId) -> Option> { - let constructor = module - .constructors - .iter() - .find(|constructor| constructor.type_id == id)?; - if constructor.field_types.len() != 1 { - return None; - } - let bindings = constructor - .parameters - .iter() - .enumerate() - .map(|(index, variable)| (*variable, ProtocolParameter::Argument(index))) - .collect(); - let mut visiting = HashSet::from([id]); - callable(module, constructor.field_types[0], &bindings, &mut visiting) -} - -fn callable( - module: &Module, - mut ty: TypeId, - bindings: &HashMap, - visiting: &mut HashSet, -) -> Option> { - while let Some((_, body)) = psrs_core::forall_parts(&module.types, ty) { - ty = body; - } - if let Some((parameters, _)) = psrs_core::closure_parts(&module.types, ty) { - return parameters - .iter() - .map(|ty| domain(module, *ty, bindings)) - .collect(); - } - let mut parameters = Vec::new(); - let mut cursor = ty; - while let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, cursor) { - parameters.push(domain(module, parameter, bindings)?); - cursor = result; - if psrs_core::forall_parts(&module.types, cursor).is_some() { - break; - } - } - if !parameters.is_empty() { - return Some(parameters); - } - let (TypeConstructor::User(id), arguments) = module.applied_constructor(ty)? else { - return None; - }; - if !module.newtype_ids.contains(&id) || !visiting.insert(id) { - return None; - } - let constructor = module - .constructors - .iter() - .find(|constructor| constructor.type_id == id)?; - if constructor.field_types.len() != 1 || constructor.parameters.len() != arguments.len() { - return None; - } - let nested = constructor - .parameters - .iter() - .zip(arguments) - .map(|(variable, argument)| Some((*variable, domain(module, argument, bindings)?))) - .collect::>>()?; - let result = callable(module, constructor.field_types[0], &nested, visiting); - visiting.remove(&id); - result -} - -fn domain( - module: &Module, - ty: TypeId, - bindings: &HashMap, -) -> Option { - if let Some(Type::Variable(variable)) = module.types.get(ty.0 as usize) { - return bindings.get(variable).cloned(); - } - closed(module, ty, &HashSet::new(), &mut HashSet::new()).then_some(ProtocolParameter::Fixed(ty)) -} - -fn closed( - module: &Module, - ty: TypeId, - bound: &HashSet, - active: &mut HashSet, -) -> bool { - if !active.insert(ty) { - return false; - } - let result = match module.types.get(ty.0 as usize) { - Some(Type::Variable(variable)) => bound.contains(variable), - Some(Type::Application(function, argument)) => { - closed(module, *function, bound, active) && closed(module, *argument, bound, active) - } - Some(Type::RowExtend { ty, tail, .. }) => { - closed(module, *ty, bound, active) && closed(module, *tail, bound, active) - } - Some(Type::ForAll { variables, body }) => { - let mut bound = bound.clone(); - bound.extend(variables); - closed(module, *body, &bound, active) - } - Some(Type::Closure { parameters, result }) => { - parameters - .iter() - .all(|ty| closed(module, *ty, bound, active)) - && closed(module, *result, bound, active) - } - Some(_) => true, - None => false, - }; - active.remove(&ty); - result -} diff --git a/crates/psrs-backend/src/boundary/newtypes/mod.rs b/crates/psrs-backend/src/boundary/newtypes/mod.rs new file mode 100644 index 00000000..497facf5 --- /dev/null +++ b/crates/psrs-backend/src/boundary/newtypes/mod.rs @@ -0,0 +1,63 @@ +//! Complete callable storage templates of checked transparent newtypes. +//! +//! A newtype's canonical field keeps its declared erased representation. +//! Constructor arguments do not specialize that physical storage convention. +use psrs_core::{Module, TypeConstructor, TypeId}; +use psrs_hir::{TypeId as HirTypeId, TypeVariableId}; +use std::collections::HashSet; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(crate) struct NewtypeCallable { + /// The outer declaration's complete field, including nested applications. + pub source_field: TypeId, + pub source_variables: Vec, + /// The declaration that owns the final canonical callable field. + pub storage_owner: HirTypeId, + pub storage_field: TypeId, + pub parameters: Vec, + /// Preserve structural results and returned closures as actual type ids. + pub result: TypeId, +} + +pub(super) fn callable(module: &Module, id: HirTypeId) -> Option { + let outer = constructor(module, id)?; + let source_field = outer.field_types[0]; + let mut storage_owner = id; + let mut storage_field = source_field; + let mut visited = HashSet::from([id]); + loop { + if crate::cc::is_callable_type(module, storage_field) { + let (parameters, result) = + crate::cc::checked_function_arrow_parameters(module, storage_field).ok()?; + return Some(NewtypeCallable { + source_field, + source_variables: outer.parameters.clone(), + storage_owner, + storage_field, + parameters, + result, + }); + } + let (_, body) = psrs_core::scheme_parts(&module.types, storage_field)?; + let (TypeConstructor::User(inner), _) = module.applied_constructor(body)? else { + return None; + }; + if !module.newtype_ids.contains(&inner) || !visited.insert(inner) { + return None; + } + storage_owner = inner; + storage_field = constructor(module, inner)?.field_types[0]; + } +} + +fn constructor(module: &Module, id: HirTypeId) -> Option<&psrs_core::ConstructorInfo> { + let mut constructors = module.constructors.iter().filter(|ctor| ctor.type_id == id); + let constructor = constructors.next()?; + (constructors.next().is_none() + && constructor.field_count == 1 + && constructor.field_types.len() == 1) + .then_some(constructor) +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/boundary/newtypes/tests.rs b/crates/psrs-backend/src/boundary/newtypes/tests.rs new file mode 100644 index 00000000..e61db9ee --- /dev/null +++ b/crates/psrs-backend/src/boundary/newtypes/tests.rs @@ -0,0 +1,178 @@ +use super::*; +use psrs_core::{ConstructorInfo, Type}; +use psrs_hir::{ModuleId, SymbolId}; + +const OWNER: HirTypeId = HirTypeId::new(ModuleId(0), 0); + +fn module(types: Vec, field: TypeId, parameters: Vec) -> Module { + Module { + id: ModuleId(0), + name: "CallableTemplate".into(), + externals: Vec::new(), + external_types: Vec::new(), + types, + newtype_ids: vec![OWNER], + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: vec![ConstructorInfo { + symbol: SymbolId::new(ModuleId(0), 0), + name: "Action".into(), + type_id: OWNER, + tag: 0, + field_count: 1, + field_types: vec![field], + parameters, + }], + declarations: Vec::new(), + type_names: Vec::new(), + entry: None, + span: psrs_span::TextRange::new(0, 1), + } +} + +#[test] +fn state_field_preserves_region_domain_and_complete_step_result() { + let r = TypeVariableId(0); + let a = TypeVariableId(1); + let module = module( + vec![ + Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_STATE)), + Type::Variable(r), + Type::Application(TypeId(0), TypeId(1)), + Type::Variable(a), + Type::RowEmpty, + Type::RowExtend { + label: "value".into(), + ty: TypeId(3), + tail: TypeId(4), + }, + Type::RowExtend { + label: "state".into(), + ty: TypeId(2), + tail: TypeId(5), + }, + Type::Constructor(TypeConstructor::Record), + Type::Application(TypeId(7), TypeId(6)), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(9), TypeId(2)), + Type::Application(TypeId(10), TypeId(8)), + ], + TypeId(11), + vec![r, a], + ); + let original = module.types.clone(); + let template = callable(&module, OWNER).unwrap(); + assert_eq!(template.source_field, TypeId(11)); + assert_eq!(template.source_variables, [r, a]); + assert_eq!(template.parameters, [TypeId(2)]); + assert_eq!(template.result, TypeId(8)); + let state = psrs_core::state::signature(&module, template.storage_field).unwrap(); + assert_eq!(state.region, TypeId(1)); + assert_eq!(state.payload, TypeId(3)); + assert_eq!( + module.types, original, + "protocol discovery cannot rewrite source types" + ); +} + +#[test] +fn nested_newtype_keeps_application_evidence_and_canonical_storage_owner() { + let inner = HirTypeId::new(ModuleId(0), 1); + let r = TypeVariableId(0); + let a = TypeVariableId(1); + let outer_a = TypeVariableId(2); + let mut module = module( + vec![ + Type::Variable(r), + Type::Variable(a), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(2), TypeId(0)), + Type::Application(TypeId(3), TypeId(1)), + Type::Constructor(TypeConstructor::User(inner)), + Type::Constructor(TypeConstructor::Int), + Type::Application(TypeId(5), TypeId(6)), + Type::Variable(outer_a), + Type::Application(TypeId(7), TypeId(8)), + ], + TypeId(9), + vec![outer_a], + ); + module.newtype_ids.push(inner); + module.constructors.push(ConstructorInfo { + symbol: SymbolId::new(ModuleId(0), 1), + name: "Inner".into(), + type_id: inner, + tag: 0, + field_count: 1, + field_types: vec![TypeId(4)], + parameters: vec![r, a], + }); + let template = callable(&module, OWNER).unwrap(); + assert_eq!(template.source_field, TypeId(9)); + assert_eq!(template.source_variables, [outer_a]); + assert_eq!(template.storage_owner, inner); + assert_eq!(template.storage_field, TypeId(4)); + assert_eq!( + template.parameters, + [TypeId(0)], + "canonical storage is not specialized to Int" + ); + assert_eq!(template.result, TypeId(1)); +} + +#[test] +fn nullary_closure_returns_a_function_without_absorbing_its_parameters() { + let module = module( + vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(1), TypeId(0)), + Type::Application(TypeId(2), TypeId(0)), + Type::Closure { + parameters: vec![], + result: TypeId(3), + }, + ], + TypeId(4), + vec![], + ); + let template = callable(&module, OWNER).unwrap(); + assert!(template.parameters.is_empty()); + assert_eq!(template.result, TypeId(3)); +} + +#[test] +fn cyclic_and_dangling_call_boundaries_do_not_become_valid_empty_protocols() { + for (types, field) in [ + ( + vec![ + Type::Constructor(TypeConstructor::Function), + Type::Constructor(TypeConstructor::Int), + Type::Application(TypeId(0), TypeId(1)), + Type::Application(TypeId(2), TypeId(3)), + ], + TypeId(3), + ), + ( + vec![ + Type::Constructor(TypeConstructor::Int), + Type::Closure { + parameters: vec![TypeId(99)], + result: TypeId(0), + }, + ], + TypeId(1), + ), + ( + vec![Type::ForAll { + variables: vec![TypeVariableId(0)], + body: TypeId(0), + }], + TypeId(0), + ), + ] { + let module = module(types, field, vec![]); + assert!(crate::cc::checked_function_arrow_parameters(&module, field).is_err()); + assert!(callable(&module, OWNER).is_none()); + } +} diff --git a/crates/psrs-backend/src/boundary/tests.rs b/crates/psrs-backend/src/boundary/tests.rs new file mode 100644 index 00000000..c4fbb7b2 --- /dev/null +++ b/crates/psrs-backend/src/boundary/tests.rs @@ -0,0 +1,74 @@ +use super::*; +use crate::cc::{Representation, RepresentationTable}; +use psrs_span::TextRange; + +#[test] +fn state_constructor_protocol_preserves_parameters_and_successor() { + let mut table = RepresentationTable::default(); + let step = table.reserve(); + table.set( + step, + Representation::Product { + fields: vec![ValueShape::State, ValueShape::Integer], + }, + ); + table.set_product_labels(step, vec!["state".into(), "value".into()]); + let parameters = vec![ValueShape::Integer, ValueShape::State]; + let source = table.add_signature(Signature { + parameters: parameters.clone(), + result: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(step), + }), + }); + crate::cc::state::register_payload_slots(&mut table); + let protocols = payload_erased_protocols( + &mut table, + &HashMap::from([(TypeId(0), source)]), + TextRange::default(), + ) + .unwrap(); + let signature = table.signature(protocols[&source]).unwrap(); + assert_eq!(signature.parameters, parameters); + let ValueShape::Reference(Reference { + heap: RefShape::Repr(result), + .. + }) = signature.result + else { + panic!("Step protocol must retain a product"); + }; + assert_eq!(table.product_labels(result).unwrap(), ["state", "value"]); + assert_eq!( + table.representation(result), + Some(&Representation::Product { + fields: vec![ValueShape::State, crate::cc::payload::erased_shape()], + }) + ); +} + +#[test] +fn callable_protocol_rejects_missing_owner_signature() { + let errors = payload_erased_protocols( + &mut RepresentationTable::default(), + &HashMap::from([(TypeId(0), SignatureId(99))]), + TextRange::default(), + ) + .unwrap_err(); + assert!(errors[0].message.contains("no registered signature")); +} + +#[test] +fn callable_protocol_rejects_state_without_a_step_result() { + let mut table = RepresentationTable::default(); + let source = table.add_signature(Signature { + parameters: vec![ValueShape::State], + result: ValueShape::Integer, + }); + let errors = payload_erased_protocols( + &mut table, + &HashMap::from([(TypeId(0), source)]), + TextRange::default(), + ) + .unwrap_err(); + assert!(errors[0].message.contains("Step product")); +} diff --git a/crates/psrs-backend/src/cc/case/decision/realize/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/mod.rs index 4bfb265c..bd68aae7 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/mod.rs @@ -201,7 +201,7 @@ impl FunctionLowerer<'_> { )); }; let stored_shape = *stored_shape; - let declared_type = array_element_type(self.module, *source_type) + let _declared_type = array_element_type(self.module, *source_type) .ok_or_else(|| case_error(*span, "array pattern type is not an array"))?; let index_value = self.fresh(ValueShape::Integer); assignments.push(Assignment { @@ -224,13 +224,7 @@ impl FunctionLowerer<'_> { span: *span, }); let target_shape = self.value_shape(*target_type, *span)?; - let conversion = self.typed_conversion( - declared_type, - *target_type, - stored_shape, - target_shape, - *span, - )?; + let conversion = self.recover_payload(target_shape, *span)?; let value = self.emit_conversion( stored_value, stored_shape, @@ -307,6 +301,16 @@ impl FunctionLowerer<'_> { tag: *tag, field: *field, template_type: *declared_type, + parameters: self + .module + .constructors + .iter() + .find(|constructor| constructor.symbol == *symbol) + .ok_or_else(|| { + case_error(*span, "variant field has no source constructor owner") + })? + .parameters + .clone(), target_type: *target_type, target_shape, stored_shape, diff --git a/crates/psrs-backend/src/cc/convert.rs b/crates/psrs-backend/src/cc/convert.rs index c9f0b1d8..f90b7deb 100644 --- a/crates/psrs-backend/src/cc/convert.rs +++ b/crates/psrs-backend/src/cc/convert.rs @@ -64,3 +64,28 @@ pub struct AggregateConvert { pub destination: ValueShape, pub plan: ValueConversion, } + +impl ValueConversion { + /// The declared output of a conversion plan. This does not validate its + /// input or representation metadata; CC verification discharges those checks. + pub(crate) fn output_shape(&self, source: ValueShape) -> ValueShape { + let reference = |id| { + ValueShape::Reference(super::Reference { + nullable: false, + heap: super::RefShape::Repr(id), + }) + }; + match self { + Self::Identity => source, + Self::BoxScalar { representation, .. } => reference(*representation), + Self::UnboxScalar { destination, .. } + | Self::RecoverReference { destination, .. } + | Self::FunctionAdapter { destination, .. } => *destination, + Self::EraseReference => super::payload::erased_shape(), + Self::ArrayMap { target, .. } | Self::ProductMap { target, .. } => reference(*target), + Self::Sequence(steps) => steps + .iter() + .fold(source, |shape, step| step.output_shape(shape)), + } + } +} diff --git a/crates/psrs-backend/src/cc/layout/aggregate.rs b/crates/psrs-backend/src/cc/layout/aggregate.rs index 936bf260..8d4fcdbe 100644 --- a/crates/psrs-backend/src/cc/layout/aggregate.rs +++ b/crates/psrs-backend/src/cc/layout/aggregate.rs @@ -188,35 +188,34 @@ impl Builder<'_> { if !self.active.insert(id) { return Ok(handle); } - let (key, representation, labels) = - if let Some(element) = array_element_type(self.module, id) { - let shape = self.value_shape(element, span)?; - ( - AggregateKey::Array(shape), - Representation::Array { element: shape }, - None, - ) - } else { - let Some(fields) = self.module.record_fields(id) else { - self.active.remove(&id); - return Err(layout_error( - span, - "aggregate type has no array or record layout", - )); - }; - let mut fields = fields - .iter() - .map(|(label, ty)| Ok((label.clone(), self.value_shape(*ty, span)?))) - .collect::, Vec>>()?; - fields.sort_by(|left, right| left.0.cmp(&right.0)); - let labels = fields.iter().map(|(label, _)| label.clone()).collect(); - let shapes = fields.iter().map(|(_, shape)| *shape).collect(); - ( - AggregateKey::Record(fields), - Representation::Product { fields: shapes }, - Some(labels), - ) + let (key, representation, labels) = if array_element_type(self.module, id).is_some() { + let shape = crate::cc::payload::erased_shape(); + ( + AggregateKey::Array(shape), + Representation::Array { element: shape }, + None, + ) + } else { + let Some(fields) = self.module.record_fields(id) else { + self.active.remove(&id); + return Err(layout_error( + span, + "aggregate type has no array or record layout", + )); }; + let mut fields = fields + .iter() + .map(|(label, ty)| Ok((label.clone(), self.value_shape(*ty, span)?))) + .collect::, Vec>>()?; + fields.sort_by(|left, right| left.0.cmp(&right.0)); + let labels = fields.iter().map(|(label, _)| label.clone()).collect(); + let shapes = fields.iter().map(|(_, shape)| *shape).collect(); + ( + AggregateKey::Record(fields), + Representation::Product { fields: shapes }, + Some(labels), + ) + }; let canonical = if let Some(canonical) = self.canonical.get(&key).copied() { canonical } else { diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index 1b82e8aa..68fc76cf 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -1,12 +1,15 @@ -use super::{Signature, function_arrow_parameters, is_callable_type, scalar_type}; +use super::{Signature, is_callable_type, scalar_type}; use crate::BackendError; use crate::cc::{RefShape, ReprId, Representation, RepresentationTable, SignatureId, ValueShape}; use psrs_core::{Module as CoreModule, TypeId}; use psrs_hir::TypeId as HirTypeId; use std::collections::{HashMap, HashSet}; +pub(crate) mod parts; +mod projection; mod reachable; +use projection::CallProjection; use reachable::referenced_types; pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { @@ -109,35 +112,35 @@ pub(crate) fn function_signature( record_types: &HashMap, function_types: &HashMap, ) -> Result> { - let (parameter_ids, result_id) = function_arrow_parameters(module, id); - let parameters = parameter_ids - .into_iter() - .map(|parameter| { - scalar_type( - module, - parameter, - module.span, - enum_types, - aggregate_types, - newtype_ids, - array_types, - record_types, - function_types, - ) - }) - .collect::, _>>()?; - let result = scalar_type( - module, - result_id, - module.span, - enum_types, - aggregate_types, - newtype_ids, - array_types, - record_types, - function_types, - )?; - Ok(Signature { parameters, result }) + let projection = CallProjection::checked(module, id)?; + let mut signature = projection.physical_signature(|source, ty| { + scalar_type( + source, + ty, + module.span, + enum_types, + aggregate_types, + newtype_ids, + array_types, + record_types, + function_types, + ) + })?; + if projection.state_contract().is_some() { + signature.parameters.push(ValueShape::State); + signature.result = scalar_type( + module, + projection.logical_result(), + module.span, + enum_types, + aggregate_types, + newtype_ids, + array_types, + record_types, + function_types, + )?; + } + Ok(signature) } /// Re-interns the signature table after aggregate normalization has rewritten diff --git a/crates/psrs-backend/src/cc/layout/functions/parts.rs b/crates/psrs-backend/src/cc/layout/functions/parts.rs new file mode 100644 index 00000000..7db2c57a --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/functions/parts.rs @@ -0,0 +1,25 @@ +//! Checked source call boundaries shared by layout and newtype protocols. +use super::super::layout_error; +use crate::BackendError; +use psrs_core::{Module as CoreModule, TypeId}; + +/// Derives the calling convention of a value. +/// +/// A closure contributes exactly the parameter list it was born with. Its +/// result stays a value, even when that value is a function or another +/// closure. An ordinary function flattens every arrow: the parameters are the +/// arrow domains and the result is the codomain. A quantifier in a codomain +/// stops the walk so that polymorphic result stays a separate closure. +pub(crate) fn function_arrow_parameters(module: &CoreModule, id: TypeId) -> (Vec, TypeId) { + checked_function_arrow_parameters(module, id) + .expect("P8 layout validated live callable signatures before expression lowering") +} + +/// Checks the complete call boundary before registering a physical signature. +/// A non-callable value has zero parameters; dangling/cyclic spines are errors. +pub(crate) fn checked_function_arrow_parameters( + module: &CoreModule, + id: TypeId, +) -> Result<(Vec, TypeId), Vec> { + psrs_core::call_parts(&module.types, id).map_err(|message| layout_error(module.span, message)) +} diff --git a/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs b/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs new file mode 100644 index 00000000..97640579 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs @@ -0,0 +1,76 @@ +//! Checked logical-to-physical calling signatures. This plans storage only; +//! expression lowering must retain the state dependency of every invocation. +use super::super::layout_error; +use crate::BackendError; +use crate::cc::{Signature, ValueShape}; +use psrs_core::{Module, TypeId, state::StateSignature}; + +pub(super) struct CallProjection<'a> { + source: &'a Module, + parameters: Vec, + result: TypeId, + logical_result: TypeId, + state: Option, +} + +impl<'a> CallProjection<'a> { + pub(super) fn checked(source: &'a Module, ty: TypeId) -> Result> { + let (parameters, result) = psrs_core::call_parts(&source.types, ty) + .map_err(|message| layout_error(source.span, message))?; + let has_state = parameters + .iter() + .any(|parameter| psrs_core::state::region(source, *parameter).is_some()); + if has_state { + let state = psrs_core::state::signature(source, ty) + .map_err(|message| layout_error(source.span, message))?; + return Ok(Self { + source, + parameters: state.parameters.clone(), + result: state.payload, + logical_result: result, + state: Some(state), + }); + } + Ok(Self { + source, + parameters, + result, + logical_result: result, + state: None, + }) + } + + pub(super) fn state_contract(&self) -> Option<&StateSignature> { + self.state.as_ref() + } + + pub(super) fn logical_result(&self) -> TypeId { + self.logical_result + } + + /// Only payload types reach the physical layout callback. The source arena + /// is retained explicitly so the projected TypeIds cannot be interpreted in + /// a rewritten physical arena. An empty parameter list is a real nullary + /// call, not permission to evaluate the action at initialization time. + pub(super) fn physical_signature( + &self, + mut shape: impl FnMut(&Module, TypeId) -> Result>, + ) -> Result> { + let parameters = self + .parameters + .iter() + .map(|ty| shape(self.source, *ty)) + .collect::, _>>()?; + let result = shape(self.source, self.result)?; + if parameters.contains(&ValueShape::State) || result == ValueShape::State { + return Err(layout_error( + self.source.span, + "nested state payloads require checked zero-width result projection", + )); + } + Ok(Signature { parameters, result }) + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/cc/layout/functions/projection/tests.rs b/crates/psrs-backend/src/cc/layout/functions/projection/tests.rs new file mode 100644 index 00000000..9d20f155 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/functions/projection/tests.rs @@ -0,0 +1,166 @@ +use super::*; +use crate::cc::{RefShape, Reference, SignatureId}; +use psrs_core::{Type, TypeConstructor}; +use psrs_hir::{ModuleId, TypeId as HirTypeId, TypeVariableId}; +use std::collections::{HashMap, HashSet}; + +fn fixture() -> Module { + Module { + id: ModuleId(0), + name: "OrdinaryStateCallable".into(), + externals: Vec::new(), + external_types: Vec::new(), + types: vec![ + Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_STATE)), + Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_REAL_WORLD)), + Type::Application(TypeId(0), TypeId(1)), + Type::Constructor(TypeConstructor::Int), + Type::RowEmpty, + Type::RowExtend { + label: "value".into(), + ty: TypeId(3), + tail: TypeId(4), + }, + Type::RowExtend { + label: "state".into(), + ty: TypeId(2), + tail: TypeId(5), + }, + Type::Constructor(TypeConstructor::Record), + Type::Application(TypeId(7), TypeId(6)), + Type::Constructor(TypeConstructor::Function), + Type::Application(TypeId(9), TypeId(2)), + Type::Application(TypeId(10), TypeId(8)), + ], + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: Vec::new(), + type_names: Vec::new(), + entry: None, + span: psrs_span::TextRange::new(0, 1), + } +} + +fn physical( + projection: &CallProjection<'_>, + functions: &HashMap, +) -> Signature { + projection + .physical_signature(|source, ty| { + crate::cc::layout::scalar_type( + source, + ty, + source.span, + &HashSet::new(), + &HashSet::new(), + &HashSet::new(), + &HashMap::new(), + &HashMap::new(), + functions, + ) + }) + .unwrap() +} + +#[test] +fn state_call_projects_to_nullary_payload_without_state_or_step_layout() { + let source = fixture(); + let before = source.types.clone(); + let projection = CallProjection::checked(&source, TypeId(11)).unwrap(); + let signature = physical(&projection, &HashMap::new()); + assert!(signature.parameters.is_empty()); + assert_eq!(signature.result, ValueShape::Integer); + assert_eq!(projection.state_contract().unwrap().region, TypeId(1)); + assert_eq!(source.types, before); +} + +#[test] +fn fixed_state_closure_preserves_ordinary_arguments_and_function_payload() { + let mut source = fixture(); + source.types.push(Type::Closure { + parameters: vec![TypeId(3)], + result: TypeId(3), + }); + let Type::RowExtend { ty, .. } = &mut source.types[5] else { + unreachable!() + }; + *ty = TypeId(12); + source.types.push(Type::Closure { + parameters: vec![TypeId(3), TypeId(2)], + result: TypeId(8), + }); + let projection = CallProjection::checked(&source, TypeId(13)).unwrap(); + let signature = physical(&projection, &HashMap::from([(TypeId(12), SignatureId(7))])); + assert_eq!(signature.parameters, [ValueShape::Integer]); + assert_eq!( + signature.result, + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(SignatureId(7)), + }) + ); +} + +#[test] +fn returned_state_action_keeps_its_own_call_boundary() { + let mut source = fixture(); + source.types.push(Type::Closure { + parameters: Vec::new(), + result: TypeId(11), + }); + let projection = CallProjection::checked(&source, TypeId(12)).unwrap(); + assert!(projection.state_contract().is_none()); + let signature = physical(&projection, &HashMap::from([(TypeId(11), SignatureId(7))])); + assert!(signature.parameters.is_empty()); + assert_eq!( + signature.result, + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(SignatureId(7)), + }) + ); +} + +#[test] +fn region_mismatch_and_nonfinal_state_reject_before_physical_layout() { + let mut source = fixture(); + source.types.push(Type::Variable(TypeVariableId(0))); + source.types.push(Type::Application(TypeId(0), TypeId(12))); + let Type::RowExtend { ty, .. } = &mut source.types[6] else { + unreachable!() + }; + *ty = TypeId(13); + assert!(CallProjection::checked(&source, TypeId(11)).is_err()); + let mut source = fixture(); + source.types.push(Type::Closure { + parameters: vec![TypeId(2), TypeId(3)], + result: TypeId(8), + }); + assert!(CallProjection::checked(&source, TypeId(12)).is_err()); +} + +#[test] +fn cc_state_signature_retains_dependencies_until_instruction_projection() { + let source = fixture(); + let signature = super::super::function_signature( + &source, + TypeId(11), + &HashSet::new(), + &HashSet::new(), + &HashSet::new(), + &HashMap::new(), + &HashMap::from([(TypeId(8), crate::cc::ReprId(0))]), + &HashMap::new(), + ) + .unwrap(); + assert_eq!(signature.parameters, [ValueShape::State]); + assert_eq!( + signature.result, + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(crate::cc::ReprId(0)), + }) + ); +} diff --git a/crates/psrs-backend/src/cc/layout/functions/reachable.rs b/crates/psrs-backend/src/cc/layout/functions/reachable.rs index 79788f60..461e100a 100644 --- a/crates/psrs-backend/src/cc/layout/functions/reachable.rs +++ b/crates/psrs-backend/src/cc/layout/functions/reachable.rs @@ -30,6 +30,20 @@ pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { record_type(module, *field, &mut visiting, &mut referenced); } } + // Runtime declarations must publish complete logical call contracts even + // when unused. Their Step and callable payload layouts cannot be inferred + // from the remaining bodies alone. A state-stepping declaration needs the + // same treatment whichever interface it binds, because its result is a + // Step whose successor and payload are not reachable from any body. + for checked in &module.external_types { + let runtime = module.externals.iter().any(|external| { + external.symbol == checked.symbol + && matches!(external.kind, psrs_hir::ExternalKind::Runtime { .. }) + }); + if runtime || psrs_core::state::signature(module, checked.ty).is_ok() { + record_type(module, checked.ty, &mut visiting, &mut referenced); + } + } referenced } diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 38728629..2877d2ad 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -50,6 +50,9 @@ pub(super) fn primitive_value_shape(constructor: TypeConstructor) -> Option Option { let id = unquantified_type(module, id); + if psrs_core::state::region(module, id).is_some() { + return Some(ValueShape::State); + } match module.types.get(id.0 as usize)? { Type::Constructor(constructor) => primitive_value_shape(*constructor), _ => None, @@ -187,6 +190,11 @@ pub(super) fn type_layout( .iter() .any(|declaration| depends_on_type_variable(module, declaration.ty)) || module_has_integer_capture(module) + || module + .types + .iter() + .enumerate() + .any(|(index, _)| array_element_type(module, TypeId(index as u32)).is_some()) || module .constructors .iter() @@ -292,9 +300,15 @@ pub(super) fn type_layout( protocols::append(&mut representations); let function_slot = crate::boundary::function_slot_protocol(&mut representations); + crate::cc::state::register_payload_slots(&mut representations); + let protocols = crate::boundary::payload_erased_protocols( + &mut representations, + &function_types, + module.span, + )?; Ok(TypeLayout { function_slot, - protocols: crate::boundary::payload_erased_protocols(&mut representations, &function_types), + protocols, representations, array_types, record_types, @@ -345,38 +359,13 @@ pub(super) fn user_type_id(module: &CoreModule, mut id: TypeId) -> Option bool { +pub(crate) fn is_callable_type(module: &CoreModule, id: TypeId) -> bool { let id = unquantified_type(module, id); psrs_core::arrow_parts(&module.types, id).is_some() || psrs_core::closure_parts(&module.types, id).is_some() } -/// Derives the calling convention of a value. -/// -/// A closure contributes exactly the parameter list it was born with. Its -/// result stays a value, even when that value is a function or another -/// closure. An ordinary function flattens every arrow: the parameters are the -/// arrow domains and the result is the codomain. A quantifier in a codomain -/// stops the walk so that polymorphic result stays a separate closure. -pub(crate) fn function_arrow_parameters(module: &CoreModule, id: TypeId) -> (Vec, TypeId) { - let id = unquantified_type(module, id); - if let Some((parameters, result)) = psrs_core::closure_parts(&module.types, id) { - return (parameters.to_vec(), result); - } - let mut parameters = Vec::new(); - let mut current = id; - while let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, current) { - parameters.push(parameter); - current = result; - // A quantifier in the codomain starts a new polymorphic closure - // boundary. Keep that type intact as the result value; unwrapping it - // there would merge its arrows into the current closure's arity. - if psrs_core::forall_parts(&module.types, current).is_some() { - break; - } - } - (parameters, current) -} +pub(crate) use functions::parts::{checked_function_arrow_parameters, function_arrow_parameters}; /// Returns the runtime-facing body of a type after removing quantifiers that /// wrap the value itself. A quantifier reached in an arrow's codomain is kept diff --git a/crates/psrs-backend/src/cc/layout/protocols.rs b/crates/psrs-backend/src/cc/layout/protocols.rs index 54a6cac0..8f8f5a64 100644 --- a/crates/psrs-backend/src/cc/layout/protocols.rs +++ b/crates/psrs-backend/src/cc/layout/protocols.rs @@ -21,6 +21,13 @@ pub(super) fn append(table: &mut RepresentationTable) { let id = table.reserve(); table.set(id, Representation::Array { element: erased }); } + // Text codecs use a private integer buffer. Source arrays use erased slots; + // codec conversion explicitly crosses this value-producing boundary. + if has_array && !table.representations.iter().any(|representation| + matches!(representation, Representation::Array { element } if *element == ValueShape::Integer)) { + let id = table.reserve(); + table.set(id, Representation::Array { element: ValueShape::Integer }); + } let labels = table .product_labels .values() diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index 064a6e59..c3c7a559 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -217,6 +217,9 @@ pub(crate) fn scalar_type( record_types: &HashMap, function_types: &HashMap, ) -> Result> { + if primitive_shape_of(module, id) == Some(ValueShape::State) { + return Ok(ValueShape::State); + } // A callable closure value — an ordinary arrow or a registered callable // constructor application — is represented by its closure signature. if is_callable_type(module, id) { diff --git a/crates/psrs-backend/src/cc/layout/tests/arrays.rs b/crates/psrs-backend/src/cc/layout/tests/arrays.rs new file mode 100644 index 00000000..f8ae3c91 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/tests/arrays.rs @@ -0,0 +1,48 @@ +use super::*; + +#[test] +fn source_arrays_share_erased_element_storage() { + let mut module = empty_module(vec![ + Type::Variable(TypeVariableId(0)), + Type::Constructor(TypeConstructor::Array), + Type::Application(TypeId(1), TypeId(0)), + Type::Constructor(psrs_core::TypeConstructor::Int), + Type::Application(TypeId(1), TypeId(3)), + Type::Application(TypeId(1), TypeId(2)), + ]); + // `Array Int` and `Array (Array a)` reach every element shape under test. + root_types(&mut module, [TypeId(4), TypeId(5)]); + let layout = layout_for(&module); + let generic = layout.array_types[&TypeId(2)]; + let concrete = layout.array_types[&TypeId(4)]; + let nested = layout.array_types[&TypeId(5)]; + assert_eq!( + generic, concrete, + "source arrays preserve storage through instantiation" + ); + assert_eq!( + generic, nested, + "nested arrays use the same storage protocol" + ); + assert_eq!( + layout.representations.representation(generic), + Some(&Representation::Array { + element: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }), + }) + ); + assert_eq!( + layout.representations.representation(concrete), + Some(&Representation::Array { + element: crate::cc::payload::erased_shape(), + }) + ); + assert_eq!( + layout.representations.representation(nested), + Some(&Representation::Array { + element: crate::cc::payload::erased_shape(), + }) + ); +} diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index 0afbae9e..4829b3b6 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -1,3 +1,5 @@ +mod arrays; + use super::*; use crate::cc::{RefShape, Reference}; use psrs_core::{ @@ -65,49 +67,6 @@ fn root_types(module: &mut Module, roots: impl IntoIterator) { } } -#[test] -fn canonical_arrays_key_by_element_shape() { - let mut module = empty_module(vec![ - Type::Variable(TypeVariableId(0)), - Type::Constructor(TypeConstructor::Array), - Type::Application(TypeId(1), TypeId(0)), - Type::Constructor(psrs_core::TypeConstructor::Int), - Type::Application(TypeId(1), TypeId(3)), - Type::Application(TypeId(1), TypeId(2)), - ]); - // `Array Int` and `Array (Array a)` reach every element shape under test. - root_types(&mut module, [TypeId(4), TypeId(5)]); - let layout = layout_for(&module); - let generic = layout.array_types[&TypeId(2)]; - let concrete = layout.array_types[&TypeId(4)]; - let nested = layout.array_types[&TypeId(5)]; - assert_ne!(generic, concrete, "Array a and Array Int must differ"); - assert_eq!( - layout.representations.representation(generic), - Some(&Representation::Array { - element: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Erased, - }), - }) - ); - assert_eq!( - layout.representations.representation(concrete), - Some(&Representation::Array { - element: ValueShape::Integer, - }) - ); - assert_eq!( - layout.representations.representation(nested), - Some(&Representation::Array { - element: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(generic), - }), - }) - ); -} - #[test] fn recursive_aggregate_normalization_terminates() { let mut module = empty_module(vec![ @@ -128,9 +87,9 @@ fn recursive_aggregate_normalization_terminates() { layout.representations.representation(second), Some(Representation::Array { .. }) )); - assert_ne!( + assert_eq!( first, second, - "mutually recursive arrays keep distinct canonical handles" + "recursive source arrays share canonical erased storage" ); } @@ -280,9 +239,9 @@ fn equal_normalized_function_signatures_share_one_signature_id() { let layout = type_layout(&module, &enums, &aggregates, &newtypes) .expect("distinct function types should normalize and intern"); - assert_ne!( + assert_eq!( layout.array_types[&array_int], layout.array_types[&array_string], - "Array Int and Array String are distinct semantic shapes with distinct canonical arrays" + "distinct source element types share physical array storage" ); assert_eq!( layout.array_types[&array_int], layout.array_types[&array_int_b], @@ -294,9 +253,9 @@ fn equal_normalized_function_signatures_share_one_signature_id() { first, second, "function types that are equal after normalization must share one SignatureId" ); - assert_ne!( + assert_eq!( layout.function_types[&f_int], layout.function_types[&f_string], - "arrays with different semantic element shapes keep distinct signatures" + "array function signatures share a physical storage convention" ); let signature = layout .representations @@ -492,7 +451,7 @@ fn an_opaque_handle_and_an_array_of_handles_have_scalar_layouts() { .representations .representation(layout.array_types[&array_handle]), Some(&Representation::Array { - element: ValueShape::Integer, + element: crate::cc::payload::erased_shape(), }) ); let _ = handle; diff --git a/crates/psrs-backend/src/cc/lower/array/mod.rs b/crates/psrs-backend/src/cc/lower/array/mod.rs index 8619614b..8593c03a 100644 --- a/crates/psrs-backend/src/cc/lower/array/mod.rs +++ b/crates/psrs-backend/src/cc/lower/array/mod.rs @@ -20,10 +20,10 @@ impl FunctionLowerer<'_> { "array expression has no representation requirement", )]); }; - let values = elements - .iter() - .map(|element| self.lower_value(element, assignments)) - .collect::, _>>()?; + let mut values = Vec::with_capacity(elements.len()); + for element in elements { + values.push(self.lower_array_element(element, assignments)?); + } let destination = self.fresh(ty); assignments.push(Assignment { destination, @@ -67,7 +67,7 @@ impl FunctionLowerer<'_> { span: expression.span, }); let index = self.lower_value(index, assignments)?; - let new_value = self.lower_value(new_value, assignments)?; + let new_value = self.lower_array_element(new_value, assignments)?; assignments.push(Assignment { destination, kind: AssignmentKind::ArraySet { diff --git a/crates/psrs-backend/src/cc/lower/array/storage.rs b/crates/psrs-backend/src/cc/lower/array/storage.rs index c51fd976..7d87c9ea 100644 --- a/crates/psrs-backend/src/cc/lower/array/storage.rs +++ b/crates/psrs-backend/src/cc/lower/array/storage.rs @@ -5,6 +5,23 @@ use crate::cc::{Assignment, AssignmentKind, ValueId, ValueShape}; use psrs_core::Expr; impl FunctionLowerer<'_> { + pub(in crate::cc::lower) fn lower_array_element( + &mut self, + value: &Expr, + assignments: &mut Vec, + ) -> Result> { + let shape = self.value_shape(value.ty, value.span)?; + let lowered = self.lower_value(value, assignments)?; + let plan = self.erase_payload(shape, value.span)?; + Ok(self.emit_conversion( + lowered, + shape, + crate::cc::payload::erased_shape(), + plan, + value.span, + assignments, + )) + } pub(in crate::cc::lower) fn lower_array_fill( &mut self, expression: &Expr, @@ -21,7 +38,7 @@ impl FunctionLowerer<'_> { )] })?; let length = self.lower_value(length, assignments)?; - let value = self.lower_value(value, assignments)?; + let value = self.lower_array_element(value, assignments)?; let destination = self.fresh(ty); assignments.push(Assignment { destination, @@ -52,7 +69,7 @@ impl FunctionLowerer<'_> { })?; let value = self.lower_value(array, assignments)?; let index = self.lower_value(index, assignments)?; - let new_value = self.lower_value(new_value, assignments)?; + let new_value = self.lower_array_element(new_value, assignments)?; assignments.push(Assignment { destination: value, span: expression.span, diff --git a/crates/psrs-backend/src/cc/lower/call/application.rs b/crates/psrs-backend/src/cc/lower/call/application.rs index 7f0e9c54..f4b2e7a1 100644 --- a/crates/psrs-backend/src/cc/lower/call/application.rs +++ b/crates/psrs-backend/src/cc/lower/call/application.rs @@ -2,7 +2,7 @@ use super::super::super::layout::{function_signature, function_type_signature}; use super::super::super::{Assignment, AssignmentKind, ValueId}; use super::super::{FunctionLowerer, Signature, ValueShape}; use super::helpers::{ - callable_parameter_types, callable_result_type, collect_application, + callable_instantiation, callable_parameter_types, callable_result_type, collect_application, conversion_reconstructs_aggregate, function_value_types, persist_reference, restore_reference, }; use super::partial::{IndirectPartialApplication, PartialApplication}; @@ -54,18 +54,7 @@ impl ApplicationLowering for FunctionLowerer<'_> { assignments, ); } - let declaration = self - .module - .declarations - .iter() - .find(|declaration| declaration.symbol == function); - let evidence = declaration.and_then(|declaration| { - self.boundary.checked_instantiation( - declaration.ty, - &declaration.quantified, - head.ty, - ) - }); + let evidence = callable_instantiation(self.module, self.boundary, function, head.ty); self.check_call_shape( &signature, arguments.len(), diff --git a/crates/psrs-backend/src/cc/lower/call/helpers.rs b/crates/psrs-backend/src/cc/lower/call/helpers.rs index 98caeccb..e0668b8c 100644 --- a/crates/psrs-backend/src/cc/lower/call/helpers.rs +++ b/crates/psrs-backend/src/cc/lower/call/helpers.rs @@ -209,7 +209,12 @@ pub(super) fn callable_parameter_types( { return declaration_parameter_types(module, symbol); } - function_parameter_types(module, callable_type) + let scheme = module + .external_types + .iter() + .find(|external| external.symbol == symbol) + .map_or(callable_type, |external| external.ty); + function_parameter_types(module, scheme) } pub(super) fn callable_result_type( @@ -218,11 +223,36 @@ pub(super) fn callable_result_type( callable_type: psrs_core::TypeId, ) -> Option { declaration_result_type(module, symbol).or_else(|| { - let (_, result) = function_arrow_parameters(module, callable_type); + let scheme = module + .external_types + .iter() + .find(|external| external.symbol == symbol) + .map_or(callable_type, |external| external.ty); + let (_, result) = function_arrow_parameters(module, scheme); module.types.get(result.0 as usize).map(|_| result) }) } +pub(super) fn callable_instantiation<'a>( + module: &'a CoreModule, + boundary: &crate::boundary::BoundaryEvidence<'a>, + symbol: SymbolId, + instance: psrs_core::TypeId, +) -> Option> { + if let Some(declaration) = module + .declarations + .iter() + .find(|declaration| declaration.symbol == symbol) + { + return boundary.checked_instantiation(declaration.ty, &declaration.quantified, instance); + } + let external = module + .external_types + .iter() + .find(|external| external.symbol == symbol)?; + boundary.instantiation_at(external.ty, instance) +} + fn function_parameter_types( module: &CoreModule, type_id: psrs_core::TypeId, diff --git a/crates/psrs-backend/src/cc/lower/call/mod.rs b/crates/psrs-backend/src/cc/lower/call/mod.rs index de4e25bc..90bfda36 100644 --- a/crates/psrs-backend/src/cc/lower/call/mod.rs +++ b/crates/psrs-backend/src/cc/lower/call/mod.rs @@ -9,6 +9,29 @@ use psrs_span::TextRange; pub(super) use helpers::{is_function_type, persist_reference, restore_reference}; +impl super::FunctionLowerer<'_> { + pub(super) fn lower_external_function_value( + &mut self, + expression: &Expr, + function: psrs_hir::SymbolId, + signature: &Signature, + result_type: ValueShape, + assignments: &mut Vec, + ) -> Result> { + self.lower_partial_global_application( + partial::PartialApplication { + expression, + function, + source_signature: signature, + arguments: Vec::new(), + result_type, + callable_type: expression.ty, + }, + assignments, + ) + } +} + pub(super) trait CallShape { fn check_call_shape( &self, diff --git a/crates/psrs-backend/src/cc/lower/call/partial/global.rs b/crates/psrs-backend/src/cc/lower/call/partial/global.rs index 3c9473f7..285cb515 100644 --- a/crates/psrs-backend/src/cc/lower/call/partial/global.rs +++ b/crates/psrs-backend/src/cc/lower/call/partial/global.rs @@ -40,18 +40,7 @@ impl FunctionLowerer<'_> { "partial application has an incomplete declaration signature", )]); } - let declaration = self - .module - .declarations - .iter() - .find(|item| item.symbol == function); - let evidence = declaration.and_then(|declaration| { - self.boundary.checked_instantiation( - declaration.ty, - &declaration.quantified, - callable_type, - ) - }); + let evidence = callable_instantiation(self.module, self.boundary, function, callable_type); let (use_parameters, _) = function_arrow_parameters(self.module, callable_type); let remaining_count = source_signature.parameters.len() - arguments.len(); if target_signature.parameters.len() < remaining_count { diff --git a/crates/psrs-backend/src/cc/lower/call/partial/mod.rs b/crates/psrs-backend/src/cc/lower/call/partial/mod.rs index 05fd9860..a85a9c5f 100644 --- a/crates/psrs-backend/src/cc/lower/call/partial/mod.rs +++ b/crates/psrs-backend/src/cc/lower/call/partial/mod.rs @@ -6,8 +6,9 @@ use super::super::super::{ use super::super::lambda::LambdaLowering; use super::super::{FunctionLowerer, Signature, ValueShape}; use super::helpers::{ - callable_parameter_types, callable_result_type, closure_value_type, closure_value_type_for, - conversion_reconstructs_aggregate, function_result_type, persist_reference, restore_reference, + callable_instantiation, callable_parameter_types, callable_result_type, closure_value_type, + closure_value_type_for, conversion_reconstructs_aggregate, function_result_type, + persist_reference, restore_reference, }; use crate::BackendError; use psrs_core::Expr; diff --git a/crates/psrs-backend/src/cc/lower/constructor.rs b/crates/psrs-backend/src/cc/lower/constructor.rs index e81e3af7..3871617a 100644 --- a/crates/psrs-backend/src/cc/lower/constructor.rs +++ b/crates/psrs-backend/src/cc/lower/constructor.rs @@ -120,12 +120,23 @@ impl FunctionLowerer<'_> { "constructor field storage does not match its normalized template", )]); } - let conversion = self.typed_conversion( + let evidence = self + .boundary + .checked_instantiation(template_type, &constructor.parameters, argument.ty) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "constructor field has no checked scoped instantiation", + )] + })?; + let conversion = self.typed_conversion_with_instantiation( argument.ty, template_type, source_shape, template_shape, expression.span, + Some(&evidence), )?; let value = self.emit_conversion( value, diff --git a/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs b/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs index 1126df2a..3133f8fc 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs @@ -2,6 +2,7 @@ //! Erasure curries flattened calls into unary erased segments; recovery applies //! those segments and adapts every argument and the final result explicitly. use super::super::LambdaLowering; +use super::state_slot::StateSlot; use super::*; use crate::cc::{Function, Signature, SignatureId}; @@ -39,8 +40,14 @@ impl FunctionLowerer<'_> { "function slot producer requires an argument", )); } - let function = self.slot_segment(source, slot, &shape, 0, span)?; - self.slot_factory(source, slot, function, span) + let state = self.state_slot(&shape, span)?; + let initial = if shape.parameters[0] == ValueShape::State { + state.unwrap().signature + } else { + slot + }; + let function = self.slot_segment(source, slot, &shape, 0, state, span)?; + self.slot_factory(source, initial, function, span) } fn slot_segment( @@ -49,6 +56,7 @@ impl FunctionLowerer<'_> { slot: SignatureId, shape: &Signature, prefix: usize, + state: Option, span: TextRange, ) -> Result> { let mut body = self.child_lowerer(); @@ -56,7 +64,18 @@ impl FunctionLowerer<'_> { nullable: false, heap: RefShape::Aggregate, })); - let input = body.fresh(erased_shape()); + let terminal = shape.parameters[prefix] == ValueShape::State; + let input_shape = if terminal { + ValueShape::State + } else { + erased_shape() + }; + let result_shape = if terminal { + state.unwrap().result + } else { + erased_shape() + }; + let input = body.fresh(input_shape); let mut assignments = Vec::new(); let producer = body.slot_capture(receiver, 0, closure(source), span, &mut assignments); let mut arguments = Vec::new(); @@ -69,10 +88,14 @@ impl FunctionLowerer<'_> { &mut assignments, )); } - let conversion = body.recover_payload(shape.parameters[prefix], span)?; + let conversion = if terminal { + ValueConversion::Identity + } else { + body.recover_payload(shape.parameters[prefix], span)? + }; arguments.push(body.emit_conversion( input, - erased_shape(), + input_shape, shape.parameters[prefix], conversion, span, @@ -89,32 +112,41 @@ impl FunctionLowerer<'_> { }, span, }); - let conversion = body.erase_payload(shape.result, span)?; + let conversion = if terminal { + body.state_slot_result(state.unwrap(), true, span)? + } else { + body.erase_payload(shape.result, span)? + }; body.emit_conversion( result, shape.result, - erased_shape(), + result_shape, conversion, span, &mut assignments, ) } else { - let next = body.slot_segment(source, slot, shape, prefix + 1, span)?; - let value = body.fresh(closure(slot)); + let next = body.slot_segment(source, slot, shape, prefix + 1, state, span)?; + let next_slot = if shape.parameters[prefix + 1] == ValueShape::State { + state.unwrap().signature + } else { + slot + }; + let value = body.fresh(closure(next_slot)); let mut captures = vec![producer]; captures.extend(arguments); assignments.push(Assignment { destination: value, kind: AssignmentKind::FunctionRef { function: next, - signature: slot, + signature: next_slot, captures, }, span, }); body.emit_conversion( value, - closure(slot), + closure(next_slot), erased_shape(), ValueConversion::EraseReference, span, @@ -129,7 +161,7 @@ impl FunctionLowerer<'_> { values: body.values, assignments, result, - result_type: erased_shape(), + result_type: result_shape, span, }; super::super::super::verify::verify_function( @@ -148,13 +180,6 @@ impl FunctionLowerer<'_> { span: TextRange, ) -> Result> { let slot = self.slot_signature(span)?; - let cast = ValueConversion::RecoverReference { - destination: closure(slot), - evidence: RecoveryEvidence::TypeInstantiation, - }; - if target == slot { - return Ok(cast); - } let shape = self .representations .signature(target) @@ -166,6 +191,19 @@ impl FunctionLowerer<'_> { "function slot consumer requires an argument", )); } + let state = self.state_slot(&shape, span)?; + let initial = if shape.parameters[0] == ValueShape::State { + state.unwrap().signature + } else { + slot + }; + let cast = ValueConversion::RecoverReference { + destination: closure(initial), + evidence: RecoveryEvidence::TypeInstantiation, + }; + if target == initial { + return Ok(cast); + } let mut body = self.child_lowerer(); let receiver = body.fresh(ValueShape::Reference(Reference { nullable: false, @@ -179,44 +217,76 @@ impl FunctionLowerer<'_> { let mut parameters = vec![receiver]; parameters.extend(inputs.iter().copied()); let mut assignments = Vec::new(); - let mut current = body.slot_capture(receiver, 0, closure(slot), span, &mut assignments); + let mut current = body.slot_capture(receiver, 0, closure(initial), span, &mut assignments); let mut result = current; for (index, parameter_shape) in shape.parameters.iter().enumerate() { let input = inputs[index]; - let conversion = body.erase_payload(*parameter_shape, span)?; + let terminal = *parameter_shape == ValueShape::State; + let argument_shape = if terminal { + ValueShape::State + } else { + erased_shape() + }; + let invoked = if terminal { + state.unwrap().signature + } else { + slot + }; + let conversion = if terminal { + ValueConversion::Identity + } else { + body.erase_payload(*parameter_shape, span)? + }; let argument = body.emit_conversion( input, *parameter_shape, - erased_shape(), + argument_shape, conversion, span, &mut assignments, ); - result = body.fresh(erased_shape()); + result = body.fresh(if terminal { + state.unwrap().result + } else { + erased_shape() + }); assignments.push(Assignment { destination: result, kind: AssignmentKind::IndirectCall { function: current, - signature: slot, + signature: invoked, arguments: vec![argument], }, span, }); if index + 1 < shape.parameters.len() { + let next_slot = if shape.parameters[index + 1] == ValueShape::State { + state.unwrap().signature + } else { + slot + }; current = body.emit_conversion( result, erased_shape(), - closure(slot), - cast.clone(), + closure(next_slot), + ValueConversion::RecoverReference { + destination: closure(next_slot), + evidence: RecoveryEvidence::TypeInstantiation, + }, span, &mut assignments, ); } } - let conversion = body.recover_payload(shape.result, span)?; + let source_result = state.map_or(erased_shape(), |state| state.result); + let conversion = if let Some(state) = state { + body.state_slot_result(state, false, span)? + } else { + body.recover_payload(shape.result, span)? + }; let result = body.emit_conversion( result, - erased_shape(), + source_result, shape.result, conversion, span, @@ -240,7 +310,7 @@ impl FunctionLowerer<'_> { )?; self.generated.extend(body.generated); self.generated.push(function); - let factory = self.slot_factory(slot, target, symbol, span)?; + let factory = self.slot_factory(initial, target, symbol, span)?; Ok(sequence(vec![cast, factory])) } diff --git a/crates/psrs-backend/src/cc/lower/conversion/mod.rs b/crates/psrs-backend/src/cc/lower/conversion/mod.rs index 6487d467..60014835 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/mod.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/mod.rs @@ -13,7 +13,9 @@ use psrs_span::TextRange; mod callable; mod function_slot; +mod product_map; mod scalars; +mod state_slot; mod transport; pub(in crate::cc) struct VariantFieldConversion { @@ -21,6 +23,7 @@ pub(in crate::cc) struct VariantFieldConversion { pub(in crate::cc) tag: u32, pub(in crate::cc) field: u32, pub(in crate::cc) template_type: TypeId, + pub(in crate::cc) parameters: Vec, pub(in crate::cc) target_type: TypeId, pub(in crate::cc) target_shape: ValueShape, pub(in crate::cc) stored_shape: ValueShape, @@ -110,6 +113,14 @@ impl FunctionLowerer<'_> { // incorrectly replace erased storage with the concrete argument shape. let source_type = self.conversion_template(source_type, span)?; let destination_type = self.conversion_template(destination_type, span)?; + // Erased callable storage uses the payload owner's curry protocol, + // rather than the concrete producer's closure signature. + if destination_shape == crate::cc::payload::erased_shape() { + return self.erase_payload(source_shape, span); + } + if source_shape == crate::cc::payload::erased_shape() { + return self.recover_payload(destination_shape, span); + } if super::call::is_function_type(self.module, source_type) && super::call::is_function_type(self.module, destination_type) && matches!( @@ -209,10 +220,17 @@ impl FunctionLowerer<'_> { "record conversion requires closed rows", )); }; - let (Some(source_repr), Some(destination_repr)) = ( - self.record_types.get(&source_type).copied(), - self.record_types.get(&destination_type).copied(), - ) else { + let ( + ValueShape::Reference(Reference { + heap: RefShape::Repr(source_repr), + .. + }), + ValueShape::Reference(Reference { + heap: RefShape::Repr(destination_repr), + .. + }), + ) = (source_shape, destination_shape) + else { return Err(conversion_error( span, "record conversion has no canonical layout", @@ -236,8 +254,22 @@ impl FunctionLowerer<'_> { "generic record conversion requires identical closed field labels", )); } + let fields = |repr| match self.representations.representation(repr) { + Some(crate::cc::Representation::Product { fields }) + if fields.len() == labels.len() => + { + Some(fields.clone()) + } + _ => None, + }; + let source_shapes = fields(source_repr).ok_or_else(|| { + conversion_error(span, "source record protocol has invalid fields") + })?; + let destination_shapes = fields(destination_repr).ok_or_else(|| { + conversion_error(span, "target record protocol has invalid fields") + })?; let mut plans = Vec::with_capacity(labels.len()); - for label in &labels { + for (index, label) in labels.iter().enumerate() { let source_field = source_fields .iter() .find(|(name, _)| name == label) @@ -251,8 +283,8 @@ impl FunctionLowerer<'_> { plans.push(self.plan_conversion( source_field, destination_field, - self.value_shape(source_field, span)?, - self.value_shape(destination_field, span)?, + source_shapes[index], + destination_shapes[index], span, instantiation, )?); @@ -303,6 +335,26 @@ impl FunctionLowerer<'_> { if matches!(plan, ValueConversion::Identity) { return value; } + if let Some(result) = + self.emit_product_map(value, source, destination, &plan, span, assignments) + { + return result; + } + if let ValueConversion::Sequence(steps) = plan { + let mut value = value; + let mut shape = source; + let length = steps.len(); + for (index, step) in steps.into_iter().enumerate() { + let next = if index + 1 == length { + destination + } else { + step.output_shape(shape) + }; + value = self.emit_conversion(value, shape, next, step, span, assignments); + shape = next; + } + return value; + } let result = self.fresh(destination); assignments.push(Assignment { destination: result, @@ -329,6 +381,7 @@ impl FunctionLowerer<'_> { tag, field, template_type, + parameters, target_type, target_shape, stored_shape, @@ -361,13 +414,19 @@ impl FunctionLowerer<'_> { "variant field storage does not match its normalized template", )]); } + let evidence = self + .boundary + .checked_instantiation(template_type, ¶meters, target_type) + .ok_or_else(|| { + conversion_error(span, "variant field has no checked scoped instantiation") + })?; self.plan_conversion( template_type, target_type, template_shape, target_shape, span, - None, + Some(&evidence), ) } } @@ -380,12 +439,7 @@ pub(super) fn sequence(steps: Vec) -> ValueConversion { } } -pub(super) fn erased_shape() -> ValueShape { - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Erased, - }) -} +pub(super) use crate::cc::payload::erased_shape; fn conversion_error(span: TextRange, message: &'static str) -> Vec { vec![BackendError::new("P8 closure conversion", span, message)] diff --git a/crates/psrs-backend/src/cc/lower/conversion/product_map.rs b/crates/psrs-backend/src/cc/lower/conversion/product_map.rs new file mode 100644 index 00000000..a27650b8 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/conversion/product_map.rs @@ -0,0 +1,98 @@ +//! Expose field conversions as CC operations before dependency publication. +use super::*; +use crate::cc::Representation; + +impl FunctionLowerer<'_> { + pub(super) fn emit_product_map( + &mut self, + value: ValueId, + source_shape: ValueShape, + destination_shape: ValueShape, + plan: &ValueConversion, + span: TextRange, + assignments: &mut Vec, + ) -> Option { + let ValueConversion::ProductMap { + source, + target, + labels, + fields, + } = plan + else { + return None; + }; + let shape = |id| { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(id), + }) + }; + let Some(Representation::Product { + fields: source_fields, + }) = self.representations.representation(*source) + else { + return None; + }; + let Some(Representation::Product { + fields: target_fields, + }) = self.representations.representation(*target) + else { + return None; + }; + // Leave malformed plans intact so the aggregate verifier diagnoses them. + if source_shape != shape(*source) + || destination_shape != shape(*target) + || source_fields.len() != fields.len() + || target_fields.len() != fields.len() + || self.representations.product_labels(*source) != Some(labels.as_slice()) + || self.representations.product_labels(*target) != Some(labels.as_slice()) + || fields + .iter() + .zip(source_fields) + .zip(target_fields) + .any(|((plan, source), target)| plan.output_shape(*source) != *target) + { + return None; + } + let source_fields = source_fields.clone(); + let target_fields = target_fields.clone(); + let mut arguments = Vec::with_capacity(fields.len()); + for (index, ((plan, source_shape), target_shape)) in fields + .iter() + .zip(source_fields) + .zip(target_fields) + .enumerate() + { + let field = self.fresh(source_shape); + assignments.push(Assignment { + destination: field, + kind: AssignmentKind::ProductGet { + destination: field, + representation: *source, + field: index as u32, + value, + }, + span, + }); + arguments.push(self.emit_conversion( + field, + source_shape, + target_shape, + plan.clone(), + span, + assignments, + )); + } + let result = self.fresh(destination_shape); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::ProductNew { + destination: result, + representation: *target, + arguments, + }, + span, + }); + Some(result) + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs index 07661582..d68fc27e 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/scalars.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/scalars.rs @@ -7,7 +7,7 @@ use crate::{ use psrs_span::TextRange; impl FunctionLowerer<'_> { - pub(super) fn erase_payload( + pub(in crate::cc) fn erase_payload( &mut self, shape: ValueShape, span: TextRange, @@ -15,7 +15,7 @@ impl FunctionLowerer<'_> { crate::cc::payload::PayloadPlanner::erase_payload(self, shape, span) } - pub(super) fn recover_payload( + pub(in crate::cc) fn recover_payload( &mut self, shape: ValueShape, span: TextRange, diff --git a/crates/psrs-backend/src/cc/lower/conversion/state_slot.rs b/crates/psrs-backend/src/cc/lower/conversion/state_slot.rs new file mode 100644 index 00000000..d214c990 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/conversion/state_slot.rs @@ -0,0 +1,82 @@ +//! Terminal callable protocol retaining a logical State and erased Step payload. +use super::*; +use crate::cc::state::StateCallProjection; +use crate::cc::{Signature, SignatureId}; + +#[derive(Clone, Copy)] +pub(super) struct StateSlot { + pub signature: SignatureId, + pub result: ValueShape, + pub source_result: ValueShape, + pub projection: StateCallProjection, +} + +impl FunctionLowerer<'_> { + pub(super) fn state_slot( + &mut self, + shape: &Signature, + span: TextRange, + ) -> Result, Vec> { + let Some(projection) = StateCallProjection::checked(shape, self.representations) + .map_err(|message| conversion_error(span, message))? + else { + return Ok(None); + }; + let id = projection + .payload_slot_signature(shape, self.representations) + .map_err(|message| conversion_error(span, message))?; + let result = self + .representations + .signature(id) + .ok_or_else(|| conversion_error(span, "State payload slot is missing its signature"))? + .result; + Ok(Some(StateSlot { + signature: id, + result, + source_result: shape.result, + projection, + })) + } + + pub(super) fn state_slot_result( + &mut self, + slot: StateSlot, + entering: bool, + span: TextRange, + ) -> Result> { + if slot.result == slot.source_result { + return Ok(ValueConversion::Identity); + } + let ValueShape::Reference(Reference { + heap: RefShape::Repr(concrete), + .. + }) = slot.source_result + else { + unreachable!() + }; + let ValueShape::Reference(Reference { + heap: RefShape::Repr(protocol), + .. + }) = slot.result + else { + unreachable!() + }; + let payload = if entering { + self.erase_payload(slot.projection.payload, span)? + } else { + self.recover_payload(slot.projection.payload, span)? + }; + let mut fields = vec![ValueConversion::Identity; 2]; + fields[slot.projection.payload_field] = payload; + Ok(ValueConversion::ProductMap { + source: if entering { concrete } else { protocol }, + target: if entering { protocol } else { concrete }, + labels: self + .representations + .product_labels(concrete) + .unwrap_or(&[]) + .to_vec(), + fields, + }) + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/transport.rs b/crates/psrs-backend/src/cc/lower/conversion/transport.rs index 920cbce6..9bb8113e 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/transport.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/transport.rs @@ -79,6 +79,16 @@ impl FunctionLowerer<'_> { nullable: false, heap: RefShape::Repr(protocol), }); + if concrete == protocol { + return Ok(Some(if entering { + ValueConversion::EraseReference + } else { + ValueConversion::RecoverReference { + destination: target_shape, + evidence: RecoveryEvidence::TypeInstantiation, + } + })); + } return Ok(Some(if entering { let element = self.erase_payload(element_shape, span)?; sequence(vec![ @@ -127,15 +137,28 @@ impl FunctionLowerer<'_> { .map(|ty| self.value_shape(ty, span)) .collect::, _>>()?; let concrete = callable(if entering { source_shape } else { target_shape }).unwrap(); - let signature = self.representations.signature(concrete).ok_or_else(|| { - conversion_error(span, "constructor transport has no concrete signature") - })?; + let signature = self + .representations + .signature(concrete) + .cloned() + .ok_or_else(|| { + conversion_error(span, "constructor transport has no concrete signature") + })?; if signature.parameters != parameters { return Err(conversion_error( span, "constructor transport requires a callable segment adapter", )); } + if let Some(result_type) = self.boundary.protocol_result(constructor) + && signature.result != self.value_shape(result_type, span)? + { + return Err(conversion_error( + span, + "constructor transport result differs from its checked storage field", + )); + } + let state = self.state_slot(&signature, span)?; let protocol = self.boundary.protocol_signature(concrete).ok_or_else(|| { conversion_error(span, "constructor transport has no registered protocol") })?; @@ -146,12 +169,20 @@ impl FunctionLowerer<'_> { }); let identity_arguments = vec![ValueConversion::Identity; parameters.len()]; let plan = if entering { - let result = self.erase_payload(payload, span)?; + let result = if let Some(state) = state { + self.state_slot_result(state, true, span)? + } else { + self.erase_payload(payload, span)? + }; let adapter = self.physical_callable_plan(concrete, protocol, identity_arguments, result, span)?; sequence(vec![adapter, ValueConversion::EraseReference]) } else { - let result = self.recover_payload(payload, span)?; + let result = if let Some(state) = state { + self.state_slot_result(state, false, span)? + } else { + self.recover_payload(payload, span)? + }; let adapter = self.physical_callable_plan(protocol, concrete, identity_arguments, result, span)?; sequence(vec![ diff --git a/crates/psrs-backend/src/cc/lower/global.rs b/crates/psrs-backend/src/cc/lower/global.rs index 66abb93e..cc63cea3 100644 --- a/crates/psrs-backend/src/cc/lower/global.rs +++ b/crates/psrs-backend/src/cc/lower/global.rs @@ -31,6 +31,21 @@ impl GlobalLowering for FunctionLowerer<'_> { )); }; if !signature.parameters.is_empty() && is_function_type(self.module, expression.ty) { + if self + .module + .external_types + .iter() + .any(|external| external.symbol == function) + { + let signature = signature.clone(); + return self.lower_external_function_value( + expression, + function, + &signature, + result_type, + assignments, + ); + } let Some(source_type) = self .module .declarations diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 8ef2fd2f..fefaa145 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -50,7 +50,8 @@ impl FunctionLowerer<'_> { }; let array = self.lower_value(array, assignments)?; let index = self.lower_value(&arguments[1], assignments)?; - let destination = self.fresh(ty); + let stored_shape = crate::cc::payload::erased_shape(); + let destination = self.fresh(stored_shape); assignments.push(Assignment { destination, kind: AssignmentKind::ArrayGet { @@ -61,7 +62,15 @@ impl FunctionLowerer<'_> { }, span: expression.span, }); - Ok(destination) + let plan = self.recover_payload(ty, expression.span)?; + Ok(self.emit_conversion( + destination, + stored_shape, + ty, + plan, + expression.span, + assignments, + )) } Implementation::Generated(G::ArrayUpdate) => self.lower_array_update( expression, @@ -147,6 +156,44 @@ impl FunctionLowerer<'_> { "intrinsic requires elaboration or has no runtime implementation", )]) } + Implementation::StateExecutionBoundary => { + psrs_core::state::primitive::verify( + self.module, + intrinsic, + &arguments.iter().map(|value| value.ty).collect::>(), + expression.ty, + ) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + message, + )] + })?; + let function = self.lower_value(&arguments[0], assignments)?; + let signature = self + .function_types + .get(&arguments[0].ty) + .copied() + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "state execution has no checked callable signature", + )] + })?; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::StateExecution { + operation: intrinsic.state_operation().unwrap(), + function, + signature, + }, + span: expression.span, + }); + Ok(destination) + } } } } diff --git a/crates/psrs-backend/src/cc/lower/string_bytes.rs b/crates/psrs-backend/src/cc/lower/string_bytes.rs index 1b6750b2..6d4328f0 100644 --- a/crates/psrs-backend/src/cc/lower/string_bytes.rs +++ b/crates/psrs-backend/src/cc/lower/string_bytes.rs @@ -1,4 +1,7 @@ -use super::super::{Assignment, AssignmentKind, ValueId, ValueShape}; +use super::super::{ + Assignment, AssignmentKind, RefShape, Reference, ReprId, Representation, ValueConversion, + ValueId, ValueShape, +}; use super::FunctionLowerer; use crate::BackendError; use psrs_core::Expr; @@ -19,14 +22,19 @@ impl FunctionLowerer<'_> { ty: ValueShape, assignments: &mut Vec, ) -> Result> { - let Some(representation) = self.array_types.get(&expression.ty).copied() else { + let Some(source_representation) = self.array_types.get(&expression.ty).copied() else { return Err(missing_representation( expression.span, "stringToBytes result has no representation requirement", )); }; + let representation = self.byte_buffer_representation(expression.span)?; + let buffer_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(representation), + }); let value = self.lower_value(value, assignments)?; - let destination = self.fresh(ty); + let destination = self.fresh(buffer_shape); assignments.push(Assignment { destination, kind: AssignmentKind::StringToBytes { @@ -36,7 +44,20 @@ impl FunctionLowerer<'_> { }, span: expression.span, }); - Ok(destination) + let element = self.erase_payload(ValueShape::Integer, expression.span)?; + let plan = ValueConversion::ArrayMap { + source: representation, + target: source_representation, + element: Box::new(element), + }; + Ok(self.emit_conversion( + destination, + buffer_shape, + ty, + plan, + expression.span, + assignments, + )) } pub(super) fn lower_bytes_to_string( @@ -46,13 +67,33 @@ impl FunctionLowerer<'_> { ty: ValueShape, assignments: &mut Vec, ) -> Result> { - let Some(representation) = self.array_types.get(&value.ty).copied() else { + let Some(source_representation) = self.array_types.get(&value.ty).copied() else { return Err(missing_representation( expression.span, "bytesToString argument has no representation requirement", )); }; + let representation = self.byte_buffer_representation(expression.span)?; + let source_shape = self.value_shape(value.ty, value.span)?; + let buffer_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(representation), + }); let value = self.lower_value(value, assignments)?; + let element = self.recover_payload(ValueShape::Integer, expression.span)?; + let plan = ValueConversion::ArrayMap { + source: source_representation, + target: representation, + element: Box::new(element), + }; + let value = self.emit_conversion( + value, + source_shape, + buffer_shape, + plan, + expression.span, + assignments, + ); let destination = self.fresh(ty); assignments.push(Assignment { destination, @@ -65,6 +106,13 @@ impl FunctionLowerer<'_> { }); Ok(destination) } + + fn byte_buffer_representation(&self, span: TextRange) -> Result> { + self.representations.representations.iter().position(|representation| + matches!(representation, Representation::Array { element } if *element == ValueShape::Integer)) + .map(|index| ReprId(index as u32)) + .ok_or_else(|| missing_representation(span, "text codec has no private integer buffer representation")) + } } fn missing_representation(span: TextRange, message: &'static str) -> Vec { diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 6b9ff192..b3c366b9 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -16,11 +16,13 @@ mod projection; mod representation; mod scalar; mod source_abi; +pub mod state; mod verify; pub(crate) use source_abi::abstract_signature; use layout::{aggregate_type_ids, declaration_shape, enum_type_ids, type_layout}; +pub(crate) use layout::{checked_function_arrow_parameters, is_callable_type}; use lower::{GeneratedSymbolAllocator, LoweringContext, lower_function}; pub use crate::types::ValueId; @@ -107,6 +109,12 @@ pub enum AssignmentKind { signature: SignatureId, arguments: Vec, }, + /// A checked source runner supplies and discharges one logical root. + StateExecution { + operation: psrs_hir::StateOperation, + function: ValueId, + signature: SignatureId, + }, ClosureGetCapture { closure: ValueId, index: u32, @@ -361,6 +369,59 @@ pub(crate) fn lower_module_with_relations( projection, }); } + for binding in &bindings.runtime { + let type_id = binding.type_id.ok_or_else(|| { + vec![ + BackendError::invalid_ir( + "P8 closure conversion", + binding.span, + "runtime binding has no checked source scheme", + ) + .with_module(binding.source_module), + ] + })?; + let signature = layout::function_signature( + &module, + type_id, + &enum_types, + &aggregate_types, + &newtype_ids, + &layout.array_types, + &layout.record_types, + &layout.function_types, + ) + .map_err(|errors| { + errors + .into_iter() + .map(|error| error.with_module(binding.source_module)) + .collect::>() + })?; + state::StateCallProjection::checked(&signature, &layout.representations) + .map_err(|message| { + vec![ + BackendError::invalid_ir("P8 closure conversion", binding.span, message) + .with_module(binding.source_module), + ] + })? + .ok_or_else(|| { + vec![ + BackendError::invalid_ir( + "P8 closure conversion", + binding.span, + "runtime binding lost its logical State contract", + ) + .with_module(binding.source_module), + ] + })?; + let signature = + crate::bindings::runtime_cc_signature(binding, &signature, &layout.representations)?; + signatures.insert(binding.symbol, signature.clone()); + externals.push(External { + symbol: binding.symbol, + signature: Some(signature), + projection: None, + }); + } let mut functions = Vec::with_capacity(module.declarations.len()); let generated_symbols = Rc::new(RefCell::new(GeneratedSymbolAllocator::new(&module))); let function_wrappers = module diff --git a/crates/psrs-backend/src/cc/payload.rs b/crates/psrs-backend/src/cc/payload.rs index 94d0dad7..5b63d568 100644 --- a/crates/psrs-backend/src/cc/payload.rs +++ b/crates/psrs-backend/src/cc/payload.rs @@ -8,6 +8,45 @@ use super::{ use crate::BackendError; use psrs_span::TextRange; +/// Project a checked field through the same owner protocol as payload erasure. +/// Retain semantic aggregate structure when its physical slot is only eqref. +pub(crate) fn stored_guest_layout( + field: &super::Field, + table: &RepresentationTable, +) -> Option { + use super::{Field, GuestLayout}; + if field.stored != erased_shape() { + return super::guest_layout(field.stored, table); + } + Some(match &field.value { + GuestLayout::Scalar { .. } | GuestLayout::Boxed { .. } => GuestLayout::Scalar { + shape: erased_shape(), + }, + GuestLayout::Product { labels, fields, .. } => GuestLayout::Product { + repr: super::layout::protocols::record(table, labels)?, + labels: labels.clone(), + fields: fields + .iter() + .map(|field| Field { + value: field.value.clone(), + stored: erased_shape(), + }) + .collect(), + }, + GuestLayout::Array { repr, element } => { + if !matches!(table.representation(*repr), Some(super::Representation::Array { element }) if *element == erased_shape()) + { + return None; + } + GuestLayout::Array { + repr: *repr, + element: element.clone(), + } + } + GuestLayout::Variant { .. } => field.value.clone(), + }) +} + pub(crate) trait PayloadPlanner { fn payload_table(&self) -> &RepresentationTable; fn payload_box(&self, kind: BoxKind) -> Option; @@ -42,6 +81,12 @@ pub(crate) trait PayloadPlanner { return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); } let boxed = match shape { + ValueShape::State => { + return Err(self.payload_error( + span, + "state dependencies require checked logical transport, not payload boxing", + )); + } ValueShape::Integer | ValueShape::Boolean => { self.box_plan(BoxKind::Integer, self.payload_box(BoxKind::Integer), span)? } @@ -77,6 +122,10 @@ pub(crate) trait PayloadPlanner { return self.payload_callable(signature, false, span); } match shape { + ValueShape::State => Err(self.payload_error( + span, + "state dependencies cannot be recovered from a physical payload", + )), ValueShape::Integer | ValueShape::Boolean => self.unbox_plan( BoxKind::Integer, self.payload_box(BoxKind::Integer), @@ -270,7 +319,7 @@ pub(crate) trait PayloadPlanner { } } -fn erased_shape() -> ValueShape { +pub(crate) fn erased_shape() -> ValueShape { ValueShape::Reference(Reference { nullable: false, heap: RefShape::Erased, diff --git a/crates/psrs-backend/src/cc/projection.rs b/crates/psrs-backend/src/cc/projection.rs index 83bd96c7..084346da 100644 --- a/crates/psrs-backend/src/cc/projection.rs +++ b/crates/psrs-backend/src/cc/projection.rs @@ -52,9 +52,21 @@ pub(crate) fn project_external( let Some(type_id) = type_id else { return Ok(None); }; - let Some((parameters, result)) = crate::abi::link::function_parts(module, type_id) else { + let Some((mut parameters, mut result)) = crate::abi::link::function_parts(module, type_id) + else { return Ok(None); }; + // Canonical guest layouts describe the host boundary, while CC signatures + // retain the complete logical dependency call. State and its successor + // never cross that ABI; only ordinary parameters and the payload do. + if parameters + .iter() + .any(|ty| psrs_core::state::region(module, *ty).is_some()) + { + let step = psrs_core::state::signature(module, type_id).map_err(str::to_owned)?; + parameters = step.parameters; + result = step.payload; + } let projector = Projector { module, record_types, diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index 059eccb5..1cb8485a 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -33,6 +33,9 @@ pub struct Reference { /// handles, or another target representation. #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub enum ValueShape { + /// A logical sequencing dependency with no physical payload. Checked Core + /// owns nominal region agreement; CC must retain producer/use provenance. + State, Integer, Boolean, Number, diff --git a/crates/psrs-backend/src/cc/state/branches.rs b/crates/psrs-backend/src/cc/state/branches.rs new file mode 100644 index 00000000..5e46c6f1 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/branches.rs @@ -0,0 +1,152 @@ +use super::*; +use psrs_core::state::dependency::Edge; + +impl<'a> Builder<'a, '_> { + #[allow(clippy::too_many_arguments)] + pub(super) fn branches( + &mut self, + assignment: &Assignment, + then_assignments: &'a [Assignment], + then_value: ValueId, + else_assignments: &'a [Assignment], + else_value: ValueId, + path: &mut Path, + ) -> Result> { + self.alternatives( + assignment, + &[ + (then_assignments, then_value), + (else_assignments, else_value), + ], + false, + path, + ) + } + + pub(super) fn alternatives( + &mut self, + assignment: &Assignment, + arms: &[(&'a [Assignment], ValueId)], + multiway: bool, + path: &mut Path, + ) -> Result> { + let before = path.clone(); + let before_current = before.current; + let mut paths = Vec::new(); + let mut values = Vec::new(); + let mut edges = Vec::new(); + for &(assignments, result) in arms { + let parameter = self.fresh(); + let block = self.blocks.len(); + self.blocks.push(Block { + id: block as u32, + parameters: if self.state_root { + vec![Dependency { + id: parameter, + region: RegionId(0), + }] + } else { + Vec::new() + }, + transitions: Vec::new(), + terminator: Terminator::Trap, + span: assignment.span, + }); + edges.push(Edge { + target: block as u32, + arguments: if self.state_root { + vec![before.current] + } else { + Vec::new() + }, + }); + let mut branch = before.clone(); + branch.block = block; + branch.current = parameter; + for value in branch.values.values_mut() { + value.remap(before.current, parameter); + } + self.assignments(assignments, &mut branch)?; + if !branch.terminated { + values.push(self.value(&branch, result)); + paths.push(branch); + } + } + self.blocks[before.block].terminator = if multiway { + Terminator::Switch { + default_edge: edges.pop().expect("a switch always has a default arm"), + case_edges: edges, + } + } else { + Terminator::Branch { + then_edge: edges.remove(0), + else_edge: edges.remove(0), + } + }; + if paths.is_empty() { + path.terminated = true; + return Ok(Value::Opaque); + } + let parameter = self.fresh(); + let join = self.blocks.len(); + self.blocks.push(Block { + id: join as u32, + parameters: if self.state_root { + vec![Dependency { + id: parameter, + region: RegionId(0), + }] + } else { + Vec::new() + }, + transitions: Vec::new(), + terminator: Terminator::Trap, + span: assignment.span, + }); + let pure = paths + .iter() + .all(|branch| branch.revision == before.revision); + for (branch, value) in paths.iter().zip(&mut values) { + self.blocks[branch.block].terminator = Terminator::Jump(Edge { + target: join as u32, + arguments: if self.state_root { + vec![branch.current] + } else { + Vec::new() + }, + }); + value.remap(branch.current, parameter); + } + *path = before; + path.block = join; + path.current = parameter; + path.revision = paths.iter().map(|branch| branch.revision).max().unwrap(); + if pure { + // Only the dependency current before this choice remains an alias + // after a pure join. Earlier observable predecessors stay stale. + for value in path.values.values_mut() { + value.remap(before_current, parameter); + } + } + let mut value = values.remove(0); + for other in values { + value = merge(value, other); + } + Ok(value) + } +} + +fn merge(left: Value, right: Value) -> Value { + match (left, right) { + (Value::Product(left), Value::Product(right)) if left.len() == right.len() => { + Value::Product( + left.into_iter() + .zip(right) + .map(|(left, right)| merge(left, right)) + .collect(), + ) + } + (left, right) if left == right => left, + _ => Value::Opaque, + } +} diff --git a/crates/psrs-backend/src/cc/state/eval.rs b/crates/psrs-backend/src/cc/state/eval.rs new file mode 100644 index 00000000..c2329e6e --- /dev/null +++ b/crates/psrs-backend/src/cc/state/eval.rs @@ -0,0 +1,314 @@ +use super::*; +use crate::cc::{AssignmentKind, ValueConversion}; + +pub(super) fn function<'a>( + module: &'a Module, + function: &'a Function, + signatures: &HashMap, + passthrough: &HashSet, +) -> Result>, Vec> { + let shapes = function + .values + .iter() + .map(|value| (value.id, value.ty)) + .collect::>(); + let roots = function + .parameters + .iter() + .filter(|id| shapes[id] == ValueShape::State) + .copied() + .collect::>(); + let state_root = !roots.is_empty(); + let has_state = shapes.values().any(|shape| *shape == ValueShape::State); + if !has_state && !execution::contains(&function.assignments) { + return Ok(None); + } + if (has_state && roots.len() != 1) || roots.len() > 1 { + return Err(error( + function, + "CC state body requires one checked dependency parameter", + )); + } + if state_root { + StateCallProjection::checked(&signatures[&function.symbol], &module.representations) + .map_err(|message| error(function, message))?; + } + let input = DependencyId(0); + let mut builder = Builder { + module, + function, + signatures, + passthrough, + shapes, + state_root, + executions: Vec::new(), + next: 1, + operations: Vec::new(), + passthrough_safe: true, + blocks: vec![Block { + id: 0, + parameters: if state_root { + vec![Dependency { + id: input, + region: RegionId(0), + }] + } else { + Vec::new() + }, + transitions: Vec::new(), + terminator: Terminator::Trap, + span: function.span, + }], + }; + let mut path = Path { + block: 0, + current: input, + revision: 0, + values: roots + .first() + .map(|id| HashMap::from([(*id, Value::State(input))])) + .unwrap_or_default(), + terminated: false, + }; + builder.assignments(&function.assignments, &mut path)?; + if !path.terminated { + let mut returned = Vec::new(); + builder.value(&path, function.result).states(&mut returned); + let expected = if state_root { + vec![path.current] + } else { + Vec::new() + }; + if returned != expected { + return Err(error( + function, + "CC state return loses or replays an executed dependency", + )); + } + builder.blocks[path.block].terminator = Terminator::Return(returned); + } + let graph = Graph { + entry: 0, + regions: if state_root { + vec![RegionId(0)] + } else { + Vec::new() + }, + blocks: builder.blocks, + }; + graph.verify().map_err(|err| { + vec![ + BackendError::invalid_ir("P8 CC state verification", err.span, err.message) + .with_module(function.symbol.module), + ] + })?; + Ok(Some(FunctionFlow { + source: module, + function, + graph, + operations: builder.operations, + executions: builder.executions, + passthrough_safe: builder.passthrough_safe, + })) +} + +impl<'a> Builder<'a, '_> { + pub(super) fn assignments( + &mut self, + assignments: &'a [Assignment], + path: &mut Path, + ) -> Result<(), Vec> { + for assignment in assignments { + if path.terminated { + break; + } + let value = match &assignment.kind { + AssignmentKind::StateExecution { signature, .. } => { + self.execution(assignment, *signature)? + } + AssignmentKind::ProductNew { arguments, .. } => { + Value::Product(arguments.iter().map(|id| self.value(path, *id)).collect()) + } + AssignmentKind::ProductGet { value, field, .. } => match self.value(path, *value) { + Value::Product(fields) => fields + .get(*field as usize) + .cloned() + .unwrap_or(Value::Opaque), + _ => Value::Opaque, + }, + AssignmentKind::FunctionRef { function, .. } => Value::Closure(*function), + AssignmentKind::DirectCall { + function, + arguments, + } => { + let signature = self.signatures.get(function).ok_or_else(|| { + error( + self.function, + "CC state invocation has no checked call signature", + ) + })?; + self.call( + assignment, + arguments, + signature, + self.passthrough.contains(function), + path, + )? + } + AssignmentKind::IndirectCall { + function, + signature, + arguments, + } => { + let signature = self + .module + .representations + .signature(*signature) + .ok_or_else(|| { + error( + self.function, + "CC state invocation has no checked closure signature", + ) + })?; + let pure = matches!(self.value(path, *function), Value::Closure(symbol) + if self.passthrough.contains(&symbol)); + self.call(assignment, arguments, signature, pure, path)? + } + AssignmentKind::If { + then_assignments, + then_value, + else_assignments, + else_value, + .. + } => self.branches( + assignment, + then_assignments, + *then_value, + else_assignments, + *else_value, + path, + )?, + AssignmentKind::TagSwitch { cases, default_assignments, default_value, .. } => { + let mut arms = cases.iter().map(|case| (case.assignments.as_slice(), case.value)).collect::>(); + arms.push((default_assignments.as_slice(), *default_value)); + self.alternatives(assignment, &arms, true, path)? + } + AssignmentKind::AggregateConvert { + value, conversion, .. + } => Self::convert(self.value(path, *value), &conversion.plan), + AssignmentKind::Unreachable => { + path.terminated = true; + self.blocks[path.block].terminator = Terminator::Trap; + Value::Opaque + } + AssignmentKind::Constant(_) + | AssignmentKind::NumberConstant(_) + | AssignmentKind::StringConstant(_) + | AssignmentKind::Primitive { .. } + | AssignmentKind::Unary { .. } + | AssignmentKind::ClosureGetCapture { .. } + // Construction preserves the incoming State. This summary + // does not erase allocation effects or authorize call CSE. + | AssignmentKind::ArrayNew { .. } + | AssignmentKind::VariantNew { .. } + | AssignmentKind::VariantTag { .. } + | AssignmentKind::VariantGet { .. } => Value::Opaque, + _ => { + self.passthrough_safe = false; + Value::Opaque + } + }; + if self.shapes[&assignment.destination] == ValueShape::State + && !matches!(value, Value::State(_)) + && !path.terminated + { + return Err(error( + self.function, + "CC state value has no checked instruction producer", + )); + } + path.values.insert(assignment.destination, value); + } + Ok(()) + } + + fn call( + &mut self, + assignment: &'a Assignment, + arguments: &[ValueId], + signature: &Signature, + pure: bool, + path: &mut Path, + ) -> Result> { + let Some(projection) = + StateCallProjection::checked(signature, &self.module.representations) + .map_err(|message| error(self.function, message))? + else { + self.passthrough_safe = false; + return Ok(Value::Opaque); + }; + let input_value = arguments.get(projection.state_parameter).ok_or_else(|| { + error( + self.function, + "CC state invocation is missing its dependency operand", + ) + })?; + let Value::State(input) = self.value(path, *input_value) else { + return Err(error( + self.function, + "CC state invocation has no checked operand provenance", + )); + }; + if input != path.current { + return Err(error( + self.function, + "CC state invocation consumes a stale dependency", + )); + } + let output = if pure { + input + } else { + self.passthrough_safe = false; + let output = self.fresh(); + let operation = self.operations.len() as u32; + self.operations.push(Operation { + assignment, + input, + output, + }); + self.blocks[path.block].transitions.push(Transition { + operation, + input, + output: Dependency { + id: output, + region: RegionId(0), + }, + span: assignment.span, + }); + path.current = output; + path.revision += 1; + output + }; + let mut fields = vec![Value::Opaque; 2]; + fields[projection.state_field] = Value::State(output); + Ok(Value::Product(fields)) + } + + fn convert(value: Value, plan: &ValueConversion) -> Value { + match plan { + ValueConversion::Identity => value, + ValueConversion::ProductMap { fields: plans, .. } => match value { + Value::Product(fields) if fields.len() == plans.len() => Value::Product( + fields + .into_iter() + .zip(plans) + .map(|(field, plan)| Self::convert(field, plan)) + .collect(), + ), + _ => Value::Opaque, + }, + ValueConversion::Sequence(plans) => plans.iter().fold(value, Self::convert), + _ => Value::Opaque, + } + } +} diff --git a/crates/psrs-backend/src/cc/state/execution.rs b/crates/psrs-backend/src/cc/state/execution.rs new file mode 100644 index 00000000..65f6f514 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/execution.rs @@ -0,0 +1,84 @@ +//! Closed execution roots belong to explicit checked runner instructions. +use super::*; +use crate::cc::{AssignmentKind, RepresentationTable, SignatureId}; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ClosedExecution<'a> { + pub assignment: &'a Assignment, + pub graph: Graph, +} + +pub fn execution_projection( + signature: SignatureId, + table: &RepresentationTable, +) -> Result { + let signature = table + .signature(signature) + .ok_or("state execution has no checked callable signature")?; + let plan = StateCallProjection::checked(signature, table)? + .ok_or("state execution requires a State-to-Step callable")?; + if plan.state_parameter != 0 { + return Err("state execution requires an action without ordinary parameters"); + } + Ok(plan) +} + +pub(super) fn contains(assignments: &[Assignment]) -> bool { + assignments.iter().any(|assignment| match &assignment.kind { + AssignmentKind::StateExecution { .. } => true, + AssignmentKind::If { + then_assignments, + else_assignments, + .. + } => contains(then_assignments) || contains(else_assignments), + AssignmentKind::TagSwitch { + cases, + default_assignments, + .. + } => contains(default_assignments) || cases.iter().any(|case| contains(&case.assignments)), + _ => false, + }) +} + +impl<'a> Builder<'a, '_> { + pub(super) fn execution( + &mut self, + assignment: &'a Assignment, + signature: SignatureId, + ) -> Result> { + execution_projection(signature, &self.module.representations) + .map_err(|message| error(self.function, message))?; + // Each instruction owns a separate graph namespace. Its explicit + // boundary supplies the root; no State value or integer literal exists. + let input = DependencyId(0); + let output = DependencyId(1); + let graph = Graph { + entry: 0, + regions: vec![RegionId(0)], + blocks: vec![Block { + id: 0, + parameters: vec![Dependency { + id: input, + region: RegionId(0), + }], + transitions: vec![Transition { + operation: 0, + input, + output: Dependency { + id: output, + region: RegionId(0), + }, + span: assignment.span, + }], + terminator: Terminator::Return(vec![output]), + span: assignment.span, + }], + }; + graph + .verify() + .map_err(|failure| error(self.function, failure.message))?; + self.executions.push(ClosedExecution { assignment, graph }); + self.passthrough_safe = false; + Ok(Value::Opaque) + } +} diff --git a/crates/psrs-backend/src/cc/state/mod.rs b/crates/psrs-backend/src/cc/state/mod.rs new file mode 100644 index 00000000..2265c848 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/mod.rs @@ -0,0 +1,221 @@ +//! Dependencies derived from actual typed CC instructions, before physical +//! projection. Nominal source-region checking is discharged by checked Core; +//! these single-root function graphs retain local dependency provenance. +use super::{Assignment, Function, Module, Signature, ValueId, ValueShape}; +use crate::BackendError; +use psrs_core::state::dependency::{ + Block, Dependency, DependencyId, Graph, RegionId, Terminator, Transition, +}; +use psrs_hir::SymbolId; +use std::collections::{HashMap, HashSet}; + +mod branches; +mod execution; +pub use execution::{ClosedExecution, execution_projection}; +mod eval; +mod projection; +pub use projection::StateCallProjection; +pub(crate) use projection::register_payload_slots; +#[cfg(test)] +mod tests; + +#[derive(Debug)] +pub struct Operation<'a> { + pub assignment: &'a Assignment, + pub input: DependencyId, + pub output: DependencyId, +} + +#[derive(Debug)] +pub struct FunctionFlow<'a> { + source: &'a Module, + pub function: &'a Function, + pub graph: Graph, + pub operations: Vec>, + pub executions: Vec>, + passthrough_safe: bool, +} + +/// Ordinary CC typing and scope verification precede dependency publication. +pub fn check(module: &Module) -> Result>, Vec> { + super::verify::verify_module(module)?; + derive_all(module) +} + +impl FunctionFlow<'_> { + pub fn verify(&self, module: &Module) -> Result<(), Vec> { + if !std::ptr::eq(self.source, module) { + return Err(error( + self.function, + "CC state flow belongs to a different module", + )); + } + let flows = derive_all(module)?; + let expected = flows + .iter() + .find(|flow| std::ptr::eq(flow.function, self.function)) + .ok_or_else(|| error(self.function, "CC state flow has no owning function"))?; + if self.executions != expected.executions + || self.graph != expected.graph + || self.operations.len() != expected.operations.len() + || self + .operations + .iter() + .zip(&expected.operations) + .any(|(actual, expected)| { + !std::ptr::eq(actual.assignment, expected.assignment) + || actual.input != expected.input + || actual.output != expected.output + }) + { + return Err(error( + self.function, + "CC state flow changes instruction provenance or control flow", + )); + } + Ok(()) + } +} + +pub(crate) fn derive_all(module: &Module) -> Result>, Vec> { + let signatures = module + .functions + .iter() + .map(|function| { + let shapes = function + .values + .iter() + .map(|value| (value.id, value.ty)) + .collect::>(); + let parameters = function + .parameters + .iter() + .map(|id| { + shapes.get(id).copied().ok_or_else(|| { + error( + function, + "CC state verification parameter has no value declaration", + ) + }) + }) + .collect::, _>>()?; + Ok(( + function.symbol, + Signature { + parameters, + result: function.result_type, + }, + )) + }) + .collect::, Vec>>()? + .into_iter() + .chain(module.externals.iter().filter_map(|external| { + external + .signature + .clone() + .map(|signature| (external.symbol, signature)) + })) + .collect::>(); + // Least fixed point: unknown and recursive calls stay observable. Only + // checked bodies returning the incoming dependency authorize aliases. This + // is a State summary, not a general purity or allocation-effect summary. + let mut passthrough = HashSet::new(); + loop { + let mut flows = Vec::new(); + let mut errors = Vec::new(); + for function in &module.functions { + match eval::function(module, function, &signatures, &passthrough) { + Ok(Some(flow)) => flows.push(flow), + Ok(None) => {} + Err(error) => errors.extend(error), + } + } + let mut changed = false; + for flow in &flows { + if flow.passthrough_safe && flow.operations.is_empty() { + changed |= passthrough.insert(flow.function.symbol); + } + } + if !changed { + return if errors.is_empty() { + Ok(flows) + } else { + Err(errors) + }; + } + } +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC state verification", function.span, message) + .with_module(function.symbol.module), + ] +} + +#[derive(Clone, Debug, PartialEq, Eq)] +enum Value { + Opaque, + State(DependencyId), + Product(Vec), + Closure(SymbolId), +} + +impl Value { + fn remap(&mut self, from: DependencyId, to: DependencyId) { + match self { + Self::State(id) if *id == from => *id = to, + Self::Product(fields) => { + for field in fields { + field.remap(from, to); + } + } + _ => {} + } + } + fn states(&self, result: &mut Vec) { + match self { + Self::State(id) => result.push(*id), + Self::Product(fields) => { + for field in fields { + field.states(result); + } + } + _ => {} + } + } +} + +#[derive(Clone)] +struct Path { + block: usize, + current: DependencyId, + revision: u32, + values: HashMap, + terminated: bool, +} + +struct Builder<'a, 'b> { + module: &'a Module, + function: &'a Function, + signatures: &'b HashMap, + passthrough: &'b HashSet, + shapes: HashMap, + state_root: bool, + executions: Vec>, + next: u32, + blocks: Vec, + operations: Vec>, + passthrough_safe: bool, +} + +impl Builder<'_, '_> { + fn fresh(&mut self) -> DependencyId { + let id = DependencyId(self.next); + self.next += 1; + id + } + fn value(&self, path: &Path, id: ValueId) -> Value { + path.values.get(&id).cloned().unwrap_or(Value::Opaque) + } +} diff --git a/crates/psrs-backend/src/cc/state/projection/conversion.rs b/crates/psrs-backend/src/cc/state/projection/conversion.rs new file mode 100644 index 00000000..6974f79c --- /dev/null +++ b/crates/psrs-backend/src/cc/state/projection/conversion.rs @@ -0,0 +1,55 @@ +use super::*; +use crate::cc::{AggregateConvert, ValueConversion}; + +impl StateCallProjection { + /// Projects a checked Step map to its payload conversion. The surrounding + /// dependency checker must separately prove that the State field is current. + pub fn payload_conversion( + conversion: &AggregateConvert, + table: &RepresentationTable, + ) -> Result { + let read = |result| { + Self::checked( + &Signature { + parameters: vec![ValueShape::State], + result, + }, + table, + )? + .ok_or("Step conversion has no logical dependency field") + }; + let source = read(conversion.source)?; + let target = read(conversion.destination)?; + let plan = match &conversion.plan { + ValueConversion::Identity if conversion.source == conversion.destination => { + ValueConversion::Identity + } + ValueConversion::ProductMap { + source: from, + target: to, + fields, + .. + } if conversion.source == product(*from) + && conversion.destination == product(*to) + && source.state_field == target.state_field + && fields.len() == 2 + && fields[source.state_field] == ValueConversion::Identity => + { + fields[source.payload_field].clone() + } + _ => return Err("Step conversion requires checked payload transport"), + }; + Ok(AggregateConvert { + source: source.payload, + destination: target.payload, + plan, + }) + } +} + +fn product(id: crate::cc::ReprId) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(id), + }) +} diff --git a/crates/psrs-backend/src/cc/state/projection/mod.rs b/crates/psrs-backend/src/cc/state/projection/mod.rs new file mode 100644 index 00000000..2b0e5004 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/projection/mod.rs @@ -0,0 +1,82 @@ +//! Shared logical call boundary for dependency verification and P9 projection. +use crate::cc::{RefShape, Reference, Representation, RepresentationTable, Signature, ValueShape}; + +mod conversion; +mod slots; +pub(crate) use slots::register_payload_slots; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct StateCallProjection { + pub state_parameter: usize, + pub state_field: usize, + pub payload_field: usize, + pub payload: ValueShape, +} + +impl StateCallProjection { + /// This describes slots only. Removing them still requires checked body, + /// invocation and CFG correspondence; a signature does not prove ordering. + pub fn checked( + signature: &Signature, + table: &RepresentationTable, + ) -> Result, &'static str> { + let states = signature + .parameters + .iter() + .enumerate() + .filter_map(|(index, shape)| (*shape == ValueShape::State).then_some(index)) + .collect::>(); + if states.is_empty() { + return Ok(None); + } + if states != [signature.parameters.len() - 1] { + return Err("CC state invocation requires exactly one final dependency parameter"); + } + let ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(id), + }) = signature.result + else { + return Err("CC state invocation requires a non-null Step product"); + }; + let Some(Representation::Product { fields }) = table.representation(id) else { + return Err("CC state invocation result is not a checked product"); + }; + if fields.len() != 2 + || fields + .iter() + .filter(|shape| **shape == ValueShape::State) + .count() + != 1 + { + return Err("CC Step requires one successor and one payload field"); + } + let state_field = fields + .iter() + .position(|shape| *shape == ValueShape::State) + .unwrap(); + let payload_field = 1 - state_field; + Ok(Some(Self { + state_parameter: states[0], + state_field, + payload_field, + payload: fields[payload_field], + })) + } + + pub fn physical_signature( + signature: &Signature, + table: &RepresentationTable, + ) -> Result { + let Some(plan) = Self::checked(signature, table)? else { + return Ok(signature.clone()); + }; + Ok(Signature { + parameters: signature.parameters[..plan.state_parameter].to_vec(), + result: plan.payload, + }) + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/cc/state/projection/slots.rs b/crates/psrs-backend/src/cc/state/projection/slots.rs new file mode 100644 index 00000000..9fd476a9 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/projection/slots.rs @@ -0,0 +1,96 @@ +//! Canonical terminal payload slots; planning registers them before lowering. +use super::*; +use crate::cc::{ReprId, SignatureId}; + +type StepRequirement = (Representation, Option>); + +impl StateCallProjection { + fn slot_requirement( + &self, + signature: &Signature, + table: &RepresentationTable, + ) -> Result { + let ValueShape::Reference(Reference { + heap: RefShape::Repr(source), + .. + }) = signature.result + else { + return Err("State payload slot has no checked Step representation"); + }; + let mut fields = vec![crate::cc::payload::erased_shape(); 2]; + fields[self.state_field] = ValueShape::State; + Ok(( + Representation::Product { fields }, + table.product_labels(source).map(<[String]>::to_vec), + )) + } + + pub(crate) fn payload_slot_signature( + &self, + signature: &Signature, + table: &RepresentationTable, + ) -> Result { + let (requirement, labels) = self.slot_requirement(signature, table)?; + let target = table + .representations + .iter() + .enumerate() + .find(|(index, value)| { + **value == requirement + && table.product_labels(ReprId(*index as u32)) == labels.as_deref() + }) + .map(|(index, _)| ReprId(index as u32)) + .ok_or("State payload slot has no registered Step protocol")?; + let signature = Signature { + parameters: vec![ValueShape::State], + result: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(target), + }), + }; + table + .signatures + .iter() + .position(|value| *value == signature) + .map(|index| SignatureId(index as u32)) + .ok_or("State payload slot has no registered callable protocol") + } +} + +pub(crate) fn register_payload_slots(table: &mut RepresentationTable) { + for signature in table.signatures.clone() { + let Ok(Some(projection)) = StateCallProjection::checked(&signature, table) else { + continue; + }; + let (requirement, labels) = projection + .slot_requirement(&signature, table) + .expect("checked Step has a representation"); + let target = table + .representations + .iter() + .enumerate() + .find(|(index, value)| { + **value == requirement + && table.product_labels(ReprId(*index as u32)) == labels.as_deref() + }) + .map(|(index, _)| ReprId(index as u32)); + let target = target.unwrap_or_else(|| { + let id = table.reserve(); + table.set(id, requirement); + if let Some(labels) = labels { + table.set_product_labels(id, labels); + } + id + }); + let slot = Signature { + parameters: vec![ValueShape::State], + result: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(target), + }), + }; + if !table.signatures.contains(&slot) { + table.add_signature(slot); + } + } +} diff --git a/crates/psrs-backend/src/cc/state/projection/tests.rs b/crates/psrs-backend/src/cc/state/projection/tests.rs new file mode 100644 index 00000000..225fb3d8 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/projection/tests.rs @@ -0,0 +1,175 @@ +use super::*; +use crate::cc::ReprId; + +fn boundary(fields: Vec) -> (Signature, RepresentationTable) { + let mut table = RepresentationTable::default(); + table + .representations + .push(Representation::Product { fields }); + let signature = Signature { + parameters: vec![ValueShape::Integer, ValueShape::State], + result: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(0)), + }), + }; + (signature, table) +} + +#[test] +fn projects_logical_slots_without_assuming_product_field_order() { + for state_field in 0..2 { + let mut fields = vec![ValueShape::Number; 2]; + fields[state_field] = ValueShape::State; + let (signature, table) = boundary(fields); + let before = table.clone(); + let plan = StateCallProjection::checked(&signature, &table) + .unwrap() + .unwrap(); + assert_eq!(plan.state_parameter, 1); + assert_eq!(plan.state_field, state_field); + assert_eq!(plan.payload_field, 1 - state_field); + assert_eq!( + StateCallProjection::physical_signature(&signature, &table).unwrap(), + Signature { + parameters: vec![ValueShape::Integer], + result: ValueShape::Number, + } + ); + assert_eq!(table, before); + } +} + +#[test] +fn nullary_projection_keeps_a_call_boundary() { + let (mut signature, table) = boundary(vec![ValueShape::State, ValueShape::Integer]); + signature.parameters.remove(0); + let projected = StateCallProjection::physical_signature(&signature, &table).unwrap(); + assert!(projected.parameters.is_empty()); + assert_eq!(projected.result, ValueShape::Integer); + assert!( + StateCallProjection::checked(&signature, &table) + .unwrap() + .is_some() + ); +} + +#[test] +fn rejects_malformed_state_boundaries() { + let (signature, table) = boundary(vec![ValueShape::State, ValueShape::Integer]); + for parameters in [ + vec![ValueShape::State, ValueShape::Integer], + vec![ValueShape::State, ValueShape::State], + ] { + let mut malformed = signature.clone(); + malformed.parameters = parameters; + assert!(StateCallProjection::checked(&malformed, &table).is_err()); + } + for fields in [ + vec![ValueShape::Integer], + vec![ValueShape::State, ValueShape::State], + vec![ValueShape::State, ValueShape::Integer, ValueShape::Number], + ] { + let (malformed, table) = boundary(fields); + assert!(StateCallProjection::checked(&malformed, &table).is_err()); + } + let mut nullable = signature; + if let ValueShape::Reference(reference) = &mut nullable.result { + reference.nullable = true; + } + assert!(StateCallProjection::checked(&nullable, &table).is_err()); +} + +#[test] +fn ordinary_signatures_preserve_their_calling_convention() { + let signature = Signature { + parameters: vec![ValueShape::Integer], + result: ValueShape::Number, + }; + assert_eq!( + StateCallProjection::physical_signature(&signature, &RepresentationTable::default()) + .unwrap(), + signature + ); +} + +#[test] +fn step_maps_keep_payload_boxing_and_reject_state_conversion() { + use crate::cc::{AggregateConvert, BoxKind, ValueConversion as C}; + let (signature, mut table) = boundary(vec![ValueShape::State, ValueShape::Integer]); + let erased = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }); + table.representations.push(Representation::Product { + fields: vec![ValueShape::State, erased], + }); + table.representations.push(Representation::Box { + value: ValueShape::Integer, + }); + let payload = C::Sequence(vec![ + C::BoxScalar { + kind: BoxKind::Integer, + representation: ReprId(2), + }, + C::EraseReference, + ]); + let mut conversion = AggregateConvert { + source: signature.result, + destination: ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(1)), + }), + plan: C::ProductMap { + source: ReprId(0), + target: ReprId(1), + labels: vec!["state".into(), "value".into()], + fields: vec![C::Identity, payload.clone()], + }, + }; + assert_eq!( + StateCallProjection::payload_conversion(&conversion, &table).unwrap(), + AggregateConvert { + source: ValueShape::Integer, + destination: erased, + plan: payload + } + ); + if let C::ProductMap { fields, .. } = &mut conversion.plan { + fields[0] = C::EraseReference; + } + assert!(StateCallProjection::payload_conversion(&conversion, &table).is_err()); +} + +#[test] +fn payload_slots_are_registered_once_and_preserve_step_field_order() { + for state_field in 0..2 { + let mut fields = vec![ValueShape::Integer; 2]; + fields[state_field] = ValueShape::State; + let (signature, mut table) = boundary(fields); + table.add_signature(signature.clone()); + let projection = StateCallProjection::checked(&signature, &table) + .unwrap() + .unwrap(); + assert!( + projection + .payload_slot_signature(&signature, &table) + .is_err() + ); + super::register_payload_slots(&mut table); + let slot = projection + .payload_slot_signature(&signature, &table) + .unwrap(); + let terminal = table.signature(slot).unwrap(); + assert_eq!(terminal.parameters, vec![ValueShape::State]); + let result = StateCallProjection::checked(terminal, &table) + .unwrap() + .unwrap(); + assert_eq!(result.state_field, state_field); + assert_eq!(result.payload, crate::cc::payload::erased_shape()); + assert_eq!(table.signature(crate::cc::SignatureId(0)), Some(&signature)); + let registered = table.clone(); + super::register_payload_slots(&mut table); + assert_eq!(table, registered); + } +} diff --git a/crates/psrs-backend/src/cc/state/tests.rs b/crates/psrs-backend/src/cc/state/tests.rs new file mode 100644 index 00000000..34f9ab4f --- /dev/null +++ b/crates/psrs-backend/src/cc/state/tests.rs @@ -0,0 +1,388 @@ +use super::*; +use crate::cc::{ + AssignmentKind, External, RefShape, Reference, ReprId, Representation, RepresentationTable, + ValueDecl, +}; +use psrs_hir::ModuleId; +use psrs_span::TextRange; + +fn step_shape() -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(0)), + }) +} +fn assignment(id: u32, kind: AssignmentKind) -> Assignment { + Assignment { + destination: ValueId(id), + kind, + span: TextRange::new(id, id + 1), + } +} +fn call(id: u32, input: u32) -> Assignment { + assignment( + id, + AssignmentKind::DirectCall { + function: SymbolId::new(ModuleId(0), 1), + arguments: vec![ValueId(input)], + }, + ) +} +fn product(id: u32, state: u32, payload: u32) -> Assignment { + assignment( + id, + AssignmentKind::ProductNew { + destination: ValueId(id), + representation: ReprId(0), + arguments: vec![ValueId(state), ValueId(payload)], + }, + ) +} +fn fixture(assignments: Vec, shapes: &[ValueShape], result: u32) -> Module { + let mut representations = RepresentationTable::default(); + representations + .representations + .push(Representation::Product { + fields: vec![ValueShape::State, ValueShape::Integer], + }); + Module { + name: "CCStateBody".into(), + representations, + externals: vec![External { + symbol: SymbolId::new(ModuleId(0), 1), + signature: Some(Signature { + parameters: vec![ValueShape::State], + result: step_shape(), + }), + projection: None, + }], + functions: vec![Function { + symbol: SymbolId::new(ModuleId(0), 0), + name: "action".into(), + parameters: vec![ValueId(0)], + values: shapes + .iter() + .enumerate() + .map(|(index, ty)| ValueDecl { + id: ValueId(index as u32), + ty: *ty, + }) + .collect(), + assignments, + result: ValueId(result), + result_type: shapes[result as usize], + span: TextRange::new(0, 20), + }], + entry: None, + span: TextRange::new(0, 20), + } +} + +#[test] +fn actual_cc_calls_and_field_projections_supply_successor_dependencies() { + let get = assignment( + 2, + AssignmentKind::ProductGet { + destination: ValueId(2), + representation: ReprId(0), + field: 0, + value: ValueId(1), + }, + ); + let module = fixture( + vec![call(1, 0), get, call(3, 2)], + &[ + ValueShape::State, + step_shape(), + ValueShape::State, + step_shape(), + ], + 3, + ); + let flows = check(&module).unwrap(); + let flow = &flows[0]; + assert_eq!(flow.operations.len(), 2); + assert!(std::ptr::eq( + flow.operations[0].assignment, + &module.functions[0].assignments[0] + )); + assert_eq!(flow.operations[1].input, flow.operations[0].output); + flow.verify(&module).unwrap(); + assert!(flow.verify(&module.clone()).is_err()); +} + +#[test] +fn stale_cc_operands_and_returns_are_rejected() { + let replay = fixture( + vec![call(1, 0), call(2, 0)], + &[ValueShape::State, step_shape(), step_shape()], + 2, + ); + assert!( + check(&replay) + .unwrap_err() + .iter() + .any(|error| error.message.contains("stale dependency")) + ); + let stale = fixture( + vec![ + call(1, 0), + assignment(2, AssignmentKind::Constant(42)), + product(3, 0, 2), + ], + &[ + ValueShape::State, + step_shape(), + ValueShape::Integer, + step_shape(), + ], + 3, + ); + assert!( + check(&stale) + .unwrap_err() + .iter() + .any(|error| error.message.contains("return loses")) + ); +} + +#[test] +fn mir_entry_checks_actual_cc_dependencies_before_physical_planning() { + let replay = fixture( + vec![call(1, 0), call(2, 0)], + &[ValueShape::State, step_shape(), step_shape()], + 2, + ); + let bindings = crate::ExternalBindings { + runtime: Vec::new(), + imports: vec![crate::ExternalBinding { + symbol: replay.externals[0].symbol, + source_module: ModuleId(0), + interface: crate::abi::names::STDOUT.into(), + function: crate::abi::names::GET_STDOUT.into(), + type_id: None, + span: replay.span, + }], + }; + let errors = crate::mir::lower_module_with_bindings( + replay, + bindings, + crate::TargetCapabilities::default(), + ) + .err() + .expect("MIR must reject a stale CC invocation"); + assert!( + errors + .iter() + .any(|error| error.message.contains("stale dependency")) + ); + assert!( + !errors + .iter() + .any(|error| error.message.contains("UnprojectedState")) + ); +} + +#[test] +fn dependency_recheck_rejects_missing_operands_and_parameter_metadata() { + let mut module = fixture(vec![call(1, 0)], &[ValueShape::State, step_shape()], 1); + if let AssignmentKind::DirectCall { arguments, .. } = + &mut module.functions[0].assignments[0].kind + { + arguments.clear(); + } + assert!( + derive_all(&module) + .unwrap_err() + .iter() + .any(|error| error.message.contains("missing its dependency operand")) + ); + module.functions[0].values.remove(0); + assert!( + derive_all(&module) + .unwrap_err() + .iter() + .any(|error| error.message.contains("no value declaration")) + ); +} + +#[test] +fn branch_calls_join_the_executed_successor() { + let choice = assignment( + 4, + AssignmentKind::If { + condition: ValueId(1), + then_assignments: vec![call(2, 0)], + then_value: ValueId(2), + else_assignments: vec![call(3, 0)], + else_value: ValueId(3), + }, + ); + let get = assignment( + 5, + AssignmentKind::ProductGet { + destination: ValueId(5), + representation: ReprId(0), + field: 0, + value: ValueId(4), + }, + ); + let module = fixture( + vec![ + assignment(1, AssignmentKind::Constant(1)), + choice, + get, + call(6, 5), + ], + &[ + ValueShape::State, + ValueShape::Boolean, + step_shape(), + step_shape(), + step_shape(), + ValueShape::State, + step_shape(), + ], + 6, + ); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 3); + assert_eq!(flows[0].graph.blocks.len(), 4); + assert_eq!( + flows[0].operations[2].input, + flows[0].graph.blocks[3].parameters[0].id + ); +} + +#[test] +fn a_pure_cc_join_preserves_previously_evaluated_aliases() { + let choice = assignment( + 5, + AssignmentKind::If { + condition: ValueId(1), + then_assignments: vec![product(3, 0, 2)], + then_value: ValueId(3), + else_assignments: vec![product(4, 0, 2)], + else_value: ValueId(4), + }, + ); + let module = fixture( + vec![ + assignment(1, AssignmentKind::Constant(1)), + assignment(2, AssignmentKind::Constant(42)), + choice, + product(6, 0, 2), + ], + &[ + ValueShape::State, + ValueShape::Boolean, + ValueShape::Integer, + step_shape(), + step_shape(), + step_shape(), + step_shape(), + ], + 6, + ); + assert!(check(&module).unwrap()[0].operations.is_empty()); +} + +#[test] +fn pure_call_summaries_come_from_checked_bodies_in_any_declaration_order() { + let mut module = fixture( + vec![ + call(1, 0), + assignment(2, AssignmentKind::Constant(42)), + product(3, 0, 2), + ], + &[ + ValueShape::State, + step_shape(), + ValueShape::Integer, + step_shape(), + ], + 3, + ); + let mut pure = fixture( + vec![ + assignment(1, AssignmentKind::Constant(42)), + product(2, 0, 1), + ], + &[ValueShape::State, ValueShape::Integer, step_shape()], + 2, + ) + .functions + .remove(0); + pure.symbol = SymbolId::new(ModuleId(0), 1); + module.externals.clear(); + module.functions.push(pure); + let flows = check(&module).unwrap(); + assert!(flows.iter().all(|flow| flow.operations.is_empty())); +} + +#[test] +fn a_trapping_cc_branch_has_no_normal_successor() { + let choice = assignment( + 4, + AssignmentKind::If { + condition: ValueId(1), + then_assignments: vec![call(2, 0)], + then_value: ValueId(2), + else_assignments: vec![assignment(3, AssignmentKind::Unreachable)], + else_value: ValueId(3), + }, + ); + let module = fixture( + vec![assignment(1, AssignmentKind::Constant(1)), choice], + &[ + ValueShape::State, + ValueShape::Boolean, + step_shape(), + step_shape(), + step_shape(), + ], + 4, + ); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 1); + assert!( + flows[0] + .graph + .blocks + .iter() + .any(|block| block.terminator == Terminator::Trap) + ); +} + +#[test] +fn state_is_neither_a_fabricated_constant_nor_boxed_payload() { + let mut module = fixture( + vec![assignment(1, AssignmentKind::Constant(0))], + &[ValueShape::State, ValueShape::State], + 1, + ); + assert!(check(&module).is_err()); + module + .representations + .representations + .push(Representation::Box { + value: ValueShape::State, + }); + assert!( + check(&module) + .unwrap_err() + .iter() + .any(|error| error.message.contains("no box or array")) + ); +} + +#[test] +fn source_correspondence_rejects_an_edited_graph() { + let module = fixture(vec![call(1, 0)], &[ValueShape::State, step_shape()], 1); + let mut flows = check(&module).unwrap(); + flows[0].graph.blocks[0].transitions.clear(); + flows[0].operations.clear(); + flows[0].graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(0)]); + flows[0].graph.verify().unwrap(); + assert!(flows[0].verify(&module).is_err()); +} diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 8173a398..49435d7b 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -124,6 +124,7 @@ pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { .collect::>() })?; } + super::state::derive_all(module)?; Ok(()) } diff --git a/crates/psrs-backend/src/cc/verify/ops/aggregate/mod.rs b/crates/psrs-backend/src/cc/verify/ops/aggregate/mod.rs index 0f833623..6b38f07a 100644 --- a/crates/psrs-backend/src/cc/verify/ops/aggregate/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/aggregate/mod.rs @@ -38,7 +38,7 @@ fn verify_plan( table: &RepresentationTable, ) -> Result> { match plan { - ValueConversion::Identity => Ok(source), + ValueConversion::Identity => Ok(plan.output_shape(source)), ValueConversion::BoxScalar { kind, representation, @@ -62,7 +62,7 @@ fn verify_plan( "scalar box plan has incompatible shapes", )); } - Ok(repr_shape(*representation)) + Ok(plan.output_shape(source)) } ValueConversion::UnboxScalar { kind, @@ -86,12 +86,12 @@ fn verify_plan( if *value == ValueShape::Integer && matches!(destination, ValueShape::Integer | ValueShape::Boolean) => { - Ok(*destination) + Ok(plan.output_shape(source)) } BoxKind::Number if *value == ValueShape::Number && *destination == ValueShape::Number => { - Ok(*destination) + Ok(plan.output_shape(source)) } _ => Err(assignment_error( assignment, @@ -110,7 +110,7 @@ fn verify_plan( "reference erasure requires a typed reference", )); } - Ok(erased_shape()) + Ok(plan.output_shape(source)) } ValueConversion::RecoverReference { destination, @@ -177,7 +177,7 @@ fn verify_plan( )); } } - Ok(*destination) + Ok(plan.output_shape(source)) } ValueConversion::FunctionAdapter { source: expected, @@ -201,7 +201,7 @@ fn verify_plan( } super::super::helpers::verify_value_shape(&source, table, assignment.span)?; super::super::helpers::verify_value_shape(destination, table, assignment.span)?; - Ok(*destination) + Ok(plan.output_shape(source)) } ValueConversion::Sequence(plans) => { let mut shape = source; @@ -241,7 +241,7 @@ fn verify_plan( "array map element conversion is invalid", )); } - Ok(repr_shape(*target)) + Ok(plan.output_shape(source)) } ValueConversion::ProductMap { source: source_id, @@ -289,7 +289,7 @@ fn verify_plan( )); } } - Ok(repr_shape(*target)) + Ok(plan.output_shape(source)) } } } diff --git a/crates/psrs-backend/src/cc/verify/ops/execution.rs b/crates/psrs-backend/src/cc/verify/ops/execution.rs new file mode 100644 index 00000000..6fa2c48b --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/ops/execution.rs @@ -0,0 +1,19 @@ +use super::*; + +pub(super) fn verify( + assignment: &Assignment, + function: ValueId, + signature: crate::cc::SignatureId, + declared: &HashMap, + table: &RepresentationTable, +) -> Result<(), Vec> { + let plan = crate::cc::state::execution_projection(signature, table) + .map_err(|message| assignment_error(assignment, message))?; + require_value_shape(declared, function, closure_shape(signature), assignment)?; + require_destination( + declared, + assignment, + plan.payload, + "state execution has an incompatible payload result", + ) +} diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index d5371bf6..3086f244 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -15,6 +15,7 @@ use tag_switch::verify_tag_switch; mod aggregate; mod arrays; +mod execution; mod string_bytes; mod table; mod tag_switch; @@ -198,6 +199,14 @@ pub(super) fn verify_assignments( uses.push(*function); uses.extend(arguments.iter().copied()); } + AssignmentKind::StateExecution { + function, + signature, + .. + } => { + execution::verify(assignment, *function, *signature, declared, table)?; + uses.push(*function); + } AssignmentKind::ClosureGetCapture { closure, .. } => { require_value_shape(declared, *closure, aggregate_shape(), assignment)?; uses.push(*closure); diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index 78d0c089..51dc92dd 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -11,6 +11,12 @@ pub(crate) fn verify_table( for (index, representation) in table.representations.iter().enumerate() { match representation { Representation::Box { value } | Representation::Array { element: value } => { + if *value == crate::cc::ValueShape::State { + return Err(table_error( + span, + "state dependencies have no box or array payload storage", + )); + } verify_value_shape(value, table, span)?; } Representation::Product { fields } => { diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 58290b1d..8e7672de 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -13,7 +13,7 @@ pub mod trace; pub mod types; pub mod wasm; -pub use bindings::{BackendInput, ExternalBinding, ExternalBindings}; +pub use bindings::{BackendInput, ExternalBinding, ExternalBindings, RuntimeBinding}; pub use capability::TargetCapabilities; pub use trace::*; diff --git a/crates/psrs-backend/src/linking/mod.rs b/crates/psrs-backend/src/linking/mod.rs index 0f119684..ccf3d4b9 100644 --- a/crates/psrs-backend/src/linking/mod.rs +++ b/crates/psrs-backend/src/linking/mod.rs @@ -63,6 +63,50 @@ pub(crate) fn plan_for_module( for import in &module.imports { let id = RequirementId(next); next += 1; + if let Some(provider) = &import.runtime { + crate::bindings::verify_runtime_import(import, &module.types).map_err(|message| { + vec![BackendError::invalid_ir( + "P9 target linking", + module.span, + message, + )] + })?; + let operation = (psrs_runtime::STORAGE_UNIT.operations)() + .into_iter() + .find(|operation| operation.export == provider.function) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 target linking", + module.span, + "runtime import has no catalog operation", + )] + })?; + let expected = + crate::wasm::raw_signature(import, &module.types).map_err(|message| { + vec![BackendError::invalid_ir( + "P9 target linking", + module.span, + message, + )] + })?; + let requirement = BindingRequirement { + id, + origin: operation.name.clone(), + boundary: Boundary::RawCore { + module: provider.module.clone(), + field: provider.function.clone(), + }, + expected: Some(expected), + provider: Provider::RuntimeOperation { + name: operation.name, + version: operation.version.into(), + }, + }; + spans.insert(requirement.origin.clone(), (module.span, owner)); + requirements.push(requirement); + symbols.push((import.symbol, id)); + continue; + } if import.symbol == abi::REALLOC_SYMBOL { crate::target_intrinsics::generated::verify(module, import).map_err(|message| { vec![BackendError::invalid_ir( @@ -187,7 +231,8 @@ pub(crate) fn plan_for_module( let input = TargetLinkInput { requirements, - units: psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME), + units: psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME) + .map_err(|errors| map_link_errors(&errors, &spans))?, policy: TargetPolicy { permitted_host_interfaces: permitted_host_interfaces(context, target), }, @@ -332,5 +377,7 @@ fn attach(error: BackendError, owner: Option) -> BackendError { } } +#[cfg(test)] +mod runtime_tests; #[cfg(test)] mod tests; diff --git a/crates/psrs-backend/src/linking/runtime_tests.rs b/crates/psrs-backend/src/linking/runtime_tests.rs new file mode 100644 index 00000000..0c506c99 --- /dev/null +++ b/crates/psrs-backend/src/linking/runtime_tests.rs @@ -0,0 +1,384 @@ +use super::*; +use crate::mir::{ + BasicBlock, BlockId, Function, Import, Instruction as I, RuntimeImport, Terminator, +}; +use crate::types::{ + CompositeType, DefinedType, DefinedTypeId, FieldType, FunctionId, HeapType, RecGroup, RefType, + StorageType, ValueDecl, ValueId, ValueType, +}; + +fn reference(id: u32) -> ValueType { + ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(DefinedTypeId(id)), + }) +} + +fn fixture() -> mir::Module { + let span = TextRange::new(0, 1); + let owner = ModuleId(7); + let symbol = |id| SymbolId::new(owner, id); + let value = |id| ValueId(id); + let eq = ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + }); + let import = |id, function: &str, parameters, result| Import { + symbol: symbol(id), + runtime: Some(RuntimeImport { + module: psrs_runtime::STORAGE_MODULE.into(), + function: function.into(), + }), + parameters, + result, + }; + let types = [ + CompositeType::Struct(vec![FieldType { + mutable: false, + storage: StorageType::I64, + }]), + CompositeType::Array(FieldType { + mutable: true, + storage: StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + }), + }), + CompositeType::Struct(vec![FieldType { + mutable: false, + storage: StorageType::I32, + }]), + ] + .into_iter() + .map(|composite| { + RecGroup(vec![DefinedType { + final_type: true, + supertype: None, + composite, + }]) + }) + .collect(); + let shapes = [ + ValueType::I32, + ValueType::I32, + reference(2), + reference(1), + ValueType::I32, + ValueType::I32, + reference(2), + reference(1), + eq, + reference(2), + ValueType::I32, + eq, + eq, + ]; + let instructions = vec![ + I::Constant { + destination: value(0), + value: 1, + span, + }, + I::Constant { + destination: value(1), + value: 40, + span, + }, + I::StructNew { + destination: value(2), + type_index: DefinedTypeId(2), + arguments: vec![value(1)], + span, + }, + I::RefCast { + destination: value(11), + value: value(2), + reference: RefType { + nullable: true, + heap: HeapType::Eq, + }, + span, + }, + I::Call { + destination: value(3), + function: symbol(11), + arguments: vec![value(0), value(11)], + span, + }, + I::Constant { + destination: value(4), + value: 0, + span, + }, + I::Constant { + destination: value(5), + value: 99, + span, + }, + I::StructNew { + destination: value(6), + type_index: DefinedTypeId(2), + arguments: vec![value(5)], + span, + }, + I::Copy { + destination: value(7), + value: value(3), + span, + }, + I::RefCast { + destination: value(12), + value: value(6), + reference: RefType { + nullable: true, + heap: HeapType::Eq, + }, + span, + }, + I::CallVoid { + function: symbol(12), + arguments: vec![value(3), value(4), value(12)], + span, + }, + I::Call { + destination: value(8), + function: symbol(13), + arguments: vec![value(7), value(4)], + span, + }, + I::RefCast { + destination: value(9), + value: value(8), + reference: RefType { + nullable: false, + heap: HeapType::Index(DefinedTypeId(2)), + }, + span, + }, + I::StructGet { + destination: value(10), + type_index: DefinedTypeId(2), + field: 0, + value: value(9), + span, + }, + ]; + mir::Module { + name: "RuntimeStorageConsumer".into(), + types, + strings: vec![], + imports: vec![ + import( + 11, + "array_fill", + vec![ValueType::I32, eq], + Some(reference(1)), + ), + import( + 12, + "array_write", + vec![reference(1), ValueType::I32, eq], + None, + ), + import( + 13, + "array_read", + vec![reference(1), ValueType::I32], + Some(eq), + ), + ], + functions: vec![Function { + state: None, + id: FunctionId(0), + symbol: symbol(20), + name: "main".into(), + parameters: vec![], + values: shapes + .into_iter() + .enumerate() + .map(|(id, ty)| ValueDecl { + id: value(id as u32), + ty, + }) + .collect(), + entry: BlockId(0), + blocks: vec![BasicBlock { + id: BlockId(0), + parameters: vec![], + instructions, + terminator: Some(Terminator::Return { + value: value(10), + span, + }), + }], + result: value(10), + result_type: ValueType::I32, + span, + }], + entry: Some(symbol(20)), + dependencies: Default::default(), + layout: None, + span, + } +} + +#[test] +fn runtime_import_contracts_are_checked_by_binding_and_linking_owners() { + let module = fixture(); + mir::verify_module(&module).unwrap(); + let context = default_context().unwrap(); + let target = TargetCapabilities::default(); + let mut wasi = WasiRegistry::load().unwrap(); + let plan = plan_for_module(&context, &module, &mut wasi, target).unwrap(); + assert_eq!(plan.plan.artifacts().len(), 1); + assert_eq!( + plan.imports[&module.imports[0].symbol], + (psrs_runtime::STORAGE_MODULE.into(), "array_fill".into()) + ); + for change in 0..6 { + let mut wrong = module.clone(); + let import = &mut wrong.imports[0]; + match change { + 0 => import.runtime.as_mut().unwrap().module = "wrong-provider".into(), + 1 => import.runtime.as_mut().unwrap().function = "array_read".into(), + 2 => import.parameters[0] = ValueType::I64, + 3 => import.result = Some(ValueType::I32), + 4 => { + import.result = Some(ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Index(DefinedTypeId(1)), + })) + } + _ => import.symbol = crate::abi::REALLOC_SYMBOL, + } + // Provider identity is opaque to MIR. Ordinary call typing remains + // checked there, while provider selection belongs to the link boundary. + if change == 0 || change == 1 { + mir::verify_module(&wrong).unwrap(); + } + assert!( + crate::bindings::verify_runtime_import(&wrong.imports[0], &wrong.types).is_err(), + "change {change}" + ); + assert!( + plan_for_module(&context, &wrong, &mut wasi, target).is_err(), + "change {change}" + ); + } + let mut wrong = module.clone(); + wrong.types[1].0[0].final_type = false; + mir::verify_module(&wrong).unwrap(); + assert!( + plan_for_module(&context, &wrong, &mut wasi, target).is_err(), + "linking must compare the actual GC definition with the runtime catalog" + ); +} + +#[test] +fn backend_runtime_storage_imports_compose_and_execute_an_alias_write() { + let mut module = fixture(); + let function = &mut module.functions[0]; + function.values.extend([ + ValueDecl { + id: ValueId(13), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(14), + ty: ValueType::Boolean, + }, + ValueDecl { + id: ValueId(15), + ty: ValueType::I32, + }, + ]); + function.blocks[0].instructions.extend([ + I::Constant { + destination: ValueId(13), + value: 99, + span: module.span, + }, + I::Primitive { + destination: ValueId(14), + op: mir::NumericOp::I32Ne, + left: ValueId(10), + right: ValueId(13), + span: module.span, + }, + I::UnaryPrimitive { + destination: ValueId(15), + op: mir::UnaryOp::BoolToI32, + value: ValueId(14), + span: module.span, + }, + ]); + function.result = ValueId(15); + function.blocks[0].terminator = Some(Terminator::Return { + value: ValueId(15), + span: module.span, + }); + if std::process::Command::new("wasmtime") + .arg("--version") + .output() + .is_err() + { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + } + let target = TargetCapabilities::default(); + let context = default_context().unwrap(); + for expected in [99, 100] { + let instruction = module.functions[0].blocks[0] + .instructions + .iter_mut() + .find(|instruction| { + matches!( + instruction, + I::Constant { + destination: ValueId(13), + .. + } + ) + }) + .unwrap(); + let I::Constant { value, .. } = instruction else { + unreachable!() + }; + *value = expected; + mir::verify_module(&module).unwrap(); + let mut wasi = WasiRegistry::load().unwrap(); + let plan = plan_for_module(&context, &module, &mut wasi, target).unwrap(); + let wasm = crate::wasm::lower_module_with_plan(&module, &mut wasi, target, &plan).unwrap(); + let core = crate::wasm::encode_module(&wasm).unwrap(); + let component = compose( + &plan, + &core, + module.span, + module.entry.map(|entry| entry.module), + ) + .unwrap(); + crate::validator_for(target) + .validate_all(&component) + .unwrap(); + let path = std::env::temp_dir().join(format!( + "psrs-backend-storage-{}-{expected}.wasm", + std::process::id() + )); + std::fs::write(&path, component).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(path).unwrap(); + assert_eq!( + output.status.code(), + Some(i32::from(expected != 99)), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + } +} diff --git a/crates/psrs-backend/src/linking/tests.rs b/crates/psrs-backend/src/linking/tests.rs index ea523bc4..aa8b5802 100644 --- a/crates/psrs-backend/src/linking/tests.rs +++ b/crates/psrs-backend/src/linking/tests.rs @@ -12,6 +12,7 @@ fn module(import: mir::Import) -> mir::Module { strings: vec![], imports: vec![import], functions: vec![], + dependencies: Default::default(), layout: None, span: TextRange::new(0, 1), } diff --git a/crates/psrs-backend/src/mir/binding_tests.rs b/crates/psrs-backend/src/mir/binding_tests.rs index 7e0ae893..55202091 100644 --- a/crates/psrs-backend/src/mir/binding_tests.rs +++ b/crates/psrs-backend/src/mir/binding_tests.rs @@ -54,6 +54,7 @@ fn input(call: bool) -> (cc::Module, ExternalBindings) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external, source_module: ModuleId(0), @@ -163,6 +164,7 @@ fn p9_exposes_an_owned_handle_without_dropping_it() { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/cfg.rs b/crates/psrs-backend/src/mir/cfg.rs index d4c44736..ade19a4e 100644 --- a/crates/psrs-backend/src/mir/cfg.rs +++ b/crates/psrs-backend/src/mir/cfg.rs @@ -11,7 +11,7 @@ use std::collections::{HashMap, HashSet, VecDeque}; /// The successor blocks named by a terminator. pub(crate) fn successors(terminator: &Terminator) -> Vec { match terminator { - Terminator::Return { .. } => Vec::new(), + Terminator::Return { .. } | Terminator::Trap { .. } => Vec::new(), Terminator::Jump { target, .. } => vec![*target], Terminator::Branch { then_block, @@ -87,7 +87,8 @@ pub(crate) fn join_blocks(function: &Function) -> HashSet { .map(|(_, target)| *target) .chain(std::iter::once(*default)) .collect(), - Terminator::Return { .. } + Terminator::Trap { .. } + | Terminator::Return { .. } | Terminator::Jump { .. } | Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => continue, diff --git a/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs b/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs index 9faea64e..f7b92807 100644 --- a/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs @@ -50,7 +50,7 @@ fn verifies_and_executes_every_cc_binary_scalar_variant_on_both_targets() { kind: AssignmentKind::StringConstant("text".into()), span: span(), }), - ValueShape::Reference(_) => unreachable!(), + ValueShape::State | ValueShape::Reference(_) => unreachable!(), } } diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs index 991932dd..b6a4b2da 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs @@ -100,6 +100,7 @@ fn base( span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs index 51302b74..5d8689d7 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs @@ -132,6 +132,7 @@ pub(super) fn fixture_with_representations( span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -269,6 +270,7 @@ pub(super) fn parameter_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs index be513667..c3caccd9 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs @@ -161,6 +161,7 @@ pub(super) fn indirect_aggregate_fixture() -> (cc::Module, ExternalBindings, Res span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs index 4cae5c7c..68b8387d 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs @@ -108,6 +108,7 @@ pub(super) fn large_record_fixture() -> (cc::Module, ExternalBindings, Resolve) span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -214,6 +215,7 @@ pub(super) fn large_unit_result_fixture() -> (cc::Module, ExternalBindings, Reso span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs index 0f4c1557..900378be 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs @@ -85,6 +85,7 @@ fn finish( span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs index cd719ede..e3497762 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs @@ -115,6 +115,7 @@ pub(super) fn nested_variant_fixture() -> (cc::Module, ExternalBindings, Resolve span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -221,6 +222,7 @@ pub(super) fn nested_record_fixture() -> (cc::Module, ExternalBindings, Resolve) span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -380,6 +382,7 @@ pub(super) fn nested_record_parameter_fixture() -> (cc::Module, ExternalBindings span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs index cb7ab113..6de33767 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs @@ -123,6 +123,7 @@ pub(super) fn record_with_aggregate_field_fixture() -> (cc::Module, ExternalBind span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -347,6 +348,7 @@ pub(super) fn record_with_aggregate_field_parameter_fixture() span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs index 4ccfb193..1da0a669 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs @@ -96,6 +96,7 @@ pub(super) fn resource_result_fixture() -> (cc::Module, ExternalBindings, Resolv span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs index ab0a6711..8613be6e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs @@ -107,6 +107,7 @@ pub(super) fn wide_scalar_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -245,6 +246,7 @@ pub(super) fn wide_scalar_parameter_fixture() -> (cc::Module, ExternalBindings, span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs index 8369eca2..c94cba6b 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs @@ -244,6 +244,7 @@ pub(super) fn composite_indirect_fixture() -> (cc::Module, ExternalBindings, Res span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/mod.rs index e5d61c59..1b0dc60c 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/mod.rs @@ -89,6 +89,7 @@ fn indirect_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs index a91166a7..cda24660 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs @@ -119,6 +119,7 @@ pub(crate) fn flags_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -214,6 +215,7 @@ pub(crate) fn handle_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -339,6 +341,7 @@ pub(crate) fn tuple_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -426,6 +429,7 @@ fn handle_result(result: &str) -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs index cb36b0b4..7253bd98 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs @@ -108,6 +108,7 @@ pub(crate) fn fixed_list_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -185,6 +186,7 @@ pub(crate) fn fixed_list_result_fixture() -> (cc::Module, ExternalBindings, Reso span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs index 63794799..a9c18f7e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs @@ -143,6 +143,7 @@ pub(super) fn fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -229,6 +230,7 @@ pub(super) fn result_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -356,6 +358,7 @@ pub(super) fn string_fixture() -> (cc::Module, ExternalBindings, Resolve) { span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs index 237f1ce6..56123e27 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs @@ -149,6 +149,7 @@ fn parameter_fixture( span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -319,6 +320,7 @@ pub(crate) fn option_string_list_result_fixture() -> (cc::Module, ExternalBindin span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), @@ -469,6 +471,7 @@ pub(crate) fn option_list_list_fixture() -> (cc::Module, ExternalBindings, Resol span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs index 48cd2ab3..4b701a0b 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs @@ -387,6 +387,7 @@ fn finish( span: span(), }; let bindings = ExternalBindings { + runtime: Vec::new(), imports: vec![ExternalBinding { symbol: external_symbol, source_module: ModuleId(0), diff --git a/crates/psrs-backend/src/mir/layout/accessors.rs b/crates/psrs-backend/src/mir/layout/accessors.rs index 4b6d05fb..c7f7d590 100644 --- a/crates/psrs-backend/src/mir/layout/accessors.rs +++ b/crates/psrs-backend/src/mir/layout/accessors.rs @@ -8,6 +8,11 @@ use crate::cc::{ use crate::types::{DefinedTypeId, HeapType, RefType, ValueType}; impl PlannedLayout { + /// Concrete definitions consumed by checked external ABI adaptation. + pub(crate) fn types(&self) -> &[crate::types::RecGroup] { + &self.types + } + pub(crate) fn repr_index(&self, id: ReprId) -> Result { self.repr_indices .get(&id) diff --git a/crates/psrs-backend/src/mir/layout/groups.rs b/crates/psrs-backend/src/mir/layout/groups.rs new file mode 100644 index 00000000..64be2f4a --- /dev/null +++ b/crates/psrs-backend/src/mir/layout/groups.rs @@ -0,0 +1,254 @@ +//! Dependency-minimal recursion groups and their complete type-ID remapping. +use super::*; + +pub(super) fn partition( + definitions: Vec, +) -> Result<(Vec, Vec), LayoutError> { + let edges = definitions.iter().map(dependencies).collect::>(); + if edges.iter().flatten().any(|id| *id >= definitions.len()) { + return Err(LayoutError::UnknownRepresentation); + } + let components = components(&edges); + let mut mapping = vec![DefinedTypeId(0); definitions.len()]; + let mut next = 0; + for component in &components { + for original in component { + mapping[*original] = DefinedTypeId(next); + next += 1; + } + } + let groups = components + .into_iter() + .map(|component| { + RecGroup( + component + .into_iter() + .map(|original| { + let mut definition = definitions[original].clone(); + remap(&mut definition, &mapping); + definition + }) + .collect(), + ) + }) + .collect(); + Ok((groups, mapping)) +} + +fn dependencies(definition: &DefinedType) -> Vec { + let mut result = definition + .supertype + .into_iter() + .map(|id| id.0 as usize) + .collect::>(); + let mut reference = |heap| { + if let HeapType::Index(id) = heap { + result.push(id.0 as usize); + } + }; + match &definition.composite { + CompositeType::Func { + parameters, + results, + } => { + for value in parameters.iter().chain(results) { + if let ValueType::Ref(ty) = value { + reference(ty.heap); + } + } + } + CompositeType::Struct(fields) => { + for field in fields { + if let StorageType::Ref(ty) = field.storage { + reference(ty.heap); + } + } + } + CompositeType::Array(field) => { + if let StorageType::Ref(ty) = field.storage { + reference(ty.heap); + } + } + } + result.sort_unstable(); + result.dedup(); + result +} + +/// Iterative Tarjan traversal avoids Rust stack growth for large type graphs. +/// Edges point from a definition to its dependencies, so completed components +/// already have the order required by Wasm: dependencies precede dependents. +fn components(edges: &[Vec]) -> Vec> { + let mut indices = vec![None; edges.len()]; + let mut low = vec![0; edges.len()]; + let mut active = vec![false; edges.len()]; + let mut stack = Vec::new(); + let mut frames = Vec::new(); + let mut result = Vec::new(); + let mut next = 0; + for root in 0..edges.len() { + if indices[root].is_some() { + continue; + } + indices[root] = Some(next); + low[root] = next; + next += 1; + active[root] = true; + stack.push(root); + frames.push((root, 0)); + while let Some((node, edge)) = frames.last_mut() { + let node = *node; + if let Some(child) = edges[node].get(*edge).copied() { + *edge += 1; + if let Some(index) = indices[child] { + if active[child] { + low[node] = low[node].min(index); + } + } else { + indices[child] = Some(next); + low[child] = next; + next += 1; + active[child] = true; + stack.push(child); + frames.push((child, 0)); + } + continue; + } + frames.pop(); + if low[node] == indices[node].unwrap() { + let mut component = Vec::new(); + loop { + let member = stack.pop().unwrap(); + active[member] = false; + component.push(member); + if member == node { + break; + } + } + component.sort_unstable(); + result.push(component); + } + if let Some((parent, _)) = frames.last() { + low[*parent] = low[*parent].min(low[node]); + } + } + } + result +} + +fn remap(definition: &mut DefinedType, mapping: &[DefinedTypeId]) { + let reference = |ty: &mut RefType| { + if let HeapType::Index(id) = &mut ty.heap { + *id = mapping[id.0 as usize]; + } + }; + if let Some(id) = &mut definition.supertype { + *id = mapping[id.0 as usize]; + } + match &mut definition.composite { + CompositeType::Func { + parameters, + results, + } => { + for value in parameters.iter_mut().chain(results) { + if let ValueType::Ref(ty) = value { + reference(ty); + } + } + } + CompositeType::Struct(fields) => { + for field in fields { + if let StorageType::Ref(ty) = &mut field.storage { + reference(ty); + } + } + } + CompositeType::Array(field) => { + if let StorageType::Ref(ty) = &mut field.storage { + reference(ty); + } + } + } +} + +#[cfg(test)] +mod tests { + use super::*; + + fn structure(references: &[u32]) -> DefinedType { + DefinedType { + final_type: true, + supertype: None, + composite: CompositeType::Struct( + references + .iter() + .map(|id| FieldType { + storage: StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Index(DefinedTypeId(*id)), + }), + mutable: false, + }) + .collect(), + ), + } + } + + #[test] + fn cycles_share_a_group_and_acyclic_dependencies_precede_users() { + let (groups, mapping) = partition(vec![ + structure(&[1, 3]), + structure(&[2]), + structure(&[1]), + structure(&[]), + structure(&[]), + ]) + .unwrap(); + assert_eq!( + groups.iter().map(|g| g.0.len()).collect::>(), + [2, 1, 1, 1] + ); + assert_eq!( + mapping, + [ + DefinedTypeId(3), + DefinedTypeId(0), + DefinedTypeId(1), + DefinedTypeId(2), + DefinedTypeId(4) + ] + ); + let CompositeType::Struct(fields) = &groups[2].0[0].composite else { + panic!("struct expected"); + }; + assert_eq!( + fields[0].storage, + StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Index(mapping[1]) + }) + ); + assert_eq!( + fields[1].storage, + StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Index(mapping[3]) + }) + ); + } + + #[test] + fn a_large_acyclic_type_chain_uses_no_recursive_rust_traversal() { + let mut definitions = (1..10_000).map(|id| structure(&[id])).collect::>(); + definitions.push(structure(&[])); + let (groups, mapping) = partition(definitions).unwrap(); + assert_eq!(groups.len(), 10_000); + assert_eq!(mapping[0], DefinedTypeId(9_999)); + assert_eq!(mapping[9_999], DefinedTypeId(0)); + } + + #[test] + fn dangling_type_edges_are_rejected_before_remapping() { + assert!(partition(vec![structure(&[1])]).is_err()); + } +} diff --git a/crates/psrs-backend/src/mir/layout/mod.rs b/crates/psrs-backend/src/mir/layout/mod.rs index 011559f2..9dc55014 100644 --- a/crates/psrs-backend/src/mir/layout/mod.rs +++ b/crates/psrs-backend/src/mir/layout/mod.rs @@ -14,6 +14,7 @@ use crate::types::{ use std::collections::HashMap; mod accessors; +mod groups; mod validate; use validate::validate_selected; @@ -341,12 +342,29 @@ impl PlannedLayout { signature_indices.insert(*id, index); } + let (types, mapping) = groups::partition(definitions)?; + let remap = |id: DefinedTypeId| mapping[id.0 as usize]; + for id in repr_indices.values_mut() { + *id = remap(*id); + } + for id in variant_indices.values_mut() { + *id = remap(*id); + } + for id in signature_indices.values_mut() { + *id = remap(*id); + } + let product_fields = product_fields + .into_iter() + .map(|(id, fields)| (remap(id), fields)) + .collect(); + let closure_index = closure_index.map(remap); + let capture_array_index = capture_array_index.map(remap); + let boxed_integer_index = boxed_integer_index.map(remap); + let boxed_number_index = boxed_number_index.map(remap); + let string_index = string_index.map(remap); + Ok(Self { - types: if definitions.is_empty() { - Vec::new() - } else { - vec![RecGroup(definitions)] - }, + types, repr_indices, product_fields, array_elements, @@ -381,6 +399,7 @@ pub(crate) enum LayoutError { UnsupportedClosureTarget, IncompatibleVariant, UnsupportedValue, + UnprojectedState, } impl std::fmt::Display for LayoutError { @@ -389,6 +408,10 @@ impl std::fmt::Display for LayoutError { Self::InvalidPayloadConversion(message) => { write!(f, "invalid payload storage conversion: {message}") } + Self::UnprojectedState => write!( + f, + "state dependencies require checked MIR instruction projection" + ), other => write!(f, "{other:?}"), } } @@ -410,6 +433,7 @@ fn value_type( string_index: Option, ) -> Result { Ok(match value { + CcValueShape::State => return Err(LayoutError::UnprojectedState), CcValueShape::Integer => ValueType::I32, CcValueShape::Boolean => ValueType::Boolean, CcValueShape::Number => ValueType::F64, @@ -469,3 +493,6 @@ fn array_storage_type( #[cfg(test)] mod tests; + +#[cfg(test)] +mod storage_tests; diff --git a/crates/psrs-backend/src/mir/layout/storage_tests.rs b/crates/psrs-backend/src/mir/layout/storage_tests.rs new file mode 100644 index 00000000..b0dc9dfc --- /dev/null +++ b/crates/psrs-backend/src/mir/layout/storage_tests.rs @@ -0,0 +1,216 @@ +//! Cross-module ABI evidence using the actual planner and Wasm encoder. +use super::*; +use crate::cc::{Reference, Signature}; +use crate::wasm::{self, Export, ExportIndex, ExportKind, FuncType, FunctionIndex, Op, TypeIndex}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; +use wasm_encoder::{HeapType as H, Instruction as I, RefType as R, ValType as V}; + +fn consumer(merge_groups: bool) -> Vec { + let mut table = RepresentationTable::default(); + let array = table.reserve(); + table.set( + array, + Representation::Array { + element: CcValueShape::Reference(Reference { + nullable: true, + heap: CcRefShape::Erased, + }), + }, + ); + let boxed = table.reserve(); + table.set( + boxed, + Representation::Box { + value: CcValueShape::Integer, + }, + ); + table.add_signature(Signature { + parameters: vec![CcValueShape::Integer], + result: CcValueShape::Integer, + }); + // Unrelated closure and box types must not become members of the array's + // canonical recursion group merely because this application uses them. + let layout = PlannedLayout::plan(&table, TargetCapabilities::default()).unwrap(); + let array = layout.repr_index(array).unwrap().0; + let boxed = layout.repr_index(boxed).unwrap().0; + let array_ref = |nullable| { + V::Ref(R { + nullable, + heap_type: H::Concrete(array), + }) + }; + let box_ref = V::Ref(R { + nullable: true, + heap_type: H::Concrete(boxed), + }); + let type_count = layout.types.iter().map(|g| g.0.len() as u32).sum::(); + let span = TextRange::new(0, 1); + let raw = |instruction| Op::Leaf(instruction); + let body = vec![ + raw(I::I32Const(7)), + raw(I::StructNew(boxed)), + raw(I::LocalSet(2)), + raw(I::I32Const(78)), + raw(I::StructNew(boxed)), + raw(I::LocalSet(3)), + raw(I::I32Const(2)), + raw(I::LocalGet(2)), + raw(I::Call(0)), + raw(I::LocalSet(0)), + raw(I::LocalGet(0)), + raw(I::LocalSet(1)), + raw(I::LocalGet(0)), + raw(I::RefAsNonNull), + raw(I::I32Const(0)), + raw(I::Call(1)), + raw(I::LocalGet(2)), + raw(I::RefEq), + raw(I::I32Eqz), + Op::If { + then_body: vec![raw(I::Unreachable)], + else_body: Vec::new(), + result: None, + span, + }, + raw(I::LocalGet(0)), + raw(I::RefAsNonNull), + raw(I::I32Const(1)), + raw(I::LocalGet(3)), + raw(I::Call(2)), + raw(I::LocalGet(1)), + raw(I::RefAsNonNull), + raw(I::I32Const(1)), + raw(I::Call(1)), + raw(I::LocalGet(3)), + raw(I::RefEq), + raw(I::I32Eqz), + Op::If { + then_body: vec![raw(I::Unreachable)], + else_body: Vec::new(), + result: None, + span, + }, + raw(I::LocalGet(1)), + raw(I::RefAsNonNull), + raw(I::I32Const(1)), + raw(I::Call(1)), + raw(I::RefCastNonNull(H::Concrete(boxed))), + raw(I::StructGet { + struct_type_index: boxed, + field_index: 0, + }), + ]; + let imports = ["array_fill", "array_read", "array_write"] + .into_iter() + .enumerate() + .map(|(index, name)| wasm::Import { + module: psrs_runtime::STORAGE_MODULE.into(), + name: name.into(), + type_index: TypeIndex(type_count + index as u32), + }) + .collect(); + let types = vec![ + FuncType { + parameters: vec![V::I32, V::Ref(R::EQREF)], + results: vec![array_ref(false)], + }, + FuncType { + parameters: vec![array_ref(false), V::I32], + results: vec![V::Ref(R::EQREF)], + }, + FuncType { + parameters: vec![array_ref(false), V::I32, V::Ref(R::EQREF)], + results: Vec::new(), + }, + FuncType { + parameters: Vec::new(), + results: vec![V::I32], + }, + ]; + let type_defs = if merge_groups { + vec![RecGroup( + layout.types.into_iter().flat_map(|group| group.0).collect(), + )] + } else { + layout.types + }; + let module = wasm::Module { + name: "storage_planned_consumer".into(), + imports, + types, + type_defs, + functions: vec![wasm::Function { + symbol: SymbolId::new(ModuleId(0), 0), + name: "test".into(), + type_index: TypeIndex(type_count + 3), + parameters: Vec::new(), + locals: vec![array_ref(true), array_ref(true), box_ref, box_ref], + body, + span, + }], + memories: Vec::new(), + data: Vec::new(), + globals: Vec::new(), + helpers: Vec::new(), + entry: None, + realloc: None, + exports: vec![Export { + name: "test".into(), + kind: ExportKind::Function, + index: ExportIndex::Function(FunctionIndex(3)), + }], + span, + }; + let bytes = wasm::encode_module(&module).unwrap(); + crate::validator().validate_all(&bytes).unwrap(); + bytes +} + +#[test] +fn planned_gc_array_matches_runtime_storage_and_preserves_aliases() { + use std::process::Command; + if !Command::new("wasmtime") + .arg("--version") + .output() + .is_ok_and(|version| version.status.success()) + { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "Wasmtime is required" + ); + return; + } + let directory = + std::env::temp_dir().join(format!("psrs-planned-storage-{}", std::process::id())); + std::fs::create_dir(&directory).unwrap(); + let provider = directory.join("storage.wasm"); + let guest = directory.join("guest.wasm"); + std::fs::write(&provider, psrs_runtime::storage::encode_module()).unwrap(); + let run = || { + Command::new("wasmtime") + .args(["run", "--preload"]) + .arg(format!( + "{}={}", + psrs_runtime::STORAGE_MODULE, + provider.display() + )) + .args(["--invoke", "test"]) + .arg(&guest) + .output() + .unwrap() + }; + std::fs::write(&guest, consumer(true)).unwrap(); + let rejected = run(); + assert!(!rejected.status.success()); + assert!( + String::from_utf8_lossy(&rejected.stderr).contains("incompatible import type"), + "{rejected:?}" + ); + std::fs::write(&guest, consumer(false)).unwrap(); + let output = run(); + std::fs::remove_dir_all(directory).unwrap(); + assert!(output.status.success(), "{output:?}"); + assert_eq!(String::from_utf8_lossy(&output.stdout).trim(), "78"); +} diff --git a/crates/psrs-backend/src/mir/layout/tests.rs b/crates/psrs-backend/src/mir/layout/tests.rs index b30519bb..65593722 100644 --- a/crates/psrs-backend/src/mir/layout/tests.rs +++ b/crates/psrs-backend/src/mir/layout/tests.rs @@ -3,6 +3,31 @@ use crate::cc::{Function, Module as CcModule, Reference, Signature, ValueDecl, V use psrs_hir::{ModuleId, SymbolId}; use psrs_span::TextRange; +fn flattened_definitions(layout: &PlannedLayout) -> Vec<&DefinedType> { + layout.types.iter().flat_map(|group| &group.0).collect() +} + +#[test] +fn a_logical_state_cannot_become_a_physical_scalar_or_storage_slot() { + let layout = PlannedLayout::plan( + &RepresentationTable::default(), + TargetCapabilities::default(), + ) + .unwrap(); + assert!(matches!( + layout.value_type(&CcValueShape::State), + Err(LayoutError::UnprojectedState) + )); + let mut table = RepresentationTable::default(); + table.representations.push(Representation::Product { + fields: vec![CcValueShape::State, CcValueShape::Integer], + }); + assert!(matches!( + PlannedLayout::plan(&table, TargetCapabilities::default()), + Err(LayoutError::UnprojectedState) + )); +} + #[test] fn planner_owns_the_gc_closure_and_capture_layouts() { let mut table = RepresentationTable::default(); @@ -13,7 +38,7 @@ fn planner_owns_the_gc_closure_and_capture_layouts() { let layout = PlannedLayout::plan(&table, TargetCapabilities::default()) .expect("planning a closure signature"); - let definitions = &layout.types[0].0; + let definitions = flattened_definitions(&layout); assert!(matches!(definitions[0].composite, CompositeType::Array(_))); assert!(matches!(definitions[1].composite, CompositeType::Struct(_))); @@ -45,9 +70,10 @@ fn signatures_that_lower_to_the_same_wasm_type_share_one_definition() { layout.signature_index(SignatureId(1)).unwrap(), "Boolean and Integer both lower to i32 and must share a function type" ); - let function_types = layout.types[0] - .0 + let function_types = layout + .types .iter() + .flat_map(|group| &group.0) .filter(|definition| matches!(definition.composite, CompositeType::Func { .. })) .count(); assert_eq!( @@ -155,7 +181,7 @@ fn maps_every_cc_value_shape_to_its_specified_mir_type() { let layout = PlannedLayout::plan(&table, TargetCapabilities::default()) .expect("planning every scalar and reference shape"); - let definitions = &layout.types[0].0; + let definitions = flattened_definitions(&layout); let product_index = layout.repr_index(product).unwrap(); let closure_index = layout.closure_layout().unwrap().0; @@ -253,7 +279,7 @@ fn maps_every_cc_value_shape_to_its_specified_mir_type() { } #[test] -fn plans_mutually_recursive_requirements_in_one_recursion_group() { +fn plans_dependency_order_for_recursive_variant_requirements() { let mut table = RepresentationTable::default(); let variant = table.reserve(); let product = table.reserve(); @@ -293,10 +319,10 @@ fn plans_mutually_recursive_requirements_in_one_recursion_group() { PlannedLayout::plan(&table, TargetCapabilities::default()).expect("planning recursion"); assert_eq!( layout.types.len(), - 1, - "all definitions share one recursion group" + 4, + "the tag base, product, array and case have acyclic concrete type dependencies" ); - let definitions = &layout.types[0].0; + let definitions = flattened_definitions(&layout); assert_eq!( definitions.len(), 4, @@ -326,7 +352,7 @@ fn plans_mutually_recursive_requirements_in_one_recursion_group() { Some(variant_index) ); - for definition in definitions { + for definition in &definitions { for field in match &definition.composite { CompositeType::Struct(fields) => fields.clone(), CompositeType::Array(field) => vec![*field], @@ -376,7 +402,7 @@ fn plans_field_bearing_variants_as_tag_carrying_supertypes() { ); let layout = PlannedLayout::plan(&table, TargetCapabilities::default()).expect("planning a mixed sum"); - let definitions = &layout.types[0].0; + let definitions = flattened_definitions(&layout); let supertype = layout.repr_index(variant).unwrap(); assert!( !definitions[supertype.0 as usize].final_type, @@ -423,7 +449,7 @@ fn plans_the_uniform_closure_and_capture_array_layout() { }); let layout = PlannedLayout::plan(&table, TargetCapabilities::default()).expect("planning a closure"); - let definitions = &layout.types[0].0; + let definitions = flattened_definitions(&layout); let (closure, capture) = layout.closure_layout().unwrap(); let CompositeType::Array(element) = &definitions[capture.0 as usize].composite else { diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index e9473448..eebb3a6d 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -219,17 +219,18 @@ impl FunctionLowerer<'_> { function, arguments, } => { - if let Some(import) = self.wit_imports.get(function).cloned() { - current = wit::lower( - self, - &import.import, - &import.signature, - import.projection.as_ref(), - assignment.destination, - arguments, - assignment.span, - current, - )?; + if let Some(binding) = self + .runtime + .and_then(|context| context.binding(*function)) + .cloned() + { + if self.lower_storage_call(&binding, assignment, current)? { + // The checked raw contract discharges this path; + // the enclosing construct supplies a Trap terminator. + return Ok(current); + } + } else if let Some(import) = self.wit_imports.get(function).cloned() { + current = self.lower_wit_call(&import, assignment, current)?; } else { self.append_instruction( current, @@ -271,6 +272,13 @@ impl FunctionLowerer<'_> { assignment.span, )? } + AssignmentKind::StateExecution { .. } => { + return Err(vec![BackendError::invalid_ir( + "P9 MIR lowering", + assignment.span, + "state execution requires checked logical projection", + )]); + } AssignmentKind::IndirectCall { function, signature, diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index 9ada99e1..7ec42023 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -18,8 +18,10 @@ mod assignment_string; mod assignments; mod conversion_helpers; mod runtime_call; +mod storage_call; mod tail; mod variant; +mod wit_call; pub(super) use conversion_helpers::ConversionHelpers; #[cfg(test)] mod wit_tests; @@ -45,13 +47,30 @@ pub(super) fn lower_function( source: &cc::Function, id: FunctionId, wit_imports: &HashMap, + runtime: &super::runtime::RuntimeContext, layout: &PlannedLayout, conversion_helpers: Option<&mut ConversionHelpers>, literals: Option<&mut StringLiterals>, + logical_state_source: Option>, target: crate::capability::TargetCapabilities, ) -> Result> { let entry = BlockId(0); + // Removed logical identities remain reserved while their source-to-MIR + // relation is checked; helper temporaries must not reuse State identities. + let logical_values = logical_state_source + .as_ref() + .and_then(|module| { + module + .functions + .iter() + .find(|function| function.symbol == source.symbol) + }) + .unwrap_or(source); let mut lowerer = FunctionLowerer { + owner: source.symbol, + runtime: Some(runtime), + runtime_calls: Vec::new(), + wit_calls: Vec::new(), next_block: 1, blocks: vec![BasicBlock { id: entry, @@ -71,7 +90,7 @@ pub(super) fn lower_function( }) }) .collect::, Vec>>()?, - next_value: source + next_value: logical_values .values .iter() .map(|value| value.id.0) @@ -92,6 +111,7 @@ pub(super) fn lower_function( source.span, )?; let mut function = Function { + state: None, id, symbol: source.symbol, name: source.name.clone(), @@ -105,11 +125,32 @@ pub(super) fn lower_function( .map_err(|error| layout_error(source.span, error))?, span: source.span, }; + for plan in &lowerer.wit_calls { + plan.verify(&function)?; + } + if let Some(source) = logical_state_source { + function.state = Some(super::state::DependencyFlow::checked_with_runtime( + source, + &function, + lowerer.runtime_calls, + lowerer.wit_calls, + )?); + } else if !lowerer.runtime_calls.is_empty() { + return Err(vec![BackendError::invalid_ir( + "P9 runtime projection", + function.span, + "raw runtime invocation has no owning dependency flow", + )]); + } tail::mark_tail(&mut function, target)?; wit::verify_function(&function, wit_imports)?; Ok(function) } pub(super) struct FunctionLowerer<'a> { + owner: SymbolId, + runtime: Option<&'a super::runtime::RuntimeContext>, + runtime_calls: Vec, + wit_calls: Vec, next_block: u32, blocks: Vec, values: Vec, @@ -265,13 +306,24 @@ impl FunctionLowerer<'_> { span: TextRange, ) -> Result<(), Vec> { let target = self.find_block_mut(block, span)?; - if target.terminator.replace(terminator).is_some() { + if target.terminator.is_some() { return Err(vec![BackendError::invalid_ir( "P9 MIR lowering", span, "basic block already has a terminator", )]); } + target.terminator = Some( + if matches!( + target.instructions.last(), + Some(Instruction::Unreachable { .. }) + ) { + // A static trap has no normal return or jump successor. + Terminator::Trap { span } + } else { + terminator + }, + ); Ok(()) } diff --git a/crates/psrs-backend/src/mir/lower/storage_call.rs b/crates/psrs-backend/src/mir/lower/storage_call.rs new file mode 100644 index 00000000..2067c0f6 --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/storage_call.rs @@ -0,0 +1,61 @@ +use super::*; +use crate::mir::{runtime::RawInvocation, state::RuntimeInvocation}; + +impl FunctionLowerer<'_> { + pub(super) fn lower_storage_call( + &mut self, + binding: &crate::RuntimeBinding, + assignment: &cc::Assignment, + block: BlockId, + ) -> Result> { + let context = self + .runtime + .expect("runtime binding was selected from this context"); + let plan = RawInvocation::from_source( + binding, + &context.logical, + self.owner, + assignment.destination, + self.layout, + self.next_value, + )?; + let never_returns = plan.never_returns(); + let (values, instructions) = plan.emit()?; + let next = self + .next_value + .checked_add(values.len() as u32) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 runtime projection", + assignment.span, + "runtime invocation has exhausted temporary identities", + )] + })?; + let start = self + .blocks + .iter() + .find(|actual| actual.id == block) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 runtime projection", + assignment.span, + "runtime invocation has no current control block", + )] + })? + .instructions + .len(); + self.runtime_calls.push(RuntimeInvocation::new( + plan, + block, + start, + instructions.len(), + values.clone(), + )); + self.values.extend(values); + self.next_value = next; + for instruction in instructions { + self.append_instruction(block, instruction, assignment.span)?; + } + Ok(never_returns) + } +} diff --git a/crates/psrs-backend/src/mir/lower/tail.rs b/crates/psrs-backend/src/mir/lower/tail.rs index f288628f..0918987c 100644 --- a/crates/psrs-backend/src/mir/lower/tail.rs +++ b/crates/psrs-backend/src/mir/lower/tail.rs @@ -22,6 +22,10 @@ pub(super) fn mark_tail( function: &mut Function, target: TargetCapabilities, ) -> Result<(), Vec> { + if function.state.is_some() { + // Tail transfer must project the logical successor before rewriting it. + return Ok(()); + } let returned = return_forwarded_values(function); let uses = use_counts(function); let symbol = function.symbol; @@ -381,6 +385,7 @@ fn use_counts(function: &Function) -> HashMap { fn terminator_operands(terminator: &Terminator) -> Vec { match terminator { + Terminator::Trap { .. } => Vec::new(), Terminator::Return { value, .. } => vec![*value], Terminator::Jump { arguments, .. } => arguments.clone(), Terminator::Branch { condition, .. } => vec![*condition], diff --git a/crates/psrs-backend/src/mir/lower/wit_call.rs b/crates/psrs-backend/src/mir/lower/wit_call.rs new file mode 100644 index 00000000..4651f2e9 --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/wit_call.rs @@ -0,0 +1,81 @@ +//! Canonical adapters are planned independently before instructions are emitted. +use super::*; + +impl FunctionLowerer<'_> { + pub(super) fn lower_wit_call( + &mut self, + import: &BoundWasiImport, + assignment: &cc::Assignment, + entry: BlockId, + ) -> Result> { + let AssignmentKind::DirectCall { arguments, .. } = &assignment.kind else { + return Err(vec![BackendError::invalid_ir( + "P9 canonical call planning", + assignment.span, + "canonical adapter requires a direct source call", + )]); + }; + let start = self + .find_block_mut(entry, assignment.span)? + .instructions + .len(); + let value_start = self.values.len(); + // The isolated builder shares checked layouts and helper ownership, + // but cannot inspect or mutate the actual instruction stream. + let mut builder = FunctionLowerer { + owner: self.owner, + runtime: None, + runtime_calls: Vec::new(), + wit_calls: Vec::new(), + next_block: self.next_block, + blocks: vec![BasicBlock { + id: entry, + parameters: Vec::new(), + instructions: Vec::new(), + terminator: None, + }], + values: self.values.clone(), + next_value: self.next_value, + wit_imports: self.wit_imports, + layout: self.layout, + conversion_helpers: self.conversion_helpers.as_deref_mut(), + literals: self.literals.as_deref_mut(), + }; + let exit = wit::lower( + &mut builder, + &import.import, + &import.signature, + import.projection.as_ref(), + assignment.destination, + arguments, + assignment.span, + entry, + )?; + let plan = wit::CallPlan::new( + self.owner, + assignment.clone(), + import.clone(), + start, + exit, + builder.blocks.clone(), + builder.values[value_start..].to_vec(), + ); + let next_block = builder.next_block; + let next_value = builder.next_value; + let blocks = builder.blocks; + let values = builder.values; + let entry_plan = &blocks[0]; + for instruction in &entry_plan.instructions { + self.append_instruction(entry, instruction.clone(), assignment.span)?; + } + if let Some(terminator) = &entry_plan.terminator { + self.set_terminator(entry, terminator.clone(), assignment.span)?; + } + self.blocks.extend(blocks.into_iter().skip(1)); + self.values.extend(values.into_iter().skip(value_start)); + self.next_block = next_block; + self.next_value = next_value; + self.wit_calls.push(plan); + Ok(exit) + } +} diff --git a/crates/psrs-backend/src/mir/lower/wit_tests.rs b/crates/psrs-backend/src/mir/lower/wit_tests.rs index 3d23ab57..172a24fb 100644 --- a/crates/psrs-backend/src/mir/lower/wit_tests.rs +++ b/crates/psrs-backend/src/mir/lower/wit_tests.rs @@ -22,6 +22,10 @@ fn gc_wit_record_projection_uses_the_planned_product_type() { }); let lowerer_span = TextRange::new(0, 1); let mut lowerer = FunctionLowerer { + owner: psrs_hir::SymbolId::new(psrs_hir::ModuleId(0), 0), + runtime: None, + runtime_calls: Vec::new(), + wit_calls: Vec::new(), conversion_helpers: None, next_block: 1, blocks: vec![BasicBlock { diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 043988a4..a5dfcdd0 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -15,6 +15,8 @@ mod numeric; pub mod opt; mod planner; mod reachable; +mod runtime; +pub mod state; mod verify; mod wit; @@ -24,6 +26,7 @@ use planner::{GcPlanner, RepresentationPlanner}; pub use instruction::{Instruction, ListDirection}; pub use numeric::{NumericOp, UnaryOp}; +pub use runtime::RuntimeImport; pub use verify::{verify_module, verify_module_with_capabilities}; #[cfg(test)] @@ -49,8 +52,7 @@ pub struct Module { pub types: Vec, /// Static string literals referenced by `ArrayNewData` data indices. pub strings: Vec, - /// Runtime ABI imports the module may call. Their canonical signatures come - /// from the WIT runtime ABI; see `docs/decision/DEC-06`. + /// Checked physical ABI imports, selected from WIT or raw runtime contracts. pub imports: Vec, pub functions: Vec, /// The program entry declaration, if selected by the driver. @@ -60,14 +62,19 @@ pub struct Module { /// here to resolve a list element's guest layout. `None` for a hand-built /// test module with no representation table. pub(crate) layout: Option, + /// Immutable source requirements, independent of mutable function evidence. + pub(crate) dependencies: state::Inventory, pub span: TextRange, } -/// A runtime ABI import, lowered to its canonical ABI signature. +/// An external call target with its checked physical ABI signature. #[derive(Clone, Debug, PartialEq, Eq)] pub struct Import { - /// The canonical ABI symbol the call references. The interface, function, - /// and return-pointer details live in the ABI registry, not here. + /// Explicit runtime provider identity; ordinary source bindings retain this + /// through MIR instead of being assigned a reserved intrinsic symbol. + pub runtime: Option, + /// The call identity. WIT interface and return-pointer details live in the + /// ABI registry; raw runtime provider identity is retained above. pub symbol: SymbolId, pub parameters: Vec, pub result: Option, @@ -86,6 +93,9 @@ pub(crate) struct BoundWasiImport { #[derive(Clone, Debug, PartialEq, Eq)] pub struct Function { + /// Logical dependencies and their checked correspondence to instructions. + /// They have no target value type and survive physical State projection. + pub state: Option, /// Stable module-local MIR identity. P10 maps this identity to a final /// Wasm function index after imports are ordered. pub id: FunctionId, @@ -110,6 +120,10 @@ pub struct BasicBlock { #[derive(Clone, Debug, PartialEq, Eq)] pub enum Terminator { + /// Ends execution without a result operand or normal successor. + Trap { + span: TextRange, + }, Return { value: ValueId, span: TextRange, @@ -215,6 +229,10 @@ fn lower_module_after_binding_validation( target: TargetCapabilities, mut wasi: WasiRegistry, ) -> Result<(Module, WasiRegistry), Vec> { + // P8 owns ordinary CC typing. Recheck actual dependency bodies at the + // physical boundary, including callers supplying CC directly. + let projected = state::project(module, &bindings.runtime)?; + let module = projected.physical; // Resolve every source-declared WIT binding and pair it with the CC // abstract signature. Conformance was already checked at the linking // boundary; a declaration the backend cannot lower is rejected here. @@ -282,6 +300,12 @@ fn lower_module_after_binding_validation( module.entry.map(|entry| entry.module), ) })?; + let runtime = runtime::RuntimeContext::checked( + &bindings.runtime, + projected.logical.clone(), + &module, + &layout, + )?; let mut conversion_helpers = lower::ConversionHelpers::new(&module); let mut literals = StringLiterals::default(); let mut functions = Vec::with_capacity(module.functions.len()); @@ -290,9 +314,14 @@ fn lower_module_after_binding_validation( function, FunctionId(id as u32), &wit_imports, + &runtime, &layout, Some(&mut conversion_helpers), Some(&mut literals), + projected + .inventory + .requires(function.symbol) + .then(|| projected.logical.clone()), target, ) .map_err(|errors| { @@ -309,9 +338,11 @@ fn lower_module_after_binding_validation( helper, FunctionId(first_helper_id + offset as u32), &wit_imports, + &runtime, &layout, None, Some(&mut literals), + None, target, )?; functions.push(lowered); @@ -324,11 +355,18 @@ fn lower_module_after_binding_validation( .iter() .filter(|import| used.contains(&import.symbol)) .map(|import| Import { + runtime: None, symbol: import.symbol, parameters: import.parameters.clone(), result: import.result, }) .collect(); + imports.extend( + runtime + .imports + .into_values() + .filter(|import| used.contains(&import.symbol)), + ); if used.contains(&crate::abi::REALLOC_SYMBOL) || wasi .imports() @@ -387,6 +425,9 @@ fn lower_module_after_binding_validation( } } let strings = literals.into_strings(); + let dependencies = projected + .inventory + .with_helpers(&functions[first_helper_id as usize..])?; let mir = Module { name: module.name, types: layout.types.clone(), @@ -394,6 +435,7 @@ fn lower_module_after_binding_validation( imports, functions, entry: module.entry, + dependencies, layout: Some(layout), span: module.span, }; diff --git a/crates/psrs-backend/src/mir/number_format_tests.rs b/crates/psrs-backend/src/mir/number_format_tests.rs index ebc97952..6f8543ad 100644 --- a/crates/psrs-backend/src/mir/number_format_tests.rs +++ b/crates/psrs-backend/src/mir/number_format_tests.rs @@ -21,20 +21,24 @@ fn number_format_module() -> Module { entry: Some(SymbolId::new(ModuleId(0), 0)), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: vec![ Import { + runtime: None, symbol: crate::abi::REALLOC_SYMBOL, parameters: vec![ValueType::I32; 4], result: Some(ValueType::I32), }, Import { + runtime: None, symbol: crate::abi::NUMBER_TO_STRING_SYMBOL, parameters: vec![ValueType::F64, ValueType::I32, ValueType::I32], result: Some(ValueType::I32), }, ], functions: vec![Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), diff --git a/crates/psrs-backend/src/mir/opt/cfg.rs b/crates/psrs-backend/src/mir/opt/cfg.rs index 023f14a3..e219716d 100644 --- a/crates/psrs-backend/src/mir/opt/cfg.rs +++ b/crates/psrs-backend/src/mir/opt/cfg.rs @@ -7,6 +7,10 @@ use std::collections::{HashMap, HashSet, VecDeque}; pub(super) fn prune_unreachable(module: &mut Module) -> bool { let mut changed = false; for function in &mut module.functions { + if function.state.is_some() { + // CFG edits require a corresponding checked dependency transfer. + continue; + } let reachable = reachable_blocks(function.entry, &function.blocks); let original_len = function.blocks.len(); function @@ -20,6 +24,9 @@ pub(super) fn prune_unreachable(module: &mut Module) -> bool { pub(super) fn simplify_terminators(module: &mut Module) -> bool { let mut changed = false; for function in &mut module.functions { + if function.state.is_some() { + continue; + } let rewrites = function .blocks .iter() @@ -54,7 +61,8 @@ pub(super) fn simplify_terminators(module: &mut Module) -> bool { .unwrap_or(*default); (target, *span) } - Terminator::Return { .. } + Terminator::Trap { .. } + | Terminator::Return { .. } | Terminator::Jump { .. } | Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => return None, @@ -100,19 +108,5 @@ pub(super) fn reachable_blocks(entry: BlockId, blocks: &[BasicBlock]) -> HashSet } pub(super) fn successors(terminator: &Terminator) -> Vec { - match terminator { - Terminator::Return { .. } => Vec::new(), - Terminator::Jump { target, .. } => vec![*target], - Terminator::Branch { - then_block, - else_block, - .. - } => vec![*then_block, *else_block], - Terminator::Switch { cases, default, .. } => cases - .iter() - .map(|(_, target)| *target) - .chain(std::iter::once(*default)) - .collect(), - Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => Vec::new(), - } + crate::mir::cfg::successors(terminator) } diff --git a/crates/psrs-backend/src/mir/opt/constants.rs b/crates/psrs-backend/src/mir/opt/constants.rs index 2c9532a3..307ccdc8 100644 --- a/crates/psrs-backend/src/mir/opt/constants.rs +++ b/crates/psrs-backend/src/mir/opt/constants.rs @@ -45,7 +45,10 @@ pub(super) fn integer_constant(function: &Function, value: ValueId) -> Option bool { let facts = analyze(function); - let mut changed = materialize_block_parameters(function, &facts); + // Join parameters and their incoming payloads are source anchors in a + // dependency projection. Removing them requires an explicit evidence + // transfer, even when their scalar value is known. + let mut changed = function.state.is_none() && materialize_block_parameters(function, &facts); for block in &mut function.blocks { for instruction in &mut block.instructions { let Some(destination) = instruction.destination() else { @@ -164,7 +167,7 @@ fn incoming_values(function: &Function, reachable: &HashSet Terminator::Switch { .. } | Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => {} - Terminator::Return { .. } => {} + Terminator::Return { .. } | Terminator::Trap { .. } => {} } } incoming diff --git a/crates/psrs-backend/src/mir/opt/imports.rs b/crates/psrs-backend/src/mir/opt/imports.rs index 072db211..f443961f 100644 --- a/crates/psrs-backend/src/mir/opt/imports.rs +++ b/crates/psrs-backend/src/mir/opt/imports.rs @@ -90,13 +90,16 @@ mod tests { name: "ImportProjectionTest".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: vec![Import { + runtime: None, symbol: imported, parameters: Vec::new(), result: None, }], functions: vec![Function { + state: None, id: FunctionId(0), symbol: entry, name: "main".into(), @@ -162,6 +165,7 @@ mod tests { *function = dead_import; module.functions.insert(0, dead); module.imports.push(Import { + runtime: None, symbol: dead_import, parameters: Vec::new(), result: None, diff --git a/crates/psrs-backend/src/mir/opt/inline.rs b/crates/psrs-backend/src/mir/opt/inline.rs index 7b32e4df..1ff17622 100644 --- a/crates/psrs-backend/src/mir/opt/inline.rs +++ b/crates/psrs-backend/src/mir/opt/inline.rs @@ -21,6 +21,9 @@ pub(super) fn inline_small_functions(module: &mut Module) -> bool { let mut changed = false; for caller in &mut module.functions { + if caller.state.is_some() { + continue; + } let mut next_id = caller .values .iter() @@ -136,6 +139,9 @@ pub(super) fn inline_small_functions(module: &mut Module) -> bool { } fn is_candidate(function: &Function) -> bool { + if function.state.is_some() { + return false; + } if function.blocks.len() != 1 || !function.blocks[0].parameters.is_empty() { return false; } diff --git a/crates/psrs-backend/src/mir/opt/tests/constants.rs b/crates/psrs-backend/src/mir/opt/tests/constants.rs index 9555440f..0a043b3c 100644 --- a/crates/psrs-backend/src/mir/opt/tests/constants.rs +++ b/crates/psrs-backend/src/mir/opt/tests/constants.rs @@ -4,6 +4,7 @@ use super::*; fn folds_total_arithmetic_but_keeps_an_unused_trapping_operation() { let symbol = SymbolId::new(ModuleId(0), 0); let function = Function { + state: None, id: FunctionId(0), symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/control_flow.rs b/crates/psrs-backend/src/mir/opt/tests/control_flow.rs index 2066ffe5..de6e297c 100644 --- a/crates/psrs-backend/src/mir/opt/tests/control_flow.rs +++ b/crates/psrs-backend/src/mir/opt/tests/control_flow.rs @@ -5,6 +5,7 @@ fn folds_branch_merges_prunes_blocks_and_projects_imports() { let entry = SymbolId::new(ModuleId(0), 0); let import = SymbolId::new(ModuleId(1), 0); let function = Function { + state: None, id: FunctionId(0), symbol: entry, name: "main".into(), @@ -82,6 +83,7 @@ fn folds_branch_merges_prunes_blocks_and_projects_imports() { span: span(), }; let imports = vec![Import { + runtime: None, symbol: import, parameters: Vec::new(), result: None, @@ -115,6 +117,7 @@ fn folds_branch_merges_prunes_blocks_and_projects_imports() { fn preserves_switch_selectors_and_all_successors_through_p10() { let entry = SymbolId::new(ModuleId(0), 0); let function = Function { + state: None, id: FunctionId(0), symbol: entry, name: "switch_main".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/copy.rs b/crates/psrs-backend/src/mir/opt/tests/copy.rs index 2ef1fdae..dbe067c2 100644 --- a/crates/psrs-backend/src/mir/opt/tests/copy.rs +++ b/crates/psrs-backend/src/mir/opt/tests/copy.rs @@ -4,6 +4,7 @@ use super::*; fn copy_forwarding_updates_the_structurer_result_value() { let symbol = SymbolId::new(ModuleId(0), 0); let function = Function { + state: None, id: FunctionId(0), symbol, name: "identity".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/inline.rs b/crates/psrs-backend/src/mir/opt/tests/inline.rs index 4497356c..1b115b02 100644 --- a/crates/psrs-backend/src/mir/opt/tests/inline.rs +++ b/crates/psrs-backend/src/mir/opt/tests/inline.rs @@ -5,6 +5,7 @@ fn inlines_small_direct_functions_and_folds_the_result() { let caller_symbol = SymbolId::new(ModuleId(0), 0); let callee_symbol = SymbolId::new(ModuleId(0), 1); let caller = Function { + state: None, id: FunctionId(0), symbol: caller_symbol, name: "main".into(), @@ -37,6 +38,7 @@ fn inlines_small_direct_functions_and_folds_the_result() { span: span(), }; let callee = Function { + state: None, id: FunctionId(1), symbol: callee_symbol, name: "increment".into(), @@ -106,6 +108,7 @@ fn inlining_uses_the_callee_function_result_value() { let caller_symbol = SymbolId::new(ModuleId(0), 0); let callee_symbol = SymbolId::new(ModuleId(0), 1); let caller = Function { + state: None, id: FunctionId(0), symbol: caller_symbol, name: "main".into(), @@ -131,6 +134,7 @@ fn inlining_uses_the_callee_function_result_value() { span: span(), }; let callee = Function { + state: None, id: FunctionId(1), symbol: callee_symbol, name: "different_result_values".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/mod.rs b/crates/psrs-backend/src/mir/opt/tests/mod.rs index 6635fc99..7d16fd39 100644 --- a/crates/psrs-backend/src/mir/opt/tests/mod.rs +++ b/crates/psrs-backend/src/mir/opt/tests/mod.rs @@ -23,6 +23,7 @@ fn module(functions: Vec, imports: Vec, entry: SymbolId) -> Mo name: "OptimizationTest".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports, functions, diff --git a/crates/psrs-backend/src/mir/opt/values.rs b/crates/psrs-backend/src/mir/opt/values.rs index 31a1eb18..d4edbfc8 100644 --- a/crates/psrs-backend/src/mir/opt/values.rs +++ b/crates/psrs-backend/src/mir/opt/values.rs @@ -7,6 +7,11 @@ use std::collections::{HashMap, HashSet}; pub(super) fn forward_copies(module: &mut Module) { for function in &mut module.functions { + if function.state.is_some() { + // Source predicates, action operands and adapter inputs remain + // anchored until this pass can transfer their alias evidence. + continue; + } forward_function(function); } } @@ -47,6 +52,12 @@ fn forward_function(function: &mut Function) { pub(super) fn eliminate_dead_pure(module: &mut Module) { for function in &mut module.functions { + if function.state.is_some() { + // Dependency correspondence retains source destinations and exact + // adapter instruction ranges, including unused Unit recovery. + // Deletion requires an explicit transfer of that evidence. + continue; + } eliminate_function(function); } } @@ -98,6 +109,7 @@ fn eliminate_function(function: &mut Function) { fn terminator_operands(terminator: &Terminator) -> Vec { match terminator { + Terminator::Trap { .. } => Vec::new(), Terminator::Return { value, .. } => vec![*value], Terminator::Jump { arguments, .. } => arguments.clone(), Terminator::Branch { condition, .. } => vec![*condition], @@ -358,6 +370,7 @@ pub(crate) fn remap_terminator(terminator: &mut Terminator, mapping: &HashMap {} Terminator::Return { value, .. } => replace(value), Terminator::Jump { arguments, .. } => arguments.iter_mut().for_each(replace), Terminator::Branch { condition, .. } => replace(condition), diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index d737bb0b..5b040c33 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -39,7 +39,8 @@ pub(super) fn add_assignments( .iter() .any(|capture| value_types.get(capture) == Some(&ValueShape::Number)); } - AssignmentKind::IndirectCall { signature, .. } => { + AssignmentKind::IndirectCall { signature, .. } + | AssignmentKind::StateExecution { signature, .. } => { add_signature(*signature, signatures, signature_work); } AssignmentKind::RepresentationTest { reference, .. } diff --git a/crates/psrs-backend/src/mir/reachable/mod.rs b/crates/psrs-backend/src/mir/reachable/mod.rs index db5d105c..8ab6b436 100644 --- a/crates/psrs-backend/src/mir/reachable/mod.rs +++ b/crates/psrs-backend/src/mir/reachable/mod.rs @@ -14,19 +14,20 @@ use assignments::add_assignments; use projection::add_projection; -pub(super) struct ReachableHandles { - pub(super) representations: Vec, - pub(super) signatures: Vec, +pub(in crate::mir) struct ReachableHandles { + pub(in crate::mir) direct_calls: HashSet, + pub(in crate::mir) representations: Vec, + pub(in crate::mir) signatures: Vec, /// Whether any reachable value, field, element, capture, signature /// parameter/result, or constant is a `String`, so the planner reserves the /// GC `$string` type. - pub(super) needs_string: bool, + pub(in crate::mir) needs_string: bool, } impl ReachableHandles { /// Computes reachability for the GC planner, whose closure environments box /// integer and number captures for the `eqref` capture array. - pub(super) fn from_module(module: &CcModule) -> Result { + pub(in crate::mir) fn from_module(module: &CcModule) -> Result { let mut representations = HashSet::new(); let mut signatures = HashSet::new(); let mut representation_work = Vec::new(); @@ -183,7 +184,16 @@ impl ReachableHandles { representations.sort_by_key(|id| id.0); let mut signatures = signatures.into_iter().collect::>(); signatures.sort_by_key(|id| id.0); - let needs_string = module.functions.iter().any(|function| { + let needs_string = module.externals.iter().any(|external| { + direct_calls.contains(&external.symbol) + && external.projection.as_ref().is_some_and(|layout| { + layout + .parameters + .iter() + .chain(layout.result.iter()) + .any(projection::has_string) + }) + }) || module.functions.iter().any(|function| { function .values .iter() @@ -199,6 +209,7 @@ impl ReachableHandles { .is_some_and(signature_has_string) }); Ok(Self { + direct_calls, representations, signatures, needs_string, @@ -286,7 +297,7 @@ fn add_value( } } -pub(super) fn add_reference( +pub(in crate::mir) fn add_reference( reference: &Reference, representations: &mut HashSet, signatures: &mut HashSet, @@ -300,7 +311,7 @@ pub(super) fn add_reference( } } -pub(super) fn add_representation( +pub(in crate::mir) fn add_representation( id: ReprId, representations: &mut HashSet, work: &mut Vec, @@ -310,7 +321,7 @@ pub(super) fn add_representation( } } -pub(super) fn add_signature( +pub(in crate::mir) fn add_signature( id: SignatureId, signatures: &mut HashSet, work: &mut Vec, diff --git a/crates/psrs-backend/src/mir/reachable/projection.rs b/crates/psrs-backend/src/mir/reachable/projection.rs index 7978090d..760a65c8 100644 --- a/crates/psrs-backend/src/mir/reachable/projection.rs +++ b/crates/psrs-backend/src/mir/reachable/projection.rs @@ -6,6 +6,20 @@ use crate::cc::{ }; use psrs_span::TextRange; +pub(super) fn has_string(layout: &GuestLayout) -> bool { + match layout { + GuestLayout::Scalar { shape } | GuestLayout::Boxed { shape } => { + *shape == ValueShape::String + } + GuestLayout::Product { fields, .. } => fields.iter().any(|field| has_string(&field.value)), + GuestLayout::Variant { cases, .. } => cases + .iter() + .flat_map(|case| &case.fields) + .any(|field| has_string(&field.value)), + GuestLayout::Array { element, .. } => has_string(&element.value), + } +} + /// Adds every representation the instance-aware projection names. The concrete /// `value` node of an erased parameter field references a nested representation /// the abstract signature does not reach, so the projection is what keeps a diff --git a/crates/psrs-backend/src/mir/runtime/context.rs b/crates/psrs-backend/src/mir/runtime/context.rs new file mode 100644 index 00000000..57a69b69 --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/context.rs @@ -0,0 +1,47 @@ +//! One checked runtime binding inventory shared by all function lowerers. +use super::*; +use psrs_hir::SymbolId; +use std::{collections::HashMap, sync::Arc}; + +pub(in crate::mir) struct RuntimeContext { + pub(in crate::mir) logical: Arc, + bindings: HashMap, + pub(in crate::mir) imports: HashMap, +} + +impl RuntimeContext { + pub(in crate::mir) fn checked( + bindings: &[RuntimeBinding], + logical: Arc, + physical: &cc::Module, + layout: &PlannedLayout, + ) -> Result> { + let live = ReachableHandles::from_module(physical).map_err(|failure| { + vec![BackendError::invalid_ir( + "P9 runtime projection", + physical.span, + failure.to_string(), + )] + })?; + let mut imports = HashMap::new(); + let mut selected = HashMap::new(); + for binding in bindings { + if !live.direct_calls.contains(&binding.symbol) { + continue; + } + let (import, _) = plan_import(binding, &logical, layout)?; + verify_import(&import, &layout.types).map_err(|message| error(binding, &message))?; + imports.insert(binding.symbol, import); + selected.insert(binding.symbol, binding.clone()); + } + Ok(Self { + logical, + bindings: selected, + imports, + }) + } + + pub(in crate::mir) fn binding(&self, symbol: SymbolId) -> Option<&RuntimeBinding> { + self.bindings.get(&symbol) + } +} diff --git a/crates/psrs-backend/src/mir/runtime/function_tests.rs b/crates/psrs-backend/src/mir/runtime/function_tests.rs new file mode 100644 index 00000000..c51e9553 --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/function_tests.rs @@ -0,0 +1,123 @@ +use super::*; +use crate::mir::{Instruction, verify_module}; +use crate::types::ValueId; +use crate::{ExternalBindings, TargetCapabilities}; +use psrs_runtime::StorageOperation; + +fn lower(operation: StorageOperation) -> super::super::Module { + let (binding, mut source) = tests::fixture(operation); + if operation == StorageOperation::Read { + source.functions[0].parameters.insert(2, ValueId(4)); + source.functions[0].values.insert( + 2, + cc::ValueDecl { + id: ValueId(4), + ty: cc::ValueShape::Integer, + }, + ); + } + super::super::lower_module_with_bindings( + source, + ExternalBindings { + imports: vec![], + runtime: vec![binding], + }, + TargetCapabilities::default(), + ) + .unwrap() + .0 +} + +#[test] +fn checked_raw_invocations_publish_whole_function_dependency_evidence() { + for operation in [ + StorageOperation::Fill, + StorageOperation::Read, + StorageOperation::Write, + ] { + let module = lower(operation); + assert_eq!(module.imports.len(), 1); + assert!(module.functions[0].state.is_some()); + verify_module(&module).unwrap(); + super::super::opt::optimize(module, TargetCapabilities::default()).unwrap(); + } +} + +#[test] +fn whole_function_checks_reject_same_typed_operand_and_provider_substitution() { + let module = lower(StorageOperation::Read); + let mut wrong = module.clone(); + let call = wrong.functions[0] + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find(|instruction| matches!(instruction, Instruction::Call { .. })) + .unwrap(); + let Instruction::Call { arguments, .. } = call else { + unreachable!() + }; + arguments[1] = ValueId(4); + assert!(verify_module(&wrong).is_err()); + let mut wrong = module.clone(); + wrong.imports[0].runtime.as_mut().unwrap().function = "array_fill".into(); + assert!( + verify_module(&wrong).is_err(), + "immutable call evidence must retain its checked import" + ); + let mut wrong = module; + wrong.imports[0].runtime = None; + assert!(verify_module(&wrong).is_err()); +} + +#[test] +fn whole_function_checks_reject_unit_in_place_of_an_actual_write() { + let module = lower(StorageOperation::Write); + let mut wrong = module.clone(); + for block in &mut wrong.functions[0].blocks { + block + .instructions + .retain(|instruction| !matches!(instruction, Instruction::CallVoid { .. })); + } + assert!(verify_module(&wrong).is_err()); + let mut wrong = module; + let unit = wrong.functions[0] + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find(|instruction| matches!(instruction, Instruction::Constant { .. })) + .unwrap(); + let Instruction::Constant { value, .. } = unit else { + unreachable!() + }; + *value = 1; + assert!(verify_module(&wrong).is_err()); +} + +#[test] +fn nonreturning_invocations_cannot_acquire_a_normal_return_or_continuation() { + let module = lower(StorageOperation::Trap); + verify_module(&module).unwrap(); + super::super::opt::optimize(module.clone(), TargetCapabilities::default()).unwrap(); + assert!(matches!( + module.functions[0].blocks[0].terminator, + Some(crate::mir::Terminator::Trap { .. }) + )); + let mut wrong = module.clone(); + wrong.functions[0].blocks[0].terminator = Some(crate::mir::Terminator::Return { + value: wrong.functions[0].result, + span: wrong.span, + }); + assert!(verify_module(&wrong).is_err()); + let mut wrong = module; + wrong.functions[0].values.push(crate::types::ValueDecl { + id: ValueId(100), + ty: ValueType::I32, + }); + let block = &mut wrong.functions[0].blocks[0]; + block.instructions.push(Instruction::Constant { + destination: ValueId(100), + value: 0, + span: wrong.span, + }); + assert!(verify_module(&wrong).is_err()); +} diff --git a/crates/psrs-backend/src/mir/runtime/invocation/emit.rs b/crates/psrs-backend/src/mir/runtime/invocation/emit.rs new file mode 100644 index 00000000..4aeb9029 --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/invocation/emit.rs @@ -0,0 +1,95 @@ +use super::*; + +impl RawInvocation { + pub(in crate::mir) fn emit( + &self, + ) -> Result<(Vec, Vec), Vec> { + let mut values = Vec::new(); + let mut instructions = Vec::new(); + let mut fresh = |ty| { + let id = ValueId(self.first_temporary + values.len() as u32); + values.push(ValueDecl { id, ty }); + id + }; + let mut arguments = Vec::new(); + for ((source, source_type), raw_type) in self + .arguments + .iter() + .zip(&self.argument_types) + .zip(&self.import.parameters) + { + let value = if source_type == raw_type { + *source + } else { + let ValueType::Ref(reference) = raw_type else { + return Err( + self.error("runtime operand requires a non-reference ABI conversion") + ); + }; + let value = fresh(*raw_type); + instructions.push(Instruction::RefCast { + destination: value, + value: *source, + reference: *reference, + span: self.span, + }); + value + }; + arguments.push(value); + } + match self.result { + RawCallResult::Value => { + let raw_type = self.import.result.unwrap(); + let result = if raw_type == self.result_type { + self.destination + } else { + fresh(raw_type) + }; + instructions.push(Instruction::Call { + destination: result, + function: self.import.symbol, + arguments, + span: self.span, + }); + if result != self.destination { + let ValueType::Ref(reference) = self.result_type else { + return Err( + self.error("runtime result requires a non-reference ABI conversion") + ); + }; + instructions.push(Instruction::RefCast { + destination: self.destination, + value: result, + reference, + span: self.span, + }); + } + } + RawCallResult::Unit => { + instructions.push(Instruction::CallVoid { + function: self.import.symbol, + arguments, + span: self.span, + }); + instructions.push(Instruction::Constant { + destination: self.destination, + value: 0, + span: self.span, + }); + } + RawCallResult::Never => { + instructions.push(Instruction::CallVoid { + function: self.import.symbol, + arguments, + span: self.span, + }); + instructions.push(Instruction::Unreachable { + destination: self.destination, + span: self.span, + }); + } + } + self.verify(&values, &instructions)?; + Ok((values, instructions)) + } +} diff --git a/crates/psrs-backend/src/mir/runtime/invocation/mod.rs b/crates/psrs-backend/src/mir/runtime/invocation/mod.rs new file mode 100644 index 00000000..f9835c38 --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/invocation/mod.rs @@ -0,0 +1,186 @@ +//! Source-anchored raw calls with immutable operand and recovery witnesses. +use super::*; +use crate::mir::Instruction; +use crate::types::{ValueDecl, ValueId}; +use psrs_hir::SymbolId; +use psrs_span::TextRange; + +mod emit; +mod verify; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(in crate::mir) struct RawInvocation { + owner: SymbolId, + source: cc::Assignment, + import: Import, + arguments: Vec, + argument_types: Vec, + destination: ValueId, + result_type: ValueType, + result: RawCallResult, + span: TextRange, + first_temporary: u32, +} + +impl RawInvocation { + /// Obtain the actual assignment from immutable checked CC, rather than + /// accepting an arbitrary caller-supplied argument list or signature. + pub(in crate::mir) fn from_source( + binding: &RuntimeBinding, + module: &cc::Module, + owner: SymbolId, + destination: ValueId, + layout: &PlannedLayout, + first_temporary: u32, + ) -> Result> { + let flows = cc::state::check(module)?; + let flow = flows + .iter() + .find(|flow| flow.function.symbol == owner) + .ok_or_else(|| error(binding, "runtime invocation has no checked owning CC body"))?; + let operation = flow + .operations + .iter() + .find(|operation| operation.assignment.destination == destination) + .ok_or_else(|| error(binding, "runtime invocation has no source assignment"))?; + let cc::AssignmentKind::DirectCall { + function, + arguments, + } = &operation.assignment.kind + else { + return Err(error( + binding, + "runtime invocation source is not a direct call", + )); + }; + if *function != binding.symbol { + return Err(error( + binding, + "runtime invocation source and binding identities disagree", + )); + } + if flow + .function + .values + .iter() + .any(|value| value.id.0 >= first_temporary) + { + return Err(error( + binding, + "runtime invocation temporaries overlap logical CC values", + )); + } + let (import, result) = plan_import(binding, module, layout)?; + verify_import(&import, &layout.types).map_err(|message| error(binding, &message))?; + let signature = module + .externals + .iter() + .find(|external| external.symbol == binding.symbol) + .and_then(|external| external.signature.as_ref()) + .unwrap(); + let state = cc::state::StateCallProjection::checked(signature, &module.representations) + .map_err(|message| error(binding, message))? + .unwrap(); + let arguments = arguments[..state.state_parameter].to_vec(); + let argument_types = signature.parameters[..state.state_parameter] + .iter() + .map(|shape| { + layout + .value_type(shape) + .map_err(|_| error(binding, "runtime operand has no source layout")) + }) + .collect::, _>>()?; + let result_type = layout + .value_type(&state.payload) + .map_err(|_| error(binding, "runtime payload has no source layout"))?; + let eq = cc::payload::erased_shape(); + for (index, raw) in import.parameters.iter().enumerate() { + if matches!( + raw, + ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq + }) + ) && signature.parameters[index] != eq + { + return Err(vec![BackendError::new( + "P9 runtime projection", + binding.span, + "runtime element requires checked canonical payload conversion before raw invocation", + )]); + } + } + if import.result + == Some(ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + })) + && state.payload != eq + { + return Err(vec![BackendError::new( + "P9 runtime projection", + binding.span, + "runtime element result requires checked canonical payload recovery", + )]); + } + Ok(Self { + owner, + source: operation.assignment.clone(), + import, + arguments, + argument_types, + destination, + result_type, + result, + span: operation.assignment.span, + first_temporary, + }) + } + + pub(in crate::mir) fn never_returns(&self) -> bool { + self.result == RawCallResult::Never + } + + pub(in crate::mir) fn import(&self) -> &Import { + &self.import + } + + pub(in crate::mir) fn matches_source(&self, owner: SymbolId, source: &cc::Assignment) -> bool { + self.owner == owner && self.source == *source + } + + pub(in crate::mir) fn destination(&self) -> ValueId { + self.destination + } + + pub(in crate::mir) fn verify_source_values( + &self, + function: &crate::mir::Function, + ) -> Result<(), Vec> { + for (id, ty) in self + .arguments + .iter() + .zip(&self.argument_types) + .chain(std::iter::once((&self.destination, &self.result_type))) + { + if !function + .values + .iter() + .any(|value| value.id == *id && value.ty == *ty) + { + return Err(self.error("runtime invocation changes checked source value types")); + } + } + Ok(()) + } + + fn error(&self, message: &str) -> Vec { + vec![ + BackendError::invalid_ir("P9 runtime invocation verification", self.span, message) + .with_module(self.owner.module), + ] + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/mir/runtime/invocation/tests.rs b/crates/psrs-backend/src/mir/runtime/invocation/tests.rs new file mode 100644 index 00000000..154c451b --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/invocation/tests.rs @@ -0,0 +1,150 @@ +use super::*; +use psrs_runtime::StorageOperation; + +fn fixture(operation: StorageOperation) -> Result> { + let (binding, mut source) = crate::mir::runtime::tests::fixture(operation); + if operation == StorageOperation::Read { + let body = &mut source.functions[0]; + body.parameters.insert(2, ValueId(4)); + body.values.insert( + 2, + cc::ValueDecl { + id: ValueId(4), + ty: cc::ValueShape::Integer, + }, + ); + } + let projected = crate::mir::state::project(source, std::slice::from_ref(&binding)).unwrap(); + let layout = crate::mir::planner::RepresentationPlanner::plan_module( + &crate::mir::planner::GcPlanner::default(), + &projected.physical, + ) + .unwrap(); + let function = &projected.logical.functions[0]; + let first = function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1; + RawInvocation::from_source( + &binding, + &projected.logical, + function.symbol, + function.result, + &layout, + first, + ) +} + +#[test] +fn returning_source_calls_emit_and_verify_actual_raw_invocations() { + for operation in [ + StorageOperation::Fill, + StorageOperation::Read, + StorageOperation::Write, + ] { + let plan = fixture(operation).unwrap(); + let (values, instructions) = plan.emit().unwrap(); + plan.verify(&values, &instructions).unwrap(); + assert_eq!( + instructions + .iter() + .filter(|instruction| matches!( + instruction, + Instruction::Call { .. } | Instruction::CallVoid { .. } + )) + .count(), + 1 + ); + assert!( + values + .iter() + .all(|value| value.id.0 >= plan.first_temporary) + ); + assert!(plan.import().runtime.is_some()); + if operation == StorageOperation::Write { + assert!(matches!( + instructions[instructions.len() - 2], + Instruction::CallVoid { .. } + )); + assert!( + matches!(instructions.last(), Some(Instruction::Constant { destination, value: 0, .. }) + if *destination == plan.destination) + ); + } + } +} + +#[test] +fn raw_operand_witnesses_reject_same_typed_substitution() { + let plan = fixture(StorageOperation::Read).unwrap(); + let (values, instructions) = plan.emit().unwrap(); + let mut wrong = instructions.clone(); + let Instruction::Call { arguments, .. } = &mut wrong[0] else { + panic!("read must start with the call"); + }; + arguments[1] = ValueId(4); + assert!(plan.verify(&values, &wrong).is_err()); + let mut wrong = instructions.clone(); + let Instruction::RefCast { value, .. } = wrong.last_mut().unwrap() else { + panic!("read must recover its result"); + }; + *value = plan.arguments[0]; + assert!(plan.verify(&values, &wrong).is_err()); + let mut wrong = instructions; + wrong.push(wrong[0].clone()); + assert!(plan.verify(&values, &wrong).is_err()); +} + +#[test] +fn unit_cannot_replace_an_omitted_or_retargeted_write() { + let plan = fixture(StorageOperation::Write).unwrap(); + let (values, instructions) = plan.emit().unwrap(); + for mutation in 0..3 { + let mut wrong = instructions.clone(); + let call = wrong + .iter() + .position(|instruction| matches!(instruction, Instruction::CallVoid { .. })) + .unwrap(); + match mutation { + 0 => { + wrong.remove(call); + } + 1 => { + if let Instruction::CallVoid { function, .. } = &mut wrong[call] { + *function = SymbolId::new(function.module, function.index + 1); + } + } + _ => { + if let Some(Instruction::Constant { value, .. }) = wrong.last_mut() { + *value = 1; + } + } + } + assert!(plan.verify(&values, &wrong).is_err(), "mutation {mutation}"); + } +} + +#[test] +fn nonreturning_calls_emit_an_actual_void_call_and_bottom_without_unit() { + let plan = fixture(StorageOperation::Trap).unwrap(); + let (values, instructions) = plan.emit().unwrap(); + assert!(values.is_empty()); + assert!(matches!( + &instructions[..], + [ + Instruction::CallVoid { .. }, + Instruction::Unreachable { .. } + ] + )); + assert!(plan.verify(&values, &instructions[..1]).is_err()); + let mut wrong = instructions; + wrong[1] = Instruction::Constant { + destination: plan.destination(), + value: 0, + span: plan.span, + }; + assert!(plan.verify(&values, &wrong).is_err()); +} diff --git a/crates/psrs-backend/src/mir/runtime/invocation/verify.rs b/crates/psrs-backend/src/mir/runtime/invocation/verify.rs new file mode 100644 index 00000000..872ec944 --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/invocation/verify.rs @@ -0,0 +1,135 @@ +use super::*; + +impl RawInvocation { + /// Check operand and result witnesses against the source call. Mere type + /// agreement, or the presence of some call, is not sufficient evidence. + pub(in crate::mir) fn verify( + &self, + values: &[ValueDecl], + instructions: &[Instruction], + ) -> Result<(), Vec> { + let mut cursor = 0; + let mut temporary = 0; + let mut expect_fresh = |id, ty| { + let expected = values.get(temporary); + let valid = expected.is_some_and(|value| value.id == id && value.ty == ty) + && id == ValueId(self.first_temporary + temporary as u32); + temporary += 1; + valid + }; + let mut arguments = Vec::new(); + for ((source, source_type), raw_type) in self + .arguments + .iter() + .zip(&self.argument_types) + .zip(&self.import.parameters) + { + if source_type == raw_type { + arguments.push(*source); + continue; + } + let Some(Instruction::RefCast { + destination, + value, + reference, + .. + }) = instructions.get(cursor) + else { + return Err(self.error("runtime operand has no checked cast witness")); + }; + if value != source + || ValueType::Ref(*reference) != *raw_type + || !expect_fresh(*destination, *raw_type) + { + return Err( + self.error("runtime operand cast changes source identity or target type") + ); + } + arguments.push(*destination); + cursor += 1; + } + match self.result { + RawCallResult::Value => { + let Some(Instruction::Call { + destination, + function, + arguments: actual, + .. + }) = instructions.get(cursor) + else { + return Err(self.error("runtime value result has no actual call")); + }; + if *function != self.import.symbol || *actual != arguments { + return Err( + self.error("runtime call changes producer or operand correspondence") + ); + } + cursor += 1; + let raw_type = self.import.result.unwrap(); + if raw_type == self.result_type { + if *destination != self.destination { + return Err(self.error("runtime call changes its source destination")); + } + } else { + if !expect_fresh(*destination, raw_type) { + return Err(self.error("runtime raw result has no typed temporary")); + } + let Some(Instruction::RefCast { + destination: output, + value, + reference, + .. + }) = instructions.get(cursor) + else { + return Err(self.error("runtime result has no checked recovery witness")); + }; + if *output != self.destination + || value != destination + || ValueType::Ref(*reference) != self.result_type + { + return Err(self.error( + "runtime recovery loses the actual call result or checked payload type", + )); + } + cursor += 1; + } + } + RawCallResult::Unit => { + if !matches!(instructions.get(cursor), Some(Instruction::CallVoid { function, arguments: actual, .. }) + if *function == self.import.symbol && *actual == arguments) + { + return Err(self.error("runtime Unit requires an actual matching void call")); + } + cursor += 1; + if self.result_type != ValueType::I32 + || !matches!(instructions.get(cursor), + Some(Instruction::Constant { destination, value: 0, .. }) if *destination == self.destination) + { + return Err( + self.error("runtime Unit result must follow its actual void invocation") + ); + } + cursor += 1; + } + RawCallResult::Never => { + if self.import.result.is_some() + || !matches!(instructions.get(cursor), Some(Instruction::CallVoid { function, arguments: actual, .. }) + if *function == self.import.symbol && *actual == arguments) + || !matches!(instructions.get(cursor + 1), Some(Instruction::Unreachable { destination, .. }) + if *destination == self.destination) + { + return Err(self.error( + "non-returning invocation requires its actual call and bottom projection", + )); + } + cursor += 2; + } + } + if cursor != instructions.len() || temporary != values.len() { + return Err( + self.error("runtime invocation adds unaccounted instructions or temporaries") + ); + } + Ok(()) + } +} diff --git a/crates/psrs-backend/src/mir/runtime/mod.rs b/crates/psrs-backend/src/mir/runtime/mod.rs new file mode 100644 index 00000000..fc3c47de --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/mod.rs @@ -0,0 +1,26 @@ +//! Source-anchored external calls using checked physical binding signatures. +use super::{Import, layout::PlannedLayout, reachable::ReachableHandles}; +use crate::bindings::{ + RawCallResult, plan_runtime_import as plan_import, runtime_projection_error as error, + verify_runtime_import as verify_import, +}; +use crate::types::{HeapType, RefType, ValueType}; +use crate::{BackendError, RuntimeBinding, cc}; + +mod context; +mod invocation; +pub(in crate::mir) use context::RuntimeContext; +pub(super) use invocation::RawInvocation; + +#[derive(Clone, Debug, PartialEq, Eq)] +/// External provider/export identity retained after ABI lowering. +pub struct RuntimeImport { + pub module: String, + pub function: String, +} + +#[cfg(test)] +mod tests; + +#[cfg(test)] +mod function_tests; diff --git a/crates/psrs-backend/src/mir/runtime/tests.rs b/crates/psrs-backend/src/mir/runtime/tests.rs new file mode 100644 index 00000000..9bf2fdbb --- /dev/null +++ b/crates/psrs-backend/src/mir/runtime/tests.rs @@ -0,0 +1,203 @@ +use super::*; +use crate::cc::{ + Assignment, AssignmentKind, RefShape, Reference, ReprId, Representation, Signature, ValueShape, +}; +use crate::mir::planner::{GcPlanner, RepresentationPlanner}; +use crate::types::{CompositeType, FieldType, StorageType}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_runtime::{StorageOperation, StorageValue}; +use psrs_span::TextRange; + +pub(super) fn fixture(operation: StorageOperation) -> (RuntimeBinding, cc::Module) { + let span = TextRange::new(0, 1); + let binding = RuntimeBinding { + symbol: SymbolId::new(ModuleId(0), 1), + source_module: ModuleId(0), + module: psrs_runtime::STORAGE_MODULE.into(), + function: operation.abi().export.into(), + type_id: Some(psrs_core::TypeId(0)), + span, + }; + let reference = |id| { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(id)), + }) + }; + let shape = |role| match role { + StorageValue::Int | StorageValue::Unit => ValueShape::Integer, + StorageValue::Array => reference(0), + StorageValue::Element | StorageValue::Any => cc::payload::erased_shape(), + }; + let source = operation.source_contract(); + let mut parameters = source + .parameters + .iter() + .copied() + .map(shape) + .collect::>(); + parameters.push(ValueShape::State); + let signature = Signature { + parameters, + result: reference(1), + }; + let arguments = (0..signature.parameters.len()) + .map(|id| cc::ValueId(id as u32)) + .collect::>(); + let result = cc::ValueId(arguments.len() as u32); + let mut values = signature + .parameters + .iter() + .enumerate() + .map(|(id, ty)| cc::ValueDecl { + id: cc::ValueId(id as u32), + ty: *ty, + }) + .collect::>(); + values.push(cc::ValueDecl { + id: result, + ty: signature.result, + }); + let owner = SymbolId::new(ModuleId(0), 0); + let module = cc::Module { + name: "RawStorageSignature".into(), + externals: vec![cc::External { + symbol: binding.symbol, + signature: Some(signature), + projection: None, + }], + representations: cc::RepresentationTable { + representations: vec![ + Representation::Array { + element: cc::payload::erased_shape(), + }, + Representation::Product { + fields: vec![ValueShape::State, shape(source.payload)], + }, + ], + ..Default::default() + }, + functions: vec![cc::Function { + symbol: owner, + name: "action".into(), + parameters: arguments.clone(), + values, + assignments: vec![Assignment { + destination: result, + kind: AssignmentKind::DirectCall { + function: binding.symbol, + arguments, + }, + span, + }], + result, + result_type: reference(1), + span, + }], + entry: Some(owner), + span, + }; + (binding, module) +} + +#[test] +fn raw_signatures_use_application_gc_types_and_distinguish_void_from_never() { + for operation in StorageOperation::ALL { + let (binding, logical) = fixture(operation); + let projected = + crate::mir::state::project(logical, std::slice::from_ref(&binding)).unwrap(); + let layout = GcPlanner::default() + .plan_module(&projected.physical) + .unwrap(); + let (import, result) = plan_import(&binding, &projected.logical, &layout).unwrap(); + let eq = ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + }); + let array = || { + layout + .value_type(&ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(0)), + })) + .unwrap() + }; + let (parameters, raw_result, result_kind) = match operation { + StorageOperation::Fill => ( + vec![ValueType::I32, eq], + Some(array()), + RawCallResult::Value, + ), + StorageOperation::Read => ( + vec![array(), ValueType::I32], + Some(eq), + RawCallResult::Value, + ), + StorageOperation::Write => { + (vec![array(), ValueType::I32, eq], None, RawCallResult::Unit) + } + StorageOperation::Trap => (vec![], None, RawCallResult::Never), + }; + assert_eq!(import.symbol, binding.symbol); + assert_eq!(import.parameters, parameters); + assert_eq!(import.result, raw_result); + assert_eq!(result, result_kind); + assert!( + projected.physical.externals[0] + .signature + .as_ref() + .unwrap() + .parameters + .iter() + .all(|parameter| *parameter != ValueShape::State) + ); + let context = RuntimeContext::checked( + &[binding], + projected.logical.clone(), + &projected.physical, + &layout, + ); + assert_eq!(context.unwrap().imports.len(), 1); + } +} + +#[test] +fn raw_signature_rejects_a_contradictory_planned_array_definition() { + for field in [ + FieldType { + mutable: false, + storage: StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + }), + }, + FieldType { + mutable: true, + storage: StorageType::Ref(RefType { + nullable: false, + heap: HeapType::Eq, + }), + }, + FieldType { + mutable: true, + storage: StorageType::I32, + }, + ] { + let (binding, logical) = fixture(StorageOperation::Read); + let projected = + crate::mir::state::project(logical, std::slice::from_ref(&binding)).unwrap(); + let mut layout = GcPlanner::default() + .plan_module(&projected.physical) + .unwrap(); + let id = layout.repr_index(ReprId(0)).unwrap(); + layout + .types + .iter_mut() + .flat_map(|group| &mut group.0) + .nth(id.0 as usize) + .unwrap() + .composite = CompositeType::Array(field); + let errors = plan_import(&binding, &projected.logical, &layout).unwrap_err(); + assert!(errors[0].message.contains("mutable nullable-eqref storage")); + } +} diff --git a/crates/psrs-backend/src/mir/state/branch_tests.rs b/crates/psrs-backend/src/mir/state/branch_tests.rs new file mode 100644 index 00000000..a18ea8cf --- /dev/null +++ b/crates/psrs-backend/src/mir/state/branch_tests.rs @@ -0,0 +1,307 @@ +use super::*; +use crate::cc::{Assignment, AssignmentKind as A, ValueDecl, ValueId, ValueShape}; +use crate::mir::{BlockId, Terminator}; +use psrs_hir::{ModuleId, SymbolId}; + +pub(super) fn source(flag: bool) -> cc::Module { + let (source, _) = super::tests::fixture(); + let mut source = (*source).clone(); + source.externals.clear(); + let span = source.span; + let step = source.functions[0].result_type; + let callee = |symbol, value| cc::Function { + symbol, + name: format!("produce_{value}"), + parameters: vec![ValueId(0)], + values: vec![ + ValueDecl { + id: ValueId(0), + ty: ValueShape::State, + }, + ValueDecl { + id: ValueId(1), + ty: ValueShape::Integer, + }, + ValueDecl { + id: ValueId(2), + ty: step, + }, + ], + assignments: vec![ + Assignment { + destination: ValueId(1), + kind: A::Constant(value), + span, + }, + Assignment { + destination: ValueId(2), + kind: A::ProductNew { + destination: ValueId(2), + representation: cc::ReprId(0), + arguments: vec![ValueId(0), ValueId(1)], + }, + span, + }, + ], + result: ValueId(2), + result_type: step, + span, + }; + source + .functions + .push(callee(SymbolId::new(ModuleId(0), 1), 42)); + source + .functions + .push(callee(SymbolId::new(ModuleId(0), 6), 43)); + let call = |id, symbol| Assignment { + destination: ValueId(id), + kind: A::DirectCall { + function: symbol, + arguments: vec![ValueId(0)], + }, + span, + }; + source.functions[0].values = vec![ + ValueDecl { + id: ValueId(0), + ty: ValueShape::State, + }, + ValueDecl { + id: ValueId(4), + ty: ValueShape::Boolean, + }, + ValueDecl { + id: ValueId(1), + ty: step, + }, + ValueDecl { + id: ValueId(5), + ty: step, + }, + ValueDecl { + id: ValueId(3), + ty: step, + }, + ]; + source.functions[0].assignments = vec![ + Assignment { + destination: ValueId(4), + kind: A::Constant(i32::from(flag)), + span, + }, + Assignment { + destination: ValueId(3), + kind: A::If { + condition: ValueId(4), + then_assignments: vec![call(1, SymbolId::new(ModuleId(0), 1))], + then_value: ValueId(1), + else_assignments: vec![call(5, SymbolId::new(ModuleId(0), 6))], + else_value: ValueId(5), + }, + span, + }, + ]; + source +} + +#[test] +fn state_branches_lower_with_logical_joins_and_payload_only_block_parameters() { + let (mir, _) = crate::mir::lower_module(source(true)).unwrap(); + let function = &mir.functions[0]; + assert_eq!(function.state.as_ref().unwrap().graph().blocks.len(), 4); + assert_eq!(function.blocks.len(), 4); + assert_eq!(function.blocks[3].parameters, vec![ValueId(3)]); + assert!(function.parameters.is_empty()); + crate::mir::verify_module(&mir).unwrap(); +} + +#[test] +fn state_branch_projection_rejects_changed_edges_and_calls_moved_across_choices() { + let (mut mir, _) = crate::mir::lower_module(source(true)).unwrap(); + if let Some(Terminator::Branch { + then_block, + else_block, + .. + }) = &mut mir.functions[0].blocks[0].terminator + { + std::mem::swap(then_block, else_block); + } + assert!( + crate::mir::verify_module(&mir) + .unwrap_err() + .iter() + .any(|failure| failure.message.contains("branch or successor")) + ); + let (mut mir, _) = crate::mir::lower_module(source(true)).unwrap(); + let instruction = mir.functions[0].blocks[1].instructions.remove(0); + mir.functions[0].blocks[2] + .instructions + .insert(0, instruction); + assert!( + crate::mir::verify_module(&mir) + .unwrap_err() + .iter() + .any(|failure| failure.message.contains("adds or loses an invocation")) + ); + let (mut mir, _) = crate::mir::lower_module(source(true)).unwrap(); + if let Some(Terminator::Jump { target, .. }) = &mut mir.functions[0].blocks[1].terminator { + *target = BlockId(2); + } + assert!(crate::mir::verify_module(&mir).is_err()); +} + +#[test] +fn nested_choices_project_source_and_mir_block_orders_explicitly() { + let mut source = source(true); + let span = source.span; + let step = source.functions[0].result_type; + source.functions[0].values.extend([ + ValueDecl { + id: ValueId(7), + ty: ValueShape::Boolean, + }, + ValueDecl { + id: ValueId(10), + ty: step, + }, + ValueDecl { + id: ValueId(11), + ty: step, + }, + ]); + if let A::If { + then_assignments, .. + } = &mut source.functions[0].assignments[1].kind + { + let call = |id, symbol| Assignment { + destination: ValueId(id), + kind: A::DirectCall { + function: SymbolId::new(ModuleId(0), symbol), + arguments: vec![ValueId(0)], + }, + span, + }; + *then_assignments = vec![ + Assignment { + destination: ValueId(7), + kind: A::Constant(0), + span, + }, + Assignment { + destination: ValueId(1), + kind: A::If { + condition: ValueId(7), + then_assignments: vec![call(10, 1)], + then_value: ValueId(10), + else_assignments: vec![call(11, 6)], + else_value: ValueId(11), + }, + span, + }, + ]; + } + let (mir, _) = crate::mir::lower_module(source).unwrap(); + assert_eq!( + mir.functions[0] + .state + .as_ref() + .unwrap() + .graph() + .blocks + .len(), + 7 + ); + assert_eq!(mir.functions[0].blocks.len(), 7); + assert!(matches!( + mir.functions[0].blocks[1].terminator, + Some(Terminator::Branch { + then_block: BlockId(4), + else_block: BlockId(5), + .. + }) + )); + crate::mir::verify_module(&mir).unwrap(); +} + +#[test] +fn a_trapping_state_arm_has_no_normal_edge_to_the_payload_join() { + let mut source = source(false); + if let A::If { + then_assignments, .. + } = &mut source.functions[0].assignments[1].kind + { + then_assignments[0].kind = A::Unreachable; + } + let (mut mir, _) = crate::mir::lower_module(source).unwrap(); + assert!(matches!( + mir.functions[0].blocks[1].terminator, + Some(Terminator::Trap { .. }) + )); + crate::mir::verify_module(&mir).unwrap(); + mir.functions[0].blocks[1].terminator = Some(Terminator::Jump { + target: BlockId(3), + arguments: vec![ValueId(1)], + span: mir.span, + }); + assert!(crate::mir::verify_module(&mir).is_err()); +} + +#[test] +fn state_branch_components_execute_both_selected_payloads_after_optimization() { + for (flag, trapping, expected) in [ + (true, false, Some(42)), + (false, false, Some(43)), + (false, true, Some(43)), + (true, true, None), + ] { + let target = crate::TargetCapabilities::default(); + let mut source = source(flag); + if trapping + && let A::If { + then_assignments, .. + } = &mut source.functions[0].assignments[1].kind + { + then_assignments[0].kind = A::Unreachable; + } + let (mir, mut wasi) = crate::mir::lower_module(source).unwrap(); + let mir = crate::mir::opt::optimize(mir, target).unwrap(); + assert_eq!(mir.functions[0].blocks.len(), 4); + let context = crate::linking::default_context().unwrap(); + let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target).unwrap(); + let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link).unwrap(); + let core = crate::wasm::encode_module(&wasm).unwrap(); + let component = crate::linking::compose(&link, &core, mir.span, None).unwrap(); + crate::validator_for(target) + .validate_all(&component) + .unwrap(); + if std::process::Command::new("wasmtime") + .arg("--version") + .output() + .is_err() + { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + } + let path = std::env::temp_dir().join(format!( + "psrs-state-choice-{}-{flag}-{trapping}.wasm", + std::process::id() + )); + std::fs::write(&path, component).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(path).unwrap(); + let stderr = String::from_utf8_lossy(&output.stderr); + if let Some(expected) = expected { + assert_eq!(output.status.code(), Some(expected), "{stderr}"); + } else { + assert!(!output.status.success(), "a selected trap must fail"); + assert!(stderr.contains("unreachable"), "{stderr}"); + } + } +} diff --git a/crates/psrs-backend/src/mir/state/control.rs b/crates/psrs-backend/src/mir/state/control.rs new file mode 100644 index 00000000..f504e576 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/control.rs @@ -0,0 +1,424 @@ +//! Source-anchored projection of structured CC choices to actual MIR blocks. +use super::*; +use crate::mir::{BlockId, Terminator}; + +struct Block<'a> { + parameters: Vec, + calls: Vec>, + end: Option, +} +struct Call<'a> { + assignment: &'a cc::Assignment, + adapter: Option<(psrs_hir::SymbolId, cc::ValueId)>, +} +enum End { + Branch(cc::ValueId, usize, usize), + Switch(cc::ValueId, Vec<(i32, usize)>, usize), + Jump(usize, cc::ValueId), + Return(cc::ValueId), + Trap, +} + +pub(super) fn verify( + source: &cc::Function, + function: &Function, + table: &cc::RepresentationTable, + runtime: &[RuntimeInvocation], + host: &[crate::mir::wit::CallPlan], +) -> Result<(), Vec> { + let mut host_by_entry = std::collections::HashMap::new(); + let mut adapter_blocks = std::collections::HashSet::new(); + for invocation in host { + invocation.verify(function)?; + if host_by_entry + .insert((invocation.entry(), invocation.start()), invocation) + .is_some() + { + return Err(error( + function, + "canonical invocation anchors are duplicated", + )); + } + for block in invocation.created_blocks() { + if !adapter_blocks.insert(block) { + return Err(error(function, "canonical invocation blocks overlap")); + } + } + } + let mut checked_host = std::collections::HashSet::new(); + let mut runtime_by_destination = std::collections::HashMap::new(); + for invocation in runtime { + if runtime_by_destination + .insert(invocation.destination(), invocation) + .is_some() + { + return Err(error( + function, + "runtime invocation source anchors are duplicated", + )); + } + } + let never = runtime + .iter() + .filter(|invocation| invocation.never_returns()) + .map(|invocation| invocation.destination()) + .collect::>(); + let mut checked_runtime = std::collections::HashSet::new(); + let states = source + .values + .iter() + .filter(|value| value.ty == cc::ValueShape::State) + .map(|value| value.id) + .collect::>(); + let projected_arguments = |arguments: &[cc::ValueId]| { + arguments + .iter() + .filter(|argument| !states.contains(argument)) + .copied() + .collect::>() + }; + let mut blocks = vec![Block { + parameters: Vec::new(), + calls: Vec::new(), + end: None, + }]; + let end = sequence(&source.assignments, 0, &mut blocks, table, &never)?; + if blocks[end].end.is_none() { + blocks[end].end = Some(End::Return(source.result)); + } + let mut source_blocks = function + .blocks + .iter() + .filter(|block| !adapter_blocks.contains(&block.id)) + .map(|block| block.id) + .collect::>(); + source_blocks.sort_by_key(|block| block.0); + if function.entry != BlockId(0) || source_blocks.len() != blocks.len() { + return Err(error( + function, + "MIR dependency projection changes checked control flow", + )); + } + for (id, expected) in blocks.iter().enumerate() { + let mut actual = function + .blocks + .iter() + .find(|block| block.id == source_blocks[id]) + .ok_or_else(|| error(function, "MIR dependency projection loses a control block"))?; + if actual.parameters != expected.parameters { + return Err(error( + function, + "MIR dependency projection changes block parameters", + )); + } + // Collapse only complete, independently checked canonical adapters. + // Their internal calls and edges remain verified by the owning plan. + let mut calls = Vec::new(); + let mut cursor = 0; + loop { + if let Some(invocation) = host_by_entry.get(&(actual.id, cursor)) { + if !checked_host.insert((actual.id, cursor)) { + return Err(error(function, "canonical invocation revisits an adapter")); + } + let instruction = actual + .instructions + .get(cursor) + .ok_or_else(|| error(function, "canonical invocation has no instruction"))?; + calls.push((actual.id, cursor, instruction, Some(*invocation))); + let (exit, offset) = invocation.exit(); + actual = function + .blocks + .iter() + .find(|block| block.id == exit) + .ok_or_else(|| error(function, "canonical invocation loses its exit"))?; + cursor = offset; + continue; + } + let Some(instruction) = actual.instructions.get(cursor) else { + break; + }; + if matches!( + instruction, + Instruction::Call { .. } + | Instruction::CallVoid { .. } + | Instruction::CallRef { .. } + | Instruction::ClosureCall { .. } + ) { + calls.push((actual.id, cursor, instruction, None)); + } + cursor += 1; + } + let valid = match (&expected.end, &actual.terminator) { + ( + Some(End::Branch(condition, left, right)), + Some(Terminator::Branch { + condition: actual, + then_block, + else_block, + .. + }), + ) => { + condition == actual + && Some(then_block) == source_blocks.get(*left) + && Some(else_block) == source_blocks.get(*right) + } + ( + Some(End::Switch(value, cases, default)), + Some(Terminator::Switch { + value: actual, + cases: actual_cases, + default: actual_default, + .. + }), + ) => { + value == actual + && cases.len() == actual_cases.len() + && cases.iter().zip(actual_cases).all( + |((tag, block), (actual_tag, actual_block))| { + tag == actual_tag && Some(actual_block) == source_blocks.get(*block) + }, + ) + && Some(actual_default) == source_blocks.get(*default) + } + ( + Some(End::Jump(target, value)), + Some(Terminator::Jump { + target: actual, + arguments, + .. + }), + ) => Some(actual) == source_blocks.get(*target) && arguments.as_slice() == [*value], + (Some(End::Return(value)), Some(Terminator::Return { value: actual, .. })) => { + value == actual + } + (Some(End::Trap), Some(Terminator::Trap { .. })) => matches!( + actual.instructions.last(), + Some(Instruction::Unreachable { .. }) + ), + _ => false, + }; + if !valid { + return Err(error( + function, + "MIR dependency projection changes a branch or successor", + )); + } + if calls.len() != expected.calls.len() { + return Err(error( + function, + "MIR dependency projection adds or loses an invocation", + )); + } + for ((call_block, call_index, instruction, host), call) in calls.iter().zip(&expected.calls) + { + let assignment = call.assignment; + if let Some(invocation) = host { + let cc::AssignmentKind::DirectCall { arguments, .. } = &assignment.kind else { + return Err(error( + function, + "canonical adapter has no direct source call", + )); + }; + if call.adapter.is_some() + || !invocation.matches_source(assignment, &projected_arguments(arguments)) + { + return Err(error( + function, + "canonical adapter changes its source invocation", + )); + } + continue; + } + if let Some(invocation) = runtime_by_destination.get(&assignment.destination) { + invocation.verify_call(source, assignment, function, *call_block, *call_index)?; + checked_runtime.insert(assignment.destination); + continue; + } + if instruction.destination() != Some(assignment.destination) { + return Err(error( + function, + "MIR dependency projection reorders invocations", + )); + } + let valid = if let Some((expected, value)) = call.adapter { + matches!(instruction, Instruction::Call { function, arguments, .. } + if *function == expected && arguments.as_slice() == [value]) + } else { + match (&assignment.kind, instruction) { + ( + cc::AssignmentKind::DirectCall { + function: expected, + arguments: expected_arguments, + }, + Instruction::Call { + function: actual, + arguments: actual_arguments, + .. + }, + ) => { + expected == actual + && projected_arguments(expected_arguments) == *actual_arguments + } + ( + cc::AssignmentKind::IndirectCall { + function: expected, + arguments: expected_arguments, + .. + }, + Instruction::ClosureCall { + function: actual, + arguments: actual_arguments, + .. + }, + ) => { + expected == actual + && projected_arguments(expected_arguments) == *actual_arguments + } + ( + cc::AssignmentKind::StateExecution { + function: expected, .. + }, + Instruction::ClosureCall { + function: actual, + arguments, + .. + }, + ) => expected == actual && arguments.is_empty(), + _ => false, + } + }; + if !valid { + return Err(error( + function, + "MIR dependency projection changes an invocation producer or operands", + )); + } + } + } + if checked_host.len() != host.len() { + return Err(error( + function, + "canonical invocation evidence has no corresponding source call", + )); + } + if checked_runtime.len() != runtime.len() { + return Err(error( + function, + "runtime invocation evidence has no corresponding source call", + )); + } + Ok(()) +} + +fn sequence<'a>( + assignments: &'a [cc::Assignment], + mut current: usize, + blocks: &mut Vec>, + table: &cc::RepresentationTable, + never: &std::collections::HashSet, +) -> Result> { + for assignment in assignments { + match &assignment.kind { + cc::AssignmentKind::DirectCall { .. } + | cc::AssignmentKind::IndirectCall { .. } + | cc::AssignmentKind::StateExecution { .. } => { + blocks[current].calls.push(Call { + assignment, + adapter: None, + }); + if never.contains(&assignment.destination) { + blocks[current].end = Some(End::Trap); + return Ok(current); + } + } + cc::AssignmentKind::If { + condition, + then_assignments, + else_assignments, + then_value, + else_value, + } => { + let left = blocks.len(); + blocks.extend((0..3).map(|offset| Block { + parameters: if offset == 2 { + vec![assignment.destination] + } else { + Vec::new() + }, + calls: Vec::new(), + end: None, + })); + let right = left + 1; + let join = left + 2; + blocks[current].end = Some(End::Branch(*condition, left, right)); + let left_end = sequence(then_assignments, left, blocks, table, never)?; + let right_end = sequence(else_assignments, right, blocks, table, never)?; + if blocks[left_end].end.is_none() { + blocks[left_end].end = Some(End::Jump(join, *then_value)); + } + if blocks[right_end].end.is_none() { + blocks[right_end].end = Some(End::Jump(join, *else_value)); + } + current = join; + } + cc::AssignmentKind::AggregateConvert { + value, conversion, .. + } => { + let projected = + cc::state::StateCallProjection::payload_conversion(conversion, table).ok(); + let conversion = projected.as_ref().unwrap_or(conversion); + if let cc::ValueConversion::FunctionAdapter { function, .. } = conversion.plan { + blocks[current].calls.push(Call { + assignment, + adapter: Some((function, *value)), + }); + } + } + cc::AssignmentKind::Unreachable => { + blocks[current].end = Some(End::Trap); + return Ok(current); + } + cc::AssignmentKind::TagSwitch { + value, + cases, + default_assignments, + default_value, + } => { + let first = blocks.len(); + let default = first + cases.len(); + let join = default + 1; + blocks.extend((first..=join).map(|id| Block { + parameters: if id == join { + vec![assignment.destination] + } else { + Vec::new() + }, + calls: Vec::new(), + end: None, + })); + blocks[current].end = Some(End::Switch( + *value, + cases + .iter() + .enumerate() + .map(|(index, case)| (case.tag, first + index)) + .collect(), + default, + )); + for (index, case) in cases.iter().enumerate() { + let end = sequence(&case.assignments, first + index, blocks, table, never)?; + if blocks[end].end.is_none() { + blocks[end].end = Some(End::Jump(join, case.value)); + } + } + let end = sequence(default_assignments, default, blocks, table, never)?; + if blocks[end].end.is_none() { + blocks[end].end = Some(End::Jump(join, *default_value)); + } + current = join; + } + _ => {} + } + } + Ok(current) +} diff --git a/crates/psrs-backend/src/mir/state/host_tests.rs b/crates/psrs-backend/src/mir/state/host_tests.rs new file mode 100644 index 00000000..08893529 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/host_tests.rs @@ -0,0 +1,188 @@ +use super::*; +use crate::cc::{ + AssignmentKind, RefShape, Reference, ReprId, Representation, Signature, ValueShape, +}; +use crate::mir::{Module, lower_module_with_bindings, verify_module}; +use crate::types::ValueId; +use crate::{ExternalBinding, ExternalBindings, TargetCapabilities}; + +fn fixture() -> Module { + let (logical, _) = super::tests::fixture(); + let mut logical = (*logical).clone(); + let getter = logical.externals[0].symbol; + let drop = psrs_hir::SymbolId::new(getter.module, getter.index + 1); + let step = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(ReprId(1)), + }); + logical + .representations + .representations + .push(Representation::Product { + fields: vec![ValueShape::State, ValueShape::Integer], + }); + logical.externals.push(cc::External { + symbol: drop, + signature: Some(Signature { + parameters: vec![ValueShape::Integer, ValueShape::State], + result: step, + }), + projection: None, + }); + let body = &mut logical.functions[0]; + body.values[3].ty = step; + body.values.push(cc::ValueDecl { + id: ValueId(4), + ty: ValueShape::Integer, + }); + body.assignments.insert( + 2, + cc::Assignment { + destination: ValueId(4), + kind: AssignmentKind::ProductGet { + destination: ValueId(4), + representation: ReprId(0), + field: 1, + value: ValueId(1), + }, + span: logical.span, + }, + ); + body.assignments[3].kind = AssignmentKind::DirectCall { + function: drop, + arguments: vec![ValueId(4), ValueId(2)], + }; + body.result_type = step; + let imports = [ + (getter, "wasi:cli/stdout", "get-stdout"), + (drop, "wasi:io/streams", "[resource-drop]output-stream"), + ] + .into_iter() + .map(|(symbol, interface, function)| ExternalBinding { + symbol, + interface: interface.into(), + function: function.into(), + source_module: getter.module, + type_id: None, + span: logical.span, + }) + .collect(); + lower_module_with_bindings( + logical, + ExternalBindings { + imports, + runtime: Vec::new(), + }, + TargetCapabilities::default(), + ) + .unwrap() + .0 +} + +#[test] +fn canonical_state_calls_check_target_operands_unit_and_import() { + let module = fixture(); + verify_module(&module).unwrap(); + let function = &module.functions[0]; + assert!( + function.blocks[0] + .instructions + .iter() + .any(|instruction| matches!(instruction, Instruction::CallVoid { .. })) + ); + for mutation in 0..4 { + let mut changed = module.clone(); + let instructions = &mut changed.functions[0].blocks[0].instructions; + match mutation { + 0 => { + let Instruction::Call { function, .. } = &mut instructions[0] else { + panic!() + }; + *function = module.functions[0].symbol; + } + 1 => { + let instruction = instructions + .iter_mut() + .find(|instruction| matches!(instruction, Instruction::CallVoid { .. })) + .unwrap(); + let Instruction::CallVoid { arguments, .. } = instruction else { + panic!() + }; + arguments[0] = ValueId(3); + } + 2 => { + let Instruction::Constant { value, .. } = instructions.last_mut().unwrap() else { + panic!() + }; + *value = 7; + } + _ => changed.imports[0] + .parameters + .push(crate::types::ValueType::I32), + } + let errors = verify_module(&changed).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 canonical call verification"), + "mutation {mutation} must fail canonical correspondence: {errors:?}" + ); + } +} + +#[test] +fn canonical_state_calls_reject_reordering_and_extra_calls() { + let module = fixture(); + let mut changed = module.clone(); + changed.functions[0].blocks[0].instructions.swap(0, 2); + assert!(verify_module(&changed).is_err()); + let mut changed = module.clone(); + let call = changed.functions[0].blocks[0].instructions[0].clone(); + changed.functions[0].blocks[0].instructions.push(call); + assert!(verify_module(&changed).is_err()); +} + +#[test] +fn canonical_dependency_evidence_cannot_be_removed_to_bypass_verification() { + let module = fixture(); + verify_module(&module).unwrap(); + let mut changed = module.clone(); + changed.functions[0].state = None; + let errors = verify_module(&changed).unwrap_err(); + assert!(errors.iter().any(|error| { + error.pass == "P9 MIR dependency verification" + && error + .message + .contains("missing required dependency evidence") + })); + let errors = crate::mir::opt::optimize(changed, TargetCapabilities::default()).unwrap_err(); + assert!(errors.iter().any(|error| { + error.pass == "P10 MIR optimization" + && error + .message + .contains("missing required dependency evidence") + })); + + let mut changed = module; + changed.dependencies = Default::default(); + changed.functions[0].state = None; + let errors = verify_module(&changed).unwrap_err(); + assert!(errors.iter().any(|error| { + error + .message + .contains("planned MIR has no checked dependency inventory") + })); +} + +#[test] +fn changing_a_projected_function_identity_cannot_remove_its_source_requirement() { + let mut module = fixture(); + module.functions[0].state = None; + module.functions[0].symbol = psrs_hir::SymbolId::new(psrs_hir::ModuleId(99), 99); + let errors = verify_module(&module).unwrap_err(); + assert!(errors.iter().any(|error| { + error + .message + .contains("no source or generated-helper provenance") + })); +} diff --git a/crates/psrs-backend/src/mir/state/inventory.rs b/crates/psrs-backend/src/mir/state/inventory.rs new file mode 100644 index 00000000..ca0de074 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/inventory.rs @@ -0,0 +1,102 @@ +//! Source requirements remain independent of mutable per-function witnesses. +use super::*; +use psrs_hir::SymbolId; +use std::collections::HashSet; + +/// No source inventory is used only for directly constructed physical MIR. +/// Production P9 modules retain their checked logical source even when pure. +#[derive(Clone, Debug, Default, PartialEq, Eq)] +pub(crate) struct Inventory { + source: Option>, + required: HashSet, + declared: HashSet, +} + +impl Inventory { + pub(in crate::mir) fn checked(source: Arc) -> Result> { + let flows = cc::state::derive_all(&source)?; + if !flows.is_empty() { + // Dependency projection requires ordinary CC typing as well. + // An empty inventory does not publish additional typing claims. + cc::state::check(&source)?; + } + let required = flows.iter().map(|flow| flow.function.symbol).collect(); + let declared = source + .functions + .iter() + .map(|function| function.symbol) + .collect(); + Ok(Self { + source: Some(source), + required, + declared, + }) + } + + /// P9 registers only the helpers it generated during this lowering. + pub(in crate::mir) fn with_helpers( + mut self, + helpers: &[Function], + ) -> Result> { + for helper in helpers { + if helper.state.is_some() || !self.declared.insert(helper.symbol) { + return Err(error( + helper, + "generated MIR helper conflicts with source provenance", + )); + } + } + Ok(self) + } + + pub(in crate::mir) fn requires(&self, symbol: SymbolId) -> bool { + self.required.contains(&symbol) + } + + pub(in crate::mir) fn verify( + &self, + module: &crate::mir::Module, + ) -> Result<(), Vec> { + let mut errors = Vec::new(); + if self.source.is_none() && module.layout.is_some() { + errors.push(BackendError::invalid_ir( + "P9 MIR dependency verification", + module.span, + "planned MIR has no checked dependency inventory", + )); + } + // Reachability may remove whole unused functions. Every retained + // function is still checked against the original source requirement; + // pruning never rewrites this immutable inventory. + for function in &module.functions { + if self.source.is_some() && !self.declared.contains(&function.symbol) { + errors.extend(error( + function, + "MIR function has no source or generated-helper provenance", + )); + } + match (self.requires(function.symbol), &function.state) { + (true, None) => errors.extend(error( + function, + "MIR function is missing required dependency evidence", + )), + (false, Some(_)) => errors.extend(error( + function, + "MIR dependency evidence has no module source requirement", + )), + (true, Some(flow)) if self.source.as_deref() != Some(flow.source.as_ref()) => { + errors.extend(error( + function, + "MIR dependency evidence belongs to a different source inventory", + )); + } + _ => {} + } + } + if errors.is_empty() { + Ok(()) + } else { + Err(errors) + } + } +} diff --git a/crates/psrs-backend/src/mir/state/mod.rs b/crates/psrs-backend/src/mir/state/mod.rs new file mode 100644 index 00000000..1201b899 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/mod.rs @@ -0,0 +1,159 @@ +//! Logical dependency evidence retained alongside concrete MIR instructions. +use super::{Function, Instruction}; +use crate::{BackendError, cc}; +use psrs_core::state::dependency::Graph; +use std::sync::Arc; +mod control; +mod inventory; +pub(crate) use inventory::Inventory; +mod projection; +mod runtime; +pub(super) use projection::project; +pub(in crate::mir) use runtime::RuntimeInvocation; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct DependencyFlow { + source: Arc, + graph: Graph, + executions: Vec, + runtime: Vec, + host: Vec, +} + +impl DependencyFlow { + /// Publishes a projection only after both its source and actual MIR calls + /// agree. Structured binary choices retain their actual CFG correspondence; + /// a graph alone never authorizes physical erasure. + pub fn checked( + source: Arc, + function: &Function, + ) -> Result> { + Self::checked_with_runtime(source, function, Vec::new(), Vec::new()) + } + + pub(in crate::mir) fn checked_with_runtime( + source: Arc, + function: &Function, + runtime: Vec, + host: Vec, + ) -> Result> { + let flows = cc::state::check(&source)?; + let flow = flows + .iter() + .find(|flow| flow.function.symbol == function.symbol) + .ok_or_else(|| error(function, "MIR dependency projection has no checked CC body"))?; + let graph = flow.graph.clone(); + let executions = flow + .executions + .iter() + .map(|execution| execution.graph.clone()) + .collect(); + let projection = Self { + source, + graph, + executions, + runtime, + host, + }; + projection.verify(function)?; + Ok(projection) + } + + pub fn executions(&self) -> &[Graph] { + &self.executions + } + + pub fn graph(&self) -> &Graph { + &self.graph + } + + pub(crate) fn verify(&self, function: &Function) -> Result<(), Vec> { + let flows = cc::state::derive_all(&self.source)?; + let expected = flows + .iter() + .find(|flow| flow.function.symbol == function.symbol) + .ok_or_else(|| { + error( + function, + "MIR dependency projection has no owning CC function", + ) + })?; + if self.executions + != expected + .executions + .iter() + .map(|execution| execution.graph.clone()) + .collect::>() + || self.graph != expected.graph + { + return Err(error( + function, + "MIR dependency projection changes checked control flow", + )); + } + self.graph + .verify() + .map_err(|failure| error(function, failure.message))?; + let source_function = expected.function; + let states = source_function + .values + .iter() + .filter(|value| value.ty == cc::ValueShape::State) + .map(|value| value.id) + .collect::>(); + let parameters = source_function + .parameters + .iter() + .filter(|id| !states.contains(id)) + .copied() + .collect::>(); + if function.parameters != parameters + || function + .values + .iter() + .any(|value| states.contains(&value.id)) + { + return Err(error( + function, + "MIR dependency projection materializes a logical State slot", + )); + } + control::verify( + source_function, + function, + &self.source.representations, + &self.runtime, + &self.host, + )?; + Ok(()) + } + + pub(crate) fn verify_imports(&self, module: &super::Module) -> Result<(), Vec> { + for invocation in &self.runtime { + invocation.verify_import(module)?; + } + for invocation in &self.host { + invocation.verify_import(module)?; + } + Ok(()) + } +} + +fn error(function: &Function, message: &str) -> Vec { + vec![ + BackendError::invalid_ir("P9 MIR dependency verification", function.span, message) + .with_module(function.symbol.module), + ] +} + +#[cfg(test)] +mod branch_tests; +#[cfg(test)] +mod host_tests; +#[cfg(test)] +mod operand_tests; +#[cfg(test)] +mod tests; + +#[cfg(test)] +mod switch_tests; diff --git a/crates/psrs-backend/src/mir/state/operand_tests.rs b/crates/psrs-backend/src/mir/state/operand_tests.rs new file mode 100644 index 00000000..34315229 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/operand_tests.rs @@ -0,0 +1,120 @@ +use super::*; +use crate::cc::{AssignmentKind, ValueShape}; +use crate::types::{ValueDecl, ValueId, ValueType}; + +fn fixture() -> (Arc, Function) { + let (mut source, mut function) = super::tests::fixture(); + let logical = Arc::make_mut(&mut source); + let signature = logical.externals[0].signature.as_mut().unwrap(); + signature + .parameters + .splice(0..0, [ValueShape::Integer, ValueShape::Integer]); + let body = &mut logical.functions[0]; + body.parameters + .splice(0..0, [ValueId(4), ValueId(5), ValueId(6)]); + function.parameters = vec![ValueId(4), ValueId(5), ValueId(6)]; + for id in [6, 5, 4] { + body.values.insert( + 0, + crate::cc::ValueDecl { + id: ValueId(id), + ty: ValueShape::Integer, + }, + ); + function.values.insert( + 0, + ValueDecl { + id: ValueId(id), + ty: ValueType::I32, + }, + ); + } + for (index, prefix) in [(0, [ValueId(4), ValueId(5)]), (2, [ValueId(5), ValueId(6)])] { + let AssignmentKind::DirectCall { arguments, .. } = &mut body.assignments[index].kind else { + panic!("fixture must have a direct call"); + }; + arguments.splice(0..0, prefix); + let Instruction::Call { arguments, .. } = &mut function.blocks[0].instructions[index / 2] + else { + panic!("fixture must have a lowered call"); + }; + *arguments = prefix.to_vec(); + } + (source, function) +} + +#[test] +fn same_typed_operand_substitution_invalidates_the_dependency_certificate() { + let (source, mut function) = fixture(); + let certificate = DependencyFlow::checked(source, &function).unwrap(); + let Instruction::Call { arguments, .. } = &mut function.blocks[0].instructions[0] else { + panic!("fixture must have a lowered call"); + }; + arguments[0] = ValueId(6); + assert!(certificate.verify(&function).is_err()); +} + +#[test] +fn changed_operand_order_or_arity_invalidates_the_dependency_certificate() { + for change in 0..3 { + let (source, mut function) = fixture(); + let certificate = DependencyFlow::checked(source, &function).unwrap(); + let Instruction::Call { arguments, .. } = &mut function.blocks[0].instructions[1] else { + panic!("fixture must have a lowered call"); + }; + match change { + 0 => arguments.swap(0, 1), + 1 => { + arguments.pop(); + } + _ => arguments.push(ValueId(4)), + } + assert!(certificate.verify(&function).is_err(), "change {change}"); + } +} + +#[test] +fn indirect_calls_preserve_ordinary_operands_after_state_erasure() { + let (source, _) = fixture(); + let mut source = (*source).clone(); + let signature = source.externals[0].signature.clone().unwrap(); + source.externals.clear(); + let signature = source.representations.add_signature(signature); + let body = &mut source.functions[0]; + body.parameters.insert(3, ValueId(7)); + body.values.insert( + 3, + crate::cc::ValueDecl { + id: ValueId(7), + ty: ValueShape::Reference(crate::cc::Reference { + nullable: false, + heap: crate::cc::RefShape::Closure(signature), + }), + }, + ); + for index in [0, 2] { + let AssignmentKind::DirectCall { arguments, .. } = &body.assignments[index].kind else { + panic!("fixture must have a direct call"); + }; + body.assignments[index].kind = AssignmentKind::IndirectCall { + function: ValueId(7), + signature, + arguments: arguments.clone(), + }; + } + let (mut module, _) = crate::mir::lower_module(source).unwrap(); + crate::mir::verify_module(&module).unwrap(); + let function = &mut module.functions[0]; + let certificate = function.state.clone().unwrap(); + let Instruction::ClosureCall { arguments, .. } = &mut function.blocks[0].instructions[0] else { + panic!("fixture must lower to a closure call"); + }; + arguments[0] = ValueId(6); + assert!(certificate.verify(function).is_err()); + assert!( + crate::mir::verify_module(&module) + .unwrap_err() + .iter() + .any(|error| error.message.contains("producer or operands")) + ); +} diff --git a/crates/psrs-backend/src/mir/state/projection.rs b/crates/psrs-backend/src/mir/state/projection.rs new file mode 100644 index 00000000..0a4e0d94 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/projection.rs @@ -0,0 +1,322 @@ +//! P9's private instruction view: immutable logical CC remains the authority. +use super::*; +use crate::cc::{AssignmentKind as A, RefShape, Representation, ValueConversion, ValueShape}; +use std::collections::{HashMap, HashSet}; + +pub(in crate::mir) struct ProjectedInput { + pub physical: cc::Module, + pub logical: Arc, + pub inventory: Inventory, +} + +pub(in crate::mir) fn project( + module: cc::Module, + runtime: &[crate::RuntimeBinding], +) -> Result> { + let mut runtime_symbols = HashSet::new(); + for binding in runtime { + crate::bindings::checked_runtime_call(binding, &module)?; + runtime_symbols.insert(binding.symbol); + } + let logical = Arc::new(module); + let inventory = Inventory::checked(logical.clone())?; + let mut physical = (*logical).clone(); + let steps = logical + .representations + .representations + .iter() + .enumerate() + .filter_map(|(id, representation)| { + let Representation::Product { fields } = representation else { + return None; + }; + if !fields.contains(&ValueShape::State) { + return None; + } + let id = cc::ReprId(id as u32); + let signature = cc::Signature { + parameters: vec![ValueShape::State], + result: ValueShape::Reference(cc::Reference { + nullable: false, + heap: RefShape::Repr(id), + }), + }; + cc::state::StateCallProjection::checked(&signature, &logical.representations) + .ok() + .flatten() + .map(|plan| (id, plan)) + }) + .collect::>(); + let shape = |value: ValueShape| match value { + ValueShape::Reference(cc::Reference { + nullable: false, + heap: RefShape::Repr(id), + }) => steps.get(&id).map_or(value, |plan| plan.payload), + _ => value, + }; + let reachable = + crate::mir::reachable::ReachableHandles::from_module(&logical).map_err(|failure| { + vec![BackendError::new( + "P9 State projection", + logical.span, + failure.to_string(), + )] + })?; + // Project signatures in the logical inventory. Physical layout planning + // subsequently recomputes reachability from the projected module; unused + // logical Step entries need neither deletion nor representation reindexing. + for id in reachable.signatures { + let signature = &mut physical.representations.signatures[id.0 as usize]; + *signature = + cc::state::StateCallProjection::physical_signature(signature, &logical.representations) + .map_err(|message| { + vec![BackendError::new( + "P9 State projection", + logical.span, + message, + )] + })?; + } + // Reachability is computed over the logical module, so a state-stepping + // signature that only a projected-away Step referred to can survive + // without being reachable. Project every remaining one: a signature with a + // checked Step call has no physical State form to keep. + for index in 0..physical.representations.signatures.len() { + let signature = &mut physical.representations.signatures[index]; + if !signature.parameters.contains(&ValueShape::State) { + continue; + } + *signature = + cc::state::StateCallProjection::physical_signature(signature, &logical.representations) + .map_err(|message| { + vec![BackendError::new( + "P9 State projection", + logical.span, + message, + )] + })?; + } + // Only checked state-stepping declarations may enter private physical + // planning. A signature that projects to a checked Step call carries its + // own proof, so a host binding is admitted on the same terms as a runtime + // one. Actual raw calls still require result adaptation and MIR + // correspondence. + for external in &mut physical.externals { + let Some(signature) = external.signature.clone() else { + continue; + }; + if !signature.parameters.contains(&ValueShape::State) { + continue; + } + let step = cc::state::StateCallProjection::checked(&signature, &logical.representations) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P9 runtime projection", + logical.span, + message, + )] + })?; + if step.is_none() && !runtime_symbols.contains(&external.symbol) { + return Err(vec![BackendError::new( + "P9 State projection", + logical.span, + "state-aware host invocation requires checked ABI projection", + )]); + } + external.signature = Some( + cc::state::StateCallProjection::physical_signature( + &signature, + &logical.representations, + ) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P9 runtime projection", + logical.span, + message, + )] + })?, + ); + } + for function in &mut physical.functions { + let original = logical + .functions + .iter() + .find(|source| source.symbol == function.symbol) + .unwrap(); + let states = original + .values + .iter() + .filter(|value| value.ty == ValueShape::State) + .map(|value| value.id) + .collect::>(); + let has_step = original + .values + .iter() + .any(|value| shape(value.ty) != value.ty); + if has_step && !inventory.requires(function.symbol) { + return Err(error( + original, + "stored Step requires checked dependency transport", + )); + } + function.parameters.retain(|id| !states.contains(id)); + function.values.retain(|value| !states.contains(&value.id)); + for value in &mut function.values { + value.ty = shape(value.ty); + } + function.result_type = shape(function.result_type); + project_assignments( + &mut function.assignments, + original, + &states, + &steps, + &shape, + &logical.representations, + )?; + } + + Ok(ProjectedInput { + physical, + logical, + inventory, + }) +} + +fn error(function: &cc::Function, message: &str) -> Vec { + vec![ + BackendError::new("P9 State projection", function.span, message) + .with_module(function.symbol.module), + ] +} + +fn project_assignments( + input: &mut Vec, + original: &cc::Function, + states: &HashSet, + steps: &HashMap, + shape: &impl Fn(ValueShape) -> ValueShape, + table: &cc::RepresentationTable, +) -> Result<(), Vec> { + let mut assignments = Vec::new(); + for mut assignment in std::mem::take(input) { + if states.contains(&assignment.destination) { + if matches!(assignment.kind, A::If { .. } | A::TagSwitch { .. }) { + return Err(error( + original, + "raw State choice requires zero-width control result projection", + )); + } + continue; + } + let copy = match &mut assignment.kind { + A::ProductNew { + representation, + arguments, + .. + } => steps + .get(representation) + .map(|plan| (arguments[plan.payload_field], plan.payload)), + A::ProductGet { + representation, + value, + field, + .. + } => { + if let Some(plan) = steps.get(representation) { + if *field as usize != plan.payload_field { + return Err(error( + original, + "State field has an unexpected physical destination", + )); + } + Some((*value, plan.payload)) + } else { + None + } + } + A::StateExecution { + function, + signature, + .. + } => { + assignment.kind = A::IndirectCall { + function: *function, + signature: *signature, + arguments: Vec::new(), + }; + None + } + A::DirectCall { arguments, .. } | A::IndirectCall { arguments, .. } => { + arguments.retain(|id| !states.contains(id)); + None + } + A::AggregateConvert { conversion, .. } => { + let source = shape(conversion.source); + let destination = shape(conversion.destination); + if source != conversion.source || destination != conversion.destination { + *conversion = + cc::state::StateCallProjection::payload_conversion(conversion, table) + .map_err(|message| error(original, message))?; + } + conversion.source = source; + conversion.destination = destination; + None + } + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + project_assignments( + &mut case.assignments, + original, + states, + steps, + shape, + table, + )?; + } + project_assignments(default_assignments, original, states, steps, shape, table)?; + None + } + A::If { + then_assignments, + else_assignments, + .. + } => { + project_assignments(then_assignments, original, states, steps, shape, table)?; + project_assignments(else_assignments, original, states, steps, shape, table)?; + None + } + _ => None, + }; + if let A::AggregateConvert { + value, conversion, .. + } = &assignment.kind + && let ValueConversion::FunctionAdapter { function, .. } = conversion.plan + { + // The checked factory signature already owns this conversion. + // Keep the source destination as the call result, rather than an + // unanchored helper temporary followed by a copy. + assignment.kind = A::DirectCall { + function, + arguments: vec![*value], + }; + } + if let Some((value, payload)) = copy { + assignment.kind = A::AggregateConvert { + destination: assignment.destination, + value, + conversion: cc::AggregateConvert { + source: payload, + destination: payload, + plan: ValueConversion::Identity, + }, + }; + } + assignments.push(assignment); + } + *input = assignments; + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/state/runtime.rs b/crates/psrs-backend/src/mir/state/runtime.rs new file mode 100644 index 00000000..775f3085 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/runtime.rs @@ -0,0 +1,122 @@ +//! Immutable source anchors and actual block ranges for raw ABI adaptation. +use super::*; +use crate::mir::{BlockId, Module, runtime::RawInvocation}; +use crate::types::ValueDecl; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(in crate::mir) struct RuntimeInvocation { + plan: RawInvocation, + block: BlockId, + start: usize, + length: usize, + temporaries: Vec, +} + +impl RuntimeInvocation { + pub(in crate::mir) fn new( + plan: RawInvocation, + block: BlockId, + start: usize, + length: usize, + temporaries: Vec, + ) -> Self { + Self { + plan, + block, + start, + length, + temporaries, + } + } + + pub(in crate::mir) fn destination(&self) -> cc::ValueId { + self.plan.destination() + } + + pub(super) fn never_returns(&self) -> bool { + self.plan.never_returns() + } + + pub(super) fn verify_call( + &self, + source: &cc::Function, + assignment: &cc::Assignment, + function: &Function, + block: BlockId, + call_index: usize, + ) -> Result<(), Vec> { + if block != self.block || !self.plan.matches_source(source.symbol, assignment) { + return Err(error( + function, + "runtime invocation loses its source or control-block anchor", + )); + } + self.plan.verify_source_values(function)?; + let actual = function + .blocks + .iter() + .find(|actual| actual.id == block) + .ok_or_else(|| error(function, "runtime invocation has no actual block"))?; + let end = self + .start + .checked_add(self.length) + .ok_or_else(|| error(function, "runtime invocation range overflows"))?; + let instructions = actual.instructions.get(self.start..end).ok_or_else(|| { + error( + function, + "runtime invocation has no complete instruction range", + ) + })?; + if instructions + .iter() + .position(|instruction| { + matches!( + instruction, + Instruction::Call { .. } | Instruction::CallVoid { .. } + ) + }) + .map(|offset| self.start + offset) + != Some(call_index) + { + return Err(error( + function, + "runtime invocation moves across source calls", + )); + } + if self.never_returns() + && (end != actual.instructions.len() + || !matches!(actual.terminator, Some(crate::mir::Terminator::Trap { .. }))) + { + return Err(error( + function, + "non-returning invocation has a physical continuation", + )); + } + for expected in &self.temporaries { + if !function.values.iter().any(|value| value == expected) { + return Err(error( + function, + "runtime invocation changes a checked temporary type", + )); + } + } + self.plan.verify(&self.temporaries, instructions) + } + + pub(super) fn verify_import(&self, module: &Module) -> Result<(), Vec> { + let expected = self.plan.import(); + if module + .imports + .iter() + .find(|import| import.symbol == expected.symbol) + != Some(expected) + { + return Err(vec![BackendError::invalid_ir( + "P9 MIR dependency verification", + module.span, + "runtime invocation import differs from its immutable checked binding", + )]); + } + Ok(()) + } +} diff --git a/crates/psrs-backend/src/mir/state/switch_tests.rs b/crates/psrs-backend/src/mir/state/switch_tests.rs new file mode 100644 index 00000000..09deb8a4 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/switch_tests.rs @@ -0,0 +1,330 @@ +use crate::cc::{self, Assignment, AssignmentKind as A, TagCase, ValueDecl, ValueId, ValueShape}; +use crate::mir::{BlockId, Terminator}; +use psrs_hir::{ModuleId, SymbolId}; + +fn source(tag: i32) -> cc::Module { + let mut source = super::branch_tests::source(true); + let span = source.span; + let mut default = source.functions[1].clone(); + default.symbol = SymbolId::new(ModuleId(0), 8); + default.assignments[0].kind = A::Constant(44); + source.functions.push(default); + let function = &mut source.functions[0]; + function + .values + .iter_mut() + .find(|value| value.id == ValueId(4)) + .unwrap() + .ty = ValueShape::Integer; + function.values.push(ValueDecl { + id: ValueId(7), + ty: function.result_type, + }); + function.assignments[0].kind = A::Constant(tag); + let call = |id, symbol| Assignment { + destination: ValueId(id), + kind: A::DirectCall { + function: SymbolId::new(ModuleId(0), symbol), + arguments: vec![ValueId(0)], + }, + span, + }; + function.assignments[1].kind = A::TagSwitch { + value: ValueId(4), + cases: vec![ + TagCase { + tag: 7, + assignments: vec![call(1, 1)], + value: ValueId(1), + }, + TagCase { + tag: -3, + assignments: vec![call(5, 6)], + value: ValueId(5), + }, + ], + default_assignments: vec![call(7, 8)], + default_value: ValueId(7), + }; + source +} + +#[test] +fn multiway_state_projection_checks_labels_default_edges_and_invocation_placement() { + let (module, _) = crate::mir::lower_module(source(7)).unwrap(); + crate::mir::verify_module(&module).unwrap(); + assert_eq!(module.functions[0].blocks.len(), 5); + for mutation in 0..6 { + let mut changed = module.clone(); + if mutation < 4 { + let Some(Terminator::Switch { + value, + cases, + default, + .. + }) = &mut changed.functions[0].blocks[0].terminator + else { + panic!() + }; + match mutation { + 0 => cases[0].0 = 9, + 1 => cases[0].1 = BlockId(2), + 2 => *default = BlockId(1), + _ => *value = ValueId(3), + } + } else if mutation == 4 { + let call = changed.functions[0].blocks[1].instructions.remove(0); + changed.functions[0].blocks[2].instructions.insert(0, call); + } else { + let Some(Terminator::Jump { arguments, .. }) = + &mut changed.functions[0].blocks[1].terminator + else { + panic!() + }; + arguments[0] = ValueId(4); + } + let errors = crate::mir::verify_module(&changed).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR dependency verification"), + "{mutation}: {errors:?}" + ); + } +} + +#[test] +fn nested_binary_choice_in_a_state_switch_preserves_both_join_payloads() { + let mut source = source(7); + let function = &mut source.functions[0]; + let span = function.span; + function.values.extend([ + ValueDecl { + id: ValueId(8), + ty: ValueShape::Boolean, + }, + ValueDecl { + id: ValueId(10), + ty: function.result_type, + }, + ValueDecl { + id: ValueId(11), + ty: function.result_type, + }, + ]); + let A::TagSwitch { cases, .. } = &mut function.assignments[1].kind else { + panic!() + }; + let call = |id, symbol| Assignment { + destination: ValueId(id), + kind: A::DirectCall { + function: SymbolId::new(ModuleId(0), symbol), + arguments: vec![ValueId(0)], + }, + span, + }; + cases[0].assignments = vec![ + Assignment { + destination: ValueId(8), + kind: A::Constant(1), + span, + }, + Assignment { + destination: ValueId(1), + kind: A::If { + condition: ValueId(8), + then_assignments: vec![call(10, 1)], + then_value: ValueId(10), + else_assignments: vec![call(11, 6)], + else_value: ValueId(11), + }, + span, + }, + ]; + let (module, _) = crate::mir::lower_module(source).unwrap(); + assert_eq!(module.functions[0].blocks.len(), 8); + crate::mir::verify_module(&module).unwrap(); + let mut changed = module; + let Some(Terminator::Jump { arguments, .. }) = &mut changed.functions[0].blocks[7].terminator + else { + panic!() + }; + arguments[0] = ValueId(4); + assert!( + crate::mir::verify_module(&changed) + .unwrap_err() + .iter() + .any(|error| error.pass == "P9 MIR dependency verification") + ); +} + +#[test] +fn state_switch_executes_case_default_and_selected_trap_after_optimization() { + if std::process::Command::new("wasmtime") + .arg("--version") + .output() + .is_err() + { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + } + for trapping in [false, true] { + for (tag, expected) in [(7, 42), (-3, 43), (99, 44)] { + let target = crate::TargetCapabilities::default(); + let mut source = source(tag); + if trapping { + let A::TagSwitch { cases, .. } = &mut source.functions[0].assignments[1].kind + else { + panic!() + }; + cases[0].assignments[0].kind = A::Unreachable; + } + let (module, mut wasi) = crate::mir::lower_module(source).unwrap(); + let module = crate::mir::opt::optimize(module, target).unwrap(); + let context = crate::linking::default_context().unwrap(); + let link = + crate::linking::plan_for_module(&context, &module, &mut wasi, target).unwrap(); + let wasm = + crate::wasm::lower_module_with_plan(&module, &mut wasi, target, &link).unwrap(); + let core = crate::wasm::encode_module(&wasm).unwrap(); + let component = crate::linking::compose(&link, &core, module.span, None).unwrap(); + let path = std::env::temp_dir().join(format!( + "psrs-state-switch-{}-{tag}-{trapping}.wasm", + std::process::id() + )); + std::fs::write(&path, component).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(path).unwrap(); + if trapping && tag == 7 { + assert!(!output.status.success()); + assert!(String::from_utf8_lossy(&output.stderr).contains("unreachable")); + } else { + assert_eq!(output.status.code(), Some(expected), "{output:?}"); + } + } + } +} + +#[test] +fn constant_payload_joins_keep_their_source_parameters_during_optimization() { + let mut source = source(7); + let function = &mut source.functions[0]; + let span = function.span; + let arms = |destination, payload| { + vec![ + Assignment { + destination: ValueId(payload), + kind: A::Constant(42), + span, + }, + Assignment { + destination: ValueId(destination), + kind: A::ProductNew { + destination: ValueId(destination), + representation: cc::ReprId(0), + arguments: vec![ValueId(0), ValueId(payload)], + }, + span, + }, + ] + }; + for payload in [10, 11, 12] { + function.values.push(ValueDecl { + id: ValueId(payload), + ty: ValueShape::Integer, + }); + } + let A::TagSwitch { + cases, + default_assignments, + .. + } = &mut function.assignments[1].kind + else { + panic!() + }; + cases[0].assignments = arms(1, 10); + cases[1].assignments = arms(5, 11); + *default_assignments = arms(7, 12); + let (module, _) = crate::mir::lower_module(source).unwrap(); + let optimized = + crate::mir::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); + assert_eq!(optimized.functions[0].blocks[4].parameters, [ValueId(3)]); + crate::mir::verify_module(&optimized).unwrap(); +} + +#[test] +fn raw_state_switch_results_reject_before_their_effectful_arms_can_be_erased() { + let mut source = source(7); + source.functions.truncate(1); + source.externals = [1, 6, 8] + .into_iter() + .map(|symbol| cc::External { + symbol: SymbolId::new(ModuleId(0), symbol), + signature: Some(cc::Signature { + parameters: vec![ValueShape::State], + result: source.functions[0].result_type, + }), + projection: None, + }) + .collect(); + let function = &mut source.functions[0]; + let span = function.span; + function.values.extend((10..=13).map(|id| ValueDecl { + id: ValueId(id), + ty: ValueShape::State, + })); + let choice = &mut function.assignments[1]; + choice.destination = ValueId(13); + let A::TagSwitch { + cases, + default_assignments, + default_value, + .. + } = &mut choice.kind + else { + panic!() + }; + let projection = |destination, value| Assignment { + destination: ValueId(destination), + kind: A::ProductGet { + destination: ValueId(destination), + representation: cc::ReprId(0), + field: 0, + value: ValueId(value), + }, + span, + }; + for (index, case) in cases.iter_mut().enumerate() { + let state = 10 + index as u32; + case.assignments.push(projection(state, case.value.0)); + case.value = ValueId(state); + } + default_assignments.push(projection(12, default_value.0)); + *default_value = ValueId(12); + function.assignments.push(Assignment { + destination: ValueId(3), + kind: A::DirectCall { + function: SymbolId::new(ModuleId(0), 1), + arguments: vec![ValueId(13)], + }, + span, + }); + cc::state::check(&source).unwrap(); + let Err(errors) = super::project(source, &[]) else { + panic!("raw State choice must reject"); + }; + assert!( + errors + .iter() + .any(|error| error.pass == "P9 State projection" + && error.message.contains("raw State choice")), + "{errors:?}" + ); +} diff --git a/crates/psrs-backend/src/mir/state/tests.rs b/crates/psrs-backend/src/mir/state/tests.rs new file mode 100644 index 00000000..be1dd861 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/tests.rs @@ -0,0 +1,401 @@ +use super::*; +use crate::cc::{Assignment, AssignmentKind, ReprId, Representation, Signature, ValueShape}; +use crate::mir::{BasicBlock, BlockId, Function, Terminator}; +use crate::types::{FunctionId, ValueDecl, ValueId, ValueType}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; + +pub(super) fn fixture() -> (Arc, Function) { + let span = TextRange::new(0, 1); + let owner = SymbolId::new(ModuleId(0), 0); + let callee = SymbolId::new(ModuleId(0), 1); + let step = ValueShape::Reference(cc::Reference { + nullable: false, + heap: cc::RefShape::Repr(ReprId(0)), + }); + let mut representations = cc::RepresentationTable::default(); + representations + .representations + .push(Representation::Product { + fields: vec![ValueShape::State, ValueShape::Integer], + }); + let source = cc::Module { + name: "DependencyProjection".into(), + representations, + externals: vec![cc::External { + symbol: callee, + signature: Some(Signature { + parameters: vec![ValueShape::State], + result: step, + }), + projection: None, + }], + functions: vec![cc::Function { + symbol: owner, + name: "action".into(), + parameters: vec![ValueId(0)], + values: [ValueShape::State, step, ValueShape::State, step] + .into_iter() + .enumerate() + .map(|(id, ty)| cc::ValueDecl { + id: ValueId(id as u32), + ty, + }) + .collect(), + assignments: vec![ + Assignment { + destination: ValueId(1), + kind: AssignmentKind::DirectCall { + function: callee, + arguments: vec![ValueId(0)], + }, + span, + }, + Assignment { + destination: ValueId(2), + kind: AssignmentKind::ProductGet { + destination: ValueId(2), + representation: ReprId(0), + field: 0, + value: ValueId(1), + }, + span, + }, + Assignment { + destination: ValueId(3), + kind: AssignmentKind::DirectCall { + function: callee, + arguments: vec![ValueId(2)], + }, + span, + }, + ], + result: ValueId(3), + result_type: step, + span, + }], + entry: Some(owner), + span, + }; + let function = Function { + state: None, + id: FunctionId(0), + symbol: owner, + name: "action".into(), + parameters: Vec::new(), + values: vec![ + ValueDecl { + id: ValueId(1), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(3), + ty: ValueType::I32, + }, + ], + entry: BlockId(0), + blocks: vec![BasicBlock { + id: BlockId(0), + parameters: Vec::new(), + instructions: vec![ + Instruction::Call { + destination: ValueId(1), + function: callee, + arguments: Vec::new(), + span, + }, + Instruction::Call { + destination: ValueId(3), + function: callee, + arguments: Vec::new(), + span, + }, + ], + terminator: Some(Terminator::Return { + value: ValueId(3), + span, + }), + }], + result: ValueId(3), + result_type: ValueType::I32, + span, + }; + (Arc::new(source), function) +} + +#[test] +fn checked_projection_retains_zero_width_dependencies_at_actual_calls() { + let (source, function) = fixture(); + let flow = DependencyFlow::checked(source, &function).unwrap(); + assert_eq!(flow.graph().blocks[0].transitions.len(), 2); + assert!(function.parameters.is_empty()); + assert_eq!(function.values.len(), 2); + flow.verify(&function).unwrap(); +} + +#[test] +fn source_certificate_cannot_replace_instruction_correspondence() { + let (source, mut function) = fixture(); + let flow = DependencyFlow::checked(source, &function).unwrap(); + function.blocks[0].instructions.swap(0, 1); + assert!(flow.verify(&function).is_err()); + function.blocks[0].instructions.pop(); + assert!(flow.verify(&function).is_err()); +} + +#[test] +fn changing_call_producer_or_normal_successor_rejects() { + let (source, mut function) = fixture(); + let flow = DependencyFlow::checked(source, &function).unwrap(); + let original = function.blocks[0].instructions[0].clone(); + function.blocks[0].instructions[0] = Instruction::Constant { + destination: ValueId(1), + value: 0, + span: function.span, + }; + assert!(flow.verify(&function).is_err()); + function.blocks[0].instructions[0] = original; + function.blocks[0].terminator = None; + assert!(flow.verify(&function).is_err()); +} + +fn physical_module(source: Arc, mut function: Function) -> super::super::Module { + function.state = Some(DependencyFlow::checked(source.clone(), &function).unwrap()); + super::super::Module { + name: "DependencyProjection".into(), + types: Vec::new(), + strings: Vec::new(), + imports: vec![super::super::Import { + runtime: None, + symbol: SymbolId::new(ModuleId(0), 1), + parameters: Vec::new(), + result: Some(ValueType::I32), + }], + entry: Some(function.symbol), + span: function.span, + functions: vec![function], + dependencies: Inventory::checked(source).unwrap(), + layout: None, + } +} + +#[test] +fn mir_verifier_rejects_extra_invocations_against_the_source_body() { + let (source, function) = fixture(); + let mut module = physical_module(source, function); + super::super::verify_module(&module).unwrap(); + let first = module.functions[0].blocks[0].instructions[0].clone(); + module.functions[0].blocks[0].instructions.insert(0, first); + let failures = super::super::verify_module(&module).unwrap_err(); + assert!( + failures + .iter() + .any(|failure| failure.message.contains("adds or loses an invocation")) + ); +} + +#[test] +fn dependency_evidence_from_another_source_cannot_replace_the_required_witness() { + let (source, function) = fixture(); + let mut other = (*source).clone(); + other.name = "OtherSource".into(); + let replacement = DependencyFlow::checked(Arc::new(other), &function).unwrap(); + let mut module = physical_module(source, function); + module.functions[0].state = Some(replacement); + let errors = super::super::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| { error.message.contains("different source inventory") }) + ); +} + +#[test] +fn pruning_an_unused_dependency_function_preserves_requirements_for_live_functions() { + let (source, function) = fixture(); + let mut source = (*source).clone(); + let mut unused_source = source.functions[0].clone(); + unused_source.symbol = SymbolId::new(ModuleId(0), 2); + source.functions.push(unused_source); + let source = Arc::new(source); + let mut unused = function.clone(); + unused.id = FunctionId(1); + unused.symbol = source.functions[1].symbol; + unused.state = Some(DependencyFlow::checked(source.clone(), &unused).unwrap()); + let mut module = physical_module(source, function); + module.functions.push(unused); + let mut optimized = + super::super::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); + assert_eq!(optimized.functions.len(), 1); + super::super::verify_module(&optimized).unwrap(); + optimized.functions[0].state = None; + let errors = super::super::verify_module(&optimized).unwrap_err(); + assert!(errors.iter().any(|error| { + error + .message + .contains("missing required dependency evidence") + })); +} + +#[test] +fn optimization_retains_an_invocation_with_an_unused_physical_payload() { + let (source, function) = fixture(); + let module = physical_module(source, function); + let optimized = + super::super::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); + assert_eq!(optimized.functions[0].blocks[0].instructions.len(), 2); + assert_eq!( + optimized.functions[0] + .state + .as_ref() + .unwrap() + .graph() + .blocks[0] + .transitions + .len(), + 2 + ); + super::super::verify_module(&optimized).unwrap(); +} + +#[test] +fn logical_state_cannot_be_reintroduced_as_a_physical_zero() { + let (source, mut function) = fixture(); + let flow = DependencyFlow::checked(source, &function).unwrap(); + function.values.push(ValueDecl { + id: ValueId(0), + ty: ValueType::I32, + }); + function.blocks[0].instructions.insert( + 0, + Instruction::Constant { + destination: ValueId(0), + value: 0, + span: function.span, + }, + ); + assert!(flow.verify(&function).unwrap_err().iter().any(|failure| { + failure + .message + .contains("materializes a logical State slot") + })); +} + +#[test] +fn trapping_source_requires_an_actual_trap_without_a_normal_successor() { + let (mut source, mut function) = fixture(); + Arc::make_mut(&mut source).functions[0].assignments[2].kind = AssignmentKind::Unreachable; + function.blocks[0].instructions[1] = Instruction::Unreachable { + destination: ValueId(3), + span: function.span, + }; + function.blocks[0].terminator = Some(Terminator::Trap { + span: function.span, + }); + let flow = DependencyFlow::checked(source, &function).unwrap(); + function.blocks[0].instructions.pop(); + assert!(flow.verify(&function).is_err()); +} + +#[test] +fn ordinary_state_calls_lower_and_execute_with_only_physical_payloads() { + let (source, _) = fixture(); + let mut source = (*source).clone(); + source.externals.clear(); + let span = source.span; + let step = source.functions[0].result_type; + source.functions.push(cc::Function { + symbol: SymbolId::new(ModuleId(0), 1), + name: "produce".into(), + parameters: vec![ValueId(0)], + values: vec![ + cc::ValueDecl { + id: ValueId(0), + ty: ValueShape::State, + }, + cc::ValueDecl { + id: ValueId(1), + ty: ValueShape::Integer, + }, + cc::ValueDecl { + id: ValueId(2), + ty: step, + }, + ], + assignments: vec![ + Assignment { + destination: ValueId(1), + kind: AssignmentKind::Constant(42), + span, + }, + Assignment { + destination: ValueId(2), + kind: AssignmentKind::ProductNew { + destination: ValueId(2), + representation: ReprId(0), + arguments: vec![ValueId(0), ValueId(1)], + }, + span, + }, + ], + result: ValueId(2), + result_type: step, + span, + }); + let target = crate::TargetCapabilities::default(); + let (mir, mut wasi) = super::super::lower_module(source).unwrap(); + assert!(mir.functions.iter().all(|function| function.state.is_some() + && function.parameters.is_empty() + && function.result_type == ValueType::I32)); + let mir = super::super::opt::optimize(mir, target).unwrap(); + assert_eq!( + mir.functions[0].blocks[0] + .instructions + .iter() + .filter(|instruction| matches!(instruction, Instruction::Call { .. })) + .count(), + 2 + ); + assert!( + !mir.functions + .iter() + .flat_map(|function| &function.blocks) + .flat_map(|block| &block.instructions) + .any(|instruction| matches!(instruction, Instruction::StructNew { .. })) + ); + let context = crate::linking::default_context().unwrap(); + let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target).unwrap(); + let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link).unwrap(); + let core = crate::wasm::encode_module(&wasm).unwrap(); + crate::validator_for(target).validate_all(&core).unwrap(); + let component = crate::linking::compose(&link, &core, span, None).unwrap(); + crate::validator_for(target) + .validate_all(&component) + .unwrap(); + if std::process::Command::new("wasmtime") + .arg("--version") + .output() + .is_err() + { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + } + let path = + std::env::temp_dir().join(format!("psrs-state-projection-{}.wasm", std::process::id())); + std::fs::write(&path, component).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(path).unwrap(); + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} diff --git a/crates/psrs-backend/src/mir/tests.rs b/crates/psrs-backend/src/mir/tests/lowering.rs similarity index 50% rename from crates/psrs-backend/src/mir/tests.rs rename to crates/psrs-backend/src/mir/tests/lowering.rs index 0d2141b7..c9d74303 100644 --- a/crates/psrs-backend/src/mir/tests.rs +++ b/crates/psrs-backend/src/mir/tests/lowering.rs @@ -1,19 +1,10 @@ -use super::NumericOp; -use super::{BasicBlock, BlockId, Function, Import, Instruction, Module, Terminator}; +//! Wasm lowering from a checked MIR module. +use super::{registry, span}; +use crate::mir::{BasicBlock, BlockId, Function, Import, Instruction, Module, Terminator, UnaryOp}; use crate::types::{ - CompositeType, DefinedType, FieldType, HeapType, RecGroup, RefType, StorageType, ValueDecl, - ValueId, ValueType, + CompositeType, DefinedType, FieldType, RecGroup, StorageType, ValueDecl, ValueId, ValueType, }; use psrs_hir::{ModuleId, SymbolId}; -use psrs_span::TextRange; - -fn span() -> TextRange { - TextRange::new(0, 1) -} - -fn registry() -> crate::abi::WasiRegistry { - crate::abi::WasiRegistry::load().expect("the vendored WASI WIT should load") -} /// MIR owns a defined-type table; the Wasm lowering must carry it into the /// encoded type section ahead of the function types. @@ -31,9 +22,11 @@ fn defined_types_flow_into_the_wasm_type_section() { }]), }])], strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), @@ -80,9 +73,11 @@ fn lowers_and_validates_f64_to_f32_abi_conversions() { entry: Some(symbol), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { + state: None, id: crate::types::FunctionId(0), symbol, name: "main".into(), @@ -117,19 +112,19 @@ fn lowers_and_validates_f64_to_f32_abi_conversions() { }, Instruction::UnaryPrimitive { destination: ValueId(1), - op: super::UnaryOp::F64ToF32, + op: UnaryOp::F64ToF32, value: ValueId(0), span: span(), }, Instruction::UnaryPrimitive { destination: ValueId(2), - op: super::UnaryOp::F32ToF64, + op: UnaryOp::F32ToF64, value: ValueId(1), span: span(), }, Instruction::UnaryPrimitive { destination: ValueId(3), - op: super::UnaryOp::F64ToI32Sat, + op: UnaryOp::F64ToI32Sat, value: ValueId(2), span: span(), }, @@ -154,153 +149,6 @@ fn lowers_and_validates_f64_to_f32_abi_conversions() { .expect("the encoded f64/f32 conversion sequence should validate"); } -/// A MIR function that builds a GC struct and sums its fields, lowered through -/// the Wasm backend and executed under wasmtime. -#[test] -fn runs_a_mir_gc_struct_under_wasmtime() { - let struct_type = DefinedType { - final_type: true, - supertype: None, - composite: CompositeType::Struct(vec![ - FieldType { - storage: StorageType::I32, - mutable: false, - }, - FieldType { - storage: StorageType::I32, - mutable: false, - }, - ]), - }; - let reference = ValueType::Ref(RefType { - nullable: false, - heap: HeapType::Index(crate::types::DefinedTypeId(0)), - }); - let mir = Module { - name: "MirGc".into(), - entry: Some(SymbolId::new(ModuleId(0), 0)), - types: vec![RecGroup(vec![struct_type])], - strings: Vec::new(), - layout: None, - imports: Vec::new(), - functions: vec![Function { - id: crate::types::FunctionId(0), - symbol: SymbolId::new(ModuleId(0), 0), - name: "main".into(), - parameters: Vec::new(), - values: vec![ - ValueDecl { - id: ValueId(0), - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(1), - ty: reference, - }, - ValueDecl { - id: ValueId(2), - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(3), - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(4), - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(5), - ty: ValueType::I32, - }, - ], - entry: BlockId(0), - blocks: vec![BasicBlock { - id: BlockId(0), - parameters: Vec::new(), - instructions: vec![ - Instruction::Constant { - destination: ValueId(2), - value: 3, - span: span(), - }, - Instruction::Constant { - destination: ValueId(3), - value: 4, - span: span(), - }, - Instruction::StructNew { - destination: ValueId(1), - type_index: crate::types::DefinedTypeId(0), - arguments: vec![ValueId(2), ValueId(3)], - span: span(), - }, - Instruction::StructGet { - destination: ValueId(4), - type_index: crate::types::DefinedTypeId(0), - field: 0, - value: ValueId(1), - span: span(), - }, - Instruction::StructGet { - destination: ValueId(5), - type_index: crate::types::DefinedTypeId(0), - field: 1, - value: ValueId(1), - span: span(), - }, - Instruction::Primitive { - destination: ValueId(0), - op: NumericOp::I32Add, - left: ValueId(4), - right: ValueId(5), - span: span(), - }, - ], - terminator: Some(Terminator::Return { - value: ValueId(0), - span: span(), - }), - }], - result: ValueId(0), - result_type: ValueType::I32, - span: span(), - }], - span: span(), - }; - - let context = crate::linking::default_context().expect("resolved world"); - let mut wasi = registry(); - let target = crate::TargetCapabilities::default(); - let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target) - .expect("checked target plan"); - let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link) - .expect("lowering to Wasm"); - let core = crate::wasm::encode_module(&wasm).expect("encoding"); - crate::validator() - .validate_all(&core) - .expect("the encoded module should validate"); - - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - eprintln!("skipping: wasmtime is not installed"); - return; - } - let component = crate::linking::compose(&link, &core, mir.span, None).expect("componentizing"); - let path = std::env::temp_dir().join(format!("psrs-mir-gc-{}.wasm", std::process::id())); - std::fs::write(&path, &component).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - let _ = std::fs::remove_file(&path); - assert_eq!(output.status.code(), Some(7), "wasmtime output: {output:?}"); -} - /// A MIR module that calls a declared import: the Wasm lowering names the /// import from the ABI registry and the module validates. Canonical argument /// adaptation is covered through the driver's `log` test. @@ -316,13 +164,16 @@ fn lowers_an_imported_call() { entry: Some(SymbolId::new(ModuleId(0), 0)), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: vec![Import { + runtime: None, symbol: callee, parameters: import.parameters.clone(), result: import.result, }], functions: vec![Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), @@ -375,9 +226,11 @@ fn wasm_lowering_requires_an_explicit_entry_symbol() { entry: None, types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), @@ -415,80 +268,3 @@ fn wasm_lowering_requires_an_explicit_entry_symbol() { "{errors:?}" ); } - -/// The MIR verifier checks struct field types, not just the type index range. -#[test] -fn rejects_a_struct_new_with_a_mistyped_field() { - let mir = Module { - name: "BadStruct".into(), - entry: None, - types: vec![RecGroup(vec![DefinedType { - final_type: true, - supertype: None, - composite: CompositeType::Struct(vec![FieldType { - storage: StorageType::I64, - mutable: false, - }]), - }])], - strings: Vec::new(), - layout: None, - imports: Vec::new(), - functions: vec![Function { - id: crate::types::FunctionId(0), - symbol: SymbolId::new(ModuleId(0), 0), - name: "main".into(), - parameters: Vec::new(), - values: vec![ - ValueDecl { - id: ValueId(0), - ty: ValueType::I64, - }, - ValueDecl { - id: ValueId(1), - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(2), - ty: ValueType::Ref(RefType { - nullable: false, - heap: HeapType::Index(crate::types::DefinedTypeId(0)), - }), - }, - ], - entry: BlockId(0), - blocks: vec![BasicBlock { - id: BlockId(0), - parameters: Vec::new(), - instructions: vec![ - Instruction::Constant { - destination: ValueId(1), - value: 1, - span: span(), - }, - Instruction::StructNew { - destination: ValueId(2), - type_index: crate::types::DefinedTypeId(0), - arguments: vec![ValueId(1)], - span: span(), - }, - ], - terminator: Some(Terminator::Return { - value: ValueId(0), - span: span(), - }), - }], - result: ValueId(0), - result_type: ValueType::I64, - span: span(), - }], - span: span(), - }; - - let errors = crate::mir::verify_module(&mir).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("struct.new argument has the wrong type")), - "{errors:?}" - ); -} diff --git a/crates/psrs-backend/src/mir/tests/mod.rs b/crates/psrs-backend/src/mir/tests/mod.rs new file mode 100644 index 00000000..1b19dd4c --- /dev/null +++ b/crates/psrs-backend/src/mir/tests/mod.rs @@ -0,0 +1,14 @@ +//! MIR-level tests grouped by the boundary each one exercises. +use psrs_span::TextRange; + +mod lowering; +mod runtime; +mod verify; + +pub(super) fn span() -> TextRange { + TextRange::new(0, 1) +} + +pub(super) fn registry() -> crate::abi::WasiRegistry { + crate::abi::WasiRegistry::load().expect("the vendored WASI WIT should load") +} diff --git a/crates/psrs-backend/src/mir/tests/runtime.rs b/crates/psrs-backend/src/mir/tests/runtime.rs new file mode 100644 index 00000000..7f09eff0 --- /dev/null +++ b/crates/psrs-backend/src/mir/tests/runtime.rs @@ -0,0 +1,157 @@ +//! End-to-end execution of a lowered MIR module under a Wasm runtime. +use super::{registry, span}; +use crate::mir::{BasicBlock, BlockId, Function, Instruction, Module, NumericOp, Terminator}; +use crate::types::{ + CompositeType, DefinedType, FieldType, HeapType, RecGroup, RefType, StorageType, ValueDecl, + ValueId, ValueType, +}; +use psrs_hir::{ModuleId, SymbolId}; + +/// A MIR function that builds a GC struct and sums its fields, lowered through +/// the Wasm backend and executed under wasmtime. +#[test] +fn runs_a_mir_gc_struct_under_wasmtime() { + let struct_type = DefinedType { + final_type: true, + supertype: None, + composite: CompositeType::Struct(vec![ + FieldType { + storage: StorageType::I32, + mutable: false, + }, + FieldType { + storage: StorageType::I32, + mutable: false, + }, + ]), + }; + let reference = ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(crate::types::DefinedTypeId(0)), + }); + let mir = Module { + name: "MirGc".into(), + entry: Some(SymbolId::new(ModuleId(0), 0)), + types: vec![RecGroup(vec![struct_type])], + strings: Vec::new(), + dependencies: Default::default(), + layout: None, + imports: Vec::new(), + functions: vec![Function { + state: None, + id: crate::types::FunctionId(0), + symbol: SymbolId::new(ModuleId(0), 0), + name: "main".into(), + parameters: Vec::new(), + values: vec![ + ValueDecl { + id: ValueId(0), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(1), + ty: reference, + }, + ValueDecl { + id: ValueId(2), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(3), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(4), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(5), + ty: ValueType::I32, + }, + ], + entry: BlockId(0), + blocks: vec![BasicBlock { + id: BlockId(0), + parameters: Vec::new(), + instructions: vec![ + Instruction::Constant { + destination: ValueId(2), + value: 3, + span: span(), + }, + Instruction::Constant { + destination: ValueId(3), + value: 4, + span: span(), + }, + Instruction::StructNew { + destination: ValueId(1), + type_index: crate::types::DefinedTypeId(0), + arguments: vec![ValueId(2), ValueId(3)], + span: span(), + }, + Instruction::StructGet { + destination: ValueId(4), + type_index: crate::types::DefinedTypeId(0), + field: 0, + value: ValueId(1), + span: span(), + }, + Instruction::StructGet { + destination: ValueId(5), + type_index: crate::types::DefinedTypeId(0), + field: 1, + value: ValueId(1), + span: span(), + }, + Instruction::Primitive { + destination: ValueId(0), + op: NumericOp::I32Add, + left: ValueId(4), + right: ValueId(5), + span: span(), + }, + ], + terminator: Some(Terminator::Return { + value: ValueId(0), + span: span(), + }), + }], + result: ValueId(0), + result_type: ValueType::I32, + span: span(), + }], + span: span(), + }; + + let context = crate::linking::default_context().expect("resolved world"); + let mut wasi = registry(); + let target = crate::TargetCapabilities::default(); + let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target) + .expect("checked target plan"); + let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link) + .expect("lowering to Wasm"); + let core = crate::wasm::encode_module(&wasm).expect("encoding"); + crate::validator() + .validate_all(&core) + .expect("the encoded module should validate"); + + if std::process::Command::new("wasmtime") + .arg("--version") + .output() + .is_err() + { + eprintln!("skipping: wasmtime is not installed"); + return; + } + let component = crate::linking::compose(&link, &core, mir.span, None).expect("componentizing"); + let path = std::env::temp_dir().join(format!("psrs-mir-gc-{}.wasm", std::process::id())); + std::fs::write(&path, &component).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + let _ = std::fs::remove_file(&path); + assert_eq!(output.status.code(), Some(7), "wasmtime output: {output:?}"); +} diff --git a/crates/psrs-backend/src/mir/tests/verify.rs b/crates/psrs-backend/src/mir/tests/verify.rs new file mode 100644 index 00000000..8d6c7860 --- /dev/null +++ b/crates/psrs-backend/src/mir/tests/verify.rs @@ -0,0 +1,87 @@ +//! MIR verification of a hand-built module. +use super::span; +use crate::mir::{BasicBlock, BlockId, Function, Instruction, Module, Terminator}; +use crate::types::{ + CompositeType, DefinedType, FieldType, HeapType, RecGroup, RefType, StorageType, ValueDecl, + ValueId, ValueType, +}; +use psrs_hir::{ModuleId, SymbolId}; + +/// The MIR verifier checks struct field types, not just the type index range. +#[test] +fn rejects_a_struct_new_with_a_mistyped_field() { + let mir = Module { + name: "BadStruct".into(), + entry: None, + types: vec![RecGroup(vec![DefinedType { + final_type: true, + supertype: None, + composite: CompositeType::Struct(vec![FieldType { + storage: StorageType::I64, + mutable: false, + }]), + }])], + strings: Vec::new(), + dependencies: Default::default(), + layout: None, + imports: Vec::new(), + functions: vec![Function { + state: None, + id: crate::types::FunctionId(0), + symbol: SymbolId::new(ModuleId(0), 0), + name: "main".into(), + parameters: Vec::new(), + values: vec![ + ValueDecl { + id: ValueId(0), + ty: ValueType::I64, + }, + ValueDecl { + id: ValueId(1), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(2), + ty: ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(crate::types::DefinedTypeId(0)), + }), + }, + ], + entry: BlockId(0), + blocks: vec![BasicBlock { + id: BlockId(0), + parameters: Vec::new(), + instructions: vec![ + Instruction::Constant { + destination: ValueId(1), + value: 1, + span: span(), + }, + Instruction::StructNew { + destination: ValueId(2), + type_index: crate::types::DefinedTypeId(0), + arguments: vec![ValueId(1)], + span: span(), + }, + ], + terminator: Some(Terminator::Return { + value: ValueId(0), + span: span(), + }), + }], + result: ValueId(0), + result_type: ValueType::I64, + span: span(), + }], + span: span(), + }; + + let errors = crate::mir::verify_module(&mir).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("struct.new argument has the wrong type")), + "{errors:?}" + ); +} diff --git a/crates/psrs-backend/src/mir/verify/array_map/mod.rs b/crates/psrs-backend/src/mir/verify/array_map/mod.rs index 9c7325ca..1dfc36ab 100644 --- a/crates/psrs-backend/src/mir/verify/array_map/mod.rs +++ b/crates/psrs-backend/src/mir/verify/array_map/mod.rs @@ -412,19 +412,5 @@ fn verify_loop_increment( } fn successors(terminator: &Terminator) -> Vec { - match terminator { - Terminator::Return { .. } => Vec::new(), - Terminator::Jump { target, .. } => vec![*target], - Terminator::Branch { - then_block, - else_block, - .. - } => vec![*then_block, *else_block], - Terminator::Switch { cases, default, .. } => cases - .iter() - .map(|(_, target)| *target) - .chain(std::iter::once(*default)) - .collect(), - Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => Vec::new(), - } + crate::mir::cfg::successors(terminator) } diff --git a/crates/psrs-backend/src/mir/verify/array_map/tests.rs b/crates/psrs-backend/src/mir/verify/array_map/tests.rs index 63bbd711..510b1fe4 100644 --- a/crates/psrs-backend/src/mir/verify/array_map/tests.rs +++ b/crates/psrs-backend/src/mir/verify/array_map/tests.rs @@ -28,6 +28,7 @@ fn verified_array_map_module(mut function: Function) -> crate::mir::Module { }]), ], strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(function.symbol), @@ -58,6 +59,7 @@ fn array_map_function() -> Function { }; Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "array_map_verifier_test".into(), diff --git a/crates/psrs-backend/src/mir/verify/capability.rs b/crates/psrs-backend/src/mir/verify/capability.rs index 176a8a44..6b214d63 100644 --- a/crates/psrs-backend/src/mir/verify/capability.rs +++ b/crates/psrs-backend/src/mir/verify/capability.rs @@ -201,6 +201,7 @@ mod tests { composite: CompositeType::Struct(Vec::new()), }])], strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), @@ -322,6 +323,7 @@ mod tests { let mut module = module_with_function_type(Vec::new(), Vec::new()); module.types.clear(); module.imports.push(mir::Import { + runtime: None, symbol: SymbolId::new(ModuleId(4), 9), parameters: vec![ValueType::Ref(RefType { nullable: true, @@ -359,6 +361,7 @@ mod tests { }, }])], strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), @@ -373,9 +376,11 @@ mod tests { name: "capability-instruction-test".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![mir::Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(4), 0), name: "capability".into(), @@ -454,9 +459,11 @@ mod tests { name: "capability-tail-test".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![mir::Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(4), 0), name: "tail".into(), diff --git a/crates/psrs-backend/src/mir/verify/function.rs b/crates/psrs-backend/src/mir/verify/function.rs index 130ace88..aceac04b 100644 --- a/crates/psrs-backend/src/mir/verify/function.rs +++ b/crates/psrs-backend/src/mir/verify/function.rs @@ -257,25 +257,12 @@ fn compute_dominators( } fn terminator_successors(terminator: &Terminator) -> Vec { - match terminator { - Terminator::Return { .. } => Vec::new(), - Terminator::Jump { target, .. } => vec![*target], - Terminator::Branch { - then_block, - else_block, - .. - } => vec![*then_block, *else_block], - Terminator::Switch { cases, default, .. } => cases - .iter() - .map(|(_, block)| *block) - .chain(std::iter::once(*default)) - .collect(), - Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => Vec::new(), - } + crate::mir::cfg::successors(terminator) } fn terminator_operands(terminator: &Terminator) -> Vec { match terminator { + Terminator::Trap { .. } => Vec::new(), Terminator::Return { value, .. } => vec![*value], Terminator::Jump { arguments, .. } => arguments.clone(), Terminator::Branch { condition, .. } => vec![*condition], @@ -293,7 +280,8 @@ fn terminator_operands(terminator: &Terminator) -> Vec { fn terminator_span(terminator: &Terminator) -> psrs_span::TextRange { match terminator { - Terminator::Return { span, .. } + Terminator::Trap { span } + | Terminator::Return { span, .. } | Terminator::Jump { span, .. } | Terminator::Branch { span, .. } | Terminator::Switch { span, .. } @@ -311,6 +299,7 @@ fn verify_terminator( defined: &[&DefinedType], ) -> Result<(), Vec> { match terminator { + Terminator::Trap { .. } => {} Terminator::Return { value, span } => { if require_value(definitions, *value, *span)? != function.result_type { return Err(mir_error(*span, "MIR return value has the wrong type")); diff --git a/crates/psrs-backend/src/mir/verify/instruction/lists.rs b/crates/psrs-backend/src/mir/verify/instruction/lists.rs index dc85c730..56c444af 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/lists.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/lists.rs @@ -3,7 +3,7 @@ use super::super::util::{composite_at, is_array_reference, mir_error, require_value}; use crate::BackendError; use crate::abi::canonical::CanonicalType; -use crate::cc::{GuestLayout, ValueShape}; +use crate::cc::{GuestLayout, RefShape, ValueShape}; use crate::mir::{Function, Instruction, ListDirection, ValueId, ValueType}; use crate::types::{CompositeType, DefinedType, StorageType}; use std::collections::HashMap; @@ -42,7 +42,20 @@ pub(super) fn verify_list_copy( let Some(CompositeType::Array(field)) = composite_at(defined, *array_type) else { return Err(mir_error(*span, "MIR list copy type is not an array")); }; - if !element_storage_matches(element, &field.storage) { + let erased_scalar = matches!(element_guest, + GuestLayout::Scalar { shape: ValueShape::Reference(reference) } + if reference.heap == RefShape::Erased) + && matches!(&field.storage, StorageType::Ref(reference) if reference.heap == crate::types::HeapType::Eq) + && matches!( + element, + CanonicalType::Bool + | CanonicalType::Int { .. } + | CanonicalType::Float { .. } + | CanonicalType::Char + | CanonicalType::Enum(_) + | CanonicalType::Handle { .. } + ); + if !erased_scalar && !element_storage_matches(element, &field.storage) { return Err(mir_error( *span, "MIR list copy element does not match the GC array", @@ -110,6 +123,7 @@ fn element_storage_matches(element: &CanonicalType, storage: &StorageType) -> bo /// Whether the struct field storage can hold a product field shape. fn field_storage_matches(shape: ValueShape, storage: &StorageType) -> bool { match shape { + ValueShape::State => false, ValueShape::Integer | ValueShape::Boolean => *storage == StorageType::I32, ValueShape::Number => *storage == StorageType::F64, ValueShape::String | ValueShape::Reference(_) => matches!(storage, StorageType::Ref(_)), diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index 325d14f6..4a25a472 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -32,6 +32,9 @@ struct Signature { pub fn verify_module(module: &Module) -> Result<(), Vec> { let mut errors = Vec::new(); verify_defined_types(module, &mut errors); + if let Err(failures) = module.dependencies.verify(module) { + errors.extend(failures); + } let mut signatures = module .functions .iter() @@ -67,6 +70,16 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { let defined = defined_types_list(module); let mut function_ids = HashSet::new(); for (position, function) in module.functions.iter().enumerate() { + if let Some(state) = &function.state + && let Err(failures) = state.verify(function) + { + errors.extend(failures); + } + if let Some(state) = &function.state + && let Err(failures) = state.verify_imports(module) + { + errors.extend(failures); + } if !function_ids.insert(function.id) || function.id != FunctionId(position as u32) { errors.extend(mir_error( function.span, @@ -133,8 +146,14 @@ fn defined_types_list(module: &Module) -> Vec<&DefinedType> { } fn verify_defined_types(module: &Module, errors: &mut Vec) { - let count = defined_type_count(module); + let mut count = DefinedTypeId(0); for group in &module.types { + if group.0.is_empty() { + errors.extend(mir_error(module.span, "MIR recursion group is empty")); + } + // A definition can refer to earlier groups or its own group, but + // never a later group. Runtime values use the full module type scope. + count.0 += group.0.len() as u32; for def in &group.0 { if let Some(supertype) = def.supertype && supertype.0 >= count.0 diff --git a/crates/psrs-backend/src/mir/verify/tests/arrays.rs b/crates/psrs-backend/src/mir/verify/tests/arrays.rs index 306ce3ff..0db44ba9 100644 --- a/crates/psrs-backend/src/mir/verify/tests/arrays.rs +++ b/crates/psrs-backend/src/mir/verify/tests/arrays.rs @@ -12,6 +12,7 @@ fn array_conversion_function( heap: HeapType::Index(DefinedTypeId(0)), }); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "array_default".into(), @@ -221,6 +222,7 @@ fn clone_function(element_storage: crate::types::StorageType) -> (Function, Vec< heap: HeapType::Index(DefinedTypeId(0)), }); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "array_clone".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/dictionary.rs b/crates/psrs-backend/src/mir/verify/tests/dictionary.rs index a9560262..9e53497b 100644 --- a/crates/psrs-backend/src/mir/verify/tests/dictionary.rs +++ b/crates/psrs-backend/src/mir/verify/tests/dictionary.rs @@ -73,6 +73,7 @@ fn return_function( result_type: ValueType, ) -> Function { Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: name.into(), @@ -212,6 +213,7 @@ fn rejects_dictionary_struct_get_with_wrong_result_type() { fn method_function() -> Function { let result = ValueId(0); Function { + state: None, id: FunctionId(1), symbol: SymbolId::new(ModuleId(0), 1), name: "method".into(), @@ -273,6 +275,7 @@ fn rejects_a_non_dominating_dictionary_projection() { let dictionary = ValueId(3); let projected = ValueId(4); let function = Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "non_dominating_projection".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/dominance.rs b/crates/psrs-backend/src/mir/verify/tests/dominance.rs index a8bb0a14..af9d6482 100644 --- a/crates/psrs-backend/src/mir/verify/tests/dominance.rs +++ b/crates/psrs-backend/src/mir/verify/tests/dominance.rs @@ -17,6 +17,7 @@ fn module_with(function: Function) -> Module { name: "DominanceTest".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(function.symbol), @@ -27,6 +28,7 @@ fn module_with(function: Function) -> Module { fn function(values: Vec, blocks: Vec) -> Function { Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "dominance".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/effects.rs b/crates/psrs-backend/src/mir/verify/tests/effects.rs index 51fd911e..12c8e534 100644 --- a/crates/psrs-backend/src/mir/verify/tests/effects.rs +++ b/crates/psrs-backend/src/mir/verify/tests/effects.rs @@ -76,6 +76,7 @@ fn effect_closure_call( values: Vec, ) -> Function { Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "effect_closure_call".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/gaps.rs b/crates/psrs-backend/src/mir/verify/tests/gaps.rs index 7972272b..e3ee1d85 100644 --- a/crates/psrs-backend/src/mir/verify/tests/gaps.rs +++ b/crates/psrs-backend/src/mir/verify/tests/gaps.rs @@ -57,6 +57,7 @@ fn rejects_ref_cast_between_unrelated_heaps() { results: Vec::new(), }); let function = Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_cast".into(), @@ -106,6 +107,7 @@ fn accepts_an_erased_upcast_to_eqref() { let output = ValueId(1); let struct_type = final_type(CompositeType::Struct(Vec::new())); let function = Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "erased_upcast".into(), @@ -172,6 +174,7 @@ fn closure_callee() -> Function { let closure = ValueId(0); let argument = ValueId(1); Function { + state: None, id: FunctionId(1), symbol: SymbolId::new(ModuleId(0), 1), name: "callee".into(), @@ -199,6 +202,7 @@ fn rejects_a_closure_capture_outside_the_eq_hierarchy() { let closure = ValueId(1); let mut module = custom_module( Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_capture".into(), @@ -281,6 +285,7 @@ fn helper_function(blocks: Vec, values: Vec) -> Function let input = ValueId(0); let output = ValueId(1); Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "aggregate_convert_0".into(), @@ -369,6 +374,7 @@ fn get_capture_function(destination_type: ValueType) -> Function { let closure = ValueId(0); let destination = ValueId(1); Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "capture_projection".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/mod.rs b/crates/psrs-backend/src/mir/verify/tests/mod.rs index ed88bf2c..e3c0fc18 100644 --- a/crates/psrs-backend/src/mir/verify/tests/mod.rs +++ b/crates/psrs-backend/src/mir/verify/tests/mod.rs @@ -14,6 +14,7 @@ fn module_with_function(function: Function, types: Vec) -> Module { name: "VerifierTest".into(), types, strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(function.symbol), @@ -25,6 +26,7 @@ fn module_with_function(function: Function, types: Vec) -> Module { #[test] fn rejects_constants_with_incompatible_result_types() { let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_constant".into(), @@ -65,6 +67,7 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { let input = ValueId(0); let output = ValueId(1); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_unary".into(), @@ -127,6 +130,7 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { fn rejects_duplicate_switch_case_values() { let selector = ValueId(0); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "duplicate_switch_cases".into(), @@ -183,6 +187,7 @@ fn rejects_duplicate_switch_case_values() { #[test] fn rejects_values_used_before_definition() { let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_order".into(), @@ -245,6 +250,7 @@ fn rejects_ref_func_with_a_different_target_signature() { }; let callee = SymbolId::new(ModuleId(0), 1); let callee_function = Function { + state: None, id: crate::types::FunctionId(1), symbol: callee, name: "callee".into(), @@ -276,6 +282,7 @@ fn rejects_ref_func_with_a_different_target_signature() { heap: crate::types::HeapType::Index(crate::types::DefinedTypeId(0)), }); let caller = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "caller".into(), @@ -317,6 +324,7 @@ fn rejects_ref_func_with_a_different_target_signature() { #[test] fn rejects_a_load_from_an_unknown_memory_id() { let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_memory".into(), @@ -385,6 +393,7 @@ fn rejects_a_branch_target_with_block_parameters() { let then_parameter = ValueId(2); let merge_parameter = ValueId(3); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_branch_target".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/scalar.rs b/crates/psrs-backend/src/mir/verify/tests/scalar.rs index 9ad3c180..242e55ff 100644 --- a/crates/psrs-backend/src/mir/verify/tests/scalar.rs +++ b/crates/psrs-backend/src/mir/verify/tests/scalar.rs @@ -10,6 +10,7 @@ fn primitive_function( let right = ValueId(1); let output = ValueId(2); Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_primitive".into(), @@ -110,6 +111,7 @@ fn rejects_an_integer_comparison_that_produces_i32() { fn rejects_a_boolean_constant_that_is_not_canonical() { let output = ValueId(0); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_boolean_constant".into(), @@ -149,6 +151,7 @@ fn rejects_a_boolean_constant_that_is_not_canonical() { fn rejects_a_call_with_the_wrong_argument_type() { let callee_symbol = SymbolId::new(ModuleId(0), 1); let helper = Function { + state: None, id: crate::types::FunctionId(1), symbol: callee_symbol, name: "__psrs_euclidean_int_div".into(), @@ -180,6 +183,7 @@ fn rejects_a_call_with_the_wrong_argument_type() { let argument = ValueId(0); let call_result = ValueId(1); let caller = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "caller".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/structure.rs b/crates/psrs-backend/src/mir/verify/tests/structure.rs index 609a5919..a67079bd 100644 --- a/crates/psrs-backend/src/mir/verify/tests/structure.rs +++ b/crates/psrs-backend/src/mir/verify/tests/structure.rs @@ -5,6 +5,7 @@ use super::*; fn simple_function(values: Vec, blocks: Vec) -> Function { Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "structure".into(), @@ -131,3 +132,47 @@ fn rejects_a_value_defined_by_two_instructions() { "{errors:?}" ); } + +#[test] +fn recursive_references_are_scoped_to_their_declared_group() { + use crate::types::{ + CompositeType, DefinedType, DefinedTypeId, FieldType, HeapType, RecGroup, RefType, + StorageType, + }; + let definition = |target| DefinedType { + final_type: true, + supertype: None, + composite: CompositeType::Struct(vec![FieldType { + storage: StorageType::Ref(RefType { + nullable: true, + heap: HeapType::Index(DefinedTypeId(target)), + }), + mutable: false, + }]), + }; + let mut source = Module { + name: "recursive_group_scope".into(), + types: vec![RecGroup(vec![definition(1), definition(0)])], + strings: Vec::new(), + dependencies: Default::default(), + layout: None, + imports: Vec::new(), + functions: Vec::new(), + entry: None, + span: span(), + }; + verify_module(&source).unwrap(); + source.types = vec![RecGroup(vec![definition(1)]), RecGroup(vec![definition(0)])]; + assert!(verify_module(&source).unwrap_err().iter().any(|error| { + error + .message + .contains("defined type reference is out of range") + })); + source.types = vec![RecGroup(Vec::new())]; + assert!( + verify_module(&source) + .unwrap_err() + .iter() + .any(|error| error.message.contains("recursion group is empty")) + ); +} diff --git a/crates/psrs-backend/src/mir/verify/tests/subtype.rs b/crates/psrs-backend/src/mir/verify/tests/subtype.rs index 25795a48..fb97fdbc 100644 --- a/crates/psrs-backend/src/mir/verify/tests/subtype.rs +++ b/crates/psrs-backend/src/mir/verify/tests/subtype.rs @@ -17,6 +17,7 @@ fn module_with(types: Vec) -> Module { name: "SubtypeTest".into(), types, strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), diff --git a/crates/psrs-backend/src/mir/verify/tests/switch.rs b/crates/psrs-backend/src/mir/verify/tests/switch.rs index e1c09804..527d032e 100644 --- a/crates/psrs-backend/src/mir/verify/tests/switch.rs +++ b/crates/psrs-backend/src/mir/verify/tests/switch.rs @@ -7,6 +7,7 @@ use psrs_hir::{ModuleId, SymbolId}; fn rejects_a_switch_with_a_non_i32_selector() { let selector = ValueId(0); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "non_i32_switch_selector".into(), @@ -60,6 +61,7 @@ fn rejects_a_projection_that_is_not_dominated_by_its_tag_test() { let projected = ValueId(1); let result = ValueId(2); let function = Function { + state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "nondominating_projection".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/tail.rs b/crates/psrs-backend/src/mir/verify/tests/tail.rs index 92415d51..05ec9138 100644 --- a/crates/psrs-backend/src/mir/verify/tests/tail.rs +++ b/crates/psrs-backend/src/mir/verify/tests/tail.rs @@ -20,6 +20,7 @@ fn module_with(caller: Function, callee: Function) -> Module { name: "TailVerifierTest".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(caller.symbol), @@ -33,6 +34,7 @@ fn callee(parameters: Vec, result_type: ValueType) -> Function { let result = parameter.id; let parameter_ty = parameter.ty; return Function { + state: None, id: FunctionId(1), symbol: symbol(1), name: "callee".into(), @@ -67,6 +69,7 @@ fn callee(parameters: Vec, result_type: ValueType) -> Function { }, }; Function { + state: None, id: FunctionId(1), symbol: symbol(1), name: "callee".into(), @@ -98,6 +101,7 @@ fn caller( terminator: Terminator, ) -> Function { Function { + state: None, id: FunctionId(0), symbol: symbol(0), name: "caller".into(), diff --git a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs index a40f1824..578555fc 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs @@ -244,6 +244,7 @@ fn read_value_concrete( span: TextRange, ) -> Result> { match shape { + ValueShape::State => Err(unsupported(span)), ValueShape::Integer | ValueShape::Boolean => { read_scalar(lowerer, kind, address, offset, block, span) } diff --git a/crates/psrs-backend/src/mir/wit/aggregate/mod.rs b/crates/psrs-backend/src/mir/wit/aggregate/mod.rs index 492178a2..410ad549 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/mod.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/mod.rs @@ -339,6 +339,7 @@ pub(super) fn recover_payload( } let recovered = match &concrete { crate::cc::GuestLayout::Scalar { shape } => match shape { + ValueShape::State => return Err(unsupported(span)), ValueShape::Integer => unbox_scalar(lowerer, value, false, block, span)?, ValueShape::Boolean => unbox_scalar(lowerer, value, true, block, span)?, ValueShape::Number => unbox_number(lowerer, value, block, span)?, diff --git a/crates/psrs-backend/src/mir/wit/call_lowerer.rs b/crates/psrs-backend/src/mir/wit/call_lowerer.rs index 050b5841..edef6373 100644 --- a/crates/psrs-backend/src/mir/wit/call_lowerer.rs +++ b/crates/psrs-backend/src/mir/wit/call_lowerer.rs @@ -8,6 +8,10 @@ use crate::types::{DefinedTypeId, ValueId, ValueType}; use psrs_span::TextRange; pub(crate) trait WitCallLowerer { + /// The physical type of a checked concrete result before payload erasure. + fn wit_value_type(&self, _shape: ValueShape) -> Option { + None + } fn fresh_wit_value(&mut self, ty: ValueType) -> ValueId; fn append_wit_instruction( &mut self, @@ -125,6 +129,10 @@ pub(crate) trait WitCallLowerer { None } + fn wit_stored_guest_layout(&self, field: &crate::cc::Field) -> Option { + self.wit_guest_layout(field.stored) + } + /// Converts an aggregate into or out of its bare-slot storage protocol. fn wit_payload_conversion( &mut self, diff --git a/crates/psrs-backend/src/mir/wit/function_lowerer.rs b/crates/psrs-backend/src/mir/wit/function_lowerer.rs index 2344ae2e..3e157c0d 100644 --- a/crates/psrs-backend/src/mir/wit/function_lowerer.rs +++ b/crates/psrs-backend/src/mir/wit/function_lowerer.rs @@ -7,6 +7,9 @@ use crate::types::{DefinedTypeId, ValueId, ValueType}; use psrs_span::TextRange; impl WitCallLowerer for FunctionLowerer<'_> { + fn wit_value_type(&self, shape: crate::cc::ValueShape) -> Option { + self.resolved_value_type(&shape) + } fn fresh_wit_value(&mut self, ty: ValueType) -> ValueId { self.fresh(ty) } @@ -169,6 +172,10 @@ impl WitCallLowerer for FunctionLowerer<'_> { self.resolved_guest_layout(shape) } + fn wit_stored_guest_layout(&self, field: &crate::cc::Field) -> Option { + crate::cc::payload::stored_guest_layout(field, self.layout.representation_table()) + } + fn wit_payload_conversion( &mut self, block: BlockId, diff --git a/crates/psrs-backend/src/mir/wit/lists/mod.rs b/crates/psrs-backend/src/mir/wit/lists/mod.rs index d899e3dc..7da03e74 100644 --- a/crates/psrs-backend/src/mir/wit/lists/mod.rs +++ b/crates/psrs-backend/src/mir/wit/lists/mod.rs @@ -269,7 +269,7 @@ fn element_guest( span: TextRange, ) -> Result> { if let Some(GuestLayout::Array { element: field, .. }) = list - && let Some(layout) = lowerer.wit_guest_layout(field.stored) + && let Some(layout) = lowerer.wit_stored_guest_layout(field) { return Ok(layout); } diff --git a/crates/psrs-backend/src/mir/wit/mod.rs b/crates/psrs-backend/src/mir/wit/mod.rs index a7cb4e8f..cafbd180 100644 --- a/crates/psrs-backend/src/mir/wit/mod.rs +++ b/crates/psrs-backend/src/mir/wit/mod.rs @@ -14,11 +14,13 @@ mod function_lowerer; mod handles; mod lists; mod parameters; +mod plan; pub(super) use bind::BoundFn; pub(super) use call_lowerer::WitCallLowerer; pub(super) use handles::verify_function; pub(super) use parameters::lower_string; +pub(in crate::mir) use plan::CallPlan; use super::{BlockId, instruction::Instruction}; use crate::BackendError; @@ -79,6 +81,88 @@ pub(super) fn lower( arguments: &[ValueId], span: TextRange, entry: BlockId, +) -> Result> { + // Canonical construction produces a concrete guest value. An erased + // source slot is filled only after the shared payload protocol discharges + // its concrete representation, including block parameter types. + let concrete = projection + .and_then(|projection| projection.result.as_ref()) + .map(GuestLayout::shape) + .filter(|shape| { + matches!( + signature.result, + crate::cc::ValueShape::Reference(crate::cc::Reference { + heap: crate::cc::RefShape::Erased | crate::cc::RefShape::Aggregate, + .. + }) + ) && *shape != signature.result + }); + let Some(shape) = concrete else { + return lower_concrete( + lowerer, + import, + signature, + projection, + destination, + arguments, + span, + entry, + ); + }; + let ty = lowerer.wit_value_type(shape).ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 canonical call planning", + span, + "canonical result has no checked concrete value type", + )] + })?; + let value = lowerer.fresh_wit_value(ty); + let current = lower_concrete( + lowerer, import, signature, projection, value, arguments, span, entry, + )?; + if signature.result == crate::cc::payload::erased_shape() { + let (current, value) = lowerer.wit_payload_conversion(current, value, shape, true, span)?; + lowerer.append_wit_instruction( + current, + Instruction::Copy { + destination, + value, + span, + }, + span, + )?; + return Ok(current); + } + let Some(ValueType::Ref(reference)) = lowerer.wit_value_type(signature.result) else { + return Err(vec![BackendError::invalid_ir( + "P9 canonical call planning", + span, + "canonical aggregate result has no checked reference slot", + )]); + }; + lowerer.append_wit_instruction( + current, + Instruction::RefCast { + destination, + value, + reference, + span, + }, + span, + )?; + Ok(current) +} + +#[allow(clippy::too_many_arguments)] +fn lower_concrete( + lowerer: &mut L, + import: &WasiImport, + signature: &crate::cc::Signature, + projection: Option<&crate::cc::ExternalProjection>, + destination: ValueId, + arguments: &[ValueId], + span: TextRange, + entry: BlockId, ) -> Result> { let bound = BoundFn::bind(import, signature, projection); let mut flat = Vec::new(); diff --git a/crates/psrs-backend/src/mir/wit/parameters/primitive.rs b/crates/psrs-backend/src/mir/wit/parameters/primitive.rs index 40296aa5..b0a1b000 100644 --- a/crates/psrs-backend/src/mir/wit/parameters/primitive.rs +++ b/crates/psrs-backend/src/mir/wit/parameters/primitive.rs @@ -51,6 +51,7 @@ fn slot_type( .copied() .ok_or_else(|| unsupported_parameter(span))?; let ty = match shape { + ValueShape::State => return Err(unsupported_parameter(span)), ValueShape::Integer => match leaf { FlatLeaf::Int32 => CanonicalType::Int { width: 32, diff --git a/crates/psrs-backend/src/mir/wit/plan.rs b/crates/psrs-backend/src/mir/wit/plan.rs new file mode 100644 index 00000000..249bee7b --- /dev/null +++ b/crates/psrs-backend/src/mir/wit/plan.rs @@ -0,0 +1,156 @@ +//! Immutable canonical adapter plans, produced before physical emission. +use crate::BackendError; +use crate::cc; +use crate::mir::{BasicBlock, BlockId, BoundWasiImport, Function}; +use crate::types::ValueDecl; +use psrs_hir::SymbolId; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(in crate::mir) struct CallPlan { + owner: SymbolId, + source: cc::Assignment, + binding: BoundWasiImport, + start: usize, + exit: BlockId, + blocks: Vec, + temporaries: Vec, +} + +impl CallPlan { + pub(in crate::mir) fn entry(&self) -> BlockId { + self.blocks[0].id + } + pub(in crate::mir) fn start(&self) -> usize { + self.start + } + pub(in crate::mir) fn exit(&self) -> (BlockId, usize) { + let block = self + .blocks + .iter() + .find(|block| block.id == self.exit) + .expect("canonical lowering returns its own exit block"); + ( + self.exit, + if self.exit == self.entry() { + self.start + } else { + 0 + } + block.instructions.len(), + ) + } + pub(in crate::mir) fn created_blocks(&self) -> impl Iterator + '_ { + self.blocks.iter().skip(1).map(|block| block.id) + } + pub(in crate::mir) fn matches_source( + &self, + assignment: &cc::Assignment, + arguments: &[cc::ValueId], + ) -> bool { + match (&self.source.kind, &assignment.kind) { + ( + cc::AssignmentKind::DirectCall { + function, + arguments: planned, + }, + cc::AssignmentKind::DirectCall { + function: actual, .. + }, + ) => { + function == actual + && planned == arguments + && self.source.destination == assignment.destination + && self.source.span == assignment.span + } + _ => false, + } + } + + pub(in crate::mir) fn verify_import( + &self, + module: &crate::mir::Module, + ) -> Result<(), Vec> { + let import = &self.binding.import; + let expected = crate::mir::Import { + runtime: None, + symbol: import.symbol, + parameters: import.parameters.clone(), + result: import.result, + }; + if module + .imports + .iter() + .find(|actual| actual.symbol == expected.symbol) + != Some(&expected) + { + return Err(vec![BackendError::invalid_ir( + "P9 canonical call verification", + self.source.span, + "canonical import differs from its immutable checked binding", + )]); + } + Ok(()) + } + #[allow(clippy::too_many_arguments)] + pub(in crate::mir) fn new( + owner: SymbolId, + source: cc::Assignment, + binding: BoundWasiImport, + start: usize, + exit: BlockId, + blocks: Vec, + temporaries: Vec, + ) -> Self { + Self { + owner, + source, + binding, + start, + exit, + blocks, + temporaries, + } + } + + pub(in crate::mir) fn verify(&self, function: &Function) -> Result<(), Vec> { + let invalid = || { + vec![BackendError::invalid_ir( + "P9 canonical call verification", + self.source.span, + "canonical adapter differs from its immutable checked plan", + )] + }; + if function.symbol != self.owner { + return Err(invalid()); + } + for temporary in &self.temporaries { + if !function.values.iter().any(|actual| actual == temporary) { + return Err(invalid()); + } + } + for (index, expected) in self.blocks.iter().enumerate() { + let actual = function + .blocks + .iter() + .find(|block| block.id == expected.id) + .ok_or_else(invalid)?; + let start = if index == 0 { self.start } else { 0 }; + let end = start + .checked_add(expected.instructions.len()) + .ok_or_else(invalid)?; + if actual.instructions.get(start..end) != Some(expected.instructions.as_slice()) { + return Err(invalid()); + } + // The exit port belongs to the enclosing source continuation; + // every other adapter edge and block is fixed by the plan. + if expected.id != self.exit + && (actual.instructions.len() != end || actual.terminator != expected.terminator) + { + return Err(invalid()); + } + if index != 0 && actual.parameters != expected.parameters { + return Err(invalid()); + } + } + Ok(()) + } +} diff --git a/crates/psrs-backend/src/mir/wit/tests/handles.rs b/crates/psrs-backend/src/mir/wit/tests/handles.rs index 9d84ba19..b41bbd91 100644 --- a/crates/psrs-backend/src/mir/wit/tests/handles.rs +++ b/crates/psrs-backend/src/mir/wit/tests/handles.rs @@ -117,6 +117,7 @@ fn an_owned_result_is_not_dropped_by_the_compiler() { fn function_calling(instructions: Vec) -> Function { Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "use-handle".into(), diff --git a/crates/psrs-backend/src/target_intrinsics/generated.rs b/crates/psrs-backend/src/target_intrinsics/generated.rs index 6a61cfb0..b7e702f6 100644 --- a/crates/psrs-backend/src/target_intrinsics/generated.rs +++ b/crates/psrs-backend/src/target_intrinsics/generated.rs @@ -31,6 +31,7 @@ pub(crate) fn signature(symbol: SymbolId, string: Option) -> Opti _ => return None, }; Some(mir::Import { + runtime: None, symbol, parameters, result: Some(result), diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 817b7a4e..88506cf5 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -28,6 +28,9 @@ pub(crate) enum Implementation { Generated(GeneratedOperation), Artifact(&'static ArtifactImplementation), Elaborated, + /// Source contracts are checked, but dependency/signature projection is + /// required before a boundary or a GC runtime call can be emitted. + StateExecutionBoundary, Unsupported, } @@ -117,6 +120,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } + Intrinsic::RunWorld | Intrinsic::RunRegion => StateExecutionBoundary, Intrinsic::Undefined => Unsupported, } } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 138257ba..85f4b10d 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -19,11 +19,19 @@ fn every_active_identity_has_an_explicit_implementation() { ); } Implementation::Unsupported => assert_eq!(intrinsic, Intrinsic::Undefined), + Implementation::StateExecutionBoundary => { + assert!(intrinsic.state_operation().is_some()); + assert!(intrinsic.descriptor().effects.may_trap); + assert!(intrinsic.descriptor().effects.may_write); + } Implementation::Generated(_) | Implementation::Elaborated => {} } } assert!(Intrinsic::from_binding("intDiv").is_none()); assert!(Intrinsic::from_binding("intMod").is_none()); + for retired in ["stateArrayRead", "stateArrayFill", "stateArrayWrite"] { + assert!(Intrinsic::from_binding(retired).is_none()); + } } #[test] diff --git a/crates/psrs-backend/src/target_runtime/mod.rs b/crates/psrs-backend/src/target_runtime/mod.rs index 7abf60e9..adec4512 100644 --- a/crates/psrs-backend/src/target_runtime/mod.rs +++ b/crates/psrs-backend/src/target_runtime/mod.rs @@ -157,6 +157,7 @@ pub(crate) fn for_symbol(symbol: SymbolId) -> Option<&'static ArtifactImplementa impl ArtifactImplementation { pub fn import(&self) -> crate::mir::Import { crate::mir::Import { + runtime: None, symbol: self.symbol, parameters: self .abi diff --git a/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs b/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs index 4fd089c3..d96f941a 100644 --- a/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs @@ -27,6 +27,7 @@ fn function( .expect("result value has a declaration") .ty; Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "extent_test".into(), @@ -45,6 +46,7 @@ fn module(function: Function) -> Module { name: "ExtentTest".into(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![function], diff --git a/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs b/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs index 315b2842..31cf873a 100644 --- a/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs +++ b/crates/psrs-backend/src/wasm/lower/post_return/tests/composition.rs @@ -24,7 +24,7 @@ pub(super) fn componentize( .collect(), }, requirements, - units: psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME), + units: psrs_linker::runtime::package_offers(&psrs_runtime::PSRS_RUNTIME).unwrap(), memory: MemoryDemand { canonical_scratch: (0, crate::abi::SCRATCH_SIZE), allocator_state: (crate::abi::HEAP_START, crate::abi::HEAP_START), diff --git a/crates/psrs-backend/src/wasm/lower/structure/cfg/mod.rs b/crates/psrs-backend/src/wasm/lower/structure/cfg/mod.rs index 107a103d..8845b137 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/cfg/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/cfg/mod.rs @@ -395,21 +395,7 @@ fn direct_children<'a>( } fn successors(terminator: &Terminator) -> Vec { - match terminator { - Terminator::Return { .. } => Vec::new(), - Terminator::Jump { target, .. } => vec![*target], - Terminator::Branch { - then_block, - else_block, - .. - } => vec![*then_block, *else_block], - Terminator::Switch { cases, default, .. } => cases - .iter() - .map(|(_, target)| *target) - .chain(std::iter::once(*default)) - .collect(), - Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. } => Vec::new(), - } + crate::mir::cfg::successors(terminator) } fn block_span(block: &BasicBlock, fallback: psrs_span::TextRange) -> psrs_span::TextRange { @@ -417,7 +403,8 @@ fn block_span(block: &BasicBlock, fallback: psrs_span::TextRange) -> psrs_span:: .terminator .as_ref() .map_or(fallback, |terminator| match terminator { - Terminator::Return { span, .. } + Terminator::Trap { span } + | Terminator::Return { span, .. } | Terminator::Jump { span, .. } | Terminator::Branch { span, .. } | Terminator::Switch { span, .. } diff --git a/crates/psrs-backend/src/wasm/lower/structure/dispatcher.rs b/crates/psrs-backend/src/wasm/lower/structure/dispatcher.rs index bdc7fe80..a7b5944f 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/dispatcher.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/dispatcher.rs @@ -110,6 +110,10 @@ impl Structurer<'_> { .ok_or_else(|| wasm_error(self.function.span, "MIR block has no terminator"))?; let span = terminator_span(terminator); match terminator { + Terminator::Trap { .. } => { + body.push(Op::Leaf(Instruction::Unreachable)); + return Ok(()); + } Terminator::Return { value, .. } => { self.emit_load(*value, span, body)?; body.push(Op::Leaf(Instruction::Return)); @@ -240,7 +244,8 @@ fn block_span(block: Option<&BasicBlock>, fallback: TextRange) -> TextRange { fn terminator_span(terminator: &Terminator) -> TextRange { match terminator { - Terminator::Return { span, .. } + Terminator::Trap { span } + | Terminator::Return { span, .. } | Terminator::Jump { span, .. } | Terminator::Branch { span, .. } | Terminator::Switch { span, .. } diff --git a/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs b/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs index 2395b511..0e1f745a 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs @@ -35,6 +35,7 @@ fn lower_and_validate(source: &Function) -> (WasmFunction, Vec) { name: source.name.clone(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![source.clone()], @@ -137,6 +138,7 @@ fn irreducible_function() -> Function { let first_branch_span = TextRange::new(10, 12); let second_branch_span = TextRange::new(20, 22); Function { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "irreducible_dispatch".into(), @@ -337,6 +339,7 @@ fn structures_and_executes_irreducible_cfg_with_block_parameters_and_sparse_swit name: function.name.clone(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![function.clone()], @@ -417,3 +420,17 @@ fn dispatcher_uses_a_br_table_and_explicit_trap_for_invalid_state() { ) )); } + +#[test] +fn dispatcher_accepts_an_explicit_trap_exit_without_return_operands() { + let mut function = irreducible_function(); + function + .blocks + .iter_mut() + .find(|block| block.id == BlockId(9)) + .unwrap() + .terminator = Some(Terminator::Trap { span: span() }); + // The cyclic multiple-entry region still requires a dispatcher. Its trap + // exit has no normal successor or result operand. + lower_and_validate(&function); +} diff --git a/crates/psrs-backend/src/wasm/lower/structure/lists/aggregate.rs b/crates/psrs-backend/src/wasm/lower/structure/lists/aggregate.rs index 43d3ec57..b49758c4 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/lists/aggregate.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/lists/aggregate.rs @@ -39,7 +39,7 @@ impl Structurer<'_> { signed: false } ) { - return self.emit_byte_store(body, context, offset, path, span); + return self.emit_byte_store(body, context, offset, guest, path, span); } match (canonical, guest) { ( diff --git a/crates/psrs-backend/src/wasm/lower/structure/lists/element.rs b/crates/psrs-backend/src/wasm/lower/structure/lists/element.rs index 71b67c1a..d654ae6c 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/lists/element.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/lists/element.rs @@ -18,16 +18,30 @@ impl Structurer<'_> { /// Stores one `list` element: a source `Array Int` value is /// range-checked to `0..255` before it is narrowed to one canonical byte /// ([DEC-16](../../../decision/DEC-16-scalar-strings-and-utf8-storage.md)). + #[allow(clippy::too_many_arguments)] pub(super) fn emit_byte_store( &self, body: &mut Body, context: &ListLoop, offset: u32, + guest: &GuestLayout, path: &[Projection], span: TextRange, ) -> Result<(), Vec> { self.element_address(body, context, offset, span)?; self.emit_project(body, context, path, span)?; + if let GuestLayout::Scalar { shape } = guest + && is_erased(*shape) + { + self.emit_unbox( + body, + &CanonicalType::Int { + width: 8, + signed: false, + }, + span, + )?; + } let scratch = self.node_locals(context.depth).scratch_local; body.push(Op::Leaf(Instruction::LocalSet(scratch))); // Trap unless the value is a canonical byte. diff --git a/crates/psrs-backend/src/wasm/lower/structure/lists/mod.rs b/crates/psrs-backend/src/wasm/lower/structure/lists/mod.rs index 67f455db..a17614a7 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/lists/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/lists/mod.rs @@ -273,6 +273,24 @@ impl Structurer<'_> { .ok_or_else(|| wasm_error(span, "canonical list element has no guest layout")) } + pub(super) fn resolve_field( + &self, + field: &crate::cc::Field, + span: TextRange, + ) -> Result> { + let layout = self + .layout + .ok_or_else(|| wasm_error(span, "canonical list copy has no layout table"))?; + crate::cc::payload::stored_guest_layout(field, layout.representation_table()).ok_or_else( + || { + wasm_error( + span, + "canonical list field has no checked storage projection", + ) + }, + ) + } + /// The concrete defined type of a representation handle. pub(super) fn repr_index( &self, diff --git a/crates/psrs-backend/src/wasm/lower/structure/lists/record.rs b/crates/psrs-backend/src/wasm/lower/structure/lists/record.rs index 35cfe291..f500ddfa 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/lists/record.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/lists/record.rs @@ -37,7 +37,7 @@ impl Structurer<'_> { for (field, (field_offset, _)) in canonical_fields.iter().zip(&layouts) { let label = abi::source_field_name(&field.name); let index = label_index(labels, &label, span)?; - let guest = self.resolve_guest(shapes[index as usize].stored, span)?; + let guest = self.resolve_field(&shapes[index as usize], span)?; let mut nested = path.to_vec(); nested.push(Projection::Field { ty: repr_index, @@ -83,7 +83,7 @@ impl Structurer<'_> { .position(|field| &abi::source_field_name(&field.name) == label) .ok_or_else(|| wasm_error(span, "canonical record element has no field"))?; let field_offset = layouts[canonical_index].0; - let guest = self.resolve_guest(shape.stored, span)?; + let guest = self.resolve_field(shape, span)?; self.emit_load_node( body, context, diff --git a/crates/psrs-backend/src/wasm/lower/structure/region.rs b/crates/psrs-backend/src/wasm/lower/structure/region.rs index 1d775d9c..0088ed99 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/region.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/region.rs @@ -132,6 +132,9 @@ impl Structurer<'_> { )); }; match terminator { + Terminator::Trap { .. } => { + body.push(Op::Leaf(Instruction::Unreachable)); + } Terminator::Return { value, span } => { self.emit_load(*value, *span, body)?; body.push(Op::Leaf(Instruction::Return)); diff --git a/crates/psrs-backend/src/wasm/lower/structure/tests.rs b/crates/psrs-backend/src/wasm/lower/structure/tests.rs index 5384617a..4c6a273a 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/tests.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/tests.rs @@ -20,6 +20,7 @@ pub(super) fn lower_and_validate(source: &MirFunction) -> (Function, Vec) { name: source.name.clone(), types: Vec::new(), strings: Vec::new(), + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![source.clone()], @@ -111,6 +112,7 @@ pub(super) fn function( result: ValueId, ) -> MirFunction { MirFunction { + state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: name.into(), diff --git a/crates/psrs-backend/src/wasm/mod.rs b/crates/psrs-backend/src/wasm/mod.rs index 336d0a08..bab9de26 100644 --- a/crates/psrs-backend/src/wasm/mod.rs +++ b/crates/psrs-backend/src/wasm/mod.rs @@ -7,6 +7,7 @@ use crate::types::{DataId, MemoryId}; mod convert; mod encode; mod lower; +mod type_contract; mod verify; #[cfg(test)] @@ -15,6 +16,7 @@ mod tests; pub use encode::encode_module; pub(crate) use lower::lower_module_with_plan; pub use lower::{lower_module, lower_module_with_capabilities}; +pub(crate) use type_contract::raw_signature; /// Final index domains assigned by P10. These are deliberately distinct from /// MIR's module-local IDs and from one another; conversion to raw `u32` is diff --git a/crates/psrs-backend/src/wasm/tests.rs b/crates/psrs-backend/src/wasm/tests.rs index c8448c9d..f671a039 100644 --- a/crates/psrs-backend/src/wasm/tests.rs +++ b/crates/psrs-backend/src/wasm/tests.rs @@ -334,9 +334,11 @@ fn interns_repeated_string_literals_in_one_lazy_global() { }), }])], strings: vec!["twice".into()], + dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![MirFunction { + state: None, id: FunctionId(0), symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/wasm/type_contract.rs b/crates/psrs-backend/src/wasm/type_contract.rs new file mode 100644 index 00000000..b956b4c7 --- /dev/null +++ b/crates/psrs-backend/src/wasm/type_contract.rs @@ -0,0 +1,25 @@ +//! Explicit conversion of MIR type arenas to linker-owned raw contracts. +use crate::{mir, types::RecGroup}; +use psrs_linker::{CoreSignature, CoreTypes}; + +pub(crate) fn raw_signature( + import: &mir::Import, + groups: &[RecGroup], +) -> Result { + let mut types = wasm_encoder::TypeSection::new(); + for group in groups { + types.ty().rec(group.0.iter().map(super::convert::sub_type)); + } + let signature = groups.iter().map(|group| group.0.len()).sum::() as u32; + types.ty().function( + import + .parameters + .iter() + .copied() + .map(super::convert::val_type), + import.result.into_iter().map(super::convert::val_type), + ); + let mut schema = wasm_encoder::Module::new(); + schema.section(&types); + CoreTypes::from_module(&schema.finish())?.signature(signature) +} diff --git a/docs/design/backend/fp/cc-ir.md b/docs/design/backend/fp/cc-ir.md index 9c063da5..64a33916 100644 --- a/docs/design/backend/fp/cc-ir.md +++ b/docs/design/backend/fp/cc-ir.md @@ -1,5 +1,10 @@ # CC IR: ANF and Closure Conversion +> **Selected extension:** [library-owned effects and state dependencies](library-owned-effects.md) +> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies +> and checked zero-width projection. Implementation and acceptance evidence +> have not migrated; the existing contracts below remain the implementation baseline. + **Feature:** F-02 **Status:** Stable (design) **Prerequisites:** the [functional core](../../frontend/semantics/functional-core.md) calculus, @@ -108,7 +113,7 @@ RepresentationTable = { representations: [Representation], signatures: [Signatur ReprId -> Representation SignatureId -> Signature -ValueShape = Integer | Boolean | Number | String | Reference(Reference) +ValueShape = State | Integer | Boolean | Number | String | Reference(Reference) Reference = { nullable: bool, heap: RefShape } RefShape = Repr(ReprId) | Aggregate | Erased | Closure(SignatureId) @@ -121,6 +126,31 @@ Signature = { parameters: [ValueShape], result: ValueShape } VariantCase = { tag: u32, fields: [ValueShape] } ``` +`State` is a logical dependency shape with no physical payload. It remains in +CC parameters, products and instruction operands until checked MIR projection +discharges it. It is not an integer, boxed value, array element or WIT field. +The CC state verifier derives transitions from actual calls and tracks their +successor fields and control-flow joins. Nominal source-region agreement is +checked by Core before this representation boundary; CC checks the dependency +provenance expressed by its own instructions. Physical layout must reject an +undischarged State rather than choose a storage fallback. +Binary and multiway choices share dependency fork and join construction. +Every case and default edge transfers the current dependency to its arm; only +normally completing arms feed the join. The shared dependency graph records +all edges, while CC retains switch predicates and labels for the physical +correspondence check. Nested choices preserve these same rules. + +Explicit `runWorld` and `runRegion` bindings lower to `StateExecution` with a +checked closure signature and stable operation identity. Core owns RealWorld, +rank-N region introduction and non-escape checks; CC trusts those source facts +and checks the complete State-to-Step callable shape and payload result. Each +instruction owns a closed dependency graph: the boundary supplies its root, +invokes the action once and discharges its successor. Graph-local identities +are separate namespaces, including repeated executions of the same action. +Functions without an incoming State parameter can therefore carry an empty +ambient region graph plus closed executions. No State literal is introduced. +Nested runners remain ordinary calls in the enclosing instruction sequence. + `String` is a semantic CC shape, distinct from numeric `Integer`; P9 alone maps it to the target's GC string representation. This distinction lets the CC verifier reject arithmetic on strings and verify WIT string arguments without @@ -645,6 +675,15 @@ canonical generic arrays and closed records. The documents the source and verified Typed Core paths, including cases for which source lowering does not yet provide the corresponding backend input. +Foreign function values consume their checked Core declaration schemes just as +partial foreign applications do. A bare callable foreign value is the +zero-supplied-argument case of that common closure construction path. Its +generated closure retains the declared operand/result conversion contract and +calls the original external identity. Missing checked foreign types reject; +they must not be reconstructed from a local declaration or a target ABI shape. +This rule also applies to State-stepping foreign values passed to library +newtype adapters, without consulting library type names. + ## References - Flanagan, Sabry, Duba, and Felleisen, *The Essence of Compiling with diff --git a/docs/design/backend/fp/data-representation.md b/docs/design/backend/fp/data-representation.md index bbbcf6b7..9973e2a0 100644 --- a/docs/design/backend/fp/data-representation.md +++ b/docs/design/backend/fp/data-representation.md @@ -66,9 +66,9 @@ array before writing. so an ADT field's storage comes from its declared template, independent of concrete instantiations. Bare variables use erased references; composite fields retain canonical array, product, or closure references. Captures use a -separate uniform reference-array protocol. A generic array or closed record -has its own canonical aggregate layout; -converting to or from a specialized concrete layout requires reconstruction, +separate uniform reference-array protocol. All source arrays share erased-element +storage, preserving their aliases across polymorphic boundaries. Closed records +retain canonical field layouts; converting between distinct record layouts requires reconstruction, as specified by [representation and evidence](representation-and-evidence.md). **Target-neutral variants.** [CC IR](cc-ir.md) @@ -144,20 +144,25 @@ not depend on its capture types: - a reference capture is stored as-is; and - an erased capture is already `eqref`. -Concrete array layouts specialize their element storage. The canonical layout -for `Array a` is `Array(Erased)` with nullable `eqref` storage; other generic -array layouts are keyed by their recursively normalized element shape. Closed +All source array layouts use `Array(Erased)` with nullable `eqref` physical storage. +Element construction and writes apply the shared payload erasure protocol; +indexing and patterns recover the checked element use type. Private integer +buffers used by text codecs have a separate explicit value conversion boundary. Closed generic records likewise use canonical products of normalized field shapes. Their conversions are explicit aggregate reconstruction, not `ref.cast` between nominal layouts. See [representation and evidence](representation-and-evidence.md). ### Type-table invariants -- Every defined type reference resolves within the completed recursion group; - mutual references may point forward. A variant supertype precedes every case - subtype because Wasm subtyping requires that order. -- All planned definitions live in one `RecGroup`, so recursive and mutually - recursive types are admissible. +- Every defined type reference resolves in an earlier group or its own group. + Mutual references may point forward inside that group. A variant supertype + precedes every case subtype because Wasm subtyping requires that order. +- Reference and supertype dependencies determine the strongly connected + components emitted as `RecGroup`s. Acyclic definitions have separate groups; + mutually recursive definitions share one. Remapping updates both definitions + and all layout handles. A closed array type therefore has the same canonical + group shape regardless of unrelated application types, allowing an + independently encoded runtime provider to share its ABI. - `Box` types exist only when a value is actually boxed; an unreachable box does not become a type. - Every field is immutable except an array's element field. @@ -171,7 +176,8 @@ between nominal layouts. See [representation and evidence](representation-and-ev P9 is the only stage that chooses representation ([IR boundaries](../00-ir-boundaries.md)). The `GcPlanner` receives the CC `RepresentationTable` plus the reachable handles and produces a -`PlannedLayout` containing one `RecGroup` and the index maps the lowering uses. +`PlannedLayout` containing dependency-ordered `RecGroup`s and the index maps +the lowering uses. The lowering then emits a fixed set of GC operations; the Wasm emitter maps each MIR instruction to its GC opcode mechanically. @@ -206,12 +212,11 @@ Two details are load-bearing: to the closure struct when its code reference is projected, so the signature does not depend on the closure type. -For generic aggregates, P8 supplies canonical `ReprId`s: `Array a` uses -`Array(Erased)`, other dependent arrays use recursively normalized element -shapes, and dependent closed records use canonical record keys containing +For generic aggregates, P8 supplies canonical `ReprId`s: every source Array uses +`Array(Erased)`, and dependent closed records use canonical record keys containing sorted labels and normalized field shapes. P9 assigns one `DefinedTypeId` per -reachable `ReprId`; concrete `Array Int` and canonical `Array(Erased)` remain -distinct nominal types. An aggregate conversion plan that names distinct layouts is lowered to +reachable `ReprId`; concrete `Array Int` and generic `Array a` share storage. +An aggregate conversion plan that names distinct private buffer or record layouts is lowered to reconstruction by [representation and evidence](representation-and-evidence.md), never to an array or struct `ref.cast`. @@ -248,8 +253,9 @@ Three sequences are worth spelling out: type yields a nullable reference. When the destination is non-null, P9 emits a temporary nullable `ArrayGet` followed by a `RefCast` to the non-null element type. -- **Converting aggregate layouts.** A generic/concrete array boundary lowers - to a fresh array and a loop that converts each element; a closed record +- **Converting aggregate layouts.** A generic/concrete source array boundary + retains the original storage. Private codec buffers convert elements into a + fresh array at their explicit value boundary; a closed record boundary reads, converts, and rebuilds its fields. The aggregate conversion plan is defined in [representation and evidence](representation-and-evidence.md). No conversion uses a cast between distinct nominal array or struct types. @@ -372,7 +378,7 @@ Required types and entry points: - The representation value/type model (`ValueType`, `CompositeType`, `RecGroup`, `DefinedTypeId`) must live in `types.rs`; `PlannedLayout` must - populate exactly one `RecGroup` of those definitions. + partition those definitions into dependency-ordered recursion groups. - `RepresentationPlanner` must be the only component that assigns concrete type IDs, with the entry point @@ -389,7 +395,8 @@ Required types and entry points: It must reject an unsupported profile with `LayoutError::UnsupportedGcTarget` or `LayoutError::UnsupportedClosureTarget` and must never emit a fallback for a missing `gc`, `reference_types`, or `function_references` capability. -- `PlannedLayout` must own one `RecGroup` whose definitions precede their uses, +- `PlannedLayout` must own dependency-ordered `RecGroup`s, with mutual + references confined to their group and supertypes preceding subtypes, the `boxed_integer_index` and `boxed_number_index` discovery slots, the closure and capture-array indices, and the accessors `repr_index`, `variant_index`, `product_field`, `signature_index`, `closure_layout`, and @@ -518,8 +525,9 @@ w = StructGet $rect(field 1, case) # 7 ``` A record literal `{ x: 3, y: 4.5 }` lowers to `StructNew $point(3, 4.5)`, and -its field read to `StructGet $point(field 0, ...)`. All four definitions are in -one `RecGroup`, and the `Rect` subtype follows its `$variant` supertype. +its field read to `StructGet $point(field 0, ...)`. These acyclic definitions +have separate dependency-ordered groups; the `Rect` subtype follows its +`$variant` supertype. ## Boundaries and interfaces diff --git a/docs/design/backend/fp/mir.md b/docs/design/backend/fp/mir.md index a39d08a8..bde987a7 100644 --- a/docs/design/backend/fp/mir.md +++ b/docs/design/backend/fp/mir.md @@ -1,5 +1,10 @@ # MIR: SSA/CFG and Verification +> **Selected extension:** [library-owned effects and state dependencies](library-owned-effects.md) +> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies +> and checked zero-width projection. Implementation and acceptance evidence +> have not migrated; the existing contracts below remain the implementation baseline. + **Feature:** F-02 **Status:** Stable (design) **Prerequisites:** [functional core](../../frontend/semantics/functional-core.md), [CC IR](cc-ir.md), @@ -29,6 +34,53 @@ in [scalars and primitives](scalars-and-primitives.md); concrete GC layouts in normalization and conversion in [representation and evidence](representation-and-evidence.md). +## Logical dependency evidence + +P9 retains a module-level immutable inventory of checked logical CC requirements, +independently of each function's mutable `state::DependencyFlow`. Every retained +function identified by that inventory must carry evidence from the same source. +Removing the function field, or attaching evidence from a different source, is +an error. Planned MIR cannot omit the source inventory. Directly constructed +physical MIR with no source projection has an explicit empty inventory and +cannot attach unowned dependency evidence. Whole-function reachability pruning +may remove unused definitions; it does not rewrite requirements for live ones. +Retained declarations must belong to the source or to helpers explicitly +registered by P9 during lowering. Changing a projected declaration's identity +cannot turn it into an unchecked physical function. +Logical dependency identities have no Wasm value type or local slot. +The flow retains immutable checked CC provenance and checks its graph against +actual MIR invocation coverage, order, producers and normal/trapping return. +The signature projection must remove logical State parameters and declarations; +reintroducing their identities as physical scalar slots is invalid. + +The evidence also retains closed execution graphs from checked CC runner +instructions. P9 projects each `StateExecution` to one closure call with no +State argument and a payload result, checking the action operand and complete +call inventory against immutable CC. Nominal world/region and non-escape facts +remain trusted from Core's checked source contract. Step product maps retain +only their checked payload conversion when the State field is identity. +Atomic callable adapters become calls to their checked factory with the source +destination retained; correspondence checks its producer and input operand. +General conversion expansion still requires explicit invocation evidence. + +The current correspondence checker supports straight-line bodies and nested +binary and multiway choices. It anchors predicates, switch labels and default +edges, block parameters, join payload operands, returns and the complete invocation +inventory in each physical block to immutable CC, independently of dependency +graph block numbering. Explicit `Trap` terminators have no operands or normal +successors and encode as Wasm `unreachable`. P9 retains +immutable logical CC and uses a private physical instruction view, projecting +State parameters/declarations and known Step products to payload slots. It +publishes dependency evidence before tail-call marking and verifies it before +returning MIR. Signature selection uses the planner's existing reachability +analysis; unused provisional signatures do not become storage requirements. +Loop projection, raw-State choice results and general scoped/erased transport +remain implementation obligations and reject until checked. State-aware host +ABI adaptation retains independently checked canonical call plans. +MIR optimization and final Wasm lowering invoke MIR verification. Transformations +that cannot preserve the evidence must leave its body intact or explicitly +reject the unsupported projection. + ## Background **SSA and CFGs.** A program is a set of basic blocks. A block is a straight-line @@ -107,7 +159,8 @@ types and indexed by `DefinedTypeId`; P10 later computes the final Wasm indices. ### Terminators ```text -Terminator = Return { value: ValueId } +Terminator = Trap + | Return { value: ValueId } | Jump { target: BlockId, arguments: [ValueId] } | Branch { condition: ValueId, then_block: BlockId, else_block: BlockId } | Switch { value: ValueId, cases: [(i32, BlockId)], default: BlockId } @@ -166,12 +219,16 @@ the `RecGroup`s that become MIR's type table. - **Reachability.** Only requirements reachable from the CC module become types. Dead boxes, variants, or closures do not appear. The worklist walks value shapes, operations, external signatures, and referenced handles. -- **Ordering.** A defined type must precede its uses; in particular a variant - supertype precedes its case subtypes. P9 assigns `DefinedTypeId`s in this - order and puts every definition in a single recursion group, which admits - recursive and mutually recursive references within that group. IDs are - reserved before definitions are filled; forward references inside the group - are valid. Only a supertype edge must point to a previously declared type. +- **Ordering.** Type dependencies precede their uses outside a recursion group; + in particular a variant + supertype precedes its case subtypes. P9 first reserves complete definitions, + then partitions their reference and supertype graph into strongly connected + components. Dependencies precede dependent groups; only mutually dependent + definitions share a recursion group. The planner remaps every definition + reference and every representation/signature/layout handle together. Forward + references are valid within a group; a supertype must precede its subtype. + Unrelated definitions cannot change a closed GC type's recursion-group + identity, which is required for cross-module runtime ABI matching. - **GC target.** The planner uses `struct`, `array`, typed function references, `ref.test`, `ref.cast`, and `call_ref`. A profile without GC or function references is rejected here with a source-associated diagnostic, never by a @@ -277,7 +334,8 @@ plan_selected(table, reachable): each case gets a fresh id with that supertype for each closure signature: allocate the capture array type and the closure struct type - build one RecGroup from the definitions, supertypes before subtypes; + partition type dependencies into RecGroups and remap all definition IDs; + emit dependency groups first, with supertypes before subtypes; validate all references after the group is complete ``` @@ -352,7 +410,7 @@ pub struct Module { name, types: Vec, imports: Vec, functions: pub struct Import { symbol: SymbolId, parameters: Vec, result: Option } pub struct Function { id: FunctionId, symbol: SymbolId, name, parameters: Vec, values: Vec, entry: BlockId, blocks: Vec, result: ValueId, result_type: ValueType, span } pub struct BasicBlock { id: BlockId, parameters: Vec, instructions: Vec, terminator: Option } -pub enum Terminator { Return, Jump, Branch, Switch, ReturnCall, ReturnCallRef } +pub enum Terminator { Trap, Return, Jump, Branch, Switch, ReturnCall, ReturnCallRef } ``` `mir/instruction.rs` MUST define `Instruction` so every variant carries a diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index c96c9912..831e310c 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -1,5 +1,10 @@ # Runtime Representation and Checked Boundaries +> **Selected revision:** [library-owned effects and state dependencies](library-owned-effects.md) +> replaces the Effect-specific token contract with a library newtype and generic +> state dependencies. Implementation and acceptance evidence have not migrated; +> this document retains the existing contract pending that migration. + **Feature:** F-02 **Status:** Stable (design) **Prerequisites:** [functional core](../../frontend/semantics/functional-core.md), @@ -167,18 +172,18 @@ storage constructor is unknown. | --- | --- | | `a` | `Erased` | | `f a` (head a variable) | `Erased` | -| concrete `Array Int` | the specialized `Aggregate([Integer])` | +| concrete `Array Int` | `Aggregate([Erased])`, the canonical source array | | `Array a` | `Aggregate([Erased])`, the canonical generic array | -| `Array (Array a)` | an aggregate whose element references the canonical `Array a` | +| `Array (Array a)` | `Aggregate([Erased])`; its elements hold canonical source array references | | concrete `{ x :: Int }` | the specialized `Aggregate` product | | `{ x :: a }` | a canonical product with an `Erased` field | | a parameterized data type | one nominal variant, each field in its declared template's normalized shape | Normalization is structural and cycle-safe, and distinguishes a declaration **template** (its bound variables abstract) from an **actual** type (the -boundary substitution applied). A closed actual type is specialized; a variable +boundary substitution applied). A closed actual record type is specialized; a variable the substitution does not resolve stays abstract and uses the template rule. -Canonical keys are: arrays by normalized element shape, closed records by sorted +Canonical keys are: source arrays by their erased-element protocol, closed records by sorted `(label, normalized field shape)` pairs, and variants by declaration identity. Equal keys intern to one representation; P9 assigns one `DefinedTypeId` per reachable representation and does not merge by physical shape. This preserves @@ -188,19 +193,22 @@ product and remain unsupported. ### Aggregates in bare polymorphic slots -The Array owner normalizes an array entering a bare variable or abstract Array -constructor slot to an array of non-null erased elements. The closed-record +The Array owner uses erased-element storage from initial construction. Entering +a bare variable or abstract Array constructor slot retains that same array. +The closed-record owner normalizes a record to a product with the same ordered logical labels and one non-null erased field per label. These protocols apply recursively to nested arrays, records, and callable fields. Recovery first reads the owner's -canonical storage, then converts each element or field to the checked use -representation. A direct cast to the consumer's specialized aggregate layout -cannot establish this contract. +canonical storage. Array element reads recover the checked use representation; +record recovery converts its fields. Array transport itself does not reconstruct +storage. A cast between distinct private buffer or record layouts cannot +establish their conversion contract. Canonical protocols are registered by the layout owner for the aggregate layouts a module contains before conversion planning; a module with no array or -record layout gains no protocol representation. Arrays and ordinary records have -no observable identity, so these conversions may construct new aggregates. +record layout gains no protocol representation. Source arrays retain identity +across transport because checked mutable storage operations expose aliasing. +Ordinary immutable record conversions may construct new aggregates. Mutable cells and other nominal references keep their owner's identity protocol; they are not reconstructed as records. Checked storage primitives consume their checked use representations before ABI erasure, preserving writes to the owning @@ -512,14 +520,13 @@ cast is needed. `unwrap :: forall a. Wrap a -> Array a`, with `main = arrayIndex (unwrap (wrap [40, 42])) 1`. The concrete literal is `Array Int`; the declared field template `Array a` has the canonical -`Array(Erased)` RuntimeRep. Construction plans an `ArrayMap` with an -`Integer -> Erased` element conversion, boxes each element into the canonical -array, and stores that reference in the variant's canonical field. `unwrap` -reads the canonical layout directly, and the outer boundary maps it back to -`Array Int`. No runtime tag and no nominal array cast is used. A bare-variable +`Array(Erased)` RuntimeRep. The literal boxes its elements into this canonical +storage once. Construction stores the same array reference in the variant's +canonical field. `unwrap` returns that same array, and indexing recovers Int +from the stored element. No runtime tag or reconstruction is used. A bare-variable field such as `data Hold a = Hold a` also uses the Array owner's erased-element -protocol when its checked value is an array. It maps specialized arrays before -storing them and maps them back on recovery. +protocol when its checked value is an array. Erasure and recovery cast the +existing array reference without copying its elements. ## Boundaries and interfaces diff --git a/docs/design/backend/opt/mir.md b/docs/design/backend/opt/mir.md index 8dd671b7..50453b03 100644 --- a/docs/design/backend/opt/mir.md +++ b/docs/design/backend/opt/mir.md @@ -1,5 +1,10 @@ # MIR Optimization +> **Selected extension:** [library-owned effects and state dependencies](../fp/library-owned-effects.md) +> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies +> and checked zero-width projection. Implementation and acceptance evidence +> have not migrated; the existing contracts below remain the implementation baseline. + **Feature:** F-02 **Status:** Draft @@ -15,6 +20,13 @@ memory rules. Each pass returns valid MIR and remains optional for correctness. ## Scope +Functions carrying logical dependency evidence are checked after each pass. +The current inliner does not rewrite these callers or use them as candidates; +tail-call marking similarly awaits checked dependency transfer. This is an +implementation restriction while dependency remapping is completed, not a +semantic prohibition on inlining or tail calls. Calls remain observable even +when their physical payload is unused. + This document owns MIR-preserving optimization and its pass-manager contract. It does not choose layouts, specialize source types, create canonical ABI adapters, or encode Wasm. Those responsibilities remain with P9, P7, P9, and @@ -154,6 +166,14 @@ loads that value for the Wasm function result, independently of the return terminator. Calls, memory operations, allocation, checked projections, casts, and explicit trap instructions remain live even when their result is unused. +State dependency correspondence currently retains source predicate and block +identities. CFG pruning and terminator simplification leave functions carrying +that evidence intact; copy forwarding also leaves their bodies intact because +callable and adapter operand identities remain source anchors. Inlining and tail-call marking remain disabled for those functions +until they can transfer the evidence. Dead pure instruction elimination still +runs and preserves observable calls and traps. `Trap` is a terminal CFG node +with no successor or operand; all successor consumers use shared MIR analysis. + ## Worked example ```text diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index d908aba3..c4a722e7 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -1,5 +1,12 @@ # Primitive Foreign Imports and Standard-Library Wrappers +> **Selected extension:** [library-owned effects and state dependencies](../fp/library-owned-effects.md) +> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies +> and checked zero-width projection. GC storage/termination use runtime-owned +> providers with a checked reference ABI, separate from scalar artifact calls. +> Integrated implementation and acceptance evidence +> have not migrated; the existing contracts below remain the implementation baseline. + **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) **Status:** Draft **Prerequisites:** the Canonical ABI's flat signature (`Resolve::wasm_signature`: scalars, `string` as `(pointer, length)`, `option`/`result` as a discriminant plus a payload), and the difference between a PureScript foreign import and the host glue behind it. Read [DEC-06](../../../decision/DEC-06-runtime-interface-via-wit.md), [DEC-11](../../../decision/DEC-11-primitive-ffi-stdlib-wrappers.md), [canonical ABI and WIT](canonical-abi-and-wit.md), and [WASI platform library](wasi-platform-library.md) first. diff --git a/docs/implementation/backend/library-owned-effects.md b/docs/implementation/backend/library-owned-effects.md new file mode 100644 index 00000000..c64c26cb --- /dev/null +++ b/docs/implementation/backend/library-owned-effects.md @@ -0,0 +1,1808 @@ +# Library-Owned Effects: Implementation Evidence + +Governing design: [library-owned effects and state dependencies](../../design/backend/fp/library-owned-effects.md). + +Status: **Partial**. The state vocabulary, checked primitive type contracts and +generic dependency graph verifier exist. Core verification now produces checked +flow for State-to-Step lambda bodies. CC now retains logical State values and +derives checked flow from actual single-root function instructions. P9 now +automatically projects State/Step calls through straight-line bodies and nested +binary and multiway choices and publishes MIR dependency evidence. Public +recursive Effect loops execute through these checked calls and choices; arbitrary +CFG backedges, raw-State choice results and general scoped transport remain +incomplete. +Explicit world/region runners now publish closed execution evidence and run +source-selected Int entries. +Ordinary source runtime bindings now reach checked CC with their logical +State-to-Step signatures and actual invocation chains. The CC/raw storage +contract and application-arena raw import signatures are checked. Canonical +payload fill/read/write calls now publish actual MIR calls and recovery with +immutable dependency/CFG correspondence. Source alias-write projection reaches +optimized MIR and Core Wasm emission. Non-returning calls now publish checked +terminating paths anchored to their source assignment and raw return contract. +Default CLI/GC-provider composition now executes source alias writes and +ordinary newtype bind wrappers. General provider cycles remain incomplete. +The Core producer's quantifier evidence for quantified record fields, +projections and array elements is repaired, so the candidate ST reference +program compiles and executes to 42 instead of being rejected at P7. +Effect and ST still use the previous locked +library and compiler mechanism. Runtime GC storage primitives execute independently and through the focused +source fixtures; this record does not assert official Effect runtime acceptance. + +## Starting point + +The 2026-10-09 implementation starts on `stdlib/vendor-core-libraries`, compiler +`9da4fd18535476c87c87373400a209c245fa22b1`, with the selected design documents +already uncommitted. The library lock remains at +`1e01310daa7e56de5ed379029d6a24dcf39e879c`. + +The unchanged full-import fixture was diagnosed with: + +```sh +./target/debug/psrs diagnose \ + /private/tmp/psrs-stdlib-compile-20261009-8rsdzxc2/Main.purs \ + --out /private/tmp/psrs-state-before.json --timeout 240 +``` + +Outcome: P5 NoInstanceFound, first message `Semigroup (Effect _T396)`, +13,298 ms, no timeout or crash. This is compile evidence only. The snapshot +and replay bundle live outside the repository. No roadmap total is changed. + +The same command with `--out /private/tmp/psrs-state-after-foundation.json` +reported the same first blocker in 13,140 ms after the foundation changes. +There is no stdlib compile-acceptance improvement at this checkpoint. + +## Requirement-to-evidence map + +| Requirement | Status | Evidence and limit | +| --- | --- | --- | +| Primitive identities, kinds and nominal regions | Verified at source layer | HIR `target_state_is_opaque_and_its_region_is_nominal`; driver `the_state_region_cannot_be_safely_coerced` and `state_accepts_the_official_st_region_kind`. State is kind-polymorphic; official `Global :: Region` and a Region-kind rank-N runner pass checking. | +| Ordinary library state newtype/combinators | Verified in focused source execution | Ordinary Task pure/bind definitions retain two callback transitions and execute through an ordinary library runner, returning 46 under mandatory Wasmtime. Actual development-package Effect Bind and public GlobalST reference execution pass; complete API acceptance remains open. | +| Complete newtype callable field contracts | Verified for template, rank-N and focused ADT field transport | Boundary tests retain State regions, whole Step results, nested field applications and returned functions. Mandatory Wasmtime tests execute Reader and structured-domain/result newtypes through a rank-N runner and a generic Holder carrier. Storage parameters use the declared erased field convention. Straight-line State projection is now implemented; scoped transport remains incomplete. | +| Binding-only state primitive exposure | Verified at resolution layer | Driver `unsafe_state_operations_require_an_explicit_binding`; registry schemes remain available for explicit bindings. | +| Primitive type contracts before erasure | Verified at Core/linking layer | Core world/region runner contract and rank-N escape tests; driver invalid-unused-binding rejection. Source origins and complete candidate validation use the existing primitive linker. | +| Generic dependency chain validation | Verified at Core body layer | Core verification derives State-to-Step lambda graphs from actual invocations, including branches, aliases, record patterns and traps. Source correspondence checks invocation coverage/order, argument provenance, region and branch placement. Utility tests also cover loop backedges; CC/MIR loop projection is still missing. | +| Checked zero-width state projection | Partial, with straight-line, binary and multiway P9 lowering | State parameters/declarations are removed only with checked CC provenance. Known Step values become payloads without record allocation; closure signatures and calls agree. Source callback and ordinary Task pure/bind cases reach encoded Wasm. A CC-to-component harness executes two state calls and returns 42. Canonical host calls now have checked adapter-subgraph projection; general CFG and scoped/erased transport remain required. | +| Runtime GC storage and termination | Verified independently | Runtime provider exports fill/read/write/trap with no state bits or linear memory. Mandatory Wasmtime tests execute cross-module calls, alias writes, reference/value identity, repeated reads, zero lengths, null values and trapping sizes/indices/termination; an incompatible immutable-array import is rejected before execution. | +| Ordinary runtime binding contracts | Verified at source and logical CC boundaries | Provider/export identity remains an ordinary foreign binding. Runtime metadata owns source operand/payload relations and physical ABI; driver tests reject malformed unused declarations, unknown exports and retired storage intrinsic names. CC checks retained State/Step slots, operand roles and canonical array storage. Canonical payload fill/read/write calls publish actual MIR calls with checked source correspondence. Non-returning calls refine their source path to checked Trap termination; Monomorphic scalar, record, callback and nested-array payload recovery now executes through ordinary CC conversions. | +| State-aware host and mutable storage execution | Partial | Checked runtime provider calls execute source storage alias-write fixtures. Canonical host adapter plans retain source anchors, physical calls, result adaptation and internal control evidence. Mandatory Wasmtime source-newtype cases execute resource get/drop, widened scalar parameters, record results, list results and variant results. Cyclic storage, general source CFG and complete host/library conformance remain incomplete. | +| Core/CC/MIR dependency production and preservation | Partial | Immutable Core bodies supply checked flow; Core optimizers recheck each pass. CC verifies actual single-root instruction flow. P9 publishes straight-line, binary and multiway MIR correspondence against immutable CC; MIR optimization and final lowering recheck it. Total Core-to-CC correspondence, general CFG/scoped/loop projection and dependency-aware inlining remain required. | +| Final encoding erasure | Partial for checked straight-line, binary and multiway source bodies | Source callbacks, Task pure/bind and checked canonical host adapter subgraphs encode after MIR verification. Public recursive loops compose through checked source calls; arbitrary CFG backedges and general scoped transport remain incomplete. Explicit source world/region runners execute through the normal pipeline. | +| Effect/ST library and command runner migration | Partial; development package wrappers migrated | Generic resolved-runner Core normalization, focused source execution and production manifest selection exist. The independent package has the unpushed State-newtype migration at `7852625` plus an uncommitted migration of 92 target WASI foreign wrappers. Public host/storage fixtures, ten pinned ST JS comparisons and ten public Effect-loop JS comparisons pass; complete API/host conformance and legacy deletion remain. The compiler library lock is unchanged. | +| Integrated source and runtime conformance | Partial | Library-owned pinned ST and public Effect-loop JS comparisons agree with mandatory Wasmtime. Full official composition/API/host acceptance remains required. | + +## Continuation order + +1. Extend checked body evidence to general scoped state transport beyond the + implemented explicit world/region boundaries; retain immutable source + correspondence during call projection. +2. Carry explicit dependencies through CC and MIR, including higher-order + calls, branches, loops, captures and signature adapters. Connect the graph + verifier to actual checked operation identities. +3. Implement general zero-width projection and checked GC runtime provider + linking/calls, then state-aware host bindings. Runtime owns storage execution; + stdlib owns combinators. Preserve checked types before erasure and in-place + alias identity. Do not route GC storage through the scalar artifact ABI. +4. Migrate Effect and ST together in the independent package, preserving official + public source contracts and recording the selected newtype adaptation. The + quantifier-evidence blocker that previously stopped this step is repaired. +5. Delete the legacy Effect mechanism, validate optimizer/final erasure and + execute complete conformance evidence. +6. Update the normal lock only after a coherent package is validated. Keep + partial development packages explicit and outside normal locked consumption. + +Do not describe utility-level tests as integrated state ordering, change the +normative design to match this partial checkpoint, or close Effect's migration +on import-only compilation. + +## Validation runs + +On 2026-10-09: + +- HIR primitive registry tests: 9 passed. +- Focused Core state tests: 12 passed before the additional integrated Core + verification test; the full Core library subsequently passed all 104 tests. +- Driver state source/binding tests: 4 passed. +- Official differential command + `PURESCRIPT_REPO=/Users/biu/Projects/purescript cargo test -p psrs-driver --test upstream`: + 19 passed, no skips. +- `cargo fmt --all --check`, `git diff --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- `sh crates/psrs-runtime/tools/check-reproducible.sh`: the existing numeric + and allocator artifacts still reproduce byte-for-byte; neither pin changed. +- `cargo test --workspace`: initial run stopped on source-layout violations; + the new dependency module now uses `dependency/mod.rs`, and an empty legacy + `program/effects/` directory was removed. The repeated run passed 1,749 unit + and integration tests with 5 ignored tests, then stopped at rustdoc E0463 + (`can't find crate for psrs_linker`). A standalone backend doc-test rebuild + passed; the subsequent `cargo test --workspace --doc` passed for all packages. + The single full workspace command did not exit successfully, so its result + is reported separately from the successful doc-test retry. +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::effects`: + 50 passed, no skips. These exercise the existing mechanism and cannot verify + the new state representation. + +Logs are in `/private/tmp/psrs-state-{workspace-tests,clippy,upstream,legacy-effects}.log`. +The doc-test retry log is `/private/tmp/psrs-state-workspace-docs.log`. +The new runtime provider is independently executable; state target lowering and +integrated Effect runtime execution remain unimplemented. + +### Runtime ownership correction + +The same checkout now has runtime-owned GC storage/termination ABI contracts +under `psrs-runtime/src/abi/storage.rs` and executable core-module encoding under +`psrs-runtime/src/storage/`. The `gc-storage` host feature encodes a separate +module, rather than compiling a Rust heap or adding a second runtime crate. +State target selection uses these contracts and keeps execution-boundary +lowering distinct. Neither path emits code without checked dependency and +signature projection. The scalar runtime catalog does not advertise this +provider: compiler-owned GC reference linking and composition remain required. + +Validation on 2026-10-09 with Wasmtime 49.0.2: + +- `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace`: passed, including doc tests; + 1,753 tests passed and 5 were ignored under their existing configuration. + This run includes four runtime storage tests, not the subsequently added + incompatible-reference import test. +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-runtime --features gc-storage storage -- --nocapture`: + all five runtime tests passed, including that additional rejection case. +- `cargo test -p psrs-backend target_intrinsics --lib`: 2 passed. +- `cargo fmt --all --check`, `git diff --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- The identical full-import fixture was diagnosed again with + `cargo run -- diagnose /private/tmp/psrs-stdlib-compile-20261009-8rsdzxc2/Main.purs --out /private/tmp/psrs-state-after-runtime.json --timeout 240`: + P5 NoInstanceFound, `Semigroup (Effect _T396)`, 13,389 ms, no timeout or crash. + The locked stdlib has not changed; this runtime correction does not repair + its source-level first blocker or establish integrated Effect execution. +- `diagnose --compare` against `psrs-state-after-foundation.json` reports a + compatible cohort, identical inputs and `unchanged_failure`; no difference + in the observed pass prefix. Canonical artifact-content comparison remains + unavailable, so this is a compile-outcome comparison only. + +Logs: `/private/tmp/psrs-runtime-effects-{workspace,storage,clippy,diagnose,compare,reproducible}.log`. + +### Ordinary runtime binding migration + +Storage no longer has one HIR intrinsic per operation. The experimental +`StateArrayRead/Fill/Write` entries were removed, with stable slots 89–91 +reserved. `ExternalKind::Runtime` retains an explicit provider/export and its +checked foreign signature; the runtime ABI owns source operand/payload relations. +Backend runtime linking resolves all declarations before projection, including +unused declarations, without relying on WIT names or a library action constructor. + +The official `Global :: Region` declaration exposed a separate kind defect: +`State :: Type -> Type` rejected the minimal state newtype at P5 with +`KindsDoNotUnify`. `State :: forall k. k -> Type` fixes that shared primitive +contract while retaining a nominal region role. The source test now checks a +Region-kind action, a Global storage binding and a rank-N Region-kind runner. +No official library declaration was changed to make this pass. + +The focused driver state suite passes all 9 tests. This is source and binding +contract evidence; valid storage bindings still reject at `P8 runtime projection` +because state dependencies and the GC call ABI are not yet carried through CC/MIR. +The active Effect objective remains incomplete. + +Validation for this migration on 2026-10-09: + +- `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace`: passed, including doc tests; + 1,759 passed, 5 ignored. All five independent runtime storage tests executed. +- `cargo fmt --all --check`, `git diff --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- `PURESCRIPT_REPO=/Users/biu/Projects/purescript cargo test -p psrs-driver --test upstream`: + 19 passed, no skips. +- Runtime reproducibility check: numeric and allocator artifacts remain + byte-for-byte identical to their reviewed pins. +- The identical full-import fixture still reports P5 NoInstanceFound, + `Semigroup (Effect _T396)`, in 13,636 ms with no timeout/crash. + `diagnose --compare` against `psrs-state-after-runtime.json` confirms + identical inputs, a compatible cohort and `unchanged_failure`. + +Logs: `/private/tmp/psrs-runtime-bindings-{workspace,clippy,upstream,reproducible,diagnose,compare}.log`. + +### Complete callable storage templates + +The boundary registry now retains the complete source field, constructor +variables, final callable storage owner/field, parameter types and result type. +It no longer substitutes concrete constructor arguments into canonical newtype +parameter slots or limits domains to a closed type/bare argument. Constructor +transport checks the complete storage result as well as parameters. Common +call-boundary extraction rejects cyclic/dangling spines before layout and keeps +a fixed-arity closure's returned function separate from its own arguments. + +The rank-N Reader source reproducer previously failed at P8 with +`constructor transport requires a callable segment adapter`. Both it and the +array-domain/record-result Batch reproducer now execute under mandatory Wasmtime +with exit value 42. Four boundary tests also check an ordinary state newtype's +State/Step template, nested owner evidence, nullary closure results and malformed +call boundaries. These are required foundations, not proof of state projection. + +At that checkpoint, the separate `Holder f a` ADT field reproducer failed at P8 with +`abstract constructor transport has no checked constructor binding` after these +changes. It was retained as the ignored runtime acceptance test +`higher_kinded_adt_field_preserves_callable_newtype`; the later constructor-field +evidence section records its repair. The active +Effect objective includes fixing that scope/evidence path, producing actual +state dependencies through CC/MIR, projecting signatures, composing GC providers, +migrating Effect/ST and replacing the legacy entry/synthesis mechanism. + +Focused evidence: 11 driver state tests passed, 1 explicit remaining acceptance +test ignored; 4 boundary tests passed. Executing the ignored case explicitly +reproduces the P8 failure, rather than a runtime skip. Logs: +`/private/tmp/psrs-callable-{newtype-before,state-focused,holder-gap}.log`. + +The subsequent `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace` completed +successfully, including doc tests: 1,765 passed and 6 ignored. One ignored test +is the explicit higher-kinded ADT acceptance gap above; the other five retain +their existing suite configuration. `cargo fmt --all --check`, +`git diff --check` and +`cargo clippy --workspace --all-targets -- -D warnings` also passed. +Logs: `/private/tmp/psrs-callable-template-{workspace,clippy}.log`. +These checks establish no regression in the current supported paths; they do +not establish integrated State projection or Effect migration acceptance. + +### Source Core dependency production + +`psrs_core::state::flow` now derives evidence from immutable State-to-Step lambda +bodies. Each input dependency belongs to the actual State binder; every observable +transition addresses its actual source invocation. Ordinary aliases, structural +record fields/patterns, constructor fields and branch joins retain producer +provenance. Unknown state callables remain conservatively observable; a small +body proof permits known inert state functions to pass their input through. +Trap paths have no normal successor. Pure joins preserve previously evaluated +state aliases, including a record's state field evaluated before its payload. + +The source certificate retains its arena, lambda, checked region and invocation +references. Its verifier checks graph validity, complete invocation coverage/order, +operand/payload contracts and the source-derived graph's dependency provenance +and branch placement. A graph that is valid in isolation cannot omit/reorder +calls, move a call to another branch or be reused with a different source arena. +Core verification runs this check after ordinary typing and scope checks. Existing +Core optimization rechecks it before optimization and after each pass. + +Source tests check two real runtime-bound calls, a conditional's selected +successor and ordinary Task newtype pure/bind definitions. Well-typed stale +returns and replayed predecessors reject at `P7 Core verification`. The unchanged +negative reproducer at `/private/tmp/psrs-state-flow-reproducer/Main.purs` previously +reached `P8 runtime projection` in 227 ms; its final post-change trace rejects +the discarded successor at P7 in 217 ms. `diagnose --compare` confirms identical +inputs and a compatible cohort, with a changed observed stage. This is stronger +rejection evidence, not a positive compile or runtime acceptance improvement. + +The focused Core state suite passes 32 tests (19 body-flow tests and the existing +13 contract/graph tests). The driver state suite passes 15 tests with the existing +ADT acceptance gap ignored. These do not establish scoped raw-state captures, +runner root/discharge evidence, complete higher-kinded transport, CC/MIR operation +correspondence, loop lowering or zero-width physical projection. The runtime +bindings still reject missing projection; the old Effect and ST package remains. +Logs: `/private/tmp/psrs-state-flow-{core,focused,before,after,compare}.log`. + +Final validation on 2026-10-09: + +- `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace`: passed, including doc tests; + 1,788 passed and 6 ignored. The independent storage provider tests execute; + the higher-kinded ADT acceptance gap remains ignored and unverified. +- `cargo fmt --all --check`, `git diff --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- `PURESCRIPT_REPO=/Users/biu/Projects/purescript cargo test -p psrs-driver --test upstream`: + 19 passed, no skips. The State dependency contract is a target extension; + this run checks existing official semantics for regressions. +- Runtime numeric and allocator artifacts reproduce byte-for-byte. +- The identical full-import fixture still rejects at P5 NoInstanceFound, + `Semigroup (Effect _T396)`, in 13,146 ms with no timeout or crash. + Comparison against `psrs-state-after-runtime-bindings.json` confirms identical + inputs, a compatible cohort and `unchanged_failure`. An initial comparison + named a nonexistent intermediate snapshot; only the retry against that + available baseline supplies comparison evidence. + +Logs: `/private/tmp/psrs-state-flow-{workspace,clippy,upstream,reproducible,stdlib,stdlib-compare}.log`. +The active Effect migration remains incomplete. No package lock, official source +or roadmap measurement changed. + +### Scoped constructor-field instantiation + +The unchanged Holder reproducer rejected at P8 with `abstract constructor +transport has no checked constructor binding`. The first missing evidence was +on construction, before pattern recovery. Aggregate field storage and variant +field recovery now retain a checked template-to-use instantiation with the +owning constructor's parameters. The shared Core relation owns that proof; +ordinary Core verification already checks all fields against the parent's +consistent type arguments. Physical storage continues to use the declaration's +canonical field convention. + +The Holder Reader test now executes with exit value 42 and is no longer ignored. +A second Holder test executes an array-domain, record-result Batch with exit +value 42, checking structured input and payload transport. The driver state +suite passes 17 tests with no skips under `PSRS_REQUIRE_WASMTIME=1`. +Logs: `/private/tmp/psrs-state-holder-{before,after,focused}.log`. +This repairs ordinary carrier transport; it does not implement State projection, +CC/MIR dependency correspondence or integrated runtime provider composition. + +Validation on 2026-10-09: mandatory-Wasmtime workspace tests passed, including +doc tests, with 1,790 passed and 5 existing ignored tests. Formatting, strict +workspace clippy and `git diff --check` passed. The explicit official frontend +differential suite passed all 19 tests without skips. +Logs: `/private/tmp/psrs-state-holder-{workspace,clippy,upstream}.log`. + +The rebuilt CLI diagnosed the identical full-import fixture in 13,096 ms: +P5 NoInstanceFound, `Semigroup (Effect _T396)`, with no timeout or crash. +Comparison against `psrs-state-after-source-flow.json` confirms identical inputs, +a compatible cohort and `unchanged_failure`. Logs: +`/private/tmp/psrs-state-holder-{stdlib,stdlib-compare}.log`. +The independent stdlib worktree and normal package lock remain unchanged. + +### Shared call boundaries and zero-width signature planning + +The fixed-arity closure reproducer failed with `state function has no state +invocation parameter`, although the equivalent arrow signature was accepted. +Core now owns `call_parts`; State signature checking and CC's ordinary call +boundary extraction consume that same operation. Fixed-arity closure results +and quantified arrow results retain their separate calling boundaries. A +checked Core closure invocation now produces its actual successor dependency, +not an assumed pass-through. Focused Core state evidence: 34 tests passed. +Logs: `/private/tmp/psrs-state-projection-{before,core}.log`. + +CC function signature planning consumes a checked CallProjection that retains +the immutable source arena and State signature. State-final calls project to +ordinary physical arguments and the closed Step's payload. Five backend tests +check nullary projection without State/Step storage, ordinary arguments with +a returned function payload, a separately returned state action, nominal region +mismatch and unsupported nonfinal State. The production function-signature +entry explicitly refuses to publish a State call signature without CC +invocation dependency lowering; a storage plan is not execution evidence. +Log: `/private/tmp/psrs-state-projection-backend.log`. + +The first workspace attempt stopped at the source-layout check: the new module +roots initially shared names with child directories. Both roots were moved to +their directories' `mod.rs`; the focused source-layout check then passed. +Logs: `/private/tmp/psrs-state-projection-{workspace,source-layout}.log`. +CC record/capture/invocation projection, MIR dependencies, runtime composition +and the Effect/ST package migration remain required. + +Final validation on 2026-10-09: mandatory-Wasmtime workspace tests passed, +including doc tests, with 1,797 passed and 5 existing ignored tests. Formatting, +strict workspace clippy and `git diff --check` passed. The explicit official +frontend differential suite passed all 19 tests without skips. +Logs: `/private/tmp/psrs-state-projection-{workspace-final,clippy,upstream}.log`. + +The rebuilt CLI diagnosed the same full-import fixture in 13,659 ms with no +timeout or crash. Its first blocker remains P5 NoInstanceFound, +`Semigroup (Effect _T396)`. Comparison against `psrs-state-after-holder.json` +confirms identical inputs, a compatible cohort and `unchanged_failure`. +Logs: `/private/tmp/psrs-state-projection-{stdlib,stdlib-compare}.log`. +No official library source, package lock or roadmap measurement changed. + +### Logical State and actual CC instruction flow + +On 2026-10-10, CC retains State as a logical zero-payload shape in parameters, +products and instruction operands. The common primitive shape owner prevents +opaque-handle or erased-reference fallback at declaration and expression uses. +Payload boxing/recovery, array storage and physical WIT/MIR layout reject an +undischarged State. Physical signature planning remains separate from CC's +logical State parameter and Step result. + +CC module verification now derives single-root dependency graphs from actual +direct/indirect calls, product creation/projection, checked identity/ProductMap +conversion, If joins and traps. Operation evidence borrows the actual CC +assignment and is tied to its immutable module. Re-derivation rejects edited +operation coverage or control flow even when the edited graph is valid alone. +Nominal source-region agreement remains a checked-Core producer guarantee; +this CC verifier checks local instruction provenance, not source kinds/roles. + +State pass-through summaries come from checked CC bodies via a least fixed point, +independent of declaration order. Unknown and recursive calls stay observable. +Stale invocation inputs and stale returns reject. Pure joins retain prior +aliases; observable joins require the selected successor. A trapping branch +has no normal successor. Captured State without a checked root, multiple roots, +multiway State switches and general erased State transport remain unsupported. + +Focused evidence: 8 backend state tests, 5 signature-planning tests and the +physical-layout rejection test passed. Source callbacks and ordinary Task +pure/bind definitions lower into CC; the callback is an actual indirect call, +and bind retains two ordered operations. These are Core-to-CC acceptance tests, +not Wasm execution evidence. Logs: +`/private/tmp/psrs-state-cc-{focused,projection,mir-boundary,source,library,driver}.log`. + +The final unchanged callback fixture at +`/private/tmp/psrs-state-cc-reproducer/Main.purs` rejected at P8 in 240 ms before +the change. After rebuilding, CC lowering completes and the fixture reaches +P9's explicit `UnprojectedState` rejection in 250 ms. The trace comparison +confirms identical inputs, a compatible cohort and `backend.cc.lower` changing +from rejected to completed. The earlier fixture omitted the callback's use and +was replaced before recording the final comparable baseline. Logs: +`/private/tmp/psrs-state-cc-{before,after,compare}.log`. + +Total Core-to-CC invocation correspondence remains required beyond the focused +source cases. MIR instruction/CFG correspondence and physical parameter/Step +projection, runner boundaries, scoped transport, runtime provider composition, +Effect/ST migration and integrated conformance remain incomplete. + +An additional source case exposed a false stale-return rejection when an ordinary +state function constructed an array and returned its input State unchanged. +Core accepted the pure construction, while CC's summary treated it as a new +dependency. CC now preserves State pass-through for array/data construction; +this summary does not authorize call CSE or suppress allocation effects. +The existing MIR effect classifier still marks calls and allocations as +potentially trapping and memory-affecting. The regression retains the action's +actual array read and verifies its incoming alias, rather than merely finding +an unrelated pure function. The driver state suite passes 20 tests under +mandatory Wasmtime. Logs: +`/private/tmp/psrs-state-cc-array-{before,after}.log` and +`/private/tmp/psrs-state-cc-driver-final.log`. + +## Shared CC call projection and MIR entry (2026-10-10) + +`cc::state::StateCallProjection` now owns the logical State-to-Step slot +boundary used by actual CC invocation checking. It identifies the final State +parameter and the successor/payload fields without assuming product field order. +The physical signature operation projects ordinary arguments and the payload; +it leaves the original signature and representation table unchanged. Malformed +parameter placement, duplicate states, nullable Step references and products +without exactly one successor and one payload reject. Ordinary call signatures +retain their convention. This plans a call boundary; it does not erase any body +instruction or establish invocation/CFG correspondence by itself. + +The common MIR lowering entry re-derives actual CC dependency bodies before +physical layout planning. Ordinary CC typing remains the P8 producer's contract; +this check does not claim to validate every source kind, region or WIT mapping. +A bound call fixture that reuses a stale predecessor now fails dependency +verification before the physical `UnprojectedState` guard. Existing P9 fixture +conventions remain covered by the backend tests. + +Physical instruction projection, dependency-preserving MIR optimization and +final encoding are still incomplete. The signature operation is available for +that lowering but has not yet been wired into physical layout emission. No +State parameter or Step storage has been erased by this checkpoint. + +Validation is scoped to the affected backend and driver state tests, following +the user's request to avoid repeating workspace-wide checks each iteration. +The backend library suite passes 431 tests with mandatory Wasmtime, including +four projection cases and the MIR-entry regression. Log: +`/private/tmp/psrs-state-projection-backend.log`. +The driver state suite passes 20 tests under mandatory Wasmtime +(`/private/tmp/psrs-state-projection-driver.log`). A subsequent missing-operand +and missing-parameter-metadata regression ensures the direct dependency +recheck rejects malformed inputs instead of indexing absent values. All 14 +CC state/projection tests pass after that change +(`/private/tmp/psrs-state-shared-projection-final.log`). Formatting, diff checks +and backend-only strict Clippy pass. Workspace tests and workspace Clippy were +not repeated for this checkpoint. + +## MIR-owned dependency evidence (2026-10-10) + +`mir::Function.state` now retains a logical `DependencyFlow` alongside concrete +SSA values and instructions. Its private immutable CC source and graph are +checked against actual MIR calls. The straight-line correspondence checker +requires complete invocation coverage, ordered destination identities, direct +callee identity, invocation kind and the normal/trapping successor. Checking +all calls also detects inserted invocations and protects State pass-through +calls rather than relying only on observable graph transitions. It rejects +reintroduced physical slots using logical State identities and requires the +remaining ordinary parameter identities to match. + +The common MIR verifier consumes this evidence. The optimizer rechecks it after +each pass; final Wasm lowering already invokes that verifier. Inlining and +tail-call marking conservatively retain bodies carrying the evidence until +their dependency remapping is implemented. A test confirms that an invocation +with unused physical payload remains present after optimization. + +This is representation and verifier evidence from hand-built, checked CC/MIR +fixtures. The source pipeline does not yet publish the flow automatically: +ordinary lowering still initializes the field to `None`, and undischarged State +continues to fail physical layout planning. Mandatory publication, automatic +zero-width body lowering, multi-block/loop correspondence, scoped and erased +transport, runtime composition and source-to-Wasm execution remain required. +The design has not been narrowed to straight-line functions. + +The affected backend library suite passed 437 tests under mandatory Wasmtime +before the final logical-State-as-zero regression +(`/private/tmp/psrs-mir-state-backend.log`). The focused MIR evidence tests cover +valid projection, missing/reordered/extra invocations, changed producers and +returns, optimization retention, physical State-slot rejection and a trapping +body's actual unreachable instruction. All 7 focused cases pass after the final +changes (`/private/tmp/psrs-mir-state-flow-final.log`). The driver state suite +also passes 20 tests under mandatory Wasmtime +(`/private/tmp/psrs-mir-state-driver.log`). Formatting, diff checks and strict +backend Clippy pass. Workspace tests and workspace Clippy were not repeated. + +## Automatic straight-line State/Step lowering (2026-10-10) + +P9 now consumes immutable logical CC through a private physical instruction +view. The shared `StateCallProjection` owns the Step successor/payload slots; +the existing reachability analysis selects the callable signatures to project. +Unused provisional signatures are not treated as checked storage requirements. +State parameters and declarations disappear from physical signatures and values. +Known Step construction and payload projection become ordinary payload copies, +without a Step struct allocation. Logical identities remain reserved so lowering +temporaries cannot accidentally reuse a removed State identity. + +After physical instruction lowering, P9 automatically publishes +`DependencyFlow` for each projected body before tail-call marking. The MIR +verifier, optimizer and final Wasm lowering check it against immutable CC and +actual calls. The source callback fixture now reaches MIR optimization and +Wasm encoding with one retained transition and Int payload signatures. +Ordinary Task newtype pure/bind definitions also encode, retaining bind's two +callback transitions. The array-payload regression reaches MIR and retains its +array read. These source tests do not invoke a new source-level world runner. + +A separate CC-to-component harness executes ordinary State functions under +mandatory Wasmtime and returns 42. Both physical functions are nullary with Int +results; two calls survive optimization and no Step struct is allocated. This +is P9 execution evidence with a selected test entry, not integrated Effect/ST +or source-runner acceptance. Log: +`/private/tmp/psrs-state-projection-runtime.log`. + +The unchanged CLI callback reproducer moves from P9 `UnprojectedState` in +252 ms to a passing compilation in 278 ms. The comparison confirms identical +inputs, a compatible cohort and `backend.mir.lower` changing from rejected to +completed. It does not provide a canonical artifact-content comparison. Logs: +`/private/tmp/psrs-state-mir-projected{,-compare}.log`. + +Validation: 439 backend library tests passed before the additional execution +harness; all 8 focused MIR state tests then passed with mandatory Wasmtime. +The final driver state suite passes 21 tests, including source-to-MIR/Wasm +callback and Task cases. Logs: +`/private/tmp/psrs-mir-projection-{backend,focused-final,driver-final}.log`. +Formatting, diff checks and strict backend/driver Clippy pass. Workspace-wide +tests, upstream differentials and the full stdlib import were not repeated for +this backend projection change. + +General CFG and loop projection, scoped/erased raw-state transport, invocation +expansion for runtime/adapter calls, source world/region runners, checked host +ABI projection, GC provider composition, Effect/ST package migration and +integrated conformance remain required. Unsupported state-aware host calls and +multi-block bodies reject rather than erasing their dependency. The normative +design and overall completion scope remain unchanged. + +## Binary choices and explicit trap exits (2026-10-10) + +P9 recursively projects binary and nested choices to payload-only MIR block +parameters. MIR dependency correspondence checks each block's predicate, +successors and complete call inventory against immutable source CC. Dependency +and physical CFG block numbers need not coincide: the source instruction tree +anchors the physical allocation order. Negative tests reject swapped edges, +redirected jumps and calls moved between arms. Raw-State choice results, +multiway choices and loops still reject until checked projection exists. + +An explicit MIR `Trap` terminator represents a path without a normal successor +or return operand. Common CFG analysis, verification, optimization and both +structured and dispatcher Wasm encoding consume that contract. A trapping +State arm retains the source trap and cannot acquire a fabricated jump to the +payload join. CFG pruning and branch simplification conservatively retain +State-bearing functions; multi-block copy forwarding also waits for evidence +transfer. Dead pure instruction elimination still runs. + +The CC-to-component harness executes both ordinary branches (42 and 43), an +unselected trap arm (43), and a selected trap arm (Wasm `unreachable`) under +mandatory Wasmtime after optimization. This remains a CC entry harness rather +than source world-runner or integrated Effect/ST acceptance. Source callback +choices independently reach checked MIR and encoded Wasm. + +Validation for this change is scoped to affected MIR, Wasm structuring and +driver State tests: 202 MIR tests, 13 Wasm structuring tests, and 22 driver +State tests pass with mandatory Wasmtime. Strict backend/driver all-target +Clippy, formatting and diff checks pass. Logs: +`/private/tmp/psrs-state-trap-{mir,structure,driver}-final.log` and +`/private/tmp/psrs-state-trap-clippy-final.log`. Workspace-wide tests, upstream +differentials and full stdlib imports were not repeated for this change. +The source runner, runtime host/storage composition, library migration and +integrated conformance obligations remain open. + +## Source world/region runners and library composition (2026-10-10) + +P8 now lowers explicit `runWorld`/`runRegion` bindings to a logical +`StateExecution` instruction after rechecking Core's primitive contract. CC +validates its closure signature and payload shape and derives a closed +root-to-invocation-to-discharge graph tied to the actual instruction. Ambient +functions without State parameters can carry an empty region graph and these +closed executions; nested scopes keep separate graph namespaces. Core owns +nominal region introduction and escape checking, which CC trusts after erasure. + +P9 projects each boundary to one physical closure call with no State argument +and retains its closed graph in MIR evidence. Correspondence rejects removed +calls and changed action operands. Each dynamic call supplies its own logical +root, including repeated calls of the same action; no integer initial State, +State local, or Step allocation is introduced by the boundary. + +Generic Step product maps now retain their payload boxing/unboxing while +requiring an identity State-field conversion. Atomic callable adapters lower +to their checked factory call using the source destination, and correspondence +checks the factory's stable producer and source operand in execution order. +Other invocation expansions and general scoped/erased transport remain open. + +The same source-world fixture previously failed in P8 with a closure-capture +diagnostic masking the unsupported execution boundary +(`/private/tmp/psrs-runners-baseline.log`). The final focused fixtures now run +through the normal source compiler and component execution helper, with source +entry selection: world 42, rank-N region 43, nested runners 44, repeated action +82, and ordinary Task newtype pure/bind through a library runner 46. A selected +runner propagates the body's integer-division trap. A callable Step payload +executes and returns 47. This last case initially failed at P10 because copy +forwarding changed its call operand without transferring correspondence +(`/private/tmp/psrs-runners-callable-payload-before.log`). Copy forwarding now +conservatively retains State-bearing bodies until alias evidence transfer +exists; dead pure instruction elimination remains enabled. These are focused +source execution cases; no official Effect/ST package or conformance result +is implied. + +Validation: 31 driver State tests pass with mandatory Wasmtime +(`/private/tmp/psrs-runners-driver-final.log`), including malformed binding and +nominal-region rejection cases. 139 CC tests and 202 MIR tests pass +(`/private/tmp/psrs-runners-{cc,mir}.log`). Strict backend/driver all-target +Clippy passes (`/private/tmp/psrs-runners-clippy.log`); formatting, diff checks +and the maintained Rust file-length check pass. Full workspace, upstream +differential and stdlib import runs are omitted under the requested focused +validation scope. + +Runtime GC host call projection/provider composition, generic configured +command-runner loading and entry normalization, official Effect/ST package +migration and integrated library-owned conformance remain required. Existing +trusted Effect/StateToken paths and the locked package are unchanged. + +## Runtime GC type-group compatibility (2026-10-10) + +The runtime storage provider declares its mutable nullable-eqref array in an +independent recursion group. P9 previously placed every application definition +in one group, changing that array's canonical identity when unrelated closure, +box or signature types were present. A consumer with the merged group is valid +Wasm but Wasmtime rejects its storage import as incompatible. + +The MIR layout planner now partitions complete definitions by reference and +supertype dependencies using strongly connected components. Dependency groups +precede users; mutually dependent definitions remain together. All definition +references, representation and signature indices, product-field keys, closure, +capture, scalar-box and string handles are remapped as one planner operation. +The iterative graph walk handles a 10,000-type dependency chain without Rust +call-stack growth and rejects dangling edges before remapping. MIR verification +also rejects empty groups and references crossing into later groups, while +accepting mutual forward references within a declared group. + +A cross-module fixture uses actual `PlannedLayout` definitions and the compiler's +Wasm encoder, then loads the independent runtime provider under mandatory +Wasmtime. The merged-group negative control fails import matching; the new +groups execute fill/write/repeated-read operations, preserving aliases and box +reference identity, and return 78. This is compiler-layout/raw-provider ABI +execution evidence, not source storage binding or checked-linker composition +acceptance. Monomorphic typed-array boxing and in-place source call projection +remain required; copying a typed array is not an acceptable write ABI. + +Validation: 14 focused layout tests, 207 MIR tests, 41 Wasm tests and 31 driver +State tests pass with mandatory Wasmtime. Logs: +`/private/tmp/psrs-storage-groups-{layout,wasm,driver}.log` and +`/private/tmp/psrs-storage-groups-mir-final.log`. Strict backend/driver all-target +Clippy passes (`/private/tmp/psrs-storage-groups-clippy-final.log`); formatting, +diff and maintained Rust file-length checks pass. Full workspace and stdlib +import/conformance runs are omitted under the focused validation scope. + +Next: extend linker-owned raw signature contracts to checked GC references and +advertise the storage provider, then connect source operand/payload projection +without array copying. The P8 runtime-binding projection rejection remains; +generic command-runner loading, Effect/ST package migration and integrated +conformance also remain open. + +## Checked GC runtime catalog and raw contracts (2026-10-10) + +The runtime package now advertises its host-encoded storage unit with operation +metadata and an independent types-only schema. Linker catalog conversion is +fallible and resolves declared references before executable artifact validation. +`CoreTypes` is the shared owner for artifact and application raw signatures: +it retains complete recursion groups, bound recursive references, nullability, +field mutability, finality and supertype edges, while resolving module indices. +Unsupported exact/shared-composite/descriptor/continuation contracts and +multi-result raw signatures report errors. Scalar WIT projection explicitly +rejects GC and SIMD types instead of coercing them to scalar ABI types. + +Focused tests establish index-offset independence, recursive binder closure, +mutability/nullability/group mismatches, independent storage export validation, +provider selection, and actual application import-contract acceptance/rejection. +The application has an unrelated preceding type, so its storage array index +intentionally differs from the provider's index. This stage accepts the valid +closed contract and rejects nullable or immutable array drift. + +Full component composition is still incomplete. The positive integration test +was executed and failed in `wit-component 0.245.1` minimized-library validation: +`array_fill` has equivalent closed array contracts but different module-local +reference IDs. Its `validate_func_sig` compares `FuncType` values directly. +The positive composition test remains explicitly ignored with this reason, +retaining the required acceptance assertion. It is not counted as passing or +runtime evidence. Logs: `/private/tmp/psrs-gc-provider-compose.log` (observed +failure), `/private/tmp/psrs-gc-provider-compose-focused.log` (one passing +provider/application rejection test, one explicitly ignored composition test). + +Validation: the linker suite passes 68 tests before the final application test; +the final linker library run passes 25 tests (one added, for 69 passing tests +across the recorded runs). All 31 mandatory-Wasmtime driver State tests pass. +Backend/driver/linker test-target compilation and strict runtime/linker/backend/ +driver all-target Clippy pass. Logs: +`/private/tmp/psrs-gc-provider-{linker-all,linker-final,check,driver,clippy-final}.log`. +Formatting and diff checks pass. Full workspace, official stdlib compilation and +conformance are omitted under the user-selected focused scope. + +Next: repair cross-module GC compatibility at the composition boundary without +aligning local type indices or discarding type evidence. Source storage binding +projection, in-place canonical storage, generic command-runner integration, +legacy Effect removal, and official Effect/ST package migration remain required. + +## Direct raw Core instance assembly (2026-10-10) + +Further composition investigation found that the existing tooling also creates +scalar indirect-call shims for private library imports. Resolving cross-module +reference IDs alone is insufficient. An experimental interface scaffold failed +final component validation because the generated shim still had scalar +parameters/results; that implementation was removed. No scaffold, trap body, +modified runtime module, or debug-write path remains in production code. + +`psrs-linker::assemble_core` now owns a distinct raw instance assembly stage. +It consumes the checked link plan, validates the encoded application contract, +and connects original provider/application modules directly by imported module +namespace. This stage supports closed acyclic raw instance graphs; unresolved +imports, host interfaces and cyclic provisioning report errors. Its output is a +provisional encoder plus the application instance identity, not a checked target +artifact. Canonical boundaries and final validation/target-world closure remain +required. Original GC definitions, signatures, bodies and module-local indices +are preserved; private calls do not pass through scalar WIT shims. + +A mandatory-Wasmtime integration fixture uses selected catalog storage bytes +and the original application bytes, then adds a canonical CLI boundary in the +test. The resulting component validates and executes fill/write/read with an +aliased array. It requires both the observed payload 78 and reference identity +to agree. Changing only the expected payload to 79 makes the CLI command fail, +proving that the application assertions execute. Nullable array contract drift +is rejected before assembly. This establishes direct raw-instance/component +execution, not generic `compose` WIT integration or source storage projection. +The old positive `compose` test remains explicitly ignored with its actual +reference-ID/scalar-shim limitation; it is still a required acceptance case. + +Evidence: `/private/tmp/psrs-gc-core-assembly-runtime-final.log` records two passing +GC provider tests and one explicitly ignored generic-composition test, including +the value-sensitive command execution. Strict linker/backend/driver all-target +Clippy passes (`/private/tmp/psrs-gc-core-assembly-clippy.log`). The general raw +instance stage must next integrate with canonical world assembly and shared +memory/host provisioning; official Effect/ST migration remains open. + +Final focused rerun: 70 linker tests pass with mandatory Wasmtime and one +explicitly ignored generic-composition acceptance test; 31 driver State tests +pass (`/private/tmp/psrs-gc-core-assembly-{linker,driver}.log`). Formatting and diff +checks pass. Full workspace and official stdlib/conformance remain unrun under +the focused validation scope. + +## Canonical world boundaries for raw GC graphs (2026-10-10) + +The normal `compose` entry now selects direct raw instance assembly when checked +source/provider interfaces contain GC references. Verified artifacts retain the +complete declared interfaces after executable-contract validation, including +required operation interfaces, so composition does not infer capability from +library or Effect names. Scalar-only graphs retain the existing assembly path. + +WIT tooling consumes a declaration-only application projection with unchanged +public function types/indices and storage declarations. Private imports become +local declarations for inspection; their implementation bodies are not supplied +to tooling. The projection is then removed entirely. Original application and +provider bytes are inserted through raw Core instance assembly, and canonical +aliases are explicitly remapped to the actual application module and instance. +The transformation tracks root/nested scopes and outer-module references, +rejects missing/repeated module identities or unexpected/repeated application +provisioning, and requires both module and instance correspondence. Full Wasm +validation and the checked external-world closure precede artifact publication. +This projection is not a foreign implementation and never executes. + +The previously ignored positive `compose` GC test is enabled and passes. It +asserts that both original Core modules survive byte-for-byte in the component, +then executes its CLI command under mandatory Wasmtime. Payload 78 and aliased +reference identity pass; the same program with expectation 79 fails. An +independently selected WIT world preserves a public `u32` parameter and result; +a valid Core module with an incompatible `i64` public parameter is rejected. +Tooling diagnostic chains are preserved so this rejection includes its actual +ABI mismatch. The latter case establishes world/signature acceptance, not a +runtime parameter-value claim. Projection tests cover import-only exports, +complete GC signatures, identity rejection, and index/scope remapping. + +Validation: 77 linker tests pass with zero ignored tests, including both direct +and normal composition runtime fixtures +(`/private/tmp/psrs-gc-world-boundary-linker-final.log`). All 31 mandatory-Wasmtime +driver State tests pass (`/private/tmp/psrs-gc-world-boundary-driver.log`). Strict +linker/backend/driver all-target Clippy and formatting/diff checks pass. Full +workspace, official stdlib compilation, and library conformance remain unrun +under the user-selected focused scope. + +Remaining: raw graphs with host imports or cyclic shared-memory provisioning, +source storage operand/payload projection and canonical in-place storage, +generic language command-runner integration, legacy Effect removal, and +Effect/ST source/runtime conformance. Closed raw GC world composition is now +implemented; it does not establish those broader requirements. + +## State callables in polymorphic payload storage (2026-10-10) + +Bare callable erasure previously tried to box the terminal State argument. +The shared State call projection now registers a terminal unary logical State +signature with a complete Step result and an erased payload during immutable +layout planning. Ordinary arguments retain the existing erased curry protocol; +State is passed directly and is never captured. Recovery maps only the Step +payload and preserves its field order, labels and nominal source region. + +The fresh-region reproducer exposed an adapter factory hidden inside a conversion +sequence. A second reproducer returning an ordinary callable exposed the same +loss inside a Step ProductMap. CC now emits sequence steps and product field +conversions as explicit assignments before dependency publication. The factory +operands and destinations survive into the immutable invocation inventory; +the MIR correspondence verifier remains unchanged. Malformed product map +metadata remains subject to aggregate verification, and expanded field +conversions are checked as ordinary CC operations. + +Mandatory Wasmtime source tests execute a stored State callable (42), ordinary +arguments before State (43), a stored array of State callables (44), a recovered +fresh-region callable (45), and a callable Step payload (46). Replacing the +fresh-region action with a RealWorld action rejects at P5. The array case proves +callable transport, not mutable storage alias preservation: array conversions +still copy storage. + +After the product conversion change, all 36 driver State tests, 140 CC tests and +207 MIR tests pass. All six generic aggregate audit tests and 21 polymorphic +erasure audit tests pass, as does strict backend/driver all-target Clippy. +Formatting and diff checks pass. Evidence: +`/private/tmp/psrs-state-slot-{driver,cc,mir,generic,polymorphic,clippy}-final.log`. +The full workspace suite, stdlib compilation and official conformance were not +run under the user-selected focused validation scope. + +Remaining: canonical alias-preserving source array storage and ordinary runtime +call projection; conversion calls nested in array iteration; host/cyclic provider +provisioning; generic command runner and legacy Effect removal; official +Effect/ST migration and conformance. Valid source storage bindings still report +the explicit P8 projection rejection. + +## Canonical source array storage and alias preservation (2026-10-10) + +The mutable alias reproducer stores `[10, 20]` in a polymorphic Holder, recovers +the array, writes 99 through the original reference and reads through the alias. +Before the change mandatory Wasmtime returned 10 instead of 99 +(`/private/tmp/psrs-state-array-alias-before.log`). Source array layouts now share +the erased-element protocol, including concrete and nested arrays. Elements are +converted at construction, fill, writes, indexing and pattern extraction; +passing the array through polymorphic storage retains the existing reference. +The same source test now returns 99. Pure array updates still clone storage. + +Text byte codecs use an explicit private integer-buffer conversion. Canonical +WIT lists box/unbox erased scalar elements, retaining byte range checks. Lists +of records require the semantic projection after element erasure: a shared +payload storage projection selects the same record protocol as the payload +planner, retaining labels and nested field evidence. String layout reachability +also includes checked external projections, so `list` results whose +elements are unused still reserve their required GC string type. + +Existing structural tests now require shared source array identities and absence +of polymorphic reconstruction, alongside the original value assertions. This +does not remove ArrayMap for explicit private-buffer conversion or change the +source type checker: distinct element types remain distinct checked types. + +Source runtime storage calls still stop at the P8 projection boundary. The +canonical source storage correction is a prerequisite for their in-place ABI; +it does not yet establish integrated runtime provider execution from source. + +Focused validation during this slice passed: 37 driver State tests, 17 source +array tests, six generic aggregate audit tests, four parameterized-shape tests, +21 polymorphic erasure tests, nine pattern audit tests, seven byte/codec tests, +146 WASI tests, 140 CC tests and 207 MIR tests. The WASI scope was extended after +canonical storage changed externally returned record and string lists; its final +run has zero failures and zero ignored tests. Strict backend/driver all-target +Clippy, formatting and diff checks pass. Evidence: +`/private/tmp/psrs-state-array-{driver,source,generic,shapes,polymorphic,patterns,bytes,wasi,cc,mir,clippy}.log`. +The full workspace suite, stdlib compilation and official library conformance +remain unrun under the user-selected focused scope. + +## Runtime-owned source/raw call projection contract (2026-10-10) + +`psrs-runtime::StorageCallProjection` checks the relationship between the +runtime's source storage contract and its raw export ABI. It pairs operands in +order and distinguishes raw payload results, normal void-to-Unit results and +non-returning results. Mismatched arity, operand roles, result types and return +properties reject before a source consumer uses the contract. Compiler binding +validation now consumes this checked runtime projection rather than independently +reconstructing the source/raw arity and return relation. + +This is data-only ABI metadata. It introduces no compiler IR dependency, State +materialization, runtime implementation rewrite or successful placeholder for +source execution. The existing P8 source projection rejection remains until +checked MIR calls, result recovery and invocation correspondence consume the +contract. In particular, Unit-producing writes must lower through a real void +call, and a non-returning export must not fabricate a normal successor. + +Validation: both runtime projection tests pass, covering all four operations and +five malformed contract variants. The source binding rejection matrix and valid +scheme matrix pass as separate driver tests. The no-std allocator-feature build +checks for `wasm32-unknown-unknown`; strict runtime/backend/driver all-target +Clippy, formatting and diff checks pass. Logs: +`/private/tmp/psrs-runtime-call-{projection,source-contracts,valid-contracts,no-std,clippy}.log`. +No runtime executable was changed, and no new source-to-runtime execution is +claimed. Full workspace, stdlib compilation and conformance remain unrun. + +## Runtime binding metadata across the backend boundary (2026-10-10) + +The backend side table now has explicit runtime bindings alongside WIT imports. +Core extraction preserves stable symbol, provider/export, source module, source +span and checked scheme identity. Core-boundary validation compares these +records with the authoritative source externals and rejects missing, duplicate, +unrelated or substituted entries. Direct CC input also checks binding inventory; +it cannot bypass the outstanding runtime projection by supplying a side table. + +This preserves the information required by the future raw-call lowerer without +embedding provider names in target-neutral CC or changing a source declaration +into an intrinsic. The source P8 projection rejection and direct-CC P9 rejection +remain explicit. No source storage execution is claimed yet. + +Validation: nine binding tests, 37 driver State tests and 207 MIR tests pass. +Strict backend/driver all-target Clippy passes. Logs: +`/private/tmp/psrs-runtime-binding-{metadata,state,mir,clippy}.log`. +The full workspace suite, stdlib compilation and conformance were not run. + +## Source runtime calls and the CC/raw contract (2026-10-10) + +Ordinary runtime externals now retain their declaration signatures in CC. Layout +planning includes checked runtime declaration schemes even when unused. Calls +and partial applications obtain parameter/result conventions and checked +instantiation from the authoritative `Core.external_types` scheme, through the +same callable boundary used for ordinary declarations. This fixes a real +mismatch between a polymorphic external's stored Step payload and a concrete +use-site result; no provider name or storage opcode is added to CC. + +Source fixtures publish and verify two consecutive reads, a fill/write/read +successor chain, and a partially applied read. The original source-to-CC P8 +projection guard is removed. Runtime bindings still stop at `P9 runtime +projection` before physical calls are emitted, so this is CC evidence rather +than integrated runtime execution. + +Before that remaining rejection, binding validation checks every runtime CC +signature against the runtime-owned raw contract. It requires a final State, +checked Step fields, ordinary operand arity, Integer indices/lengths/Unit and +non-null canonical erased-element arrays. Tests reject noncanonical scalar +arrays, products substituted for arrays, nullable array references, provider +and export substitution, and malformed logical call signatures. Core still +owns source element equality and nominal region agreement; CC shape checks do +not reconstruct these erased semantic facts or authorize dependency erasure. + +Focused validation: 13 backend binding tests and 40 driver State tests pass with +zero ignored tests. `PSRS_REQUIRE_WASMTIME=1` is enabled for the driver run; the +three new runtime-call fixtures validate CC rather than execute source runtime +storage. Logs: `/private/tmp/psrs-runtime-cc-contract.log` and +`/private/tmp/psrs-runtime-cc-state.log`. Strict backend/driver all-target Clippy, +formatting and diff checks pass (`/private/tmp/psrs-runtime-cc-clippy.log`). +Full workspace tests, stdlib compilation +and official library conformance remain unrun under the user-selected scope. + +## MIR invocation operand correspondence (2026-10-10) + +Inspection of the raw-call boundary exposed an existing shared verifier gap: +MIR correspondence checked call destinations and producers but did not compare +ordinary call operands. A valid checked source body and MIR certificate could +therefore survive substitution of an argument with a different value of the +same physical type. The focused regression failed before the production fix +because the mutated call was accepted. + +The common control correspondence verifier now compares the complete ordinary +operand sequence for direct and closure calls against immutable CC, removing +only values whose checked CC declarations have State shape. Source IDs, order, +arity and duplicate occurrences remain authoritative. Existing factory calls +and closed runner invocation checks retain their explicit operand contracts. +A raw ABI adapter must provide checked conversion correspondence; this repair +does not authorize replacing those checks with type compatibility. + +Focused regressions reject same-typed substitution, operand reordering, missing +and extra arguments. The indirect-call regression lowers a real CC closure +signature through MIR, then proves that module verification rejects an operand +substitution. All 16 MIR State tests and 40 driver State tests pass with zero +ignored tests and mandatory Wasmtime enabled. Logs: +`/private/tmp/psrs-state-call-operands-before.log`, +`/private/tmp/psrs-state-call-operands-after.log`, and +`/private/tmp/psrs-state-call-operands-driver.log`. +The runtime raw-call projection remains incomplete at P9; full workspace, +stdlib compilation and library conformance remain unrun. + +## Runtime raw import signatures in the application arena (2026-10-10) + +Runtime bindings now enter P9's private physical planning after their retained +CC contract is checked. Their physical callable signatures remove the final +State and project Step to its payload through the shared State call protocol; +immutable logical CC remains authoritative. State-aware WIT imports retain the +existing rejection. The generic layout reachability result now retains its +actual direct-call set, so raw runtime type planning selects only referenced +bindings instead of introducing a second storage-specific call scanner. + +The runtime import planner consumes the runtime-owned raw projection and the +application's actual `PlannedLayout`. Integer operands become i32; raw elements +become nullable eqref. Array IDs come from the application's representation +mapping, and the resulting target definitions must be mutable arrays of +nullable eqref. It does not reuse runtime-private type indices or fabricate an +i32 handle. Raw writes and traps both return void, while their result contracts +remain distinct Unit and Never projections. + +Planning rejects contradictory immutable, non-null-element and scalar-element +array target definitions. Tests cover all four raw signatures and retained +State-free physical callable signatures. Source State fixtures now reach these +checks before the same explicit P9 call-projection guard. No raw invocation or +MIR module is published for these bindings yet: boxing/recovery, real void-call +handling, non-returning control flow, immutable invocation correspondence and +provider identity through linking remain necessary for source execution. + +Validation: two raw-signature tests, 13 binding tests, 16 MIR State tests and +40 driver State tests pass with zero ignored tests. Mandatory Wasmtime is enabled +for the State runs. Strict backend/driver all-target Clippy, formatting and diff +checks pass. Logs: `/private/tmp/psrs-runtime-mir-signature.log` and +`/private/tmp/psrs-runtime-mir-signature-{bindings,state,driver,clippy}.log`. Full workspace tests, +stdlib compilation and official library conformance remain unrun under the +user-selected focused scope. + +## Raw runtime identity through MIR and target linking (2026-10-10) + +MIR imports now have optional explicit runtime provider/export identity. The +ordinary source call symbol remains unchanged, and WIT/generated/artifact +imports retain their existing contracts. Runtime signature planning copies this +identity from the source binding. MIR verification and target linking check +provider/export lookup, raw operand/result types and canonical array storage; +a source runtime descriptor cannot replace a reserved generated/artifact +binding. Both planning and verification use one raw storage type predicate. + +The backend converts the application's actual MIR GC arena into a types-only +Wasm schema, using the existing target encoder conversion, and asks the +linker's `CoreTypes` owner for closed raw signatures. Complete recursion groups +and application-local type mappings survive this boundary. Target selection +uses the runtime unit's operation identity/version rather than inventing an +intrinsic or copying the offered provider's signature as the expected consumer +contract. A valid MIR mutable-eqref array with different finality is rejected +by linking, proving that the actual consumer definition reaches the comparison. + +A hand-built raw MIR consumer now passes verification, checked provider +selection, Wasm emission, component composition and mandatory Wasmtime +execution. It allocates an array initialized with 40, preserves an alias, +performs a real void write of 99, reads through the alias, casts/unboxes the +stored payload and returns a comparison against 99. Changing only the expected +value to 100 produces a failed command, proving the execution check depends on +the stored value. This is backend raw-call +execution evidence, not source State/Step projection or official library +acceptance. The source P9 guard remains. + +Execution uses `wasi_cli: false` for a closed provider graph. The default CLI +profile adds a host exit import and currently rejects GC-provider composition +with `raw instance assembly requires a closed provider graph`. Supporting that +host graph remains required; this test does not narrow the design or assert +default CLI acceptance. Unknown/substituted providers and exports, wrong +scalar/result/nullability contracts and reserved-symbol substitution reject at +both MIR and linking boundaries. + +Focused evidence is recorded in `/private/tmp/psrs-runtime-provider-linking.log`: +four linking tests pass, including the two new raw runtime tests, with zero +ignored tests and mandatory Wasmtime enabled. The final value-sensitive run is +`/private/tmp/psrs-runtime-provider-execution.log`. Two raw-signature tests, +16 MIR State tests and 40 driver State tests also pass with zero ignored tests; +strict backend/driver all-target Clippy, formatting and diff checks pass. Logs: +`/private/tmp/psrs-runtime-provider-{mir,state,driver,clippy}.log`. +Full workspace tests, stdlib +compilation and library conformance remain unrun. + +## Source-anchored raw instruction plans (2026-10-10) + +`StorageInvocation` now obtains the actual call assignment from a checked CC +State body, resolves its ordinary binding and uses the application's planned +raw signature. Its private immutable facts retain caller ownership, original +ordinary operands, source result destination, logical/physical value types and +fresh temporary frontier. Reserved provider identity is checked through the +shared MIR runtime import verifier. Temporaries cannot reuse logical State or +other source value identities. + +For canonical erased payloads, fill/read/write instruction plans emit real raw +calls. Nullable-eqref operand adaptation has explicit cast witnesses. Read +recovery consumes the actual nullable result and writes the checked non-null +source payload destination. Write emits `CallVoid`, followed by Unit's normal +integer representation; it creates no physical State. The invocation verifier +checks operand identity/order, actual producer, fresh typed temporaries, +recovery provenance and complete instruction coverage. It rejects an omitted or +retargeted write, fabricated Unit, substituted same-typed index, detached result +recovery and an extra invocation. + +P9 exercises these plans for actual referenced source calls before the existing +whole-function guard. The resulting sequences are checked intermediate plans; +they are not yet inserted into a published MIR function. Immutable dependency +and CFG correspondence must consume the plans before that guard can be removed. +Direct monomorphic element declarations still require the shared canonical +payload conversion boundary; this slice does not replace it with private +boxing rules or an arbitrary reference cast. Non-returning operations remain +explicitly rejected pending their distinct CFG projection, rather than +fabricating a normal successor or payload. + +Focused validation: six runtime tests and 40 driver State tests pass with zero +ignored tests (`/private/tmp/psrs-runtime-invocation.log` and +`/private/tmp/psrs-runtime-invocation-driver.log`). The driver run requires +Wasmtime; the new per-invocation tests inspect and mutate raw instruction plans +rather than execute source runtime storage. Full workspace tests, stdlib +compilation and official library conformance remain unrun. + +Strict backend/driver all-target Clippy, formatting and diff checks pass; +Clippy evidence is `/private/tmp/psrs-runtime-invocation-clippy.log`. + +## External binding ownership and whole-function raw calls (2026-10-10) + +This checkpoint supersedes the earlier source P9 guard and MIR provider-lookup +claims. Storage provider/export lookup, physical array-definition checks and +source-to-raw signature planning now belong to `bindings/runtime/target.rs`. +MIR's provider identity is opaque: ordinary MIR verification does not interpret +storage export names. The binding adapter supplies physical signatures and a +provider-independent `RawCallResult` convention. Target linking continues to +validate provider identity and the actual consumer GC types against the runtime +catalog. A hand-built MIR import with substituted provider identity is +structurally valid MIR but fails binding/link validation. Source-derived calls +also reject that mutation through their immutable checked import evidence. + +`RawInvocation` plans are now inserted into actual function blocks. Dependency +correspondence retains the source assignment, owning block, instruction range, +typed temporaries and checked import. Returning fill/read/write calls publish +MIR only after their instruction witnesses and source CFG correspondence pass. +Unused valid runtime declarations do not produce imports. Required +non-returning CFG adaptation and monomorphic payload conversion remain explicit +unsupported boundaries. + +Whole-function rejection tests cover same-typed index substitution, changing or +removing the checked provider identity, deleting an actual void write and +fabricating its Unit recovery. Normal returning operations pass MIR optimization. +The source regression includes fill, an array alias, an ignored write result +and a read through the alias; it reaches optimized MIR and Core Wasm emission. +A source execution attempt exposed dead-instruction deletion of Unit recovery. +Functions retaining dependency certificates now also defer dead pure deletion, +matching the existing restrictions on copy/CFG/inlining transformations. This +is an explicit optimization limitation until these passes transfer immutable +source correspondence; optimization integration is not complete. + +Source storage execution was attempted but not established. With +`wasi_cli: false`, the complete artifact pipeline rejects at P11 target +capabilities. The existing default-CLI GC provider/host composition obligation +also remains. The source regression consequently proves projection and Core +Wasm emission, not a runnable composed source artifact or library conformance. +The independent hand-built raw MIR alias-write test still composes and executes +under mandatory Wasmtime, including its value-sensitive failing comparison. + +Focused evidence: nine raw-call/backend tests, 41 driver State tests and two +runtime linking tests pass, with zero ignored tests. Driver and linking runs +require Wasmtime. Logs are `/private/tmp/psrs-effect-boundary-{mir,driver,linking}.log`. +The failed source execution investigation is retained in +`/private/tmp/psrs-effect-source-storage.log`. Full workspace tests, full stdlib +compilation and official Effect/ST conformance remain unrun. + +Strict backend/driver all-target Clippy passes +(`/private/tmp/psrs-effect-boundary-clippy.log`). + +## Default CLI composition with GC providers (2026-10-10) + +This checkpoint supersedes the prior default CLI/host-graph blocker for closed +GC storage providers. Core preparation instantiates independent acyclic provider +modules and retains the original application module without instantiating it. +The WIT facade keeps permitted host imports while replacing private imports +with local declarations. Its imported-function permutation is applied to public +exports, globals and element segments. After WIT tooling produces canonical host +instances, attachment instantiates the original application with those instances +and the checked raw provider instances. The facade never supplies executable +application bodies. Module and instance remapping accounts for component scopes; +final validation and exact host-import closure checks remain mandatory. + +The backend raw MIR alias-write test now uses the default CLI target, including +its real WASI exit host import. Expected 99 succeeds and expected 100 fails. +More significantly, an ordinary source State/Step program now compiles through +the normal default artifact pipeline and executes under mandatory Wasmtime: +fill 40, alias the array, write 42, then read through the alias. Comparing the +result with 42 succeeds; comparing with the old value 40 fails. This establishes +source-to-component storage execution and alias preservation for this fixture. + +An additional source execution fixture defines ordinary `Task` newtype, +`bindTask`, fill/write/read wrappers and `runTask`. Its callbacks sequence real +storage operations through the library-owned combinator and return 42 under the +default CLI. No Task/Effect-name dispatch or whole-combinator runtime operation +is involved. This is library-form composition evidence, not official Effect/ST +package migration or conformance. + +Remaining obligations include non-returning invocation CFG projection, +monomorphic payload conversion, general loops/scoped transport, dependency-aware +optimization, shared-memory/provider cycles and providers requiring later host +provisioning. The disabled-CLI complete artifact profile is still unsupported; +this change executes using the supported default target rather than weakening +that capability check. The locked Effect/ST package and legacy command mechanism +have not been migrated. + +Evidence logs: `/private/tmp/psrs-effect-host-{boundary,gc,backend,source,newtype}.log`. +Six boundary tests, four GC composition tests, two backend runtime tests and the +two new mandatory source execution fixtures pass. Full workspace tests, full +stdlib compilation and official library conformance remain unrun. + +The final focused driver State cohort passes all 43 tests, with zero ignored +cases and mandatory Wasmtime (`/private/tmp/psrs-effect-host-driver.log`). Strict +linker/backend/driver all-target Clippy, formatting and diff checks pass; Clippy +evidence is `/private/tmp/psrs-effect-host-clippy.log`. + +## Non-returning external call projection (2026-10-10) + +This checkpoint supersedes the prior non-returning P9 rejection for checked +runtime calls. The binding adapter retains its provider-independent `Never` +convention separately from normal void-to-Unit. Source invocation planning keeps +that immutable convention with the actual source assignment and checked import. +Emission produces the real `CallVoid`, then a typed bottom projection +(`Unreachable`) and a `Trap` terminator. No runtime payload, physical State or +Unit constant is produced. + +The checked source dependency graph describes abstract normal-return +continuations. Target correspondence refines the exact certified non-returning +invocation to a terminating path. Physical lowering and correspondence stop at +that invocation; later assignments on that path are not emitted. Normal sibling +branches retain their calls and join edges. Refinement is justified by the +frozen checked raw return contract, not by export-name recognition in MIR or by +assuming all void calls terminate. The invocation verifier requires its actual +producer, bottom destination and full instruction coverage; whole-function +verification additionally requires the invocation range to end the block and +its terminator to be Trap. Changing the checked import, substituting Unit, +adding a physical continuation or attaching a normal return rejects. + +Mandatory source execution covers direct trap, a normal-looking read after trap, +constant choices and choices controlled by a real runtime read. A stored 0 +selects termination; a stored 1 selects the normal sibling and returns 42. The +source uses ordinary foreign binding metadata and the default CLI pipeline. +Provider termination does not become a new storage intrinsic or Effect handler. + +Evidence: the source runtime case passes all six scenarios with mandatory +Wasmtime (`/private/tmp/psrs-effect-never-source.log`). Backend raw invocation +and whole-function tests are recorded in `/private/tmp/psrs-effect-never-mir.log`. +Official Effect/ST migration, monomorphic payload conversion, general loops, +scoped transport and dependency-aware optimization remain incomplete. No full +workspace or full stdlib acceptance claim is made. + +Final focused validation: 10 backend raw-call tests, 16 MIR dependency tests and +44 driver State tests pass, with zero ignored tests. Mandatory Wasmtime applies +to the driver execution run. Logs: +`/private/tmp/psrs-effect-never-{mir,state,driver}.log`. Strict backend/driver +all-target Clippy, formatting and diff checks pass; Clippy evidence is +`/private/tmp/psrs-effect-never-clippy.log`. Full workspace tests and full stdlib +compilation remain intentionally unrun. + +## Generic Core command entry normalization (2026-10-10) + +`psrs-core::command::normalize_entry` consumes resolved entry/runner symbols and +checked Core. It requires a monomorphic source runner `T -> Int` and a +monomorphic entry of type T, while preserving direct Int entries. It allocates +a fresh symbol in the entry's source namespace and constructs ordinary Core +`runner main`, preserving the selected main range. Candidate verification is +transactional: missing identities, invalid schemes, nominal input mismatch or +verification failure leave the original Core unchanged. The helper never names +Effect, synthesizes combinators or adds a runtime dispatcher. + +The driver frontend lowering now has an explicit runner selection path exercised +by a focused source harness. It resolves the named source declaration once, +normalizes before pruning and retains ordinary runner dependencies. The existing +production entry selection and legacy Effect path continue to use their prior +mode. Manifest parsing, explicit runner-root loading and production selection +are **not yet wired**; this is checked Core conversion and source execution +evidence, not completed package configuration or legacy-mechanism removal. + +Four focused cases cover an unrelated `Command` newtype, direct Int entry +preservation, missing runner, polymorphic runner, non-Int result, distinct nominal +input type, rollback on failed selection and an ordinary State newtype main +without an explicit runner call. The last source fixture uses the default +backend artifact pipeline and returns 42 under mandatory Wasmtime. Its runner is +an ordinary source function in a separate module. Evidence: +`/private/tmp/psrs-command-driver.log`. Strict Core/driver all-target Clippy passes +(`/private/tmp/psrs-command-clippy.log`). Official Effect/ST migration, package +configuration and legacy deletion remain incomplete. + +The final focused State cohort passes all 48 tests, with mandatory Wasmtime and +zero ignored cases (`/private/tmp/psrs-command-state.log`). The existing legacy +entry cohort passes all 15 tests (`/private/tmp/psrs-command-legacy-entry.log`), +checking that extraction of frontend lowering preserves entry precedence, +source origins and the existing compilation path. Formatting and diff checks +pass. No full workspace or stdlib compilation run was performed. + +## Production package runner selection (2026-10-10) + +This checkpoint supersedes the preceding checkpoint's unwired production +selection limitation. The driver now reads +`compiler_contract.command_runner = { "module": "Runner", "function": "run" }` +from the package manifest. Executable compilation adds its trusted module and +import closure as an explicit root, resolves a source identity in the trusted +prefix and normalizes checked Core before pruning. Compile, report and diagnosis +share this path. A configured runner bypasses legacy TrustedEffect discovery +and lexical runEffect restrictions. The unchanged locked package has no runner +configuration and temporarily retains its legacy path. + +CLI integration cases use a synthetic development package, separate from the +official vendored sources. Main constructs `Job Int`, an ordinary State newtype, +without importing or invoking Runner. Mandatory Wasmtime observes 42; a direct +Int entry observes 7. The State newtype case also imports a Prelude containing +an unrelated opaque Effect declaration without legacy operations, proving that +runner configuration does not activate the legacy contract. Negative cases +reject a missing trusted module, missing declaration, non-Int result, +polymorphic runner and nominal input mismatch. An isolated check-only case +accepts the source despite an absent executable runner root; report and diagnosis +reject that configuration with library-origin diagnostics. + +These cases live in `crates/psrs-cli/tests/command_runner.rs`. They establish +production entry selection, not official Effect/ST package migration. The lock, +official sources and legacy deletion remain unchanged; full stdlib acceptance +and general dependency/optimization coverage remain incomplete. + +Final focused evidence: all four CLI integration cases pass with mandatory +Wasmtime, including successful report/Core dump and traced diagnosis retaining +the runner root (`/private/tmp/psrs-command-package-regression.log`). The entry +filtered driver cohort passes 21 tests with zero ignored tests +(`/private/tmp/psrs-command-package-entry.log`). Driver/CLI all-target strict +Clippy, formatting and diff checks pass. The manifest parsing cohort previously +passed all four package tests (`/private/tmp/psrs-command-package-tests.log`). +No full workspace tests or full stdlib compilation were run. + +## Real-package migration candidate and callable transport (2026-10-10) + +A development copy of the independent package is retained at +`/private/tmp/psrs-effect-state-package`, with preparation script +`/private/tmp/psrs-effect-migrate.py`, package-relative `migration.patch` and +`migration-status.json`. It restores the official Prelude surface, places the +hidden Effect newtype in Effect, retains the pinned official Effect instances, +implements foreign combinator slots as ordinary source functions, configures +PSRS.Command.run and changes PSRS.ST.Action/storage to the shared State +protocol. This is a migration candidate, not an accepted package revision. +Official API auditing, Effect.Ref, host I/O and failure wrappers, ST.Global +behavior and conformance remain unverified. The original independent checkout +and compiler stdlib lock are unchanged. + +The first real candidate failure was official `Functor Effect`'s `map = liftA1` +at P8. Abstract callable-constructor transport attempted to recover the entire +Step product through ordinary payload storage, including its State field. +The repair makes the shared protocol registry retain the successor and erase +only the payload. Constructor transport consumes that registry and the existing +State projection for the result conversion; it adds no Effect name dispatch. +Protocol planning now rejects missing signatures and invalid State call shapes. + +The same `Main.purs` and package fingerprint recovered from P8 rejection to full +compile acceptance. Comparable traces and their comparison are retained as +`effect-diagnose{,-after}.json` and `effect-compare.log` under the candidate root. +The comparison reports compatible inputs and a changed `backend.cc.lower` +status; canonical artifact-content comparison remains unavailable. +`main :: Effect Unit; main = pure unit` executes with exit 0. A second source +uses official class methods to bind `pure 40` to `pure (value + 2)` and executes +through Effect.Unsafe with exit 42. These executions establish those two +operations in the candidate, not full official Effect support. + +The ST reference program is no longer rejected by Core scope verification. +Importing Control.Alt with `main = 0` had reproduced three +`type variable is outside its quantifier scope` errors at its ordinary +`alt = append` definition, which located the defect in the producer's +quantifier evidence rather than in the ST region API. Core scope verification +now opens the leading quantifiers of a record field, projection and array +element before checking that child, and `row_fields` rejects a cyclic row +instead of looping. The eight `record_scope` unit tests cover the repair and +its negative cases; reverting the scope change fails them with the original +message. With that repair the candidate's ST reference program compiles and +executes `Ref.new 40`, `Ref.write 42` and `Ref.read` to exit 42 under Wasmtime, +and the `Control.Alt` import type-checks with `main = 0`. + +This is candidate-package compile and execution evidence. It does not migrate +the locked official package, audit the official ST surface, or establish +library conformance; the package lock, official sources and the legacy Effect +mechanism are unchanged. + +The focused State cohort passes 49 cases with mandatory Wasmtime, including a +new unrelated State newtype transported through `forall f a. f a -> f a` and +executed for value 42. The CC cohort passes 140 tests. Logs are +`state-tests.log`, `transport-test.log` and `cc-tests.log` in the candidate root. +Full workspace tests and full stdlib acceptance remain unrun. + +Three protocol-planning tests also pass (`protocol-tests.log`): a callable with +an ordinary argument followed by State retains both parameters and its Step +successor, while missing signature ownership and a State call without Step +reject. Strict backend/driver/CLI all-target Clippy, formatting and diff checks +pass. The final constructor-transport execution check passes after switching +all consumers to the shared registry result. + +### Quantifier-evidence repair verification (2026-10-11) + +The earlier claim that the ST reference program remained rejected at P7 was +stale: it described an intermediate state before the scope repair landed. With +the current tree and `PSRS_STDLIB_ROOT` set to the candidate package, +`AltMain.purs` (`import Control.Alt (alt)`, `main = 0`) type-checks, and +`STMain.purs` compiles and executes `ST.run` with `Ref.new 40`, `Ref.write 42` +and `Ref.read` to exit 42 under Wasmtime 49.0.2. + +Attribution was confirmed by reverting `verify/scopes/expr.rs` alone: the three +positive `record_scope` cases fail with +`type variable is outside its quantifier scope` and the five negative cases +still pass. The candidate package sources were not modified after the original +log was written, so the earlier failure came from the compiler state at that +time rather than from the package. + +Validation on 2026-10-11: + +- `cargo test --workspace --no-fail-fast`: passed, 1,921 passed, 0 failed and + the 5 existing ignored official-suite scoreboards; doc-tests ran with no + failures. Two independent runs agree. +- `cargo test -p psrs-core --lib record_scope`: 8 passed. +- `cargo fmt --all --check`, `git diff --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- The 7 source-layout violations previously reported by + `crates/psrs-cli/tests/source_layout.rs` are repaired by module-directory + splits; that target passes. +- `crates/psrs-driver/src/tests/cc_ir_audit.rs` asserted the generic dictionary + adapter inside a `ProductMap` plan. CC now emits product field conversions as + explicit assignments, so the audit follows the adapter to its top-level + conversion and additionally checks that its result is rebuilt by `ProductNew`. + Reverting `emit_product_map` fails the audit. + +These repairs do not migrate the locked official package. The stdlib lock, the +official sources and the legacy Effect mechanism are unchanged, the official +suite scoreboards remain unmeasured, and Effect/ST API auditing and conformance +remain open. + +## Canonical host invocation correspondence (2026-10-11) + +A source probe calling `get-stdout` and then explicitly dropping the returned +stream first rejected at P9 with `UnprojectedState`. The external guest +projection retained the logical State parameter and complete Step even after +the external signature was physically projected. Projecting ordinary arguments +and the Step payload removes that layout requirement without deleting or +renumbering the representation table. Production layout planning recomputes +reachability from the physical module; unused logical Step entries are not +physical layout obligations. + +The same probe then exposed the missing correspondence between a source call +and its canonical adapter. Canonical calls change the target identity, may widen +operands or use return areas, build aggregate results, and perform cleanup. +The adapter now builds an immutable plan in an isolated instruction builder +before actual emission. The plan retains source anchors, the checked binding, +instructions, temporary declarations, generated blocks and its exit port. +MIR dependency verification checks the complete adapter and contracts only that +checked subgraph when comparing source invocation order and control edges. +Existing runtime invocation evidence continues to check actual physical block +and instruction anchors, including when a canonical adapter precedes it. + +A variant-result execution case also exposed a concrete result being passed +directly into an abstract Aggregate block parameter. Canonical results are now +constructed at their projected concrete types before conversion to an abstract +aggregate reference or erasure through the existing payload protocol. A malformed +State signature no longer falls back to ordinary WIT conformance checking. + +Focused evidence: + +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib`: 479 passed, + zero failures and zero ignored tests. This includes two new mutation tests + covering canonical targets, operands, Unit results, import signatures, + invocation reordering and added calls. +- `PSRS_REQUIRE_WASMTIME=1 PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib + cargo test -p psrs-driver --lib tests::state::host -- --nocapture`: + three passed, zero ignored tests. Five source-newtype execution paths cover + resource get/drop, widened `u64` input, record result, `list` result + with nonempty argv, and nested variant result followed by a checked runtime + storage read in the same State chain. Changing a variant adapter's + internal switch edge rejects during module verification. The list returns + the observed argv count of three; the other paths return 42. +- The CLI resource probe builds with the explicit development package and + `wasmtime run` exits with 42. Before/after logs are + `/private/tmp/psrs-wit-state-resource-before.log`, + `/private/tmp/psrs-wit-state-resource-after.log`, and + `/private/tmp/psrs-wit-state-resource-plan.log`. +- `cargo fmt --all --check`, `git diff --check`, and + `cargo clippy -p psrs-backend -p psrs-driver --all-targets -- -D warnings` + pass. Test logs are `/private/tmp/psrs-effect-backend-after.log` and + `/private/tmp/psrs-effect-host-driver.log`. + +The compiler lock and sibling package are unchanged by this slice. A live count +of the development package finds 92 WIT foreign declarations returning Effect: +Clock 5, Random 5, Network 27, IO 20, Process 3, and FileSystem 32. The earlier +handoff's count of 55 does not cover that current surface. Their ordinary +library wrapper migration and complete API/conformance evidence remain open. +General source dependency loops, multiway control, scoped transport, provenance +requiredness, legacy deletion and optimizer coverage remain separate obligations. +No workspace test suite or official scoreboard was rerun for this slice. + +## Public WASI wrappers in the development package (2026-10-11) + +The independent `psrs-stdlib` checkout now has an uncommitted host-wrapper slice +on top of `7852625`. All 92 target WASI foreign declarations use private +State-stepping source signatures. Their public signatures, exports and existing +pure wrapper algorithms are preserved. A target-only `PSRS.Effect.fromState` +owns the narrow coercion into the package's hidden Effect newtype; it does not +execute the callable or manufacture a State value. The package inventory now +records that helper and the previously unclassified `PSRS.Command` as target +sources. No official source file changed in this host-wrapper slice. + +The first public resource program rejected at P8: a foreign function used as a +value was looked up only among local source declarations. CC now consumes its +checked external scheme through the common partial-application path with zero +supplied arguments. Source identity, checked use types, normal conversions and +closure construction therefore retain the same owner as partially supplied +foreign calls. The regression uses an unrelated `Native` newtype and executes +get/drop to 42; it contains no Effect name or compiler-special library adapter. + +The library-owned runner accepted all six versioned public API fixtures under +`conformance/effects/` in the actual package: + +- Resource get/drop returns 42. +- Console construction and repeated execution print exactly `first`, `later`, + `later`, each on its own line, and the configured Effect Unit runner exits 0. +- Arguments consumes the canonical host list and returns 42. +- Clock decodes its record, creates/drops a duration subscription and returns 42. +- The unchanged official GlobalST conversion allocates, writes and reads 42. +- Exit returns 47 and the following console action produces no output. + +The evidence reports are `/private/tmp/psrs-effect-package-/run.json`, +with case names `resource`, `console`, `arguments`, `clock`, `globalst`, and +`exit`. All reports require Wasmtime, check exact outputs and record unchanged +package fingerprints. The umbrella WASI import compiles with the actual +development package; this is compile acceptance, not execution of all imports. + +`node conformance/st.mjs /private/tmp/ps-pkgs/purescript-st +/private/tmp/psrs-effect-state-st-oracle` evaluates ten observations against +the pinned official ST JS implementation. The same package runner accepts its +generated source with exit 42 in `/private/tmp/psrs-effect-state-st-runtime`. +This includes cell allocation/read/write, map/bind, while/for/foreach and empty +or false conditions that must not invoke their callback. It does not establish +general dependency CFG transformation or every public ST API. + +The pinned source audit in `/private/tmp/psrs-effect-package-audit` checks all +41 reference packages and retains 170 identical / 36 modified official modules, +155 nonrecursive replacements, 3 removed foreign declarations and 130 retained +foreign declarations. Target additions increase from 24 to 26: Command obtains +provenance and the new helper adds one module. The earlier unclassified module +count of one becomes zero. + +Focused compiler host tests pass 4/4 with mandatory Wasmtime, and package Node +tests pass 11/11. Formatting, both repository diff checks and backend/driver +all-target Clippy pass. Logs include `/private/tmp/psrs-effect-foreign-value.log`, +`/private/tmp/psrs-effect-foreign-host-after.log`, and +`/private/tmp/psrs-effect-foreign-clippy.log`. Compiler staging remains untouched; +no changes were committed or pushed. The normal compiler lock stays at +`1e01310`, so development package consumption must remain explicit. + +Complete host/API conformance, the failure wrapper, provenance requiredness, +general scoped/multiway dependency control, legacy deletion and optimizer +coverage remain open. Neither the full workspace suite nor official scoreboards +were rerun for this slice. + +## Suspended failure and mixed provider composition (2026-10-11) + +The target package now exports `PSRS.Effect.fail`, an ordinary library wrapper +around the checked non-returning runtime storage trap. An unused constructed +action returns 42; executing the action after console output produces exactly +`before\n`, then Wasmtime's terminal `unreachable` trap (observed exit 134), +with no following output. No Effect-specific intrinsic or fabricated normal +State successor was added. + +The first combined console/trap case rejected at P11 because the raw provider +schedule attempted to instantiate the scalar allocator before the application. +Its unavailable imports were `env` and `__main_module__`. Composition now keeps +providers with reference-valued import/export interfaces and their transitive +consumers in the raw Core graph. Scalar-interface providers use the existing +canonical library/shim provisioning, retaining their checked scheduling flags. +The allocator therefore receives the original application's memory and heap +boundary. Unsupported raw dependency cycles still reject with the unresolved +provider namespaces included in the diagnostic. + +The new facade test checks retained scalar imports, relocated raw function +exports, and unchanged complete type signatures. Its first run incorrectly +used function indices as `CoreTypes.signature` type indices; the test now checks +the actual function type entries. The new source regression executes a canonical +string-list call followed by GC storage read or trap in the selected branch. + +Focused validation: + +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-linker`: all unit and integration + targets pass, including raw GC storage and allocator heap-boundary execution. +- Driver `tests::state::runtime_cc`: 8/8; `tests::state::host`: 4/4, both with + mandatory Wasmtime and explicit development package consumption. +- Actual package runner accepts failure, deferred failure, Console, Arguments, + and GlobalST against the rebuilt CLI. Reports are + `/private/tmp/psrs-effect-failure-final-/run.json`, with case names + `failure`, `failure-deferred`, `console`, `arguments`, and `globalst`. + Every report records unchanged package fingerprint + `fnv1a64-v1:d3b145fb3d987017`. +- Actual package tool tests: 12/12. Expected-trap mode requires successful + compilation, completed nonzero execution without a process signal, exact + stdout and the terminal Wasmtime diagnostic; compile/launch failure, timeout + or successful execution cannot satisfy it. Full stderr remains captured. +- Pinned source audit covers all 41 checkouts, using the exact checkout paths + retained by the previous audit. Counts remain 170 identical / 36 modified + official modules, 26 target additions, 155 nonrecursive replacements, + 3 removed foreign declarations and 130 retained foreign declarations. + Evidence is `/private/tmp/psrs-effect-failure-final-audit/inventory.json`. +- Formatting, both repository diff checks, and linker/backend/driver all-target + Clippy pass. + +No workspace suite or official scoreboard was rerun. The compiler index remains +at 259 paths, the lock stays at `1e01310`, and no changes were committed or +pushed. Complete API conformance, provenance requiredness, general scoped and +multiway dependency control, optimizer evidence and legacy deletion remain open. + +## Required MIR dependency provenance (2026-10-11) + +The old module verifier only checked `Function.state` when it was present. +Clearing that field on a projected canonical host function therefore accepted +its physical body without any dependency correspondence checks. The new removal +regression fails when the inventory guard is disabled: `verify_module` returns +`Ok(())` where rejection is required. This comparable baseline is retained at +`/private/tmp/psrs-effect-inventory-without-guard.log`. + +P9 now derives one immutable module inventory from the logical CC source before +physical projection. That inventory owns dependency requiredness and also drives +which functions receive projection evidence. Per-function witnesses must refer +to that same source. Retained declarations must be original source declarations +or explicitly registered P9 conversion helpers. Clearing a witness, clearing a +planned module's inventory, using another source's witness, or renaming a +projected declaration to an unregistered identity is rejected. Optimizer entry +verification enforces the same requirement. Whole-function reachability pruning +may still remove an unused dependency function; requirements for live functions +remain immutable and are checked after pruning. + +Directly constructed physical MIR uses an explicit empty inventory and may not +attach unowned dependency witnesses. For dependency-free direct CC, the inventory +does not newly claim ordinary CC typing. An initial implementation accidentally +broadened that claim and rejected nine existing ABI cast fixtures; moving +inventory construction to the projection owner and preserving the existing +conditional typing contract restored those cases without changing their bodies. + +Focused validation with mandatory Wasmtime: + +- Backend library tests: 483/483, zero ignored, including four new regressions + for missing witnesses, foreign-source witnesses, identity substitution and + legitimate dead-function pruning. +- Driver State tests with the actual development package: 54/54, zero ignored. + This includes source runners, scoped callable transport, runtime storage, + canonical host adapters, command entry and selected-branch termination. +- Formatting and both repository diff checks pass; backend/driver all-target + Clippy passes. Logs are `/private/tmp/psrs-effect-inventory-backend.log`, + `/private/tmp/psrs-effect-inventory-driver.log`, and + `/private/tmp/psrs-effect-inventory-clippy.log`. + +This closes the missing per-function evidence bypass for production P9 modules. +It does not prove general scoped transport, multiway/loop correspondence or +optimizer graph rewriting. Complete API conformance and legacy deletion remain +open. No full workspace suite or official scoreboard was rerun, the 259 staged +paths remain unchanged, and the compiler lock stays at `1e01310`. + +## Structured multiway State projection (2026-10-11) + +The focused three-arm CC probe rejected at P8 with +`CC state switch requires checked multiway dependency projection`; its baseline +is `/private/tmp/psrs-effect-switch-before.log`. CC now shares dependency +fork/join construction between binary and multiway choices. The representation- +independent graph validates every case/default dependency transfer, and trapping +arms never acquire a normal join edge. Concrete switch labels and predicates +remain owned by CC and are checked against actual MIR. + +P9 recursively projects every switch arm and checks source block parameters, +case labels, selector, default edge, invocation placement, join payload operands +and return operands. Nested binary choices within a switch retain both joins. +Raw-State choice results still reject explicitly before an entire effectful +switch could be erased; zero-width control-result projection remains open. + +The strengthened join check exposed the scalar constant pass removing source +join parameters and jump arguments. Constant folding may still preserve scalar +destinations, but block-parameter materialization now retains source dependency +anchors until it has a checked evidence-transfer operation. An all-constant +payload join regression verifies that optimization leaves those parameters. + +Focused mandatory-Wasmtime evidence: + +- Core dependency graph tests: 6/6, including stale case/default edge rejection. +- Backend State tests: 27/27; optimizer tests: 8/8. Six actual component runs + cover two case labels and default, with and without a trapping first arm. + Normal selected values are 42/43/44; only the selected trap terminates. + Mutations of selector, label, target, default, call placement and same-typed + join payload reject through dependency verification. +- Driver State tests: 56/56. The new constructor case executes all three + source selections, and a predecessor replay after the choice rejects at Core. +- Actual package `conformance/effects/Choices.purs` combines three selections + through ordinary Effect Bind and checks values 40/41/42 before returning 42. + Its fourth arm contains an unselected runtime trap. The runner report is + `/private/tmp/psrs-effect-switch-package-final/run.json`, with unchanged + package fingerprint `fnv1a64-v1:7160abec40561f94`. +- Formatting, both repository diff checks, and core/backend/driver all-target + Clippy pass. Logs use the prefix `/private/tmp/psrs-effect-switch-` with + suffixes `backend.log`, `optimizer.log`, `driver.log` and `clippy.log`. + +An adjacent storage projection gap remains explicit: a monomorphic +`Array Int -> Int -> State RealWorld -> Step RealWorld Int` foreign read is +accepted at source binding but rejected at P9 for missing checked canonical +payload recovery. Its retained source and log are +`/private/tmp/psrs-effect-monomorphic-storage-result.purs` and `.log`. +The package fixture uses the catalog's polymorphic source signature and its +existing checked payload transport; this does not close monomorphic raw-ABI +adaptation. Neither a constant result nor permissive physical cast was added. + +General loop projection, scoped/erased transport, optimizer graph transfers, +complete API conformance and legacy deletion remain open. No full workspace +suite or official scoreboard was rerun. Compiler staging remains 259 paths; +no commits, pushes or compiler lock updates were made. + + +## Monomorphic storage payload protocol (2026-10-11) + +The preceding monomorphic read baseline is now repaired at Core-to-CC protocol +selection. Core still checks nominal regions and element equality at source +use types. Runtime catalog Element operands and Element results adopt the shared +payload protocol only after those checks; Array, Int, Unit and non-returning +roles retain their contracts. Ordinary CC conversions perform boxing and +recovery. Record conversion uses the supplied storage field representations +alongside checked source field types, rather than rebuilding those shapes from +the concrete source type alone. + +The new runtime matrix exposed a callable mismatch: entering erased storage +used the payload curry protocol, but recovery selected a concrete closure cast. +Erased payload endpoints now use their authoritative owner before ordinary +concrete callable adaptation. Int, Number, Boolean, String, record and callable +values execute correctly after write/read; the Int case retains 2147483647, +and the callable case executes the stored replacement callback. + +Two monomorphic declarations importing array_read also exposed two independent +linker constraints. Application checking now validates every occurrence against +the complete planned Core signature, accepting matching aliases and rejecting +conflicting types. Component embedding then normalizes checked duplicate +function import names and remaps all function references. A focused structural +case checks calls, exports and element initializers. This normalization does +not replace application bodies or merge source invocation evidence. + +Focused validation with mandatory Wasmtime: + +- Backend library: 489/489, including catalog role preservation and existing + malformed storage, dependency and canonical host adapter checks. +- Driver State: 60/60. Four new tests cover scalar/record/callback recovery, + partial read, nested array sharing through two source aliases, and checked + CC protocol selection before MIR layout. +- Linker: 80/80 across its library and integration tests, zero ignored. +- The library-owned runner accepts the actual development package with + ordinary Effect Bind and monomorphic nested-array read/write aliases. Writing + through the first retrieved element is observed through the second slot; + execution returns 42 with empty stdout/stderr. Report: + /private/tmp/psrs-effect-storage-aliases-final/run.json. Package fingerprint + remains fnv1a64-v1:7160abec40561f94. +- Backend/driver/linker all-target Clippy, formatting and working-tree diff + checks pass. Logs use /private/tmp/psrs-effect-storage-protocol-final- with + backend.log, driver.log, linker.log and clippy.log suffixes. The staged-only + diff check still reports three existing Markdown hard-break spaces at design + lines 3, 6 and 12; the index was not rewritten. + +This closes the concrete monomorphic storage recovery gap, including callable +payloads and alias-sensitive nested arrays. It does not close general loop or +scoped transport, optimizer graph transfers, complete API conformance or legacy +deletion. The full workspace and official scoreboard were not rerun. Compiler +staging stays at 259 paths, the lock stays at 1e01310, and no commits or pushes +were made. The package runner input is retained under /private/tmp; its compiler +regressions are maintained in the driver and linker tests. + + +## Public recursive Effect loop evidence (2026-10-11) + +The actual package's ordinary whileE, untilE, forE and foreachE definitions +already compose through checked calls and branch projection. A combined public +program using unchanged GlobalST reference adapters executes to 42; its report +is /private/tmp/psrs-effect-loops-before/run.json. This evidence must not be +misreported as arbitrary dependency CFG backedge support or stack-safe looping. + +The independent package now maintains conformance/effect-loops.mjs, +conformance/effects/Loops.purs and Loops.observations.json. The oracle requires +a clean purescript-effect checkout at the package pin before importing its +actual Effect.js. Ten observations compare while condition/body trace 1212121, +until invocation counts 3 and 1, exclusive for order 12345, negative-bound order +1234, foreach order 314, and four skipped callbacks that would trap. The generated +Wasm input checks each independently and returns 42 only when all agree. +The runner accepts /private/tmp/psrs-effect-public-loops-runtime/run.json, +recording the unchanged package fingerprint fnv1a64-v1:7160abec40561f94 and +actual compiler/runtime hashes. After installing the oracle, fixture and package +documentation, the maintained fixture is independently accepted with package +fingerprint fnv1a64-v1:db4998eb78158e83 in +/private/tmp/psrs-effect-public-loops-versioned/run.json. Each report confirms +its own package remained unchanged during execution; the installation changes +the package fingerprint between the two runs. Package Node tests +pass 12/12 with zero skips; syntax and both working-tree diff checks pass. +No official library implementation or inventory +was changed in this slice. + +A separate public MonadRec Effect baseline rejects at P8 library linking: +Effect.Ref._new, Effect.Ref.read and Effect.Ref.write have no target +implementation. The retained source is /private/tmp/psrs-effect-tailrecm.purs; +its failed runner report is /private/tmp/psrs-effect-tailrecm-before/run.json. +The official foreign contracts remain intact. Reference adapter migration is +the next library integration obligation; a tailRecM-specific intrinsic or fake +reference implementation would not satisfy it. + +The current requirement map above is refreshed to reflect verified multiway, +monomorphic payload and focused official-loop evidence. Full API/host conformance, +arbitrary CFG backedges, scoped transport, optimizer graph rewriting, legacy +deletion and coherent package pin acceptance remain open. No Rust source was +changed, no workspace or scoreboard was rerun, and the 259-path index and old +compiler library lock remain unchanged. From 4fcc98543ca8bdc45b005595315e4884b4bcdca0 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:07:38 +0800 Subject: [PATCH 087/148] Run library-owned effects through the driver and CLI --- crates/psrs-cli/tests/command_runner.rs | 244 +++++++++ crates/psrs-driver/src/lib.rs | 2 +- crates/psrs-driver/src/prelude/mod.rs | 24 +- crates/psrs-driver/src/prelude/package.rs | 60 +++ crates/psrs-driver/src/program/compilation.rs | 63 +-- crates/psrs-driver/src/program/library.rs | 56 +- crates/psrs-driver/src/program/lowering.rs | 127 +++++ crates/psrs-driver/src/program/mod.rs | 61 +-- crates/psrs-driver/src/tests/cc_ir_audit.rs | 93 ++-- .../src/tests/generic_aggregate_audit.rs | 18 +- crates/psrs-driver/src/tests/mod.rs | 1 + .../src/tests/parameterized_shapes.rs | 46 +- crates/psrs-driver/src/tests/state/cc.rs | 200 ++++++++ crates/psrs-driver/src/tests/state/command.rs | 129 +++++ crates/psrs-driver/src/tests/state/host.rs | 156 ++++++ crates/psrs-driver/src/tests/state/mod.rs | 480 ++++++++++++++++++ crates/psrs-driver/src/tests/state/runners.rs | 392 ++++++++++++++ .../psrs-driver/src/tests/state/runtime_cc.rs | 366 +++++++++++++ .../src/tests/state/storage_protocol.rs | 129 +++++ 19 files changed, 2450 insertions(+), 197 deletions(-) create mode 100644 crates/psrs-cli/tests/command_runner.rs create mode 100644 crates/psrs-driver/src/program/lowering.rs create mode 100644 crates/psrs-driver/src/tests/state/cc.rs create mode 100644 crates/psrs-driver/src/tests/state/command.rs create mode 100644 crates/psrs-driver/src/tests/state/host.rs create mode 100644 crates/psrs-driver/src/tests/state/mod.rs create mode 100644 crates/psrs-driver/src/tests/state/runners.rs create mode 100644 crates/psrs-driver/src/tests/state/runtime_cc.rs create mode 100644 crates/psrs-driver/src/tests/state/storage_protocol.rs diff --git a/crates/psrs-cli/tests/command_runner.rs b/crates/psrs-cli/tests/command_runner.rs new file mode 100644 index 00000000..7902d904 --- /dev/null +++ b/crates/psrs-cli/tests/command_runner.rs @@ -0,0 +1,244 @@ +use std::fs; +use std::path::PathBuf; +use std::process::{Command, Output}; +use std::sync::atomic::{AtomicUsize, Ordering}; + +const TYPES: &str = "module Types where\nimport Prim.State (State, RealWorld)\ntype Step s a = { state :: State s, value :: a }\nnewtype Job a = Job (State RealWorld -> Step RealWorld a)\n"; +const RUNNER: &str = "module Runner where\nimport Prim.State (State, RealWorld)\nimport Types (Job(..), Step)\nforeign import \"psrs:intrinsic#runWorld\" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a\nrun :: Job Int -> Int\nrun (Job action) = execute action\n"; +const MAIN: &str = "module Main where\nimport Types (Job(..))\nmain :: Job Int\nmain = Job (\\state -> { state: state, value: 42 })\n"; + +struct Package(PathBuf); + +impl Package { + fn new() -> Self { + static NEXT: AtomicUsize = AtomicUsize::new(0); + let root = std::env::temp_dir().join(format!( + "psrs-command-runner-{}-{}", + std::process::id(), + NEXT.fetch_add(1, Ordering::Relaxed) + )); + fs::create_dir_all(root.join("lib")).unwrap(); + fs::create_dir_all(root.join("conformance")).unwrap(); + fs::write(root.join("upstream-lock.json"), "{}").unwrap(); + fs::write(root.join("lib/trusted"), "Prelude\nTypes\nRunner\n").unwrap(); + fs::write(root.join("lib/Prelude.purs"), "module Prelude where\n").unwrap(); + fs::write(root.join("lib/Types.purs"), TYPES).unwrap(); + fs::write(root.join("lib/Runner.purs"), RUNNER).unwrap(); + fs::write(root.join("Main.purs"), MAIN).unwrap(); + let package = Self(root); + package.configure("Runner", "run"); + package + } + + fn configure(&self, module: &str, function: &str) { + let manifest = serde_json::json!({ + "schema_version": 1, + "name": "psrs-stdlib", + "source_root": "lib", + "trusted_modules": "lib/trusted", + "upstream_lock": "upstream-lock.json", + "compiler_contract": { + "primitive_binding_protocol": 1, + "string_semantics": "unicode-scalar-utf8", + "int_semantics": "signed-i32", + "command_runner": { "module": module, "function": function } + } + }); + fs::write( + self.0.join("manifest.json"), + serde_json::to_vec(&manifest).unwrap(), + ) + .unwrap(); + } + + fn build(&self) -> Output { + Command::new(env!("CARGO_BIN_EXE_psrs")) + .env("PSRS_STDLIB_ROOT", &self.0) + .arg("build") + .arg(self.0.join("Main.purs")) + .arg("-o") + .arg(self.0.join("main.wasm")) + .output() + .unwrap() + } + + fn reject(&self, message: &str) { + let output = self.build(); + assert!(!output.status.success(), "invalid runner accepted"); + let stderr = String::from_utf8_lossy(&output.stderr); + assert!(stderr.contains(message), "{stderr}"); + } + + fn execute(&self, expected: i32) { + let output = self.build(); + assert!( + output.status.success(), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + let output = Command::new("wasmtime") + .arg("run") + .arg(self.0.join("main.wasm")) + .output(); + match output { + Ok(output) => assert_eq!( + output.status.code(), + Some(expected), + "{}", + String::from_utf8_lossy(&output.stderr) + ), + Err(error) if error.kind() == std::io::ErrorKind::NotFound => { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "mandatory Wasmtime is missing" + ); + eprintln!("Wasmtime unavailable; execution skipped"); + } + Err(error) => panic!("Wasmtime failed: {error}"), + } + } +} + +impl Drop for Package { + fn drop(&mut self) { + let _ = fs::remove_dir_all(&self.0); + } +} + +#[test] +fn reports_and_diagnosis_retain_the_configured_runner() { + const CHILD_ROOT: &str = "PSRS_COMMAND_REPORT_ROOT"; + if let Some(root) = std::env::var_os(CHILD_ROOT) { + let source = fs::read_to_string(PathBuf::from(root).join("Main.purs")).unwrap(); + let sources = [("Main.purs", source.as_str())]; + let report = psrs_driver::compile_program_sources_with_prelude_report(&sources); + assert!(report.artifact.is_some(), "{:?}", report.diagnostics); + assert!(report.dumps.core.unwrap().contains("$command_entry")); + let report = psrs_driver::compile_program_sources_with_prelude_diagnosis(&sources, true); + assert!(report.artifact.is_some(), "{:?}", report.diagnostics); + assert!(report.backend_trace.is_some()); + let frontend = report.frontend_trace.unwrap(); + assert!(frontend.output_core.is_some()); + assert!( + frontend + .source_names + .iter() + .any(|name| name.ends_with("Runner.purs")) + ); + return; + } + let package = Package::new(); + let output = Command::new(std::env::current_exe().unwrap()) + .args([ + "--exact", + "reports_and_diagnosis_retain_the_configured_runner", + "--nocapture", + ]) + .env(CHILD_ROOT, &package.0) + .env("PSRS_STDLIB_ROOT", &package.0) + .output() + .unwrap(); + assert!( + output.status.success(), + "{}\n{}", + String::from_utf8_lossy(&output.stdout), + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn configured_source_runner_executes_an_unrelated_state_newtype() { + let package = Package::new(); + fs::write( + package.0.join("lib/Prelude.purs"), + "module Prelude where\nforeign import data Effect :: Type -> Type\n", + ) + .unwrap(); + fs::write( + package.0.join("Main.purs"), + MAIN.replace("import Types", "import Prelude (Effect)\nimport Types"), + ) + .unwrap(); + // Main neither imports Runner nor calls it: configuration must retain it. + // An unrelated opaque Effect declaration must not activate legacy checks. + package.execute(42); + fs::write( + package.0.join("Main.purs"), + "module Main where\nmain :: Int\nmain = 7\n", + ) + .unwrap(); + package.execute(7); +} + +#[test] +fn configured_runner_rejects_missing_identity_and_invalid_checked_types() { + let package = Package::new(); + package.configure("Missing", "run"); + package.reject("absent from the trusted package inventory"); + package.configure("Runner", "missing"); + package.reject("exactly one source declaration"); + package.configure("Runner", "run"); + fs::write( + package.0.join("lib/Runner.purs"), + "module Runner where\nimport Types (Job)\nrun :: Job Int -> Boolean\nrun _ = true\n", + ) + .unwrap(); + package.reject("must return Int"); + fs::write( + package.0.join("lib/Runner.purs"), + "module Runner where\nrun :: forall a. a -> Int\nrun _ = 0\n", + ) + .unwrap(); + package.reject("must be monomorphic"); + fs::write( + package.0.join("lib/Runner.purs"), + "module Runner where\nnewtype Other = Other Int\nrun :: Other -> Int\nrun (Other value) = value\n", + ) + .unwrap(); + package.reject("entry type disagrees"); +} + +#[test] +fn check_only_does_not_require_an_executable_runner_root() { + const CHILD_ROOT: &str = "PSRS_COMMAND_CHECK_ONLY_ROOT"; + if let Some(root) = std::env::var_os(CHILD_ROOT) { + let source = fs::read_to_string(PathBuf::from(root).join("Main.purs")).unwrap(); + psrs_driver::check_program_types_lenient_with_prelude(&[("Main.purs", &source)]).unwrap(); + let sources = [("Main.purs", source.as_str())]; + for report in [ + psrs_driver::compile_program_sources_with_prelude_report(&sources), + psrs_driver::compile_program_sources_with_prelude_diagnosis(&sources, true), + ] { + assert!(report.artifact.is_none()); + assert!(report.diagnostics.iter().any(|error| { + error.source == psrs_driver::DiagnosticOrigin::Library + && error + .diagnostic + .message + .contains("absent from the trusted package inventory") + })); + } + return; + } + let package = Package::new(); + package.configure("Missing", "run"); + // A child process isolates the package cache from other integration cases. + let output = Command::new(std::env::current_exe().unwrap()) + .args([ + "--exact", + "check_only_does_not_require_an_executable_runner_root", + "--nocapture", + ]) + .env(CHILD_ROOT, &package.0) + .env("PSRS_STDLIB_ROOT", &package.0) + .output() + .unwrap(); + assert!( + output.status.success(), + "{}\n{}", + String::from_utf8_lossy(&output.stdout), + String::from_utf8_lossy(&output.stderr) + ); + package.reject("absent from the trusted package inventory"); +} diff --git a/crates/psrs-driver/src/lib.rs b/crates/psrs-driver/src/lib.rs index 2ab22ab2..7ae98957 100644 --- a/crates/psrs-driver/src/lib.rs +++ b/crates/psrs-driver/src/lib.rs @@ -3,7 +3,7 @@ use psrs_span::{SourceFile, TextRange}; mod diagnostics; mod loader; mod prelude; -pub use prelude::{StandardLibraryInfo, standard_library_info}; +pub use prelude::{CommandRunner, StandardLibraryInfo, standard_library_info}; mod program; pub use diagnostics::{CompilationReport, FrontendPassTrace, IrDumpArtifacts, PartialIrDumps}; diff --git a/crates/psrs-driver/src/prelude/mod.rs b/crates/psrs-driver/src/prelude/mod.rs index a6369c1d..b0c55f1c 100644 --- a/crates/psrs-driver/src/prelude/mod.rs +++ b/crates/psrs-driver/src/prelude/mod.rs @@ -4,7 +4,7 @@ //! `PSRS_STDLIB_ROOT` explicitly selects an unlocked development package. mod package; -pub use package::StandardLibraryInfo; +pub use package::{CommandRunner, StandardLibraryInfo}; use std::collections::HashSet; use std::collections::VecDeque; @@ -44,6 +44,19 @@ pub(crate) fn module_names() -> Result, String> { /// Prepends the trusted standard-library modules reachable from `sources`. pub(crate) fn prepend<'a>( user_sources: &[(&'a str, &'a str)], +) -> Result, String> { + prepend_selected(user_sources, false) +} + +pub(crate) fn prepend_for_command<'a>( + user_sources: &[(&'a str, &'a str)], +) -> Result, String> { + prepend_selected(user_sources, true) +} + +fn prepend_selected<'a>( + user_sources: &[(&'a str, &'a str)], + command: bool, ) -> Result, String> { let library = sources()?; let by_name = library @@ -53,6 +66,15 @@ pub(crate) fn prepend<'a>( .collect::>(); let mut needed = HashSet::new(); let mut pending = VecDeque::new(); + if command && let Some(runner) = &load()?.info.command_runner { + if !by_name.contains_key(runner.module.as_str()) { + return Err(format!( + "configured command runner module `{}` is absent from the trusted package inventory", + runner.module + )); + } + pending.push_back(runner.module.clone()); + } for (name, text) in user_sources { if let Ok(parsed) = crate::lower_source_to_ast(name, text) { pending.extend(parsed.imports.into_iter().map(|import| import.module.text)); diff --git a/crates/psrs-driver/src/prelude/package.rs b/crates/psrs-driver/src/prelude/package.rs index 326d9a78..3dcc5906 100644 --- a/crates/psrs-driver/src/prelude/package.rs +++ b/crates/psrs-driver/src/prelude/package.rs @@ -9,6 +9,15 @@ pub struct StandardLibraryInfo { pub source_fingerprint: String, /// Absent for an explicit development override. pub locked_revision: Option, + pub command_runner: Option, +} + +/// An ordinary package-owned declaration used to adapt command entries. +#[derive(Clone, Debug, PartialEq, Eq, Deserialize)] +#[serde(deny_unknown_fields)] +pub struct CommandRunner { + pub module: String, + pub function: String, } #[derive(Deserialize)] @@ -86,6 +95,24 @@ fn inspect(root: &Path, revision: Option) -> Result(value.clone()) + .map_err(|error| format!("{}: invalid command_runner: {error}", root.display())) + }) + .transpose()?; + if command_runner.as_ref().is_some_and(|runner| { + runner.module.is_empty() + || runner.function.is_empty() + || runner.module.trim() != runner.module + || runner.function.trim() != runner.function + }) { + return Err(format!( + "{}: command_runner requires nonempty module and function names", + root.display() + )); + } // Required metadata must exist even in development mode. read(&root.join("lib/trusted"))?; read(&root.join("lib/Prelude.purs"))?; @@ -95,6 +122,7 @@ fn inspect(root: &Path, revision: Option) -> Result Result> { - let report = compile_attempt(sources, trusted_prefix, false, false); + let report = compile_attempt(sources, trusted_prefix, false, false, None); match report.artifact { Some(artifact) => Ok(artifact), None => Err(report.diagnostics), } } -pub(crate) fn compile_program_sources_with_trusted_prefix_report( - sources: &[(&str, &str)], - trusted_prefix: usize, -) -> CompilationReport { - compile_attempt(sources, trusted_prefix, true, false) -} - -pub(crate) fn compile_program_sources_with_trusted_prefix_diagnosis( - sources: &[(&str, &str)], - trusted_prefix: usize, - capture_dumps: bool, -) -> CompilationReport { - compile_attempt(sources, trusted_prefix, capture_dumps, true) -} - -fn compile_attempt( +pub(super) fn compile_attempt( sources: &[(&str, &str)], trusted_prefix: usize, capture_dumps: bool, trace_enabled: bool, + runner: Option<&crate::prelude::CommandRunner>, ) -> CompilationReport { - let (core, source_warnings, effect_context) = - match lower_program_to_core_and_effect_context(sources, trusted_prefix) { - Ok(lowered) => lowered, - Err(diagnostics) => { - let mut report = CompilationReport::failed(diagnostics, PartialIrDumps::default()); - if trace_enabled { - report.frontend_trace = Some(FrontendPassTrace { - contract_version: 1, - pass_key: "driver.frontend.lower_program_to_core", - trusted_prefix, - source_names: sources.iter().map(|(name, _)| (*name).to_owned()).collect(), - status: TracePassStatus::Rejected, - output_core: None, - diagnostic_indices: (0..report.diagnostics.len()).collect(), - }); - } - return report; + let (core, source_warnings, effect_context) = match if let Some(runner) = runner { + super::lowering::lower_program_inner( + sources, + trusted_prefix, + Some((&runner.module, &runner.function)), + ) + } else { + lower_program_to_core_and_effect_context(sources, trusted_prefix) + } { + Ok(lowered) => lowered, + Err(diagnostics) => { + let mut report = CompilationReport::failed(diagnostics, PartialIrDumps::default()); + if trace_enabled { + report.frontend_trace = Some(FrontendPassTrace { + contract_version: 1, + pass_key: "driver.frontend.lower_program_to_core", + trusted_prefix, + source_names: sources.iter().map(|(name, _)| (*name).to_owned()).collect(), + status: TracePassStatus::Rejected, + output_core: None, + diagnostic_indices: (0..report.diagnostics.len()).collect(), + }); } - }; + return report; + } + }; let mut frontend_trace = trace_enabled.then(|| FrontendPassTrace { contract_version: 1, diff --git a/crates/psrs-driver/src/program/library.rs b/crates/psrs-driver/src/program/library.rs index ba45b67d..0b442852 100644 --- a/crates/psrs-driver/src/program/library.rs +++ b/crates/psrs-driver/src/program/library.rs @@ -1,8 +1,7 @@ //! Prepends the on-disk standard library as the trusted source prefix. use super::{ - check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, - compile_program_sources_with_trusted_prefix, diagnostic, + check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, diagnostic, }; use crate::prelude; use crate::{Artifact, CompilationReport, DiagnosticOrigin, ProgramDiagnostic}; @@ -16,43 +15,60 @@ use crate::{Artifact, CompilationReport, DiagnosticOrigin, ProgramDiagnostic}; pub fn compile_program_sources_with_prelude( sources: &[(&str, &str)], ) -> Result> { - let (all_sources, trusted_prefix) = with_prelude(sources)?; - compile_program_sources_with_trusted_prefix(&all_sources, trusted_prefix) - .map_err(|errors| shift(errors, trusted_prefix)) + let report = compile_library(sources, false, false); + match report.artifact { + Some(artifact) => Ok(artifact), + None => Err(report.diagnostics), + } } -/// Compiles with the trusted library and retains the last successful IR stages -/// for diagnosis. Backend diagnostics keep their source origin and error kind. +/// Compiles with the package and retains the last successful IR stages. pub fn compile_program_sources_with_prelude_report(sources: &[(&str, &str)]) -> CompilationReport { - let (all_sources, trusted_prefix) = match with_prelude(sources) { - Ok(sources) => sources, - Err(errors) => return CompilationReport::failed(errors, Default::default()), - }; - let mut report = - super::compile_program_sources_with_trusted_prefix_report(&all_sources, trusted_prefix); - report.diagnostics = shift(report.diagnostics, trusted_prefix); - report + compile_library(sources, true, false) } -/// Compiles for `psrs diagnose`, retaining a lightweight pass trace and -/// optionally the IR snapshots used by trace-mode bundles. +/// Compiles with the package and records actual frontend/backend pass events. pub fn compile_program_sources_with_prelude_diagnosis( sources: &[(&str, &str)], capture_dumps: bool, ) -> CompilationReport { - let (all_sources, trusted_prefix) = match with_prelude(sources) { + compile_library(sources, capture_dumps, true) +} + +fn compile_library( + sources: &[(&str, &str)], + capture_dumps: bool, + trace: bool, +) -> CompilationReport { + let (all_sources, trusted_prefix) = match prelude::prepend_for_command(sources) { Ok(sources) => sources, - Err(errors) => return CompilationReport::failed(errors, Default::default()), + Err(message) => return package_failure(message), }; - let mut report = super::compile_program_sources_with_trusted_prefix_diagnosis( + let info = match prelude::standard_library_info() { + Ok(info) => info, + Err(message) => return package_failure(message), + }; + let mut report = super::compilation::compile_attempt( &all_sources, trusted_prefix, capture_dumps, + trace, + info.command_runner.as_ref(), ); report.diagnostics = shift(report.diagnostics, trusted_prefix); report } +fn package_failure(message: String) -> CompilationReport { + CompilationReport::failed( + vec![ProgramDiagnostic { + source: DiagnosticOrigin::Library, + diagnostic: diagnostic("stdlib", psrs_span::TextRange::default(), message), + }], + Default::default(), + ) +} + /// Resolves user sources leniently together with the on-disk standard library. /// /// A lenient check tolerates imports whose modules are not provided at all, so a diff --git a/crates/psrs-driver/src/program/lowering.rs b/crates/psrs-driver/src/program/lowering.rs new file mode 100644 index 00000000..0e64a653 --- /dev/null +++ b/crates/psrs-driver/src/program/lowering.rs @@ -0,0 +1,127 @@ +use super::*; + +pub(super) fn lower_program_inner( + sources: &[(&str, &str)], + trusted_prefix: usize, + runner: Option<(&str, &str)>, +) -> Result< + ( + psrs_core::Module, + Vec, + Option, + ), + Vec, +> { + let resolved = resolve_program_sources(sources)?; + let selected_runner = runner + .map(|(owner, name)| { + let candidates = resolved + .iter() + .take(if trusted_prefix == 0 { + resolved.len() + } else { + trusted_prefix + }) + .filter(|module| module.name == owner) + .flat_map(|module| module.declarations.iter().filter(|decl| decl.name == name)) + .collect::>(); + match candidates.as_slice() { + [runner] => Ok(runner.symbol), + _ => Err(vec![ProgramDiagnostic { + source: DiagnosticOrigin::Program, + diagnostic: diagnostic( + "P7 command runner", + psrs_span::TextRange::new(0, 0), + "configured command runner must resolve to exactly one source declaration", + ), + }]), + } + }) + .transpose()?; + let entry = effects::require_unambiguous_entry(effects::select_entry(&resolved))?; + let trusted = if selected_runner.is_none() { + let trusted = effects::trusted_effect(&resolved, trusted_prefix)?; + effects::check_run_effect_scope(&resolved, entry, trusted.as_ref())?; + trusted + } else { + None + }; + let (typed, warnings) = typecheck_resolved_program_with_warnings(resolved)?; + let command_entry = if selected_runner.is_none() { + classify_command_entry(&typed, entry, trusted.as_ref())? + } else { + None + }; + let mut modules = Vec::with_capacity(typed.len()); + for (index, module) in typed.into_iter().enumerate() { + match psrs_core::lower_module_unverified(module) { + Ok(core) => modules.push(core), + Err(errors) => { + return Err(errors + .into_iter() + .map(|error| ProgramDiagnostic { + source: DiagnosticOrigin::Source(index), + diagnostic: diagnostic("P6 Core lowering", error.span, error.message), + }) + .collect()); + } + } + } + let mut linked = psrs_core::link(modules); + if let Some(entry) = entry { + let symbol = if let Some(runner) = selected_runner { + psrs_core::command::normalize_entry(&mut linked, entry.symbol, runner).map_err( + |errors| { + errors + .into_iter() + .map(|error| ProgramDiagnostic { + source: DiagnosticOrigin::Source(error.module.0 as usize), + diagnostic: diagnostic("P7 command runner", error.span, error.message), + }) + .collect::>() + }, + )? + } else { + entry.symbol + }; + linked.entry = Some(symbol); + psrs_core::prune_unreachable(&mut linked, symbol); + } + if let Err(errors) = linked.verify() { + return Err(errors + .into_iter() + .map(|error| ProgramDiagnostic { + source: DiagnosticOrigin::Source(error.module.0 as usize), + diagnostic: diagnostic("P7 Core verification", error.span, error.message), + }) + .collect()); + } + let context = trusted.map(|trusted| psrs_core::effect::EffectCompilation { + trusted, + command_entry, + }); + Ok((linked, warnings, context)) +} + +pub(crate) fn lower_program_to_core_and_effect_context( + sources: &[(&str, &str)], + trusted_prefix: usize, +) -> Result< + ( + psrs_core::Module, + Vec, + Option, + ), + Vec, +> { + lower_program_inner(sources, trusted_prefix, None) +} + +#[cfg(test)] +pub(crate) fn lower_program_to_core_with_runner( + sources: &[(&str, &str)], + owner: &str, + function: &str, +) -> Result> { + lower_program_inner(sources, 0, Some((owner, function))).map(|(core, _, _)| core) +} diff --git a/crates/psrs-driver/src/program/mod.rs b/crates/psrs-driver/src/program/mod.rs index 18b2233b..6b70a1a7 100644 --- a/crates/psrs-driver/src/program/mod.rs +++ b/crates/psrs-driver/src/program/mod.rs @@ -7,11 +7,6 @@ use super::{ }; pub use compilation::compile_program_sources; -pub(super) use compilation::{ - compile_program_sources_with_trusted_prefix, - compile_program_sources_with_trusted_prefix_diagnosis, - compile_program_sources_with_trusted_prefix_report, -}; pub use lenient::{ check_program_kinds_lenient, check_program_lenient, check_program_types_lenient, }; @@ -27,6 +22,9 @@ mod effects; mod graph; mod lenient; mod library; +mod lowering; +#[cfg(test)] +pub(crate) use lowering::lower_program_to_core_with_runner; mod reports; mod signatures; @@ -75,58 +73,7 @@ pub(crate) fn lower_program_to_core_with_trusted_prefix_and_warnings( .map(|(core, warnings, _context)| (core, warnings)) } -pub(super) fn lower_program_to_core_and_effect_context( - sources: &[(&str, &str)], - trusted_prefix: usize, -) -> Result< - ( - psrs_core::Module, - Vec, - Option, - ), - Vec, -> { - let resolved = resolve_program_sources(sources)?; - let entry = effects::require_unambiguous_entry(effects::select_entry(&resolved))?; - let trusted = effects::trusted_effect(&resolved, trusted_prefix)?; - effects::check_run_effect_scope(&resolved, entry, trusted.as_ref())?; - let (typed, warnings) = typecheck_resolved_program_with_warnings(resolved)?; - let command_entry = classify_command_entry(&typed, entry, trusted.as_ref())?; - let mut modules = Vec::with_capacity(typed.len()); - for (index, module) in typed.into_iter().enumerate() { - match psrs_core::lower_module_unverified(module) { - Ok(core) => modules.push(core), - Err(errors) => { - return Err(errors - .into_iter() - .map(|error| ProgramDiagnostic { - source: DiagnosticOrigin::Source(index), - diagnostic: diagnostic("P6 Core lowering", error.span, error.message), - }) - .collect()); - } - } - } - let mut linked = psrs_core::link(modules); - if let Some(entry) = entry { - linked.entry = Some(entry.symbol); - psrs_core::prune_unreachable(&mut linked, entry.symbol); - } - if let Err(errors) = linked.verify() { - return Err(errors - .into_iter() - .map(|error| ProgramDiagnostic { - source: DiagnosticOrigin::Source(error.module.0 as usize), - diagnostic: diagnostic("P7 Core verification", error.span, error.message), - }) - .collect()); - } - let context = trusted.map(|trusted| psrs_core::effect::EffectCompilation { - trusted, - command_entry, - }); - Ok((linked, warnings, context)) -} +pub(super) use lowering::lower_program_to_core_and_effect_context; fn classify_command_entry( typed: &[psrs_thir::Module], diff --git a/crates/psrs-driver/src/tests/cc_ir_audit.rs b/crates/psrs-driver/src/tests/cc_ir_audit.rs index b9b416ee..707edc56 100644 --- a/crates/psrs-driver/src/tests/cc_ir_audit.rs +++ b/crates/psrs-driver/src/tests/cc_ir_audit.rs @@ -281,54 +281,47 @@ fn a_polymorphic_imported_instance_method_recovers_through_an_adapter() { }), "main must not cast an erased method field straight to a concrete closure" ); - let conversion = main + // A generic method is recovered as its own CC operation. CC exposes a + // dictionary's field conversions as explicit assignments, so the adapter + // that lifts the erased template calling convention is a top-level + // conversion rather than a field nested in a product-map plan. + let (adapted, function, signature) = main .assignments .iter() - .find_map(|assignment| match &assignment.kind { - AssignmentKind::AggregateConvert { conversion, .. } => { - let ValueConversion::ProductMap { fields, .. } = &conversion.plan else { - return None; - }; - let ValueConversion::FunctionAdapter { source, .. } = fields[0] else { - return None; - }; - let ValueShape::Reference(psrs_backend::cc::Reference { - heap: RefShape::Closure(id), + .find_map(|assignment| { + let AssignmentKind::AggregateConvert { + destination, + conversion, + .. + } = &assignment.kind + else { + return None; + }; + let ValueConversion::FunctionAdapter { + function, source, .. + } = &conversion.plan + else { + return None; + }; + let ValueShape::Reference(psrs_backend::cc::Reference { + heap: RefShape::Closure(signature), + .. + }) = source + else { + return None; + }; + matches!( + cc.representations.signatures[signature.0 as usize] + .parameters + .first(), + Some(ValueShape::Reference(psrs_backend::cc::Reference { + heap: RefShape::Erased, .. - }) = source - else { - return None; - }; - matches!( - cc.representations.signatures[id.0 as usize] - .parameters - .first(), - Some(ValueShape::Reference(psrs_backend::cc::Reference { - heap: RefShape::Erased, - .. - })) - ) - .then_some(conversion) - } - _ => None, + })) + ) + .then_some((*destination, *function, *signature)) }) - .expect("dictionary instantiation uses the recursive conversion plan"); - let psrs_backend::cc::ValueConversion::ProductMap { fields, .. } = &conversion.plan else { - panic!("dictionary conversion must reconstruct the product"); - }; - let psrs_backend::cc::ValueConversion::FunctionAdapter { - function, source, .. - } = fields[0] - else { - panic!("the method field must adapt its call signature"); - }; - let ValueShape::Reference(psrs_backend::cc::Reference { - heap: RefShape::Closure(signature), - .. - }) = source - else { - panic!("a generic method retains its template closure signature"); - }; + .expect("the dictionary method recovers through an adapter over its erased template"); assert!( matches!( cc.representations.signatures[signature.0 as usize].parameters[0], @@ -337,9 +330,15 @@ fn a_polymorphic_imported_instance_method_recovers_through_an_adapter() { .. }) ), - "template signature: {:?}; fields: {:?}", - cc.representations.signatures[signature.0 as usize], - fields + "template signature: {:?}", + cc.representations.signatures[signature.0 as usize] + ); + assert!( + main.assignments.iter().any(|assignment| matches!( + &assignment.kind, + AssignmentKind::ProductNew { arguments, .. } if arguments.contains(&adapted) + )), + "the adapted method field is rebuilt into a dictionary product" ); let factory = cc .functions diff --git a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs index e409e8c6..462238b2 100644 --- a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs +++ b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs @@ -99,9 +99,10 @@ fn linked_modules_share_canonical_layouts() { canonical_arrays, 1, "linked modules must share one canonical Array(Erased) layout" ); - assert!( - array_new_default_count(&stages.mir) >= 1, - "the linked producer boundary must retain a reconstruction path" + assert_eq!( + array_new_default_count(&stages.mir), + 0, + "the linked producer boundary must preserve the original array storage" ); match execute_wasm("linked_modules", &stages.artifact.wasm) { Ok(Some(code)) => assert_eq!(code, 42, "linked round-trip should preserve its element"), @@ -413,9 +414,10 @@ fn empty_array_reconstruction_executes() { psrs_backend::TargetCapabilities::default(), ) .expect("an empty concrete array must still lower through the conversion path"); - assert!( - array_new_default_count(&stages.mir) >= 1, - "the empty array should still allocate its canonical destination" + assert_eq!( + array_new_default_count(&stages.mir), + 0, + "the empty array must not be reconstructed at a polymorphic boundary" ); assert!( stages @@ -426,9 +428,9 @@ fn empty_array_reconstruction_executes() { .flat_map(|block| &block.instructions) .any(|instruction| matches!( instruction, - psrs_backend::mir::Instruction::ArraySet { .. } + psrs_backend::mir::Instruction::ArrayNew { elements, .. } if elements.is_empty() )), - "the conversion loop should retain its element store even for an empty source" + "the empty source literal retains its single storage allocation" ); match execute_wasm("empty_array_reconstruction", &stages.artifact.wasm) { Ok(Some(code)) => assert_eq!(code, 0, "empty array round-trip should have length zero"), diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index e9a6eb87..545d50d8 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -36,6 +36,7 @@ mod primitive_foreign; mod scalars; mod semigroup; mod show; +mod state; fn lower_source_to_mir(source: &str) -> psrs_backend::mir::Module { let backend_input = crate::lower_main_to_cc(source).expect("Core should lower to CC"); diff --git a/crates/psrs-driver/src/tests/parameterized_shapes.rs b/crates/psrs-driver/src/tests/parameterized_shapes.rs index e0e24fcd..abd77450 100644 --- a/crates/psrs-driver/src/tests/parameterized_shapes.rs +++ b/crates/psrs-driver/src/tests/parameterized_shapes.rs @@ -1,7 +1,7 @@ use super::*; #[test] -fn maps_generic_arrays_across_polymorphic_adt_boundaries() { +fn preserves_generic_arrays_across_polymorphic_adt_boundaries() { let source = "\ module Main where data Wrap a = Wrap (Array a) @@ -24,8 +24,8 @@ main = arrayIndex (unwrap (wrap [40, 42])) 1 .map(|conversion| array_map_count(&conversion.plan)) .sum::(); assert!( - generic_array_maps >= 2, - "expected pre-P7 concrete/generic boundary maps; found {generic_array_maps}" + generic_array_maps == 0, + "expected no array copying at pre-P7 concrete/generic boundaries; found {generic_array_maps}" ); let stages = psrs_backend::compile_with_context( prepared.core, @@ -82,12 +82,12 @@ main = arrayIndex (unwrap (wrap [40, 42])) 1 }) .count(); assert!( - array_maps >= 2, - "expected specialization and canonicalization maps; found {array_maps}" + array_maps == 0, + "expected no array reconstruction; found {array_maps}" ); - assert!(stages.artifact.wat.contains("array.new_default")); + assert!(!stages.artifact.wat.contains("array.new_default")); assert!(stages.artifact.wat.contains("array.get")); - assert!(stages.artifact.wat.contains("array.set")); + assert!(stages.artifact.wat.contains("array.new_fixed")); let Some(output) = run_wasmtime(source) else { eprintln!("skipping execution: wasmtime is not installed"); return; @@ -118,9 +118,13 @@ main = arrayIndex ((copy { items: [40, 42], value: 7 }).items) 1 assert!( generic_conversions .iter() - .any(|conversion| { contains_canonical_record_array_map(&conversion.plan) }), - "expected a pre-P7 canonical closed-record map containing a nested array map" + .all(|conversion| array_map_count(&conversion.plan) == 0), + "record conversion must retain its nested array storage" ); + assert!(generic_cc.functions.iter().flat_map(|function| &function.assignments).any(|assignment| + matches!(assignment.kind, psrs_backend::cc::AssignmentKind::ProductNew { representation, .. } + if generic_cc.representations.product_labels(representation) == Some(&["items".to_owned(), "value".to_owned()]))), + "record conversion retains explicit product construction"); let stages = psrs_backend::compile_with_context( prepared.core, prepared.effect_context, @@ -143,7 +147,7 @@ main = arrayIndex ((copy { items: [40, 42], value: 7 }).items) 1 } #[test] -fn maps_nested_generic_arrays_recursively_across_instantiations() { +fn preserves_nested_generic_arrays_across_instantiations() { let source = "\ module Main where duplicate :: forall a. Array (Array a) -> Array (Array a) @@ -164,8 +168,8 @@ main = arrayIndex (arrayIndex (duplicate [[40, 42]]) 0) 1 .max() .unwrap_or_default(); assert!( - maximum_nested_array_maps >= 2, - "expected pre-P7 recursively nested ArrayMap plans; found depth {maximum_nested_array_maps}" + maximum_nested_array_maps == 0, + "expected no recursive array reconstruction; found depth {maximum_nested_array_maps}" ); let stages = psrs_backend::compile_with_context( prepared.core, @@ -207,8 +211,8 @@ main = arrayIndex (applyArray concrete [40, 42]) 1 .map(|conversion| array_map_count(&conversion.plan)) .sum::(); assert!( - array_maps >= 2, - "expected pre-P7 higher-order argument and result ArrayMap plans; found {array_maps}" + array_maps == 0, + "expected no pre-P7 higher-order array reconstruction; found {array_maps}" ); let stages = psrs_backend::compile_with_context( prepared.core, @@ -295,20 +299,6 @@ fn array_map_depth(conversion: &psrs_backend::cc::ValueConversion) -> usize { } } -fn contains_canonical_record_array_map(conversion: &psrs_backend::cc::ValueConversion) -> bool { - use psrs_backend::cc::ValueConversion; - - match conversion { - ValueConversion::ProductMap { labels, fields, .. } => { - labels == &["items".to_owned(), "value".to_owned()] - && fields.iter().any(|field| array_map_count(field) > 0) - } - ValueConversion::ArrayMap { element, .. } => contains_canonical_record_array_map(element), - ValueConversion::Sequence(steps) => steps.iter().any(contains_canonical_record_array_map), - _ => false, - } -} - fn run_wasmtime(source: &str) -> Option { let required = std::env::var("PSRS_REQUIRE_WASMTIME").as_deref() == Ok("1"); if std::process::Command::new("wasmtime") diff --git a/crates/psrs-driver/src/tests/state/cc.rs b/crates/psrs-driver/src/tests/state/cc.rs new file mode 100644 index 00000000..7fee3a22 --- /dev/null +++ b/crates/psrs-driver/src/tests/state/cc.rs @@ -0,0 +1,200 @@ +use super::*; + +#[test] +fn source_state_choices_preserve_callback_blocks_through_wasm_encoding() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +choose :: Boolean -> (State RealWorld -> Step RealWorld Int) -> (State RealWorld -> Step RealWorld Int) -> State RealWorld -> Step RealWorld Int +choose flag left right state = if flag then left state else right state +ignore :: (State RealWorld -> Step RealWorld Int) -> Int +ignore action = 42 +main :: Int +main = ignore (choose true (\state -> { state: state, value: 40 }) (\state -> { state: state, value: 41 })) +"#; + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let target = psrs_backend::TargetCapabilities::default(); + let (mir, mut wasi) = + psrs_backend::mir::lower_module_with_bindings(input.cc, input.externals, target).unwrap(); + let branch = mir + .functions + .iter() + .find(|function| { + function.state.as_ref().is_some_and(|flow| { + flow.graph().blocks.len() == 4 + && flow + .graph() + .blocks + .iter() + .map(|block| block.transitions.len()) + .sum::() + == 2 + }) + }) + .unwrap(); + let owner = branch.symbol; + assert_eq!(branch.blocks.len(), 4); + let mir = psrs_backend::mir::opt::optimize(mir, target).unwrap(); + assert_eq!( + mir.functions + .iter() + .find(|function| function.symbol == owner) + .unwrap() + .blocks + .len(), + 4 + ); + let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); + psrs_backend::wasm::encode_module(&wasm).unwrap(); +} + +#[test] +fn source_state_callbacks_publish_mir_dependencies_without_step_storage() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +apply :: (State RealWorld -> Step RealWorld Int) -> State RealWorld -> Step RealWorld Int +apply action state = action state +ignore :: (State RealWorld -> Step RealWorld Int) -> Int +ignore action = 42 +main :: Int +main = ignore (apply (\state -> { state: state, value: 40 })) +"#; + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let (mir, mut wasi) = psrs_backend::mir::lower_module_with_bindings( + input.cc, + input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .unwrap(); + let projected = mir + .functions + .iter() + .filter(|function| function.state.is_some()) + .collect::>(); + assert!(!projected.is_empty()); + assert!(projected.iter().any(|function| { + function.state.as_ref().unwrap().graph().blocks[0] + .transitions + .len() + == 1 + })); + for function in projected { + assert_eq!(function.result_type, psrs_backend::types::ValueType::I32); + assert!( + !function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .any(|instruction| matches!( + instruction, + psrs_backend::mir::Instruction::StructNew { .. } + )) + ); + } + psrs_backend::mir::verify_module(&mir).unwrap(); + let mir = + psrs_backend::mir::opt::optimize(mir, psrs_backend::TargetCapabilities::default()).unwrap(); + assert!( + mir.functions + .iter() + .any(|function| function.state.is_some()) + ); + let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); + psrs_backend::wasm::encode_module(&wasm).unwrap(); +} + +#[test] +fn pure_state_array_construction_preserves_incoming_dependency_aliases() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +produce :: State RealWorld -> Step RealWorld (Array Int) +produce state = { state: state, value: [40] } +action :: State RealWorld -> Step RealWorld Int +action state = case produce state of + { state: next, value: values } -> { state: state, value: arrayIndex values 0 } +ignore :: (State RealWorld -> Step RealWorld Int) -> Int +ignore callback = 42 +main :: Int +main = ignore action +"#; + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + let action = flows + .iter() + .find(|flow| { + flow.function.assignments.iter().any(|assignment| { + matches!( + assignment.kind, + psrs_backend::cc::AssignmentKind::ArrayGet { .. } + ) + }) + }) + .expect("the source action retains its array payload read"); + assert!(action.operations.is_empty()); + let (mir, _) = psrs_backend::mir::lower_module_with_bindings( + input.cc, + input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .unwrap(); + assert!(mir.functions.iter().any(|function| { + function.state.is_some() + && function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .any(|instruction| { + matches!(instruction, psrs_backend::mir::Instruction::ArrayGet { .. }) + }) + })); +} + +#[test] +fn ordinary_newtype_pure_and_bind_produce_checked_cc_state_bodies() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +newtype Task a = Task (State RealWorld -> Step RealWorld a) +pureTask :: forall a. a -> Task a +pureTask value = Task (\state -> { state: state, value: value }) +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task first) next = Task (\state0 -> + case first state0 of + { state: state1, value: value } -> + case next value of + Task second -> second state1) +ignore :: Task Int -> Int +ignore action = 42 +main :: Int +main = ignore (bindTask (pureTask 40) (\value -> pureTask (intAdd value 2))) +"#; + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + assert!(flows.iter().any(|flow| flow.operations.is_empty())); + assert!(flows.iter().any(|flow| flow.operations.len() == 2)); + for flow in &flows { + flow.verify(&input.cc).unwrap(); + } + let (mir, mut wasi) = psrs_backend::mir::lower_module_with_bindings( + input.cc, + input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .unwrap(); + assert!(mir.functions.iter().any(|function| { + function + .state + .as_ref() + .is_some_and(|state| state.graph().blocks[0].transitions.len() == 2) + })); + let mir = + psrs_backend::mir::opt::optimize(mir, psrs_backend::TargetCapabilities::default()).unwrap(); + let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); + psrs_backend::wasm::encode_module(&wasm).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/state/command.rs b/crates/psrs-driver/src/tests/state/command.rs new file mode 100644 index 00000000..5310e4bf --- /dev/null +++ b/crates/psrs-driver/src/tests/state/command.rs @@ -0,0 +1,129 @@ +use super::*; + +fn lower( + main: &str, + library: &str, + runner: &str, +) -> Result> { + crate::program::lower_program_to_core_with_runner( + &[("Main.purs", main), ("Runner.purs", library)], + "Runner", + runner, + ) +} + +const LIBRARY: &str = "module Runner where\nnewtype Command = Command Int\nrun :: Command -> Int\nrun (Command value) = value\n"; +const MAIN: &str = + "module Main where\nimport Runner (Command(..))\nmain :: Command\nmain = Command 42\n"; + +#[test] +fn configured_runner_wraps_an_unrelated_library_type_before_pruning() { + let core = lower(MAIN, LIBRARY, "run").unwrap(); + let entry = core + .declarations + .iter() + .find(|decl| Some(decl.symbol) == core.entry) + .unwrap(); + assert_eq!(entry.name, "$command_entry"); + let psrs_core::ExprKind::Application(function, argument) = &entry.value.kind else { + panic!("ordinary runner application expected") + }; + assert!( + matches!(function.kind, psrs_core::ExprKind::Global(symbol) if core.declarations.iter().any(|decl| decl.symbol == symbol && decl.name == "run")) + ); + assert!( + matches!(argument.kind, psrs_core::ExprKind::Global(symbol) if core.declarations.iter().any(|decl| decl.symbol == symbol && decl.name == "main")) + ); + core.verify().unwrap(); + psrs_backend::compile(core).unwrap(); +} + +#[test] +fn configured_runner_preserves_int_entries_and_rejects_invalid_selection_or_types() { + let core = lower("module Main where\nmain :: Int\nmain = 7\n", LIBRARY, "run").unwrap(); + assert_eq!( + core.declarations + .iter() + .find(|decl| Some(decl.symbol) == core.entry) + .unwrap() + .name, + "main" + ); + for (library, runner, message) in [ + (LIBRARY, "missing", "exactly one source declaration"), + ( + "module Runner where\nnewtype Command = Command Int\nrun :: forall a. a -> Int\nrun _ = 42\n", + "run", + "must be monomorphic", + ), + ( + "module Runner where\nnewtype Command = Command Int\nrun :: Command -> Boolean\nrun _ = true\n", + "run", + "must return Int", + ), + ( + "module Runner where\nnewtype Command = Command Int\nnewtype Other = Other Int\nrun :: Other -> Int\nrun (Other value) = value\n", + "run", + "disagrees with the configured runner input", + ), + ] { + let errors = lower(MAIN, library, runner).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.message.contains(message)), + "{errors:?}" + ); + } +} + +#[test] +fn command_normalization_failure_preserves_the_checked_core() { + let mut core = lower(MAIN, LIBRARY, "run").unwrap(); + let before = core.clone(); + let entry = core + .declarations + .iter() + .find(|decl| decl.name == "main") + .unwrap() + .symbol; + let unknown = psrs_hir::SymbolId::new(entry.module, u32::MAX); + assert!(psrs_core::command::normalize_entry(&mut core, entry, unknown).is_err()); + assert_eq!(core, before); +} + +#[test] +fn configured_runner_executes_a_state_newtype_without_an_explicit_main_runner_call() { + let library = r#"module Runner where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +newtype Job a = Job (State RealWorld -> Step RealWorld a) +run :: Job Int -> Int +run (Job action) = execute action +"#; + let main = r#"module Main where +import Runner (Job(..)) +main :: Job Int +main = Job (\state -> { state: state, value: 42 }) +"#; + let core = lower(main, library, "run").unwrap(); + if wasmtime_available().is_none() { + return; + } + let artifact = psrs_backend::compile(core).unwrap(); + let path = std::env::temp_dir().join(format!("psrs-command-state-{}.wasm", std::process::id())); + std::fs::write(&path, artifact.wasm).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(&path).unwrap(); + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} diff --git a/crates/psrs-driver/src/tests/state/host.rs b/crates/psrs-driver/src/tests/state/host.rs new file mode 100644 index 00000000..d0f4905b --- /dev/null +++ b/crates/psrs-driver/src/tests/state/host.rs @@ -0,0 +1,156 @@ +//! Source newtypes and canonical host adapters retain one dependency chain. +use super::*; + +fn source(declarations: &str, action: &str) -> String { + format!( + r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = {{ state :: State s, value :: a }} +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +newtype Task a = Task (State RealWorld -> Step RealWorld a) +{declarations} +action :: Task Int +action = Task (\state0 -> {action}) +main :: Int +main = case action of + Task run -> execute run +"# + ) +} + +#[test] +fn source_newtype_host_resources_and_canonical_scalars_execute() { + for (declarations, action) in [ + ( + r#"foreign import data Stream :: Type +foreign import "wasi:cli/stdout#get-stdout" stdout :: State RealWorld -> Step RealWorld Stream +foreign import "wasi:io/streams#[resource-drop]output-stream" release :: Stream -> State RealWorld -> Step RealWorld Unit"#, + r#"case stdout state0 of + { state: state1, value: stream } -> case release stream state1 of + { state: state2, value: _ } -> { state: state2, value: 42 }"#, + ), + ( + r#"foreign import data Pollable :: Type +foreign import "wasi:clocks/monotonic-clock#subscribe-duration" subscribe :: Int -> State RealWorld -> Step RealWorld Pollable +foreign import "wasi:io/poll#[resource-drop]pollable" release :: Pollable -> State RealWorld -> Step RealWorld Unit"#, + r#"case subscribe 0 state0 of + { state: state1, value: pollable } -> case release pollable state1 of + { state: state2, value: _ } -> { state: state2, value: 42 }"#, + ), + ( + r#"foreign import "wasi:clocks/wall-clock#now" now :: State RealWorld -> Step RealWorld { seconds :: Int, nanoseconds :: Int } +foreign import "psrs:intrinsic#intLt" lt :: Int -> Int -> Boolean"#, + r#"case now state0 of + { state: state1, value: time } -> + { state: state1, value: if lt time.nanoseconds 1000000000 then 42 else 1 }"#, + ), + ] { + let source = source(declarations, action); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + } +} + +#[test] +fn source_newtype_host_list_adapter_executes_its_loop_and_cleanup() { + let source = source( + r#"foreign import "wasi:cli/environment#get-arguments" arguments :: State RealWorld -> Step RealWorld (Array String) +foreign import "psrs:intrinsic#arrayLength" length :: forall a. Array a -> Int"#, + r#"case arguments state0 of + { state: state1, value: items } -> { state: state1, value: length items }"#, + ); + let Some(output) = run_with_wasmtime_args(&source, &["alpha", "beta"]) else { + return; + }; + assert_eq!(output.status.code(), Some(3), "{output:?}"); +} + +#[test] +fn source_newtype_host_variant_adapter_executes_checked_internal_edges() { + let source = source( + r#"foreign import data Stream :: Type +foreign import data Error :: Type +data StreamError = LastOperationFailed Error | Closed +foreign import "wasi:cli/stdout#get-stdout" stdout :: State RealWorld -> Step RealWorld Stream +foreign import "wasi:io/streams#[method]output-stream.flush" flush :: Stream -> State RealWorld -> Step RealWorld (Either StreamError Unit) +foreign import "wasi:io/streams#[resource-drop]output-stream" release :: Stream -> State RealWorld -> Step RealWorld Unit +foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a"#, + r#"case stdout state0 of + { state: state1, value: stream } -> case flush stream state1 of + { state: state2, value: _ } -> case release stream state2 of + { state: state3, value: _ } -> read [42] 0 state3"#, + ).replace("import Prim.State", "import Data.Either (Either)\nimport Prim.State"); + let sources = [ + ( + "Either.purs", + "module Data.Either (Either(..)) where\ndata Either a b = Left a | Right b\n", + ), + ("Main.purs", source.as_str()), + ]; + let Some(output) = run_program_with_wasmtime(&sources) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + let core = lower_program_to_core(&sources).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let (module, _) = psrs_backend::mir::lower_module_with_bindings( + input.cc, + input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .unwrap(); + psrs_backend::mir::verify_module(&module).unwrap(); + let mut changed = module.clone(); + let block = changed + .functions + .iter_mut() + .flat_map(|function| &mut function.blocks) + .find(|block| { + matches!( + block.terminator, + Some(psrs_backend::mir::Terminator::Switch { .. }) + ) + }) + .expect("canonical variant result must select its checked case"); + let psrs_backend::mir::Terminator::Switch { default, cases, .. } = + block.terminator.as_mut().unwrap() + else { + panic!() + }; + *default = cases[0].1; + let errors = psrs_backend::mir::verify_module(&changed).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 canonical call verification"), + "changing the internal edge must fail canonical correspondence: {errors:?}" + ); +} + +#[test] +fn bare_foreign_function_values_use_checked_source_schemes() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import data Stream :: Type +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "wasi:cli/stdout#get-stdout" get :: State RealWorld -> Step RealWorld Stream +foreign import "wasi:io/streams#[resource-drop]output-stream" release :: Stream -> State RealWorld -> Step RealWorld Unit +newtype Native a = Native (State RealWorld -> Step RealWorld a) +fromState :: forall a. (State RealWorld -> Step RealWorld a) -> Native a +fromState body = Native body +stdout :: Native Stream +stdout = fromState get +main :: Int +main = case stdout of + Native call -> execute (\state0 -> case call state0 of + { state: state1, value: stream } -> case release stream state1 of + { state: state2, value: _ } -> { state: state2, value: 42 }) +"#; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/state/mod.rs b/crates/psrs-driver/src/tests/state/mod.rs new file mode 100644 index 00000000..97005d87 --- /dev/null +++ b/crates/psrs-driver/src/tests/state/mod.rs @@ -0,0 +1,480 @@ +//! State contracts compose with ordinary source newtypes and nominal regions. +use super::*; + +mod cc; +mod command; +mod host; +mod runners; +mod runtime_cc; +mod storage_protocol; + +fn state_flow_source(body: &str) -> String { + format!( + r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = {{ state :: State s, value :: a }} +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a +action :: State RealWorld -> Step RealWorld Int +action state0 = {body} +main :: Int +main = execute action +"# + ) +} + +#[test] +fn source_state_calls_produce_core_dependencies_before_projection() { + let source = state_flow_source( + r#"case read [40] 0 state0 of + { state: state1, value: first } -> case read [first] 0 state1 of + { state: state2, value: second } -> { state: state2, value: second }"#, + ); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let flows = psrs_core::state::flow::check(&core).unwrap(); + let action = flows + .iter() + .find(|flow| flow.operations.len() == 2) + .expect("two actual runtime-bound source invocations"); + action.verify(&core).unwrap(); + assert_eq!(action.operations[1].input, action.operations[0].output); +} + +#[test] +fn source_state_flow_rejects_stale_returns_and_replayed_predecessors() { + for (body, message) in [ + ( + r#"case read [40] 0 state0 of + { state: state1, value: first } -> { state: state0, value: first }"#, + "state return discards an executed operation", + ), + ( + r#"case read [40] 0 state0 of + { state: state1, value: first } -> read [first] 0 state0"#, + "state call consumes a stale dependency", + ), + ] { + let source = state_flow_source(body); + check_program(&[("Main.purs", &source)]).unwrap(); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P7 Core verification" + && error.diagnostic.message == message), + "{errors:?}" + ); + } +} + +#[test] +fn source_state_branch_joins_preserve_the_selected_dependency() { + let source = state_flow_source( + r#"case (if true then read [40] 0 state0 else read [2] 0 state0) of + { state: state1, value: first } -> read [first] 0 state1"#, + ); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let flows = psrs_core::state::flow::check(&core).unwrap(); + let action = flows + .iter() + .find(|flow| flow.operations.len() == 3) + .unwrap(); + assert_eq!(action.graph.blocks.len(), 4); + action.verify(&core).unwrap(); +} + +#[test] +fn ordinary_library_newtype_bind_retains_checked_core_state_flow() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +newtype Task a = Task (State RealWorld -> Step RealWorld a) +pureTask :: forall a. a -> Task a +pureTask value = Task (\state -> { state: state, value: value }) +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task first) next = Task (\state0 -> + case first state0 of + { state: state1, value: value } -> + case next value of + Task second -> second state1) +main :: Int +main = case bindTask (pureTask 40) (\value -> pureTask (intAdd value 2)) of + Task action -> execute action +"#; + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let flows = psrs_core::state::flow::check(&core).unwrap(); + assert!(flows.iter().any(|flow| flow.operations.is_empty())); + assert!(flows.iter().any(|flow| flow.operations.len() == 2)); +} + +#[test] +fn state_newtype_combinators_are_ordinary_library_definitions() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +newtype Task a = Task (State RealWorld -> Step RealWorld a) +type role Task representational +pureTask :: forall a. a -> Task a +pureTask value = Task (\state -> { state: state, value: value }) +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task first) next = Task (\state0 -> + case first state0 of + { state: state1, value: value } -> + case next value of + Task second -> second state1) +main :: Int +main = 0 +"#; + check_program(&[("Main.purs", source)]) + .unwrap_or_else(|errors| panic!("ordinary state combinators: {errors:?}")); +} + +#[test] +fn the_state_region_cannot_be_safely_coerced() { + let source = r#"module Main where +import Prim.State (State) +import Safe.Coerce (coerce) +newtype RegionA = RegionA Int +newtype RegionB = RegionB Int +mix :: State RegionA -> State RegionB +mix = coerce +main :: Int +main = 0 +"#; + let errors = check_program(&[("Main.purs", source)]).expect_err("nominal state regions"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("NoInstanceFound")), + "{errors:?}" + ); +} + +#[test] +fn unsafe_state_operations_require_an_explicit_binding() { + let unbound = "module Main where\nmain = runWorld (\\state -> { state: state, value: 42 })\n"; + let errors = check_program(&[("Main.purs", unbound)]).expect_err("no implicit unsafe runner"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P3 resolve"), + "{errors:?}" + ); + let bound = r#"module Main where +import Prim.State (State, RealWorld) +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> { state :: State RealWorld, value :: a }) -> a +main :: Int +main = execute (\state -> { state: state, value: 42 }) +"#; + check_program(&[("Main.purs", bound)]) + .unwrap_or_else(|errors| panic!("explicit state runner scheme: {errors:?}")); +} + +#[test] +fn state_binding_validation_rejects_invalid_unused_runner_schemes() { + for contract in [ + "forall s a. (State s -> { state :: State s, value :: a }) -> a", + "forall a. (State RealWorld -> { state :: State RealWorld, value :: a }) -> State RealWorld", + "forall a. (State RealWorld -> { state :: State RealWorld, value :: a, extra :: Int }) -> a", + ] { + let source = format!( + "module Main where\nimport Prim.State (State, RealWorld)\nforeign import \"psrs:intrinsic#runWorld\" execute :: {contract}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("invalid unused state binding"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 primitive linking" + && !error + .diagnostic + .message + .contains("no foreign-function implementation")), + "{errors:?}" + ); + } +} + +fn runtime_source(export: &str, scheme: &str) -> String { + format!( + "module Main where\nimport Prim.State (State, RealWorld)\ntype Step s a = {{ state :: State s, value :: a }}\nforeign import \"psrs:runtime-storage#{export}\" operation :: {scheme}\nmain :: Int\nmain = 0\n" + ) +} + +#[test] +fn storage_uses_ordinary_runtime_binding_identity() { + let source = runtime_source( + "array_read", + "forall s a. Array a -> Int -> State s -> Step s a", + ); + let modules = resolve_program_sources(&[("Main.purs", &source)]).unwrap(); + let external = modules[0] + .externals + .iter() + .find(|external| external.name == "operation") + .unwrap(); + assert_eq!( + external.kind, + psrs_hir::ExternalKind::Runtime { + module: "psrs:runtime-storage".into(), + function: "array_read".into(), + } + ); +} + +#[test] +fn checked_unused_runtime_storage_schemes_compile_without_imports() { + for (export, scheme) in [ + ( + "array_read", + "forall s a. Array a -> Int -> State s -> Step s a", + ), + ( + "array_fill", + "forall s a. Int -> a -> State s -> Step s (Array a)", + ), + ( + "array_write", + "forall s a. Array a -> Int -> a -> State s -> Step s Unit", + ), + ("trap", "forall s a. State s -> Step s a"), + ] { + let source = runtime_source(export, scheme); + check_program(&[("Main.purs", &source)]) + .unwrap_or_else(|errors| panic!("{export}: {errors:?}")); + compile_program_sources(&[("Main.purs", &source)]) + .unwrap_or_else(|errors| panic!("{export}: {errors:?}")); + } +} + +#[test] +fn runtime_binding_contracts_reject_invalid_unused_declarations() { + for (export, scheme) in [ + ( + "array_read", + "forall s a. Array a -> Boolean -> State s -> Step s a", + ), + ( + "array_read", + "forall s a. Array a -> Int -> State s -> Step s Int", + ), + ( + "array_read", + "forall s t a. Array a -> Int -> State s -> Step t a", + ), + ( + "array_read", + "forall s a. Array a -> Int -> State s -> { state :: State s, value :: a, extra :: Int }", + ), + ( + "array_fill", + "forall s a. Int -> a -> State s -> Step s Int", + ), + ( + "array_fill", + "forall s a. Int -> a -> State s -> Step s (Array Int)", + ), + ( + "array_write", + "forall s a b. Array a -> Int -> b -> State s -> Step s Unit", + ), + ( + "array_write", + "forall s a. Array a -> Int -> a -> State s -> Step s Int", + ), + ("trap", "Int -> Int"), + ] { + let source = runtime_source(export, scheme); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("invalid unused runtime binding"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 runtime linking"), + "{export}: {errors:?}" + ); + } +} + +#[test] +fn unknown_runtime_exports_and_retired_storage_intrinsics_are_rejected() { + let source = runtime_source("missing", "forall s a. State s -> Step s a"); + let errors = + compile_program_sources(&[("Main.purs", &source)]).expect_err("unknown runtime export"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 runtime linking" + && error.diagnostic.message.contains("no export")), + "{errors:?}" + ); + let source = runtime_source( + "array_read", + "forall s a. Array a -> Int -> State s -> Step s a", + ) + .replace( + "psrs:runtime-storage#array_read", + "psrs:intrinsic#stateArrayRead", + ); + let errors = check_program(&[("Main.purs", &source)]).expect_err("retired intrinsic"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P3 resolve"), + "{errors:?}" + ); +} + +#[test] +fn state_accepts_the_official_st_region_kind() { + let source = r#"module Main where +import Prim.State (State) +foreign import data Region :: Type +foreign import data Global :: Region +type Step s a = { state :: State s, value :: a } +foreign import "psrs:runtime-storage#array_read" readGlobal :: forall a. Array a -> Int -> State Global -> Step Global a +foreign import "psrs:intrinsic#runRegion" runLocal :: forall a. (forall (s :: Region). State s -> Step s a) -> a +newtype Action r a = Action (State r -> { state :: State r, value :: a }) +type role Action nominal representational +global :: Action Global Int +global = Action (\state -> { state: state, value: 42 }) +main :: Int +main = 0 +"#; + check_program(&[("Main.purs", source)]) + .unwrap_or_else(|errors| panic!("official ST region kind: {errors:?}")); + compile_program_sources(&[("Main.purs", source)]) + .unwrap_or_else(|errors| panic!("official ST region kind compilation: {errors:?}")); +} + +#[test] +fn callable_newtype_templates_survive_higher_kinded_storage() { + let source = r#"module Main where +newtype Reader r a = Reader (r -> a) +newtype Runner = Runner (forall f a. (f a -> Int) -> f a -> Int) +runner :: Runner +runner = Runner (\consume value -> consume value) +run :: Reader Int Int -> Int +run (Reader action) = action 2 +main :: Int +main = case runner of + Runner invoke -> invoke run (Reader (\value -> intAdd value 40)) +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn structured_callable_newtype_domains_and_results_survive_storage() { + let source = r#"module Main where +newtype Batch r a = Batch (Array r -> { tag :: Int, value :: a }) +newtype Runner = Runner (forall f a. (f a -> Int) -> f a -> Int) +runner :: Runner +runner = Runner (\consume value -> consume value) +run :: Batch Int Int -> Int +run (Batch action) = let result = action [2] in intAdd result.tag result.value +main :: Int +main = case runner of + Runner invoke -> invoke run (Batch (\values -> { tag: arrayIndex values 0, value: 40 })) +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn higher_kinded_adt_field_preserves_callable_newtype() { + let source = r#"module Main where +data Holder f a = Holder (f a) +newtype Reader r a = Reader (r -> a) +hold :: forall f a. f a -> Holder f a +hold value = Holder value +recover :: forall f a. Holder f a -> f a +recover (Holder value) = value +run :: Reader Int Int -> Int +run (Reader action) = action 2 +main :: Int +main = run (recover (hold (Reader (\value -> intAdd value 40)))) +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn higher_kinded_adt_field_preserves_structured_callable_newtype() { + let source = r#"module Main where +data Holder f a = Holder (f a) +newtype Batch r a = Batch (Array r -> { tag :: Int, value :: a }) +hold :: forall f a. f a -> Holder f a +hold value = Holder value +recover :: forall f a. Holder f a -> f a +recover (Holder value) = value +run :: Batch Int Int -> Int +run (Batch action) = let result = action [2] in intAdd result.tag result.value +main :: Int +main = run (recover (hold (Batch (\values -> { tag: arrayIndex values 0, value: 40 })))) +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn ordinary_state_callbacks_lower_to_checked_cc_instruction_dependencies() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +apply :: (State RealWorld -> Step RealWorld Int) -> State RealWorld -> Step RealWorld Int +apply action state = action state +ignore :: (State RealWorld -> Step RealWorld Int) -> Int +ignore action = 42 +main :: Int +main = ignore (apply (\state -> { state: state, value: 40 })) +"#; + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + let apply = flows + .iter() + .find(|flow| { + flow.operations.len() == 1 + && matches!( + flow.operations[0].assignment.kind, + psrs_backend::cc::AssignmentKind::IndirectCall { .. } + ) + }) + .expect("a source callback invocation survives as an actual CC indirect call"); + assert_eq!(apply.operations.len(), 1); + assert!(matches!( + apply.operations[0].assignment.kind, + psrs_backend::cc::AssignmentKind::IndirectCall { .. } + )); + apply.verify(&input.cc).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/state/runners.rs b/crates/psrs-driver/src/tests/state/runners.rs new file mode 100644 index 00000000..d220ca74 --- /dev/null +++ b/crates/psrs-driver/src/tests/state/runners.rs @@ -0,0 +1,392 @@ +use super::*; + +fn world(body: &str) -> String { + format!( + r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = {{ state :: State s, value :: a }} +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +main :: Int +main = {body} +"# + ) +} + +fn compile(source: &str) -> (psrs_backend::mir::Module, psrs_backend::abi::WasiRegistry) { + let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let target = psrs_backend::TargetCapabilities::default(); + let (mir, wasi) = + psrs_backend::mir::lower_module_with_bindings(input.cc, input.externals, target).unwrap(); + let mir = psrs_backend::mir::opt::optimize(mir, target).unwrap(); + (mir, wasi) +} + +#[test] +fn source_world_runner_projects_a_closed_invocation() { + let source = world("execute (\\state -> { state: state, value: 42 })"); + let (mir, mut wasi) = compile(&source); + assert!(mir.functions.iter().any(|function| { + function + .state + .as_ref() + .is_some_and(|flow| flow.executions().len() == 1) + })); + let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); + psrs_backend::wasm::encode_module(&wasm).unwrap(); +} + +fn execute(source: &str, expected: i32) { + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + }; + assert_eq!( + output.status.code(), + Some(expected), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn source_world_runner_executes_the_source_selected_entry() { + execute( + &world("execute (\\state -> { state: state, value: 42 })"), + 42, + ); +} + +#[test] +fn abstract_constructor_transport_preserves_state_and_converts_only_the_payload() { + execute( + r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +newtype Job a = Job (State RealWorld -> Step RealWorld a) +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +preserve :: forall f a. f a -> f a +preserve value = value +unwrap :: forall a. Job a -> State RealWorld -> Step RealWorld a +unwrap (Job action) = action +main :: Int +main = execute (unwrap (preserve (Job (\state -> { state: state, value: 42 })))) +"#, + 42, + ); +} + +#[test] +fn source_region_runner_executes_a_rank_n_body() { + let source = r#"module Main where +import Prim.State (State) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runRegion" scoped :: forall a. (forall s. State s -> Step s a) -> a +main :: Int +main = scoped (\state -> { state: state, value: 43 }) +"#; + execute(source, 43); +} + +#[test] +fn nested_source_runners_preserve_both_invocation_boundaries() { + let source = world( + "execute (\\outer -> { state: outer, value: execute (\\inner -> { state: inner, value: 44 }) })", + ); + let (mir, _) = compile(&source); + assert_eq!( + mir.functions + .iter() + .filter_map(|function| function.state.as_ref()) + .map(|flow| flow.executions().len()) + .sum::(), + 2 + ); + execute(&source, 44); +} + +#[test] +fn repeated_source_runners_retain_two_dynamic_calls() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:intrinsic#intAdd" add :: Int -> Int -> Int +action :: State RealWorld -> Step RealWorld Int +action state = { state: state, value: 41 } +main :: Int +main = add (execute action) (execute action) +"#; + let (mir, _) = compile(source); + let runners = mir + .functions + .iter() + .filter(|function| { + function + .state + .as_ref() + .is_some_and(|flow| !flow.executions().is_empty()) + }) + .map(|function| function.symbol) + .collect::>(); + let entry = mir + .functions + .iter() + .find(|function| Some(function.symbol) == mir.entry) + .unwrap(); + assert_eq!(runners.len(), 2); + let closures = entry + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| match instruction { + psrs_backend::mir::Instruction::ClosureNew { + destination, + function, + .. + } if runners.contains(function) => Some(*destination), + _ => None, + }) + .collect::>(); + assert_eq!( + entry + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter(|instruction| matches!(instruction, + psrs_backend::mir::Instruction::ClosureCall { function, .. } + if closures.contains(function))) + .count(), + 2 + ); + execute(source, 82); +} + +#[test] +fn runner_projection_rejects_removed_calls_and_changed_action_operands() { + let source = world("execute (\\state -> { state: state, value: 42 })"); + let (mir, _) = compile(&source); + let index = mir + .functions + .iter() + .position(|function| { + function + .state + .as_ref() + .is_some_and(|flow| !flow.executions().is_empty()) + }) + .unwrap(); + let mut missing = mir.clone(); + missing.functions[index].blocks[0] + .instructions + .retain(|instruction| { + !matches!( + instruction, + psrs_backend::mir::Instruction::ClosureCall { .. } + ) + }); + assert!( + psrs_backend::mir::verify_module(&missing) + .unwrap_err() + .iter() + .any(|error| error.message.contains("loses an invocation")) + ); + let mut changed = mir; + let function = &mut changed.functions[index]; + let replacement = function.result; + if let Some(psrs_backend::mir::Instruction::ClosureCall { function, .. }) = function.blocks[0] + .instructions + .iter_mut() + .find(|instruction| { + matches!( + instruction, + psrs_backend::mir::Instruction::ClosureCall { .. } + ) + }) + { + *function = replacement; + } + assert!( + psrs_backend::mir::verify_module(&changed) + .unwrap_err() + .iter() + .any(|error| error.message.contains("invocation producer")) + ); +} + +#[test] +fn ordinary_newtype_pure_and_bind_execute_through_the_library_runner() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +newtype Task a = Task (State RealWorld -> Step RealWorld a) +pureTask :: forall a. a -> Task a +pureTask value = Task (\state -> { state: state, value: value }) +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task first) next = Task (\state0 -> + case first state0 of + { state: state1, value: value } -> + case next value of + Task second -> second state1) +runTask :: forall a. Task a -> a +runTask (Task action) = execute action +main :: Int +main = runTask (bindTask (pureTask 40) (\value -> pureTask (intAdd value 6))) +"#; + execute(source, 46); +} + +#[test] +fn source_runner_propagates_a_trap_from_the_invoked_body() { + let source = world("execute (\\state -> { state: state, value: quotient 1 0 })").replace( + "main :: Int", + "foreign import \"psrs:intrinsic#intQuot\" quotient :: Int -> Int -> Int\nmain :: Int", + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert!(!output.status.success()); + let stderr = String::from_utf8_lossy(&output.stderr); + assert!(stderr.contains("integer divide by zero"), "{stderr}"); +} + +#[test] +fn a_callable_step_payload_keeps_its_source_operand_during_optimization() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +produce :: State RealWorld -> Step RealWorld (State RealWorld -> Step RealWorld Int) +produce state = { state: state, value: \next -> { state: next, value: 47 } } +main :: Int +main = execute (\initial -> case produce initial of + { state: next, value: callback } -> callback next) +"#; + execute(source, 47); +} + +#[test] +fn a_state_callable_crosses_a_bare_polymorphic_payload() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +data Holder a = Holder a +unwrap :: forall a. Holder a -> a +unwrap (Holder value) = value +action :: State RealWorld -> Step RealWorld Int +action state = { state: state, value: 42 } +main :: Int +main = execute (unwrap (Holder action)) +"#; + execute(source, 42); +} + +#[test] +fn a_state_callable_curries_ordinary_arguments_before_its_dependency() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:intrinsic#intAdd" add :: Int -> Int -> Int +data Holder a = Holder a +unwrap :: forall a. Holder a -> a +unwrap (Holder value) = value +action :: Int -> Int -> State RealWorld -> Step RealWorld Int +action left right state = { state: state, value: add left right } +main :: Int +main = execute ((unwrap (Holder action)) 20 23) +"#; + execute(source, 43); +} + +#[test] +fn state_callables_cross_polymorphic_array_payloads() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:intrinsic#arrayIndex" index :: forall a. Array a -> Int -> a +data Holder a = Holder a +unwrap :: forall a. Holder a -> a +unwrap (Holder value) = value +action :: State RealWorld -> Step RealWorld Int +action state = { state: state, value: 44 } +main :: Int +main = execute (index (unwrap (Holder [action])) 0) +"#; + execute(source, 44); +} + +#[test] +fn stored_state_callables_keep_fresh_region_checking() { + let source = r#"module Main where +import Prim.State (State) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runRegion" scoped :: forall a. (forall s. State s -> Step s a) -> a +data Holder a = Holder a +unwrap :: forall a. Holder a -> a +unwrap (Holder value) = value +action :: forall s. State s -> Step s Int +action state = { state: state, value: 45 } +main :: Int +main = scoped (\state -> (unwrap (Holder action)) state) +"#; + execute(source, 45); + let wrong = source + .replace( + "import Prim.State (State)", + "import Prim.State (State, RealWorld)", + ) + .replace( + "action :: forall s. State s -> Step s Int", + "action :: State RealWorld -> Step RealWorld Int", + ); + let errors = lower_program_to_core(&[("Main.purs", wrong.as_str())]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P5 typecheck"), + "{errors:?}" + ); +} + +#[test] +fn erased_state_callables_preserve_a_callable_step_payload() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:intrinsic#intAdd" add :: Int -> Int -> Int +data Holder a = Holder a +unwrap :: forall a. Holder a -> a +unwrap (Holder value) = value +action :: State RealWorld -> Step RealWorld (Int -> Int) +action state = { state: state, value: \value -> add value 1 } +main :: Int +main = (execute (unwrap (Holder action))) 45 +"#; + execute(source, 46); +} + +#[test] +fn polymorphic_array_transport_preserves_mutable_storage_aliases() { + let source = r#"module Main where +foreign import "psrs:intrinsic#arrayIndex" index :: forall a. Array a -> Int -> a +foreign import "psrs:intrinsic#arrayWrite" write :: forall a. Array a -> Int -> a -> Array a +data Holder a = Holder a +unwrap :: forall a. Holder a -> a +unwrap (Holder value) = value +main :: Int +main = let original = [10, 20] + alias = unwrap (Holder original) + written = write original 0 99 + ignored = write written 1 21 + in index alias 0 +"#; + execute(source, 99); +} diff --git a/crates/psrs-driver/src/tests/state/runtime_cc.rs b/crates/psrs-driver/src/tests/state/runtime_cc.rs new file mode 100644 index 00000000..f4d0d0bb --- /dev/null +++ b/crates/psrs-driver/src/tests/state/runtime_cc.rs @@ -0,0 +1,366 @@ +use super::*; + +#[test] +fn a_partially_applied_runtime_binding_preserves_its_source_scheme() { + let source = state_flow_source("let reader = read [42] 0 in reader state0"); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let binding = &input.externals.runtime[0]; + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + let operation = flows.iter().flat_map(|flow| &flow.operations).find(|operation| + matches!(operation.assignment.kind, psrs_backend::cc::AssignmentKind::DirectCall { function, .. } if function == binding.symbol)).unwrap(); + assert_ne!(operation.input, operation.output); + for flow in &flows { + flow.verify(&input.cc).unwrap(); + } +} + +#[test] +fn runtime_fill_write_read_preserve_the_cc_successor_chain() { + let source = state_flow_source( + r#"case fill 2 40 state0 of + { state: state1, value: items } -> case write items 0 42 state1 of + { state: state2, value: ignored } -> read items 0 state2"#, + ).replace("action ::", r#"foreign import "psrs:runtime-storage#array_fill" fill :: forall s a. Int -> a -> State s -> Step s (Array a) +foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit +action ::"#); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + assert_eq!(input.externals.runtime.len(), 3); + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + let flow = flows + .iter() + .find(|flow| flow.operations.len() == 3) + .unwrap(); + flow.verify(&input.cc).unwrap(); + for pair in flow.operations.windows(2) { + assert_eq!(pair[1].input, pair[0].output); + } + let targets = flow + .operations + .iter() + .map(|operation| match operation.assignment.kind { + psrs_backend::cc::AssignmentKind::DirectCall { function, .. } => input + .externals + .runtime + .iter() + .find(|binding| binding.symbol == function) + .unwrap() + .function + .as_str(), + _ => panic!("runtime operations must remain ordinary direct calls"), + }) + .collect::>(); + assert_eq!(targets, ["array_fill", "array_write", "array_read"]); +} + +#[test] +fn runtime_source_calls_publish_checked_cc_dependencies() { + let source = state_flow_source( + r#"case read [40] 0 state0 of + { state: state1, value: first } -> case read [first] 0 state1 of + { state: state2, value: second } -> { state: state2, value: second }"#, + ); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + assert_eq!(input.externals.runtime.len(), 1); + let binding = &input.externals.runtime[0]; + assert_eq!(binding.module, "psrs:runtime-storage"); + assert_eq!(binding.function, "array_read"); + assert!(binding.type_id.is_some()); + let external = input + .cc + .externals + .iter() + .find(|external| external.symbol == binding.symbol) + .unwrap(); + let signature = external.signature.as_ref().unwrap(); + let projection = + psrs_backend::cc::state::StateCallProjection::checked(signature, &input.cc.representations) + .unwrap() + .unwrap(); + assert_eq!(projection.state_parameter, 2); + assert_eq!( + projection.payload, + psrs_backend::cc::ValueShape::Reference(psrs_backend::cc::Reference { + nullable: false, + heap: psrs_backend::cc::RefShape::Erased, + }) + ); + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + let flow = flows + .iter() + .find(|flow| flow.operations.len() == 2) + .unwrap(); + flow.verify(&input.cc).unwrap(); + assert_eq!(flow.operations[1].input, flow.operations[0].output); + assert!(flow.operations.iter().all(|operation| matches!(operation.assignment.kind, + psrs_backend::cc::AssignmentKind::DirectCall { function, .. } if function == binding.symbol))); + let (module, _) = psrs_backend::mir::lower_module_with_bindings( + input.cc.clone(), + input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .unwrap(); + psrs_backend::mir::verify_module(&module).unwrap(); + assert_eq!(module.imports.len(), 1); + assert_eq!( + module.imports[0].runtime.as_ref().unwrap().function, + "array_read" + ); + assert!( + module + .functions + .iter() + .any(|function| function.state.is_some()) + ); +} + +#[test] +fn source_storage_projection_preserves_an_ignored_write_through_optimization() { + let source = storage_alias_source(); + let target = psrs_backend::TargetCapabilities { + wasi_cli: false, + ..psrs_backend::TargetCapabilities::default() + }; + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let (module, mut wasi) = + psrs_backend::mir::lower_module_with_bindings(input.cc, input.externals, target).unwrap(); + let module = psrs_backend::mir::opt::optimize(module, target).unwrap(); + assert_eq!( + module + .imports + .iter() + .filter(|import| import.runtime.is_some()) + .count(), + 3 + ); + let write = module + .imports + .iter() + .find(|import| { + import + .runtime + .as_ref() + .is_some_and(|provider| provider.function == "array_write") + }) + .unwrap(); + assert!(module.functions.iter().flat_map(|function| &function.blocks) + .flat_map(|block| &block.instructions).any(|instruction| + matches!(instruction, psrs_backend::mir::Instruction::CallVoid { function, .. } if *function == write.symbol))); + let wasm = + psrs_backend::wasm::lower_module_with_capabilities(&module, &mut wasi, target).unwrap(); + psrs_backend::wasm::encode_module(&wasm).unwrap(); +} + +fn storage_alias_source() -> String { + state_flow_source(r#"case fill 2 40 state0 of + { state: state1, value: items } -> let alias = items in + case write items 0 42 state1 of + { state: state2, value: ignored } -> read alias 0 state2"#) + .replace("action ::", r#"foreign import "psrs:runtime-storage#array_fill" fill :: forall s a. Int -> a -> State s -> Step s (Array a) +foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit +action ::"#) +} + +#[test] +fn source_storage_executes_through_the_default_cli_and_preserves_alias_writes() { + for expected in [42, 40] { + let source = storage_alias_source() + .replace( + "main ::", + r#"foreign import "psrs:intrinsic#intEq" eq :: Int -> Int -> Boolean +main ::"#, + ) + .replace( + "main = execute action", + &format!("main = if eq (execute action) {expected} then 0 else 1"), + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + }; + assert_eq!( + output.status.code(), + Some(i32::from(expected != 42)), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + } +} + +#[test] +fn ordinary_newtype_bind_executes_runtime_storage_without_an_effect_dispatcher() { + let source = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_fill" fill :: forall s a. Int -> a -> State s -> Step s (Array a) +foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit +foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a +newtype Task a = Task (State RealWorld -> Step RealWorld a) +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task first) next = Task (\state0 -> + case first state0 of + { state: state1, value: value } -> case next value of + Task second -> second state1) +fillTask :: forall a. Int -> a -> Task (Array a) +fillTask length value = Task (\state -> fill length value state) +writeTask :: forall a. Array a -> Int -> a -> Task Unit +writeTask items index value = Task (\state -> write items index value state) +readTask :: forall a. Array a -> Int -> Task a +readTask items index = Task (\state -> read items index state) +runTask :: forall a. Task a -> a +runTask (Task action) = execute action +action :: Task Int +action = bindTask (fillTask 2 40) (\items -> + let alias = items in bindTask (writeTask items 0 42) (\ignored -> readTask alias 0)) +main :: Int +main = runTask action +"#; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + }; + assert_eq!( + output.status.code(), + Some(42), + "{}", + String::from_utf8_lossy(&output.stderr) + ); +} + +#[test] +fn runtime_nonreturning_calls_trap_and_only_terminate_the_selected_branch() { + for (body, expected) in [ + ("abort state0", None), + ( + "case read [0] 0 state0 of { state: state1, value: first } -> if eq first 0 then abort state1 else { state: state1, value: 42 }", + None, + ), + ( + "case read [1] 0 state0 of { state: state1, value: first } -> if eq first 0 then abort state1 else { state: state1, value: 42 }", + Some(42), + ), + ( + "case abort state0 of { state: state1, value: ignored } -> read [42] 0 state1", + None, + ), + ( + "if true then abort state0 else { state: state0, value: 42 }", + None, + ), + ( + "if false then abort state0 else { state: state0, value: 42 }", + Some(42), + ), + ] { + let source = state_flow_source(body).replace( + "action ::", + r#"foreign import "psrs:runtime-storage#trap" abort :: forall s a. State s -> Step s a +foreign import "psrs:intrinsic#intEq" eq :: Int -> Int -> Boolean +action ::"#, + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + assert!( + std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), + "Wasmtime is required" + ); + return; + }; + if let Some(expected) = expected { + assert_eq!( + output.status.code(), + Some(expected), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + } else { + assert!(!output.status.success()); + assert!( + String::from_utf8_lossy(&output.stderr).contains("unreachable"), + "{}", + String::from_utf8_lossy(&output.stderr) + ); + } + } +} + +#[test] +fn gc_runtime_and_canonical_allocator_share_the_application_memory() { + for abort in [false, true] { + let body = format!( + "case arguments state0 of {{ state: state1, value: items }} -> if {abort} then abort state1 else read [42] 0 state1" + ); + let source = state_flow_source(&body).replace("action ::", r#"foreign import "wasi:cli/environment#get-arguments" arguments :: State RealWorld -> Step RealWorld (Array String) +foreign import "psrs:runtime-storage#trap" abort :: forall s a. State s -> Step s a +action ::"#); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + if abort { + assert!(!output.status.success()); + assert!( + String::from_utf8_lossy(&output.stderr) + .contains("wasm `unreachable` instruction executed"), + "{output:?}" + ); + } else { + assert_eq!(output.status.code(), Some(42), "{output:?}"); + } + } +} + +#[test] +fn source_constructor_choices_execute_only_the_selected_state_action() { + for (choice, expected) in [("First", 42), ("Second", 43), ("Last", 44)] { + let body = format!("choose {choice} state0"); + let source = state_flow_source(&body).replace( + "action ::", + r#"data Choice = First | Second | Last +choose :: Choice -> State RealWorld -> Step RealWorld Int +choose choice state0 = case choice of + First -> read [42] 0 state0 + Second -> read [43] 0 state0 + Last -> read [44] 0 state0 +action ::"#, + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(expected), "{choice}: {output:?}"); + } +} + +#[test] +fn constructor_choice_cannot_replay_the_predecessor_after_its_state_operation() { + let source = state_flow_source( + r#"case choose First state0 of + { state: state1, value: item } -> read [item] 0 state0"#, + ) + .replace( + "action ::", + r#"data Choice = First | Second | Last +choose :: Choice -> State RealWorld -> Step RealWorld Int +choose choice state0 = case choice of + First -> read [42] 0 state0 + Second -> read [43] 0 state0 + Last -> read [44] 0 state0 +action ::"#, + ); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P7 Core verification" + && error.diagnostic.message.contains("stale dependency")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/state/storage_protocol.rs b/crates/psrs-driver/src/tests/state/storage_protocol.rs new file mode 100644 index 00000000..37b92231 --- /dev/null +++ b/crates/psrs-driver/src/tests/state/storage_protocol.rs @@ -0,0 +1,129 @@ +use super::*; + +fn source(item: &str, initial: &str, replacement: &str, predicate: &str) -> String { + format!( + r#"module Main where +import Prim.State (State, RealWorld) +foreign import "psrs:intrinsic#intEq" eqInt :: Int -> Int -> Boolean +foreign import "psrs:intrinsic#numberEq" eqNumber :: Number -> Number -> Boolean +foreign import "psrs:intrinsic#booleanEq" eqBoolean :: Boolean -> Boolean -> Boolean +foreign import "psrs:intrinsic#stringToBytes" bytes :: String -> Array Int +foreign import "psrs:intrinsic#arrayLength" length :: forall a. Array a -> Int +foreign import "psrs:intrinsic#arrayIndex" index :: forall a. Array a -> Int -> a +foreign import "psrs:intrinsic#intAdd" addInt :: Int -> Int -> Int +type Item = {item} +type Step s a = {{ state :: State s, value :: a }} +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_fill" fill :: Int -> Item -> State RealWorld -> Step RealWorld (Array Item) +foreign import "psrs:runtime-storage#array_write" write :: Array Item -> Int -> Item -> State RealWorld -> Step RealWorld Unit +foreign import "psrs:runtime-storage#array_read" read :: Array Item -> Int -> State RealWorld -> Step RealWorld Item +action :: State RealWorld -> Step RealWorld Int +action state0 = case fill 1 ({initial}) state0 of + {{ state: state1, value: items }} -> + let alias = items in case write items 0 ({replacement}) state1 of + {{ state: state2, value: ignored }} -> case read alias 0 state2 of + {{ state: state3, value: item }} -> {{ state: state3, value: if {predicate} then 42 else 1 }} +main :: Int +main = execute action +"# + ) +} + +#[test] +fn monomorphic_storage_recovers_scalars_records_and_callbacks_without_copying_the_array() { + for (item, initial, replacement, predicate) in [ + ("Int", "40", "2147483647", "eqInt item 2147483647"), + ("Number", "40.5", "42.25", "eqNumber item 42.25"), + ("Boolean", "true", "false", "eqBoolean item false"), + ( + "String", + "\"before\"", + "\"after\"", + "if eqInt (length (bytes item)) 5 then eqInt (index (bytes item) 0) 97 else false", + ), + ( + "{ count :: Int }", + "{ count: 40 }", + "{ count: 42 }", + "eqInt item.count 42", + ), + ( + "(Int -> Int)", + "\\n -> n", + "\\n -> addInt n 1", + "eqInt (item 41) 42", + ), + ] { + let source = source(item, initial, replacement, predicate); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{item}: {output:?}"); + } +} + +#[test] +fn monomorphic_partial_read_keeps_its_checked_source_result() { + let source = source("Int", "40", "42", "eqInt item 42").replace( + "case read alias 0 state2 of", + "let later = read alias 0 in case later state2 of", + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn monomorphic_nested_storage_preserves_element_aliases_across_slots() { + let source = state_flow_source(r#"let shared = [40] in case fillNested 2 shared state0 of + { state: state1, value: outer } -> case readNested outer 0 state1 of + { state: state2, value: first } -> case writeInt first 0 42 state2 of + { state: state3, value: ignored } -> case readNested outer 1 state3 of + { state: state4, value: second } -> readInt second 0 state4"#).replace("action ::", r#"foreign import "psrs:runtime-storage#array_fill" fillNested :: Int -> Array Int -> State RealWorld -> Step RealWorld (Array (Array Int)) +foreign import "psrs:runtime-storage#array_read" readNested :: Array (Array Int) -> Int -> State RealWorld -> Step RealWorld (Array Int) +foreign import "psrs:runtime-storage#array_write" writeInt :: Array Int -> Int -> Int -> State RealWorld -> Step RealWorld Unit +foreign import "psrs:runtime-storage#array_read" readInt :: Array Int -> Int -> State RealWorld -> Step RealWorld Int +action ::"#); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn runtime_storage_protocol_is_selected_after_source_checking_and_before_mir_layout() { + use psrs_backend::cc::{self, AssignmentKind, ValueConversion}; + let source = source("Int", "40", "42", "eqInt item 42"); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let input = cc::lower_module(core).unwrap(); + let reader = input + .externals + .runtime + .iter() + .find(|binding| binding.function == "array_read") + .unwrap(); + let signature = input + .cc + .externals + .iter() + .find(|external| external.symbol == reader.symbol) + .unwrap() + .signature + .as_ref() + .unwrap(); + let projection = cc::state::StateCallProjection::checked(signature, &input.cc.representations) + .unwrap() + .unwrap(); + assert_eq!( + projection.payload, + cc::ValueShape::Reference(cc::Reference { + nullable: false, + heap: cc::RefShape::Erased + }) + ); + assert!(input.cc.functions.iter().flat_map(|function| &function.assignments).any(|assignment| + matches!(&assignment.kind, AssignmentKind::AggregateConvert { conversion, .. } + if matches!(conversion.plan, ValueConversion::UnboxScalar { destination: cc::ValueShape::Integer, .. })))); + cc::state::check(&input.cc).unwrap(); +} From 6b40b8d6f42df0218c64affad0e1c054869b870d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 04:41:07 +0800 Subject: [PATCH 088/148] Record public Effect.Ref reference adapter evidence --- .../backend/library-owned-effects.md | 48 +++++++++++++------ 1 file changed, 34 insertions(+), 14 deletions(-) diff --git a/docs/implementation/backend/library-owned-effects.md b/docs/implementation/backend/library-owned-effects.md index c64c26cb..729aef06 100644 --- a/docs/implementation/backend/library-owned-effects.md +++ b/docs/implementation/backend/library-owned-effects.md @@ -68,7 +68,7 @@ There is no stdlib compile-acceptance improvement at this checkpoint. | State-aware host and mutable storage execution | Partial | Checked runtime provider calls execute source storage alias-write fixtures. Canonical host adapter plans retain source anchors, physical calls, result adaptation and internal control evidence. Mandatory Wasmtime source-newtype cases execute resource get/drop, widened scalar parameters, record results, list results and variant results. Cyclic storage, general source CFG and complete host/library conformance remain incomplete. | | Core/CC/MIR dependency production and preservation | Partial | Immutable Core bodies supply checked flow; Core optimizers recheck each pass. CC verifies actual single-root instruction flow. P9 publishes straight-line, binary and multiway MIR correspondence against immutable CC; MIR optimization and final lowering recheck it. Total Core-to-CC correspondence, general CFG/scoped/loop projection and dependency-aware inlining remain required. | | Final encoding erasure | Partial for checked straight-line, binary and multiway source bodies | Source callbacks, Task pure/bind and checked canonical host adapter subgraphs encode after MIR verification. Public recursive loops compose through checked source calls; arbitrary CFG backedges and general scoped transport remain incomplete. Explicit source world/region runners execute through the normal pipeline. | -| Effect/ST library and command runner migration | Partial; development package wrappers migrated | Generic resolved-runner Core normalization, focused source execution and production manifest selection exist. The independent package has the unpushed State-newtype migration at `7852625` plus an uncommitted migration of 92 target WASI foreign wrappers. Public host/storage fixtures, ten pinned ST JS comparisons and ten public Effect-loop JS comparisons pass; complete API/host conformance and legacy deletion remain. The compiler library lock is unchanged. | +| Effect/ST library and command runner migration | Partial; development package wrappers migrated | Generic resolved-runner Core normalization, focused source execution and production manifest selection exist. The independent package has the unpushed State-newtype migration at `7852625` plus an uncommitted migration of 92 target WASI foreign wrappers and the `Effect.Ref` reference adapters. Public host/storage fixtures, ten pinned ST JS comparisons, ten public Effect-loop JS comparisons and ten public Effect.Ref JS comparisons pass; complete API/host conformance and legacy deletion remain. The compiler library lock is unchanged. | | Integrated source and runtime conformance | Partial | Library-owned pinned ST and public Effect-loop JS comparisons agree with mandatory Wasmtime. Full official composition/API/host acceptance remains required. | ## Continuation order @@ -1792,17 +1792,37 @@ pass 12/12 with zero skips; syntax and both working-tree diff checks pass. No official library implementation or inventory was changed in this slice. -A separate public MonadRec Effect baseline rejects at P8 library linking: -Effect.Ref._new, Effect.Ref.read and Effect.Ref.write have no target -implementation. The retained source is /private/tmp/psrs-effect-tailrecm.purs; -its failed runner report is /private/tmp/psrs-effect-tailrecm-before/run.json. -The official foreign contracts remain intact. Reference adapter migration is -the next library integration obligation; a tailRecM-specific intrinsic or fake -reference implementation would not satisfy it. - -The current requirement map above is refreshed to reflect verified multiway, -monomorphic payload and focused official-loop evidence. Full API/host conformance, +A separate public MonadRec Effect baseline at +/private/tmp/psrs-effect-tailrecm.purs now compiles and executes to 42. Its +previous report, /private/tmp/psrs-effect-tailrecm-before/run.json, recorded the +P8 library-linking rejection; the accepted report is +/private/tmp/psrs-effect-tailrecm-after/run.json. + +### Public reference adapters (2026-10-11) + +Official `Effect.Ref` now has library-owned target implementations. The opaque +`foreign import data Ref` becomes `newtype Ref a = Ref (PSRS.Ref.Cell a)`, and +`_new`, `newWithSelf`, `read`, `modifyImpl` and `write` are ordinary source over +the target-only `PSRS.Ref` module. `PSRS.Ref` stores one `Maybe a` per cell: +`newWithSelf` publishes `f self` over a `Nothing` slot, and a read before +publication traps through the checked `psrs:runtime-storage#trap` primitive +instead of fabricating an element. Public exports, signatures and the +representational role are preserved; no Effect.Ref-specific compiler intrinsic +or recursive placeholder was added. + +The independent package validates this with `conformance/effect-ref.mjs`, ten +public observations against the clean pinned `purescript-refs` JavaScript, and +the maintained fixtures `conformance/effects/Reference.purs` (exit 42) and +`conformance/effects/ReferenceUninitialized.purs` (terminal `unreachable` trap). +The source audit reports 169 identical, 37 modified and 27 platform additions +over 233 vendored modules; `Effect/Ref.purs` is modified and `PSRS/Ref.purs` is a +target addition. Package tool tests pass 12/12 and the oracle, storage and loop +cases remain accepted. + +This closes the public reference adapters. The requirement map above is +refreshed to reflect verified multiway, monomorphic payload, focused +official-loop and public reference-adapter evidence. Full API/host conformance, arbitrary CFG backedges, scoped transport, optimizer graph rewriting, legacy -deletion and coherent package pin acceptance remain open. No Rust source was -changed, no workspace or scoreboard was rerun, and the 259-path index and old -compiler library lock remain unchanged. +deletion and coherent package pin acceptance remain open. This +reference-adapter slice changed no Rust source; no workspace or official +scoreboard was rerun, and the compiler library lock remains at `1e01310`. From 3d345d30abb4dfdd8bd66c0fba70d41635ad434e Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 13:26:05 +0800 Subject: [PATCH 089/148] Checkpoint library-owned Effect and State migration work Capture the in-progress compiler work for the library-owned Effect representation and the State dependency mechanism before the agreed removal of compiler-owned Effect and State logic. This checkpoint preserves the working tree state, including Core/CC/MIR State analysis, runtime and linker scaffolding, driver tests, and the governing design documents, so the removal can proceed from a recorded baseline. --- crates/psrs-backend/src/capability.rs | 10 +- crates/psrs-backend/src/cc/state/branches.rs | 31 +- crates/psrs-backend/src/cc/state/captures.rs | 39 + crates/psrs-backend/src/cc/state/eval.rs | 97 ++- crates/psrs-backend/src/cc/state/mod.rs | 47 +- .../src/cc/state/projection/mod.rs | 60 +- crates/psrs-backend/src/cc/verify/helpers.rs | 2 +- crates/psrs-backend/src/cc/verify/mod.rs | 1 + .../psrs-backend/src/mir/lower/assignments.rs | 12 +- crates/psrs-backend/src/mir/lower/mod.rs | 20 +- crates/psrs-backend/src/mir/lower/tail.rs | 18 +- crates/psrs-backend/src/mir/lower/wit_call.rs | 1 + .../psrs-backend/src/mir/lower/wit_tests.rs | 1 + crates/psrs-backend/src/mir/mod.rs | 5 +- crates/psrs-backend/src/mir/opt/constants.rs | 9 +- crates/psrs-backend/src/mir/opt/mod.rs | 2 +- .../src/mir/state/branch_tests.rs | 14 +- crates/psrs-backend/src/mir/state/captures.rs | 91 +++ crates/psrs-backend/src/mir/state/control.rs | 23 +- .../psrs-backend/src/mir/state/inventory.rs | 24 +- crates/psrs-backend/src/mir/state/mod.rs | 69 +- .../src/mir/state/operand_tests.rs | 2 +- .../psrs-backend/src/mir/state/projection.rs | 53 +- crates/psrs-backend/src/mir/state/source.rs | 104 +++ .../src/mir/state/switch_tests.rs | 53 +- crates/psrs-backend/src/mir/state/tail.rs | 102 +++ crates/psrs-backend/src/mir/state/tests.rs | 20 +- .../src/opt/specialize/callable_fields.rs | 67 ++ crates/psrs-core/src/opt/specialize/mod.rs | 4 + crates/psrs-core/src/state/flow/branches.rs | 28 + .../psrs-core/src/state/flow/closure_tests.rs | 153 ++++ crates/psrs-core/src/state/flow/closures.rs | 165 ++++ crates/psrs-core/src/state/flow/eval.rs | 23 +- crates/psrs-core/src/state/flow/mod.rs | 31 + crates/psrs-core/src/state/flow/tests.rs | 16 +- crates/psrs-core/src/state/flow/verify.rs | 84 +-- crates/psrs-driver/src/tests/state/mod.rs | 2 + crates/psrs-driver/src/tests/state/runners.rs | 22 +- .../src/tests/state/scoped_callbacks.rs | 354 +++++++++ .../src/tests/state/zero_width_choices.rs | 82 ++ crates/psrs-driver/src/tests/tail_calls.rs | 180 ++++- docs/decision/DEC-05-wasmtime-feature-set.md | 5 +- docs/design/backend/README.md | 2 + docs/design/backend/fp/cc-ir.md | 9 +- .../backend/fp/control-flow-and-tail-calls.md | 28 +- docs/design/backend/fp/effects.md | 5 +- .../backend/fp/library-owned-effects.md | 164 +--- docs/design/backend/fp/mir.md | 9 +- .../backend/fp/representation-and-evidence.md | 9 +- ...tate-primitives-and-dependency-lowering.md | 704 ++++++++++++++++++ docs/design/backend/opt/core.md | 9 +- docs/design/backend/opt/mir.md | 18 +- .../design/backend/wasm/capability-profile.md | 13 +- .../backend/wasm/primitive-ffi-and-stdlib.md | 12 +- ...effect-state-removal-handoff-2026-10-11.md | 193 +++++ .../library-owned-effects-audit-2026-10-11.md | 202 +++++ .../backend/library-owned-effects.md | 486 +++++++++++- 57 files changed, 3540 insertions(+), 449 deletions(-) create mode 100644 crates/psrs-backend/src/cc/state/captures.rs create mode 100644 crates/psrs-backend/src/mir/state/captures.rs create mode 100644 crates/psrs-backend/src/mir/state/source.rs create mode 100644 crates/psrs-backend/src/mir/state/tail.rs create mode 100644 crates/psrs-core/src/opt/specialize/callable_fields.rs create mode 100644 crates/psrs-core/src/state/flow/closure_tests.rs create mode 100644 crates/psrs-core/src/state/flow/closures.rs create mode 100644 crates/psrs-driver/src/tests/state/scoped_callbacks.rs create mode 100644 crates/psrs-driver/src/tests/state/zero_width_choices.rs create mode 100644 docs/design/backend/fp/state-primitives-and-dependency-lowering.md create mode 100644 docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md create mode 100644 docs/implementation/backend/library-owned-effects-audit-2026-10-11.md diff --git a/crates/psrs-backend/src/capability.rs b/crates/psrs-backend/src/capability.rs index 129083e1..c9d1b28c 100644 --- a/crates/psrs-backend/src/capability.rs +++ b/crates/psrs-backend/src/capability.rs @@ -52,9 +52,9 @@ pub struct TargetCapabilities { impl TargetCapabilities { /// The stable target used by `compile`. /// - /// GC and typed function references are required by the current runtime - /// representation. Other Tier 1 Wasmtime proposals remain opt-in until - /// a lowering and an execution test actually use them. + /// GC, typed function references and tail calls are required by the current + /// runtime representation and stack-safe callable execution. Other proposals + /// remain opt-in until a lowering and an execution test actually use them. pub const fn wasmtime_wasi_0_2() -> Self { Self { mutable_globals: true, @@ -67,7 +67,7 @@ impl TargetCapabilities { gc: true, simd: false, relaxed_simd: false, - tail_call: false, + tail_call: true, multi_memory: false, memory64: false, exceptions: false, @@ -175,7 +175,7 @@ mod tests { gc: true, simd: false, relaxed_simd: false, - tail_call: false, + tail_call: true, multi_memory: false, memory64: false, exceptions: false, diff --git a/crates/psrs-backend/src/cc/state/branches.rs b/crates/psrs-backend/src/cc/state/branches.rs index 5e46c6f1..2a2ced98 100644 --- a/crates/psrs-backend/src/cc/state/branches.rs +++ b/crates/psrs-backend/src/cc/state/branches.rs @@ -130,23 +130,46 @@ impl<'a> Builder<'a, '_> { } let mut value = values.remove(0); for other in values { - value = merge(value, other); + value = merge(value, other).map_err(|()| { + error( + self.function, + "CC state branch loses captured producer provenance", + ) + })?; } Ok(value) } } -fn merge(left: Value, right: Value) -> Value { - match (left, right) { +fn merge(left: Value, right: Value) -> Result { + Ok(match (left, right) { (Value::Product(left), Value::Product(right)) if left.len() == right.len() => { Value::Product( left.into_iter() .zip(right) .map(|(left, right)| merge(left, right)) - .collect(), + .collect::>()?, ) } (left, right) if left == right => left, + (left, right) if left.carries_state() || right.carries_state() => return Err(()), _ => Value::Opaque, + }) +} + +#[cfg(test)] +mod tests { + use super::*; + use psrs_hir::ModuleId; + + #[test] + fn incompatible_captured_producers_cannot_become_an_opaque_join() { + let closure = |dependency| Value::Closure { + symbol: SymbolId::new(ModuleId(0), 1), + captures: vec![Value::State(DependencyId(dependency))], + }; + assert_eq!(merge(closure(0), closure(0)).unwrap(), closure(0)); + assert!(merge(closure(0), closure(1)).is_err()); + assert!(merge(Value::Product(vec![closure(0)]), Value::Opaque).is_err()); } } diff --git a/crates/psrs-backend/src/cc/state/captures.rs b/crates/psrs-backend/src/cc/state/captures.rs new file mode 100644 index 00000000..118d7465 --- /dev/null +++ b/crates/psrs-backend/src/cc/state/captures.rs @@ -0,0 +1,39 @@ +//! A captured dependency is supplied by the closure producer, never invented +//! by the lifted body. Capture slots come from ordinary CC layout verification. +use super::*; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct CapturedCallProjection { + pub capture_index: usize, + pub step: StateResultProjection, +} + +impl CapturedCallProjection { + pub(crate) fn checked( + module: &Module, + function: &Function, + signature: &Signature, + ) -> Result, Vec> { + let captures = super::super::verify::capture_shapes(function)?; + let states = captures + .iter() + .enumerate() + .filter_map(|(index, shape)| (*shape == ValueShape::State).then_some(index)) + .collect::>(); + if states.is_empty() { + return Ok(None); + } + if states.len() != 1 || signature.parameters.contains(&ValueShape::State) { + return Err(error( + function, + "captured State requires one dependency source", + )); + } + let step = StateResultProjection::checked(signature.result, &module.representations) + .map_err(|message| error(function, message))?; + Ok(Some(Self { + capture_index: states[0], + step, + })) + } +} diff --git a/crates/psrs-backend/src/cc/state/eval.rs b/crates/psrs-backend/src/cc/state/eval.rs index c2329e6e..15f14dd7 100644 --- a/crates/psrs-backend/src/cc/state/eval.rs +++ b/crates/psrs-backend/src/cc/state/eval.rs @@ -6,6 +6,7 @@ pub(super) fn function<'a>( function: &'a Function, signatures: &HashMap, passthrough: &HashSet, + captured: &HashMap>, ) -> Result>, Vec> { let shapes = function .values @@ -18,18 +19,19 @@ pub(super) fn function<'a>( .filter(|id| shapes[id] == ValueShape::State) .copied() .collect::>(); - let state_root = !roots.is_empty(); + let capture_root = captured[&function.symbol].map(|plan| plan.capture_index); + let state_root = !roots.is_empty() || capture_root.is_some(); let has_state = shapes.values().any(|shape| *shape == ValueShape::State); if !has_state && !execution::contains(&function.assignments) { return Ok(None); } - if (has_state && roots.len() != 1) || roots.len() > 1 { + if (has_state && roots.len() + usize::from(capture_root.is_some()) != 1) || roots.len() > 1 { return Err(error( function, "CC state body requires one checked dependency parameter", )); } - if state_root { + if !roots.is_empty() { StateCallProjection::checked(&signatures[&function.symbol], &module.representations) .map_err(|message| error(function, message))?; } @@ -39,6 +41,8 @@ pub(super) fn function<'a>( function, signatures, passthrough, + captured, + capture_root, shapes, state_root, executions: Vec::new(), @@ -70,6 +74,23 @@ pub(super) fn function<'a>( .unwrap_or_default(), terminated: false, }; + if let Some(index) = capture_root { + let closure = function.parameters.first().ok_or_else(|| { + error( + function, + "captured dependency has no owning closure parameter", + ) + })?; + let mut captures = vec![Value::Opaque; index + 1]; + captures[index] = Value::State(input); + path.values.insert( + *closure, + Value::Closure { + symbol: function.symbol, + captures, + }, + ); + } builder.assignments(&function.assignments, &mut path)?; if !path.terminated { let mut returned = Vec::new(); @@ -105,6 +126,12 @@ pub(super) fn function<'a>( Ok(Some(FunctionFlow { source: module, function, + input: capture_root + .map(|index| DependencySource::Capture { + closure: function.parameters[0], + index: index as u32, + }) + .or_else(|| roots.first().copied().map(DependencySource::Parameter)), graph, operations: builder.operations, executions: builder.executions, @@ -136,7 +163,22 @@ impl<'a> Builder<'a, '_> { .unwrap_or(Value::Opaque), _ => Value::Opaque, }, - AssignmentKind::FunctionRef { function, .. } => Value::Closure(*function), + AssignmentKind::FunctionRef { function, captures, .. } => Value::Closure { + symbol: *function, + captures: captures.iter().map(|id| self.value(path, *id)).collect(), + }, + AssignmentKind::ClosureGetCapture { closure, index } + if self.capture_root == Some(*index as usize) => { + if self.function.parameters.first() != Some(closure) { + return Err(error(self.function, + "captured dependency must come from the owning closure parameter")); + } + let Value::Closure { captures, .. } = self.value(path, *closure) else { + return Err(error(self.function, + "captured dependency has no checked closure producer")); + }; + captures[*index as usize].clone() + } AssignmentKind::DirectCall { function, arguments, @@ -170,9 +212,24 @@ impl<'a> Builder<'a, '_> { "CC state invocation has no checked closure signature", ) })?; - let pure = matches!(self.value(path, *function), Value::Closure(symbol) - if self.passthrough.contains(&symbol)); - self.call(assignment, arguments, signature, pure, path)? + let callable = self.value(path, *function); + if let Value::Closure { symbol, captures } = &callable + && let Some(Some(plan)) = self.captured.get(symbol) { + let Some(Value::State(input)) = captures.get(plan.capture_index) else { + return Err(error(self.function, + "CC captured invocation has no checked operand provenance")); + }; + self.call_dependency(assignment, *input, plan.step, + self.passthrough.contains(symbol), path)? + } else { + if callable.carries_state() { + return Err(error(self.function, + "CC captured invocation requires checked dependency transport")); + } + let pure = matches!(callable, Value::Closure { symbol, .. } + if self.passthrough.contains(&symbol)); + self.call(assignment, arguments, signature, pure, path)? + } } AssignmentKind::If { then_assignments, @@ -244,6 +301,15 @@ impl<'a> Builder<'a, '_> { StateCallProjection::checked(signature, &self.module.representations) .map_err(|message| error(self.function, message))? else { + if arguments + .iter() + .any(|id| self.value(path, *id).carries_state()) + { + return Err(error( + self.function, + "CC state-carrying argument requires checked invocation transport", + )); + } self.passthrough_safe = false; return Ok(Value::Opaque); }; @@ -259,6 +325,23 @@ impl<'a> Builder<'a, '_> { "CC state invocation has no checked operand provenance", )); }; + self.call_dependency( + assignment, + input, + projection.result_projection(), + pure, + path, + ) + } + + fn call_dependency( + &mut self, + assignment: &'a Assignment, + input: DependencyId, + projection: StateResultProjection, + pure: bool, + path: &mut Path, + ) -> Result> { if input != path.current { return Err(error( self.function, diff --git a/crates/psrs-backend/src/cc/state/mod.rs b/crates/psrs-backend/src/cc/state/mod.rs index 2265c848..408911f6 100644 --- a/crates/psrs-backend/src/cc/state/mod.rs +++ b/crates/psrs-backend/src/cc/state/mod.rs @@ -10,12 +10,15 @@ use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; mod branches; +mod captures; +pub(crate) use super::verify::capture_shapes; +pub use captures::CapturedCallProjection; mod execution; pub use execution::{ClosedExecution, execution_projection}; mod eval; mod projection; -pub use projection::StateCallProjection; pub(crate) use projection::register_payload_slots; +pub use projection::{StateCallProjection, StateResultProjection}; #[cfg(test)] mod tests; @@ -30,12 +33,19 @@ pub struct Operation<'a> { pub struct FunctionFlow<'a> { source: &'a Module, pub function: &'a Function, + pub input: Option, pub graph: Graph, pub operations: Vec>, pub executions: Vec>, passthrough_safe: bool, } +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum DependencySource { + Parameter(ValueId), + Capture { closure: ValueId, index: u32 }, +} + /// Ordinary CC typing and scope verification precede dependency publication. pub fn check(module: &Module) -> Result>, Vec> { super::verify::verify_module(module)?; @@ -55,7 +65,8 @@ impl FunctionFlow<'_> { .iter() .find(|flow| std::ptr::eq(flow.function, self.function)) .ok_or_else(|| error(self.function, "CC state flow has no owning function"))?; - if self.executions != expected.executions + if self.input != expected.input + || self.executions != expected.executions || self.graph != expected.graph || self.operations.len() != expected.operations.len() || self @@ -119,12 +130,20 @@ pub(crate) fn derive_all(module: &Module) -> Result>, Vec, _>>()?; let mut passthrough = HashSet::new(); loop { let mut flows = Vec::new(); let mut errors = Vec::new(); for function in &module.functions { - match eval::function(module, function, &signatures, &passthrough) { + match eval::function(module, function, &signatures, &passthrough, &captured) { Ok(Some(flow)) => flows.push(flow), Ok(None) => {} Err(error) => errors.extend(error), @@ -158,10 +177,23 @@ enum Value { Opaque, State(DependencyId), Product(Vec), - Closure(SymbolId), + Closure { + symbol: SymbolId, + captures: Vec, + }, } impl Value { + fn carries_state(&self) -> bool { + match self { + Self::State(_) => true, + Self::Product(fields) + | Self::Closure { + captures: fields, .. + } => fields.iter().any(Self::carries_state), + Self::Opaque => false, + } + } fn remap(&mut self, from: DependencyId, to: DependencyId) { match self { Self::State(id) if *id == from => *id = to, @@ -170,6 +202,11 @@ impl Value { field.remap(from, to); } } + Self::Closure { captures, .. } => { + for value in captures { + value.remap(from, to); + } + } _ => {} } } @@ -200,6 +237,8 @@ struct Builder<'a, 'b> { function: &'a Function, signatures: &'b HashMap, passthrough: &'b HashSet, + captured: &'b HashMap>, + capture_root: Option, shapes: HashMap, state_root: bool, executions: Vec>, diff --git a/crates/psrs-backend/src/cc/state/projection/mod.rs b/crates/psrs-backend/src/cc/state/projection/mod.rs index 2b0e5004..52c9d508 100644 --- a/crates/psrs-backend/src/cc/state/projection/mod.rs +++ b/crates/psrs-backend/src/cc/state/projection/mod.rs @@ -13,6 +13,13 @@ pub struct StateCallProjection { pub payload: ValueShape, } +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct StateResultProjection { + pub state_field: usize, + pub payload_field: usize, + pub payload: ValueShape, +} + impl StateCallProjection { /// This describes slots only. Removing them still requires checked body, /// invocation and CFG correspondence; a signature does not prove ordering. @@ -32,10 +39,45 @@ impl StateCallProjection { if states != [signature.parameters.len() - 1] { return Err("CC state invocation requires exactly one final dependency parameter"); } + let result = StateResultProjection::checked(signature.result, table)?; + Ok(Some(Self { + state_parameter: states[0], + state_field: result.state_field, + payload_field: result.payload_field, + payload: result.payload, + })) + } + + pub fn result_projection(self) -> StateResultProjection { + StateResultProjection { + state_field: self.state_field, + payload_field: self.payload_field, + payload: self.payload, + } + } + + pub fn physical_signature( + signature: &Signature, + table: &RepresentationTable, + ) -> Result { + let Some(plan) = Self::checked(signature, table)? else { + return Ok(signature.clone()); + }; + Ok(Signature { + parameters: signature.parameters[..plan.state_parameter].to_vec(), + result: plan.payload, + }) + } +} + +impl StateResultProjection { + /// The shared Step result contract is independent of whether its incoming + /// dependency belongs to an explicit parameter or a lexical capture. + pub fn checked(result: ValueShape, table: &RepresentationTable) -> Result { let ValueShape::Reference(Reference { nullable: false, heap: RefShape::Repr(id), - }) = signature.result + }) = result else { return Err("CC state invocation requires a non-null Step product"); }; @@ -56,24 +98,10 @@ impl StateCallProjection { .position(|shape| *shape == ValueShape::State) .unwrap(); let payload_field = 1 - state_field; - Ok(Some(Self { - state_parameter: states[0], + Ok(Self { state_field, payload_field, payload: fields[payload_field], - })) - } - - pub fn physical_signature( - signature: &Signature, - table: &RepresentationTable, - ) -> Result { - let Some(plan) = Self::checked(signature, table)? else { - return Ok(signature.clone()); - }; - Ok(Signature { - parameters: signature.parameters[..plan.state_parameter].to_vec(), - result: plan.payload, }) } } diff --git a/crates/psrs-backend/src/cc/verify/helpers.rs b/crates/psrs-backend/src/cc/verify/helpers.rs index 28e8458f..915c9581 100644 --- a/crates/psrs-backend/src/cc/verify/helpers.rs +++ b/crates/psrs-backend/src/cc/verify/helpers.rs @@ -68,7 +68,7 @@ pub(super) fn verify_capture_layout(function: &Function) -> Result<(), Vec Result, Vec> { +pub(crate) fn capture_shapes(function: &Function) -> Result, Vec> { let declared = function .values .iter() diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 49435d7b..46f9902c 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -6,6 +6,7 @@ use std::collections::{HashMap, HashSet}; mod adaptation; mod helpers; +pub(crate) use helpers::capture_shapes; mod ops; mod scalar; mod variant; diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index eebb3a6d..a0806be6 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -334,7 +334,7 @@ impl FunctionLowerer<'_> { } => { let then_block = self.new_block(Vec::new()); let else_block = self.new_block(Vec::new()); - let merge = self.new_block(vec![assignment.destination]); + let merge = self.new_block(self.control_values(assignment.destination)); self.set_terminator( current, Terminator::Branch { @@ -350,7 +350,7 @@ impl FunctionLowerer<'_> { then_end, Terminator::Jump { target: merge, - arguments: vec![*then_value], + arguments: self.control_values(*then_value), span: assignment.span, }, assignment.span, @@ -360,7 +360,7 @@ impl FunctionLowerer<'_> { else_end, Terminator::Jump { target: merge, - arguments: vec![*else_value], + arguments: self.control_values(*else_value), span: assignment.span, }, assignment.span, @@ -378,7 +378,7 @@ impl FunctionLowerer<'_> { .map(|_| self.new_block(Vec::new())) .collect::>(); let default_block = self.new_block(Vec::new()); - let merge = self.new_block(vec![assignment.destination]); + let merge = self.new_block(self.control_values(assignment.destination)); self.set_terminator( current, Terminator::Switch { @@ -399,7 +399,7 @@ impl FunctionLowerer<'_> { end, Terminator::Jump { target: merge, - arguments: vec![case.value], + arguments: self.control_values(case.value), span: assignment.span, }, assignment.span, @@ -410,7 +410,7 @@ impl FunctionLowerer<'_> { end, Terminator::Jump { target: merge, - arguments: vec![*default_value], + arguments: self.control_values(*default_value), span: assignment.span, }, assignment.span, diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index 7ec42023..b73cc47d 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -19,7 +19,7 @@ mod assignments; mod conversion_helpers; mod runtime_call; mod storage_call; -mod tail; +pub(in crate::mir) mod tail; mod variant; mod wit_call; pub(super) use conversion_helpers::ConversionHelpers; @@ -51,7 +51,7 @@ pub(super) fn lower_function( layout: &PlannedLayout, conversion_helpers: Option<&mut ConversionHelpers>, literals: Option<&mut StringLiterals>, - logical_state_source: Option>, + logical_state_source: Option>, target: crate::capability::TargetCapabilities, ) -> Result> { let entry = BlockId(0); @@ -61,12 +61,19 @@ pub(super) fn lower_function( .as_ref() .and_then(|module| { module + .module .functions .iter() .find(|function| function.symbol == source.symbol) }) .unwrap_or(source); let mut lowerer = FunctionLowerer { + erased_states: logical_values + .values + .iter() + .filter(|value| value.ty == cc::ValueShape::State) + .map(|value| value.id) + .collect(), owner: source.symbol, runtime: Some(runtime), runtime_calls: Vec::new(), @@ -147,6 +154,8 @@ pub(super) fn lower_function( Ok(function) } pub(super) struct FunctionLowerer<'a> { + // Logical IDs remain reserved, but have no physical declaration or slot. + erased_states: std::collections::HashSet, owner: SymbolId, runtime: Option<&'a super::runtime::RuntimeContext>, runtime_calls: Vec, @@ -162,6 +171,13 @@ pub(super) struct FunctionLowerer<'a> { } impl FunctionLowerer<'_> { + fn control_values(&self, value: ValueId) -> Vec { + if self.erased_states.contains(&value) { + Vec::new() + } else { + vec![value] + } + } pub(super) fn value_type(&self, id: ValueId) -> Option { self.values .iter() diff --git a/crates/psrs-backend/src/mir/lower/tail.rs b/crates/psrs-backend/src/mir/lower/tail.rs index 0918987c..efb2d41d 100644 --- a/crates/psrs-backend/src/mir/lower/tail.rs +++ b/crates/psrs-backend/src/mir/lower/tail.rs @@ -22,10 +22,19 @@ pub(super) fn mark_tail( function: &mut Function, target: TargetCapabilities, ) -> Result<(), Vec> { - if function.state.is_some() { - // Tail transfer must project the logical successor before rewriting it. + if let Some(flow) = function.state.clone() { + let (transformed, checked) = flow.project_tail(function, target)?; + *function = transformed; + function.state = Some(checked); return Ok(()); } + rewrite(function, target) +} + +pub(in crate::mir) fn rewrite( + function: &mut Function, + target: TargetCapabilities, +) -> Result<(), Vec> { let returned = return_forwarded_values(function); let uses = use_counts(function); let symbol = function.symbol; @@ -315,7 +324,10 @@ fn loopify_self_calls( block.instructions.pop(); block.terminator = Some(Terminator::Jump { target: header_id, - arguments: arguments.clone(), + arguments: arguments + .iter() + .map(|id| mapping.get(id).copied().unwrap_or(*id)) + .collect(), span: *span, }); } diff --git a/crates/psrs-backend/src/mir/lower/wit_call.rs b/crates/psrs-backend/src/mir/lower/wit_call.rs index 4651f2e9..2cb04840 100644 --- a/crates/psrs-backend/src/mir/lower/wit_call.rs +++ b/crates/psrs-backend/src/mir/lower/wit_call.rs @@ -23,6 +23,7 @@ impl FunctionLowerer<'_> { // The isolated builder shares checked layouts and helper ownership, // but cannot inspect or mutate the actual instruction stream. let mut builder = FunctionLowerer { + erased_states: Default::default(), owner: self.owner, runtime: None, runtime_calls: Vec::new(), diff --git a/crates/psrs-backend/src/mir/lower/wit_tests.rs b/crates/psrs-backend/src/mir/lower/wit_tests.rs index 172a24fb..9dd9a623 100644 --- a/crates/psrs-backend/src/mir/lower/wit_tests.rs +++ b/crates/psrs-backend/src/mir/lower/wit_tests.rs @@ -22,6 +22,7 @@ fn gc_wit_record_projection_uses_the_planned_product_type() { }); let lowerer_span = TextRange::new(0, 1); let mut lowerer = FunctionLowerer { + erased_states: Default::default(), owner: psrs_hir::SymbolId::new(psrs_hir::ModuleId(0), 0), runtime: None, runtime_calls: Vec::new(), diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index a5dfcdd0..9fa2a1ce 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -318,10 +318,7 @@ fn lower_module_after_binding_validation( &layout, Some(&mut conversion_helpers), Some(&mut literals), - projected - .inventory - .requires(function.symbol) - .then(|| projected.logical.clone()), + projected.inventory.source_for(function.symbol), target, ) .map_err(|errors| { diff --git a/crates/psrs-backend/src/mir/opt/constants.rs b/crates/psrs-backend/src/mir/opt/constants.rs index 307ccdc8..3deceb77 100644 --- a/crates/psrs-backend/src/mir/opt/constants.rs +++ b/crates/psrs-backend/src/mir/opt/constants.rs @@ -48,7 +48,14 @@ fn propagate_function(function: &mut Function) -> bool { // Join parameters and their incoming payloads are source anchors in a // dependency projection. Removing them requires an explicit evidence // transfer, even when their scalar value is known. - let mut changed = function.state.is_none() && materialize_block_parameters(function, &facts); + let changed = function.state.is_none() && materialize_block_parameters(function, &facts); + changed | fold_scalar_instructions(function) +} + +/// Canonicalize proven scalar operations without changing calls, identities or CFG. +pub(in crate::mir) fn fold_scalar_instructions(function: &mut Function) -> bool { + let facts = analyze(function); + let mut changed = false; for block in &mut function.blocks { for instruction in &mut block.instructions { let Some(destination) = instruction.destination() else { diff --git a/crates/psrs-backend/src/mir/opt/mod.rs b/crates/psrs-backend/src/mir/opt/mod.rs index 9035dc8d..65ddb00b 100644 --- a/crates/psrs-backend/src/mir/opt/mod.rs +++ b/crates/psrs-backend/src/mir/opt/mod.rs @@ -1,7 +1,7 @@ //! Representation-preserving P10 optimization over verified MIR. mod cfg; -mod constants; +pub(in crate::mir) mod constants; mod effects; mod imports; mod inline; diff --git a/crates/psrs-backend/src/mir/state/branch_tests.rs b/crates/psrs-backend/src/mir/state/branch_tests.rs index a18ea8cf..e462d0cf 100644 --- a/crates/psrs-backend/src/mir/state/branch_tests.rs +++ b/crates/psrs-backend/src/mir/state/branch_tests.rs @@ -106,7 +106,7 @@ pub(super) fn source(flag: bool) -> cc::Module { #[test] fn state_branches_lower_with_logical_joins_and_payload_only_block_parameters() { - let (mir, _) = crate::mir::lower_module(source(true)).unwrap(); + let (mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); let function = &mir.functions[0]; assert_eq!(function.state.as_ref().unwrap().graph().blocks.len(), 4); assert_eq!(function.blocks.len(), 4); @@ -117,7 +117,7 @@ fn state_branches_lower_with_logical_joins_and_payload_only_block_parameters() { #[test] fn state_branch_projection_rejects_changed_edges_and_calls_moved_across_choices() { - let (mut mir, _) = crate::mir::lower_module(source(true)).unwrap(); + let (mut mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); if let Some(Terminator::Branch { then_block, else_block, @@ -132,7 +132,7 @@ fn state_branch_projection_rejects_changed_edges_and_calls_moved_across_choices( .iter() .any(|failure| failure.message.contains("branch or successor")) ); - let (mut mir, _) = crate::mir::lower_module(source(true)).unwrap(); + let (mut mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); let instruction = mir.functions[0].blocks[1].instructions.remove(0); mir.functions[0].blocks[2] .instructions @@ -143,7 +143,7 @@ fn state_branch_projection_rejects_changed_edges_and_calls_moved_across_choices( .iter() .any(|failure| failure.message.contains("adds or loses an invocation")) ); - let (mut mir, _) = crate::mir::lower_module(source(true)).unwrap(); + let (mut mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); if let Some(Terminator::Jump { target, .. }) = &mut mir.functions[0].blocks[1].terminator { *target = BlockId(2); } @@ -200,7 +200,7 @@ fn nested_choices_project_source_and_mir_block_orders_explicitly() { }, ]; } - let (mir, _) = crate::mir::lower_module(source).unwrap(); + let (mir, _) = super::tests::lower_without_tail_calls(source).unwrap(); assert_eq!( mir.functions[0] .state @@ -232,7 +232,7 @@ fn a_trapping_state_arm_has_no_normal_edge_to_the_payload_join() { { then_assignments[0].kind = A::Unreachable; } - let (mut mir, _) = crate::mir::lower_module(source).unwrap(); + let (mut mir, _) = super::tests::lower_without_tail_calls(source).unwrap(); assert!(matches!( mir.functions[0].blocks[1].terminator, Some(Terminator::Trap { .. }) @@ -263,7 +263,7 @@ fn state_branch_components_execute_both_selected_payloads_after_optimization() { { then_assignments[0].kind = A::Unreachable; } - let (mir, mut wasi) = crate::mir::lower_module(source).unwrap(); + let (mir, mut wasi) = super::tests::lower_without_tail_calls(source).unwrap(); let mir = crate::mir::opt::optimize(mir, target).unwrap(); assert_eq!(mir.functions[0].blocks.len(), 4); let context = crate::linking::default_context().unwrap(); diff --git a/crates/psrs-backend/src/mir/state/captures.rs b/crates/psrs-backend/src/mir/state/captures.rs new file mode 100644 index 00000000..517bdc3e --- /dev/null +++ b/crates/psrs-backend/src/mir/state/captures.rs @@ -0,0 +1,91 @@ +//! Capture producers and surviving slot reads stay anchored to logical CC. +use super::*; +use std::collections::HashSet; + +pub(super) fn verify( + source: &cc::Function, + function: &Function, + assignments: &[&cc::Assignment], + instructions: &[&Instruction], +) -> Result<(), Vec> { + let states = source + .values + .iter() + .filter(|value| value.ty == cc::ValueShape::State) + .map(|value| value.id) + .collect::>(); + let slots = cc::state::capture_shapes(source)?; + let mut expected = Vec::new(); + collect(assignments, &states, &slots, &mut expected); + let mut actual = Vec::new(); + for instruction in instructions { + let capture = match instruction { + Instruction::ClosureNew { + destination, + function, + captures, + .. + } => Some((*destination, Capture::New(*function, captures.clone()))), + Instruction::ClosureGetCapture { + destination, + closure, + index, + .. + } => Some((*destination, Capture::Get(*closure, *index))), + _ => None, + }; + if let Some(capture) = capture { + actual.push(capture); + } + } + if actual != expected { + return Err(error( + function, + "MIR capture projection changes a producer, operand, logical slot or scope", + )); + } + Ok(()) +} + +#[derive(Debug, PartialEq, Eq)] +enum Capture { + New(psrs_hir::SymbolId, Vec), + Get(cc::ValueId, u32), +} + +fn collect( + assignments: &[&cc::Assignment], + states: &HashSet, + slots: &[cc::ValueShape], + expected: &mut Vec<(cc::ValueId, Capture)>, +) { + for assignment in assignments { + match &assignment.kind { + cc::AssignmentKind::FunctionRef { + function, captures, .. + } => { + expected.push(( + assignment.destination, + Capture::New( + *function, + captures + .iter() + .filter(|value| !states.contains(value)) + .copied() + .collect(), + ), + )); + } + cc::AssignmentKind::ClosureGetCapture { closure, index } + if !states.contains(&assignment.destination) => + { + let physical = slots[..*index as usize] + .iter() + .filter(|shape| **shape != cc::ValueShape::State) + .count() as u32; + expected.push((assignment.destination, Capture::Get(*closure, physical))); + } + _ => {} + } + } +} diff --git a/crates/psrs-backend/src/mir/state/control.rs b/crates/psrs-backend/src/mir/state/control.rs index f504e576..d89a1af7 100644 --- a/crates/psrs-backend/src/mir/state/control.rs +++ b/crates/psrs-backend/src/mir/state/control.rs @@ -5,6 +5,7 @@ use crate::mir::{BlockId, Terminator}; struct Block<'a> { parameters: Vec, calls: Vec>, + captures: Vec<&'a cc::Assignment>, end: Option, } struct Call<'a> { @@ -80,6 +81,7 @@ pub(super) fn verify( let mut blocks = vec![Block { parameters: Vec::new(), calls: Vec::new(), + captures: Vec::new(), end: None, }]; let end = sequence(&source.assignments, 0, &mut blocks, table, &never)?; @@ -105,7 +107,7 @@ pub(super) fn verify( .iter() .find(|block| block.id == source_blocks[id]) .ok_or_else(|| error(function, "MIR dependency projection loses a control block"))?; - if actual.parameters != expected.parameters { + if actual.parameters != projected_arguments(&expected.parameters) { return Err(error( function, "MIR dependency projection changes block parameters", @@ -114,6 +116,7 @@ pub(super) fn verify( // Collapse only complete, independently checked canonical adapters. // Their internal calls and edges remain verified by the owning plan. let mut calls = Vec::new(); + let mut captures = Vec::new(); let mut cursor = 0; loop { if let Some(invocation) = host_by_entry.get(&(actual.id, cursor)) { @@ -146,8 +149,15 @@ pub(super) fn verify( ) { calls.push((actual.id, cursor, instruction, None)); } + if matches!( + instruction, + Instruction::ClosureNew { .. } | Instruction::ClosureGetCapture { .. } + ) { + captures.push(instruction); + } cursor += 1; } + super::captures::verify(source, function, &expected.captures, &captures)?; let valid = match (&expected.end, &actual.terminator) { ( Some(End::Branch(condition, left, right)), @@ -187,7 +197,10 @@ pub(super) fn verify( arguments, .. }), - ) => Some(actual) == source_blocks.get(*target) && arguments.as_slice() == [*value], + ) => { + Some(actual) == source_blocks.get(*target) + && *arguments == projected_arguments(&[*value]) + } (Some(End::Return(value)), Some(Terminator::Return { value: actual, .. })) => { value == actual } @@ -319,6 +332,10 @@ fn sequence<'a>( ) -> Result> { for assignment in assignments { match &assignment.kind { + cc::AssignmentKind::FunctionRef { .. } + | cc::AssignmentKind::ClosureGetCapture { .. } => { + blocks[current].captures.push(assignment); + } cc::AssignmentKind::DirectCall { .. } | cc::AssignmentKind::IndirectCall { .. } | cc::AssignmentKind::StateExecution { .. } => { @@ -346,6 +363,7 @@ fn sequence<'a>( Vec::new() }, calls: Vec::new(), + captures: Vec::new(), end: None, })); let right = left + 1; @@ -394,6 +412,7 @@ fn sequence<'a>( Vec::new() }, calls: Vec::new(), + captures: Vec::new(), end: None, })); blocks[current].end = Some(End::Switch( diff --git a/crates/psrs-backend/src/mir/state/inventory.rs b/crates/psrs-backend/src/mir/state/inventory.rs index ca0de074..62efe09c 100644 --- a/crates/psrs-backend/src/mir/state/inventory.rs +++ b/crates/psrs-backend/src/mir/state/inventory.rs @@ -7,21 +7,17 @@ use std::collections::HashSet; /// Production P9 modules retain their checked logical source even when pure. #[derive(Clone, Debug, Default, PartialEq, Eq)] pub(crate) struct Inventory { - source: Option>, + source: Option>, required: HashSet, declared: HashSet, } impl Inventory { pub(in crate::mir) fn checked(source: Arc) -> Result> { - let flows = cc::state::derive_all(&source)?; - if !flows.is_empty() { - // Dependency projection requires ordinary CC typing as well. - // An empty inventory does not publish additional typing claims. - cc::state::check(&source)?; - } - let required = flows.iter().map(|flow| flow.function.symbol).collect(); + let source = CheckedSource::checked(source)?; + let required = source.required().collect(); let declared = source + .module .functions .iter() .map(|function| function.symbol) @@ -49,6 +45,11 @@ impl Inventory { Ok(self) } + pub(in crate::mir) fn source_for(&self, symbol: SymbolId) -> Option> { + self.requires(symbol) + .then(|| self.source.as_ref().unwrap().clone()) + } + pub(in crate::mir) fn requires(&self, symbol: SymbolId) -> bool { self.required.contains(&symbol) } @@ -84,7 +85,12 @@ impl Inventory { function, "MIR dependency evidence has no module source requirement", )), - (true, Some(flow)) if self.source.as_deref() != Some(flow.source.as_ref()) => { + (true, Some(flow)) + if !self + .source + .as_ref() + .is_some_and(|source| Arc::ptr_eq(&source.module, &flow.source.module)) => + { errors.extend(error( function, "MIR dependency evidence belongs to a different source inventory", diff --git a/crates/psrs-backend/src/mir/state/mod.rs b/crates/psrs-backend/src/mir/state/mod.rs index 1201b899..5a17e302 100644 --- a/crates/psrs-backend/src/mir/state/mod.rs +++ b/crates/psrs-backend/src/mir/state/mod.rs @@ -3,17 +3,22 @@ use super::{Function, Instruction}; use crate::{BackendError, cc}; use psrs_core::state::dependency::Graph; use std::sync::Arc; +mod captures; mod control; mod inventory; pub(crate) use inventory::Inventory; mod projection; mod runtime; +mod source; +pub(in crate::mir) use source::CheckedSource; +mod tail; pub(super) use projection::project; pub(in crate::mir) use runtime::RuntimeInvocation; #[derive(Clone, Debug, PartialEq, Eq)] pub struct DependencyFlow { - source: Arc, + source: Arc, + tail: Option, graph: Graph, executions: Vec, runtime: Vec, @@ -28,28 +33,28 @@ impl DependencyFlow { source: Arc, function: &Function, ) -> Result> { - Self::checked_with_runtime(source, function, Vec::new(), Vec::new()) + Self::checked_with_runtime( + CheckedSource::checked(source)?, + function, + Vec::new(), + Vec::new(), + ) } pub(in crate::mir) fn checked_with_runtime( - source: Arc, + source: Arc, function: &Function, runtime: Vec, host: Vec, ) -> Result> { - let flows = cc::state::check(&source)?; - let flow = flows - .iter() - .find(|flow| flow.function.symbol == function.symbol) + let flow = source + .flow(function.symbol) .ok_or_else(|| error(function, "MIR dependency projection has no checked CC body"))?; let graph = flow.graph.clone(); - let executions = flow - .executions - .iter() - .map(|execution| execution.graph.clone()) - .collect(); + let executions = flow.executions.clone(); let projection = Self { source, + tail: None, graph, executions, runtime, @@ -68,24 +73,19 @@ impl DependencyFlow { } pub(crate) fn verify(&self, function: &Function) -> Result<(), Vec> { - let flows = cc::state::derive_all(&self.source)?; - let expected = flows - .iter() - .find(|flow| flow.function.symbol == function.symbol) - .ok_or_else(|| { - error( - function, - "MIR dependency projection has no owning CC function", - ) - })?; - if self.executions - != expected - .executions - .iter() - .map(|execution| execution.graph.clone()) - .collect::>() - || self.graph != expected.graph - { + let function = if let Some(transfer) = &self.tail { + transfer.verify(function)?; + transfer.source() + } else { + function + }; + let expected = self.source.flow(function.symbol).ok_or_else(|| { + error( + function, + "MIR dependency projection has no owning CC function", + ) + })?; + if self.executions != expected.executions || self.graph != expected.graph { return Err(error( function, "MIR dependency projection changes checked control flow", @@ -94,7 +94,12 @@ impl DependencyFlow { self.graph .verify() .map_err(|failure| error(function, failure.message))?; - let source_function = expected.function; + let source_function = self.source.function(function.symbol).ok_or_else(|| { + error( + function, + "MIR dependency projection has no owning CC function", + ) + })?; let states = source_function .values .iter() @@ -121,7 +126,7 @@ impl DependencyFlow { control::verify( source_function, function, - &self.source.representations, + &self.source.module.representations, &self.runtime, &self.host, )?; diff --git a/crates/psrs-backend/src/mir/state/operand_tests.rs b/crates/psrs-backend/src/mir/state/operand_tests.rs index 34315229..a5bde8b3 100644 --- a/crates/psrs-backend/src/mir/state/operand_tests.rs +++ b/crates/psrs-backend/src/mir/state/operand_tests.rs @@ -102,7 +102,7 @@ fn indirect_calls_preserve_ordinary_operands_after_state_erasure() { arguments: arguments.clone(), }; } - let (mut module, _) = crate::mir::lower_module(source).unwrap(); + let (mut module, _) = super::tests::lower_without_tail_calls(source).unwrap(); crate::mir::verify_module(&module).unwrap(); let function = &mut module.functions[0]; let certificate = function.state.clone().unwrap(); diff --git a/crates/psrs-backend/src/mir/state/projection.rs b/crates/psrs-backend/src/mir/state/projection.rs index 0a4e0d94..58557b2b 100644 --- a/crates/psrs-backend/src/mir/state/projection.rs +++ b/crates/psrs-backend/src/mir/state/projection.rs @@ -34,16 +34,12 @@ pub(in crate::mir) fn project( return None; } let id = cc::ReprId(id as u32); - let signature = cc::Signature { - parameters: vec![ValueShape::State], - result: ValueShape::Reference(cc::Reference { - nullable: false, - heap: RefShape::Repr(id), - }), - }; - cc::state::StateCallProjection::checked(&signature, &logical.representations) + let result = ValueShape::Reference(cc::Reference { + nullable: false, + heap: RefShape::Repr(id), + }); + cc::state::StateResultProjection::checked(result, &logical.representations) .ok() - .flatten() .map(|plan| (id, plan)) }) .collect::>(); @@ -96,6 +92,12 @@ pub(in crate::mir) fn project( )] })?; } + // A checked captured callback retains ordinary parameters and returns the + // same Step payload as an explicit-parameter action. Inventory checks on + // its actual producer/body still precede physical layout planning. + for signature in &mut physical.representations.signatures { + signature.result = shape(signature.result); + } // Only checked state-stepping declarations may enter private physical // planning. A signature that projects to a checked Step call carries its // own proof, so a host binding is admitted on the same terms as a runtime @@ -193,22 +195,39 @@ fn project_assignments( input: &mut Vec, original: &cc::Function, states: &HashSet, - steps: &HashMap, + steps: &HashMap, shape: &impl Fn(ValueShape) -> ValueShape, table: &cc::RepresentationTable, ) -> Result<(), Vec> { + let capture_shapes = cc::state::capture_shapes(original)?; let mut assignments = Vec::new(); for mut assignment in std::mem::take(input) { - if states.contains(&assignment.destination) { - if matches!(assignment.kind, A::If { .. } | A::TagSwitch { .. }) { - return Err(error( - original, - "raw State choice requires zero-width control result projection", - )); - } + // A zero-width result does not make the control or its calls erasable. + // Keep choices for CFG lowering, while removing their physical slots. + if states.contains(&assignment.destination) + && !matches!(assignment.kind, A::If { .. } | A::TagSwitch { .. }) + { continue; } let copy = match &mut assignment.kind { + A::FunctionRef { captures, .. } => { + captures.retain(|id| !states.contains(id)); + None + } + A::ClosureGetCapture { index, .. } => { + let slot = *index as usize; + if slot >= capture_shapes.len() { + return Err(error( + original, + "capture projection has no checked logical slot", + )); + } + *index = capture_shapes[..slot] + .iter() + .filter(|shape| **shape != ValueShape::State) + .count() as u32; + None + } A::ProductNew { representation, arguments, diff --git a/crates/psrs-backend/src/mir/state/source.rs b/crates/psrs-backend/src/mir/state/source.rs new file mode 100644 index 00000000..8b362e4c --- /dev/null +++ b/crates/psrs-backend/src/mir/state/source.rs @@ -0,0 +1,104 @@ +//! One immutable dependency authority per logical CC module. Physical function +//! verification consumes its checked summaries without deriving the entire +//! frozen module again for each body or optimizer checkpoint. +use super::*; +use psrs_hir::SymbolId; +use std::collections::HashMap; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(in crate::mir) struct SourceFlow { + pub graph: Graph, + pub executions: Vec, +} + +#[derive(Debug, PartialEq, Eq)] +pub(in crate::mir) struct CheckedSource { + pub module: Arc, + positions: HashMap, + flows: HashMap, +} + +impl CheckedSource { + pub(in crate::mir) fn checked(module: Arc) -> Result, Vec> { + let derived = cc::state::derive_all(&module)?; + if !derived.is_empty() { + // Publish State summaries only with ordinary CC typing/scope + // validation. An empty source retains the existing pure-module + // inventory contract and publishes no additional typing claims. + cc::state::check(&module)?; + } + let flows = derived + .iter() + .map(|flow| { + ( + flow.function.symbol, + SourceFlow { + graph: flow.graph.clone(), + executions: flow + .executions + .iter() + .map(|run| run.graph.clone()) + .collect(), + }, + ) + }) + .collect(); + let positions = module + .functions + .iter() + .enumerate() + .map(|(id, body)| (body.symbol, id)) + .collect(); + Ok(Arc::new(Self { + module, + positions, + flows, + })) + } + + pub(in crate::mir) fn required(&self) -> impl Iterator + '_ { + self.flows.keys().copied() + } + + pub(in crate::mir) fn flow(&self, symbol: SymbolId) -> Option<&SourceFlow> { + self.flows.get(&symbol) + } + + pub(in crate::mir) fn function(&self, symbol: SymbolId) -> Option<&cc::Function> { + self.positions + .get(&symbol) + .map(|id| &self.module.functions[*id]) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn frozen_source_keeps_its_calls_when_a_source_copy_changes() { + let (mut source, physical) = crate::mir::state::tests::fixture(); + let checked = CheckedSource::checked(source.clone()).unwrap(); + let original = DependencyFlow::checked_with_runtime( + checked.clone(), + &physical, + Vec::new(), + Vec::new(), + ) + .unwrap(); + let changed = Arc::make_mut(&mut source); + let replacement = psrs_hir::SymbolId::new(psrs_hir::ModuleId(0), 2); + let mut external = changed.externals[0].clone(); + external.symbol = replacement; + changed.externals.push(external); + let cc::AssignmentKind::DirectCall { function, .. } = + &mut changed.functions[0].assignments[0].kind + else { + panic!("fixture has an observable call"); + }; + *function = replacement; + assert!(!Arc::ptr_eq(&checked.module, &source)); + original.verify(&physical).unwrap(); + assert!(DependencyFlow::checked(source, &physical).is_err()); + } +} diff --git a/crates/psrs-backend/src/mir/state/switch_tests.rs b/crates/psrs-backend/src/mir/state/switch_tests.rs index 09deb8a4..e2da37ef 100644 --- a/crates/psrs-backend/src/mir/state/switch_tests.rs +++ b/crates/psrs-backend/src/mir/state/switch_tests.rs @@ -51,7 +51,7 @@ fn source(tag: i32) -> cc::Module { #[test] fn multiway_state_projection_checks_labels_default_edges_and_invocation_placement() { - let (module, _) = crate::mir::lower_module(source(7)).unwrap(); + let (module, _) = super::tests::lower_without_tail_calls(source(7)).unwrap(); crate::mir::verify_module(&module).unwrap(); assert_eq!(module.functions[0].blocks.len(), 5); for mutation in 0..6 { @@ -141,7 +141,7 @@ fn nested_binary_choice_in_a_state_switch_preserves_both_join_payloads() { span, }, ]; - let (module, _) = crate::mir::lower_module(source).unwrap(); + let (module, _) = super::tests::lower_without_tail_calls(source).unwrap(); assert_eq!(module.functions[0].blocks.len(), 8); crate::mir::verify_module(&module).unwrap(); let mut changed = module; @@ -182,7 +182,7 @@ fn state_switch_executes_case_default_and_selected_trap_after_optimization() { }; cases[0].assignments[0].kind = A::Unreachable; } - let (module, mut wasi) = crate::mir::lower_module(source).unwrap(); + let (module, mut wasi) = super::tests::lower_without_tail_calls(source).unwrap(); let module = crate::mir::opt::optimize(module, target).unwrap(); let context = crate::linking::default_context().unwrap(); let link = @@ -252,7 +252,7 @@ fn constant_payload_joins_keep_their_source_parameters_during_optimization() { cases[0].assignments = arms(1, 10); cases[1].assignments = arms(5, 11); *default_assignments = arms(7, 12); - let (module, _) = crate::mir::lower_module(source).unwrap(); + let (module, _) = super::tests::lower_without_tail_calls(source).unwrap(); let optimized = crate::mir::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); assert_eq!(optimized.functions[0].blocks[4].parameters, [ValueId(3)]); @@ -260,20 +260,8 @@ fn constant_payload_joins_keep_their_source_parameters_during_optimization() { } #[test] -fn raw_state_switch_results_reject_before_their_effectful_arms_can_be_erased() { +fn raw_state_switch_results_keep_control_and_erase_only_join_slots() { let mut source = source(7); - source.functions.truncate(1); - source.externals = [1, 6, 8] - .into_iter() - .map(|symbol| cc::External { - symbol: SymbolId::new(ModuleId(0), symbol), - signature: Some(cc::Signature { - parameters: vec![ValueShape::State], - result: source.functions[0].result_type, - }), - projection: None, - }) - .collect(); let function = &mut source.functions[0]; let span = function.span; function.values.extend((10..=13).map(|id| ValueDecl { @@ -317,14 +305,35 @@ fn raw_state_switch_results_reject_before_their_effectful_arms_can_be_erased() { span, }); cc::state::check(&source).unwrap(); - let Err(errors) = super::project(source, &[]) else { - panic!("raw State choice must reject"); - }; + let (module, _) = super::tests::lower_without_tail_calls(source).unwrap(); + let function = &module.functions[0]; + assert!(function.blocks[4].parameters.is_empty()); + for id in [1, 2, 3] { + let Some(Terminator::Jump { arguments, .. }) = &function.blocks[id].terminator else { + panic!("choice arm lost its jump"); + }; + assert!(arguments.is_empty()); + } + crate::mir::verify_module(&module).unwrap(); + let mut changed = module.clone(); + changed.functions[0].values.push(crate::types::ValueDecl { + id: ValueId(14), + ty: crate::types::ValueType::I32, + }); + changed.functions[0].blocks[4].parameters.push(ValueId(14)); + for (block, value) in [(1, 1), (2, 5), (3, 7)] { + let Some(Terminator::Jump { arguments, .. }) = + &mut changed.functions[0].blocks[block].terminator + else { + panic!(); + }; + arguments.push(ValueId(value)); + } + let errors = crate::mir::verify_module(&changed).unwrap_err(); assert!( errors .iter() - .any(|error| error.pass == "P9 State projection" - && error.message.contains("raw State choice")), + .all(|error| error.pass == "P9 MIR dependency verification"), "{errors:?}" ); } diff --git a/crates/psrs-backend/src/mir/state/tail.rs b/crates/psrs-backend/src/mir/state/tail.rs new file mode 100644 index 00000000..347f24a6 --- /dev/null +++ b/crates/psrs-backend/src/mir/state/tail.rs @@ -0,0 +1,102 @@ +//! Tail conversion preserves the checked physical predecessor through the +//! common tail rewrite. Actual MIR must implement that exact conversion; +//! source correspondence is still checked against the immutable predecessor. +use super::*; +use crate::TargetCapabilities; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(super) struct TailTransfer { + source: Arc, + target: TargetCapabilities, +} + +impl DependencyFlow { + pub(in crate::mir) fn project_tail( + &self, + function: &Function, + target: TargetCapabilities, + ) -> Result<(Function, Self), Vec> { + self.verify(function)?; + if self.tail.is_some() { + return Err(error( + function, + "tail dependency transfer is already projected", + )); + } + let mut source = function.clone(); + source.state = None; + let mut transformed = source.clone(); + crate::mir::lower::tail::rewrite(&mut transformed, target)?; + let mut flow = self.clone(); + if transformed != source { + flow.tail = Some(TailTransfer { + source: Arc::new(source), + target, + }); + } + flow.verify(&transformed)?; + Ok((transformed, flow)) + } +} + +impl TailTransfer { + pub(super) fn source(&self) -> &Function { + &self.source + } + + pub(super) fn verify(&self, function: &Function) -> Result<(), Vec> { + let mut expected = (*self.source).clone(); + crate::mir::lower::tail::rewrite(&mut expected, self.target)?; + let mut actual = function.clone(); + actual.state = None; + // FunctionId is the compacted module position, not semantic identity. + // Source inventories and calls remain anchored to the stable SymbolId. + expected.id = actual.id; + // P10 already permits proven scalar folding in State functions. Use + // that same operation to compare instructions, without admitting any + // call, operand, capture, block-parameter or control-flow change. + crate::mir::opt::constants::fold_scalar_instructions(&mut expected); + crate::mir::opt::constants::fold_scalar_instructions(&mut actual); + if actual != expected { + return Err(error( + function, + "MIR tail conversion changes checked dependency instructions or control flow", + )); + } + Ok(()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn checked_tail_transfer_rejects_a_changed_call_target() { + let (source, function) = crate::mir::state::tests::fixture(); + let flow = DependencyFlow::checked(source, &function).unwrap(); + let (mut projected, flow) = flow + .project_tail(&function, TargetCapabilities::default()) + .unwrap(); + let Some(crate::mir::Terminator::ReturnCall { + function: target, .. + }) = &mut projected.blocks[0].terminator + else { + panic!("the checked terminal call must become a tail call"); + }; + *target = projected.symbol; + assert!(flow.verify(&projected).is_err()); + } + + #[test] + fn checked_tail_transfer_preserves_the_preceding_observable_call() { + let (source, function) = crate::mir::state::tests::fixture(); + let flow = DependencyFlow::checked(source, &function).unwrap(); + let (mut projected, flow) = flow + .project_tail(&function, TargetCapabilities::default()) + .unwrap(); + flow.verify(&projected).unwrap(); + projected.blocks[0].instructions.clear(); + assert!(flow.verify(&projected).is_err()); + } +} diff --git a/crates/psrs-backend/src/mir/state/tests.rs b/crates/psrs-backend/src/mir/state/tests.rs index be1dd861..234d8cb9 100644 --- a/crates/psrs-backend/src/mir/state/tests.rs +++ b/crates/psrs-backend/src/mir/state/tests.rs @@ -353,7 +353,11 @@ fn ordinary_state_calls_lower_and_execute_with_only_physical_payloads() { .instructions .iter() .filter(|instruction| matches!(instruction, Instruction::Call { .. })) - .count(), + .count() + + usize::from(matches!( + mir.functions[0].blocks[0].terminator, + Some(Terminator::ReturnCall { .. }) + )), 2 ); assert!( @@ -399,3 +403,17 @@ fn ordinary_state_calls_lower_and_execute_with_only_physical_payloads() { String::from_utf8_lossy(&output.stderr) ); } + +// These projection fixtures exercise the pre-tail correspondence contract. +// Tail conversion and mutation rejection have separate coverage in tail.rs. +pub(super) fn lower_without_tail_calls( + source: cc::Module, +) -> Result<(crate::mir::Module, crate::abi::WasiRegistry), Vec> { + crate::mir::lower_module_with_capabilities( + source, + crate::TargetCapabilities { + tail_call: false, + ..Default::default() + }, + ) +} diff --git a/crates/psrs-core/src/opt/specialize/callable_fields.rs b/crates/psrs-core/src/opt/specialize/callable_fields.rs new file mode 100644 index 00000000..4a712694 --- /dev/null +++ b/crates/psrs-core/src/opt/specialize/callable_fields.rs @@ -0,0 +1,67 @@ +//! Eligibility at declaration-owned callable storage boundaries. +//! +//! Specializing a generic body which opens or produces such a field changes +//! its use signature while the field's declared convention stays generic. +//! Until lowering can eliminate that round trip, retain the generic entry: +//! added result adapters can turn a constant-stack invocation into recursion +//! with post-call work. This is independent of State and library names. + +use crate::{Declaration, Module, Type, TypeConstructor, TypeId, arrow_parts}; +use std::collections::HashSet; + +pub(super) fn crosses_callable_field(module: &Module, declaration: &Declaration) -> bool { + // Examine each ordinary argument and the final result, rather than + // classifying the declaration's own outer arrows as stored callables. + let mut result = declaration.ty; + while let Some((parameter, next)) = arrow_parts(&module.types, result) { + if contains_callable_field(module, parameter, &mut HashSet::new()) { + return true; + } + result = next; + } + contains_callable_field(module, result, &mut HashSet::new()) +} + +fn contains_callable_field(module: &Module, ty: TypeId, seen: &mut HashSet) -> bool { + if !seen.insert(ty) { + return false; + } + if let Some((head, arguments)) = module.applied_constructor(ty) { + if let TypeConstructor::User(owner) = head { + for constructor in &module.constructors { + if constructor.type_id == owner + && constructor.field_types.iter().any(|field| { + arrow_parts(&module.types, *field).is_some() + || contains_callable_field(module, *field, seen) + }) + { + return true; + } + } + } + if arguments + .iter() + .any(|argument| contains_callable_field(module, *argument, seen)) + { + return true; + } + } + match module.types.get(ty.0 as usize) { + Some(Type::Application(function, argument)) => { + contains_callable_field(module, *function, seen) + || contains_callable_field(module, *argument, seen) + } + Some(Type::RowExtend { ty, tail, .. }) => { + contains_callable_field(module, *ty, seen) + || contains_callable_field(module, *tail, seen) + } + Some(Type::ForAll { body, .. }) => contains_callable_field(module, *body, seen), + Some(Type::Closure { parameters, result }) => { + parameters + .iter() + .any(|parameter| contains_callable_field(module, *parameter, seen)) + || contains_callable_field(module, *result, seen) + } + _ => false, + } +} diff --git a/crates/psrs-core/src/opt/specialize/mod.rs b/crates/psrs-core/src/opt/specialize/mod.rs index dd13c7e6..16f2fd3b 100644 --- a/crates/psrs-core/src/opt/specialize/mod.rs +++ b/crates/psrs-core/src/opt/specialize/mod.rs @@ -1,4 +1,5 @@ mod calls; +mod callable_fields; mod types; use super::{Budget, util::count_nodes}; @@ -63,6 +64,9 @@ impl State { call_type: crate::TypeId, pending: &mut Vec, ) -> Option { + if callable_fields::crosses_callable_field(module, declaration) { + return None; + } let (replacements, arguments) = match_instantiation(module, declaration, call_type)?; let key = Key { declaration: declaration.symbol, diff --git a/crates/psrs-core/src/state/flow/branches.rs b/crates/psrs-core/src/state/flow/branches.rs index 02e1d537..3fbd4254 100644 --- a/crates/psrs-core/src/state/flow/branches.rs +++ b/crates/psrs-core/src/state/flow/branches.rs @@ -168,12 +168,40 @@ impl<'a> Builder<'a> { .collect::>()?, ) } + ( + Value::Closure { + index, + captures: left, + }, + Value::Closure { + index: other, + mut captures, + }, + ) if index == other && left.len() == captures.len() => { + let mut merged = std::collections::HashMap::new(); + for (local, value) in left { + let other = captures.remove(&local).ok_or_else(|| { + self.error(span, "callback branch changes its lexical captures") + })?; + merged.insert(local, self.merge(value, other, span)?); + } + Value::Closure { + index, + captures: merged, + } + } (Value::State(_), _) | (_, Value::State(_)) => { return Err(self.error( span, "state branch result has incompatible producer provenance", )); } + (left, right) if left.carries_state() || right.carries_state() => { + return Err(self.error( + span, + "state branch result has incompatible producer provenance", + )); + } _ => Value::Opaque, }) } diff --git a/crates/psrs-core/src/state/flow/closure_tests.rs b/crates/psrs-core/src/state/flow/closure_tests.rs new file mode 100644 index 00000000..9a0d1814 --- /dev/null +++ b/crates/psrs-core/src/state/flow/closure_tests.rs @@ -0,0 +1,153 @@ +use super::tests::*; +use super::*; + +fn callback(body: Expr) -> Expr { + value( + ExprKind::Lambda { + binder: binder(9, 3), + body: Box::new(body), + }, + 16, + ) +} +fn call(id: u32, argument: Expr) -> Expr { + value( + ExprKind::Application(Box::new(local(id, 16)), Box::new(argument)), + 8, + ) +} +fn module(body: Expr) -> Module { + let mut module = fixture(body); + module + .types + .push(crate::Type::Application(TypeId(9), TypeId(3))); + module + .types + .push(crate::Type::Application(TypeId(15), TypeId(8))); + module +} + +#[test] +fn lexical_callback_consumes_its_captured_source_without_inventing_a_root() { + let module = module(let_value( + 2, + callback(invocation(local(0, 2))), + call(2, value(ExprKind::Integer(42), 3)), + )); + let flows = check(&module).unwrap(); + assert_eq!(flows.len(), 1); + assert_eq!(flows[0].operations.len(), 1); + assert_eq!(flows[0].operations[0].input, DependencyId(0)); + assert_eq!(flows[0].operations[0].output, DependencyId(1)); + flows[0].verify(&module).unwrap(); +} + +#[test] +fn creating_an_unused_callback_does_not_execute_its_body() { + let module = module(let_value( + 2, + callback(invocation(local(0, 2))), + step(local(0, 2)), + )); + let flows = check(&module).unwrap(); + assert!(flows[0].operations.is_empty()); +} + +#[test] +fn invoking_a_captured_predecessor_twice_rejects() { + let module = module(let_value( + 2, + callback(invocation(local(0, 2))), + let_value( + 3, + call(2, value(ExprKind::Integer(1), 3)), + call(2, value(ExprKind::Integer(2), 3)), + ), + )); + assert_eq!( + check(&module).unwrap_err()[0].message, + "state call consumes a stale dependency" + ); +} + +#[test] +fn a_callback_argument_executes_before_the_captured_body() { + let argument = let_value(3, invocation(local(0, 2)), value(ExprKind::Integer(42), 3)); + let module = module(let_value( + 2, + callback(invocation(local(0, 2))), + call(2, argument), + )); + assert_eq!( + check(&module).unwrap_err()[0].message, + "state call consumes a stale dependency" + ); +} + +#[test] +fn callback_aliases_survive_a_pure_choice_with_the_selected_root() { + let chosen = value( + ExprKind::If { + condition: Box::new(value(ExprKind::Boolean(true), 12)), + then_branch: Box::new(local(2, 16)), + else_branch: Box::new(local(2, 16)), + }, + 16, + ); + let module = module(let_value( + 2, + callback(invocation(local(0, 2))), + let_value(3, chosen, call(3, value(ExprKind::Integer(42), 3))), + )); + let flows = check(&module).unwrap(); + assert_eq!(flows[0].operations.len(), 1); + flows[0].verify(&module).unwrap(); +} + +#[test] +fn an_unknown_callback_consumer_cannot_hide_a_captured_state_operation() { + let consume = value( + ExprKind::Application( + Box::new(value( + ExprKind::Global(psrs_hir::SymbolId::new(ModuleId(0), 77)), + 18, + )), + Box::new(local(2, 16)), + ), + 3, + ); + let mut module = module(let_value( + 2, + callback(invocation(local(0, 2))), + let_value(3, consume, step(local(0, 2))), + )); + module + .types + .push(crate::Type::Application(TypeId(9), TypeId(16))); + module + .types + .push(crate::Type::Application(TypeId(17), TypeId(3))); + assert_eq!( + check(&module).unwrap_err()[0].message, + "state-carrying argument requires a checked invocation scope" + ); +} + +#[test] +fn callback_invocations_cannot_be_removed_from_a_valid_source_witness() { + let module = module(let_value( + 2, + callback(invocation(local(0, 2))), + call(2, value(ExprKind::Integer(42), 3)), + )); + let mut flows = check(&module).unwrap(); + let flow = &mut flows[0]; + flow.operations.clear(); + flow.graph.blocks[0].transitions.clear(); + flow.graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(0)]); + flow.graph.verify().unwrap(); + assert_eq!( + flow.verify(&module).unwrap_err().message, + "state graph changes executing source invocation order or coverage" + ); +} diff --git a/crates/psrs-core/src/state/flow/closures.rs b/crates/psrs-core/src/state/flow/closures.rs new file mode 100644 index 00000000..0da2a315 --- /dev/null +++ b/crates/psrs-core/src/state/flow/closures.rs @@ -0,0 +1,165 @@ +//! Lexical callback execution shares the caller's dependency path, not a root. +use super::{Builder, Path, Value}; +use crate::{Expr, ExprKind, VerifyError}; +use psrs_hir::LocalId; +use psrs_span::TextRange; +use std::collections::HashSet; + +impl<'a> Builder<'a> { + pub(super) fn closure(&mut self, expression: &'a Expr, path: &Path) -> Value { + let index = self.closures.len(); + self.closures.push(expression); + let mut free = HashSet::new(); + free_locals(expression, &HashSet::new(), &mut free); + Value::Closure { + index, + captures: path + .locals + .iter() + .filter(|(id, _)| free.contains(id)) + .map(|(id, value)| (*id, value.clone())) + .collect(), + } + } + + pub(super) fn invoke_closure( + &mut self, + function: Value, + argument: Value, + path: &mut Path, + span: TextRange, + ) -> Result { + let Value::Closure { + index, + mut captures, + } = function + else { + if argument.carries_state() { + return Err(self.error( + span, + "state-carrying argument requires a checked invocation scope", + )); + } + return Ok(Value::Opaque); + }; + if self.active_closures.contains(&index) { + return Err(self.error( + span, + "recursive captured callback requires checked loop transport", + )); + } + let ExprKind::Lambda { binder, body } = &self.closures[index].kind else { + unreachable!("closure registration requires a lambda"); + }; + for captured in captures.values_mut() { + captured.resolve(path); + } + captures.insert(binder.id, argument); + let caller = std::mem::replace(&mut path.locals, captures); + self.active_closures.push(index); + let result = self.eval(body, path); + self.active_closures.pop(); + path.locals = caller; + result + } +} + +fn free_locals(expr: &Expr, bound: &HashSet, free: &mut HashSet) { + psrs_span::with_sufficient_stack(|| { + let mut visit = |value| free_locals(value, bound, free); + match &expr.kind { + ExprKind::Local(id) if !bound.contains(id) => { + free.insert(*id); + } + ExprKind::Lambda { binder, body } => { + let mut scope = bound.clone(); + scope.insert(binder.id); + free_locals(body, &scope, free); + } + ExprKind::Let { bindings, body } => { + let mut scope = bound.clone(); + scope.extend(bindings.iter().map(|binding| binding.binder.id)); + for binding in bindings { + free_locals(&binding.value, &scope, free); + } + free_locals(body, &scope, free); + } + ExprKind::Case { + scrutinee, + branches, + } => { + visit(scrutinee); + for branch in branches { + let mut scope = bound.clone(); + bind_pattern(&branch.pattern, &mut scope); + free_locals(&branch.value, &scope, free); + } + } + ExprKind::Constructor { arguments, .. } + | ExprKind::IntrinsicCall { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => { + for argument in arguments { + visit(argument); + } + } + ExprKind::Record { fields } => { + for (_, value) in fields { + visit(value); + } + } + ExprKind::RecordUpdate { record, fields } => { + visit(record); + for (_, value) in fields { + visit(value); + } + } + ExprKind::FieldAccess { record, .. } + | ExprKind::RepresentationCast { value: record, .. } => visit(record), + ExprKind::Application(function, argument) => { + visit(function); + visit(argument); + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + visit(condition); + visit(then_branch); + visit(else_branch); + } + _ => {} + } + }); +} + +fn bind_pattern(pattern: &crate::Pattern, bound: &mut HashSet) { + use crate::PatternKind; + match &pattern.kind { + PatternKind::Var { id, .. } => { + bound.insert(*id); + } + PatternKind::Named { id, pattern } => { + bound.insert(*id); + bind_pattern(pattern, bound); + } + PatternKind::Constructor { arguments, .. } => { + for field in arguments { + bind_pattern(field, bound); + } + } + PatternKind::Record { fields } => { + for (_, field) in fields { + bind_pattern(field, bound); + } + } + PatternKind::Array { elements } => { + for element in elements { + bind_pattern(element, bound); + } + } + _ => {} + } +} diff --git a/crates/psrs-core/src/state/flow/eval.rs b/crates/psrs-core/src/state/flow/eval.rs index 08ac436b..b6123829 100644 --- a/crates/psrs-core/src/state/flow/eval.rs +++ b/crates/psrs-core/src/state/flow/eval.rs @@ -49,7 +49,8 @@ impl<'a> Builder<'a> { Value::Record(values) } ExprKind::Application(function, argument) => { - if matches!(self.eval(function, path)?, Value::Terminated) { + let callable = self.eval(function, path)?; + if matches!(callable, Value::Terminated) { return Ok(Value::Terminated); } let argument_value = self.eval(argument, path)?; @@ -81,7 +82,7 @@ impl<'a> Builder<'a> { ("value".into(), Value::Opaque), ])) } else { - Value::Opaque + self.invoke_closure(callable, argument_value, path, expression.span)? } } ExprKind::Let { bindings, body } => { @@ -145,6 +146,11 @@ impl<'a> Builder<'a> { || self.module.types_equivalent(value.ty, expression.ty) { evaluated + } else if evaluated.carries_state() { + return Err(self.error( + expression.span, + "state-carrying cast requires checked producer transport", + )); } else { Value::Opaque } @@ -154,15 +160,22 @@ impl<'a> Builder<'a> { elements: arguments, } => { for argument in arguments { - if matches!(self.eval(argument, path)?, Value::Terminated) { + let evaluated = self.eval(argument, path)?; + if matches!(evaluated, Value::Terminated) { return Ok(Value::Terminated); } + if evaluated.carries_state() { + return Err(self.error( + argument.span, + "state-carrying operand requires checked producer transport", + )); + } } Value::Opaque } ExprKind::Trap => Value::Terminated, - // A lambda is inert here. Its own execution scope is checked by - // scan, independently of the enclosing invocation's parameter. + // Construction retains lexical producers but executes nothing. + ExprKind::Lambda { .. } => self.closure(expression, path), _ => Value::Opaque, }; if crate::state::region(self.module, expression.ty).is_some() diff --git a/crates/psrs-core/src/state/flow/mod.rs b/crates/psrs-core/src/state/flow/mod.rs index 09ec7886..b8190924 100644 --- a/crates/psrs-core/src/state/flow/mod.rs +++ b/crates/psrs-core/src/state/flow/mod.rs @@ -9,6 +9,9 @@ use psrs_span::TextRange; use std::collections::HashMap; mod branches; +#[cfg(test)] +mod closure_tests; +mod closures; mod eval; mod scan; mod summary; @@ -66,10 +69,24 @@ enum Value { State(DependencyId), Record(HashMap), Constructor(Vec), + Closure { + index: usize, + captures: HashMap, + }, Terminated, } impl Value { + fn carries_state(&self) -> bool { + match self { + Self::State(_) => true, + Self::Record(fields) => fields.values().any(Self::carries_state), + Self::Constructor(fields) => fields.iter().any(Self::carries_state), + Self::Closure { captures, .. } => captures.values().any(Self::carries_state), + Self::Opaque | Self::Terminated => false, + } + } + fn state(&self) -> Option { if let Self::State(id) = self { Some(*id) @@ -91,6 +108,11 @@ impl Value { field.remap(old, new); } } + Self::Closure { captures, .. } => { + for value in captures.values_mut() { + value.remap(old, new); + } + } _ => {} } } @@ -108,6 +130,11 @@ impl Value { field.resolve(path); } } + Self::Closure { captures, .. } => { + for value in captures.values_mut() { + value.resolve(path); + } + } _ => {} } } @@ -141,6 +168,8 @@ struct Builder<'a> { next: u32, blocks: Vec, operations: Vec>, + closures: Vec<&'a Expr>, + active_closures: Vec, } impl<'a> Builder<'a> { @@ -263,6 +292,8 @@ fn derive<'a>( span: lambda.span, }], operations: Vec::new(), + closures: Vec::new(), + active_closures: Vec::new(), }; let mut path = Path { block: 0, diff --git a/crates/psrs-core/src/state/flow/tests.rs b/crates/psrs-core/src/state/flow/tests.rs index 47561e2f..a615d0b7 100644 --- a/crates/psrs-core/src/state/flow/tests.rs +++ b/crates/psrs-core/src/state/flow/tests.rs @@ -2,17 +2,17 @@ use super::*; use crate::{Binder, Binding, CaseBranch, Declaration, Pattern, PatternKind}; use psrs_hir::{CaseBranchCoverage, LocalId, SymbolId}; -fn value(kind: ExprKind, ty: u32) -> Expr { +pub(super) fn value(kind: ExprKind, ty: u32) -> Expr { Expr { kind, ty: TypeId(ty), span: TextRange::new(10, 20), } } -fn local(id: u32, ty: u32) -> Expr { +pub(super) fn local(id: u32, ty: u32) -> Expr { value(ExprKind::Local(LocalId(id)), ty) } -fn step(state: Expr) -> Expr { +pub(super) fn step(state: Expr) -> Expr { value( ExprKind::Record { fields: vec![ @@ -23,7 +23,7 @@ fn step(state: Expr) -> Expr { 8, ) } -fn binder(id: u32, ty: u32) -> Binder { +pub(super) fn binder(id: u32, ty: u32) -> Binder { Binder { id: LocalId(id), name: format!("v{id}"), @@ -40,13 +40,13 @@ fn action(body: Expr) -> Expr { 11, ) } -fn invocation(input: Expr) -> Expr { +pub(super) fn invocation(input: Expr) -> Expr { value( ExprKind::Application(Box::new(local(1, 11)), Box::new(input)), 8, ) } -fn field(id: u32) -> Expr { +pub(super) fn field(id: u32) -> Expr { value( ExprKind::FieldAccess { record: Box::new(local(id, 8)), @@ -55,7 +55,7 @@ fn field(id: u32) -> Expr { 2, ) } -fn let_value(id: u32, expression: Expr, body: Expr) -> Expr { +pub(super) fn let_value(id: u32, expression: Expr, body: Expr) -> Expr { let ty = expression.ty.0; let result = body.ty.0; value( @@ -71,7 +71,7 @@ fn let_value(id: u32, expression: Expr, body: Expr) -> Expr { result, ) } -fn fixture(body: Expr) -> Module { +pub(super) fn fixture(body: Expr) -> Module { let mut module = crate::state::tests::fixture(); module .types diff --git a/crates/psrs-core/src/state/flow/verify.rs b/crates/psrs-core/src/state/flow/verify.rs index 1acfb052..7bcfa41f 100644 --- a/crates/psrs-core/src/state/flow/verify.rs +++ b/crates/psrs-core/src/state/flow/verify.rs @@ -20,7 +20,7 @@ impl FunctionFlow<'_> { self.graph .verify() .map_err(|error| fail(error.span, error.message))?; - let ExprKind::Lambda { binder, body } = &self.lambda.kind else { + let ExprKind::Lambda { binder, .. } = &self.lambda.kind else { return Err(fail(self.lambda.span, "state flow has no source lambda")); }; let region = crate::state::region(module, binder.ty) @@ -34,9 +34,16 @@ impl FunctionFlow<'_> { "state graph changes its checked source region mapping", )); } - let mut expressions = HashSet::new(); - let mut invocations = Vec::new(); - executed(module, body, &mut expressions, &mut invocations); + // The source evaluator owns callback execution scopes and order. + // Re-derive before checking a witness; a syntax walk cannot distinguish + // closure construction from invocation through a lexical alias. + let expected = super::derive(module, self.owner, self.lambda)?; + let invocations = expected + .operations + .iter() + .map(|operation| operation.expression as *const Expr) + .collect::>(); + let expressions = invocations.iter().copied().collect::>(); let mut seen = HashSet::new(); for block in &self.graph.blocks { for transition in &block.transitions { @@ -80,7 +87,6 @@ impl FunctionFlow<'_> { // cannot authorize different argument provenance or branch placement. // A transformed IR needs its own correspondence verifier; it cannot // mutate this source certificate and retain a checked claim. - let expected = super::derive(module, self.owner, self.lambda)?; if self.graph != expected.graph { return Err(fail( self.lambda.span, @@ -128,71 +134,3 @@ impl FunctionFlow<'_> { Ok(()) } } - -fn executed( - module: &Module, - value: &Expr, - expressions: &mut HashSet<*const Expr>, - invocations: &mut Vec<*const Expr>, -) -> bool { - psrs_span::with_sufficient_stack(|| { - expressions.insert(value as *const Expr); - let mut visit = |value| executed(module, value, expressions, invocations); - match &value.kind { - ExprKind::Constructor { arguments, .. } - | ExprKind::IntrinsicCall { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => arguments.iter().all(visit), - ExprKind::Record { fields } => fields.iter().all(|(_, value)| visit(value)), - ExprKind::RecordUpdate { record, fields } => { - visit(record) && fields.iter().all(|(_, value)| visit(value)) - } - ExprKind::FieldAccess { record, .. } - | ExprKind::RepresentationCast { value: record, .. } => visit(record), - ExprKind::Application(function, argument) => { - if !visit(function) || !visit(argument) { - return false; - } - if crate::state::region(module, argument.ty).is_some() - && !super::summary::passthrough(module, function) - { - invocations.push(value as *const Expr); - } - true - } - ExprKind::Let { bindings, body } => { - bindings.iter().all(|binding| visit(&binding.value)) && visit(body) - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - if !visit(condition) { - return false; - } - let left = visit(then_branch); - let right = visit(else_branch); - left || right - } - ExprKind::Case { - scrutinee, - branches, - } => { - if !visit(scrutinee) { - return false; - } - let mut returns = false; - for branch in branches { - returns |= visit(&branch.value); - } - returns - } - // Closure creation is inert, so nested execution bodies do not - // supply transitions to this function's dependency graph. - ExprKind::Trap => false, - _ => true, - } - }) -} diff --git a/crates/psrs-driver/src/tests/state/mod.rs b/crates/psrs-driver/src/tests/state/mod.rs index 97005d87..ca1088be 100644 --- a/crates/psrs-driver/src/tests/state/mod.rs +++ b/crates/psrs-driver/src/tests/state/mod.rs @@ -6,7 +6,9 @@ mod command; mod host; mod runners; mod runtime_cc; +mod scoped_callbacks; mod storage_protocol; +mod zero_width_choices; fn state_flow_source(body: &str) -> String { format!( diff --git a/crates/psrs-driver/src/tests/state/runners.rs b/crates/psrs-driver/src/tests/state/runners.rs index d220ca74..4c502e14 100644 --- a/crates/psrs-driver/src/tests/state/runners.rs +++ b/crates/psrs-driver/src/tests/state/runners.rs @@ -188,11 +188,21 @@ fn runner_projection_rejects_removed_calls_and_changed_action_operands() { psrs_backend::mir::Instruction::ClosureCall { .. } ) }); + if matches!( + missing.functions[index].blocks[0].terminator, + Some(psrs_backend::mir::Terminator::ReturnCallRef { .. }) + ) { + missing.functions[index].blocks[0].terminator = Some(psrs_backend::mir::Terminator::Trap { + span: missing.functions[index].span, + }); + } assert!( psrs_backend::mir::verify_module(&missing) .unwrap_err() .iter() - .any(|error| error.message.contains("loses an invocation")) + .any(|error| error.pass == "P9 MIR dependency verification" + && (error.message.contains("loses an invocation") + || error.message.contains("tail conversion"))) ); let mut changed = mir; let function = &mut changed.functions[index]; @@ -209,11 +219,19 @@ fn runner_projection_rejects_removed_calls_and_changed_action_operands() { { *function = replacement; } + if let Some(psrs_backend::mir::Terminator::ReturnCallRef { + function: callee, .. + }) = &mut function.blocks[0].terminator + { + *callee = replacement; + } assert!( psrs_backend::mir::verify_module(&changed) .unwrap_err() .iter() - .any(|error| error.message.contains("invocation producer")) + .any(|error| error.pass == "P9 MIR dependency verification" + && (error.message.contains("invocation producer") + || error.message.contains("tail conversion"))) ); } diff --git a/crates/psrs-driver/src/tests/state/scoped_callbacks.rs b/crates/psrs-driver/src/tests/state/scoped_callbacks.rs new file mode 100644 index 00000000..80e00e30 --- /dev/null +++ b/crates/psrs-driver/src/tests/state/scoped_callbacks.rs @@ -0,0 +1,354 @@ +use super::*; + +const SOURCE: &str = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a + +action :: State RealWorld -> Step RealWorld Int +action state0 = + let next = \ignored -> read [42] 0 state0 + in next unit +main :: Int +main = execute action +"#; + +#[test] +fn lexical_state_callback_has_checked_core_producers_and_execution_scope() { + let module = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); + let flows = psrs_core::state::flow::check(&module).unwrap(); + assert_eq!(flows.len(), 1); + assert_eq!(flows[0].operations.len(), 1); + flows[0].verify(&module).unwrap(); +} + +#[test] +fn lexical_state_callback_has_checked_cc_capture_and_invocation_producers() { + let core = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); + let captured = flows + .iter() + .find(|flow| { + matches!( + flow.input, + Some(psrs_backend::cc::state::DependencySource::Capture { .. }) + ) + }) + .unwrap(); + assert_eq!(captured.operations.len(), 1); + for flow in flows { + flow.verify(&input.cc).unwrap(); + } +} + +#[test] +fn cc_rejects_replaying_the_same_captured_dependency() { + use psrs_backend::cc::{AssignmentKind, ValueDecl, ValueId}; + let core = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); + let mut module = psrs_backend::cc::lower_module(core).unwrap().cc; + let flows = psrs_backend::cc::state::check(&module).unwrap(); + let caller = flows + .iter() + .find(|flow| { + flow.operations.iter().any(|operation| { + matches!( + operation.assignment.kind, + AssignmentKind::IndirectCall { .. } + ) + }) + }) + .unwrap(); + let owner = caller.function.symbol; + let mut replay = caller + .operations + .iter() + .find(|operation| { + matches!( + operation.assignment.kind, + AssignmentKind::IndirectCall { .. } + ) + }) + .unwrap() + .assignment + .clone(); + drop(flows); + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == owner) + .unwrap(); + let index = function + .assignments + .iter() + .position(|assignment| assignment == &replay) + .unwrap(); + let ty = function + .values + .iter() + .find(|value| value.id == replay.destination) + .unwrap() + .ty; + replay.destination = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(ValueDecl { + id: replay.destination, + ty, + }); + function.assignments.insert(index + 1, replay); + let errors = psrs_backend::cc::state::check(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P8 CC state verification" + && error.message.contains("stale dependency")), + "{errors:?}" + ); +} + +#[test] +fn captured_cc_input_evidence_cannot_be_replaced_by_an_explicit_parameter() { + use psrs_backend::cc::state::DependencySource; + let core = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); + let module = psrs_backend::cc::lower_module(core).unwrap().cc; + let mut flows = psrs_backend::cc::state::check(&module).unwrap(); + let flow = flows + .iter_mut() + .find(|flow| matches!(flow.input, Some(DependencySource::Capture { .. }))) + .unwrap(); + flow.input = Some(DependencySource::Parameter(flow.function.parameters[0])); + let errors = flow.verify(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("instruction provenance")) + ); +} + +#[test] +fn captured_dependency_remains_checked_across_exclusive_cc_branches() { + let source = SOURCE.replace( + "read [42] 0 state0", + "if true then read [42] 0 state0 else read [43] 0 state0", + ); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let module = psrs_backend::cc::lower_module(core).unwrap().cc; + let flows = psrs_backend::cc::state::check(&module).unwrap(); + let captured = flows + .iter() + .find(|flow| { + matches!( + flow.input, + Some(psrs_backend::cc::state::DependencySource::Capture { .. }) + ) + }) + .unwrap(); + assert_eq!(captured.operations.len(), 2); + assert_eq!(captured.graph.blocks.len(), 4); + captured.verify(&module).unwrap(); +} + +#[test] +fn captured_state_callbacks_execute_with_zero_width_and_mixed_capture_slots() { + for body in [ + "\n let next = \\ignored -> read [42] 0 state0\n in next unit", + "\n let items = [42]\n next = \\ignored -> read items 0 state0\n in next unit", + "\n let items = [42]\n next = \\ignored -> case read [0] 0 state0 of\n { state: state1, value: unused } -> read items 0 state1\n in next unit", + "\n let items = [42]\n index = 0\n next = \\ignored -> case read [0] 0 state0 of\n { state: state1, value: unused } -> read items index state1\n in next unit", + ] { + let source = state_flow_source(body); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{source}\n{output:?}"); + assert!(output.stdout.is_empty()); + assert!(output.stderr.is_empty()); + } +} + +#[test] +fn mir_capture_projection_rejects_type_correct_operand_and_slot_mutations() { + use psrs_backend::{TargetCapabilities, mir}; + let source = state_flow_source( + "\n let items = [42]\n other = [43]\n next = \\ignored -> case read [0] 0 state0 of\n { state: state1, value: unused } -> case read items 0 state1 of\n { state: state2, value: first } -> read other 0 state2\n in next unit", + ); + let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let input = psrs_backend::cc::lower_module(core).unwrap(); + let (module, _) = + mir::lower_module_with_bindings(input.cc, input.externals, TargetCapabilities::default()) + .unwrap(); + mir::verify_module(&module).unwrap(); + for change_slot in [false, true] { + let mut mutated = module.clone(); + let instruction = mutated.functions.iter_mut().flat_map(|function| &mut function.blocks) + .flat_map(|block| &mut block.instructions).find(|instruction| if change_slot { + matches!(instruction, mir::Instruction::ClosureGetCapture { index: 0, .. }) + } else { + matches!(instruction, mir::Instruction::ClosureNew { captures, .. } if captures.len() == 2) + }).unwrap(); + match instruction { + mir::Instruction::ClosureNew { captures, .. } => captures.swap(0, 1), + mir::Instruction::ClosureGetCapture { index, .. } => *index = 1, + _ => unreachable!(), + } + let errors = mir::verify_module(&mutated).unwrap_err(); + assert!( + errors + .iter() + .all(|error| error.pass == "P9 MIR dependency verification"), + "{errors:?}" + ); + assert!( + errors + .iter() + .any(|error| error.message.contains("capture projection") + || error.message.contains("tail conversion")), + "{errors:?}" + ); + } +} + +#[test] +fn captured_callbacks_keep_selected_branches_and_nonreturning_operations() { + for (flag, trap, expected) in [ + (1, false, 42), + (2, false, 43), + (1, true, 134), + (2, true, 43), + ] { + let body = format!( + "\n case read [{flag}] 0 state0 of\n {{ state: state1, value: flag }} ->\n let items = [42]\n other = [43]\n next = \\ignored -> if eqInt flag 1 then read items 0 state1 else read other 0 state1\n in next unit" + ); + let mut source = state_flow_source(&body).replace( + "action ::", + "foreign import \"psrs:intrinsic#intEq\" eqInt :: Int -> Int -> Boolean\naction ::", + ); + if trap { + source = source.replace("action ::", "foreign import \"psrs:runtime-storage#trap\" abort :: State RealWorld -> Step RealWorld Int\naction ::") + .replace("then read items 0 state1", "then abort state1"); + } + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(expected), "{source}\n{output:?}"); + if expected == 134 { + assert!(String::from_utf8_lossy(&output.stderr).contains("unreachable")); + } + } +} + +#[test] +fn constructing_an_unused_trapping_capture_does_not_execute_it() { + let source = state_flow_source("\n let next = \\ignored -> abort state0\n in { state: state0, value: 42 }") + .replace("action ::", "foreign import \"psrs:runtime-storage#trap\" abort :: State RealWorld -> Step RealWorld Int\naction ::"); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert!(output.stderr.is_empty()); +} + +#[test] +fn construction_does_not_execute_a_state_capturing_callback() { + let source = SOURCE.replace("in next unit", "in { state: state0, value: 42 }"); + let module = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let flows = psrs_core::state::flow::check(&module).unwrap(); + assert_eq!(flows.len(), 1); + assert!(flows[0].operations.is_empty()); +} + +#[test] +fn a_scoped_callback_cannot_replay_its_captured_predecessor() { + let source = SOURCE.replace( + "in next unit", + "in case read [0] 0 state0 of\n { state: advanced, value: ignored } -> next unit", + ); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage.starts_with("P7") + && error.diagnostic.message.contains("stale dependency")), + "{errors:?}" + ); +} + +#[test] +fn nested_lexical_callback_invocation_preserves_the_captured_producer() { + let source = SOURCE.replace( + "in next unit", + " apply = \\callback -> callback unit\n in apply next", + ); + let module = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); + let flows = psrs_core::state::flow::check(&module).unwrap(); + assert_eq!(flows.len(), 1); + assert_eq!(flows[0].operations.len(), 1); + flows[0].verify(&module).unwrap(); +} + +#[test] +fn an_unchecked_global_callback_scope_cannot_discard_a_state_transition() { + let source = SOURCE + .replace( + "action ::", + "consume :: (Unit -> Step RealWorld Int) -> Int\nconsume callback = (callback unit).value\n\naction ::", + ) + .replace( + "in next unit", + " ignored = consume next\n in { state: state0, value: ignored }", + ); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage.starts_with("P7") + && error + .diagnostic + .message + .contains("checked invocation scope")), + "{errors:?}" + ); +} + +#[test] +fn a_choice_of_captured_callbacks_cannot_erase_dependency_provenance() { + let source = SOURCE.replace( + "in next unit", + " chosen = (if true then next else (\\ignored -> read [43] 0 state0))\n result = chosen unit\n in { state: state0, value: result.value }", + ); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage.starts_with("P7") + && error.diagnostic.message.contains("producer provenance")), + "{errors:?}" + ); +} + +#[test] +fn an_opaque_array_cannot_hide_a_captured_state_producer() { + let source = SOURCE.replace( + "in next unit", + " callbacks = [next]\n in { state: state0, value: 42 }", + ); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage.starts_with("P7") + && error + .diagnostic + .message + .contains("checked producer transport")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/state/zero_width_choices.rs b/crates/psrs-driver/src/tests/state/zero_width_choices.rs new file mode 100644 index 00000000..f2daea14 --- /dev/null +++ b/crates/psrs-driver/src/tests/state/zero_width_choices.rs @@ -0,0 +1,82 @@ +use super::*; + +fn source(flag: i32, choice: &str) -> String { + SOURCE.replace("[1]", &format!("[{flag}]")) + .replace("if eqInt flag 1 then\n case write values 0 42 initial of\n { state: next, value: ignored } -> next\n else case write values 0 43 initial of\n { state: next, value: ignored } -> next", choice) +} + +const SOURCE: &str = r#"module Main where +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_write" write :: Array Int -> Int -> Int -> State RealWorld -> Step RealWorld Unit +foreign import "psrs:runtime-storage#array_read" read :: Array Int -> Int -> State RealWorld -> Step RealWorld Int + +foreign import "psrs:intrinsic#intEq" eqInt :: Int -> Int -> Boolean +action :: State RealWorld -> Step RealWorld Int +action state0 = case read [1] 0 state0 of + { state: initial, value: flag } -> + let values = [0] + state1 = if eqInt flag 1 then + case write values 0 42 initial of + { state: next, value: ignored } -> next + else case write values 0 43 initial of + { state: next, value: ignored } -> next + in read values 0 state1 +main :: Int +main = execute action +"#; + +const BINARY: &str = "if eqInt flag 1 then\n case write values 0 42 initial of\n { state: next, value: ignored } -> next\n else case write values 0 43 initial of\n { state: next, value: ignored } -> next"; +const SWITCH: &str = "case flag of\n 1 -> case write values 0 42 initial of\n { state: next, value: ignored } -> next\n 2 -> case write values 0 43 initial of\n { state: next, value: ignored } -> next\n _ -> case write values 0 44 initial of\n { state: next, value: ignored } -> next"; + +#[test] +fn zero_width_choice_results_keep_selected_mutation_and_successor() { + for (choice, flag, expected) in [ + (BINARY, 1, 42), + (BINARY, 2, 43), + (SWITCH, 1, 42), + (SWITCH, 2, 43), + (SWITCH, 3, 44), + ] { + let source = source(flag, choice); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(expected), "{source}\n{output:?}"); + } +} + +#[test] +fn zero_width_choice_preserves_selected_nonreturning_arms() { + for (flag, expected) in [(1, 134), (2, 43)] { + let source = source(flag, BINARY) + .replace( + "action ::", + "foreign import \"psrs:runtime-storage#trap\" abort :: State RealWorld -> Step RealWorld Unit\naction ::", + ) + .replace("case write values 0 42 initial of", "case abort initial of"); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(expected), "{source}\n{output:?}"); + if flag == 1 { + assert!(String::from_utf8_lossy(&output.stderr).contains("unreachable")); + } + } +} + +#[test] +fn zero_width_choice_cannot_replay_its_observable_predecessor() { + for choice in [BINARY, SWITCH] { + let source = + source(1, choice).replace("in read values 0 state1", "in read values 0 initial"); + let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage.starts_with("P7")), + "{errors:?}" + ); + } +} diff --git a/crates/psrs-driver/src/tests/tail_calls.rs b/crates/psrs-driver/src/tests/tail_calls.rs index 9434ce5a..05d686e4 100644 --- a/crates/psrs-driver/src/tests/tail_calls.rs +++ b/crates/psrs-driver/src/tests/tail_calls.rs @@ -3,7 +3,7 @@ //! Self tail recursion is loopified on every profile, so a deep self-recursive //! program runs in constant stack. Non-self tail calls become `return_call` / //! `return_call_ref` only when the target enables the tail-call proposal; the -//! stable profile keeps them as ordinary calls plus return. +//! stable profile enables both instructions. use psrs_backend::TargetCapabilities; use psrs_backend::mir::Terminator; @@ -67,9 +67,15 @@ fn has_return_call_ref(mir: &psrs_backend::mir::Module) -> bool { #[test] fn self_tail_recursion_runs_in_constant_stack() { // 100000 frames would exhaust the default Wasmtime stack; loopification - // must make this a `loop` on the tail-call-disabled stable profile. + // must make this a `loop` even on a profile with tail calls disabled. let source = "module Main where\nimport Prelude\ncount :: Int -> Int\ncount n = if n == 0 then 42 else count (n - 1)\nmain = count 100000\n"; - let stages = compile_with(source, TargetCapabilities::default()); + let stages = compile_with( + source, + TargetCapabilities { + tail_call: false, + ..TargetCapabilities::default() + }, + ); assert!( !has_tail_call(&stages.mir), "self-recursion must become a loop, not a return_call" @@ -84,10 +90,7 @@ fn self_tail_recursion_runs_in_constant_stack() { #[test] fn non_self_tail_calls_use_return_call_when_enabled() { let source = "module Main where\nimport Prelude\neven :: Int -> Int\neven n = if n == 0 then 42 else odd (n - 1)\nodd :: Int -> Int\nodd n = if n == 0 then 7 else even (n - 1)\nmain = even 100000\n"; - let target = TargetCapabilities { - tail_call: true, - ..TargetCapabilities::default() - }; + let target = TargetCapabilities::default(); let stages = compile_with(source, target); assert!( has_tail_call(&stages.mir), @@ -110,10 +113,7 @@ fn indirect_tail_recursion_uses_return_call_ref() { // With 100000 iterations this only succeeds if the reference tail call // reuses the frame. let source = "module Main where\nimport Prelude\nrun :: (Int -> Int) -> Int -> Int\nrun step n = if n == 0 then 42 else step (n - 1)\ntick :: Int -> Int\ntick n = run tick n\nmain = tick 100000\n"; - let target = TargetCapabilities { - tail_call: true, - ..TargetCapabilities::default() - }; + let target = TargetCapabilities::default(); let stages = compile_with(source, target); assert!( has_return_call_ref(&stages.mir), @@ -133,7 +133,13 @@ fn indirect_tail_recursion_uses_return_call_ref() { #[test] fn disabled_profile_keeps_an_ordinary_call() { let source = "module Main where\nimport Prelude\nf :: Int -> Int\nf x = g x\ng :: Int -> Int\ng x = x + 1\nmain = f 41\n"; - let stages = compile_with(source, TargetCapabilities::default()); + let stages = compile_with( + source, + TargetCapabilities { + tail_call: false, + ..TargetCapabilities::default() + }, + ); assert!( !has_tail_call(&stages.mir), "a disabled profile must not emit a tail-call terminator" @@ -148,3 +154,153 @@ fn disabled_profile_keeps_an_ordinary_call() { Err(error) => panic!("{error}"), } } + +#[test] +fn state_self_tail_recursion_preserves_zero_width_dependencies() { + let source = r#"module Main where +import Prelude +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" run :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a +count :: Int -> State RealWorld -> Step RealWorld Int +count n state = if n == 0 then read [42] 0 state else count (n - 1) state +main :: Int +main = run (count 100000) +"#; + let stages = compile_with(source, TargetCapabilities::default()); + assert!( + stages + .mir + .functions + .iter() + .any(|function| function.state.is_some()) + ); + match execute_component("state_self_tail_loop", &stages.artifact.wasm) { + Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), + Ok(None) => {} + Err(error) => panic!("{error}"), + } +} + +// This uses an unrelated ordinary newtype to cover the specialization +// regression independently of the public Effect.forE case. +#[test] +fn ordinary_state_newtype_bind_loops_run_in_constant_stack() { + let source = r#"module Main where +import Prelude +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +newtype Task a = Task (State RealWorld -> Step RealWorld a) +foreign import "psrs:intrinsic#runWorld" run :: forall a. (State RealWorld -> Step RealWorld a) -> a +pureTask :: forall a. a -> Task a +pureTask value = Task \state -> { state: state, value: value } +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task action) next = Task \state0 -> + case action state0 of + { state: state1, value: value } -> case next value of + Task continuation -> continuation state1 +loopTask :: Int -> Task Unit +loopTask n = if n == 0 then pureTask unit + else bindTask (pureTask unit) (\_ -> loopTask (n - 1)) +execute :: forall a. Task a -> a +execute (Task action) = run action +main :: Int +main = execute (bindTask (loopTask 100000) (\_ -> pureTask 42)) +"#; + let stages = compile_with(source, TargetCapabilities::default()); + assert!(has_return_call_ref(&stages.mir)); + match execute_component("state_newtype_bind_loop", &stages.artifact.wasm) { + Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), + Ok(None) => {} + Err(error) => panic!("{error}"), + } +} + +#[test] +fn ordinary_pure_newtype_bind_loops_run_in_constant_stack() { + let source = r#"module Main where +import Prelude +newtype Task a = Task (Unit -> a) +pureTask :: forall a. a -> Task a +pureTask value = Task \_ -> value +bindTask :: forall a b. Task a -> (a -> Task b) -> Task b +bindTask (Task action) next = Task \token -> + case next (action token) of + Task continuation -> continuation token +loopTask :: Int -> Task Unit +loopTask n = if n == 0 then pureTask unit + else bindTask (pureTask unit) (\_ -> loopTask (n - 1)) +execute :: forall a. Task a -> a +execute (Task action) = action unit +main :: Int +main = execute (bindTask (loopTask 100000) (\_ -> pureTask 42)) +"#; + let stages = compile_with(source, TargetCapabilities::default()); + assert!(has_return_call_ref(&stages.mir)); + match execute_component("pure_newtype_bind_loop", &stages.artifact.wasm) { + Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), + Ok(None) => {} + Err(error) => panic!("{error}"), + } +} + +#[test] +fn self_tail_recursion_remaps_forwarded_arguments() { + let source = "module Main where\nimport Prelude\nrotate :: Int -> Int -> Int -> Int\nrotate n a b = if n == 0 then a else rotate (n - 1) b a\nmain = rotate 100000 42 7\n"; + let stages = compile_with(source, TargetCapabilities::default()); + match execute_component("tail_loop_forwarded_arguments", &stages.artifact.wasm) { + Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), + Ok(None) => {} + Err(error) => panic!("{error}"), + } +} + +#[test] +fn state_mutual_tail_recursion_preserves_every_storage_update() { + let source = r#"module Main where +import Prelude +import Prim.State (State, RealWorld) +type Step s a = { state :: State s, value :: a } +foreign import "psrs:intrinsic#runWorld" run :: forall a. (State RealWorld -> Step RealWorld a) -> a +foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a +foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit +even :: Int -> Array Int -> State RealWorld -> Step RealWorld Int +even n cell state = if n == 0 then + case read cell 0 state of + { state: finalState, value: value } -> + { state: finalState, value: if value == 150000 then 42 else 0 } + else case read cell 0 state of + { state: readState, value: value } -> + case write cell 0 (value + 1) readState of + { state: writeState } -> odd (n - 1) cell writeState +odd :: Int -> Array Int -> State RealWorld -> Step RealWorld Int +odd n cell state = case read cell 0 state of + { state: readState, value: value } -> + case write cell 0 (value + 2) readState of + { state: writeState } -> even (n - 1) cell writeState +main :: Int +main = run (\state -> even 100000 [0] state) +"#; + let stages = compile_with(source, TargetCapabilities::default()); + for name in ["even", "odd"] { + let function = stages + .mir + .functions + .iter() + .find(|function| function.name == name) + .expect("mutual State functions must remain reachable"); + assert!(function.state.is_some()); + assert!( + function + .blocks + .iter() + .any(|block| { matches!(block.terminator, Some(Terminator::ReturnCall { .. })) }) + ); + } + match execute_component("state_mutual_updates", &stages.artifact.wasm) { + Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), + Ok(None) => {} + Err(error) => panic!("{error}"), + } +} diff --git a/docs/decision/DEC-05-wasmtime-feature-set.md b/docs/decision/DEC-05-wasmtime-feature-set.md index ba9ad715..ba9d1a3f 100644 --- a/docs/decision/DEC-05-wasmtime-feature-set.md +++ b/docs/decision/DEC-05-wasmtime-feature-set.md @@ -30,8 +30,9 @@ can execute. The default profile is - The backend may emit only features enabled in the selected profile. The stable profile requires MVP Wasm plus the GC/reference/function-reference - subset used by the current runtime representation and the Component Model - with WASI 0.2. SIMD, tail calls, exceptions, threads, multi-memory, + subset used by the current runtime representation, tail calls for stack-safe + callable execution, and the Component Model with WASI 0.2. SIMD, exceptions, + threads, multi-memory, memory64, wide arithmetic, async components, and WASI 0.3 remain disabled. - A proposal is not `Implemented` because Wasmtime accepts it. It needs a lowering, profile validation, regression tests, and observable execution diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index 5b275fe3..428528aa 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -55,6 +55,8 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [control-flow-and-tail-calls.md](fp/control-flow-and-tail-calls.md) | CFG structuring, `Switch`, tail calls | mir | | [type-classes-and-dictionaries.md](fp/type-classes-and-dictionaries.md) | Dictionary passing and instance evidence | functional-core | | [effects.md](fp/effects.md) | Effect representation and the platform boundary | functional-core | +| [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics, cross-pass dependencies, optimizer transfers and checked zero-width erasure (Draft) | primitive types, functional-core, CC, MIR | +| [library-owned-effects.md](fp/library-owned-effects.md) | Ordinary Effect/ST newtypes, runtime adapters, command runner and migration acceptance (Draft) | State primitives and dependency lowering, source fidelity | ### Wasm/WASI (`wasm/`) diff --git a/docs/design/backend/fp/cc-ir.md b/docs/design/backend/fp/cc-ir.md index 64a33916..2100e1cd 100644 --- a/docs/design/backend/fp/cc-ir.md +++ b/docs/design/backend/fp/cc-ir.md @@ -1,9 +1,10 @@ # CC IR: ANF and Closure Conversion -> **Selected extension:** [library-owned effects and state dependencies](library-owned-effects.md) -> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies -> and checked zero-width projection. Implementation and acceptance evidence -> have not migrated; the existing contracts below remain the implementation baseline. +> **Selected extension:** [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) +> owns primitive State contracts, preserved dependencies and checked zero-width +> projection. [Library-owned effects](library-owned-effects.md) owns the +> library adaptation. Coverage remains partial; see the +> [implementation checklist](../../../implementation/backend/library-owned-effects.md). **Feature:** F-02 **Status:** Stable (design) diff --git a/docs/design/backend/fp/control-flow-and-tail-calls.md b/docs/design/backend/fp/control-flow-and-tail-calls.md index ba506b36..6279e28a 100644 --- a/docs/design/backend/fp/control-flow-and-tail-calls.md +++ b/docs/design/backend/fp/control-flow-and-tail-calls.md @@ -187,13 +187,25 @@ with the tail-call proposal disabled. Non-self tail calls use ### Tail calls and the capability profile -Tail calls are a target capability: the stable profile currently disables them +Tail calls are a target capability: the stable profile enables them ([capability profile](../wasm/capability-profile.md), [DEC-05](../../../decision/DEC-05-wasmtime-feature-set.md)). Enabling the -emission path requires revising that profile to expose `tail_call` and adding -execution evidence; the lowering must not emit a `return_call*` when the flag is +emission path uses the explicit `tail_call` profile flag and runtime evidence; +the lowering must not emit a `return_call*` when the flag is off, and must fall back to an ordinary call plus return. +The profile enables physical tail calls whose result is returned unchanged. +It does not establish constant-stack execution for every source tail position. +An erased/concrete function adapter may call its producer and then box, recover +or rebuild the result. That producer invocation has a continuation and cannot +be replaced with `return_call*` by dropping its result conversion. The shared +[polymorphic callable representation](polymorphism-and-erasure.md) and +[Core optimization](../opt/core.md) own removal or prevention of redundant +adaptation. State dependency transfer verifies a legal physical tail rewrite; +it does not authorize a different result representation or erase post-call +work. Execution evidence must distinguish direct/reference physical tail calls +from source recursion through such adapters. + ### Rejected alternatives - **Keep `merge_block` diamonds.** Rejected: they cannot encode loops, and they @@ -603,8 +615,14 @@ specific areas: closure call becomes `ReturnCallRef` after projecting the code reference and passing the closure as the receiver. When the flag is disabled, the call is left as an ordinary call plus return and the verifier rejects a forced - `ReturnCall*`. The stable profile keeps the flag disabled; the enabled path is - exercised by driver tests under an explicit `tail_call` profile. + `ReturnCall*`. The stable profile enables the flag; driver tests cover deep + direct, indirect and State self-recursion under that default + and retain an explicitly disabled-profile regression. +- State-bearing functions retain immutable pre-tail physical MIR tied to their + checked CC source. Verification replays the common tail rewrite and compares + the actual instructions/control with that conversion; independently checked + scalar folding and function-position compaction remain admissible. This is a + bounded transfer contract, not general arbitrary CFG optimization support. ## References diff --git a/docs/design/backend/fp/effects.md b/docs/design/backend/fp/effects.md index ccf2bbdf..8fb24f44 100644 --- a/docs/design/backend/fp/effects.md +++ b/docs/design/backend/fp/effects.md @@ -1,8 +1,9 @@ # Effects -> **Selected revision:** [library-owned effects and state dependencies](library-owned-effects.md) +> **Selected revision:** [library-owned effects](library-owned-effects.md) > replaces the Effect-specific token contract with a library newtype and generic -> state dependencies, with executable storage and termination owned by +> state dependencies governed by [the State topic](state-primitives-and-dependency-lowering.md), +> with executable storage and termination owned by > `psrs-runtime` and combinators owned by stdlib. Integrated acceptance has not migrated; > this document retains the existing contract pending that migration. diff --git a/docs/design/backend/fp/library-owned-effects.md b/docs/design/backend/fp/library-owned-effects.md index 63f59fac..bd8b277c 100644 --- a/docs/design/backend/fp/library-owned-effects.md +++ b/docs/design/backend/fp/library-owned-effects.md @@ -1,10 +1,11 @@ -# Library-Owned Effects and State Dependencies +# Library-Owned Effects **Feature:** [F-02](../../../feature/F-02-portable-programs.md) **Status:** Draft design; newtype and state-dependency direction selected, implementation migration in progress. Coverage is recorded in the [implementation checklist](../../../implementation/backend/library-owned-effects.md). -**Prerequisites:** [effects](effects.md), [representation and evidence](representation-and-evidence.md), +**Prerequisites:** [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md), +[effects](effects.md), [representation and evidence](representation-and-evidence.md), [primitive types](../../frontend/type-system/prim.md), [foreign imports](../../frontend/semantics/foreign-imports.md), [primitive bindings](../wasm/primitive-ffi-and-stdlib.md), @@ -172,53 +173,13 @@ unchecked library coercions and unsafe execution remain explicit trust boundarie returns a second action after one action. Neither payload becomes extra parameters of the outer state-transforming callable. -### General primitive contracts +### Primitive execution boundary -Proposed registry operations are named here by responsibility; exact Rust and -binding names must follow the single intrinsic catalog. Do not add implicit -bootstrap exports of unsafe operations. - -```text -runWorld :: forall a. - (State RealWorld -> Step RealWorld a) -> a -runRegion :: forall a. - (forall s. State s -> Step s a) -> a -``` - -runWorld starts one dynamic execution, supplies its root dependency, invokes -the supplied function once and discharges its returned state before yielding -the payload. It is an unsafe execution boundary used by the library unsafe -runner and command adapter, not a purity proof. runRegion introduces a fresh -scoped region, invokes the rank-N body once and checks that the region does -not escape in the result. No arbitrary initial State literal is exposed. -Nested and repeated executions retain distinct dynamic invocation boundaries. - -Mutation and reads of mutable storage use state-aware checked primitives, for -example a private cell operation has the schematic shape: - -```text -readCell :: forall s a. Cell s a -> State s -> Step s a -writeCell :: forall s a. Cell s a -> a -> State s -> Step s Unit -``` - -Cell is library owned. Actual storage bindings use their existing checked -storage operands; a primitive scheme may not presume the identity or layout of -Cell. New storage allocation, mutable reads, writes and unsafe freezing all -participate in the dependency protocol. Pure array operations retain their -existing pure contracts; reading mutable backing storage must not be classified -as pure merely because immutable array indexing is pure. - -Generic execution primitive descriptors and checked target binding contracts -own dependency inputs/results, observable effects and trap behavior. Source -schemes, kind/role checks, Core elaboration and verifiers consume these contracts. -Backend binding metadata keeps runtime provider/export identity, source module, -span and the checked Core scheme identity beside target-neutral CC. Extraction -must retain every runtime binding; boundary validation rejects missing, -duplicated or substituted records. Keeping a raw binding record does not mean -its call has been projected or checked against a physical instruction sequence. -Returning an ordinary record containing -the same input State is not enough to implement an observable primitive: its -checked operation must establish a successor dependency. +[State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) +owns runWorld/runRegion signatures, root/region rules and checked operation +successors. Effect.Unsafe executes through runWorld; PSRS.ST uses runRegion. +Storage operations remain ordinary checked runtime bindings, not additional +Effect or storage-specific HIR intrinsics. ## Design @@ -390,99 +351,20 @@ at this audited boundary and calls runWorld. It does not cast State to Int, fabricate a token or bypass dependency verification. Common unsafe callable transport must preserve the logical signature and execute correctly. -### Checked dependencies across representations - -Typed Core preserves source State applications, roles and primitive contracts. -Its state-operation verifier checks input/output shapes, region identity, -producer provenance, normal-return state and dependency scope. Ordinary functions -are checked from their bodies; an external or abstract callable needs a checked -state signature contract. MIR retains checked source requirements in an immutable -module inventory independent of mutable per-function evidence. Every retained -function must satisfy its source requirement; deleting an optional witness must -not disable verification. Unused whole functions may be pruned without changing -the requirements of surviving functions. Missing required evidence is an error, not a fresh -state or assumed-pure operation. - -Core body evidence is tied to its immutable source arena. It derives transitions -from actual invocation nodes and tracks their argument and returned-field -provenance through ordinary aliases, record patterns and control-flow joins. -Verification checks invocation coverage and order, region/payload contracts and -branch placement in addition to standalone graph validity. A proven pure body -may pass its incoming dependency through unchanged; an unknown invocation stays -conservatively observable. Pure joins preserve aliases already evaluated before -the join. Core transformations invalidate old body evidence and recheck the -resulting source representation before later projection can consume it. - -CC makes the dependency chain explicit alongside ordinary evaluation order. -Each observable state operation defines an output dependency referring to its -input. Calls retain checked state inputs/results through dictionaries, erased -closures and higher-kinded instantiation. Conditional joins select the dependency -from the executed branch; loops carry it as a loop parameter. The returned -state must be downstream of the observable operations executed on that path. -Unknown calls and unsafe execution remain conservatively observable. - -Verification does not claim a general linear source type system. It rejects -malformed chains, region mixing and an unsupported fork that would discard or -replay a predecessor around observable operations. Branch-exclusive uses and -pure state pass-through are valid. A library closure may execute repeatedly; -each invocation threads the state supplied for that invocation. Support for a -raw-state transport shape must be checked across its actual fields, captures, -products and calls; unsupported shapes fail explicitly rather than materializing -a placeholder token or erasing the dependency. - -MIR fixes physical representation and keeps a checked dependency projection -for instructions, calls, block joins and loop edges. Dependency identities are -not Wasm value types or integer locals. Their definitions/uses are explicit MIR -structure, not a name-based side table reconstructed by the encoder. MIR -verification establishes dominance, region agreement, call contract consistency, -and control-flow preservation of the dependency chain. - -The existing representation planner owns the source/logical-to-physical mapping. -State maps to zero payload slots; Step's state field contributes no storage. -At a known state-call boundary, the result projects to the payload and requires -no Step record allocation. Common aggregate and erased transport may use an -ordinary payload container when required; it must not lose logical dependency -evidence or silently change callable conventions. No full GHC unboxed-tuple -syntax or global allocation-free claim is introduced. - -Physical parameter removal occurs only through checked signature projection, -shared by producers, consumers, partial applications and adapters. State -parameters are zero-width while their logical invocation and dependency remain. -Core owns call-boundary extraction for arrows, fixed-arity closures and quantified -results. The representation planner consumes that boundary and the checked State -signature, retaining its source arena and region while projecting only payload -types into physical slots. A signature plan alone cannot discharge invocation dependencies. -For ordinary direct and indirect calls, MIR correspondence preserves every -non-State operand identity, order and occurrence from immutable CC. It removes -only operands whose checked CC declarations have State shape. Changing an -operand to another value of the same physical type still invalidates the -certificate. ABI conversions require their own checked correspondence rather -than relaxing this ordinary-call invariant. -A nullary physical host call stays a call inside the action body, not a global -initializer. Immutable checked source Core is not mutated into a physical type -model; the lowering carries its explicit relation to CC/MIR. - -### Optimization and final erasure - -Core and MIR transformations preserve dependency edges, dynamic multiplicity, -branch/loop placement and observable call/trap behavior. Unused payloads do not -permit removal of their operation. State pass-through for a pure action is -simplifiable; a state-producing host/mutation operation is never replaced by -its input State. Inlining preserves argument order and reconnects dependencies -using fresh local identities. CSE, code motion, dead-code elimination and loop -optimizations require evidence covering both dependencies and observable effects. - -Zero-width representation does not make a state operation pure. Observable-effect -metadata remains necessary after physical projection and for calls outside the -state protocol. Dependencies do not promise rollback, thread synchronization or -replay prevention for arbitrary unsafe source code. - -After the last MIR optimizer, verify the full dependency graph and the ordered -instruction/CFG projection. The encoder may erase logical state edges only when -that projection discharges them. It preserves instruction/control order and -performs no subsequent effect-moving optimization. No State constant zero, -state counter, token object, dedicated world heap or runtime version comparison -is emitted. Verified state ordering survives as executable calls and control flow. +### Dependency lowering and optimization + +The [State topic](state-primitives-and-dependency-lowering.md) is authoritative +for source producer identity, strict evaluation, closure/call transport, joins, +loops, zero-width projection, optimization transfers and final erasure. This +library design consumes those contracts; it does not define another dependency +model. General raw-State extensions are not automatic migration prerequisites: +select required slices using concrete public API/host reproducers and preserve +the full State model's invariants for every admitted shape. + +Library acceptance must execute callbacks, ignored results, repeated actions, +normal returns and traps. Public recursive loops must also retain the official +stack-safe behavior; short-loop order evidence is insufficient. Temporary +optimizer exclusions are implementation gaps, not accepted library semantics. ### WIT boundary and generic command entry diff --git a/docs/design/backend/fp/mir.md b/docs/design/backend/fp/mir.md index bde987a7..72554297 100644 --- a/docs/design/backend/fp/mir.md +++ b/docs/design/backend/fp/mir.md @@ -1,9 +1,10 @@ # MIR: SSA/CFG and Verification -> **Selected extension:** [library-owned effects and state dependencies](library-owned-effects.md) -> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies -> and checked zero-width projection. Implementation and acceptance evidence -> have not migrated; the existing contracts below remain the implementation baseline. +> **Selected extension:** [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) +> owns primitive State contracts, preserved dependencies and checked zero-width +> projection. [Library-owned effects](library-owned-effects.md) owns the +> library adaptation. Coverage remains partial; see the +> [implementation checklist](../../../implementation/backend/library-owned-effects.md). **Feature:** F-02 **Status:** Stable (design) diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index 831e310c..8348855d 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -1,9 +1,10 @@ # Runtime Representation and Checked Boundaries -> **Selected revision:** [library-owned effects and state dependencies](library-owned-effects.md) -> replaces the Effect-specific token contract with a library newtype and generic -> state dependencies. Implementation and acceptance evidence have not migrated; -> this document retains the existing contract pending that migration. +> **Selected revision:** [Library-owned effects](library-owned-effects.md) +> replaces the Effect-specific token contract with ordinary library newtypes. +> [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) +> owns the logical dependency and zero-width projection contracts. Coverage +> remains partial; see the [implementation checklist](../../../implementation/backend/library-owned-effects.md). **Feature:** F-02 **Status:** Stable (design) diff --git a/docs/design/backend/fp/state-primitives-and-dependency-lowering.md b/docs/design/backend/fp/state-primitives-and-dependency-lowering.md new file mode 100644 index 00000000..0f8043f8 --- /dev/null +++ b/docs/design/backend/fp/state-primitives-and-dependency-lowering.md @@ -0,0 +1,704 @@ +# State Primitives and Dependency Lowering + +**Feature:** [F-02](../../../feature/F-02-portable-programs.md) +**Status:** Draft. The primitive representation direction is selected; general +transport and optimizer integration remain incomplete. Coverage belongs in the +[implementation checklist](../../../implementation/backend/library-owned-effects.md), +with known gaps recorded in the [scope audit](../../../implementation/backend/library-owned-effects-audit-2026-10-11.md). +**Prerequisites:** [primitive types](../../frontend/type-system/prim.md), +[Functional Core](../../frontend/semantics/functional-core.md), +[representation and evidence](representation-and-evidence.md), [CC](cc-ir.md), +[MIR](mir.md), [Core optimization](../opt/core.md), +[MIR optimization](../opt/mir.md), and +[primitive bindings](../wasm/primitive-ffi-and-stdlib.md). +**Summary:** State is a primitive logical dependency with no runtime payload. +Execution intrinsics establish boundaries; checked operations define successors. +Each lowering preserves invocation identity, execution order and scope until +MIR validates their physical projection. Libraries own Effect/ST types and +algorithms; runtime providers own storage and termination execution. + +## Scope + +This topic owns State/RealWorld semantics, execution primitive contracts, +dependency transport through Core, ANF/closure conversion and MIR, optimization +legality, and the conditions for zero-width projection and final erasure. +It does not introduce another IR between MIR and Wasm. + +[Library-owned effects](library-owned-effects.md) owns the Effect/ST newtypes, +combinators, source adaptation, private adapters, ordinary command runner and +migration acceptance. The runtime and canonical ABI topics own executable +providers and host adaptation. State dependency evidence does not replace +observable-effect metadata or the ordinary type and representation system. + +The complete transport contract includes calls, joins, loops, closures and +adapters. This is a correctness target, not a requirement to finish every +possible raw-State extension before accepting the actual Effect package. +Migration slices must name a public API/host reproducer. Additional low-level +State generality is tracked separately and must not relax the same invariants. + +## Background + +### What State represents + +`State s` represents the dependency supplied to an action in region `s`. +The successor returned by an observable operation tells the compiler which +later operations follow it. It contains no application data, memory contents, +world snapshot, counter or runtime handle. The mutable data remains in the +cell, array or host resource used by that operation. + +For example, writing a cell and then reading it creates this logical chain: + +```text +s0 -- write cell 7 --> s1 -- read cell --> s2 +``` + +The read must follow the write even if the write returns no useful payload. +The labels name compile-time dependency producers; no machine compares their +values or increments them during execution. Repeating the action executes the +calls again, rather than allocating a sequence of token objects. + +This primitive differs from a library state monad of the form +`UserState -> (UserState, a)`: that monad transforms an ordinary value which +the program can inspect and return. Here the actual mutable state lives outside +the dependency value. `RealWorld` marks the region used for external effects; +it is not an object containing the world's state. ST uses a scoped region +marker to separate computations at the type level. + +### Why introduce it + +The migration has two responsibilities: let the library define actions and +their combinators, and give the compiler a contract for checking their +execution through optimization and representation changes. An ordinary newtype +solves the first responsibility. The selected State protocol solves the second +with an explicit predecessor/successor relation. + +The important distinction is between constructing an action and executing it. +Constructing a closure that will write a cell must remain inert. Running it +twice must write twice. Reading after a write must observe that write. Dropping +an action's returned value must retain its executed write, host call or trap. +These requirements concern actual invocation and control flow, rather than +the spelling of `Effect` or the mere presence of a monad instance. + +This is a selected compiler/library contract, not a claim that every correct +Effect implementation needs State. A suspended `Unit -> a` representation can +be correct when strict evaluation and sound observable-call metadata preserve +execution. Official PureScript's JavaScript adapter uses suspended functions. +Choosing that design would require a complete contract of its own. Here State +expresses sequencing and scoped region boundaries explicitly, and its physical +representation can be erased after checking them. + +Neither a constant zero nor an incrementing integer supplies this contract by +itself. A constant can trigger an invocation, but carries no checked successor +relation. A counter adds runtime work without proving that the compiler retained +the right calls, operands and control edges. Zero-width dependencies avoid that +runtime work while retaining the relation during compilation. + +### What belongs to the library, compiler and runtime + +The library owns `Effect` and ST action newtypes, `pure`, `bind`, instances, +loops and wrappers. For example, it can define a hidden action constructor over +`State RealWorld -> Step RealWorld a`. Another library newtype using the same +protocol needs no new Effect-specific compiler rule. + +The compiler owns the primitive State/region identities, unsafe execution +boundaries, operation contracts and their checked projection. It recognizes +these identities and contracts, rather than treating a library module named +`Effect` as privileged. The runtime owns the executable storage operation or +host interaction: it receives the cell/array, index and payload, not State. +An ordinary foreign binding connects that executable operation to its checked +source signature. A foreign binding does not make `Effect` a foreign type. + +```mermaid +flowchart LR + L["Library: newtypes and combinators"] --> C["Core: checked types and logical dependencies"] + C --> CC["CC: explicit calls and captures"] + CC --> M["MIR: checked physical projection"] + M --> W["Wasm: calls and control flow"] + W --> R["Runtime / host: storage and I/O"] +``` + +Moving storage implementation into runtime does not move source types or +optimization legality there. Once a compiler has deleted or reordered a call, +the runtime cannot recover the missing operation or its intended predecessor. +After checking and projection, the runtime needs no dependency interpreter. + +### Relation to Haskell + +GHC's IO representation is a newtype over a primitive State# transformer. +This motivates the selected shape; it does not specify this compiler's proof +algorithm or source restrictions. See [GHC.Internal.IO](https://downloads.haskell.org/ghc/latest/docs/libraries/ghc-internal-9.1401.0-555c/GHC-Internal-IO.html). +Our State is at kind `Type`; the nominal region, lack of constructors, and +checked execution boundaries must be stated independently of GHC's runtime. +The analogy concerns a library newtype around a primitive dependency-carrying +function. It does not establish that our dependency graphs, source restrictions +or per-pass verification algorithm are GHC's implementation. + +Three facts must remain distinct: + +- A logical dependency identifies where an operation belongs on an executed path. +- An observable operation can mutate storage, invoke a host service or trap, + even when its result is unused and it has no physical State argument. +- Zero-width representation removes payload slots, not execution or its order. + +## Model + +### Vocabulary and primitive surface + +The phrase "State intrinsic" covers several different responsibilities and +should not imply one runtime action mechanism: + +| Name | Meaning | Owner | +| --- | --- | --- | +| `State s` | Primitive dependency type with a nominal region parameter and no physical payload. | Compiler primitive type catalog. | +| `RealWorld` | Primitive marker for the external-effect region. | Compiler primitive type catalog. | +| `Step s a` | Ordinary record alias containing successor State and result `a`. | Library source; the shared compiler contract checks its structural fields. | +| `runWorld`, `runRegion` | Explicit execution-boundary intrinsics. | Compiler intrinsic catalog and checked lowering. | +| Storage read/write/fill/trap | Executable operations exposed through checked foreign bindings. | Runtime provider and its ABI contract. | +| `Effect a`, ST action types | Ordinary library newtypes over the protocol. | Library source. | + +The registered State execution intrinsics are `RunWorld` and `RunRegion`. +There is no State constructor intrinsic, no token increment intrinsic, no +intrinsic implementation of bind/loops and no intrinsic per runtime export. +The catalog entries are available through explicit bindings rather than +implicitly exporting unsafe runners from ordinary library modules. + +Execution needs a primitive boundary in this design because ordinary library +code has no constructor for a root State. `runRegion` additionally uses the +compiler's rank-N region and result-escape checks. The intrinsic supplies that +checked boundary, not an action interpreter. +The library's runner still chooses when to call it. Mutable operations need +checked external contracts because their executable bodies are outside the +source verifier; they do not need to become compiler-defined library algorithms. + +### Types and structural call boundary + +```text +Prim.State.State :: forall k. k -> Type -- nominal region role +Prim.State.RealWorld :: Type -- region marker +Step s a = { state :: State s, value :: a } +``` + +The primitive declaration catalog supplies stable identities. State has no +constructor, equality operation, numeric payload or safe region-changing +coercion. RealWorld is not a mutable world object. The region kind remains +polymorphic for official ST region markers. + +Step is an ordinary closed structural record with exactly the state/value +fields. Core extracts the complete callable boundary and validates the State +input and Step successor at the same region. Field correspondence is checked; +consumers must not infer it from an erased layout or a library constructor name. +Only validated boundaries receive a State call projection plan. + +### Dependencies and source uses + +A dependency is a scoped producer identity, not token bits. A formal callable +input is supplied by its caller; it is not a new execution root. Only a checked +execution primitive opens a root. An observable operation consumes the current +input and, on normal return, produces a successor. A pure pass-through action +may retain the input identity. A non-returning operation has no normal successor. + +The checked sequential protocol imposes the following conditions: + +| Source use | Contract | +| --- | --- | +| Bind another name to State | Preserve producer identity; an alias is not a fresh dependency. | +| Return unchanged State | Valid for proven pass-through behavior; not a replacement for a write/host successor. | +| Discard an action's payload | Valid; its observable operation and successor remain required. | +| Discard a successor and return an older predecessor | Invalid after an observable transition on that executed path. | +| Use State in mutually exclusive branches | Each executed arm threads its current dependency; the join selects that arm's successor. | +| Use aliases successively around observable calls | Aliasing does not authorize replay of a stale predecessor or an unchecked fork. | +| Capture raw State | Construction is inert; invocation must preserve its producer and validate it against the current path. | +| Execute an action repeatedly | Each dynamic invocation receives its own supplied input; reusable action closures are not single-use objects. | +| Return a function or nested action as payload | Keep the payload's complete type and callable convention; do not execute it or add outer parameters. | +| Store State in a container or pass it to an abstract consumer | Require a complete checked transport contract; never silently forget its provenance. | + +These are obligations of the checked sequential protocol, not a general linear +PureScript type system. Unsafe source has no automatic replay-prevention or +purity guarantee. Unsupported raw-State transport must be diagnosed distinctly +from a malformed checked chain. Neither an implementation's one-capture limit +nor its local-helper restriction defines the language's final semantic rule. + +### Execution and operation contracts + +Proposed registry operations are named here by responsibility; exact Rust and +binding names must follow the single intrinsic catalog. Do not add implicit +bootstrap exports of unsafe operations. + +```text +runWorld :: forall a. + (State RealWorld -> Step RealWorld a) -> a +runRegion :: forall a. + (forall s. State s -> Step s a) -> a +``` + +runWorld starts one dynamic execution, supplies its root dependency, invokes +the supplied function once and discharges its returned state before yielding +the payload. It is an unsafe execution boundary used by the library unsafe +runner and command adapter, not a purity proof. runRegion introduces a fresh +scoped region, invokes the rank-N body once and checks that the region does +not escape in the result. No arbitrary initial State literal is exposed. +Nested and repeated executions retain distinct dynamic invocation boundaries. + +Mutation and reads of mutable storage use state-aware checked primitives, for +example a private cell operation has the schematic shape: + +```text +readCell :: forall s a. Cell s a -> State s -> Step s a +writeCell :: forall s a. Cell s a -> a -> State s -> Step s Unit +``` + +Cell is library owned. Actual storage bindings use their existing checked +storage operands; a primitive scheme may not presume the identity or layout of +Cell. New storage allocation, mutable reads, writes and unsafe freezing all +participate in the dependency protocol. Pure array operations retain their +existing pure contracts; reading mutable backing storage must not be classified +as pure merely because immutable array indexing is pure. + +Generic execution primitive descriptors and checked target binding contracts +own dependency inputs/results, observable effects and trap behavior. Source +schemes, kind/role checks, Core elaboration and verifiers consume these contracts. +Backend binding metadata keeps runtime provider/export identity, source module, +span and the checked Core scheme identity beside target-neutral CC. Extraction +must retain every runtime binding; boundary validation rejects missing, +duplicated or substituted records. Keeping a raw binding record does not mean +its call has been projected or checked against a physical instruction sequence. +Returning an ordinary record containing +the same input State is not enough to implement an observable primitive: its +checked operation must establish a successor dependency. + +## Design + +### Why the protocol crosses several passes + +Each representation changes something the preceding representation could +express. Core retains checked regions and source call types; closure conversion +makes hidden captures and calls explicit; MIR removes logical State slots and +fixes executable layouts. A proof about the source chain alone does not show +that a later adapter invokes the same storage operation on the same cell. +Conversely, physical type correctness alone cannot distinguish a call on the +intended cell from one on another cell of the same type. + +The protocol therefore follows the existing representation boundaries. The +extra obligation at each boundary is to preserve the same operations, operand +identities, execution multiplicity and chosen control paths while changing +their representation. It introduces no additional IR or runtime execution stage. +Ordinary typing, effect metadata and representation operations remain shared +with other library types. + +Preserving this contract is necessary for the selected design; the present +amount of machinery is not itself a requirement. Reinterpreting the same source +in multiple private evaluators, repeatedly deriving an immutable module or +restricting all bodies to one local source form are implementation choices +which must be assessed against the shared contract. A new State rule or pass +must name the semantic fact it owns and the transformation that requires it. +Code that cannot do so is not justified merely by supporting Effect. + +### One semantic owner, explicit lowering relations + +The primitive catalog owns identities and roles. Checked source contracts own +operation inputs/results, region agreement, effects and normal-return behavior. +Core owns call-boundary extraction and body dependency production, tied to +immutable invocation nodes and source ranges. + +Lowerings consume those facts and publish an explicit relation to their actual +output operations. CC and MIR verify that relation against immutable input; +they do not rediscover primitive semantics from names or invent fresh inputs. +A producer can be trusted for type facts already checked at its stage, but a +consumer claiming invocation correspondence must check actual calls, operands, +results and control placement. A valid standalone dependency graph is not proof +that the executable instructions implement it. + +P9 freezes one CheckedSource authority for a logical CC module after deriving +and validating its State flows. The inventory and physical function witnesses +share that authority. A summary is keyed by stable function identity and retains +the expected dependency and execution graphs; its function body remains in the +same immutable source arena. Verification compares current witnesses with those +summaries and checks actual instructions/control against the source body. +It must not recompute the entire frozen module for every physical function or +optimizer checkpoint. Mutating a source copy creates a different arena and +requires new checked summaries; cached evidence never authorizes changed calls. + +| Boundary | Required input | Output and discharge obligation | +| --- | --- | --- | +| Resolved HIR to typed Core | Stable primitive/external IDs, complete schemes, source origin | Typed calls, nominal regions and checked primitive contracts; no dependency inferred from Effect names. | +| Core optimization | Checked bodies and operation contracts | Preserve behavior; invalidate and regenerate affected body evidence after transformation. | +| Core to ANF/CC | Immutable source calls, lexical scopes, argument evaluation order | Explicit evaluations, invocation correspondence and producer transport. ANF is part of CC lowering, not an extra State execution stage. | +| Closure conversion | Ordinary free-local/capture structure plus dependency provenance | Captures and lifted formal inputs tied to actual producers; no synthetic execution root. | +| CC to MIR | Checked logical call/result/capture plans and immutable CC | Zero-width slots plus checked instruction/CFG correspondence; payload conversion and raw ABI calls remain explicit. | +| MIR optimization | Physical operations with immutable requirements and current evidence | Preserve or transfer evidence for every changed call/edge; reject stale evidence. | +| MIR to Wasm | Verified final physical projection and effectful calls/control | Encode existing behavior; no remaining State value representation or effect-moving optimization. | + +### Transport and projection + +Typed Core preserves source State applications, roles and primitive contracts. +Its state-operation verifier checks input/output shapes, region identity, +producer provenance, normal-return state and dependency scope. Ordinary functions +are checked from their bodies; an external or abstract callable needs a checked +state signature contract. MIR retains checked source requirements in an immutable +module inventory independent of mutable per-function evidence. Every retained +function must satisfy its source requirement; deleting an optional witness must +not disable verification. Unused whole functions may be pruned without changing +the requirements of surviving functions. Missing required evidence is an error, not a fresh +state or assumed-pure operation. + +Core body evidence is tied to its immutable source arena. It derives transitions +from actual invocation nodes and tracks their argument and returned-field +provenance through ordinary aliases, record patterns and control-flow joins. +Verification checks invocation coverage and order, region/payload contracts and +branch placement in addition to standalone graph validity. A proven pure body +may pass its incoming dependency through unchanged; an unknown invocation stays +conservatively observable. Pure joins preserve aliases already evaluated before +the join. Core transformations invalidate old body evidence and recheck the +resulting source representation before later projection can consume it. + +Lexical callback construction retains the producers of its free locals without +executing the body. Calling a known callback evaluates its argument first, then +checks its body in the captured lexical environment against the caller's current +dependency. It creates no new root. Nested callback parameters retain this same +provenance, and leaving the invocation restores the caller's local scope. +Pure joins may rebase captured aliases; observable transitions do not make an +older capture current again. Source verification derives executing invocation +identities through these scopes, including operations inside called callbacks. +An unsupported callback consumer, branch merge, container or cast must reject +state-carrying values before losing their producers into an opaque value. +Later representations must preserve the actual capture and invocation relation +and discharge it through checked zero-width capture and call projection. + +CC makes the dependency chain explicit alongside ordinary evaluation order. +Each observable state operation defines an output dependency referring to its +input. Calls retain checked state inputs/results through dictionaries, erased +closures and higher-kinded instantiation. Conditional joins select the dependency +from the executed branch; loops carry it as a loop parameter. The returned +state must be downstream of the observable operations executed on that path. +Unknown calls and unsafe execution remain conservatively observable. + +A lifted callback may receive its logical input through a checked closure +capture instead of an explicit State parameter. CC records which owning closure +parameter and capture index supply that input. Construction preserves the +capture's producer, and invocation checks it against the caller's current +dependency. The callee's local root is a formal input supplied by that call, +not a new execution boundary. Explicit and captured inputs share the checked +Step result contract; capture transport does not add a synthetic State parameter +to the ordinary call ABI. Branches rebase current captures together with other +aliases and preserve stale predecessors. Source correspondence verifies this +input relation as well as actual operations. Physical removal requires separate +checked capture-slot and invocation correspondence. + +Zero-width capture projection removes only logical State operands from a +checked closure producer. Each surviving capture read uses the number of +ordinary slots before its original logical index. The captured callback keeps +its ordinary parameter convention and returns the checked Step payload. The +immutable source CFG anchors closure construction and surviving capture reads +to their original scope and order, with the same target, destination and +ordinary operands. A physically type-correct change of capture index or operand +is still an invalid dependency projection. Constructing a callback remains +inert even when its body traps; selected invocations retain normal successors +or their checked non-returning path. + +Verification does not claim a general linear source type system. It rejects +malformed chains, region mixing and an unsupported fork that would discard or +replay a predecessor around observable operations. Branch-exclusive uses and +pure state pass-through are valid. A library closure may execute repeatedly; +each invocation threads the state supplied for that invocation. Support for a +raw-state transport shape must be checked across its actual fields, captures, +products and calls; unsupported shapes fail explicitly rather than materializing +a placeholder token or erasing the dependency. + +MIR fixes physical representation and keeps a checked dependency projection +for instructions, calls, block joins and loop edges. Dependency identities are +not Wasm value types or integer locals. Their definitions/uses are explicit MIR +structure, not a name-based side table reconstructed by the encoder. MIR +verification establishes dominance, region agreement, call contract consistency, +and control-flow preservation of the dependency chain. + +The existing representation planner owns the source/logical-to-physical mapping. +State maps to zero payload slots; Step's state field contributes no storage. +A structured choice returning only State retains its selector, arm calls and +control edges. Its physical join has no value parameter and incoming jumps +carry no payload argument. The immutable logical source still owns the chosen +successor dependency; projection verification checks these empty physical slots +alongside call placement and every control edge. Zero-width choice results must +never erase the choice's observable execution or introduce an integer token. +At a known state-call boundary, the result projects to the payload and requires +no Step record allocation. Common aggregate and erased transport may use an +ordinary payload container when required; it must not lose logical dependency +evidence or silently change callable conventions. No full GHC unboxed-tuple +syntax or global allocation-free claim is introduced. + +Physical parameter removal occurs only through checked signature projection, +shared by producers, consumers, partial applications and adapters. State +parameters are zero-width while their logical invocation and dependency remain. +Core owns call-boundary extraction for arrows, fixed-arity closures and quantified +results. The representation planner consumes that boundary and the checked State +signature, retaining its source arena and region while projecting only payload +types into physical slots. A signature plan alone cannot discharge invocation dependencies. +For ordinary direct and indirect calls, MIR correspondence preserves every +non-State operand identity, order and occurrence from immutable CC. It removes +only operands whose checked CC declarations have State shape. Changing an +operand to another value of the same physical type still invalidates the +certificate. ABI conversions require their own checked correspondence rather +than relaxing this ordinary-call invariant. +A nullary physical host call stays a call inside the action body, not a global +initializer. Immutable checked source Core is not mutated into a physical type +model; the lowering carries its explicit relation to CC/MIR. + +### Optimization and final erasure + +Core and MIR transformations preserve dependency edges, dynamic multiplicity, +branch/loop placement and observable call/trap behavior. Unused payloads do not +permit removal of their operation. State pass-through for a pure action is +simplifiable; a state-producing host/mutation operation is never replaced by +its input State. Inlining preserves argument order and reconnects dependencies +using fresh local identities. CSE, code motion, dead-code elimination and loop +optimizations require evidence covering both dependencies and observable effects. + +Zero-width representation does not make a state operation pure. Observable-effect +metadata remains necessary after physical projection and for calls outside the +state protocol. Dependencies do not promise rollback, thread synchronization or +replay prevention for arbitrary unsafe source code. + +After the last MIR optimizer, verify the full dependency graph and the ordered +instruction/CFG projection. The encoder may erase logical state edges only when +that projection discharges them. It preserves instruction/control order and +performs no subsequent effect-moving optimization. No State constant zero, +state counter, token object, dedicated world heap or runtime version comparison +is emitted. Verified state ordering survives as executable calls and control flow. + +### Observable runtime and host calls + +Runtime storage operations are ordinary checked foreign bindings, not one HIR +intrinsic per export. The runtime contract describes ordinary operand roles, +payload adaptation and whether the operation returns normally. Validate element +use types before erasure and retain mutable array reference identity. + +State-aware host calls use the canonical ABI's checked adapter subgraph. Its +source call, ordinary operands, payload recovery, cleanup and exit must remain +anchored to the same invocation. Only a completely checked adapter subgraph can +be contracted to one logical invocation for ordering checks. State is not a WIT +resource, canonical argument or runtime handle. + +Signature/result projection must consume the authoritative checked boundary +plan. A structural Step-looking physical type alone does not discharge producer, +invocation or return obligations. Remove unused representation entries through +ordinary reachability/layout planning; do not broaden semantic admission to +make an inventory pass. + +### Rejected alternatives + +Reject constant or incrementing tokens, world heap objects, Effect-name checks, +whole-function combinator intrinsics, and runtime action interpreters introduced +solely to avoid a checked callable boundary. Also reject source-order guesses +without call identity, permissive fallback for lost provenance, and global +signature rewrites justified only by one supported capture case. + +Temporarily rejecting unsupported transport is honest. Skipping optimization +can protect a partial contract, but is not a complete optimization design or +stack-safety proof. Tail/loop conversion must reconnect logical successors and +physical control rather than exclude all State-bearing functions permanently. + +## Algorithms + +1. Resolve stable primitive and external identities; validate complete schemes, + region roles, rank-N scope and normal-return contracts before publishing them. +2. For each checked body, establish formal inputs, executed invocation identities + and path-local producers. Preserve source spans for every failure origin. +3. Follow ordinary strict evaluation through ANF. Bind aliases to existing + producers; distinguish callback construction from callback invocation. +4. Relate branch successors and loop-carried dependencies to actual control + edges. Transport free-local producers through the ordinary closure layout. +5. Publish CC evidence and verify operation coverage against immutable Core; + malformed or unsupported transport must not become an opaque valid result. +6. Build call/result/capture projection plans from checked logical boundaries. + Plan raw runtime or canonical host adaptation using complete operand/payload + contracts. Validate actual emitted subgraphs, including terminating paths. +7. Lower to MIR with zero physical State slots and immutable requirements for + surviving functions. Validate operands, capture index remapping and CFG edges. +8. After each relevant optimizer, transfer or rebuild evidence and reverify. + Inlining substitutes inputs with fresh local identities; tail/loop conversion + maps successors onto backedges. Preserve dynamic multiplicity and traps. +9. Verify the final physical module before encoding. Erase discharged logical + dependencies while retaining observable calls and control flow. + +No error path may publish partially checked evidence. Pruning an unused whole +function may remove its requirement; deleting a retained function's witness +must not suppress verification. + +## Code map + +This table specifies ownership and required APIs, rather than an inventory of +existing special cases. + +| Owner | Required types/operations | +| --- | --- | +| HIR primitive catalog | State/RealWorld identities, nominal role and `StateOperation::{RunWorld, RunRegion}` source schemes. | +| Core State contract | `signature(...)` extracts complete region/payload call contracts; execution checking validates root/region scopes. | +| Core dependency producer | Body checking produces invocation/provenance evidence tied to the immutable source arena; verification diagnoses missing, stale or unsupported relations. | +| Core-to-CC lowering | Explicit source-to-invocation/capture correspondence using ordinary ANF and closure conversion operations. | +| CC State contract | `StateCallProjection`, `StateResultProjection` and capture plans share region/result rules; function verification checks actual inputs, calls and returns. | +| Runtime ABI contract | Source operand roles, physical export signatures and normal-return properties; no compiler IR or Effect algorithms. | +| ABI adapter planner | Checked runtime/host subgraphs anchored to source call identity and actual application types. | +| MIR State projection/verifier | Shared immutable CheckedSource authority, inventory, logical-to-physical input/result/capture mappings and per-function instruction/control correspondence. | +| Optimizers | Transfer/invalidate evidence at common transformations; immutable requirements remain authoritative. | +| Encoder | Consume verified MIR layouts and ordered operations without reconstructing State semantics. | + +Current local closure evaluators are implementation strategies, not independent +semantic owners. If retained, they must consume the shared contracts and agree +across equivalent source forms; the design does not require interpreting +arbitrary PureScript code to prove ordinary library combinators. + +## Invariants and verification + +| Invariant | Required verification | +| --- | --- | +| No fabricated root or region change | Primitive IDs, nominal roles, execution scopes, rank-N escape negatives. | +| Every required operation is represented | Invocation coverage against immutable source plus actual call/provider identity. | +| Correct predecessor/successor | Path-local producer checks, stale-use/fork negatives, branch selection and loop-carried inputs. | +| Correct lexical transport | Actual closure producer, ordinary captures, lifted input, invocation and source scope; direct/helper forms compose under the same contract. | +| Normal return versus trap | Runtime contract anchored to invocation; no successor or continuation after a non-returning call. | +| Sound physical projection | Ordinary operand identity/order, payload recovery, capture remapping, no State slots or token constants. | +| Optimizer preservation | Values and observable traces before/after transformations; changed graphs have current evidence. | +| Safe library behavior | Inert construction, strict arguments, repeated execution, ignored payloads, storage aliasing and region boundaries. | +| Stack-safe public loops | Mandatory Wasmtime execution at meaningful iteration counts, compared with the pinned official loop behavior. Short traces alone are insufficient. | +| Honest unsupported forms | Stage-specific source diagnostics; no success by dropping dependency metadata. | + +Runtime execution, malformed-IR rejection and representation inspection are +separate evidence. The [implementation checklist](../../../implementation/backend/library-owned-effects.md) +records which obligations actually passed; this document grants no new support. + +## Worked example + +### Ordinary pure and bind + +These schematic definitions belong in a library, with the constructor hidden +from clients. They are not compiler-generated combinators: + +```purescript +type Step s a = { state :: State s, value :: a } +newtype Action s a = Action (State s -> Step s a) + +pureAction :: forall s a. a -> Action s a +pureAction value = Action \state -> { state: state, value: value } + +bindAction :: forall s a b. Action s a -> (a -> Action s b) -> Action s b +bindAction (Action first) next = Action \state0 -> + case first state0 of + { state: state1, value: value } -> + case next value of + Action second -> second state1 +``` + +`pureAction` creates no observable transition and returns its supplied State. +`bindAction` constructs a closure. When that closure is invoked, it runs +`first`, gives its ordinary payload to `next`, and runs the returned action +with `state1`. It does not run either action merely by assembling the bind. +The compiler checks the generic callable protocol; it needs no knowledge of +these function names or the `Action` constructor. + +### Logical sequencing and physical calls + +Consider two storage calls inside an ordinary action: + +```text +step1 = write cell 7 s0 +step2 = read cell step1.state +return { state: step2.state, value: step2.value } +``` + +Core checks one region and the storage element/payload contracts. It records +`write(s0) -> s1` and `read(s1) -> s2`, with the actual source invocation IDs. +ANF evaluates operands in order; CC keeps both calls and their successor fields. +Returning s0 instead of s2 is a stale dependency even though both have the same +type. An unused read payload still does not make a mutable read pure. + +MIR emits a write using the original cell reference, followed by a read and +payload recovery. State arguments and fields contribute no physical slots. +Verification checks that these actual calls correspond to the logical chain, +including operand identity, order and normal-return behavior. Wasm contains the +calls and their control flow without State parameters or a world object. + +The physical behavior is schematically: + +```text +runtime_write(cell, 7) +value = runtime_read(cell) +return value +``` + +Payload boxing/recovery and canonical ABI adaptation may still occur around +these calls. Erasing State does not promise that every action, record or +closure is allocation-free. It removes the dependency's own slots and the +known Step boundary's State field while preserving the useful result. + +If a branch chooses between writes, only the executed arm supplies the join +input. Even if the branch returns only State, its physical join can have zero +value parameters while retaining the selector, arm calls and control edges. +If an arm traps, it has no normal edge or successor to that join. + +### Execution roots and regions + +A library runner binds explicitly to `runWorld` or `runRegion`; it does not +manufacture an initial State. `runWorld` invokes the action once with a logical +root in `RealWorld` and yields its payload. `runRegion` checks a rank-N action +whose fresh region cannot appear in the result. This separates region safety +from sequential ordering: matching region types is necessary, but returning an +old predecessor after a write remains invalid even in that same region. + +A scoped region is a type and execution boundary, not a new runtime world +object. Storage allocation, ownership and lifetime follow their own runtime +contracts; the region runner does not by itself specify an arena allocator or +promise automatic resource cleanup. + +## Boundaries and interfaces + +The library can define unrelated newtypes over the same protocol without new +compiler rules. Private unsafe adapters and unsafe execution are explicit trust +boundaries; nominal regions and checked call conventions survive them, but they +are not blanket source purity proofs. + +Runtime providers receive ordinary physical storage operands, not dependency +identities. The linker validates actual application reference types against +provider contracts. Host adapters obey canonical ABI requirements. Neither +runtime nor linker derives source sequencing by recognizing Effect or ST. + +Core and CC evidence describes logical execution; MIR fixes representation and +checks its projection. Wasm consumes MIR, not a separate State IR. Logical +projection can remove zero-width slots before final encoding, but observable +metadata and source correspondence remain until their obligations are discharged. + +## Open questions and future work + +General raw-State transport needs a coherent shared invocation/capture contract +rather than successive local exceptions. An arbitrary higher-order consumer +must preserve or explicitly discharge producers; relaxing an unknown call to +an opaque result is not a solution. The precise safe exposure policy for raw +State at kind `Type` remains a design question distinct from public Effect use. + +General optimizer graph transfers remain required. Tail conversion retains an +immutable checked pre-tail physical body, replays the shared conversion, and +verifies actual output against it. Scalar folding uses the same optimizer owner; +function-position compaction does not change stable call identities. This bounded +contract supports tail calls and self-recursion backedges without admitting +arbitrary CFG changes. Current single-root/capture restrictions, other pass +exclusions and signature-wide projection +must be assessed against these contracts, not promoted into normative rules. +See the [audit](../../../implementation/backend/library-owned-effects-audit-2026-10-11.md) +for reproduced failures and static concerns. No implementation gap authorizes +narrowing the complete transport model or postponing a concrete public API fix +behind unrelated generality. + +Async scheduling, exceptions/recovery, concurrent memory ordering and independent +State fork/join optimization require separate designs. This synchronous protocol +provides no transaction, rollback or synchronization guarantee. + +## References + +- [Library-owned effects](library-owned-effects.md) and its + [implementation evidence](../../../implementation/backend/library-owned-effects.md). +- [GHC.Internal.IO](https://downloads.haskell.org/ghc/latest/docs/libraries/ghc-internal-9.1401.0-555c/GHC-Internal-IO.html). +- [Pinned PureScript Effect JavaScript implementation](https://github.com/purescript/purescript-effect/blob/a192ddb923027d426d6ea3d8deb030c9aa7c7dda/src/Effect.js), + the reference for suspended construction and explicit execution. +- [IR boundaries](../00-ir-boundaries.md), [CC](cc-ir.md), [MIR](mir.md), + [Core optimization](../opt/core.md), [MIR optimization](../opt/mir.md). +- [Primitive bindings](../wasm/primitive-ffi-and-stdlib.md), + [canonical ABI](../wasm/canonical-abi-and-wit.md), and + [runtime linking](../wasm/linking-and-runtime.md). diff --git a/docs/design/backend/opt/core.md b/docs/design/backend/opt/core.md index 47ce4688..3426a0f0 100644 --- a/docs/design/backend/opt/core.md +++ b/docs/design/backend/opt/core.md @@ -1,9 +1,10 @@ # Typed Core Optimization -> **Selected extension:** [library-owned effects and state dependencies](../fp/library-owned-effects.md) -> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies -> and checked zero-width projection. Implementation and acceptance evidence -> have not migrated; the existing contracts below remain the implementation baseline. +> **Selected extension:** [State primitives and dependency lowering](../fp/state-primitives-and-dependency-lowering.md) +> owns primitive State contracts, preserved dependencies and checked zero-width +> projection. [Library-owned effects](../fp/library-owned-effects.md) owns the +> library adaptation. Coverage remains partial; see the +> [implementation checklist](../../../implementation/backend/library-owned-effects.md). **Feature:** F-02 diff --git a/docs/design/backend/opt/mir.md b/docs/design/backend/opt/mir.md index 50453b03..dd5fbc19 100644 --- a/docs/design/backend/opt/mir.md +++ b/docs/design/backend/opt/mir.md @@ -1,9 +1,10 @@ # MIR Optimization -> **Selected extension:** [library-owned effects and state dependencies](../fp/library-owned-effects.md) -> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies -> and checked zero-width projection. Implementation and acceptance evidence -> have not migrated; the existing contracts below remain the implementation baseline. +> **Selected extension:** [State primitives and dependency lowering](../fp/state-primitives-and-dependency-lowering.md) +> owns primitive State contracts, preserved dependencies and checked zero-width +> projection. [Library-owned effects](../fp/library-owned-effects.md) owns the +> library adaptation. Coverage remains partial; see the +> [implementation checklist](../../../implementation/backend/library-owned-effects.md). **Feature:** F-02 @@ -169,8 +170,13 @@ and explicit trap instructions remain live even when their result is unused. State dependency correspondence currently retains source predicate and block identities. CFG pruning and terminator simplification leave functions carrying that evidence intact; copy forwarding also leaves their bodies intact because -callable and adapter operand identities remain source anchors. Inlining and tail-call marking remain disabled for those functions -until they can transfer the evidence. Dead pure instruction elimination still +callable and adapter operand identities remain source anchors. Inlining remains +disabled until it can transfer the evidence. P9 tail-call marking uses the +checked conversion described in +[State dependency lowering](../fp/state-primitives-and-dependency-lowering.md): +it retains the physical predecessor and validates the actual transformed body +against the shared tail rewrite before checking source correspondence. Dead +pure instruction elimination still runs and preserves observable calls and traps. `Trap` is a terminal CFG node with no successor or operand; all successor consumers use shared MIR analysis. diff --git a/docs/design/backend/wasm/capability-profile.md b/docs/design/backend/wasm/capability-profile.md index 5895b2e3..98ce316b 100644 --- a/docs/design/backend/wasm/capability-profile.md +++ b/docs/design/backend/wasm/capability-profile.md @@ -117,7 +117,8 @@ for the default target and is also `Default::default()`. Its policy is: | Reference types, typed function references, GC | Enabled and required when used | Closures, aggregates, casts, and `call_ref` depend on them. | | Component Model and WASI 0.2 (`wasi_cli`, `wasi_io`, `wasi_clocks`, `wasi_random`, `wasi_filesystem`, `wasi_sockets`) | Enabled and required | The artifact boundary; canonical ABI and WIT metadata are emitted. Filesystem and sockets have `WASI.FileSystem` and `WASI.Network` wrappers over the vendored WIT and the pinned host. | | SIMD, relaxed SIMD | Disabled | Optimization track only. | -| Tail calls, exceptions, multi-memory, wide arithmetic, threads | Disabled | Tail-call lowering and execution tests now exist but are gated on `tail_call`; enabling it in the stable profile still requires a profile revision ([control flow and tail calls](../fp/control-flow-and-tail-calls.md)). Other proposals have no lowering. | +| Tail calls | Enabled | Stack-safe direct and closure calls use `return_call`/`return_call_ref`; self recursion can also become a CFG loop. State calls require checked dependency transfer ([control flow and tail calls](../fp/control-flow-and-tail-calls.md)). | +| Exceptions, multi-memory, wide arithmetic, threads | Disabled | No lowering. | | Memory64 | Disabled | Deferred; see below. | | WASI Preview 1, WASI 0.3 | Disabled | Separate compatibility tracks; neither is the artifact ABI. | | Component async/map/implements | Disabled | Not a stable compiler dependency. | @@ -300,8 +301,8 @@ consults the same profile through `wasi_interface_enabled(target, interface)` in ## Invariants and verification - `wasmtime_wasi_0_2()` enables GC, function references, reference types, - multi-value, and the Component Model/WASI 0.2 families, and disables SIMD, - tail calls, exceptions, memory64, threads, and Component async. A unit test + multi-value, tail calls, and the Component Model/WASI 0.2 families, and disables + SIMD, exceptions, memory64, threads, and Component async. A unit test asserts this against `wasm_features`. - Lowering is rejected with a source-associated diagnostic whenever a required capability is disabled. The check runs in `verify_module_with_capabilities`, @@ -345,9 +346,9 @@ pinned host does not link it. ## Open questions and future work -- **Tail calls.** [Control flow and tail calls](../fp/control-flow-and-tail-calls.md) - proposes enabling `tail_call` in the stable profile once its lowering and - execution evidence exist. +- **Tail-call optimization.** The stable profile enables `tail_call`. + Additional inlining and CFG transformations must preserve the checked State + transfer contract; proposal adoption does not establish those optimizations. - **Memory64.** Revisited only when `wit-component` lifts 64-bit-memory modules and the WASI host supports them. - **New WASI services.** Filesystem and sockets are enabled as service packages diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index c4a722e7..b859bf68 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -1,11 +1,11 @@ # Primitive Foreign Imports and Standard-Library Wrappers -> **Selected extension:** [library-owned effects and state dependencies](../fp/library-owned-effects.md) -> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies -> and checked zero-width projection. GC storage/termination use runtime-owned -> providers with a checked reference ABI, separate from scalar artifact calls. -> Integrated implementation and acceptance evidence -> have not migrated; the existing contracts below remain the implementation baseline. +> **Selected extension:** [State primitives and dependency lowering](../fp/state-primitives-and-dependency-lowering.md) +> owns primitive State contracts, preserved dependencies and checked zero-width +> projection. [Library-owned effects](../fp/library-owned-effects.md) owns the +> library adaptation. GC storage/termination retain their runtime-owned checked +> reference ABI, separate from scalar artifact calls. Coverage remains partial; see the +> [implementation checklist](../../../implementation/backend/library-owned-effects.md). **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) **Status:** Draft diff --git a/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md b/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md new file mode 100644 index 00000000..cca548f3 --- /dev/null +++ b/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md @@ -0,0 +1,193 @@ +# Handoff: Remove Compiler-Owned Effect and State Mechanisms + +**Date:** 2026-10-11 +**Scope:** Compiler cleanup only; no replacement Effect design. +**Status:** Instructions for the next agent. Removal has not been implemented. + +## User decision and authority + +The user explicitly requests removal of all compiler-side Effect-specific +logic and State analysis, including both the legacy Effect mechanism and the +new State dependency mechanism. The user explicitly rejects selecting an +ordinary thunk representation as part of this task: the replacement design +has not been decided. + +This instruction supersedes the previous continuation order in +[library-owned effects](library-owned-effects.md) and the selected State +direction in the existing design documents. Do not resume those implementation +slices. The earlier implementation goal was paused; this handoff does not +resume it. + +Do not introduce a new Effect representation, library thunk implementation, +State protocol, execution intrinsic, or alternate dependency analysis to make +the deletion appear complete. The deliverable is removal, with the remaining +boundaries and unsupported consumers stated honestly. + +## Checkout and existing work + +At handoff inspection, the compiler checkout is +`/Users/biu/Projects/purescript-rs`, branch `stdlib/vendor-core-libraries`, +HEAD `6b40b8d6` (`Record public Effect.Ref reference adapter evidence`). It has +substantial tracked and untracked work across Core, CC, MIR, driver tests, and +documentation. Inspect status and diffs again before editing. + +The independent `/Users/biu/Projects/psrs-stdlib` checkout also has substantial +uncommitted work. Its development sources currently depend on `Prim.State`, +State-stepping runtime/host declarations, and the library State representation. +The compiler's normal lock still points to revision +`1e01310daa7e56de5ed379029d6a24dcf39e879c`, which uses the legacy mechanism. +Neither package is evidence of a compatible post-removal implementation. + +Preserve unrelated work. Do not reset the checkout, drop stashes, revert the +entire migration commits, stage all paths, or rewrite history as a shortcut. +Those commits also contain useful generic runtime, linker, representation, +and optimizer changes. Do not commit, push, or change the normal stdlib lock +unless separately requested. + +## Required removal + +The paths below are investigation entry points, not an exhaustive deletion +list. Follow their callers, public fields, enum variants, verifier hooks, +configuration, tests, diagnostics, and documentation throughout the repository. + +### Legacy Effect mechanism + +Remove compiler ownership of the identity, representation, and operations of +the library type `Effect`: + +- Driver discovery of `TrustedEffect`, trusted operation lookup, and lexical + restrictions on `runEffect` in `crates/psrs-driver/src/program/effects.rs`. +- `EffectCompilation`, `EffectCommandEntry`, and other Effect-specific context + passed through driver, Core, linker, and backend APIs. +- Synthesized `pure`, `bind`, runner, and trap implementations in + `crates/psrs-core/src/effect/`, including operation supplies and lowering. +- Backend Effect-specific entry adaptation, suspension plans, import + classification, and verification in `crates/psrs-backend/src/effects/`. +- Effect-specific callable policies, fixed-token conventions, opaque-type + exceptions, and implicit host suspension based on Effect result types. +- Legacy `StateToken` expressions, representations, constant-zero lowering, + and traversal/verification branches used only by that protocol. + +Extract generic entry selection or reusable source diagnostics from mixed +modules before deleting their Effect-specific parts. Do not remove unrelated +entry selection merely because its current file is named `effects.rs`. + +### State dependency mechanism + +Remove the compiler's special interpretation of the State protocol: + +- Core State signature classification, flow evaluation, scoped/captured token + tracking, dependency graphs, stale-token/fork checks, and summaries in + `crates/psrs-core/src/state/`. +- CC State execution plans, graphs, branch/capture analysis, and + `StateCallProjection` in `crates/psrs-backend/src/cc/state/`. +- MIR State projection, inventories, immutable checked source, operand and CFG + correspondence, and tail-transfer proof replay in + `crates/psrs-backend/src/mir/state/`. +- State-specific fields on shared IR objects and all producer, transformation, + verification, serialization, and linking hooks for those fields. +- State slots and State-aware conversion, capture, signature, result, and + physical representation handling, including `UnprojectedState` contracts. +- State-stepping inference in WIT conformance, runtime bindings, reachable + layout publication, and host call lowering. A function or record shape must + not trigger hidden State protocol interpretation. +- Linker world-boundary construction and special runner facades in + `crates/psrs-linker/src/world_boundary/` and their consumers. +- State-specific optimizer exclusions and eligibility checks. Review each + mixed condition; preserve independent correctness constraints. + +Also remove compiler-only facilities introduced to support this mechanism: +the `Prim.State` primitive catalog/typechecking rules, `RunWorld`/`RunRegion` +intrinsics and descriptors, and `StateExecutionBoundary` target handling. +Entry points include `psrs-hir/src/primitives/state.rs`, +`psrs-hir/src/intrinsic/state.rs`, and +`psrs-typecheck/src/typecheck/state.rs`. +Do not leave dormant registered intrinsics or special primitive types as a +compatibility route. An ordinary user/library declaration named State must +continue to receive ordinary language treatment. + +## What must remain generic + +"Effect-related logic" here means compiler ownership of the library Effect +abstraction and the State protocol. It does not mean removing the compiler's +ordinary ability to compile observable calls and mutable operations. + +Preserve: + +- Strict evaluation order, generic foreign calls, traps, and conservative + optimizer treatment of observable or unknown calls. +- General effect summaries used by Core rewrites and MIR dead-code + elimination, such as `psrs-core/src/opt/effects.rs` and + `psrs-backend/src/mir/opt/effects.rs`. Remove protocol-specific cases inside + them, not their generic safety rules. +- Ordinary newtype checking, roles, constructor visibility, generic callable + storage, closures, captures, instantiation, adapters, and representation + conversion. +- Generic direct/indirect tail calls, loop lowering, and argument remapping. +- Real runtime storage implementations, GC provider support, generic runtime + linking, and checked source-value/ABI correspondence that is independent of + State. Remove their State-shaped contract coupling; do not invent a new + Effect ABI. If no generic replacement contract exists, report that missing + interface rather than fabricate successful binding. +- Generic package-configured command runner invocation only if it uses + ordinary function application and has no Effect/State-specific discovery, + validation, or lowering. Existing State-dependent runner code is not a + reason to preserve world-boundary machinery. + +The uncommitted `opt/specialize/callable_fields.rs` guard is a separate generic +specialization workaround, not a State requirement. Review it independently. +Earlier focused runs passed nine tail-call tests and 24 Core optimizer tests; +these results predate removal and do not establish a complete adapter repair. +Do not remove the pure newtype deep-bind regression because its State variant +is being retired. The CLI binary was last built during a temporary experiment +with specialization disabled; rebuild before using it as evidence. + +## Execution instructions + +1. Inventory both mechanisms and all their consumers. Capture the current + diff and a small relevant baseline without altering the index. Classify + shared changes before removing anything. +2. Update the governing design and acceptance documents to state that the + State direction is withdrawn and the replacement Effect representation is + undecided. Existing normative text cannot remain an instruction to rebuild + the removed machinery. Preserve dated evidence as historical evidence. +3. Remove both mechanisms across their owning stages and public interfaces. + Remove obsolete registrations and configuration as well as implementation + files. Keep stage contracts coherent after metadata removal. +4. Remove tests that exist solely to assert retired compiler protocols. + Preserve independent semantic and generic compiler regression tests where + their fixtures can remain ordinary source. Do not invent a new Effect + implementation just to retain an old fixture. +5. Record affected package consumers and unresolved runtime/host interfaces. + Do not modify the independent stdlib implementation or its public contracts + as part of this cleanup. Missing support must remain an explicit failure. +6. Review the full resulting diff and report deletion coverage, generic code + retained, checks executed, failures, and unresolved consumers. + +## Validation and completion + +Use focused crate checks/tests while iterating. The user previously requested +avoiding repeated full workspace runs. Run final integrated checks once the +removal stabilizes; if package-dependent tests cannot run or fail, report +their actual status and cause rather than disabling or reporting them green. + +Required evidence: + +- Searches and code review show no live legacy Effect synthesis, trusted + identity path, State analyzer, dependency witness, execution intrinsic, + special State representation, or State-stepping signature inference. + Explain remaining textual matches instead of targeting zero occurrences of + the English words "state" and "effect". +- Generic compiler checks and targeted runtime tests exercise ordinary + closures/newtypes, observable call order, calls with unused results, trap + preservation, mutable storage where a generic interface already exists, + and the pure deep-bind/tail-call regression. +- Formatting and diff whitespace checks pass. Report the scope and result of + workspace check/tests and clippy, including omissions and package blockers. +- Designs and the implementation ledger no longer present the removed + protocols as current requirements or completed capabilities. + +Completion means compiler ownership of both protocols is removed and all +remaining consumers and limitations are explicit. It does **not** mean a new +Effect mechanism exists or that either current stdlib package remains +executable. Designing that mechanism is a separate user decision. diff --git a/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md b/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md new file mode 100644 index 00000000..01f0c64b --- /dev/null +++ b/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md @@ -0,0 +1,202 @@ +# Library-owned effects: scope and implementation audit + +Date: 2026-10-11. Compiler branch: `stdlib/vendor-core-libraries`, HEAD +`6b40b8d6`. This audit includes the existing 28 modified/untracked paths, +including the uncommitted scoped-callback and zero-width-choice slices. The +independent development package is consumed explicitly; the normal compiler +lock remains at `1e01310daa7e56de5ed379029d6a24dcf39e879c`. + +## Conclusion + +The primitive State representation and small runtime boundary fit the selected +goal: ordinary library Effect/ST newtypes, library combinators, and checked +target operations. They do not require compiler recognition of the new Effect +constructor. The implementation and continuation plan have nevertheless grown +into a partial general State transport and provenance system. Completing that +system has become a prerequisite for the package migration without a concrete +public API blocker for every extension. + +The most urgent reproduced problem is in an actual public API: a 10,000-iteration +`Effect.forE` program compiles but exhausts the Wasm call stack. Expanding raw +State closure transport does not resolve that acceptance gap. The safe response +is to prioritize public package behavior and constrain the remaining work by +real reproducers, while preserving sequencing checks and honest rejection paths. + +## Necessary owners + +| Owner | Reviewed responsibility | Assessment | +| --- | --- | --- | +| Library | Effect/ST newtypes, pure/bind, callbacks, loops, Ref wrappers, command runner | Matches the goal. Algorithms remain ordinary source. | +| Primitive catalog | State/RealWorld identities, nominal region role | Necessary for the selected primitive State design. | +| Intrinsic catalog | Only `RunWorld` and `RunRegion`, with checked signatures | Bounded execution boundaries; no Effect/Ref algorithm intrinsic. | +| Runtime | GC storage fill/read/write and non-returning trap | Bounded executable primitives. Physical ABI has no State token. | +| Compiler call boundary | Complete source signatures, region agreement, payload representation, host/runtime ABI projection | Necessary. Newtype and zero-width calls affect HIR/Core/CC/MIR even though execution lives in runtime. | +| Dependency preservation | Keep observable calls ordered and retain evidence until checked erasure | Necessary correctness obligation; its current general source interpreter is a design choice, not dictated by the newtype equation. | + +Relevant owners are `psrs-hir/src/intrinsic/state.rs`, +`psrs-core/src/state/primitive.rs`, `psrs-runtime/src/abi/storage/mod.rs`, +`psrs-runtime/src/storage/mod.rs`, and the backend call/projection boundaries. + +GHC's IO representation uses primitive State# and a RealWorld marker; State# has +no runtime representation. This supports the selected representation direction. +It does not establish that this compiler's lexical callback interpreter and +single-root graph restrictions are required by Haskell's IO definition. Our +State is exposed at kind `Type`, whereas GHC documents State# as unlifted; the +source restrictions here require their own explicit contract. +References: [GHC IO](https://downloads.haskell.org/ghc/latest/docs/libraries/ghc-internal-9.1401.0-555c/GHC-Internal-IO.html) +and [GHC primitive State#](https://hackage-content.haskell.org/package/ghc-prim-0.12.0/docs/GHC-Prim.html). + +## Findings + +### A1: Public loops exhaust the stack (high priority, reproduced) + +The development package implements `forE` recursively through ordinary bind. +The backend's `mir/lower/tail.rs:24` returns immediately for any function with +State evidence, bypassing both self-recursion loopification and tail-call +conversion. State functions are also excluded from several optimization passes +in `mir/opt/{inline,values,cfg}.rs`. These are explicit temporary guards, not +silent successful-looking placeholders, but they impose real costs on normal +library code. + +Audit program: + +```purescript +main :: Int +main = unsafePerformEffect do + forE 0 10000 (\_ -> pure unit) + pure 42 +``` + +The program compiles successfully and Wasmtime 49.0.2 exits 134 with +`wasm trap: call stack exhausted`. The same program with 100 iterations is +accepted and exits 42. The clean pinned official Effect.js implements `forE` +as a JavaScript loop and completes 10,000 callbacks. The recursive target +implementation and disabled tail transformations are implicated by inspection; +this audit did not isolate their individual contributions by changing code. + +Disposition: make stack-safe execution of actual public loops and MonadRec +cases a package acceptance obligation. Repair the owning lowering/transfer +contract or select a justified library/runtime primitive decomposition; do not +substitute a whole-function Effect-loop intrinsic merely to bypass the issue. +Earlier short-loop conformance remains valid for its measured inputs, but does +not demonstrate stack safety. + +### A2: Raw State capture support depends on source arrangement (medium priority, reproduced) + +Three probes perform the same storage read through a closure capturing the +current raw State. Direct invocation compiles and executes to 42. Routing the +closure through a local callback helper rejects at P8; routing it through a +top-level helper rejects at P7. + +Core's `state/flow/closures.rs` interprets registered lexical lambda bodies with +a captured producer environment, treating unknown call targets conservatively. +CC's `state/captures.rs` permits one direct State capture and no explicit State +parameter. The supported subsets differ across stages. This is partial general +higher-order transport, rather than merely an execution/storage intrinsic. + +These probes are deliberately low-level State programs. This audit did not find +a migrated public Effect API requiring this exact raw-State-capturing helper +shape. Ordinary bind passes the successor to the next action as an explicit +argument. Public Effect/ST/Ref evidence predates the current capture extension. + +Disposition: defer further generic capture expansion until an actual package +reproducer requires it. Keep the current unsupported forms explicit; do not +relax checks to make them appear supported. If retained as a separate feature, +define one cross-stage invocation contract and test equivalent source forms. + +### A3: Signature projection is broader than its stated captured-call justification (medium priority, static concern) + +`mir/state/projection.rs:98` rewrites the result of every stored signature using +the structural Step-to-payload map. The nearby comment justifies this by checked +captured callback producer/body evidence, but the loop itself is not restricted +to those producers or signatures. Inventory and subsequent correspondence +checks still exist; this audit has not established an accepted invalid program +or miscompilation from this rewrite. + +Disposition: identify the authoritative set of dischargeable call/result +boundaries and project through that checked plan. Alternatively, prove and +document why every structural Step occurrence in this loop has the required +evidence. Keep physical-layout cleanup distinct from semantic admission. + +### A4: The continuation order turns generic completion into an Effect prerequisite (scope finding) + +The implementation checklist puts general scoped transport, higher-order +calls/captures/loops, and general projection before package completion and legacy +deletion. Core verification runs the State flow checker on every otherwise +checked module; that checker traverses declarations and nested State bodies. +Arrays, casts and unknown calls that carry State have additional restrictions +beyond ordinary PureScript type checking. This is substantial new semantic and +verification machinery, although it is not a complete linear type system. + +The selected design legitimately requires preserved ordering. The scope error +is treating full generality of this particular proof machinery as necessary for +finishing the migration, without identifying which public behavior it enables. +The growing Core/CC/MIR callback models and optimizer exclusions compound that +cost. Do not remove dependency checks blindly: removing runtime token values +does not remove sequencing obligations. + +Disposition: use public API/host reproducers to select required vertical slices. +Separate additional general raw-State language support from migration closure. +Keep one authoritative semantic fact across stages instead of extending several +independent restricted models for each new example. + +### A5: Normal consumption still uses legacy Effect (completion finding) + +The lock still selects the old package. `driver/program/effects.rs` retains +trusted Effect discovery and old synthesized combinators/runner behavior; +`driver/program/lowering.rs` selects that route when no ordinary runner is +configured. Legacy StateToken paths remain. Explicit development-package success +does not demonstrate migrated normal locked consumption. + +Disposition: complete coherent public API/host acceptance, remove the legacy +mechanism, and then update the lock in the established order. Do not change the +lock during this audit. + +## Explicit trust boundary + +The target-private `PSRS.Effect.fromState` uses `unsafeCoerce` to construct the +hidden ordinary Effect newtype from its exact field representation. +`Effect.Unsafe` similarly unwraps it for the runner. This is a library-owned +representation assumption, not a proof supplied by the compiler. Its signatures, +hidden-constructor policy and runtime suspension behavior must remain recorded +and tested. It is not a fabricated implementation or a per-module compiler hack. + +## Disposition and evidence limits + +Retain the newtype direction, State/RealWorld identities, two runner intrinsics, +four storage operations, alias-preserving GC arrays, checked payload conversions, +rank-N region checks and state-aware host ABI adaptation. None of those should +be rolled back simply because several compiler stages consume them. + +Prioritize public loops, full API/host behavior, optimizer transfers required by +those programs, and coherent legacy removal. Defer broader raw-State capture +generality unless a concrete public use requires it. Revisit the signature-wide +projection contract before enlarging the admitted subset. + +This audit changed no compiler or package implementation and ran no full Rust +suite, scoreboard, formatting or Clippy cohort. It inspected the normative +design, checklist, primitive/Core flow, CC capture verification, MIR projection +and optimization guards, runtime ABI/provider, driver legacy/runner paths, and +development-package Effect/ST/Ref/host wrappers. This is an architecture and +focused behavior review, not a proof of complete host/API conformance. + +Focused artifacts live in `/private/tmp/psrs-effect-state-audit-20261011/`: +`Direct.purs`, `LocalHelper.purs`, `GlobalHelper.purs` and their build logs; +`PublicLoop/run.json` (compile 0, runtime 134); +`PublicLoopSmall/run.json` (accepted, runtime 42); and `official-loop.json`. +The official checkout is clean at +`a192ddb923027d426d6ea3d8deb030c9aa7c7dda` (Effect v4.0.0). +The development package fingerprint is `fnv1a64-v1:6c93c7e357fcc3e3` and the +probed compiler SHA256 is +`11f1b614fb5d85f838308d20f8498a7d2711000f99773b8f23d498aea04a3928`. + + +## Tail-call follow-up + +After this audit, the user selected enabling tail calls in the default target. +The shared tail pass now admits State functions through checked transfer, and +the original public forE case succeeds at both 10,000 and 100,000 iterations +without library rewrites. See [the implementation evidence](library-owned-effects.md#default-tail-calls-and-checked-state-transfer-2026-10-11). +A separate generic polymorphic Task adapter case still exhausts the stack; +this follow-up does not close all representation/optimizer obligations or the +Effect migration. Findings above describe the audited pre-fix snapshot. diff --git a/docs/implementation/backend/library-owned-effects.md b/docs/implementation/backend/library-owned-effects.md index 729aef06..1018570f 100644 --- a/docs/implementation/backend/library-owned-effects.md +++ b/docs/implementation/backend/library-owned-effects.md @@ -1,6 +1,13 @@ # Library-Owned Effects: Implementation Evidence -Governing design: [library-owned effects and state dependencies](../../design/backend/fp/library-owned-effects.md). +Governing designs: [library-owned effects](../../design/backend/fp/library-owned-effects.md) +and [State primitives and dependency lowering](../../design/backend/fp/state-primitives-and-dependency-lowering.md). +The State topic owns compiler semantics and pass contracts; this record tracks +implementation evidence. General raw-State transport is not by itself a package +migration prerequisite. Select required slices using public API/host reproducers. +The [2026-10-11 audit](library-owned-effects-audit-2026-10-11.md) records the public +loop stack-exhaustion baseline and outstanding scope/projection concerns. +The tail-call follow-up below records the repaired loop case. Status: **Partial**. The state vocabulary, checked primitive type contracts and generic dependency graph verifier exist. Core verification now produces checked @@ -9,8 +16,13 @@ derives checked flow from actual single-root function instructions. P9 now automatically projects State/Step calls through straight-line bodies and nested binary and multiway choices and publishes MIR dependency evidence. Public recursive Effect loops execute through these checked calls and choices; arbitrary -CFG backedges, raw-State choice results and general scoped transport remain -incomplete. +CFG backedges and general scoped transport remain incomplete. Structured +raw-State choice results now retain control with zero-width joins. +Core now checks lexical callback dependency scopes, including captured producers +and nested local callback invocation. CC checks one direct captured State input +and its actual closure invocation. Direct captured callbacks now execute after +checked zero-width capture and signature projection. General nested and +higher-order capture transport remains incomplete. Explicit world/region runners now publish closed execution evidence and run source-selected Int entries. Ordinary source runtime bindings now reach checked CC with their logical @@ -27,7 +39,8 @@ projections and array elements is repaired, so the candidate ST reference program compiles and executes to 42 instead of being rejected at P7. Effect and ST still use the previous locked library and compiler mechanism. Runtime GC storage primitives execute independently and through the focused -source fixtures; this record does not assert official Effect runtime acceptance. +source fixtures; this record does not assert complete official Effect runtime +acceptance. ## Starting point @@ -73,24 +86,36 @@ There is no stdlib compile-acceptance improvement at this checkpoint. ## Continuation order -1. Extend checked body evidence to general scoped state transport beyond the - implemented explicit world/region boundaries; retain immutable source - correspondence during call projection. -2. Carry explicit dependencies through CC and MIR, including higher-order - calls, branches, loops, captures and signature adapters. Connect the graph - verifier to actual checked operation identities. -3. Implement general zero-width projection and checked GC runtime provider - linking/calls, then state-aware host bindings. Runtime owns storage execution; - stdlib owns combinators. Preserve checked types before erasure and in-place - alias identity. Do not route GC storage through the scalar artifact ABI. -4. Migrate Effect and ST together in the independent package, preserving official - public source contracts and recording the selected newtype adaptation. The - quantifier-evidence blocker that previously stopped this step is repaired. -5. Delete the legacy Effect mechanism, validate optimizer/final erasure and - execute complete conformance evidence. -6. Update the normal lock only after a coherent package is validated. Keep +The State topic defines the complete compiler contract. Package migration and +additional general raw-State support have distinct acceptance boundaries. +Prioritize migration work by actual public API/host failures rather than making +all general transport extensions prerequisites. + +1. Freeze public Effect/ST/Ref/host reproducers and compare pinned upstream + observations with mandatory Wasmtime. Validate stack safety for public loops + and MonadRec; the audited forE failure is repaired by the tail-call follow-up + below, while short loop traces alone do not prove general stack safety. +2. Repair the shared call, dependency and projection contracts required by those + reproducers, preserving immutable source correspondence, checked use types, + mutable alias identity and non-returning behavior. Validate runtime provider + and state-aware host adaptation through their actual invocation subgraphs. +3. Implement optimizer graph transfers required by the package, including + tail/loop conversion. Replace blanket State-function exclusions with checked + transformation contracts; verify observable traces and final erasure. +4. Complete coherent Effect/ST library, reference and host conformance in the + independent package, preserving public source contracts and documenting the + selected newtype and unsafe-adapter boundaries. +5. Delete the legacy Effect discovery/synthesis/token/entry mechanism only with + integrated package and ordinary-runner evidence. +6. Update the normal lock only after that coherent package is validated. Keep partial development packages explicit and outside normal locked consumption. +General scoped State transport, arbitrary higher-order calls, nested captures, +CFG backedges and complete source-to-CC correspondence remain tracked compiler +obligations. Their full invariants are unchanged. A new extension must name its +use case and cross-stage evidence; unsupported shapes must fail honestly rather +than blocking unrelated package acceptance or gaining permissive fallbacks. + Do not describe utility-level tests as integrated state ordering, change the normative design to match this partial checkpoint, or close Effect's migration on import-only compilation. @@ -1826,3 +1851,424 @@ arbitrary CFG backedges, scoped transport, optimizer graph rewriting, legacy deletion and coherent package pin acceptance remain open. This reference-adapter slice changed no Rust source; no workspace or official scoreboard was rerun, and the compiler library lock remains at `1e01310`. + + +## Zero-width structured State choice results (2026-10-11) + +A dynamic binary source choice writes through one selected arm, returns only +its successor State, and then reads the shared array. Core and CC accept the +checked dependency chain; the previous P9 rejects with raw State choice requires +zero-width control result projection. The retained source and comparable log are +/private/tmp/psrs-effect-raw-state-choice.purs and +/private/tmp/psrs-effect-raw-state-choice-dynamic-before.log. The selector comes +from an observable runtime read, so constant folding cannot remove this choice +before the affected boundary. + +P9 now retains structured If/TagSwitch assignments with raw-State results while +recursively projecting their arms. Removed State value identities stay reserved +in the immutable logical source. MIR lowering uses those checked declarations +for empty join parameters and empty jump payloads, without a fabricated physical +value. Source correspondence independently requires the same empty slots, exact +selector/labels/edges and original invocation placement. A zero-width result +therefore cannot erase a selected call or discard its control. This does not +add arbitrary State-returning function ABIs or scoped State captures. + +The driver regression executes both binary selections and all three integer +case selections through actual mutable writes, then reads 42/43/44. Replaying +the predecessor after either choice rejects at Core. Selected non-returning +arms must still trap, and unselected non-returning arms must leave the normal +selected value. The direct CC multiway regression checks empty physical joins +and jumps, retains immutable dependency evidence and rejects a type-consistent +added scalar join parameter and matching arm +arguments specifically through dependency verification, rather than an arity +or ordinary MIR typing failure. + +Focused mandatory-Wasmtime verification: backend library 489/489; driver State +63/63, including seven selected-path runtime observations and stale-predecessor +rejections; final strengthened mutation regression 1/1. Backend/driver all-target +Clippy and formatting/working-tree diff checks pass. The actual development +package executes the zero-width choice through ordinary Effect Bind and returns +42 with empty output: /private/tmp/psrs-effect-zero-choice-library-runtime/run.json, +package fingerprint fnv1a64-v1:6c93c7e357fcc3e3. Logs use the prefix +/private/tmp/psrs-effect-zero-choice- and suffixes final-backend.log, +final-driver.log, mutation-final.log and clippy.log. + +General scoped transport, arbitrary CFG backedges, optimizer graph rewriting, +complete API/host conformance, legacy deletion and coherent package pin +acceptance remain open. The normal compiler lock is unchanged; the development +package remains explicit. No full workspace or official scoreboard is rerun. + +## Core lexical callback dependency scopes (2026-10-11) + +The source reproducer /private/tmp/psrs-effect-scoped-state-capture.purs creates +a callback capturing the incoming State and invokes it with an ordinary Unit +argument. Before this slice, P7 reports that the state function result has no +checked state field. Core now retains free-local producers at construction, +executes known lexical callbacks against the caller's current dependency and +restores the caller's local environment on return. Strict argument evaluation +precedes the callback body. No independent root is created for the capture. +The source evaluator also supplies the executing invocation identities used by +the immutable-source correspondence verifier, replacing the separate syntactic +walk that could not follow ordinary callback calls. + +Seven Core tests cover construction, captured invocation, repeated stale use, +argument order, pure-join aliases, unsupported consumers and removal of an +executing operation from an otherwise valid graph. Seven source/Core tests +cover direct and nested lexical invocation, inert construction, stale replay, +global callback consumers, distinct callback choices and opaque array transport. +State-carrying values cannot silently become opaque at unsupported branch, +container or cast boundaries. Removing the branch transport rejection makes the +distinct-callback regression fail because the invalid program is accepted; +the mutation log is /private/tmp/psrs-effect-callback-choice-mutation.log. + +The reproducer is still rejected at P8: CC reports that the state return loses +or replays an executed dependency and that the lifted callback lacks a checked +dependency parameter. The before/after logs are +/private/tmp/psrs-effect-scoped-state-capture-before.log and +/private/tmp/psrs-effect-scoped-state-capture-after.log. This is Core evidence +only, not Wasm execution of scoped raw-State captures. CC currently retains +only a symbol for a closure value; its captured dependency producers and actual +invocation relation need a shared checked contract before MIR can project the +capture and result to zero width. Multiple captures, general global helper +instantiation, recursive captured scopes and arbitrary CFG backedges remain +required. The normal package lock and legacy mechanisms are unchanged. + +Focused review validation passes: Core library 141/141; driver State 70/70 with +mandatory Wasmtime and the explicit development package; Core/backend/driver +all-target Clippy, formatting and diff checks. The seven new source cases assert +Core behavior only; the runtime cohort covers previously supported paths. Logs +are /private/tmp/psrs-effect-scoped-{core,driver,clippy}-review.log. No full +workspace or official scoreboard is rerun. + +## CC captured dependency inputs (2026-10-11) + +The same scoped capture reproducer now passes P8. Ordinary CC capture-layout +verification supplies the capture shapes; dependency checking consumes that +shared result instead of defining a separate capture layout. A checked function +input explicitly identifies either a State parameter or an owning closure +parameter and capture index. The captured root is a formal dependency input, +supplied by the caller's retained capture producer. Reading the capture from a +different closure is rejected. Constructing a closure preserves its captured +values without advancing the chain; invoking it checks freshness and supplies +the Step successor from normal completion. Pure-body summaries and branch +rebasing use the same dependency operations as explicit-parameter calls. + +StateResultProjection owns the common Step result contract for both input forms. +The captured contract adds no synthetic State parameter to the actual function +signature. Source verification independently rederives the function input and +instruction graph, so replacing capture input evidence by parameter evidence +is rejected. Incompatible captured branch producers cannot degrade to opaque +values. Unknown consumers and nested captured transport fail explicitly. + +Four source/CC regressions check the captured producer and operation, reject +an inserted second call replaying the same capture, reject changed input +evidence and verify exclusive branch transitions. A direct join regression +rejects incompatible capture producers, including a product/opaque join. +The final source replay reports P9 MIR lowering: invalid representation table: +UnprojectedState, in /private/tmp/psrs-effect-captured-cc-build.log. No Wasm or +scoped-capture runtime success is claimed. + +The next projection must remove State capture fields with coherent index +remapping, project the captured callback's Step-returning signature and preserve +actual capture/call source correspondence. Nested captured closures, multiple +dependency sources and general higher-order transport remain required. The +normal stdlib lock and independent package sources are unchanged by this slice. + +Final focused checks pass: CC State 17/17; driver State 74/74 with mandatory +Wasmtime and the explicit development package; backend/driver all-target Clippy, +formatting and diff checks. New capture regressions prove Core/CC behavior only; +the runtime cohort covers already supported paths. Logs use +/private/tmp/psrs-effect-captured-cc- with state-final.log, driver-final.log and +clippy.log. No full workspace or official scoreboard is rerun. + +## Zero-width direct State captures (2026-10-11) + +The same source reproducer now passes physical planning and executes to 42. +Previously its direct captured callback stopped at P9 UnprojectedState +(/private/tmp/psrs-effect-captured-cc-build.log). Projection now removes logical +State capture operands, drops their slot reads, remaps surviving capture indices +by counting ordinary slots before each logical index, and projects the callback +signature's checked Step result to its payload. The ordinary parameter +convention stays intact. The shared StateResultProjection also supplies the +Step layout split without inventing an explicit State parameter. + +The rebuilt CLI accepts the frozen reproducer with the explicit development +package and emits /private/tmp/psrs-effect-capture-projected-final.wasm +(SHA-256 415f639a4935b52ed4ba4dcca2e08c40f82d5b0511f75ba9365c7e68d1602d49). +Wasmtime 49.0.2 exits 42 with empty output. The logs are +/private/tmp/psrs-effect-capture-projected-final-build.log and +/private/tmp/psrs-effect-capture-projected-final-runtime.log. + +MIR correspondence independently derives expected capture constructors and +surviving reads from immutable logical CC. The existing source CFG projection +assigns these to their actual scopes and orders; canonical host adapter regions +remain checked separately. Target, destination, ordinary capture operands and +projected getter index must all agree. Reordering two same-type array captures +or replacing a getter index by another valid physical slot rejects specifically +through P9 dependency verification, without relying on ordinary typing errors. + +Four mandatory-Wasmtime observations return 42 for State-only captures, an +ordinary array before State, an array after State, and an array/scalar pair after +State. A dynamic runtime selector executes both callback branches (42/43), +traps for the selected non-returning branch and returns 43 when that branch is +unselected. Constructing an unused callback whose body traps returns 42 without +executing it. Existing source/Core and CC stale-predecessor rejections remain. + +Focused checks pass: backend library 490/490 with mandatory Wasmtime; driver +State 77/77; final scoped-callback cohort 15/15 after adding the inert trap +observation. Backend/driver all-target Clippy, formatting and diff checks pass. +The driver cohort exercises the normal optimization and encoding pipeline. +Logs use /private/tmp/psrs-effect-capture-projection- with backend.log, +driver.log, source-final.log and clippy.log. No full workspace or official +scoreboard is rerun. + +This completes direct single-State captures, not general scoped transport. +Nested captured closures, global helper instantiation, multiple dependency +sources, arbitrary CFG backedges, dependency-aware optimizer graph transfers, +complete Effect/host conformance and legacy deletion remain required. The normal +compiler package lock and independent package sources are unchanged. + + +## Default tail calls and checked State transfer (2026-10-11) + +The stable Wasmtime/WASI 0.2 target now enables tail calls. Self recursion still +supports CFG loopification with the proposal explicitly disabled. Ordinary direct +and closure calls use return_call/return_call_ref when enabled. Library loops +remain unchanged ordinary source; no Effect-loop intrinsic was added. + +State functions no longer bypass the shared tail pass. Their evidence retains +immutable pre-tail physical MIR, already verified against logical CC. Verification +replays the same tail conversion and checks actual output instructions/control; +it then checks the predecessor's source correspondence. Proven scalar folding +uses the common optimizer operation, and module-position compaction preserves +stable SymbolId ownership. This bounded exact-conversion relation does not +close general inlining or CFG graph transfers. Mutation tests reject a changed +terminal call target and deletion of a preceding observable invocation. + +Self-loop backedge arguments are remapped to the new header parameters through +the same parameter substitution used by the loop body, preserving reused +ordinary arguments instead of referring to their initial function input. + +Focused mandatory-Wasmtime evidence: + +- `PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib PSRS_REQUIRE_WASMTIME=1 + cargo test -p psrs-driver --lib tests::tail_calls`: 6 passed, 1 ignored. + Accepted cases execute 100,000 iterations for ordinary self/mutual/indirect + recursion, State self-recursion and forwarded/swapped loop arguments. The + disabled-profile call fallback is also retained. +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib state::`: + 46 passed, including transfer mutation rejection and pre-tail correspondence. +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib capability`: + 13 passed, including disabled-proposal rejection and independent flag mapping. +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib mir::opt`: + 8 passed, covering shared scalar folding and adjacent optimizer behavior. +- Explicit development-package mandatory runtime State cohort: 78 passed. +- Public `Effect.forE` at 10,000 and 100,000 iterations compiles and exits 42 + under Wasmtime 49.0.2; accepted reports are + `/private/tmp/psrs-state-tail-loop-verified/run.json` and + `/private/tmp/psrs-state-tail-loop-100000/run.json`. The compiler SHA256 is + `441ea7636663fe495acfc2536254694b9dc8316c982d30110d8cd15f4a45fe1a`; + the package remains `fnv1a64-v1:6c93c7e357fcc3e3` during both runs. + +The package-owned Effect loop oracle was regenerated from the clean pinned +Effect v4.0.0 checkout and its ten observations were executed through the new +compiler. The accepted report is +`/private/tmp/psrs-tail-effect-loop-oracle-runtime/run.json`; source order, counts, +skipped callbacks and normal return still agree with the official JS. This +short-case oracle checks behavior separately from the deep forE stack test. + +One additional generic Task bind-loop fixture was actually executed and still +traps with call stack exhaustion: polymorphic payload boxing/recovery leaves +work after recursive calls, preventing their physical tail conversion. The +regression `ordinary_state_newtype_bind_loops_run_in_constant_stack` is explicitly +ignored with that reason and is **not** accepted runtime evidence. Its source +and WAT are retained at `/private/tmp/psrs-state-tail-bind-loop.{purs,wat}`. +Reproduce with the same explicit package and mandatory Wasmtime environment: +`cargo test -p psrs-driver --lib ordinary_state_newtype_bind_loops_run_in_constant_stack -- --ignored`. +It remains a callable-representation/specialization obligation; enabling tail +instructions does not prove stack safety for every polymorphic newtype. + +### Adapter stack-safety ownership follow-up (2026-10-11) + +The current compiler was traced on the same State Task fixture with +`PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib target/debug/psrs diagnose +/private/tmp/psrs-state-tail-bind-loop.purs --trace +--out /private/tmp/psrs-state-tail-bind-owner-before.json --timeout 45`. +Compilation and the recorded validators pass. The retained CC contains +`erased_adapter_*` bodies calling a producer and then projecting/converting and +rebuilding its result. Those calls have physical work remaining after them. +The trace has no node-lineage or canonical-summary coverage; it is not a +node-by-node source derivation proof. + +A control replaces State/Step with the ordinary newtype +`Task a = Task (Unit -> a)` and keeps the polymorphic pure/bind recursion. +There are no State imports, runtime primitives or world runners in this +control. `PureShallow.purs` at 100 iterations compiles and exits 42; +`PureDeep.purs` at 100,000 compiles but exits 134 with +`wasm trap: call stack exhausted`. Its retained MIR `erased_adapter_223` +contains `ClosureCall`, followed by `StructNew` and `RefCast`, then an ordinary +`Return`. This establishes a general erased/concrete adapter limitation; +changing State admission or adding an Effect intrinsic cannot close it. +The common callable representation/optimization owners must preserve payload +semantics and observable work when removing redundant adaptation. Simply +discarding these result operations to force a physical tail call is invalid. + +Both control runs use compiler SHA256 +`850ce3e3c1262dcd551c5d4c30f2882d2b25712a50107186b7d687688801b8b1`, +Wasmtime 49.0.2 and unchanged development package +`fnv1a64-v1:6c93c7e357fcc3e3`. Sources, runtime reports and the pure trace bundle +are retained under `/private/tmp/psrs-bind-protocol-control/`. +Reproduce either control using the package-owned runner: + +```sh +node /Users/biu/Projects/psrs-stdlib/tools/conformance.mjs run \ + --compiler /Users/biu/Projects/purescript-rs/target/debug/psrs \ + --stdlib-root /Users/biu/Projects/psrs-stdlib \ + --input /private/tmp/psrs-bind-protocol-control/PureDeep.purs \ + --out /private/tmp/psrs-bind-protocol-control/PureDeep-runtime --timeout 45 +``` + +The deep report remains failed; neither an increased host stack nor a smaller +input counts as closing constant-stack execution. No compiler implementation +change is claimed for the adapter limitation. + +A bounded Core inlining experiment then allowed only single-branch irrefutable +cases: variable/wildcard bindings, record bindings and registered newtype +constructors with one irrefutable field. Existing recursion, rank-N and size/site +guards remained. This tested whether the blanket case-body exclusion alone +accounted for the adapter recursion. Both the State and pure 100,000-step +fixtures compiled but still trapped with stack exhaustion. Reports are +`/private/tmp/psrs-case-inline-experiment/{StateDeep,PureDeep}/run.json`; both +retain unchanged package/input fingerprints. The experiment was removed, +the original optimizer files were compared byte-for-byte with their saved +preimages, and the ordinary CLI was rebuilt successfully. No relaxation of +case inlining is part of the resulting worktree. + +This rejects that particular fix hypothesis, not every possible inlining or +specialization strategy. The next representation question is how a known +closure can be produced directly at the declared callable field convention, +including its tail result, without an erased/concrete round trip. Merely moving +the same post-call conversion into a lifted lambda does not make it a tail +call. Such work must use checked field instantiation and the common argument, +result and capture contracts; it must retain the generic fallback and preserve +effects/traps. No consumer-specific Unit/Effect exception is justified by this +experiment. + +The new mandatory-Wasmtime regression +`state_mutual_tail_recursion_preserves_every_storage_update` executes 100,000 +transitions between two State functions, adding 1 and 2 alternately to an +aliased storage cell. It returns 42 only when the final cell is 150,000. Both +functions retain dependency witnesses and direct tail-call terminators. This +checks executed read/write multiplicity across checked mutual tail transfer, +separately from the generic adapter limitation above. + +The focused tail-call cohort now reports 7 passed, 0 failed and 1 ignored under +`PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib PSRS_REQUIRE_WASMTIME=1 +cargo test -p psrs-driver --lib tests::tail_calls`. Strict driver all-target +Clippy passes. Full workspace tests and suite scoreboards were not run for this +follow-up; the ignored generic adapter case remains explicitly unverified for +constant-stack behavior. + +### Current development-package host execution (2026-10-11) + +The existing package-owned Console, Clock, Arguments and Resource fixtures were +compiled and executed with the current CLI. All four reports are accepted at +`/private/tmp/psrs-effect-host-current/{Console,Clock,Arguments,Resource}/run.json`. +Console uses expected exit 0 and the package's exact `Console.stdout` golden; +the other three use expected exit 42. Each report records unchanged source +inputs and the unchanged development package +`fnv1a64-v1:6c93c7e357fcc3e3`, compiler SHA256 +`850ce3e3c1262dcd551c5d4c30f2882d2b25712a50107186b7d687688801b8b1` +and Wasmtime 49.0.2. + +Console observes `first`, then two executions of the same suspended `later` +action, against the exact stdout golden. Clock observes a wall-clock result's +nanosecond range and creates/drops a zero-duration pollable. Arguments observes +a nonempty host argument array. Resource obtains and drops stdout's stream +handle. These are real host executions through the migrated library State +wrappers, rather than unused-import acceptance. They establish these particular +host paths, not complete Console/Clock/Process/IO API conformance or resource +lifetime correctness for every operation. + +Each was run with the library-owned command: + +```sh +node /Users/biu/Projects/psrs-stdlib/tools/conformance.mjs run \ + --compiler /Users/biu/Projects/purescript-rs/target/debug/psrs \ + --stdlib-root /Users/biu/Projects/psrs-stdlib \ + --input /Users/biu/Projects/psrs-stdlib/conformance/effects/Resource.purs \ + --out /private/tmp/psrs-effect-host-current/Resource --timeout 45 +``` + +Use the corresponding fixture/output name for Clock and Arguments. Console +also supplies `--expected-exit 0 --expected-stdout +/Users/biu/Projects/psrs-stdlib/conformance/effects/Console.stdout`. +No independent package files or normal compiler lock were changed. The verified +Effect.Uncurried candidate remains outside the package pending explicit +cross-repository installation approval. + +Formatting, working-tree diff checks and strict backend/driver all-target Clippy +pass. Full workspace tests, full workspace Clippy and suite scoreboards were not +run for this focused change. No package source or normal stdlib lock was changed. + + +## Shared frozen State authority and uncurried candidate (2026-10-11) + +The public Effect depth probes now accept tailRecM at 100,000 steps and foreachE +at 10,000 elements with an observed Ref write count. Reports are +`/private/tmp/psrs-effect-depth-probes/{tailrecm,foreach}/run.json`, each executing +to 42 against the explicit development package. The generic polymorphic Task +adapter failure remains; these public successes do not close that gap. + +Actual Effect.Uncurried use was rejected at P8 because mkEffectFn1/runEffectFn1 +had no target implementation. The candidate package at +`/private/tmp/psrs-effect-uncurried-candidate` implements all twenty mk/run slots +and ten constructor-hidden EffectFn newtypes in ordinary source over the same +State protocol. It adds no intrinsic. Twenty public signatures, ten roles and +all pure Semigroup/Monoid instance bodies are unchanged; the explicit exports +hide the new constructors and private representation helper. + +The package-owned oracle evaluates 34 observations using pinned Effect v4.0.0 +JS: all arities, argument order, retained Semigroup/Monoid composition, factory +suspension, strict ordinary arguments, repeated execution, function payloads and +nested actions. Candidate deferred-factory execution returns 42; a selected +10-argument trap callback produces unreachable. The source audit reports +168 identical / 38 modified / 27 platform additions over 233 modules and 41 +packages; the removed-foreign-value count stays at 3. The new adapter's twenty +foreign slots are nonrecursive replacements. Candidate Node tools pass 12/12. + +The combined oracle originally exceeded its 180-second compilation bound. +A fixed-content rerun confirmed a 20-second timeout with unchanged inputs and +package. Inspection found per-function/per-checkpoint derivation of the entire +immutable CC State module. MIR now freezes one checked source authority and +shares its expected graphs and original function bodies with the inventory and +function witnesses. Current physical calls, operands, captures, edges, graphs, +imports and tail conversions are still verified. A new negative test proves +that changing a source copy's call producer cannot borrow the frozen authority. +Source inventory matching now uses the immutable CC arena identity. + +The same fixed oracle/package accepts after this change: compilation takes +18.58 seconds and Wasmtime exits 42. The matching before/after package fingerprint +is `fnv1a64-v1:9fb6b99e1eb78a0b`; reports are +`/private/tmp/psrs-effect-uncurried-oracle-stable-{before,after}/run.json`. +The earlier 180-second run also saw a candidate fixture inventory change and is +not a fingerprint-compatible comparison. After installing the candidate's +versioned fixtures, its separate report +`/private/tmp/psrs-effect-uncurried-versioned/run.json` accepts all 34 checks with +fingerprint `fnv1a64-v1:d34b98eb86cba0de`; compilation takes 17.79 seconds. + +Focused mandatory runtime checks after the shared-authority change: +backend State 47/47; development-package driver State 78/78. Strict backend/driver +all-target Clippy passes. Full workspace tests, workspace Clippy and scoreboards +were not run, and the normal stdlib lock is unchanged. + +Package installation is pending explicit approval. Automatic review rejected +the guarded write to the independent psrs-stdlib repository twice, first citing +a retained paused/audit-only scope and then declining to treat the active goal +status as authorization for this exact slice. No independent-package files were +written. The install script is `/private/tmp/install-effect-uncurried.py`; it +checks the untouched Uncurried preimage and absent new paths, changes only that +module's inventory hash, appends its adaptation section, and installs the oracle +and four fixtures. It does not stage, commit, push, change the compiler lock or +overwrite unrelated package work. Candidate acceptance is not installed-package +acceptance or completion of Effect's migration. From e806616ed91c396dd128c9b891948188ad938f39 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 14:03:33 +0800 Subject: [PATCH 090/148] Remove compiler-owned Effect and State mechanisms The compiler no longer owns the identity, representation, or operations of the library `Effect` type, nor the State dependency protocol. Delete the trusted-Effect synthesis and backend adaptation, the Core/CC/MIR State analysis and its shared-IR fields, the `Prim.State` primitives, the `RunWorld`/`RunRegion` intrinsics, and the runtime storage source-binding contract. Preserve the generic compiler: strict evaluation order, traps, generic foreign and WIT calls, the generic effect summaries, ordinary newtypes, closures and adapters, generic tail calls, the runtime storage crate, the linker's canonical component boundary, and the package-configured command runner. A source runtime-storage binding cannot be projected without the withdrawn State contract, so it now reports that missing interface explicitly instead of fabricating a binding. Mark the governing designs and acceptance records as withdrawn while retaining their dated evidence. No replacement Effect representation is introduced; the stdlib packages that used either mechanism are not executable and their consumers are recorded as unresolved. Co-Authored-By: Claude Opus 4.8 (1M context) --- .../psrs-backend/src/abi/link/conformance.rs | 41 -- crates/psrs-backend/src/bindings/mod.rs | 7 +- .../src/bindings/primitives/mod.rs | 1 - .../src/bindings/runtime/call/mod.rs | 155 +----- .../src/bindings/runtime/call/tests.rs | 199 ------- .../src/bindings/runtime/metadata.rs | 80 --- .../psrs-backend/src/bindings/runtime/mod.rs | 75 +-- .../src/bindings/runtime/target.rs | 94 +--- crates/psrs-backend/src/boundary/mod.rs | 36 +- .../src/boundary/newtypes/tests.rs | 45 -- crates/psrs-backend/src/boundary/tests.rs | 62 +-- crates/psrs-backend/src/cc/layout/captures.rs | 4 +- .../src/cc/layout/functions/mod.rs | 16 +- .../src/cc/layout/functions/projection/mod.rs | 39 +- .../cc/layout/functions/projection/tests.rs | 166 ------ .../src/cc/layout/functions/reachable.rs | 12 +- crates/psrs-backend/src/cc/layout/mod.rs | 4 - crates/psrs-backend/src/cc/layout/scalar.rs | 3 - .../src/cc/lower/conversion/function_slot.rs | 99 +--- .../src/cc/lower/conversion/mod.rs | 1 - .../src/cc/lower/conversion/state_slot.rs | 82 --- .../src/cc/lower/conversion/transport.rs | 13 +- crates/psrs-backend/src/cc/lower/intrinsic.rs | 38 -- .../src/cc/lower/lambda/captures.rs | 2 +- crates/psrs-backend/src/cc/lower/mod.rs | 9 - crates/psrs-backend/src/cc/mod.rs | 23 - crates/psrs-backend/src/cc/payload.rs | 10 - crates/psrs-backend/src/cc/projection.rs | 14 +- crates/psrs-backend/src/cc/representation.rs | 3 - crates/psrs-backend/src/cc/state/branches.rs | 175 ------ crates/psrs-backend/src/cc/state/captures.rs | 39 -- crates/psrs-backend/src/cc/state/eval.rs | 397 -------------- crates/psrs-backend/src/cc/state/execution.rs | 84 --- crates/psrs-backend/src/cc/state/mod.rs | 260 --------- .../src/cc/state/projection/conversion.rs | 55 -- .../src/cc/state/projection/mod.rs | 110 ---- .../src/cc/state/projection/slots.rs | 96 ---- .../src/cc/state/projection/tests.rs | 175 ------ crates/psrs-backend/src/cc/state/tests.rs | 388 -------------- crates/psrs-backend/src/cc/verify/mod.rs | 2 - .../src/cc/verify/ops/execution.rs | 19 - crates/psrs-backend/src/cc/verify/ops/mod.rs | 9 - .../psrs-backend/src/cc/verify/ops/table.rs | 6 - crates/psrs-backend/src/effects/entry.rs | 226 -------- crates/psrs-backend/src/effects/mod.rs | 127 ----- crates/psrs-backend/src/effects/suspension.rs | 462 ---------------- crates/psrs-backend/src/effects/verify.rs | 277 ---------- crates/psrs-backend/src/lib.rs | 50 +- .../psrs-backend/src/linking/runtime_tests.rs | 2 - crates/psrs-backend/src/linking/tests.rs | 1 - .../src/mir/gc_tests/binary_matrix/mod.rs | 2 +- .../psrs-backend/src/mir/layout/accessors.rs | 5 - crates/psrs-backend/src/mir/layout/mod.rs | 6 - crates/psrs-backend/src/mir/layout/tests.rs | 21 - .../psrs-backend/src/mir/lower/assignments.rs | 19 +- crates/psrs-backend/src/mir/lower/mod.rs | 50 +- .../src/mir/lower/storage_call.rs | 61 --- crates/psrs-backend/src/mir/lower/tail.rs | 6 - crates/psrs-backend/src/mir/lower/wit_call.rs | 4 - .../psrs-backend/src/mir/lower/wit_tests.rs | 3 - crates/psrs-backend/src/mir/mod.rs | 23 +- .../src/mir/number_format_tests.rs | 2 - crates/psrs-backend/src/mir/opt/cfg.rs | 7 - crates/psrs-backend/src/mir/opt/constants.rs | 5 +- crates/psrs-backend/src/mir/opt/imports.rs | 2 - crates/psrs-backend/src/mir/opt/inline.rs | 6 - .../src/mir/opt/tests/constants.rs | 1 - .../src/mir/opt/tests/control_flow.rs | 2 - crates/psrs-backend/src/mir/opt/tests/copy.rs | 1 - .../psrs-backend/src/mir/opt/tests/inline.rs | 4 - crates/psrs-backend/src/mir/opt/tests/mod.rs | 1 - crates/psrs-backend/src/mir/opt/values.rs | 11 - .../src/mir/reachable/assignments.rs | 3 +- .../psrs-backend/src/mir/runtime/context.rs | 26 +- .../src/mir/runtime/function_tests.rs | 123 ----- .../src/mir/runtime/invocation/emit.rs | 95 ---- .../src/mir/runtime/invocation/mod.rs | 186 ------- .../src/mir/runtime/invocation/tests.rs | 150 ------ .../src/mir/runtime/invocation/verify.rs | 135 ----- crates/psrs-backend/src/mir/runtime/mod.rs | 14 +- crates/psrs-backend/src/mir/runtime/tests.rs | 203 ------- .../src/mir/state/branch_tests.rs | 307 ----------- crates/psrs-backend/src/mir/state/captures.rs | 91 ---- crates/psrs-backend/src/mir/state/control.rs | 443 ---------------- .../psrs-backend/src/mir/state/host_tests.rs | 188 ------- .../psrs-backend/src/mir/state/inventory.rs | 108 ---- crates/psrs-backend/src/mir/state/mod.rs | 164 ------ .../src/mir/state/operand_tests.rs | 120 ----- .../psrs-backend/src/mir/state/projection.rs | 341 ------------ crates/psrs-backend/src/mir/state/runtime.rs | 122 ----- crates/psrs-backend/src/mir/state/source.rs | 104 ---- .../src/mir/state/switch_tests.rs | 339 ------------ crates/psrs-backend/src/mir/state/tail.rs | 102 ---- crates/psrs-backend/src/mir/state/tests.rs | 419 --------------- crates/psrs-backend/src/mir/tests/lowering.rs | 8 - crates/psrs-backend/src/mir/tests/runtime.rs | 2 - crates/psrs-backend/src/mir/tests/verify.rs | 2 - .../src/mir/verify/array_map/tests.rs | 2 - .../psrs-backend/src/mir/verify/capability.rs | 6 - .../src/mir/verify/instruction/lists.rs | 1 - crates/psrs-backend/src/mir/verify/mod.rs | 13 - .../src/mir/verify/tests/arrays.rs | 2 - .../src/mir/verify/tests/dictionary.rs | 3 - .../src/mir/verify/tests/dominance.rs | 2 - .../src/mir/verify/tests/effects.rs | 1 - .../psrs-backend/src/mir/verify/tests/gaps.rs | 6 - .../psrs-backend/src/mir/verify/tests/mod.rs | 9 - .../src/mir/verify/tests/scalar.rs | 4 - .../src/mir/verify/tests/structure.rs | 2 - .../src/mir/verify/tests/subtype.rs | 1 - .../src/mir/verify/tests/switch.rs | 2 - .../psrs-backend/src/mir/verify/tests/tail.rs | 4 - .../src/mir/wit/aggregate/decode.rs | 1 - .../psrs-backend/src/mir/wit/aggregate/mod.rs | 1 - .../src/mir/wit/parameters/primitive.rs | 1 - crates/psrs-backend/src/mir/wit/plan.rs | 78 +-- .../psrs-backend/src/mir/wit/tests/handles.rs | 1 - crates/psrs-backend/src/pipeline/mod.rs | 64 +-- .../psrs-backend/src/target_intrinsics/mod.rs | 4 - .../src/target_intrinsics/tests.rs | 5 - crates/psrs-backend/src/trace.rs | 23 - .../src/wasm/lower/extent/tests/mod.rs | 2 - .../structure/irreducible_dispatch_tests.rs | 3 - .../src/wasm/lower/structure/tests.rs | 2 - crates/psrs-backend/src/wasm/tests.rs | 2 - crates/psrs-cli/tests/command_runner.rs | 15 +- crates/psrs-core/src/effect/mod.rs | 328 ------------ crates/psrs-core/src/effect/operations.rs | 341 ------------ crates/psrs-core/src/effect/supplies.rs | 115 ---- .../psrs-core/src/instantiation/local_rows.rs | 2 - .../src/instantiation/substitution.rs | 1 - crates/psrs-core/src/lib.rs | 8 - crates/psrs-core/src/link/mod.rs | 1 - crates/psrs-core/src/link/shift.rs | 1 - crates/psrs-core/src/link/variables.rs | 2 +- crates/psrs-core/src/locals/alpha.rs | 1 - crates/psrs-core/src/locals/mod.rs | 2 +- crates/psrs-core/src/opt/dead.rs | 3 +- crates/psrs-core/src/opt/effects.rs | 2 - .../src/opt/inline/global/analysis.rs | 4 +- crates/psrs-core/src/opt/inline/global/mod.rs | 1 - crates/psrs-core/src/opt/inline/local.rs | 1 - crates/psrs-core/src/opt/simplify/mod.rs | 2 +- crates/psrs-core/src/opt/specialize/calls.rs | 1 - crates/psrs-core/src/opt/specialize/mod.rs | 4 +- crates/psrs-core/src/opt/util.rs | 3 +- crates/psrs-core/src/primitive.rs | 1 - crates/psrs-core/src/state/dependency/mod.rs | 213 -------- .../psrs-core/src/state/dependency/tests.rs | 193 ------- crates/psrs-core/src/state/flow/branches.rs | 208 -------- .../psrs-core/src/state/flow/closure_tests.rs | 153 ------ crates/psrs-core/src/state/flow/closures.rs | 165 ------ crates/psrs-core/src/state/flow/eval.rs | 246 --------- crates/psrs-core/src/state/flow/mod.rs | 324 ------------ crates/psrs-core/src/state/flow/scan.rs | 78 --- crates/psrs-core/src/state/flow/summary.rs | 66 --- crates/psrs-core/src/state/flow/tests.rs | 450 ---------------- crates/psrs-core/src/state/flow/verify.rs | 136 ----- crates/psrs-core/src/state/mod.rs | 76 --- crates/psrs-core/src/state/primitive.rs | 73 --- crates/psrs-core/src/state/tests.rs | 270 ---------- crates/psrs-core/src/tests/effects.rs | 269 ---------- crates/psrs-core/src/tests/mod.rs | 1 - crates/psrs-core/src/verify/expr/intrinsic.rs | 18 - crates/psrs-core/src/verify/expr/mod.rs | 17 +- crates/psrs-core/src/verify/mod.rs | 5 - crates/psrs-core/src/verify/scopes/expr.rs | 2 +- crates/psrs-driver/src/lib.rs | 26 +- crates/psrs-driver/src/program/compilation.rs | 14 +- crates/psrs-driver/src/program/effects.rs | 269 +--------- crates/psrs-driver/src/program/lowering.rs | 47 +- crates/psrs-driver/src/program/mod.rs | 97 +--- .../psrs-driver/src/tests/closure_protocol.rs | 9 +- .../psrs-driver/src/tests/diagnosis_trace.rs | 7 +- crates/psrs-driver/src/tests/effect_arity.rs | 166 ------ .../psrs-driver/src/tests/effects/contract.rs | 187 ------- crates/psrs-driver/src/tests/effects/entry.rs | 287 ---------- crates/psrs-driver/src/tests/effects/mod.rs | 500 ------------------ .../src/tests/generic_aggregate_audit.rs | 1 - .../src/tests/generic_aggregate_fixtures.rs | 2 +- crates/psrs-driver/src/tests/mod.rs | 3 - .../src/tests/parameterized_shapes.rs | 40 +- crates/psrs-driver/src/tests/state/cc.rs | 200 ------- crates/psrs-driver/src/tests/state/command.rs | 129 ----- crates/psrs-driver/src/tests/state/host.rs | 156 ------ crates/psrs-driver/src/tests/state/mod.rs | 482 ----------------- crates/psrs-driver/src/tests/state/runners.rs | 410 -------------- .../psrs-driver/src/tests/state/runtime_cc.rs | 366 ------------- .../src/tests/state/scoped_callbacks.rs | 354 ------------- .../src/tests/state/storage_protocol.rs | 129 ----- .../src/tests/state/zero_width_choices.rs | 82 --- crates/psrs-driver/src/tests/tail_calls.rs | 111 ---- crates/psrs-driver/src/tests/wasi/wrappers.rs | 8 +- crates/psrs-hir/src/intrinsic/effects.rs | 2 +- crates/psrs-hir/src/intrinsic/mod.rs | 29 +- crates/psrs-hir/src/intrinsic/registry.rs | 4 - crates/psrs-hir/src/intrinsic/state.rs | 82 --- crates/psrs-hir/src/lib.rs | 10 +- crates/psrs-hir/src/primitives/mod.rs | 2 - crates/psrs-hir/src/primitives/state.rs | 25 - crates/psrs-hir/src/primitives/tests.rs | 26 - crates/psrs-resolve/src/resolver/bootstrap.rs | 1 - docs/design/D-04-suite-roadmap.md | 13 +- docs/design/D-15-compiler-builtins.md | 2 +- docs/design/backend/README.md | 6 +- docs/design/backend/fp/cc-ir.md | 14 +- .../backend/fp/control-flow-and-tail-calls.md | 4 + docs/design/backend/fp/effects.md | 17 +- .../backend/fp/library-owned-effects.md | 15 +- docs/design/backend/fp/mir.md | 10 +- .../backend/fp/representation-and-evidence.md | 10 +- ...tate-primitives-and-dependency-lowering.md | 13 +- docs/design/backend/opt/core.md | 10 +- docs/design/backend/opt/mir.md | 10 +- .../backend/wasm/primitive-ffi-and-stdlib.md | 17 +- .../backend/wasm/wasi-platform-library.md | 2 +- .../frontend/semantics/foreign-imports.md | 8 +- docs/design/frontend/type-system/prim.md | 9 +- ...effect-state-removal-handoff-2026-10-11.md | 43 +- docs/implementation/backend/effects.md | 7 +- .../library-owned-effects-audit-2026-10-11.md | 6 + .../backend/library-owned-effects.md | 10 +- 222 files changed, 346 insertions(+), 16520 deletions(-) delete mode 100644 crates/psrs-backend/src/bindings/runtime/call/tests.rs delete mode 100644 crates/psrs-backend/src/cc/layout/functions/projection/tests.rs delete mode 100644 crates/psrs-backend/src/cc/lower/conversion/state_slot.rs delete mode 100644 crates/psrs-backend/src/cc/state/branches.rs delete mode 100644 crates/psrs-backend/src/cc/state/captures.rs delete mode 100644 crates/psrs-backend/src/cc/state/eval.rs delete mode 100644 crates/psrs-backend/src/cc/state/execution.rs delete mode 100644 crates/psrs-backend/src/cc/state/mod.rs delete mode 100644 crates/psrs-backend/src/cc/state/projection/conversion.rs delete mode 100644 crates/psrs-backend/src/cc/state/projection/mod.rs delete mode 100644 crates/psrs-backend/src/cc/state/projection/slots.rs delete mode 100644 crates/psrs-backend/src/cc/state/projection/tests.rs delete mode 100644 crates/psrs-backend/src/cc/state/tests.rs delete mode 100644 crates/psrs-backend/src/cc/verify/ops/execution.rs delete mode 100644 crates/psrs-backend/src/effects/entry.rs delete mode 100644 crates/psrs-backend/src/effects/mod.rs delete mode 100644 crates/psrs-backend/src/effects/suspension.rs delete mode 100644 crates/psrs-backend/src/effects/verify.rs delete mode 100644 crates/psrs-backend/src/mir/lower/storage_call.rs delete mode 100644 crates/psrs-backend/src/mir/runtime/function_tests.rs delete mode 100644 crates/psrs-backend/src/mir/runtime/invocation/emit.rs delete mode 100644 crates/psrs-backend/src/mir/runtime/invocation/mod.rs delete mode 100644 crates/psrs-backend/src/mir/runtime/invocation/tests.rs delete mode 100644 crates/psrs-backend/src/mir/runtime/invocation/verify.rs delete mode 100644 crates/psrs-backend/src/mir/runtime/tests.rs delete mode 100644 crates/psrs-backend/src/mir/state/branch_tests.rs delete mode 100644 crates/psrs-backend/src/mir/state/captures.rs delete mode 100644 crates/psrs-backend/src/mir/state/control.rs delete mode 100644 crates/psrs-backend/src/mir/state/host_tests.rs delete mode 100644 crates/psrs-backend/src/mir/state/inventory.rs delete mode 100644 crates/psrs-backend/src/mir/state/mod.rs delete mode 100644 crates/psrs-backend/src/mir/state/operand_tests.rs delete mode 100644 crates/psrs-backend/src/mir/state/projection.rs delete mode 100644 crates/psrs-backend/src/mir/state/runtime.rs delete mode 100644 crates/psrs-backend/src/mir/state/source.rs delete mode 100644 crates/psrs-backend/src/mir/state/switch_tests.rs delete mode 100644 crates/psrs-backend/src/mir/state/tail.rs delete mode 100644 crates/psrs-backend/src/mir/state/tests.rs delete mode 100644 crates/psrs-core/src/effect/mod.rs delete mode 100644 crates/psrs-core/src/effect/operations.rs delete mode 100644 crates/psrs-core/src/effect/supplies.rs delete mode 100644 crates/psrs-core/src/state/dependency/mod.rs delete mode 100644 crates/psrs-core/src/state/dependency/tests.rs delete mode 100644 crates/psrs-core/src/state/flow/branches.rs delete mode 100644 crates/psrs-core/src/state/flow/closure_tests.rs delete mode 100644 crates/psrs-core/src/state/flow/closures.rs delete mode 100644 crates/psrs-core/src/state/flow/eval.rs delete mode 100644 crates/psrs-core/src/state/flow/mod.rs delete mode 100644 crates/psrs-core/src/state/flow/scan.rs delete mode 100644 crates/psrs-core/src/state/flow/summary.rs delete mode 100644 crates/psrs-core/src/state/flow/tests.rs delete mode 100644 crates/psrs-core/src/state/flow/verify.rs delete mode 100644 crates/psrs-core/src/state/mod.rs delete mode 100644 crates/psrs-core/src/state/primitive.rs delete mode 100644 crates/psrs-core/src/state/tests.rs delete mode 100644 crates/psrs-core/src/tests/effects.rs delete mode 100644 crates/psrs-driver/src/tests/effect_arity.rs delete mode 100644 crates/psrs-driver/src/tests/effects/contract.rs delete mode 100644 crates/psrs-driver/src/tests/effects/entry.rs delete mode 100644 crates/psrs-driver/src/tests/effects/mod.rs delete mode 100644 crates/psrs-driver/src/tests/state/cc.rs delete mode 100644 crates/psrs-driver/src/tests/state/command.rs delete mode 100644 crates/psrs-driver/src/tests/state/host.rs delete mode 100644 crates/psrs-driver/src/tests/state/mod.rs delete mode 100644 crates/psrs-driver/src/tests/state/runners.rs delete mode 100644 crates/psrs-driver/src/tests/state/runtime_cc.rs delete mode 100644 crates/psrs-driver/src/tests/state/scoped_callbacks.rs delete mode 100644 crates/psrs-driver/src/tests/state/storage_protocol.rs delete mode 100644 crates/psrs-driver/src/tests/state/zero_width_choices.rs delete mode 100644 crates/psrs-hir/src/intrinsic/state.rs delete mode 100644 crates/psrs-hir/src/primitives/state.rs diff --git a/crates/psrs-backend/src/abi/link/conformance.rs b/crates/psrs-backend/src/abi/link/conformance.rs index 7c862662..1e96556a 100644 --- a/crates/psrs-backend/src/abi/link/conformance.rs +++ b/crates/psrs-backend/src/abi/link/conformance.rs @@ -22,20 +22,9 @@ pub(crate) fn validate_import_signature( module: &CoreModule, type_id: CoreTypeId, ) -> Result<(), String> { - // A declaration that threads its own `State` returns a `Step`, not the - // canonical result directly. The canonical function neither takes nor - // returns the state, so it is compared against the step's payload and the - // ordinary arguments that precede the state parameter. let Some((parameters, result)) = function_parts(module, type_id) else { return Err(incompatible(import)); }; - if parameters - .iter() - .any(|ty| psrs_core::state::region(module, *ty).is_some()) - { - let step = psrs_core::state::signature(module, type_id).map_err(str::to_owned)?; - return validate_state_stepping(import, module, &step); - } let all_primitive = parameters.iter().all(|id| is_primitive(module, *id)) && is_primitive(module, result); if all_primitive && parameters.len() != import.params.len() { @@ -130,36 +119,6 @@ fn validate_zipped_parameters( Ok(()) } -/// Validates a state-stepping foreign declaration: the canonical signature -/// describes the call the host actually performs, so the `State` parameter and -/// the step's successor field belong to the caller's dependency chain and are -/// not part of it. -fn validate_state_stepping( - import: &WasiImport, - module: &CoreModule, - step: &psrs_core::state::StateSignature, -) -> Result<(), String> { - if step.parameters.len() != import.params.len() { - return Err(mismatch(import)); - } - for (id, ty) in step.parameters.iter().zip(&import.params) { - if !core_matches_kind(module, *id, ty) { - return Err(format!( - "WIT import `{}` has a source parameter with an incompatible type", - import.name - )); - } - } - if core_matches_result(module, step.payload, import) { - Ok(()) - } else { - Err(format!( - "WIT import `{}` has a source result type incompatible with its canonical result", - import.name - )) - } -} - fn core_matches_result(module: &CoreModule, result: CoreTypeId, import: &WasiImport) -> bool { match &import.canonical_result { // A function with no WIT result maps to source `Unit`. diff --git a/crates/psrs-backend/src/bindings/mod.rs b/crates/psrs-backend/src/bindings/mod.rs index a422c492..4babee0f 100644 --- a/crates/psrs-backend/src/bindings/mod.rs +++ b/crates/psrs-backend/src/bindings/mod.rs @@ -9,16 +9,13 @@ use std::collections::{HashMap, HashSet}; mod primitives; mod runtime; pub(crate) use primitives::lower as lower_primitives; -pub(crate) use runtime::call::{ - canonical_signature as runtime_cc_signature, checked as checked_runtime_call, -}; +pub(crate) use runtime::call::canonical_signature as runtime_cc_signature; pub use runtime::metadata::RuntimeBinding; pub(crate) use runtime::metadata::{ from_core as runtime_metadata_from_core, validate_core as validate_runtime_bindings, }; pub(crate) use runtime::target::{ - RawCallResult, error as runtime_projection_error, plan_import as plan_runtime_import, - verify_import as verify_runtime_import, + plan_import as plan_runtime_import, verify_import as verify_runtime_import, }; /// The complete input consumed by P9. Platform binding metadata is kept beside diff --git a/crates/psrs-backend/src/bindings/primitives/mod.rs b/crates/psrs-backend/src/bindings/primitives/mod.rs index cb12beaf..961c9855 100644 --- a/crates/psrs-backend/src/bindings/primitives/mod.rs +++ b/crates/psrs-backend/src/bindings/primitives/mod.rs @@ -80,7 +80,6 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), | IntrinsicCategory::ArrayWrite | IntrinsicCategory::StringToBytes | IntrinsicCategory::BytesToString - | IntrinsicCategory::State ) && intrinsic != Intrinsic::UnsafeCoerce && !matches!(intrinsic, Intrinsic::NumberNaN | Intrinsic::NumberInfinity) { diff --git a/crates/psrs-backend/src/bindings/runtime/call/mod.rs b/crates/psrs-backend/src/bindings/runtime/call/mod.rs index ea1f5c68..f7f88dc4 100644 --- a/crates/psrs-backend/src/bindings/runtime/call/mod.rs +++ b/crates/psrs-backend/src/bindings/runtime/call/mod.rs @@ -1,139 +1,42 @@ //! Checked logical CC operands for the runtime-owned raw storage contract. +//! +//! The source storage operations were declared through the withdrawn State +//! protocol. No generic source-to-raw operand projection replaced it, so this +//! boundary reports the missing interface explicitly instead of fabricating a +//! successful binding. Provider identity validation lives in +//! [`super::target::verify_import`], which does not need a State contract. use crate::BackendError; use crate::bindings::RuntimeBinding; -use crate::cc::{self, RefShape, Reference, Representation, ValueShape}; -use psrs_runtime::{StorageCallProjection, StorageOperation, StorageValue}; +use crate::cc; -/// Source element equality and nominal regions are checked against Core before -/// CC publication. This boundary checks the retained logical slots and storage -/// layout; it does not authorize State erasure or prove instruction ordering. -pub(crate) fn checked( - binding: &RuntimeBinding, - module: &cc::Module, -) -> Result> { - let error = |message: &str| { - vec![ - BackendError::invalid_ir("P9 runtime projection", binding.span, message) - .with_module(binding.source_module), - ] - }; - let external = module - .externals - .iter() - .find(|external| external.symbol == binding.symbol) - .ok_or_else(|| error("runtime CC binding has no external declaration"))?; - let signature = external - .signature - .as_ref() - .ok_or_else(|| error("runtime CC binding has no logical signature"))?; - checked_signature(binding, signature, &module.representations) +fn unsupported(binding: &RuntimeBinding, message: &str) -> Vec { + vec![ + BackendError::invalid_ir("P9 runtime projection", binding.span, message) + .with_module(binding.source_module), + ] } -fn checked_signature( +/// The former State-to-Step operand projection. Retained as an explicit failure +/// while the replacement runtime binding contract is undecided. +pub(crate) fn checked( binding: &RuntimeBinding, - signature: &cc::Signature, - table: &cc::RepresentationTable, -) -> Result> { - let error = |message: &str| { - vec![ - BackendError::invalid_ir("P9 runtime projection", binding.span, message) - .with_module(binding.source_module), - ] - }; - if binding.module != psrs_runtime::STORAGE_MODULE { - return Err(error("runtime CC binding has an unknown provider")); - } - let operation = StorageOperation::from_export(&binding.function) - .ok_or_else(|| error("runtime CC binding has an unknown export"))?; - let raw = operation.projection().map_err(error)?; - let state = cc::state::StateCallProjection::checked(signature, table) - .map_err(error)? - .ok_or_else(|| error("runtime CC binding requires a checked State-to-Step signature"))?; - if state.state_parameter != raw.operands().len() { - return Err(error("runtime CC and raw operand counts disagree")); - } - for (shape, role) in signature.parameters[..state.state_parameter] - .iter() - .copied() - .zip(raw.operands().map(|(source, _)| source)) - .chain([(state.payload, raw.source().payload)]) - { - match role { - StorageValue::Int | StorageValue::Unit if shape != ValueShape::Integer => { - return Err(error( - "runtime CC index, length or Unit payload must be Integer", - )); - } - StorageValue::Array => { - let ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(id), - }) = shape - else { - return Err(error( - "runtime CC array requires a non-null concrete storage reference", - )); - }; - if !matches!(table.representation(id), Some(Representation::Array { element }) - if *element == cc::payload::erased_shape()) - { - return Err(error( - "runtime CC array requires canonical erased-element storage", - )); - } - } - StorageValue::Element | StorageValue::Any if shape == ValueShape::State => { - return Err(error( - "runtime CC payload cannot materialize a State dependency", - )); - } - _ => {} - } - } - Ok(raw) + _module: &cc::Module, +) -> Result<(), Vec> { + Err(unsupported( + binding, + "runtime storage bindings require the withdrawn State contract", + )) } -/// Select the runtime-owned storage roles only after source checking. Ordinary -/// CC conversions adapt checked use types to this protocol before MIR erasure. +/// The former canonical storage signature. There is no generic replacement, so +/// a runtime source binding cannot produce a CC signature. pub(crate) fn canonical_signature( binding: &RuntimeBinding, - signature: &cc::Signature, - table: &cc::RepresentationTable, + _signature: &cc::Signature, + _table: &cc::RepresentationTable, ) -> Result> { - let projection = checked_signature(binding, signature, table)?; - let mut result = signature.clone(); - for (shape, (role, _)) in result.parameters.iter_mut().zip(projection.operands()) { - if role == StorageValue::Element { - *shape = cc::payload::erased_shape(); - } - } - if projection.source().payload == StorageValue::Element { - let state = cc::state::StateCallProjection::checked(signature, table) - .map_err(|message| { - vec![BackendError::invalid_ir( - "P8 runtime protocol", - binding.span, - message, - )] - })? - .expect("checked runtime signature retains State"); - let slot = state - .payload_slot_signature(signature, table) - .map_err(|message| { - vec![BackendError::invalid_ir( - "P8 runtime protocol", - binding.span, - message, - )] - })?; - result.result = table - .signature(slot) - .expect("checked payload slot exists") - .result; - } - checked_signature(binding, &result, table)?; - Ok(result) + Err(unsupported( + binding, + "runtime storage bindings require the withdrawn State contract", + )) } - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-backend/src/bindings/runtime/call/tests.rs b/crates/psrs-backend/src/bindings/runtime/call/tests.rs deleted file mode 100644 index bb2ed221..00000000 --- a/crates/psrs-backend/src/bindings/runtime/call/tests.rs +++ /dev/null @@ -1,199 +0,0 @@ -use super::*; -use crate::cc::{External, ReprId, RepresentationTable, Signature}; -use psrs_hir::{ModuleId, SymbolId}; -use psrs_span::TextRange; - -fn reference(id: u32) -> ValueShape { - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(id)), - }) -} - -fn fixture(operation: StorageOperation) -> (RuntimeBinding, cc::Module) { - let span = TextRange::new(0, 1); - let binding = RuntimeBinding { - symbol: SymbolId::new(ModuleId(1), 2), - source_module: ModuleId(1), - module: psrs_runtime::STORAGE_MODULE.into(), - function: operation.abi().export.into(), - type_id: Some(psrs_core::TypeId(0)), - span, - }; - let shape = |role| match role { - StorageValue::Int | StorageValue::Unit => ValueShape::Integer, - StorageValue::Array => reference(0), - StorageValue::Element | StorageValue::Any => cc::payload::erased_shape(), - }; - let source = operation.source_contract(); - let mut parameters = source - .parameters - .iter() - .copied() - .map(shape) - .collect::>(); - parameters.push(ValueShape::State); - let module = cc::Module { - name: "RuntimeBoundary".into(), - externals: vec![External { - symbol: binding.symbol, - signature: Some(Signature { - parameters, - result: reference(1), - }), - projection: None, - }], - representations: RepresentationTable { - representations: vec![ - Representation::Array { - element: cc::payload::erased_shape(), - }, - Representation::Product { - fields: vec![shape(source.payload), ValueShape::State], - }, - ], - ..Default::default() - }, - functions: Vec::new(), - entry: None, - span, - }; - (binding, module) -} - -#[test] -fn monomorphic_elements_use_the_payload_protocol_without_changing_other_roles() { - for operation in StorageOperation::ALL { - let (binding, mut module) = fixture(operation); - let source = operation.source_contract(); - let signature = module.externals[0].signature.as_mut().unwrap(); - for (shape, role) in signature.parameters.iter_mut().zip(source.parameters) { - if *role == StorageValue::Element { - *shape = ValueShape::Integer; - } - } - if source.payload == StorageValue::Element { - module.representations.set( - ReprId(1), - Representation::Product { - fields: vec![ValueShape::Integer, ValueShape::State], - }, - ); - } - let original = signature.clone(); - module.representations.add_signature(original.clone()); - cc::state::register_payload_slots(&mut module.representations); - let canonical = canonical_signature(&binding, &original, &module.representations).unwrap(); - for ((before, after), role) in original - .parameters - .iter() - .zip(&canonical.parameters) - .zip(source.parameters) - { - assert_eq!( - *after, - if *role == StorageValue::Element { - cc::payload::erased_shape() - } else { - *before - } - ); - } - assert_eq!(canonical.parameters.last(), Some(&ValueShape::State)); - let step = cc::state::StateCallProjection::checked(&canonical, &module.representations) - .unwrap() - .unwrap(); - assert_eq!(step.state_field, 1); - if source.payload == StorageValue::Element { - assert_eq!(step.payload, cc::payload::erased_shape()); - } else { - assert_eq!(canonical.result, original.result); - } - } -} - -#[test] -fn validates_all_raw_contracts_with_permuted_step_fields() { - for operation in StorageOperation::ALL { - let (binding, module) = fixture(operation); - let plan = checked(&binding, &module).unwrap(); - assert_eq!(plan.abi().export, operation.abi().export); - assert_eq!(plan.result(), operation.projection().unwrap().result()); - } -} - -#[test] -fn rejects_noncanonical_array_storage_before_raw_call_projection() { - for operation in [ - StorageOperation::Fill, - StorageOperation::Read, - StorageOperation::Write, - ] { - let (binding, mut module) = fixture(operation); - for representation in [ - Representation::Array { - element: ValueShape::Integer, - }, - Representation::Product { - fields: vec![cc::payload::erased_shape()], - }, - ] { - module.representations.set(ReprId(0), representation); - let errors = checked(&binding, &module).err().unwrap(); - assert!( - errors[0] - .message - .contains("canonical erased-element storage") - ); - } - } -} - -#[test] -fn rejects_logical_signature_and_provider_substitution() { - for mutation in 0..8 { - let (mut binding, mut module) = fixture(StorageOperation::Read); - let signature = module.externals[0].signature.as_mut().unwrap(); - match mutation { - 0 => binding.module = "other-runtime".into(), - 1 => binding.function = "other-export".into(), - 2 => signature.parameters.pop().map(|_| ()).unwrap(), - 3 => signature.parameters.insert(0, ValueShape::State), - 4 => signature.parameters.insert(0, ValueShape::Integer), - 5 => signature.parameters[1] = ValueShape::Boolean, - 6 => signature.result = cc::payload::erased_shape(), - _ => { - signature.parameters[0] = ValueShape::Reference(Reference { - nullable: true, - heap: RefShape::Repr(ReprId(0)), - }) - } - } - assert!(checked(&binding, &module).is_err(), "mutation {mutation}"); - } -} - -#[test] -fn rejects_payload_and_successor_layout_drift() { - for (operation, fields) in [ - ( - StorageOperation::Fill, - vec![ValueShape::Integer, ValueShape::State], - ), - ( - StorageOperation::Write, - vec![cc::payload::erased_shape(), ValueShape::State], - ), - ( - StorageOperation::Read, - vec![ValueShape::State, ValueShape::State], - ), - (StorageOperation::Read, vec![cc::payload::erased_shape()]), - ] { - let (binding, mut module) = fixture(operation); - module - .representations - .set(ReprId(1), Representation::Product { fields }); - assert!(checked(&binding, &module).is_err()); - } -} diff --git a/crates/psrs-backend/src/bindings/runtime/metadata.rs b/crates/psrs-backend/src/bindings/runtime/metadata.rs index 42a7d5c0..3abfeedd 100644 --- a/crates/psrs-backend/src/bindings/runtime/metadata.rs +++ b/crates/psrs-backend/src/bindings/runtime/metadata.rs @@ -97,7 +97,6 @@ pub(crate) fn validate_core( #[cfg(test)] mod tests { use super::*; - use crate::{bindings::ExternalBindings, cc}; fn fixture() -> CoreModule { let mut module = crate::bindings::tests::module(Vec::new()); @@ -144,83 +143,4 @@ mod tests { wrong[0].symbol = SymbolId::new(module.id, 8); assert!(validate_core(&wrong, &module).is_err()); } - - #[test] - fn direct_cc_runtime_bindings_cannot_bypass_the_projection_boundary() { - let source = fixture(); - let binding = from_core(&source).remove(0); - let mut module = cc::Module { - name: source.name.clone(), - externals: vec![cc::External { - symbol: binding.symbol, - signature: None, - projection: None, - }], - representations: cc::RepresentationTable::default(), - functions: Vec::new(), - entry: None, - span: source.span, - }; - let bindings = ExternalBindings { - imports: Vec::new(), - runtime: vec![binding.clone()], - }; - let errors = bindings.validate_cc(&module).unwrap_err(); - assert_eq!(errors[0].pass, "P9 runtime projection"); - assert_eq!( - errors[0].message, - "runtime CC binding has no logical signature" - ); - let array = module.representations.reserve(); - module.representations.set( - array, - cc::Representation::Array { - element: cc::payload::erased_shape(), - }, - ); - let step = module.representations.reserve(); - module.representations.set( - step, - cc::Representation::Product { - fields: vec![cc::ValueShape::State, cc::payload::erased_shape()], - }, - ); - let reference = |id| { - cc::ValueShape::Reference(cc::Reference { - nullable: false, - heap: cc::RefShape::Repr(id), - }) - }; - module.externals[0].signature = Some(cc::Signature { - parameters: vec![ - reference(array), - cc::ValueShape::Integer, - cc::ValueShape::State, - ], - result: reference(step), - }); - bindings.validate_cc(&module).unwrap(); - let (lowered, _) = crate::mir::lower_module_with_bindings( - module.clone(), - bindings.clone(), - crate::TargetCapabilities::default(), - ) - .unwrap(); - assert!( - lowered.imports.is_empty(), - "unused runtime declarations do not emit imports" - ); - let mut missing = bindings.clone(); - missing.runtime.clear(); - assert_eq!( - missing.validate_cc(&module).unwrap_err()[0].pass, - "P9 external binding validation" - ); - let mut duplicate = bindings; - duplicate.runtime.push(binding); - assert_eq!( - duplicate.validate_cc(&module).unwrap_err()[0].pass, - "P9 external binding validation" - ); - } } diff --git a/crates/psrs-backend/src/bindings/runtime/mod.rs b/crates/psrs-backend/src/bindings/runtime/mod.rs index 67e4f486..5e5fee88 100644 --- a/crates/psrs-backend/src/bindings/runtime/mod.rs +++ b/crates/psrs-backend/src/bindings/runtime/mod.rs @@ -2,9 +2,9 @@ //! Export lookup and physical operations belong to psrs-runtime, not HIR. use crate::BackendError; -use psrs_core::{Module, Type, TypeConstructor, state::StateSignature}; +use psrs_core::Module; use psrs_hir::ExternalKind; -use psrs_runtime::{StorageOperation, StorageValue}; +use psrs_runtime::StorageOperation; pub(super) mod call; pub(super) mod metadata; @@ -12,6 +12,10 @@ pub(super) mod target; /// Validate all declarations, including unused ones, before lowering/erasure. /// The immutable checked Core arena owns every signature identity used here. +/// +/// The former State-to-Step source contract check was removed with the State +/// mechanism. Provider identity and export existence are still checked; the +/// operand projection is reported unsupported at the CC boundary instead. pub(crate) fn validate(module: &Module) -> Result<(), Vec> { for external in &module.externals { let ExternalKind::Runtime { @@ -36,76 +40,11 @@ pub(crate) fn validate(module: &Module) -> Result<(), Vec> { if provider != psrs_runtime::STORAGE_MODULE { return Err(error(format!("unknown runtime provider `{provider}`"))); } - let operation = StorageOperation::from_export(function).ok_or_else(|| { + StorageOperation::from_export(function).ok_or_else(|| { error(format!( "runtime provider `{provider}` has no export `{function}`" )) })?; - let checked = checked - .ok_or_else(|| error("runtime binding has no checked source signature".into()))?; - let signature = psrs_core::state::signature(module, checked.ty) - .map_err(|message| error(format!("runtime binding `{function}`: {message}")))?; - validate_contract(module, operation, &signature) - .map_err(|message| error(format!("runtime binding `{function}`: {message}")))?; - } - Ok(()) -} - -fn validate_contract( - module: &Module, - operation: StorageOperation, - signature: &StateSignature, -) -> Result<(), &'static str> { - let projection = operation.projection()?; - let source = projection.source(); - if signature.parameters.len() != source.parameters.len() { - return Err("runtime source and physical argument counts disagree"); - } - let mut element = None; - for (ty, expected) in signature - .parameters - .iter() - .copied() - .zip(projection.operands().map(|(source, _)| source)) - .chain([(signature.payload, source.payload)]) - { - let checked = match expected { - StorageValue::Int => { - if module.types.get(ty.0 as usize) != Some(&Type::Constructor(TypeConstructor::Int)) - { - return Err("runtime index or length must have checked type Int"); - } - None - } - StorageValue::Unit => { - if module.types.get(ty.0 as usize) - != Some(&Type::Constructor(TypeConstructor::Unit)) - { - return Err("runtime void operation must have checked payload Unit"); - } - None - } - StorageValue::Array => { - let (head, arguments) = module - .applied_constructor(ty) - .ok_or("runtime storage operand must be Array")?; - if head != TypeConstructor::Array || arguments.len() != 1 { - return Err("runtime storage operand must be a saturated Array"); - } - Some(arguments[0]) - } - StorageValue::Element => Some(ty), - StorageValue::Any => None, - }; - if let Some(checked) = checked { - if let Some(element) = element { - if !module.types_equivalent(element, checked) { - return Err("runtime storage element and checked payload types disagree"); - } - } else { - element = Some(checked); - } - } } Ok(()) } diff --git a/crates/psrs-backend/src/bindings/runtime/target.rs b/crates/psrs-backend/src/bindings/runtime/target.rs index 165ac40a..dfe7ee82 100644 --- a/crates/psrs-backend/src/bindings/runtime/target.rs +++ b/crates/psrs-backend/src/bindings/runtime/target.rs @@ -1,17 +1,9 @@ //! Storage-provider ABI adaptation at the external-binding boundary. //! MIR consumers receive physical signatures and a general return convention. -use crate::mir::{Import, RuntimeImport, layout::PlannedLayout}; +use crate::mir::{Import, layout::PlannedLayout}; use crate::types::{CompositeType, FieldType, HeapType, RecGroup, RefType, StorageType, ValueType}; use crate::{BackendError, RuntimeBinding, cc}; -use psrs_runtime::{StorageResultProjection, StorageType as RawType}; - -/// Result adaptation for a checked external call, independent of its provider. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub(crate) enum RawCallResult { - Value, - Unit, - Never, -} +use psrs_runtime::StorageType as RawType; fn matches_raw_type(raw: RawType, value: ValueType, types: &[RecGroup]) -> bool { match (raw, value) { @@ -89,79 +81,17 @@ pub(crate) fn error(binding: &RuntimeBinding, message: &str) -> Vec Result<(Import, RawCallResult), Vec> { - let raw = crate::bindings::checked_runtime_call(binding, logical)?; - let signature = logical - .externals - .iter() - .find(|external| external.symbol == binding.symbol) - .and_then(|external| external.signature.as_ref()) - .unwrap(); - let state = cc::state::StateCallProjection::checked(signature, &logical.representations) - .map_err(|message| error(binding, message))? - .unwrap(); - let physical = |raw: RawType, shape: cc::ValueShape| -> Result> { - match raw { - RawType::I32 => Ok(ValueType::I32), - RawType::Value => Ok(ValueType::Ref(RefType { - nullable: true, - heap: HeapType::Eq, - })), - RawType::Array => { - let ty = layout.value_type(&shape).map_err(|_| { - error( - binding, - "runtime array has no planned type in the application arena", - ) - })?; - let ValueType::Ref(RefType { - nullable: false, - heap: HeapType::Index(_), - }) = ty - else { - return Err(error( - binding, - "runtime array has no non-null concrete target type", - )); - }; - if !matches_raw_type(raw, ty, layout.types()) { - return Err(error( - binding, - "runtime array target must be mutable nullable-eqref storage", - )); - } - Ok(ty) - } - } - }; - let parameters = raw - .operands() - .zip(&signature.parameters) - .map(|((_, raw), shape)| physical(raw, *shape)) - .collect::, _>>()?; - let result = raw - .abi() - .result - .map(|raw| physical(raw, state.payload)) - .transpose()?; - Ok(( - Import { - runtime: Some(RuntimeImport { - module: binding.module.clone(), - function: binding.function.clone(), - }), - symbol: binding.symbol, - parameters, - result, - }, - match raw.result() { - StorageResultProjection::Value(_) => RawCallResult::Value, - StorageResultProjection::Unit => RawCallResult::Unit, - StorageResultProjection::Never => RawCallResult::Never, - }, + _logical: &cc::Module, + _layout: &PlannedLayout, +) -> Result> { + Err(error( + binding, + "runtime storage bindings require the withdrawn State contract", )) } diff --git a/crates/psrs-backend/src/boundary/mod.rs b/crates/psrs-backend/src/boundary/mod.rs index e4953b10..c9f9bb95 100644 --- a/crates/psrs-backend/src/boundary/mod.rs +++ b/crates/psrs-backend/src/boundary/mod.rs @@ -23,9 +23,6 @@ pub(crate) enum RepresentationPolicy { /// The fixed parameters are the constructor's checked instantiation /// arguments (a function arrow's domain). InstantiationArguments, - /// The owner registered explicit fixed parameters (the Effect runtime - /// token). The payload remains the application's result. - Fixed(Vec), /// Complete source and canonical callable fields of a transparent newtype. /// Storage uses the declared field, without specializing its free variables. Newtype(newtypes::NewtypeCallable), @@ -84,13 +81,12 @@ impl RepresentationRegistry { ) -> Option> { Some(match self.policies.get(&constructor)? { RepresentationPolicy::InstantiationArguments => arguments.to_vec(), - RepresentationPolicy::Fixed(parameters) => parameters.clone(), RepresentationPolicy::Newtype(template) => template.parameters.clone(), }) } /// A transparent newtype's full declared storage result. Ordinary function - /// and legacy fixed-token policies obtain their result from the use type. + /// policies obtain their result from the use type. fn protocol_result(&self, constructor: TypeConstructor) -> Option { match self.policies.get(&constructor)? { RepresentationPolicy::Newtype(template) => Some(template.result), @@ -248,32 +244,10 @@ pub(crate) fn payload_erased_protocols( "callable owner has no registered signature", )] })?; - let error = |message: &'static str| { - vec![crate::BackendError::invalid_ir( - "P8 callable protocol", - span, - message, - )] - }; - let result = if let Some(state) = - crate::cc::state::StateCallProjection::checked(&signature, representations) - .map_err(error)? - { - let slot = state - .payload_slot_signature(&signature, representations) - .map_err(error)?; - representations - .signature(slot) - .ok_or_else(|| { - error("State callable protocol has no registered payload signature") - })? - .result - } else { - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Erased, - }) - }; + let result = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }); let protocol = Signature { parameters: signature.parameters, result, diff --git a/crates/psrs-backend/src/boundary/newtypes/tests.rs b/crates/psrs-backend/src/boundary/newtypes/tests.rs index e61db9ee..07a34467 100644 --- a/crates/psrs-backend/src/boundary/newtypes/tests.rs +++ b/crates/psrs-backend/src/boundary/newtypes/tests.rs @@ -30,51 +30,6 @@ fn module(types: Vec, field: TypeId, parameters: Vec) -> M } } -#[test] -fn state_field_preserves_region_domain_and_complete_step_result() { - let r = TypeVariableId(0); - let a = TypeVariableId(1); - let module = module( - vec![ - Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_STATE)), - Type::Variable(r), - Type::Application(TypeId(0), TypeId(1)), - Type::Variable(a), - Type::RowEmpty, - Type::RowExtend { - label: "value".into(), - ty: TypeId(3), - tail: TypeId(4), - }, - Type::RowExtend { - label: "state".into(), - ty: TypeId(2), - tail: TypeId(5), - }, - Type::Constructor(TypeConstructor::Record), - Type::Application(TypeId(7), TypeId(6)), - Type::Constructor(TypeConstructor::Function), - Type::Application(TypeId(9), TypeId(2)), - Type::Application(TypeId(10), TypeId(8)), - ], - TypeId(11), - vec![r, a], - ); - let original = module.types.clone(); - let template = callable(&module, OWNER).unwrap(); - assert_eq!(template.source_field, TypeId(11)); - assert_eq!(template.source_variables, [r, a]); - assert_eq!(template.parameters, [TypeId(2)]); - assert_eq!(template.result, TypeId(8)); - let state = psrs_core::state::signature(&module, template.storage_field).unwrap(); - assert_eq!(state.region, TypeId(1)); - assert_eq!(state.payload, TypeId(3)); - assert_eq!( - module.types, original, - "protocol discovery cannot rewrite source types" - ); -} - #[test] fn nested_newtype_keeps_application_evidence_and_canonical_storage_owner() { let inner = HirTypeId::new(ModuleId(0), 1); diff --git a/crates/psrs-backend/src/boundary/tests.rs b/crates/psrs-backend/src/boundary/tests.rs index c4fbb7b2..aac0a817 100644 --- a/crates/psrs-backend/src/boundary/tests.rs +++ b/crates/psrs-backend/src/boundary/tests.rs @@ -1,51 +1,7 @@ use super::*; -use crate::cc::{Representation, RepresentationTable}; +use crate::cc::RepresentationTable; use psrs_span::TextRange; -#[test] -fn state_constructor_protocol_preserves_parameters_and_successor() { - let mut table = RepresentationTable::default(); - let step = table.reserve(); - table.set( - step, - Representation::Product { - fields: vec![ValueShape::State, ValueShape::Integer], - }, - ); - table.set_product_labels(step, vec!["state".into(), "value".into()]); - let parameters = vec![ValueShape::Integer, ValueShape::State]; - let source = table.add_signature(Signature { - parameters: parameters.clone(), - result: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(step), - }), - }); - crate::cc::state::register_payload_slots(&mut table); - let protocols = payload_erased_protocols( - &mut table, - &HashMap::from([(TypeId(0), source)]), - TextRange::default(), - ) - .unwrap(); - let signature = table.signature(protocols[&source]).unwrap(); - assert_eq!(signature.parameters, parameters); - let ValueShape::Reference(Reference { - heap: RefShape::Repr(result), - .. - }) = signature.result - else { - panic!("Step protocol must retain a product"); - }; - assert_eq!(table.product_labels(result).unwrap(), ["state", "value"]); - assert_eq!( - table.representation(result), - Some(&Representation::Product { - fields: vec![ValueShape::State, crate::cc::payload::erased_shape()], - }) - ); -} - #[test] fn callable_protocol_rejects_missing_owner_signature() { let errors = payload_erased_protocols( @@ -56,19 +12,3 @@ fn callable_protocol_rejects_missing_owner_signature() { .unwrap_err(); assert!(errors[0].message.contains("no registered signature")); } - -#[test] -fn callable_protocol_rejects_state_without_a_step_result() { - let mut table = RepresentationTable::default(); - let source = table.add_signature(Signature { - parameters: vec![ValueShape::State], - result: ValueShape::Integer, - }); - let errors = payload_erased_protocols( - &mut table, - &HashMap::from([(TypeId(0), source)]), - TextRange::default(), - ) - .unwrap_err(); - assert!(errors[0].message.contains("Step product")); -} diff --git a/crates/psrs-backend/src/cc/layout/captures.rs b/crates/psrs-backend/src/cc/layout/captures.rs index 63b20289..c04d470a 100644 --- a/crates/psrs-backend/src/cc/layout/captures.rs +++ b/crates/psrs-backend/src/cc/layout/captures.rs @@ -75,7 +75,7 @@ fn expression_has_integer_capture_inner(expression: &Expr, module: &CoreModule) | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => false, - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => false, + ExprKind::Unit | ExprKind::Trap => false, } } @@ -171,7 +171,7 @@ fn free_integer_local_inner( | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => false, - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => false, + ExprKind::Unit | ExprKind::Trap => false, } } diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index 68fc76cf..822cfb17 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -113,7 +113,7 @@ pub(crate) fn function_signature( function_types: &HashMap, ) -> Result> { let projection = CallProjection::checked(module, id)?; - let mut signature = projection.physical_signature(|source, ty| { + let signature = projection.physical_signature(|source, ty| { scalar_type( source, ty, @@ -126,20 +126,6 @@ pub(crate) fn function_signature( function_types, ) })?; - if projection.state_contract().is_some() { - signature.parameters.push(ValueShape::State); - signature.result = scalar_type( - module, - projection.logical_result(), - module.span, - enum_types, - aggregate_types, - newtype_ids, - array_types, - record_types, - function_types, - )?; - } Ok(signature) } diff --git a/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs b/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs index 97640579..bcd944a6 100644 --- a/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/projection/mod.rs @@ -1,53 +1,27 @@ //! Checked logical-to-physical calling signatures. This plans storage only; -//! expression lowering must retain the state dependency of every invocation. +//! expression lowering retains the calling convention of every invocation. use super::super::layout_error; use crate::BackendError; use crate::cc::{Signature, ValueShape}; -use psrs_core::{Module, TypeId, state::StateSignature}; +use psrs_core::{Module, TypeId}; pub(super) struct CallProjection<'a> { source: &'a Module, parameters: Vec, result: TypeId, - logical_result: TypeId, - state: Option, } impl<'a> CallProjection<'a> { pub(super) fn checked(source: &'a Module, ty: TypeId) -> Result> { let (parameters, result) = psrs_core::call_parts(&source.types, ty) .map_err(|message| layout_error(source.span, message))?; - let has_state = parameters - .iter() - .any(|parameter| psrs_core::state::region(source, *parameter).is_some()); - if has_state { - let state = psrs_core::state::signature(source, ty) - .map_err(|message| layout_error(source.span, message))?; - return Ok(Self { - source, - parameters: state.parameters.clone(), - result: state.payload, - logical_result: result, - state: Some(state), - }); - } Ok(Self { source, parameters, result, - logical_result: result, - state: None, }) } - pub(super) fn state_contract(&self) -> Option<&StateSignature> { - self.state.as_ref() - } - - pub(super) fn logical_result(&self) -> TypeId { - self.logical_result - } - /// Only payload types reach the physical layout callback. The source arena /// is retained explicitly so the projected TypeIds cannot be interpreted in /// a rewritten physical arena. An empty parameter list is a real nullary @@ -62,15 +36,6 @@ impl<'a> CallProjection<'a> { .map(|ty| shape(self.source, *ty)) .collect::, _>>()?; let result = shape(self.source, self.result)?; - if parameters.contains(&ValueShape::State) || result == ValueShape::State { - return Err(layout_error( - self.source.span, - "nested state payloads require checked zero-width result projection", - )); - } Ok(Signature { parameters, result }) } } - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-backend/src/cc/layout/functions/projection/tests.rs b/crates/psrs-backend/src/cc/layout/functions/projection/tests.rs deleted file mode 100644 index 9d20f155..00000000 --- a/crates/psrs-backend/src/cc/layout/functions/projection/tests.rs +++ /dev/null @@ -1,166 +0,0 @@ -use super::*; -use crate::cc::{RefShape, Reference, SignatureId}; -use psrs_core::{Type, TypeConstructor}; -use psrs_hir::{ModuleId, TypeId as HirTypeId, TypeVariableId}; -use std::collections::{HashMap, HashSet}; - -fn fixture() -> Module { - Module { - id: ModuleId(0), - name: "OrdinaryStateCallable".into(), - externals: Vec::new(), - external_types: Vec::new(), - types: vec![ - Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_STATE)), - Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_REAL_WORLD)), - Type::Application(TypeId(0), TypeId(1)), - Type::Constructor(TypeConstructor::Int), - Type::RowEmpty, - Type::RowExtend { - label: "value".into(), - ty: TypeId(3), - tail: TypeId(4), - }, - Type::RowExtend { - label: "state".into(), - ty: TypeId(2), - tail: TypeId(5), - }, - Type::Constructor(TypeConstructor::Record), - Type::Application(TypeId(7), TypeId(6)), - Type::Constructor(TypeConstructor::Function), - Type::Application(TypeId(9), TypeId(2)), - Type::Application(TypeId(10), TypeId(8)), - ], - newtype_ids: Vec::new(), - opaque_ids: Vec::new(), - callable_types: Vec::new(), - constructors: Vec::new(), - declarations: Vec::new(), - type_names: Vec::new(), - entry: None, - span: psrs_span::TextRange::new(0, 1), - } -} - -fn physical( - projection: &CallProjection<'_>, - functions: &HashMap, -) -> Signature { - projection - .physical_signature(|source, ty| { - crate::cc::layout::scalar_type( - source, - ty, - source.span, - &HashSet::new(), - &HashSet::new(), - &HashSet::new(), - &HashMap::new(), - &HashMap::new(), - functions, - ) - }) - .unwrap() -} - -#[test] -fn state_call_projects_to_nullary_payload_without_state_or_step_layout() { - let source = fixture(); - let before = source.types.clone(); - let projection = CallProjection::checked(&source, TypeId(11)).unwrap(); - let signature = physical(&projection, &HashMap::new()); - assert!(signature.parameters.is_empty()); - assert_eq!(signature.result, ValueShape::Integer); - assert_eq!(projection.state_contract().unwrap().region, TypeId(1)); - assert_eq!(source.types, before); -} - -#[test] -fn fixed_state_closure_preserves_ordinary_arguments_and_function_payload() { - let mut source = fixture(); - source.types.push(Type::Closure { - parameters: vec![TypeId(3)], - result: TypeId(3), - }); - let Type::RowExtend { ty, .. } = &mut source.types[5] else { - unreachable!() - }; - *ty = TypeId(12); - source.types.push(Type::Closure { - parameters: vec![TypeId(3), TypeId(2)], - result: TypeId(8), - }); - let projection = CallProjection::checked(&source, TypeId(13)).unwrap(); - let signature = physical(&projection, &HashMap::from([(TypeId(12), SignatureId(7))])); - assert_eq!(signature.parameters, [ValueShape::Integer]); - assert_eq!( - signature.result, - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Closure(SignatureId(7)), - }) - ); -} - -#[test] -fn returned_state_action_keeps_its_own_call_boundary() { - let mut source = fixture(); - source.types.push(Type::Closure { - parameters: Vec::new(), - result: TypeId(11), - }); - let projection = CallProjection::checked(&source, TypeId(12)).unwrap(); - assert!(projection.state_contract().is_none()); - let signature = physical(&projection, &HashMap::from([(TypeId(11), SignatureId(7))])); - assert!(signature.parameters.is_empty()); - assert_eq!( - signature.result, - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Closure(SignatureId(7)), - }) - ); -} - -#[test] -fn region_mismatch_and_nonfinal_state_reject_before_physical_layout() { - let mut source = fixture(); - source.types.push(Type::Variable(TypeVariableId(0))); - source.types.push(Type::Application(TypeId(0), TypeId(12))); - let Type::RowExtend { ty, .. } = &mut source.types[6] else { - unreachable!() - }; - *ty = TypeId(13); - assert!(CallProjection::checked(&source, TypeId(11)).is_err()); - let mut source = fixture(); - source.types.push(Type::Closure { - parameters: vec![TypeId(2), TypeId(3)], - result: TypeId(8), - }); - assert!(CallProjection::checked(&source, TypeId(12)).is_err()); -} - -#[test] -fn cc_state_signature_retains_dependencies_until_instruction_projection() { - let source = fixture(); - let signature = super::super::function_signature( - &source, - TypeId(11), - &HashSet::new(), - &HashSet::new(), - &HashSet::new(), - &HashMap::new(), - &HashMap::from([(TypeId(8), crate::cc::ReprId(0))]), - &HashMap::new(), - ) - .unwrap(); - assert_eq!(signature.parameters, [ValueShape::State]); - assert_eq!( - signature.result, - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(crate::cc::ReprId(0)), - }) - ); -} diff --git a/crates/psrs-backend/src/cc/layout/functions/reachable.rs b/crates/psrs-backend/src/cc/layout/functions/reachable.rs index 461e100a..39755c2c 100644 --- a/crates/psrs-backend/src/cc/layout/functions/reachable.rs +++ b/crates/psrs-backend/src/cc/layout/functions/reachable.rs @@ -30,17 +30,15 @@ pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { record_type(module, *field, &mut visiting, &mut referenced); } } - // Runtime declarations must publish complete logical call contracts even - // when unused. Their Step and callable payload layouts cannot be inferred - // from the remaining bodies alone. A state-stepping declaration needs the - // same treatment whichever interface it binds, because its result is a - // Step whose successor and payload are not reachable from any body. + // Runtime declarations must publish their callable payload layouts even + // when unused, because a runtime import's function shape is fixed by its + // provider contract rather than inferred from any remaining body. for checked in &module.external_types { let runtime = module.externals.iter().any(|external| { external.symbol == checked.symbol && matches!(external.kind, psrs_hir::ExternalKind::Runtime { .. }) }); - if runtime || psrs_core::state::signature(module, checked.ty).is_ok() { + if runtime { record_type(module, checked.ty, &mut visiting, &mut referenced); } } @@ -131,7 +129,7 @@ fn record_expr_inner( | ExprKind::Char(_) => {} // Both mention no subexpression, so the type recorded above is all // their layout can refer to. - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} } } diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 2877d2ad..f01c5228 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -50,9 +50,6 @@ pub(super) fn primitive_value_shape(constructor: TypeConstructor) -> Option Option { let id = unquantified_type(module, id); - if psrs_core::state::region(module, id).is_some() { - return Some(ValueShape::State); - } match module.types.get(id.0 as usize)? { Type::Constructor(constructor) => primitive_value_shape(*constructor), _ => None, @@ -300,7 +297,6 @@ pub(super) fn type_layout( protocols::append(&mut representations); let function_slot = crate::boundary::function_slot_protocol(&mut representations); - crate::cc::state::register_payload_slots(&mut representations); let protocols = crate::boundary::payload_erased_protocols( &mut representations, &function_types, diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index c3c7a559..064a6e59 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -217,9 +217,6 @@ pub(crate) fn scalar_type( record_types: &HashMap, function_types: &HashMap, ) -> Result> { - if primitive_shape_of(module, id) == Some(ValueShape::State) { - return Ok(ValueShape::State); - } // A callable closure value — an ordinary arrow or a registered callable // constructor application — is represented by its closure signature. if is_callable_type(module, id) { diff --git a/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs b/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs index 3133f8fc..aac0e6bd 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/function_slot.rs @@ -2,7 +2,6 @@ //! Erasure curries flattened calls into unary erased segments; recovery applies //! those segments and adapts every argument and the final result explicitly. use super::super::LambdaLowering; -use super::state_slot::StateSlot; use super::*; use crate::cc::{Function, Signature, SignatureId}; @@ -40,14 +39,8 @@ impl FunctionLowerer<'_> { "function slot producer requires an argument", )); } - let state = self.state_slot(&shape, span)?; - let initial = if shape.parameters[0] == ValueShape::State { - state.unwrap().signature - } else { - slot - }; - let function = self.slot_segment(source, slot, &shape, 0, state, span)?; - self.slot_factory(source, initial, function, span) + let function = self.slot_segment(source, slot, &shape, 0, span)?; + self.slot_factory(source, slot, function, span) } fn slot_segment( @@ -56,7 +49,6 @@ impl FunctionLowerer<'_> { slot: SignatureId, shape: &Signature, prefix: usize, - state: Option, span: TextRange, ) -> Result> { let mut body = self.child_lowerer(); @@ -64,17 +56,8 @@ impl FunctionLowerer<'_> { nullable: false, heap: RefShape::Aggregate, })); - let terminal = shape.parameters[prefix] == ValueShape::State; - let input_shape = if terminal { - ValueShape::State - } else { - erased_shape() - }; - let result_shape = if terminal { - state.unwrap().result - } else { - erased_shape() - }; + let input_shape = erased_shape(); + let result_shape = erased_shape(); let input = body.fresh(input_shape); let mut assignments = Vec::new(); let producer = body.slot_capture(receiver, 0, closure(source), span, &mut assignments); @@ -88,11 +71,7 @@ impl FunctionLowerer<'_> { &mut assignments, )); } - let conversion = if terminal { - ValueConversion::Identity - } else { - body.recover_payload(shape.parameters[prefix], span)? - }; + let conversion = body.recover_payload(shape.parameters[prefix], span)?; arguments.push(body.emit_conversion( input, input_shape, @@ -112,11 +91,7 @@ impl FunctionLowerer<'_> { }, span, }); - let conversion = if terminal { - body.state_slot_result(state.unwrap(), true, span)? - } else { - body.erase_payload(shape.result, span)? - }; + let conversion = body.erase_payload(shape.result, span)?; body.emit_conversion( result, shape.result, @@ -126,27 +101,22 @@ impl FunctionLowerer<'_> { &mut assignments, ) } else { - let next = body.slot_segment(source, slot, shape, prefix + 1, state, span)?; - let next_slot = if shape.parameters[prefix + 1] == ValueShape::State { - state.unwrap().signature - } else { - slot - }; - let value = body.fresh(closure(next_slot)); + let next = body.slot_segment(source, slot, shape, prefix + 1, span)?; + let value = body.fresh(closure(slot)); let mut captures = vec![producer]; captures.extend(arguments); assignments.push(Assignment { destination: value, kind: AssignmentKind::FunctionRef { function: next, - signature: next_slot, + signature: slot, captures, }, span, }); body.emit_conversion( value, - closure(next_slot), + closure(slot), erased_shape(), ValueConversion::EraseReference, span, @@ -191,12 +161,7 @@ impl FunctionLowerer<'_> { "function slot consumer requires an argument", )); } - let state = self.state_slot(&shape, span)?; - let initial = if shape.parameters[0] == ValueShape::State { - state.unwrap().signature - } else { - slot - }; + let initial = slot; let cast = ValueConversion::RecoverReference { destination: closure(initial), evidence: RecoveryEvidence::TypeInstantiation, @@ -221,22 +186,9 @@ impl FunctionLowerer<'_> { let mut result = current; for (index, parameter_shape) in shape.parameters.iter().enumerate() { let input = inputs[index]; - let terminal = *parameter_shape == ValueShape::State; - let argument_shape = if terminal { - ValueShape::State - } else { - erased_shape() - }; - let invoked = if terminal { - state.unwrap().signature - } else { - slot - }; - let conversion = if terminal { - ValueConversion::Identity - } else { - body.erase_payload(*parameter_shape, span)? - }; + let argument_shape = erased_shape(); + let invoked = slot; + let conversion = body.erase_payload(*parameter_shape, span)?; let argument = body.emit_conversion( input, *parameter_shape, @@ -245,11 +197,7 @@ impl FunctionLowerer<'_> { span, &mut assignments, ); - result = body.fresh(if terminal { - state.unwrap().result - } else { - erased_shape() - }); + result = body.fresh(erased_shape()); assignments.push(Assignment { destination: result, kind: AssignmentKind::IndirectCall { @@ -260,17 +208,12 @@ impl FunctionLowerer<'_> { span, }); if index + 1 < shape.parameters.len() { - let next_slot = if shape.parameters[index + 1] == ValueShape::State { - state.unwrap().signature - } else { - slot - }; current = body.emit_conversion( result, erased_shape(), - closure(next_slot), + closure(slot), ValueConversion::RecoverReference { - destination: closure(next_slot), + destination: closure(slot), evidence: RecoveryEvidence::TypeInstantiation, }, span, @@ -278,12 +221,8 @@ impl FunctionLowerer<'_> { ); } } - let source_result = state.map_or(erased_shape(), |state| state.result); - let conversion = if let Some(state) = state { - body.state_slot_result(state, false, span)? - } else { - body.recover_payload(shape.result, span)? - }; + let source_result = erased_shape(); + let conversion = body.recover_payload(shape.result, span)?; let result = body.emit_conversion( result, source_result, diff --git a/crates/psrs-backend/src/cc/lower/conversion/mod.rs b/crates/psrs-backend/src/cc/lower/conversion/mod.rs index 60014835..10bdfb15 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/mod.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/mod.rs @@ -15,7 +15,6 @@ mod callable; mod function_slot; mod product_map; mod scalars; -mod state_slot; mod transport; pub(in crate::cc) struct VariantFieldConversion { diff --git a/crates/psrs-backend/src/cc/lower/conversion/state_slot.rs b/crates/psrs-backend/src/cc/lower/conversion/state_slot.rs deleted file mode 100644 index d214c990..00000000 --- a/crates/psrs-backend/src/cc/lower/conversion/state_slot.rs +++ /dev/null @@ -1,82 +0,0 @@ -//! Terminal callable protocol retaining a logical State and erased Step payload. -use super::*; -use crate::cc::state::StateCallProjection; -use crate::cc::{Signature, SignatureId}; - -#[derive(Clone, Copy)] -pub(super) struct StateSlot { - pub signature: SignatureId, - pub result: ValueShape, - pub source_result: ValueShape, - pub projection: StateCallProjection, -} - -impl FunctionLowerer<'_> { - pub(super) fn state_slot( - &mut self, - shape: &Signature, - span: TextRange, - ) -> Result, Vec> { - let Some(projection) = StateCallProjection::checked(shape, self.representations) - .map_err(|message| conversion_error(span, message))? - else { - return Ok(None); - }; - let id = projection - .payload_slot_signature(shape, self.representations) - .map_err(|message| conversion_error(span, message))?; - let result = self - .representations - .signature(id) - .ok_or_else(|| conversion_error(span, "State payload slot is missing its signature"))? - .result; - Ok(Some(StateSlot { - signature: id, - result, - source_result: shape.result, - projection, - })) - } - - pub(super) fn state_slot_result( - &mut self, - slot: StateSlot, - entering: bool, - span: TextRange, - ) -> Result> { - if slot.result == slot.source_result { - return Ok(ValueConversion::Identity); - } - let ValueShape::Reference(Reference { - heap: RefShape::Repr(concrete), - .. - }) = slot.source_result - else { - unreachable!() - }; - let ValueShape::Reference(Reference { - heap: RefShape::Repr(protocol), - .. - }) = slot.result - else { - unreachable!() - }; - let payload = if entering { - self.erase_payload(slot.projection.payload, span)? - } else { - self.recover_payload(slot.projection.payload, span)? - }; - let mut fields = vec![ValueConversion::Identity; 2]; - fields[slot.projection.payload_field] = payload; - Ok(ValueConversion::ProductMap { - source: if entering { concrete } else { protocol }, - target: if entering { protocol } else { concrete }, - labels: self - .representations - .product_labels(concrete) - .unwrap_or(&[]) - .to_vec(), - fields, - }) - } -} diff --git a/crates/psrs-backend/src/cc/lower/conversion/transport.rs b/crates/psrs-backend/src/cc/lower/conversion/transport.rs index 9bb8113e..ca3932ea 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/transport.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/transport.rs @@ -158,7 +158,6 @@ impl FunctionLowerer<'_> { "constructor transport result differs from its checked storage field", )); } - let state = self.state_slot(&signature, span)?; let protocol = self.boundary.protocol_signature(concrete).ok_or_else(|| { conversion_error(span, "constructor transport has no registered protocol") })?; @@ -169,20 +168,12 @@ impl FunctionLowerer<'_> { }); let identity_arguments = vec![ValueConversion::Identity; parameters.len()]; let plan = if entering { - let result = if let Some(state) = state { - self.state_slot_result(state, true, span)? - } else { - self.erase_payload(payload, span)? - }; + let result = self.erase_payload(payload, span)?; let adapter = self.physical_callable_plan(concrete, protocol, identity_arguments, result, span)?; sequence(vec![adapter, ValueConversion::EraseReference]) } else { - let result = if let Some(state) = state { - self.state_slot_result(state, false, span)? - } else { - self.recover_payload(payload, span)? - }; + let result = self.recover_payload(payload, span)?; let adapter = self.physical_callable_plan(protocol, concrete, identity_arguments, result, span)?; sequence(vec![ diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index fefaa145..b4fd38fa 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -156,44 +156,6 @@ impl FunctionLowerer<'_> { "intrinsic requires elaboration or has no runtime implementation", )]) } - Implementation::StateExecutionBoundary => { - psrs_core::state::primitive::verify( - self.module, - intrinsic, - &arguments.iter().map(|value| value.ty).collect::>(), - expression.ty, - ) - .map_err(|message| { - vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - message, - )] - })?; - let function = self.lower_value(&arguments[0], assignments)?; - let signature = self - .function_types - .get(&arguments[0].ty) - .copied() - .ok_or_else(|| { - vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "state execution has no checked callable signature", - )] - })?; - let destination = self.fresh(ty); - assignments.push(Assignment { - destination, - kind: AssignmentKind::StateExecution { - operation: intrinsic.state_operation().unwrap(), - function, - signature, - }, - span: expression.span, - }); - Ok(destination) - } } } } diff --git a/crates/psrs-backend/src/cc/lower/lambda/captures.rs b/crates/psrs-backend/src/cc/lower/lambda/captures.rs index 16f0a4d2..83a32b1e 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/captures.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/captures.rs @@ -98,7 +98,7 @@ fn collect_captures_inner( | ExprKind::String(_) | ExprKind::Char(_) => {} // Neither a literal unit nor a trap reads a local. - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} } } diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index a6e72836..99791a20 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -327,15 +327,6 @@ impl FunctionLowerer<'_> { ty, assignments, )), - // The state token carries no payload for the synchronous effect - // model, so it lowers to a constant scalar. Its type stays opaque, - // so no pass can treat it as an `Int`. - ExprKind::StateToken => Ok(self.lower_literal( - AssignmentKind::Constant(0), - expression.span, - ty, - assignments, - )), // A trap has a type but no value: it is the one expression that // ends the path instead of filling a destination. ExprKind::Trap => self.lower_trap(expression.span, ty, assignments), diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index b3c366b9..c5b7f46d 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -16,7 +16,6 @@ mod projection; mod representation; mod scalar; mod source_abi; -pub mod state; mod verify; pub(crate) use source_abi::abstract_signature; @@ -110,11 +109,6 @@ pub enum AssignmentKind { arguments: Vec, }, /// A checked source runner supplies and discharges one logical root. - StateExecution { - operation: psrs_hir::StateOperation, - function: ValueId, - signature: SignatureId, - }, ClosureGetCapture { closure: ValueId, index: u32, @@ -396,23 +390,6 @@ pub(crate) fn lower_module_with_relations( .map(|error| error.with_module(binding.source_module)) .collect::>() })?; - state::StateCallProjection::checked(&signature, &layout.representations) - .map_err(|message| { - vec![ - BackendError::invalid_ir("P8 closure conversion", binding.span, message) - .with_module(binding.source_module), - ] - })? - .ok_or_else(|| { - vec![ - BackendError::invalid_ir( - "P8 closure conversion", - binding.span, - "runtime binding lost its logical State contract", - ) - .with_module(binding.source_module), - ] - })?; let signature = crate::bindings::runtime_cc_signature(binding, &signature, &layout.representations)?; signatures.insert(binding.symbol, signature.clone()); diff --git a/crates/psrs-backend/src/cc/payload.rs b/crates/psrs-backend/src/cc/payload.rs index 5b63d568..f10ce210 100644 --- a/crates/psrs-backend/src/cc/payload.rs +++ b/crates/psrs-backend/src/cc/payload.rs @@ -81,12 +81,6 @@ pub(crate) trait PayloadPlanner { return Ok(sequence(vec![adapter, ValueConversion::EraseReference])); } let boxed = match shape { - ValueShape::State => { - return Err(self.payload_error( - span, - "state dependencies require checked logical transport, not payload boxing", - )); - } ValueShape::Integer | ValueShape::Boolean => { self.box_plan(BoxKind::Integer, self.payload_box(BoxKind::Integer), span)? } @@ -122,10 +116,6 @@ pub(crate) trait PayloadPlanner { return self.payload_callable(signature, false, span); } match shape { - ValueShape::State => Err(self.payload_error( - span, - "state dependencies cannot be recovered from a physical payload", - )), ValueShape::Integer | ValueShape::Boolean => self.unbox_plan( BoxKind::Integer, self.payload_box(BoxKind::Integer), diff --git a/crates/psrs-backend/src/cc/projection.rs b/crates/psrs-backend/src/cc/projection.rs index 084346da..83bd96c7 100644 --- a/crates/psrs-backend/src/cc/projection.rs +++ b/crates/psrs-backend/src/cc/projection.rs @@ -52,21 +52,9 @@ pub(crate) fn project_external( let Some(type_id) = type_id else { return Ok(None); }; - let Some((mut parameters, mut result)) = crate::abi::link::function_parts(module, type_id) - else { + let Some((parameters, result)) = crate::abi::link::function_parts(module, type_id) else { return Ok(None); }; - // Canonical guest layouts describe the host boundary, while CC signatures - // retain the complete logical dependency call. State and its successor - // never cross that ABI; only ordinary parameters and the payload do. - if parameters - .iter() - .any(|ty| psrs_core::state::region(module, *ty).is_some()) - { - let step = psrs_core::state::signature(module, type_id).map_err(str::to_owned)?; - parameters = step.parameters; - result = step.payload; - } let projector = Projector { module, record_types, diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index 1cb8485a..059eccb5 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -33,9 +33,6 @@ pub struct Reference { /// handles, or another target representation. #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub enum ValueShape { - /// A logical sequencing dependency with no physical payload. Checked Core - /// owns nominal region agreement; CC must retain producer/use provenance. - State, Integer, Boolean, Number, diff --git a/crates/psrs-backend/src/cc/state/branches.rs b/crates/psrs-backend/src/cc/state/branches.rs deleted file mode 100644 index 2a2ced98..00000000 --- a/crates/psrs-backend/src/cc/state/branches.rs +++ /dev/null @@ -1,175 +0,0 @@ -use super::*; -use psrs_core::state::dependency::Edge; - -impl<'a> Builder<'a, '_> { - #[allow(clippy::too_many_arguments)] - pub(super) fn branches( - &mut self, - assignment: &Assignment, - then_assignments: &'a [Assignment], - then_value: ValueId, - else_assignments: &'a [Assignment], - else_value: ValueId, - path: &mut Path, - ) -> Result> { - self.alternatives( - assignment, - &[ - (then_assignments, then_value), - (else_assignments, else_value), - ], - false, - path, - ) - } - - pub(super) fn alternatives( - &mut self, - assignment: &Assignment, - arms: &[(&'a [Assignment], ValueId)], - multiway: bool, - path: &mut Path, - ) -> Result> { - let before = path.clone(); - let before_current = before.current; - let mut paths = Vec::new(); - let mut values = Vec::new(); - let mut edges = Vec::new(); - for &(assignments, result) in arms { - let parameter = self.fresh(); - let block = self.blocks.len(); - self.blocks.push(Block { - id: block as u32, - parameters: if self.state_root { - vec![Dependency { - id: parameter, - region: RegionId(0), - }] - } else { - Vec::new() - }, - transitions: Vec::new(), - terminator: Terminator::Trap, - span: assignment.span, - }); - edges.push(Edge { - target: block as u32, - arguments: if self.state_root { - vec![before.current] - } else { - Vec::new() - }, - }); - let mut branch = before.clone(); - branch.block = block; - branch.current = parameter; - for value in branch.values.values_mut() { - value.remap(before.current, parameter); - } - self.assignments(assignments, &mut branch)?; - if !branch.terminated { - values.push(self.value(&branch, result)); - paths.push(branch); - } - } - self.blocks[before.block].terminator = if multiway { - Terminator::Switch { - default_edge: edges.pop().expect("a switch always has a default arm"), - case_edges: edges, - } - } else { - Terminator::Branch { - then_edge: edges.remove(0), - else_edge: edges.remove(0), - } - }; - if paths.is_empty() { - path.terminated = true; - return Ok(Value::Opaque); - } - let parameter = self.fresh(); - let join = self.blocks.len(); - self.blocks.push(Block { - id: join as u32, - parameters: if self.state_root { - vec![Dependency { - id: parameter, - region: RegionId(0), - }] - } else { - Vec::new() - }, - transitions: Vec::new(), - terminator: Terminator::Trap, - span: assignment.span, - }); - let pure = paths - .iter() - .all(|branch| branch.revision == before.revision); - for (branch, value) in paths.iter().zip(&mut values) { - self.blocks[branch.block].terminator = Terminator::Jump(Edge { - target: join as u32, - arguments: if self.state_root { - vec![branch.current] - } else { - Vec::new() - }, - }); - value.remap(branch.current, parameter); - } - *path = before; - path.block = join; - path.current = parameter; - path.revision = paths.iter().map(|branch| branch.revision).max().unwrap(); - if pure { - // Only the dependency current before this choice remains an alias - // after a pure join. Earlier observable predecessors stay stale. - for value in path.values.values_mut() { - value.remap(before_current, parameter); - } - } - let mut value = values.remove(0); - for other in values { - value = merge(value, other).map_err(|()| { - error( - self.function, - "CC state branch loses captured producer provenance", - ) - })?; - } - Ok(value) - } -} - -fn merge(left: Value, right: Value) -> Result { - Ok(match (left, right) { - (Value::Product(left), Value::Product(right)) if left.len() == right.len() => { - Value::Product( - left.into_iter() - .zip(right) - .map(|(left, right)| merge(left, right)) - .collect::>()?, - ) - } - (left, right) if left == right => left, - (left, right) if left.carries_state() || right.carries_state() => return Err(()), - _ => Value::Opaque, - }) -} - -#[cfg(test)] -mod tests { - use super::*; - use psrs_hir::ModuleId; - - #[test] - fn incompatible_captured_producers_cannot_become_an_opaque_join() { - let closure = |dependency| Value::Closure { - symbol: SymbolId::new(ModuleId(0), 1), - captures: vec![Value::State(DependencyId(dependency))], - }; - assert_eq!(merge(closure(0), closure(0)).unwrap(), closure(0)); - assert!(merge(closure(0), closure(1)).is_err()); - assert!(merge(Value::Product(vec![closure(0)]), Value::Opaque).is_err()); - } -} diff --git a/crates/psrs-backend/src/cc/state/captures.rs b/crates/psrs-backend/src/cc/state/captures.rs deleted file mode 100644 index 118d7465..00000000 --- a/crates/psrs-backend/src/cc/state/captures.rs +++ /dev/null @@ -1,39 +0,0 @@ -//! A captured dependency is supplied by the closure producer, never invented -//! by the lifted body. Capture slots come from ordinary CC layout verification. -use super::*; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct CapturedCallProjection { - pub capture_index: usize, - pub step: StateResultProjection, -} - -impl CapturedCallProjection { - pub(crate) fn checked( - module: &Module, - function: &Function, - signature: &Signature, - ) -> Result, Vec> { - let captures = super::super::verify::capture_shapes(function)?; - let states = captures - .iter() - .enumerate() - .filter_map(|(index, shape)| (*shape == ValueShape::State).then_some(index)) - .collect::>(); - if states.is_empty() { - return Ok(None); - } - if states.len() != 1 || signature.parameters.contains(&ValueShape::State) { - return Err(error( - function, - "captured State requires one dependency source", - )); - } - let step = StateResultProjection::checked(signature.result, &module.representations) - .map_err(|message| error(function, message))?; - Ok(Some(Self { - capture_index: states[0], - step, - })) - } -} diff --git a/crates/psrs-backend/src/cc/state/eval.rs b/crates/psrs-backend/src/cc/state/eval.rs deleted file mode 100644 index 15f14dd7..00000000 --- a/crates/psrs-backend/src/cc/state/eval.rs +++ /dev/null @@ -1,397 +0,0 @@ -use super::*; -use crate::cc::{AssignmentKind, ValueConversion}; - -pub(super) fn function<'a>( - module: &'a Module, - function: &'a Function, - signatures: &HashMap, - passthrough: &HashSet, - captured: &HashMap>, -) -> Result>, Vec> { - let shapes = function - .values - .iter() - .map(|value| (value.id, value.ty)) - .collect::>(); - let roots = function - .parameters - .iter() - .filter(|id| shapes[id] == ValueShape::State) - .copied() - .collect::>(); - let capture_root = captured[&function.symbol].map(|plan| plan.capture_index); - let state_root = !roots.is_empty() || capture_root.is_some(); - let has_state = shapes.values().any(|shape| *shape == ValueShape::State); - if !has_state && !execution::contains(&function.assignments) { - return Ok(None); - } - if (has_state && roots.len() + usize::from(capture_root.is_some()) != 1) || roots.len() > 1 { - return Err(error( - function, - "CC state body requires one checked dependency parameter", - )); - } - if !roots.is_empty() { - StateCallProjection::checked(&signatures[&function.symbol], &module.representations) - .map_err(|message| error(function, message))?; - } - let input = DependencyId(0); - let mut builder = Builder { - module, - function, - signatures, - passthrough, - captured, - capture_root, - shapes, - state_root, - executions: Vec::new(), - next: 1, - operations: Vec::new(), - passthrough_safe: true, - blocks: vec![Block { - id: 0, - parameters: if state_root { - vec![Dependency { - id: input, - region: RegionId(0), - }] - } else { - Vec::new() - }, - transitions: Vec::new(), - terminator: Terminator::Trap, - span: function.span, - }], - }; - let mut path = Path { - block: 0, - current: input, - revision: 0, - values: roots - .first() - .map(|id| HashMap::from([(*id, Value::State(input))])) - .unwrap_or_default(), - terminated: false, - }; - if let Some(index) = capture_root { - let closure = function.parameters.first().ok_or_else(|| { - error( - function, - "captured dependency has no owning closure parameter", - ) - })?; - let mut captures = vec![Value::Opaque; index + 1]; - captures[index] = Value::State(input); - path.values.insert( - *closure, - Value::Closure { - symbol: function.symbol, - captures, - }, - ); - } - builder.assignments(&function.assignments, &mut path)?; - if !path.terminated { - let mut returned = Vec::new(); - builder.value(&path, function.result).states(&mut returned); - let expected = if state_root { - vec![path.current] - } else { - Vec::new() - }; - if returned != expected { - return Err(error( - function, - "CC state return loses or replays an executed dependency", - )); - } - builder.blocks[path.block].terminator = Terminator::Return(returned); - } - let graph = Graph { - entry: 0, - regions: if state_root { - vec![RegionId(0)] - } else { - Vec::new() - }, - blocks: builder.blocks, - }; - graph.verify().map_err(|err| { - vec![ - BackendError::invalid_ir("P8 CC state verification", err.span, err.message) - .with_module(function.symbol.module), - ] - })?; - Ok(Some(FunctionFlow { - source: module, - function, - input: capture_root - .map(|index| DependencySource::Capture { - closure: function.parameters[0], - index: index as u32, - }) - .or_else(|| roots.first().copied().map(DependencySource::Parameter)), - graph, - operations: builder.operations, - executions: builder.executions, - passthrough_safe: builder.passthrough_safe, - })) -} - -impl<'a> Builder<'a, '_> { - pub(super) fn assignments( - &mut self, - assignments: &'a [Assignment], - path: &mut Path, - ) -> Result<(), Vec> { - for assignment in assignments { - if path.terminated { - break; - } - let value = match &assignment.kind { - AssignmentKind::StateExecution { signature, .. } => { - self.execution(assignment, *signature)? - } - AssignmentKind::ProductNew { arguments, .. } => { - Value::Product(arguments.iter().map(|id| self.value(path, *id)).collect()) - } - AssignmentKind::ProductGet { value, field, .. } => match self.value(path, *value) { - Value::Product(fields) => fields - .get(*field as usize) - .cloned() - .unwrap_or(Value::Opaque), - _ => Value::Opaque, - }, - AssignmentKind::FunctionRef { function, captures, .. } => Value::Closure { - symbol: *function, - captures: captures.iter().map(|id| self.value(path, *id)).collect(), - }, - AssignmentKind::ClosureGetCapture { closure, index } - if self.capture_root == Some(*index as usize) => { - if self.function.parameters.first() != Some(closure) { - return Err(error(self.function, - "captured dependency must come from the owning closure parameter")); - } - let Value::Closure { captures, .. } = self.value(path, *closure) else { - return Err(error(self.function, - "captured dependency has no checked closure producer")); - }; - captures[*index as usize].clone() - } - AssignmentKind::DirectCall { - function, - arguments, - } => { - let signature = self.signatures.get(function).ok_or_else(|| { - error( - self.function, - "CC state invocation has no checked call signature", - ) - })?; - self.call( - assignment, - arguments, - signature, - self.passthrough.contains(function), - path, - )? - } - AssignmentKind::IndirectCall { - function, - signature, - arguments, - } => { - let signature = self - .module - .representations - .signature(*signature) - .ok_or_else(|| { - error( - self.function, - "CC state invocation has no checked closure signature", - ) - })?; - let callable = self.value(path, *function); - if let Value::Closure { symbol, captures } = &callable - && let Some(Some(plan)) = self.captured.get(symbol) { - let Some(Value::State(input)) = captures.get(plan.capture_index) else { - return Err(error(self.function, - "CC captured invocation has no checked operand provenance")); - }; - self.call_dependency(assignment, *input, plan.step, - self.passthrough.contains(symbol), path)? - } else { - if callable.carries_state() { - return Err(error(self.function, - "CC captured invocation requires checked dependency transport")); - } - let pure = matches!(callable, Value::Closure { symbol, .. } - if self.passthrough.contains(&symbol)); - self.call(assignment, arguments, signature, pure, path)? - } - } - AssignmentKind::If { - then_assignments, - then_value, - else_assignments, - else_value, - .. - } => self.branches( - assignment, - then_assignments, - *then_value, - else_assignments, - *else_value, - path, - )?, - AssignmentKind::TagSwitch { cases, default_assignments, default_value, .. } => { - let mut arms = cases.iter().map(|case| (case.assignments.as_slice(), case.value)).collect::>(); - arms.push((default_assignments.as_slice(), *default_value)); - self.alternatives(assignment, &arms, true, path)? - } - AssignmentKind::AggregateConvert { - value, conversion, .. - } => Self::convert(self.value(path, *value), &conversion.plan), - AssignmentKind::Unreachable => { - path.terminated = true; - self.blocks[path.block].terminator = Terminator::Trap; - Value::Opaque - } - AssignmentKind::Constant(_) - | AssignmentKind::NumberConstant(_) - | AssignmentKind::StringConstant(_) - | AssignmentKind::Primitive { .. } - | AssignmentKind::Unary { .. } - | AssignmentKind::ClosureGetCapture { .. } - // Construction preserves the incoming State. This summary - // does not erase allocation effects or authorize call CSE. - | AssignmentKind::ArrayNew { .. } - | AssignmentKind::VariantNew { .. } - | AssignmentKind::VariantTag { .. } - | AssignmentKind::VariantGet { .. } => Value::Opaque, - _ => { - self.passthrough_safe = false; - Value::Opaque - } - }; - if self.shapes[&assignment.destination] == ValueShape::State - && !matches!(value, Value::State(_)) - && !path.terminated - { - return Err(error( - self.function, - "CC state value has no checked instruction producer", - )); - } - path.values.insert(assignment.destination, value); - } - Ok(()) - } - - fn call( - &mut self, - assignment: &'a Assignment, - arguments: &[ValueId], - signature: &Signature, - pure: bool, - path: &mut Path, - ) -> Result> { - let Some(projection) = - StateCallProjection::checked(signature, &self.module.representations) - .map_err(|message| error(self.function, message))? - else { - if arguments - .iter() - .any(|id| self.value(path, *id).carries_state()) - { - return Err(error( - self.function, - "CC state-carrying argument requires checked invocation transport", - )); - } - self.passthrough_safe = false; - return Ok(Value::Opaque); - }; - let input_value = arguments.get(projection.state_parameter).ok_or_else(|| { - error( - self.function, - "CC state invocation is missing its dependency operand", - ) - })?; - let Value::State(input) = self.value(path, *input_value) else { - return Err(error( - self.function, - "CC state invocation has no checked operand provenance", - )); - }; - self.call_dependency( - assignment, - input, - projection.result_projection(), - pure, - path, - ) - } - - fn call_dependency( - &mut self, - assignment: &'a Assignment, - input: DependencyId, - projection: StateResultProjection, - pure: bool, - path: &mut Path, - ) -> Result> { - if input != path.current { - return Err(error( - self.function, - "CC state invocation consumes a stale dependency", - )); - } - let output = if pure { - input - } else { - self.passthrough_safe = false; - let output = self.fresh(); - let operation = self.operations.len() as u32; - self.operations.push(Operation { - assignment, - input, - output, - }); - self.blocks[path.block].transitions.push(Transition { - operation, - input, - output: Dependency { - id: output, - region: RegionId(0), - }, - span: assignment.span, - }); - path.current = output; - path.revision += 1; - output - }; - let mut fields = vec![Value::Opaque; 2]; - fields[projection.state_field] = Value::State(output); - Ok(Value::Product(fields)) - } - - fn convert(value: Value, plan: &ValueConversion) -> Value { - match plan { - ValueConversion::Identity => value, - ValueConversion::ProductMap { fields: plans, .. } => match value { - Value::Product(fields) if fields.len() == plans.len() => Value::Product( - fields - .into_iter() - .zip(plans) - .map(|(field, plan)| Self::convert(field, plan)) - .collect(), - ), - _ => Value::Opaque, - }, - ValueConversion::Sequence(plans) => plans.iter().fold(value, Self::convert), - _ => Value::Opaque, - } - } -} diff --git a/crates/psrs-backend/src/cc/state/execution.rs b/crates/psrs-backend/src/cc/state/execution.rs deleted file mode 100644 index 65f6f514..00000000 --- a/crates/psrs-backend/src/cc/state/execution.rs +++ /dev/null @@ -1,84 +0,0 @@ -//! Closed execution roots belong to explicit checked runner instructions. -use super::*; -use crate::cc::{AssignmentKind, RepresentationTable, SignatureId}; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct ClosedExecution<'a> { - pub assignment: &'a Assignment, - pub graph: Graph, -} - -pub fn execution_projection( - signature: SignatureId, - table: &RepresentationTable, -) -> Result { - let signature = table - .signature(signature) - .ok_or("state execution has no checked callable signature")?; - let plan = StateCallProjection::checked(signature, table)? - .ok_or("state execution requires a State-to-Step callable")?; - if plan.state_parameter != 0 { - return Err("state execution requires an action without ordinary parameters"); - } - Ok(plan) -} - -pub(super) fn contains(assignments: &[Assignment]) -> bool { - assignments.iter().any(|assignment| match &assignment.kind { - AssignmentKind::StateExecution { .. } => true, - AssignmentKind::If { - then_assignments, - else_assignments, - .. - } => contains(then_assignments) || contains(else_assignments), - AssignmentKind::TagSwitch { - cases, - default_assignments, - .. - } => contains(default_assignments) || cases.iter().any(|case| contains(&case.assignments)), - _ => false, - }) -} - -impl<'a> Builder<'a, '_> { - pub(super) fn execution( - &mut self, - assignment: &'a Assignment, - signature: SignatureId, - ) -> Result> { - execution_projection(signature, &self.module.representations) - .map_err(|message| error(self.function, message))?; - // Each instruction owns a separate graph namespace. Its explicit - // boundary supplies the root; no State value or integer literal exists. - let input = DependencyId(0); - let output = DependencyId(1); - let graph = Graph { - entry: 0, - regions: vec![RegionId(0)], - blocks: vec![Block { - id: 0, - parameters: vec![Dependency { - id: input, - region: RegionId(0), - }], - transitions: vec![Transition { - operation: 0, - input, - output: Dependency { - id: output, - region: RegionId(0), - }, - span: assignment.span, - }], - terminator: Terminator::Return(vec![output]), - span: assignment.span, - }], - }; - graph - .verify() - .map_err(|failure| error(self.function, failure.message))?; - self.executions.push(ClosedExecution { assignment, graph }); - self.passthrough_safe = false; - Ok(Value::Opaque) - } -} diff --git a/crates/psrs-backend/src/cc/state/mod.rs b/crates/psrs-backend/src/cc/state/mod.rs deleted file mode 100644 index 408911f6..00000000 --- a/crates/psrs-backend/src/cc/state/mod.rs +++ /dev/null @@ -1,260 +0,0 @@ -//! Dependencies derived from actual typed CC instructions, before physical -//! projection. Nominal source-region checking is discharged by checked Core; -//! these single-root function graphs retain local dependency provenance. -use super::{Assignment, Function, Module, Signature, ValueId, ValueShape}; -use crate::BackendError; -use psrs_core::state::dependency::{ - Block, Dependency, DependencyId, Graph, RegionId, Terminator, Transition, -}; -use psrs_hir::SymbolId; -use std::collections::{HashMap, HashSet}; - -mod branches; -mod captures; -pub(crate) use super::verify::capture_shapes; -pub use captures::CapturedCallProjection; -mod execution; -pub use execution::{ClosedExecution, execution_projection}; -mod eval; -mod projection; -pub(crate) use projection::register_payload_slots; -pub use projection::{StateCallProjection, StateResultProjection}; -#[cfg(test)] -mod tests; - -#[derive(Debug)] -pub struct Operation<'a> { - pub assignment: &'a Assignment, - pub input: DependencyId, - pub output: DependencyId, -} - -#[derive(Debug)] -pub struct FunctionFlow<'a> { - source: &'a Module, - pub function: &'a Function, - pub input: Option, - pub graph: Graph, - pub operations: Vec>, - pub executions: Vec>, - passthrough_safe: bool, -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum DependencySource { - Parameter(ValueId), - Capture { closure: ValueId, index: u32 }, -} - -/// Ordinary CC typing and scope verification precede dependency publication. -pub fn check(module: &Module) -> Result>, Vec> { - super::verify::verify_module(module)?; - derive_all(module) -} - -impl FunctionFlow<'_> { - pub fn verify(&self, module: &Module) -> Result<(), Vec> { - if !std::ptr::eq(self.source, module) { - return Err(error( - self.function, - "CC state flow belongs to a different module", - )); - } - let flows = derive_all(module)?; - let expected = flows - .iter() - .find(|flow| std::ptr::eq(flow.function, self.function)) - .ok_or_else(|| error(self.function, "CC state flow has no owning function"))?; - if self.input != expected.input - || self.executions != expected.executions - || self.graph != expected.graph - || self.operations.len() != expected.operations.len() - || self - .operations - .iter() - .zip(&expected.operations) - .any(|(actual, expected)| { - !std::ptr::eq(actual.assignment, expected.assignment) - || actual.input != expected.input - || actual.output != expected.output - }) - { - return Err(error( - self.function, - "CC state flow changes instruction provenance or control flow", - )); - } - Ok(()) - } -} - -pub(crate) fn derive_all(module: &Module) -> Result>, Vec> { - let signatures = module - .functions - .iter() - .map(|function| { - let shapes = function - .values - .iter() - .map(|value| (value.id, value.ty)) - .collect::>(); - let parameters = function - .parameters - .iter() - .map(|id| { - shapes.get(id).copied().ok_or_else(|| { - error( - function, - "CC state verification parameter has no value declaration", - ) - }) - }) - .collect::, _>>()?; - Ok(( - function.symbol, - Signature { - parameters, - result: function.result_type, - }, - )) - }) - .collect::, Vec>>()? - .into_iter() - .chain(module.externals.iter().filter_map(|external| { - external - .signature - .clone() - .map(|signature| (external.symbol, signature)) - })) - .collect::>(); - // Least fixed point: unknown and recursive calls stay observable. Only - // checked bodies returning the incoming dependency authorize aliases. This - // is a State summary, not a general purity or allocation-effect summary. - let captured = module - .functions - .iter() - .map(|function| { - CapturedCallProjection::checked(module, function, &signatures[&function.symbol]) - .map(|plan| (function.symbol, plan)) - }) - .collect::, _>>()?; - let mut passthrough = HashSet::new(); - loop { - let mut flows = Vec::new(); - let mut errors = Vec::new(); - for function in &module.functions { - match eval::function(module, function, &signatures, &passthrough, &captured) { - Ok(Some(flow)) => flows.push(flow), - Ok(None) => {} - Err(error) => errors.extend(error), - } - } - let mut changed = false; - for flow in &flows { - if flow.passthrough_safe && flow.operations.is_empty() { - changed |= passthrough.insert(flow.function.symbol); - } - } - if !changed { - return if errors.is_empty() { - Ok(flows) - } else { - Err(errors) - }; - } - } -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC state verification", function.span, message) - .with_module(function.symbol.module), - ] -} - -#[derive(Clone, Debug, PartialEq, Eq)] -enum Value { - Opaque, - State(DependencyId), - Product(Vec), - Closure { - symbol: SymbolId, - captures: Vec, - }, -} - -impl Value { - fn carries_state(&self) -> bool { - match self { - Self::State(_) => true, - Self::Product(fields) - | Self::Closure { - captures: fields, .. - } => fields.iter().any(Self::carries_state), - Self::Opaque => false, - } - } - fn remap(&mut self, from: DependencyId, to: DependencyId) { - match self { - Self::State(id) if *id == from => *id = to, - Self::Product(fields) => { - for field in fields { - field.remap(from, to); - } - } - Self::Closure { captures, .. } => { - for value in captures { - value.remap(from, to); - } - } - _ => {} - } - } - fn states(&self, result: &mut Vec) { - match self { - Self::State(id) => result.push(*id), - Self::Product(fields) => { - for field in fields { - field.states(result); - } - } - _ => {} - } - } -} - -#[derive(Clone)] -struct Path { - block: usize, - current: DependencyId, - revision: u32, - values: HashMap, - terminated: bool, -} - -struct Builder<'a, 'b> { - module: &'a Module, - function: &'a Function, - signatures: &'b HashMap, - passthrough: &'b HashSet, - captured: &'b HashMap>, - capture_root: Option, - shapes: HashMap, - state_root: bool, - executions: Vec>, - next: u32, - blocks: Vec, - operations: Vec>, - passthrough_safe: bool, -} - -impl Builder<'_, '_> { - fn fresh(&mut self) -> DependencyId { - let id = DependencyId(self.next); - self.next += 1; - id - } - fn value(&self, path: &Path, id: ValueId) -> Value { - path.values.get(&id).cloned().unwrap_or(Value::Opaque) - } -} diff --git a/crates/psrs-backend/src/cc/state/projection/conversion.rs b/crates/psrs-backend/src/cc/state/projection/conversion.rs deleted file mode 100644 index 6974f79c..00000000 --- a/crates/psrs-backend/src/cc/state/projection/conversion.rs +++ /dev/null @@ -1,55 +0,0 @@ -use super::*; -use crate::cc::{AggregateConvert, ValueConversion}; - -impl StateCallProjection { - /// Projects a checked Step map to its payload conversion. The surrounding - /// dependency checker must separately prove that the State field is current. - pub fn payload_conversion( - conversion: &AggregateConvert, - table: &RepresentationTable, - ) -> Result { - let read = |result| { - Self::checked( - &Signature { - parameters: vec![ValueShape::State], - result, - }, - table, - )? - .ok_or("Step conversion has no logical dependency field") - }; - let source = read(conversion.source)?; - let target = read(conversion.destination)?; - let plan = match &conversion.plan { - ValueConversion::Identity if conversion.source == conversion.destination => { - ValueConversion::Identity - } - ValueConversion::ProductMap { - source: from, - target: to, - fields, - .. - } if conversion.source == product(*from) - && conversion.destination == product(*to) - && source.state_field == target.state_field - && fields.len() == 2 - && fields[source.state_field] == ValueConversion::Identity => - { - fields[source.payload_field].clone() - } - _ => return Err("Step conversion requires checked payload transport"), - }; - Ok(AggregateConvert { - source: source.payload, - destination: target.payload, - plan, - }) - } -} - -fn product(id: crate::cc::ReprId) -> ValueShape { - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(id), - }) -} diff --git a/crates/psrs-backend/src/cc/state/projection/mod.rs b/crates/psrs-backend/src/cc/state/projection/mod.rs deleted file mode 100644 index 52c9d508..00000000 --- a/crates/psrs-backend/src/cc/state/projection/mod.rs +++ /dev/null @@ -1,110 +0,0 @@ -//! Shared logical call boundary for dependency verification and P9 projection. -use crate::cc::{RefShape, Reference, Representation, RepresentationTable, Signature, ValueShape}; - -mod conversion; -mod slots; -pub(crate) use slots::register_payload_slots; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct StateCallProjection { - pub state_parameter: usize, - pub state_field: usize, - pub payload_field: usize, - pub payload: ValueShape, -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct StateResultProjection { - pub state_field: usize, - pub payload_field: usize, - pub payload: ValueShape, -} - -impl StateCallProjection { - /// This describes slots only. Removing them still requires checked body, - /// invocation and CFG correspondence; a signature does not prove ordering. - pub fn checked( - signature: &Signature, - table: &RepresentationTable, - ) -> Result, &'static str> { - let states = signature - .parameters - .iter() - .enumerate() - .filter_map(|(index, shape)| (*shape == ValueShape::State).then_some(index)) - .collect::>(); - if states.is_empty() { - return Ok(None); - } - if states != [signature.parameters.len() - 1] { - return Err("CC state invocation requires exactly one final dependency parameter"); - } - let result = StateResultProjection::checked(signature.result, table)?; - Ok(Some(Self { - state_parameter: states[0], - state_field: result.state_field, - payload_field: result.payload_field, - payload: result.payload, - })) - } - - pub fn result_projection(self) -> StateResultProjection { - StateResultProjection { - state_field: self.state_field, - payload_field: self.payload_field, - payload: self.payload, - } - } - - pub fn physical_signature( - signature: &Signature, - table: &RepresentationTable, - ) -> Result { - let Some(plan) = Self::checked(signature, table)? else { - return Ok(signature.clone()); - }; - Ok(Signature { - parameters: signature.parameters[..plan.state_parameter].to_vec(), - result: plan.payload, - }) - } -} - -impl StateResultProjection { - /// The shared Step result contract is independent of whether its incoming - /// dependency belongs to an explicit parameter or a lexical capture. - pub fn checked(result: ValueShape, table: &RepresentationTable) -> Result { - let ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(id), - }) = result - else { - return Err("CC state invocation requires a non-null Step product"); - }; - let Some(Representation::Product { fields }) = table.representation(id) else { - return Err("CC state invocation result is not a checked product"); - }; - if fields.len() != 2 - || fields - .iter() - .filter(|shape| **shape == ValueShape::State) - .count() - != 1 - { - return Err("CC Step requires one successor and one payload field"); - } - let state_field = fields - .iter() - .position(|shape| *shape == ValueShape::State) - .unwrap(); - let payload_field = 1 - state_field; - Ok(Self { - state_field, - payload_field, - payload: fields[payload_field], - }) - } -} - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-backend/src/cc/state/projection/slots.rs b/crates/psrs-backend/src/cc/state/projection/slots.rs deleted file mode 100644 index 9fd476a9..00000000 --- a/crates/psrs-backend/src/cc/state/projection/slots.rs +++ /dev/null @@ -1,96 +0,0 @@ -//! Canonical terminal payload slots; planning registers them before lowering. -use super::*; -use crate::cc::{ReprId, SignatureId}; - -type StepRequirement = (Representation, Option>); - -impl StateCallProjection { - fn slot_requirement( - &self, - signature: &Signature, - table: &RepresentationTable, - ) -> Result { - let ValueShape::Reference(Reference { - heap: RefShape::Repr(source), - .. - }) = signature.result - else { - return Err("State payload slot has no checked Step representation"); - }; - let mut fields = vec![crate::cc::payload::erased_shape(); 2]; - fields[self.state_field] = ValueShape::State; - Ok(( - Representation::Product { fields }, - table.product_labels(source).map(<[String]>::to_vec), - )) - } - - pub(crate) fn payload_slot_signature( - &self, - signature: &Signature, - table: &RepresentationTable, - ) -> Result { - let (requirement, labels) = self.slot_requirement(signature, table)?; - let target = table - .representations - .iter() - .enumerate() - .find(|(index, value)| { - **value == requirement - && table.product_labels(ReprId(*index as u32)) == labels.as_deref() - }) - .map(|(index, _)| ReprId(index as u32)) - .ok_or("State payload slot has no registered Step protocol")?; - let signature = Signature { - parameters: vec![ValueShape::State], - result: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(target), - }), - }; - table - .signatures - .iter() - .position(|value| *value == signature) - .map(|index| SignatureId(index as u32)) - .ok_or("State payload slot has no registered callable protocol") - } -} - -pub(crate) fn register_payload_slots(table: &mut RepresentationTable) { - for signature in table.signatures.clone() { - let Ok(Some(projection)) = StateCallProjection::checked(&signature, table) else { - continue; - }; - let (requirement, labels) = projection - .slot_requirement(&signature, table) - .expect("checked Step has a representation"); - let target = table - .representations - .iter() - .enumerate() - .find(|(index, value)| { - **value == requirement - && table.product_labels(ReprId(*index as u32)) == labels.as_deref() - }) - .map(|(index, _)| ReprId(index as u32)); - let target = target.unwrap_or_else(|| { - let id = table.reserve(); - table.set(id, requirement); - if let Some(labels) = labels { - table.set_product_labels(id, labels); - } - id - }); - let slot = Signature { - parameters: vec![ValueShape::State], - result: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(target), - }), - }; - if !table.signatures.contains(&slot) { - table.add_signature(slot); - } - } -} diff --git a/crates/psrs-backend/src/cc/state/projection/tests.rs b/crates/psrs-backend/src/cc/state/projection/tests.rs deleted file mode 100644 index 225fb3d8..00000000 --- a/crates/psrs-backend/src/cc/state/projection/tests.rs +++ /dev/null @@ -1,175 +0,0 @@ -use super::*; -use crate::cc::ReprId; - -fn boundary(fields: Vec) -> (Signature, RepresentationTable) { - let mut table = RepresentationTable::default(); - table - .representations - .push(Representation::Product { fields }); - let signature = Signature { - parameters: vec![ValueShape::Integer, ValueShape::State], - result: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(0)), - }), - }; - (signature, table) -} - -#[test] -fn projects_logical_slots_without_assuming_product_field_order() { - for state_field in 0..2 { - let mut fields = vec![ValueShape::Number; 2]; - fields[state_field] = ValueShape::State; - let (signature, table) = boundary(fields); - let before = table.clone(); - let plan = StateCallProjection::checked(&signature, &table) - .unwrap() - .unwrap(); - assert_eq!(plan.state_parameter, 1); - assert_eq!(plan.state_field, state_field); - assert_eq!(plan.payload_field, 1 - state_field); - assert_eq!( - StateCallProjection::physical_signature(&signature, &table).unwrap(), - Signature { - parameters: vec![ValueShape::Integer], - result: ValueShape::Number, - } - ); - assert_eq!(table, before); - } -} - -#[test] -fn nullary_projection_keeps_a_call_boundary() { - let (mut signature, table) = boundary(vec![ValueShape::State, ValueShape::Integer]); - signature.parameters.remove(0); - let projected = StateCallProjection::physical_signature(&signature, &table).unwrap(); - assert!(projected.parameters.is_empty()); - assert_eq!(projected.result, ValueShape::Integer); - assert!( - StateCallProjection::checked(&signature, &table) - .unwrap() - .is_some() - ); -} - -#[test] -fn rejects_malformed_state_boundaries() { - let (signature, table) = boundary(vec![ValueShape::State, ValueShape::Integer]); - for parameters in [ - vec![ValueShape::State, ValueShape::Integer], - vec![ValueShape::State, ValueShape::State], - ] { - let mut malformed = signature.clone(); - malformed.parameters = parameters; - assert!(StateCallProjection::checked(&malformed, &table).is_err()); - } - for fields in [ - vec![ValueShape::Integer], - vec![ValueShape::State, ValueShape::State], - vec![ValueShape::State, ValueShape::Integer, ValueShape::Number], - ] { - let (malformed, table) = boundary(fields); - assert!(StateCallProjection::checked(&malformed, &table).is_err()); - } - let mut nullable = signature; - if let ValueShape::Reference(reference) = &mut nullable.result { - reference.nullable = true; - } - assert!(StateCallProjection::checked(&nullable, &table).is_err()); -} - -#[test] -fn ordinary_signatures_preserve_their_calling_convention() { - let signature = Signature { - parameters: vec![ValueShape::Integer], - result: ValueShape::Number, - }; - assert_eq!( - StateCallProjection::physical_signature(&signature, &RepresentationTable::default()) - .unwrap(), - signature - ); -} - -#[test] -fn step_maps_keep_payload_boxing_and_reject_state_conversion() { - use crate::cc::{AggregateConvert, BoxKind, ValueConversion as C}; - let (signature, mut table) = boundary(vec![ValueShape::State, ValueShape::Integer]); - let erased = ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Erased, - }); - table.representations.push(Representation::Product { - fields: vec![ValueShape::State, erased], - }); - table.representations.push(Representation::Box { - value: ValueShape::Integer, - }); - let payload = C::Sequence(vec![ - C::BoxScalar { - kind: BoxKind::Integer, - representation: ReprId(2), - }, - C::EraseReference, - ]); - let mut conversion = AggregateConvert { - source: signature.result, - destination: ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(1)), - }), - plan: C::ProductMap { - source: ReprId(0), - target: ReprId(1), - labels: vec!["state".into(), "value".into()], - fields: vec![C::Identity, payload.clone()], - }, - }; - assert_eq!( - StateCallProjection::payload_conversion(&conversion, &table).unwrap(), - AggregateConvert { - source: ValueShape::Integer, - destination: erased, - plan: payload - } - ); - if let C::ProductMap { fields, .. } = &mut conversion.plan { - fields[0] = C::EraseReference; - } - assert!(StateCallProjection::payload_conversion(&conversion, &table).is_err()); -} - -#[test] -fn payload_slots_are_registered_once_and_preserve_step_field_order() { - for state_field in 0..2 { - let mut fields = vec![ValueShape::Integer; 2]; - fields[state_field] = ValueShape::State; - let (signature, mut table) = boundary(fields); - table.add_signature(signature.clone()); - let projection = StateCallProjection::checked(&signature, &table) - .unwrap() - .unwrap(); - assert!( - projection - .payload_slot_signature(&signature, &table) - .is_err() - ); - super::register_payload_slots(&mut table); - let slot = projection - .payload_slot_signature(&signature, &table) - .unwrap(); - let terminal = table.signature(slot).unwrap(); - assert_eq!(terminal.parameters, vec![ValueShape::State]); - let result = StateCallProjection::checked(terminal, &table) - .unwrap() - .unwrap(); - assert_eq!(result.state_field, state_field); - assert_eq!(result.payload, crate::cc::payload::erased_shape()); - assert_eq!(table.signature(crate::cc::SignatureId(0)), Some(&signature)); - let registered = table.clone(); - super::register_payload_slots(&mut table); - assert_eq!(table, registered); - } -} diff --git a/crates/psrs-backend/src/cc/state/tests.rs b/crates/psrs-backend/src/cc/state/tests.rs deleted file mode 100644 index 34f9ab4f..00000000 --- a/crates/psrs-backend/src/cc/state/tests.rs +++ /dev/null @@ -1,388 +0,0 @@ -use super::*; -use crate::cc::{ - AssignmentKind, External, RefShape, Reference, ReprId, Representation, RepresentationTable, - ValueDecl, -}; -use psrs_hir::ModuleId; -use psrs_span::TextRange; - -fn step_shape() -> ValueShape { - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(0)), - }) -} -fn assignment(id: u32, kind: AssignmentKind) -> Assignment { - Assignment { - destination: ValueId(id), - kind, - span: TextRange::new(id, id + 1), - } -} -fn call(id: u32, input: u32) -> Assignment { - assignment( - id, - AssignmentKind::DirectCall { - function: SymbolId::new(ModuleId(0), 1), - arguments: vec![ValueId(input)], - }, - ) -} -fn product(id: u32, state: u32, payload: u32) -> Assignment { - assignment( - id, - AssignmentKind::ProductNew { - destination: ValueId(id), - representation: ReprId(0), - arguments: vec![ValueId(state), ValueId(payload)], - }, - ) -} -fn fixture(assignments: Vec, shapes: &[ValueShape], result: u32) -> Module { - let mut representations = RepresentationTable::default(); - representations - .representations - .push(Representation::Product { - fields: vec![ValueShape::State, ValueShape::Integer], - }); - Module { - name: "CCStateBody".into(), - representations, - externals: vec![External { - symbol: SymbolId::new(ModuleId(0), 1), - signature: Some(Signature { - parameters: vec![ValueShape::State], - result: step_shape(), - }), - projection: None, - }], - functions: vec![Function { - symbol: SymbolId::new(ModuleId(0), 0), - name: "action".into(), - parameters: vec![ValueId(0)], - values: shapes - .iter() - .enumerate() - .map(|(index, ty)| ValueDecl { - id: ValueId(index as u32), - ty: *ty, - }) - .collect(), - assignments, - result: ValueId(result), - result_type: shapes[result as usize], - span: TextRange::new(0, 20), - }], - entry: None, - span: TextRange::new(0, 20), - } -} - -#[test] -fn actual_cc_calls_and_field_projections_supply_successor_dependencies() { - let get = assignment( - 2, - AssignmentKind::ProductGet { - destination: ValueId(2), - representation: ReprId(0), - field: 0, - value: ValueId(1), - }, - ); - let module = fixture( - vec![call(1, 0), get, call(3, 2)], - &[ - ValueShape::State, - step_shape(), - ValueShape::State, - step_shape(), - ], - 3, - ); - let flows = check(&module).unwrap(); - let flow = &flows[0]; - assert_eq!(flow.operations.len(), 2); - assert!(std::ptr::eq( - flow.operations[0].assignment, - &module.functions[0].assignments[0] - )); - assert_eq!(flow.operations[1].input, flow.operations[0].output); - flow.verify(&module).unwrap(); - assert!(flow.verify(&module.clone()).is_err()); -} - -#[test] -fn stale_cc_operands_and_returns_are_rejected() { - let replay = fixture( - vec![call(1, 0), call(2, 0)], - &[ValueShape::State, step_shape(), step_shape()], - 2, - ); - assert!( - check(&replay) - .unwrap_err() - .iter() - .any(|error| error.message.contains("stale dependency")) - ); - let stale = fixture( - vec![ - call(1, 0), - assignment(2, AssignmentKind::Constant(42)), - product(3, 0, 2), - ], - &[ - ValueShape::State, - step_shape(), - ValueShape::Integer, - step_shape(), - ], - 3, - ); - assert!( - check(&stale) - .unwrap_err() - .iter() - .any(|error| error.message.contains("return loses")) - ); -} - -#[test] -fn mir_entry_checks_actual_cc_dependencies_before_physical_planning() { - let replay = fixture( - vec![call(1, 0), call(2, 0)], - &[ValueShape::State, step_shape(), step_shape()], - 2, - ); - let bindings = crate::ExternalBindings { - runtime: Vec::new(), - imports: vec![crate::ExternalBinding { - symbol: replay.externals[0].symbol, - source_module: ModuleId(0), - interface: crate::abi::names::STDOUT.into(), - function: crate::abi::names::GET_STDOUT.into(), - type_id: None, - span: replay.span, - }], - }; - let errors = crate::mir::lower_module_with_bindings( - replay, - bindings, - crate::TargetCapabilities::default(), - ) - .err() - .expect("MIR must reject a stale CC invocation"); - assert!( - errors - .iter() - .any(|error| error.message.contains("stale dependency")) - ); - assert!( - !errors - .iter() - .any(|error| error.message.contains("UnprojectedState")) - ); -} - -#[test] -fn dependency_recheck_rejects_missing_operands_and_parameter_metadata() { - let mut module = fixture(vec![call(1, 0)], &[ValueShape::State, step_shape()], 1); - if let AssignmentKind::DirectCall { arguments, .. } = - &mut module.functions[0].assignments[0].kind - { - arguments.clear(); - } - assert!( - derive_all(&module) - .unwrap_err() - .iter() - .any(|error| error.message.contains("missing its dependency operand")) - ); - module.functions[0].values.remove(0); - assert!( - derive_all(&module) - .unwrap_err() - .iter() - .any(|error| error.message.contains("no value declaration")) - ); -} - -#[test] -fn branch_calls_join_the_executed_successor() { - let choice = assignment( - 4, - AssignmentKind::If { - condition: ValueId(1), - then_assignments: vec![call(2, 0)], - then_value: ValueId(2), - else_assignments: vec![call(3, 0)], - else_value: ValueId(3), - }, - ); - let get = assignment( - 5, - AssignmentKind::ProductGet { - destination: ValueId(5), - representation: ReprId(0), - field: 0, - value: ValueId(4), - }, - ); - let module = fixture( - vec![ - assignment(1, AssignmentKind::Constant(1)), - choice, - get, - call(6, 5), - ], - &[ - ValueShape::State, - ValueShape::Boolean, - step_shape(), - step_shape(), - step_shape(), - ValueShape::State, - step_shape(), - ], - 6, - ); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 3); - assert_eq!(flows[0].graph.blocks.len(), 4); - assert_eq!( - flows[0].operations[2].input, - flows[0].graph.blocks[3].parameters[0].id - ); -} - -#[test] -fn a_pure_cc_join_preserves_previously_evaluated_aliases() { - let choice = assignment( - 5, - AssignmentKind::If { - condition: ValueId(1), - then_assignments: vec![product(3, 0, 2)], - then_value: ValueId(3), - else_assignments: vec![product(4, 0, 2)], - else_value: ValueId(4), - }, - ); - let module = fixture( - vec![ - assignment(1, AssignmentKind::Constant(1)), - assignment(2, AssignmentKind::Constant(42)), - choice, - product(6, 0, 2), - ], - &[ - ValueShape::State, - ValueShape::Boolean, - ValueShape::Integer, - step_shape(), - step_shape(), - step_shape(), - step_shape(), - ], - 6, - ); - assert!(check(&module).unwrap()[0].operations.is_empty()); -} - -#[test] -fn pure_call_summaries_come_from_checked_bodies_in_any_declaration_order() { - let mut module = fixture( - vec![ - call(1, 0), - assignment(2, AssignmentKind::Constant(42)), - product(3, 0, 2), - ], - &[ - ValueShape::State, - step_shape(), - ValueShape::Integer, - step_shape(), - ], - 3, - ); - let mut pure = fixture( - vec![ - assignment(1, AssignmentKind::Constant(42)), - product(2, 0, 1), - ], - &[ValueShape::State, ValueShape::Integer, step_shape()], - 2, - ) - .functions - .remove(0); - pure.symbol = SymbolId::new(ModuleId(0), 1); - module.externals.clear(); - module.functions.push(pure); - let flows = check(&module).unwrap(); - assert!(flows.iter().all(|flow| flow.operations.is_empty())); -} - -#[test] -fn a_trapping_cc_branch_has_no_normal_successor() { - let choice = assignment( - 4, - AssignmentKind::If { - condition: ValueId(1), - then_assignments: vec![call(2, 0)], - then_value: ValueId(2), - else_assignments: vec![assignment(3, AssignmentKind::Unreachable)], - else_value: ValueId(3), - }, - ); - let module = fixture( - vec![assignment(1, AssignmentKind::Constant(1)), choice], - &[ - ValueShape::State, - ValueShape::Boolean, - step_shape(), - step_shape(), - step_shape(), - ], - 4, - ); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 1); - assert!( - flows[0] - .graph - .blocks - .iter() - .any(|block| block.terminator == Terminator::Trap) - ); -} - -#[test] -fn state_is_neither_a_fabricated_constant_nor_boxed_payload() { - let mut module = fixture( - vec![assignment(1, AssignmentKind::Constant(0))], - &[ValueShape::State, ValueShape::State], - 1, - ); - assert!(check(&module).is_err()); - module - .representations - .representations - .push(Representation::Box { - value: ValueShape::State, - }); - assert!( - check(&module) - .unwrap_err() - .iter() - .any(|error| error.message.contains("no box or array")) - ); -} - -#[test] -fn source_correspondence_rejects_an_edited_graph() { - let module = fixture(vec![call(1, 0)], &[ValueShape::State, step_shape()], 1); - let mut flows = check(&module).unwrap(); - flows[0].graph.blocks[0].transitions.clear(); - flows[0].operations.clear(); - flows[0].graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(0)]); - flows[0].graph.verify().unwrap(); - assert!(flows[0].verify(&module).is_err()); -} diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 46f9902c..8173a398 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -6,7 +6,6 @@ use std::collections::{HashMap, HashSet}; mod adaptation; mod helpers; -pub(crate) use helpers::capture_shapes; mod ops; mod scalar; mod variant; @@ -125,7 +124,6 @@ pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { .collect::>() })?; } - super::state::derive_all(module)?; Ok(()) } diff --git a/crates/psrs-backend/src/cc/verify/ops/execution.rs b/crates/psrs-backend/src/cc/verify/ops/execution.rs deleted file mode 100644 index 6fa2c48b..00000000 --- a/crates/psrs-backend/src/cc/verify/ops/execution.rs +++ /dev/null @@ -1,19 +0,0 @@ -use super::*; - -pub(super) fn verify( - assignment: &Assignment, - function: ValueId, - signature: crate::cc::SignatureId, - declared: &HashMap, - table: &RepresentationTable, -) -> Result<(), Vec> { - let plan = crate::cc::state::execution_projection(signature, table) - .map_err(|message| assignment_error(assignment, message))?; - require_value_shape(declared, function, closure_shape(signature), assignment)?; - require_destination( - declared, - assignment, - plan.payload, - "state execution has an incompatible payload result", - ) -} diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index 3086f244..d5371bf6 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -15,7 +15,6 @@ use tag_switch::verify_tag_switch; mod aggregate; mod arrays; -mod execution; mod string_bytes; mod table; mod tag_switch; @@ -199,14 +198,6 @@ pub(super) fn verify_assignments( uses.push(*function); uses.extend(arguments.iter().copied()); } - AssignmentKind::StateExecution { - function, - signature, - .. - } => { - execution::verify(assignment, *function, *signature, declared, table)?; - uses.push(*function); - } AssignmentKind::ClosureGetCapture { closure, .. } => { require_value_shape(declared, *closure, aggregate_shape(), assignment)?; uses.push(*closure); diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index 51dc92dd..78d0c089 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -11,12 +11,6 @@ pub(crate) fn verify_table( for (index, representation) in table.representations.iter().enumerate() { match representation { Representation::Box { value } | Representation::Array { element: value } => { - if *value == crate::cc::ValueShape::State { - return Err(table_error( - span, - "state dependencies have no box or array payload storage", - )); - } verify_value_shape(value, table, span)?; } Representation::Product { fields } => { diff --git a/crates/psrs-backend/src/effects/entry.rs b/crates/psrs-backend/src/effects/entry.rs deleted file mode 100644 index 8f142d1e..00000000 --- a/crates/psrs-backend/src/effects/entry.rs +++ /dev/null @@ -1,226 +0,0 @@ -use super::verify::effect_error; -use crate::BackendError; -use psrs_core::{ - Binder, Binding, Declaration, Expr, ExprKind, Module as CoreModule, Type, TypeConstructor, - TypeId, -}; -use psrs_hir::SymbolId; -use psrs_span::TextRange; - -pub(super) fn validate_source( - module: &CoreModule, - trusted: &psrs_core::effect::TrustedEffect, - entry: psrs_core::effect::EffectCommandEntry, -) -> Result<(), Vec> { - let Some(main) = module - .declarations - .iter() - .find(|declaration| declaration.symbol == entry.symbol) - else { - return Err(vec![effect_error( - module, - module.span, - "Effect command entry has no source declaration", - )]); - }; - if !main.quantified.is_empty() - || psrs_core::effect::effect_application(module, main.ty, trusted.effect_type) - .is_none_or(|(_, payload)| !is_unit(module, payload)) - { - return Err(vec![effect_error( - module, - main.name_span, - "Effect command entry must have type Effect Unit", - )]); - } - Ok(()) -} - -pub(super) fn install( - module: &mut CoreModule, - trusted: &psrs_core::effect::TrustedEffect, - entry: psrs_core::effect::EffectCommandEntry, -) -> Result<(), Vec> { - let Some(main) = module - .declarations - .iter() - .find(|declaration| declaration.symbol == entry.symbol) - .cloned() - else { - return Err(vec![effect_error( - module, - module.span, - "Effect command entry has no source declaration", - )]); - }; - let Some((token_parameters, unit)) = psrs_core::closure_parts(&module.types, main.ty) else { - return Err(vec![effect_error( - module, - main.name_span, - "lowered Effect command entry is not an ordinary token closure", - )]); - }; - if token_parameters.len() != 1 || !is_unit(module, unit) { - return Err(vec![effect_error( - module, - main.name_span, - "lowered Effect command entry must take one token and return Unit", - )]); - } - let Some(run) = trusted - .operations - .iter() - .find(|operation| operation.operation == psrs_core::effect::EffectOperation::Run) - .map(|operation| operation.symbol) - else { - return Err(vec![effect_error( - module, - main.name_span, - "trusted runEffect operation is missing from the Effect contract", - )]); - }; - if !module - .declarations - .iter() - .any(|declaration| declaration.symbol == run) - { - return Err(vec![effect_error( - module, - main.name_span, - "trusted runEffect operation was not lowered", - )]); - } - let int = intern(module, Type::Constructor(TypeConstructor::Int)); - let run_type = psrs_core::effect::function_type(module, &[main.ty], unit); - let result_local = psrs_core::effect::fresh_local(module); - let binder = Binder { - id: result_local, - name: "effectResult".to_string(), - ty: unit, - span: main.name_span, - }; - let run_action = expr( - ExprKind::Application( - Box::new(expr(ExprKind::Global(run), run_type, main.name_span)), - Box::new(expr( - ExprKind::Global(entry.symbol), - main.ty, - main.name_span, - )), - ), - unit, - main.name_span, - ); - let value = expr( - ExprKind::Let { - bindings: vec![Binding { - binder, - quantified: Vec::new(), - value: run_action, - span: main.name_span, - }], - body: Box::new(expr(ExprKind::Integer(0), int, main.name_span)), - }, - int, - main.name_span, - ); - let symbol = fresh_entry_symbol(module, main.symbol.module); - module.declarations.push(Declaration { - symbol, - name: "psrs.command-entry".to_string(), - name_span: main.name_span, - quantified: Vec::new(), - ty: int, - value, - span: main.span, - }); - module.entry = Some(symbol); - if !valid_wrapper(module, symbol, entry.symbol, run, unit, int) { - return Err(vec![effect_error( - module, - main.name_span, - "generated Effect command entry does not run the selected action exactly once", - )]); - } - Ok(()) -} - -fn valid_wrapper( - module: &CoreModule, - wrapper_symbol: SymbolId, - source: SymbolId, - run: SymbolId, - unit: TypeId, - int: TypeId, -) -> bool { - let Some(wrapper) = module - .declarations - .iter() - .find(|declaration| declaration.symbol == wrapper_symbol) - else { - return false; - }; - if wrapper.ty != int || !wrapper.quantified.is_empty() { - return false; - } - let ExprKind::Let { bindings, body } = &wrapper.value.kind else { - return false; - }; - if bindings.len() != 1 || bindings[0].binder.ty != unit || bindings[0].value.ty != unit { - return false; - } - let ExprKind::Application(function, action) = &bindings[0].value.kind else { - return false; - }; - if !matches!(function.kind, ExprKind::Global(symbol) if symbol == run) - || !matches!(action.kind, ExprKind::Global(symbol) if symbol == source) - { - return false; - } - matches!(body.kind, ExprKind::Integer(0)) && body.ty == int -} - -fn is_unit(module: &CoreModule, ty: TypeId) -> bool { - matches!( - module.types.get(ty.0 as usize), - Some(Type::Constructor(TypeConstructor::Unit)) - ) -} - -fn intern(module: &mut CoreModule, ty: Type) -> TypeId { - if let Some(index) = module.types.iter().position(|current| current == &ty) { - TypeId(index as u32) - } else { - module.types.push(ty); - TypeId((module.types.len() - 1) as u32) - } -} - -fn fresh_entry_symbol(module: &CoreModule, owner: psrs_hir::ModuleId) -> SymbolId { - let next = module - .declarations - .iter() - .filter(|declaration| declaration.symbol.module == owner) - .map(|declaration| declaration.symbol.index) - .chain( - module - .externals - .iter() - .filter(|external| external.symbol.module == owner) - .map(|external| external.symbol.index), - ) - .chain( - module - .constructors - .iter() - .filter(|constructor| constructor.symbol.module == owner) - .map(|constructor| constructor.symbol.index), - ) - .max() - .map_or(0, |index| index.saturating_add(1)); - SymbolId::new(owner, next) -} - -fn expr(kind: ExprKind, ty: TypeId, span: TextRange) -> Expr { - Expr { kind, ty, span } -} diff --git a/crates/psrs-backend/src/effects/mod.rs b/crates/psrs-backend/src/effects/mod.rs deleted file mode 100644 index f1de3058..00000000 --- a/crates/psrs-backend/src/effects/mod.rs +++ /dev/null @@ -1,127 +0,0 @@ -//! Effect lowering coordinator. Abstract identities and the import plan are -//! checked before the Core type table erases `Effect` applications. - -mod entry; -mod suspension; -mod verify; - -use super::boundary::{RepresentationPolicy, RepresentationRegistry}; -use crate::BackendError; -use crate::bindings::ExternalBindings; -use psrs_core::{Module as CoreModule, TypeConstructor, effect::EffectCompilation}; -use std::collections::HashSet; - -/// Source Core captured before effect applications become closures, plus the -/// representation registry the Effect owner contributes to conversion. -pub(crate) struct EffectPreparation { - pub(crate) source: CoreModule, - pub(crate) registry: RepresentationRegistry, -} - -pub(crate) fn lower_effects( - module: &mut CoreModule, - bindings: &mut ExternalBindings, - context: &EffectCompilation, -) -> Result> { - verify::trusted_contract(module, bindings, &context.trusted)?; - validate_entry_context(module, context)?; - let suspensions = suspension::plan(module, bindings, &context.trusted)?; - let source = module.clone(); - let lowering = psrs_core::effect::lower_effects(module, &context.trusted) - .map_err(|errors| verify::verification_errors(&errors))?; - let registry = effect_registry(module, &context.trusted, &lowering)?; - - let applied = suspension::apply(module, bindings, &suspensions)?; - if let Some(entry) = context.command_entry { - entry::install(module, &context.trusted, entry)?; - } - - lowering - .verify(module) - .map_err(|errors| verify::verification_errors(&errors))?; - if let Err(errors) = module.verify_with_source(&source) { - return Err(verify::verification_errors(&errors)); - } - suspension::verify(module, bindings, &suspensions, &applied)?; - let synthesized = lowering.synthesized.to_vec(); - bindings - .imports - .retain(|binding| !synthesized.contains(&binding.symbol)); - Ok(EffectPreparation { source, registry }) -} - -/// The Effect representation owner registers its constructor's stored calling -/// convention: the runtime token chosen by effect lowering. The payload -/// remains the application's result and is not a hidden parameter. -fn effect_registry( - module: &CoreModule, - trusted: &psrs_core::effect::TrustedEffect, - lowering: &psrs_core::effect::EffectLowering, -) -> Result> { - let mut tokens = HashSet::new(); - for closure in &lowering.closures { - tokens.insert(closure.token); - } - if tokens.len() > 1 { - return Err(vec![verify::effect_error( - module, - module.span, - "Effect lowering produced more than one runtime token", - )]); - } - let mut registry = RepresentationRegistry::new(); - if let Some(token) = tokens.into_iter().next() { - registry.register( - TypeConstructor::User(trusted.effect_type), - RepresentationPolicy::Fixed(vec![token]), - ); - } - Ok(registry) -} - -fn validate_entry_context( - module: &CoreModule, - context: &EffectCompilation, -) -> Result<(), Vec> { - let selected = module.entry; - match (selected, context.command_entry) { - (Some(selected), Some(entry)) if selected != entry.symbol => { - Err(vec![verify::effect_error( - module, - module.span, - "Effect command entry does not match the selected source entry", - )]) - } - (Some(_), Some(entry)) => entry::validate_source(module, &context.trusted, entry), - (Some(selected), None) => { - let Some(declaration) = module - .declarations - .iter() - .find(|declaration| declaration.symbol == selected) - else { - return Ok(()); - }; - if psrs_core::effect::effect_application( - module, - declaration.ty, - context.trusted.effect_type, - ) - .is_some() - { - Err(vec![verify::effect_error( - module, - declaration.name_span, - "missing Effect command entry metadata for the selected source entry", - )]) - } else { - Ok(()) - } - } - (None, Some(_)) => Err(vec![verify::effect_error( - module, - module.span, - "Effect command entry metadata has no selected source entry", - )]), - (None, None) => Ok(()), - } -} diff --git a/crates/psrs-backend/src/effects/suspension.rs b/crates/psrs-backend/src/effects/suspension.rs deleted file mode 100644 index 339d312a..00000000 --- a/crates/psrs-backend/src/effects/suspension.rs +++ /dev/null @@ -1,462 +0,0 @@ -use super::verify::{effect_error, source_effect_error}; -use crate::BackendError; -use crate::bindings::ExternalBindings; -use psrs_core::{ - Binder, Declaration, Expr, ExprKind, Module as CoreModule, Type, TypeId, closure_parts, -}; -use psrs_hir::{LocalId, ModuleId, SymbolId, TypeVariableId}; -use psrs_span::TextRange; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(super) struct SuspensionPlan { - index: usize, - original: SymbolId, - source_module: ModuleId, - name: String, - span: TextRange, - source: TypeId, - source_body: TypeId, - quantified: Vec, - parameters: Vec, - application: TypeId, - payload: TypeId, -} - -#[derive(Clone, Debug)] -pub(super) struct AppliedSuspension { - plan: SuspensionPlan, - host: SymbolId, - host_type: TypeId, -} - -fn import_error(module: &CoreModule, plan: &SuspensionPlan, message: &str) -> BackendError { - source_effect_error(module, plan.source_module, plan.span, message) -} - -pub(super) fn plan( - module: &CoreModule, - bindings: &ExternalBindings, - trusted: &psrs_core::effect::TrustedEffect, -) -> Result, Vec> { - let mut plans = Vec::new(); - let operation_symbols = trusted - .operations - .iter() - .map(|operation| operation.symbol) - .collect::>(); - for (index, binding) in bindings.imports.iter().enumerate() { - if operation_symbols.contains(&binding.symbol) { - continue; - } - let Some(source) = binding.type_id else { - continue; - }; - let shape = psrs_core::effect::classify_effect_import(module, source, trusted.effect_type) - .map_err(|message| { - vec![source_effect_error( - module, - binding.source_module, - binding.span, - message, - )] - })?; - let Some(shape) = shape else { - continue; - }; - let Some(external) = module - .externals - .iter() - .find(|external| external.symbol == binding.symbol) - else { - return Err(vec![source_effect_error( - module, - binding.source_module, - binding.span, - "effectful import has no external symbol", - )]); - }; - let source_body = strip_foralls(module, source).ok_or_else(|| { - vec![source_effect_error( - module, - binding.source_module, - binding.span, - "effectful import has an invalid quantified type", - )] - })?; - plans.push(SuspensionPlan { - index, - original: binding.symbol, - source_module: binding.source_module, - name: external.name.clone(), - span: binding.span, - source, - source_body, - quantified: shape.quantified, - parameters: shape.parameters, - application: shape.application, - payload: shape.payload, - }); - } - Ok(plans) -} - -pub(super) fn apply( - module: &mut CoreModule, - bindings: &mut ExternalBindings, - plans: &[SuspensionPlan], -) -> Result, Vec> { - let mut applied = Vec::with_capacity(plans.len()); - for plan in plans { - let Some(binding) = bindings.imports.get(plan.index) else { - return Err(vec![import_error( - module, - plan, - "effect import plan no longer names an external binding", - )]); - }; - if binding.symbol != plan.original - || binding.source_module != plan.source_module - || binding.type_id != Some(plan.source) - { - return Err(vec![import_error( - module, - plan, - "effect import plan no longer matches its source binding", - )]); - } - let Some((parameters, payload)) = closure_parts(&module.types, plan.application) else { - return Err(vec![import_error( - module, - plan, - "planned Effect result was not lowered to a closure", - )]); - }; - if parameters.len() != 1 || payload != plan.payload { - return Err(vec![import_error( - module, - plan, - "planned Effect result has an invalid token closure shape", - )]); - } - let token = parameters[0]; - let host = psrs_core::effect::fresh_foreign_symbol(module); - let host_body = psrs_core::effect::function_type(module, &plan.parameters, plan.payload); - let host_type = quantify(module, &plan.quantified, host_body); - let Some(external) = module - .externals - .iter_mut() - .find(|external| external.symbol == plan.original) - else { - return Err(vec![import_error( - module, - plan, - "effectful import has no external symbol", - )]); - }; - external.symbol = host; - let Some(external_type) = module - .external_types - .iter_mut() - .find(|external| external.symbol == plan.original) - else { - return Err(vec![import_error( - module, - plan, - "effectful import has no checked source signature", - )]); - }; - external_type.symbol = host; - external_type.ty = host_type; - bindings.imports[plan.index].symbol = host; - bindings.imports[plan.index].type_id = Some(host_type); - let wrapper = build_wrapper(module, plan, host, host_body, token)?; - module.declarations.push(wrapper); - applied.push(AppliedSuspension { - plan: plan.clone(), - host, - host_type, - }); - } - Ok(applied) -} - -pub(super) fn verify( - module: &CoreModule, - bindings: &ExternalBindings, - plans: &[SuspensionPlan], - applied: &[AppliedSuspension], -) -> Result<(), Vec> { - if plans.len() != applied.len() { - return Err(vec![effect_error( - module, - module.span, - "effect import plan and wrapper counts differ", - )]); - } - for (plan, applied) in plans.iter().zip(applied) { - if &applied.plan != plan { - return Err(vec![import_error( - module, - plan, - "effect import wrapper was built from different lowering evidence", - )]); - } - let Some(binding) = bindings.imports.get(plan.index) else { - return Err(vec![import_error( - module, - plan, - "effect wrapper has no host binding", - )]); - }; - if binding.symbol != applied.host - || binding.source_module != plan.source_module - || binding.type_id != Some(applied.host_type) - { - return Err(vec![import_error( - module, - plan, - "effect wrapper and host binding signatures differ", - )]); - } - let Some(host_external) = module - .externals - .iter() - .find(|external| external.symbol == applied.host) - else { - return Err(vec![import_error( - module, - plan, - "effect wrapper host import is missing", - )]); - }; - if host_external.signature.is_none() { - return Err(vec![import_error( - module, - plan, - "effect wrapper host import has no source signature", - )]); - } - let Some(wrapper) = module - .declarations - .iter() - .find(|declaration| declaration.symbol == plan.original) - else { - return Err(vec![import_error( - module, - plan, - "effect import wrapper declaration is missing", - )]); - }; - if wrapper.ty != plan.source_body - || wrapper.quantified != plan.quantified - || !wrapper_matches(module, wrapper, plan, applied.host) - { - return Err(vec![import_error( - module, - plan, - "effect import wrapper does not preserve its planned signature and suspension", - )]); - } - let Some((token_parameters, result)) = closure_parts(&module.types, plan.application) - else { - return Err(vec![import_error( - module, - plan, - "planned Effect result is no longer a closure", - )]); - }; - if token_parameters.len() != 1 || result != plan.payload { - return Err(vec![import_error( - module, - plan, - "planned Effect result no longer matches its recorded payload", - )]); - } - } - Ok(()) -} - -fn build_wrapper( - module: &CoreModule, - plan: &SuspensionPlan, - host: SymbolId, - host_body: TypeId, - token: TypeId, -) -> Result> { - let mut next_local = psrs_core::effect::fresh_local(module).0; - let mut fresh = || { - let id = LocalId(next_local); - next_local += 1; - id - }; - let binders = plan - .parameters - .iter() - .copied() - .map(|ty| (fresh(), ty)) - .collect::>(); - let mut call = expr(ExprKind::Global(host), host_body, plan.span); - let mut remaining = host_body; - for (local, ty) in &binders { - let Some((_, result)) = psrs_core::arrow_parts(&module.types, remaining) else { - return Err(vec![import_error( - module, - plan, - "planned host import type has fewer arguments than its source binding", - )]); - }; - call = expr( - ExprKind::Application( - Box::new(call), - Box::new(expr(ExprKind::Local(*local), *ty, plan.span)), - ), - result, - plan.span, - ); - remaining = result; - } - if remaining != plan.payload { - return Err(vec![import_error( - module, - plan, - "planned host import result differs from its Effect payload", - )]); - } - let mut arrow_types = Vec::new(); - let mut current = plan.source_body; - for _ in &plan.parameters { - arrow_types.push(current); - let Some((_, result)) = psrs_core::arrow_parts(&module.types, current) else { - return Err(vec![import_error( - module, - plan, - "effectful import type is not a function of its planned payload", - )]); - }; - current = result; - } - if current != plan.application { - return Err(vec![import_error( - module, - plan, - "effect import source signature changed after planning", - )]); - } - let token_local = fresh(); - let mut value = lambda( - token_local, - "token", - token, - call, - plan.application, - plan.span, - ); - for (index, (local, ty)) in binders.iter().enumerate().rev() { - value = lambda(*local, "value", *ty, value, arrow_types[index], plan.span); - } - Ok(Declaration { - symbol: plan.original, - name: plan.name.clone(), - name_span: plan.span, - quantified: plan.quantified.clone(), - ty: plan.source_body, - value, - span: plan.span, - }) -} - -fn wrapper_matches( - module: &CoreModule, - wrapper: &Declaration, - plan: &SuspensionPlan, - host: SymbolId, -) -> bool { - let mut expression = &wrapper.value; - let mut locals = Vec::with_capacity(plan.parameters.len() + 1); - for parameter in &plan.parameters { - let ExprKind::Lambda { binder, body } = &expression.kind else { - return false; - }; - if binder.ty != *parameter { - return false; - } - locals.push(binder.id); - expression = body; - } - let ExprKind::Lambda { binder, body } = &expression.kind else { - return false; - }; - let Some((tokens, result)) = closure_parts(&module.types, plan.application) else { - return false; - }; - if tokens != [binder.ty] || result != plan.payload || expression.ty != plan.application { - return false; - } - locals.push(binder.id); - let mut call = body.as_ref(); - for local in locals.iter().take(plan.parameters.len()).rev() { - let ExprKind::Application(function, argument) = &call.kind else { - return false; - }; - if !matches!(argument.kind, ExprKind::Local(id) if id == *local) { - return false; - } - call = function; - } - matches!(call.kind, ExprKind::Global(symbol) if symbol == host) -} - -fn strip_foralls(module: &CoreModule, mut ty: TypeId) -> Option { - let mut remaining = module.types.len(); - while let Some(Type::ForAll { body, .. }) = module.types.get(ty.0 as usize) { - if remaining == 0 { - return None; - } - remaining -= 1; - ty = *body; - } - Some(ty) -} - -fn quantify(module: &mut CoreModule, variables: &[TypeVariableId], body: TypeId) -> TypeId { - if variables.is_empty() { - return body; - } - let ty = Type::ForAll { - variables: variables.to_vec(), - body, - }; - if let Some(index) = module.types.iter().position(|candidate| candidate == &ty) { - TypeId(index as u32) - } else { - module.types.push(ty); - TypeId((module.types.len() - 1) as u32) - } -} - -fn lambda( - id: LocalId, - name: &str, - ty: TypeId, - body: Expr, - function_ty: TypeId, - span: TextRange, -) -> Expr { - expr( - ExprKind::Lambda { - binder: Binder { - id, - name: name.to_string(), - ty, - span, - }, - body: Box::new(body), - }, - function_ty, - span, - ) -} - -fn expr(kind: ExprKind, ty: TypeId, span: TextRange) -> Expr { - Expr { kind, ty, span } -} diff --git a/crates/psrs-backend/src/effects/verify.rs b/crates/psrs-backend/src/effects/verify.rs deleted file mode 100644 index af89e06d..00000000 --- a/crates/psrs-backend/src/effects/verify.rs +++ /dev/null @@ -1,277 +0,0 @@ -use crate::BackendError; -use crate::bindings::ExternalBindings; -use psrs_core::{Module as CoreModule, Type, TypeConstructor}; -use psrs_hir::{ExternalKind, TypeId as HirTypeId, TypeVariableId}; -use psrs_span::TextRange; -use std::collections::HashSet; - -const EFFECT_INTERFACE: &str = "psrs:effect"; - -pub(super) fn trusted_contract( - module: &CoreModule, - bindings: &ExternalBindings, - trusted: &psrs_core::effect::TrustedEffect, -) -> Result<(), Vec> { - if !module.opaque_ids.contains(&trusted.effect_type) - || !module.types.iter().any(|ty| { - matches!(ty, Type::Constructor(TypeConstructor::User(id)) if *id == trusted.effect_type) - }) - { - return Err(vec![effect_error( - module, - module.span, - "trusted Effect identity is missing or is not an opaque type", - )]); - } - let mut symbols = HashSet::new(); - let mut operations = HashSet::new(); - for operation in &trusted.operations { - if !symbols.insert(operation.symbol) || !operations.insert(operation.operation) { - return Err(vec![effect_error( - module, - module.span, - "trusted Effect operation bindings are duplicated", - )]); - } - let Some(external) = module - .externals - .iter() - .find(|external| external.symbol == operation.symbol) - else { - return Err(vec![effect_error( - module, - module.span, - "trusted Effect operation binding has no external declaration", - )]); - }; - let expected = operation.operation.wit_function(); - if !matches!( - &external.kind, - ExternalKind::Wit { interface, function } - if interface == EFFECT_INTERFACE && function == expected - ) { - return Err(vec![source_effect_error( - module, - external_source_module(module, operation.symbol), - external - .signature - .as_ref() - .map_or(module.span, |ty| ty.span), - "trusted Effect operation identity does not match its WIT binding", - )]); - } - let Some(binding) = bindings - .imports - .iter() - .find(|binding| binding.symbol == operation.symbol) - else { - return Err(vec![source_effect_error( - module, - external_source_module(module, operation.symbol), - external - .signature - .as_ref() - .map_or(module.span, |ty| ty.span), - "trusted Effect operation has no external binding metadata", - )]); - }; - let Some(signature) = binding.type_id else { - return Err(vec![source_effect_error( - module, - binding.source_module, - binding.span, - "trusted Effect operation has no checked source signature", - )]); - }; - if !valid_core_operation_signature( - module, - signature, - trusted.effect_type, - operation.operation, - ) { - return Err(vec![source_effect_error( - module, - binding.source_module, - binding.span, - &format!( - "trusted Effect operation `{expected}` has an invalid checked source signature" - ), - )]); - } - } - if [ - psrs_core::effect::EffectOperation::Pure, - psrs_core::effect::EffectOperation::Bind, - psrs_core::effect::EffectOperation::Run, - psrs_core::effect::EffectOperation::Trap, - ] - .into_iter() - .any(|required| !operations.contains(&required)) - { - return Err(vec![effect_error( - module, - module.span, - "trusted Effect contract is missing a required operation binding", - )]); - } - for external in &module.externals { - if matches!( - &external.kind, - ExternalKind::Wit { interface, .. } if interface == EFFECT_INTERFACE - ) && !symbols.contains(&external.symbol) - { - return Err(vec![source_effect_error( - module, - external_source_module(module, external.symbol), - external - .signature - .as_ref() - .map_or(module.span, |ty| ty.span), - "Effect WIT import is missing from the trusted operation bindings", - )]); - } - } - Ok(()) -} - -fn valid_core_operation_signature( - module: &CoreModule, - ty: psrs_core::TypeId, - effect: HirTypeId, - operation: psrs_core::effect::EffectOperation, -) -> bool { - let Some((variables, parameters, result)) = core_function_signature(module, ty) else { - return false; - }; - match operation { - psrs_core::effect::EffectOperation::Pure => { - variables.len() == 1 - && parameters.len() == 1 - && core_variable(module, parameters[0]) == Some(variables[0]) - && core_effect_payload(module, result, effect) - .is_some_and(|payload| core_variable(module, payload) == Some(variables[0])) - } - psrs_core::effect::EffectOperation::Bind => { - if variables.len() != 2 || parameters.len() != 2 { - return false; - } - let first = core_effect_payload(module, parameters[0], effect); - let continuation = psrs_core::arrow_parts(&module.types, parameters[1]); - let result = core_effect_payload(module, result, effect); - matches!((first, continuation, result), - (Some(first), Some((input, output)), Some(output_result)) - if core_variable(module, first) == Some(variables[0]) - && core_variable(module, input) == Some(variables[0]) - && core_effect_payload(module, output, effect) - .is_some_and(|payload| core_variable(module, payload) == Some(variables[1])) - && core_variable(module, output_result) == Some(variables[1])) - } - psrs_core::effect::EffectOperation::Run => { - variables.len() == 1 - && parameters.len() == 1 - && core_effect_payload(module, parameters[0], effect) - .is_some_and(|payload| core_variable(module, payload) == Some(variables[0])) - && core_variable(module, result) == Some(variables[0]) - } - psrs_core::effect::EffectOperation::Trap => { - parameters.is_empty() - && variables.is_empty() - && core_effect_payload(module, result, effect).is_some_and(|payload| { - matches!( - module.types.get(payload.0 as usize), - Some(Type::Constructor(TypeConstructor::Unit)) - ) - }) - } - } -} - -fn core_function_signature( - module: &CoreModule, - ty: psrs_core::TypeId, -) -> Option<( - Vec, - Vec, - psrs_core::TypeId, -)> { - let mut quantified = Vec::new(); - let mut body = ty; - let mut seen = HashSet::new(); - while seen.insert(body) { - let Some((variables, inner)) = psrs_core::forall_parts(&module.types, body) else { - break; - }; - quantified.extend_from_slice(variables); - body = inner; - } - if !seen.insert(body) && psrs_core::forall_parts(&module.types, body).is_some() { - return None; - } - let mut parameters = Vec::new(); - let mut arrow_seen = HashSet::new(); - loop { - if !arrow_seen.insert(body) { - return None; - } - let Some((parameter, result)) = psrs_core::arrow_parts(&module.types, body) else { - break; - }; - parameters.push(parameter); - body = result; - } - Some((quantified, parameters, body)) -} - -fn core_variable(module: &CoreModule, ty: psrs_core::TypeId) -> Option { - match module.types.get(ty.0 as usize) { - Some(Type::Variable(variable)) => Some(*variable), - _ => None, - } -} - -fn core_effect_payload( - module: &CoreModule, - ty: psrs_core::TypeId, - effect: HirTypeId, -) -> Option { - psrs_core::effect::effect_application(module, ty, effect).map(|(_, payload)| payload) -} - -pub(super) fn verification_errors(errors: &[psrs_core::VerifyError]) -> Vec { - errors - .iter() - .map(|error| { - BackendError::invalid_ir("P8 effect lowering", error.span, error.message.to_string()) - .with_module(error.module) - }) - .collect() -} - -pub(super) fn effect_error(module: &CoreModule, span: TextRange, message: &str) -> BackendError { - let error = BackendError::invalid_ir("P8 effect lowering", span, message.to_string()); - match module.entry { - Some(entry) => error.with_module(entry.module), - None => error, - } -} - -pub(super) fn source_effect_error( - _module: &CoreModule, - source_module: psrs_hir::ModuleId, - span: TextRange, - message: &str, -) -> BackendError { - BackendError::invalid_ir("P8 effect lowering", span, message.to_string()) - .with_module(source_module) -} - -pub(super) fn external_source_module( - module: &CoreModule, - symbol: psrs_hir::SymbolId, -) -> psrs_hir::ModuleId { - module - .external_types - .iter() - .find(|external| external.symbol == symbol) - .map_or(module.id, |external| external.source_module) -} diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 8e7672de..74a9cfec 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -3,7 +3,6 @@ mod bindings; mod boundary; pub mod capability; pub mod cc; -mod effects; mod linking; pub mod mir; mod pipeline; @@ -132,36 +131,6 @@ pub fn compile(module: psrs_core::Module) -> Result> Ok(compile_with_stages(module)?.artifact) } -/// Compiles linked Core using the trusted Effect identities issued by the -/// driver. Core-only callers that do not provide this contract receive no -/// library-specific Effect lowering. -pub fn compile_with_effect_context( - module: psrs_core::Module, - effect_context: psrs_core::effect::EffectCompilation, -) -> Result> { - Ok(compile_with_context(module, Some(effect_context), TargetCapabilities::default())?.artifact) -} - -/// Lowers Core to CC after applying an explicit Effect contract. -/// -/// Callers that already removed trusted Effect imports, or that have no -/// trusted contract, pass `None` and get the same binding extraction as -/// [`cc::lower_module`]. -pub fn lower_cc_with_context( - mut module: psrs_core::Module, - effect_context: Option<&psrs_core::effect::EffectCompilation>, -) -> Result> { - let mut external_bindings = ExternalBindings::from_core(&module); - let mut source = None; - let mut registry = boundary::RepresentationRegistry::new(); - if let Some(context) = effect_context { - let prepared = effects::lower_effects(&mut module, &mut external_bindings, context)?; - registry = prepared.registry; - source = Some(prepared.source); - } - cc::lower_module_with_relations(module, external_bindings, source.as_ref(), registry) -} - /// The default-profile validator, retained for backend unit tests. #[allow(dead_code)] pub(crate) fn validator() -> wasmparser::Validator { @@ -180,8 +149,6 @@ pub(crate) fn validator_for(target: TargetCapabilities) -> wasmparser::Validator pub struct Stages { /// Verified Typed Core after P7 and before P8. pub core: psrs_core::Module, - /// The explicit trusted Effect context needed to compile `core` again. - pub effect_context: Option, pub cc: cc::Module, pub mir: mir::Module, pub wasm: wasm::Module, @@ -226,15 +193,14 @@ pub fn compile_with_target( module: psrs_core::Module, target: TargetCapabilities, ) -> Result> { - compile_with_context(module, None, target) + compile_with_context(module, target) } pub fn compile_with_context( module: psrs_core::Module, - effect_context: Option, target: TargetCapabilities, ) -> Result> { - pipeline::compile_with_context_inner(module, effect_context, target, None, None) + pipeline::compile_with_context_inner(module, target, None, None) } /// Compiles with actual top-level pass/artifact tracing. Setting @@ -242,12 +208,10 @@ pub fn compile_with_context( /// lightweight and does not clone or format IR values. pub fn compile_with_context_traced( module: psrs_core::Module, - effect_context: Option, target: TargetCapabilities, capture_partial: bool, ) -> TracedCompile { - let (result, trace) = - pipeline::compile_with_context_traced(module, effect_context, target, capture_partial); + let (result, trace) = pipeline::compile_with_context_traced(module, target, capture_partial); TracedCompile { result, trace } } @@ -256,13 +220,13 @@ pub fn compile_with_context_traced( /// the verified Core available but does not publish the unverified CC candidate. pub fn compile_with_context_capturing( module: psrs_core::Module, - effect_context: Option, target: TargetCapabilities, ) -> Result { let mut partial = PartialStages::default(); - pipeline::compile_with_context_inner(module, effect_context, target, Some(&mut partial), None) - .map_err(|errors| CompileFailure { + pipeline::compile_with_context_inner(module, target, Some(&mut partial), None).map_err( + |errors| CompileFailure { errors, partial: Box::new(partial), - }) + }, + ) } diff --git a/crates/psrs-backend/src/linking/runtime_tests.rs b/crates/psrs-backend/src/linking/runtime_tests.rs index 0c506c99..59d70f21 100644 --- a/crates/psrs-backend/src/linking/runtime_tests.rs +++ b/crates/psrs-backend/src/linking/runtime_tests.rs @@ -188,7 +188,6 @@ fn fixture() -> mir::Module { ), ], functions: vec![Function { - state: None, id: FunctionId(0), symbol: symbol(20), name: "main".into(), @@ -216,7 +215,6 @@ fn fixture() -> mir::Module { span, }], entry: Some(symbol(20)), - dependencies: Default::default(), layout: None, span, } diff --git a/crates/psrs-backend/src/linking/tests.rs b/crates/psrs-backend/src/linking/tests.rs index aa8b5802..ea523bc4 100644 --- a/crates/psrs-backend/src/linking/tests.rs +++ b/crates/psrs-backend/src/linking/tests.rs @@ -12,7 +12,6 @@ fn module(import: mir::Import) -> mir::Module { strings: vec![], imports: vec![import], functions: vec![], - dependencies: Default::default(), layout: None, span: TextRange::new(0, 1), } diff --git a/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs b/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs index f7b92807..9faea64e 100644 --- a/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs +++ b/crates/psrs-backend/src/mir/gc_tests/binary_matrix/mod.rs @@ -50,7 +50,7 @@ fn verifies_and_executes_every_cc_binary_scalar_variant_on_both_targets() { kind: AssignmentKind::StringConstant("text".into()), span: span(), }), - ValueShape::State | ValueShape::Reference(_) => unreachable!(), + ValueShape::Reference(_) => unreachable!(), } } diff --git a/crates/psrs-backend/src/mir/layout/accessors.rs b/crates/psrs-backend/src/mir/layout/accessors.rs index c7f7d590..4b6d05fb 100644 --- a/crates/psrs-backend/src/mir/layout/accessors.rs +++ b/crates/psrs-backend/src/mir/layout/accessors.rs @@ -8,11 +8,6 @@ use crate::cc::{ use crate::types::{DefinedTypeId, HeapType, RefType, ValueType}; impl PlannedLayout { - /// Concrete definitions consumed by checked external ABI adaptation. - pub(crate) fn types(&self) -> &[crate::types::RecGroup] { - &self.types - } - pub(crate) fn repr_index(&self, id: ReprId) -> Result { self.repr_indices .get(&id) diff --git a/crates/psrs-backend/src/mir/layout/mod.rs b/crates/psrs-backend/src/mir/layout/mod.rs index 9dc55014..7b46010f 100644 --- a/crates/psrs-backend/src/mir/layout/mod.rs +++ b/crates/psrs-backend/src/mir/layout/mod.rs @@ -399,7 +399,6 @@ pub(crate) enum LayoutError { UnsupportedClosureTarget, IncompatibleVariant, UnsupportedValue, - UnprojectedState, } impl std::fmt::Display for LayoutError { @@ -408,10 +407,6 @@ impl std::fmt::Display for LayoutError { Self::InvalidPayloadConversion(message) => { write!(f, "invalid payload storage conversion: {message}") } - Self::UnprojectedState => write!( - f, - "state dependencies require checked MIR instruction projection" - ), other => write!(f, "{other:?}"), } } @@ -433,7 +428,6 @@ fn value_type( string_index: Option, ) -> Result { Ok(match value { - CcValueShape::State => return Err(LayoutError::UnprojectedState), CcValueShape::Integer => ValueType::I32, CcValueShape::Boolean => ValueType::Boolean, CcValueShape::Number => ValueType::F64, diff --git a/crates/psrs-backend/src/mir/layout/tests.rs b/crates/psrs-backend/src/mir/layout/tests.rs index 65593722..222ce67b 100644 --- a/crates/psrs-backend/src/mir/layout/tests.rs +++ b/crates/psrs-backend/src/mir/layout/tests.rs @@ -7,27 +7,6 @@ fn flattened_definitions(layout: &PlannedLayout) -> Vec<&DefinedType> { layout.types.iter().flat_map(|group| &group.0).collect() } -#[test] -fn a_logical_state_cannot_become_a_physical_scalar_or_storage_slot() { - let layout = PlannedLayout::plan( - &RepresentationTable::default(), - TargetCapabilities::default(), - ) - .unwrap(); - assert!(matches!( - layout.value_type(&CcValueShape::State), - Err(LayoutError::UnprojectedState) - )); - let mut table = RepresentationTable::default(); - table.representations.push(Representation::Product { - fields: vec![CcValueShape::State, CcValueShape::Integer], - }); - assert!(matches!( - PlannedLayout::plan(&table, TargetCapabilities::default()), - Err(LayoutError::UnprojectedState) - )); -} - #[test] fn planner_owns_the_gc_closure_and_capture_layouts() { let mut table = RepresentationTable::default(); diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index a0806be6..6bdfc940 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -219,17 +219,7 @@ impl FunctionLowerer<'_> { function, arguments, } => { - if let Some(binding) = self - .runtime - .and_then(|context| context.binding(*function)) - .cloned() - { - if self.lower_storage_call(&binding, assignment, current)? { - // The checked raw contract discharges this path; - // the enclosing construct supplies a Trap terminator. - return Ok(current); - } - } else if let Some(import) = self.wit_imports.get(function).cloned() { + if let Some(import) = self.wit_imports.get(function).cloned() { current = self.lower_wit_call(&import, assignment, current)?; } else { self.append_instruction( @@ -272,13 +262,6 @@ impl FunctionLowerer<'_> { assignment.span, )? } - AssignmentKind::StateExecution { .. } => { - return Err(vec![BackendError::invalid_ir( - "P9 MIR lowering", - assignment.span, - "state execution requires checked logical projection", - )]); - } AssignmentKind::IndirectCall { function, signature, diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index b73cc47d..de9aa7d9 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -18,7 +18,6 @@ mod assignment_string; mod assignments; mod conversion_helpers; mod runtime_call; -mod storage_call; pub(in crate::mir) mod tail; mod variant; mod wit_call; @@ -47,36 +46,14 @@ pub(super) fn lower_function( source: &cc::Function, id: FunctionId, wit_imports: &HashMap, - runtime: &super::runtime::RuntimeContext, layout: &PlannedLayout, conversion_helpers: Option<&mut ConversionHelpers>, literals: Option<&mut StringLiterals>, - logical_state_source: Option>, target: crate::capability::TargetCapabilities, ) -> Result> { let entry = BlockId(0); - // Removed logical identities remain reserved while their source-to-MIR - // relation is checked; helper temporaries must not reuse State identities. - let logical_values = logical_state_source - .as_ref() - .and_then(|module| { - module - .module - .functions - .iter() - .find(|function| function.symbol == source.symbol) - }) - .unwrap_or(source); let mut lowerer = FunctionLowerer { - erased_states: logical_values - .values - .iter() - .filter(|value| value.ty == cc::ValueShape::State) - .map(|value| value.id) - .collect(), owner: source.symbol, - runtime: Some(runtime), - runtime_calls: Vec::new(), wit_calls: Vec::new(), next_block: 1, blocks: vec![BasicBlock { @@ -97,7 +74,7 @@ pub(super) fn lower_function( }) }) .collect::, Vec>>()?, - next_value: logical_values + next_value: source .values .iter() .map(|value| value.id.0) @@ -118,7 +95,6 @@ pub(super) fn lower_function( source.span, )?; let mut function = Function { - state: None, id, symbol: source.symbol, name: source.name.clone(), @@ -135,30 +111,12 @@ pub(super) fn lower_function( for plan in &lowerer.wit_calls { plan.verify(&function)?; } - if let Some(source) = logical_state_source { - function.state = Some(super::state::DependencyFlow::checked_with_runtime( - source, - &function, - lowerer.runtime_calls, - lowerer.wit_calls, - )?); - } else if !lowerer.runtime_calls.is_empty() { - return Err(vec![BackendError::invalid_ir( - "P9 runtime projection", - function.span, - "raw runtime invocation has no owning dependency flow", - )]); - } tail::mark_tail(&mut function, target)?; wit::verify_function(&function, wit_imports)?; Ok(function) } pub(super) struct FunctionLowerer<'a> { - // Logical IDs remain reserved, but have no physical declaration or slot. - erased_states: std::collections::HashSet, owner: SymbolId, - runtime: Option<&'a super::runtime::RuntimeContext>, - runtime_calls: Vec, wit_calls: Vec, next_block: u32, blocks: Vec, @@ -172,11 +130,7 @@ pub(super) struct FunctionLowerer<'a> { impl FunctionLowerer<'_> { fn control_values(&self, value: ValueId) -> Vec { - if self.erased_states.contains(&value) { - Vec::new() - } else { - vec![value] - } + vec![value] } pub(super) fn value_type(&self, id: ValueId) -> Option { self.values diff --git a/crates/psrs-backend/src/mir/lower/storage_call.rs b/crates/psrs-backend/src/mir/lower/storage_call.rs deleted file mode 100644 index 2067c0f6..00000000 --- a/crates/psrs-backend/src/mir/lower/storage_call.rs +++ /dev/null @@ -1,61 +0,0 @@ -use super::*; -use crate::mir::{runtime::RawInvocation, state::RuntimeInvocation}; - -impl FunctionLowerer<'_> { - pub(super) fn lower_storage_call( - &mut self, - binding: &crate::RuntimeBinding, - assignment: &cc::Assignment, - block: BlockId, - ) -> Result> { - let context = self - .runtime - .expect("runtime binding was selected from this context"); - let plan = RawInvocation::from_source( - binding, - &context.logical, - self.owner, - assignment.destination, - self.layout, - self.next_value, - )?; - let never_returns = plan.never_returns(); - let (values, instructions) = plan.emit()?; - let next = self - .next_value - .checked_add(values.len() as u32) - .ok_or_else(|| { - vec![BackendError::invalid_ir( - "P9 runtime projection", - assignment.span, - "runtime invocation has exhausted temporary identities", - )] - })?; - let start = self - .blocks - .iter() - .find(|actual| actual.id == block) - .ok_or_else(|| { - vec![BackendError::invalid_ir( - "P9 runtime projection", - assignment.span, - "runtime invocation has no current control block", - )] - })? - .instructions - .len(); - self.runtime_calls.push(RuntimeInvocation::new( - plan, - block, - start, - instructions.len(), - values.clone(), - )); - self.values.extend(values); - self.next_value = next; - for instruction in instructions { - self.append_instruction(block, instruction, assignment.span)?; - } - Ok(never_returns) - } -} diff --git a/crates/psrs-backend/src/mir/lower/tail.rs b/crates/psrs-backend/src/mir/lower/tail.rs index efb2d41d..19f178b9 100644 --- a/crates/psrs-backend/src/mir/lower/tail.rs +++ b/crates/psrs-backend/src/mir/lower/tail.rs @@ -22,12 +22,6 @@ pub(super) fn mark_tail( function: &mut Function, target: TargetCapabilities, ) -> Result<(), Vec> { - if let Some(flow) = function.state.clone() { - let (transformed, checked) = flow.project_tail(function, target)?; - *function = transformed; - function.state = Some(checked); - return Ok(()); - } rewrite(function, target) } diff --git a/crates/psrs-backend/src/mir/lower/wit_call.rs b/crates/psrs-backend/src/mir/lower/wit_call.rs index 2cb04840..562009f9 100644 --- a/crates/psrs-backend/src/mir/lower/wit_call.rs +++ b/crates/psrs-backend/src/mir/lower/wit_call.rs @@ -23,10 +23,7 @@ impl FunctionLowerer<'_> { // The isolated builder shares checked layouts and helper ownership, // but cannot inspect or mutate the actual instruction stream. let mut builder = FunctionLowerer { - erased_states: Default::default(), owner: self.owner, - runtime: None, - runtime_calls: Vec::new(), wit_calls: Vec::new(), next_block: self.next_block, blocks: vec![BasicBlock { @@ -55,7 +52,6 @@ impl FunctionLowerer<'_> { let plan = wit::CallPlan::new( self.owner, assignment.clone(), - import.clone(), start, exit, builder.blocks.clone(), diff --git a/crates/psrs-backend/src/mir/lower/wit_tests.rs b/crates/psrs-backend/src/mir/lower/wit_tests.rs index 9dd9a623..22e67622 100644 --- a/crates/psrs-backend/src/mir/lower/wit_tests.rs +++ b/crates/psrs-backend/src/mir/lower/wit_tests.rs @@ -22,10 +22,7 @@ fn gc_wit_record_projection_uses_the_planned_product_type() { }); let lowerer_span = TextRange::new(0, 1); let mut lowerer = FunctionLowerer { - erased_states: Default::default(), owner: psrs_hir::SymbolId::new(psrs_hir::ModuleId(0), 0), - runtime: None, - runtime_calls: Vec::new(), wit_calls: Vec::new(), conversion_helpers: None, next_block: 1, diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 9fa2a1ce..a544809b 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -16,7 +16,6 @@ pub mod opt; mod planner; mod reachable; mod runtime; -pub mod state; mod verify; mod wit; @@ -62,8 +61,6 @@ pub struct Module { /// here to resolve a list element's guest layout. `None` for a hand-built /// test module with no representation table. pub(crate) layout: Option, - /// Immutable source requirements, independent of mutable function evidence. - pub(crate) dependencies: state::Inventory, pub span: TextRange, } @@ -93,9 +90,6 @@ pub(crate) struct BoundWasiImport { #[derive(Clone, Debug, PartialEq, Eq)] pub struct Function { - /// Logical dependencies and their checked correspondence to instructions. - /// They have no target value type and survive physical State projection. - pub state: Option, /// Stable module-local MIR identity. P10 maps this identity to a final /// Wasm function index after imports are ordered. pub id: FunctionId, @@ -231,8 +225,6 @@ fn lower_module_after_binding_validation( ) -> Result<(Module, WasiRegistry), Vec> { // P8 owns ordinary CC typing. Recheck actual dependency bodies at the // physical boundary, including callers supplying CC directly. - let projected = state::project(module, &bindings.runtime)?; - let module = projected.physical; // Resolve every source-declared WIT binding and pair it with the CC // abstract signature. Conformance was already checked at the linking // boundary; a declaration the backend cannot lower is rejected here. @@ -300,12 +292,7 @@ fn lower_module_after_binding_validation( module.entry.map(|entry| entry.module), ) })?; - let runtime = runtime::RuntimeContext::checked( - &bindings.runtime, - projected.logical.clone(), - &module, - &layout, - )?; + let runtime = runtime::RuntimeContext::checked(&bindings.runtime, &module, &layout)?; let mut conversion_helpers = lower::ConversionHelpers::new(&module); let mut literals = StringLiterals::default(); let mut functions = Vec::with_capacity(module.functions.len()); @@ -314,11 +301,9 @@ fn lower_module_after_binding_validation( function, FunctionId(id as u32), &wit_imports, - &runtime, &layout, Some(&mut conversion_helpers), Some(&mut literals), - projected.inventory.source_for(function.symbol), target, ) .map_err(|errors| { @@ -335,11 +320,9 @@ fn lower_module_after_binding_validation( helper, FunctionId(first_helper_id + offset as u32), &wit_imports, - &runtime, &layout, None, Some(&mut literals), - None, target, )?; functions.push(lowered); @@ -422,9 +405,6 @@ fn lower_module_after_binding_validation( } } let strings = literals.into_strings(); - let dependencies = projected - .inventory - .with_helpers(&functions[first_helper_id as usize..])?; let mir = Module { name: module.name, types: layout.types.clone(), @@ -432,7 +412,6 @@ fn lower_module_after_binding_validation( imports, functions, entry: module.entry, - dependencies, layout: Some(layout), span: module.span, }; diff --git a/crates/psrs-backend/src/mir/number_format_tests.rs b/crates/psrs-backend/src/mir/number_format_tests.rs index 6f8543ad..04604f75 100644 --- a/crates/psrs-backend/src/mir/number_format_tests.rs +++ b/crates/psrs-backend/src/mir/number_format_tests.rs @@ -21,7 +21,6 @@ fn number_format_module() -> Module { entry: Some(SymbolId::new(ModuleId(0), 0)), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: vec![ Import { @@ -38,7 +37,6 @@ fn number_format_module() -> Module { }, ], functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), diff --git a/crates/psrs-backend/src/mir/opt/cfg.rs b/crates/psrs-backend/src/mir/opt/cfg.rs index e219716d..92759f6c 100644 --- a/crates/psrs-backend/src/mir/opt/cfg.rs +++ b/crates/psrs-backend/src/mir/opt/cfg.rs @@ -7,10 +7,6 @@ use std::collections::{HashMap, HashSet, VecDeque}; pub(super) fn prune_unreachable(module: &mut Module) -> bool { let mut changed = false; for function in &mut module.functions { - if function.state.is_some() { - // CFG edits require a corresponding checked dependency transfer. - continue; - } let reachable = reachable_blocks(function.entry, &function.blocks); let original_len = function.blocks.len(); function @@ -24,9 +20,6 @@ pub(super) fn prune_unreachable(module: &mut Module) -> bool { pub(super) fn simplify_terminators(module: &mut Module) -> bool { let mut changed = false; for function in &mut module.functions { - if function.state.is_some() { - continue; - } let rewrites = function .blocks .iter() diff --git a/crates/psrs-backend/src/mir/opt/constants.rs b/crates/psrs-backend/src/mir/opt/constants.rs index 3deceb77..39cb89e2 100644 --- a/crates/psrs-backend/src/mir/opt/constants.rs +++ b/crates/psrs-backend/src/mir/opt/constants.rs @@ -45,10 +45,7 @@ pub(super) fn integer_constant(function: &Function, value: ValueId) -> Option bool { let facts = analyze(function); - // Join parameters and their incoming payloads are source anchors in a - // dependency projection. Removing them requires an explicit evidence - // transfer, even when their scalar value is known. - let changed = function.state.is_none() && materialize_block_parameters(function, &facts); + let changed = materialize_block_parameters(function, &facts); changed | fold_scalar_instructions(function) } diff --git a/crates/psrs-backend/src/mir/opt/imports.rs b/crates/psrs-backend/src/mir/opt/imports.rs index f443961f..ff8c78f5 100644 --- a/crates/psrs-backend/src/mir/opt/imports.rs +++ b/crates/psrs-backend/src/mir/opt/imports.rs @@ -90,7 +90,6 @@ mod tests { name: "ImportProjectionTest".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: vec![Import { runtime: None, @@ -99,7 +98,6 @@ mod tests { result: None, }], functions: vec![Function { - state: None, id: FunctionId(0), symbol: entry, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/opt/inline.rs b/crates/psrs-backend/src/mir/opt/inline.rs index 1ff17622..7b32e4df 100644 --- a/crates/psrs-backend/src/mir/opt/inline.rs +++ b/crates/psrs-backend/src/mir/opt/inline.rs @@ -21,9 +21,6 @@ pub(super) fn inline_small_functions(module: &mut Module) -> bool { let mut changed = false; for caller in &mut module.functions { - if caller.state.is_some() { - continue; - } let mut next_id = caller .values .iter() @@ -139,9 +136,6 @@ pub(super) fn inline_small_functions(module: &mut Module) -> bool { } fn is_candidate(function: &Function) -> bool { - if function.state.is_some() { - return false; - } if function.blocks.len() != 1 || !function.blocks[0].parameters.is_empty() { return false; } diff --git a/crates/psrs-backend/src/mir/opt/tests/constants.rs b/crates/psrs-backend/src/mir/opt/tests/constants.rs index 0a043b3c..9555440f 100644 --- a/crates/psrs-backend/src/mir/opt/tests/constants.rs +++ b/crates/psrs-backend/src/mir/opt/tests/constants.rs @@ -4,7 +4,6 @@ use super::*; fn folds_total_arithmetic_but_keeps_an_unused_trapping_operation() { let symbol = SymbolId::new(ModuleId(0), 0); let function = Function { - state: None, id: FunctionId(0), symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/control_flow.rs b/crates/psrs-backend/src/mir/opt/tests/control_flow.rs index de6e297c..cb2bfc4a 100644 --- a/crates/psrs-backend/src/mir/opt/tests/control_flow.rs +++ b/crates/psrs-backend/src/mir/opt/tests/control_flow.rs @@ -5,7 +5,6 @@ fn folds_branch_merges_prunes_blocks_and_projects_imports() { let entry = SymbolId::new(ModuleId(0), 0); let import = SymbolId::new(ModuleId(1), 0); let function = Function { - state: None, id: FunctionId(0), symbol: entry, name: "main".into(), @@ -117,7 +116,6 @@ fn folds_branch_merges_prunes_blocks_and_projects_imports() { fn preserves_switch_selectors_and_all_successors_through_p10() { let entry = SymbolId::new(ModuleId(0), 0); let function = Function { - state: None, id: FunctionId(0), symbol: entry, name: "switch_main".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/copy.rs b/crates/psrs-backend/src/mir/opt/tests/copy.rs index dbe067c2..2ef1fdae 100644 --- a/crates/psrs-backend/src/mir/opt/tests/copy.rs +++ b/crates/psrs-backend/src/mir/opt/tests/copy.rs @@ -4,7 +4,6 @@ use super::*; fn copy_forwarding_updates_the_structurer_result_value() { let symbol = SymbolId::new(ModuleId(0), 0); let function = Function { - state: None, id: FunctionId(0), symbol, name: "identity".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/inline.rs b/crates/psrs-backend/src/mir/opt/tests/inline.rs index 1b115b02..4497356c 100644 --- a/crates/psrs-backend/src/mir/opt/tests/inline.rs +++ b/crates/psrs-backend/src/mir/opt/tests/inline.rs @@ -5,7 +5,6 @@ fn inlines_small_direct_functions_and_folds_the_result() { let caller_symbol = SymbolId::new(ModuleId(0), 0); let callee_symbol = SymbolId::new(ModuleId(0), 1); let caller = Function { - state: None, id: FunctionId(0), symbol: caller_symbol, name: "main".into(), @@ -38,7 +37,6 @@ fn inlines_small_direct_functions_and_folds_the_result() { span: span(), }; let callee = Function { - state: None, id: FunctionId(1), symbol: callee_symbol, name: "increment".into(), @@ -108,7 +106,6 @@ fn inlining_uses_the_callee_function_result_value() { let caller_symbol = SymbolId::new(ModuleId(0), 0); let callee_symbol = SymbolId::new(ModuleId(0), 1); let caller = Function { - state: None, id: FunctionId(0), symbol: caller_symbol, name: "main".into(), @@ -134,7 +131,6 @@ fn inlining_uses_the_callee_function_result_value() { span: span(), }; let callee = Function { - state: None, id: FunctionId(1), symbol: callee_symbol, name: "different_result_values".into(), diff --git a/crates/psrs-backend/src/mir/opt/tests/mod.rs b/crates/psrs-backend/src/mir/opt/tests/mod.rs index 7d16fd39..6635fc99 100644 --- a/crates/psrs-backend/src/mir/opt/tests/mod.rs +++ b/crates/psrs-backend/src/mir/opt/tests/mod.rs @@ -23,7 +23,6 @@ fn module(functions: Vec, imports: Vec, entry: SymbolId) -> Mo name: "OptimizationTest".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports, functions, diff --git a/crates/psrs-backend/src/mir/opt/values.rs b/crates/psrs-backend/src/mir/opt/values.rs index d4edbfc8..46d3b377 100644 --- a/crates/psrs-backend/src/mir/opt/values.rs +++ b/crates/psrs-backend/src/mir/opt/values.rs @@ -7,11 +7,6 @@ use std::collections::{HashMap, HashSet}; pub(super) fn forward_copies(module: &mut Module) { for function in &mut module.functions { - if function.state.is_some() { - // Source predicates, action operands and adapter inputs remain - // anchored until this pass can transfer their alias evidence. - continue; - } forward_function(function); } } @@ -52,12 +47,6 @@ fn forward_function(function: &mut Function) { pub(super) fn eliminate_dead_pure(module: &mut Module) { for function in &mut module.functions { - if function.state.is_some() { - // Dependency correspondence retains source destinations and exact - // adapter instruction ranges, including unused Unit recovery. - // Deletion requires an explicit transfer of that evidence. - continue; - } eliminate_function(function); } } diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index 5b040c33..d737bb0b 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -39,8 +39,7 @@ pub(super) fn add_assignments( .iter() .any(|capture| value_types.get(capture) == Some(&ValueShape::Number)); } - AssignmentKind::IndirectCall { signature, .. } - | AssignmentKind::StateExecution { signature, .. } => { + AssignmentKind::IndirectCall { signature, .. } => { add_signature(*signature, signatures, signature_work); } AssignmentKind::RepresentationTest { reference, .. } diff --git a/crates/psrs-backend/src/mir/runtime/context.rs b/crates/psrs-backend/src/mir/runtime/context.rs index 57a69b69..3b518685 100644 --- a/crates/psrs-backend/src/mir/runtime/context.rs +++ b/crates/psrs-backend/src/mir/runtime/context.rs @@ -1,18 +1,15 @@ //! One checked runtime binding inventory shared by all function lowerers. use super::*; use psrs_hir::SymbolId; -use std::{collections::HashMap, sync::Arc}; +use std::collections::HashMap; pub(in crate::mir) struct RuntimeContext { - pub(in crate::mir) logical: Arc, - bindings: HashMap, pub(in crate::mir) imports: HashMap, } impl RuntimeContext { pub(in crate::mir) fn checked( bindings: &[RuntimeBinding], - logical: Arc, physical: &cc::Module, layout: &PlannedLayout, ) -> Result> { @@ -23,25 +20,16 @@ impl RuntimeContext { failure.to_string(), )] })?; - let mut imports = HashMap::new(); - let mut selected = HashMap::new(); + // A live source runtime binding needs the withdrawn State contract to + // map its operands. There is no generic replacement, so planning it is + // an explicit failure rather than a fabricated successful binding. for binding in bindings { - if !live.direct_calls.contains(&binding.symbol) { - continue; + if live.direct_calls.contains(&binding.symbol) { + plan_import(binding, physical, layout)?; } - let (import, _) = plan_import(binding, &logical, layout)?; - verify_import(&import, &layout.types).map_err(|message| error(binding, &message))?; - imports.insert(binding.symbol, import); - selected.insert(binding.symbol, binding.clone()); } Ok(Self { - logical, - bindings: selected, - imports, + imports: HashMap::new(), }) } - - pub(in crate::mir) fn binding(&self, symbol: SymbolId) -> Option<&RuntimeBinding> { - self.bindings.get(&symbol) - } } diff --git a/crates/psrs-backend/src/mir/runtime/function_tests.rs b/crates/psrs-backend/src/mir/runtime/function_tests.rs deleted file mode 100644 index c51e9553..00000000 --- a/crates/psrs-backend/src/mir/runtime/function_tests.rs +++ /dev/null @@ -1,123 +0,0 @@ -use super::*; -use crate::mir::{Instruction, verify_module}; -use crate::types::ValueId; -use crate::{ExternalBindings, TargetCapabilities}; -use psrs_runtime::StorageOperation; - -fn lower(operation: StorageOperation) -> super::super::Module { - let (binding, mut source) = tests::fixture(operation); - if operation == StorageOperation::Read { - source.functions[0].parameters.insert(2, ValueId(4)); - source.functions[0].values.insert( - 2, - cc::ValueDecl { - id: ValueId(4), - ty: cc::ValueShape::Integer, - }, - ); - } - super::super::lower_module_with_bindings( - source, - ExternalBindings { - imports: vec![], - runtime: vec![binding], - }, - TargetCapabilities::default(), - ) - .unwrap() - .0 -} - -#[test] -fn checked_raw_invocations_publish_whole_function_dependency_evidence() { - for operation in [ - StorageOperation::Fill, - StorageOperation::Read, - StorageOperation::Write, - ] { - let module = lower(operation); - assert_eq!(module.imports.len(), 1); - assert!(module.functions[0].state.is_some()); - verify_module(&module).unwrap(); - super::super::opt::optimize(module, TargetCapabilities::default()).unwrap(); - } -} - -#[test] -fn whole_function_checks_reject_same_typed_operand_and_provider_substitution() { - let module = lower(StorageOperation::Read); - let mut wrong = module.clone(); - let call = wrong.functions[0] - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find(|instruction| matches!(instruction, Instruction::Call { .. })) - .unwrap(); - let Instruction::Call { arguments, .. } = call else { - unreachable!() - }; - arguments[1] = ValueId(4); - assert!(verify_module(&wrong).is_err()); - let mut wrong = module.clone(); - wrong.imports[0].runtime.as_mut().unwrap().function = "array_fill".into(); - assert!( - verify_module(&wrong).is_err(), - "immutable call evidence must retain its checked import" - ); - let mut wrong = module; - wrong.imports[0].runtime = None; - assert!(verify_module(&wrong).is_err()); -} - -#[test] -fn whole_function_checks_reject_unit_in_place_of_an_actual_write() { - let module = lower(StorageOperation::Write); - let mut wrong = module.clone(); - for block in &mut wrong.functions[0].blocks { - block - .instructions - .retain(|instruction| !matches!(instruction, Instruction::CallVoid { .. })); - } - assert!(verify_module(&wrong).is_err()); - let mut wrong = module; - let unit = wrong.functions[0] - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find(|instruction| matches!(instruction, Instruction::Constant { .. })) - .unwrap(); - let Instruction::Constant { value, .. } = unit else { - unreachable!() - }; - *value = 1; - assert!(verify_module(&wrong).is_err()); -} - -#[test] -fn nonreturning_invocations_cannot_acquire_a_normal_return_or_continuation() { - let module = lower(StorageOperation::Trap); - verify_module(&module).unwrap(); - super::super::opt::optimize(module.clone(), TargetCapabilities::default()).unwrap(); - assert!(matches!( - module.functions[0].blocks[0].terminator, - Some(crate::mir::Terminator::Trap { .. }) - )); - let mut wrong = module.clone(); - wrong.functions[0].blocks[0].terminator = Some(crate::mir::Terminator::Return { - value: wrong.functions[0].result, - span: wrong.span, - }); - assert!(verify_module(&wrong).is_err()); - let mut wrong = module; - wrong.functions[0].values.push(crate::types::ValueDecl { - id: ValueId(100), - ty: ValueType::I32, - }); - let block = &mut wrong.functions[0].blocks[0]; - block.instructions.push(Instruction::Constant { - destination: ValueId(100), - value: 0, - span: wrong.span, - }); - assert!(verify_module(&wrong).is_err()); -} diff --git a/crates/psrs-backend/src/mir/runtime/invocation/emit.rs b/crates/psrs-backend/src/mir/runtime/invocation/emit.rs deleted file mode 100644 index 4aeb9029..00000000 --- a/crates/psrs-backend/src/mir/runtime/invocation/emit.rs +++ /dev/null @@ -1,95 +0,0 @@ -use super::*; - -impl RawInvocation { - pub(in crate::mir) fn emit( - &self, - ) -> Result<(Vec, Vec), Vec> { - let mut values = Vec::new(); - let mut instructions = Vec::new(); - let mut fresh = |ty| { - let id = ValueId(self.first_temporary + values.len() as u32); - values.push(ValueDecl { id, ty }); - id - }; - let mut arguments = Vec::new(); - for ((source, source_type), raw_type) in self - .arguments - .iter() - .zip(&self.argument_types) - .zip(&self.import.parameters) - { - let value = if source_type == raw_type { - *source - } else { - let ValueType::Ref(reference) = raw_type else { - return Err( - self.error("runtime operand requires a non-reference ABI conversion") - ); - }; - let value = fresh(*raw_type); - instructions.push(Instruction::RefCast { - destination: value, - value: *source, - reference: *reference, - span: self.span, - }); - value - }; - arguments.push(value); - } - match self.result { - RawCallResult::Value => { - let raw_type = self.import.result.unwrap(); - let result = if raw_type == self.result_type { - self.destination - } else { - fresh(raw_type) - }; - instructions.push(Instruction::Call { - destination: result, - function: self.import.symbol, - arguments, - span: self.span, - }); - if result != self.destination { - let ValueType::Ref(reference) = self.result_type else { - return Err( - self.error("runtime result requires a non-reference ABI conversion") - ); - }; - instructions.push(Instruction::RefCast { - destination: self.destination, - value: result, - reference, - span: self.span, - }); - } - } - RawCallResult::Unit => { - instructions.push(Instruction::CallVoid { - function: self.import.symbol, - arguments, - span: self.span, - }); - instructions.push(Instruction::Constant { - destination: self.destination, - value: 0, - span: self.span, - }); - } - RawCallResult::Never => { - instructions.push(Instruction::CallVoid { - function: self.import.symbol, - arguments, - span: self.span, - }); - instructions.push(Instruction::Unreachable { - destination: self.destination, - span: self.span, - }); - } - } - self.verify(&values, &instructions)?; - Ok((values, instructions)) - } -} diff --git a/crates/psrs-backend/src/mir/runtime/invocation/mod.rs b/crates/psrs-backend/src/mir/runtime/invocation/mod.rs deleted file mode 100644 index f9835c38..00000000 --- a/crates/psrs-backend/src/mir/runtime/invocation/mod.rs +++ /dev/null @@ -1,186 +0,0 @@ -//! Source-anchored raw calls with immutable operand and recovery witnesses. -use super::*; -use crate::mir::Instruction; -use crate::types::{ValueDecl, ValueId}; -use psrs_hir::SymbolId; -use psrs_span::TextRange; - -mod emit; -mod verify; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(in crate::mir) struct RawInvocation { - owner: SymbolId, - source: cc::Assignment, - import: Import, - arguments: Vec, - argument_types: Vec, - destination: ValueId, - result_type: ValueType, - result: RawCallResult, - span: TextRange, - first_temporary: u32, -} - -impl RawInvocation { - /// Obtain the actual assignment from immutable checked CC, rather than - /// accepting an arbitrary caller-supplied argument list or signature. - pub(in crate::mir) fn from_source( - binding: &RuntimeBinding, - module: &cc::Module, - owner: SymbolId, - destination: ValueId, - layout: &PlannedLayout, - first_temporary: u32, - ) -> Result> { - let flows = cc::state::check(module)?; - let flow = flows - .iter() - .find(|flow| flow.function.symbol == owner) - .ok_or_else(|| error(binding, "runtime invocation has no checked owning CC body"))?; - let operation = flow - .operations - .iter() - .find(|operation| operation.assignment.destination == destination) - .ok_or_else(|| error(binding, "runtime invocation has no source assignment"))?; - let cc::AssignmentKind::DirectCall { - function, - arguments, - } = &operation.assignment.kind - else { - return Err(error( - binding, - "runtime invocation source is not a direct call", - )); - }; - if *function != binding.symbol { - return Err(error( - binding, - "runtime invocation source and binding identities disagree", - )); - } - if flow - .function - .values - .iter() - .any(|value| value.id.0 >= first_temporary) - { - return Err(error( - binding, - "runtime invocation temporaries overlap logical CC values", - )); - } - let (import, result) = plan_import(binding, module, layout)?; - verify_import(&import, &layout.types).map_err(|message| error(binding, &message))?; - let signature = module - .externals - .iter() - .find(|external| external.symbol == binding.symbol) - .and_then(|external| external.signature.as_ref()) - .unwrap(); - let state = cc::state::StateCallProjection::checked(signature, &module.representations) - .map_err(|message| error(binding, message))? - .unwrap(); - let arguments = arguments[..state.state_parameter].to_vec(); - let argument_types = signature.parameters[..state.state_parameter] - .iter() - .map(|shape| { - layout - .value_type(shape) - .map_err(|_| error(binding, "runtime operand has no source layout")) - }) - .collect::, _>>()?; - let result_type = layout - .value_type(&state.payload) - .map_err(|_| error(binding, "runtime payload has no source layout"))?; - let eq = cc::payload::erased_shape(); - for (index, raw) in import.parameters.iter().enumerate() { - if matches!( - raw, - ValueType::Ref(RefType { - nullable: true, - heap: HeapType::Eq - }) - ) && signature.parameters[index] != eq - { - return Err(vec![BackendError::new( - "P9 runtime projection", - binding.span, - "runtime element requires checked canonical payload conversion before raw invocation", - )]); - } - } - if import.result - == Some(ValueType::Ref(RefType { - nullable: true, - heap: HeapType::Eq, - })) - && state.payload != eq - { - return Err(vec![BackendError::new( - "P9 runtime projection", - binding.span, - "runtime element result requires checked canonical payload recovery", - )]); - } - Ok(Self { - owner, - source: operation.assignment.clone(), - import, - arguments, - argument_types, - destination, - result_type, - result, - span: operation.assignment.span, - first_temporary, - }) - } - - pub(in crate::mir) fn never_returns(&self) -> bool { - self.result == RawCallResult::Never - } - - pub(in crate::mir) fn import(&self) -> &Import { - &self.import - } - - pub(in crate::mir) fn matches_source(&self, owner: SymbolId, source: &cc::Assignment) -> bool { - self.owner == owner && self.source == *source - } - - pub(in crate::mir) fn destination(&self) -> ValueId { - self.destination - } - - pub(in crate::mir) fn verify_source_values( - &self, - function: &crate::mir::Function, - ) -> Result<(), Vec> { - for (id, ty) in self - .arguments - .iter() - .zip(&self.argument_types) - .chain(std::iter::once((&self.destination, &self.result_type))) - { - if !function - .values - .iter() - .any(|value| value.id == *id && value.ty == *ty) - { - return Err(self.error("runtime invocation changes checked source value types")); - } - } - Ok(()) - } - - fn error(&self, message: &str) -> Vec { - vec![ - BackendError::invalid_ir("P9 runtime invocation verification", self.span, message) - .with_module(self.owner.module), - ] - } -} - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-backend/src/mir/runtime/invocation/tests.rs b/crates/psrs-backend/src/mir/runtime/invocation/tests.rs deleted file mode 100644 index 154c451b..00000000 --- a/crates/psrs-backend/src/mir/runtime/invocation/tests.rs +++ /dev/null @@ -1,150 +0,0 @@ -use super::*; -use psrs_runtime::StorageOperation; - -fn fixture(operation: StorageOperation) -> Result> { - let (binding, mut source) = crate::mir::runtime::tests::fixture(operation); - if operation == StorageOperation::Read { - let body = &mut source.functions[0]; - body.parameters.insert(2, ValueId(4)); - body.values.insert( - 2, - cc::ValueDecl { - id: ValueId(4), - ty: cc::ValueShape::Integer, - }, - ); - } - let projected = crate::mir::state::project(source, std::slice::from_ref(&binding)).unwrap(); - let layout = crate::mir::planner::RepresentationPlanner::plan_module( - &crate::mir::planner::GcPlanner::default(), - &projected.physical, - ) - .unwrap(); - let function = &projected.logical.functions[0]; - let first = function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1; - RawInvocation::from_source( - &binding, - &projected.logical, - function.symbol, - function.result, - &layout, - first, - ) -} - -#[test] -fn returning_source_calls_emit_and_verify_actual_raw_invocations() { - for operation in [ - StorageOperation::Fill, - StorageOperation::Read, - StorageOperation::Write, - ] { - let plan = fixture(operation).unwrap(); - let (values, instructions) = plan.emit().unwrap(); - plan.verify(&values, &instructions).unwrap(); - assert_eq!( - instructions - .iter() - .filter(|instruction| matches!( - instruction, - Instruction::Call { .. } | Instruction::CallVoid { .. } - )) - .count(), - 1 - ); - assert!( - values - .iter() - .all(|value| value.id.0 >= plan.first_temporary) - ); - assert!(plan.import().runtime.is_some()); - if operation == StorageOperation::Write { - assert!(matches!( - instructions[instructions.len() - 2], - Instruction::CallVoid { .. } - )); - assert!( - matches!(instructions.last(), Some(Instruction::Constant { destination, value: 0, .. }) - if *destination == plan.destination) - ); - } - } -} - -#[test] -fn raw_operand_witnesses_reject_same_typed_substitution() { - let plan = fixture(StorageOperation::Read).unwrap(); - let (values, instructions) = plan.emit().unwrap(); - let mut wrong = instructions.clone(); - let Instruction::Call { arguments, .. } = &mut wrong[0] else { - panic!("read must start with the call"); - }; - arguments[1] = ValueId(4); - assert!(plan.verify(&values, &wrong).is_err()); - let mut wrong = instructions.clone(); - let Instruction::RefCast { value, .. } = wrong.last_mut().unwrap() else { - panic!("read must recover its result"); - }; - *value = plan.arguments[0]; - assert!(plan.verify(&values, &wrong).is_err()); - let mut wrong = instructions; - wrong.push(wrong[0].clone()); - assert!(plan.verify(&values, &wrong).is_err()); -} - -#[test] -fn unit_cannot_replace_an_omitted_or_retargeted_write() { - let plan = fixture(StorageOperation::Write).unwrap(); - let (values, instructions) = plan.emit().unwrap(); - for mutation in 0..3 { - let mut wrong = instructions.clone(); - let call = wrong - .iter() - .position(|instruction| matches!(instruction, Instruction::CallVoid { .. })) - .unwrap(); - match mutation { - 0 => { - wrong.remove(call); - } - 1 => { - if let Instruction::CallVoid { function, .. } = &mut wrong[call] { - *function = SymbolId::new(function.module, function.index + 1); - } - } - _ => { - if let Some(Instruction::Constant { value, .. }) = wrong.last_mut() { - *value = 1; - } - } - } - assert!(plan.verify(&values, &wrong).is_err(), "mutation {mutation}"); - } -} - -#[test] -fn nonreturning_calls_emit_an_actual_void_call_and_bottom_without_unit() { - let plan = fixture(StorageOperation::Trap).unwrap(); - let (values, instructions) = plan.emit().unwrap(); - assert!(values.is_empty()); - assert!(matches!( - &instructions[..], - [ - Instruction::CallVoid { .. }, - Instruction::Unreachable { .. } - ] - )); - assert!(plan.verify(&values, &instructions[..1]).is_err()); - let mut wrong = instructions; - wrong[1] = Instruction::Constant { - destination: plan.destination(), - value: 0, - span: plan.span, - }; - assert!(plan.verify(&values, &wrong).is_err()); -} diff --git a/crates/psrs-backend/src/mir/runtime/invocation/verify.rs b/crates/psrs-backend/src/mir/runtime/invocation/verify.rs deleted file mode 100644 index 872ec944..00000000 --- a/crates/psrs-backend/src/mir/runtime/invocation/verify.rs +++ /dev/null @@ -1,135 +0,0 @@ -use super::*; - -impl RawInvocation { - /// Check operand and result witnesses against the source call. Mere type - /// agreement, or the presence of some call, is not sufficient evidence. - pub(in crate::mir) fn verify( - &self, - values: &[ValueDecl], - instructions: &[Instruction], - ) -> Result<(), Vec> { - let mut cursor = 0; - let mut temporary = 0; - let mut expect_fresh = |id, ty| { - let expected = values.get(temporary); - let valid = expected.is_some_and(|value| value.id == id && value.ty == ty) - && id == ValueId(self.first_temporary + temporary as u32); - temporary += 1; - valid - }; - let mut arguments = Vec::new(); - for ((source, source_type), raw_type) in self - .arguments - .iter() - .zip(&self.argument_types) - .zip(&self.import.parameters) - { - if source_type == raw_type { - arguments.push(*source); - continue; - } - let Some(Instruction::RefCast { - destination, - value, - reference, - .. - }) = instructions.get(cursor) - else { - return Err(self.error("runtime operand has no checked cast witness")); - }; - if value != source - || ValueType::Ref(*reference) != *raw_type - || !expect_fresh(*destination, *raw_type) - { - return Err( - self.error("runtime operand cast changes source identity or target type") - ); - } - arguments.push(*destination); - cursor += 1; - } - match self.result { - RawCallResult::Value => { - let Some(Instruction::Call { - destination, - function, - arguments: actual, - .. - }) = instructions.get(cursor) - else { - return Err(self.error("runtime value result has no actual call")); - }; - if *function != self.import.symbol || *actual != arguments { - return Err( - self.error("runtime call changes producer or operand correspondence") - ); - } - cursor += 1; - let raw_type = self.import.result.unwrap(); - if raw_type == self.result_type { - if *destination != self.destination { - return Err(self.error("runtime call changes its source destination")); - } - } else { - if !expect_fresh(*destination, raw_type) { - return Err(self.error("runtime raw result has no typed temporary")); - } - let Some(Instruction::RefCast { - destination: output, - value, - reference, - .. - }) = instructions.get(cursor) - else { - return Err(self.error("runtime result has no checked recovery witness")); - }; - if *output != self.destination - || value != destination - || ValueType::Ref(*reference) != self.result_type - { - return Err(self.error( - "runtime recovery loses the actual call result or checked payload type", - )); - } - cursor += 1; - } - } - RawCallResult::Unit => { - if !matches!(instructions.get(cursor), Some(Instruction::CallVoid { function, arguments: actual, .. }) - if *function == self.import.symbol && *actual == arguments) - { - return Err(self.error("runtime Unit requires an actual matching void call")); - } - cursor += 1; - if self.result_type != ValueType::I32 - || !matches!(instructions.get(cursor), - Some(Instruction::Constant { destination, value: 0, .. }) if *destination == self.destination) - { - return Err( - self.error("runtime Unit result must follow its actual void invocation") - ); - } - cursor += 1; - } - RawCallResult::Never => { - if self.import.result.is_some() - || !matches!(instructions.get(cursor), Some(Instruction::CallVoid { function, arguments: actual, .. }) - if *function == self.import.symbol && *actual == arguments) - || !matches!(instructions.get(cursor + 1), Some(Instruction::Unreachable { destination, .. }) - if *destination == self.destination) - { - return Err(self.error( - "non-returning invocation requires its actual call and bottom projection", - )); - } - cursor += 2; - } - } - if cursor != instructions.len() || temporary != values.len() { - return Err( - self.error("runtime invocation adds unaccounted instructions or temporaries") - ); - } - Ok(()) - } -} diff --git a/crates/psrs-backend/src/mir/runtime/mod.rs b/crates/psrs-backend/src/mir/runtime/mod.rs index fc3c47de..76629430 100644 --- a/crates/psrs-backend/src/mir/runtime/mod.rs +++ b/crates/psrs-backend/src/mir/runtime/mod.rs @@ -1,16 +1,10 @@ //! Source-anchored external calls using checked physical binding signatures. use super::{Import, layout::PlannedLayout, reachable::ReachableHandles}; -use crate::bindings::{ - RawCallResult, plan_runtime_import as plan_import, runtime_projection_error as error, - verify_runtime_import as verify_import, -}; -use crate::types::{HeapType, RefType, ValueType}; +use crate::bindings::plan_runtime_import as plan_import; use crate::{BackendError, RuntimeBinding, cc}; mod context; -mod invocation; pub(in crate::mir) use context::RuntimeContext; -pub(super) use invocation::RawInvocation; #[derive(Clone, Debug, PartialEq, Eq)] /// External provider/export identity retained after ABI lowering. @@ -18,9 +12,3 @@ pub struct RuntimeImport { pub module: String, pub function: String, } - -#[cfg(test)] -mod tests; - -#[cfg(test)] -mod function_tests; diff --git a/crates/psrs-backend/src/mir/runtime/tests.rs b/crates/psrs-backend/src/mir/runtime/tests.rs deleted file mode 100644 index 9bf2fdbb..00000000 --- a/crates/psrs-backend/src/mir/runtime/tests.rs +++ /dev/null @@ -1,203 +0,0 @@ -use super::*; -use crate::cc::{ - Assignment, AssignmentKind, RefShape, Reference, ReprId, Representation, Signature, ValueShape, -}; -use crate::mir::planner::{GcPlanner, RepresentationPlanner}; -use crate::types::{CompositeType, FieldType, StorageType}; -use psrs_hir::{ModuleId, SymbolId}; -use psrs_runtime::{StorageOperation, StorageValue}; -use psrs_span::TextRange; - -pub(super) fn fixture(operation: StorageOperation) -> (RuntimeBinding, cc::Module) { - let span = TextRange::new(0, 1); - let binding = RuntimeBinding { - symbol: SymbolId::new(ModuleId(0), 1), - source_module: ModuleId(0), - module: psrs_runtime::STORAGE_MODULE.into(), - function: operation.abi().export.into(), - type_id: Some(psrs_core::TypeId(0)), - span, - }; - let reference = |id| { - ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(id)), - }) - }; - let shape = |role| match role { - StorageValue::Int | StorageValue::Unit => ValueShape::Integer, - StorageValue::Array => reference(0), - StorageValue::Element | StorageValue::Any => cc::payload::erased_shape(), - }; - let source = operation.source_contract(); - let mut parameters = source - .parameters - .iter() - .copied() - .map(shape) - .collect::>(); - parameters.push(ValueShape::State); - let signature = Signature { - parameters, - result: reference(1), - }; - let arguments = (0..signature.parameters.len()) - .map(|id| cc::ValueId(id as u32)) - .collect::>(); - let result = cc::ValueId(arguments.len() as u32); - let mut values = signature - .parameters - .iter() - .enumerate() - .map(|(id, ty)| cc::ValueDecl { - id: cc::ValueId(id as u32), - ty: *ty, - }) - .collect::>(); - values.push(cc::ValueDecl { - id: result, - ty: signature.result, - }); - let owner = SymbolId::new(ModuleId(0), 0); - let module = cc::Module { - name: "RawStorageSignature".into(), - externals: vec![cc::External { - symbol: binding.symbol, - signature: Some(signature), - projection: None, - }], - representations: cc::RepresentationTable { - representations: vec![ - Representation::Array { - element: cc::payload::erased_shape(), - }, - Representation::Product { - fields: vec![ValueShape::State, shape(source.payload)], - }, - ], - ..Default::default() - }, - functions: vec![cc::Function { - symbol: owner, - name: "action".into(), - parameters: arguments.clone(), - values, - assignments: vec![Assignment { - destination: result, - kind: AssignmentKind::DirectCall { - function: binding.symbol, - arguments, - }, - span, - }], - result, - result_type: reference(1), - span, - }], - entry: Some(owner), - span, - }; - (binding, module) -} - -#[test] -fn raw_signatures_use_application_gc_types_and_distinguish_void_from_never() { - for operation in StorageOperation::ALL { - let (binding, logical) = fixture(operation); - let projected = - crate::mir::state::project(logical, std::slice::from_ref(&binding)).unwrap(); - let layout = GcPlanner::default() - .plan_module(&projected.physical) - .unwrap(); - let (import, result) = plan_import(&binding, &projected.logical, &layout).unwrap(); - let eq = ValueType::Ref(RefType { - nullable: true, - heap: HeapType::Eq, - }); - let array = || { - layout - .value_type(&ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(0)), - })) - .unwrap() - }; - let (parameters, raw_result, result_kind) = match operation { - StorageOperation::Fill => ( - vec![ValueType::I32, eq], - Some(array()), - RawCallResult::Value, - ), - StorageOperation::Read => ( - vec![array(), ValueType::I32], - Some(eq), - RawCallResult::Value, - ), - StorageOperation::Write => { - (vec![array(), ValueType::I32, eq], None, RawCallResult::Unit) - } - StorageOperation::Trap => (vec![], None, RawCallResult::Never), - }; - assert_eq!(import.symbol, binding.symbol); - assert_eq!(import.parameters, parameters); - assert_eq!(import.result, raw_result); - assert_eq!(result, result_kind); - assert!( - projected.physical.externals[0] - .signature - .as_ref() - .unwrap() - .parameters - .iter() - .all(|parameter| *parameter != ValueShape::State) - ); - let context = RuntimeContext::checked( - &[binding], - projected.logical.clone(), - &projected.physical, - &layout, - ); - assert_eq!(context.unwrap().imports.len(), 1); - } -} - -#[test] -fn raw_signature_rejects_a_contradictory_planned_array_definition() { - for field in [ - FieldType { - mutable: false, - storage: StorageType::Ref(RefType { - nullable: true, - heap: HeapType::Eq, - }), - }, - FieldType { - mutable: true, - storage: StorageType::Ref(RefType { - nullable: false, - heap: HeapType::Eq, - }), - }, - FieldType { - mutable: true, - storage: StorageType::I32, - }, - ] { - let (binding, logical) = fixture(StorageOperation::Read); - let projected = - crate::mir::state::project(logical, std::slice::from_ref(&binding)).unwrap(); - let mut layout = GcPlanner::default() - .plan_module(&projected.physical) - .unwrap(); - let id = layout.repr_index(ReprId(0)).unwrap(); - layout - .types - .iter_mut() - .flat_map(|group| &mut group.0) - .nth(id.0 as usize) - .unwrap() - .composite = CompositeType::Array(field); - let errors = plan_import(&binding, &projected.logical, &layout).unwrap_err(); - assert!(errors[0].message.contains("mutable nullable-eqref storage")); - } -} diff --git a/crates/psrs-backend/src/mir/state/branch_tests.rs b/crates/psrs-backend/src/mir/state/branch_tests.rs deleted file mode 100644 index e462d0cf..00000000 --- a/crates/psrs-backend/src/mir/state/branch_tests.rs +++ /dev/null @@ -1,307 +0,0 @@ -use super::*; -use crate::cc::{Assignment, AssignmentKind as A, ValueDecl, ValueId, ValueShape}; -use crate::mir::{BlockId, Terminator}; -use psrs_hir::{ModuleId, SymbolId}; - -pub(super) fn source(flag: bool) -> cc::Module { - let (source, _) = super::tests::fixture(); - let mut source = (*source).clone(); - source.externals.clear(); - let span = source.span; - let step = source.functions[0].result_type; - let callee = |symbol, value| cc::Function { - symbol, - name: format!("produce_{value}"), - parameters: vec![ValueId(0)], - values: vec![ - ValueDecl { - id: ValueId(0), - ty: ValueShape::State, - }, - ValueDecl { - id: ValueId(1), - ty: ValueShape::Integer, - }, - ValueDecl { - id: ValueId(2), - ty: step, - }, - ], - assignments: vec![ - Assignment { - destination: ValueId(1), - kind: A::Constant(value), - span, - }, - Assignment { - destination: ValueId(2), - kind: A::ProductNew { - destination: ValueId(2), - representation: cc::ReprId(0), - arguments: vec![ValueId(0), ValueId(1)], - }, - span, - }, - ], - result: ValueId(2), - result_type: step, - span, - }; - source - .functions - .push(callee(SymbolId::new(ModuleId(0), 1), 42)); - source - .functions - .push(callee(SymbolId::new(ModuleId(0), 6), 43)); - let call = |id, symbol| Assignment { - destination: ValueId(id), - kind: A::DirectCall { - function: symbol, - arguments: vec![ValueId(0)], - }, - span, - }; - source.functions[0].values = vec![ - ValueDecl { - id: ValueId(0), - ty: ValueShape::State, - }, - ValueDecl { - id: ValueId(4), - ty: ValueShape::Boolean, - }, - ValueDecl { - id: ValueId(1), - ty: step, - }, - ValueDecl { - id: ValueId(5), - ty: step, - }, - ValueDecl { - id: ValueId(3), - ty: step, - }, - ]; - source.functions[0].assignments = vec![ - Assignment { - destination: ValueId(4), - kind: A::Constant(i32::from(flag)), - span, - }, - Assignment { - destination: ValueId(3), - kind: A::If { - condition: ValueId(4), - then_assignments: vec![call(1, SymbolId::new(ModuleId(0), 1))], - then_value: ValueId(1), - else_assignments: vec![call(5, SymbolId::new(ModuleId(0), 6))], - else_value: ValueId(5), - }, - span, - }, - ]; - source -} - -#[test] -fn state_branches_lower_with_logical_joins_and_payload_only_block_parameters() { - let (mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); - let function = &mir.functions[0]; - assert_eq!(function.state.as_ref().unwrap().graph().blocks.len(), 4); - assert_eq!(function.blocks.len(), 4); - assert_eq!(function.blocks[3].parameters, vec![ValueId(3)]); - assert!(function.parameters.is_empty()); - crate::mir::verify_module(&mir).unwrap(); -} - -#[test] -fn state_branch_projection_rejects_changed_edges_and_calls_moved_across_choices() { - let (mut mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); - if let Some(Terminator::Branch { - then_block, - else_block, - .. - }) = &mut mir.functions[0].blocks[0].terminator - { - std::mem::swap(then_block, else_block); - } - assert!( - crate::mir::verify_module(&mir) - .unwrap_err() - .iter() - .any(|failure| failure.message.contains("branch or successor")) - ); - let (mut mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); - let instruction = mir.functions[0].blocks[1].instructions.remove(0); - mir.functions[0].blocks[2] - .instructions - .insert(0, instruction); - assert!( - crate::mir::verify_module(&mir) - .unwrap_err() - .iter() - .any(|failure| failure.message.contains("adds or loses an invocation")) - ); - let (mut mir, _) = super::tests::lower_without_tail_calls(source(true)).unwrap(); - if let Some(Terminator::Jump { target, .. }) = &mut mir.functions[0].blocks[1].terminator { - *target = BlockId(2); - } - assert!(crate::mir::verify_module(&mir).is_err()); -} - -#[test] -fn nested_choices_project_source_and_mir_block_orders_explicitly() { - let mut source = source(true); - let span = source.span; - let step = source.functions[0].result_type; - source.functions[0].values.extend([ - ValueDecl { - id: ValueId(7), - ty: ValueShape::Boolean, - }, - ValueDecl { - id: ValueId(10), - ty: step, - }, - ValueDecl { - id: ValueId(11), - ty: step, - }, - ]); - if let A::If { - then_assignments, .. - } = &mut source.functions[0].assignments[1].kind - { - let call = |id, symbol| Assignment { - destination: ValueId(id), - kind: A::DirectCall { - function: SymbolId::new(ModuleId(0), symbol), - arguments: vec![ValueId(0)], - }, - span, - }; - *then_assignments = vec![ - Assignment { - destination: ValueId(7), - kind: A::Constant(0), - span, - }, - Assignment { - destination: ValueId(1), - kind: A::If { - condition: ValueId(7), - then_assignments: vec![call(10, 1)], - then_value: ValueId(10), - else_assignments: vec![call(11, 6)], - else_value: ValueId(11), - }, - span, - }, - ]; - } - let (mir, _) = super::tests::lower_without_tail_calls(source).unwrap(); - assert_eq!( - mir.functions[0] - .state - .as_ref() - .unwrap() - .graph() - .blocks - .len(), - 7 - ); - assert_eq!(mir.functions[0].blocks.len(), 7); - assert!(matches!( - mir.functions[0].blocks[1].terminator, - Some(Terminator::Branch { - then_block: BlockId(4), - else_block: BlockId(5), - .. - }) - )); - crate::mir::verify_module(&mir).unwrap(); -} - -#[test] -fn a_trapping_state_arm_has_no_normal_edge_to_the_payload_join() { - let mut source = source(false); - if let A::If { - then_assignments, .. - } = &mut source.functions[0].assignments[1].kind - { - then_assignments[0].kind = A::Unreachable; - } - let (mut mir, _) = super::tests::lower_without_tail_calls(source).unwrap(); - assert!(matches!( - mir.functions[0].blocks[1].terminator, - Some(Terminator::Trap { .. }) - )); - crate::mir::verify_module(&mir).unwrap(); - mir.functions[0].blocks[1].terminator = Some(Terminator::Jump { - target: BlockId(3), - arguments: vec![ValueId(1)], - span: mir.span, - }); - assert!(crate::mir::verify_module(&mir).is_err()); -} - -#[test] -fn state_branch_components_execute_both_selected_payloads_after_optimization() { - for (flag, trapping, expected) in [ - (true, false, Some(42)), - (false, false, Some(43)), - (false, true, Some(43)), - (true, true, None), - ] { - let target = crate::TargetCapabilities::default(); - let mut source = source(flag); - if trapping - && let A::If { - then_assignments, .. - } = &mut source.functions[0].assignments[1].kind - { - then_assignments[0].kind = A::Unreachable; - } - let (mir, mut wasi) = super::tests::lower_without_tail_calls(source).unwrap(); - let mir = crate::mir::opt::optimize(mir, target).unwrap(); - assert_eq!(mir.functions[0].blocks.len(), 4); - let context = crate::linking::default_context().unwrap(); - let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target).unwrap(); - let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link).unwrap(); - let core = crate::wasm::encode_module(&wasm).unwrap(); - let component = crate::linking::compose(&link, &core, mir.span, None).unwrap(); - crate::validator_for(target) - .validate_all(&component) - .unwrap(); - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - } - let path = std::env::temp_dir().join(format!( - "psrs-state-choice-{}-{flag}-{trapping}.wasm", - std::process::id() - )); - std::fs::write(&path, component).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - std::fs::remove_file(path).unwrap(); - let stderr = String::from_utf8_lossy(&output.stderr); - if let Some(expected) = expected { - assert_eq!(output.status.code(), Some(expected), "{stderr}"); - } else { - assert!(!output.status.success(), "a selected trap must fail"); - assert!(stderr.contains("unreachable"), "{stderr}"); - } - } -} diff --git a/crates/psrs-backend/src/mir/state/captures.rs b/crates/psrs-backend/src/mir/state/captures.rs deleted file mode 100644 index 517bdc3e..00000000 --- a/crates/psrs-backend/src/mir/state/captures.rs +++ /dev/null @@ -1,91 +0,0 @@ -//! Capture producers and surviving slot reads stay anchored to logical CC. -use super::*; -use std::collections::HashSet; - -pub(super) fn verify( - source: &cc::Function, - function: &Function, - assignments: &[&cc::Assignment], - instructions: &[&Instruction], -) -> Result<(), Vec> { - let states = source - .values - .iter() - .filter(|value| value.ty == cc::ValueShape::State) - .map(|value| value.id) - .collect::>(); - let slots = cc::state::capture_shapes(source)?; - let mut expected = Vec::new(); - collect(assignments, &states, &slots, &mut expected); - let mut actual = Vec::new(); - for instruction in instructions { - let capture = match instruction { - Instruction::ClosureNew { - destination, - function, - captures, - .. - } => Some((*destination, Capture::New(*function, captures.clone()))), - Instruction::ClosureGetCapture { - destination, - closure, - index, - .. - } => Some((*destination, Capture::Get(*closure, *index))), - _ => None, - }; - if let Some(capture) = capture { - actual.push(capture); - } - } - if actual != expected { - return Err(error( - function, - "MIR capture projection changes a producer, operand, logical slot or scope", - )); - } - Ok(()) -} - -#[derive(Debug, PartialEq, Eq)] -enum Capture { - New(psrs_hir::SymbolId, Vec), - Get(cc::ValueId, u32), -} - -fn collect( - assignments: &[&cc::Assignment], - states: &HashSet, - slots: &[cc::ValueShape], - expected: &mut Vec<(cc::ValueId, Capture)>, -) { - for assignment in assignments { - match &assignment.kind { - cc::AssignmentKind::FunctionRef { - function, captures, .. - } => { - expected.push(( - assignment.destination, - Capture::New( - *function, - captures - .iter() - .filter(|value| !states.contains(value)) - .copied() - .collect(), - ), - )); - } - cc::AssignmentKind::ClosureGetCapture { closure, index } - if !states.contains(&assignment.destination) => - { - let physical = slots[..*index as usize] - .iter() - .filter(|shape| **shape != cc::ValueShape::State) - .count() as u32; - expected.push((assignment.destination, Capture::Get(*closure, physical))); - } - _ => {} - } - } -} diff --git a/crates/psrs-backend/src/mir/state/control.rs b/crates/psrs-backend/src/mir/state/control.rs deleted file mode 100644 index d89a1af7..00000000 --- a/crates/psrs-backend/src/mir/state/control.rs +++ /dev/null @@ -1,443 +0,0 @@ -//! Source-anchored projection of structured CC choices to actual MIR blocks. -use super::*; -use crate::mir::{BlockId, Terminator}; - -struct Block<'a> { - parameters: Vec, - calls: Vec>, - captures: Vec<&'a cc::Assignment>, - end: Option, -} -struct Call<'a> { - assignment: &'a cc::Assignment, - adapter: Option<(psrs_hir::SymbolId, cc::ValueId)>, -} -enum End { - Branch(cc::ValueId, usize, usize), - Switch(cc::ValueId, Vec<(i32, usize)>, usize), - Jump(usize, cc::ValueId), - Return(cc::ValueId), - Trap, -} - -pub(super) fn verify( - source: &cc::Function, - function: &Function, - table: &cc::RepresentationTable, - runtime: &[RuntimeInvocation], - host: &[crate::mir::wit::CallPlan], -) -> Result<(), Vec> { - let mut host_by_entry = std::collections::HashMap::new(); - let mut adapter_blocks = std::collections::HashSet::new(); - for invocation in host { - invocation.verify(function)?; - if host_by_entry - .insert((invocation.entry(), invocation.start()), invocation) - .is_some() - { - return Err(error( - function, - "canonical invocation anchors are duplicated", - )); - } - for block in invocation.created_blocks() { - if !adapter_blocks.insert(block) { - return Err(error(function, "canonical invocation blocks overlap")); - } - } - } - let mut checked_host = std::collections::HashSet::new(); - let mut runtime_by_destination = std::collections::HashMap::new(); - for invocation in runtime { - if runtime_by_destination - .insert(invocation.destination(), invocation) - .is_some() - { - return Err(error( - function, - "runtime invocation source anchors are duplicated", - )); - } - } - let never = runtime - .iter() - .filter(|invocation| invocation.never_returns()) - .map(|invocation| invocation.destination()) - .collect::>(); - let mut checked_runtime = std::collections::HashSet::new(); - let states = source - .values - .iter() - .filter(|value| value.ty == cc::ValueShape::State) - .map(|value| value.id) - .collect::>(); - let projected_arguments = |arguments: &[cc::ValueId]| { - arguments - .iter() - .filter(|argument| !states.contains(argument)) - .copied() - .collect::>() - }; - let mut blocks = vec![Block { - parameters: Vec::new(), - calls: Vec::new(), - captures: Vec::new(), - end: None, - }]; - let end = sequence(&source.assignments, 0, &mut blocks, table, &never)?; - if blocks[end].end.is_none() { - blocks[end].end = Some(End::Return(source.result)); - } - let mut source_blocks = function - .blocks - .iter() - .filter(|block| !adapter_blocks.contains(&block.id)) - .map(|block| block.id) - .collect::>(); - source_blocks.sort_by_key(|block| block.0); - if function.entry != BlockId(0) || source_blocks.len() != blocks.len() { - return Err(error( - function, - "MIR dependency projection changes checked control flow", - )); - } - for (id, expected) in blocks.iter().enumerate() { - let mut actual = function - .blocks - .iter() - .find(|block| block.id == source_blocks[id]) - .ok_or_else(|| error(function, "MIR dependency projection loses a control block"))?; - if actual.parameters != projected_arguments(&expected.parameters) { - return Err(error( - function, - "MIR dependency projection changes block parameters", - )); - } - // Collapse only complete, independently checked canonical adapters. - // Their internal calls and edges remain verified by the owning plan. - let mut calls = Vec::new(); - let mut captures = Vec::new(); - let mut cursor = 0; - loop { - if let Some(invocation) = host_by_entry.get(&(actual.id, cursor)) { - if !checked_host.insert((actual.id, cursor)) { - return Err(error(function, "canonical invocation revisits an adapter")); - } - let instruction = actual - .instructions - .get(cursor) - .ok_or_else(|| error(function, "canonical invocation has no instruction"))?; - calls.push((actual.id, cursor, instruction, Some(*invocation))); - let (exit, offset) = invocation.exit(); - actual = function - .blocks - .iter() - .find(|block| block.id == exit) - .ok_or_else(|| error(function, "canonical invocation loses its exit"))?; - cursor = offset; - continue; - } - let Some(instruction) = actual.instructions.get(cursor) else { - break; - }; - if matches!( - instruction, - Instruction::Call { .. } - | Instruction::CallVoid { .. } - | Instruction::CallRef { .. } - | Instruction::ClosureCall { .. } - ) { - calls.push((actual.id, cursor, instruction, None)); - } - if matches!( - instruction, - Instruction::ClosureNew { .. } | Instruction::ClosureGetCapture { .. } - ) { - captures.push(instruction); - } - cursor += 1; - } - super::captures::verify(source, function, &expected.captures, &captures)?; - let valid = match (&expected.end, &actual.terminator) { - ( - Some(End::Branch(condition, left, right)), - Some(Terminator::Branch { - condition: actual, - then_block, - else_block, - .. - }), - ) => { - condition == actual - && Some(then_block) == source_blocks.get(*left) - && Some(else_block) == source_blocks.get(*right) - } - ( - Some(End::Switch(value, cases, default)), - Some(Terminator::Switch { - value: actual, - cases: actual_cases, - default: actual_default, - .. - }), - ) => { - value == actual - && cases.len() == actual_cases.len() - && cases.iter().zip(actual_cases).all( - |((tag, block), (actual_tag, actual_block))| { - tag == actual_tag && Some(actual_block) == source_blocks.get(*block) - }, - ) - && Some(actual_default) == source_blocks.get(*default) - } - ( - Some(End::Jump(target, value)), - Some(Terminator::Jump { - target: actual, - arguments, - .. - }), - ) => { - Some(actual) == source_blocks.get(*target) - && *arguments == projected_arguments(&[*value]) - } - (Some(End::Return(value)), Some(Terminator::Return { value: actual, .. })) => { - value == actual - } - (Some(End::Trap), Some(Terminator::Trap { .. })) => matches!( - actual.instructions.last(), - Some(Instruction::Unreachable { .. }) - ), - _ => false, - }; - if !valid { - return Err(error( - function, - "MIR dependency projection changes a branch or successor", - )); - } - if calls.len() != expected.calls.len() { - return Err(error( - function, - "MIR dependency projection adds or loses an invocation", - )); - } - for ((call_block, call_index, instruction, host), call) in calls.iter().zip(&expected.calls) - { - let assignment = call.assignment; - if let Some(invocation) = host { - let cc::AssignmentKind::DirectCall { arguments, .. } = &assignment.kind else { - return Err(error( - function, - "canonical adapter has no direct source call", - )); - }; - if call.adapter.is_some() - || !invocation.matches_source(assignment, &projected_arguments(arguments)) - { - return Err(error( - function, - "canonical adapter changes its source invocation", - )); - } - continue; - } - if let Some(invocation) = runtime_by_destination.get(&assignment.destination) { - invocation.verify_call(source, assignment, function, *call_block, *call_index)?; - checked_runtime.insert(assignment.destination); - continue; - } - if instruction.destination() != Some(assignment.destination) { - return Err(error( - function, - "MIR dependency projection reorders invocations", - )); - } - let valid = if let Some((expected, value)) = call.adapter { - matches!(instruction, Instruction::Call { function, arguments, .. } - if *function == expected && arguments.as_slice() == [value]) - } else { - match (&assignment.kind, instruction) { - ( - cc::AssignmentKind::DirectCall { - function: expected, - arguments: expected_arguments, - }, - Instruction::Call { - function: actual, - arguments: actual_arguments, - .. - }, - ) => { - expected == actual - && projected_arguments(expected_arguments) == *actual_arguments - } - ( - cc::AssignmentKind::IndirectCall { - function: expected, - arguments: expected_arguments, - .. - }, - Instruction::ClosureCall { - function: actual, - arguments: actual_arguments, - .. - }, - ) => { - expected == actual - && projected_arguments(expected_arguments) == *actual_arguments - } - ( - cc::AssignmentKind::StateExecution { - function: expected, .. - }, - Instruction::ClosureCall { - function: actual, - arguments, - .. - }, - ) => expected == actual && arguments.is_empty(), - _ => false, - } - }; - if !valid { - return Err(error( - function, - "MIR dependency projection changes an invocation producer or operands", - )); - } - } - } - if checked_host.len() != host.len() { - return Err(error( - function, - "canonical invocation evidence has no corresponding source call", - )); - } - if checked_runtime.len() != runtime.len() { - return Err(error( - function, - "runtime invocation evidence has no corresponding source call", - )); - } - Ok(()) -} - -fn sequence<'a>( - assignments: &'a [cc::Assignment], - mut current: usize, - blocks: &mut Vec>, - table: &cc::RepresentationTable, - never: &std::collections::HashSet, -) -> Result> { - for assignment in assignments { - match &assignment.kind { - cc::AssignmentKind::FunctionRef { .. } - | cc::AssignmentKind::ClosureGetCapture { .. } => { - blocks[current].captures.push(assignment); - } - cc::AssignmentKind::DirectCall { .. } - | cc::AssignmentKind::IndirectCall { .. } - | cc::AssignmentKind::StateExecution { .. } => { - blocks[current].calls.push(Call { - assignment, - adapter: None, - }); - if never.contains(&assignment.destination) { - blocks[current].end = Some(End::Trap); - return Ok(current); - } - } - cc::AssignmentKind::If { - condition, - then_assignments, - else_assignments, - then_value, - else_value, - } => { - let left = blocks.len(); - blocks.extend((0..3).map(|offset| Block { - parameters: if offset == 2 { - vec![assignment.destination] - } else { - Vec::new() - }, - calls: Vec::new(), - captures: Vec::new(), - end: None, - })); - let right = left + 1; - let join = left + 2; - blocks[current].end = Some(End::Branch(*condition, left, right)); - let left_end = sequence(then_assignments, left, blocks, table, never)?; - let right_end = sequence(else_assignments, right, blocks, table, never)?; - if blocks[left_end].end.is_none() { - blocks[left_end].end = Some(End::Jump(join, *then_value)); - } - if blocks[right_end].end.is_none() { - blocks[right_end].end = Some(End::Jump(join, *else_value)); - } - current = join; - } - cc::AssignmentKind::AggregateConvert { - value, conversion, .. - } => { - let projected = - cc::state::StateCallProjection::payload_conversion(conversion, table).ok(); - let conversion = projected.as_ref().unwrap_or(conversion); - if let cc::ValueConversion::FunctionAdapter { function, .. } = conversion.plan { - blocks[current].calls.push(Call { - assignment, - adapter: Some((function, *value)), - }); - } - } - cc::AssignmentKind::Unreachable => { - blocks[current].end = Some(End::Trap); - return Ok(current); - } - cc::AssignmentKind::TagSwitch { - value, - cases, - default_assignments, - default_value, - } => { - let first = blocks.len(); - let default = first + cases.len(); - let join = default + 1; - blocks.extend((first..=join).map(|id| Block { - parameters: if id == join { - vec![assignment.destination] - } else { - Vec::new() - }, - calls: Vec::new(), - captures: Vec::new(), - end: None, - })); - blocks[current].end = Some(End::Switch( - *value, - cases - .iter() - .enumerate() - .map(|(index, case)| (case.tag, first + index)) - .collect(), - default, - )); - for (index, case) in cases.iter().enumerate() { - let end = sequence(&case.assignments, first + index, blocks, table, never)?; - if blocks[end].end.is_none() { - blocks[end].end = Some(End::Jump(join, case.value)); - } - } - let end = sequence(default_assignments, default, blocks, table, never)?; - if blocks[end].end.is_none() { - blocks[end].end = Some(End::Jump(join, *default_value)); - } - current = join; - } - _ => {} - } - } - Ok(current) -} diff --git a/crates/psrs-backend/src/mir/state/host_tests.rs b/crates/psrs-backend/src/mir/state/host_tests.rs deleted file mode 100644 index 08893529..00000000 --- a/crates/psrs-backend/src/mir/state/host_tests.rs +++ /dev/null @@ -1,188 +0,0 @@ -use super::*; -use crate::cc::{ - AssignmentKind, RefShape, Reference, ReprId, Representation, Signature, ValueShape, -}; -use crate::mir::{Module, lower_module_with_bindings, verify_module}; -use crate::types::ValueId; -use crate::{ExternalBinding, ExternalBindings, TargetCapabilities}; - -fn fixture() -> Module { - let (logical, _) = super::tests::fixture(); - let mut logical = (*logical).clone(); - let getter = logical.externals[0].symbol; - let drop = psrs_hir::SymbolId::new(getter.module, getter.index + 1); - let step = ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Repr(ReprId(1)), - }); - logical - .representations - .representations - .push(Representation::Product { - fields: vec![ValueShape::State, ValueShape::Integer], - }); - logical.externals.push(cc::External { - symbol: drop, - signature: Some(Signature { - parameters: vec![ValueShape::Integer, ValueShape::State], - result: step, - }), - projection: None, - }); - let body = &mut logical.functions[0]; - body.values[3].ty = step; - body.values.push(cc::ValueDecl { - id: ValueId(4), - ty: ValueShape::Integer, - }); - body.assignments.insert( - 2, - cc::Assignment { - destination: ValueId(4), - kind: AssignmentKind::ProductGet { - destination: ValueId(4), - representation: ReprId(0), - field: 1, - value: ValueId(1), - }, - span: logical.span, - }, - ); - body.assignments[3].kind = AssignmentKind::DirectCall { - function: drop, - arguments: vec![ValueId(4), ValueId(2)], - }; - body.result_type = step; - let imports = [ - (getter, "wasi:cli/stdout", "get-stdout"), - (drop, "wasi:io/streams", "[resource-drop]output-stream"), - ] - .into_iter() - .map(|(symbol, interface, function)| ExternalBinding { - symbol, - interface: interface.into(), - function: function.into(), - source_module: getter.module, - type_id: None, - span: logical.span, - }) - .collect(); - lower_module_with_bindings( - logical, - ExternalBindings { - imports, - runtime: Vec::new(), - }, - TargetCapabilities::default(), - ) - .unwrap() - .0 -} - -#[test] -fn canonical_state_calls_check_target_operands_unit_and_import() { - let module = fixture(); - verify_module(&module).unwrap(); - let function = &module.functions[0]; - assert!( - function.blocks[0] - .instructions - .iter() - .any(|instruction| matches!(instruction, Instruction::CallVoid { .. })) - ); - for mutation in 0..4 { - let mut changed = module.clone(); - let instructions = &mut changed.functions[0].blocks[0].instructions; - match mutation { - 0 => { - let Instruction::Call { function, .. } = &mut instructions[0] else { - panic!() - }; - *function = module.functions[0].symbol; - } - 1 => { - let instruction = instructions - .iter_mut() - .find(|instruction| matches!(instruction, Instruction::CallVoid { .. })) - .unwrap(); - let Instruction::CallVoid { arguments, .. } = instruction else { - panic!() - }; - arguments[0] = ValueId(3); - } - 2 => { - let Instruction::Constant { value, .. } = instructions.last_mut().unwrap() else { - panic!() - }; - *value = 7; - } - _ => changed.imports[0] - .parameters - .push(crate::types::ValueType::I32), - } - let errors = verify_module(&changed).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 canonical call verification"), - "mutation {mutation} must fail canonical correspondence: {errors:?}" - ); - } -} - -#[test] -fn canonical_state_calls_reject_reordering_and_extra_calls() { - let module = fixture(); - let mut changed = module.clone(); - changed.functions[0].blocks[0].instructions.swap(0, 2); - assert!(verify_module(&changed).is_err()); - let mut changed = module.clone(); - let call = changed.functions[0].blocks[0].instructions[0].clone(); - changed.functions[0].blocks[0].instructions.push(call); - assert!(verify_module(&changed).is_err()); -} - -#[test] -fn canonical_dependency_evidence_cannot_be_removed_to_bypass_verification() { - let module = fixture(); - verify_module(&module).unwrap(); - let mut changed = module.clone(); - changed.functions[0].state = None; - let errors = verify_module(&changed).unwrap_err(); - assert!(errors.iter().any(|error| { - error.pass == "P9 MIR dependency verification" - && error - .message - .contains("missing required dependency evidence") - })); - let errors = crate::mir::opt::optimize(changed, TargetCapabilities::default()).unwrap_err(); - assert!(errors.iter().any(|error| { - error.pass == "P10 MIR optimization" - && error - .message - .contains("missing required dependency evidence") - })); - - let mut changed = module; - changed.dependencies = Default::default(); - changed.functions[0].state = None; - let errors = verify_module(&changed).unwrap_err(); - assert!(errors.iter().any(|error| { - error - .message - .contains("planned MIR has no checked dependency inventory") - })); -} - -#[test] -fn changing_a_projected_function_identity_cannot_remove_its_source_requirement() { - let mut module = fixture(); - module.functions[0].state = None; - module.functions[0].symbol = psrs_hir::SymbolId::new(psrs_hir::ModuleId(99), 99); - let errors = verify_module(&module).unwrap_err(); - assert!(errors.iter().any(|error| { - error - .message - .contains("no source or generated-helper provenance") - })); -} diff --git a/crates/psrs-backend/src/mir/state/inventory.rs b/crates/psrs-backend/src/mir/state/inventory.rs deleted file mode 100644 index 62efe09c..00000000 --- a/crates/psrs-backend/src/mir/state/inventory.rs +++ /dev/null @@ -1,108 +0,0 @@ -//! Source requirements remain independent of mutable per-function witnesses. -use super::*; -use psrs_hir::SymbolId; -use std::collections::HashSet; - -/// No source inventory is used only for directly constructed physical MIR. -/// Production P9 modules retain their checked logical source even when pure. -#[derive(Clone, Debug, Default, PartialEq, Eq)] -pub(crate) struct Inventory { - source: Option>, - required: HashSet, - declared: HashSet, -} - -impl Inventory { - pub(in crate::mir) fn checked(source: Arc) -> Result> { - let source = CheckedSource::checked(source)?; - let required = source.required().collect(); - let declared = source - .module - .functions - .iter() - .map(|function| function.symbol) - .collect(); - Ok(Self { - source: Some(source), - required, - declared, - }) - } - - /// P9 registers only the helpers it generated during this lowering. - pub(in crate::mir) fn with_helpers( - mut self, - helpers: &[Function], - ) -> Result> { - for helper in helpers { - if helper.state.is_some() || !self.declared.insert(helper.symbol) { - return Err(error( - helper, - "generated MIR helper conflicts with source provenance", - )); - } - } - Ok(self) - } - - pub(in crate::mir) fn source_for(&self, symbol: SymbolId) -> Option> { - self.requires(symbol) - .then(|| self.source.as_ref().unwrap().clone()) - } - - pub(in crate::mir) fn requires(&self, symbol: SymbolId) -> bool { - self.required.contains(&symbol) - } - - pub(in crate::mir) fn verify( - &self, - module: &crate::mir::Module, - ) -> Result<(), Vec> { - let mut errors = Vec::new(); - if self.source.is_none() && module.layout.is_some() { - errors.push(BackendError::invalid_ir( - "P9 MIR dependency verification", - module.span, - "planned MIR has no checked dependency inventory", - )); - } - // Reachability may remove whole unused functions. Every retained - // function is still checked against the original source requirement; - // pruning never rewrites this immutable inventory. - for function in &module.functions { - if self.source.is_some() && !self.declared.contains(&function.symbol) { - errors.extend(error( - function, - "MIR function has no source or generated-helper provenance", - )); - } - match (self.requires(function.symbol), &function.state) { - (true, None) => errors.extend(error( - function, - "MIR function is missing required dependency evidence", - )), - (false, Some(_)) => errors.extend(error( - function, - "MIR dependency evidence has no module source requirement", - )), - (true, Some(flow)) - if !self - .source - .as_ref() - .is_some_and(|source| Arc::ptr_eq(&source.module, &flow.source.module)) => - { - errors.extend(error( - function, - "MIR dependency evidence belongs to a different source inventory", - )); - } - _ => {} - } - } - if errors.is_empty() { - Ok(()) - } else { - Err(errors) - } - } -} diff --git a/crates/psrs-backend/src/mir/state/mod.rs b/crates/psrs-backend/src/mir/state/mod.rs deleted file mode 100644 index 5a17e302..00000000 --- a/crates/psrs-backend/src/mir/state/mod.rs +++ /dev/null @@ -1,164 +0,0 @@ -//! Logical dependency evidence retained alongside concrete MIR instructions. -use super::{Function, Instruction}; -use crate::{BackendError, cc}; -use psrs_core::state::dependency::Graph; -use std::sync::Arc; -mod captures; -mod control; -mod inventory; -pub(crate) use inventory::Inventory; -mod projection; -mod runtime; -mod source; -pub(in crate::mir) use source::CheckedSource; -mod tail; -pub(super) use projection::project; -pub(in crate::mir) use runtime::RuntimeInvocation; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct DependencyFlow { - source: Arc, - tail: Option, - graph: Graph, - executions: Vec, - runtime: Vec, - host: Vec, -} - -impl DependencyFlow { - /// Publishes a projection only after both its source and actual MIR calls - /// agree. Structured binary choices retain their actual CFG correspondence; - /// a graph alone never authorizes physical erasure. - pub fn checked( - source: Arc, - function: &Function, - ) -> Result> { - Self::checked_with_runtime( - CheckedSource::checked(source)?, - function, - Vec::new(), - Vec::new(), - ) - } - - pub(in crate::mir) fn checked_with_runtime( - source: Arc, - function: &Function, - runtime: Vec, - host: Vec, - ) -> Result> { - let flow = source - .flow(function.symbol) - .ok_or_else(|| error(function, "MIR dependency projection has no checked CC body"))?; - let graph = flow.graph.clone(); - let executions = flow.executions.clone(); - let projection = Self { - source, - tail: None, - graph, - executions, - runtime, - host, - }; - projection.verify(function)?; - Ok(projection) - } - - pub fn executions(&self) -> &[Graph] { - &self.executions - } - - pub fn graph(&self) -> &Graph { - &self.graph - } - - pub(crate) fn verify(&self, function: &Function) -> Result<(), Vec> { - let function = if let Some(transfer) = &self.tail { - transfer.verify(function)?; - transfer.source() - } else { - function - }; - let expected = self.source.flow(function.symbol).ok_or_else(|| { - error( - function, - "MIR dependency projection has no owning CC function", - ) - })?; - if self.executions != expected.executions || self.graph != expected.graph { - return Err(error( - function, - "MIR dependency projection changes checked control flow", - )); - } - self.graph - .verify() - .map_err(|failure| error(function, failure.message))?; - let source_function = self.source.function(function.symbol).ok_or_else(|| { - error( - function, - "MIR dependency projection has no owning CC function", - ) - })?; - let states = source_function - .values - .iter() - .filter(|value| value.ty == cc::ValueShape::State) - .map(|value| value.id) - .collect::>(); - let parameters = source_function - .parameters - .iter() - .filter(|id| !states.contains(id)) - .copied() - .collect::>(); - if function.parameters != parameters - || function - .values - .iter() - .any(|value| states.contains(&value.id)) - { - return Err(error( - function, - "MIR dependency projection materializes a logical State slot", - )); - } - control::verify( - source_function, - function, - &self.source.module.representations, - &self.runtime, - &self.host, - )?; - Ok(()) - } - - pub(crate) fn verify_imports(&self, module: &super::Module) -> Result<(), Vec> { - for invocation in &self.runtime { - invocation.verify_import(module)?; - } - for invocation in &self.host { - invocation.verify_import(module)?; - } - Ok(()) - } -} - -fn error(function: &Function, message: &str) -> Vec { - vec![ - BackendError::invalid_ir("P9 MIR dependency verification", function.span, message) - .with_module(function.symbol.module), - ] -} - -#[cfg(test)] -mod branch_tests; -#[cfg(test)] -mod host_tests; -#[cfg(test)] -mod operand_tests; -#[cfg(test)] -mod tests; - -#[cfg(test)] -mod switch_tests; diff --git a/crates/psrs-backend/src/mir/state/operand_tests.rs b/crates/psrs-backend/src/mir/state/operand_tests.rs deleted file mode 100644 index a5bde8b3..00000000 --- a/crates/psrs-backend/src/mir/state/operand_tests.rs +++ /dev/null @@ -1,120 +0,0 @@ -use super::*; -use crate::cc::{AssignmentKind, ValueShape}; -use crate::types::{ValueDecl, ValueId, ValueType}; - -fn fixture() -> (Arc, Function) { - let (mut source, mut function) = super::tests::fixture(); - let logical = Arc::make_mut(&mut source); - let signature = logical.externals[0].signature.as_mut().unwrap(); - signature - .parameters - .splice(0..0, [ValueShape::Integer, ValueShape::Integer]); - let body = &mut logical.functions[0]; - body.parameters - .splice(0..0, [ValueId(4), ValueId(5), ValueId(6)]); - function.parameters = vec![ValueId(4), ValueId(5), ValueId(6)]; - for id in [6, 5, 4] { - body.values.insert( - 0, - crate::cc::ValueDecl { - id: ValueId(id), - ty: ValueShape::Integer, - }, - ); - function.values.insert( - 0, - ValueDecl { - id: ValueId(id), - ty: ValueType::I32, - }, - ); - } - for (index, prefix) in [(0, [ValueId(4), ValueId(5)]), (2, [ValueId(5), ValueId(6)])] { - let AssignmentKind::DirectCall { arguments, .. } = &mut body.assignments[index].kind else { - panic!("fixture must have a direct call"); - }; - arguments.splice(0..0, prefix); - let Instruction::Call { arguments, .. } = &mut function.blocks[0].instructions[index / 2] - else { - panic!("fixture must have a lowered call"); - }; - *arguments = prefix.to_vec(); - } - (source, function) -} - -#[test] -fn same_typed_operand_substitution_invalidates_the_dependency_certificate() { - let (source, mut function) = fixture(); - let certificate = DependencyFlow::checked(source, &function).unwrap(); - let Instruction::Call { arguments, .. } = &mut function.blocks[0].instructions[0] else { - panic!("fixture must have a lowered call"); - }; - arguments[0] = ValueId(6); - assert!(certificate.verify(&function).is_err()); -} - -#[test] -fn changed_operand_order_or_arity_invalidates_the_dependency_certificate() { - for change in 0..3 { - let (source, mut function) = fixture(); - let certificate = DependencyFlow::checked(source, &function).unwrap(); - let Instruction::Call { arguments, .. } = &mut function.blocks[0].instructions[1] else { - panic!("fixture must have a lowered call"); - }; - match change { - 0 => arguments.swap(0, 1), - 1 => { - arguments.pop(); - } - _ => arguments.push(ValueId(4)), - } - assert!(certificate.verify(&function).is_err(), "change {change}"); - } -} - -#[test] -fn indirect_calls_preserve_ordinary_operands_after_state_erasure() { - let (source, _) = fixture(); - let mut source = (*source).clone(); - let signature = source.externals[0].signature.clone().unwrap(); - source.externals.clear(); - let signature = source.representations.add_signature(signature); - let body = &mut source.functions[0]; - body.parameters.insert(3, ValueId(7)); - body.values.insert( - 3, - crate::cc::ValueDecl { - id: ValueId(7), - ty: ValueShape::Reference(crate::cc::Reference { - nullable: false, - heap: crate::cc::RefShape::Closure(signature), - }), - }, - ); - for index in [0, 2] { - let AssignmentKind::DirectCall { arguments, .. } = &body.assignments[index].kind else { - panic!("fixture must have a direct call"); - }; - body.assignments[index].kind = AssignmentKind::IndirectCall { - function: ValueId(7), - signature, - arguments: arguments.clone(), - }; - } - let (mut module, _) = super::tests::lower_without_tail_calls(source).unwrap(); - crate::mir::verify_module(&module).unwrap(); - let function = &mut module.functions[0]; - let certificate = function.state.clone().unwrap(); - let Instruction::ClosureCall { arguments, .. } = &mut function.blocks[0].instructions[0] else { - panic!("fixture must lower to a closure call"); - }; - arguments[0] = ValueId(6); - assert!(certificate.verify(function).is_err()); - assert!( - crate::mir::verify_module(&module) - .unwrap_err() - .iter() - .any(|error| error.message.contains("producer or operands")) - ); -} diff --git a/crates/psrs-backend/src/mir/state/projection.rs b/crates/psrs-backend/src/mir/state/projection.rs deleted file mode 100644 index 58557b2b..00000000 --- a/crates/psrs-backend/src/mir/state/projection.rs +++ /dev/null @@ -1,341 +0,0 @@ -//! P9's private instruction view: immutable logical CC remains the authority. -use super::*; -use crate::cc::{AssignmentKind as A, RefShape, Representation, ValueConversion, ValueShape}; -use std::collections::{HashMap, HashSet}; - -pub(in crate::mir) struct ProjectedInput { - pub physical: cc::Module, - pub logical: Arc, - pub inventory: Inventory, -} - -pub(in crate::mir) fn project( - module: cc::Module, - runtime: &[crate::RuntimeBinding], -) -> Result> { - let mut runtime_symbols = HashSet::new(); - for binding in runtime { - crate::bindings::checked_runtime_call(binding, &module)?; - runtime_symbols.insert(binding.symbol); - } - let logical = Arc::new(module); - let inventory = Inventory::checked(logical.clone())?; - let mut physical = (*logical).clone(); - let steps = logical - .representations - .representations - .iter() - .enumerate() - .filter_map(|(id, representation)| { - let Representation::Product { fields } = representation else { - return None; - }; - if !fields.contains(&ValueShape::State) { - return None; - } - let id = cc::ReprId(id as u32); - let result = ValueShape::Reference(cc::Reference { - nullable: false, - heap: RefShape::Repr(id), - }); - cc::state::StateResultProjection::checked(result, &logical.representations) - .ok() - .map(|plan| (id, plan)) - }) - .collect::>(); - let shape = |value: ValueShape| match value { - ValueShape::Reference(cc::Reference { - nullable: false, - heap: RefShape::Repr(id), - }) => steps.get(&id).map_or(value, |plan| plan.payload), - _ => value, - }; - let reachable = - crate::mir::reachable::ReachableHandles::from_module(&logical).map_err(|failure| { - vec![BackendError::new( - "P9 State projection", - logical.span, - failure.to_string(), - )] - })?; - // Project signatures in the logical inventory. Physical layout planning - // subsequently recomputes reachability from the projected module; unused - // logical Step entries need neither deletion nor representation reindexing. - for id in reachable.signatures { - let signature = &mut physical.representations.signatures[id.0 as usize]; - *signature = - cc::state::StateCallProjection::physical_signature(signature, &logical.representations) - .map_err(|message| { - vec![BackendError::new( - "P9 State projection", - logical.span, - message, - )] - })?; - } - // Reachability is computed over the logical module, so a state-stepping - // signature that only a projected-away Step referred to can survive - // without being reachable. Project every remaining one: a signature with a - // checked Step call has no physical State form to keep. - for index in 0..physical.representations.signatures.len() { - let signature = &mut physical.representations.signatures[index]; - if !signature.parameters.contains(&ValueShape::State) { - continue; - } - *signature = - cc::state::StateCallProjection::physical_signature(signature, &logical.representations) - .map_err(|message| { - vec![BackendError::new( - "P9 State projection", - logical.span, - message, - )] - })?; - } - // A checked captured callback retains ordinary parameters and returns the - // same Step payload as an explicit-parameter action. Inventory checks on - // its actual producer/body still precede physical layout planning. - for signature in &mut physical.representations.signatures { - signature.result = shape(signature.result); - } - // Only checked state-stepping declarations may enter private physical - // planning. A signature that projects to a checked Step call carries its - // own proof, so a host binding is admitted on the same terms as a runtime - // one. Actual raw calls still require result adaptation and MIR - // correspondence. - for external in &mut physical.externals { - let Some(signature) = external.signature.clone() else { - continue; - }; - if !signature.parameters.contains(&ValueShape::State) { - continue; - } - let step = cc::state::StateCallProjection::checked(&signature, &logical.representations) - .map_err(|message| { - vec![BackendError::invalid_ir( - "P9 runtime projection", - logical.span, - message, - )] - })?; - if step.is_none() && !runtime_symbols.contains(&external.symbol) { - return Err(vec![BackendError::new( - "P9 State projection", - logical.span, - "state-aware host invocation requires checked ABI projection", - )]); - } - external.signature = Some( - cc::state::StateCallProjection::physical_signature( - &signature, - &logical.representations, - ) - .map_err(|message| { - vec![BackendError::invalid_ir( - "P9 runtime projection", - logical.span, - message, - )] - })?, - ); - } - for function in &mut physical.functions { - let original = logical - .functions - .iter() - .find(|source| source.symbol == function.symbol) - .unwrap(); - let states = original - .values - .iter() - .filter(|value| value.ty == ValueShape::State) - .map(|value| value.id) - .collect::>(); - let has_step = original - .values - .iter() - .any(|value| shape(value.ty) != value.ty); - if has_step && !inventory.requires(function.symbol) { - return Err(error( - original, - "stored Step requires checked dependency transport", - )); - } - function.parameters.retain(|id| !states.contains(id)); - function.values.retain(|value| !states.contains(&value.id)); - for value in &mut function.values { - value.ty = shape(value.ty); - } - function.result_type = shape(function.result_type); - project_assignments( - &mut function.assignments, - original, - &states, - &steps, - &shape, - &logical.representations, - )?; - } - - Ok(ProjectedInput { - physical, - logical, - inventory, - }) -} - -fn error(function: &cc::Function, message: &str) -> Vec { - vec![ - BackendError::new("P9 State projection", function.span, message) - .with_module(function.symbol.module), - ] -} - -fn project_assignments( - input: &mut Vec, - original: &cc::Function, - states: &HashSet, - steps: &HashMap, - shape: &impl Fn(ValueShape) -> ValueShape, - table: &cc::RepresentationTable, -) -> Result<(), Vec> { - let capture_shapes = cc::state::capture_shapes(original)?; - let mut assignments = Vec::new(); - for mut assignment in std::mem::take(input) { - // A zero-width result does not make the control or its calls erasable. - // Keep choices for CFG lowering, while removing their physical slots. - if states.contains(&assignment.destination) - && !matches!(assignment.kind, A::If { .. } | A::TagSwitch { .. }) - { - continue; - } - let copy = match &mut assignment.kind { - A::FunctionRef { captures, .. } => { - captures.retain(|id| !states.contains(id)); - None - } - A::ClosureGetCapture { index, .. } => { - let slot = *index as usize; - if slot >= capture_shapes.len() { - return Err(error( - original, - "capture projection has no checked logical slot", - )); - } - *index = capture_shapes[..slot] - .iter() - .filter(|shape| **shape != ValueShape::State) - .count() as u32; - None - } - A::ProductNew { - representation, - arguments, - .. - } => steps - .get(representation) - .map(|plan| (arguments[plan.payload_field], plan.payload)), - A::ProductGet { - representation, - value, - field, - .. - } => { - if let Some(plan) = steps.get(representation) { - if *field as usize != plan.payload_field { - return Err(error( - original, - "State field has an unexpected physical destination", - )); - } - Some((*value, plan.payload)) - } else { - None - } - } - A::StateExecution { - function, - signature, - .. - } => { - assignment.kind = A::IndirectCall { - function: *function, - signature: *signature, - arguments: Vec::new(), - }; - None - } - A::DirectCall { arguments, .. } | A::IndirectCall { arguments, .. } => { - arguments.retain(|id| !states.contains(id)); - None - } - A::AggregateConvert { conversion, .. } => { - let source = shape(conversion.source); - let destination = shape(conversion.destination); - if source != conversion.source || destination != conversion.destination { - *conversion = - cc::state::StateCallProjection::payload_conversion(conversion, table) - .map_err(|message| error(original, message))?; - } - conversion.source = source; - conversion.destination = destination; - None - } - A::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - project_assignments( - &mut case.assignments, - original, - states, - steps, - shape, - table, - )?; - } - project_assignments(default_assignments, original, states, steps, shape, table)?; - None - } - A::If { - then_assignments, - else_assignments, - .. - } => { - project_assignments(then_assignments, original, states, steps, shape, table)?; - project_assignments(else_assignments, original, states, steps, shape, table)?; - None - } - _ => None, - }; - if let A::AggregateConvert { - value, conversion, .. - } = &assignment.kind - && let ValueConversion::FunctionAdapter { function, .. } = conversion.plan - { - // The checked factory signature already owns this conversion. - // Keep the source destination as the call result, rather than an - // unanchored helper temporary followed by a copy. - assignment.kind = A::DirectCall { - function, - arguments: vec![*value], - }; - } - if let Some((value, payload)) = copy { - assignment.kind = A::AggregateConvert { - destination: assignment.destination, - value, - conversion: cc::AggregateConvert { - source: payload, - destination: payload, - plan: ValueConversion::Identity, - }, - }; - } - assignments.push(assignment); - } - *input = assignments; - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/state/runtime.rs b/crates/psrs-backend/src/mir/state/runtime.rs deleted file mode 100644 index 775f3085..00000000 --- a/crates/psrs-backend/src/mir/state/runtime.rs +++ /dev/null @@ -1,122 +0,0 @@ -//! Immutable source anchors and actual block ranges for raw ABI adaptation. -use super::*; -use crate::mir::{BlockId, Module, runtime::RawInvocation}; -use crate::types::ValueDecl; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(in crate::mir) struct RuntimeInvocation { - plan: RawInvocation, - block: BlockId, - start: usize, - length: usize, - temporaries: Vec, -} - -impl RuntimeInvocation { - pub(in crate::mir) fn new( - plan: RawInvocation, - block: BlockId, - start: usize, - length: usize, - temporaries: Vec, - ) -> Self { - Self { - plan, - block, - start, - length, - temporaries, - } - } - - pub(in crate::mir) fn destination(&self) -> cc::ValueId { - self.plan.destination() - } - - pub(super) fn never_returns(&self) -> bool { - self.plan.never_returns() - } - - pub(super) fn verify_call( - &self, - source: &cc::Function, - assignment: &cc::Assignment, - function: &Function, - block: BlockId, - call_index: usize, - ) -> Result<(), Vec> { - if block != self.block || !self.plan.matches_source(source.symbol, assignment) { - return Err(error( - function, - "runtime invocation loses its source or control-block anchor", - )); - } - self.plan.verify_source_values(function)?; - let actual = function - .blocks - .iter() - .find(|actual| actual.id == block) - .ok_or_else(|| error(function, "runtime invocation has no actual block"))?; - let end = self - .start - .checked_add(self.length) - .ok_or_else(|| error(function, "runtime invocation range overflows"))?; - let instructions = actual.instructions.get(self.start..end).ok_or_else(|| { - error( - function, - "runtime invocation has no complete instruction range", - ) - })?; - if instructions - .iter() - .position(|instruction| { - matches!( - instruction, - Instruction::Call { .. } | Instruction::CallVoid { .. } - ) - }) - .map(|offset| self.start + offset) - != Some(call_index) - { - return Err(error( - function, - "runtime invocation moves across source calls", - )); - } - if self.never_returns() - && (end != actual.instructions.len() - || !matches!(actual.terminator, Some(crate::mir::Terminator::Trap { .. }))) - { - return Err(error( - function, - "non-returning invocation has a physical continuation", - )); - } - for expected in &self.temporaries { - if !function.values.iter().any(|value| value == expected) { - return Err(error( - function, - "runtime invocation changes a checked temporary type", - )); - } - } - self.plan.verify(&self.temporaries, instructions) - } - - pub(super) fn verify_import(&self, module: &Module) -> Result<(), Vec> { - let expected = self.plan.import(); - if module - .imports - .iter() - .find(|import| import.symbol == expected.symbol) - != Some(expected) - { - return Err(vec![BackendError::invalid_ir( - "P9 MIR dependency verification", - module.span, - "runtime invocation import differs from its immutable checked binding", - )]); - } - Ok(()) - } -} diff --git a/crates/psrs-backend/src/mir/state/source.rs b/crates/psrs-backend/src/mir/state/source.rs deleted file mode 100644 index 8b362e4c..00000000 --- a/crates/psrs-backend/src/mir/state/source.rs +++ /dev/null @@ -1,104 +0,0 @@ -//! One immutable dependency authority per logical CC module. Physical function -//! verification consumes its checked summaries without deriving the entire -//! frozen module again for each body or optimizer checkpoint. -use super::*; -use psrs_hir::SymbolId; -use std::collections::HashMap; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(in crate::mir) struct SourceFlow { - pub graph: Graph, - pub executions: Vec, -} - -#[derive(Debug, PartialEq, Eq)] -pub(in crate::mir) struct CheckedSource { - pub module: Arc, - positions: HashMap, - flows: HashMap, -} - -impl CheckedSource { - pub(in crate::mir) fn checked(module: Arc) -> Result, Vec> { - let derived = cc::state::derive_all(&module)?; - if !derived.is_empty() { - // Publish State summaries only with ordinary CC typing/scope - // validation. An empty source retains the existing pure-module - // inventory contract and publishes no additional typing claims. - cc::state::check(&module)?; - } - let flows = derived - .iter() - .map(|flow| { - ( - flow.function.symbol, - SourceFlow { - graph: flow.graph.clone(), - executions: flow - .executions - .iter() - .map(|run| run.graph.clone()) - .collect(), - }, - ) - }) - .collect(); - let positions = module - .functions - .iter() - .enumerate() - .map(|(id, body)| (body.symbol, id)) - .collect(); - Ok(Arc::new(Self { - module, - positions, - flows, - })) - } - - pub(in crate::mir) fn required(&self) -> impl Iterator + '_ { - self.flows.keys().copied() - } - - pub(in crate::mir) fn flow(&self, symbol: SymbolId) -> Option<&SourceFlow> { - self.flows.get(&symbol) - } - - pub(in crate::mir) fn function(&self, symbol: SymbolId) -> Option<&cc::Function> { - self.positions - .get(&symbol) - .map(|id| &self.module.functions[*id]) - } -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn frozen_source_keeps_its_calls_when_a_source_copy_changes() { - let (mut source, physical) = crate::mir::state::tests::fixture(); - let checked = CheckedSource::checked(source.clone()).unwrap(); - let original = DependencyFlow::checked_with_runtime( - checked.clone(), - &physical, - Vec::new(), - Vec::new(), - ) - .unwrap(); - let changed = Arc::make_mut(&mut source); - let replacement = psrs_hir::SymbolId::new(psrs_hir::ModuleId(0), 2); - let mut external = changed.externals[0].clone(); - external.symbol = replacement; - changed.externals.push(external); - let cc::AssignmentKind::DirectCall { function, .. } = - &mut changed.functions[0].assignments[0].kind - else { - panic!("fixture has an observable call"); - }; - *function = replacement; - assert!(!Arc::ptr_eq(&checked.module, &source)); - original.verify(&physical).unwrap(); - assert!(DependencyFlow::checked(source, &physical).is_err()); - } -} diff --git a/crates/psrs-backend/src/mir/state/switch_tests.rs b/crates/psrs-backend/src/mir/state/switch_tests.rs deleted file mode 100644 index e2da37ef..00000000 --- a/crates/psrs-backend/src/mir/state/switch_tests.rs +++ /dev/null @@ -1,339 +0,0 @@ -use crate::cc::{self, Assignment, AssignmentKind as A, TagCase, ValueDecl, ValueId, ValueShape}; -use crate::mir::{BlockId, Terminator}; -use psrs_hir::{ModuleId, SymbolId}; - -fn source(tag: i32) -> cc::Module { - let mut source = super::branch_tests::source(true); - let span = source.span; - let mut default = source.functions[1].clone(); - default.symbol = SymbolId::new(ModuleId(0), 8); - default.assignments[0].kind = A::Constant(44); - source.functions.push(default); - let function = &mut source.functions[0]; - function - .values - .iter_mut() - .find(|value| value.id == ValueId(4)) - .unwrap() - .ty = ValueShape::Integer; - function.values.push(ValueDecl { - id: ValueId(7), - ty: function.result_type, - }); - function.assignments[0].kind = A::Constant(tag); - let call = |id, symbol| Assignment { - destination: ValueId(id), - kind: A::DirectCall { - function: SymbolId::new(ModuleId(0), symbol), - arguments: vec![ValueId(0)], - }, - span, - }; - function.assignments[1].kind = A::TagSwitch { - value: ValueId(4), - cases: vec![ - TagCase { - tag: 7, - assignments: vec![call(1, 1)], - value: ValueId(1), - }, - TagCase { - tag: -3, - assignments: vec![call(5, 6)], - value: ValueId(5), - }, - ], - default_assignments: vec![call(7, 8)], - default_value: ValueId(7), - }; - source -} - -#[test] -fn multiway_state_projection_checks_labels_default_edges_and_invocation_placement() { - let (module, _) = super::tests::lower_without_tail_calls(source(7)).unwrap(); - crate::mir::verify_module(&module).unwrap(); - assert_eq!(module.functions[0].blocks.len(), 5); - for mutation in 0..6 { - let mut changed = module.clone(); - if mutation < 4 { - let Some(Terminator::Switch { - value, - cases, - default, - .. - }) = &mut changed.functions[0].blocks[0].terminator - else { - panic!() - }; - match mutation { - 0 => cases[0].0 = 9, - 1 => cases[0].1 = BlockId(2), - 2 => *default = BlockId(1), - _ => *value = ValueId(3), - } - } else if mutation == 4 { - let call = changed.functions[0].blocks[1].instructions.remove(0); - changed.functions[0].blocks[2].instructions.insert(0, call); - } else { - let Some(Terminator::Jump { arguments, .. }) = - &mut changed.functions[0].blocks[1].terminator - else { - panic!() - }; - arguments[0] = ValueId(4); - } - let errors = crate::mir::verify_module(&changed).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 MIR dependency verification"), - "{mutation}: {errors:?}" - ); - } -} - -#[test] -fn nested_binary_choice_in_a_state_switch_preserves_both_join_payloads() { - let mut source = source(7); - let function = &mut source.functions[0]; - let span = function.span; - function.values.extend([ - ValueDecl { - id: ValueId(8), - ty: ValueShape::Boolean, - }, - ValueDecl { - id: ValueId(10), - ty: function.result_type, - }, - ValueDecl { - id: ValueId(11), - ty: function.result_type, - }, - ]); - let A::TagSwitch { cases, .. } = &mut function.assignments[1].kind else { - panic!() - }; - let call = |id, symbol| Assignment { - destination: ValueId(id), - kind: A::DirectCall { - function: SymbolId::new(ModuleId(0), symbol), - arguments: vec![ValueId(0)], - }, - span, - }; - cases[0].assignments = vec![ - Assignment { - destination: ValueId(8), - kind: A::Constant(1), - span, - }, - Assignment { - destination: ValueId(1), - kind: A::If { - condition: ValueId(8), - then_assignments: vec![call(10, 1)], - then_value: ValueId(10), - else_assignments: vec![call(11, 6)], - else_value: ValueId(11), - }, - span, - }, - ]; - let (module, _) = super::tests::lower_without_tail_calls(source).unwrap(); - assert_eq!(module.functions[0].blocks.len(), 8); - crate::mir::verify_module(&module).unwrap(); - let mut changed = module; - let Some(Terminator::Jump { arguments, .. }) = &mut changed.functions[0].blocks[7].terminator - else { - panic!() - }; - arguments[0] = ValueId(4); - assert!( - crate::mir::verify_module(&changed) - .unwrap_err() - .iter() - .any(|error| error.pass == "P9 MIR dependency verification") - ); -} - -#[test] -fn state_switch_executes_case_default_and_selected_trap_after_optimization() { - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - } - for trapping in [false, true] { - for (tag, expected) in [(7, 42), (-3, 43), (99, 44)] { - let target = crate::TargetCapabilities::default(); - let mut source = source(tag); - if trapping { - let A::TagSwitch { cases, .. } = &mut source.functions[0].assignments[1].kind - else { - panic!() - }; - cases[0].assignments[0].kind = A::Unreachable; - } - let (module, mut wasi) = super::tests::lower_without_tail_calls(source).unwrap(); - let module = crate::mir::opt::optimize(module, target).unwrap(); - let context = crate::linking::default_context().unwrap(); - let link = - crate::linking::plan_for_module(&context, &module, &mut wasi, target).unwrap(); - let wasm = - crate::wasm::lower_module_with_plan(&module, &mut wasi, target, &link).unwrap(); - let core = crate::wasm::encode_module(&wasm).unwrap(); - let component = crate::linking::compose(&link, &core, module.span, None).unwrap(); - let path = std::env::temp_dir().join(format!( - "psrs-state-switch-{}-{tag}-{trapping}.wasm", - std::process::id() - )); - std::fs::write(&path, component).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - std::fs::remove_file(path).unwrap(); - if trapping && tag == 7 { - assert!(!output.status.success()); - assert!(String::from_utf8_lossy(&output.stderr).contains("unreachable")); - } else { - assert_eq!(output.status.code(), Some(expected), "{output:?}"); - } - } - } -} - -#[test] -fn constant_payload_joins_keep_their_source_parameters_during_optimization() { - let mut source = source(7); - let function = &mut source.functions[0]; - let span = function.span; - let arms = |destination, payload| { - vec![ - Assignment { - destination: ValueId(payload), - kind: A::Constant(42), - span, - }, - Assignment { - destination: ValueId(destination), - kind: A::ProductNew { - destination: ValueId(destination), - representation: cc::ReprId(0), - arguments: vec![ValueId(0), ValueId(payload)], - }, - span, - }, - ] - }; - for payload in [10, 11, 12] { - function.values.push(ValueDecl { - id: ValueId(payload), - ty: ValueShape::Integer, - }); - } - let A::TagSwitch { - cases, - default_assignments, - .. - } = &mut function.assignments[1].kind - else { - panic!() - }; - cases[0].assignments = arms(1, 10); - cases[1].assignments = arms(5, 11); - *default_assignments = arms(7, 12); - let (module, _) = super::tests::lower_without_tail_calls(source).unwrap(); - let optimized = - crate::mir::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); - assert_eq!(optimized.functions[0].blocks[4].parameters, [ValueId(3)]); - crate::mir::verify_module(&optimized).unwrap(); -} - -#[test] -fn raw_state_switch_results_keep_control_and_erase_only_join_slots() { - let mut source = source(7); - let function = &mut source.functions[0]; - let span = function.span; - function.values.extend((10..=13).map(|id| ValueDecl { - id: ValueId(id), - ty: ValueShape::State, - })); - let choice = &mut function.assignments[1]; - choice.destination = ValueId(13); - let A::TagSwitch { - cases, - default_assignments, - default_value, - .. - } = &mut choice.kind - else { - panic!() - }; - let projection = |destination, value| Assignment { - destination: ValueId(destination), - kind: A::ProductGet { - destination: ValueId(destination), - representation: cc::ReprId(0), - field: 0, - value: ValueId(value), - }, - span, - }; - for (index, case) in cases.iter_mut().enumerate() { - let state = 10 + index as u32; - case.assignments.push(projection(state, case.value.0)); - case.value = ValueId(state); - } - default_assignments.push(projection(12, default_value.0)); - *default_value = ValueId(12); - function.assignments.push(Assignment { - destination: ValueId(3), - kind: A::DirectCall { - function: SymbolId::new(ModuleId(0), 1), - arguments: vec![ValueId(13)], - }, - span, - }); - cc::state::check(&source).unwrap(); - let (module, _) = super::tests::lower_without_tail_calls(source).unwrap(); - let function = &module.functions[0]; - assert!(function.blocks[4].parameters.is_empty()); - for id in [1, 2, 3] { - let Some(Terminator::Jump { arguments, .. }) = &function.blocks[id].terminator else { - panic!("choice arm lost its jump"); - }; - assert!(arguments.is_empty()); - } - crate::mir::verify_module(&module).unwrap(); - let mut changed = module.clone(); - changed.functions[0].values.push(crate::types::ValueDecl { - id: ValueId(14), - ty: crate::types::ValueType::I32, - }); - changed.functions[0].blocks[4].parameters.push(ValueId(14)); - for (block, value) in [(1, 1), (2, 5), (3, 7)] { - let Some(Terminator::Jump { arguments, .. }) = - &mut changed.functions[0].blocks[block].terminator - else { - panic!(); - }; - arguments.push(ValueId(value)); - } - let errors = crate::mir::verify_module(&changed).unwrap_err(); - assert!( - errors - .iter() - .all(|error| error.pass == "P9 MIR dependency verification"), - "{errors:?}" - ); -} diff --git a/crates/psrs-backend/src/mir/state/tail.rs b/crates/psrs-backend/src/mir/state/tail.rs deleted file mode 100644 index 347f24a6..00000000 --- a/crates/psrs-backend/src/mir/state/tail.rs +++ /dev/null @@ -1,102 +0,0 @@ -//! Tail conversion preserves the checked physical predecessor through the -//! common tail rewrite. Actual MIR must implement that exact conversion; -//! source correspondence is still checked against the immutable predecessor. -use super::*; -use crate::TargetCapabilities; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(super) struct TailTransfer { - source: Arc, - target: TargetCapabilities, -} - -impl DependencyFlow { - pub(in crate::mir) fn project_tail( - &self, - function: &Function, - target: TargetCapabilities, - ) -> Result<(Function, Self), Vec> { - self.verify(function)?; - if self.tail.is_some() { - return Err(error( - function, - "tail dependency transfer is already projected", - )); - } - let mut source = function.clone(); - source.state = None; - let mut transformed = source.clone(); - crate::mir::lower::tail::rewrite(&mut transformed, target)?; - let mut flow = self.clone(); - if transformed != source { - flow.tail = Some(TailTransfer { - source: Arc::new(source), - target, - }); - } - flow.verify(&transformed)?; - Ok((transformed, flow)) - } -} - -impl TailTransfer { - pub(super) fn source(&self) -> &Function { - &self.source - } - - pub(super) fn verify(&self, function: &Function) -> Result<(), Vec> { - let mut expected = (*self.source).clone(); - crate::mir::lower::tail::rewrite(&mut expected, self.target)?; - let mut actual = function.clone(); - actual.state = None; - // FunctionId is the compacted module position, not semantic identity. - // Source inventories and calls remain anchored to the stable SymbolId. - expected.id = actual.id; - // P10 already permits proven scalar folding in State functions. Use - // that same operation to compare instructions, without admitting any - // call, operand, capture, block-parameter or control-flow change. - crate::mir::opt::constants::fold_scalar_instructions(&mut expected); - crate::mir::opt::constants::fold_scalar_instructions(&mut actual); - if actual != expected { - return Err(error( - function, - "MIR tail conversion changes checked dependency instructions or control flow", - )); - } - Ok(()) - } -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn checked_tail_transfer_rejects_a_changed_call_target() { - let (source, function) = crate::mir::state::tests::fixture(); - let flow = DependencyFlow::checked(source, &function).unwrap(); - let (mut projected, flow) = flow - .project_tail(&function, TargetCapabilities::default()) - .unwrap(); - let Some(crate::mir::Terminator::ReturnCall { - function: target, .. - }) = &mut projected.blocks[0].terminator - else { - panic!("the checked terminal call must become a tail call"); - }; - *target = projected.symbol; - assert!(flow.verify(&projected).is_err()); - } - - #[test] - fn checked_tail_transfer_preserves_the_preceding_observable_call() { - let (source, function) = crate::mir::state::tests::fixture(); - let flow = DependencyFlow::checked(source, &function).unwrap(); - let (mut projected, flow) = flow - .project_tail(&function, TargetCapabilities::default()) - .unwrap(); - flow.verify(&projected).unwrap(); - projected.blocks[0].instructions.clear(); - assert!(flow.verify(&projected).is_err()); - } -} diff --git a/crates/psrs-backend/src/mir/state/tests.rs b/crates/psrs-backend/src/mir/state/tests.rs deleted file mode 100644 index 234d8cb9..00000000 --- a/crates/psrs-backend/src/mir/state/tests.rs +++ /dev/null @@ -1,419 +0,0 @@ -use super::*; -use crate::cc::{Assignment, AssignmentKind, ReprId, Representation, Signature, ValueShape}; -use crate::mir::{BasicBlock, BlockId, Function, Terminator}; -use crate::types::{FunctionId, ValueDecl, ValueId, ValueType}; -use psrs_hir::{ModuleId, SymbolId}; -use psrs_span::TextRange; - -pub(super) fn fixture() -> (Arc, Function) { - let span = TextRange::new(0, 1); - let owner = SymbolId::new(ModuleId(0), 0); - let callee = SymbolId::new(ModuleId(0), 1); - let step = ValueShape::Reference(cc::Reference { - nullable: false, - heap: cc::RefShape::Repr(ReprId(0)), - }); - let mut representations = cc::RepresentationTable::default(); - representations - .representations - .push(Representation::Product { - fields: vec![ValueShape::State, ValueShape::Integer], - }); - let source = cc::Module { - name: "DependencyProjection".into(), - representations, - externals: vec![cc::External { - symbol: callee, - signature: Some(Signature { - parameters: vec![ValueShape::State], - result: step, - }), - projection: None, - }], - functions: vec![cc::Function { - symbol: owner, - name: "action".into(), - parameters: vec![ValueId(0)], - values: [ValueShape::State, step, ValueShape::State, step] - .into_iter() - .enumerate() - .map(|(id, ty)| cc::ValueDecl { - id: ValueId(id as u32), - ty, - }) - .collect(), - assignments: vec![ - Assignment { - destination: ValueId(1), - kind: AssignmentKind::DirectCall { - function: callee, - arguments: vec![ValueId(0)], - }, - span, - }, - Assignment { - destination: ValueId(2), - kind: AssignmentKind::ProductGet { - destination: ValueId(2), - representation: ReprId(0), - field: 0, - value: ValueId(1), - }, - span, - }, - Assignment { - destination: ValueId(3), - kind: AssignmentKind::DirectCall { - function: callee, - arguments: vec![ValueId(2)], - }, - span, - }, - ], - result: ValueId(3), - result_type: step, - span, - }], - entry: Some(owner), - span, - }; - let function = Function { - state: None, - id: FunctionId(0), - symbol: owner, - name: "action".into(), - parameters: Vec::new(), - values: vec![ - ValueDecl { - id: ValueId(1), - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(3), - ty: ValueType::I32, - }, - ], - entry: BlockId(0), - blocks: vec![BasicBlock { - id: BlockId(0), - parameters: Vec::new(), - instructions: vec![ - Instruction::Call { - destination: ValueId(1), - function: callee, - arguments: Vec::new(), - span, - }, - Instruction::Call { - destination: ValueId(3), - function: callee, - arguments: Vec::new(), - span, - }, - ], - terminator: Some(Terminator::Return { - value: ValueId(3), - span, - }), - }], - result: ValueId(3), - result_type: ValueType::I32, - span, - }; - (Arc::new(source), function) -} - -#[test] -fn checked_projection_retains_zero_width_dependencies_at_actual_calls() { - let (source, function) = fixture(); - let flow = DependencyFlow::checked(source, &function).unwrap(); - assert_eq!(flow.graph().blocks[0].transitions.len(), 2); - assert!(function.parameters.is_empty()); - assert_eq!(function.values.len(), 2); - flow.verify(&function).unwrap(); -} - -#[test] -fn source_certificate_cannot_replace_instruction_correspondence() { - let (source, mut function) = fixture(); - let flow = DependencyFlow::checked(source, &function).unwrap(); - function.blocks[0].instructions.swap(0, 1); - assert!(flow.verify(&function).is_err()); - function.blocks[0].instructions.pop(); - assert!(flow.verify(&function).is_err()); -} - -#[test] -fn changing_call_producer_or_normal_successor_rejects() { - let (source, mut function) = fixture(); - let flow = DependencyFlow::checked(source, &function).unwrap(); - let original = function.blocks[0].instructions[0].clone(); - function.blocks[0].instructions[0] = Instruction::Constant { - destination: ValueId(1), - value: 0, - span: function.span, - }; - assert!(flow.verify(&function).is_err()); - function.blocks[0].instructions[0] = original; - function.blocks[0].terminator = None; - assert!(flow.verify(&function).is_err()); -} - -fn physical_module(source: Arc, mut function: Function) -> super::super::Module { - function.state = Some(DependencyFlow::checked(source.clone(), &function).unwrap()); - super::super::Module { - name: "DependencyProjection".into(), - types: Vec::new(), - strings: Vec::new(), - imports: vec![super::super::Import { - runtime: None, - symbol: SymbolId::new(ModuleId(0), 1), - parameters: Vec::new(), - result: Some(ValueType::I32), - }], - entry: Some(function.symbol), - span: function.span, - functions: vec![function], - dependencies: Inventory::checked(source).unwrap(), - layout: None, - } -} - -#[test] -fn mir_verifier_rejects_extra_invocations_against_the_source_body() { - let (source, function) = fixture(); - let mut module = physical_module(source, function); - super::super::verify_module(&module).unwrap(); - let first = module.functions[0].blocks[0].instructions[0].clone(); - module.functions[0].blocks[0].instructions.insert(0, first); - let failures = super::super::verify_module(&module).unwrap_err(); - assert!( - failures - .iter() - .any(|failure| failure.message.contains("adds or loses an invocation")) - ); -} - -#[test] -fn dependency_evidence_from_another_source_cannot_replace_the_required_witness() { - let (source, function) = fixture(); - let mut other = (*source).clone(); - other.name = "OtherSource".into(); - let replacement = DependencyFlow::checked(Arc::new(other), &function).unwrap(); - let mut module = physical_module(source, function); - module.functions[0].state = Some(replacement); - let errors = super::super::verify_module(&module).unwrap_err(); - assert!( - errors - .iter() - .any(|error| { error.message.contains("different source inventory") }) - ); -} - -#[test] -fn pruning_an_unused_dependency_function_preserves_requirements_for_live_functions() { - let (source, function) = fixture(); - let mut source = (*source).clone(); - let mut unused_source = source.functions[0].clone(); - unused_source.symbol = SymbolId::new(ModuleId(0), 2); - source.functions.push(unused_source); - let source = Arc::new(source); - let mut unused = function.clone(); - unused.id = FunctionId(1); - unused.symbol = source.functions[1].symbol; - unused.state = Some(DependencyFlow::checked(source.clone(), &unused).unwrap()); - let mut module = physical_module(source, function); - module.functions.push(unused); - let mut optimized = - super::super::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); - assert_eq!(optimized.functions.len(), 1); - super::super::verify_module(&optimized).unwrap(); - optimized.functions[0].state = None; - let errors = super::super::verify_module(&optimized).unwrap_err(); - assert!(errors.iter().any(|error| { - error - .message - .contains("missing required dependency evidence") - })); -} - -#[test] -fn optimization_retains_an_invocation_with_an_unused_physical_payload() { - let (source, function) = fixture(); - let module = physical_module(source, function); - let optimized = - super::super::opt::optimize(module, crate::TargetCapabilities::default()).unwrap(); - assert_eq!(optimized.functions[0].blocks[0].instructions.len(), 2); - assert_eq!( - optimized.functions[0] - .state - .as_ref() - .unwrap() - .graph() - .blocks[0] - .transitions - .len(), - 2 - ); - super::super::verify_module(&optimized).unwrap(); -} - -#[test] -fn logical_state_cannot_be_reintroduced_as_a_physical_zero() { - let (source, mut function) = fixture(); - let flow = DependencyFlow::checked(source, &function).unwrap(); - function.values.push(ValueDecl { - id: ValueId(0), - ty: ValueType::I32, - }); - function.blocks[0].instructions.insert( - 0, - Instruction::Constant { - destination: ValueId(0), - value: 0, - span: function.span, - }, - ); - assert!(flow.verify(&function).unwrap_err().iter().any(|failure| { - failure - .message - .contains("materializes a logical State slot") - })); -} - -#[test] -fn trapping_source_requires_an_actual_trap_without_a_normal_successor() { - let (mut source, mut function) = fixture(); - Arc::make_mut(&mut source).functions[0].assignments[2].kind = AssignmentKind::Unreachable; - function.blocks[0].instructions[1] = Instruction::Unreachable { - destination: ValueId(3), - span: function.span, - }; - function.blocks[0].terminator = Some(Terminator::Trap { - span: function.span, - }); - let flow = DependencyFlow::checked(source, &function).unwrap(); - function.blocks[0].instructions.pop(); - assert!(flow.verify(&function).is_err()); -} - -#[test] -fn ordinary_state_calls_lower_and_execute_with_only_physical_payloads() { - let (source, _) = fixture(); - let mut source = (*source).clone(); - source.externals.clear(); - let span = source.span; - let step = source.functions[0].result_type; - source.functions.push(cc::Function { - symbol: SymbolId::new(ModuleId(0), 1), - name: "produce".into(), - parameters: vec![ValueId(0)], - values: vec![ - cc::ValueDecl { - id: ValueId(0), - ty: ValueShape::State, - }, - cc::ValueDecl { - id: ValueId(1), - ty: ValueShape::Integer, - }, - cc::ValueDecl { - id: ValueId(2), - ty: step, - }, - ], - assignments: vec![ - Assignment { - destination: ValueId(1), - kind: AssignmentKind::Constant(42), - span, - }, - Assignment { - destination: ValueId(2), - kind: AssignmentKind::ProductNew { - destination: ValueId(2), - representation: ReprId(0), - arguments: vec![ValueId(0), ValueId(1)], - }, - span, - }, - ], - result: ValueId(2), - result_type: step, - span, - }); - let target = crate::TargetCapabilities::default(); - let (mir, mut wasi) = super::super::lower_module(source).unwrap(); - assert!(mir.functions.iter().all(|function| function.state.is_some() - && function.parameters.is_empty() - && function.result_type == ValueType::I32)); - let mir = super::super::opt::optimize(mir, target).unwrap(); - assert_eq!( - mir.functions[0].blocks[0] - .instructions - .iter() - .filter(|instruction| matches!(instruction, Instruction::Call { .. })) - .count() - + usize::from(matches!( - mir.functions[0].blocks[0].terminator, - Some(Terminator::ReturnCall { .. }) - )), - 2 - ); - assert!( - !mir.functions - .iter() - .flat_map(|function| &function.blocks) - .flat_map(|block| &block.instructions) - .any(|instruction| matches!(instruction, Instruction::StructNew { .. })) - ); - let context = crate::linking::default_context().unwrap(); - let link = crate::linking::plan_for_module(&context, &mir, &mut wasi, target).unwrap(); - let wasm = crate::wasm::lower_module_with_plan(&mir, &mut wasi, target, &link).unwrap(); - let core = crate::wasm::encode_module(&wasm).unwrap(); - crate::validator_for(target).validate_all(&core).unwrap(); - let component = crate::linking::compose(&link, &core, span, None).unwrap(); - crate::validator_for(target) - .validate_all(&component) - .unwrap(); - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - } - let path = - std::env::temp_dir().join(format!("psrs-state-projection-{}.wasm", std::process::id())); - std::fs::write(&path, component).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - std::fs::remove_file(path).unwrap(); - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -// These projection fixtures exercise the pre-tail correspondence contract. -// Tail conversion and mutation rejection have separate coverage in tail.rs. -pub(super) fn lower_without_tail_calls( - source: cc::Module, -) -> Result<(crate::mir::Module, crate::abi::WasiRegistry), Vec> { - crate::mir::lower_module_with_capabilities( - source, - crate::TargetCapabilities { - tail_call: false, - ..Default::default() - }, - ) -} diff --git a/crates/psrs-backend/src/mir/tests/lowering.rs b/crates/psrs-backend/src/mir/tests/lowering.rs index c9d74303..b51f83a0 100644 --- a/crates/psrs-backend/src/mir/tests/lowering.rs +++ b/crates/psrs-backend/src/mir/tests/lowering.rs @@ -22,11 +22,9 @@ fn defined_types_flow_into_the_wasm_type_section() { }]), }])], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), @@ -73,11 +71,9 @@ fn lowers_and_validates_f64_to_f32_abi_conversions() { entry: Some(symbol), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol, name: "main".into(), @@ -164,7 +160,6 @@ fn lowers_an_imported_call() { entry: Some(SymbolId::new(ModuleId(0), 0)), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: vec![Import { runtime: None, @@ -173,7 +168,6 @@ fn lowers_an_imported_call() { result: import.result, }], functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), @@ -226,11 +220,9 @@ fn wasm_lowering_requires_an_explicit_entry_symbol() { entry: None, types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), diff --git a/crates/psrs-backend/src/mir/tests/runtime.rs b/crates/psrs-backend/src/mir/tests/runtime.rs index 7f09eff0..39711cec 100644 --- a/crates/psrs-backend/src/mir/tests/runtime.rs +++ b/crates/psrs-backend/src/mir/tests/runtime.rs @@ -34,11 +34,9 @@ fn runs_a_mir_gc_struct_under_wasmtime() { entry: Some(SymbolId::new(ModuleId(0), 0)), types: vec![RecGroup(vec![struct_type])], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), diff --git a/crates/psrs-backend/src/mir/tests/verify.rs b/crates/psrs-backend/src/mir/tests/verify.rs index 8d6c7860..6ce8c572 100644 --- a/crates/psrs-backend/src/mir/tests/verify.rs +++ b/crates/psrs-backend/src/mir/tests/verify.rs @@ -22,11 +22,9 @@ fn rejects_a_struct_new_with_a_mistyped_field() { }]), }])], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "main".into(), diff --git a/crates/psrs-backend/src/mir/verify/array_map/tests.rs b/crates/psrs-backend/src/mir/verify/array_map/tests.rs index 510b1fe4..63bbd711 100644 --- a/crates/psrs-backend/src/mir/verify/array_map/tests.rs +++ b/crates/psrs-backend/src/mir/verify/array_map/tests.rs @@ -28,7 +28,6 @@ fn verified_array_map_module(mut function: Function) -> crate::mir::Module { }]), ], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(function.symbol), @@ -59,7 +58,6 @@ fn array_map_function() -> Function { }; Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "array_map_verifier_test".into(), diff --git a/crates/psrs-backend/src/mir/verify/capability.rs b/crates/psrs-backend/src/mir/verify/capability.rs index 6b214d63..e48c3602 100644 --- a/crates/psrs-backend/src/mir/verify/capability.rs +++ b/crates/psrs-backend/src/mir/verify/capability.rs @@ -201,7 +201,6 @@ mod tests { composite: CompositeType::Struct(Vec::new()), }])], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), @@ -361,7 +360,6 @@ mod tests { }, }])], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), @@ -376,11 +374,9 @@ mod tests { name: "capability-instruction-test".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![mir::Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(4), 0), name: "capability".into(), @@ -459,11 +455,9 @@ mod tests { name: "capability-tail-test".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![mir::Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(4), 0), name: "tail".into(), diff --git a/crates/psrs-backend/src/mir/verify/instruction/lists.rs b/crates/psrs-backend/src/mir/verify/instruction/lists.rs index 56c444af..1c940412 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/lists.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/lists.rs @@ -123,7 +123,6 @@ fn element_storage_matches(element: &CanonicalType, storage: &StorageType) -> bo /// Whether the struct field storage can hold a product field shape. fn field_storage_matches(shape: ValueShape, storage: &StorageType) -> bool { match shape { - ValueShape::State => false, ValueShape::Integer | ValueShape::Boolean => *storage == StorageType::I32, ValueShape::Number => *storage == StorageType::F64, ValueShape::String | ValueShape::Reference(_) => matches!(storage, StorageType::Ref(_)), diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index 4a25a472..24e26823 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -32,9 +32,6 @@ struct Signature { pub fn verify_module(module: &Module) -> Result<(), Vec> { let mut errors = Vec::new(); verify_defined_types(module, &mut errors); - if let Err(failures) = module.dependencies.verify(module) { - errors.extend(failures); - } let mut signatures = module .functions .iter() @@ -70,16 +67,6 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { let defined = defined_types_list(module); let mut function_ids = HashSet::new(); for (position, function) in module.functions.iter().enumerate() { - if let Some(state) = &function.state - && let Err(failures) = state.verify(function) - { - errors.extend(failures); - } - if let Some(state) = &function.state - && let Err(failures) = state.verify_imports(module) - { - errors.extend(failures); - } if !function_ids.insert(function.id) || function.id != FunctionId(position as u32) { errors.extend(mir_error( function.span, diff --git a/crates/psrs-backend/src/mir/verify/tests/arrays.rs b/crates/psrs-backend/src/mir/verify/tests/arrays.rs index 0db44ba9..306ce3ff 100644 --- a/crates/psrs-backend/src/mir/verify/tests/arrays.rs +++ b/crates/psrs-backend/src/mir/verify/tests/arrays.rs @@ -12,7 +12,6 @@ fn array_conversion_function( heap: HeapType::Index(DefinedTypeId(0)), }); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "array_default".into(), @@ -222,7 +221,6 @@ fn clone_function(element_storage: crate::types::StorageType) -> (Function, Vec< heap: HeapType::Index(DefinedTypeId(0)), }); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "array_clone".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/dictionary.rs b/crates/psrs-backend/src/mir/verify/tests/dictionary.rs index 9e53497b..a9560262 100644 --- a/crates/psrs-backend/src/mir/verify/tests/dictionary.rs +++ b/crates/psrs-backend/src/mir/verify/tests/dictionary.rs @@ -73,7 +73,6 @@ fn return_function( result_type: ValueType, ) -> Function { Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: name.into(), @@ -213,7 +212,6 @@ fn rejects_dictionary_struct_get_with_wrong_result_type() { fn method_function() -> Function { let result = ValueId(0); Function { - state: None, id: FunctionId(1), symbol: SymbolId::new(ModuleId(0), 1), name: "method".into(), @@ -275,7 +273,6 @@ fn rejects_a_non_dominating_dictionary_projection() { let dictionary = ValueId(3); let projected = ValueId(4); let function = Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "non_dominating_projection".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/dominance.rs b/crates/psrs-backend/src/mir/verify/tests/dominance.rs index af9d6482..a8bb0a14 100644 --- a/crates/psrs-backend/src/mir/verify/tests/dominance.rs +++ b/crates/psrs-backend/src/mir/verify/tests/dominance.rs @@ -17,7 +17,6 @@ fn module_with(function: Function) -> Module { name: "DominanceTest".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(function.symbol), @@ -28,7 +27,6 @@ fn module_with(function: Function) -> Module { fn function(values: Vec, blocks: Vec) -> Function { Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "dominance".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/effects.rs b/crates/psrs-backend/src/mir/verify/tests/effects.rs index 12c8e534..51fd911e 100644 --- a/crates/psrs-backend/src/mir/verify/tests/effects.rs +++ b/crates/psrs-backend/src/mir/verify/tests/effects.rs @@ -76,7 +76,6 @@ fn effect_closure_call( values: Vec, ) -> Function { Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "effect_closure_call".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/gaps.rs b/crates/psrs-backend/src/mir/verify/tests/gaps.rs index e3ee1d85..7972272b 100644 --- a/crates/psrs-backend/src/mir/verify/tests/gaps.rs +++ b/crates/psrs-backend/src/mir/verify/tests/gaps.rs @@ -57,7 +57,6 @@ fn rejects_ref_cast_between_unrelated_heaps() { results: Vec::new(), }); let function = Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_cast".into(), @@ -107,7 +106,6 @@ fn accepts_an_erased_upcast_to_eqref() { let output = ValueId(1); let struct_type = final_type(CompositeType::Struct(Vec::new())); let function = Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "erased_upcast".into(), @@ -174,7 +172,6 @@ fn closure_callee() -> Function { let closure = ValueId(0); let argument = ValueId(1); Function { - state: None, id: FunctionId(1), symbol: SymbolId::new(ModuleId(0), 1), name: "callee".into(), @@ -202,7 +199,6 @@ fn rejects_a_closure_capture_outside_the_eq_hierarchy() { let closure = ValueId(1); let mut module = custom_module( Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_capture".into(), @@ -285,7 +281,6 @@ fn helper_function(blocks: Vec, values: Vec) -> Function let input = ValueId(0); let output = ValueId(1); Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "aggregate_convert_0".into(), @@ -374,7 +369,6 @@ fn get_capture_function(destination_type: ValueType) -> Function { let closure = ValueId(0); let destination = ValueId(1); Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "capture_projection".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/mod.rs b/crates/psrs-backend/src/mir/verify/tests/mod.rs index e3c0fc18..ed88bf2c 100644 --- a/crates/psrs-backend/src/mir/verify/tests/mod.rs +++ b/crates/psrs-backend/src/mir/verify/tests/mod.rs @@ -14,7 +14,6 @@ fn module_with_function(function: Function, types: Vec) -> Module { name: "VerifierTest".into(), types, strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(function.symbol), @@ -26,7 +25,6 @@ fn module_with_function(function: Function, types: Vec) -> Module { #[test] fn rejects_constants_with_incompatible_result_types() { let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_constant".into(), @@ -67,7 +65,6 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { let input = ValueId(0); let output = ValueId(1); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_unary".into(), @@ -130,7 +127,6 @@ fn rejects_a_unary_primitive_with_mistyped_operands() { fn rejects_duplicate_switch_case_values() { let selector = ValueId(0); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "duplicate_switch_cases".into(), @@ -187,7 +183,6 @@ fn rejects_duplicate_switch_case_values() { #[test] fn rejects_values_used_before_definition() { let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_order".into(), @@ -250,7 +245,6 @@ fn rejects_ref_func_with_a_different_target_signature() { }; let callee = SymbolId::new(ModuleId(0), 1); let callee_function = Function { - state: None, id: crate::types::FunctionId(1), symbol: callee, name: "callee".into(), @@ -282,7 +276,6 @@ fn rejects_ref_func_with_a_different_target_signature() { heap: crate::types::HeapType::Index(crate::types::DefinedTypeId(0)), }); let caller = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "caller".into(), @@ -324,7 +317,6 @@ fn rejects_ref_func_with_a_different_target_signature() { #[test] fn rejects_a_load_from_an_unknown_memory_id() { let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_memory".into(), @@ -393,7 +385,6 @@ fn rejects_a_branch_target_with_block_parameters() { let then_parameter = ValueId(2); let merge_parameter = ValueId(3); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_branch_target".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/scalar.rs b/crates/psrs-backend/src/mir/verify/tests/scalar.rs index 242e55ff..9ad3c180 100644 --- a/crates/psrs-backend/src/mir/verify/tests/scalar.rs +++ b/crates/psrs-backend/src/mir/verify/tests/scalar.rs @@ -10,7 +10,6 @@ fn primitive_function( let right = ValueId(1); let output = ValueId(2); Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_primitive".into(), @@ -111,7 +110,6 @@ fn rejects_an_integer_comparison_that_produces_i32() { fn rejects_a_boolean_constant_that_is_not_canonical() { let output = ValueId(0); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "bad_boolean_constant".into(), @@ -151,7 +149,6 @@ fn rejects_a_boolean_constant_that_is_not_canonical() { fn rejects_a_call_with_the_wrong_argument_type() { let callee_symbol = SymbolId::new(ModuleId(0), 1); let helper = Function { - state: None, id: crate::types::FunctionId(1), symbol: callee_symbol, name: "__psrs_euclidean_int_div".into(), @@ -183,7 +180,6 @@ fn rejects_a_call_with_the_wrong_argument_type() { let argument = ValueId(0); let call_result = ValueId(1); let caller = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "caller".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/structure.rs b/crates/psrs-backend/src/mir/verify/tests/structure.rs index a67079bd..0eb9715a 100644 --- a/crates/psrs-backend/src/mir/verify/tests/structure.rs +++ b/crates/psrs-backend/src/mir/verify/tests/structure.rs @@ -5,7 +5,6 @@ use super::*; fn simple_function(values: Vec, blocks: Vec) -> Function { Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "structure".into(), @@ -154,7 +153,6 @@ fn recursive_references_are_scoped_to_their_declared_group() { name: "recursive_group_scope".into(), types: vec![RecGroup(vec![definition(1), definition(0)])], strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), diff --git a/crates/psrs-backend/src/mir/verify/tests/subtype.rs b/crates/psrs-backend/src/mir/verify/tests/subtype.rs index fb97fdbc..25795a48 100644 --- a/crates/psrs-backend/src/mir/verify/tests/subtype.rs +++ b/crates/psrs-backend/src/mir/verify/tests/subtype.rs @@ -17,7 +17,6 @@ fn module_with(types: Vec) -> Module { name: "SubtypeTest".into(), types, strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: Vec::new(), diff --git a/crates/psrs-backend/src/mir/verify/tests/switch.rs b/crates/psrs-backend/src/mir/verify/tests/switch.rs index 527d032e..e1c09804 100644 --- a/crates/psrs-backend/src/mir/verify/tests/switch.rs +++ b/crates/psrs-backend/src/mir/verify/tests/switch.rs @@ -7,7 +7,6 @@ use psrs_hir::{ModuleId, SymbolId}; fn rejects_a_switch_with_a_non_i32_selector() { let selector = ValueId(0); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "non_i32_switch_selector".into(), @@ -61,7 +60,6 @@ fn rejects_a_projection_that_is_not_dominated_by_its_tag_test() { let projected = ValueId(1); let result = ValueId(2); let function = Function { - state: None, id: crate::types::FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "nondominating_projection".into(), diff --git a/crates/psrs-backend/src/mir/verify/tests/tail.rs b/crates/psrs-backend/src/mir/verify/tests/tail.rs index 05ec9138..92415d51 100644 --- a/crates/psrs-backend/src/mir/verify/tests/tail.rs +++ b/crates/psrs-backend/src/mir/verify/tests/tail.rs @@ -20,7 +20,6 @@ fn module_with(caller: Function, callee: Function) -> Module { name: "TailVerifierTest".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), entry: Some(caller.symbol), @@ -34,7 +33,6 @@ fn callee(parameters: Vec, result_type: ValueType) -> Function { let result = parameter.id; let parameter_ty = parameter.ty; return Function { - state: None, id: FunctionId(1), symbol: symbol(1), name: "callee".into(), @@ -69,7 +67,6 @@ fn callee(parameters: Vec, result_type: ValueType) -> Function { }, }; Function { - state: None, id: FunctionId(1), symbol: symbol(1), name: "callee".into(), @@ -101,7 +98,6 @@ fn caller( terminator: Terminator, ) -> Function { Function { - state: None, id: FunctionId(0), symbol: symbol(0), name: "caller".into(), diff --git a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs index 578555fc..a40f1824 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs @@ -244,7 +244,6 @@ fn read_value_concrete( span: TextRange, ) -> Result> { match shape { - ValueShape::State => Err(unsupported(span)), ValueShape::Integer | ValueShape::Boolean => { read_scalar(lowerer, kind, address, offset, block, span) } diff --git a/crates/psrs-backend/src/mir/wit/aggregate/mod.rs b/crates/psrs-backend/src/mir/wit/aggregate/mod.rs index 410ad549..492178a2 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/mod.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/mod.rs @@ -339,7 +339,6 @@ pub(super) fn recover_payload( } let recovered = match &concrete { crate::cc::GuestLayout::Scalar { shape } => match shape { - ValueShape::State => return Err(unsupported(span)), ValueShape::Integer => unbox_scalar(lowerer, value, false, block, span)?, ValueShape::Boolean => unbox_scalar(lowerer, value, true, block, span)?, ValueShape::Number => unbox_number(lowerer, value, block, span)?, diff --git a/crates/psrs-backend/src/mir/wit/parameters/primitive.rs b/crates/psrs-backend/src/mir/wit/parameters/primitive.rs index b0a1b000..40296aa5 100644 --- a/crates/psrs-backend/src/mir/wit/parameters/primitive.rs +++ b/crates/psrs-backend/src/mir/wit/parameters/primitive.rs @@ -51,7 +51,6 @@ fn slot_type( .copied() .ok_or_else(|| unsupported_parameter(span))?; let ty = match shape { - ValueShape::State => return Err(unsupported_parameter(span)), ValueShape::Integer => match leaf { FlatLeaf::Int32 => CanonicalType::Int { width: 32, diff --git a/crates/psrs-backend/src/mir/wit/plan.rs b/crates/psrs-backend/src/mir/wit/plan.rs index 249bee7b..5fc766bc 100644 --- a/crates/psrs-backend/src/mir/wit/plan.rs +++ b/crates/psrs-backend/src/mir/wit/plan.rs @@ -1,7 +1,7 @@ //! Immutable canonical adapter plans, produced before physical emission. use crate::BackendError; use crate::cc; -use crate::mir::{BasicBlock, BlockId, BoundWasiImport, Function}; +use crate::mir::{BasicBlock, BlockId, Function}; use crate::types::ValueDecl; use psrs_hir::SymbolId; @@ -9,7 +9,6 @@ use psrs_hir::SymbolId; pub(in crate::mir) struct CallPlan { owner: SymbolId, source: cc::Assignment, - binding: BoundWasiImport, start: usize, exit: BlockId, blocks: Vec, @@ -17,84 +16,10 @@ pub(in crate::mir) struct CallPlan { } impl CallPlan { - pub(in crate::mir) fn entry(&self) -> BlockId { - self.blocks[0].id - } - pub(in crate::mir) fn start(&self) -> usize { - self.start - } - pub(in crate::mir) fn exit(&self) -> (BlockId, usize) { - let block = self - .blocks - .iter() - .find(|block| block.id == self.exit) - .expect("canonical lowering returns its own exit block"); - ( - self.exit, - if self.exit == self.entry() { - self.start - } else { - 0 - } + block.instructions.len(), - ) - } - pub(in crate::mir) fn created_blocks(&self) -> impl Iterator + '_ { - self.blocks.iter().skip(1).map(|block| block.id) - } - pub(in crate::mir) fn matches_source( - &self, - assignment: &cc::Assignment, - arguments: &[cc::ValueId], - ) -> bool { - match (&self.source.kind, &assignment.kind) { - ( - cc::AssignmentKind::DirectCall { - function, - arguments: planned, - }, - cc::AssignmentKind::DirectCall { - function: actual, .. - }, - ) => { - function == actual - && planned == arguments - && self.source.destination == assignment.destination - && self.source.span == assignment.span - } - _ => false, - } - } - - pub(in crate::mir) fn verify_import( - &self, - module: &crate::mir::Module, - ) -> Result<(), Vec> { - let import = &self.binding.import; - let expected = crate::mir::Import { - runtime: None, - symbol: import.symbol, - parameters: import.parameters.clone(), - result: import.result, - }; - if module - .imports - .iter() - .find(|actual| actual.symbol == expected.symbol) - != Some(&expected) - { - return Err(vec![BackendError::invalid_ir( - "P9 canonical call verification", - self.source.span, - "canonical import differs from its immutable checked binding", - )]); - } - Ok(()) - } #[allow(clippy::too_many_arguments)] pub(in crate::mir) fn new( owner: SymbolId, source: cc::Assignment, - binding: BoundWasiImport, start: usize, exit: BlockId, blocks: Vec, @@ -103,7 +28,6 @@ impl CallPlan { Self { owner, source, - binding, start, exit, blocks, diff --git a/crates/psrs-backend/src/mir/wit/tests/handles.rs b/crates/psrs-backend/src/mir/wit/tests/handles.rs index b41bbd91..9d84ba19 100644 --- a/crates/psrs-backend/src/mir/wit/tests/handles.rs +++ b/crates/psrs-backend/src/mir/wit/tests/handles.rs @@ -117,7 +117,6 @@ fn an_owned_result_is_not_dropped_by_the_compiler() { fn function_calling(instructions: Vec) -> Function { Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "use-handle".into(), diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs index c9242911..07238722 100644 --- a/crates/psrs-backend/src/pipeline/mod.rs +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -7,13 +7,12 @@ use crate::{ annotate_errors, }; -use crate::{cc, effects, mir}; +use crate::{cc, mir}; mod emission; pub(crate) fn compile_with_context_inner( module: psrs_core::Module, - effect_context: Option, target: TargetCapabilities, mut capture: Option<&mut PartialStages>, mut trace: Option<&mut TraceRecorder>, @@ -35,7 +34,7 @@ pub(crate) fn compile_with_context_inner( target_parameter(), ) }); - let mut module = match psrs_core::opt::optimize(module, psrs_core::opt::Budget::default()) { + let module = match psrs_core::opt::optimize(module, psrs_core::opt::Budget::default()) { Ok(module) => module, Err(errors) => { if let (Some(trace), Some(call)) = (trace.as_deref_mut(), core_call) { @@ -80,8 +79,8 @@ pub(crate) fn compile_with_context_inner( Vec::new(), ) }); - let mut external_bindings = crate::ExternalBindings::from_core(&module); - let mut binding_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), binding_call) { + let external_bindings = crate::ExternalBindings::from_core(&module); + let binding_id = if let (Some(trace), Some(call)) = (trace.as_deref_mut(), binding_call) { trace .complete(call, &[TraceRepresentation::ExternalBindings], &[]) .first() @@ -90,54 +89,6 @@ pub(crate) fn compile_with_context_inner( None }; - let mut effect_source = None; - let mut effect_registry = crate::boundary::RepresentationRegistry::new(); - if let Some(context) = effect_context.as_ref() { - let effect_call = trace.as_deref_mut().map(|trace| { - trace.begin( - "backend.effect.lower", - &[ - core_id.expect("traced optimized Core"), - binding_id.expect("traced external bindings"), - ], - TraceValidationCoverage::Composite, - vec![TraceParameter { - key: "effect_context", - value: "present".into(), - }], - ) - }); - let prepared = match effects::lower_effects(&mut module, &mut external_bindings, context) { - Ok(prepared) => prepared, - Err(errors) => { - if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { - trace.reject(call, errors.len()); - } - return Err(errors); - } - }; - effect_registry = prepared.registry; - effect_source = Some(prepared.source); - if let (Some(trace), Some(call)) = (trace.as_deref_mut(), effect_call) { - let outputs = trace.complete( - call, - &[ - TraceRepresentation::Core, - TraceRepresentation::ExternalBindings, - ], - &[TraceValidationSpec::outputs( - "psrs_backend::effects::lower_effects", - &[0, 1], - TraceValidationCoverage::Composite, - )], - ); - core_id = outputs.first().copied(); - binding_id = outputs.get(1).copied(); - } - } else if let Some(trace) = trace.as_deref_mut() { - trace.not_applicable("backend.effect.lower", "no effect context supplied"); - } - let conformance_call = trace.as_deref_mut().map(|trace| { trace.begin( "backend.external_bindings.validate_conformance", @@ -189,8 +140,8 @@ pub(crate) fn compile_with_context_inner( let lowered_cc = match cc::lower_module_with_relations( module, external_bindings, - effect_source.as_ref(), - effect_registry, + None, + crate::boundary::RepresentationRegistry::new(), ) { Ok(lowered) => lowered, Err(errors) => { @@ -359,7 +310,6 @@ pub(crate) fn compile_with_context_inner( Ok(Stages { core: optimized_core, - effect_context, cc, mir, wasm: emitted.module, @@ -373,7 +323,6 @@ pub(crate) fn compile_with_context_inner( pub(crate) fn compile_with_context_traced( module: psrs_core::Module, - effect_context: Option, target: TargetCapabilities, capture_partial: bool, ) -> (Result, CompileTrace) { @@ -381,7 +330,6 @@ pub(crate) fn compile_with_context_traced( let mut partial = PartialStages::default(); let result = compile_with_context_inner( module, - effect_context, target, capture_partial.then_some(&mut partial), Some(&mut trace), diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 88506cf5..817b7a4e 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -28,9 +28,6 @@ pub(crate) enum Implementation { Generated(GeneratedOperation), Artifact(&'static ArtifactImplementation), Elaborated, - /// Source contracts are checked, but dependency/signature projection is - /// required before a boundary or a GC runtime call can be emitted. - StateExecutionBoundary, Unsupported, } @@ -120,7 +117,6 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Intrinsic::BoolTrue | Intrinsic::BoolFalse | Intrinsic::Unit | Intrinsic::Coerce => { Elaborated } - Intrinsic::RunWorld | Intrinsic::RunRegion => StateExecutionBoundary, Intrinsic::Undefined => Unsupported, } } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 85f4b10d..92e45e3d 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -19,11 +19,6 @@ fn every_active_identity_has_an_explicit_implementation() { ); } Implementation::Unsupported => assert_eq!(intrinsic, Intrinsic::Undefined), - Implementation::StateExecutionBoundary => { - assert!(intrinsic.state_operation().is_some()); - assert!(intrinsic.descriptor().effects.may_trap); - assert!(intrinsic.descriptor().effects.may_write); - } Implementation::Generated(_) | Implementation::Elaborated => {} } } diff --git a/crates/psrs-backend/src/trace.rs b/crates/psrs-backend/src/trace.rs index b5fb4fbe..33d5d509 100644 --- a/crates/psrs-backend/src/trace.rs +++ b/crates/psrs-backend/src/trace.rs @@ -349,29 +349,6 @@ impl TraceRecorder { self.reject(call, diagnostic_count); } - pub(crate) fn not_applicable(&mut self, pass_key: &'static str, reason: &'static str) { - let call = self.begin( - pass_key, - &[], - TraceValidationCoverage::NotObserved, - vec![TraceParameter { - key: "reason", - value: reason.into(), - }], - ); - self.trace.executions.push(TraceExecution { - id: call.id, - pass_key: call.pass_key, - contract_version: 1, - inputs: Vec::new(), - outputs: Vec::new(), - status: TracePassStatus::NotApplicable, - diagnostic_indices: Vec::new(), - validation_coverage: call.validation_coverage, - parameters: call.parameters, - }); - } - #[cfg(test)] fn validations(&self) -> &[TraceValidation] { &self.trace.validations diff --git a/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs b/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs index d96f941a..4fd089c3 100644 --- a/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs +++ b/crates/psrs-backend/src/wasm/lower/extent/tests/mod.rs @@ -27,7 +27,6 @@ fn function( .expect("result value has a declaration") .ty; Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "extent_test".into(), @@ -46,7 +45,6 @@ fn module(function: Function) -> Module { name: "ExtentTest".into(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![function], diff --git a/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs b/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs index 0e1f745a..fc585ef6 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/irreducible_dispatch_tests.rs @@ -35,7 +35,6 @@ fn lower_and_validate(source: &Function) -> (WasmFunction, Vec) { name: source.name.clone(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![source.clone()], @@ -138,7 +137,6 @@ fn irreducible_function() -> Function { let first_branch_span = TextRange::new(10, 12); let second_branch_span = TextRange::new(20, 22); Function { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: "irreducible_dispatch".into(), @@ -339,7 +337,6 @@ fn structures_and_executes_irreducible_cfg_with_block_parameters_and_sparse_swit name: function.name.clone(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![function.clone()], diff --git a/crates/psrs-backend/src/wasm/lower/structure/tests.rs b/crates/psrs-backend/src/wasm/lower/structure/tests.rs index 4c6a273a..5384617a 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/tests.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/tests.rs @@ -20,7 +20,6 @@ pub(super) fn lower_and_validate(source: &MirFunction) -> (Function, Vec) { name: source.name.clone(), types: Vec::new(), strings: Vec::new(), - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![source.clone()], @@ -112,7 +111,6 @@ pub(super) fn function( result: ValueId, ) -> MirFunction { MirFunction { - state: None, id: FunctionId(0), symbol: SymbolId::new(ModuleId(0), 0), name: name.into(), diff --git a/crates/psrs-backend/src/wasm/tests.rs b/crates/psrs-backend/src/wasm/tests.rs index f671a039..c8448c9d 100644 --- a/crates/psrs-backend/src/wasm/tests.rs +++ b/crates/psrs-backend/src/wasm/tests.rs @@ -334,11 +334,9 @@ fn interns_repeated_string_literals_in_one_lazy_global() { }), }])], strings: vec!["twice".into()], - dependencies: Default::default(), layout: None, imports: Vec::new(), functions: vec![MirFunction { - state: None, id: FunctionId(0), symbol, name: "main".into(), diff --git a/crates/psrs-cli/tests/command_runner.rs b/crates/psrs-cli/tests/command_runner.rs index 7902d904..8936a795 100644 --- a/crates/psrs-cli/tests/command_runner.rs +++ b/crates/psrs-cli/tests/command_runner.rs @@ -3,9 +3,10 @@ use std::path::PathBuf; use std::process::{Command, Output}; use std::sync::atomic::{AtomicUsize, Ordering}; -const TYPES: &str = "module Types where\nimport Prim.State (State, RealWorld)\ntype Step s a = { state :: State s, value :: a }\nnewtype Job a = Job (State RealWorld -> Step RealWorld a)\n"; -const RUNNER: &str = "module Runner where\nimport Prim.State (State, RealWorld)\nimport Types (Job(..), Step)\nforeign import \"psrs:intrinsic#runWorld\" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a\nrun :: Job Int -> Int\nrun (Job action) = execute action\n"; -const MAIN: &str = "module Main where\nimport Types (Job(..))\nmain :: Job Int\nmain = Job (\\state -> { state: state, value: 42 })\n"; +const TYPES: &str = "module Types where\nnewtype Job a = Job (Unit -> a)\n"; +const RUNNER: &str = "module Runner where\nimport Types (Job(..))\nrun :: Job Int -> Int\nrun (Job action) = action unit\n"; +const MAIN: &str = + "module Main where\nimport Types (Job(..))\nmain :: Job Int\nmain = Job (\\_ -> 42)\n"; struct Package(PathBuf); @@ -148,20 +149,20 @@ fn reports_and_diagnosis_retain_the_configured_runner() { } #[test] -fn configured_source_runner_executes_an_unrelated_state_newtype() { +fn configured_source_runner_executes_an_unrelated_newtype() { let package = Package::new(); fs::write( package.0.join("lib/Prelude.purs"), - "module Prelude where\nforeign import data Effect :: Type -> Type\n", + "module Prelude where\nforeign import data Unrelated :: Type -> Type\n", ) .unwrap(); fs::write( package.0.join("Main.purs"), - MAIN.replace("import Types", "import Prelude (Effect)\nimport Types"), + MAIN.replace("import Types", "import Prelude (Unrelated)\nimport Types"), ) .unwrap(); // Main neither imports Runner nor calls it: configuration must retain it. - // An unrelated opaque Effect declaration must not activate legacy checks. + // An unrelated opaque declaration must not activate any special handling. package.execute(42); fs::write( package.0.join("Main.purs"), diff --git a/crates/psrs-core/src/effect/mod.rs b/crates/psrs-core/src/effect/mod.rs deleted file mode 100644 index 5fb6fcfc..00000000 --- a/crates/psrs-core/src/effect/mod.rs +++ /dev/null @@ -1,328 +0,0 @@ -//! Representation lowering for the library effect type. -//! -//! `Effect τ` stays an abstract application through type checking and Typed -//! Core. This pass is the only one that matches that type's identity. It -//! replaces each application with a closure whose parameter list is the -//! runtime token, it supplies bodies for `pure`, `bind`, and `runEffect`, and -//! it records every closure it wrote so the shape can be verified before any -//! later pass sees it. - -mod operations; -mod supplies; - -use crate::{Module, Type, TypeConstructor, TypeId, VerifyError, closure_parts}; -use psrs_hir::{LocalId, ModuleId, SymbolId, TypeId as HirTypeId}; -use std::collections::HashSet; - -use operations::synthesize_operations; -use supplies::LocalSupply; - -const EFFECT_INTERFACE: &str = "psrs:effect"; - -/// The resolved identity of the trusted effect library interface. The driver -/// creates this only from its trusted library prefix and carries it to P8. -/// Consumers must not reconstruct trust from qualified names or opacity. -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct TrustedEffect { - pub effect_type: HirTypeId, - pub operations: Vec, -} - -/// A source command entry that the frontend has checked to have type -/// `Effect Unit`. P8 wraps it after lowering the abstract effect type. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct EffectCommandEntry { - pub symbol: SymbolId, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct EffectCompilation { - pub trusted: TrustedEffect, - pub command_entry: Option, -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct EffectOperationBinding { - pub operation: EffectOperation, - pub symbol: SymbolId, -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum EffectOperation { - Pure, - Bind, - Run, - Trap, -} - -impl EffectOperation { - pub fn wit_function(self) -> &'static str { - match self { - Self::Pure => "pure", - Self::Bind => "bind", - Self::Run => "run", - Self::Trap => "trap", - } - } -} - -/// An import signature classified while its result still names the abstract -/// trusted Effect constructor. -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct EffectImportType { - pub quantified: Vec, - pub parameters: Vec, - pub application: TypeId, - pub payload: TypeId, -} - -/// One representation closure written for an `Effect` application. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct EffectClosure { - /// The closure type node the lowering wrote. - pub ty: TypeId, - /// The runtime token the closure must take as its only parameter. - pub token: TypeId, - /// The lowered result of the `Effect` application the closure replaced. - pub result: TypeId, -} - -/// Symbols whose abstract `psrs:effect` imports became ordinary declarations. -#[derive(Clone, Debug, Default)] -pub struct EffectLowering { - pub synthesized: Vec, - /// The representation closures written for `Effect` applications. - pub closures: Vec, -} - -impl EffectLowering { - /// Rejects a representation closure whose parameter list is not - /// `[token]`, or whose result is not the lowered effect result. - /// - /// No later pass recognizes `Effect`, so this Core check is the only place - /// that can reject such a closure. It runs over the closures this lowering - /// wrote, before closure conversion and before any encoding. - pub fn verify(&self, module: &Module) -> Result<(), Vec> { - let mut errors = Vec::new(); - for closure in &self.closures { - let Some((parameters, result)) = closure_parts(&module.types, closure.ty) else { - errors.push(verification_error( - module, - "a lowered effect application is not a closure", - )); - continue; - }; - if parameters.len() != 1 || parameters[0] != closure.token { - errors.push(verification_error( - module, - "a lowered effect closure must take only the runtime token", - )); - } - if result != closure.result { - errors.push(verification_error( - module, - "a lowered effect closure must return the lowered effect result", - )); - } - } - if errors.is_empty() { - Ok(()) - } else { - Err(errors) - } - } -} - -/// Lowers library effects in a linked Core module. -/// -/// Programs that do not contain the opaque `Prelude.Effect` type are unchanged. -pub fn lower_effects( - module: &mut Module, - trusted: &TrustedEffect, -) -> Result> { - let effect = trusted.effect_type; - if !module.opaque_ids.contains(&effect) { - return Err(vec![verification_error( - module, - "trusted Effect identity is missing or is not an opaque type", - )]); - } - match module.callable_parameters(effect) { - Some(1) => {} - Some(_) => { - return Err(vec![verification_error( - module, - "trusted Effect type has an incompatible callable representation", - )]); - } - None => module.callable_types.push((effect, 1)), - } - let token = state_token_type(module); - let closures = rewrite_effect_applications(module, effect, token); - let synthesized = synthesize_operations(module, token, trusted)?; - let lowering = EffectLowering { - synthesized, - closures, - }; - lowering.verify(module)?; - Ok(lowering) -} - -/// Classifies a WIT source signature by its abstract result type. The returned -/// structure is evidence for a later wrapper; no closure shape is inspected. -pub fn classify_effect_import( - module: &Module, - ty: TypeId, - effect: HirTypeId, -) -> Result, &'static str> { - let mut current = ty; - let mut quantified = Vec::new(); - let mut parameters = Vec::new(); - let mut visited = HashSet::new(); - loop { - if !visited.insert(current) { - return Err("cyclic type spine in effect import signature"); - } - let Some(node) = module.types.get(current.0 as usize) else { - return Err("effect import signature references an invalid type id"); - }; - if let Type::ForAll { variables, body } = node { - quantified.extend_from_slice(variables); - current = *body; - continue; - } - if let Type::Application(function, argument) = node - && (module.types.get(function.0 as usize).is_none() - || module.types.get(argument.0 as usize).is_none()) - { - return Err("effect import signature contains an invalid application spine"); - } - if let Some((function, payload)) = effect_application(module, current, effect) { - return Ok(Some(EffectImportType { - quantified, - parameters, - application: function, - payload, - })); - } - let Some((parameter, result)) = crate::arrow_parts(&module.types, current) else { - return Ok(None); - }; - if module.types.get(parameter.0 as usize).is_none() - || module.types.get(result.0 as usize).is_none() - { - return Err("effect import signature contains an invalid function spine"); - } - parameters.push(parameter); - current = result; - } -} - -pub fn effect_application( - module: &Module, - id: TypeId, - effect: HirTypeId, -) -> Option<(TypeId, TypeId)> { - let Type::Application(function, payload) = module.types.get(id.0 as usize)? else { - return None; - }; - is_effect_constructor(module, *function, effect).then_some((id, *payload)) -} - -/// Writes `Type::Closure` over each `Effect` application and records the shape -/// each written closure must keep. -fn rewrite_effect_applications( - module: &mut Module, - effect: HirTypeId, - token: TypeId, -) -> Vec { - let targets = module - .types - .iter() - .enumerate() - .filter_map(|(index, ty)| { - let Type::Application(function, argument) = ty else { - return None; - }; - is_effect_constructor(module, *function, effect).then_some((index, *argument)) - }) - .collect::>(); - let mut closures = Vec::with_capacity(targets.len()); - for (index, result) in targets { - module.types[index] = Type::Closure { - parameters: vec![token], - result, - }; - closures.push(EffectClosure { - ty: TypeId(index as u32), - token, - result, - }); - } - closures -} - -fn is_effect_constructor(module: &Module, id: TypeId, effect: HirTypeId) -> bool { - matches!( - module.types.get(id.0 as usize), - Some(Type::Constructor(TypeConstructor::User(id))) if *id == effect - ) -} - -/// Interns the compiler-owned opaque state token an `Effect` closure takes. -/// It has no source spelling; marking it opaque gives it a scalar runtime shape -/// without letting any pass treat it as an `Int` -/// ([effects](../../../design/backend/fp/effects.md)). -fn state_token_type(module: &mut Module) -> TypeId { - let token = psrs_hir::TypeId::STATE_TOKEN; - if !module.opaque_ids.contains(&token) { - module.opaque_ids.push(token); - } - intern(module, Type::Constructor(TypeConstructor::User(token))) -} - -fn verification_error(module: &Module, message: &'static str) -> VerifyError { - VerifyError { - module: module.id, - span: module.span, - message, - } -} - -fn intern(module: &mut Module, ty: Type) -> TypeId { - if let Some(index) = module.types.iter().position(|existing| existing == &ty) { - return TypeId(index as u32); - } - module.types.push(ty); - TypeId((module.types.len() - 1) as u32) -} - -/// Builds `parameters -> result` in the module type table. -pub fn function_type(module: &mut Module, parameters: &[TypeId], result: TypeId) -> TypeId { - let mut ty = result; - for parameter in parameters.iter().rev() { - ty = operations::arrow(module, *parameter, ty); - } - ty -} - -/// The next foreign-symbol index above the symbols already in the module. -pub fn fresh_foreign_symbol(module: &Module) -> SymbolId { - let mut next = psrs_hir::FOREIGN_SYMBOL_BASE; - for external in &module.externals { - if external.symbol.module == ModuleId::INTRINSICS { - next = next.max(external.symbol.index.saturating_add(1)); - } - } - for declaration in &module.declarations { - if declaration.symbol.module == ModuleId::INTRINSICS { - next = next.max(declaration.symbol.index.saturating_add(1)); - } - } - SymbolId::new(ModuleId::INTRINSICS, next) -} - -/// A fresh local id above every binder already in the module. -pub fn fresh_local(module: &Module) -> LocalId { - LocalSupply::new(module).fresh() -} diff --git a/crates/psrs-core/src/effect/operations.rs b/crates/psrs-core/src/effect/operations.rs deleted file mode 100644 index d3e805f3..00000000 --- a/crates/psrs-core/src/effect/operations.rs +++ /dev/null @@ -1,341 +0,0 @@ -//! Ordinary declarations for the abstract `psrs:effect` operations. -//! -//! `lower_effects` replaces the library's opaque imports with the values the -//! design specifies: `pure` returns a closure over the token, `bind` runs the -//! first effect before the continuation, `run` applies the closure to the -//! runtime state token, and `trap` is the effect that escapes instead of -//! returning. - -use super::supplies::{LocalSupply, VariableSupply}; -use super::{EFFECT_INTERFACE, TrustedEffect, intern}; -use crate::{Binder, Declaration, Expr, ExprKind, Module, Type, TypeConstructor, TypeId}; -use psrs_hir::{ExternalKind, LocalId, SymbolId, TypeVariableId}; -use psrs_span::TextRange; - -/// Synthesizes `pure`, `bind`, `run`, and `trap`, dropping the abstract imports -/// they replace. Returns the symbols that became ordinary declarations. -pub(super) fn synthesize_operations( - module: &mut Module, - token: TypeId, - trusted: &TrustedEffect, -) -> Result, Vec> { - let mut operations = Vec::new(); - let mut seen_symbols = std::collections::HashSet::new(); - let mut seen_operations = std::collections::HashSet::new(); - for binding in &trusted.operations { - if !seen_symbols.insert(binding.symbol) || !seen_operations.insert(binding.operation) { - return Err(vec![verification_error( - module, - "trusted Effect operation bindings are duplicated", - )]); - } - let Some((index, external)) = module - .externals - .iter() - .enumerate() - .find(|(_, external)| external.symbol == binding.symbol) - else { - return Err(vec![verification_error( - module, - "trusted Effect operation binding has no external declaration", - )]); - }; - let ExternalKind::Wit { - interface, - function, - } = &external.kind - else { - return Err(vec![verification_error( - module, - "trusted Effect operation is not a WIT import", - )]); - }; - if interface != EFFECT_INTERFACE || function != binding.operation.wit_function() { - return Err(vec![verification_error( - module, - "trusted Effect operation identity does not match its WIT binding", - )]); - } - operations.push(( - index, - binding.symbol, - external.name.clone(), - function.clone(), - external_span(external), - )); - } - if module.externals.iter().any(|external| { - matches!( - &external.kind, - ExternalKind::Wit { interface, .. } if interface == EFFECT_INTERFACE - ) && !seen_symbols.contains(&external.symbol) - }) { - return Err(vec![verification_error( - module, - "Effect WIT import is missing from the trusted operation bindings", - )]); - } - let mut locals = LocalSupply::new(module); - let mut variables = VariableSupply::new(module); - let mut synthesized = Vec::new(); - let mut remove = Vec::new(); - for (index, symbol, name, function, span) in operations { - let declaration = match function.as_str() { - "pure" => Some(pure_declaration( - module, - symbol, - &name, - span, - token, - &mut locals, - &mut variables, - )), - "bind" => Some(bind_declaration( - module, - symbol, - &name, - span, - token, - &mut locals, - &mut variables, - )), - "run" => Some(run_declaration( - module, - symbol, - &name, - span, - token, - &mut locals, - &mut variables, - )), - "trap" => Some(trap_declaration( - module, - symbol, - &name, - span, - token, - &mut locals, - )), - _ => None, - }; - let Some(declaration) = declaration else { - return Err(vec![verification_error( - module, - "trusted Effect operation has no lowering rule", - )]); - }; - module.declarations.push(declaration); - synthesized.push(symbol); - remove.push(index); - } - remove.sort_unstable(); - for index in remove.into_iter().rev() { - module.externals.remove(index); - } - module - .external_types - .retain(|external| !seen_symbols.contains(&external.symbol)); - Ok(synthesized) -} - -fn verification_error(module: &Module, message: &'static str) -> crate::VerifyError { - crate::VerifyError { - module: module.id, - span: module.span, - message, - } -} - -fn pure_declaration( - module: &mut Module, - symbol: SymbolId, - name: &str, - span: TextRange, - token: TypeId, - locals: &mut LocalSupply, - variables: &mut VariableSupply, -) -> Declaration { - let parameter = variables.fresh(); - let parameter_ty = intern(module, Type::Variable(parameter)); - let result = closure_type(module, token, parameter_ty); - let ty = arrow(module, parameter_ty, result); - let value_local = locals.fresh(); - let token_local = locals.fresh(); - let body = expr(ExprKind::Local(value_local), parameter_ty, span); - let closure = lambda(token_local, "token", token, body, result, span); - let value = lambda(value_local, "value", parameter_ty, closure, ty, span); - declaration(symbol, name, vec![parameter], ty, value, span) -} - -fn bind_declaration( - module: &mut Module, - symbol: SymbolId, - name: &str, - span: TextRange, - token: TypeId, - locals: &mut LocalSupply, - variables: &mut VariableSupply, -) -> Declaration { - let first_var = variables.fresh(); - let next_var = variables.fresh(); - let first_ty = intern(module, Type::Variable(first_var)); - let next_ty = intern(module, Type::Variable(next_var)); - let first_effect = closure_type(module, token, first_ty); - let next_effect = closure_type(module, token, next_ty); - let continuation = arrow(module, first_ty, next_effect); - let suspended = arrow(module, continuation, next_effect); - let ty = arrow(module, first_effect, suspended); - let first_local = locals.fresh(); - let next_local = locals.fresh(); - let token_local = locals.fresh(); - let ran_first = application( - expr(ExprKind::Local(first_local), first_effect, span), - expr(ExprKind::Local(token_local), token, span), - first_ty, - span, - ); - let ran_next = application( - expr(ExprKind::Local(next_local), continuation, span), - ran_first, - next_effect, - span, - ); - let body = application( - ran_next, - expr(ExprKind::Local(token_local), token, span), - next_ty, - span, - ); - let closure = lambda(token_local, "token", token, body, next_effect, span); - let with_next = lambda(next_local, "next", continuation, closure, suspended, span); - let value = lambda(first_local, "first", first_effect, with_next, ty, span); - declaration(symbol, name, vec![first_var, next_var], ty, value, span) -} - -fn run_declaration( - module: &mut Module, - symbol: SymbolId, - name: &str, - span: TextRange, - token: TypeId, - locals: &mut LocalSupply, - variables: &mut VariableSupply, -) -> Declaration { - let result_var = variables.fresh(); - let result_ty = intern(module, Type::Variable(result_var)); - let action_ty = closure_type(module, token, result_ty); - let ty = arrow(module, action_ty, result_ty); - let action = locals.fresh(); - let token_value = expr(ExprKind::StateToken, token, span); - let body = application( - expr(ExprKind::Local(action), action_ty, span), - token_value, - result_ty, - span, - ); - let value = lambda(action, "action", action_ty, body, ty, span); - declaration(symbol, name, vec![result_var], ty, value, span) -} - -/// The `trap :: Effect Unit` operation: an effect over the runtime token whose -/// body never returns, so running it escapes instead of producing `Unit`. -/// -/// It is a closure rather than a bare trap so that referencing the value stays -/// inert, exactly as `pure` is: an `Effect` only does something when the entry -/// applies it to a token. `Effect` is abstract, so this is the only place that -/// can state that an uncaught failure is a target trap. -fn trap_declaration( - module: &mut Module, - symbol: SymbolId, - name: &str, - span: TextRange, - token: TypeId, - locals: &mut LocalSupply, -) -> Declaration { - let unit = intern(module, Type::Constructor(TypeConstructor::Unit)); - let action = closure_type(module, token, unit); - let token_local = locals.fresh(); - let body = expr(ExprKind::Trap, unit, span); - let value = lambda(token_local, "token", token, body, action, span); - declaration(symbol, name, Vec::new(), action, value, span) -} - -fn declaration( - symbol: SymbolId, - name: &str, - quantified: Vec, - ty: TypeId, - value: Expr, - span: TextRange, -) -> Declaration { - Declaration { - symbol, - name: name.to_string(), - name_span: span, - quantified, - ty, - value, - span, - } -} - -fn lambda( - id: LocalId, - name: &str, - ty: TypeId, - body: Expr, - function_ty: TypeId, - span: TextRange, -) -> Expr { - expr( - ExprKind::Lambda { - binder: Binder { - id, - name: name.to_string(), - ty, - span, - }, - body: Box::new(body), - }, - function_ty, - span, - ) -} - -fn application(function: Expr, argument: Expr, ty: TypeId, span: TextRange) -> Expr { - expr( - ExprKind::Application(Box::new(function), Box::new(argument)), - ty, - span, - ) -} - -fn expr(kind: ExprKind, ty: TypeId, span: TextRange) -> Expr { - Expr { kind, ty, span } -} - -fn external_span(external: &psrs_hir::ExternalSymbol) -> TextRange { - external - .signature - .as_ref() - .map(|signature| signature.span) - .unwrap_or_default() -} - -/// Builds the token closure type `[token] -> result` in the module type table. -pub(super) fn closure_type(module: &mut Module, token: TypeId, result: TypeId) -> TypeId { - intern( - module, - Type::Closure { - parameters: vec![token], - result, - }, - ) -} - -/// Builds `parameter -> result` in the module type table. -pub(super) fn arrow(module: &mut Module, parameter: TypeId, result: TypeId) -> TypeId { - let function = intern(module, Type::Constructor(TypeConstructor::Function)); - let partial = intern(module, Type::Application(function, parameter)); - intern(module, Type::Application(partial, result)) -} diff --git a/crates/psrs-core/src/effect/supplies.rs b/crates/psrs-core/src/effect/supplies.rs deleted file mode 100644 index 0387b403..00000000 --- a/crates/psrs-core/src/effect/supplies.rs +++ /dev/null @@ -1,115 +0,0 @@ -//! Identifier supplies used while representation lowering adds declarations. - -use super::Module; -use crate::{Expr, ExprKind, Type}; -use psrs_hir::{LocalId, TypeVariableId}; - -/// A local id above every binder the module already holds. -pub(super) struct LocalSupply { - next: u32, -} - -impl LocalSupply { - pub(super) fn new(module: &Module) -> Self { - let mut next = 0; - for declaration in &module.declarations { - next = next.max(max_local(&declaration.value) + 1); - } - Self { next } - } - - pub(super) fn fresh(&mut self) -> LocalId { - let id = LocalId(self.next); - self.next += 1; - id - } -} - -fn max_local(expression: &Expr) -> u32 { - match &expression.kind { - ExprKind::Local(id) => id.0, - ExprKind::Lambda { binder, body } => binder.id.0.max(max_local(body)), - ExprKind::Application(function, argument) => max_local(function).max(max_local(argument)), - ExprKind::Let { bindings, body } => bindings - .iter() - .map(|binding| binding.binder.id.0.max(max_local(&binding.value))) - .chain(std::iter::once(max_local(body))) - .max() - .unwrap_or(0), - ExprKind::Case { - scrutinee, - branches, - } => branches - .iter() - .map(|branch| max_local(&branch.value)) - .chain(std::iter::once(max_local(scrutinee))) - .max() - .unwrap_or(0), - ExprKind::If { - condition, - then_branch, - else_branch, - } => max_local(condition) - .max(max_local(then_branch)) - .max(max_local(else_branch)), - ExprKind::Constructor { arguments, .. } - | ExprKind::IntrinsicCall { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => arguments.iter().map(max_local).max().unwrap_or(0), - ExprKind::Record { fields } => fields - .iter() - .map(|(_, value)| max_local(value)) - .max() - .unwrap_or(0), - ExprKind::RecordUpdate { record, fields } => fields - .iter() - .map(|(_, value)| max_local(value)) - .chain(std::iter::once(max_local(record))) - .max() - .unwrap_or(0), - ExprKind::FieldAccess { record, .. } - | ExprKind::RepresentationCast { value: record, .. } => max_local(record), - ExprKind::Global(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::Boolean(_) - | ExprKind::String(_) - | ExprKind::Char(_) => 0, - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => 0, - } -} - -/// A type variable above every binder the module already holds. -pub(super) struct VariableSupply { - next: u32, -} - -impl VariableSupply { - pub(super) fn new(module: &Module) -> Self { - let mut next = 0; - for ty in &module.types { - match ty { - Type::Variable(variable) => next = next.max(variable.0 + 1), - Type::ForAll { variables, .. } => { - for variable in variables { - next = next.max(variable.0 + 1); - } - } - _ => {} - } - } - for declaration in &module.declarations { - for variable in &declaration.quantified { - next = next.max(variable.0 + 1); - } - } - Self { next } - } - - pub(super) fn fresh(&mut self) -> TypeVariableId { - let id = TypeVariableId(self.next); - self.next += 1; - id - } -} diff --git a/crates/psrs-core/src/instantiation/local_rows.rs b/crates/psrs-core/src/instantiation/local_rows.rs index 128e8d28..dbb398fb 100644 --- a/crates/psrs-core/src/instantiation/local_rows.rs +++ b/crates/psrs-core/src/instantiation/local_rows.rs @@ -244,7 +244,6 @@ fn children(expr: &mut Expr) -> Vec<&mut Expr> { | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit - | ExprKind::StateToken | ExprKind::Trap => Vec::new(), } } @@ -328,7 +327,6 @@ fn children_ref(expr: &Expr) -> Vec<&Expr> { | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit - | ExprKind::StateToken | ExprKind::Trap => Vec::new(), } } diff --git a/crates/psrs-core/src/instantiation/substitution.rs b/crates/psrs-core/src/instantiation/substitution.rs index 9c2de0af..6ad56e09 100644 --- a/crates/psrs-core/src/instantiation/substitution.rs +++ b/crates/psrs-core/src/instantiation/substitution.rs @@ -228,7 +228,6 @@ impl TypeSubstitution<'_> { ExprKind::String(value) => ExprKind::String(value.clone()), ExprKind::Char(value) => ExprKind::Char(*value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 805c9db9..5a420c68 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -1,6 +1,5 @@ pub mod command; pub mod dictionary; -pub mod effect; mod instantiation; mod link; mod locals; @@ -9,7 +8,6 @@ pub mod opt; mod pattern; pub mod primitive; mod records; -pub mod state; pub use instantiation::{Instantiation, RowInstantiation, instantiate_local_rows}; mod types; mod verify; @@ -147,12 +145,6 @@ pub enum ExprKind { /// constructor application. Its canonical runtime value is the integer `0` /// ([scalars and primitives](../../design/backend/fp/scalars-and-primitives.md)). Unit, - /// The one value of the compiler-owned opaque state token an `Effect` - /// closure takes. Only effect lowering produces it; it is threaded through - /// the chain and never inspected, the `State# RealWorld` analogue of - /// [effects](../../design/backend/fp/effects.md). Its runtime shape is a - /// scalar, but it is not an `Int`. - StateToken, /// An expression that never produces its value: the guest traps. Core /// carries it so the effect interface can supply an `Effect Unit` that /// escapes instead of returning, which is what an uncaught failure is on diff --git a/crates/psrs-core/src/link/mod.rs b/crates/psrs-core/src/link/mod.rs index 999faaa2..d911bacf 100644 --- a/crates/psrs-core/src/link/mod.rs +++ b/crates/psrs-core/src/link/mod.rs @@ -387,7 +387,6 @@ fn collect_references_inner( | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit - | ExprKind::StateToken | ExprKind::Trap => {} ExprKind::Array { elements } => { for element in elements { diff --git a/crates/psrs-core/src/link/shift.rs b/crates/psrs-core/src/link/shift.rs index 6f56c577..8acbfc66 100644 --- a/crates/psrs-core/src/link/shift.rs +++ b/crates/psrs-core/src/link/shift.rs @@ -24,7 +24,6 @@ pub(super) fn shift_kind(kind: ExprKind, offset: u32, variable_offset: u32) -> E ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/link/variables.rs b/crates/psrs-core/src/link/variables.rs index 05f19190..0d327632 100644 --- a/crates/psrs-core/src/link/variables.rs +++ b/crates/psrs-core/src/link/variables.rs @@ -97,6 +97,6 @@ fn expression_span(expression: &Expr, maximum: &mut Option) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/locals/alpha.rs b/crates/psrs-core/src/locals/alpha.rs index f61bd99a..a48a1f3a 100644 --- a/crates/psrs-core/src/locals/alpha.rs +++ b/crates/psrs-core/src/locals/alpha.rs @@ -38,7 +38,6 @@ fn clone_expr( ExprKind::String(value) => ExprKind::String(value.clone()), ExprKind::Char(value) => ExprKind::Char(*value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/locals/mod.rs b/crates/psrs-core/src/locals/mod.rs index 39298d26..1c278ace 100644 --- a/crates/psrs-core/src/locals/mod.rs +++ b/crates/psrs-core/src/locals/mod.rs @@ -96,7 +96,7 @@ fn collect_ids(expression: &Expr, ids: &mut HashSet) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/dead.rs b/crates/psrs-core/src/opt/dead.rs index 22a13ff8..4c2deb55 100644 --- a/crates/psrs-core/src/opt/dead.rs +++ b/crates/psrs-core/src/opt/dead.rs @@ -113,7 +113,6 @@ fn eliminate_expr_inner(mut expression: Expr) -> Expr { ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression @@ -229,6 +228,6 @@ fn collect_refs_inner(expression: &Expr, references: &mut HashSet) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/effects.rs b/crates/psrs-core/src/opt/effects.rs index 592e861c..af2b2c6a 100644 --- a/crates/psrs-core/src/opt/effects.rs +++ b/crates/psrs-core/src/opt/effects.rs @@ -36,8 +36,6 @@ fn summarize_inner(expression: &Expr) -> Effects { | ExprKind::Char(_) => Effects::default(), // The unit value has no payload and no failure mode. ExprKind::Unit => Effects::default(), - // The state token has no payload and no failure mode. - ExprKind::StateToken => Effects::default(), // A trap is a failure by definition, so no rewrite may drop or move it // as if it were an inert value. ExprKind::Trap => Effects { diff --git a/crates/psrs-core/src/opt/inline/global/analysis.rs b/crates/psrs-core/src/opt/inline/global/analysis.rs index 2ec48a3c..d4ea2d8b 100644 --- a/crates/psrs-core/src/opt/inline/global/analysis.rs +++ b/crates/psrs-core/src/opt/inline/global/analysis.rs @@ -117,7 +117,6 @@ fn expr_introduces_type_binders_inner(expression: &Expr, types: &[Type]) -> bool | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit - | ExprKind::StateToken | ExprKind::Trap => false, } } @@ -197,7 +196,6 @@ fn contains_case_inner(expression: &Expr) -> bool { | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit - | ExprKind::StateToken | ExprKind::Trap => false, } } @@ -266,6 +264,6 @@ fn collect_globals_inner(expression: &Expr, out: &mut Vec) { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => {} - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/inline/global/mod.rs b/crates/psrs-core/src/opt/inline/global/mod.rs index 1cde4dac..7d3851bf 100644 --- a/crates/psrs-core/src/opt/inline/global/mod.rs +++ b/crates/psrs-core/src/opt/inline/global/mod.rs @@ -362,7 +362,6 @@ fn inline_expr_inner( ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression diff --git a/crates/psrs-core/src/opt/inline/local.rs b/crates/psrs-core/src/opt/inline/local.rs index 432ab47a..ff653f21 100644 --- a/crates/psrs-core/src/opt/inline/local.rs +++ b/crates/psrs-core/src/opt/inline/local.rs @@ -234,7 +234,6 @@ fn inline_expr_inner( ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression diff --git a/crates/psrs-core/src/opt/simplify/mod.rs b/crates/psrs-core/src/opt/simplify/mod.rs index 5b4477d5..7d5c31d1 100644 --- a/crates/psrs-core/src/opt/simplify/mod.rs +++ b/crates/psrs-core/src/opt/simplify/mod.rs @@ -219,7 +219,7 @@ fn simplify_expr_inner(mut expression: Expr, fresh: &mut FreshLocals) -> Expr { ExprKind::Boolean(value) => ExprKind::Boolean(value), ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), - kind @ (ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap) => kind, + kind @ (ExprKind::Unit | ExprKind::Trap) => kind, }; expression } diff --git a/crates/psrs-core/src/opt/specialize/calls.rs b/crates/psrs-core/src/opt/specialize/calls.rs index f2aeb3f5..f35e6b24 100644 --- a/crates/psrs-core/src/opt/specialize/calls.rs +++ b/crates/psrs-core/src/opt/specialize/calls.rs @@ -134,7 +134,6 @@ fn rewrite_inner( ExprKind::String(value) => ExprKind::String(value), ExprKind::Char(value) => ExprKind::Char(value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, }; expression diff --git a/crates/psrs-core/src/opt/specialize/mod.rs b/crates/psrs-core/src/opt/specialize/mod.rs index 16f2fd3b..777a8960 100644 --- a/crates/psrs-core/src/opt/specialize/mod.rs +++ b/crates/psrs-core/src/opt/specialize/mod.rs @@ -1,5 +1,5 @@ -mod calls; mod callable_fields; +mod calls; mod types; use super::{Budget, util::count_nodes}; @@ -229,6 +229,6 @@ fn collect_references_inner(expression: &crate::Expr, out: &mut Vec) { | crate::ExprKind::Boolean(_) | crate::ExprKind::String(_) | crate::ExprKind::Char(_) => {} - crate::ExprKind::Unit | crate::ExprKind::StateToken | crate::ExprKind::Trap => {} + crate::ExprKind::Unit | crate::ExprKind::Trap => {} } } diff --git a/crates/psrs-core/src/opt/util.rs b/crates/psrs-core/src/opt/util.rs index 49432fef..f4afc800 100644 --- a/crates/psrs-core/src/opt/util.rs +++ b/crates/psrs-core/src/opt/util.rs @@ -16,7 +16,7 @@ fn count_nodes_inner(expression: &Expr) -> usize { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => 0, - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => 0, + ExprKind::Unit | ExprKind::Trap => 0, ExprKind::Constructor { arguments, .. } | ExprKind::IntrinsicCall { arguments, .. } | ExprKind::Array { @@ -121,7 +121,6 @@ fn substitute_inner_walk( ExprKind::String(value) => ExprKind::String(value.clone()), ExprKind::Char(value) => ExprKind::Char(*value), ExprKind::Unit => ExprKind::Unit, - ExprKind::StateToken => ExprKind::StateToken, ExprKind::Trap => ExprKind::Trap, ExprKind::Array { elements } => ExprKind::Array { elements: elements diff --git a/crates/psrs-core/src/primitive.rs b/crates/psrs-core/src/primitive.rs index 7f608d28..32489215 100644 --- a/crates/psrs-core/src/primitive.rs +++ b/crates/psrs-core/src/primitive.rs @@ -185,7 +185,6 @@ fn rewrite_inner( | ExprKind::String(_) | ExprKind::Char(_) | ExprKind::Unit - | ExprKind::StateToken | ExprKind::Trap => {} } Ok(()) diff --git a/crates/psrs-core/src/state/dependency/mod.rs b/crates/psrs-core/src/state/dependency/mod.rs deleted file mode 100644 index 199d5308..00000000 --- a/crates/psrs-core/src/state/dependency/mod.rs +++ /dev/null @@ -1,213 +0,0 @@ -//! Representation-independent state flow validation. -//! -//! Block parameters represent joins and loop-carried dependencies. Each block -//! is checked using those parameters as its incoming state; edges transfer the -//! current state of each region to the corresponding successor parameter. -use psrs_span::TextRange; -use std::collections::{HashMap, HashSet}; - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub struct DependencyId(pub u32); - -/// An interned checked region identity, never a physical value or type name. -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub struct RegionId(pub u32); - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct Dependency { - pub id: DependencyId, - pub region: RegionId, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct Transition { - /// The defining operation in the owning representation, in execution order. - pub operation: u32, - pub input: DependencyId, - pub output: Dependency, - pub span: TextRange, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct Edge { - pub target: u32, - pub arguments: Vec, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub enum Terminator { - Return(Vec), - Jump(Edge), - Branch { - then_edge: Edge, - else_edge: Edge, - }, - /// Total multiway choice. Concrete predicates and case labels belong to - /// the owning representation's instruction-correspondence check. - Switch { - case_edges: Vec, - default_edge: Edge, - }, - /// A trapping path has no normal state successor. - Trap, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct Block { - pub id: u32, - pub parameters: Vec, - pub transitions: Vec, - pub terminator: Terminator, - pub span: TextRange, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct Graph { - pub entry: u32, - /// Checked function input regions, in signature order. A runner's verified - /// invocation boundary supplies roots; the graph never invents a root. - pub regions: Vec, - pub blocks: Vec, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct DependencyError { - pub span: TextRange, - pub message: &'static str, -} - -impl Graph { - /// Validation is read-only. Consumers must additionally check that every - /// transition's operation identity maps to its actual checked instruction. - pub fn verify(&self) -> Result<(), DependencyError> { - let fail = |span, message| DependencyError { span, message }; - let mut blocks = HashMap::new(); - let mut definitions = HashSet::new(); - for block in &self.blocks { - if blocks.insert(block.id, block).is_some() { - return Err(fail(block.span, "duplicate state dependency block")); - } - for definition in block.parameters.iter().chain( - block - .transitions - .iter() - .map(|transition| &transition.output), - ) { - if !definitions.insert(definition.id) { - return Err(fail( - block.span, - "state dependency has multiple definitions", - )); - } - } - } - let Some(entry) = blocks.get(&self.entry) else { - return Err(fail(TextRange::new(0, 0), "state graph has no entry block")); - }; - if entry - .parameters - .iter() - .map(|value| value.region) - .collect::>() - != self.regions - { - return Err(fail( - entry.span, - "state graph entry does not match its checked regions", - )); - } - for block in &self.blocks { - let mut current = HashMap::new(); - for parameter in &block.parameters { - if current.insert(parameter.region, parameter.id).is_some() { - return Err(fail(block.span, "duplicate incoming state region")); - } - } - if current.len() != self.regions.len() - || self - .regions - .iter() - .any(|region| !current.contains_key(region)) - { - return Err(fail( - block.span, - "state block changes the checked region set", - )); - } - let mut previous_operation = None; - for transition in &block.transitions { - if previous_operation.is_some_and(|previous| previous >= transition.operation) { - return Err(fail( - transition.span, - "state transitions are not in operation order", - )); - } - previous_operation = Some(transition.operation); - if current.get(&transition.output.region) != Some(&transition.input) { - return Err(fail( - transition.span, - "state operation uses a stale or foreign dependency", - )); - } - current.insert(transition.output.region, transition.output.id); - } - let check_edge = |edge: &Edge| -> Result<(), DependencyError> { - let target = blocks - .get(&edge.target) - .ok_or_else(|| fail(block.span, "state edge has no target block"))?; - if edge.arguments.len() != target.parameters.len() { - return Err(fail( - block.span, - "state edge has an invalid parameter count", - )); - } - for (argument, parameter) in edge.arguments.iter().zip(&target.parameters) { - if current.get(¶meter.region) != Some(argument) { - return Err(fail( - block.span, - "state edge does not transfer the current dependency", - )); - } - } - Ok(()) - }; - match &block.terminator { - Terminator::Return(values) => { - if values.len() != self.regions.len() - || self - .regions - .iter() - .zip(values) - .any(|(region, value)| current.get(region) != Some(value)) - { - return Err(fail( - block.span, - "state return discards an executed operation", - )); - } - } - Terminator::Jump(edge) => check_edge(edge)?, - Terminator::Branch { - then_edge, - else_edge, - } => { - check_edge(then_edge)?; - check_edge(else_edge)?; - } - Terminator::Switch { - case_edges, - default_edge, - } => { - for edge in case_edges.iter().chain(std::iter::once(default_edge)) { - check_edge(edge)?; - } - } - Terminator::Trap => {} - } - } - Ok(()) - } -} - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-core/src/state/dependency/tests.rs b/crates/psrs-core/src/state/dependency/tests.rs deleted file mode 100644 index e1fe6cc8..00000000 --- a/crates/psrs-core/src/state/dependency/tests.rs +++ /dev/null @@ -1,193 +0,0 @@ -use super::*; - -const SPAN: TextRange = TextRange::new(10, 20); -fn dependency(id: u32) -> Dependency { - Dependency { - id: DependencyId(id), - region: RegionId(0), - } -} -fn transition(input: u32, output: u32) -> Transition { - Transition { - operation: output, - input: DependencyId(input), - output: dependency(output), - span: SPAN, - } -} -fn edge(target: u32, input: u32) -> Edge { - Edge { - target, - arguments: vec![DependencyId(input)], - } -} -fn block(id: u32, incoming: u32, transitions: Vec, terminator: Terminator) -> Block { - Block { - id, - parameters: vec![dependency(incoming)], - transitions, - terminator, - span: SPAN, - } -} -fn graph(blocks: Vec) -> Graph { - Graph { - entry: 0, - regions: vec![RegionId(0)], - blocks, - } -} - -#[test] -fn rejects_stale_predecessors_and_discarded_final_state() { - let mut graph = graph(vec![block( - 0, - 0, - vec![transition(0, 1), transition(1, 2)], - Terminator::Return(vec![DependencyId(2)]), - )]); - graph.verify().unwrap(); - graph.blocks[0].transitions[1].input = DependencyId(0); - let error = graph.verify().unwrap_err(); - assert_eq!(error.span, SPAN); - assert_eq!( - error.message, - "state operation uses a stale or foreign dependency" - ); - graph.blocks[0].transitions[1].input = DependencyId(1); - graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(1)]); - assert!(graph.verify().unwrap_err().message.contains("discards")); -} - -#[test] -fn multiway_edges_transfer_current_dependencies_and_traps_have_no_join_edge() { - let mut graph = graph(vec![ - block( - 0, - 0, - vec![transition(0, 1)], - Terminator::Switch { - case_edges: vec![edge(1, 1), edge(2, 1)], - default_edge: edge(3, 1), - }, - ), - block(1, 2, vec![transition(2, 5)], Terminator::Jump(edge(4, 5))), - block(2, 3, vec![], Terminator::Trap), - block(3, 4, vec![], Terminator::Jump(edge(4, 4))), - block(4, 6, vec![], Terminator::Return(vec![DependencyId(6)])), - ]); - graph.verify().unwrap(); - for choice in 0..3 { - let original = graph.blocks[0].terminator.clone(); - let Terminator::Switch { - case_edges, - default_edge, - } = &mut graph.blocks[0].terminator - else { - panic!() - }; - let edge = if choice == 2 { - default_edge - } else { - &mut case_edges[choice] - }; - edge.arguments[0] = DependencyId(0); - assert!(graph.verify().is_err()); - graph.blocks[0].terminator = original; - } -} - -#[test] -fn branch_exclusive_operations_merge_the_executed_dependency() { - let mut graph = graph(vec![ - block( - 0, - 0, - vec![], - Terminator::Branch { - then_edge: edge(1, 0), - else_edge: edge(2, 0), - }, - ), - block(1, 1, vec![transition(1, 3)], Terminator::Jump(edge(3, 3))), - block(2, 2, vec![transition(2, 4)], Terminator::Jump(edge(3, 4))), - block( - 3, - 5, - vec![transition(5, 6)], - Terminator::Return(vec![DependencyId(6)]), - ), - ]); - graph.verify().unwrap(); - graph.blocks[2].terminator = Terminator::Jump(edge(3, 3)); - assert!( - graph - .verify() - .unwrap_err() - .message - .contains("current dependency") - ); -} - -#[test] -fn loop_carries_the_latest_state_and_traps_need_no_successor() { - let mut graph = graph(vec![ - block(0, 0, vec![], Terminator::Jump(edge(1, 0))), - block( - 1, - 1, - vec![transition(1, 2)], - Terminator::Branch { - then_edge: edge(1, 2), - else_edge: edge(2, 2), - }, - ), - block(2, 3, vec![], Terminator::Trap), - ]); - graph.verify().unwrap(); - let Terminator::Branch { then_edge, .. } = &mut graph.blocks[1].terminator else { - unreachable!() - }; - then_edge.arguments[0] = DependencyId(1); - assert!(graph.verify().is_err()); -} - -#[test] -fn rejects_wrong_region_duplicate_definitions_and_missing_roots() { - let mut graph = graph(vec![block( - 0, - 0, - vec![transition(0, 1)], - Terminator::Return(vec![DependencyId(1)]), - )]); - graph.blocks[0].transitions[0].output.region = RegionId(1); - assert!(graph.verify().is_err()); - graph.blocks[0].transitions[0].output = dependency(0); - assert!( - graph - .verify() - .unwrap_err() - .message - .contains("multiple definitions") - ); - graph.entry = 10; - assert!(graph.verify().is_err()); -} - -#[test] -fn rejects_a_projection_that_reorders_actual_operations() { - let mut graph = graph(vec![block( - 0, - 0, - vec![transition(0, 1), transition(1, 2)], - Terminator::Return(vec![DependencyId(2)]), - )]); - graph.blocks[0].transitions[0].operation = 5; - assert!( - graph - .verify() - .unwrap_err() - .message - .contains("operation order") - ); -} diff --git a/crates/psrs-core/src/state/flow/branches.rs b/crates/psrs-core/src/state/flow/branches.rs deleted file mode 100644 index 3fbd4254..00000000 --- a/crates/psrs-core/src/state/flow/branches.rs +++ /dev/null @@ -1,208 +0,0 @@ -use super::{Block, Builder, Dependency, Path, RegionId, Terminator, Value}; -use crate::state::dependency::Edge; -use crate::{CaseBranch, Expr, Pattern, VerifyError}; -use psrs_span::TextRange; -use std::collections::HashMap; - -impl<'a> Builder<'a> { - fn fork(&mut self, path: &Path, span: TextRange) -> Path { - let input = self.fresh(); - let block = self.blocks.len(); - self.blocks.push(Block { - id: block as u32, - parameters: vec![Dependency { - id: input, - region: RegionId(0), - }], - transitions: Vec::new(), - terminator: Terminator::Trap, - span, - }); - let mut locals = path.locals.clone(); - for value in locals.values_mut() { - value.remap(path.current, input); - } - let mut aliases = path.aliases.clone(); - aliases.insert(path.current, input); - Path { - block, - current: input, - revision: path.revision, - locals, - aliases, - } - } - - pub(super) fn alternatives( - &mut self, - values: &[&'a Expr], - path: &mut Path, - span: TextRange, - ) -> Result { - let arms = values - .iter() - .map(|value| (*value, None)) - .collect::>(); - self.arms(&arms, &Value::Opaque, path, span) - } - - pub(super) fn case_alternatives( - &mut self, - value: Value, - branches: &'a [CaseBranch], - path: &mut Path, - span: TextRange, - ) -> Result { - let arms = branches - .iter() - .map(|branch| (&branch.value, Some(&branch.pattern))) - .collect::>(); - self.arms(&arms, &value, path, span) - } - - fn arms( - &mut self, - arms: &[(&'a Expr, Option<&'a Pattern>)], - scrutinee: &Value, - path: &mut Path, - span: TextRange, - ) -> Result { - psrs_span::with_sufficient_stack(|| self.arms_inner(arms, scrutinee, path, span)) - } - - fn arms_inner( - &mut self, - arms: &[(&'a Expr, Option<&'a Pattern>)], - scrutinee: &Value, - path: &mut Path, - span: TextRange, - ) -> Result { - if arms.is_empty() { - return Ok(Value::Terminated); - } - if arms.len() == 1 { - if let Some(pattern) = arms[0].1 { - self.bind(pattern, scrutinee.clone(), path)?; - } - return self.eval(arms[0].0, path); - } - let incoming = path.current; - let revision = path.revision; - let mut left = self.fork(path, span); - let mut right = self.fork(path, span); - self.blocks[path.block].terminator = Terminator::Branch { - then_edge: Edge { - target: left.block as u32, - arguments: vec![incoming], - }, - else_edge: Edge { - target: right.block as u32, - arguments: vec![incoming], - }, - }; - let mut left_scrutinee = scrutinee.clone(); - left_scrutinee.remap(incoming, left.current); - let left_value = self.arms(&arms[..1], &left_scrutinee, &mut left, span)?; - let mut right_scrutinee = scrutinee.clone(); - right_scrutinee.remap(incoming, right.current); - let right_value = self.arms(&arms[1..], &right_scrutinee, &mut right, span)?; - let live = [(left_value, left), (right_value, right)] - .into_iter() - .filter(|(value, _)| !matches!(value, Value::Terminated)) - .collect::>(); - if live.is_empty() { - return Ok(Value::Terminated); - } - let join = self.fork(path, span); - let mut merged = None; - for (value, branch) in &live { - let mut value = value.clone(); - value.resolve(branch); - self.blocks[branch.block].terminator = Terminator::Jump(Edge { - target: join.block as u32, - arguments: vec![branch.current], - }); - value.remap(branch.current, join.current); - merged = Some(match merged { - None => value, - Some(previous) => self.merge(previous, value, span)?, - }); - } - // With no observable invocation on any surviving path, incoming state - // aliases also denote the selected join dependency. Otherwise they - // remain predecessors and a subsequent use must reject. - if live.iter().all(|(_, branch)| branch.revision == revision) { - path.aliases.insert(incoming, join.current); - for value in path.locals.values_mut() { - value.remap(incoming, join.current); - } - } - path.current = join.current; - path.block = join.block; - path.revision = live - .iter() - .map(|(_, branch)| branch.revision) - .max() - .unwrap(); - Ok(merged.unwrap()) - } - - fn merge(&self, left: Value, right: Value, span: TextRange) -> Result { - Ok(match (left, right) { - (Value::State(left), Value::State(right)) if left == right => Value::State(left), - (Value::Record(left), Value::Record(mut right)) if left.len() == right.len() => { - let mut fields = HashMap::new(); - for (label, value) in left { - let other = right.remove(&label).ok_or_else(|| { - self.error(span, "state branch result changes its checked fields") - })?; - fields.insert(label, self.merge(value, other, span)?); - } - Value::Record(fields) - } - (Value::Constructor(left), Value::Constructor(right)) if left.len() == right.len() => { - Value::Constructor( - left.into_iter() - .zip(right) - .map(|(left, right)| self.merge(left, right, span)) - .collect::>()?, - ) - } - ( - Value::Closure { - index, - captures: left, - }, - Value::Closure { - index: other, - mut captures, - }, - ) if index == other && left.len() == captures.len() => { - let mut merged = std::collections::HashMap::new(); - for (local, value) in left { - let other = captures.remove(&local).ok_or_else(|| { - self.error(span, "callback branch changes its lexical captures") - })?; - merged.insert(local, self.merge(value, other, span)?); - } - Value::Closure { - index, - captures: merged, - } - } - (Value::State(_), _) | (_, Value::State(_)) => { - return Err(self.error( - span, - "state branch result has incompatible producer provenance", - )); - } - (left, right) if left.carries_state() || right.carries_state() => { - return Err(self.error( - span, - "state branch result has incompatible producer provenance", - )); - } - _ => Value::Opaque, - }) - } -} diff --git a/crates/psrs-core/src/state/flow/closure_tests.rs b/crates/psrs-core/src/state/flow/closure_tests.rs deleted file mode 100644 index 9a0d1814..00000000 --- a/crates/psrs-core/src/state/flow/closure_tests.rs +++ /dev/null @@ -1,153 +0,0 @@ -use super::tests::*; -use super::*; - -fn callback(body: Expr) -> Expr { - value( - ExprKind::Lambda { - binder: binder(9, 3), - body: Box::new(body), - }, - 16, - ) -} -fn call(id: u32, argument: Expr) -> Expr { - value( - ExprKind::Application(Box::new(local(id, 16)), Box::new(argument)), - 8, - ) -} -fn module(body: Expr) -> Module { - let mut module = fixture(body); - module - .types - .push(crate::Type::Application(TypeId(9), TypeId(3))); - module - .types - .push(crate::Type::Application(TypeId(15), TypeId(8))); - module -} - -#[test] -fn lexical_callback_consumes_its_captured_source_without_inventing_a_root() { - let module = module(let_value( - 2, - callback(invocation(local(0, 2))), - call(2, value(ExprKind::Integer(42), 3)), - )); - let flows = check(&module).unwrap(); - assert_eq!(flows.len(), 1); - assert_eq!(flows[0].operations.len(), 1); - assert_eq!(flows[0].operations[0].input, DependencyId(0)); - assert_eq!(flows[0].operations[0].output, DependencyId(1)); - flows[0].verify(&module).unwrap(); -} - -#[test] -fn creating_an_unused_callback_does_not_execute_its_body() { - let module = module(let_value( - 2, - callback(invocation(local(0, 2))), - step(local(0, 2)), - )); - let flows = check(&module).unwrap(); - assert!(flows[0].operations.is_empty()); -} - -#[test] -fn invoking_a_captured_predecessor_twice_rejects() { - let module = module(let_value( - 2, - callback(invocation(local(0, 2))), - let_value( - 3, - call(2, value(ExprKind::Integer(1), 3)), - call(2, value(ExprKind::Integer(2), 3)), - ), - )); - assert_eq!( - check(&module).unwrap_err()[0].message, - "state call consumes a stale dependency" - ); -} - -#[test] -fn a_callback_argument_executes_before_the_captured_body() { - let argument = let_value(3, invocation(local(0, 2)), value(ExprKind::Integer(42), 3)); - let module = module(let_value( - 2, - callback(invocation(local(0, 2))), - call(2, argument), - )); - assert_eq!( - check(&module).unwrap_err()[0].message, - "state call consumes a stale dependency" - ); -} - -#[test] -fn callback_aliases_survive_a_pure_choice_with_the_selected_root() { - let chosen = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(local(2, 16)), - else_branch: Box::new(local(2, 16)), - }, - 16, - ); - let module = module(let_value( - 2, - callback(invocation(local(0, 2))), - let_value(3, chosen, call(3, value(ExprKind::Integer(42), 3))), - )); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 1); - flows[0].verify(&module).unwrap(); -} - -#[test] -fn an_unknown_callback_consumer_cannot_hide_a_captured_state_operation() { - let consume = value( - ExprKind::Application( - Box::new(value( - ExprKind::Global(psrs_hir::SymbolId::new(ModuleId(0), 77)), - 18, - )), - Box::new(local(2, 16)), - ), - 3, - ); - let mut module = module(let_value( - 2, - callback(invocation(local(0, 2))), - let_value(3, consume, step(local(0, 2))), - )); - module - .types - .push(crate::Type::Application(TypeId(9), TypeId(16))); - module - .types - .push(crate::Type::Application(TypeId(17), TypeId(3))); - assert_eq!( - check(&module).unwrap_err()[0].message, - "state-carrying argument requires a checked invocation scope" - ); -} - -#[test] -fn callback_invocations_cannot_be_removed_from_a_valid_source_witness() { - let module = module(let_value( - 2, - callback(invocation(local(0, 2))), - call(2, value(ExprKind::Integer(42), 3)), - )); - let mut flows = check(&module).unwrap(); - let flow = &mut flows[0]; - flow.operations.clear(); - flow.graph.blocks[0].transitions.clear(); - flow.graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(0)]); - flow.graph.verify().unwrap(); - assert_eq!( - flow.verify(&module).unwrap_err().message, - "state graph changes executing source invocation order or coverage" - ); -} diff --git a/crates/psrs-core/src/state/flow/closures.rs b/crates/psrs-core/src/state/flow/closures.rs deleted file mode 100644 index 0da2a315..00000000 --- a/crates/psrs-core/src/state/flow/closures.rs +++ /dev/null @@ -1,165 +0,0 @@ -//! Lexical callback execution shares the caller's dependency path, not a root. -use super::{Builder, Path, Value}; -use crate::{Expr, ExprKind, VerifyError}; -use psrs_hir::LocalId; -use psrs_span::TextRange; -use std::collections::HashSet; - -impl<'a> Builder<'a> { - pub(super) fn closure(&mut self, expression: &'a Expr, path: &Path) -> Value { - let index = self.closures.len(); - self.closures.push(expression); - let mut free = HashSet::new(); - free_locals(expression, &HashSet::new(), &mut free); - Value::Closure { - index, - captures: path - .locals - .iter() - .filter(|(id, _)| free.contains(id)) - .map(|(id, value)| (*id, value.clone())) - .collect(), - } - } - - pub(super) fn invoke_closure( - &mut self, - function: Value, - argument: Value, - path: &mut Path, - span: TextRange, - ) -> Result { - let Value::Closure { - index, - mut captures, - } = function - else { - if argument.carries_state() { - return Err(self.error( - span, - "state-carrying argument requires a checked invocation scope", - )); - } - return Ok(Value::Opaque); - }; - if self.active_closures.contains(&index) { - return Err(self.error( - span, - "recursive captured callback requires checked loop transport", - )); - } - let ExprKind::Lambda { binder, body } = &self.closures[index].kind else { - unreachable!("closure registration requires a lambda"); - }; - for captured in captures.values_mut() { - captured.resolve(path); - } - captures.insert(binder.id, argument); - let caller = std::mem::replace(&mut path.locals, captures); - self.active_closures.push(index); - let result = self.eval(body, path); - self.active_closures.pop(); - path.locals = caller; - result - } -} - -fn free_locals(expr: &Expr, bound: &HashSet, free: &mut HashSet) { - psrs_span::with_sufficient_stack(|| { - let mut visit = |value| free_locals(value, bound, free); - match &expr.kind { - ExprKind::Local(id) if !bound.contains(id) => { - free.insert(*id); - } - ExprKind::Lambda { binder, body } => { - let mut scope = bound.clone(); - scope.insert(binder.id); - free_locals(body, &scope, free); - } - ExprKind::Let { bindings, body } => { - let mut scope = bound.clone(); - scope.extend(bindings.iter().map(|binding| binding.binder.id)); - for binding in bindings { - free_locals(&binding.value, &scope, free); - } - free_locals(body, &scope, free); - } - ExprKind::Case { - scrutinee, - branches, - } => { - visit(scrutinee); - for branch in branches { - let mut scope = bound.clone(); - bind_pattern(&branch.pattern, &mut scope); - free_locals(&branch.value, &scope, free); - } - } - ExprKind::Constructor { arguments, .. } - | ExprKind::IntrinsicCall { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => { - for argument in arguments { - visit(argument); - } - } - ExprKind::Record { fields } => { - for (_, value) in fields { - visit(value); - } - } - ExprKind::RecordUpdate { record, fields } => { - visit(record); - for (_, value) in fields { - visit(value); - } - } - ExprKind::FieldAccess { record, .. } - | ExprKind::RepresentationCast { value: record, .. } => visit(record), - ExprKind::Application(function, argument) => { - visit(function); - visit(argument); - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - visit(condition); - visit(then_branch); - visit(else_branch); - } - _ => {} - } - }); -} - -fn bind_pattern(pattern: &crate::Pattern, bound: &mut HashSet) { - use crate::PatternKind; - match &pattern.kind { - PatternKind::Var { id, .. } => { - bound.insert(*id); - } - PatternKind::Named { id, pattern } => { - bound.insert(*id); - bind_pattern(pattern, bound); - } - PatternKind::Constructor { arguments, .. } => { - for field in arguments { - bind_pattern(field, bound); - } - } - PatternKind::Record { fields } => { - for (_, field) in fields { - bind_pattern(field, bound); - } - } - PatternKind::Array { elements } => { - for element in elements { - bind_pattern(element, bound); - } - } - _ => {} - } -} diff --git a/crates/psrs-core/src/state/flow/eval.rs b/crates/psrs-core/src/state/flow/eval.rs deleted file mode 100644 index b6123829..00000000 --- a/crates/psrs-core/src/state/flow/eval.rs +++ /dev/null @@ -1,246 +0,0 @@ -use super::{Builder, Path, Value}; -use crate::{Expr, ExprKind, Pattern, PatternKind, VerifyError}; -use std::collections::HashMap; - -impl<'a> Builder<'a> { - pub(super) fn eval( - &mut self, - expression: &'a Expr, - path: &mut Path, - ) -> Result { - psrs_span::with_sufficient_stack(|| self.eval_inner(expression, path)) - } - - fn eval_inner(&mut self, expression: &'a Expr, path: &mut Path) -> Result { - let value = match &expression.kind { - ExprKind::Local(id) => path.locals.get(id).cloned().unwrap_or(Value::Opaque), - ExprKind::Record { fields } => { - let mut values = HashMap::new(); - for (label, field) in fields { - let value = self.eval(field, path)?; - if matches!(value, Value::Terminated) { - return Ok(value); - } - values.insert(label.clone(), value); - } - Value::Record(values) - } - ExprKind::FieldAccess { record, field } => match self.eval(record, path)? { - Value::Record(mut fields) => fields.remove(field).unwrap_or(Value::Opaque), - Value::Terminated => Value::Terminated, - _ => Value::Opaque, - }, - ExprKind::RecordUpdate { record, fields } => { - let value = self.eval(record, path)?; - if matches!(value, Value::Terminated) { - return Ok(value); - } - let mut values = match value { - Value::Record(values) => values, - _ => HashMap::new(), - }; - for (label, field) in fields { - let value = self.eval(field, path)?; - if matches!(value, Value::Terminated) { - return Ok(value); - } - values.insert(label.clone(), value); - } - Value::Record(values) - } - ExprKind::Application(function, argument) => { - let callable = self.eval(function, path)?; - if matches!(callable, Value::Terminated) { - return Ok(Value::Terminated); - } - let argument_value = self.eval(argument, path)?; - if matches!(argument_value, Value::Terminated) { - return Ok(argument_value); - } - if let Some(region) = crate::state::region(self.module, argument.ty) { - if !self.module.types_equivalent(region, self.region) { - return Err(self.error(argument.span, "state call mixes checked regions")); - } - // Use the instantiated final callable, not a declaration's - // uninstantiated variables or an action constructor name. - let signature = crate::state::signature(self.module, function.ty) - .map_err(|message| self.error(function.span, message))?; - if !signature.parameters.is_empty() { - return Err(self.error( - function.span, - "state call is not at its invocation boundary", - )); - } - let input = self.state_value(&argument_value, path, argument.span)?; - let output = if super::summary::passthrough(self.module, function) { - input - } else { - self.transition(expression, input, path)? - }; - Value::Record(HashMap::from([ - ("state".into(), Value::State(output)), - ("value".into(), Value::Opaque), - ])) - } else { - self.invoke_closure(callable, argument_value, path, expression.span)? - } - } - ExprKind::Let { bindings, body } => { - let previous = path.locals.clone(); - for binding in bindings { - let value = self.eval(&binding.value, path)?; - if matches!(value, Value::Terminated) { - return Ok(value); - } - path.locals.insert(binding.binder.id, value); - } - let value = self.eval(body, path)?; - path.locals = previous; - value - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - if matches!(self.eval(condition, path)?, Value::Terminated) { - return Ok(Value::Terminated); - } - return self.alternatives(&[then_branch, else_branch], path, expression.span); - } - ExprKind::Case { - scrutinee, - branches, - } => { - let value = self.eval(scrutinee, path)?; - if matches!(value, Value::Terminated) { - return Ok(value); - } - if branches.len() == 1 { - let previous = path.locals.clone(); - self.bind(&branches[0].pattern, value, path)?; - let value = self.eval(&branches[0].value, path)?; - path.locals = previous; - value - } else { - return self.case_alternatives(value, branches, path, expression.span); - } - } - ExprKind::Constructor { arguments, .. } => { - let mut values = Vec::new(); - for argument in arguments { - let value = self.eval(argument, path)?; - if matches!(value, Value::Terminated) { - return Ok(value); - } - values.push(value); - } - Value::Constructor(values) - } - ExprKind::RepresentationCast { value, .. } => { - // Checked casts retain provenance only for an equivalent - // State/record contract; arbitrary unsafe transport is not a - // source of a root dependency. - let evaluated = self.eval(value, path)?; - if matches!(evaluated, Value::Terminated) - || self.module.types_equivalent(value.ty, expression.ty) - { - evaluated - } else if evaluated.carries_state() { - return Err(self.error( - expression.span, - "state-carrying cast requires checked producer transport", - )); - } else { - Value::Opaque - } - } - ExprKind::IntrinsicCall { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => { - for argument in arguments { - let evaluated = self.eval(argument, path)?; - if matches!(evaluated, Value::Terminated) { - return Ok(Value::Terminated); - } - if evaluated.carries_state() { - return Err(self.error( - argument.span, - "state-carrying operand requires checked producer transport", - )); - } - } - Value::Opaque - } - ExprKind::Trap => Value::Terminated, - // Construction retains lexical producers but executes nothing. - ExprKind::Lambda { .. } => self.closure(expression, path), - _ => Value::Opaque, - }; - if crate::state::region(self.module, expression.ty).is_some() - && !matches!(value, Value::State(_) | Value::Terminated) - { - return Err(self.error( - expression.span, - "state value has no checked producer provenance", - )); - } - Ok(value) - } - - pub(super) fn bind( - &self, - pattern: &Pattern, - value: Value, - path: &mut Path, - ) -> Result<(), VerifyError> { - match &pattern.kind { - PatternKind::Var { id, .. } => { - path.locals.insert(*id, value); - } - PatternKind::Named { id, pattern } => { - path.locals.insert(*id, value.clone()); - self.bind(pattern, value, path)?; - } - PatternKind::Record { fields } => { - let Value::Record(values) = value else { - // Opaque ordinary records carry no state evidence. Any - // later State use must reject rather than assume a root. - for (_, field) in fields { - self.bind(field, Value::Opaque, path)?; - } - return Ok(()); - }; - for (label, field) in fields { - self.bind( - field, - values.get(label).cloned().unwrap_or(Value::Opaque), - path, - )?; - } - } - PatternKind::Constructor { arguments, .. } => { - let values = if let Value::Constructor(values) = value { - values - } else { - Vec::new() - }; - for (index, field) in arguments.iter().enumerate() { - self.bind( - field, - values.get(index).cloned().unwrap_or(Value::Opaque), - path, - )?; - } - } - PatternKind::Array { elements } => { - for field in elements { - self.bind(field, Value::Opaque, path)?; - } - } - _ => {} - } - Ok(()) - } -} diff --git a/crates/psrs-core/src/state/flow/mod.rs b/crates/psrs-core/src/state/flow/mod.rs deleted file mode 100644 index b8190924..00000000 --- a/crates/psrs-core/src/state/flow/mod.rs +++ /dev/null @@ -1,324 +0,0 @@ -//! Checked state flow produced from immutable source Core, before projection. -//! -//! Operation identities address actual call expressions in this arena. Each -//! state lambda supplies a parameter root; evaluation never invents a state. -use super::dependency::{Block, Dependency, DependencyId, Graph, RegionId, Terminator, Transition}; -use crate::{Expr, ExprKind, Module, TypeId, VerifyError}; -use psrs_hir::{LocalId, ModuleId}; -use psrs_span::TextRange; -use std::collections::HashMap; - -mod branches; -#[cfg(test)] -mod closure_tests; -mod closures; -mod eval; -mod scan; -mod summary; -#[cfg(test)] -mod tests; -mod verify; - -/// A source invocation and the dependency it consumes/produces on return. -#[derive(Debug)] -pub struct Operation<'a> { - pub expression: &'a Expr, - pub input: DependencyId, - pub output: DependencyId, -} - -/// Evidence for one lexical state-function body. Region IDs are local to this -/// function, while `region` retains its checked source type identity. -#[derive(Debug)] -pub struct FunctionFlow<'a> { - source: &'a Module, - pub owner: ModuleId, - pub lambda: &'a Expr, - pub region: TypeId, - pub graph: Graph, - pub operations: Vec>, -} - -/// Validate State-to-Step lambdas, including nested and uncalled library bodies. -/// Other raw-state callable/storage shapes still require a checked lowering -/// contract before projection; this does not publish evidence for those shapes. -/// Ordinary Core type and lexical-scope checks precede this state-flow check. -/// No source type, expression, or local identity is changed. -pub fn check(module: &Module) -> Result>, Vec> { - let mut flows = Vec::new(); - let mut errors = Vec::new(); - for declaration in &module.declarations { - scan::expression( - module, - declaration.symbol.module, - &declaration.value, - &mut flows, - &mut errors, - ); - } - if errors.is_empty() { - Ok(flows) - } else { - Err(errors) - } -} - -#[derive(Clone, Debug)] -enum Value { - Opaque, - State(DependencyId), - Record(HashMap), - Constructor(Vec), - Closure { - index: usize, - captures: HashMap, - }, - Terminated, -} - -impl Value { - fn carries_state(&self) -> bool { - match self { - Self::State(_) => true, - Self::Record(fields) => fields.values().any(Self::carries_state), - Self::Constructor(fields) => fields.iter().any(Self::carries_state), - Self::Closure { captures, .. } => captures.values().any(Self::carries_state), - Self::Opaque | Self::Terminated => false, - } - } - - fn state(&self) -> Option { - if let Self::State(id) = self { - Some(*id) - } else { - None - } - } - - fn remap(&mut self, old: DependencyId, new: DependencyId) { - match self { - Self::State(id) if *id == old => *id = new, - Self::Record(fields) => { - for field in fields.values_mut() { - field.remap(old, new); - } - } - Self::Constructor(fields) => { - for field in fields { - field.remap(old, new); - } - } - Self::Closure { captures, .. } => { - for value in captures.values_mut() { - value.remap(old, new); - } - } - _ => {} - } - } - - fn resolve(&mut self, path: &Path) { - match self { - Self::State(id) => *id = path.resolve(*id), - Self::Record(fields) => { - for field in fields.values_mut() { - field.resolve(path); - } - } - Self::Constructor(fields) => { - for field in fields { - field.resolve(path); - } - } - Self::Closure { captures, .. } => { - for value in captures.values_mut() { - value.resolve(path); - } - } - _ => {} - } - } -} - -#[derive(Clone)] -struct Path { - block: usize, - current: DependencyId, - revision: u32, - locals: HashMap, - /// Pure control-flow joins preserve the incoming dependency's meaning. - /// Edges always point to newer IDs, including aliases evaluated earlier. - aliases: HashMap, -} - -impl Path { - fn resolve(&self, mut id: DependencyId) -> DependencyId { - while let Some(next) = self.aliases.get(&id) { - debug_assert!(next.0 > id.0); - id = *next; - } - id - } -} - -struct Builder<'a> { - module: &'a Module, - owner: ModuleId, - region: TypeId, - next: u32, - blocks: Vec, - operations: Vec>, - closures: Vec<&'a Expr>, - active_closures: Vec, -} - -impl<'a> Builder<'a> { - fn fresh(&mut self) -> DependencyId { - let id = DependencyId(self.next); - self.next += 1; - id - } - - fn error(&self, span: TextRange, message: &'static str) -> VerifyError { - VerifyError { - module: self.owner, - span, - message, - } - } - - fn transition( - &mut self, - expression: &'a Expr, - input: DependencyId, - path: &mut Path, - ) -> Result { - if input != path.current { - return Err(self.error(expression.span, "state call consumes a stale dependency")); - } - let output = self.fresh(); - let operation = self.operations.len() as u32; - self.operations.push(Operation { - expression, - input, - output, - }); - self.blocks[path.block].transitions.push(Transition { - operation, - input, - output: Dependency { - id: output, - region: RegionId(0), - }, - span: expression.span, - }); - path.current = output; - path.revision += 1; - Ok(output) - } - - fn state_value( - &self, - value: &Value, - path: &Path, - span: TextRange, - ) -> Result { - value - .state() - .map(|id| path.resolve(id)) - .ok_or_else(|| self.error(span, "state value has no checked producer provenance")) - } - - fn returned(&self, value: &Value, path: &Path, span: TextRange) -> Result<(), VerifyError> { - let Value::Record(fields) = value else { - return Err(self.error(span, "state function result has no checked state field")); - }; - let state = fields - .get("state") - .and_then(Value::state) - .ok_or_else(|| self.error(span, "state return has no checked producer provenance"))?; - if path.resolve(state) != path.current { - return Err(self.error(span, "state return discards an executed operation")); - } - Ok(()) - } -} - -fn function<'a>( - module: &'a Module, - owner: ModuleId, - lambda: &'a Expr, -) -> Result, VerifyError> { - let flow = derive(module, owner, lambda)?; - flow.verify(module)?; - Ok(flow) -} - -fn derive<'a>( - module: &'a Module, - owner: ModuleId, - lambda: &'a Expr, -) -> Result, VerifyError> { - let ExprKind::Lambda { binder, body } = &lambda.kind else { - unreachable!() - }; - let region = super::region(module, binder.ty).expect("scan selected a checked State parameter"); - let (state, _) = super::step(module, body.ty).ok_or(VerifyError { - module: owner, - span: body.span, - message: "state function must return a closed state/value record", - })?; - if !module.types_equivalent(binder.ty, state) { - return Err(VerifyError { - module: owner, - span: body.span, - message: "state function returns a different region", - }); - } - let input = DependencyId(0); - let mut builder = Builder { - module, - owner, - region, - next: 1, - blocks: vec![Block { - id: 0, - parameters: vec![Dependency { - id: input, - region: RegionId(0), - }], - transitions: Vec::new(), - terminator: Terminator::Trap, - span: lambda.span, - }], - operations: Vec::new(), - closures: Vec::new(), - active_closures: Vec::new(), - }; - let mut path = Path { - block: 0, - current: input, - revision: 0, - locals: HashMap::from([(binder.id, Value::State(input))]), - aliases: HashMap::new(), - }; - let value = builder.eval(body, &mut path)?; - if !matches!(value, Value::Terminated) { - builder.returned(&value, &path, body.span)?; - builder.blocks[path.block].terminator = Terminator::Return(vec![path.current]); - } - let graph = Graph { - entry: 0, - regions: vec![RegionId(0)], - blocks: builder.blocks, - }; - let flow = FunctionFlow { - source: module, - owner, - lambda, - region, - graph, - operations: builder.operations, - }; - Ok(flow) -} diff --git a/crates/psrs-core/src/state/flow/scan.rs b/crates/psrs-core/src/state/flow/scan.rs deleted file mode 100644 index 1d1f7cfc..00000000 --- a/crates/psrs-core/src/state/flow/scan.rs +++ /dev/null @@ -1,78 +0,0 @@ -use super::{FunctionFlow, function}; -use crate::{Expr, ExprKind, Module, VerifyError}; -use psrs_hir::ModuleId; - -pub(super) fn expression<'a>( - module: &'a Module, - owner: ModuleId, - value: &'a Expr, - flows: &mut Vec>, - errors: &mut Vec, -) { - psrs_span::with_sufficient_stack(|| { - if let ExprKind::Lambda { binder, body } = &value.kind - && crate::state::region(module, binder.ty).is_some() - && crate::state::step(module, body.ty).is_some() - { - match function(module, owner, value) { - Ok(flow) => flows.push(flow), - Err(error) => errors.push(error), - } - } - let mut visit = |child| expression(module, owner, child, flows, errors); - match &value.kind { - ExprKind::Constructor { arguments, .. } - | ExprKind::IntrinsicCall { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => { - for argument in arguments { - visit(argument); - } - } - ExprKind::Record { fields } => { - for (_, field) in fields { - visit(field); - } - } - ExprKind::RecordUpdate { record, fields } => { - visit(record); - for (_, field) in fields { - visit(field); - } - } - ExprKind::FieldAccess { record, .. } - | ExprKind::RepresentationCast { value: record, .. } => visit(record), - ExprKind::Application(function, argument) => { - visit(function); - visit(argument); - } - ExprKind::Lambda { body, .. } => visit(body), - ExprKind::Let { bindings, body } => { - for binding in bindings { - visit(&binding.value); - } - visit(body); - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - visit(condition); - visit(then_branch); - visit(else_branch); - } - ExprKind::Case { - scrutinee, - branches, - } => { - visit(scrutinee); - for branch in branches { - visit(&branch.value); - } - } - _ => {} - } - }); -} diff --git a/crates/psrs-core/src/state/flow/summary.rs b/crates/psrs-core/src/state/flow/summary.rs deleted file mode 100644 index 542644ce..00000000 --- a/crates/psrs-core/src/state/flow/summary.rs +++ /dev/null @@ -1,66 +0,0 @@ -//! A deliberately small proof of an ordinary body's state pass-through. -//! Unknown/higher-order invocations remain observable, without name exceptions. -use crate::{Expr, ExprKind, Module}; - -pub(super) fn passthrough(module: &Module, callable: &Expr) -> bool { - let mut callable = callable; - loop { - match &callable.kind { - ExprKind::Application(function, _) => callable = function, - ExprKind::Global(symbol) => { - let Some(declaration) = module - .declarations - .iter() - .find(|value| value.symbol == *symbol) - else { - return false; - }; - return lambda(module, &declaration.value); - } - ExprKind::Lambda { .. } => return lambda(module, callable), - _ => return false, - } - } -} - -fn lambda(module: &Module, mut callable: &Expr) -> bool { - while let ExprKind::Lambda { binder, body } = &callable.kind { - if crate::state::region(module, binder.ty).is_some() { - return crate::state::step(module, body.ty).is_some() && inert(body); - } - callable = body; - } - false -} - -fn inert(value: &Expr) -> bool { - psrs_span::with_sufficient_stack(|| match &value.kind { - ExprKind::Local(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::Boolean(_) - | ExprKind::String(_) - | ExprKind::Char(_) - | ExprKind::Unit - | ExprKind::Lambda { .. } => true, - ExprKind::Record { fields } => fields.iter().all(|(_, value)| inert(value)), - ExprKind::FieldAccess { record, .. } => inert(record), - ExprKind::Constructor { arguments, .. } - | ExprKind::Array { - elements: arguments, - } => arguments.iter().all(inert), - ExprKind::Let { bindings, body } => { - bindings.iter().all(|binding| inert(&binding.value)) && inert(body) - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => inert(condition) && inert(then_branch) && inert(else_branch), - ExprKind::Case { - scrutinee, - branches, - } => inert(scrutinee) && branches.iter().all(|branch| inert(&branch.value)), - _ => false, - }) -} diff --git a/crates/psrs-core/src/state/flow/tests.rs b/crates/psrs-core/src/state/flow/tests.rs deleted file mode 100644 index a615d0b7..00000000 --- a/crates/psrs-core/src/state/flow/tests.rs +++ /dev/null @@ -1,450 +0,0 @@ -use super::*; -use crate::{Binder, Binding, CaseBranch, Declaration, Pattern, PatternKind}; -use psrs_hir::{CaseBranchCoverage, LocalId, SymbolId}; - -pub(super) fn value(kind: ExprKind, ty: u32) -> Expr { - Expr { - kind, - ty: TypeId(ty), - span: TextRange::new(10, 20), - } -} -pub(super) fn local(id: u32, ty: u32) -> Expr { - value(ExprKind::Local(LocalId(id)), ty) -} -pub(super) fn step(state: Expr) -> Expr { - value( - ExprKind::Record { - fields: vec![ - ("state".into(), state), - ("value".into(), value(ExprKind::Integer(42), 3)), - ], - }, - 8, - ) -} -pub(super) fn binder(id: u32, ty: u32) -> Binder { - Binder { - id: LocalId(id), - name: format!("v{id}"), - ty: TypeId(ty), - span: TextRange::new(10, 20), - } -} -fn action(body: Expr) -> Expr { - value( - ExprKind::Lambda { - binder: binder(0, 2), - body: Box::new(body), - }, - 11, - ) -} -pub(super) fn invocation(input: Expr) -> Expr { - value( - ExprKind::Application(Box::new(local(1, 11)), Box::new(input)), - 8, - ) -} -pub(super) fn field(id: u32) -> Expr { - value( - ExprKind::FieldAccess { - record: Box::new(local(id, 8)), - field: "state".into(), - }, - 2, - ) -} -pub(super) fn let_value(id: u32, expression: Expr, body: Expr) -> Expr { - let ty = expression.ty.0; - let result = body.ty.0; - value( - ExprKind::Let { - bindings: vec![Binding { - binder: binder(id, ty), - quantified: Vec::new(), - span: expression.span, - value: expression, - }], - body: Box::new(body), - }, - result, - ) -} -pub(super) fn fixture(body: Expr) -> Module { - let mut module = crate::state::tests::fixture(); - module - .types - .push(crate::Type::Constructor(crate::TypeConstructor::Boolean)); - module - .types - .push(crate::Type::Application(TypeId(9), TypeId(11))); - module - .types - .push(crate::Type::Application(TypeId(13), TypeId(11))); - let action = action(body); - let body = value( - ExprKind::Lambda { - binder: binder(1, 11), - body: Box::new(action), - }, - 14, - ); - module.declarations.push(Declaration { - symbol: SymbolId::new(ModuleId(0), 0), - name: "action".into(), - name_span: body.span, - quantified: Vec::new(), - ty: TypeId(14), - span: body.span, - value: body, - }); - module -} - -#[test] -fn pure_return_uses_the_lambda_parameter_without_inventing_a_root() { - let module = fixture(step(local(0, 2))); - let flows = check(&module).unwrap(); - assert_eq!(flows.len(), 1); - assert!(flows[0].operations.is_empty()); - assert_eq!( - flows[0].graph.blocks[0].terminator, - Terminator::Return(vec![DependencyId(0)]) - ); -} - -#[test] -fn actual_calls_supply_successors_and_aliases_retain_their_producers() { - let body = let_value( - 2, - invocation(local(0, 2)), - let_value(3, invocation(field(2)), step(field(3))), - ); - let module = fixture(body); - let flows = check(&module).unwrap(); - let flow = &flows[0]; - assert_eq!(flow.operations.len(), 2); - assert_eq!(flow.operations[0].input, DependencyId(0)); - assert_eq!(flow.operations[1].input, flow.operations[0].output); - assert!( - flow.operations - .iter() - .all(|operation| matches!(operation.expression.kind, ExprKind::Application(..))) - ); - assert_eq!(flow.graph.blocks[0].transitions.len(), 2); -} - -#[test] -fn fixed_arity_state_invocation_retains_its_actual_operation_dependency() { - let mut module = fixture(invocation(local(0, 2))); - module.types[11] = crate::Type::Closure { - parameters: vec![TypeId(2)], - result: TypeId(8), - }; - module.verify().unwrap(); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 1); - assert_eq!(flows[0].operations[0].input, DependencyId(0)); - assert_eq!( - flows[0].graph.blocks[0].terminator, - Terminator::Return(vec![flows[0].operations[0].output]) - ); -} - -#[test] -fn discarded_payload_does_not_allow_discarding_a_state_operation() { - let module = fixture(let_value(2, invocation(local(0, 2)), step(local(0, 2)))); - let errors = check(&module).unwrap_err(); - assert_eq!( - errors[0].message, - "state return discards an executed operation" - ); -} - -#[test] -fn repeated_use_of_an_observable_predecessor_is_rejected() { - let module = fixture(let_value( - 2, - invocation(local(0, 2)), - let_value(3, invocation(local(0, 2)), step(field(3))), - )); - assert_eq!( - check(&module).unwrap_err()[0].message, - "state call consumes a stale dependency" - ); -} - -#[test] -fn branch_exclusive_calls_transfer_the_executed_successor_to_a_join() { - let body = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(invocation(local(0, 2))), - else_branch: Box::new(invocation(local(0, 2))), - }, - 8, - ); - let module = fixture(body); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 2); - assert_eq!(flows[0].graph.blocks.len(), 4); - flows[0].graph.verify().unwrap(); -} - -#[test] -fn a_pure_branch_join_preserves_incoming_state_aliases() { - let choice = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(value(ExprKind::Integer(1), 3)), - else_branch: Box::new(value(ExprKind::Integer(2), 3)), - }, - 3, - ); - let module = fixture(let_value(2, choice, step(local(0, 2)))); - module.verify().unwrap(); - assert!(check(&module).unwrap()[0].operations.is_empty()); -} - -#[test] -fn a_trapping_branch_has_no_normal_successor() { - let choice = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(invocation(local(0, 2))), - else_branch: Box::new(value(ExprKind::Trap, 8)), - }, - 8, - ); - let module = fixture(choice); - module.verify().unwrap(); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 1); - assert!( - flows[0] - .graph - .blocks - .iter() - .any(|block| block.terminator == Terminator::Trap) - ); -} - -#[test] -fn a_stale_return_on_one_branch_is_not_hidden_by_a_valid_other_branch() { - let choice = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(let_value(2, invocation(local(0, 2)), step(local(0, 2)))), - else_branch: Box::new(step(local(0, 2))), - }, - 8, - ); - assert!(check(&fixture(choice)).is_err()); -} - -#[test] -fn a_record_pattern_retains_the_called_operations_successor() { - let module = fixture(value( - ExprKind::Case { - scrutinee: Box::new(invocation(local(0, 2))), - branches: vec![CaseBranch { - pattern: Pattern { - ty: TypeId(8), - span: TextRange::new(10, 20), - kind: PatternKind::Record { - fields: vec![( - "state".into(), - Pattern { - ty: TypeId(2), - span: TextRange::new(10, 20), - kind: PatternKind::Var { - id: LocalId(2), - ty: TypeId(2), - }, - }, - )], - }, - }, - value: step(local(2, 2)), - span: TextRange::new(10, 20), - coverage: CaseBranchCoverage::Source, - }], - }, - 8, - )); - module.verify().unwrap(); - assert_eq!(check(&module).unwrap()[0].operations.len(), 1); -} - -#[test] -fn core_verification_rejects_a_well_typed_but_stale_state_return() { - let module = fixture(let_value(2, invocation(local(0, 2)), step(local(0, 2)))); - let errors = module.verify().unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message == "state return discards an executed operation") - ); - assert!(errors.iter().all(|error| error.module == ModuleId(0))); -} - -#[test] -fn state_values_cannot_be_fabricated_by_unknown_payloads() { - let mut module = fixture(step(local(4, 2))); - // Producer validation is also callable independently of ordinary typing; - // a dangling local must not acquire a fresh state root. - assert_eq!( - check(&module).unwrap_err()[0].message, - "state value has no checked producer provenance" - ); - module.declarations.clear(); - assert!(check(&module).unwrap().is_empty()); -} - -#[test] -fn a_structurally_valid_graph_cannot_omit_real_source_invocations() { - let module = fixture(invocation(local(0, 2))); - let mut flows = check(&module).unwrap(); - let flow = &mut flows[0]; - flow.operations.clear(); - flow.graph.blocks[0].transitions.clear(); - flow.graph.blocks[0].terminator = Terminator::Return(vec![DependencyId(0)]); - flow.graph.verify().unwrap(); - assert_eq!( - flow.verify(&module).unwrap_err().message, - "state graph changes executing source invocation order or coverage" - ); -} - -#[test] -fn a_structurally_valid_graph_cannot_reorder_real_source_invocations() { - let module = fixture(let_value(2, invocation(local(0, 2)), invocation(field(2)))); - let mut flows = check(&module).unwrap(); - let flow = &mut flows[0]; - let first = flow.operations[0].expression; - flow.operations[0].expression = flow.operations[1].expression; - flow.operations[1].expression = first; - flow.graph.verify().unwrap(); - assert_eq!( - flow.verify(&module).unwrap_err().message, - "state graph changes executing source invocation order or coverage" - ); -} - -#[test] -fn source_evidence_cannot_be_reused_with_a_different_arena() { - let module = fixture(invocation(local(0, 2))); - let flows = check(&module).unwrap(); - let other = module.clone(); - assert_eq!( - flows[0].verify(&other).unwrap_err().message, - "state flow belongs to a different source arena" - ); -} - -#[test] -fn unreachable_calls_after_a_trap_do_not_create_successors() { - let module = fixture(let_value( - 2, - value(ExprKind::Trap, 3), - invocation(local(0, 2)), - )); - module.verify().unwrap(); - let flows = check(&module).unwrap(); - assert!(flows[0].operations.is_empty()); - assert_eq!(flows[0].graph.blocks[0].terminator, Terminator::Trap); -} - -#[test] -fn a_proven_pure_state_body_may_return_its_incoming_state_unchanged() { - let pure = value( - ExprKind::Lambda { - binder: binder(5, 2), - body: Box::new(step(local(5, 2))), - }, - 11, - ); - let call = value( - ExprKind::Application(Box::new(pure), Box::new(local(0, 2))), - 8, - ); - let module = fixture(let_value(2, call, step(local(0, 2)))); - module.verify().unwrap(); - assert!( - check(&module) - .unwrap() - .iter() - .all(|flow| flow.operations.is_empty()) - ); -} - -#[test] -fn an_invocation_after_a_branch_uses_the_selected_successor() { - let branch = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(invocation(local(0, 2))), - else_branch: Box::new(invocation(local(0, 2))), - }, - 8, - ); - let module = fixture(let_value(2, branch, invocation(field(2)))); - module.verify().unwrap(); - let flows = check(&module).unwrap(); - assert_eq!(flows[0].operations.len(), 3); - assert_eq!(flows[0].graph.blocks.last().unwrap().transitions.len(), 1); -} - -#[test] -fn a_valid_graph_cannot_move_a_call_to_the_other_source_branch() { - let body = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(invocation(local(0, 2))), - else_branch: Box::new(invocation(local(0, 2))), - }, - 8, - ); - let module = fixture(body); - let mut flows = check(&module).unwrap(); - let flow = &mut flows[0]; - let left = flow.graph.blocks[1].transitions.remove(0); - let right = flow.graph.blocks[2].transitions.remove(0); - flow.graph.blocks[1].transitions.push(right); - flow.graph.blocks[2].transitions.push(left); - for index in [1, 2] { - let block = &mut flow.graph.blocks[index]; - let transition = &mut block.transitions[0]; - transition.input = block.parameters[0].id; - flow.operations[transition.operation as usize].input = transition.input; - let Terminator::Jump(edge) = &mut block.terminator else { - unreachable!() - }; - edge.arguments[0] = transition.output.id; - } - flow.graph.verify().unwrap(); - assert_eq!( - flow.verify(&module).unwrap_err().message, - "state graph changes source dependency provenance or control flow" - ); -} - -#[test] -fn a_pure_payload_branch_keeps_a_previously_evaluated_state_field_valid() { - let payload = value( - ExprKind::If { - condition: Box::new(value(ExprKind::Boolean(true), 12)), - then_branch: Box::new(value(ExprKind::Integer(1), 3)), - else_branch: Box::new(value(ExprKind::Integer(2), 3)), - }, - 3, - ); - let module = fixture(value( - ExprKind::Record { - fields: vec![("state".into(), local(0, 2)), ("value".into(), payload)], - }, - 8, - )); - module.verify().unwrap(); -} diff --git a/crates/psrs-core/src/state/flow/verify.rs b/crates/psrs-core/src/state/flow/verify.rs deleted file mode 100644 index 7bcfa41f..00000000 --- a/crates/psrs-core/src/state/flow/verify.rs +++ /dev/null @@ -1,136 +0,0 @@ -use super::{FunctionFlow, Operation, RegionId}; -use crate::{Expr, ExprKind, Module, VerifyError}; -use std::collections::HashSet; - -impl FunctionFlow<'_> { - /// Check both graph validity and its correspondence to this immutable body. - /// A structurally valid graph alone is not a certificate for source calls. - pub fn verify(&self, module: &Module) -> Result<(), VerifyError> { - let fail = |span, message| VerifyError { - module: self.owner, - span, - message, - }; - if !std::ptr::eq(self.source, module) { - return Err(fail( - self.lambda.span, - "state flow belongs to a different source arena", - )); - } - self.graph - .verify() - .map_err(|error| fail(error.span, error.message))?; - let ExprKind::Lambda { binder, .. } = &self.lambda.kind else { - return Err(fail(self.lambda.span, "state flow has no source lambda")); - }; - let region = crate::state::region(module, binder.ty) - .ok_or_else(|| fail(binder.span, "state flow parameter has no checked region"))?; - if !module.types_equivalent(region, self.region) { - return Err(fail(binder.span, "state flow changes its source region")); - } - if self.graph.regions != [RegionId(0)] { - return Err(fail( - binder.span, - "state graph changes its checked source region mapping", - )); - } - // The source evaluator owns callback execution scopes and order. - // Re-derive before checking a witness; a syntax walk cannot distinguish - // closure construction from invocation through a lexical alias. - let expected = super::derive(module, self.owner, self.lambda)?; - let invocations = expected - .operations - .iter() - .map(|operation| operation.expression as *const Expr) - .collect::>(); - let expressions = invocations.iter().copied().collect::>(); - let mut seen = HashSet::new(); - for block in &self.graph.blocks { - for transition in &block.transitions { - let operation = self - .operations - .get(transition.operation as usize) - .ok_or_else(|| { - fail(transition.span, "state transition has no source operation") - })?; - if !seen.insert(transition.operation) - || operation.input != transition.input - || operation.output != transition.output.id - || operation.expression.span != transition.span - { - return Err(fail( - transition.span, - "state transition disagrees with its source operation", - )); - } - self.verify_operation(module, operation, &expressions)?; - } - } - if seen.len() != self.operations.len() { - return Err(fail( - self.lambda.span, - "state graph omits a checked source operation", - )); - } - let actual = self - .operations - .iter() - .map(|operation| operation.expression as *const Expr) - .collect::>(); - if actual != invocations { - return Err(fail( - self.lambda.span, - "state graph changes executing source invocation order or coverage", - )); - } - // Re-derive the source relation so matching call identities alone - // cannot authorize different argument provenance or branch placement. - // A transformed IR needs its own correspondence verifier; it cannot - // mutate this source certificate and retain a checked claim. - if self.graph != expected.graph { - return Err(fail( - self.lambda.span, - "state graph changes source dependency provenance or control flow", - )); - } - Ok(()) - } - - fn verify_operation( - &self, - module: &Module, - operation: &Operation<'_>, - expressions: &HashSet<*const Expr>, - ) -> Result<(), VerifyError> { - let expression = operation.expression; - let fail = |message| VerifyError { - module: self.owner, - span: expression.span, - message, - }; - if !expressions.contains(&(expression as *const Expr)) { - return Err(fail( - "state operation does not belong to its executing source body", - )); - } - let ExprKind::Application(function, argument) = &expression.kind else { - return Err(fail( - "state transition does not address an actual invocation", - )); - }; - let signature = crate::state::signature(module, function.ty).map_err(fail)?; - let (state, payload) = crate::state::step(module, expression.ty) - .ok_or_else(|| fail("state operation result has no checked Step contract"))?; - if !signature.parameters.is_empty() - || !module.types_equivalent(signature.region, self.region) - || !module.types_equivalent(signature.state, argument.ty) - || !module.types_equivalent(signature.state, state) - || !module.types_equivalent(signature.payload, payload) - { - return Err(fail( - "state operation disagrees with its checked invocation contract", - )); - } - Ok(()) - } -} diff --git a/crates/psrs-core/src/state/mod.rs b/crates/psrs-core/src/state/mod.rs deleted file mode 100644 index c7614c95..00000000 --- a/crates/psrs-core/src/state/mod.rs +++ /dev/null @@ -1,76 +0,0 @@ -//! Shared source contracts for state-transforming callables. -//! -//! These contracts refer only to registered primitive identities and checked -//! structural records. They do not recognize a library's action constructor. -use crate::{Module, Type, TypeConstructor, TypeId, call_parts, row_fields}; -use psrs_hir::TypeId as HirTypeId; - -pub mod dependency; -pub mod flow; -pub mod primitive; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct StateSignature { - /// Ordinary arguments evaluated before the final state invocation. - pub parameters: Vec, - pub state: TypeId, - pub region: TypeId, - pub payload: TypeId, -} - -/// Reads State's exactly one nominal region argument. A dangling or unsaturated -/// application is not a valid state value. -pub fn region(module: &Module, ty: TypeId) -> Option { - let (head, arguments) = module.applied_constructor(ty)?; - if head != TypeConstructor::User(HirTypeId::PRIM_STATE) || arguments.len() != 1 { - return None; - } - Some(arguments[0]) -} - -/// Reads the complete structural Step contract, rejecting open rows, duplicate -/// fields, extra fields and state/region mismatch. -pub fn step(module: &Module, ty: TypeId) -> Option<(TypeId, TypeId)> { - let Type::Application(head, row) = module.types.get(ty.0 as usize)? else { - return None; - }; - if module.types.get(head.0 as usize) != Some(&Type::Constructor(TypeConstructor::Record)) { - return None; - } - let (fields, tail) = row_fields(&module.types, *row)?; - if tail.is_some() || fields.len() != 2 { - return None; - } - let state = fields.iter().find(|(name, _)| name == "state")?.1; - let payload = fields.iter().find(|(name, _)| name == "value")?.1; - region(module, state)?; - Some((state, payload)) -} - -/// Validates an ordinary checked function's state input and result. No source -/// constructor or module name is interpreted as evidence. -pub fn signature(module: &Module, ty: TypeId) -> Result { - let (parameters, result) = call_parts(&module.types, ty)?; - for (index, parameter) in parameters.iter().copied().enumerate() { - if let Some(region) = region(module, parameter) { - if index + 1 != parameters.len() { - return Err("state invocation parameter must be last in its call boundary"); - } - let (result_state, payload) = step(module, result) - .ok_or("state function must return a closed state/value record")?; - if !module.types_equivalent(parameter, result_state) { - return Err("state function returns a different region"); - } - return Ok(StateSignature { - parameters: parameters[..index].to_vec(), - state: parameter, - region, - payload, - }); - } - } - Err("state function has no state invocation parameter") -} - -#[cfg(test)] -mod tests; diff --git a/crates/psrs-core/src/state/primitive.rs b/crates/psrs-core/src/state/primitive.rs deleted file mode 100644 index bca227f1..00000000 --- a/crates/psrs-core/src/state/primitive.rs +++ /dev/null @@ -1,73 +0,0 @@ -//! Type contracts for checked state primitives before representation erasure. -use super::signature; -use crate::{Module, Type, TypeConstructor, TypeId, scheme_parts}; -use psrs_hir::{Intrinsic, StateOperation, TypeId as HirTypeId}; -use std::collections::HashSet; - -pub fn verify( - module: &Module, - intrinsic: Intrinsic, - arguments: &[TypeId], - result: TypeId, -) -> Result<(), &'static str> { - let operation = intrinsic - .state_operation() - .ok_or("operation has no state contract")?; - if arguments.len() != intrinsic.descriptor().arity as usize { - return Err("state primitive has an invalid argument count"); - } - let checked = signature(module, arguments[0])?; - if !checked.parameters.is_empty() || !module.types_equivalent(checked.payload, result) { - return Err("state runner has an invalid callable payload"); - } - match operation { - StateOperation::RunWorld => { - if module.types.get(checked.region.0 as usize) - != Some(&Type::Constructor(TypeConstructor::User( - HirTypeId::PRIM_REAL_WORLD, - ))) - { - return Err("world runner requires the RealWorld region"); - } - } - StateOperation::RunRegion => { - let (variables, _) = scheme_parts(&module.types, arguments[0]) - .ok_or("region runner has an invalid quantified callable")?; - let Some(Type::Variable(region)) = module.types.get(checked.region.0 as usize) else { - return Err("region runner requires a quantified region"); - }; - if variables.as_slice() != [*region] { - return Err("region runner requires exactly one fresh region binder"); - } - if mentions(module, checked.payload, checked.region, &mut HashSet::new()) { - return Err("region runner result escapes its region"); - } - } - } - Ok(()) -} - -fn mentions(module: &Module, ty: TypeId, region: TypeId, seen: &mut HashSet) -> bool { - if !seen.insert(ty) { - return false; - } - if module.types_equivalent(ty, region) { - return true; - } - match module.types.get(ty.0 as usize) { - Some(Type::Application(head, argument)) => { - mentions(module, *head, region, seen) || mentions(module, *argument, region, seen) - } - Some(Type::RowExtend { ty, tail, .. }) => { - mentions(module, *ty, region, seen) || mentions(module, *tail, region, seen) - } - Some(Type::ForAll { body, .. }) => mentions(module, *body, region, seen), - Some(Type::Closure { parameters, result }) => { - parameters - .iter() - .any(|ty| mentions(module, *ty, region, seen)) - || mentions(module, *result, region, seen) - } - _ => false, - } -} diff --git a/crates/psrs-core/src/state/tests.rs b/crates/psrs-core/src/state/tests.rs deleted file mode 100644 index cfcf8f6d..00000000 --- a/crates/psrs-core/src/state/tests.rs +++ /dev/null @@ -1,270 +0,0 @@ -use super::*; -use psrs_hir::{ModuleId, TypeVariableId}; -use psrs_span::TextRange; - -pub(super) fn fixture() -> Module { - Module { - id: ModuleId(0), - name: "UnrelatedStateLibrary".into(), - externals: Vec::new(), - external_types: Vec::new(), - types: vec![ - Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_STATE)), - Type::Constructor(TypeConstructor::User(HirTypeId::PRIM_REAL_WORLD)), - Type::Application(TypeId(0), TypeId(1)), - Type::Constructor(TypeConstructor::Int), - Type::RowEmpty, - Type::RowExtend { - label: "value".into(), - ty: TypeId(3), - tail: TypeId(4), - }, - Type::RowExtend { - label: "state".into(), - ty: TypeId(2), - tail: TypeId(5), - }, - Type::Constructor(TypeConstructor::Record), - Type::Application(TypeId(7), TypeId(6)), - Type::Constructor(TypeConstructor::Function), - Type::Application(TypeId(9), TypeId(2)), - Type::Application(TypeId(10), TypeId(8)), - ], - newtype_ids: Vec::new(), - opaque_ids: Vec::new(), - callable_types: Vec::new(), - constructors: Vec::new(), - declarations: Vec::new(), - type_names: Vec::new(), - entry: None, - span: TextRange::new(0, 0), - } -} - -#[test] -fn registered_state_identity_needs_no_effect_or_library_name() { - let module = fixture(); - let signature = signature(&module, TypeId(11)).unwrap(); - assert_eq!(signature.region, TypeId(1)); - assert_eq!(signature.payload, TypeId(3)); - assert!(signature.parameters.is_empty()); -} - -#[test] -fn fixed_arity_state_closure_preserves_its_payload_boundary() { - let mut module = fixture(); - module.types.push(Type::Application(TypeId(9), TypeId(3))); - module.types.push(Type::Application(TypeId(12), TypeId(3))); - let Type::RowExtend { ty, .. } = &mut module.types[5] else { - unreachable!() - }; - *ty = TypeId(13); - module.types.push(Type::Closure { - parameters: vec![TypeId(3), TypeId(2)], - result: TypeId(8), - }); - let checked = signature(&module, TypeId(14)).unwrap(); - assert_eq!(checked.parameters, [TypeId(3)]); - assert_eq!(checked.state, TypeId(2)); - assert_eq!(checked.payload, TypeId(13)); -} - -#[test] -fn function_payload_is_not_an_extra_action_parameter() { - let mut module = fixture(); - module.types.push(Type::Application(TypeId(9), TypeId(3))); - module.types.push(Type::Application(TypeId(12), TypeId(3))); - let Type::RowExtend { ty, .. } = &mut module.types[5] else { - unreachable!() - }; - *ty = TypeId(13); - let signature = signature(&module, TypeId(11)).unwrap(); - assert_eq!(signature.payload, TypeId(13)); - assert!(signature.parameters.is_empty()); -} - -#[test] -fn step_requires_a_closed_complete_structural_contract() { - let mut module = fixture(); - module.types[4] = Type::Variable(TypeVariableId(7)); - assert!(step(&module, TypeId(8)).is_none()); - module.types[4] = Type::RowExtend { - label: "extra".into(), - ty: TypeId(3), - tail: TypeId(4), - }; - assert!( - step(&module, TypeId(8)).is_none(), - "cyclic rows must terminate with rejection" - ); - module.types[4] = Type::RowEmpty; - let Type::RowExtend { label, .. } = &mut module.types[5] else { - unreachable!() - }; - *label = "state".into(); - assert!( - step(&module, TypeId(8)).is_none(), - "duplicate labels cannot supply the payload" - ); -} - -#[test] -fn state_result_must_preserve_the_nominal_region() { - let mut module = fixture(); - module.types.push(Type::Variable(TypeVariableId(8))); - module.types.push(Type::Application(TypeId(0), TypeId(12))); - let Type::RowExtend { ty, .. } = &mut module.types[6] else { - unreachable!() - }; - *ty = TypeId(13); - assert_eq!( - signature(&module, TypeId(11)).unwrap_err(), - "state function returns a different region" - ); -} - -#[test] -fn an_unrelated_opaque_constructor_is_not_state() { - let mut module = fixture(); - module.types[0] = Type::Constructor(TypeConstructor::User(HirTypeId::new(ModuleId(3), 0))); - assert!(signature(&module, TypeId(11)).is_err()); -} - -#[test] -fn a_world_runner_checks_both_the_payload_and_the_region() { - let mut module = fixture(); - primitive::verify( - &module, - psrs_hir::Intrinsic::RunWorld, - &[TypeId(11)], - TypeId(3), - ) - .unwrap(); - assert!( - primitive::verify( - &module, - psrs_hir::Intrinsic::RunWorld, - &[TypeId(11)], - TypeId(2) - ) - .is_err() - ); - module.types[1] = Type::Variable(TypeVariableId(8)); - assert_eq!( - primitive::verify( - &module, - psrs_hir::Intrinsic::RunWorld, - &[TypeId(11)], - TypeId(3) - ) - .unwrap_err(), - "world runner requires the RealWorld region" - ); -} - -#[test] -fn a_region_runner_requires_rank_n_and_rejects_escape() { - let mut module = fixture(); - module.types[1] = Type::Variable(TypeVariableId(8)); - assert!( - primitive::verify( - &module, - psrs_hir::Intrinsic::RunRegion, - &[TypeId(11)], - TypeId(3) - ) - .is_err() - ); - module.types.push(Type::ForAll { - variables: vec![TypeVariableId(8)], - body: TypeId(11), - }); - primitive::verify( - &module, - psrs_hir::Intrinsic::RunRegion, - &[TypeId(12)], - TypeId(3), - ) - .unwrap(); - let Type::RowExtend { ty, .. } = &mut module.types[5] else { - unreachable!() - }; - *ty = TypeId(2); - assert_eq!( - primitive::verify( - &module, - psrs_hir::Intrinsic::RunRegion, - &[TypeId(12)], - TypeId(2) - ) - .unwrap_err(), - "region runner result escapes its region" - ); -} - -#[test] -fn core_verification_checks_the_world_runner_contract() { - use crate::{Binder, Declaration, Expr, ExprKind}; - use psrs_hir::{Intrinsic, LocalId, SymbolId}; - let mut module = fixture(); - let span = TextRange::new(0, 10); - let action = Expr { - ty: TypeId(11), - span, - kind: ExprKind::Lambda { - binder: Binder { - id: LocalId(0), - name: "state".into(), - ty: TypeId(2), - span, - }, - body: Box::new(Expr { - ty: TypeId(8), - span, - kind: ExprKind::Record { - fields: vec![ - ( - "state".into(), - Expr { - kind: ExprKind::Local(LocalId(0)), - ty: TypeId(2), - span, - }, - ), - ( - "value".into(), - Expr { - kind: ExprKind::Integer(42), - ty: TypeId(3), - span, - }, - ), - ], - }, - }), - }, - }; - module.declarations.push(Declaration { - symbol: SymbolId::new(ModuleId(0), 0), - name: "main".into(), - name_span: span, - quantified: Vec::new(), - ty: TypeId(3), - span, - value: crate::primitive::primitive_value( - Intrinsic::RunWorld, - vec![action], - TypeId(3), - span, - ), - }); - module.verify().unwrap(); - module.types[1] = Type::Constructor(TypeConstructor::Int); - let errors = module.verify().unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message == "world runner requires the RealWorld region"), - "{errors:?}" - ); -} diff --git a/crates/psrs-core/src/tests/effects.rs b/crates/psrs-core/src/tests/effects.rs deleted file mode 100644 index fc8c652a..00000000 --- a/crates/psrs-core/src/tests/effects.rs +++ /dev/null @@ -1,269 +0,0 @@ -//! Fixtures for the effect representation closures written by `lower_effects`. -//! -//! The pass is the only one that recognizes the opaque `Prelude.Effect` -//! application, so it also owns the check that every closure it wrote takes the -//! runtime token alone and returns the lowered effect result. - -use super::*; -use crate::effect::{EffectClosure, TrustedEffect, classify_effect_import, lower_effects}; -use psrs_hir::{ModuleId, SymbolId, TypeId as HirTypeId, TypeVariableId}; - -const SPAN: TextRange = TextRange::new(0, 8); - -const TOKEN: TypeId = TypeId(0); -const A: TypeId = TypeId(1); -const B: TypeId = TypeId(2); -const ARROW: TypeId = TypeId(5); -const EFFECT: TypeId = TypeId(6); -const EFFECT_APPLICATION: TypeId = TypeId(7); -const EFFECT_HIR: HirTypeId = HirTypeId::new(ModuleId(0), 3); - -fn trusted_effect() -> TrustedEffect { - TrustedEffect { - effect_type: EFFECT_HIR, - operations: Vec::new(), - } -} - -/// A linked module whose only effect is `Effect (a -> b)`. -/// -/// Its type table is -/// -/// | id | node | -/// | --- | --- | -/// | 0 | the opaque state token, the representation lowering chose | -/// | 1, 2 | `a`, `b` | -/// | 3, 4, 5 | `a -> b` | -/// | 6 | `Prelude.Effect` | -/// | 7 | `Effect (a -> b)`, the node lowering replaces | -fn effect_module() -> Module { - let effect = EFFECT_HIR; - let token = HirTypeId::STATE_TOKEN; - Module { - id: ModuleId(0), - name: "Main".into(), - externals: Vec::new(), - external_types: Vec::new(), - types: vec![ - Type::Constructor(TypeConstructor::User(token)), - Type::Variable(TypeVariableId(0)), - Type::Variable(TypeVariableId(1)), - Type::Constructor(TypeConstructor::Function), - Type::Application(TypeId(3), A), - Type::Application(TypeId(4), B), - Type::Constructor(TypeConstructor::User(effect)), - Type::Application(EFFECT, ARROW), - ], - newtype_ids: Vec::new(), - opaque_ids: vec![effect, token], - callable_types: Vec::new(), - constructors: Vec::new(), - declarations: Vec::new(), - type_names: vec![(effect, "Prelude.Effect".into())], - entry: Some(SymbolId::new(ModuleId(0), 0)), - span: SPAN, - } -} - -/// `Effect (a -> b)` lowers to one token parameter and keeps `a -> b` whole as -/// its result, so the accepted path stays accepted. -#[test] -fn lowered_effect_closures_are_one_token_closure_over_the_effect_result() { - let mut module = effect_module(); - let lowering = - lower_effects(&mut module, &trusted_effect()).expect("the written closure keeps its shape"); - assert_eq!( - lowering.closures, - vec![EffectClosure { - ty: EFFECT_APPLICATION, - token: TOKEN, - result: ARROW, - }] - ); - assert_eq!( - closure_parts(&module.types, EFFECT_APPLICATION), - Some(([TOKEN].as_slice(), ARROW)), - "Effect (a -> b) takes the token alone and returns the function whole" - ); - assert!(lowering.verify(&module).is_ok()); - assert!( - module.verify().is_ok(), - "{:?}", - module.verify().unwrap_err() - ); -} - -/// The negative fixture the obligation names: the closure for `Effect (a -> b)` -/// flattened to two parameters `[Token, a]` is not a representation closure. -/// The general Core verifier accepts that type table, so the rejection is this -/// pass's own check and it happens before closure conversion. -#[test] -fn a_lowered_effect_closure_flattened_to_arity_two_is_rejected() { - let mut module = effect_module(); - let lowering = lower_effects(&mut module, &trusted_effect()) - .expect("the written closure starts in its shape"); - module.types[EFFECT_APPLICATION.0 as usize] = Type::Closure { - parameters: vec![TOKEN, A], - result: ARROW, - }; - assert!( - module.verify().is_ok(), - "{:?}", - module.verify().unwrap_err() - ); - assert_eq!( - messages(lowering.verify(&module)), - ["a lowered effect closure must take only the runtime token"] - ); -} - -/// A closure that takes the token but returns something other than the lowered -/// effect result is not a representation closure either. -#[test] -fn a_lowered_effect_closure_with_the_wrong_result_is_rejected() { - let mut module = effect_module(); - let lowering = lower_effects(&mut module, &trusted_effect()) - .expect("the written closure starts in its shape"); - module.types[EFFECT_APPLICATION.0 as usize] = Type::Closure { - parameters: vec![TOKEN], - result: B, - }; - assert_eq!( - messages(lowering.verify(&module)), - ["a lowered effect closure must return the lowered effect result"] - ); -} - -/// A node that is not a closure at all cannot be the representation of an -/// effect either. -#[test] -fn a_lowered_effect_that_is_not_a_closure_is_rejected() { - let mut module = effect_module(); - let lowering = lower_effects(&mut module, &trusted_effect()) - .expect("the written closure starts in its shape"); - module.types[EFFECT_APPLICATION.0 as usize] = Type::Application(EFFECT, ARROW); - let errors = lowering - .verify(&module) - .expect_err("an application is not a closure representation"); - assert_eq!( - errors[0].message, - "a lowered effect application is not a closure" - ); - assert_eq!(errors[0].module, module.id); - assert_eq!(errors[0].span, module.span); -} - -/// A module without the opaque library type is left alone and passes the check. -#[test] -fn lowering_rejects_missing_trusted_effect_identity() { - let mut module = effect_module(); - module.type_names.clear(); - module.opaque_ids.clear(); - let errors = lower_effects(&mut module, &trusted_effect()) - .expect_err("missing trusted identity metadata is an error"); - assert_eq!( - errors[0].message, - "trusted Effect identity is missing or is not an opaque type" - ); -} - -#[test] -fn effect_import_classification_rejects_a_cyclic_arrow_result() { - let mut module = effect_module(); - module.types = vec![ - Type::Constructor(TypeConstructor::Function), - Type::Constructor(TypeConstructor::Int), - Type::Application(TypeId(0), TypeId(1)), - Type::Application(TypeId(2), TypeId(3)), - ]; - let error = classify_effect_import(&module, TypeId(3), EFFECT_HIR) - .expect_err("a recursive arrow spine is malformed"); - assert_eq!(error, "cyclic type spine in effect import signature"); -} - -#[test] -fn a_checked_foreign_effect_signature_must_quantify_its_type_variables() { - let mut module = effect_module(); - let symbol = SymbolId::new(ModuleId(0), 9); - let free = TypeId(module.types.len() as u32); - module.types.push(Type::Variable(TypeVariableId(99))); - module.externals.push(psrs_hir::ExternalSymbol { - symbol, - name: "foreignEffect".into(), - kind: psrs_hir::ExternalKind::Wit { - interface: "test:effect".into(), - function: "foreign-effect".into(), - }, - signature: None, - }); - module.external_types.push(crate::ExternalType { - symbol, - source_module: module.id, - ty: free, - }); - - let errors = module - .verify() - .expect_err("free external variables are invalid"); - assert!( - errors - .iter() - .any(|error| { error.message == "type variable is outside its quantifier scope" }) - ); -} - -#[test] -fn another_foreign_effect_identity_is_not_the_trusted_effect_constructor() { - let mut module = effect_module(); - let other_effect = HirTypeId::new(ModuleId(1), 3); - let other = TypeId(module.types.len() as u32); - module - .types - .push(Type::Constructor(TypeConstructor::User(other_effect))); - let application = TypeId(module.types.len() as u32); - module.types.push(Type::Application(other, A)); - module.opaque_ids.push(other_effect); - module - .type_names - .push((other_effect, "Prelude.Effect".into())); - - assert_eq!( - classify_effect_import(&module, application, EFFECT_HIR).unwrap(), - None, - "matching spelling and opacity do not substitute for trusted identity" - ); - - lower_effects(&mut module, &trusted_effect()).unwrap(); - assert!(matches!( - module.types.get(application.0 as usize), - Some(Type::Application(_, _)) - )); - assert!(matches!( - module.types.get(EFFECT_APPLICATION.0 as usize), - Some(Type::Closure { .. }) - )); -} - -#[test] -fn an_ordinary_closure_shaped_import_is_not_an_effect_import() { - let mut module = effect_module(); - let ordinary = TypeId(module.types.len() as u32); - module.types.push(Type::Closure { - parameters: vec![A], - result: B, - }); - - assert_eq!( - classify_effect_import(&module, ordinary, EFFECT_HIR).unwrap(), - None, - "suspension is planned from the checked abstract Effect result, not closure shape" - ); -} - -fn messages(result: Result<(), Vec>) -> Vec<&'static str> { - result - .expect_err("the malformed closure must be rejected") - .iter() - .map(|error| error.message) - .collect() -} diff --git a/crates/psrs-core/src/tests/mod.rs b/crates/psrs-core/src/tests/mod.rs index 4e2b303b..c47a7381 100644 --- a/crates/psrs-core/src/tests/mod.rs +++ b/crates/psrs-core/src/tests/mod.rs @@ -2,7 +2,6 @@ use super::*; use psrs_hir::{Intrinsic, LocalId, ModuleId, SymbolId}; mod deep_expr; -mod effects; mod external_types; mod instantiation; mod link; diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 139ba36a..92b3da9c 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -18,24 +18,6 @@ impl Context<'_> { intrinsic: Intrinsic, arguments: &[Expr], ) { - if intrinsic.state_operation().is_some() { - for argument in arguments { - self.expr(argument, None); - } - if let Err(message) = crate::state::primitive::verify( - self.module, - intrinsic, - &arguments - .iter() - .map(|argument| argument.ty) - .collect::>(), - expression.ty, - ) { - self.errors - .push(error(self.owner, expression.span, message)); - } - return; - } match intrinsic { Intrinsic::ArrayLength => self.verify_array_length(expression, &arguments[0]), Intrinsic::ArrayIndex => { diff --git a/crates/psrs-core/src/verify/expr/mod.rs b/crates/psrs-core/src/verify/expr/mod.rs index 6665db16..b01039f9 100644 --- a/crates/psrs-core/src/verify/expr/mod.rs +++ b/crates/psrs-core/src/verify/expr/mod.rs @@ -2,7 +2,7 @@ use super::{ Locals, SchemeType, array_element, compatible, error, primitive_type_id, record_field, restore_local, verify_pattern, verify_type, }; -use crate::{Expr, ExprKind, Module, Type, TypeConstructor, TypeId, VerifyError}; +use crate::{Expr, ExprKind, Module, TypeConstructor, TypeId, VerifyError}; use psrs_hir::{ModuleId, SymbolId}; use std::collections::HashMap; @@ -113,21 +113,6 @@ impl Context<'_> { ExprKind::String(_) => self.shape(expression, TypeConstructor::String), ExprKind::Char(_) => self.shape(expression, TypeConstructor::Char), ExprKind::Unit => self.shape(expression, TypeConstructor::Unit), - // The state token is the one value of the compiler-owned opaque - // token type. Only effect lowering produces it. - ExprKind::StateToken => { - if !matches!( - self.module.types.get(expression.ty.0 as usize), - Some(Type::Constructor(TypeConstructor::User(id))) - if *id == psrs_hir::TypeId::STATE_TOKEN - ) { - self.errors.push(error( - self.owner, - expression.span, - "state token expression does not have the compiler token type", - )); - } - } // A trap produces no value, so its type is only the one its context // wants; the surrounding context check already established that. ExprKind::Trap => {} diff --git a/crates/psrs-core/src/verify/mod.rs b/crates/psrs-core/src/verify/mod.rs index ef1b4d1c..b9788703 100644 --- a/crates/psrs-core/src/verify/mod.rs +++ b/crates/psrs-core/src/verify/mod.rs @@ -153,11 +153,6 @@ pub(crate) fn module(module: &Module, source: Option<&Module>) -> Result<(), Vec &mut errors, ); } - if errors.is_empty() - && let Err(state_errors) = crate::state::flow::check(module) - { - errors.extend(state_errors); - } if errors.is_empty() { Ok(()) } else { diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index bbd318e6..97215062 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -36,7 +36,7 @@ fn scoped_expr_inner( | ExprKind::Char(_) => {} // Both are leaves: their type is already checked by the expression // check, and neither mentions a binder. - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => {} + ExprKind::Unit | ExprKind::Trap => {} ExprKind::Constructor { arguments, .. } => { // Constructor lowering collapses a THIR application spine. Its // result quantifiers still bind the corresponding free variables diff --git a/crates/psrs-driver/src/lib.rs b/crates/psrs-driver/src/lib.rs index 7ae98957..6da45c19 100644 --- a/crates/psrs-driver/src/lib.rs +++ b/crates/psrs-driver/src/lib.rs @@ -123,7 +123,6 @@ pub fn compile_source(source_name: &str, source_text: &str) -> Result, - effect_context: Option, } /// Parses the standard library and a program module and links both into one @@ -150,14 +148,12 @@ fn lower_source_with_prelude_to_core( source_text: &str, ) -> Result> { let (sources, trusted_prefix) = prepend_stdlib(&[(source_name, source_text)])?; - let (core, warnings, effect_context) = - program::lower_program_to_core_and_effect_context(&sources, trusted_prefix) - .map_err(program_diagnostics_from_hidden_prelude)?; + let (core, warnings) = program::lower_program_to_core_and_warnings(&sources, trusted_prefix) + .map_err(program_diagnostics_from_hidden_prelude)?; Ok(LoweredSource { core, trusted_prefix, warnings: program::typecheck_warnings(warnings, trusted_prefix), - effect_context, }) } @@ -195,7 +191,6 @@ pub(crate) fn lower_source_to_core( #[cfg(test)] pub(crate) struct PreparedSource { pub core: psrs_core::Module, - pub effect_context: Option, } #[cfg(test)] @@ -206,13 +201,9 @@ pub(crate) fn prepare_main(source: &str) -> Result Result> { let (sources, trusted_prefix) = prepend_stdlib(sources)?; - let (core, _warnings, effect_context) = - program::lower_program_to_core_and_effect_context(&sources, trusted_prefix) - .map_err(program_diagnostics_from_hidden_prelude)?; - Ok(PreparedSource { - core, - effect_context, - }) + let (core, _warnings) = program::lower_program_to_core_and_warnings(&sources, trusted_prefix) + .map_err(program_diagnostics_from_hidden_prelude)?; + Ok(PreparedSource { core }) } #[cfg(test)] @@ -226,8 +217,7 @@ pub(crate) fn compile_main_with_target( target: psrs_backend::TargetCapabilities, ) -> Result> { let prepared = prepare_main(source)?; - psrs_backend::compile_with_context(prepared.core, prepared.effect_context, target) - .map_err(backend_diagnostics) + psrs_backend::compile_with_context(prepared.core, target).map_err(backend_diagnostics) } #[cfg(test)] @@ -235,8 +225,7 @@ pub(crate) fn lower_main_to_cc( source: &str, ) -> Result> { let prepared = prepare_main(source)?; - psrs_backend::lower_cc_with_context(prepared.core, prepared.effect_context.as_ref()) - .map_err(backend_diagnostics) + psrs_backend::cc::lower_module(prepared.core).map_err(backend_diagnostics) } pub fn compile_source_with_dumps( @@ -247,7 +236,6 @@ pub fn compile_source_with_dumps( let mut warnings = lowered.warnings; let stages = psrs_backend::compile_with_context( lowered.core, - lowered.effect_context, psrs_backend::TargetCapabilities::default(), ) .map_err(backend_diagnostics)?; diff --git a/crates/psrs-driver/src/program/compilation.rs b/crates/psrs-driver/src/program/compilation.rs index 64f0be73..b4883c61 100644 --- a/crates/psrs-driver/src/program/compilation.rs +++ b/crates/psrs-driver/src/program/compilation.rs @@ -1,4 +1,4 @@ -use super::{lower_program_to_core_and_effect_context, typecheck_warnings}; +use super::{lower_program_to_core_and_warnings, typecheck_warnings}; use crate::{ Artifact, CompilationReport, Diagnostic, DiagnosticOrigin, FrontendPassTrace, IrDumpArtifacts, PartialIrDumps, ProgramDiagnostic, backend_warnings, @@ -30,14 +30,14 @@ pub(super) fn compile_attempt( trace_enabled: bool, runner: Option<&crate::prelude::CommandRunner>, ) -> CompilationReport { - let (core, source_warnings, effect_context) = match if let Some(runner) = runner { + let (core, source_warnings) = match if let Some(runner) = runner { super::lowering::lower_program_inner( sources, trusted_prefix, Some((&runner.module, &runner.function)), ) } else { - lower_program_to_core_and_effect_context(sources, trusted_prefix) + lower_program_to_core_and_warnings(sources, trusted_prefix) } { Ok(lowered) => lowered, Err(diagnostics) => { @@ -71,7 +71,6 @@ pub(super) fn compile_attempt( let linked_core = capture_dumps.then(|| core.clone()); let traced = psrs_backend::compile_with_context_traced( core, - effect_context, psrs_backend::TargetCapabilities::default(), capture_dumps, ); @@ -111,7 +110,6 @@ pub(super) fn compile_attempt( let linked_core = core.clone(); let stages = match psrs_backend::compile_with_context_capturing( core, - effect_context, psrs_backend::TargetCapabilities::default(), ) { Ok(stages) => stages, @@ -123,11 +121,7 @@ pub(super) fn compile_attempt( return success_report(stages, source_warnings, trusted_prefix, true, None, None); } - match psrs_backend::compile_with_context( - core, - effect_context, - psrs_backend::TargetCapabilities::default(), - ) { + match psrs_backend::compile_with_context(core, psrs_backend::TargetCapabilities::default()) { Ok(stages) => success_report(stages, source_warnings, trusted_prefix, false, None, None), Err(errors) => { CompilationReport::failed(backend_diagnostics(errors), PartialIrDumps::default()) diff --git a/crates/psrs-driver/src/program/effects.rs b/crates/psrs-driver/src/program/effects.rs index f42e7ea9..203791f2 100644 --- a/crates/psrs-driver/src/program/effects.rs +++ b/crates/psrs-driver/src/program/effects.rs @@ -1,6 +1,5 @@ use super::{DiagnosticOrigin, ProgramDiagnostic, diagnostic}; -use psrs_core::effect::EffectOperation; -use psrs_hir::{Expr, ExprKind, ExternalKind, Module, SymbolId, TypeDeclarationKind}; +use psrs_hir::{Module, SymbolId}; use psrs_span::TextRange; #[derive(Clone, Copy, Debug, PartialEq, Eq)] @@ -81,269 +80,3 @@ pub(super) fn require_unambiguous_entry( } } } - -pub(super) fn trusted_effect( - modules: &[Module], - trusted_prefix: usize, -) -> Result, Vec> { - let preludes = modules - .iter() - .take(trusted_prefix) - .enumerate() - .filter(|(_, module)| module.name == "Prelude") - .collect::>(); - if preludes.is_empty() { - return Ok(None); - } - if preludes.len() != 1 { - return Err(vec![ProgramDiagnostic { - source: DiagnosticOrigin::Program, - diagnostic: diagnostic( - "P7 Effect contract", - preludes[1].1.span, - "trusted program contains multiple Prelude modules", - ), - }]); - } - let (source, prelude) = preludes[0]; - let Some(effect) = prelude.types.iter().find(|declaration| { - declaration.name == "Effect" && declaration.kind == TypeDeclarationKind::Foreign - }) else { - return Ok(None); - }; - let mut operations = Vec::new(); - for (name, operation, wit_name) in [ - ("effectPure", EffectOperation::Pure, "pure"), - ("effectBind", EffectOperation::Bind, "bind"), - ("runEffect", EffectOperation::Run, "run"), - ("trap", EffectOperation::Trap, "trap"), - ] { - let Some(external) = prelude - .externals - .iter() - .find(|external| external.name == name) - else { - return Err(vec![ProgramDiagnostic { - source: DiagnosticOrigin::Source(source), - diagnostic: diagnostic( - "P7 Effect contract", - prelude.span, - "trusted Prelude is missing a required Effect operation binding", - ), - }]); - }; - if !matches!( - &external.kind, - ExternalKind::Wit { interface, function } - if interface == "psrs:effect" && function == wit_name - ) { - return Err(vec![ProgramDiagnostic { - source: DiagnosticOrigin::Source(source), - diagnostic: diagnostic( - "P7 Effect contract", - external - .signature - .as_ref() - .map_or(prelude.span, |ty| ty.span), - "trusted Prelude Effect operation has the wrong WIT identity", - ), - }]); - } - operations.push(psrs_core::effect::EffectOperationBinding { - operation, - symbol: external.symbol, - }); - } - Ok(Some(psrs_core::effect::TrustedEffect { - effect_type: effect.id, - operations, - })) -} - -/// Enforces the source compatibility rule: `runEffect` may be referenced only -/// inside the selected declaration. Passing it from that declaration to a -/// helper is allowed; this is a lexical rule, not capability confinement. -pub(super) fn check_run_effect_scope( - modules: &[Module], - entry: Option, - trusted: Option<&psrs_core::effect::TrustedEffect>, -) -> Result<(), Vec> { - let Some(runner) = trusted - .and_then(|trusted| { - trusted - .operations - .iter() - .find(|operation| operation.operation == EffectOperation::Run) - }) - .map(|operation| operation.symbol) - else { - return Ok(()); - }; - let mut errors = Vec::new(); - for (source, module) in modules.iter().enumerate() { - for declaration in &module.declarations { - let mut references = Vec::new(); - collect_runner_references(&declaration.value, runner, &mut references); - if entry.is_some_and(|entry| declaration.symbol == entry.symbol) { - continue; - } - for span in references { - errors.push(ProgramDiagnostic { - source: DiagnosticOrigin::Source(source), - diagnostic: diagnostic( - "P7 entry selection", - span, - "the trusted `runEffect` binding may only be referenced from the selected command entry `main`", - ), - }); - } - } - for instance in &module.instances { - for member in &instance.members { - let mut references = Vec::new(); - collect_runner_references(&member.value, runner, &mut references); - for span in references { - errors.push(ProgramDiagnostic { - source: DiagnosticOrigin::Source(source), - diagnostic: diagnostic( - "P7 entry selection", - span, - "the trusted `runEffect` binding may only be referenced from the selected command entry `main`", - ), - }); - } - } - } - } - if errors.is_empty() { - Ok(()) - } else { - Err(errors) - } -} - -fn collect_runner_references(expression: &Expr, runner: SymbolId, spans: &mut Vec) { - match &expression.kind { - ExprKind::Global(symbol) if *symbol == runner => spans.push(expression.span), - ExprKind::Array(elements) => { - for element in elements { - collect_runner_references(element, runner, spans); - } - } - ExprKind::Record(fields) | ExprKind::MatchProduct(fields) => { - for (_, value) in fields { - collect_runner_references(value, runner, spans); - } - } - ExprKind::RecordUpdate { expression, fields } => { - collect_runner_references(expression, runner, spans); - for (_, value) in fields { - collect_runner_references(value, runner, spans); - } - } - ExprKind::FieldAccess { expression, .. } - | ExprKind::Typed { expression, .. } - | ExprKind::TypeApplication { expression, .. } => { - collect_runner_references(expression, runner, spans); - } - ExprKind::Application(function, argument) => { - collect_runner_references(function, runner, spans); - collect_runner_references(argument, runner, spans); - } - ExprKind::Operator { - operator, - operator_span, - left, - right, - } => { - if *operator == runner { - spans.push(*operator_span); - } - collect_runner_references(left, runner, spans); - collect_runner_references(right, runner, spans); - } - ExprKind::Negate { - function, - expression, - .. - } => { - collect_runner_references(function, runner, spans); - collect_runner_references(expression, runner, spans); - } - ExprKind::OperatorChain { - operands, - operators, - } => { - for operator in operators { - if operator.local.is_none() && operator.symbol == runner { - spans.push(operator.operator_span); - } - } - for operand in operands { - collect_runner_references(operand, runner, spans); - } - } - ExprKind::OperatorSection { - operator, operand, .. - } => { - if operator.symbol == runner { - spans.push(operator.operator_span); - } - collect_runner_references(operand, runner, spans); - } - ExprKind::Lambda { body, .. } => collect_runner_references(body, runner, spans), - ExprKind::Let { bindings, body } => { - for binding in bindings { - collect_runner_references(&binding.value, runner, spans); - } - collect_runner_references(body, runner, spans); - } - ExprKind::If { - condition, - then_branch, - else_branch, - } => { - collect_runner_references(condition, runner, spans); - collect_runner_references(then_branch, runner, spans); - collect_runner_references(else_branch, runner, spans); - } - ExprKind::Case { - scrutinee, - branches, - } => { - collect_runner_references(scrutinee, runner, spans); - for branch in branches { - collect_runner_references(&branch.value, runner, spans); - } - } - ExprKind::Guarded(clauses) => { - for clause in clauses { - for binding in &clause.where_bindings { - collect_runner_references(&binding.value, runner, spans); - } - for guard in &clause.guards { - match guard { - psrs_hir::Guard::Boolean(value) => { - collect_runner_references(value, runner, spans) - } - psrs_hir::Guard::Pattern { value, .. } => { - collect_runner_references(value, runner, spans) - } - psrs_hir::Guard::Let { bindings, .. } => { - for binding in bindings { - collect_runner_references(&binding.value, runner, spans); - } - } - } - } - collect_runner_references(&clause.value, runner, spans); - } - } - ExprKind::Local(_) - | ExprKind::Global(_) - | ExprKind::Integer(_) - | ExprKind::Number(_) - | ExprKind::String(_) - | ExprKind::Char(_) => {} - } -} diff --git a/crates/psrs-driver/src/program/lowering.rs b/crates/psrs-driver/src/program/lowering.rs index 0e64a653..9a5fc0bb 100644 --- a/crates/psrs-driver/src/program/lowering.rs +++ b/crates/psrs-driver/src/program/lowering.rs @@ -4,14 +4,7 @@ pub(super) fn lower_program_inner( sources: &[(&str, &str)], trusted_prefix: usize, runner: Option<(&str, &str)>, -) -> Result< - ( - psrs_core::Module, - Vec, - Option, - ), - Vec, -> { +) -> Result<(psrs_core::Module, Vec), Vec> { let resolved = resolve_program_sources(sources)?; let selected_runner = runner .map(|(owner, name)| { @@ -39,19 +32,7 @@ pub(super) fn lower_program_inner( }) .transpose()?; let entry = effects::require_unambiguous_entry(effects::select_entry(&resolved))?; - let trusted = if selected_runner.is_none() { - let trusted = effects::trusted_effect(&resolved, trusted_prefix)?; - effects::check_run_effect_scope(&resolved, entry, trusted.as_ref())?; - trusted - } else { - None - }; let (typed, warnings) = typecheck_resolved_program_with_warnings(resolved)?; - let command_entry = if selected_runner.is_none() { - classify_command_entry(&typed, entry, trusted.as_ref())? - } else { - None - }; let mut modules = Vec::with_capacity(typed.len()); for (index, module) in typed.into_iter().enumerate() { match psrs_core::lower_module_unverified(module) { @@ -96,32 +77,12 @@ pub(super) fn lower_program_inner( }) .collect()); } - let context = trusted.map(|trusted| psrs_core::effect::EffectCompilation { - trusted, - command_entry, - }); - Ok((linked, warnings, context)) + Ok((linked, warnings)) } -pub(crate) fn lower_program_to_core_and_effect_context( +pub(crate) fn lower_program_to_core_and_warnings( sources: &[(&str, &str)], trusted_prefix: usize, -) -> Result< - ( - psrs_core::Module, - Vec, - Option, - ), - Vec, -> { +) -> Result<(psrs_core::Module, Vec), Vec> { lower_program_inner(sources, trusted_prefix, None) } - -#[cfg(test)] -pub(crate) fn lower_program_to_core_with_runner( - sources: &[(&str, &str)], - owner: &str, - function: &str, -) -> Result> { - lower_program_inner(sources, 0, Some((owner, function))).map(|(core, _, _)| core) -} diff --git a/crates/psrs-driver/src/program/mod.rs b/crates/psrs-driver/src/program/mod.rs index 6b70a1a7..255d0eed 100644 --- a/crates/psrs-driver/src/program/mod.rs +++ b/crates/psrs-driver/src/program/mod.rs @@ -23,8 +23,6 @@ mod graph; mod lenient; mod library; mod lowering; -#[cfg(test)] -pub(crate) use lowering::lower_program_to_core_with_runner; mod reports; mod signatures; @@ -69,84 +67,10 @@ pub(crate) fn lower_program_to_core_with_trusted_prefix_and_warnings( sources: &[(&str, &str)], trusted_prefix: usize, ) -> Result<(psrs_core::Module, Vec), Vec> { - lower_program_to_core_and_effect_context(sources, trusted_prefix) - .map(|(core, warnings, _context)| (core, warnings)) + lower_program_to_core_and_warnings(sources, trusted_prefix) } -pub(super) use lowering::lower_program_to_core_and_effect_context; - -fn classify_command_entry( - typed: &[psrs_thir::Module], - selected: Option, - trusted: Option<&psrs_core::effect::TrustedEffect>, -) -> Result, Vec> { - let Some(selected) = selected else { - return Ok(None); - }; - let Some(module) = typed.get(selected.source) else { - return Err(vec![ProgramDiagnostic { - source: DiagnosticOrigin::Source(selected.source), - diagnostic: diagnostic( - "P7 entry selection", - selected.span, - "selected command entry was not type checked", - ), - }]); - }; - let Some(main) = module - .declarations - .iter() - .find(|declaration| declaration.symbol == selected.symbol) - else { - return Err(vec![ProgramDiagnostic { - source: DiagnosticOrigin::Source(selected.source), - diagnostic: diagnostic( - "P7 entry selection", - selected.span, - "selected command entry has no typed declaration", - ), - }]); - }; - if matches!( - module.types.get(main.ty.0 as usize), - Some(psrs_thir::Type::Constructor( - psrs_thir::TypeConstructor::Int - )) - ) { - return Ok(None); - } - let is_effect_unit = trusted.is_some_and(|trusted| { - let Some(psrs_thir::Type::Application(function, payload)) = - module.types.get(main.ty.0 as usize) - else { - return false; - }; - matches!( - module.types.get(function.0 as usize), - Some(psrs_thir::Type::Constructor(psrs_thir::TypeConstructor::User(id))) - if *id == trusted.effect_type - ) && matches!( - module.types.get(payload.0 as usize), - Some(psrs_thir::Type::Constructor( - psrs_thir::TypeConstructor::Unit - )) - ) && main.quantified.is_empty() - }); - if is_effect_unit { - Ok(Some(psrs_core::effect::EffectCommandEntry { - symbol: selected.symbol, - })) - } else { - Err(vec![ProgramDiagnostic { - source: DiagnosticOrigin::Source(selected.source), - diagnostic: diagnostic( - "P7 entry selection", - main.name_span, - "command entry must have type `Int` or `Effect Unit`", - ), - }]) - } -} +pub(super) use lowering::lower_program_to_core_and_warnings; /// Resolves a program from a list of `(source_name, source_text)` pairs. Module /// IDs equal each source's index in the list. This is the module-graph entry @@ -197,15 +121,6 @@ pub(crate) fn check_program_with_trusted_prefix_and_warnings( .map(|(_modules, warnings)| warnings) } -#[cfg(test)] -pub(crate) fn typecheck_program_sources_with_trusted_prefix( - sources: &[(&str, &str)], - trusted_prefix: usize, -) -> Result, Vec> { - let modules = resolve_program_sources(sources)?; - typecheck_program_with_warnings(modules, trusted_prefix).map(|(modules, _warnings)| modules) -} - fn typecheck_program_sources_with_trusted_prefix_and_warnings( sources: &[(&str, &str)], trusted_prefix: usize, @@ -216,14 +131,8 @@ fn typecheck_program_sources_with_trusted_prefix_and_warnings( pub(super) fn typecheck_program_with_warnings( modules: Vec, - trusted_prefix: usize, + _trusted_prefix: usize, ) -> Result<(Vec, Vec), Vec> { - let entry = match effects::select_entry(&modules) { - effects::EntryResolution::Selected(entry) => Some(entry), - effects::EntryResolution::Missing | effects::EntryResolution::Ambiguous { .. } => None, - }; - let trusted = effects::trusted_effect(&modules, trusted_prefix)?; - effects::check_run_effect_scope(&modules, entry, trusted.as_ref())?; typecheck_resolved_program_with_warnings(modules) } diff --git a/crates/psrs-driver/src/tests/closure_protocol.rs b/crates/psrs-driver/src/tests/closure_protocol.rs index 138378bf..691d8f7e 100644 --- a/crates/psrs-driver/src/tests/closure_protocol.rs +++ b/crates/psrs-driver/src/tests/closure_protocol.rs @@ -85,12 +85,9 @@ main :: Int main = repeatAction action 42 "#; let prepared = crate::prepare_main(source).expect("source should lower to Core"); - let cc = psrs_backend::lower_cc_with_context( - prepared.core.clone(), - prepared.effect_context.as_ref(), - ) - .expect("the Reader dictionary should lower to CC") - .cc; + let cc = psrs_backend::cc::lower_module(prepared.core.clone()) + .expect("the Reader dictionary should lower to CC") + .cc; let has_adapter = cc .functions .iter() diff --git a/crates/psrs-driver/src/tests/diagnosis_trace.rs b/crates/psrs-driver/src/tests/diagnosis_trace.rs index 7610466b..d3c25f95 100644 --- a/crates/psrs-driver/src/tests/diagnosis_trace.rs +++ b/crates/psrs-driver/src/tests/diagnosis_trace.rs @@ -171,12 +171,7 @@ fn target_rejection_keeps_prior_artifacts_and_maps_errors_to_its_execution() { component_model: false, ..Default::default() }; - let traced = psrs_backend::compile_with_context_traced( - prepared.core, - prepared.effect_context, - target, - false, - ); + let traced = psrs_backend::compile_with_context_traced(prepared.core, target, false); let failure = traced .result .expect_err("target profile should be rejected"); diff --git a/crates/psrs-driver/src/tests/effect_arity.rs b/crates/psrs-driver/src/tests/effect_arity.rs deleted file mode 100644 index bc2b3af8..00000000 --- a/crates/psrs-driver/src/tests/effect_arity.rs +++ /dev/null @@ -1,166 +0,0 @@ -//! Calling-convention evidence for the effect representation. -//! -//! `Effect τ` is a one-parameter closure. A source arrow such as -//! `String -> Effect Unit` stays saturated at that arrow; the token is not -//! another parameter of `log`. - -use super::run_with_wasmtime; - -#[test] -fn an_effect_of_a_function_is_not_arity_two_and_log_is_saturated() { - let source = "module Main where\nimport Prelude\nimport WASI.Clock\nimport WASI.Console\nmk :: Effect (Int -> Int)\nmk = pure (\\x -> x + 1)\nmain = let stored = now in let message = log \"message\" in runEffect (bind mk (\\f -> pure (f 41)))\n"; - let stages = crate::compile_main_stages(source).expect("Core lowers through CC"); - let function = |name: &str| { - stages - .cc - .functions - .iter() - .find(|function| function.name == name) - .unwrap_or_else(|| panic!("missing function {name}")) - }; - assert_eq!( - function("log").parameters.len(), - 1, - "log keeps the source arrow and leaves the token on the returned closure" - ); - assert_eq!( - function("now").parameters.len(), - 1, - "Effect Int is a one-parameter closure" - ); - assert_eq!( - function("effectPure").parameters.len(), - 1, - "pure takes the value and returns the token closure" - ); - assert_eq!( - function("effectBind").parameters.len(), - 2, - "bind takes the effect and the continuation; the token belongs to the result" - ); - assert_ne!( - function("mk").parameters.len(), - 2, - "an alias of Effect (Int -> Int) is not a two-parameter function" - ); - let log_symbol = function("log").symbol; - let log_calls = stages - .cc - .functions - .iter() - .flat_map(|function| direct_calls(&function.assignments)) - .filter(|(symbol, _)| *symbol == log_symbol) - .map(|(_, arguments)| arguments) - .collect::>(); - assert!( - !log_calls.is_empty() && log_calls.iter().all(|count| *count == 1), - "log \"message\" is a saturated one-argument call, got {log_calls:?}" - ); - let Some(output) = run_with_wasmtime(source) else { - eprintln!("skipping execution: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); - assert!( - output.stdout.is_empty(), - "storing log \"message\" must not run it: {output:?}" - ); -} - -/// `pick :: Boolean -> String -> Effect Unit` has two source parameters. Supplying -/// only the Boolean captures that argument once and returns `String -> Effect Unit`. -/// The token stays on the effect that `pick` returns, and the write waits until -/// that effect is run. -#[test] -fn a_partial_source_application_captures_once_and_defers_the_effect() { - let stored = "module Main where\nimport Prelude\nimport WASI.Console\npick :: Boolean -> String -> Effect Unit\npick choice message = if choice then log message else log \"other\"\nmain = let partial = pick true in 0\n"; - let stages = crate::compile_main_stages(stored).expect("Core lowers through CC"); - let pick = stages - .cc - .functions - .iter() - .find(|function| function.name == "pick") - .expect("pick"); - assert_eq!( - pick.parameters.len(), - 2, - "the token is not a parameter of pick" - ); - let partials = stages - .cc - .functions - .iter() - .filter(|function| { - function.name.starts_with("partial_") - && direct_calls(&function.assignments) - .iter() - .any(|(symbol, arguments)| *symbol == pick.symbol && *arguments == 2) - }) - .collect::>(); - assert_eq!(partials.len(), 1, "one partial application of pick"); - assert_eq!( - partials[0].parameters.len(), - 2, - "the partial keeps the remaining String and the closure environment" - ); - let captures = partials[0] - .assignments - .iter() - .filter(|assignment| { - matches!( - assignment.kind, - psrs_backend::cc::AssignmentKind::ClosureGetCapture { index: 0, .. } - ) - }) - .count(); - assert_eq!(captures, 1, "the supplied Boolean is captured once"); - let Some(stored_output) = run_with_wasmtime(stored) else { - eprintln!("skipping execution: wasmtime is not installed"); - return; - }; - assert_eq!(stored_output.status.code(), Some(0), "{stored_output:?}"); - assert!( - stored_output.stdout.is_empty(), - "building the partial application must not run the effect: {stored_output:?}" - ); - - let ran = "module Main where\nimport Prelude\nimport WASI.Console\npick :: Boolean -> String -> Effect Unit\npick choice message = if choice then log message else log \"other\"\nmain = let partial = pick true in let first = runEffect (partial \"again\") in let second = runEffect (partial \"again\") in 0\n"; - let Some(ran_output) = run_with_wasmtime(ran) else { - eprintln!("skipping execution: wasmtime is not installed"); - return; - }; - assert_eq!(ran_output.status.code(), Some(0), "{ran_output:?}"); - assert_eq!(ran_output.stdout, b"again\nagain\n", "{ran_output:?}"); -} - -fn direct_calls(assignments: &[psrs_backend::cc::Assignment]) -> Vec<(psrs_hir::SymbolId, usize)> { - let mut found = Vec::new(); - for assignment in assignments { - match &assignment.kind { - psrs_backend::cc::AssignmentKind::DirectCall { - function, - arguments, - } => found.push((*function, arguments.len())), - psrs_backend::cc::AssignmentKind::If { - then_assignments, - else_assignments, - .. - } => { - found.extend(direct_calls(then_assignments)); - found.extend(direct_calls(else_assignments)); - } - psrs_backend::cc::AssignmentKind::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - found.extend(direct_calls(&case.assignments)); - } - found.extend(direct_calls(default_assignments)); - } - _ => {} - } - } - found -} diff --git a/crates/psrs-driver/src/tests/effects/contract.rs b/crates/psrs-driver/src/tests/effects/contract.rs deleted file mode 100644 index 2cd8bd8b..00000000 --- a/crates/psrs-driver/src/tests/effects/contract.rs +++ /dev/null @@ -1,187 +0,0 @@ -use psrs_core::effect::{EffectCommandEntry, EffectCompilation, EffectOperation}; - -fn fixture() -> (psrs_core::Module, EffectCompilation) { - let lowered = crate::lower_source_with_prelude_to_core( - "Main.purs", - "module Main where\nimport Prelude\nmain = 0\n", - ) - .unwrap(); - let core = lowered.core; - let context = lowered.effect_context; - ( - core, - context.expect("embedded Prelude supplies the trusted contract"), - ) -} - -fn rejects(core: psrs_core::Module, context: EffectCompilation, message: &str) { - let errors = psrs_backend::compile_with_context( - core, - Some(context), - psrs_backend::TargetCapabilities::default(), - ) - .expect_err("a malformed explicit Effect contract must fail before encoding"); - assert!( - errors.iter().any(|error| error.message.contains(message)), - "{errors:?}" - ); -} - -#[test] -fn the_backend_rejects_partial_and_duplicate_trusted_operation_metadata() { - let (core, mut context) = fixture(); - context - .trusted - .operations - .retain(|binding| binding.operation != EffectOperation::Trap); - rejects(core, context, "missing a required operation binding"); - - let (core, mut context) = fixture(); - context - .trusted - .operations - .push(context.trusted.operations[0]); - rejects(core, context, "duplicated"); -} - -#[test] -fn the_backend_rejects_operation_identity_and_checked_signature_mismatches() { - let (core, mut context) = fixture(); - context.trusted.operations[0].symbol = core.entry.unwrap(); - rejects(core, context, "no external declaration"); - - let (mut core, context) = fixture(); - let pure = context - .trusted - .operations - .iter() - .find(|binding| binding.operation == EffectOperation::Pure) - .unwrap() - .symbol; - let integer = psrs_core::TypeId( - core.types - .iter() - .position(|ty| { - matches!( - ty, - psrs_core::Type::Constructor(psrs_core::TypeConstructor::Int) - ) - }) - .unwrap() as u32, - ); - core.external_types - .iter_mut() - .find(|external| external.symbol == pure) - .unwrap() - .ty = integer; - rejects(core, context, "invalid checked source signature"); -} - -#[test] -fn the_backend_rejects_an_effect_entry_context_for_an_integer_source_entry() { - let (core, mut context) = fixture(); - context.command_entry = Some(EffectCommandEntry { - symbol: core.entry.unwrap(), - }); - rejects(core, context, "must have type Effect Unit"); -} - -fn action_fixture() -> (psrs_core::Module, EffectCompilation) { - let lowered = crate::lower_source_with_prelude_to_core( - "Main.purs", - "module Main where\nimport Prelude\nmain :: Effect Unit\nmain = pure unit\n", - ) - .unwrap(); - (lowered.core, lowered.effect_context.unwrap()) -} - -#[test] -fn effect_command_metadata_must_name_the_selected_source_entry() { - let (mut core, mut context) = action_fixture(); - let selected = core.entry.unwrap(); - let mut decoy = core - .declarations - .iter() - .find(|decl| decl.symbol == selected) - .unwrap() - .clone(); - decoy.symbol = psrs_hir::SymbolId::new(selected.module, 1_000_000); - decoy.name = "decoy".into(); - context.command_entry = Some(EffectCommandEntry { - symbol: decoy.symbol, - }); - core.declarations.push(decoy); - rejects(core, context, "selected source entry"); -} - -#[test] -fn an_effect_source_entry_requires_command_metadata() { - let (core, mut context) = action_fixture(); - context.command_entry = None; - rejects(core, context, "missing Effect command entry"); -} - -#[test] -fn checked_import_verification_keeps_the_foreign_source_module() { - let prepared = crate::prepare_sources(&[ - ( - "Clock.purs", - "module Clock where\nimport Prelude\nforeign import \"wasi:clocks/monotonic-clock#now\" keep :: Int\n", - ), - ( - "Main.purs", - "module Main where\nimport Prelude\nimport Clock\nmain = keep\n", - ), - ]) - .expect("the clock import links before its checked signature is damaged"); - let mut core = prepared.core; - let context = prepared.effect_context.expect("trusted effect"); - let entry = core.entry.expect("selected main"); - let keep = core - .externals - .iter() - .find(|external| external.name == "keep") - .expect("clock import") - .symbol; - let source_module = core - .external_types - .iter() - .find(|external| external.symbol == keep) - .expect("checked clock signature") - .source_module; - assert_ne!(source_module, entry.module); - core.types - .push(psrs_core::Type::Variable(psrs_hir::TypeVariableId(900_001))); - let free = psrs_core::TypeId((core.types.len() - 1) as u32); - core.external_types - .iter_mut() - .find(|external| external.symbol == keep) - .expect("checked clock signature") - .ty = free; - let context = Some(context); - let optimized = psrs_backend::compile_with_context( - core.clone(), - context.clone(), - psrs_backend::TargetCapabilities::default(), - ) - .expect_err("optimization must reject an unbound variable in a checked import"); - let lowered = psrs_backend::lower_cc_with_context(core, context.as_ref()) - .expect_err("effect lowering must reject an unbound variable in a checked import"); - for errors in [optimized, lowered] { - assert!( - errors.iter().any(|error| { - error.module == Some(source_module) - && error - .message - .contains("type variable is outside its quantifier scope") - }), - "{errors:?}" - ); - assert!( - errors - .iter() - .all(|error| error.module != Some(entry.module)), - "the entry module must not own the import's verification failure: {errors:?}" - ); - } -} diff --git a/crates/psrs-driver/src/tests/effects/entry.rs b/crates/psrs-driver/src/tests/effects/entry.rs deleted file mode 100644 index b47ec88e..00000000 --- a/crates/psrs-driver/src/tests/effects/entry.rs +++ /dev/null @@ -1,287 +0,0 @@ -use super::super::super::*; -use std::process::Output; - -#[test] -fn both_single_source_apis_compile_int_main_with_the_trusted_effect_library() { - let source = "module Main where\nimport Prelude\nmain = 0\n"; - compile_source("Main.purs", source).expect("compile_source must lower trusted Effect imports"); - compile_source_with_dumps("Main.purs", source) - .expect("compile_source_with_dumps must lower trusted Effect imports"); -} - -#[test] -fn an_effect_unit_entry_executes_its_action_once_through_both_source_apis() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = log \"command\"\n"; - let artifact = compile_source("Main.purs", source).expect("inferred Effect Unit main"); - let dumped = compile_source_with_dumps("Main.purs", source) - .expect("the dump API must preserve Effect lowering context"); - for wasm in [&artifact.wasm, &dumped.artifact.wasm] { - let Some(output) = run_wasm(wasm) else { return }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"command\n"); - } -} - -#[test] -fn effect_unit_entry_runs_strict_construction_effects_before_its_action() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let ignored = runEffect (log \"construct\") in log \"action\"\n"; - let artifact = compile_source("Main.purs", source).expect("the selected main owns runEffect"); - let Some(output) = run_wasm(&artifact.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"construct\naction\n"); -} - -#[test] -fn effect_unit_entry_propagates_a_trap_from_the_action() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain :: Effect Unit\nmain = bind (log \"before\") (\\_ -> bind trap (\\_ -> log \"after\"))\n"; - let artifact = compile_source("Main.purs", source).expect("the effect entry should compile"); - let Some(output) = run_wasm(&artifact.wasm) else { - return; - }; - assert!( - !output.status.success(), - "the action trap must escape: {output:?}" - ); - assert!( - String::from_utf8_lossy(&output.stderr).contains("wasm trap:") - || String::from_utf8_lossy(&output.stderr).contains("wasm backtrace"), - "the action trap should include a Wasmtime trap marker: {output:?}" - ); - assert_eq!( - output.stdout, b"before\n", - "the trap must suppress later output" - ); -} - -#[test] -fn the_effect_context_survives_backend_stage_recompilation() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain :: Effect Unit\nmain = log \"recompiled\"\n"; - let lowered = crate::lower_source_with_prelude_to_core("Main.purs", source).unwrap(); - let core = lowered.core; - let context = lowered.effect_context; - let stages = psrs_backend::compile_with_context( - core, - context, - psrs_backend::TargetCapabilities::default(), - ) - .unwrap(); - let replay = psrs_backend::compile_with_context( - stages.core.clone(), - stages.effect_context.clone(), - psrs_backend::TargetCapabilities::default(), - ) - .expect("P8 context must be retained with the returned Core"); - let Some(output) = run_wasm(&replay.artifact.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"recompiled\n"); -} - -#[test] -fn a_quantified_effect_import_lowers_to_a_monotype_wrapper() { - let clock = ( - "Clock.purs", - "module Clock where\nimport Prelude\nforeign import \"wasi:clocks/monotonic-clock#now\" now :: forall a. Effect Int\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Prelude\nimport WASI.Console\nimport Clock\nmain :: Effect Unit\nmain = bind now (\\_ -> log \"quantified\")\n", - ); - let artifact = compile_program_sources_with_prelude(&[clock, main]) - .expect("a rank-1 effect import must lower without repeating its forall"); - let Some(output) = run_wasm(&artifact.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"quantified\n"); -} - -#[test] -fn effect_import_alias_is_expanded_before_suspension_planning() { - let types = ( - "Types.purs", - "module Types where\nimport Prelude\ntype ClockTick = Effect Int\n", - ); - let clock = ( - "Clock.purs", - "module Clock where\nimport Prelude\nimport Types\nforeign import \"wasi:clocks/monotonic-clock#now\" clock :: ClockTick\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Prelude\nimport WASI.Console\nimport Clock\nmain :: Effect Unit\nmain = bind clock (\\_ -> log \"clock completed\")\n", - ); - let artifact = compile_program_sources_with_prelude(&[types, clock, main]) - .expect("an imported alias in a WIT signature must be classified from checked types"); - let Some(output) = run_wasm(&artifact.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"clock completed\n"); -} - -#[test] -fn effect_suspension_conformance_errors_keep_the_imports_source_origin() { - let clock = ( - "Clock.purs", - "module Clock where\nimport Prelude\nforeign import \"wasi:clocks/monotonic-clock#now\" clock :: Effect String\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Prelude\nimport WASI.Console\nimport Clock\nmain = bind clock (\\_ -> log \"unreachable\")\n", - ); - let errors = compile_program_sources_with_prelude(&[clock, main]) - .expect_err("a suspended host import must still match its WIT result"); - assert!( - errors.iter().any(|error| { - error.source == DiagnosticOrigin::Source(0) - && error.diagnostic.stage == "P8 WIT linking" - && error - .diagnostic - .message - .contains("source result type incompatible") - }), - "{errors:#?}" - ); -} - -#[test] -fn class_constrained_wit_imports_are_rejected_with_a_source_diagnostic() { - let source = "module Main where\nimport Prelude\nforeign import \"wasi:clocks/monotonic-clock#now\" clock :: forall a. Eq a => a\nmain = 0\n"; - let errors = compile_program_sources_with_prelude(&[("Main.purs", source)]) - .expect_err("the canonical WIT ABI cannot carry class dictionaries"); - assert!( - errors.iter().any(|error| { - error.source == DiagnosticOrigin::Source(0) - && error.diagnostic.stage == "P5 typecheck" - && error - .diagnostic - .message - .contains("class-constrained WIT imports are not supported") - }), - "{errors:#?}" - ); -} - -#[test] -fn instance_member_references_do_not_bypass_the_run_effect_scope() { - let source = "module Main where\nimport Prelude\nclass Runner a where\n run :: a -> Int\ninstance Runner Int where\n run _ = runEffect (pure 42)\nmain = run 0\n"; - let errors = compile_program_sources_with_prelude(&[("Main.purs", source)]) - .expect_err("instance methods are executable declarations too"); - assert!( - errors.iter().any(|error| { - error.source == DiagnosticOrigin::Source(0) - && error.diagnostic.stage == "P7 entry selection" - && error - .diagnostic - .message - .contains("may only be referenced from the selected command entry") - }), - "{errors:#?}" - ); -} - -#[test] -fn the_selected_entry_may_pass_run_effect_to_a_higher_order_helper() { - let source = "module Main where\nimport Prelude\nrunWith :: (Effect Int -> Int) -> Int\nrunWith runner = runner (pure 42)\nmain = runWith runEffect\n"; - let artifact = compile_source("Main.purs", source) - .expect("the selected declaration may pass its lexically scoped runner"); - let Some(output) = run_wasm(&artifact.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -#[test] -fn effect_unit_entry_accepts_a_type_synonym_and_cross_module_value() { - let producer = ( - "Producer.purs", - "module Producer where\nimport Prelude\nimport WASI.Console\ntype Action = Effect Unit\naction :: Action\naction = log \"linked\"\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Prelude\nimport Producer\nmain = action\n", - ); - let artifact = compile_program_sources_with_prelude(&[producer, main]) - .expect("an inferred entry may return an imported aliased Effect Unit"); - let Some(output) = run_wasm(&artifact.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"linked\n"); -} - -#[test] -fn an_effect_int_entry_remains_invalid() { - let source = "module Main where\nimport Prelude\nmain :: Effect Int\nmain = pure 42\n"; - let errors = compile_source("Main.purs", source) - .expect_err("the command entry must return Int or Effect Unit"); - assert!(errors.iter().any(|error| { - error.stage == "P7 entry selection" && error.message.contains("Effect Unit") - })); -} - -#[test] -fn typechecking_does_not_require_a_unique_command_entry() { - let left = ("Left.purs", "module Left where\nmain = 0\n"); - let right = ("Right.purs", "module Right where\nmain = 0\n"); - crate::typecheck_program_sources(&[left, right]) - .expect("ordinary typechecking does not select a command entry"); - let errors = compile_program_sources_with_prelude(&[left, right]) - .expect_err("compilation requires one command entry"); - assert!(errors.iter().any(|error| { - error.diagnostic.stage == "P7 entry selection" - && error - .diagnostic - .message - .contains("multiple `main` declarations") - })); -} - -#[test] -fn a_main_in_the_main_module_takes_precedence_and_unique_main_is_the_fallback() { - let other = ("Other.purs", "module Other where\nmain = 1\n"); - let main = ("Main.purs", "module Main where\nmain = 42\n"); - let preferred = compile_program_sources(&[other, main]).unwrap(); - let Some(output) = run_wasm(&preferred.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(42)); - - let unique = ("Runner.purs", "module Runner where\nmain = 7\n"); - let fallback = compile_program_sources(&[unique]).unwrap(); - let Some(output) = run_wasm(&fallback.wasm) else { - return; - }; - assert_eq!(output.status.code(), Some(7)); -} - -fn run_wasm(wasm: &[u8]) -> Option { - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_err() - { - if std::env::var("PSRS_REQUIRE_WASMTIME").as_deref() == Ok("1") { - panic!("PSRS_REQUIRE_WASMTIME=1 but wasmtime is not installed"); - } - eprintln!("skipping: wasmtime is not installed"); - return None; - } - static COUNTER: std::sync::atomic::AtomicU32 = std::sync::atomic::AtomicU32::new(0); - let id = COUNTER.fetch_add(1, std::sync::atomic::Ordering::Relaxed); - let path = std::env::temp_dir().join(format!( - "psrs-effect-entry-{}-{id}.wasm", - std::process::id() - )); - std::fs::write(&path, wasm).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - let _ = std::fs::remove_file(path); - Some(output) -} diff --git a/crates/psrs-driver/src/tests/effects/mod.rs b/crates/psrs-driver/src/tests/effects/mod.rs deleted file mode 100644 index 7c2951d6..00000000 --- a/crates/psrs-driver/src/tests/effects/mod.rs +++ /dev/null @@ -1,500 +0,0 @@ -mod contract; -mod entry; - -use super::super::*; -use std::sync::atomic::{AtomicU32, Ordering}; - -#[test] -fn constructing_an_effect_does_not_execute_it() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = log \"not printed\" in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert!(output.stdout.is_empty()); -} - -#[test] -fn running_effects_preserves_source_order() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let first = runEffect (log \"first\") in let second = runEffect (log \"second\") in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"first\nsecond\n"); -} - -#[test] -fn a_stored_effect_runs_each_time_it_is_explicitly_run() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = log \"again\" in let first = runEffect action in let second = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"again\nagain\n"); -} - -#[test] -fn a_function_cannot_be_passed_to_run_effect_as_an_effect() { - let source = "module Main where\nimport Prelude\nmain = runEffect (\\token -> 42)\n"; - let errors = compile_source("Main.purs", source).unwrap_err(); - assert!( - errors.iter().any(|error| { - error.stage == "P5 typecheck" && error.message.contains("type mismatch") - }) - ); -} - -#[test] -fn run_effect_is_only_available_from_the_selected_entry() { - let helper = ( - "Helper.purs", - "module Helper where\nimport Prelude\nrun = runEffect (pure 42)\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Helper\nmain = run\n", - ); - let errors = compile_program_sources_with_prelude(&[helper, main]).unwrap_err(); - assert!(errors.iter().any(|error| { - error.diagnostic.stage == "P7 entry selection" - && error - .diagnostic - .message - .contains("runEffect` binding may only be referenced") - })); -} - -#[test] -fn transitive_effect_types_keep_their_closure_representation() { - let library_source = ( - "Library.purs", - "module Library where\nimport Prelude\nimport WASI.Clock\naction :: Effect Int\naction = now\n", - ); - let main_source = ( - "Main.purs", - "module Main where\nimport Library\nforward = action\nmain = let ignored = forward in 0\n", - ); - let (sources, trusted_prefix) = - prelude::prepend(&[library_source, main_source]).expect("standard library"); - let typed = - crate::program::typecheck_program_sources_with_trusted_prefix(&sources, trusted_prefix) - .unwrap(); - let library = typed - .iter() - .find(|module| module.name == "Library") - .unwrap(); - let main = typed.iter().find(|module| module.name == "Main").unwrap(); - let action = library - .declarations - .iter() - .find(|declaration| declaration.name == "action") - .unwrap(); - let forward = main - .declarations - .iter() - .find(|declaration| declaration.name == "forward") - .unwrap(); - // `Effect Int` keeps the imported opaque type constructor into Core; it is - // not rewritten to an arrow. The backend selects the closure representation - // by identity. - let Some(psrs_thir::Type::Application(constructor, _)) = - library.types.get(action.ty.0 as usize) - else { - panic!("`Effect Int` must remain an applied opaque type"); - }; - assert!(matches!( - library.types.get(constructor.0 as usize), - Some(psrs_thir::Type::Constructor( - psrs_thir::TypeConstructor::User(_) - )) - )); - assert_eq!( - main.types.get(forward.ty.0 as usize), - library.types.get(action.ty.0 as usize) - ); - let artifact = compile_program_sources_with_prelude(&[library_source, main_source]); - assert!(artifact.is_ok(), "{artifact:?}"); -} - -#[test] -fn an_untrusted_prelude_effect_remains_an_ordinary_user_type() { - let prelude_source = ( - "Prelude.purs", - "module Prelude where\nforeign import data Effect :: Type -> Type\nforeign import \"wasi:clocks/monotonic-clock#now\" foreignEffect :: Effect Int\n", - ); - let main_source = ( - "Main.purs", - "module Main where\nimport Prelude\nforward :: Effect Int\nforward = foreignEffect\nmain = 0\n", - ); - let typed = crate::program::typecheck_program_sources(&[prelude_source, main_source]).unwrap(); - let main = typed.iter().find(|module| module.name == "Main").unwrap(); - let forward = main - .declarations - .iter() - .find(|declaration| declaration.name == "forward") - .unwrap(); - let psrs_thir::Type::Application(effect_constructor, _) = &main.types[forward.ty.0 as usize] - else { - panic!("untrusted Prelude.Effect should remain an applied user type"); - }; - assert!(matches!( - main.types[effect_constructor.0 as usize], - psrs_thir::Type::Constructor(psrs_thir::TypeConstructor::User(_)) - )); - let errors = compile_program_sources(&[prelude_source, main_source]) - .expect_err("the untrusted nominal Effect remains an ordinary WIT result type"); - assert!( - errors.iter().any(|error| { - error.diagnostic.stage == "P8 WIT linking" - && error - .diagnostic - .message - .contains("source result type incompatible") - }), - "{errors:#?}" - ); -} - -#[test] -fn running_pure_returns_the_supplied_value_without_an_external_action() { - let source = "module Main where\nimport Prelude\nmain = runEffect (pure 42)\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); - assert!( - output.stdout.is_empty(), - "pure must not perform an external action: {output:?}" - ); -} - -#[test] -fn bind_runs_the_first_effect_before_the_continuation() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (log \"first\") (\\_ -> log \"second\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"first\nsecond\n"); -} - -#[test] -fn bind_passes_the_first_result_to_the_continuation() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (pure 1) (\\x -> if x < 2 then log \"small\" else log \"big\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"small\n"); -} - -#[test] -fn nested_binds_preserve_left_to_right_order() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (log \"a\") (\\_ -> bind (log \"b\") (\\_ -> log \"c\")) in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"a\nb\nc\n"); -} - -#[test] -fn bind_runs_the_returned_effect_exactly_once() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (log \"once\") (\\_ -> log \"tail\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"once\ntail\n"); -} - -#[test] -fn an_effect_captured_by_a_closure_is_not_run() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = log \"captured\" in let holder = \\n -> action in let stored = holder in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert!( - output.stdout.is_empty(), - "capturing an effect must not run it: {output:?}" - ); -} - -#[test] -fn passing_an_effect_to_a_function_does_not_run_it() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nconsume :: forall a. Effect a -> Int\nconsume effect = 0\nmain = let action = log \"passed\" in consume action\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert!( - output.stdout.is_empty(), - "passing an effect must not run it: {output:?}" - ); -} - -#[test] -fn a_polymorphic_effect_uses_ordinary_adapters() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nidentityEffect :: forall a. Effect a -> Effect a\nidentityEffect effect = effect\nmain = let action = identityEffect (log \"generic\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"generic\n"); -} - -#[test] -fn a_polymorphic_effect_carries_string_and_number_values() { - let string = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (pure \"s\") (\\_ -> log \"str\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(string) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"str\n"); - - let number = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (pure 1.5) (\\_ -> log \"num\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(number) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"num\n"); -} - -#[test] -fn a_polymorphic_effect_carries_a_gc_aggregate() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\ndata Pair a = Pair a a\nidentityEffect :: forall a. Effect a -> Effect a\nidentityEffect effect = effect\nmain = let action = identityEffect (pure (Pair 1 2)) in let result = runEffect (bind action (\\p -> log \"poly\")) in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"poly\n"); -} - -#[test] -fn bind_preserves_wasi_results_across_stdout_and_stderr() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (error \"stderr\") (\\_ -> log \"stdout\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"stdout\n"); - assert_eq!(output.stderr, b"stderr\n"); -} - -#[test] -fn a_linked_module_forwards_an_effect_without_running_it() { - let producer = ( - "Producer.purs", - "module Producer where\nimport Prelude\nimport WASI.Console\naction :: Effect Unit\naction = log \"linked\"\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Prelude\nimport Producer\nforward :: Effect Unit\nforward = action\nmain = let stored = forward in 0\n", - ); - let Some(output) = run_effect_program_sources(&[producer, main]) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert!( - output.stdout.is_empty(), - "forwarding an effect must not run it: {output:?}" - ); -} - -#[test] -fn a_linked_module_forwards_an_effect_that_runs_only_when_selected() { - let producer = ( - "Producer.purs", - "module Producer where\nimport Prelude\nimport WASI.Console\naction :: Effect Unit\naction = log \"linked\"\n", - ); - let main = ( - "Main.purs", - "module Main where\nimport Prelude\nimport Producer\nforward :: Effect Unit\nforward = action\nmain = let result = runEffect forward in 0\n", - ); - let Some(output) = run_effect_program_sources(&[producer, main]) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"linked\n"); -} - -#[test] -fn a_boolean_effect_runs_through_bind() { - // `Boolean` and `Int` both lower to Wasm `i32`, so their closure signatures - // must share one concrete function type; otherwise the erased call site's - // `ref.cast` traps even though both are representationally identical. - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = bind (pure true) (\\x -> if x then log \"yes\" else log \"no\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"yes\n"); -} - -#[test] -fn discard_defined_from_bind_sequences_effects() { - // The Prelude defines `discard first next = bind first next`; the direct - // call returns an effect closure that must be adapted from the - // declaration's generic body result to the instantiated `Effect Int`. - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let action = discard (log \"a\") (\\_ -> log \"b\") in let result = runEffect action in 0\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"a\nb\n"); -} - -#[test] -fn a_standard_apply_composes_higher_order_effects() { - // `apply` is defined from `bind`; its first argument is an - // `Effect (a -> b)`, so the inner function must cross the erased boundary - // without losing its runtime call signature. - let source = "module Main where\nimport Prelude\nmain = runEffect (apply (pure (\\x -> x + 1)) (pure 41))\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -#[test] -fn map_composes_a_higher_order_effect() { - let source = - "module Main where\nimport Prelude\nmain = runEffect (map (\\x -> x + 1) (pure 41))\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -#[test] -fn ado_notation_combines_effectful_arguments_in_order() { - // `ado x <- a; y <- b; in f x y` desugars to - // `apply (map (\x -> \y -> f x y) a) b`; the curried continuation crosses - // the erased generic function boundary. - let source = "module Main where\nimport Prelude\nmain = runEffect (ado\n x <- pure 40\n y <- pure 2\n in x + y)\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -#[test] -fn ado_notation_runs_effects_left_to_right() { - // The `ado` block stays outside `let`: its `in` closes the nearest - // layout `let`, so the Int entry is the block's own result. - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = runEffect (ado\n first <- log \"first\"\n second <- log \"second\"\n in 0)\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0)); - assert_eq!(output.stdout, b"first\nsecond\n"); -} - -#[test] -fn an_effect_of_a_function_returns_a_separate_closure() { - // `Effect (Int -> Int)` is a closure whose result is a function value, not - // an effect that has been flattened into two parameters. Binding it and - // applying the returned function must still produce 42. - let source = "module Main where\nimport Prelude\nfoo :: Effect (Int -> Int)\nfoo = pure (\\x -> x + 1)\nmain = runEffect (bind foo (\\f -> pure (f 41)))\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -#[test] -fn an_effect_of_an_effect_runs_the_inner_effect() { - // `Effect (Effect Int)` stores one effect closure as the value of another. - // The inner closure must survive the outer bind and run exactly here. - let source = "module Main where\nimport Prelude\nnested :: Effect (Effect Int)\nnested = pure (pure 42)\nmain = runEffect (bind nested (\\inner -> inner))\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -#[test] -fn a_polymorphic_effect_combinator_runs() { - // A user-defined higher-order combinator over an erased `Effect a` value - // must compose through the closure representation. - let source = "module Main where\nimport Prelude\nrepeatAction :: forall a. Effect a -> Effect a\nrepeatAction action = bind action (\\_ -> action)\nmain = runEffect (repeatAction (pure 42))\n"; - let Some(output) = run_effect_program(source) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(42)); -} - -fn run_effect_program(source: &str) -> Option { - if !wasmtime_available() { - return None; - } - static COUNTER: AtomicU32 = AtomicU32::new(0); - let artifact = compile_source("Main.purs", source).unwrap(); - run_artifact(&artifact.wasm, "effect", &COUNTER) -} - -/// Runs a program linked from several source modules with the embedded -/// standard library. -fn run_effect_program_sources(sources: &[(&str, &str)]) -> Option { - if !wasmtime_available() { - return None; - } - static COUNTER: AtomicU32 = AtomicU32::new(0); - let artifact = compile_program_sources_with_prelude(sources).unwrap(); - run_artifact(&artifact.wasm, "effect-multi", &COUNTER) -} - -fn wasmtime_available() -> bool { - if std::process::Command::new("wasmtime") - .arg("--version") - .output() - .is_ok() - { - return true; - } - if std::env::var("PSRS_REQUIRE_WASMTIME").as_deref() == Ok("1") { - panic!("PSRS_REQUIRE_WASMTIME=1 but wasmtime is not installed"); - } - false -} - -fn run_artifact(wasm: &[u8], tag: &str, counter: &AtomicU32) -> Option { - let id = counter.fetch_add(1, Ordering::Relaxed); - let path = std::env::temp_dir().join(format!("psrs-{tag}-{}-{id}.wasm", std::process::id())); - std::fs::write(&path, wasm).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - let _ = std::fs::remove_file(path); - Some(output) -} diff --git a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs index 462238b2..7f1681e4 100644 --- a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs +++ b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs @@ -410,7 +410,6 @@ fn empty_array_reconstruction_executes() { ); let stages = psrs_backend::compile_with_context( prepared.core, - prepared.effect_context, psrs_backend::TargetCapabilities::default(), ) .expect("an empty concrete array must still lower through the conversion path"); diff --git a/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs b/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs index e2d2d8a7..a24268ec 100644 --- a/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs +++ b/crates/psrs-driver/src/tests/generic_aggregate_fixtures.rs @@ -54,7 +54,7 @@ pub(super) fn clear_array_literals(expression: &mut psrs_core::Expr) -> bool { | ExprKind::Boolean(_) | ExprKind::String(_) | ExprKind::Char(_) => false, - ExprKind::Unit | ExprKind::StateToken | ExprKind::Trap => false, + ExprKind::Unit | ExprKind::Trap => false, } } diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 545d50d8..d7d69534 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -12,8 +12,6 @@ mod data_tuple; mod declaration_calls; mod deriving; mod diagnosis_trace; -mod effect_arity; -mod effects; mod foldable; mod functor; mod guard_coverage; @@ -36,7 +34,6 @@ mod primitive_foreign; mod scalars; mod semigroup; mod show; -mod state; fn lower_source_to_mir(source: &str) -> psrs_backend::mir::Module { let backend_input = crate::lower_main_to_cc(source).expect("Core should lower to CC"); diff --git a/crates/psrs-driver/src/tests/parameterized_shapes.rs b/crates/psrs-driver/src/tests/parameterized_shapes.rs index abd77450..94c028eb 100644 --- a/crates/psrs-driver/src/tests/parameterized_shapes.rs +++ b/crates/psrs-driver/src/tests/parameterized_shapes.rs @@ -13,12 +13,9 @@ unwrap value = case value of main = arrayIndex (unwrap (wrap [40, 42])) 1 "; let prepared = crate::prepare_main(source).expect("source should lower to Core"); - let generic_cc = psrs_backend::lower_cc_with_context( - prepared.core.clone(), - prepared.effect_context.as_ref(), - ) - .expect("generic source Core should lower to CC before P7") - .cc; + let generic_cc = psrs_backend::cc::lower_module(prepared.core.clone()) + .expect("generic source Core should lower to CC before P7") + .cc; let generic_array_maps = aggregate_conversions(&generic_cc) .iter() .map(|conversion| array_map_count(&conversion.plan)) @@ -29,7 +26,6 @@ main = arrayIndex (unwrap (wrap [40, 42])) 1 ); let stages = psrs_backend::compile_with_context( prepared.core, - prepared.effect_context, psrs_backend::TargetCapabilities::default(), ) .expect("generic Array a must map at concrete call boundaries"); @@ -108,12 +104,9 @@ copy record = record { value = record.value } main = arrayIndex ((copy { items: [40, 42], value: 7 }).items) 1 "; let prepared = crate::prepare_main(source).expect("source should lower to Core"); - let generic_cc = psrs_backend::lower_cc_with_context( - prepared.core.clone(), - prepared.effect_context.as_ref(), - ) - .expect("generic source Core should lower to CC before P7") - .cc; + let generic_cc = psrs_backend::cc::lower_module(prepared.core.clone()) + .expect("generic source Core should lower to CC before P7") + .cc; let generic_conversions = aggregate_conversions(&generic_cc); assert!( generic_conversions @@ -127,7 +120,6 @@ main = arrayIndex ((copy { items: [40, 42], value: 7 }).items) 1 "record conversion retains explicit product construction"); let stages = psrs_backend::compile_with_context( prepared.core, - prepared.effect_context, psrs_backend::TargetCapabilities::default(), ) .expect("closed generic records should map across concrete instantiations"); @@ -155,12 +147,9 @@ duplicate values = values main = arrayIndex (arrayIndex (duplicate [[40, 42]]) 0) 1 "; let prepared = crate::prepare_main(source).expect("source should lower to Core"); - let generic_cc = psrs_backend::lower_cc_with_context( - prepared.core.clone(), - prepared.effect_context.as_ref(), - ) - .expect("generic source Core should lower to CC before P7") - .cc; + let generic_cc = psrs_backend::cc::lower_module(prepared.core.clone()) + .expect("generic source Core should lower to CC before P7") + .cc; let conversions = aggregate_conversions(&generic_cc); let maximum_nested_array_maps = conversions .iter() @@ -173,7 +162,6 @@ main = arrayIndex (arrayIndex (duplicate [[40, 42]]) 0) 1 ); let stages = psrs_backend::compile_with_context( prepared.core, - prepared.effect_context, psrs_backend::TargetCapabilities::default(), ) .expect("nested generic arrays should map recursively"); @@ -200,12 +188,9 @@ concrete values = values main = arrayIndex (applyArray concrete [40, 42]) 1 "; let prepared = crate::prepare_main(source).expect("source should lower to Core"); - let generic_cc = psrs_backend::lower_cc_with_context( - prepared.core.clone(), - prepared.effect_context.as_ref(), - ) - .expect("generic source Core should lower to CC before P7") - .cc; + let generic_cc = psrs_backend::cc::lower_module(prepared.core.clone()) + .expect("generic source Core should lower to CC before P7") + .cc; let array_maps = aggregate_conversions(&generic_cc) .iter() .map(|conversion| array_map_count(&conversion.plan)) @@ -216,7 +201,6 @@ main = arrayIndex (applyArray concrete [40, 42]) 1 ); let stages = psrs_backend::compile_with_context( prepared.core, - prepared.effect_context, psrs_backend::TargetCapabilities::default(), ) .expect("higher-order adapters should convert generic aggregate arguments and results"); diff --git a/crates/psrs-driver/src/tests/state/cc.rs b/crates/psrs-driver/src/tests/state/cc.rs deleted file mode 100644 index 7fee3a22..00000000 --- a/crates/psrs-driver/src/tests/state/cc.rs +++ /dev/null @@ -1,200 +0,0 @@ -use super::*; - -#[test] -fn source_state_choices_preserve_callback_blocks_through_wasm_encoding() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -choose :: Boolean -> (State RealWorld -> Step RealWorld Int) -> (State RealWorld -> Step RealWorld Int) -> State RealWorld -> Step RealWorld Int -choose flag left right state = if flag then left state else right state -ignore :: (State RealWorld -> Step RealWorld Int) -> Int -ignore action = 42 -main :: Int -main = ignore (choose true (\state -> { state: state, value: 40 }) (\state -> { state: state, value: 41 })) -"#; - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let target = psrs_backend::TargetCapabilities::default(); - let (mir, mut wasi) = - psrs_backend::mir::lower_module_with_bindings(input.cc, input.externals, target).unwrap(); - let branch = mir - .functions - .iter() - .find(|function| { - function.state.as_ref().is_some_and(|flow| { - flow.graph().blocks.len() == 4 - && flow - .graph() - .blocks - .iter() - .map(|block| block.transitions.len()) - .sum::() - == 2 - }) - }) - .unwrap(); - let owner = branch.symbol; - assert_eq!(branch.blocks.len(), 4); - let mir = psrs_backend::mir::opt::optimize(mir, target).unwrap(); - assert_eq!( - mir.functions - .iter() - .find(|function| function.symbol == owner) - .unwrap() - .blocks - .len(), - 4 - ); - let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); - psrs_backend::wasm::encode_module(&wasm).unwrap(); -} - -#[test] -fn source_state_callbacks_publish_mir_dependencies_without_step_storage() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -apply :: (State RealWorld -> Step RealWorld Int) -> State RealWorld -> Step RealWorld Int -apply action state = action state -ignore :: (State RealWorld -> Step RealWorld Int) -> Int -ignore action = 42 -main :: Int -main = ignore (apply (\state -> { state: state, value: 40 })) -"#; - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let (mir, mut wasi) = psrs_backend::mir::lower_module_with_bindings( - input.cc, - input.externals, - psrs_backend::TargetCapabilities::default(), - ) - .unwrap(); - let projected = mir - .functions - .iter() - .filter(|function| function.state.is_some()) - .collect::>(); - assert!(!projected.is_empty()); - assert!(projected.iter().any(|function| { - function.state.as_ref().unwrap().graph().blocks[0] - .transitions - .len() - == 1 - })); - for function in projected { - assert_eq!(function.result_type, psrs_backend::types::ValueType::I32); - assert!( - !function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .any(|instruction| matches!( - instruction, - psrs_backend::mir::Instruction::StructNew { .. } - )) - ); - } - psrs_backend::mir::verify_module(&mir).unwrap(); - let mir = - psrs_backend::mir::opt::optimize(mir, psrs_backend::TargetCapabilities::default()).unwrap(); - assert!( - mir.functions - .iter() - .any(|function| function.state.is_some()) - ); - let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); - psrs_backend::wasm::encode_module(&wasm).unwrap(); -} - -#[test] -fn pure_state_array_construction_preserves_incoming_dependency_aliases() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -produce :: State RealWorld -> Step RealWorld (Array Int) -produce state = { state: state, value: [40] } -action :: State RealWorld -> Step RealWorld Int -action state = case produce state of - { state: next, value: values } -> { state: state, value: arrayIndex values 0 } -ignore :: (State RealWorld -> Step RealWorld Int) -> Int -ignore callback = 42 -main :: Int -main = ignore action -"#; - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - let action = flows - .iter() - .find(|flow| { - flow.function.assignments.iter().any(|assignment| { - matches!( - assignment.kind, - psrs_backend::cc::AssignmentKind::ArrayGet { .. } - ) - }) - }) - .expect("the source action retains its array payload read"); - assert!(action.operations.is_empty()); - let (mir, _) = psrs_backend::mir::lower_module_with_bindings( - input.cc, - input.externals, - psrs_backend::TargetCapabilities::default(), - ) - .unwrap(); - assert!(mir.functions.iter().any(|function| { - function.state.is_some() - && function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .any(|instruction| { - matches!(instruction, psrs_backend::mir::Instruction::ArrayGet { .. }) - }) - })); -} - -#[test] -fn ordinary_newtype_pure_and_bind_produce_checked_cc_state_bodies() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -newtype Task a = Task (State RealWorld -> Step RealWorld a) -pureTask :: forall a. a -> Task a -pureTask value = Task (\state -> { state: state, value: value }) -bindTask :: forall a b. Task a -> (a -> Task b) -> Task b -bindTask (Task first) next = Task (\state0 -> - case first state0 of - { state: state1, value: value } -> - case next value of - Task second -> second state1) -ignore :: Task Int -> Int -ignore action = 42 -main :: Int -main = ignore (bindTask (pureTask 40) (\value -> pureTask (intAdd value 2))) -"#; - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - assert!(flows.iter().any(|flow| flow.operations.is_empty())); - assert!(flows.iter().any(|flow| flow.operations.len() == 2)); - for flow in &flows { - flow.verify(&input.cc).unwrap(); - } - let (mir, mut wasi) = psrs_backend::mir::lower_module_with_bindings( - input.cc, - input.externals, - psrs_backend::TargetCapabilities::default(), - ) - .unwrap(); - assert!(mir.functions.iter().any(|function| { - function - .state - .as_ref() - .is_some_and(|state| state.graph().blocks[0].transitions.len() == 2) - })); - let mir = - psrs_backend::mir::opt::optimize(mir, psrs_backend::TargetCapabilities::default()).unwrap(); - let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); - psrs_backend::wasm::encode_module(&wasm).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/state/command.rs b/crates/psrs-driver/src/tests/state/command.rs deleted file mode 100644 index 5310e4bf..00000000 --- a/crates/psrs-driver/src/tests/state/command.rs +++ /dev/null @@ -1,129 +0,0 @@ -use super::*; - -fn lower( - main: &str, - library: &str, - runner: &str, -) -> Result> { - crate::program::lower_program_to_core_with_runner( - &[("Main.purs", main), ("Runner.purs", library)], - "Runner", - runner, - ) -} - -const LIBRARY: &str = "module Runner where\nnewtype Command = Command Int\nrun :: Command -> Int\nrun (Command value) = value\n"; -const MAIN: &str = - "module Main where\nimport Runner (Command(..))\nmain :: Command\nmain = Command 42\n"; - -#[test] -fn configured_runner_wraps_an_unrelated_library_type_before_pruning() { - let core = lower(MAIN, LIBRARY, "run").unwrap(); - let entry = core - .declarations - .iter() - .find(|decl| Some(decl.symbol) == core.entry) - .unwrap(); - assert_eq!(entry.name, "$command_entry"); - let psrs_core::ExprKind::Application(function, argument) = &entry.value.kind else { - panic!("ordinary runner application expected") - }; - assert!( - matches!(function.kind, psrs_core::ExprKind::Global(symbol) if core.declarations.iter().any(|decl| decl.symbol == symbol && decl.name == "run")) - ); - assert!( - matches!(argument.kind, psrs_core::ExprKind::Global(symbol) if core.declarations.iter().any(|decl| decl.symbol == symbol && decl.name == "main")) - ); - core.verify().unwrap(); - psrs_backend::compile(core).unwrap(); -} - -#[test] -fn configured_runner_preserves_int_entries_and_rejects_invalid_selection_or_types() { - let core = lower("module Main where\nmain :: Int\nmain = 7\n", LIBRARY, "run").unwrap(); - assert_eq!( - core.declarations - .iter() - .find(|decl| Some(decl.symbol) == core.entry) - .unwrap() - .name, - "main" - ); - for (library, runner, message) in [ - (LIBRARY, "missing", "exactly one source declaration"), - ( - "module Runner where\nnewtype Command = Command Int\nrun :: forall a. a -> Int\nrun _ = 42\n", - "run", - "must be monomorphic", - ), - ( - "module Runner where\nnewtype Command = Command Int\nrun :: Command -> Boolean\nrun _ = true\n", - "run", - "must return Int", - ), - ( - "module Runner where\nnewtype Command = Command Int\nnewtype Other = Other Int\nrun :: Other -> Int\nrun (Other value) = value\n", - "run", - "disagrees with the configured runner input", - ), - ] { - let errors = lower(MAIN, library, runner).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.message.contains(message)), - "{errors:?}" - ); - } -} - -#[test] -fn command_normalization_failure_preserves_the_checked_core() { - let mut core = lower(MAIN, LIBRARY, "run").unwrap(); - let before = core.clone(); - let entry = core - .declarations - .iter() - .find(|decl| decl.name == "main") - .unwrap() - .symbol; - let unknown = psrs_hir::SymbolId::new(entry.module, u32::MAX); - assert!(psrs_core::command::normalize_entry(&mut core, entry, unknown).is_err()); - assert_eq!(core, before); -} - -#[test] -fn configured_runner_executes_a_state_newtype_without_an_explicit_main_runner_call() { - let library = r#"module Runner where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -newtype Job a = Job (State RealWorld -> Step RealWorld a) -run :: Job Int -> Int -run (Job action) = execute action -"#; - let main = r#"module Main where -import Runner (Job(..)) -main :: Job Int -main = Job (\state -> { state: state, value: 42 }) -"#; - let core = lower(main, library, "run").unwrap(); - if wasmtime_available().is_none() { - return; - } - let artifact = psrs_backend::compile(core).unwrap(); - let path = std::env::temp_dir().join(format!("psrs-command-state-{}.wasm", std::process::id())); - std::fs::write(&path, artifact.wasm).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - std::fs::remove_file(&path).unwrap(); - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} diff --git a/crates/psrs-driver/src/tests/state/host.rs b/crates/psrs-driver/src/tests/state/host.rs deleted file mode 100644 index d0f4905b..00000000 --- a/crates/psrs-driver/src/tests/state/host.rs +++ /dev/null @@ -1,156 +0,0 @@ -//! Source newtypes and canonical host adapters retain one dependency chain. -use super::*; - -fn source(declarations: &str, action: &str) -> String { - format!( - r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = {{ state :: State s, value :: a }} -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -newtype Task a = Task (State RealWorld -> Step RealWorld a) -{declarations} -action :: Task Int -action = Task (\state0 -> {action}) -main :: Int -main = case action of - Task run -> execute run -"# - ) -} - -#[test] -fn source_newtype_host_resources_and_canonical_scalars_execute() { - for (declarations, action) in [ - ( - r#"foreign import data Stream :: Type -foreign import "wasi:cli/stdout#get-stdout" stdout :: State RealWorld -> Step RealWorld Stream -foreign import "wasi:io/streams#[resource-drop]output-stream" release :: Stream -> State RealWorld -> Step RealWorld Unit"#, - r#"case stdout state0 of - { state: state1, value: stream } -> case release stream state1 of - { state: state2, value: _ } -> { state: state2, value: 42 }"#, - ), - ( - r#"foreign import data Pollable :: Type -foreign import "wasi:clocks/monotonic-clock#subscribe-duration" subscribe :: Int -> State RealWorld -> Step RealWorld Pollable -foreign import "wasi:io/poll#[resource-drop]pollable" release :: Pollable -> State RealWorld -> Step RealWorld Unit"#, - r#"case subscribe 0 state0 of - { state: state1, value: pollable } -> case release pollable state1 of - { state: state2, value: _ } -> { state: state2, value: 42 }"#, - ), - ( - r#"foreign import "wasi:clocks/wall-clock#now" now :: State RealWorld -> Step RealWorld { seconds :: Int, nanoseconds :: Int } -foreign import "psrs:intrinsic#intLt" lt :: Int -> Int -> Boolean"#, - r#"case now state0 of - { state: state1, value: time } -> - { state: state1, value: if lt time.nanoseconds 1000000000 then 42 else 1 }"#, - ), - ] { - let source = source(declarations, action); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); - } -} - -#[test] -fn source_newtype_host_list_adapter_executes_its_loop_and_cleanup() { - let source = source( - r#"foreign import "wasi:cli/environment#get-arguments" arguments :: State RealWorld -> Step RealWorld (Array String) -foreign import "psrs:intrinsic#arrayLength" length :: forall a. Array a -> Int"#, - r#"case arguments state0 of - { state: state1, value: items } -> { state: state1, value: length items }"#, - ); - let Some(output) = run_with_wasmtime_args(&source, &["alpha", "beta"]) else { - return; - }; - assert_eq!(output.status.code(), Some(3), "{output:?}"); -} - -#[test] -fn source_newtype_host_variant_adapter_executes_checked_internal_edges() { - let source = source( - r#"foreign import data Stream :: Type -foreign import data Error :: Type -data StreamError = LastOperationFailed Error | Closed -foreign import "wasi:cli/stdout#get-stdout" stdout :: State RealWorld -> Step RealWorld Stream -foreign import "wasi:io/streams#[method]output-stream.flush" flush :: Stream -> State RealWorld -> Step RealWorld (Either StreamError Unit) -foreign import "wasi:io/streams#[resource-drop]output-stream" release :: Stream -> State RealWorld -> Step RealWorld Unit -foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a"#, - r#"case stdout state0 of - { state: state1, value: stream } -> case flush stream state1 of - { state: state2, value: _ } -> case release stream state2 of - { state: state3, value: _ } -> read [42] 0 state3"#, - ).replace("import Prim.State", "import Data.Either (Either)\nimport Prim.State"); - let sources = [ - ( - "Either.purs", - "module Data.Either (Either(..)) where\ndata Either a b = Left a | Right b\n", - ), - ("Main.purs", source.as_str()), - ]; - let Some(output) = run_program_with_wasmtime(&sources) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); - let core = lower_program_to_core(&sources).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let (module, _) = psrs_backend::mir::lower_module_with_bindings( - input.cc, - input.externals, - psrs_backend::TargetCapabilities::default(), - ) - .unwrap(); - psrs_backend::mir::verify_module(&module).unwrap(); - let mut changed = module.clone(); - let block = changed - .functions - .iter_mut() - .flat_map(|function| &mut function.blocks) - .find(|block| { - matches!( - block.terminator, - Some(psrs_backend::mir::Terminator::Switch { .. }) - ) - }) - .expect("canonical variant result must select its checked case"); - let psrs_backend::mir::Terminator::Switch { default, cases, .. } = - block.terminator.as_mut().unwrap() - else { - panic!() - }; - *default = cases[0].1; - let errors = psrs_backend::mir::verify_module(&changed).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 canonical call verification"), - "changing the internal edge must fail canonical correspondence: {errors:?}" - ); -} - -#[test] -fn bare_foreign_function_values_use_checked_source_schemes() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import data Stream :: Type -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "wasi:cli/stdout#get-stdout" get :: State RealWorld -> Step RealWorld Stream -foreign import "wasi:io/streams#[resource-drop]output-stream" release :: Stream -> State RealWorld -> Step RealWorld Unit -newtype Native a = Native (State RealWorld -> Step RealWorld a) -fromState :: forall a. (State RealWorld -> Step RealWorld a) -> Native a -fromState body = Native body -stdout :: Native Stream -stdout = fromState get -main :: Int -main = case stdout of - Native call -> execute (\state0 -> case call state0 of - { state: state1, value: stream } -> case release stream state1 of - { state: state2, value: _ } -> { state: state2, value: 42 }) -"#; - let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} diff --git a/crates/psrs-driver/src/tests/state/mod.rs b/crates/psrs-driver/src/tests/state/mod.rs deleted file mode 100644 index ca1088be..00000000 --- a/crates/psrs-driver/src/tests/state/mod.rs +++ /dev/null @@ -1,482 +0,0 @@ -//! State contracts compose with ordinary source newtypes and nominal regions. -use super::*; - -mod cc; -mod command; -mod host; -mod runners; -mod runtime_cc; -mod scoped_callbacks; -mod storage_protocol; -mod zero_width_choices; - -fn state_flow_source(body: &str) -> String { - format!( - r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = {{ state :: State s, value :: a }} -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a -action :: State RealWorld -> Step RealWorld Int -action state0 = {body} -main :: Int -main = execute action -"# - ) -} - -#[test] -fn source_state_calls_produce_core_dependencies_before_projection() { - let source = state_flow_source( - r#"case read [40] 0 state0 of - { state: state1, value: first } -> case read [first] 0 state1 of - { state: state2, value: second } -> { state: state2, value: second }"#, - ); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let flows = psrs_core::state::flow::check(&core).unwrap(); - let action = flows - .iter() - .find(|flow| flow.operations.len() == 2) - .expect("two actual runtime-bound source invocations"); - action.verify(&core).unwrap(); - assert_eq!(action.operations[1].input, action.operations[0].output); -} - -#[test] -fn source_state_flow_rejects_stale_returns_and_replayed_predecessors() { - for (body, message) in [ - ( - r#"case read [40] 0 state0 of - { state: state1, value: first } -> { state: state0, value: first }"#, - "state return discards an executed operation", - ), - ( - r#"case read [40] 0 state0 of - { state: state1, value: first } -> read [first] 0 state0"#, - "state call consumes a stale dependency", - ), - ] { - let source = state_flow_source(body); - check_program(&[("Main.purs", &source)]).unwrap(); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P7 Core verification" - && error.diagnostic.message == message), - "{errors:?}" - ); - } -} - -#[test] -fn source_state_branch_joins_preserve_the_selected_dependency() { - let source = state_flow_source( - r#"case (if true then read [40] 0 state0 else read [2] 0 state0) of - { state: state1, value: first } -> read [first] 0 state1"#, - ); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let flows = psrs_core::state::flow::check(&core).unwrap(); - let action = flows - .iter() - .find(|flow| flow.operations.len() == 3) - .unwrap(); - assert_eq!(action.graph.blocks.len(), 4); - action.verify(&core).unwrap(); -} - -#[test] -fn ordinary_library_newtype_bind_retains_checked_core_state_flow() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -newtype Task a = Task (State RealWorld -> Step RealWorld a) -pureTask :: forall a. a -> Task a -pureTask value = Task (\state -> { state: state, value: value }) -bindTask :: forall a b. Task a -> (a -> Task b) -> Task b -bindTask (Task first) next = Task (\state0 -> - case first state0 of - { state: state1, value: value } -> - case next value of - Task second -> second state1) -main :: Int -main = case bindTask (pureTask 40) (\value -> pureTask (intAdd value 2)) of - Task action -> execute action -"#; - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let flows = psrs_core::state::flow::check(&core).unwrap(); - assert!(flows.iter().any(|flow| flow.operations.is_empty())); - assert!(flows.iter().any(|flow| flow.operations.len() == 2)); -} - -#[test] -fn state_newtype_combinators_are_ordinary_library_definitions() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -newtype Task a = Task (State RealWorld -> Step RealWorld a) -type role Task representational -pureTask :: forall a. a -> Task a -pureTask value = Task (\state -> { state: state, value: value }) -bindTask :: forall a b. Task a -> (a -> Task b) -> Task b -bindTask (Task first) next = Task (\state0 -> - case first state0 of - { state: state1, value: value } -> - case next value of - Task second -> second state1) -main :: Int -main = 0 -"#; - check_program(&[("Main.purs", source)]) - .unwrap_or_else(|errors| panic!("ordinary state combinators: {errors:?}")); -} - -#[test] -fn the_state_region_cannot_be_safely_coerced() { - let source = r#"module Main where -import Prim.State (State) -import Safe.Coerce (coerce) -newtype RegionA = RegionA Int -newtype RegionB = RegionB Int -mix :: State RegionA -> State RegionB -mix = coerce -main :: Int -main = 0 -"#; - let errors = check_program(&[("Main.purs", source)]).expect_err("nominal state regions"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.code == Some("NoInstanceFound")), - "{errors:?}" - ); -} - -#[test] -fn unsafe_state_operations_require_an_explicit_binding() { - let unbound = "module Main where\nmain = runWorld (\\state -> { state: state, value: 42 })\n"; - let errors = check_program(&[("Main.purs", unbound)]).expect_err("no implicit unsafe runner"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P3 resolve"), - "{errors:?}" - ); - let bound = r#"module Main where -import Prim.State (State, RealWorld) -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> { state :: State RealWorld, value :: a }) -> a -main :: Int -main = execute (\state -> { state: state, value: 42 }) -"#; - check_program(&[("Main.purs", bound)]) - .unwrap_or_else(|errors| panic!("explicit state runner scheme: {errors:?}")); -} - -#[test] -fn state_binding_validation_rejects_invalid_unused_runner_schemes() { - for contract in [ - "forall s a. (State s -> { state :: State s, value :: a }) -> a", - "forall a. (State RealWorld -> { state :: State RealWorld, value :: a }) -> State RealWorld", - "forall a. (State RealWorld -> { state :: State RealWorld, value :: a, extra :: Int }) -> a", - ] { - let source = format!( - "module Main where\nimport Prim.State (State, RealWorld)\nforeign import \"psrs:intrinsic#runWorld\" execute :: {contract}\nmain = 0\n" - ); - let errors = compile_program_sources(&[("Main.purs", &source)]) - .expect_err("invalid unused state binding"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P8 primitive linking" - && !error - .diagnostic - .message - .contains("no foreign-function implementation")), - "{errors:?}" - ); - } -} - -fn runtime_source(export: &str, scheme: &str) -> String { - format!( - "module Main where\nimport Prim.State (State, RealWorld)\ntype Step s a = {{ state :: State s, value :: a }}\nforeign import \"psrs:runtime-storage#{export}\" operation :: {scheme}\nmain :: Int\nmain = 0\n" - ) -} - -#[test] -fn storage_uses_ordinary_runtime_binding_identity() { - let source = runtime_source( - "array_read", - "forall s a. Array a -> Int -> State s -> Step s a", - ); - let modules = resolve_program_sources(&[("Main.purs", &source)]).unwrap(); - let external = modules[0] - .externals - .iter() - .find(|external| external.name == "operation") - .unwrap(); - assert_eq!( - external.kind, - psrs_hir::ExternalKind::Runtime { - module: "psrs:runtime-storage".into(), - function: "array_read".into(), - } - ); -} - -#[test] -fn checked_unused_runtime_storage_schemes_compile_without_imports() { - for (export, scheme) in [ - ( - "array_read", - "forall s a. Array a -> Int -> State s -> Step s a", - ), - ( - "array_fill", - "forall s a. Int -> a -> State s -> Step s (Array a)", - ), - ( - "array_write", - "forall s a. Array a -> Int -> a -> State s -> Step s Unit", - ), - ("trap", "forall s a. State s -> Step s a"), - ] { - let source = runtime_source(export, scheme); - check_program(&[("Main.purs", &source)]) - .unwrap_or_else(|errors| panic!("{export}: {errors:?}")); - compile_program_sources(&[("Main.purs", &source)]) - .unwrap_or_else(|errors| panic!("{export}: {errors:?}")); - } -} - -#[test] -fn runtime_binding_contracts_reject_invalid_unused_declarations() { - for (export, scheme) in [ - ( - "array_read", - "forall s a. Array a -> Boolean -> State s -> Step s a", - ), - ( - "array_read", - "forall s a. Array a -> Int -> State s -> Step s Int", - ), - ( - "array_read", - "forall s t a. Array a -> Int -> State s -> Step t a", - ), - ( - "array_read", - "forall s a. Array a -> Int -> State s -> { state :: State s, value :: a, extra :: Int }", - ), - ( - "array_fill", - "forall s a. Int -> a -> State s -> Step s Int", - ), - ( - "array_fill", - "forall s a. Int -> a -> State s -> Step s (Array Int)", - ), - ( - "array_write", - "forall s a b. Array a -> Int -> b -> State s -> Step s Unit", - ), - ( - "array_write", - "forall s a. Array a -> Int -> a -> State s -> Step s Int", - ), - ("trap", "Int -> Int"), - ] { - let source = runtime_source(export, scheme); - let errors = compile_program_sources(&[("Main.purs", &source)]) - .expect_err("invalid unused runtime binding"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P8 runtime linking"), - "{export}: {errors:?}" - ); - } -} - -#[test] -fn unknown_runtime_exports_and_retired_storage_intrinsics_are_rejected() { - let source = runtime_source("missing", "forall s a. State s -> Step s a"); - let errors = - compile_program_sources(&[("Main.purs", &source)]).expect_err("unknown runtime export"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P8 runtime linking" - && error.diagnostic.message.contains("no export")), - "{errors:?}" - ); - let source = runtime_source( - "array_read", - "forall s a. Array a -> Int -> State s -> Step s a", - ) - .replace( - "psrs:runtime-storage#array_read", - "psrs:intrinsic#stateArrayRead", - ); - let errors = check_program(&[("Main.purs", &source)]).expect_err("retired intrinsic"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P3 resolve"), - "{errors:?}" - ); -} - -#[test] -fn state_accepts_the_official_st_region_kind() { - let source = r#"module Main where -import Prim.State (State) -foreign import data Region :: Type -foreign import data Global :: Region -type Step s a = { state :: State s, value :: a } -foreign import "psrs:runtime-storage#array_read" readGlobal :: forall a. Array a -> Int -> State Global -> Step Global a -foreign import "psrs:intrinsic#runRegion" runLocal :: forall a. (forall (s :: Region). State s -> Step s a) -> a -newtype Action r a = Action (State r -> { state :: State r, value :: a }) -type role Action nominal representational -global :: Action Global Int -global = Action (\state -> { state: state, value: 42 }) -main :: Int -main = 0 -"#; - check_program(&[("Main.purs", source)]) - .unwrap_or_else(|errors| panic!("official ST region kind: {errors:?}")); - compile_program_sources(&[("Main.purs", source)]) - .unwrap_or_else(|errors| panic!("official ST region kind compilation: {errors:?}")); -} - -#[test] -fn callable_newtype_templates_survive_higher_kinded_storage() { - let source = r#"module Main where -newtype Reader r a = Reader (r -> a) -newtype Runner = Runner (forall f a. (f a -> Int) -> f a -> Int) -runner :: Runner -runner = Runner (\consume value -> consume value) -run :: Reader Int Int -> Int -run (Reader action) = action 2 -main :: Int -main = case runner of - Runner invoke -> invoke run (Reader (\value -> intAdd value 40)) -"#; - let Some(output) = run_with_wasmtime(source) else { - return; - }; - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -#[test] -fn structured_callable_newtype_domains_and_results_survive_storage() { - let source = r#"module Main where -newtype Batch r a = Batch (Array r -> { tag :: Int, value :: a }) -newtype Runner = Runner (forall f a. (f a -> Int) -> f a -> Int) -runner :: Runner -runner = Runner (\consume value -> consume value) -run :: Batch Int Int -> Int -run (Batch action) = let result = action [2] in intAdd result.tag result.value -main :: Int -main = case runner of - Runner invoke -> invoke run (Batch (\values -> { tag: arrayIndex values 0, value: 40 })) -"#; - let Some(output) = run_with_wasmtime(source) else { - return; - }; - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -#[test] -fn higher_kinded_adt_field_preserves_callable_newtype() { - let source = r#"module Main where -data Holder f a = Holder (f a) -newtype Reader r a = Reader (r -> a) -hold :: forall f a. f a -> Holder f a -hold value = Holder value -recover :: forall f a. Holder f a -> f a -recover (Holder value) = value -run :: Reader Int Int -> Int -run (Reader action) = action 2 -main :: Int -main = run (recover (hold (Reader (\value -> intAdd value 40)))) -"#; - let Some(output) = run_with_wasmtime(source) else { - return; - }; - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -#[test] -fn higher_kinded_adt_field_preserves_structured_callable_newtype() { - let source = r#"module Main where -data Holder f a = Holder (f a) -newtype Batch r a = Batch (Array r -> { tag :: Int, value :: a }) -hold :: forall f a. f a -> Holder f a -hold value = Holder value -recover :: forall f a. Holder f a -> f a -recover (Holder value) = value -run :: Batch Int Int -> Int -run (Batch action) = let result = action [2] in intAdd result.tag result.value -main :: Int -main = run (recover (hold (Batch (\values -> { tag: arrayIndex values 0, value: 40 })))) -"#; - let Some(output) = run_with_wasmtime(source) else { - return; - }; - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -#[test] -fn ordinary_state_callbacks_lower_to_checked_cc_instruction_dependencies() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -apply :: (State RealWorld -> Step RealWorld Int) -> State RealWorld -> Step RealWorld Int -apply action state = action state -ignore :: (State RealWorld -> Step RealWorld Int) -> Int -ignore action = 42 -main :: Int -main = ignore (apply (\state -> { state: state, value: 40 })) -"#; - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - let apply = flows - .iter() - .find(|flow| { - flow.operations.len() == 1 - && matches!( - flow.operations[0].assignment.kind, - psrs_backend::cc::AssignmentKind::IndirectCall { .. } - ) - }) - .expect("a source callback invocation survives as an actual CC indirect call"); - assert_eq!(apply.operations.len(), 1); - assert!(matches!( - apply.operations[0].assignment.kind, - psrs_backend::cc::AssignmentKind::IndirectCall { .. } - )); - apply.verify(&input.cc).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/state/runners.rs b/crates/psrs-driver/src/tests/state/runners.rs deleted file mode 100644 index 4c502e14..00000000 --- a/crates/psrs-driver/src/tests/state/runners.rs +++ /dev/null @@ -1,410 +0,0 @@ -use super::*; - -fn world(body: &str) -> String { - format!( - r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = {{ state :: State s, value :: a }} -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -main :: Int -main = {body} -"# - ) -} - -fn compile(source: &str) -> (psrs_backend::mir::Module, psrs_backend::abi::WasiRegistry) { - let core = lower_program_to_core(&[("Main.purs", source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let target = psrs_backend::TargetCapabilities::default(); - let (mir, wasi) = - psrs_backend::mir::lower_module_with_bindings(input.cc, input.externals, target).unwrap(); - let mir = psrs_backend::mir::opt::optimize(mir, target).unwrap(); - (mir, wasi) -} - -#[test] -fn source_world_runner_projects_a_closed_invocation() { - let source = world("execute (\\state -> { state: state, value: 42 })"); - let (mir, mut wasi) = compile(&source); - assert!(mir.functions.iter().any(|function| { - function - .state - .as_ref() - .is_some_and(|flow| flow.executions().len() == 1) - })); - let wasm = psrs_backend::wasm::lower_module(&mir, &mut wasi).unwrap(); - psrs_backend::wasm::encode_module(&wasm).unwrap(); -} - -fn execute(source: &str, expected: i32) { - let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - }; - assert_eq!( - output.status.code(), - Some(expected), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -#[test] -fn source_world_runner_executes_the_source_selected_entry() { - execute( - &world("execute (\\state -> { state: state, value: 42 })"), - 42, - ); -} - -#[test] -fn abstract_constructor_transport_preserves_state_and_converts_only_the_payload() { - execute( - r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -newtype Job a = Job (State RealWorld -> Step RealWorld a) -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -preserve :: forall f a. f a -> f a -preserve value = value -unwrap :: forall a. Job a -> State RealWorld -> Step RealWorld a -unwrap (Job action) = action -main :: Int -main = execute (unwrap (preserve (Job (\state -> { state: state, value: 42 })))) -"#, - 42, - ); -} - -#[test] -fn source_region_runner_executes_a_rank_n_body() { - let source = r#"module Main where -import Prim.State (State) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runRegion" scoped :: forall a. (forall s. State s -> Step s a) -> a -main :: Int -main = scoped (\state -> { state: state, value: 43 }) -"#; - execute(source, 43); -} - -#[test] -fn nested_source_runners_preserve_both_invocation_boundaries() { - let source = world( - "execute (\\outer -> { state: outer, value: execute (\\inner -> { state: inner, value: 44 }) })", - ); - let (mir, _) = compile(&source); - assert_eq!( - mir.functions - .iter() - .filter_map(|function| function.state.as_ref()) - .map(|flow| flow.executions().len()) - .sum::(), - 2 - ); - execute(&source, 44); -} - -#[test] -fn repeated_source_runners_retain_two_dynamic_calls() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:intrinsic#intAdd" add :: Int -> Int -> Int -action :: State RealWorld -> Step RealWorld Int -action state = { state: state, value: 41 } -main :: Int -main = add (execute action) (execute action) -"#; - let (mir, _) = compile(source); - let runners = mir - .functions - .iter() - .filter(|function| { - function - .state - .as_ref() - .is_some_and(|flow| !flow.executions().is_empty()) - }) - .map(|function| function.symbol) - .collect::>(); - let entry = mir - .functions - .iter() - .find(|function| Some(function.symbol) == mir.entry) - .unwrap(); - assert_eq!(runners.len(), 2); - let closures = entry - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| match instruction { - psrs_backend::mir::Instruction::ClosureNew { - destination, - function, - .. - } if runners.contains(function) => Some(*destination), - _ => None, - }) - .collect::>(); - assert_eq!( - entry - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter(|instruction| matches!(instruction, - psrs_backend::mir::Instruction::ClosureCall { function, .. } - if closures.contains(function))) - .count(), - 2 - ); - execute(source, 82); -} - -#[test] -fn runner_projection_rejects_removed_calls_and_changed_action_operands() { - let source = world("execute (\\state -> { state: state, value: 42 })"); - let (mir, _) = compile(&source); - let index = mir - .functions - .iter() - .position(|function| { - function - .state - .as_ref() - .is_some_and(|flow| !flow.executions().is_empty()) - }) - .unwrap(); - let mut missing = mir.clone(); - missing.functions[index].blocks[0] - .instructions - .retain(|instruction| { - !matches!( - instruction, - psrs_backend::mir::Instruction::ClosureCall { .. } - ) - }); - if matches!( - missing.functions[index].blocks[0].terminator, - Some(psrs_backend::mir::Terminator::ReturnCallRef { .. }) - ) { - missing.functions[index].blocks[0].terminator = Some(psrs_backend::mir::Terminator::Trap { - span: missing.functions[index].span, - }); - } - assert!( - psrs_backend::mir::verify_module(&missing) - .unwrap_err() - .iter() - .any(|error| error.pass == "P9 MIR dependency verification" - && (error.message.contains("loses an invocation") - || error.message.contains("tail conversion"))) - ); - let mut changed = mir; - let function = &mut changed.functions[index]; - let replacement = function.result; - if let Some(psrs_backend::mir::Instruction::ClosureCall { function, .. }) = function.blocks[0] - .instructions - .iter_mut() - .find(|instruction| { - matches!( - instruction, - psrs_backend::mir::Instruction::ClosureCall { .. } - ) - }) - { - *function = replacement; - } - if let Some(psrs_backend::mir::Terminator::ReturnCallRef { - function: callee, .. - }) = &mut function.blocks[0].terminator - { - *callee = replacement; - } - assert!( - psrs_backend::mir::verify_module(&changed) - .unwrap_err() - .iter() - .any(|error| error.pass == "P9 MIR dependency verification" - && (error.message.contains("invocation producer") - || error.message.contains("tail conversion"))) - ); -} - -#[test] -fn ordinary_newtype_pure_and_bind_execute_through_the_library_runner() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -newtype Task a = Task (State RealWorld -> Step RealWorld a) -pureTask :: forall a. a -> Task a -pureTask value = Task (\state -> { state: state, value: value }) -bindTask :: forall a b. Task a -> (a -> Task b) -> Task b -bindTask (Task first) next = Task (\state0 -> - case first state0 of - { state: state1, value: value } -> - case next value of - Task second -> second state1) -runTask :: forall a. Task a -> a -runTask (Task action) = execute action -main :: Int -main = runTask (bindTask (pureTask 40) (\value -> pureTask (intAdd value 6))) -"#; - execute(source, 46); -} - -#[test] -fn source_runner_propagates_a_trap_from_the_invoked_body() { - let source = world("execute (\\state -> { state: state, value: quotient 1 0 })").replace( - "main :: Int", - "foreign import \"psrs:intrinsic#intQuot\" quotient :: Int -> Int -> Int\nmain :: Int", - ); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert!(!output.status.success()); - let stderr = String::from_utf8_lossy(&output.stderr); - assert!(stderr.contains("integer divide by zero"), "{stderr}"); -} - -#[test] -fn a_callable_step_payload_keeps_its_source_operand_during_optimization() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -produce :: State RealWorld -> Step RealWorld (State RealWorld -> Step RealWorld Int) -produce state = { state: state, value: \next -> { state: next, value: 47 } } -main :: Int -main = execute (\initial -> case produce initial of - { state: next, value: callback } -> callback next) -"#; - execute(source, 47); -} - -#[test] -fn a_state_callable_crosses_a_bare_polymorphic_payload() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -data Holder a = Holder a -unwrap :: forall a. Holder a -> a -unwrap (Holder value) = value -action :: State RealWorld -> Step RealWorld Int -action state = { state: state, value: 42 } -main :: Int -main = execute (unwrap (Holder action)) -"#; - execute(source, 42); -} - -#[test] -fn a_state_callable_curries_ordinary_arguments_before_its_dependency() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:intrinsic#intAdd" add :: Int -> Int -> Int -data Holder a = Holder a -unwrap :: forall a. Holder a -> a -unwrap (Holder value) = value -action :: Int -> Int -> State RealWorld -> Step RealWorld Int -action left right state = { state: state, value: add left right } -main :: Int -main = execute ((unwrap (Holder action)) 20 23) -"#; - execute(source, 43); -} - -#[test] -fn state_callables_cross_polymorphic_array_payloads() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:intrinsic#arrayIndex" index :: forall a. Array a -> Int -> a -data Holder a = Holder a -unwrap :: forall a. Holder a -> a -unwrap (Holder value) = value -action :: State RealWorld -> Step RealWorld Int -action state = { state: state, value: 44 } -main :: Int -main = execute (index (unwrap (Holder [action])) 0) -"#; - execute(source, 44); -} - -#[test] -fn stored_state_callables_keep_fresh_region_checking() { - let source = r#"module Main where -import Prim.State (State) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runRegion" scoped :: forall a. (forall s. State s -> Step s a) -> a -data Holder a = Holder a -unwrap :: forall a. Holder a -> a -unwrap (Holder value) = value -action :: forall s. State s -> Step s Int -action state = { state: state, value: 45 } -main :: Int -main = scoped (\state -> (unwrap (Holder action)) state) -"#; - execute(source, 45); - let wrong = source - .replace( - "import Prim.State (State)", - "import Prim.State (State, RealWorld)", - ) - .replace( - "action :: forall s. State s -> Step s Int", - "action :: State RealWorld -> Step RealWorld Int", - ); - let errors = lower_program_to_core(&[("Main.purs", wrong.as_str())]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P5 typecheck"), - "{errors:?}" - ); -} - -#[test] -fn erased_state_callables_preserve_a_callable_step_payload() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:intrinsic#intAdd" add :: Int -> Int -> Int -data Holder a = Holder a -unwrap :: forall a. Holder a -> a -unwrap (Holder value) = value -action :: State RealWorld -> Step RealWorld (Int -> Int) -action state = { state: state, value: \value -> add value 1 } -main :: Int -main = (execute (unwrap (Holder action))) 45 -"#; - execute(source, 46); -} - -#[test] -fn polymorphic_array_transport_preserves_mutable_storage_aliases() { - let source = r#"module Main where -foreign import "psrs:intrinsic#arrayIndex" index :: forall a. Array a -> Int -> a -foreign import "psrs:intrinsic#arrayWrite" write :: forall a. Array a -> Int -> a -> Array a -data Holder a = Holder a -unwrap :: forall a. Holder a -> a -unwrap (Holder value) = value -main :: Int -main = let original = [10, 20] - alias = unwrap (Holder original) - written = write original 0 99 - ignored = write written 1 21 - in index alias 0 -"#; - execute(source, 99); -} diff --git a/crates/psrs-driver/src/tests/state/runtime_cc.rs b/crates/psrs-driver/src/tests/state/runtime_cc.rs deleted file mode 100644 index f4d0d0bb..00000000 --- a/crates/psrs-driver/src/tests/state/runtime_cc.rs +++ /dev/null @@ -1,366 +0,0 @@ -use super::*; - -#[test] -fn a_partially_applied_runtime_binding_preserves_its_source_scheme() { - let source = state_flow_source("let reader = read [42] 0 in reader state0"); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let binding = &input.externals.runtime[0]; - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - let operation = flows.iter().flat_map(|flow| &flow.operations).find(|operation| - matches!(operation.assignment.kind, psrs_backend::cc::AssignmentKind::DirectCall { function, .. } if function == binding.symbol)).unwrap(); - assert_ne!(operation.input, operation.output); - for flow in &flows { - flow.verify(&input.cc).unwrap(); - } -} - -#[test] -fn runtime_fill_write_read_preserve_the_cc_successor_chain() { - let source = state_flow_source( - r#"case fill 2 40 state0 of - { state: state1, value: items } -> case write items 0 42 state1 of - { state: state2, value: ignored } -> read items 0 state2"#, - ).replace("action ::", r#"foreign import "psrs:runtime-storage#array_fill" fill :: forall s a. Int -> a -> State s -> Step s (Array a) -foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit -action ::"#); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - assert_eq!(input.externals.runtime.len(), 3); - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - let flow = flows - .iter() - .find(|flow| flow.operations.len() == 3) - .unwrap(); - flow.verify(&input.cc).unwrap(); - for pair in flow.operations.windows(2) { - assert_eq!(pair[1].input, pair[0].output); - } - let targets = flow - .operations - .iter() - .map(|operation| match operation.assignment.kind { - psrs_backend::cc::AssignmentKind::DirectCall { function, .. } => input - .externals - .runtime - .iter() - .find(|binding| binding.symbol == function) - .unwrap() - .function - .as_str(), - _ => panic!("runtime operations must remain ordinary direct calls"), - }) - .collect::>(); - assert_eq!(targets, ["array_fill", "array_write", "array_read"]); -} - -#[test] -fn runtime_source_calls_publish_checked_cc_dependencies() { - let source = state_flow_source( - r#"case read [40] 0 state0 of - { state: state1, value: first } -> case read [first] 0 state1 of - { state: state2, value: second } -> { state: state2, value: second }"#, - ); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - assert_eq!(input.externals.runtime.len(), 1); - let binding = &input.externals.runtime[0]; - assert_eq!(binding.module, "psrs:runtime-storage"); - assert_eq!(binding.function, "array_read"); - assert!(binding.type_id.is_some()); - let external = input - .cc - .externals - .iter() - .find(|external| external.symbol == binding.symbol) - .unwrap(); - let signature = external.signature.as_ref().unwrap(); - let projection = - psrs_backend::cc::state::StateCallProjection::checked(signature, &input.cc.representations) - .unwrap() - .unwrap(); - assert_eq!(projection.state_parameter, 2); - assert_eq!( - projection.payload, - psrs_backend::cc::ValueShape::Reference(psrs_backend::cc::Reference { - nullable: false, - heap: psrs_backend::cc::RefShape::Erased, - }) - ); - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - let flow = flows - .iter() - .find(|flow| flow.operations.len() == 2) - .unwrap(); - flow.verify(&input.cc).unwrap(); - assert_eq!(flow.operations[1].input, flow.operations[0].output); - assert!(flow.operations.iter().all(|operation| matches!(operation.assignment.kind, - psrs_backend::cc::AssignmentKind::DirectCall { function, .. } if function == binding.symbol))); - let (module, _) = psrs_backend::mir::lower_module_with_bindings( - input.cc.clone(), - input.externals, - psrs_backend::TargetCapabilities::default(), - ) - .unwrap(); - psrs_backend::mir::verify_module(&module).unwrap(); - assert_eq!(module.imports.len(), 1); - assert_eq!( - module.imports[0].runtime.as_ref().unwrap().function, - "array_read" - ); - assert!( - module - .functions - .iter() - .any(|function| function.state.is_some()) - ); -} - -#[test] -fn source_storage_projection_preserves_an_ignored_write_through_optimization() { - let source = storage_alias_source(); - let target = psrs_backend::TargetCapabilities { - wasi_cli: false, - ..psrs_backend::TargetCapabilities::default() - }; - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let (module, mut wasi) = - psrs_backend::mir::lower_module_with_bindings(input.cc, input.externals, target).unwrap(); - let module = psrs_backend::mir::opt::optimize(module, target).unwrap(); - assert_eq!( - module - .imports - .iter() - .filter(|import| import.runtime.is_some()) - .count(), - 3 - ); - let write = module - .imports - .iter() - .find(|import| { - import - .runtime - .as_ref() - .is_some_and(|provider| provider.function == "array_write") - }) - .unwrap(); - assert!(module.functions.iter().flat_map(|function| &function.blocks) - .flat_map(|block| &block.instructions).any(|instruction| - matches!(instruction, psrs_backend::mir::Instruction::CallVoid { function, .. } if *function == write.symbol))); - let wasm = - psrs_backend::wasm::lower_module_with_capabilities(&module, &mut wasi, target).unwrap(); - psrs_backend::wasm::encode_module(&wasm).unwrap(); -} - -fn storage_alias_source() -> String { - state_flow_source(r#"case fill 2 40 state0 of - { state: state1, value: items } -> let alias = items in - case write items 0 42 state1 of - { state: state2, value: ignored } -> read alias 0 state2"#) - .replace("action ::", r#"foreign import "psrs:runtime-storage#array_fill" fill :: forall s a. Int -> a -> State s -> Step s (Array a) -foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit -action ::"#) -} - -#[test] -fn source_storage_executes_through_the_default_cli_and_preserves_alias_writes() { - for expected in [42, 40] { - let source = storage_alias_source() - .replace( - "main ::", - r#"foreign import "psrs:intrinsic#intEq" eq :: Int -> Int -> Boolean -main ::"#, - ) - .replace( - "main = execute action", - &format!("main = if eq (execute action) {expected} then 0 else 1"), - ); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - }; - assert_eq!( - output.status.code(), - Some(i32::from(expected != 42)), - "{}", - String::from_utf8_lossy(&output.stderr) - ); - } -} - -#[test] -fn ordinary_newtype_bind_executes_runtime_storage_without_an_effect_dispatcher() { - let source = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_fill" fill :: forall s a. Int -> a -> State s -> Step s (Array a) -foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit -foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a -newtype Task a = Task (State RealWorld -> Step RealWorld a) -bindTask :: forall a b. Task a -> (a -> Task b) -> Task b -bindTask (Task first) next = Task (\state0 -> - case first state0 of - { state: state1, value: value } -> case next value of - Task second -> second state1) -fillTask :: forall a. Int -> a -> Task (Array a) -fillTask length value = Task (\state -> fill length value state) -writeTask :: forall a. Array a -> Int -> a -> Task Unit -writeTask items index value = Task (\state -> write items index value state) -readTask :: forall a. Array a -> Int -> Task a -readTask items index = Task (\state -> read items index state) -runTask :: forall a. Task a -> a -runTask (Task action) = execute action -action :: Task Int -action = bindTask (fillTask 2 40) (\items -> - let alias = items in bindTask (writeTask items 0 42) (\ignored -> readTask alias 0)) -main :: Int -main = runTask action -"#; - let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - }; - assert_eq!( - output.status.code(), - Some(42), - "{}", - String::from_utf8_lossy(&output.stderr) - ); -} - -#[test] -fn runtime_nonreturning_calls_trap_and_only_terminate_the_selected_branch() { - for (body, expected) in [ - ("abort state0", None), - ( - "case read [0] 0 state0 of { state: state1, value: first } -> if eq first 0 then abort state1 else { state: state1, value: 42 }", - None, - ), - ( - "case read [1] 0 state0 of { state: state1, value: first } -> if eq first 0 then abort state1 else { state: state1, value: 42 }", - Some(42), - ), - ( - "case abort state0 of { state: state1, value: ignored } -> read [42] 0 state1", - None, - ), - ( - "if true then abort state0 else { state: state0, value: 42 }", - None, - ), - ( - "if false then abort state0 else { state: state0, value: 42 }", - Some(42), - ), - ] { - let source = state_flow_source(body).replace( - "action ::", - r#"foreign import "psrs:runtime-storage#trap" abort :: forall s a. State s -> Step s a -foreign import "psrs:intrinsic#intEq" eq :: Int -> Int -> Boolean -action ::"#, - ); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - assert!( - std::env::var_os("PSRS_REQUIRE_WASMTIME").is_none(), - "Wasmtime is required" - ); - return; - }; - if let Some(expected) = expected { - assert_eq!( - output.status.code(), - Some(expected), - "{}", - String::from_utf8_lossy(&output.stderr) - ); - } else { - assert!(!output.status.success()); - assert!( - String::from_utf8_lossy(&output.stderr).contains("unreachable"), - "{}", - String::from_utf8_lossy(&output.stderr) - ); - } - } -} - -#[test] -fn gc_runtime_and_canonical_allocator_share_the_application_memory() { - for abort in [false, true] { - let body = format!( - "case arguments state0 of {{ state: state1, value: items }} -> if {abort} then abort state1 else read [42] 0 state1" - ); - let source = state_flow_source(&body).replace("action ::", r#"foreign import "wasi:cli/environment#get-arguments" arguments :: State RealWorld -> Step RealWorld (Array String) -foreign import "psrs:runtime-storage#trap" abort :: forall s a. State s -> Step s a -action ::"#); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - if abort { - assert!(!output.status.success()); - assert!( - String::from_utf8_lossy(&output.stderr) - .contains("wasm `unreachable` instruction executed"), - "{output:?}" - ); - } else { - assert_eq!(output.status.code(), Some(42), "{output:?}"); - } - } -} - -#[test] -fn source_constructor_choices_execute_only_the_selected_state_action() { - for (choice, expected) in [("First", 42), ("Second", 43), ("Last", 44)] { - let body = format!("choose {choice} state0"); - let source = state_flow_source(&body).replace( - "action ::", - r#"data Choice = First | Second | Last -choose :: Choice -> State RealWorld -> Step RealWorld Int -choose choice state0 = case choice of - First -> read [42] 0 state0 - Second -> read [43] 0 state0 - Last -> read [44] 0 state0 -action ::"#, - ); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(expected), "{choice}: {output:?}"); - } -} - -#[test] -fn constructor_choice_cannot_replay_the_predecessor_after_its_state_operation() { - let source = state_flow_source( - r#"case choose First state0 of - { state: state1, value: item } -> read [item] 0 state0"#, - ) - .replace( - "action ::", - r#"data Choice = First | Second | Last -choose :: Choice -> State RealWorld -> Step RealWorld Int -choose choice state0 = case choice of - First -> read [42] 0 state0 - Second -> read [43] 0 state0 - Last -> read [44] 0 state0 -action ::"#, - ); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage == "P7 Core verification" - && error.diagnostic.message.contains("stale dependency")), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/state/scoped_callbacks.rs b/crates/psrs-driver/src/tests/state/scoped_callbacks.rs deleted file mode 100644 index 80e00e30..00000000 --- a/crates/psrs-driver/src/tests/state/scoped_callbacks.rs +++ /dev/null @@ -1,354 +0,0 @@ -use super::*; - -const SOURCE: &str = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a - -action :: State RealWorld -> Step RealWorld Int -action state0 = - let next = \ignored -> read [42] 0 state0 - in next unit -main :: Int -main = execute action -"#; - -#[test] -fn lexical_state_callback_has_checked_core_producers_and_execution_scope() { - let module = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); - let flows = psrs_core::state::flow::check(&module).unwrap(); - assert_eq!(flows.len(), 1); - assert_eq!(flows[0].operations.len(), 1); - flows[0].verify(&module).unwrap(); -} - -#[test] -fn lexical_state_callback_has_checked_cc_capture_and_invocation_producers() { - let core = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let flows = psrs_backend::cc::state::check(&input.cc).unwrap(); - let captured = flows - .iter() - .find(|flow| { - matches!( - flow.input, - Some(psrs_backend::cc::state::DependencySource::Capture { .. }) - ) - }) - .unwrap(); - assert_eq!(captured.operations.len(), 1); - for flow in flows { - flow.verify(&input.cc).unwrap(); - } -} - -#[test] -fn cc_rejects_replaying_the_same_captured_dependency() { - use psrs_backend::cc::{AssignmentKind, ValueDecl, ValueId}; - let core = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); - let mut module = psrs_backend::cc::lower_module(core).unwrap().cc; - let flows = psrs_backend::cc::state::check(&module).unwrap(); - let caller = flows - .iter() - .find(|flow| { - flow.operations.iter().any(|operation| { - matches!( - operation.assignment.kind, - AssignmentKind::IndirectCall { .. } - ) - }) - }) - .unwrap(); - let owner = caller.function.symbol; - let mut replay = caller - .operations - .iter() - .find(|operation| { - matches!( - operation.assignment.kind, - AssignmentKind::IndirectCall { .. } - ) - }) - .unwrap() - .assignment - .clone(); - drop(flows); - let function = module - .functions - .iter_mut() - .find(|function| function.symbol == owner) - .unwrap(); - let index = function - .assignments - .iter() - .position(|assignment| assignment == &replay) - .unwrap(); - let ty = function - .values - .iter() - .find(|value| value.id == replay.destination) - .unwrap() - .ty; - replay.destination = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(ValueDecl { - id: replay.destination, - ty, - }); - function.assignments.insert(index + 1, replay); - let errors = psrs_backend::cc::state::check(&module).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P8 CC state verification" - && error.message.contains("stale dependency")), - "{errors:?}" - ); -} - -#[test] -fn captured_cc_input_evidence_cannot_be_replaced_by_an_explicit_parameter() { - use psrs_backend::cc::state::DependencySource; - let core = lower_program_to_core(&[("Main.purs", SOURCE)]).unwrap(); - let module = psrs_backend::cc::lower_module(core).unwrap().cc; - let mut flows = psrs_backend::cc::state::check(&module).unwrap(); - let flow = flows - .iter_mut() - .find(|flow| matches!(flow.input, Some(DependencySource::Capture { .. }))) - .unwrap(); - flow.input = Some(DependencySource::Parameter(flow.function.parameters[0])); - let errors = flow.verify(&module).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("instruction provenance")) - ); -} - -#[test] -fn captured_dependency_remains_checked_across_exclusive_cc_branches() { - let source = SOURCE.replace( - "read [42] 0 state0", - "if true then read [42] 0 state0 else read [43] 0 state0", - ); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let module = psrs_backend::cc::lower_module(core).unwrap().cc; - let flows = psrs_backend::cc::state::check(&module).unwrap(); - let captured = flows - .iter() - .find(|flow| { - matches!( - flow.input, - Some(psrs_backend::cc::state::DependencySource::Capture { .. }) - ) - }) - .unwrap(); - assert_eq!(captured.operations.len(), 2); - assert_eq!(captured.graph.blocks.len(), 4); - captured.verify(&module).unwrap(); -} - -#[test] -fn captured_state_callbacks_execute_with_zero_width_and_mixed_capture_slots() { - for body in [ - "\n let next = \\ignored -> read [42] 0 state0\n in next unit", - "\n let items = [42]\n next = \\ignored -> read items 0 state0\n in next unit", - "\n let items = [42]\n next = \\ignored -> case read [0] 0 state0 of\n { state: state1, value: unused } -> read items 0 state1\n in next unit", - "\n let items = [42]\n index = 0\n next = \\ignored -> case read [0] 0 state0 of\n { state: state1, value: unused } -> read items index state1\n in next unit", - ] { - let source = state_flow_source(body); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{source}\n{output:?}"); - assert!(output.stdout.is_empty()); - assert!(output.stderr.is_empty()); - } -} - -#[test] -fn mir_capture_projection_rejects_type_correct_operand_and_slot_mutations() { - use psrs_backend::{TargetCapabilities, mir}; - let source = state_flow_source( - "\n let items = [42]\n other = [43]\n next = \\ignored -> case read [0] 0 state0 of\n { state: state1, value: unused } -> case read items 0 state1 of\n { state: state2, value: first } -> read other 0 state2\n in next unit", - ); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let input = psrs_backend::cc::lower_module(core).unwrap(); - let (module, _) = - mir::lower_module_with_bindings(input.cc, input.externals, TargetCapabilities::default()) - .unwrap(); - mir::verify_module(&module).unwrap(); - for change_slot in [false, true] { - let mut mutated = module.clone(); - let instruction = mutated.functions.iter_mut().flat_map(|function| &mut function.blocks) - .flat_map(|block| &mut block.instructions).find(|instruction| if change_slot { - matches!(instruction, mir::Instruction::ClosureGetCapture { index: 0, .. }) - } else { - matches!(instruction, mir::Instruction::ClosureNew { captures, .. } if captures.len() == 2) - }).unwrap(); - match instruction { - mir::Instruction::ClosureNew { captures, .. } => captures.swap(0, 1), - mir::Instruction::ClosureGetCapture { index, .. } => *index = 1, - _ => unreachable!(), - } - let errors = mir::verify_module(&mutated).unwrap_err(); - assert!( - errors - .iter() - .all(|error| error.pass == "P9 MIR dependency verification"), - "{errors:?}" - ); - assert!( - errors - .iter() - .any(|error| error.message.contains("capture projection") - || error.message.contains("tail conversion")), - "{errors:?}" - ); - } -} - -#[test] -fn captured_callbacks_keep_selected_branches_and_nonreturning_operations() { - for (flag, trap, expected) in [ - (1, false, 42), - (2, false, 43), - (1, true, 134), - (2, true, 43), - ] { - let body = format!( - "\n case read [{flag}] 0 state0 of\n {{ state: state1, value: flag }} ->\n let items = [42]\n other = [43]\n next = \\ignored -> if eqInt flag 1 then read items 0 state1 else read other 0 state1\n in next unit" - ); - let mut source = state_flow_source(&body).replace( - "action ::", - "foreign import \"psrs:intrinsic#intEq\" eqInt :: Int -> Int -> Boolean\naction ::", - ); - if trap { - source = source.replace("action ::", "foreign import \"psrs:runtime-storage#trap\" abort :: State RealWorld -> Step RealWorld Int\naction ::") - .replace("then read items 0 state1", "then abort state1"); - } - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(expected), "{source}\n{output:?}"); - if expected == 134 { - assert!(String::from_utf8_lossy(&output.stderr).contains("unreachable")); - } - } -} - -#[test] -fn constructing_an_unused_trapping_capture_does_not_execute_it() { - let source = state_flow_source("\n let next = \\ignored -> abort state0\n in { state: state0, value: 42 }") - .replace("action ::", "foreign import \"psrs:runtime-storage#trap\" abort :: State RealWorld -> Step RealWorld Int\naction ::"); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); - assert!(output.stderr.is_empty()); -} - -#[test] -fn construction_does_not_execute_a_state_capturing_callback() { - let source = SOURCE.replace("in next unit", "in { state: state0, value: 42 }"); - let module = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let flows = psrs_core::state::flow::check(&module).unwrap(); - assert_eq!(flows.len(), 1); - assert!(flows[0].operations.is_empty()); -} - -#[test] -fn a_scoped_callback_cannot_replay_its_captured_predecessor() { - let source = SOURCE.replace( - "in next unit", - "in case read [0] 0 state0 of\n { state: advanced, value: ignored } -> next unit", - ); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage.starts_with("P7") - && error.diagnostic.message.contains("stale dependency")), - "{errors:?}" - ); -} - -#[test] -fn nested_lexical_callback_invocation_preserves_the_captured_producer() { - let source = SOURCE.replace( - "in next unit", - " apply = \\callback -> callback unit\n in apply next", - ); - let module = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let flows = psrs_core::state::flow::check(&module).unwrap(); - assert_eq!(flows.len(), 1); - assert_eq!(flows[0].operations.len(), 1); - flows[0].verify(&module).unwrap(); -} - -#[test] -fn an_unchecked_global_callback_scope_cannot_discard_a_state_transition() { - let source = SOURCE - .replace( - "action ::", - "consume :: (Unit -> Step RealWorld Int) -> Int\nconsume callback = (callback unit).value\n\naction ::", - ) - .replace( - "in next unit", - " ignored = consume next\n in { state: state0, value: ignored }", - ); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage.starts_with("P7") - && error - .diagnostic - .message - .contains("checked invocation scope")), - "{errors:?}" - ); -} - -#[test] -fn a_choice_of_captured_callbacks_cannot_erase_dependency_provenance() { - let source = SOURCE.replace( - "in next unit", - " chosen = (if true then next else (\\ignored -> read [43] 0 state0))\n result = chosen unit\n in { state: state0, value: result.value }", - ); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage.starts_with("P7") - && error.diagnostic.message.contains("producer provenance")), - "{errors:?}" - ); -} - -#[test] -fn an_opaque_array_cannot_hide_a_captured_state_producer() { - let source = SOURCE.replace( - "in next unit", - " callbacks = [next]\n in { state: state0, value: 42 }", - ); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage.starts_with("P7") - && error - .diagnostic - .message - .contains("checked producer transport")), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/state/storage_protocol.rs b/crates/psrs-driver/src/tests/state/storage_protocol.rs deleted file mode 100644 index 37b92231..00000000 --- a/crates/psrs-driver/src/tests/state/storage_protocol.rs +++ /dev/null @@ -1,129 +0,0 @@ -use super::*; - -fn source(item: &str, initial: &str, replacement: &str, predicate: &str) -> String { - format!( - r#"module Main where -import Prim.State (State, RealWorld) -foreign import "psrs:intrinsic#intEq" eqInt :: Int -> Int -> Boolean -foreign import "psrs:intrinsic#numberEq" eqNumber :: Number -> Number -> Boolean -foreign import "psrs:intrinsic#booleanEq" eqBoolean :: Boolean -> Boolean -> Boolean -foreign import "psrs:intrinsic#stringToBytes" bytes :: String -> Array Int -foreign import "psrs:intrinsic#arrayLength" length :: forall a. Array a -> Int -foreign import "psrs:intrinsic#arrayIndex" index :: forall a. Array a -> Int -> a -foreign import "psrs:intrinsic#intAdd" addInt :: Int -> Int -> Int -type Item = {item} -type Step s a = {{ state :: State s, value :: a }} -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_fill" fill :: Int -> Item -> State RealWorld -> Step RealWorld (Array Item) -foreign import "psrs:runtime-storage#array_write" write :: Array Item -> Int -> Item -> State RealWorld -> Step RealWorld Unit -foreign import "psrs:runtime-storage#array_read" read :: Array Item -> Int -> State RealWorld -> Step RealWorld Item -action :: State RealWorld -> Step RealWorld Int -action state0 = case fill 1 ({initial}) state0 of - {{ state: state1, value: items }} -> - let alias = items in case write items 0 ({replacement}) state1 of - {{ state: state2, value: ignored }} -> case read alias 0 state2 of - {{ state: state3, value: item }} -> {{ state: state3, value: if {predicate} then 42 else 1 }} -main :: Int -main = execute action -"# - ) -} - -#[test] -fn monomorphic_storage_recovers_scalars_records_and_callbacks_without_copying_the_array() { - for (item, initial, replacement, predicate) in [ - ("Int", "40", "2147483647", "eqInt item 2147483647"), - ("Number", "40.5", "42.25", "eqNumber item 42.25"), - ("Boolean", "true", "false", "eqBoolean item false"), - ( - "String", - "\"before\"", - "\"after\"", - "if eqInt (length (bytes item)) 5 then eqInt (index (bytes item) 0) 97 else false", - ), - ( - "{ count :: Int }", - "{ count: 40 }", - "{ count: 42 }", - "eqInt item.count 42", - ), - ( - "(Int -> Int)", - "\\n -> n", - "\\n -> addInt n 1", - "eqInt (item 41) 42", - ), - ] { - let source = source(item, initial, replacement, predicate); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{item}: {output:?}"); - } -} - -#[test] -fn monomorphic_partial_read_keeps_its_checked_source_result() { - let source = source("Int", "40", "42", "eqInt item 42").replace( - "case read alias 0 state2 of", - "let later = read alias 0 in case later state2 of", - ); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} - -#[test] -fn monomorphic_nested_storage_preserves_element_aliases_across_slots() { - let source = state_flow_source(r#"let shared = [40] in case fillNested 2 shared state0 of - { state: state1, value: outer } -> case readNested outer 0 state1 of - { state: state2, value: first } -> case writeInt first 0 42 state2 of - { state: state3, value: ignored } -> case readNested outer 1 state3 of - { state: state4, value: second } -> readInt second 0 state4"#).replace("action ::", r#"foreign import "psrs:runtime-storage#array_fill" fillNested :: Int -> Array Int -> State RealWorld -> Step RealWorld (Array (Array Int)) -foreign import "psrs:runtime-storage#array_read" readNested :: Array (Array Int) -> Int -> State RealWorld -> Step RealWorld (Array Int) -foreign import "psrs:runtime-storage#array_write" writeInt :: Array Int -> Int -> Int -> State RealWorld -> Step RealWorld Unit -foreign import "psrs:runtime-storage#array_read" readInt :: Array Int -> Int -> State RealWorld -> Step RealWorld Int -action ::"#); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} - -#[test] -fn runtime_storage_protocol_is_selected_after_source_checking_and_before_mir_layout() { - use psrs_backend::cc::{self, AssignmentKind, ValueConversion}; - let source = source("Int", "40", "42", "eqInt item 42"); - let core = lower_program_to_core(&[("Main.purs", &source)]).unwrap(); - let input = cc::lower_module(core).unwrap(); - let reader = input - .externals - .runtime - .iter() - .find(|binding| binding.function == "array_read") - .unwrap(); - let signature = input - .cc - .externals - .iter() - .find(|external| external.symbol == reader.symbol) - .unwrap() - .signature - .as_ref() - .unwrap(); - let projection = cc::state::StateCallProjection::checked(signature, &input.cc.representations) - .unwrap() - .unwrap(); - assert_eq!( - projection.payload, - cc::ValueShape::Reference(cc::Reference { - nullable: false, - heap: cc::RefShape::Erased - }) - ); - assert!(input.cc.functions.iter().flat_map(|function| &function.assignments).any(|assignment| - matches!(&assignment.kind, AssignmentKind::AggregateConvert { conversion, .. } - if matches!(conversion.plan, ValueConversion::UnboxScalar { destination: cc::ValueShape::Integer, .. })))); - cc::state::check(&input.cc).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/state/zero_width_choices.rs b/crates/psrs-driver/src/tests/state/zero_width_choices.rs deleted file mode 100644 index f2daea14..00000000 --- a/crates/psrs-driver/src/tests/state/zero_width_choices.rs +++ /dev/null @@ -1,82 +0,0 @@ -use super::*; - -fn source(flag: i32, choice: &str) -> String { - SOURCE.replace("[1]", &format!("[{flag}]")) - .replace("if eqInt flag 1 then\n case write values 0 42 initial of\n { state: next, value: ignored } -> next\n else case write values 0 43 initial of\n { state: next, value: ignored } -> next", choice) -} - -const SOURCE: &str = r#"module Main where -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" execute :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_write" write :: Array Int -> Int -> Int -> State RealWorld -> Step RealWorld Unit -foreign import "psrs:runtime-storage#array_read" read :: Array Int -> Int -> State RealWorld -> Step RealWorld Int - -foreign import "psrs:intrinsic#intEq" eqInt :: Int -> Int -> Boolean -action :: State RealWorld -> Step RealWorld Int -action state0 = case read [1] 0 state0 of - { state: initial, value: flag } -> - let values = [0] - state1 = if eqInt flag 1 then - case write values 0 42 initial of - { state: next, value: ignored } -> next - else case write values 0 43 initial of - { state: next, value: ignored } -> next - in read values 0 state1 -main :: Int -main = execute action -"#; - -const BINARY: &str = "if eqInt flag 1 then\n case write values 0 42 initial of\n { state: next, value: ignored } -> next\n else case write values 0 43 initial of\n { state: next, value: ignored } -> next"; -const SWITCH: &str = "case flag of\n 1 -> case write values 0 42 initial of\n { state: next, value: ignored } -> next\n 2 -> case write values 0 43 initial of\n { state: next, value: ignored } -> next\n _ -> case write values 0 44 initial of\n { state: next, value: ignored } -> next"; - -#[test] -fn zero_width_choice_results_keep_selected_mutation_and_successor() { - for (choice, flag, expected) in [ - (BINARY, 1, 42), - (BINARY, 2, 43), - (SWITCH, 1, 42), - (SWITCH, 2, 43), - (SWITCH, 3, 44), - ] { - let source = source(flag, choice); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(expected), "{source}\n{output:?}"); - } -} - -#[test] -fn zero_width_choice_preserves_selected_nonreturning_arms() { - for (flag, expected) in [(1, 134), (2, 43)] { - let source = source(flag, BINARY) - .replace( - "action ::", - "foreign import \"psrs:runtime-storage#trap\" abort :: State RealWorld -> Step RealWorld Unit\naction ::", - ) - .replace("case write values 0 42 initial of", "case abort initial of"); - let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { - return; - }; - assert_eq!(output.status.code(), Some(expected), "{source}\n{output:?}"); - if flag == 1 { - assert!(String::from_utf8_lossy(&output.stderr).contains("unreachable")); - } - } -} - -#[test] -fn zero_width_choice_cannot_replay_its_observable_predecessor() { - for choice in [BINARY, SWITCH] { - let source = - source(1, choice).replace("in read values 0 state1", "in read values 0 initial"); - let errors = lower_program_to_core(&[("Main.purs", &source)]).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.diagnostic.stage.starts_with("P7")), - "{errors:?}" - ); - } -} diff --git a/crates/psrs-driver/src/tests/tail_calls.rs b/crates/psrs-driver/src/tests/tail_calls.rs index 05d686e4..504f9a2d 100644 --- a/crates/psrs-driver/src/tests/tail_calls.rs +++ b/crates/psrs-driver/src/tests/tail_calls.rs @@ -155,68 +155,6 @@ fn disabled_profile_keeps_an_ordinary_call() { } } -#[test] -fn state_self_tail_recursion_preserves_zero_width_dependencies() { - let source = r#"module Main where -import Prelude -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" run :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a -count :: Int -> State RealWorld -> Step RealWorld Int -count n state = if n == 0 then read [42] 0 state else count (n - 1) state -main :: Int -main = run (count 100000) -"#; - let stages = compile_with(source, TargetCapabilities::default()); - assert!( - stages - .mir - .functions - .iter() - .any(|function| function.state.is_some()) - ); - match execute_component("state_self_tail_loop", &stages.artifact.wasm) { - Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), - Ok(None) => {} - Err(error) => panic!("{error}"), - } -} - -// This uses an unrelated ordinary newtype to cover the specialization -// regression independently of the public Effect.forE case. -#[test] -fn ordinary_state_newtype_bind_loops_run_in_constant_stack() { - let source = r#"module Main where -import Prelude -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -newtype Task a = Task (State RealWorld -> Step RealWorld a) -foreign import "psrs:intrinsic#runWorld" run :: forall a. (State RealWorld -> Step RealWorld a) -> a -pureTask :: forall a. a -> Task a -pureTask value = Task \state -> { state: state, value: value } -bindTask :: forall a b. Task a -> (a -> Task b) -> Task b -bindTask (Task action) next = Task \state0 -> - case action state0 of - { state: state1, value: value } -> case next value of - Task continuation -> continuation state1 -loopTask :: Int -> Task Unit -loopTask n = if n == 0 then pureTask unit - else bindTask (pureTask unit) (\_ -> loopTask (n - 1)) -execute :: forall a. Task a -> a -execute (Task action) = run action -main :: Int -main = execute (bindTask (loopTask 100000) (\_ -> pureTask 42)) -"#; - let stages = compile_with(source, TargetCapabilities::default()); - assert!(has_return_call_ref(&stages.mir)); - match execute_component("state_newtype_bind_loop", &stages.artifact.wasm) { - Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), - Ok(None) => {} - Err(error) => panic!("{error}"), - } -} - #[test] fn ordinary_pure_newtype_bind_loops_run_in_constant_stack() { let source = r#"module Main where @@ -255,52 +193,3 @@ fn self_tail_recursion_remaps_forwarded_arguments() { Err(error) => panic!("{error}"), } } - -#[test] -fn state_mutual_tail_recursion_preserves_every_storage_update() { - let source = r#"module Main where -import Prelude -import Prim.State (State, RealWorld) -type Step s a = { state :: State s, value :: a } -foreign import "psrs:intrinsic#runWorld" run :: forall a. (State RealWorld -> Step RealWorld a) -> a -foreign import "psrs:runtime-storage#array_read" read :: forall s a. Array a -> Int -> State s -> Step s a -foreign import "psrs:runtime-storage#array_write" write :: forall s a. Array a -> Int -> a -> State s -> Step s Unit -even :: Int -> Array Int -> State RealWorld -> Step RealWorld Int -even n cell state = if n == 0 then - case read cell 0 state of - { state: finalState, value: value } -> - { state: finalState, value: if value == 150000 then 42 else 0 } - else case read cell 0 state of - { state: readState, value: value } -> - case write cell 0 (value + 1) readState of - { state: writeState } -> odd (n - 1) cell writeState -odd :: Int -> Array Int -> State RealWorld -> Step RealWorld Int -odd n cell state = case read cell 0 state of - { state: readState, value: value } -> - case write cell 0 (value + 2) readState of - { state: writeState } -> even (n - 1) cell writeState -main :: Int -main = run (\state -> even 100000 [0] state) -"#; - let stages = compile_with(source, TargetCapabilities::default()); - for name in ["even", "odd"] { - let function = stages - .mir - .functions - .iter() - .find(|function| function.name == name) - .expect("mutual State functions must remain reachable"); - assert!(function.state.is_some()); - assert!( - function - .blocks - .iter() - .any(|block| { matches!(block.terminator, Some(Terminator::ReturnCall { .. })) }) - ); - } - match execute_component("state_mutual_updates", &stages.artifact.wasm) { - Ok(Some(output)) => assert_eq!(output.status.code(), Some(42), "{output:?}"), - Ok(None) => {} - Err(error) => panic!("{error}"), - } -} diff --git a/crates/psrs-driver/src/tests/wasi/wrappers.rs b/crates/psrs-driver/src/tests/wasi/wrappers.rs index 2ddb4d28..5e60a5d8 100644 --- a/crates/psrs-driver/src/tests/wasi/wrappers.rs +++ b/crates/psrs-driver/src/tests/wasi/wrappers.rs @@ -240,10 +240,10 @@ fn raw_foreign_value_names(text: &str) -> Vec { let Some(close) = rest.find('"') else { continue; }; - // `psrs:` names compiler bindings (`psrs:effect` abstract effect - // operations, `psrs:intrinsic` checked primitives). Those are the - // public library interface, not a private host import hidden behind a - // wrapper; only `wasi:` bindings name host imports. + // `psrs:` names compiler bindings (`psrs:intrinsic` checked primitives, + // `psrs:runtime-*` runtime providers). Those are the public library + // interface, not a private host import hidden behind a wrapper; only + // `wasi:` bindings name host imports. if rest[..close].starts_with("psrs:") { continue; } diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 03f497e3..4613d5e7 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -11,7 +11,7 @@ impl IntrinsicEffects { pub(super) fn for_intrinsic(intrinsic: Intrinsic) -> Self { use Intrinsic::*; match intrinsic { - ArrayWrite | RunWorld | RunRegion => Self { + ArrayWrite => Self { may_trap: true, may_write: true, }, diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 5dfc890a..2e2bdd1f 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -8,11 +8,9 @@ mod effects; mod registry; -mod state; pub use effects::IntrinsicEffects; pub use registry::{IntrinsicCategory, IntrinsicDescriptor}; -pub use state::StateOperation; use crate::{ModuleId, SymbolId}; @@ -166,23 +164,9 @@ pub enum Intrinsic { NumberNaN = 85, /// Positive infinity. NumberInfinity = 86, - RunWorld = 87, - RunRegion = 88, } impl Intrinsic { - /// State operations are available only through explicit checked bindings. - pub fn state_operation(self) -> Option { - Some(match self { - Self::RunWorld => StateOperation::RunWorld, - Self::RunRegion => StateOperation::RunRegion, - _ => return None, - }) - } - - pub fn is_bootstrap(self) -> bool { - self.state_operation().is_none() - } pub const fn symbol(self) -> SymbolId { SymbolId::new(ModuleId::INTRINSICS, self as u32) } @@ -200,13 +184,14 @@ impl Intrinsic { .find(|value| value.descriptor().name == name) } - /// Retired floor division and experimental storage intrinsic identities. - /// Storage now uses ordinary runtime bindings; slots must never be reused. - pub const RESERVED_IDS: [u32; 5] = [26, 27, 89, 90, 91]; + /// Retired floor division, experimental storage, and State runner + /// intrinsic identities. Storage uses ordinary runtime bindings and the + /// State mechanism was removed; these slots must never be reused. + pub const RESERVED_IDS: [u32; 7] = [26, 27, 87, 88, 89, 90, 91]; /// Every active variant, in discriminant order. Binding resolution uses the - /// complete list; bootstrap resolution selects only exposed operations. - pub const ALL: [Intrinsic; 87] = [ + /// complete list. + pub const ALL: [Intrinsic; 85] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -292,8 +277,6 @@ impl Intrinsic { Intrinsic::NumberIsNaN, Intrinsic::NumberNaN, Intrinsic::NumberInfinity, - Intrinsic::RunWorld, - Intrinsic::RunRegion, ]; } diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index e838bf42..eaa19d2f 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -43,8 +43,6 @@ pub enum IntrinsicCategory { Coercion, /// `Prim.undefined`: a value with no runtime representation. PartialValue, - /// An explicitly bound operation with a checked state contract. - State, } /// The metadata for one intrinsic. @@ -174,8 +172,6 @@ descriptors! { ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; NumberToString => "numberToString", 1, Unary, scheme::number_string; NumberFromDecimal => "numberFromDecimal", 1, Unary, scheme::string_number; - RunWorld => "runWorld", 1, State, super::state::run_world; - RunRegion => "runRegion", 1, State, super::state::run_region; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that diff --git a/crates/psrs-hir/src/intrinsic/state.rs b/crates/psrs-hir/src/intrinsic/state.rs deleted file mode 100644 index e73ccecd..00000000 --- a/crates/psrs-hir/src/intrinsic/state.rs +++ /dev/null @@ -1,82 +0,0 @@ -//! Explicit state operations and their source signatures. -use crate::{Type, TypeField, TypeId, TypeKind, TypeParameter}; -use psrs_span::TextRange; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum StateOperation { - RunWorld, - RunRegion, -} - -fn ty(kind: TypeKind) -> Type { - Type { - kind, - span: TextRange::new(0, 0), - } -} -fn variable(name: &str) -> Type { - ty(TypeKind::Variable(name.into())) -} -fn named(value: TypeId) -> Type { - ty(TypeKind::Named(value)) -} -fn apply(head: Type, argument: Type) -> Type { - ty(TypeKind::Application(Box::new(head), Box::new(argument))) -} -fn arrow(parameter: Type, result: Type) -> Type { - ty(TypeKind::Function { - parameter: Box::new(parameter), - result: Box::new(result), - }) -} -fn forall(names: &[&str], body: Type) -> Type { - ty(TypeKind::Forall { - variables: names - .iter() - .map(|name| TypeParameter { - name: (*name).into(), - name_span: TextRange::new(0, 0), - kind: None, - }) - .collect(), - body: Box::new(body), - }) -} -fn state(region: Type) -> Type { - apply(named(TypeId::PRIM_STATE), region) -} -fn step(region: Type, value: Type) -> Type { - let field = |label: &str, ty| TypeField { - label: label.into(), - label_span: TextRange::new(0, 0), - ty, - span: TextRange::new(0, 0), - }; - ty(TypeKind::Record { - fields: vec![field("state", state(region)), field("value", value)], - tail: None, - }) -} - -pub(super) fn run_world() -> Type { - let region = named(TypeId::PRIM_REAL_WORLD); - forall( - &["a"], - arrow( - arrow(state(region.clone()), step(region, variable("a"))), - variable("a"), - ), - ) -} -pub(super) fn run_region() -> Type { - forall( - &["a"], - arrow( - forall( - &["s"], - arrow(state(variable("s")), step(variable("s"), variable("a"))), - ), - variable("a"), - ), - ) -} diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index 50b65083..6f24253c 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -106,18 +106,10 @@ impl TypeId { pub const PRIM_TYPE_ERROR_QUOTE_LABEL: Self = Self::new(ModuleId::INTRINSICS, 28); pub const PRIM_TYPE_ERROR_BESIDE: Self = Self::new(ModuleId::INTRINSICS, 29); pub const PRIM_TYPE_ERROR_ABOVE: Self = Self::new(ModuleId::INTRINSICS, 30); - /// Legacy compiler-owned Effect invocation trigger. It has no source - /// spelling and lowers to a scalar constant; it does not carry the generic - /// dependency semantics of PRIM_STATE. Retire after Effect/ST migration. - pub const STATE_TOKEN: Self = Self::new(ModuleId::INTRINSICS, 31); - /// Generic state dependency carrier. Its region parameter has a nominal role. - pub const PRIM_STATE: Self = Self::new(ModuleId::INTRINSICS, 32); - /// Region marker for state operations on the external world. - pub const PRIM_REAL_WORLD: Self = Self::new(ModuleId::INTRINSICS, 33); } mod intrinsic; -pub use intrinsic::{Intrinsic, IntrinsicCategory, IntrinsicDescriptor, StateOperation}; +pub use intrinsic::{Intrinsic, IntrinsicCategory, IntrinsicDescriptor}; /// Symbol index base for source-declared `foreign import`s, which live in the /// reserved intrinsic module but above the intrinsic and WASI import ranges. diff --git a/crates/psrs-hir/src/primitives/mod.rs b/crates/psrs-hir/src/primitives/mod.rs index a31a252f..9c9f4777 100644 --- a/crates/psrs-hir/src/primitives/mod.rs +++ b/crates/psrs-hir/src/primitives/mod.rs @@ -7,7 +7,6 @@ use psrs_span::TextRange; mod core; mod numbers; mod rows; -mod state; mod type_error; #[cfg(test)] @@ -21,7 +20,6 @@ pub fn primitive_type_declarations() -> Vec<(&'static str, TypeDeclaration)> { rows::declarations(), numbers::declarations(), type_error::declarations(), - state::declarations(), ] .into_iter() .flatten() diff --git a/crates/psrs-hir/src/primitives/state.rs b/crates/psrs-hir/src/primitives/state.rs deleted file mode 100644 index 2f4bc213..00000000 --- a/crates/psrs-hir/src/primitives/state.rs +++ /dev/null @@ -1,25 +0,0 @@ -//! Target state facilities are separate from the official PureScript vocabulary. -use super::*; - -pub(super) fn declarations() -> Vec<(&'static str, TypeDeclaration)> { - vec![ - ( - "Prim.State", - foreign_type( - TypeId::PRIM_STATE, - "State", - forall_kind_result("k", vec![variable("k")], builtin(BuiltinType::Type)), - &[Role::Nominal], - ), - ), - ( - "Prim.State", - foreign_type( - TypeId::PRIM_REAL_WORLD, - "RealWorld", - builtin(BuiltinType::Type), - &[], - ), - ), - ] -} diff --git a/crates/psrs-hir/src/primitives/tests.rs b/crates/psrs-hir/src/primitives/tests.rs index 87e647cf..09b0c791 100644 --- a/crates/psrs-hir/src/primitives/tests.rs +++ b/crates/psrs-hir/src/primitives/tests.rs @@ -55,7 +55,6 @@ fn declared(owner: &str, name: &str) -> TypeDeclaration { fn every_official_primitive_member_is_declared_exactly_once() { let mut declared = primitive_type_declarations() .into_iter() - .filter(|(owner, _)| *owner != "Prim.State") .map(|(owner, declaration)| (owner.to_owned(), declaration.name.clone())) .collect::>(); declared.sort(); @@ -70,31 +69,6 @@ fn every_official_primitive_member_is_declared_exactly_once() { ); } -#[test] -fn target_state_is_opaque_and_its_region_is_nominal() { - let state = declared("Prim.State", "State"); - assert_eq!(roles(&state), vec![Role::Nominal]); - assert_eq!(state.id, TypeId::PRIM_STATE); - assert_eq!(state.kind, TypeDeclarationKind::Foreign); - assert!(state.constructors.is_empty()); - let TypeKind::Forall { variables, body } = &state.declared_kind.as_ref().unwrap().kind else { - panic!("State must quantify its region kind"); - }; - assert_eq!(variables.len(), 1); - let TypeKind::Function { parameter, result } = &body.kind else { - panic!("State must take exactly one nominal region"); - }; - assert_eq!( - parameter.kind, - TypeKind::Variable(variables[0].name.clone()) - ); - assert_eq!(result.kind, TypeKind::Constructor(BuiltinType::Type)); - let world = declared("Prim.State", "RealWorld"); - assert_eq!(world.id, TypeId::PRIM_REAL_WORLD); - assert!(roles(&world).is_empty()); - assert!(world.constructors.is_empty()); -} - #[test] fn boolean_literals_are_declared_at_the_boolean_kind() { // The official environment registers `True` and `False` at the type diff --git a/crates/psrs-resolve/src/resolver/bootstrap.rs b/crates/psrs-resolve/src/resolver/bootstrap.rs index 86dc5c02..124fd71f 100644 --- a/crates/psrs-resolve/src/resolver/bootstrap.rs +++ b/crates/psrs-resolve/src/resolver/bootstrap.rs @@ -9,7 +9,6 @@ use psrs_hir::{ExternalKind, ExternalSymbol, Intrinsic}; pub fn bootstrap_externals() -> Vec { Intrinsic::ALL .into_iter() - .filter(|intrinsic| intrinsic.is_bootstrap()) .map(|intrinsic| { let descriptor = intrinsic.descriptor(); ExternalSymbol { diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 3ba14fb9..9fffa6f4 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -3,6 +3,15 @@ **Implements:** [F-02 — Build Portable Program Artifacts](../feature/F-02-portable-programs.md) **Status:** In progress +> **Withdrawn capability (2026-10-11).** The compiler-owned Effect and State +> mechanisms described below were removed: the trusted `Effect` synthesis, the +> `Prim.State` primitives, the `runWorld`/`runRegion` intrinsics, the Core/CC/MIR +> State analysis, and the runtime storage source-binding contract. The `Effects` +> gate row and the `BE-21` `Effect Unit` entry capability no longer describe the +> compiler. No replacement Effect representation has been selected, so any +> measurement whose cases used either mechanism is historical. See the +> [removal handoff](../implementation/backend/effect-state-removal-handoff-2026-10-11.md). + ## Purpose Turn the official PureScript test suite into an operational scoreboard for the @@ -1192,7 +1201,7 @@ Wasm is the target encoding, and WIT/WASI are the platform integration layers. | BE-18 | Generic source-declared WIT imports | Compatible `Int`/`Boolean`/`Number` scalars, handles, and `list`/`string` imports lower through the canonical ABI with signature validation. A WIT `string` is a source `String` and a WIT `list` is `Array Int`, so the two no longer share a source type ([DEC-16](../decision/DEC-16-scalar-strings-and-utf8-storage.md)). Closed, directly flattened WIT records can contain nested `list` fields. | Partial | Add other aggregate WIT values, richer results, and user-library loading. | | BE-19 | WIT aggregate values and resources | Resource handles lower under [DEC-14](../decision/DEC-14-resource-handle-ownership.md): the compiler drops no handle on its own and exposes `resource.drop` to source, so the standard library owns the lifetime discipline; byte lists and closed WIT records with nested byte-list fields are classified and lowered in WIT field order. Indirect parameter tuples are allocated through `cabi_realloc`. Non-byte `list` of scalars, `bool`, `char`, strings, nullary enums, flags, resource handles, and directly flattened records of scalar or string fields is copied between a source GC array and the canonical buffer, with a driver execution test for `list` and synthesized Wasm fixtures for `list`, `list`, and `list` ([ABI-08](../implementation/backend/linear-memory-and-canonical-abi.md) In progress). `option`, `result`, and non-unit `variant` are classified and validated against `Data.Maybe.Maybe`, `Data.Either.Either`, and a source data type, CC derives their variant representation and a concrete payload tree, and MIR branches on each tag and rebuilds the source value recursively for a scalar payload of any width (`s8`..`u64`, `f32`/`f64`), a byte or non-byte list, `flags`, a closed record, and a nested `option`/`result`/`variant`, recursing through record fields and a `list`/`list` element, with synthesized Wasm fixtures ([DEC-13](../decision/DEC-13-wit-to-source-type-mapping.md)); a large aggregate return area is allocated through `cabi_realloc`, a handle in a result is an ordinary value the standard library drops explicitly, and an indirect parameter record carries a mapped aggregate. The aggregate ABI is generated from one normalized canonical type ([compositional canonical ABI lowering](backend/wasm/canonical-abi-compositional.md)); the descriptor types and per-shape plans are removed. `list>`/`list`/`list` elements, nested `list>`, multi-word flags as list elements and in aggregates, non-byte `list`, and `list>` results are classified and lowered, and a unit-success `result<_, E>` maps to `Either E Unit` (the error on `Left`) and sizes its return area from the error payload. | Partial | Add general aggregate layouts beyond the list-and-handle subset. | | BE-20 | Component Model packaging and capability-based imports | `wit-component` lifts the core module to a WASI 0.2 component and prunes unused imports. | Partial | Add component import/export regression cases beyond the CLI path and pass the L6/M7 gate. | -| BE-21 | WASI CLI entry, exit, stdout, and stderr | `wasi:cli/run`, exit codes, console output, and error output work in the component path. A selected `Int` entry returns its value as the exit code. A selected `Effect Unit` entry runs that action once, returns 0 after normal completion, and propagates a trap. Creating an action does not run its deferred operation. Focused Wasmtime tests assert output, status, and trap markers ([WASI-02/03](../implementation/backend/wasi-platform.md) Verified). The latest official runtime board is 164/413; 46 files have no selected `main`, and this row stays Partial. | Partial | Pass the L6/M7 gate. The 46 files with no selected `main` stay explicit blockers. | +| BE-21 | WASI CLI entry, exit, stdout, and stderr | `wasi:cli/run`, exit codes, console output, and error output work in the component path. A selected `Int` entry returns its value as the exit code. The former `Effect Unit` entry capability was removed on 2026-10-11; a non-`Int` entry is rejected and the replacement representation is undecided. Focused Wasmtime tests assert output and status for `Int` entries. The latest official runtime board is 164/413; 46 files have no selected `main`, and this row stays Partial. | Partial | Pass the L6/M7 gate. The 46 files with no selected `main` stay explicit blockers, and every non-`Int` entry remains unsupported. | | BE-22 | WASI clocks and randomness | Monotonic time and random bytes are wired through WASI and tested. | Partial | Expose the remaining clock/random library surface and pass the L6/M7 gate. | | BE-23 | WASI arguments, environment, and filesystem | WIT descriptions are vendored, but the source library and aggregate lowering are not complete ([WASI-07](../implementation/backend/wasi-platform.md) In progress). | Planned | Add module loading and aggregate/list support, then expose these services. | | BE-24 | WASI sockets and HTTP | Not part of the current synchronous portable-program target. | Excluded | Revisit as a separate platform scope after the core target is stable. | @@ -1216,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Effects | BE-21; supporting BE-02, BE-26 | Trusted Effect identities and checked WIT schemes are passed explicitly. Source `Effect a` stays abstract through Typed Core; P8 lowers it to a generic one-parameter closure. EF-01..EF-13 are Verified, including the `Effect Unit` command adapter and the lexical `runEffect` rule. A type table changed after `lower_effects` returns is not checked again. The official runtime board is 164/413; 46 files with no selected `main` remain blocked, and BE-21 stays Partial. Focused effect tests still expose CC verification and runtime traps, so their source-level integration remains open. | [EF-01..EF-13](../implementation/backend/effects.md) | +| Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | | Optimization | BE-12 | Topic acceptance complete: OPT-01..OPT-14 have implementation, verifier, and required execution evidence. The official M8-O gate stays on the broader BE-12 row. | [OPT-01..OPT-14](../implementation/backend/optimization.md) | diff --git a/docs/design/D-15-compiler-builtins.md b/docs/design/D-15-compiler-builtins.md index fbfe9fdf..2f43f584 100644 --- a/docs/design/D-15-compiler-builtins.md +++ b/docs/design/D-15-compiler-builtins.md @@ -40,7 +40,7 @@ contract each pass has for interpreting an intrinsic. It does not own: | Kind | Examples | Owner | Crosses the component boundary? | | --- | --- | --- | --- | | Intrinsic | `i32Add`, `charToInt`, `arrayAppend`, `stringToBytes`, `unit` | the compiler; emitted inline | no | -| External | `wasi:cli/stdout#get-stdout` (WIT), `psrs:effect#bind` (effect) | a WIT import or a compiler-lowered effect external | only the WIT import | +| External | `wasi:cli/stdout#get-stdout` (WIT) | a WIT import | only the WIT import | | Type-level function | `Prim.Int.Add`, `Prim.Row.Cons`, `Prim.Symbol.Append` | compile-time only | no runtime form | Only the first kind is this document's subject. The second is diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index 428528aa..43fa7b68 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -54,9 +54,9 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [pattern-matching.md](fp/pattern-matching.md) | Pattern decision trees and exhaustiveness | cc-ir | | [control-flow-and-tail-calls.md](fp/control-flow-and-tail-calls.md) | CFG structuring, `Switch`, tail calls | mir | | [type-classes-and-dictionaries.md](fp/type-classes-and-dictionaries.md) | Dictionary passing and instance evidence | functional-core | -| [effects.md](fp/effects.md) | Effect representation and the platform boundary | functional-core | -| [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics, cross-pass dependencies, optimizer transfers and checked zero-width erasure (Draft) | primitive types, functional-core, CC, MIR | -| [library-owned-effects.md](fp/library-owned-effects.md) | Ordinary Effect/ST newtypes, runtime adapters, command runner and migration acceptance (Draft) | State primitives and dependency lowering, source fidelity | +| [effects.md](fp/effects.md) | Effect representation and the platform boundary (**withdrawn 2026-10-11**; replacement undecided) | functional-core | +| [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics and cross-pass dependencies (**withdrawn 2026-10-11**) | primitive types, functional-core, CC, MIR | +| [library-owned-effects.md](fp/library-owned-effects.md) | Ordinary Effect/ST newtypes, runtime adapters, command runner (**withdrawn 2026-10-11**) | State primitives and dependency lowering, source fidelity | ### Wasm/WASI (`wasm/`) diff --git a/docs/design/backend/fp/cc-ir.md b/docs/design/backend/fp/cc-ir.md index 2100e1cd..f1041061 100644 --- a/docs/design/backend/fp/cc-ir.md +++ b/docs/design/backend/fp/cc-ir.md @@ -1,10 +1,10 @@ # CC IR: ANF and Closure Conversion -> **Selected extension:** [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) -> owns primitive State contracts, preserved dependencies and checked zero-width -> projection. [Library-owned effects](library-owned-effects.md) owns the -> library adaptation. Coverage remains partial; see the -> [implementation checklist](../../../implementation/backend/library-owned-effects.md). +> **Withdrawn extension (2026-10-11).** [State primitives and dependency +> lowering](state-primitives-and-dependency-lowering.md) and +> [library-owned effects](library-owned-effects.md) were removed. Any paragraph +> that refers to State values, dependencies, or `StateExecution` is retained as +> historical evidence, not as a current requirement. **Feature:** F-02 **Status:** Stable (design) @@ -141,6 +141,10 @@ normally completing arms feed the join. The shared dependency graph records all edges, while CC retains switch predicates and labels for the physical correspondence check. Nested choices preserve these same rules. +> **Withdrawn 2026-10-11.** The `runWorld`/`runRegion` intrinsics and the +> `StateExecution` CC assignment were removed with the State mechanism. The +> paragraph below is retained as historical evidence. + Explicit `runWorld` and `runRegion` bindings lower to `StateExecution` with a checked closure signature and stable operation identity. Core owns RealWorld, rank-N region introduction and non-escape checks; CC trusts those source facts diff --git a/docs/design/backend/fp/control-flow-and-tail-calls.md b/docs/design/backend/fp/control-flow-and-tail-calls.md index 6279e28a..0192801a 100644 --- a/docs/design/backend/fp/control-flow-and-tail-calls.md +++ b/docs/design/backend/fp/control-flow-and-tail-calls.md @@ -1,5 +1,9 @@ # Control-Flow Lowering and Tail Calls +> **Withdrawn extension (2026-10-11).** The State dependency projection and +> tail-transfer proof replay described below were removed. Any paragraph that +> refers to State dependencies is retained as historical evidence. + **Feature:** F-02 **Status:** Stable (design) **Prerequisites:** [MIR](mir.md) and its SSA/CFG model, [CC IR](cc-ir.md); diff --git a/docs/design/backend/fp/effects.md b/docs/design/backend/fp/effects.md index 8fb24f44..672b4eac 100644 --- a/docs/design/backend/fp/effects.md +++ b/docs/design/backend/fp/effects.md @@ -1,14 +1,17 @@ # Effects -> **Selected revision:** [library-owned effects](library-owned-effects.md) -> replaces the Effect-specific token contract with a library newtype and generic -> state dependencies governed by [the State topic](state-primitives-and-dependency-lowering.md), -> with executable storage and termination owned by -> `psrs-runtime` and combinators owned by stdlib. Integrated acceptance has not migrated; -> this document retains the existing contract pending that migration. +> **Withdrawn 2026-10-11.** The compiler no longer owns the identity, +> representation, or operations of the library type `Effect`. Trusted-Effect +> discovery, synthesized `pure`/`bind`/`runEffect`/trap implementations, the +> Effect-specific backend entry adaptation, the opaque state token, and the +> `Effect Unit` command entry were removed. No replacement Effect representation +> has been selected, so a program that used the mechanism does not compile. +> Everything below is retained as dated historical evidence and is **not** an +> instruction to rebuild the removed machinery. **Feature:** F-02 -**Status:** Draft (design) +**Status:** Withdrawn. The trusted-identity contract recorded below was removed +on 2026-10-11. **Prerequisites:** [functional core](../../frontend/semantics/functional-core.md), [CC IR](cc-ir.md), and [type classes and dictionaries](type-classes-and-dictionaries.md); monads, closures, and the distinction between a value and a computation. Read diff --git a/docs/design/backend/fp/library-owned-effects.md b/docs/design/backend/fp/library-owned-effects.md index bd8b277c..10892e50 100644 --- a/docs/design/backend/fp/library-owned-effects.md +++ b/docs/design/backend/fp/library-owned-effects.md @@ -1,9 +1,18 @@ # Library-Owned Effects +> **Withdrawn 2026-10-11.** The compiler no longer owns the Effect type or the +> State dependency protocol. The `Prim.State` primitives, the +> `RunWorld`/`RunRegion` intrinsics, the Core/CC/MIR State analysis, the legacy +> trusted-Effect synthesis, and the runtime storage source-binding contract were +> removed. No replacement Effect representation has been selected, so a program +> that used either mechanism does not compile. Everything below is retained as +> dated historical evidence and is **not** an instruction to rebuild the +> removed machinery. See the +> [removal handoff](../../../implementation/backend/effect-state-removal-handoff-2026-10-11.md). + **Feature:** [F-02](../../../feature/F-02-portable-programs.md) -**Status:** Draft design; newtype and state-dependency direction selected, -implementation migration in progress. Coverage is recorded in the -[implementation checklist](../../../implementation/backend/library-owned-effects.md). +**Status:** Withdrawn. The newtype and state-dependency direction recorded below +was removed on 2026-10-11; the replacement Effect representation is undecided. **Prerequisites:** [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md), [effects](effects.md), [representation and evidence](representation-and-evidence.md), [primitive types](../../frontend/type-system/prim.md), diff --git a/docs/design/backend/fp/mir.md b/docs/design/backend/fp/mir.md index 72554297..f6cb17a1 100644 --- a/docs/design/backend/fp/mir.md +++ b/docs/design/backend/fp/mir.md @@ -1,10 +1,10 @@ # MIR: SSA/CFG and Verification -> **Selected extension:** [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) -> owns primitive State contracts, preserved dependencies and checked zero-width -> projection. [Library-owned effects](library-owned-effects.md) owns the -> library adaptation. Coverage remains partial; see the -> [implementation checklist](../../../implementation/backend/library-owned-effects.md). +> **Withdrawn extension (2026-10-11).** [State primitives and dependency +> lowering](state-primitives-and-dependency-lowering.md) and +> [library-owned effects](library-owned-effects.md) were removed. Any paragraph +> that refers to State dependencies or projection is retained as historical +> evidence, not as a current requirement. **Feature:** F-02 **Status:** Stable (design) diff --git a/docs/design/backend/fp/representation-and-evidence.md b/docs/design/backend/fp/representation-and-evidence.md index 8348855d..a039a75f 100644 --- a/docs/design/backend/fp/representation-and-evidence.md +++ b/docs/design/backend/fp/representation-and-evidence.md @@ -1,10 +1,10 @@ # Runtime Representation and Checked Boundaries -> **Selected revision:** [Library-owned effects](library-owned-effects.md) -> replaces the Effect-specific token contract with ordinary library newtypes. -> [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) -> owns the logical dependency and zero-width projection contracts. Coverage -> remains partial; see the [implementation checklist](../../../implementation/backend/library-owned-effects.md). +> **Withdrawn extension (2026-10-11).** [Library-owned effects](library-owned-effects.md) +> and [State primitives and dependency lowering](state-primitives-and-dependency-lowering.md) +> were removed. Any paragraph that refers to the Effect token, State +> dependencies, or zero-width State projection is retained as historical +> evidence, not as a current requirement. **Feature:** F-02 **Status:** Stable (design) diff --git a/docs/design/backend/fp/state-primitives-and-dependency-lowering.md b/docs/design/backend/fp/state-primitives-and-dependency-lowering.md index 0f8043f8..bab9cf34 100644 --- a/docs/design/backend/fp/state-primitives-and-dependency-lowering.md +++ b/docs/design/backend/fp/state-primitives-and-dependency-lowering.md @@ -1,10 +1,15 @@ # State Primitives and Dependency Lowering +> **Withdrawn 2026-10-11.** The compiler no longer owns the State dependency +> protocol. `Prim.State`, `Prim.RealWorld`, the `runWorld`/`runRegion` +> intrinsics, the Core/CC/MIR State analysis, and the runtime storage +> source-binding contract were removed. Everything below is retained as dated +> historical evidence and is **not** an instruction to rebuild the removed +> machinery. + **Feature:** [F-02](../../../feature/F-02-portable-programs.md) -**Status:** Draft. The primitive representation direction is selected; general -transport and optimizer integration remain incomplete. Coverage belongs in the -[implementation checklist](../../../implementation/backend/library-owned-effects.md), -with known gaps recorded in the [scope audit](../../../implementation/backend/library-owned-effects-audit-2026-10-11.md). +**Status:** Withdrawn. The primitive representation direction recorded below was +removed on 2026-10-11; no replacement has been selected. **Prerequisites:** [primitive types](../../frontend/type-system/prim.md), [Functional Core](../../frontend/semantics/functional-core.md), [representation and evidence](representation-and-evidence.md), [CC](cc-ir.md), diff --git a/docs/design/backend/opt/core.md b/docs/design/backend/opt/core.md index 3426a0f0..8d3ad5c5 100644 --- a/docs/design/backend/opt/core.md +++ b/docs/design/backend/opt/core.md @@ -1,10 +1,10 @@ # Typed Core Optimization -> **Selected extension:** [State primitives and dependency lowering](../fp/state-primitives-and-dependency-lowering.md) -> owns primitive State contracts, preserved dependencies and checked zero-width -> projection. [Library-owned effects](../fp/library-owned-effects.md) owns the -> library adaptation. Coverage remains partial; see the -> [implementation checklist](../../../implementation/backend/library-owned-effects.md). +> **Withdrawn extension (2026-10-11).** [State primitives and dependency +> lowering](../fp/state-primitives-and-dependency-lowering.md) and +> [library-owned effects](../fp/library-owned-effects.md) were removed. Any +> paragraph that refers to State dependencies or State-specific optimizer +> exclusions is retained as historical evidence, not as a current requirement. **Feature:** F-02 diff --git a/docs/design/backend/opt/mir.md b/docs/design/backend/opt/mir.md index dd5fbc19..441da476 100644 --- a/docs/design/backend/opt/mir.md +++ b/docs/design/backend/opt/mir.md @@ -1,10 +1,10 @@ # MIR Optimization -> **Selected extension:** [State primitives and dependency lowering](../fp/state-primitives-and-dependency-lowering.md) -> owns primitive State contracts, preserved dependencies and checked zero-width -> projection. [Library-owned effects](../fp/library-owned-effects.md) owns the -> library adaptation. Coverage remains partial; see the -> [implementation checklist](../../../implementation/backend/library-owned-effects.md). +> **Withdrawn extension (2026-10-11).** [State primitives and dependency +> lowering](../fp/state-primitives-and-dependency-lowering.md) and +> [library-owned effects](../fp/library-owned-effects.md) were removed. Any +> paragraph that refers to State dependencies or State-specific optimizer +> exclusions is retained as historical evidence, not as a current requirement. **Feature:** F-02 diff --git a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md index b859bf68..7641d196 100644 --- a/docs/design/backend/wasm/primitive-ffi-and-stdlib.md +++ b/docs/design/backend/wasm/primitive-ffi-and-stdlib.md @@ -1,11 +1,12 @@ # Primitive Foreign Imports and Standard-Library Wrappers -> **Selected extension:** [State primitives and dependency lowering](../fp/state-primitives-and-dependency-lowering.md) -> owns primitive State contracts, preserved dependencies and checked zero-width -> projection. [Library-owned effects](../fp/library-owned-effects.md) owns the -> library adaptation. GC storage/termination retain their runtime-owned checked -> reference ABI, separate from scalar artifact calls. Coverage remains partial; see the -> [implementation checklist](../../../implementation/backend/library-owned-effects.md). +> **Withdrawn extension (2026-10-11).** [State primitives and dependency +> lowering](../fp/state-primitives-and-dependency-lowering.md) and +> [library-owned effects](../fp/library-owned-effects.md) were removed. GC +> storage/termination retain their runtime-owned checked reference ABI, but the +> source runtime-storage binding contract no longer projects. Any paragraph that +> refers to State dependencies is retained as historical evidence, not as a +> current requirement. **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) **Status:** Draft @@ -413,7 +414,9 @@ crates/psrs-backend/src/ `Data.Show` and not a second stringifier. `Test.Assert` composes `Effect.Console.error` with `Prelude.trap`. A failure is a guest trap because that is the only signal a compilable corpus - case can carry; `Prelude.trap` is a `psrs:effect` external, not a host call. + case can carry. `Prelude.trap` was formerly a `psrs:effect` external the + compiler synthesized a body for; that mechanism was removed on 2026-10-11 and + the replacement is undecided. - Each raw binding is an unexported `foreign import` whose parameters and single result are in the primitive set. The binding string is `#`, as in the canonical ABI topic. diff --git a/docs/design/backend/wasm/wasi-platform-library.md b/docs/design/backend/wasm/wasi-platform-library.md index 70880d25..87a2cac7 100644 --- a/docs/design/backend/wasm/wasi-platform-library.md +++ b/docs/design/backend/wasm/wasi-platform-library.md @@ -134,7 +134,7 @@ wrapper owns the corpus-facing name. | Module | Corpus name | Over | Owner | | --- | --- | --- | --- | -| `Prelude` | `Effect`, `pure`, `bind`, `discard`, `map`, `apply`, `runEffect`, `trap`, and the re-exported `class Semigroup`, `append`, `<>`, `const`, `flip`, `$`, `#` | the `psrs:effect` interface the compiler synthesizes bodies for, and `Data.Function` / `Data.Semigroup` | FE-02, FE-05, FE-09, FE-14, BE-02, BE-21 | +| `Prelude` | `Effect`, `pure`, `bind`, `discard`, `map`, `apply`, `runEffect`, `trap`, and the re-exported `class Semigroup`, `append`, `<>`, `const`, `flip`, `$`, `#` | the `psrs:effect` interface the compiler formerly synthesized bodies for (removed 2026-10-11; replacement undecided), and `Data.Function` / `Data.Semigroup` | FE-02, FE-05, FE-09, FE-14, BE-02, BE-21 | | `Data.Function` | `apply`, `applyFlipped`, `const`, `flip`, `on`, `$`, `#` | nothing: it is the definition site, and `$`/`#` are its fixity aliases | FE-05 | | `Data.Semigroup` | `class Semigroup`, `append`, `<>` | nothing: it is the definition site for the class, and `append` for `String` is built from the compiler's `stringToBytes` / `arrayAppend` / `bytesToString`; `append` for `Array a` is `arrayAppend` | FE-14, BE-10 | | `Data.Monoid` | `class Monoid`, `mempty` | `Data.Semigroup`; `String`, `Unit`, and `Array a` identities | FE-14 | diff --git a/docs/design/frontend/semantics/foreign-imports.md b/docs/design/frontend/semantics/foreign-imports.md index e559272b..d4995a02 100644 --- a/docs/design/frontend/semantics/foreign-imports.md +++ b/docs/design/frontend/semantics/foreign-imports.md @@ -1,9 +1,9 @@ # Foreign Imports -> **Selected revision:** [library-owned effects and state dependencies](../../backend/fp/library-owned-effects.md) -> replaces the Effect-specific token contract with a library newtype and generic -> state dependencies. Implementation and acceptance evidence have not migrated; -> this document retains the existing contract pending that migration. +> **Withdrawn revision (2026-10-11).** The replacement of the Effect-specific +> token contract by a library newtype and generic state dependencies was removed. +> Any paragraph that refers to generic state dependencies is retained as +> historical evidence. **Feature:** F-02 diff --git a/docs/design/frontend/type-system/prim.md b/docs/design/frontend/type-system/prim.md index a083d514..bec9f055 100644 --- a/docs/design/frontend/type-system/prim.md +++ b/docs/design/frontend/type-system/prim.md @@ -1,9 +1,10 @@ # Primitive Interfaces and Relations -> **Selected extension:** [library-owned effects and state dependencies](../../backend/fp/library-owned-effects.md) -> specifies generic primitive state contracts, preserved Core/CC/MIR dependencies -> and checked zero-width projection. Implementation and acceptance evidence -> have not migrated; the existing contracts below remain the implementation baseline. +> **Withdrawn extension (2026-10-11).** The generic primitive state contracts +> described by [library-owned effects and state dependencies](../../backend/fp/library-owned-effects.md) +> were removed, including `Prim.State`/`Prim.RealWorld` and the +> `runWorld`/`runRegion` intrinsics. The contracts below are the implementation +> baseline. **Feature:** F-02 diff --git a/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md b/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md index cca548f3..62b4465a 100644 --- a/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md +++ b/docs/implementation/backend/effect-state-removal-handoff-2026-10-11.md @@ -2,7 +2,10 @@ **Date:** 2026-10-11 **Scope:** Compiler cleanup only; no replacement Effect design. -**Status:** Instructions for the next agent. Removal has not been implemented. +**Status:** Implemented 2026-10-11. The legacy Effect mechanism and the State +dependency mechanism were removed from the compiler. The replacement Effect +representation remains undecided. The sections below are retained as the +instruction record that governed the removal. ## User decision and authority @@ -191,3 +194,41 @@ Completion means compiler ownership of both protocols is removed and all remaining consumers and limitations are explicit. It does **not** mean a new Effect mechanism exists or that either current stdlib package remains executable. Designing that mechanism is a separate user decision. + +## Post-removal record + +The removal was implemented on 2026-10-11. What was deleted and what remains: + +- **Removed.** `psrs-core/src/effect`, `psrs-core/src/state`, + `psrs-backend/src/effects`, `psrs-backend/src/cc/state`, + `psrs-backend/src/mir/state`, `psrs-hir/src/primitives/state.rs`, + `psrs-hir/src/intrinsic/state.rs`, the `Prim.State`/`Prim.RealWorld` catalog, + the `RunWorld`/`RunRegion` intrinsics, the `StateExecutionBoundary` target + implementation, the driver's trusted-Effect discovery and lexical + `runEffect` rule, `ExprKind::StateToken`, `ExprKind::StateToken`'s opaque + token identity, `ValueShape::State`, `StateCallProjection`, + `LayoutError::UnprojectedState`, and the State-specific fields on shared CC + and MIR objects. The Effect/State protocol tests were removed. +- **Retained generic.** Strict evaluation order and call lowering; `Trap`; + generic foreign and WIT calls; the generic Core/MIR effect summaries; + ordinary newtypes, roles, closures and adapters; generic direct, indirect, + and tail calls with loopification; the `psrs-runtime` GC storage crate and + the linker's canonical component boundary; and the package-configured + command runner. +- **Explicit failures.** A source runtime storage binding (`psrs:runtime-*`) + can no longer be projected: the operand mapping depended on the withdrawn + State contract, and no generic replacement exists. `bindings::validate`, + `plan_runtime_import`, and `canonical_signature` report + `runtime storage bindings require the withdrawn State contract`. The + linker-side `psrs_linker::runtime::package_offers` path and + `psrs-linker/tests/gc_storage.rs` do not use the source binding contract and + remain. +- **Affected package consumers.** The independent `psrs-stdlib` sources that + declare `Prim.State`, `psrs:intrinsic#runWorld`/`runRegion`, or + `psrs:runtime-storage` do not compile against the removal. The normal compiler + lock still points at `1e01310daa7e56de5ed379029d6a24dcf39e879c`, whose + `Prelude` uses the legacy Effect mechanism. Package-dependent tests therefore + cannot run; they fail before lowering on the stdlib lock mismatch or on the + missing primitive surface. The replacement Effect representation and the + stdlib migration that follows it are separate, undecided work. + diff --git a/docs/implementation/backend/effects.md b/docs/implementation/backend/effects.md index 5aa9af87..8acc00a8 100644 --- a/docs/implementation/backend/effects.md +++ b/docs/implementation/backend/effects.md @@ -1,10 +1,15 @@ # Effects Implementation Acceptance +> **Withdrawn 2026-10-11.** The trusted-Effect implementation and its acceptance +> scope were removed. The `EF-*` rows and the measurements below are retained as +> dated historical evidence and are **not** current capability or requirements. +> See the [removal handoff](effect-state-removal-handoff-2026-10-11.md). + **Feature:** [F-02](../../feature/F-02-portable-programs.md) **Design:** [Effects](../../design/backend/fp/effects.md) -**Progress:** EF-01 through EF-13 are Verified on the explicit trusted-identity +**Progress (pre-removal, historical):** EF-01 through EF-13 were Verified on the explicit trusted-identity contract. The effect-entry measurement on 2026-10-04 was 124/413 (Wasmtime 49.0.2, `purs` 0.15.16). Those 124 files are the previous non-`Int` entries; each exits 0. A later `Data.Functor` measurement on the same day moved the diff --git a/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md b/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md index 01f0c64b..8d32a9ad 100644 --- a/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md +++ b/docs/implementation/backend/library-owned-effects-audit-2026-10-11.md @@ -1,5 +1,11 @@ # Library-owned effects: scope and implementation audit +> **Historical (2026-10-11).** The compiler-owned Effect and State mechanisms +> audited here were removed on 2026-10-11. This audit describes the pre-removal +> tree and is retained as dated evidence only; it is **not** a plan to rebuild +> the removed machinery. See the +> [removal handoff](effect-state-removal-handoff-2026-10-11.md). + Date: 2026-10-11. Compiler branch: `stdlib/vendor-core-libraries`, HEAD `6b40b8d6`. This audit includes the existing 28 modified/untracked paths, including the uncommitted scoped-callback and zero-width-choice slices. The diff --git a/docs/implementation/backend/library-owned-effects.md b/docs/implementation/backend/library-owned-effects.md index 1018570f..26fbac0e 100644 --- a/docs/implementation/backend/library-owned-effects.md +++ b/docs/implementation/backend/library-owned-effects.md @@ -1,5 +1,13 @@ # Library-Owned Effects: Implementation Evidence +> **Withdrawn 2026-10-11.** The compiler-owned Effect and State mechanisms this +> record tracks were removed. The State vocabulary, checked primitive +> type contracts, dependency graph verifier, CC/MIR projection, runtime storage +> source bindings, and world-boundary runner integration no longer exist. The +> record below is retained as dated historical evidence and is **not** a plan to +> rebuild the removed machinery; the replacement Effect representation is +> undecided. + Governing designs: [library-owned effects](../../design/backend/fp/library-owned-effects.md) and [State primitives and dependency lowering](../../design/backend/fp/state-primitives-and-dependency-lowering.md). The State topic owns compiler semantics and pass contracts; this record tracks @@ -9,7 +17,7 @@ The [2026-10-11 audit](library-owned-effects-audit-2026-10-11.md) records the pu loop stack-exhaustion baseline and outstanding scope/projection concerns. The tail-call follow-up below records the repaired loop case. -Status: **Partial**. The state vocabulary, checked primitive type contracts and +Status (pre-removal, historical): **Partial**. The state vocabulary, checked primitive type contracts and generic dependency graph verifier exist. Core verification now produces checked flow for State-to-Step lambda bodies. CC now retains logical State values and derives checked flow from actual single-root function instructions. P9 now From 395ccba6ec50dd81c71e1eaaed84b0f0b26d2296 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 15:16:57 +0800 Subject: [PATCH 091/148] Use unsigned wasm32 allocator operands and separate artifact builds Interpret canonical realloc pointers, lengths and alignment as unsigned wasm32 values while keeping the four i32 export parameters. High-bit live addresses can now be resized and freed; Rust backing layouts above isize::MAX fail allocation, and full-memory byte coverage saturates instead of wrapping. Rebuild and repin the allocator artifact. Make `catalog` the only default psrs-runtime feature and rename `formatter` to `number`. Catalog, GC encoding and packaging dependencies are host-only. Replace the packaging example with the `psrs-runtime-package` binary under `tools/`, gated by `artifact-tool`, and give the numeric and allocator build scripts separate target directories so concurrent builds cannot exchange modules. Exercise a real 0x80000000 heap boundary in the linker test. --- crates/psrs-driver/src/tests/show.rs | 2 +- crates/psrs-linker/tests/heap_getter.rs | 4 +- crates/psrs-runtime/Cargo.toml | 18 ++- .../psrs-runtime/artifact/psrs_allocator.wasm | Bin 8062 -> 8118 bytes .../psrs-runtime/src/allocator/algorithm.rs | 114 +++++++++++++----- crates/psrs-runtime/src/allocator/wasm.rs | 13 +- crates/psrs-runtime/src/catalog/allocator.rs | 2 +- crates/psrs-runtime/src/catalog/number.rs | 2 +- crates/psrs-runtime/src/lib.rs | 33 ++--- crates/psrs-runtime/tools/build-allocator.sh | 5 +- crates/psrs-runtime/tools/build.sh | 10 +- .../{examples => tools}/package.rs | 2 +- .../wasm/canonical-realloc-runtime-adapter.md | 10 +- .../backend/wasm/linking-and-runtime.md | 23 +++- .../backend/linking-and-runtime.md | 42 +++++++ 15 files changed, 204 insertions(+), 76 deletions(-) rename crates/psrs-runtime/{examples => tools}/package.rs (96%) diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index cba5b70a..e024b171 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -122,7 +122,7 @@ main = let ignored = log (show 1.0e21) in 0 assert!(digests.contains("psrs:runtime-number"), "{digests}"); assert!(digests.contains("psrs:runtime-allocator"), "{digests}"); assert!( - digests.contains("a6f556d0151e8c474c495ad4488b9a23d67bb105dda2dc84eff17eaba70bbf19"), + digests.contains("4eca097da7112522a23cd790d7562d643090ac7d5f63aa493e853b23925dfb23"), "{digests}" ); assert!( diff --git a/crates/psrs-linker/tests/heap_getter.rs b/crates/psrs-linker/tests/heap_getter.rs index 25e4b6af..1cd55d40 100644 --- a/crates/psrs-linker/tests/heap_getter.rs +++ b/crates/psrs-linker/tests/heap_getter.rs @@ -122,7 +122,9 @@ fn allocator_executes_with_each_application_supplied_boundary() { return; } let context = resolve_default_definitions().unwrap(); - for heap in [65536, 262144] { + // The last boundary exercises real high-bit pointers through allocation, + // content-preserving resize and free, without a large payload allocation. + for heap in [65536_u32, 262144, 0x8000_0000] { let link = plan(&context, input(heap)).unwrap(); // Allocate beyond the initial page, verify bounds and scratch survival, // resize with content preservation, then free through the same instance. diff --git a/crates/psrs-runtime/Cargo.toml b/crates/psrs-runtime/Cargo.toml index 7bf82699..d6042c20 100644 --- a/crates/psrs-runtime/Cargo.toml +++ b/crates/psrs-runtime/Cargo.toml @@ -7,26 +7,34 @@ license.workspace = true [lib] crate-type = ["cdylib", "rlib"] +[[bin]] +name = "psrs-runtime-package" +path = "tools/package.rs" +required-features = ["artifact-tool"] + [features] -default = ["catalog", "formatter"] +default = ["catalog"] # Immutable host-consumed catalog data: WIT sources, world identity, artifact # bytes and provenance. Compiles no executable target code. catalog = [] # The executable number module: formatting, parsing, and scalar math. -# The feature name is retained for existing artifact build commands. -formatter = ["dep:ryu-js", "dep:libm"] -# The executable canonical realloc provider. The Wasm artifact build enables -# only this feature, separate from the numeric runtime. +number = ["dep:ryu-js", "dep:libm"] +# The executable canonical realloc provider, built separately from number. allocator = ["dep:dlmalloc"] # Host-side encoding of the executable GC storage provider. Its target code # uses Wasm GC directly, without a Rust heap or linear-memory handles. gc-storage = ["dep:wasm-encoder"] +# Host-only build tool for reserving the numeric artifact's private stack. +artifact-tool = ["dep:wasm-encoder", "wasm-encoder/wasmparser", "dep:wasmparser"] [dependencies] ryu-js = { version = "=1.0.2", default-features = false, optional = true } libm = { version = "=0.2.15", default-features = false, optional = true } dlmalloc = { version = "=0.2.14", default-features = false, optional = true } + +[target.'cfg(not(target_arch = "wasm32"))'.dependencies] wasm-encoder = { workspace = true, optional = true } +wasmparser = { workspace = true, optional = true } [dev-dependencies] wasm-encoder = { workspace = true, features = ["wasmparser"] } diff --git a/crates/psrs-runtime/artifact/psrs_allocator.wasm b/crates/psrs-runtime/artifact/psrs_allocator.wasm index 7a4ea802aa79bf5484b061ceef1a52d56e674133..84e04de597f140bebe0a563777ec200b4949c313 100644 GIT binary patch delta 591 zcmYLGL2J}N6n^t&UTR4Oqp)_9g1n>!S3G!IM2efCEXz{#>P7JE_EeFc3JHZC6oi&( z@A?}G9tFjNM-LwT6NN$#1?!uMRYGPmFW>vV_kHvG$*0NTSA6^E=-b7MmrAt`DuWF+ ztQlWBcxE9}DXS6wtGng71vUYYpLAUZl@1UiN8cY))(&QsNf}s=(a2^_FV*qj?wL~5 zPNXA9^bezjASxXGqxqw(PjuAK!vL(MUEbhD~rQ0>J(}Cmd z+N{S@+c-$AonODW&MiPsaj_u@|VtR|1 zSmlS&K@dg%yjod+$U{lo z#z%{aB*OWRvMi}cGL@phxnFHlAxZkI!{TVXXz=$(ZYbV^ z%dZow)>WQa<)1rxANDNzlgqyh$<5y1zcV1TOe{y9K9kf6Ee{F=50a?5RssZ^AI*lf?j3?G7}Q*k+TYGMgI35qnb7&Dvzyvx7m zM@(%*e8sE@5afPEYYAG`0k|AgNHS$D$g?O%^s)%(#e7N8 Result { + old_ptr: u32, + old_len: u32, + align: u32, + new_len: u32, +) -> Result { let align = canonical_align(align)?; - let new_len = canonical_len(new_len)?; if new_len == 0 { if old_ptr != 0 { let live = find(store, *head, old_ptr)?; - if live.requested != canonical_len(old_len)? { + if live.requested != old_len { return Err(()); } unlink(store, head, live.backing); @@ -49,9 +49,8 @@ pub fn realloc( if old_len != 0 { return Err(()); } - return Ok(insert(store, head, align, new_len)? as i32); + return insert(store, head, align, new_len); } - let old_len = canonical_len(old_len)?; let live = find(store, *head, old_ptr)?; if live.requested != old_len { return Err(()); @@ -60,7 +59,7 @@ pub fn realloc( store.copy(live.user, user, old_len.min(new_len)); unlink(store, head, live.backing); store.release(live.backing, live.size, live.align); - Ok(user as i32) + Ok(user) } fn insert(store: &mut impl Store, head: &mut u32, align: u32, len: u32) -> Result { @@ -82,15 +81,14 @@ fn insert(store: &mut impl Store, head: &mut u32, align: u32, len: u32) -> Resul Ok(user) } -fn find(store: &impl Store, head: u32, old_ptr: i32) -> Result { - if old_ptr <= 0 { +fn find(store: &impl Store, head: u32, old_ptr: u32) -> Result { + if old_ptr == 0 { return Err(()); } - let wanted = old_ptr as u32; let mut backing = head; while backing != 0 { let live = read_live(store, backing)?; - if live.user == wanted { + if live.user == old_ptr { return Ok(live); } backing = live.next; @@ -125,11 +123,7 @@ fn unlink(store: &mut impl Store, head: &mut u32, backing: u32) { } } -fn canonical_align(align: i32) -> Result { - if align <= 0 { - return Err(()); - } - let align = align as u32; +fn canonical_align(align: u32) -> Result { if align.is_power_of_two() { Ok(align) } else { @@ -137,10 +131,6 @@ fn canonical_align(align: i32) -> Result { } } -fn canonical_len(len: i32) -> Result { - u32::try_from(len).map_err(|_| ()) -} - pub mod provision { pub fn align_u32(value: u32, align: u32) -> Result { if align == 0 || !align.is_power_of_two() { @@ -211,7 +201,7 @@ mod tests { let mut heap = Heap::new(); let mut head = 0; let first = realloc(&mut heap, &mut head, 0, 0, 8, 4).unwrap(); - heap.write(first as u32, u32::from_le_bytes(*b"abcd")); + heap.write(first, u32::from_le_bytes(*b"abcd")); assert_eq!(first & 7, 0); let resized = realloc(&mut heap, &mut head, first, 4, 32, 4).unwrap(); assert_eq!(resized & 31, 0); @@ -234,9 +224,75 @@ mod tests { heap.bytes[first as usize] = 9; assert!(realloc(&mut heap, &mut head, first, 4, 8, 8).is_err()); assert_eq!(heap.bytes[first as usize], 9); - assert_eq!( - head, - first as u32 - provision::align_u32(RECORD, 8).unwrap() - ); + assert_eq!(head, first - provision::align_u32(RECORD, 8).unwrap()); + } + + // Sparse bookkeeping exercises unsigned addresses/lengths without reserving + // gigabytes of host memory. Copies are recorded rather than materialized. + struct SparseHeap { + cursor: u32, + words: std::collections::BTreeMap, + copies: Vec<(u32, u32, u32)>, + released: Vec, + } + + impl SparseHeap { + fn at(cursor: u32) -> Self { + Self { + cursor, + words: Default::default(), + copies: Vec::new(), + released: Vec::new(), + } + } + } + + impl Store for SparseHeap { + fn allocate(&mut self, size: u32, align: u32) -> Option { + let address = provision::align_u32(self.cursor, align).ok()?; + self.cursor = address.checked_add(size)?; + Some(address) + } + fn release(&mut self, pointer: u32, _: u32, _: u32) { + self.released.push(pointer); + } + fn read(&self, address: u32) -> u32 { + self.words[&address] + } + fn write(&mut self, address: u32, value: u32) { + self.words.insert(address, value); + } + fn copy(&mut self, from: u32, to: u32, len: u32) { + self.copies.push((from, to, len)); + } + } + + #[test] + fn high_bit_addresses_can_be_resized_and_freed() { + let mut heap = SparseHeap::at(0x8000_0000); + let mut head = 0; + let first = realloc(&mut heap, &mut head, 0, 0, 4, 8).unwrap(); + assert_eq!(first, 0x8000_0014); + assert!(realloc(&mut heap, &mut head, first + 1, 8, 4, 0).is_err()); + let resized = realloc(&mut heap, &mut head, first, 8, 8, 16).unwrap(); + assert_eq!(heap.copies, vec![(first, resized, 8)]); + assert_eq!(heap.released, vec![0x8000_0000]); + assert_eq!(realloc(&mut heap, &mut head, resized, 16, 8, 0), Ok(0)); + assert_eq!(head, 0); + assert_eq!(heap.released.len(), 2); + assert!(realloc(&mut heap, &mut head, resized, 16, 8, 0).is_err()); + } + + #[test] + fn unsigned_lengths_are_preserved_and_overflow_is_rejected() { + let mut heap = SparseHeap::at(64); + let mut head = 0; + let first = realloc(&mut heap, &mut head, 0, 0, 4, 0x8000_0000).unwrap(); + let resized = realloc(&mut heap, &mut head, first, 0x8000_0000, 4, 1).unwrap(); + assert_eq!(heap.copies, vec![(first, resized, 1)]); + assert_eq!(realloc(&mut heap, &mut head, resized, 1, 4, 0), Ok(0)); + assert_eq!(realloc(&mut heap, &mut head, 0, 0, 0x8000_0000, 0), Ok(0)); + assert!(realloc(&mut heap, &mut head, 0, 0, 4, u32::MAX).is_err()); + assert_eq!(head, 0); } } diff --git a/crates/psrs-runtime/src/allocator/wasm.rs b/crates/psrs-runtime/src/allocator/wasm.rs index 32506ecd..f66c7993 100644 --- a/crates/psrs-runtime/src/allocator/wasm.rs +++ b/crates/psrs-runtime/src/allocator/wasm.rs @@ -64,6 +64,12 @@ struct WasmStore<'a> { impl algorithm::Store for WasmStore<'_> { fn allocate(&mut self, size: u32, align: u32) -> Option { + // Rust allocations cannot exceed isize::MAX even though the canonical + // ABI accepts unsigned lengths. Reject such requests as allocation + // failures, without treating the high bit of an address as a sign. + if size > isize::MAX as u32 || align > isize::MAX as u32 { + return None; + } let pointer = unsafe { self.alloc.malloc(size as usize, align as usize) }; if pointer.is_null() { None @@ -120,7 +126,10 @@ static mut STATE: State = State { }; fn memory_bytes() -> usize { - core::arch::wasm32::memory_size(0) * PAGE + // A full wasm32 memory is 4 GiB, whose byte count exceeds usize::MAX. + // Saturation preserves coverage checks; segment planning still rejects + // ranges whose exclusive end cannot be represented. + core::arch::wasm32::memory_size(0).saturating_mul(PAGE) } fn initialize(alloc: &mut Dlmalloc) -> Result<(), ()> { @@ -134,7 +143,7 @@ fn initialize(alloc: &mut Dlmalloc) -> Result<(), ()> { /// Canonical realloc export. A trap leaves no published replacement pointer. #[unsafe(no_mangle)] -pub unsafe extern "C" fn cabi_realloc(old_ptr: i32, old_len: i32, align: i32, new_len: i32) -> i32 { +pub unsafe extern "C" fn cabi_realloc(old_ptr: u32, old_len: u32, align: u32, new_len: u32) -> u32 { unsafe { let state = &mut *core::ptr::addr_of_mut!(STATE); let initializing = phase::enter(&mut state.phase).unwrap_or_else(|_| { diff --git a/crates/psrs-runtime/src/catalog/allocator.rs b/crates/psrs-runtime/src/catalog/allocator.rs index eef9d8f3..ed6dffcb 100644 --- a/crates/psrs-runtime/src/catalog/allocator.rs +++ b/crates/psrs-runtime/src/catalog/allocator.rs @@ -22,7 +22,7 @@ pub const ALLOCATOR_RUNTIME: RuntimeArtifact = RuntimeArtifact { recipe: "tools/build-allocator.sh: remap-path-prefix, no-redzone, --import-memory \ --stack-first -zstack-size=32768 --global-base=32768; direct Rust output, \ imports __main_module__.get_heap_base, no executable start", - sha256: "a6f556d0151e8c474c495ad4488b9a23d67bb105dda2dc84eff17eaba70bbf19", + sha256: "4eca097da7112522a23cd790d7562d643090ac7d5f63aa493e853b23925dfb23", }, required_features: &[ "mutable-globals", diff --git a/crates/psrs-runtime/src/catalog/number.rs b/crates/psrs-runtime/src/catalog/number.rs index cbedf450..182d2e51 100644 --- a/crates/psrs-runtime/src/catalog/number.rs +++ b/crates/psrs-runtime/src/catalog/number.rs @@ -16,7 +16,7 @@ pub const NUMBER_RUNTIME: RuntimeArtifact = RuntimeArtifact { target: "wasm32-unknown-unknown", profile: "target-runtime", recipe: "tools/build.sh: RUSTFLAGS=-C no-redzone=yes; --import-memory --global-base=65536 \ - -zstack-size=65536 --export=__heap_base, then package", + -zstack-size=65536 --export=__heap_base, then psrs-runtime-package", sha256: "458a7df7eb27038c4d6b22aa52fc8ea283c6dca41120b0c0bf31f6a851aa0260", }, required_features: &[ diff --git a/crates/psrs-runtime/src/lib.rs b/crates/psrs-runtime/src/lib.rs index 53691373..71830510 100644 --- a/crates/psrs-runtime/src/lib.rs +++ b/crates/psrs-runtime/src/lib.rs @@ -2,44 +2,33 @@ //! //! `abi` defines data-only raw contracts for every build. Feature `catalog` //! exposes pinned WIT, artifact metadata, and package units to native compiler -//! consumers. Feature `formatter` builds the numeric implementation in `number`; -//! feature `allocator` builds the canonical allocator. Each Wasm artifact enables -//! exactly one executable feature and embeds no catalog assets. +//! consumers and is the only default feature. Feature `number` builds the numeric implementation; +//! feature `allocator` builds the canonical allocator. Features are additive; +//! each pinned Wasm artifact selects exactly one executable feature. //! Feature `gc-storage` exposes a host encoder for an independent GC storage //! module; its target operations allocate no Rust or linear-memory heap. +//! Feature `artifact-tool` builds the host-only `psrs-runtime-package` binary. -#![cfg_attr( - all( - any(feature = "formatter", feature = "allocator"), - target_arch = "wasm32" - ), - no_std -)] +#![cfg_attr(target_arch = "wasm32", no_std)] pub mod abi; pub use abi::*; -#[cfg(feature = "gc-storage")] +#[cfg(all(feature = "gc-storage", not(target_arch = "wasm32")))] pub mod storage; -#[cfg(feature = "catalog")] +#[cfg(all(feature = "catalog", not(target_arch = "wasm32")))] pub mod catalog; -#[cfg(feature = "catalog")] +#[cfg(all(feature = "catalog", not(target_arch = "wasm32")))] pub use catalog::*; -#[cfg(feature = "formatter")] +#[cfg(feature = "number")] mod number; -#[cfg(feature = "formatter")] +#[cfg(feature = "number")] pub use number::*; #[cfg(all(feature = "allocator", any(test, target_arch = "wasm32")))] mod allocator; -#[cfg(all( - any(feature = "formatter", feature = "allocator"), - target_arch = "wasm32" -))] +#[cfg(all(target_arch = "wasm32", not(test)))] mod panic; - -#[cfg(all(feature = "formatter", feature = "allocator", target_arch = "wasm32"))] -compile_error!("the formatter and allocator are separate wasm32 artifacts"); diff --git a/crates/psrs-runtime/tools/build-allocator.sh b/crates/psrs-runtime/tools/build-allocator.sh index cebd17cf..8c2101f5 100755 --- a/crates/psrs-runtime/tools/build-allocator.sh +++ b/crates/psrs-runtime/tools/build-allocator.sh @@ -1,14 +1,15 @@ #!/bin/sh set -eu cd "$(dirname "$0")/../../.." +runtime_allocator_target="${CARGO_TARGET_DIR:-target}/runtime-allocator" sysroot=$(rustc --print sysroot) # The upper 16 KiB of the stack prefix is allocator-owned; verified frame # bounds keep accesses above canonical scratch. Data starts above the stack. # Paths in panic text must not capture this machine. RUSTFLAGS="${RUSTFLAGS:-} -C no-redzone=yes --remap-path-prefix=${HOME}/.cargo/=/cargo/ --remap-path-prefix=${sysroot}=/rustc/ --remap-path-prefix=${PWD}=/psrs/" \ cargo rustc --locked -p psrs-runtime --lib --no-default-features --features allocator \ - --target wasm32-unknown-unknown --profile target-runtime -- \ + --target-dir "$runtime_allocator_target" --target wasm32-unknown-unknown --profile target-runtime -- \ -C link-arg=--import-memory -C link-arg=--global-base=32768 \ -C link-arg=--stack-first -C link-arg=-zstack-size=32768 -cp target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ +cp "$runtime_allocator_target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm" \ "${1:-crates/psrs-runtime/artifact/psrs_allocator.wasm}" diff --git a/crates/psrs-runtime/tools/build.sh b/crates/psrs-runtime/tools/build.sh index cf30f6b8..da326d11 100644 --- a/crates/psrs-runtime/tools/build.sh +++ b/crates/psrs-runtime/tools/build.sh @@ -1,13 +1,15 @@ #!/bin/sh set -eu cd "$(dirname "$0")/../../.." +runtime_number_target="${CARGO_TARGET_DIR:-target}/runtime-number" # Apply to dependencies as well: libm force_eval uses stack temporaries. # Explicit frames let the linker measure their storage without a red zone. RUSTFLAGS="${RUSTFLAGS:-} -C no-redzone=yes" \ -cargo rustc --locked -p psrs-runtime --lib --no-default-features --features formatter \ - --target wasm32-unknown-unknown --profile target-runtime -- \ +cargo rustc --locked -p psrs-runtime --lib --no-default-features --features number \ + --target-dir "$runtime_number_target" --target wasm32-unknown-unknown --profile target-runtime -- \ -C link-arg=--import-memory -C link-arg=--global-base=65536 \ -C link-arg=-zstack-size=65536 -C link-arg=--export=__heap_base -cargo run --locked -p psrs-runtime --example package -- \ - target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm \ +cargo run --locked -p psrs-runtime --no-default-features --features artifact-tool \ + --bin psrs-runtime-package -- \ + "$runtime_number_target/wasm32-unknown-unknown/target-runtime/psrs_runtime.wasm" \ "${1:-crates/psrs-runtime/artifact/psrs_runtime.wasm}" diff --git a/crates/psrs-runtime/examples/package.rs b/crates/psrs-runtime/tools/package.rs similarity index 96% rename from crates/psrs-runtime/examples/package.rs rename to crates/psrs-runtime/tools/package.rs index ce3442e4..9fe1d720 100644 --- a/crates/psrs-runtime/examples/package.rs +++ b/crates/psrs-runtime/tools/package.rs @@ -51,7 +51,7 @@ impl Reencode for Reservation { fn main() -> Result<(), Box> { let args: Vec<_> = env::args().collect(); if args.len() != 3 { - return Err("usage: package ".into()); + return Err("usage: psrs-runtime-package ".into()); } let bytes = fs::read(&args[1])?; wasmparser::Validator::new().validate_all(&bytes)?; diff --git a/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md b/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md index 6b721889..a57950f8 100644 --- a/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md +++ b/docs/design/backend/wasm/canonical-realloc-runtime-adapter.md @@ -152,8 +152,16 @@ an optimization requiring correct record updates and the same failure guarantees ## Algorithms -1. Validate `align` as a nonzero power of two for every call, including zero sizes. +1. Interpret pointers, lengths and alignment as unsigned wasm32 values; their + physical Core signature remains `i32`. A high-bit address is a valid address, + not a negative-pointer error. Validate `align` as a nonzero power of two for + every call, including zero sizes. Apply checked payload/prefix/alignment arithmetic before allocator mutation. + The Rust allocation adapter rejects backing sizes and alignments above + `isize::MAX` as allocation failures. This bounds individual allocation + layouts, not the numeric address of a live allocation. At full wasm32 memory, + byte coverage saturates to `usize::MAX`; segment planning still rejects an + unrepresentable exclusive end. 2. For `new_len == 0`, locate and free any non-null live allocation using its stored backing layout, unlink its record, and return zero. Preserve the existing free-path old-length treatment; do not pass that length to Rust. diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index cc518975..5add4fd7 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -246,16 +246,27 @@ The package remains one crate, with four module owners: - `src/catalog/` contains plain metadata records, WIT assets, package membership, and separate numeric/allocator declarations. Each unit's operation offers and pinned artifact contract are declared together. -- `src/number/` implements formatting, decimal parsing, and scalar math. The - existing `formatter` feature remains its build entry for compatibility. +- `src/number/` implements formatting, decimal parsing, and scalar math, + selected by the `number` feature. - `src/allocator/` separates portable allocation validation, phase handling and segment planning from the Wasm adapter and its persistent state. `lib.rs` selects these modules and preserves the existing root-level exports. -One Wasm-only panic handler supplies trap behavior for either executable build; -the numeric and allocator features remain mutually exclusive on Wasm. Native -compiler consumers enable only `catalog`, while each artifact build enables only -its executable feature. `tools/check-reproducible.sh` rebuilds and compares both +One Wasm-only panic handler supplies trap behavior for executable builds. +Features are additive: enabling both numeric and allocator code is permitted, +but does not select a published artifact's storage contract. Native +compiler consumers enable `catalog` and, where needed, the `gc-storage` host +encoder. The default feature set contains only `catalog`; executable numeric +code is not enabled by metadata consumption. Catalog and GC encoding modules, +and packaging dependencies, are host-only even when their features are enabled +on Wasm. Each Rust artifact build disables +defaults and enables only `number` or `allocator`. The host packaging binary +`psrs-runtime-package` lives in `tools/package.rs` and requires `artifact-tool`; +`tools/build.sh` invokes it with defaults disabled to reserve the numeric +artifact's private stack. The scripts use separate `runtime-number` and +`runtime-allocator` target directories under the configured Cargo target root, +so concurrent builds cannot exchange their output modules. +`tools/check-reproducible.sh` rebuilds and compares both pinned artifacts through their respective build scripts without overwriting them. The resolved default world supplies interface membership. Capability policy is diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index 3433f78f..b17e3b07 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -290,3 +290,45 @@ tests execute string-buffer reclamation through the composed provider. Corpus scoreboards were not remeasured. This evidence does not close all allocator and buffer-lifetime acceptance obligations or persistent Core caching. + +## Runtime address and build contracts (2026-10-11) + +Canonical allocator operands now use unsigned wasm32 addresses, lengths and +alignment throughout the runtime adapter. The Core export signature remains +four `i32` parameters and one `i32` result. High-bit live addresses can be resized +and freed; backing layouts beyond Rust's `isize::MAX` allocation limit fail +explicitly. Full-memory byte coverage no longer wraps at 4 GiB. + +The allocator artifact was rebuilt and repinned to SHA-256 +`4eca097da7112522a23cd790d7562d643090ac7d5f63aa493e853b23925dfb23`. +Composition verifies its ABI, storage reservations and declared 80-byte stack +upper bound against the actual binary. + +`catalog` is the only default feature. Host metadata, GC encoding and packaging +dependencies are excluded from Wasm builds. Executable features are additive; +published numeric and allocator artifacts still select separate feature sets +and storage contracts. Their build scripts now use distinct target directories. +Numeric packaging is an explicit host binary under `tools/`, rather than an +example. The numeric artifact is unchanged. + +Focused validation: + +| Command or check | Result | +| --- | --- | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-runtime --all-features --lib` | 26 passed; includes sparse high-bit address and unsigned-length allocator cases, and mandatory GC provider execution | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-linker --test heap_getter` | 4 passed with the new artifact; the execution case subsequently passed with an added `0x80000000` heap boundary | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib post_return::` | 3 passed, including composed string-buffer reclamation | +| `cargo check --locked -p psrs-runtime --lib --target wasm32-unknown-unknown --all-features` | Passed | +| Concurrent numeric and allocator build scripts, followed by comparison against pinned bytes | Both artifacts reproduced byte-for-byte | +| `cargo clippy -p psrs-runtime --all-targets --all-features -- -D warnings` | Passed | + +Formatting (`cargo fmt --all --check`), shell syntax checks and +`git diff --check` passed for this continuation. + +The high-boundary execution allocates a small payload in memory above 2 GiB, +checks its contents after resizing, and frees it through the composed allocator. +It does not attempt a single allocation larger than Rust's layout limit. +Workspace tests and corpus scoreboards were not rerun for this bounded fix. +Storage ABI comments now describe ordinary operands without a State protocol. +Compiler-side generic storage bindings remain explicitly unsupported after +withdrawal of State; this work does not restore them or implement Effect/ST. From e7e250cfc581c41113f607028534f6cbfedf147a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 15:18:02 +0800 Subject: [PATCH 092/148] Support ordinary runtime storage bindings Replace the explicit "withdrawn State contract" rejections with ordinary checked storage bindings. `bindings/runtime/source.rs` validates every Core signature, including unused imports, and Core's type-equivalence relation checks array elements and payloads. `bindings/runtime/call/` canonicalizes operand slots to the existing erased payload protocol and verifies incoming CC signatures using the common CC boxing, recovery and callable-adapter machinery; arrays keep their canonical erased-element storage and identity. `bindings/runtime/target.rs` plans physical imports in the application layout arena, and MIR retains the live import inventory so `mir/lower/storage_call.rs` can widen references to nullable raw calls, check recovered references, materialize Unit after a void write and emit an unreachable result after a non-returning trap. Zero-operand polymorphic external values now take their source scheme from the external type inventory through ordinary global lowering. No State token, dependency chain or sequencing analysis returns. Add driver source-to-component storage tests and malformed-CC-signature tests. Record that the erasure cohort fails identically before and after this change because the committed stdlib lock is stale relative to the effect removal. --- crates/psrs-backend/src/bindings/mod.rs | 2 +- .../src/bindings/runtime/call/mod.rs | 103 +++++++++++---- .../src/bindings/runtime/call/tests.rs | 76 +++++++++++ .../psrs-backend/src/bindings/runtime/mod.rs | 10 +- .../src/bindings/runtime/source.rs | 52 ++++++++ .../src/bindings/runtime/target.rs | 63 +++++++-- crates/psrs-backend/src/cc/lower/global.rs | 33 +++-- .../psrs-backend/src/mir/layout/accessors.rs | 4 + .../psrs-backend/src/mir/lower/assignments.rs | 8 ++ crates/psrs-backend/src/mir/lower/mod.rs | 4 + .../src/mir/lower/storage_call.rs | 118 +++++++++++++++++ crates/psrs-backend/src/mir/lower/wit_call.rs | 1 + .../psrs-backend/src/mir/lower/wit_tests.rs | 1 + crates/psrs-backend/src/mir/mod.rs | 2 + .../psrs-backend/src/mir/runtime/context.rs | 10 +- crates/psrs-driver/src/tests/mod.rs | 1 + .../psrs-driver/src/tests/runtime_storage.rs | 125 ++++++++++++++++++ crates/psrs-runtime/src/abi/storage/mod.rs | 8 +- .../src/abi/storage/projection.rs | 6 +- .../backend/wasm/linking-and-runtime.md | 24 ++++ .../backend/linking-and-runtime.md | 43 ++++++ 21 files changed, 625 insertions(+), 69 deletions(-) create mode 100644 crates/psrs-backend/src/bindings/runtime/call/tests.rs create mode 100644 crates/psrs-backend/src/bindings/runtime/source.rs create mode 100644 crates/psrs-backend/src/mir/lower/storage_call.rs create mode 100644 crates/psrs-driver/src/tests/runtime_storage.rs diff --git a/crates/psrs-backend/src/bindings/mod.rs b/crates/psrs-backend/src/bindings/mod.rs index 4babee0f..81477c1d 100644 --- a/crates/psrs-backend/src/bindings/mod.rs +++ b/crates/psrs-backend/src/bindings/mod.rs @@ -217,7 +217,7 @@ impl ExternalBindings { /// Checks that the binding inventory covers CC externals exactly once. /// Source conformance is checked against Core before CC publication; - /// unsupported runtime call projection remains an explicit boundary. + /// runtime operands must agree with the canonical CC call signature. pub(crate) fn validate_cc(&self, module: &cc::Module) -> Result<(), Vec> { let mut cc_externals = HashMap::new(); let mut errors = Vec::new(); diff --git a/crates/psrs-backend/src/bindings/runtime/call/mod.rs b/crates/psrs-backend/src/bindings/runtime/call/mod.rs index f7f88dc4..e0e5258d 100644 --- a/crates/psrs-backend/src/bindings/runtime/call/mod.rs +++ b/crates/psrs-backend/src/bindings/runtime/call/mod.rs @@ -1,42 +1,91 @@ -//! Checked logical CC operands for the runtime-owned raw storage contract. -//! -//! The source storage operations were declared through the withdrawn State -//! protocol. No generic source-to-raw operand projection replaced it, so this -//! boundary reports the missing interface explicitly instead of fabricating a -//! successful binding. Provider identity validation lives in -//! [`super::target::verify_import`], which does not need a State contract. -use crate::BackendError; -use crate::bindings::RuntimeBinding; -use crate::cc; +//! Ordinary CC call signatures for the runtime storage ABI. +use crate::{BackendError, RuntimeBinding, cc}; +use psrs_runtime::{StorageOperation, StorageValue}; -fn unsupported(binding: &RuntimeBinding, message: &str) -> Vec { +#[cfg(test)] +mod tests; + +fn error(binding: &RuntimeBinding, message: &str) -> Vec { vec![ - BackendError::invalid_ir("P9 runtime projection", binding.span, message) + BackendError::invalid_ir("P8 runtime ABI", binding.span, message) .with_module(binding.source_module), ] } -/// The former State-to-Step operand projection. Retained as an explicit failure -/// while the replacement runtime binding contract is undecided. pub(crate) fn checked( binding: &RuntimeBinding, - _module: &cc::Module, + module: &cc::Module, ) -> Result<(), Vec> { - Err(unsupported( - binding, - "runtime storage bindings require the withdrawn State contract", - )) + let signature = module + .externals + .iter() + .find(|external| external.symbol == binding.symbol) + .and_then(|external| external.signature.as_ref()) + .ok_or_else(|| error(binding, "runtime external has no CC signature"))?; + let canonical = canonical_signature(binding, signature, &module.representations)?; + if &canonical != signature { + return Err(error( + binding, + "runtime external disagrees with its canonical CC signature", + )); + } + Ok(()) } -/// The former canonical storage signature. There is no generic replacement, so -/// a runtime source binding cannot produce a CC signature. +/// Use the common CC payload protocol at the external call boundary. Source +/// arrays already store erased elements: their identity is never converted. pub(crate) fn canonical_signature( binding: &RuntimeBinding, - _signature: &cc::Signature, - _table: &cc::RepresentationTable, + signature: &cc::Signature, + table: &cc::RepresentationTable, ) -> Result> { - Err(unsupported( - binding, - "runtime storage bindings require the withdrawn State contract", - )) + if binding.module != psrs_runtime::STORAGE_MODULE { + return Err(error(binding, "unknown runtime storage provider")); + } + let operation = StorageOperation::from_export(&binding.function) + .ok_or_else(|| error(binding, "unknown runtime storage export"))?; + let contract = operation.source_contract(); + if signature.parameters.len() != contract.parameters.len() { + return Err(error( + binding, + "runtime CC signature has the wrong parameter count", + )); + } + let shape = |expected, actual| -> Result<_, Vec> { + match expected { + StorageValue::Int | StorageValue::Unit if actual == cc::ValueShape::Integer => { + Ok(actual) + } + StorageValue::Element => Ok(cc::payload::erased_shape()), + StorageValue::Any => Ok(actual), + StorageValue::Array => { + if let cc::ValueShape::Reference(cc::Reference { + nullable: false, + heap: cc::RefShape::Repr(id), + }) = actual + && matches!(table.representation(id), Some(cc::Representation::Array { element }) if *element == cc::payload::erased_shape()) + { + return Ok(actual); + } + Err(error( + binding, + "runtime array requires canonical erased-element storage", + )) + } + _ => Err(error( + binding, + "runtime CC operand shape disagrees with its contract", + )), + } + }; + Ok(cc::Signature { + parameters: contract + .parameters + .iter() + .copied() + .zip(&signature.parameters) + .map(|(expected, actual)| shape(expected, *actual)) + .collect::>()?, + result: shape(contract.payload, signature.result)?, + }) } diff --git a/crates/psrs-backend/src/bindings/runtime/call/tests.rs b/crates/psrs-backend/src/bindings/runtime/call/tests.rs new file mode 100644 index 00000000..ff839891 --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/call/tests.rs @@ -0,0 +1,76 @@ +use super::*; + +#[test] +fn canonical_runtime_call_rejects_malformed_cc_signatures() { + let binding = RuntimeBinding { + symbol: psrs_hir::SymbolId::new(psrs_hir::ModuleId(7), 1), + source_module: psrs_hir::ModuleId(7), + module: psrs_runtime::STORAGE_MODULE.into(), + function: "array_read".into(), + type_id: None, + span: psrs_span::TextRange::new(0, 1), + }; + let mut table = cc::RepresentationTable::default(); + let array = table.reserve(); + table.set( + array, + cc::Representation::Array { + element: cc::payload::erased_shape(), + }, + ); + let mut module = cc::Module { + name: "Probe".into(), + externals: vec![cc::External { + symbol: binding.symbol, + signature: Some(cc::Signature { + parameters: vec![ + cc::ValueShape::Reference(cc::Reference { + nullable: false, + heap: cc::RefShape::Repr(array), + }), + cc::ValueShape::Integer, + ], + result: cc::payload::erased_shape(), + }), + projection: None, + }], + representations: table, + functions: Vec::new(), + entry: None, + span: binding.span, + }; + checked(&binding, &module).unwrap(); + for change in 0..5 { + let mut wrong = module.clone(); + match change { + 0 => wrong.externals[0].signature = None, + 1 => { + wrong.externals[0] + .signature + .as_mut() + .unwrap() + .parameters + .pop(); + } + 2 => wrong.externals[0].signature.as_mut().unwrap().result = cc::ValueShape::Integer, + 3 => { + wrong.externals[0].signature.as_mut().unwrap().parameters[0] = + cc::payload::erased_shape() + } + _ => wrong.representations.set( + array, + cc::Representation::Array { + element: cc::ValueShape::Integer, + }, + ), + } + let errors = checked(&binding, &wrong).expect_err("malformed runtime CC signature"); + assert!( + errors + .iter() + .all(|error| error.module == Some(binding.source_module)) + ); + } + module.externals.clear(); + assert!(checked(&binding, &module).is_err()); +} diff --git a/crates/psrs-backend/src/bindings/runtime/mod.rs b/crates/psrs-backend/src/bindings/runtime/mod.rs index 5e5fee88..c305382b 100644 --- a/crates/psrs-backend/src/bindings/runtime/mod.rs +++ b/crates/psrs-backend/src/bindings/runtime/mod.rs @@ -8,14 +8,13 @@ use psrs_runtime::StorageOperation; pub(super) mod call; pub(super) mod metadata; +mod source; pub(super) mod target; /// Validate all declarations, including unused ones, before lowering/erasure. /// The immutable checked Core arena owns every signature identity used here. /// -/// The former State-to-Step source contract check was removed with the State -/// mechanism. Provider identity and export existence are still checked; the -/// operand projection is reported unsupported at the CC boundary instead. +/// Source operands are ordinary values; no sequencing protocol is inferred. pub(crate) fn validate(module: &Module) -> Result<(), Vec> { for external in &module.externals { let ExternalKind::Runtime { @@ -40,11 +39,14 @@ pub(crate) fn validate(module: &Module) -> Result<(), Vec> { if provider != psrs_runtime::STORAGE_MODULE { return Err(error(format!("unknown runtime provider `{provider}`"))); } - StorageOperation::from_export(function).ok_or_else(|| { + let operation = StorageOperation::from_export(function).ok_or_else(|| { error(format!( "runtime provider `{provider}` has no export `{function}`" )) })?; + let checked = checked + .ok_or_else(|| error("runtime binding has no checked source signature".into()))?; + source::validate(module, checked.ty, operation).map_err(error)?; } Ok(()) } diff --git a/crates/psrs-backend/src/bindings/runtime/source.rs b/crates/psrs-backend/src/bindings/runtime/source.rs new file mode 100644 index 00000000..e0f6d212 --- /dev/null +++ b/crates/psrs-backend/src/bindings/runtime/source.rs @@ -0,0 +1,52 @@ +//! Source type agreement checked before ABI erasure, including unused imports. +use psrs_core::{Module, Type, TypeConstructor, TypeId}; +use psrs_runtime::{StorageOperation, StorageValue}; + +pub(super) fn validate( + module: &Module, + ty: TypeId, + operation: StorageOperation, +) -> Result<(), String> { + let (parameters, result) = psrs_core::call_parts(&module.types, ty).map_err(str::to_owned)?; + let contract = operation.source_contract(); + if parameters.len() != contract.parameters.len() { + return Err("runtime storage signature has the wrong parameter count".into()); + } + let mut element = None; + for (ty, expected) in parameters + .into_iter() + .zip(contract.parameters) + .chain(std::iter::once((result, &contract.payload))) + { + let candidate = match expected { + StorageValue::Int | StorageValue::Unit => { + let constructor = if *expected == StorageValue::Int { + TypeConstructor::Int + } else { + TypeConstructor::Unit + }; + if module.types.get(ty.0 as usize) != Some(&Type::Constructor(constructor)) { + return Err(format!("runtime storage signature expects {expected:?}")); + } + continue; + } + StorageValue::Array => { + let Some((TypeConstructor::Array, arguments)) = module.applied_constructor(ty) + else { + return Err("runtime storage signature expects Array".into()); + }; + let [element] = arguments.as_slice() else { + return Err("runtime storage Array must have one element type".into()); + }; + *element + } + StorageValue::Element => ty, + StorageValue::Any => continue, + }; + if element.is_some_and(|previous| !module.types_equivalent(previous, candidate)) { + return Err("runtime storage signature has inconsistent element types".into()); + } + element = Some(candidate); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/bindings/runtime/target.rs b/crates/psrs-backend/src/bindings/runtime/target.rs index dfe7ee82..9730d1a3 100644 --- a/crates/psrs-backend/src/bindings/runtime/target.rs +++ b/crates/psrs-backend/src/bindings/runtime/target.rs @@ -74,24 +74,61 @@ pub(crate) fn verify_import(import: &Import, types: &[RecGroup]) -> Result<(), S pub(crate) fn error(binding: &RuntimeBinding, message: &str) -> Vec { vec![ - BackendError::invalid_ir("P9 runtime projection", binding.span, message) + BackendError::invalid_ir("P9 runtime ABI", binding.span, message) .with_module(binding.source_module), ] } -/// Plan raw types in the application's own layout arena. This does not box -/// operands, recover results, emit calls, or authorize dependency erasure. -/// -/// The source operand projection depended on the withdrawn State protocol, so -/// no generic replacement exists. This reports the missing interface explicitly -/// instead of planning a call from an erased contract. +/// Plan raw types using the canonical CC signature and the application's arena. pub(crate) fn plan_import( binding: &RuntimeBinding, - _logical: &cc::Module, - _layout: &PlannedLayout, + logical: &cc::Module, + layout: &PlannedLayout, ) -> Result> { - Err(error( - binding, - "runtime storage bindings require the withdrawn State contract", - )) + super::call::checked(binding, logical)?; + let signature = logical + .externals + .iter() + .find(|external| external.symbol == binding.symbol) + .and_then(|external| external.signature.as_ref()) + .ok_or_else(|| error(binding, "runtime external has no CC signature"))?; + let operation = psrs_runtime::StorageOperation::from_export(&binding.function) + .ok_or_else(|| error(binding, "unknown runtime storage export"))?; + let raw = operation + .projection() + .map_err(|message| error(binding, message))?; + let physical = |raw, shape| -> Result<_, Vec> { + Ok(match raw { + RawType::I32 => ValueType::I32, + RawType::Value => ValueType::Ref(RefType { + nullable: true, + heap: HeapType::Eq, + }), + RawType::Array => layout + .value_type(&shape) + .map_err(|_| error(binding, "runtime array has no planned layout"))?, + }) + }; + let import = Import { + symbol: binding.symbol, + runtime: Some(crate::mir::RuntimeImport { + module: binding.module.clone(), + function: binding.function.clone(), + }), + parameters: raw + .abi() + .parameters + .iter() + .copied() + .zip(&signature.parameters) + .map(|(raw, shape)| physical(raw, *shape)) + .collect::>()?, + result: raw + .abi() + .result + .map(|raw| physical(raw, signature.result)) + .transpose()?, + }; + verify_import(&import, layout.types()).map_err(|message| error(binding, &message))?; + Ok(import) } diff --git a/crates/psrs-backend/src/cc/lower/global.rs b/crates/psrs-backend/src/cc/lower/global.rs index cc63cea3..1b2ea5b1 100644 --- a/crates/psrs-backend/src/cc/lower/global.rs +++ b/crates/psrs-backend/src/cc/lower/global.rs @@ -139,20 +139,33 @@ impl GlobalLowering for FunctionLowerer<'_> { if source_shape == result_type { return Ok(destination); } - let declaration = self + let (source_type, quantified) = if let Some(declaration) = self .module .declarations .iter() .find(|declaration| declaration.symbol == function) - .ok_or_else(|| { - global_error(expression, "global value has no source declaration type") - })?; - let source_type = declaration.ty; - let evidence = self.boundary.checked_instantiation( - source_type, - &declaration.quantified, - expression.ty, - ); + { + (declaration.ty, declaration.quantified.clone()) + } else if let Some(external) = self + .module + .external_types + .iter() + .find(|external| external.symbol == function) + { + let (quantified, _) = psrs_core::scheme_parts(&self.module.types, external.ty) + .ok_or_else(|| { + global_error(expression, "external value has an invalid source scheme") + })?; + (external.ty, quantified) + } else { + return Err(global_error( + expression, + "global value has no source declaration type", + )); + }; + let evidence = + self.boundary + .checked_instantiation(source_type, &quantified, expression.ty); let conversion = self.typed_conversion_with_instantiation( source_type, expression.ty, diff --git a/crates/psrs-backend/src/mir/layout/accessors.rs b/crates/psrs-backend/src/mir/layout/accessors.rs index 4b6d05fb..46f39ada 100644 --- a/crates/psrs-backend/src/mir/layout/accessors.rs +++ b/crates/psrs-backend/src/mir/layout/accessors.rs @@ -8,6 +8,10 @@ use crate::cc::{ use crate::types::{DefinedTypeId, HeapType, RefType, ValueType}; impl PlannedLayout { + pub(crate) fn types(&self) -> &[crate::types::RecGroup] { + &self.types + } + pub(crate) fn repr_index(&self, id: ReprId) -> Result { self.repr_indices .get(&id) diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 6bdfc940..35406bd1 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -221,6 +221,14 @@ impl FunctionLowerer<'_> { } => { if let Some(import) = self.wit_imports.get(function).cloned() { current = self.lower_wit_call(&import, assignment, current)?; + } else if let Some(import) = self.runtime_imports.get(function).cloned() { + self.lower_storage_call( + current, + assignment.destination, + &import, + arguments, + assignment.span, + )?; } else { self.append_instruction( current, diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index de9aa7d9..f47d611c 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -18,6 +18,7 @@ mod assignment_string; mod assignments; mod conversion_helpers; mod runtime_call; +mod storage_call; pub(in crate::mir) mod tail; mod variant; mod wit_call; @@ -46,6 +47,7 @@ pub(super) fn lower_function( source: &cc::Function, id: FunctionId, wit_imports: &HashMap, + runtime_imports: &HashMap, layout: &PlannedLayout, conversion_helpers: Option<&mut ConversionHelpers>, literals: Option<&mut StringLiterals>, @@ -81,6 +83,7 @@ pub(super) fn lower_function( .max() .map_or(0, |max| max + 1), wit_imports, + runtime_imports, layout, conversion_helpers, literals, @@ -123,6 +126,7 @@ pub(super) struct FunctionLowerer<'a> { values: Vec, next_value: u32, wit_imports: &'a HashMap, + runtime_imports: &'a HashMap, pub(in crate::mir) layout: &'a PlannedLayout, conversion_helpers: Option<&'a mut ConversionHelpers>, literals: Option<&'a mut StringLiterals>, diff --git a/crates/psrs-backend/src/mir/lower/storage_call.rs b/crates/psrs-backend/src/mir/lower/storage_call.rs new file mode 100644 index 00000000..aa3f6812 --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/storage_call.rs @@ -0,0 +1,118 @@ +//! Ordinary storage calls: CC has already adapted payloads to erased storage. +use super::*; + +impl FunctionLowerer<'_> { + pub(super) fn lower_storage_call( + &mut self, + block: BlockId, + destination: ValueId, + import: &crate::mir::Import, + arguments: &[ValueId], + span: TextRange, + ) -> Result<(), Vec> { + if arguments.len() != import.parameters.len() { + return Err(vec![BackendError::invalid_ir( + "P9 runtime binding", + span, + "storage call has the wrong argument count", + )]); + } + let provider = import.runtime.as_ref().ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 runtime binding", + span, + "storage call has no provider", + )] + })?; + let operation = psrs_runtime::StorageOperation::from_export(&provider.function) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 runtime binding", + span, + "storage call has no checked export", + )] + })?; + let mut raw_arguments = Vec::with_capacity(arguments.len()); + for (value, expected) in arguments.iter().copied().zip(&import.parameters) { + if self.value_type(value) == Some(*expected) { + raw_arguments.push(value); + } else if let ValueType::Ref(reference) = expected { + let raw = self.fresh(*expected); + self.append_instruction( + block, + Instruction::RefCast { + destination: raw, + value, + reference: *reference, + span, + }, + span, + )?; + raw_arguments.push(raw); + } else { + return Err(vec![BackendError::invalid_ir( + "P9 runtime binding", + span, + "storage operand disagrees with its raw type", + )]); + } + } + if let Some(result) = import.result { + let raw = if self.value_type(destination) == Some(result) { + destination + } else { + self.fresh(result) + }; + self.append_instruction( + block, + Instruction::Call { + destination: raw, + function: import.symbol, + arguments: raw_arguments, + span, + }, + span, + )?; + if raw != destination { + let Some(ValueType::Ref(reference)) = self.value_type(destination) else { + return Err(vec![BackendError::invalid_ir( + "P9 runtime binding", + span, + "storage result recovery requires a reference", + )]); + }; + self.append_instruction( + block, + Instruction::RefCast { + destination, + value: raw, + reference, + span, + }, + span, + )?; + } + } else { + self.append_instruction( + block, + Instruction::CallVoid { + function: import.symbol, + arguments: raw_arguments, + span, + }, + span, + )?; + let instruction = if operation.abi().returns_normally { + Instruction::Constant { + destination, + value: 0, + span, + } + } else { + Instruction::Unreachable { destination, span } + }; + self.append_instruction(block, instruction, span)?; + } + Ok(()) + } +} diff --git a/crates/psrs-backend/src/mir/lower/wit_call.rs b/crates/psrs-backend/src/mir/lower/wit_call.rs index 562009f9..94a4ceec 100644 --- a/crates/psrs-backend/src/mir/lower/wit_call.rs +++ b/crates/psrs-backend/src/mir/lower/wit_call.rs @@ -35,6 +35,7 @@ impl FunctionLowerer<'_> { values: self.values.clone(), next_value: self.next_value, wit_imports: self.wit_imports, + runtime_imports: self.runtime_imports, layout: self.layout, conversion_helpers: self.conversion_helpers.as_deref_mut(), literals: self.literals.as_deref_mut(), diff --git a/crates/psrs-backend/src/mir/lower/wit_tests.rs b/crates/psrs-backend/src/mir/lower/wit_tests.rs index 22e67622..f18b6885 100644 --- a/crates/psrs-backend/src/mir/lower/wit_tests.rs +++ b/crates/psrs-backend/src/mir/lower/wit_tests.rs @@ -38,6 +38,7 @@ fn gc_wit_record_projection_uses_the_planned_product_type() { }], next_value: 1, wit_imports: &HashMap::new(), + runtime_imports: &HashMap::new(), layout: &layout, literals: None, }; diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index a544809b..4b360e0f 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -301,6 +301,7 @@ fn lower_module_after_binding_validation( function, FunctionId(id as u32), &wit_imports, + &runtime.imports, &layout, Some(&mut conversion_helpers), Some(&mut literals), @@ -320,6 +321,7 @@ fn lower_module_after_binding_validation( helper, FunctionId(first_helper_id + offset as u32), &wit_imports, + &runtime.imports, &layout, None, Some(&mut literals), diff --git a/crates/psrs-backend/src/mir/runtime/context.rs b/crates/psrs-backend/src/mir/runtime/context.rs index 3b518685..74bc598a 100644 --- a/crates/psrs-backend/src/mir/runtime/context.rs +++ b/crates/psrs-backend/src/mir/runtime/context.rs @@ -20,16 +20,12 @@ impl RuntimeContext { failure.to_string(), )] })?; - // A live source runtime binding needs the withdrawn State contract to - // map its operands. There is no generic replacement, so planning it is - // an explicit failure rather than a fabricated successful binding. + let mut imports = HashMap::new(); for binding in bindings { if live.direct_calls.contains(&binding.symbol) { - plan_import(binding, physical, layout)?; + imports.insert(binding.symbol, plan_import(binding, physical, layout)?); } } - Ok(Self { - imports: HashMap::new(), - }) + Ok(Self { imports }) } } diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index d7d69534..07d10658 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -31,6 +31,7 @@ mod number_trunc; mod operators; mod partial_application; mod primitive_foreign; +mod runtime_storage; mod scalars; mod semigroup; mod show; diff --git a/crates/psrs-driver/src/tests/runtime_storage.rs b/crates/psrs-driver/src/tests/runtime_storage.rs new file mode 100644 index 00000000..efc586d4 --- /dev/null +++ b/crates/psrs-driver/src/tests/runtime_storage.rs @@ -0,0 +1,125 @@ +use super::*; + +const IMPORTS: &str = r#" +foreign import "psrs:runtime-storage#array_fill" filled :: forall a. Int -> a -> Array a +foreign import "psrs:runtime-storage#array_read" read :: forall a. Array a -> Int -> a +foreign import "psrs:runtime-storage#array_write" write :: forall a. Array a -> Int -> a -> Unit +"#; + +#[test] +fn runtime_storage_preserves_aliases_and_recovers_payloads() { + let source = format!( + r#"module Main where +{IMPORTS} +main = + let + xs = filled 2 1 + alias = xs + put = write xs 1 + ignored = put 42 + texts = filled 1 "😀" + records = filled 1 {{ value: 42 }} + functions = filled 1 (\x -> intAdd x 2) + nested = filled 1 (filled 1 42) + in if booleanAnd (intEq (read alias 1) 42) + (booleanAnd (intEq (arrayLength (stringToBytes (read texts 0))) 4) + (booleanAnd (intEq (read records 0).value 42) + (booleanAnd (intEq ((read functions 0) 40) 42) + (intEq (read (read nested 0) 0) 42)))) then 42 else 1 +"# + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn runtime_storage_validates_unused_source_contracts() { + for (export, ty) in [ + ("array_fill", "Int -> Int -> Array Number"), + ("array_read", "forall a b. Array a -> Int -> b"), + ("array_write", "forall a. Array a -> Int -> a -> Int"), + ("array_write", "Array Int -> Int -> Number -> Unit"), + ("array_read", "forall a. Array a -> Number -> a"), + ("array_fill", "forall a. a -> Array a"), + ("array_read", "Array Boolean -> Int -> Int"), + ] { + let source = format!( + "module Main where\nforeign import \"psrs:runtime-storage#{export}\" op :: {ty}\nmain = 0\n" + ); + let errors = compile_program_sources(&[("Main.purs", &source)]) + .expect_err("invalid storage contract"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P8 runtime linking"), + "{export}: {errors:?}" + ); + } +} + +#[test] +fn runtime_storage_valid_unused_imports_do_not_link_a_provider() { + let source = format!("module Main where\n{IMPORTS}\nmain = 42\n"); + let unused = compile_program_sources(&[("Main.purs", &source)]).unwrap(); + assert!(!unused.wat.contains("array_fill"), "{}", unused.wat); + let source = format!("module Main where\n{IMPORTS}\nmain = read (filled 1 42) 0\n"); + let used = compile_program_sources(&[("Main.purs", &source)]).unwrap(); + assert!(used.wat.contains("array_fill"), "{}", used.wat); +} + +#[test] +fn runtime_storage_traps_on_invalid_ranges() { + for (body, trap) in [ + ("arrayLength (filled (intNeg 1) 0)", "unreachable"), + ("read (filled 1 0) 1", "out of bounds array access"), + ( + "let ignored = write (filled 1 0) 1 42 in 0", + "out of bounds array access", + ), + ] { + let source = format!("module Main where\n{IMPORTS}\nmain = {body}\n"); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert!(!output.status.success(), "{body}: {output:?}"); + assert!( + String::from_utf8_lossy(&output.stderr).contains(trap), + "{output:?}" + ); + } +} + +#[test] +fn runtime_storage_trap_has_no_normal_return() { + for ty in ["Int", "forall a. a"] { + let source = format!( + "module Main where\nforeign import \"psrs:runtime-storage#trap\" abort :: {ty}\nmain :: Int\nmain = abort\n" + ); + let Some(output) = run_program_with_wasmtime(&[("Main.purs", &source)]) else { + return; + }; + assert!(!output.status.success(), "{output:?}"); + assert!( + String::from_utf8_lossy(&output.stderr).contains("unreachable"), + "{output:?}" + ); + } +} + +#[test] +fn runtime_storage_monomorphic_operands_use_the_same_array() { + let source = r#"module Main where +foreign import "psrs:runtime-storage#array_fill" filled :: Int -> Int -> Array Int +foreign import "psrs:runtime-storage#array_read" read :: Array Int -> Int -> Int +foreign import "psrs:runtime-storage#array_write" write :: Array Int -> Int -> Int -> Unit +main = let xs = filled 1 0 + ignored = write xs 0 42 + in read xs 0 +"#; + let Some(output) = run_program_with_wasmtime(&[("Main.purs", source)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-runtime/src/abi/storage/mod.rs b/crates/psrs-runtime/src/abi/storage/mod.rs index 0c6f1024..affe6e24 100644 --- a/crates/psrs-runtime/src/abi/storage/mod.rs +++ b/crates/psrs-runtime/src/abi/storage/mod.rs @@ -1,5 +1,5 @@ //! GC storage ABI, separate from scalar/linear-memory artifact contracts. -//! State dependencies have no physical parameters or results in this ABI. +//! Operands and results describe only storage values, without execution tokens. mod projection; pub use projection::*; @@ -23,7 +23,7 @@ pub enum StorageOperation { Trap, } -/// Checked source-value relations before GC boxing and state projection. +/// Checked source-value relations before GC boxing and ABI conversion. /// Element occurrences in one binding must denote the same source type. #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub enum StorageValue { @@ -36,7 +36,7 @@ pub enum StorageValue { } pub struct StorageSourceContract { - /// Ordinary parameters before the final logical State parameter. + /// Complete source operands corresponding to the raw ABI parameters. pub parameters: &'static [StorageValue], pub payload: StorageValue, } @@ -58,7 +58,7 @@ impl StorageOperation { .find(|operation| operation.abi().export == export) } - /// State regions are generic and must agree between input and successor. + /// Source element occurrences must share the same checked type. pub const fn source_contract(self) -> StorageSourceContract { use StorageValue::*; match self { diff --git a/crates/psrs-runtime/src/abi/storage/projection.rs b/crates/psrs-runtime/src/abi/storage/projection.rs index ed126001..b1d3c04c 100644 --- a/crates/psrs-runtime/src/abi/storage/projection.rs +++ b/crates/psrs-runtime/src/abi/storage/projection.rs @@ -7,13 +7,13 @@ pub enum StorageResultProjection { Value(StorageType), /// The export returns normally without a value. The caller produces Unit. Unit, - /// The export cannot return normally; no successor or payload is produced. + /// The export cannot return normally; no result is produced. Never, } /// Validated correspondence between source operands and raw ABI operands. -/// This does not authorize erasure of a compiler's dependency graph or provide -/// boxing, reference validation, or instruction correspondence evidence. +/// Consumers still own checked element-type correspondence, boxing and recovery, +/// and mutable array identity. The raw ABI alone does not prove those facts. pub struct StorageCallProjection { source: StorageSourceContract, abi: StorageAbi, diff --git a/docs/design/backend/wasm/linking-and-runtime.md b/docs/design/backend/wasm/linking-and-runtime.md index 5add4fd7..e424011e 100644 --- a/docs/design/backend/wasm/linking-and-runtime.md +++ b/docs/design/backend/wasm/linking-and-runtime.md @@ -637,6 +637,30 @@ Guest execution evidence is recorded separately from the numeric runtime slice. ### Consumer signatures and implementation selection +Ordinary source imports can name the storage provider through +`foreign import "psrs:runtime-storage#"`. The runtime ABI owns the raw +export contract. Backend binding validation checks the checked Core declaration, +including unused imports: arity, `Int` indices and lengths, `Unit` write results, +and agreement of every array element and payload occurrence. The interface is +`Int -> a -> Array a` for fill, `Array a -> Int -> a` for read, +`Array a -> Int -> a -> Unit` for write, and a zero-operand arbitrary result +for the non-returning trap. These can be polymorphic or concrete signatures. + +CC uses its existing payload erasure and recovery operations for element +operands and results, including callable adapters. Source arrays already use +canonical erased-element storage and cross the import boundary with the same +identity; adapting a mutable array by copying its elements is forbidden. +MIR plans the physical import in the application's layout arena. It widens +element references to nullable `eqref` for raw calls, checks returned references +before recovering non-null source values, materializes source `Unit` after a +void write, and emits an unreachable result after a non-returning trap. +Provider selection still comes from the actual MIR import; unused declarations +are validated without adding a provider to the executable. Partial application +and higher-order uses follow the ordinary closure adapter path. + +This is a typed external-call ABI, with no State token, dependency chain or +read/write ordering analysis. It does not define an Effect/ST implementation. + The exhaustive [intrinsic implementation catalog](../fp/intrinsic-implementations.md) owns direct/generated/artifact selection. HIR owns language schemes and semantic effects; the runtime owns raw export contracts and transport protocols. CC keeps diff --git a/docs/implementation/backend/linking-and-runtime.md b/docs/implementation/backend/linking-and-runtime.md index b17e3b07..ca672263 100644 --- a/docs/implementation/backend/linking-and-runtime.md +++ b/docs/implementation/backend/linking-and-runtime.md @@ -332,3 +332,46 @@ Workspace tests and corpus scoreboards were not rerun for this bounded fix. Storage ABI comments now describe ordinary operands without a State protocol. Compiler-side generic storage bindings remain explicitly unsupported after withdrawal of State; this work does not restore them or implement Effect/ST. + +## Ordinary runtime storage bindings (2026-10-11) + +The subsequent storage-binding repair replaces the explicit unsupported +boundaries described above. `bindings/runtime/source.rs` checks ordinary Core +operand/result types before erasure, using Core's existing type-equivalence +relation. `bindings/runtime/call/` publishes canonical CC payload signatures; +the common CC conversion machinery supplies boxing and recovery. Array values +retain their canonical representation and identity. `target.rs` plans actual +raw imports in the application layout arena, and MIR lowering adapts reference +nullability and void/non-returning results. No State or dependency analysis was +reintroduced. Zero-operand external polymorphic values now obtain their source +scheme from the external type inventory through ordinary global lowering. + +Baseline inspection at `e806616e`: CC runtime signature conversion, CC binding +verification and MIR import planning unconditionally rejected storage bindings +with the withdrawn State-contract diagnostic. This was a code baseline, not an +independent before-build measurement. + +| Validation | Result | +| --- | --- | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib runtime_storage::` | 6 passed; generic/concrete calls, partial application, alias write, string/record/function/nested-array recovery, bounds traps, polymorphic and concrete trap values, unused declaration rejection and provider omission | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib runtime -- --nocapture` | 11 passed; includes malformed CC signatures, runtime metadata, physical provider checks, GC composition/execution and neighboring artifact protocols | +| `cargo clippy -p psrs-backend -p psrs-driver --all-targets -- -D warnings` | Passed | + +The broad erasure cohort cannot currently pass against this compiler and the +locked stdlib. Materializing the locked revision `1e01310` (whose content +reproduces fingerprint `fnv1a64-v1:bca0ace40bd0ccac`) and running +`PSRS_REQUIRE_WASMTIME=1 PSRS_STDLIB_ROOT= cargo test -p psrs-driver +--lib polymorphism_erasure_audit::` gives 9 passed, 12 failed. That set is +identical at HEAD `e806616e` and with this work, so the storage repair changes +none of it: 9 failures are the locked `Prelude`'s `foreign import +"psrs:effect#..."` declarations rejected at P8 WIT linking after the effect +mechanism was removed, and 3 are pre-existing `guest projection of a non-closed +type` closure-conversion cases. The committed lock is stale relative to the +effect removal, so comparable broad erasure evidence needs a matching +compiler/stdlib pair; neither the lock nor the development package was modified. + +Final `cargo fmt --all --check` and `git diff --check` passed. + +Workspace tests and corpus scoreboards were not run. Effect/ST and algebraic +handler drafts remain unimplemented; successful storage ABI calls do not +establish effect-library conformance. From 981c832a6538b3950ca9cdd5b5174d2fbb5d586a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 15:18:15 +0800 Subject: [PATCH 093/148] Document draft library-owned effects and native Effect/ST handlers Add draft design proposals for library-owned algebraic effects and for native Effect/ST implemented over those handlers, with their Unverified acceptance checklists. Index both drafts and record in F-02 that the former Effect Unit entry adaptation and lexical runEffect restriction were removed with the effect mechanism; their replacement remains a draft proposal. --- docs/design/backend/README.md | 2 + .../fp/algebraic-effects-and-handlers.md | 372 ++++++++++++++++ .../fp/native-effect-and-st-handlers.md | 401 ++++++++++++++++++ docs/feature/F-02-portable-programs.md | 41 +- .../backend/algebraic-effects.md | 39 ++ .../backend/native-effect-and-st.md | 36 ++ 6 files changed, 874 insertions(+), 17 deletions(-) create mode 100644 docs/design/backend/fp/algebraic-effects-and-handlers.md create mode 100644 docs/design/backend/fp/native-effect-and-st-handlers.md create mode 100644 docs/implementation/backend/algebraic-effects.md create mode 100644 docs/implementation/backend/native-effect-and-st.md diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index 43fa7b68..eac12dcd 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -54,6 +54,8 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [pattern-matching.md](fp/pattern-matching.md) | Pattern decision trees and exhaustiveness | cc-ir | | [control-flow-and-tail-calls.md](fp/control-flow-and-tail-calls.md) | CFG structuring, `Switch`, tail calls | mir | | [type-classes-and-dictionaries.md](fp/type-classes-and-dictionaries.md) | Dictionary passing and instance evidence | functional-core | +| [algebraic-effects-and-handlers.md](fp/algebraic-effects-and-handlers.md) | Library operation rows and handlers; continuation ownership and runtime control options (**Draft proposal**) | DEC-03, ordinary rows/classes, functional-core, runtime linking | +| [native-effect-and-st-handlers.md](fp/native-effect-and-st-handlers.md) | Official Effect/ST facades, common native computation, typed storage/host handlers, and region safety (**Draft proposal**) | algebraic effects, roles, rank-N, runtime linking | | [effects.md](fp/effects.md) | Effect representation and the platform boundary (**withdrawn 2026-10-11**; replacement undecided) | functional-core | | [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics and cross-pass dependencies (**withdrawn 2026-10-11**) | primitive types, functional-core, CC, MIR | | [library-owned-effects.md](fp/library-owned-effects.md) | Ordinary Effect/ST newtypes, runtime adapters, command runner (**withdrawn 2026-10-11**) | State primitives and dependency lowering, source fidelity | diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md new file mode 100644 index 00000000..54c16dad --- /dev/null +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -0,0 +1,372 @@ +# Library-Owned Algebraic Effects and Handlers + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) +**Status:** Draft proposal; no implementation or accepted native Effect replacement. +**Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), +[functional Core](../../frontend/semantics/functional-core.md), +[rows and records](../../frontend/type-system/rows-and-records.md), +[representation and evidence](representation-and-evidence.md), +[control flow](control-flow-and-tail-calls.md), and +[runtime linking](../wasm/linking-and-runtime.md). +**Summary:** Algebraic operations and their handlers are library values, checked +using ordinary PureScript types and rows. The compiler owns generic language +semantics and representation, not a State/IO protocol or operation dependency +graph. Explicit library continuations provide a portable semantic model; +runtime delimited continuations are a separately specified execution option, +not an assumed ability of an ordinary Wasm import. The separate +[native Effect/ST proposal](native-effect-and-st-handlers.md) specifies public +facades without changing this generic operation model. + +## Scope + +This topic owns the meaning of library-defined algebraic operations, handler +composition, row-based operation requirements, and continuation boundaries. +It specifies the division of responsibility between library, compiler, and +runtime and the conditions for adopting runtime control support. + +The following are separate decisions: official Effect/ST representation and +source adaptation (proposed in the native topic), a native effect type system, new surface syntax, resource +ownership types, async scheduling, and target stack switching. Designing +algebraic effects does not authorize rebuilding the withdrawn compiler-owned +Effect or State mechanisms. + +The proposal follows DEC-03's library encoding. A runtime option that requires +new compiler control primitives must be reviewed against DEC-03 before being +selected. This document does not silently amend that accepted decision. + +## Background + +An algebraic operation describes a request without choosing its interpretation. +A handler supplies that interpretation and decides how the remaining +computation proceeds. The same console operation can write to a terminal or +append to a test log; the same state operations can thread a pure value or use +mutable storage. + +A continuation represents the remainder of a computation. It can be explicit +data and functions in a library, or a suspended execution segment managed by +a control runtime. These representations have different implementation costs; +neither requires a compiler to know the meaning of a particular operation. + +PureScript already provides ADTs, functions, higher-kinded types, type classes, +rank-N polymorphism, ordinary rows, and monadic `do`. `purescript-run` encodes +extensible operations using `Free` and `VariantF`; its handlers are ordinary +interpreters. This establishes expressibility in the language, not acceptance +by this compiler or availability of a native IO implementation. + +An operation row is a library parameter, not a second effect system attached +to every function arrow. Its constraints describe which requests a computation +can expose. They do not prove single use, termination, absence of unsafe FFI, +or correct resource release. + +## Model + +### Computations and operation signatures + +Use the following schematic public model, matching the kind of `Run`: + +```purescript +Run :: Row (Type -> Type) -> Type -> Type + +data StateF s next + = Get (s -> next) + | Put s next + +data ConsoleF next + = Print String next +``` + +Each signature has a Functor instance. `Get` receives the operation result +before continuing; `Put` and `Print` have a unit result. Operations are lifted +into a row-indexed computation by library functions. Binding constructs the +remaining computation without performing requests. + +The semantic computation tree has `Return a` and `Request op continuation`. +This is a mathematical model, not a required runtime layout. An implementation +may use freer/Coyoneda representations and queued binds to avoid restrictive +Functor implementations and inefficient left-associated bind chains. + +### Handlers and residual rows + +These are schematic interfaces, not new compiler intrinsics: + +```purescript +get :: forall s r. Run (state :: StateF s | r) s +put :: forall s r. s -> Run (state :: StateF s | r) Unit + +handleState + :: forall s r a + . s + -> Run (state :: StateF s | r) a + -> Run r { state :: s, value :: a } + +runPure :: forall a. Run () a -> a +``` + +Row membership and removal use ordinary row relations and library evidence. +The actual API must preserve the upstream row constraints, including label +absence where needed; the schematic signatures do not authorize weakening +those constraints. State here is an ordinary value `s`, not a primitive token. + +A handler handles its selected slot and forwards every other request with a +continuation that re-enters the handler. This is deep-handler semantics: after +resumption, subsequent requests at the same slot are handled again. Distinct +instances use distinct labels; a duplicate-label or shadowing policy must be +explicit rather than relying on a silent row-map collapse. + +### Resumption and lifetime + +The portable model uses persistent explicit continuations. A handler may resume +zero, once, or multiple times when its API permits it. A pure state handler +supplies a state value to each branch; replaying a continuation does not roll +back mutations or external IO already performed by another branch. + +Single-use native resumptions require a distinct abstract API. Existing +PureScript arrows are unrestricted: hiding a constructor or adding a nominal +type parameter does not prevent callers from invoking a value twice. A native +one-shot implementation must check consumption at runtime unless a separate +static usage discipline has been adopted. + +## Design + +### Ownership + +| Owner | Responsibility | +| --- | --- | +| Type system | Ordinary kinds, rows, class evidence, quantifiers, roles, constructor visibility, and applicable region constraints | +| Library | Operation signatures, computation construction, handler interpretation, residual operation rows, continuation composition, and policies | +| Compiler | Strict evaluation, ordinary closures/ADTs/dictionaries, generic calls and ABI checks, and sound optimization/control lowering | +| Runtime | Real IO/storage primitives; if separately adopted, delimited control and native resumption lifetime checks | +| Target profile | Explicitly adopted Wasm features and rejection of unavailable capabilities | + +No pass discovers an operation by the spelling `State`, `Console`, `Run`, or +`Effect`. No pass interprets handler source to infer a hidden protocol. No +operation graph, frozen source inventory, or cross-pass State witness is +required. Generic type, representation, and CFG verification remain required. + +The compiler preserves observable calls and traps even when their results are +unused. The library cannot make an optimizer sound by providing a handler: +generic call semantics and conservative effect summaries remain compiler +responsibilities. Inlining and specialization must work for these values under +the same contracts as other ordinary higher-order programs. + +### Portable execution + +The default proposal under DEC-03 is an ordinary library interpreter over +explicit continuations, with stack-safe library machinery. This is not a +decision to represent native Effect as `Unit -> a`. Pure handlers need no native +control runtime. Host-facing handlers eventually invoke checked foreign/runtime +operations; this topic does not select the currently missing native Effect ABI. + +Reuse upstream `purescript-run`/`purescript-free` semantics and sources where +appropriate rather than making a compiler-known replacement monad. Audit their +actual FFI and representation needs before claiming target compatibility. +Performance needs a measured implementation: a naive tree interpreter or +recursive bind evaluator is not sufficient stack-safety evidence. + +### Runtime delimited continuation option + +Delimited control limits capture to a particular execution boundary. A handler +can suspend a computation at a request, examine its payload, and resume it with +an operation result. This can support efficient direct execution without +materializing every intermediate computation tree, but is not free stack access. + +Two valid runtime architectures are candidates: + +1. A compiler-generated continuation representation (CPS or resumable frames) + whose frames are managed by a runtime scheduler. +2. A separately enabled target continuation/stack-switching facility, with + compiler lowering and validation for that facility. + +A normal imported Rust/Wasm function cannot capture the caller's Wasm execution +stack. Rust's private linear-memory stack is not that execution stack; moving +its stack pointer or saving registers is not a valid continuation implementation. + +Any native option must define all of the following before implementation: + +- A typed boundary answer, request payload/result relation, and abstract + resumption. Runtime dispatch uses checked identity/evidence; it must not cast + an arbitrary label and payload into an unrelated result type. +- Deep versus shallow resumption and the placement of the handler delimiter. + Handler clauses execute outside the handled delimiter unless explicitly + re-entered, so their own requests are forwarded or handled by an outer scope. +- A one-shot or multi-shot API. One-shot consumption is checked before transfer; + multi-shot support needs an explicit frame/stack cloning contract and cannot + be implemented by bypassing a one-shot guard. +- Boundary lifetime, captured GC roots, cancellation, abandonment, and return + to the handler. Suspended continuations cannot retain borrowed canonical ABI + buffers or invalid host-resource references. +- Foreign-call boundaries. Capture across a non-suspendable host/import frame + is rejected unless that boundary has an explicit suspension protocol. +- Representation of the resumable computation in existing PureScript types. + Raw capture primitives must not inhabit an unrestricted pure function type + while changing its control behavior. An abstract computation API or another + justified typed boundary is required. + +Conceptually, a one-shot continuation has `Pending`, `Running`, `Consumed`, or +`Cancelled` status. The transfer from `Pending` must atomically consume the +resumption with respect to re-entrancy; failure does not silently permit a +second transfer. The status belongs to a runtime object, not a compiler State +token analysis. Return, cancellation, and non-resuming clauses release captured +storage under the selected lifetime contract. + +No new control intrinsic, Rust feature, Wasm proposal, or opaque public type is +selected by this draft. DEC-03 and target capability decisions must explicitly +authorize a native option. Runtime one-shot and portable multi-shot behavior +must have distinguishable APIs; an optimization cannot silently change one +into the other. + +### Rejected shortcuts + +- Attaching effect requirements to all function arrows without a language/type + system decision. +- Reconstructing handler behavior in Core, CC, or MIR to recover an implicit + State protocol. +- Calling a generic runtime import a stack-capture primitive without a valid + target or compiler-generated continuation representation. +- Treating a row requirement as linearity or resource-lifetime evidence. +- Replacing native Effect/ST or public foreign APIs merely to get an algebraic + effects example to compile. + +## Algorithms + +### Interpretation and forwarding + +For a pure State handler carrying value `s`: + +```text +handle(s, Return(a)) = Return({ state: s, value: a }) +handle(s, Get(k)) = handle(s, k(s)) +handle(s, Put(s', next)) = handle(s', next) +handle(s, Other(op, k)) = Request(op, x -> handle(s, k(x))) +``` + +Actual evaluation uses an explicit stack-safe work loop or upstream trampoline +machinery. The final rule preserves the captured state while the outer handler +interprets another operation. Re-entering the State handler ensures deep +semantics. It does not statically inspect the future continuation. + +Type checking is ordinary application checking: operation lifting proves row +membership; handler application produces the residual row; `runPure` accepts +only the closed empty row. Any residual request is a type mismatch at that +boundary, assuming safe construction and the library's declared contracts. + +### Native control, if selected + +Establish a typed delimiter, suspend the continuation at a request, transfer +to the appropriate handler clause, and consume/resume the continuation under +the native API. GC roots and delimiter state are retained until resumption or +cancellation completes. These are generic runtime/control operations; no +operation-specific analysis is performed during compilation. + +## Code map + +This is the proposed owner map, not a claim that these APIs are implemented: + +| Location | Intended responsibility | +| --- | --- | +| Independent `psrs-stdlib` package | Upstream computation libraries, ordinary operation modules, handlers, source audit, and conformance fixtures | +| Existing kind/row/class/rank-N owners | Check library source using standard PureScript rules; repair shared deficiencies without effect-specific solvers | +| Existing Core/CC/MIR lowering and optimizers | Compile library code as ordinary higher-order code and preserve generic observable-call semantics | +| `psrs-runtime` ABI/catalog/executable owners | Small native IO/storage contracts and implementations, independent of operation-row or library identities | +| Runtime control owner, only if separately adopted | Delimiter/resumption ABI, captured-root storage, lifecycle checks, and capability requirements | + +No new compiler crate, handler IR, State graph directory, or compiler-side +operation registry is required for the portable model. Runtime control module +names and entry-point signatures remain unselected until the native contract +above is complete. + +## Invariants and verification + +- Library computations are inert until interpreted, while ordinary strict + arguments are evaluated according to PureScript semantics. +- Operation results match their checked signature. Safe row dispatch cannot + exchange unrelated payload/result types. +- A handler removes exactly its advertised operation requirement and preserves + residual requests and the appropriate continuation. +- The pure boundary requires a closed empty operation row. This is not a proof + about unsafe coercions or arbitrary FFI hidden in user code. +- Closure conversion, adapters, and optimizations preserve evaluation behavior + under ordinary IR contracts; they do not verify a private effect protocol. +- Aborting/resuming/replaying a continuation follows the chosen API. Native + one-shot reuse is rejected; multi-shot execution does not imply IO rollback. +- Resource safety is a separate contract. A bare handler does not prove + release-on-trap or prevent use-after-release. + +Evidence must separately cover type rejection, pure interpretation, generic +representation, observable runtime behavior, and any native control capability. +The [acceptance checklist](../../../implementation/backend/algebraic-effects.md) +records proposed requirements; none are verified by this document. + +## Worked example + +The following is schematic library code using the signatures above: + +```purescript +program :: Run (state :: StateF Int) Int +program = do + put 41 + value <- get + pure (value + 1) + +result :: { state :: Int, value :: Int } +result = runPure (handleState 0 program) +``` + +Constructing `program` does not allocate a mutable cell or execute native IO. +Interpretation changes the handler's ordinary state value to 41, supplies 41 +to the continuation of `get`, and returns `{ state: 41, value: 42 }`. +The compiler sees constructors, functions, and calls; there is no State token +to project, no write/read dependency graph, and no operation-specific witness. + +Adding a Console slot leaves that slot in the residual row after `handleState`. +A pure log-collecting handler can remove it for testing. A host-writing handler +needs an explicit native IO boundary, proposed in +[native Effect/ST](native-effect-and-st-handlers.md); `runPure` cannot be used +as that boundary. + +## Boundaries and interfaces + +Source syntax, type arrows, and standard row rules remain unchanged. Library +type parameters express operation requirements. The compiler neither adds +ambient effect inference nor recognizes the `Run` constructor specially. + +Native services remain explicit checked bindings with ordinary value/ABI +contracts. Command execution uses an ordinary configured runner where supported, +without discovery of `Effect Unit` or hidden interpretation of operation rows. +This topic does not reopen the deleted legacy runner path. + +The baseline target profile does not gain stack switching through this design. +Native resumption support requires a pinned target capability, MIR/lowering +contract, validator coverage, and actual execution evidence. An unsupported +capability is an error, never a silent change to continuation semantics. + +## Open questions and future work + +1. Confirm whether explicit library continuations are the execution design or + whether runtime delimited control is required. The library baseline follows + DEC-03; the native alternative needs a separate reviewed decision. +2. Audit the pinned upstream Run/Free/Variant packages, their FFI, and this + compiler's generic representation support. No compile/runtime acceptance + has been measured for this proposal. +3. Validate the separate [native Effect/ST proposal](native-effect-and-st-handlers.md). + Its current package consumers remain unsupported after compiler cleanup. +4. If adopting native control, settle answer typing, one-/multi-shot semantics, + capture boundaries, and GC/lifetime contracts before choosing primitives. +5. Scoped/higher-order effects, bracket/finalization, async, and concurrency need + their own semantics. Ordinary first-order operation rows do not provide + those guarantees automatically. + +## References + +- [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md) and + [compiler cleanup handoff](../../../implementation/backend/effect-state-removal-handoff-2026-10-11.md). +- [PureScript Run](https://github.com/natefaubion/purescript-run) and its + [API](https://pursuit.purescript.org/packages/purescript-run/5.0.0/docs/Run). +- [PureScript Free](https://github.com/purescript/purescript-free) and + [Stack Safety for Free](https://functorial.com/stack-safety-for-free/index.pdf). +- [Continuing WebAssembly with Effect Handlers](https://arxiv.org/abs/2308.08347), + a proposal-level reference, not evidence of this target profile's support. + +External references were consulted earlier in this conversation. A fresh +online verification attempt on 2026-10-11 failed due to connection errors; +current upstream APIs and target support must be verified before implementation. diff --git a/docs/design/backend/fp/native-effect-and-st-handlers.md b/docs/design/backend/fp/native-effect-and-st-handlers.md new file mode 100644 index 00000000..6e30bcb2 --- /dev/null +++ b/docs/design/backend/fp/native-effect-and-st-handlers.md @@ -0,0 +1,401 @@ +# Native Effect and ST over Algebraic Handlers + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) +**Status:** Draft proposal; representation selected in this proposal, not implemented or accepted. +**Prerequisites:** [algebraic effects and handlers](algebraic-effects-and-handlers.md), +[DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), +[roles and coercions](../../frontend/type-system/prim.md), +[polymorphism and erasure](polymorphism-and-erasure.md), and +[runtime linking](../wasm/linking-and-runtime.md). +**Summary:** Effect and ST are constructor-hidden library newtypes over the same +ordinary algebraic computation representation. A library native handler executes +typed storage and host requests using existing generic primitives and bindings. +ST safety follows from its rank-N runner, nominal region roles, and restricted +safe constructors, not compiler State analysis. The common representation +preserves the official ST.Global-to-Effect conversion contract. + +## Scope + +This topic proposes the native Effect/ST implementation beneath the official +public signatures, exports, instances, roles, and ordinary pure definitions. +It includes Effect.Ref, STRef, mutable-array boundaries, native execution, and +the bridge from user-defined algebraic effects to native operations. + +It does not add syntax, ambient effect inference, primitive State types, a +special compiler-known Effect constructor, or a new execution intrinsic. +Runtime delimited continuation support remains a separate option in the +algebraic-effects topic; it is not required by this representation proposal. +Compiler cleanup remains in force. This design is not authorization to change +the independent package, publish a lock, or claim restored runtime support. + +## Background + +The official libraries distinguish unrestricted native IO (`Effect`) from +region-restricted mutation (`ST`). `ST.run` has the rank-N signature +`forall a. (forall r. ST r a) -> a`. ST and STRef have nominal region roles. +`ST.Global.toEffect :: ST Global ~> Effect` is implemented with `unsafeCoerce` +in official source, relying on compatible native representations. + +The withdrawn compiler protocols and the development package's current State +declarations cannot provide the foundation for this implementation. Existing +ArrayFill, ArrayIndex, ArrayWrite, ArrayLength, and WIT/WASI binding facilities +provide useful leaf operations. Their existence does not establish a complete +native handler or a safe ST API. + +General algebraic operation rows express composable requests. The official +`Effect a` and `ST r a` APIs do not expose such a row. Their implementation can +seal a native request vocabulary and retain their original public types. + +## Model + +### Common computation representation + +The private target library supplies this schematic representation: + +```purescript +type NativeProgram a = Run (native :: NativeF) a + +newtype Effect a = Effect (NativeProgram a) +type role Effect representational + +newtype ST :: Region -> Type -> Type +newtype ST r a = ST (NativeProgram a) +type role ST nominal representational + +newtype Ref a = Ref (Cell a) +type role Ref representational + +newtype STRef :: Region -> Type -> Type +newtype STRef r a = STRef (Cell a) +type role STRef nominal representational +``` + +`r` retains the official Region kind. Region and Global remain library marker +declarations; the compiler gives them ordinary declaration identity and role +checking, not a State protocol. NativeProgram does not import ST's Region kind, +which avoids a cycle between the representation owner and ST.Internal. + +Both wrappers have exactly the same declared field type for the same `a`. +No distinct operation-row layout or region-specialized representation is +hidden behind the official Global conversion. Newtype lowering remains generic. +The chosen computation representation must support the official representational +result role. If its inferred roles do not, fix the library representation or +record the design blocker; do not force an invalid role annotation. + +Effect/ST constructors remain hidden. No public Newtype instance or coercion +witness exposes their NativeProgram fields. In particular, do not export +`NativeProgram a -> ST r a`: it would allow host requests to enter safe ST. +Internal construction helpers belong to their owning library implementation; +any unavoidable exposed unsafe adapter must be identified as unsafe and audited. + +### Native requests + +```purescript +data NativeF next + = Storage (StorageF next) + | Host (HostF next) + | Abort +``` + +StorageF represents allocation, read, and write requests. HostF is the library's +composition of typed operation families for the selected WIT services. Abort +has no continuation and cannot return normally. Functor mapping changes only +the continuation, never performs an operation. + +NativeF is a shared private vocabulary, not a compiler operation registry. +Safe ST constructors expose only storage requests; safe Effect constructors +may expose storage and host requests. This restriction is established by the +library implementation and its export/coercion boundary, not a phantom region +alone. The fixed internal native row is not a claim that a row solver proves +all ST requests are storage-only. + +### Heterogeneous storage requests + +One program may allocate an Int cell and a String cell. Plain PureScript ADTs +must not be written as if they supplied GADT existential constructors. Use a +rank-N eliminator or an equivalent established library encoding. For example: + +```purescript +newtype StorageF next = StorageF + (forall z. + { new :: forall a. a -> (Cell a -> next) -> z + , read :: forall a. Cell a -> (a -> next) -> z + , write :: forall a. Cell a -> a -> next -> z + } -> z) +``` + +This sketch preserves the relationship between a cell's element type, the +operand, and the continuation result at each request. A smart constructor +selects a method with one checked `a`; an interpreter method accepts every `a`. +Host families similarly preserve each operation's checked payload/result type. +Do not encode requests as integer tags plus untyped values or use unsafeCoerce +to recover arbitrary payload types. + +The interpreter's generic leaf calls still require ordinary checked boxing, +unboxing, and ABI adaptation. Those are representation responsibilities, not +native request interpretation by the compiler. + +## Design + +### Construction, composition, and execution + +`pure` constructs a return node. `map`, `apply`, and `bind` use ordinary +computation-library operations. Building an action does not allocate a native +cell, call WASI, or execute a callback belonging to a future request. Strict +factory arguments retain normal PureScript evaluation behavior. + +The native interpreter selects a library request clause, performs the leaf +operation, and continues exactly once with its result. It does not expose +multi-shot native resumptions through the Effect/ST APIs. The stored program +is reusable: running it twice executes it twice and performs fresh allocations +for allocation requests on each run. References captured before either run +retain their identity and mutations, as in the official native semantics. + +The private execution boundary has schematic type +`executeNative :: forall a. NativeProgram a -> a`. Its body is an ordinary +library interpreter invoking observable primitives, not a pure `Run ()` +eliminator or a compiler intrinsic. This function is an unsafe native boundary; +it must not be advertised as a generally pure handler or exposed as an +unrestricted safe runner. + +`Effect.Unsafe.unsafePerformEffect` unwraps Effect in its owning implementation +and invokes this boundary. Its public type and unsafe status remain official. +`PSRS.Command.run :: Effect Unit -> Int` invokes it once and returns zero on +normal completion. A trap propagates. The compiler uses the configured ordinary +runner and never identifies `Effect Unit` specially. + +ST.run uses the same execution machinery behind its rank-N boundary. Its +observable purity relies on the safe API permitting only isolated mutation; +unsafe coercions, arbitrary unsafe FFI, and explicitly unsafe array operations +are outside that guarantee. Generic optimizer treatment of the interpreter's +observable calls remains conservative; no new purity annotation is justified. + +### ST region safety + +Preserve the exact signature `run :: forall a. (forall r. ST r a) -> a` and +nominal roles on ST, STRef, and STArray region parameters. A result containing +an externally usable region-specific reference or action cannot satisfy a +region-independent `a` through safe construction. The type checker owns +skolem scope, quantifier checking, and Coercible visibility in the ordinary way. + +The handler needs no runtime region token and no scan of captured references. +Its objects reside in the GC language heap. Rank-N isolation does not imply +deterministic arena reclamation: unreachable cells are collected by GC. +Nested ST runs receive independent type scopes through normal checking. + +Constructor hiding, region roles, rank-N checking, and trusted library bodies +are all necessary. A phantom `r` by itself proves neither isolation nor +storage-only behavior. Negative source cases must test cross-region use, +reference/action escape, region coercion, and attempts to inject host programs. + +### Global conversion + +Preserve the official `ST.Global.toEffect = unsafeCoerce` implementation only +after source-field and executed-behavior evidence establishes common NativeProgram +representation. A converted action is interpreted by the native handler, +which already handles storage requests. Global references can survive and be +used by subsequent converted actions in Effect. + +Do not reconstruct this conversion by a compiler-recognized region name, a +State/RealWorld cast, or a distinct row reinterpretation. Generic representation +code must preserve the common field contract; adapter failures are generic +compiler defects, not reasons to add a Global special case. + +### Leaf operations and cells + +| Native request | Existing capability | Library behavior | +| --- | --- | --- | +| New cell | ArrayFill | Allocate a fresh one-slot cell at interpretation time | +| Read cell | ArrayIndex | Read the current slot with the checked element type | +| Write cell | ArrayWrite | Mutate the same slot; discard the returned array as appropriate | +| Array length | ArrayLength | Inspect backing storage without changing public mutable-array contracts | +| Host operation | Typed WIT/WASI foreign binding | Call the selected import with its ordinary checked parameters/result | +| Abort | Existing non-returning trap support | Stop interpretation; produce no fabricated result or successor | + +The independent GC storage provider may implement equivalent checked leaf +operations where its generic external-binding contract is available. Do not +require both routes or retain State-shaped source signatures. Audit the +existing provider ABI's historical State comments and contracts before reuse; +physical exports alone do not prove a valid generic source binding. + +One cell must retain its physical identity across all polymorphic reads and +writes. An erased-array adaptation that copies the array on write is invalid. +Generic optimizer rules must treat reads from mutable backing storage and +in-place writes correctly; a trapping-read annotation alone is not a proof +against caching or reordering a read across a write. These are ordinary memory +and call contracts, not a request for a new State dependency analysis. + +Cell can use `Array (Maybe a)` privately. Initialized allocation publishes +`Just value`; Effect.Ref.newWithSelf first allocates Nothing, calls its callback +exactly once with that cell, then publishes the callback result. Reading an +unpublished cell traps under the existing target adaptation. This is a stated +Wasm representation boundary, not fabricated initialization and not a claim +that JavaScript's transient null value is observationally identical. + +Effect.Ref.write returns Unit; ST.write returns the supplied value. modify' +reads once, invokes the source callback once, writes its state result, and +returns its value result. It is not a concurrency/atomicity primitive. Preserve +re-entrant behavior where an explicitly unsafe callback performs other effects. + +### Mutable arrays and official source fidelity + +Retain official loop, traversal, callback, and MonadRec definitions. Provide +ordinary target adapters for native foreign slots rather than whole-function +intrinsics. Safe thaw/freeze must satisfy their copy/isolation contracts; +unsafe thaw/freeze may share only according to their explicit unsafe contract. +Arrays reachable outside a safe ST run must not be mutated through a supposed +safe thaw. Backing storage growth and replacement belong to library algorithms +and sufficiently small checked primitives, with real identity behavior tested. + +ArrayFill/ArrayWrite are not evidence that every STArray operation is already +implementable. Missing resize, storage transport, or generic callback support +must remain explicit until a focused case establishes the owning gap. + +Public Effect and ST signatures, roles, instances, modules, and exports remain +official. Replacing foreign data declarations with constructor-hidden newtypes +and replacing native foreign bodies is a target representation adaptation +requiring an independent package audit and runtime evidence. Do not rewrite +official pure functions or remove declarations to accommodate compiler gaps. + +### User-defined algebraic effects + +Public user computations may use an extensible Run row. A library interpreter +can handle a Console or application-specific operation into Effect; other +handlers may remain pure. Interpretation into Effect constructs a native +program and does not execute it prematurely. + +The native row remains private and fixed for the official facade. Arbitrary +user handlers and multi-shot continuations are not accepted as an ST isolation +proof or silently installed as the native runner. Public algebraic APIs and +the opaque official native APIs have distinct construction boundaries. + +## Algorithms + +```text +native(Return(a)): + finish with a +native(Storage(New(value, k))): + cell = allocate_and_publish(value) + continue k(cell) +native(Storage(Read(cell, k))): + value = checked_read(cell) + continue k(value) +native(Storage(Write(cell, value, next))): + checked_in_place_write(cell, value) + continue next +native(Host(request, k)): + result = checked_foreign_call(request) + continue k(result) +native(Abort): + trap +``` + +This is semantic pseudocode. The implementation uses the established +stack-safe computation machinery, not recursive evaluation of a naive bind +tree. Host request typing and storage rank-N elimination determine checked +calls; no erased tag-to-type recovery occurs in the interpreter. + +Generic tail calls, adapters, and optimization must preserve this behavior. +Interpreter stack safety must be tested with long mixed request/bind sequences, +not just with a tail-recursive pure counter. + +## Code map + +| Owner | Intended contents | +| --- | --- | +| Independent package's private native module(s) | Shared NativeProgram, typed request encodings, leaf bindings, and native interpreter | +| Effect owning module and unsafe adapter | Hidden wrapper, ordinary combinators, safe native constructors, and unsafe execution bridge | +| ST.Internal owning module | Hidden wrapper, nominal region facade, source foreign-slot bodies, and rank-N run | +| Effect.Ref and ST.Ref adapters | Typed Cell wrappers and official return/callback behavior | +| ST.Global | Official Global marker and representation-compatible conversion | +| Existing mutable-array target adapters | Official array API algorithms and small storage calls | +| PSRS.Command | Ordinary explicitly configured command runner | +| Existing compiler and runtime owners | Generic representation, observable primitive semantics, ABI validation, and actual leaf implementations | + +Module names are an implementation choice; do not create a compiler native +operation enum or new crate. Import dependencies must remain acyclic. Helpers +must not expose a safe arbitrary-program-to-ST conversion. Constructor scope +and imports are checked explicitly before choosing module boundaries. + +## Invariants and verification + +1. Effect and ST of the same result type have the same NativeProgram field and + the official Global conversion works without protocol-specific lowering. +2. Construction is inert; one native interpretation performs each encountered + request once, in program order. Repeated interpretation repeats operations. +3. Every storage request retains its element/operand/result relationship + through polymorphism, boxing, and callback invocation. +4. Safe ST construction permits isolated storage, with nominal region roles, + hidden constructors, and rank-N run preserving ordinary scope rules. +5. No uninitialized value, missing binding, invalid adapter, or host failure is + replaced with a successful-looking value. +6. Native execution uses generic observable-call contracts. No compiler pass + recognizes native operation families or reconstructs their chain. +7. Source fidelity, compile acceptance, and executed behavior are independently + measured. This proposal establishes none of those measurements. + +The [acceptance checklist](../../../implementation/backend/native-effect-and-st.md) +names required evidence, including real public API and unsafe-boundary tests. + +## Worked example + +```purescript +answer :: Int +answer = ST.run do + ref <- STRef.new 0 + _ <- STRef.write 41 ref + value <- STRef.read ref + pure (value + 1) +``` + +The library builds New, Write, and Read requests. ST.run interprets them under +the region-independent result type. The handler allocates one cell, mutates it +to 41, supplies 41 to the read continuation, and returns 42. The compiler sees +ordinary request values, closures, and intrinsic calls; it sees no region token. + +A Global variant converted with toEffect uses the same program and interpreter. +Effect.Ref.new likewise allocates at execution time, so repeated runs of one +allocation action produce independent cells. A previously captured Ref remains +the same cell across repeated reads/writes. + +## Boundaries and interfaces + +The public facade types remain official. Private native request rows are not +added to function arrows or inferred as ambient effects. Existing Coercible, +rank-N, kind, and generic representation rules apply unchanged. + +Leaf storage uses the GC language heap. Host calls retain WIT resource and +canonical ABI ownership rules. A trap is not automatic finalization; resource +bracketing, exceptions, and cancellation need their own explicit contracts. + +This proposal neither requires runtime delimited control nor prohibits a +future implementation that preserves its native API and multiplicity. A native +continuation implementation must meet the separate control obligations before +replacing explicit library continuations. + +## Open questions and future work + +- Prototype rank-N heterogeneous request transport and the common Global + representation before migrating public modules. Any compiler fixes must + also work for unrelated rank-N ADTs/records and generic closures. +- Audit the full public Effect/ST/Ref/uncurried/array API and exact target + adapters. The current State-dependent package is not an implementation of + this proposal, and the normal compiler lock must not move prematurely. +- Measure interpreter allocation and deep execution. Select an established + stack-safe representation without special optimizer exemptions. +- Confirm trap lowering and the remaining generic external storage binding + contracts. Do not rely on historical State projection declarations. + +## References + +- [Algebraic effects and handlers](algebraic-effects-and-handlers.md), + [source fidelity](../../../workflow/stdlib-vendoring.md), and + [conformance workflow](../../../workflow/stdlib-conformance.md). +- [Official ST.Internal](https://github.com/purescript/purescript-st/blob/master/src/Control/Monad/ST/Internal.purs) + and [ST.Global](https://github.com/purescript/purescript-st/blob/master/src/Control/Monad/ST/Global.purs). +- [Official Effect](https://github.com/purescript/purescript-effect) and + [Effect.Ref](https://github.com/purescript/purescript-refs). + +The pinned local upstream ST and Ref source and JavaScript bodies were inspected +on 2026-10-11. They establish the referenced API/behavior contracts, not target +acceptance of this proposed implementation. diff --git a/docs/feature/F-02-portable-programs.md b/docs/feature/F-02-portable-programs.md index aa9ce7d6..2280a43b 100644 --- a/docs/feature/F-02-portable-programs.md +++ b/docs/feature/F-02-portable-programs.md @@ -2,7 +2,9 @@ **Status:** In progress **Design:** [wasm encoding — Wasm Lowering](../design/backend/wasm/encoding-and-structuring.md), -[linking and runtime (Draft)](../design/backend/wasm/linking-and-runtime.md) +[linking and runtime (Draft)](../design/backend/wasm/linking-and-runtime.md), +[algebraic effects and handlers (Draft proposal)](../design/backend/fp/algebraic-effects-and-handlers.md), +[native Effect/ST handlers (Draft proposal)](../design/backend/fp/native-effect-and-st-handlers.md) ## User need @@ -11,6 +13,13 @@ compatible portable environment. ## User-visible behavior +A proposed library-level algebraic effects API would let programs describe +operations and supply different handlers for production and testing, using +existing PureScript syntax and types. A separate draft proposes implementing +the official Effect/ST APIs over library native handlers while preserving +their public contracts. Neither proposal is an implemented capability or an +accepted native representation. + The intended workflow is: ```sh @@ -48,17 +57,16 @@ See [Explicit Component Linking](../workflow/component-linking.md) for the manifest format and supported boundary. The compiler selects `Main.main` when that declaration exists; otherwise it -requires exactly one top-level declaration named `main`. The selected entry -takes no arguments and may return `Int` or `Effect Unit`. An integer result -continues to determine the process exit code. For `Effect Unit`, the compiler -runs the returned action once; normal completion exits with code 0, and a guest -trap propagates as a failure. - -A direct reference to the provided `runEffect` operation may appear only in the -selected entry declaration. This is a lexical source restriction: the entry may -pass the runner to a helper, and that helper may call it. An `Effect` value is -opaque to source code, and constructing the value itself does not run its -deferred operation. +requires exactly one top-level declaration named `main`. A direct entry returns +`Int`, which determines the process exit code. A package may explicitly configure +an ordinary runner to adapt its source entry to that integer command boundary. +The runner's implementation determines execution behavior; the compiler does +not discover an Effect type or synthesize its operations. + +The former `Effect Unit` entry adaptation and lexical `runEffect` restriction +were removed on 2026-10-11. Their replacement remains a draft proposal. Earlier platform +coverage below does not establish current execution of package sources that +depend on the withdrawn Effect or State mechanisms. The compiler emits a WASI 0.2 Component Model artifact. The legacy WASI Preview 1 module ABI is not part of the supported output contract. @@ -107,8 +115,8 @@ and closed concrete record patterns with variable, wildcard, and nested constructor or record field bindings, function values including scalar-capturing closures, higher-order calls, and the implemented effect-based WASI console and clock libraries plus random imports. -The selected source entry must take no arguments and return `Int` or -`Effect Unit`. Generic direct calls and annotated rank-N values are lowered, +The command boundary returns `Int`, directly or through an explicitly configured +ordinary runner. Generic direct calls and annotated rank-N values are lowered, including quantified parameters, record and constructor fields, captures, and returned functions. Each use can instantiate a quantified value independently; nested constraints are supplied @@ -162,9 +170,8 @@ function calls. requested output path. - The compiler prints WAT or writes it at the requested output path. - The WASI artifact runs in a compatible runtime and preserves observable - behavior. An `Int` entry preserves its exit code; an `Effect Unit` entry - executes once, exits with code 0 after normal completion, and propagates a - trap. + behavior. An `Int` entry preserves its exit code; a configured ordinary runner + preserves its declared behavior, and guest traps propagate as failures. - Unsupported constructs fail with a source-oriented diagnostic. - Each added platform service has documented behavior and executable tests. - Explicit guest linking verifies artifact pins and interface compatibility, diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md new file mode 100644 index 00000000..51c19403 --- /dev/null +++ b/docs/implementation/backend/algebraic-effects.md @@ -0,0 +1,39 @@ +# Algebraic Effects: Proposed Acceptance Checklist + +**Status:** Design only; all requirements below are Unverified. +**Design:** [Library-owned algebraic effects and handlers](../../design/backend/fp/algebraic-effects-and-handlers.md). +**Date:** 2026-10-11. + +This checklist records evidence required for a future implementation. Creating +it does not resume the withdrawn State migration, select native Effect/ST +representation, or authorize native continuation primitives. Compiler cleanup +and runtime build-tool changes are separate work. + +| ID | Requirement | Required evidence | Status | +| --- | --- | --- | --- | +| AE-01 | Existing PureScript syntax and type system express computation rows and handlers | Pinned upstream source; official `purs` accept/reject comparison on positive and negative library cases | Unverified | +| AE-02 | Handler removes its slot and preserves the residual row | Missing operation, wrong result type, residual row at pure boundary, and wrong-kind rejection cases | Unverified | +| AE-03 | Compiler does not recognize concrete effect/library identities | Code review and equivalent behavior for renamed ordinary operation modules; no State/Effect protocol hooks | Unverified | +| AE-04 | Construction is inert and interpretation preserves strict argument behavior | Operation count/order, strict factory arguments, ignored operation results, and repeat interpretation observations | Unverified | +| AE-05 | Pure State interpretation has correct value threading | Write/read result 42, nested handlers, independent labelled instances, and forwarded requests | Unverified | +| AE-06 | Deep handlers forward and resume correctly | Nested handler order, handled requests after resumption, and outer handling of clause requests | Unverified | +| AE-07 | Generic representation composes with handlers | Captures, rank-N interpreter arguments, polymorphic ADT/record fields, higher-order calls, and signature adapters | Unverified | +| AE-08 | Deep interpretation is stack safe | Actual Wasmtime execution of long bind chains, nested requests, and loops; compare observable results with pinned upstream oracle | Unverified | +| AE-09 | Generic optimization preserves observable behavior | Mandatory execution with ignored results, traps, callbacks, and pure newtype controls; no effect-specific optimizer exemptions | Unverified | +| AE-10 | Source fidelity is preserved | Independent package audit with pinned revisions; every target adaptation has a concrete representation reason | Unverified | +| AE-11 | Host interpretation uses a defined native IO boundary | Separate selected ABI design and actual host behavior evidence; a pure handler test is insufficient | Unverified | + +If native delimited control is selected, these additional obligations become +required. They remain Unverified, not implicitly satisfied by library encoding: + +| ID | Requirement | Required evidence | Status | +| --- | --- | --- | --- | +| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 disposition and complete request/result/answer and row contracts | Unverified | +| AC-02 | Runtime can capture and resume using the selected representation | Actual target execution, supported frame boundaries, capability gating, and unavailable-capability rejection | Unverified | +| AC-03 | Resumption multiplicity and lifetime are enforced | Double resume, re-entrant resume, cancellation, non-resuming clauses, and expired-boundary tests | Unverified | +| AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Unverified | +| AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior | Unverified | + +No runtime or differential validation was run for this design. Record future +evidence with compiler/package identities, commands, actual outputs, and any +skips. Do not infer topic completion from existing generic compiler tests. diff --git a/docs/implementation/backend/native-effect-and-st.md b/docs/implementation/backend/native-effect-and-st.md new file mode 100644 index 00000000..e91fc435 --- /dev/null +++ b/docs/implementation/backend/native-effect-and-st.md @@ -0,0 +1,36 @@ +# Native Effect and ST: Proposed Acceptance Checklist + +**Status:** Design only; every requirement is Unverified. +**Design:** [Native Effect and ST over algebraic handlers](../../design/backend/fp/native-effect-and-st-handlers.md). +**Date:** 2026-10-11. + +This is a new proposal after compiler protocol removal. Historical State-based +execution evidence is not evidence for this representation. The independent +package and normal compiler lock have not been migrated by this design task. + +| ID | Requirement | Required evidence | Status | +| --- | --- | --- | --- | +| NE-01 | Public source fidelity | Pinned source audit; public exports/signatures/roles/classes/instances unchanged; native replacements explicitly justified | Unverified | +| NE-02 | Shared Effect/ST representation | Generic source-field and representation evidence; executed official ST.Global.toEffect with persistent references and multiple result types | Unverified | +| NE-03 | Inert construction and repeat execution | Public native API oracle for operation counts, strict factory arguments, delayed callbacks, and fresh allocations on repeated runs | Unverified | +| NE-04 | Heterogeneous request typing and identity | Int/String/function/record cells in one program; rank-N transports, in-place writes across polymorphic boxing, read/write optimization order, and malformed generic representation rejection | Unverified | +| NE-05 | Official Ref semantics | Aliasing, writes, read/modify' callback count and result, re-entrant unsafe callback behavior, and official oracle comparisons | Unverified | +| NE-06 | Self-referential initialization | Callback executes once; published self-reference works; unpublished read traps under the documented target adaptation | Unverified | +| NE-07 | ST region isolation | Official compiler differential cases for escaping references/actions, cross-region use, nominal Coercible rejection, constructor scope, and host-program injection | Unverified | +| NE-08 | Safe mutable-array isolation | Thaw/freeze copy behavior; repeated writes; callbacks; growth and alias transport; explicit unsafe sharing distinguished from safe APIs | Unverified | +| NE-09 | Deep stack-safe execution | Mandatory Wasmtime long public loops, MonadRec, bind chains, mixed native requests, and pure generic controls | Unverified | +| NE-10 | Native host handler behavior | Actual Console/Clock/Arguments/resource and other supported service execution; exact output/value/call order and lifetime observations | Unverified | +| NE-11 | Ordinary command/unsafe boundary | Configured runner executes once and returns zero; unsafePerformEffect repeats; traps propagate; no special Effect entry discovery | Unverified | +| NE-12 | User effects interpret into native Effect | Handler constructs native requests without executing early; residual operation rows are preserved or rejected appropriately | Unverified | +| NE-13 | Compiler neutrality | No State protocol, Effect discovery, native operation enum, hidden shape inference, or effect-specific optimizer exemption; generic regression evidence | Unverified | + +Implementation order follows semantic dependency: validate shared generic +representation and typed requests; implement native interpretation and region +boundaries; adapt public modules with fidelity evidence; execute complete API +conformance; only then consider a coherent package pin. Native continuation +support remains an independent decision and validation track. + +No runtime tests or differential cases were executed for this proposal. Record +exact compiler/package identities, commands, results, and skips for subsequent +evidence. Do not label a requirement Verified from this design text or a test +that exercises the withdrawn implementation. From 34cb5f8dea4cd4a32b221c834f99d35bb8f1f307 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 15:19:39 +0800 Subject: [PATCH 094/148] Record the runtime and storage binding continuation Record the runtime cleanup and ordinary storage binding repair, the locked revision's real erasure-cohort measurement, and the remaining Effect/ST implementation task. Neither the compiler stdlib lock nor the independent development package changes here. --- .../runtime-storage-handoff-2026-10-11.md | 180 ++++++++++++++++++ 1 file changed, 180 insertions(+) create mode 100644 docs/implementation/backend/runtime-storage-handoff-2026-10-11.md diff --git a/docs/implementation/backend/runtime-storage-handoff-2026-10-11.md b/docs/implementation/backend/runtime-storage-handoff-2026-10-11.md new file mode 100644 index 00000000..324bb605 --- /dev/null +++ b/docs/implementation/backend/runtime-storage-handoff-2026-10-11.md @@ -0,0 +1,180 @@ +# Runtime and ordinary storage binding handoff + +Date: 2026-10-11. Repository: `/Users/biu/Projects/purescript-rs`. +Branch: `stdlib/vendor-core-libraries`. Baseline HEAD: `e806616e` (`Remove +compiler-owned Effect and State mechanisms`). The work described below was +subsequently committed as three topical commits (`395ccba6`, `e7e250cf`, +`981c832a`), with this record following. No push or PR was created. + +## Direction and boundaries + +The user requested deletion of compiler-owned State analysis and the legacy +Effect mechanism, then a neutral algebraic-effects design, runtime cleanup, +and repair of ordinary runtime storage bindings. Do not restore State tokens, +dependency chains, effect-specific pass rules or the legacy Effect entry path. +The user has not selected an ordinary thunk replacement. + +Algebraic effects and Effect/ST are design drafts. Their eventual handlers and +sequencing belong to library/runtime code with ordinary compiler contracts. +DEC-03 governs library effects; runtime delimited continuations require their +own reviewed control contract and are not implemented here. + +## Runtime changes + +- `crates/psrs-runtime/Cargo.toml` and `src/lib.rs`: only `catalog` is enabled by + default; `formatter` was renamed to `number`. Catalog/GC encoding/packaging + dependencies are host-only. Executable features are additive; pinned artifact + builds still select separate feature sets and storage contracts. +- The old `examples/package.rs` is deleted; the same packaging operation is now + an explicit `psrs-runtime-package` binary in `tools/package.rs`, gated by + `artifact-tool`. Include the untracked new file when reviewing/committing. +- `tools/build.sh` and `tools/build-allocator.sh` use separate target directories + (`runtime-number`, `runtime-allocator`) under `${CARGO_TARGET_DIR:-target}`. +- `src/allocator/algorithm.rs` and `wasm.rs` use unsigned wasm32 operands. Live + addresses above 2 GiB no longer fail signed-pointer validation. Rust backing + layouts above `isize::MAX` fail allocation; full-memory byte coverage saturates + rather than wrapping. This does not promise a single allocation above 2 GiB. +- The allocator artifact and its catalog digest were repinned: + `4eca097da7112522a23cd790d7562d643090ac7d5f63aa493e853b23925dfb23`. + The numeric artifact is unchanged. ABI/storage/stack upper-bound verification + passed through composition. The declared allocator stack bound remains 80 bytes. +- `src/abi/storage/{mod,projection}.rs` no longer describes State operands. +- `crates/psrs-linker/tests/heap_getter.rs` exercises real high-bit addresses with + a heap boundary of `0x80000000`, including content-preserving resize and free. +- `crates/psrs-driver/src/tests/show.rs` updates its expected allocator digest + to match this repin. That stdlib-dependent test was not executed in this work. + +## Ordinary storage binding repair + +Before this repair, three backend boundaries unconditionally rejected runtime +storage declarations with `runtime storage bindings require the withdrawn State +contract`. This baseline was established by inspecting the current checkout, +not by an independent before-build comparison. + +Implemented source contracts: + +```purescript +foreign import "psrs:runtime-storage#array_fill" + filled :: forall a. Int -> a -> Array a +foreign import "psrs:runtime-storage#array_read" + read :: forall a. Array a -> Int -> a +foreign import "psrs:runtime-storage#array_write" + write :: forall a. Array a -> Int -> a -> Unit +foreign import "psrs:runtime-storage#trap" + abort :: forall a. a +``` + +Concrete scalar/array signatures are also exercised. Function payloads are +exercised through polymorphic declarations. Calling boundaries still follow the +existing Core call decomposition; no new source syntax or function-result arity +model was introduced. + +Ownership and changed files: + +1. `bindings/runtime/mod.rs` and new `source.rs` validate every checked Core + signature, including unused imports. The runtime owns operand categories; + Core's `types_equivalent` checks agreement of array elements and payloads. + Missing source signatures, wrong arity/types and mismatched elements fail. +2. `bindings/runtime/call/mod.rs` canonicalizes element slots to the existing CC + erased payload protocol and verifies incoming CC bindings. New `call/tests.rs` + rejects missing signatures, wrong arity/result and invalid array storage. + The normal CC call/partial-application conversion machinery performs payload + boxing, recovery and callable adaptation. Arrays must keep their canonical + erased-element storage and identity; do not add element-wise copy adaptation + for mutation. +3. `bindings/runtime/target.rs` plans physical imports from the provider ABI and + application layout; `mir/layout/accessors.rs` exposes read-only type definitions + for physical contract verification. Provider identity survives into MIR. +4. `mir/runtime/context.rs` now retains live imports instead of an empty map. + `mir/{mod,lower/mod,lower/assignments}.rs` pass this inventory to ordinary call + lowering. New `mir/lower/storage_call.rs` handles nullable raw references, + checked recovery, void-write Unit and non-returning trap results. WIT builder + and its test receive the inventory too. This adds no execution-order analysis. +5. `cc/lower/global.rs` looks up an external's checked scheme for zero-operand + polymorphic values, rather than requiring a local declaration. This enables + the ordinary polymorphic non-returning import; it is a general external-value + correction. +6. New `crates/psrs-driver/src/tests/runtime_storage.rs` covers the complete + source-to-component path without requiring the independent stdlib package. + +## Validation and limits + +Successful focused checks: + +| Check | Evidence | +| --- | --- | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-runtime --all-features --lib` | 26 passed, including two unsigned allocator cases and runtime GC provider execution | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-linker --test heap_getter` | 4 passed with the repinned artifact; the execution test was then rerun successfully with the added high boundary | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib post_return::` | 3 passed, including composed buffer reclamation | +| `cargo check --locked -p psrs-runtime --lib --target wasm32-unknown-unknown --all-features` | Passed | +| Concurrent numeric/allocator build scripts and `cmp` against pinned artifacts | Both reproduced byte-for-byte | +| `cargo clippy -p psrs-runtime --all-targets --all-features -- -D warnings` | Passed | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib runtime_storage::` | 6 passed; aliases/partial calls/concrete and generic payloads, invalid declarations, traps and unused-provider omission | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-backend --lib runtime -- --nocapture` | 11 passed; malformed IR and provider/linking/execution checks | +| `cargo clippy -p psrs-backend -p psrs-driver --all-targets -- -D warnings` | Passed | + +Additional erasure regression was attempted: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib polymorphism_erasure_audit:: +``` + +Result: 1 passed, 20 failed. All failures reported that +`/Users/biu/Projects/psrs-stdlib` content differs from `stdlib.lock.json`, before +backend lowering. This is an environment/package admission failure, not evidence +of a backend regression or a successful broad regression run. One linked-module +high-bit integer case passed because it uses explicit sources. Do not change the +lock or point these tests at the State-dependent development package merely to +bypass this failure; provide the actual locked package for comparable evidence. + +Final `cargo fmt --all --check` and `git diff --check` passed after the storage +continuation's formatting correction. Runtime script syntax checks also passed. +No full workspace tests, full clippy, +official scoreboards, source-fidelity audit or public Effect/ST conformance run +was performed. Existing user preference is focused validation, not repeatedly +running the full workspace suite. + +## Documents and independent package + +Relevant normative and acceptance documents updated in this workspace: + +- `docs/design/backend/wasm/linking-and-runtime.md` +- `docs/design/backend/wasm/canonical-realloc-runtime-adapter.md` +- `docs/implementation/backend/linking-and-runtime.md` + +Other draft design work landed with the documentation commit: + +- `docs/design/backend/fp/algebraic-effects-and-handlers.md` +- `docs/implementation/backend/algebraic-effects.md` +- `docs/design/backend/fp/native-effect-and-st-handlers.md` +- `docs/implementation/backend/native-effect-and-st.md` +- Backend README index and `docs/feature/F-02-portable-programs.md` changes. + +The algebraic/native-effect checklists remain Unverified. Storage ABI acceptance +does not implement either topic. `/Users/biu/Projects/psrs-stdlib` was not edited +in this work. Its earlier handoff reported substantial uncommitted State-based +adaptations; inspect that repository before any migration. Compiler +`stdlib.lock.json` remains unchanged and points at the old locked package. + +## Completion + +1. The diff and untracked source files were reviewed. The draft design work and + the independently committed State-removal baseline were preserved. +2. The shared zero-operand external lowering change was reviewed; focused storage + behavior and the final formatting/diff checks are green. +3. Broader erasure evidence was measured. The locked revision `1e01310`, + materialized without modifying the lock or the development repository, + reproduces fingerprint `fnv1a64-v1:bca0ace40bd0ccac` and yields `9 passed, + 12 failed` for `polymorphism_erasure_audit`. The same 12 tests fail at + baseline `e806616e`, so the storage repair changes none of them. Nine are the + locked `Prelude`'s removed `psrs:effect` imports at P8 WIT linking; three are + pre-existing `guest projection of a non-closed type` closure-conversion + cases. The committed lock is stale relative to the effect removal, so a green + cohort needs a matching compiler/stdlib pair. +4. Runtime cleanup and ordinary storage binding repair were committed as + coherent topics with their docs and tests, including the renamed packaging + tool and the new backend/driver files. +5. Algebraic-effect and native Effect/ST implementation remains a separate, + explicitly selected next task. Library compatibility is not claimed and the + normal stdlib lock was not updated. + From 867b42e18c008126f86e9df9d38557a0586b9d6a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 15:43:10 +0800 Subject: [PATCH 095/148] Select compiler-generated frames for generic effect handlers DEC-19 records the generic, effect-agnostic handler and interruption mechanism as compiler-generated resumable frames: a selective, defunctionalized CPS whose continuation is an explicit GC frame chain resumed by a trampoline. It keeps concrete operations, rows, and handlers in library code and adds no effect rows or handlers to the type system. The record narrowly amends DEC-03's exclusion of delimited continuations below Typed Core and rejects WebAssembly stack switching for now: the proposal is at Phase 3, Wasmtime disables it by default, and it depends on the exceptions feature this profile disables. Rewrite the algebraic-effects design document around the selected mechanism: a beginner introduction to operations, handlers, continuations, and deep/shallow and one-shot/multi-shot resumptions; the abstract control model and its effect-agnostic contracts; the compiler/runtime/Wasm layering; a detailed selective-CPS-to-resumable-frames lowering with the trampoline, frame lifetime, GC roots, and foreign-call boundaries; and a comparison of compiler CPS against native stack switching. The AC-* control obligations become required, and the native Effect/ST, backend index, F-02, and DEC-03 references are updated to match. --- .../DEC-03-purescript-faithful-type-system.md | 7 +- ...-19-compiler-generated-resumable-frames.md | 107 +++ docs/design/backend/README.md | 2 +- .../fp/algebraic-effects-and-handlers.md | 843 +++++++++++++----- .../fp/native-effect-and-st-handlers.md | 18 +- docs/feature/F-02-portable-programs.md | 9 +- .../backend/algebraic-effects.md | 22 +- 7 files changed, 760 insertions(+), 248 deletions(-) create mode 100644 docs/decision/DEC-19-compiler-generated-resumable-frames.md diff --git a/docs/decision/DEC-03-purescript-faithful-type-system.md b/docs/decision/DEC-03-purescript-faithful-type-system.md index f0b447cc..d6b34a09 100644 --- a/docs/decision/DEC-03-purescript-faithful-type-system.md +++ b/docs/decision/DEC-03-purescript-faithful-type-system.md @@ -1,7 +1,12 @@ # DEC-03 — PureScript-Faithful Type System and Effect Encoding **Status:** Accepted -**Date:** 2026-09-19 +**Date:** 2026-09-19 +**Amended by:** [DEC-19](DEC-19-compiler-generated-resumable-frames.md) +(2026-10-11). DEC-19 narrows this record's blanket exclusion of delimited +continuations: a generic, effect-agnostic control mechanism may be lowered below +Typed Core. The type-system decision here is unchanged — effects remain a library +encoding with no frontend effect rows and no compiler-known handlers. ## Context diff --git a/docs/decision/DEC-19-compiler-generated-resumable-frames.md b/docs/decision/DEC-19-compiler-generated-resumable-frames.md new file mode 100644 index 00000000..1f191a05 --- /dev/null +++ b/docs/decision/DEC-19-compiler-generated-resumable-frames.md @@ -0,0 +1,107 @@ +# DEC-19 — Compiler-Generated Resumable Frames for Generic Handlers + +**Status:** Accepted +**Date:** 2026-10-11 +**Amends:** [DEC-03](DEC-03-purescript-faithful-type-system.md), the clause that +keeps delimited continuations out of every IR. +**Governed by:** [F-02](../feature/F-02-portable-programs.md) and +[algebraic effects and handlers](../design/backend/fp/algebraic-effects-and-handlers.md). + +## Context and constraints + +A portable program needs a way for library code to define effectful operations +and the handlers that interpret them. [DEC-03](DEC-03-purescript-faithful-type-system.md) +chose to encode effects as a library (`purescript-run` style) and explicitly kept +"effect rows, handlers, or delimited continuations" out of CST, AST, HIR, THIR, +and Typed Core. The compiler-owned `Effect`/`State` mechanism was removed on +2026-10-11, leaving no replacement representation. + +A library-only encoding over a free/freer monad is portable and needs no compiler +change, but it forces every effectful computation through an explicit monadic +value and depends on library trampolining for stack safety. A generic mechanism +that can suspend a computation and capture the remainder — delimited control — +gives the direct style users expect while keeping every concrete operation, row, +and handler in library code. + +Delimited control has exactly two viable implementations on this target: + +- **Compiler-generated resumable frames.** The compiler lowers the regions that + can suspend into an explicit heap-allocated frame chain (a defunctionalized CPS + / abstract machine) driven by a loop. This uses only features the pinned profile + already enables: Wasm GC, typed function references, and tail calls. +- **Target-native stack switching.** Lower suspension to the WebAssembly + stack-switching proposal (`cont`/`suspend`/`resume`) and let the runtime capture + the guest execution stack. + +A plain host import cannot implement either. A Rust/Wasm function called by the +guest cannot capture the caller's Wasm execution stack; Rust's linear-memory stack +is a different stack, so "runtime support" is not a normal binding. + +## Decision + +Adopt **compiler-generated resumable frames** as the generic, effect-agnostic +handler and interruption mechanism. + +- The compiler owns a small, abstract control surface: a suspension primitive, a + delimiter/handler boundary, and an abstract typed resumption. No pass recognizes + a concrete operation name (`State`, `Console`, `Run`, `Effect`), and the type + system gains no effect rows or handlers. +- The lowering is a **selective, defunctionalized CPS**: only computations that + can reach a suspension are converted; the continuation is an explicit chain of + GC frame objects resumed by a trampoline, so execution is stack-safe + independently of the native stack. +- Concrete operations, rows, and handlers remain in the independent standard + library and user libraries, built on the control surface. The compiler does not + own their meaning. +- **Do not adopt WebAssembly stack switching now.** It is a Phase 3 proposal and + not merged into the core specification. Wasmtime disables it by default + (`Config::wasm_stack_switching = false`), it depends on the `exceptions` + feature, and the pinned profile disables `exceptions`. Revisit it as a + target-profile revision only when it reaches Phase 4/5 and the pinned runtime + enables it by default; until then the artifact contract must not depend on it. + +### Amendment to DEC-03 + +DEC-03's prohibition of delimited continuations in the IRs is narrowed: a +*generic, effect-agnostic* control mechanism may be lowered below Typed Core (in +the backend MIR), and a small abstract control surface may appear at the boundary +that the library builds on. DEC-03's type-system decision is retained: there are +no frontend effect rows, no compiler-known handlers, and no compiler-native effect +system; effects remain a library encoding. + +## Alternatives considered + +- **WebAssembly stack switching (rejected for now).** It is a Phase 3 proposal, + disabled by default in the pinned runtime, depends on a second disabled feature + (`exceptions`), and would tie the artifact contract to a moving proposal and a + non-default runtime configuration. It remains a possible future accelerator + behind an explicit profile revision. +- **Library-only free monad (retained as the portable baseline, not sufficient + alone).** It needs no compiler change and remains valid for pure handlers, but + it is not direct style and gives no generic interruption mechanism for code not + written in the monad; its stack safety is a library trampoline, not a compiler + guarantee. +- **Host-imported stack capture (rejected as impossible).** A Wasm import cannot + capture its caller's execution stack. +- **A compiler-native effect system (rejected, unchanged from DEC-03).** Adding + effect rows and handlers to the type system is a language change DEC-03 + rejected; this record does not revive it. + +## Consequences + +- The backend gains a new lowering obligation: selective CPS/defunctionalization, + an explicit frame representation, a trampoline, and verification that frame + identity, capture boundaries, and resumption consumption are preserved. Frames + are GC values, so captured roots are collected by the engine. +- The target profile is unchanged: GC, typed function references, and tail calls + already cover the mechanism; no new capability flag is required. +- The native mechanism and the portable library encoding are distinct and must not + be silently interchanged; runtime one-shot and library multi-shot behavior stay + distinguishable. +- Delimited control is powerful and dangerous. Suspension across a non-suspendable + host/foreign frame, multi-shot replay of mutable state, and continuation + lifetime are explicit contracts, not automatic guarantees. +- The design document + [`algebraic-effects-and-handlers.md`](../design/backend/fp/algebraic-effects-and-handlers.md) + is the source of truth for the mechanism, its lowering, and the comparison with + stack switching. Implementation follows it. diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index eac12dcd..098ff07a 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -54,7 +54,7 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [pattern-matching.md](fp/pattern-matching.md) | Pattern decision trees and exhaustiveness | cc-ir | | [control-flow-and-tail-calls.md](fp/control-flow-and-tail-calls.md) | CFG structuring, `Switch`, tail calls | mir | | [type-classes-and-dictionaries.md](fp/type-classes-and-dictionaries.md) | Dictionary passing and instance evidence | functional-core | -| [algebraic-effects-and-handlers.md](fp/algebraic-effects-and-handlers.md) | Library operation rows and handlers; continuation ownership and runtime control options (**Draft proposal**) | DEC-03, ordinary rows/classes, functional-core, runtime linking | +| [algebraic-effects-and-handlers.md](fp/algebraic-effects-and-handlers.md) | Library operation rows and handlers; the generic suspension/handler mechanism and its compiler-generated resumable-frame lowering (**Draft design**) | DEC-03, DEC-19, ordinary rows/classes, functional-core, capability-profile, runtime linking | | [native-effect-and-st-handlers.md](fp/native-effect-and-st-handlers.md) | Official Effect/ST facades, common native computation, typed storage/host handlers, and region safety (**Draft proposal**) | algebraic effects, roles, rank-N, runtime linking | | [effects.md](fp/effects.md) | Effect representation and the platform boundary (**withdrawn 2026-10-11**; replacement undecided) | functional-core | | [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics and cross-pass dependencies (**withdrawn 2026-10-11**) | primitive types, functional-core, CC, MIR | diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index 54c16dad..4727ab0f 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -1,68 +1,155 @@ # Library-Owned Algebraic Effects and Handlers **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) -**Status:** Draft proposal; no implementation or accepted native Effect replacement. +**Status:** Draft design. The generic mechanism and its representation are +selected by [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md); +the lowering is not implemented. **Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), [functional Core](../../frontend/semantics/functional-core.md), [rows and records](../../frontend/type-system/rows-and-records.md), [representation and evidence](representation-and-evidence.md), -[control flow](control-flow-and-tail-calls.md), and +[control flow and tail calls](control-flow-and-tail-calls.md), +[capability profile](../wasm/capability-profile.md), and [runtime linking](../wasm/linking-and-runtime.md). **Summary:** Algebraic operations and their handlers are library values, checked -using ordinary PureScript types and rows. The compiler owns generic language -semantics and representation, not a State/IO protocol or operation dependency -graph. Explicit library continuations provide a portable semantic model; -runtime delimited continuations are a separately specified execution option, -not an assumed ability of an ordinary Wasm import. The separate -[native Effect/ST proposal](native-effect-and-st-handlers.md) specifies public -facades without changing this generic operation model. +with ordinary PureScript types and rows. The compiler owns only a generic, +effect-agnostic suspension/handler mechanism, lowered to explicit resumable frames +(a selective, defunctionalized CPS) that need no new target capability. Runtime +delimited control through WebAssembly stack switching is a separately reviewed +target option, not an assumed ability of an ordinary Wasm import. ## Scope -This topic owns the meaning of library-defined algebraic operations, handler -composition, row-based operation requirements, and continuation boundaries. -It specifies the division of responsibility between library, compiler, and -runtime and the conditions for adopting runtime control support. - -The following are separate decisions: official Effect/ST representation and -source adaptation (proposed in the native topic), a native effect type system, new surface syntax, resource -ownership types, async scheduling, and target stack switching. Designing -algebraic effects does not authorize rebuilding the withdrawn compiler-owned -Effect or State mechanisms. - -The proposal follows DEC-03's library encoding. A runtime option that requires -new compiler control primitives must be reviewed against DEC-03 before being -selected. This document does not silently amend that accepted decision. +This document owns the meaning of library-defined algebraic operations, handler +composition, row-based operation requirements, and continuation boundaries. It +also owns the generic control mechanism that makes such handlers executable — the +suspension, delimiter, and resumption primitives — and their lowering through MIR +to Wasm, including the comparison with native stack switching. + +The following are separate decisions: official Effect/ST representation and source +adaptation (proposed in the [native topic](native-effect-and-st-handlers.md)), a +native effect type system, new source syntax, resource-ownership types, async +scheduling, and target stack switching. Designing algebraic effects does not +authorize rebuilding the withdrawn compiler-owned `Effect` or `State` +mechanisms, nor adding effect rows or handlers to the type system. + +The proposal follows DEC-03's library encoding and the mechanism decision in +DEC-19. DEC-19 narrowly amends DEC-03's blanket exclusion of delimited +continuations below Typed Core; the type-system decision is unchanged. Any option +that needs a new target capability or a new frontend feature must be reviewed +against DEC-03 before it is selected, and this document does not silently amend +that accepted decision. ## Background -An algebraic operation describes a request without choosing its interpretation. -A handler supplies that interpretation and decides how the remaining -computation proceeds. The same console operation can write to a terminal or -append to a test log; the same state operations can thread a pure value or use -mutable storage. - -A continuation represents the remainder of a computation. It can be explicit -data and functions in a library, or a suspended execution segment managed by -a control runtime. These representations have different implementation costs; -neither requires a compiler to know the meaning of a particular operation. +### What algebraic effects are + +Algebraic effects and handlers separate the *description* of an effectful +operation from its *interpretation*. A computation performs an operation; a +**handler** around that computation decides what the operation means. + +- An **operation** (also called a request) is a value describing what the program + wants to do: "read the current state", "print this line", "get the clock time". + It names a *result type* but not the way the result is produced. +- An **operation signature** is a set of operations, for example + `Get : Unit -> S` and `Put : S -> Unit`. +- A **computation** is a value that may perform operations before it returns its + result; its type records the result and the operations it may expose. +- A **handler** interprets the operations of one signature. It receives each + operation together with a **continuation** — the rest of the computation from + just after the performed operation — and chooses what to do with it. +- A **continuation** (also called a **resumption**) represents "the remainder". + A handler may call it zero times (abort), exactly once (resume), or several + times (replay). +- A **delimiter** is the boundary within which a handler is installed. Capturing a + continuation stops at that boundary. +- A **deep handler** installs itself again for every request made after a + resumption; a **shallow handler** interprets only the current request and runs + the remainder without reinstalling itself. +- A **one-shot** continuation may be resumed at most once; a **multi-shot** + continuation may be resumed arbitrarily many times. +- The **residual row** is the set of operations not handled by a given handler, + which remains in the computation's type. + +The intuition for a reader new to the idea is a `throw`/`catch` pair where the +catcher can *resume the thrower*. `catch` receives the thrown value; here the +handler also receives a way to continue, so it can supply a result and let the +original computation proceed. This is the same idea as `yield` in a generator, +generalized so that a handler can resume zero, one, or many times and can choose a +different interpretation for each request. + +A minimal State signature shows the shape: -PureScript already provides ADTs, functions, higher-kinded types, type classes, -rank-N polymorphism, ordinary rows, and monadic `do`. `purescript-run` encodes -extensible operations using `Free` and `VariantF`; its handlers are ordinary -interpreters. This establishes expressibility in the language, not acceptance -by this compiler or availability of a native IO implementation. +```purescript +data StateF s next + = Get (s -> next) + | Put s next +``` -An operation row is a library parameter, not a second effect system attached -to every function arrow. Its constraints describe which requests a computation -can expose. They do not prove single use, termination, absence of unsafe FFI, -or correct resource release. +`Get` carries its result as a function argument (`s -> next`); `Put` has a unit +result (`next` alone). A `Functor` instance lets operations be composed without +knowing their meaning. The same console operation can write to a terminal or +append to a test log; the same state operations can thread a pure value or use +mutable storage. The operation says *what*, the handler says *how*. + +The name "algebraic" comes from the interpretation: operations form a signature, +and handlers are algebras over it, obeying the laws the signature declares. The +implementation does not need to understand the theory; it only needs ordinary +values, functions, and a way to capture and resume a continuation. + +Why not ordinary exceptions? A handler can *resume*. `catch` consumes control +permanently, but an effect handler can supply the operation's result and continue +the computation, possibly more than once. That single difference is what requires +continuations. + +PureScript already provides the types to *describe* all of this: algebraic data +types, functions, higher-kinded types, type classes, rank-N polymorphism, +ordinary rows, and monadic `do`. `purescript-run` encodes extensible operations +using `Free` and `VariantF`; its handlers are ordinary interpreters. That +establishes expressibility in the language, not an execution strategy. + +An operation row is a library parameter, not a second effect system attached to +every function arrow. Its constraints describe which requests a computation can +expose. They do not prove single use, termination, absence of unsafe FFI, or +correct resource release. + +### Two ways to execute a handler + +Once handlers are expressible, they still have to run. There are exactly two +execution strategies. + +1. **Library encoding.** Operations are data constructors, a computation is an + ADT, and a handler is a recursive interpreter. Binding builds a tree without + performing requests. This is portable and needs no compiler support, and it is + the default baseline of DEC-03. Its costs are indirect style (all effectful + code lives in the monad) and stack safety that depends on a library trampoline + rather than a compiler guarantee. + +2. **Native delimited control.** The compiler provides a generic way to suspend + the current computation and capture the remainder, and a handler is ordinary + code that receives an operation and a resumption and decides whether to resume. + Effectful code keeps its direct style, and the compiler can guarantee stack + safety. This requires a compiler/runtime mechanism, which DEC-19 selects. + +Neither strategy changes what operations, rows, or handlers mean; they differ only +in how a continuation is represented and resumed. + +### What the compiler must not know + +The compiler never learns what a particular operation means. It does not recognize +the spelling `State`, `Console`, `Run`, or `Effect`, does not inspect a handler +body to infer a hidden protocol, and keeps no operation graph, frozen source +inventory, or cross-pass witness. It owns only an abstract suspension boundary and +its representation. Everything specific — the operation signatures, the handler +interpretations, the residual rows, and the continuation-composition policies — +belongs to library code. ## Model -### Computations and operation signatures +### Library computations and operation signatures -Use the following schematic public model, matching the kind of `Run`: +The library-visible model matches the kind of `Run`: ```purescript Run :: Row (Type -> Type) -> Type -> Type @@ -75,19 +162,13 @@ data ConsoleF next = Print String next ``` -Each signature has a Functor instance. `Get` receives the operation result -before continuing; `Put` and `Print` have a unit result. Operations are lifted -into a row-indexed computation by library functions. Binding constructs the -remaining computation without performing requests. - -The semantic computation tree has `Return a` and `Request op continuation`. -This is a mathematical model, not a required runtime layout. An implementation -may use freer/Coyoneda representations and queued binds to avoid restrictive -Functor implementations and inefficient left-associated bind chains. +Each signature has a `Functor` instance. Operations are lifted into a row-indexed +computation by library functions. Binding constructs the remaining computation +without performing requests. The semantic computation tree has `Return a` and +`Request op continuation`; this is a mathematical model, not a required runtime +layout. An implementation may use freer/Coyoneda representations and queued binds. -### Handlers and residual rows - -These are schematic interfaces, not new compiler intrinsics: +Schematic handler interfaces, which are library values, not compiler intrinsics: ```purescript get :: forall s r. Run (state :: StateF s | r) s @@ -102,29 +183,94 @@ handleState runPure :: forall a. Run () a -> a ``` -Row membership and removal use ordinary row relations and library evidence. -The actual API must preserve the upstream row constraints, including label -absence where needed; the schematic signatures do not authorize weakening -those constraints. State here is an ordinary value `s`, not a primitive token. +Row membership and removal use ordinary row relations and library evidence. The +actual API must preserve the upstream row constraints, including label absence +where needed. State here is an ordinary value `s`, not a primitive token. A handler handles its selected slot and forwards every other request with a -continuation that re-enters the handler. This is deep-handler semantics: after -resumption, subsequent requests at the same slot are handled again. Distinct -instances use distinct labels; a duplicate-label or shadowing policy must be -explicit rather than relying on a silent row-map collapse. +continuation that re-enters the handler (deep semantics). Distinct instances use +distinct labels; a duplicate-label or shadowing policy must be explicit rather +than relying on a silent row-map collapse. + +### The generic control model + +The compiler-owned model is deliberately smaller than any effect API. It consists +of four abstract notions. + +- **A computation carrier** `Control a`: an opaque type for "a computation that + yields `a` and may suspend". Only the primitives below inspect it; no pass + pattern-matches on a concrete operation. +- **Suspension**: a primitive that captures the current continuation up to the + nearest delimiter, delivers an opaque, library-typed payload to that + delimiter's handler, and waits for a result of the suspension's result type. +- **A delimiter/handler boundary**: a primitive that installs a handler over a + computation. The handler receives each suspension's payload and its resumption + and returns the computation's overall answer. +- **A resumption** `Resumption a`: an abstract, typed value representing a captured + continuation whose result type is `a`. Resuming applies it to a value of that + type. + +The essential, effect-agnostic contracts — the ones the compiler guarantees and +the ones that make concrete effects safe — are: + +- A suspended payload is delivered unchanged to its delimiter; the compiler never + inspects or reinterprets it. +- A resumption is resumed at exactly the result type at which it suspended. The + compiler preserves this relationship through erasure, boxing, and call + adaptation; it cannot be exchanged for an unrelated result type. +- A resumption captures only up to its delimiter. Frames outside the delimiter are + not part of it. +- A resumption's lifetime is bounded by its delimiter, and the values it captured + remain valid for as long as the resumption is live (they are GC roots). +- Resumption multiplicity is an API property. A one-shot resumption is consumed by + its first resume; a multi-shot resumption is persistent. The compiler provides + the representation and the check; the library chooses which API it exposes and + may not silently change one into the other. + +Because the payload and the resumption's result type are related existentially, +the surface is stated as a contract rather than a single surface type; the exact +signatures, and the rank-N eliminator that recovers per-operation typing, are +settled with the implementation. The contracts above are normative: -### Resumption and lifetime +```text +Control a -- computation yielding an a that may suspend +Request -- an opaque, library-typed request value +Resumption -- a captured continuation yielding an a -The portable model uses persistent explicit continuations. A handler may resume -zero, once, or multiple times when its API permits it. A pure state handler -supplies a state value to each branch; replaying a continuation does not roll -back mutations or external IO already performed by another branch. +suspend : Request -> Control a + -- capture the continuation up to the nearest delimiter and deliver a + -- request; the suspension's own result type is the a -Single-use native resumptions require a distinct abstract API. Existing -PureScript arrows are unrestricted: hiding a constructor or adding a nominal -type parameter does not prevent callers from invoking a value twice. A native -one-shot implementation must check consumption at runtime unless a separate -static usage discipline has been adopted. +handle : Handler -> Control a -> Answer + -- install a delimiter; the handler receives each Request together with the + -- Resumption for that suspension's own result type a, and returns the + -- delimiter's Answer + +resume : Resumption -> a -> Control a + -- resume a captured continuation at its own result type +``` + +The payload type and the resumption's result type are linked by the library, not +by this surface: the library encodes typed requests with a rank-N eliminator, as +the [native topic](native-effect-and-st-handlers.md) sketches for heterogeneous +storage requests. The primitive only has to preserve the resumption's result type +and deliver the payload opaquely. + +### Deep versus shallow, one-shot versus multi-shot + +Deep and shallow are properties of a handler, expressed by whether the library +reinstalls the handler around the resumption. A deep state handler carries its +state value forward and handles later requests at the same slot; a shallow handler +returns control to the code outside the delimiter after the current request. + +One-shot and multi-shot are properties of the resumption. The portable library +encoding is naturally multi-shot: continuations are persistent data, so replaying +one re-runs the interpreted remainder, and replaying does not roll back mutations +or external IO already performed by another branch. A native one-shot API is +naturally cheap because the captured frames can be consumed. Existing PureScript +arrows are unrestricted, so hiding a constructor or adding a nominal parameter +does not by itself stop a caller from invoking a value twice; a one-shot guarantee +must be checked at the representation boundary, not asserted by the type. ## Design @@ -132,104 +278,230 @@ static usage discipline has been adopted. | Owner | Responsibility | | --- | --- | -| Type system | Ordinary kinds, rows, class evidence, quantifiers, roles, constructor visibility, and applicable region constraints | -| Library | Operation signatures, computation construction, handler interpretation, residual operation rows, continuation composition, and policies | -| Compiler | Strict evaluation, ordinary closures/ADTs/dictionaries, generic calls and ABI checks, and sound optimization/control lowering | -| Runtime | Real IO/storage primitives; if separately adopted, delimited control and native resumption lifetime checks | -| Target profile | Explicitly adopted Wasm features and rejection of unavailable capabilities | +| Type system | Ordinary kinds, rows, class evidence, quantifiers, roles, constructor visibility, and applicable region constraints. No effect rows or handlers. | +| Library | Operation signatures, computation construction, handler interpretation, residual operation rows, continuation composition, and one-shot/multi-shot API choice. | +| Compiler | The abstract control surface; strict evaluation; ordinary closures/ADTs/dictionaries; generic calls and ABI checks; the selective CPS/defunctionalization lowering and its verification; sound optimization. | +| Runtime | Real IO/storage primitives; an optional trampoline or driver; if separately adopted, target stack switching and native resumption lifetime checks. | +| Target profile | Explicitly adopted Wasm features and rejection of unavailable capabilities. | No pass discovers an operation by the spelling `State`, `Console`, `Run`, or -`Effect`. No pass interprets handler source to infer a hidden protocol. No -operation graph, frozen source inventory, or cross-pass State witness is -required. Generic type, representation, and CFG verification remain required. - -The compiler preserves observable calls and traps even when their results are -unused. The library cannot make an optimizer sound by providing a handler: -generic call semantics and conservative effect summaries remain compiler -responsibilities. Inlining and specialization must work for these values under -the same contracts as other ordinary higher-order programs. - -### Portable execution - -The default proposal under DEC-03 is an ordinary library interpreter over -explicit continuations, with stack-safe library machinery. This is not a -decision to represent native Effect as `Unit -> a`. Pure handlers need no native -control runtime. Host-facing handlers eventually invoke checked foreign/runtime -operations; this topic does not select the currently missing native Effect ABI. - -Reuse upstream `purescript-run`/`purescript-free` semantics and sources where -appropriate rather than making a compiler-known replacement monad. Audit their -actual FFI and representation needs before claiming target compatibility. -Performance needs a measured implementation: a naive tree interpreter or -recursive bind evaluator is not sufficient stack-safety evidence. - -### Runtime delimited continuation option - -Delimited control limits capture to a particular execution boundary. A handler -can suspend a computation at a request, examine its payload, and resume it with -an operation result. This can support efficient direct execution without -materializing every intermediate computation tree, but is not free stack access. - -Two valid runtime architectures are candidates: - -1. A compiler-generated continuation representation (CPS or resumable frames) - whose frames are managed by a runtime scheduler. -2. A separately enabled target continuation/stack-switching facility, with - compiler lowering and validation for that facility. - -A normal imported Rust/Wasm function cannot capture the caller's Wasm execution -stack. Rust's private linear-memory stack is not that execution stack; moving -its stack pointer or saving registers is not a valid continuation implementation. - -Any native option must define all of the following before implementation: - -- A typed boundary answer, request payload/result relation, and abstract - resumption. Runtime dispatch uses checked identity/evidence; it must not cast - an arbitrary label and payload into an unrelated result type. -- Deep versus shallow resumption and the placement of the handler delimiter. - Handler clauses execute outside the handled delimiter unless explicitly - re-entered, so their own requests are forwarded or handled by an outer scope. -- A one-shot or multi-shot API. One-shot consumption is checked before transfer; - multi-shot support needs an explicit frame/stack cloning contract and cannot - be implemented by bypassing a one-shot guard. -- Boundary lifetime, captured GC roots, cancellation, abandonment, and return - to the handler. Suspended continuations cannot retain borrowed canonical ABI - buffers or invalid host-resource references. -- Foreign-call boundaries. Capture across a non-suspendable host/import frame - is rejected unless that boundary has an explicit suspension protocol. -- Representation of the resumable computation in existing PureScript types. - Raw capture primitives must not inhabit an unrestricted pure function type - while changing its control behavior. An abstract computation API or another - justified typed boundary is required. - -Conceptually, a one-shot continuation has `Pending`, `Running`, `Consumed`, or -`Cancelled` status. The transfer from `Pending` must atomically consume the -resumption with respect to re-entrancy; failure does not silently permit a -second transfer. The status belongs to a runtime object, not a compiler State -token analysis. Return, cancellation, and non-resuming clauses release captured -storage under the selected lifetime contract. - -No new control intrinsic, Rust feature, Wasm proposal, or opaque public type is -selected by this draft. DEC-03 and target capability decisions must explicitly -authorize a native option. Runtime one-shot and portable multi-shot behavior -must have distinguishable APIs; an optimization cannot silently change one -into the other. +`Effect`. No pass interprets handler source to infer a hidden protocol. Generic +type, representation, and CFG verification remain required. The compiler preserves +observable calls and traps even when their results are unused; a library cannot +make an optimizer sound by providing a handler. + +### The effect-agnostic control surface + +The compiler owns only the four notions of the [control model](#the-generic-control-model). +It carries no operation registry and adds no operation-specific solver. The surface +is exposed to source as an abstract typed API; a library in the independent +standard library wraps it into whatever operation/handler API users see. Because +the surface is abstract, a raw capture cannot inhabit an unrestricted pure function +type while changing its control behavior: the caller must use `Control`, +`Resumption`, and the primitives, whose types state the suspension. + +The surface must be declared with a stable identity and a checked type contract, +like other compiler primitives. It is not a host import and not a WIT binding: it +has no runtime implementation of its own, because the lowering produces ordinary +guest code. + +### Lowering: selective CPS to resumable frames + +The mechanism is implemented by compiling the regions that can suspend into an +explicit continuation representation. The concept is **continuation-passing style +(CPS)**; the representation is **defunctionalized resumable frames** driven by a +**trampoline**. + +#### CPS in one paragraph + +In direct style, a function `f :: A -> B` returns its result to its caller, and +the caller's remaining work lives in the engine's execution stack. In CPS, the +same function becomes `A -> (B -> r) -> r`: it does not return; it calls a +**continuation** `k` that names the rest of the computation. Every call can then be +a tail call, so the "rest" is a value (`k`) rather than a stack of return +addresses. Capturing a continuation is, conceptually, taking that `k` and keeping +it. Resuming it is calling it. + +The concept alone is not enough, for two reasons specific to this target: + +1. **Capture needs reification.** If the "rest" is spread across the live Wasm + stack, it cannot be stored, passed to a handler, inspected, or resumed twice. + The continuation must be **data**. +2. **Stack safety must not depend on the engine.** The pinned profile enables tail + calls, so pure closure-CPS can be stack-safe, but a captured continuation + still needs a representation the compiler can reason about. + +The lowering therefore *defunctionalizes* CPS: instead of closures, a continuation +is an explicit chain of **frame objects** in the GC heap, and a loop runs the +machine one frame at a time. + +#### Selective conversion + +Converting a whole program to CPS would be slow and would change the representation +of code that never suspends. The compilation is **selective**: + +- A function is *convertible* when it can reach a suspension in its dynamic extent + — directly, through a call, or through a value it invokes. +- Only convertible functions are lowered to resumable form. Pure, non-convertible + functions keep the ordinary direct representation and calling convention. +- A suspension converts exactly the region from the suspension point out to its + delimiter; frames below the delimiter are ordinary calls and are not captured. + +Selectivity keeps the lowering proportional to the effectful part of the program +and keeps pure code fast. It is also where optimization interacts with the +mechanism: an inliner or specializer must not merge a convertible function into a +non-convertible one without preserving the conversion of the merged region, nor +erase a suspension whose result is unused, because the suspension is observable +control, not a pure computation. + +#### Frame construction + +Each step of a converted computation is represented by a frame. A frame stores: + +- the free variables the step needs (its captured environment), +- a small tag identifying which continuation step it is ("after the `Get`, apply + this function to the read value"), +- the pointer to the next frame (the previously captured remainder). + +A suspension builds a frame chain from the current point out to the delimiter, +hands the opaque payload and a `Resumption` (a handle to the chain) to the +handler, and stops running the current computation. `resume` reinstalls the chain +and supplies the response as the step's result. Frames are ordinary GC objects, so +captured references are roots the engine scans automatically; this is a decisive +advantage over capturing a raw execution stack, where the runtime must establish +stack maps to find roots. + +#### The trampoline + +A **trampoline** is the loop that runs the machine: + +```text +run(state): + loop: + step = state.current + match step: + Return(v) -> return v + Eval(frame) -> state.current = frame.step(state) + Suspend(payload, k) -> state = call_handler(payload, k) // may return + Resume(k, v) -> state.current = k.install(v) +``` + +Because the loop drives every step, the native Wasm stack does not grow with the +depth of binds or with long request sequences. Deep recursion in direct style +becomes bounded frame churn, the same way a self tail call becomes a loop. Using +`return_call`/`return_call_ref` for the tail positions of the emitted steps keeps +the constant-stack property even where the machine calls into ordinary code. + +#### Deep and shallow handlers + +The delineated region is a marker in the frame chain. A **deep** handler is one +whose resumption re-installs the handler before continuing, so subsequent requests +at the same delimiter are handled again; the lowering wraps the resumed chain with +the handler frame. A **shallow** handler resumes the chain without re-wrapping, so +the handler runs once and later requests escape to an outer delimiter. The library +selects the semantics; the lowering must implement both and must not silently +deepen or shallow a handler. + +#### One-shot and multi-shot + +The frame chain is the resumption. Two representations are possible: + +- **Persistent frames** (the natural multi-shot representation): a resumed frame is + not mutated, so the same `Resumption` may be resumed again. Replay re-runs the + captured remainder against the handler's supplied values. Mutable references and + external IO already performed by another branch are shared, exactly as the pure + model requires; multi-shot execution does not roll back IO. +- **Owned frames** (the one-shot representation): a `Resumption` holds a status of + `Pending`, `Running`, `Consumed`, or `Cancelled`. The first `resume` atomically + transitions out of `Pending`; a second attempt is rejected rather than silently + reinterpreted. Transfer must be atomic with respect to re-entrancy, so a + re-entrant resume of a running resumption fails rather than corrupting the chain. + +The two are distinct APIs. An optimization may not turn a multi-shot resumption +into a one-shot one. + +#### Lifetime, GC roots, and abandonment + +A resumption keeps its captured frames reachable, so anything those frames captured +stays alive until the resumption is dropped, resumed to completion, cancelled, or +abandoned. When a handler returns without resuming, its resumption becomes +unreachable and the GC reclaims the frames. The compiler must not drop a live +resumption to an optimization, and must not let a dead one keep roots alive beyond +its contract. + +#### Foreign-call boundaries + +Suspension cannot cross a non-suspendable host or foreign frame: a captured +continuation that spans a canonical-ABI call or an in-progress WIT import cannot +be resumed without that boundary's cooperation. The lowering rejects a conversion +that would capture across such a boundary unless the boundary declares an explicit +suspension protocol. The same rule applies to a canonical ABI buffer: a resumption +cannot retain a borrowed buffer or a host-resource reference past the boundary's +lifetime. + +### Compiler CPS versus native stack switching + +DEC-19 selects compiler-generated frames. The alternative, WebAssembly stack +switching, is a real implementation with different trade-offs. This section is the +comparison the mechanism decision rests on. + +The two implementations differ in where the "remainder" lives. **Native stack +switching** extends the instruction set with a continuation reference type and +`suspend`/`resume` instructions: a delimiter becomes a continuation object, and +suspending captures the current execution stack into it, which the runtime +relocates off the main Wasm stack; resuming reinstalls the captured segment. The +runtime must then scan captured stack slots for GC roots. **Compiler CPS** never +touches the execution stack: the compiler rewrites the functions that can suspend +into a state machine whose states are explicit GC frame objects, and a work-loop +(trampoline) drives them, so the "remainder" is ordinary heap data the GC already +understands. + +| Dimension | Compiler resumable frames (CPS/defunctionalized) | Native stack switching | +| --- | --- | --- | +| Standardization | Uses standardized Wasm 3.0 features (GC, function references, tail calls) already in the profile | A Phase 3 proposal, not merged into the core specification; semantics may still change | +| Runtime enablement | Runs on the default pinned runtime: those features are on by default | Wasmtime disables it by default; it additionally depends on the `exceptions` feature, which this profile disables | +| Portability | Any engine implementing the pinned profile | Only engines implementing the proposal with the matching configuration | +| What is captured | An explicit heap chain of frame objects | The live Wasm execution stack (a continuation object) | +| Capture cost | Allocates frame records proportional to the captured region; selective conversion limits it to the effectful part | The runtime captures or switches a stack segment; cost scales with the stack being captured | +| Cost on non-suspending code | Pure code stays direct; only convertible regions pay per-step frame cost | Direct code is unchanged; the runtime's switching machinery is present regardless | +| Stack safety | A trampoline gives constant native stack independent of bind depth and of the engine | Depends on the runtime moving captured stacks off the main stack; not a compiler guarantee | +| GC/roots | Frames are GC values; captured roots are scanned automatically | Captured stack slots need runtime stack maps; GC/continuation integration is the runtime's responsibility | +| One-shot/multi-shot | Explicit: persistent frames are multi-shot, owned frames are one-shot and checkable | The runtime captures a stack; multi-shot requires cloning it; one-shot is the natural case | +| Foreign boundary | The compiler statically rejects capturing across a non-suspendable host frame | `suspend` also cannot cross a host frame; the proposal defines which frames are capturable | +| Compiler complexity | Large: selective conversion, frame identity, lifetime, and optimization interaction are new obligations in MIR and its verifier | Smaller in the compiler, but the artifact depends on a target feature and the runtime must be configured for it | +| Optimizability | Frames are explicit and inspectable; every pass must preserve frame identity and suspension observability | Capture points are opaque to the compiler, so it cannot reorder or eliminate them, but it also cannot reason about them | +| Verification | Fits the existing MIR/Wasm pipeline; verified and executed under the pinned runtime | Needs a validator built with the proposal enabled and a runtime so configured | +| Principal risk | High implementation cost and subtle frame/lifetime bugs | Dependence on a moving proposal and a non-default runtime configuration | + +In short: stack switching moves the difficult part (capturing and rooting a live +stack) into the runtime and the standard, at the cost of an unstable, off-by-default +target feature. Compiler frames move it into the compiler, at the cost of a new +lowering, but keep the artifact inside the stable profile and make continuation +identity and lifetime explicit and verifiable. Given the project's rule that runtime +support is not a contract and that a proposal is adopted only by deliberate profile +revision, the compiler frames are the correct baseline. Stack switching remains a +future accelerator behind a separate decision once the proposal stabilizes. ### Rejected shortcuts - Attaching effect requirements to all function arrows without a language/type system decision. -- Reconstructing handler behavior in Core, CC, or MIR to recover an implicit - State protocol. -- Calling a generic runtime import a stack-capture primitive without a valid - target or compiler-generated continuation representation. -- Treating a row requirement as linearity or resource-lifetime evidence. +- Reconstructing handler behavior in Core, CC, or MIR to recover an implicit State + protocol. +- Capturing the Wasm stack from a generic host import; a normal imported function + cannot capture its caller's execution stack. +- Adopting Wasm stack switching while it is a Phase 3, off-by-default proposal that + a second disabled feature gates. +- Letting a raw capture primitive inhabit an unrestricted pure function type while + changing its control behavior. +- Treating a row requirement as linearity, single-use, or resource-lifetime + evidence. - Replacing native Effect/ST or public foreign APIs merely to get an algebraic effects example to compile. ## Algorithms -### Interpretation and forwarding +### Interpretation and forwarding (library) For a pure State handler carrying value `s`: @@ -242,64 +514,151 @@ handle(s, Other(op, k)) = Request(op, x -> handle(s, k(x))) Actual evaluation uses an explicit stack-safe work loop or upstream trampoline machinery. The final rule preserves the captured state while the outer handler -interprets another operation. Re-entering the State handler ensures deep +interprets another operation, and re-entering the State handler gives deep semantics. It does not statically inspect the future continuation. Type checking is ordinary application checking: operation lifting proves row -membership; handler application produces the residual row; `runPure` accepts -only the closed empty row. Any residual request is a type mismatch at that -boundary, assuming safe construction and the library's declared contracts. +membership; handler application produces the residual row; `runPure` accepts only +the closed empty row. Any residual request is a type mismatch at that boundary, +assuming safe construction and the library's declared contracts. + +### Selective conversion + +```text +convertible(f): + if f performs a suspension: return true + for each call, value applied, or capture in f: + if convertible(callee) or callee is unknown: return true + return false + +lower(program): + mark every function convertible by a fixed point over the call graph + for each convertible function: + rewrite its body in CPS form (Section "Frame construction") and + register its frames in the module frame table + leave non-convertible functions direct +``` -### Native control, if selected +An unknown or indirect callee that might suspend makes its caller convertible, so +the analysis is conservative at exactly the boundaries it cannot see. -Establish a typed delimiter, suspend the continuation at a request, transfer -to the appropriate handler clause, and consume/resume the continuation under -the native API. GC roots and delimiter state are retained until resumption or -cancellation completes. These are generic runtime/control operations; no -operation-specific analysis is performed during compilation. +### Suspension and resumption + +```text +suspend(payload): + k = capture_frames(current, up_to = nearest_delimiter) + transfer(payload, k) to the delimiter's handler + +resume(k, value): + assert k.status == Pending // for a one-shot resumption + k.status = Running + reinstall(k.frames, value) // continue with value as the step result + k.status = Consumed // on normal or trapping completion +``` + +The `capture_frames` step reads the current chain up to the delimiter without +copying outer frames. For a persistent (multi-shot) resumption it does not mutate +the chain; for an owned (one-shot) resumption the status transition is atomic so a +re-entrant resume is rejected. + +### Frame construction and trampoline loop + +```text +run(initial): + state = initial + loop: + match state: + Return(v) -> return v + Eval(frame) -> state = frame.step() + Suspend(payload, k) -> state = deliver(payload, k) + Resume(k, v) -> state = install(k, v) + Abort -> trap +``` + +`install(k, v)` continues the captured chain with `v` as the suspended step's +result. `deliver` calls the delimiter's handler; a handler that returns without +resuming produces a normal answer, and its resumption becomes unreachable. + +### Deep-handler reinstatement + +```text +install_deep(k, v, handler): + // Deep: the same delimiter must handle the continuation's later requests. + install(k, v) with handler re-wrapped around the resumed chain + +install_shallow(k, v): + install(k, v) without re-wrapping the handler +``` + +The frame chain records which wrapping applies; the lowering must not conflate the +two. + +### One-shot consumption + +```text +transfer(k): + atomically: if k.status != Pending: reject + k.status = Running + ... normal or trapping completion sets k.status = Consumed ... + ... cancellation sets k.status = Cancelled ... +``` + +The atomic transition is what makes one-shot reuse rejection a runtime guarantee +rather than a documented expectation. ## Code map -This is the proposed owner map, not a claim that these APIs are implemented: +This is the design target, not a claim that these APIs exist yet: | Location | Intended responsibility | | --- | --- | -| Independent `psrs-stdlib` package | Upstream computation libraries, ordinary operation modules, handlers, source audit, and conformance fixtures | +| Independent `psrs-stdlib` package | Upstream computation libraries, the abstract-control wrapper, ordinary operation modules, handlers, source audit, and conformance fixtures | | Existing kind/row/class/rank-N owners | Check library source using standard PureScript rules; repair shared deficiencies without effect-specific solvers | -| Existing Core/CC/MIR lowering and optimizers | Compile library code as ordinary higher-order code and preserve generic observable-call semantics | -| `psrs-runtime` ABI/catalog/executable owners | Small native IO/storage contracts and implementations, independent of operation-row or library identities | -| Runtime control owner, only if separately adopted | Delimiter/resumption ABI, captured-root storage, lifecycle checks, and capability requirements | +| Compiler control-surface owner | The abstract carrier, suspension/delimiter/resumption primitives, and their checked type contract | +| MIR control-lowering owner | Selective CPS/defunctionalization, the frame table, the trampoline, deep/shallow wrapping, and one-shot status | +| MIR verifier | Frame identity, capture boundary, resumption result-type, and suspension-observability checks | +| Existing Core/CC/MIR lowering and optimizers | Compile library code and the converted frames as ordinary higher-order code; preserve generic observable-call semantics | +| `psrs-runtime` ABI/catalog/executable owners | Small native IO/storage contracts and implementations, independent of operation rows; an optional trampoline driver | +| Runtime control owner, only if separately adopted | Stack-switching ABI, captured-root storage, lifecycle checks, and capability requirements | -No new compiler crate, handler IR, State graph directory, or compiler-side -operation registry is required for the portable model. Runtime control module -names and entry-point signatures remain unselected until the native contract -above is complete. +No compiler-side operation registry, handler IR, State graph directory, or +effect-specific solver is required. Runtime control module names and entry-point +signatures remain unselected until a target option is explicitly adopted. ## Invariants and verification -- Library computations are inert until interpreted, while ordinary strict - arguments are evaluated according to PureScript semantics. -- Operation results match their checked signature. Safe row dispatch cannot - exchange unrelated payload/result types. +- Library computations are inert until interpreted, while ordinary strict arguments + are evaluated according to PureScript semantics. +- Operation results match their checked signature. Safe dispatch cannot exchange + unrelated payload/result types. - A handler removes exactly its advertised operation requirement and preserves residual requests and the appropriate continuation. -- The pure boundary requires a closed empty operation row. This is not a proof - about unsafe coercions or arbitrary FFI hidden in user code. +- The pure boundary requires a closed empty operation row. This is not a proof about + unsafe coercions or arbitrary FFI hidden in user code. +- A suspension is observable control: it is never erased, reordered across, or + duplicated by an optimizer, and a converted function is never merged into a + direct one without preserving its conversion. +- A resumption is resumed only at its captured result type, and a one-shot + resumption is transferred at most once, atomically with respect to re-entrancy. +- Deep and shallow handlers behave as declared; the lowering does not silently + change the semantics. +- Captured frames keep their values valid until the resumption is dropped, resumed + to completion, or cancelled; a resumption is never retained across a + non-suspendable foreign boundary. - Closure conversion, adapters, and optimizations preserve evaluation behavior under ordinary IR contracts; they do not verify a private effect protocol. -- Aborting/resuming/replaying a continuation follows the chosen API. Native - one-shot reuse is rejected; multi-shot execution does not imply IO rollback. - Resource safety is a separate contract. A bare handler does not prove release-on-trap or prevent use-after-release. Evidence must separately cover type rejection, pure interpretation, generic -representation, observable runtime behavior, and any native control capability. -The [acceptance checklist](../../../implementation/backend/algebraic-effects.md) -records proposed requirements; none are verified by this document. +representation, the lowered control mechanism (frame identity, deep/shallow, +one-shot/multi-shot, stack safety), and any native control capability. The +[acceptance checklist](../../../implementation/backend/algebraic-effects.md) +records the requirements. ## Worked example -The following is schematic library code using the signatures above: +A schematic library program: ```purescript program :: Run (state :: StateF Int) Int @@ -312,61 +671,91 @@ result :: { state :: Int, value :: Int } result = runPure (handleState 0 program) ``` -Constructing `program` does not allocate a mutable cell or execute native IO. -Interpretation changes the handler's ordinary state value to 41, supplies 41 -to the continuation of `get`, and returns `{ state: 41, value: 42 }`. -The compiler sees constructors, functions, and calls; there is no State token -to project, no write/read dependency graph, and no operation-specific witness. +Constructing `program` does not allocate a mutable cell or execute native IO. Under +the library encoding, interpretation changes the handler's ordinary state value to +41, supplies 41 to the continuation of `get`, and returns +`{ state: 41, value: 42 }`. The compiler sees constructors, functions, and calls; +there is no State token to project, no write/read dependency graph, and no +operation-specific witness. + +Under the native mechanism, the same program is a small frame chain. Tracing the +trampoline: -Adding a Console slot leaves that slot in the residual row after `handleState`. -A pure log-collecting handler can remove it for testing. A host-writing handler -needs an explicit native IO boundary, proposed in -[native Effect/ST](native-effect-and-st-handlers.md); `runPure` cannot be used +```text +run(handleState 0 program) + Put 41 -> handler state 0 becomes 41; continue + Get k -> handler supplies 41 to k; k is a Resumption of result Int + Return(42) -> the state handler returns { state: 41, value: 42 } +``` + +Each `Put` and `Get` builds a frame from the current point to the `handleState` +delimiter, delivers it to the handler, and resumes through the trampoline. Depth of +`do` binding does not grow the native stack. + +Adding a Console slot leaves that slot in the residual row after `handleState`. A +pure log-collecting handler can remove it for testing. A host-writing handler needs +an explicit native IO boundary, proposed in the +[native Effect/ST topic](native-effect-and-st-handlers.md); `runPure` cannot be used as that boundary. ## Boundaries and interfaces -Source syntax, type arrows, and standard row rules remain unchanged. Library -type parameters express operation requirements. The compiler neither adds -ambient effect inference nor recognizes the `Run` constructor specially. +Source syntax, type arrows, and standard row rules remain unchanged. The generic +control surface is abstract and library-facing; it is not new effect syntax. The +compiler adds no ambient effect inference and does not recognize a `Run` or +`Effect` constructor specially. + +The library and the compiler divide cleanly: operations, rows, handlers, +continuation composition, and the one-shot/multi-shot API are library code; only the +suspension/delimiter/resumption mechanism and its lowering are compiler code. A +library cannot make the optimizer unsound, and the compiler cannot change an +operation's meaning. -Native services remain explicit checked bindings with ordinary value/ABI -contracts. Command execution uses an ordinary configured runner where supported, -without discovery of `Effect Unit` or hidden interpretation of operation rows. -This topic does not reopen the deleted legacy runner path. +Native services remain explicit checked bindings with ordinary value/ABI contracts. +Command execution uses an ordinary configured runner where supported, without +discovery of `Effect Unit` or hidden interpretation of operation rows. This topic +does not reopen the deleted legacy runner path. -The baseline target profile does not gain stack switching through this design. -Native resumption support requires a pinned target capability, MIR/lowering +The baseline target profile does not gain stack switching through this design. A +native resumption option requires a pinned target capability, an MIR/lowering contract, validator coverage, and actual execution evidence. An unsupported capability is an error, never a silent change to continuation semantics. ## Open questions and future work -1. Confirm whether explicit library continuations are the execution design or - whether runtime delimited control is required. The library baseline follows - DEC-03; the native alternative needs a separate reviewed decision. -2. Audit the pinned upstream Run/Free/Variant packages, their FFI, and this - compiler's generic representation support. No compile/runtime acceptance - has been measured for this proposal. -3. Validate the separate [native Effect/ST proposal](native-effect-and-st-handlers.md). +1. Confirm the final type signatures and the abstract carrier of the control + surface, including how the library links operation payload types to resumption + result types with a rank-N eliminator. +2. Fix the boundary between selective conversion and the existing tail-call, + closure, and dictionary lowerings, and specify which optimizations must treat a + suspension as observable. +3. Decide the default representation for one-shot versus multi-shot resumptions and + how a library selects each without weakening the other. +4. Derive the exact rejection rules for capturing across a host/foreign frame, + including canonical-ABI and WIT boundaries. +5. Audit the pinned upstream Run/Free/Variant packages and this compiler's generic + representation support; no compile/runtime acceptance has been measured for this + design. +6. Validate the separate [native Effect/ST proposal](native-effect-and-st-handlers.md). Its current package consumers remain unsupported after compiler cleanup. -4. If adopting native control, settle answer typing, one-/multi-shot semantics, - capture boundaries, and GC/lifetime contracts before choosing primitives. -5. Scoped/higher-order effects, bracket/finalization, async, and concurrency need - their own semantics. Ordinary first-order operation rows do not provide - those guarantees automatically. +7. Measure interpreter allocation, frame churn, and deep execution to set the + performance contract for the lowering. +8. Scoped/higher-order effects, bracket/finalization, async, and concurrency need + their own semantics. Ordinary first-order operation rows do not provide those + guarantees automatically. ## References -- [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md) and +- [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), + [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), and [compiler cleanup handoff](../../../implementation/backend/effect-state-removal-handoff-2026-10-11.md). - [PureScript Run](https://github.com/natefaubion/purescript-run) and its [API](https://pursuit.purescript.org/packages/purescript-run/5.0.0/docs/Run). - [PureScript Free](https://github.com/purescript/purescript-free) and [Stack Safety for Free](https://functorial.com/stack-safety-for-free/index.pdf). -- [Continuing WebAssembly with Effect Handlers](https://arxiv.org/abs/2308.08347), +- [Continuing WebAssembly with Effect Handlers](https://arxiv.org/abs/2308.08347) + and the [WebAssembly stack-switching proposal](https://github.com/WebAssembly/stack-switching), a proposal-level reference, not evidence of this target profile's support. - -External references were consulted earlier in this conversation. A fresh -online verification attempt on 2026-10-11 failed due to connection errors; -current upstream APIs and target support must be verified before implementation. +- [Capability profile](../wasm/capability-profile.md) and + [DEC-05](../../../decision/DEC-05-wasmtime-feature-set.md) for the target features + and the rule that runtime support is not a contract. diff --git a/docs/design/backend/fp/native-effect-and-st-handlers.md b/docs/design/backend/fp/native-effect-and-st-handlers.md index 6e30bcb2..7e36b673 100644 --- a/docs/design/backend/fp/native-effect-and-st-handlers.md +++ b/docs/design/backend/fp/native-effect-and-st-handlers.md @@ -22,9 +22,11 @@ It includes Effect.Ref, STRef, mutable-array boundaries, native execution, and the bridge from user-defined algebraic effects to native operations. It does not add syntax, ambient effect inference, primitive State types, a -special compiler-known Effect constructor, or a new execution intrinsic. -Runtime delimited continuation support remains a separate option in the -algebraic-effects topic; it is not required by this representation proposal. +special compiler-known Effect constructor, or a new execution intrinsic. The +generic handler mechanism is selected by +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md) as +compiler-generated resumable frames; this representation can be interpreted by an +explicit library interpreter or by that mechanism without changing its public API. Compiler cleanup remains in force. This design is not authorization to change the independent package, publish a lock, or claim restored runtime support. @@ -368,10 +370,12 @@ Leaf storage uses the GC language heap. Host calls retain WIT resource and canonical ABI ownership rules. A trap is not automatic finalization; resource bracketing, exceptions, and cancellation need their own explicit contracts. -This proposal neither requires runtime delimited control nor prohibits a -future implementation that preserves its native API and multiplicity. A native -continuation implementation must meet the separate control obligations before -replacing explicit library continuations. +This proposal uses the generic handler mechanism selected by DEC-19 but does not +require target stack switching, and it does not prohibit a future target option +that preserves its native API and multiplicity. Any target continuation +implementation must meet the separate control obligations in the +[algebraic-effects topic](algebraic-effects-and-handlers.md) before replacing +compiler-generated frames. ## Open questions and future work diff --git a/docs/feature/F-02-portable-programs.md b/docs/feature/F-02-portable-programs.md index 2280a43b..5ab8de5b 100644 --- a/docs/feature/F-02-portable-programs.md +++ b/docs/feature/F-02-portable-programs.md @@ -15,10 +15,11 @@ compatible portable environment. A proposed library-level algebraic effects API would let programs describe operations and supply different handlers for production and testing, using -existing PureScript syntax and types. A separate draft proposes implementing -the official Effect/ST APIs over library native handlers while preserving -their public contracts. Neither proposal is an implemented capability or an -accepted native representation. +existing PureScript syntax and types. The representation for the generic handler +mechanism is recorded as a decision ([DEC-19](../decision/DEC-19-compiler-generated-resumable-frames.md)); +a separate draft proposes implementing the official Effect/ST APIs over library +native handlers while preserving their public contracts. None of these proposals +is an implemented capability yet. The intended workflow is: diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 51c19403..c300fc47 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -2,12 +2,17 @@ **Status:** Design only; all requirements below are Unverified. **Design:** [Library-owned algebraic effects and handlers](../../design/backend/fp/algebraic-effects-and-handlers.md). +**Decision:** [DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md) +selects compiler-generated resumable frames as the generic handler/interruption +mechanism. **Date:** 2026-10-11. This checklist records evidence required for a future implementation. Creating -it does not resume the withdrawn State migration, select native Effect/ST -representation, or authorize native continuation primitives. Compiler cleanup -and runtime build-tool changes are separate work. +it does not resume the withdrawn State migration or select native Effect/ST +representation. Compiler cleanup and runtime build-tool changes are separate +work. The `AC-*` obligations are **required**, not conditional: DEC-19 selected +the generic control mechanism, implemented as compiler-generated resumable +frames rather than target stack switching. | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | @@ -23,16 +28,17 @@ and runtime build-tool changes are separate work. | AE-10 | Source fidelity is preserved | Independent package audit with pinned revisions; every target adaptation has a concrete representation reason | Unverified | | AE-11 | Host interpretation uses a defined native IO boundary | Separate selected ABI design and actual host behavior evidence; a pure handler test is insufficient | Unverified | -If native delimited control is selected, these additional obligations become -required. They remain Unverified, not implicitly satisfied by library encoding: +The generic control mechanism selected by DEC-19 adds these required +obligations. They remain Unverified; library encoding alone does not satisfy +them: | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | -| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 disposition and complete request/result/answer and row contracts | Unverified | -| AC-02 | Runtime can capture and resume using the selected representation | Actual target execution, supported frame boundaries, capability gating, and unavailable-capability rejection | Unverified | +| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 amendment (DEC-19) and complete suspension/delimiter/resumption contracts | Unverified | +| AC-02 | The selected representation can capture and resume | Actual target execution of resumable frames at supported boundaries, stack safety, and capability gating; no silent fallback | Unverified | | AC-03 | Resumption multiplicity and lifetime are enforced | Double resume, re-entrant resume, cancellation, non-resuming clauses, and expired-boundary tests | Unverified | | AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Unverified | -| AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior | Unverified | +| AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior; suspension is not optimized away | Unverified | No runtime or differential validation was run for this design. Record future evidence with compiler/package identities, commands, actual outputs, and any From a3c4f141728e67caa552b90d0739c0d752113d0b Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 16:50:06 +0800 Subject: [PATCH 096/148] Split delimited control out of the effects design and fix its scope Add delimited-control-and-resumable-frames.md as the compiler mechanism topic: the effect-agnostic Control f a surface with return/bind/perform/run, its Prim.Control identity, the selective CPS / defunctionalized-frame lowering and trampoline, deep/shallow and one-shot/multi-shot representation, and the comparison with WebAssembly stack switching. Trim algebraic-effects-and-handlers.md to the library-owned model (operation functors, handlers, residual rows, and the Run wrapper) and remove the content now owned by the mechanism topic. Make the scope explicit: the type system gains no effect rows, no effect tracking, and no effect reasoning; effect requirements are ordinary library types. Update DEC-19 and the backend index to match, and rewrite the Open questions as decisions. Add the representation prototype test (rank-N heterogeneous request transport and the common Effect/ST field, executed under wasmtime) and record it in the acceptance checklist. --- .../tests/effect_representation.rs | 115 +++ ...-19-compiler-generated-resumable-frames.md | 12 +- docs/design/backend/README.md | 5 +- .../fp/algebraic-effects-and-handlers.md | 711 +++++------------- .../delimited-control-and-resumable-frames.md | 555 ++++++++++++++ .../backend/algebraic-effects.md | 26 +- 6 files changed, 876 insertions(+), 548 deletions(-) create mode 100644 crates/psrs-driver/tests/effect_representation.rs create mode 100644 docs/design/backend/fp/delimited-control-and-resumable-frames.md diff --git a/crates/psrs-driver/tests/effect_representation.rs b/crates/psrs-driver/tests/effect_representation.rs new file mode 100644 index 00000000..b767e111 --- /dev/null +++ b/crates/psrs-driver/tests/effect_representation.rs @@ -0,0 +1,115 @@ +//! Prototype acceptance for the library-owned algebraic-effects representation. +//! +//! Before the native handler mechanism selected by +//! [DEC-19](../../../docs/decision/DEC-19-compiler-generated-resumable-frames.md) +//! is lowered, the [algebraic-effects design](../../../docs/design/backend/fp/algebraic-effects-and-handlers.md) +//! requires validating the shared generic representation: a rank-N +//! heterogeneous request transport and the common computation type the official +//! Effect/ST facades share. This test pins that representation and its pure +//! interpretation. It does not claim the compiler-generated resumable-frame +//! mechanism, and it is not standard-library migration evidence. + +use std::process::Command; + +/// A rank-N eliminator whose method is itself rank-1 polymorphic transports a +/// typed payload and continuation. `Effect` and `ST` wrap the same `Free` field, +/// and `toEffect = unsafeCoerce` is the common Global conversion. +const COMMON_REPRESENTATION: &str = r#"module Main where + +import Unsafe.Coerce (unsafeCoerce) + +data Request next = Request + (forall z. { run :: forall a. a -> (a -> next) -> z } -> z) + +data Free a = Pure a | Step (Request (Free a)) + +newtype Effect a = Effect (Free a) +newtype ST a = ST (Free a) + +toEffect :: forall a. ST a -> Effect a +toEffect = unsafeCoerce + +mk :: forall a. a -> Request (Free a) +mk value = Request \ops -> ops.run value Pure + +step :: forall a. a -> Free a +step value = Step (mk value) + +interp :: forall a. Free a -> a +interp (Pure a) = a +interp (Step k) = case k of + Request f -> interp (f { run: \x next -> next x }) + +stProg :: ST Int +stProg = ST (step 42) + +main :: Int +main = case toEffect stProg of + Effect f -> interp f +"#; + +/// A request transports its payload and continuation at one result type; using +/// the request itself where its result type is wanted must be rejected. +const REQUEST_IS_NOT_ITS_RESULT: &str = r#"module Main where + +data Request next = Request + (forall z. { run :: forall a. a -> (a -> next) -> z } -> z) + +data Free a = Pure a | Step (Request (Free a)) + +mk :: forall a. a -> Request (Free a) +mk value = Request \ops -> ops.run value Pure + +bad :: Int +bad = Step (mk 42) +"#; + +#[test] +fn common_representation_checks() { + if let Err(errors) = psrs_driver::check_source("Main.purs", COMMON_REPRESENTATION) { + panic!("common representation rejected: {errors:?}"); + } +} + +#[test] +fn a_request_is_not_interchangeable_with_its_result() { + assert!( + psrs_driver::check_source("Main.purs", REQUEST_IS_NOT_ITS_RESULT).is_err(), + "a request used as its own result type must be rejected" + ); +} + +#[test] +fn executes_a_pure_handler_over_the_shared_representation() { + let available = Command::new("wasmtime") + .arg("--version") + .output() + .is_ok_and(|output| output.status.success()); + if !available { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "the pure-handler execution requires wasmtime" + ); + eprintln!("skipping effect-representation execution: wasmtime is unavailable"); + return; + } + let artifact = psrs_driver::compile_source("Main.purs", COMMON_REPRESENTATION) + .expect("compile the common representation"); + let path = std::env::temp_dir().join(format!( + "psrs-effect-representation-{}.wasm", + std::process::id() + )); + std::fs::write(&path, &artifact.wasm).expect("write component"); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .expect("run component"); + let _ = std::fs::remove_file(path); + assert_eq!( + output.status.code(), + Some(42), + "expected the pure handler to return 42, got {output:?}" + ); +} diff --git a/docs/decision/DEC-19-compiler-generated-resumable-frames.md b/docs/decision/DEC-19-compiler-generated-resumable-frames.md index 1f191a05..23b6fa3a 100644 --- a/docs/decision/DEC-19-compiler-generated-resumable-frames.md +++ b/docs/decision/DEC-19-compiler-generated-resumable-frames.md @@ -4,8 +4,9 @@ **Date:** 2026-10-11 **Amends:** [DEC-03](DEC-03-purescript-faithful-type-system.md), the clause that keeps delimited continuations out of every IR. -**Governed by:** [F-02](../feature/F-02-portable-programs.md) and -[algebraic effects and handlers](../design/backend/fp/algebraic-effects-and-handlers.md). +**Governed by:** [F-02](../feature/F-02-portable-programs.md), +[delimited control and resumable frames](../design/backend/fp/delimited-control-and-resumable-frames.md), +and [library-owned algebraic effects](../design/backend/fp/algebraic-effects-and-handlers.md). ## Context and constraints @@ -67,7 +68,10 @@ DEC-03's prohibition of delimited continuations in the IRs is narrowed: a the backend MIR), and a small abstract control surface may appear at the boundary that the library builds on. DEC-03's type-system decision is retained: there are no frontend effect rows, no compiler-known handlers, and no compiler-native effect -system; effects remain a library encoding. +system; effects remain a library encoding. No effect tracking or effect reasoning +is added to the type system: the compiler does not infer, propagate, or solve +effect requirements, and does not reason about which effects a function may +perform. ## Alternatives considered @@ -102,6 +106,6 @@ system; effects remain a library encoding. host/foreign frame, multi-shot replay of mutable state, and continuation lifetime are explicit contracts, not automatic guarantees. - The design document - [`algebraic-effects-and-handlers.md`](../design/backend/fp/algebraic-effects-and-handlers.md) + [`delimited-control-and-resumable-frames.md`](../design/backend/fp/delimited-control-and-resumable-frames.md) is the source of truth for the mechanism, its lowering, and the comparison with stack switching. Implementation follows it. diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index 098ff07a..353bc2bc 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -54,8 +54,9 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [pattern-matching.md](fp/pattern-matching.md) | Pattern decision trees and exhaustiveness | cc-ir | | [control-flow-and-tail-calls.md](fp/control-flow-and-tail-calls.md) | CFG structuring, `Switch`, tail calls | mir | | [type-classes-and-dictionaries.md](fp/type-classes-and-dictionaries.md) | Dictionary passing and instance evidence | functional-core | -| [algebraic-effects-and-handlers.md](fp/algebraic-effects-and-handlers.md) | Library operation rows and handlers; the generic suspension/handler mechanism and its compiler-generated resumable-frame lowering (**Draft design**) | DEC-03, DEC-19, ordinary rows/classes, functional-core, capability-profile, runtime linking | -| [native-effect-and-st-handlers.md](fp/native-effect-and-st-handlers.md) | Official Effect/ST facades, common native computation, typed storage/host handlers, and region safety (**Draft proposal**) | algebraic effects, roles, rank-N, runtime linking | +| [algebraic-effects-and-handlers.md](fp/algebraic-effects-and-handlers.md) | Library operation functors, handlers, residual rows, and the `Run` wrapper over the control surface (**Draft design**) | DEC-03, delimited control, ordinary rows/classes, functional-core | +| [delimited-control-and-resumable-frames.md](fp/delimited-control-and-resumable-frames.md) | Effect-agnostic delimited control (`Control f a` with `return`/`bind`/`perform`/`run`) and its selective CPS / defunctionalized-frame lowering (**Draft design**) | DEC-03, DEC-19, cc-ir, mir, control-flow-and-tail-calls, capability-profile | +| [native-effect-and-st-handlers.md](fp/native-effect-and-st-handlers.md) | Official Effect/ST facades, common native computation, typed storage/host handlers, and region safety (**Draft proposal**) | algebraic effects, delimited control, roles, rank-N, runtime linking | | [effects.md](fp/effects.md) | Effect representation and the platform boundary (**withdrawn 2026-10-11**; replacement undecided) | functional-core | | [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics and cross-pass dependencies (**withdrawn 2026-10-11**) | primitive types, functional-core, CC, MIR | | [library-owned-effects.md](fp/library-owned-effects.md) | Ordinary Effect/ST newtypes, runtime adapters, command runner (**withdrawn 2026-10-11**) | State primitives and dependency lowering, source fidelity | diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index 4727ab0f..a27ca267 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -1,72 +1,71 @@ # Library-Owned Algebraic Effects and Handlers **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) -**Status:** Draft design. The generic mechanism and its representation are -selected by [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md); +**Status:** Draft design. The execution mechanism is selected by +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md) and +specified in [delimited control and resumable frames](delimited-control-and-resumable-frames.md); the lowering is not implemented. **Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), -[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), [functional Core](../../frontend/semantics/functional-core.md), [rows and records](../../frontend/type-system/rows-and-records.md), -[representation and evidence](representation-and-evidence.md), -[control flow and tail calls](control-flow-and-tail-calls.md), -[capability profile](../wasm/capability-profile.md), and -[runtime linking](../wasm/linking-and-runtime.md). +[representation and evidence](representation-and-evidence.md), and +[delimited control and resumable frames](delimited-control-and-resumable-frames.md). **Summary:** Algebraic operations and their handlers are library values, checked -with ordinary PureScript types and rows. The compiler owns only a generic, -effect-agnostic suspension/handler mechanism, lowered to explicit resumable frames -(a selective, defunctionalized CPS) that need no new target capability. Runtime -delimited control through WebAssembly stack switching is a separately reviewed -target option, not an assumed ability of an ordinary Wasm import. +with ordinary PureScript types and rows. The compiler owns only the effect-agnostic +control mechanism the handlers run on, specified separately. This document owns the +library model — operations, handler composition, row-based requirements, residual +rows, and how the library sits on that mechanism. ## Scope This document owns the meaning of library-defined algebraic operations, handler -composition, row-based operation requirements, and continuation boundaries. It -also owns the generic control mechanism that makes such handlers executable — the -suspension, delimiter, and resumption primitives — and their lowering through MIR -to Wasm, including the comparison with native stack switching. - -The following are separate decisions: official Effect/ST representation and source -adaptation (proposed in the [native topic](native-effect-and-st-handlers.md)), a -native effect type system, new source syntax, resource-ownership types, async -scheduling, and target stack switching. Designing algebraic effects does not -authorize rebuilding the withdrawn compiler-owned `Effect` or `State` -mechanisms, nor adding effect rows or handlers to the type system. - -The proposal follows DEC-03's library encoding and the mechanism decision in -DEC-19. DEC-19 narrowly amends DEC-03's blanket exclusion of delimited -continuations below Typed Core; the type-system decision is unchanged. Any option -that needs a new target capability or a new frontend feature must be reviewed -against DEC-03 before it is selected, and this document does not silently amend -that accepted decision. +composition, row-based operation requirements, residual rows, and the library API +that builds on the compiler's control surface. + +It does not own the control mechanism itself — the `Control f a` carrier, the +`return`/`bind`/`perform`/`run` primitives, and their lowering — which is +[delimited control and resumable frames](delimited-control-and-resumable-frames.md). +It also does not own the official Effect/ST representation +([native topic](native-effect-and-st-handlers.md)), a native effect type system, new +source syntax, resource-ownership types, async scheduling, or target stack +switching. + +The proposal follows DEC-03's library encoding. It does not reauthorize the +withdrawn compiler-owned `Effect` or `State` mechanisms. + +**The type system is unchanged.** This design adds no effect rows, no effect +tracking, and no effect reasoning — no effect inference, propagation, subsumption, +or solving — to CST, AST, HIR, THIR, or Typed Core. An "operation requirement" is an +ordinary library type: a computation value parameterized by its request functor (or +by a row of request functors), checked with the ordinary kind, row, and class rules. +The compiler never reasons about which effects a function may perform. ## Background ### What algebraic effects are -Algebraic effects and handlers separate the *description* of an effectful -operation from its *interpretation*. A computation performs an operation; a -**handler** around that computation decides what the operation means. +Algebraic effects and handlers separate the *description* of an effectful operation +from its *interpretation*. A computation performs an operation; a **handler** around +that computation decides what the operation means. - An **operation** (also called a request) is a value describing what the program - wants to do: "read the current state", "print this line", "get the clock time". - It names a *result type* but not the way the result is produced. -- An **operation signature** is a set of operations, for example - `Get : Unit -> S` and `Put : S -> Unit`. + wants to do: "read the current state", "print this line", "get the clock time". It + names a *result type* but not the way the result is produced. +- An **operation signature** is a set of operations, for example `Get : Unit -> S` + and `Put : S -> Unit`. - A **computation** is a value that may perform operations before it returns its result; its type records the result and the operations it may expose. - A **handler** interprets the operations of one signature. It receives each - operation together with a **continuation** — the rest of the computation from - just after the performed operation — and chooses what to do with it. -- A **continuation** (also called a **resumption**) represents "the remainder". - A handler may call it zero times (abort), exactly once (resume), or several - times (replay). + operation together with a **continuation** — the rest of the computation from just + after the performed operation — and chooses what to do with it. +- A **continuation** (also called a **resumption**) represents "the remainder". A + handler may call it zero times (abort), exactly once (resume), or several times + (replay). - A **delimiter** is the boundary within which a handler is installed. Capturing a continuation stops at that boundary. - A **deep handler** installs itself again for every request made after a - resumption; a **shallow handler** interprets only the current request and runs - the remainder without reinstalling itself. + resumption; a **shallow handler** interprets only the current request and runs the + remainder without reinstalling itself. - A **one-shot** continuation may be resumed at most once; a **multi-shot** continuation may be resumed arbitrarily many times. - The **residual row** is the set of operations not handled by a given handler, @@ -89,12 +88,12 @@ data StateF s next `Get` carries its result as a function argument (`s -> next`); `Put` has a unit result (`next` alone). A `Functor` instance lets operations be composed without -knowing their meaning. The same console operation can write to a terminal or -append to a test log; the same state operations can thread a pure value or use -mutable storage. The operation says *what*, the handler says *how*. +knowing their meaning. The same console operation can write to a terminal or append +to a test log; the same state operations can thread a pure value or use mutable +storage. The operation says *what*, the handler says *how*. -The name "algebraic" comes from the interpretation: operations form a signature, -and handlers are algebras over it, obeying the laws the signature declares. The +The name "algebraic" comes from the interpretation: operations form a signature, and +handlers are algebras over it, obeying the laws the signature declares. The implementation does not need to understand the theory; it only needs ordinary values, functions, and a way to capture and resume a continuation. @@ -104,44 +103,42 @@ the computation, possibly more than once. That single difference is what require continuations. PureScript already provides the types to *describe* all of this: algebraic data -types, functions, higher-kinded types, type classes, rank-N polymorphism, -ordinary rows, and monadic `do`. `purescript-run` encodes extensible operations -using `Free` and `VariantF`; its handlers are ordinary interpreters. That -establishes expressibility in the language, not an execution strategy. +types, functions, higher-kinded types, type classes, rank-N polymorphism, ordinary +rows, and monadic `do`. `purescript-run` encodes extensible operations using `Free` +and `VariantF`; its handlers are ordinary interpreters. That establishes +expressibility in the language, not an execution strategy. An operation row is a library parameter, not a second effect system attached to every function arrow. Its constraints describe which requests a computation can -expose. They do not prove single use, termination, absence of unsafe FFI, or -correct resource release. +expose. They do not prove single use, termination, absence of unsafe FFI, or correct +resource release. -### Two ways to execute a handler +### Encoding operations without native GADTs or existentials -Once handlers are expressible, they still have to run. There are exactly two -execution strategies. +The language has no native GADT or existential syntax. `purs 0.15.16` rejects +`data Box = forall a. Box a` at parse time, while a rank-N field such as +`data Box = Box (forall a. a -> a)` is accepted. GADTs therefore have no direct +form, and an indexed operation cannot be written with a native existential. -1. **Library encoding.** Operations are data constructors, a computation is an - ADT, and a handler is a recursive interpreter. Binding builds a tree without - performing requests. This is portable and needs no compiler support, and it is - the default baseline of DEC-03. Its costs are indirect style (all effectful - code lives in the monad) and stack safety that depends on a library trampoline - rather than a compiler guarantee. +Existentials are nonetheless a standard library encoding. The vendored `Data.Exists` +provides `Exists f` (isomorphic to `exists a. f a`) through `mkExists`/`runExists` +over an internal `unsafeCoerce`; its rank-N eliminator compiles and runs on this +target (verified 2026-10-11), and the hidden type variable must not escape the +eliminator's result. A library may therefore encode a typed request with `VariantF` +and rows, with `Data.Exists`, or with a rank-N eliminator, and the choice is the +library's. -2. **Native delimited control.** The compiler provides a generic way to suspend - the current computation and capture the remainder, and a handler is ordinary - code that receives an operation and a resumption and decides whether to resume. - Effectful code keeps its direct style, and the compiler can guarantee stack - safety. This requires a compiler/runtime mechanism, which DEC-19 selects. - -Neither strategy changes what operations, rows, or handlers mean; they differ only -in how a continuation is represented and resumed. +The compiler-facing control surface is independent of that choice: its request +functor is opaque, so how a request carries its own payload/result relation never +reaches the compiler. ### What the compiler must not know The compiler never learns what a particular operation means. It does not recognize -the spelling `State`, `Console`, `Run`, or `Effect`, does not inspect a handler -body to infer a hidden protocol, and keeps no operation graph, frozen source -inventory, or cross-pass witness. It owns only an abstract suspension boundary and -its representation. Everything specific — the operation signatures, the handler +the spelling `State`, `Console`, `Run`, or `Effect`, does not inspect a handler body +to infer a hidden protocol, and keeps no operation graph, frozen source inventory, +or cross-pass witness. It owns only the abstract control surface and its +representation. Everything specific — the operation signatures, the handler interpretations, the residual rows, and the continuation-composition policies — belongs to library code. @@ -184,93 +181,26 @@ runPure :: forall a. Run () a -> a ``` Row membership and removal use ordinary row relations and library evidence. The -actual API must preserve the upstream row constraints, including label absence -where needed. State here is an ordinary value `s`, not a primitive token. +actual API must preserve the upstream row constraints, including label absence where +needed. State here is an ordinary value `s`, not a primitive token. A handler handles its selected slot and forwards every other request with a continuation that re-enters the handler (deep semantics). Distinct instances use -distinct labels; a duplicate-label or shadowing policy must be explicit rather -than relying on a silent row-map collapse. - -### The generic control model - -The compiler-owned model is deliberately smaller than any effect API. It consists -of four abstract notions. - -- **A computation carrier** `Control a`: an opaque type for "a computation that - yields `a` and may suspend". Only the primitives below inspect it; no pass - pattern-matches on a concrete operation. -- **Suspension**: a primitive that captures the current continuation up to the - nearest delimiter, delivers an opaque, library-typed payload to that - delimiter's handler, and waits for a result of the suspension's result type. -- **A delimiter/handler boundary**: a primitive that installs a handler over a - computation. The handler receives each suspension's payload and its resumption - and returns the computation's overall answer. -- **A resumption** `Resumption a`: an abstract, typed value representing a captured - continuation whose result type is `a`. Resuming applies it to a value of that - type. - -The essential, effect-agnostic contracts — the ones the compiler guarantees and -the ones that make concrete effects safe — are: - -- A suspended payload is delivered unchanged to its delimiter; the compiler never - inspects or reinterprets it. -- A resumption is resumed at exactly the result type at which it suspended. The - compiler preserves this relationship through erasure, boxing, and call - adaptation; it cannot be exchanged for an unrelated result type. -- A resumption captures only up to its delimiter. Frames outside the delimiter are - not part of it. -- A resumption's lifetime is bounded by its delimiter, and the values it captured - remain valid for as long as the resumption is live (they are GC roots). -- Resumption multiplicity is an API property. A one-shot resumption is consumed by - its first resume; a multi-shot resumption is persistent. The compiler provides - the representation and the check; the library chooses which API it exposes and - may not silently change one into the other. - -Because the payload and the resumption's result type are related existentially, -the surface is stated as a contract rather than a single surface type; the exact -signatures, and the rank-N eliminator that recovers per-operation typing, are -settled with the implementation. The contracts above are normative: - -```text -Control a -- computation yielding an a that may suspend -Request -- an opaque, library-typed request value -Resumption -- a captured continuation yielding an a - -suspend : Request -> Control a - -- capture the continuation up to the nearest delimiter and deliver a - -- request; the suspension's own result type is the a - -handle : Handler -> Control a -> Answer - -- install a delimiter; the handler receives each Request together with the - -- Resumption for that suspension's own result type a, and returns the - -- delimiter's Answer - -resume : Resumption -> a -> Control a - -- resume a captured continuation at its own result type -``` +distinct labels; a duplicate-label or shadowing policy must be explicit rather than +relying on a silent row-map collapse. -The payload type and the resumption's result type are linked by the library, not -by this surface: the library encodes typed requests with a rank-N eliminator, as -the [native topic](native-effect-and-st-handlers.md) sketches for heterogeneous -storage requests. The primitive only has to preserve the resumption's result type -and deliver the payload opaquely. +### Handler semantics -### Deep versus shallow, one-shot versus multi-shot +Deep and shallow are properties of a handler and are not part of the control +surface. A deep State handler carries its state value forward and reinstalls itself +around the continuation, so later requests at the same slot are handled again; a +shallow handler returns control outside the delimiter after the current request. +The library chooses by how it calls the continuation inside its `run` handler. -Deep and shallow are properties of a handler, expressed by whether the library -reinstalls the handler around the resumption. A deep state handler carries its -state value forward and handles later requests at the same slot; a shallow handler -returns control to the code outside the delimiter after the current request. - -One-shot and multi-shot are properties of the resumption. The portable library -encoding is naturally multi-shot: continuations are persistent data, so replaying -one re-runs the interpreted remainder, and replaying does not roll back mutations -or external IO already performed by another branch. A native one-shot API is -naturally cheap because the captured frames can be consumed. Existing PureScript -arrows are unrestricted, so hiding a constructor or adding a nominal parameter -does not by itself stop a caller from invoking a value twice; a one-shot guarantee -must be checked at the representation boundary, not asserted by the type. +A handler that does not handle a request forwards it, and the residual row describes +exactly what remains. A pure handler collects or discards a slot for testing; a +handler that reaches a host service needs an explicit native boundary, proposed in +the [native Effect/ST topic](native-effect-and-st-handlers.md). ## Design @@ -279,229 +209,60 @@ must be checked at the representation boundary, not asserted by the type. | Owner | Responsibility | | --- | --- | | Type system | Ordinary kinds, rows, class evidence, quantifiers, roles, constructor visibility, and applicable region constraints. No effect rows or handlers. | -| Library | Operation signatures, computation construction, handler interpretation, residual operation rows, continuation composition, and one-shot/multi-shot API choice. | -| Compiler | The abstract control surface; strict evaluation; ordinary closures/ADTs/dictionaries; generic calls and ABI checks; the selective CPS/defunctionalization lowering and its verification; sound optimization. | +| Library | Operation signatures and functors, computation construction, handler interpretation, residual rows, continuation composition, and the one-shot/multi-shot API choice. | +| Compiler | The effect-agnostic `Control f a` carrier, `return`/`bind`/`perform`/`run`, and the selective CPS/defunctionalization lowering — owned by [delimited control and resumable frames](delimited-control-and-resumable-frames.md). | | Runtime | Real IO/storage primitives; an optional trampoline or driver; if separately adopted, target stack switching and native resumption lifetime checks. | -| Target profile | Explicitly adopted Wasm features and rejection of unavailable capabilities. | No pass discovers an operation by the spelling `State`, `Console`, `Run`, or -`Effect`. No pass interprets handler source to infer a hidden protocol. Generic -type, representation, and CFG verification remain required. The compiler preserves -observable calls and traps even when their results are unused; a library cannot -make an optimizer sound by providing a handler. - -### The effect-agnostic control surface - -The compiler owns only the four notions of the [control model](#the-generic-control-model). -It carries no operation registry and adds no operation-specific solver. The surface -is exposed to source as an abstract typed API; a library in the independent -standard library wraps it into whatever operation/handler API users see. Because -the surface is abstract, a raw capture cannot inhabit an unrestricted pure function -type while changing its control behavior: the caller must use `Control`, -`Resumption`, and the primitives, whose types state the suspension. - -The surface must be declared with a stable identity and a checked type contract, -like other compiler primitives. It is not a host import and not a WIT binding: it -has no runtime implementation of its own, because the lowering produces ordinary -guest code. - -### Lowering: selective CPS to resumable frames - -The mechanism is implemented by compiling the regions that can suspend into an -explicit continuation representation. The concept is **continuation-passing style -(CPS)**; the representation is **defunctionalized resumable frames** driven by a -**trampoline**. - -#### CPS in one paragraph - -In direct style, a function `f :: A -> B` returns its result to its caller, and -the caller's remaining work lives in the engine's execution stack. In CPS, the -same function becomes `A -> (B -> r) -> r`: it does not return; it calls a -**continuation** `k` that names the rest of the computation. Every call can then be -a tail call, so the "rest" is a value (`k`) rather than a stack of return -addresses. Capturing a continuation is, conceptually, taking that `k` and keeping -it. Resuming it is calling it. - -The concept alone is not enough, for two reasons specific to this target: - -1. **Capture needs reification.** If the "rest" is spread across the live Wasm - stack, it cannot be stored, passed to a handler, inspected, or resumed twice. - The continuation must be **data**. -2. **Stack safety must not depend on the engine.** The pinned profile enables tail - calls, so pure closure-CPS can be stack-safe, but a captured continuation - still needs a representation the compiler can reason about. - -The lowering therefore *defunctionalizes* CPS: instead of closures, a continuation -is an explicit chain of **frame objects** in the GC heap, and a loop runs the -machine one frame at a time. - -#### Selective conversion - -Converting a whole program to CPS would be slow and would change the representation -of code that never suspends. The compilation is **selective**: - -- A function is *convertible* when it can reach a suspension in its dynamic extent - — directly, through a call, or through a value it invokes. -- Only convertible functions are lowered to resumable form. Pure, non-convertible - functions keep the ordinary direct representation and calling convention. -- A suspension converts exactly the region from the suspension point out to its - delimiter; frames below the delimiter are ordinary calls and are not captured. - -Selectivity keeps the lowering proportional to the effectful part of the program -and keeps pure code fast. It is also where optimization interacts with the -mechanism: an inliner or specializer must not merge a convertible function into a -non-convertible one without preserving the conversion of the merged region, nor -erase a suspension whose result is unused, because the suspension is observable -control, not a pure computation. - -#### Frame construction - -Each step of a converted computation is represented by a frame. A frame stores: - -- the free variables the step needs (its captured environment), -- a small tag identifying which continuation step it is ("after the `Get`, apply - this function to the read value"), -- the pointer to the next frame (the previously captured remainder). - -A suspension builds a frame chain from the current point out to the delimiter, -hands the opaque payload and a `Resumption` (a handle to the chain) to the -handler, and stops running the current computation. `resume` reinstalls the chain -and supplies the response as the step's result. Frames are ordinary GC objects, so -captured references are roots the engine scans automatically; this is a decisive -advantage over capturing a raw execution stack, where the runtime must establish -stack maps to find roots. - -#### The trampoline - -A **trampoline** is the loop that runs the machine: +`Effect`. No pass interprets handler source to infer a hidden protocol. Generic type, +representation, and CFG verification remain required. -```text -run(state): - loop: - step = state.current - match step: - Return(v) -> return v - Eval(frame) -> state.current = frame.step(state) - Suspend(payload, k) -> state = call_handler(payload, k) // may return - Resume(k, v) -> state.current = k.install(v) +### The library on the control surface + +The library builds on the compiler's surface — `Control f a` with `return`/`bind`/ +`perform`/`run`, specified in +[delimited control and resumable frames](delimited-control-and-resumable-frames.md). +It defines its computation as that carrier over an operation functor: + +```purescript +type Run r a = Control (VariantF r) a ``` -Because the loop drives every step, the native Wasm stack does not grow with the -depth of binds or with long request sequences. Deep recursion in direct style -becomes bounded frame churn, the same way a self tail call becomes a loop. Using -`return_call`/`return_call_ref` for the tail positions of the emitted steps keeps -the constant-stack property even where the machine calls into ordinary code. - -#### Deep and shallow handlers - -The delineated region is a marker in the frame chain. A **deep** handler is one -whose resumption re-installs the handler before continuing, so subsequent requests -at the same delimiter are handled again; the lowering wraps the resumed chain with -the handler frame. A **shallow** handler resumes the chain without re-wrapping, so -the handler runs once and later requests escape to an outer delimiter. The library -selects the semantics; the lowering must implement both and must not silently -deepen or shallow a handler. - -#### One-shot and multi-shot - -The frame chain is the resumption. Two representations are possible: - -- **Persistent frames** (the natural multi-shot representation): a resumed frame is - not mutated, so the same `Resumption` may be resumed again. Replay re-runs the - captured remainder against the handler's supplied values. Mutable references and - external IO already performed by another branch are shared, exactly as the pure - model requires; multi-shot execution does not roll back IO. -- **Owned frames** (the one-shot representation): a `Resumption` holds a status of - `Pending`, `Running`, `Consumed`, or `Cancelled`. The first `resume` atomically - transitions out of `Pending`; a second attempt is rejected rather than silently - reinterpreted. Transfer must be atomic with respect to re-entrancy, so a - re-entrant resume of a running resumption fails rather than corrupting the chain. - -The two are distinct APIs. An optimization may not turn a multi-shot resumption -into a one-shot one. - -#### Lifetime, GC roots, and abandonment - -A resumption keeps its captured frames reachable, so anything those frames captured -stays alive until the resumption is dropped, resumed to completion, cancelled, or -abandoned. When a handler returns without resuming, its resumption becomes -unreachable and the GC reclaims the frames. The compiler must not drop a live -resumption to an optimization, and must not let a dead one keep roots alive beyond -its contract. - -#### Foreign-call boundaries - -Suspension cannot cross a non-suspendable host or foreign frame: a captured -continuation that spans a canonical-ABI call or an in-progress WIT import cannot -be resumed without that boundary's cooperation. The lowering rejects a conversion -that would capture across such a boundary unless the boundary declares an explicit -suspension protocol. The same rule applies to a canonical ABI buffer: a resumption -cannot retain a borrowed buffer or a host-resource reference past the boundary's -lifetime. - -### Compiler CPS versus native stack switching - -DEC-19 selects compiler-generated frames. The alternative, WebAssembly stack -switching, is a real implementation with different trade-offs. This section is the -comparison the mechanism decision rests on. - -The two implementations differ in where the "remainder" lives. **Native stack -switching** extends the instruction set with a continuation reference type and -`suspend`/`resume` instructions: a delimiter becomes a continuation object, and -suspending captures the current execution stack into it, which the runtime -relocates off the main Wasm stack; resuming reinstalls the captured segment. The -runtime must then scan captured stack slots for GC roots. **Compiler CPS** never -touches the execution stack: the compiler rewrites the functions that can suspend -into a state machine whose states are explicit GC frame objects, and a work-loop -(trampoline) drives them, so the "remainder" is ordinary heap data the GC already -understands. - -| Dimension | Compiler resumable frames (CPS/defunctionalized) | Native stack switching | -| --- | --- | --- | -| Standardization | Uses standardized Wasm 3.0 features (GC, function references, tail calls) already in the profile | A Phase 3 proposal, not merged into the core specification; semantics may still change | -| Runtime enablement | Runs on the default pinned runtime: those features are on by default | Wasmtime disables it by default; it additionally depends on the `exceptions` feature, which this profile disables | -| Portability | Any engine implementing the pinned profile | Only engines implementing the proposal with the matching configuration | -| What is captured | An explicit heap chain of frame objects | The live Wasm execution stack (a continuation object) | -| Capture cost | Allocates frame records proportional to the captured region; selective conversion limits it to the effectful part | The runtime captures or switches a stack segment; cost scales with the stack being captured | -| Cost on non-suspending code | Pure code stays direct; only convertible regions pay per-step frame cost | Direct code is unchanged; the runtime's switching machinery is present regardless | -| Stack safety | A trampoline gives constant native stack independent of bind depth and of the engine | Depends on the runtime moving captured stacks off the main stack; not a compiler guarantee | -| GC/roots | Frames are GC values; captured roots are scanned automatically | Captured stack slots need runtime stack maps; GC/continuation integration is the runtime's responsibility | -| One-shot/multi-shot | Explicit: persistent frames are multi-shot, owned frames are one-shot and checkable | The runtime captures a stack; multi-shot requires cloning it; one-shot is the natural case | -| Foreign boundary | The compiler statically rejects capturing across a non-suspendable host frame | `suspend` also cannot cross a host frame; the proposal defines which frames are capturable | -| Compiler complexity | Large: selective conversion, frame identity, lifetime, and optimization interaction are new obligations in MIR and its verifier | Smaller in the compiler, but the artifact depends on a target feature and the runtime must be configured for it | -| Optimizability | Frames are explicit and inspectable; every pass must preserve frame identity and suspension observability | Capture points are opaque to the compiler, so it cannot reorder or eliminate them, but it also cannot reason about them | -| Verification | Fits the existing MIR/Wasm pipeline; verified and executed under the pinned runtime | Needs a validator built with the proposal enabled and a runtime so configured | -| Principal risk | High implementation cost and subtle frame/lifetime bugs | Dependence on a moving proposal and a non-default runtime configuration | - -In short: stack switching moves the difficult part (capturing and rooting a live -stack) into the runtime and the standard, at the cost of an unstable, off-by-default -target feature. Compiler frames move it into the compiler, at the cost of a new -lowering, but keep the artifact inside the stable profile and make continuation -identity and lifetime explicit and verifiable. Given the project's rule that runtime -support is not a contract and that a proposal is adopted only by deliberate profile -revision, the compiler frames are the correct baseline. Stack switching remains a -future accelerator behind a separate decision once the proposal stabilizes. +An operation is a library functor member, lifted with the perform primitive: + +```purescript +get :: forall s r. Run (state :: StateF s | r) s +get = perform (inj (StateF (Get identity))) -- schematic; the library owns inj +``` + +A handler is a `run` handler: it receives each request and the continuation, and it +decides to resume, abort, or replay. Deep semantics is the library re-entering `run` +when it forwards a request it does not handle; the compiler does not decide +deep/shallow. + +The surface is monadic, so effectful code is written with the library's operations +and `bind` (via `do`). There is no direct-style effect syntax and no effect typing +(see the [scope](delimited-control-and-resumable-frames.md#scope) of the mechanism +document). ### Rejected shortcuts +- Making a concrete operation, `Run`, or an effect row a compiler-known identity; + the compiler sees only opaque request functors. - Attaching effect requirements to all function arrows without a language/type system decision. - Reconstructing handler behavior in Core, CC, or MIR to recover an implicit State protocol. -- Capturing the Wasm stack from a generic host import; a normal imported function - cannot capture its caller's execution stack. -- Adopting Wasm stack switching while it is a Phase 3, off-by-default proposal that - a second disabled feature gates. -- Letting a raw capture primitive inhabit an unrestricted pure function type while - changing its control behavior. - Treating a row requirement as linearity, single-use, or resource-lifetime evidence. - Replacing native Effect/ST or public foreign APIs merely to get an algebraic effects example to compile. +- Providing a whole-function intrinsic for a library loop merely to bypass a + representation gap. ## Algorithms -### Interpretation and forwarding (library) +### Interpretation and forwarding For a pure State handler carrying value `s`: @@ -512,118 +273,29 @@ handle(s, Put(s', next)) = handle(s', next) handle(s, Other(op, k)) = Request(op, x -> handle(s, k(x))) ``` -Actual evaluation uses an explicit stack-safe work loop or upstream trampoline -machinery. The final rule preserves the captured state while the outer handler -interprets another operation, and re-entering the State handler gives deep -semantics. It does not statically inspect the future continuation. +The library expresses this as a `run` handler over the control surface; the +mechanism that captures `k` and drives the trampoline is +[delimited control and resumable frames](delimited-control-and-resumable-frames.md). +The final rule preserves the captured state while the outer handler interprets +another operation, and re-entering the State handler gives deep semantics. It does +not statically inspect the future continuation. Type checking is ordinary application checking: operation lifting proves row -membership; handler application produces the residual row; `runPure` accepts only -the closed empty row. Any residual request is a type mismatch at that boundary, +membership; handler application produces the residual row; a pure runner accepts +only the closed empty row. Any residual request is a type mismatch at that boundary, assuming safe construction and the library's declared contracts. -### Selective conversion - -```text -convertible(f): - if f performs a suspension: return true - for each call, value applied, or capture in f: - if convertible(callee) or callee is unknown: return true - return false - -lower(program): - mark every function convertible by a fixed point over the call graph - for each convertible function: - rewrite its body in CPS form (Section "Frame construction") and - register its frames in the module frame table - leave non-convertible functions direct -``` - -An unknown or indirect callee that might suspend makes its caller convertible, so -the analysis is conservative at exactly the boundaries it cannot see. - -### Suspension and resumption - -```text -suspend(payload): - k = capture_frames(current, up_to = nearest_delimiter) - transfer(payload, k) to the delimiter's handler - -resume(k, value): - assert k.status == Pending // for a one-shot resumption - k.status = Running - reinstall(k.frames, value) // continue with value as the step result - k.status = Consumed // on normal or trapping completion -``` - -The `capture_frames` step reads the current chain up to the delimiter without -copying outer frames. For a persistent (multi-shot) resumption it does not mutate -the chain; for an owned (one-shot) resumption the status transition is atomic so a -re-entrant resume is rejected. - -### Frame construction and trampoline loop - -```text -run(initial): - state = initial - loop: - match state: - Return(v) -> return v - Eval(frame) -> state = frame.step() - Suspend(payload, k) -> state = deliver(payload, k) - Resume(k, v) -> state = install(k, v) - Abort -> trap -``` - -`install(k, v)` continues the captured chain with `v` as the suspended step's -result. `deliver` calls the delimiter's handler; a handler that returns without -resuming produces a normal answer, and its resumption becomes unreachable. - -### Deep-handler reinstatement - -```text -install_deep(k, v, handler): - // Deep: the same delimiter must handle the continuation's later requests. - install(k, v) with handler re-wrapped around the resumed chain - -install_shallow(k, v): - install(k, v) without re-wrapping the handler -``` - -The frame chain records which wrapping applies; the lowering must not conflate the -two. - -### One-shot consumption - -```text -transfer(k): - atomically: if k.status != Pending: reject - k.status = Running - ... normal or trapping completion sets k.status = Consumed ... - ... cancellation sets k.status = Cancelled ... -``` - -The atomic transition is what makes one-shot reuse rejection a runtime guarantee -rather than a documented expectation. - ## Code map This is the design target, not a claim that these APIs exist yet: | Location | Intended responsibility | | --- | --- | -| Independent `psrs-stdlib` package | Upstream computation libraries, the abstract-control wrapper, ordinary operation modules, handlers, source audit, and conformance fixtures | +| Independent `psrs-stdlib` package | Upstream computation libraries, the `Run`/operation/handler wrapper over the control surface, ordinary operation modules, source audit, and conformance fixtures | | Existing kind/row/class/rank-N owners | Check library source using standard PureScript rules; repair shared deficiencies without effect-specific solvers | -| Compiler control-surface owner | The abstract carrier, suspension/delimiter/resumption primitives, and their checked type contract | -| MIR control-lowering owner | Selective CPS/defunctionalization, the frame table, the trampoline, deep/shallow wrapping, and one-shot status | -| MIR verifier | Frame identity, capture boundary, resumption result-type, and suspension-observability checks | -| Existing Core/CC/MIR lowering and optimizers | Compile library code and the converted frames as ordinary higher-order code; preserve generic observable-call semantics | -| `psrs-runtime` ABI/catalog/executable owners | Small native IO/storage contracts and implementations, independent of operation rows; an optional trampoline driver | -| Runtime control owner, only if separately adopted | Stack-switching ABI, captured-root storage, lifecycle checks, and capability requirements | -No compiler-side operation registry, handler IR, State graph directory, or -effect-specific solver is required. Runtime control module names and entry-point -signatures remain unselected until a target option is explicitly adopted. +The control mechanism's code map is in +[delimited control and resumable frames](delimited-control-and-resumable-frames.md). ## Invariants and verification @@ -635,26 +307,14 @@ signatures remain unselected until a target option is explicitly adopted. residual requests and the appropriate continuation. - The pure boundary requires a closed empty operation row. This is not a proof about unsafe coercions or arbitrary FFI hidden in user code. -- A suspension is observable control: it is never erased, reordered across, or - duplicated by an optimizer, and a converted function is never merged into a - direct one without preserving its conversion. -- A resumption is resumed only at its captured result type, and a one-shot - resumption is transferred at most once, atomically with respect to re-entrancy. -- Deep and shallow handlers behave as declared; the lowering does not silently - change the semantics. -- Captured frames keep their values valid until the resumption is dropped, resumed - to completion, or cancelled; a resumption is never retained across a - non-suspendable foreign boundary. -- Closure conversion, adapters, and optimizations preserve evaluation behavior - under ordinary IR contracts; they do not verify a private effect protocol. - Resource safety is a separate contract. A bare handler does not prove release-on-trap or prevent use-after-release. -Evidence must separately cover type rejection, pure interpretation, generic -representation, the lowered control mechanism (frame identity, deep/shallow, -one-shot/multi-shot, stack safety), and any native control capability. The -[acceptance checklist](../../../implementation/backend/algebraic-effects.md) -records the requirements. +Evidence must separately cover type rejection, pure interpretation, and generic +representation; the lowered mechanism's evidence (frame identity, deep/shallow, +one-shot/multi-shot, stack safety) belongs to its own topic. The +[acceptance checklist](../../../implementation/backend/algebraic-effects.md) records +the requirements. ## Worked example @@ -671,44 +331,31 @@ result :: { state :: Int, value :: Int } result = runPure (handleState 0 program) ``` -Constructing `program` does not allocate a mutable cell or execute native IO. Under -the library encoding, interpretation changes the handler's ordinary state value to -41, supplies 41 to the continuation of `get`, and returns -`{ state: 41, value: 42 }`. The compiler sees constructors, functions, and calls; -there is no State token to project, no write/read dependency graph, and no -operation-specific witness. - -Under the native mechanism, the same program is a small frame chain. Tracing the -trampoline: - -```text -run(handleState 0 program) - Put 41 -> handler state 0 becomes 41; continue - Get k -> handler supplies 41 to k; k is a Resumption of result Int - Return(42) -> the state handler returns { state: 41, value: 42 } -``` - -Each `Put` and `Get` builds a frame from the current point to the `handleState` -delimiter, delivers it to the handler, and resumes through the trampoline. Depth of -`do` binding does not grow the native stack. +Constructing `program` does not allocate a mutable cell or execute native IO. +Interpretation changes the handler's ordinary state value to 41, supplies 41 to the +continuation of `get`, and returns `{ state: 41, value: 42 }`. The compiler sees +constructors, functions, and calls; there is no State token to project, no +write/read dependency graph, and no operation-specific witness. The frame-level +trace of the same program, under the control mechanism, is in +[delimited control and resumable frames](delimited-control-and-resumable-frames.md#worked-example). Adding a Console slot leaves that slot in the residual row after `handleState`. A pure log-collecting handler can remove it for testing. A host-writing handler needs an explicit native IO boundary, proposed in the -[native Effect/ST topic](native-effect-and-st-handlers.md); `runPure` cannot be used -as that boundary. +[native Effect/ST topic](native-effect-and-st-handlers.md); a pure runner cannot be +used as that boundary. ## Boundaries and interfaces -Source syntax, type arrows, and standard row rules remain unchanged. The generic -control surface is abstract and library-facing; it is not new effect syntax. The -compiler adds no ambient effect inference and does not recognize a `Run` or -`Effect` constructor specially. +Source syntax, type arrows, and standard row rules remain unchanged. This topic adds +no effect syntax and no effect rows; the compiler adds no ambient effect inference +and does not recognize a `Run` or `Effect` constructor specially. -The library and the compiler divide cleanly: operations, rows, handlers, -continuation composition, and the one-shot/multi-shot API are library code; only the -suspension/delimiter/resumption mechanism and its lowering are compiler code. A -library cannot make the optimizer unsound, and the compiler cannot change an +The library and the compiler divide cleanly: operations, rows, handlers, and the +one-shot/multi-shot API are library code; only the carrier, the four primitives, and +their lowering are compiler code +([delimited control and resumable frames](delimited-control-and-resumable-frames.md)). +A library cannot make the optimizer unsound, and the compiler cannot change an operation's meaning. Native services remain explicit checked bindings with ordinary value/ABI contracts. @@ -716,46 +363,30 @@ Command execution uses an ordinary configured runner where supported, without discovery of `Effect Unit` or hidden interpretation of operation rows. This topic does not reopen the deleted legacy runner path. -The baseline target profile does not gain stack switching through this design. A -native resumption option requires a pinned target capability, an MIR/lowering -contract, validator coverage, and actual execution evidence. An unsupported -capability is an error, never a silent change to continuation semantics. - ## Open questions and future work -1. Confirm the final type signatures and the abstract carrier of the control - surface, including how the library links operation payload types to resumption - result types with a rank-N eliminator. -2. Fix the boundary between selective conversion and the existing tail-call, - closure, and dictionary lowerings, and specify which optimizations must treat a - suspension as observable. -3. Decide the default representation for one-shot versus multi-shot resumptions and - how a library selects each without weakening the other. -4. Derive the exact rejection rules for capturing across a host/foreign frame, - including canonical-ABI and WIT boundaries. -5. Audit the pinned upstream Run/Free/Variant packages and this compiler's generic - representation support; no compile/runtime acceptance has been measured for this - design. -6. Validate the separate [native Effect/ST proposal](native-effect-and-st-handlers.md). - Its current package consumers remain unsupported after compiler cleanup. -7. Measure interpreter allocation, frame churn, and deep execution to set the - performance contract for the lowering. -8. Scoped/higher-order effects, bracket/finalization, async, and concurrency need - their own semantics. Ordinary first-order operation rows do not provide those - guarantees automatically. +1. **Reference-library acceptance.** Audit the pinned upstream Run/Free/Variant + packages, accept the reference library on this target, and build the row-based + (`VariantF`) library over the closed prototype. No compile or runtime acceptance + has been measured for the reference library. +2. **Operation-row encoding.** Confirm the reference encoding (`VariantF` over an + open row) is supported end to end, or record the compiler gap it exposes. +3. **Scoped and higher-order effects, bracket/finalization.** These need their own + semantics; ordinary first-order operation rows do not provide those guarantees. +4. **Async and concurrency.** Scheduling, cancellation, and thread interaction are + separate tracks. +5. **Native Effect/ST.** Validate the separate + [native proposal](native-effect-and-st-handlers.md); its current package + consumers remain unsupported after compiler cleanup. ## References -- [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), - [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), and +- [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md) and the [compiler cleanup handoff](../../../implementation/backend/effect-state-removal-handoff-2026-10-11.md). +- [Delimited control and resumable frames](delimited-control-and-resumable-frames.md), + the compiler mechanism these handlers run on. - [PureScript Run](https://github.com/natefaubion/purescript-run) and its [API](https://pursuit.purescript.org/packages/purescript-run/5.0.0/docs/Run). - [PureScript Free](https://github.com/purescript/purescript-free) and [Stack Safety for Free](https://functorial.com/stack-safety-for-free/index.pdf). -- [Continuing WebAssembly with Effect Handlers](https://arxiv.org/abs/2308.08347) - and the [WebAssembly stack-switching proposal](https://github.com/WebAssembly/stack-switching), - a proposal-level reference, not evidence of this target profile's support. -- [Capability profile](../wasm/capability-profile.md) and - [DEC-05](../../../decision/DEC-05-wasmtime-feature-set.md) for the target features - and the rule that runtime support is not a contract. +- [Native Effect and ST handlers](native-effect-and-st-handlers.md). diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md new file mode 100644 index 00000000..b7393e2c --- /dev/null +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -0,0 +1,555 @@ +# Delimited Control and Resumable Frames + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) +**Status:** Draft design. The mechanism is selected by +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md); the +lowering is not implemented. +**Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), +[functional Core](../../frontend/semantics/functional-core.md), +[CC IR](cc-ir.md), [MIR](mir.md), +[control flow and tail calls](control-flow-and-tail-calls.md), +[representation and evidence](representation-and-evidence.md), +[capability profile](../wasm/capability-profile.md), and the +[library-owned effects](algebraic-effects-and-handlers.md) this mechanism runs. +**Summary:** The compiler owns an effect-agnostic delimited-control surface — +`Control f a` with `return`/`bind`/`perform`/`run` — lowered by a selective, +defunctionalized continuation-passing transformation to explicit GC frame objects +driven by a trampoline. It needs no new target capability and is distinct from +WebAssembly stack switching. + +## Scope + +This document owns the generic control surface, its identity, the selective +CPS/defunctionalization lowering, the frame representation and trampoline, +deep/shallow encoding, one-shot status, continuation lifetime and GC roots, +foreign-call capture boundaries, and the comparison with native stack switching. + +It does not own operation signatures, handlers, or rows — those are the +[library-owned effects](algebraic-effects-and-handlers.md) this mechanism runs — nor +the official Effect/ST facades ([native topic](native-effect-and-st-handlers.md)), +nor target capability decisions ([capability profile](../wasm/capability-profile.md)). + +It adds no source syntax, no frontend effect rows, and no effect tracking or effect +reasoning in the type system: the surface is an ordinary monadic type over an opaque +request functor, and the compiler never infers, propagates, or solves effects and +never reasons about which effects a function may perform. + +The mechanism follows DEC-19. DEC-19 narrowly amends DEC-03's blanket exclusion of +delimited continuations below Typed Core; the type-system decision (effects are a +library encoding) is unchanged. + +## Background + +### Delimited control + +A **continuation** is the rest of a computation from a given point. **Delimited +control** captures that rest only up to a boundary — a **delimiter** — rather than +capturing the entire remaining program. A computation may **suspend** at an +operation; the delimiter's **handler** receives the operation together with the +captured continuation (a **resumption**) and decides how to proceed: it may resume +zero times (abort), once, or many times (replay). Capturing stops at the delimiter, +so code outside it is not part of the continuation. + +This mechanism is what makes library-defined handlers executable. The operations, +signatures, and handlers themselves are library values +([library-owned effects](algebraic-effects-and-handlers.md)); the compiler owns only +the suspension/delimiter/resumption mechanism and its representation, and never +learns what a particular operation means. + +### Continuation-passing style and defunctionalization + +In direct style, a function `f :: A -> B` returns its result to its caller, and the +caller's remaining work lives in the engine's execution stack. In +**continuation-passing style (CPS)**, the same function becomes +`A -> (B -> r) -> r`: it does not return; it calls a **continuation** `k` that names +the rest of the computation. Every call can then be a tail call, so the "rest" is a +value (`k`) rather than a stack of return addresses. Conceptually, capturing a +continuation is keeping that `k`; resuming is calling it. + +The concept alone is not enough for this target, for two reasons: + +1. **Capture needs reification.** If the "rest" is spread across the live Wasm + stack, it cannot be stored, passed to a handler, inspected, or resumed twice. The + continuation must be **data**. +2. **Stack safety must not depend on the engine.** The pinned profile enables tail + calls, so pure closure-CPS can be stack-safe, but a captured continuation still + needs a representation the compiler can reason about and verify. + +The lowering therefore **defunctionalizes** CPS: instead of closures, a continuation +is an explicit chain of **frame objects** in the GC heap, and a loop runs the +machine one frame at a time. + +### Why a host import cannot capture a continuation + +A Rust/Wasm function called by the guest cannot capture the caller's Wasm execution +stack; Rust's private linear-memory stack is a different stack, and moving its stack +pointer or saving registers is not a continuation implementation. "Runtime support" +for delimited control therefore cannot be a normal imported binding. The two viable +implementations are compiler-generated frames (this design) and target-level stack +switching (rejected for now, below). + +### Stack switching is not a target feature + +The WebAssembly stack-switching proposal is at Phase 3 (implementation), not merged +into the core specification. The pinned runtime disables it by default +(`Config::wasm_stack_switching = false`), it depends on the `exceptions` feature, +and the pinned profile disables `exceptions`. Adopting it would be a deliberate +target-profile revision that ties the artifact to a moving proposal and a +non-default runtime configuration. DEC-19 therefore selects compiler-generated +frames as the baseline and keeps stack switching as a future accelerator behind a +separate decision. + +## Model + +### The computation carrier and primitives + +The compiler-owned surface is an **over-functor computation**: a freer computation +over an opaque request functor `f`, with four primitives. + +```text +Control f a -- computation over request functor f, yielding an a + +return : a -> Control f a +bind : Control f a -> (a -> Control f b) -> Control f b +perform : f a -> Control f a +run : (forall x. f x -> (x -> Control f a) -> Control f a) + -> Control f a -> a +``` + +- `Control f a` is opaque; no pass inspects a request. +- `perform` suspends: it captures the continuation up to the nearest `run`, + delivers the request value `f a` to that delimiter, and resumes with an `a`. +- `run` installs the delimiter. Its handler is rank-2 in the request's answer `x`, + so an operation's payload/continuation relation is checked by ordinary rank-N + typing; no native GADT or existential is needed. +- `bind` composes continuations directly (freer style), so no `Functor f` + constraint is required and a library functor needs no mapping instance. + +The continuation a handler receives is the function `x -> Control f a`, delimited by +its `run`; it captures only frames inside that delimiter. `run` is **closed** to its +answer `a`; a residual computation is a library concern, handled by re-entering +`run`. + +**Why this surface.** It is exactly the shape `purescript-run` builds on, so that +ecosystem's operation rows, `VariantF` encodings, and deep handlers map onto it +directly; it keeps every concrete operation in library code; and it is expressible +with ordinary rank-N polymorphism. The alternatives are rejected. A separate +`suspend`/`handle`/`resume` triple with an abstract `Resumption` still has to carry +the payload/result relation in the request value, so it collapses into this surface +unless it adds an existential. `shift`/`reset` threads an answer type through the +monad and is not expressible without a frontend effect-row system, which DEC-03 +excludes. + +The surface is **monadic, not direct style**. Direct-style effectful code needs +`shift`/`reset` or effect syntax and is future work +([Open questions](#open-questions-and-future-work)). The compiler's contribution +over a pure library free monad is the representation: it lowers `bind`/`perform` to +an explicit continuation chain, so binding is stack-safe without materializing a +tree and a handler receives a first-class resumption. + +The surface is independent of how the library encodes operations: `f` is opaque, so +`VariantF` over an open row, a closed operation functor, `Data.Exists`, or a rank-N +eliminator are all library choices. + +### Effect-agnostic contracts + +These are the guarantees the compiler provides and the ones that make concrete +effects safe: + +- A request is delivered unchanged to its delimiter; the compiler never inspects or + reinterprets it. +- A continuation is resumed at exactly the result type at which it suspended. The + compiler preserves this relationship through erasure, boxing, and call adaptation; + it cannot be exchanged for an unrelated result type. +- A continuation captures only up to its delimiter. Frames outside the delimiter are + not part of it. +- A continuation's lifetime is bounded by its delimiter, and the values it captured + stay valid for as long as it is live (they are GC roots). +- Multiplicity is an API property: the base surface is multi-shot, one-shot is a + separate API, and the compiler provides the representation and check for both. + +### Continuation multiplicity + +Deep and shallow are handler semantics, owned by the +[library-owned effects](algebraic-effects-and-handlers.md#handler-semantics) +document; the lowering supports both (see +[Deep and shallow handlers](#deep-and-shallow-handlers)). + +The surface is **multi-shot**. A handler receives a persistent continuation function +and may call it zero, one, or many times; replay re-runs the interpreted remainder +and does not roll back mutations or external IO already performed by another branch. +This matches the portable library encoding and needs no extra representation. + +**One-shot is a separate library API.** It exposes an opaque `Resumption a` value +with a consumed status instead of a bare function; the first resume atomically +consumes it and a second attempt is rejected rather than silently reinterpreted. The +compiler provides the frame representation and the atomic check; no optimization may +turn a multi-shot continuation into a one-shot one. Existing PureScript arrows are +unrestricted, so hiding a constructor or adding a nominal parameter does not enforce +one-shot use; the guarantee lives at the representation boundary, not in the type. + +## Design + +### Identity and exposure + +The compiler owns the carrier and the four primitives. They are declared as a +compiler-reserved interface module, `Prim.Control`, the way `Prim.Coerce` exposes +`coerce`: `Prim.Control` declares the abstract type `Control` and the +`return`/`bind`/`perform`/`run` values, whose schemes the compiler checks against the +[model above](#the-computation-carrier-and-primitives). The module carries no +operation registry; no pass recognizes a concrete operation or adds an +operation-specific solver. + +The surface is exposed to source only as this abstract typed API; the independent +standard library wraps it into the operation and handler API users see. Because the +surface is abstract, a raw capture cannot inhabit an unrestricted pure function type +while changing its control behavior: the caller must use `Control` and the +primitives, whose types state the suspension. + +`Prim.Control` is not a host import and not a WIT binding: it has no runtime +implementation of its own, because the lowering produces ordinary guest code. + +### Lowering: selective CPS to resumable frames + +#### Selective conversion + +Converting a whole program to CPS would be slow and would change the representation +of code that never suspends. The compilation is **selective**: + +- A function is *convertible* when it can reach a suspension in its dynamic extent — + directly, through a call, or through a value it invokes. +- Only convertible functions are lowered to resumable form. Pure, non-convertible + functions keep the ordinary direct representation and calling convention. +- A suspension converts exactly the region from the suspension point out to its + delimiter; frames below the delimiter are ordinary calls and are not captured. + +Selectivity keeps the lowering proportional to the effectful part of the program and +keeps pure code fast. It is also where optimization interacts with the mechanism: an +inliner or specializer must not merge a convertible function into a non-convertible +one without preserving the conversion of the merged region, nor erase a suspension +whose result is unused, because the suspension is observable control, not a pure +computation. + +#### Frame construction + +Each step of a converted computation is represented by a frame. A frame stores: + +- the free variables the step needs (its captured environment), +- a small tag identifying which continuation step it is ("after this `perform`, + apply this function to the answer"), +- the pointer to the next frame (the previously captured remainder). + +A `perform` builds a frame chain from the current point out to its `run` delimiter, +hands the request and a handle to that chain (the continuation) to the handler, and +stops running the current computation. Continuing re-installs the chain and supplies +a value as the performed step's result. Frames are ordinary GC objects, so captured +references are roots the engine scans automatically; this is a decisive advantage +over capturing a raw execution stack, where the runtime must establish stack maps to +find roots. + +#### The trampoline + +A **trampoline** is the loop that runs the machine: + +```text +run(state): + loop: + step = state.current + match step: + Return(v) -> return v + Eval(frame) -> state.current = frame.step(state) + Suspend(payload, k) -> state = call_handler(payload, k) + Resume(k, v) -> state.current = k.install(v) +``` + +Because the loop drives every step, the native Wasm stack does not grow with the +depth of binds or with long request sequences. Deep recursion in direct style +becomes bounded frame churn, the same way a self tail call becomes a loop. Using +`return_call`/`return_call_ref` for the tail positions of the emitted steps keeps +the constant-stack property even where the machine calls into ordinary code. + +#### Deep and shallow handlers + +The delineated region is a marker in the frame chain. A **deep** handler is one +whose continuation re-installs the handler before continuing, so subsequent requests +at the same delimiter are handled again; the lowering wraps the resumed chain with +the handler frame. A **shallow** handler resumes the chain without re-wrapping, so +the handler runs once and later requests escape to an outer delimiter. The library +selects the semantics; the lowering must implement both and must not silently deepen +or shallow a handler. + +#### One-shot and multi-shot + +The frame chain is the continuation. Two representations are possible: + +- **Persistent frames** (the natural multi-shot representation): a resumed frame is + not mutated, so the same continuation may be resumed again. Replay re-runs the + captured remainder against the handler's supplied values. Mutable references and + external IO already performed by another branch are shared, exactly as the pure + model requires; multi-shot execution does not roll back IO. +- **Owned frames** (the one-shot representation): a `Resumption` holds a status of + `Pending`, `Running`, `Consumed`, or `Cancelled`. The first `resume` atomically + transitions out of `Pending`; a second attempt is rejected rather than silently + reinterpreted. Transfer must be atomic with respect to re-entrancy, so a re-entrant + resume of a running resumption fails rather than corrupting the chain. + +The two are distinct APIs. An optimization may not turn a multi-shot continuation +into a one-shot one. + +#### Lifetime, GC roots, and abandonment + +A continuation keeps its captured frames reachable, so anything those frames +captured stays alive until the continuation is dropped, resumed to completion, +cancelled, or abandoned. When a handler returns without resuming, its continuation +becomes unreachable and the GC reclaims the frames. The compiler must not drop a +live continuation to an optimization, and must not let a dead one keep roots alive +beyond its contract. + +#### Foreign-call boundaries + +Suspension cannot cross a non-suspendable host or foreign frame: a captured +continuation that spans a canonical-ABI call or an in-progress WIT import cannot be +resumed without that boundary's cooperation. The lowering rejects a conversion that +would capture across such a boundary unless the boundary declares an explicit +suspension protocol. A continuation also cannot retain a borrowed canonical-ABI +buffer or a host-resource reference past the boundary's lifetime. + +### Compiler CPS versus native stack switching + +DEC-19 selects compiler-generated frames. The alternative, WebAssembly stack +switching, is a real implementation with different trade-offs. This section is the +comparison the mechanism decision rests on. + +The two implementations differ in where the "remainder" lives. **Native stack +switching** extends the instruction set with a continuation reference type and +`suspend`/`resume` instructions: a delimiter becomes a continuation object, and +suspending captures the current execution stack into it, which the runtime relocates +off the main Wasm stack; resuming reinstalls the captured segment. The runtime must +then scan captured stack slots for GC roots. **Compiler CPS** never touches the +execution stack: the compiler rewrites the functions that can suspend into a state +machine whose states are explicit GC frame objects, and a work-loop (trampoline) +drives them, so the "remainder" is ordinary heap data the GC already understands. + +| Dimension | Compiler resumable frames (CPS/defunctionalized) | Native stack switching | +| --- | --- | --- | +| Standardization | Uses standardized Wasm 3.0 features (GC, function references, tail calls) already in the profile | A Phase 3 proposal, not merged into the core specification; semantics may still change | +| Runtime enablement | Runs on the default pinned runtime: those features are on by default | Wasmtime disables it by default; it additionally depends on the `exceptions` feature, which this profile disables | +| Portability | Any engine implementing the pinned profile | Only engines implementing the proposal with the matching configuration | +| What is captured | An explicit heap chain of frame objects | The live Wasm execution stack (a continuation object) | +| Capture cost | Allocates frame records proportional to the captured region; selective conversion limits it to the effectful part | The runtime captures or switches a stack segment; cost scales with the stack being captured | +| Cost on non-suspending code | Pure code stays direct; only convertible regions pay per-step frame cost | Direct code is unchanged; the runtime's switching machinery is present regardless | +| Stack safety | A trampoline gives constant native stack independent of bind depth and of the engine | Depends on the runtime moving captured stacks off the main stack; not a compiler guarantee | +| GC/roots | Frames are GC values; captured roots are scanned automatically | Captured stack slots need runtime stack maps; GC/continuation integration is the runtime's responsibility | +| One-shot/multi-shot | Explicit: persistent frames are multi-shot, owned frames are one-shot and checkable | The runtime captures a stack; multi-shot requires cloning it; one-shot is the natural case | +| Foreign boundary | The compiler statically rejects capturing across a non-suspendable host frame | `suspend` also cannot cross a host frame; the proposal defines which frames are capturable | +| Compiler complexity | Large: selective conversion, frame identity, lifetime, and optimization interaction are new obligations in MIR and its verifier | Smaller in the compiler, but the artifact depends on a target feature and the runtime must be configured for it | +| Optimizability | Frames are explicit and inspectable; every pass must preserve frame identity and suspension observability | Capture points are opaque to the compiler, so it cannot reorder or eliminate them, but it also cannot reason about them | +| Verification | Fits the existing MIR/Wasm pipeline; verified and executed under the pinned runtime | Needs a validator built with the proposal enabled and a runtime so configured | +| Principal risk | High implementation cost and subtle frame/lifetime bugs | Dependence on a moving proposal and a non-default runtime configuration | + +In short: stack switching moves the difficult part (capturing and rooting a live +stack) into the runtime and the standard, at the cost of an unstable, off-by-default +target feature. Compiler frames move it into the compiler, at the cost of a new +lowering, but keep the artifact inside the stable profile and make continuation +identity and lifetime explicit and verifiable. Given the project's rule that runtime +support is not a contract and that a proposal is adopted only by deliberate profile +revision, the compiler frames are the correct baseline. Stack switching remains a +future accelerator behind a separate decision once the proposal stabilizes. + +### Rejected shortcuts + +- Capturing the Wasm stack from a generic host import; a normal imported function + cannot capture its caller's execution stack. +- Adopting Wasm stack switching while it is a Phase 3, off-by-default proposal that a + second disabled feature gates. +- Letting a raw capture primitive inhabit an unrestricted pure function type while + changing its control behavior. +- Offering only whole-program CPS: purity and stack cost of unconverted code must be + preserved by a selective analysis. +- Recovering a hidden operation protocol by inspecting handler bodies. + +## Algorithms + +### Selective conversion + +```text +convertible(f): + if f performs a suspension: return true + for each call, value applied, or capture in f: + if convertible(callee) or callee is unknown: return true + return false + +lower(program): + mark every function convertible by a fixed point over the call graph + for each convertible function: + rewrite its body in CPS form (Section "Frame construction") and + register its frames in the module frame table + leave non-convertible functions direct +``` + +An unknown or indirect callee that might suspend makes its caller convertible, so +the analysis is conservative at exactly the boundaries it cannot see. + +### Perform and continuation + +```text +perform(request): + k = capture_frames(current, up_to = nearest run delimiter) + transfer(request, k) to the delimiter's handler + +handler(request, k): -- library code + ... -- resume k, abort, or replay k + +continue(k, value): + reinstall(k.frames, value) -- the performed step's result is value +``` + +`capture_frames` reads the current chain up to the delimiter without copying outer +frames. For the multi-shot surface it does not mutate the chain; for the one-shot +API the status transition (`Pending` → `Running` → `Consumed`) is atomic, so a +re-entrant resume is rejected. + +### Frame construction and trampoline loop + +```text +run(initial): + state = initial + loop: + match state: + Return(v) -> return v + Eval(frame) -> state = frame.step() + Suspend(payload, k) -> state = deliver(payload, k) + Resume(k, v) -> state = install(k, v) + Abort -> trap +``` + +`install(k, v)` continues the captured chain with `v` as the suspended step's +result. `deliver` calls the delimiter's handler; a handler that returns without +resuming produces a normal answer, and its continuation becomes unreachable. + +### Deep-handler reinstatement + +```text +install_deep(k, v, handler): + // Deep: the same delimiter must handle the continuation's later requests. + install(k, v) with handler re-wrapped around the resumed chain + +install_shallow(k, v): + install(k, v) without re-wrapping the handler +``` + +The frame chain records which wrapping applies; the lowering must not conflate the +two. + +### One-shot consumption + +```text +transfer(k): + atomically: if k.status != Pending: reject + k.status = Running + ... normal or trapping completion sets k.status = Consumed ... + ... cancellation sets k.status = Cancelled ... +``` + +The atomic transition is what makes one-shot reuse rejection a runtime guarantee +rather than a documented expectation. + +## Code map + +This is the design target, not a claim that these APIs exist yet: + +| Location | Intended responsibility | +| --- | --- | +| `Prim.Control` owner | The abstract `Control f a` carrier and the `return`/`bind`/`perform`/`run` primitives, with their checked schemes | +| MIR control-lowering owner | Selective CPS/defunctionalization, the frame table, the trampoline, deep/shallow wrapping, and one-shot status | +| MIR verifier | Frame identity, capture boundary, continuation result-type, and suspension-observability checks | +| Existing Core/CC/MIR lowering and optimizers | Compile the converted frames as ordinary higher-order code; preserve generic observable-call semantics | +| Runtime control owner, only if separately adopted | Stack-switching ABI, captured-root storage, lifecycle checks, and capability requirements | + +No compiler-side operation registry, handler IR, or effect-specific solver is +required. Runtime control module names and entry-point signatures remain unselected +until a target option is explicitly adopted. + +## Invariants and verification + +- A suspension is observable control: it is never erased, reordered across, or + duplicated by an optimizer, and a convertible function is never merged into a + direct one without preserving its conversion. +- A continuation is resumed only at its captured result type, and a one-shot + continuation is transferred at most once, atomically with respect to re-entrancy. +- Deep and shallow handlers behave as declared; the lowering does not silently + change the semantics. +- Captured frames keep their values valid until the continuation is dropped, resumed + to completion, or cancelled; a continuation is never retained across a + non-suspendable foreign boundary. +- The trampoline drives every step, so execution is stack-safe independently of the + native stack; emitted tail positions use `return_call*`. +- Closure conversion, adapters, and optimizations preserve evaluation behavior under + ordinary IR contracts; they do not verify a private protocol. + +Evidence must cover frame identity, deep/shallow behavior, one-shot/multi-shot +rejection, stack safety, and any native control capability, separately from the +library-level interpretation evidence. The +[acceptance checklist](../../../implementation/backend/algebraic-effects.md) records +the requirements. + +## Worked example + +The [library-owned effects document](algebraic-effects-and-handlers.md#worked-example) +defines the program `runPure (handleState 0 program)`. Under this mechanism it is a +small frame chain. Tracing the trampoline: + +```text +run(handleState 0 program) + Put 41 -> handler state 0 becomes 41; continue + Get k -> handler supplies 41 to k; k is the delimited continuation yielding Int + Return(42) -> the state handler returns { state: 41, value: 42 } +``` + +Each `put` and `get` performs an operation, builds a frame from the current point to +the `handleState` delimiter, delivers it to the handler, and resumes through the +trampoline. Depth of `do` binding does not grow the native stack. The library-level +meaning of this program is in the +[library-owned effects document](algebraic-effects-and-handlers.md#worked-example). + +## Boundaries and interfaces + +The control surface is abstract and library-facing; it is not new source syntax, and +the compiler adds no ambient effect inference. It is the only compiler-owned part of +the effects story; operations, rows, handlers, and the one-shot/multi-shot API are +library code ([library-owned effects](algebraic-effects-and-handlers.md#ownership)). + +The baseline target profile does not gain stack switching through this design. A +native resumption option requires a pinned target capability, an MIR/lowering +contract, validator coverage, and actual execution evidence. An unsupported +capability is an error, never a silent change to continuation semantics. + +## Open questions and future work + +1. **Direct-style surface sugar.** Effect typing is out of scope (see + [Scope](#scope)). A non-typed syntax that desugars to the monadic API is a + separate, uncommitted option; it would add no effect tracking, but it would add + non-PureScript syntax and is not part of this design. +2. **Conversion analysis formalization.** Fix the boundary between selective + conversion and the existing tail-call, closure, and dictionary lowerings, and + specify precisely which optimizations must treat a suspension as observable. +3. **Foreign-frame suspension protocol.** Capturing across a non-suspendable host or + foreign frame is rejected by the lowering; a boundary that needs to suspend across + it must define an explicit protocol and its lifetime contract. +4. **Performance.** Measure allocation, frame churn, and deep execution to set the + lowering's performance contract. + +## References + +- [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), + [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), and + [compiler cleanup handoff](../../../implementation/backend/effect-state-removal-handoff-2026-10-11.md). +- [Continuing WebAssembly with Effect Handlers](https://arxiv.org/abs/2308.08347) + and the [WebAssembly stack-switching proposal](https://github.com/WebAssembly/stack-switching), + proposal-level references, not evidence of this target profile's support. +- [Capability profile](../wasm/capability-profile.md) and + [DEC-05](../../../decision/DEC-05-wasmtime-feature-set.md) for the target features + and the rule that runtime support is not a contract. +- [Algebraic effects and handlers](algebraic-effects-and-handlers.md) for the + library-owned operations and handlers this mechanism runs. diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index c300fc47..9083f17e 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1,7 +1,9 @@ # Algebraic Effects: Proposed Acceptance Checklist **Status:** Design only; all requirements below are Unverified. -**Design:** [Library-owned algebraic effects and handlers](../../design/backend/fp/algebraic-effects-and-handlers.md). +**Design:** [Library-owned algebraic effects and handlers](../../design/backend/fp/algebraic-effects-and-handlers.md) +(library model) and [Delimited control and resumable frames](../../design/backend/fp/delimited-control-and-resumable-frames.md) +(compiler mechanism). **Decision:** [DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md) selects compiler-generated resumable frames as the generic handler/interruption mechanism. @@ -34,7 +36,7 @@ them: | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | -| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 amendment (DEC-19) and complete suspension/delimiter/resumption contracts | Unverified | +| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 amendment (DEC-19) and the complete `Control f a` carrier plus `return`/`bind`/`perform`/`run` contracts | Unverified | | AC-02 | The selected representation can capture and resume | Actual target execution of resumable frames at supported boundaries, stack safety, and capability gating; no silent fallback | Unverified | | AC-03 | Resumption multiplicity and lifetime are enforced | Double resume, re-entrant resume, cancellation, non-resuming clauses, and expired-boundary tests | Unverified | | AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Unverified | @@ -43,3 +45,23 @@ them: No runtime or differential validation was run for this design. Record future evidence with compiler/package identities, commands, actual outputs, and any skips. Do not infer topic completion from existing generic compiler tests. + +## Prototype evidence (2026-10-11) + +`crates/psrs-driver/tests/effect_representation.rs` compiles and executes a +self-contained prototype of the shared representation the design requires before +the native lowering: a rank-N eliminator whose method is rank-1 polymorphic, two +facades (`Effect`, `ST`) over the same computation field, an `unsafeCoerce` Global +conversion, and a pure interpreter. Mandatory `wasmtime` execution returns 42. Run +it with the locked standard library: + +```sh +PSRS_STDLIB_ROOT= PSRS_REQUIRE_WASMTIME=1 \ + cargo test -p psrs-driver --test effect_representation +``` + +This is representation and interpretation evidence only. It does not establish +AE-04/AE-05/AE-06 (row-based handlers, deep/shallow, forwarding), AE-07 (captures, +rank-N interpreter arguments, higher-order calls, signature adapters), or any +`AC-*` obligation, because the compiler-generated resumable-frame mechanism is not +implemented. No status above changes. From 251352a4f8ff018057278f0e417ff54c18220cc8 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 18:55:17 +0800 Subject: [PATCH 097/148] Design the delimited-control mechanism: frames, executor, and handlers Expand the delimited-control design into a coherent whole. Add a software versus native continuation dichotomy and a design space over representation, driver, and ownership, with the four candidate architectures (library freer monad, compiler closures, compiler frames, native cont) and the State-mechanism comparison. Settle the eliminator as a state-threading fold: the driver threads the handler state and the handler returns the next state with the next computation, so the loop is flat and stack-safe without tail-call support. Effect removal uses an open union: `handle` is generic over the combined effect functor and the library supplies `project`/`inject`, so the compiler never reasons about rows or labels. Record why the CPS-answer eliminator is not used (its driver is nested). Add the executor and its runtime boundary: the driver is guest code, the host runtime carries no continuation for the software form and must not learn the frame layout, and a native continuation removes the executor entirely. Add the migration-to-native-control mapping, the executor loop algorithm, and align the library-owned effects document's handler wording. --- .../fp/algebraic-effects-and-handlers.md | 5 +- .../delimited-control-and-resumable-frames.md | 373 ++++++++++++++++-- 2 files changed, 340 insertions(+), 38 deletions(-) diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index a27ca267..02031bde 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -235,8 +235,9 @@ get :: forall s r. Run (state :: StateF s | r) s get = perform (inj (StateF (Get identity))) -- schematic; the library owns inj ``` -A handler is a `run` handler: it receives each request and the continuation, and it -decides to resume, abort, or replay. Deep semantics is the library re-entering `run` +A handler is `run`'s rank-2 argument: it receives the handler state, the request, and +the continuation, and returns the next state together with the next computation, +deciding to resume, abort, or replay. Deep semantics is the library re-entering `run` when it forwards a request it does not handle; the compiler does not decide deep/shallow. diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index b7393e2c..75c921e9 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -16,14 +16,17 @@ lowering is not implemented. `Control f a` with `return`/`bind`/`perform`/`run` — lowered by a selective, defunctionalized continuation-passing transformation to explicit GC frame objects driven by a trampoline. It needs no new target capability and is distinct from -WebAssembly stack switching. +WebAssembly stack switching. The selected activation is the frame/trampoline +representation (row 3) with a state-threading fold eliminator and an open-union +`handle` that removes one effect. ## Scope This document owns the generic control surface, its identity, the selective -CPS/defunctionalization lowering, the frame representation and trampoline, -deep/shallow encoding, one-shot status, continuation lifetime and GC roots, -foreign-call capture boundaries, and the comparison with native stack switching. +CPS/defunctionalization lowering, the frame representation and trampoline (the +executor), the executor's boundary with the runtime, deep/shallow encoding, one-shot +status, continuation lifetime and GC roots, foreign-call capture boundaries, and the +comparison with native stack switching. It does not own operation signatures, handlers, or rows — those are the [library-owned effects](algebraic-effects-and-handlers.md) this mechanism runs — nor @@ -57,6 +60,22 @@ signatures, and handlers themselves are library values the suspension/delimiter/resumption mechanism and its representation, and never learns what a particular operation means. +### Relationship to the withdrawn State mechanism + +This mechanism is not the removed compiler-owned State mechanism, and a frame chain +is not a state chain. The State mechanism (`Prim.State`, the `runWorld`/`runRegion` +intrinsics, and the Core/CC/MIR dependency graph) encoded a **linear token** whose +flow through calls a static analysis verified and then erased at MIR. It could order +effects but could not capture, store, or resume control. A frame chain is a +**runtime continuation**: heap data recording the rest of the computation, delivered +to a handler and resumable zero, one, or many times. + +They share only that both are compiler-owned representations of "the rest of the +computation", and both risked cross-pass coupling. The State mechanism was removed +for that coupling. This mechanism avoids it by being effect-agnostic — it knows only +an opaque request functor — and additive, below Typed Core, which the State +mechanism was not. + ### Continuation-passing style and defunctionalization In direct style, a function `f :: A -> B` returns its result to its caller, and the @@ -80,6 +99,37 @@ The lowering therefore **defunctionalizes** CPS: instead of closures, a continua is an explicit chain of **frame objects** in the GC heap, and a loop runs the machine one frame at a time. +### Software and native continuations + +A continuation can be implemented in two fundamentally different places, and this is +the distinction the rest of this document turns on. + +- **Software continuation (heap).** The compiler reifies the rest of the computation + as ordinary heap data — a computation AST or a frame chain — and a loop drives it. + The continuation's state lives on the **language heap**, so every reference it + captured is an ordinary GC root and nothing special keeps it alive. The driver and + the frame layout are the compiler's (or a library's) responsibility. +- **Native continuation (stack).** The runtime exposes an opaque continuation handle + (`cont`) with `suspend`/`resume` and captures the **native execution stack** itself. + The continuation's state lives in runtime-managed stack memory, not the language + heap. The runtime, not the compiler, performs the stack capture and restore, and + must therefore scan captured stack slots for GC roots and own the continuation's + lifetime and, for multi-shot use, stack cloning. + +These are not layers of one another. A defunctionalized representation plus a +trampoline is a *software* continuation, built on the heap precisely because the +language cannot capture its own native stack; stack switching is a *native* +continuation, which exists so the compiler does **not** have to build the heap +representation. They are two implementations of the same abstract continuation, and a +mechanism can move from one to the other behind an unchanged surface +([Migration to native control](#migration-to-native-control)). + +The distinction sets the cost model. The software form is portable and GC-friendly, +but makes the compiler own the driver, the frame layout, and frame-identity +verification. The native form is cheaper to execute and reaches the direct style, but +requires a target capability and moves stack capture, GC-root scanning, and lifetime +onto the runtime. + ### Why a host import cannot capture a continuation A Rust/Wasm function called by the guest cannot capture the caller's Wasm execution @@ -113,23 +163,47 @@ Control f a -- computation over request functor f, yielding an return : a -> Control f a bind : Control f a -> (a -> Control f b) -> Control f b perform : f a -> Control f a -run : (forall x. f x -> (x -> Control f a) -> Control f a) - -> Control f a -> a +run : s + -> (forall x. s -> f x -> (x -> Control f a) -> (s, Control f a)) + -> Control f a + -> (s, a) +handle : s + -> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a)) + -> (forall x. u x -> Either (f x) (g x)) + -> (forall x. g x -> u x) + -> Control u a + -> Control g (s, a) ``` - `Control f a` is opaque; no pass inspects a request. - `perform` suspends: it captures the continuation up to the nearest `run`, delivers the request value `f a` to that delimiter, and resumes with an `a`. -- `run` installs the delimiter. Its handler is rank-2 in the request's answer `x`, - so an operation's payload/continuation relation is checked by ordinary rank-N - typing; no native GADT or existential is needed. -- `bind` composes continuations directly (freer style), so no `Functor f` - constraint is required and a library functor needs no mapping instance. +- `run` is a **state-threading fold**. The driver threads a handler state `s`; the + handler is rank-2 in the request's answer `x`, receives the current state, the + request, and the continuation, and returns the next state together with the next + computation. A stateless handler uses `s = ()`. +- `handle` is the open eliminator: it interprets the `f` operations of a computation + over a combined effect `u` and leaves the rest as a residual `Control g (s, a)`. The + library supplies the open union `u` and its split, `project : u x -> Either (f x) + (g x)` and `inject : g x -> u x`, so the compiler never reasons about rows or + labels. `run` is the closed case, with an empty residual. +- `bind` composes continuations directly (freer style), so no `Functor f` constraint + is required and a library functor needs no mapping instance. + +The driver is a flat loop: -The continuation a handler receives is the function `x -> Control f a`, delimited by -its `run`; it captures only frames inside that delimiter. `run` is **closed** to its -answer `a`; a residual computation is a library concern, handled by re-entering -`run`. +```text +run h s (Return a) = (s, a) +run h s (Perform op cont) = let (s', next) = h s op cont in run h s' next +``` + +It recurses in tail position and the handler never re-enters it, so execution is +constant-stack independently of tail-call support and of the number of requests or +binds. This is the row-3 eliminator. A *CPS-answer* eliminator +`(forall x. f x -> (x -> r) -> r) -> Control f a -> (a -> r) -> r` also threads state +(`r = s -> (s, a)`) but makes the driver *nested*, so it belongs to row 2 and is not +this mechanism's eliminator ([Design space](#design-space), +[Handler interface for a flat loop](#handler-interface-for-a-flat-loop)). **Why this surface.** It is exactly the shape `purescript-run` builds on, so that ecosystem's operation rows, `VariantF` encodings, and deep handlers map onto it @@ -145,8 +219,8 @@ The surface is **monadic, not direct style**. Direct-style effectful code needs `shift`/`reset` or effect syntax and is future work ([Open questions](#open-questions-and-future-work)). The compiler's contribution over a pure library free monad is the representation: it lowers `bind`/`perform` to -an explicit continuation chain, so binding is stack-safe without materializing a -tree and a handler receives a first-class resumption. +an explicit continuation chain, so binding is stack-safe without materializing a tree, +and the handler is handed the continuation directly. The surface is independent of how the library encodes operations: `f` is opaque, so `VariantF` over an open row, a closed operation functor, `Data.Exists`, or a rank-N @@ -210,8 +284,161 @@ primitives, whose types state the suspension. `Prim.Control` is not a host import and not a WIT binding: it has no runtime implementation of its own, because the lowering produces ordinary guest code. +### Handler interface for a flat loop + +Row 3's eliminator is the state-threading fold in +[Model](#the-computation-carrier-and-primitives). The handler is called once per +request and returns the next state and computation, so the driver stays flat. For a +State request functor: + +```text +h s (Get f) cont = (s, cont (f s)) +h s (Put s' n) cont = (s', cont n) + +runState s0 c = run h s0 c -- (s, a) +``` + +A stateless handler uses `s = ()` and returns `((), next)`. + +**Removing one effect (residual rows).** The fold above interprets the *whole* effect +`f`. The library's `Run r a = Control (VariantF r) a` and +`handleState :: s -> Run (state :: StateF s | r) a -> Run r { state :: s, value :: a }` +need the output to change effect, from `VariantF (label :: f | r)` to `VariantF r`. +The mechanism follows the industry standard — an **open union** indexed by the effect +collection — but keeps the compiler free of it: `handle` is generic over the combined +effect functor `u`, and the library supplies the union and its split. + +```text +handle s h project inject c :: Control g (s, a) + +go s (Return a) = Return (s, a) +go s (Perform uop cont) = + case project uop of + Left fop -> let (s', next) = h s fop cont in go s' next -- handled + Right gop -> Bind (Perform_g gop) (\x -> go s (cont x)) -- forwarded to residual +``` + +The library's `VariantF r` is the open union for the row; it supplies +`project : VariantF (label :: f | r) x -> Either (f x) (VariantF r x)` and +`inject : VariantF r x -> VariantF (label :: f | r) x` from ordinary row membership +(`Prim.Row.Cons`/`Lacks`). The compiler therefore never reasons about rows or labels; +the row machinery is library code, as with operations and handlers generally. This is +the row-indexed open union the ecosystem uses (`purescript-run`'s `VariantF`, Haskell's +`Union` with `Member`), realized here with a generic primitive rather than a +compiler-known row. + +The driver stays flat for handled requests; a forwarded request builds a residual +`Control g (s, a)` by binding `perform_g gop` to a continuation that resumes handling +with the saved state, so re-entry is bounded by the number of handlers, not by the +computation. + +**Why not the CPS-answer eliminator.** +`run :: (forall x. f x -> (x -> r) -> r) -> Control f a -> (a -> r) -> r` also threads +state, by choosing `r = s -> (s, a)`, but its handler's continuation `x -> r` must +produce the answer synchronously, so the driver becomes a *nested* `run` +(`\x -> run h (cont x) k`). That is not a flat loop and loses the row-3 stack +guarantee; it is the row-2 shape, and this mechanism does not adopt it. + ### Lowering: selective CPS to resumable frames +The mechanism compiles the regions that can suspend into an explicit continuation +representation. The concept is **continuation-passing style (CPS)**; the chosen +representation is **defunctionalized resumable frames** driven by a **trampoline**. + +#### Design space + +The design space has three independent axes; earlier drafts were confusing because +they mixed them. + +**Axis 1 — continuation representation.** +- *Closure (CPS).* The continuation is a closure; `perform op = \k h -> h op k` and + `run h c k = c k h`. There is no distinct continuation node: the continuation is + ordinary function data. +- *Defunctionalized.* The continuation is data: either a *free/freer monad* (the whole + computation is an AST, `Pure`/`Impure`, with a bind queue) or a *frame chain* (the + continuation itself is a chain of explicit frame records). +- *Native `cont`.* The continuation is a runtime object capturing the execution stack + (stack switching). + +**Axis 2 — driver.** +- *Tail call.* Each continuation step is a tail call (`return_call*`); constant stack + only if every step is truly in tail position. +- *Trampoline.* A loop repeatedly takes the next step/computation/frame; constant + stack regardless of the step's position. +- *Runtime `suspend`/`resume`.* The runtime captures and reinstalls the stack. + +**Axis 3 — ownership.** The structure is *library-owned* (the library builds and folds +it, as `purescript-run` does) or *compiler-owned* (the compiler lowers the surface to +it). + +**Dispatch.** With a single delimiter there is no dispatch. With several effects or +stacked handlers, a request is routed by the dynamic delimiter chain, by an operation +tag/label, or statically by *evidence passing* (Koka), which removes the runtime +lookup. + +The candidate architectures combine the axes as follows. + +| # | Representation | Driver | Ownership | Continuation state / roots | Notes | +| --- | --- | --- | --- | --- | --- | +| 1 | free/freer monad AST | trampoline (library) | library | heap; GC scans it | `purescript-run`, `freer-simple`; the library folds, so handlers thread state naturally; little compiler involvement | +| 2 | closure (CPS) | tail call | compiler | heap; GC scans it | smallest lowering, no new backend construct; stack safety depends on every step being a tail call; the continuation is opaque (not verifiable) | +| 3 | frame chain (defunctionalized continuation) | trampoline (compiler-generated loop) | compiler | heap; GC scans it | DEC-19's design; tail-call-independent; frame identity / capture boundary / one-shot status are verifiable | +| 4 | native `cont` | runtime `suspend`/`resume` | compiler + runtime | runtime stack; the runtime scans roots | stack switching; a target capability | + +Rows 1–3 are **software continuations** and row 4 is a **native continuation** +([Software and native continuations](#software-and-native-continuations)): rows 1–3 +keep the continuation on the language heap, so the GC finds its roots for free, while +row 4 keeps it in runtime stack memory, so the runtime must scan captured stack slots +and own the lifetime. Only row 2 depends on tail calls: rows 3 and 4 are +tail-call-independent — a trampoline loops, and `suspend` captures non-tail frames +just as well as tail ones. + +Terminology: *capture/reinstall* of a defunctionalized continuation (rows 1 and 3) is +not *suspend/resume* of a native stack (row 4). The frame model's "self-implemented +suspend/resume" is really *capture/reinstall*, driven by a trampoline; the +suspend/resume words belong to stack switching. + +Rows 3 and 1 are the same idea — defunctionalized representation plus an interpreter +loop — differing in what is defunctionalized (the continuation vs the whole +computation) and in ownership, which is an independent axis: a library or a compiler +can own either. Row 2 is not defunctionalized at all: its continuation is a closure +and it leans on tail calls. + +**Whole-program CPS** (CPS-transforming every effectful user function) is a further +candidate but is rejected: it changes calling conventions across Core/CC/MIR and needs +adapters between converted and direct functions, for a direct style this mechanism +does not provide (operations and handlers are monadic here). + +This document's design is row 3. Row 2 is a shorter alternative: a source CPS State +handler written over a rank-2 newtype field compiled and executed on this target (a +`wasmtime` run returning 42), and the official `purs` compiler accepts the same source. +Row 2 is not rejected for expressibility; row 3 is chosen for the guarantees above. + +**The `run` typing is coupled to the representation.** Row 3 naturally supports a +*structure-returning* handler `forall x. f x -> (x -> Control f a) -> Control f a`, +whose result is the next computation, with `run :: ... -> Control f a -> a`. A +*CPS-answer* handler `forall x. f x -> (x -> r) -> r` with a polymorphic `r` is what +threads state (`r = s -> (s, a)`) and changes effects (`r = Control g b`); it is what +row 2 uses directly (`run h c k = c k h`), but a trampoline (row 3) does not obviously +carry it, because the handler's continuation `x -> r` must produce the answer +synchronously. + +How existing systems thread handler state: + +- Row-1 libraries fold a **concrete** computation, with state in the target monad + (`StateT`) or in the fold's own recursion. This mechanism's carrier is opaque, so + the library cannot fold it. +- Row-4 systems (OCaml 5, Koka, Eff) capture the stack and thread state through + handler-local (often mutable) state. +- CPS encodings (`Cont`, `shift`/`reset`) thread state through the answer type — + exactly the CPS-answer `run`, i.e., row 2. + +This mechanism resolves the coupling as row 3 with the **state-threading fold** +([Handler interface for a flat loop](#handler-interface-for-a-flat-loop)): the driver +threads the handler state, so state threading no longer needs the CPS-answer +eliminator and the driver stays flat. Effect removal uses the open-union `handle`, +whose `project`/`inject` the library supplies so the compiler stays row-agnostic. + #### Selective conversion Converting a whole program to CPS would be slow and would change the representation @@ -306,6 +533,12 @@ becomes unreachable and the GC reclaims the frames. The compiler must not drop a live continuation to an optimization, and must not let a dead one keep roots alive beyond its contract. +This is the software-continuation cost model: because the frames are heap objects, +the ordinary GC finds their roots and no separate root information is needed. A +native continuation moves the same obligation to the runtime, which scans captured +stack slots for roots and owns the stack's lifetime +([Software and native continuations](#software-and-native-continuations)). + #### Foreign-call boundaries Suspension cannot cross a non-suspendable host or foreign frame: a captured @@ -315,6 +548,48 @@ would capture across such a boundary unless the boundary declares an explicit suspension protocol. A continuation also cannot retain a borrowed canonical-ABI buffer or a host-resource reference past the boundary's lifetime. +### The executor and the runtime boundary + +The eliminator's driver — the trampoline of [The trampoline](#the-trampoline) — is the +**executor**: the component that turns a `Control` value, a handler, and a handler +state into a result. Where it lives is a design decision with a strict boundary. + +- **The executor is guest code.** It is a compiler-generated loop over the frame + representation, or a library function over a compiler-provided frame view. It runs + in the compiled program because it must call the guest handler and guest + continuations; a host function cannot call back into arbitrary guest closures + without an explicit boundary. +- **The host runtime does not interpret frames.** `psrs-runtime` provides the GC heap + (where frames live), the leaf primitives a request may call (storage, host services, + trap), and linking. It does not inspect the frame layout, index frames, or own a + continuation. Nothing about the software representation crosses the host boundary. +- **The runtime may provide a generic driver loop.** A runtime that loops calling a + guest "step" function is admissible, as long as it treats the step as opaque guest + code and learns nothing about the frame layout. This is optional; a guest-side loop + is the baseline. +- **Under a native continuation the executor disappears.** With stack switching the + runtime captures and resumes the stack itself, so there is no software driver to + place ([Migration to native control](#migration-to-native-control)). + +The executor's contract: + +- Input: a `Control` value, a handler, and the initial handler state `s`. +- Output: `(s, a)` for the closed `run`, or a residual `Control g (s, a)` for `handle`. +- It calls the handler once per handled request and never re-enters itself for a + handled request; forwarded requests build residual data, so re-entry is bounded by + the handler count. +- It preserves the [invariants](#invariants-and-verification): frame identity, capture + boundary, and one-shot status. + +What the compiler and the runtime each own: + +| Concern | Compiler (guest code) | Runtime (`psrs-runtime`) | +| --- | --- | --- | +| Continuation | frame objects and the executor loop | nothing for the software form; `cont` capture/resume for a native form | +| GC roots | frames are GC objects, scanned by the GC | stack scanning only under a native form | +| Leaf operations | ordinary calls to checked bindings | storage, host services, trap | +| Frame layout | defines and verifies it | must not know it | + ### Compiler CPS versus native stack switching DEC-19 selects compiler-generated frames. The alternative, WebAssembly stack @@ -357,6 +632,18 @@ support is not a contract and that a proposal is adopted only by deliberate prof revision, the compiler frames are the correct baseline. Stack switching remains a future accelerator behind a separate decision once the proposal stabilizes. +### Migration to native control + +The frame representation also eases a later move to WebAssembly stack switching, +because the two share one shape: the continuation is explicit and the suspension +protocol is explicit. The mapping is mechanical — a frame chain becomes a `cont` +reference, the compiler-inserted suspension becomes `suspend`, the trampoline's +resume becomes `resume`, and the one-shot status becomes the native consumption. +The `Control` surface and all library and user code stay unchanged; only the +lowering and the target capability change. A closure/CPS representation would need +an added suspension protocol before it mapped as directly. Adopting the native +option remains a separate target-capability decision with its own evidence. + ### Rejected shortcuts - Capturing the Wasm stack from a generic host import; a normal imported function @@ -410,23 +697,26 @@ frames. For the multi-shot surface it does not mutate the chain; for the one-sho API the status transition (`Pending` → `Running` → `Consumed`) is atomic, so a re-entrant resume is rejected. -### Frame construction and trampoline loop +### The executor loop + +The executor is the fold driver ([The executor and the runtime boundary](#the-executor-and-the-runtime-boundary)): ```text -run(initial): - state = initial - loop: - match state: - Return(v) -> return v - Eval(frame) -> state = frame.step() - Suspend(payload, k) -> state = deliver(payload, k) - Resume(k, v) -> state = install(k, v) - Abort -> trap +run h s (Return a) = (s, a) +run h s (Perform op cont) = let (s', next) = h s op cont in run h s' next + +handle h s project inject (Return a) = Return (s, a) +handle h s project inject (Perform uop cont) = + case project uop of + Left fop -> let (s', next) = h s fop cont in handle h s' project inject next + Right gop -> Bind (Perform_g gop) (\x -> handle h s project inject (cont x)) ``` -`install(k, v)` continues the captured chain with `v` as the suspended step's -result. `deliver` calls the delimiter's handler; a handler that returns without -resuming produces a normal answer, and its continuation becomes unreachable. +`handle` threads the handler state and forwards unhandled requests to the residual; +the loop recurses in tail position for handled requests, so the executor never grows +the native stack with computation depth. A handler that returns without resuming +leaves its continuation unreachable; deep and shallow differ only in whether `h` +re-wraps the continuation. ### Deep-handler reinstatement @@ -461,15 +751,18 @@ This is the design target, not a claim that these APIs exist yet: | Location | Intended responsibility | | --- | --- | -| `Prim.Control` owner | The abstract `Control f a` carrier and the `return`/`bind`/`perform`/`run` primitives, with their checked schemes | -| MIR control-lowering owner | Selective CPS/defunctionalization, the frame table, the trampoline, deep/shallow wrapping, and one-shot status | +| `Prim.Control` owner | The abstract `Control f a` carrier and the `return`/`bind`/`perform`/`run`/`handle` primitives, with their checked schemes | +| MIR control-lowering owner | Selective CPS/defunctionalization, the frame table, deep/shallow wrapping, and one-shot status | +| Executor (guest code) | The loop that drives frames against a handler and threads its state; compiler-generated or a library function over a frame view; never a runtime interpreter of the frame layout | | MIR verifier | Frame identity, capture boundary, continuation result-type, and suspension-observability checks | -| Existing Core/CC/MIR lowering and optimizers | Compile the converted frames as ordinary higher-order code; preserve generic observable-call semantics | +| Existing Core/CC/MIR lowering and optimizers | Compile the converted frames and the executor as ordinary higher-order code; preserve generic observable-call semantics | +| `psrs-runtime` (software form) | GC heap, leaf primitives, trap, and linking; provides no continuation and must not learn the frame layout | | Runtime control owner, only if separately adopted | Stack-switching ABI, captured-root storage, lifecycle checks, and capability requirements | No compiler-side operation registry, handler IR, or effect-specific solver is -required. Runtime control module names and entry-point signatures remain unselected -until a target option is explicitly adopted. +required. The runtime carries no continuation for the software form; runtime control +module names and entry-point signatures remain unselected until a target option is +explicitly adopted. ## Invariants and verification @@ -520,6 +813,10 @@ the compiler adds no ambient effect inference. It is the only compiler-owned par the effects story; operations, rows, handlers, and the one-shot/multi-shot API are library code ([library-owned effects](algebraic-effects-and-handlers.md#ownership)). +For the software form the runtime carries no continuation: the executor is guest code +and `psrs-runtime` provides only the GC heap, leaf primitives, and trap +([The executor and the runtime boundary](#the-executor-and-the-runtime-boundary)). + The baseline target profile does not gain stack switching through this design. A native resumption option requires a pinned target capability, an MIR/lowering contract, validator coverage, and actual execution evidence. An unsupported @@ -527,6 +824,10 @@ capability is an error, never a silent change to continuation semantics. ## Open questions and future work +The eliminator is settled — the state-threading fold with the open-union `handle` +([Handler interface for a flat loop](#handler-interface-for-a-flat-loop)). The +following remain open. + 1. **Direct-style surface sugar.** Effect typing is out of scope (see [Scope](#scope)). A non-typed syntax that desugars to the monadic API is a separate, uncommitted option; it would add no effect tracking, but it would add @@ -538,7 +839,7 @@ capability is an error, never a silent change to continuation semantics. foreign frame is rejected by the lowering; a boundary that needs to suspend across it must define an explicit protocol and its lifetime contract. 4. **Performance.** Measure allocation, frame churn, and deep execution to set the - lowering's performance contract. + lowering's performance cost. ## References From 1633dd88ac9f1687ae2376efed7b978d43ae8638 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 19:00:35 +0800 Subject: [PATCH 098/148] Add the compiler-owned delimited-control surface (Prim.Control) Introduce Prim.Control, the effect-agnostic delimited-control interface: the opaque Control f a carrier and return/bind/perform/run/handle with checked schemes. run is the closed state-threading fold (s -> handler -> Control f a -> (s, a)); handle is the open eliminator that interprets the f requests of a computation over a combined effect u and leaves the rest as a residual Control g (s, a), with the library supplying project/inject as a Church-encoded sum so the compiler stays row-agnostic. Register the carrier and primitives with stable identities, kind, roles, and effect summaries; expose handle alongside return/bind/perform/run; and report the primitives as explicitly unsupported in the backend until the selective-CPS/resumable-frame lowering lands. Add frontend acceptance tests for the fold run, the open handle, and the rejection of result-type confusion and a monomorphic handler. --- .../psrs-backend/src/target_intrinsics/mod.rs | 8 + .../src/target_intrinsics/tests.rs | 19 +- crates/psrs-driver/tests/control_surface.rs | 124 +++++++++++++ crates/psrs-hir/src/compiler_interface.rs | 15 ++ crates/psrs-hir/src/intrinsic/effects.rs | 12 +- crates/psrs-hir/src/intrinsic/mod.rs | 24 ++- crates/psrs-hir/src/intrinsic/registry.rs | 170 +++++++++++++++++- crates/psrs-hir/src/lib.rs | 3 + crates/psrs-hir/src/primitives/control.rs | 23 +++ crates/psrs-hir/src/primitives/mod.rs | 2 + crates/psrs-hir/src/primitives/tests.rs | 8 +- 11 files changed, 402 insertions(+), 6 deletions(-) create mode 100644 crates/psrs-driver/tests/control_surface.rs create mode 100644 crates/psrs-hir/src/primitives/control.rs diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 817b7a4e..b1da397d 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -118,6 +118,14 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Elaborated } Intrinsic::Undefined => Unsupported, + // The delimited-control primitives have no target implementation until + // the selective-CPS/resumable-frame lowering lands; they are reported as + // unsupported rather than lowered as a placeholder. + Intrinsic::ControlReturn + | Intrinsic::ControlBind + | Intrinsic::ControlPerform + | Intrinsic::ControlRun + | Intrinsic::ControlHandle => Unsupported, } } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 92e45e3d..5f174ea3 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -18,7 +18,19 @@ fn every_active_identity_has_an_explicit_implementation() { intrinsic.descriptor().arity as usize ); } - Implementation::Unsupported => assert_eq!(intrinsic, Intrinsic::Undefined), + Implementation::Unsupported => assert!( + matches!( + intrinsic, + Intrinsic::Undefined + | Intrinsic::ControlReturn + | Intrinsic::ControlBind + | Intrinsic::ControlPerform + | Intrinsic::ControlRun + | Intrinsic::ControlHandle + ), + "{} has no explicit implementation", + intrinsic.descriptor().name + ), Implementation::Generated(_) | Implementation::Elaborated => {} } } @@ -45,6 +57,11 @@ fn language_renaming_preserves_stable_symbols_and_retired_slots() { (Intrinsic::NumberAtan2, 73), (Intrinsic::NumberSin, 74), (Intrinsic::NumberInfinity, 86), + (Intrinsic::ControlReturn, 92), + (Intrinsic::ControlBind, 93), + (Intrinsic::ControlPerform, 94), + (Intrinsic::ControlRun, 95), + (Intrinsic::ControlHandle, 96), ] { assert_eq!(intrinsic.symbol().index, id); } diff --git a/crates/psrs-driver/tests/control_surface.rs b/crates/psrs-driver/tests/control_surface.rs new file mode 100644 index 00000000..ecc46187 --- /dev/null +++ b/crates/psrs-driver/tests/control_surface.rs @@ -0,0 +1,124 @@ +//! Frontend acceptance for the compiler-owned delimited-control surface. +//! +//! `Prim.Control` exposes the effect-agnostic `Control f a` carrier with +//! `return`/`bind`/`perform`/`run`/`handle` ([DEC-19](../../../docs/decision/DEC-19-compiler-generated-resumable-frames.md), +//! [delimited control and resumable frames](../../../docs/design/backend/fp/delimited-control-and-resumable-frames.md)). +//! The selective CPS / resumable-frame lowering is not implemented, so these +//! tests check source acceptance and rejection (P0-P5) only; they do not claim +//! execution. + +/// A well-typed program over an opaque request functor, interpreted by the +/// closed state-threading `run`. `Op`'s answer type is `Int`, and the handler +/// threads an `Int` state, so `run 0 handler program` is `{ _1 :: Int, _2 :: Int }`. +const ACCEPTS: &str = r#"module Main where + +import Prim.Control as C + +data Op next = Op (Int -> next) + +program :: C.Control Op Int +program = C.perform (Op \x -> x) + +runProgram :: { _1 :: Int, _2 :: Int } +runProgram = C.run 0 handler program + where + handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } + handler s (Op k) cont = { _1: s, _2: cont (k s) } + +main :: Int +main = runProgram._2 +"#; + +/// A `Control f a` computation is not interchangeable with its result type. +const REJECTS_RESULT_TYPE: &str = r#"module Main where + +import Prim.Control as C + +data Op next = Op (Int -> next) + +program :: C.Control Op Int +program = C.perform (Op \x -> x) + +bad :: Int +bad = program +"#; + +/// `run`'s handler must be rank-2: a handler specialized to one answer type +/// cannot satisfy the polymorphic argument. +const REJECTS_MONOMORPHIC_HANDLER: &str = r#"module Main where + +import Prim.Control as C + +data Op next = Op (Int -> next) + +program :: C.Control Op Int +program = C.perform (Op \x -> x) + +mono :: Int -> Op Int -> (Int -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +mono s (Op k) cont = { _1: s, _2: cont (k s) } + +bad :: { _1 :: Int, _2 :: Int } +bad = C.run 0 mono program +"#; + +/// The open eliminator removes one effect: `handle` interprets the `F` requests +/// of a computation over the combined effect `U` and leaves the `G` requests as a +/// residual `Control G`. +const HANDLES_ONE_EFFECT: &str = r#"module Main where + +import Prim.Control as C + +data F next = F (Int -> next) +data G next = G (Int -> next) +data U next = UF (F next) | UG (G next) + +project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r +project u onF onG = case u of + UF f -> onF f + UG g -> onG g + +inject :: forall x. G x -> U x +inject = UG + +handler :: forall x. Int -> F x -> (x -> C.Control U Int) -> { _1 :: Int, _2 :: C.Control U Int } +handler s (F k) cont = { _1: s, _2: cont (k s) } + +program :: C.Control U Int +program = C.bind (C.perform (UF (F \x -> x))) \_ -> C.perform (UG (G \x -> x)) + +handled :: C.Control G { _1 :: Int, _2 :: Int } +handled = C.handle 0 handler project inject program + +main :: Int +main = 0 +"#; + +#[test] +fn control_surface_typechecks() { + if let Err(errors) = psrs_driver::check_source("Main.purs", ACCEPTS) { + panic!("control surface rejected: {errors:?}"); + } +} + +#[test] +fn control_surface_handles_one_effect() { + if let Err(errors) = psrs_driver::check_source("Main.purs", HANDLES_ONE_EFFECT) { + panic!("open handle rejected: {errors:?}"); + } +} + +#[test] +fn control_surface_rejects_result_type_confusion() { + assert!( + psrs_driver::check_source("Main.purs", REJECTS_RESULT_TYPE).is_err(), + "a computation used as its own result type must be rejected" + ); +} + +#[test] +fn control_surface_requires_a_rank_two_handler() { + assert!( + psrs_driver::check_source("Main.purs", REJECTS_MONOMORPHIC_HANDLER).is_err(), + "a monomorphic handler must not satisfy run's rank-2 argument" + ); +} diff --git a/crates/psrs-hir/src/compiler_interface.rs b/crates/psrs-hir/src/compiler_interface.rs index 8243421e..6251f9db 100644 --- a/crates/psrs-hir/src/compiler_interface.rs +++ b/crates/psrs-hir/src/compiler_interface.rs @@ -39,6 +39,21 @@ pub const COMPILER_INTERFACES: &[CompilerInterface] = &[ types: &[], classes: &[("IsSymbol", CompilerClass::IsSymbol)], }, + // The effect-agnostic delimited-control surface. The carrier and the four + // primitives are compiler-owned; no pass recognizes a concrete operation. + CompilerInterface { + module: "Prim.Control", + implementation: InterfaceImplementation::Compiler, + values: &[ + ("return", Intrinsic::ControlReturn), + ("bind", Intrinsic::ControlBind), + ("perform", Intrinsic::ControlPerform), + ("run", Intrinsic::ControlRun), + ("handle", Intrinsic::ControlHandle), + ], + types: &[("Control", TypeId::CONTROL)], + classes: &[], + }, ]; pub fn compiler_interface(module: &str) -> Option<&'static CompilerInterface> { diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 4613d5e7..c3e11910 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -21,6 +21,14 @@ impl IntrinsicEffects { may_trap: true, may_write: false, }, + // Executing a delimiter runs the handler and the continuation, which + // can trap or mutate storage; the summary is deliberately + // conservative. `return`/`bind`/`perform` only build an inert + // computation, so they carry no effect of their own. + ControlRun | ControlHandle => Self { + may_trap: true, + may_write: true, + }, BoolTrue | BoolFalse | IntAdd | IntSub | IntMul | IntEq | IntNe | IntLt | IntLe | IntGt | IntGe | ArrayLength | IntNeg | IntComplement | NumberNeg | BooleanNot | IntToNumber | NumberToInt | BooleanToInt | IntToBoolean | CharToInt | IntToChar @@ -31,7 +39,9 @@ impl IntrinsicEffects { | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin | NumberAtan | NumberAtan2 | NumberSin | NumberCos | NumberTan | NumberExp | NumberLog | NumberPow | NumberMin | NumberMax | NumberSign | NumberRemainder | NumberIsNaN - | NumberNaN | NumberInfinity => Self::default(), + | NumberNaN | NumberInfinity | ControlReturn | ControlBind | ControlPerform => { + Self::default() + } } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 2e2bdd1f..353069d6 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -164,6 +164,21 @@ pub enum Intrinsic { NumberNaN = 85, /// Positive infinity. NumberInfinity = 86, + /// `Prim.Control.return`: lift a value into the control computation. + ControlReturn = 92, + /// `Prim.Control.bind`: sequence two control computations. + ControlBind = 93, + /// `Prim.Control.perform`: suspend at a request, delivering it to the + /// nearest `run` delimiter. + ControlPerform = 94, + /// `Prim.Control.run`: install a delimiter and interpret requests. The + /// handler is rank-2 in the request's answer type and threads a handler + /// state. + ControlRun = 95, + /// `Prim.Control.handle`: the open eliminator. It interprets the `f` + /// operations of a computation over a combined effect `u` and leaves the + /// rest as a residual `Control g (s, a)`. + ControlHandle = 96, } impl Intrinsic { @@ -191,7 +206,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. Binding resolution uses the /// complete list. - pub const ALL: [Intrinsic; 85] = [ + pub const ALL: [Intrinsic; 90] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -277,6 +292,11 @@ impl Intrinsic { Intrinsic::NumberIsNaN, Intrinsic::NumberNaN, Intrinsic::NumberInfinity, + Intrinsic::ControlReturn, + Intrinsic::ControlBind, + Intrinsic::ControlPerform, + Intrinsic::ControlRun, + Intrinsic::ControlHandle, ]; } @@ -285,7 +305,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() == 92, + Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() == 97, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index eaa19d2f..f5ded84b 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -9,7 +9,7 @@ //! silently. use super::{Intrinsic, IntrinsicEffects}; -use crate::{BuiltinType, Type, TypeId, TypeKind, TypeParameter}; +use crate::{BuiltinType, Type, TypeField, TypeId, TypeKind, TypeParameter}; use psrs_span::TextRange; /// A representation-independent classification of an intrinsic: what kind of @@ -43,6 +43,9 @@ pub enum IntrinsicCategory { Coercion, /// `Prim.undefined`: a value with no runtime representation. PartialValue, + /// A compiler-owned delimited-control primitive: `Control`'s + /// `return`/`bind`/`perform`/`run`. + Control, } /// The metadata for one intrinsic. @@ -172,6 +175,11 @@ descriptors! { ArrayWrite => "arrayWrite", 3, ArrayWrite, scheme::array_update; NumberToString => "numberToString", 1, Unary, scheme::number_string; NumberFromDecimal => "numberFromDecimal", 1, Unary, scheme::string_number; + ControlReturn => "controlReturn", 1, Control, scheme::control_return; + ControlBind => "controlBind", 2, Control, scheme::control_bind; + ControlPerform => "controlPerform", 1, Control, scheme::control_perform; + ControlRun => "controlRun", 3, Control, scheme::control_run; + ControlHandle => "controlHandle", 5, Control, scheme::control_handle; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that @@ -408,6 +416,166 @@ mod scheme { pub(super) fn unsafe_coerce() -> Type { forall(&["a", "b"], arrow(variable("a"), variable("b"))) } + + /// `Control f a`: a computation over the opaque request functor `f` that + /// yields an `a`, possibly after suspending at `perform`. + fn control(of: Type, value: Type) -> Type { + apply(apply(named(TypeId::CONTROL), of), value) + } + + /// `Prim.Control.return :: forall f a. a -> Control f a`. + pub(super) fn control_return() -> Type { + forall( + &["f", "a"], + arrow(variable("a"), control(variable("f"), variable("a"))), + ) + } + + /// `Prim.Control.bind :: forall f a b. Control f a -> (a -> Control f b) -> Control f b`. + pub(super) fn control_bind() -> Type { + forall( + &["f", "a", "b"], + arrow( + control(variable("f"), variable("a")), + arrow( + arrow(variable("a"), control(variable("f"), variable("b"))), + control(variable("f"), variable("b")), + ), + ), + ) + } + + /// `Prim.Control.perform :: forall f a. f a -> Control f a`. + pub(super) fn control_perform() -> Type { + forall( + &["f", "a"], + arrow( + apply(variable("f"), variable("a")), + control(variable("f"), variable("a")), + ), + ) + } + + /// A closed two-field record, used for the `(state, value)` result. + fn record(fields: &[(&str, Type)]) -> Type { + Type { + kind: TypeKind::Record { + fields: fields + .iter() + .map(|(label, ty)| TypeField { + label: (*label).to_owned(), + label_span: empty_span(), + ty: ty.clone(), + span: empty_span(), + }) + .collect(), + tail: None, + }, + span: empty_span(), + } + } + + /// `Prim.Control.run`, the closed state-threading fold: + /// `forall f a s. s -> (forall x. s -> f x -> (x -> Control f a) -> + /// (s, Control f a)) -> Control f a -> (s, a)`. + pub(super) fn control_run() -> Type { + let handler = forall( + &["x"], + arrow( + variable("s"), + arrow( + apply(variable("f"), variable("x")), + arrow( + arrow(variable("x"), control(variable("f"), variable("a"))), + record(&[ + ("_1", variable("s")), + ("_2", control(variable("f"), variable("a"))), + ]), + ), + ), + ), + ); + forall( + &["f", "a", "s"], + arrow( + variable("s"), + arrow( + handler, + arrow( + control(variable("f"), variable("a")), + record(&[("_1", variable("s")), ("_2", variable("a"))]), + ), + ), + ), + ) + } + + /// `Prim.Control.handle`, the open eliminator: + /// `forall f g u a s. s` + /// `-> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a))` + /// `-> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r)` (project) + /// `-> (forall x. g x -> u x)` (inject) + /// `-> Control u a -> Control g (s, a)`. + pub(super) fn control_handle() -> Type { + let handler = forall( + &["x"], + arrow( + variable("s"), + arrow( + apply(variable("f"), variable("x")), + arrow( + arrow(variable("x"), control(variable("u"), variable("a"))), + record(&[ + ("_1", variable("s")), + ("_2", control(variable("u"), variable("a"))), + ]), + ), + ), + ), + ); + let project = forall( + &["x", "r"], + arrow( + apply(variable("u"), variable("x")), + arrow( + arrow(apply(variable("f"), variable("x")), variable("r")), + arrow( + arrow(apply(variable("g"), variable("x")), variable("r")), + variable("r"), + ), + ), + ), + ); + let inject = forall( + &["x"], + arrow( + apply(variable("g"), variable("x")), + apply(variable("u"), variable("x")), + ), + ); + forall( + &["f", "g", "u", "a", "s"], + arrow( + variable("s"), + arrow( + handler, + arrow( + project, + arrow( + inject, + arrow( + control(variable("u"), variable("a")), + control( + variable("g"), + record(&[("_1", variable("s")), ("_2", variable("a"))]), + ), + ), + ), + ), + ), + ), + ) + } } #[cfg(test)] diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index 6f24253c..79419fe3 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -106,6 +106,9 @@ impl TypeId { pub const PRIM_TYPE_ERROR_QUOTE_LABEL: Self = Self::new(ModuleId::INTRINSICS, 28); pub const PRIM_TYPE_ERROR_BESIDE: Self = Self::new(ModuleId::INTRINSICS, 29); pub const PRIM_TYPE_ERROR_ABOVE: Self = Self::new(ModuleId::INTRINSICS, 30); + /// Stable identity of the compiler-owned `Prim.Control.Control` carrier, the + /// effect-agnostic delimited-control computation type. + pub const CONTROL: Self = Self::new(ModuleId::INTRINSICS, 31); } mod intrinsic; diff --git a/crates/psrs-hir/src/primitives/control.rs b/crates/psrs-hir/src/primitives/control.rs new file mode 100644 index 00000000..dfa653ad --- /dev/null +++ b/crates/psrs-hir/src/primitives/control.rs @@ -0,0 +1,23 @@ +use super::*; + +/// The `Prim.Control` interface's carrier type. `Control f a` is an opaque +/// computation over the request functor `f` that yields an `a`, possibly after +/// suspending at `perform`. Its representation is owned by the control lowering; +/// this declaration fixes only its identity, kind, and roles. +pub(super) fn declarations() -> Vec<(&'static str, TypeDeclaration)> { + vec![( + "Prim.Control", + foreign_type( + TypeId::CONTROL, + "Control", + arrow_kind( + vec![ + arrow_kind(vec![builtin(BuiltinType::Type)], builtin(BuiltinType::Type)), + builtin(BuiltinType::Type), + ], + builtin(BuiltinType::Type), + ), + &[Role::Representational, Role::Representational], + ), + )] +} diff --git a/crates/psrs-hir/src/primitives/mod.rs b/crates/psrs-hir/src/primitives/mod.rs index 9c9f4777..959dc5c3 100644 --- a/crates/psrs-hir/src/primitives/mod.rs +++ b/crates/psrs-hir/src/primitives/mod.rs @@ -4,6 +4,7 @@ use crate::{ }; use psrs_span::TextRange; +mod control; mod core; mod numbers; mod rows; @@ -16,6 +17,7 @@ mod tests; /// shared type spine. Each declaration is owned by its virtual interface. pub fn primitive_type_declarations() -> Vec<(&'static str, TypeDeclaration)> { [ + control::declarations(), core::declarations(), rows::declarations(), numbers::declarations(), diff --git a/crates/psrs-hir/src/primitives/tests.rs b/crates/psrs-hir/src/primitives/tests.rs index 09b0c791..16944572 100644 --- a/crates/psrs-hir/src/primitives/tests.rs +++ b/crates/psrs-hir/src/primitives/tests.rs @@ -43,6 +43,11 @@ const OFFICIAL_MEMBERS: &[(&str, &str)] = &[ ("Prim.TypeError", "Text"), ]; +/// Compiler-owned members that extend the official `Prim.*` environment. They +/// are not part of PureScript's `primModules`, so they are recorded separately +/// and never folded into the official transcription above. +const COMPILER_EXTENSIONS: &[(&str, &str)] = &[("Prim.Control", "Control")]; + fn declared(owner: &str, name: &str) -> TypeDeclaration { primitive_type_declarations() .into_iter() @@ -60,12 +65,13 @@ fn every_official_primitive_member_is_declared_exactly_once() { declared.sort(); let mut official = OFFICIAL_MEMBERS .iter() + .chain(COMPILER_EXTENSIONS.iter()) .map(|(owner, name)| ((*owner).to_owned(), (*name).to_owned())) .collect::>(); official.sort(); assert_eq!( declared, official, - "the registry must declare exactly the official `Prim` members" + "the registry must declare exactly the official `Prim` members plus the recorded compiler extensions" ); } From 64a27de8b9dadc760aea05b691a0645c3cc29584 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 19:21:39 +0800 Subject: [PATCH 099/148] Lower Control frames and the return path of the executor Give Control f a a runtime frame representation and lower return/perform/bind to frames plus an inline executor for the closed run. The frame is a shared variant { Return[Erased], Perform[Erased], Bind[Erased,Erased] }. Control is treated as an opaque aggregate, so its shape needs no scalar_type change, and the frame representation is reserved by the layout and threaded through the lowering context. run reads the frame tag and builds the (state, value) result for a return frame. Its perform/bind cases trap until the executor grows a loop, and handle is not lowered yet; both report explicit errors. Return/run now execute end to end -- a source program exits 42 under wasmtime -- and a driver test covers it. --- .../src/cc/case/decision/realize/tests/mod.rs | 1 + .../decision/realize/tests/nested_tests.rs | 1 + .../decision/realize/tests/newtype_tests.rs | 1 + .../tests/parameterized_tests/support.rs | 1 + .../decision/realize/tests/product_tests.rs | 1 + .../decision/realize/tests/record_tests.rs | 1 + crates/psrs-backend/src/cc/layout/mod.rs | 46 ++++- .../src/cc/lower/conversion/tests.rs | 1 + crates/psrs-backend/src/cc/lower/intrinsic.rs | 180 +++++++++++++++++- .../psrs-backend/src/cc/lower/lambda/mod.rs | 1 + crates/psrs-backend/src/cc/lower/mod.rs | 3 + crates/psrs-backend/src/cc/mod.rs | 7 +- .../psrs-backend/src/target_intrinsics/mod.rs | 5 +- .../src/target_intrinsics/tests.rs | 14 +- crates/psrs-driver/tests/control_surface.rs | 56 ++++++ 15 files changed, 306 insertions(+), 13 deletions(-) diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs index 723be3c0..b2e7730f 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs @@ -144,6 +144,7 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs index 34251dd6..0e731a31 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs @@ -193,6 +193,7 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs index 4505c246..92f4ddf5 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs @@ -133,6 +133,7 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs index 522d8757..fb4fd6d0 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs @@ -61,6 +61,7 @@ pub(super) fn lower_and_verify( newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: context.array_types, record_types: context.record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs index 482cc45d..41f05dcd 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs @@ -129,6 +129,7 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs index 10baa07d..55245f2e 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs @@ -153,6 +153,7 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index f01c5228..7575cbc6 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -1,5 +1,8 @@ use super::VariantCase; -use super::{ReprId, Representation, RepresentationTable, Signature, SignatureId, ValueShape}; +use super::{ + RefShape, Reference, ReprId, Representation, RepresentationTable, Signature, SignatureId, + ValueShape, +}; use crate::BackendError; use psrs_core::{Module as CoreModule, Type, TypeConstructor, TypeId}; use psrs_hir::{SymbolId, TypeId as HirTypeId, TypeVariableId}; @@ -178,6 +181,38 @@ pub(super) fn type_layout( ) -> Result> { let mut representations = RepresentationTable::default(); + // The frame representation shared by every `Control f a` instantiation: a + // tagged variant with `Return` (one erased value), `Perform` (an erased + // request and its erased continuation), and `Bind` (an inner computation + // and its erased continuation). + let control_type = { + let erased = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }); + let id = representations.reserve(); + representations.set( + id, + Representation::Variant { + cases: vec![ + VariantCase { + tag: 0, + fields: vec![erased], + }, + VariantCase { + tag: 1, + fields: vec![erased], + }, + VariantCase { + tag: 2, + fields: vec![erased, erased], + }, + ], + }, + ); + Some(id) + }; + let boxed_integer_type = if module .types .iter() @@ -250,7 +285,11 @@ pub(super) fn type_layout( let record_types = aggregate_layouts.records; let mut constructor_types = HashMap::new(); - let mut aggregate_ids = aggregate_types.iter().copied().collect::>(); + let mut aggregate_ids = aggregate_types + .iter() + .copied() + .filter(|id| *id != HirTypeId::CONTROL) + .collect::>(); aggregate_ids.sort_by_key(|id| (id.module.0, id.index)); for type_id in aggregate_ids { let id = representations.reserve(); @@ -312,6 +351,7 @@ pub(super) fn type_layout( boxed_integer_type, boxed_number_type, function_types, + control_type, }) } @@ -328,6 +368,8 @@ pub(super) struct TypeLayout { pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, pub(super) function_types: HashMap, + /// The shared frame representation for `Control f a` values. + pub(super) control_type: Option, } pub(super) fn newtype_field_type(module: &CoreModule, type_id: HirTypeId) -> Option { diff --git a/crates/psrs-backend/src/cc/lower/conversion/tests.rs b/crates/psrs-backend/src/cc/lower/conversion/tests.rs index d852276f..d161520e 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/tests.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/tests.rs @@ -51,6 +51,7 @@ fn unsupported_typed_boundary_reports_its_source_span() { newtype_ids: &ids, boxed_integer_type: None, boxed_number_type: None, + control_type: None, array_types: &reprs, record_types: &reprs, constructor_tags: &tags, diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index b4fd38fa..5ba80a50 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -4,9 +4,10 @@ //! every intrinsic. The array, string, and scalar helpers this dispatches to are //! the same ones the previous per-operation expressions used. -use super::super::{Assignment, AssignmentKind, ValueId, ValueShape}; +use super::super::{Assignment, AssignmentKind, BinaryOp, ValueId, ValueShape}; use super::FunctionLowerer; use crate::BackendError; +use crate::cc::payload::erased_shape; use crate::target_intrinsics::{ GeneratedOperation as G, Implementation, ScalarOperation, implementation, }; @@ -149,6 +150,9 @@ impl FunctionLowerer<'_> { }); Ok(destination) } + Implementation::Control => { + self.lower_control(expression, intrinsic, arguments, ty, assignments) + } Implementation::Elaborated | Implementation::Unsupported => { Err(vec![BackendError::invalid_ir( "P8 closure conversion", @@ -158,4 +162,178 @@ impl FunctionLowerer<'_> { } } } + + /// Lowers a `Prim.Control` primitive to a frame in the shared control + /// representation. `return`/`perform`/`bind` build frames; the executor + /// (`run`/`handle`) is not lowered yet. + pub(super) fn lower_control( + &mut self, + expression: &Expr, + intrinsic: Intrinsic, + arguments: &[Expr], + ty: ValueShape, + assignments: &mut Vec, + ) -> Result> { + let Some(representation) = self.control_type else { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "control primitive used without a frame representation", + )]); + }; + let (case, fields): (u32, Vec<&Expr>) = match intrinsic { + Intrinsic::ControlReturn => (0, vec![&arguments[0]]), + Intrinsic::ControlPerform => (1, vec![&arguments[0]]), + Intrinsic::ControlBind => (2, vec![&arguments[0], &arguments[1]]), + Intrinsic::ControlRun => { + return self.lower_control_run(expression, arguments, ty, assignments); + } + Intrinsic::ControlHandle => { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "the open control handler is not lowered yet", + )]); + } + _ => { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "not a control primitive", + )]); + } + }; + let mut values = Vec::with_capacity(fields.len()); + for field in fields { + values.push(self.lower_array_element(field, assignments)?); + } + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::VariantNew { + destination, + representation, + case, + fields: values, + }, + span: expression.span, + }); + Ok(destination) + } + + /// Lowers `ControlRun` inline: read the frame tag and, for a `return` frame, + /// build the `(state, value)` result. `perform`/`bind` frames trap until the + /// executor grows those cases. + fn lower_control_run( + &mut self, + expression: &Expr, + arguments: &[Expr], + ty: ValueShape, + assignments: &mut Vec, + ) -> Result> { + let Some(representation) = self.control_type else { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "control primitive used without a frame representation", + )]); + }; + let Some(record_representation) = self.record_types.get(&expression.ty).copied() else { + return Err(vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "control run result is not a represented record", + )]); + }; + let value_type = self + .module + .record_field(expression.ty, "_2") + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 closure conversion", + expression.span, + "control run result record has no value field", + )] + })?; + let value_shape = self.value_shape(value_type, expression.span)?; + let state = self.lower_value(&arguments[0], assignments)?; + let _handler = self.lower_value(&arguments[1], assignments)?; + let computation = self.lower_value(&arguments[2], assignments)?; + let plan = self.recover_payload(value_shape, expression.span)?; + + let zero = self.fresh(ValueShape::Integer); + let tag = self.fresh(ValueShape::Integer); + let condition = self.fresh(ValueShape::Boolean); + let payload_erased = self.fresh(erased_shape()); + let mut then_assignments = vec![Assignment { + destination: payload_erased, + kind: AssignmentKind::VariantGet { + destination: payload_erased, + representation, + case: 0, + field: 0, + value: computation, + }, + span: expression.span, + }]; + let payload = self.emit_conversion( + payload_erased, + erased_shape(), + value_shape, + plan, + expression.span, + &mut then_assignments, + ); + let record = self.fresh(ty); + then_assignments.push(Assignment { + destination: record, + kind: AssignmentKind::ProductNew { + destination: record, + representation: record_representation, + arguments: vec![state, payload], + }, + span: expression.span, + }); + let trap = self.fresh(ty); + let result = self.fresh(ty); + assignments.push(Assignment { + destination: zero, + kind: AssignmentKind::Constant(0), + span: expression.span, + }); + assignments.push(Assignment { + destination: tag, + kind: AssignmentKind::VariantTag { + destination: tag, + representation, + value: computation, + }, + span: expression.span, + }); + assignments.push(Assignment { + destination: condition, + kind: AssignmentKind::Primitive { + op: BinaryOp::IntEq, + left: tag, + right: zero, + }, + span: expression.span, + }); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::If { + condition, + then_assignments, + then_value: record, + else_assignments: vec![Assignment { + destination: trap, + kind: AssignmentKind::Unreachable, + span: expression.span, + }], + else_value: trap, + }, + span: expression.span, + }); + Ok(result) + } } diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index 24c5f99d..49545b5c 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -321,6 +321,7 @@ impl LambdaLowering for FunctionLowerer<'_> { newtype_ids: self.newtype_ids, boxed_integer_type: self.boxed_integer_type, boxed_number_type: self.boxed_number_type, + control_type: self.control_type, array_types: self.array_types, record_types: self.record_types, constructor_tags: self.constructor_tags, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 99791a20..589f7985 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -45,6 +45,7 @@ pub(super) struct LoweringContext<'a> { pub(super) newtype_ids: &'a HashSet, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, + pub(super) control_type: Option, pub(super) array_types: &'a HashMap, pub(super) record_types: &'a HashMap, pub(super) constructor_tags: &'a HashMap, @@ -74,6 +75,7 @@ pub(super) fn lower_function( newtype_ids: context.newtype_ids, boxed_integer_type: context.boxed_integer_type, boxed_number_type: context.boxed_number_type, + control_type: context.control_type, array_types: context.array_types, record_types: context.record_types, constructor_tags: context.constructor_tags, @@ -216,6 +218,7 @@ pub(super) struct FunctionLowerer<'a> { pub(super) newtype_ids: &'a HashSet, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, + pub(super) control_type: Option, pub(super) array_types: &'a HashMap, pub(super) record_types: &'a HashMap, pub(super) constructor_tags: &'a HashMap, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index c5b7f46d..5ffdb1b3 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -300,7 +300,11 @@ pub(crate) fn lower_module_with_relations( } let newtype_ids = module.newtype_ids.iter().copied().collect(); let enum_types = enum_type_ids(&module, &newtype_ids); - let aggregate_types = aggregate_type_ids(&module, &newtype_ids); + let mut aggregate_types = aggregate_type_ids(&module, &newtype_ids); + // `Prim.Control`'s `Control f a` is an opaque aggregate: the layout reserves + // its frame representation, and its shape is the erased aggregate reference + // so this slice needs no `scalar_type` change. + aggregate_types.insert(HirTypeId::CONTROL); let layout = type_layout(&module, &enum_types, &aggregate_types, &newtype_ids)?; let mut constructor_tags = HashMap::new(); let mut constructors_by_type: HashMap> = HashMap::new(); @@ -428,6 +432,7 @@ pub(crate) fn lower_module_with_relations( newtype_ids: &newtype_ids, boxed_integer_type: layout.boxed_integer_type, boxed_number_type: layout.boxed_number_type, + control_type: layout.control_type, array_types: &layout.array_types, record_types: &layout.record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index b1da397d..5da73998 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -28,6 +28,9 @@ pub(crate) enum Implementation { Generated(GeneratedOperation), Artifact(&'static ArtifactImplementation), Elaborated, + /// A compiler-owned delimited-control primitive, lowered to frame + /// construction or the executor by CC. + Control, Unsupported, } @@ -125,7 +128,7 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { | Intrinsic::ControlBind | Intrinsic::ControlPerform | Intrinsic::ControlRun - | Intrinsic::ControlHandle => Unsupported, + | Intrinsic::ControlHandle => Control, } } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index 5f174ea3..c5f1a524 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -18,19 +18,17 @@ fn every_active_identity_has_an_explicit_implementation() { intrinsic.descriptor().arity as usize ); } - Implementation::Unsupported => assert!( - matches!( + Implementation::Unsupported => assert_eq!(intrinsic, Intrinsic::Undefined), + Implementation::Control => { + assert!(matches!( intrinsic, - Intrinsic::Undefined - | Intrinsic::ControlReturn + Intrinsic::ControlReturn | Intrinsic::ControlBind | Intrinsic::ControlPerform | Intrinsic::ControlRun | Intrinsic::ControlHandle - ), - "{} has no explicit implementation", - intrinsic.descriptor().name - ), + )); + } Implementation::Generated(_) | Implementation::Elaborated => {} } } diff --git a/crates/psrs-driver/tests/control_surface.rs b/crates/psrs-driver/tests/control_surface.rs index ecc46187..f0b24cbc 100644 --- a/crates/psrs-driver/tests/control_surface.rs +++ b/crates/psrs-driver/tests/control_surface.rs @@ -93,6 +93,29 @@ main :: Int main = 0 "#; +use std::process::Command; + +/// The `return`-only path lowers to a frame and executes: `main` reads the +/// `(state, value)` result of the closed `run`. +const RETURNS_AND_RUNS: &str = r#"module Main where + +import Prim.Control as C + +data Op next = Op (Int -> next) + +program :: C.Control Op Int +program = C.return 42 + +result :: { _1 :: Int, _2 :: Int } +result = C.run 0 handler program + where + handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } + handler s (Op k) cont = { _1: s, _2: cont (k s) } + +main :: Int +main = result._2 +"#; + #[test] fn control_surface_typechecks() { if let Err(errors) = psrs_driver::check_source("Main.purs", ACCEPTS) { @@ -100,6 +123,39 @@ fn control_surface_typechecks() { } } +#[test] +fn executes_a_returning_computation() { + let available = Command::new("wasmtime") + .arg("--version") + .output() + .is_ok_and(|output| output.status.success()); + if !available { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "control execution requires wasmtime" + ); + eprintln!("skipping control execution: wasmtime is unavailable"); + return; + } + let artifact = psrs_driver::compile_source("Main.purs", RETURNS_AND_RUNS) + .expect("compile the returning computation"); + let path = + std::env::temp_dir().join(format!("psrs-control-return-{}.wasm", std::process::id())); + std::fs::write(&path, &artifact.wasm).expect("write component"); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .expect("run component"); + let _ = std::fs::remove_file(path); + assert_eq!( + output.status.code(), + Some(42), + "expected the returning computation to exit 42, got {output:?}" + ); +} + #[test] fn control_surface_handles_one_effect() { if let Err(errors) = psrs_driver::check_source("Main.purs", HANDLES_ONE_EFFECT) { From d8fc25087c54f333e006cb0bb0a03828f1793d89 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 19:26:50 +0800 Subject: [PATCH 100/148] Thread generated-function signatures through CC lowering Add a `generated_signatures` table shared by the lowering context and the function lowerer. The per-function verifier now resolves direct calls against the declared signatures plus any signatures registered while lowering, which is what a lowering-synthesized function (the control executor and the continuation closures it needs) requires. No lowering registers a signature yet; this is the plumbing the control executor needs before it can be emitted. --- .../src/cc/case/decision/realize/tests/mod.rs | 3 +++ .../case/decision/realize/tests/nested_tests.rs | 3 +++ .../case/decision/realize/tests/newtype_tests.rs | 3 +++ .../realize/tests/parameterized_tests/support.rs | 3 +++ .../case/decision/realize/tests/product_tests.rs | 3 +++ .../case/decision/realize/tests/record_tests.rs | 3 +++ .../psrs-backend/src/cc/lower/conversion/tests.rs | 3 +++ crates/psrs-backend/src/cc/lower/lambda/mod.rs | 1 + crates/psrs-backend/src/cc/lower/mod.rs | 15 ++++++++++++++- crates/psrs-backend/src/cc/mod.rs | 3 +++ 10 files changed, 39 insertions(+), 1 deletion(-) diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs index b2e7730f..31b9b62f 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs @@ -145,6 +145,9 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs index 0e731a31..4ba45b7a 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs @@ -194,6 +194,9 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs index 92f4ddf5..d3c906a6 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs @@ -134,6 +134,9 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs index fb4fd6d0..5547c74f 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs @@ -62,6 +62,9 @@ pub(super) fn lower_and_verify( boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: context.array_types, record_types: context.record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs index 41f05dcd..cd14a433 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs @@ -130,6 +130,9 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs index 55245f2e..948dbbfb 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs @@ -154,6 +154,9 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: &array_types, record_types: &record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/lower/conversion/tests.rs b/crates/psrs-backend/src/cc/lower/conversion/tests.rs index d161520e..8eee11a4 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/tests.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/tests.rs @@ -52,6 +52,9 @@ fn unsupported_typed_boundary_reports_its_source_span() { boxed_integer_type: None, boxed_number_type: None, control_type: None, + generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( + std::collections::HashMap::new(), + )), array_types: &reprs, record_types: &reprs, constructor_tags: &tags, diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index 49545b5c..016552c6 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -330,6 +330,7 @@ impl LambdaLowering for FunctionLowerer<'_> { function_types: self.function_types, function_wrappers: self.function_wrappers, generated_symbols: std::rc::Rc::clone(&self.generated_symbols), + generated_signatures: std::rc::Rc::clone(&self.generated_signatures), owner: self.owner, warnings: Vec::new(), local_types: HashMap::new(), diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 589f7985..7ac5bb02 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -54,6 +54,10 @@ pub(super) struct LoweringContext<'a> { pub(super) function_types: &'a HashMap, pub(super) function_wrappers: &'a HashMap, pub(super) generated_symbols: Rc>, + /// Signatures of functions generated during lowering (for example the + /// control executor). The per-function verifier resolves calls against these + /// in addition to the declared signatures. + pub(super) generated_signatures: Rc>>, } pub(super) fn lower_function( @@ -84,6 +88,7 @@ pub(super) fn lower_function( function_types: context.function_types, function_wrappers: context.function_wrappers, generated_symbols: Rc::clone(&context.generated_symbols), + generated_signatures: Rc::clone(&context.generated_signatures), owner: declaration.symbol.module, warnings: Vec::new(), generated: Vec::new(), @@ -187,7 +192,11 @@ pub(super) fn lower_function( result_type, span: declaration.span, }; - super::verify::verify_function(&function, context.signatures, context.representations)?; + let mut all_signatures = context.signatures.clone(); + for (symbol, signature) in state.generated_signatures.borrow().iter() { + all_signatures.insert(*symbol, signature.clone()); + } + super::verify::verify_function(&function, &all_signatures, context.representations)?; let mut generated = state.generated; generated.push(lambda::make_wrapper(&function, declaration, context)); let warnings = state @@ -227,6 +236,10 @@ pub(super) struct FunctionLowerer<'a> { pub(super) function_types: &'a HashMap, pub(super) function_wrappers: &'a HashMap, pub(super) generated_symbols: Rc>, + /// Signatures of functions generated during lowering (for example the + /// control executor). The per-function verifier resolves calls against these + /// in addition to the declared signatures. + pub(super) generated_signatures: Rc>>, pub(super) owner: ModuleId, pub(super) warnings: Vec, pub(super) generated: Vec, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 5ffdb1b3..bf0f3be0 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -405,6 +405,8 @@ pub(crate) fn lower_module_with_relations( } let mut functions = Vec::with_capacity(module.declarations.len()); let generated_symbols = Rc::new(RefCell::new(GeneratedSymbolAllocator::new(&module))); + let generated_signatures: Rc>> = + Rc::new(RefCell::new(HashMap::new())); let function_wrappers = module .declarations .iter() @@ -441,6 +443,7 @@ pub(crate) fn lower_module_with_relations( function_types: &layout.function_types, function_wrappers: &function_wrappers, generated_symbols, + generated_signatures, }; let mut warnings = Vec::new(); for declaration in &module.declarations { From 2026238f76234c8b3fb55f7b64342bf6d0e84fe8 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 19:33:12 +0800 Subject: [PATCH 101/148] Record the delimited-control lowering handoff Document the state of the Prim.Control lowering for a follow-up agent: the implemented surface, the frame representation and the working return/run path, the reference commands and the locked-stdlib override, the remaining executor work with its file touchpoints, and the blocking design decision (synthesized continuation closures need a SignatureId from the representation table, which is immutable during lowering, so the intended path pre-declares erased signatures and emitters a generic erased executor). --- ...ted-control-lowering-handoff-2026-10-11.md | 236 ++++++++++++++++++ 1 file changed, 236 insertions(+) create mode 100644 docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md new file mode 100644 index 00000000..10910916 --- /dev/null +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -0,0 +1,236 @@ +# Handoff: Lower the Delimited-Control Executor + +**Date:** 2026-10-11 +**Branch:** `feat/effect-handlers` (based on `stdlib/vendor-core-libraries`) +**Scope:** Continue the compiler lowering for the `Prim.Control` delimited-control +surface. The `return`/`run` path works end to end; the `perform`/`bind` executor and +`handle` are not lowered. +**Status:** Partial. Frames and effect summaries are in place; the executor needs a +design decision recorded below before it can be emitted. + +## Objective + +Implement **[DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md)**'s +compiler-generated resumable-frame mechanism for the `Prim.Control` surface, so that +library code can define algebraic-effect operations and handlers on top of it. The +normative designs are: + +- [Library-Owned Algebraic Effects and Handlers](../../design/backend/fp/algebraic-effects-and-handlers.md) + (library model; the operations, rows, handlers live in the standard library). +- [Delimited Control and Resumable Frames](../../design/backend/fp/delimited-control-and-resumable-frames.md) + (the compiler mechanism: the surface, the frame representation, the executor, the + runtime boundary, the comparison with stack switching). **Read this first.** +- [Algebraic Effects: Proposed Acceptance Checklist](../../implementation/backend/algebraic-effects.md) + (AE-*/AC-* evidence requirements; all still Unverified). + +The scope decision: **the type system gains no effect tracking or effect reasoning**; +effect requirements are ordinary library types. The carrier and primitives are +compiler-owned; operations, rows, and handlers are library code. The mechanism is +confined below Typed Core. + +## What is implemented + +### Frontend surface (committed `1633dd88`) + +`Prim.Control` (a compiler-reserved interface) exposes: + +```text +Control f a -- opaque carrier, kind (Type -> Type) -> Type -> Type +return : a -> Control f a +bind : Control f a -> (a -> Control f b) -> Control f b +perform : f a -> Control f a +run : s + -> (forall x. s -> f x -> (x -> Control f a) -> (s, Control f a)) + -> Control f a + -> (s, a) +handle : s + -> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a)) + -> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) -- project (Church sum) + -> (forall x. g x -> u x) -- inject + -> Control u a + -> Control g (s, a) +``` + +`run` is the closed state-threading fold; `handle` is the open eliminator that +removes one effect and leaves a residual. Touch points: + +- `crates/psrs-hir/src/primitives/control.rs` — the `Control` carrier declaration + (kind, representational roles). +- `crates/psrs-hir/src/intrinsic/mod.rs` — `ControlReturn=92 … ControlHandle=96`, + `ALL`, reserved-slot assertion. +- `crates/psrs-hir/src/intrinsic/registry.rs` — `IntrinsicCategory::Control`, + descriptors, and the schemes (`control_run`, `control_handle`, `record` helper). +- `crates/psrs-hir/src/intrinsic/effects.rs` — `run`/`handle` are `may_trap`+`may_write`. +- `crates/psrs-hir/src/compiler_interface.rs` — the `Prim.Control` interface + (`return`/`bind`/`perform`/`run`/`handle`). +- `crates/psrs-hir/src/lib.rs` — `TypeId::CONTROL`. + +### Backend representation and the `return`/`run` path (committed `64a27de8`) + +- **`Control f a` is an opaque aggregate.** `crates/psrs-backend/src/cc/mod.rs` + inserts `HirTypeId::CONTROL` into `aggregate_types`, so `scalar_type` needs no + change. `crates/psrs-backend/src/cc/layout/mod.rs` reserves the shared **frame** + representation and stores it in `TypeLayout::control_type`: + + ```text + Variant { + Return [Erased] -- tag 0 + Perform [Erased] -- tag 1, the request only (no continuation) + Bind [Erased, Erased] -- tag 2, an inner computation and a continuation + } + ``` + +- **`control_type` is threaded** through `LoweringContext`/`FunctionLowerer` + (`crates/psrs-backend/src/cc/lower/mod.rs`). +- **`return`/`perform`/`bind`** lower to frames in + `crates/psrs-backend/src/cc/lower/intrinsic.rs::lower_control` (a `VariantNew` + with erased fields via `lower_array_element`). +- **`run`** lowers inline (`lower_control_run`): read the tag, and for a `Return` + frame build the `(state, value)` record and return it; every other tag traps. +- `crates/psrs-backend/src/target_intrinsics/mod.rs` adds + `Implementation::Control` and maps the five intrinsics to it. + +### Executor plumbing (committed `d8fc2508`) + +`generated_signatures: Rc>>` is shared by the +lowering context and the function lowerer, and the per-function verifier resolves +direct calls against the declared signatures **plus** these. This is the plumbing a +lowering-synthesized executor function needs. **No lowering registers a signature +yet.** + +### Tests + +`crates/psrs-driver/tests/control_surface.rs` (5 tests, all passing): +`control_surface_typechecks`, `control_surface_handles_one_effect`, +`control_surface_rejects_result_type_confusion`, +`control_surface_requires_a_rank_two_handler`, `executes_a_returning_computation`. + +`executes_a_returning_computation` compiles a `return`/`run` program, runs it under +`wasmtime`, and asserts **exit 42**. The exact program: + +```purescript +module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +program :: C.Control Op Int +program = C.return 42 +result :: { _1 :: Int, _2 :: Int } +result = C.run 0 handler program + where + handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } + handler s (Op k) cont = { _1: s, _2: cont (k s) } +main :: Int +main = result._2 +``` + +## How to run + +The on-disk `/Users/biu/Projects/psrs-stdlib` differs from `stdlib.lock.json`, so the +driver requires the locked revision via `PSRS_STDLIB_ROOT`. A materialized copy of +locked revision `1e01310` is at +`/private/var/folders/f2/h3z3zsy51xq3kr06707r9ct40000gn/T/opencode/psrs-stdlib-1e01310` +(re-materialize with `git archive` if it is gone; do not change the lock or the +package). + +```sh +export PSRS_STDLIB_ROOT=/private/var/folders/f2/h3z3zsy51xq3kr06707r9ct40000gn/T/opencode/psrs-stdlib-1e01310 +cargo build --workspace +cargo fmt --all --check +cargo clippy -p psrs-backend -p psrs-driver -p psrs-hir --all-targets -- -D warnings +cargo test -p psrs-backend --lib # 422 tests +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test control_surface +``` + +`wasmtime` 49.0.2 is installed. All of the above were green at `d8fc2508`. + +## Remaining work + +The next slice is the **executor**: lower `ControlRun` (and `ControlHandle`) to a +generated function that drives frames, and implement `ControlPerform`/`ControlBind` +so they build frames carrying a **continuation**, not just the request. + +### The blocking design decision + +The executor and the continuation closures it needs are lowering-synthesized +functions. `AssignmentKind::FunctionRef`/`IndirectCall` require a `SignatureId` from +the `RepresentationTable`, which is **immutable during CC lowering** (only the layout +phase has `&mut`). The `generated_signatures` table added in `d8fc2508` holds CC +`Signature` values (parameter/result shapes) for the *verifier*, but not the +`SignatureId` the emitter needs. Two ways forward: + +- **(a) Make the representation table extensible during lowering** (`Rc>`). + Direct but broad. +- **(b) Pre-declare erased signatures and representations in layout** and emit one + generic erased executor. **This is the intended path.** Reserve in + `crates/psrs-backend/src/cc/layout/mod.rs`: + - `control_cont_signature : [Erased] -> Erased` (a continuation), + - `control_executor_signature : [Erased, Erased, Erased] -> Erased` + (state, handler, computation → an erased `(state, value)` pair), + - `control_pair : Product[Erased, Erased]` (the `(state, value)` result), + and add them to `TypeLayout`, threaded like `control_type`. + +### Executor semantics + +The freer-monad fold for the closed `run` is: + +```text +exec h s (Return a) = (s, a) +exec h s (Perform op cont) = let (s', next) = h s op cont in exec h s' next +exec h s (Bind inner g) = exec h s' (continue inner g) +``` + +At the erased level: `TagSwitch` on the computation's tag; `Return` builds the +`control_pair`; `Perform` calls the rank-2 handler (erased +`[Erased,Erased,Erased]->Erased`) and recurses on its result; `Bind` evaluates the +inner computation and composes the continuations. Recurrence is a self tail call, +which MIR loopification turns into a `loop`. The call site boxes `s`/`handler`/ +`computation`, calls the executor, then unboxes the pair and converts each field to +the concrete `(s, a)` record. A single generic executor is enough (dedupe by symbol). + +The frame representation must change: **`Perform` must carry its continuation**, and +`bind` must compose continuations (`bind (Perform op k) g = Perform op (\x -> bind (k x) g)`), +so `perform op` needs an identity continuation (`\x -> Return x`) and `bind` needs a +composition closure — both synthesized with `FunctionRef` using the pre-declared +signatures. This is where the synthesis work lives. + +### Additional touch points + +- `crates/psrs-backend/src/cc/lower/intrinsic.rs` — rewrite `lower_control_run`; + implement the `perform`/`bind` continuation closures; generate the executor. +- `crates/psrs-backend/src/cc/mod.rs` — carry the new pre-declared handles. +- `crates/psrs-backend/src/cc/lower/mod.rs` / `lambda/mod.rs` — thread them; the + executor is appended via `self.generated`. +- `crates/psrs-backend/src/target_intrinsics/tests.rs` — the control intrinsics are + `Implementation::Control` now (they are no longer expected `Unsupported`). +- `crates/psrs-backend/src/mir/opt/effects.rs` — classify the executor call as + effectful so a suspension is never erased. + +### Not started + +- `ControlHandle` (the open eliminator): not lowered. +- The standard-library wrapper (`Run r a`, `handleState`, …): not written. The + library can be authored once the executor works; the surface typechecks today. +- Verifier/optimizer obligations for the executor and for suspension observability. +- Runtime-side design (the executor is guest code; `psrs-runtime` carries no + continuation for the software form — see the design's "executor and runtime + boundary"). + +## Known limitations / honest gaps + +- Only the `return` path of `run` executes. `perform`/`bind` build frames that trap + at `run` until the executor lands. +- The frame representation currently has no continuation slot in `Perform`; it must + be revised as described. +- `handle` is unreachable. +- The locked standard library is stale relative to the Effect/State removal, so the + default root cannot compile library-dependent programs; the control tests use + self-contained sources and the locked revision via `PSRS_STDLIB_ROOT`. + +## Workflow notes + +- The user has been reviewing and committing topical commits as work lands. Local + history on `feat/effect-handlers` is not pushed; the four commits above are the + current state. Do not rewrite pushed history (none is pushed). +- AGENTS.md governs the repository: keep changes topical, keep compiler + representations separate, do not narrow the design to close gaps, and report + unsupported cases honestly. From 1bcad5a72b4c9578168c3a279352a5919e21a180 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 20:48:47 +0800 Subject: [PATCH 102/148] Implement persistent control executors and open handler forwarding --- .../src/cc/case/decision/realize/tests/mod.rs | 3 +- .../decision/realize/tests/nested_tests.rs | 3 +- .../decision/realize/tests/newtype_tests.rs | 3 +- .../tests/parameterized_tests/support.rs | 3 +- .../decision/realize/tests/product_tests.rs | 3 +- .../decision/realize/tests/record_tests.rs | 3 +- crates/psrs-backend/src/cc/layout/control.rs | 88 +++++ crates/psrs-backend/src/cc/layout/mod.rs | 43 +-- .../src/cc/lower/control/builder.rs | 264 ++++++++++++++ .../src/cc/lower/control/executor.rs | 163 +++++++++ .../psrs-backend/src/cc/lower/control/mod.rs | 195 ++++++++++ .../psrs-backend/src/cc/lower/control/open.rs | 120 ++++++ .../src/cc/lower/conversion/tests.rs | 3 +- crates/psrs-backend/src/cc/lower/intrinsic.rs | 177 +-------- .../psrs-backend/src/cc/lower/lambda/mod.rs | 9 +- crates/psrs-backend/src/cc/lower/mod.rs | 25 +- crates/psrs-backend/src/cc/mod.rs | 3 +- crates/psrs-backend/src/mir/lower/variant.rs | 38 +- .../src/mir/lower/variant/tests.rs | 85 +++++ .../psrs-driver/tests/control_open_runtime.rs | 306 ++++++++++++++++ crates/psrs-driver/tests/control_runtime.rs | 215 +++++++++++ .../psrs-driver/tests/control_support/mod.rs | 57 +++ crates/psrs-driver/tests/control_surface.rs | 67 ++-- crates/psrs-hir/src/intrinsic/effects.rs | 9 +- docs/design/D-04-suite-roadmap.md | 1 + .../delimited-control-and-resumable-frames.md | 135 ++++++- .../backend/algebraic-effects.md | 205 ++++++++++- ...ted-control-lowering-handoff-2026-10-11.md | 343 +++++++----------- 28 files changed, 2060 insertions(+), 509 deletions(-) create mode 100644 crates/psrs-backend/src/cc/layout/control.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/builder.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/executor.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/mod.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/open.rs create mode 100644 crates/psrs-backend/src/mir/lower/variant/tests.rs create mode 100644 crates/psrs-driver/tests/control_open_runtime.rs create mode 100644 crates/psrs-driver/tests/control_runtime.rs create mode 100644 crates/psrs-driver/tests/control_support/mod.rs diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs index 31b9b62f..d368f882 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs @@ -144,7 +144,8 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs index 4ba45b7a..1302ea86 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs @@ -193,7 +193,8 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs index d3c906a6..da1b8a59 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs @@ -133,7 +133,8 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs index 5547c74f..edeab6ef 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs @@ -61,7 +61,8 @@ pub(super) fn lower_and_verify( newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs index cd14a433..9b0f598b 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs @@ -129,7 +129,8 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs index 948dbbfb..b045031b 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs @@ -153,7 +153,8 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { newtype_ids: &newtype_ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control.rs new file mode 100644 index 00000000..355870b4 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/control.rs @@ -0,0 +1,88 @@ +//! Predeclared representations for the persistent control abstract machine. + +use crate::cc::payload::erased_shape; +use crate::cc::{ReprId, Representation, RepresentationTable, Signature, SignatureId, VariantCase}; + +#[derive(Clone, Copy)] +pub(in crate::cc) struct ControlLayout { + pub computation: ReprId, + pub sequence: ReprId, + pub pair: ReprId, + pub continuation: SignatureId, + pub executor: SignatureId, + pub open_executor: SignatureId, + pub projected: ReprId, +} + +pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) -> ControlLayout { + let erased = erased_shape(); + let computation = table.reserve(); + table.set( + computation, + Representation::Variant { + cases: [1, 1, 2, 2, 5] + .into_iter() + .enumerate() + .map(|(tag, count)| VariantCase { + tag: tag as u32, + fields: vec![erased; count], + }) + .collect(), + }, + ); + let sequence = table.reserve(); + table.set( + sequence, + Representation::Variant { + cases: [0, 2, 2] + .into_iter() + .enumerate() + .map(|(tag, count)| VariantCase { + tag: tag as u32, + fields: vec![erased; count], + }) + .collect(), + }, + ); + let labels = vec!["_1".to_owned(), "_2".to_owned()]; + let pair = super::protocols::record(table, &labels).unwrap_or_else(|| { + let pair = table.reserve(); + table.set( + pair, + Representation::Product { + fields: vec![erased; 2], + }, + ); + table.set_product_labels(pair, labels); + pair + }); + let executor = table.add_signature(Signature { + parameters: vec![erased; 4], + result: erased, + }); + let open_executor = table.add_signature(Signature { + parameters: vec![erased; 6], + result: erased, + }); + let projected = table.reserve(); + table.set( + projected, + Representation::Variant { + cases: (0..2) + .map(|tag| VariantCase { + tag, + fields: vec![erased], + }) + .collect(), + }, + ); + ControlLayout { + computation, + sequence, + pair, + continuation, + executor, + open_executor, + projected, + } +} diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 7575cbc6..c6d96adc 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -1,8 +1,5 @@ use super::VariantCase; -use super::{ - RefShape, Reference, ReprId, Representation, RepresentationTable, Signature, SignatureId, - ValueShape, -}; +use super::{ReprId, Representation, RepresentationTable, Signature, SignatureId, ValueShape}; use crate::BackendError; use psrs_core::{Module as CoreModule, Type, TypeConstructor, TypeId}; use psrs_hir::{SymbolId, TypeId as HirTypeId, TypeVariableId}; @@ -11,6 +8,7 @@ use std::collections::{HashMap, HashSet}; mod aggregate; mod captures; +pub(in crate::cc) mod control; mod declaration; mod functions; pub(crate) mod protocols; @@ -181,38 +179,6 @@ pub(super) fn type_layout( ) -> Result> { let mut representations = RepresentationTable::default(); - // The frame representation shared by every `Control f a` instantiation: a - // tagged variant with `Return` (one erased value), `Perform` (an erased - // request and its erased continuation), and `Bind` (an inner computation - // and its erased continuation). - let control_type = { - let erased = ValueShape::Reference(Reference { - nullable: false, - heap: RefShape::Erased, - }); - let id = representations.reserve(); - representations.set( - id, - Representation::Variant { - cases: vec![ - VariantCase { - tag: 0, - fields: vec![erased], - }, - VariantCase { - tag: 1, - fields: vec![erased], - }, - VariantCase { - tag: 2, - fields: vec![erased, erased], - }, - ], - }, - ); - Some(id) - }; - let boxed_integer_type = if module .types .iter() @@ -341,6 +307,7 @@ pub(super) fn type_layout( &function_types, module.span, )?; + let control_layout = Some(control::append(&mut representations, function_slot)); Ok(TypeLayout { function_slot, protocols, @@ -351,7 +318,7 @@ pub(super) fn type_layout( boxed_integer_type, boxed_number_type, function_types, - control_type, + control_layout, }) } @@ -369,7 +336,7 @@ pub(super) struct TypeLayout { pub(super) boxed_number_type: Option, pub(super) function_types: HashMap, /// The shared frame representation for `Control f a` values. - pub(super) control_type: Option, + pub(super) control_layout: Option, } pub(super) fn newtype_field_type(module: &CoreModule, type_id: HirTypeId) -> Option { diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs new file mode 100644 index 00000000..5dc00193 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -0,0 +1,264 @@ +//! CC construction helpers for steps over predeclared machine layouts. + +use super::{ControlFunctions, ControlLayout}; +use crate::cc::lower::FunctionLowerer; +use crate::cc::payload::erased_shape; +use crate::cc::{ + Assignment, AssignmentKind, Function, RefShape, Reference, ReprId, SignatureId, TagCase, + ValueId, ValueShape, +}; +use psrs_hir::SymbolId; +use psrs_span::TextRange; + +pub(super) struct Machine<'a> { + pub lower: FunctionLowerer<'a>, + pub layout: ControlLayout, + pub functions: ControlFunctions, + pub span: TextRange, + pub open: Option<(ValueId, ValueId)>, +} + +pub(super) fn repr(id: ReprId) -> ValueShape { + reference(RefShape::Repr(id)) +} + +fn reference(heap: RefShape) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap, + }) +} + +impl<'a> Machine<'a> { + pub fn new( + lower: FunctionLowerer<'a>, + layout: ControlLayout, + functions: ControlFunctions, + span: TextRange, + ) -> Self { + Self { + lower, + layout, + functions, + span, + open: None, + } + } + + pub fn emit( + &mut self, + shape: ValueShape, + body: &mut Vec, + kind: impl FnOnce(ValueId) -> AssignmentKind, + ) -> ValueId { + let destination = self.lower.fresh(shape); + body.push(Assignment { + destination, + kind: kind(destination), + span: self.span, + }); + destination + } + + pub fn cast( + &mut self, + value: ValueId, + shape: ValueShape, + body: &mut Vec, + ) -> ValueId { + let ValueShape::Reference(reference) = shape else { + unreachable!("machine casts only references"); + }; + self.emit(shape, body, |destination| { + AssignmentKind::RepresentationCast { + destination, + value, + reference, + } + }) + } + + pub fn node( + &mut self, + representation: ReprId, + case: u32, + fields: Vec, + body: &mut Vec, + ) -> ValueId { + let value = self.emit(repr(representation), body, |destination| { + AssignmentKind::VariantNew { + destination, + representation, + case, + fields, + } + }); + self.cast(value, erased_shape(), body) + } + + pub fn field( + &mut self, + value: ValueId, + representation: ReprId, + case: u32, + field: u32, + body: &mut Vec, + ) -> ValueId { + let value = self.cast(value, repr(representation), body); + self.emit(erased_shape(), body, |destination| { + AssignmentKind::VariantGet { + destination, + representation, + case, + field, + value, + } + }) + } + + pub fn pair(&mut self, state: ValueId, value: ValueId, body: &mut Vec) -> ValueId { + let representation = self.layout.pair; + let value = self.emit(repr(representation), body, |destination| { + AssignmentKind::ProductNew { + destination, + representation, + arguments: vec![state, value], + } + }); + self.cast(value, erased_shape(), body) + } + + pub fn pair_field( + &mut self, + value: ValueId, + field: u32, + body: &mut Vec, + ) -> ValueId { + let representation = self.layout.pair; + let value = self.cast(value, repr(representation), body); + self.emit(erased_shape(), body, |destination| { + AssignmentKind::ProductGet { + destination, + representation, + field, + value, + } + }) + } + + pub fn capture(&mut self, closure: ValueId, index: u32, body: &mut Vec) -> ValueId { + self.emit(erased_shape(), body, |_| { + AssignmentKind::ClosureGetCapture { closure, index } + }) + } + + pub fn closure( + &mut self, + function: SymbolId, + signature: SignatureId, + captures: Vec, + body: &mut Vec, + ) -> ValueId { + let value = self.emit(reference(RefShape::Closure(signature)), body, |_| { + AssignmentKind::FunctionRef { + function, + signature, + captures, + } + }); + self.cast(value, erased_shape(), body) + } + + /// Use the common curry protocol; every intermediate result is erased. + pub fn apply( + &mut self, + mut function: ValueId, + arguments: &[ValueId], + body: &mut Vec, + ) -> ValueId { + let signature = self.layout.continuation; + for argument in arguments { + let callable = self.cast(function, reference(RefShape::Closure(signature)), body); + function = self.emit(erased_shape(), body, |_| AssignmentKind::IndirectCall { + function: callable, + signature, + arguments: vec![*argument], + }); + } + function + } + + pub fn recur( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let (function, arguments) = if let Some((project, inject)) = self.open { + ( + self.functions.open_executor, + vec![state, handler, computation, sequence, project, inject], + ) + } else { + ( + self.functions.executor, + vec![state, handler, computation, sequence], + ) + }; + self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { + function, + arguments, + }) + } + + pub fn switch( + &mut self, + value: ValueId, + representation: ReprId, + cases: Vec, + body: &mut Vec, + ) -> ValueId { + let value = self.cast(value, repr(representation), body); + let tag = self.emit(ValueShape::Integer, body, |destination| { + AssignmentKind::VariantTag { + destination, + representation, + value, + } + }); + let trap = self.lower.fresh(erased_shape()); + let default_assignments = vec![Assignment { + destination: trap, + kind: AssignmentKind::Unreachable, + span: self.span, + }]; + self.emit(erased_shape(), body, |_| AssignmentKind::TagSwitch { + value: tag, + cases, + default_assignments, + default_value: trap, + }) + } + + pub fn finish( + self, + symbol: SymbolId, + name: &str, + parameters: Vec, + assignments: Vec, + result: ValueId, + ) -> Function { + Function { + symbol, + name: name.into(), + parameters, + assignments, + result, + result_type: erased_shape(), + values: self.lower.values, + span: self.span, + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs new file mode 100644 index 00000000..210ac5ef --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -0,0 +1,163 @@ +//! A flat driver; only the driver traverses saved continuation sequences. + +use super::builder::Machine; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, Function, TagCase, ValueId}; + +impl Machine<'_> { + pub(super) fn executor(mut self, open: bool) -> Function { + let state = self.lower.fresh(erased_shape()); + let handler = self.lower.fresh(erased_shape()); + let computation = self.lower.fresh(erased_shape()); + let sequence = self.lower.fresh(erased_shape()); + let mut parameters = vec![state, handler, computation, sequence]; + if open { + let project = self.lower.fresh(erased_shape()); + let inject = self.lower.fresh(erased_shape()); + self.open = Some((project, inject)); + parameters.extend([project, inject]); + } + let mut cases = Vec::new(); + + let mut body = Vec::new(); + let value = self.field(computation, self.layout.computation, 0, 0, &mut body); + let result = self.returned(state, handler, computation, value, sequence, &mut body); + cases.push(arm(0, body, result)); + + let mut body = Vec::new(); + let result = self.requested(state, handler, computation, sequence, &mut body); + cases.push(arm(1, body, result)); + + let mut body = Vec::new(); + let inner = self.field(computation, self.layout.computation, 2, 0, &mut body); + let continuation = self.field(computation, self.layout.computation, 2, 1, &mut body); + let pending = self.node( + self.layout.sequence, + 1, + vec![continuation, sequence], + &mut body, + ); + let result = self.recur(state, handler, inner, pending, &mut body); + cases.push(arm(2, body, result)); + + let mut body = Vec::new(); + let value = self.field(computation, self.layout.computation, 3, 0, &mut body); + let saved = self.field(computation, self.layout.computation, 3, 1, &mut body); + let pending = self.node(self.layout.sequence, 2, vec![saved, sequence], &mut body); + let next = self.node(self.layout.computation, 0, vec![value], &mut body); + let result = self.recur(state, handler, next, pending, &mut body); + cases.push(arm(3, body, result)); + + let mut body = Vec::new(); + let inner_state = self.field(computation, self.layout.computation, 4, 0, &mut body); + let inner_handler = self.field(computation, self.layout.computation, 4, 1, &mut body); + let project = self.field(computation, self.layout.computation, 4, 2, &mut body); + let inject = self.field(computation, self.layout.computation, 4, 3, &mut body); + let inner = self.field(computation, self.layout.computation, 4, 4, &mut body); + let empty = self.node(self.layout.sequence, 0, vec![], &mut body); + let function = self.functions.open_executor; + let next = self.emit(erased_shape(), &mut body, |_| { + crate::cc::AssignmentKind::DirectCall { + function, + arguments: vec![inner_state, inner_handler, inner, empty, project, inject], + } + }); + let result = self.recur(state, handler, next, sequence, &mut body); + cases.push(arm(4, body, result)); + + let mut body = Vec::new(); + let result = self.switch(computation, self.layout.computation, cases, &mut body); + let symbol = if open { + self.functions.open_executor + } else { + self.functions.executor + }; + self.finish( + symbol, + if open { + "control_open_executor" + } else { + "control_executor" + }, + parameters, + body, + result, + ) + } + + fn returned( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + value: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let mut cases = Vec::new(); + let mut branch = Vec::new(); + let pair = self.pair(state, value, &mut branch); + let result = if self.open.is_some() { + self.node(self.layout.computation, 0, vec![pair], &mut branch) + } else { + pair + }; + cases.push(arm(0, branch, result)); + + let mut branch = Vec::new(); + let continuation = self.field(sequence, self.layout.sequence, 1, 0, &mut branch); + let rest = self.field(sequence, self.layout.sequence, 1, 1, &mut branch); + let next = self.apply(continuation, &[value], &mut branch); + let result = self.recur(state, handler, next, rest, &mut branch); + cases.push(arm(1, branch, result)); + + let mut branch = Vec::new(); + let left = self.field(sequence, self.layout.sequence, 2, 0, &mut branch); + let right = self.field(sequence, self.layout.sequence, 2, 1, &mut branch); + let result = self.appended(state, handler, computation, value, left, right, &mut branch); + cases.push(arm(2, branch, result)); + self.switch(sequence, self.layout.sequence, cases, body) + } + + #[allow(clippy::too_many_arguments)] + fn appended( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + value: ValueId, + left: ValueId, + right: ValueId, + body: &mut Vec, + ) -> ValueId { + let mut cases = Vec::new(); + let mut branch = Vec::new(); + let result = self.recur(state, handler, computation, right, &mut branch); + cases.push(arm(0, branch, result)); + + let mut branch = Vec::new(); + let continuation = self.field(left, self.layout.sequence, 1, 0, &mut branch); + let rest = self.field(left, self.layout.sequence, 1, 1, &mut branch); + let pending = self.node(self.layout.sequence, 2, vec![rest, right], &mut branch); + let next = self.apply(continuation, &[value], &mut branch); + let result = self.recur(state, handler, next, pending, &mut branch); + cases.push(arm(1, branch, result)); + + let mut branch = Vec::new(); + let first = self.field(left, self.layout.sequence, 2, 0, &mut branch); + let second = self.field(left, self.layout.sequence, 2, 1, &mut branch); + let rest = self.node(self.layout.sequence, 2, vec![second, right], &mut branch); + let pending = self.node(self.layout.sequence, 2, vec![first, rest], &mut branch); + let result = self.recur(state, handler, computation, pending, &mut branch); + cases.push(arm(2, branch, result)); + self.switch(left, self.layout.sequence, cases, body) + } +} + +pub(super) fn arm(tag: i32, assignments: Vec, value: ValueId) -> TagCase { + TagCase { + tag, + assignments, + value, + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs new file mode 100644 index 00000000..ffe94e34 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -0,0 +1,195 @@ +//! Lower the inert control surface to a persistent continuation machine. + +use super::{FunctionLowerer, LambdaLowering}; +use crate::BackendError; +use crate::cc::layout::control::ControlLayout; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, AssignmentKind, ValueId, ValueShape}; +use psrs_core::Expr; +use psrs_hir::{Intrinsic, SymbolId}; +use psrs_span::TextRange; + +mod builder; +mod executor; +mod open; +use builder::Machine; + +#[derive(Clone, Copy)] +pub(in crate::cc) struct ControlFunctions { + executor: SymbolId, + resume: SymbolId, + open_executor: SymbolId, + forward: SymbolId, + project_left: SymbolId, + project_right: SymbolId, +} + +impl FunctionLowerer<'_> { + pub(super) fn lower_control( + &mut self, + expression: &Expr, + intrinsic: Intrinsic, + arguments: &[Expr], + ty: ValueShape, + assignments: &mut Vec, + ) -> Result> { + let layout = self.control_layout.ok_or_else(|| { + control_error( + expression.span, + "control primitive used without a frame representation", + ) + })?; + let fields = arguments + .iter() + .map(|argument| self.lower_array_element(argument, assignments)) + .collect::, _>>()?; + if intrinsic == Intrinsic::ControlRun { + let functions = self.ensure_control_functions(layout, expression.span)?; + let empty = self.control_empty_sequence(layout, expression.span, assignments); + let result = self.fresh(erased_shape()); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::DirectCall { + function: functions.executor, + arguments: vec![fields[0], fields[1], fields[2], empty], + }, + span: expression.span, + }); + let conversion = self.recover_payload(ty, expression.span)?; + return Ok(self.emit_conversion( + result, + erased_shape(), + ty, + conversion, + expression.span, + assignments, + )); + } + let case = match intrinsic { + Intrinsic::ControlReturn => 0, + Intrinsic::ControlPerform => 1, + Intrinsic::ControlBind => 2, + Intrinsic::ControlHandle => 4, + _ => return Err(control_error(expression.span, "not a control primitive")), + }; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::VariantNew { + destination, + representation: layout.computation, + case, + fields, + }, + span: expression.span, + }); + Ok(destination) + } + + fn control_empty_sequence( + &mut self, + layout: ControlLayout, + span: TextRange, + assignments: &mut Vec, + ) -> ValueId { + let shape = builder::repr(layout.sequence); + let value = self.fresh(shape); + assignments.push(Assignment { + destination: value, + kind: AssignmentKind::VariantNew { + destination: value, + representation: layout.sequence, + case: 0, + fields: vec![], + }, + span, + }); + self.emit_conversion( + value, + shape, + erased_shape(), + crate::cc::ValueConversion::EraseReference, + span, + assignments, + ) + } + + fn ensure_control_functions( + &mut self, + layout: ControlLayout, + span: TextRange, + ) -> Result> { + if let Some(functions) = *self.control_functions.borrow() { + return Ok(functions); + } + let functions = { + let mut symbols = self.generated_symbols.borrow_mut(); + ControlFunctions { + executor: symbols.fresh(self.owner), + resume: symbols.fresh(self.owner), + open_executor: symbols.fresh(self.owner), + forward: symbols.fresh(self.owner), + project_left: symbols.fresh(self.owner), + project_right: symbols.fresh(self.owner), + } + }; + let signature = self + .representations + .signature(layout.executor) + .ok_or_else(|| control_error(span, "control executor has no predeclared signature"))? + .clone(); + self.generated_signatures + .borrow_mut() + .insert(functions.executor, signature); + let open_signature = self + .representations + .signature(layout.open_executor) + .ok_or_else(|| { + control_error(span, "open control executor has no predeclared signature") + })? + .clone(); + self.generated_signatures + .borrow_mut() + .insert(functions.open_executor, open_signature); + let mut resume = Machine::new(self.child_lowerer(), layout, functions, span); + let receiver = resume.lower.fresh(super::lambda::closure_value_type()); + let value = resume.lower.fresh(erased_shape()); + let mut assignments = Vec::new(); + let saved = resume.capture(receiver, 0, &mut assignments); + let result = resume.node(layout.computation, 3, vec![value, saved], &mut assignments); + let resume = resume.finish( + functions.resume, + "control_resume", + vec![receiver, value], + assignments, + result, + ); + self.verify_synthesized(&resume)?; + self.generated.push(resume); + let executor = Machine::new(self.child_lowerer(), layout, functions, span).executor(false); + self.verify_synthesized(&executor)?; + self.generated.push(executor); + let open = Machine::new(self.child_lowerer(), layout, functions, span).executor(true); + self.verify_synthesized(&open)?; + self.generated.push(open); + let forward = Machine::new(self.child_lowerer(), layout, functions, span).forward(); + self.verify_synthesized(&forward)?; + self.generated.push(forward); + for (case, symbol) in [(0, functions.project_left), (1, functions.project_right)] { + let selector = + Machine::new(self.child_lowerer(), layout, functions, span).selector(case, symbol); + self.verify_synthesized(&selector)?; + self.generated.push(selector); + } + *self.control_functions.borrow_mut() = Some(functions); + Ok(functions) + } +} + +fn control_error(span: TextRange, message: &'static str) -> Vec { + vec![BackendError::invalid_ir( + "P8 closure conversion", + span, + message, + )] +} diff --git a/crates/psrs-backend/src/cc/lower/control/open.rs b/crates/psrs-backend/src/cc/lower/control/open.rs new file mode 100644 index 00000000..4dc00323 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/open.rs @@ -0,0 +1,120 @@ +//! Open interpretation stops at residual requests and saves its own delimiter. + +use super::builder::Machine; +use super::executor::arm; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, Function, ValueId}; +use psrs_hir::SymbolId; + +impl Machine<'_> { + pub(super) fn requested( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let request = self.field(computation, self.layout.computation, 1, 0, body); + let Some((project, inject)) = self.open else { + return self.handled(state, handler, request, sequence, body); + }; + let left = self.closure( + self.functions.project_left, + self.layout.continuation, + vec![], + body, + ); + let right = self.closure( + self.functions.project_right, + self.layout.continuation, + vec![], + body, + ); + let projected = self.apply(project, &[request, left, right], body); + let mut branch = Vec::new(); + let request = self.field(projected, self.layout.projected, 0, 0, &mut branch); + let result = self.handled(state, handler, request, sequence, &mut branch); + let handled = arm(0, branch, result); + + let mut branch = Vec::new(); + let request = self.field(projected, self.layout.projected, 1, 0, &mut branch); + let request = self.node(self.layout.computation, 1, vec![request], &mut branch); + let continuation = self.closure( + self.functions.forward, + self.layout.continuation, + vec![state, handler, project, inject, sequence], + &mut branch, + ); + let result = self.node( + self.layout.computation, + 2, + vec![request, continuation], + &mut branch, + ); + let forwarded = arm(1, branch, result); + self.switch( + projected, + self.layout.projected, + vec![handled, forwarded], + body, + ) + } + + fn handled( + &mut self, + state: ValueId, + handler: ValueId, + request: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let continuation = self.closure( + self.functions.resume, + self.layout.continuation, + vec![sequence], + body, + ); + let pair = self.apply(handler, &[state, request, continuation], body); + let next_state = self.pair_field(pair, 0, body); + let next = self.pair_field(pair, 1, body); + // Abandoned work is reachable only through the clause's resumption. + let empty = self.node(self.layout.sequence, 0, vec![], body); + self.recur(next_state, handler, next, empty, body) + } + + pub(super) fn forward(mut self) -> Function { + let receiver = self.lower.fresh(super::super::lambda::closure_value_type()); + let value = self.lower.fresh(erased_shape()); + let mut body = Vec::new(); + let mut fields = (0..4) + .map(|index| self.capture(receiver, index, &mut body)) + .collect::>(); + let saved = self.capture(receiver, 4, &mut body); + let resumed = self.node(self.layout.computation, 3, vec![value, saved], &mut body); + fields.push(resumed); + let result = self.node(self.layout.computation, 4, fields, &mut body); + let symbol = self.functions.forward; + self.finish( + symbol, + "control_forward", + vec![receiver, value], + body, + result, + ) + } + + pub(super) fn selector(mut self, case: u32, symbol: SymbolId) -> Function { + let receiver = self.lower.fresh(super::super::lambda::closure_value_type()); + let value = self.lower.fresh(erased_shape()); + let mut body = Vec::new(); + let result = self.node(self.layout.projected, case, vec![value], &mut body); + self.finish( + symbol, + "control_project", + vec![receiver, value], + body, + result, + ) + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/tests.rs b/crates/psrs-backend/src/cc/lower/conversion/tests.rs index 8eee11a4..692d6e9b 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/tests.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/tests.rs @@ -51,7 +51,8 @@ fn unsupported_typed_boundary_reports_its_source_span() { newtype_ids: &ids, boxed_integer_type: None, boxed_number_type: None, - control_type: None, + control_layout: None, + control_functions: std::rc::Rc::new(std::cell::RefCell::new(None)), generated_signatures: std::rc::Rc::new(std::cell::RefCell::new( std::collections::HashMap::new(), )), diff --git a/crates/psrs-backend/src/cc/lower/intrinsic.rs b/crates/psrs-backend/src/cc/lower/intrinsic.rs index 5ba80a50..2b3b48f5 100644 --- a/crates/psrs-backend/src/cc/lower/intrinsic.rs +++ b/crates/psrs-backend/src/cc/lower/intrinsic.rs @@ -4,10 +4,9 @@ //! every intrinsic. The array, string, and scalar helpers this dispatches to are //! the same ones the previous per-operation expressions used. -use super::super::{Assignment, AssignmentKind, BinaryOp, ValueId, ValueShape}; +use super::super::{Assignment, AssignmentKind, ValueId, ValueShape}; use super::FunctionLowerer; use crate::BackendError; -use crate::cc::payload::erased_shape; use crate::target_intrinsics::{ GeneratedOperation as G, Implementation, ScalarOperation, implementation, }; @@ -162,178 +161,4 @@ impl FunctionLowerer<'_> { } } } - - /// Lowers a `Prim.Control` primitive to a frame in the shared control - /// representation. `return`/`perform`/`bind` build frames; the executor - /// (`run`/`handle`) is not lowered yet. - pub(super) fn lower_control( - &mut self, - expression: &Expr, - intrinsic: Intrinsic, - arguments: &[Expr], - ty: ValueShape, - assignments: &mut Vec, - ) -> Result> { - let Some(representation) = self.control_type else { - return Err(vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "control primitive used without a frame representation", - )]); - }; - let (case, fields): (u32, Vec<&Expr>) = match intrinsic { - Intrinsic::ControlReturn => (0, vec![&arguments[0]]), - Intrinsic::ControlPerform => (1, vec![&arguments[0]]), - Intrinsic::ControlBind => (2, vec![&arguments[0], &arguments[1]]), - Intrinsic::ControlRun => { - return self.lower_control_run(expression, arguments, ty, assignments); - } - Intrinsic::ControlHandle => { - return Err(vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "the open control handler is not lowered yet", - )]); - } - _ => { - return Err(vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "not a control primitive", - )]); - } - }; - let mut values = Vec::with_capacity(fields.len()); - for field in fields { - values.push(self.lower_array_element(field, assignments)?); - } - let destination = self.fresh(ty); - assignments.push(Assignment { - destination, - kind: AssignmentKind::VariantNew { - destination, - representation, - case, - fields: values, - }, - span: expression.span, - }); - Ok(destination) - } - - /// Lowers `ControlRun` inline: read the frame tag and, for a `return` frame, - /// build the `(state, value)` result. `perform`/`bind` frames trap until the - /// executor grows those cases. - fn lower_control_run( - &mut self, - expression: &Expr, - arguments: &[Expr], - ty: ValueShape, - assignments: &mut Vec, - ) -> Result> { - let Some(representation) = self.control_type else { - return Err(vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "control primitive used without a frame representation", - )]); - }; - let Some(record_representation) = self.record_types.get(&expression.ty).copied() else { - return Err(vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "control run result is not a represented record", - )]); - }; - let value_type = self - .module - .record_field(expression.ty, "_2") - .ok_or_else(|| { - vec![BackendError::invalid_ir( - "P8 closure conversion", - expression.span, - "control run result record has no value field", - )] - })?; - let value_shape = self.value_shape(value_type, expression.span)?; - let state = self.lower_value(&arguments[0], assignments)?; - let _handler = self.lower_value(&arguments[1], assignments)?; - let computation = self.lower_value(&arguments[2], assignments)?; - let plan = self.recover_payload(value_shape, expression.span)?; - - let zero = self.fresh(ValueShape::Integer); - let tag = self.fresh(ValueShape::Integer); - let condition = self.fresh(ValueShape::Boolean); - let payload_erased = self.fresh(erased_shape()); - let mut then_assignments = vec![Assignment { - destination: payload_erased, - kind: AssignmentKind::VariantGet { - destination: payload_erased, - representation, - case: 0, - field: 0, - value: computation, - }, - span: expression.span, - }]; - let payload = self.emit_conversion( - payload_erased, - erased_shape(), - value_shape, - plan, - expression.span, - &mut then_assignments, - ); - let record = self.fresh(ty); - then_assignments.push(Assignment { - destination: record, - kind: AssignmentKind::ProductNew { - destination: record, - representation: record_representation, - arguments: vec![state, payload], - }, - span: expression.span, - }); - let trap = self.fresh(ty); - let result = self.fresh(ty); - assignments.push(Assignment { - destination: zero, - kind: AssignmentKind::Constant(0), - span: expression.span, - }); - assignments.push(Assignment { - destination: tag, - kind: AssignmentKind::VariantTag { - destination: tag, - representation, - value: computation, - }, - span: expression.span, - }); - assignments.push(Assignment { - destination: condition, - kind: AssignmentKind::Primitive { - op: BinaryOp::IntEq, - left: tag, - right: zero, - }, - span: expression.span, - }); - assignments.push(Assignment { - destination: result, - kind: AssignmentKind::If { - condition, - then_assignments, - then_value: record, - else_assignments: vec![Assignment { - destination: trap, - kind: AssignmentKind::Unreachable, - span: expression.span, - }], - else_value: trap, - }, - span: expression.span, - }); - Ok(result) - } } diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index 016552c6..e3668ea1 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -256,11 +256,7 @@ impl LambdaLowering for FunctionLowerer<'_> { result_type: final_result_type, span: expression.span, }; - super::super::verify::verify_function( - &nested_function, - self.signatures, - self.representations, - )?; + self.verify_synthesized(&nested_function)?; let FunctionLowerer { generated: nested_generated, warnings: nested_warnings, @@ -321,7 +317,8 @@ impl LambdaLowering for FunctionLowerer<'_> { newtype_ids: self.newtype_ids, boxed_integer_type: self.boxed_integer_type, boxed_number_type: self.boxed_number_type, - control_type: self.control_type, + control_layout: self.control_layout, + control_functions: std::rc::Rc::clone(&self.control_functions), array_types: self.array_types, record_types: self.record_types, constructor_tags: self.constructor_tags, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 7ac5bb02..5e73b500 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -14,6 +14,7 @@ use std::rc::Rc; mod array; mod call; mod constructor; +mod control; mod conversion; mod dictionary; mod erased; @@ -45,7 +46,8 @@ pub(super) struct LoweringContext<'a> { pub(super) newtype_ids: &'a HashSet, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, - pub(super) control_type: Option, + pub(super) control_layout: Option, + pub(super) control_functions: Rc>>, pub(super) array_types: &'a HashMap, pub(super) record_types: &'a HashMap, pub(super) constructor_tags: &'a HashMap, @@ -79,7 +81,8 @@ pub(super) fn lower_function( newtype_ids: context.newtype_ids, boxed_integer_type: context.boxed_integer_type, boxed_number_type: context.boxed_number_type, - control_type: context.control_type, + control_layout: context.control_layout, + control_functions: Rc::clone(&context.control_functions), array_types: context.array_types, record_types: context.record_types, constructor_tags: context.constructor_tags, @@ -227,7 +230,8 @@ pub(super) struct FunctionLowerer<'a> { pub(super) newtype_ids: &'a HashSet, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, - pub(super) control_type: Option, + pub(super) control_layout: Option, + pub(super) control_functions: Rc>>, pub(super) array_types: &'a HashMap, pub(super) record_types: &'a HashMap, pub(super) constructor_tags: &'a HashMap, @@ -246,6 +250,21 @@ pub(super) struct FunctionLowerer<'a> { } impl FunctionLowerer<'_> { + pub(in crate::cc::lower) fn verify_synthesized( + &self, + function: &Function, + ) -> Result<(), Vec> { + let mut signatures: std::collections::HashMap = + self.signatures.clone(); + signatures.extend( + self.generated_signatures + .borrow() + .iter() + .map(|(symbol, signature)| (*symbol, signature.clone())), + ); + crate::cc::verify::verify_function(function, &signatures, self.representations) + } + pub(super) fn lower_value( &mut self, expression: &Expr, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index bf0f3be0..50aa2555 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -434,7 +434,8 @@ pub(crate) fn lower_module_with_relations( newtype_ids: &newtype_ids, boxed_integer_type: layout.boxed_integer_type, boxed_number_type: layout.boxed_number_type, - control_type: layout.control_type, + control_layout: layout.control_layout, + control_functions: Rc::new(RefCell::new(None)), array_types: &layout.array_types, record_types: &layout.record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/mir/lower/variant.rs b/crates/psrs-backend/src/mir/lower/variant.rs index bd282496..1be22c87 100644 --- a/crates/psrs-backend/src/mir/lower/variant.rs +++ b/crates/psrs-backend/src/mir/lower/variant.rs @@ -4,6 +4,9 @@ use crate::cc::{Assignment, AssignmentKind}; use crate::mir::{BlockId, Instruction}; use crate::types::{HeapType, RefType, ValueType}; +#[cfg(test)] +mod tests; + impl FunctionLowerer<'_> { pub(in crate::mir) fn lower_variant( &mut self, @@ -22,6 +25,24 @@ impl FunctionLowerer<'_> { .layout .variant_index(*representation, *case) .map_err(|error| layout_error(span, error))?; + // CC permits a variant's common representation as well as an + // abstract aggregate result. Construct at the concrete case + // type before widening to a declared common representation. + let declared = self.value_type(*destination); + let widened = match declared { + Some(ValueType::Ref(reference)) if matches!(reference.heap, HeapType::Index(index) if index != case_type) => { + Some(reference) + } + _ => None, + }; + let constructed = if widened.is_some() { + self.fresh(ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(case_type), + })) + } else { + *destination + }; let tag = self.fresh(ValueType::I32); self.append_instruction( current, @@ -36,13 +57,26 @@ impl FunctionLowerer<'_> { self.append_instruction( current, Instruction::StructNew { - destination: *destination, + destination: constructed, type_index: case_type, arguments, span, }, span, - ) + )?; + if let Some(reference) = widened { + self.append_instruction( + current, + Instruction::RefCast { + destination: *destination, + value: constructed, + reference, + span, + }, + span, + )?; + } + Ok(()) } AssignmentKind::VariantTag { destination, diff --git a/crates/psrs-backend/src/mir/lower/variant/tests.rs b/crates/psrs-backend/src/mir/lower/variant/tests.rs new file mode 100644 index 00000000..ffc4c8a9 --- /dev/null +++ b/crates/psrs-backend/src/mir/lower/variant/tests.rs @@ -0,0 +1,85 @@ +//! CC admits both abstract and concrete common variant result shapes. + +use crate::cc::{ + Assignment, AssignmentKind, Function, Module, RefShape, Reference, Representation, + RepresentationTable, ValueDecl, ValueId, ValueShape, VariantCase, +}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; + +#[test] +fn variant_construction_lowers_at_abstract_and_common_representation_shapes() { + for case in 0..2 { + let mut table = RepresentationTable::default(); + let variant = table.reserve(); + table.set( + variant, + Representation::Variant { + cases: vec![ + VariantCase { + tag: 0, + fields: vec![ValueShape::Integer], + }, + VariantCase { + tag: 1, + fields: vec![], + }, + ], + }, + ); + for heap in [RefShape::Aggregate, RefShape::Repr(variant)] { + let shape = ValueShape::Reference(Reference { + nullable: false, + heap, + }); + let span = TextRange::new(0, 1); + let value = ValueId(0); + let result = ValueId(1); + let module = Module { + name: "VariantResult".into(), + externals: vec![], + representations: table.clone(), + entry: None, + span, + functions: vec![Function { + symbol: SymbolId::new(ModuleId(0), 0), + name: "construct".into(), + parameters: vec![], + span, + result, + result_type: shape, + values: vec![ + ValueDecl { + id: value, + ty: ValueShape::Integer, + }, + ValueDecl { + id: result, + ty: shape, + }, + ], + assignments: vec![ + Assignment { + destination: value, + kind: AssignmentKind::Constant(42), + span, + }, + Assignment { + destination: result, + kind: AssignmentKind::VariantNew { + destination: result, + representation: variant, + case, + fields: if case == 0 { vec![value] } else { vec![] }, + }, + span, + }, + ], + }], + }; + let (mir, _) = crate::mir::lower_module(module).expect("valid variant construction"); + crate::mir::verify_module(&mir) + .expect("the constructed case widens to its declared shape"); + } + } +} diff --git a/crates/psrs-driver/tests/control_open_runtime.rs b/crates/psrs-driver/tests/control_open_runtime.rs new file mode 100644 index 00000000..5865481b --- /dev/null +++ b/crates/psrs-driver/tests/control_open_runtime.rs @@ -0,0 +1,306 @@ +//! Value-sensitive execution of open elimination and persistent forwarding. + +mod control_support; +use control_support::execute; + +fn source(program: &str, inner: &str, outer: &str, result: &str) -> String { + format!( + r#"module Main where +import Prim.Control as C +data F next = F (Int -> next) +data G next = G (Int -> next) +data U next = UF (F next) | UG (G next) +project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r +project u onF onG = case u of + UF f -> onF f + UG g -> onG g +inject :: forall x. G x -> U x +inject = UG +inner :: forall x. Int -> F x -> (x -> C.Control U Int) -> {{ _1 :: Int, _2 :: C.Control U Int }} +inner s (F k) cont = {inner} +outer :: forall x. Int -> G x -> (x -> C.Control G {{ _1 :: Int, _2 :: Int }}) -> {{ _1 :: Int, _2 :: C.Control G {{ _1 :: Int, _2 :: Int }} }} +outer s (G k) cont = {outer} +program :: C.Control U Int +program = {program} +handled :: C.Control G {{ _1 :: Int, _2 :: Int }} +handled = C.handle 0 inner project inject program +result :: {{ _1 :: Int, _2 :: {{ _1 :: Int, _2 :: Int }} }} +result = C.run 0 outer handled +main :: Int +main = {result} +"# + ) +} + +const INNER: &str = "{ _1: intAdd s 1, _2: cont (k s) }"; +const OUTER: &str = "{ _1: intAdd s 1, _2: cont (k 40) }"; +const MIXED: &str = r"C.bind (C.perform (UF (F \x -> x))) (\a -> C.bind (C.perform (UG (G \x -> x))) (\b -> C.bind (C.perform (UF (F \x -> x))) (\c -> C.return (intAdd a (intAdd b c)))))"; + +#[test] +fn handles_and_forwards_then_reinstalls_the_inner_delimiter() { + execute( + "open-mixed", + &source( + MIXED, + INNER, + OUTER, + "if intEq result._1 1 then if intEq result._2._1 2 then intAdd result._2._2 1 else 1 else 1", + ), + 42, + ); +} + +#[test] +fn constructing_an_open_handler_is_inert() { + let text = source(MIXED, "{ _1: intQuot 1 0, _2: cont (k s) }", OUTER, "42") + .replace("main = 42", "main = let unused = handled in 42"); + execute("open-inert", &text, 42); +} + +#[test] +fn open_handler_can_abandon_its_remainder() { + execute( + "open-abandon", + &source( + r"C.bind (C.perform (UF (F \x -> x))) (\_ -> C.return (intQuot 1 0))", + "{ _1: 7, _2: C.return 42 }", + OUTER, + "if intEq result._1 0 then if intEq result._2._1 7 then result._2._2 else 1 else 1", + ), + 42, + ); +} + +#[test] +fn residual_handler_can_abandon_the_inner_delimiter() { + execute( + "residual-abandon", + &source( + r"C.bind (C.perform (UG (G \x -> x))) (\_ -> C.return (intQuot 1 0))", + INNER, + "{ _1: 7, _2: C.return { _1: 0, _2: 42 } }", + "if intEq result._1 7 then result._2._2 else 1", + ), + 42, + ); +} + +#[test] +fn residual_replay_preserves_each_branchs_inner_state() { + execute( + "residual-replay", + &source( + MIXED, + INNER, + r"{ _1: intAdd s 1, _2: C.bind (cont (k 19)) (\a -> C.bind (cont (k 20)) (\b -> C.return { _1: intAdd a._1 b._1, _2: intAdd a._2 b._2 })) }", + "if intEq result._1 1 then if intEq result._2._1 4 then intAdd result._2._2 1 else 1 else 1", + ), + 42, + ); +} + +#[test] +fn open_handler_can_replay_its_saved_sequence() { + execute( + "open-replay", + &source( + r"C.bind (C.perform (UF (F \x -> x))) (\a -> C.return (intAdd a 1))", + r"{ _1: intAdd s 1, _2: C.bind (cont (k 19)) (\a -> C.bind (cont (k 21)) (\b -> C.return (intAdd a b))) }", + OUTER, + "if intEq result._2._1 1 then result._2._2 else 1", + ), + 42, + ); +} + +#[test] +fn forwarded_remainders_finish_before_the_outer_bind() { + let text = source(MIXED, INNER, OUTER, "result._2._2").replace( + "C.run 0 outer handled", + "C.run 0 outer (C.bind handled (\\a -> C.return { _1: a._1, _2: intAdd a._2 1 }))", + ); + execute("forward-order", &text, 42); +} + +#[test] +fn clause_requests_are_interpreted_with_updated_inner_state() { + execute( + "open-clause-request", + &source( + r"C.perform (UF (F \x -> x))", + r"if intEq s 0 then { _1: 1, _2: C.bind (C.perform (UG (G \x -> x))) (\a -> cont (k (intAdd a 2))) } else { _1: s, _2: cont (k s) }", + OUTER, + "if intEq result._2._1 1 then result._2._2 else 1", + ), + 42, + ); +} + +#[test] +fn long_forwarded_request_sequences_are_stack_safe() { + let mut text = source( + "build 100000", + INNER, + OUTER, + "if intEq result._1 100000 then if intEq result._2._1 100000 then result._2._2 else 1 else 1", + ); + text.push_str(r" +build :: Int -> C.Control U Int +build n = if intEq n 0 then C.return 42 else C.bind (C.perform (UF (F \x -> x))) (\_ -> C.bind (C.perform (UG (G \x -> x))) (\_ -> build (intSub n 1)))"); + execute("long-forward", &text, 42); +} + +#[test] +fn repeated_interpretation_preserves_open_nodes() { + execute( + "open-repeat", + &source( + MIXED, + INNER, + OUTER, + "let other = C.run 0 outer handled in intAdd result._2._2 (intSub other._2._2 40)", + ), + 42, + ); +} + +#[test] +fn nested_open_handlers_remove_distinct_effects_in_order() { + execute( + "open-nested", + r#"module Main where +import Prim.Control as C +data F x = F (Int -> x) +data G x = G (Int -> x) +data H x = H (Int -> x) +data U x = UF (F x) | UG (G x) | UH (H x) +data V x = VG (G x) | VH (H x) +projectF :: forall x r. U x -> (F x -> r) -> (V x -> r) -> r +projectF u l r = case u of + UF f -> l f + UG g -> r (VG g) + UH h -> r (VH h) +injectF :: forall x. V x -> U x +injectF v = case v of + VG g -> UG g + VH h -> UH h +projectG :: forall x r. V x -> (G x -> r) -> (H x -> r) -> r +projectG v l r = case v of + VG g -> l g + VH h -> r h +handlerF :: forall x. Int -> F x -> (x -> C.Control U Int) -> { _1 :: Int, _2 :: C.Control U Int } +handlerF s (F k) cont = { _1: intAdd s 1, _2: cont (k s) } +handlerG :: forall x. Int -> G x -> (x -> C.Control V { _1 :: Int, _2 :: Int }) -> { _1 :: Int, _2 :: C.Control V { _1 :: Int, _2 :: Int } } +handlerG s (G k) cont = { _1: intAdd s 1, _2: cont (k s) } +handlerH :: forall x. Int -> H x -> (x -> C.Control H { _1 :: Int, _2 :: { _1 :: Int, _2 :: Int } }) -> { _1 :: Int, _2 :: C.Control H { _1 :: Int, _2 :: { _1 :: Int, _2 :: Int } } } +handlerH s (H k) cont = { _1: intAdd s 1, _2: cont (k s) } +program :: C.Control U Int +program = C.bind (C.perform (UF (F \x -> x))) (\a -> C.bind (C.perform (UG (G \x -> x))) (\b -> C.bind (C.perform (UH (H \x -> x))) (\c -> C.bind (C.perform (UF (F \x -> x))) (\d -> C.return (intAdd a (intAdd b (intAdd c d))))))) +result = C.run 30 handlerH (C.handle 10 handlerG projectG VH (C.handle 0 handlerF projectF injectF program)) +main :: Int +main = if intEq result._1 31 then if intEq result._2._1 11 then if intEq result._2._2._1 2 then intAdd result._2._2._2 1 else 1 else 1 else 1 +"#, + 42, + ); +} + +#[test] +fn open_handler_recovers_aggregate_answers_state_and_captures() { + execute( + "open-aggregate", + r#"module Main where +import Prim.Control as C +data F x = F ({ value :: Int } -> x) +data G x = G ({ value :: Int } -> x) +data U x = UF (F x) | UG (G x) +project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r +project u l r = case u of + UF f -> l f + UG g -> r g +inner :: forall x. { count :: Int } -> F x -> (x -> C.Control U { answer :: Int }) -> { _1 :: { count :: Int }, _2 :: C.Control U { answer :: Int } } +inner s (F k) cont = { _1: { count: intAdd s.count 1 }, _2: cont (k { value: 1 }) } +outer :: forall x. Int -> G x -> (x -> C.Control G { _1 :: { count :: Int }, _2 :: { answer :: Int } }) -> { _1 :: Int, _2 :: C.Control G { _1 :: { count :: Int }, _2 :: { answer :: Int } } } +outer s (G k) cont = { _1: intAdd s 1, _2: cont (k { value: 39 }) } +program :: C.Control U { answer :: Int } +program = let captured = { offset: 2 } in C.bind (C.perform (UG (G \x -> x))) (\a -> C.bind (C.perform (UF (F \x -> x))) (\b -> C.return { answer: intAdd captured.offset (intAdd a.value b.value) })) +result = C.run 0 outer (C.handle { count: 0 } inner project UG program) +main :: Int +main = if intEq result._1 1 then if intEq result._2._1.count 1 then result._2._2.answer else 1 else 1 +"#, + 42, + ); +} + +#[test] +fn ignored_open_interpretation_retains_handler_traps() { + execute( + "open-ignored-trap", + &source( + MIXED, + "{ _1: intQuot 1 0, _2: cont (k s) }", + OUTER, + "let ignored = result in 42", + ), + 134, + ); +} + +#[test] +fn open_handler_arguments_are_strict() { + let text = source(MIXED, INNER, OUTER, "let unused = handled in 42") + .replace("C.handle 0", "C.handle (intQuot 1 0)"); + execute("open-strict", &text, 134); +} + +#[test] +fn operation_names_do_not_affect_open_lowering() { + let text = source(MIXED, INNER, OUTER, "intAdd result._2._2 1") + .replace("UF", "First") + .replace("UG", "Second") + .replace(" F ", " Query ") + .replace("(F ", "(Query ") + .replace(" G ", " Reply ") + .replace("(G ", "(Reply "); + execute("open-renamed", &text, 42); +} + +#[test] +fn collection_preserves_suspended_open_frames_and_captures() { + let mut text = source( + r"let saved = { offset: 2 } in C.bind (C.perform (UF (F \x -> x))) (\a -> C.return (intAdd a saved.offset))", + r"let churn = C.run 0 noiseHandler (noise 5000) in { _1: intAdd s churn._1, _2: cont (k 40) }", + OUTER, + "if intEq result._2._1 5000 then result._2._2 else 1", + ); + text.push_str(r" +noiseHandler :: forall x. Int -> G x -> (x -> C.Control G Int) -> { _1 :: Int, _2 :: C.Control G Int } +noiseHandler s (G k) cont = { _1: intAdd s 1, _2: cont (k s) } +noise :: Int -> C.Control G Int +noise n = if intEq n 0 then C.return 0 else C.bind (C.perform (G \x -> x)) (\_ -> noise (intSub n 1))"); + control_support::execute_with_gc("open-gc", &text, 42); +} + +#[test] +fn library_shallow_forwarding_differs_from_deep_reinstallation() { + let program = r"C.bind (C.perform (UF (F \x -> x))) (\a -> C.bind (C.perform (UF (F \x -> x))) (\b -> C.bind (C.perform (UF (F \x -> x))) (\c -> C.return (intAdd a (intAdd b c)))))"; + execute( + "open-deep", + &source( + program, + INNER, + OUTER, + "if intEq result._1 0 then if intEq result._2._1 3 then intAdd result._2._2 39 else 1 else 1", + ), + 42, + ); + execute( + "open-shallow-library", + &source( + program, + r"if intEq s 0 then { _1: 1, _2: cont (k 1) } else { _1: s, _2: C.bind (C.perform (UG (G \x -> x))) (\v -> cont (k v)) }", + "{ _1: intAdd s 1, _2: cont (k 20) }", + "if intEq result._1 2 then if intEq result._2._1 1 then intAdd result._2._2 1 else 1 else 1", + ), + 42, + ); +} diff --git a/crates/psrs-driver/tests/control_runtime.rs b/crates/psrs-driver/tests/control_runtime.rs new file mode 100644 index 00000000..9819a5c7 --- /dev/null +++ b/crates/psrs-driver/tests/control_runtime.rs @@ -0,0 +1,215 @@ +//! Value-sensitive execution of persistent continuations through closed `run`. + +mod control_support; +use control_support::execute; + +fn source(program: &str, handler: &str, result: &str) -> String { + format!( + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> {{ _1 :: Int, _2 :: C.Control Op Int }} +handler s (Op k) cont = {handler} +program :: C.Control Op Int +program = {program} +result :: {{ _1 :: Int, _2 :: Int }} +result = C.run 0 handler program +main :: Int +main = {result} +"# + ) +} + +const NEXT: &str = "{ _1: intAdd s 1, _2: cont (k s) }"; + +#[test] +fn bind_associations_preserve_order_and_state() { + for (name, program) in [ + ( + "left", + r"C.bind (C.bind (C.perform (Op \x -> x)) (\a -> C.return (intAdd a 40))) (\b -> C.bind (C.perform (Op \x -> x)) (\c -> C.return (intAdd b c)))", + ), + ( + "right", + r"C.bind (C.perform (Op \x -> x)) (\a -> C.bind (C.return (intAdd a 40)) (\b -> C.bind (C.perform (Op \x -> x)) (\c -> C.return (intAdd b c))))", + ), + ] { + execute( + name, + &source( + program, + NEXT, + "if intEq result._1 2 then intAdd result._2 1 else 1", + ), + 42, + ); + } +} + +#[test] +fn a_handler_can_abandon_the_pending_sequence() { + execute( + "abandon", + &source( + r"C.bind (C.perform (Op \x -> x)) (\_ -> C.return (intQuot 1 0))", + "{ _1: 7, _2: C.return 42 }", + "if intEq result._1 7 then result._2 else 1", + ), + 42, + ); +} + +#[test] +fn a_handler_can_replay_then_bind_a_saved_continuation() { + execute( + "replay", + &source( + r"C.bind (C.perform (Op \x -> x)) (\a -> C.bind (C.return (intAdd a 1)) (\b -> C.return b))", + r"{ _1: intAdd s 1, _2: C.bind (cont (k 19)) (\a -> C.bind (cont (k 21)) (\b -> C.return (intAdd a b))) }", + "if intEq result._1 1 then result._2 else 1", + ), + 42, + ); +} + +#[test] +fn replayed_requests_share_current_handler_state_without_consuming_saved_frames() { + execute( + "replayed-requests", + &source( + r"C.bind (C.perform (Op \x -> x)) (\a -> C.bind (C.perform (Op \x -> x)) (\b -> C.return (intAdd a b)))", + r"if intEq s 0 then { _1: 1, _2: C.bind (cont (k 19)) (\a -> C.bind (cont (k 20)) (\b -> C.return (intAdd a b))) } else { _1: intAdd s 1, _2: cont (k s) }", + "if intEq result._1 3 then result._2 else 1", + ), + 42, + ); +} + +#[test] +fn nested_runs_have_independent_pending_sequences() { + execute( + "nested", + &source( + r"C.bind (C.perform (Op \x -> x)) (\a -> let inner = C.run 40 handler (C.bind (C.perform (Op \x -> x)) (\b -> C.return (intAdd b 1))) in C.return (intAdd a inner._2))", + NEXT, + "if intEq result._1 1 then intAdd result._2 1 else 1", + ), + 42, + ); +} + +#[test] +fn constructing_a_computation_does_not_interpret_requests() { + execute( + "inert", + &source( + r"let unused = C.bind (C.perform (Op \x -> x)) (\_ -> C.return (intQuot 1 0)) in C.return 42", + "{ _1: intQuot 1 0, _2: cont (k s) }", + "if intEq result._1 0 then result._2 else 1", + ), + 42, + ); +} + +#[test] +fn ignored_run_results_preserve_handler_traps() { + let text = source( + r"C.perform (Op \x -> x)", + "{ _1: intQuot 1 0, _2: cont (k s) }", + "let ignored = result in 42", + ); + // Wasmtime maps a guest trap to exit 134 on this runner. + execute("ignored-trap", &text, 134); +} + +#[test] +fn computation_factory_arguments_are_strict() { + execute( + "strict-factory", + &source( + "let unused = C.return (intQuot 1 0) in C.return 42", + NEXT, + "result._2", + ), + 134, + ); +} + +#[test] +fn repeating_interpretation_keeps_computation_nodes_immutable() { + execute( + "repeat-run", + &source( + r"C.bind (C.perform (Op \x -> x)) (\a -> C.return (intAdd a 1))", + NEXT, + "let other = C.run 40 handler program in if intEq result._1 1 then if intEq other._1 41 then intAdd result._2 other._2 else 1 else 1", + ), + 42, + ); +} + +#[test] +fn long_bind_chains_and_request_sequences_are_stack_safe() { + for (name, definition) in [ + ( + "long-left", + r"build n c = if intEq n 0 then c else build (intSub n 1) (C.bind c (\a -> C.return (intAdd a 1)))", + ), + ( + "long-right", + r"build n c = if intEq n 0 then c else C.bind c (\a -> build (intSub n 1) (C.return (intAdd a 1)))", + ), + ( + "long-requests", + r"build n c = if intEq n 0 then c else C.bind (C.perform (Op \x -> x)) (\_ -> build (intSub n 1) (C.bind c (\a -> C.return (intAdd a 1))))", + ), + ] { + let mut text = source( + "build 100000 (C.return 0)", + NEXT, + "if intEq result._2 100000 then 42 else 1", + ); + text.push_str("\nbuild :: Int -> C.Control Op Int -> C.Control Op Int\n"); + text.push_str(definition); + text.push('\n'); + execute(name, &text, 42); + } +} + +#[test] +fn erased_aggregate_answers_state_and_captures_are_recovered() { + execute( + "aggregate", + r#"module Main where +import Prim.Control as C +data Op next = Op ({ value :: Int } -> next) +handler :: forall x. { count :: Int } -> Op x -> (x -> C.Control Op { answer :: Int }) -> { _1 :: { count :: Int }, _2 :: C.Control Op { answer :: Int } } +handler s (Op k) cont = { _1: { count: intAdd s.count 1 }, _2: cont (k { value: 40 }) } +program :: C.Control Op { answer :: Int } +program = let saved = { offset: 2 } in C.bind (C.perform (Op \x -> x)) (\a -> C.return { answer: intAdd a.value saved.offset }) +result :: { _1 :: { count :: Int }, _2 :: { answer :: Int } } +result = C.run { count: 0 } handler program +main :: Int +main = if intEq result._1.count 1 then result._2.answer else 1 +"#, + 42, + ); +} + +#[test] +fn function_answers_use_the_shared_callable_protocol() { + execute( + "function", + r#"module Main where +import Prim.Control as C +data Op next = Op ((Int -> Int) -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler s (Op k) cont = { _1: s, _2: cont (k (\n -> intAdd n 2)) } +program :: C.Control Op Int +program = C.bind (C.perform (Op \x -> x)) (\f -> C.return (f 40)) +main :: Int +main = (C.run 0 handler program)._2 +"#, + 42, + ); +} diff --git a/crates/psrs-driver/tests/control_support/mod.rs b/crates/psrs-driver/tests/control_support/mod.rs new file mode 100644 index 00000000..2138c206 --- /dev/null +++ b/crates/psrs-driver/tests/control_support/mod.rs @@ -0,0 +1,57 @@ +use std::process::Command; + +pub fn execute(name: &str, source: &str, expected: i32) { + run(name, source, expected, false); +} + +#[allow(dead_code)] +pub fn execute_with_gc(name: &str, source: &str, expected: i32) { + run(name, source, expected, true); +} + +fn run(name: &str, source: &str, expected: i32, force_gc: bool) { + let available = Command::new("wasmtime") + .arg("--version") + .output() + .is_ok_and(|output| output.status.success()); + if !available { + assert_ne!( + std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), + Ok("1"), + "control execution requires wasmtime" + ); + eprintln!("skipping control execution: wasmtime is unavailable"); + return; + } + let artifact = psrs_driver::compile_source("Main.purs", source) + .unwrap_or_else(|errors| panic!("compile {name}: {errors:?}")); + let path = + std::env::temp_dir().join(format!("psrs-control-{name}-{}.wasm", std::process::id())); + std::fs::write(&path, &artifact.wasm).expect("write component"); + let mut command = Command::new("wasmtime"); + command.arg("run"); + if force_gc { + command + .args(["-O", "gc-heap-initial-size=65536"]) + .env("WASMTIME_LOG", "wasmtime::runtime::vm::gc=trace"); + } + let output = command.arg(&path).output().expect("run component"); + let _ = std::fs::remove_file(path); + if force_gc { + let log = String::from_utf8_lossy(&output.stderr); + std::fs::write( + std::env::temp_dir().join(format!("psrs-control-{name}-gc.log")), + &output.stderr, + ) + .expect("retain collection log"); + assert!( + log.contains("After collection, GC heap's allocated bytes"), + "no observed collection: {log}" + ); + } + assert_eq!( + output.status.code(), + Some(expected), + "expected {name} to exit {expected}, got {output:?}" + ); +} diff --git a/crates/psrs-driver/tests/control_surface.rs b/crates/psrs-driver/tests/control_surface.rs index f0b24cbc..1190e1e3 100644 --- a/crates/psrs-driver/tests/control_surface.rs +++ b/crates/psrs-driver/tests/control_surface.rs @@ -3,9 +3,8 @@ //! `Prim.Control` exposes the effect-agnostic `Control f a` carrier with //! `return`/`bind`/`perform`/`run`/`handle` ([DEC-19](../../../docs/decision/DEC-19-compiler-generated-resumable-frames.md), //! [delimited control and resumable frames](../../../docs/design/backend/fp/delimited-control-and-resumable-frames.md)). -//! The selective CPS / resumable-frame lowering is not implemented, so these -//! tests check source acceptance and rejection (P0-P5) only; they do not claim -//! execution. +//! Source acceptance/rejection and focused executor execution. +//! Open execution is covered in `control_open_runtime.rs`. /// A well-typed program over an opaque request functor, interpreted by the /// closed state-threading `run`. `Op`'s answer type is `Int`, and the handler @@ -93,7 +92,8 @@ main :: Int main = 0 "#; -use std::process::Command; +mod control_support; +use control_support::execute; /// The `return`-only path lowers to a frame and executes: `main` reads the /// `(state, value)` result of the closed `run`. @@ -125,35 +125,12 @@ fn control_surface_typechecks() { #[test] fn executes_a_returning_computation() { - let available = Command::new("wasmtime") - .arg("--version") - .output() - .is_ok_and(|output| output.status.success()); - if !available { - assert_ne!( - std::env::var("PSRS_REQUIRE_WASMTIME").as_deref(), - Ok("1"), - "control execution requires wasmtime" - ); - eprintln!("skipping control execution: wasmtime is unavailable"); - return; - } - let artifact = psrs_driver::compile_source("Main.purs", RETURNS_AND_RUNS) - .expect("compile the returning computation"); - let path = - std::env::temp_dir().join(format!("psrs-control-return-{}.wasm", std::process::id())); - std::fs::write(&path, &artifact.wasm).expect("write component"); - let output = Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .expect("run component"); - let _ = std::fs::remove_file(path); - assert_eq!( - output.status.code(), - Some(42), - "expected the returning computation to exit 42, got {output:?}" - ); + execute("return", RETURNS_AND_RUNS, 42); +} + +#[test] +fn executes_a_performed_request() { + execute("perform", &ACCEPTS.replace("C.run 0", "C.run 42"), 42); } #[test] @@ -178,3 +155,27 @@ fn control_surface_requires_a_rank_two_handler() { "a monomorphic handler must not satisfy run's rank-2 argument" ); } + +#[test] +fn open_control_rejects_an_incompatible_residual_functor() { + let source = HANDLES_ONE_EFFECT.replace("handled :: C.Control G", "handled :: C.Control F"); + assert!(psrs_driver::check_source("Main.purs", &source).is_err()); +} + +#[test] +fn open_control_rejects_an_incompatible_injection() { + let source = HANDLES_ONE_EFFECT.replace( + "inject :: forall x. G x -> U x\ninject = UG", + "inject :: forall x. F x -> U x\ninject = UF", + ); + assert!(psrs_driver::check_source("Main.purs", &source).is_err()); +} + +#[test] +fn open_control_requires_a_rank_two_projection() { + let source = HANDLES_ONE_EFFECT.replace( + "project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r", + "project :: forall r. U Int -> (F Int -> r) -> (G Int -> r) -> r", + ); + assert!(psrs_driver::check_source("Main.purs", &source).is_err()); +} diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index c3e11910..6ad50369 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -23,9 +23,9 @@ impl IntrinsicEffects { }, // Executing a delimiter runs the handler and the continuation, which // can trap or mutate storage; the summary is deliberately - // conservative. `return`/`bind`/`perform` only build an inert + // conservative. `return`/`bind`/`perform`/`handle` only build an inert // computation, so they carry no effect of their own. - ControlRun | ControlHandle => Self { + ControlRun => Self { may_trap: true, may_write: true, }, @@ -39,9 +39,8 @@ impl IntrinsicEffects { | NumberCeil | NumberAbs | NumberSqrt | NumberAcos | NumberAsin | NumberAtan | NumberAtan2 | NumberSin | NumberCos | NumberTan | NumberExp | NumberLog | NumberPow | NumberMin | NumberMax | NumberSign | NumberRemainder | NumberIsNaN - | NumberNaN | NumberInfinity | ControlReturn | ControlBind | ControlPerform => { - Self::default() - } + | NumberNaN | NumberInfinity | ControlReturn | ControlBind | ControlPerform + | ControlHandle => Self::default(), } } } diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 9fffa6f4..a20f9496 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,6 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the five `Prim.Control` primitives lower to persistent frames and shared closed/open executors. Mandatory Wasmtime evidence covers bind/request stack safety, open residual forwarding, nested handlers, abandonment, multi-shot replay, aggregate captures and GC during suspension. One-shot/cancellation APIs, delimiter-liveness checks, complete frame verification, foreign capture boundaries and official library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 75c921e9..6e130045 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -2,8 +2,7 @@ **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) **Status:** Draft design. The mechanism is selected by -[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md); the -lowering is not implemented. +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md). **Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), [functional Core](../../frontend/semantics/functional-core.md), @@ -460,20 +459,95 @@ computation. #### Frame construction -Each step of a converted computation is represented by a frame. A frame stores: +The monadic surface is represented by inert computation nodes and a persistent +sequence of continuation frames. Constructing a `bind` never interprets its input +computation or invokes its continuation. Strict evaluation of primitive arguments +still follows the ordinary language rules. -- the free variables the step needs (its captured environment), -- a small tag identifying which continuation step it is ("after this `perform`, - apply this function to the answer"), -- the pointer to the next frame (the previously captured remainder). +```text +Computation = Return(value) | Perform(request) | Bind(inner, continuation) + | Resume(value, savedSequence) -- internal only + | Handle(state, handler, project, inject, inner) +Sequence = Empty | Cons(continuation, rest) | Append(left, right) +Machine = (handler, state, computation, pendingSequence) +``` + +`Bind` records a checked function from the inner result to the next computation. +The executor pushes this function onto its pending sequence and descends into the +inner computation. A `Return` consumes one pending function; that function returns +a computation node to the executor. A `Perform` passes the unchanged request and a +resumption capturing the entire pending sequence to the handler. The resumption +constructs `Resume(value, savedSequence)`; it does not execute the sequence or +re-enter the executor. A bare `Perform` therefore needs only a request field: its +identity continuation is represented by the empty pending sequence. +Suspension becomes observable when an executor interprets the node. An unused +inert node may be eliminated only while preserving strict argument evaluation; +an interpretation that invokes a handler remains an observable call. + +All sequence nodes are immutable GC objects. `Append` joins sequences without +copying them, including when a resumed computation is itself bound by the handler. +The saved sequence runs before the caller's pending sequence. Each normalization +step is driven by the executor loop; recursively nested composition closures are +not the sequence representation. This is the explicit continuation sequencing used +by operational free/freer implementations, adapted to compiler-owned frames. + +The handler returns the next state and computation. The executor clears its old +pending sequence: that remainder belongs to the resumption, so a clause may discard +it, resume it once, or construct several independent resumptions. Retaining the old +sequence would execute abandoned work or execute a resumed remainder twice. +Persistent nodes preserve multi-shot replay without mutating shared continuations. + +CC layout predeclares these representations and the executor call signature. The +continuation uses the existing unary erased callable-slot signature. The result +pair uses the canonical erased record protocol for `_1` and `_2`; ordinary payload +conversion adapts concrete states, results, handlers, and bind functions. CC lowering +synthesizes function bodies and registers their direct-call signatures, but cannot +mutate the representation table. Signature handles and verifier signatures come +from the same layout declarations. + +#### Open elimination and residual forwarding + +`handle` constructs an inert `Handle` node. It evaluates its arguments strictly, +but invokes neither the handler nor `project` during construction. Interpretation +enters a second instance of the same sequence machine with a fresh empty sequence; +the caller's pending sequence stays outside this delimiter. Finishing the inner +machine produces `Return((state, value))`, which the caller interprets with its own +pending sequence. + +The checked compiler interface encodes `Either` using its Church eliminator: + +```text +project : forall x r. u x -> (f x -> r) -> (g x -> r) -> r +``` + +The machine applies it to two generated selectors, yielding an internal tagged +payload. The handled branch calls the supplied clause and continues the inner +loop with the returned state and computation. The residual branch stops this +inner loop and returns: + +```text +Bind(Perform(gop), forward(savedState, handler, project, inject, savedSequence)) +forward(x) = Handle(savedState, handler, project, inject, + Resume(x, savedSequence)) +``` + +The outer executor delivers `gop` unchanged to its handler. Calling `forward` +only constructs data; re-entry occurs when the outer executor interprets the +returned `Handle`. Saved state is immutable: separate outer resumptions each +start with the same saved inner state. Subsequent changes within one branch do +not overwrite the other branch's state. An outer clause can abandon the entire +inner delimiter by discarding its resumption. + +`inject` remains a checked, strictly evaluated library argument. This machine +retains the original `u` computation and its pending sequence, so forwarding an +answer does not reconstruct a `u` request or call `inject`. It needs no inverse +law between `project` and `inject`. Requests remain opaque throughout. -A `perform` builds a frame chain from the current point out to its `run` delimiter, -hands the request and a handle to that chain (the continuation) to the handler, and -stops running the current computation. Continuing re-installs the chain and supplies -a value as the performed step's result. Frames are ordinary GC objects, so captured -references are roots the engine scans automatically; this is a decisive advantage -over capturing a raw execution stack, where the runtime must establish stack maps to -find roots. +Both executors use loop-driven sequence normalization. Nested open delimiters +may call the open executor while retaining their caller; stack use can depend on +handler nesting depth, but does not grow with bind or forwarded request count +at fixed handler depth. This guarantee does not cover arbitrary recursive user +callbacks or direct-style capture across foreign frames. #### The trampoline @@ -699,12 +773,35 @@ re-entrant resume is rejected. ### The executor loop -The executor is the fold driver ([The executor and the runtime boundary](#the-executor-and-the-runtime-boundary)): +The closed executor drives both computation and pending sequence in a flat loop: ```text -run h s (Return a) = (s, a) -run h s (Perform op cont) = let (s', next) = h s op cont in run h s' next +exec(h, s, Bind(c, k), q) = exec(h, s, c, Cons(k, q)) +exec(h, s, Resume(v, saved), q) = exec(h, s, Return(v), Append(saved, q)) +exec(h, s, Return(v), Empty) = (s, v) +exec(h, s, Return(v), Cons(k, q)) = exec(h, s, k(v), q) +exec(h, s, Return(v), Append(Empty, q)) = exec(h, s, Return(v), q) +exec(h, s, Return(v), Append(Cons(k, rest), q)) = + exec(h, s, k(v), Append(rest, q)) +exec(h, s, Return(v), Append(Append(a, b), q)) = + exec(h, s, Return(v), Append(a, Append(b, q))) +exec(h, s, Perform(op), q) = + let cont(x) = Resume(x, q) + let (s', next) = h(s, op, cont) + exec(h, s', next, Empty) +``` + +Every recursive `exec` edge is a self tail call lowered to a MIR loop. Calls to +ordinary bind functions and handlers return one computation step; they do not +traverse the saved sequence. User code's own non-tail recursion is outside this +machine's stack-safety guarantee. Invalid internal tags trap explicitly. +The open executor uses the same sequence rules. At a request it projects the opaque +union, calls the matching handler for a handled request, or constructs residual +control data with a continuation that reinstates the saved handler state and +sequence: + +```text handle h s project inject (Return a) = Return (s, a) handle h s project inject (Perform uop cont) = case project uop of @@ -752,7 +849,7 @@ This is the design target, not a claim that these APIs exist yet: | Location | Intended responsibility | | --- | --- | | `Prim.Control` owner | The abstract `Control f a` carrier and the `return`/`bind`/`perform`/`run`/`handle` primitives, with their checked schemes | -| MIR control-lowering owner | Selective CPS/defunctionalization, the frame table, deep/shallow wrapping, and one-shot status | +| CC control lowering and MIR | Persistent continuation sequencing and synthesis below Typed Core; selective conversion, deep/shallow wrapping, and one-shot status | | Executor (guest code) | The loop that drives frames against a handler and threads its state; compiler-generated or a library function over a frame view; never a runtime interpreter of the frame layout | | MIR verifier | Frame identity, capture boundary, continuation result-type, and suspension-observability checks | | Existing Core/CC/MIR lowering and optimizers | Compile the converted frames and the executor as ordinary higher-order code; preserve generic observable-call semantics | @@ -846,6 +943,8 @@ following remain open. - [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), and [compiler cleanup handoff](../../../implementation/backend/effect-state-removal-handoff-2026-10-11.md). +- [Reflection without Remorse](https://okmij.org/ftp/Haskell/Reflection.html) for + explicit type-aligned continuation sequences. - [Continuing WebAssembly with Effect Handlers](https://arxiv.org/abs/2308.08347) and the [WebAssembly stack-switching proposal](https://github.com/WebAssembly/stack-switching), proposal-level references, not evidence of this target profile's support. diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 9083f17e..76dc36d6 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1,6 +1,6 @@ # Algebraic Effects: Proposed Acceptance Checklist -**Status:** Design only; all requirements below are Unverified. +**Status:** Partial implementation evidence; all complete requirements below remain Unverified. **Design:** [Library-owned algebraic effects and handlers](../../design/backend/fp/algebraic-effects-and-handlers.md) (library model) and [Delimited control and resumable frames](../../design/backend/fp/delimited-control-and-resumable-frames.md) (compiler mechanism). @@ -9,7 +9,7 @@ selects compiler-generated resumable frames as the generic handler/interruption mechanism. **Date:** 2026-10-11. -This checklist records evidence required for a future implementation. Creating +This checklist records the complete evidence required for implementation. Creating it does not resume the withdrawn State migration or select native Effect/ST representation. Compiler cleanup and runtime build-tool changes are separate work. The `AC-*` obligations are **required**, not conditional: DEC-19 selected @@ -42,8 +42,9 @@ them: | AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Unverified | | AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior; suspension is not optimized away | Unverified | -No runtime or differential validation was run for this design. Record future -evidence with compiler/package identities, commands, actual outputs, and any +The evidence sections below record focused runtime validation. No official +PureScript differential validation has been run for the control surface. Record +further evidence with compiler/package identities, commands, actual outputs, and any skips. Do not infer topic completion from existing generic compiler tests. ## Prototype evidence (2026-10-11) @@ -63,5 +64,197 @@ PSRS_STDLIB_ROOT= PSRS_REQUIRE_WASMTIME=1 \ This is representation and interpretation evidence only. It does not establish AE-04/AE-05/AE-06 (row-based handlers, deep/shallow, forwarding), AE-07 (captures, rank-N interpreter arguments, higher-order calls, signature adapters), or any -`AC-*` obligation, because the compiler-generated resumable-frame mechanism is not -implemented. No status above changes. +`AC-*` obligation, because that prototype does not use compiler-generated resumable frames. No status above changes. + + +## Closed control executor evidence (2026-10-11) + +The continuation machine is lowered in CC using layout-predeclared representations +and signatures. `Return`, `Perform`, and inert `Bind` nodes execute under a closed +`run`. A persistent continuation sequence is captured at requests; invoking a +resumption constructs internal `Resume` data rather than recursively executing +saved frames. MIR lowers the executor's self tail calls to loop back edges. +Ordinary conservative call effects retain interpretation with ignored results; +there is no control-specific optimizer exemption. + +The baseline at `2026238f` passed the five existing `control_surface` tests. +`executes_a_performed_request` compiled but trapped with `unreachable` (Wasmtime +exit 134) rather than returning 42. The same case now returns 42. + +`crates/psrs-driver/tests/control_surface.rs` covers the typed surface and the +return/request runtime paths. `crates/psrs-driver/tests/control_runtime.rs` adds +value-sensitive checks for left/right bind association, state/order, abandonment +of a trapping remainder, persistent multi-shot replay, replayed requests with +current handler state, nested delimiters, inert construction and strict factory +arguments, repeated interpretation, ignored-result handler traps, aggregate state +and captures, and callable answers. The stack-safety test executes 100,000-step +left-associated binds, right-associated binds, and request sequences under +Wasmtime. This tests machine traversal, not arbitrary recursion in user callbacks. + +The public CC-to-MIR variant construction contract is also covered directly by +`variant_construction_lowers_at_abstract_and_common_representation_shapes`: both +field-bearing and nullary cases lower at abstract and concrete common variant +shapes. Construction first uses the concrete case type and then widens when the +CC destination names the common representation. + +Run the focused evidence with the locked standard library and mandatory runtime: + +```sh +PSRS_STDLIB_ROOT= PSRS_REQUIRE_WASMTIME=1 \ + cargo test -p psrs-driver --test control_surface --test control_runtime +``` + +This subsection records the closed-executor slice. Open elimination and GC +evidence are recorded below. One-shot APIs, expired-boundary rejection, complete +deep/shallow wrappers, foreign-resource lifetime checks, and official source +comparison remain unverified. The ordinary CC/MIR verifiers check call shapes, +fields, tags, and control flow; they trust Typed Core's answer-type relationship +and the synthesized machine's sequencing rules. They do not independently prove +all frame identity, lifetime, or multiplicity obligations in `AC-*`. No complete +requirement above changes status. + + +For the standalone request reproducer, the retained component +`/private/tmp/psrs-control-perform.wasm` executes with exit 42 under Wasmtime +49.0.2 (`3c8a3e79a`, 2026-10-02). Its SHA-256 is +`fc9f54c5934873af34beab1f3a8b745535a231cb7cbf8b3bfd8d94ab5bc9e192`. +The same source's baseline component trapped with exit 134. + +The matching source diagnosis reports are `/private/tmp/psrs-control-before.json` +and `/private/tmp/psrs-control-after.json`, with retained Core/CC/MIR bundles. +Both compile successfully; compile diagnosis alone cannot observe the runtime +repair. The updated executor's retained MIR has loop jumps and no direct self +calls. Artifact canonical comparison and node lineage are unavailable in the +trace format, so this is manual MIR inspection plus actual execution evidence. + + +Validation of the closed-executor snapshot, using locked revision `1e01310` +and mandatory Wasmtime, completed on 2026-10-11: + +- `cargo fmt --all --check` and `git diff --check`: passed. +- `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- Backend library tests: 423 passed, including the common variant regression. +- Control tests: 6 surface tests and 12 runtime tests passed, with no runtime skips. +- `cargo test --workspace`: failed at the first CLI integration target. +- `cargo test --workspace --no-fail-fast`: completed every target; 9 targets failed + with 176 failing test names. A full baseline run from archived `2026238f` with + identical stdlib/runtime settings has exactly the same failed targets and test + names. No previously passing test became failing in this comparison. + +| Failed target (baseline and updated) | Failed tests | +| --- | ---: | +| `psrs-cli --test cli` | 1 | +| `psrs-cli --test diagnose_trace` | 1 | +| `psrs-cli --test link` | 1 | +| `psrs-cli --test source_layout` | 1 | +| `psrs-driver --lib` | 163 | +| `psrs-driver --test data_representation_execution` | 1 | +| `psrs-driver --test pattern_matrix_execution` | 6 | +| `psrs-driver --test residual_constraints` | 1 | +| `psrs-driver --test visible_type_application` | 1 | + +The CLI Prelude reproducer fails in both versions at P8 WIT linking because the +locked package still names the removed `psrs:effect` interface. Other baseline +failures are retained in the logs; the shared failure set is not a claim that +all 176 failures have one semantic cause. Workspace acceptance remains failing. + +Baseline and final logs are `/private/tmp/psrs-control-baseline-all.log` and +`/private/tmp/psrs-control-workspace-verified.log`; their failure-set comparison +is `/private/tmp/psrs-control-workspace-comparison.json`. The final clippy log is +`/private/tmp/psrs-control-clippy-verified.log`. Shared-build-cache interference +was discovered during intermediate runs; those intermediate results were +excluded, and the final updated run rebuilt workspace packages after cleaning +their artifacts. These temporary files are local continuation evidence, not +portable repository artifacts. Official control differential cases and suite +scoreboards were not run; complete AE/AC statuses remain Unverified. + + +## Open control executor evidence (2026-10-11) + +The open executor interprets inert `Handle` nodes and applies the library's +rank-2 Church-sum projection. Handled requests continue its loop; residual +requests stop that loop with `Bind(Perform(gop), forward)`. The generated forwarding +closure captures the persistent inner sequence and immutable handler state and +constructs another inert `Handle` when resumed. Both drivers share bind, return +and append reductions. `inject` is evaluated and retained; the original union +computation supplies the continuation, so no request reconstruction calls it. +The shared intrinsic summary now correctly classifies `handle` construction as +inert. Interpretation remains an ordinary conservative call. + +`control_open_runtime.rs` has 17 mandatory-runtime tests covering: + +- Handled/forwarded/handled ordering and saved state; three nested open/closed + delimiters eliminating distinct ordinary request functors. +- Inner and outer abandonment, inner replay, outer replay with independent inner + state, outer bind ordering, and residual requests created inside clauses. +- Inert construction, strict arguments, ignored interpretation traps, repeat + interpretation, and equivalent behavior after renaming operation constructors. +- Aggregate state, request answers, results and captures through erasure. +- 100,000 iterations each containing a handled and a forwarded request. +- Deep reinstallation versus a library clause that forwards later requests to + the outer handler. This is explicit library routing evidence; no dedicated + shallow primitive or generic shallow wrapper has been implemented. +- A continuation held across 5,000 nested interpreted requests with a captured + record. Wasmtime starts with a 65,536-byte GC heap; the test checks the completed + collection log and the final captured result 42. This establishes collection + of ordinary GC captures during suspension, not foreign resource lifetimes. + +`control_surface.rs` adds rejection cases for an incompatible residual functor, +incompatible injection, and a projection specialized to one request answer. +The focused command is: + +```sh +PSRS_STDLIB_ROOT= PSRS_REQUIRE_WASMTIME=1 \ + cargo test -p psrs-driver --test control_surface --test control_runtime --test control_open_runtime +``` + +All 38 focused tests passed (9 surface, 12 closed runtime, 17 open runtime), with +mandatory Wasmtime and no skips. The GC test retains the runtime collection log +at `$TMPDIR/psrs-control-open-gc-gc.log`. It requires a runtime exposing the pinned +Wasmtime logging/heap configuration. The tests do not use the `gc-zeal` debug +option, which ordinary Wasmtime builds can ignore. + +The existing `AC-*` statuses remain Unverified: the monadic multi-shot API has no +explicit one-shot resumption or cancellation primitive, and generated resumptions +currently have no delimiter-liveness check. Ordinary verifiers trust the generated +machine's sequencing and checked source answer types. Direct-style selective +conversion, foreign capture checks and complete frame/lifetime verification remain +required. These obligations have not been removed from the normative design. + + +### Integrated validation of the open continuation + +With the same locked package revision `1e01310` and mandatory Wasmtime: + +- Formatting, `git diff --check`, and full workspace/all-target clippy passed. +- `cargo test --workspace --no-fail-fast` completed every target. The 9 failed + targets and 176 failed test names exactly match the archived `2026238f` + baseline; the comparison has no new failures and no recovered failures. +- Backend library tests: 423 passed. The 38 focused control tests also passed + within this complete run, including the observed-GC test. + +Logs: `/private/tmp/psrs-control-open-workspace-final.log`, +`/private/tmp/psrs-control-open-clippy.log`, and +`/private/tmp/psrs-control-open-focused-final.log`. Failure sets are recorded in +`/private/tmp/psrs-control-open-workspace-comparison.json`. An earlier workspace +run overlapped recompilation during tests and had stale-dependency rustdoc errors; +it is excluded from the evidence above. The final run completed before the next +build began. Workspace acceptance remains failing on the baseline failures. + + +The standalone mixed handled/residual request source is retained at +`/private/tmp/psrs-control-open.purs`. Matching before/after trace reports are +`/private/tmp/psrs-control-open-before.json` and +`/private/tmp/psrs-control-open-after.json`. Input/cohort/environment observations +match: the baseline stops at P8 closure conversion with unsupported open handling; +the updated source compiles with no diagnostics. The observed pass-status change +is `backend.cc.lower` from rejected to completed; canonical artifact comparison +remains unavailable. + +The retained component `/private/tmp/psrs-control-open.wasm` executes with exit 42. +Its SHA-256 is `bb67426e18809c9d7142f0c768462af33760a42d62c98ad7f30150562622ce5c`. +Manual inspection of the retained MIR shows loop back edges for both executors. +The open executor retains one non-tail call to itself for nested `Handle` entry; +this matches the documented handler-depth bound and does not recurse once per +forwarded request. Wasmtime 49.0.2 executes the long forwarding test and the +collection test. Official differential cases and scoreboards were not run. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 10910916..ca23d62f 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -1,236 +1,151 @@ -# Handoff: Lower the Delimited-Control Executor +# Handoff: Delimited-Control Lowering -**Date:** 2026-10-11 -**Branch:** `feat/effect-handlers` (based on `stdlib/vendor-core-libraries`) -**Scope:** Continue the compiler lowering for the `Prim.Control` delimited-control -surface. The `return`/`run` path works end to end; the `perform`/`bind` executor and -`handle` are not lowered. -**Status:** Partial. Frames and effect summaries are in place; the executor needs a -design decision recorded below before it can be emitted. +**Date:** 2026-10-11 +**Branch:** `feat/effect-handlers` +**Starting commit:** `2026238f`; the checkout was clean before this continuation. +**Scope:** Typed `Prim.Control` surface, closed/open executors, and persistent bind +sequencing. The continuation changes below are uncommitted. +**Status:** Partial topic. All five current primitives are lowered; complete AE/AC acceptance remains outstanding. -## Objective +## Governing contracts -Implement **[DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md)**'s -compiler-generated resumable-frame mechanism for the `Prim.Control` surface, so that -library code can define algebraic-effect operations and handlers on top of it. The -normative designs are: +- [DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md). +- [Delimited Control and Resumable Frames](../../design/backend/fp/delimited-control-and-resumable-frames.md). +- [Library-Owned Algebraic Effects and Handlers](../../design/backend/fp/algebraic-effects-and-handlers.md). +- [Acceptance checklist](algebraic-effects.md). -- [Library-Owned Algebraic Effects and Handlers](../../design/backend/fp/algebraic-effects-and-handlers.md) - (library model; the operations, rows, handlers live in the standard library). -- [Delimited Control and Resumable Frames](../../design/backend/fp/delimited-control-and-resumable-frames.md) - (the compiler mechanism: the surface, the frame representation, the executor, the - runtime boundary, the comparison with stack switching). **Read this first.** -- [Algebraic Effects: Proposed Acceptance Checklist](../../implementation/backend/algebraic-effects.md) - (AE-*/AC-* evidence requirements; all still Unverified). +The type system gains no effect tracking or effect reasoning. The compiler owns +only the carrier and generic mechanism below Typed Core; concrete operations, +rows, and handlers remain library code. The executor is guest code, and +`psrs-runtime` does not inspect control frames. -The scope decision: **the type system gains no effect tracking or effect reasoning**; -effect requirements are ordinary library types. The carrier and primitives are -compiler-owned; operations, rows, and handlers are library code. The mechanism is -confined below Typed Core. +## Committed starting state -## What is implemented +- `1633dd88`: the `Control f a` carrier and the checked schemes for + `return`, `bind`, `perform`, `run`, and `handle`. +- `64a27de8`: inert `Return`, `Perform`, and `Bind` frames; only `run` of a + `Return` frame executed, while every other frame trapped. +- `d8fc2508`: a shared direct-call signature table for lowering-generated + functions. It did not provide emitter `SignatureId` handles. +- `2026238f`: the original lowering handoff. -### Frontend surface (committed `1633dd88`) +The original five `control_surface` tests passed at this checkpoint, including +Wasmtime exit 42 for `run (return 42)`. A new request runtime reproducer compiled +but trapped with `unreachable` (exit 134). -`Prim.Control` (a compiler-reserved interface) exposes: +## Current lowering + +The representation table stays immutable during CC lowering. Layout predeclares +all machine representations and the executor signature; the continuation uses +the existing unary erased callable-slot protocol. Verifier direct-call signatures +are registered from those same declarations. ```text -Control f a -- opaque carrier, kind (Type -> Type) -> Type -> Type -return : a -> Control f a -bind : Control f a -> (a -> Control f b) -> Control f b -perform : f a -> Control f a -run : s - -> (forall x. s -> f x -> (x -> Control f a) -> (s, Control f a)) - -> Control f a - -> (s, a) -handle : s - -> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a)) - -> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) -- project (Church sum) - -> (forall x. g x -> u x) -- inject - -> Control u a - -> Control g (s, a) +Computation = Return(value) | Perform(request) | Bind(inner, continuation) + | Resume(value, savedSequence) + | Handle(state, handler, project, inject, inner) +Sequence = Empty | Cons(continuation, rest) | Append(left, right) +executor(state, handler, computation, pendingSequence) -> erased (state, value) ``` -`run` is the closed state-threading fold; `handle` is the open eliminator that -removes one effect and leaves a residual. Touch points: - -- `crates/psrs-hir/src/primitives/control.rs` — the `Control` carrier declaration - (kind, representational roles). -- `crates/psrs-hir/src/intrinsic/mod.rs` — `ControlReturn=92 … ControlHandle=96`, - `ALL`, reserved-slot assertion. -- `crates/psrs-hir/src/intrinsic/registry.rs` — `IntrinsicCategory::Control`, - descriptors, and the schemes (`control_run`, `control_handle`, `record` helper). -- `crates/psrs-hir/src/intrinsic/effects.rs` — `run`/`handle` are `may_trap`+`may_write`. -- `crates/psrs-hir/src/compiler_interface.rs` — the `Prim.Control` interface - (`return`/`bind`/`perform`/`run`/`handle`). -- `crates/psrs-hir/src/lib.rs` — `TypeId::CONTROL`. - -### Backend representation and the `return`/`run` path (committed `64a27de8`) - -- **`Control f a` is an opaque aggregate.** `crates/psrs-backend/src/cc/mod.rs` - inserts `HirTypeId::CONTROL` into `aggregate_types`, so `scalar_type` needs no - change. `crates/psrs-backend/src/cc/layout/mod.rs` reserves the shared **frame** - representation and stores it in `TypeLayout::control_type`: - - ```text - Variant { - Return [Erased] -- tag 0 - Perform [Erased] -- tag 1, the request only (no continuation) - Bind [Erased, Erased] -- tag 2, an inner computation and a continuation - } - ``` - -- **`control_type` is threaded** through `LoweringContext`/`FunctionLowerer` - (`crates/psrs-backend/src/cc/lower/mod.rs`). -- **`return`/`perform`/`bind`** lower to frames in - `crates/psrs-backend/src/cc/lower/intrinsic.rs::lower_control` (a `VariantNew` - with erased fields via `lower_array_element`). -- **`run`** lowers inline (`lower_control_run`): read the tag, and for a `Return` - frame build the `(state, value)` record and return it; every other tag traps. -- `crates/psrs-backend/src/target_intrinsics/mod.rs` adds - `Implementation::Control` and maps the five intrinsics to it. - -### Executor plumbing (committed `d8fc2508`) - -`generated_signatures: Rc>>` is shared by the -lowering context and the function lowerer, and the per-function verifier resolves -direct calls against the declared signatures **plus** these. This is the plumbing a -lowering-synthesized executor function needs. **No lowering registers a signature -yet.** - -### Tests - -`crates/psrs-driver/tests/control_surface.rs` (5 tests, all passing): -`control_surface_typechecks`, `control_surface_handles_one_effect`, -`control_surface_rejects_result_type_confusion`, -`control_surface_requires_a_rank_two_handler`, `executes_a_returning_computation`. - -`executes_a_returning_computation` compiles a `return`/`run` program, runs it under -`wasmtime`, and asserts **exit 42**. The exact program: - -```purescript -module Main where -import Prim.Control as C -data Op next = Op (Int -> next) -program :: C.Control Op Int -program = C.return 42 -result :: { _1 :: Int, _2 :: Int } -result = C.run 0 handler program - where - handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } - handler s (Op k) cont = { _1: s, _2: cont (k s) } -main :: Int -main = result._2 -``` +`Bind` is inert. The executor pushes its continuation and processes its inner +computation. `Return` consumes one pending continuation. At `Perform`, the +handler receives a resumption capturing the persistent pending sequence; calling +it builds `Resume` data. It does not recursively execute the saved work. `Resume` +joins saved and caller sequences in that order, with loop-driven normalization. + +After a handler returns its next state/computation, the executor clears its old +pending sequence. Only the returned computation chooses whether to resume, +abandon, or replay saved work. All frame/sequence nodes remain immutable, so +multiple resumptions share the saved chain safely. A bare `Perform` needs only +the request; its identity continuation is the empty sequence. This supersedes the +original handoff's proposed recursive composition closures and mandatory +continuation field on every `Perform` node. + +Concrete state, results, handlers, and bind closures cross the existing payload +conversion boundary. The result pair uses the canonical erased `_1`/`_2` record +protocol. Closed/open executors and generated resumption/projection functions are shared across all +`run` sites in the linked module. Self tail calls become MIR loop back edges. +Conservative ordinary call effects preserve ignored-result interpretation; no +control-specific optimizer classification was introduced. + +### Code owners + +- `crates/psrs-backend/src/cc/layout/control.rs`: predeclared machine layouts and + signatures. +- `crates/psrs-backend/src/cc/lower/control/`: source primitive lowering, synthesis, + CC construction helpers, shared driver reductions, and open forwarding. +- CC lowering context and lambda children: shared generated functions/signatures. + Nested functions resolve generated executor calls during verification. +- `crates/psrs-backend/src/mir/lower/variant.rs`: the general CC-to-MIR variant + construction contract. A concrete common variant result is constructed at its + case type before widening; the direct regression covers nullary and + field-bearing cases at abstract/common result shapes. +- `crates/psrs-driver/tests/control_surface.rs` and `control_runtime.rs`: source + rejection and mandatory value-sensitive execution evidence. + +## Open-handler continuation + +`handle` is an inert node. The open executor shares closed-driver reductions, +but returns residual computation data. Its Church-sum projection selects handled +requests or unchanged residual payloads. A residual bind closure captures the +inner state, handler and pending sequence and constructs a fresh `Handle` around +`Resume`; it does not recursively interpret the sequence. Outer replay preserves +independent copies of saved inner state, and outer abandonment discards the inner +remainder. The caller's pending bind stays outside the inner delimiter. + +The current machine retains the original union computation, so `inject` is +strictly evaluated and stored but is not called to reconstruct a request. The +normative design records this contract. Native stack use may depend on handler +nesting depth, not on the number of requests at fixed depth. + +`control_open_runtime.rs` adds executed open-handler, forwarding, nested-handler, +aggregate, replay, trap and GC evidence. The GC case requires an observed completed +collection in the runtime log before claiming success. Source tests reject an +incompatible residual functor/injection and a monomorphic projection. + +## Validation + +The locked standard-library revision `1e01310` is materialized at: -## How to run +```text +/private/var/folders/f2/h3z3zsy51xq3kr06707r9ct40000gn/T/opencode/psrs-stdlib-1e01310 +``` -The on-disk `/Users/biu/Projects/psrs-stdlib` differs from `stdlib.lock.json`, so the -driver requires the locked revision via `PSRS_STDLIB_ROOT`. A materialized copy of -locked revision `1e01310` is at -`/private/var/folders/f2/h3z3zsy51xq3kr06707r9ct40000gn/T/opencode/psrs-stdlib-1e01310` -(re-materialize with `git archive` if it is gone; do not change the lock or the -package). +Set `PSRS_STDLIB_ROOT` to that directory. Do not modify the lock or substitute the +working standard-library checkout. Run runtime evidence with +`PSRS_REQUIRE_WASMTIME=1`. ```sh -export PSRS_STDLIB_ROOT=/private/var/folders/f2/h3z3zsy51xq3kr06707r9ct40000gn/T/opencode/psrs-stdlib-1e01310 -cargo build --workspace cargo fmt --all --check -cargo clippy -p psrs-backend -p psrs-driver -p psrs-hir --all-targets -- -D warnings -cargo test -p psrs-backend --lib # 422 tests -PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test control_surface +cargo clippy --workspace --all-targets -- -D warnings +cargo test --workspace +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test control_surface --test control_runtime --test control_open_runtime ``` -`wasmtime` 49.0.2 is installed. All of the above were green at `d8fc2508`. +Final validation passed formatting, full clippy, 423 backend library tests, and +38 control tests with mandatory Wasmtime. Full workspace acceptance still fails: +the open-continuation `--no-fail-fast` run and archived `2026238f` baseline have the same +9 failing targets and 176 failing test names. The acceptance checklist records +the decomposition, logs, tested cases, and remaining obligations. +Compile acceptance, executed runtime checks, and official source comparison are +separate claims. ## Remaining work -The next slice is the **executor**: lower `ControlRun` (and `ControlHandle`) to a -generated function that drives frames, and implement `ControlPerform`/`ControlBind` -so they build frames carrying a **continuation**, not just the request. - -### The blocking design decision - -The executor and the continuation closures it needs are lowering-synthesized -functions. `AssignmentKind::FunctionRef`/`IndirectCall` require a `SignatureId` from -the `RepresentationTable`, which is **immutable during CC lowering** (only the layout -phase has `&mut`). The `generated_signatures` table added in `d8fc2508` holds CC -`Signature` values (parameter/result shapes) for the *verifier*, but not the -`SignatureId` the emitter needs. Two ways forward: - -- **(a) Make the representation table extensible during lowering** (`Rc>`). - Direct but broad. -- **(b) Pre-declare erased signatures and representations in layout** and emit one - generic erased executor. **This is the intended path.** Reserve in - `crates/psrs-backend/src/cc/layout/mod.rs`: - - `control_cont_signature : [Erased] -> Erased` (a continuation), - - `control_executor_signature : [Erased, Erased, Erased] -> Erased` - (state, handler, computation → an erased `(state, value)` pair), - - `control_pair : Product[Erased, Erased]` (the `(state, value)` result), - and add them to `TypeLayout`, threaded like `control_type`. - -### Executor semantics - -The freer-monad fold for the closed `run` is: - -```text -exec h s (Return a) = (s, a) -exec h s (Perform op cont) = let (s', next) = h s op cont in exec h s' next -exec h s (Bind inner g) = exec h s' (continue inner g) -``` - -At the erased level: `TagSwitch` on the computation's tag; `Return` builds the -`control_pair`; `Perform` calls the rank-2 handler (erased -`[Erased,Erased,Erased]->Erased`) and recurses on its result; `Bind` evaluates the -inner computation and composes the continuations. Recurrence is a self tail call, -which MIR loopification turns into a `loop`. The call site boxes `s`/`handler`/ -`computation`, calls the executor, then unboxes the pair and converts each field to -the concrete `(s, a)` record. A single generic executor is enough (dedupe by symbol). - -The frame representation must change: **`Perform` must carry its continuation**, and -`bind` must compose continuations (`bind (Perform op k) g = Perform op (\x -> bind (k x) g)`), -so `perform op` needs an identity continuation (`\x -> Return x`) and `bind` needs a -composition closure — both synthesized with `FunctionRef` using the pre-declared -signatures. This is where the synthesis work lives. - -### Additional touch points - -- `crates/psrs-backend/src/cc/lower/intrinsic.rs` — rewrite `lower_control_run`; - implement the `perform`/`bind` continuation closures; generate the executor. -- `crates/psrs-backend/src/cc/mod.rs` — carry the new pre-declared handles. -- `crates/psrs-backend/src/cc/lower/mod.rs` / `lambda/mod.rs` — thread them; the - executor is appended via `self.generated`. -- `crates/psrs-backend/src/target_intrinsics/tests.rs` — the control intrinsics are - `Implementation::Control` now (they are no longer expected `Unsupported`). -- `crates/psrs-backend/src/mir/opt/effects.rs` — classify the executor call as - effectful so a suspension is never erased. - -### Not started - -- `ControlHandle` (the open eliminator): not lowered. -- The standard-library wrapper (`Run r a`, `handleState`, …): not written. The - library can be authored once the executor works; the surface typechecks today. -- Verifier/optimizer obligations for the executor and for suspension observability. -- Runtime-side design (the executor is guest code; `psrs-runtime` carries no - continuation for the software form — see the design's "executor and runtime - boundary"). - -## Known limitations / honest gaps - -- Only the `return` path of `run` executes. `perform`/`bind` build frames that trap - at `run` until the executor lands. -- The frame representation currently has no continuation slot in `Perform`; it must - be revised as described. -- `handle` is unreachable. -- The locked standard library is stale relative to the Effect/State removal, so the - default root cannot compile library-dependent programs; the control tests use - self-contained sources and the locked revision via `PSRS_STDLIB_ROOT`. - -## Workflow notes - -- The user has been reviewing and committing topical commits as work lands. Local - history on `feat/effect-handlers` is not pushed; the four commits above are the - current state. Do not rewrite pushed history (none is pushed). -- AGENTS.md governs the repository: keep changes topical, keep compiler - representations separate, do not narrow the design to close gaps, and report - unsupported cases honestly. +- Implement library wrappers in the independent `psrs-stdlib` repository. +- Complete generic deep/shallow wrappers, one-shot, lifetime/cancellation, + foreign capture-boundary, foreign-resource GC, and official differential evidence. + Ordinary GC capture recovery during suspension has executed evidence. +- Formalize selective conversion beyond the monadic surface. This closed executor + does not establish direct-style capture or arbitrary user recursion safety. +- Extend verification evidence for complete frame identity and lifetime claims. + Current generic verifiers check ordinary shapes, calls, tags, and control flow; + they trust checked answer types and the generated machine's sequencing rules. +- Repair the separate mismatch between the locked package's old Effect bindings + and the compiler's removed Effect/State mechanism. A locked-package failure is + not evidence about the self-contained control programs. + +No complete AE/AC requirement is marked Verified by these slices. All current +`Prim.Control` primitives lower and execute; one-shot and expired-boundary +guarantees still require their API and representation contracts. From a31ba11e85db07872050fcf282a3a6c1ddbbe639 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 21:22:27 +0800 Subject: [PATCH 103/148] Enforce resumption ownership and delimiter lifetime --- .../src/bindings/primitives/mod.rs | 15 +- crates/psrs-backend/src/cc/layout/control.rs | 78 +++- crates/psrs-backend/src/cc/layout/mod.rs | 6 +- .../psrs-backend/src/cc/layout/protocols.rs | 29 +- .../src/cc/lower/control/builder.rs | 20 +- .../src/cc/lower/control/executor.rs | 28 +- .../src/cc/lower/control/lifetime.rs | 237 +++++++++++ .../psrs-backend/src/cc/lower/control/mod.rs | 108 ++++- .../psrs-backend/src/cc/lower/control/open.rs | 23 +- .../src/cc/lower/control/owned.rs | 54 +++ crates/psrs-backend/src/cc/mod.rs | 1 + .../psrs-backend/src/target_intrinsics/mod.rs | 9 +- .../src/target_intrinsics/tests.rs | 3 + crates/psrs-driver/tests/control_lifetime.rs | 109 +++++ .../tests/control_owned_runtime.rs | 171 ++++++++ .../tests/control_owned_surface.rs | 67 +++ .../tests/control_primitive_values.rs | 58 +++ crates/psrs-hir/src/compiler_interface.rs | 10 +- crates/psrs-hir/src/intrinsic/effects.rs | 4 +- crates/psrs-hir/src/intrinsic/mod.rs | 13 +- crates/psrs-hir/src/intrinsic/registry.rs | 397 +----------------- .../src/intrinsic/registry/scheme/control.rs | 198 +++++++++ .../src/intrinsic/registry/scheme/mod.rs | 237 +++++++++++ crates/psrs-hir/src/lib.rs | 2 + crates/psrs-hir/src/primitives/control.rs | 42 +- crates/psrs-hir/src/primitives/tests.rs | 3 +- docs/design/D-04-suite-roadmap.md | 2 +- .../delimited-control-and-resumable-frames.md | 84 +++- docs/feature/F-02-portable-programs.md | 8 +- .../backend/algebraic-effects.md | 131 ++++++ ...ted-control-lowering-handoff-2026-10-11.md | 89 +++- 31 files changed, 1742 insertions(+), 494 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/control/lifetime.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/owned.rs create mode 100644 crates/psrs-driver/tests/control_lifetime.rs create mode 100644 crates/psrs-driver/tests/control_owned_runtime.rs create mode 100644 crates/psrs-driver/tests/control_owned_surface.rs create mode 100644 crates/psrs-driver/tests/control_primitive_values.rs create mode 100644 crates/psrs-hir/src/intrinsic/registry/scheme/control.rs create mode 100644 crates/psrs-hir/src/intrinsic/registry/scheme/mod.rs diff --git a/crates/psrs-backend/src/bindings/primitives/mod.rs b/crates/psrs-backend/src/bindings/primitives/mod.rs index 961c9855..9af5a7f3 100644 --- a/crates/psrs-backend/src/bindings/primitives/mod.rs +++ b/crates/psrs-backend/src/bindings/primitives/mod.rs @@ -18,9 +18,6 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), Some((external.clone(), intrinsic)) }) .collect::>(); - if bindings.is_empty() { - return Ok(()); - } module .verify_with_source(source.unwrap_or(module)) .map_err(|errors| { @@ -42,9 +39,17 @@ pub(crate) fn lower(module: &mut Module, source: Option<&Module>) -> Result<(), let mut probe = module.clone(); probe.declarations.clear(); probe.entry = None; - let operations = bindings + // Compiler-interface globals and explicit foreign primitive bindings share + // the same checked value elaboration. A primitive used as an alias or a + // partial application still needs expansion when there are no externals. + let operations = Intrinsic::ALL .iter() - .map(|(external, intrinsic)| (external.symbol, *intrinsic)) + .map(|intrinsic| (intrinsic.symbol(), *intrinsic)) + .chain( + bindings + .iter() + .map(|(external, intrinsic)| (external.symbol, *intrinsic)), + ) .collect(); for (external, intrinsic) in bindings { let span = external diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control.rs index 355870b4..e4b78a89 100644 --- a/crates/psrs-backend/src/cc/layout/control.rs +++ b/crates/psrs-backend/src/cc/layout/control.rs @@ -12,6 +12,12 @@ pub(in crate::cc) struct ControlLayout { pub executor: SignatureId, pub open_executor: SignatureId, pub projected: ReprId, + pub owner: ReprId, + pub callback: ReprId, + pub boundary: ReprId, + pub status: ReprId, + pub start: SignatureId, + pub boundary_check: SignatureId, } pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) -> ControlLayout { @@ -20,7 +26,7 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) table.set( computation, Representation::Variant { - cases: [1, 1, 2, 2, 5] + cases: [1, 1, 2, 3, 5, 6, 2] .into_iter() .enumerate() .map(|(tag, count)| VariantCase { @@ -57,11 +63,11 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) pair }); let executor = table.add_signature(Signature { - parameters: vec![erased; 4], + parameters: vec![erased; 5], result: erased, }); let open_executor = table.add_signature(Signature { - parameters: vec![erased; 6], + parameters: vec![erased; 7], result: erased, }); let projected = table.reserve(); @@ -76,6 +82,38 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) .collect(), }, ); + let callback = super::protocols::array(table, erased); + let owner = table.reserve(); + table.set( + owner, + Representation::Variant { + cases: vec![VariantCase { + tag: 0, + fields: vec![erased; 2], + }], + }, + ); + let status = super::protocols::array(table, crate::cc::ValueShape::Integer); + let boundary = table.reserve(); + table.set( + boundary, + Representation::Variant { + cases: (0..2) + .map(|tag| VariantCase { + tag, + fields: vec![erased; tag as usize + 1], + }) + .collect(), + }, + ); + let start = table.add_signature(Signature { + parameters: vec![], + result: erased, + }); + let boundary_check = table.add_signature(Signature { + parameters: vec![erased], + result: erased, + }); ControlLayout { computation, sequence, @@ -84,5 +122,39 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) executor, open_executor, projected, + owner, + callback, + boundary, + status, + start, + boundary_check, + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn control_cells_reuse_existing_canonical_array_layouts() { + let mut table = RepresentationTable::default(); + let erased = erased_shape(); + let callback = super::super::protocols::array(&mut table, erased); + let status = super::super::protocols::array(&mut table, crate::cc::ValueShape::Integer); + let continuation = table.add_signature(Signature { + parameters: vec![erased], + result: erased, + }); + let layout = append(&mut table, continuation); + assert_eq!(layout.callback, callback); + assert_eq!(layout.status, status); + assert_eq!( + table + .representations + .iter() + .filter(|repr| matches!(repr, Representation::Array { .. })) + .count(), + 2 + ); } } diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index c6d96adc..e94a5650 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -254,7 +254,7 @@ pub(super) fn type_layout( let mut aggregate_ids = aggregate_types .iter() .copied() - .filter(|id| *id != HirTypeId::CONTROL) + .filter(|id| *id != HirTypeId::CONTROL && *id != HirTypeId::RESUMPTION) .collect::>(); aggregate_ids.sort_by_key(|id| (id.module.0, id.index)); for type_id in aggregate_ids { @@ -307,7 +307,9 @@ pub(super) fn type_layout( &function_types, module.span, )?; - let control_layout = Some(control::append(&mut representations, function_slot)); + let uses_control = module.types.iter().any(|ty| matches!(ty, + Type::Constructor(TypeConstructor::User(id)) if *id == HirTypeId::CONTROL || *id == HirTypeId::RESUMPTION)); + let control_layout = uses_control.then(|| control::append(&mut representations, function_slot)); Ok(TypeLayout { function_slot, protocols, diff --git a/crates/psrs-backend/src/cc/layout/protocols.rs b/crates/psrs-backend/src/cc/layout/protocols.rs index 8f8f5a64..fdf53f86 100644 --- a/crates/psrs-backend/src/cc/layout/protocols.rs +++ b/crates/psrs-backend/src/cc/layout/protocols.rs @@ -14,19 +14,10 @@ pub(super) fn append(table: &mut RepresentationTable) { .representations .iter() .any(|representation| matches!(representation, Representation::Array { .. })); - if has_array - && !table.representations.iter().any(|representation| - matches!(representation, Representation::Array { element } if *element == erased)) - { - let id = table.reserve(); - table.set(id, Representation::Array { element: erased }); - } - // Text codecs use a private integer buffer. Source arrays use erased slots; - // codec conversion explicitly crosses this value-producing boundary. - if has_array && !table.representations.iter().any(|representation| - matches!(representation, Representation::Array { element } if *element == ValueShape::Integer)) { - let id = table.reserve(); - table.set(id, Representation::Array { element: ValueShape::Integer }); + if has_array { + array(table, erased); + // Text codecs explicitly cross from source slots to integer buffers. + array(table, ValueShape::Integer); } let labels = table .product_labels @@ -64,3 +55,15 @@ pub(crate) fn record(table: &RepresentationTable, labels: &[String]) -> Option ReprId { + if let Some(index) = table.representations.iter().position(|representation| { + matches!(representation, Representation::Array { element: existing } if *existing == element) + }) { + return ReprId(index as u32); + } + let id = table.reserve(); + table.set(id, Representation::Array { element }); + id +} diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs index 5dc00193..bd4b471a 100644 --- a/crates/psrs-backend/src/cc/lower/control/builder.rs +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -16,6 +16,7 @@ pub(super) struct Machine<'a> { pub functions: ControlFunctions, pub span: TextRange, pub open: Option<(ValueId, ValueId)>, + pub boundary: Option, } pub(super) fn repr(id: ReprId) -> ValueShape { @@ -42,6 +43,7 @@ impl<'a> Machine<'a> { functions, span, open: None, + boundary: None, } } @@ -199,12 +201,26 @@ impl<'a> Machine<'a> { let (function, arguments) = if let Some((project, inject)) = self.open { ( self.functions.open_executor, - vec![state, handler, computation, sequence, project, inject], + vec![ + state, + handler, + computation, + sequence, + project, + inject, + self.boundary.unwrap(), + ], ) } else { ( self.functions.executor, - vec![state, handler, computation, sequence], + vec![ + state, + handler, + computation, + sequence, + self.boundary.unwrap(), + ], ) }; self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index 210ac5ef..808e93a2 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -17,6 +17,9 @@ impl Machine<'_> { self.open = Some((project, inject)); parameters.extend([project, inject]); } + let boundary = self.lower.fresh(erased_shape()); + self.boundary = Some(boundary); + parameters.push(boundary); let mut cases = Vec::new(); let mut body = Vec::new(); @@ -43,27 +46,23 @@ impl Machine<'_> { let mut body = Vec::new(); let value = self.field(computation, self.layout.computation, 3, 0, &mut body); let saved = self.field(computation, self.layout.computation, 3, 1, &mut body); + let captured_boundary = self.field(computation, self.layout.computation, 3, 2, &mut body); + self.check_boundary(captured_boundary, &mut body); let pending = self.node(self.layout.sequence, 2, vec![saved, sequence], &mut body); let next = self.node(self.layout.computation, 0, vec![value], &mut body); let result = self.recur(state, handler, next, pending, &mut body); cases.push(arm(3, body, result)); let mut body = Vec::new(); - let inner_state = self.field(computation, self.layout.computation, 4, 0, &mut body); - let inner_handler = self.field(computation, self.layout.computation, 4, 1, &mut body); - let project = self.field(computation, self.layout.computation, 4, 2, &mut body); - let inject = self.field(computation, self.layout.computation, 4, 3, &mut body); - let inner = self.field(computation, self.layout.computation, 4, 4, &mut body); - let empty = self.node(self.layout.sequence, 0, vec![], &mut body); - let function = self.functions.open_executor; - let next = self.emit(erased_shape(), &mut body, |_| { - crate::cc::AssignmentKind::DirectCall { - function, - arguments: vec![inner_state, inner_handler, inner, empty, project, inject], - } - }); - let result = self.recur(state, handler, next, sequence, &mut body); + let result = self.enter_handle(state, handler, computation, sequence, 4, &mut body); cases.push(arm(4, body, result)); + let mut body = Vec::new(); + let result = self.enter_handle(state, handler, computation, sequence, 5, &mut body); + cases.push(arm(5, body, result)); + + let mut body = Vec::new(); + let result = self.consume_owned(state, handler, computation, sequence, &mut body); + cases.push(arm(6, body, result)); let mut body = Vec::new(); let result = self.switch(computation, self.layout.computation, cases, &mut body); @@ -98,6 +97,7 @@ impl Machine<'_> { let mut branch = Vec::new(); let pair = self.pair(state, value, &mut branch); let result = if self.open.is_some() { + self.close_boundary(self.boundary.unwrap(), &mut branch); self.node(self.layout.computation, 0, vec![pair], &mut branch) } else { pair diff --git a/crates/psrs-backend/src/cc/lower/control/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/lifetime.rs new file mode 100644 index 00000000..b69adb7a --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/lifetime.rs @@ -0,0 +1,237 @@ +//! Mutable status cells are private; frame payloads and sequences stay immutable. + +use super::builder::{Machine, repr}; +use super::executor::arm; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, AssignmentKind, Function, TagCase, ValueId, ValueShape}; + +impl Machine<'_> { + pub(super) fn integer(&mut self, n: i32, body: &mut Vec) -> ValueId { + self.emit(ValueShape::Integer, body, |_| AssignmentKind::Constant(n)) + } + + pub(super) fn new_cell( + &mut self, + representation: crate::cc::ReprId, + value: ValueId, + body: &mut Vec, + ) -> ValueId { + let cell = self.emit(repr(representation), body, |destination| { + AssignmentKind::ArrayNew { + destination, + representation, + elements: vec![value], + } + }); + self.cast(cell, erased_shape(), body) + } + + pub(super) fn read_cell( + &mut self, + representation: crate::cc::ReprId, + shape: ValueShape, + cell: ValueId, + body: &mut Vec, + ) -> ValueId { + let cell = self.cast(cell, repr(representation), body); + let index = self.integer(0, body); + self.emit(shape, body, |destination| AssignmentKind::ArrayGet { + destination, + representation, + value: cell, + index, + }) + } + + pub(super) fn write_cell( + &mut self, + representation: crate::cc::ReprId, + cell: ValueId, + new_value: ValueId, + body: &mut Vec, + ) { + let cell = self.cast(cell, repr(representation), body); + let index = self.integer(0, body); + body.push(Assignment { + destination: cell, + kind: AssignmentKind::ArraySet { + destination: cell, + representation, + value: cell, + index, + new_value, + }, + span: self.span, + }); + } + + pub(super) fn new_status(&mut self, body: &mut Vec) -> ValueId { + let zero = self.integer(0, body); + self.new_cell(self.layout.status, zero, body) + } + + pub(super) fn status(&mut self, cell: ValueId, body: &mut Vec) -> ValueId { + self.read_cell(self.layout.status, ValueShape::Integer, cell, body) + } + + pub(super) fn set_status(&mut self, cell: ValueId, n: i32, body: &mut Vec) { + let new_value = self.integer(n, body); + self.write_cell(self.layout.status, cell, new_value, body); + } + + pub(super) fn guard_pending(&mut self, cell: ValueId, body: &mut Vec) { + let status = self.status(cell, body); + self.select(status, vec![arm(0, vec![], cell)], body); + } + + pub(super) fn select( + &mut self, + value: ValueId, + cases: Vec, + body: &mut Vec, + ) -> ValueId { + let trap = self.lower.fresh(erased_shape()); + let default_assignments = vec![Assignment { + destination: trap, + kind: AssignmentKind::Unreachable, + span: self.span, + }]; + self.emit(erased_shape(), body, |_| AssignmentKind::TagSwitch { + value, + cases, + default_assignments, + default_value: trap, + }) + } + + pub(super) fn new_boundary( + &mut self, + parent: Option, + body: &mut Vec, + ) -> ValueId { + let cell = self.new_status(body); + let (case, fields) = match parent { + Some(parent) => (1, vec![cell, parent]), + None => (0, vec![cell]), + }; + self.node(self.layout.boundary, case, fields, body) + } + + pub(super) fn check_boundary( + &mut self, + boundary: ValueId, + body: &mut Vec, + ) -> ValueId { + let function = self.functions.check; + self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { + function, + arguments: vec![boundary], + }) + } + + pub(super) fn close_boundary( + &mut self, + boundary: ValueId, + body: &mut Vec, + ) -> ValueId { + let function = self.functions.close; + self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { + function, + arguments: vec![boundary], + }) + } + + pub(super) fn start_boundary(mut self) -> Function { + let mut body = Vec::new(); + let result = self.new_boundary(None, &mut body); + let symbol = self.functions.start; + self.finish(symbol, "control_start_boundary", vec![], body, result) + } + + pub(super) fn boundary_check(mut self) -> Function { + let boundary = self.lower.fresh(erased_shape()); + let mut cases = Vec::new(); + for case in 0..2 { + let mut branch = Vec::new(); + let cell = self.field(boundary, self.layout.boundary, case, 0, &mut branch); + self.guard_pending(cell, &mut branch); + let result = if case == 0 { + boundary + } else { + let parent = self.field(boundary, self.layout.boundary, case, 1, &mut branch); + self.check_boundary(parent, &mut branch) + }; + cases.push(arm(case as i32, branch, result)); + } + let mut body = Vec::new(); + let result = self.switch(boundary, self.layout.boundary, cases, &mut body); + let symbol = self.functions.check; + self.finish( + symbol, + "control_check_boundary", + vec![boundary], + body, + result, + ) + } + + pub(super) fn boundary_close(mut self) -> Function { + let boundary = self.lower.fresh(erased_shape()); + let mut cases = Vec::new(); + for case in 0..2 { + let mut branch = Vec::new(); + let cell = self.field(boundary, self.layout.boundary, case, 0, &mut branch); + self.set_status(cell, 1, &mut branch); + cases.push(arm(case as i32, branch, boundary)); + } + let mut body = Vec::new(); + let result = self.switch(boundary, self.layout.boundary, cases, &mut body); + let symbol = self.functions.close; + self.finish( + symbol, + "control_close_boundary", + vec![boundary], + body, + result, + ) + } + + pub(super) fn enter_handle( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + case: u32, + body: &mut Vec, + ) -> ValueId { + let inner_state = self.field(computation, self.layout.computation, case, 0, body); + let inner_handler = self.field(computation, self.layout.computation, case, 1, body); + let project = self.field(computation, self.layout.computation, case, 2, body); + let inject = self.field(computation, self.layout.computation, case, 3, body); + let inner = self.field(computation, self.layout.computation, case, 4, body); + let boundary = if case == 4 { + self.new_boundary(self.boundary, body) + } else { + let boundary = self.field(computation, self.layout.computation, case, 5, body); + self.check_boundary(boundary, body); + let parent = self.field(boundary, self.layout.boundary, 1, 1, body); + self.new_boundary(Some(parent), body) + }; + let empty = self.node(self.layout.sequence, 0, vec![], body); + let function = self.functions.open_executor; + let next = self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { + function, + arguments: vec![ + inner_state, + inner_handler, + inner, + empty, + project, + inject, + boundary, + ], + }); + self.recur(state, handler, next, sequence, body) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index ffe94e34..dcff2395 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -11,7 +11,9 @@ use psrs_span::TextRange; mod builder; mod executor; +mod lifetime; mod open; +mod owned; use builder::Machine; #[derive(Clone, Copy)] @@ -22,6 +24,11 @@ pub(in crate::cc) struct ControlFunctions { forward: SymbolId, project_left: SymbolId, project_right: SymbolId, + start: SymbolId, + check: SymbolId, + close: SymbolId, + once: SymbolId, + cancel: SymbolId, } impl FunctionLowerer<'_> { @@ -43,15 +50,68 @@ impl FunctionLowerer<'_> { .iter() .map(|argument| self.lower_array_element(argument, assignments)) .collect::, _>>()?; + if matches!(intrinsic, Intrinsic::ControlOnce | Intrinsic::ControlCancel) { + let functions = self.ensure_control_functions(layout, expression.span)?; + let function = if intrinsic == Intrinsic::ControlOnce { + functions.once + } else { + functions.cancel + }; + let result = self.fresh(erased_shape()); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::DirectCall { + function, + arguments: fields, + }, + span: expression.span, + }); + if intrinsic == Intrinsic::ControlCancel { + let unit = self.fresh(ty); + assignments.push(Assignment { + destination: unit, + kind: AssignmentKind::Constant(0), + span: expression.span, + }); + return Ok(unit); + } + let conversion = self.recover_payload(ty, expression.span)?; + return Ok(self.emit_conversion( + result, + erased_shape(), + ty, + conversion, + expression.span, + assignments, + )); + } if intrinsic == Intrinsic::ControlRun { let functions = self.ensure_control_functions(layout, expression.span)?; let empty = self.control_empty_sequence(layout, expression.span, assignments); + let boundary = self.fresh(erased_shape()); + assignments.push(Assignment { + destination: boundary, + kind: AssignmentKind::DirectCall { + function: functions.start, + arguments: vec![], + }, + span: expression.span, + }); let result = self.fresh(erased_shape()); assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { function: functions.executor, - arguments: vec![fields[0], fields[1], fields[2], empty], + arguments: vec![fields[0], fields[1], fields[2], empty, boundary], + }, + span: expression.span, + }); + let closed = self.fresh(erased_shape()); + assignments.push(Assignment { + destination: closed, + kind: AssignmentKind::DirectCall { + function: functions.close, + arguments: vec![boundary], }, span: expression.span, }); @@ -70,6 +130,7 @@ impl FunctionLowerer<'_> { Intrinsic::ControlPerform => 1, Intrinsic::ControlBind => 2, Intrinsic::ControlHandle => 4, + Intrinsic::ControlResume => 6, _ => return Err(control_error(expression.span, "not a control primitive")), }; let destination = self.fresh(ty); @@ -131,6 +192,11 @@ impl FunctionLowerer<'_> { forward: symbols.fresh(self.owner), project_left: symbols.fresh(self.owner), project_right: symbols.fresh(self.owner), + start: symbols.fresh(self.owner), + check: symbols.fresh(self.owner), + close: symbols.fresh(self.owner), + once: symbols.fresh(self.owner), + cancel: symbols.fresh(self.owner), } }; let signature = self @@ -151,12 +217,40 @@ impl FunctionLowerer<'_> { self.generated_signatures .borrow_mut() .insert(functions.open_executor, open_signature); + for (symbol, id) in [ + (functions.start, layout.start), + (functions.check, layout.boundary_check), + (functions.close, layout.boundary_check), + (functions.once, layout.boundary_check), + (functions.cancel, layout.boundary_check), + ] { + let signature = self + .representations + .signature(id) + .ok_or_else(|| { + control_error( + span, + "control lifetime function has no predeclared signature", + ) + })? + .clone(); + self.generated_signatures + .borrow_mut() + .insert(symbol, signature); + } let mut resume = Machine::new(self.child_lowerer(), layout, functions, span); let receiver = resume.lower.fresh(super::lambda::closure_value_type()); let value = resume.lower.fresh(erased_shape()); let mut assignments = Vec::new(); let saved = resume.capture(receiver, 0, &mut assignments); - let result = resume.node(layout.computation, 3, vec![value, saved], &mut assignments); + let boundary = resume.capture(receiver, 1, &mut assignments); + resume.check_boundary(boundary, &mut assignments); + let result = resume.node( + layout.computation, + 3, + vec![value, saved, boundary], + &mut assignments, + ); let resume = resume.finish( functions.resume, "control_resume", @@ -181,6 +275,16 @@ impl FunctionLowerer<'_> { self.verify_synthesized(&selector)?; self.generated.push(selector); } + for function in [ + Machine::new(self.child_lowerer(), layout, functions, span).start_boundary(), + Machine::new(self.child_lowerer(), layout, functions, span).boundary_check(), + Machine::new(self.child_lowerer(), layout, functions, span).boundary_close(), + Machine::new(self.child_lowerer(), layout, functions, span).owned(), + Machine::new(self.child_lowerer(), layout, functions, span).cancel(), + ] { + self.verify_synthesized(&function)?; + self.generated.push(function); + } *self.control_functions.borrow_mut() = Some(functions); Ok(functions) } diff --git a/crates/psrs-backend/src/cc/lower/control/open.rs b/crates/psrs-backend/src/cc/lower/control/open.rs index 4dc00323..9455fb15 100644 --- a/crates/psrs-backend/src/cc/lower/control/open.rs +++ b/crates/psrs-backend/src/cc/lower/control/open.rs @@ -43,7 +43,14 @@ impl Machine<'_> { let continuation = self.closure( self.functions.forward, self.layout.continuation, - vec![state, handler, project, inject, sequence], + vec![ + state, + handler, + project, + inject, + sequence, + self.boundary.unwrap(), + ], &mut branch, ); let result = self.node( @@ -72,7 +79,7 @@ impl Machine<'_> { let continuation = self.closure( self.functions.resume, self.layout.continuation, - vec![sequence], + vec![sequence, self.boundary.unwrap()], body, ); let pair = self.apply(handler, &[state, request, continuation], body); @@ -91,9 +98,17 @@ impl Machine<'_> { .map(|index| self.capture(receiver, index, &mut body)) .collect::>(); let saved = self.capture(receiver, 4, &mut body); - let resumed = self.node(self.layout.computation, 3, vec![value, saved], &mut body); + let boundary = self.capture(receiver, 5, &mut body); + self.check_boundary(boundary, &mut body); + let resumed = self.node( + self.layout.computation, + 3, + vec![value, saved, boundary], + &mut body, + ); fields.push(resumed); - let result = self.node(self.layout.computation, 4, fields, &mut body); + fields.push(boundary); + let result = self.node(self.layout.computation, 5, fields, &mut body); let symbol = self.functions.forward; self.finish( symbol, diff --git a/crates/psrs-backend/src/cc/lower/control/owned.rs b/crates/psrs-backend/src/cc/lower/control/owned.rs new file mode 100644 index 00000000..15cbcfa8 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/owned.rs @@ -0,0 +1,54 @@ +//! One-shot ownership is consumed at interpretation, before invoking user code. + +use super::builder::Machine; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, Function, ValueId}; + +impl Machine<'_> { + pub(super) fn owned(mut self) -> Function { + let continuation = self.lower.fresh(erased_shape()); + let mut body = Vec::new(); + let callback = self.new_cell(self.layout.callback, continuation, &mut body); + let status = self.new_status(&mut body); + let result = self.node(self.layout.owner, 0, vec![callback, status], &mut body); + let symbol = self.functions.once; + self.finish(symbol, "control_once", vec![continuation], body, result) + } + + pub(super) fn cancel(mut self) -> Function { + let owner = self.lower.fresh(erased_shape()); + let mut body = Vec::new(); + let status = self.field(owner, self.layout.owner, 0, 1, &mut body); + self.guard_pending(status, &mut body); + self.set_status(status, 3, &mut body); + let callback = self.field(owner, self.layout.owner, 0, 0, &mut body); + self.write_cell(self.layout.callback, callback, status, &mut body); + let symbol = self.functions.cancel; + self.finish(symbol, "control_cancel", vec![owner], body, owner) + } + + pub(super) fn consume_owned( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let owner = self.field(computation, self.layout.computation, 6, 0, body); + let value = self.field(computation, self.layout.computation, 6, 1, body); + let callback = self.field(owner, self.layout.owner, 0, 0, body); + let status = self.field(owner, self.layout.owner, 0, 1, body); + self.guard_pending(status, body); + // No guest callback runs between this check and transition. The pinned + // guest profile is single-threaded; re-entrant callbacks see Running. + self.set_status(status, 1, body); + let continuation = self.read_cell(self.layout.callback, erased_shape(), callback, body); + // The local invocation roots the callback; a retained consumed owner + // must no longer root its captures. + self.write_cell(self.layout.callback, callback, status, body); + let next = self.apply(continuation, &[value], body); + self.set_status(status, 2, body); + self.recur(state, handler, next, sequence, body) + } +} diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 50aa2555..54f8884a 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -305,6 +305,7 @@ pub(crate) fn lower_module_with_relations( // its frame representation, and its shape is the erased aggregate reference // so this slice needs no `scalar_type` change. aggregate_types.insert(HirTypeId::CONTROL); + aggregate_types.insert(HirTypeId::RESUMPTION); let layout = type_layout(&module, &enum_types, &aggregate_types, &newtype_ids)?; let mut constructor_tags = HashMap::new(); let mut constructors_by_type: HashMap> = HashMap::new(); diff --git a/crates/psrs-backend/src/target_intrinsics/mod.rs b/crates/psrs-backend/src/target_intrinsics/mod.rs index 5da73998..06374258 100644 --- a/crates/psrs-backend/src/target_intrinsics/mod.rs +++ b/crates/psrs-backend/src/target_intrinsics/mod.rs @@ -121,14 +121,15 @@ pub(crate) fn implementation(intrinsic: Intrinsic) -> Implementation { Elaborated } Intrinsic::Undefined => Unsupported, - // The delimited-control primitives have no target implementation until - // the selective-CPS/resumable-frame lowering lands; they are reported as - // unsupported rather than lowered as a placeholder. + // Control primitives lower to guest frames and generated drivers. Intrinsic::ControlReturn | Intrinsic::ControlBind | Intrinsic::ControlPerform | Intrinsic::ControlRun - | Intrinsic::ControlHandle => Control, + | Intrinsic::ControlHandle + | Intrinsic::ControlOnce + | Intrinsic::ControlResume + | Intrinsic::ControlCancel => Control, } } diff --git a/crates/psrs-backend/src/target_intrinsics/tests.rs b/crates/psrs-backend/src/target_intrinsics/tests.rs index c5f1a524..9d5fe352 100644 --- a/crates/psrs-backend/src/target_intrinsics/tests.rs +++ b/crates/psrs-backend/src/target_intrinsics/tests.rs @@ -27,6 +27,9 @@ fn every_active_identity_has_an_explicit_implementation() { | Intrinsic::ControlPerform | Intrinsic::ControlRun | Intrinsic::ControlHandle + | Intrinsic::ControlOnce + | Intrinsic::ControlResume + | Intrinsic::ControlCancel )); } Implementation::Generated(_) | Implementation::Elaborated => {} diff --git a/crates/psrs-driver/tests/control_lifetime.rs b/crates/psrs-driver/tests/control_lifetime.rs new file mode 100644 index 00000000..058b399a --- /dev/null +++ b/crates/psrs-driver/tests/control_lifetime.rs @@ -0,0 +1,109 @@ +//! Delimiter lifetime checks through escaped, ordinarily typed resumptions. +mod control_support; +use control_support::execute; + +const ESCAPED: &str = r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. { saved :: Int -> C.Control Op Int } -> Op x -> (x -> C.Control Op Int) -> { _1 :: { saved :: Int -> C.Control Op Int }, _2 :: C.Control Op Int } +handler s (Op k) cont = { _1: { saved: \n -> cont (k n) }, _2: C.return 42 } +result = C.run { saved: \n -> C.return n } handler (C.perform (Op \x -> x)) +main :: Int +main = (C.run result._1 handler (result._1.saved 42))._2 +"#; + +#[test] +fn rejects_a_resumption_after_its_closed_delimiter_returns() { + execute("expired-closed", ESCAPED, 134); +} + +#[test] +fn rejects_a_resume_node_built_before_the_delimiter_expired() { + execute( + "expired-prebuilt", + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. { saved :: C.Control Op Int } -> Op x -> (x -> C.Control Op Int) -> { _1 :: { saved :: C.Control Op Int }, _2 :: C.Control Op Int } +handler s (Op k) cont = { _1: { saved: cont (k 42) }, _2: C.return 0 } +result = C.run { saved: C.return 0 } handler (C.perform (Op \x -> x)) +main :: Int +main = (C.run result._1 handler result._1.saved)._2 +"#, + 134, + ); +} + +#[test] +fn a_live_multi_shot_resumption_can_be_interpreted_reentrantly() { + execute( + "live-reentrant", + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler s (Op k) cont = let nested = C.run s handler (cont (k 42)) in { _1: nested._1, _2: C.return nested._2 } +main :: Int +main = (C.run 0 handler (C.perform (Op \x -> x)))._2 +"#, + 42, + ); +} + +const OPEN: &str = r#"module Main where +import Prim.Control as C +data F next = F (Int -> next) +data G next = G (Int -> next) +data U next = UF (F next) | UG (G next) +type Saved = { saved :: Int -> C.Control U Int } +project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r +project u l r = case u of + UF f -> l f + UG g -> r g +inner :: forall x. Saved -> F x -> (x -> C.Control U Int) -> { _1 :: Saved, _2 :: C.Control U Int } +inner s (F k) cont = { _1: { saved: \n -> cont (k n) }, _2: C.return 42 } +outer :: forall x. Int -> G x -> (x -> C.Control G { _1 :: Saved, _2 :: Int }) -> { _1 :: Int, _2 :: C.Control G { _1 :: Saved, _2 :: Int } } +outer s (G k) cont = { _1: s, _2: cont (k 0) } +handled = C.handle { saved: \n -> C.return n } inner project UG (C.perform (UF (F \x -> x))) +result = C.run 0 outer handled +main :: Int +main = result._2._2 +"#; + +#[test] +fn rejects_a_completed_open_delimiter_while_its_outer_delimiter_is_live() { + let text = OPEN.replace("result = C.run 0 outer handled", r"result = C.run 0 outer (C.bind handled (\pair -> C.handle pair._1 inner project UG (pair._1.saved 42)))"); + execute("expired-open-live-outer", &text, 134); +} + +#[test] +fn rejects_an_open_resumption_after_the_outer_run_returns() { + let text = OPEN.replace("main = result._2._2", "main = (C.run 0 outer (C.handle result._2._1 inner project UG (result._2._1.saved 42)))._2._2"); + execute("expired-open", &text, 134); +} + +#[test] +fn outer_abandonment_expires_a_suspended_inner_delimiter() { + execute( + "expired-abandoned-open", + r#"module Main where +import Prim.Control as C +data F x = F (Int -> x) +data G x = G (Int -> C.Control U Int) (Int -> x) +data U x = UF (F x) | UG (G x) +type Saved = { saved :: Int -> C.Control U Int } +project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r +project u l r = case u of + UF f -> l f + UG g -> r g +inner :: forall x. Int -> F x -> (x -> C.Control U Int) -> { _1 :: Int, _2 :: C.Control U Int } +inner s (F k) cont = { _1: s, _2: C.perform (UG (G (\n -> cont (k n)) (\x -> x))) } +outer :: forall x. Saved -> G x -> (x -> C.Control G { _1 :: Int, _2 :: Int }) -> { _1 :: Saved, _2 :: C.Control G { _1 :: Int, _2 :: Int } } +outer s (G saved k) cont = { _1: { saved: saved }, _2: C.return { _1: 0, _2: 42 } } +result = C.run { saved: \n -> C.return n } outer (C.handle 0 inner project UG (C.perform (UF (F \x -> x)))) +main :: Int +main = (C.run result._1 outer (C.handle 0 inner project UG (result._1.saved 42)))._2._2 +"#, + 134, + ); +} diff --git a/crates/psrs-driver/tests/control_owned_runtime.rs b/crates/psrs-driver/tests/control_owned_runtime.rs new file mode 100644 index 00000000..11e55015 --- /dev/null +++ b/crates/psrs-driver/tests/control_owned_runtime.rs @@ -0,0 +1,171 @@ +//! Runtime consumption of one-shot owners; construction remains inert. +mod control_support; +use control_support::execute; + +fn source(body: &str) -> String { + let body = body.replace("; ", " in let "); + format!( + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> {{ _1 :: Int, _2 :: C.Control Op Int }} +handler s (Op k) cont = {{ _1: s, _2: cont (k s) }} +main :: Int +main = {body} +"# + ) +} + +#[test] +fn a_one_shot_owner_runs_once() { + execute( + "owned-once", + &source( + r"let owner = C.once (\n -> C.return (intAdd n 2)) in (C.run 0 handler (C.resume owner 40))._2", + ), + 42, + ); +} + +#[test] +fn building_an_unused_resume_does_not_consume_ownership() { + execute( + "owned-inert", + &source( + r"let owner = C.once (\n -> C.return n); unused = C.resume owner 7 in (C.run 0 handler (C.resume owner 42))._2", + ), + 42, + ); +} + +#[test] +fn executing_two_resume_nodes_rejects_the_second() { + execute( + "owned-double", + &source( + r"let owner = C.once (\n -> C.return n) in (C.run 0 handler (C.bind (C.resume owner 19) (\a -> C.bind (C.resume owner 23) (\b -> C.return (intAdd a b)))))._2", + ), + 134, + ); +} + +#[test] +fn repeating_the_same_resume_node_rejects_reinterpretation() { + execute( + "owned-repeat", + &source( + r"let owner = C.once (\n -> C.return n); program = C.resume owner 21; first = C.run 0 handler program; second = C.run 0 handler program in intAdd first._2 second._2", + ), + 134, + ); +} + +#[test] +fn cancelling_a_pending_owner_rejects_resume() { + execute( + "owned-cancel", + &source( + r"let owner = C.once (\n -> C.return n); cancelled = C.cancel owner in (C.run 0 handler (C.resume owner 42))._2", + ), + 134, + ); +} + +#[test] +fn cancellation_is_single_use() { + execute( + "owned-cancel-twice", + &source( + r"let owner = C.once (\n -> C.return n); first = C.cancel owner; second = C.cancel owner in 42", + ), + 134, + ); +} + +#[test] +fn a_consumed_owner_cannot_be_cancelled() { + execute( + "owned-cancel-consumed", + &source( + r"let owner = C.once (\n -> C.return n); first = C.run 0 handler (C.resume owner 42); cancelled = C.cancel owner in first._2", + ), + 134, + ); +} + +#[test] +fn resume_factory_arguments_are_strict() { + execute( + "owned-strict", + &source( + r"let owner = C.once (\n -> C.return n); unused = C.resume owner (intQuot 1 0) in 42", + ), + 134, + ); +} + +#[test] +fn reentrant_interpretation_rejects_a_running_owner() { + execute( + "owned-reentrant", + &source( + r"let holder = [C.once (\n -> C.return n)]; owner = C.once (\n -> let nested = C.run 0 handler (C.resume (arrayIndex holder 0) n) in C.return nested._2); written = arrayWrite holder 0 owner in (C.run 0 handler (C.resume owner 42))._2", + ), + 134, + ); +} + +#[test] +fn reentrant_cancellation_rejects_a_running_owner() { + execute( + "owned-reentrant-cancel", + &source( + r"let holder = [C.once (\n -> C.return n)]; owner = C.once (\n -> let cancelled = C.cancel (arrayIndex holder 0) in C.return n); written = arrayWrite holder 0 owner in (C.run 0 handler (C.resume owner 42))._2", + ), + 134, + ); +} + +#[test] +fn separate_owners_do_not_share_consumption_state() { + execute( + "owned-independent", + &source( + r"let first = C.once (\n -> C.return n); second = C.once (\n -> C.return n) in (C.run 0 handler (C.bind (C.resume first 19) (\a -> C.bind (C.resume second 23) (\b -> C.return (intAdd a b)))))._2", + ), + 42, + ); +} + +#[test] +fn an_ignored_one_shot_interpretation_keeps_its_callback_trap() { + execute( + "owned-ignored", + &source( + r"let owner = C.once (\_ -> C.return (intQuot 1 0)); unused = C.run 0 handler (C.resume owner 42) in 42", + ), + 134, + ); +} + +#[test] +fn an_abandoned_resume_node_does_not_consume_its_owner() { + execute( + "owned-abandoned", + &source( + r"let owner = C.once (\n -> C.return n); program = C.bind (C.perform (Op \x -> x)) (\_ -> C.resume owner 7); skipped = C.run 0 (\s op cont -> { _1: s, _2: C.return 0 }) program in intAdd skipped._2 (C.run 0 handler (C.resume owner 42))._2", + ), + 42, + ); +} + +#[test] +fn collection_preserves_a_pending_one_shot_owners_captures() { + let mut text = source( + r"let saved = { offset: 2 }; owner = C.once (\n -> C.return (intAdd n saved.offset)); churn = C.run 0 handler (noise 5000) in if intEq churn._2 0 then (C.run 0 handler (C.resume owner 40))._2 else 1", + ); + text.push_str(r" +noise :: Int -> C.Control Op Int +noise n = if intEq n 0 then C.return 0 else C.bind (C.perform (Op \x -> x)) (\_ -> noise (intSub n 1))"); + control_support::execute_with_gc("owned-gc", &text, 42); +} diff --git a/crates/psrs-driver/tests/control_owned_surface.rs b/crates/psrs-driver/tests/control_owned_surface.rs new file mode 100644 index 00000000..da4ab256 --- /dev/null +++ b/crates/psrs-driver/tests/control_owned_surface.rs @@ -0,0 +1,67 @@ +//! Nominal one-shot ownership keeps input, output and functor identities checked. +fn source(declarations: &str) -> String { + format!( + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +data Other next = Other (Int -> next) +owner :: C.Resumption Op Int Int +owner = C.once (\n -> C.return n) +{declarations} +"# + ) +} + +#[test] +fn accepts_the_owned_surface() { + psrs_driver::check_source("Main.purs", &source("program :: C.Control Op Int\nprogram = C.resume owner 42\ncancelled :: Unit\ncancelled = C.cancel owner")).unwrap(); +} + +#[test] +fn rejects_a_wrong_resume_argument() { + assert!(psrs_driver::check_source("Main.purs", &source("bad = C.resume owner true")).is_err()); +} + +#[test] +fn rejects_a_wrong_resume_result() { + assert!( + psrs_driver::check_source( + "Main.purs", + &source("bad :: C.Control Op Boolean\nbad = C.resume owner 42") + ) + .is_err() + ); +} + +#[test] +fn rejects_a_wrong_resume_functor() { + assert!( + psrs_driver::check_source( + "Main.purs", + &source("bad :: C.Control Other Int\nbad = C.resume owner 42") + ) + .is_err() + ); +} + +#[test] +fn rejects_cancellation_of_an_unrestricted_function() { + assert!( + psrs_driver::check_source("Main.purs", &source("bad = C.cancel (\\n -> C.return n)")) + .is_err() + ); +} + +#[test] +fn nominal_ownership_rejects_answer_coercion() { + let text = source( + "newtype Answer = Answer Int\nbad :: C.Resumption Op Answer Int\nbad = coerce owner", + ) + .replace( + "import Prim.Control as C", + "import Prim.Control as C\nimport Safe.Coerce (coerce)", + ); + let identity = text.replace("C.Resumption Op Answer Int", "C.Resumption Op Int Int"); + psrs_driver::check_source("Main.purs", &identity).unwrap(); + assert!(psrs_driver::check_source("Main.purs", &text).is_err()); +} diff --git a/crates/psrs-driver/tests/control_primitive_values.rs b/crates/psrs-driver/tests/control_primitive_values.rs new file mode 100644 index 00000000..147c64c0 --- /dev/null +++ b/crates/psrs-driver/tests/control_primitive_values.rs @@ -0,0 +1,58 @@ +//! Checked compiler primitives used as ordinary values and partial applications. + +mod control_support; +use control_support::execute; + +#[test] +fn aliases_preserve_control_and_scalar_primitive_semantics() { + execute( + "primitive-aliases", + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +pure :: forall f a. a -> C.Control f a +pure = C.return +bind :: forall f a b. C.Control f a -> (a -> C.Control f b) -> C.Control f b +bind = C.bind +perform :: forall f a. f a -> C.Control f a +perform = C.perform +run :: forall f a s. s -> (forall x. s -> f x -> (x -> C.Control f a) -> { _1 :: s, _2 :: C.Control f a }) -> C.Control f a -> { _1 :: s, _2 :: a } +run = C.run +once :: forall f a b. (a -> C.Control f b) -> C.Resumption f a b +once = C.once +resume :: forall f a b. C.Resumption f a b -> a -> C.Control f b +resume = C.resume +add :: Int -> Int -> Int +add = intAdd +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler s (Op k) cont = { _1: s, _2: resume (once cont) (k 41) } +program :: C.Control Op Int +program = bind (perform (Op \x -> x)) (\value -> pure (add value 1)) +main :: Int +main = (run 0 handler program)._2 +"#, + 42, + ); +} + +#[test] +fn partial_applications_keep_checked_argument_types() { + execute( + "primitive-partial", + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler s (Op k) cont = { _1: s, _2: cont (k 0) } +finish :: (Int -> C.Control Op Int) -> C.Control Op Int +finish = C.bind (C.return 41) +interpret :: C.Control Op Int -> { _1 :: Int, _2 :: Int } +interpret = C.run 0 handler +increment :: Int -> Int +increment = intAdd 1 +main :: Int +main = (interpret (finish (\value -> C.return (increment value))))._2 +"#, + 42, + ); +} diff --git a/crates/psrs-hir/src/compiler_interface.rs b/crates/psrs-hir/src/compiler_interface.rs index 6251f9db..77ea4ab7 100644 --- a/crates/psrs-hir/src/compiler_interface.rs +++ b/crates/psrs-hir/src/compiler_interface.rs @@ -39,7 +39,7 @@ pub const COMPILER_INTERFACES: &[CompilerInterface] = &[ types: &[], classes: &[("IsSymbol", CompilerClass::IsSymbol)], }, - // The effect-agnostic delimited-control surface. The carrier and the four + // The effect-agnostic delimited-control surface. The carrier and the control // primitives are compiler-owned; no pass recognizes a concrete operation. CompilerInterface { module: "Prim.Control", @@ -50,8 +50,14 @@ pub const COMPILER_INTERFACES: &[CompilerInterface] = &[ ("perform", Intrinsic::ControlPerform), ("run", Intrinsic::ControlRun), ("handle", Intrinsic::ControlHandle), + ("once", Intrinsic::ControlOnce), + ("resume", Intrinsic::ControlResume), + ("cancel", Intrinsic::ControlCancel), + ], + types: &[ + ("Control", TypeId::CONTROL), + ("Resumption", TypeId::RESUMPTION), ], - types: &[("Control", TypeId::CONTROL)], classes: &[], }, ]; diff --git a/crates/psrs-hir/src/intrinsic/effects.rs b/crates/psrs-hir/src/intrinsic/effects.rs index 6ad50369..60ba6260 100644 --- a/crates/psrs-hir/src/intrinsic/effects.rs +++ b/crates/psrs-hir/src/intrinsic/effects.rs @@ -11,7 +11,7 @@ impl IntrinsicEffects { pub(super) fn for_intrinsic(intrinsic: Intrinsic) -> Self { use Intrinsic::*; match intrinsic { - ArrayWrite => Self { + ArrayWrite | ControlCancel => Self { may_trap: true, may_write: true, }, @@ -40,7 +40,7 @@ impl IntrinsicEffects { | NumberAtan2 | NumberSin | NumberCos | NumberTan | NumberExp | NumberLog | NumberPow | NumberMin | NumberMax | NumberSign | NumberRemainder | NumberIsNaN | NumberNaN | NumberInfinity | ControlReturn | ControlBind | ControlPerform - | ControlHandle => Self::default(), + | ControlHandle | ControlOnce | ControlResume => Self::default(), } } } diff --git a/crates/psrs-hir/src/intrinsic/mod.rs b/crates/psrs-hir/src/intrinsic/mod.rs index 353069d6..7b6c8078 100644 --- a/crates/psrs-hir/src/intrinsic/mod.rs +++ b/crates/psrs-hir/src/intrinsic/mod.rs @@ -179,6 +179,12 @@ pub enum Intrinsic { /// operations of a computation over a combined effect `u` and leaves the /// rest as a residual `Control g (s, a)`. ControlHandle = 96, + /// Allocate opaque one-shot continuation ownership. + ControlOnce = 97, + /// Build an inert computation that consumes ownership at interpretation. + ControlResume = 98, + /// Cancel a pending one-shot owner. + ControlCancel = 99, } impl Intrinsic { @@ -206,7 +212,7 @@ impl Intrinsic { /// Every active variant, in discriminant order. Binding resolution uses the /// complete list. - pub const ALL: [Intrinsic; 90] = [ + pub const ALL: [Intrinsic; 93] = [ Intrinsic::BoolTrue, Intrinsic::BoolFalse, Intrinsic::IntAdd, @@ -297,6 +303,9 @@ impl Intrinsic { Intrinsic::ControlPerform, Intrinsic::ControlRun, Intrinsic::ControlHandle, + Intrinsic::ControlOnce, + Intrinsic::ControlResume, + Intrinsic::ControlCancel, ]; } @@ -305,7 +314,7 @@ impl Intrinsic { // cannot be added and silently left out of the bootstrap name table. const _: () = { assert!( - Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() == 97, + Intrinsic::ALL.len() + Intrinsic::RESERVED_IDS.len() == 100, "Intrinsic::ALL is out of date: update it when adding a variant", ); let mut seen: u128 = 0; diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index f5ded84b..34e8b8e9 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -180,403 +180,14 @@ descriptors! { ControlPerform => "controlPerform", 1, Control, scheme::control_perform; ControlRun => "controlRun", 3, Control, scheme::control_run; ControlHandle => "controlHandle", 5, Control, scheme::control_handle; + ControlOnce => "controlOnce", 1, Control, scheme::control_once; + ControlResume => "controlResume", 2, Control, scheme::control_resume; + ControlCancel => "controlCancel", 1, Control, scheme::control_cancel; } /// The HIR type schemes. Each returns a fresh [`Type`], so a caller that /// instantiates it at a use site gets its own type variables. -mod scheme { - use super::*; - - fn empty_span() -> TextRange { - TextRange::new(0, 0) - } - - fn builtin(builtin: BuiltinType) -> Type { - Type { - kind: TypeKind::Constructor(builtin), - span: empty_span(), - } - } - - fn named(id: TypeId) -> Type { - Type { - kind: TypeKind::Named(id), - span: empty_span(), - } - } - - fn variable(name: &str) -> Type { - Type { - kind: TypeKind::Variable(name.to_owned()), - span: empty_span(), - } - } - - fn apply(function: Type, argument: Type) -> Type { - Type { - kind: TypeKind::Application(Box::new(function), Box::new(argument)), - span: empty_span(), - } - } - - fn arrow(parameter: Type, result: Type) -> Type { - Type { - kind: TypeKind::Function { - parameter: Box::new(parameter), - result: Box::new(result), - }, - span: empty_span(), - } - } - - fn forall(names: &[&str], body: Type) -> Type { - Type { - kind: TypeKind::Forall { - variables: names - .iter() - .map(|name| TypeParameter { - name: (*name).to_owned(), - name_span: empty_span(), - kind: None, - }) - .collect(), - body: Box::new(body), - }, - span: empty_span(), - } - } - - fn array(element: Type) -> Type { - apply(builtin(BuiltinType::Array), element) - } - - fn int() -> Type { - builtin(BuiltinType::Int) - } - - fn scalar(operand: BuiltinType, result: BuiltinType) -> Type { - let operand = builtin(operand); - arrow(operand.clone(), arrow(operand, builtin(result))) - } - - fn unary(operand: BuiltinType, result: BuiltinType) -> Type { - arrow(builtin(operand), builtin(result)) - } - - pub(super) fn boolean() -> Type { - builtin(BuiltinType::Boolean) - } - - pub(super) fn unit() -> Type { - builtin(BuiltinType::Unit) - } - - pub(super) fn int_int_int() -> Type { - scalar(BuiltinType::Int, BuiltinType::Int) - } - - pub(super) fn int_int_bool() -> Type { - scalar(BuiltinType::Int, BuiltinType::Boolean) - } - - pub(super) fn number_number_number() -> Type { - scalar(BuiltinType::Number, BuiltinType::Number) - } - - pub(super) fn number_number_bool() -> Type { - scalar(BuiltinType::Number, BuiltinType::Boolean) - } - - pub(super) fn boolean_boolean_boolean() -> Type { - scalar(BuiltinType::Boolean, BuiltinType::Boolean) - } - - pub(super) fn char_char_bool() -> Type { - scalar(BuiltinType::Char, BuiltinType::Boolean) - } - - pub(super) fn int_int() -> Type { - unary(BuiltinType::Int, BuiltinType::Int) - } - - pub(super) fn number_number() -> Type { - unary(BuiltinType::Number, BuiltinType::Number) - } - - pub(super) fn number_bool() -> Type { - unary(BuiltinType::Number, BuiltinType::Boolean) - } - - pub(super) fn number() -> Type { - builtin(BuiltinType::Number) - } - - pub(super) fn boolean_boolean() -> Type { - unary(BuiltinType::Boolean, BuiltinType::Boolean) - } - - pub(super) fn int_number() -> Type { - unary(BuiltinType::Int, BuiltinType::Number) - } - - pub(super) fn string_number() -> Type { - unary(BuiltinType::String, BuiltinType::Number) - } - - pub(super) fn number_string() -> Type { - unary(BuiltinType::Number, BuiltinType::String) - } - - pub(super) fn number_int() -> Type { - unary(BuiltinType::Number, BuiltinType::Int) - } - - pub(super) fn boolean_int() -> Type { - unary(BuiltinType::Boolean, BuiltinType::Int) - } - - pub(super) fn int_boolean() -> Type { - unary(BuiltinType::Int, BuiltinType::Boolean) - } - - pub(super) fn char_int() -> Type { - unary(BuiltinType::Char, BuiltinType::Int) - } - - pub(super) fn int_char() -> Type { - unary(BuiltinType::Int, BuiltinType::Char) - } - - pub(super) fn array_length() -> Type { - forall(&["a"], arrow(array(variable("a")), int())) - } - - pub(super) fn array_index() -> Type { - forall( - &["a"], - arrow(array(variable("a")), arrow(int(), variable("a"))), - ) - } - - pub(super) fn array_update() -> Type { - forall( - &["a"], - arrow( - array(variable("a")), - arrow(int(), arrow(variable("a"), array(variable("a")))), - ), - ) - } - - pub(super) fn array_append() -> Type { - forall( - &["a"], - arrow( - array(variable("a")), - arrow(array(variable("a")), array(variable("a"))), - ), - ) - } - - pub(super) fn array_fill() -> Type { - forall( - &["a"], - arrow(int(), arrow(variable("a"), array(variable("a")))), - ) - } - - pub(super) fn string_to_bytes() -> Type { - arrow(builtin(BuiltinType::String), array(int())) - } - - pub(super) fn bytes_to_string() -> Type { - arrow(array(int()), builtin(BuiltinType::String)) - } - - pub(super) fn undefined() -> Type { - forall(&["a"], variable("a")) - } - - pub(super) fn coerce() -> Type { - let constraint = apply( - apply(named(TypeId::COERCIBLE), variable("a")), - variable("b"), - ); - Type { - kind: TypeKind::Constrained { - constraint: Box::new(constraint), - body: Box::new(arrow(variable("a"), variable("b"))), - }, - span: empty_span(), - } - } - - /// `Unsafe.Coerce.unsafeCoerce`: an unconstrained identity cast. It has no - /// `Coercible` proof; the value crosses its erased representation unchanged. - pub(super) fn unsafe_coerce() -> Type { - forall(&["a", "b"], arrow(variable("a"), variable("b"))) - } - - /// `Control f a`: a computation over the opaque request functor `f` that - /// yields an `a`, possibly after suspending at `perform`. - fn control(of: Type, value: Type) -> Type { - apply(apply(named(TypeId::CONTROL), of), value) - } - - /// `Prim.Control.return :: forall f a. a -> Control f a`. - pub(super) fn control_return() -> Type { - forall( - &["f", "a"], - arrow(variable("a"), control(variable("f"), variable("a"))), - ) - } - - /// `Prim.Control.bind :: forall f a b. Control f a -> (a -> Control f b) -> Control f b`. - pub(super) fn control_bind() -> Type { - forall( - &["f", "a", "b"], - arrow( - control(variable("f"), variable("a")), - arrow( - arrow(variable("a"), control(variable("f"), variable("b"))), - control(variable("f"), variable("b")), - ), - ), - ) - } - - /// `Prim.Control.perform :: forall f a. f a -> Control f a`. - pub(super) fn control_perform() -> Type { - forall( - &["f", "a"], - arrow( - apply(variable("f"), variable("a")), - control(variable("f"), variable("a")), - ), - ) - } - - /// A closed two-field record, used for the `(state, value)` result. - fn record(fields: &[(&str, Type)]) -> Type { - Type { - kind: TypeKind::Record { - fields: fields - .iter() - .map(|(label, ty)| TypeField { - label: (*label).to_owned(), - label_span: empty_span(), - ty: ty.clone(), - span: empty_span(), - }) - .collect(), - tail: None, - }, - span: empty_span(), - } - } - - /// `Prim.Control.run`, the closed state-threading fold: - /// `forall f a s. s -> (forall x. s -> f x -> (x -> Control f a) -> - /// (s, Control f a)) -> Control f a -> (s, a)`. - pub(super) fn control_run() -> Type { - let handler = forall( - &["x"], - arrow( - variable("s"), - arrow( - apply(variable("f"), variable("x")), - arrow( - arrow(variable("x"), control(variable("f"), variable("a"))), - record(&[ - ("_1", variable("s")), - ("_2", control(variable("f"), variable("a"))), - ]), - ), - ), - ), - ); - forall( - &["f", "a", "s"], - arrow( - variable("s"), - arrow( - handler, - arrow( - control(variable("f"), variable("a")), - record(&[("_1", variable("s")), ("_2", variable("a"))]), - ), - ), - ), - ) - } - - /// `Prim.Control.handle`, the open eliminator: - /// `forall f g u a s. s` - /// `-> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a))` - /// `-> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r)` (project) - /// `-> (forall x. g x -> u x)` (inject) - /// `-> Control u a -> Control g (s, a)`. - pub(super) fn control_handle() -> Type { - let handler = forall( - &["x"], - arrow( - variable("s"), - arrow( - apply(variable("f"), variable("x")), - arrow( - arrow(variable("x"), control(variable("u"), variable("a"))), - record(&[ - ("_1", variable("s")), - ("_2", control(variable("u"), variable("a"))), - ]), - ), - ), - ), - ); - let project = forall( - &["x", "r"], - arrow( - apply(variable("u"), variable("x")), - arrow( - arrow(apply(variable("f"), variable("x")), variable("r")), - arrow( - arrow(apply(variable("g"), variable("x")), variable("r")), - variable("r"), - ), - ), - ), - ); - let inject = forall( - &["x"], - arrow( - apply(variable("g"), variable("x")), - apply(variable("u"), variable("x")), - ), - ); - forall( - &["f", "g", "u", "a", "s"], - arrow( - variable("s"), - arrow( - handler, - arrow( - project, - arrow( - inject, - arrow( - control(variable("u"), variable("a")), - control( - variable("g"), - record(&[("_1", variable("s")), ("_2", variable("a"))]), - ), - ), - ), - ), - ), - ), - ) - } -} +mod scheme; #[cfg(test)] mod tests { diff --git a/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs b/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs new file mode 100644 index 00000000..77af16e7 --- /dev/null +++ b/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs @@ -0,0 +1,198 @@ +use super::*; + +/// `Control f a`: a computation over the opaque request functor `f` that +/// yields an `a`, possibly after suspending at `perform`. +fn control(of: Type, value: Type) -> Type { + apply(apply(named(TypeId::CONTROL), of), value) +} + +/// `Prim.Control.return :: forall f a. a -> Control f a`. +pub(in crate::intrinsic::registry) fn control_return() -> Type { + forall( + &["f", "a"], + arrow(variable("a"), control(variable("f"), variable("a"))), + ) +} + +/// `Prim.Control.bind :: forall f a b. Control f a -> (a -> Control f b) -> Control f b`. +pub(in crate::intrinsic::registry) fn control_bind() -> Type { + forall( + &["f", "a", "b"], + arrow( + control(variable("f"), variable("a")), + arrow( + arrow(variable("a"), control(variable("f"), variable("b"))), + control(variable("f"), variable("b")), + ), + ), + ) +} + +/// `Prim.Control.perform :: forall f a. f a -> Control f a`. +pub(in crate::intrinsic::registry) fn control_perform() -> Type { + forall( + &["f", "a"], + arrow( + apply(variable("f"), variable("a")), + control(variable("f"), variable("a")), + ), + ) +} + +/// A closed two-field record, used for the `(state, value)` result. +fn record(fields: &[(&str, Type)]) -> Type { + Type { + kind: TypeKind::Record { + fields: fields + .iter() + .map(|(label, ty)| TypeField { + label: (*label).to_owned(), + label_span: empty_span(), + ty: ty.clone(), + span: empty_span(), + }) + .collect(), + tail: None, + }, + span: empty_span(), + } +} + +/// `Prim.Control.run`, the closed state-threading fold: +/// `forall f a s. s -> (forall x. s -> f x -> (x -> Control f a) -> +/// (s, Control f a)) -> Control f a -> (s, a)`. +pub(in crate::intrinsic::registry) fn control_run() -> Type { + let handler = forall( + &["x"], + arrow( + variable("s"), + arrow( + apply(variable("f"), variable("x")), + arrow( + arrow(variable("x"), control(variable("f"), variable("a"))), + record(&[ + ("_1", variable("s")), + ("_2", control(variable("f"), variable("a"))), + ]), + ), + ), + ), + ); + forall( + &["f", "a", "s"], + arrow( + variable("s"), + arrow( + handler, + arrow( + control(variable("f"), variable("a")), + record(&[("_1", variable("s")), ("_2", variable("a"))]), + ), + ), + ), + ) +} + +/// `Prim.Control.handle`, the open eliminator: +/// `forall f g u a s. s` +/// `-> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a))` +/// `-> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r)` (project) +/// `-> (forall x. g x -> u x)` (inject) +/// `-> Control u a -> Control g (s, a)`. +pub(in crate::intrinsic::registry) fn control_handle() -> Type { + let handler = forall( + &["x"], + arrow( + variable("s"), + arrow( + apply(variable("f"), variable("x")), + arrow( + arrow(variable("x"), control(variable("u"), variable("a"))), + record(&[ + ("_1", variable("s")), + ("_2", control(variable("u"), variable("a"))), + ]), + ), + ), + ), + ); + let project = forall( + &["x", "r"], + arrow( + apply(variable("u"), variable("x")), + arrow( + arrow(apply(variable("f"), variable("x")), variable("r")), + arrow( + arrow(apply(variable("g"), variable("x")), variable("r")), + variable("r"), + ), + ), + ), + ); + let inject = forall( + &["x"], + arrow( + apply(variable("g"), variable("x")), + apply(variable("u"), variable("x")), + ), + ); + forall( + &["f", "g", "u", "a", "s"], + arrow( + variable("s"), + arrow( + handler, + arrow( + project, + arrow( + inject, + arrow( + control(variable("u"), variable("a")), + control( + variable("g"), + record(&[("_1", variable("s")), ("_2", variable("a"))]), + ), + ), + ), + ), + ), + ), + ) +} + +fn resumption(f: Type, a: Type, b: Type) -> Type { + apply(apply(apply(named(TypeId::RESUMPTION), f), a), b) +} + +/// Wrap an ordinary continuation with independently checked one-shot ownership. +pub(in crate::intrinsic::registry) fn control_once() -> Type { + forall( + &["f", "a", "b"], + arrow( + arrow(variable("a"), control(variable("f"), variable("b"))), + resumption(variable("f"), variable("a"), variable("b")), + ), + ) +} + +/// Construct a resume node; ownership is consumed when it is interpreted. +pub(in crate::intrinsic::registry) fn control_resume() -> Type { + forall( + &["f", "a", "b"], + arrow( + resumption(variable("f"), variable("a"), variable("b")), + arrow(variable("a"), control(variable("f"), variable("b"))), + ), + ) +} + +/// Cancel pending ownership immediately; cancelling an active/used owner traps. +pub(in crate::intrinsic::registry) fn control_cancel() -> Type { + forall( + &["f", "a", "b"], + arrow( + resumption(variable("f"), variable("a"), variable("b")), + builtin(BuiltinType::Unit), + ), + ) +} diff --git a/crates/psrs-hir/src/intrinsic/registry/scheme/mod.rs b/crates/psrs-hir/src/intrinsic/registry/scheme/mod.rs new file mode 100644 index 00000000..a215d14c --- /dev/null +++ b/crates/psrs-hir/src/intrinsic/registry/scheme/mod.rs @@ -0,0 +1,237 @@ +use super::*; + +fn empty_span() -> TextRange { + TextRange::new(0, 0) +} + +fn builtin(builtin: BuiltinType) -> Type { + Type { + kind: TypeKind::Constructor(builtin), + span: empty_span(), + } +} + +fn named(id: TypeId) -> Type { + Type { + kind: TypeKind::Named(id), + span: empty_span(), + } +} + +fn variable(name: &str) -> Type { + Type { + kind: TypeKind::Variable(name.to_owned()), + span: empty_span(), + } +} + +fn apply(function: Type, argument: Type) -> Type { + Type { + kind: TypeKind::Application(Box::new(function), Box::new(argument)), + span: empty_span(), + } +} + +fn arrow(parameter: Type, result: Type) -> Type { + Type { + kind: TypeKind::Function { + parameter: Box::new(parameter), + result: Box::new(result), + }, + span: empty_span(), + } +} + +fn forall(names: &[&str], body: Type) -> Type { + Type { + kind: TypeKind::Forall { + variables: names + .iter() + .map(|name| TypeParameter { + name: (*name).to_owned(), + name_span: empty_span(), + kind: None, + }) + .collect(), + body: Box::new(body), + }, + span: empty_span(), + } +} + +fn array(element: Type) -> Type { + apply(builtin(BuiltinType::Array), element) +} + +fn int() -> Type { + builtin(BuiltinType::Int) +} + +fn scalar(operand: BuiltinType, result: BuiltinType) -> Type { + let operand = builtin(operand); + arrow(operand.clone(), arrow(operand, builtin(result))) +} + +fn unary(operand: BuiltinType, result: BuiltinType) -> Type { + arrow(builtin(operand), builtin(result)) +} + +pub(super) fn boolean() -> Type { + builtin(BuiltinType::Boolean) +} + +pub(super) fn unit() -> Type { + builtin(BuiltinType::Unit) +} + +pub(super) fn int_int_int() -> Type { + scalar(BuiltinType::Int, BuiltinType::Int) +} + +pub(super) fn int_int_bool() -> Type { + scalar(BuiltinType::Int, BuiltinType::Boolean) +} + +pub(super) fn number_number_number() -> Type { + scalar(BuiltinType::Number, BuiltinType::Number) +} + +pub(super) fn number_number_bool() -> Type { + scalar(BuiltinType::Number, BuiltinType::Boolean) +} + +pub(super) fn boolean_boolean_boolean() -> Type { + scalar(BuiltinType::Boolean, BuiltinType::Boolean) +} + +pub(super) fn char_char_bool() -> Type { + scalar(BuiltinType::Char, BuiltinType::Boolean) +} + +pub(super) fn int_int() -> Type { + unary(BuiltinType::Int, BuiltinType::Int) +} + +pub(super) fn number_number() -> Type { + unary(BuiltinType::Number, BuiltinType::Number) +} + +pub(super) fn number_bool() -> Type { + unary(BuiltinType::Number, BuiltinType::Boolean) +} + +pub(super) fn number() -> Type { + builtin(BuiltinType::Number) +} + +pub(super) fn boolean_boolean() -> Type { + unary(BuiltinType::Boolean, BuiltinType::Boolean) +} + +pub(super) fn int_number() -> Type { + unary(BuiltinType::Int, BuiltinType::Number) +} + +pub(super) fn string_number() -> Type { + unary(BuiltinType::String, BuiltinType::Number) +} + +pub(super) fn number_string() -> Type { + unary(BuiltinType::Number, BuiltinType::String) +} + +pub(super) fn number_int() -> Type { + unary(BuiltinType::Number, BuiltinType::Int) +} + +pub(super) fn boolean_int() -> Type { + unary(BuiltinType::Boolean, BuiltinType::Int) +} + +pub(super) fn int_boolean() -> Type { + unary(BuiltinType::Int, BuiltinType::Boolean) +} + +pub(super) fn char_int() -> Type { + unary(BuiltinType::Char, BuiltinType::Int) +} + +pub(super) fn int_char() -> Type { + unary(BuiltinType::Int, BuiltinType::Char) +} + +pub(super) fn array_length() -> Type { + forall(&["a"], arrow(array(variable("a")), int())) +} + +pub(super) fn array_index() -> Type { + forall( + &["a"], + arrow(array(variable("a")), arrow(int(), variable("a"))), + ) +} + +pub(super) fn array_update() -> Type { + forall( + &["a"], + arrow( + array(variable("a")), + arrow(int(), arrow(variable("a"), array(variable("a")))), + ), + ) +} + +pub(super) fn array_append() -> Type { + forall( + &["a"], + arrow( + array(variable("a")), + arrow(array(variable("a")), array(variable("a"))), + ), + ) +} + +pub(super) fn array_fill() -> Type { + forall( + &["a"], + arrow(int(), arrow(variable("a"), array(variable("a")))), + ) +} + +pub(super) fn string_to_bytes() -> Type { + arrow(builtin(BuiltinType::String), array(int())) +} + +pub(super) fn bytes_to_string() -> Type { + arrow(array(int()), builtin(BuiltinType::String)) +} + +pub(super) fn undefined() -> Type { + forall(&["a"], variable("a")) +} + +pub(super) fn coerce() -> Type { + let constraint = apply( + apply(named(TypeId::COERCIBLE), variable("a")), + variable("b"), + ); + Type { + kind: TypeKind::Constrained { + constraint: Box::new(constraint), + body: Box::new(arrow(variable("a"), variable("b"))), + }, + span: empty_span(), + } +} + +/// `Unsafe.Coerce.unsafeCoerce`: an unconstrained identity cast. It has no +/// `Coercible` proof; the value crosses its erased representation unchanged. +pub(super) fn unsafe_coerce() -> Type { + forall(&["a", "b"], arrow(variable("a"), variable("b"))) +} + +mod control; +pub(super) use control::{ + control_bind, control_cancel, control_handle, control_once, control_perform, control_resume, + control_return, control_run, +}; diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index 79419fe3..9a0ebc9d 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -109,6 +109,8 @@ impl TypeId { /// Stable identity of the compiler-owned `Prim.Control.Control` carrier, the /// effect-agnostic delimited-control computation type. pub const CONTROL: Self = Self::new(ModuleId::INTRINSICS, 31); + /// Opaque owner of one continuation use; argument roles are nominal. + pub const RESUMPTION: Self = Self::new(ModuleId::INTRINSICS, 32); } mod intrinsic; diff --git a/crates/psrs-hir/src/primitives/control.rs b/crates/psrs-hir/src/primitives/control.rs index dfa653ad..3e227203 100644 --- a/crates/psrs-hir/src/primitives/control.rs +++ b/crates/psrs-hir/src/primitives/control.rs @@ -5,19 +5,37 @@ use super::*; /// suspending at `perform`. Its representation is owned by the control lowering; /// this declaration fixes only its identity, kind, and roles. pub(super) fn declarations() -> Vec<(&'static str, TypeDeclaration)> { - vec![( - "Prim.Control", - foreign_type( - TypeId::CONTROL, - "Control", - arrow_kind( - vec![ - arrow_kind(vec![builtin(BuiltinType::Type)], builtin(BuiltinType::Type)), + vec![ + ( + "Prim.Control", + foreign_type( + TypeId::CONTROL, + "Control", + arrow_kind( + vec![ + arrow_kind(vec![builtin(BuiltinType::Type)], builtin(BuiltinType::Type)), + builtin(BuiltinType::Type), + ], builtin(BuiltinType::Type), - ], - builtin(BuiltinType::Type), + ), + &[Role::Representational, Role::Representational], ), - &[Role::Representational, Role::Representational], ), - )] + ( + "Prim.Control", + foreign_type( + TypeId::RESUMPTION, + "Resumption", + arrow_kind( + vec![ + arrow_kind(vec![builtin(BuiltinType::Type)], builtin(BuiltinType::Type)), + builtin(BuiltinType::Type), + builtin(BuiltinType::Type), + ], + builtin(BuiltinType::Type), + ), + &[Role::Nominal, Role::Nominal, Role::Nominal], + ), + ), + ] } diff --git a/crates/psrs-hir/src/primitives/tests.rs b/crates/psrs-hir/src/primitives/tests.rs index 16944572..2157c48c 100644 --- a/crates/psrs-hir/src/primitives/tests.rs +++ b/crates/psrs-hir/src/primitives/tests.rs @@ -46,7 +46,8 @@ const OFFICIAL_MEMBERS: &[(&str, &str)] = &[ /// Compiler-owned members that extend the official `Prim.*` environment. They /// are not part of PureScript's `primModules`, so they are recorded separately /// and never folded into the official transcription above. -const COMPILER_EXTENSIONS: &[(&str, &str)] = &[("Prim.Control", "Control")]; +const COMPILER_EXTENSIONS: &[(&str, &str)] = + &[("Prim.Control", "Control"), ("Prim.Control", "Resumption")]; fn declared(owner: &str, name: &str) -> TypeDeclaration { primitive_type_declarations() diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index a20f9496..5f4b050f 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the five `Prim.Control` primitives lower to persistent frames and shared closed/open executors. Mandatory Wasmtime evidence covers bind/request stack safety, open residual forwarding, nested handlers, abandonment, multi-shot replay, aggregate captures and GC during suspension. One-shot/cancellation APIs, delimiter-liveness checks, complete frame verification, foreign capture boundaries and official library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight `Prim.Control` primitives lower to persistent frames and shared closed/open executors. Mandatory Wasmtime evidence covers bind/request stack safety, open residual forwarding, nested handlers, abandonment, multi-shot replay, aggregate captures and GC during suspension. One-shot ownership/cancellation and delimiter-liveness checks have focused execution evidence. Complete frame verification, foreign capture boundaries and official library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 6e130045..b4786a6c 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -254,13 +254,45 @@ and may call it zero, one, or many times; replay re-runs the interpreted remaind and does not roll back mutations or external IO already performed by another branch. This matches the portable library encoding and needs no extra representation. -**One-shot is a separate library API.** It exposes an opaque `Resumption a` value -with a consumed status instead of a bare function; the first resume atomically -consumes it and a second attempt is rejected rather than silently reinterpreted. The -compiler provides the frame representation and the atomic check; no optimization may -turn a multi-shot continuation into a one-shot one. Existing PureScript arrows are -unrestricted, so hiding a constructor or adding a nominal parameter does not enforce -one-shot use; the guarantee lives at the representation boundary, not in the type. +**One-shot is a separate library API.** It exposes an opaque +`Resumption f a b`. A library can wrap the multi-shot function received by a +clause once and expose only this owner to its clients. The compiler provides: + +```text +once : (a -> Control f b) -> Resumption f a b +resume : Resumption f a b -> a -> Control f b +cancel : Resumption f a b -> Unit +``` + +All three type parameters have nominal roles: safe coercion cannot change the +owned request, input or answer contract. `once` allocates independent ownership; +wrapping the same unrestricted function twice deliberately creates two owners. +It does not make the original function linear. Aliases of one owner share its +status, and a library that promises one-shot use must expose that owner rather +than the unrestricted function or a factory for additional owners. + +`resume` constructs an inert node and evaluates its arguments strictly. When an +executor interprets that node, it requires `Pending`, enters `Running` before +invoking the wrapped function, and enters `Consumed` when that function returns +the next computation. Re-entrant interpretation or cancellation sees `Running` +and is rejected. A second interpretation of the same node also fails. Once the +wrapped function returns, subsequent suspended work is ordinary `Control` data; +the owner grants one invocation, not a linear-use rule for every value produced +by that invocation. No optimization may consume ownership during construction. + +`cancel` immediately transitions a `Pending` owner to `Cancelled`; cancelling a +running, consumed or cancelled owner traps. Cancelling an owner does not cancel +the delimiter or other owners. Discarding an inert resume node leaves ownership +pending. Status transitions use private mutable GC cells and happen without a +callback between the check and update. This is atomic with respect to re-entrancy +under the pinned single-threaded guest profile; it is not a cross-thread atomic +protocol. Enabling shared guest execution requires a separate ownership design. + +The callback is stored in a private mutable reference slot and removed on +consumption or cancellation. A retained spent owner does not retain that +callback's captures. The executor's local reference roots a running callback. +Existing unrestricted PureScript arrows remain multi-shot, and no optimization +may silently replace them with an owner. ## Design @@ -466,8 +498,10 @@ still follows the ordinary language rules. ```text Computation = Return(value) | Perform(request) | Bind(inner, continuation) - | Resume(value, savedSequence) -- internal only + | Resume(value, savedSequence, boundary) -- internal only | Handle(state, handler, project, inject, inner) + | Reenter(state, handler, project, inject, inner, boundary) + | OwnedResume(owner, value) -- internal only Sequence = Empty | Cons(continuation, rest) | Append(left, right) Machine = (handler, state, computation, pendingSequence) ``` @@ -477,7 +511,7 @@ The executor pushes this function onto its pending sequence and descends into th inner computation. A `Return` consumes one pending function; that function returns a computation node to the executor. A `Perform` passes the unchanged request and a resumption capturing the entire pending sequence to the handler. The resumption -constructs `Resume(value, savedSequence)`; it does not execute the sequence or +constructs `Resume(value, savedSequence, boundary)`; it does not execute the sequence or re-enter the executor. A bare `Perform` therefore needs only a request field: its identity continuation is represented by the empty pending sequence. Suspension becomes observable when an executor interprets the node. An unused @@ -527,13 +561,13 @@ inner loop and returns: ```text Bind(Perform(gop), forward(savedState, handler, project, inject, savedSequence)) -forward(x) = Handle(savedState, handler, project, inject, - Resume(x, savedSequence)) +forward(x) = Reenter(savedState, handler, project, inject, + Resume(x, savedSequence, boundary), boundary) ``` The outer executor delivers `gop` unchanged to its handler. Calling `forward` only constructs data; re-entry occurs when the outer executor interprets the -returned `Handle`. Saved state is immutable: separate outer resumptions each +returned `Reenter`. Saved state is immutable: separate outer resumptions each start with the same saved inner state. Subsequent changes within one branch do not overwrite the other branch's state. An outer clause can abandon the entire inner delimiter by discarding its resumption. @@ -590,8 +624,7 @@ The frame chain is the continuation. Two representations are possible: external IO already performed by another branch are shared, exactly as the pure model requires; multi-shot execution does not roll back IO. - **Owned frames** (the one-shot representation): a `Resumption` holds a status of - `Pending`, `Running`, `Consumed`, or `Cancelled`. The first `resume` atomically - transitions out of `Pending`; a second attempt is rejected rather than silently + `Pending`, `Running`, `Consumed`, or `Cancelled`. The first interpreted `resume` transitions out of `Pending` without an intervening callback; a second attempt is rejected rather than silently reinterpreted. Transfer must be atomic with respect to re-entrancy, so a re-entrant resume of a running resumption fails rather than corrupting the chain. @@ -607,6 +640,29 @@ becomes unreachable and the GC reclaims the frames. The compiler must not drop a live continuation to an optimization, and must not let a dead one keep roots alive beyond its contract. +Every interpreted closed `run` allocates a fresh delimiter token. It closes +that token before returning the result. A captured resumption and its `Resume` +node both retain the token: calling the function and interpreting an already +constructed node each check liveness. Moving the node into another `run` cannot +bypass expiry. A live multi-shot resumption may be interpreted re-entrantly under +a nested `run`; it still captures only its original pending sequence. + +An open `Handle` allocates a child token referring to its enclosing delimiter. +Completion closes that activation's token. Forwarding suspends it; the saved +checkpoint remains valid while its parent is live. Each residual replay starts +a fresh activation with the same enclosing parent, so completing one replay does +not invalidate the saved checkpoint used by another replay. New resumptions +captured in that replay belong to its own activation and expire when it completes. +Re-entry checks the checkpoint before creating the new activation. Tokens follow +actual delimiter nesting, not forwarded request count; checkpoint re-entry does +not build a new ancestor link for every request. Parent expiry also invalidates +suspended children, including ones abandoned by an outer clause. + +Tokens are immutable tagged GC objects containing private mutable liveness cells +and an optional parent. A shared generated loop checks the token and its ancestors. +The token is not an abstract target-native stack handle. Frame payloads and saved +sequences remain persistent, so lifetime checks do not consume multi-shot data. + This is the software-continuation cost model: because the frames are heap objects, the ordinary GC finds their roots and no separate root information is needed. A native continuation moves the same obligation to the runtime, which scans captured diff --git a/docs/feature/F-02-portable-programs.md b/docs/feature/F-02-portable-programs.md index 5ab8de5b..77f20559 100644 --- a/docs/feature/F-02-portable-programs.md +++ b/docs/feature/F-02-portable-programs.md @@ -18,8 +18,12 @@ operations and supply different handlers for production and testing, using existing PureScript syntax and types. The representation for the generic handler mechanism is recorded as a decision ([DEC-19](../decision/DEC-19-compiler-generated-resumable-frames.md)); a separate draft proposes implementing the official Effect/ST APIs over library -native handlers while preserving their public contracts. None of these proposals -is an implemented capability yet. +native handlers while preserving their public contracts. The low-level control surface now supports closed and open interpretation, +persistent multi-shot continuations, and explicit one-shot owners. Calling or +interpreting an expired continuation, reusing a spent owner, or resuming a +cancelled owner traps. Full library APIs, host interpretation and official-suite +acceptance remain incomplete; this does not restore the former `Effect Unit` +entry capability. The intended workflow is: diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 76dc36d6..5b33671e 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -258,3 +258,134 @@ The open executor retains one non-tail call to itself for nested `Handle` entry; this matches the documented handler-depth bound and does not recurse once per forwarded request. Wasmtime 49.0.2 executes the long forwarding test and the collection test. Official differential cases and scoreboards were not run. + + +## One-shot ownership and delimiter lifetime evidence (2026-10-11) + +The prior executor slice was committed as `1bcad5a7`. With that compiler, a handler +could store its continuation in an ordinary record, return from `run`, then call +and interpret the saved continuation in another `run`, returning 42. The owning +boundary is CC control lowering: the old captured sequence carried no liveness +evidence. `/private/tmp/psrs-control-lifetime-before.log` records execution of the +baseline case. The continuation now carries a delimiter token checked both on +invocation and interpretation; the same case traps with Wasmtime exit 134. + +The compiler interface adds nominal `Resumption f a b`, `once`, inert `resume`, and +immediate `cancel`. Owners use a shared private status cell. Interpretation checks +Pending and changes it to Running without invoking a callback between these steps; +normal callback return changes it to Consumed. Cancellation changes only Pending +to Cancelled. Re-entrant callbacks observe Running, and all non-Pending uses trap. +The guarantee is atomic with respect to callbacks in the pinned single-threaded +guest profile. It is not an atomic protocol for shared-memory threads. +The mutable callback slot is cleared on consumption/cancellation, so a retained +spent owner does not root its callback indefinitely. This is ordinary CC/MIR GC +array storage; no target-native continuations or runtime frame interpreter were +added. Layout predeclares the new representations/signatures and stays immutable +during CC lowering. Scheme helpers were split into focused modules to retain the +500-line source limit. + +The existing multi-shot handler API is preserved. Wrapping one unrestricted +function in two `once` calls creates independent owners; aliasing one owner shares +one consumption status. A one-shot library wrapper must keep the unrestricted +function private and expose only its owner. `resume` consumes an invocation when +interpreted, not when constructed. Its returned ordinary computation can still be +shared; this API does not impose a linear-use type system on `Control` values. + +Executed evidence: + +- `control_owned_surface.rs`: six checks for the nominal API, incompatible + arguments/results/functors, cancellation of a bare function, and refusal to + safely coerce the owner's answer parameter. The same-identity coercion control + succeeds, so the rejection is not an unavailable import. +- `control_owned_runtime.rs`: fourteen mandatory runtime tests for one use, + inert and abandoned resume nodes, aliases/double interpretation, repeated + interpretation, cancellation, spent-owner cancellation, re-entrant resume and + cancellation, independent owners, strict arguments, ignored callback traps, + and collection while an owner retains an aggregate capture. +- `control_lifetime.rs`: six mandatory runtime tests for expired closed/open + continuations, already-built Resume nodes, completion of an inner open + delimiter while the outer remains live, invalidation of a suspended child + after outer abandonment, and allowed re-entrant multi-shot interpretation + while the original delimiter is still live. +- The previous 38 surface/closed/open control tests still pass, including + outer replay and 100,000 forwarded requests. Replay creates a fresh activation + with the checkpoint's original parent rather than a growing ancestry chain. + +The owner GC case uses a 65,536-byte initial heap, requires observed completed +collections in Wasmtime's log, and then checks capture recovery with result 42. +The retained log is `$TMPDIR/psrs-control-owned-gc-gc.log`. + +Run all focused evidence with the locked package and mandatory runtime: + +```sh +PSRS_STDLIB_ROOT= PSRS_REQUIRE_WASMTIME=1 \ + cargo test -p psrs-driver --test control_surface --test control_runtime \ + --test control_open_runtime --test control_owned_surface \ + --test control_owned_runtime --test control_lifetime +``` + +Normal return closes delimiter tokens; a guest trap terminates the current command +path. The guest has no exception cleanup path under the selected profile. A host +that catches a guest trap and later re-enters the same retained state requires an +explicit invalidation/cleanup protocol; this is not proved by exit-134 tests. +Complete foreign borrowed-buffer/resource capture checks, host trap recovery, +frame-identity verification and official differentials remain unverified. +Ordinary library wrappers have separate executed evidence below. No complete AE/AC requirement is marked Verified by this slice. + +## Checked primitive values and independent library wrappers (2026-10-11) + +Ordinary source aliases such as `pure = Prim.Control.return` exposed a common P8 +contract gap: compiler-interface primitive globals were omitted from mandatory +checked primitive-value elaboration. This is owned by Core primitive expansion +and the backend primitive-binding boundary, not by control-specific CC global +handling. The operation inventory now combines registry-owned intrinsic symbols +with validated foreign primitive bindings, even when the module has no foreign +bindings. Expansion preserves checked occurrence types and verifies the complete +candidate before publication. `control_primitive_values.rs` executes both aliases +(including rank-N `run`, `once`, `resume`, and scalar `intAdd`) and partial +applications, returning 42 in both cases. + +Control callback/status cells also share the canonical array-layout owner with +ordinary array protocols. A direct layout test proves reuse; the existing +linked-module canonical-layout regression passes. Control layouts are declared +only when the linked type table contains the opaque carrier or owner, avoiding +unused synthetic layouts in pure modules. + +The independent package worktree `/private/tmp/psrs-stdlib-control-20261011` is +based on the compiler's locked `1e01310` package and committed as `dda3ba3`. +The original stdlib working checkout and compiler lock are unchanged. The new +target-only `PSRS.Control` module has explicit provenance in `upstream-lock.json`; +no official module is edited. It supplies ordinary aliases and `runOnce` / +`handleOnce`, which expose one owner per request without leaking the unrestricted +continuation. Public package-runner cases `OneShot`, `MultiShot`, and `Open` +execute with exit 42; `DoubleResume` and `Cancelled` compile and execute with +exit 134 and an `unreachable` trap. Negative reports use reviewed byte-exact +runtime stderr files, as required by the existing runner. These do not establish +row compatibility, deep/shallow semantics, official `purescript-run` acceptance, +or host IO safety. + +All five reports are `/private/tmp/psrs-control-library-/run.json` and record +compiler/runtime/package fingerprints and artifact hashes. The package-owned +Node test suite passes all 11 tests. Its pinned source audit reports 41 packages, +231 modules: 170 identical, 36 modified, 25 target additions, and no absent upstream +modules or direct self-recursions. The audit is comparison evidence, not approval +of every existing target adaptation. Retained logs are +`/private/tmp/psrs-stdlib-control-node-tests-final.log` and +`/private/tmp/psrs-control-library-audit-final.log`. + +Final compiler validation with the locked package and mandatory Wasmtime: + +- `cargo fmt --all --check` and `git diff --check`: pass. +- `cargo clippy --workspace --all-targets -- -D warnings`: pass. +- `cargo test --workspace --no-fail-fast`: 424 backend library tests and all + 66 control tests pass. The workspace still fails at the same 9 baseline + targets, with 175 failing names versus 176 at archived `2026238f`. No new + failure names are present; the recovered case is + `tests::adts::erases_a_newtype_constructor_and_pattern_at_runtime`. + +Final logs are `/private/tmp/psrs-control-owned-alias-workspace.log`, +`/private/tmp/psrs-control-owned-alias-clippy.log`, and the baseline comparison +`/private/tmp/psrs-control-owned-alias-comparison.json`. Earlier intermediate +runs that failed canonical-array reuse or suffered shared build-cache interference +are not final evidence. No official differential or scoreboard was run. Complete +AE/AC requirements retain their Unverified status. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index ca23d62f..f73ddc57 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -2,10 +2,11 @@ **Date:** 2026-10-11 **Branch:** `feat/effect-handlers` -**Starting commit:** `2026238f`; the checkout was clean before this continuation. -**Scope:** Typed `Prim.Control` surface, closed/open executors, and persistent bind -sequencing. The continuation changes below are uncommitted. -**Status:** Partial topic. All five current primitives are lowered; complete AE/AC acceptance remains outstanding. +**Starting commit:** `2026238f`; the original checkout was clean. +**Executor commit:** `1bcad5a7`; the ownership/lifetime continuation starts from this clean commit. +**Scope:** Typed `Prim.Control` surface, closed/open executors, persistent bind +sequencing, and one-shot ownership/lifetime checks. The ownership/lifetime changes are delivered with this handoff in one topical commit. +**Status:** Partial topic. All eight current primitives are lowered; complete AE/AC acceptance remains outstanding. ## Governing contracts @@ -42,10 +43,12 @@ are registered from those same declarations. ```text Computation = Return(value) | Perform(request) | Bind(inner, continuation) - | Resume(value, savedSequence) + | Resume(value, savedSequence, boundary) | Handle(state, handler, project, inject, inner) + | Reenter(state, handler, project, inject, inner, boundary) + | OwnedResume(owner, value) Sequence = Empty | Cons(continuation, rest) | Append(left, right) -executor(state, handler, computation, pendingSequence) -> erased (state, value) +executor(state, handler, computation, pendingSequence, boundary) -> erased (state, value) ``` `Bind` is inert. The executor pushes its continuation and processes its inner @@ -89,7 +92,7 @@ control-specific optimizer classification was introduced. `handle` is an inert node. The open executor shares closed-driver reductions, but returns residual computation data. Its Church-sum projection selects handled requests or unchanged residual payloads. A residual bind closure captures the -inner state, handler and pending sequence and constructs a fresh `Handle` around +inner state, handler and pending sequence and constructs `Reenter` around `Resume`; it does not recursively interpret the sequence. Outer replay preserves independent copies of saved inner state, and outer abandonment discards the inner remainder. The caller's pending bind stays outside the inner delimiter. @@ -104,6 +107,28 @@ aggregate, replay, trap and GC evidence. The GC case requires an observed comple collection in the runtime log before claiming success. Source tests reject an incompatible residual functor/injection and a monomorphic projection. +## Ownership and lifetime continuation + +The compiler interface adds nominal `Resumption f a b` and `once`/`resume`/`cancel`. +`resume` constructs an inert `OwnedResume`; interpretation checks shared ownership, +sets Running before calling the wrapped function, then marks Consumed on its +normal return. Immediate cancellation changes only Pending to Cancelled. Spent +owners clear their callback slot, allowing captured values to be collected. +Separate `once` calls allocate independent owners; ordinary captured functions +remain multi-shot. + +`run` creates and closes a delimiter token. Calling a resumption and interpreting +its already-built `Resume` node both check token liveness. Open delimiters refer to +their enclosing token; suspended checkpoints expire when that parent expires. +Residual replay creates a fresh sibling activation, preserving multi-shot replay +without growing the token ancestor chain once per forwarded request. + +The baseline at `1bcad5a7` executed an escaped continuation after its `run` returned +with result 42. It now traps. New source/runtime tests cover owned API rejection, +double interpretation, cancellation, re-entrancy, closed/open expiry, outer +abandonment and GC with a pending owner. Checked frame identity, foreign resource +capture and host recovery after a guest trap still require complete acceptance. + ## Validation The locked standard-library revision `1e01310` is materialized at: @@ -123,19 +148,22 @@ cargo test --workspace PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test control_surface --test control_runtime --test control_open_runtime ``` -Final validation passed formatting, full clippy, 423 backend library tests, and -38 control tests with mandatory Wasmtime. Full workspace acceptance still fails: -the open-continuation `--no-fail-fast` run and archived `2026238f` baseline have the same -9 failing targets and 176 failing test names. The acceptance checklist records +The committed executor slice passed formatting, full clippy, 423 backend library +tests, and 38 control tests with mandatory Wasmtime. Its full workspace run and +archived `2026238f` baseline had the same 9 failing targets and 176 failing test +names. The ownership/lifetime continuation adds focused evidence recorded below. +The acceptance checklist records the decomposition, logs, tested cases, and remaining obligations. Compile acceptance, executed runtime checks, and official source comparison are separate claims. ## Remaining work -- Implement library wrappers in the independent `psrs-stdlib` repository. -- Complete generic deep/shallow wrappers, one-shot, lifetime/cancellation, - foreign capture-boundary, foreign-resource GC, and official differential evidence. +- Integrate the independently committed library wrappers into a selected package + revision; the compiler lock remains unchanged for this continuation. +- Complete generic deep/shallow wrappers, foreign capture-boundary, foreign-resource + GC, host recovery after a guest trap, and official differential evidence. + One-shot and normal-return lifetime checks have focused executed evidence. Ordinary GC capture recovery during suspension has executed evidence. - Formalize selective conversion beyond the monadic surface. This closed executor does not establish direct-style capture or arbitrary user recursion safety. @@ -147,5 +175,34 @@ separate claims. not evidence about the self-contained control programs. No complete AE/AC requirement is marked Verified by these slices. All current -`Prim.Control` primitives lower and execute; one-shot and expired-boundary -guarantees still require their API and representation contracts. +`Prim.Control` primitives lower and execute, including one-shot consumption and +normal-return delimiter expiry. The complete foreign, host recovery and frame +verification guarantees remain unverified. + +## Latest continuation validation and package handoff + +All 66 control tests and 424 backend library tests pass with mandatory Wasmtime. +Formatting and full workspace clippy pass. The full workspace `--no-fail-fast` +run remains failing at the same 9 baseline targets: 175 names versus 176 at +`2026238f`, with no new failures. The recovered case is the newtype constructor / +pattern runtime test. Retained final logs and decomposition are in the acceptance +checklist's checked primitive values section. + +The continuation also repairs mandatory primitive-value elaboration for compiler +interface globals, so valid aliases and partial applications use their checked +Core types before CC. Two direct runtime regressions cover scalar/control aliases +and partial applications. It does not add a feature-specific global exception. + +Independent library wrappers are committed at `dda3ba3` in +`/private/tmp/psrs-stdlib-control-20261011`, based on locked stdlib `1e01310`. +Public `PSRS.Control` wrappers execute one-shot, multi-shot, open forwarding, +double-use rejection and cancellation rejection through the package-owned Node +runner. The original dirty stdlib checkout is preserved, and the compiler package +lock is unchanged. Integrating this package revision with the unrelated existing +stdlib changes is still separate work; these wrappers are not yet in the locked +compiler package. + +The next required slices are deep/shallow handler behavior with official library +comparison, complete frame identity verification, foreign borrowed resources and +host recovery/cleanup after a caught guest trap. Normal-return lifetime and +single-thread callback ownership evidence do not discharge those obligations. From 95982bea612b96cb1e7bd8035c5d3bb5a51654ff Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 21:35:17 +0800 Subject: [PATCH 104/148] Record public control validation and clause scope gap --- .../fp/algebraic-effects-and-handlers.md | 3 +- .../delimited-control-and-resumable-frames.md | 13 +++- .../backend/algebraic-effects.md | 69 +++++++++++++++++++ ...ted-control-lowering-handoff-2026-10-11.md | 24 +++++++ 4 files changed, 107 insertions(+), 2 deletions(-) diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index 02031bde..98ce6511 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -4,7 +4,8 @@ **Status:** Draft design. The execution mechanism is selected by [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md) and specified in [delimited control and resumable frames](delimited-control-and-resumable-frames.md); -the lowering is not implemented. +the low-level closed/open folds and ownership checks have focused implementation +evidence; complete library handler semantics remain unverified. **Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), [functional Core](../../frontend/semantics/functional-core.md), [rows and records](../../frontend/type-system/rows-and-records.md), diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index b4786a6c..eec1b130 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -154,7 +154,7 @@ separate decision. ### The computation carrier and primitives The compiler-owned surface is an **over-functor computation**: a freer computation -over an opaque request functor `f`, with four primitives. +over an opaque request functor `f`, with construction and interpretation primitives. ```text Control f a -- computation over request functor f, yielding an a @@ -614,6 +614,17 @@ the handler runs once and later requests escape to an outer delimiter. The libra selects the semantics; the lowering must implement both and must not silently deepen or shallow a handler. +The current state-threading `run`/`handle` folds process the clause's returned +computation under their own driver. That contract alone does not express the +scoped-handler distinction between a fresh request in a clause (handled outside +the delimiter) and a request in a resumed program (reinstalled under a deep +handler). In particular, forwarding residual requests from the handled program +does not prove forwarding from a clause. A generic typed delimiter boundary must +preserve this distinction before the library can implement the complete +deep/shallow contract. This is a remaining representation/API obligation, not +permission to narrow the library semantics. The retained `ClauseScope.purs` +acceptance case is described in the implementation checklist. + #### One-shot and multi-shot The frame chain is the continuation. Two representations are possible: diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 5b33671e..12793c83 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -389,3 +389,72 @@ Final logs are `/private/tmp/psrs-control-owned-alias-workspace.log`, runs that failed canonical-array reuse or suffered shared build-cache interference are not final evidence. No official differential or scoreboard was run. Complete AE/AC requirements retain their Unverified status. + +## Main package cleanup and official type comparison (2026-10-11) + +The stdlib main worktree previously contained committed `7852625` and uncommitted +State-protocol/WASI adaptations. At the user's request those old working changes +were archived in a named stash, and the main worktree switched to `control-library` +based on the locked package plus `dda3ba3`. The generic trap-runner improvement +was preserved separately. The old branch and stash retain recovery history; no +shared Git repository directory was deleted. The main package is now committed +at `28997b5` and clean. The compiler lock is still unchanged. + +Official `purs` 0.15.16 found `UnknownExport` in the initial target wrapper: +imported type names cannot be listed as local exports. The wrapper now declares +local `Control` and `Resumption` type aliases. The retained before report is +`/private/tmp/psrs-control-official-types-before.stdout`. + +The package-owned `conformance/control-types.mjs` compares five accepting and +four rejecting sources using both public compiler executables. Since official +`purs` does not implement `Prim.Control`, the official side explicitly uses an +opaque foreign-declaration shim with the same eight scheme shapes, local Unit +and scalar declarations, and a compiler-interface import remap. It emits CoreFn +only, with no fabricated foreign runtime. The wrapper bodies and aliases are +otherwise unchanged. Both compilers accept all five wrapper fixture sources and +reject wrong owner input, wrong result, a bare function passed to cancellation, +and a monomorphic clause with `TypesDoNotUnify`. The target rejection must come +from P5 typecheck; crashes, missing tools and unrelated diagnostics do not count. +The accepted report, including tool/source hashes and unchanged package +fingerprint, is `/private/tmp/psrs-control-official-types/types.json`. + +This is focused ordinary-language type evidence. It does not establish official +control runtime behavior, pinned `purescript-run` compatibility, full rows or any +complete AE requirement. No official suite scoreboard was rerun. + +All five public target runtime fixtures pass from the main package. Negative +cases now use `--expected-trap unreachable`: completed nonzero execution, +expected stdout and the terminal trap reason are required; raw stderr is still +retained. Backtrace offsets are no longer a golden. All 12 Node tool tests pass; +the pinned audit retains 41 packages / 231 modules (170 identical, 36 modified, +25 target additions), with no absent upstream modules or direct self-recursions. +Reports are `/private/tmp/psrs-control-main-/run.json`; tool and audit logs +are `/private/tmp/psrs-stdlib-control-trap-node.log` and +`/private/tmp/psrs-control-main-audit.log`. + +### Next owning contract: clause scope and deep/shallow reinstatement + +`conformance/control/ClauseScope.purs` in stdlib is a retained failing acceptance +case. An inner clause performs a fresh request before invoking its continuation. +The scoped-handler requirement expects the outer handler to handle that request +and supply 42; the inner clause should be invoked once. Under `a31ba11e`, the +case compiles successfully but returns 0, because the inner fold handles both +requests. `/private/tmp/psrs-control-main-ClauseScope/run.json` records the +failure against expected exit 42. This case is excluded from the five passing +runtime fixtures and the nine type comparisons. + +`cc/lower/control/open.rs::handled` calls the clause then recurs with the same +handler over its next computation. That implements the present state-threading +fold, but it does not carry the semantic evidence needed to distinguish clause +execution outside the delimiter from deep reinstatement of a resumed program. +A shallow continuation likewise cannot select removal of that handler with the +current fold surface. The next foundation must provide that distinction at one +generic typed delimiter boundary, keep clause and resumed-program domains +explicit, and retain lifetime/multiplicity evidence through CC. A hidden mutable +projection flag, concrete-effect dispatch exception or request suppression would +not satisfy the contract. AE-06 and AC-05 remain Unverified. + +No Rust source changed in this continuation. Full Rust workspace tests/clippy +were not repeated; the prior `a31ba11e` evidence remains the compiler baseline. +The library tools, official type comparison, focused public runtime cases and +source audit were actually executed as recorded above. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index f73ddc57..6fb3cdb8 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -206,3 +206,27 @@ The next required slices are deep/shallow handler behavior with official library comparison, complete frame identity verification, foreign borrowed resources and host recovery/cleanup after a caught guest trap. Normal-return lifetime and single-thread callback ownership evidence do not discharge those obligations. + +## Main stdlib continuation (2026-10-11) + +The main stdlib worktree is now clean on `control-library` at `28997b5`, containing +`dda3ba3` plus official type comparison and semantic trap acceptance. Withdrawn +State-protocol changes were archived in a stash; the main checkout no longer +contains that implementation. The compiler lock remains on `1e01310`. +The clean temporary stdlib control worktree was removed after its commits were +retained on the main package branch. + +The official type comparison discovered and fixed the wrapper's invalid imported +type exports by using local type aliases. Both compilers agree on five accepting +and four `TypesDoNotUnify` rejection cases; the official side uses an explicitly +opaque interface shim and makes no control runtime claim. The five public +Wasmtime fixtures and 12 Node tool tests pass. Full Rust checks were not repeated +because this continuation changes only library/tool sources and compiler docs. + +The next concrete blocker is retained in stdlib `ClauseScope.purs`: compilation +succeeds, execution returns 0 against required 42. The current fold interprets a +clause's fresh request under the same inner handler, while complete scoped-handler +semantics require the outer handler to see it. Deep resumed execution and clause +execution need distinct generic delimiter evidence; shallow removal also remains +unexpressed. The checklist records the owning code, report and required next +boundary. Do not treat existing residual forwarding as proof of clause scope. From bdaf0cfcc1eb8ac761a3448d6d4d0737005f486e Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 23:11:48 +0800 Subject: [PATCH 105/148] Implement typed control elimination with scoped handler contexts --- crates/psrs-backend/src/cc/layout/control.rs | 36 +- .../src/cc/lower/control/builder.rs | 38 +- .../src/cc/lower/control/executor.rs | 81 +-- .../src/cc/lower/control/lifetime.rs | 39 -- .../psrs-backend/src/cc/lower/control/mod.rs | 65 +- .../psrs-backend/src/cc/lower/control/open.rs | 135 ----- .../src/cc/lower/control/replay.rs | 135 +++++ .../src/cc/lower/control/scope.rs | 182 ++++++ crates/psrs-core/src/tests/control.rs | 113 ++++ crates/psrs-core/src/tests/mod.rs | 1 + crates/psrs-core/src/verify/expr/control.rs | 222 +++++++ crates/psrs-core/src/verify/expr/intrinsic.rs | 14 + crates/psrs-core/src/verify/expr/mod.rs | 1 + crates/psrs-driver/src/prelude/package.rs | 36 ++ crates/psrs-driver/tests/control_lifetime.rs | 10 +- .../psrs-driver/tests/control_open_runtime.rs | 10 +- .../tests/control_scoped_replay.rs | 47 ++ .../tests/control_scoped_runtime.rs | 180 ++++++ .../tests/control_scoped_surface.rs | 79 +++ .../psrs-driver/tests/control_support/mod.rs | 23 +- crates/psrs-driver/tests/control_surface.rs | 23 +- crates/psrs-hir/src/intrinsic/registry.rs | 4 +- .../src/intrinsic/registry/scheme/control.rs | 57 +- ...-19-compiler-generated-resumable-frames.md | 13 +- .../DEC-20-typed-control-elimination.md | 49 ++ docs/design/D-04-suite-roadmap.md | 2 +- .../fp/algebraic-effects-and-handlers.md | 25 +- .../control-elimination-and-handler-scopes.md | 270 +++++++++ .../delimited-control-and-resumable-frames.md | 567 ++++++------------ .../backend/algebraic-effects.md | 192 ++++++ ...ted-control-lowering-handoff-2026-10-11.md | 84 ++- stdlib.lock.json | 4 +- 32 files changed, 1967 insertions(+), 770 deletions(-) delete mode 100644 crates/psrs-backend/src/cc/lower/control/open.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/replay.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/scope.rs create mode 100644 crates/psrs-core/src/tests/control.rs create mode 100644 crates/psrs-core/src/verify/expr/control.rs create mode 100644 crates/psrs-driver/tests/control_scoped_replay.rs create mode 100644 crates/psrs-driver/tests/control_scoped_runtime.rs create mode 100644 crates/psrs-driver/tests/control_scoped_surface.rs create mode 100644 docs/decision/DEC-20-typed-control-elimination.md create mode 100644 docs/design/backend/fp/control-elimination-and-handler-scopes.md diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control.rs index e4b78a89..ee55d9aa 100644 --- a/crates/psrs-backend/src/cc/layout/control.rs +++ b/crates/psrs-backend/src/cc/layout/control.rs @@ -10,8 +10,9 @@ pub(in crate::cc) struct ControlLayout { pub pair: ReprId, pub continuation: SignatureId, pub executor: SignatureId, - pub open_executor: SignatureId, - pub projected: ReprId, + pub context: ReprId, + pub clone_sequence: SignatureId, + pub rebuild_sequence: SignatureId, pub owner: ReprId, pub callback: ReprId, pub boundary: ReprId, @@ -26,7 +27,7 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) table.set( computation, Representation::Variant { - cases: [1, 1, 2, 3, 5, 6, 2] + cases: [1, 1, 2, 3, 3, 0, 2] .into_iter() .enumerate() .map(|(tag, count)| VariantCase { @@ -40,7 +41,7 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) table.set( sequence, Representation::Variant { - cases: [0, 2, 2] + cases: [0, 2, 2, 3] .into_iter() .enumerate() .map(|(tag, count)| VariantCase { @@ -63,21 +64,27 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) pair }); let executor = table.add_signature(Signature { + parameters: vec![erased; 6], + result: erased, + }); + let clone_sequence = table.add_signature(Signature { parameters: vec![erased; 5], result: erased, }); - let open_executor = table.add_signature(Signature { - parameters: vec![erased; 7], + let rebuild_sequence = table.add_signature(Signature { + parameters: vec![erased; 4], result: erased, }); - let projected = table.reserve(); + let context = table.reserve(); table.set( - projected, + context, Representation::Variant { - cases: (0..2) - .map(|tag| VariantCase { - tag, - fields: vec![erased], + cases: [1, 6] + .into_iter() + .enumerate() + .map(|(tag, count)| VariantCase { + tag: tag as u32, + fields: vec![erased; count], }) .collect(), }, @@ -120,8 +127,9 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) pair, continuation, executor, - open_executor, - projected, + context, + clone_sequence, + rebuild_sequence, owner, callback, boundary, diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs index bd4b471a..b8f4351b 100644 --- a/crates/psrs-backend/src/cc/lower/control/builder.rs +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -15,7 +15,7 @@ pub(super) struct Machine<'a> { pub layout: ControlLayout, pub functions: ControlFunctions, pub span: TextRange, - pub open: Option<(ValueId, ValueId)>, + pub context: Option, pub boundary: Option, } @@ -42,7 +42,7 @@ impl<'a> Machine<'a> { layout, functions, span, - open: None, + context: None, boundary: None, } } @@ -198,31 +198,15 @@ impl<'a> Machine<'a> { sequence: ValueId, body: &mut Vec, ) -> ValueId { - let (function, arguments) = if let Some((project, inject)) = self.open { - ( - self.functions.open_executor, - vec![ - state, - handler, - computation, - sequence, - project, - inject, - self.boundary.unwrap(), - ], - ) - } else { - ( - self.functions.executor, - vec![ - state, - handler, - computation, - sequence, - self.boundary.unwrap(), - ], - ) - }; + let function = self.functions.executor; + let arguments = vec![ + state, + handler, + computation, + sequence, + self.boundary.unwrap(), + self.context.unwrap(), + ]; self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { function, arguments, diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index 808e93a2..8f9ed0a1 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -5,21 +5,16 @@ use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, TagCase, ValueId}; impl Machine<'_> { - pub(super) fn executor(mut self, open: bool) -> Function { + pub(super) fn executor(mut self) -> Function { let state = self.lower.fresh(erased_shape()); let handler = self.lower.fresh(erased_shape()); let computation = self.lower.fresh(erased_shape()); let sequence = self.lower.fresh(erased_shape()); - let mut parameters = vec![state, handler, computation, sequence]; - if open { - let project = self.lower.fresh(erased_shape()); - let inject = self.lower.fresh(erased_shape()); - self.open = Some((project, inject)); - parameters.extend([project, inject]); - } let boundary = self.lower.fresh(erased_shape()); + let context = self.lower.fresh(erased_shape()); self.boundary = Some(boundary); - parameters.push(boundary); + self.context = Some(context); + let parameters = vec![state, handler, computation, sequence, boundary, context]; let mut cases = Vec::new(); let mut body = Vec::new(); @@ -48,40 +43,36 @@ impl Machine<'_> { let saved = self.field(computation, self.layout.computation, 3, 1, &mut body); let captured_boundary = self.field(computation, self.layout.computation, 3, 2, &mut body); self.check_boundary(captured_boundary, &mut body); + let empty = self.node(self.layout.sequence, 0, vec![], &mut body); + let function = self.functions.clone_sequence; + let boundary = self.boundary.unwrap(); + let parent = self.dispatch_boundary(&mut body); + let cloned = self.emit(erased_shape(), &mut body, |_| { + crate::cc::AssignmentKind::DirectCall { + function, + arguments: vec![saved, empty, empty, boundary, parent], + } + }); + let saved = self.pair_field(cloned, 0, &mut body); + let active = self.pair_field(cloned, 1, &mut body); let pending = self.node(self.layout.sequence, 2, vec![saved, sequence], &mut body); + self.boundary = Some(active); let next = self.node(self.layout.computation, 0, vec![value], &mut body); let result = self.recur(state, handler, next, pending, &mut body); cases.push(arm(3, body, result)); + self.boundary = Some(boundary); let mut body = Vec::new(); - let result = self.enter_handle(state, handler, computation, sequence, 4, &mut body); + let result = self.enter_handle(state, handler, computation, sequence, &mut body); cases.push(arm(4, body, result)); - let mut body = Vec::new(); - let result = self.enter_handle(state, handler, computation, sequence, 5, &mut body); - cases.push(arm(5, body, result)); - let mut body = Vec::new(); let result = self.consume_owned(state, handler, computation, sequence, &mut body); cases.push(arm(6, body, result)); let mut body = Vec::new(); let result = self.switch(computation, self.layout.computation, cases, &mut body); - let symbol = if open { - self.functions.open_executor - } else { - self.functions.executor - }; - self.finish( - symbol, - if open { - "control_open_executor" - } else { - "control_executor" - }, - parameters, - body, - result, - ) + let symbol = self.functions.executor; + self.finish(symbol, "control_executor", parameters, body, result) } fn returned( @@ -95,13 +86,7 @@ impl Machine<'_> { ) -> ValueId { let mut cases = Vec::new(); let mut branch = Vec::new(); - let pair = self.pair(state, value, &mut branch); - let result = if self.open.is_some() { - self.close_boundary(self.boundary.unwrap(), &mut branch); - self.node(self.layout.computation, 0, vec![pair], &mut branch) - } else { - pair - }; + let result = self.finish_source(state, handler, value, &mut branch); cases.push(arm(0, branch, result)); let mut branch = Vec::new(); @@ -116,6 +101,15 @@ impl Machine<'_> { let right = self.field(sequence, self.layout.sequence, 2, 1, &mut branch); let result = self.appended(state, handler, computation, value, left, right, &mut branch); cases.push(arm(2, branch, result)); + let mut branch = Vec::new(); + let boundary = self.field(sequence, self.layout.sequence, 3, 0, &mut branch); + let rest = self.field(sequence, self.layout.sequence, 3, 1, &mut branch); + let parent = self.field(sequence, self.layout.sequence, 3, 2, &mut branch); + self.close_boundary(boundary, &mut branch); + let old = self.boundary.replace(parent); + let result = self.recur(state, handler, computation, rest, &mut branch); + self.boundary = old; + cases.push(arm(3, branch, result)); self.switch(sequence, self.layout.sequence, cases, body) } @@ -150,6 +144,19 @@ impl Machine<'_> { let pending = self.node(self.layout.sequence, 2, vec![first, rest], &mut branch); let result = self.recur(state, handler, computation, pending, &mut branch); cases.push(arm(2, branch, result)); + let mut branch = Vec::new(); + let boundary = self.field(left, self.layout.sequence, 3, 0, &mut branch); + let rest = self.field(left, self.layout.sequence, 3, 1, &mut branch); + let parent = self.field(left, self.layout.sequence, 3, 2, &mut branch); + let pending = self.node(self.layout.sequence, 2, vec![rest, right], &mut branch); + let pending = self.node( + self.layout.sequence, + 3, + vec![boundary, pending, parent], + &mut branch, + ); + let result = self.recur(state, handler, computation, pending, &mut branch); + cases.push(arm(3, branch, result)); self.switch(left, self.layout.sequence, cases, body) } } diff --git a/crates/psrs-backend/src/cc/lower/control/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/lifetime.rs index b69adb7a..2b5c7199 100644 --- a/crates/psrs-backend/src/cc/lower/control/lifetime.rs +++ b/crates/psrs-backend/src/cc/lower/control/lifetime.rs @@ -195,43 +195,4 @@ impl Machine<'_> { result, ) } - - pub(super) fn enter_handle( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, - case: u32, - body: &mut Vec, - ) -> ValueId { - let inner_state = self.field(computation, self.layout.computation, case, 0, body); - let inner_handler = self.field(computation, self.layout.computation, case, 1, body); - let project = self.field(computation, self.layout.computation, case, 2, body); - let inject = self.field(computation, self.layout.computation, case, 3, body); - let inner = self.field(computation, self.layout.computation, case, 4, body); - let boundary = if case == 4 { - self.new_boundary(self.boundary, body) - } else { - let boundary = self.field(computation, self.layout.computation, case, 5, body); - self.check_boundary(boundary, body); - let parent = self.field(boundary, self.layout.boundary, 1, 1, body); - self.new_boundary(Some(parent), body) - }; - let empty = self.node(self.layout.sequence, 0, vec![], body); - let function = self.functions.open_executor; - let next = self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { - function, - arguments: vec![ - inner_state, - inner_handler, - inner, - empty, - project, - inject, - boundary, - ], - }); - self.recur(state, handler, next, sequence, body) - } } diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index dcff2395..e34319fe 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -12,18 +12,17 @@ use psrs_span::TextRange; mod builder; mod executor; mod lifetime; -mod open; mod owned; +mod replay; +mod scope; use builder::Machine; #[derive(Clone, Copy)] pub(in crate::cc) struct ControlFunctions { executor: SymbolId, resume: SymbolId, - open_executor: SymbolId, - forward: SymbolId, - project_left: SymbolId, - project_right: SymbolId, + clone_sequence: SymbolId, + rebuild_sequence: SymbolId, start: SymbolId, check: SymbolId, close: SymbolId, @@ -97,12 +96,32 @@ impl FunctionLowerer<'_> { }, span: expression.span, }); + let shape = builder::repr(layout.context); + let context = self.fresh(shape); + assignments.push(Assignment { + destination: context, + kind: AssignmentKind::VariantNew { + destination: context, + representation: layout.context, + case: 0, + fields: vec![boundary], + }, + span: expression.span, + }); + let context = self.emit_conversion( + context, + shape, + erased_shape(), + crate::cc::ValueConversion::EraseReference, + expression.span, + assignments, + ); let result = self.fresh(erased_shape()); assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { function: functions.executor, - arguments: vec![fields[0], fields[1], fields[2], empty, boundary], + arguments: vec![fields[0], fields[1], fields[2], empty, boundary, context], }, span: expression.span, }); @@ -188,10 +207,8 @@ impl FunctionLowerer<'_> { ControlFunctions { executor: symbols.fresh(self.owner), resume: symbols.fresh(self.owner), - open_executor: symbols.fresh(self.owner), - forward: symbols.fresh(self.owner), - project_left: symbols.fresh(self.owner), - project_right: symbols.fresh(self.owner), + clone_sequence: symbols.fresh(self.owner), + rebuild_sequence: symbols.fresh(self.owner), start: symbols.fresh(self.owner), check: symbols.fresh(self.owner), close: symbols.fresh(self.owner), @@ -207,17 +224,9 @@ impl FunctionLowerer<'_> { self.generated_signatures .borrow_mut() .insert(functions.executor, signature); - let open_signature = self - .representations - .signature(layout.open_executor) - .ok_or_else(|| { - control_error(span, "open control executor has no predeclared signature") - })? - .clone(); - self.generated_signatures - .borrow_mut() - .insert(functions.open_executor, open_signature); for (symbol, id) in [ + (functions.clone_sequence, layout.clone_sequence), + (functions.rebuild_sequence, layout.rebuild_sequence), (functions.start, layout.start), (functions.check, layout.boundary_check), (functions.close, layout.boundary_check), @@ -260,22 +269,12 @@ impl FunctionLowerer<'_> { ); self.verify_synthesized(&resume)?; self.generated.push(resume); - let executor = Machine::new(self.child_lowerer(), layout, functions, span).executor(false); + let executor = Machine::new(self.child_lowerer(), layout, functions, span).executor(); self.verify_synthesized(&executor)?; self.generated.push(executor); - let open = Machine::new(self.child_lowerer(), layout, functions, span).executor(true); - self.verify_synthesized(&open)?; - self.generated.push(open); - let forward = Machine::new(self.child_lowerer(), layout, functions, span).forward(); - self.verify_synthesized(&forward)?; - self.generated.push(forward); - for (case, symbol) in [(0, functions.project_left), (1, functions.project_right)] { - let selector = - Machine::new(self.child_lowerer(), layout, functions, span).selector(case, symbol); - self.verify_synthesized(&selector)?; - self.generated.push(selector); - } for function in [ + Machine::new(self.child_lowerer(), layout, functions, span).clone_sequence(), + Machine::new(self.child_lowerer(), layout, functions, span).rebuild_sequence(), Machine::new(self.child_lowerer(), layout, functions, span).start_boundary(), Machine::new(self.child_lowerer(), layout, functions, span).boundary_check(), Machine::new(self.child_lowerer(), layout, functions, span).boundary_close(), diff --git a/crates/psrs-backend/src/cc/lower/control/open.rs b/crates/psrs-backend/src/cc/lower/control/open.rs deleted file mode 100644 index 9455fb15..00000000 --- a/crates/psrs-backend/src/cc/lower/control/open.rs +++ /dev/null @@ -1,135 +0,0 @@ -//! Open interpretation stops at residual requests and saves its own delimiter. - -use super::builder::Machine; -use super::executor::arm; -use crate::cc::payload::erased_shape; -use crate::cc::{Assignment, Function, ValueId}; -use psrs_hir::SymbolId; - -impl Machine<'_> { - pub(super) fn requested( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let request = self.field(computation, self.layout.computation, 1, 0, body); - let Some((project, inject)) = self.open else { - return self.handled(state, handler, request, sequence, body); - }; - let left = self.closure( - self.functions.project_left, - self.layout.continuation, - vec![], - body, - ); - let right = self.closure( - self.functions.project_right, - self.layout.continuation, - vec![], - body, - ); - let projected = self.apply(project, &[request, left, right], body); - let mut branch = Vec::new(); - let request = self.field(projected, self.layout.projected, 0, 0, &mut branch); - let result = self.handled(state, handler, request, sequence, &mut branch); - let handled = arm(0, branch, result); - - let mut branch = Vec::new(); - let request = self.field(projected, self.layout.projected, 1, 0, &mut branch); - let request = self.node(self.layout.computation, 1, vec![request], &mut branch); - let continuation = self.closure( - self.functions.forward, - self.layout.continuation, - vec![ - state, - handler, - project, - inject, - sequence, - self.boundary.unwrap(), - ], - &mut branch, - ); - let result = self.node( - self.layout.computation, - 2, - vec![request, continuation], - &mut branch, - ); - let forwarded = arm(1, branch, result); - self.switch( - projected, - self.layout.projected, - vec![handled, forwarded], - body, - ) - } - - fn handled( - &mut self, - state: ValueId, - handler: ValueId, - request: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let continuation = self.closure( - self.functions.resume, - self.layout.continuation, - vec![sequence, self.boundary.unwrap()], - body, - ); - let pair = self.apply(handler, &[state, request, continuation], body); - let next_state = self.pair_field(pair, 0, body); - let next = self.pair_field(pair, 1, body); - // Abandoned work is reachable only through the clause's resumption. - let empty = self.node(self.layout.sequence, 0, vec![], body); - self.recur(next_state, handler, next, empty, body) - } - - pub(super) fn forward(mut self) -> Function { - let receiver = self.lower.fresh(super::super::lambda::closure_value_type()); - let value = self.lower.fresh(erased_shape()); - let mut body = Vec::new(); - let mut fields = (0..4) - .map(|index| self.capture(receiver, index, &mut body)) - .collect::>(); - let saved = self.capture(receiver, 4, &mut body); - let boundary = self.capture(receiver, 5, &mut body); - self.check_boundary(boundary, &mut body); - let resumed = self.node( - self.layout.computation, - 3, - vec![value, saved, boundary], - &mut body, - ); - fields.push(resumed); - fields.push(boundary); - let result = self.node(self.layout.computation, 5, fields, &mut body); - let symbol = self.functions.forward; - self.finish( - symbol, - "control_forward", - vec![receiver, value], - body, - result, - ) - } - - pub(super) fn selector(mut self, case: u32, symbol: SymbolId) -> Function { - let receiver = self.lower.fresh(super::super::lambda::closure_value_type()); - let value = self.lower.fresh(erased_shape()); - let mut body = Vec::new(); - let result = self.node(self.layout.projected, case, vec![value], &mut body); - self.finish( - symbol, - "control_project", - vec![receiver, value], - body, - result, - ) - } -} diff --git a/crates/psrs-backend/src/cc/lower/control/replay.rs b/crates/psrs-backend/src/cc/lower/control/replay.rs new file mode 100644 index 00000000..b472a662 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/replay.rs @@ -0,0 +1,135 @@ +//! Instantiate lifecycle frames when replaying a persistent source checkpoint. +//! Ordinary callbacks and one-shot owner objects are shared, never cloned. + +use super::builder::Machine; +use super::executor::arm; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, AssignmentKind, Function, ValueId}; + +impl Machine<'_> { + /// Flatten into a reversed heap sequence with an explicit traversal stack. + pub(super) fn clone_sequence(mut self) -> Function { + let queue = self.lower.fresh(erased_shape()); + let todo = self.lower.fresh(erased_shape()); + let reversed = self.lower.fresh(erased_shape()); + let active = self.lower.fresh(erased_shape()); + let parent = self.lower.fresh(erased_shape()); + let mut cases = Vec::new(); + let mut body = Vec::new(); + let mut empty_cases = Vec::new(); + for tag in 0..4 { + let mut branch = Vec::new(); + let result = if tag == 0 { + self.replay_call( + self.functions.rebuild_sequence, + vec![reversed, todo, active, parent], + &mut branch, + ) + } else { + // The traversal stack is built exclusively from Append nodes. + if tag == 2 { + let next = self.field(todo, self.layout.sequence, 2, 0, &mut branch); + let rest = self.field(todo, self.layout.sequence, 2, 1, &mut branch); + self.replay_call( + self.functions.clone_sequence, + vec![next, rest, reversed, active, parent], + &mut branch, + ) + } else { + self.emit(erased_shape(), &mut branch, |_| AssignmentKind::Unreachable) + } + }; + empty_cases.push(arm(tag, branch, result)); + } + let result = self.switch(todo, self.layout.sequence, empty_cases, &mut body); + cases.push(arm(0, body, result)); + for tag in [1, 2, 3] { + let mut branch = Vec::new(); + let (next, todo, reversed) = if tag == 2 { + let left = self.field(queue, self.layout.sequence, 2, 0, &mut branch); + let right = self.field(queue, self.layout.sequence, 2, 1, &mut branch); + let todo = self.node(self.layout.sequence, 2, vec![right, todo], &mut branch); + (left, todo, reversed) + } else { + let payload = self.field(queue, self.layout.sequence, tag, 0, &mut branch); + let rest = self.field(queue, self.layout.sequence, tag, 1, &mut branch); + let fields = if tag == 1 { + vec![payload, reversed] + } else { + self.check_boundary(payload, &mut branch); + vec![payload, reversed, parent] + }; + let reversed = self.node(self.layout.sequence, tag, fields, &mut branch); + (rest, todo, reversed) + }; + let result = self.replay_call( + self.functions.clone_sequence, + vec![next, todo, reversed, active, parent], + &mut branch, + ); + cases.push(arm(tag as i32, branch, result)); + } + let mut body = Vec::new(); + let result = self.switch(queue, self.layout.sequence, cases, &mut body); + let symbol = self.functions.clone_sequence; + self.finish( + symbol, + "control_clone_sequence", + vec![queue, todo, reversed, active, parent], + body, + result, + ) + } + + /// Rebuild from the outside inward, giving each finish a fresh child extent. + pub(super) fn rebuild_sequence(mut self) -> Function { + let reversed = self.lower.fresh(erased_shape()); + let result_queue = self.lower.fresh(erased_shape()); + let active = self.lower.fresh(erased_shape()); + let parent = self.lower.fresh(erased_shape()); + let mut cases = Vec::new(); + let mut branch = Vec::new(); + let result = self.pair(result_queue, active, &mut branch); + cases.push(arm(0, branch, result)); + for tag in [1, 3] { + let mut branch = Vec::new(); + let payload = self.field(reversed, self.layout.sequence, tag, 0, &mut branch); + let rest = self.field(reversed, self.layout.sequence, tag, 1, &mut branch); + let (fields, active) = if tag == 1 { + (vec![payload, result_queue], active) + } else { + let extent = self.new_boundary(Some(parent), &mut branch); + (vec![extent, result_queue, active], extent) + }; + let next = self.node(self.layout.sequence, tag, fields, &mut branch); + let result = self.replay_call( + self.functions.rebuild_sequence, + vec![rest, next, active, if tag == 3 { active } else { parent }], + &mut branch, + ); + cases.push(arm(tag as i32, branch, result)); + } + let mut body = Vec::new(); + let result = self.switch(reversed, self.layout.sequence, cases, &mut body); + let symbol = self.functions.rebuild_sequence; + self.finish( + symbol, + "control_rebuild_sequence", + vec![reversed, result_queue, active, parent], + body, + result, + ) + } + + fn replay_call( + &mut self, + function: psrs_hir::SymbolId, + arguments: Vec, + body: &mut Vec, + ) -> ValueId { + self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { + function, + arguments, + }) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/scope.rs b/crates/psrs-backend/src/cc/lower/control/scope.rs new file mode 100644 index 00000000..a4c8bf87 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/scope.rs @@ -0,0 +1,182 @@ +//! Source dispatch and target lifetime are separate heap contexts. + +use super::builder::Machine; +use super::executor::arm; +use crate::cc::{Assignment, ValueId}; + +impl Machine<'_> { + pub(super) fn dispatch_boundary(&mut self, body: &mut Vec) -> ValueId { + let context = self.context.unwrap(); + let mut cases = Vec::new(); + for tag in 0..2 { + let mut branch = Vec::new(); + let index = if tag == 0 { 0 } else { 5 }; + let extent = self.field(context, self.layout.context, tag, index, &mut branch); + cases.push(arm(tag as i32, branch, extent)); + } + self.switch(context, self.layout.context, cases, body) + } + + pub(super) fn enter_handle( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let ret = self.field(computation, self.layout.computation, 4, 0, body); + let op = self.field(computation, self.layout.computation, 4, 1, body); + let inner = self.field(computation, self.layout.computation, 4, 2, body); + let caller = self.context.unwrap(); + let parent = self.boundary.unwrap(); + let mut cases = Vec::new(); + for tag in 0..4 { + let mut branch = Vec::new(); + if tag == 2 { + let result = + self.normalize_handle_queue(state, handler, computation, sequence, &mut branch); + cases.push(arm(tag, branch, result)); + continue; + } + // A leading compiler finish marker has the same checked target + // answer boundary as this tail-returned Handle. Share that extent + // and remove its duplicate finish; no user continuation is skipped. + let (saved, parent, extent) = if tag == 3 { + let extent = self.field(sequence, self.layout.sequence, 3, 0, &mut branch); + let saved = self.field(sequence, self.layout.sequence, 3, 1, &mut branch); + let parent = self.field(sequence, self.layout.sequence, 3, 2, &mut branch); + (saved, parent, extent) + } else { + let extent = self.new_boundary(Some(parent), &mut branch); + (sequence, parent, extent) + }; + let context = self.node( + self.layout.context, + 1, + vec![ret, op, saved, parent, caller, extent], + &mut branch, + ); + let empty = self.node(self.layout.sequence, 0, vec![], &mut branch); + let old_context = self.context.replace(context); + let old_boundary = self.boundary.replace(extent); + let result = self.recur(state, handler, inner, empty, &mut branch); + self.context = old_context; + self.boundary = old_boundary; + cases.push(arm(tag, branch, result)); + } + self.switch(sequence, self.layout.sequence, cases, body) + } + + fn normalize_handle_queue( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let left = self.field(sequence, self.layout.sequence, 2, 0, body); + let right = self.field(sequence, self.layout.sequence, 2, 1, body); + let mut cases = Vec::new(); + for tag in 0..4 { + let mut branch = Vec::new(); + let pending = if tag == 0 { + right + } else { + let head = self.field(left, self.layout.sequence, tag, 0, &mut branch); + let rest = self.field(left, self.layout.sequence, tag, 1, &mut branch); + let rest = self.node(self.layout.sequence, 2, vec![rest, right], &mut branch); + let mut fields = vec![head, rest]; + if tag == 3 { + fields.push(self.field(left, self.layout.sequence, tag, 2, &mut branch)); + } + self.node(self.layout.sequence, tag, fields, &mut branch) + }; + let result = self.recur(state, handler, computation, pending, &mut branch); + cases.push(arm(tag as i32, branch, result)); + } + self.switch(left, self.layout.sequence, cases, body) + } + + pub(super) fn finish_source( + &mut self, + state: ValueId, + handler: ValueId, + value: ValueId, + body: &mut Vec, + ) -> ValueId { + let context = self.context.unwrap(); + let mut branch = Vec::new(); + let result = self.pair(state, value, &mut branch); + let root = arm(0, branch, result); + let mut branch = Vec::new(); + let ret = self.field(context, self.layout.context, 1, 0, &mut branch); + let target = self.apply(ret, &[value], &mut branch); + let result = self.enter_target(state, handler, target, &mut branch); + self.switch( + context, + self.layout.context, + vec![root, arm(1, branch, result)], + body, + ) + } + + fn enter_target( + &mut self, + state: ValueId, + handler: ValueId, + target: ValueId, + body: &mut Vec, + ) -> ValueId { + let context = self.context.unwrap(); + let saved = self.field(context, self.layout.context, 1, 2, body); + let parent = self.field(context, self.layout.context, 1, 3, body); + let caller = self.field(context, self.layout.context, 1, 4, body); + let extent = self.field(context, self.layout.context, 1, 5, body); + let finish = self.node(self.layout.sequence, 3, vec![extent, saved, parent], body); + let old_context = self.context.replace(caller); + let old_boundary = self.boundary.replace(extent); + let result = self.recur(state, handler, target, finish, body); + self.context = old_context; + self.boundary = old_boundary; + result + } + + pub(super) fn requested( + &mut self, + state: ValueId, + handler: ValueId, + computation: ValueId, + sequence: ValueId, + body: &mut Vec, + ) -> ValueId { + let request = self.field(computation, self.layout.computation, 1, 0, body); + let context = self.context.unwrap(); + let mut cases = Vec::new(); + for tag in 0..2 { + let mut branch = Vec::new(); + let index = if tag == 0 { 0 } else { 5 }; + let extent = self.field(context, self.layout.context, tag, index, &mut branch); + let continuation = self.closure( + self.functions.resume, + self.layout.continuation, + vec![sequence, extent], + &mut branch, + ); + let result = if tag == 0 { + let pair = self.apply(handler, &[state, request, continuation], &mut branch); + let next_state = self.pair_field(pair, 0, &mut branch); + let next = self.pair_field(pair, 1, &mut branch); + let empty = self.node(self.layout.sequence, 0, vec![], &mut branch); + self.recur(next_state, handler, next, empty, &mut branch) + } else { + let op = self.field(context, self.layout.context, 1, 1, &mut branch); + let target = self.apply(op, &[request, continuation], &mut branch); + self.enter_target(state, handler, target, &mut branch) + }; + cases.push(arm(tag as i32, branch, result)); + } + self.switch(context, self.layout.context, cases, body) + } +} diff --git a/crates/psrs-core/src/tests/control.rs b/crates/psrs-core/src/tests/control.rs new file mode 100644 index 00000000..4f736511 --- /dev/null +++ b/crates/psrs-core/src/tests/control.rs @@ -0,0 +1,113 @@ +//! Malformed control calls must fail before their domains are erased. +use super::*; + +fn append(types: &mut Vec, ty: Type) -> TypeId { + let id = TypeId(types.len() as u32); + types.push(ty); + id +} + +fn application(types: &mut Vec, head: TypeId, argument: TypeId) -> TypeId { + append(types, Type::Application(head, argument)) +} + +fn fixture(wrong_raw: bool, wrong_target: bool) -> Module { + let variable = psrs_hir::TypeVariableId(42); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Boolean), + Type::Constructor(TypeConstructor::User(psrs_hir::TypeId::CONTROL)), + Type::Constructor(TypeConstructor::User(psrs_hir::TypeId::new(ModuleId(0), 7))), + Type::Constructor(TypeConstructor::User(psrs_hir::TypeId::new(ModuleId(0), 8))), + Type::Variable(variable), + ]; + let head = application(&mut types, TypeId(2), TypeId(3)); + let source = application(&mut types, head, TypeId(0)); + let head = application(&mut types, TypeId(2), TypeId(4)); + let target = application(&mut types, head, TypeId(1)); + let ret = arrow_type(&mut types, TypeId(0), target); + let request = application(&mut types, TypeId(3), TypeId(5)); + let raw = arrow_type( + &mut types, + if wrong_raw { TypeId(1) } else { TypeId(5) }, + source, + ); + let result = if wrong_target { source } else { target }; + let op = arrow_type(&mut types, raw, result); + let op = arrow_type(&mut types, request, op); + let op = append( + &mut types, + Type::ForAll { + variables: vec![variable], + body: op, + }, + ); + let trap = |ty| Expr { + kind: ExprKind::Trap, + ty, + span: TextRange::new(3, 9), + }; + single_declaration( + types, + target, + Expr { + kind: ExprKind::IntrinsicCall { + intrinsic: Intrinsic::ControlHandle, + arguments: vec![trap(ret), trap(op), trap(source)], + }, + ty: target, + span: TextRange::new(3, 9), + }, + ) +} + +#[test] +fn verifier_accepts_distinct_control_source_and_target_answers() { + fixture(false, false).verify().unwrap(); +} + +#[test] +fn verifier_rejects_control_domain_and_raw_answer_mismatches() { + for (raw, target) in [(true, false), (false, true)] { + let errors = fixture(raw, target).verify().unwrap_err(); + assert!(errors.iter().any(|error| error.message + == "control handle clauses do not preserve their checked source and target contracts")); + assert!(errors.iter().all(|error| error.module == ModuleId(0))); + } +} + +#[test] +fn verifier_rejects_old_control_arity_without_indexing_invalid_arguments() { + for count in [0, 1, 2, 4, 5] { + let mut module = fixture(false, false); + let ExprKind::IntrinsicCall { arguments, .. } = &mut module.declarations[0].value.kind + else { + unreachable!() + }; + arguments.resize(count, arguments[0].clone()); + assert!(has_message( + &module, + "intrinsic call does not have its registered saturated arity" + )); + } +} + +#[test] +fn verifier_rejects_a_forged_source_payload_at_the_common_constructor() { + let mut module = fixture(false, false); + let ExprKind::IntrinsicCall { arguments, .. } = &mut module.declarations[0].value.kind else { + unreachable!() + }; + arguments[2].kind = ExprKind::IntrinsicCall { + intrinsic: Intrinsic::ControlReturn, + arguments: vec![Expr { + kind: ExprKind::Boolean(true), + ty: TypeId(1), + span: TextRange::new(3, 9), + }], + }; + assert!(has_message( + &module, + "control primitive does not preserve its checked carrier and callable contracts" + )); +} diff --git a/crates/psrs-core/src/tests/mod.rs b/crates/psrs-core/src/tests/mod.rs index c47a7381..0a8bf56f 100644 --- a/crates/psrs-core/src/tests/mod.rs +++ b/crates/psrs-core/src/tests/mod.rs @@ -1,6 +1,7 @@ use super::*; use psrs_hir::{Intrinsic, LocalId, ModuleId, SymbolId}; +mod control; mod deep_expr; mod external_types; mod instantiation; diff --git a/crates/psrs-core/src/verify/expr/control.rs b/crates/psrs-core/src/verify/expr/control.rs new file mode 100644 index 00000000..a4bb8bcc --- /dev/null +++ b/crates/psrs-core/src/verify/expr/control.rs @@ -0,0 +1,222 @@ +//! Verify the typed source/target boundary before control payloads are erased. +use super::{Context, error, viewed}; +use crate::{Expr, Module, Type, TypeConstructor, TypeId}; + +fn carrier_parts( + module: &Module, + id: TypeId, + carrier: psrs_hir::TypeId, + count: usize, +) -> Option> { + let (_, mut id) = crate::scheme_parts(&module.types, id)?; + let mut arguments = Vec::new(); + while let Some(Type::Application(head, argument)) = module.types.get(id.0 as usize) { + if arguments.len() >= count { + return None; + } + arguments.push(*argument); + id = *head; + } + if arguments.len() != count + || !matches!(module.types.get(id.0 as usize), + Some(Type::Constructor(TypeConstructor::User(actual))) if *actual == carrier) + { + return None; + } + arguments.reverse(); + Some(arguments) +} + +fn control_parts(module: &Module, id: TypeId) -> Option<(TypeId, TypeId)> { + let parts = carrier_parts(module, id, psrs_hir::TypeId::CONTROL, 2)?; + Some((parts[0], parts[1])) +} + +fn pair_parts(module: &Module, id: TypeId) -> Option<(TypeId, TypeId)> { + let fields = module.record_fields(id)?; + if fields.len() != 2 { + return None; + } + Some(( + fields.iter().find(|(label, _)| label == "_1")?.1, + fields.iter().find(|(label, _)| label == "_2")?.1, + )) +} + +fn call(module: &Module, id: TypeId, count: usize) -> Option<(Vec, TypeId)> { + let (parameters, result) = crate::call_parts(&module.types, id).ok()?; + (parameters.len() == count).then_some((parameters, result)) +} + +fn request_parts(module: &Module, clause: TypeId, request: TypeId) -> Option<(TypeId, TypeId)> { + let (variables, _) = crate::scheme_parts(&module.types, clause)?; + let Type::Application(functor, answer) = module.types.get(request.0 as usize)? else { + return None; + }; + let Type::Variable(variable) = module.types.get(answer.0 as usize)? else { + return None; + }; + (variables.len() == 1 && variables.contains(variable)).then_some((*functor, *answer)) +} + +impl Context<'_> { + pub(super) fn verify_control( + &mut self, + expression: &Expr, + intrinsic: psrs_hir::Intrinsic, + arguments: &[Expr], + ) { + if intrinsic == psrs_hir::Intrinsic::ControlHandle { + return self.verify_control_handle(expression, arguments); + } + for argument in arguments { + self.expr(argument, None); + } + let ids = std::iter::once(expression.ty) + .chain(arguments.iter().map(|a| a.ty)) + .collect::>(); + let module = viewed(self.module, self.source, &ids); + let equal = |a, b| super::super::types::equivalent_types(a, b, module); + let valid = (|| { + use psrs_hir::Intrinsic::*; + let args = arguments.iter().map(|a| a.ty).collect::>(); + match intrinsic { + ControlReturn => { + let (_, answer) = control_parts(module, expression.ty)?; + equal(args[0], answer).then_some(()) + } + ControlPerform => { + let (functor, answer) = control_parts(module, expression.ty)?; + let Type::Application(f, a) = module.types.get(args[0].0 as usize)? else { + return None; + }; + (equal(*f, functor) && equal(*a, answer)).then_some(()) + } + ControlBind => { + let (source, answer) = control_parts(module, args[0])?; + let (target, _) = control_parts(module, expression.ty)?; + let (params, result) = call(module, args[1], 1)?; + (equal(source, target) + && equal(params[0], answer) + && equal(result, expression.ty)) + .then_some(()) + } + ControlRun => { + let (functor, answer) = control_parts(module, args[2])?; + let (params, result) = call(module, args[1], 3)?; + let (request, x) = request_parts(module, args[1], params[1])?; + let (raw, source) = call(module, params[2], 1)?; + let (state, next) = pair_parts(module, result)?; + let (out_state, out_answer) = pair_parts(module, expression.ty)?; + (equal(params[0], args[0]) + && equal(request, functor) + && equal(raw[0], x) + && equal(source, args[2]) + && equal(state, args[0]) + && equal(next, args[2]) + && equal(out_state, args[0]) + && equal(out_answer, answer)) + .then_some(()) + } + ControlOnce => { + let owner = + carrier_parts(module, expression.ty, psrs_hir::TypeId::RESUMPTION, 3)?; + let (params, result) = call(module, args[0], 1)?; + let (functor, answer) = control_parts(module, result)?; + (equal(params[0], owner[1]) + && equal(functor, owner[0]) + && equal(answer, owner[2])) + .then_some(()) + } + ControlResume => { + let owner = carrier_parts(module, args[0], psrs_hir::TypeId::RESUMPTION, 3)?; + let (functor, answer) = control_parts(module, expression.ty)?; + (equal(args[1], owner[1]) + && equal(functor, owner[0]) + && equal(answer, owner[2])) + .then_some(()) + } + ControlCancel => { + carrier_parts(module, args[0], psrs_hir::TypeId::RESUMPTION, 3)?; + matches!( + module.types.get(expression.ty.0 as usize), + Some(Type::Constructor(TypeConstructor::Unit)) + ) + .then_some(()) + } + _ => None, + } + })() + .is_some(); + if !valid { + self.errors.push(error( + self.owner, + expression.span, + "control primitive does not preserve its checked carrier and callable contracts", + )); + } + } + + pub(super) fn verify_control_handle(&mut self, expression: &Expr, arguments: &[Expr]) { + for argument in arguments { + self.expr(argument, None); + } + let module = viewed( + self.module, + self.source, + &[ + expression.ty, + arguments[0].ty, + arguments[1].ty, + arguments[2].ty, + ], + ); + let valid = (|| { + let (source_request, source_answer) = control_parts(module, arguments[2].ty)?; + control_parts(module, expression.ty)?; + let (ret_parameters, ret_result) = + crate::call_parts(&module.types, arguments[0].ty).ok()?; + if ret_parameters.len() != 1 { + return None; + } + let (variables, body) = crate::scheme_parts(&module.types, arguments[1].ty)?; + let (parameters, result) = crate::call_parts(&module.types, body).ok()?; + if variables.len() != 1 || parameters.len() != 2 { + return None; + } + let Type::Application(request, answer) = module.types.get(parameters[0].0 as usize)? + else { + return None; + }; + let Type::Variable(variable) = module.types.get(answer.0 as usize)? else { + return None; + }; + if !variables.contains(variable) { + return None; + } + let (raw_parameters, raw_result) = + crate::call_parts(&module.types, parameters[1]).ok()?; + if raw_parameters.len() != 1 { + return None; + } + // Use the checking owner's single rigid relation for all repeated + // positions. Quantified answer variables must remain the same. + let equal = |a, b| super::super::types::equivalent_types(a, b, module); + (equal(ret_parameters[0], source_answer) + && equal(ret_result, expression.ty) + && equal(*request, source_request) + && equal(raw_parameters[0], *answer) + && equal(raw_result, arguments[2].ty) + && equal(result, expression.ty)) + .then_some(()) + })() + .is_some(); + if !valid { + self.errors.push(error( + self.owner, + expression.span, + "control handle clauses do not preserve their checked source and target contracts", + )); + } + } +} diff --git a/crates/psrs-core/src/verify/expr/intrinsic.rs b/crates/psrs-core/src/verify/expr/intrinsic.rs index 92b3da9c..d33b81be 100644 --- a/crates/psrs-core/src/verify/expr/intrinsic.rs +++ b/crates/psrs-core/src/verify/expr/intrinsic.rs @@ -18,7 +18,21 @@ impl Context<'_> { intrinsic: Intrinsic, arguments: &[Expr], ) { + if arguments.len() != intrinsic.descriptor().arity as usize { + self.errors.push(error( + self.owner, + expression.span, + "intrinsic call does not have its registered saturated arity", + )); + for argument in arguments { + self.expr(argument, None); + } + return; + } match intrinsic { + intrinsic if intrinsic.descriptor().category == IntrinsicCategory::Control => { + self.verify_control(expression, intrinsic, arguments) + } Intrinsic::ArrayLength => self.verify_array_length(expression, &arguments[0]), Intrinsic::ArrayIndex => { self.verify_array_index(expression, &arguments[0], &arguments[1]) diff --git a/crates/psrs-core/src/verify/expr/mod.rs b/crates/psrs-core/src/verify/expr/mod.rs index b01039f9..01403af2 100644 --- a/crates/psrs-core/src/verify/expr/mod.rs +++ b/crates/psrs-core/src/verify/expr/mod.rs @@ -7,6 +7,7 @@ use psrs_hir::{ModuleId, SymbolId}; use std::collections::HashMap; mod arrays; +mod control; mod entry; mod helpers; mod intrinsic; diff --git a/crates/psrs-driver/src/prelude/package.rs b/crates/psrs-driver/src/prelude/package.rs index 3dcc5906..ba881a2a 100644 --- a/crates/psrs-driver/src/prelude/package.rs +++ b/crates/psrs-driver/src/prelude/package.rs @@ -95,6 +95,17 @@ fn inspect(root: &Path, revision: Option) -> Result F x -> (x -> C.Control U Int) -> { _1 :: Saved, _2 : inner s (F k) cont = { _1: { saved: \n -> cont (k n) }, _2: C.return 42 } outer :: forall x. Int -> G x -> (x -> C.Control G { _1 :: Saved, _2 :: Int }) -> { _1 :: Int, _2 :: C.Control G { _1 :: Saved, _2 :: Int } } outer s (G k) cont = { _1: s, _2: cont (k 0) } -handled = C.handle { saved: \n -> C.return n } inner project UG (C.perform (UF (F \x -> x))) +handled = foldOpen { saved: \n -> C.return n } inner project UG (C.perform (UF (F \x -> x))) result = C.run 0 outer handled main :: Int main = result._2._2 @@ -72,13 +72,13 @@ main = result._2._2 #[test] fn rejects_a_completed_open_delimiter_while_its_outer_delimiter_is_live() { - let text = OPEN.replace("result = C.run 0 outer handled", r"result = C.run 0 outer (C.bind handled (\pair -> C.handle pair._1 inner project UG (pair._1.saved 42)))"); + let text = OPEN.replace("result = C.run 0 outer handled", r"result = C.run 0 outer (C.bind handled (\pair -> foldOpen pair._1 inner project UG (pair._1.saved 42)))"); execute("expired-open-live-outer", &text, 134); } #[test] fn rejects_an_open_resumption_after_the_outer_run_returns() { - let text = OPEN.replace("main = result._2._2", "main = (C.run 0 outer (C.handle result._2._1 inner project UG (result._2._1.saved 42)))._2._2"); + let text = OPEN.replace("main = result._2._2", "main = (C.run 0 outer (foldOpen result._2._1 inner project UG (result._2._1.saved 42)))._2._2"); execute("expired-open", &text, 134); } @@ -100,9 +100,9 @@ inner :: forall x. Int -> F x -> (x -> C.Control U Int) -> { _1 :: Int, _2 :: C. inner s (F k) cont = { _1: s, _2: C.perform (UG (G (\n -> cont (k n)) (\x -> x))) } outer :: forall x. Saved -> G x -> (x -> C.Control G { _1 :: Int, _2 :: Int }) -> { _1 :: Saved, _2 :: C.Control G { _1 :: Int, _2 :: Int } } outer s (G saved k) cont = { _1: { saved: saved }, _2: C.return { _1: 0, _2: 42 } } -result = C.run { saved: \n -> C.return n } outer (C.handle 0 inner project UG (C.perform (UF (F \x -> x)))) +result = C.run { saved: \n -> C.return n } outer (foldOpen 0 inner project UG (C.perform (UF (F \x -> x)))) main :: Int -main = (C.run result._1 outer (C.handle 0 inner project UG (result._1.saved 42)))._2._2 +main = (C.run result._1 outer (foldOpen 0 inner project UG (result._1.saved 42)))._2._2 "#, 134, ); diff --git a/crates/psrs-driver/tests/control_open_runtime.rs b/crates/psrs-driver/tests/control_open_runtime.rs index 5865481b..db83f1a7 100644 --- a/crates/psrs-driver/tests/control_open_runtime.rs +++ b/crates/psrs-driver/tests/control_open_runtime.rs @@ -23,7 +23,7 @@ outer s (G k) cont = {outer} program :: C.Control U Int program = {program} handled :: C.Control G {{ _1 :: Int, _2 :: Int }} -handled = C.handle 0 inner project inject program +handled = foldOpen 0 inner project inject program result :: {{ _1 :: Int, _2 :: {{ _1 :: Int, _2 :: Int }} }} result = C.run 0 outer handled main :: Int @@ -196,7 +196,7 @@ handlerH :: forall x. Int -> H x -> (x -> C.Control H { _1 :: Int, _2 :: { _1 :: handlerH s (H k) cont = { _1: intAdd s 1, _2: cont (k s) } program :: C.Control U Int program = C.bind (C.perform (UF (F \x -> x))) (\a -> C.bind (C.perform (UG (G \x -> x))) (\b -> C.bind (C.perform (UH (H \x -> x))) (\c -> C.bind (C.perform (UF (F \x -> x))) (\d -> C.return (intAdd a (intAdd b (intAdd c d))))))) -result = C.run 30 handlerH (C.handle 10 handlerG projectG VH (C.handle 0 handlerF projectF injectF program)) +result = C.run 30 handlerH (foldOpen 10 handlerG projectG VH (foldOpen 0 handlerF projectF injectF program)) main :: Int main = if intEq result._1 31 then if intEq result._2._1 11 then if intEq result._2._2._1 2 then intAdd result._2._2._2 1 else 1 else 1 else 1 "#, @@ -223,7 +223,7 @@ outer :: forall x. Int -> G x -> (x -> C.Control G { _1 :: { count :: Int }, _2 outer s (G k) cont = { _1: intAdd s 1, _2: cont (k { value: 39 }) } program :: C.Control U { answer :: Int } program = let captured = { offset: 2 } in C.bind (C.perform (UG (G \x -> x))) (\a -> C.bind (C.perform (UF (F \x -> x))) (\b -> C.return { answer: intAdd captured.offset (intAdd a.value b.value) })) -result = C.run 0 outer (C.handle { count: 0 } inner project UG program) +result = C.run 0 outer (foldOpen { count: 0 } inner project UG program) main :: Int main = if intEq result._1 1 then if intEq result._2._1.count 1 then result._2._2.answer else 1 else 1 "#, @@ -248,7 +248,7 @@ fn ignored_open_interpretation_retains_handler_traps() { #[test] fn open_handler_arguments_are_strict() { let text = source(MIXED, INNER, OUTER, "let unused = handled in 42") - .replace("C.handle 0", "C.handle (intQuot 1 0)"); + .replace("foldOpen 0", "foldOpen (intQuot 1 0)"); execute("open-strict", &text, 134); } @@ -281,7 +281,7 @@ noise n = if intEq n 0 then C.return 0 else C.bind (C.perform (G \x -> x)) (\_ - } #[test] -fn library_shallow_forwarding_differs_from_deep_reinstallation() { +fn library_state_fold_can_choose_when_to_forward_selected_requests() { let program = r"C.bind (C.perform (UF (F \x -> x))) (\a -> C.bind (C.perform (UF (F \x -> x))) (\b -> C.bind (C.perform (UF (F \x -> x))) (\c -> C.return (intAdd a (intAdd b c)))))"; execute( "open-deep", diff --git a/crates/psrs-driver/tests/control_scoped_replay.rs b/crates/psrs-driver/tests/control_scoped_replay.rs new file mode 100644 index 00000000..03ceb901 --- /dev/null +++ b/crates/psrs-driver/tests/control_scoped_replay.rs @@ -0,0 +1,47 @@ +//! Replay nested target finish frames without consuming suspended checkpoints. +mod control_support; +use control_support::execute; + +const SOURCE: &str = r"module Main where +import Prim.Control as C +data F x = F Int (Int -> x) +data G x = G (Int -> x) +type Answer = { saved :: Int -> C.Control F Int, built :: C.Control F Int, value :: Int } +ret :: Int -> C.Control G Answer +ret n = C.return { saved: \x -> C.return x, built: C.return n, value: n } +inner :: forall x. F x -> (x -> C.Control F Int) -> C.Control G Answer +inner (F label k) raw = if intEq label 1 + then C.bind (C.perform (G (\x -> x))) (\n -> loop (raw (k n))) + else C.return { saved: \n -> raw (k n), built: raw (k 42), value: 21 } +loop :: C.Control F Int -> C.Control G Answer +loop = C.handle ret inner +forward :: forall x. G x -> (x -> C.Control G Answer) -> C.Control G Answer +forward request raw = C.bind (C.perform request) (\answer -> wrap (raw answer)) +wrap :: C.Control G Answer -> C.Control G Answer +wrap computation = C.handle C.return forward computation +root :: forall x. Int -> G x -> (x -> C.Control G Answer) -> { _1 :: Int, _2 :: C.Control G Answer } +root s (G k) raw = { _1: s, _2: C.bind (raw (k 0)) (\a -> AFTER) } +closed :: forall x. Int -> F x -> (x -> C.Control F Int) -> { _1 :: Int, _2 :: C.Control F Int } +closed s (F label k) raw = { _1: s, _2: raw (k 42) } +program = C.bind (C.perform (F 1 (\x -> x))) (\_ -> C.perform (F 2 (\x -> x))) +main = (C.run 0 root (wrap (loop program)))._2.value +"; + +#[test] +fn two_replays_preserve_nested_suspended_source_checkpoints() { + execute("scoped-nested-replay", &SOURCE.replace("AFTER", r"C.bind (raw (k 0)) (\b -> C.return { saved: a.saved, built: a.built, value: intAdd a.value b.value })"), 42); +} + +#[test] +fn captures_created_in_a_replay_expire_at_that_branchs_completion() { + for (name, value) in [("call", "a.saved 42"), ("node", "a.built")] { + let after = format!( + "let expired = C.run 0 closed ({value}) in C.return {{ saved: a.saved, built: a.built, value: expired._2 }}" + ); + execute( + &format!("scoped-replay-expired-{name}"), + &SOURCE.replace("AFTER", &after), + 134, + ); + } +} diff --git a/crates/psrs-driver/tests/control_scoped_runtime.rs b/crates/psrs-driver/tests/control_scoped_runtime.rs new file mode 100644 index 00000000..89b77103 --- /dev/null +++ b/crates/psrs-driver/tests/control_scoped_runtime.rs @@ -0,0 +1,180 @@ +//! Contract v2: source/target scope, persistent replay and extent completion. +mod control_support; +use control_support::execute; + +const HEADER: &str = r"module Main where +import Prim.Control as C +data Op next = Op Int (Int -> next) +handleDeep :: forall u f g s a. (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) -> (forall x. s -> f x -> (s -> x -> C.Control g { _1 :: s, _2 :: a }) -> C.Control g { _1 :: s, _2 :: a }) -> s -> C.Control u a -> C.Control g { _1 :: s, _2 :: a } +handleDeep project clause state computation = C.handle + (\value -> C.return { _1: state, _2: value }) + (\request raw -> project request + (\op -> clause state op (\nextState answer -> handleDeep project clause nextState (raw answer))) + (\op -> C.bind (C.perform op) (\answer -> handleDeep project clause state (raw answer)))) + computation +handleShallow :: forall u f g s a. (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) -> (forall x. s -> f x -> (s -> x -> C.Control u { _1 :: s, _2 :: a }) -> C.Control u { _1 :: s, _2 :: a }) -> s -> C.Control u a -> C.Control u { _1 :: s, _2 :: a } +handleShallow project clause state computation = C.handle + (\value -> C.return { _1: state, _2: value }) + (\request raw -> project request + (\op -> clause state op (\nextState answer -> C.bind (raw answer) (\value -> C.return { _1: nextState, _2: value }))) + (\_ -> C.bind (C.perform request) (\answer -> handleShallow project clause state (raw answer)))) + computation +project :: forall x r. Op x -> (Op x -> r) -> (Op x -> r) -> r +project op selected residual = selected op +outer :: forall x. Int -> Op x -> (x -> C.Control Op { _1 :: Int, _2 :: Int }) -> { _1 :: Int, _2 :: C.Control Op { _1 :: Int, _2 :: Int } } +outer s (Op label k) cont = { _1: intAdd s 1, _2: cont (k 21) } +"; + +fn check(name: &str, program: &str, expected: i32) { + execute(name, &format!("{HEADER}\n{program}"), expected); +} + +#[test] +fn fresh_clause_requests_reach_the_outer_handler() { + check( + "scoped-clause", + r" +inner :: forall x. Int -> Op x -> (Int -> x -> C.Control Op { _1 :: Int, _2 :: Int }) -> C.Control Op { _1 :: Int, _2 :: Int } +inner s (Op label k) cont = C.bind (C.perform (Op 2 (\x -> x))) (\n -> cont (intAdd s 1) (k (intAdd n 21))) +result = C.run 0 outer (handleDeep project inner 0 (C.perform (Op 1 (\x -> x)))) +main = if intEq result._1 1 then if intEq result._2._1 1 then result._2._2 else 0 else 0 +", + 42, + ); +} + +#[test] +fn deep_and_shallow_have_distinct_source_resumption_scopes() { + let body = r" +inner :: forall x. Int -> Op x -> (Int -> x -> C.Control Op { _1 :: Int, _2 :: Int }) -> C.Control Op { _1 :: Int, _2 :: Int } +inner s (Op label k) cont = cont (intAdd s 1) (k 21) +program = C.bind (C.perform (Op 1 (\x -> x))) (\a -> C.bind (C.perform (Op 1 (\x -> x))) (\b -> C.return (intAdd a b))) +result = C.run 0 outer (HANDLE project inner 0 program) +main = if intEq result._1 OUTER then if intEq result._2._1 INNER then result._2._2 else 0 else 0 +"; + check( + "scoped-deep", + &body + .replace("HANDLE", "handleDeep") + .replace("OUTER", "0") + .replace("INNER", "2"), + 42, + ); + check( + "scoped-shallow", + &body + .replace("HANDLE", "handleShallow") + .replace("OUTER", "1") + .replace("INNER", "1"), + 42, + ); +} + +#[test] +fn return_clause_effects_execute_outside_source_dispatch() { + check( + "scoped-return", + r" +ret :: Int -> C.Control Op { _1 :: Int, _2 :: Int } +ret a = C.bind (C.perform (Op 2 (\x -> x))) (\b -> C.return { _1: 7, _2: intAdd a b }) +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op { _1 :: Int, _2 :: Int } +clause request raw = C.return { _1: 0, _2: intQuot 1 0 } +result = C.run 0 outer (C.handle ret clause (C.return 21)) +main = if intEq result._1 1 then result._2._2 else 0 +", + 42, + ); +} + +#[test] +fn deep_replay_keeps_independent_state_and_caller_work_outside_capture() { + check( + "scoped-replay", + r" +inner :: forall x. Int -> Op x -> (Int -> x -> C.Control Op { _1 :: Int, _2 :: Int }) -> C.Control Op { _1 :: Int, _2 :: Int } +inner s (Op label k) cont = C.bind (cont 3 (k 19)) (\a -> C.bind (cont 7 (k 21)) (\b -> C.return { _1: intAdd a._1 b._1, _2: intAdd a._2 b._2 })) +program = C.bind (C.perform (Op 1 (\x -> x))) (\a -> C.return (intAdd a 1)) +result = C.run 0 outer (C.bind (handleDeep project inner 0 program) (\pair -> C.bind (C.perform (Op 2 (\x -> x))) (\_ -> C.return pair))) +main = if intEq result._1 1 then if intEq result._2._1 10 then result._2._2 else 0 else 0 +", + 42, + ); +} + +#[test] +fn abandonment_never_executes_the_captured_source_queue() { + check( + "scoped-abandon", + r" +inner :: forall x. Int -> Op x -> (Int -> x -> C.Control Op { _1 :: Int, _2 :: Int }) -> C.Control Op { _1 :: Int, _2 :: Int } +inner s op cont = C.return { _1: 7, _2: 42 } +program = C.bind (C.perform (Op 1 (\x -> x))) (\_ -> C.return (intQuot 1 0)) +result = C.run 0 outer (handleDeep project inner 0 program) +main = if intEq result._1 0 then if intEq result._2._1 7 then result._2._2 else 0 else 0 +", + 42, + ); +} + +const ESCAPE: &str = r" +type Saved = { raw :: Int -> C.Control Op Int, built :: C.Control Op Int } +ret :: Int -> C.Control Op Saved +ret a = C.return { raw: \x -> C.return x, built: C.return a } +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Saved +clause (Op label k) raw = C.return { raw: \n -> raw (k n), built: raw (k 42) } +root :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +root s (Op label k) raw = { _1: s, _2: raw (k 42) } +handled = C.handle ret clause (C.perform (Op 1 (\x -> x))) +main = (C.run 0 root (C.bind handled (\saved -> USE)))._2 +"; + +#[test] +fn target_completion_expires_raw_continuations_while_parent_is_live() { + check( + "scoped-expired-call", + &ESCAPE.replace("USE", "saved.raw 42"), + 134, + ); + check( + "scoped-expired-node", + &ESCAPE.replace("USE", "saved.built"), + 134, + ); +} + +#[test] +fn handle_alias_and_partial_application_keep_distinct_answer_types() { + check( + "scoped-alias", + r" +eliminate :: forall u g a b. (a -> C.Control g b) -> (forall x. u x -> (x -> C.Control u a) -> C.Control g b) -> C.Control u a -> C.Control g b +eliminate = C.handle +ret :: Int -> C.Control Op Boolean +ret n = C.return (intEq n 42) +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Boolean +clause op raw = C.return false +finish :: C.Control Op Int -> C.Control Op Boolean +finish = eliminate ret clause +root :: forall x. Int -> Op x -> (x -> C.Control Op Boolean) -> { _1 :: Int, _2 :: C.Control Op Boolean } +root s (Op label k) raw = { _1: s, _2: raw (k 0) } +main = if (C.run 0 root (finish (C.return 42)))._2 then 42 else 0 +", + 42, + ); +} + +#[test] +fn long_deep_sequences_do_not_grow_the_native_stack() { + check( + "scoped-long", + r" +inner :: forall x. Int -> Op x -> (Int -> x -> C.Control Op { _1 :: Int, _2 :: Int }) -> C.Control Op { _1 :: Int, _2 :: Int } +inner s (Op label k) cont = cont (intAdd s 1) (k 0) +build :: Int -> C.Control Op Int +build n = if intEq n 0 then C.return 42 else C.bind (C.perform (Op 1 (\x -> x))) (\_ -> build (intSub n 1)) +result = C.run 0 outer (handleDeep project inner 0 (build 100000)) +main = if intEq result._2._1 100000 then result._2._2 else 0 +", + 42, + ); +} diff --git a/crates/psrs-driver/tests/control_scoped_surface.rs b/crates/psrs-driver/tests/control_scoped_surface.rs new file mode 100644 index 00000000..c6d02698 --- /dev/null +++ b/crates/psrs-driver/tests/control_scoped_surface.rs @@ -0,0 +1,79 @@ +//! Ordinary language rejection of invalid source/target elimination contracts. +const HEADER: &str = r"module Main where +import Prim.Control as C +data F x = F (Int -> x) +data G x = G (Int -> x) +data U x = UF (F x) | UG (G x) +ret :: Int -> C.Control G Boolean +ret n = C.return true +source :: C.Control U Int +source = C.return 42 +"; + +fn rejects(body: &str) { + let errors = psrs_driver::check_source("Main.purs", &format!("{HEADER}\n{body}")) + .expect_err("invalid control contract accepted"); + assert!( + errors + .iter() + .any(|error| error.code == Some("TypesDoNotUnify")), + "{errors:?}" + ); +} + +#[test] +fn rejects_source_requests_in_a_target_clause() { + rejects( + r" +clause :: forall x. U x -> (x -> C.Control U Int) -> C.Control G Boolean +clause request raw = C.bind (C.perform request) (\_ -> C.return true) +bad = C.handle ret clause source +main = 0 +", + ); +} + +#[test] +fn rejects_unrelated_raw_and_target_answers() { + rejects( + r" +clause :: forall x. U x -> (x -> C.Control U Int) -> C.Control G Boolean +clause request raw = C.bind (raw true) (\_ -> C.return true) +bad = C.handle ret clause source +main = 0 +", + ); + rejects( + r" +clause :: forall x. U x -> (x -> C.Control U Int) -> C.Control G Boolean +clause request raw = C.return 42 +bad = C.handle ret clause source +main = 0 +", + ); +} + +#[test] +fn rejects_the_previous_five_argument_handle_signature() { + rejects( + r" +old :: Int -> (forall x. Int -> F x -> (x -> C.Control U Int) -> { _1 :: Int, _2 :: C.Control U Int }) -> (forall x r. U x -> (F x -> r) -> (G x -> r) -> r) -> (forall x. G x -> U x) -> C.Control U Int -> C.Control G { _1 :: Int, _2 :: Int } +old = C.handle +main = 0 +", + ); +} + +#[test] +fn rejects_shallow_residual_effect_removal() { + rejects( + r" +shallow :: C.Control U Int -> C.Control U { value :: Int } +shallow computation = C.handle (\a -> C.return { value: a }) + (\request raw -> C.bind (C.perform request) (\answer -> C.bind (raw answer) (\a -> C.return { value: a }))) computation +bad :: C.Control G { value :: Int } +bad = shallow source +main = 0 +", + ); +} diff --git a/crates/psrs-driver/tests/control_support/mod.rs b/crates/psrs-driver/tests/control_support/mod.rs index 2138c206..52fb7f54 100644 --- a/crates/psrs-driver/tests/control_support/mod.rs +++ b/crates/psrs-driver/tests/control_support/mod.rs @@ -23,7 +23,7 @@ fn run(name: &str, source: &str, expected: i32, force_gc: bool) { eprintln!("skipping control execution: wasmtime is unavailable"); return; } - let artifact = psrs_driver::compile_source("Main.purs", source) + let artifact = psrs_driver::compile_source("Main.purs", &fold_source(source)) .unwrap_or_else(|errors| panic!("compile {name}: {errors:?}")); let path = std::env::temp_dir().join(format!("psrs-control-{name}-{}.wasm", std::process::id())); @@ -55,3 +55,24 @@ fn run(name: &str, source: &str, expected: i32, force_gc: bool) { "expected {name} to exit {expected}, got {output:?}" ); } + +/// Preserve coverage of user-defined open state folds on the revised primitive. +/// This is an ordinary library program, not a legacy compiler overload. Scoped +/// deep/shallow semantics are tested separately in control_scoped_runtime.rs. +pub fn fold_source(source: &str) -> String { + if !source.contains("foldOpen") { + return source.to_owned(); + } + format!( + "{source}\n{}", + r" +foldOpen :: forall f g u a s. s -> (forall x. s -> f x -> (x -> C.Control u a) -> { _1 :: s, _2 :: C.Control u a }) -> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) -> (forall x. g x -> u x) -> C.Control u a -> C.Control g { _1 :: s, _2 :: a } +foldOpen state clause project inject computation = C.handle + (\value -> C.return { _1: state, _2: value }) + (\request raw -> project request + (\op -> let next = clause state op raw in foldOpen next._1 clause project inject next._2) + (\op -> C.bind (C.perform op) (\answer -> foldOpen state clause project inject (raw answer)))) + computation +" + ) +} diff --git a/crates/psrs-driver/tests/control_surface.rs b/crates/psrs-driver/tests/control_surface.rs index 1190e1e3..94f69282 100644 --- a/crates/psrs-driver/tests/control_surface.rs +++ b/crates/psrs-driver/tests/control_surface.rs @@ -86,7 +86,7 @@ program :: C.Control U Int program = C.bind (C.perform (UF (F \x -> x))) \_ -> C.perform (UG (G \x -> x)) handled :: C.Control G { _1 :: Int, _2 :: Int } -handled = C.handle 0 handler project inject program +handled = foldOpen 0 handler project inject program main :: Int main = 0 @@ -135,7 +135,10 @@ fn executes_a_performed_request() { #[test] fn control_surface_handles_one_effect() { - if let Err(errors) = psrs_driver::check_source("Main.purs", HANDLES_ONE_EFFECT) { + if let Err(errors) = psrs_driver::check_source( + "Main.purs", + &control_support::fold_source(HANDLES_ONE_EFFECT), + ) { panic!("open handle rejected: {errors:?}"); } } @@ -159,23 +162,29 @@ fn control_surface_requires_a_rank_two_handler() { #[test] fn open_control_rejects_an_incompatible_residual_functor() { let source = HANDLES_ONE_EFFECT.replace("handled :: C.Control G", "handled :: C.Control F"); - assert!(psrs_driver::check_source("Main.purs", &source).is_err()); + assert!( + psrs_driver::check_source("Main.purs", &control_support::fold_source(&source)).is_err() + ); } #[test] -fn open_control_rejects_an_incompatible_injection() { +fn library_fold_rejects_an_incompatible_injection() { let source = HANDLES_ONE_EFFECT.replace( "inject :: forall x. G x -> U x\ninject = UG", "inject :: forall x. F x -> U x\ninject = UF", ); - assert!(psrs_driver::check_source("Main.purs", &source).is_err()); + assert!( + psrs_driver::check_source("Main.purs", &control_support::fold_source(&source)).is_err() + ); } #[test] -fn open_control_requires_a_rank_two_projection() { +fn library_fold_requires_a_rank_two_projection() { let source = HANDLES_ONE_EFFECT.replace( "project :: forall x r. U x -> (F x -> r) -> (G x -> r) -> r", "project :: forall r. U Int -> (F Int -> r) -> (G Int -> r) -> r", ); - assert!(psrs_driver::check_source("Main.purs", &source).is_err()); + assert!( + psrs_driver::check_source("Main.purs", &control_support::fold_source(&source)).is_err() + ); } diff --git a/crates/psrs-hir/src/intrinsic/registry.rs b/crates/psrs-hir/src/intrinsic/registry.rs index 34e8b8e9..9de21caf 100644 --- a/crates/psrs-hir/src/intrinsic/registry.rs +++ b/crates/psrs-hir/src/intrinsic/registry.rs @@ -44,7 +44,7 @@ pub enum IntrinsicCategory { /// `Prim.undefined`: a value with no runtime representation. PartialValue, /// A compiler-owned delimited-control primitive: `Control`'s - /// `return`/`bind`/`perform`/`run`. + /// construction, execution, typed elimination and explicit ownership operations. Control, } @@ -179,7 +179,7 @@ descriptors! { ControlBind => "controlBind", 2, Control, scheme::control_bind; ControlPerform => "controlPerform", 1, Control, scheme::control_perform; ControlRun => "controlRun", 3, Control, scheme::control_run; - ControlHandle => "controlHandle", 5, Control, scheme::control_handle; + ControlHandle => "controlHandle", 3, Control, scheme::control_handle; ControlOnce => "controlOnce", 1, Control, scheme::control_once; ControlResume => "controlResume", 2, Control, scheme::control_resume; ControlCancel => "controlCancel", 1, Control, scheme::control_cancel; diff --git a/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs b/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs index 77af16e7..ea69998c 100644 --- a/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs +++ b/crates/psrs-hir/src/intrinsic/registry/scheme/control.rs @@ -93,68 +93,27 @@ pub(in crate::intrinsic::registry) fn control_run() -> Type { ) } -/// `Prim.Control.handle`, the open eliminator: -/// `forall f g u a s. s` -/// `-> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a))` -/// `-> (forall x r. u x -> (f x -> r) -> (g x -> r) -> r)` (project) -/// `-> (forall x. g x -> u x)` (inject) -/// `-> Control u a -> Control g (s, a)`. +/// Eliminate a source computation into an independently typed target computation. +/// Clauses execute outside source dispatch; the raw continuation retains `u`/`a`. pub(in crate::intrinsic::registry) fn control_handle() -> Type { + let target = control(variable("g"), variable("b")); let handler = forall( &["x"], - arrow( - variable("s"), - arrow( - apply(variable("f"), variable("x")), - arrow( - arrow(variable("x"), control(variable("u"), variable("a"))), - record(&[ - ("_1", variable("s")), - ("_2", control(variable("u"), variable("a"))), - ]), - ), - ), - ), - ); - let project = forall( - &["x", "r"], arrow( apply(variable("u"), variable("x")), arrow( - arrow(apply(variable("f"), variable("x")), variable("r")), - arrow( - arrow(apply(variable("g"), variable("x")), variable("r")), - variable("r"), - ), + arrow(variable("x"), control(variable("u"), variable("a"))), + target.clone(), ), ), ); - let inject = forall( - &["x"], - arrow( - apply(variable("g"), variable("x")), - apply(variable("u"), variable("x")), - ), - ); forall( - &["f", "g", "u", "a", "s"], + &["u", "g", "a", "b"], arrow( - variable("s"), + arrow(variable("a"), target.clone()), arrow( handler, - arrow( - project, - arrow( - inject, - arrow( - control(variable("u"), variable("a")), - control( - variable("g"), - record(&[("_1", variable("s")), ("_2", variable("a"))]), - ), - ), - ), - ), + arrow(control(variable("u"), variable("a")), target), ), ), ) diff --git a/docs/decision/DEC-19-compiler-generated-resumable-frames.md b/docs/decision/DEC-19-compiler-generated-resumable-frames.md index 23b6fa3a..64e0d0ae 100644 --- a/docs/decision/DEC-19-compiler-generated-resumable-frames.md +++ b/docs/decision/DEC-19-compiler-generated-resumable-frames.md @@ -21,8 +21,11 @@ A library-only encoding over a free/freer monad is portable and needs no compile change, but it forces every effectful computation through an explicit monadic value and depends on library trampolining for stack safety. A generic mechanism that can suspend a computation and capture the remainder — delimited control — -gives the direct style users expect while keeping every concrete operation, row, -and handler in library code. +provides compiler-owned continuation sequencing while keeping every concrete +operation, row, and handler in library code. The selected `Control` surface is +monadic; it does not provide direct-style syntax or capture arbitrary pure calls. +[DEC-20](DEC-20-typed-control-elimination.md) clarifies its typed elimination and +clause-scope contract. Delimited control has exactly two viable implementations on this target: @@ -82,9 +85,9 @@ perform. behind an explicit profile revision. - **Library-only free monad (retained as the portable baseline, not sufficient alone).** It needs no compiler change and remains valid for pure handlers, but - it is not direct style and gives no generic interruption mechanism for code not - written in the monad; its stack safety is a library trampoline, not a compiler - guarantee. + its stack safety is a library trampoline, not a compiler guarantee. + The selected compiler surface also uses explicit monadic computations; arbitrary + non-monadic interruption is not established by this decision. - **Host-imported stack capture (rejected as impossible).** A Wasm import cannot capture its caller's execution stack. - **A compiler-native effect system (rejected, unchanged from DEC-03).** Adding diff --git a/docs/decision/DEC-20-typed-control-elimination.md b/docs/decision/DEC-20-typed-control-elimination.md new file mode 100644 index 00000000..258a0594 --- /dev/null +++ b/docs/decision/DEC-20-typed-control-elimination.md @@ -0,0 +1,49 @@ +# DEC-20 — Typed Source-to-Target Control Elimination + +**Status:** Accepted +**Date:** 2026-10-11 +**Clarifies:** [DEC-19](DEC-19-compiler-generated-resumable-frames.md) +**Governed by:** [F-02](../feature/F-02-portable-programs.md) and +[control elimination and handler scopes](../design/backend/fp/control-elimination-and-handler-scopes.md). + +## Context and constraints + +The draft five-argument `handle` is an open state fold: its clause returns a +source computation, which the driver interprets under the same handler. That +cannot implement fresh clause requests outside the handler while preserving its +source and target types. The retained ClauseScope program exposes the mismatch. +The design also promises library-selectable deep/shallow handlers, multi-shot +replay, delimiter expiry and a flat guest machine. A dispatch patch or mode flag +cannot repair the missing target-answer contract. + +## Decision + +Generalize the existing `Prim.Control.handle` to take a return clause, a rank-2 +operation clause, and a source computation. Its raw continuation returns the +original source computation; both clauses return a distinct target computation. +No new intrinsic is added. State and union projection are ordinary library +closures; deep code reinstalls `handle`, shallow code uses the raw remainder. +Shallow output retains the source effect collection unless library code explicitly +transforms it. The existing `run` remains a separate closed state fold. + +Source dispatch ends before clause execution. Its lifetime extent remains live +until the target answer finishes. Explicit heap contexts preserve this distinction, +caller capture boundaries, and replay activation identities. Tail finalization +coalescing may preserve common completion boundaries but cannot erase independently +observable expiry. The software-frame architecture and target profile of DEC-19 +remain unchanged; the selected source surface is monadic, not direct style. + +## Consequences + +This revises an unpublished draft API: `ControlHandle` keeps identity 96, but its +checked scheme and arity change. Compiler registry, verification, layouts, lowering, +independent package and acceptance cases require a coherent migration and explicit +artifact/package compatibility invalidation. Existing v1 execution evidence is +retained as historical evidence and cannot certify v2 scope semantics. + +Library expressibility is supported by official ordinary-language type checking +and a rewrite model; lifetime, GC, native stack and foreign cleanup still require +real target execution. The full contract is in the linked design; the +[checklist](../implementation/backend/algebraic-effects.md) records migration and +remaining verification. This decision does not add frontend effect typing or +claim acceptance of the upstream Run library. diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 5f4b050f..cbbe200b 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight `Prim.Control` primitives lower to persistent frames and shared closed/open executors. Mandatory Wasmtime evidence covers bind/request stack safety, open residual forwarding, nested handlers, abandonment, multi-shot replay, aggregate captures and GC during suspension. One-shot ownership/cancellation and delimiter-liveness checks have focused execution evidence. Complete frame verification, foreign capture boundaries and official library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index 98ce6511..8a6b5a49 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -196,7 +196,11 @@ Deep and shallow are properties of a handler and are not part of the control surface. A deep State handler carries its state value forward and reinstalls itself around the continuation, so later requests at the same slot are handled again; a shallow handler returns control outside the delimiter after the current request. -The library chooses by how it calls the continuation inside its `run` handler. +The library chooses by wrapping the raw source continuation in a new `handle` +(deep) or using it directly (shallow). Fresh clause requests run outside the source +handler in its target domain. A shallow result retains the source effects unless +library code explicitly transforms them; removing a slot from its type would not +be justified merely by handling its first request. A handler that does not handle a request forwards it, and the residual row describes exactly what remains. A pure handler collects or discards a slot for testing; a @@ -211,7 +215,7 @@ the [native Effect/ST topic](native-effect-and-st-handlers.md). | --- | --- | | Type system | Ordinary kinds, rows, class evidence, quantifiers, roles, constructor visibility, and applicable region constraints. No effect rows or handlers. | | Library | Operation signatures and functors, computation construction, handler interpretation, residual rows, continuation composition, and the one-shot/multi-shot API choice. | -| Compiler | The effect-agnostic `Control f a` carrier, `return`/`bind`/`perform`/`run`, and the selective CPS/defunctionalization lowering — owned by [delimited control and resumable frames](delimited-control-and-resumable-frames.md). | +| Compiler | The effect-agnostic `Control f a` carrier, `return`/`bind`/`perform`/`run`/`handle` plus ownership operations, and the selective CPS/defunctionalization lowering — owned by [delimited control and resumable frames](delimited-control-and-resumable-frames.md). | | Runtime | Real IO/storage primitives; an optional trampoline or driver; if separately adopted, target stack switching and native resumption lifetime checks. | No pass discovers an operation by the spelling `State`, `Console`, `Run`, or @@ -221,7 +225,7 @@ representation, and CFG verification remain required. ### The library on the control surface The library builds on the compiler's surface — `Control f a` with `return`/`bind`/ -`perform`/`run`, specified in +`perform`/`run`/`handle`, specified in [delimited control and resumable frames](delimited-control-and-resumable-frames.md). It defines its computation as that carrier over an operation functor: @@ -236,11 +240,12 @@ get :: forall s r. Run (state :: StateF s | r) s get = perform (inj (StateF (Get identity))) -- schematic; the library owns inj ``` -A handler is `run`'s rank-2 argument: it receives the handler state, the request, and -the continuation, and returns the next state together with the next computation, -deciding to resume, abort, or replay. Deep semantics is the library re-entering `run` -when it forwards a request it does not handle; the compiler does not decide -deep/shallow. +A scoped handler uses `handle`'s return and rank-2 operation clauses. The raw +continuation has source domain `Control u a`; both clauses return target domain +`Control g b`. State, union projection and deep reinstatement belong to ordinary +library code. `run` remains a closed state-fold convenience and does not provide +this clause scope. Exact checked types and deep/shallow derivations are in +[control elimination and handler scopes](control-elimination-and-handler-scopes.md). The surface is monadic, so effectful code is written with the library's operations and `bind` (via `do`). There is no direct-style effect syntax and no effect typing @@ -275,7 +280,7 @@ handle(s, Put(s', next)) = handle(s', next) handle(s, Other(op, k)) = Request(op, x -> handle(s, k(x))) ``` -The library expresses this as a `run` handler over the control surface; the +The library expresses this as a deep `handle` wrapper over the control surface; the mechanism that captures `k` and drives the trampoline is [delimited control and resumable frames](delimited-control-and-resumable-frames.md). The final rule preserves the captured state while the outer handler interprets @@ -354,7 +359,7 @@ no effect syntax and no effect rows; the compiler adds no ambient effect inferen and does not recognize a `Run` or `Effect` constructor specially. The library and the compiler divide cleanly: operations, rows, handlers, and the -one-shot/multi-shot API are library code; only the carrier, the four primitives, and +one-shot/multi-shot API are library code; only the opaque carriers, generic control operations, and their lowering are compiler code ([delimited control and resumable frames](delimited-control-and-resumable-frames.md)). A library cannot make the optimizer unsound, and the compiler cannot change an diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md new file mode 100644 index 00000000..52427189 --- /dev/null +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -0,0 +1,270 @@ +# Control Elimination and Handler Scopes + +**Feature:** [F-02](../../../feature/F-02-portable-programs.md) +**Status:** Draft +**Prerequisites:** [Delimited control](delimited-control-and-resumable-frames.md), +[CC IR](cc-ir.md), and [representation and evidence](representation-and-evidence.md). +**Summary:** Generalize the existing `Prim.Control.handle` to eliminate a source +computation into a distinct target computation. Return and operation clauses run +outside the source handler; ordinary library code chooses deep or shallow +resumption. Dispatch scope and continuation lifetime are separate machine facts. +[DEC-20](../../../decision/DEC-20-typed-control-elimination.md) records this draft +API revision; the implementation checklist separates historical v1 evidence from +focused v2 execution and the remaining verifier/foreign obligations. + +## Scope + +This topic owns the precise `handle` type, raw continuation behavior, clause +scope, and the frame/lifetime obligations needed to implement it. The parent +control topic owns the other primitives, one-shot ownership, foreign boundaries, +and target profile. Concrete operations, state, union projection, and residual +row policy remain library responsibilities. + +## Background + +The previous five-argument `handle` gave its operation clause a source result +`Control u a`, then interpreted that result under the same handler to produce +`Control g (s, a)`. This is a fold. It cannot move clause execution outside that +handler without an actual conversion between both request and answer domains. +Changing dispatch alone would confuse `u` with `g` and `a` with `(s, a)`. + +Scoped handlers instead distinguish the source remainder from the target answer. +A clause may perform target effects before resuming, abandon the source, or +resume it several times. Shallow resumption leaves subsequent source effects +available to an outer handler, so it cannot in general erase the handled effect +from its result type. These are ordinary type relationships, not effect inference. + +The reference `purescript-run` implementation exposes one-layer elimination and +folds into a target monad. Its target domain is distinct from the source carrier. +This motivates the separation here, but does not establish compatibility with a +pinned upstream package. OCaml's deep/shallow distinction provides a scope +reference; its native continuation ownership and lifetime policy are not adopted. + +## Model + +The existing intrinsic identity `ControlHandle` has this revised checked scheme: + +```purescript +handle :: forall u g a b. + (a -> Control g b) + -> (forall x. u x -> (x -> Control u a) -> Control g b) + -> Control u a + -> Control g b +``` + +The first argument is the return clause; the second is the operation clause. +The raw continuation receives exactly the request's answer `x` and constructs +an inert computation over the original `u`, returning the original `a`. +It does not reinstall the source handler or apply its return clause. Both +clauses construct target computations over `g`, returning `b`. Constructing +`handle`, `bind`, `perform`, or a raw resumed computation invokes no callback. +Strict evaluation of arguments still follows the ordinary language rules. + +`run` retains its existing state-threading closed fold type and behavior. It is +a terminal execution convenience, not the closed case of this scoped operator. +A library can finish an empty-request target with a checked empty-functor runner. +The base continuation remains multi-shot; `once`/`resume`/`cancel` retain their +separate ownership contract. + +## Design + +### Library derivations + +Below, `project` is a library Church-encoded split, and `pure` wraps the compiler +return primitive. `Pair s a` abbreviates `{ _1 :: s, _2 :: a }`. + +```text +project : forall x r. u x -> (f x -> r) -> (g x -> r) -> r + +deep : (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) + -> (forall x. s -> f x -> (s -> x -> Control g (Pair s a)) + -> Control g (Pair s a)) + -> s -> Control u a -> Control g (Pair s a) + +deep project clause s c = handle + (\a -> pure (s, a)) + (\request raw -> project request + (\op -> clause s op (\s' x -> deep project clause s' (raw x))) + (\op -> bind (perform op) (\x -> deep project clause s (raw x)))) + c + +shallow : (forall x r. u x -> (f x -> r) -> (g x -> r) -> r) + -> (forall x. s -> f x -> (s -> x -> Control u (Pair s a)) + -> Control u (Pair s a)) + -> s -> Control u a -> Control u (Pair s a) + +shallow project clause s c = handle + (\a -> pure (s, a)) + (\request raw -> project request + (\op -> clause s op + (\s' x -> bind (raw x) (\a -> pure (s', a)))) + (\_ -> bind (perform request) + (\x -> shallow project clause s (raw x)))) + c +``` + +Deep continuation reinstalls the library handler around the raw source remainder. +Its clause's fresh requests belong to `g` and execute outside that installation. +State updates are arguments to the continuation; independent replay branches +start from the state each invocation supplies. This does not copy mutable user +objects or roll back IO. Deep forwarding re-emits the residual `g` payload. + +Shallow continuation resumes the raw source directly and maps its final answer. +Its result retains `u`; claiming a general `Control g` result would be unsound. +Before the selected operation is reached, forwarding re-emits the original `u` +request and reinstalls the shallow search after its answer. No inverse injection +law or compiler union selector is needed. More elaborate shallow APIs may widen +or transform the remaining effect collection explicitly in library code. + +### Machine phases and scope + +The guest loop uses explicit context frames, not a recursive interpreter call +per handler or request: + +```text +Computation = Return | Perform | Bind | Resume | Handle(ret, op, body) | OwnedResume +Sequence = Empty | Cons | Append +Context = Source(contract, ret, op, sourceQueue, extent, caller) + | Target(contract, targetQueue, finishExtent, caller) +``` + +A contract records the checked source request/answer domain and target +request/answer domain. A source context captures only its source queue. Caller +work is outside that capture. When a clause returns target data, its source +dispatch is absent; the enclosing target dispatch handles fresh requests. +An explicit finish marker retains the source extent until that target computation +finishes with `b`, then supplies `b` to the saved caller queue. Returning `a` +from the source is not equivalent to completing the target with `b`. + +### Lifetime and replay + +Dispatch removal does not close a delimiter's lifetime extent. A raw continuation +captured by a clause stays valid while its target answer is being computed. +Once that answer completes, calling it or interpreting a previously constructed +resume node must fail, even if an enclosing runner is still live. An ancestor's +completion also expires suspended children abandoned by an outer clause. + +Captured queues are persistent. A replay creates fresh activation state for +captured lifecycle frames; completing one replay must not close the original +suspended checkpoint needed by another. Captures created inside a replay expire +with that replay's activation. When capture includes inner finish markers, those +markers are activation templates, not shared mutable close tokens. Only compiler +lifecycle frames are instantiated again: user closures, mutable values, and +one-shot owners remain shared. Frame identity and checkpoint provenance must +survive erasure; request names cannot reconstruct them. + +A deep library handler can tail-return another `Handle` on every request. +Constant native stack alone does not prevent an ever-growing chain of inactive +lifetime ancestors. The machine may coalesce finalization groups only when the +remaining target queue contains compiler finish markers, no user continuation, +and both checked target contracts and completion boundaries agree. It must +retain separate extents when a clause has work after a resumed branch or a +branch completes independently. Shared tail finish groups close at their common +answer boundary; replay-local captures still expire at branch completion. +Long request sequences require allocation and ancestor-depth evidence as well +as stack evidence. Any optimization must preserve the observable expiry rules. + +### Alternatives + +- Moving old clause execution to the caller changes neither its source type nor + its answer type, and is unsound without a real typed conversion. +- A deep/shallow Boolean cannot supply the missing output domain or return clause. +- A new `step` intrinsic duplicates the elimination supplied by generalized + `handle`; a one-layer observation alone also does not define lifetime extent. +- A synchronous arbitrary answer `r` requires a different execution contract. + Here the answer is inert `Control g b`, which the shared loop interprets later. + This representation supports target-answer separation without nested execution. +- Separate compiler deep/shallow operations are unnecessary: the typed library + derivations express their difference. No concrete effect policy enters lowering. + +## Algorithms + +1. Interpreting `Handle` saves caller work, opens an extent, and enters its source + with an empty source queue. +2. Normalize source `Bind`/`Return`/`Resume` using persistent sequence operations. + A resume checks checkpoint liveness and runs its saved queue before consumer + work; it does not automatically restore source dispatch. +3. At source `Return a` with an empty queue, remove source dispatch and invoke + the return clause once. Enter the returned target data with a finish marker. +4. At source `Perform request`, package its source queue as raw continuation, + remove source dispatch, and invoke the operation clause once. Clear the old + queue: only explicit continuation use may run it. Enter target data with a + finish marker, leaving the captured checkpoint live. +5. Process target requests in the enclosing dispatch. A library deep continuation + constructs a new `Handle`; a shallow continuation constructs a raw resume. +6. At target completion, close that activation's extent and restore caller work. + Capture/replay of context frames instantiates lifecycle templates as described + above. Normalization and context transitions use one iterative guest machine. + +## Code map + +| Owner | Required responsibility | +| --- | --- | +| Intrinsic registry and checked Core | One revised `ControlHandle` scheme and checked occurrence contract; quantified request/answer relationships | +| CC layout | Predeclare computation/context layouts, callable signatures and contract identities; representation table remains immutable in CC lowering | +| CC lowering | Synthesize guest loop and callbacks using those SignatureIds; preserve source/target domains, capture boundaries and lifecycle provenance | +| CC/MIR verification | Validate contracts, queue/context composition, capture ownership and matched entry/finish operations | +| Independent stdlib | State, union projection, residual forwarding, deep/shallow wrappers and source/runtime comparisons | +| Target encoding | Encode verified MIR using the existing capability profile | + +## Invariants and verification + +Source checking owns quantified type relationships. Lowered verification checks +that generated frames and erased calls use the retained contract identities and +predeclared signatures; it trusts checked source typing, not arbitrary erased +payload casts. Missing metadata, cross-domain queue composition, mismatched +finish frames and forged checkpoint ownership are errors. No stage adds effect +inference, reinterprets operation spellings or mutates representation layout late. + +Required behavior includes clause and return-clause effects outside source +dispatch; deep reinstatement; shallow escape with a truthful residual type; +forwarding, abandonment and independent replay; caller work outside capture; +expiry after target completion; liveness throughout clauses; replay of nested +finish frames; one-shot reuse rejection; GC roots; long request sequences; and +foreign-resource/host-trap cleanup. Type proofs and a rewrite model do not verify +Wasm lifetime, GC, stack safety or foreign cleanup. The +[implementation checklist](../../../implementation/backend/algebraic-effects.md) +keeps these claims separate. + +## Worked example + +An inner handler receives `F`, performs a fresh target request `G`, then invokes +its deep continuation with the supplied answer. `G` reaches the outer handler; +`F` in the resumed source reaches a fresh inner installation. For shallow use, +the resumed `F` instead reaches the outer handler because the raw remainder +still has source domain `u`. If the clause abandons the continuation, no saved +source work executes. The return clause also runs in the target domain. + +## Boundaries and interfaces + +This is a breaking revision of the draft control interface, designated contract +v2 here. It retains intrinsic identity 96 and the existing eight-operation set, +changing `handle` from five arguments to three. This designation is not a claim +that a compatibility marker already exists in artifacts or packages. Registry, +Core verifier, CC layouts, call expansion, executor, wrappers and tests must +migrate together. Old source signatures must fail checking; cached artifacts +must be invalidated through the artifact contract, and an explicitly revised +package/compiler contract must reject incompatible checked dependencies. +No hidden legacy overload or ninth intrinsic is selected. + +Historical compiler/runtime evidence belongs to contract v1. Focused v2 evidence +is recorded separately in the implementation checklist. The compiler lock moves +only after the revised independent package passes source, checked interface and +runtime acceptance. The selected design does not imply that +`purescript-run`, full VariantF rows, or scoped Wasm handlers already work. + +## Open questions and future work + +The type and scope correction is selected. Concrete context layouts, replay +activation instantiation, and safe tail finalization coalescing require compiler +implementation and the stated acceptance evidence. Foreign-frame suspension and +host recovery remain obligations of the parent topic. Direct-style syntax and +native stack switching remain separately governed future work. + +## References + +- [DEC-20](../../../decision/DEC-20-typed-control-elimination.md). +- [Run source](https://raw.githubusercontent.com/natefaubion/purescript-run/master/src/Run.purs), + reviewed 2026-10-11 as an unpinned design reference, not package acceptance. +- [OCaml 5.3 effect handlers](https://ocaml.org/manual/5.3/effects.html), scope reference + only; this design retains its own software multi-shot and delimiter lifetime policy. diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index eec1b130..5b778cce 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -11,13 +11,14 @@ [representation and evidence](representation-and-evidence.md), [capability profile](../wasm/capability-profile.md), and the [library-owned effects](algebraic-effects-and-handlers.md) this mechanism runs. -**Summary:** The compiler owns an effect-agnostic delimited-control surface — -`Control f a` with `return`/`bind`/`perform`/`run` — lowered by a selective, -defunctionalized continuation-passing transformation to explicit GC frame objects -driven by a trampoline. It needs no new target capability and is distinct from -WebAssembly stack switching. The selected activation is the frame/trampoline -representation (row 3) with a state-threading fold eliminator and an open-union -`handle` that removes one effect. +**Summary:** The compiler owns an effect-agnostic monadic `Control` surface, +lowered to persistent GC continuation frames driven by a guest loop. The existing +`handle` is generalized to typed source-to-target elimination, with clauses outside +source dispatch and deep/shallow policy in library code. The separate closed `run` +remains a state fold. [DEC-20](../../../decision/DEC-20-typed-control-elimination.md) +and [the scope contract](control-elimination-and-handler-scopes.md) specify this +revision. Focused v2 implementation and execution evidence are recorded in the +acceptance checklist; full verifier and foreign-boundary obligations remain open. ## Scope @@ -153,77 +154,40 @@ separate decision. ### The computation carrier and primitives -The compiler-owned surface is an **over-functor computation**: a freer computation -over an opaque request functor `f`, with construction and interpretation primitives. +The carrier is opaque and monadic over an arbitrary request functor. No `Functor` +constraint or compiler effect-row reasoning is required. ```text -Control f a -- computation over request functor f, yielding an a - return : a -> Control f a bind : Control f a -> (a -> Control f b) -> Control f b perform : f a -> Control f a run : s -> (forall x. s -> f x -> (x -> Control f a) -> (s, Control f a)) - -> Control f a - -> (s, a) -handle : s - -> (forall x. s -> f x -> (x -> Control u a) -> (s, Control u a)) - -> (forall x. u x -> Either (f x) (g x)) - -> (forall x. g x -> u x) - -> Control u a - -> Control g (s, a) + -> Control f a -> (s, a) +handle : (a -> Control g b) + -> (forall x. u x -> (x -> Control u a) -> Control g b) + -> Control u a -> Control g b ``` -- `Control f a` is opaque; no pass inspects a request. -- `perform` suspends: it captures the continuation up to the nearest `run`, - delivers the request value `f a` to that delimiter, and resumes with an `a`. -- `run` is a **state-threading fold**. The driver threads a handler state `s`; the - handler is rank-2 in the request's answer `x`, receives the current state, the - request, and the continuation, and returns the next state together with the next - computation. A stateless handler uses `s = ()`. -- `handle` is the open eliminator: it interprets the `f` operations of a computation - over a combined effect `u` and leaves the rest as a residual `Control g (s, a)`. The - library supplies the open union `u` and its split, `project : u x -> Either (f x) - (g x)` and `inject : g x -> u x`, so the compiler never reasons about rows or - labels. `run` is the closed case, with an empty residual. -- `bind` composes continuations directly (freer style), so no `Functor f` constraint - is required and a library functor needs no mapping instance. - -The driver is a flat loop: - -```text -run h s (Return a) = (s, a) -run h s (Perform op cont) = let (s', next) = h s op cont in run h s' next -``` - -It recurses in tail position and the handler never re-enters it, so execution is -constant-stack independently of tail-call support and of the number of requests or -binds. This is the row-3 eliminator. A *CPS-answer* eliminator -`(forall x. f x -> (x -> r) -> r) -> Control f a -> (a -> r) -> r` also threads state -(`r = s -> (s, a)`) but makes the driver *nested*, so it belongs to row 2 and is not -this mechanism's eliminator ([Design space](#design-space), -[Handler interface for a flat loop](#handler-interface-for-a-flat-loop)). - -**Why this surface.** It is exactly the shape `purescript-run` builds on, so that -ecosystem's operation rows, `VariantF` encodings, and deep handlers map onto it -directly; it keeps every concrete operation in library code; and it is expressible -with ordinary rank-N polymorphism. The alternatives are rejected. A separate -`suspend`/`handle`/`resume` triple with an abstract `Resumption` still has to carry -the payload/result relation in the request value, so it collapses into this surface -unless it adds an existential. `shift`/`reset` threads an answer type through the -monad and is not expressible without a frontend effect-row system, which DEC-03 -excludes. - -The surface is **monadic, not direct style**. Direct-style effectful code needs -`shift`/`reset` or effect syntax and is future work -([Open questions](#open-questions-and-future-work)). The compiler's contribution -over a pure library free monad is the representation: it lowers `bind`/`perform` to -an explicit continuation chain, so binding is stack-safe without materializing a tree, -and the handler is handed the continuation directly. - -The surface is independent of how the library encodes operations: `f` is opaque, so -`VariantF` over an open row, a closed operation functor, `Data.Exists`, or a rank-N -eliminator are all library choices. +`return`, `bind` and `perform` construct inert data; `perform` becomes observable +only when interpreted. `bind` runs saved work before consumer work. `run` is a +closed state-threading fold; its clause returns the next source computation. +`handle` constructs an inert source-to-target delimiter. Its raw continuation +constructs the original source remainder without reinstalling the handler. Its +return and operation clauses produce target computations outside source dispatch. +The [scope contract](control-elimination-and-handler-scopes.md) defines exact +phase, lifetime, library derivation and compatibility obligations. + +A flat guest loop interprets this data, including nested delimiters. A target +answer of inert `Control g b` needs no synchronous recursive interpreter call. +An arbitrary synchronous answer `r` would require a different contract; this +fact does not justify excluding typed target computations from a trampoline. + +The surface is monadic. Direct-style syntax is separate future work. Operations +may use a closed functor, an open `VariantF`, an existential or a rank-N library +encoding; the compiler learns no concrete effect. Reference Run exposes source +to target-monad elimination, but its API is not identical to this surface and +its pinned package acceptance remains unverified. ### Effect-agnostic contracts @@ -298,10 +262,10 @@ may silently replace them with an owner. ### Identity and exposure -The compiler owns the carrier and the four primitives. They are declared as a +The compiler owns the opaque carriers and eight generic control operations. They are declared as a compiler-reserved interface module, `Prim.Control`, the way `Prim.Coerce` exposes `coerce`: `Prim.Control` declares the abstract type `Control` and the -`return`/`bind`/`perform`/`run` values, whose schemes the compiler checks against the +`return`/`bind`/`perform`/`run`/`handle` and `once`/`resume`/`cancel` values, whose schemes the compiler checks against the [model above](#the-computation-carrier-and-primitives). The module carries no operation registry; no pass recognizes a concrete operation or adds an operation-specific solver. @@ -317,58 +281,19 @@ implementation of its own, because the lowering produces ordinary guest code. ### Handler interface for a flat loop -Row 3's eliminator is the state-threading fold in -[Model](#the-computation-carrier-and-primitives). The handler is called once per -request and returns the next state and computation, so the driver stays flat. For a -State request functor: +The closed `run` fold invokes its clause with state, request and raw source +continuation, and drives the returned next computation. This convenience does +not implement complete scoped-handler semantics. The generic `handle` instead +separates source `Control u a` from target `Control g b`; its callbacks return +inert target data to the shared loop. State, projection and reinstatement are +ordinary library functions. Complete typed deep/shallow derivations and the +return-clause contract are in +[control elimination and handler scopes](control-elimination-and-handler-scopes.md#library-derivations). -```text -h s (Get f) cont = (s, cont (f s)) -h s (Put s' n) cont = (s', cont n) - -runState s0 c = run h s0 c -- (s, a) -``` - -A stateless handler uses `s = ()` and returns `((), next)`. - -**Removing one effect (residual rows).** The fold above interprets the *whole* effect -`f`. The library's `Run r a = Control (VariantF r) a` and -`handleState :: s -> Run (state :: StateF s | r) a -> Run r { state :: s, value :: a }` -need the output to change effect, from `VariantF (label :: f | r)` to `VariantF r`. -The mechanism follows the industry standard — an **open union** indexed by the effect -collection — but keeps the compiler free of it: `handle` is generic over the combined -effect functor `u`, and the library supplies the union and its split. - -```text -handle s h project inject c :: Control g (s, a) - -go s (Return a) = Return (s, a) -go s (Perform uop cont) = - case project uop of - Left fop -> let (s', next) = h s fop cont in go s' next -- handled - Right gop -> Bind (Perform_g gop) (\x -> go s (cont x)) -- forwarded to residual -``` - -The library's `VariantF r` is the open union for the row; it supplies -`project : VariantF (label :: f | r) x -> Either (f x) (VariantF r x)` and -`inject : VariantF r x -> VariantF (label :: f | r) x` from ordinary row membership -(`Prim.Row.Cons`/`Lacks`). The compiler therefore never reasons about rows or labels; -the row machinery is library code, as with operations and handlers generally. This is -the row-indexed open union the ecosystem uses (`purescript-run`'s `VariantF`, Haskell's -`Union` with `Member`), realized here with a generic primitive rather than a -compiler-known row. - -The driver stays flat for handled requests; a forwarded request builds a residual -`Control g (s, a)` by binding `perform_g gop` to a continuation that resumes handling -with the saved state, so re-entry is bounded by the number of handlers, not by the -computation. - -**Why not the CPS-answer eliminator.** -`run :: (forall x. f x -> (x -> r) -> r) -> Control f a -> (a -> r) -> r` also threads -state, by choosing `r = s -> (s, a)`, but its handler's continuation `x -> r` must -produce the answer synchronously, so the driver becomes a *nested* `run` -(`\x -> run h (cont x) k`). That is not a flat loop and loses the row-3 stack -guarantee; it is the row-2 shape, and this mechanism does not adopt it. +A library deep handler removes a selected effect only by actually transforming +source requests to target requests. A shallow remainder retains its source +request domain. Moving an old source-domain clause to target dispatch without +that typed transformation would be unsound. ### Lowering: selective CPS to resumable frames @@ -445,143 +370,63 @@ handler written over a rank-2 newtype field compiled and executed on this target `wasmtime` run returning 42), and the official `purs` compiler accepts the same source. Row 2 is not rejected for expressibility; row 3 is chosen for the guarantees above. -**The `run` typing is coupled to the representation.** Row 3 naturally supports a -*structure-returning* handler `forall x. f x -> (x -> Control f a) -> Control f a`, -whose result is the next computation, with `run :: ... -> Control f a -> a`. A -*CPS-answer* handler `forall x. f x -> (x -> r) -> r` with a polymorphic `r` is what -threads state (`r = s -> (s, a)`) and changes effects (`r = Control g b`); it is what -row 2 uses directly (`run h c k = c k h`), but a trampoline (row 3) does not obviously -carry it, because the handler's continuation `x -> r` must produce the answer -synchronously. - -How existing systems thread handler state: - -- Row-1 libraries fold a **concrete** computation, with state in the target monad - (`StateT`) or in the fold's own recursion. This mechanism's carrier is opaque, so - the library cannot fold it. -- Row-4 systems (OCaml 5, Koka, Eff) capture the stack and thread state through - handler-local (often mutable) state. -- CPS encodings (`Cont`, `shift`/`reset`) thread state through the answer type — - exactly the CPS-answer `run`, i.e., row 2. - -This mechanism resolves the coupling as row 3 with the **state-threading fold** -([Handler interface for a flat loop](#handler-interface-for-a-flat-loop)): the driver -threads the handler state, so state threading no longer needs the CPS-answer -eliminator and the driver stays flat. Effect removal uses the open-union `handle`, -whose `project`/`inject` the library supplies so the compiler stays row-agnostic. +**Elimination and the representation.** A trampoline can interpret a handler's +inert target answer `Control g b` while preserving its raw source remainder +`Control u a`. This provides answer-type separation without a synchronous +`x -> r` interpreter. The former state-fold-only argument incorrectly excluded +this case. The selected `handle` uses typed source and target contexts; `run` +retains the closed state-fold convenience. Concrete state and open-union policy +belong in the library, not compiler selectors. #### Selective conversion -Converting a whole program to CPS would be slow and would change the representation -of code that never suspends. The compilation is **selective**: - -- A function is *convertible* when it can reach a suspension in its dynamic extent — - directly, through a call, or through a value it invokes. -- Only convertible functions are lowered to resumable form. Pure, non-convertible - functions keep the ordinary direct representation and calling convention. -- A suspension converts exactly the region from the suspension point out to its - delimiter; frames below the delimiter are ordinary calls and are not captured. +Selectivity applies to checked control operations and their continuation/context +representation. It is not whole-program dynamic-stack capture. Ordinary calls, +including callbacks that construct `Control` data, keep the existing callable +conventions. `bind` explicitly identifies saved continuation work; interpretation +reifies and captures that work only to its source delimiter. Calling `perform` +constructs data rather than suspending a live pure call stack. -Selectivity keeps the lowering proportional to the effectful part of the program and -keeps pure code fast. It is also where optimization interacts with the mechanism: an -inliner or specializer must not merge a convertible function into a non-convertible -one without preserving the conversion of the merged region, nor erase a suspension -whose result is unused, because the suspension is observable control, not a pure -computation. +A future direct-style transform would need its own conversion and foreign-frame +contracts. This monadic design requires no conservative call-graph analysis that +turns every unknown higher-order caller into a resumable function. Optimizers +preserve strict argument evaluation, inert construction and observable execution +separately. They may remove unused inert data, but may not erase, reorder or +duplicate interpretation callbacks as though they were pure constructions. #### Frame construction -The monadic surface is represented by inert computation nodes and a persistent -sequence of continuation frames. Constructing a `bind` never interprets its input -computation or invokes its continuation. Strict evaluation of primitive arguments -still follows the ordinary language rules. - -```text -Computation = Return(value) | Perform(request) | Bind(inner, continuation) - | Resume(value, savedSequence, boundary) -- internal only - | Handle(state, handler, project, inject, inner) - | Reenter(state, handler, project, inject, inner, boundary) - | OwnedResume(owner, value) -- internal only -Sequence = Empty | Cons(continuation, rest) | Append(left, right) -Machine = (handler, state, computation, pendingSequence) -``` - -`Bind` records a checked function from the inner result to the next computation. -The executor pushes this function onto its pending sequence and descends into the -inner computation. A `Return` consumes one pending function; that function returns -a computation node to the executor. A `Perform` passes the unchanged request and a -resumption capturing the entire pending sequence to the handler. The resumption -constructs `Resume(value, savedSequence, boundary)`; it does not execute the sequence or -re-enter the executor. A bare `Perform` therefore needs only a request field: its -identity continuation is represented by the empty pending sequence. -Suspension becomes observable when an executor interprets the node. An unused -inert node may be eliminated only while preserving strict argument evaluation; -an interpretation that invokes a handler remains an observable call. - -All sequence nodes are immutable GC objects. `Append` joins sequences without -copying them, including when a resumed computation is itself bound by the handler. -The saved sequence runs before the caller's pending sequence. Each normalization -step is driven by the executor loop; recursively nested composition closures are -not the sequence representation. This is the explicit continuation sequencing used -by operational free/freer implementations, adapted to compiler-owned frames. - -The handler returns the next state and computation. The executor clears its old -pending sequence: that remainder belongs to the resumption, so a clause may discard -it, resume it once, or construct several independent resumptions. Retaining the old -sequence would execute abandoned work or execute a resumed remainder twice. -Persistent nodes preserve multi-shot replay without mutating shared continuations. - -CC layout predeclares these representations and the executor call signature. The -continuation uses the existing unary erased callable-slot signature. The result -pair uses the canonical erased record protocol for `_1` and `_2`; ordinary payload -conversion adapts concrete states, results, handlers, and bind functions. CC lowering -synthesizes function bodies and registers their direct-call signatures, but cannot -mutate the representation table. Signature handles and verifier signatures come -from the same layout declarations. +The machine uses inert `Return`, `Perform`, `Bind`, raw `Resume`, +`Handle(returnClause, operationClause, body)` and `OwnedResume` nodes. Pending +continuations use immutable `Empty`, `Cons` and `Append` sequences. Raw resume +checks checkpoint liveness, runs the saved sequence before its consumer queue, +and does not automatically reinstall source dispatch. Capture excludes caller +work. Abandonment clears the source queue from the driver; only explicit resume +may run it. Persistent queues support replay without cloning user mutable data. + +Explicit heap contexts distinguish source normalization from target execution. +A clause's target answer runs under enclosing dispatch with an extent-finish +marker. The [scope contract](control-elimination-and-handler-scopes.md#machine-phases-and-scope) +specifies context identities, capture provenance and finish boundaries. + +CC layout predeclares computation/context layouts and all executor/callback +SignatureIds. Lowering synthesizes bodies using these declarations and cannot +mutate the representation table. Checked source/target contract identities remain +available for verification after payload erasure. The previous open-union +`Handle`/`Reenter` executor is v1 implementation evidence, not this normative shape. #### Open elimination and residual forwarding -`handle` constructs an inert `Handle` node. It evaluates its arguments strictly, -but invokes neither the handler nor `project` during construction. Interpretation -enters a second instance of the same sequence machine with a fresh empty sequence; -the caller's pending sequence stays outside this delimiter. Finishing the inner -machine produces `Return((state, value))`, which the caller interprets with its own -pending sequence. - -The checked compiler interface encodes `Either` using its Church eliminator: - -```text -project : forall x r. u x -> (f x -> r) -> (g x -> r) -> r -``` +The compiler receives opaque source requests and invokes the supplied operation +clause. Library code projects the union and constructs target residual requests. +It decides whether to wrap the raw source remainder in a new handler. It also +constructs state/result records through ordinary code. Neither union selectors +nor a compiler-owned injection argument are part of revised `handle`. -The machine applies it to two generated selectors, yielding an internal tagged -payload. The handled branch calls the supplied clause and continues the inner -loop with the returned state and computation. The residual branch stops this -inner loop and returns: - -```text -Bind(Perform(gop), forward(savedState, handler, project, inject, savedSequence)) -forward(x) = Reenter(savedState, handler, project, inject, - Resume(x, savedSequence, boundary), boundary) -``` - -The outer executor delivers `gop` unchanged to its handler. Calling `forward` -only constructs data; re-entry occurs when the outer executor interprets the -returned `Reenter`. Saved state is immutable: separate outer resumptions each -start with the same saved inner state. Subsequent changes within one branch do -not overwrite the other branch's state. An outer clause can abandon the entire -inner delimiter by discarding its resumption. - -`inject` remains a checked, strictly evaluated library argument. This machine -retains the original `u` computation and its pending sequence, so forwarding an -answer does not reconstruct a `u` request or call `inject`. It needs no inverse -law between `project` and `inject`. Requests remain opaque throughout. - -Both executors use loop-driven sequence normalization. Nested open delimiters -may call the open executor while retaining their caller; stack use can depend on -handler nesting depth, but does not grow with bind or forwarded request count -at fixed handler depth. This guarantee does not cover arbitrary recursive user -callbacks or direct-style capture across foreign frames. +Forwarding suspends target execution. Capturing and replaying that target context +must preserve nested source checkpoint provenance and instantiate lifecycle +frames per replay, as required by the scope contract. Shared guest context +transitions avoid native recursion per handler or forwarded request. #### The trampoline @@ -606,24 +451,13 @@ the constant-stack property even where the machine calls into ordinary code. #### Deep and shallow handlers -The delineated region is a marker in the frame chain. A **deep** handler is one -whose continuation re-installs the handler before continuing, so subsequent requests -at the same delimiter are handled again; the lowering wraps the resumed chain with -the handler frame. A **shallow** handler resumes the chain without re-wrapping, so -the handler runs once and later requests escape to an outer delimiter. The library -selects the semantics; the lowering must implement both and must not silently deepen -or shallow a handler. - -The current state-threading `run`/`handle` folds process the clause's returned -computation under their own driver. That contract alone does not express the -scoped-handler distinction between a fresh request in a clause (handled outside -the delimiter) and a request in a resumed program (reinstalled under a deep -handler). In particular, forwarding residual requests from the handled program -does not prove forwarding from a clause. A generic typed delimiter boundary must -preserve this distinction before the library can implement the complete -deep/shallow contract. This is a remaining representation/API obligation, not -permission to narrow the library semantics. The retained `ClauseScope.purs` -acceptance case is described in the implementation checklist. +Deep library code reinstalls `handle` around the raw source remainder; shallow +code resumes that remainder directly. Both operation and return clauses execute +outside the source handler. Deep output may remove the selected effect; shallow +output generally retains it. The typed library definitions in the +[scope contract](control-elimination-and-handler-scopes.md#library-derivations) +are authoritative. A compiler mode flag or implicit raw-continuation reinstallation +would change those semantics. Current v1 fold tests do not verify this contract. #### One-shot and multi-shot @@ -644,35 +478,30 @@ into a one-shot one. #### Lifetime, GC roots, and abandonment -A continuation keeps its captured frames reachable, so anything those frames -captured stays alive until the continuation is dropped, resumed to completion, -cancelled, or abandoned. When a handler returns without resuming, its continuation -becomes unreachable and the GC reclaims the frames. The compiler must not drop a -live continuation to an optimization, and must not let a dead one keep roots alive -beyond its contract. - -Every interpreted closed `run` allocates a fresh delimiter token. It closes -that token before returning the result. A captured resumption and its `Resume` -node both retain the token: calling the function and interpreting an already -constructed node each check liveness. Moving the node into another `run` cannot -bypass expiry. A live multi-shot resumption may be interpreted re-entrantly under -a nested `run`; it still captures only its original pending sequence. - -An open `Handle` allocates a child token referring to its enclosing delimiter. -Completion closes that activation's token. Forwarding suspends it; the saved -checkpoint remains valid while its parent is live. Each residual replay starts -a fresh activation with the same enclosing parent, so completing one replay does -not invalidate the saved checkpoint used by another replay. New resumptions -captured in that replay belong to its own activation and expire when it completes. -Re-entry checks the checkpoint before creating the new activation. Tokens follow -actual delimiter nesting, not forwarded request count; checkpoint re-entry does -not build a new ancestor link for every request. Parent expiry also invalidates -suspended children, including ones abandoned by an outer clause. - -Tokens are immutable tagged GC objects containing private mutable liveness cells -and an optional parent. A shared generated loop checks the token and its ancestors. -The token is not an abstract target-native stack handle. Frame payloads and saved -sequences remain persistent, so lifetime checks do not consume multi-shot data. +A reachable continuation keeps its captured values as GC roots. Multi-shot use +neither consumes it nor releases those roots automatically. Completion of its +extent makes it unusable; roots may remain reachable if user code retains the +expired closure. Abandonment makes frames collectible only when no references +remain. Spent one-shot owners clear their private callback captures. Lifetime +validity and heap reachability are separate facts, and optimizations preserve both. + +Every interpreted closed `run` opens a lifetime extent and closes it before +returning. Both calling a captured continuation and interpreting an already +constructed resume node check liveness. Moving data into another runner cannot +bypass expiry. + +For `handle`, source dispatch removal and extent completion are distinct. Its +extent stays live during its target clause answer and closes when that answer +finishes, even when the parent runner remains live. Replay instantiates compiler +activation frames; it does not share a mutable finish token between independent +branches or clone user state. Parent completion expires abandoned children. +[Lifetime and replay](control-elimination-and-handler-scopes.md#lifetime-and-replay) +defines checkpoint provenance and safe tail finalization groups. Long deep +sequences must not build unbounded inactive lifetime ancestry merely because +library code tail-returns another handler. + +Lifetime metadata consists of GC frames and private liveness state, not a native +stack handle. Persistent queues remain replayable while their checkpoint is live. This is the software-continuation cost model: because the frames are heap objects, the ordinary GC finds their roots and no separate root information is needed. A @@ -692,8 +521,8 @@ buffer or a host-resource reference past the boundary's lifetime. ### The executor and the runtime boundary The eliminator's driver — the trampoline of [The trampoline](#the-trampoline) — is the -**executor**: the component that turns a `Control` value, a handler, and a handler -state into a result. Where it lives is a design decision with a strict boundary. +**executor**: the component that interprets `Control` data through typed contexts +and dispatch clauses; closed `run` also threads explicit handler state. Where it lives is a design decision with a strict boundary. - **The executor is guest code.** It is a compiler-generated loop over the frame representation, or a library function over a compiler-provided frame view. It runs @@ -715,10 +544,11 @@ state into a result. Where it lives is a design decision with a strict boundary. The executor's contract: - Input: a `Control` value, a handler, and the initial handler state `s`. -- Output: `(s, a)` for the closed `run`, or a residual `Control g (s, a)` for `handle`. -- It calls the handler once per handled request and never re-enters itself for a - handled request; forwarded requests build residual data, so re-entry is bounded by - the handler count. +- Output: `(s, a)` for the closed `run`. Interpreting scoped `handle` changes + from source `Control u a` to target `Control g b`, with an explicit finish context. +- It invokes the matching clause once at each source return/request boundary. + Nested source/target and forwarding transitions use the shared guest loop; + library callbacks return data rather than invoking a synchronous inner executor. - It preserves the [invariants](#invariants-and-verification): frame identity, capture boundary, and one-shot status. @@ -801,100 +631,46 @@ option remains a separate target-capability decision with its own evidence. ### Selective conversion -```text -convertible(f): - if f performs a suspension: return true - for each call, value applied, or capture in f: - if convertible(callee) or callee is unknown: return true - return false - -lower(program): - mark every function convertible by a fixed point over the call graph - for each convertible function: - rewrite its body in CPS form (Section "Frame construction") and - register its frames in the module frame table - leave non-convertible functions direct -``` +1. Consume checked primitive occurrences, including callable aliases and partial + applications, using their authoritative Core contracts. +2. Predeclare computation, sequence and context representations plus signatures + in CC layout before lowering synthesizes any bodies. +3. Lower construction to inert data and interpretation to the guest context loop; + preserve source spans, source/target domain identities and capture provenance. +4. Leave ordinary functions in the existing calling convention. Adapt callback + payloads through the shared checked representation operations. -An unknown or indirect callee that might suspend makes its caller convertible, so -the analysis is conservative at exactly the boundaries it cannot see. +This procedure does not infer effects from function names or unknown callees and +does not capture the native stack of ordinary pure code. ### Perform and continuation -```text -perform(request): - k = capture_frames(current, up_to = nearest run delimiter) - transfer(request, k) to the delimiter's handler - -handler(request, k): -- library code - ... -- resume k, abort, or replay k - -continue(k, value): - reinstall(k.frames, value) -- the performed step's result is value -``` - -`capture_frames` reads the current chain up to the delimiter without copying outer -frames. For the multi-shot surface it does not mutate the chain; for the one-shot -API the status transition (`Pending` → `Running` → `Consumed`) is atomic, so a -re-entrant resume is rejected. +Constructing `perform(request)` stores inert data. At interpretation, the current +source delimiter captures only its pending source queue and supplies a raw +continuation to its operation clause. No callback runs during construction. +The source clause returns target data; saved work executes only if it uses the +raw continuation. Calling that continuation constructs a checked `Resume` node. ### The executor loop -The closed executor drives both computation and pending sequence in a flat loop: +Sequence normalization consumes `Bind`, `Return` and `Resume` iteratively. +`Append(saved, consumer)` runs saved work first without mutating either sequence. +Closed `run` supplies its state-fold clause and final result boundary. Scoped +`handle` saves caller work, normalizes source work, removes source dispatch before +calling either clause, and interprets the target answer under enclosing dispatch. +An explicit finish context closes the extent only at target completion. -```text -exec(h, s, Bind(c, k), q) = exec(h, s, c, Cons(k, q)) -exec(h, s, Resume(v, saved), q) = exec(h, s, Return(v), Append(saved, q)) -exec(h, s, Return(v), Empty) = (s, v) -exec(h, s, Return(v), Cons(k, q)) = exec(h, s, k(v), q) -exec(h, s, Return(v), Append(Empty, q)) = exec(h, s, Return(v), q) -exec(h, s, Return(v), Append(Cons(k, rest), q)) = - exec(h, s, k(v), Append(rest, q)) -exec(h, s, Return(v), Append(Append(a, b), q)) = - exec(h, s, Return(v), Append(a, Append(b, q))) -exec(h, s, Perform(op), q) = - let cont(x) = Resume(x, q) - let (s', next) = h(s, op, cont) - exec(h, s', next, Empty) -``` - -Every recursive `exec` edge is a self tail call lowered to a MIR loop. Calls to -ordinary bind functions and handlers return one computation step; they do not -traverse the saved sequence. User code's own non-tail recursion is outside this -machine's stack-safety guarantee. Invalid internal tags trap explicitly. - -The open executor uses the same sequence rules. At a request it projects the opaque -union, calls the matching handler for a handled request, or constructs residual -control data with a continuation that reinstates the saved handler state and -sequence: - -```text -handle h s project inject (Return a) = Return (s, a) -handle h s project inject (Perform uop cont) = - case project uop of - Left fop -> let (s', next) = h s fop cont in handle h s' project inject next - Right gop -> Bind (Perform_g gop) (\x -> handle h s project inject (cont x)) -``` - -`handle` threads the handler state and forwards unhandled requests to the residual; -the loop recurses in tail position for handled requests, so the executor never grows -the native stack with computation depth. A handler that returns without resuming -leaves its continuation unreachable; deep and shallow differ only in whether `h` -re-wraps the continuation. +The complete transition procedure is in +[scope algorithms](control-elimination-and-handler-scopes.md#algorithms). +Nested context transitions use the shared guest loop. User callbacks' arbitrary +non-tail recursion remains outside the machine guarantee. Invalid tags or contract +mismatches fail explicitly. ### Deep-handler reinstatement -```text -install_deep(k, v, handler): - // Deep: the same delimiter must handle the continuation's later requests. - install(k, v) with handler re-wrapped around the resumed chain - -install_shallow(k, v): - install(k, v) without re-wrapping the handler -``` - -The frame chain records which wrapping applies; the lowering must not conflate the -two. +Reinstatement is a library `handle` construction around a raw resumed source. +Shallow use omits that construction. Lowering preserves these ordinary typed +operations; it does not inspect callback bodies to infer concrete handler policy. ### One-shot consumption @@ -902,7 +678,8 @@ two. transfer(k): atomically: if k.status != Pending: reject k.status = Running - ... normal or trapping completion sets k.status = Consumed ... + ... normal completion sets k.status = Consumed ... + ... caught-trap recovery requires the separate cleanup contract ... ... cancellation sets k.status = Cancelled ... ``` @@ -916,8 +693,8 @@ This is the design target, not a claim that these APIs exist yet: | Location | Intended responsibility | | --- | --- | | `Prim.Control` owner | The abstract `Control f a` carrier and the `return`/`bind`/`perform`/`run`/`handle` primitives, with their checked schemes | -| CC control lowering and MIR | Persistent continuation sequencing and synthesis below Typed Core; selective conversion, deep/shallow wrapping, and one-shot status | -| Executor (guest code) | The loop that drives frames against a handler and threads its state; compiler-generated or a library function over a frame view; never a runtime interpreter of the frame layout | +| CC control lowering and MIR | Persistent sequencing and typed contexts below Typed Core; preserve library reinstatement, lifecycle provenance and one-shot status | +| Executor (guest code) | The guest loop over typed source/target contexts, persistent queues and lifetime activations; closed run also threads fold state | | MIR verifier | Frame identity, capture boundary, continuation result-type, and suspension-observability checks | | Existing Core/CC/MIR lowering and optimizers | Compile the converted frames and the executor as ordinary higher-order code; preserve generic observable-call semantics | | `psrs-runtime` (software form) | GC heap, leaf primitives, trap, and linking; provides no continuation and must not learn the frame layout | @@ -930,15 +707,14 @@ explicitly adopted. ## Invariants and verification -- A suspension is observable control: it is never erased, reordered across, or - duplicated by an optimizer, and a convertible function is never merged into a - direct one without preserving its conversion. +- Interpreting a suspension is observable control and may not be erased, reordered + or duplicated as a pure construction. Inert data follows ordinary strict evaluation. - A continuation is resumed only at its captured result type, and a one-shot continuation is transferred at most once, atomically with respect to re-entrancy. - Deep and shallow handlers behave as declared; the lowering does not silently change the semantics. -- Captured frames keep their values valid until the continuation is dropped, resumed - to completion, or cancelled; a continuation is never retained across a +- Reachable captured frames keep their values rooted; expiry follows the target + extent and multi-shot resume does not consume the checkpoint; a continuation is never retained across a non-suspendable foreign boundary. - The trampoline drives every step, so execution is stack-safe independently of the native stack; emitted tail positions use `return_call*`. @@ -988,9 +764,10 @@ capability is an error, never a silent change to continuation semantics. ## Open questions and future work -The eliminator is settled — the state-threading fold with the open-union `handle` -([Handler interface for a flat loop](#handler-interface-for-a-flat-loop)). The -following remain open. +The source-to-target `handle` contract is selected by DEC-20; the separate `run` +remains a closed fold. Migration, context-frame verification, replay activation +identity and finalization coalescing require the evidence in the scope topic. +The following remain open. 1. **Direct-style surface sugar.** Effect typing is out of scope (see [Scope](#scope)). A non-typed syntax that desugars to the monadic API is a diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 12793c83..ce29e3d0 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -458,3 +458,195 @@ No Rust source changed in this continuation. Full Rust workspace tests/clippy were not repeated; the prior `a31ba11e` evidence remains the compiler baseline. The library tools, official type comparison, focused public runtime cases and source audit were actually executed as recorded above. + + +### Typed elimination design correction (2026-10-11) + +[DEC-20](../../decision/DEC-20-typed-control-elimination.md) and +[the scope contract](../../design/backend/fp/control-elimination-and-handler-scopes.md) +replace the draft five-argument open fold with a three-argument generalized +`handle`. No intrinsic was added and no compiler or production package source was +changed in this design continuation. The existing ID 96 remains selected. +`run` retains its closed state-fold contract. This is contract v2 design; compiler +`95982bea` and independent package `28997b5` still implement v1. + +The ClauseScope failure is a missing typed API contract, not merely incorrect +CC dispatch: the old clause returns source `Control u a`, whereas the operator +returns target `Control g (s, a)`. Executing that clause as target data would be +unsound without a conversion. Revised clauses return the actual target domain; +a raw continuation remains in its source domain. Library code owns state, +projection, forwarding, deep reinstallation and shallow residual preservation. + +#### Design validation actually performed + +Artifacts are retained in `/private/tmp/psrs-control-contract-20261011/`. +Official `purs` 0.15.16 compiled `Contract.purs` to CoreFn using opaque foreign +carrier/primitive declarations, with no foreign runtime. The accepted source +contains the revised scheme, both complete wrapper bodies reproduced in the +scope design, a deep clause performing a target request, and typed deep/shallow +applications. `positive.json` records acceptance (shadowing warnings only). +Four separate negatives each report `TypesDoNotUnify`: + +| File | Rejected relationship | +| --- | --- | +| `WrongClauseDomain.purs` | Source request performed in a target clause | +| `ShallowCannotRemove.purs` | Shallow source result assigned a reduced target effect domain | +| `WrongRawAnswer.purs` | Raw rank-2 continuation supplied an unrelated Boolean | +| `WrongTargetAnswer.purs` | Target answer assigned an unrelated result type | + +Each file has a corresponding `.json` and `.stderr` report. These cases establish +ordinary type expressibility, not current target compiler acceptance of v2. +They are separate from the earlier nine package comparisons of the v1 interface. + +`node model.mjs` executed eight rewrite-semantic assertions; `model.json` records +clause scope, deep reinstallation, shallow escape, residual forwarding, independent +multi-shot state, abandonment, return-clause scope and caller capture boundaries. +The expected clause-scope result is value 42 with one inner and one outer call; +deep handles both source requests internally, while shallow sends the second to +the outer handler. The model does not implement lifetime, GC, Wasm or a stack-safe +executor. No AE/AC requirement requiring guest execution becomes Verified from +these proofs. No official suite measurement changes. + +#### Required coherent migration and evidence + +| Obligation | Owner and required evidence | Status | +| --- | --- | --- | +| Revise checked scheme/arity, preserving intrinsic identity | Registry, primitive value elaboration, Core verification; direct calls, aliases, partial applications, malformed and old-signature rejection | Unverified | +| Preserve source/target contracts after erasure | CC layout and verification; predeclared SignatureIds and immutable representation table; cross-domain and mismatched finish-frame rejection | Unverified | +| Flat source/target context machine | CC lowering; inert construction, caller work outside capture, both clauses outside source dispatch, arbitrary nested handlers | Unverified | +| Typed library policies | Independent stdlib; port the shown wrappers and type negatives into package-owned conformance, compare with official `purs`, migrate ClauseScope and deep/shallow runtime cases | Unverified | +| Lifetime separate from dispatch | Mandatory Wasmtime; raw use during clause, expiry after target answer while parent stays live, expiry of already built nodes, abandoned child expiry | Unverified | +| Replay activation identities | Mandatory Wasmtime; replay of nested finish contexts, original checkpoint retained, replay-local captures expire, shared one-shot owners reject reuse | Unverified | +| Bound stack and inactive ancestor growth | Mandatory Wasmtime long deep/residual sequences; inspect frame/ancestor and allocation behavior; exercise non-tail multi-shot clauses separately | Unverified | +| Coherent artifact/package contract v2 | Explicit compatibility invalidation/rejection, revised independent package acceptance before lock update; no old/new overload or hidden extra intrinsic | Unverified | +| Complete adjacent obligations | Existing frame identity, GC roots, foreign borrowed-resource and caught-host-trap cleanup requirements remain in force | Unverified | + +AE-06 and AC-05 remain Unverified. Their normative scope is not reduced to the +state fold. The earlier focused v1 runtime results remain historical evidence; +they do not certify the revised interface. Rust tests/clippy were not rerun for +this documentation-only correction; `git diff --check` is the relevant local gate. + + +## Control contract v2 implementation (2026-10-11) + +Starting point: compiler `95982bea` on `feat/effect-handlers`, with the preceding +design correction uncommitted; independent stdlib `28997b5` on `control-library`, +initially clean. The default package selection rejected that main checkout because +it differed from locked `1e01310`. The same original mixed-forwarding test passed +with the explicit `PSRS_STDLIB_ROOT=/Users/biu/Projects/psrs-stdlib` development +package. Baseline log: `/private/tmp/psrs-control-v2-before.log`. + +### Implemented ownership and machine contracts + +- `ControlHandle` retains ID 96 and now has arity three and the DEC-20 scheme. + There is no ninth intrinsic, legacy overload, compiler union projection or + effect-name dispatch. The separate closed `run` still implements a state fold. +- Core rejects wrong saturated arity before indexing arguments, and checks all + eight control carrier/callable relationships before erasure. Rank-2 clauses + retain the shared request/raw answer variable and exact source/target domains. + `tests::control` has four malformed/valid IR checks, including a forged source + payload rejected at the common return constructor. Type relations use the + existing Core checking owner; no private effect solver was added. +- CC layout predeclares computation, persistent queue, context and callback + signatures. The single six-argument executor switches between root/source + contexts. A source context saves its return clause, operation clause, caller + queue, caller extent, caller context and owned extent. Both clauses execute + with caller dispatch and a target finish marker, retaining the owned extent + until their target answer completes. +- Raw resume remains inert and retains its original source queue/checkpoint. + Replay flattens lifecycle templates with a heap traversal stack and rebuilds + them from the outside inward with fresh activations. Ordinary callback values + and one-shot owners remain shared. New activation ancestry uses the current + dispatch extent; saved checkpoints retain their original owner. Helper edges + are self tail calls lowered to loops, not recursive native sequence traversal. +- Tail handler entry normalizes leading `Append` nodes before inspecting finish + markers. A leading compiler finish allows shared completion of the tail-returned + handler without another lifetime ancestor or duplicate finish. User continuation + heads keep independent extents. The intermediate long-forwarding run exposed + missing queue normalization; it was stopped and superseded by the passing + corrected run in `/private/tmp/psrs-control-v2-long-forward.log`. + +Core verifies source typing. Existing CC/MIR verification checks generated +representation shapes and predeclared calls; full semantic frame/context identity +and malformed lifecycle-provenance verification remain Unverified. The long +runtime cases establish bounded native stack on the executed programs, not a +complete allocation/ancestor-depth measurement or proof for every control form. + +### Requirement-to-test evidence + +| Requirement slice | Actually executed evidence | Coverage | +| --- | --- | --- | +| Clause and return-clause scope; deep vs shallow | `control_scoped_runtime` fresh clause, return clause and distinct source-resumption cases | Focused Verified | +| Source/target answers and primitive values | Scoped alias/partial application changes Int source answer to Boolean target; `control_scoped_surface` rejects source requests in target clauses, wrong raw/target answers, old scheme and false shallow removal | Focused Verified | +| Replay, abandonment and caller capture | Scoped state replay/caller queue and abandonment; historical library-fold forwarding tests ported through an explicitly ordinary `foldOpen` helper | Focused Verified | +| Normal target lifetime | Scoped expiry of raw closures and prebuilt nodes while parent remains live | Focused Verified | +| Nested replay lifecycle | `control_scoped_replay` replays two nested finish contexts twice; new replay-local closures and prebuilt nodes expire after that branch | Focused Verified | +| Request/bind stack safety | Scoped deep and mixed forwarding cases execute 100000 requests; existing closed bind/request case also executes | Focused Verified; general allocation/depth bound unverified | +| Adjacent ownership, aggregate and GC behavior | Existing owned/open/closed control runtime targets; forced-GC evidence actually observes collection | Focused Verified | +| Package contract | Package test rejects explicit incompatible/null/string control versions; source rejects v1 handle scheme | Focused Verified | +| Complete verifier, foreign resources, caught traps, pinned reference library | No new execution establishes these contracts | Unverified | + +The helper `foldOpen` in compiler tests is a user-defined state fold over v2 +`handle`; it preserves historical fold behavior by explicitly converting its +source clause result. It is not the public scoped handler contract. Actual +shallow behavior is tested directly and through the independent public wrapper. +No compiler dispatch flag emulates it. + +### Independent package and validation + +The independent package now exposes revised `handle`/`handleOnce`, plus ordinary +`handleDeep`/`handleShallow`, and declares `control_protocol = 2`. Target wrapper +provenance/hash are updated; official PureScript module sources are unchanged. +The package-owned official comparison passes 17 cases: nine accepted sources and +eight `TypesDoNotUnify` negatives. It uses `purs` 0.15.16 and an opaque CoreFn-only +interface shim, not an official control runtime. Report: +`/private/tmp/psrs-control-v2-official/types.json`. + +Nine public Wasmtime fixtures pass: `OneShot`, `MultiShot`, `Open`, `ClauseScope`, +`HandleOnce`, `Deep`, `Shallow`, `DoubleResume`, and `Cancelled`. The last two +require a completed semantic `unreachable` trap; the others require value 42, +including inner/outer counts where declared. Reports: +`/private/tmp/psrs-control-v2-public-/run.json`. +Node tool tests: 12 pass. Pinned source audit: 41 packages, 231 modules (170 +identical, 36 modified, 25 target additions), no missing upstream modules or +direct self-recursions. Logs: `/private/tmp/psrs-control-v2-node.log` and +`/private/tmp/psrs-control-v2-audit.log`. + +Compiler validation with explicit development package and mandatory Wasmtime: + +- Full workspace `--no-fail-fast` executes 78 control tests and all 424 backend + library tests successfully. It still fails at the same nine targets and 175 + test names as `a31ba11e`; comparison has no added or recovered failure names. + This compares failure names, not an assertion that every failure has one cause. +- Two additional nested replay tests execute successfully after the workspace + run, bringing focused control coverage to 80 Rust tests. Four Core control IR + tests and the package protocol rejection test pass in the workspace run. +- Formatting, diff checking and full workspace clippy pass. No new syntax, + diagnostic code or official scoreboard measurement is claimed. + +Logs: `/private/tmp/psrs-control-v2-workspace.log`, +`/private/tmp/psrs-control-v2-workspace-comparison.json`, +`/private/tmp/psrs-control-v2-nested-replay.log`, and +`/private/tmp/psrs-control-v2-clippy.log`. + +Package protocol v2 and source fingerprinting prevent silently accepting an +explicit v1 package contract; old source schemes fail checking. The inspected +pipeline rebuilds Core/CC from source and exposes no persistent checked-IR cache +migration path. Existing standalone Wasm artifacts must be rebuilt; this change +does not claim a new runtime artifact-version rejection mechanism. +AE-06/AC-05 retain their full Unverified topic status, with the focused slices +above recorded separately. This implementation does not close the topic. + + +### Locked package integration + +The package continuation is committed at +`5d523805c4e2096e68fab5a4f965f62b225ee2af`; the compiler lock now pins it with +`fnv1a64-v1:a1e5a2f8f4157041`. After the pin, all 80 control tests execute and pass +with `PSRS_STDLIB_ROOT` explicitly unset and mandatory Wasmtime, so ordinary +package selection is exercised rather than relying on the development override. +All five package-selection tests and four Core control IR tests also pass. +Logs: `/private/tmp/psrs-control-v2-locked.log`, +`/private/tmp/psrs-control-v2-package.log`, and `/private/tmp/psrs-control-v2-core.log`. +The full workspace failure-set comparison above used the explicit development +path to the same package content; it is not relabelled as a default-selection run. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 6fb3cdb8..7d52ecea 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -4,13 +4,25 @@ **Branch:** `feat/effect-handlers` **Starting commit:** `2026238f`; the original checkout was clean. **Executor commit:** `1bcad5a7`; the ownership/lifetime continuation starts from this clean commit. -**Scope:** Typed `Prim.Control` surface, closed/open executors, persistent bind -sequencing, and one-shot ownership/lifetime checks. The ownership/lifetime changes are delivered with this handoff in one topical commit. +**Scope:** Typed `Prim.Control` surface, a shared context executor, persistent bind +sequencing, clause scope, library deep/shallow policies, and ownership/lifetime checks. The ownership/lifetime changes are delivered with this handoff in one topical commit. **Status:** Partial topic. All eight current primitives are lowered; complete AE/AC acceptance remains outstanding. +## Latest state + +This topic commit implements DEC-20 control contract v2. The compiler lock pins +stdlib `5d523805c4e2096e68fab5a4f965f62b225ee2af` with content identity +`fnv1a64-v1:a1e5a2f8f4157041`. All 80 control tests pass under default locked package +selection with mandatory Wasmtime; the official type comparison and nine public +package fixtures are recorded in the v2 checklist. Historical sections below +preserve prior checkpoints; the five-argument API belongs to those checkpoints. +Full frame/context identity verification, allocation/depth measurements, foreign +resources and caught-trap cleanup remain outstanding. + ## Governing contracts -- [DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md). +- [DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md) and + [DEC-20](../../decision/DEC-20-typed-control-elimination.md). - [Delimited Control and Resumable Frames](../../design/backend/fp/delimited-control-and-resumable-frames.md). - [Library-Owned Algebraic Effects and Handlers](../../design/backend/fp/algebraic-effects-and-handlers.md). - [Acceptance checklist](algebraic-effects.md). @@ -230,3 +242,69 @@ semantics require the outer handler to see it. Deep resumed execution and clause execution need distinct generic delimiter evidence; shallow removal also remains unexpressed. The checklist records the owning code, report and required next boundary. Do not treat existing residual forwarding as proof of clause scope. + + +## Selected contract correction and next implementation + +The [scope contract](../../design/backend/fp/control-elimination-and-handler-scopes.md) +and [DEC-20](../../decision/DEC-20-typed-control-elimination.md) resolve the next +foundation. Generalize the existing `handle` rather than adding `step`: + +```text +handle : (a -> Control g b) + -> (forall x. u x -> (x -> Control u a) -> Control g b) + -> Control u a -> Control g b +``` + +The old fold's source-domain clause cannot execute in its target domain merely +by changing dispatch. Both new clauses return target computations outside source +dispatch, while a raw continuation retains its original source type. Deep/shallow, +state and union projection are library compositions; shallow output preserves +remaining source effects. `run` stays a closed state fold. + +Dispatch scope and lifetime must migrate together. Explicit heap source/target +contexts save caller work outside capture and retain extent-finish markers during +clause execution. Target completion closes the extent. Replay instantiates +compiler lifecycle activation frames, preserving original checkpoints and sharing +user values/one-shot owners. Safe tail finalization groups prevent a deep wrapper +from accumulating inactive ancestors per request; non-tail branches retain their +independent expiry boundaries. + +Implement the registry/Core scheme and checked contracts, predeclare all CC +layout/signatures, implement and verify the shared context machine, then migrate +the independent package wrappers and acceptance cases. Retain ID 96 and eight +operations; invalidate incompatible artifact/package contracts. Do not update +`stdlib.lock.json` before package source/type/runtime acceptance. The checklist +records the requirement-to-evidence matrix and actual design proofs: official +`purs` accepts both wrappers and rejects four invalid relationships; an eight-case +rewrite model passes. Neither proof establishes guest lifetime or stack safety. + +This handoff now distinguishes implemented v1 (`95982bea`, stdlib `28997b5`) from +selected v2 design. No production source changed in the design correction. +The older clause failure remains a v1 reproducer; migrate it to the revised typed +wrapper before using it as v2 target acceptance. AE-06/AC-05, full frame identity, +foreign resources and caught-trap cleanup remain Unverified. + + +## Implemented v2 continuation + +The selected contract is now implemented: existing ID 96 has three arguments, +Core checks control carrier/callable relationships, and CC generates one flat +source/target context executor. Clause and return-clause requests execute outside +source dispatch, with finish markers keeping the target lifetime live. Persistent +replay creates fresh lifecycle activations; tail handler entry normalizes queue +heads and shares compatible finish boundaries. No new intrinsic was added. + +The independent package provides the new `handle`/`handleOnce` and typed ordinary +`handleDeep`/`handleShallow` wrappers with protocol 2. Public ClauseScope now +returns 42. Nine public runtime fixtures and 17 official type comparisons pass; +these remain separate from pinned Run/VariantF acceptance. Existing compiler +fold cases are retained as ordinary `foldOpen` library regressions; new scope +cases test the actual revised contract. + +The checklist's v2 section records 80 control tests (78 in the full workspace run +plus two subsequent nested replay tests), 424 passing backend tests, formatting +and clippy, and the unchanged nine-target / 175-name workspace failure baseline. +Full CC/MIR semantic frame identity, allocation/depth measurement, foreign borrowed +resources and caught-trap cleanup remain Unverified. Continue with those owner +contracts rather than adding concrete effects or a dispatch mode to the compiler. diff --git a/stdlib.lock.json b/stdlib.lock.json index cf1aaa9f..a12bf2e2 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "1e01310daa7e56de5ed379029d6a24dcf39e879c", - "source_fingerprint": "fnv1a64-v1:bca0ace40bd0ccac" + "revision": "5d523805c4e2096e68fab5a4f965f62b225ee2af", + "source_fingerprint": "fnv1a64-v1:a1e5a2f8f4157041" } From 5c78fa780ca51232ad724074672eb422667db3a6 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 11 Oct 2026 23:49:17 +0800 Subject: [PATCH 106/148] Preserve control machine field representations through CC and MIR --- crates/psrs-backend/src/cc/layout/control.rs | 154 +++++++++------ .../src/cc/lower/control/builder.rs | 26 ++- .../src/cc/lower/control/fields.rs | 100 ++++++++++ .../psrs-backend/src/cc/lower/control/mod.rs | 17 +- .../src/cc/verify/tests/control_frames.rs | 179 ++++++++++++++++++ .../psrs-backend/src/cc/verify/tests/mod.rs | 1 + .../psrs-driver/tests/control_support/mod.rs | 7 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 24 +++ .../backend/algebraic-effects.md | 48 +++++ ...ted-control-lowering-handoff-2026-10-11.md | 3 + 11 files changed, 487 insertions(+), 74 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/control/fields.rs create mode 100644 crates/psrs-backend/src/cc/verify/tests/control_frames.rs diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control.rs index ee55d9aa..bbb99048 100644 --- a/crates/psrs-backend/src/cc/layout/control.rs +++ b/crates/psrs-backend/src/cc/layout/control.rs @@ -1,7 +1,10 @@ //! Predeclared representations for the persistent control abstract machine. use crate::cc::payload::erased_shape; -use crate::cc::{ReprId, Representation, RepresentationTable, Signature, SignatureId, VariantCase}; +use crate::cc::{ + RefShape, Reference, ReprId, Representation, RepresentationTable, Signature, SignatureId, + ValueShape, VariantCase, +}; #[derive(Clone, Copy)] pub(in crate::cc) struct ControlLayout { @@ -21,35 +24,75 @@ pub(in crate::cc) struct ControlLayout { pub boundary_check: SignatureId, } -pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) -> ControlLayout { +pub(in crate::cc) fn append( + table: &mut RepresentationTable, + continuation: SignatureId, +) -> ControlLayout { let erased = erased_shape(); let computation = table.reserve(); - table.set( + let sequence = table.reserve(); + let context = table.reserve(); + let owner = table.reserve(); + let boundary = table.reserve(); + let callback = super::protocols::array(table, erased); + let status = super::protocols::array(table, ValueShape::Integer); + let callable = reference(RefShape::Closure(continuation)); + let queue = reference(RefShape::Repr(sequence)); + let extent = reference(RefShape::Repr(boundary)); + let frame = reference(RefShape::Repr(computation)); + set_cases( + table, computation, - Representation::Variant { - cases: [1, 1, 2, 3, 3, 0, 2] - .into_iter() - .enumerate() - .map(|(tag, count)| VariantCase { - tag: tag as u32, - fields: vec![erased; count], - }) - .collect(), - }, + vec![ + vec![erased], + vec![erased], + vec![frame, callable], + vec![erased, queue, extent], + vec![callable, callable, frame], + vec![], // Retired v1 Reenter tag; the executor rejects it. + vec![reference(RefShape::Repr(owner)), erased], + ], ); - let sequence = table.reserve(); - table.set( + set_cases( + table, sequence, - Representation::Variant { - cases: [0, 2, 2, 3] - .into_iter() - .enumerate() - .map(|(tag, count)| VariantCase { - tag: tag as u32, - fields: vec![erased; count], - }) - .collect(), - }, + vec![ + vec![], + vec![callable, queue], + vec![queue, queue], + vec![extent, queue, extent], + ], + ); + set_cases( + table, + context, + vec![ + vec![extent], + vec![ + callable, + callable, + queue, + extent, + reference(RefShape::Repr(context)), + extent, + ], + ], + ); + set_cases( + table, + owner, + vec![vec![ + reference(RefShape::Repr(callback)), + reference(RefShape::Repr(status)), + ]], + ); + set_cases( + table, + boundary, + vec![ + vec![reference(RefShape::Repr(status))], + vec![reference(RefShape::Repr(status)), extent], + ], ); let labels = vec!["_1".to_owned(), "_2".to_owned()]; let pair = super::protocols::record(table, &labels).unwrap_or_else(|| { @@ -75,44 +118,6 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) parameters: vec![erased; 4], result: erased, }); - let context = table.reserve(); - table.set( - context, - Representation::Variant { - cases: [1, 6] - .into_iter() - .enumerate() - .map(|(tag, count)| VariantCase { - tag: tag as u32, - fields: vec![erased; count], - }) - .collect(), - }, - ); - let callback = super::protocols::array(table, erased); - let owner = table.reserve(); - table.set( - owner, - Representation::Variant { - cases: vec![VariantCase { - tag: 0, - fields: vec![erased; 2], - }], - }, - ); - let status = super::protocols::array(table, crate::cc::ValueShape::Integer); - let boundary = table.reserve(); - table.set( - boundary, - Representation::Variant { - cases: (0..2) - .map(|tag| VariantCase { - tag, - fields: vec![erased; tag as usize + 1], - }) - .collect(), - }, - ); let start = table.add_signature(Signature { parameters: vec![], result: erased, @@ -139,6 +144,29 @@ pub(super) fn append(table: &mut RepresentationTable, continuation: SignatureId) } } +fn reference(heap: RefShape) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap, + }) +} + +fn set_cases(table: &mut RepresentationTable, id: ReprId, fields: Vec>) { + table.set( + id, + Representation::Variant { + cases: fields + .into_iter() + .enumerate() + .map(|(tag, fields)| VariantCase { + tag: tag as u32, + fields, + }) + .collect(), + }, + ); +} + #[cfg(test)] mod tests { use super::*; diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs index b8f4351b..be7452f3 100644 --- a/crates/psrs-backend/src/cc/lower/control/builder.rs +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -87,6 +87,10 @@ impl<'a> Machine<'a> { fields: Vec, body: &mut Vec, ) -> ValueId { + let fields = self + .lower + .control_fields(representation, case, fields, self.span, body) + .expect("machine construction must match its predeclared frame schema"); let value = self.emit(repr(representation), body, |destination| { AssignmentKind::VariantNew { destination, @@ -107,15 +111,19 @@ impl<'a> Machine<'a> { body: &mut Vec, ) -> ValueId { let value = self.cast(value, repr(representation), body); - self.emit(erased_shape(), body, |destination| { - AssignmentKind::VariantGet { - destination, - representation, - case, - field, - value, - } - }) + let shape = self.lower.control_field_shape(representation, case, field); + let result = self.emit(shape, body, |destination| AssignmentKind::VariantGet { + destination, + representation, + case, + field, + value, + }); + if shape == erased_shape() { + result + } else { + self.cast(result, erased_shape(), body) + } } pub fn pair(&mut self, state: ValueId, value: ValueId, body: &mut Vec) -> ValueId { diff --git a/crates/psrs-backend/src/cc/lower/control/fields.rs b/crates/psrs-backend/src/cc/lower/control/fields.rs new file mode 100644 index 00000000..2d8d1992 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/fields.rs @@ -0,0 +1,100 @@ +//! Recover machine fields at the explicit erased carrier/callback boundary. + +use super::{FunctionLowerer, control_error}; +use crate::BackendError; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, AssignmentKind, ReprId, Representation, ValueId, ValueShape}; +use psrs_span::TextRange; + +impl FunctionLowerer<'_> { + pub(super) fn control_field_shape( + &self, + representation: ReprId, + case: u32, + field: u32, + ) -> ValueShape { + let Some(Representation::Variant { cases }) = + self.representations.representation(representation) + else { + unreachable!("machine fields require a predeclared variant"); + }; + cases + .iter() + .find(|candidate| candidate.tag == case) + .and_then(|case| case.fields.get(field as usize)) + .copied() + .expect("machine projection must name a predeclared field") + } + + pub(super) fn control_fields( + &mut self, + representation: ReprId, + case: u32, + fields: Vec, + span: TextRange, + assignments: &mut Vec, + ) -> Result, Vec> { + let Some(Representation::Variant { cases }) = + self.representations.representation(representation) + else { + return Err(control_error( + span, + "control frame has no variant representation", + )); + }; + let shapes = cases + .iter() + .find(|candidate| candidate.tag == case) + .map(|case| case.fields.clone()) + .ok_or_else(|| control_error(span, "control frame has an unknown case"))?; + if shapes.len() != fields.len() { + return Err(control_error( + span, + "control frame has an incompatible field count", + )); + } + fields + .into_iter() + .zip(shapes) + .map(|(value, shape)| { + // Source payloads and generated helpers use the erased protocol. + // Storage is nominal; recovery is explicit and checked at runtime. + let source = self + .values + .iter() + .find(|declaration| declaration.id == value) + .map(|declaration| declaration.ty) + .ok_or_else(|| control_error(span, "control field has no value declaration"))?; + if source == shape { + return Ok(value); + } + if source != erased_shape() { + return Err(control_error( + span, + "control field has an incompatible representation", + )); + } + // These are references to existing machine objects, not source + // Array/Function payloads. Payload recovery would adapt their + // contents and could copy a shared mutable status cell. + let ValueShape::Reference(reference) = shape else { + return Err(control_error( + span, + "control field requires a reference shape", + )); + }; + let destination = self.fresh(shape); + assignments.push(Assignment { + destination, + kind: AssignmentKind::RepresentationCast { + destination, + value, + reference, + }, + span, + }); + Ok(destination) + }) + .collect() + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index e34319fe..a8a0939d 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -11,6 +11,7 @@ use psrs_span::TextRange; mod builder; mod executor; +mod fields; mod lifetime; mod owned; mod replay; @@ -98,13 +99,20 @@ impl FunctionLowerer<'_> { }); let shape = builder::repr(layout.context); let context = self.fresh(shape); + let context_fields = self.control_fields( + layout.context, + 0, + vec![boundary], + expression.span, + assignments, + )?; assignments.push(Assignment { destination: context, kind: AssignmentKind::VariantNew { destination: context, representation: layout.context, case: 0, - fields: vec![boundary], + fields: context_fields, }, span: expression.span, }); @@ -153,6 +161,13 @@ impl FunctionLowerer<'_> { _ => return Err(control_error(expression.span, "not a control primitive")), }; let destination = self.fresh(ty); + let fields = self.control_fields( + layout.computation, + case, + fields, + expression.span, + assignments, + )?; assignments.push(Assignment { destination, kind: AssignmentKind::VariantNew { diff --git a/crates/psrs-backend/src/cc/verify/tests/control_frames.rs b/crates/psrs-backend/src/cc/verify/tests/control_frames.rs new file mode 100644 index 00000000..b944d59c --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/tests/control_frames.rs @@ -0,0 +1,179 @@ +//! Machine object identities must survive variant storage and MIR lowering. + +use super::super::verify_function; +use super::symbol; +use crate::cc::layout::control; +use crate::cc::payload::erased_shape; +use crate::cc::{ + Assignment, AssignmentKind, Function, Module, RefShape, Reference, ReprId, Representation, + RepresentationTable, Signature, ValueDecl, ValueId, ValueShape, +}; +use psrs_span::TextRange; +use std::collections::HashMap; + +fn shape(id: ReprId) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(id), + }) +} + +fn constructor(table: &RepresentationTable, representation: ReprId, case: u32) -> Function { + let Some(Representation::Variant { cases }) = table.representation(representation) else { + panic!("expected a machine variant"); + }; + let fields = &cases + .iter() + .find(|candidate| candidate.tag == case) + .unwrap() + .fields; + let mut values = fields + .iter() + .enumerate() + .map(|(index, ty)| ValueDecl { + id: ValueId(index as u32), + ty: *ty, + }) + .collect::>(); + let parameters = values.iter().map(|value| value.id).collect::>(); + let result = ValueId(values.len() as u32); + values.push(ValueDecl { + id: result, + ty: shape(representation), + }); + let span = TextRange::new(0, 1); + Function { + symbol: symbol(0), + name: "machine_frame".into(), + parameters: parameters.clone(), + values, + assignments: vec![Assignment { + destination: result, + kind: AssignmentKind::VariantNew { + destination: result, + representation, + case, + fields: parameters, + }, + span, + }], + result, + result_type: shape(representation), + span, + } +} + +#[test] +fn control_frames_reject_erased_or_wrong_machine_fields_in_cc() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + for (representation, case, field, wrong) in [ + (layout.computation, 3, 1, shape(layout.boundary)), + (layout.computation, 4, 2, shape(layout.sequence)), + (layout.sequence, 2, 0, shape(layout.context)), + (layout.sequence, 3, 0, shape(layout.sequence)), + (layout.context, 1, 4, shape(layout.boundary)), + (layout.owner, 0, 1, shape(layout.callback)), + (layout.boundary, 1, 1, shape(layout.owner)), + ] { + let valid = constructor(&table, representation, case); + verify_function(&valid, &HashMap::new(), &table).expect("valid machine fields"); + for wrong in [wrong, erased_shape()] { + let mut invalid = valid.clone(); + invalid.values[field].ty = wrong; + let errors = verify_function(&invalid, &HashMap::new(), &table).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("variant fields")), + "{errors:?}" + ); + } + } +} + +#[test] +fn control_frame_projection_cannot_silently_erase_checkpoint_identity() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + let mut function = constructor(&table, layout.sequence, 3); + let result = ValueId(function.values.len() as u32); + function.values.push(ValueDecl { + id: result, + ty: erased_shape(), + }); + function.assignments.push(Assignment { + destination: result, + kind: AssignmentKind::VariantGet { + destination: result, + representation: layout.sequence, + case: 3, + field: 0, + value: function.result, + }, + span: function.span, + }); + function.result = result; + function.result_type = erased_shape(); + let errors = verify_function(&function, &HashMap::new(), &table).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("variant field has")), + "{errors:?}" + ); +} + +#[test] +fn mir_preserves_control_frame_fields_and_rejects_cross_wired_storage() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + for (representation, case, left, right) in [ + (layout.computation, 3, 1, 2), + (layout.sequence, 3, 0, 1), + (layout.context, 1, 2, 3), + (layout.owner, 0, 0, 1), + (layout.boundary, 1, 0, 1), + ] { + let function = constructor(&table, representation, case); + let module = Module { + name: "ControlFrames".into(), + functions: vec![function.clone()], + externals: vec![], + representations: table.clone(), + entry: None, + span: function.span, + }; + let (mut mir, _) = crate::mir::lower_module(module).expect("valid typed machine frame"); + crate::mir::verify_module(&mir).expect("valid frame in MIR"); + let instruction = mir.functions[0].blocks.iter_mut() + .flat_map(|block| &mut block.instructions) + .find(|instruction| matches!(instruction, crate::mir::Instruction::StructNew { arguments, .. } if arguments.len() == function.parameters.len() + 1)) + .expect("frame constructor"); + let crate::mir::Instruction::StructNew { arguments, .. } = instruction else { + unreachable!() + }; + // Slot zero is the variant tag; mutate only its stored payload fields. + arguments.swap(left + 1, right + 1); + let errors = + crate::mir::verify_module(&mir).expect_err("MIR must reject cross-wired frame storage"); + assert!( + errors.iter().any(|error| error + .message + .contains("struct.new argument has the wrong type")), + "{errors:?}" + ); + } +} diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index cac15013..b5194452 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -4,6 +4,7 @@ use psrs_hir::ModuleId; use psrs_span::TextRange; mod adaptation; +mod control_frames; mod dictionary; mod effects; mod number_decimal; diff --git a/crates/psrs-driver/tests/control_support/mod.rs b/crates/psrs-driver/tests/control_support/mod.rs index 52fb7f54..84f706a0 100644 --- a/crates/psrs-driver/tests/control_support/mod.rs +++ b/crates/psrs-driver/tests/control_support/mod.rs @@ -54,6 +54,13 @@ fn run(name: &str, source: &str, expected: i32, force_gc: bool) { Some(expected), "expected {name} to exit {expected}, got {output:?}" ); + if expected == 134 { + let stderr = String::from_utf8_lossy(&output.stderr); + assert!( + stderr.contains("wasm trap:") && !stderr.contains("cast failure"), + "expected a guest trap without an invalid machine representation in {name}, got: {stderr}" + ); + } } /// Preserve coverage of user-defined open state folds on the revised primitive. diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index cbbe200b..b729f0ca 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure; nominal machine storage fields reject cross-wired queues, extents and ownership cells in CC/MIR. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 52427189..3c50ac5b 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -164,6 +164,30 @@ answer boundary; replay-local captures still expire at branch completion. Long request sequences require allocation and ancestor-depth evidence as well as stack evidence. Any optimization must preserve the observable expiry rules. +### Machine storage contracts + +The representation table owns the recursive field schema. Computation links, +queue tails, finish extents, caller contexts, owner callback cells and status +cells have explicit `ReprId` shapes; stored bind/handler callbacks have the +predeclared unary callable shape. Only user requests, answers and the mutable +callback-cell contents use erased storage. A spent owner clears its callback +slot with another erased reference while its integer status cell stays shared. + +The erased carrier/helper protocol uses explicit reference casts to recover +these existing machine objects before construction. This is not source payload +recovery: adapting array contents here would copy a status cell and invalidate +ownership/lifetime sharing. Projections produce their declared stored shape; +erasure for a helper call is a separate conversion. CC verifies construction +and projection shapes, and the target planner retains them as MIR struct field +types, including recursive queue/context/extent references. + +These storage contracts reject a queue supplied as a finish extent and an +erased field projection declared without an explicit conversion. They do not +prove which particular extent owns a checkpoint or that two same-shaped fields +have compatible source/target domains. Full semantic provenance verification +must additionally retain those identities through helper calls and casts; a +well-shaped reference cast alone is not that proof. + ### Alternatives - Moving old clause execution to the caller changes neither its source type nor diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index ce29e3d0..e2c9fabd 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -650,3 +650,51 @@ Logs: `/private/tmp/psrs-control-v2-locked.log`, `/private/tmp/psrs-control-v2-package.log`, and `/private/tmp/psrs-control-v2-core.log`. The full workspace failure-set comparison above used the explicit development path to the same package content; it is not relabelled as a default-selection run. + +## Nominal machine storage continuation (2026-10-11) + +Starting point: compiler `bdaf0cfc`, a clean worktree, and the default locked +stdlib `5d523805c4e2096e68fab5a4f965f62b225ee2af`. The scoped runtime, nested +replay and lifetime targets pass before the change; their baseline log is +`/private/tmp/psrs-control-typed-frames-before.log`. + +CC layout now stores computation links, queue tails, finish extents, caller +contexts and ownership cells with explicit representation handles. Stored +callbacks name the predeclared unary signature. Primitive and synthesized +constructors consult this same immutable schema; projections declare its field +shape before a separate erasure. Existing erased carrier/helper boundaries use +explicit reference casts. They recover existing objects without invoking source +array payload conversion, which would adapt/copy a shared integer status cell. +The target planner retains recursive nominal fields in MIR struct types. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Reject wrong or erased machine storage fields | `control_frames_reject_erased_or_wrong_machine_fields_in_cc`: resume queue, handle body, append queue, finish extent, caller context, owner status and boundary parent | Focused Verified | +| Preserve typed projection before erasure | `control_frame_projection_cannot_silently_erase_checkpoint_identity` rejects an erased declaration for a finish extent projection | Focused Verified | +| Preserve field contracts into MIR | `mir_preserves_control_frame_fields_and_rejects_cross_wired_storage` lowers valid recursive frames, then swaps fields in resume, finish, context, owner and boundary structs; MIR rejects wrong argument types | Focused Verified | +| Preserve execution and shared ownership | All 80 control tests pass with mandatory Wasmtime and default package selection, including reentrant live raw resume, nested replay, expiry, cancellation, GC and long requests | Focused Verified | +| Prove semantic source/target identity and checkpoint provenance | Same-shaped extents/domains can still be exchanged without this storage check proving their ownership; erased helper calls and reference casts remain trusted producer boundaries | Unverified | + +Trap assertions now require an actual guest trap and reject cast failures, so +incorrect machine representations cannot satisfy expected control rejection. +Ordinary strictness/ignored-result fixtures retain their divide-by-zero traps. +No package source, control signature, intrinsic identity or gate measurement +changes in this continuation. Full AE/AC acceptance remains Unverified. + +Validation logs: `/private/tmp/psrs-control-typed-frames-ir.log` (three new +malformed-IR tests), `/private/tmp/psrs-control-typed-frames-control.log` (80 control +tests), and `/private/tmp/psrs-control-typed-frames-clippy.log` (workspace clippy). +Formatting and diff checking pass. `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace +--no-fail-fast` executes all 427 backend tests and the control targets successfully. +The nine pre-existing non-doc targets still fail at exactly the same 175 test +names as the v2 baseline, with no added or recovered names. Two additional +doctest targets report `E0463` (missing dependency crate) in that run while other +validation commands rebuild shared artifacts; a subsequent serial +`cargo test -p psrs-backend -p psrs-driver --doc` passes both targets (zero doc +examples). This rerun resolves the observed operational failures, without +relabeling the initial full workspace run as passing. +Logs: `/private/tmp/psrs-control-typed-frames-workspace.log`, +`/private/tmp/psrs-control-typed-frames-comparison.json`, and +`/private/tmp/psrs-control-typed-frames-doctests.log`. No official scoreboard or +upstream type comparison is rerun for this internal storage change; the prior +package type/source evidence is retained rather than remeasured here. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 7d52ecea..959d39b6 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -16,6 +16,9 @@ stdlib `5d523805c4e2096e68fab5a4f965f62b225ee2af` with content identity selection with mandatory Wasmtime; the official type comparison and nine public package fixtures are recorded in the v2 checklist. Historical sections below preserve prior checkpoints; the five-argument API belongs to those checkpoints. +The continuation from compiler `bdaf0cfc` makes machine frame storage fields +nominal and adds malformed CC/MIR construction/projection checks; detailed +validation is recorded in the acceptance checklist's machine storage section. Full frame/context identity verification, allocation/depth measurements, foreign resources and caught-trap cleanup remain outstanding. From d2125f5c760d71db74563d9f8e3d00dcecec968c Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 00:15:51 +0800 Subject: [PATCH 107/148] Preserve nominal control types across helper calls and captures --- crates/psrs-backend/src/cc/layout/control.rs | 46 ++- .../src/cc/lower/control/builder.rs | 90 ++++-- .../src/cc/lower/control/executor.rs | 32 ++- .../src/cc/lower/control/fields.rs | 51 +++- .../src/cc/lower/control/lifetime.rs | 34 +-- .../psrs-backend/src/cc/lower/control/mod.rs | 142 +++++---- .../src/cc/lower/control/owned.rs | 14 +- .../src/cc/lower/control/replay.rs | 69 +++-- .../src/cc/verify/tests/control_calls.rs | 271 ++++++++++++++++++ .../psrs-backend/src/cc/verify/tests/mod.rs | 1 + .../src/tests/control_contracts.rs | 92 ++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 24 +- .../backend/algebraic-effects.md | 73 ++++- ...ted-control-lowering-handoff-2026-10-11.md | 4 + 16 files changed, 774 insertions(+), 172 deletions(-) create mode 100644 crates/psrs-backend/src/cc/verify/tests/control_calls.rs create mode 100644 crates/psrs-driver/src/tests/control_contracts.rs diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control.rs index bbb99048..907069ce 100644 --- a/crates/psrs-backend/src/cc/layout/control.rs +++ b/crates/psrs-backend/src/cc/layout/control.rs @@ -22,6 +22,9 @@ pub(in crate::cc) struct ControlLayout { pub status: ReprId, pub start: SignatureId, pub boundary_check: SignatureId, + pub once: SignatureId, + pub cancel: SignatureId, + pub replay_result: ReprId, } pub(in crate::cc) fn append( @@ -94,6 +97,14 @@ pub(in crate::cc) fn append( vec![reference(RefShape::Repr(status)), extent], ], ); + let replay_result = table.reserve(); + table.set( + replay_result, + Representation::Product { + fields: vec![queue, extent], + }, + ); + let replay = reference(RefShape::Repr(replay_result)); let labels = vec!["_1".to_owned(), "_2".to_owned()]; let pair = super::protocols::record(table, &labels).unwrap_or_else(|| { let pair = table.reserve(); @@ -107,24 +118,40 @@ pub(in crate::cc) fn append( pair }); let executor = table.add_signature(Signature { - parameters: vec![erased; 6], + parameters: vec![ + erased, + callable, + frame, + queue, + extent, + reference(RefShape::Repr(context)), + ], result: erased, }); let clone_sequence = table.add_signature(Signature { - parameters: vec![erased; 5], - result: erased, + parameters: vec![queue, queue, queue, extent, extent], + result: replay, }); let rebuild_sequence = table.add_signature(Signature { - parameters: vec![erased; 4], - result: erased, + parameters: vec![queue, queue, extent, extent], + result: replay, }); let start = table.add_signature(Signature { parameters: vec![], - result: erased, + result: extent, }); let boundary_check = table.add_signature(Signature { - parameters: vec![erased], - result: erased, + parameters: vec![extent], + result: extent, + }); + let owner_shape = reference(RefShape::Repr(owner)); + let once = table.add_signature(Signature { + parameters: vec![callable], + result: owner_shape, + }); + let cancel = table.add_signature(Signature { + parameters: vec![owner_shape], + result: owner_shape, }); ControlLayout { computation, @@ -141,6 +168,9 @@ pub(in crate::cc) fn append( status, start, boundary_check, + once, + cancel, + replay_result, } } diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs index be7452f3..bfeb27cd 100644 --- a/crates/psrs-backend/src/cc/lower/control/builder.rs +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -68,6 +68,9 @@ impl<'a> Machine<'a> { shape: ValueShape, body: &mut Vec, ) -> ValueId { + if self.value_shape(value) == shape { + return value; + } let ValueShape::Reference(reference) = shape else { unreachable!("machine casts only references"); }; @@ -91,15 +94,14 @@ impl<'a> Machine<'a> { .lower .control_fields(representation, case, fields, self.span, body) .expect("machine construction must match its predeclared frame schema"); - let value = self.emit(repr(representation), body, |destination| { + self.emit(repr(representation), body, |destination| { AssignmentKind::VariantNew { destination, representation, case, fields, } - }); - self.cast(value, erased_shape(), body) + }) } pub fn field( @@ -112,21 +114,18 @@ impl<'a> Machine<'a> { ) -> ValueId { let value = self.cast(value, repr(representation), body); let shape = self.lower.control_field_shape(representation, case, field); - let result = self.emit(shape, body, |destination| AssignmentKind::VariantGet { + self.emit(shape, body, |destination| AssignmentKind::VariantGet { destination, representation, case, field, value, - }); - if shape == erased_shape() { - result - } else { - self.cast(result, erased_shape(), body) - } + }) } pub fn pair(&mut self, state: ValueId, value: ValueId, body: &mut Vec) -> ValueId { + let state = self.cast(state, erased_shape(), body); + let value = self.cast(value, erased_shape(), body); let representation = self.layout.pair; let value = self.emit(repr(representation), body, |destination| { AssignmentKind::ProductNew { @@ -156,9 +155,16 @@ impl<'a> Machine<'a> { }) } - pub fn capture(&mut self, closure: ValueId, index: u32, body: &mut Vec) -> ValueId { - self.emit(erased_shape(), body, |_| { - AssignmentKind::ClosureGetCapture { closure, index } + pub fn capture( + &mut self, + closure: ValueId, + index: u32, + shape: ValueShape, + body: &mut Vec, + ) -> ValueId { + self.emit(shape, body, |_| AssignmentKind::ClosureGetCapture { + closure, + index, }) } @@ -169,14 +175,13 @@ impl<'a> Machine<'a> { captures: Vec, body: &mut Vec, ) -> ValueId { - let value = self.emit(reference(RefShape::Closure(signature)), body, |_| { + self.emit(reference(RefShape::Closure(signature)), body, |_| { AssignmentKind::FunctionRef { function, signature, captures, } - }); - self.cast(value, erased_shape(), body) + }) } /// Use the common curry protocol; every intermediate result is erased. @@ -188,11 +193,12 @@ impl<'a> Machine<'a> { ) -> ValueId { let signature = self.layout.continuation; for argument in arguments { + let argument = self.cast(*argument, erased_shape(), body); let callable = self.cast(function, reference(RefShape::Closure(signature)), body); function = self.emit(erased_shape(), body, |_| AssignmentKind::IndirectCall { function: callable, signature, - arguments: vec![*argument], + arguments: vec![argument], }); } function @@ -215,10 +221,28 @@ impl<'a> Machine<'a> { self.boundary.unwrap(), self.context.unwrap(), ]; - self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { - function, - arguments, - }) + self.call(function, arguments, body) + } + + pub fn call( + &mut self, + function: SymbolId, + arguments: Vec, + body: &mut Vec, + ) -> ValueId { + let signature = self.functions.signature(self.layout, function); + self.lower + .control_call(function, signature, arguments, self.span, body) + .expect("generated call must match its predeclared signature") + } + + pub fn value_shape(&self, value: ValueId) -> ValueShape { + self.lower + .values + .iter() + .find(|declaration| declaration.id == value) + .map(|declaration| declaration.ty) + .expect("declared machine value") } pub fn switch( @@ -236,13 +260,14 @@ impl<'a> Machine<'a> { value, } }); - let trap = self.lower.fresh(erased_shape()); + let shape = self.value_shape(cases.first().expect("machine switch has cases").value); + let trap = self.lower.fresh(shape); let default_assignments = vec![Assignment { destination: trap, kind: AssignmentKind::Unreachable, span: self.span, }]; - self.emit(erased_shape(), body, |_| AssignmentKind::TagSwitch { + self.emit(shape, body, |_| AssignmentKind::TagSwitch { value: tag, cases, default_assignments, @@ -251,20 +276,33 @@ impl<'a> Machine<'a> { } pub fn finish( - self, + mut self, symbol: SymbolId, name: &str, parameters: Vec, - assignments: Vec, + mut assignments: Vec, result: ValueId, ) -> Function { + let result_type = if symbol == self.functions.resume { + erased_shape() + } else { + self.lower + .representations + .signature(self.functions.signature(self.layout, symbol)) + .expect("predeclared machine signature") + .result + }; + let result = self + .lower + .control_values(vec![result], vec![result_type], self.span, &mut assignments) + .expect("machine result must match its predeclared signature")[0]; Function { symbol, name: name.into(), parameters, assignments, result, - result_type: erased_shape(), + result_type, values: self.lower.values, span: self.span, } diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index 8f9ed0a1..d47b541c 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -1,17 +1,22 @@ //! A flat driver; only the driver traverses saved continuation sequences. -use super::builder::Machine; +use super::builder::{Machine, repr}; use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, TagCase, ValueId}; impl Machine<'_> { pub(super) fn executor(mut self) -> Function { let state = self.lower.fresh(erased_shape()); - let handler = self.lower.fresh(erased_shape()); - let computation = self.lower.fresh(erased_shape()); - let sequence = self.lower.fresh(erased_shape()); - let boundary = self.lower.fresh(erased_shape()); - let context = self.lower.fresh(erased_shape()); + let signature = self + .lower + .representations + .signature(self.layout.executor) + .unwrap(); + let handler = self.lower.fresh(signature.parameters[1]); + let computation = self.lower.fresh(repr(self.layout.computation)); + let sequence = self.lower.fresh(repr(self.layout.sequence)); + let boundary = self.lower.fresh(repr(self.layout.boundary)); + let context = self.lower.fresh(repr(self.layout.context)); self.boundary = Some(boundary); self.context = Some(context); let parameters = vec![state, handler, computation, sequence, boundary, context]; @@ -47,14 +52,13 @@ impl Machine<'_> { let function = self.functions.clone_sequence; let boundary = self.boundary.unwrap(); let parent = self.dispatch_boundary(&mut body); - let cloned = self.emit(erased_shape(), &mut body, |_| { - crate::cc::AssignmentKind::DirectCall { - function, - arguments: vec![saved, empty, empty, boundary, parent], - } - }); - let saved = self.pair_field(cloned, 0, &mut body); - let active = self.pair_field(cloned, 1, &mut body); + let cloned = self.call( + function, + vec![saved, empty, empty, boundary, parent], + &mut body, + ); + let saved = self.replay_field(cloned, 0, &mut body); + let active = self.replay_field(cloned, 1, &mut body); let pending = self.node(self.layout.sequence, 2, vec![saved, sequence], &mut body); self.boundary = Some(active); let next = self.node(self.layout.computation, 0, vec![value], &mut body); diff --git a/crates/psrs-backend/src/cc/lower/control/fields.rs b/crates/psrs-backend/src/cc/lower/control/fields.rs index 2d8d1992..fea3e120 100644 --- a/crates/psrs-backend/src/cc/lower/control/fields.rs +++ b/crates/psrs-backend/src/cc/lower/control/fields.rs @@ -3,7 +3,10 @@ use super::{FunctionLowerer, control_error}; use crate::BackendError; use crate::cc::payload::erased_shape; -use crate::cc::{Assignment, AssignmentKind, ReprId, Representation, ValueId, ValueShape}; +use crate::cc::{ + Assignment, AssignmentKind, ReprId, Representation, SignatureId, ValueId, ValueShape, +}; +use psrs_hir::SymbolId; use psrs_span::TextRange; impl FunctionLowerer<'_> { @@ -47,18 +50,28 @@ impl FunctionLowerer<'_> { .find(|candidate| candidate.tag == case) .map(|case| case.fields.clone()) .ok_or_else(|| control_error(span, "control frame has an unknown case"))?; + self.control_values(fields, shapes, span, assignments) + } + + pub(super) fn control_values( + &mut self, + fields: Vec, + shapes: Vec, + span: TextRange, + assignments: &mut Vec, + ) -> Result, Vec> { if shapes.len() != fields.len() { return Err(control_error( span, - "control frame has an incompatible field count", + "control values have an incompatible count", )); } fields .into_iter() .zip(shapes) .map(|(value, shape)| { - // Source payloads and generated helpers use the erased protocol. - // Storage is nominal; recovery is explicit and checked at runtime. + // Source payloads and user callbacks use the erased protocol. + // Machine helpers keep their predeclared nominal shapes. let source = self .values .iter() @@ -68,7 +81,9 @@ impl FunctionLowerer<'_> { if source == shape { return Ok(value); } - if source != erased_shape() { + if !matches!(source, ValueShape::Reference(_)) + || (source != erased_shape() && shape != erased_shape()) + { return Err(control_error( span, "control field has an incompatible representation", @@ -97,4 +112,30 @@ impl FunctionLowerer<'_> { }) .collect() } + + pub(super) fn control_call( + &mut self, + function: SymbolId, + signature: SignatureId, + arguments: Vec, + span: TextRange, + assignments: &mut Vec, + ) -> Result> { + let signature = self + .representations + .signature(signature) + .ok_or_else(|| control_error(span, "control call has no predeclared signature"))? + .clone(); + let arguments = self.control_values(arguments, signature.parameters, span, assignments)?; + let destination = self.fresh(signature.result); + assignments.push(Assignment { + destination, + kind: AssignmentKind::DirectCall { + function, + arguments, + }, + span, + }); + Ok(destination) + } } diff --git a/crates/psrs-backend/src/cc/lower/control/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/lifetime.rs index 2b5c7199..275c054c 100644 --- a/crates/psrs-backend/src/cc/lower/control/lifetime.rs +++ b/crates/psrs-backend/src/cc/lower/control/lifetime.rs @@ -2,7 +2,6 @@ use super::builder::{Machine, repr}; use super::executor::arm; -use crate::cc::payload::erased_shape; use crate::cc::{Assignment, AssignmentKind, Function, TagCase, ValueId, ValueShape}; impl Machine<'_> { @@ -16,14 +15,13 @@ impl Machine<'_> { value: ValueId, body: &mut Vec, ) -> ValueId { - let cell = self.emit(repr(representation), body, |destination| { + self.emit(repr(representation), body, |destination| { AssignmentKind::ArrayNew { destination, representation, elements: vec![value], } - }); - self.cast(cell, erased_shape(), body) + }) } pub(super) fn read_cell( @@ -51,6 +49,15 @@ impl Machine<'_> { body: &mut Vec, ) { let cell = self.cast(cell, repr(representation), body); + let Some(crate::cc::Representation::Array { element }) = + self.lower.representations.representation(representation) + else { + unreachable!("machine cell is an array"); + }; + let new_value = self + .lower + .control_values(vec![new_value], vec![*element], self.span, body) + .expect("machine write must preserve its cell representation")[0]; let index = self.integer(0, body); body.push(Assignment { destination: cell, @@ -90,13 +97,14 @@ impl Machine<'_> { cases: Vec, body: &mut Vec, ) -> ValueId { - let trap = self.lower.fresh(erased_shape()); + let shape = self.value_shape(cases.first().expect("machine select has cases").value); + let trap = self.lower.fresh(shape); let default_assignments = vec![Assignment { destination: trap, kind: AssignmentKind::Unreachable, span: self.span, }]; - self.emit(erased_shape(), body, |_| AssignmentKind::TagSwitch { + self.emit(shape, body, |_| AssignmentKind::TagSwitch { value, cases, default_assignments, @@ -123,10 +131,7 @@ impl Machine<'_> { body: &mut Vec, ) -> ValueId { let function = self.functions.check; - self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { - function, - arguments: vec![boundary], - }) + self.call(function, vec![boundary], body) } pub(super) fn close_boundary( @@ -135,10 +140,7 @@ impl Machine<'_> { body: &mut Vec, ) -> ValueId { let function = self.functions.close; - self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { - function, - arguments: vec![boundary], - }) + self.call(function, vec![boundary], body) } pub(super) fn start_boundary(mut self) -> Function { @@ -149,7 +151,7 @@ impl Machine<'_> { } pub(super) fn boundary_check(mut self) -> Function { - let boundary = self.lower.fresh(erased_shape()); + let boundary = self.lower.fresh(repr(self.layout.boundary)); let mut cases = Vec::new(); for case in 0..2 { let mut branch = Vec::new(); @@ -176,7 +178,7 @@ impl Machine<'_> { } pub(super) fn boundary_close(mut self) -> Function { - let boundary = self.lower.fresh(erased_shape()); + let boundary = self.lower.fresh(repr(self.layout.boundary)); let mut cases = Vec::new(); for case in 0..2 { let mut branch = Vec::new(); diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index a8a0939d..69eef430 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -4,7 +4,7 @@ use super::{FunctionLowerer, LambdaLowering}; use crate::BackendError; use crate::cc::layout::control::ControlLayout; use crate::cc::payload::erased_shape; -use crate::cc::{Assignment, AssignmentKind, ValueId, ValueShape}; +use crate::cc::{Assignment, AssignmentKind, SignatureId, ValueId, ValueShape}; use psrs_core::Expr; use psrs_hir::{Intrinsic, SymbolId}; use psrs_span::TextRange; @@ -31,6 +31,29 @@ pub(in crate::cc) struct ControlFunctions { cancel: SymbolId, } +impl ControlFunctions { + fn signatures(self, layout: ControlLayout) -> [(SymbolId, SignatureId); 8] { + [ + (self.executor, layout.executor), + (self.clone_sequence, layout.clone_sequence), + (self.rebuild_sequence, layout.rebuild_sequence), + (self.start, layout.start), + (self.check, layout.boundary_check), + (self.close, layout.boundary_check), + (self.once, layout.once), + (self.cancel, layout.cancel), + ] + } + + fn signature(self, layout: ControlLayout, function: SymbolId) -> SignatureId { + self.signatures(layout) + .into_iter() + .find(|(symbol, _)| *symbol == function) + .map(|(_, signature)| signature) + .expect("predeclared control function") + } +} + impl FunctionLowerer<'_> { pub(super) fn lower_control( &mut self, @@ -57,15 +80,13 @@ impl FunctionLowerer<'_> { } else { functions.cancel }; - let result = self.fresh(erased_shape()); - assignments.push(Assignment { - destination: result, - kind: AssignmentKind::DirectCall { - function, - arguments: fields, - }, - span: expression.span, - }); + let result = self.control_call( + function, + functions.signature(layout, function), + fields, + expression.span, + assignments, + )?; if intrinsic == Intrinsic::ControlCancel { let unit = self.fresh(ty); assignments.push(Assignment { @@ -76,11 +97,15 @@ impl FunctionLowerer<'_> { return Ok(unit); } let conversion = self.recover_payload(ty, expression.span)?; + let source = builder::repr(layout.owner); return Ok(self.emit_conversion( result, - erased_shape(), + source, ty, - conversion, + crate::cc::ValueConversion::Sequence(vec![ + crate::cc::ValueConversion::EraseReference, + conversion, + ]), expression.span, assignments, )); @@ -88,15 +113,13 @@ impl FunctionLowerer<'_> { if intrinsic == Intrinsic::ControlRun { let functions = self.ensure_control_functions(layout, expression.span)?; let empty = self.control_empty_sequence(layout, expression.span, assignments); - let boundary = self.fresh(erased_shape()); - assignments.push(Assignment { - destination: boundary, - kind: AssignmentKind::DirectCall { - function: functions.start, - arguments: vec![], - }, - span: expression.span, - }); + let boundary = self.control_call( + functions.start, + layout.start, + vec![], + expression.span, + assignments, + )?; let shape = builder::repr(layout.context); let context = self.fresh(shape); let context_fields = self.control_fields( @@ -116,32 +139,20 @@ impl FunctionLowerer<'_> { }, span: expression.span, }); - let context = self.emit_conversion( - context, - shape, - erased_shape(), - crate::cc::ValueConversion::EraseReference, + let result = self.control_call( + functions.executor, + layout.executor, + vec![fields[0], fields[1], fields[2], empty, boundary, context], expression.span, assignments, - ); - let result = self.fresh(erased_shape()); - assignments.push(Assignment { - destination: result, - kind: AssignmentKind::DirectCall { - function: functions.executor, - arguments: vec![fields[0], fields[1], fields[2], empty, boundary, context], - }, - span: expression.span, - }); - let closed = self.fresh(erased_shape()); - assignments.push(Assignment { - destination: closed, - kind: AssignmentKind::DirectCall { - function: functions.close, - arguments: vec![boundary], - }, - span: expression.span, - }); + )?; + self.control_call( + functions.close, + layout.boundary_check, + vec![boundary], + expression.span, + assignments, + )?; let conversion = self.recover_payload(ty, expression.span)?; return Ok(self.emit_conversion( result, @@ -199,14 +210,7 @@ impl FunctionLowerer<'_> { }, span, }); - self.emit_conversion( - value, - shape, - erased_shape(), - crate::cc::ValueConversion::EraseReference, - span, - assignments, - ) + value } fn ensure_control_functions( @@ -231,23 +235,7 @@ impl FunctionLowerer<'_> { cancel: symbols.fresh(self.owner), } }; - let signature = self - .representations - .signature(layout.executor) - .ok_or_else(|| control_error(span, "control executor has no predeclared signature"))? - .clone(); - self.generated_signatures - .borrow_mut() - .insert(functions.executor, signature); - for (symbol, id) in [ - (functions.clone_sequence, layout.clone_sequence), - (functions.rebuild_sequence, layout.rebuild_sequence), - (functions.start, layout.start), - (functions.check, layout.boundary_check), - (functions.close, layout.boundary_check), - (functions.once, layout.boundary_check), - (functions.cancel, layout.boundary_check), - ] { + for (symbol, id) in functions.signatures(layout) { let signature = self .representations .signature(id) @@ -266,8 +254,18 @@ impl FunctionLowerer<'_> { let receiver = resume.lower.fresh(super::lambda::closure_value_type()); let value = resume.lower.fresh(erased_shape()); let mut assignments = Vec::new(); - let saved = resume.capture(receiver, 0, &mut assignments); - let boundary = resume.capture(receiver, 1, &mut assignments); + let saved = resume.capture( + receiver, + 0, + builder::repr(layout.sequence), + &mut assignments, + ); + let boundary = resume.capture( + receiver, + 1, + builder::repr(layout.boundary), + &mut assignments, + ); resume.check_boundary(boundary, &mut assignments); let result = resume.node( layout.computation, diff --git a/crates/psrs-backend/src/cc/lower/control/owned.rs b/crates/psrs-backend/src/cc/lower/control/owned.rs index 15cbcfa8..3c70ef62 100644 --- a/crates/psrs-backend/src/cc/lower/control/owned.rs +++ b/crates/psrs-backend/src/cc/lower/control/owned.rs @@ -1,14 +1,20 @@ //! One-shot ownership is consumed at interpretation, before invoking user code. -use super::builder::Machine; +use super::builder::{Machine, repr}; use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, ValueId}; impl Machine<'_> { pub(super) fn owned(mut self) -> Function { - let continuation = self.lower.fresh(erased_shape()); + let signature = self + .lower + .representations + .signature(self.layout.once) + .unwrap(); + let continuation = self.lower.fresh(signature.parameters[0]); let mut body = Vec::new(); - let callback = self.new_cell(self.layout.callback, continuation, &mut body); + let erased = self.cast(continuation, erased_shape(), &mut body); + let callback = self.new_cell(self.layout.callback, erased, &mut body); let status = self.new_status(&mut body); let result = self.node(self.layout.owner, 0, vec![callback, status], &mut body); let symbol = self.functions.once; @@ -16,7 +22,7 @@ impl Machine<'_> { } pub(super) fn cancel(mut self) -> Function { - let owner = self.lower.fresh(erased_shape()); + let owner = self.lower.fresh(repr(self.layout.owner)); let mut body = Vec::new(); let status = self.field(owner, self.layout.owner, 0, 1, &mut body); self.guard_pending(status, &mut body); diff --git a/crates/psrs-backend/src/cc/lower/control/replay.rs b/crates/psrs-backend/src/cc/lower/control/replay.rs index b472a662..084ff39b 100644 --- a/crates/psrs-backend/src/cc/lower/control/replay.rs +++ b/crates/psrs-backend/src/cc/lower/control/replay.rs @@ -1,19 +1,18 @@ //! Instantiate lifecycle frames when replaying a persistent source checkpoint. //! Ordinary callbacks and one-shot owner objects are shared, never cloned. -use super::builder::Machine; +use super::builder::{Machine, repr}; use super::executor::arm; -use crate::cc::payload::erased_shape; use crate::cc::{Assignment, AssignmentKind, Function, ValueId}; impl Machine<'_> { /// Flatten into a reversed heap sequence with an explicit traversal stack. pub(super) fn clone_sequence(mut self) -> Function { - let queue = self.lower.fresh(erased_shape()); - let todo = self.lower.fresh(erased_shape()); - let reversed = self.lower.fresh(erased_shape()); - let active = self.lower.fresh(erased_shape()); - let parent = self.lower.fresh(erased_shape()); + let queue = self.lower.fresh(repr(self.layout.sequence)); + let todo = self.lower.fresh(repr(self.layout.sequence)); + let reversed = self.lower.fresh(repr(self.layout.sequence)); + let active = self.lower.fresh(repr(self.layout.boundary)); + let parent = self.lower.fresh(repr(self.layout.boundary)); let mut cases = Vec::new(); let mut body = Vec::new(); let mut empty_cases = Vec::new(); @@ -36,7 +35,9 @@ impl Machine<'_> { &mut branch, ) } else { - self.emit(erased_shape(), &mut branch, |_| AssignmentKind::Unreachable) + self.emit(repr(self.layout.replay_result), &mut branch, |_| { + AssignmentKind::Unreachable + }) } }; empty_cases.push(arm(tag, branch, result)); @@ -83,13 +84,13 @@ impl Machine<'_> { /// Rebuild from the outside inward, giving each finish a fresh child extent. pub(super) fn rebuild_sequence(mut self) -> Function { - let reversed = self.lower.fresh(erased_shape()); - let result_queue = self.lower.fresh(erased_shape()); - let active = self.lower.fresh(erased_shape()); - let parent = self.lower.fresh(erased_shape()); + let reversed = self.lower.fresh(repr(self.layout.sequence)); + let result_queue = self.lower.fresh(repr(self.layout.sequence)); + let active = self.lower.fresh(repr(self.layout.boundary)); + let parent = self.lower.fresh(repr(self.layout.boundary)); let mut cases = Vec::new(); let mut branch = Vec::new(); - let result = self.pair(result_queue, active, &mut branch); + let result = self.replay_result(result_queue, active, &mut branch); cases.push(arm(0, branch, result)); for tag in [1, 3] { let mut branch = Vec::new(); @@ -127,9 +128,45 @@ impl Machine<'_> { arguments: Vec, body: &mut Vec, ) -> ValueId { - self.emit(erased_shape(), body, |_| AssignmentKind::DirectCall { - function, - arguments, + self.call(function, arguments, body) + } + + fn replay_result( + &mut self, + queue: ValueId, + active: ValueId, + body: &mut Vec, + ) -> ValueId { + let representation = self.layout.replay_result; + self.emit(repr(representation), body, |destination| { + AssignmentKind::ProductNew { + destination, + representation, + arguments: vec![queue, active], + } + }) + } + + pub(super) fn replay_field( + &mut self, + value: ValueId, + field: u32, + body: &mut Vec, + ) -> ValueId { + let representation = self.layout.replay_result; + let Some(crate::cc::Representation::Product { fields }) = + self.lower.representations.representation(representation) + else { + unreachable!("predeclared replay result product"); + }; + let shape = *fields + .get(field as usize) + .expect("predeclared replay result field"); + self.emit(shape, body, |destination| AssignmentKind::ProductGet { + destination, + representation, + field, + value, }) } } diff --git a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs new file mode 100644 index 00000000..9a3eb335 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs @@ -0,0 +1,271 @@ +//! Nominal machine identities must survive helper calls and closure captures. + +use super::super::{verify_function, verify_module}; +use super::symbol; +use crate::cc::layout::control; +use crate::cc::payload::erased_shape; +use crate::cc::{ + Assignment, AssignmentKind, Function, Module, RefShape, Reference, RepresentationTable, + Signature, ValueDecl, ValueId, ValueShape, +}; +use psrs_span::TextRange; +use std::collections::HashMap; + +fn reference(heap: RefShape) -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap, + }) +} + +fn call_fixture(signature: &Signature) -> Function { + let mut values = signature + .parameters + .iter() + .enumerate() + .map(|(index, ty)| ValueDecl { + id: ValueId(index as u32), + ty: *ty, + }) + .collect::>(); + let parameters = values.iter().map(|value| value.id).collect::>(); + let result = ValueId(values.len() as u32); + values.push(ValueDecl { + id: result, + ty: signature.result, + }); + let span = TextRange::new(0, 1); + Function { + symbol: symbol(0), + name: "control_call".into(), + parameters: parameters.clone(), + values, + assignments: vec![Assignment { + destination: result, + kind: AssignmentKind::DirectCall { + function: symbol(1), + arguments: parameters, + }, + span, + }], + result, + result_type: signature.result, + span, + } +} + +#[test] +fn control_helper_calls_reject_erased_and_cross_wired_machine_arguments() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + for (id, argument, wrong) in [ + ( + layout.executor, + 3, + reference(RefShape::Repr(layout.boundary)), + ), + ( + layout.clone_sequence, + 0, + reference(RefShape::Repr(layout.boundary)), + ), + ( + layout.rebuild_sequence, + 2, + reference(RefShape::Repr(layout.sequence)), + ), + ( + layout.boundary_check, + 0, + reference(RefShape::Repr(layout.owner)), + ), + (layout.once, 0, reference(RefShape::Repr(layout.owner))), + (layout.cancel, 0, reference(RefShape::Repr(layout.boundary))), + ] { + let signature = table.signature(id).unwrap(); + let signatures = HashMap::from([(symbol(1), signature.clone())]); + let valid = call_fixture(signature); + verify_function(&valid, &signatures, &table).expect("matching machine call"); + for wrong in [wrong, erased_shape()] { + let mut invalid = valid.clone(); + invalid.values[argument].ty = wrong; + let errors = verify_function(&invalid, &signatures, &table).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("call shape mismatch")), + "{errors:?}" + ); + } + } +} + +#[test] +fn control_replay_result_cannot_be_declared_as_an_erased_user_pair() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + let signature = table.signature(layout.clone_sequence).unwrap(); + let signatures = HashMap::from([(symbol(1), signature.clone())]); + let mut function = call_fixture(signature); + function.values.last_mut().unwrap().ty = erased_shape(); + function.result_type = erased_shape(); + let errors = verify_function(&function, &signatures, &table).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("call result shape mismatch")), + "{errors:?}" + ); +} + +#[test] +fn mir_rejects_machine_call_arguments_with_swapped_queue_and_extent() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + for (id, left, right) in [ + (layout.executor, 3, 4), + (layout.clone_sequence, 0, 3), + (layout.rebuild_sequence, 1, 2), + ] { + let caller = call_fixture(table.signature(id).unwrap()); + // The callee body is irrelevant to this call-contract verifier fixture. + let mut callee = caller.clone(); + callee.symbol = symbol(1); + callee.name = "machine_callee".into(); + callee.assignments[0].kind = AssignmentKind::Unreachable; + let module = Module { + name: "MachineCalls".into(), + functions: vec![caller, callee], + externals: vec![], + representations: table.clone(), + entry: None, + span: TextRange::new(0, 1), + }; + verify_module(&module).expect("valid CC helper call"); + let (mut mir, _) = crate::mir::lower_module(module).expect("valid MIR helper call"); + let terminator = mir.functions[0] + .blocks + .iter_mut() + .find_map(|block| { + block.terminator.as_mut().filter(|terminator| { + matches!(terminator, crate::mir::Terminator::ReturnCall { .. }) + }) + }) + .expect("typed helper tail call"); + let crate::mir::Terminator::ReturnCall { arguments, .. } = terminator else { + unreachable!() + }; + arguments.swap(left, right); + let errors = crate::mir::verify_module(&mir).expect_err("wrong machine argument types"); + assert!( + errors + .iter() + .any(|error| error.message.contains("argument")), + "{errors:?}" + ); + } +} + +#[test] +fn raw_resumption_capture_preserves_queue_and_checkpoint_shapes() { + let mut table = RepresentationTable::default(); + let continuation = table.add_signature(Signature { + parameters: vec![erased_shape()], + result: erased_shape(), + }); + let layout = control::append(&mut table, continuation); + let span = TextRange::new(0, 1); + let queue = reference(RefShape::Repr(layout.sequence)); + let boundary = reference(RefShape::Repr(layout.boundary)); + let receiver = reference(RefShape::Aggregate); + let closure = reference(RefShape::Closure(continuation)); + let target = Function { + symbol: symbol(1), + name: "raw_capture_target".into(), + parameters: vec![ValueId(0), ValueId(1)], + values: [receiver, erased_shape(), queue, boundary] + .into_iter() + .enumerate() + .map(|(index, ty)| ValueDecl { + id: ValueId(index as u32), + ty, + }) + .collect(), + assignments: (0..2) + .map(|index| Assignment { + destination: ValueId(index + 2), + kind: AssignmentKind::ClosureGetCapture { + closure: ValueId(0), + index, + }, + span, + }) + .collect(), + result: ValueId(1), + result_type: erased_shape(), + span, + }; + let caller = Function { + symbol: symbol(0), + name: "raw_capture".into(), + parameters: vec![ValueId(0), ValueId(1)], + values: [queue, boundary, closure] + .into_iter() + .enumerate() + .map(|(index, ty)| ValueDecl { + id: ValueId(index as u32), + ty, + }) + .collect(), + assignments: vec![Assignment { + destination: ValueId(2), + kind: AssignmentKind::FunctionRef { + function: symbol(1), + signature: continuation, + captures: vec![ValueId(0), ValueId(1)], + }, + span, + }], + result: ValueId(2), + result_type: closure, + span, + }; + let module = Module { + name: "RawCapture".into(), + functions: vec![caller, target], + externals: vec![], + representations: table, + entry: None, + span, + }; + verify_module(&module).expect("typed checkpoint capture"); + for captures in [vec![ValueId(1), ValueId(0)], vec![ValueId(0), ValueId(0)]] { + let mut invalid = module.clone(); + let AssignmentKind::FunctionRef { + captures: actual, .. + } = &mut invalid.functions[0].assignments[0].kind + else { + unreachable!() + }; + *actual = captures; + let errors = verify_module(&invalid).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("captures do not match")), + "{errors:?}" + ); + } +} diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index b5194452..55efe7c2 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -4,6 +4,7 @@ use psrs_hir::ModuleId; use psrs_span::TextRange; mod adaptation; +mod control_calls; mod control_frames; mod dictionary; mod effects; diff --git a/crates/psrs-driver/src/tests/control_contracts.rs b/crates/psrs-driver/src/tests/control_contracts.rs new file mode 100644 index 00000000..c8a5e892 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_contracts.rs @@ -0,0 +1,92 @@ +//! Structural contracts are checked where control lowering creates them. + +use psrs_backend::cc::{AssignmentKind, Function, RefShape, Representation, ValueId, ValueShape}; + +fn shape(function: &Function, value: ValueId) -> ValueShape { + function + .values + .iter() + .find(|declaration| declaration.id == value) + .unwrap() + .ty +} + +#[test] +fn control_machine_preserves_nominal_capture_and_replay_contracts() { + let input = crate::lower_main_to_cc( + r"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +main :: Int +main = (C.run 0 handler (C.perform (Op \x -> x)))._2 +", + ) + .expect("checked source should lower to CC"); + let find = |name| { + input + .cc + .functions + .iter() + .find(|function| function.name == name) + .unwrap() + }; + let executor = find("control_executor"); + let queue = shape(executor, executor.parameters[3]); + let boundary = shape(executor, executor.parameters[4]); + assert!( + matches!(queue, ValueShape::Reference(reference) if matches!(reference.heap, RefShape::Repr(_))) + ); + assert!( + matches!(boundary, ValueShape::Reference(reference) if matches!(reference.heap, RefShape::Repr(_))) + ); + assert_ne!(queue, boundary); + + let resume = find("control_resume"); + let captures = resume + .assignments + .iter() + .filter_map(|assignment| { + if let AssignmentKind::ClosureGetCapture { index, .. } = &assignment.kind { + Some((*index, shape(resume, assignment.destination))) + } else { + None + } + }) + .collect::>(); + assert_eq!(captures, vec![(0, queue), (1, boundary)]); + + let clone = find("control_clone_sequence"); + let rebuild = find("control_rebuild_sequence"); + let parameters = |function: &Function| { + function + .parameters + .iter() + .map(|value| shape(function, *value)) + .collect::>() + }; + assert_eq!( + parameters(clone), + vec![queue, queue, queue, boundary, boundary] + ); + assert_eq!(parameters(rebuild), vec![queue, queue, boundary, boundary]); + assert_eq!(clone.result_type, rebuild.result_type); + let ValueShape::Reference(reference) = clone.result_type else { + panic!("replay result reference") + }; + let RefShape::Repr(replay) = reference.heap else { + panic!("nominal replay result") + }; + assert_eq!( + input.cc.representations.representation(replay), + Some(&Representation::Product { + fields: vec![queue, boundary] + }) + ); + for name in ["control_check_boundary", "control_close_boundary"] { + let function = find(name); + assert_eq!(parameters(function), vec![boundary]); + assert_eq!(function.result_type, boundary); + } +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 07d10658..bf9b8685 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -7,6 +7,7 @@ static WASM_ARTIFACT_COUNTER: AtomicU32 = AtomicU32::new(0); mod assertions; mod closure_protocol; mod coercion; +mod control_contracts; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index b729f0ca..f1320db7 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure; nominal machine storage fields reject cross-wired queues, extents and ownership cells in CC/MIR. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure; nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC checks raw capture roles. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 3c50ac5b..25a02aa8 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -173,20 +173,28 @@ predeclared unary callable shape. Only user requests, answers and the mutable callback-cell contents use erased storage. A spent owner clears its callback slot with another erased reference while its integer status cell stays shared. -The erased carrier/helper protocol uses explicit reference casts to recover -these existing machine objects before construction. This is not source payload -recovery: adapting array contents here would copy a status cell and invalidate +The source carrier and user callback protocol use explicit reference casts to +recover these existing machine objects before construction. This is not source +payload recovery: adapting array contents here would copy a status cell and invalidate ownership/lifetime sharing. Projections produce their declared stored shape; -erasure for a helper call is a separate conversion. CC verifies construction +erasure for a user callback is a separate conversion. CC verifies construction and projection shapes, and the target planner retains them as MIR struct field types, including recursive queue/context/extent references. -These storage contracts reject a queue supplied as a finish extent and an -erased field projection declared without an explicit conversion. They do not +Machine helper signatures preserve the callable, computation, queue, extent, +context and owner shapes. A raw resumption captures a typed queue and typed +checkpoint extent; closure capture verification checks those same shapes. +Replay returns a dedicated product of `(queue, activeExtent)`, distinct from +the erased user `(state, answer)` protocol. Ordinary helpers and self tail-call +loop parameters retain those types; crossing the user callback protocol erases +only the callback arguments/results that require it. + +These contracts reject a queue supplied as a finish extent or helper argument, +and an erased field projection declared without an explicit conversion. They do not prove which particular extent owns a checkpoint or that two same-shaped fields have compatible source/target domains. Full semantic provenance verification -must additionally retain those identities through helper calls and casts; a -well-shaped reference cast alone is not that proof. +must additionally retain those semantic identities through helper calls and +casts; a well-shaped reference cast alone is not that proof. ### Alternatives diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index e2c9fabd..6e5a0e68 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -42,8 +42,9 @@ them: | AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Unverified | | AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior; suspension is not optimized away | Unverified | -The evidence sections below record focused runtime validation. No official -PureScript differential validation has been run for the control surface. Record +The evidence sections below record focused runtime validation. Official `purs` +type comparisons are recorded in the v2 section; complete pinned upstream-library +differential acceptance remains unverified. Record further evidence with compiler/package identities, commands, actual outputs, and any skips. Do not infer topic completion from existing generic compiler tests. @@ -698,3 +699,71 @@ Logs: `/private/tmp/psrs-control-typed-frames-workspace.log`, `/private/tmp/psrs-control-typed-frames-doctests.log`. No official scoreboard or upstream type comparison is rerun for this internal storage change; the prior package type/source evidence is retained rather than remeasured here. + +## Typed machine helpers and captures (2026-10-12) + +Starting point: compiler `5c78fa78`, a clean worktree and unchanged default locked +stdlib. The lifetime, nested replay and primitive-value targets pass at this +checkpoint and after migration. Baseline: +`/private/tmp/psrs-control-typed-calls-before.log`; focused result: +`/private/tmp/psrs-control-typed-calls-focused.log`. + +Previously, stored fields were nominal but synthesized helpers immediately +erased projections and passed every argument/result as erased data. The raw +resume closure also declared its queue and checkpoint captures as erased. This +continuation removes those unnecessary erasures. Layout predeclares the complete +helper signatures; registration, call construction and function result checking +consume them, without allocating late SignatureIds or duplicating the registry. + +| Helper | Parameters | Result | +| --- | --- | --- | +| Executor | Erased state, unary handler, computation, queue, active extent, dispatch context | Erased user state/answer pair | +| Clone sequence | Queue, traversal stack, reversed queue, active extent, parent extent | Replay result | +| Rebuild sequence | Reversed queue, result queue, active extent, parent extent | Replay result | +| Start boundary | None | Boundary | +| Check/close boundary | Boundary | Boundary | +| Once | Unary callback | Owner | +| Cancel | Owner | Owner | + +Replay result is a dedicated product with nominal queue and active-extent +fields; it cannot be recovered as an ordinary user state/answer pair. Machine +constructors, projections, status cells and raw resume captures retain their +nominal shapes. User callback application alone adapts its arguments and result +through the existing erased curry protocol. Clearing a spent owner's callback +uses an explicit reference erasure, retaining the shared status-cell identity. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Reject erased and wrong helper arguments | `control_helper_calls_reject_erased_and_cross_wired_machine_arguments`: executor, clone/rebuild, lifetime and once/cancel | Focused Verified | +| Distinguish replay result from user pair | `control_replay_result_cannot_be_declared_as_an_erased_user_pair` rejects an erased call-result declaration | Focused Verified | +| Preserve queue/checkpoint capture roles | `raw_resumption_capture_preserves_queue_and_checkpoint_shapes` accepts typed capture and rejects swapped/duplicate capture slots through common closure verification | Focused Verified | +| Preserve helper roles into target calls | `mir_rejects_machine_call_arguments_with_swapped_queue_and_extent` lowers valid CC calls into MIR tail calls, then rejects wrong argument types | Focused Verified | +| Require production lowering to retain these contracts | `control_machine_preserves_nominal_capture_and_replay_contracts` lowers checked source to CC and inspects actual executor parameters, raw captures, replay products and lifetime helpers | Focused Verified | +| Prove source/target domain relation and exact checkpoint owner | Different checkpoints still share `Boundary`; the source/target request and answer relation is checked in Core and not retained as a semantic domain contract in CC/MIR | Unverified | + +No source control scheme, package revision, intrinsic identity, effect inference +or scoreboard measurement changes. This supplies nominal call/capture contracts, +not the complete semantic provenance proof. The remaining verifier must retain +the source/target contract identities and distinguish captured checkpoint owners, +replay activations and completion boundaries even when their physical shapes +match. Complete AE/AC requirements stay Unverified. + +The four new backend malformed-IR tests pass, and the source-to-CC test passes. +Logs: `/private/tmp/psrs-control-typed-calls-ir.log` and +`/private/tmp/psrs-control-typed-calls-source-ir.log`. + +Final validation uses default locked package selection and Wasmtime 49.0.2 +(`3c8a3e79a`), with no development package override. Formatting, diff checking +and `cargo clippy --workspace --all-targets -- -D warnings` pass. +`PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` executes all +431 backend tests, all 80 control tests and the new source-to-CC test successfully. +The full run still fails at the same nine non-doc targets and 175 test names; +failure-name comparison with the previous storage checkpoint adds or recovers +no names. Doctests complete without the prior dependency-artifact errors. +The final workspace run is serial with respect to other Cargo commands. + +Logs: `/private/tmp/psrs-control-typed-calls-workspace.log`, +`/private/tmp/psrs-control-typed-calls-comparison.json`, and +`/private/tmp/psrs-control-typed-calls-clippy.log`. Upstream type comparison, +package conformance and official scoreboards are not rerun for this internal +machine change; their previous evidence is retained. No gate count is updated. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 959d39b6..60c76dcc 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -19,6 +19,10 @@ preserve prior checkpoints; the five-argument API belongs to those checkpoints. The continuation from compiler `bdaf0cfc` makes machine frame storage fields nominal and adds malformed CC/MIR construction/projection checks; detailed validation is recorded in the acceptance checklist's machine storage section. +The 2026-10-12 continuation starts from `5c78fa78` and retains these nominal +types across executor/lifetime/replay calls and raw resumption captures. Replay +returns a dedicated typed queue/activation product. Details and remaining +semantic identity obligations are in the checklist's typed helper section. Full frame/context identity verification, allocation/depth measurements, foreign resources and caught-trap cleanup remain outstanding. From 148e706b0189c66d83e1c5bb345ba7538d15b3c1 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 00:28:32 +0800 Subject: [PATCH 108/148] Verify local closure capture contracts through MIR erasure --- .../src/cc/verify/tests/control_calls.rs | 131 +++++++++++++++++- .../psrs-backend/src/mir/verify/captures.rs | 118 ++++++++++++++++ crates/psrs-backend/src/mir/verify/mod.rs | 2 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 8 ++ .../backend/algebraic-effects.md | 44 ++++++ ...ted-control-lowering-handoff-2026-10-11.md | 4 + 7 files changed, 304 insertions(+), 5 deletions(-) create mode 100644 crates/psrs-backend/src/mir/verify/captures.rs diff --git a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs index 9a3eb335..1f56c68b 100644 --- a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs +++ b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs @@ -178,8 +178,7 @@ fn mir_rejects_machine_call_arguments_with_swapped_queue_and_extent() { } } -#[test] -fn raw_resumption_capture_preserves_queue_and_checkpoint_shapes() { +fn raw_capture_module() -> Module { let mut table = RepresentationTable::default(); let continuation = table.add_signature(Signature { parameters: vec![erased_shape()], @@ -242,14 +241,19 @@ fn raw_resumption_capture_preserves_queue_and_checkpoint_shapes() { result_type: closure, span, }; - let module = Module { + Module { name: "RawCapture".into(), functions: vec![caller, target], externals: vec![], representations: table, entry: None, span, - }; + } +} + +#[test] +fn raw_resumption_capture_preserves_queue_and_checkpoint_shapes() { + let module = raw_capture_module(); verify_module(&module).expect("typed checkpoint capture"); for captures in [vec![ValueId(1), ValueId(0)], vec![ValueId(0), ValueId(0)]] { let mut invalid = module.clone(); @@ -269,3 +273,122 @@ fn raw_resumption_capture_preserves_queue_and_checkpoint_shapes() { ); } } + +#[test] +fn mir_raw_resumption_rejects_swapped_duplicate_and_missing_captures() { + let module = raw_capture_module(); + let (mir, _) = crate::mir::lower_module(module).expect("typed raw captures lower"); + crate::mir::verify_module(&mir).expect("typed MIR captures"); + for slots in [vec![1, 0], vec![0, 0], vec![0]] { + let mut invalid = mir.clone(); + let instruction = &mut invalid.functions[0].blocks[0].instructions[0]; + let crate::mir::Instruction::ClosureNew { captures, .. } = instruction else { + panic!("expected raw closure construction"); + }; + *captures = slots.into_iter().map(crate::types::ValueId).collect(); + let errors = crate::mir::verify_module(&invalid).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("captures do not match")), + "{errors:?}" + ); + } +} + +#[test] +fn mir_capture_contract_survives_sparse_projections_after_optimization() { + let (mut mir, _) = crate::mir::lower_module(raw_capture_module()).unwrap(); + // Dead projection elimination may leave slot 1 without slot 0. Stored + // captures are unchanged; MIR must check the surviving slot by its index. + mir.functions[1].blocks[0].instructions.remove(0); + crate::mir::verify_module(&mir).expect("sparse live projection contract"); + let crate::mir::Instruction::ClosureNew { captures, .. } = + &mut mir.functions[0].blocks[0].instructions[0] + else { + unreachable!() + }; + captures.swap(0, 1); + assert!( + crate::mir::verify_module(&mir) + .unwrap_err() + .iter() + .any(|error| error.message.contains("captures do not match")) + ); +} + +#[test] +fn mir_capture_contract_rejects_inconsistent_reads_of_one_slot() { + let (mut mir, _) = crate::mir::lower_module(raw_capture_module()).unwrap(); + let crate::mir::Instruction::ClosureGetCapture { index, .. } = + &mut mir.functions[1].blocks[0].instructions[1] + else { + unreachable!() + }; + *index = 0; + let errors = crate::mir::verify_module(&mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("incompatible projection types")), + "{errors:?}" + ); +} + +#[test] +fn mir_capture_contract_tracks_receiver_copies_and_reference_casts() { + let (mir, _) = crate::mir::lower_module(raw_capture_module()).unwrap(); + for cast in [false, true] { + let mut module = mir.clone(); + let target = &mut module.functions[1]; + let receiver = target.parameters[0]; + let ty = target + .values + .iter() + .find(|value| value.id == receiver) + .unwrap() + .ty; + let alias = crate::types::ValueId(4); + target + .values + .push(crate::types::ValueDecl { id: alias, ty }); + for instruction in &mut target.blocks[0].instructions { + if let crate::mir::Instruction::ClosureGetCapture { closure, .. } = instruction { + *closure = alias; + } + } + let span = target.span; + let copy = if cast { + let crate::types::ValueType::Ref(reference) = ty else { + unreachable!() + }; + crate::mir::Instruction::RefCast { + destination: alias, + value: receiver, + reference, + span, + } + } else { + crate::mir::Instruction::Copy { + destination: alias, + value: receiver, + span, + } + }; + target.blocks[0].instructions.insert(0, copy); + crate::mir::verify_module(&module).expect("receiver aliases retain the contract"); + let crate::mir::Instruction::ClosureNew { captures, .. } = + &mut module.functions[0].blocks[0].instructions[0] + else { + unreachable!() + }; + captures.swap(0, 1); + let errors = crate::mir::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("captures do not match")), + "{errors:?}" + ); + } +} diff --git a/crates/psrs-backend/src/mir/verify/captures.rs b/crates/psrs-backend/src/mir/verify/captures.rs new file mode 100644 index 00000000..a7f0fa44 --- /dev/null +++ b/crates/psrs-backend/src/mir/verify/captures.rs @@ -0,0 +1,118 @@ +//! Check closure slots against the local code target before eqref storage erases +//! their types. Surviving projections define a sparse contract after optimization. + +use super::util::{mir_error, value_type}; +use crate::BackendError; +use crate::mir::{Function, Instruction, Module, ValueId, ValueType}; +use crate::types::DefinedType; +use std::collections::{HashMap, HashSet}; + +pub(super) fn verify(module: &Module, defined: &[&DefinedType], errors: &mut Vec) { + let contracts = module + .functions + .iter() + .map(|function| { + let receivers = receiver_aliases(function); + let mut slots = HashMap::new(); + for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { + if let Instruction::ClosureGetCapture { + destination, + closure, + index, + span, + .. + } = instruction + && receivers.contains(closure) + && let Some(ty) = value_type(function, *destination) + && slots + .insert(*index, ty) + .is_some_and(|previous| previous != ty) + { + errors.extend( + mir_error( + *span, + "MIR closure capture slot has incompatible projection types", + ) + .into_iter() + .map(|error| error.with_module(function.symbol.module)), + ); + } + } + (function.symbol, slots) + }) + .collect::>(); + + for function in &module.functions { + for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { + let Instruction::ClosureNew { + function: target, + captures, + span, + .. + } = instruction + else { + continue; + }; + // Imported code has no local body from which to derive a contract. + // Its ABI remains a trusted external boundary. + let Some(slots) = contracts.get(target) else { + continue; + }; + for (index, expected) in slots { + let actual = captures + .get(*index as usize) + .and_then(|value| value_type(function, *value)); + if actual.is_none_or(|actual| !compatible(actual, *expected, defined)) { + errors.extend( + mir_error( + *span, + "MIR closure captures do not match target projection types", + ) + .into_iter() + .map(|error| error.with_module(function.symbol.module)), + ); + } + } + } + } +} + +fn receiver_aliases(function: &Function) -> HashSet { + let mut aliases = function + .parameters + .first() + .copied() + .into_iter() + .collect::>(); + loop { + let mut changed = false; + for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { + if let Instruction::Copy { + destination, value, .. + } + | Instruction::RefCast { + destination, value, .. + } = instruction + && aliases.contains(value) + { + changed |= aliases.insert(*destination); + } + } + if !changed { + return aliases; + } + } +} + +fn compatible(actual: ValueType, expected: ValueType, defined: &[&DefinedType]) -> bool { + if actual == expected { + return true; + } + match (actual, expected) { + (ValueType::Ref(actual), ValueType::Ref(expected)) => { + (!actual.nullable || expected.nullable) + && super::subtype::heap_subtype(actual.heap, expected.heap, defined) + } + _ => false, + } +} diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index 24e26823..715ed585 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -11,6 +11,7 @@ use std::collections::{HashMap, HashSet}; mod array_map; mod call; mod capability; +mod captures; mod function; mod instruction; mod subtype; @@ -65,6 +66,7 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { } let defined_types = defined_type_count(module); let defined = defined_types_list(module); + captures::verify(module, &defined, &mut errors); let mut function_ids = HashSet::new(); for (position, function) in module.functions.iter().enumerate() { if !function_ids.insert(function.id) || function.id != FunctionId(position as u32) { diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index f1320db7..7599f875 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure; nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC checks raw capture roles. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure; nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 25a02aa8..0ba4b77c 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -184,6 +184,14 @@ types, including recursive queue/context/extent references. Machine helper signatures preserve the callable, computation, queue, extent, context and owner shapes. A raw resumption captures a typed queue and typed checkpoint extent; closure capture verification checks those same shapes. +MIR checks each locally constructed closure against the surviving capture +projections of its code target before nullable `eqref` storage erases slot types. +Receiver copies and reference casts preserve this relation. The contract is +sparse after dead projection elimination: unused stored slots may remain, but +every surviving slot must exist and supply a compatible type. Repeated reads +of one receiver slot must agree. Imported code and projections from unrelated +closure values remain trusted boundaries; this check does not infer their +capture contracts from a physical closure type. Replay returns a dedicated product of `(queue, activeExtent)`, distinct from the erased user `(state, answer)` protocol. Ordinary helpers and self tail-call loop parameters retain those types; crossing the user callback protocol erases diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 6e5a0e68..184e5d3b 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -767,3 +767,47 @@ Logs: `/private/tmp/psrs-control-typed-calls-workspace.log`, `/private/tmp/psrs-control-typed-calls-clippy.log`. Upstream type comparison, package conformance and official scoreboards are not rerun for this internal machine change; their previous evidence is retained. No gate count is updated. + +## MIR closure capture contracts (2026-10-12) + +Starting point: clean compiler `d2125f5c`, default locked package selection. +Baseline: `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test +control_scoped_replay --test control_lifetime` passes all eight runtime tests +(`/private/tmp/psrs-control-mir-captures-before.log`). The owning boundary is +MIR closure construction: the previous verifier checked eqref representability +without relating capture slots to the locally defined target's projections. + +Common MIR module verification now derives slot types from surviving projections +of the target receiver, following receiver copies and reference casts. Every +local `ClosureNew` must supply compatible values at those indices. Conflicting +reads of one receiver slot are invalid. After optimization, projection contracts +may be sparse; the verifier neither renumbers slots nor requires unused stored +captures to disappear. Imported targets and projections from unrelated closure +values retain their trusted boundary. No synthesized function name or control +intrinsic is used to interpret the contract. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Preserve raw queue/checkpoint roles through MIR capture storage | `mir_raw_resumption_rejects_swapped_duplicate_and_missing_captures` lowers valid CC, then mutates MIR slots | Focused Verified | +| Check surviving slots after dead projection elimination | `mir_capture_contract_survives_sparse_projections_after_optimization` accepts a live slot 1 without slot 0, then rejects the wrong stored value | Focused Verified | +| Reject contradictory receiver reads | `mir_capture_contract_rejects_inconsistent_reads_of_one_slot` | Focused Verified | +| Preserve receiver identity across ordinary aliases | `mir_capture_contract_tracks_receiver_copies_and_reference_casts` accepts both aliases and rejects wrong captures through each | Focused Verified | +| Prove exact checkpoint owner and source/target domains | Nominally identical boundaries still have no semantic provenance proof | Unverified | + +This extends nominal capture-role verification to MIR; complete AE/AC identity, +foreign-resource, cleanup and allocation obligations remain outstanding. + +Validation uses default locked package selection with mandatory Wasmtime 49.0.2 +(`3c8a3e79a`). `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` +passes all 435 backend tests and all 80 control tests. The workspace still fails +at the same nine targets and 175 test names as `d2125f5c`; comparison adds or +recovers no names. After preserving the owning module in the new diagnostics, +the backend suite is rerun on the final source. Formatting, diff checking and +`cargo clippy --workspace --all-targets -- -D warnings` pass. + +Logs: `/private/tmp/psrs-control-mir-captures-workspace.log`, +`/private/tmp/psrs-control-mir-captures-comparison.json`, +`/private/tmp/psrs-control-mir-captures-backend.log`, and +`/private/tmp/psrs-control-mir-captures-clippy.log`. Pinned upstream-library +conformance, explicit official type comparison and scoreboards are not rerun; +no gate measurement or topic-completion status changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 60c76dcc..6bc0bdbb 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -23,6 +23,10 @@ The 2026-10-12 continuation starts from `5c78fa78` and retains these nominal types across executor/lifetime/replay calls and raw resumption captures. Replay returns a dedicated typed queue/activation product. Details and remaining semantic identity obligations are in the checklist's typed helper section. +The continuation from `d2125f5c` extends capture-role checking through MIR: +local closure construction must supply the types read by its target's surviving +receiver projections, including receiver copies/casts and sparse optimized +slots. The checklist records malformed-IR evidence and validation separately. Full frame/context identity verification, allocation/depth measurements, foreign resources and caught-trap cleanup remain outstanding. From 2e88d65661814ec2d08cdd020cc2f5b31a3e430c Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 00:56:15 +0800 Subject: [PATCH 109/148] Measure control extent ancestry and retained heap under long requests --- crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/verify/mod.rs | 4 +- crates/psrs-backend/src/lib.rs | 7 + crates/psrs-backend/src/pipeline/cc_input.rs | 23 ++ crates/psrs-backend/src/pipeline/mod.rs | 3 + .../src/tests/control_costs/mod.rs | 119 ++++++++ .../src/tests/control_costs/probe.rs | 257 ++++++++++++++++++ .../src/tests/control_costs/sources.rs | 47 ++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- docs/design/backend/fp/cc-ir.md | 6 + .../control-elimination-and-handler-scopes.md | 4 + .../backend/algebraic-effects.md | 99 +++++++ ...ted-control-lowering-handoff-2026-10-11.md | 10 +- 14 files changed, 579 insertions(+), 4 deletions(-) create mode 100644 crates/psrs-backend/src/pipeline/cc_input.rs create mode 100644 crates/psrs-driver/src/tests/control_costs/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_costs/probe.rs create mode 100644 crates/psrs-driver/src/tests/control_costs/sources.rs diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 54f8884a..0db6eb2d 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -17,6 +17,7 @@ mod representation; mod scalar; mod source_abi; mod verify; +pub use verify::verify_module; pub(crate) use source_abi::abstract_signature; diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 8173a398..9a844233 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -12,7 +12,9 @@ mod variant; use helpers::{verify_capture_layout, verify_value_shape}; use ops::{verify_assignments, verify_table}; -pub(super) fn verify_module(module: &Module) -> Result<(), Vec> { +/// Checks target-neutral value, representation and callable contracts. Source +/// typing and complete semantic control provenance remain producer obligations. +pub fn verify_module(module: &Module) -> Result<(), Vec> { verify_table(&module.representations, module.span)?; let mut signatures = HashMap::new(); let mut functions_by_symbol = HashMap::new(); diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index 74a9cfec..deddd2e3 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -131,6 +131,13 @@ pub fn compile(module: psrs_core::Module) -> Result> Ok(compile_with_stages(module)?.artifact) } +/// Emits an artifact from a P8 input using the default target profile. Source +/// typing and binding conformance belong to P8; this entry rechecks CC and all +/// subsequent representation contracts, including modified inspection inputs. +pub fn compile_cc(input: BackendInput) -> Result> { + pipeline::compile_cc(input) +} + /// The default-profile validator, retained for backend unit tests. #[allow(dead_code)] pub(crate) fn validator() -> wasmparser::Validator { diff --git a/crates/psrs-backend/src/pipeline/cc_input.rs b/crates/psrs-backend/src/pipeline/cc_input.rs new file mode 100644 index 00000000..2df12f52 --- /dev/null +++ b/crates/psrs-backend/src/pipeline/cc_input.rs @@ -0,0 +1,23 @@ +//! The shared target pipeline is also usable from its defined CC boundary. + +use crate::{Artifact, BackendError, BackendInput, TargetCapabilities, annotate_errors, cc, mir}; + +pub(crate) fn compile(input: BackendInput) -> Result> { + let target = TargetCapabilities::default(); + let owner = input.cc.entry.map(|entry| entry.module); + cc::verify_module(&input.cc).map_err(|errors| annotate_errors(errors, owner))?; + let context = crate::linking::default_context()?; + let (mir, mut wasi) = mir::lower_module_with_bindings_and_resolve( + input.cc, + input.externals, + target, + context.shared_resolve(), + )?; + let mir = mir::opt::optimize(mir, target)?; + let emitted = super::emission::emit(&mir, &mut wasi, target, owner, None, None, None)?; + Ok(Artifact { + wasm: emitted.component, + wat: emitted.wat, + warnings: input.warnings, + }) +} diff --git a/crates/psrs-backend/src/pipeline/mod.rs b/crates/psrs-backend/src/pipeline/mod.rs index 07238722..85178826 100644 --- a/crates/psrs-backend/src/pipeline/mod.rs +++ b/crates/psrs-backend/src/pipeline/mod.rs @@ -9,8 +9,11 @@ use crate::{ use crate::{cc, mir}; +mod cc_input; mod emission; +pub(crate) use cc_input::compile as compile_cc; + pub(crate) fn compile_with_context_inner( module: psrs_core::Module, target: TargetCapabilities, diff --git a/crates/psrs-driver/src/tests/control_costs/mod.rs b/crates/psrs-driver/src/tests/control_costs/mod.rs new file mode 100644 index 00000000..59e01af6 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_costs/mod.rs @@ -0,0 +1,119 @@ +//! Cost evidence combines actual ancestry guards with observed GC collections. + +mod probe; +mod sources; + +use std::process::Command; + +fn run(name: &str, template: &str, steps: i32, depth: i32, expected: i32) -> Option> { + super::wasmtime_available()?; + let source = template.replace("STEPS", &steps.to_string()); + let mut input = crate::lower_main_to_cc(&source).expect("cost source compiles"); + assert!( + probe::instrument(&mut input, depth) > 0, + "no extent allocations inspected" + ); + let artifact = psrs_backend::compile_cc(input).expect("instrumented target compiles"); + let prefix = std::env::temp_dir().join(format!("psrs-control-cost-{name}-{steps}-{depth}")); + let wasm = prefix.with_extension("wasm"); + std::fs::write(prefix.with_extension("purs"), source).unwrap(); + let identity = artifact + .wasm + .iter() + .fold(0xcbf29ce484222325_u64, |hash, byte| { + (hash ^ u64::from(*byte)).wrapping_mul(0x100000001b3) + }); + std::fs::write(&wasm, artifact.wasm).unwrap(); + let output = Command::new("wasmtime") + .args(["run", "-O", "gc-heap-initial-size=65536"]) + .env("WASMTIME_LOG", "wasmtime::runtime::vm::gc=trace") + .arg(&wasm) + .output() + .unwrap(); + std::fs::write(prefix.with_extension("gc.log"), &output.stderr).unwrap(); + assert_eq!(output.status.code(), Some(expected), "{name}: {output:?}"); + let log = String::from_utf8_lossy(&output.stderr); + if expected == 134 { + assert!( + log.contains("wasm trap:") && !log.contains("cast failure"), + "{log}" + ); + } + let bytes = log + .lines() + .filter_map(|line| { + let (_, after) = line.split_once("After collection, GC heap's allocated bytes = 0x")?; + let hex = after.split_whitespace().next().unwrap(); + Some(u64::from_str_radix(hex, 16).expect("observed GC live bytes")) + }) + .collect::>(); + let report = serde_json::json!({ + "workload": name, + "steps": steps, + "ancestry_bound": depth, + "observed_exit": output.status.code(), + "artifact": wasm, + "artifact_identity": format!("fnv1a64-v1:{identity:016x}"), + "gc_initial_heap_bytes": 65536, + "collections": bytes.len(), + "maximum_post_gc_live_bytes": bytes.iter().max(), + "minimum_post_gc_live_bytes": bytes.iter().min(), + }); + std::fs::write( + prefix.with_extension("json"), + serde_json::to_vec_pretty(&report).unwrap(), + ) + .unwrap(); + eprintln!( + "{name}: steps={steps}, ancestry_bound={depth}, collections={}, maximum_post_gc_live_bytes={}", + bytes.len(), + bytes.iter().max().unwrap_or(&0) + ); + Some(bytes) +} + +#[test] +fn control_tail_handlers_bound_extent_ancestry_and_post_gc_live_heap() { + for (name, source) in [("deep", sources::DEEP), ("forwarded", sources::FORWARDED)] { + let mut previous = 0; + for steps in [1000, 10000, 100000] { + let Some(bytes) = run(name, source, steps, 2, 42) else { + return; + }; + assert!( + !bytes.is_empty(), + "no actual collection at {steps} requests" + ); + assert!( + bytes.len() > previous, + "increased work must exercise collection churn" + ); + previous = bytes.len(); + assert!( + bytes.iter().all(|n| *n < 16384), + "live heap grows despite tail extent coalescing: {bytes:?}" + ); + } + } +} + +#[test] +fn control_ancestry_probe_observes_independent_non_tail_extents() { + // This distinguishes an actual ancestry walk from a dead or ineffective probe. + run("nested", sources::NESTED, 8, 8, 42); + run("nested", sources::NESTED, 8, 7, 134); +} + +#[test] +fn control_cost_pipeline_rejects_a_malformed_instrumented_input() { + let mut input = crate::lower_main_to_cc(&sources::DEEP.replace("STEPS", "1")).unwrap(); + probe::instrument(&mut input, 2); + let checker = input.cc.functions.last_mut().unwrap(); + checker.values[0].ty = psrs_backend::cc::ValueShape::Integer; + let errors = psrs_backend::compile_cc(input).expect_err("CC must be rechecked before emission"); + assert!( + errors.iter().any(|error| error.pass == "P8 CC verification" + && error.kind == psrs_backend::BackendErrorKind::InvalidCompilerIr), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_costs/probe.rs b/crates/psrs-driver/src/tests/control_costs/probe.rs new file mode 100644 index 00000000..daf48c72 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_costs/probe.rs @@ -0,0 +1,257 @@ +//! Test-only probes inspect actual extent ancestry at allocation. They neither +//! alter machine layouts nor expose a source intrinsic or runtime frame API. + +use psrs_backend::BackendInput; +use psrs_backend::cc::{ + Assignment, AssignmentKind as K, BinaryOp, Function, RefShape, ReprId, Representation, TagCase, + ValueDecl, ValueId, ValueShape, +}; +use psrs_hir::SymbolId; +use psrs_span::TextRange; + +pub(super) fn instrument(input: &mut BackendInput, limit: i32) -> usize { + let start = input + .cc + .functions + .iter() + .find(|f| f.name == "control_start_boundary") + .unwrap(); + let extent = start.result_type; + let ValueShape::Reference(reference) = extent else { + panic!("boundary reference") + }; + let RefShape::Repr(boundary) = reference.heap else { + panic!("nominal boundary") + }; + let Some(Representation::Variant { cases }) = input.cc.representations.representation(boundary) + else { + panic!("boundary variant") + }; + assert_eq!(cases.len(), 2); + assert_eq!(cases[1].fields[1], extent); + let module = start.symbol.module; + let index = input + .cc + .functions + .iter() + .filter(|f| f.symbol.module == module) + .map(|f| f.symbol.index) + .max() + .unwrap() + + 1; + let symbol = SymbolId::new(module, index); + let mut count = 0; + for function in &mut input.cc.functions { + count += insert( + &mut function.assignments, + &mut function.values, + boundary, + extent, + symbol, + limit, + ); + } + input.cc.functions.push(checker(symbol, boundary, extent)); + psrs_backend::cc::verify_module(&input.cc).expect("checked ancestry probes"); + count +} + +fn insert( + body: &mut Vec, + values: &mut Vec, + boundary: ReprId, + extent: ValueShape, + checker: SymbolId, + limit: i32, +) -> usize { + let mut count = 0; + let mut result = Vec::new(); + for mut assignment in std::mem::take(body) { + match &mut assignment.kind { + K::If { + then_assignments, + else_assignments, + .. + } => { + count += insert(then_assignments, values, boundary, extent, checker, limit); + count += insert(else_assignments, values, boundary, extent, checker, limit); + } + K::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + count += insert( + &mut case.assignments, + values, + boundary, + extent, + checker, + limit, + ); + } + count += insert( + default_assignments, + values, + boundary, + extent, + checker, + limit, + ); + } + _ => {} + } + let probe = matches!(&assignment.kind, K::VariantNew { representation, .. } if *representation == boundary); + let value = assignment.destination; + let span = assignment.span; + result.push(assignment); + if probe { + count += 1; + let next = values.iter().map(|v| v.id.0).max().unwrap() + 1; + let budget = ValueId(next); + let checked = ValueId(next + 1); + values.push(ValueDecl { + id: budget, + ty: ValueShape::Integer, + }); + values.push(ValueDecl { + id: checked, + ty: extent, + }); + result.push(Assignment { + destination: budget, + kind: K::Constant(limit), + span, + }); + result.push(Assignment { + destination: checked, + kind: K::DirectCall { + function: checker, + arguments: vec![value, budget], + }, + span, + }); + } + } + *body = result; + count +} + +fn checker(symbol: SymbolId, boundary: ReprId, extent: ValueShape) -> Function { + let span = TextRange::new(0, 1); + let a = |id, kind| Assignment { + destination: ValueId(id), + kind, + span, + }; + let values = [ + extent, + ValueShape::Integer, + ValueShape::Integer, + ValueShape::Boolean, + ValueShape::Integer, + extent, + ValueShape::Integer, + ValueShape::Integer, + extent, + extent, + extent, + extent, + extent, + ] + .into_iter() + .enumerate() + .map(|(id, ty)| ValueDecl { + id: ValueId(id as u32), + ty, + }) + .collect(); + let child = vec![ + a( + 5, + K::VariantGet { + destination: ValueId(5), + representation: boundary, + case: 1, + field: 1, + value: ValueId(0), + }, + ), + a(6, K::Constant(1)), + a( + 7, + K::Primitive { + op: BinaryOp::IntSub, + left: ValueId(1), + right: ValueId(6), + }, + ), + a( + 8, + K::DirectCall { + function: symbol, + arguments: vec![ValueId(5), ValueId(7)], + }, + ), + ]; + Function { + symbol, + name: "test_control_ancestry_probe".into(), + parameters: vec![ValueId(0), ValueId(1)], + values, + assignments: vec![ + a(2, K::Constant(0)), + a( + 3, + K::Primitive { + op: BinaryOp::IntGe, + left: ValueId(1), + right: ValueId(2), + }, + ), + a( + 12, + K::If { + condition: ValueId(3), + then_assignments: vec![ + a( + 4, + K::VariantTag { + destination: ValueId(4), + representation: boundary, + value: ValueId(0), + }, + ), + a( + 10, + K::TagSwitch { + value: ValueId(4), + cases: vec![ + TagCase { + tag: 0, + assignments: vec![], + value: ValueId(0), + }, + TagCase { + tag: 1, + assignments: child, + value: ValueId(8), + }, + ], + default_assignments: vec![a(9, K::Unreachable)], + default_value: ValueId(9), + }, + ), + ], + then_value: ValueId(10), + else_assignments: vec![a(11, K::Unreachable)], + else_value: ValueId(11), + }, + ), + ], + result: ValueId(12), + result_type: extent, + span, + } +} diff --git a/crates/psrs-driver/src/tests/control_costs/sources.rs b/crates/psrs-driver/src/tests/control_costs/sources.rs new file mode 100644 index 00000000..064d902c --- /dev/null +++ b/crates/psrs-driver/src/tests/control_costs/sources.rs @@ -0,0 +1,47 @@ +pub(super) const DEEP: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +deep :: Int -> C.Control Op Int -> C.Control Op { count :: Int, value :: Int } +deep count body = C.handle + (\value -> C.return { count: count, value: value }) + (\(Op k) raw -> deep (intAdd count 1) (raw (k 0))) + body +root :: forall x. Int -> Op x -> (x -> C.Control Op { count :: Int, value :: Int }) -> { _1 :: Int, _2 :: C.Control Op { count :: Int, value :: Int } } +root s (Op k) raw = { _1: s, _2: raw (k 0) } +build :: Int -> C.Control Op Int +build n = if intEq n 0 then C.return 42 else C.bind (C.perform (Op (\x -> x))) (\_ -> build (intSub n 1)) +result = (C.run 0 root (deep 0 (build STEPS)))._2 +main = if intEq result.count STEPS then result.value else 0 +"; + +pub(super) const FORWARDED: &str = r"module Main where +import Prim.Control as C +data F x = F (Int -> x) +data G x = G (Int -> x) +data U x = UF (F x) | UG (G x) +fold :: Int -> C.Control U Int -> C.Control G { count :: Int, value :: Int } +fold count body = C.handle + (\value -> C.return { count: count, value: value }) + (\request raw -> case request of + UF (F k) -> fold (intAdd count 1) (raw (k 0)) + UG op -> C.bind (C.perform op) (\answer -> fold count (raw answer))) + body +root :: forall x. Int -> G x -> (x -> C.Control G { count :: Int, value :: Int }) -> { _1 :: Int, _2 :: C.Control G { count :: Int, value :: Int } } +root s (G k) raw = { _1: intAdd s 1, _2: raw (k 0) } +build :: Int -> C.Control U Int +build n = if intEq n 0 then C.return 42 else C.bind (C.perform (UF (F (\x -> x)))) (\_ -> C.bind (C.perform (UG (G (\x -> x)))) (\_ -> build (intSub n 1))) +result = C.run 0 root (fold 0 (build STEPS)) +main = if intEq result._1 STEPS then if intEq result._2.count STEPS then result._2.value else 0 else 0 +"; + +pub(super) const NESTED: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Int +clause (Op k) raw = raw (k 0) +nest :: Int -> C.Control Op Int +nest n = if intEq n 0 then C.return 42 else C.bind (C.handle C.return clause (nest (intSub n 1))) (\n -> C.return n) +root :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +root s (Op k) raw = { _1: s, _2: raw (k 0) } +main = (C.run 0 root (nest STEPS))._2 +"; diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index bf9b8685..b32d30b8 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -8,6 +8,7 @@ mod assertions; mod closure_protocol; mod coercion; mod control_contracts; +mod control_costs; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 7599f875..f9160816 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Core checks the carrier/callable contracts before erasure; nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core checks the carrier/callable contracts before erasure; nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/cc-ir.md b/docs/design/backend/fp/cc-ir.md index f1041061..8a03bcff 100644 --- a/docs/design/backend/fp/cc-ir.md +++ b/docs/design/backend/fp/cc-ir.md @@ -621,6 +621,12 @@ inside `If` assignments. See [MIR's worked example](mir.md) for the SSA form. `Module::verify` before lowering. - **Output.** A verified `cc::Module` carried in a `BackendInput` together with the bindings that P9 needs. CC is target-neutral: it names no layout. +- **Explicit backend entry.** `compile_cc(BackendInput)` consumes this boundary + under the default target profile. It rechecks CC, then uses the ordinary MIR + lowering/optimization and checked target emission. It trusts source typing + and source binding conformance already discharged by P8; it does not recover + those contracts from erased CC. Inspection tools can add ordinary checked + assignments before this entry without bypassing downstream verification. - **To P9 (MIR).** CC supplies representation requirements, function signatures, aggregate conversion plans, and ordered assignments. P9 chooses the layout, builds the Wasm type table, lowers aggregate maps, and converts diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 0ba4b77c..99ad585d 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -163,6 +163,10 @@ branch completes independently. Shared tail finish groups close at their common answer boundary; replay-local captures still expire at branch completion. Long request sequences require allocation and ancestor-depth evidence as well as stack evidence. Any optimization must preserve the observable expiry rules. +The cost tests inspect actual parent chains at extent allocation using ordinary +checked IR probes and record post-collection live heap and collection counts at +fixed initial heap size. This distinguishes retained ancestry from allocation +churn; collection counts are not a measurement of exact total allocated bytes. ### Machine storage contracts diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 184e5d3b..7a2c7ba9 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -811,3 +811,102 @@ Logs: `/private/tmp/psrs-control-mir-captures-workspace.log`, `/private/tmp/psrs-control-mir-captures-clippy.log`. Pinned upstream-library conformance, explicit official type comparison and scoreboards are not rerun; no gate measurement or topic-completion status changes. + +## Tail-handler ancestry and GC cost evidence (2026-10-12) + +Starting point: clean compiler `148e706b`, with the same locked stdlib revision +`5d523805c4e2096e68fab5a4f965f62b225ee2af`. The existing long-request tests only +observed native stack safety. They did not inspect extent ancestry or retained +heap. This slice supplies those measurements without adding a control intrinsic. + +`tests::control_costs` lowers checked source to CC and inserts an ordinary +direct-call probe after every boundary allocation in the generated machine, +including nested branches and replay helpers. The probe walks the actual parent +chain and traps when its budget is exceeded. `compile_cc(BackendInput)` rechecks +CC and runs the ordinary MIR, optimization, linking and Wasm emission. A malformed +instrumented input is rejected before emission. The same layouts, source control +schemes, capture slots and lifecycle transitions are used by production lowering. +The instrumentation adds no heap objects to the machine. + +`control_tail_handlers_bound_extent_ancestry_and_post_gc_live_heap` executes +deep reinstatement and mixed handled/forwarded loops at three scales. Each run +asserts the final value 42 and the exact source/outer request counts. Every new +extent has at most two parent edges. With a 65,536-byte initial GC heap and actual +copying collections observed under Wasmtime 49.0.2 (`3c8a3e79a`), the results are: + +| Workload | Steps | Collections | Maximum post-GC live bytes | Component fingerprint (`fnv1a64-v1`) | +| --- | ---: | ---: | ---: | --- | +| Deep | 1,000 | 94 | 1,408 | `3dd8da22d97c8e7d` | +| Deep | 10,000 | 941 | 1,408 | `88b822c5f0cf24ef` | +| Deep | 100,000 | 9,411 | 1,472 | `9e9c3d60547570a9` | +| Mixed forwarding | 1,000 | 393 | 1,440 | `3d7123bbbf850041` | +| Mixed forwarding | 10,000 | 3,934 | 1,440 | `65b8375305188f41` | +| Mixed forwarding | 100,000 | 39,344 | 1,440 | `d1bea8d6df3f2cd0` | + +These are measurements of instrumented workloads, not a general bound on all +programs. Collections measure churn at a fixed initial heap size; they do not +measure exact total allocated bytes or timing without the probe/logging overhead. +Post-GC live bytes measure retained objects at collection points. Together with +the ancestry guard, they reject unbounded inactive parent retention in these +tail-handler loops. The test uses a 16,384-byte live-heap ceiling to allow ordinary +layout and root-set variation while still detecting retained linear growth. + +`control_ancestry_probe_observes_independent_non_tail_extents` executes eight +nested handles separated by user continuations. A budget of eight returns 42; +a budget of seven produces a guest trap without a cast failure. This establishes +that the probe observes actual ancestry and that the machine preserves distinct +non-tail scopes. Existing non-tail multi-shot and branch-expiry execution remains +separate semantic evidence. + +Reproduce the focused measurement with: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib control_costs -- --nocapture +``` + +Source, component, GC trace and JSON reports are retained under the OS temporary +directory as `psrs-control-cost-{deep,forwarded}-{steps}-2.{purs,wasm,gc.log,json}`; +the nested controls use `psrs-control-cost-nested-8-{8,7}`. JSON records the +component fingerprint, observed exit, configured heap, ancestry guard and GC +observations. Focused log: `/private/tmp/psrs-control-costs-focused.log`. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Bound inactive ancestry for long tail deep/forwarded loops | Actual allocation-site parent walks at all three scales, budget two | Focused Verified | +| Measure retained heap and churn separately from native stack | Required copying collections, live-byte ceiling and retained scale reports | Focused Verified | +| Preserve independent non-tail scopes and prove probe execution | Eight-versus-seven ancestry-budget control | Focused Verified | +| Keep instrumented execution inside stage contracts | `control_cost_pipeline_rejects_a_malformed_instrumented_input`; common CC/MIR verifiers and target pipeline | Focused Verified | +| Complete semantic identities, foreign lifetime, caught traps and pinned library acceptance | This measurement does not discharge those obligations | Unverified | + +Final validation: `cargo fmt --all --check`, diff checking and +`cargo clippy --workspace --all-targets -- -D warnings` pass. +`PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` passes all 435 +backend tests, all 80 control integration tests and the three new cost tests. +It still fails at the same nine targets and 175 test names as the preceding +checkpoint; failure-name comparison adds or recovers no names. Logs: +`/private/tmp/psrs-control-costs-workspace.log`, +`/private/tmp/psrs-control-costs-comparison.json`, and +`/private/tmp/psrs-control-costs-clippy.log`. Explicit upstream type comparison, +package conformance and scoreboards are not rerun for this internal cost slice. +No gate measurement or complete AE/AC status changes. + +### Completion audit after the cost slice + +The objective remains complete delimited control, followed by native Effect/ST. +The governing designs keep those owners separate. Before advancing to the native +facades, remaining mechanism acceptance must cover: + +- Retained checked source/target domain relationships and exact checkpoint, + replay-activation and finish-boundary provenance, with malformed-IR rejection. +- Foreign-buffer/resource capture validity and explicit unsupported-boundary + rejection; ordinary GC captures do not supply this evidence. +- A defined caught-host-trap recovery/cleanup boundary and actual recovery + execution; terminal guest traps alone do not supply it. +- Complete pinned upstream library/source and execution comparisons for the + generic handler model, including the remaining row/representation interactions. +- Cost evidence for the remaining required control forms and an explicit account + of total allocation where the selected acceptance contract requires it. + +AE-11 native host interpretation and the official Effect/ST facades belong to the +subsequent native topic. This dependency ordering does not change their required +acceptance or narrow any AC requirement above. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 6bc0bdbb..525682cf 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -27,8 +27,14 @@ The continuation from `d2125f5c` extends capture-role checking through MIR: local closure construction must supply the types read by its target's surviving receiver projections, including receiver copies/casts and sparse optimized slots. The checklist records malformed-IR evidence and validation separately. -Full frame/context identity verification, allocation/depth measurements, foreign -resources and caught-trap cleanup remain outstanding. +The continuation from `148e706b` adds actual parent-chain guards and GC cost +measurements for long deep and mixed-forwarding loops. New extent ancestry stays +at most two edges for the measured workloads; independent non-tail scopes remain +separate. The checklist records scale, artifacts and the distinction between +live heap, collection churn and exact total allocation. +Full frame/context identity verification, general allocation bounds, foreign +resources and caught-trap cleanup remain outstanding. Complete delimited-control +acceptance precedes the requested native Effect/ST implementation. ## Governing contracts From 57e94257192c710245cd24089341bf393adf04d3 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 01:52:41 +0800 Subject: [PATCH 110/148] Retain checked control domains through CC and MIR lowering --- .../psrs-backend/src/cc/control_contract.rs | 104 +++++++ .../src/cc/layout/control_contracts.rs | 270 +++++++++++++++++ crates/psrs-backend/src/cc/layout/mod.rs | 4 + .../psrs-backend/src/cc/lower/control/mod.rs | 90 ++++-- crates/psrs-backend/src/cc/mod.rs | 13 + crates/psrs-backend/src/cc/projection.rs | 1 + crates/psrs-backend/src/cc/representation.rs | 6 + .../psrs-backend/src/cc/verify/ops/control.rs | 152 ++++++++++ crates/psrs-backend/src/cc/verify/ops/mod.rs | 4 + .../psrs-backend/src/cc/verify/ops/table.rs | 12 + .../psrs-backend/src/mir/control_contracts.rs | 75 +++++ .../indirect_tests/aggregate/collections.rs | 1 + .../mir/indirect_tests/aggregate/fixtures.rs | 2 + .../mir/indirect_tests/aggregate/indirect.rs | 1 + .../src/mir/indirect_tests/aggregate/large.rs | 2 + .../indirect_tests/aggregate/list_record.rs | 1 + .../mir/indirect_tests/aggregate/nested.rs | 3 + .../indirect_tests/aggregate/record_fields.rs | 2 + .../aggregate/resource_result.rs | 1 + .../mir/indirect_tests/aggregate/scalars.rs | 2 + .../mir/indirect_tests/composite/fixture.rs | 1 + .../record_list/fixtures/aggregate.rs | 4 + .../record_list/fixtures/fixed.rs | 2 + .../record_list/fixtures/mod.rs | 3 + .../record_list/fixtures/variants.rs | 3 + .../record_list/fixtures/wide_flags.rs | 1 + .../src/mir/instruction/methods.rs | 12 + .../psrs-backend/src/mir/instruction/mod.rs | 9 + crates/psrs-backend/src/mir/layout/tests.rs | 2 + .../psrs-backend/src/mir/lower/assignments.rs | 38 +++ crates/psrs-backend/src/mir/mod.rs | 1 + crates/psrs-backend/src/mir/opt/effects.rs | 1 + crates/psrs-backend/src/mir/opt/values.rs | 14 + .../src/mir/reachable/assignments.rs | 1 + .../src/mir/verify/instruction/copy.rs | 10 +- .../src/mir/verify/instruction/mod.rs | 4 +- crates/psrs-backend/src/mir/verify/mod.rs | 1 + .../src/wasm/lower/structure/instructions.rs | 6 + crates/psrs-core/src/control.rs | 272 ++++++++++++++++++ crates/psrs-core/src/lib.rs | 6 + crates/psrs-core/src/tests/control.rs | 41 +++ crates/psrs-core/src/verify/expr/control.rs | 216 +------------- .../src/tests/control_contracts.rs | 244 ++++++++++++++++ docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 42 ++- .../backend/algebraic-effects.md | 77 +++++ ...ted-control-lowering-handoff-2026-10-11.md | 6 + 47 files changed, 1530 insertions(+), 235 deletions(-) create mode 100644 crates/psrs-backend/src/cc/control_contract.rs create mode 100644 crates/psrs-backend/src/cc/layout/control_contracts.rs create mode 100644 crates/psrs-backend/src/cc/verify/ops/control.rs create mode 100644 crates/psrs-backend/src/mir/control_contracts.rs create mode 100644 crates/psrs-core/src/control.rs diff --git a/crates/psrs-backend/src/cc/control_contract.rs b/crates/psrs-backend/src/cc/control_contract.rs new file mode 100644 index 00000000..c1c3b05d --- /dev/null +++ b/crates/psrs-backend/src/cc/control_contract.rs @@ -0,0 +1,104 @@ +//! Immutable source contracts checked by Core and quoted before representation +//! erasure. No Core arena indices remain in the published CC evidence. + +use super::{ReprId, SignatureId}; +use psrs_hir::{Intrinsic, TypeId, TypeVariableId}; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub struct ControlContractId(pub u32); + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub struct SourceTypeIdentityId(pub u32); + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum TypeConstructorIdentity { + Function, + Record, + Row, + Array, + Int, + Number, + Boolean, + String, + Char, + Unit, + Type, + Constraint, + Symbol, + User(TypeId), +} + +/// Lexical binders and stable free-variable identities are retained, including +/// nested quantifiers and open rows. This is evidence, not a second type solver. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum TypeIdentity { + Variable(TypeVariableId), + Constructor(TypeConstructorIdentity), + Application(Box, Box), + ForAll { + variables: Vec, + body: Box, + }, + Closure { + parameters: Vec, + result: Box, + }, + RowEmpty, + RowExtend { + label: String, + ty: Box, + tail: Box, + }, + TypeLevelString(String), + TypeLevelInt(i64), +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ControlDomain { + pub request: TypeIdentity, + pub answer: TypeIdentity, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(super) enum ControlImplementation { + Frame { representation: ReprId, case: u32 }, + Call { signature: SignatureId }, +} + +/// A source use can only be published from the control owner's checked proof. +/// Its fields are immutable to callers constructing or inspecting CC. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ControlContract { + pub(super) implementation: ControlImplementation, + pub(super) result_identity: SourceTypeIdentityId, + pub(super) argument_identities: Vec, + pub(super) operation: Intrinsic, + pub(super) result: TypeIdentity, + pub(super) arguments: Vec, + pub(super) source: Option, + pub(super) target: Option, +} + +impl ControlContract { + pub fn result_identity(&self) -> SourceTypeIdentityId { + self.result_identity + } + pub fn argument_identities(&self) -> &[SourceTypeIdentityId] { + &self.argument_identities + } + pub fn operation(&self) -> Intrinsic { + self.operation + } + pub fn result(&self) -> &TypeIdentity { + &self.result + } + pub fn arguments(&self) -> &[TypeIdentity] { + &self.arguments + } + pub fn source(&self) -> Option<&ControlDomain> { + self.source.as_ref() + } + pub fn target(&self) -> Option<&ControlDomain> { + self.target.as_ref() + } +} diff --git a/crates/psrs-backend/src/cc/layout/control_contracts.rs b/crates/psrs-backend/src/cc/layout/control_contracts.rs new file mode 100644 index 00000000..040fa355 --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/control_contracts.rs @@ -0,0 +1,270 @@ +//! Quote the authoritative Core proof before the immutable CC table is frozen. + +use super::control::ControlLayout; +use crate::BackendError; +use crate::cc::control_contract::ControlImplementation; +use crate::cc::{ + ControlContract, ControlContractId, ControlDomain, RepresentationTable, SourceTypeIdentityId, + TypeConstructorIdentity as C, TypeIdentity as T, +}; +use psrs_core::{CheckedControlContract, ExprKind, Module, Type, TypeConstructor, TypeId}; +use psrs_hir::Intrinsic; +use std::collections::HashSet; + +pub(super) fn append( + module: &Module, + table: &mut RepresentationTable, + layout: ControlLayout, +) -> Result<(), Vec> { + let mut identities = Vec::::new(); + let mut pending = module + .declarations + .iter() + .map(|declaration| &declaration.value) + .collect::>(); + while let Some(expression) = pending.pop() { + match &expression.kind { + ExprKind::IntrinsicCall { + intrinsic, + arguments, + } => { + if intrinsic.descriptor().category == psrs_hir::IntrinsicCategory::Control { + let proof = psrs_core::checked_control_contract( + module, + *intrinsic, + expression.ty, + &arguments + .iter() + .map(|argument| argument.ty) + .collect::>(), + ) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P8 control contract planning", + expression.span, + message, + )] + })?; + let quoted = quote(module, &proof).ok_or_else(|| { + vec![BackendError::invalid_ir( + "P8 control contract planning", + expression.span, + "control contract contains a dangling or cyclic type", + )] + })?; + let mut intern = |id: TypeId, quoted: &T| -> SourceTypeIdentityId { + if let Some(index) = identities + .iter() + .position(|other| psrs_core::equivalent_types(id, *other, module)) + { + return SourceTypeIdentityId(index as u32); + } + let index = identities.len(); + identities.push(id); + table.source_type_identities.push(quoted.clone()); + SourceTypeIdentityId(index as u32) + }; + let result_identity = intern(proof.result(), "ed.result); + let argument_identities = proof + .arguments() + .iter() + .zip("ed.arguments) + .map(|(id, quoted)| intern(*id, quoted)) + .collect(); + let contract = ControlContract { + result_identity, + argument_identities, + implementation: implementation(layout, proof.operation()), + operation: proof.operation(), + result: quoted.result, + arguments: quoted.arguments, + source: quoted.source, + target: quoted.target, + }; + if !table.control_contracts.contains(&contract) { + table.control_contracts.push(contract); + } + } + pending.extend(arguments); + } + ExprKind::Constructor { arguments, .. } + | ExprKind::Array { + elements: arguments, + } => pending.extend(arguments), + ExprKind::Record { fields } => pending.extend(fields.iter().map(|(_, value)| value)), + ExprKind::RecordUpdate { record, fields } => { + pending.push(record); + pending.extend(fields.iter().map(|(_, value)| value)); + } + ExprKind::FieldAccess { record, .. } => pending.push(record), + ExprKind::RepresentationCast { value, .. } => pending.push(value), + ExprKind::Application(left, right) => { + pending.push(left); + pending.push(right); + } + ExprKind::Lambda { body, .. } => pending.push(body), + ExprKind::Let { bindings, body } => { + pending.extend(bindings.iter().map(|binding| &binding.value)); + pending.push(body); + } + ExprKind::If { + condition, + then_branch, + else_branch, + } => { + pending.extend([ + condition.as_ref(), + then_branch.as_ref(), + else_branch.as_ref(), + ]); + } + ExprKind::Case { + scrutinee, + branches, + } => { + pending.push(scrutinee); + pending.extend(branches.iter().map(|branch| &branch.value)); + } + _ => {} + } + } + Ok(()) +} + +pub(in crate::cc) fn lookup( + module: &Module, + table: &RepresentationTable, + proof: &CheckedControlContract, +) -> Option { + let quoted = quote(module, proof)?; + table + .control_contracts + .iter() + .position(|candidate| { + candidate.operation == proof.operation() + && candidate.result == quoted.result + && candidate.arguments == quoted.arguments + && candidate.source == quoted.source + && candidate.target == quoted.target + }) + .map(|index| ControlContractId(index as u32)) +} + +struct QuotedContract { + result: T, + arguments: Vec, + source: Option, + target: Option, +} + +fn quote(module: &Module, proof: &CheckedControlContract) -> Option { + let domain = |domain: psrs_core::ControlDomain| { + Some(ControlDomain { + request: ty(module, domain.request, &mut HashSet::new())?, + answer: ty(module, domain.answer, &mut HashSet::new())?, + }) + }; + Some(QuotedContract { + result: ty(module, proof.result(), &mut HashSet::new())?, + arguments: proof + .arguments() + .iter() + .map(|id| ty(module, *id, &mut HashSet::new())) + .collect::>()?, + source: match proof.source() { + Some(value) => Some(domain(value)?), + None => None, + }, + target: match proof.target() { + Some(value) => Some(domain(value)?), + None => None, + }, + }) +} + +fn ty(module: &Module, id: TypeId, visiting: &mut HashSet) -> Option { + psrs_span::with_sufficient_stack(|| { + if !visiting.insert(id) { + return None; + } + let result = match module.types.get(id.0 as usize)? { + Type::Variable(variable) => T::Variable(*variable), + Type::Constructor(constructor) => T::Constructor(match constructor { + TypeConstructor::Function => C::Function, + TypeConstructor::Record => C::Record, + TypeConstructor::Row => C::Row, + TypeConstructor::Array => C::Array, + TypeConstructor::Int => C::Int, + TypeConstructor::Number => C::Number, + TypeConstructor::Boolean => C::Boolean, + TypeConstructor::String => C::String, + TypeConstructor::Char => C::Char, + TypeConstructor::Unit => C::Unit, + TypeConstructor::Type => C::Type, + TypeConstructor::Constraint => C::Constraint, + TypeConstructor::Symbol => C::Symbol, + TypeConstructor::User(id) => C::User(*id), + }), + Type::Application(head, argument) => T::Application( + Box::new(ty(module, *head, visiting)?), + Box::new(ty(module, *argument, visiting)?), + ), + Type::ForAll { variables, body } => T::ForAll { + variables: variables.clone(), + body: Box::new(ty(module, *body, visiting)?), + }, + Type::Closure { parameters, result } => T::Closure { + parameters: parameters + .iter() + .map(|id| ty(module, *id, visiting)) + .collect::>()?, + result: Box::new(ty(module, *result, visiting)?), + }, + Type::RowEmpty => T::RowEmpty, + Type::RowExtend { + label, + ty: field, + tail, + } => T::RowExtend { + label: label.clone(), + ty: Box::new(ty(module, *field, visiting)?), + tail: Box::new(ty(module, *tail, visiting)?), + }, + Type::TypeLevelString(value) => T::TypeLevelString(value.clone()), + Type::TypeLevelInt(value) => T::TypeLevelInt(*value), + }; + visiting.remove(&id); + Some(result) + }) +} + +fn implementation(layout: ControlLayout, operation: Intrinsic) -> ControlImplementation { + use Intrinsic::*; + let case = match operation { + ControlReturn => 0, + ControlPerform => 1, + ControlBind => 2, + ControlHandle => 4, + ControlResume => 6, + ControlRun => { + return ControlImplementation::Call { + signature: layout.executor, + }; + } + ControlOnce => { + return ControlImplementation::Call { + signature: layout.once, + }; + } + ControlCancel => { + return ControlImplementation::Call { + signature: layout.cancel, + }; + } + _ => unreachable!("checked control operation"), + }; + ControlImplementation::Frame { + representation: layout.computation, + case, + } +} diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index e94a5650..c2458fdc 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -9,6 +9,7 @@ use std::collections::{HashMap, HashSet}; mod aggregate; mod captures; pub(in crate::cc) mod control; +pub(in crate::cc) mod control_contracts; mod declaration; mod functions; pub(crate) mod protocols; @@ -310,6 +311,9 @@ pub(super) fn type_layout( let uses_control = module.types.iter().any(|ty| matches!(ty, Type::Constructor(TypeConstructor::User(id)) if *id == HirTypeId::CONTROL || *id == HirTypeId::RESUMPTION)); let control_layout = uses_control.then(|| control::append(&mut representations, function_slot)); + if let Some(control) = control_layout { + control_contracts::append(module, &mut representations, control)?; + } Ok(TypeLayout { function_slot, protocols, diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 69eef430..4ec5ea9a 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -63,16 +63,58 @@ impl FunctionLowerer<'_> { ty: ValueShape, assignments: &mut Vec, ) -> Result> { + let proof = psrs_core::checked_control_contract( + self.module, + intrinsic, + expression.ty, + &arguments + .iter() + .map(|argument| argument.ty) + .collect::>(), + ) + .map_err(|message| control_error(expression.span, message))?; + let contract = + crate::cc::layout::control_contracts::lookup(self.module, self.representations, &proof) + .ok_or_else(|| { + control_error( + expression.span, + "control use has no predeclared checked contract", + ) + })?; + let fields = arguments + .iter() + .map(|argument| self.lower_array_element(argument, assignments)) + .collect::, _>>()?; + let (value, implementation) = + self.lower_control_frame(expression, intrinsic, fields.clone(), ty, assignments)?; + let destination = self.fresh(ty); + assignments.push(Assignment { + destination, + kind: AssignmentKind::ControlEvidence { + value, + implementation, + arguments: fields, + contract, + }, + span: expression.span, + }); + Ok(destination) + } + + fn lower_control_frame( + &mut self, + expression: &Expr, + intrinsic: Intrinsic, + fields: Vec, + ty: ValueShape, + assignments: &mut Vec, + ) -> Result<(ValueId, ValueId), Vec> { let layout = self.control_layout.ok_or_else(|| { control_error( expression.span, "control primitive used without a frame representation", ) })?; - let fields = arguments - .iter() - .map(|argument| self.lower_array_element(argument, assignments)) - .collect::, _>>()?; if matches!(intrinsic, Intrinsic::ControlOnce | Intrinsic::ControlCancel) { let functions = self.ensure_control_functions(layout, expression.span)?; let function = if intrinsic == Intrinsic::ControlOnce { @@ -94,20 +136,23 @@ impl FunctionLowerer<'_> { kind: AssignmentKind::Constant(0), span: expression.span, }); - return Ok(unit); + return Ok((unit, result)); } let conversion = self.recover_payload(ty, expression.span)?; let source = builder::repr(layout.owner); - return Ok(self.emit_conversion( + return Ok(( + self.emit_conversion( + result, + source, + ty, + crate::cc::ValueConversion::Sequence(vec![ + crate::cc::ValueConversion::EraseReference, + conversion, + ]), + expression.span, + assignments, + ), result, - source, - ty, - crate::cc::ValueConversion::Sequence(vec![ - crate::cc::ValueConversion::EraseReference, - conversion, - ]), - expression.span, - assignments, )); } if intrinsic == Intrinsic::ControlRun { @@ -154,13 +199,16 @@ impl FunctionLowerer<'_> { assignments, )?; let conversion = self.recover_payload(ty, expression.span)?; - return Ok(self.emit_conversion( + return Ok(( + self.emit_conversion( + result, + erased_shape(), + ty, + conversion, + expression.span, + assignments, + ), result, - erased_shape(), - ty, - conversion, - expression.span, - assignments, )); } let case = match intrinsic { @@ -189,7 +237,7 @@ impl FunctionLowerer<'_> { }, span: expression.span, }); - Ok(destination) + Ok((destination, destination)) } fn control_empty_sequence( diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 0db6eb2d..9312e227 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -8,6 +8,11 @@ use std::collections::HashMap; use std::rc::Rc; mod case; +mod control_contract; +pub use control_contract::{ + ControlContract, ControlContractId, ControlDomain, SourceTypeIdentityId, + TypeConstructorIdentity, TypeIdentity, +}; mod convert; mod layout; mod lower; @@ -83,6 +88,14 @@ pub struct Assignment { #[derive(Clone, Debug, PartialEq, Eq)] pub enum AssignmentKind { + /// Retains the checked source operation at its explicit P8 erasure boundary. + /// The runtime result is the existing value; Wasm encoding erases this witness. + ControlEvidence { + value: ValueId, + implementation: ValueId, + arguments: Vec, + contract: ControlContractId, + }, Constant(i32), NumberConstant(String), StringConstant(String), diff --git a/crates/psrs-backend/src/cc/projection.rs b/crates/psrs-backend/src/cc/projection.rs index 83bd96c7..fd132bbe 100644 --- a/crates/psrs-backend/src/cc/projection.rs +++ b/crates/psrs-backend/src/cc/projection.rs @@ -439,6 +439,7 @@ mod tests { product_labels: [(ReprId(0), vec!["name".to_string()])] .into_iter() .collect(), + ..Default::default() }; let record_types = [(record, ReprId(0))].into_iter().collect(); let array_types = HashMap::new(); diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index 059eccb5..c5f984d5 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -225,6 +225,12 @@ fn storage_case( #[derive(Clone, Debug, PartialEq, Eq, Default)] pub struct RepresentationTable { + /// Source control contracts are predeclared by layout, before lowering + /// emits any factory or executor bodies. + pub control_contracts: Vec, + /// Rigid semantic identity is allocated using Core's relation before + /// arena indices are erased. The quoted types retain lexical structure. + pub source_type_identities: Vec, pub representations: Vec, pub signatures: Vec, /// Canonical logical labels for record products; positional products do diff --git a/crates/psrs-backend/src/cc/verify/ops/control.rs b/crates/psrs-backend/src/cc/verify/ops/control.rs new file mode 100644 index 00000000..c99768ea --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/ops/control.rs @@ -0,0 +1,152 @@ +use super::super::helpers::{assignment_error, declared_shape}; +use crate::BackendError; +use crate::cc::control_contract::ControlImplementation; +use crate::cc::{Assignment, AssignmentKind, RepresentationTable, ValueId, ValueShape}; +use crate::cc::{Signature, ValueConversion}; +use psrs_hir::SymbolId; +use std::collections::HashMap; + +pub(super) fn verify( + assignment: &Assignment, + declared: &HashMap, + table: &RepresentationTable, + assignments: &[Assignment], + signatures: &HashMap, +) -> Result, Vec> { + let AssignmentKind::ControlEvidence { + value, + implementation, + arguments, + contract, + } = &assignment.kind + else { + unreachable!() + }; + let proof = table + .control_contracts + .get(contract.0 as usize) + .ok_or_else(|| { + assignment_error( + assignment, + "control evidence has no checked source contract", + ) + })?; + if proof.arguments().len() != arguments.len() { + return Err(assignment_error( + assignment, + "control evidence argument count disagrees with its checked source contract", + )); + } + if declared_shape(declared, *value, assignment)? + != declared_shape(declared, assignment.destination, assignment)? + { + return Err(assignment_error( + assignment, + "control evidence changes its runtime result shape", + )); + } + let definition = assignments + .iter() + .find(|candidate| candidate.destination == *implementation) + .ok_or_else(|| { + assignment_error(assignment, "control implementation has no local definition") + })?; + if matches!(proof.implementation, ControlImplementation::Frame { .. }) + && value != implementation + { + return Err(assignment_error( + assignment, + "control evidence result is not its checked frame", + )); + } + let operands = match (&proof.implementation, &definition.kind) { + ( + ControlImplementation::Frame { + representation, + case, + }, + AssignmentKind::VariantNew { + representation: actual, + case: tag, + fields, + .. + }, + ) if representation == actual && case == tag => fields, + ( + ControlImplementation::Call { signature }, + AssignmentKind::DirectCall { + function, + arguments, + }, + ) if signatures.get(function) == table.signature(*signature) => arguments, + _ => { + return Err(assignment_error( + assignment, + "control implementation disagrees with its checked frame or helper plan", + )); + } + }; + if operands.len() < arguments.len() + || !arguments + .iter() + .zip(operands) + .all(|(source, actual)| origin(*source, assignments) == origin(*actual, assignments)) + { + return Err(assignment_error( + assignment, + "control implementation does not preserve its checked source operands", + )); + } + for (argument, expected) in arguments.iter().zip(proof.argument_identities()) { + let origin = origin(*argument, assignments); + if let Some(Assignment { + kind: AssignmentKind::ControlEvidence { contract, .. }, + .. + }) = assignments + .iter() + .find(|candidate| candidate.destination == origin) + { + let producer = table + .control_contracts + .get(contract.0 as usize) + .ok_or_else(|| { + assignment_error(assignment, "control operand has no checked source contract") + })?; + if producer.result_identity() != *expected { + return Err(assignment_error( + assignment, + "control operand source type disagrees with its checked domain", + )); + } + } + } + let mut uses = arguments.clone(); + uses.extend([*value, *implementation]); + Ok(uses) +} + +fn origin(mut value: ValueId, assignments: &[Assignment]) -> ValueId { + for _ in 0..assignments.len() { + let next = assignments + .iter() + .find(|assignment| assignment.destination == value) + .and_then(|assignment| match &assignment.kind { + AssignmentKind::RepresentationCast { value, .. } => Some(*value), + AssignmentKind::AggregateConvert { + value, conversion, .. + } if matches!( + conversion.plan, + ValueConversion::EraseReference | ValueConversion::RecoverReference { .. } + ) => + { + Some(*value) + } + _ => None, + }); + match next { + Some(next) => value = next, + None => break, + } + } + value +} diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index d5371bf6..b4fe7a42 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -15,6 +15,7 @@ use tag_switch::verify_tag_switch; mod aggregate; mod arrays; +mod control; mod string_bytes; mod table; mod tag_switch; @@ -35,6 +36,9 @@ pub(super) fn verify_assignments( for assignment in assignments { let mut uses = Vec::new(); match &assignment.kind { + AssignmentKind::ControlEvidence { .. } => { + uses = control::verify(assignment, declared, table, assignments, signatures)?; + } AssignmentKind::AggregateConvert { destination, value, diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index 78d0c089..c5a419b8 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -8,6 +8,18 @@ pub(crate) fn verify_table( table: &RepresentationTable, span: TextRange, ) -> Result<(), Vec> { + for proof in &table.control_contracts { + if proof.argument_identities().len() != proof.arguments().len() + || std::iter::once(&proof.result_identity()) + .chain(proof.argument_identities()) + .any(|id| table.source_type_identities.get(id.0 as usize).is_none()) + { + return Err(table_error( + span, + "control contract has no canonical source type identity", + )); + } + } for (index, representation) in table.representations.iter().enumerate() { match representation { Representation::Box { value } | Representation::Array { element: value } => { diff --git a/crates/psrs-backend/src/mir/control_contracts.rs b/crates/psrs-backend/src/mir/control_contracts.rs new file mode 100644 index 00000000..810aed2a --- /dev/null +++ b/crates/psrs-backend/src/mir/control_contracts.rs @@ -0,0 +1,75 @@ +use super::{Instruction, Module}; +use crate::BackendError; + +impl Module { + /// Source contracts remain immutable and inspectable after physical layout. + pub fn control_contracts(&self) -> &[crate::cc::ControlContract] { + self.layout.as_ref().map_or(&[], |layout| { + layout.representation_table().control_contracts.as_slice() + }) + } +} + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + for function in &module.functions { + for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { + let Instruction::ControlEvidence { + arguments, + contract, + span, + .. + } = instruction + else { + continue; + }; + let mut message = match module.control_contracts().get(contract.0 as usize) { + None => Some("MIR control evidence has no checked source contract"), + Some(proof) if arguments.len() != proof.arguments().len() => Some( + "MIR control evidence argument count disagrees with its checked source contract", + ), + _ => None, + }; + if message.is_none() { + let proof = &module.control_contracts()[contract.0 as usize]; + for (argument, expected) in arguments.iter().zip(proof.argument_identities()) { + let mut value = *argument; + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .collect::>(); + for _ in 0..definitions.len() { + match definitions + .iter() + .find(|instruction| instruction.destination() == Some(value)) + { + Some( + Instruction::Copy { value: source, .. } + | Instruction::RefCast { value: source, .. }, + ) => value = *source, + Some(Instruction::ControlEvidence { contract, .. }) => { + if module + .control_contracts() + .get(contract.0 as usize) + .is_none_or(|producer| producer.result_identity() != *expected) + { + message = Some( + "MIR control operand source type disagrees with its checked domain", + ); + } + break; + } + _ => break, + } + } + } + } + if let Some(message) = message { + errors.push( + BackendError::invalid_ir("P9 MIR verification", *span, message) + .with_module(function.symbol.module), + ); + } + } + } +} diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs index b6a4b2da..019e65ec 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs @@ -85,6 +85,7 @@ fn base( ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs index 5d8689d7..f2ae41c1 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs @@ -66,6 +66,7 @@ pub(super) fn fixture_with_representations( representations, signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -174,6 +175,7 @@ pub(super) fn parameter_fixture() -> (cc::Module, ExternalBindings, Resolve) { ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs index c3caccd9..fab37122 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs @@ -45,6 +45,7 @@ pub(super) fn indirect_aggregate_fixture() -> (cc::Module, ExternalBindings, Res ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs index 68b8387d..484fbf9a 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs @@ -50,6 +50,7 @@ pub(super) fn large_record_fixture() -> (cc::Module, ExternalBindings, Resolve) )] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -163,6 +164,7 @@ pub(super) fn large_unit_result_fixture() -> (cc::Module, ExternalBindings, Reso )] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs index 900378be..0dee7b6c 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs @@ -43,6 +43,7 @@ fn finish( representations, signatures: Vec::new(), product_labels: product_labels.into_iter().collect(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs index e3497762..6e9fe201 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs @@ -53,6 +53,7 @@ pub(super) fn nested_variant_fixture() -> (cc::Module, ExternalBindings, Resolve ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -164,6 +165,7 @@ pub(super) fn nested_record_fixture() -> (cc::Module, ExternalBindings, Resolve) product_labels: [(ReprId(2), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -271,6 +273,7 @@ pub(super) fn nested_record_parameter_fixture() -> (cc::Module, ExternalBindings product_labels: [(ReprId(2), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs index 6de33767..1b5e7976 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs @@ -61,6 +61,7 @@ pub(super) fn record_with_aggregate_field_fixture() -> (cc::Module, ExternalBind product_labels: [(ReprId(2), vec!["inner".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -189,6 +190,7 @@ pub(super) fn record_with_aggregate_field_parameter_fixture() product_labels: [(ReprId(2), vec!["inner".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs index 1da0a669..89327b67 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs @@ -42,6 +42,7 @@ pub(super) fn resource_result_fixture() -> (cc::Module, ExternalBindings, Resolv ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs index 8613be6e..85179549 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs @@ -45,6 +45,7 @@ pub(super) fn wide_scalar_fixture() -> (cc::Module, ExternalBindings, Resolve) { ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -151,6 +152,7 @@ pub(super) fn wide_scalar_parameter_fixture() -> (cc::Module, ExternalBindings, ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs index c94cba6b..3a5ecc73 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs @@ -67,6 +67,7 @@ pub(super) fn composite_indirect_fixture() -> (cc::Module, ExternalBindings, Res .into_iter() .map(|(id, labels)| (id, labels.into_iter().map(String::from).collect())) .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs index cda24660..cb3ad920 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs @@ -29,6 +29,7 @@ pub(crate) fn flags_fixture() -> (cc::Module, ExternalBindings, Resolve) { product_labels: [(cc::ReprId(0), vec!["read".to_string(), "write".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -147,6 +148,7 @@ pub(crate) fn handle_fixture() -> (cc::Module, ExternalBindings, Resolve) { }], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -251,6 +253,7 @@ pub(crate) fn tuple_fixture() -> (cc::Module, ExternalBindings, Resolve) { product_labels: [(cc::ReprId(0), vec!["_1".to_string(), "_2".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -377,6 +380,7 @@ fn handle_result(result: &str) -> (cc::Module, ExternalBindings, Resolve) { }], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs index 7253bd98..0634257e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs @@ -93,6 +93,7 @@ pub(crate) fn fixed_list_fixture() -> (cc::Module, ExternalBindings, Resolve) { }], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, @@ -148,6 +149,7 @@ pub(crate) fn fixed_list_result_fixture() -> (cc::Module, ExternalBindings, Reso }], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs index a9c18f7e..f14bc681 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs @@ -53,6 +53,7 @@ pub(super) fn fixture() -> (cc::Module, ExternalBindings, Resolve) { product_labels: [(cc::ReprId(0), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -178,6 +179,7 @@ pub(super) fn result_fixture() -> (cc::Module, ExternalBindings, Resolve) { product_labels: [(cc::ReprId(0), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); @@ -268,6 +270,7 @@ pub(super) fn string_fixture() -> (cc::Module, ExternalBindings, Resolve) { product_labels: [(cc::ReprId(0), vec!["code".to_string(), "text".to_string()])] .into_iter() .collect(), + ..Default::default() }; let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs index 56123e27..6817d3a7 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs @@ -134,6 +134,7 @@ fn parameter_fixture( representations, signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, @@ -282,6 +283,7 @@ pub(crate) fn option_string_list_result_fixture() -> (cc::Module, ExternalBindin ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, @@ -456,6 +458,7 @@ pub(crate) fn option_list_list_fixture() -> (cc::Module, ExternalBindings, Resol ], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs index 4b701a0b..1d7e2253 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs @@ -372,6 +372,7 @@ fn finish( representations, signatures: Vec::new(), product_labels: labels.into_iter().collect(), + ..Default::default() }, functions: vec![cc::Function { symbol: main_symbol, diff --git a/crates/psrs-backend/src/mir/instruction/methods.rs b/crates/psrs-backend/src/mir/instruction/methods.rs index 11c37761..52f9dace 100644 --- a/crates/psrs-backend/src/mir/instruction/methods.rs +++ b/crates/psrs-backend/src/mir/instruction/methods.rs @@ -7,6 +7,7 @@ impl Instruction { pub fn destination(&self) -> Option { match self { Self::Copy { destination, .. } + | Self::ControlEvidence { destination, .. } | Self::Constant { destination, .. } | Self::NumberConstant { destination, .. } | Self::ArrayNewData { destination, .. } @@ -70,6 +71,16 @@ impl Instruction { pub fn operands(&self) -> Vec { match self { Self::Copy { value, .. } => vec![*value], + Self::ControlEvidence { + value, + implementation, + arguments, + .. + } => { + let mut uses = arguments.clone(); + uses.extend([*value, *implementation]); + uses + } Self::Constant { .. } | Self::NumberConstant { .. } | Self::ArrayNewData { .. } => { Vec::new() } @@ -161,6 +172,7 @@ impl Instruction { pub fn span(&self) -> TextRange { match self { Self::Copy { span, .. } + | Self::ControlEvidence { span, .. } | Self::Constant { span, .. } | Self::NumberConstant { span, .. } | Self::ArrayNewData { span, .. } diff --git a/crates/psrs-backend/src/mir/instruction/mod.rs b/crates/psrs-backend/src/mir/instruction/mod.rs index a7b6a3d1..0d6ca06f 100644 --- a/crates/psrs-backend/src/mir/instruction/mod.rs +++ b/crates/psrs-backend/src/mir/instruction/mod.rs @@ -19,6 +19,15 @@ pub enum ListDirection { #[derive(Clone, Debug, PartialEq, Eq)] pub enum Instruction { + /// Source proof retained beside an already represented runtime value. + ControlEvidence { + destination: ValueId, + value: ValueId, + implementation: ValueId, + arguments: Vec, + contract: crate::cc::ControlContractId, + span: TextRange, + }, Copy { destination: ValueId, value: ValueId, diff --git a/crates/psrs-backend/src/mir/layout/tests.rs b/crates/psrs-backend/src/mir/layout/tests.rs index 222ce67b..d2c16c69 100644 --- a/crates/psrs-backend/src/mir/layout/tests.rs +++ b/crates/psrs-backend/src/mir/layout/tests.rs @@ -72,6 +72,7 @@ fn planner_rejects_a_dangling_closure_signature() { }], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; assert!(matches!( PlannedLayout::plan(&table, TargetCapabilities::default()), @@ -84,6 +85,7 @@ fn gc_planner_rejects_an_mvp_only_target() { representations: vec![Representation::Product { fields: Vec::new() }], signatures: Vec::new(), product_labels: Default::default(), + ..Default::default() }; let mvp_only = TargetCapabilities { diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 35406bd1..9d85a356 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -8,6 +8,44 @@ impl FunctionLowerer<'_> { ) -> Result> { for assignment in assignments { match &assignment.kind { + AssignmentKind::ControlEvidence { + value, + implementation, + contract, + arguments, + } => { + let proof = self + .layout + .representation_table() + .control_contracts + .get(contract.0 as usize) + .ok_or_else(|| { + vec![BackendError::invalid_ir( + "P9 MIR lowering", + assignment.span, + "control evidence has no checked source contract", + )] + })?; + if proof.arguments().len() != arguments.len() { + return Err(vec![BackendError::invalid_ir( + "P9 MIR lowering", + assignment.span, + "control evidence argument count disagrees with its checked source contract", + )]); + } + self.append_instruction( + current, + Instruction::ControlEvidence { + destination: assignment.destination, + value: *value, + implementation: *implementation, + arguments: arguments.clone(), + contract: *contract, + span: assignment.span, + }, + assignment.span, + )?; + } AssignmentKind::AggregateConvert { value, conversion, .. } => { diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 4b360e0f..e442b330 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -7,6 +7,7 @@ use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; pub(crate) mod cfg; +mod control_contracts; mod instruction; pub(crate) mod layout; mod literals; diff --git a/crates/psrs-backend/src/mir/opt/effects.rs b/crates/psrs-backend/src/mir/opt/effects.rs index 8bfe3d45..342a69f4 100644 --- a/crates/psrs-backend/src/mir/opt/effects.rs +++ b/crates/psrs-backend/src/mir/opt/effects.rs @@ -111,6 +111,7 @@ pub(super) fn classify(instruction: &Instruction) -> InstructionEffects { ..InstructionEffects::default() }, I::Copy { .. } + | I::ControlEvidence { .. } | I::Constant { .. } | I::NumberConstant { .. } | I::Primitive { .. } diff --git a/crates/psrs-backend/src/mir/opt/values.rs b/crates/psrs-backend/src/mir/opt/values.rs index 46d3b377..a4e3c3cd 100644 --- a/crates/psrs-backend/src/mir/opt/values.rs +++ b/crates/psrs-backend/src/mir/opt/values.rs @@ -123,6 +123,20 @@ pub(crate) fn remap_instruction( *value = mapping.get(value).copied().unwrap_or(*value); }; match instruction { + I::ControlEvidence { + destination, + value, + implementation, + arguments, + .. + } => { + replace(destination); + replace(value); + replace(implementation); + for argument in arguments { + replace(argument); + } + } I::Copy { destination, value, .. } => { diff --git a/crates/psrs-backend/src/mir/reachable/assignments.rs b/crates/psrs-backend/src/mir/reachable/assignments.rs index d737bb0b..37d65f63 100644 --- a/crates/psrs-backend/src/mir/reachable/assignments.rs +++ b/crates/psrs-backend/src/mir/reachable/assignments.rs @@ -130,6 +130,7 @@ pub(super) fn add_assignments( } } AssignmentKind::Constant(_) + | AssignmentKind::ControlEvidence { .. } | AssignmentKind::NumberConstant(_) | AssignmentKind::StringConstant(_) | AssignmentKind::Primitive { .. } diff --git a/crates/psrs-backend/src/mir/verify/instruction/copy.rs b/crates/psrs-backend/src/mir/verify/instruction/copy.rs index a32e5357..82246d59 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/copy.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/copy.rs @@ -8,11 +8,17 @@ pub(super) fn verify_copy( instruction: &Instruction, definitions: &HashMap, ) -> Result<(), Vec> { - let Instruction::Copy { + let (Instruction::Copy { destination, value, span, - } = instruction + } + | Instruction::ControlEvidence { + destination, + value, + span, + .. + }) = instruction else { unreachable!("copy verifier received another instruction") }; diff --git a/crates/psrs-backend/src/mir/verify/instruction/mod.rs b/crates/psrs-backend/src/mir/verify/instruction/mod.rs index beddd227..eb5cae33 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/mod.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/mod.rs @@ -29,7 +29,9 @@ pub(super) fn verify_instruction( defined: &[&DefinedType], ) -> Result<(), Vec> { match instruction { - Instruction::Copy { .. } => copy::verify_copy(function, instruction, definitions)?, + Instruction::Copy { .. } | Instruction::ControlEvidence { .. } => { + copy::verify_copy(function, instruction, definitions)? + } Instruction::Constant { .. } | Instruction::NumberConstant { .. } => { constant::verify_constant(function, instruction, definitions)? } diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index 715ed585..aac35b4f 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -32,6 +32,7 @@ struct Signature { pub fn verify_module(module: &Module) -> Result<(), Vec> { let mut errors = Vec::new(); + super::control_contracts::verify(module, &mut errors); verify_defined_types(module, &mut errors); let mut signatures = module .functions diff --git a/crates/psrs-backend/src/wasm/lower/structure/instructions.rs b/crates/psrs-backend/src/wasm/lower/structure/instructions.rs index 222269ca..ea7ceb9d 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/instructions.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/instructions.rs @@ -12,6 +12,12 @@ impl Structurer<'_> { destination, value, span, + } + | MirInstruction::ControlEvidence { + destination, + value, + span, + .. } => { self.load(body, *value, *span)?; self.store(body, *destination, *span)?; diff --git a/crates/psrs-core/src/control.rs b/crates/psrs-core/src/control.rs new file mode 100644 index 00000000..07139378 --- /dev/null +++ b/crates/psrs-core/src/control.rs @@ -0,0 +1,272 @@ +//! The authoritative checked contract for the eight generic control operations. +use crate::{Module, Type, TypeConstructor, TypeId}; +use psrs_hir::Intrinsic; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct ControlDomain { + pub request: TypeId, + pub answer: TypeId, +} + +/// Constructed only after carrier, callable and rigid quantified-answer checks. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct CheckedControlContract { + operation: Intrinsic, + result: TypeId, + arguments: Vec, + source: Option, + target: Option, +} + +impl CheckedControlContract { + pub fn operation(&self) -> Intrinsic { + self.operation + } + pub fn result(&self) -> TypeId { + self.result + } + pub fn arguments(&self) -> &[TypeId] { + &self.arguments + } + pub fn source(&self) -> Option { + self.source + } + pub fn target(&self) -> Option { + self.target + } +} + +pub fn checked_control_contract( + module: &Module, + intrinsic: Intrinsic, + result: TypeId, + arguments: &[TypeId], +) -> Result { + if intrinsic.descriptor().category != psrs_hir::IntrinsicCategory::Control { + return Err("operation is not a control primitive"); + } + if arguments.len() != intrinsic.descriptor().arity as usize { + return Err("control primitive has an incompatible argument count"); + } + if intrinsic == Intrinsic::ControlHandle { + check_handle(module, result, arguments)?; + } else { + check(module, intrinsic, result, arguments)?; + } + let source_type = match intrinsic { + Intrinsic::ControlBind => Some(arguments[0]), + Intrinsic::ControlRun | Intrinsic::ControlHandle => Some(arguments[2]), + Intrinsic::ControlOnce => call(module, arguments[0], 1).map(|(_, result)| result), + _ => None, + }; + let source = source_type.and_then(|id| domain(module, id)).or_else(|| { + if matches!( + intrinsic, + Intrinsic::ControlResume | Intrinsic::ControlCancel + ) { + let parts = carrier_parts(module, arguments[0], psrs_hir::TypeId::RESUMPTION, 3)?; + Some(ControlDomain { + request: parts[0], + answer: parts[2], + }) + } else { + None + } + }); + Ok(CheckedControlContract { + operation: intrinsic, + result, + arguments: arguments.to_vec(), + source, + target: domain(module, result), + }) +} + +fn domain(module: &Module, id: TypeId) -> Option { + let (request, answer) = control_parts(module, id)?; + Some(ControlDomain { request, answer }) +} + +fn carrier_parts( + module: &Module, + id: TypeId, + carrier: psrs_hir::TypeId, + count: usize, +) -> Option> { + let (_, mut id) = crate::scheme_parts(&module.types, id)?; + let mut arguments = Vec::new(); + while let Some(Type::Application(head, argument)) = module.types.get(id.0 as usize) { + if arguments.len() >= count { + return None; + } + arguments.push(*argument); + id = *head; + } + if arguments.len() != count + || !matches!(module.types.get(id.0 as usize), + Some(Type::Constructor(TypeConstructor::User(actual))) if *actual == carrier) + { + return None; + } + arguments.reverse(); + Some(arguments) +} + +fn control_parts(module: &Module, id: TypeId) -> Option<(TypeId, TypeId)> { + let parts = carrier_parts(module, id, psrs_hir::TypeId::CONTROL, 2)?; + Some((parts[0], parts[1])) +} + +fn pair_parts(module: &Module, id: TypeId) -> Option<(TypeId, TypeId)> { + let fields = module.record_fields(id)?; + if fields.len() != 2 { + return None; + } + Some(( + fields.iter().find(|(label, _)| label == "_1")?.1, + fields.iter().find(|(label, _)| label == "_2")?.1, + )) +} + +fn call(module: &Module, id: TypeId, count: usize) -> Option<(Vec, TypeId)> { + let (parameters, result) = crate::call_parts(&module.types, id).ok()?; + (parameters.len() == count).then_some((parameters, result)) +} + +fn request_parts(module: &Module, clause: TypeId, request: TypeId) -> Option<(TypeId, TypeId)> { + let (variables, _) = crate::scheme_parts(&module.types, clause)?; + let Type::Application(functor, answer) = module.types.get(request.0 as usize)? else { + return None; + }; + let Type::Variable(variable) = module.types.get(answer.0 as usize)? else { + return None; + }; + (variables.len() == 1 && variables.contains(variable)).then_some((*functor, *answer)) +} + +fn check( + module: &Module, + intrinsic: Intrinsic, + use_type: TypeId, + arguments: &[TypeId], +) -> Result<(), &'static str> { + let equal = |a, b| crate::verify::equivalent_types(a, b, module); + let valid = (|| { + use psrs_hir::Intrinsic::*; + let args = arguments; + match intrinsic { + ControlReturn => { + let (_, answer) = control_parts(module, use_type)?; + equal(args[0], answer).then_some(()) + } + ControlPerform => { + let (functor, answer) = control_parts(module, use_type)?; + let Type::Application(f, a) = module.types.get(args[0].0 as usize)? else { + return None; + }; + (equal(*f, functor) && equal(*a, answer)).then_some(()) + } + ControlBind => { + let (source, answer) = control_parts(module, args[0])?; + let (target, _) = control_parts(module, use_type)?; + let (params, result) = call(module, args[1], 1)?; + (equal(source, target) && equal(params[0], answer) && equal(result, use_type)) + .then_some(()) + } + ControlRun => { + let (functor, answer) = control_parts(module, args[2])?; + let (params, result) = call(module, args[1], 3)?; + let (request, x) = request_parts(module, args[1], params[1])?; + let (raw, source) = call(module, params[2], 1)?; + let (state, next) = pair_parts(module, result)?; + let (out_state, out_answer) = pair_parts(module, use_type)?; + (equal(params[0], args[0]) + && equal(request, functor) + && equal(raw[0], x) + && equal(source, args[2]) + && equal(state, args[0]) + && equal(next, args[2]) + && equal(out_state, args[0]) + && equal(out_answer, answer)) + .then_some(()) + } + ControlOnce => { + let owner = carrier_parts(module, use_type, psrs_hir::TypeId::RESUMPTION, 3)?; + let (params, result) = call(module, args[0], 1)?; + let (functor, answer) = control_parts(module, result)?; + (equal(params[0], owner[1]) && equal(functor, owner[0]) && equal(answer, owner[2])) + .then_some(()) + } + ControlResume => { + let owner = carrier_parts(module, args[0], psrs_hir::TypeId::RESUMPTION, 3)?; + let (functor, answer) = control_parts(module, use_type)?; + (equal(args[1], owner[1]) && equal(functor, owner[0]) && equal(answer, owner[2])) + .then_some(()) + } + ControlCancel => { + carrier_parts(module, args[0], psrs_hir::TypeId::RESUMPTION, 3)?; + matches!( + module.types.get(use_type.0 as usize), + Some(Type::Constructor(TypeConstructor::Unit)) + ) + .then_some(()) + } + _ => None, + } + })() + .is_some(); + if valid { + Ok(()) + } else { + Err("control primitive does not preserve its checked carrier and callable contracts") + } +} + +fn check_handle( + module: &Module, + use_type: TypeId, + arguments: &[TypeId], +) -> Result<(), &'static str> { + let valid = (|| { + let (source_request, source_answer) = control_parts(module, arguments[2])?; + control_parts(module, use_type)?; + let (ret_parameters, ret_result) = crate::call_parts(&module.types, arguments[0]).ok()?; + if ret_parameters.len() != 1 { + return None; + } + let (variables, body) = crate::scheme_parts(&module.types, arguments[1])?; + let (parameters, result) = crate::call_parts(&module.types, body).ok()?; + if variables.len() != 1 || parameters.len() != 2 { + return None; + } + let Type::Application(request, answer) = module.types.get(parameters[0].0 as usize)? else { + return None; + }; + let Type::Variable(variable) = module.types.get(answer.0 as usize)? else { + return None; + }; + if !variables.contains(variable) { + return None; + } + let (raw_parameters, raw_result) = crate::call_parts(&module.types, parameters[1]).ok()?; + if raw_parameters.len() != 1 { + return None; + } + // Use the checking owner's single rigid relation for all repeated + // positions. Quantified answer variables must remain the same. + let equal = |a, b| crate::verify::equivalent_types(a, b, module); + (equal(ret_parameters[0], source_answer) + && equal(ret_result, use_type) + && equal(*request, source_request) + && equal(raw_parameters[0], *answer) + && equal(raw_result, arguments[2]) + && equal(result, use_type)) + .then_some(()) + })() + .is_some(); + if valid { + Ok(()) + } else { + Err("control handle clauses do not preserve their checked source and target contracts") + } +} diff --git a/crates/psrs-core/src/lib.rs b/crates/psrs-core/src/lib.rs index 5a420c68..d6507c71 100644 --- a/crates/psrs-core/src/lib.rs +++ b/crates/psrs-core/src/lib.rs @@ -1,4 +1,10 @@ pub mod command; +mod control; +pub use control::{CheckedControlContract, ControlDomain, checked_control_contract}; +/// The Core owner's rigid type relation, including lexical alpha-equivalence. +pub fn equivalent_types(left: TypeId, right: TypeId, module: &Module) -> bool { + verify::equivalent_types(left, right, module) +} pub mod dictionary; mod instantiation; mod link; diff --git a/crates/psrs-core/src/tests/control.rs b/crates/psrs-core/src/tests/control.rs index 4f736511..1aa7bcba 100644 --- a/crates/psrs-core/src/tests/control.rs +++ b/crates/psrs-core/src/tests/control.rs @@ -111,3 +111,44 @@ fn verifier_rejects_a_forged_source_payload_at_the_common_constructor() { "control primitive does not preserve its checked carrier and callable contracts" )); } + +#[test] +fn checked_control_proof_retains_both_domains_and_the_full_clause_type() { + let module = fixture(false, false); + let expression = &module.declarations[0].value; + let ExprKind::IntrinsicCall { + intrinsic, + arguments, + } = &expression.kind + else { + unreachable!() + }; + let arguments = arguments + .iter() + .map(|argument| argument.ty) + .collect::>(); + let proof = + crate::checked_control_contract(&module, *intrinsic, expression.ty, &arguments).unwrap(); + assert_eq!(proof.operation(), Intrinsic::ControlHandle); + assert_eq!(proof.result(), expression.ty); + assert_eq!(proof.arguments(), arguments); + assert_eq!( + proof.source(), + Some(crate::ControlDomain { + request: TypeId(3), + answer: TypeId(0) + }) + ); + assert_eq!( + proof.target(), + Some(crate::ControlDomain { + request: TypeId(4), + answer: TypeId(1) + }) + ); + assert!(matches!( + module.types[proof.arguments()[1].0 as usize], + Type::ForAll { .. } + )); + assert!(crate::checked_control_contract(&module, *intrinsic, expression.ty, &[]).is_err()); +} diff --git a/crates/psrs-core/src/verify/expr/control.rs b/crates/psrs-core/src/verify/expr/control.rs index a4bb8bcc..0f2398ef 100644 --- a/crates/psrs-core/src/verify/expr/control.rs +++ b/crates/psrs-core/src/verify/expr/control.rs @@ -1,63 +1,6 @@ -//! Verify the typed source/target boundary before control payloads are erased. +//! Consume the control owner's checked contract before payload erasure. use super::{Context, error, viewed}; -use crate::{Expr, Module, Type, TypeConstructor, TypeId}; - -fn carrier_parts( - module: &Module, - id: TypeId, - carrier: psrs_hir::TypeId, - count: usize, -) -> Option> { - let (_, mut id) = crate::scheme_parts(&module.types, id)?; - let mut arguments = Vec::new(); - while let Some(Type::Application(head, argument)) = module.types.get(id.0 as usize) { - if arguments.len() >= count { - return None; - } - arguments.push(*argument); - id = *head; - } - if arguments.len() != count - || !matches!(module.types.get(id.0 as usize), - Some(Type::Constructor(TypeConstructor::User(actual))) if *actual == carrier) - { - return None; - } - arguments.reverse(); - Some(arguments) -} - -fn control_parts(module: &Module, id: TypeId) -> Option<(TypeId, TypeId)> { - let parts = carrier_parts(module, id, psrs_hir::TypeId::CONTROL, 2)?; - Some((parts[0], parts[1])) -} - -fn pair_parts(module: &Module, id: TypeId) -> Option<(TypeId, TypeId)> { - let fields = module.record_fields(id)?; - if fields.len() != 2 { - return None; - } - Some(( - fields.iter().find(|(label, _)| label == "_1")?.1, - fields.iter().find(|(label, _)| label == "_2")?.1, - )) -} - -fn call(module: &Module, id: TypeId, count: usize) -> Option<(Vec, TypeId)> { - let (parameters, result) = crate::call_parts(&module.types, id).ok()?; - (parameters.len() == count).then_some((parameters, result)) -} - -fn request_parts(module: &Module, clause: TypeId, request: TypeId) -> Option<(TypeId, TypeId)> { - let (variables, _) = crate::scheme_parts(&module.types, clause)?; - let Type::Application(functor, answer) = module.types.get(request.0 as usize)? else { - return None; - }; - let Type::Variable(variable) = module.types.get(answer.0 as usize)? else { - return None; - }; - (variables.len() == 1 && variables.contains(variable)).then_some((*functor, *answer)) -} +use crate::Expr; impl Context<'_> { pub(super) fn verify_control( @@ -66,157 +9,22 @@ impl Context<'_> { intrinsic: psrs_hir::Intrinsic, arguments: &[Expr], ) { - if intrinsic == psrs_hir::Intrinsic::ControlHandle { - return self.verify_control_handle(expression, arguments); - } for argument in arguments { self.expr(argument, None); } + let argument_types = arguments + .iter() + .map(|argument| argument.ty) + .collect::>(); let ids = std::iter::once(expression.ty) - .chain(arguments.iter().map(|a| a.ty)) + .chain(argument_types.iter().copied()) .collect::>(); let module = viewed(self.module, self.source, &ids); - let equal = |a, b| super::super::types::equivalent_types(a, b, module); - let valid = (|| { - use psrs_hir::Intrinsic::*; - let args = arguments.iter().map(|a| a.ty).collect::>(); - match intrinsic { - ControlReturn => { - let (_, answer) = control_parts(module, expression.ty)?; - equal(args[0], answer).then_some(()) - } - ControlPerform => { - let (functor, answer) = control_parts(module, expression.ty)?; - let Type::Application(f, a) = module.types.get(args[0].0 as usize)? else { - return None; - }; - (equal(*f, functor) && equal(*a, answer)).then_some(()) - } - ControlBind => { - let (source, answer) = control_parts(module, args[0])?; - let (target, _) = control_parts(module, expression.ty)?; - let (params, result) = call(module, args[1], 1)?; - (equal(source, target) - && equal(params[0], answer) - && equal(result, expression.ty)) - .then_some(()) - } - ControlRun => { - let (functor, answer) = control_parts(module, args[2])?; - let (params, result) = call(module, args[1], 3)?; - let (request, x) = request_parts(module, args[1], params[1])?; - let (raw, source) = call(module, params[2], 1)?; - let (state, next) = pair_parts(module, result)?; - let (out_state, out_answer) = pair_parts(module, expression.ty)?; - (equal(params[0], args[0]) - && equal(request, functor) - && equal(raw[0], x) - && equal(source, args[2]) - && equal(state, args[0]) - && equal(next, args[2]) - && equal(out_state, args[0]) - && equal(out_answer, answer)) - .then_some(()) - } - ControlOnce => { - let owner = - carrier_parts(module, expression.ty, psrs_hir::TypeId::RESUMPTION, 3)?; - let (params, result) = call(module, args[0], 1)?; - let (functor, answer) = control_parts(module, result)?; - (equal(params[0], owner[1]) - && equal(functor, owner[0]) - && equal(answer, owner[2])) - .then_some(()) - } - ControlResume => { - let owner = carrier_parts(module, args[0], psrs_hir::TypeId::RESUMPTION, 3)?; - let (functor, answer) = control_parts(module, expression.ty)?; - (equal(args[1], owner[1]) - && equal(functor, owner[0]) - && equal(answer, owner[2])) - .then_some(()) - } - ControlCancel => { - carrier_parts(module, args[0], psrs_hir::TypeId::RESUMPTION, 3)?; - matches!( - module.types.get(expression.ty.0 as usize), - Some(Type::Constructor(TypeConstructor::Unit)) - ) - .then_some(()) - } - _ => None, - } - })() - .is_some(); - if !valid { - self.errors.push(error( - self.owner, - expression.span, - "control primitive does not preserve its checked carrier and callable contracts", - )); - } - } - - pub(super) fn verify_control_handle(&mut self, expression: &Expr, arguments: &[Expr]) { - for argument in arguments { - self.expr(argument, None); - } - let module = viewed( - self.module, - self.source, - &[ - expression.ty, - arguments[0].ty, - arguments[1].ty, - arguments[2].ty, - ], - ); - let valid = (|| { - let (source_request, source_answer) = control_parts(module, arguments[2].ty)?; - control_parts(module, expression.ty)?; - let (ret_parameters, ret_result) = - crate::call_parts(&module.types, arguments[0].ty).ok()?; - if ret_parameters.len() != 1 { - return None; - } - let (variables, body) = crate::scheme_parts(&module.types, arguments[1].ty)?; - let (parameters, result) = crate::call_parts(&module.types, body).ok()?; - if variables.len() != 1 || parameters.len() != 2 { - return None; - } - let Type::Application(request, answer) = module.types.get(parameters[0].0 as usize)? - else { - return None; - }; - let Type::Variable(variable) = module.types.get(answer.0 as usize)? else { - return None; - }; - if !variables.contains(variable) { - return None; - } - let (raw_parameters, raw_result) = - crate::call_parts(&module.types, parameters[1]).ok()?; - if raw_parameters.len() != 1 { - return None; - } - // Use the checking owner's single rigid relation for all repeated - // positions. Quantified answer variables must remain the same. - let equal = |a, b| super::super::types::equivalent_types(a, b, module); - (equal(ret_parameters[0], source_answer) - && equal(ret_result, expression.ty) - && equal(*request, source_request) - && equal(raw_parameters[0], *answer) - && equal(raw_result, arguments[2].ty) - && equal(result, expression.ty)) - .then_some(()) - })() - .is_some(); - if !valid { - self.errors.push(error( - self.owner, - expression.span, - "control handle clauses do not preserve their checked source and target contracts", - )); + if let Err(message) = + crate::checked_control_contract(module, intrinsic, expression.ty, &argument_types) + { + self.errors + .push(error(self.owner, expression.span, message)); } } } diff --git a/crates/psrs-driver/src/tests/control_contracts.rs b/crates/psrs-driver/src/tests/control_contracts.rs index c8a5e892..ba66631b 100644 --- a/crates/psrs-driver/src/tests/control_contracts.rs +++ b/crates/psrs-driver/src/tests/control_contracts.rs @@ -90,3 +90,247 @@ main = (C.run 0 handler (C.perform (Op \x -> x)))._2 assert_eq!(function.result_type, boundary); } } + +const DOMAINS: &str = r"module Main where +import Prim.Control as C +data F x = F (Int -> x) +data G x = G (Int -> x) +clause :: forall x. F x -> (x -> C.Control F Int) -> C.Control G Boolean +clause request raw = C.return true +outer :: forall x. Int -> G x -> (x -> C.Control G Boolean) -> { _1 :: Int, _2 :: C.Control G Boolean } +outer state (G k) raw = { _1: state, _2: raw (k 0) } +main :: Int +main = let target = (C.return true :: C.Control G Boolean) + result = C.handle (\n -> target) clause (C.return 42) + in if (C.run 0 outer result)._2 then 42 else 0 +"; + +#[test] +fn checked_domains_and_rank_two_clause_survive_physical_lowering() { + use psrs_backend::cc::{TypeConstructorIdentity as C, TypeIdentity as T}; + let stages = crate::compile_main_stages(DOMAINS).unwrap(); + let cc = &stages.cc; + let handle = cc + .representations + .control_contracts + .iter() + .find(|proof| proof.operation() == psrs_hir::Intrinsic::ControlHandle) + .unwrap(); + assert_eq!(handle.source().unwrap().answer, T::Constructor(C::Int)); + assert_eq!(handle.target().unwrap().answer, T::Constructor(C::Boolean)); + assert_ne!( + handle.source().unwrap().request, + handle.target().unwrap().request + ); + assert!(matches!(handle.arguments()[1], T::ForAll { .. })); + let mir = &stages.mir; + assert!(mir.control_contracts().iter().any(|proof| proof == handle)); + assert!( + mir.functions + .iter() + .flat_map(|function| &function.blocks) + .flat_map(|block| &block.instructions) + .any(|instruction| matches!( + instruction, + psrs_backend::mir::Instruction::ControlEvidence { .. } + )) + ); + psrs_backend::mir::verify_module(mir).unwrap(); +} + +#[test] +fn cc_rejects_a_dangling_control_contract() { + let mut input = crate::lower_main_to_cc(DOMAINS).unwrap(); + let evidence = input + .cc + .functions + .iter_mut() + .flat_map(|function| &mut function.assignments) + .find_map(|assignment| match &mut assignment.kind { + AssignmentKind::ControlEvidence { contract, .. } => Some(contract), + _ => None, + }) + .unwrap(); + *evidence = psrs_backend::cc::ControlContractId(u32::MAX); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("no checked source contract")) + ); +} + +#[test] +fn cc_rejects_a_same_shape_body_from_the_target_domain() { + let mut input = crate::lower_main_to_cc(DOMAINS).unwrap(); + let contracts = &input.cc.representations.control_contracts; + let (function, index) = input.cc.functions.iter_mut().find_map(|function| function.assignments.iter().position(|assignment| matches!(&assignment.kind, + AssignmentKind::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle)).map(|index| (function, index))).unwrap(); + let target = function + .assignments + .iter() + .find_map(|assignment| match &assignment.kind { + AssignmentKind::ControlEvidence { contract, .. } + if contracts[contract.0 as usize] + .target() + .is_some_and(|domain| { + domain.answer + == psrs_backend::cc::TypeIdentity::Constructor( + psrs_backend::cc::TypeConstructorIdentity::Boolean, + ) + }) => + { + Some(assignment.destination) + } + _ => None, + }) + .unwrap(); + let argument = match &function.assignments[index].kind { + AssignmentKind::ControlEvidence { arguments, .. } => arguments[2], + _ => unreachable!(), + }; + let erasure = function + .assignments + .iter_mut() + .find(|assignment| assignment.destination == argument) + .unwrap(); + let AssignmentKind::AggregateConvert { value, .. } = &mut erasure.kind else { + unreachable!() + }; + *value = target; + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("source type disagrees with its checked domain")), + "{errors:?}" + ); +} + +#[test] +fn cc_rejects_a_frame_that_does_not_save_the_proven_source_body() { + let mut input = crate::lower_main_to_cc(DOMAINS).unwrap(); + let contracts = &input.cc.representations.control_contracts; + let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().any(|assignment| matches!(&assignment.kind, + AssignmentKind::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle))).unwrap(); + let (implementation, other) = function + .assignments + .iter() + .find_map(|assignment| match &assignment.kind { + AssignmentKind::ControlEvidence { + contract, + implementation, + arguments, + .. + } if contracts[contract.0 as usize].operation() + == psrs_hir::Intrinsic::ControlHandle => + { + Some((*implementation, arguments[0])) + } + _ => None, + }) + .unwrap(); + let frame = function + .assignments + .iter_mut() + .find(|assignment| assignment.destination == implementation) + .unwrap(); + let AssignmentKind::VariantNew { fields, .. } = &mut frame.kind else { + unreachable!() + }; + let cast = fields[2]; + let cast = function + .assignments + .iter_mut() + .find(|assignment| assignment.destination == cast) + .unwrap(); + let AssignmentKind::RepresentationCast { value, .. } = &mut cast.kind else { + unreachable!() + }; + *value = other; + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("does not preserve its checked source operands")), + "{errors:?}" + ); +} + +#[test] +fn mir_rejects_an_operand_from_the_other_checked_domain() { + let mut stages = crate::compile_main_stages(DOMAINS).unwrap(); + let contracts = stages.mir.control_contracts().to_vec(); + let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, + psrs_backend::mir::Instruction::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle))).unwrap(); + let target = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + psrs_backend::mir::Instruction::ControlEvidence { + destination, + contract, + .. + } if contracts[contract.0 as usize].operation() + == psrs_hir::Intrinsic::ControlReturn + && contracts[contract.0 as usize] + .target() + .is_some_and(|domain| { + domain.answer + == psrs_backend::cc::TypeIdentity::Constructor( + psrs_backend::cc::TypeConstructorIdentity::Boolean, + ) + }) => + { + Some(*destination) + } + _ => None, + }) + .unwrap(); + for instruction in function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + { + if let psrs_backend::mir::Instruction::ControlEvidence { + arguments, + contract, + .. + } = instruction + && contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle + { + arguments[2] = target; + } + } + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("source type disagrees with its checked domain")), + "{errors:?}" + ); +} + +#[test] +fn mir_rejects_a_dangling_control_contract_after_optimization() { + let mut stages = crate::compile_main_stages(DOMAINS).unwrap(); + let contract = stages + .mir + .functions + .iter_mut() + .flat_map(|function| &mut function.blocks) + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + psrs_backend::mir::Instruction::ControlEvidence { contract, .. } => Some(contract), + _ => None, + }) + .unwrap(); + *contract = psrs_backend::cc::ControlContractId(u32::MAX); + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("no checked source contract")) + ); +} diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index f9160816..4b195b98 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core checks the carrier/callable contracts before erasure; nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 99ad585d..88490864 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -201,12 +201,42 @@ the erased user `(state, answer)` protocol. Ordinary helpers and self tail-call loop parameters retain those types; crossing the user callback protocol erases only the callback arguments/results that require it. -These contracts reject a queue supplied as a finish extent or helper argument, -and an erased field projection declared without an explicit conversion. They do not -prove which particular extent owns a checkpoint or that two same-shaped fields -have compatible source/target domains. Full semantic provenance verification -must additionally retain those semantic identities through helper calls and -casts; a well-shaped reference cast alone is not that proof. +These storage contracts reject a queue supplied as a finish extent or helper +argument, and an erased projection declared without an explicit conversion. +Source semantic contracts have a separate owner. Core exposes a sealed checked +contract for each of the eight operations; both its verifier and P8 consume the +same carrier, callable and quantified-answer checks. Planning quotes the complete +result and operand types before freezing the representation table. The quotation +retains stable constructors, free variables, lexical `forall` binders and open +rows without retaining Core arena indices. Canonical source type identities use +Core's rigid equality, including alpha-equivalence and its existing row relation. +CC does not implement another effect type checker. + +At each source erasure boundary, `ControlEvidence` connects the immutable +contract to the represented result, original erased operands and actual frame +construction or helper call. CC checks the predeclared frame case/representation +or helper signature and ordered operands through reference erasure/recovery +aliases. Frame results must be the proven construction. When an operand comes +from another control witness in the same CC assignment sequence, its canonical source type must match the +consumer's checked operand type. Thus identical runtime shapes do not permit +exchanging a known source computation with a target computation. + +P9 preserves the witness as an SSA instruction. MIR checks its contract and +arity, verifies ordinary SSA use/definition and result type rules, and compares +known producer domains through copies and reference casts. Optimizations remap +all evidence operands with their ordinary value substitutions. Live witnesses +survive P10; dead, pure witnesses may disappear with unused inert results. Wasm +encoding finally erases the proof and emits only the represented value copy. +There is no additional source intrinsic, runtime frame or host callback protocol. + +This is a partial semantic provenance contract. Parameter values, imported and +ordinary higher-order call results, aggregate projections and control-flow joins +without a local witness remain trusted Core/P8 producer boundaries. MIR trusts +P9's translation of the checked factory relationship; it does not reconstruct +that relationship from physical struct instructions. A matching helper signature +does not prove a helper's implementation identity. Exact checkpoint ownership, +replay activation and matched finish provenance must still be carried and +verified; neither a well-shaped cast nor a quoted source type proves them. ### Alternatives diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 7a2c7ba9..ae8e6913 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -910,3 +910,80 @@ facades, remaining mechanism acceptance must cover: AE-11 native host interpretation and the official Effect/ST facades belong to the subsequent native topic. This dependency ordering does not change their required acceptance or narrow any AC requirement above. + + +### Checked source contracts through physical lowering (2026-10-12) + +This continuation starts from compiler `2e88d656`. Core's existing control checks +now have one shared API, `checked_control_contract`, returning a sealed proof. +Core verification still traverses the operand expressions and supplies its scoped +type view. P8 checks the same operation contract, quotes its complete result, +arguments and source/target domains, and plans the factory representation/case or +helper signature before the CC representation table becomes immutable. + +The quotations retain nested quantifiers, binder identities, stable constructors +and open rows. Canonical type identities are allocated using Core's existing +rigid equality; the backend does not infer effect rows or add a private relation. +`ControlEvidence` is an explicit erasure-boundary witness. CC checks the actual +factory's ordered operands, allowing the checked representation conversions, and +requires inert frame results to be the proven construction. Known control +producers in the same CC assignment sequence must supply the expected canonical source type. MIR retains the source +proof, validates references/arity/result shape and checks known producer domains +through copies/casts after optimization. The final encoder emits only a value +copy. No new source intrinsic, heap frame or host import is added. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Share the authoritative checked source contract | Core `checked_control_proof_retains_both_domains_and_the_full_clause_type`; existing malformed carrier/callable tests | Focused Verified | +| Retain distinct request/answer domains and rank-two clauses through P10 | `checked_domains_and_rank_two_clause_survive_physical_lowering`, actual checked F/Int to G/Boolean source | Focused Verified | +| Reject missing contract references | `cc_rejects_a_dangling_control_contract`, `mir_rejects_a_dangling_control_contract_after_optimization` | Focused Verified | +| Connect proven operands to actual frame construction | `cc_rejects_a_frame_that_does_not_save_the_proven_source_body`; legal cast shapes with wrong saved operand | Focused Verified | +| Reject a known target-domain body as a source computation despite compatible physical storage | `cc_rejects_a_same_shape_body_from_the_target_domain`, `mir_rejects_an_operand_from_the_other_checked_domain` | Focused Verified | +| Establish complete semantic provenance | Parameters, ordinary call results, imports, aggregate projections, CC parent-sequence values and joins without local witnesses remain trusted; exact checkpoint/replay/finish identity is absent | Unverified | + +MIR trusts P9's translation of the checked factory connection; this unit does not +reconstruct that proof from physical struct instructions or establish helper +implementation identity from a matching signature. The complete AE/AC rows stay +Unverified. Foreign resource/buffer capture, caught-host-trap cleanup, full pinned +library acceptance and the remaining cost obligations also remain open. + +Focused validation passes 435 backend and 95 Core tests, 21 surface/scoped tests, +and 11 filtered driver tests (including the six new source/provenance tests and +the existing three ancestry/GC cost tests). Logs: +`/private/tmp/psrs-control-contracts-backend.log`, +`/private/tmp/psrs-control-contracts-focused.log`, and +`/private/tmp/psrs-control-contracts-driver.log`. + +The six long-loop cost measurements are rerun with the existing scales, 65,536-byte +initial heap, ancestry bound two and live-heap ceiling 16,384 bytes. Collection +counts and maximum post-GC live bytes remain exactly those measured in the prior +cost slice. Component identities change because live witnesses encode value +copies; this continuation's retained reports record: + +| Workload | Steps | Component fingerprint (`fnv1a64-v1`) | +| --- | ---: | --- | +| Deep | 1,000 | `5ed1de202d259abd` | +| Deep | 10,000 | `4b2c2d30ffa39ce5` | +| Deep | 100,000 | `c27e72b4855c6211` | +| Mixed forwarding | 1,000 | `4cb540e330538aed` | +| Mixed forwarding | 10,000 | `2df8c32f11ae2d73` | +| Mixed forwarding | 100,000 | `c4a675dd4d73a60c` | + +Reports use the same OS temporary paths recorded in the cost slice. These +measurements still do not supply a general allocation bound or exact total +allocated bytes. The unchanged semantic and lifetime obligations must be +completed before starting native Effect/ST. + +Final integrated validation: `cargo fmt --all --check`, `git diff --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. +`PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` executes every +workspace target. All 435 backend tests, 95 Core tests, 80 control integration +tests, six new driver source/provenance tests and three existing cost tests pass. +The nine failing targets and 175 failed test names are exactly the same as at +`2e88d656`; the comparison adds or recovers no names. This is a failure-name +comparison, not a new classification of each baseline cause. Logs and comparison: +`/private/tmp/psrs-control-contracts-workspace.log`, +`/private/tmp/psrs-control-contracts-comparison.json`, and +`/private/tmp/psrs-control-contracts-clippy.log`. Explicit upstream type comparison, +package conformance and suite scoreboards are not rerun for this internal stage +contract unit; no measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 525682cf..52ab4136 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -32,6 +32,12 @@ measurements for long deep and mixed-forwarding loops. New extent ancestry stays at most two edges for the measured workloads; independent non-tail scopes remain separate. The checklist records scale, artifacts and the distinction between live heap, collection churn and exact total allocation. +The continuation from `2e88d656` shares Core's checked control contract with +P8, quotes complete source/target types into the immutable CC table and retains +operation witnesses through optimized MIR. CC checks actual factory operands; +CC/MIR reject a locally proven computation from an incompatible semantic domain. +The checklist records focused structural and malformed-IR evidence and the +remaining trusted producer boundaries. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From df46f2d2807172c0522188b7d6ecd8aad82bcd82 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 11:44:01 +0800 Subject: [PATCH 111/148] Bind control machine calls to predeclared semantic helpers --- .../psrs-backend/src/cc/control_contract.rs | 10 +- crates/psrs-backend/src/cc/control_helpers.rs | 70 +++++ .../src/cc/layout/control_contracts.rs | 63 ++-- crates/psrs-backend/src/cc/layout/mod.rs | 10 +- .../src/cc/lower/call/application.rs | 1 + .../src/cc/lower/call/partial/global.rs | 1 + .../src/cc/lower/control/fields.rs | 10 + .../psrs-backend/src/cc/lower/control/mod.rs | 92 ++++-- crates/psrs-backend/src/cc/lower/global.rs | 1 + .../src/cc/lower/lambda/wrapper.rs | 2 + crates/psrs-backend/src/cc/lower/mod.rs | 1 + crates/psrs-backend/src/cc/mod.rs | 9 +- crates/psrs-backend/src/cc/representation.rs | 2 + .../psrs-backend/src/cc/verify/ops/control.rs | 12 +- crates/psrs-backend/src/cc/verify/ops/mod.rs | 4 + .../psrs-backend/src/cc/verify/ops/table.rs | 13 + .../src/cc/verify/tests/control_calls.rs | 1 + .../src/cc/verify/tests/effects.rs | 1 + .../psrs-backend/src/cc/verify/tests/mod.rs | 1 + .../src/cc/verify/tests/structure.rs | 1 + .../psrs-backend/src/linking/runtime_tests.rs | 2 + crates/psrs-backend/src/mir/binding_tests.rs | 2 + .../psrs-backend/src/mir/control_contracts.rs | 65 ++++ .../psrs-backend/src/mir/gc_tests/erased.rs | 1 + .../indirect_tests/aggregate/collections.rs | 1 + .../aggregate/erased_storage.rs | 1 + .../mir/indirect_tests/aggregate/fixtures.rs | 2 + .../mir/indirect_tests/aggregate/indirect.rs | 1 + .../src/mir/indirect_tests/aggregate/large.rs | 2 + .../indirect_tests/aggregate/list_record.rs | 1 + .../mir/indirect_tests/aggregate/nested.rs | 3 + .../indirect_tests/aggregate/record_fields.rs | 2 + .../aggregate/resource_result.rs | 1 + .../mir/indirect_tests/aggregate/scalars.rs | 2 + .../mir/indirect_tests/composite/fixture.rs | 1 + .../src/mir/indirect_tests/mod.rs | 1 + .../record_list/fixtures/aggregate.rs | 4 + .../record_list/fixtures/fixed.rs | 2 + .../record_list/fixtures/mod.rs | 3 + .../record_list/fixtures/variants.rs | 3 + .../record_list/fixtures/wide_flags.rs | 3 + .../psrs-backend/src/mir/instruction/mod.rs | 2 + .../src/mir/lower/aggregate/mod.rs | 1 + .../src/mir/lower/assignment_string/mod.rs | 3 + .../psrs-backend/src/mir/lower/assignments.rs | 13 + crates/psrs-backend/src/mir/lower/mod.rs | 1 + .../src/mir/lower/runtime_call.rs | 3 + .../src/mir/lower/storage_call.rs | 1 + crates/psrs-backend/src/mir/lower/tail.rs | 8 +- crates/psrs-backend/src/mir/mod.rs | 1 + .../src/mir/number_format_tests.rs | 2 + .../psrs-backend/src/mir/opt/tests/inline.rs | 2 + crates/psrs-backend/src/mir/tests/lowering.rs | 1 + .../psrs-backend/src/mir/verify/capability.rs | 1 + .../psrs-backend/src/mir/verify/function.rs | 1 + .../src/mir/verify/instruction/mod.rs | 1 + .../src/mir/verify/tests/dictionary.rs | 1 + .../src/mir/verify/tests/scalar.rs | 1 + .../psrs-backend/src/mir/verify/tests/tail.rs | 2 + .../src/mir/wit/aggregate/decode.rs | 1 + crates/psrs-backend/src/mir/wit/lists/mod.rs | 1 + crates/psrs-backend/src/mir/wit/mod.rs | 5 + .../src/mir/wit/parameters/indirect.rs | 1 + .../src/mir/wit/parameters/mod.rs | 1 + .../psrs-backend/src/mir/wit/tests/handles.rs | 2 + .../src/wasm/lower/structure/instructions.rs | 1 + .../src/wasm/lower/structure/region.rs | 1 + .../src/tests/control_costs/probe.rs | 2 + .../src/tests/control_helper_contracts.rs | 284 ++++++++++++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 26 ++ .../backend/algebraic-effects.md | 52 ++++ ...ted-control-lowering-handoff-2026-10-11.md | 5 + 74 files changed, 773 insertions(+), 65 deletions(-) create mode 100644 crates/psrs-backend/src/cc/control_helpers.rs create mode 100644 crates/psrs-driver/src/tests/control_helper_contracts.rs diff --git a/crates/psrs-backend/src/cc/control_contract.rs b/crates/psrs-backend/src/cc/control_contract.rs index c1c3b05d..781103b9 100644 --- a/crates/psrs-backend/src/cc/control_contract.rs +++ b/crates/psrs-backend/src/cc/control_contract.rs @@ -61,8 +61,14 @@ pub struct ControlDomain { #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub(super) enum ControlImplementation { - Frame { representation: ReprId, case: u32 }, - Call { signature: SignatureId }, + Frame { + representation: ReprId, + case: u32, + }, + Call { + signature: SignatureId, + role: super::ControlHelperRole, + }, } /// A source use can only be published from the control owner's checked proof. diff --git a/crates/psrs-backend/src/cc/control_helpers.rs b/crates/psrs-backend/src/cc/control_helpers.rs new file mode 100644 index 00000000..949881df --- /dev/null +++ b/crates/psrs-backend/src/cc/control_helpers.rs @@ -0,0 +1,70 @@ +//! Stable semantic identities of predeclared control-machine helpers. +use super::SignatureId; +use psrs_hir::SymbolId; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub struct ControlHelperId(pub u32); + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum ControlHelperRole { + Executor, + CloneSequence, + RebuildSequence, + Start, + Check, + Close, + Once, + Cancel, +} + +/// A checked call identifies a particular helper, even when two helpers have +/// the same physical signature. Only P8 planning publishes these bindings. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ControlHelperContract { + pub(super) role: ControlHelperRole, + pub(super) function: SymbolId, + pub(super) signature: SignatureId, +} + +impl ControlHelperContract { + pub fn role(&self) -> ControlHelperRole { + self.role + } + pub fn function(&self) -> SymbolId { + self.function + } + pub fn signature(&self) -> SignatureId { + self.signature + } +} + +impl super::RepresentationTable { + pub(crate) fn verify_control_call( + &self, + function: SymbolId, + contract: Option, + ) -> Result<(), &'static str> { + match contract { + Some(id) => { + let helper = self + .control_helpers + .get(id.0 as usize) + .ok_or("control call has no predeclared helper contract")?; + if helper.function != function { + return Err( + "control call target disagrees with its predeclared semantic helper", + ); + } + } + None if self + .control_helpers + .iter() + .any(|helper| helper.function == function) => + { + return Err("control helper call is missing its semantic contract"); + } + None => {} + } + Ok(()) + } +} diff --git a/crates/psrs-backend/src/cc/layout/control_contracts.rs b/crates/psrs-backend/src/cc/layout/control_contracts.rs index 040fa355..e938d5dd 100644 --- a/crates/psrs-backend/src/cc/layout/control_contracts.rs +++ b/crates/psrs-backend/src/cc/layout/control_contracts.rs @@ -15,20 +15,28 @@ pub(super) fn append( module: &Module, table: &mut RepresentationTable, layout: ControlLayout, -) -> Result<(), Vec> { +) -> Result, Vec> { + let mut origin = None::; let mut identities = Vec::::new(); let mut pending = module .declarations .iter() - .map(|declaration| &declaration.value) + .enumerate() + .map(|(owner, declaration)| (owner, &declaration.value)) .collect::>(); - while let Some(expression) = pending.pop() { + while let Some((owner, expression)) = pending.pop() { match &expression.kind { ExprKind::IntrinsicCall { intrinsic, arguments, } => { if intrinsic.descriptor().category == psrs_hir::IntrinsicCategory::Control { + if matches!( + intrinsic, + Intrinsic::ControlRun | Intrinsic::ControlOnce | Intrinsic::ControlCancel + ) { + origin = Some(origin.map_or(owner, |previous| previous.min(owner))); + } let proof = psrs_core::checked_control_contract( module, *intrinsic, @@ -85,50 +93,56 @@ pub(super) fn append( table.control_contracts.push(contract); } } - pending.extend(arguments); + pending.extend(arguments.iter().map(|value| (owner, value))); } ExprKind::Constructor { arguments, .. } | ExprKind::Array { elements: arguments, - } => pending.extend(arguments), - ExprKind::Record { fields } => pending.extend(fields.iter().map(|(_, value)| value)), + } => pending.extend(arguments.iter().map(|value| (owner, value))), + ExprKind::Record { fields } => { + pending.extend(fields.iter().map(|(_, value)| (owner, value))) + } ExprKind::RecordUpdate { record, fields } => { - pending.push(record); - pending.extend(fields.iter().map(|(_, value)| value)); + pending.push((owner, record)); + pending.extend(fields.iter().map(|(_, value)| (owner, value))); } - ExprKind::FieldAccess { record, .. } => pending.push(record), - ExprKind::RepresentationCast { value, .. } => pending.push(value), + ExprKind::FieldAccess { record, .. } => pending.push((owner, record)), + ExprKind::RepresentationCast { value, .. } => pending.push((owner, value)), ExprKind::Application(left, right) => { - pending.push(left); - pending.push(right); + pending.push((owner, left)); + pending.push((owner, right)); } - ExprKind::Lambda { body, .. } => pending.push(body), + ExprKind::Lambda { body, .. } => pending.push((owner, body)), ExprKind::Let { bindings, body } => { - pending.extend(bindings.iter().map(|binding| &binding.value)); - pending.push(body); + pending.extend(bindings.iter().map(|binding| (owner, &binding.value))); + pending.push((owner, body)); } ExprKind::If { condition, then_branch, else_branch, } => { - pending.extend([ - condition.as_ref(), - then_branch.as_ref(), - else_branch.as_ref(), - ]); + pending.extend( + [ + condition.as_ref(), + then_branch.as_ref(), + else_branch.as_ref(), + ] + .into_iter() + .map(|value| (owner, value)), + ); } ExprKind::Case { scrutinee, branches, } => { - pending.push(scrutinee); - pending.extend(branches.iter().map(|branch| &branch.value)); + pending.push((owner, scrutinee)); + pending.extend(branches.iter().map(|branch| (owner, &branch.value))); } _ => {} } } - Ok(()) + Ok(origin.map(|index| module.declarations[index].symbol.module)) } pub(in crate::cc) fn lookup( @@ -249,16 +263,19 @@ fn implementation(layout: ControlLayout, operation: Intrinsic) -> ControlImpleme ControlRun => { return ControlImplementation::Call { signature: layout.executor, + role: crate::cc::ControlHelperRole::Executor, }; } ControlOnce => { return ControlImplementation::Call { signature: layout.once, + role: crate::cc::ControlHelperRole::Once, }; } ControlCancel => { return ControlImplementation::Call { signature: layout.cancel, + role: crate::cc::ControlHelperRole::Cancel, }; } _ => unreachable!("checked control operation"), diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index c2458fdc..fbeca7e5 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -311,9 +311,10 @@ pub(super) fn type_layout( let uses_control = module.types.iter().any(|ty| matches!(ty, Type::Constructor(TypeConstructor::User(id)) if *id == HirTypeId::CONTROL || *id == HirTypeId::RESUMPTION)); let control_layout = uses_control.then(|| control::append(&mut representations, function_slot)); - if let Some(control) = control_layout { - control_contracts::append(module, &mut representations, control)?; - } + let control_owner = match control_layout { + Some(control) => control_contracts::append(module, &mut representations, control)?, + None => None, + }; Ok(TypeLayout { function_slot, protocols, @@ -325,6 +326,7 @@ pub(super) fn type_layout( boxed_number_type, function_types, control_layout, + control_owner, }) } @@ -341,6 +343,8 @@ pub(super) struct TypeLayout { pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, pub(super) function_types: HashMap, + /// Source module of the first declaration that emits machine helpers. + pub(super) control_owner: Option, /// The shared frame representation for `Control f a` values. pub(super) control_layout: Option, } diff --git a/crates/psrs-backend/src/cc/lower/call/application.rs b/crates/psrs-backend/src/cc/lower/call/application.rs index f4b2e7a1..0f3356e5 100644 --- a/crates/psrs-backend/src/cc/lower/call/application.rs +++ b/crates/psrs-backend/src/cc/lower/call/application.rs @@ -121,6 +121,7 @@ impl ApplicationLowering for FunctionLowerer<'_> { assignments.push(Assignment { destination: call_result, kind: AssignmentKind::DirectCall { + contract: None, function, arguments: values, }, diff --git a/crates/psrs-backend/src/cc/lower/call/partial/global.rs b/crates/psrs-backend/src/cc/lower/call/partial/global.rs index 285cb515..d260cb1c 100644 --- a/crates/psrs-backend/src/cc/lower/call/partial/global.rs +++ b/crates/psrs-backend/src/cc/lower/call/partial/global.rs @@ -179,6 +179,7 @@ impl FunctionLowerer<'_> { nested_assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function, arguments: call_arguments, }, diff --git a/crates/psrs-backend/src/cc/lower/control/fields.rs b/crates/psrs-backend/src/cc/lower/control/fields.rs index fea3e120..af761500 100644 --- a/crates/psrs-backend/src/cc/lower/control/fields.rs +++ b/crates/psrs-backend/src/cc/lower/control/fields.rs @@ -121,6 +121,15 @@ impl FunctionLowerer<'_> { span: TextRange, assignments: &mut Vec, ) -> Result> { + let contract = self + .representations + .control_helpers + .iter() + .position(|helper| helper.function() == function) + .map(|index| crate::cc::ControlHelperId(index as u32)) + .ok_or_else(|| { + control_error(span, "control call has no predeclared semantic helper") + })?; let signature = self .representations .signature(signature) @@ -131,6 +140,7 @@ impl FunctionLowerer<'_> { assignments.push(Assignment { destination, kind: AssignmentKind::DirectCall { + contract: Some(contract), function, arguments, }, diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 4ec5ea9a..617cbc88 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -20,6 +20,7 @@ use builder::Machine; #[derive(Clone, Copy)] pub(in crate::cc) struct ControlFunctions { + emitted: bool, executor: SymbolId, resume: SymbolId, clone_sequence: SymbolId, @@ -32,24 +33,32 @@ pub(in crate::cc) struct ControlFunctions { } impl ControlFunctions { - fn signatures(self, layout: ControlLayout) -> [(SymbolId, SignatureId); 8] { + fn contracts( + self, + layout: ControlLayout, + ) -> [(SymbolId, SignatureId, crate::cc::ControlHelperRole); 8] { + use crate::cc::ControlHelperRole::*; [ - (self.executor, layout.executor), - (self.clone_sequence, layout.clone_sequence), - (self.rebuild_sequence, layout.rebuild_sequence), - (self.start, layout.start), - (self.check, layout.boundary_check), - (self.close, layout.boundary_check), - (self.once, layout.once), - (self.cancel, layout.cancel), + (self.executor, layout.executor, Executor), + (self.clone_sequence, layout.clone_sequence, CloneSequence), + ( + self.rebuild_sequence, + layout.rebuild_sequence, + RebuildSequence, + ), + (self.start, layout.start, Start), + (self.check, layout.boundary_check, Check), + (self.close, layout.boundary_check, Close), + (self.once, layout.once, Once), + (self.cancel, layout.cancel, Cancel), ] } fn signature(self, layout: ControlLayout, function: SymbolId) -> SignatureId { - self.signatures(layout) + self.contracts(layout) .into_iter() - .find(|(symbol, _)| *symbol == function) - .map(|(_, signature)| signature) + .find(|(symbol, _, _)| *symbol == function) + .map(|(_, signature, _)| signature) .expect("predeclared control function") } } @@ -266,24 +275,14 @@ impl FunctionLowerer<'_> { layout: ControlLayout, span: TextRange, ) -> Result> { - if let Some(functions) = *self.control_functions.borrow() { + let functions = self + .control_functions + .borrow() + .ok_or_else(|| control_error(span, "control helpers were not predeclared"))?; + if functions.emitted { return Ok(functions); } - let functions = { - let mut symbols = self.generated_symbols.borrow_mut(); - ControlFunctions { - executor: symbols.fresh(self.owner), - resume: symbols.fresh(self.owner), - clone_sequence: symbols.fresh(self.owner), - rebuild_sequence: symbols.fresh(self.owner), - start: symbols.fresh(self.owner), - check: symbols.fresh(self.owner), - close: symbols.fresh(self.owner), - once: symbols.fresh(self.owner), - cancel: symbols.fresh(self.owner), - } - }; - for (symbol, id) in functions.signatures(layout) { + for (symbol, id, _) in functions.contracts(layout) { let signature = self .representations .signature(id) @@ -345,7 +344,10 @@ impl FunctionLowerer<'_> { self.verify_synthesized(&function)?; self.generated.push(function); } - *self.control_functions.borrow_mut() = Some(functions); + *self.control_functions.borrow_mut() = Some(ControlFunctions { + emitted: true, + ..functions + }); Ok(functions) } } @@ -357,3 +359,35 @@ fn control_error(span: TextRange, message: &'static str) -> Vec { message, )] } + +pub(in crate::cc) fn plan_control_helpers( + layout: &mut crate::cc::layout::TypeLayout, + allocator: &std::rc::Rc>, +) -> Option { + let control = layout.control_layout?; + let mut allocator = allocator.borrow_mut(); + let owner = layout.control_owner?; + let functions = ControlFunctions { + emitted: false, + executor: allocator.fresh(owner), + resume: allocator.fresh(owner), + clone_sequence: allocator.fresh(owner), + rebuild_sequence: allocator.fresh(owner), + start: allocator.fresh(owner), + check: allocator.fresh(owner), + close: allocator.fresh(owner), + once: allocator.fresh(owner), + cancel: allocator.fresh(owner), + }; + for (function, signature, role) in functions.contracts(control) { + layout + .representations + .control_helpers + .push(crate::cc::ControlHelperContract { + role, + function, + signature, + }); + } + Some(functions) +} diff --git a/crates/psrs-backend/src/cc/lower/global.rs b/crates/psrs-backend/src/cc/lower/global.rs index 1b2ea5b1..07a67795 100644 --- a/crates/psrs-backend/src/cc/lower/global.rs +++ b/crates/psrs-backend/src/cc/lower/global.rs @@ -131,6 +131,7 @@ impl GlobalLowering for FunctionLowerer<'_> { assignments.push(Assignment { destination, kind: AssignmentKind::DirectCall { + contract: None, function, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/cc/lower/lambda/wrapper.rs b/crates/psrs-backend/src/cc/lower/lambda/wrapper.rs index be714e46..a207d979 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/wrapper.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/wrapper.rs @@ -45,6 +45,7 @@ pub(in crate::cc::lower) fn make_wrapper( assignments: vec![Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function: source.symbol, arguments, }, @@ -114,6 +115,7 @@ fn eta_expanded_wrapper( let mut assignments = vec![Assignment { destination: intermediate, kind: AssignmentKind::DirectCall { + contract: None, function: source.symbol, arguments: first_parameters, }, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 5e73b500..9a2c260d 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -27,6 +27,7 @@ mod record; mod string_bytes; mod symbols; use call::ApplicationLowering; +pub(super) use control::plan_control_helpers; pub(in crate::cc) use conversion::VariantFieldConversion; use global::GlobalLowering; use lambda::LambdaLowering; diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 9312e227..8b04720f 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -9,10 +9,12 @@ use std::rc::Rc; mod case; mod control_contract; +mod control_helpers; pub use control_contract::{ ControlContract, ControlContractId, ControlDomain, SourceTypeIdentityId, TypeConstructorIdentity, TypeIdentity, }; +pub use control_helpers::{ControlHelperContract, ControlHelperId, ControlHelperRole}; mod convert; mod layout; mod lower; @@ -109,6 +111,8 @@ pub enum AssignmentKind { value: ValueId, }, DirectCall { + /// Required for predeclared machine helpers; absent for ordinary calls. + contract: Option, function: SymbolId, arguments: Vec, }, @@ -320,7 +324,7 @@ pub(crate) fn lower_module_with_relations( // so this slice needs no `scalar_type` change. aggregate_types.insert(HirTypeId::CONTROL); aggregate_types.insert(HirTypeId::RESUMPTION); - let layout = type_layout(&module, &enum_types, &aggregate_types, &newtype_ids)?; + let mut layout = type_layout(&module, &enum_types, &aggregate_types, &newtype_ids)?; let mut constructor_tags = HashMap::new(); let mut constructors_by_type: HashMap> = HashMap::new(); for constructor in &module.constructors { @@ -432,6 +436,7 @@ pub(crate) fn lower_module_with_relations( (declaration.symbol, wrapper) }) .collect::>(); + let control_functions = lower::plan_control_helpers(&mut layout, &generated_symbols); let boundary = BoundaryEvidence::new( relations, &module, @@ -450,7 +455,7 @@ pub(crate) fn lower_module_with_relations( boxed_integer_type: layout.boxed_integer_type, boxed_number_type: layout.boxed_number_type, control_layout: layout.control_layout, - control_functions: Rc::new(RefCell::new(None)), + control_functions: Rc::new(RefCell::new(control_functions)), array_types: &layout.array_types, record_types: &layout.record_types, constructor_tags: &constructor_tags, diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index c5f984d5..b32fe2a1 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -225,6 +225,8 @@ fn storage_case( #[derive(Clone, Debug, PartialEq, Eq, Default)] pub struct RepresentationTable { + /// Semantic helper bindings are fixed before any function body is lowered. + pub control_helpers: Vec, /// Source control contracts are predeclared by layout, before lowering /// emits any factory or executor bodies. pub control_contracts: Vec, diff --git a/crates/psrs-backend/src/cc/verify/ops/control.rs b/crates/psrs-backend/src/cc/verify/ops/control.rs index c99768ea..9bac7d46 100644 --- a/crates/psrs-backend/src/cc/verify/ops/control.rs +++ b/crates/psrs-backend/src/cc/verify/ops/control.rs @@ -73,12 +73,20 @@ pub(super) fn verify( }, ) if representation == actual && case == tag => fields, ( - ControlImplementation::Call { signature }, + ControlImplementation::Call { signature, role }, AssignmentKind::DirectCall { function, arguments, + contract: Some(contract), }, - ) if signatures.get(function) == table.signature(*signature) => arguments, + ) if signatures.get(function) == table.signature(*signature) + && table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == *role) => + { + arguments + } _ => { return Err(assignment_error( assignment, diff --git a/crates/psrs-backend/src/cc/verify/ops/mod.rs b/crates/psrs-backend/src/cc/verify/ops/mod.rs index b4fe7a42..1ae4dfae 100644 --- a/crates/psrs-backend/src/cc/verify/ops/mod.rs +++ b/crates/psrs-backend/src/cc/verify/ops/mod.rs @@ -129,9 +129,13 @@ pub(super) fn verify_assignments( uses.push(*value); } AssignmentKind::DirectCall { + contract, function, arguments, } => { + table + .verify_control_call(*function, *contract) + .map_err(|message| assignment_error(assignment, message))?; let Some(signature) = signatures.get(function) else { return Err(assignment_error( assignment, diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index c5a419b8..c25a11a4 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -8,6 +8,19 @@ pub(crate) fn verify_table( table: &RepresentationTable, span: TextRange, ) -> Result<(), Vec> { + let mut roles = HashSet::new(); + let mut helpers = HashSet::new(); + for helper in &table.control_helpers { + if !roles.insert(helper.role()) + || !helpers.insert(helper.function()) + || table.signature(helper.signature()).is_none() + { + return Err(table_error( + span, + "control helper contract has a duplicate identity or missing signature", + )); + } + } for proof in &table.control_contracts { if proof.argument_identities().len() != proof.arguments().len() || std::iter::once(&proof.result_identity()) diff --git a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs index 1f56c68b..fb108b2a 100644 --- a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs +++ b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs @@ -43,6 +43,7 @@ fn call_fixture(signature: &Signature) -> Function { assignments: vec![Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function: symbol(1), arguments: parameters, }, diff --git a/crates/psrs-backend/src/cc/verify/tests/effects.rs b/crates/psrs-backend/src/cc/verify/tests/effects.rs index 0b77acc5..d1cb02f0 100644 --- a/crates/psrs-backend/src/cc/verify/tests/effects.rs +++ b/crates/psrs-backend/src/cc/verify/tests/effects.rs @@ -241,6 +241,7 @@ fn rejects_a_direct_call_to_an_unbound_runner_external() { assignments: vec![Assignment { destination, kind: AssignmentKind::DirectCall { + contract: None, function: runner, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/cc/verify/tests/mod.rs b/crates/psrs-backend/src/cc/verify/tests/mod.rs index 55efe7c2..4b4ae9a9 100644 --- a/crates/psrs-backend/src/cc/verify/tests/mod.rs +++ b/crates/psrs-backend/src/cc/verify/tests/mod.rs @@ -52,6 +52,7 @@ fn rejects_a_direct_call_with_the_wrong_result_shape() { assignments: vec![Assignment { destination, kind: AssignmentKind::DirectCall { + contract: None, function: callee, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/cc/verify/tests/structure.rs b/crates/psrs-backend/src/cc/verify/tests/structure.rs index fea45333..5b509f49 100644 --- a/crates/psrs-backend/src/cc/verify/tests/structure.rs +++ b/crates/psrs-backend/src/cc/verify/tests/structure.rs @@ -141,6 +141,7 @@ fn rejects_a_direct_call_with_the_wrong_arity() { assignments: vec![Assignment { destination, kind: AssignmentKind::DirectCall { + contract: None, function: callee, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/linking/runtime_tests.rs b/crates/psrs-backend/src/linking/runtime_tests.rs index 59d70f21..138b2c9b 100644 --- a/crates/psrs-backend/src/linking/runtime_tests.rs +++ b/crates/psrs-backend/src/linking/runtime_tests.rs @@ -100,6 +100,7 @@ fn fixture() -> mir::Module { span, }, I::Call { + contract: None, destination: value(3), function: symbol(11), arguments: vec![value(0), value(11)], @@ -141,6 +142,7 @@ fn fixture() -> mir::Module { span, }, I::Call { + contract: None, destination: value(8), function: symbol(13), arguments: vec![value(7), value(4)], diff --git a/crates/psrs-backend/src/mir/binding_tests.rs b/crates/psrs-backend/src/mir/binding_tests.rs index 55202091..99ac7061 100644 --- a/crates/psrs-backend/src/mir/binding_tests.rs +++ b/crates/psrs-backend/src/mir/binding_tests.rs @@ -14,6 +14,7 @@ fn input(call: bool) -> (cc::Module, ExternalBindings) { Assignment { destination: crate::types::ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external, arguments: Vec::new(), }, @@ -145,6 +146,7 @@ fn p9_exposes_an_owned_handle_without_dropping_it() { Assignment { destination: crate::types::ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/control_contracts.rs b/crates/psrs-backend/src/mir/control_contracts.rs index 810aed2a..e3c9a36c 100644 --- a/crates/psrs-backend/src/mir/control_contracts.rs +++ b/crates/psrs-backend/src/mir/control_contracts.rs @@ -2,6 +2,12 @@ use super::{Instruction, Module}; use crate::BackendError; impl Module { + pub fn control_helpers(&self) -> &[crate::cc::ControlHelperContract] { + self.layout + .as_ref() + .map_or(&[], |layout| &layout.representation_table().control_helpers) + } + /// Source contracts remain immutable and inspectable after physical layout. pub fn control_contracts(&self) -> &[crate::cc::ControlContract] { self.layout.as_ref().map_or(&[], |layout| { @@ -12,6 +18,15 @@ impl Module { pub(super) fn verify(module: &Module, errors: &mut Vec) { for function in &module.functions { + if let Err(mut failures) = verify_helper_calls( + function, + module + .layout + .as_ref() + .map(|layout| layout.representation_table()), + ) { + errors.append(&mut failures); + } for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { let Instruction::ControlEvidence { arguments, @@ -73,3 +88,53 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { } } } + +pub(super) fn verify_helper_calls( + function: &super::Function, + table: Option<&crate::cc::RepresentationTable>, +) -> Result<(), Vec> { + for block in &function.blocks { + let calls = block + .instructions + .iter() + .filter_map(|instruction| match instruction { + Instruction::Call { + function, + contract, + span, + .. + } => Some((*function, *contract, *span)), + _ => None, + }) + .chain( + block + .terminator + .iter() + .filter_map(|terminator| match terminator { + super::Terminator::ReturnCall { + function, + contract, + span, + .. + } => Some((*function, *contract, *span)), + _ => None, + }), + ); + for (callee, contract, span) in calls { + let check = match table { + Some(table) => table.verify_control_call(callee, contract), + None if contract.is_some() => { + Err("control call has no predeclared helper contract") + } + None => Ok(()), + }; + check.map_err(|message| { + vec![ + BackendError::invalid_ir("P9 MIR control verification", span, message) + .with_module(function.symbol.module), + ] + })?; + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/gc_tests/erased.rs b/crates/psrs-backend/src/mir/gc_tests/erased.rs index 27bd4c0d..d9870c43 100644 --- a/crates/psrs-backend/src/mir/gc_tests/erased.rs +++ b/crates/psrs-backend/src/mir/gc_tests/erased.rs @@ -87,6 +87,7 @@ fn executes_erased_identity_for_scalars_and_concrete_references_on_both_targets( let call_identity = |destination, value| Assignment { destination: ValueId(destination), kind: AssignmentKind::DirectCall { + contract: None, function: identity_symbol, arguments: vec![ValueId(value)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs index 019e65ec..6b9b1887 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs @@ -46,6 +46,7 @@ fn base( Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs index 18bf5d2e..4f46a56e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/erased_storage.rs @@ -81,6 +81,7 @@ fn roundtrip(array: bool, include_protocol: bool) -> (cc::Module, ExternalBindin main.assignments.push(Assignment { destination: ValueId(3), kind: AssignmentKind::DirectCall { + contract: None, function: take, arguments: vec![ValueId(0)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs index f2ae41c1..8195683a 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs @@ -96,6 +96,7 @@ pub(super) fn fixture_with_representations( Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -240,6 +241,7 @@ pub(super) fn parameter_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(3), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(2)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs index fab37122..59e43cb1 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs @@ -131,6 +131,7 @@ pub(super) fn indirect_aggregate_fixture() -> (cc::Module, ExternalBindings, Res assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments, }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs index 484fbf9a..aa80b4f2 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs @@ -73,6 +73,7 @@ pub(super) fn large_record_fixture() -> (cc::Module, ExternalBindings, Resolve) Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -198,6 +199,7 @@ pub(super) fn large_unit_result_fixture() -> (cc::Module, ExternalBindings, Reso Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs index 0dee7b6c..4f9d922c 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs @@ -67,6 +67,7 @@ fn finish( Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs index 6e9fe201..4f582639 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs @@ -80,6 +80,7 @@ pub(super) fn nested_variant_fixture() -> (cc::Module, ExternalBindings, Resolve Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -188,6 +189,7 @@ pub(super) fn nested_record_fixture() -> (cc::Module, ExternalBindings, Resolve) Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -354,6 +356,7 @@ pub(super) fn nested_record_parameter_fixture() -> (cc::Module, ExternalBindings Assignment { destination: ValueId(5), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(4)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs index 1b5e7976..d28533c5 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs @@ -88,6 +88,7 @@ pub(super) fn record_with_aggregate_field_fixture() -> (cc::Module, ExternalBind Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -319,6 +320,7 @@ pub(super) fn record_with_aggregate_field_parameter_fixture() Assignment { destination: ValueId(7), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(6)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs index 89327b67..d0a41793 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs @@ -61,6 +61,7 @@ pub(super) fn resource_result_fixture() -> (cc::Module, ExternalBindings, Resolv Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs index 85179549..ff7402e0 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs @@ -72,6 +72,7 @@ pub(super) fn wide_scalar_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -217,6 +218,7 @@ pub(super) fn wide_scalar_parameter_fixture() -> (cc::Module, ExternalBindings, Assignment { destination: ValueId(3), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(2)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs index 3a5ecc73..75c5c4db 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs @@ -214,6 +214,7 @@ pub(super) fn composite_indirect_fixture() -> (cc::Module, ExternalBindings, Res assignments.push(Assignment { destination: call_result, kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: call_arguments, }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/mod.rs index 1b0dc60c..ccf2f72b 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/mod.rs @@ -58,6 +58,7 @@ fn indirect_fixture() -> (cc::Module, ExternalBindings, Resolve) { assignments.push(Assignment { destination: call_result, kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments, }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs index cb3ad920..0525f625 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs @@ -88,6 +88,7 @@ pub(crate) fn flags_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(4), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(3)], }, @@ -185,6 +186,7 @@ pub(crate) fn handle_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(2), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(1)], }, @@ -312,6 +314,7 @@ pub(crate) fn tuple_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(4), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(3)], }, @@ -414,6 +417,7 @@ fn handle_result(result: &str) -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs index 0634257e..06aa6ce3 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs @@ -71,6 +71,7 @@ pub(crate) fn fixed_list_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(4), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(3)], }, @@ -169,6 +170,7 @@ pub(crate) fn fixed_list_result_fixture() -> (cc::Module, ExternalBindings, Reso Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs index f14bc681..09ae1668 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs @@ -112,6 +112,7 @@ pub(super) fn fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(4), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(3)], }, @@ -213,6 +214,7 @@ pub(super) fn result_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -329,6 +331,7 @@ pub(super) fn string_fixture() -> (cc::Module, ExternalBindings, Resolve) { Assignment { destination: ValueId(4), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(3)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs index 6817d3a7..a32addd8 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs @@ -115,6 +115,7 @@ fn parameter_fixture( assignments.push(Assignment { destination: ValueId(4), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(3)], }, @@ -303,6 +304,7 @@ pub(crate) fn option_string_list_result_fixture() -> (cc::Module, ExternalBindin Assignment { destination: ValueId(0), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: Vec::new(), }, @@ -419,6 +421,7 @@ pub(crate) fn option_list_list_fixture() -> (cc::Module, ExternalBindings, Resol Assignment { destination: ValueId(5), kind: AssignmentKind::DirectCall { + contract: None, function: external_symbol, arguments: vec![ValueId(4)], }, diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs index 1d7e2253..236ae041 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs @@ -97,6 +97,7 @@ pub(crate) fn wide_flags_list_fixture() -> (cc::Module, ExternalBindings, Resolv assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function: SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE), arguments: vec![array], }, @@ -194,6 +195,7 @@ pub(crate) fn wide_flags_record_fixture() -> (cc::Module, ExternalBindings, Reso assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function: SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE), arguments: vec![array], }, @@ -309,6 +311,7 @@ pub(crate) fn wide_flags_variant_fixture() -> (cc::Module, ExternalBindings, Res assignments.push(Assignment { destination: result, kind: AssignmentKind::DirectCall { + contract: None, function: SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE), arguments: vec![array], }, diff --git a/crates/psrs-backend/src/mir/instruction/mod.rs b/crates/psrs-backend/src/mir/instruction/mod.rs index 0d6ca06f..f0b372c6 100644 --- a/crates/psrs-backend/src/mir/instruction/mod.rs +++ b/crates/psrs-backend/src/mir/instruction/mod.rs @@ -65,6 +65,8 @@ pub enum Instruction { span: TextRange, }, Call { + /// Retained until a checked call conversion discharges its callee binding. + contract: Option, destination: ValueId, function: SymbolId, arguments: Vec, diff --git a/crates/psrs-backend/src/mir/lower/aggregate/mod.rs b/crates/psrs-backend/src/mir/lower/aggregate/mod.rs index 918f313d..1dffb401 100644 --- a/crates/psrs-backend/src/mir/lower/aggregate/mod.rs +++ b/crates/psrs-backend/src/mir/lower/aggregate/mod.rs @@ -169,6 +169,7 @@ impl FunctionLowerer<'_> { self.append_instruction( block, Instruction::Call { + contract: None, destination: result, function: *function, arguments: vec![value], diff --git a/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs b/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs index af5a534c..516d7aca 100644 --- a/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs +++ b/crates/psrs-backend/src/mir/lower/assignment_string/mod.rs @@ -158,6 +158,7 @@ impl FunctionLowerer<'_> { self.append_instruction( current, Instruction::Call { + contract: None, destination: buffer, function: crate::abi::REALLOC_SYMBOL, arguments: vec![zero, zero, align, capacity], @@ -196,6 +197,7 @@ impl FunctionLowerer<'_> { self.append_instruction( current, Instruction::Call { + contract: None, destination: string, function: crate::abi::BYTES_TO_STRING_SYMBOL, arguments: vec![buffer, length], @@ -209,6 +211,7 @@ impl FunctionLowerer<'_> { self.append_instruction( current, Instruction::Call { + contract: None, destination: discarded, function: crate::abi::REALLOC_SYMBOL, arguments: vec![buffer, capacity, align, free_size], diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 9d85a356..22ad299c 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -57,6 +57,7 @@ impl FunctionLowerer<'_> { self.append_instruction( current, Instruction::Call { + contract: None, destination: assignment.destination, function: helper, arguments: vec![*value], @@ -254,9 +255,20 @@ impl FunctionLowerer<'_> { current = self.lower_array_assignment(current, assignment)?; } AssignmentKind::DirectCall { + contract, function, arguments, } => { + self.layout + .representation_table() + .verify_control_call(*function, *contract) + .map_err(|message| { + vec![BackendError::invalid_ir( + "P9 MIR lowering", + assignment.span, + message, + )] + })?; if let Some(import) = self.wit_imports.get(function).cloned() { current = self.lower_wit_call(&import, assignment, current)?; } else if let Some(import) = self.runtime_imports.get(function).cloned() { @@ -271,6 +283,7 @@ impl FunctionLowerer<'_> { self.append_instruction( current, Instruction::Call { + contract: *contract, destination: assignment.destination, function: *function, arguments: arguments.clone(), diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index f47d611c..65e4cb55 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -114,6 +114,7 @@ pub(super) fn lower_function( for plan in &lowerer.wit_calls { plan.verify(&function)?; } + super::control_contracts::verify_helper_calls(&function, Some(layout.representation_table()))?; tail::mark_tail(&mut function, target)?; wit::verify_function(&function, wit_imports)?; Ok(function) diff --git a/crates/psrs-backend/src/mir/lower/runtime_call.rs b/crates/psrs-backend/src/mir/lower/runtime_call.rs index 6ece156b..0212c03d 100644 --- a/crates/psrs-backend/src/mir/lower/runtime_call.rs +++ b/crates/psrs-backend/src/mir/lower/runtime_call.rs @@ -58,6 +58,7 @@ impl FunctionLowerer<'_> { self.append_instruction( block, Instruction::Call { + contract: None, destination: buffer, function: crate::abi::REALLOC_SYMBOL, arguments: vec![zero, zero, align, capacity], @@ -72,6 +73,7 @@ impl FunctionLowerer<'_> { self.append_instruction( block, Instruction::Call { + contract: None, destination, function: crate::abi::BYTES_TO_STRING_SYMBOL, arguments: vec![buffer, length], @@ -96,6 +98,7 @@ impl FunctionLowerer<'_> { self.append_instruction( block, Instruction::Call { + contract: None, destination, function: provider.symbol, arguments, diff --git a/crates/psrs-backend/src/mir/lower/storage_call.rs b/crates/psrs-backend/src/mir/lower/storage_call.rs index aa3f6812..50dea0b5 100644 --- a/crates/psrs-backend/src/mir/lower/storage_call.rs +++ b/crates/psrs-backend/src/mir/lower/storage_call.rs @@ -66,6 +66,7 @@ impl FunctionLowerer<'_> { self.append_instruction( block, Instruction::Call { + contract: None, destination: raw, function: import.symbol, arguments: raw_arguments, diff --git a/crates/psrs-backend/src/mir/lower/tail.rs b/crates/psrs-backend/src/mir/lower/tail.rs index 19f178b9..976a9d0d 100644 --- a/crates/psrs-backend/src/mir/lower/tail.rs +++ b/crates/psrs-backend/src/mir/lower/tail.rs @@ -63,13 +63,14 @@ pub(in crate::mir) fn rewrite( self_calls.push((block.id, arguments.clone(), *span)); } Instruction::Call { + contract, function: callee, arguments, span, .. } => non_self.push(( block.id, - NonSelfCall::Direct(*callee), + NonSelfCall::Direct(*callee, *contract), arguments.clone(), *span, )), @@ -106,7 +107,8 @@ pub(in crate::mir) fn rewrite( if target.tail_call { for (block_id, call, arguments, span) in non_self { let terminator = match call { - NonSelfCall::Direct(callee) => Terminator::ReturnCall { + NonSelfCall::Direct(callee, contract) => Terminator::ReturnCall { + contract, function: callee, arguments, span, @@ -129,7 +131,7 @@ pub(in crate::mir) fn rewrite( } enum NonSelfCall { - Direct(psrs_hir::SymbolId), + Direct(psrs_hir::SymbolId, Option), Reference(ValueId), } diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index e442b330..e94e036f 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -148,6 +148,7 @@ pub enum Terminator { /// A direct tail call. The arguments are evaluated and control transfers to /// `function`, whose result becomes this function's result. ReturnCall { + contract: Option, function: SymbolId, arguments: Vec, span: TextRange, diff --git a/crates/psrs-backend/src/mir/number_format_tests.rs b/crates/psrs-backend/src/mir/number_format_tests.rs index 04604f75..5a4df6f1 100644 --- a/crates/psrs-backend/src/mir/number_format_tests.rs +++ b/crates/psrs-backend/src/mir/number_format_tests.rs @@ -93,12 +93,14 @@ fn number_format_module() -> Module { span: span(), }, Instruction::Call { + contract: None, destination: ValueId(2), function: crate::abi::REALLOC_SYMBOL, arguments: vec![ValueId(3), ValueId(3), ValueId(4), ValueId(5)], span: span(), }, Instruction::Call { + contract: None, destination: ValueId(0), function: crate::abi::NUMBER_TO_STRING_SYMBOL, arguments: vec![ValueId(1), ValueId(2), ValueId(5)], diff --git a/crates/psrs-backend/src/mir/opt/tests/inline.rs b/crates/psrs-backend/src/mir/opt/tests/inline.rs index 4497356c..702dcc9b 100644 --- a/crates/psrs-backend/src/mir/opt/tests/inline.rs +++ b/crates/psrs-backend/src/mir/opt/tests/inline.rs @@ -21,6 +21,7 @@ fn inlines_small_direct_functions_and_folds_the_result() { span: span(), }, Instruction::Call { + contract: None, destination: ValueId(1), function: callee_symbol, arguments: vec![ValueId(0)], @@ -116,6 +117,7 @@ fn inlining_uses_the_callee_function_result_value() { id: BlockId(0), parameters: Vec::new(), instructions: vec![Instruction::Call { + contract: None, destination: ValueId(0), function: callee_symbol, arguments: Vec::new(), diff --git a/crates/psrs-backend/src/mir/tests/lowering.rs b/crates/psrs-backend/src/mir/tests/lowering.rs index b51f83a0..e2bc5172 100644 --- a/crates/psrs-backend/src/mir/tests/lowering.rs +++ b/crates/psrs-backend/src/mir/tests/lowering.rs @@ -181,6 +181,7 @@ fn lowers_an_imported_call() { id: BlockId(0), parameters: Vec::new(), instructions: vec![Instruction::Call { + contract: None, destination: ValueId(0), function: callee, arguments: Vec::new(), diff --git a/crates/psrs-backend/src/mir/verify/capability.rs b/crates/psrs-backend/src/mir/verify/capability.rs index e48c3602..af2ef46a 100644 --- a/crates/psrs-backend/src/mir/verify/capability.rs +++ b/crates/psrs-backend/src/mir/verify/capability.rs @@ -469,6 +469,7 @@ mod tests { parameters: Vec::new(), instructions: Vec::new(), terminator: Some(mir::Terminator::ReturnCall { + contract: None, function: SymbolId::new(ModuleId(4), 1), arguments: Vec::new(), span, diff --git a/crates/psrs-backend/src/mir/verify/function.rs b/crates/psrs-backend/src/mir/verify/function.rs index aceac04b..96a38696 100644 --- a/crates/psrs-backend/src/mir/verify/function.rs +++ b/crates/psrs-backend/src/mir/verify/function.rs @@ -392,6 +392,7 @@ fn verify_terminator( function: callee, arguments, span, + .. } => { super::call::tail::verify_return_call( function, diff --git a/crates/psrs-backend/src/mir/verify/instruction/mod.rs b/crates/psrs-backend/src/mir/verify/instruction/mod.rs index eb5cae33..e3becc58 100644 --- a/crates/psrs-backend/src/mir/verify/instruction/mod.rs +++ b/crates/psrs-backend/src/mir/verify/instruction/mod.rs @@ -55,6 +55,7 @@ pub(super) fn verify_instruction( function: callee, arguments, span, + .. } => { let Some(Some(signature)) = signatures.get(callee) else { return Err(mir_error(*span, "MIR call target has no valid signature")); diff --git a/crates/psrs-backend/src/mir/verify/tests/dictionary.rs b/crates/psrs-backend/src/mir/verify/tests/dictionary.rs index a9560262..72f8bcc9 100644 --- a/crates/psrs-backend/src/mir/verify/tests/dictionary.rs +++ b/crates/psrs-backend/src/mir/verify/tests/dictionary.rs @@ -250,6 +250,7 @@ fn rejects_dictionary_method_call_with_wrong_arity() { value(1, ValueType::I32), ], vec![Instruction::Call { + contract: None, destination, function: SymbolId::new(ModuleId(0), 1), arguments: vec![method], diff --git a/crates/psrs-backend/src/mir/verify/tests/scalar.rs b/crates/psrs-backend/src/mir/verify/tests/scalar.rs index 9ad3c180..8ef059a9 100644 --- a/crates/psrs-backend/src/mir/verify/tests/scalar.rs +++ b/crates/psrs-backend/src/mir/verify/tests/scalar.rs @@ -199,6 +199,7 @@ fn rejects_a_call_with_the_wrong_argument_type() { id: BlockId(0), parameters: Vec::new(), instructions: vec![Instruction::Call { + contract: None, destination: call_result, function: callee_symbol, arguments: vec![argument, argument], diff --git a/crates/psrs-backend/src/mir/verify/tests/tail.rs b/crates/psrs-backend/src/mir/verify/tests/tail.rs index 92415d51..432df1d0 100644 --- a/crates/psrs-backend/src/mir/verify/tests/tail.rs +++ b/crates/psrs-backend/src/mir/verify/tests/tail.rs @@ -124,6 +124,7 @@ fn rejects_a_direct_return_call_whose_result_differs_from_its_caller() { Vec::new(), Vec::new(), Terminator::ReturnCall { + contract: None, function: symbol(1), arguments: Vec::new(), span: span(), @@ -159,6 +160,7 @@ fn rejects_a_direct_return_call_with_the_wrong_argument_type() { span: span(), }], Terminator::ReturnCall { + contract: None, function: symbol(1), arguments: vec![ValueId(0)], span: span(), diff --git a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs index a40f1824..8dbf52df 100644 --- a/crates/psrs-backend/src/mir/wit/aggregate/decode.rs +++ b/crates/psrs-backend/src/mir/wit/aggregate/decode.rs @@ -347,6 +347,7 @@ fn read_string( lowerer.append_wit_instruction( block, Instruction::Call { + contract: None, destination: value, function: abi::BYTES_TO_STRING_SYMBOL, arguments: vec![pointer, length], diff --git a/crates/psrs-backend/src/mir/wit/lists/mod.rs b/crates/psrs-backend/src/mir/wit/lists/mod.rs index 7da03e74..36a253ec 100644 --- a/crates/psrs-backend/src/mir/wit/lists/mod.rs +++ b/crates/psrs-backend/src/mir/wit/lists/mod.rs @@ -382,6 +382,7 @@ pub(super) fn allocate( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination: address, function: abi::REALLOC_SYMBOL, arguments, diff --git a/crates/psrs-backend/src/mir/wit/mod.rs b/crates/psrs-backend/src/mir/wit/mod.rs index cafbd180..f36facd7 100644 --- a/crates/psrs-backend/src/mir/wit/mod.rs +++ b/crates/psrs-backend/src/mir/wit/mod.rs @@ -218,6 +218,7 @@ fn lower_concrete( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination, function: crate::abi::BYTES_TO_STRING_SYMBOL, arguments: vec![pointer, length], @@ -270,6 +271,7 @@ fn lower_concrete( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination: value, function: import.symbol, arguments: flat, @@ -292,6 +294,7 @@ fn lower_concrete( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination: value, function: import.symbol, arguments: flat, @@ -313,6 +316,7 @@ fn lower_concrete( Some(ValueType::I32 | ValueType::F64) => lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination, function: import.symbol, arguments: flat, @@ -456,6 +460,7 @@ pub(super) fn free_buffer( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination: discarded, function: abi::REALLOC_SYMBOL, arguments: vec![pointer, length, align_value, zero], diff --git a/crates/psrs-backend/src/mir/wit/parameters/indirect.rs b/crates/psrs-backend/src/mir/wit/parameters/indirect.rs index 61320052..18af49e4 100644 --- a/crates/psrs-backend/src/mir/wit/parameters/indirect.rs +++ b/crates/psrs-backend/src/mir/wit/parameters/indirect.rs @@ -215,6 +215,7 @@ fn allocate_parameter_area( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination: address, function: abi::REALLOC_SYMBOL, arguments, diff --git a/crates/psrs-backend/src/mir/wit/parameters/mod.rs b/crates/psrs-backend/src/mir/wit/parameters/mod.rs index dfb45df4..bd7e66d2 100644 --- a/crates/psrs-backend/src/mir/wit/parameters/mod.rs +++ b/crates/psrs-backend/src/mir/wit/parameters/mod.rs @@ -210,6 +210,7 @@ pub(in crate::mir) fn lower_string( lowerer.append_wit_instruction( current, Instruction::Call { + contract: None, destination: prefix, function: crate::abi::STRING_TO_BYTES_SYMBOL, arguments: vec![argument], diff --git a/crates/psrs-backend/src/mir/wit/tests/handles.rs b/crates/psrs-backend/src/mir/wit/tests/handles.rs index 9d84ba19..bd8e4179 100644 --- a/crates/psrs-backend/src/mir/wit/tests/handles.rs +++ b/crates/psrs-backend/src/mir/wit/tests/handles.rs @@ -158,6 +158,7 @@ fn the_verifier_rejects_an_owned_handle_dropped_twice() { ); let instructions = vec![ Instruction::Call { + contract: None, destination: ValueId(1), function: symbol, arguments: Vec::new(), @@ -195,6 +196,7 @@ fn the_verifier_accepts_an_explicit_drop() { ); let instructions = vec![ Instruction::Call { + contract: None, destination: ValueId(1), function: symbol, arguments: Vec::new(), diff --git a/crates/psrs-backend/src/wasm/lower/structure/instructions.rs b/crates/psrs-backend/src/wasm/lower/structure/instructions.rs index ea7ceb9d..c5116faa 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/instructions.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/instructions.rs @@ -128,6 +128,7 @@ impl Structurer<'_> { function, arguments, span, + .. } => { for argument in arguments { self.load(body, *argument, *span)?; diff --git a/crates/psrs-backend/src/wasm/lower/structure/region.rs b/crates/psrs-backend/src/wasm/lower/structure/region.rs index 0088ed99..cfeb70a6 100644 --- a/crates/psrs-backend/src/wasm/lower/structure/region.rs +++ b/crates/psrs-backend/src/wasm/lower/structure/region.rs @@ -188,6 +188,7 @@ impl Structurer<'_> { function, arguments, span, + .. } => { self.emit_return_call(*function, arguments, *span, body)?; } diff --git a/crates/psrs-driver/src/tests/control_costs/probe.rs b/crates/psrs-driver/src/tests/control_costs/probe.rs index daf48c72..13b45245 100644 --- a/crates/psrs-driver/src/tests/control_costs/probe.rs +++ b/crates/psrs-driver/src/tests/control_costs/probe.rs @@ -127,6 +127,7 @@ fn insert( result.push(Assignment { destination: checked, kind: K::DirectCall { + contract: None, function: checker, arguments: vec![value, budget], }, @@ -190,6 +191,7 @@ fn checker(symbol: SymbolId, boundary: ReprId, extent: ValueShape) -> Function { a( 8, K::DirectCall { + contract: None, function: symbol, arguments: vec![ValueId(5), ValueId(7)], }, diff --git a/crates/psrs-driver/src/tests/control_helper_contracts.rs b/crates/psrs-driver/src/tests/control_helper_contracts.rs new file mode 100644 index 00000000..cc7db13c --- /dev/null +++ b/crates/psrs-driver/src/tests/control_helper_contracts.rs @@ -0,0 +1,284 @@ +//! Same-shaped lifetime helpers must retain their semantic callee identity. +use psrs_backend::cc::{Assignment, AssignmentKind, ControlHelperId, ControlHelperRole}; +use psrs_backend::mir::{Instruction, Terminator}; + +const SOURCE: &str = r"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +main :: Int +main = (C.run 0 handler (C.perform (Op \x -> x)))._2 +"; + +fn visit( + body: &mut [Assignment], + check: ControlHelperId, + replace: &mut impl FnMut(&mut AssignmentKind), +) -> bool { + for assignment in body { + if matches!(assignment.kind, AssignmentKind::DirectCall { contract: Some(id), .. } if id == check) + { + replace(&mut assignment.kind); + return true; + } + if let AssignmentKind::TagSwitch { + cases, + default_assignments, + .. + } = &mut assignment.kind + { + for case in cases { + if visit(&mut case.assignments, check, replace) { + return true; + } + } + if visit(default_assignments, check, replace) { + return true; + } + } + } + false +} + +#[test] +fn cc_rejects_exchanging_check_and_close_despite_equal_signatures() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let check = table + .control_helpers + .iter() + .position(|helper| helper.role() == ControlHelperRole::Check) + .unwrap(); + let close = table + .control_helpers + .iter() + .find(|helper| helper.role() == ControlHelperRole::Close) + .unwrap(); + assert_eq!( + table.signature(table.control_helpers[check].signature()), + table.signature(close.signature()) + ); + let close = close.function(); + assert!(input.cc.functions.iter_mut().any(|function| visit( + &mut function.assignments, + ControlHelperId(check as u32), + &mut |kind| { + let AssignmentKind::DirectCall { function, .. } = kind else { + unreachable!() + }; + *function = close; + } + ))); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("predeclared semantic helper")), + "{errors:?}" + ); +} + +#[test] +fn cc_rejects_removing_a_machine_call_contract() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let check = input + .cc + .representations + .control_helpers + .iter() + .position(|helper| helper.role() == ControlHelperRole::Check) + .unwrap(); + assert!(input.cc.functions.iter_mut().any(|function| visit( + &mut function.assignments, + ControlHelperId(check as u32), + &mut |kind| { + let AssignmentKind::DirectCall { contract, .. } = kind else { + unreachable!() + }; + *contract = None; + } + ))); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("missing its semantic contract")), + "{errors:?}" + ); +} + +#[test] +fn optimized_mir_rejects_exchanging_check_and_close() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let check = stages + .mir + .control_helpers() + .iter() + .position(|helper| helper.role() == ControlHelperRole::Check) + .unwrap(); + let close = stages + .mir + .control_helpers() + .iter() + .find(|helper| helper.role() == ControlHelperRole::Close) + .unwrap() + .function(); + let call = stages + .mir + .functions + .iter_mut() + .flat_map(|function| &mut function.blocks) + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + Instruction::Call { + function, + contract: Some(id), + .. + } if id.0 as usize == check => Some(function), + _ => None, + }) + .expect("optimized execution retains a lifetime check"); + *call = close; + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("predeclared semantic helper")), + "{errors:?}" + ); +} + +#[test] +fn mir_tail_calls_retain_the_predeclared_helper_identity() { + let stages = crate::compile_main_stages(SOURCE).unwrap(); + let helpers = stages.mir.control_helpers(); + let mut count = 0; + for block in stages + .mir + .functions + .iter() + .flat_map(|function| &function.blocks) + { + if let Some(Terminator::ReturnCall { + function, + contract: Some(contract), + .. + }) = block.terminator + { + assert_eq!(helpers[contract.0 as usize].function(), function); + count += 1; + } + } + assert!( + count > 0, + "machine mutual tail calls retain their callee proof" + ); +} + +#[test] +fn p9_rejects_a_wrong_helper_before_lowering_or_loopifying_calls() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let check = input + .cc + .representations + .control_helpers + .iter() + .position(|helper| helper.role() == ControlHelperRole::Check) + .unwrap(); + let close = input + .cc + .representations + .control_helpers + .iter() + .find(|helper| helper.role() == ControlHelperRole::Close) + .unwrap() + .function(); + assert!(input.cc.functions.iter_mut().any(|function| visit( + &mut function.assignments, + ControlHelperId(check as u32), + &mut |kind| { + let AssignmentKind::DirectCall { function, .. } = kind else { + unreachable!() + }; + *function = close; + } + ))); + let errors = psrs_backend::mir::lower_module_with_bindings( + input.cc, + input.externals, + psrs_backend::TargetCapabilities::default(), + ) + .err() + .expect("P9 rejects the wrong semantic helper"); + assert!( + errors + .iter() + .any(|error| error.message.contains("predeclared semantic helper")), + "{errors:?}" + ); +} + +#[test] +fn mir_rejects_missing_identity_on_a_tail_helper_call() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let contract = stages + .mir + .functions + .iter_mut() + .flat_map(|function| &mut function.blocks) + .find_map(|block| match &mut block.terminator { + Some(Terminator::ReturnCall { contract, .. }) if contract.is_some() => Some(contract), + _ => None, + }) + .unwrap(); + *contract = None; + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("missing its semantic contract")), + "{errors:?}" + ); +} + +#[test] +fn control_helper_contracts_execute_long_requests_without_tail_call_capability() { + let Some(()) = super::wasmtime_available() else { + return; + }; + let source = format!( + r"{} +go :: Int -> C.Control Op Int +go n = if intEq n 0 then C.return 42 else C.bind (C.perform (Op \x -> x)) (\_ -> go (intSub n 1)) +main :: Int +main = let result = C.run 0 handler (go 100000) + in if intEq result._1 100000 then result._2 else 0 +", + SOURCE[..SOURCE.find("main ::").unwrap()].replace("{ _1: state,", "{ _1: intAdd state 1,") + ); + let target = psrs_backend::TargetCapabilities { + tail_call: false, + ..Default::default() + }; + let stages = crate::compile_main_with_target(&source, target).unwrap(); + assert!( + stages + .mir + .functions + .iter() + .flat_map(|function| &function.blocks) + .all(|block| !matches!( + block.terminator, + Some(Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. }) + )) + ); + let path = std::env::temp_dir().join("psrs-control-no-tail-contracts.wasm"); + std::fs::write(&path, &stages.artifact.wasm).unwrap(); + let output = std::process::Command::new("wasmtime") + .args(["run", "-W", "tail-call=n"]) + .arg(&path) + .output() + .unwrap(); + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index b32d30b8..408e379e 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -9,6 +9,7 @@ mod closure_protocol; mod coercion; mod control_contracts; mod control_costs; +mod control_helper_contracts; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 4b195b98..f55a17c6 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 88490864..fd3e9a09 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -238,6 +238,32 @@ does not prove a helper's implementation identity. Exact checkpoint ownership, replay activation and matched finish provenance must still be carried and verified; neither a well-shaped cast nor a quoted source type proves them. +### Semantic helper call identities + +P8 plans the control helper symbols before lowering any function body. Each +immutable helper contract binds one semantic role, a stable `SymbolId` and a +predeclared signature. Roles are unique, and check/close remain distinct even +though they have identical physical signatures. The planner retains the owning +source declaration's module (the first run/once/cancel use) for synthesized helper diagnostics. Helper bodies +may be emitted lazily; their identities and signatures may not be allocated late. + +Every direct machine-helper call carries its `ControlHelperId`. Common CC call +verification rejects an absent contract, an unknown contract or a target different +from the bound helper. The source operation witness also requires the expected +executor/once/cancel role. Ordinary calls have no machine contract. P9 checks the +same binding before choosing local/import call lowering and before converting a +self tail call to a loop. MIR `Call` and `ReturnCall` retain the contract and use +the same identity operation in verification, including after P10. Common inlining +may discharge the call identity when it substitutes the body of that resolved +callee; self loopification discharges it only after identity verification. +These conversions add no control-specific optimization rule. + +This proves the callee binding of a checked call. It does not prove that a check +uses the particular checkpoint required by its caller, that a close matches the +correct finish frame, or that the bound helper body implements every lifecycle +rule. Those argument, body and activation provenance obligations remain part of +the complete machine verification contract. + ### Alternatives - Moving old clause execution to the caller changes neither its source type nor diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index ae8e6913..e18c9fd8 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -987,3 +987,55 @@ comparison, not a new classification of each baseline cause. Logs and comparison `/private/tmp/psrs-control-contracts-clippy.log`. Explicit upstream type comparison, package conformance and suite scoreboards are not rerun for this internal stage contract unit; no measured gate number changes. + + +### Semantic helper callee bindings (2026-10-12) + +This continuation starts from `57e94257`. Check and close have the same callable +signature but different lifetime meanings. Previously, exchanging their callee +symbols could pass all physical call checks. P8 now predeclares an immutable +helper binding for each executor/lifecycle/replay/owner role before any function +body is lowered. The binding contains the concrete helper symbol and its +predeclared signature. The source contract planner retains the first owning +run/once/cancel declaration's module; generated diagnostics do not acquire an unrelated +entry module merely because helper allocation moved earlier. + +Machine direct calls carry their `ControlHelperId`; ordinary calls carry no +machine contract. CC checks the exact callee binding and rejects missing or +invalid contracts. Run/once/cancel source witnesses additionally require their +expected helper role. P9 checks call identity before local/import conversion and +before self loopification. Ordinary MIR calls and non-self tail calls retain and +verify it. P10's common inliner may discharge a verified call by substituting that +resolved callee's body; common self loopification discharges the verified self +binding. This adds no source intrinsic, runtime frame or optimization exemption. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Distinguish semantic helpers with equal signatures | `cc_rejects_exchanging_check_and_close_despite_equal_signatures`, `optimized_mir_rejects_exchanging_check_and_close` | Focused Verified | +| Reject loss of a required machine call contract | `cc_rejects_removing_a_machine_call_contract`, `mir_rejects_missing_identity_on_a_tail_helper_call` | Focused Verified | +| Validate before P9 can discharge a call into a loop/import lowering | `p9_rejects_a_wrong_helper_before_lowering_or_loopifying_calls`, actual malformed CC through the public P9 entry | Focused Verified | +| Preserve helper identity across non-self tail conversion | `mir_tail_calls_retain_the_predeclared_helper_identity`, actual checked-source optimized MIR | Focused Verified | +| Execute the persistent driver without tail-call capability | `control_helper_contracts_execute_long_requests_without_tail_call_capability`: compile with `tail_call: false`, assert no MIR tail-call terminators, run Wasmtime with `-W tail-call=n`, count exactly 100,000 requests and return 42 | Focused Verified | +| Verify complete checkpoint, activation and finish provenance | The bound callee may still receive a wrong same-shaped boundary; helper-body lifecycle correctness is not proved by the binding alone | Unverified | + +Focused log: `/private/tmp/psrs-control-helpers-focused.log` (seven tests, mandatory +Wasmtime). Earlier source/provenance and ancestry/GC probes also pass in the +filtered control driver run. Complete AE/AC status remains Unverified; source and +checkpoint argument relations, foreign capture, caught-trap cleanup, full pinned +library comparison and remaining general allocation obligations remain open. + + +Final validation: `cargo fmt --all --check`, `git diff --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. Mandatory Wasmtime +workspace execution passes all 435 backend tests, 95 Core tests, 80 control +integration tests, the seven new helper/capability tests and the existing +source/provenance and three cost tests. The nine failed targets and 175 failed +test names exactly match `57e94257`; no names are added or recovered. This compares +failure names, not every baseline cause. Logs: +`/private/tmp/psrs-control-helpers-workspace.log`, +`/private/tmp/psrs-control-helpers-comparison.json`, and +`/private/tmp/psrs-control-helpers-clippy.log`. The six ancestry/GC workloads are +remeasured; component fingerprints, collection counts and maximum post-GC live +bytes exactly match the preceding source-contract slice. Explicit upstream type +comparison, package conformance and scoreboards are not rerun for this internal +call-contract unit, and no measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 52ab4136..b3b239e4 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -38,6 +38,11 @@ operation witnesses through optimized MIR. CC checks actual factory operands; CC/MIR reject a locally proven computation from an incompatible semantic domain. The checklist records focused structural and malformed-IR evidence and the remaining trusted producer boundaries. +The continuation from `57e94257` predeclares semantic helper identities and +retains them on CC/MIR calls and MIR tail calls. Signature-compatible check/close +swaps and missing helper contracts are rejected; P9 validates identities before +loopification. A mandatory Wasmtime run with tail calls disabled executes and +counts 100,000 requests. Exact checkpoint/finish argument provenance is still open. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From 35dbdf9db3f76f91cb7152ed32298d89c9b9517e Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 12:30:13 +0800 Subject: [PATCH 112/148] Verify finish extent and restoration ownership across CC and MIR --- crates/psrs-backend/src/cc/control_helpers.rs | 29 ++ crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/value_identity.rs | 34 ++ .../src/cc/verify/control_provenance.rs | 182 +++++++ crates/psrs-backend/src/cc/verify/mod.rs | 2 + .../psrs-backend/src/cc/verify/ops/control.rs | 29 +- .../psrs-backend/src/cc/verify/ops/table.rs | 10 + crates/psrs-backend/src/control_provenance.rs | 34 ++ crates/psrs-backend/src/lib.rs | 1 + .../src/mir/control_provenance.rs | 259 ++++++++++ crates/psrs-backend/src/mir/mod.rs | 1 + crates/psrs-backend/src/mir/verify/mod.rs | 1 + .../src/tests/control_finish_provenance.rs | 462 ++++++++++++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 26 + .../backend/algebraic-effects.md | 54 ++ ...ted-control-lowering-handoff-2026-10-11.md | 5 + 18 files changed, 1109 insertions(+), 24 deletions(-) create mode 100644 crates/psrs-backend/src/cc/value_identity.rs create mode 100644 crates/psrs-backend/src/cc/verify/control_provenance.rs create mode 100644 crates/psrs-backend/src/control_provenance.rs create mode 100644 crates/psrs-backend/src/mir/control_provenance.rs create mode 100644 crates/psrs-driver/src/tests/control_finish_provenance.rs diff --git a/crates/psrs-backend/src/cc/control_helpers.rs b/crates/psrs-backend/src/cc/control_helpers.rs index 949881df..d6721443 100644 --- a/crates/psrs-backend/src/cc/control_helpers.rs +++ b/crates/psrs-backend/src/cc/control_helpers.rs @@ -17,6 +17,19 @@ pub enum ControlHelperRole { Cancel, } +impl ControlHelperRole { + pub(crate) const ALL: [Self; 8] = [ + Self::Executor, + Self::CloneSequence, + Self::RebuildSequence, + Self::Start, + Self::Check, + Self::Close, + Self::Once, + Self::Cancel, + ]; +} + /// A checked call identifies a particular helper, even when two helpers have /// the same physical signature. Only P8 planning publishes these bindings. #[derive(Clone, Debug, PartialEq, Eq)] @@ -39,6 +52,22 @@ impl ControlHelperContract { } impl super::RepresentationTable { + pub(crate) fn control_sequence(&self) -> Option { + let helper = self + .control_helpers + .iter() + .find(|helper| helper.role == ControlHelperRole::CloneSequence)?; + let super::ValueShape::Reference(reference) = + *self.signature(helper.signature)?.parameters.first()? + else { + return None; + }; + let super::RefShape::Repr(sequence) = reference.heap else { + return None; + }; + Some(sequence) + } + pub(crate) fn verify_control_call( &self, function: SymbolId, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 8b04720f..fbe7b3cd 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -10,6 +10,7 @@ use std::rc::Rc; mod case; mod control_contract; mod control_helpers; +pub(crate) mod value_identity; pub use control_contract::{ ControlContract, ControlContractId, ControlDomain, SourceTypeIdentityId, TypeConstructorIdentity, TypeIdentity, diff --git a/crates/psrs-backend/src/cc/value_identity.rs b/crates/psrs-backend/src/cc/value_identity.rs new file mode 100644 index 00000000..d97dbd9d --- /dev/null +++ b/crates/psrs-backend/src/cc/value_identity.rs @@ -0,0 +1,34 @@ +//! Identity-preserving CC operations, shared by semantic evidence consumers. +use super::{AssignmentKind, ValueConversion, ValueId}; +use std::collections::HashSet; + +pub(crate) fn reference_origin<'a>( + mut value: ValueId, + mut definition: impl FnMut(ValueId) -> Option<&'a AssignmentKind>, +) -> ValueId { + let mut seen = HashSet::new(); + while seen.insert(value) { + let source = match definition(value) { + Some(AssignmentKind::RepresentationCast { value, .. }) => Some(*value), + Some(AssignmentKind::AggregateConvert { + value, conversion, .. + }) if transparent(&conversion.plan) => Some(*value), + _ => None, + }; + match source { + Some(source) => value = source, + None => break, + } + } + value +} + +fn transparent(conversion: &ValueConversion) -> bool { + match conversion { + ValueConversion::Identity + | ValueConversion::EraseReference + | ValueConversion::RecoverReference { .. } => true, + ValueConversion::Sequence(steps) => steps.iter().all(transparent), + _ => false, + } +} diff --git a/crates/psrs-backend/src/cc/verify/control_provenance.rs b/crates/psrs-backend/src/cc/verify/control_provenance.rs new file mode 100644 index 00000000..9cc9d0b8 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control_provenance.rs @@ -0,0 +1,182 @@ +//! Read actual CC projections and tail transitions, independently of the builder. +use crate::BackendError; +use crate::cc::{ + AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, +}; +use crate::control_provenance::{FinishProjection, finish_relation}; +use std::collections::HashMap; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) + { + return Ok(()); + } + let sequence = table.control_sequence().ok_or_else(|| { + error( + function, + function.span, + "control executor has no checked sequence schema", + ) + })?; + let mut definitions = HashMap::new(); + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for assignment in body { + definitions.insert(assignment.destination, &assignment.kind); + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &assignment.kind + { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + } + } + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for (index, assignment) in body.iter().enumerate() { + match &assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + A::DirectCall { + contract: Some(contract), + arguments, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Close) => + { + let next = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + contract: Some(contract), + arguments, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Executor) => + { + Some(arguments) + } + _ => None, + }) + .ok_or_else(|| { + error( + function, + assignment.span, + "control finish has no executor transition", + ) + })?; + if arguments.len() != 1 || next.len() != 6 { + return Err(error( + function, + assignment.span, + "control finish transition has an invalid arity", + )); + } + finish_relation( + projection(arguments[0], &definitions, sequence), + projection(next[3], &definitions, sequence), + projection(next[4], &definitions, sequence), + ) + .map_err(|message| error(function, assignment.span, message))?; + } + A::DirectCall { + contract: Some(contract), + arguments, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Executor) + && arguments.len() == 6 + && projection(arguments[3], &definitions, sequence) + .is_some_and(|projection| projection.field == 1) => + { + let close = body[..index] + .iter() + .rev() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + contract: Some(contract), + arguments, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Close) => + { + arguments.first().copied() + } + _ => None, + }) + .ok_or_else(|| { + error( + function, + assignment.span, + "control finish transition does not close its frame", + ) + })?; + finish_relation( + projection(close, &definitions, sequence), + projection(arguments[3], &definitions, sequence), + projection(arguments[4], &definitions, sequence), + ) + .map_err(|message| error(function, assignment.span, message))?; + } + _ => {} + } + } + } + Ok(()) +} + +fn projection( + value: ValueId, + definitions: &HashMap, + sequence: crate::cc::ReprId, +) -> Option { + let definition = |value| definitions.get(&value).copied(); + let value = crate::cc::value_identity::reference_origin(value, definition); + match definition(value)? { + A::VariantGet { + representation, + case: 3, + field, + value: owner, + .. + } if *representation == sequence => Some(FinishProjection { + owner: crate::cc::value_identity::reference_origin(*owner, definition), + field: *field, + }), + _ => None, + } +} + +fn error( + function: &Function, + span: psrs_span::TextRange, + message: &'static str, +) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC control provenance", span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 9a844233..22d848c1 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -5,6 +5,7 @@ use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; mod adaptation; +mod control_provenance; mod helpers; mod ops; mod scalar; @@ -187,6 +188,7 @@ fn verify_function_inner( )]); } verify_capture_layout(function)?; + control_provenance::verify(function, representations)?; let mut available = function.parameters.iter().copied().collect::>(); verify_assignments( &function.assignments, diff --git a/crates/psrs-backend/src/cc/verify/ops/control.rs b/crates/psrs-backend/src/cc/verify/ops/control.rs index 9bac7d46..f71387cf 100644 --- a/crates/psrs-backend/src/cc/verify/ops/control.rs +++ b/crates/psrs-backend/src/cc/verify/ops/control.rs @@ -1,8 +1,8 @@ use super::super::helpers::{assignment_error, declared_shape}; use crate::BackendError; +use crate::cc::Signature; use crate::cc::control_contract::ControlImplementation; use crate::cc::{Assignment, AssignmentKind, RepresentationTable, ValueId, ValueShape}; -use crate::cc::{Signature, ValueConversion}; use psrs_hir::SymbolId; use std::collections::HashMap; @@ -133,28 +133,11 @@ pub(super) fn verify( Ok(uses) } -fn origin(mut value: ValueId, assignments: &[Assignment]) -> ValueId { - for _ in 0..assignments.len() { - let next = assignments +fn origin(value: ValueId, assignments: &[Assignment]) -> ValueId { + crate::cc::value_identity::reference_origin(value, |value| { + assignments .iter() .find(|assignment| assignment.destination == value) - .and_then(|assignment| match &assignment.kind { - AssignmentKind::RepresentationCast { value, .. } => Some(*value), - AssignmentKind::AggregateConvert { - value, conversion, .. - } if matches!( - conversion.plan, - ValueConversion::EraseReference | ValueConversion::RecoverReference { .. } - ) => - { - Some(*value) - } - _ => None, - }); - match next { - Some(next) => value = next, - None => break, - } - } - value + .map(|assignment| &assignment.kind) + }) } diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index c25a11a4..bb09424e 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -21,6 +21,16 @@ pub(crate) fn verify_table( )); } } + if !table.control_helpers.is_empty() + && crate::cc::ControlHelperRole::ALL + .iter() + .any(|role| !roles.contains(role)) + { + return Err(table_error( + span, + "control machine is missing a required semantic helper", + )); + } for proof in &table.control_contracts { if proof.argument_identities().len() != proof.arguments().len() || std::iter::once(&proof.result_identity()) diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control_provenance.rs new file mode 100644 index 00000000..e29c0302 --- /dev/null +++ b/crates/psrs-backend/src/control_provenance.rs @@ -0,0 +1,34 @@ +//! Stage-independent ownership relations for the control machine. +use crate::types::ValueId; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) struct FinishProjection { + pub owner: ValueId, + pub field: u32, +} + +/// Finishing restores all lifecycle state from one immutable finish record. +/// A shape-compatible parent or a projection from another record is insufficient. +pub(crate) fn finish_relation( + extent: Option, + queue: Option, + parent: Option, +) -> Result<(), &'static str> { + let extent = extent + .filter(|projection| projection.field == 0) + .ok_or("control finish must close its frame's extent, not another boundary")?; + if queue + != Some(FinishProjection { + owner: extent.owner, + field: 1, + }) + || parent + != Some(FinishProjection { + owner: extent.owner, + field: 2, + }) + { + return Err("control finish must restore the queue and parent from the same frame"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index deddd2e3..eb4ae36a 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -3,6 +3,7 @@ mod bindings; mod boundary; pub mod capability; pub mod cc; +mod control_provenance; mod linking; pub mod mir; mod pipeline; diff --git a/crates/psrs-backend/src/mir/control_provenance.rs b/crates/psrs-backend/src/mir/control_provenance.rs new file mode 100644 index 00000000..2aa6b416 --- /dev/null +++ b/crates/psrs-backend/src/mir/control_provenance.rs @@ -0,0 +1,259 @@ +//! Recheck lifecycle ownership after physical projection and loop conversion. +use super::{Function, Instruction as I, Module, Terminator as T}; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control_provenance::{FinishProjection, finish_relation}; +use crate::types::{DefinedTypeId, ValueId}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { + return; + }; + let table = layout.representation_table(); + let Some(executor) = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + else { + return; + }; + if !module + .functions + .iter() + .any(|function| function.symbol == executor.function()) + { + return; + } + let Some(sequence) = table.control_sequence() else { + if table + .control_helpers + .iter() + .any(|helper| helper.role() == R::Executor) + { + errors.push(BackendError::invalid_ir( + "P9 MIR control provenance", + module.span, + "control executor has no checked sequence schema", + )); + } + return; + }; + let Ok(finish_type) = layout.variant_index(sequence, 3) else { + errors.push(BackendError::invalid_ir( + "P9 MIR control provenance", + module.span, + "control finish schema has no physical layout", + )); + return; + }; + for function in &module.functions { + if !table + .control_helpers + .iter() + .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) + { + continue; + } + let header = function + .blocks + .iter() + .find(|block| block.id == function.entry) + .and_then(|block| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if arguments == &function.parameters => Some(*target), + _ => None, + }); + for block in &function.blocks { + for (index, instruction) in block.instructions.iter().enumerate() { + let I::Call { + contract: Some(contract), + arguments, + span, + .. + } = instruction + else { + continue; + }; + if !table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Close) + { + continue; + } + let next = block.instructions[index + 1..] + .iter() + .find_map(|instruction| match instruction { + I::Call { + contract: Some(contract), + arguments, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Executor) => + { + Some(arguments.as_slice()) + } + _ => None, + }) + .or_else(|| match &block.terminator { + Some(T::ReturnCall { + contract: Some(contract), + arguments, + .. + }) if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Executor) => + { + Some(arguments.as_slice()) + } + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == header => Some(arguments.as_slice()), + _ => None, + }); + let check = match next { + Some(next) if arguments.len() == 1 && next.len() == 6 => finish_relation( + projection(arguments[0], function, finish_type), + projection(next[3], function, finish_type), + projection(next[4], function, finish_type), + ), + _ => Err("control finish has no checked executor transition"), + }; + if let Err(message) = check { + errors.push( + BackendError::invalid_ir("P9 MIR control provenance", *span, message) + .with_module(function.symbol.module), + ); + } + } + let transitions = block + .instructions + .iter() + .filter_map(|instruction| match instruction { + I::Call { + contract: Some(contract), + arguments, + span, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Executor) => + { + Some((arguments.as_slice(), *span)) + } + _ => None, + }) + .chain(block.terminator.iter().filter_map(|terminator| { + match terminator { + T::ReturnCall { + contract: Some(contract), + arguments, + span, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Executor) => + { + Some((arguments.as_slice(), *span)) + } + T::Jump { + target, + arguments, + span, + } if Some(*target) == header => Some((arguments.as_slice(), *span)), + _ => None, + } + })); + for (next, span) in transitions { + if next.len() != 6 + || !projection(next[3], function, finish_type) + .is_some_and(|projection| projection.field == 1) + { + continue; + } + let close = + block + .instructions + .iter() + .rev() + .find_map(|instruction| match instruction { + I::Call { + contract: Some(contract), + arguments, + .. + } if table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::Close) => + { + arguments.first().copied() + } + _ => None, + }); + let check = match close { + Some(close) => finish_relation( + projection(close, function, finish_type), + projection(next[3], function, finish_type), + projection(next[4], function, finish_type), + ), + None => Err("control finish transition does not close its frame"), + }; + if let Err(message) = check { + errors.push( + BackendError::invalid_ir("P9 MIR control provenance", span, message) + .with_module(function.symbol.module), + ); + } + } + } + } +} + +fn projection( + mut value: ValueId, + function: &Function, + finish_type: DefinedTypeId, +) -> Option { + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .collect::>(); + for _ in 0..definitions.len() { + match definitions + .iter() + .find(|instruction| instruction.destination() == Some(value))? + { + I::Copy { value: source, .. } | I::RefCast { value: source, .. } => value = *source, + I::StructGet { + type_index, + field, + value: owner, + .. + } if *type_index == finish_type && *field > 0 => { + let mut owner = *owner; + for _ in 0..definitions.len() { + match definitions + .iter() + .find(|instruction| instruction.destination() == Some(owner)) + { + Some(I::Copy { value, .. } | I::RefCast { value, .. }) => owner = *value, + _ => break, + } + } + return Some(FinishProjection { + owner, + field: field - 1, + }); + } + _ => return None, + } + } + None +} diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index e94e036f..5cc4b537 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -8,6 +8,7 @@ use std::collections::{HashMap, HashSet}; pub(crate) mod cfg; mod control_contracts; +mod control_provenance; mod instruction; pub(crate) mod layout; mod literals; diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index aac35b4f..4fdcf5e1 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -33,6 +33,7 @@ struct Signature { pub fn verify_module(module: &Module) -> Result<(), Vec> { let mut errors = Vec::new(); super::control_contracts::verify(module, &mut errors); + super::control_provenance::verify(module, &mut errors); verify_defined_types(module, &mut errors); let mut signatures = module .functions diff --git a/crates/psrs-driver/src/tests/control_finish_provenance.rs b/crates/psrs-driver/src/tests/control_finish_provenance.rs new file mode 100644 index 00000000..36bb7b57 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_finish_provenance.rs @@ -0,0 +1,462 @@ +//! Finish relations must reject lifetime swaps that ordinary types accept. +use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; + +const SOURCE: &str = r"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +ret :: Int -> C.Control Op Int +ret x = C.return x +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Int +clause (Op k) raw = C.handle ret clause (raw (k 42)) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +main :: Int +main = (C.run 0 handler (C.handle ret clause (C.perform (Op \x -> x))))._2 +"; + +fn leaf( + body: &mut Vec, + close: u32, + edit: &mut impl FnMut(&mut Vec, usize), +) -> bool { + if let Some(index) = body.iter().position(|assignment| matches!(assignment.kind, A::DirectCall { contract: Some(contract), .. } if contract.0 == close)) { + edit(body, index); + return true; + } + for assignment in body { + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &mut assignment.kind + { + for case in cases { + if leaf(&mut case.assignments, close, edit) { + return true; + } + } + if leaf(default_assignments, close, edit) { + return true; + } + } + } + false +} + +fn mutate_cc(edit: &mut impl FnMut(&mut Vec, usize)) -> psrs_backend::BackendInput { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let helpers = &input.cc.representations.control_helpers; + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + assert!(leaf(&mut function.assignments, close, edit)); + input +} + +#[test] +fn cc_rejects_closing_the_parent_instead_of_the_finish_extent() { + let input = mutate_cc(&mut |body, index| { + let parent = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { arguments, .. } if arguments.len() == 6 => Some(arguments[4]), + _ => None, + }) + .unwrap(); + let A::DirectCall { arguments, .. } = &mut body[index].kind else { + unreachable!() + }; + arguments[0] = parent; + }); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("must close its frame's extent")), + "{errors:?}" + ); +} + +#[test] +fn cc_rejects_restoring_the_closed_extent_instead_of_its_parent() { + let input = mutate_cc(&mut |body, index| { + let A::DirectCall { arguments, .. } = &body[index].kind else { + unreachable!() + }; + let closed = arguments[0]; + let arguments = body[index + 1..] + .iter_mut() + .find_map(|assignment| match &mut assignment.kind { + A::DirectCall { arguments, .. } if arguments.len() == 6 => Some(arguments), + _ => None, + }) + .unwrap(); + arguments[4] = closed; + }); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("restore the queue and parent from the same frame")), + "{errors:?}" + ); +} + +#[test] +fn optimized_mir_rejects_closing_a_same_shaped_parent() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let helpers = stages.mir.control_helpers(); + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); + let Some(T::Jump { arguments, .. }) = &block.terminator else { + panic!("finish loop transition") + }; + let parent = arguments[4]; + let call = block + .instructions + .iter_mut() + .find_map(|instruction| match instruction { + I::Call { + arguments, + contract: Some(contract), + .. + } if contract.0 == close => Some(arguments), + _ => None, + }) + .unwrap(); + call[0] = parent; + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("must close its frame's extent")), + "{errors:?}" + ); +} + +#[test] +fn optimized_mir_rejects_the_wrong_restored_parent() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let helpers = stages.mir.control_helpers(); + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); + let extent = block + .instructions + .iter() + .find_map(|instruction| match instruction { + I::Call { + arguments, + contract: Some(contract), + .. + } if contract.0 == close => Some(arguments[0]), + _ => None, + }) + .unwrap(); + let Some(T::Jump { arguments, .. }) = &mut block.terminator else { + panic!("finish loop transition") + }; + arguments[4] = extent; + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("restore the queue and parent from the same frame")), + "{errors:?}" + ); +} + +#[test] +fn cc_rejects_a_finish_disguised_as_a_valid_lifetime_check() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let helpers = &input.cc.representations.control_helpers; + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let check = helpers + .iter() + .position(|helper| helper.role() == R::Check) + .unwrap() as u32; + let check_function = helpers[check as usize].function(); + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + assert!(leaf( + &mut function.assignments, + close, + &mut |body, index| { + let A::DirectCall { + contract, function, .. + } = &mut body[index].kind + else { + unreachable!() + }; + *contract = Some(psrs_backend::cc::ControlHelperId(check)); + *function = check_function; + } + )); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("transition does not close its frame")), + "{errors:?}" + ); +} + +#[test] +fn optimized_mir_rejects_a_finish_without_a_close() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let helpers = stages.mir.control_helpers(); + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); + let index = block.instructions.iter().position(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close)).unwrap(); + block.instructions.remove(index); + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("transition does not close its frame")), + "{errors:?}" + ); +} + +#[test] +fn cc_rejects_a_parent_projected_from_another_finish_frame() { + let input = mutate_cc(&mut |body, index| { + let next = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { arguments, .. } if arguments.len() == 6 => { + Some((arguments[3], arguments[4])) + } + _ => None, + }) + .unwrap(); + let parent = body + .iter_mut() + .find(|assignment| assignment.destination == next.1) + .unwrap(); + let A::VariantGet { value, .. } = &mut parent.kind else { + unreachable!() + }; + *value = next.0; + }); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("restore the queue and parent from the same frame")), + "{errors:?}" + ); +} + +#[test] +fn optimized_mir_rejects_a_parent_from_a_different_finish_frame() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let helpers = stages.mir.control_helpers(); + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); + let Some(T::Jump { arguments, .. }) = &block.terminator else { + panic!("finish loop transition") + }; + let (queue, parent) = (arguments[3], arguments[4]); + let cast = block + .instructions + .iter() + .find_map(|instruction| match instruction { + I::StructGet { + destination, value, .. + } if *destination == parent => Some(*value), + _ => None, + }) + .unwrap(); + let cast = block + .instructions + .iter_mut() + .find(|instruction| instruction.destination() == Some(cast)) + .unwrap(); + let I::RefCast { value, .. } = cast else { + panic!("physical finish projection") + }; + *value = queue; + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("restore the queue and parent from the same frame")), + "{errors:?}" + ); +} + +#[test] +fn checked_reference_identity_aliases_preserve_finish_ownership() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let helpers = &input.cc.representations.control_helpers; + let close = helpers + .iter() + .position(|helper| helper.role() == R::Close) + .unwrap() as u32; + let executor = helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + let queue_shape = input + .cc + .representations + .signature( + helpers + .iter() + .find(|helper| helper.role() == R::CloneSequence) + .unwrap() + .signature(), + ) + .unwrap() + .parameters[0]; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let alias = psrs_backend::cc::ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let mut source = None; + assert!(leaf( + &mut function.assignments, + close, + &mut |body, index| { + let parent = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { arguments, .. } if arguments.len() == 6 => Some(arguments[4]), + _ => None, + }) + .unwrap(); + let definition = body + .iter() + .position(|assignment| assignment.destination == parent) + .unwrap(); + let A::VariantGet { value, .. } = &mut body[definition].kind else { + unreachable!() + }; + source = Some(*value); + *value = alias; + let owner = source.unwrap(); + let span = body[definition].span; + body.insert( + definition, + Assignment { + destination: alias, + span, + kind: A::AggregateConvert { + destination: alias, + value: owner, + conversion: psrs_backend::cc::AggregateConvert { + source: queue_shape, + destination: queue_shape, + plan: psrs_backend::cc::ValueConversion::Identity, + }, + }, + }, + ); + } + )); + let shape = function + .values + .iter() + .find(|value| value.id == source.unwrap()) + .unwrap() + .ty; + function.values.push(psrs_backend::cc::ValueDecl { + id: alias, + ty: shape, + }); + psrs_backend::cc::verify_module(&input.cc).unwrap(); + psrs_backend::compile_cc(input).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 408e379e..b382e55b 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -9,6 +9,7 @@ mod closure_protocol; mod coercion; mod control_contracts; mod control_costs; +mod control_finish_provenance; mod control_helper_contracts; mod data_function; mod data_tuple; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index f55a17c6..b2c16a14 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. Complete CC/MIR frame identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. Complete producer/checkpoint/replay identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index fd3e9a09..8a1ae033 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -264,6 +264,32 @@ correct finish frame, or that the bound helper body implements every lifecycle rule. Those argument, body and activation provenance obligations remain part of the complete machine verification contract. +### Finish consumption ownership + +A finish record stores `(extent, remainingQueue, parent)`. Consuming it must close +field zero and pass fields one and two from that same record to the next control +execution step. A compatible boundary type cannot establish this relation. + +The shared `finish_relation` validates the record identity and logical field +positions. CC reads actual variant projections and helper calls in the execution +loop; it indexes definitions across nested assignment sequences and uses the +shared identity-preserving reference operations. MIR reads actual struct +projections, strips copies/reference casts, accounts for the tag-field offset, +and reads the next direct/tail call or self-loop jump. It uses the immutable +planned sequence schema and the bound execution helper identity, without matching +function names. A recorded close requires its corresponding transition; a +transition consuming a finish queue requires a preceding close. A shape-compatible +check cannot substitute for that close, even if its own callee contract is valid. + +This checks finish consumers and preserves the relation after P10. It does not +establish that every finish was created from the right context, that all replay +activations have the intended ancestry, or that all checkpoint captures and +checks refer to the proper source extent. Those producer, capture and activation +obligations remain required for complete lifecycle provenance. A simultaneous +rewrite removing both the close and all recognizable finish projections is not +proved equivalent by this local relation check; complete execution-step evidence +must still cover it. + ### Alternatives - Moving old clause execution to the caller changes neither its source type nor diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index e18c9fd8..a586fc11 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1039,3 +1039,57 @@ remeasured; component fingerprints, collection counts and maximum post-GC live bytes exactly match the preceding source-contract slice. Explicit upstream type comparison, package conformance and scoreboards are not rerun for this internal call-contract unit, and no measured gate number changes. + + +### Finish consumer ownership (2026-10-12) + +This continuation starts from `df46f2d2`. Same-shaped boundaries could still be +exchanged while keeping the correct close helper identity. A shared relation now +checks actual finish consumption: the closed extent, restored queue and restored +parent must be projections 0/1/2 of one immutable finish record. CC reads actual +variant projections and execution calls; MIR reads actual struct projections and +execution calls/tail calls/self-loop jumps. The schema comes from the predeclared +sequence helper signature and physical layout, not function names or a new +source intrinsic. Both directions are checked: a close needs the matching next +step, and a step consuming a finish queue needs a preceding close. + +CC reference identity operations have one shared owner. Identity conversion, +reference erasure/recovery and reference casts preserve an existing object's +identity; mappings/adapters that construct another object do not. The finish +verifier indexes definitions across nested CC sequences, while the existing +source-contract consumer uses the same transparent-operation rules. MIR follows +copies and casts, including the self-loop parameters produced by P9. No runtime +instruction or representation changes are introduced by this verification unit. +Incomplete nonempty helper registries and missing sequence schemas are errors. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Close the finish extent rather than its parent | `cc_rejects_closing_the_parent_instead_of_the_finish_extent`, `optimized_mir_rejects_closing_a_same_shaped_parent` | Focused Verified | +| Restore the proper parent | `cc_rejects_restoring_the_closed_extent_instead_of_its_parent`, `optimized_mir_rejects_the_wrong_restored_parent` | Focused Verified | +| Require all restored fields to come from the same record | `cc_rejects_a_parent_projected_from_another_finish_frame`, `optimized_mir_rejects_a_parent_from_a_different_finish_frame` | Focused Verified | +| Require completion rather than a compatible check or omitted call | `cc_rejects_a_finish_disguised_as_a_valid_lifetime_check`, `optimized_mir_rejects_a_finish_without_a_close` | Focused Verified | +| Accept identity-preserving transformations | `checked_reference_identity_aliases_preserve_finish_ownership`, real CC through the checked artifact pipeline | Focused Verified | +| Establish complete lifecycle provenance | Correct finish production, checkpoint capture/check identity, fresh replay ancestry and full execution-step coverage remain unverified | Unverified | + +The consumer relation does not prove the origin of every finish record. A rewrite +removing both completion and all recognizable finish projections also requires +complete execution-step evidence; this unit does not claim that proof. Existing +Core typing and trusted higher-order/imported producer boundaries remain as +recorded above. Full AE/AC acceptance, foreign capture, caught-host-trap cleanup, +pinned library comparison and remaining general allocation obligations stay open. + +Validation: all nine new driver tests pass, with required Wasmtime and real +optimized MIR. `cargo fmt --all --check`, `git diff --check` and +`cargo clippy --workspace --all-targets -- -D warnings` pass. Mandatory workspace +execution passes 435 backend tests, 95 Core tests, all 80 control integration +tests and the existing cost probes. The nine failing targets and 175 failed test +names exactly match `df46f2d2`, with no added or recovered names. This compares +failure names, not all baseline causes. Logs: +`/private/tmp/psrs-control-finish-structural.log`, +`/private/tmp/psrs-control-finish-workspace.log`, +`/private/tmp/psrs-control-finish-comparison.json`, and +`/private/tmp/psrs-control-finish-clippy.log`. The six ancestry/GC workloads are +remeasured; fingerprints, collection counts and maximum post-GC live bytes match +the preceding helper slice. Explicit upstream type comparison, package +conformance and scoreboards are not rerun for this internal invariant change. +No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index b3b239e4..c4ffcfdb 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -43,6 +43,11 @@ retains them on CC/MIR calls and MIR tail calls. Signature-compatible check/clos swaps and missing helper contracts are rejected; P9 validates identities before loopification. A mandatory Wasmtime run with tail calls disabled executes and counts 100,000 requests. Exact checkpoint/finish argument provenance is still open. +The continuation from `df46f2d2` checks finish consumer ownership in CC and +optimized MIR: close, restored queue and restored parent must use one finish +record. A check or omitted close cannot replace completion. Nine new provenance +and identity-alias tests pass. Finish production, checkpoint identity and replay +activation ancestry still need their complete semantic proofs. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From f3c5a138e050c9f8900ebed0ba35b214bd68ed98 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 12:49:05 +0800 Subject: [PATCH 113/148] fix(backend): retain nominal control carriers at source boundaries --- .../src/cc/case/decision/realize/tests/mod.rs | 1 + .../decision/realize/tests/nested_tests.rs | 1 + .../decision/realize/tests/newtype_tests.rs | 1 + .../tests/parameterized_tests/support.rs | 1 + .../decision/realize/tests/product_tests.rs | 1 + .../decision/realize/tests/record_tests.rs | 1 + .../psrs-backend/src/cc/layout/aggregate.rs | 6 + crates/psrs-backend/src/cc/layout/control.rs | 19 +- .../src/cc/layout/functions/mod.rs | 5 + crates/psrs-backend/src/cc/layout/mod.rs | 18 +- crates/psrs-backend/src/cc/layout/scalar.rs | 26 +++ .../psrs-backend/src/cc/layout/tests/mod.rs | 1 + .../src/cc/layout/tests/opaque.rs | 1 + .../src/cc/lower/call/application.rs | 1 + .../psrs-backend/src/cc/lower/control/mod.rs | 27 +-- .../src/cc/lower/control/operands.rs | 109 ++++++++++ .../src/cc/lower/conversion/mod.rs | 1 + .../src/cc/lower/conversion/tests.rs | 1 + .../src/cc/lower/erased/curried.rs | 1 + .../psrs-backend/src/cc/lower/erased/mod.rs | 2 + .../psrs-backend/src/cc/lower/lambda/mod.rs | 3 + .../psrs-backend/src/cc/lower/letrec/mod.rs | 1 + crates/psrs-backend/src/cc/lower/mod.rs | 7 + crates/psrs-backend/src/cc/mod.rs | 10 +- .../psrs-backend/src/cc/verify/ops/control.rs | 16 ++ .../src/cc/verify/tests/control_calls.rs | 12 +- .../src/cc/verify/tests/control_frames.rs | 9 +- .../psrs-driver/src/tests/control_carriers.rs | 201 ++++++++++++++++++ .../src/tests/control_contracts.rs | 56 +++-- crates/psrs-driver/src/tests/mod.rs | 1 + .../tests/control_carrier_runtime.rs | 11 + .../control_support/nominal_carriers.purs | 25 +++ docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 25 ++- .../backend/algebraic-effects.md | 68 ++++++ ...ted-control-lowering-handoff-2026-10-11.md | 10 +- 36 files changed, 616 insertions(+), 65 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/control/operands.rs create mode 100644 crates/psrs-driver/src/tests/control_carriers.rs create mode 100644 crates/psrs-driver/tests/control_carrier_runtime.rs create mode 100644 crates/psrs-driver/tests/control_support/nominal_carriers.purs diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs index d368f882..ff57cb83 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/mod.rs @@ -142,6 +142,7 @@ fn compiled_root_switch_resolves_the_realizer_root_slot() { enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs index 1302ea86..5a1ac855 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/nested_tests.rs @@ -191,6 +191,7 @@ fn nested_sum_patterns_project_once_per_selected_constructor_and_trap_missing_ta enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs index da1b8a59..9ffa9411 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/newtype_tests.rs @@ -131,6 +131,7 @@ fn newtype_constructor_erases_before_nested_enum_dispatch() { enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs index edeab6ef..6da39b4e 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/parameterized_tests/support.rs @@ -59,6 +59,7 @@ pub(super) fn lower_and_verify( enum_types: context.enum_types, aggregate_types: context.aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs index 9b0f598b..7d402055 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/product_tests.rs @@ -127,6 +127,7 @@ fn single_constructor_product_dispatch_projects_and_binds_first_row_once() { enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs index b045031b..a80bd98a 100644 --- a/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs +++ b/crates/psrs-backend/src/cc/case/decision/realize/tests/record_tests.rs @@ -151,6 +151,7 @@ fn nested_record_patterns_share_one_product_projection_and_keep_source_spans() { enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/layout/aggregate.rs b/crates/psrs-backend/src/cc/layout/aggregate.rs index 8d4fcdbe..898c0ba4 100644 --- a/crates/psrs-backend/src/cc/layout/aggregate.rs +++ b/crates/psrs-backend/src/cc/layout/aggregate.rs @@ -51,6 +51,7 @@ pub(super) fn normalize_aggregate_layouts( enum_types: &HashSet, aggregate_types: &HashSet, newtype_ids: &HashSet, + nominal_types: &HashMap, mut function_types: HashMap, mut layouts: AggregateLayouts, representations: &mut RepresentationTable, @@ -67,6 +68,7 @@ pub(super) fn normalize_aggregate_layouts( enum_types, aggregate_types, newtype_ids, + nominal_types, function_types, layouts, representations, @@ -90,6 +92,7 @@ fn normalize_pass( enum_types: &HashSet, aggregate_types: &HashSet, newtype_ids: &HashSet, + nominal_types: &HashMap, mut function_types: HashMap, layouts: AggregateLayouts, representations: &mut RepresentationTable, @@ -100,6 +103,7 @@ fn normalize_pass( enum_types, aggregate_types, newtype_ids, + nominal_types, function_types: function_types.clone(), representations, arrays: layouts.arrays, @@ -170,6 +174,7 @@ struct Builder<'a> { enum_types: &'a HashSet, aggregate_types: &'a HashSet, newtype_ids: &'a HashSet, + nominal_types: &'a HashMap, function_types: HashMap, representations: &'a mut RepresentationTable, arrays: HashMap, @@ -256,6 +261,7 @@ impl Builder<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, &self.arrays, &self.records, &self.function_types, diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control.rs index 907069ce..6df6592b 100644 --- a/crates/psrs-backend/src/cc/layout/control.rs +++ b/crates/psrs-backend/src/cc/layout/control.rs @@ -6,6 +6,17 @@ use crate::cc::{ ValueShape, VariantCase, }; +use psrs_hir::TypeId as HirTypeId; +use std::collections::HashMap; + +/// Reserve builtin carriers before any source signature or aggregate layout. +pub(in crate::cc) fn reserve(table: &mut RepresentationTable) -> HashMap { + HashMap::from([ + (HirTypeId::CONTROL, table.reserve()), + (HirTypeId::RESUMPTION, table.reserve()), + ]) +} + #[derive(Clone, Copy)] pub(in crate::cc) struct ControlLayout { pub computation: ReprId, @@ -30,12 +41,13 @@ pub(in crate::cc) struct ControlLayout { pub(in crate::cc) fn append( table: &mut RepresentationTable, continuation: SignatureId, + nominal_types: &HashMap, ) -> ControlLayout { let erased = erased_shape(); - let computation = table.reserve(); + let computation = nominal_types[&HirTypeId::CONTROL]; let sequence = table.reserve(); let context = table.reserve(); - let owner = table.reserve(); + let owner = nominal_types[&HirTypeId::RESUMPTION]; let boundary = table.reserve(); let callback = super::protocols::array(table, erased); let status = super::protocols::array(table, ValueShape::Integer); @@ -211,7 +223,8 @@ mod tests { parameters: vec![erased], result: erased, }); - let layout = append(&mut table, continuation); + let nominal_types = reserve(&mut table); + let layout = append(&mut table, continuation, &nominal_types); assert_eq!(layout.callback, callback); assert_eq!(layout.status, status); assert_eq!( diff --git a/crates/psrs-backend/src/cc/layout/functions/mod.rs b/crates/psrs-backend/src/cc/layout/functions/mod.rs index 822cfb17..39781590 100644 --- a/crates/psrs-backend/src/cc/layout/functions/mod.rs +++ b/crates/psrs-backend/src/cc/layout/functions/mod.rs @@ -16,11 +16,13 @@ pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { reachable::live_type_ids(module) } +#[allow(clippy::too_many_arguments)] pub(super) fn append_function_types( module: &CoreModule, enum_types: &HashSet, aggregate_types: &HashSet, newtype_ids: &HashSet, + nominal_types: &HashMap, array_types: &HashMap, record_types: &HashMap, representations: &mut RepresentationTable, @@ -63,6 +65,7 @@ pub(super) fn append_function_types( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, &provisional_function_types, @@ -108,6 +111,7 @@ pub(crate) fn function_signature( enum_types: &HashSet, aggregate_types: &HashSet, newtype_ids: &HashSet, + nominal_types: &HashMap, array_types: &HashMap, record_types: &HashMap, function_types: &HashMap, @@ -121,6 +125,7 @@ pub(crate) fn function_signature( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, function_types, diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index fbeca7e5..64963d60 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -226,6 +226,14 @@ pub(super) fn type_layout( None }; + let uses_control = module.types.iter().any(|ty| matches!(ty, + Type::Constructor(TypeConstructor::User(id)) if *id == HirTypeId::CONTROL || *id == HirTypeId::RESUMPTION)); + let nominal_types = if uses_control { + control::reserve(&mut representations) + } else { + HashMap::new() + }; + // Reserve aggregate handles before signatures so closure types can refer // to them. Normalize afterward and rewrite signature references to the // canonical handles. @@ -235,6 +243,7 @@ pub(super) fn type_layout( enum_types, aggregate_types, newtype_ids, + &nominal_types, &reserved_aggregates.arrays, &reserved_aggregates.records, &mut representations, @@ -244,6 +253,7 @@ pub(super) fn type_layout( enum_types, aggregate_types, newtype_ids, + &nominal_types, function_layout.function_types, reserved_aggregates, &mut representations, @@ -287,6 +297,7 @@ pub(super) fn type_layout( enum_types, aggregate_types, newtype_ids, + &nominal_types, &array_types, &record_types, &function_types, @@ -308,9 +319,8 @@ pub(super) fn type_layout( &function_types, module.span, )?; - let uses_control = module.types.iter().any(|ty| matches!(ty, - Type::Constructor(TypeConstructor::User(id)) if *id == HirTypeId::CONTROL || *id == HirTypeId::RESUMPTION)); - let control_layout = uses_control.then(|| control::append(&mut representations, function_slot)); + let control_layout = + uses_control.then(|| control::append(&mut representations, function_slot, &nominal_types)); let control_owner = match control_layout { Some(control) => control_contracts::append(module, &mut representations, control)?, None => None, @@ -322,6 +332,7 @@ pub(super) fn type_layout( array_types, record_types, constructor_types, + nominal_types, boxed_integer_type, boxed_number_type, function_types, @@ -340,6 +351,7 @@ pub(super) struct TypeLayout { pub(super) array_types: HashMap, pub(super) record_types: HashMap, pub(super) constructor_types: HashMap, + pub(super) nominal_types: HashMap, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, pub(super) function_types: HashMap, diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index 064a6e59..f0277a83 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -16,12 +16,14 @@ pub(crate) fn declaration_shape( enum_types: &HashSet, aggregate_types: &HashSet, newtype_ids: &HashSet, + nominal_types: &HashMap, array_types: &HashMap, record_types: &HashMap, function_types: &HashMap, ) -> Result> { let call = super::declaration_call_parts(module, declaration)?; let ty = call.result; + let nominal_result = nominal_shape(module, ty, nominal_types); let parameters = call .parameters .into_iter() @@ -33,12 +35,16 @@ pub(crate) fn declaration_shape( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, function_types, ) }) .collect::, _>>()?; + if let Some(result) = nominal_result { + return Ok(Signature { parameters, result }); + } if is_callable_type(module, ty) { return Ok(Signature { parameters, @@ -154,6 +160,7 @@ pub(crate) fn declaration_shape( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, function_types, @@ -179,6 +186,7 @@ pub(crate) fn declaration_shape( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, function_types, @@ -213,6 +221,7 @@ pub(crate) fn scalar_type( enum_types: &HashSet, aggregate_types: &HashSet, newtype_ids: &HashSet, + nominal_types: &HashMap, array_types: &HashMap, record_types: &HashMap, function_types: &HashMap, @@ -223,6 +232,9 @@ pub(crate) fn scalar_type( return callable_value_shape(module, id, span, function_types); } let id = unquantified_type(module, id); + if let Some(shape) = nominal_shape(module, id, nominal_types) { + return Ok(shape); + } if let Some(shape) = primitive_shape_of(module, id) { return Ok(shape); } @@ -293,6 +305,7 @@ pub(crate) fn scalar_type( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, function_types, @@ -318,6 +331,7 @@ pub(crate) fn scalar_type( enum_types, aggregate_types, newtype_ids, + nominal_types, array_types, record_types, function_types, @@ -393,3 +407,15 @@ pub(in crate::cc) fn is_abstract_type(module: &CoreModule, mut id: TypeId) -> bo } false } + +fn nominal_shape( + module: &CoreModule, + ty: TypeId, + nominal_types: &HashMap, +) -> Option { + let repr = nominal_types.get(&user_type_id(module, ty)?)?; + Some(ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Repr(*repr), + })) +} diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index 4829b3b6..54a11417 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -151,6 +151,7 @@ fn bound_rank_n_record_fields_do_not_make_dictionary_layout_dependent() { &HashSet::new(), &HashSet::new(), &HashMap::new(), + &HashMap::new(), &record_types, &HashMap::new(), ) diff --git a/crates/psrs-backend/src/cc/layout/tests/opaque.rs b/crates/psrs-backend/src/cc/layout/tests/opaque.rs index 35410083..2fa1aaa5 100644 --- a/crates/psrs-backend/src/cc/layout/tests/opaque.rs +++ b/crates/psrs-backend/src/cc/layout/tests/opaque.rs @@ -36,6 +36,7 @@ fn an_applied_opaque_foreign_type_uses_the_erased_reference() { &HashMap::new(), &HashMap::new(), &HashMap::new(), + &HashMap::new(), ) .expect("an applied opaque type should have a layout"); assert!(signature.parameters.is_empty()); diff --git a/crates/psrs-backend/src/cc/lower/call/application.rs b/crates/psrs-backend/src/cc/lower/call/application.rs index 0f3356e5..58dc599c 100644 --- a/crates/psrs-backend/src/cc/lower/call/application.rs +++ b/crates/psrs-backend/src/cc/lower/call/application.rs @@ -175,6 +175,7 @@ impl FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 617cbc88..4e36a407 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -13,6 +13,7 @@ mod builder; mod executor; mod fields; mod lifetime; +mod operands; mod owned; mod replay; mod scope; @@ -90,10 +91,7 @@ impl FunctionLowerer<'_> { "control use has no predeclared checked contract", ) })?; - let fields = arguments - .iter() - .map(|argument| self.lower_array_element(argument, assignments)) - .collect::, _>>()?; + let fields = self.lower_control_operands(contract, arguments, assignments)?; let (value, implementation) = self.lower_control_frame(expression, intrinsic, fields.clone(), ty, assignments)?; let destination = self.fresh(ty); @@ -147,22 +145,13 @@ impl FunctionLowerer<'_> { }); return Ok((unit, result)); } - let conversion = self.recover_payload(ty, expression.span)?; - let source = builder::repr(layout.owner); - return Ok(( - self.emit_conversion( - result, - source, - ty, - crate::cc::ValueConversion::Sequence(vec![ - crate::cc::ValueConversion::EraseReference, - conversion, - ]), + if ty != builder::repr(layout.owner) { + return Err(control_error( expression.span, - assignments, - ), - result, - )); + "resumption result has no nominal owner shape", + )); + } + return Ok((result, result)); } if intrinsic == Intrinsic::ControlRun { let functions = self.ensure_control_functions(layout, expression.span)?; diff --git a/crates/psrs-backend/src/cc/lower/control/operands.rs b/crates/psrs-backend/src/cc/lower/control/operands.rs new file mode 100644 index 00000000..8891925d --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/operands.rs @@ -0,0 +1,109 @@ +//! Lower each source operand into its predeclared storage role. + +use super::{FunctionLowerer, control_error}; +use crate::BackendError; +use crate::cc::control_contract::ControlImplementation; +use crate::cc::payload::{PayloadPlanner, erased_shape}; +use crate::cc::{ + Assignment, ControlContractId, RefShape, Reference, Representation, ValueId, ValueShape, +}; +use psrs_core::Expr; + +impl FunctionLowerer<'_> { + pub(super) fn lower_control_operands( + &mut self, + contract: ControlContractId, + arguments: &[Expr], + assignments: &mut Vec, + ) -> Result, Vec> { + let proof = &self.representations.control_contracts[contract.0 as usize]; + let shapes = match proof.implementation { + ControlImplementation::Frame { + representation, + case, + } => { + let Some(Representation::Variant { cases }) = + self.representations.representation(representation) + else { + return Err(control_error( + self.module.span, + "control operand plan has no variant", + )); + }; + cases + .iter() + .find(|candidate| candidate.tag == case) + .map(|case| case.fields.clone()) + .ok_or_else(|| { + control_error(self.module.span, "control operand plan has no case") + })? + } + ControlImplementation::Call { signature, .. } => self + .representations + .signature(signature) + .ok_or_else(|| { + control_error(self.module.span, "control operand plan has no signature") + })? + .parameters + .iter() + .take(arguments.len()) + .copied() + .collect(), + }; + if shapes.len() != arguments.len() { + return Err(control_error( + self.module.span, + "control operand plan has an incompatible count", + )); + } + arguments + .iter() + .zip(shapes) + .map(|(argument, target)| { + if target == erased_shape() { + return self.lower_array_element(argument, assignments); + } + let source = self.value_shape(argument.ty, argument.span)?; + let value = self.lower_value(argument, assignments)?; + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(_), + .. + }) = target + { + let ValueShape::Reference(Reference { + heap: RefShape::Closure(signature), + .. + }) = source + else { + return Err(control_error( + argument.span, + "control callback has no callable representation", + )); + }; + let plan = self.payload_callable(signature, true, argument.span)?; + if plan.output_shape(source) != target { + return Err(control_error( + argument.span, + "control callback disagrees with its unary protocol", + )); + } + return Ok(self.emit_conversion( + value, + source, + target, + plan, + argument.span, + assignments, + )); + } + if source != target { + return Err(control_error( + argument.span, + "control carrier disagrees with its nominal representation", + )); + } + Ok(value) + }) + .collect() + } +} diff --git a/crates/psrs-backend/src/cc/lower/conversion/mod.rs b/crates/psrs-backend/src/cc/lower/conversion/mod.rs index 10bdfb15..6edfdf13 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/mod.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/mod.rs @@ -42,6 +42,7 @@ impl FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, diff --git a/crates/psrs-backend/src/cc/lower/conversion/tests.rs b/crates/psrs-backend/src/cc/lower/conversion/tests.rs index 692d6e9b..4815b0dc 100644 --- a/crates/psrs-backend/src/cc/lower/conversion/tests.rs +++ b/crates/psrs-backend/src/cc/lower/conversion/tests.rs @@ -49,6 +49,7 @@ fn unsupported_typed_boundary_reports_its_source_span() { enum_types: &ids, aggregate_types: &ids, newtype_ids: &ids, + nominal_types: &std::collections::HashMap::new(), boxed_integer_type: None, boxed_number_type: None, control_layout: None, diff --git a/crates/psrs-backend/src/cc/lower/erased/curried.rs b/crates/psrs-backend/src/cc/lower/erased/curried.rs index e392e57d..10885a82 100644 --- a/crates/psrs-backend/src/cc/lower/erased/curried.rs +++ b/crates/psrs-backend/src/cc/lower/erased/curried.rs @@ -54,6 +54,7 @@ impl FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, diff --git a/crates/psrs-backend/src/cc/lower/erased/mod.rs b/crates/psrs-backend/src/cc/lower/erased/mod.rs index 4610897c..733b2c9f 100644 --- a/crates/psrs-backend/src/cc/lower/erased/mod.rs +++ b/crates/psrs-backend/src/cc/lower/erased/mod.rs @@ -106,6 +106,7 @@ impl FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, @@ -116,6 +117,7 @@ impl FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index e3668ea1..e303af91 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -82,6 +82,7 @@ impl LambdaLowering for FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, @@ -116,6 +117,7 @@ impl LambdaLowering for FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, @@ -315,6 +317,7 @@ impl LambdaLowering for FunctionLowerer<'_> { enum_types: self.enum_types, aggregate_types: self.aggregate_types, newtype_ids: self.newtype_ids, + nominal_types: self.nominal_types, boxed_integer_type: self.boxed_integer_type, boxed_number_type: self.boxed_number_type, control_layout: self.control_layout, diff --git a/crates/psrs-backend/src/cc/lower/letrec/mod.rs b/crates/psrs-backend/src/cc/lower/letrec/mod.rs index 9e30ab23..93d8d3bd 100644 --- a/crates/psrs-backend/src/cc/lower/letrec/mod.rs +++ b/crates/psrs-backend/src/cc/lower/letrec/mod.rs @@ -372,6 +372,7 @@ fn scalar_shape( lowerer.enum_types, lowerer.aggregate_types, lowerer.newtype_ids, + lowerer.nominal_types, lowerer.array_types, lowerer.record_types, lowerer.function_types, diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index 9a2c260d..a38b45b4 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -45,6 +45,7 @@ pub(super) struct LoweringContext<'a> { pub(super) enum_types: &'a HashSet, pub(super) aggregate_types: &'a HashSet, pub(super) newtype_ids: &'a HashSet, + pub(super) nominal_types: &'a HashMap, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, pub(super) control_layout: Option, @@ -80,6 +81,7 @@ pub(super) fn lower_function( enum_types: context.enum_types, aggregate_types: context.aggregate_types, newtype_ids: context.newtype_ids, + nominal_types: context.nominal_types, boxed_integer_type: context.boxed_integer_type, boxed_number_type: context.boxed_number_type, control_layout: context.control_layout, @@ -118,6 +120,7 @@ pub(super) fn lower_function( context.enum_types, context.aggregate_types, context.newtype_ids, + context.nominal_types, context.array_types, context.record_types, context.function_types, @@ -156,6 +159,7 @@ pub(super) fn lower_function( context.enum_types, context.aggregate_types, context.newtype_ids, + context.nominal_types, context.array_types, context.record_types, context.function_types, @@ -182,6 +186,7 @@ pub(super) fn lower_function( context.enum_types, context.aggregate_types, context.newtype_ids, + context.nominal_types, context.array_types, context.record_types, context.function_types, @@ -229,6 +234,7 @@ pub(super) struct FunctionLowerer<'a> { pub(super) enum_types: &'a HashSet, pub(super) aggregate_types: &'a HashSet, pub(super) newtype_ids: &'a HashSet, + pub(super) nominal_types: &'a HashMap, pub(super) boxed_integer_type: Option, pub(super) boxed_number_type: Option, pub(super) control_layout: Option, @@ -286,6 +292,7 @@ impl FunctionLowerer<'_> { self.enum_types, self.aggregate_types, self.newtype_ids, + self.nominal_types, self.array_types, self.record_types, self.function_types, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index fbe7b3cd..22221e87 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -319,12 +319,7 @@ pub(crate) fn lower_module_with_relations( } let newtype_ids = module.newtype_ids.iter().copied().collect(); let enum_types = enum_type_ids(&module, &newtype_ids); - let mut aggregate_types = aggregate_type_ids(&module, &newtype_ids); - // `Prim.Control`'s `Control f a` is an opaque aggregate: the layout reserves - // its frame representation, and its shape is the erased aggregate reference - // so this slice needs no `scalar_type` change. - aggregate_types.insert(HirTypeId::CONTROL); - aggregate_types.insert(HirTypeId::RESUMPTION); + let aggregate_types = aggregate_type_ids(&module, &newtype_ids); let mut layout = type_layout(&module, &enum_types, &aggregate_types, &newtype_ids)?; let mut constructor_tags = HashMap::new(); let mut constructors_by_type: HashMap> = HashMap::new(); @@ -343,6 +338,7 @@ pub(crate) fn lower_module_with_relations( &enum_types, &aggregate_types, &newtype_ids, + &layout.nominal_types, &layout.array_types, &layout.record_types, &layout.function_types, @@ -404,6 +400,7 @@ pub(crate) fn lower_module_with_relations( &enum_types, &aggregate_types, &newtype_ids, + &layout.nominal_types, &layout.array_types, &layout.record_types, &layout.function_types, @@ -453,6 +450,7 @@ pub(crate) fn lower_module_with_relations( enum_types: &enum_types, aggregate_types: &aggregate_types, newtype_ids: &newtype_ids, + nominal_types: &layout.nominal_types, boxed_integer_type: layout.boxed_integer_type, boxed_number_type: layout.boxed_number_type, control_layout: layout.control_layout, diff --git a/crates/psrs-backend/src/cc/verify/ops/control.rs b/crates/psrs-backend/src/cc/verify/ops/control.rs index f71387cf..c57837ca 100644 --- a/crates/psrs-backend/src/cc/verify/ops/control.rs +++ b/crates/psrs-backend/src/cc/verify/ops/control.rs @@ -45,6 +45,22 @@ pub(super) fn verify( "control evidence changes its runtime result shape", )); } + let carrier_shape = match proof.implementation { + ControlImplementation::Frame { representation, .. } => { + Some(super::super::helpers::repr_shape(representation)) + } + ControlImplementation::Call { + signature, + role: crate::cc::ControlHelperRole::Once, + } => table.signature(signature).map(|signature| signature.result), + _ => None, + }; + if carrier_shape.is_some_and(|shape| declared.get(value).copied() != Some(shape)) { + return Err(assignment_error( + assignment, + "control carrier result must retain its nominal representation", + )); + } let definition = assignments .iter() .find(|candidate| candidate.destination == *implementation) diff --git a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs index fb108b2a..7988cdd6 100644 --- a/crates/psrs-backend/src/cc/verify/tests/control_calls.rs +++ b/crates/psrs-backend/src/cc/verify/tests/control_calls.rs @@ -62,7 +62,8 @@ fn control_helper_calls_reject_erased_and_cross_wired_machine_arguments() { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); for (id, argument, wrong) in [ ( layout.executor, @@ -112,7 +113,8 @@ fn control_replay_result_cannot_be_declared_as_an_erased_user_pair() { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); let signature = table.signature(layout.clone_sequence).unwrap(); let signatures = HashMap::from([(symbol(1), signature.clone())]); let mut function = call_fixture(signature); @@ -134,7 +136,8 @@ fn mir_rejects_machine_call_arguments_with_swapped_queue_and_extent() { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); for (id, left, right) in [ (layout.executor, 3, 4), (layout.clone_sequence, 0, 3), @@ -185,7 +188,8 @@ fn raw_capture_module() -> Module { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); let span = TextRange::new(0, 1); let queue = reference(RefShape::Repr(layout.sequence)); let boundary = reference(RefShape::Repr(layout.boundary)); diff --git a/crates/psrs-backend/src/cc/verify/tests/control_frames.rs b/crates/psrs-backend/src/cc/verify/tests/control_frames.rs index b944d59c..9721c305 100644 --- a/crates/psrs-backend/src/cc/verify/tests/control_frames.rs +++ b/crates/psrs-backend/src/cc/verify/tests/control_frames.rs @@ -70,7 +70,8 @@ fn control_frames_reject_erased_or_wrong_machine_fields_in_cc() { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); for (representation, case, field, wrong) in [ (layout.computation, 3, 1, shape(layout.boundary)), (layout.computation, 4, 2, shape(layout.sequence)), @@ -103,7 +104,8 @@ fn control_frame_projection_cannot_silently_erase_checkpoint_identity() { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); let mut function = constructor(&table, layout.sequence, 3); let result = ValueId(function.values.len() as u32); function.values.push(ValueDecl { @@ -139,7 +141,8 @@ fn mir_preserves_control_frame_fields_and_rejects_cross_wired_storage() { parameters: vec![erased_shape()], result: erased_shape(), }); - let layout = control::append(&mut table, continuation); + let nominal_types = control::reserve(&mut table); + let layout = control::append(&mut table, continuation, &nominal_types); for (representation, case, left, right) in [ (layout.computation, 3, 1, 2), (layout.sequence, 3, 0, 1), diff --git a/crates/psrs-driver/src/tests/control_carriers.rs b/crates/psrs-driver/src/tests/control_carriers.rs new file mode 100644 index 00000000..6829b286 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_carriers.rs @@ -0,0 +1,201 @@ +//! Source carriers retain nominal shapes before control operand lowering. +use psrs_backend::cc::{ + Assignment, AssignmentKind, ControlHelperRole, Function, RefShape, ValueId, ValueShape, +}; +use psrs_hir::Intrinsic; + +const SOURCE: &str = include_str!("../../tests/control_support/nominal_carriers.purs"); + +fn shape(function: &Function, value: ValueId) -> ValueShape { + function + .values + .iter() + .find(|declaration| declaration.id == value) + .unwrap() + .ty +} + +fn visit(body: &[Assignment], callback: &mut impl FnMut(&Assignment)) { + for assignment in body { + callback(assignment); + match &assignment.kind { + AssignmentKind::If { + then_assignments, + else_assignments, + .. + } => { + visit(then_assignments, callback); + visit(else_assignments, callback); + } + AssignmentKind::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + visit(&case.assignments, callback); + } + visit(default_assignments, callback); + } + _ => {} + } + } +} + +#[test] +fn all_eight_operations_use_nominal_carriers_and_direct_callable_protocols() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let signature = |role| { + let helper = table + .control_helpers + .iter() + .find(|helper| helper.role() == role) + .unwrap(); + table.signature(helper.signature()).unwrap() + }; + let computation = signature(ControlHelperRole::Executor).parameters[2]; + let owner = signature(ControlHelperRole::Once).result; + let callable = signature(ControlHelperRole::Once).parameters[0]; + assert_ne!(computation, owner); + assert!( + matches!(computation, ValueShape::Reference(reference) if matches!(reference.heap, RefShape::Repr(_))) + ); + let erased = ValueShape::Reference(psrs_backend::cc::Reference { + nullable: false, + heap: RefShape::Erased, + }); + let mut operations = std::collections::HashSet::new(); + for function in &input.cc.functions { + visit(&function.assignments, &mut |assignment| { + let AssignmentKind::ControlEvidence { + contract, + arguments, + implementation, + value, + } = &assignment.kind + else { + return; + }; + let operation = table.control_contracts[contract.0 as usize].operation(); + operations.insert(operation); + let expected = match operation { + Intrinsic::ControlReturn | Intrinsic::ControlPerform => vec![erased], + Intrinsic::ControlBind => vec![computation, callable], + Intrinsic::ControlHandle => vec![callable, callable, computation], + Intrinsic::ControlRun => vec![erased, callable, computation], + Intrinsic::ControlOnce => vec![callable], + Intrinsic::ControlResume => vec![owner, erased], + Intrinsic::ControlCancel => vec![owner], + _ => unreachable!(), + }; + assert_eq!( + arguments + .iter() + .map(|value| shape(function, *value)) + .collect::>(), + expected + ); + // Frames and helpers consume the witnessed operands directly. + let producer = function + .assignments + .iter() + .find(|candidate| candidate.destination == *implementation) + .unwrap(); + let actual = match &producer.kind { + AssignmentKind::VariantNew { fields, .. } => fields, + AssignmentKind::DirectCall { arguments, .. } => arguments, + _ => unreachable!(), + }; + assert_eq!(&actual[..arguments.len()], arguments); + if operation == Intrinsic::ControlOnce { + assert_eq!(value, implementation); + assert_eq!(shape(function, *value), owner); + } + }); + } + assert_eq!(operations.len(), 8); + psrs_backend::compile_cc(input).unwrap(); +} + +#[test] +fn ordinary_parameters_results_and_join_values_keep_the_carrier_shape() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let expected = |role, parameter: Option| { + let helper = table + .control_helpers + .iter() + .find(|helper| helper.role() == role) + .unwrap(); + let signature = table.signature(helper.signature()).unwrap(); + parameter.map_or(signature.result, |index| signature.parameters[index]) + }; + for (name, carrier, count) in [ + ("keep", expected(ControlHelperRole::Executor, Some(2)), 1), + ("retain", expected(ControlHelperRole::Once, None), 1), + ("choose", expected(ControlHelperRole::Executor, Some(2)), 3), + ] { + let function = input + .cc + .functions + .iter() + .find(|function| function.name == name) + .unwrap(); + assert_eq!(function.parameters.len(), count); + assert_eq!(function.result_type, carrier); + assert_eq!( + shape(function, *function.parameters.last().unwrap()), + carrier + ); + if name == "choose" { + assert!(function.assignments.iter().any(|assignment| matches!( + assignment.kind, + AssignmentKind::If { .. } + ) && shape( + function, + assignment.destination + ) == carrier)); + } + } +} + +#[test] +fn cc_rejects_weakening_a_source_computation_to_an_abstract_aggregate() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let contracts = &input.cc.representations.control_contracts; + let (function, value, destination) = input + .cc + .functions + .iter_mut() + .find_map(|function| { + function + .assignments + .iter() + .find_map(|assignment| match &assignment.kind { + AssignmentKind::ControlEvidence { + contract, value, .. + } if contracts[contract.0 as usize].operation() == Intrinsic::ControlReturn => { + Some((*value, assignment.destination)) + } + _ => None, + }) + .map(|(value, destination)| (function, value, destination)) + }) + .unwrap(); + for declaration in &mut function.values { + if declaration.id == value || declaration.id == destination { + declaration.ty = ValueShape::Reference(psrs_backend::cc::Reference { + nullable: false, + heap: RefShape::Aggregate, + }); + } + } + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("control carrier result must retain its nominal representation")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_contracts.rs b/crates/psrs-driver/src/tests/control_contracts.rs index ba66631b..afc1f2e4 100644 --- a/crates/psrs-driver/src/tests/control_contracts.rs +++ b/crates/psrs-driver/src/tests/control_contracts.rs @@ -185,19 +185,26 @@ fn cc_rejects_a_same_shape_body_from_the_target_domain() { _ => None, }) .unwrap(); - let argument = match &function.assignments[index].kind { - AssignmentKind::ControlEvidence { arguments, .. } => arguments[2], + let implementation = match &mut function.assignments[index].kind { + AssignmentKind::ControlEvidence { + arguments, + implementation, + .. + } => { + arguments[2] = target; + *implementation + } _ => unreachable!(), }; - let erasure = function + let frame = function .assignments .iter_mut() - .find(|assignment| assignment.destination == argument) + .find(|assignment| assignment.destination == implementation) .unwrap(); - let AssignmentKind::AggregateConvert { value, .. } = &mut erasure.kind else { + let AssignmentKind::VariantNew { fields, .. } = &mut frame.kind else { unreachable!() }; - *value = target; + fields[2] = target; let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); assert!( errors.iter().any(|error| error @@ -213,19 +220,39 @@ fn cc_rejects_a_frame_that_does_not_save_the_proven_source_body() { let contracts = &input.cc.representations.control_contracts; let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().any(|assignment| matches!(&assignment.kind, AssignmentKind::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle))).unwrap(); - let (implementation, other) = function + let implementation = function .assignments .iter() .find_map(|assignment| match &assignment.kind { AssignmentKind::ControlEvidence { contract, implementation, - arguments, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle => { - Some((*implementation, arguments[0])) + Some(*implementation) + } + _ => None, + }) + .unwrap(); + let other = function + .assignments + .iter() + .find_map(|assignment| match &assignment.kind { + AssignmentKind::ControlEvidence { contract, .. } + if contracts[contract.0 as usize].operation() + == psrs_hir::Intrinsic::ControlReturn + && contracts[contract.0 as usize] + .target() + .is_some_and(|domain| { + domain.answer + == psrs_backend::cc::TypeIdentity::Constructor( + psrs_backend::cc::TypeConstructorIdentity::Boolean, + ) + }) => + { + Some(assignment.destination) } _ => None, }) @@ -238,16 +265,7 @@ fn cc_rejects_a_frame_that_does_not_save_the_proven_source_body() { let AssignmentKind::VariantNew { fields, .. } = &mut frame.kind else { unreachable!() }; - let cast = fields[2]; - let cast = function - .assignments - .iter_mut() - .find(|assignment| assignment.destination == cast) - .unwrap(); - let AssignmentKind::RepresentationCast { value, .. } = &mut cast.kind else { - unreachable!() - }; - *value = other; + fields[2] = other; let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); assert!( errors.iter().any(|error| error diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index b382e55b..607a5090 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -7,6 +7,7 @@ static WASM_ARTIFACT_COUNTER: AtomicU32 = AtomicU32::new(0); mod assertions; mod closure_protocol; mod coercion; +mod control_carriers; mod control_contracts; mod control_costs; mod control_finish_provenance; diff --git a/crates/psrs-driver/tests/control_carrier_runtime.rs b/crates/psrs-driver/tests/control_carrier_runtime.rs new file mode 100644 index 00000000..8530573d --- /dev/null +++ b/crates/psrs-driver/tests/control_carrier_runtime.rs @@ -0,0 +1,11 @@ +//! Nominal carriers compose with ordinary polymorphic and aggregate storage. +mod control_support; + +#[test] +fn control_and_owner_cross_generic_storage_without_changing_identity() { + control_support::execute( + "nominal-carriers", + include_str!("control_support/nominal_carriers.purs"), + 42, + ); +} diff --git a/crates/psrs-driver/tests/control_support/nominal_carriers.purs b/crates/psrs-driver/tests/control_support/nominal_carriers.purs new file mode 100644 index 00000000..d19ad6f5 --- /dev/null +++ b/crates/psrs-driver/tests/control_support/nominal_carriers.purs @@ -0,0 +1,25 @@ +module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +data Box a = Box a +unbox :: forall a. Box a -> a +unbox (Box value) = value +keep :: forall f a. C.Control f a -> C.Control f a +keep value = value +retain :: forall f x a. C.Resumption f x a -> C.Resumption f x a +retain value = value +apply :: forall a b. (a -> b) -> a -> b +apply function value = function value +choose :: forall f a. Boolean -> C.Control f a -> C.Control f a -> C.Control f a +choose flag left right = if flag then left else right +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Int +clause (Op k) raw = raw (k 40) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 0) } +main :: Int +main = let owner = retain (apply unbox (Box (C.once (\n -> C.return (intAdd n 2))))) + spare = C.once (\n -> C.return n) + cancelled = C.cancel spare + saved = { owner: owner, computation: C.perform (Op \x -> x) } + program = C.bind (choose true (apply keep saved.computation) (C.return 0)) (\n -> C.resume saved.owner n) + in (C.run 0 handler (C.handle (\n -> C.return n) clause program))._2 diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index b2c16a14..de6065ef 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. Complete producer/checkpoint/replay identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. Complete producer/checkpoint/replay identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 8a1ae033..8b4c3c41 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -177,11 +177,24 @@ predeclared unary callable shape. Only user requests, answers and the mutable callback-cell contents use erased storage. A spent owner clears its callback slot with another erased reference while its integer status cell stays shared. -The source carrier and user callback protocol use explicit reference casts to -recover these existing machine objects before construction. This is not source -payload recovery: adapting array contents here would copy a status cell and invalidate -ownership/lifetime sharing. Projections produce their declared stored shape; -erasure for a user callback is a separate conversion. CC verifies construction +P8 reserves the nominal representations of `Control f a` and +`Resumption f x a` before planning source signatures and aggregate fields. The +shared source-shape owner maps these carriers to computation and owner references, +including ordinary parameters, returned values, closure captures and joins. +Planning fills the reserved schemas and declares helper signatures before body +lowering; the representation table remains immutable during body lowering. + +Source control operands follow the predeclared frame or helper field schema. +Computation and owner operands pass directly as nominal references. User +callbacks are adapted directly to the unary callable protocol; user requests, +answers and state use the payload owner's recursive erasure. `once` returns its +nominal owner directly. An abstract generic storage slot still erases a carrier +and recovers its representation at a checked use. This storage boundary does not +reconstruct source request or answer types at runtime: those remain immutable +compile-time evidence. Private status and callback cells use identity-preserving +reference conversions; adapting their array contents would copy a shared cell +and invalidate ownership/lifetime sharing. Projections produce their declared +stored shape; erasure for a user callback is a separate conversion. CC verifies construction and projection shapes, and the target planner retains them as MIR struct field types, including recursive queue/context/extent references. @@ -213,7 +226,7 @@ Core's rigid equality, including alpha-equivalence and its existing row relation CC does not implement another effect type checker. At each source erasure boundary, `ControlEvidence` connects the immutable -contract to the represented result, original erased operands and actual frame +contract to the represented result, operands in their declared storage roles and actual frame construction or helper call. CC checks the predeclared frame case/representation or helper signature and ordered operands through reference erasure/recovery aliases. Frame results must be the proven construction. When an operand comes diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index a586fc11..e2c0b201 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1093,3 +1093,71 @@ remeasured; fingerprints, collection counts and maximum post-GC live bytes match the preceding helper slice. Explicit upstream type comparison, package conformance and scoreboards are not rerun for this internal invariant change. No measured gate number changes. + + +## Nominal source carrier entrance (2026-10-12) + +Starting point: compiler `35dbdf9d`, branch `feat/effect-handlers`, clean checkout. +Source `Control` and `Resumption` previously used the abstract aggregate shape, +and every primitive operand passed through array-element payload erasure before +recovery into its actual field. `once` also erased and recovered its owner result. +P8 now reserves both nominal carriers before source signatures and aggregate +normalization. The common source-shape operation propagates those identities to +parameters, results, records, arrays, constructor templates and closure captures. +The schemas and helper contracts are filled before immutable body lowering. + +Operand lowering consumes the checked contract's actual frame/helper schema. +Nominal computation and owner operands pass directly; callback adaptation targets +the existing unary protocol directly; user payloads retain recursive erasure. +`once` returns the nominal owner directly. Generic abstract storage legitimately +retains its own erasure/recovery boundary. No source intrinsic or runtime type +inference is added, and private mutable cell identity is preserved. + +| Requirement | Evidence | Status | +| --- | --- | --- | +| All eight primitive entrances use their declared operand roles | `all_eight_operations_use_nominal_carriers_and_direct_callable_protocols`; witnesses and actual factory operands are identical, and `once` returns its helper result directly | Focused Verified | +| Ordinary carrier parameters, returns and joins retain the nominal shape | `ordinary_parameters_results_and_join_values_keep_the_carrier_shape`, including polymorphic `keep`, `retain` and branch-producing `choose` | Focused Verified | +| Generic storage and higher-order calls compose with shared owner identity | `control_and_owner_cross_generic_storage_without_changing_identity`, mandatory Wasmtime, expected exit 42; generic `Box`, `apply`, record storage, request dispatch, owned resume and cancellation | Focused Verified | +| Reject source carrier results weakened to abstract aggregates | `cc_rejects_weakening_a_source_computation_to_an_abstract_aggregate`, common CC witness verifier | Focused Verified | +| Source-domain and frame-operand rejection survives removal of entrance casts | Existing malformed CC tests now substitute same-shaped computations directly, separately checking wrong source domain and disagreement between witness and saved frame body | Focused Verified | + +This removes the unconditional control-entrance round trip. It does not establish +complete source provenance across every higher-order/imported producer, exact +checkpoint/replay identity, foreign capture, caught-host-trap cleanup, upstream +library acceptance or remaining general allocation requirements. Full AE/AC rows +remain unverified. + +The six long ancestry/GC workloads are remeasured with the nominal entrance. +Collection counts and maximum post-GC live bytes match the preceding finish +slice; emitted component identities change. Each actual boundary allocation is +still instrumented, and the independent non-tail depth probes retain their +success/trap distinction. These are live-heap measurements, not exact total +allocation or general-program bounds. + +| Workload | Requests | Collections | Maximum post-GC live bytes | Component identity | +| --- | --- | --- | --- | --- | +| deep | 1000 | 94 | 1408 | `fnv1a64-v1:278d489ba3f752ac` | +| deep | 10000 | 941 | 1408 | `fnv1a64-v1:8fd6d2f9c4d55078` | +| deep | 100000 | 9411 | 1472 | `fnv1a64-v1:ff662465ed856c1c` | +| forwarded | 1000 | 393 | 1440 | `fnv1a64-v1:1c4e88a867b5987e` | +| forwarded | 10000 | 3934 | 1440 | `fnv1a64-v1:3fb0dd7cdfd36c28` | +| forwarded | 100000 | 39344 | 1440 | `fnv1a64-v1:7503867b1a999a07` | + +Validation: the three new structural/malformed-IR driver tests and one new +runtime integration pass. Final `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace +--no-fail-fast` passes all 435 backend tests, 95 Core tests, 81 control integration +tests and the existing ancestry/GC and no-tail-call execution probes. Driver +library results are 541 passed and 162 failed. The same nine failing targets and +175 failed test names match `35dbdf9d`, with no added or recovered names. This +compares failure names, not every baseline cause. The final run's doctest targets +pass; an earlier concurrent build reported unavailable dependency artifacts and +is not the final validation result. + +`cargo fmt --all --check` and `git diff --check` pass. Logs and comparison: +`/private/tmp/psrs-nominal-new.log`, +`/private/tmp/psrs-nominal-workspace-final.log`, and +`/private/tmp/psrs-nominal-comparison.json`. Final +`cargo clippy --workspace --all-targets -- -D warnings` passes; its log is +`/private/tmp/psrs-nominal-clippy-final.log`. Explicit upstream type comparison, +package conformance and suite scoreboards are not rerun for this internal layout +change. No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index c4ffcfdb..79e1bd30 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -12,7 +12,7 @@ sequencing, clause scope, library deep/shallow policies, and ownership/lifetime This topic commit implements DEC-20 control contract v2. The compiler lock pins stdlib `5d523805c4e2096e68fab5a4f965f62b225ee2af` with content identity -`fnv1a64-v1:a1e5a2f8f4157041`. All 80 control tests pass under default locked package +`fnv1a64-v1:a1e5a2f8f4157041`. All 81 control integration tests pass under default locked package selection with mandatory Wasmtime; the official type comparison and nine public package fixtures are recorded in the v2 checklist. Historical sections below preserve prior checkpoints; the five-argument API belongs to those checkpoints. @@ -48,6 +48,14 @@ optimized MIR: close, restored queue and restored parent must use one finish record. A check or omitted close cannot replace completion. Nine new provenance and identity-alias tests pass. Finish production, checkpoint identity and replay activation ancestry still need their complete semantic proofs. +The continuation from `35dbdf9d` reserves nominal source carrier representations +before signature and aggregate planning. Ordinary `Control`/`Resumption` +parameters, results, captures and joins use the same computation/owner schema. +Source operands follow the actual frame/helper storage roles: nominal carriers +pass directly, callbacks adapt directly to the unary protocol, and user payloads +use recursive erasure. The `once` result no longer erases and recovers its owner. +Generic abstract storage still erases carriers at its explicit boundary. The +checklist records structural and runtime evidence for this change separately. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From f9e9e14e4dffd11405a12c8a4f9b826c1ece6d35 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 13:08:56 +0800 Subject: [PATCH 114/148] fix(backend): verify raw resumption checkpoint ownership --- crates/psrs-backend/src/cc/control_helpers.rs | 47 ++ .../psrs-backend/src/cc/lower/control/mod.rs | 4 + crates/psrs-backend/src/cc/mod.rs | 4 +- crates/psrs-backend/src/cc/representation.rs | 1 + crates/psrs-backend/src/cc/value_identity.rs | 33 ++ .../src/cc/verify/control_checkpoints.rs | 231 +++++++++ .../src/cc/verify/control_provenance.rs | 17 +- crates/psrs-backend/src/cc/verify/mod.rs | 2 + .../psrs-backend/src/cc/verify/ops/table.rs | 28 + crates/psrs-backend/src/control_provenance.rs | 29 ++ crates/psrs-backend/src/mir/cfg.rs | 65 +++ .../src/mir/control_checkpoints.rs | 296 +++++++++++ crates/psrs-backend/src/mir/mod.rs | 1 + .../psrs-backend/src/mir/verify/function.rs | 67 +-- crates/psrs-backend/src/mir/verify/mod.rs | 1 + .../src/tests/control_checkpoint_ordering.rs | 46 ++ .../src/tests/control_checkpoints.rs | 479 ++++++++++++++++++ crates/psrs-driver/src/tests/mod.rs | 2 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 32 ++ .../backend/algebraic-effects.md | 60 +++ ...ted-control-lowering-handoff-2026-10-11.md | 9 + 22 files changed, 1372 insertions(+), 84 deletions(-) create mode 100644 crates/psrs-backend/src/cc/verify/control_checkpoints.rs create mode 100644 crates/psrs-backend/src/mir/control_checkpoints.rs create mode 100644 crates/psrs-driver/src/tests/control_checkpoint_ordering.rs create mode 100644 crates/psrs-driver/src/tests/control_checkpoints.rs diff --git a/crates/psrs-backend/src/cc/control_helpers.rs b/crates/psrs-backend/src/cc/control_helpers.rs index d6721443..2c836b7b 100644 --- a/crates/psrs-backend/src/cc/control_helpers.rs +++ b/crates/psrs-backend/src/cc/control_helpers.rs @@ -97,3 +97,50 @@ impl super::RepresentationTable { Ok(()) } } + +/// The raw resumption code target is planned separately from direct-call helpers. +/// Its callable protocol excludes the hidden capture receiver parameter. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct ControlResumptionContract { + pub(super) function: SymbolId, + pub(super) signature: SignatureId, +} + +impl ControlResumptionContract { + pub fn function(&self) -> SymbolId { + self.function + } + pub fn signature(&self) -> SignatureId { + self.signature + } +} + +#[derive(Clone, Copy)] +pub(crate) struct ControlCheckpointSchema { + pub computation: super::ReprId, + pub context: super::ReprId, +} + +impl super::RepresentationTable { + pub(crate) fn control_checkpoint_schema(&self) -> Option { + let parameter = |role, index| { + let helper = self + .control_helpers + .iter() + .find(|helper| helper.role() == role)?; + let super::ValueShape::Reference(reference) = + *self.signature(helper.signature())?.parameters.get(index)? + else { + return None; + }; + let super::RefShape::Repr(repr) = reference.heap else { + return None; + }; + Some(repr) + }; + Some(ControlCheckpointSchema { + computation: parameter(ControlHelperRole::Executor, 2)?, + context: parameter(ControlHelperRole::Executor, 5)?, + }) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 4e36a407..fd0626aa 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -368,6 +368,10 @@ pub(in crate::cc) fn plan_control_helpers( once: allocator.fresh(owner), cancel: allocator.fresh(owner), }; + layout.representations.control_resumption = Some(crate::cc::ControlResumptionContract { + function: functions.resume, + signature: control.continuation, + }); for (function, signature, role) in functions.contracts(control) { layout .representations diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 22221e87..dca9e412 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -15,7 +15,9 @@ pub use control_contract::{ ControlContract, ControlContractId, ControlDomain, SourceTypeIdentityId, TypeConstructorIdentity, TypeIdentity, }; -pub use control_helpers::{ControlHelperContract, ControlHelperId, ControlHelperRole}; +pub use control_helpers::{ + ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, +}; mod convert; mod layout; mod lower; diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index b32fe2a1..7ca958ca 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -227,6 +227,7 @@ fn storage_case( pub struct RepresentationTable { /// Semantic helper bindings are fixed before any function body is lowered. pub control_helpers: Vec, + pub control_resumption: Option, /// Source control contracts are predeclared by layout, before lowering /// emits any factory or executor bodies. pub control_contracts: Vec, diff --git a/crates/psrs-backend/src/cc/value_identity.rs b/crates/psrs-backend/src/cc/value_identity.rs index d97dbd9d..0abe5e2f 100644 --- a/crates/psrs-backend/src/cc/value_identity.rs +++ b/crates/psrs-backend/src/cc/value_identity.rs @@ -32,3 +32,36 @@ fn transparent(conversion: &ValueConversion) -> bool { _ => false, } } + +/// Index definitions across every nested assignment sequence, without guessing +/// identities from spans or names. +pub(crate) fn definitions( + body: &[super::Assignment], +) -> std::collections::HashMap { + let mut definitions = std::collections::HashMap::new(); + let mut pending = vec![body]; + while let Some(body) = pending.pop() { + for assignment in body { + definitions.insert(assignment.destination, &assignment.kind); + match &assignment.kind { + AssignmentKind::If { + then_assignments, + else_assignments, + .. + } => { + pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]); + } + AssignmentKind::TagSwitch { + cases, + default_assignments, + .. + } => { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + _ => {} + } + } + } + definitions +} diff --git a/crates/psrs-backend/src/cc/verify/control_checkpoints.rs b/crates/psrs-backend/src/cc/verify/control_checkpoints.rs new file mode 100644 index 00000000..d2fc6183 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control_checkpoints.rs @@ -0,0 +1,231 @@ +//! Validate actual checkpoint capture, raw-frame construction and replay checks. +use crate::BackendError; +use crate::cc::{ + Assignment, AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, +}; +use crate::control_provenance::{ + CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, +}; +use std::collections::HashMap; + +type Definitions<'a> = HashMap; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + let Some(raw) = &table.control_resumption else { + return Ok(()); + }; + let schema = table + .control_checkpoint_schema() + .ok_or_else(|| error(function, "raw resumption has no checkpoint schema"))?; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = |value| origin(value, &definitions); + let executor = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + .unwrap() + .function(); + if function.symbol == executor && function.parameters.len() != 6 { + return Err(error( + function, + "control executor has an invalid parameter contract", + )); + } + if function.symbol == raw.function() { + if function.parameters.len() != 2 { + return Err(error( + function, + "raw resumption has an invalid parameter contract", + )); + } + let result = origin(function.result); + let Some(A::VariantNew { + representation, + case: 3, + fields, + .. + }) = definitions.get(&result).copied() + else { + return Err(error( + function, + "raw resumption must return its saved Resume frame", + )); + }; + if *representation != schema.computation + || fields.len() != 3 + || origin(fields[0]) != function.parameters[1] + { + return Err(error( + function, + "raw resumption frame has an invalid answer or schema", + )); + } + checkpoint_capture_relation( + function.parameters[0], + capture(fields[1], &definitions), + capture(fields[2], &definitions), + ) + .map_err(|message| error(function, message))?; + let position = function + .assignments + .iter() + .position(|assignment| assignment.destination == result) + .ok_or_else(|| { + error( + function, + "raw resumption frame has no checked construction sequence", + ) + })?; + require_check( + function, + table, + &function.assignments[..position], + origin(fields[2]), + &definitions, + )?; + } + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for (index, assignment) in body.iter().enumerate() { + match &assignment.kind { + A::If { + then_assignments, + else_assignments, + .. + } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), + A::TagSwitch { + cases, + default_assignments, + .. + } => { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + A::FunctionRef { + function: target, + signature, + captures, + } if *target == raw.function() => { + if function.symbol != executor + || function.parameters.len() != 6 + || captures.len() != 2 + || *signature != raw.signature() + || origin(captures[0]) != function.parameters[3] + { + return Err(error( + function, + "raw resumption factory must capture the executor's current queue", + )); + } + let projection = match definitions.get(&origin(captures[1])).copied() { + Some(A::VariantGet { + representation, + case, + field, + value, + .. + }) if *representation == schema.context => { + Some((origin(*value), *case, *field)) + } + _ => None, + }; + dispatch_checkpoint_relation(function.parameters[5], projection) + .map_err(|message| error(function, message))?; + } + A::DirectCall { + contract: Some(contract), + arguments, + .. + } if function.symbol == executor + && table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::CloneSequence) => + { + let Some(saved) = arguments.first() else { + return Err(error(function, "replay has no saved queue")); + }; + let Some(A::VariantGet { + representation, + case: 3, + field: 1, + value, + .. + }) = definitions.get(&origin(*saved)).copied() + else { + return Err(error( + function, + "replay must use the Resume frame's saved queue", + )); + }; + if *representation != schema.computation + || origin(*value) != function.parameters[2] + { + return Err(error(function, "replay must use the current Resume frame")); + } + let checkpoint = body[..index] + .iter() + .find_map(|assignment| match &assignment.kind { + A::VariantGet { + representation, + case: 3, + field: 2, + value: owner, + .. + } if *representation == schema.computation + && origin(*owner) == origin(*value) => + { + Some(origin(assignment.destination)) + } + _ => None, + }) + .ok_or_else(|| { + error(function, "replay has no current Resume checkpoint") + })?; + require_check(function, table, &body[..index], checkpoint, &definitions)?; + } + _ => {} + } + } + } + Ok(()) +} + +fn origin(value: ValueId, definitions: &Definitions<'_>) -> ValueId { + crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) +} + +fn capture(value: ValueId, definitions: &Definitions<'_>) -> Option { + match definitions.get(&origin(value, definitions)).copied()? { + A::ClosureGetCapture { closure, index } => Some(CaptureProjection { + receiver: origin(*closure, definitions), + slot: *index, + }), + _ => None, + } +} + +fn require_check( + function: &Function, + table: &RepresentationTable, + prefix: &[Assignment], + checkpoint: ValueId, + definitions: &Definitions<'_>, +) -> Result<(), Vec> { + if prefix.iter().any(|assignment| matches!(&assignment.kind, + A::DirectCall { contract: Some(contract), arguments, .. } + if table.control_helpers.get(contract.0 as usize).is_some_and(|helper| helper.role() == R::Check) + && arguments.len() == 1 && origin(arguments[0], definitions) == checkpoint)) { + Ok(()) + } else { Err(error(function, "resumption must check its saved checkpoint before construction or replay")) } +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC control checkpoint", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/control_provenance.rs b/crates/psrs-backend/src/cc/verify/control_provenance.rs index 9cc9d0b8..58815830 100644 --- a/crates/psrs-backend/src/cc/verify/control_provenance.rs +++ b/crates/psrs-backend/src/cc/verify/control_provenance.rs @@ -24,22 +24,7 @@ pub(super) fn verify( "control executor has no checked sequence schema", ) })?; - let mut definitions = HashMap::new(); - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for assignment in body { - definitions.insert(assignment.destination, &assignment.kind); - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &assignment.kind - { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - } - } + let definitions = crate::cc::value_identity::definitions(&function.assignments); let mut pending = vec![function.assignments.as_slice()]; while let Some(body) = pending.pop() { for (index, assignment) in body.iter().enumerate() { diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 22d848c1..f8bf0c28 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -5,6 +5,7 @@ use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; mod adaptation; +mod control_checkpoints; mod control_provenance; mod helpers; mod ops; @@ -200,6 +201,7 @@ fn verify_function_inner( function.span, &function.name, )?; + control_checkpoints::verify(function, representations)?; if !available.contains(&function.result) { return Err(vec![BackendError::invalid_ir( "P8 CC verification", diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index bb09424e..3ec6c4fd 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -31,6 +31,34 @@ pub(crate) fn verify_table( "control machine is missing a required semantic helper", )); } + if !table.control_helpers.is_empty() { + let valid = table.control_resumption.as_ref().is_some_and(|resume| { + !helpers.contains(&resume.function()) + && table.signature(resume.signature()).is_some() + && table.control_checkpoint_schema().is_some() + && table + .control_helpers + .iter() + .find(|helper| helper.role() == crate::cc::ControlHelperRole::Once) + .and_then(|helper| table.signature(helper.signature())) + .and_then(|signature| signature.parameters.first()) + == Some(&crate::cc::ValueShape::Reference(crate::cc::Reference { + nullable: false, + heap: crate::cc::RefShape::Closure(resume.signature()), + })) + }); + if !valid { + return Err(table_error( + span, + "control machine has no valid raw resumption binding", + )); + } + } else if table.control_resumption.is_some() { + return Err(table_error( + span, + "raw resumption binding has no control helper schema", + )); + } for proof in &table.control_contracts { if proof.argument_identities().len() != proof.arguments().len() || std::iter::once(&proof.result_identity()) diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control_provenance.rs index e29c0302..989559af 100644 --- a/crates/psrs-backend/src/control_provenance.rs +++ b/crates/psrs-backend/src/control_provenance.rs @@ -32,3 +32,32 @@ pub(crate) fn finish_relation( } Ok(()) } + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) struct CaptureProjection { + pub receiver: ValueId, + pub slot: u32, +} + +pub(crate) fn checkpoint_capture_relation( + receiver: ValueId, + queue: Option, + checkpoint: Option, +) -> Result<(), &'static str> { + if queue != Some(CaptureProjection { receiver, slot: 0 }) + || checkpoint != Some(CaptureProjection { receiver, slot: 1 }) + { + return Err("raw resumption must save its own queue and checkpoint capture slots"); + } + Ok(()) +} + +pub(crate) fn dispatch_checkpoint_relation( + context: ValueId, + projection: Option<(ValueId, u32, u32)>, +) -> Result<(), &'static str> { + match projection { + Some((owner, 0, 0) | (owner, 1, 5)) if owner == context => Ok(()), + _ => Err("raw resumption must capture its current dispatch context checkpoint"), + } +} diff --git a/crates/psrs-backend/src/mir/cfg.rs b/crates/psrs-backend/src/mir/cfg.rs index ade19a4e..92682e99 100644 --- a/crates/psrs-backend/src/mir/cfg.rs +++ b/crates/psrs-backend/src/mir/cfg.rs @@ -121,6 +121,71 @@ fn block_distances(by_id: &HashMap, entry: BlockId) -> Has distances } +/// Block dominators shared by SSA and lifecycle verification. +pub(crate) fn dominators(function: &Function) -> HashMap> { + let entry = function.entry; + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + let all = blocks.keys().copied().collect::>(); + let mut predecessors = blocks + .keys() + .copied() + .map(|id| (id, HashSet::new())) + .collect::>>(); + for block in blocks.values() { + let Some(terminator) = &block.terminator else { + continue; + }; + for successor in successors(terminator) { + if let Some(preds) = predecessors.get_mut(&successor) { + preds.insert(block.id); + } + } + } + + let mut dominators = blocks + .keys() + .copied() + .map(|id| { + let initial = if id == entry { + HashSet::from([entry]) + } else { + all.clone() + }; + (id, initial) + }) + .collect::>(); + loop { + let mut changed = false; + for id in blocks.keys().copied().filter(|id| *id != entry) { + let mut next = all.clone(); + if let Some(preds) = predecessors.get(&id) { + if preds.is_empty() { + next.clear(); + } else { + for pred in preds { + if let Some(pred_dominators) = dominators.get(pred) { + next.retain(|candidate| pred_dominators.contains(candidate)); + } + } + } + } + next.insert(id); + if dominators.get(&id) != Some(&next) { + dominators.insert(id, next); + changed = true; + } + } + if !changed { + break; + } + } + dominators +} + #[cfg(test)] mod tests { use super::*; diff --git a/crates/psrs-backend/src/mir/control_checkpoints.rs b/crates/psrs-backend/src/mir/control_checkpoints.rs new file mode 100644 index 00000000..bd4f40d8 --- /dev/null +++ b/crates/psrs-backend/src/mir/control_checkpoints.rs @@ -0,0 +1,296 @@ +//! Preserve checkpoint ownership after physical projection and loop conversion. +use super::{Function, Instruction as I, Module, Terminator as T}; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control_provenance::{ + CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, +}; +use crate::types::{DefinedTypeId, ValueId}; +use std::collections::HashMap; + +type Definitions<'a> = HashMap; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let Some(raw) = &table.control_resumption else { + return; + }; + let Some(executor) = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + else { + return; + }; + if !module + .functions + .iter() + .any(|function| function.symbol == raw.function() || function.symbol == executor.function()) + { + return; + } + let Some(schema) = table.control_checkpoint_schema() else { + errors.push(BackendError::invalid_ir( + "P9 MIR control checkpoint", + module.span, + "raw resumption has no checkpoint schema", + )); + return; + }; + let types = ( + layout.variant_index(schema.computation, 3), + layout.variant_index(schema.context, 0), + layout.variant_index(schema.context, 1), + layout.signature_index(raw.signature()), + ); + let (Ok(resume), Ok(root), Ok(scope), Ok(callable)) = types else { + errors.push(BackendError::invalid_ir( + "P9 MIR control checkpoint", + module.span, + "raw resumption schema has no physical layout", + )); + return; + }; + for function in &module.functions { + if let Err(message) = verify_function( + function, + table, + raw, + executor.function(), + resume, + root, + scope, + callable, + ) { + errors.push( + BackendError::invalid_ir("P9 MIR control checkpoint", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} + +#[allow(clippy::too_many_arguments)] +fn verify_function( + function: &Function, + table: &crate::cc::RepresentationTable, + raw: &crate::cc::ControlResumptionContract, + executor: psrs_hir::SymbolId, + resume: DefinedTypeId, + root: DefinedTypeId, + scope: DefinedTypeId, + callable: DefinedTypeId, +) -> Result<(), &'static str> { + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| { + instruction + .destination() + .map(|destination| (destination, instruction)) + }) + .collect::>(); + let origin = |value| origin(value, &definitions); + let dominators = super::cfg::dominators(function); + let parameters = loop_parameters(function); + if function.symbol == executor && parameters.len() != 6 { + return Err("control executor has an invalid parameter contract"); + } + if function.symbol == raw.function() { + if parameters.len() != 2 { + return Err("raw resumption has an invalid parameter contract"); + } + let result = origin(function.result); + let Some(I::StructNew { + type_index, + arguments, + .. + }) = definitions.get(&result).copied() + else { + return Err("raw resumption must return its saved Resume frame"); + }; + if *type_index != resume + || arguments.len() != 4 + || origin(arguments[1]) != parameters[1] + || !matches!( + definitions.get(&origin(arguments[0])).copied(), + Some(I::Constant { value: 3, .. }) + ) + { + return Err("raw resumption frame has an invalid answer or schema"); + } + checkpoint_capture_relation( + parameters[0], + capture(arguments[2], &definitions), + capture(arguments[3], &definitions), + )?; + let point = function + .blocks + .iter() + .find_map(|block| { + block + .instructions + .iter() + .position(|instruction| instruction.destination() == Some(result)) + .map(|index| (block.id, index)) + }) + .ok_or("raw resumption frame has no checked construction sequence")?; + require_check( + function, + table, + point, + origin(arguments[3]), + &definitions, + &dominators, + )?; + } + for block in &function.blocks { + for (index, instruction) in block.instructions.iter().enumerate() { + match instruction { + I::ClosureNew { + function: target, + captures, + type_index, + .. + } if *target == raw.function() => { + if function.symbol != executor + || parameters.len() != 6 + || captures.len() != 2 + || *type_index != callable + || origin(captures[0]) != parameters[3] + { + return Err( + "raw resumption factory must capture the executor's current queue", + ); + } + let projection = match definitions.get(&origin(captures[1])).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *field > 0 && (*type_index == root || *type_index == scope) => { + Some((origin(*value), u32::from(*type_index == scope), field - 1)) + } + _ => None, + }; + dispatch_checkpoint_relation(parameters[5], projection)?; + } + I::Call { + contract: Some(contract), + arguments, + .. + } if function.symbol == executor + && table + .control_helpers + .get(contract.0 as usize) + .is_some_and(|helper| helper.role() == R::CloneSequence) => + { + let saved = arguments.first().ok_or("replay has no saved queue")?; + let Some(I::StructGet { + type_index, + field: 2, + value, + .. + }) = definitions.get(&origin(*saved)).copied() + else { + return Err("replay must use the Resume frame's saved queue"); + }; + if *type_index != resume || origin(*value) != parameters[2] { + return Err("replay must use the current Resume frame"); + } + let checkpoint = definitions + .iter() + .find_map(|(destination, instruction)| match instruction { + I::StructGet { + type_index, + field: 3, + value: owner, + .. + } if *type_index == resume && origin(*owner) == origin(*value) => { + Some(origin(*destination)) + } + _ => None, + }) + .ok_or("replay has no current Resume checkpoint")?; + require_check( + function, + table, + (block.id, index), + checkpoint, + &definitions, + &dominators, + )?; + } + _ => {} + } + } + } + Ok(()) +} + +fn loop_parameters(function: &Function) -> &[ValueId] { + let header = function + .blocks + .iter() + .find(|block| block.id == function.entry) + .and_then(|block| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if arguments == &function.parameters => Some(*target), + _ => None, + }); + function + .blocks + .iter() + .find(|block| Some(block.id) == header) + .map_or(&function.parameters, |block| &block.parameters) +} + +fn origin(mut value: ValueId, definitions: &Definitions<'_>) -> ValueId { + for _ in 0..definitions.len() { + match definitions.get(&value).copied() { + Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { + value = *source + } + _ => break, + } + } + value +} + +fn capture(value: ValueId, definitions: &Definitions<'_>) -> Option { + match definitions.get(&origin(value, definitions)).copied()? { + I::ClosureGetCapture { closure, index, .. } => Some(CaptureProjection { + receiver: origin(*closure, definitions), + slot: *index, + }), + _ => None, + } +} + +fn require_check( + function: &Function, + table: &crate::cc::RepresentationTable, + point: (super::BlockId, usize), + checkpoint: ValueId, + definitions: &Definitions<'_>, + dominators: &HashMap>, +) -> Result<(), &'static str> { + let checked = function.blocks.iter().any(|block| { + let prefix = if block.id == point.0 { &block.instructions[..point.1] } + else if dominators.get(&point.0).is_some_and(|set| set.contains(&block.id)) { block.instructions.as_slice() } + else { return false }; + prefix.iter().any(|instruction| matches!(instruction, + I::Call { contract: Some(contract), arguments, .. } + if table.control_helpers.get(contract.0 as usize).is_some_and(|helper| helper.role() == R::Check) + && arguments.len() == 1 && origin(arguments[0], definitions) == checkpoint)) + }); + if checked { + Ok(()) + } else { + Err("resumption must check its saved checkpoint before construction or replay") + } +} diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 5cc4b537..e2df3c15 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -7,6 +7,7 @@ use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; pub(crate) mod cfg; +mod control_checkpoints; mod control_contracts; mod control_provenance; mod instruction; diff --git a/crates/psrs-backend/src/mir/verify/function.rs b/crates/psrs-backend/src/mir/verify/function.rs index 96a38696..78fb98d9 100644 --- a/crates/psrs-backend/src/mir/verify/function.rs +++ b/crates/psrs-backend/src/mir/verify/function.rs @@ -109,7 +109,7 @@ pub(super) fn verify_function( } } - let dominators = compute_dominators(function.entry, &blocks); + let dominators = crate::mir::cfg::dominators(function); for block in &function.blocks { let mut available = block.parameters.iter().copied().collect::>(); for instruction in &block.instructions { @@ -195,71 +195,6 @@ fn value_available( .is_some_and(|set| set.contains(owner)) } -fn compute_dominators( - entry: BlockId, - blocks: &HashMap, -) -> HashMap> { - let all = blocks.keys().copied().collect::>(); - let mut predecessors = blocks - .keys() - .copied() - .map(|id| (id, HashSet::new())) - .collect::>>(); - for block in blocks.values() { - let Some(terminator) = &block.terminator else { - continue; - }; - for successor in terminator_successors(terminator) { - if let Some(preds) = predecessors.get_mut(&successor) { - preds.insert(block.id); - } - } - } - - let mut dominators = blocks - .keys() - .copied() - .map(|id| { - let initial = if id == entry { - HashSet::from([entry]) - } else { - all.clone() - }; - (id, initial) - }) - .collect::>(); - loop { - let mut changed = false; - for id in blocks.keys().copied().filter(|id| *id != entry) { - let mut next = all.clone(); - if let Some(preds) = predecessors.get(&id) { - if preds.is_empty() { - next.clear(); - } else { - for pred in preds { - if let Some(pred_dominators) = dominators.get(pred) { - next.retain(|candidate| pred_dominators.contains(candidate)); - } - } - } - } - next.insert(id); - if dominators.get(&id) != Some(&next) { - dominators.insert(id, next); - changed = true; - } - } - if !changed { - break; - } - } - dominators -} - -fn terminator_successors(terminator: &Terminator) -> Vec { - crate::mir::cfg::successors(terminator) -} - fn terminator_operands(terminator: &Terminator) -> Vec { match terminator { Terminator::Trap { .. } => Vec::new(), diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index 4fdcf5e1..b694182c 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -34,6 +34,7 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { let mut errors = Vec::new(); super::control_contracts::verify(module, &mut errors); super::control_provenance::verify(module, &mut errors); + super::control_checkpoints::verify(module, &mut errors); verify_defined_types(module, &mut errors); let mut signatures = module .functions diff --git a/crates/psrs-driver/src/tests/control_checkpoint_ordering.rs b/crates/psrs-driver/src/tests/control_checkpoint_ordering.rs new file mode 100644 index 00000000..3a70f812 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_checkpoint_ordering.rs @@ -0,0 +1,46 @@ +//! A correct checkpoint check must dominate the start of replay. +use super::control_checkpoints::{SOURCE, binding, mir_error}; +use psrs_backend::cc::ControlHelperRole as R; +use psrs_backend::mir::Instruction as I; + +#[test] +fn mir_rejects_a_correct_checkpoint_check_after_replay_has_started() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let executor = binding(&stages.cc.representations, R::Executor).0; + let check = binding(&stages.cc.representations, R::Check).1; + let clone = binding(&stages.cc.representations, R::CloneSequence).1; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let source = function + .blocks + .iter() + .enumerate() + .find_map(|(block, body)| { + body.instructions.iter().position(|instruction| + matches!(instruction, I::Call { contract: Some(id), .. } if *id == check)) + .map(|index| (block, index)) + }) + .unwrap(); + let instruction = function.blocks[source.0].instructions.remove(source.1); + let target = function + .blocks + .iter() + .enumerate() + .find_map(|(block, body)| { + body.instructions.iter().position(|instruction| + matches!(instruction, I::Call { contract: Some(id), .. } if *id == clone)) + .map(|index| (block, index)) + }) + .unwrap(); + function.blocks[target.0] + .instructions + .insert(target.1 + 1, instruction); + mir_error( + &stages.mir, + "check its saved checkpoint before construction or replay", + ); +} diff --git a/crates/psrs-driver/src/tests/control_checkpoints.rs b/crates/psrs-driver/src/tests/control_checkpoints.rs new file mode 100644 index 00000000..baade113 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_checkpoints.rs @@ -0,0 +1,479 @@ +//! Checkpoint identities are checked independently of physical reference types. +use psrs_backend::cc::{ + Assignment, AssignmentKind as A, ControlHelperId, ControlHelperRole as R, ValueId, +}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; + +pub(super) const SOURCE: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +main :: Int +main = (C.run 0 handler (C.perform (Op \x -> x)))._2 +"; + +fn cc_visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut A) -> bool) -> bool { + for assignment in body { + if mutate(&mut assignment.kind) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if cc_visit(&mut case.assignments, mutate) { + return true; + } + } + if cc_visit(default_assignments, mutate) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if cc_visit(then_assignments, mutate) || cc_visit(else_assignments, mutate) { + return true; + } + } + _ => {} + } + } + false +} + +pub(super) fn binding( + table: &psrs_backend::cc::RepresentationTable, + role: R, +) -> (psrs_hir::SymbolId, ControlHelperId) { + let index = table + .control_helpers + .iter() + .position(|helper| helper.role() == role) + .unwrap(); + ( + table.control_helpers[index].function(), + ControlHelperId(index as u32), + ) +} + +fn cc_error(input: &psrs_backend::BackendInput, message: &str) { + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error.message.contains(message)), + "{errors:?}" + ); +} + +pub(super) fn mir_error(module: &psrs_backend::mir::Module, message: &str) { + let errors = psrs_backend::mir::verify_module(module).unwrap_err(); + assert!( + errors.iter().any(|error| error.message.contains(message)), + "{errors:?}" + ); +} + +fn mir_parameters(function: &psrs_backend::mir::Function) -> Vec { + let target = function + .blocks + .iter() + .find(|block| block.id == function.entry) + .and_then(|block| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if arguments == &function.parameters => Some(*target), + _ => None, + }); + function + .blocks + .iter() + .find(|block| Some(block.id) == target) + .map_or_else( + || function.parameters.clone(), + |block| block.parameters.clone(), + ) +} + +#[test] +fn cc_rejects_missing_raw_resumption_binding() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + input.cc.representations.control_resumption = None; + cc_error(&input, "no valid raw resumption binding"); +} + +#[test] +fn cc_rejects_capturing_execution_extent_as_dispatch_checkpoint() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let raw = input + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let executor = binding(&input.cc.representations, R::Executor).0; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let wrong = function.parameters[4]; + assert!(cc_visit( + &mut function.assignments, + &mut |kind| match kind { + A::FunctionRef { + function, captures, .. + } if *function == raw => { + captures[1] = wrong; + true + } + _ => false, + } + )); + cc_error(&input, "current dispatch context checkpoint"); +} + +#[test] +fn mir_rejects_capturing_execution_extent_as_dispatch_checkpoint() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let raw = stages + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let executor = binding(&stages.cc.representations, R::Executor).0; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let wrong = mir_parameters(function)[4]; + let captures = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::ClosureNew { + function, captures, .. + } if *function == raw => Some(captures), + _ => None, + }) + .unwrap(); + captures[1] = wrong; + mir_error(&stages.mir, "current dispatch context checkpoint"); +} + +#[test] +fn cc_rejects_a_raw_frame_checkpoint_from_another_capture_slot() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let raw = input + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .unwrap(); + let index = function + .assignments + .iter_mut() + .find_map(|assignment| match &mut assignment.kind { + A::ClosureGetCapture { index, .. } if *index == 1 => Some(index), + _ => None, + }) + .unwrap(); + *index = 2; + // Keep the ordinary dense capture contract valid, so this exercises identity. + let checkpoint = function + .assignments + .iter() + .find_map(|assignment| { + matches!(assignment.kind, A::ClosureGetCapture { index: 2, .. }) + .then_some(assignment.destination) + }) + .unwrap(); + let ty = function + .values + .iter() + .find(|declaration| declaration.id == checkpoint) + .unwrap() + .ty; + let unused = ValueId( + function + .values + .iter() + .map(|declaration| declaration.id.0) + .max() + .unwrap() + + 1, + ); + function + .values + .push(psrs_backend::cc::ValueDecl { id: unused, ty }); + function.assignments.insert( + 0, + Assignment { + destination: unused, + kind: A::ClosureGetCapture { + closure: function.parameters[0], + index: 1, + }, + span: function.span, + }, + ); + cc_error(&input, "its own queue and checkpoint capture slots"); +} + +#[test] +fn mir_rejects_a_raw_frame_checkpoint_from_another_capture_slot() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let raw = stages + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .unwrap(); + let index = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::ClosureGetCapture { index, .. } if *index == 1 => Some(index), + _ => None, + }) + .unwrap(); + *index = 2; + mir_error(&stages.mir, "its own queue and checkpoint capture slots"); +} + +#[test] +fn cc_rejects_a_raw_frame_built_without_its_checkpoint_check() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let raw = input + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let check = binding(&input.cc.representations, R::Check).1; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .unwrap(); + let count = function.assignments.len(); + function.assignments.retain(|assignment| !matches!(assignment.kind, A::DirectCall { contract: Some(id), .. } if id == check)); + assert_eq!(function.assignments.len(), count - 1); + cc_error( + &input, + "check its saved checkpoint before construction or replay", + ); +} + +#[test] +fn mir_rejects_a_raw_frame_built_without_its_checkpoint_check() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let raw = stages + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let check = binding(&stages.cc.representations, R::Check).1; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .unwrap(); + let mut removed = 0; + for block in &mut function.blocks { + block.instructions.retain(|instruction| { + let remove = matches!(instruction, I::Call { contract: Some(id), .. } if *id == check); + removed += usize::from(remove); + !remove + }); + } + assert_eq!(removed, 1); + mir_error( + &stages.mir, + "check its saved checkpoint before construction or replay", + ); +} + +#[test] +fn cc_rejects_replay_checking_current_extent_instead_of_saved_checkpoint() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let executor = binding(&input.cc.representations, R::Executor).0; + let check = binding(&input.cc.representations, R::Check).1; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let wrong = function.parameters[4]; + assert!(cc_visit( + &mut function.assignments, + &mut |kind| match kind { + A::DirectCall { + contract: Some(id), + arguments, + .. + } if *id == check => { + arguments[0] = wrong; + true + } + _ => false, + } + )); + cc_error( + &input, + "check its saved checkpoint before construction or replay", + ); +} + +#[test] +fn mir_rejects_replay_checking_current_extent_instead_of_saved_checkpoint() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let executor = binding(&stages.cc.representations, R::Executor).0; + let check = binding(&stages.cc.representations, R::Check).1; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let wrong = mir_parameters(function)[4]; + let arguments = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::Call { + contract: Some(id), + arguments, + .. + } if *id == check => Some(arguments), + _ => None, + }) + .unwrap(); + arguments[0] = wrong; + mir_error( + &stages.mir, + "check its saved checkpoint before construction or replay", + ); +} + +#[test] +fn checked_checkpoint_reference_aliases_survive_physical_lowering() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let raw = input + .cc + .representations + .control_resumption + .as_ref() + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .unwrap(); + let checkpoint = function + .assignments + .iter() + .find_map(|assignment| { + matches!(assignment.kind, A::ClosureGetCapture { index: 1, .. }) + .then_some(assignment.destination) + }) + .unwrap(); + let declaration = function + .values + .iter() + .find(|declaration| declaration.id == checkpoint) + .unwrap() + .clone(); + let alias = ValueId( + function + .values + .iter() + .map(|declaration| declaration.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(psrs_backend::cc::ValueDecl { + id: alias, + ty: declaration.ty, + }); + let position = function + .assignments + .iter() + .position(|assignment| assignment.destination == checkpoint) + .unwrap() + + 1; + function.assignments.insert( + position, + Assignment { + destination: alias, + kind: A::AggregateConvert { + destination: alias, + value: checkpoint, + conversion: psrs_backend::cc::AggregateConvert { + source: declaration.ty, + destination: declaration.ty, + plan: psrs_backend::cc::ValueConversion::Identity, + }, + }, + span: function.span, + }, + ); + for assignment in &mut function.assignments[position + 1..] { + match &mut assignment.kind { + A::DirectCall { arguments, .. } => { + for argument in arguments { + if *argument == checkpoint { + *argument = alias + } + } + } + A::VariantNew { fields, .. } => { + for field in fields { + if *field == checkpoint { + *field = alias + } + } + } + _ => {} + } + } + psrs_backend::cc::verify_module(&input.cc).unwrap(); + psrs_backend::compile_cc(input).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 607a5090..8466b30f 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -8,6 +8,8 @@ mod assertions; mod closure_protocol; mod coercion; mod control_carriers; +mod control_checkpoint_ordering; +mod control_checkpoints; mod control_contracts; mod control_costs; mod control_finish_provenance; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index de6065ef..98ae1ed6 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. Complete producer/checkpoint/replay identity verification, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. Complete frame/context and replay activation provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 8b4c3c41..e734a96e 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -277,6 +277,38 @@ correct finish frame, or that the bound helper body implements every lifecycle rule. Those argument, body and activation provenance obligations remain part of the complete machine verification contract. +### Raw resumption checkpoint ownership + +P8 also predeclares an immutable raw-resumption binding: its code target and +unary callable protocol. It is separate from direct-call helper contracts because +its hidden capture receiver is supplied by closure invocation. The binding must +have the same callable protocol as stored callbacks, and cannot reuse a direct +helper identity. Consumers identify this code by the binding, never by its name. + +The raw closure captures the current executor queue and the dispatch context's +checkpoint: field zero of a root context or field five of a scoped context. +The current execution extent alone is insufficient. Its body returns a Resume +frame containing its input answer, capture slot zero's queue and capture slot +one's checkpoint from its own receiver. It must check that captured checkpoint +before constructing the frame. At interpretation, replay takes the saved queue +from the current Resume frame and checks that same frame's saved checkpoint +before starting clone traversal. + +CC verifies these actual captures, projections, factory operands and preceding +calls. MIR repeats the relations over physical closure captures, case struct +fields, reference aliases and loop parameters. Its checkpoint check must dominate +the construction or clone call; checking the right reference in another path or +after clone traversal has started is insufficient. SSA and lifecycle verification +share the common CFG dominator operation. These relations use immutable planning +evidence and add no runtime instructions. + +This establishes the raw capture/construction/interpretation chain, not every +lifecycle operation. Finish production, validation of each saved finish extent +during clone traversal, fresh replay ancestry, caught-host-trap cleanup and +complete frame/context provenance still require their separate proofs. Ordinary +user callback typing and imported producer boundaries retain their existing +trusted contracts. + ### Finish consumption ownership A finish record stores `(extent, remainingQueue, parent)`. Consuming it must close diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index e2c0b201..130e1f28 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1161,3 +1161,63 @@ is not the final validation result. `/private/tmp/psrs-nominal-clippy-final.log`. Explicit upstream type comparison, package conformance and suite scoreboards are not rerun for this internal layout change. No measured gate number changes. + + +## Raw resumption checkpoint ownership (2026-10-12) + +Starting point: compiler `f3c5a138`, branch `feat/effect-handlers`, clean checkout. +The existing capture contracts proved physical slot types; the raw resumption +code target had no semantic binding, and compatible boundary references could +not establish the identity of a checkpoint used by capture or check operations. +P8 now reserves an immutable raw code-target/callable-protocol binding with its +other control identities, before body lowering. It is distinct from direct-call +helpers and does not introduce another source operation or signature allocation +during lowering. + +CC and MIR verify actual raw closure factories against the executor queue and +its root/scoped dispatch context checkpoint. The raw body returns a Resume of +its input answer, saved queue slot zero and checkpoint slot one from the same +receiver, after checking the captured checkpoint. Interpretation must use the +current Resume frame's saved queue and check its saved checkpoint before clone +traversal. MIR checks actual SSA captures and physical projections after loop +conversion and optimization. The check must dominate the consumer; the common +CFG dominator operation now serves both SSA and lifecycle verification. + +| Requirement | Evidence | Status | +| --- | --- | --- | +| Require a planned raw code binding | `cc_rejects_missing_raw_resumption_binding` | Focused Verified | +| Capture the dispatch checkpoint rather than a compatible execution extent | `cc_rejects_capturing_execution_extent_as_dispatch_checkpoint`, `mir_rejects_capturing_execution_extent_as_dispatch_checkpoint` | Focused Verified | +| Save the raw receiver's required queue/checkpoint slots | `cc_rejects_a_raw_frame_checkpoint_from_another_capture_slot`, `mir_rejects_a_raw_frame_checkpoint_from_another_capture_slot` | Focused Verified | +| Check the saved checkpoint before raw construction | `cc_rejects_a_raw_frame_built_without_its_checkpoint_check`, `mir_rejects_a_raw_frame_built_without_its_checkpoint_check` | Focused Verified | +| Check the current Resume frame's checkpoint before cloning its saved queue | `cc_rejects_replay_checking_current_extent_instead_of_saved_checkpoint`, `mir_rejects_replay_checking_current_extent_instead_of_saved_checkpoint`, `mir_rejects_a_correct_checkpoint_check_after_replay_has_started` | Focused Verified | +| Preserve accepted identity aliases across lowering | `checked_checkpoint_reference_aliases_survive_physical_lowering`, checked CC through the artifact pipeline | Focused Verified | + +The raw body must retain its saved Resume result, so deleting both its check and +construction cannot masquerade as a valid raw function. The replay check relation +is focused on recognizable clone traversal from the current Resume frame; it +does not establish all execution steps if a rewrite deletes that entire step. +MIR trusts the immutable representation metadata produced by checked P8 and does +not reconstruct source types. Saved finish validation inside clone traversal, +finish production, fresh replay activation ancestry and complete context/frame +provenance remain unverified. Foreign capture, caught-host-trap cleanup, pinned +library comparison and general allocation obligations also remain open. Full +AE/AC acceptance is not established by this unit. + +Validation: all eleven new driver tests pass, including the checked CC-to-artifact +alias case and the optimized-MIR ordering rejection. Final mandatory Wasmtime +workspace execution passes 435 backend tests, 95 Core tests, all 81 control +integration tests and the existing ancestry/GC and no-tail-call probes. Driver +library results are 552 passed and 162 failed. The nine failing targets and 175 +failed test names exactly match `f3c5a138`, with no added or recovered names; this +compares names, not every baseline cause. `cargo fmt --all --check`, +`git diff --check` and `cargo clippy --workspace --all-targets -- -D warnings` +pass. The six ancestry/GC workloads retain the preceding carrier slice's exact +component identities, collection counts and maximum post-GC live bytes, as +expected for a verification-only change. + +Logs: `/private/tmp/psrs-checkpoint-structural-final.log`, +`/private/tmp/psrs-checkpoint-workspace.log`, +`/private/tmp/psrs-checkpoint-comparison.json`, and +`/private/tmp/psrs-checkpoint-clippy.log`. Explicit upstream type comparison, +package conformance and suite scoreboards are not rerun for this internal +invariant change. No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 79e1bd30..62f443aa 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -56,6 +56,15 @@ pass directly, callbacks adapt directly to the unary protocol, and user payloads use recursive erasure. The `once` result no longer erases and recovers its owner. Generic abstract storage still erases carriers at its explicit boundary. The checklist records structural and runtime evidence for this change separately. +The continuation from `f3c5a138` predeclares the raw-resumption code binding and +checks checkpoint identity across raw closure capture, Resume construction and +interpretation. CC/MIR distinguish the dispatch checkpoint from a same-shaped +execution extent; the raw body must check and save its own capture slots. Replay +must check the checkpoint of the current Resume frame before cloning its saved +queue. MIR uses shared CFG dominance across dispatch-selection blocks. Eleven +new malformed-IR/alias/ordering tests provide focused evidence. Complete saved +finish validation, fresh replay activation ancestry and other lifecycle rules +remain open. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From b2dd64769ce5e5822ea82e45e7f4f6c3e9127334 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 13:45:56 +0800 Subject: [PATCH 115/148] fix(backend): verify saved finishes and fresh replay activations --- crates/psrs-backend/src/cc/control_helpers.rs | 48 +++ crates/psrs-backend/src/cc/value_identity.rs | 2 +- .../src/cc/verify/control_replay.rs | 261 ++++++++++++ crates/psrs-backend/src/cc/verify/mod.rs | 3 + .../psrs-backend/src/cc/verify/read_only.rs | 76 ++++ crates/psrs-backend/src/control_provenance.rs | 27 ++ .../src/mir/control_checkpoints.rs | 47 +-- .../src/mir/control_provenance.rs | 61 +-- crates/psrs-backend/src/mir/control_replay.rs | 370 ++++++++++++++++++ crates/psrs-backend/src/mir/mod.rs | 2 + crates/psrs-backend/src/mir/opt/effects.rs | 55 +++ crates/psrs-backend/src/mir/opt/mod.rs | 2 +- crates/psrs-backend/src/mir/value_identity.rs | 54 +++ crates/psrs-backend/src/mir/verify/mod.rs | 1 + .../control_replay_contracts/allocation.rs | 114 ++++++ .../src/tests/control_replay_contracts/cc.rs | 231 +++++++++++ .../src/tests/control_replay_contracts/mir.rs | 276 +++++++++++++ .../src/tests/control_replay_contracts/mod.rs | 130 ++++++ crates/psrs-driver/src/tests/mod.rs | 1 + .../tests/control_scoped_replay.rs | 25 +- .../tests/control_support/scoped_replay.purs | 23 ++ docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 38 ++ .../backend/algebraic-effects.md | 64 +++ ...ted-control-lowering-handoff-2026-10-11.md | 9 + 25 files changed, 1807 insertions(+), 115 deletions(-) create mode 100644 crates/psrs-backend/src/cc/verify/control_replay.rs create mode 100644 crates/psrs-backend/src/cc/verify/read_only.rs create mode 100644 crates/psrs-backend/src/mir/control_replay.rs create mode 100644 crates/psrs-backend/src/mir/value_identity.rs create mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs create mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/mir.rs create mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/mod.rs create mode 100644 crates/psrs-driver/tests/control_support/scoped_replay.purs diff --git a/crates/psrs-backend/src/cc/control_helpers.rs b/crates/psrs-backend/src/cc/control_helpers.rs index 2c836b7b..2ebb438d 100644 --- a/crates/psrs-backend/src/cc/control_helpers.rs +++ b/crates/psrs-backend/src/cc/control_helpers.rs @@ -144,3 +144,51 @@ impl super::RepresentationTable { }) } } + +#[derive(Clone, Copy)] +pub(crate) struct ControlReplaySchema { + pub sequence: super::ReprId, + pub boundary: super::ReprId, + pub status: super::ReprId, + pub result: super::ReprId, +} + +impl super::RepresentationTable { + pub(crate) fn control_replay_schema(&self) -> Option { + let repr = |shape| match shape { + super::ValueShape::Reference(super::Reference { + heap: super::RefShape::Repr(id), + nullable: false, + }) => Some(id), + _ => None, + }; + let signature = |role| { + self.signature( + self.control_helpers + .iter() + .find(|helper| helper.role() == role)? + .signature(), + ) + }; + let sequence = self.control_sequence()?; + let boundary = repr(*signature(ControlHelperRole::Check)?.parameters.first()?)?; + let super::Representation::Variant { cases } = self.representation(boundary)? else { + return None; + }; + let status = repr(*cases.iter().find(|case| case.tag == 1)?.fields.first()?)?; + if !matches!( + self.representation(status), + Some(super::Representation::Array { + element: super::ValueShape::Integer + }) + ) { + return None; + } + Some(ControlReplaySchema { + sequence, + boundary, + status, + result: repr(signature(ControlHelperRole::CloneSequence)?.result)?, + }) + } +} diff --git a/crates/psrs-backend/src/cc/value_identity.rs b/crates/psrs-backend/src/cc/value_identity.rs index 0abe5e2f..60d3a42d 100644 --- a/crates/psrs-backend/src/cc/value_identity.rs +++ b/crates/psrs-backend/src/cc/value_identity.rs @@ -23,7 +23,7 @@ pub(crate) fn reference_origin<'a>( value } -fn transparent(conversion: &ValueConversion) -> bool { +pub(crate) fn transparent(conversion: &ValueConversion) -> bool { match conversion { ValueConversion::Identity | ValueConversion::EraseReference diff --git a/crates/psrs-backend/src/cc/verify/control_replay.rs b/crates/psrs-backend/src/cc/verify/control_replay.rs new file mode 100644 index 00000000..33a12b06 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control_replay.rs @@ -0,0 +1,261 @@ +//! Saved finish validation and fresh replay activation ownership. +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control_provenance::{ + FinishProjection, replay_activation_relation, saved_finish_relation, +}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, + functions: Option<&std::collections::HashMap>, +) -> Result<(), Vec> { + let role = table + .control_helpers + .iter() + .find(|helper| helper.function() == function.symbol) + .map(|helper| helper.role()); + if !matches!(role, Some(R::CloneSequence | R::RebuildSequence)) { + return Ok(()); + } + let read_only = functions + .map(super::read_only::functions) + .unwrap_or_default(); + let schema = table + .control_replay_schema() + .ok_or_else(|| error(function, "replay has no checked lifecycle schema"))?; + let expected = if role == Some(R::CloneSequence) { 5 } else { 4 }; + if function.parameters.len() != expected { + return Err(error(function, "replay has an invalid parameter contract")); + } + let parameters = &function.parameters; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = |value| { + crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) + }; + let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(A::Constant(value)) if *value == expected); + let projection = |value, expected_case| match definitions.get(&origin(value)).copied() { + Some(A::VariantGet { + representation, + case, + field, + value, + .. + }) if *representation == schema.sequence && *case == expected_case => { + Some(FinishProjection { + owner: origin(*value), + field: *field, + }) + } + _ => None, + }; + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for (index, assignment) in body.iter().enumerate() { + match &assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + A::If { + then_assignments, + else_assignments, + .. + } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), + A::DirectCall { + function: target, + contract, + .. + } if contract + .and_then(|id| table.control_helpers.get(id.0 as usize)) + .is_none_or(|helper| { + !matches!( + helper.role(), + R::Check | R::CloneSequence | R::RebuildSequence + ) + }) + && !read_only.contains(target) => + { + return Err(error( + function, + "replay traversal cannot invoke callbacks or mutate lifecycle cells", + )); + } + A::IndirectCall { .. } | A::RuntimeCall { .. } | A::FunctionRef { .. } => { + return Err(error( + function, + "replay traversal cannot invoke callbacks or mutate lifecycle cells", + )); + } + A::VariantNew { + representation, + case: 1, + fields, + .. + } if *representation == schema.sequence => { + let accumulator = + parameters[if role == Some(R::CloneSequence) { 2 } else { 1 }]; + if fields.len() != 2 + || projection(fields[0], 1) + != Some(FinishProjection { + owner: parameters[0], + field: 0, + }) + || origin(fields[1]) != accumulator + { + return Err(error( + function, + "replay must share the original callback and retain its accumulator", + )); + } + } + A::VariantNew { + representation, + case: 3, + fields, + .. + } if *representation == schema.sequence => { + if fields.len() != 3 { + return Err(error(function, "replay finish has an invalid schema")); + } + if role == Some(R::CloneSequence) { + saved_finish_relation(parameters[0], projection(fields[0], 3)) + .map_err(|message| error(function, message))?; + if origin(fields[1]) != parameters[2] || origin(fields[2]) != parameters[4] + { + return Err(error( + function, + "replay traversal must retain its reverse accumulator and parent", + )); + } + if !body[..index].iter().any(|assignment| matches!(&assignment.kind, + A::DirectCall { contract: Some(id), arguments, .. } + if table.control_helpers.get(id.0 as usize).is_some_and(|helper| helper.role() == R::Check) + && arguments.len() == 1 && origin(arguments[0]) == origin(fields[0]))) { + return Err(error(function, "replay must check the saved finish extent before copying it")); + } + } else { + replay_activation_relation( + parameters[1], + parameters[2], + origin(fields[1]), + origin(fields[2]), + ) + .map_err(|message| error(function, message))?; + let extent = origin(fields[0]); + let Some(A::VariantNew { + representation, + case: 1, + fields: activation, + .. + }) = definitions.get(&extent).copied() + else { + return Err(error( + function, + "replay must create a fresh activation extent", + )); + }; + if *representation != schema.boundary + || activation.len() != 2 + || origin(activation[1]) != parameters[3] + { + return Err(error( + function, + "replay activation must use its current parent", + )); + } + let status = origin(activation[0]); + let initialized = match definitions.get(&status).copied() { + Some(A::ArrayNew { + representation, + elements, + .. + }) => { + *representation == schema.status + && elements.len() == 1 + && constant(elements[0], 0) + } + Some(A::ArrayFill { + representation, + length, + value, + .. + }) => { + *representation == schema.status + && constant(*length, 1) + && constant(*value, 0) + } + _ => false, + }; + // Common CC scope verification proves these local allocations + // dominate the construction; every recursive call is a fresh + // invocation, including allocations before the tag switch. + if !initialized { + return Err(error( + function, + "replay activation needs a fresh live status cell in its iteration", + )); + } + let next = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments), + _ => None, + }) + .ok_or_else(|| { + error(function, "replay activation has no rebuild transition") + })?; + if next.len() != 4 + || origin(next[1]) != assignment.destination + || origin(next[2]) != extent + || origin(next[3]) != extent + { + return Err(error( + function, + "replay must advance its queue, active extent and parent together", + )); + } + } + } + A::ProductNew { + representation, + arguments, + .. + } if role == Some(R::RebuildSequence) && *representation == schema.result => { + if arguments.len() != 2 + || origin(arguments[0]) != parameters[1] + || origin(arguments[1]) != parameters[2] + { + return Err(error( + function, + "replay result must return its accumulated queue and active extent", + )); + } + } + A::ArraySet { .. } => { + return Err(error( + function, + "replay must not mutate saved or fresh lifecycle cells", + )); + } + _ => {} + } + } + } + Ok(()) +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC control replay", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index f8bf0c28..f935af1b 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -7,8 +7,10 @@ use std::collections::{HashMap, HashSet}; mod adaptation; mod control_checkpoints; mod control_provenance; +mod control_replay; mod helpers; mod ops; +mod read_only; mod scalar; mod variant; use helpers::{verify_capture_layout, verify_value_shape}; @@ -202,6 +204,7 @@ fn verify_function_inner( &function.name, )?; control_checkpoints::verify(function, representations)?; + control_replay::verify(function, representations, functions)?; if !available.contains(&function.result) { return Err(vec![BackendError::invalid_ir( "P8 CC verification", diff --git a/crates/psrs-backend/src/cc/verify/read_only.rs b/crates/psrs-backend/src/cc/verify/read_only.rs new file mode 100644 index 00000000..392ad49b --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/read_only.rs @@ -0,0 +1,76 @@ +//! Conservative local call summaries; imported and dynamic calls are unproven. +use crate::cc::{AssignmentKind as A, Function}; +use psrs_hir::SymbolId; +use std::collections::{HashMap, HashSet}; + +pub(super) fn functions(functions: &HashMap) -> HashSet { + let mut dependencies = HashMap::>::new(); + for (symbol, function) in functions { + let mut calls = HashSet::new(); + let mut safe = true; + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for assignment in body { + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &assignment.kind + { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } else if let A::If { + then_assignments, + else_assignments, + .. + } = &assignment.kind + { + pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]); + } + match &assignment.kind { + A::DirectCall { function, .. } => { + calls.insert(*function); + } + // String literals allocate guest arrays and are excluded. + A::Constant(_) + | A::NumberConstant(_) + | A::Primitive { .. } + | A::Unary { .. } + | A::RepresentationCast { .. } + | A::RepresentationTest { .. } + | A::VariantGet { .. } + | A::VariantTag { .. } + | A::ProductGet { .. } + | A::ArrayGet { .. } + | A::ArrayLen { .. } + | A::ClosureGetCapture { .. } + | A::TagSwitch { .. } + | A::If { .. } + | A::Unreachable + | A::ControlEvidence { .. } => {} + A::AggregateConvert { conversion, .. } + if crate::cc::value_identity::transparent(&conversion.plan) => {} + _ => { + safe = false; + break; + } + } + } + } + if safe { + dependencies.insert(*symbol, calls); + } + } + let mut safe = dependencies.keys().copied().collect::>(); + loop { + let previous = safe.clone(); + safe.retain(|symbol| { + dependencies[symbol] + .iter() + .all(|callee| previous.contains(callee)) + }); + if safe == previous { + return safe; + } + } +} diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control_provenance.rs index 989559af..2ab261f9 100644 --- a/crates/psrs-backend/src/control_provenance.rs +++ b/crates/psrs-backend/src/control_provenance.rs @@ -61,3 +61,30 @@ pub(crate) fn dispatch_checkpoint_relation( _ => Err("raw resumption must capture its current dispatch context checkpoint"), } } + +pub(crate) fn saved_finish_relation( + input: ValueId, + extent: Option, +) -> Result<(), &'static str> { + if extent + != Some(FinishProjection { + owner: input, + field: 0, + }) + { + return Err("replay must preserve the original saved finish extent"); + } + Ok(()) +} + +pub(crate) fn replay_activation_relation( + previous_queue: ValueId, + previous_active: ValueId, + queue: ValueId, + restored_parent: ValueId, +) -> Result<(), &'static str> { + if queue != previous_queue || restored_parent != previous_active { + return Err("replay finish must retain its accumulated queue and previous active extent"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control_checkpoints.rs b/crates/psrs-backend/src/mir/control_checkpoints.rs index bd4f40d8..21e398bf 100644 --- a/crates/psrs-backend/src/mir/control_checkpoints.rs +++ b/crates/psrs-backend/src/mir/control_checkpoints.rs @@ -1,5 +1,5 @@ //! Preserve checkpoint ownership after physical projection and loop conversion. -use super::{Function, Instruction as I, Module, Terminator as T}; +use super::{Function, Instruction as I, Module}; use crate::BackendError; use crate::cc::ControlHelperRole as R; use crate::control_provenance::{ @@ -8,7 +8,9 @@ use crate::control_provenance::{ use crate::types::{DefinedTypeId, ValueId}; use std::collections::HashMap; -type Definitions<'a> = HashMap; +use super::value_identity::{ + Definitions, definitions, loop_parameters, reference_origin as origin, +}; pub(super) fn verify(module: &Module, errors: &mut Vec) { let Some(layout) = &module.layout else { return }; @@ -82,16 +84,7 @@ fn verify_function( scope: DefinedTypeId, callable: DefinedTypeId, ) -> Result<(), &'static str> { - let definitions = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| { - instruction - .destination() - .map(|destination| (destination, instruction)) - }) - .collect::>(); + let definitions = definitions(function); let origin = |value| origin(value, &definitions); let dominators = super::cfg::dominators(function); let parameters = loop_parameters(function); @@ -231,36 +224,6 @@ fn verify_function( Ok(()) } -fn loop_parameters(function: &Function) -> &[ValueId] { - let header = function - .blocks - .iter() - .find(|block| block.id == function.entry) - .and_then(|block| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if arguments == &function.parameters => Some(*target), - _ => None, - }); - function - .blocks - .iter() - .find(|block| Some(block.id) == header) - .map_or(&function.parameters, |block| &block.parameters) -} - -fn origin(mut value: ValueId, definitions: &Definitions<'_>) -> ValueId { - for _ in 0..definitions.len() { - match definitions.get(&value).copied() { - Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { - value = *source - } - _ => break, - } - } - value -} - fn capture(value: ValueId, definitions: &Definitions<'_>) -> Option { match definitions.get(&origin(value, definitions)).copied()? { I::ClosureGetCapture { closure, index, .. } => Some(CaptureProjection { diff --git a/crates/psrs-backend/src/mir/control_provenance.rs b/crates/psrs-backend/src/mir/control_provenance.rs index 2aa6b416..709cc706 100644 --- a/crates/psrs-backend/src/mir/control_provenance.rs +++ b/crates/psrs-backend/src/mir/control_provenance.rs @@ -54,16 +54,7 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { { continue; } - let header = function - .blocks - .iter() - .find(|block| block.id == function.entry) - .and_then(|block| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if arguments == &function.parameters => Some(*target), - _ => None, - }); + let header = super::value_identity::loop_header(function); for block in &function.blocks { for (index, instruction) in block.instructions.iter().enumerate() { let I::Call { @@ -216,44 +207,22 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { } fn projection( - mut value: ValueId, + value: ValueId, function: &Function, finish_type: DefinedTypeId, ) -> Option { - let definitions = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .collect::>(); - for _ in 0..definitions.len() { - match definitions - .iter() - .find(|instruction| instruction.destination() == Some(value))? - { - I::Copy { value: source, .. } | I::RefCast { value: source, .. } => value = *source, - I::StructGet { - type_index, - field, - value: owner, - .. - } if *type_index == finish_type && *field > 0 => { - let mut owner = *owner; - for _ in 0..definitions.len() { - match definitions - .iter() - .find(|instruction| instruction.destination() == Some(owner)) - { - Some(I::Copy { value, .. } | I::RefCast { value, .. }) => owner = *value, - _ => break, - } - } - return Some(FinishProjection { - owner, - field: field - 1, - }); - } - _ => return None, - } + let definitions = super::value_identity::definitions(function); + let origin = |value| super::value_identity::reference_origin(value, &definitions); + match definitions.get(&origin(value)).copied()? { + I::StructGet { + type_index, + field, + value: owner, + .. + } if *type_index == finish_type && *field > 0 => Some(FinishProjection { + owner: origin(*owner), + field: field - 1, + }), + _ => None, } - None } diff --git a/crates/psrs-backend/src/mir/control_replay.rs b/crates/psrs-backend/src/mir/control_replay.rs new file mode 100644 index 00000000..2fc88ccc --- /dev/null +++ b/crates/psrs-backend/src/mir/control_replay.rs @@ -0,0 +1,370 @@ +//! Check replay lifecycle allocations and transitions after loop conversion. +use super::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use super::{Function, Instruction as I, Module, Terminator as T}; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control_provenance::{ + FinishProjection, replay_activation_relation, saved_finish_relation, +}; +use crate::types::{DefinedTypeId, ValueId}; +use std::collections::{HashMap, HashSet}; + +type Point = (super::BlockId, usize); + +struct Schema { + finish: DefinedTypeId, + cons: DefinedTypeId, + boundary: DefinedTypeId, + status: DefinedTypeId, + result: DefinedTypeId, +} + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let functions = module + .functions + .iter() + .filter_map(|function| { + let role = table + .control_helpers + .iter() + .find(|helper| helper.function() == function.symbol)? + .role(); + matches!(role, R::CloneSequence | R::RebuildSequence).then_some((function, role)) + }) + .collect::>(); + if functions.is_empty() { + return; + } + let Some(requirements) = table.control_replay_schema() else { + errors.push(BackendError::invalid_ir( + "P9 MIR control replay", + module.span, + "replay has no checked lifecycle schema", + )); + return; + }; + let types = ( + layout.variant_index(requirements.sequence, 3), + layout.variant_index(requirements.sequence, 1), + layout.variant_index(requirements.boundary, 1), + layout.repr_index(requirements.status), + layout.repr_index(requirements.result), + ); + let (Ok(finish), Ok(cons), Ok(boundary), Ok(status), Ok(result)) = types else { + errors.push(BackendError::invalid_ir( + "P9 MIR control replay", + module.span, + "replay lifecycle schema has no physical layout", + )); + return; + }; + let schema = Schema { + finish, + cons, + boundary, + status, + result, + }; + let read_only = super::opt::effects::read_only_functions(module); + for (function, role) in functions { + if let Err(message) = verify_function(function, role, table, &schema, &read_only) { + errors.push( + BackendError::invalid_ir("P9 MIR control replay", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} + +fn verify_function( + function: &Function, + role: R, + table: &crate::cc::RepresentationTable, + schema: &Schema, + read_only: &HashSet, +) -> Result<(), &'static str> { + let parameters = loop_parameters(function); + if parameters.len() != if role == R::CloneSequence { 5 } else { 4 } { + return Err("replay has an invalid parameter contract"); + } + let definitions = definitions(function); + let origin = |value| reference_origin(value, &definitions); + let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(I::Constant { value, .. }) if *value == expected); + let projection = |value, expected_type| match definitions.get(&origin(value)).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *type_index == expected_type && *field > 0 => Some(FinishProjection { + owner: origin(*value), + field: field - 1, + }), + _ => None, + }; + let points = function + .blocks + .iter() + .flat_map(|block| { + block + .instructions + .iter() + .enumerate() + .filter_map(move |(index, instruction)| { + instruction + .destination() + .map(|destination| (destination, (block.id, index))) + }) + }) + .collect::>(); + let dominators = super::cfg::dominators(function); + for block in &function.blocks { + for (index, instruction) in block.instructions.iter().enumerate() { + let read_only_call = matches!(instruction, + I::Call { function, .. } | I::CallVoid { function, .. } if read_only.contains(function)); + if super::opt::effects::may_invoke(instruction) + && !read_only_call + && !matches!(instruction, I::Call { contract: Some(id), .. } + if table.control_helpers.get(id.0 as usize).is_some_and(|helper| + matches!(helper.role(), R::Check | R::CloneSequence | R::RebuildSequence))) + { + return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); + } + match instruction { + I::ClosureNew { .. } => { + return Err( + "replay traversal cannot invoke callbacks or mutate lifecycle cells", + ); + } + I::StructNew { + type_index, + arguments, + .. + } if *type_index == schema.cons => { + let accumulator = parameters[if role == R::CloneSequence { 2 } else { 1 }]; + if arguments.len() != 3 + || !constant(arguments[0], 1) + || projection(arguments[1], schema.cons) + != Some(FinishProjection { + owner: parameters[0], + field: 0, + }) + || origin(arguments[2]) != accumulator + { + return Err( + "replay must share the original callback and retain its accumulator", + ); + } + } + I::StructNew { + type_index, + arguments, + destination, + .. + } if *type_index == schema.finish => { + if arguments.len() != 4 || !constant(arguments[0], 3) { + return Err("replay finish has an invalid schema"); + } + if role == R::CloneSequence { + saved_finish_relation( + parameters[0], + projection(arguments[1], schema.finish), + )?; + if origin(arguments[2]) != parameters[2] + || origin(arguments[3]) != parameters[4] + { + return Err( + "replay traversal must retain its reverse accumulator and parent", + ); + } + let checked = function.blocks.iter().any(|source| source.instructions.iter().enumerate().any(|(position, instruction)| { + precedes((source.id, position), (block.id, index), &dominators) + && matches!(instruction, I::Call { contract: Some(id), arguments: checked, .. } + if table.control_helpers.get(id.0 as usize).is_some_and(|helper| helper.role() == R::Check) + && checked.len() == 1 && origin(checked[0]) == origin(arguments[1])) + })); + if !checked { + return Err( + "replay must check the saved finish extent before copying it", + ); + } + } else { + replay_activation_relation( + parameters[1], + parameters[2], + origin(arguments[2]), + origin(arguments[3]), + )?; + let extent = origin(arguments[1]); + let Some(I::StructNew { + type_index, + arguments: activation, + .. + }) = definitions.get(&extent).copied() + else { + return Err("replay must create a fresh activation extent"); + }; + if *type_index != schema.boundary + || activation.len() != 3 + || !constant(activation[0], 1) + || origin(activation[2]) != parameters[3] + { + return Err("replay activation must use its current parent"); + } + let status = origin(activation[1]); + let initialized = match definitions.get(&status).copied() { + Some(I::ArrayNew { + type_index, + elements, + .. + }) => { + *type_index == schema.status + && elements.len() == 1 + && constant(elements[0], 0) + } + Some(I::ArrayNewFilled { + type_index, + length, + value, + .. + }) => { + *type_index == schema.status + && constant(*length, 1) + && constant(*value, 0) + } + _ => false, + }; + let point = (block.id, index); + if !initialized + || !fresh_iteration_allocation( + function, + status, + point, + &points, + &dominators, + ) + || !fresh_iteration_allocation( + function, + extent, + point, + &points, + &dominators, + ) + { + return Err( + "replay activation needs a fresh live status cell in its iteration", + ); + } + let next = block.instructions[index + 1..] + .iter() + .find_map(|instruction| match instruction { + I::Call { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .or_else(|| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == loop_header(function) => { + Some(arguments.as_slice()) + } + Some(T::ReturnCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .ok_or("replay activation has no rebuild transition")?; + if next.len() != 4 + || origin(next[1]) != *destination + || origin(next[2]) != extent + || origin(next[3]) != extent + { + return Err( + "replay must advance its queue, active extent and parent together", + ); + } + } + } + I::StructNew { + type_index, + arguments, + .. + } if role == R::RebuildSequence && *type_index == schema.result => { + if arguments.len() != 2 + || origin(arguments[0]) != parameters[1] + || origin(arguments[1]) != parameters[2] + { + return Err( + "replay result must return its accumulated queue and active extent", + ); + } + } + I::ArraySet { .. } => { + return Err("replay must not mutate saved or fresh lifecycle cells"); + } + _ => {} + } + } + match &block.terminator { + Some(T::ReturnCallRef { .. }) => { + return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); + } + Some(T::ReturnCall { + function: target, + contract, + .. + }) if contract + .and_then(|id| table.control_helpers.get(id.0 as usize)) + .is_none_or(|helper| { + !matches!( + helper.role(), + R::Check | R::CloneSequence | R::RebuildSequence + ) + }) => + { + return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); + } + _ => {} + } + } + Ok(()) +} + +fn precedes( + source: Point, + target: Point, + dominators: &HashMap>, +) -> bool { + if source.0 == target.0 { + source.1 < target.1 + } else { + dominators + .get(&target.0) + .is_some_and(|set| set.contains(&source.0)) + } +} + +fn fresh_iteration_allocation( + function: &Function, + allocation: ValueId, + consumer: Point, + points: &HashMap, + dominators: &HashMap>, +) -> bool { + let Some(point) = points.get(&allocation).copied() else { + return false; + }; + precedes(point, consumer, dominators) + && loop_header(function).is_none_or(|header| { + dominators + .get(&point.0) + .is_some_and(|set| set.contains(&header)) + }) +} diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index e2df3c15..6dd6653d 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -10,6 +10,7 @@ pub(crate) mod cfg; mod control_checkpoints; mod control_contracts; mod control_provenance; +mod control_replay; mod instruction; pub(crate) mod layout; mod literals; @@ -19,6 +20,7 @@ pub mod opt; mod planner; mod reachable; mod runtime; +mod value_identity; mod verify; mod wit; diff --git a/crates/psrs-backend/src/mir/opt/effects.rs b/crates/psrs-backend/src/mir/opt/effects.rs index 342a69f4..9a3baad2 100644 --- a/crates/psrs-backend/src/mir/opt/effects.rs +++ b/crates/psrs-backend/src/mir/opt/effects.rs @@ -129,3 +129,58 @@ pub(super) fn classify(instruction: &Instruction) -> InstructionEffects { pub(super) fn is_pure_and_total(instruction: &Instruction) -> bool { classify(instruction).is_pure_and_total() } + +/// Share the conservative call boundary with semantic IR verification. +pub(in crate::mir) fn may_invoke(instruction: &Instruction) -> bool { + classify(instruction).may_call +} + +/// Greatest closed set of local bodies without writes or dynamic calls. +/// Static recursion is permitted; imported calls remain unproven. +pub(in crate::mir) fn read_only_functions( + module: &crate::mir::Module, +) -> std::collections::HashSet { + use crate::mir::Terminator; + use std::collections::{HashMap, HashSet}; + let mut dependencies = HashMap::>::new(); + for function in &module.functions { + let mut calls = HashSet::new(); + let mut safe = true; + for block in &function.blocks { + for instruction in &block.instructions { + match instruction { + Instruction::Call { function, .. } | Instruction::CallVoid { function, .. } => { + calls.insert(*function); + } + _ if classify(instruction).may_call || classify(instruction).writes_memory => { + safe = false; + break; + } + _ => {} + } + } + match &block.terminator { + Some(Terminator::ReturnCall { function, .. }) => { + calls.insert(*function); + } + Some(Terminator::ReturnCallRef { .. }) => safe = false, + _ => {} + } + } + if safe { + dependencies.insert(function.symbol, calls); + } + } + let mut safe = dependencies.keys().copied().collect::>(); + loop { + let previous = safe.clone(); + safe.retain(|symbol| { + dependencies[symbol] + .iter() + .all(|callee| previous.contains(callee)) + }); + if safe == previous { + return safe; + } + } +} diff --git a/crates/psrs-backend/src/mir/opt/mod.rs b/crates/psrs-backend/src/mir/opt/mod.rs index 65ddb00b..73b1af19 100644 --- a/crates/psrs-backend/src/mir/opt/mod.rs +++ b/crates/psrs-backend/src/mir/opt/mod.rs @@ -2,7 +2,7 @@ mod cfg; pub(in crate::mir) mod constants; -mod effects; +pub(in crate::mir) mod effects; mod imports; mod inline; mod values; diff --git a/crates/psrs-backend/src/mir/value_identity.rs b/crates/psrs-backend/src/mir/value_identity.rs new file mode 100644 index 00000000..32a39484 --- /dev/null +++ b/crates/psrs-backend/src/mir/value_identity.rs @@ -0,0 +1,54 @@ +//! Shared reference identity and loop parameter views for MIR consumers. +use super::{BlockId, Function, Instruction, Terminator}; +use crate::types::ValueId; +use std::collections::HashMap; + +pub(crate) type Definitions<'a> = HashMap; + +pub(crate) fn definitions(function: &Function) -> Definitions<'_> { + function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| { + instruction + .destination() + .map(|destination| (destination, instruction)) + }) + .collect() +} + +pub(crate) fn reference_origin(mut value: ValueId, definitions: &Definitions<'_>) -> ValueId { + for _ in 0..definitions.len() { + match definitions.get(&value).copied() { + Some( + Instruction::Copy { value: source, .. } + | Instruction::RefCast { value: source, .. }, + ) => value = *source, + _ => break, + } + } + value +} + +pub(crate) fn loop_header(function: &Function) -> Option { + function + .blocks + .iter() + .find(|block| block.id == function.entry) + .and_then(|block| match &block.terminator { + Some(Terminator::Jump { + target, arguments, .. + }) if arguments == &function.parameters => Some(*target), + _ => None, + }) +} + +pub(crate) fn loop_parameters(function: &Function) -> &[ValueId] { + let header = loop_header(function); + function + .blocks + .iter() + .find(|block| Some(block.id) == header) + .map_or(&function.parameters, |block| &block.parameters) +} diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index b694182c..adabde8b 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -35,6 +35,7 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { super::control_contracts::verify(module, &mut errors); super::control_provenance::verify(module, &mut errors); super::control_checkpoints::verify(module, &mut errors); + super::control_replay::verify(module, &mut errors); verify_defined_types(module, &mut errors); let mut signatures = module .functions diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs b/crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs new file mode 100644 index 00000000..63498849 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs @@ -0,0 +1,114 @@ +//! A valid allocation move remains fresh on every rebuild invocation/iteration. +use super::{R, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueDecl, ValueId, ValueShape}; +use std::process::Command; + +fn extract( + body: &mut [Assignment], + status: &mut Option, + zero: &mut Option, +) -> bool { + for assignment in body.iter_mut() { + if let A::TagSwitch { cases, .. } = &mut assignment.kind { + for case in cases { + if let Some(index) = case + .assignments + .iter() + .position(|assignment| matches!(assignment.kind, A::ArrayNew { .. })) + { + let allocation = case.assignments.remove(index); + let A::ArrayNew { elements, .. } = &allocation.kind else { + unreachable!() + }; + let position = case + .assignments + .iter() + .position(|assignment| assignment.destination == elements[0]) + .unwrap(); + *zero = Some(case.assignments.remove(position)); + *status = Some(allocation); + return true; + } + if extract(&mut case.assignments, status, zero) { + return true; + } + } + } + } + false +} + +#[test] +fn allocation_before_dispatch_and_filled_storage_preserve_replay_identity() { + let Some(_) = super::super::wasmtime_available() else { + return; + }; + let source = include_str!("../../../tests/control_support/scoped_replay.purs").replace("AFTER", r"C.bind (raw (k 0)) (\b -> C.return { saved: a.saved, built: a.built, value: intAdd a.value b.value })"); + let mut input = crate::lower_main_to_cc(&source).unwrap(); + let symbol = binding(&input.cc.representations, R::RebuildSequence).0; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let mut status = None; + let mut zero = None; + assert!(extract(&mut function.assignments, &mut status, &mut zero)); + let zero = zero.unwrap(); + assert!(matches!(zero.kind, A::Constant(0))); + let mut status = status.unwrap(); + let A::ArrayNew { + representation, + elements, + .. + } = &status.kind + else { + unreachable!() + }; + let length = ValueId( + function + .values + .iter() + .map(|declaration| declaration.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(ValueDecl { + id: length, + ty: ValueShape::Integer, + }); + status.kind = A::ArrayFill { + destination: status.destination, + representation: *representation, + length, + value: elements[0], + }; + function.assignments.splice( + 0..0, + [ + zero, + Assignment { + destination: length, + kind: A::Constant(1), + span: function.span, + }, + status, + ], + ); + psrs_backend::cc::verify_module(&input.cc).unwrap(); + let artifact = psrs_backend::compile_cc(input).unwrap(); + let path = std::env::temp_dir().join(format!( + "psrs-replay-filled-status-{}.wasm", + std::process::id() + )); + std::fs::write(&path, artifact.wasm).unwrap(); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(&path).unwrap(); + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/cc.rs b/crates/psrs-driver/src/tests/control_replay_contracts/cc.rs new file mode 100644 index 00000000..0610259f --- /dev/null +++ b/crates/psrs-driver/src/tests/control_replay_contracts/cc.rs @@ -0,0 +1,231 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, Function, RefShape, ValueId}; + +fn visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut Assignment) -> bool) -> bool { + for assignment in body { + if mutate(assignment) { + return true; + } + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &mut assignment.kind + { + for case in cases { + if visit(&mut case.assignments, mutate) { + return true; + } + } + if visit(default_assignments, mutate) { + return true; + } + } + } + false +} + +fn definition(function: &Function, value: ValueId) -> &A { + fn find(body: &[Assignment], value: ValueId) -> Option<&A> { + for assignment in body { + if assignment.destination == value { + return Some(&assignment.kind); + } + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &assignment.kind + { + for case in cases { + if let Some(kind) = find(&case.assignments, value) { + return Some(kind); + } + } + if let Some(kind) = find(default_assignments, value) { + return Some(kind); + } + } + } + None + } + find(&function.assignments, value).unwrap() +} + +pub(super) fn reject(mutation: Mutation) { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let role = mutation.role(); + let symbol = binding(&input.cc.representations, role).0; + let check = binding(&input.cc.representations, R::Check).1; + let close = binding(&input.cc.representations, R::Close); + let helper = &input.cc.representations.control_helpers[check.0 as usize]; + let boundary_shape = input + .cc + .representations + .signature(helper.signature()) + .unwrap() + .result; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let parameters = function.parameters.clone(); + let changed = match mutation { + Mutation::PrematureClose => visit(&mut function.assignments, &mut |assignment| { + let A::DirectCall { + function, + contract: Some(id), + .. + } = &mut assignment.kind + else { + return false; + }; + if *id != check { + return false; + } + *function = close.0; + *id = close.1; + true + }), + Mutation::CallbackFromOtherQueue => visit(&mut function.assignments, &mut |assignment| { + let A::VariantGet { + case: 1, + field: 0, + value, + .. + } = &mut assignment.kind + else { + return false; + }; + *value = parameters[1]; + true + }), + Mutation::WrongSavedCheck | Mutation::MissingSavedCheck => { + visit(&mut function.assignments, &mut |assignment| { + let A::DirectCall { + contract: Some(id), + arguments, + .. + } = &mut assignment.kind + else { + return false; + }; + if *id != check { + return false; + } + if matches!(mutation, Mutation::WrongSavedCheck) { + arguments[0] = parameters[4]; + } else { + let value = arguments[0]; + assignment.kind = A::AggregateConvert { + destination: assignment.destination, + value, + conversion: psrs_backend::cc::AggregateConvert { + source: boundary_shape, + destination: boundary_shape, + plan: psrs_backend::cc::ValueConversion::Identity, + }, + }; + } + true + }) + } + Mutation::ReusedActivation | Mutation::WrongRestoredParent => { + visit(&mut function.assignments, &mut |assignment| { + let A::VariantNew { + case: 3, fields, .. + } = &mut assignment.kind + else { + return false; + }; + if matches!(mutation, Mutation::ReusedActivation) { + fields[0] = parameters[2]; + } else { + fields[2] = parameters[3]; + } + true + }) + } + Mutation::WrongActivationParent => { + let psrs_backend::cc::ValueShape::Reference(reference) = boundary_shape else { + unreachable!() + }; + let RefShape::Repr(boundary) = reference.heap else { + unreachable!() + }; + visit(&mut function.assignments, &mut |assignment| { + let A::VariantNew { + representation, + case: 1, + fields, + .. + } = &mut assignment.kind + else { + return false; + }; + if *representation != boundary { + return false; + } + fields[1] = parameters[2]; + true + }) + } + Mutation::ClosedStatus => { + let mut status = None; + assert!(visit(&mut function.assignments, &mut |assignment| { + if let A::ArrayNew { elements, .. } = &assignment.kind { + status = elements.first().copied(); + return true; + } + false + })); + assert!(matches!( + definition(function, status.unwrap()), + A::Constant(0) + )); + visit(&mut function.assignments, &mut |assignment| { + if assignment.destination == status.unwrap() { + assignment.kind = A::Constant(1); + return true; + } + false + }) + } + Mutation::WrongAdvance => { + let mut finish = None; + assert!(visit(&mut function.assignments, &mut |assignment| { + if matches!(assignment.kind, A::VariantNew { case: 3, .. }) { + finish = Some(assignment.destination); + return true; + } + false + })); + visit(&mut function.assignments, &mut |assignment| { + let A::DirectCall { + function: target, + arguments, + .. + } = &mut assignment.kind + else { + return false; + }; + if *target != symbol || arguments[1] != finish.unwrap() { + return false; + } + arguments[2] = parameters[2]; + true + }) + } + Mutation::StatusOutsideLoop => unreachable!(), + }; + assert!(changed); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/mir.rs b/crates/psrs-driver/src/tests/control_replay_contracts/mir.rs new file mode 100644 index 00000000..e8e68650 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_replay_contracts/mir.rs @@ -0,0 +1,276 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::ValueId; +use psrs_backend::mir::{Function, Instruction as I, Terminator as T}; + +fn parameters(function: &Function) -> Vec { + let entry = function + .blocks + .iter() + .find(|block| block.id == function.entry) + .unwrap(); + let Some(T::Jump { + target, arguments, .. + }) = &entry.terminator + else { + return function.parameters.clone(); + }; + assert_eq!(arguments, &function.parameters); + function + .blocks + .iter() + .find(|block| block.id == *target) + .unwrap() + .parameters + .clone() +} + +fn origin(function: &Function, mut value: ValueId) -> ValueId { + for _ in 0..function.values.len() { + match function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find(|instruction| instruction.destination() == Some(value)) + { + Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { + value = *source + } + _ => break, + } + } + value +} + +pub(super) fn reject(mutation: Mutation) { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let symbol = binding(&stages.cc.representations, mutation.role()).0; + let check = binding(&stages.cc.representations, R::Check).1; + let close = binding(&stages.cc.representations, R::Close); + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let parameters = parameters(function); + if matches!(mutation, Mutation::PrematureClose) { + let instruction = function.blocks.iter_mut().flat_map(|block| &mut block.instructions).find(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == check)).unwrap(); + let I::Call { + function: target, + contract, + .. + } = instruction + else { + unreachable!() + }; + *target = close.0; + *contract = Some(close.1); + } else if matches!(mutation, Mutation::CallbackFromOtherQueue) { + let receiver = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::StructNew { arguments, .. } if arguments.len() == 3 => { + let callback = origin(function, arguments[1]); + match function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find(|instruction| instruction.destination() == Some(callback)) + { + Some(I::StructGet { value, .. }) => Some(*value), + _ => None, + } + } + _ => None, + }) + .unwrap(); + let source = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::RefCast { + destination, value, .. + } if *destination == receiver => Some(value), + _ => None, + }) + .unwrap(); + *source = parameters[1]; + } else if matches!( + mutation, + Mutation::WrongSavedCheck | Mutation::MissingSavedCheck + ) { + let instruction = function.blocks.iter_mut().flat_map(|block| &mut block.instructions).find(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == check)).unwrap(); + let I::Call { + destination, + arguments, + span, + .. + } = instruction + else { + unreachable!() + }; + if matches!(mutation, Mutation::WrongSavedCheck) { + arguments[0] = parameters[4]; + } else { + *instruction = I::Copy { + destination: *destination, + value: arguments[0], + span: *span, + }; + } + } else { + let (finish, extent) = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::StructNew { + destination, + arguments, + .. + } if arguments.len() == 4 => Some((*destination, origin(function, arguments[1]))), + _ => None, + }) + .unwrap(); + match mutation { + Mutation::ReusedActivation | Mutation::WrongRestoredParent => { + let arguments = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::StructNew { + destination, + arguments, + .. + } if *destination == finish => Some(arguments), + _ => None, + }) + .unwrap(); + if matches!(mutation, Mutation::ReusedActivation) { + arguments[1] = parameters[2]; + } else { + arguments[3] = parameters[3]; + } + } + Mutation::WrongActivationParent => { + let arguments = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::StructNew { + destination, + arguments, + .. + } if *destination == extent => Some(arguments), + _ => None, + }) + .unwrap(); + arguments[2] = parameters[2]; + } + Mutation::ClosedStatus | Mutation::StatusOutsideLoop => { + let status = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::StructNew { + destination, + arguments, + .. + } if *destination == extent => Some(origin(function, arguments[1])), + _ => None, + }) + .unwrap(); + let zero = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::ArrayNew { + destination, + elements, + .. + } if *destination == status => Some(elements[0]), + _ => None, + }) + .unwrap(); + if matches!(mutation, Mutation::ClosedStatus) { + let value = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find_map(|instruction| match instruction { + I::Constant { + destination, value, .. + } if *destination == zero => Some(value), + _ => None, + }) + .unwrap(); + assert_eq!(*value, 0); + *value = 1; + } else { + let mut moved = Vec::new(); + for block in &mut function.blocks { + let mut index = 0; + while index < block.instructions.len() { + if matches!(block.instructions[index].destination(), Some(id) if id == zero || id == status) + { + moved.push(block.instructions.remove(index)); + } else { + index += 1 + } + } + } + assert_eq!(moved.len(), 2); + moved.sort_by_key(|instruction| { + usize::from(instruction.destination() == Some(status)) + }); + function + .blocks + .iter_mut() + .find(|block| block.id == function.entry) + .unwrap() + .instructions + .extend(moved); + } + } + Mutation::WrongAdvance => { + let target = function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Jump { arguments, .. }) + if arguments.len() == 4 && origin(function, arguments[1]) == finish => + { + Some(block.id) + } + _ => None, + }) + .unwrap(); + let Some(T::Jump { arguments, .. }) = &mut function + .blocks + .iter_mut() + .find(|block| block.id == target) + .unwrap() + .terminator + else { + unreachable!() + }; + arguments[2] = parameters[2]; + } + _ => unreachable!(), + } + } + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/mod.rs b/crates/psrs-driver/src/tests/control_replay_contracts/mod.rs new file mode 100644 index 00000000..848758a9 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_replay_contracts/mod.rs @@ -0,0 +1,130 @@ +//! Lifecycle replay must preserve checkpoints and allocate distinct activations. +mod allocation; +mod cc; +mod mir; +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::ControlHelperRole as R; + +#[derive(Clone, Copy)] +enum Mutation { + WrongSavedCheck, + PrematureClose, + CallbackFromOtherQueue, + MissingSavedCheck, + ReusedActivation, + WrongActivationParent, + WrongRestoredParent, + ClosedStatus, + WrongAdvance, + StatusOutsideLoop, +} + +impl Mutation { + fn role(self) -> R { + match self { + Self::WrongSavedCheck + | Self::MissingSavedCheck + | Self::PrematureClose + | Self::CallbackFromOtherQueue => R::CloneSequence, + _ => R::RebuildSequence, + } + } + fn message(self) -> &'static str { + match self { + Self::PrematureClose => { + "replay traversal cannot invoke callbacks or mutate lifecycle cells" + } + Self::CallbackFromOtherQueue => { + "share the original callback and retain its accumulator" + } + Self::WrongSavedCheck | Self::MissingSavedCheck => { + "check the saved finish extent before copying it" + } + Self::ReusedActivation => "create a fresh activation extent", + Self::WrongActivationParent => "activation must use its current parent", + Self::WrongRestoredParent => "retain its accumulated queue and previous active extent", + Self::ClosedStatus | Self::StatusOutsideLoop => { + "fresh live status cell in its iteration" + } + Self::WrongAdvance => "advance its queue, active extent and parent together", + } + } +} + +#[test] +fn cc_checks_original_saved_extent() { + cc::reject(Mutation::WrongSavedCheck); +} +#[test] +fn mir_checks_original_saved_extent() { + mir::reject(Mutation::WrongSavedCheck); +} +#[test] +fn cc_requires_saved_extent_check() { + cc::reject(Mutation::MissingSavedCheck); +} +#[test] +fn mir_requires_saved_extent_check() { + mir::reject(Mutation::MissingSavedCheck); +} +#[test] +fn cc_rejects_reusing_an_activation() { + cc::reject(Mutation::ReusedActivation); +} +#[test] +fn mir_rejects_reusing_an_activation() { + mir::reject(Mutation::ReusedActivation); +} +#[test] +fn cc_checks_fresh_activation_parent() { + cc::reject(Mutation::WrongActivationParent); +} +#[test] +fn mir_checks_fresh_activation_parent() { + mir::reject(Mutation::WrongActivationParent); +} +#[test] +fn cc_checks_restored_active_extent() { + cc::reject(Mutation::WrongRestoredParent); +} +#[test] +fn mir_checks_restored_active_extent() { + mir::reject(Mutation::WrongRestoredParent); +} +#[test] +fn cc_requires_a_live_new_status() { + cc::reject(Mutation::ClosedStatus); +} +#[test] +fn mir_requires_a_live_new_status() { + mir::reject(Mutation::ClosedStatus); +} +#[test] +fn cc_checks_activation_advance() { + cc::reject(Mutation::WrongAdvance); +} +#[test] +fn mir_checks_activation_advance() { + mir::reject(Mutation::WrongAdvance); +} +#[test] +fn mir_rejects_status_allocation_before_the_rebuild_loop() { + mir::reject(Mutation::StatusOutsideLoop); +} + +#[test] +fn cc_replay_cannot_complete_a_saved_extent() { + cc::reject(Mutation::PrematureClose); +} +#[test] +fn mir_replay_cannot_complete_a_saved_extent() { + mir::reject(Mutation::PrematureClose); +} +#[test] +fn cc_replay_must_share_the_original_callback() { + cc::reject(Mutation::CallbackFromOtherQueue); +} +#[test] +fn mir_replay_must_share_the_original_callback() { + mir::reject(Mutation::CallbackFromOtherQueue); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 8466b30f..8487cf05 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -14,6 +14,7 @@ mod control_contracts; mod control_costs; mod control_finish_provenance; mod control_helper_contracts; +mod control_replay_contracts; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/crates/psrs-driver/tests/control_scoped_replay.rs b/crates/psrs-driver/tests/control_scoped_replay.rs index 03ceb901..7c8884d6 100644 --- a/crates/psrs-driver/tests/control_scoped_replay.rs +++ b/crates/psrs-driver/tests/control_scoped_replay.rs @@ -2,30 +2,7 @@ mod control_support; use control_support::execute; -const SOURCE: &str = r"module Main where -import Prim.Control as C -data F x = F Int (Int -> x) -data G x = G (Int -> x) -type Answer = { saved :: Int -> C.Control F Int, built :: C.Control F Int, value :: Int } -ret :: Int -> C.Control G Answer -ret n = C.return { saved: \x -> C.return x, built: C.return n, value: n } -inner :: forall x. F x -> (x -> C.Control F Int) -> C.Control G Answer -inner (F label k) raw = if intEq label 1 - then C.bind (C.perform (G (\x -> x))) (\n -> loop (raw (k n))) - else C.return { saved: \n -> raw (k n), built: raw (k 42), value: 21 } -loop :: C.Control F Int -> C.Control G Answer -loop = C.handle ret inner -forward :: forall x. G x -> (x -> C.Control G Answer) -> C.Control G Answer -forward request raw = C.bind (C.perform request) (\answer -> wrap (raw answer)) -wrap :: C.Control G Answer -> C.Control G Answer -wrap computation = C.handle C.return forward computation -root :: forall x. Int -> G x -> (x -> C.Control G Answer) -> { _1 :: Int, _2 :: C.Control G Answer } -root s (G k) raw = { _1: s, _2: C.bind (raw (k 0)) (\a -> AFTER) } -closed :: forall x. Int -> F x -> (x -> C.Control F Int) -> { _1 :: Int, _2 :: C.Control F Int } -closed s (F label k) raw = { _1: s, _2: raw (k 42) } -program = C.bind (C.perform (F 1 (\x -> x))) (\_ -> C.perform (F 2 (\x -> x))) -main = (C.run 0 root (wrap (loop program)))._2.value -"; +const SOURCE: &str = include_str!("control_support/scoped_replay.purs"); #[test] fn two_replays_preserve_nested_suspended_source_checkpoints() { diff --git a/crates/psrs-driver/tests/control_support/scoped_replay.purs b/crates/psrs-driver/tests/control_support/scoped_replay.purs new file mode 100644 index 00000000..a9d60887 --- /dev/null +++ b/crates/psrs-driver/tests/control_support/scoped_replay.purs @@ -0,0 +1,23 @@ +module Main where +import Prim.Control as C +data F x = F Int (Int -> x) +data G x = G (Int -> x) +type Answer = { saved :: Int -> C.Control F Int, built :: C.Control F Int, value :: Int } +ret :: Int -> C.Control G Answer +ret n = C.return { saved: \x -> C.return x, built: C.return n, value: n } +inner :: forall x. F x -> (x -> C.Control F Int) -> C.Control G Answer +inner (F label k) raw = if intEq label 1 + then C.bind (C.perform (G (\x -> x))) (\n -> loop (raw (k n))) + else C.return { saved: \n -> raw (k n), built: raw (k 42), value: 21 } +loop :: C.Control F Int -> C.Control G Answer +loop = C.handle ret inner +forward :: forall x. G x -> (x -> C.Control G Answer) -> C.Control G Answer +forward request raw = C.bind (C.perform request) (\answer -> wrap (raw answer)) +wrap :: C.Control G Answer -> C.Control G Answer +wrap computation = C.handle C.return forward computation +root :: forall x. Int -> G x -> (x -> C.Control G Answer) -> { _1 :: Int, _2 :: C.Control G Answer } +root s (G k) raw = { _1: s, _2: C.bind (raw (k 0)) (\a -> AFTER) } +closed :: forall x. Int -> F x -> (x -> C.Control F Int) -> { _1 :: Int, _2 :: C.Control F Int } +closed s (F label k) raw = { _1: s, _2: raw (k 42) } +program = C.bind (C.perform (F 1 (\x -> x))) (\_ -> C.perform (F 2 (\x -> x))) +main = (C.run 0 root (wrap (loop program)))._2.value diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 98ae1ed6..5bc80a57 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. Complete frame/context and replay activation provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Complete execution-step, root/dispatch seeding and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index e734a96e..eb2da5a7 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -309,6 +309,44 @@ complete frame/context provenance still require their separate proofs. Ordinary user callback typing and imported producer boundaries retain their existing trusted contracts. +### Saved finish replay and fresh activations + +Clone traversal preserves a saved finish extent from field zero of its current +input finish, checking that exact extent before constructing the reversed copy. +Its reverse accumulator and ancestry input are retained. Callback queue nodes +reuse the original input callback reference and the current accumulator in both +traversal and rebuild; replay does not clone or invoke those dynamic callbacks. + +Rebuild creates a child activation with its current parent input and a newly +allocated, live one-element status cell. The finish restores the accumulated +queue and previous active extent. The next rebuild step advances its queue, +active extent and parent together to the new activation. The terminal replay +product returns the accumulated queue and active extent. A new extent sharing an +old cell, a closed initial status or an allocation outside the rebuild iteration +cannot establish freshness. + +CC checks these actual constructions and transitions after common scope +verification. A local allocation before the CC dispatch switch is still fresh on +every recursive invocation. MIR repeats the relations over physical fields, +reference identities and loop parameters, requiring status and extent allocations +to dominate the finish and occur inside the current loop iteration. An allocation +hoisted into the function preheader is insufficient. One-element `ArrayNew` and +filled allocation forms with live initial status are both admitted. + +Replay cannot write lifecycle cells or call lifecycle completion. Additional +static inspection calls may be accepted only when their local bodies and all +transitive static callees are proved read-only, without dynamic calls or +allocations. Missing and imported bodies remain unproven. MIR uses the common +instruction effect owner for this summary; neither stage makes a name-based +exception for a cost probe. This leaves ordinary trapping ancestry checks valid +without admitting a shape-compatible close operation. + +These checks cover recognizable copy/rebuild nodes and transitions. They do not +prove complete traversal if a rewrite removes an entire required step, all +root/dispatch seeding and propagation relationships, finish production from its +source context, or caught-host-trap cleanup. Those obligations remain part of +complete lifecycle and execution-step verification. + ### Finish consumption ownership A finish record stores `(extent, remainingQueue, parent)`. Consuming it must close diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 130e1f28..81a076f8 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1221,3 +1221,67 @@ Logs: `/private/tmp/psrs-checkpoint-structural-final.log`, `/private/tmp/psrs-checkpoint-clippy.log`. Explicit upstream type comparison, package conformance and suite scoreboards are not rerun for this internal invariant change. No measured gate number changes. + + +## Saved finish replay and fresh activation ownership (2026-10-12) + +Starting point: compiler `f9e9e14e`, branch `feat/effect-handlers`, clean checkout. +CC/MIR now check that clone traversal validates the current input finish's original +extent before copying it, retaining the reverse accumulator and ancestry input. +Callback nodes share their original input callback reference. Rebuild requires a +fresh child extent with the current parent, a freshly allocated live status cell, +the accumulated queue and previous active extent as restored state, and joint +queue/activation/parent advancement. Its terminal product retains the accumulated +queue and active extent. No runtime schema, source intrinsic or signature +allocation is added. + +The CC verifier uses common scope checking to establish that local allocations +are fresh on each recursive invocation. The MIR verifier uses shared reference +identity, loop parameters and CFG dominance: a cell allocated in the preheader +cannot be reused across rebuild iterations. Both fixed and filled one-element +allocations are accepted. Replay rejects lifecycle writes, completion calls and +dynamic callback invocation. Extra static inspection calls require a conservative +closed set of read-only local bodies and static callees. Imported/missing bodies +and allocating or writing bodies are unproven. MIR consults the ordinary effect +summary; no cost-probe name receives an exception and no optimizer exemption is +introduced. + +| Requirement | Evidence | Status | +| --- | --- | --- | +| Check the exact original saved finish extent | `cc_checks_original_saved_extent`, `mir_checks_original_saved_extent`, `cc_requires_saved_extent_check`, `mir_requires_saved_extent_check` | Focused Verified | +| Share original callbacks and preserve queue accumulators | `cc_replay_must_share_the_original_callback`, `mir_replay_must_share_the_original_callback` | Focused Verified | +| Create fresh activation objects with the current parent | `cc_rejects_reusing_an_activation`, `mir_rejects_reusing_an_activation`, `cc_checks_fresh_activation_parent`, `mir_checks_fresh_activation_parent` | Focused Verified | +| Preserve restored active state and advance the new activation coherently | `cc_checks_restored_active_extent`, `mir_checks_restored_active_extent`, `cc_checks_activation_advance`, `mir_checks_activation_advance` | Focused Verified | +| Initialize fresh live status on each rebuild iteration | `cc_requires_a_live_new_status`, `mir_requires_a_live_new_status`, `mir_rejects_status_allocation_before_the_rebuild_loop` | Focused Verified | +| Keep traversal from completing original extents | `cc_replay_cannot_complete_a_saved_extent`, `mir_replay_cannot_complete_a_saved_extent`; a valid close callee/contract with the same signature cannot replace validation | Focused Verified | +| Accept semantically valid allocation placement and forms | `allocation_before_dispatch_and_filled_storage_preserve_replay_identity`: checked CC to optimized artifact, mandatory Wasmtime, nested replay returns 42 with filled status allocation before dispatch | Focused Verified | +| Preserve read-only inspection instrumentation | Existing actual ancestry/GC probes, through the checked CC-to-artifact pipeline | Focused Verified | + +The accepted nested replay source is shared with the existing scoped replay +integration tests through a compiler-owned synthetic fixture; its source program +is unchanged. These checks establish recognizable node relationships, not full +algorithm equivalence when entire traversal/construction steps are removed. +Initial dispatch/root seeding and all propagation relationships, source-context +finish production, complete frame/context provenance, foreign capture, +caught-host-trap cleanup, pinned library comparison and remaining general +allocation obligations stay open. Full AE/AC acceptance remains unverified. + +Validation: all twenty new cases pass, including actual mandatory Wasmtime +execution of the altered filled-status allocation path through nested multi-shot +replay. Final `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` +passes 435 backend tests, 95 Core tests, all 81 control integration tests and the +existing ancestry/GC and no-tail-call probes. Driver library results are 572 +passed and 162 failed. The same nine failing targets and 175 failed test names +match `f9e9e14e`, with no added or recovered names; this compares names rather +than every baseline cause. `cargo fmt --all --check`, `git diff --check` and final +`cargo clippy --workspace --all-targets -- -D warnings` pass. Two test-helper lint +repairs were followed by a rerun of all twenty new cases. + +The six measured ancestry/GC workloads retain the preceding checkpoint slice's +exact component fingerprints, collection counts and maximum post-GC live bytes. +Logs: `/private/tmp/psrs-replay-structural-final.log`, +`/private/tmp/psrs-replay-workspace-final.log`, +`/private/tmp/psrs-replay-comparison.json`, and +`/private/tmp/psrs-replay-clippy-final.log`. Explicit upstream type comparison, +package conformance and suite scoreboards are not rerun for this internal +invariant change. No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 62f443aa..811f530c 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -65,6 +65,15 @@ queue. MIR uses shared CFG dominance across dispatch-selection blocks. Eleven new malformed-IR/alias/ordering tests provide focused evidence. Complete saved finish validation, fresh replay activation ancestry and other lifecycle rules remain open. +The continuation from `f9e9e14e` validates saved finish extents during clone +traversal, callback sharing and fresh rebuild activations. The new status must +be live and allocated in the current invocation/loop iteration; child ancestry, +restored state, advancement and terminal replay products retain their required +identities. Statically verified read-only inspection callees remain accepted. +Twenty new cases include malformed CC/MIR and actual execution of nested replay +with status allocation moved before dispatch and expressed as filled storage. +Complete traversal, initial root/dispatch seeding, finish production and host +cleanup still require their remaining proofs. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From 5b74e43b28bd799910555e249a642e359bf8a42c Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 14:23:28 +0800 Subject: [PATCH 116/148] fix(backend): verify completion contexts and replay ancestry flow --- .../src/cc/verify/control_checkpoints.rs | 67 ++++++ .../src/cc/verify/control_finish_creation.rs | 184 ++++++++++++++++ .../src/cc/verify/control_replay.rs | 59 ++++++ crates/psrs-backend/src/cc/verify/mod.rs | 2 + crates/psrs-backend/src/control_provenance.rs | 19 ++ .../src/mir/control_checkpoints.rs | 41 +++- .../src/mir/control_finish_creation.rs | 194 +++++++++++++++++ crates/psrs-backend/src/mir/control_replay.rs | 106 ++++++++++ crates/psrs-backend/src/mir/mod.rs | 1 + crates/psrs-backend/src/mir/value_identity.rs | 34 +++ crates/psrs-backend/src/mir/verify/mod.rs | 1 + .../control_context_contracts/aliases.rs | 74 +++++++ .../src/tests/control_context_contracts/cc.rs | 200 ++++++++++++++++++ .../tests/control_context_contracts/mir.rs | 197 +++++++++++++++++ .../tests/control_context_contracts/mod.rs | 136 ++++++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 39 +++- .../backend/algebraic-effects.md | 59 ++++++ ...ted-control-lowering-handoff-2026-10-11.md | 9 + 20 files changed, 1418 insertions(+), 7 deletions(-) create mode 100644 crates/psrs-backend/src/cc/verify/control_finish_creation.rs create mode 100644 crates/psrs-backend/src/mir/control_finish_creation.rs create mode 100644 crates/psrs-driver/src/tests/control_context_contracts/aliases.rs create mode 100644 crates/psrs-driver/src/tests/control_context_contracts/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_context_contracts/mir.rs create mode 100644 crates/psrs-driver/src/tests/control_context_contracts/mod.rs diff --git a/crates/psrs-backend/src/cc/verify/control_checkpoints.rs b/crates/psrs-backend/src/cc/verify/control_checkpoints.rs index d2fc6183..1e957c1c 100644 --- a/crates/psrs-backend/src/cc/verify/control_checkpoints.rs +++ b/crates/psrs-backend/src/cc/verify/control_checkpoints.rs @@ -145,6 +145,73 @@ pub(super) fn verify( .get(contract.0 as usize) .is_some_and(|helper| helper.role() == R::CloneSequence) => { + if arguments.len() != 5 || origin(arguments[3]) != function.parameters[4] { + return Err(error( + function, + "replay must start with its current execution extent", + )); + } + for empty in &arguments[1..3] { + if !matches!(definitions.get(&origin(*empty)).copied(), Some(A::VariantNew { representation, case: 0, fields, .. }) + if Some(*representation) == table.control_sequence() && fields.is_empty()) + { + return Err(error( + function, + "replay must start with empty traversal accumulators", + )); + } + } + let Some(A::TagSwitch { + value: tag, + cases, + default_value, + .. + }) = definitions.get(&origin(arguments[4])).copied() + else { + return Err(error( + function, + "replay parent must select its current dispatch context", + )); + }; + if !matches!(definitions.get(&origin(*tag)).copied(), Some(A::VariantTag { representation, value, .. }) + if *representation == schema.context && origin(*value) == function.parameters[5]) + || cases.len() != 2 + || !matches!( + definitions.get(&origin(*default_value)).copied(), + Some(A::Unreachable) + ) + { + return Err(error( + function, + "replay parent must select its current dispatch context", + )); + } + let mut seen = std::collections::HashSet::new(); + for case in cases { + let projection = match definitions.get(&origin(case.value)).copied() { + Some(A::VariantGet { + representation, + case: selected, + field, + value, + .. + }) if *representation == schema.context + && *selected as i32 == case.tag => + { + Some((origin(*value), *selected, *field)) + } + _ => None, + }; + dispatch_checkpoint_relation(function.parameters[5], projection) + .map_err(|message| error(function, message))?; + seen.insert(case.tag); + } + if seen != std::collections::HashSet::from([0, 1]) { + return Err(error( + function, + "replay parent must cover root and scoped dispatch contexts", + )); + } let Some(saved) = arguments.first() else { return Err(error(function, "replay has no saved queue")); }; diff --git a/crates/psrs-backend/src/cc/verify/control_finish_creation.rs b/crates/psrs-backend/src/cc/verify/control_finish_creation.rs new file mode 100644 index 00000000..6331d1ff --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control_finish_creation.rs @@ -0,0 +1,184 @@ +//! Check target completion records and immutable finish reassociation. +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control_provenance::{FinishProjection, context_finish_relation}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) + { + return Ok(()); + } + if function.parameters.len() != 6 { + return Err(error( + function, + "finish producer has an invalid executor contract", + )); + } + let context = table + .control_checkpoint_schema() + .ok_or_else(|| error(function, "finish producer has no checked context schema"))? + .context; + let sequence = table + .control_sequence() + .ok_or_else(|| error(function, "finish producer has no checked queue schema"))?; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = |value| { + crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) + }; + let projection = |value, representation, case| match definitions.get(&origin(value)).copied() { + Some(A::VariantGet { + representation: actual, + case: tag, + field, + value, + .. + }) if *actual == representation && *tag == case => Some(FinishProjection { + owner: origin(*value), + field: *field, + }), + _ => None, + }; + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for (index, assignment) in body.iter().enumerate() { + match &assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + A::If { + then_assignments, + else_assignments, + .. + } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), + A::VariantNew { + representation, + case: 3, + fields, + .. + } if *representation == sequence => { + if fields.len() != 3 { + return Err(error( + function, + "finish producer has an invalid frame schema", + )); + } + if projection(fields[0], context, 1).is_some() { + context_finish_relation( + function.parameters[5], + projection(fields[0], context, 1), + projection(fields[1], context, 1), + projection(fields[2], context, 1), + ) + .map_err(|message| error(function, message))?; + let next = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments), + _ => None, + }) + .ok_or_else(|| { + error(function, "target finish has no executor transition") + })?; + if next.len() != 6 + || origin(next[3]) != assignment.destination + || origin(next[4]) != origin(fields[0]) + || projection(next[5], context, 1) + != Some(FinishProjection { + owner: function.parameters[5], + field: 4, + }) + { + return Err(error( + function, + "target finish must enter its caller context with the saved extent", + )); + } + } else { + let extent = projection(fields[0], sequence, 3) + .filter(|projection| projection.field == 0) + .ok_or_else(|| { + error(function, "finish copy must preserve its original extent") + })?; + if projection(fields[2], sequence, 3) + != Some(FinishProjection { + owner: extent.owner, + field: 2, + }) + { + return Err(error( + function, + "finish copy must preserve its original parent", + )); + } + let Some(A::VariantNew { + representation, + case: 2, + fields: appended, + .. + }) = definitions.get(&origin(fields[1])).copied() + else { + return Err(error( + function, + "finish copy must reassociate the original queue", + )); + }; + if *representation != sequence + || appended.len() != 2 + || projection(appended[0], sequence, 3) + != Some(FinishProjection { + owner: extent.owner, + field: 1, + }) + { + return Err(error( + function, + "finish copy must reassociate the original queue", + )); + } + let left = projection(extent.owner, sequence, 2) + .filter(|projection| projection.field == 0) + .ok_or_else(|| { + error(function, "finish copy has no original append input") + })?; + if left.owner != function.parameters[3] + || projection(appended[1], sequence, 2) + != Some(FinishProjection { + owner: left.owner, + field: 1, + }) + { + return Err(error( + function, + "finish copy must retain the original append tail", + )); + } + } + } + _ => {} + } + } + } + Ok(()) +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC finish creation", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/control_replay.rs b/crates/psrs-backend/src/cc/verify/control_replay.rs index 33a12b06..0d45b8d6 100644 --- a/crates/psrs-backend/src/cc/verify/control_replay.rs +++ b/crates/psrs-backend/src/cc/verify/control_replay.rs @@ -85,6 +85,37 @@ pub(super) fn verify( "replay traversal cannot invoke callbacks or mutate lifecycle cells", )); } + A::DirectCall { + contract: Some(id), + arguments, + .. + } if role == Some(R::CloneSequence) => { + let target = table + .control_helpers + .get(id.0 as usize) + .map(|helper| helper.role()); + let valid = match target { + Some(R::CloneSequence) => { + arguments.len() == 5 + && origin(arguments[3]) == parameters[3] + && origin(arguments[4]) == parameters[4] + } + Some(R::RebuildSequence) => { + arguments.len() == 4 + && origin(arguments[0]) == parameters[2] + && origin(arguments[1]) == parameters[1] + && origin(arguments[2]) == parameters[3] + && origin(arguments[3]) == parameters[4] + } + _ => true, + }; + if !valid { + return Err(error( + function, + "clone traversal must preserve its accumulators, active extent and parent", + )); + } + } A::IndirectCall { .. } | A::RuntimeCall { .. } | A::FunctionRef { .. } => { return Err(error( function, @@ -112,6 +143,34 @@ pub(super) fn verify( "replay must share the original callback and retain its accumulator", )); } + if role == Some(R::RebuildSequence) { + let next = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments), + _ => None, + }) + .ok_or_else(|| error(function, "callback rebuild has no transition"))?; + if next.len() != 4 + || projection(next[0], 1) + != Some(FinishProjection { + owner: parameters[0], + field: 1, + }) + || origin(next[1]) != assignment.destination + || origin(next[2]) != parameters[2] + || origin(next[3]) != parameters[3] + { + return Err(error( + function, + "callback rebuild must preserve its active extent and parent", + )); + } + } } A::VariantNew { representation, diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index f935af1b..d80fbd26 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -6,6 +6,7 @@ use std::collections::{HashMap, HashSet}; mod adaptation; mod control_checkpoints; +mod control_finish_creation; mod control_provenance; mod control_replay; mod helpers; @@ -204,6 +205,7 @@ fn verify_function_inner( &function.name, )?; control_checkpoints::verify(function, representations)?; + control_finish_creation::verify(function, representations)?; control_replay::verify(function, representations, functions)?; if !available.contains(&function.result) { return Err(vec![BackendError::invalid_ir( diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control_provenance.rs index 2ab261f9..17ad5da9 100644 --- a/crates/psrs-backend/src/control_provenance.rs +++ b/crates/psrs-backend/src/control_provenance.rs @@ -88,3 +88,22 @@ pub(crate) fn replay_activation_relation( } Ok(()) } + +pub(crate) fn context_finish_relation( + context: ValueId, + extent: Option, + queue: Option, + parent: Option, +) -> Result<(), &'static str> { + for (projection, field) in [(extent, 5), (queue, 2), (parent, 3)] { + if projection + != Some(FinishProjection { + owner: context, + field, + }) + { + return Err("target finish must preserve its source context extent, queue and parent"); + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control_checkpoints.rs b/crates/psrs-backend/src/mir/control_checkpoints.rs index 21e398bf..96d3a5c2 100644 --- a/crates/psrs-backend/src/mir/control_checkpoints.rs +++ b/crates/psrs-backend/src/mir/control_checkpoints.rs @@ -45,8 +45,11 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { layout.variant_index(schema.context, 0), layout.variant_index(schema.context, 1), layout.signature_index(raw.signature()), + table + .control_sequence() + .and_then(|sequence| layout.variant_index(sequence, 0).ok()), ); - let (Ok(resume), Ok(root), Ok(scope), Ok(callable)) = types else { + let (Ok(resume), Ok(root), Ok(scope), Ok(callable), Some(empty)) = types else { errors.push(BackendError::invalid_ir( "P9 MIR control checkpoint", module.span, @@ -64,6 +67,7 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { root, scope, callable, + empty, ) { errors.push( BackendError::invalid_ir("P9 MIR control checkpoint", function.span, message) @@ -83,6 +87,7 @@ fn verify_function( root: DefinedTypeId, scope: DefinedTypeId, callable: DefinedTypeId, + empty: DefinedTypeId, ) -> Result<(), &'static str> { let definitions = definitions(function); let origin = |value| origin(value, &definitions); @@ -181,6 +186,40 @@ fn verify_function( .get(contract.0 as usize) .is_some_and(|helper| helper.role() == R::CloneSequence) => { + if arguments.len() != 5 || origin(arguments[3]) != parameters[4] { + return Err("replay must start with its current execution extent"); + } + for initial in &arguments[1..3] { + if !matches!(definitions.get(&origin(*initial)).copied(), Some(I::StructNew { type_index, arguments, .. }) + if *type_index == empty && arguments.len() == 1 + && matches!(definitions.get(&origin(arguments[0])).copied(), Some(I::Constant { value: 0, .. }))) + { + return Err("replay must start with empty traversal accumulators"); + } + } + let parents = + super::value_identity::incoming_values(function, origin(arguments[4])) + .ok_or("replay parent must select its current dispatch context")?; + let mut seen = std::collections::HashSet::new(); + for parent in parents { + let projection = match definitions.get(&origin(parent)).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *field > 0 && (*type_index == root || *type_index == scope) => { + let case = u32::from(*type_index == scope); + seen.insert(case); + Some((origin(*value), case, field - 1)) + } + _ => None, + }; + dispatch_checkpoint_relation(parameters[5], projection)?; + } + if seen != std::collections::HashSet::from([0, 1]) { + return Err("replay parent must cover root and scoped dispatch contexts"); + } let saved = arguments.first().ok_or("replay has no saved queue")?; let Some(I::StructGet { type_index, diff --git a/crates/psrs-backend/src/mir/control_finish_creation.rs b/crates/psrs-backend/src/mir/control_finish_creation.rs new file mode 100644 index 00000000..87fff95d --- /dev/null +++ b/crates/psrs-backend/src/mir/control_finish_creation.rs @@ -0,0 +1,194 @@ +//! Target completion construction and finish copying after physical lowering. +use super::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use super::{Function, Instruction as I, Module, Terminator as T}; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control_provenance::{FinishProjection, context_finish_relation}; +use crate::types::DefinedTypeId; + +struct Schema { + context: DefinedTypeId, + finish: DefinedTypeId, + append: DefinedTypeId, +} + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let Some(executor) = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + else { + return; + }; + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == executor.function()) + else { + return; + }; + let types = table + .control_checkpoint_schema() + .zip(table.control_sequence()) + .and_then(|(schema, sequence)| { + Some(( + layout.variant_index(schema.context, 1).ok()?, + layout.variant_index(sequence, 3).ok()?, + layout.variant_index(sequence, 2).ok()?, + )) + }); + let Some((context, finish, append)) = types else { + errors.push(BackendError::invalid_ir( + "P9 MIR finish creation", + function.span, + "finish producer has no physical context or queue schema", + )); + return; + }; + if let Err(message) = verify_function( + function, + &Schema { + context, + finish, + append, + }, + ) { + errors.push( + BackendError::invalid_ir("P9 MIR finish creation", function.span, message) + .with_module(function.symbol.module), + ); + } +} + +fn verify_function(function: &Function, schema: &Schema) -> Result<(), &'static str> { + let parameters = loop_parameters(function); + if parameters.len() != 6 { + return Err("finish producer has an invalid executor contract"); + } + let definitions = definitions(function); + let origin = |value| reference_origin(value, &definitions); + let projection = |value, expected| match definitions.get(&origin(value)).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *type_index == expected && *field > 0 => Some(FinishProjection { + owner: origin(*value), + field: field - 1, + }), + _ => None, + }; + for block in &function.blocks { + for (index, instruction) in block.instructions.iter().enumerate() { + let I::StructNew { + type_index, + arguments, + destination, + .. + } = instruction + else { + continue; + }; + if *type_index != schema.finish { + continue; + } + if arguments.len() != 4 + || !matches!( + definitions.get(&origin(arguments[0])).copied(), + Some(I::Constant { value: 3, .. }) + ) + { + return Err("finish producer has an invalid frame schema"); + } + if projection(arguments[1], schema.context).is_some() { + context_finish_relation( + parameters[5], + projection(arguments[1], schema.context), + projection(arguments[2], schema.context), + projection(arguments[3], schema.context), + )?; + let next = block.instructions[index + 1..] + .iter() + .find_map(|instruction| match instruction { + I::Call { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .or_else(|| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == loop_header(function) => Some(arguments.as_slice()), + Some(T::ReturnCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .ok_or("target finish has no executor transition")?; + if next.len() != 6 + || origin(next[3]) != *destination + || origin(next[4]) != origin(arguments[1]) + || projection(next[5], schema.context) + != Some(FinishProjection { + owner: parameters[5], + field: 4, + }) + { + return Err( + "target finish must enter its caller context with the saved extent", + ); + } + } else { + let extent = projection(arguments[1], schema.finish) + .filter(|projection| projection.field == 0) + .ok_or("finish copy must preserve its original extent")?; + if projection(arguments[3], schema.finish) + != Some(FinishProjection { + owner: extent.owner, + field: 2, + }) + { + return Err("finish copy must preserve its original parent"); + } + let Some(I::StructNew { + type_index, + arguments: appended, + .. + }) = definitions.get(&origin(arguments[2])).copied() + else { + return Err("finish copy must reassociate the original queue"); + }; + if *type_index != schema.append + || appended.len() != 3 + || projection(appended[1], schema.finish) + != Some(FinishProjection { + owner: extent.owner, + field: 1, + }) + { + return Err("finish copy must reassociate the original queue"); + } + let left = projection(extent.owner, schema.append) + .filter(|projection| projection.field == 0) + .ok_or("finish copy has no original append input")?; + if left.owner != parameters[3] + || projection(appended[2], schema.append) + != Some(FinishProjection { + owner: left.owner, + field: 1, + }) + { + return Err("finish copy must retain the original append tail"); + } + } + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control_replay.rs b/crates/psrs-backend/src/mir/control_replay.rs index 2fc88ccc..3caa7463 100644 --- a/crates/psrs-backend/src/mir/control_replay.rs +++ b/crates/psrs-backend/src/mir/control_replay.rs @@ -141,6 +141,7 @@ fn verify_function( I::StructNew { type_index, arguments, + destination, .. } if *type_index == schema.cons => { let accumulator = parameters[if role == R::CloneSequence { 2 } else { 1 }]; @@ -157,6 +158,46 @@ fn verify_function( "replay must share the original callback and retain its accumulator", ); } + if role == R::RebuildSequence { + let next = block.instructions[index + 1..] + .iter() + .find_map(|instruction| match instruction { + I::Call { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .or_else(|| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == loop_header(function) => { + Some(arguments.as_slice()) + } + Some(T::ReturnCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .ok_or("callback rebuild has no transition")?; + if next.len() != 4 + || projection(next[0], schema.cons) + != Some(FinishProjection { + owner: parameters[0], + field: 1, + }) + || origin(next[1]) != *destination + || origin(next[2]) != parameters[2] + || origin(next[3]) != parameters[3] + { + return Err( + "callback rebuild must preserve its active extent and parent", + ); + } + } } I::StructNew { type_index, @@ -312,6 +353,71 @@ fn verify_function( _ => {} } } + if role == R::CloneSequence { + let calls = block + .instructions + .iter() + .filter_map(|instruction| match instruction { + I::Call { + contract: Some(id), + arguments, + .. + } => Some((*id, arguments.as_slice())), + _ => None, + }) + .chain( + block + .terminator + .iter() + .filter_map(|terminator| match terminator { + T::ReturnCall { + contract: Some(id), + arguments, + .. + } => Some((*id, arguments.as_slice())), + _ => None, + }), + ); + for (id, arguments) in calls { + let valid = match table + .control_helpers + .get(id.0 as usize) + .map(|helper| helper.role()) + { + Some(R::CloneSequence) => { + arguments.len() == 5 + && origin(arguments[3]) == parameters[3] + && origin(arguments[4]) == parameters[4] + } + Some(R::RebuildSequence) => { + arguments.len() == 4 + && origin(arguments[0]) == parameters[2] + && origin(arguments[1]) == parameters[1] + && origin(arguments[2]) == parameters[3] + && origin(arguments[3]) == parameters[4] + } + _ => true, + }; + if !valid { + return Err( + "clone traversal must preserve its accumulators, active extent and parent", + ); + } + } + if let Some(T::Jump { + target, arguments, .. + }) = &block.terminator + && block.id != function.entry + && Some(*target) == loop_header(function) + && (arguments.len() != 5 + || origin(arguments[3]) != parameters[3] + || origin(arguments[4]) != parameters[4]) + { + return Err( + "clone traversal must preserve its accumulators, active extent and parent", + ); + } + } match &block.terminator { Some(T::ReturnCallRef { .. }) => { return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 6dd6653d..97db621d 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -9,6 +9,7 @@ use std::collections::{HashMap, HashSet}; pub(crate) mod cfg; mod control_checkpoints; mod control_contracts; +mod control_finish_creation; mod control_provenance; mod control_replay; mod instruction; diff --git a/crates/psrs-backend/src/mir/value_identity.rs b/crates/psrs-backend/src/mir/value_identity.rs index 32a39484..d96415bf 100644 --- a/crates/psrs-backend/src/mir/value_identity.rs +++ b/crates/psrs-backend/src/mir/value_identity.rs @@ -52,3 +52,37 @@ pub(crate) fn loop_parameters(function: &Function) -> &[ValueId] { .find(|block| Some(block.id) == header) .map_or(&function.parameters, |block| &block.parameters) } + +/// Incoming values of a non-loop SSA join parameter. Unknown edges are not +/// treated as a valid empty provenance set. +pub(crate) fn incoming_values(function: &Function, value: ValueId) -> Option> { + let (block, index) = function.blocks.iter().find_map(|block| { + block + .parameters + .iter() + .position(|parameter| *parameter == value) + .map(|index| (block, index)) + })?; + if Some(block.id) == loop_header(function) { + return None; + } + let mut incoming = Vec::new(); + for predecessor in &function.blocks { + let Some(terminator) = &predecessor.terminator else { + continue; + }; + if super::cfg::successors(terminator).contains(&block.id) { + let Terminator::Jump { + target, arguments, .. + } = terminator + else { + return None; + }; + if *target != block.id { + return None; + } + incoming.push(*arguments.get(index)?); + } + } + (!incoming.is_empty()).then_some(incoming) +} diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index adabde8b..08f5651c 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -36,6 +36,7 @@ pub fn verify_module(module: &Module) -> Result<(), Vec> { super::control_provenance::verify(module, &mut errors); super::control_checkpoints::verify(module, &mut errors); super::control_replay::verify(module, &mut errors); + super::control_finish_creation::verify(module, &mut errors); verify_defined_types(module, &mut errors); let mut signatures = module .functions diff --git a/crates/psrs-driver/src/tests/control_context_contracts/aliases.rs b/crates/psrs-driver/src/tests/control_context_contracts/aliases.rs new file mode 100644 index 00000000..2e846e5e --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_contracts/aliases.rs @@ -0,0 +1,74 @@ +//! A dispatch join retains identity through an ordinary SSA copy. +use super::{R, SOURCE, binding}; +use psrs_backend::cc::ValueId; +use psrs_backend::mir::{Instruction as I, Terminator as T}; + +#[test] +fn dispatch_parent_join_accepts_reference_identity_copies() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let executor = binding(&stages.cc.representations, R::Executor).0; + let clone = binding(&stages.cc.representations, R::CloneSequence).1; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == executor) + .unwrap(); + let parent = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::Call { + contract: Some(id), + arguments, + .. + } if *id == clone => Some(arguments[4]), + _ => None, + }) + .unwrap(); + let (target, index) = function + .blocks + .iter() + .find_map(|block| { + block + .parameters + .iter() + .position(|parameter| *parameter == parent) + .map(|index| (block.id, index)) + }) + .unwrap(); + let source_block = function.blocks.iter().position(|block| matches!(&block.terminator, Some(T::Jump { target: next, .. }) if *next == target)).unwrap(); + let Some(T::Jump { arguments, .. }) = &function.blocks[source_block].terminator else { + unreachable!() + }; + let value = arguments[index]; + let ty = function + .values + .iter() + .find(|declaration| declaration.id == value) + .unwrap() + .ty; + let alias = ValueId( + function + .values + .iter() + .map(|declaration| declaration.id.0) + .max() + .unwrap() + + 1, + ); + function + .values + .push(psrs_backend::types::ValueDecl { id: alias, ty }); + function.blocks[source_block].instructions.push(I::Copy { + destination: alias, + value, + span: function.span, + }); + let Some(T::Jump { arguments, .. }) = &mut function.blocks[source_block].terminator else { + unreachable!() + }; + arguments[index] = alias; + psrs_backend::mir::verify_module(&stages.mir).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/cc.rs b/crates/psrs-driver/src/tests/control_context_contracts/cc.rs new file mode 100644 index 00000000..05490315 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_contracts/cc.rs @@ -0,0 +1,200 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, RefShape, ValueId, ValueShape}; +use std::collections::HashMap; + +fn index(body: &[Assignment], definitions: &mut HashMap) { + for assignment in body { + definitions.insert(assignment.destination, assignment.kind.clone()); + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &assignment.kind + { + for case in cases { + index(&case.assignments, definitions); + } + index(default_assignments, definitions); + } + } +} +fn visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut Assignment) -> bool) -> bool { + for assignment in body { + if mutate(assignment) { + return true; + } + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &mut assignment.kind + { + for case in cases { + if visit(&mut case.assignments, mutate) { + return true; + } + } + if visit(default_assignments, mutate) { + return true; + } + } + } + false +} + +pub(super) fn reject(mutation: Mutation) { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = binding(&input.cc.representations, mutation.role()).0; + let clone = binding(&input.cc.representations, R::CloneSequence).1; + let executor = binding(&input.cc.representations, R::Executor).1; + let signature = input + .cc + .representations + .signature(input.cc.representations.control_helpers[executor.0 as usize].signature()) + .unwrap(); + let repr = |shape| match shape { + ValueShape::Reference(reference) => match reference.heap { + RefShape::Repr(id) => id, + _ => unreachable!(), + }, + _ => unreachable!(), + }; + let context = repr(signature.parameters[5]); + let sequence = repr(signature.parameters[3]); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let parameters = function.parameters.clone(); + let mut definitions = HashMap::new(); + index(&function.assignments, &mut definitions); + let context_extent = |value| matches!(definitions.get(&value), Some(A::VariantGet { representation, case: 1, field: 5, .. }) if *representation == context); + let target_finish = definitions.iter().find_map(|(value, kind)| match kind { + A::VariantNew { + representation, + case: 3, + fields, + .. + } if *representation == sequence && context_extent(fields[0]) => Some(*value), + _ => None, + }); + let changed = visit( + &mut function.assignments, + &mut |assignment| match mutation { + Mutation::FinishExtent | Mutation::FinishQueue | Mutation::FinishParent => { + if Some(assignment.destination) != target_finish { + return false; + } + let A::VariantNew { fields, .. } = &mut assignment.kind else { + unreachable!() + }; + match mutation { + Mutation::FinishExtent => fields[0] = parameters[4], + Mutation::FinishQueue => fields[1] = parameters[3], + Mutation::FinishParent => fields[2] = parameters[4], + _ => unreachable!(), + } + true + } + Mutation::CallerContext => match &mut assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == symbol && Some(arguments[3]) == target_finish => { + arguments[5] = parameters[5]; + true + } + _ => false, + }, + Mutation::CopyParent => match &mut assignment.kind { + A::VariantNew { + representation, + case: 3, + fields, + .. + } if *representation == sequence && !context_extent(fields[0]) => { + fields[2] = parameters[4]; + true + } + _ => false, + }, + Mutation::CopyOrder => match &mut assignment.kind { + A::VariantNew { + representation, + case: 2, + fields, + .. + } if *representation == sequence + && matches!( + definitions.get(&fields[0]), + Some(A::VariantGet { + case: 3, + field: 1, + .. + }) + ) => + { + fields.swap(0, 1); + true + } + _ => false, + }, + Mutation::SeedParent | Mutation::SeedActive | Mutation::SeedAccumulator => { + match &mut assignment.kind { + A::DirectCall { + contract: Some(id), + arguments, + .. + } if *id == clone => { + match mutation { + Mutation::SeedParent => arguments[4] = parameters[4], + Mutation::SeedActive => arguments[3] = arguments[4], + Mutation::SeedAccumulator => arguments[1] = arguments[0], + _ => unreachable!(), + } + true + } + _ => false, + } + } + Mutation::CloneForward => match &mut assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == symbol => { + arguments[4] = parameters[3]; + true + } + _ => false, + }, + Mutation::CallbackForward => match &mut assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == symbol + && matches!( + definitions.get(&arguments[1]), + Some(A::VariantNew { case: 1, .. }) + ) => + { + arguments[3] = parameters[2]; + true + } + _ => false, + }, + }, + ); + assert!(changed); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/mir.rs b/crates/psrs-driver/src/tests/control_context_contracts/mir.rs new file mode 100644 index 00000000..98b0bbd0 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_contracts/mir.rs @@ -0,0 +1,197 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::ValueId; +use psrs_backend::mir::{Instruction as I, Terminator as T}; +use std::collections::HashMap; + +pub(super) fn reject(mutation: Mutation) { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let symbol = binding(&stages.cc.representations, mutation.role()).0; + let clone = binding(&stages.cc.representations, R::CloneSequence).1; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let entry = function + .blocks + .iter() + .find(|block| block.id == function.entry) + .unwrap(); + let Some(T::Jump { + target: header, + arguments, + .. + }) = &entry.terminator + else { + unreachable!() + }; + assert_eq!(arguments, &function.parameters); + let header = *header; + let parameters = function + .blocks + .iter() + .find(|block| block.id == header) + .unwrap() + .parameters + .clone(); + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| { + instruction + .destination() + .map(|destination| (destination, instruction.clone())) + }) + .collect::>(); + let origin = |mut value: ValueId| { + for _ in 0..definitions.len() { + match definitions.get(&value) { + Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { + value = *source + } + _ => break, + } + } + value + }; + let context_extent = |value| matches!(definitions.get(&origin(value)), Some(I::StructGet { field: 6, value, .. }) if origin(*value) == parameters[5]); + let target_finish = if parameters.len() == 6 { + definitions + .iter() + .find_map(|(value, instruction)| match instruction { + I::StructNew { arguments, .. } + if arguments.len() == 4 && context_extent(arguments[1]) => + { + Some(*value) + } + _ => None, + }) + } else { + None + }; + let copied_append = if matches!(mutation, Mutation::CopyOrder) { + definitions + .values() + .find_map(|instruction| match instruction { + I::StructNew { arguments, .. } + if arguments.len() == 4 && !context_extent(arguments[1]) => + { + Some(origin(arguments[2])) + } + _ => None, + }) + } else { + None + }; + let mut changed = false; + match mutation { + Mutation::FinishExtent + | Mutation::FinishQueue + | Mutation::FinishParent + | Mutation::CopyParent + | Mutation::CopyOrder => { + for instruction in function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + { + let I::StructNew { + destination, + arguments, + .. + } = instruction + else { + continue; + }; + let target = match mutation { + Mutation::CopyParent => arguments.len() == 4 && !context_extent(arguments[1]), + Mutation::CopyOrder => Some(*destination) == copied_append, + _ => Some(*destination) == target_finish, + }; + if !target { + continue; + } + match mutation { + Mutation::FinishExtent => arguments[1] = parameters[4], + Mutation::FinishQueue => arguments[2] = parameters[3], + Mutation::FinishParent | Mutation::CopyParent => arguments[3] = parameters[4], + Mutation::CopyOrder => arguments.swap(1, 2), + _ => unreachable!(), + } + changed = true; + break; + } + } + Mutation::SeedParent | Mutation::SeedActive | Mutation::SeedAccumulator => { + for instruction in function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + { + if let I::Call { + contract: Some(id), + arguments, + .. + } = instruction + { + if *id != clone { + continue; + } + match mutation { + Mutation::SeedParent => arguments[4] = parameters[4], + Mutation::SeedActive => arguments[3] = arguments[4], + Mutation::SeedAccumulator => arguments[1] = arguments[0], + _ => unreachable!(), + } + changed = true; + break; + } + } + } + Mutation::CallerContext | Mutation::CloneForward | Mutation::CallbackForward => { + for block in &mut function.blocks { + if block.id == function.entry { + continue; + } + let Some(T::Jump { + target, arguments, .. + }) = &mut block.terminator + else { + continue; + }; + if *target != header { + continue; + } + let target = match mutation { + Mutation::CallerContext => Some(origin(arguments[3])) == target_finish, + Mutation::CloneForward => true, + Mutation::CallbackForward => { + matches!(definitions.get(&origin(arguments[1])), Some(I::StructNew { arguments, .. }) if arguments.len() == 3 && matches!(definitions.get(&origin(arguments[1])), Some(I::StructGet { field: 1, .. }))) + } + _ => unreachable!(), + }; + if !target { + continue; + } + match mutation { + Mutation::CallerContext => arguments[5] = parameters[5], + Mutation::CloneForward => arguments[4] = parameters[3], + Mutation::CallbackForward => arguments[3] = parameters[2], + _ => unreachable!(), + } + changed = true; + break; + } + } + } + assert!(changed); + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/mod.rs b/crates/psrs-driver/src/tests/control_context_contracts/mod.rs new file mode 100644 index 00000000..aaa154f8 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_contracts/mod.rs @@ -0,0 +1,136 @@ +//! Verify completion context creation and replay ancestry seeding/propagation. +mod aliases; +mod cc; +mod mir; +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::ControlHelperRole as R; + +#[derive(Clone, Copy)] +enum Mutation { + FinishExtent, + FinishQueue, + FinishParent, + CallerContext, + CopyParent, + CopyOrder, + SeedParent, + SeedActive, + SeedAccumulator, + CloneForward, + CallbackForward, +} +impl Mutation { + fn role(self) -> R { + match self { + Self::CloneForward => R::CloneSequence, + Self::CallbackForward => R::RebuildSequence, + _ => R::Executor, + } + } + fn message(self) -> &'static str { + match self { + Self::FinishExtent => "finish copy must preserve its original extent", + Self::FinishQueue | Self::FinishParent => { + "target finish must preserve its source context" + } + Self::CallerContext => "enter its caller context with the saved extent", + Self::CopyParent => "finish copy must preserve its original parent", + Self::CopyOrder => "finish copy must reassociate the original queue", + Self::SeedParent => "replay parent must select its current dispatch context", + Self::SeedActive => "start with its current execution extent", + Self::SeedAccumulator => "start with empty traversal accumulators", + Self::CloneForward => { + "clone traversal must preserve its accumulators, active extent and parent" + } + Self::CallbackForward => "callback rebuild must preserve its active extent and parent", + } + } +} +#[test] +fn cc_target_finish_uses_its_context_extent() { + cc::reject(Mutation::FinishExtent); +} +#[test] +fn mir_target_finish_uses_its_context_extent() { + mir::reject(Mutation::FinishExtent); +} +#[test] +fn cc_target_finish_uses_its_context_queue() { + cc::reject(Mutation::FinishQueue); +} +#[test] +fn mir_target_finish_uses_its_context_queue() { + mir::reject(Mutation::FinishQueue); +} +#[test] +fn cc_target_finish_uses_its_context_parent() { + cc::reject(Mutation::FinishParent); +} +#[test] +fn mir_target_finish_uses_its_context_parent() { + mir::reject(Mutation::FinishParent); +} +#[test] +fn cc_target_finish_enters_its_caller_context() { + cc::reject(Mutation::CallerContext); +} +#[test] +fn mir_target_finish_enters_its_caller_context() { + mir::reject(Mutation::CallerContext); +} +#[test] +fn cc_finish_copy_preserves_its_parent() { + cc::reject(Mutation::CopyParent); +} +#[test] +fn mir_finish_copy_preserves_its_parent() { + mir::reject(Mutation::CopyParent); +} +#[test] +fn cc_finish_copy_preserves_append_order() { + cc::reject(Mutation::CopyOrder); +} +#[test] +fn mir_finish_copy_preserves_append_order() { + mir::reject(Mutation::CopyOrder); +} +#[test] +fn cc_replay_parent_comes_from_dispatch() { + cc::reject(Mutation::SeedParent); +} +#[test] +fn mir_replay_parent_comes_from_dispatch() { + mir::reject(Mutation::SeedParent); +} +#[test] +fn cc_replay_starts_with_current_active_extent() { + cc::reject(Mutation::SeedActive); +} +#[test] +fn mir_replay_starts_with_current_active_extent() { + mir::reject(Mutation::SeedActive); +} +#[test] +fn cc_replay_starts_with_empty_accumulators() { + cc::reject(Mutation::SeedAccumulator); +} +#[test] +fn mir_replay_starts_with_empty_accumulators() { + mir::reject(Mutation::SeedAccumulator); +} +#[test] +fn cc_clone_preserves_parent_during_traversal() { + cc::reject(Mutation::CloneForward); +} +#[test] +fn mir_clone_preserves_parent_during_traversal() { + mir::reject(Mutation::CloneForward); +} +#[test] +fn cc_callback_rebuild_preserves_parent() { + cc::reject(Mutation::CallbackForward); +} +#[test] +fn mir_callback_rebuild_preserves_parent() { + mir::reject(Mutation::CallbackForward); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 8487cf05..3f078fdb 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -10,6 +10,7 @@ mod coercion; mod control_carriers; mod control_checkpoint_ordering; mod control_checkpoints; +mod control_context_contracts; mod control_contracts; mod control_costs; mod control_finish_provenance; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 5bc80a57..b4f9c493 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Complete execution-step, root/dispatch seeding and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Complete execution-step, context-entry and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index eb2da5a7..2d2a2c0d 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -341,11 +341,40 @@ instruction effect owner for this summary; neither stage makes a name-based exception for a cost probe. This leaves ordinary trapping ancestry checks valid without admitting a shape-compatible close operation. -These checks cover recognizable copy/rebuild nodes and transitions. They do not -prove complete traversal if a rewrite removes an entire required step, all -root/dispatch seeding and propagation relationships, finish production from its -source context, or caught-host-trap cleanup. Those obligations remain part of -complete lifecycle and execution-step verification. +These checks cover recognizable copy/rebuild nodes and transitions. At replay +entry, traversal starts with empty accumulators and the current execution extent; +its ancestry parent comes from the current dispatch context. CC checks the +root/scoped selector and both source projections. MIR checks every incoming +value of the corresponding SSA join, preserving reference copies/casts and +rejecting unknown or absent provenance. Clone traversal and handoff to rebuild +preserve active/parent state and accumulators; rebuilding callback nodes preserves +the current active extent and parent. The entry preheader forwards the original +function parameters, while actual loop back edges retain the current loop state. + +These relations do not prove whole traversal if a rewrite removes an entire +required step, full context-entry/dispatch selection semantics, or caught-host-trap +cleanup. Those obligations remain part of complete lifecycle and execution-step +verification. + +### Finish creation and reassociation + +A target-completion finish must take extent, saved queue and parent from fields +five, two and three of the current scoped source context. Its execution step +passes that finish, its saved extent and field four's caller context. Compatible +execution extents, queue references or the current source context cannot replace +these operands: target clauses run in the caller's dispatch context. + +A finish copied during append reassociation preserves extent and parent from one +original finish. Its queue appends that finish's remaining queue before the +original append tail, retaining both operands and their order. Both the returned +value path and handle-queue normalization follow this relation. + +CC reads actual context/queue projections, constructors and calls through shared +reference identity. MIR repeats the relations over physical case fields, copies, +casts and loop/call transitions. These checks validate existing production and +copy steps; deleting an entire required step still needs full execution-step +coverage. Creating every source context with the right clauses and identities +remains a separate producer obligation. ### Finish consumption ownership diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 81a076f8..a5352985 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1285,3 +1285,62 @@ Logs: `/private/tmp/psrs-replay-structural-final.log`, `/private/tmp/psrs-replay-clippy-final.log`. Explicit upstream type comparison, package conformance and suite scoreboards are not rerun for this internal invariant change. No measured gate number changes. + + +## Completion context creation and replay ancestry flow (2026-10-12) + +Starting point: compiler `b2dd6476`, branch `feat/effect-handlers`, clean checkout. +CC/MIR now verify target finish production from the current scoped source context +(extent, saved queue, parent) and target entry with the saved extent and caller +context. Copying a finish during append reassociation retains its original extent +and parent, appending the original remaining queue before the original append +tail. Both returned-queue reassociation and handle normalization are covered by +the same relation. + +Replay starts with empty traversal accumulators, the current execution extent +and an ancestry parent selected from the current root/scoped dispatch context. +CC checks the selector, projections and context identity. MIR reads actual SSA +join incoming values through reference identities; unknown edges and empty +provenance sets are not accepted. Clone back edges and handoff to rebuild retain +active/parent state and accumulators, while callback rebuild retains the current +active extent and parent. The entry preheader's original-parameter forwarding is +distinct from iteration back edges. A generic join-source operation shares these +SSA facts without adding runtime metadata or reconstructing source types. + +| Requirement | Evidence | Status | +| --- | --- | --- | +| Preserve the scoped source context's extent, queue and parent in a target finish | `cc_target_finish_uses_its_context_extent`, `mir_target_finish_uses_its_context_extent`, paired CC/MIR context-queue and context-parent tests | Focused Verified | +| Enter the target in the saved caller context | `cc_target_finish_enters_its_caller_context`, `mir_target_finish_enters_its_caller_context` | Focused Verified | +| Preserve original finish identity and append order during reassociation | `cc_finish_copy_preserves_its_parent`, `mir_finish_copy_preserves_its_parent`, `cc_finish_copy_preserves_append_order`, `mir_finish_copy_preserves_append_order` | Focused Verified | +| Seed ancestry from current dispatch and active extent from current execution | `cc_replay_parent_comes_from_dispatch`, `mir_replay_parent_comes_from_dispatch`, paired current-active-extent tests | Focused Verified | +| Start traversal with empty accumulators | `cc_replay_starts_with_empty_accumulators`, `mir_replay_starts_with_empty_accumulators` | Focused Verified | +| Preserve ancestry through traversal and callback rebuild | Paired `clone_preserves_parent_during_traversal` and `callback_rebuild_preserves_parent` tests | Focused Verified | +| Admit identity-preserving SSA transformations at the parent join | `dispatch_parent_join_accepts_reference_identity_copies`, optimized MIR with an added copy on an incoming edge | Focused Verified | + +These checks validate recognizable constructor and transition operands. They do +not establish every context-entry constructor, correct clause selection, all +algorithmic traversal steps or equivalence after an entire required step is +removed. Complete frame/context and execution-step provenance, foreign capture, +caught-host-trap cleanup, pinned upstream comparison and general allocation +obligations remain open. No full AE/AC row is declared complete. + +Validation: all twenty-three new structural/malformed-IR cases pass, and the final +focused control filter passes 84 driver tests with mandatory Wasmtime, including +existing actual ancestry/GC and no-tail-call execution. Mandatory workspace +execution passes 435 backend tests, 95 Core tests and all 81 control integration +tests. Driver library results are 595 passed and 162 failed. The nine failing +targets and 175 failed test names exactly match `b2dd6476`, with no added or +recovered names; this compares names, not all baseline causes. `cargo fmt --all +--check`, `git diff --check` and final `cargo clippy --workspace --all-targets -- +-D warnings` pass. A syntax-only lint repair to the existing jump guard was +followed by the final focused rerun. + +The six measured ancestry/GC components retain the preceding replay slice's +exact fingerprints, collection counts and maximum post-GC live bytes. Logs: +`/private/tmp/psrs-context-structural.log`, +`/private/tmp/psrs-context-focused-final.log`, +`/private/tmp/psrs-context-workspace.log`, +`/private/tmp/psrs-context-comparison.json`, and +`/private/tmp/psrs-context-clippy-final.log`. Explicit upstream type comparison, +package conformance and suite scoreboards are not rerun for this internal +invariant change. No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 811f530c..cd297ad9 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -74,6 +74,15 @@ Twenty new cases include malformed CC/MIR and actual execution of nested replay with status allocation moved before dispatch and expressed as filled storage. Complete traversal, initial root/dispatch seeding, finish production and host cleanup still require their remaining proofs. +The continuation from `b2dd6476` checks target-finish production from one source +context and entry into its caller context, plus immutable finish reassociation +with original extent/parent and append order. Replay seeding uses empty +accumulators, the current execution extent and the dispatch context's ancestry +parent. CC checks the root/scoped selector; MIR checks the join's incoming +references. Traversal, handoff and callback rebuild preserve the required active, +parent and accumulator identities. Twenty-three new cases include a valid SSA +copy at the dispatch-parent join. Entire-step deletion, context-entry production, +full selection/algorithm coverage and host cleanup remain open. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From a9d87844eb9453698e16baa8cd27e53b92d12253 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 14:34:04 +0800 Subject: [PATCH 117/148] refactor(backend): group control contracts and verifiers by stage --- .../contracts.rs} | 22 ++++---- .../helpers.rs} | 50 +++++++++---------- crates/psrs-backend/src/cc/control/mod.rs | 13 +++++ .../contracts.rs} | 6 +-- .../cc/layout/{control.rs => control/mod.rs} | 16 ++++-- crates/psrs-backend/src/cc/layout/mod.rs | 3 +- .../psrs-backend/src/cc/lower/control/mod.rs | 2 +- .../src/cc/lower/control/operands.rs | 2 +- crates/psrs-backend/src/cc/mod.rs | 13 ++--- .../checkpoints.rs} | 0 .../finish_consumption.rs} | 0 .../finish_creation.rs} | 0 .../psrs-backend/src/cc/verify/control/mod.rs | 28 +++++++++++ .../{control_replay.rs => control/replay.rs} | 2 +- crates/psrs-backend/src/cc/verify/mod.rs | 11 ++-- .../psrs-backend/src/cc/verify/ops/control.rs | 2 +- .../checkpoints.rs} | 12 ++--- .../contracts.rs} | 8 +-- .../finish_consumption.rs} | 8 +-- .../finish_creation.rs} | 4 +- crates/psrs-backend/src/mir/control/mod.rs | 20 ++++++++ .../{control_replay.rs => control/replay.rs} | 16 +++--- crates/psrs-backend/src/mir/lower/mod.rs | 2 +- crates/psrs-backend/src/mir/mod.rs | 6 +-- crates/psrs-backend/src/mir/verify/mod.rs | 6 +-- ...ted-control-lowering-handoff-2026-10-11.md | 22 ++++++++ 26 files changed, 173 insertions(+), 101 deletions(-) rename crates/psrs-backend/src/cc/{control_contract.rs => control/contracts.rs} (81%) rename crates/psrs-backend/src/cc/{control_helpers.rs => control/helpers.rs} (79%) create mode 100644 crates/psrs-backend/src/cc/control/mod.rs rename crates/psrs-backend/src/cc/layout/{control_contracts.rs => control/contracts.rs} (99%) rename crates/psrs-backend/src/cc/layout/{control.rs => control/mod.rs} (91%) rename crates/psrs-backend/src/cc/verify/{control_checkpoints.rs => control/checkpoints.rs} (100%) rename crates/psrs-backend/src/cc/verify/{control_provenance.rs => control/finish_consumption.rs} (100%) rename crates/psrs-backend/src/cc/verify/{control_finish_creation.rs => control/finish_creation.rs} (100%) create mode 100644 crates/psrs-backend/src/cc/verify/control/mod.rs rename crates/psrs-backend/src/cc/verify/{control_replay.rs => control/replay.rs} (99%) rename crates/psrs-backend/src/mir/{control_checkpoints.rs => control/checkpoints.rs} (96%) rename crates/psrs-backend/src/mir/{control_contracts.rs => control/contracts.rs} (96%) rename crates/psrs-backend/src/mir/{control_provenance.rs => control/finish_consumption.rs} (96%) rename crates/psrs-backend/src/mir/{control_finish_creation.rs => control/finish_creation.rs} (97%) create mode 100644 crates/psrs-backend/src/mir/control/mod.rs rename crates/psrs-backend/src/mir/{control_replay.rs => control/replay.rs} (97%) diff --git a/crates/psrs-backend/src/cc/control_contract.rs b/crates/psrs-backend/src/cc/control/contracts.rs similarity index 81% rename from crates/psrs-backend/src/cc/control_contract.rs rename to crates/psrs-backend/src/cc/control/contracts.rs index 781103b9..9bc7e9c9 100644 --- a/crates/psrs-backend/src/cc/control_contract.rs +++ b/crates/psrs-backend/src/cc/control/contracts.rs @@ -1,7 +1,7 @@ //! Immutable source contracts checked by Core and quoted before representation //! erasure. No Core arena indices remain in the published CC evidence. -use super::{ReprId, SignatureId}; +use crate::cc::{ReprId, SignatureId}; use psrs_hir::{Intrinsic, TypeId, TypeVariableId}; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] @@ -60,14 +60,14 @@ pub struct ControlDomain { } #[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub(super) enum ControlImplementation { +pub(in crate::cc) enum ControlImplementation { Frame { representation: ReprId, case: u32, }, Call { signature: SignatureId, - role: super::ControlHelperRole, + role: crate::cc::ControlHelperRole, }, } @@ -75,14 +75,14 @@ pub(super) enum ControlImplementation { /// Its fields are immutable to callers constructing or inspecting CC. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ControlContract { - pub(super) implementation: ControlImplementation, - pub(super) result_identity: SourceTypeIdentityId, - pub(super) argument_identities: Vec, - pub(super) operation: Intrinsic, - pub(super) result: TypeIdentity, - pub(super) arguments: Vec, - pub(super) source: Option, - pub(super) target: Option, + pub(in crate::cc) implementation: ControlImplementation, + pub(in crate::cc) result_identity: SourceTypeIdentityId, + pub(in crate::cc) argument_identities: Vec, + pub(in crate::cc) operation: Intrinsic, + pub(in crate::cc) result: TypeIdentity, + pub(in crate::cc) arguments: Vec, + pub(in crate::cc) source: Option, + pub(in crate::cc) target: Option, } impl ControlContract { diff --git a/crates/psrs-backend/src/cc/control_helpers.rs b/crates/psrs-backend/src/cc/control/helpers.rs similarity index 79% rename from crates/psrs-backend/src/cc/control_helpers.rs rename to crates/psrs-backend/src/cc/control/helpers.rs index 2ebb438d..861313ba 100644 --- a/crates/psrs-backend/src/cc/control_helpers.rs +++ b/crates/psrs-backend/src/cc/control/helpers.rs @@ -1,5 +1,5 @@ //! Stable semantic identities of predeclared control-machine helpers. -use super::SignatureId; +use crate::cc::SignatureId; use psrs_hir::SymbolId; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] @@ -34,9 +34,9 @@ impl ControlHelperRole { /// the same physical signature. Only P8 planning publishes these bindings. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ControlHelperContract { - pub(super) role: ControlHelperRole, - pub(super) function: SymbolId, - pub(super) signature: SignatureId, + pub(in crate::cc) role: ControlHelperRole, + pub(in crate::cc) function: SymbolId, + pub(in crate::cc) signature: SignatureId, } impl ControlHelperContract { @@ -51,18 +51,18 @@ impl ControlHelperContract { } } -impl super::RepresentationTable { - pub(crate) fn control_sequence(&self) -> Option { +impl crate::cc::RepresentationTable { + pub(crate) fn control_sequence(&self) -> Option { let helper = self .control_helpers .iter() .find(|helper| helper.role == ControlHelperRole::CloneSequence)?; - let super::ValueShape::Reference(reference) = + let crate::cc::ValueShape::Reference(reference) = *self.signature(helper.signature)?.parameters.first()? else { return None; }; - let super::RefShape::Repr(sequence) = reference.heap else { + let crate::cc::RefShape::Repr(sequence) = reference.heap else { return None; }; Some(sequence) @@ -102,8 +102,8 @@ impl super::RepresentationTable { /// Its callable protocol excludes the hidden capture receiver parameter. #[derive(Clone, Debug, PartialEq, Eq)] pub struct ControlResumptionContract { - pub(super) function: SymbolId, - pub(super) signature: SignatureId, + pub(in crate::cc) function: SymbolId, + pub(in crate::cc) signature: SignatureId, } impl ControlResumptionContract { @@ -117,23 +117,23 @@ impl ControlResumptionContract { #[derive(Clone, Copy)] pub(crate) struct ControlCheckpointSchema { - pub computation: super::ReprId, - pub context: super::ReprId, + pub computation: crate::cc::ReprId, + pub context: crate::cc::ReprId, } -impl super::RepresentationTable { +impl crate::cc::RepresentationTable { pub(crate) fn control_checkpoint_schema(&self) -> Option { let parameter = |role, index| { let helper = self .control_helpers .iter() .find(|helper| helper.role() == role)?; - let super::ValueShape::Reference(reference) = + let crate::cc::ValueShape::Reference(reference) = *self.signature(helper.signature())?.parameters.get(index)? else { return None; }; - let super::RefShape::Repr(repr) = reference.heap else { + let crate::cc::RefShape::Repr(repr) = reference.heap else { return None; }; Some(repr) @@ -147,17 +147,17 @@ impl super::RepresentationTable { #[derive(Clone, Copy)] pub(crate) struct ControlReplaySchema { - pub sequence: super::ReprId, - pub boundary: super::ReprId, - pub status: super::ReprId, - pub result: super::ReprId, + pub sequence: crate::cc::ReprId, + pub boundary: crate::cc::ReprId, + pub status: crate::cc::ReprId, + pub result: crate::cc::ReprId, } -impl super::RepresentationTable { +impl crate::cc::RepresentationTable { pub(crate) fn control_replay_schema(&self) -> Option { let repr = |shape| match shape { - super::ValueShape::Reference(super::Reference { - heap: super::RefShape::Repr(id), + crate::cc::ValueShape::Reference(crate::cc::Reference { + heap: crate::cc::RefShape::Repr(id), nullable: false, }) => Some(id), _ => None, @@ -172,14 +172,14 @@ impl super::RepresentationTable { }; let sequence = self.control_sequence()?; let boundary = repr(*signature(ControlHelperRole::Check)?.parameters.first()?)?; - let super::Representation::Variant { cases } = self.representation(boundary)? else { + let crate::cc::Representation::Variant { cases } = self.representation(boundary)? else { return None; }; let status = repr(*cases.iter().find(|case| case.tag == 1)?.fields.first()?)?; if !matches!( self.representation(status), - Some(super::Representation::Array { - element: super::ValueShape::Integer + Some(crate::cc::Representation::Array { + element: crate::cc::ValueShape::Integer }) ) { return None; diff --git a/crates/psrs-backend/src/cc/control/mod.rs b/crates/psrs-backend/src/cc/control/mod.rs new file mode 100644 index 00000000..9fbb2d22 --- /dev/null +++ b/crates/psrs-backend/src/cc/control/mod.rs @@ -0,0 +1,13 @@ +//! Checked source contracts and semantic identities for the control machine. + +mod contracts; +mod helpers; + +pub(in crate::cc) use contracts::ControlImplementation; +pub use contracts::{ + ControlContract, ControlContractId, ControlDomain, SourceTypeIdentityId, + TypeConstructorIdentity, TypeIdentity, +}; +pub use helpers::{ + ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, +}; diff --git a/crates/psrs-backend/src/cc/layout/control_contracts.rs b/crates/psrs-backend/src/cc/layout/control/contracts.rs similarity index 99% rename from crates/psrs-backend/src/cc/layout/control_contracts.rs rename to crates/psrs-backend/src/cc/layout/control/contracts.rs index e938d5dd..3a44117a 100644 --- a/crates/psrs-backend/src/cc/layout/control_contracts.rs +++ b/crates/psrs-backend/src/cc/layout/control/contracts.rs @@ -1,8 +1,8 @@ //! Quote the authoritative Core proof before the immutable CC table is frozen. -use super::control::ControlLayout; +use super::ControlLayout; use crate::BackendError; -use crate::cc::control_contract::ControlImplementation; +use crate::cc::control::ControlImplementation; use crate::cc::{ ControlContract, ControlContractId, ControlDomain, RepresentationTable, SourceTypeIdentityId, TypeConstructorIdentity as C, TypeIdentity as T, @@ -11,7 +11,7 @@ use psrs_core::{CheckedControlContract, ExprKind, Module, Type, TypeConstructor, use psrs_hir::Intrinsic; use std::collections::HashSet; -pub(super) fn append( +pub(in crate::cc::layout) fn append( module: &Module, table: &mut RepresentationTable, layout: ControlLayout, diff --git a/crates/psrs-backend/src/cc/layout/control.rs b/crates/psrs-backend/src/cc/layout/control/mod.rs similarity index 91% rename from crates/psrs-backend/src/cc/layout/control.rs rename to crates/psrs-backend/src/cc/layout/control/mod.rs index 6df6592b..c3ac3e4e 100644 --- a/crates/psrs-backend/src/cc/layout/control.rs +++ b/crates/psrs-backend/src/cc/layout/control/mod.rs @@ -1,5 +1,10 @@ //! Predeclared representations for the persistent control abstract machine. +mod contracts; + +pub(in crate::cc::layout) use contracts::append as append_contracts; +pub(in crate::cc) use contracts::lookup; + use crate::cc::payload::erased_shape; use crate::cc::{ RefShape, Reference, ReprId, Representation, RepresentationTable, Signature, SignatureId, @@ -49,8 +54,8 @@ pub(in crate::cc) fn append( let context = table.reserve(); let owner = nominal_types[&HirTypeId::RESUMPTION]; let boundary = table.reserve(); - let callback = super::protocols::array(table, erased); - let status = super::protocols::array(table, ValueShape::Integer); + let callback = crate::cc::layout::protocols::array(table, erased); + let status = crate::cc::layout::protocols::array(table, ValueShape::Integer); let callable = reference(RefShape::Closure(continuation)); let queue = reference(RefShape::Repr(sequence)); let extent = reference(RefShape::Repr(boundary)); @@ -118,7 +123,7 @@ pub(in crate::cc) fn append( ); let replay = reference(RefShape::Repr(replay_result)); let labels = vec!["_1".to_owned(), "_2".to_owned()]; - let pair = super::protocols::record(table, &labels).unwrap_or_else(|| { + let pair = crate::cc::layout::protocols::record(table, &labels).unwrap_or_else(|| { let pair = table.reserve(); table.set( pair, @@ -217,8 +222,9 @@ mod tests { fn control_cells_reuse_existing_canonical_array_layouts() { let mut table = RepresentationTable::default(); let erased = erased_shape(); - let callback = super::super::protocols::array(&mut table, erased); - let status = super::super::protocols::array(&mut table, crate::cc::ValueShape::Integer); + let callback = crate::cc::layout::protocols::array(&mut table, erased); + let status = + crate::cc::layout::protocols::array(&mut table, crate::cc::ValueShape::Integer); let continuation = table.add_signature(Signature { parameters: vec![erased], result: erased, diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 64963d60..582a799b 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -9,7 +9,6 @@ use std::collections::{HashMap, HashSet}; mod aggregate; mod captures; pub(in crate::cc) mod control; -pub(in crate::cc) mod control_contracts; mod declaration; mod functions; pub(crate) mod protocols; @@ -322,7 +321,7 @@ pub(super) fn type_layout( let control_layout = uses_control.then(|| control::append(&mut representations, function_slot, &nominal_types)); let control_owner = match control_layout { - Some(control) => control_contracts::append(module, &mut representations, control)?, + Some(control) => control::append_contracts(module, &mut representations, control)?, None => None, }; Ok(TypeLayout { diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index fd0626aa..77502140 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -84,7 +84,7 @@ impl FunctionLowerer<'_> { ) .map_err(|message| control_error(expression.span, message))?; let contract = - crate::cc::layout::control_contracts::lookup(self.module, self.representations, &proof) + crate::cc::layout::control::lookup(self.module, self.representations, &proof) .ok_or_else(|| { control_error( expression.span, diff --git a/crates/psrs-backend/src/cc/lower/control/operands.rs b/crates/psrs-backend/src/cc/lower/control/operands.rs index 8891925d..1947b27a 100644 --- a/crates/psrs-backend/src/cc/lower/control/operands.rs +++ b/crates/psrs-backend/src/cc/lower/control/operands.rs @@ -2,7 +2,7 @@ use super::{FunctionLowerer, control_error}; use crate::BackendError; -use crate::cc::control_contract::ControlImplementation; +use crate::cc::control::ControlImplementation; use crate::cc::payload::{PayloadPlanner, erased_shape}; use crate::cc::{ Assignment, ControlContractId, RefShape, Reference, Representation, ValueId, ValueShape, diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index dca9e412..eaa20caf 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -8,15 +8,12 @@ use std::collections::HashMap; use std::rc::Rc; mod case; -mod control_contract; -mod control_helpers; +mod control; pub(crate) mod value_identity; -pub use control_contract::{ - ControlContract, ControlContractId, ControlDomain, SourceTypeIdentityId, - TypeConstructorIdentity, TypeIdentity, -}; -pub use control_helpers::{ - ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, +pub use control::{ + ControlContract, ControlContractId, ControlDomain, ControlHelperContract, ControlHelperId, + ControlHelperRole, ControlResumptionContract, SourceTypeIdentityId, TypeConstructorIdentity, + TypeIdentity, }; mod convert; mod layout; diff --git a/crates/psrs-backend/src/cc/verify/control_checkpoints.rs b/crates/psrs-backend/src/cc/verify/control/checkpoints.rs similarity index 100% rename from crates/psrs-backend/src/cc/verify/control_checkpoints.rs rename to crates/psrs-backend/src/cc/verify/control/checkpoints.rs diff --git a/crates/psrs-backend/src/cc/verify/control_provenance.rs b/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs similarity index 100% rename from crates/psrs-backend/src/cc/verify/control_provenance.rs rename to crates/psrs-backend/src/cc/verify/control/finish_consumption.rs diff --git a/crates/psrs-backend/src/cc/verify/control_finish_creation.rs b/crates/psrs-backend/src/cc/verify/control/finish_creation.rs similarity index 100% rename from crates/psrs-backend/src/cc/verify/control_finish_creation.rs rename to crates/psrs-backend/src/cc/verify/control/finish_creation.rs diff --git a/crates/psrs-backend/src/cc/verify/control/mod.rs b/crates/psrs-backend/src/cc/verify/control/mod.rs new file mode 100644 index 00000000..10a33118 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/mod.rs @@ -0,0 +1,28 @@ +//! Control helper body checks at the CC verification boundary. + +use crate::BackendError; +use crate::cc::{Function, RepresentationTable}; +use psrs_hir::SymbolId; +use std::collections::HashMap; + +mod checkpoints; +mod finish_consumption; +mod finish_creation; +mod replay; + +pub(super) fn verify_before_assignments( + function: &Function, + representations: &RepresentationTable, +) -> Result<(), Vec> { + finish_consumption::verify(function, representations) +} + +pub(super) fn verify_after_assignments( + function: &Function, + representations: &RepresentationTable, + functions: Option<&HashMap>, +) -> Result<(), Vec> { + checkpoints::verify(function, representations)?; + finish_creation::verify(function, representations)?; + replay::verify(function, representations, functions) +} diff --git a/crates/psrs-backend/src/cc/verify/control_replay.rs b/crates/psrs-backend/src/cc/verify/control/replay.rs similarity index 99% rename from crates/psrs-backend/src/cc/verify/control_replay.rs rename to crates/psrs-backend/src/cc/verify/control/replay.rs index 0d45b8d6..0bd2bd6d 100644 --- a/crates/psrs-backend/src/cc/verify/control_replay.rs +++ b/crates/psrs-backend/src/cc/verify/control/replay.rs @@ -19,7 +19,7 @@ pub(super) fn verify( return Ok(()); } let read_only = functions - .map(super::read_only::functions) + .map(super::super::read_only::functions) .unwrap_or_default(); let schema = table .control_replay_schema() diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index d80fbd26..050e177f 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -5,10 +5,7 @@ use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; mod adaptation; -mod control_checkpoints; -mod control_finish_creation; -mod control_provenance; -mod control_replay; +mod control; mod helpers; mod ops; mod read_only; @@ -192,7 +189,7 @@ fn verify_function_inner( )]); } verify_capture_layout(function)?; - control_provenance::verify(function, representations)?; + control::verify_before_assignments(function, representations)?; let mut available = function.parameters.iter().copied().collect::>(); verify_assignments( &function.assignments, @@ -204,9 +201,7 @@ fn verify_function_inner( function.span, &function.name, )?; - control_checkpoints::verify(function, representations)?; - control_finish_creation::verify(function, representations)?; - control_replay::verify(function, representations, functions)?; + control::verify_after_assignments(function, representations, functions)?; if !available.contains(&function.result) { return Err(vec![BackendError::invalid_ir( "P8 CC verification", diff --git a/crates/psrs-backend/src/cc/verify/ops/control.rs b/crates/psrs-backend/src/cc/verify/ops/control.rs index c57837ca..ef79a72e 100644 --- a/crates/psrs-backend/src/cc/verify/ops/control.rs +++ b/crates/psrs-backend/src/cc/verify/ops/control.rs @@ -1,7 +1,7 @@ use super::super::helpers::{assignment_error, declared_shape}; use crate::BackendError; use crate::cc::Signature; -use crate::cc::control_contract::ControlImplementation; +use crate::cc::control::ControlImplementation; use crate::cc::{Assignment, AssignmentKind, RepresentationTable, ValueId, ValueShape}; use psrs_hir::SymbolId; use std::collections::HashMap; diff --git a/crates/psrs-backend/src/mir/control_checkpoints.rs b/crates/psrs-backend/src/mir/control/checkpoints.rs similarity index 96% rename from crates/psrs-backend/src/mir/control_checkpoints.rs rename to crates/psrs-backend/src/mir/control/checkpoints.rs index 96d3a5c2..7c345d74 100644 --- a/crates/psrs-backend/src/mir/control_checkpoints.rs +++ b/crates/psrs-backend/src/mir/control/checkpoints.rs @@ -1,14 +1,14 @@ //! Preserve checkpoint ownership after physical projection and loop conversion. -use super::{Function, Instruction as I, Module}; use crate::BackendError; use crate::cc::ControlHelperRole as R; use crate::control_provenance::{ CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, }; +use crate::mir::{Function, Instruction as I, Module}; use crate::types::{DefinedTypeId, ValueId}; use std::collections::HashMap; -use super::value_identity::{ +use crate::mir::value_identity::{ Definitions, definitions, loop_parameters, reference_origin as origin, }; @@ -91,7 +91,7 @@ fn verify_function( ) -> Result<(), &'static str> { let definitions = definitions(function); let origin = |value| origin(value, &definitions); - let dominators = super::cfg::dominators(function); + let dominators = crate::mir::cfg::dominators(function); let parameters = loop_parameters(function); if function.symbol == executor && parameters.len() != 6 { return Err("control executor has an invalid parameter contract"); @@ -198,7 +198,7 @@ fn verify_function( } } let parents = - super::value_identity::incoming_values(function, origin(arguments[4])) + crate::mir::value_identity::incoming_values(function, origin(arguments[4])) .ok_or("replay parent must select its current dispatch context")?; let mut seen = std::collections::HashSet::new(); for parent in parents { @@ -276,10 +276,10 @@ fn capture(value: ValueId, definitions: &Definitions<'_>) -> Option, - dominators: &HashMap>, + dominators: &HashMap>, ) -> Result<(), &'static str> { let checked = function.blocks.iter().any(|block| { let prefix = if block.id == point.0 { &block.instructions[..point.1] } diff --git a/crates/psrs-backend/src/mir/control_contracts.rs b/crates/psrs-backend/src/mir/control/contracts.rs similarity index 96% rename from crates/psrs-backend/src/mir/control_contracts.rs rename to crates/psrs-backend/src/mir/control/contracts.rs index e3c9a36c..37aee1b9 100644 --- a/crates/psrs-backend/src/mir/control_contracts.rs +++ b/crates/psrs-backend/src/mir/control/contracts.rs @@ -1,5 +1,5 @@ -use super::{Instruction, Module}; use crate::BackendError; +use crate::mir::{Instruction, Module}; impl Module { pub fn control_helpers(&self) -> &[crate::cc::ControlHelperContract] { @@ -89,8 +89,8 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { } } -pub(super) fn verify_helper_calls( - function: &super::Function, +pub(in crate::mir) fn verify_helper_calls( + function: &crate::mir::Function, table: Option<&crate::cc::RepresentationTable>, ) -> Result<(), Vec> { for block in &function.blocks { @@ -111,7 +111,7 @@ pub(super) fn verify_helper_calls( .terminator .iter() .filter_map(|terminator| match terminator { - super::Terminator::ReturnCall { + crate::mir::Terminator::ReturnCall { function, contract, span, diff --git a/crates/psrs-backend/src/mir/control_provenance.rs b/crates/psrs-backend/src/mir/control/finish_consumption.rs similarity index 96% rename from crates/psrs-backend/src/mir/control_provenance.rs rename to crates/psrs-backend/src/mir/control/finish_consumption.rs index 709cc706..00aa5319 100644 --- a/crates/psrs-backend/src/mir/control_provenance.rs +++ b/crates/psrs-backend/src/mir/control/finish_consumption.rs @@ -1,8 +1,8 @@ //! Recheck lifecycle ownership after physical projection and loop conversion. -use super::{Function, Instruction as I, Module, Terminator as T}; use crate::BackendError; use crate::cc::ControlHelperRole as R; use crate::control_provenance::{FinishProjection, finish_relation}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; use crate::types::{DefinedTypeId, ValueId}; pub(super) fn verify(module: &Module, errors: &mut Vec) { @@ -54,7 +54,7 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { { continue; } - let header = super::value_identity::loop_header(function); + let header = crate::mir::value_identity::loop_header(function); for block in &function.blocks { for (index, instruction) in block.instructions.iter().enumerate() { let I::Call { @@ -211,8 +211,8 @@ fn projection( function: &Function, finish_type: DefinedTypeId, ) -> Option { - let definitions = super::value_identity::definitions(function); - let origin = |value| super::value_identity::reference_origin(value, &definitions); + let definitions = crate::mir::value_identity::definitions(function); + let origin = |value| crate::mir::value_identity::reference_origin(value, &definitions); match definitions.get(&origin(value)).copied()? { I::StructGet { type_index, diff --git a/crates/psrs-backend/src/mir/control_finish_creation.rs b/crates/psrs-backend/src/mir/control/finish_creation.rs similarity index 97% rename from crates/psrs-backend/src/mir/control_finish_creation.rs rename to crates/psrs-backend/src/mir/control/finish_creation.rs index 87fff95d..8834eae7 100644 --- a/crates/psrs-backend/src/mir/control_finish_creation.rs +++ b/crates/psrs-backend/src/mir/control/finish_creation.rs @@ -1,9 +1,9 @@ //! Target completion construction and finish copying after physical lowering. -use super::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; -use super::{Function, Instruction as I, Module, Terminator as T}; use crate::BackendError; use crate::cc::ControlHelperRole as R; use crate::control_provenance::{FinishProjection, context_finish_relation}; +use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; use crate::types::DefinedTypeId; struct Schema { diff --git a/crates/psrs-backend/src/mir/control/mod.rs b/crates/psrs-backend/src/mir/control/mod.rs new file mode 100644 index 00000000..e0c9738e --- /dev/null +++ b/crates/psrs-backend/src/mir/control/mod.rs @@ -0,0 +1,20 @@ +//! Control evidence and helper body contracts after physical layout. + +use crate::BackendError; +use crate::mir::Module; + +mod checkpoints; +mod contracts; +mod finish_consumption; +mod finish_creation; +mod replay; + +pub(super) use contracts::verify_helper_calls; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + contracts::verify(module, errors); + finish_consumption::verify(module, errors); + checkpoints::verify(module, errors); + replay::verify(module, errors); + finish_creation::verify(module, errors); +} diff --git a/crates/psrs-backend/src/mir/control_replay.rs b/crates/psrs-backend/src/mir/control/replay.rs similarity index 97% rename from crates/psrs-backend/src/mir/control_replay.rs rename to crates/psrs-backend/src/mir/control/replay.rs index 3caa7463..c1c25af5 100644 --- a/crates/psrs-backend/src/mir/control_replay.rs +++ b/crates/psrs-backend/src/mir/control/replay.rs @@ -1,15 +1,15 @@ //! Check replay lifecycle allocations and transitions after loop conversion. -use super::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; -use super::{Function, Instruction as I, Module, Terminator as T}; use crate::BackendError; use crate::cc::ControlHelperRole as R; use crate::control_provenance::{ FinishProjection, replay_activation_relation, saved_finish_relation, }; +use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; use crate::types::{DefinedTypeId, ValueId}; use std::collections::{HashMap, HashSet}; -type Point = (super::BlockId, usize); +type Point = (crate::mir::BlockId, usize); struct Schema { finish: DefinedTypeId, @@ -67,7 +67,7 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { status, result, }; - let read_only = super::opt::effects::read_only_functions(module); + let read_only = crate::mir::opt::effects::read_only_functions(module); for (function, role) in functions { if let Err(message) = verify_function(function, role, table, &schema, &read_only) { errors.push( @@ -119,12 +119,12 @@ fn verify_function( }) }) .collect::>(); - let dominators = super::cfg::dominators(function); + let dominators = crate::mir::cfg::dominators(function); for block in &function.blocks { for (index, instruction) in block.instructions.iter().enumerate() { let read_only_call = matches!(instruction, I::Call { function, .. } | I::CallVoid { function, .. } if read_only.contains(function)); - if super::opt::effects::may_invoke(instruction) + if crate::mir::opt::effects::may_invoke(instruction) && !read_only_call && !matches!(instruction, I::Call { contract: Some(id), .. } if table.control_helpers.get(id.0 as usize).is_some_and(|helper| @@ -446,7 +446,7 @@ fn verify_function( fn precedes( source: Point, target: Point, - dominators: &HashMap>, + dominators: &HashMap>, ) -> bool { if source.0 == target.0 { source.1 < target.1 @@ -462,7 +462,7 @@ fn fresh_iteration_allocation( allocation: ValueId, consumer: Point, points: &HashMap, - dominators: &HashMap>, + dominators: &HashMap>, ) -> bool { let Some(point) = points.get(&allocation).copied() else { return false; diff --git a/crates/psrs-backend/src/mir/lower/mod.rs b/crates/psrs-backend/src/mir/lower/mod.rs index 65e4cb55..b43a18d4 100644 --- a/crates/psrs-backend/src/mir/lower/mod.rs +++ b/crates/psrs-backend/src/mir/lower/mod.rs @@ -114,7 +114,7 @@ pub(super) fn lower_function( for plan in &lowerer.wit_calls { plan.verify(&function)?; } - super::control_contracts::verify_helper_calls(&function, Some(layout.representation_table()))?; + super::control::verify_helper_calls(&function, Some(layout.representation_table()))?; tail::mark_tail(&mut function, target)?; wit::verify_function(&function, wit_imports)?; Ok(function) diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 97db621d..7a4be468 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -7,11 +7,7 @@ use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; pub(crate) mod cfg; -mod control_checkpoints; -mod control_contracts; -mod control_finish_creation; -mod control_provenance; -mod control_replay; +mod control; mod instruction; pub(crate) mod layout; mod literals; diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index 08f5651c..d6422d3c 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -32,11 +32,7 @@ struct Signature { pub fn verify_module(module: &Module) -> Result<(), Vec> { let mut errors = Vec::new(); - super::control_contracts::verify(module, &mut errors); - super::control_provenance::verify(module, &mut errors); - super::control_checkpoints::verify(module, &mut errors); - super::control_replay::verify(module, &mut errors); - super::control_finish_creation::verify(module, &mut errors); + super::control::verify(module, &mut errors); verify_defined_types(module, &mut errors); let mut signatures = module .functions diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index cd297ad9..6615a82e 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -87,6 +87,28 @@ Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. +### Control module organization + +The continuation from `5b74e43b` groups related backend modules by their owning +stage: `cc/control/` owns immutable source contracts and helper identities; +`cc/layout/control/` predeclares machine layouts and quotes source contracts; +`cc/verify/control/` checks helper bodies before and after assignment verification; +`mir/control/` checks the retained evidence and physical helper bodies. The +existing `cc/lower/control/` continues to own machine synthesis. Public CC/MIR +APIs and verification order are preserved. + +Shared reference provenance, value identity, CFG and read-only analysis remain +with their common owners. Source assignment checks remain in `cc/verify/ops/`. +Independent integration test targets retain their Cargo test identities. This +organization change does not discharge any outstanding semantic acceptance row. + +Validation: formatting and strict workspace clippy pass. The mandatory-Wasmtime +workspace run passes all 435 backend tests and all 81 control integration tests. +It retains exactly the same 175 failed test names across nine targets as the +`5b74e43b` baseline; no failure name is added or recovered. Detailed workspace and +comparison logs are `/private/tmp/psrs-control-organization-workspace.log` and +`/private/tmp/psrs-control-organization-comparison.json`. + ## Governing contracts - [DEC-19](../../decision/DEC-19-compiler-generated-resumable-frames.md) and From 7789c5ce490ca498a41a604568d180d316aa58aa Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 14:51:14 +0800 Subject: [PATCH 118/148] fix(backend): verify source context construction and entry --- .../src/cc/verify/control/context_entry.rs | 204 +++++++++++++++ .../psrs-backend/src/cc/verify/control/mod.rs | 2 + crates/psrs-backend/src/control_provenance.rs | 44 ++++ .../src/mir/control/context_entry.rs | 240 +++++++++++++++++ crates/psrs-backend/src/mir/control/mod.rs | 2 + crates/psrs-backend/src/mir/control/replay.rs | 41 +-- crates/psrs-backend/src/mir/value_identity.rs | 39 ++- .../tests/control_context_entry/aliases.rs | 111 ++++++++ .../src/tests/control_context_entry/cc.rs | 195 ++++++++++++++ .../src/tests/control_context_entry/mir.rs | 243 ++++++++++++++++++ .../src/tests/control_context_entry/mod.rs | 139 ++++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 25 ++ .../backend/algebraic-effects.md | 46 ++++ ...ted-control-lowering-handoff-2026-10-11.md | 7 + 16 files changed, 1303 insertions(+), 38 deletions(-) create mode 100644 crates/psrs-backend/src/cc/verify/control/context_entry.rs create mode 100644 crates/psrs-backend/src/mir/control/context_entry.rs create mode 100644 crates/psrs-driver/src/tests/control_context_entry/aliases.rs create mode 100644 crates/psrs-driver/src/tests/control_context_entry/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_context_entry/mir.rs create mode 100644 crates/psrs-driver/src/tests/control_context_entry/mod.rs diff --git a/crates/psrs-backend/src/cc/verify/control/context_entry.rs b/crates/psrs-backend/src/cc/verify/control/context_entry.rs new file mode 100644 index 00000000..55111f08 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/context_entry.rs @@ -0,0 +1,204 @@ +//! Source Handle entry retains its clauses, caller work and lifetime boundary. +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control_provenance::{FinishProjection, context_clause_relation, context_tail_relation}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) + { + return Ok(()); + } + let parameters = &function.parameters; + if parameters.len() != 6 { + return Err(error( + function, + "source context has an invalid executor contract", + )); + } + let checkpoint = table + .control_checkpoint_schema() + .ok_or_else(|| error(function, "source context has no checked schema"))?; + let schema = table + .control_replay_schema() + .ok_or_else(|| error(function, "source context has no checked lifecycle schema"))?; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = |value| { + crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) + }; + let constant = |value, expected| { + matches!(definitions.get(&origin(value)).copied(), + Some(A::Constant(value)) if *value == expected) + }; + let projection = |value, expected, tag| match definitions.get(&origin(value)).copied() { + Some(A::VariantGet { + representation, + case, + field, + value, + .. + }) if *representation == expected && *case == tag => Some(FinishProjection { + owner: origin(*value), + field: *field, + }), + _ => None, + }; + let mut pending = vec![function.assignments.as_slice()]; + while let Some(body) = pending.pop() { + for (index, assignment) in body.iter().enumerate() { + match &assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + A::If { + then_assignments, + else_assignments, + .. + } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), + A::VariantNew { + representation, + case: 1, + fields, + .. + } if *representation == checkpoint.context => { + if fields.len() != 6 { + return Err(error( + function, + "source context has an invalid frame schema", + )); + } + context_clause_relation( + parameters[2], + projection(fields[0], checkpoint.computation, 4), + projection(fields[1], checkpoint.computation, 4), + ) + .map_err(|message| error(function, message))?; + if origin(fields[4]) != parameters[5] { + return Err(error( + function, + "source context must retain its current caller context", + )); + } + if projection(fields[5], schema.sequence, 3).is_some() { + context_tail_relation( + parameters[3], + projection(fields[2], schema.sequence, 3), + projection(fields[3], schema.sequence, 3), + projection(fields[5], schema.sequence, 3), + ) + .map_err(|message| error(function, message))?; + } else { + if origin(fields[2]) != parameters[3] || origin(fields[3]) != parameters[4] + { + return Err(error( + function, + "source context must save its current queue and execution parent", + )); + } + let Some(A::VariantNew { + representation, + case: 1, + fields: activation, + .. + }) = definitions.get(&origin(fields[5])).copied() + else { + return Err(error( + function, + "source context must allocate a fresh child extent", + )); + }; + if *representation != schema.boundary + || activation.len() != 2 + || origin(activation[1]) != parameters[4] + { + return Err(error( + function, + "source context extent must retain its current execution parent", + )); + } + let initialized = match definitions.get(&origin(activation[0])).copied() { + Some(A::ArrayNew { + representation, + elements, + .. + }) => { + *representation == schema.status + && elements.len() == 1 + && constant(elements[0], 0) + } + Some(A::ArrayFill { + representation, + length, + value, + .. + }) => { + *representation == schema.status + && constant(*length, 1) + && constant(*value, 0) + } + _ => false, + }; + if !initialized { + return Err(error( + function, + "source context extent needs a fresh live status cell in its iteration", + )); + } + } + let next = body[index + 1..] + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments), + _ => None, + }) + .ok_or_else(|| { + error(function, "source context has no executor transition") + })?; + let empty = matches!(next.get(3).and_then(|value| definitions.get(&origin(*value))).copied(), + Some(A::VariantNew { representation, case: 0, fields, .. }) + if *representation == schema.sequence && fields.is_empty()); + if next.len() != 6 + || origin(next[0]) != parameters[0] + || origin(next[1]) != parameters[1] + || projection(next[2], checkpoint.computation, 4) + != Some(FinishProjection { + owner: parameters[2], + field: 2, + }) + || !empty + || origin(next[4]) != origin(fields[5]) + || origin(next[5]) != assignment.destination + { + return Err(error( + function, + "source context transition must enter its Handle body with an empty queue and its own extent", + )); + } + } + _ => {} + } + } + } + Ok(()) +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC context entry", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/control/mod.rs b/crates/psrs-backend/src/cc/verify/control/mod.rs index 10a33118..3df1564f 100644 --- a/crates/psrs-backend/src/cc/verify/control/mod.rs +++ b/crates/psrs-backend/src/cc/verify/control/mod.rs @@ -6,6 +6,7 @@ use psrs_hir::SymbolId; use std::collections::HashMap; mod checkpoints; +mod context_entry; mod finish_consumption; mod finish_creation; mod replay; @@ -24,5 +25,6 @@ pub(super) fn verify_after_assignments( ) -> Result<(), Vec> { checkpoints::verify(function, representations)?; finish_creation::verify(function, representations)?; + context_entry::verify(function, representations)?; replay::verify(function, representations, functions) } diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control_provenance.rs index 17ad5da9..28f399a8 100644 --- a/crates/psrs-backend/src/control_provenance.rs +++ b/crates/psrs-backend/src/control_provenance.rs @@ -107,3 +107,47 @@ pub(crate) fn context_finish_relation( } Ok(()) } + +/// A scoped dispatch owns the clauses of the current Handle computation. +pub(crate) fn context_clause_relation( + computation: ValueId, + return_clause: Option, + operation_clause: Option, +) -> Result<(), &'static str> { + if return_clause + != Some(FinishProjection { + owner: computation, + field: 0, + }) + || operation_clause + != Some(FinishProjection { + owner: computation, + field: 1, + }) + { + return Err("source context must retain the current Handle return and operation clauses"); + } + Ok(()) +} + +/// Tail scope entry removes one finish while sharing its completion boundary. +pub(crate) fn context_tail_relation( + sequence: ValueId, + saved: Option, + parent: Option, + extent: Option, +) -> Result<(), &'static str> { + for (projection, field) in [(saved, 1), (parent, 2), (extent, 0)] { + if projection + != Some(FinishProjection { + owner: sequence, + field, + }) + { + return Err( + "tail source context must retain queue, parent and extent from its current finish", + ); + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control/context_entry.rs b/crates/psrs-backend/src/mir/control/context_entry.rs new file mode 100644 index 00000000..e16746ab --- /dev/null +++ b/crates/psrs-backend/src/mir/control/context_entry.rs @@ -0,0 +1,240 @@ +//! Check source Handle entry over physical fields and executor loop transitions. +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control_provenance::{FinishProjection, context_clause_relation, context_tail_relation}; +use crate::mir::value_identity::{ + definitions, fresh_iteration_allocation, loop_header, loop_parameters, reference_origin, +}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; +use crate::types::DefinedTypeId; +use std::collections::HashMap; + +struct Schema { + context: DefinedTypeId, + handle: DefinedTypeId, + finish: DefinedTypeId, + empty: DefinedTypeId, + boundary: DefinedTypeId, + status: DefinedTypeId, +} + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let Some(executor) = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + else { + return; + }; + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == executor.function()) + else { + return; + }; + let schema = table + .control_checkpoint_schema() + .zip(table.control_replay_schema()) + .and_then(|(checkpoint, replay)| { + Some(Schema { + context: layout.variant_index(checkpoint.context, 1).ok()?, + handle: layout.variant_index(checkpoint.computation, 4).ok()?, + finish: layout.variant_index(replay.sequence, 3).ok()?, + empty: layout.variant_index(replay.sequence, 0).ok()?, + boundary: layout.variant_index(replay.boundary, 1).ok()?, + status: layout.repr_index(replay.status).ok()?, + }) + }); + let result = schema + .ok_or("source context has no physical schema") + .and_then(|schema| verify_function(function, &schema)); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR context entry", function.span, message) + .with_module(function.symbol.module), + ); + } +} + +fn verify_function(function: &Function, schema: &Schema) -> Result<(), &'static str> { + let parameters = loop_parameters(function); + if parameters.len() != 6 { + return Err("source context has an invalid executor contract"); + } + let definitions = definitions(function); + let origin = |value| reference_origin(value, &definitions); + let constant = |value, expected| { + matches!(definitions.get(&origin(value)).copied(), + Some(I::Constant { value, .. }) if *value == expected) + }; + let projection = |value, expected| match definitions.get(&origin(value)).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *type_index == expected && *field > 0 => Some(FinishProjection { + owner: origin(*value), + field: field - 1, + }), + _ => None, + }; + let points = function + .blocks + .iter() + .flat_map(|block| { + block + .instructions + .iter() + .enumerate() + .filter_map(move |(index, instruction)| { + instruction + .destination() + .map(|value| (value, (block.id, index))) + }) + }) + .collect::>(); + let dominators = crate::mir::cfg::dominators(function); + for block in &function.blocks { + for (index, instruction) in block.instructions.iter().enumerate() { + let I::StructNew { + type_index, + arguments, + destination, + .. + } = instruction + else { + continue; + }; + if *type_index != schema.context { + continue; + } + if arguments.len() != 7 || !constant(arguments[0], 1) { + return Err("source context has an invalid frame schema"); + } + let fields = &arguments[1..]; + context_clause_relation( + parameters[2], + projection(fields[0], schema.handle), + projection(fields[1], schema.handle), + )?; + if origin(fields[4]) != parameters[5] { + return Err("source context must retain its current caller context"); + } + if projection(fields[5], schema.finish).is_some() { + context_tail_relation( + parameters[3], + projection(fields[2], schema.finish), + projection(fields[3], schema.finish), + projection(fields[5], schema.finish), + )?; + } else { + if origin(fields[2]) != parameters[3] || origin(fields[3]) != parameters[4] { + return Err("source context must save its current queue and execution parent"); + } + let extent = origin(fields[5]); + let Some(I::StructNew { + type_index, + arguments: activation, + .. + }) = definitions.get(&extent).copied() + else { + return Err("source context must allocate a fresh child extent"); + }; + if *type_index != schema.boundary + || activation.len() != 3 + || !constant(activation[0], 1) + || origin(activation[2]) != parameters[4] + { + return Err("source context extent must retain its current execution parent"); + } + let status = origin(activation[1]); + let initialized = match definitions.get(&status).copied() { + Some(I::ArrayNew { + type_index, + elements, + .. + }) => { + *type_index == schema.status + && elements.len() == 1 + && constant(elements[0], 0) + } + Some(I::ArrayNewFilled { + type_index, + length, + value, + .. + }) => { + *type_index == schema.status && constant(*length, 1) && constant(*value, 0) + } + _ => false, + }; + if !initialized + || !fresh_iteration_allocation( + function, + status, + (block.id, index), + &points, + &dominators, + ) + || !fresh_iteration_allocation( + function, + extent, + (block.id, index), + &points, + &dominators, + ) + { + return Err( + "source context extent needs a fresh live status cell in its iteration", + ); + } + } + let next = block.instructions[index + 1..] + .iter() + .find_map(|instruction| match instruction { + I::Call { + function: target, + arguments, + .. + } if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .or_else(|| match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == loop_header(function) => Some(arguments.as_slice()), + Some(T::ReturnCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .ok_or("source context has no executor transition")?; + let empty = matches!(next.get(3).and_then(|value| definitions.get(&origin(*value))).copied(), + Some(I::StructNew { type_index, arguments, .. }) + if *type_index == schema.empty && arguments.len() == 1 && constant(arguments[0], 0)); + if next.len() != 6 + || origin(next[0]) != parameters[0] + || origin(next[1]) != parameters[1] + || projection(next[2], schema.handle) + != Some(FinishProjection { + owner: parameters[2], + field: 2, + }) + || !empty + || origin(next[4]) != origin(fields[5]) + || origin(next[5]) != *destination + { + return Err( + "source context transition must enter its Handle body with an empty queue and its own extent", + ); + } + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control/mod.rs b/crates/psrs-backend/src/mir/control/mod.rs index e0c9738e..ed08e5cf 100644 --- a/crates/psrs-backend/src/mir/control/mod.rs +++ b/crates/psrs-backend/src/mir/control/mod.rs @@ -4,6 +4,7 @@ use crate::BackendError; use crate::mir::Module; mod checkpoints; +mod context_entry; mod contracts; mod finish_consumption; mod finish_creation; @@ -17,4 +18,5 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { checkpoints::verify(module, errors); replay::verify(module, errors); finish_creation::verify(module, errors); + context_entry::verify(module, errors); } diff --git a/crates/psrs-backend/src/mir/control/replay.rs b/crates/psrs-backend/src/mir/control/replay.rs index c1c25af5..1053601e 100644 --- a/crates/psrs-backend/src/mir/control/replay.rs +++ b/crates/psrs-backend/src/mir/control/replay.rs @@ -4,13 +4,14 @@ use crate::cc::ControlHelperRole as R; use crate::control_provenance::{ FinishProjection, replay_activation_relation, saved_finish_relation, }; -use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use crate::mir::value_identity::{ + definitions, fresh_iteration_allocation, loop_header, loop_parameters, precedes, + reference_origin, +}; use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::{DefinedTypeId, ValueId}; +use crate::types::DefinedTypeId; use std::collections::{HashMap, HashSet}; -type Point = (crate::mir::BlockId, usize); - struct Schema { finish: DefinedTypeId, cons: DefinedTypeId, @@ -442,35 +443,3 @@ fn verify_function( } Ok(()) } - -fn precedes( - source: Point, - target: Point, - dominators: &HashMap>, -) -> bool { - if source.0 == target.0 { - source.1 < target.1 - } else { - dominators - .get(&target.0) - .is_some_and(|set| set.contains(&source.0)) - } -} - -fn fresh_iteration_allocation( - function: &Function, - allocation: ValueId, - consumer: Point, - points: &HashMap, - dominators: &HashMap>, -) -> bool { - let Some(point) = points.get(&allocation).copied() else { - return false; - }; - precedes(point, consumer, dominators) - && loop_header(function).is_none_or(|header| { - dominators - .get(&point.0) - .is_some_and(|set| set.contains(&header)) - }) -} diff --git a/crates/psrs-backend/src/mir/value_identity.rs b/crates/psrs-backend/src/mir/value_identity.rs index d96415bf..adeae905 100644 --- a/crates/psrs-backend/src/mir/value_identity.rs +++ b/crates/psrs-backend/src/mir/value_identity.rs @@ -1,7 +1,7 @@ //! Shared reference identity and loop parameter views for MIR consumers. use super::{BlockId, Function, Instruction, Terminator}; use crate::types::ValueId; -use std::collections::HashMap; +use std::collections::{HashMap, HashSet}; pub(crate) type Definitions<'a> = HashMap; @@ -86,3 +86,40 @@ pub(crate) fn incoming_values(function: &Function, value: ValueId) -> Option>, +) -> bool { + if source.0 == target.0 { + source.1 < target.1 + } else { + dominators + .get(&target.0) + .is_some_and(|set| set.contains(&source.0)) + } +} + +/// Prove that a producer dominates its consumer and executes inside the current +/// loop iteration, excluding allocations reused from the entry preheader. +/// Callers separately prove that the producer is the required allocation. +pub(crate) fn fresh_iteration_allocation( + function: &Function, + allocation: ValueId, + consumer: Point, + points: &HashMap, + dominators: &HashMap>, +) -> bool { + let Some(point) = points.get(&allocation).copied() else { + return false; + }; + precedes(point, consumer, dominators) + && loop_header(function).is_none_or(|header| { + dominators + .get(&point.0) + .is_some_and(|set| set.contains(&header)) + }) +} diff --git a/crates/psrs-driver/src/tests/control_context_entry/aliases.rs b/crates/psrs-driver/src/tests/control_context_entry/aliases.rs new file mode 100644 index 00000000..77876ae0 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_entry/aliases.rs @@ -0,0 +1,111 @@ +//! Transparent aliases preserve the caller identity at source context entry. +use super::{R, SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueId, ValueShape}; +use psrs_backend::mir::Instruction as I; + +fn alias_fields(body: &mut [Assignment], original: ValueId, alias: ValueId) -> bool { + for assignment in body { + match &mut assignment.kind { + A::VariantNew { + case: 1, fields, .. + } if fields.len() == 6 && fields[4] == original => { + fields[4] = alias; + return true; + } + A::TagSwitch { cases, .. } => { + for case in cases { + if alias_fields(&mut case.assignments, original, alias) { + return true; + } + } + } + _ => {} + } + } + false +} + +#[test] +fn cc_source_context_accepts_a_reference_alias_of_its_caller() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = binding(&input.cc.representations, R::Executor).0; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let original = function.parameters[5]; + let ty = function + .values + .iter() + .find(|value| value.id == original) + .unwrap() + .ty; + let ValueShape::Reference(reference) = ty else { + unreachable!() + }; + let alias = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function + .values + .push(psrs_backend::cc::ValueDecl { id: alias, ty }); + function.assignments.insert( + 0, + Assignment { + destination: alias, + kind: A::RepresentationCast { + destination: alias, + value: original, + reference, + }, + span: function.span, + }, + ); + assert!(alias_fields(&mut function.assignments, original, alias)); + psrs_backend::cc::verify_module(&input.cc).unwrap(); + psrs_backend::compile_cc(input).unwrap(); +} + +#[test] +fn mir_source_context_accepts_a_copy_of_its_caller() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let symbol = binding(&stages.cc.representations, R::Executor).0; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let alias = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let mut changed = false; + for block in &mut function.blocks { + if let Some(index) = block.instructions.iter().position(|instruction| matches!(instruction, I::StructNew { arguments, .. } if arguments.len() == 7)) { + let I::StructNew { arguments, .. } = &mut block.instructions[index] else { unreachable!() }; + let original = arguments[5]; + let ty = function.values.iter().find(|value| value.id == original).unwrap().ty; + function.values.push(psrs_backend::types::ValueDecl { id: alias, ty }); + arguments[5] = alias; + block.instructions.insert(index, I::Copy { destination: alias, value: original, span: function.span }); + changed = true; + break; + } + } + assert!(changed); + psrs_backend::mir::verify_module(&stages.mir).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/control_context_entry/cc.rs b/crates/psrs-driver/src/tests/control_context_entry/cc.rs new file mode 100644 index 00000000..5bd5d3c4 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_entry/cc.rs @@ -0,0 +1,195 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, RefShape, ValueId, ValueShape}; +use std::collections::HashMap; + +fn index(body: &[Assignment], definitions: &mut HashMap) { + for assignment in body { + definitions.insert(assignment.destination, assignment.kind.clone()); + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &assignment.kind + { + for case in cases { + index(&case.assignments, definitions); + } + index(default_assignments, definitions); + } + } +} +fn visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut Assignment) -> bool) -> bool { + for assignment in body { + if mutate(assignment) { + return true; + } + if let A::TagSwitch { + cases, + default_assignments, + .. + } = &mut assignment.kind + { + for case in cases { + if visit(&mut case.assignments, mutate) { + return true; + } + } + if visit(default_assignments, mutate) { + return true; + } + } + } + false +} + +pub(super) fn reject(mutation: Mutation) { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, id) = binding(&input.cc.representations, R::Executor); + let signature = input + .cc + .representations + .signature(input.cc.representations.control_helpers[id.0 as usize].signature()) + .unwrap(); + let ValueShape::Reference(reference) = signature.parameters[5] else { + unreachable!() + }; + let RefShape::Repr(context) = reference.heap else { + unreachable!() + }; + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let parameters = function.parameters.clone(); + let mut definitions = HashMap::new(); + index(&function.assignments, &mut definitions); + let tail = |fields: &[ValueId]| { + matches!( + definitions.get(&fields[5]), + Some(A::VariantGet { + case: 3, + field: 0, + .. + }) + ) + }; + let context_value = definitions + .iter() + .find_map(|(value, kind)| match kind { + A::VariantNew { + representation, + case: 1, + fields, + .. + } if *representation == context && !tail(fields) => Some(*value), + _ => None, + }) + .unwrap(); + let status = match &definitions[&context_value] { + A::VariantNew { fields, .. } => match &definitions[&fields[5]] { + A::VariantNew { fields, .. } => fields[0], + _ => unreachable!(), + }, + _ => unreachable!(), + }; + let caller = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + if matches!(mutation, Mutation::Caller) { + function.values.push(psrs_backend::cc::ValueDecl { + id: caller, + ty: signature.parameters[5], + }); + function.assignments.insert( + 0, + Assignment { + destination: caller, + kind: A::VariantGet { + destination: caller, + representation: context, + case: 1, + field: 4, + value: parameters[5], + }, + span: function.span, + }, + ); + } + let changed = visit(&mut function.assignments, &mut |assignment| { + match mutation { + Mutation::Caller + | Mutation::Clauses + | Mutation::TailQueue + | Mutation::TailParent + | Mutation::TailExtent => { + let A::VariantNew { + representation, + case: 1, + fields, + .. + } = &mut assignment.kind + else { + return false; + }; + if *representation != context { + return false; + } + match mutation { + Mutation::Caller => fields[4] = caller, + Mutation::Clauses => fields.swap(0, 1), + _ if !tail(fields) => return false, + Mutation::TailQueue => fields[2] = parameters[3], + Mutation::TailParent => fields[3] = parameters[4], + Mutation::TailExtent => fields[5] = parameters[4], + _ => unreachable!(), + } + } + Mutation::Status => { + if assignment.destination != status { + return false; + } + let A::ArrayNew { elements, .. } = &mut assignment.kind else { + unreachable!() + }; + elements.clear(); + } + _ => { + let A::DirectCall { + function: target, + arguments, + .. + } = &mut assignment.kind + else { + return false; + }; + if *target != symbol || arguments[5] != context_value { + return false; + } + match mutation { + Mutation::EntryBody => arguments[2] = parameters[2], + Mutation::EntryQueue => arguments[3] = parameters[3], + Mutation::EntryExtent => arguments[4] = parameters[4], + Mutation::EntryContext => arguments[5] = parameters[5], + _ => unreachable!(), + } + } + } + true + }); + assert!(changed); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_context_entry/mir.rs b/crates/psrs-driver/src/tests/control_context_entry/mir.rs new file mode 100644 index 00000000..389c0c4c --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_entry/mir.rs @@ -0,0 +1,243 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::ValueId; +use psrs_backend::mir::{Instruction as I, Terminator as T}; +use std::collections::HashMap; + +pub(super) fn reject(mutation: Mutation) { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let symbol = binding(&stages.cc.representations, R::Executor).0; + let function = stages + .mir + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let entry = function + .blocks + .iter() + .find(|block| block.id == function.entry) + .unwrap(); + let Some(T::Jump { + target: header, + arguments, + .. + }) = &entry.terminator + else { + unreachable!() + }; + assert_eq!(arguments, &function.parameters); + let header = *header; + let parameters = function + .blocks + .iter() + .find(|block| block.id == header) + .unwrap() + .parameters + .clone(); + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| { + instruction + .destination() + .map(|value| (value, instruction.clone())) + }) + .collect::>(); + let origin = |mut value: ValueId| { + for _ in 0..definitions.len() { + match definitions.get(&value) { + Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { + value = *source + } + _ => break, + } + } + value + }; + let tail = |fields: &[ValueId]| { + matches!( + definitions.get(&origin(fields[6])), + Some(I::StructGet { field: 1, .. }) + ) + }; + let context_value = definitions + .iter() + .find_map(|(value, instruction)| match instruction { + I::StructNew { arguments, .. } if arguments.len() == 7 && !tail(arguments) => { + Some(*value) + } + _ => None, + }) + .unwrap(); + let status = match &definitions[&context_value] { + I::StructNew { arguments, .. } => match &definitions[&origin(arguments[6])] { + I::StructNew { arguments, .. } => origin(arguments[1]), + _ => unreachable!(), + }, + _ => unreachable!(), + }; + if matches!(mutation, Mutation::StatusOutsideLoop) { + let I::ArrayNew { elements, .. } = &definitions[&status] else { + unreachable!() + }; + let zero = elements[0]; + assert!(matches!(definitions[&zero], I::Constant { value: 0, .. })); + let mut moved = Vec::new(); + for block in &mut function.blocks { + let mut index = 0; + while index < block.instructions.len() { + if matches!(block.instructions[index].destination(), Some(value) if value == status || value == zero) + { + moved.push(block.instructions.remove(index)); + } else { + index += 1; + } + } + } + assert_eq!(moved.len(), 2); + moved.sort_by_key(|instruction| usize::from(instruction.destination() == Some(status))); + function + .blocks + .iter_mut() + .find(|block| block.id == function.entry) + .unwrap() + .instructions + .extend(moved); + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); + return; + } + let caller = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + if matches!(mutation, Mutation::Caller) { + let cast = ValueId(caller.0 + 1); + let I::StructNew { type_index, .. } = definitions[&context_value] else { + unreachable!() + }; + let reference = psrs_backend::types::RefType { + nullable: false, + heap: psrs_backend::types::HeapType::Index(type_index), + }; + let caller_ty = function + .values + .iter() + .find(|value| value.id == function.parameters[5]) + .unwrap() + .ty; + function.values.push(psrs_backend::types::ValueDecl { + id: caller, + ty: caller_ty, + }); + function.values.push(psrs_backend::types::ValueDecl { + id: cast, + ty: psrs_backend::types::ValueType::Ref(reference), + }); + let entry = function + .blocks + .iter_mut() + .find(|block| block.id == function.entry) + .unwrap(); + entry.instructions.push(I::RefCast { + destination: cast, + value: function.parameters[5], + reference, + span: function.span, + }); + entry.instructions.push(I::StructGet { + destination: caller, + type_index, + field: 5, + value: cast, + span: function.span, + }); + } + let mut changed = false; + for block in &mut function.blocks { + for instruction in &mut block.instructions { + match mutation { + Mutation::Caller + | Mutation::Clauses + | Mutation::TailQueue + | Mutation::TailParent + | Mutation::TailExtent => { + let I::StructNew { arguments, .. } = instruction else { + continue; + }; + if arguments.len() != 7 { + continue; + } + match mutation { + Mutation::Caller => arguments[5] = caller, + Mutation::Clauses => arguments.swap(1, 2), + _ if !tail(arguments) => continue, + Mutation::TailQueue => arguments[3] = parameters[3], + Mutation::TailParent => arguments[4] = parameters[4], + Mutation::TailExtent => arguments[6] = parameters[4], + _ => unreachable!(), + } + changed = true; + } + Mutation::Status => { + let I::ArrayNew { + destination, + elements, + .. + } = instruction + else { + continue; + }; + if *destination != status { + continue; + } + elements.clear(); + changed = true; + } + _ => {} + } + if changed { + break; + } + } + if !changed + && block.id != function.entry + && let Some(T::Jump { + target, arguments, .. + }) = &mut block.terminator + && *target == header + && origin(arguments[5]) == context_value + { + match mutation { + Mutation::EntryBody => arguments[2] = parameters[2], + Mutation::EntryQueue => arguments[3] = parameters[3], + Mutation::EntryExtent => arguments[4] = parameters[4], + Mutation::EntryContext => arguments[5] = parameters[5], + _ => continue, + } + changed = true; + } + if changed { + break; + } + } + assert!(changed); + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_context_entry/mod.rs b/crates/psrs-driver/src/tests/control_context_entry/mod.rs new file mode 100644 index 00000000..65317b8c --- /dev/null +++ b/crates/psrs-driver/src/tests/control_context_entry/mod.rs @@ -0,0 +1,139 @@ +//! Actual source context construction and entry operands must retain identity. +mod aliases; +mod cc; +mod mir; +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::ControlHelperRole as R; + +#[derive(Clone, Copy)] +enum Mutation { + Clauses, + Caller, + TailQueue, + TailParent, + TailExtent, + EntryBody, + EntryQueue, + EntryExtent, + EntryContext, + Status, + StatusOutsideLoop, +} +impl Mutation { + fn message(self) -> &'static str { + match self { + Self::Caller => "retain its current caller context", + Self::Clauses => "retain the current Handle return and operation clauses", + Self::TailQueue | Self::TailParent => { + "retain queue, parent and extent from its current finish" + } + Self::TailExtent => "save its current queue and execution parent", + Self::Status | Self::StatusOutsideLoop => "fresh live status cell in its iteration", + _ => "enter its Handle body with an empty queue and its own extent", + } + } +} + +#[test] +fn cc_source_context_retains_clauses() { + cc::reject(Mutation::Clauses); +} + +#[test] +fn mir_source_context_retains_clauses() { + mir::reject(Mutation::Clauses); +} + +#[test] +fn cc_source_context_retains_tail_queue() { + cc::reject(Mutation::TailQueue); +} + +#[test] +fn mir_source_context_retains_tail_queue() { + mir::reject(Mutation::TailQueue); +} + +#[test] +fn cc_source_context_retains_tail_parent() { + cc::reject(Mutation::TailParent); +} + +#[test] +fn mir_source_context_retains_tail_parent() { + mir::reject(Mutation::TailParent); +} + +#[test] +fn cc_source_context_retains_tail_extent() { + cc::reject(Mutation::TailExtent); +} + +#[test] +fn mir_source_context_retains_tail_extent() { + mir::reject(Mutation::TailExtent); +} + +#[test] +fn cc_source_context_retains_entry_body() { + cc::reject(Mutation::EntryBody); +} + +#[test] +fn mir_source_context_retains_entry_body() { + mir::reject(Mutation::EntryBody); +} + +#[test] +fn cc_source_context_retains_entry_queue() { + cc::reject(Mutation::EntryQueue); +} + +#[test] +fn mir_source_context_retains_entry_queue() { + mir::reject(Mutation::EntryQueue); +} + +#[test] +fn cc_source_context_retains_entry_extent() { + cc::reject(Mutation::EntryExtent); +} + +#[test] +fn mir_source_context_retains_entry_extent() { + mir::reject(Mutation::EntryExtent); +} + +#[test] +fn cc_source_context_retains_entry_context() { + cc::reject(Mutation::EntryContext); +} + +#[test] +fn mir_source_context_retains_entry_context() { + mir::reject(Mutation::EntryContext); +} + +#[test] +fn cc_source_context_retains_fresh_status() { + cc::reject(Mutation::Status); +} + +#[test] +fn mir_source_context_retains_fresh_status() { + mir::reject(Mutation::Status); +} + +#[test] +fn cc_source_context_retains_current_caller() { + cc::reject(Mutation::Caller); +} +#[test] +fn mir_source_context_retains_current_caller() { + mir::reject(Mutation::Caller); +} + +#[test] +fn mir_source_context_status_is_allocated_inside_the_executor_loop() { + mir::reject(Mutation::StatusOutsideLoop); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 3f078fdb..1061e3c4 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -11,6 +11,7 @@ mod control_carriers; mod control_checkpoint_ordering; mod control_checkpoints; mod control_context_contracts; +mod control_context_entry; mod control_contracts; mod control_costs; mod control_finish_provenance; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index b4f9c493..6ae4c2f1 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Complete execution-step, context-entry and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Complete execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 2d2a2c0d..c24f90cf 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -376,6 +376,31 @@ copy steps; deleting an entire required step still needs full execution-step coverage. Creating every source context with the right clauses and identities remains a separate producer obligation. +### Source context construction and entry + +Creating a scoped context retains return and operation clauses from fields zero +and one of the current Handle computation, and retains the current dispatch +context as its caller. Ordinary entry saves the current pending queue and current +execution extent as parent, allocating a child extent with a new one-element live +status cell. Tail entry instead removes one leading finish and shares its extent; +saved queue, parent and extent must all come from that same current finish. + +The following executor transition preserves state and the root handler, enters +field two of that Handle with an empty queue, and installs the newly constructed +context and its extent. It must not enter the Handle again, execute caller work +inside the source, or reuse the previous context/extent. CC checks nominal case +fields and reference origins. MIR repeats those relations over physical fields, +copies/casts and call/tail-call/loop transitions. Allocation dominance and the +current loop iteration are checked through the same common MIR operation used +by replay validation; an allocation reused from the entry preheader is invalid. + +These checks establish constructor operands and their associated transitions. +They do not yet prove complete dispatch coverage, branch selection (including +when tail coalescing is selected), root context seeding, or rejection after an +entire required entry step is removed. Status initialization is checked; arbitrary +extra effectful instructions and complete lifecycle flow require execution-step +verification. Those obligations remain part of full context provenance. + ### Finish consumption ownership A finish record stores `(extent, remainingQueue, parent)`. Consuming it must close diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index a5352985..57db9693 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1344,3 +1344,49 @@ exact fingerprints, collection counts and maximum post-GC live bytes. Logs: `/private/tmp/psrs-context-clippy-final.log`. Explicit upstream type comparison, package conformance and suite scoreboards are not rerun for this internal invariant change. No measured gate number changes. + + +## Source context construction and entry (2026-10-12) + +Starting point: compiler `a9d87844`, branch `feat/effect-handlers`, clean checkout. +CC/MIR check actual scoped-context constructors and their following executor +transitions. Shared stage-independent clause and tail-finish relations use the +current Handle and current queue identities. Ordinary entry retains caller work +outside capture and creates a child lifetime activation; tail entry preserves +queue, extent and parent from one current finish. The transition enters the +Handle body with an empty queue, preserving state/root handler and installing the +new context and its extent. MIR allocation ordering and iteration freshness now +have a common owner shared with replay checking. + +| Requirement | Evidence | Status | +| --- | --- | --- | +| Keep return/operation clauses from the current Handle | Paired `source_context_retains_clauses` malformed CC/MIR cases | Focused Verified | +| Retain the current caller context | Paired `source_context_retains_current_caller`; paired accepted caller cast/copy tests | Focused Verified | +| Retain current finish operands during tail entry | Paired `source_context_retains_tail_queue`, `tail_parent`, `tail_extent` cases | Focused Verified | +| Enter the inner computation with an empty queue and new context/extent | Paired `source_context_retains_entry_body`, `entry_queue`, `entry_extent`, `entry_context` cases | Focused Verified | +| Allocate a live one-element status inside the current iteration | Paired `source_context_retains_fresh_status`, plus `mir_source_context_status_is_allocated_inside_the_executor_loop` | Focused Verified | + +All twenty-three new structural cases pass. They check existing constructors and +transitions; deleting every required entry step, full dispatch/branch selection, +root seeding, arbitrary additional effects and complete frame/context provenance +remain unverified. Foreign capture, caught-host-trap cleanup, pinned upstream +acceptance and general allocation accounting also remain open. No full AE/AC row +is declared complete; native Effect/ST follows complete delimited-control +acceptance. + +Validation: `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` passes +435 backend tests, 95 Core tests and all 81 control integration tests. Driver +library results are 618 passed and 162 failed. The nine failing targets and all +175 failed test names exactly match `a9d87844`; no name is added or recovered. +This compares failed names, not every baseline cause. A syntax-only test-helper +lint repair is followed by a final mandatory-Wasmtime control filter: 107 driver +tests pass, including ancestry/GC and no-tail-call execution. Formatting, +`git diff --check` and final strict workspace clippy pass. + +Logs: `/private/tmp/psrs-context-entry-structural.log`, +`/private/tmp/psrs-context-entry-workspace.log`, +`/private/tmp/psrs-context-entry-comparison.json`, +`/private/tmp/psrs-context-entry-focused-final.log`, and +`/private/tmp/psrs-context-entry-clippy-final.log`. Separate pinned-package +conformance commands and ignored suite scoreboards are not rerun for this +internal invariant slice. No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 6615a82e..65774c46 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -83,6 +83,13 @@ references. Traversal, handoff and callback rebuild preserve the required active parent and accumulator identities. Twenty-three new cases include a valid SSA copy at the dispatch-parent join. Entire-step deletion, context-entry production, full selection/algorithm coverage and host cleanup remain open. +The continuation from `a9d87844` checks scoped source-context construction and +entry in CC/MIR: current Handle clauses, caller identity, ordinary saved work and +fresh child activation, shared tail-finish provenance, and the empty-queue inner +computation transition. Common MIR allocation ordering proves freshness within +the current loop iteration. Twenty-three new tests cover malformed operands, +preheader allocation rejection and accepted reference aliases. Complete dispatch +selection, root seeding, entire-step deletion and host cleanup remain open. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From 7a6dae8985d39124a019bce7bd3b8b6a421c8166 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 15:40:19 +0800 Subject: [PATCH 119/148] fix(backend): verify control root initialization and normal cleanup --- .../psrs-backend/src/cc/verify/control/mod.rs | 2 + .../src/cc/verify/control/root.rs | 215 ++++++++++++++ crates/psrs-backend/src/control_provenance.rs | 10 + crates/psrs-backend/src/mir/cfg.rs | 108 +++++++ crates/psrs-backend/src/mir/control/mod.rs | 2 + crates/psrs-backend/src/mir/control/root.rs | 253 ++++++++++++++++ .../psrs-driver/src/tests/control_root/cc.rs | 213 +++++++++++++ .../psrs-driver/src/tests/control_root/mir.rs | 280 ++++++++++++++++++ .../psrs-driver/src/tests/control_root/mod.rs | 111 +++++++ .../src/tests/control_root/ownership.rs | 270 +++++++++++++++++ .../src/tests/control_root/paths.rs | 201 +++++++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + docs/design/D-04-suite-roadmap.md | 2 +- .../control-elimination-and-handler-scopes.md | 27 ++ .../backend/algebraic-effects.md | 54 ++++ ...ted-control-lowering-handoff-2026-10-11.md | 9 + 16 files changed, 1757 insertions(+), 1 deletion(-) create mode 100644 crates/psrs-backend/src/cc/verify/control/root.rs create mode 100644 crates/psrs-backend/src/mir/control/root.rs create mode 100644 crates/psrs-driver/src/tests/control_root/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_root/mir.rs create mode 100644 crates/psrs-driver/src/tests/control_root/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_root/ownership.rs create mode 100644 crates/psrs-driver/src/tests/control_root/paths.rs diff --git a/crates/psrs-backend/src/cc/verify/control/mod.rs b/crates/psrs-backend/src/cc/verify/control/mod.rs index 3df1564f..1a8658e9 100644 --- a/crates/psrs-backend/src/cc/verify/control/mod.rs +++ b/crates/psrs-backend/src/cc/verify/control/mod.rs @@ -10,6 +10,7 @@ mod context_entry; mod finish_consumption; mod finish_creation; mod replay; +mod root; pub(super) fn verify_before_assignments( function: &Function, @@ -23,6 +24,7 @@ pub(super) fn verify_after_assignments( representations: &RepresentationTable, functions: Option<&HashMap>, ) -> Result<(), Vec> { + root::verify(function, representations)?; checkpoints::verify(function, representations)?; finish_creation::verify(function, representations)?; context_entry::verify(function, representations)?; diff --git a/crates/psrs-backend/src/cc/verify/control/root.rs b/crates/psrs-backend/src/cc/verify/control/root.rs new file mode 100644 index 00000000..23fc7b0f --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/root.rs @@ -0,0 +1,215 @@ +//! Run factories establish one fresh root and close it before publishing a result. +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control_provenance::root_extent_relation; +use psrs_hir::Intrinsic; +use std::collections::HashMap; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + let Some(schema) = table.control_replay_schema() else { + return Ok(()); + }; + let context = table + .control_checkpoint_schema() + .ok_or_else(|| error(function, "control run has no checked root schema"))? + .context; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = |value| { + crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) + }; + let role = |id: crate::cc::ControlHelperId| { + table + .control_helpers + .get(id.0 as usize) + .map(|helper| helper.role()) + }; + let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(A::Constant(value)) if *value == expected); + if table + .control_helpers + .iter() + .any(|helper| helper.function() == function.symbol && helper.role() == R::Start) + { + if !function.parameters.is_empty() { + return Err(error( + function, + "control Start has an invalid parameter contract", + )); + } + let Some(A::VariantNew { + representation, + case: 0, + fields, + .. + }) = definitions.get(&origin(function.result)).copied() + else { + return Err(error( + function, + "control Start must return a freshly allocated root extent", + )); + }; + if *representation != schema.boundary || fields.len() != 1 { + return Err(error( + function, + "control Start must return a freshly allocated root extent", + )); + } + let live = match definitions.get(&origin(fields[0])).copied() { + Some(A::ArrayNew { + representation, + elements, + .. + }) => { + *representation == schema.status && elements.len() == 1 && constant(elements[0], 0) + } + Some(A::ArrayFill { + representation, + length, + value, + .. + }) => *representation == schema.status && constant(*length, 1) && constant(*value, 0), + _ => false, + }; + if !live { + return Err(error( + function, + "control Start needs a fresh one-element live status cell", + )); + } + } + let mut owners = HashMap::<_, Vec<(_, Vec<(crate::cc::ValueId, i64)>)>>::new(); + let mut pending = vec![(function.assignments.as_slice(), Vec::new())]; + while let Some((body, path)) = pending.pop() { + for (index, assignment) in body.iter().enumerate() { + match &assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + let mut child = path.clone(); + child.push((assignment.destination, i64::from(case.tag))); + pending.push((case.assignments.as_slice(), child)); + } + let mut child = path.clone(); + child.push((assignment.destination, i64::MIN)); + pending.push((default_assignments.as_slice(), child)); + } + A::If { + then_assignments, + else_assignments, + .. + } => { + for (body, arm) in [ + (then_assignments.as_slice(), 0), + (else_assignments.as_slice(), 1), + ] { + let mut child = path.clone(); + child.push((assignment.destination, arm)); + pending.push((body, child)); + } + } + A::ControlEvidence { + contract, + implementation, + .. + } if table + .control_contracts + .get(contract.0 as usize) + .is_some_and(|proof| proof.operation() == Intrinsic::ControlRun) => + { + let implementation = origin(*implementation); + let call_index = body[..index] + .iter() + .position(|assignment| assignment.destination == implementation) + .ok_or_else(|| { + error(function, "control run has no local executor invocation") + })?; + let A::DirectCall { + contract: Some(id), + arguments, + .. + } = &body[call_index].kind + else { + return Err(error( + function, + "control run has no local executor invocation", + )); + }; + if role(*id) != Some(R::Executor) || arguments.len() != 6 { + return Err(error( + function, + "control run has no local executor invocation", + )); + } + if !matches!(definitions.get(&origin(arguments[3])).copied(), Some(A::VariantNew { representation, case: 0, fields, .. }) if *representation == schema.sequence && fields.is_empty()) + { + return Err(error( + function, + "control run must start with an empty root queue", + )); + } + let extent = origin(arguments[4]); + let previous = owners.entry(extent).or_default(); + if previous.iter().any(|(call, previous_path)| { + *call != implementation + && !previous_path.iter().any(|(branch, arm)| { + path.iter().any(|(current_branch, current_arm)| { + branch == current_branch && arm != current_arm + }) + }) + }) { + return Err(error( + function, + "control run factories must not reuse another invocation's root extent", + )); + } + previous.push((implementation, path.clone())); + if !matches!(definitions.get(&extent).copied(), Some(A::DirectCall { contract: Some(id), arguments, .. }) if role(*id) == Some(R::Start) && arguments.is_empty()) + { + return Err(error( + function, + "control run must start with a fresh Start extent", + )); + } + let Some(A::VariantNew { + representation, + case: 0, + fields, + .. + }) = definitions.get(&origin(arguments[5])).copied() + else { + return Err(error( + function, + "control run must install a root dispatch context", + )); + }; + if *representation != context || fields.len() != 1 { + return Err(error( + function, + "control run must install a root dispatch context", + )); + } + root_extent_relation(extent, origin(fields[0])) + .map_err(|message| error(function, message))?; + if !body[call_index + 1..index].iter().any(|assignment| matches!(&assignment.kind, + A::DirectCall { contract: Some(id), arguments, .. } if role(*id) == Some(R::Close) && arguments.len() == 1 && origin(arguments[0]) == extent)) { + return Err(error(function, "control run must close its root after execution and before publishing its result")); + } + } + _ => {} + } + } + } + Ok(()) +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC control root", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control_provenance.rs index 28f399a8..ff3c61c7 100644 --- a/crates/psrs-backend/src/control_provenance.rs +++ b/crates/psrs-backend/src/control_provenance.rs @@ -151,3 +151,13 @@ pub(crate) fn context_tail_relation( } Ok(()) } + +pub(crate) fn root_extent_relation( + execution: ValueId, + dispatch: ValueId, +) -> Result<(), &'static str> { + if execution != dispatch { + return Err("control run must use the same fresh root extent for execution and dispatch"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/cfg.rs b/crates/psrs-backend/src/mir/cfg.rs index 92682e99..8ecad15f 100644 --- a/crates/psrs-backend/src/mir/cfg.rs +++ b/crates/psrs-backend/src/mir/cfg.rs @@ -8,6 +8,114 @@ use super::{BasicBlock, BlockId, Function, Terminator}; use std::collections::{HashMap, HashSet, VecDeque}; +/// Every normal path after `start` must cross a required instruction before a +/// normal exit, checked publication, or another execution of `start`. Trapping +/// paths are excluded; this does not establish caught-host-trap cleanup. +pub(crate) fn normal_paths_cross( + function: &Function, + start: (BlockId, usize), + required: impl Fn(&super::Instruction) -> bool, + publication: impl Fn(&super::Instruction) -> bool, +) -> bool { + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + if blocks + .get(&start.0) + .is_none_or(|block| start.1 >= block.instructions.len()) + { + return false; + } + let mut pending = vec![(start.0, start.1 + 1)]; + let mut seen = HashSet::new(); + while let Some((id, index)) = pending.pop() { + if !seen.insert((id, index)) { + continue; + } + let Some(block) = blocks.get(&id) else { + return false; + }; + let mut crossed = false; + for (offset, instruction) in block.instructions[index..].iter().enumerate() { + if required(instruction) + || matches!(instruction, super::Instruction::Unreachable { .. }) + { + crossed = true; + break; + } + if (id, index + offset) == start || publication(instruction) { + return false; + } + } + if crossed { + continue; + } + match &block.terminator { + Some(Terminator::Trap { .. }) => {} + Some( + Terminator::Jump { .. } | Terminator::Branch { .. } | Terminator::Switch { .. }, + ) => { + pending.extend( + successors(block.terminator.as_ref().unwrap()) + .into_iter() + .map(|id| (id, 0)), + ); + } + _ => return false, + } + } + true +} + +/// Can a later instruction be reached before the producer executes again? +/// `None` denotes malformed point/edge metadata, not an empty path set. +pub(crate) fn reachable_without( + function: &Function, + source: (BlockId, usize), + target: (BlockId, usize), + producer: (BlockId, usize), +) -> Option { + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + for point in [source, target, producer] { + if point.1 >= blocks.get(&point.0)?.instructions.len() { + return None; + } + } + let mut pending = vec![(source.0, source.1 + 1)]; + let mut seen = HashSet::new(); + while let Some((id, index)) = pending.pop() { + if !seen.insert((id, index)) { + continue; + } + let block = blocks.get(&id)?; + let mut stopped = false; + for (offset, instruction) in block.instructions[index..].iter().enumerate() { + let point = (id, index + offset); + if point == producer || matches!(instruction, super::Instruction::Unreachable { .. }) { + stopped = true; + break; + } + if point == target { + return Some(true); + } + } + if !stopped { + pending.extend( + successors(block.terminator.as_ref()?) + .into_iter() + .map(|id| (id, 0)), + ); + } + } + Some(false) +} + /// The successor blocks named by a terminator. pub(crate) fn successors(terminator: &Terminator) -> Vec { match terminator { diff --git a/crates/psrs-backend/src/mir/control/mod.rs b/crates/psrs-backend/src/mir/control/mod.rs index ed08e5cf..3502404e 100644 --- a/crates/psrs-backend/src/mir/control/mod.rs +++ b/crates/psrs-backend/src/mir/control/mod.rs @@ -9,11 +9,13 @@ mod contracts; mod finish_consumption; mod finish_creation; mod replay; +mod root; pub(super) use contracts::verify_helper_calls; pub(super) fn verify(module: &Module, errors: &mut Vec) { contracts::verify(module, errors); + root::verify(module, errors); finish_consumption::verify(module, errors); checkpoints::verify(module, errors); replay::verify(module, errors); diff --git a/crates/psrs-backend/src/mir/control/root.rs b/crates/psrs-backend/src/mir/control/root.rs new file mode 100644 index 00000000..ea20f5f3 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/root.rs @@ -0,0 +1,253 @@ +//! Root initialization and normal completion after physical lowering. +use crate::BackendError; +use crate::cc::{ControlHelperRole as R, RepresentationTable}; +use crate::control_provenance::root_extent_relation; +use crate::mir::value_identity::{definitions, fresh_iteration_allocation, reference_origin}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; +use crate::types::DefinedTypeId; +use psrs_hir::Intrinsic; +use std::collections::HashMap; + +struct Schema { + context: DefinedTypeId, + boundary: DefinedTypeId, + empty: DefinedTypeId, + status: DefinedTypeId, +} + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + if table.control_helpers.is_empty() { + return; + } + let schema = table + .control_checkpoint_schema() + .zip(table.control_replay_schema()) + .and_then(|(checkpoint, replay)| { + Some(Schema { + context: layout.variant_index(checkpoint.context, 0).ok()?, + boundary: layout.variant_index(replay.boundary, 0).ok()?, + empty: layout.variant_index(replay.sequence, 0).ok()?, + status: layout.repr_index(replay.status).ok()?, + }) + }); + let Some(schema) = schema else { + errors.push(BackendError::invalid_ir( + "P9 MIR control root", + module.span, + "control run has no physical root schema", + )); + return; + }; + for function in &module.functions { + if let Err(message) = verify_function(function, table, &schema) { + errors.push( + BackendError::invalid_ir("P9 MIR control root", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} + +fn verify_function( + function: &Function, + table: &RepresentationTable, + schema: &Schema, +) -> Result<(), &'static str> { + let definitions = definitions(function); + let origin = |value| reference_origin(value, &definitions); + let role = |id: crate::cc::ControlHelperId| { + table + .control_helpers + .get(id.0 as usize) + .map(|helper| helper.role()) + }; + let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(I::Constant { value, .. }) if *value == expected); + let physical_root = |value| { + let Some(I::StructNew { + type_index, + arguments, + .. + }) = definitions.get(&origin(value)).copied() + else { + return Err("control Start must return a freshly allocated root extent"); + }; + if *type_index != schema.boundary || arguments.len() != 2 || !constant(arguments[0], 0) { + return Err("control Start must return a freshly allocated root extent"); + } + let status = origin(arguments[1]); + let live = match definitions.get(&status).copied() { + Some(I::ArrayNew { + type_index, + elements, + .. + }) => *type_index == schema.status && elements.len() == 1 && constant(elements[0], 0), + Some(I::ArrayNewFilled { + type_index, + length, + value, + .. + }) => *type_index == schema.status && constant(*length, 1) && constant(*value, 0), + _ => false, + }; + if !live { + return Err("control Start needs a fresh one-element live status cell"); + } + Ok(status) + }; + if table + .control_helpers + .iter() + .any(|helper| helper.function() == function.symbol && helper.role() == R::Start) + { + if !function.parameters.is_empty() { + return Err("control Start has an invalid parameter contract"); + } + let mut returns = 0; + for block in &function.blocks { + match &block.terminator { + Some(T::Return { value, .. }) => { + returns += 1; + physical_root(*value)?; + } + Some(T::ReturnCall { .. } | T::ReturnCallRef { .. }) => { + return Err("control Start must return a freshly allocated root extent"); + } + _ => {} + } + } + if returns == 0 { + return Err("control Start must return a freshly allocated root extent"); + } + } + if !definitions.values().any(|instruction| matches!(instruction, I::ControlEvidence { contract, .. } + if table.control_contracts.get(contract.0 as usize).is_some_and(|proof| proof.operation() == Intrinsic::ControlRun))) { + return Ok(()); + } + let points = function + .blocks + .iter() + .flat_map(|block| { + block + .instructions + .iter() + .enumerate() + .filter_map(move |(index, instruction)| { + instruction + .destination() + .map(|value| (value, (block.id, index))) + }) + }) + .collect::>(); + let dominators = crate::mir::cfg::dominators(function); + let mut owners = HashMap::<_, Vec<_>>::new(); + for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { + let I::ControlEvidence { + contract, + implementation, + .. + } = instruction + else { + continue; + }; + if !table + .control_contracts + .get(contract.0 as usize) + .is_some_and(|proof| proof.operation() == Intrinsic::ControlRun) + { + continue; + } + let implementation = origin(*implementation); + let Some(I::Call { + contract: Some(id), + arguments, + .. + }) = definitions.get(&implementation).copied() + else { + return Err("control run has no local executor invocation"); + }; + if role(*id) != Some(R::Executor) || arguments.len() != 6 { + return Err("control run has no local executor invocation"); + } + if !matches!(definitions.get(&origin(arguments[3])).copied(), Some(I::StructNew { type_index, arguments, .. }) + if *type_index == schema.empty && arguments.len() == 1 && constant(arguments[0], 0)) + { + return Err("control run must start with an empty root queue"); + } + let extent = origin(arguments[4]); + let retained_start = matches!(definitions.get(&extent).copied(), Some(I::Call { contract: Some(id), arguments, .. }) if role(*id) == Some(R::Start) && arguments.is_empty()); + if !retained_start + && !matches!(definitions.get(&extent).copied(), Some(I::StructNew { type_index, .. }) if *type_index == schema.boundary) + { + return Err("control run must start with a fresh Start extent"); + } + let point = *points + .get(&implementation) + .ok_or("control run has no local executor invocation")?; + let status = if retained_start { + None + } else { + Some(physical_root(extent)?) + }; + if !fresh_iteration_allocation(function, extent, point, &points, &dominators) + || status.is_some_and(|status| { + !fresh_iteration_allocation(function, status, point, &points, &dominators) + }) + { + return Err( + "control run root must be allocated in its current invocation or iteration", + ); + } + for owned in std::iter::once(extent).chain(status) { + let producer = *points + .get(&owned) + .ok_or("control run has no root producer")?; + let previous = owners.entry(owned).or_default(); + for previous_point in previous + .iter() + .copied() + .filter(|previous| *previous != point) + { + let forward = + crate::mir::cfg::reachable_without(function, previous_point, point, producer); + let backward = + crate::mir::cfg::reachable_without(function, point, previous_point, producer); + if forward != Some(false) || backward != Some(false) { + return Err( + "control run factories must not reuse another invocation's root extent or status cell", + ); + } + } + previous.push(point); + } + let Some(I::StructNew { + type_index, + arguments: context, + .. + }) = definitions.get(&origin(arguments[5])).copied() + else { + return Err("control run must install a root dispatch context"); + }; + if *type_index != schema.context || context.len() != 2 || !constant(context[0], 0) { + return Err("control run must install a root dispatch context"); + } + root_extent_relation(extent, origin(context[1]))?; + let closed = crate::mir::cfg::normal_paths_cross( + function, + point, + |instruction| { + matches!(instruction, + I::Call { contract: Some(id), arguments, .. } + if role(*id) == Some(R::Close) && arguments.len() == 1 && origin(arguments[0]) == extent) + }, + |instruction| matches!(instruction, I::ControlEvidence { implementation: actual, .. } if origin(*actual) == implementation), + ); + if !closed { + return Err( + "control run must close its root after execution and before publishing its result", + ); + } + } + Ok(()) +} diff --git a/crates/psrs-driver/src/tests/control_root/cc.rs b/crates/psrs-driver/src/tests/control_root/cc.rs new file mode 100644 index 00000000..0107b4c0 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_root/cc.rs @@ -0,0 +1,213 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueId, ValueShape}; +use psrs_hir::Intrinsic; + +pub(super) fn reject(mutation: Mutation) { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (start, start_id) = binding(&input.cc.representations, R::Start); + let (check, check_id) = binding(&input.cc.representations, R::Check); + let close = binding(&input.cc.representations, R::Close).1; + let table = &input.cc.representations; + let function = input.cc.functions.iter_mut().find(|function| { + if matches!(mutation, Mutation::StartStatus) { return function.symbol == start; } + function.assignments.iter().any(|assignment| matches!(&assignment.kind, + A::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)) + }).unwrap(); + if matches!(mutation, Mutation::StartStatus) { + let A::ArrayNew { elements, .. } = &mut function + .assignments + .iter_mut() + .find(|assignment| matches!(assignment.kind, A::ArrayNew { .. })) + .unwrap() + .kind + else { + unreachable!() + }; + elements.clear(); + } else { + let call_value = function + .assignments + .iter() + .find_map(|assignment| match &assignment.kind { + A::ControlEvidence { + contract, + implementation, + .. + } if table.control_contracts[contract.0 as usize].operation() + == Intrinsic::ControlRun => + { + Some(*implementation) + } + _ => None, + }) + .unwrap(); + let call_index = function + .assignments + .iter() + .position(|assignment| assignment.destination == call_value) + .unwrap(); + let A::DirectCall { arguments, .. } = &function.assignments[call_index].kind else { + unreachable!() + }; + let extent = arguments[4]; + let context = arguments[5]; + let empty = arguments[3]; + let extra = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let extent_ty = function + .values + .iter() + .find(|value| value.id == extent) + .unwrap() + .ty; + let start_index = function + .assignments + .iter() + .position(|assignment| assignment.destination == extent) + .unwrap(); + if matches!( + mutation, + Mutation::DispatchExtent | Mutation::ExecutionExtent | Mutation::WrongClose + ) { + function.values.push(psrs_backend::cc::ValueDecl { + id: extra, + ty: extent_ty, + }); + function.assignments.insert( + start_index + 1, + Assignment { + destination: extra, + kind: A::DirectCall { + contract: Some(start_id), + function: start, + arguments: vec![], + }, + span: function.span, + }, + ); + } + match mutation { + Mutation::DispatchExtent => { + let A::VariantNew { fields, .. } = &mut function + .assignments + .iter_mut() + .find(|assignment| assignment.destination == context) + .unwrap() + .kind + else { + unreachable!() + }; + fields[0] = extra; + } + Mutation::ExecutionExtent => { + let A::DirectCall { arguments, .. } = &mut function + .assignments + .iter_mut() + .find(|assignment| assignment.destination == call_value) + .unwrap() + .kind + else { + unreachable!() + }; + arguments[4] = extra; + } + Mutation::Queue => { + let A::VariantNew { representation, .. } = function + .assignments + .iter() + .find(|assignment| assignment.destination == empty) + .unwrap() + .kind + else { + unreachable!() + }; + let ty = function + .values + .iter() + .find(|value| value.id == empty) + .unwrap() + .ty; + function + .values + .push(psrs_backend::cc::ValueDecl { id: extra, ty }); + function.assignments.insert( + call_index, + Assignment { + destination: extra, + kind: A::VariantNew { + destination: extra, + representation, + case: 3, + fields: vec![extent, empty, extent], + }, + span: function.span, + }, + ); + let A::DirectCall { arguments, .. } = + &mut function.assignments[call_index + 1].kind + else { + unreachable!() + }; + arguments[3] = extra; + } + _ => { + let close_index = function + .assignments + .iter() + .position(|assignment| { + matches!(assignment.kind, + A::DirectCall { contract: Some(id), .. } if id == close) + }) + .unwrap(); + let assignment = &mut function.assignments[close_index]; + match mutation { + Mutation::MissingClose => { + let ValueShape::Reference(reference) = extent_ty else { + unreachable!() + }; + assignment.kind = A::RepresentationCast { + destination: assignment.destination, + value: extent, + reference, + }; + } + Mutation::WrongClose => { + let A::DirectCall { arguments, .. } = &mut assignment.kind else { + unreachable!() + }; + arguments[0] = extra; + } + Mutation::EarlyClose => { + let instruction = function.assignments.remove(close_index); + function.assignments.insert(call_index, instruction); + } + Mutation::CheckInsteadClose => { + let A::DirectCall { + contract, function, .. + } = &mut assignment.kind + else { + unreachable!() + }; + *contract = Some(check_id); + *function = check; + } + _ => unreachable!(), + } + } + } + } + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_root/mir.rs b/crates/psrs-driver/src/tests/control_root/mir.rs new file mode 100644 index 00000000..14b4a5b6 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_root/mir.rs @@ -0,0 +1,280 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::ValueId; +use psrs_backend::mir::Instruction as I; +use psrs_backend::types::ValueType; +use psrs_hir::Intrinsic; +use std::collections::HashMap; + +pub(super) fn reject(mutation: Mutation) { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let close = binding(&stages.cc.representations, R::Close).1; + let (check, check_id) = binding(&stages.cc.representations, R::Check); + let start = binding(&stages.cc.representations, R::Start).0; + let executor = binding(&stages.cc.representations, R::Executor).0; + let table = &stages.cc.representations; + let retained_start = stages + .mir + .functions + .iter() + .any(|function| function.symbol == start); + let (finish_type, finish_ty) = stages + .mir + .functions + .iter() + .filter(|function| function.symbol == executor) + .find_map(|function| { + function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::StructNew { + destination, + type_index, + arguments, + .. + } if arguments.len() == 4 => Some(( + *type_index, + function + .values + .iter() + .find(|value| value.id == *destination) + .unwrap() + .ty, + )), + _ => None, + }) + }) + .unwrap(); + let function = stages.mir.functions.iter_mut().find(|function| { + if matches!(mutation, Mutation::StartStatus) && retained_start { return function.symbol == start; } + function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, + I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)) + }).unwrap(); + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| { + instruction + .destination() + .map(|value| (value, instruction.clone())) + }) + .collect::>(); + let origin = |mut value: ValueId| { + for _ in 0..definitions.len() { + match definitions.get(&value) { + Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { + value = *source + } + _ => break, + } + } + value + }; + if matches!(mutation, Mutation::StartStatus) { + let I::ArrayNew { elements, .. } = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find(|instruction| matches!(instruction, I::ArrayNew { .. })) + .unwrap() + else { + unreachable!() + }; + elements.clear(); + } else { + let call = definitions + .values() + .find_map(|instruction| match instruction { + I::ControlEvidence { + contract, + implementation, + .. + } if table.control_contracts[contract.0 as usize].operation() + == Intrinsic::ControlRun => + { + Some(origin(*implementation)) + } + _ => None, + }) + .unwrap(); + let I::Call { arguments, .. } = &definitions[&call] else { + unreachable!() + }; + let extent = origin(arguments[4]); + let context = origin(arguments[5]); + let empty = arguments[3]; + let extra = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let extent_ty = function + .values + .iter() + .find(|value| value.id == extent) + .unwrap() + .ty; + if matches!( + mutation, + Mutation::DispatchExtent | Mutation::ExecutionExtent | Mutation::WrongClose + ) { + function.values.push(psrs_backend::types::ValueDecl { + id: extra, + ty: extent_ty, + }); + for block in &mut function.blocks { + if let Some(index) = block + .instructions + .iter() + .position(|instruction| instruction.destination() == Some(extent)) + { + let I::StructNew { + type_index, + arguments, + .. + } = &block.instructions[index] + else { + unreachable!() + }; + let node = I::StructNew { + destination: extra, + type_index: *type_index, + arguments: arguments.clone(), + span: function.span, + }; + block.instructions.insert(index + 1, node); + break; + } + } + } + if matches!(mutation, Mutation::Queue) { + let tag = ValueId(extra.0 + 1); + function.values.extend([ + psrs_backend::types::ValueDecl { + id: extra, + ty: finish_ty, + }, + psrs_backend::types::ValueDecl { + id: tag, + ty: ValueType::I32, + }, + ]); + for block in &mut function.blocks { + if let Some(index) = block + .instructions + .iter() + .position(|instruction| instruction.destination() == Some(call)) + { + let I::Call { arguments, .. } = &mut block.instructions[index] else { + unreachable!() + }; + arguments[3] = extra; + block.instructions.splice( + index..index, + [ + I::Constant { + destination: tag, + value: 3, + span: function.span, + }, + I::StructNew { + destination: extra, + type_index: finish_type, + arguments: vec![tag, extent, empty, extent], + span: function.span, + }, + ], + ); + break; + } + } + } else { + let mut changed = false; + for block in &mut function.blocks { + for instruction in &mut block.instructions { + match mutation { + Mutation::DispatchExtent => { + if instruction.destination() != Some(context) { + continue; + } + let I::StructNew { arguments, .. } = instruction else { + unreachable!() + }; + arguments[1] = extra; + } + Mutation::ExecutionExtent => { + if instruction.destination() != Some(call) { + continue; + } + let I::Call { arguments, .. } = instruction else { + unreachable!() + }; + arguments[4] = extra; + } + _ => { + let I::Call { + contract: Some(id), + arguments, + destination, + function: target, + span, + .. + } = instruction + else { + continue; + }; + if *id != close { + continue; + } + match mutation { + Mutation::MissingClose => { + *instruction = I::Copy { + destination: *destination, + value: arguments[0], + span: *span, + } + } + Mutation::WrongClose => arguments[0] = extra, + Mutation::CheckInsteadClose => { + *id = check_id; + *target = check; + } + Mutation::EarlyClose => {} + _ => unreachable!(), + } + } + } + changed = true; + break; + } + if changed { + if matches!(mutation, Mutation::EarlyClose) { + let close_index = block.instructions.iter().position(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close)).unwrap(); + let call_index = block + .instructions + .iter() + .position(|instruction| instruction.destination() == Some(call)) + .unwrap(); + let instruction = block.instructions.remove(close_index); + block.instructions.insert(call_index, instruction); + } + break; + } + } + assert!(changed); + } + } + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains(mutation.message())), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_root/mod.rs b/crates/psrs-driver/src/tests/control_root/mod.rs new file mode 100644 index 00000000..c2f07bf4 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_root/mod.rs @@ -0,0 +1,111 @@ +//! Root initialization and normal cleanup must belong to the checked Run. +mod cc; +mod mir; +mod ownership; +mod paths; +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::ControlHelperRole as R; + +#[derive(Clone, Copy)] +enum Mutation { + DispatchExtent, + ExecutionExtent, + Queue, + MissingClose, + WrongClose, + EarlyClose, + CheckInsteadClose, + StartStatus, +} +impl Mutation { + fn message(self) -> &'static str { + match self { + Self::DispatchExtent | Self::ExecutionExtent => { + "same fresh root extent for execution and dispatch" + } + Self::Queue => "start with an empty root queue", + Self::StartStatus => "fresh one-element live status cell", + _ => "close its root after execution and before publishing its result", + } + } +} + +#[test] +fn cc_rejects_incorrect_root_dispatch_extent() { + cc::reject(Mutation::DispatchExtent); +} + +#[test] +fn mir_rejects_incorrect_root_dispatch_extent() { + mir::reject(Mutation::DispatchExtent); +} + +#[test] +fn cc_rejects_incorrect_root_execution_extent() { + cc::reject(Mutation::ExecutionExtent); +} + +#[test] +fn mir_rejects_incorrect_root_execution_extent() { + mir::reject(Mutation::ExecutionExtent); +} + +#[test] +fn cc_rejects_incorrect_root_queue() { + cc::reject(Mutation::Queue); +} + +#[test] +fn mir_rejects_incorrect_root_queue() { + mir::reject(Mutation::Queue); +} + +#[test] +fn cc_rejects_incorrect_root_missing_close() { + cc::reject(Mutation::MissingClose); +} + +#[test] +fn mir_rejects_incorrect_root_missing_close() { + mir::reject(Mutation::MissingClose); +} + +#[test] +fn cc_rejects_incorrect_root_wrong_close() { + cc::reject(Mutation::WrongClose); +} + +#[test] +fn mir_rejects_incorrect_root_wrong_close() { + mir::reject(Mutation::WrongClose); +} + +#[test] +fn cc_rejects_incorrect_root_early_close() { + cc::reject(Mutation::EarlyClose); +} + +#[test] +fn mir_rejects_incorrect_root_early_close() { + mir::reject(Mutation::EarlyClose); +} + +#[test] +fn cc_rejects_incorrect_root_check_instead_of_close() { + cc::reject(Mutation::CheckInsteadClose); +} + +#[test] +fn mir_rejects_incorrect_root_check_instead_of_close() { + mir::reject(Mutation::CheckInsteadClose); +} + +#[test] +fn cc_rejects_incorrect_root_start_status() { + cc::reject(Mutation::StartStatus); +} + +#[test] +fn mir_rejects_incorrect_root_start_status() { + mir::reject(Mutation::StartStatus); +} diff --git a/crates/psrs-driver/src/tests/control_root/ownership.rs b/crates/psrs-driver/src/tests/control_root/ownership.rs new file mode 100644 index 00000000..574a2ed2 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_root/ownership.rs @@ -0,0 +1,270 @@ +//! Distinct returning Runs need distinct roots; exclusive branches may share one. +use super::{R, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueId}; +use psrs_backend::mir::Instruction as I; +use psrs_hir::Intrinsic; +use std::collections::HashMap; +use std::process::Command; + +const HEADER: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +"; +const SEQUENTIAL: &str = "main :: Int\nmain = intAdd ((C.run 0 handler (C.return 20))._2) ((C.run 0 handler (C.return 22))._2)\n"; + +#[test] +fn cc_sequential_runs_cannot_share_a_root() { + let mut input = crate::lower_main_to_cc(&format!("{HEADER}\n{SEQUENTIAL}")).unwrap(); + let close = binding(&input.cc.representations, R::Close).1; + let table = &input.cc.representations; + let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().filter(|assignment| matches!(&assignment.kind, + A::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)).count() == 2).unwrap(); + let calls = function + .assignments + .iter() + .filter_map(|assignment| match &assignment.kind { + A::ControlEvidence { + contract, + implementation, + .. + } if table.control_contracts[contract.0 as usize].operation() + == Intrinsic::ControlRun => + { + Some(*implementation) + } + _ => None, + }) + .collect::>(); + let arguments = |call| match &function + .assignments + .iter() + .find(|assignment| assignment.destination == call) + .unwrap() + .kind + { + A::DirectCall { arguments, .. } => arguments.clone(), + _ => unreachable!(), + }; + let first = arguments(calls[0]); + let second = arguments(calls[1]); + for assignment in &mut function.assignments { + match &mut assignment.kind { + A::DirectCall { arguments, .. } if assignment.destination == calls[1] => { + arguments[4] = first[4] + } + A::VariantNew { fields, .. } if assignment.destination == second[5] => { + fields[0] = first[4] + } + A::DirectCall { + contract: Some(id), + arguments, + .. + } if *id == close && arguments[0] == second[4] => arguments[0] = first[4], + _ => {} + } + } + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("not reuse another invocation's root extent")), + "{errors:?}" + ); +} + +fn mir_reuse(status: bool) { + let mut stages = crate::compile_main_stages(&format!("{HEADER}\n{SEQUENTIAL}")).unwrap(); + let close = binding(&stages.cc.representations, R::Close).1; + let table = &stages.cc.representations; + let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).filter(|instruction| matches!(instruction, + I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)).count() == 2).unwrap(); + let definitions = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| { + instruction + .destination() + .map(|value| (value, instruction.clone())) + }) + .collect::>(); + let origin = |mut value: ValueId| { + for _ in 0..definitions.len() { + match definitions.get(&value) { + Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { + value = *source + } + _ => break, + } + } + value + }; + let calls = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| match instruction { + I::ControlEvidence { + contract, + implementation, + .. + } if table.control_contracts[contract.0 as usize].operation() + == Intrinsic::ControlRun => + { + Some(origin(*implementation)) + } + _ => None, + }) + .collect::>(); + let I::Call { + arguments: first, .. + } = &definitions[&calls[0]] + else { + unreachable!() + }; + let I::Call { + arguments: second, .. + } = &definitions[&calls[1]] + else { + unreachable!() + }; + if status { + let I::StructNew { + arguments: root, .. + } = &definitions[&origin(first[4])] + else { + unreachable!() + }; + let cell = root[1]; + let node = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find(|instruction| instruction.destination() == Some(origin(second[4]))) + .unwrap(); + let I::StructNew { arguments, .. } = node else { + unreachable!() + }; + arguments[1] = cell; + } else { + for instruction in function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + { + match instruction { + I::Call { + destination, + arguments, + .. + } if *destination == calls[1] => arguments[4] = first[4], + I::StructNew { + destination, + arguments, + .. + } if *destination == origin(second[5]) => arguments[1] = first[4], + I::Call { + contract: Some(id), + arguments, + .. + } if *id == close && origin(arguments[0]) == origin(second[4]) => { + arguments[0] = first[4] + } + _ => {} + } + } + } + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("not reuse another invocation's root extent")), + "{errors:?}" + ); +} + +fn share_branch( + body: &mut [Assignment], + close: psrs_backend::cc::ControlHelperId, + extent: ValueId, +) { + let call = body + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { arguments, .. } if arguments.len() == 6 => { + Some((assignment.destination, arguments[5])) + } + _ => None, + }) + .unwrap(); + for assignment in body { + match &mut assignment.kind { + A::DirectCall { arguments, .. } if assignment.destination == call.0 => { + arguments[4] = extent + } + A::VariantNew { fields, .. } if assignment.destination == call.1 => fields[0] = extent, + A::DirectCall { + contract: Some(id), + arguments, + .. + } if *id == close => arguments[0] = extent, + _ => {} + } + } +} + +#[test] +fn exclusive_run_branches_share_initialization_and_execute_independent_invocations() { + if super::super::wasmtime_available().is_none() { + return; + } + let source = format!( + "{HEADER}\nchoose :: Boolean -> Int\nchoose flag = if flag then (C.run 0 handler (C.return 20))._2 else (C.run 0 handler (C.return 22))._2\nmain :: Int\nmain = intAdd (choose true) (choose false)\n" + ); + let mut input = crate::lower_main_to_cc(&source).unwrap(); + let start = binding(&input.cc.representations, R::Start).1; + let close = binding(&input.cc.representations, R::Close).1; + let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().any(|assignment| + matches!(&assignment.kind, A::If { then_assignments, .. } if then_assignments.iter().any(|assignment| matches!(assignment.kind, A::DirectCall { contract: Some(id), .. } if id == start))))).unwrap(); + let index = function + .assignments + .iter() + .position(|assignment| matches!(assignment.kind, A::If { .. })) + .unwrap(); + let A::If { + then_assignments, + else_assignments, + .. + } = &mut function.assignments[index].kind + else { + unreachable!() + }; + let start_index = then_assignments.iter().position(|assignment| matches!(assignment.kind, A::DirectCall { contract: Some(id), .. } if id == start)).unwrap(); + let allocation = then_assignments.remove(start_index); + let extent = allocation.destination; + share_branch(else_assignments, close, extent); + function.assignments.insert(index, allocation); + psrs_backend::cc::verify_module(&input.cc).unwrap(); + let artifact = psrs_backend::compile_cc(input).unwrap(); + let path = + std::env::temp_dir().join(format!("psrs-exclusive-root-{}.wasm", std::process::id())); + std::fs::write(&path, artifact.wasm).unwrap(); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + std::fs::remove_file(&path).unwrap(); + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn mir_sequential_runs_cannot_share_a_root() { + mir_reuse(false); +} +#[test] +fn mir_sequential_runs_cannot_share_a_status_cell() { + mir_reuse(true); +} diff --git a/crates/psrs-driver/src/tests/control_root/paths.rs b/crates/psrs-driver/src/tests/control_root/paths.rs new file mode 100644 index 00000000..6f552a3f --- /dev/null +++ b/crates/psrs-driver/src/tests/control_root/paths.rs @@ -0,0 +1,201 @@ +//! Cleanup is checked on all normal paths, including multiple physical closes. +use super::{R, SOURCE, binding}; +use psrs_backend::cc::ValueId; +use psrs_backend::mir::{BasicBlock, BlockId, Instruction as I, Terminator as T}; +use psrs_backend::types::{ValueDecl, ValueType}; +use psrs_hir::Intrinsic; + +fn branching_cleanup(missing: bool, trap: bool) { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let close = binding(&stages.cc.representations, R::Close).1; + let table = &stages.cc.representations; + let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, + I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun))).unwrap(); + let block_index = function.blocks.iter().position(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close))).unwrap(); + let close_index = function.blocks[block_index] + .instructions + .iter() + .position( + |instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close), + ) + .unwrap(); + let close_instruction = function.blocks[block_index] + .instructions + .remove(close_index); + let suffix = function.blocks[block_index] + .instructions + .split_off(close_index); + let terminator = function.blocks[block_index].terminator.take(); + let condition = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let alias = ValueId(condition.0 + 1); + let I::Call { + destination, + arguments, + .. + } = &close_instruction + else { + unreachable!() + }; + let ty = function + .values + .iter() + .find(|value| value.id == *destination) + .unwrap() + .ty; + function.values.extend([ + ValueDecl { + id: condition, + ty: ValueType::Boolean, + }, + ValueDecl { id: alias, ty }, + ]); + let mut other = close_instruction.clone(); + if missing || trap { + other = I::Copy { + destination: alias, + value: arguments[0], + span: function.span, + }; + } else { + let I::Call { destination, .. } = &mut other else { + unreachable!() + }; + *destination = alias; + } + let then_block = BlockId( + function + .blocks + .iter() + .map(|block| block.id.0) + .max() + .unwrap() + + 1, + ); + let else_block = BlockId(then_block.0 + 1); + let join = BlockId(then_block.0 + 2); + let jump = || { + Some(T::Jump { + target: join, + arguments: vec![], + span: function.span, + }) + }; + function.blocks[block_index].instructions.push(I::Constant { + destination: condition, + value: 1, + span: function.span, + }); + function.blocks[block_index].terminator = Some(T::Branch { + condition, + then_block, + else_block, + span: function.span, + }); + function.blocks.extend([ + BasicBlock { + id: then_block, + parameters: vec![], + instructions: vec![close_instruction], + terminator: jump(), + }, + BasicBlock { + id: else_block, + parameters: vec![], + instructions: vec![other], + terminator: if trap { + Some(T::Trap { + span: function.span, + }) + } else { + jump() + }, + }, + BasicBlock { + id: join, + parameters: vec![], + instructions: suffix, + terminator, + }, + ]); + if missing { + let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("close its root after execution")), + "{errors:?}" + ); + } else { + psrs_backend::mir::verify_module(&stages.mir).unwrap(); + } +} + +#[test] +fn root_cleanup_can_be_distributed_across_normal_branches() { + branching_cleanup(false, false); +} +#[test] +fn root_cleanup_cannot_be_skipped_on_a_normal_branch() { + branching_cleanup(true, false); +} +#[test] +fn root_normal_cleanup_proof_excludes_trapping_paths() { + branching_cleanup(false, true); +} + +#[test] +fn physical_root_and_close_accept_reference_copies() { + let mut stages = crate::compile_main_stages(SOURCE).unwrap(); + let close = binding(&stages.cc.representations, R::Close).1; + let table = &stages.cc.representations; + let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, + I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun))).unwrap(); + let alias = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let mut changed = false; + for block in &mut function.blocks { + if let Some(index) = block.instructions.iter().position( + |instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close), + ) { + let I::Call { arguments, .. } = &mut block.instructions[index] else { + unreachable!() + }; + let value = arguments[0]; + let ty = function + .values + .iter() + .find(|declaration| declaration.id == value) + .unwrap() + .ty; + function.values.push(ValueDecl { id: alias, ty }); + arguments[0] = alias; + block.instructions.insert( + index, + I::Copy { + destination: alias, + value, + span: function.span, + }, + ); + changed = true; + break; + } + } + assert!(changed); + psrs_backend::mir::verify_module(&stages.mir).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 1061e3c4..076082e3 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -17,6 +17,7 @@ mod control_costs; mod control_finish_provenance; mod control_helper_contracts; mod control_replay_contracts; +mod control_root; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 6ae4c2f1..e4cdfbc7 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Complete execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Complete execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index c24f90cf..0bab6821 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -376,6 +376,33 @@ copy steps; deleting an entire required step still needs full execution-step coverage. Creating every source context with the right clauses and identities remains a separate producer obligation. +### Root initialization and normal completion + +A checked Run factory starts with the canonical empty queue and a new root +extent, installing a Root dispatch context containing that same extent. Start +returns a freshly allocated parentless extent with a new one-element live status +cell. Different sequential Run invocations must not share an extent or status +cell. Mutually exclusive alternatives may share initialization within one +invocation; recursion and loop iterations still require a new activation. + +Normal execution closes that root after the executor returns and before the +checked Run result is published. A check, a close of another root, or a close +before execution does not satisfy completion. CC checks the factory sequence and +source witness, using branch identity to distinguish exclusive alternatives. +MIR admits both a retained Start call and its inlined root/status allocations; +common allocation ordering checks the current invocation/iteration. Common CFG +analysis checks root reuse without reinitialization and requires a matching close +on every normal path before publication, another invocation or a normal exit. +The close can be distributed across several branches. + +These checks retain the source contract through Start inlining and ordinary +reference copies/casts. They establish initialization operands and normal cleanup +for surviving checked Run witnesses, not full execution-step equivalence. Extra +effectful instructions, deletion of every source witness and full dispatch +semantics require the remaining execution-step proof. Trapping paths are excluded +from the normal completion proof; caught-host-trap cleanup still requires its +separate host/runtime contract and execution evidence. + ### Source context construction and entry Creating a scoped context retains return and operation clauses from fields zero diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 57db9693..294f19b2 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1390,3 +1390,57 @@ Logs: `/private/tmp/psrs-context-entry-structural.log`, `/private/tmp/psrs-context-entry-clippy-final.log`. Separate pinned-package conformance commands and ignored suite scoreboards are not rerun for this internal invariant slice. No measured gate number changes. + + +## Root initialization and normal completion (2026-10-12) + +Starting point: compiler `7789c5ce`, branch `feat/effect-handlers`, clean checkout. +The root verifier consumes the checked Run witness and actual factory operands. +Start produces a fresh parentless extent with a one-element live status; the Run +factory starts with an empty queue and installs that same extent for execution +and root dispatch. It closes its root after execution and before publication. +MIR admits retained Start calls and inlined physical root/status construction, +checking allocation dominance and current iteration freshness through the common +owner shared with replay/context entry. Common CFG path operations prove normal +cleanup and reject root or status reuse along a path without reinitialization. +CC branch identity and MIR CFG reachability admit exclusive alternatives. + +| Requirement | Evidence | Status | +| --- | --- | --- | +| Root execution/dispatch share one fresh extent | Paired `rejects_incorrect_root_dispatch_extent` and `execution_extent` cases | Focused Verified | +| Begin with an empty root queue | Paired `rejects_incorrect_root_queue` cases with a real pending finish | Focused Verified | +| Start creates a fresh one-element live status | Paired `rejects_incorrect_root_start_status`; MIR checks actual inlined allocation | Focused Verified | +| Close the same root after execution, before result publication | Paired missing/wrong/early close and check-instead-of-close cases | Focused Verified | +| Complete cleanup on every normal path | Distributed-close positive test, skipped normal-branch negative test and trap-exclusion boundary test | Focused Verified | +| Retain ownership across Start inlining and reference aliases | Actual optimized MIR cases and `physical_root_and_close_accept_reference_copies` | Focused Verified | +| Separate sequential invocations, allow exclusive initialization | Paired sequential-root rejection, MIR sequential-status rejection; modified exclusive-branch CC compiled and executed twice, returning 42 | Focused Verified | + +All twenty-four new cases pass with mandatory Wasmtime. The executed exclusive +fixture moves one Start from a branch to the enclosing function and uses it in +both alternatives. Two calls to that function choose different branches and +execute independently. This is value-sensitive runtime evidence for the admitted +transformation, separate from malformed-IR rejection and CFG proof tests. + +The checks apply to surviving checked Run witnesses and recognizable Start +production. They do not prove arbitrary extra effects, deletion of every source +witness, complete dispatch/clause selection or caught-host-trap recovery. Foreign +capture, pinned upstream package acceptance and general allocation accounting +also remain open. No full AE/AC row is declared complete. + +Validation: mandatory-Wasmtime workspace execution passes 435 backend tests, +95 Core tests and all 81 control integration tests. Driver library results are +642 passed and 162 failed. The nine failing targets and all 175 failed test names +exactly match `7789c5ce`; no name is added or recovered. This compares failed +names, not every baseline cause. Final focused execution passes 131 control driver +tests, including actual ancestry/GC and no-tail-call execution. The final focused +run follows a test-fixture correction selecting the semantic Executor's physical +Finish type rather than an arbitrary four-field constructor. Formatting, +`git diff --check` and final strict workspace clippy pass. + +Logs: `/private/tmp/psrs-control-root-structural.log`, +`/private/tmp/psrs-control-root-workspace.log`, +`/private/tmp/psrs-control-root-comparison.json`, +`/private/tmp/psrs-control-root-focused-final.log`, and +`/private/tmp/psrs-control-root-clippy-final.log`. Separate pinned-package +conformance commands and ignored suite scoreboards are not rerun for this +internal invariant slice. No measured gate number changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 65774c46..166c6a26 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -90,6 +90,15 @@ computation transition. Common MIR allocation ordering proves freshness within the current loop iteration. Twenty-three new tests cover malformed operands, preheader allocation rejection and accepted reference aliases. Complete dispatch selection, root seeding, entire-step deletion and host cleanup remain open. +The continuation from `7789c5ce` checks Root initialization and normal completion. +Start produces a fresh parentless live extent; Run installs it in both execution +and dispatch, starts with an empty queue and closes it after execution, before +publishing a result. MIR preserves the proof through Start inlining and checks +all normal cleanup paths. Sequential runs cannot share extent/status storage; +exclusive alternatives may share initialization. Twenty-four new cases include +actual execution of modified exclusive-branch CC across two independent function +invocations, returning 42. Full dispatch selection, source-witness deletion, +arbitrary extra effects and caught-host-trap cleanup remain unverified. Full frame/context identity verification, general allocation bounds, foreign resources and caught-trap cleanup remain outstanding. Complete delimited-control acceptance precedes the requested native Effect/ST implementation. From 3d320e29feb255cd5ae2059cef64d16c08aa48a3 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 16:28:45 +0800 Subject: [PATCH 120/148] fix(frontend): accept qualified constructor operator chains --- crates/psrs-driver/src/tests/operators/mod.rs | 1 + .../src/tests/operators/qualified_patterns.rs | 26 +++++ crates/psrs-resolve/src/resolver/operators.rs | 1 + crates/psrs-syntax/src/parser/expr/pattern.rs | 41 +++++--- crates/psrs-syntax/src/parser/tests.rs | 2 + .../src/parser/tests/qualified_patterns.rs | 41 ++++++++ .../backend/algebraic-effects.md | 20 ++++ ...-reference-library-migration-2026-10-12.md | 97 +++++++++++++++++++ ...ted-control-lowering-handoff-2026-10-11.md | 9 ++ 9 files changed, 222 insertions(+), 16 deletions(-) create mode 100644 crates/psrs-driver/src/tests/operators/qualified_patterns.rs create mode 100644 crates/psrs-syntax/src/parser/tests/qualified_patterns.rs create mode 100644 docs/implementation/backend/control-reference-library-migration-2026-10-12.md diff --git a/crates/psrs-driver/src/tests/operators/mod.rs b/crates/psrs-driver/src/tests/operators/mod.rs index 1b1a8a78..18571c93 100644 --- a/crates/psrs-driver/src/tests/operators/mod.rs +++ b/crates/psrs-driver/src/tests/operators/mod.rs @@ -1,5 +1,6 @@ mod opaque_type; mod prim_type; +mod qualified_patterns; mod sections; use super::*; diff --git a/crates/psrs-driver/src/tests/operators/qualified_patterns.rs b/crates/psrs-driver/src/tests/operators/qualified_patterns.rs new file mode 100644 index 00000000..e3760ae8 --- /dev/null +++ b/crates/psrs-driver/src/tests/operators/qualified_patterns.rs @@ -0,0 +1,26 @@ +use super::*; + +#[test] +fn qualified_constructor_operator_patterns_reassociate_and_execute() { + let library = ( + "Chain.purs", + r"module Chain where +data Chain a = Link a (Chain a) | Empty +infixr 6 Link as : +data Wrapped = Wrap Int +", + ); + let main = ( + "Main.purs", + r"module Main where +import Chain as Foo.Bar +values = Foo.Bar.Wrap 20 Foo.Bar.: Foo.Bar.Wrap 22 Foo.Bar.: Foo.Bar.Empty +main :: Int +main = case values of + Foo.Bar.Wrap first Foo.Bar.: Foo.Bar.Wrap second Foo.Bar.: _ -> intAdd first second + _ -> 0 +", + ); + let output = run_program_with_wasmtime(&[library, main]).expect("required Wasmtime runtime"); + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-resolve/src/resolver/operators.rs b/crates/psrs-resolve/src/resolver/operators.rs index 47c6a233..646dd733 100644 --- a/crates/psrs-resolve/src/resolver/operators.rs +++ b/crates/psrs-resolve/src/resolver/operators.rs @@ -32,6 +32,7 @@ pub(super) fn merge_fixities( hir::FixityNamespace::Value => &mut value_fixities, hir::FixityNamespace::Type => &mut type_fixities, }; + destination.insert(format!("{qualifier}.{}", fixity.operator), fixity.clone()); destination.insert(format!("{qualifier}.({})", fixity.operator), fixity.clone()); } } diff --git a/crates/psrs-syntax/src/parser/expr/pattern.rs b/crates/psrs-syntax/src/parser/expr/pattern.rs index 2cf9017a..7f29f80b 100644 --- a/crates/psrs-syntax/src/parser/expr/pattern.rs +++ b/crates/psrs-syntax/src/parser/expr/pattern.rs @@ -10,6 +10,14 @@ impl<'a> Parser<'a> { let mut operands = vec![first]; let mut operators = Vec::new(); loop { + if let Some((operator, _, tokens)) = self.qualified_operator() { + for _ in 0..tokens { + self.bump(); + } + operators.push(operator); + operands.push(self.parse_pattern_prefix()?); + continue; + } let operator = match &self.current().kind { LayoutTokenKind::Raw(RawTokenKind::Operator(operator)) if operator != "@" => { operator.clone() @@ -96,23 +104,24 @@ impl<'a> Parser<'a> { } pub(crate) fn starts_pattern_atom(&self) -> bool { - matches!( - &self.current().kind, - LayoutTokenKind::Raw( - RawTokenKind::LowerIdent(_) - | RawTokenKind::UpperIdent(_) - | RawTokenKind::Integer(_) - | RawTokenKind::Number(_) - | RawTokenKind::String(_) - | RawTokenKind::Char(_) - | RawTokenKind::LParen - | RawTokenKind::LBracket - | RawTokenKind::LBrace - | RawTokenKind::As - | RawTokenKind::Hiding - | RawTokenKind::Role + self.qualified_operator().is_none() + && matches!( + &self.current().kind, + LayoutTokenKind::Raw( + RawTokenKind::LowerIdent(_) + | RawTokenKind::UpperIdent(_) + | RawTokenKind::Integer(_) + | RawTokenKind::Number(_) + | RawTokenKind::String(_) + | RawTokenKind::Char(_) + | RawTokenKind::LParen + | RawTokenKind::LBracket + | RawTokenKind::LBrace + | RawTokenKind::As + | RawTokenKind::Hiding + | RawTokenKind::Role + ) ) - ) } pub(crate) fn parse_pattern_atom(&mut self) -> Result { diff --git a/crates/psrs-syntax/src/parser/tests.rs b/crates/psrs-syntax/src/parser/tests.rs index 5b5a9316..f5ee949a 100644 --- a/crates/psrs-syntax/src/parser/tests.rs +++ b/crates/psrs-syntax/src/parser/tests.rs @@ -3,6 +3,8 @@ use crate::{add_layout, lex}; use psrs_cst::{Declaration, ExprKind, PatternKind, TypeExprKind, ValueRhs}; use psrs_span::SourceFile; +mod qualified_patterns; + #[test] fn parses_qualified_symbolic_operators_with_symbolic_dots_and_sections() { let module = parse("module Main where\na = 2 A... 5\nb = 4 Foo.Bar.-#- 10\nc = (_ A.!! 1)\nd = (2 A.: _)\ne = A.(..) 2 5\nf = A.(:) 2 []\n").unwrap(); diff --git a/crates/psrs-syntax/src/parser/tests/qualified_patterns.rs b/crates/psrs-syntax/src/parser/tests/qualified_patterns.rs new file mode 100644 index 00000000..b3be9583 --- /dev/null +++ b/crates/psrs-syntax/src/parser/tests/qualified_patterns.rs @@ -0,0 +1,41 @@ +use super::*; + +#[test] +fn qualified_pattern_operators_preserve_names_spans_and_constructor_operands() { + for (pattern, expected, constructor) in [ + ("head L.: tail", "L.:", false), + ("Wrap head Foo.Bar.: tail", "Foo.Bar.:", true), + ("L.Wrap head Foo.Bar... tail", "Foo.Bar...", true), + ] { + let source = format!("module Main where\nmain = case value of\n {pattern} -> 42\n"); + let module = parse(&source).unwrap(); + let ExprKind::Case { alternatives, .. } = + &plain_value(as_value(&module.declarations[0])).kind + else { + panic!("expected a case"); + }; + let PatternKind::OperatorChain { + operands, + operators, + } = &alternatives[0].patterns[0].kind + else { + panic!("expected an operator chain"); + }; + assert_eq!(operands.len(), 2); + assert_eq!(operators.len(), 1); + assert_eq!(operators[0].text, expected); + let span = operators[0].span; + assert_eq!(&source[span.start as usize..span.end as usize], expected); + if constructor { + let PatternKind::Constructor { arguments, .. } = &operands[0].kind else { + panic!("expected the left constructor operand"); + }; + assert_eq!(arguments.len(), 1); + } + } +} + +#[test] +fn qualified_pattern_operator_before_unicode_guards_parses() { + parse("module Main where\nmain = case value of\n t L.: ts\n | t == tag → true\n | otherwise → go ts\n L.Nil → false\n").unwrap(); +} diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 294f19b2..6616f175 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -16,6 +16,26 @@ work. The `AC-*` obligations are **required**, not conditional: DEC-19 selected the generic control mechanism, implemented as compiler-generated resumable frames rather than target stack switching. +## Execution order + +Complete production migration through source, checked Core, CC/MIR lowering and +the independent standard-library callers before expanding the full structural +verifier. Each migration slice includes the focused source-to-Wasm behavior +evidence needed to review it. Once the execution model and caller contract are +stable, complete structural, malformed-IR and requirement-by-requirement +verification. All acceptance obligations below remain required. + +The compiler and locked `PSRS.Control` wrappers already use contract v2. The +current independent package does not provide `Run` or `Data.VariantF`; its public +control fixtures and opaque official type comparison do not establish the pinned +upstream integration. Prioritize the remaining production/library integration +and runtime boundaries, then close verification gaps. Native Effect/ST follows +complete delimited-control acceptance. + +The [reference-library migration baseline](control-reference-library-migration-2026-10-12.md) +records the selected upstream revisions, the first unchanged-source compile +blocker and the compiler repairs needed to advance that boundary. + | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | | AE-01 | Existing PureScript syntax and type system express computation rows and handlers | Pinned upstream source; official `purs` accept/reject comparison on positive and negative library cases | Unverified | diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md new file mode 100644 index 00000000..129ecf53 --- /dev/null +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -0,0 +1,97 @@ +# Control Reference-Library Migration Baseline + +**Date:** 2026-10-12. + +**Starting compiler:** `7a6dae8985d39124a019bce7bd3b8b6a421c8166`, with an +execution-order documentation edit. + +**Scope:** Prerequisites for the reference-library acceptance required by +[library-owned effects](../../design/backend/fp/algebraic-effects-and-handlers.md). +This is compile evidence, not complete library or delimited-control acceptance. + +## Selected reference sources + +| Package | Tag | Commit | Source modules | +| --- | --- | --- | --- | +| `natefaubion/purescript-run` | `v5.0.0` | `abec7c343e92154d44b9dafd52b91ee82d32a870` | 7 | +| `purescript/purescript-free` | `v7.0.0` | `e2d8fa8023a864363857834e11393483bced5e38` | 7 | +| `natefaubion/purescript-variant` | `v8.0.0` | `8b2bd73a4202257d80a955c4dd36f6055f149823` | 3 | + +Clean tagged checkouts and per-module SHA-256 inventories are retained under +`/private/tmp/psrs-control-reference/`, in `reference-inventory.json`. These are +selected reference pins; the independent package has not imported these packages +or changed its lock. Complete transitive dependency pinning remains required. + +Upstream `Run` wraps `Free (VariantF r)` and imports Aff. Preserve its source +contract for reference acceptance. The ordinary row-based library over +`Prim.Control` is a separate implementation task; replacing upstream `Free` +with `Control` would not prove unchanged-source acceptance. Native Effect/Aff +execution remains outside this pure migration slice. + +## First compile boundary and repair + +The three unchanged Variant source modules are supplied explicitly to diagnosis +with the development package at `psrs-stdlib` revision +`5d523805c4e2096e68fab5a4f965f62b225ee2af`, source fingerprint +`fnv1a64-v1:a1e5a2f8f4157041`. The first rejection was P1 +`ErrorParsingModule` at `Data.Variant.Internal` line 155: `t L.: ts`. + +Pattern parsing now uses the same contiguous qualified-symbolic-name recognizer +as expression parsing. Constructor application stops before a qualified operator, +so a left operand such as `L.Wrap x` cannot consume the following qualifier. +The CST retains the operator name, full span and unreassociated operands. + +Execution exposed a related resolver defect: imported fixities were registered +only as `Qualifier.(operator)`, while infix expressions and patterns use +`Qualifier.operator`. Both spellings now use the imported fixity in the common +value/type fixity tables. Symbol resolution and reassociation remain their +existing owners. + +Two syntax tests cover names, spans, constructor operands, symbolic dots, +multi-component qualifiers and Unicode guarded alternatives. A driver test uses +`Foo.Bar.Wrap` operands and a right-associated `Foo.Bar.:` chain in both +construction and matching; mandatory Wasmtime execution returns 42. Official +`purs 0.15.16` accepts the same two-module case with a type-only foreign declaration +for `intAdd` (`qualified-pattern/official.json`, no errors). + +## Diagnosis and next production blocker + +`variant-before.json` and `variant-after.json` have identical ordered source +fingerprints. Their comparison advances from P1 to P3. The initial entry fixture +incorrectly imported `Data.Functor.Identity`; this remaining fixture error is not +a library/compiler defect. `VariantMain.purs` corrects it to `Data.Identity`. + +The corrected entry, with the same three unchanged Variant modules, reaches P5 +and reports one `NoInstanceFound` in `Data.Functor.Variant` line 90, at the +`foldableCons` instance context: `FoldableVFRL _T192 _T2090`. +`variant-entry.json` retains the ordered sources and observed pass prefix. +It produces no accepted Core/CC/MIR or executable artifact. The next migration +step is to reduce and repair this class/row constraint boundary, then rerun the +unchanged package sources. Do not remove the instance or weaken its constraints. + +Official `purs` parsing of all three upstream Variant modules reports only +`ModuleNotFound` for the deliberately incomplete input closure, with no +`ErrorParsingModule`. This proves parsing only; official whole-library type and +runtime comparisons remain unverified. + +## Validation + +- `cargo fmt --all --check` and `git diff --check`: passed. +- `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast`: nonzero, + with the same 175 failed test names and nine failing targets as the + `7a6dae89` root-validation baseline; no added or recovered failed names. + Driver unit tests report 643 passed / 162 failed. Backend tests report + 435 passed, syntax tests 37 passed, and all 81 control integration tests pass. + Failure-name equality does not establish identical failure causes. +- `PURESCRIPT_REPO=/Users/biu/Projects/purescript PSRS_ORACLE=annotations + PSRS_SUITE_FILTER=Operator cargo test -p psrs-driver --test suite + l1_parse_scoreboard_against_purs -- --ignored --nocapture`: passed, + 28/28 agreement (16 passing, 10 failing, 2 layout), one FFI exclusion. + This is a filtered parser result, not a new full gate measurement. + +Logs are retained in `workspace.log`, `workspace-comparison.json`, `clippy.log` +and `operator-scoreboard.log` under `/private/tmp/psrs-control-reference/`. +Full ignored scoreboards, complete official reference-library type/runtime +comparison, package audit and public package conformance were not run. No D-04 +gate number or full AE/AC requirement status changes. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 166c6a26..1b5a169f 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -10,6 +10,15 @@ sequencing, clause scope, library deep/shallow policies, and ownership/lifetime ## Latest state +The continuation from `7a6dae89` prioritizes production and library migration +before expanding the complete structural verifier. The +[reference-library baseline](control-reference-library-migration-2026-10-12.md) +selects exact Run/Free/Variant release commits and repairs qualified constructor +operator parsing and imported fixity lookup. Unchanged Variant source now reaches +P5; its `foldableCons` constraint remains the next production blocker. Reference +packages are not yet imported into the locked independent package, and full +delimited-control acceptance remains outstanding. + This topic commit implements DEC-20 control contract v2. The compiler lock pins stdlib `5d523805c4e2096e68fab5a4f965f62b225ee2af` with content identity `fnv1a64-v1:a1e5a2f8f4157041`. All 81 control integration tests pass under default locked package From c35d4efca60d974e6822962030d3929b79cee197 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 16:44:01 +0800 Subject: [PATCH 121/148] fix(typecheck): improve recursive instance context constraints --- .../src/tests/wasi/classes/fundeps.rs | 2 + .../wasi/classes/fundeps/nested_context.rs | 56 +++++++++++++++ .../src/typecheck/classes/solve/search.rs | 6 ++ .../type-system/classes-and-evidence.md | 6 ++ ...-reference-library-migration-2026-10-12.md | 71 +++++++++++++++++-- ...ted-control-lowering-handoff-2026-10-11.md | 10 +++ 6 files changed, 147 insertions(+), 4 deletions(-) create mode 100644 crates/psrs-driver/src/tests/wasi/classes/fundeps/nested_context.rs diff --git a/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs b/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs index 57c552c0..800945da 100644 --- a/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs +++ b/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs @@ -6,6 +6,8 @@ use super::super::super::*; +mod nested_context; + const FUNCTIONAL_DEPENDENCY_SOURCE: &str = r#" module Main where diff --git a/crates/psrs-driver/src/tests/wasi/classes/fundeps/nested_context.rs b/crates/psrs-driver/src/tests/wasi/classes/fundeps/nested_context.rs new file mode 100644 index 00000000..41f11742 --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/fundeps/nested_context.rs @@ -0,0 +1,56 @@ +use super::*; + +const ROW_CONTEXT: &str = r"module Main where +import Prim.Row as R +import Prim.RowList as RL +class FoldableVFRL :: RL.RowList (Type -> Type) -> Row (Type -> Type) -> Constraint +class FoldableVFRL rl row | rl -> row +instance foldableCons :: + ( FoldableVFRL rl r, R.Cons k f r r' ) => FoldableVFRL (RL.Cons k f rl) r' +class TraversableVFRL :: RL.RowList (Type -> Type) -> Row (Type -> Type) -> Constraint +class FoldableVFRL rl row <= TraversableVFRL rl row | rl -> row +instance traversableCons :: + ( TraversableVFRL rl r, R.Cons k f r r', R.Union r rx r' ) => TraversableVFRL (RL.Cons k f rl) r' +main :: Int +main = 42 +"; + +#[test] +fn nested_instance_context_improves_from_a_given_superclass_row_dependency() { + check_source("Main.purs", ROW_CONTEXT).expect("the superclass determines the residual row"); +} + +#[test] +fn nested_instance_context_without_a_residual_row_dictionary_is_rejected() { + let source = ROW_CONTEXT.replace("TraversableVFRL rl r, R.Cons", "R.Cons"); + let errors = check_source("Main.purs", &source).expect_err("no residual dictionary exists"); + assert!( + errors + .iter() + .any(|error| error.code == Some("NoInstanceFound")), + "{errors:?}" + ); +} + +#[test] +fn nested_instance_context_improvement_executes_user_class_dictionaries() { + let source = r"module Main where +data Wrapper a = Wrapper a +class Describe a b | a -> b where + describe :: a -> b +class Value a where + value :: a -> Int +instance describeInt :: Describe Int Int where + describe x = x +instance valueInt :: Value Int where + value x = x +instance valueWrapper :: (Describe a b, Value b) => Value (Wrapper a) where + value (Wrapper x) = value (describe x) +useGiven :: forall a b. Describe a b => Value b => Wrapper a -> Int +useGiven wrapped = value wrapped +main :: Int +main = useGiven (Wrapper 42) +"; + let output = run_with_wasmtime(source).expect("required Wasmtime runtime"); + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs index 09c7a3fc..fff0dadc 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/solve/search.rs @@ -40,6 +40,12 @@ impl Checker { if !depth.within_bound() { return None; } + // Instance contexts are created after the outer wanted-list fixed point. + // Improve every recursive obligation before exact given lookup or head + // selection, using the same dependencies as the outer worklist. + let mut improved = constraint.clone(); + self.improve_one(&mut improved); + let constraint = &improved; let class_id = constraint.class_id; let arguments = constraint.arguments.clone(); let rule = self.registered_primitive_rule(class_id); diff --git a/docs/design/frontend/type-system/classes-and-evidence.md b/docs/design/frontend/type-system/classes-and-evidence.md index 191547b0..525e74e4 100644 --- a/docs/design/frontend/type-system/classes-and-evidence.md +++ b/docs/design/frontend/type-system/classes-and-evidence.md @@ -164,6 +164,12 @@ solve(wanted, givens, instances): return Instance(candidate, context_evidence) ``` +Every recursive instance-context obligation enters the same functional-dependency +improvement step before given lookup and head selection. The outer wanted-list +fixed point cannot cover context obligations created later by instance selection. +Improvement uses the obligation's captured givens, including superclass closure; +exact given lookup does not independently unify unknown arguments. + Head comparison distinguishes `Match`, `Apart`, and `Unknown`. Repeated head variables compare all wanted types they capture after dependency coverage is known. A structural occurs conflict such as `a` against `Array a` is Apart; diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index 129ecf53..94db1686 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -22,6 +22,20 @@ Clean tagged checkouts and per-module SHA-256 inventories are retained under selected reference pins; the independent package has not imported these packages or changed its lock. Complete transitive dependency pinning remains required. +## Latest migration state + +The continuation from `3d320e29` repairs functional-dependency improvement for +recursively generated instance contexts. The same corrected Variant entry and +three unchanged upstream modules now pass P5 and produce Core. Diagnosis next +rejects at P8 WIT linking: `` `psrs:effect` is not `package/interface` ``. No CC/MIR +or executable is produced for the reference entry. The diagnostic's span matches +the legacy `effectPure` foreign declaration in the locked Prelude. Core's +`prune_unreachable` deliberately retains source-wide WIT/primitive conformance +obligations, and P8 validates dormant declarations too. This is not evidence for +weakening reachability or binding validation. The next migration slice must +address the remaining legacy standard-library declarations under that contract; +no native Effect ABI or VariantF representation failure is established here. + Upstream `Run` wraps `Free (VariantF r)` and imports Aff. Preserve its source contract for reference acceptance. The ordinary row-based library over `Prim.Control` is a separate implementation task; replacing upstream `Free` @@ -65,16 +79,16 @@ The corrected entry, with the same three unchanged Variant modules, reaches P5 and reports one `NoInstanceFound` in `Data.Functor.Variant` line 90, at the `foldableCons` instance context: `FoldableVFRL _T192 _T2090`. `variant-entry.json` retains the ordered sources and observed pass prefix. -It produces no accepted Core/CC/MIR or executable artifact. The next migration -step is to reduce and repair this class/row constraint boundary, then rerun the -unchanged package sources. Do not remove the instance or weaken its constraints. +At the initial checkpoint it produced no accepted Core/CC/MIR or executable +artifact. The continuation below repairs the class/row constraint boundary and +reruns the unchanged package sources, preserving the instance and its constraints. Official `purs` parsing of all three upstream Variant modules reports only `ModuleNotFound` for the deliberately incomplete input closure, with no `ErrorParsingModule`. This proves parsing only; official whole-library type and runtime comparisons remain unverified. -## Validation +## Initial validation - `cargo fmt --all --check` and `git diff --check`: passed. - `cargo clippy --workspace --all-targets -- -D warnings`: passed. @@ -95,3 +109,52 @@ and `operator-scoreboard.log` under `/private/tmp/psrs-control-reference/`. Full ignored scoreboards, complete official reference-library type/runtime comparison, package audit and public package conformance were not run. No D-04 gate number or full AE/AC requirement status changes. + +## Recursive instance-context improvement (2026-10-12) + +The outer wanted-list fixed point improves constraints already in the worklist. +Selecting an instance subsequently creates fresh context obligations. Those +ordinary class obligations previously entered exact given lookup without the +same improvement. While constructing the `TraversableVFRL` cons superclass, +the selected `FoldableVFRL` cons instance introduces a fresh residual row. Its +recursive context can determine that row from the given `TraversableVFRL`'s +superclass and `rl -> row` dependency, but that improvement was missing. The +diagnostic cites the selected instance's context declaration at line 90; it is +not a failure in that instance's method body. + +The shared `solve_constraint_with_chain` entry now runs the existing +`improve_one` operation before primitive dispatch, given lookup and instance +selection. Recursive contexts and requeued obligations use the same rule; +rigidity, branch commitment and exact given matching remain enforced by their +existing owners. No operation/library identity participates in the fix. + +Three driver tests cover a reduced RowList/row superclass declaration, its +missing-residual-dictionary rejection, and a user-class `Describe`/`Value` +dictionary path that executes to 42. Official `purs 0.15.16` accepts both +positive programs and rejects the negative with `NoInstanceFound`; executing +the official user's class program with Node also returns 42. + +The identical corrected Variant input closure advances from P5 rejection to P8 +WIT rejection. `variant-nested-row-comparison.json` and +`variant-nested-row-after.json` retain the same ordered input fingerprints and +the produced Core. `nested-row-before.json`, `nested-row-after.json` and their +comparison record recovery of the reduced superclass declaration. All reports +remain under `/private/tmp/psrs-control-reference/`. + +Validation: + +- `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib nested_instance_context + -- --nocapture`: three passed, including actual Wasmtime execution. +- `cargo fmt --all --check`, `git diff --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. +- `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast`: nonzero, with + the same 175 failed names / nine failing targets as `3d320e29`; no added or + recovered failed names. Driver unit tests report 646 passed / 162 failed; + typechecker unit tests 135 passed; all 81 control integration tests pass. + Logs: `nested-row-workspace.log`, `nested-row-workspace-comparison.json` and + `nested-row-clippy.log`. Failure-name equality does not prove equal causes. + +Full ignored scoreboards, official reference-library execution, source audit +and public package conformance were not rerun. Neither package lock nor D-04 +gate measurements change; full reference-library and delimited-control +acceptance remain outstanding. diff --git a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md index 1b5a169f..aa7c72ef 100644 --- a/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md +++ b/docs/implementation/backend/delimited-control-lowering-handoff-2026-10-11.md @@ -19,6 +19,16 @@ P5; its `foldableCons` constraint remains the next production blocker. Reference packages are not yet imported into the locked independent package, and full delimited-control acceptance remains outstanding. +The continuation from `3d320e29` applies the existing functional-dependency +improvement at the shared recursive constraint-search entry. The unchanged +Variant closure now passes P5 and produces Core; the next rejection is P8 WIT +conformance for the legacy `effectPure` declaration in the locked Prelude. +Source-wide foreign conformance intentionally includes dormant declarations. +The reference baseline records the reduced positive/negative official type +comparison and a user-class dictionary program returning 42 in both official +JS and Wasmtime. Native Effect ABI selection and complete library acceptance +remain outstanding. + This topic commit implements DEC-20 control contract v2. The compiler lock pins stdlib `5d523805c4e2096e68fab5a4f965f62b225ee2af` with content identity `fnv1a64-v1:a1e5a2f8f4157041`. All 81 control integration tests pass under default locked package From d66bb2945c22294c49e5fac2428edb89b550336d Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 17:21:10 +0800 Subject: [PATCH 122/148] Migrate Effect fixtures to the official module and pin the restored stdlib Prelude no longer supplies the target-only Effect/runEffect/trap API, so the driver fixtures that used runEffect are migrated to `import Effect (Effect)` with the computation as `main`. These fixtures only resolve, typecheck or lower, so they need no native Effect runner. Two standard-library-shadowing fixtures are migrated for the same reason. A focused Wasmtime case executes a real `Partial.Unsafe.unsafeCrashWith` caller and asserts the guest trap, covering the restored `Partial._crashWith` contract through its library path. stdlib.lock.json moves to the restored package revision 407de2618ef2f5b43befc572bdc787d94287f1eb with source fingerprint fnv1a64-v1:f29cc57fc1e691f4, so default locked consumption loads again. Driver unit tests: 740 passed / 68 failed, against 731 / 77 for the restoration candidate; none of the eight added failure names remain. Runtime Effect/WASI fixtures remain blocked on native Effect execution, and Variant's next blocker is P8 closure conversion for aggregate and parameterized types. --- crates/psrs-driver/src/tests/assertions.rs | 19 +++++- crates/psrs-driver/src/tests/module_loader.rs | 6 +- crates/psrs-driver/src/tests/resolution.rs | 4 +- .../psrs-driver/src/tests/runtime_storage.rs | 17 ++++++ crates/psrs-driver/src/tests/typecheck/mod.rs | 20 ++++-- ...-reference-library-migration-2026-10-12.md | 61 +++++++++++++++++++ stdlib.lock.json | 4 +- 7 files changed, 118 insertions(+), 13 deletions(-) diff --git a/crates/psrs-driver/src/tests/assertions.rs b/crates/psrs-driver/src/tests/assertions.rs index 78ba5c25..3c2a9d63 100644 --- a/crates/psrs-driver/src/tests/assertions.rs +++ b/crates/psrs-driver/src/tests/assertions.rs @@ -25,6 +25,9 @@ fn assert_trapped_after_message(output: &std::process::Output, message: &str) { } /// The one `Unit` value, in both spellings the surface language has for it. +/// +/// The runtime case needs a runner, so it keeps the target `Effect` sequence; +/// the Core-shape case below is deliberately pure and never needs one. const UNIT_SOURCE: &str = r#" module Main where @@ -46,13 +49,27 @@ main = let ignored = message in let ignoredToo = alsoUnit in 0 "#; +/// A pure use of the one `Unit` value in both spellings. It exercises only +/// type checking and Core lowering, so it does not depend on a runner. +const UNIT_CORE_SOURCE: &str = r#" +module Main where + +import Prelude + +takesUnit :: Unit -> Int +takesUnit _ = 7 + +main :: Int +main = takesUnit unit + takesUnit () +"#; + #[test] fn the_unit_value_is_a_core_expression_rather_than_an_integer_literal() { // `Unit` has no payload and no constructor table here, so the value is a // compiler primitive. Core must name it as itself: lowering it to the // integer `0` would make a unit indistinguishable from an `Int` at every // later stage. - let core = lower_source_to_core("Main.purs", UNIT_SOURCE) + let core = lower_source_to_core("Main.purs", UNIT_CORE_SOURCE) .expect("typechecking and lowering `unit` into Core"); let dump = format!("{core:#?}"); assert!( diff --git a/crates/psrs-driver/src/tests/module_loader.rs b/crates/psrs-driver/src/tests/module_loader.rs index 75b2da80..1e22f832 100644 --- a/crates/psrs-driver/src/tests/module_loader.rs +++ b/crates/psrs-driver/src/tests/module_loader.rs @@ -119,14 +119,14 @@ fn loads_the_standard_library_from_disk_in_trusted_order() { } check_source( "Main.purs", - "module Main where\nimport Prelude\nimport WASI.Console\nimport WASI.Clock\nmain = let stamp = runEffect now in let action = runEffect (log \"ok\") in stamp\n", + "module Main where\nimport Prelude\nimport Effect (Effect)\nimport WASI.Console\nimport WASI.Clock\nmain :: Effect Int\nmain = do\n _ <- now\n log \"ok\"\n pure 0\n", ) .expect("the on-disk standard library should typecheck with a user module"); } #[test] fn resolves_the_standard_library_closure_imported_by_a_wasi_program() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nimport WASI.Clock\nmain = let stamp = runEffect now in let action = runEffect (log \"ok\") in stamp\n"; + let source = "module Main where\nimport Prelude\nimport Effect (Effect)\nimport WASI.Console\nimport WASI.Clock\nmain :: Effect Int\nmain = do\n _ <- now\n log \"ok\"\n pure 0\n"; let (sources, trusted_prefix) = crate::prelude::prepend(&[("Main.purs", source)]) .expect("the standard library should load from disk"); assert!(trusted_prefix > 0); @@ -164,7 +164,7 @@ fn does_not_discover_a_user_module_shadowing_the_standard_library() { .unwrap(); std::fs::write( &main, - "module Main where\nimport Prelude\nmain = runEffect (pure 1)\n", + "module Main where\nimport Prelude\nmain :: Int\nmain = 1\n", ) .unwrap(); diff --git a/crates/psrs-driver/src/tests/resolution.rs b/crates/psrs-driver/src/tests/resolution.rs index 2ac7b21d..8b86330e 100644 --- a/crates/psrs-driver/src/tests/resolution.rs +++ b/crates/psrs-driver/src/tests/resolution.rs @@ -175,7 +175,7 @@ markerInt = 1\n"; #[test] fn resolves_a_program_against_the_on_disk_standard_library() { - let source = "module Main where\nimport Prelude\nmain = runEffect (pure 1)\n"; + let source = "module Main where\nimport Prelude\nimport Effect (Effect)\nmain :: Effect Int\nmain = pure 1\n"; let errors = check_program_lenient(&[("Main.purs", source)]).unwrap_err(); assert!( errors @@ -190,7 +190,7 @@ fn resolves_a_program_against_the_on_disk_standard_library() { #[test] fn attributes_a_library_backed_diagnostic_to_the_user_source() { - let source = "module Main where\nimport Prelude\nmain = runEffect (pure missingName)\n"; + let source = "module Main where\nimport Prelude\nimport Effect (Effect)\nmain :: Effect Int\nmain = pure missingName\n"; let errors = check_program_lenient_with_prelude(&[("Main.purs", source)]).unwrap_err(); assert!( errors.iter().any(|error| { diff --git a/crates/psrs-driver/src/tests/runtime_storage.rs b/crates/psrs-driver/src/tests/runtime_storage.rs index efc586d4..08c03b69 100644 --- a/crates/psrs-driver/src/tests/runtime_storage.rs +++ b/crates/psrs-driver/src/tests/runtime_storage.rs @@ -108,6 +108,23 @@ fn runtime_storage_trap_has_no_normal_return() { } } +#[test] +fn partial_crash_with_reaches_the_storage_trap() { + // `Partial._crashWith` is an official JavaScript `foreign import` that + // throws. The target implements it with the checked non-returning storage + // trap, so a real library caller must never return a value for the absent + // result type. + let source = "module Main where\nimport Prelude\nimport Partial.Unsafe (unsafeCrashWith)\nmain :: Int\nmain = unsafeCrashWith \"boom\"\n"; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert!(!output.status.success(), "{output:?}"); + assert!( + String::from_utf8_lossy(&output.stderr).contains("unreachable"), + "{output:?}" + ); +} + #[test] fn runtime_storage_monomorphic_operands_use_the_same_array() { let source = r#"module Main where diff --git a/crates/psrs-driver/src/tests/typecheck/mod.rs b/crates/psrs-driver/src/tests/typecheck/mod.rs index 0adcc725..c13b1f92 100644 --- a/crates/psrs-driver/src/tests/typecheck/mod.rs +++ b/crates/psrs-driver/src/tests/typecheck/mod.rs @@ -110,6 +110,7 @@ fn typechecks_do_notation_over_effect() { let source = "\ module Main where import Prelude +import Effect (Effect) import WASI.Console action :: Effect Int action = do @@ -117,7 +118,8 @@ action = do let doubled = handle + handle _ <- log \"value\" pure doubled -main = runEffect action +main :: Effect Int +main = action "; assert!(check_source("Main.purs", source).is_ok()); } @@ -129,12 +131,14 @@ fn typechecks_a_non_variable_do_binder() { let source = "\ module Main where import Prelude +import Effect (Effect) data Pair = Pair Int Int action :: Effect Int action = do Pair x y <- pure (Pair 1 2) pure (x + y) -main = runEffect action +main :: Effect Int +main = action "; assert!(check_source("Main.purs", source).is_ok()); } @@ -144,12 +148,14 @@ fn rejects_a_do_binder_with_the_wrong_case_type() { let source = "\ module Main where import Prelude +import Effect (Effect) data Pair = Pair Int Int action :: Effect Int action = do Pair x y <- pure 1 pure (x + y) -main = runEffect action +main :: Effect Int +main = action "; assert!(check_source("Main.purs", source).is_err()); } @@ -161,12 +167,14 @@ fn typechecks_ado_notation_over_effect() { let source = "\ module Main where import Prelude +import Effect (Effect) action :: Effect Int action = ado x <- pure 20 y <- pure 22 in x + y -main = runEffect action +main :: Effect Int +main = action "; assert!(check_source("Main.purs", source).is_ok()); } @@ -176,12 +184,14 @@ fn typechecks_an_ado_value_and_let() { let source = "\ module Main where import Prelude +import Effect (Effect) action :: Effect Int action = ado _ <- pure 1 let base = 40 in base + 2 -main = runEffect action +main :: Effect Int +main = action "; assert!(check_source("Main.purs", source).is_ok()); } diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index 94db1686..50baaa13 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -158,3 +158,64 @@ Full ignored scoreboards, official reference-library execution, source audit and public package conformance were not rerun. Neither package lock nor D-04 gate measurements change; full reference-library and delimited-control acceptance remain outstanding. + +## Official-source restoration and Partial crash contract (2026-10-12) + +The development package carried a target-only `Effect`, `runEffect`, `trap`, +their `psrs:effect` foreign declarations and instances in `Prelude`. Official +`purescript-prelude` owns none of them, and the compiler no longer implements +the withdrawn `psrs:effect` protocol, so those declarations were both a source +fidelity violation and dead. The package restores the official source contract +first and lets the native Effect/ST design replace the withdrawn compiler +protocol afterwards. + +- `lib/Prelude.purs`, `lib/Effect.purs` and `lib/Test/Assert.purs` are + byte-identical to their pinned upstream sources again. `Effect` returns to its + owning module; `Partial` now takes the checked non-returning storage trap for + `_crashWith` and keeps its public signature and exports. +- `lib/WASI/*.purs` import `Effect (Effect)` because `Prelude` no longer supplies + that type. +- The package commit is `407de2618ef2f5b43befc572bdc787d94287f1eb`, source + fingerprint `fnv1a64-v1:f29cc57fc1e691f4`. `stdlib.lock.json` is updated to + that revision and fingerprint; default locked consumption loads and passes. + +`Partial._crashWith` reaches `Partial.Unsafe.unsafeCrashWith` through the +existing checked `psrs:runtime-storage#trap` operation. A focused program that +reaches `unsafeCrashWith` compiles, links and guest-traps (`wasm unreachable`); +the message has no Wasm trap payload and is not observable, which is the stated +representation boundary rather than a fabricated result. + +With `_crashWith` resolved, the unchanged Variant entry advances past P8 library +linking. Its next first blocker is P8 closure conversion: +`aggregate and parameterized types are not supported by the first backend slice` +(`variant-crashfix.json`). That is real remaining backend work, not an Effect +or WIT failure, and no executable is produced for the reference entry yet. + +Eight driver unit tests had been failing only because their fixtures used the +removed `Prelude.runEffect`/`Effect` API. They only resolve, typecheck or lower, +so they are migrated to `import Effect (Effect)` with the computation as +`main`. Two further fixtures that shadow the standard library were migrated for +the same reason. + +Validation: + +- Driver unit-test target: 740 passed / 68 failed, against 731 / 77 for the + restoration candidate before the fixture migration. None of the eight added + failure names remain; the remaining failures are runtime Effect/WASI cases + blocked on native Effect execution or on the P8 closure-conversion slice. + Log: `driver-after-fixture-migration.log`. +- Whole workspace with mandatory Wasmtime, default locked package: + `error: 4 targets failed` (CLI `link`, CLI `source_layout`, driver `--lib`, + driver `residual_constraints`) with 71 failed names, down from 80 for the + restoration candidate and with no added names. Log: + `workspace-after-lock-update.log`. +- `cargo fmt --all --check`: passed. `cargo clippy --workspace --all-targets -- + -D warnings`: passed. `npm test` in `psrs-stdlib`: 12 passed. +- Default locked consumption (no `PSRS_STDLIB_ROOT`): the migrated tests and a + trivial program pass and report the new fingerprint. + +Native `Effect.pureE`, `Effect.bindE`, the loop/traversal foreigns and +`Test.Assert.assertImpl` still have no target implementation and fail explicitly +at P8 library linking. Restoring the official declarations is not their runtime +implementation; native Effect/ST and full reference-library acceptance remain +outstanding. diff --git a/stdlib.lock.json b/stdlib.lock.json index a12bf2e2..2827d67c 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "5d523805c4e2096e68fab5a4f965f62b225ee2af", - "source_fingerprint": "fnv1a64-v1:a1e5a2f8f4157041" + "revision": "407de2618ef2f5b43befc572bdc787d94287f1eb", + "source_fingerprint": "fnv1a64-v1:f29cc57fc1e691f4" } From e5c54d3ae7c8233a1889cedf8d59ee96537a0883 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 18:14:36 +0800 Subject: [PATCH 123/148] fix(backend): lay out uninhabited data types as erased references An algebraic data declaration with no constructors is uninhabited: no expression can build one, so its only values come from unchecked coercions. It therefore crosses the erased boundary like a bare abstract type, whether used bare (Void) or applied (VariantF r a). The layout pass previously rejected any user type that was neither an enum, an aggregate, a newtype nor an opaque foreign type. That blocked the unchanged reference Variant sources, where Data.Functor.Variant declares VariantF and UnknownF with no constructors and coerces a record newtype to and from them. The rule excludes foreign data (a nullary foreign type is a resource handle) and does not swallow types whose layout is unknown for another reason: a type whose constructors were pruned by Core, or whose fields are not layoutable, still takes its own error path. Evidence: the unchanged reference entry and its three upstream Variant modules now pass diagnosis and execute under Wasmtime to 42; cc::layout::tests:: uninhabited and a driver coercion round-trip cover the rule; backend tests 438 passed, driver 742 passed / 68 failed with the same failure names, and the whole workspace stays at the same four failing targets and 71 failed names with no added names. --- crates/psrs-backend/src/cc/layout/mod.rs | 18 ++++ crates/psrs-backend/src/cc/layout/scalar.rs | 32 ++++++- .../psrs-backend/src/cc/layout/tests/mod.rs | 1 + .../src/cc/layout/tests/uninhabited.rs | 88 +++++++++++++++++++ crates/psrs-driver/src/tests/mod.rs | 1 + crates/psrs-driver/src/tests/uninhabited.rs | 33 +++++++ docs/design/backend/fp/data-representation.md | 1 + .../backend/fp/polymorphism-and-erasure.md | 8 ++ ...-reference-library-migration-2026-10-12.md | 44 ++++++++++ 9 files changed, 224 insertions(+), 2 deletions(-) create mode 100644 crates/psrs-backend/src/cc/layout/tests/uninhabited.rs create mode 100644 crates/psrs-driver/src/tests/uninhabited.rs diff --git a/crates/psrs-backend/src/cc/layout/mod.rs b/crates/psrs-backend/src/cc/layout/mod.rs index 582a799b..338dab89 100644 --- a/crates/psrs-backend/src/cc/layout/mod.rs +++ b/crates/psrs-backend/src/cc/layout/mod.rs @@ -153,6 +153,11 @@ fn layoutable_field_type_inner( let Some(type_id) = user_type_id(module, id) else { return false; }; + // An uninhabited applied data type is an erased reference, which a + // variant case may carry like any other referenced payload. + if is_uninhabited_data_type(module, type_id) { + return true; + } if !newtype_ids.contains(&type_id) { return false; } @@ -383,6 +388,19 @@ pub(super) fn user_type_id(module: &CoreModule, mut id: TypeId) -> Option bool { + !module.opaque_ids.contains(&type_id) + && !module + .constructors + .iter() + .any(|constructor| constructor.type_id == type_id) +} + /// Whether a Core type is a callable closure value: an ordinary function arrow /// or a closure born with a fixed parameter list. pub(crate) fn is_callable_type(module: &CoreModule, id: TypeId) -> bool { diff --git a/crates/psrs-backend/src/cc/layout/scalar.rs b/crates/psrs-backend/src/cc/layout/scalar.rs index f0277a83..2ffe36dc 100644 --- a/crates/psrs-backend/src/cc/layout/scalar.rs +++ b/crates/psrs-backend/src/cc/layout/scalar.rs @@ -1,6 +1,6 @@ use super::{ - function_type_signature, is_callable_type, layout_error, newtype_field_type, - primitive_shape_of, unquantified_type, user_type_id, + function_type_signature, is_callable_type, is_uninhabited_data_type, layout_error, + newtype_field_type, primitive_shape_of, unquantified_type, user_type_id, }; use crate::BackendError; use crate::cc::{RefShape, Reference, ReprId, Signature, SignatureId, ValueShape}; @@ -86,6 +86,17 @@ pub(crate) fn declaration_shape( result: ValueShape::Integer, }) } + // A constructorless user data type is uninhabited: no expression builds + // one, so its values come only from unchecked coercions. It crosses the + // erased boundary like any other abstract type. + Some(Type::Constructor(TypeConstructor::User(id))) + if is_uninhabited_data_type(module, *id) => + { + Ok(Signature { + parameters, + result: erased_reference(), + }) + } Some(_) if module.is_record_type(ty) => { if module.record_is_open(ty).unwrap_or(false) { Err(vec![BackendError::new( @@ -134,6 +145,13 @@ pub(crate) fn declaration_shape( parameters, result: erased_reference(), }) + } else if is_uninhabited_data_type(module, type_id) { + // An applied constructorless algebraic type is uninhabited and + // only appears through unchecked coercions. + Ok(Signature { + parameters, + result: erased_reference(), + }) } else if enum_types.contains(&type_id) { Ok(Signature { parameters, @@ -253,6 +271,13 @@ pub(crate) fn scalar_type( Some(Type::Constructor(TypeConstructor::User(id))) if module.opaque_ids.contains(id) => { Ok(ValueShape::Integer) } + // A constructorless user data type is uninhabited, so it has no + // concrete value to lay out beyond the erased reference. + Some(Type::Constructor(TypeConstructor::User(id))) + if is_uninhabited_data_type(module, *id) => + { + Ok(erased_reference()) + } Some(Type::Application(_, _)) if array_types.contains_key(&id) => { Ok(ValueShape::Reference(Reference { nullable: false, @@ -290,6 +315,9 @@ pub(crate) fn scalar_type( if module.opaque_ids.contains(&type_id) { return Ok(erased_reference()); } + if is_uninhabited_data_type(module, type_id) { + return Ok(erased_reference()); + } if enum_types.contains(&type_id) { Ok(ValueShape::Integer) } else if aggregate_types.contains(&type_id) { diff --git a/crates/psrs-backend/src/cc/layout/tests/mod.rs b/crates/psrs-backend/src/cc/layout/tests/mod.rs index 54a11417..3c8d754b 100644 --- a/crates/psrs-backend/src/cc/layout/tests/mod.rs +++ b/crates/psrs-backend/src/cc/layout/tests/mod.rs @@ -9,6 +9,7 @@ use psrs_hir::{LocalId, ModuleId, SymbolId, TypeId as HirTypeId, TypeVariableId} mod opaque; mod records; +mod uninhabited; fn push_arrow(types: &mut Vec, parameter: TypeId, result: TypeId) -> TypeId { let head = TypeId(types.len() as u32); diff --git a/crates/psrs-backend/src/cc/layout/tests/uninhabited.rs b/crates/psrs-backend/src/cc/layout/tests/uninhabited.rs new file mode 100644 index 00000000..4e68ba7b --- /dev/null +++ b/crates/psrs-backend/src/cc/layout/tests/uninhabited.rs @@ -0,0 +1,88 @@ +//! A constructorless user `data` declaration is uninhabited. Its values come +//! only from unchecked coercions, so the backend lays it out as an erased +//! reference, like any other abstract type. Foreign data stays a resource +//! handle and is excluded. +use super::{declaration_shape, empty_module}; +use crate::cc::{RefShape, Reference, ValueShape}; +use psrs_core::{ConstructorInfo, Declaration, Expr, ExprKind, Type, TypeConstructor, TypeId}; +use psrs_hir::{ModuleId, SymbolId, TypeId as HirTypeId}; +use std::collections::{HashMap, HashSet}; + +fn declaration(module: &mut psrs_core::Module, ty: TypeId) -> Declaration { + let declaration = Declaration { + symbol: SymbolId::new(module.id, 0), + name: "value".to_owned(), + name_span: psrs_span::TextRange::new(0, 1), + quantified: Vec::new(), + ty, + value: Expr { + kind: ExprKind::Unit, + ty, + span: psrs_span::TextRange::new(0, 1), + }, + span: psrs_span::TextRange::new(0, 1), + }; + module.declarations.push(declaration.clone()); + declaration +} + +fn shape(module: &psrs_core::Module, declaration: &Declaration) -> ValueShape { + declaration_shape( + declaration, + module, + &HashSet::new(), + &HashSet::new(), + &HashSet::new(), + &HashMap::new(), + &HashMap::new(), + &HashMap::new(), + &HashMap::new(), + ) + .expect("an uninhabited type should have a layout") + .result +} + +fn erased() -> ValueShape { + ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Erased, + }) +} + +#[test] +fn a_bare_constructorless_data_type_uses_the_erased_reference() { + let empty = HirTypeId::new(ModuleId(1), 0); + let mut module = empty_module(vec![Type::Constructor(TypeConstructor::User(empty))]); + let declaration = declaration(&mut module, TypeId(0)); + assert_eq!(shape(&module, &declaration), erased()); +} + +#[test] +fn an_applied_constructorless_data_type_uses_the_erased_reference() { + let empty = HirTypeId::new(ModuleId(1), 0); + let mut module = empty_module(vec![ + Type::Constructor(TypeConstructor::User(empty)), + Type::Constructor(TypeConstructor::Int), + Type::Application(TypeId(0), TypeId(1)), + ]); + let declaration = declaration(&mut module, TypeId(2)); + assert_eq!(shape(&module, &declaration), erased()); +} + +#[test] +fn a_user_type_with_a_constructor_is_not_treated_as_uninhabited() { + // The same nominal type becomes an enum as soon as it has a nullary + // constructor, so the erased fallback must not swallow it. + let inhabited = HirTypeId::new(ModuleId(1), 0); + let mut module = empty_module(vec![Type::Constructor(TypeConstructor::User(inhabited))]); + module.constructors.push(ConstructorInfo { + symbol: SymbolId::new(module.id, 1), + name: "Only".to_owned(), + type_id: inhabited, + tag: 0, + field_count: 0, + field_types: Vec::new(), + parameters: Vec::new(), + }); + assert!(!super::is_uninhabited_data_type(&module, inhabited)); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 076082e3..0368c0bb 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -46,6 +46,7 @@ mod runtime_storage; mod scalars; mod semigroup; mod show; +mod uninhabited; fn lower_source_to_mir(source: &str) -> psrs_backend::mir::Module { let backend_input = crate::lower_main_to_cc(source).expect("Core should lower to CC"); diff --git a/crates/psrs-driver/src/tests/uninhabited.rs b/crates/psrs-driver/src/tests/uninhabited.rs new file mode 100644 index 00000000..a4ec74cd --- /dev/null +++ b/crates/psrs-driver/src/tests/uninhabited.rs @@ -0,0 +1,33 @@ +//! A constructorless algebraic data type is uninhabited: no expression builds +//! one, so its only values come from unchecked coercions, and the backend lays +//! it out as an erased reference. This exercises a type (like the reference +//! `VariantF`) that has no constructors of its own yet carries a coerced +//! concrete representation. + +#[test] +fn a_constructorless_data_type_round_trips_through_unsafe_coercion() { + let source = r#"module Main where + +import Prelude +import Unsafe.Coerce (unsafeCoerce) + +data Empty :: Type -> Type +data Empty a + +newtype Rep a = Rep { value :: a } + +toEmpty :: forall a. Rep a -> Empty a +toEmpty = unsafeCoerce + +fromEmpty :: forall a. Empty a -> Rep a +fromEmpty = unsafeCoerce + +main :: Int +main = case fromEmpty (toEmpty (Rep { value: 42 })) of + Rep r -> r.value +"#; + let Some(output) = super::run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/docs/design/backend/fp/data-representation.md b/docs/design/backend/fp/data-representation.md index 9973e2a0..a47d11f4 100644 --- a/docs/design/backend/fp/data-representation.md +++ b/docs/design/backend/fp/data-representation.md @@ -468,6 +468,7 @@ must run fixtures of the following class: | Nullary data types | tag construction and tag comparison | | Field data types | construction, tag test, and field projection ([CC IR](cc-ir.md)) | | Newtypes | erased single-field construction and match | +| Uninhabited data types | unchecked coercion round-trip through the erased reference | | Records | literal, field read, and update | | Arrays | literal, length, index, and update | | Closures | captured scalar/reference closures and higher-order calls | diff --git a/docs/design/backend/fp/polymorphism-and-erasure.md b/docs/design/backend/fp/polymorphism-and-erasure.md index 54e33483..10cfffee 100644 --- a/docs/design/backend/fp/polymorphism-and-erasure.md +++ b/docs/design/backend/fp/polymorphism-and-erasure.md @@ -268,6 +268,14 @@ in [representation and evidence](representation-and-evidence.md). There is exact one erased representation for abstract values, and it carries no source type identity. +An algebraic data declaration with no constructors is uninhabited: no +expression can build one, so its only values come from unchecked coercions. It +therefore uses the same erased ABI as a bare abstract type, whether it is used +bare (`Void`) or applied (`VariantF r a`). This is not the resource-handle case: +a nullary `foreign import data` type is opaque and stays a handle, and an +applied foreign type already uses the erased reference. Inhabited algebraic +types keep their enum, aggregate, or newtype layout. + This is viable because: - the erased core performs no runtime type analysis, so no tag is required; diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index 50baaa13..feb60dc7 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -219,3 +219,47 @@ Native `Effect.pureE`, `Effect.bindE`, the loop/traversal foreigns and at P8 library linking. Restoring the official declarations is not their runtime implementation; native Effect/ST and full reference-library acceptance remain outstanding. + +## Reference-Variant compilation (2026-10-12) + +With `_crashWith` resolved, the unchanged Variant entry advanced past P8 library +linking and stopped at `backend.cc.lower` with `aggregate and parameterized +types are not supported by the first backend slice`. Tracing the failure showed +it was not a general aggregate gap: `Data.Functor.Variant` declares +`data VariantF :: Row (Type -> Type) -> Type -> Type` / `data VariantF f a` and +`data UnknownF a`, all constructorless, and the layout pass rejected any user +type that was neither an enum, an aggregate, a newtype, nor an opaque foreign +type. + +A constructorless algebraic data declaration is uninhabited: no expression can +build one, so its only values come from unchecked coercions (the upstream +modules coerce `VariantFRep f a`, a newtype over a record, to and from +`VariantF f a`). Such a type now uses the erased reference, exactly like a bare +abstract type. The rule is deliberately narrower than "any type without a +resolved layout": a type whose constructors were pruned by Core, or whose fields +are not layoutable, still takes its own error path. `foreign import data` is +excluded — a nullary foreign type is a resource handle and an applied one +already uses the erased reference. + +Evidence: + +- The unchanged reference entry and its three unchanged upstream Variant modules + now pass diagnosis (`variant-uninhabited.json`) and execute under Wasmtime to + `42`. Before the fix the first blocker was the layout rejection; this is the + reference-library compile/execute milestone for the Variant package. +- `cc::layout::tests::uninhabited` covers the bare and applied forms and checks + that a type with a constructor is not swallowed by the rule. +- `tests::uninhabited::a_constructorless_data_type_round_trips_through_unsafe_coercion` + compiles and executes a self-contained coercion round-trip to `42`. +- Backend unit tests: 438 passed. Driver unit tests: 742 passed / 68 failed, + with exactly the same 68 failure names as before the change, so no regression. +- Whole workspace with mandatory Wasmtime: the same four failing targets and 71 + failed names as before the change, with no added or recovered names. Log: + `workspace-after-variant.log`. + +The remaining groups are unchanged: native Effect/ST API execution, the +`Effect`/WASI runtime fixtures, the CLI link/source-layout and residual +constraint targets, and the other reference packages (`Run`, `Free`) plus the +ordinary row library over `Prim.Control`. The earlier "first backend slice" +closure-conversion message still covers genuinely unsupported shapes (for +example open rows and unresolved type constructors); those remain real work. From a2fb20cce41649d254336bb26b1e3642953a857b Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 18:40:42 +0800 Subject: [PATCH 124/148] fix(frontend): desugar local signature types and resolve ~> through its alias Two defects blocked the unchanged purescript-free sources once its dependency closure was supplied. A local where/let binding signature is elaborated as a Typed expression, and P4 desugaring recursed into its expression but passed the written type through unchanged. A type operator chain in a local signature therefore reached kind checking as UnloweredTypeOperator (Control.Monad.Free's go :: Free f ~> Free g). Typed and TypeApplication now desugar their written type like every other type path. A bare (~>) was unconditionally resolved to the builtin function arrow, so a partial (->) was reported as PartiallyAppliedSynonym and broke Control.Monad.Trampoline's `Free ((->) Unit)`, while the official (~>) Array diagnostic only matched by coincidence. A bare ~> now resolves through the imported type-operator alias (Prelude aliases it to NaturalTransformation; a user may alias it to Prim.Function); only an unresolved ~> falls back to the arrow, and the builtin arrow is never a partially applied synonym. Evidence: L3 PartiallyAppliedSynonym agreement stays 12/12 (TypeSynonyms9 and PASTrumpsKDNU2 still agree); L2/L3/L4-L5 annotation scoreboards ran; the whole workspace keeps the same four failing targets and 71 failed names with no added names. The next blocker is polymorphic local signatures (rank-1 local generalization) in Data.CatList and Control.Monad.Free. --- crates/psrs-desugar/src/lib.rs | 6 +- crates/psrs-driver/src/tests/operators/mod.rs | 25 ++++++++ crates/psrs-kind/src/check/infer/type_kind.rs | 35 ++++------ crates/psrs-kind/src/tests/declarations.rs | 10 ++- crates/psrs-kind/src/tests/instances.rs | 23 +++---- .../src/resolver/type_resolution.rs | 25 ++++++-- ...-reference-library-migration-2026-10-12.md | 64 +++++++++++++++++++ 7 files changed, 145 insertions(+), 43 deletions(-) diff --git a/crates/psrs-desugar/src/lib.rs b/crates/psrs-desugar/src/lib.rs index f360c904..bae54518 100644 --- a/crates/psrs-desugar/src/lib.rs +++ b/crates/psrs-desugar/src/lib.rs @@ -216,7 +216,11 @@ fn desugar_expr_inner(expression: Expr) -> Expr { }, ExprKind::Typed { expression, ty } => ExprKind::Typed { expression: Box::new(desugar_expr(*expression)), - ty, + ty: types::desugar_type(ty), + }, + ExprKind::TypeApplication { expression, ty } => ExprKind::TypeApplication { + expression: Box::new(desugar_expr(*expression)), + ty: types::desugar_type(ty), }, ExprKind::Lambda { binder, body } => ExprKind::Lambda { binder, diff --git a/crates/psrs-driver/src/tests/operators/mod.rs b/crates/psrs-driver/src/tests/operators/mod.rs index 18571c93..ab8a1099 100644 --- a/crates/psrs-driver/src/tests/operators/mod.rs +++ b/crates/psrs-driver/src/tests/operators/mod.rs @@ -481,3 +481,28 @@ fn rejects_ambiguous_fixity_groups_for_values_patterns_and_types() { ); } } + +#[test] +fn a_local_signature_with_a_type_operator_chain_is_desugared() { + // A `where`/`let` binding signature is elaborated as a `Typed` expression. + // Its written type must go through P4 like any other type, or the operator + // chain survives into kind checking as `UnloweredTypeOperator`. + let source = r#"module Main where + +import Prelude + +type Pair a b = { _1 :: a, _2 :: b } + +infixr 5 type Pair as :+: + +main :: Int +main = helper { _1: 42, _2: true } + where + helper :: Int :+: Boolean -> Int + helper p = p._1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-kind/src/check/infer/type_kind.rs b/crates/psrs-kind/src/check/infer/type_kind.rs index 86d68bdb..5279e73a 100644 --- a/crates/psrs-kind/src/check/infer/type_kind.rs +++ b/crates/psrs-kind/src/check/infer/type_kind.rs @@ -23,9 +23,9 @@ impl Checker<'_> { /// is the case that matters: each of its arguments is checked against the /// parameter kind its class declares, and `(->)` applied to one argument is /// how a higher-kinded class parameter is written — `Functor ((->) r)` is - /// the standard library's own instance, which `purs` accepts. Read on its - /// own, that same argument is the function arrow partway applied, which is - /// the `PartiallyAppliedSynonym` of `failing/TypeSynonyms9.purs`. + /// the standard library's own instance, which `purs` accepts. The function + /// arrow is a builtin type constructor, not a synonym, so a partial + /// application of it is never a `PartiallyAppliedSynonym`. pub(super) fn kind_of_type_against( &mut self, ty: &hir::Type, @@ -228,26 +228,15 @@ impl Checker<'_> { arguments: usize, span: TextRange, ) { - match &head.kind { - TypeKind::Named(id) => { - if let Some(arity) = self.synonym_arity.get(id) - && arguments < *arity - { - self.report( - PARTIALLY_APPLIED_SYNONYM, - span, - "a type synonym must be fully applied", - ); - } - } - TypeKind::Constructor(BuiltinType::Function) if arguments < 2 => { - self.report( - PARTIALLY_APPLIED_SYNONYM, - span, - "a type synonym must be fully applied", - ); - } - _ => {} + if let TypeKind::Named(id) = &head.kind + && let Some(arity) = self.synonym_arity.get(id) + && arguments < *arity + { + self.report( + PARTIALLY_APPLIED_SYNONYM, + span, + "a type synonym must be fully applied", + ); } } } diff --git a/crates/psrs-kind/src/tests/declarations.rs b/crates/psrs-kind/src/tests/declarations.rs index 2fa1d5d4..41c9a7ab 100644 --- a/crates/psrs-kind/src/tests/declarations.rs +++ b/crates/psrs-kind/src/tests/declarations.rs @@ -100,7 +100,15 @@ fn rejects_an_unsaturated_foreign_data_constructor() { #[test] fn reports_a_partially_applied_function_synonym() { - let errors = check("module Main where\nnewtype N = N ((~>) Array)\n"); + // `~>` aliases a type synonym; applying the bare operator to fewer + // arguments than the synonym's arity is `PartiallyAppliedSynonym`. The + // plain function arrow is a builtin constructor and is never this error. + let errors = check( + "module Main where\n\ + type Natural f g = forall a. f a -> g a\n\ + infixr 4 type Natural as ~>\n\ + newtype N = N ((~>) Array)\n", + ); assert!( codes(&errors).contains(&"PartiallyAppliedSynonym"), "{errors:?}" diff --git a/crates/psrs-kind/src/tests/instances.rs b/crates/psrs-kind/src/tests/instances.rs index 4d062cb1..224a1a04 100644 --- a/crates/psrs-kind/src/tests/instances.rs +++ b/crates/psrs-kind/src/tests/instances.rs @@ -60,19 +60,16 @@ fn accepts_the_function_constructor_as_an_instance_argument() { } #[test] -fn still_reports_a_partially_applied_function_synonym_in_a_type() { - // The same shape as above, but standing alone as a newtype field, where it - // is not checked against a class kind. `purs` reports - // PartiallyAppliedSynonym for `failing/TypeSynonyms9.purs`. - let errors = check( - "module Main where\n\ - newtype A (a :: (Type -> Type) -> Type -> Type) = A String\n\ - newtype B = B (A ((->) Array))\n", - ); - assert!( - codes(&errors).contains(&"PartiallyAppliedSynonym"), - "{errors:?}" - ); +fn accepts_a_partially_applied_function_arrow() { + // `(->)` is a builtin type constructor, not a synonym, so a partial + // application read on its own is valid: `purs` accepts `type Reader = (->) r` + // and `Free ((->) Unit)`. Only a named synonym is `PartiallyAppliedSynonym`. + check_ok(concat!( + "module Main where\n", + "type Reader = (->) Int\n", + "type ReaderString = (->) Int String\n", + "newtype B = B ((->) Boolean Int)\n", + )); } #[test] diff --git a/crates/psrs-resolve/src/resolver/type_resolution.rs b/crates/psrs-resolve/src/resolver/type_resolution.rs index bd11a032..16e46e93 100644 --- a/crates/psrs-resolve/src/resolver/type_resolution.rs +++ b/crates/psrs-resolve/src/resolver/type_resolution.rs @@ -19,14 +19,29 @@ impl Resolver { let reference = self.lookup_qualified_type(&name.text, qualifier, member, name.span)?; self.type_reference_kind(reference) + } else if name.text == "->" { + // The function arrow is a type operator, not a name imported + // from `Prim`. Keep its builtin identity independent of the + // source-level implicit import rules for `Function`. + HirTypeKind::Constructor(builtin_type("->")?) + } else if name.text == "~>" { + // `~>` is an ordinary type-operator alias: official Prelude + // aliases it to `NaturalTransformation`, and a user module + // may alias it to `Prim.Function`. A bare `(~>)` resolves + // through the imported alias; only an unresolved `~>` falls + // back to the function arrow. + match self.type_fixities.get("~>").map(|fixity| fixity.target) { + Some(hir::FixityTarget::Type(reference)) => { + self.type_reference_kind(reference) + } + Some(hir::FixityTarget::Value(_)) => { + unreachable!("type fixities target types") + } + None => HirTypeKind::Constructor(builtin_type("~>")?), + } } else if is_uppercase(&name.text) { let reference = self.lookup_type_name(&name.text, name.span)?; self.type_reference_kind(reference) - } else if matches!(name.text.as_str(), "->" | "~>") { - // Function arrows are type operators, not names imported - // from `Prim`. Keep their builtin identity independent of - // the source-level implicit import rules for `Function`. - HirTypeKind::Constructor(builtin_type(&name.text)?) } else { HirTypeKind::Variable(name.text) } diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index feb60dc7..b12b7b77 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -263,3 +263,67 @@ constraint targets, and the other reference packages (`Run`, `Free`) plus the ordinary row library over `Prim.Control`. The earlier "first backend slice" closure-conversion message still covers genuinely unsupported shapes (for example open rows and unresolved type constructors); those remain real work. + +## Free/Run dependency closure (2026-10-12) + +The reference `Free` package imports `Control.Monad.Trans.Class` and +`Data.CatList`, and its `Control.Monad.Free.Class` reaches +`Control.Monad.Except.Trans`, which imports `Effect.Exception`. Those modules +were not in the pinned package. The closure is now pinned at upstream tags: + +| Package | Tag | Commit | +| --- | --- | --- | +| `purescript-catenable-lists` | `v7.0.0` | `09abe1f4888bc00841ad2b59e56a9e7ce7ebd4ab` | +| `purescript-transformers` | `v6.0.0` | `be72ab52357d9a665cbf93d73ba1c07c4b0957ee` | +| `purescript-exceptions` | `v6.0.0` | `afab3c07c820bb49b6c5be50049db46a964a6161` | +| `purescript-aff` (for Run) | `v7.1.0` | `6adec6ff048a7876f74c294c440374cd21342d39` | + +With those sources supplied unchanged next to the seven `purescript-free` +modules and the entry `FreeMain.purs`, the Free closure has no missing module +and reaches P5. Reproduce with `psrs build FreeMain.purs `; `free-files-list.txt` records the exact +source set in the evidence root. + +Two real frontend defects blocked it and are fixed: + +1. A local `where`/`let` binding signature is elaborated as an + `ExprKind::Typed` node, and P4 desugaring recursed into the expression but + passed the written type through unchanged. A type operator chain in a local + signature therefore survived to kind checking as `UnloweredTypeOperator` + (`Control.Monad.Free`'s `go :: Free f ~> Free g`). `desugar_expr` now + desugars the type of both `Typed` and `TypeApplication`, matching the + top-level and pattern paths. +2. A bare `(~>)` was unconditionally resolved to the builtin function arrow. + That made `(->) Unit` report `PartiallyAppliedSynonym` (breaking + `Control.Monad.Trampoline`'s `type Trampoline = Free ((->) Unit)`), while + the official `(~>) Array` diagnostic only matched by coincidence. A bare + `~>` now resolves through the imported type-operator alias (official Prelude + aliases it to `NaturalTransformation`; a user may alias it to + `Prim.Function`), and only an unresolved `~>` falls back to the arrow. The + function arrow is a builtin constructor and is never a partially applied + synonym inline. L3 kind agreement is unchanged at `PartiallyAppliedSynonym` + 12/12, so `failing/TypeSynonyms9.purs` and `PASTrumpsKDNU2.purs` still agree. + +The next real blocker is **polymorphic local signatures** (rank-1 local +generalization). `Data.CatList`'s recursive `where` `foldl :: forall b c. ...` +and `Control.Monad.Free`'s `go :: Free f ~> Free g` both report `EscapedSkolem` +and `TypesDoNotUnify` at the recursive use. The written `forall` is +re-generalized against a rigid instantiation instead of being instantiated per +use, so the local binding is effectively monomorphic. This is a typechecker +slice, not a desugar or kind issue. + +Run additionally needs `Effect.Aff` and `Effect.Aff.Class`. Its closure pulls +`refs`, `parallel`, and `datetime` on top of the modules above, and `Effect.Aff` +execution itself is gate-blocked on native Effect, so Run cannot be completed in +this pure source-migration track. + +Validation for these fixes: + +- Whole workspace with mandatory Wasmtime: the same four failing targets and 71 + failed names as before the change, with no added or recovered names. Log: + `workspace-after-fixity.log`. +- L2 resolution, L3 kind, and L4/L5 type scoreboards with annotations ran and + printed their reports; L3 `PartiallyAppliedSynonym` agreement is 12/12. +- `cargo fmt --all --check` and + `cargo clippy --workspace --all-targets -- -D warnings`: passed. Regression + tests cover the local-signature desugar and the partial function arrow. From 7a7425311d1c140dd772a969bf66aead0abaaec5 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 19:08:27 +0800 Subject: [PATCH 125/148] fix(typecheck): predeclare annotated local bindings at their written type infer_let_expression predeclared every local binder with a fresh monomorphic metavariable. For a recursive local with a polymorphic annotation (Data.CatList's foldl, Control.Monad.Free's go), the first recursive use bound that metavariable to an arrow before the written forall was unified, so the binding was effectively monomorphic and the case failed with EscapedSkolem and TypesDoNotUnify. An annotated local is now predeclared at its written type: the binding's Typed annotation is elaborated (a speculative elaboration that reports a diagnostic is discarded so the ascription reports it once) and recursive uses instantiate that annotation. The final binding type still unifies with the ascription, which is alpha-equivalent for quantified annotations and keeps a wildcard annotation's unknown connected. Evidence: the unchanged purescript-free sources now compile and execute to 42 under Wasmtime; M4 type agreement rises from 38/49 to 39/50; the whole workspace keeps the same four failing targets and 71 failed names with no added names. --- .../psrs-driver/src/tests/local_signatures.rs | 27 +++++++ crates/psrs-driver/src/tests/mod.rs | 1 + .../src/typecheck/infer/let_expr.rs | 34 ++++++++- ...-reference-library-migration-2026-10-12.md | 70 +++++++++++++------ 4 files changed, 108 insertions(+), 24 deletions(-) create mode 100644 crates/psrs-driver/src/tests/local_signatures.rs diff --git a/crates/psrs-driver/src/tests/local_signatures.rs b/crates/psrs-driver/src/tests/local_signatures.rs new file mode 100644 index 00000000..8a0dad86 --- /dev/null +++ b/crates/psrs-driver/src/tests/local_signatures.rs @@ -0,0 +1,27 @@ +//! An explicit polymorphic annotation on a local binding is predeclared at its +//! written type, so a recursive use instantiates the annotation rather than +//! binding a fresh metavariable to an arrow before the quantifier is checked. + +#[test] +fn a_recursive_local_signature_keeps_its_quantifiers() { + let source = r#"module Main where + +import Prelude + +data List a = Nil | Cons a (List a) + +foldlLocal :: forall b c. (c -> b -> c) -> c -> List b -> c +foldlLocal k c xs = go k c xs + where + go :: forall b2 c2. (c2 -> b2 -> c2) -> c2 -> List b2 -> c2 + go _ acc Nil = acc + go k2 acc (Cons b rest) = go k2 (k2 acc b) rest + +main :: Int +main = foldlLocal (\acc x -> acc + x) 0 (Cons 1 (Cons 2 (Cons 3 Nil))) +"#; + let Some(output) = super::run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(6), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 0368c0bb..7544a7aa 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -29,6 +29,7 @@ mod guard_coverage; mod intrinsic_contracts; mod let_constraints; mod library_foreign; +mod local_signatures; mod number_abs; mod number_acos; mod number_asin; diff --git a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs index 8ce1636a..c5dbc81c 100644 --- a/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs +++ b/crates/psrs-typecheck/src/typecheck/infer/let_expr.rs @@ -18,7 +18,11 @@ impl Checker { let result = self.with_scope(|checker| { let mut binders = Vec::with_capacity(bindings.len()); for binding in bindings { - let scheme = Scheme::monomorphic(checker.fresh()); + // An annotated local is predeclared at its written type so a + // recursive use instantiates the annotation instead of a fresh + // metavariable that a first recursive use would bind to an + // arrow. + let scheme = checker.predeclared_local_scheme(binding); checker .scope .locals @@ -56,4 +60,32 @@ impl Checker { self.scope.locals = previous_locals; result } + + /// The scheme a local binder is predeclared with. An explicit annotation is + /// elaborated here; an elaboration that reports a diagnostic is discarded so + /// the ascription reports it once. An unannotated local is monomorphic. + fn predeclared_local_scheme(&mut self, binding: &hir::LocalBinding) -> Scheme { + let Some(ty) = local_annotation(binding) else { + return Scheme::monomorphic(self.fresh()); + }; + let mut variables = self.scope.annotation_variables.clone(); + let annotation = self.speculate(|checker| { + let errors_before = checker.state.errors.len(); + let annotation = checker.elaborate_type(ty, &mut variables); + (checker.state.errors.len() == errors_before).then_some(annotation) + }); + match annotation { + Some(annotation) => Scheme::monomorphic(annotation), + None => Scheme::monomorphic(self.fresh()), + } + } +} + +/// The written type of an annotated local binding, which the resolver stores as +/// a `Typed` wrapper on the binding value. +fn local_annotation(binding: &hir::LocalBinding) -> Option<&hir::Type> { + match &binding.value.kind { + hir::ExprKind::Typed { ty, .. } => Some(ty), + _ => None, + } } diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index b12b7b77..8763fb69 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -279,10 +279,11 @@ were not in the pinned package. The closure is now pinned at upstream tags: | `purescript-aff` (for Run) | `v7.1.0` | `6adec6ff048a7876f74c294c440374cd21342d39` | With those sources supplied unchanged next to the seven `purescript-free` -modules and the entry `FreeMain.purs`, the Free closure has no missing module -and reaches P5. Reproduce with `psrs build FreeMain.purs `; `free-files-list.txt` records the exact -source set in the evidence root. +modules and the entry `FreeMain.purs`, the closure has no missing module, the +unchanged sources compile, and the program executes under Wasmtime to `42`. +Reproduce with `psrs build FreeMain.purs `; `free-files-list.txt` records the exact source set in the +evidence root. Two real frontend defects blocked it and are fixed: @@ -304,26 +305,49 @@ Two real frontend defects blocked it and are fixed: synonym inline. L3 kind agreement is unchanged at `PartiallyAppliedSynonym` 12/12, so `failing/TypeSynonyms9.purs` and `PASTrumpsKDNU2.purs` still agree. -The next real blocker is **polymorphic local signatures** (rank-1 local +The next real blocker was **polymorphic local signatures** (rank-1 local generalization). `Data.CatList`'s recursive `where` `foldl :: forall b c. ...` -and `Control.Monad.Free`'s `go :: Free f ~> Free g` both report `EscapedSkolem` -and `TypesDoNotUnify` at the recursive use. The written `forall` is -re-generalized against a rigid instantiation instead of being instantiated per -use, so the local binding is effectively monomorphic. This is a typechecker -slice, not a desugar or kind issue. - -Run additionally needs `Effect.Aff` and `Effect.Aff.Class`. Its closure pulls -`refs`, `parallel`, and `datetime` on top of the modules above, and `Effect.Aff` -execution itself is gate-blocked on native Effect, so Run cannot be completed in -this pure source-migration track. - -Validation for these fixes: - +and `Control.Monad.Free`'s `go :: Free f ~> Free g` both reported `EscapedSkolem` +and `TypesDoNotUnify` at the recursive use: `infer_let_expression` predeclared +every local binder with a fresh monomorphic metavariable, so the first recursive +use bound that metavariable to an arrow before the written `forall` was unified, +and the local binding was effectively monomorphic. + +An annotated local is now predeclared at its written type: `predeclared_local_scheme` +elaborates the binding's `Typed` annotation (discarding a speculative elaboration +that reports a diagnostic, so the ascription reports it once) and a recursive +use instantiates that annotation. The final binding type still unifies with the +ascription, which is alpha-equivalent for quantified annotations and keeps a +wildcard annotation's unknown connected (so `failing/2534.purs` still reports +`InfiniteType`). + +With that fix the unchanged `purescript-free` sources compile and execute: +`FreeMain.purs` over `Free Identity` returns `42` under Wasmtime. M4 type +agreement rises from 38/49 to 39/50 (the wildcard case is measured and agrees +again) and M5 stays 77/97; the whole workspace keeps the same four failing +targets and 71 failed names with no added names. + +Two follow-ups remain in the evidence. Compiling `Control.Monad.Free` emits one +`P8 closure conversion` warning at line 226 (`redundant case alternative is +unreachable`) even though both `Return` and `Bind` are reachable and the +program executes correctly; that is a coverage-analysis false positive exposed +by the new closure, not a typechecking error. Run additionally needs `Effect.Aff` +and `Effect.Aff.Class`; every `Run/*` module imports the `Run` top module, which +imports `Effect.Aff`, so the package cannot even resolve without Aff. Aff's +closure pulls `refs`, `parallel`, and `datetime` on top of the modules above, and +`Effect.Aff` execution itself is gate-blocked on native Effect, so Run cannot be +completed in this pure source-migration track. + +Validation for the closure, the frontend fixes, and the local-signature fix: + +- Unchanged Free sources build and execute to `42` under Wasmtime. - Whole workspace with mandatory Wasmtime: the same four failing targets and 71 - failed names as before the change, with no added or recovered names. Log: - `workspace-after-fixity.log`. -- L2 resolution, L3 kind, and L4/L5 type scoreboards with annotations ran and - printed their reports; L3 `PartiallyAppliedSynonym` agreement is 12/12. + failed names as before the changes, with no added names. Logs: + `workspace-after-fixity.log`, `workspace-after-localsig2.log`. +- L2/L3/L4-L5 annotation scoreboards ran. L2 resolution 72/72, L3 kind 39/48 + with `PartiallyAppliedSynonym` 12/12, M4 type agreement 39/50, M5 77/97, with + 147 measured and 11 blocked-before-typecheck cases (unchanged set). - `cargo fmt --all --check` and `cargo clippy --workspace --all-targets -- -D warnings`: passed. Regression - tests cover the local-signature desugar and the partial function arrow. + tests cover the local-signature desugar, the partial function arrow, and the + recursive local signature. From 34a1290adec7250b4d4ed3b822666d2a5c9a451f Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 19:33:28 +0800 Subject: [PATCH 126/148] fix(backend): do not treat an uninhabited field as a complete signature Coverage's signature() read a zero-constructor user type as a complete empty constructor set. A case alternative whose field is such a type then had no witness and was reported as a redundant branch. The reference Free stores FreeView f Val Val, so Return's payload is the uninhabited Val, yet fromView builds Return values through unsafeCoerce; compiling it warned at Control/Monad/Free.purs:226 even though both constructors are reachable and the program executes correctly. An uninhabited user type now leaves the shape unknown, like an abstract type, so the wildcard matrix handles it. The warning is gone and the unchanged Free sources still execute to 42. Backend tests 439 passed; the whole workspace keeps the same four failing targets and 71 failed names with no added names. --- .../src/cc/case/coverage/engine.rs | 8 ++++ .../src/cc/case/coverage/tests/mod.rs | 37 +++++++++++++++++++ ...-reference-library-migration-2026-10-12.md | 25 ++++++++----- 3 files changed, 61 insertions(+), 9 deletions(-) diff --git a/crates/psrs-backend/src/cc/case/coverage/engine.rs b/crates/psrs-backend/src/cc/case/coverage/engine.rs index dc607efc..6652b8f1 100644 --- a/crates/psrs-backend/src/cc/case/coverage/engine.rs +++ b/crates/psrs-backend/src/cc/case/coverage/engine.rs @@ -240,6 +240,14 @@ fn useful_array_any( fn signature(module: &Module, ty: TypeId) -> Option> { let ty = crate::cc::layout::unquantified_type(module, ty); if let Some(type_id) = user_type_id(module, ty) { + // An uninhabited user type has no constructors, but unchecked coercions + // can still produce its values (the reference `Free` over `Val` builds + // `Return` values this way). Coverage must not treat it as a complete + // empty signature, so its shape is left unknown and the wildcard matrix + // handles it. + if crate::cc::layout::is_uninhabited_data_type(module, type_id) { + return None; + } return Some( module .constructors diff --git a/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs b/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs index ce165c86..dc0de84e 100644 --- a/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs +++ b/crates/psrs-backend/src/cc/case/coverage/tests/mod.rs @@ -412,3 +412,40 @@ fn recursive_coverage_agrees_with_a_bounded_first_match_oracle() { ); } } + +#[test] +fn a_field_of_an_uninhabited_type_does_not_make_its_constructor_redundant() { + // `data View a b = Return a | Bind b Int` checked at `b` uninhabited, like + // the reference `Free` instantiated at `Val`. `Val` has no constructors, but + // unchecked coercions still produce `Return` values, so coverage must treat + // the uninhabited field as an unknown shape rather than a complete empty + // signature and must not call `Return` redundant. + let module = module( + vec![ + Type::Constructor(TypeConstructor::User(hir_type_id(0))), + Type::Constructor(TypeConstructor::User(hir_type_id(1))), + Type::Constructor(TypeConstructor::Int), + ], + vec![ + constructor(0, "Return", 0, vec![TypeId(1)]), + constructor(1, "Bind", 0, vec![TypeId(1), TypeId(2)]), + ], + ); + let return_branch = branch(pat( + 0, + PatternKind::Constructor { + symbol: symbol(0), + arguments: vec![binder(1)], + }, + )); + let bind_branch = branch(pat( + 0, + PatternKind::Constructor { + symbol: symbol(1), + arguments: vec![binder(1), binder(2)], + }, + )); + let report = analyze(&module, TypeId(0), &[return_branch, bind_branch]); + assert!(report.exhaustive, "{report:?}"); + assert!(report.redundant_branches.is_empty(), "{report:?}"); +} diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index 8763fb69..8eb6f742 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -327,12 +327,18 @@ agreement rises from 38/49 to 39/50 (the wildcard case is measured and agrees again) and M5 stays 77/97; the whole workspace keeps the same four failing targets and 71 failed names with no added names. -Two follow-ups remain in the evidence. Compiling `Control.Monad.Free` emits one -`P8 closure conversion` warning at line 226 (`redundant case alternative is -unreachable`) even though both `Return` and `Bind` are reachable and the -program executes correctly; that is a coverage-analysis false positive exposed -by the new closure, not a typechecking error. Run additionally needs `Effect.Aff` -and `Effect.Aff.Class`; every `Run/*` module imports the `Run` top module, which +Compiling `Control.Monad.Free` initially emitted one `P8 closure conversion` +warning at line 226 (`redundant case alternative is unreachable`). The warning +was type-correct but wrong in practice: `Free` stores `FreeView f Val Val`, so +`Return`'s payload is the uninhabited `Val`, yet `fromView` builds `Return` +values through `unsafeCoerce`. Coverage's `signature` treated a zero-constructor +user type as a complete empty signature, so `Any` over it had no witness and the +enclosing branch looked redundant. `signature` now leaves an uninhabited user +type's shape unknown, like an abstract type, so the wildcard matrix handles it; +the warning is gone and the program still returns `42`. + +Run remains the outstanding reference package. It needs `Effect.Aff` and +`Effect.Aff.Class`; every `Run/*` module imports the `Run` top module, which imports `Effect.Aff`, so the package cannot even resolve without Aff. Aff's closure pulls `refs`, `parallel`, and `datetime` on top of the modules above, and `Effect.Aff` execution itself is gate-blocked on native Effect, so Run cannot be @@ -343,11 +349,12 @@ Validation for the closure, the frontend fixes, and the local-signature fix: - Unchanged Free sources build and execute to `42` under Wasmtime. - Whole workspace with mandatory Wasmtime: the same four failing targets and 71 failed names as before the changes, with no added names. Logs: - `workspace-after-fixity.log`, `workspace-after-localsig2.log`. + `workspace-after-fixity.log`, `workspace-after-localsig2.log`, + `workspace-after-coverage.log`. - L2/L3/L4-L5 annotation scoreboards ran. L2 resolution 72/72, L3 kind 39/48 with `PartiallyAppliedSynonym` 12/12, M4 type agreement 39/50, M5 77/97, with 147 measured and 11 blocked-before-typecheck cases (unchanged set). - `cargo fmt --all --check` and `cargo clippy --workspace --all-targets -- -D warnings`: passed. Regression - tests cover the local-signature desugar, the partial function arrow, and the - recursive local signature. + tests cover the local-signature desugar, the partial function arrow, the + recursive local signature, and the uninhabited-field coverage shape. From 06f8e79b5109fae129d28455dfef31f654eb5a16 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 19:48:35 +0800 Subject: [PATCH 127/148] test(effect): prototype the rank-N heterogeneous native representation The native Effect/ST design's first implementation step is to validate the shared representation and typed requests before migrating public modules. This adds that prototype as a compiler regression test: a rank-N request functor preserves a cell's element type, operand, and continuation result without a GADT or an unsafe cast, and a free computation over it is interpreted one request at a time with a tail-recursive interpreter. The test compiles an Int cell and a String cell in one `do` program, writes both in place, reads both, reads the WASI monotonic clock through a Host request performed by the interpreter from a raw host leaf, and executes to 42. It also records the design's flagged role risk as a real blocker: a free computation whose `a` sits inside the request functor's parameter infers a nominal result role, so the official `type role Effect representational` (which ST.Global.toEffect relies on) cannot hold. The Host family, the facade newtype, and the interpreter work and return 42; the public-module migration waits on fixing the representation's result role. The ST facade, region boundary, Global conversion, and public migration remain outstanding. --- crates/psrs-driver/src/tests/mod.rs | 18 ++ .../src/tests/native_representation.rs | 182 ++++++++++++++++++ .../backend/native-effect-and-st.md | 81 ++++++++ 3 files changed, 281 insertions(+) create mode 100644 crates/psrs-driver/src/tests/native_representation.rs diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 7544a7aa..f2058c15 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -98,6 +98,23 @@ fn run_program_with_wasmtime(sources: &[(&str, &str)]) -> Option Option { + wasmtime_available()?; + let artifact = compile_program_sources_with_prelude(sources).unwrap(); + let id = WASM_ARTIFACT_COUNTER.fetch_add(1, Ordering::Relaxed); + let path = std::env::temp_dir().join(format!("psrs-{}-{id}.wasm", std::process::id())); + std::fs::write(&path, &artifact.wasm).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + let _ = std::fs::remove_file(&path); + Some(output) +} + fn run_with_wasmtime_args(source: &str, args: &[&str]) -> Option { run_wasmtime(source, args, None) } @@ -187,6 +204,7 @@ mod guard_let; mod guards; mod module_loader; +mod native_representation; mod library_types; diff --git a/crates/psrs-driver/src/tests/native_representation.rs b/crates/psrs-driver/src/tests/native_representation.rs new file mode 100644 index 00000000..e7e018af --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation.rs @@ -0,0 +1,182 @@ +//! The shared native computation representation for the Effect/ST design: a +//! free computation over a rank-N heterogeneous request functor, interpreted by +//! leaf storage operations and one host operation. This is a representation +//! prototype, not the public Effect/ST facade. + +#[test] +fn a_rank_n_heterogeneous_storage_and_host_program_runs() { + let native = r###"-- Prototype of the native computation representation for the Effect/ST design. +-- It is deliberately outside the package: the design says to validate the +-- shared representation and typed requests before migrating public modules. +-- The host family is one raw leaf; the public Effect/ST facade is not here yet. +module PSRS.Effect.Native + ( Native + , NativeF + , Cell + , newCell + , readCell + , writeCell + , clockNow + , abort + , bindNative + , pureNative + , runNative + ) where + +import Prelude + +import PSRS.Effect.Native.Host (clockNow) as Host + +-- Target storage leaves stay below the Canonical ABI, as the design requires. +foreign import "psrs:intrinsic#arrayFill" filled :: forall a. Int -> a -> Array a +foreign import "psrs:intrinsic#arrayWrite" slot :: forall a. Array a -> Int -> a -> Array a +foreign import "psrs:intrinsic#arrayIndex" at :: forall a. Array a -> Int -> a +foreign import "psrs:runtime-storage#trap" trap :: forall a. a + +newtype Cell a = Cell (Array a) + +-- A rank-N request eliminator. `next` is the continuation's result, so a +-- request preserves the relationship between the cell's element type, the +-- operand, and the continuation result without a GADT. +type StorageMethods next z = + { new :: forall a. a -> (Cell a -> next) -> z + , read :: forall a. Cell a -> (a -> next) -> z + , write :: forall a. Cell a -> a -> (Unit -> next) -> z + } + +newtype StorageF next = StorageF (forall z. StorageMethods next z -> z) + +-- The host family. Each operation carries its checked request/result type. +type HostMethods next z = + { clockNow :: (Int -> next) -> z + } + +newtype HostF next = HostF (forall z. HostMethods next z -> z) + +data NativeF next = Storage (StorageF next) | Host (HostF next) | Abort + +-- A free computation over the request functor. `Suspend` stores the request +-- with its continuation embedded, and the interpreter drives it in constant +-- stack by tail-calling the continuation. +data Native f a = Return a | Suspend (f (Native f a)) + +mapNative :: forall f a b. Functor f => (a -> b) -> Native f a -> Native f b +mapNative g (Return a) = Return (g a) +mapNative g (Suspend op) = Suspend (map (mapNative g) op) + +bindNative :: forall f a b. Functor f => Native f a -> (a -> Native f b) -> Native f b +bindNative (Return a) f = f a +bindNative (Suspend op) f = Suspend (map (\rest -> bindNative rest f) op) + +pureNative :: forall f a. a -> Native f a +pureNative = Return + +instance functorNativeF :: Functor NativeF where + map g (Storage (StorageF k)) = Storage (StorageF \h -> + k + { new: \value cont -> h.new value (cont >>> g) + , read: \cell cont -> h.read cell (cont >>> g) + , write: \cell value cont -> h.write cell value (cont >>> g) + }) + map g (Host (HostF k)) = Host (HostF \h -> k { clockNow: \cont -> h.clockNow (cont >>> g) }) + map _ Abort = Abort + +instance functorNative :: Functor f => Functor (Native f) where + map g (Return a) = Return (g a) + map g (Suspend op) = Suspend (map (map g) op) + +instance bindNative' :: Functor f => Bind (Native f) where + bind (Return a) f = f a + bind (Suspend op) f = Suspend (map (\rest -> bind rest f) op) + +instance applyNative :: Functor f => Apply (Native f) where + apply mf mx = bind mf \f -> bind mx \x -> Return (f x) + +instance applicativeNative :: Functor f => Applicative (Native f) where + pure = Return + +instance monadNative :: Functor f => Monad (Native f) + +newCell :: forall a. a -> Native NativeF (Cell a) +newCell value = Suspend (Storage (StorageF request)) + where + request :: forall z. StorageMethods (Native NativeF (Cell a)) z -> z + request h = h.new value Return + +readCell :: forall a. Cell a -> Native NativeF a +readCell cell = Suspend (Storage (StorageF request)) + where + request :: forall z. StorageMethods (Native NativeF a) z -> z + request h = h.read cell Return + +writeCell :: forall a. Cell a -> a -> Native NativeF Unit +writeCell cell value = Suspend (Storage (StorageF request)) + where + request :: forall z. StorageMethods (Native NativeF Unit) z -> z + request h = h.write cell value Return + +clockNow :: Native NativeF Int +clockNow = Suspend (Host (HostF request)) + where + request :: forall z. HostMethods (Native NativeF Int) z -> z + request h = h.clockNow Return + +abort :: forall a. Native NativeF a +abort = Suspend Abort + +runNative :: forall a. Native NativeF a -> a +runNative = go + where + go :: Native NativeF a -> a + go (Return a) = a + go (Suspend op) = go (step op) + + step :: NativeF (Native NativeF a) -> Native NativeF a + step (Storage (StorageF k)) = k (storageInterpreter :: StorageMethods (Native NativeF a) (Native NativeF a)) + step (Host (HostF k)) = k { clockNow: \cont -> cont Host.clockNow } + step Abort = trap + + storageInterpreter :: StorageMethods (Native NativeF a) (Native NativeF a) + storageInterpreter = + { new: \value cont -> cont (Cell (filled 1 value)) + , read: \(Cell cell) cont -> cont (at cell 0) + , write: \(Cell cell) value cont -> cont (let _ = slot cell 0 value in unit) + } +"###; + let host = r###"module PSRS.Effect.Native.Host (clockNow) where + +-- A raw host leaf: declared at its canonical result, not wrapped in `Effect`. +-- The native interpreter turns this into a Host request. +foreign import "wasi:clocks/monotonic-clock#now" clockNow :: Int +"###; + let entry = r###"module Main where + +import Prelude + +import PSRS.Effect.Native (Native, NativeF, newCell, readCell, writeCell, clockNow, runNative) + +-- A storage program with two element types plus a host request. The host leaf +-- is a real WASI monotonic-clock read performed by the interpreter. +program :: Native NativeF Int +program = do + ints <- newCell 0 + strs <- newCell "a" + _ <- writeCell ints 41 + _ <- writeCell strs "b" + stamp <- clockNow + first <- readCell ints + _ <- readCell strs + if stamp >= 0 then pure (first + 1) else pure 0 + +main :: Int +main = runNative program +"###; + let Some(output) = super::run_program_with_prelude_wasmtime(&[ + ("PSRS/Effect/Native/Host.purs", host), + ("PSRS/Effect/Native.purs", native), + ("Main.purs", entry), + ]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/docs/implementation/backend/native-effect-and-st.md b/docs/implementation/backend/native-effect-and-st.md index e91fc435..1a52ada3 100644 --- a/docs/implementation/backend/native-effect-and-st.md +++ b/docs/implementation/backend/native-effect-and-st.md @@ -34,3 +34,84 @@ No runtime tests or differential cases were executed for this proposal. Record exact compiler/package identities, commands, results, and skips for subsequent evidence. Do not label a requirement Verified from this design text or a test that exercises the withdrawn implementation. + +## Representation prototype (2026-10-12) + +The first implementation step, "validate shared generic representation and typed +requests", has a working prototype. It lives outside the package, as the +implementation order requires, and is exercised by a compiler regression test +so a future change cannot silently break the encoding. + +The prototype supplies a rank-N heterogeneous request functor and a free +computation over it: + +```purescript +type Methods next z = + { new :: forall a. a -> (Cell a -> next) -> z + , read :: forall a. Cell a -> (a -> next) -> z + , write :: forall a. Cell a -> a -> (Unit -> next) -> z + , abort :: forall a. a -> z + } + +newtype NativeF next = NativeF (forall z. Methods next z -> z) +data Native f a = Return a | Suspend (f (Native f a)) +``` + +`next` is the continuation result, so a request preserves the relationship +between a cell's element type, the operand, and the continuation result without +a GADT or an unsafe payload cast. `runNative` interprets one `Suspend` at a time +and tail-calls the continuation, so interpretation runs in constant stack; cell +storage uses the existing checked `arrayFill`/`arrayWrite`/`arrayIndex` +primitives, and `abort` uses the checked storage trap. + +Evidence: + +- `tests::native_representation::a_rank_n_heterogeneous_storage_and_host_program_runs` + compiles the module set and an entry that allocates an `Int` cell and a + `String` cell, writes both in place, reads both, reads the WASI monotonic + clock through a `Host` request, and returns `42`. The program uses `do` + notation, so the `Functor`/`Bind`/`Apply`/`Applicative`/`Monad` instances are + exercised too. +- The whole workspace keeps the same four failing targets and 71 failed names + with no added names (`workspace-after-native-proto.log`). + +### Host leaves + +A WIT import declared as `Effect X` cannot satisfy the ABI: `core_matches_result` +compares the import's resolved result against its canonical result and does not +unwrap `Effect`, so the checked `getStdin :: Effect InputStream` and its +neighbours fail. A raw host leaf declared at its canonical result instead +(`foreign import "wasi:clocks/monotonic-clock#now" clockNow :: Int`) validates +and executes; the interpreter turns it into a `Host` request and performs the +call. The prototype's `Host` family has one operation and the interpreter calls +the raw leaf once per request. + +### Recorded blocker: result-role representationality + +The official `Effect` module declares `type role Effect representational`, and +`ST.Global.toEffect` is `unsafeCoerce` under that contract, so the shared +representation must infer a representational result role. The naive free monad +`data Native f a = Return a | Suspend (f (Native f a))` does not: `a` sits inside +`f`'s parameter, whose role is unknown at `Native`'s definition, so `a` is +inferred **nominal**, and `type role Effect representational` over it is +`RoleMismatch`. + +The direction is confirmed, not just hypothesised. Upstream `Free` erases its +result type internally +(`data Free f a = Free (FreeView f Val Val) (CatList (ExpF f))`), so `a` is +phantom there; a `newtype Effect a = Effect (Free NativeF a)` with +`type role Effect representational` type checks. The design's chosen +`Run (native :: NativeF) a` is `Run (Free (VariantF r) a)`, so it inherits that +representational result role. The work is therefore to express the storage and +host requests over the `Free`/`Run` answer-indexed representation (whose +`perform` carries the operation answer, not the continuation result), rather +than over the naive continuation-passing free monad. That is the next design +step; the public-module migration does not proceed on the nominal encoding, and +the invalid role annotation is never forced. + +What the prototype does **not** do, and what the checklist still requires: there +is no `ST` facade, region boundary, `ST.Global` conversion, safe mutable-array +integration, or public-module migration, and no `Effect` module with the +official role annotation or exports. Every checklist row remains Unverified +except that NE-04's heterogeneous request typing now has prototype evidence for +two element types. From 40cc00cb811ab221f50297e07919a8251929d888 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 20:58:52 +0800 Subject: [PATCH 128/148] fix(resolve): require visible aliases for symbolic type operators --- .../src/tests/operators/local_types.rs | 26 +++++++++ crates/psrs-driver/src/tests/operators/mod.rs | 27 +-------- .../tests/operators/natural_transformation.rs | 56 +++++++++++++++++++ .../psrs-resolve/src/resolver/names/util.rs | 2 +- .../src/resolver/type_resolution.rs | 53 +++++++++--------- .../semantics/modules-and-resolution.md | 5 ++ 6 files changed, 118 insertions(+), 51 deletions(-) create mode 100644 crates/psrs-driver/src/tests/operators/local_types.rs create mode 100644 crates/psrs-driver/src/tests/operators/natural_transformation.rs diff --git a/crates/psrs-driver/src/tests/operators/local_types.rs b/crates/psrs-driver/src/tests/operators/local_types.rs new file mode 100644 index 00000000..a9402787 --- /dev/null +++ b/crates/psrs-driver/src/tests/operators/local_types.rs @@ -0,0 +1,26 @@ +use super::*; + +#[test] +fn a_local_signature_with_a_type_operator_chain_is_desugared() { + // A `where`/`let` binding signature is elaborated as a `Typed` expression. + // Its written type must go through P4 like any other type, or the operator + // chain survives into kind checking as `UnloweredTypeOperator`. + let source = r#"module Main where + +import Prelude + +type Pair a b = { _1 :: a, _2 :: b } + +infixr 5 type Pair as :+: + +main :: Int +main = helper { _1: 42, _2: true } + where + helper :: Int :+: Boolean -> Int + helper p = p._1 +"#; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/operators/mod.rs b/crates/psrs-driver/src/tests/operators/mod.rs index ab8a1099..a6728feb 100644 --- a/crates/psrs-driver/src/tests/operators/mod.rs +++ b/crates/psrs-driver/src/tests/operators/mod.rs @@ -1,3 +1,5 @@ +mod local_types; +mod natural_transformation; mod opaque_type; mod prim_type; mod qualified_patterns; @@ -481,28 +483,3 @@ fn rejects_ambiguous_fixity_groups_for_values_patterns_and_types() { ); } } - -#[test] -fn a_local_signature_with_a_type_operator_chain_is_desugared() { - // A `where`/`let` binding signature is elaborated as a `Typed` expression. - // Its written type must go through P4 like any other type, or the operator - // chain survives into kind checking as `UnloweredTypeOperator`. - let source = r#"module Main where - -import Prelude - -type Pair a b = { _1 :: a, _2 :: b } - -infixr 5 type Pair as :+: - -main :: Int -main = helper { _1: 42, _2: true } - where - helper :: Int :+: Boolean -> Int - helper p = p._1 -"#; - let Some(output) = run_with_wasmtime(source) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} diff --git a/crates/psrs-driver/src/tests/operators/natural_transformation.rs b/crates/psrs-driver/src/tests/operators/natural_transformation.rs new file mode 100644 index 00000000..7374fc0c --- /dev/null +++ b/crates/psrs-driver/src/tests/operators/natural_transformation.rs @@ -0,0 +1,56 @@ +use super::*; + +#[test] +fn unimported_natural_transformation_alias_is_rejected_in_bare_and_infix_forms() { + for ty in ["Holder ((~>) Int)", "Int ~> Int"] { + let source = format!( + "module Main where\ndata Holder f = Holder (f Int)\nfoo :: {ty}\nfoo = foo\nmain = 42\n" + ); + let errors = resolve_program_sources(&[("Main.purs", &source)]) + .expect_err("a type operator requires a declaration or import"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("UnknownName")), + "{errors:?}" + ); + } +} + +#[test] +fn hiding_the_natural_transformation_alias_does_not_restore_a_builtin_arrow() { + let library = ( + "Alias.purs", + "module Alias where\ninfixr 0 type Function as ~>\n", + ); + let source = "module Main where\nimport Alias hiding (type (~>))\ndata Holder f = Holder (f Int)\nfoo :: Holder ((~>) Int)\nfoo = Holder (\\x -> x)\nmain = 42\n"; + let errors = resolve_program_sources(&[library, ("Main.purs", source)]) + .expect_err("a hidden type alias is not in scope"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("UnknownName")), + "{errors:?}" + ); +} + +#[test] +fn a_declared_bare_natural_transformation_alias_retains_its_target() { + let source = "module Main where\ninfixr 0 type Function as ~>\ndata Holder f = Holder (f Int)\nfoo :: Holder ((~>) Int)\nfoo = Holder (\\x -> x)\nmain = 42\n"; + typecheck_program_sources(&[("Main.purs", source)]) + .expect("the explicitly declared Function alias is a valid partial constructor"); +} + +#[test] +fn other_bare_type_operator_aliases_use_the_same_lookup() { + let source = "module Main where\ninfixr 0 type Function as :+\ndata Holder f = Holder (f Int)\nfoo :: Holder ((:+) Int)\nfoo = Holder (\\x -> x)\nmain = 42\n"; + typecheck_program_sources(&[("Main.purs", source)]).expect("ordinary operator alias"); + let source = source.replace("infixr 0 type Function as :+\n", ""); + let errors = resolve_program_sources(&[("Main.purs", &source)]).expect_err("missing alias"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("UnknownName")), + "{errors:?}" + ); +} diff --git a/crates/psrs-resolve/src/resolver/names/util.rs b/crates/psrs-resolve/src/resolver/names/util.rs index f044fe53..1ec30627 100644 --- a/crates/psrs-resolve/src/resolver/names/util.rs +++ b/crates/psrs-resolve/src/resolver/names/util.rs @@ -67,7 +67,7 @@ pub(in crate::resolver) fn builtin_type(name: &str) -> Option { "Row" => BuiltinType::Row, "Record" => BuiltinType::Record, "Array" => BuiltinType::Array, - "Function" | "->" | "~>" => BuiltinType::Function, + "Function" | "->" => BuiltinType::Function, _ => return None, }) } diff --git a/crates/psrs-resolve/src/resolver/type_resolution.rs b/crates/psrs-resolve/src/resolver/type_resolution.rs index 16e46e93..cfde4894 100644 --- a/crates/psrs-resolve/src/resolver/type_resolution.rs +++ b/crates/psrs-resolve/src/resolver/type_resolution.rs @@ -24,21 +24,16 @@ impl Resolver { // from `Prim`. Keep its builtin identity independent of the // source-level implicit import rules for `Function`. HirTypeKind::Constructor(builtin_type("->")?) - } else if name.text == "~>" { - // `~>` is an ordinary type-operator alias: official Prelude - // aliases it to `NaturalTransformation`, and a user module - // may alias it to `Prim.Function`. A bare `(~>)` resolves - // through the imported alias; only an unresolved `~>` falls - // back to the function arrow. - match self.type_fixities.get("~>").map(|fixity| fixity.target) { - Some(hir::FixityTarget::Type(reference)) => { - self.type_reference_kind(reference) - } - Some(hir::FixityTarget::Value(_)) => { - unreachable!("type fixities target types") - } - None => HirTypeKind::Constructor(builtin_type("~>")?), - } + } else if name + .text + .chars() + .next() + .is_some_and(|first| !first.is_alphabetic() && first != '_') + { + // Symbolic names are type operators. Bare and infix uses + // share alias lookup; an absent alias is a resolution error. + let reference = self.lookup_type_operator_reference(&name.text, name.span)?; + self.type_reference_kind(reference) } else if is_uppercase(&name.text) { let reference = self.lookup_type_name(&name.text, name.span)?; self.type_reference_kind(reference) @@ -103,16 +98,7 @@ impl Resolver { name: &str, span: TextRange, ) -> Option { - let reference = if let Some(fixity) = self.type_fixities.get(name) { - match fixity.target { - hir::FixityTarget::Type(reference) => reference, - hir::FixityTarget::Value(_) => unreachable!("type fixities target types"), - } - } else if let Some((qualifier, member)) = split_qualified(name) { - self.lookup_qualified_type(name, qualifier, member, span)? - } else { - self.lookup_type_name(name, span)? - }; + let reference = self.lookup_type_operator_reference(name, span)?; let (associativity, precedence) = self .type_fixities .get(name) @@ -126,6 +112,23 @@ impl Resolver { }) } + fn lookup_type_operator_reference( + &mut self, + name: &str, + span: TextRange, + ) -> Option { + if let Some(fixity) = self.type_fixities.get(name) { + match fixity.target { + hir::FixityTarget::Type(reference) => Some(reference), + hir::FixityTarget::Value(_) => unreachable!("type fixities target types"), + } + } else if let Some((qualifier, member)) = split_qualified(name) { + self.lookup_qualified_type(name, qualifier, member, span) + } else { + self.lookup_type_name(name, span) + } + } + fn resolve_type_parameter( &mut self, parameter: ast::TypeParameter, diff --git a/docs/design/frontend/semantics/modules-and-resolution.md b/docs/design/frontend/semantics/modules-and-resolution.md index ae54b30c..bdd88810 100644 --- a/docs/design/frontend/semantics/modules-and-resolution.md +++ b/docs/design/frontend/semantics/modules-and-resolution.md @@ -34,6 +34,11 @@ qualified, selective, or hidden, and exports can re-export imported declarations. Stable identities let later passes refer to declarations without repeating name lookup. +The function arrow `(->)` is builtin. `(~>)` is an ordinary type-operator alias: +bare and infix uses require a declaration or visible import, including the +alias's target identity. Missing or hidden aliases report `UnknownName`; neither +spelling silently becomes the builtin arrow. + ## Model ```text From 92ac17415034d93787fe6f5319626a784a4af3de Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 20:59:43 +0800 Subject: [PATCH 129/148] test(effect): observe both heterogeneous storage results --- crates/psrs-driver/src/tests/native_representation.rs | 4 ++-- docs/implementation/backend/native-effect-and-st.md | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/crates/psrs-driver/src/tests/native_representation.rs b/crates/psrs-driver/src/tests/native_representation.rs index e7e018af..fd97a1aa 100644 --- a/crates/psrs-driver/src/tests/native_representation.rs +++ b/crates/psrs-driver/src/tests/native_representation.rs @@ -165,8 +165,8 @@ program = do _ <- writeCell strs "b" stamp <- clockNow first <- readCell ints - _ <- readCell strs - if stamp >= 0 then pure (first + 1) else pure 0 + second <- readCell strs + if stamp >= 0 && second == "b" then pure (first + 1) else pure 0 main :: Int main = runNative program diff --git a/docs/implementation/backend/native-effect-and-st.md b/docs/implementation/backend/native-effect-and-st.md index 1a52ada3..bee8b304 100644 --- a/docs/implementation/backend/native-effect-and-st.md +++ b/docs/implementation/backend/native-effect-and-st.md @@ -69,7 +69,8 @@ Evidence: - `tests::native_representation::a_rank_n_heterogeneous_storage_and_host_program_runs` compiles the module set and an entry that allocates an `Int` cell and a `String` cell, writes both in place, reads both, reads the WASI monotonic - clock through a `Host` request, and returns `42`. The program uses `do` + clock through a `Host` request, and returns `42` only if the String read is + `"b"` and the Int read is `41`. The program uses `do` notation, so the `Functor`/`Bind`/`Apply`/`Applicative`/`Monad` instances are exercised too. - The whole workspace keeps the same four failing targets and 71 failed names From d5dfbb99864aeffd5f89331a57264da53c4f864a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 21:01:03 +0800 Subject: [PATCH 130/148] Land labelled Control row wrappers and align the control design --- .../fp/algebraic-effects-and-handlers.md | 6 ++- .../control-elimination-and-handler-scopes.md | 18 ++++++- .../delimited-control-and-resumable-frames.md | 47 ++++++++++++++++--- ...-reference-library-migration-2026-10-12.md | 44 +++++++++++++++++ stdlib.lock.json | 4 +- 5 files changed, 107 insertions(+), 12 deletions(-) diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index 8a6b5a49..383c77ff 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -374,8 +374,10 @@ does not reopen the deleted legacy runner path. 1. **Reference-library acceptance.** Audit the pinned upstream Run/Free/Variant packages, accept the reference library on this target, and build the row-based - (`VariantF`) library over the closed prototype. No compile or runtime acceptance - has been measured for the reference library. + (`VariantF`) library over compiler Control. Representative unchanged Variant + and Free programs execute, and labelled deep/shallow Control wrappers have + focused behavior evidence. Complete reference-library/API acceptance remains + open; neither those programs nor the native prototype establish it. 2. **Operation-row encoding.** Confirm the reference encoding (`VariantF` over an open row) is supported end to end, or record the compiler gap it exposes. 3. **Scoped and higher-order effects, bracket/finalization.** These need their own diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 0bab6821..152b5608 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -1,14 +1,14 @@ # Control Elimination and Handler Scopes **Feature:** [F-02](../../../feature/F-02-portable-programs.md) -**Status:** Draft +**Status:** Selected contract v2; partially implemented, complete acceptance outstanding. **Prerequisites:** [Delimited control](delimited-control-and-resumable-frames.md), [CC IR](cc-ir.md), and [representation and evidence](representation-and-evidence.md). **Summary:** Generalize the existing `Prim.Control.handle` to eliminate a source computation into a distinct target computation. Return and operation clauses run outside the source handler; ordinary library code chooses deep or shallow resumption. Dispatch scope and continuation lifetime are separate machine facts. -[DEC-20](../../../decision/DEC-20-typed-control-elimination.md) records this draft +[DEC-20](../../../decision/DEC-20-typed-control-elimination.md) records this selected API revision; the implementation checklist separates historical v1 evidence from focused v2 execution and the remaining verifier/foreign obligations. @@ -70,6 +70,14 @@ separate ownership contract. ### Library derivations +The independent package's `PSRS.Control.Row` instantiates these policies over +unchanged pinned `VariantF`: `performAt` injects a labelled request, +`handleDeepAt` eliminates that label and preserves the residual row, +`handleShallowAt` retains the complete source row, and `runPure` requires the +empty row. Projection uses the ordinary upstream `on` function. These wrappers +introduce no compiler operation identity, union selector or extra intrinsic. +They are a Control library, distinct from reference Run/Free acceptance. + Below, `project` is a library Church-encoded split, and `pure` wraps the compiler return primitive. `Pair s a` abbreviates `{ _1 :: s, _2 :: a }`. @@ -488,6 +496,12 @@ must still cover it. ## Code map +The source signature, immutable layout planning, guest executor and public +deep/shallow wrappers are implemented. The table also includes required checks +whose complete coverage is still open; local constructor/provenance checks do +not prove the whole execution algorithm. Current implementation and runtime +evidence are recorded in the acceptance checklist. + | Owner | Required responsibility | | --- | --- | | Intrinsic registry and checked Core | One revised `ControlHandle` scheme and checked occurrence contract; quantified request/answer relationships | diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 5b778cce..52cdbbf2 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -1,7 +1,8 @@ # Delimited Control and Resumable Frames **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) -**Status:** Draft design. The mechanism is selected by +**Status:** Selected design; contract v2 is partially implemented, complete +acceptance remains outstanding. The mechanism is selected by [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md). **Prerequisites:** [DEC-03](../../../decision/DEC-03-purescript-faithful-type-system.md), [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), @@ -443,9 +444,14 @@ run(state): Resume(k, v) -> state.current = k.install(v) ``` -Because the loop drives every step, the native Wasm stack does not grow with the -depth of binds or with long request sequences. Deep recursion in direct style -becomes bounded frame churn, the same way a self tail call becomes a loop. Using +This is a schematic driver, not the exact constructor inventory. The implemented +CC machine uses `Return`, `Perform`, `Bind`, `Handle`, `Resume` and `OwnedResume`, +with explicit queues and source/target contexts. + +Because the loop drives control steps, the native Wasm stack does not grow with +the depth of interpreted binds or with long machine request sequences. Ordinary +recursive user callbacks are not converted into frames by this monadic lowering; +their stack behavior follows ordinary call and tail-call lowering. Using `return_call`/`return_call_ref` for the tail positions of the emitted steps keeps the constant-stack property even where the machine calls into ordinary code. @@ -513,11 +519,16 @@ stack slots for roots and owns the stack's lifetime Suspension cannot cross a non-suspendable host or foreign frame: a captured continuation that spans a canonical-ABI call or an in-progress WIT import cannot be -resumed without that boundary's cooperation. The lowering rejects a conversion that +resumed without that boundary's cooperation. The lowering must reject a conversion that would capture across such a boundary unless the boundary declares an explicit suspension protocol. A continuation also cannot retain a borrowed canonical-ABI buffer or a host-resource reference past the boundary's lifetime. +The current explicit monadic lowering captures guest queue/context data, not +native host frames. This does not discharge captured-resource lifetime checks or +caught-host-trap cleanup. Those remain required acceptance obligations; no +complete foreign-boundary verifier or recovery protocol is claimed here. + ### The executor and the runtime boundary The eliminator's driver — the trampoline of [The trampoline](#the-trampoline) — is the @@ -688,7 +699,9 @@ rather than a documented expectation. ## Code map -This is the design target, not a claim that these APIs exist yet: +The source primitives and guest machine exist. This map states their owners and +required responsibilities; it does not imply every verifier or foreign-boundary +obligation is implemented. | Location | Intended responsibility | | --- | --- | @@ -700,6 +713,23 @@ This is the design target, not a claim that these APIs exist yet: | `psrs-runtime` (software form) | GC heap, leaf primitives, trap, and linking; provides no continuation and must not learn the frame layout | | Runtime control owner, only if separately adopted | Stack-switching ABI, captured-root storage, lifecycle checks, and capability requirements | +The implementation locations are `psrs-hir/src/intrinsic/registry.rs`, checked +Core control contracts, `psrs-backend/src/cc/layout/control/`, +`cc/lower/control/`, `cc/verify/control/` and `mir/control/`. Layout planning +reserves nominal Control/Resumption carriers and all synthesized signatures +before CC lowering freezes the representation table. Ordinary carrier parameters, +results, captures and joins use these nominal representations; only explicit +abstract user-payload/storage boundaries erase and recover values. The executor +does not reconstruct a complete source type from erased data. + +The eight source primitives retain their identities, with `handle` identity 96 +and arity three under contract v2. The independent package/compiler contract is +versioned as `control_protocol: 2`. Full row-library and reference-library +acceptance remain distinct from the existing closed/open machine fixtures. +Upstream `Free`/`Run` executes its ordinary library representation; it is not an +alternative implementation of the compiler's Control machine, and the native +Effect/ST prototype is not evidence that this topic is complete. + No compiler-side operation registry, handler IR, or effect-specific solver is required. The runtime carries no continuation for the software form; runtime control module names and entry-point signatures remain unselected until a target option is @@ -769,6 +799,11 @@ remains a closed fold. Migration, context-frame verification, replay activation identity and finalization coalescing require the evidence in the scope topic. The following remain open. +Finish production/library migration with focused execution evidence, then close +the complete structural and malformed-IR checks at the stable stage contracts. +Complete delimited-control acceptance precedes native Effect/ST public migration. +Required acceptance scope is unchanged by this implementation order. + 1. **Direct-style surface sugar.** Effect typing is out of scope (see [Scope](#scope)). A non-typed syntax that desugars to the monadic API is a separate, uncommitted option; it would add no effect tracking, but it would add diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index 8eb6f742..e0c2762f 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -1,5 +1,49 @@ # Control Reference-Library Migration Baseline +## Review continuation and labelled Control rows + +The continuation from `06f8e79b` removes the unresolved `~>` arrow fallback. +Bare and infix aliases now share lookup and require a declaration or visible +import. Four new regression tests and existing operator tests pass: 20 focused +tests with mandatory Wasmtime. Official `purs` rejects absent bare/infix and +hidden aliases with `UnknownName` and accepts an explicit Function alias. +The operator test module was split below 500 lines. The native prototype now +checks the String read against `"b"`; its focused Wasmtime test passes. These +changes do not advance native public migration ahead of delimited control. + +The selected design/code map is aligned with the existing nominal Control +machine, immutable signature planning and explicit monadic capture boundary. +It no longer attributes ordinary direct-style recursion to machine stack safety +or describes existing source APIs as absent. Foreign capture and caught-host +cleanup remain required, unverified obligations. + +The independent package `baf285f8acdccbeb4f3ff8e5315b153400e69f0d`, fingerprint +`fnv1a64-v1:ecebcb4301e7039a`, adds every unchanged source module from +Variant v8.0.0 and `PSRS.Control.Row`, with registered trusted-module inventory. +The ordinary wrappers provide labelled injection, deep elimination, shallow +residual preservation and an empty-row runner. Two public fixtures compile and +execute to 42: deep forwarding/reinstallation observes counts 2/1; shallow escape +observes counts 1/1. A nonempty residual row at `runPure` rejects in P5 with +`TypesDoNotUnify`. Evidence is under `rows-deep-public/`, `rows-shallow-public/` +and `rows-residual-final.json` in the existing temporary evidence root; final +runtime reports are `rows-deep-final/run.json` and `rows-shallow-final/run.json`. +The full source audit is 42 packages / 235 modules: 175 identical, 34 modified, +26 target additions, no missing upstream modules or detected direct recursion. + +Pure reference Run is a separate migration obligation. The exact Parallel +v6.0.0 (`85290dca837771ac4870071008c933d315ef678f`) and DateTime v6.0.0 +(`a6a0cf1b0324964ad1854bc3377ed8766ba90e6f`) pins resolve its missing Aff +dependency imports. An explicit unchanged-source closure of 28 modules reaches +kind checking; the first blocker is `PartiallyAppliedSynonym` for valid +`STATE s + r` applications, not missing native Effect execution. +`run-reference-closure-inventory.json`, `run-files-list.txt` and +`run-pure-before.json` retain this evidence. The next owner to repair is synonym +application normalization at the kind boundary; preserve the upstream source. + +Validation scope is focused by explicit user instruction. Full workspace tests, +workspace clippy and complete ignored scoreboards were not rerun for this +continuation. Existing full statuses and gate measurements remain unchanged. + **Date:** 2026-10-12. **Starting compiler:** `7a6dae8985d39124a019bce7bd3b8b6a421c8166`, with an diff --git a/stdlib.lock.json b/stdlib.lock.json index 2827d67c..e9d76d0d 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "407de2618ef2f5b43befc572bdc787d94287f1eb", - "source_fingerprint": "fnv1a64-v1:f29cc57fc1e691f4" + "revision": "baf285f8acdccbeb4f3ff8e5315b153400e69f0d", + "source_fingerprint": "fnv1a64-v1:ecebcb4301e7039a" } From 6703863d255797304c3933f0a61f130cb389e23a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 21:21:45 +0800 Subject: [PATCH 131/148] Normalize higher-order synonym applications before saturation and elaboration --- crates/psrs-driver/src/tests/operators/mod.rs | 1 + .../src/tests/operators/synonyms.rs | 40 +++++++++ crates/psrs-kind/src/check/infer/type_kind.rs | 77 +++++++++-------- crates/psrs-kind/src/check/mod.rs | 22 ++--- crates/psrs-kind/src/check/roles/mod.rs | 2 +- .../src/check/{roles => }/synonyms.rs | 82 ++++++++++++------- crates/psrs-kind/src/kind.rs | 9 ++ crates/psrs-kind/src/tests/mod.rs | 1 + crates/psrs-kind/src/tests/synonyms.rs | 61 ++++++++++++++ .../psrs-typecheck/src/typecheck/signature.rs | 12 +++ .../delimited-control-and-resumable-frames.md | 7 ++ docs/design/frontend/type-system/kinds.md | 15 +++- ...-reference-library-migration-2026-10-12.md | 30 ++++++- 13 files changed, 274 insertions(+), 85 deletions(-) create mode 100644 crates/psrs-driver/src/tests/operators/synonyms.rs rename crates/psrs-kind/src/check/{roles => }/synonyms.rs (65%) create mode 100644 crates/psrs-kind/src/tests/synonyms.rs diff --git a/crates/psrs-driver/src/tests/operators/mod.rs b/crates/psrs-driver/src/tests/operators/mod.rs index a6728feb..c9e164dc 100644 --- a/crates/psrs-driver/src/tests/operators/mod.rs +++ b/crates/psrs-driver/src/tests/operators/mod.rs @@ -4,6 +4,7 @@ mod opaque_type; mod prim_type; mod qualified_patterns; mod sections; +mod synonyms; use super::*; diff --git a/crates/psrs-driver/src/tests/operators/synonyms.rs b/crates/psrs-driver/src/tests/operators/synonyms.rs new file mode 100644 index 00000000..0c3d9c99 --- /dev/null +++ b/crates/psrs-driver/src/tests/operators/synonyms.rs @@ -0,0 +1,40 @@ +use super::*; + +#[test] +fn higher_order_alias_arguments_are_substituted_before_elaboration() { + let source = r"module Main where +type Apply f x = f x +type Ignore f = Int +type Wrap a b = { value :: a, other :: b } +value :: Apply (Apply (Wrap Int)) Boolean +value = { value: 42, other: true } +main :: Ignore (Wrap Int) +main = value.value +"; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn open_row_alias_operator_preserves_the_row_tail() { + let source = r"module Main where +type RowApply f a = f a +infixr 0 type RowApply as + +type VALUE r = (value :: Int | r) +read :: forall r. Record (VALUE + r) -> Int +read row = row.value +main = read { value: 42, other: true } +"; + typecheck_program_sources(&[("Main.purs", source)]) + .expect("the open tail survives kind checking and elaboration"); + let closed = source.replace( + "forall r. Record (VALUE + r)", + "Record (VALUE + (other :: Boolean))", + ); + let Some(output) = run_with_wasmtime(&closed) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-kind/src/check/infer/type_kind.rs b/crates/psrs-kind/src/check/infer/type_kind.rs index 5279e73a..0db195ce 100644 --- a/crates/psrs-kind/src/check/infer/type_kind.rs +++ b/crates/psrs-kind/src/check/infer/type_kind.rs @@ -32,17 +32,22 @@ impl Checker<'_> { scope: &mut HashMap, report_partial_synonym: bool, ) -> Kind { + if report_partial_synonym { + self.check_annotation_saturation(ty); + } + self.infer_type_kind(ty, scope) + } + + // Infer the original application so even arguments discarded by synonym + // expansion must satisfy the declaration's checked parameter kinds. + fn infer_type_kind(&mut self, ty: &hir::Type, scope: &mut HashMap) -> Kind { match &ty.kind { TypeKind::Wildcard => self.fresh(), TypeKind::Application(..) => { let (head, arguments) = flatten_spine(ty); - if report_partial_synonym { - self.check_partial_synonym(head, arguments.len(), ty.span); - } let mut function = self.head_kind(head, scope); for argument in arguments { - let argument = - self.kind_of_type_against(argument, scope, report_partial_synonym); + let argument = self.infer_type_kind(argument, scope); let result = self.fresh(); self.unify( function, @@ -61,10 +66,7 @@ impl Checker<'_> { ); self.fresh() } - TypeKind::Named(id) | TypeKind::Opaque(id) => { - self.check_partial_synonym(ty, 0, ty.span); - self.instantiate_named(*id, ty.span) - } + TypeKind::Named(id) | TypeKind::Opaque(id) => self.instantiate_named(*id, ty.span), TypeKind::Constructor(BuiltinType::Function) => { // A bare `(->)` is the function type constructor itself, of kind // `Type -> Type -> Type`, and applies nothing. It is how a @@ -108,7 +110,7 @@ impl Checker<'_> { }), TypeKind::Constructor(builtin) => primitive_kind(*builtin), TypeKind::Named(id) | TypeKind::Opaque(id) => self.instantiate_named(*id, ty.span), - TypeKind::Application(..) => self.kind_of_type(ty, scope), + TypeKind::Application(..) => self.infer_type_kind(ty, scope), TypeKind::OperatorChain { .. } => { self.report( UNLOWERED_TYPE_OPERATOR, @@ -118,9 +120,9 @@ impl Checker<'_> { self.fresh() } TypeKind::Function { parameter, result } => { - let parameter_kind = self.kind_of_type(parameter, scope); + let parameter_kind = self.infer_type_kind(parameter, scope); self.unify(parameter_kind, type_kind(), parameter.span); - let result_kind = self.kind_of_type(result, scope); + let result_kind = self.infer_type_kind(result, scope); self.unify(result_kind, type_kind(), result.span); type_kind() } @@ -133,23 +135,23 @@ impl Checker<'_> { }; scope.insert(variable.name.clone(), kind); } - let kind = self.kind_of_type(body, scope); + let kind = self.infer_type_kind(body, scope); *scope = saved; kind } TypeKind::Constrained { constraint, body } => { - let constraint_kind = self.kind_of_type(constraint, scope); + let constraint_kind = self.infer_type_kind(constraint, scope); self.unify(constraint_kind, super::constraint_kind(), constraint.span); - self.kind_of_type(body, scope) + self.infer_type_kind(body, scope) } TypeKind::Row { fields, tail } => { let field_kind = self.fresh(); for field in fields { - let kind = self.kind_of_type(&field.ty, scope); + let kind = self.infer_type_kind(&field.ty, scope); self.unify(kind, field_kind.clone(), field.ty.span); } if let Some(tail) = tail { - let tail_kind = self.kind_of_type(tail, scope); + let tail_kind = self.infer_type_kind(tail, scope); self.unify(tail_kind, Kind::row(field_kind.clone()), tail.span); } Kind::row(field_kind) @@ -157,11 +159,11 @@ impl Checker<'_> { TypeKind::Record { fields, tail } => { let field_kind = self.fresh(); for field in fields { - let kind = self.kind_of_type(&field.ty, scope); + let kind = self.infer_type_kind(&field.ty, scope); self.unify(kind, field_kind.clone(), field.ty.span); } if let Some(tail) = tail { - let tail_kind = self.kind_of_type(tail, scope); + let tail_kind = self.infer_type_kind(tail, scope); self.unify(tail_kind, Kind::row(field_kind), tail.span); } type_kind() @@ -178,44 +180,51 @@ impl Checker<'_> { /// `newtype C (a :: (->) (Type -> Type) -> Type)` is a partially applied /// synonym whether the expression is read as a kind or as a type. pub(in crate::check) fn check_annotation_saturation(&mut self, ty: &hir::Type) { + // A saturated outer alias can apply or discard a partial alias + // argument. Only aliases surviving substitution require saturation. + let expanded = super::super::synonyms::expand(ty, &self.synonyms); + self.check_normalized_saturation(expanded.as_ref().unwrap_or(ty), ty.span); + } + + fn check_normalized_saturation(&mut self, ty: &hir::Type, use_span: TextRange) { match &ty.kind { TypeKind::Application(..) => { let (head, arguments) = flatten_spine(ty); - self.check_partial_synonym(head, arguments.len(), ty.span); - self.check_annotation_saturation(head); + self.check_partial_synonym(head, arguments.len(), use_span); for argument in arguments { - self.check_annotation_saturation(argument); + self.check_normalized_saturation(argument, use_span); } } TypeKind::Function { parameter, result } => { - self.check_annotation_saturation(parameter); - self.check_annotation_saturation(result); + self.check_normalized_saturation(parameter, use_span); + self.check_normalized_saturation(result, use_span); } TypeKind::Forall { variables, body } => { for variable in variables { if let Some(annotation) = &variable.kind { - self.check_annotation_saturation(annotation); + self.check_normalized_saturation(annotation, use_span); } } - self.check_annotation_saturation(body); + self.check_normalized_saturation(body, use_span); } TypeKind::Constrained { constraint, body } => { - self.check_annotation_saturation(constraint); - self.check_annotation_saturation(body); + self.check_normalized_saturation(constraint, use_span); + self.check_normalized_saturation(body, use_span); } TypeKind::Row { fields, tail } | TypeKind::Record { fields, tail } => { for field in fields { - self.check_annotation_saturation(&field.ty); + self.check_normalized_saturation(&field.ty, use_span); } if let Some(tail) = tail { - self.check_annotation_saturation(tail); + self.check_normalized_saturation(tail, use_span); } } + TypeKind::Named(_) | TypeKind::Opaque(_) => { + self.check_partial_synonym(ty, 0, use_span); + } TypeKind::Variable(_) | TypeKind::Wildcard | TypeKind::Constructor(_) - | TypeKind::Named(_) - | TypeKind::Opaque(_) | TypeKind::OperatorChain { .. } | TypeKind::Integer(_) | TypeKind::String(_) => {} @@ -229,8 +238,8 @@ impl Checker<'_> { span: TextRange, ) { if let TypeKind::Named(id) = &head.kind - && let Some(arity) = self.synonym_arity.get(id) - && arguments < *arity + && let Some(synonym) = self.synonyms.get(id) + && arguments < synonym.parameters.len() { self.report( PARTIALLY_APPLIED_SYNONYM, diff --git a/crates/psrs-kind/src/check/mod.rs b/crates/psrs-kind/src/check/mod.rs index 20fa303f..fc4526d5 100644 --- a/crates/psrs-kind/src/check/mod.rs +++ b/crates/psrs-kind/src/check/mod.rs @@ -10,6 +10,7 @@ use std::collections::HashMap; mod infer; mod roles; +pub(crate) mod synonyms; /// Official `errorCode`s this pass reports. pub const KINDS_DO_NOT_UNIFY: &str = "KindsDoNotUnify"; @@ -71,7 +72,7 @@ struct Checker<'a> { /// The schemes this run knows: the program's checked schemes, overwritten by /// the declarations this run checks. schemes: HashMap, - synonym_arity: HashMap, + synonyms: synonyms::SynonymMap, state: KindState, errors: Vec, } @@ -88,7 +89,7 @@ impl<'a> Checker<'a> { declaring, names, schemes: HashMap::new(), - synonym_arity: synonym_arities(modules), + synonyms: synonyms::collect(modules), state: coercible_state(), errors: Vec::new(), } @@ -99,13 +100,15 @@ impl<'a> Checker<'a> { let (declaring, names) = declaration_index(modules); let mut schemes = imported.kinds.clone(); schemes.extend(coercible_scheme()); + let mut synonyms = imported.synonyms.clone(); + synonyms.extend(synonyms::collect(modules)); Self { current: module.id, modules, declaring, names, schemes, - synonym_arity: synonym_arities(modules), + synonyms, state: coercible_state(), errors: Vec::new(), } @@ -158,6 +161,7 @@ impl<'a> Checker<'a> { roles, kinds: self.checked_schemes(), declaring_module, + synonyms: self.synonyms.clone(), } } @@ -389,15 +393,3 @@ fn declaration_index( } (declaring, names) } - -fn synonym_arities(modules: &[hir::Module]) -> HashMap { - let mut arities = HashMap::new(); - for module in modules { - for declaration in &module.types { - if declaration.kind == TypeDeclarationKind::TypeSynonym { - arities.insert(declaration.id, declaration.parameters.len()); - } - } - } - arities -} diff --git a/crates/psrs-kind/src/check/roles/mod.rs b/crates/psrs-kind/src/check/roles/mod.rs index 98dc6d4f..479e3508 100644 --- a/crates/psrs-kind/src/check/roles/mod.rs +++ b/crates/psrs-kind/src/check/roles/mod.rs @@ -2,7 +2,7 @@ use super::*; use psrs_hir::{BuiltinType, ModuleId}; use std::collections::HashSet; -mod synonyms; +use super::synonyms; /// Infers representation roles for every data, newtype, and foreign-data type in a /// resolved program. Explicit annotations constrain the published roles and diff --git a/crates/psrs-kind/src/check/roles/synonyms.rs b/crates/psrs-kind/src/check/synonyms.rs similarity index 65% rename from crates/psrs-kind/src/check/roles/synonyms.rs rename to crates/psrs-kind/src/check/synonyms.rs index 1a7ba2f5..edc66c5b 100644 --- a/crates/psrs-kind/src/check/roles/synonyms.rs +++ b/crates/psrs-kind/src/check/synonyms.rs @@ -1,16 +1,17 @@ use psrs_hir::{self as hir, TypeId, TypeKind}; -use std::collections::{HashMap, HashSet}; +use std::collections::HashMap; -#[derive(Clone)] -pub(super) struct Synonym { - parameters: Vec, +#[derive(Clone, Debug, PartialEq, Eq)] +pub(crate) struct Synonym { + pub(super) parameters: Vec, body: hir::Type, + cyclic: bool, } -pub(super) type SynonymMap = HashMap; +pub(crate) type SynonymMap = HashMap; pub(super) fn collect(modules: &[hir::Module]) -> SynonymMap { - modules + let mut definitions: SynonymMap = modules .iter() .flat_map(|module| &module.types) .filter(|declaration| declaration.kind == hir::TypeDeclarationKind::TypeSynonym) @@ -24,20 +25,41 @@ pub(super) fn collect(modules: &[hir::Module]) -> SynonymMap { .map(|parameter| parameter.name.clone()) .collect(), body: declaration.body.clone()?, + cyclic: false, }, )) }) - .collect() + .collect(); + let edges = definitions + .iter() + .map(|(&id, item)| { + let mut references = Vec::new(); + crate::kind::collect_type_ids(&item.body, &mut references); + ( + id, + references + .into_iter() + .map(|id| (id, item.body.span)) + .collect(), + ) + }) + .collect(); + for (id, _) in crate::kind::detect_cycle(definitions.keys().copied(), &edges) { + if let Some(item) = definitions.get_mut(&id) { + item.cyclic = true; + } + } + definitions } -pub(super) fn expand(ty: &hir::Type, synonyms: &SynonymMap) -> Option { - expand_inner(ty, synonyms, &mut HashSet::new(), &mut 0) +pub(crate) fn expand(ty: &hir::Type, synonyms: &SynonymMap) -> Option { + expand_inner(ty, synonyms, &mut 65_536, &mut 0) } fn expand_inner( ty: &hir::Type, synonyms: &SynonymMap, - active: &mut HashSet, + fuel: &mut usize, next_fresh: &mut u32, ) -> Option { let kind = match &ty.kind { @@ -46,11 +68,11 @@ fn expand_inner( .get(id) .is_some_and(|item| item.parameters.is_empty()) => { - return expand_synonym(*id, Vec::new(), synonyms, active, next_fresh); + return expand_synonym(*id, Vec::new(), synonyms, fuel, next_fresh); } TypeKind::Application(function, argument) => { - let function = expand_inner(function, synonyms, active, next_fresh)?; - let argument = expand_inner(argument, synonyms, active, next_fresh)?; + let function = expand_inner(function, synonyms, fuel, next_fresh)?; + let argument = expand_inner(argument, synonyms, fuel, next_fresh)?; let applied = hir::Type { kind: TypeKind::Application(Box::new(function), Box::new(argument)), span: ty.span, @@ -60,13 +82,13 @@ fn expand_inner( && let Some(synonym) = synonyms.get(&id) && synonym.parameters.len() == arguments.len() { - return expand_synonym(id, arguments, synonyms, active, next_fresh); + return expand_synonym(id, arguments, synonyms, fuel, next_fresh); } return Some(applied); } TypeKind::Function { parameter, result } => TypeKind::Function { - parameter: Box::new(expand_inner(parameter, synonyms, active, next_fresh)?), - result: Box::new(expand_inner(result, synonyms, active, next_fresh)?), + parameter: Box::new(expand_inner(parameter, synonyms, fuel, next_fresh)?), + result: Box::new(expand_inner(result, synonyms, fuel, next_fresh)?), }, TypeKind::Forall { variables, body } => TypeKind::Forall { variables: variables @@ -76,29 +98,29 @@ fn expand_inner( name: variable.name.clone(), name_span: variable.name_span, kind: match &variable.kind { - Some(kind) => Some(expand_inner(kind, synonyms, active, next_fresh)?), + Some(kind) => Some(expand_inner(kind, synonyms, fuel, next_fresh)?), None => None, }, }) }) .collect::>>()?, - body: Box::new(expand_inner(body, synonyms, active, next_fresh)?), + body: Box::new(expand_inner(body, synonyms, fuel, next_fresh)?), }, TypeKind::Constrained { constraint, body } => TypeKind::Constrained { - constraint: Box::new(expand_inner(constraint, synonyms, active, next_fresh)?), - body: Box::new(expand_inner(body, synonyms, active, next_fresh)?), + constraint: Box::new(expand_inner(constraint, synonyms, fuel, next_fresh)?), + body: Box::new(expand_inner(body, synonyms, fuel, next_fresh)?), }, TypeKind::Row { fields, tail } => TypeKind::Row { - fields: expand_fields(fields, synonyms, active, next_fresh)?, + fields: expand_fields(fields, synonyms, fuel, next_fresh)?, tail: match tail { - Some(tail) => Some(Box::new(expand_inner(tail, synonyms, active, next_fresh)?)), + Some(tail) => Some(Box::new(expand_inner(tail, synonyms, fuel, next_fresh)?)), None => None, }, }, TypeKind::Record { fields, tail } => TypeKind::Record { - fields: expand_fields(fields, synonyms, active, next_fresh)?, + fields: expand_fields(fields, synonyms, fuel, next_fresh)?, tail: match tail { - Some(tail) => Some(Box::new(expand_inner(tail, synonyms, active, next_fresh)?)), + Some(tail) => Some(Box::new(expand_inner(tail, synonyms, fuel, next_fresh)?)), None => None, }, }, @@ -113,7 +135,7 @@ fn expand_inner( fn expand_fields( fields: &[hir::TypeField], synonyms: &SynonymMap, - active: &mut HashSet, + fuel: &mut usize, next_fresh: &mut u32, ) -> Option> { fields @@ -122,7 +144,7 @@ fn expand_fields( Some(hir::TypeField { label: field.label.clone(), label_span: field.label_span, - ty: expand_inner(&field.ty, synonyms, active, next_fresh)?, + ty: expand_inner(&field.ty, synonyms, fuel, next_fresh)?, span: field.span, }) }) @@ -133,13 +155,14 @@ fn expand_synonym( id: TypeId, arguments: Vec, synonyms: &SynonymMap, - active: &mut HashSet, + fuel: &mut usize, next_fresh: &mut u32, ) -> Option { let synonym = synonyms.get(&id)?; - if synonym.parameters.len() != arguments.len() || !active.insert(id) { + if synonym.parameters.len() != arguments.len() || synonym.cyclic || *fuel == 0 { return None; } + *fuel -= 1; let mapping = synonym .parameters .iter() @@ -147,8 +170,7 @@ fn expand_synonym( .zip(arguments) .collect::>(); let instantiated = hir::substitute_type_variables(&synonym.body, &mapping, next_fresh); - let expanded = expand_inner(&instantiated, synonyms, active, next_fresh); - active.remove(&id); + let expanded = expand_inner(&instantiated, synonyms, fuel, next_fresh); expanded } diff --git a/crates/psrs-kind/src/kind.rs b/crates/psrs-kind/src/kind.rs index 5c7d0782..1c7fa098 100644 --- a/crates/psrs-kind/src/kind.rs +++ b/crates/psrs-kind/src/kind.rs @@ -117,9 +117,18 @@ pub struct CheckedKindEnv { /// The module that declares each entry, so a use in one module is checked /// against, and reported against, the module that declared the type. pub declaring_module: HashMap, + /// Checked synonym templates retained for expansion during module rechecks. + pub(crate) synonyms: crate::check::synonyms::SynonymMap, } impl CheckedKindEnv { + /// Expands saturated synonyms with capture-avoiding substitution before + /// consumers elaborate their arguments. Returns `None` for a declaration + /// cycle or when the bounded expansion cannot finish. + pub fn expand_synonyms(&self, ty: &psrs_hir::Type) -> Option { + crate::check::synonyms::expand(ty, &self.synonyms) + } + pub fn roles(&self, id: TypeId) -> Option<&[Role]> { self.roles.get(&id).map(Vec::as_slice) } diff --git a/crates/psrs-kind/src/tests/mod.rs b/crates/psrs-kind/src/tests/mod.rs index a99ffe37..7a848146 100644 --- a/crates/psrs-kind/src/tests/mod.rs +++ b/crates/psrs-kind/src/tests/mod.rs @@ -9,6 +9,7 @@ mod declarations; mod instances; mod program; mod roles; +mod synonyms; pub(super) fn check(source: &str) -> Vec { check_modules(&[resolve(source)]) diff --git a/crates/psrs-kind/src/tests/synonyms.rs b/crates/psrs-kind/src/tests/synonyms.rs new file mode 100644 index 00000000..2fbc5838 --- /dev/null +++ b/crates/psrs-kind/src/tests/synonyms.rs @@ -0,0 +1,61 @@ +use super::*; + +#[test] +fn saturated_aliases_apply_or_discard_their_partial_alias_arguments() { + for usage in ["Apply (Wrap Int) Boolean", "Ignore (Wrap Int)"] { + check_ok(&format!( + "module Main where\ntype Apply f x = f x\ntype Ignore f = Int\ntype Wrap a b = {{ first :: a, second :: b }}\nvalue :: {usage}\nvalue = value\n" + )); + } +} + +#[test] +fn applying_an_open_row_alias_normalizes_before_saturation() { + check_ok( + "module Main where\ntype Apply f x = f x\ntype STATE s r = (state :: Array s | r)\nvalue :: Record (Apply (STATE Int) ())\nvalue = value\n", + ); +} + +#[test] +fn repeated_higher_order_alias_application_is_not_a_declaration_cycle() { + check_ok( + "module Main where\ntype Apply f x = f x\ntype Wrap a b = { first :: a, second :: b }\nvalue :: Apply (Apply (Wrap Int)) Boolean\nvalue = value\n", + ); +} + +#[test] +fn a_remaining_partial_alias_under_a_data_constructor_is_rejected() { + let errors = check( + "module Main where\ndata Holder f = Holder (f Boolean)\ntype Wrap a b = { first :: a, second :: b }\nvalue :: Holder (Wrap Int)\nvalue = value\n", + ); + assert!( + codes(&errors).contains(&"PartiallyAppliedSynonym"), + "{errors:?}" + ); +} + +#[test] +fn module_rechecks_retain_imported_alias_templates_and_arity() { + let modules = resolve_program(&[ + ( + "Alias.purs", + "module Alias where\ntype Apply f x = f x\ntype Wrap a b = { first :: a, second :: b }\n", + ), + ( + "Main.purs", + "module Main where\nimport Alias (Apply, Wrap)\nvalue :: Apply (Wrap Int) Boolean\nvalue = value\n", + ), + ]); + let (environment, errors) = check_env(&modules); + assert!(errors.is_empty(), "{errors:?}"); + let errors = crate::check_module(&modules[1], &environment); + assert!(errors.is_empty(), "{errors:?}"); +} + +#[test] +fn discarded_alias_arguments_still_satisfy_declared_kinds() { + let errors = check( + "module Main where\ntype Ignore :: Type -> Type\ntype Ignore a = Int\nvalue :: Ignore Array\nvalue = value\n", + ); + assert!(codes(&errors).contains(&"KindsDoNotUnify"), "{errors:?}"); +} diff --git a/crates/psrs-typecheck/src/typecheck/signature.rs b/crates/psrs-typecheck/src/typecheck/signature.rs index 168e9ac4..4de37a11 100644 --- a/crates/psrs-typecheck/src/typecheck/signature.rs +++ b/crates/psrs-typecheck/src/typecheck/signature.rs @@ -83,6 +83,11 @@ impl Checker { rigid: bool, quantified: &mut Vec, ) -> (Vec, InferType) { + if let Some(expanded) = self.env.checked_kinds.expand_synonyms(ty) + && expanded != *ty + { + return self.elaborate_constraint_spine(&expanded, variables, rigid, quantified); + } match &ty.kind { hir::TypeKind::Forall { variables: binders, @@ -125,6 +130,13 @@ impl Checker { variables: &mut HashMap, rigid_variables: bool, ) -> InferType { + // Substitute in HIR before elaborating arguments: a saturated outer + // alias may apply a partial alias argument or discard it altogether. + if let Some(expanded) = self.env.checked_kinds.expand_synonyms(ty) + && expanded != *ty + { + return self.elaborate_type_mode(&expanded, variables, rigid_variables); + } match &ty.kind { hir::TypeKind::Wildcard => self.fresh(), hir::TypeKind::Variable(name) => { diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 52cdbbf2..e10d310a 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -730,6 +730,13 @@ Upstream `Free`/`Run` executes its ordinary library representation; it is not an alternative implementation of the compiler's Control machine, and the native Effect/ST prototype is not evidence that this topic is complete. +The current pure Run migration resolves the unchanged Aff import closure and +passes higher-order row-alias kind checking and signature expansion. It still +rejects the `runMonadEffect` instance member in term checking. This is a frontend +migration blocker; native Aff execution has not been demonstrated as a dependency +of the pure entry. The [reference migration record](../../../implementation/backend/control-reference-library-migration-2026-10-12.md) +keeps compilation, runtime evidence and remaining full acceptance separate. + No compiler-side operation registry, handler IR, or effect-specific solver is required. The runtime carries no continuation for the software form; runtime control module names and entry-point signatures remain unselected until a target option is diff --git a/docs/design/frontend/type-system/kinds.md b/docs/design/frontend/type-system/kinds.md index 7e78379e..d1ef957c 100644 --- a/docs/design/frontend/type-system/kinds.md +++ b/docs/design/frontend/type-system/kinds.md @@ -29,7 +29,8 @@ Kind = Builtin(BuiltinType) | Named(TypeId) # a constructor read as a kind | App(Kind, Kind) | Function(Kind, Kind) | Variable(KindVarId) KindScheme = { quantified_kind_vars, kind } CheckedKindEnv = { kind_schemes: TypeId -> KindScheme, roles: TypeId -> [Role], - declaring_module: TypeId -> ModuleId } + declaring_module: TypeId -> ModuleId, + synonym_templates: TypeId -> { parameters, body } } KindDiagnostic = { code, span, message, origin: ModuleId } CheckedTypeConstructor = { id, kind_scheme, arity, roles, origin } ``` @@ -75,7 +76,17 @@ wrong number of arguments is an arity error owned by the class environment, so the kind check leaves it alone rather than reporting `KindsDoNotUnify` where `ClassInstanceArityMismatch` is the official code. -Reject cyclic synonyms and unsaturated synonym use, including a partial synonym in a higher-kinded position. Ordinary data/newtype constructors may be partially applied when the expected kind allows it. Infer data/newtype roles from constructor fields to a fixed point across the resolved module graph, then check explicit annotations. Foreign data has no constructor fields from which to infer roles, so it is nominal by default; an explicit role annotation is its trusted interface contract. Keep source ranges on all kind uses and role annotations. +Reject cyclic synonyms and unsaturated synonym use that remains after +capture-avoiding substitution of saturated outer aliases. A partially supplied +alias argument is valid when that substitution applies its remaining parameters +or discards it: `Apply (Wrap Int) Boolean` and `Ignore (Wrap Int)` are accepted, +while `Holder (Wrap Int)` still rejects. Infer kinds from the original application +so discarded arguments must satisfy the alias's declared parameter kinds. +Checked environments retain imported synonym templates. Kind saturation, role +analysis and checked signature elaboration consume the same HIR expansion; +term elaboration expands before converting arguments into inference types. +Declaration-cycle guards are distinct from repeated higher-order application of +an acyclic alias. Ordinary data/newtype constructors may be partially applied when the expected kind allows it. Infer data/newtype roles from constructor fields to a fixed point across the resolved module graph, then check explicit annotations. Foreign data has no constructor fields from which to infer roles, so it is nominal by default; an explicit role annotation is its trusted interface contract. Keep source ranges on all kind uses and role annotations. A `Type | Row(Type) | Arrow` enum is rejected because it cannot express `Symbol` or polymorphic kinds. Eager synonym expansion before cycle checking is rejected because it may diverge. Two kind checkers, one per module, are rejected because a program-level conflict found by one run is not guaranteed to be found again by the other, so the diagnostic that matters depends on which entry point the driver chose. diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index e0c2762f..3255743b 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -40,6 +40,27 @@ kind checking; the first blocker is `PartiallyAppliedSynonym` for valid `run-pure-before.json` retain this evidence. The next owner to repair is synonym application normalization at the kind boundary; preserve the upstream source. +The current compiler repairs that boundary and term signature elaboration with +one capture-avoiding HIR expander shared with role inference. Saturation is checked +after substitution, while kinds are inferred from original arguments, including +arguments discarded by an outer alias. Checked per-module environments retain +imported alias templates. The focused kind suite passes 38 tests; two source tests +cover higher-order application/discard and a row alias operator. The open record +version is typecheck evidence only because generic open record layouts still +reject at P8; the closed row version executes to 42 under mandatory Wasmtime, +as does the higher-order application/discard fixture. Official `purs` and file +diagnosis agree on repeated higher-order application (accepted), a partial alias +remaining under a data constructor (`PartiallyAppliedSynonym`), and an incorrectly +kinded discarded argument (`KindsDoNotUnify`); `row-synonym-kind/summary.json` +records those comparisons. + +The current explicit closure omits the three Variant inputs now supplied by the +pinned package (`run-files-current-list.txt`). `run-pure-after-kind.json` reaches +term checking; `run-pure-after-elaboration.json` removes its alias diagnostics and +leaves one `TypesDoNotUnify` at the unchanged `runMonadEffect` instance member. +Pure Run remains incomplete. Its next blocker is consumption of given type +relations during instance-member checking, not demonstrated Aff execution. + Validation scope is focused by explicit user instruction. Full workspace tests, workspace clippy and complete ignored scoreboards were not rerun for this continuation. Existing full statuses and gate measurements remain unchanged. @@ -344,7 +365,8 @@ Two real frontend defects blocked it and are fixed: the official `(~>) Array` diagnostic only matched by coincidence. A bare `~>` now resolves through the imported type-operator alias (official Prelude aliases it to `NaturalTransformation`; a user may alias it to - `Prim.Function`), and only an unresolved `~>` falls back to the arrow. The + `Prim.Function`), and no unresolved `~>` falls back to the arrow (corrected during the review + continuation above). The function arrow is a builtin constructor and is never a partially applied synonym inline. L3 kind agreement is unchanged at `PartiallyAppliedSynonym` 12/12, so `failing/TypeSynonyms9.purs` and `PASTrumpsKDNU2.purs` still agree. @@ -385,8 +407,10 @@ Run remains the outstanding reference package. It needs `Effect.Aff` and `Effect.Aff.Class`; every `Run/*` module imports the `Run` top module, which imports `Effect.Aff`, so the package cannot even resolve without Aff. Aff's closure pulls `refs`, `parallel`, and `datetime` on top of the modules above, and -`Effect.Aff` execution itself is gate-blocked on native Effect, so Run cannot be -completed in this pure source-migration track. +actual `Effect.Aff` execution still requires target support. Pure Run source +migration and pure handler execution must be attempted independently: importing +Aff does not establish that a pure entry executes it. The continuation above +records the current pure Run blocker. Validation for the closure, the frontend fixes, and the local-signature fix: From d2d489f5a2855ff78028dac9028721e3fa03759a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 21:37:03 +0800 Subject: [PATCH 132/148] Refine superclass row contexts through semantic dependency improvement --- .../src/tests/wasi/classes/fundeps.rs | 1 + .../src/tests/wasi/classes/fundeps/rows.rs | 42 +++++++++++++++++++ .../src/typecheck/classes/evidence/mod.rs | 31 ++++++++------ .../src/typecheck/classes/fundeps/mod.rs | 12 ++++++ .../delimited-control-and-resumable-frames.md | 14 ++++--- .../type-system/classes-and-evidence.md | 8 ++++ ...-reference-library-migration-2026-10-12.md | 17 +++++++- 7 files changed, 104 insertions(+), 21 deletions(-) create mode 100644 crates/psrs-driver/src/tests/wasi/classes/fundeps/rows.rs diff --git a/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs b/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs index 800945da..2459be56 100644 --- a/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs +++ b/crates/psrs-driver/src/tests/wasi/classes/fundeps.rs @@ -7,6 +7,7 @@ use super::super::super::*; mod nested_context; +mod rows; const FUNCTIONAL_DEPENDENCY_SOURCE: &str = r#" module Main where diff --git a/crates/psrs-driver/src/tests/wasi/classes/fundeps/rows.rs b/crates/psrs-driver/src/tests/wasi/classes/fundeps/rows.rs new file mode 100644 index 00000000..cec510eb --- /dev/null +++ b/crates/psrs-driver/src/tests/wasi/classes/fundeps/rows.rs @@ -0,0 +1,42 @@ +use super::*; + +const SOURCE: &str = r"module Main where +import Type.Equality (class TypeEquals) +import Type.Proxy (Proxy) +import Unsafe.Coerce (unsafeCoerce) +data R r a = R a +fromRows :: forall f r1 r2 a. TypeEquals (Proxy r1) (Proxy r2) => f r2 a -> f r1 a +fromRows = unsafeCoerce +inject :: forall r a. a -> R (value :: Array | r) a +inject = R +class Lift m where + lift :: forall a. a -> m a +instance liftR :: TypeEquals (Proxy r1) (Proxy (value :: Array | r2)) => Lift (R r1) where + lift value = fromRows (inject value) +class Lift m <= Child m where + stamp :: m Int -> Int +instance childR :: TypeEquals (Proxy r1) (Proxy (other :: Array, value :: Array | r2)) => Child (R r1) where + stamp (R n) = n +main = stamp (R 42 :: R (other :: Array, value :: Array) Int) +"; + +#[test] +fn superclass_context_refines_a_row_tail_from_a_given_dependency() { + let Some(output) = run_with_wasmtime(SOURCE) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn superclass_context_does_not_invent_a_missing_row_field() { + let source = SOURCE.replace("other :: Array, value :: Array | r2", "other :: Array | r2"); + let errors = compile_source("Main.purs", &source) + .expect_err("an abstract tail cannot guarantee a missing field"); + assert!( + errors + .iter() + .any(|error| error.code == Some("TypesDoNotUnify")), + "{errors:?}" + ); +} diff --git a/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs index f4770ecb..aefb57ae 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/evidence/mod.rs @@ -56,19 +56,24 @@ impl Checker { (InferType::Application(f1, a1), InferType::Application(f2, a2)) => { self.infer_types_equal(&f1, &f2) && self.infer_types_equal(&a1, &a2) } - (InferType::RowEmpty, InferType::RowEmpty) => true, - ( - InferType::RowExtend { - label: l1, - ty: t1, - tail: r1, - }, - InferType::RowExtend { - label: l2, - ty: t2, - tail: r2, - }, - ) => l1 == l2 && self.infer_types_equal(&t1, &t2) && self.infer_types_equal(&r1, &r2), + (left, right) if self.is_row(&left) && self.is_row(&right) => { + let span = TextRange::new(0, 0); + let (Ok(mut left), Ok(mut right)) = ( + self.normalize_row(left, span), + self.normalize_row(right, span), + ) else { + return false; + }; + left.fields.sort_by(|a, b| a.0.cmp(&b.0)); + right.fields.sort_by(|a, b| a.0.cmp(&b.0)); + left.tail == right.tail + && left.fields.len() == right.fields.len() + && left + .fields + .iter() + .zip(&right.fields) + .all(|((ll, lt), (rl, rt))| ll == rl && self.infer_types_equal(lt, rt)) + } _ => false, } } diff --git a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs index b5cbfef9..5c04c4e3 100644 --- a/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs +++ b/crates/psrs-typecheck/src/typecheck/classes/fundeps/mod.rs @@ -147,6 +147,18 @@ impl Checker { if self.infer_types_equal(&wanted, &source) { return false; } + // Row order is semantic, not the written extension spine. A known + // source can refine only the wanted row through the shared normalizer; + // unresolved source variables remain conservative as below. + if self.is_row(&wanted) && self.is_row(&source) && !self.has_flexible_variable(&source) { + if !self.has_flexible_variable(&wanted) { + self.report_fundep_conflict(&wanted, &source, span); + return false; + } + let substitutions_before = self.state.substitutions.len(); + self.unify_rows(wanted, source, span); + return self.state.substitutions.len() != substitutions_before; + } match (&wanted, &source) { (InferType::Variable(variable), _) => { if self.state.rigid.contains(variable) { diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index e10d310a..510ddbfd 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -730,12 +730,14 @@ Upstream `Free`/`Run` executes its ordinary library representation; it is not an alternative implementation of the compiler's Control machine, and the native Effect/ST prototype is not evidence that this topic is complete. -The current pure Run migration resolves the unchanged Aff import closure and -passes higher-order row-alias kind checking and signature expansion. It still -rejects the `runMonadEffect` instance member in term checking. This is a frontend -migration blocker; native Aff execution has not been demonstrated as a dependency -of the pure entry. The [reference migration record](../../../implementation/backend/control-reference-library-migration-2026-10-12.md) -keeps compilation, runtime evidence and remaining full acceptance separate. +The current pure Run migration resolves the unchanged Aff import closure, +checks higher-order row aliases through shared HIR expansion, and consumes given +row dependencies when solving superclass contexts. The pure State program +(`put`, `modify`, `get`, `evalState`, `extract`) compiles without diagnostics and +executes to 42 under Wasmtime. This representative result does not establish +complete package import, API coverage, Aff execution or Control-machine +acceptance. The [reference migration record](../../../implementation/backend/control-reference-library-migration-2026-10-12.md) +keeps those obligations separate. No compiler-side operation registry, handler IR, or effect-specific solver is required. The runtime carries no continuation for the software form; runtime control diff --git a/docs/design/frontend/type-system/classes-and-evidence.md b/docs/design/frontend/type-system/classes-and-evidence.md index 525e74e4..456049e3 100644 --- a/docs/design/frontend/type-system/classes-and-evidence.md +++ b/docs/design/frontend/type-system/classes-and-evidence.md @@ -126,6 +126,14 @@ storage. Check class parameter kinds, dependency indices, superclass cycles, method signatures, instance heads and contexts, and coherence conditions before solving uses. Build a searchable instance environment respecting module visibility and the official orphan and instance-chain rules. Compiler-owned primitive evidence has an evidence-defined place in the search order: proof and relation rules run before direct given lookup; report rules run after it so a warning or unsolved report constraint can propagate through the enclosing declaration. For ordinary class constraints, search givens first, then superclass paths and candidate instances. Matching a given compares all resolved wanted arguments with the given's arguments without choosing values for unknowns. Instantiated superclass arguments follow the same equality rule. Functional dependencies may improve unknowns separately, using the declared dependency relation. Apply functional dependencies to improve unknowns using only the selected branch in each chain; repeat until stable. Compare every class argument in an instance head. Functional dependencies contribute the transitive closure of already matched positions, while arguments outside that closure can still prove a candidate apart. Within each visible chain, continue only when a branch is provably apart. A matching branch commits before its context is solved. An unknown non-final branch blocks later alternatives in that chain; unknown singleton and final branches are ignored. Unknown branches do not create an overlap with one definite match from an unrelated chain. Failure to solve a selected context does not fall through. Unrelated ordinary candidates must remain coherent; overlapping or unresolved obligations receive source-oriented diagnostics. Memoize and bound search to prevent cycles. +Row arguments use semantic row equality through the shared row normalizer, +including field permutation and solved tails. Given lookup remains read-only; +it never selects a value for an unknown argument. Functional-dependency +improvement may refine a flexible wanted row against a known given source, +including extending its tail with fields present in the source. It preserves +rigid source variables, and an abstract source tail does not guarantee a missing +field. Superclass contexts use the same improvement when recursively solved. + The common instance recorder rejects a class-argument count mismatch with `ClassInstanceArityMismatch` before deriving or member inference. Derived known-class rules separately diagnose a supported rule's own arity contract diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index 3255743b..feef73f5 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -58,8 +58,21 @@ The current explicit closure omits the three Variant inputs now supplied by the pinned package (`run-files-current-list.txt`). `run-pure-after-kind.json` reaches term checking; `run-pure-after-elaboration.json` removes its alias diagnostics and leaves one `TypesDoNotUnify` at the unchanged `runMonadEffect` instance member. -Pure Run remains incomplete. Its next blocker is consumption of given type -relations during instance-member checking, not demonstrated Aff execution. +That intermediate rejection is repaired by semantic row dependency improvement: +the `runMonadAff` superclass obligation needs the given larger row to refine the +`runMonadEffect` context's tail. Improvement and exact given comparison now use +the shared row normalizer. The actual blocker was not a name-based Effect rule. + +`run-pure-after-row-fundep.json` compiles the unchanged reference closure with no +diagnostics. A separate build and mandatory Wasmtime run execute `put 20`, +`modify (+22)` and `get` to 42 (`run-pure-build.log`, `run-pure-runtime.json`). +The functional-dependency group passes 11 focused tests, including superclass +row refinement and rejection of a missing field. The final minimal row fixtures +also pass separately. Official `purs` agrees on acceptance and the missing-field +`TypesDoNotUnify`; its oracle projection removes only the target binding string +from `Unsafe.Coerce`'s foreign declaration, preserving the signature. +`row-fundep-official/summary.json` records that comparison. Full package import, +source/API audit and broader handler/runtime acceptance remain outstanding. Validation scope is focused by explicit user instruction. Full workspace tests, workspace clippy and complete ignored scoreboards were not rerun for this From 6df8bfba59f74659883f8572ac8a88c821a6574e Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Mon, 12 Oct 2026 21:58:22 +0800 Subject: [PATCH 133/148] Complete Run and Free source migration with recursive closure adaptation --- .../psrs-backend/src/cc/lower/lambda/eta.rs | 72 +++++++++++++++++++ .../psrs-backend/src/cc/lower/lambda/mod.rs | 37 +++------- .../psrs-backend/src/cc/lower/letrec/mod.rs | 57 +++++++++++---- .../psrs-backend/src/cc/lower/letrec/tests.rs | 2 + .../cc/lower/letrec/tests/initialization.rs | 24 +++++++ crates/psrs-core/src/opt/mod.rs | 6 ++ crates/psrs-driver/src/tests/mod.rs | 2 + .../src/tests/recursive_closures.rs | 32 +++++++++ docs/design/D-04-suite-roadmap.md | 2 +- .../fp/algebraic-effects-and-handlers.md | 13 ++-- docs/design/backend/fp/cc-ir.md | 10 +++ .../delimited-control-and-resumable-frames.md | 9 ++- .../backend/algebraic-effects.md | 44 ++++++++++-- ...-reference-library-migration-2026-10-12.md | 49 +++++++++++++ stdlib.lock.json | 4 +- 15 files changed, 307 insertions(+), 56 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/lambda/eta.rs create mode 100644 crates/psrs-backend/src/cc/lower/letrec/tests/initialization.rs create mode 100644 crates/psrs-driver/src/tests/recursive_closures.rs diff --git a/crates/psrs-backend/src/cc/lower/lambda/eta.rs b/crates/psrs-backend/src/cc/lower/lambda/eta.rs new file mode 100644 index 00000000..aa277d83 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/lambda/eta.rs @@ -0,0 +1,72 @@ +//! Shared adaptation from a closure-valued body to a flattened callable. +use super::super::FunctionLowerer; +use crate::BackendError; +use crate::cc::{ + Assignment, AssignmentKind, RefShape, Reference, SignatureId, ValueId, ValueShape, +}; +use psrs_span::TextRange; + +pub(in crate::cc::lower) struct EtaApplication { + pub value: ValueId, + pub shape: ValueShape, + pub signature: SignatureId, + pub arguments: Vec, + pub result_shape: ValueShape, + pub span: TextRange, +} + +impl FunctionLowerer<'_> { + pub(in crate::cc::lower) fn apply_eta_result( + &mut self, + application: EtaApplication, + assignments: &mut Vec, + ) -> Result> { + let EtaApplication { + value, + shape, + signature, + arguments, + result_shape, + span, + } = application; + let closure_shape = ValueShape::Reference(Reference { + nullable: false, + heap: RefShape::Closure(signature), + }); + let callable = if super::is_erased_reference(shape) { + let closure = self.fresh(closure_shape); + assignments.push(Assignment { + destination: closure, + kind: AssignmentKind::RepresentationCast { + destination: closure, + value, + reference: Reference { + nullable: false, + heap: RefShape::Closure(signature), + }, + }, + span, + }); + closure + } else if shape == closure_shape { + value + } else { + return Err(vec![BackendError::new( + "P8 closure conversion", + span, + "eta body has an incompatible closure representation", + )]); + }; + let result = self.fresh(result_shape); + assignments.push(Assignment { + destination: result, + kind: AssignmentKind::IndirectCall { + function: callable, + signature, + arguments, + }, + span, + }); + Ok(result) + } +} diff --git a/crates/psrs-backend/src/cc/lower/lambda/mod.rs b/crates/psrs-backend/src/cc/lower/lambda/mod.rs index e303af91..4e8ddba1 100644 --- a/crates/psrs-backend/src/cc/lower/lambda/mod.rs +++ b/crates/psrs-backend/src/cc/lower/lambda/mod.rs @@ -10,10 +10,12 @@ use psrs_core::{Expr, ExprKind}; use std::collections::HashMap; mod captures; +mod eta; mod wrapper; pub(super) use captures::collect_captures; use captures::lambda_captures; +pub(super) use eta::EtaApplication; pub(super) use wrapper::make_wrapper; pub(super) trait LambdaLowering { @@ -213,36 +215,17 @@ impl LambdaLowering for FunctionLowerer<'_> { .expect("an eta-expanded lambda has an interned signature"); let body_signature = body_signature.expect("an eta-expanded lambda has a body signature"); - // Recover the erased function value into its closure shape so the - // indirect call can name the body signature. - let callable = if is_erased_reference(nested_result_type) { - let closure = nested.fresh(closure_value_type_for(body_signature)); - nested_assignments.push(Assignment { - destination: closure, - kind: AssignmentKind::RepresentationCast { - destination: closure, - value: result, - reference: Reference { - nullable: false, - heap: RefShape::Closure(body_signature), - }, - }, - span: expression.span, - }); - closure - } else { - result - }; - let final_result = nested.fresh(signature_definition.result); - nested_assignments.push(Assignment { - destination: final_result, - kind: AssignmentKind::IndirectCall { - function: callable, + let final_result = nested.apply_eta_result( + EtaApplication { + value: result, + shape: nested_result_type, signature: body_signature, arguments: extra_parameters, + result_shape: signature_definition.result, + span: expression.span, }, - span: expression.span, - }); + &mut nested_assignments, + )?; (final_result, signature_definition.result) } else { (result, nested_result_type) diff --git a/crates/psrs-backend/src/cc/lower/letrec/mod.rs b/crates/psrs-backend/src/cc/lower/letrec/mod.rs index 93d8d3bd..8866930b 100644 --- a/crates/psrs-backend/src/cc/lower/letrec/mod.rs +++ b/crates/psrs-backend/src/cc/lower/letrec/mod.rs @@ -4,7 +4,7 @@ use super::super::{ ValueShape, }; use super::FunctionLowerer; -use super::lambda::{LambdaLowering, collect_captures}; +use super::lambda::{EtaApplication, LambdaLowering, collect_captures}; use crate::BackendError; use psrs_core::{Binder, Binding, Expr, ExprKind}; use psrs_hir::{LocalId, SymbolId}; @@ -144,13 +144,13 @@ impl FunctionLowerer<'_> { "recursive local function has an unknown CC signature", )); }; - let (parameters, body) = peel_parameters(&binding.value, signature.parameters.len()) - .ok_or_else(|| { - lowering_error( - binding.span, - "recursive local function must bind every parameter in its CC signature", - ) - })?; + let (parameters, body) = peel_parameters(&binding.value, signature.parameters.len()); + if parameters.is_empty() && !psrs_core::opt::evaluation_is_inert(&binding.value) { + return Err(lowering_error( + binding.span, + "observable recursive initializer requires eager recursive value support", + )); + } let symbol = self.generated_symbols.borrow_mut().fresh(self.owner); functions.push(RecursiveFunction { binding, @@ -192,6 +192,15 @@ impl FunctionLowerer<'_> { parameters.push(parameter); } + // Like ordinary lambdas, recursive closures expose their complete + // flattened signature even when the written body returns a function. + let mut extra_parameters = Vec::new(); + for shape in &function.signature.parameters[function.parameters.len()..] { + let parameter = nested.fresh(*shape); + parameters.push(parameter); + extra_parameters.push(parameter); + } + let mut nested_assignments = Vec::new(); for (index, (local, shape)) in captures.iter().zip(capture_shapes).enumerate() { let destination = nested.fresh(*shape); @@ -237,7 +246,31 @@ impl FunctionLowerer<'_> { } let result = nested.lower_value(function.body, &mut nested_assignments)?; - let result_type = scalar_shape(&nested, function.body.ty, function.body.span)?; + let body_shape = scalar_shape(&nested, function.body.ty, function.body.span)?; + let (result, result_type) = if extra_parameters.is_empty() { + (result, body_shape) + } else { + let body_signature = + function_type_signature(self.module, self.function_types, function.body.ty) + .ok_or_else(|| { + lowering_error( + function.body.span, + "recursive eta body has no runtime function type", + ) + })?; + let result = nested.apply_eta_result( + EtaApplication { + value: result, + shape: body_shape, + signature: body_signature, + arguments: extra_parameters, + result_shape: function.signature.result, + span: function.body.span, + }, + &mut nested_assignments, + )?; + (result, function.signature.result) + }; if result_type != function.signature.result { return Err(lowering_error( function.body.span, @@ -301,17 +334,17 @@ fn recursive_captures( captures } -fn peel_parameters(expression: &Expr, count: usize) -> Option<(Vec<&Binder>, &Expr)> { +fn peel_parameters(expression: &Expr, count: usize) -> (Vec<&Binder>, &Expr) { let mut current = expression; let mut parameters = Vec::with_capacity(count); for _ in 0..count { let ExprKind::Lambda { binder, body } = ¤t.kind else { - return None; + break; }; parameters.push(binder); current = body; } - Some((parameters, current)) + (parameters, current) } fn emit_function_ref( diff --git a/crates/psrs-backend/src/cc/lower/letrec/tests.rs b/crates/psrs-backend/src/cc/lower/letrec/tests.rs index 20962fc0..bfee48b0 100644 --- a/crates/psrs-backend/src/cc/lower/letrec/tests.rs +++ b/crates/psrs-backend/src/cc/lower/letrec/tests.rs @@ -496,3 +496,5 @@ fn value_shape(function: &Function, value: ValueId) -> Option { .find(|declaration| declaration.id == value) .map(|declaration| declaration.ty) } + +mod initialization; diff --git a/crates/psrs-backend/src/cc/lower/letrec/tests/initialization.rs b/crates/psrs-backend/src/cc/lower/letrec/tests/initialization.rs new file mode 100644 index 00000000..c895905f --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/letrec/tests/initialization.rs @@ -0,0 +1,24 @@ +use super::*; + +#[test] +fn observable_recursive_initializer_is_not_delayed_until_a_call() { + let mut module = mutual_recursion_module(); + let ExprKind::Let { bindings, .. } = &mut module.declarations[0].value.kind else { + panic!("fixture contains a recursive group"); + }; + let original = bindings[0].value.clone(); + let ty = original.ty; + bindings[0].value.kind = ExprKind::If { + condition: Box::new(expression(ExprKind::Boolean(true), TypeId(1), 20, 21)), + then_branch: Box::new(expression(ExprKind::Trap, ty, 21, 22)), + else_branch: Box::new(original), + }; + let errors = crate::cc::lower_module(module) + .expect_err("an observable recursive initializer requires eager evaluation"); + assert!( + errors + .iter() + .any(|error| error.message.contains("eager recursive value support")), + "{errors:?}" + ); +} diff --git a/crates/psrs-core/src/opt/mod.rs b/crates/psrs-core/src/opt/mod.rs index d5d4d6f3..6c0a4dbe 100644 --- a/crates/psrs-core/src/opt/mod.rs +++ b/crates/psrs-core/src/opt/mod.rs @@ -9,6 +9,12 @@ mod util; use crate::{Module, VerifyError}; +/// Whether evaluating an expression can be deferred without moving a call, +/// trap or write. Consumers share the optimizer's conservative effect summary. +pub fn evaluation_is_inert(expression: &crate::Expr) -> bool { + effects::summarize(expression).inert() +} + /// Resource limits for deterministic P7 optimization. #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub struct Budget { diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index f2058c15..284052e5 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -211,3 +211,5 @@ mod library_types; mod tail_calls; mod symbol_reflection; + +mod recursive_closures; diff --git a/crates/psrs-driver/src/tests/recursive_closures.rs b/crates/psrs-driver/src/tests/recursive_closures.rs new file mode 100644 index 00000000..57b81fe6 --- /dev/null +++ b/crates/psrs-driver/src/tests/recursive_closures.rs @@ -0,0 +1,32 @@ +use super::*; + +#[test] +fn recursive_local_function_can_return_a_branch_selected_closure() { + let source = r"module Main where +import Prelude +main = go 42 0 + where + go n = if n == 0 then (\a -> a) else (\a -> go (n - 1) (a + 1)) +"; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +#[test] +fn recursive_local_aliases_share_the_same_capture_environment() { + let source = r"module Main where +import Prelude +main = outer 1 + where + outer step = go 42 0 + where + alias = go + go n a = if n == 0 then a else alias (n - 1) (a + step) +"; + let Some(output) = run_with_wasmtime(source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index e4cdfbc7..82d88738 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Complete execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and pinned upstream-library acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Labelled Control rows over pinned VariantF execute deep forwarding and shallow residual policies. Complete pinned Run/Free dependency sources are imported unchanged; representative pure Run State, Choose and combined Reader/State/Writer/Except programs execute with observed values and log order. Complete execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and broader upstream-library API acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/fp/algebraic-effects-and-handlers.md b/docs/design/backend/fp/algebraic-effects-and-handlers.md index 383c77ff..7224a4d2 100644 --- a/docs/design/backend/fp/algebraic-effects-and-handlers.md +++ b/docs/design/backend/fp/algebraic-effects-and-handlers.md @@ -372,12 +372,13 @@ does not reopen the deleted legacy runner path. ## Open questions and future work -1. **Reference-library acceptance.** Audit the pinned upstream Run/Free/Variant - packages, accept the reference library on this target, and build the row-based - (`VariantF`) library over compiler Control. Representative unchanged Variant - and Free programs execute, and labelled deep/shallow Control wrappers have - focused behavior evidence. Complete reference-library/API acceptance remains - open; neither those programs nor the native prototype establish it. +1. **Reference-library acceptance.** Complete pinned Run/Free/Variant sources + and their dependency packages are imported unchanged. The ordinary labelled + VariantF library over Control has deep/shallow execution evidence; pure Run + State, Choose and combined Reader/State/Writer/Except programs also execute + with observable result/order checks. Complete API, foreign-runtime and + differential acceptance remains open; these results and the native prototype + do not establish it. See the [migration record](../../../implementation/backend/control-reference-library-migration-2026-10-12.md). 2. **Operation-row encoding.** Confirm the reference encoding (`VariantF` over an open row) is supported end to end, or record the compiler gap it exposes. 3. **Scoped and higher-order effects, bracket/finalization.** These need their own diff --git a/docs/design/backend/fp/cc-ir.md b/docs/design/backend/fp/cc-ir.md index 8a03bcff..1703eca4 100644 --- a/docs/design/backend/fp/cc-ir.md +++ b/docs/design/backend/fp/cc-ir.md @@ -56,6 +56,16 @@ Steele (1978) and Appel (*Compiling with Continuations*, 1992) are the standard references. CC keeps captures explicit and ordered; the physical closure object is chosen later by [MIR](mir.md). +Recursive local function groups use the same flattened callable contract as +ordinary lambdas. When a written function body returns a closure before binding +all arrow parameters, generated CC parameters feed the remaining closure call. +Lambda and recursive-group lowering share that adaptation and use signatures +reserved before lowering. Inert local aliases may participate in a recursive +group and preserve its capture environment. A zero-binder recursive initializer +that may call, trap or write still requires eager recursive-value support; +current lowering rejects it rather than delaying its evaluation. The Core +optimizer's conservative evaluation summary owns this distinction. + **Evaluation order.** Because Core is strict, the order in which operands are evaluated is observable as soon as effects exist. CC makes Core's defined order explicit: `lower_value` lowers operands in source order and emits one `Assignment` diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 510ddbfd..2e165d9f 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -735,8 +735,13 @@ checks higher-order row aliases through shared HIR expansion, and consumes given row dependencies when solving superclass contexts. The pure State program (`put`, `modify`, `get`, `evalState`, `extract`) compiles without diagnostics and executes to 42 under Wasmtime. This representative result does not establish -complete package import, API coverage, Aff execution or Control-machine -acceptance. The [reference migration record](../../../implementation/backend/control-reference-library-migration-2026-10-12.md) +API coverage, Aff execution or Control-machine acceptance. A complete 70-module +reference-package import also preserves the unchanged Run/Free dependency +sources in the pinned independent stdlib. Choose and combined Reader/State/Writer/Except fixtures execute to 42; +the latter checks local handler scope and Writer log order. CC recursively lifted +functions now share ordinary lambda parameter adaptation. These results do not +replace structural machine provenance, lifecycle, foreign capture or trap-cleanup +verification. The [reference migration record](../../../implementation/backend/control-reference-library-migration-2026-10-12.md) keeps those obligations separate. No compiler-side operation registry, handler IR, or effect-specific solver is diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 6616f175..e124a658 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -25,12 +25,14 @@ evidence needed to review it. Once the execution model and caller contract are stable, complete structural, malformed-IR and requirement-by-requirement verification. All acceptance obligations below remain required. -The compiler and locked `PSRS.Control` wrappers already use contract v2. The -current independent package does not provide `Run` or `Data.VariantF`; its public -control fixtures and opaque official type comparison do not establish the pinned -upstream integration. Prioritize the remaining production/library integration -and runtime boundaries, then close verification gaps. Native Effect/ST follows -complete delimited-control acceptance. +The compiler and locked `PSRS.Control` wrappers use contract v2. The independent +package now preserves every pinned Run/Free/Variant module and its dependency +sources; the labelled Control row library uses `Data.Functor.Variant`. Focused +State, Choose and combined Reader/State/Writer/Except programs execute with +observable value/order checks. This establishes representative production +migration evidence, not complete upstream API or foreign-runtime acceptance. +Continue through the full machine, runtime-boundary and verification obligations +below. Native Effect/ST follows complete delimited-control acceptance. The [reference-library migration baseline](control-reference-library-migration-2026-10-12.md) records the selected upstream revisions, the first unchanged-source compile @@ -1464,3 +1466,33 @@ Logs: `/private/tmp/psrs-control-root-structural.log`, `/private/tmp/psrs-control-root-clippy-final.log`. Separate pinned-package conformance commands and ignored suite scoreboards are not rerun for this internal invariant slice. No measured gate number changes. + + +## Complete reference-source import and representative execution (2026-10-12) + +Compiler continuation `6703863d` and `d2d489f5` repairs higher-order alias +normalization and superclass row dependency refinement. The recursive closure +adaptation and package pin accompany this record. The independent package +`d6cf81105046e288e2e9cd9685f8cc47e960c988`, fingerprint +`fnv1a64-v1:6eb134fa699297f4`, adds 70 byte-identical modules from the complete +pinned reference packages and dependencies. Its full source audit records +50 packages / 305 modules, with 245 identical, 34 modified and 26 target additions; +no upstream module is omitted and no direct same-argument recursion is detected. +Existing modifications remain separate fidelity obligations. + +The focused source, official kind/type comparisons and actual Wasmtime evidence +are recorded in the [reference migration record](control-reference-library-migration-2026-10-12.md). +Pure Run State returns 42; Choose checks both alternatives in order; the combined +Reader/State/Writer/Except fixture returns 42 with exact log `"ab!"`. The final +combined fixture has stable input and package hashes. Original Control row deep +and shallow fixtures also execute to 42 after pinning; shallow uses the default +lock without a development override. Aff, DateTime and exception FFI are not +executed by these pure fixtures. + +Focused validation includes 38 kind tests, 11 functional-dependency tests, +source Wasmtime cases for higher-order aliases and recursive closures, and five +backend recursive-group tests including observable-initializer rejection. +Formatting and local diff checks pass. Full workspace tests, workspace clippy +and complete scoreboards were intentionally not rerun under the user's focused +validation scope. Complete AE/AC statuses remain Unverified; no gate measurement +is changed. diff --git a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md index feef73f5..a9f7283b 100644 --- a/docs/implementation/backend/control-reference-library-migration-2026-10-12.md +++ b/docs/implementation/backend/control-reference-library-migration-2026-10-12.md @@ -74,6 +74,55 @@ from `Unsafe.Coerce`'s foreign declaration, preserving the signature. `row-fundep-official/summary.json` records that comparison. Full package import, source/API audit and broader handler/runtime acceptance remain outstanding. + +## Complete reference-package import + +The independent package `d6cf81105046e288e2e9cd9685f8cc47e960c988`, fingerprint +`fnv1a64-v1:6eb134fa699297f4`, now copies all 70 source modules, byte-for-byte, from Run, +Free, catenable-lists, transformers, exceptions, Aff, Parallel and DateTime at the +pins recorded in `reference-package-candidate-inventory.json`. All dependency +imports resolve. A complete Node audit records 50 packages / 305 modules: +245 identical, 34 modified, 26 target additions; no upstream module is missing +and no direct same-argument recursion is detected. The existing 34 modifications +remain separately reviewable and are not justified by this migration. + +The complete package's pure Run State entry compiles (`reference-package-before.json`). +`RunChoose.purs` executes both alternatives and checks `[20, 22]` and length two; +`run-choose-candidate/run.json` is accepted. `RunHandlers.purs` composes Reader +local scopes, State updates, Writer censor/order and Except elimination, checking +42 and `"ab!"`; `run-handlers-after-eta/run.json` is accepted with unchanged +inputs and package fingerprint during that run. + +The first combined-handler build exposed CC's requirement that a recursive +local function syntactically bind every flattened parameter. Recursive groups +now use the shared lambda adaptation to call a returned closure with remaining +CC parameters, including inert local recursive aliases. Two source Wasmtime +cases cover branch-selected closures and shared captures. Five focused backend +tests pass, including rejection of a trap-bearing recursive initializer whose +evaluation cannot safely be deferred. Eager observable recursive values remain +an explicit unsupported boundary. + +`run-handlers-final/run.json` replays the combined handler fixture on the final +compiler with the initializer guard. Compilation and Wasmtime execution pass +with exit 42, stable inputs and stable package content. The validated temporary +package and the committed independent package have the same measured fingerprint; +only their absolute roots differ. The compiler lock pins that committed revision. +`run-choose-candidate/run.json` predates addition of the State case file; its input +and library source content are unchanged, but its full package fingerprint is +historical, so it is not represented as a final locked-package run. + +After pinning the committed package, the original labelled Control deep fixture +passes compilation and mandatory Wasmtime with stable package/input hashes +(`rows-deep-reference-lock/run.json`). The shallow fixture also builds with the +development override removed, consuming the default lock, and executes to 42 +(`rows-shallow-locked.json`). These are integration checks of existing Control +policies against the expanded package, not complete machine acceptance. + +The candidate retains the upstream foreign declarations. These pure programs do +not execute Aff, DateTime or host exception FFI; importing their complete source +and passing a source audit is not foreign-runtime acceptance. Full Control-machine +acceptance and native Effect/ST migration remain separate outstanding work. + Validation scope is focused by explicit user instruction. Full workspace tests, workspace clippy and complete ignored scoreboards were not rerun for this continuation. Existing full statuses and gate measurements remain unchanged. diff --git a/stdlib.lock.json b/stdlib.lock.json index e9d76d0d..e7048061 100644 --- a/stdlib.lock.json +++ b/stdlib.lock.json @@ -1,6 +1,6 @@ { "schema_version": 1, "path": "../psrs-stdlib", - "revision": "baf285f8acdccbeb4f3ff8e5315b153400e69f0d", - "source_fingerprint": "fnv1a64-v1:ecebcb4301e7039a" + "revision": "d6cf81105046e288e2e9cd9685f8cc47e960c988", + "source_fingerprint": "fnv1a64-v1:6eb134fa699297f4" } From 1e24e5d53a3d747c0954435cdefab5587a0684e1 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 14 Oct 2026 21:49:55 +0800 Subject: [PATCH 134/148] Verify delimited control machine paths and lifecycle bodies Share dispatch, execution, observable-event and owned-resumption relations across CC and MIR, with path-sensitive provenance and publication checks. Validate lifecycle bodies and total-call assumptions, and move cost probes after compiler verification. Add permanent malformed-IR and runtime regression coverage, align the control-machine design, and record remaining acceptance work and validation in the handoff. Validation: control 185 passed, backend 444 passed, mandatory control integration 81 passed. Workspace snapshot retains the same 71 baseline failures. Formatting passes; strict Clippy remains blocked by the existing let_and_return warning. --- Cargo.lock | 2 + crates/psrs-backend/src/cc/branch_facts.rs | 67 ++ .../src/cc/layout/control/contracts.rs | 2 +- .../psrs-backend/src/cc/layout/control/mod.rs | 2 +- .../src/cc/lower/control/executor.rs | 2 +- .../psrs-backend/src/cc/lower/control/mod.rs | 2 +- .../src/cc/lower/control/owned.rs | 4 +- crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/representation.rs | 3 + crates/psrs-backend/src/cc/value_identity.rs | 100 ++- .../src/cc/verify/control/checkpoints.rs | 2 +- .../src/cc/verify/control/clauses.rs | 210 ++++++ .../src/cc/verify/control/context_entry.rs | 4 +- .../src/cc/verify/control/dispatch.rs | 160 +++++ .../cc/verify/control/execution/effects.rs | 102 +++ .../src/cc/verify/control/execution/mod.rs | 286 ++++++++ .../src/cc/verify/control/exits.rs | 133 ++++ .../cc/verify/control/finish_consumption.rs | 2 +- .../src/cc/verify/control/finish_creation.rs | 2 +- .../src/cc/verify/control/initialization.rs | 114 +++ .../src/cc/verify/control/lifecycle.rs | 92 +++ .../psrs-backend/src/cc/verify/control/mod.rs | 21 +- .../src/cc/verify/control/owned.rs | 82 +++ .../src/cc/verify/control/refinements.rs | 66 ++ .../src/cc/verify/control/replay.rs | 8 +- .../src/cc/verify/control/root.rs | 2 +- .../src/cc/verify/control/steps.rs | 150 ++++ .../src/cc/verify/control/traces.rs | 193 +++++ crates/psrs-backend/src/cc/verify/mod.rs | 2 +- .../src/cc/verify/{read_only.rs => total.rs} | 37 +- crates/psrs-backend/src/control/dispatch.rs | 28 + crates/psrs-backend/src/control/events.rs | 166 +++++ .../psrs-backend/src/control/execution/mod.rs | 398 ++++++++++ .../src/control/execution/observables.rs | 134 ++++ crates/psrs-backend/src/control/lifecycle.rs | 137 ++++ crates/psrs-backend/src/control/mod.rs | 15 + crates/psrs-backend/src/control/owned.rs | 358 +++++++++ .../provenance.rs} | 70 ++ crates/psrs-backend/src/control/steps.rs | 42 ++ crates/psrs-backend/src/lib.rs | 2 +- crates/psrs-backend/src/mir/branch_facts.rs | 310 ++++++++ crates/psrs-backend/src/mir/cfg.rs | 57 +- .../src/mir/control/checkpoints.rs | 2 +- .../psrs-backend/src/mir/control/clauses.rs | 349 +++++++++ .../src/mir/control/context_entry.rs | 4 +- .../psrs-backend/src/mir/control/dispatch.rs | 252 +++++++ .../psrs-backend/src/mir/control/execution.rs | 323 +++++++++ crates/psrs-backend/src/mir/control/exits.rs | 77 ++ .../src/mir/control/finish_consumption.rs | 2 +- .../src/mir/control/finish_creation.rs | 2 +- .../src/mir/control/initialization.rs | 126 ++++ .../psrs-backend/src/mir/control/lifecycle.rs | 118 +++ crates/psrs-backend/src/mir/control/mod.rs | 23 + crates/psrs-backend/src/mir/control/owned.rs | 101 +++ .../src/mir/control/publication.rs | 238 ++++++ .../src/mir/control/refinements.rs | 105 +++ crates/psrs-backend/src/mir/control/replay.rs | 16 +- crates/psrs-backend/src/mir/control/root.rs | 2 +- crates/psrs-backend/src/mir/control/steps.rs | 200 ++++++ crates/psrs-backend/src/mir/control/traces.rs | 229 ++++++ .../psrs-backend/src/mir/{opt => }/effects.rs | 71 +- .../psrs-backend/src/mir/layout/accessors.rs | 17 + crates/psrs-backend/src/mir/mod.rs | 2 + crates/psrs-backend/src/mir/opt/mod.rs | 2 +- crates/psrs-backend/src/mir/value_identity.rs | 157 +++- crates/psrs-backend/src/mir/verify/mod.rs | 3 + crates/psrs-backend/src/mir/verify/subtype.rs | 2 +- .../psrs-backend/src/mir/verify/variants.rs | 68 ++ .../src/mir/verify/variants/tests.rs | 257 +++++++ crates/psrs-driver/Cargo.toml | 4 + .../src/tests/control_clause_selection.rs | 252 +++++++ .../src/tests/control_clause_steps.rs | 404 +++++++++++ .../src/tests/control_costs/mod.rs | 43 +- .../src/tests/control_costs/probe.rs | 418 +++++------ .../src/tests/control_dispatch/cc.rs | 184 +++++ .../src/tests/control_dispatch/mir.rs | 305 ++++++++ .../src/tests/control_dispatch/mod.rs | 140 ++++ .../src/tests/control_execution_steps.rs | 281 ++++++++ .../src/tests/control_inlined_publication.rs | 147 ++++ .../src/tests/control_lifecycle_bodies.rs | 181 +++++ .../src/tests/control_observable_paths.rs | 228 ++++++ .../src/tests/control_owned_steps/cc.rs | 228 ++++++ .../src/tests/control_owned_steps/mir.rs | 305 ++++++++ .../src/tests/control_owned_steps/mod.rs | 378 ++++++++++ .../src/tests/control_queue_steps/cc.rs | 314 ++++++++ .../tests/control_queue_steps/mir/effects.rs | 248 +++++++ .../src/tests/control_queue_steps/mir/mod.rs | 320 +++++++++ .../src/tests/control_queue_steps/mod.rs | 150 ++++ .../src/tests/control_result_provenance.rs | 352 +++++++++ crates/psrs-driver/src/tests/mod.rs | 10 + docs/design/D-04-suite-roadmap.md | 2 +- docs/design/backend/README.md | 3 +- .../control-elimination-and-handler-scopes.md | 59 +- docs/design/backend/fp/control-machine.md | 680 ++++++++++++++++++ .../delimited-control-and-resumable-frames.md | 163 +---- .../backend/algebraic-effects.md | 213 ++++++ ...-control-architecture-review-2026-10-14.md | 264 +++++++ ...ed-control-migration-handoff-2026-10-12.md | 456 ++++++++++++ 98 files changed, 12551 insertions(+), 499 deletions(-) create mode 100644 crates/psrs-backend/src/cc/branch_facts.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/clauses.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/dispatch.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/execution/effects.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/execution/mod.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/exits.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/initialization.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/lifecycle.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/owned.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/refinements.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/steps.rs create mode 100644 crates/psrs-backend/src/cc/verify/control/traces.rs rename crates/psrs-backend/src/cc/verify/{read_only.rs => total.rs} (68%) create mode 100644 crates/psrs-backend/src/control/dispatch.rs create mode 100644 crates/psrs-backend/src/control/events.rs create mode 100644 crates/psrs-backend/src/control/execution/mod.rs create mode 100644 crates/psrs-backend/src/control/execution/observables.rs create mode 100644 crates/psrs-backend/src/control/lifecycle.rs create mode 100644 crates/psrs-backend/src/control/mod.rs create mode 100644 crates/psrs-backend/src/control/owned.rs rename crates/psrs-backend/src/{control_provenance.rs => control/provenance.rs} (70%) create mode 100644 crates/psrs-backend/src/control/steps.rs create mode 100644 crates/psrs-backend/src/mir/branch_facts.rs create mode 100644 crates/psrs-backend/src/mir/control/clauses.rs create mode 100644 crates/psrs-backend/src/mir/control/dispatch.rs create mode 100644 crates/psrs-backend/src/mir/control/execution.rs create mode 100644 crates/psrs-backend/src/mir/control/exits.rs create mode 100644 crates/psrs-backend/src/mir/control/initialization.rs create mode 100644 crates/psrs-backend/src/mir/control/lifecycle.rs create mode 100644 crates/psrs-backend/src/mir/control/owned.rs create mode 100644 crates/psrs-backend/src/mir/control/publication.rs create mode 100644 crates/psrs-backend/src/mir/control/refinements.rs create mode 100644 crates/psrs-backend/src/mir/control/steps.rs create mode 100644 crates/psrs-backend/src/mir/control/traces.rs rename crates/psrs-backend/src/mir/{opt => }/effects.rs (74%) create mode 100644 crates/psrs-backend/src/mir/verify/variants.rs create mode 100644 crates/psrs-backend/src/mir/verify/variants/tests.rs create mode 100644 crates/psrs-driver/src/tests/control_clause_selection.rs create mode 100644 crates/psrs-driver/src/tests/control_clause_steps.rs create mode 100644 crates/psrs-driver/src/tests/control_dispatch/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_dispatch/mir.rs create mode 100644 crates/psrs-driver/src/tests/control_dispatch/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_execution_steps.rs create mode 100644 crates/psrs-driver/src/tests/control_inlined_publication.rs create mode 100644 crates/psrs-driver/src/tests/control_lifecycle_bodies.rs create mode 100644 crates/psrs-driver/src/tests/control_observable_paths.rs create mode 100644 crates/psrs-driver/src/tests/control_owned_steps/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_owned_steps/mir.rs create mode 100644 crates/psrs-driver/src/tests/control_owned_steps/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_queue_steps/cc.rs create mode 100644 crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs create mode 100644 crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_queue_steps/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_result_provenance.rs create mode 100644 docs/design/backend/fp/control-machine.md create mode 100644 docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md create mode 100644 docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md diff --git a/Cargo.lock b/Cargo.lock index 9d379de5..f3831254 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -392,6 +392,8 @@ dependencies = [ "psrs-typecheck", "serde", "serde_json", + "wasm-encoder", + "wasmparser", ] [[package]] diff --git a/crates/psrs-backend/src/cc/branch_facts.rs b/crates/psrs-backend/src/cc/branch_facts.rs new file mode 100644 index 00000000..541a3ef4 --- /dev/null +++ b/crates/psrs-backend/src/cc/branch_facts.rs @@ -0,0 +1,67 @@ +//! Immutable variant tag facts on structured CC paths. +use super::{AssignmentKind as A, ReprId, ValueId}; +use std::collections::HashMap; + +pub(crate) type Facts = HashMap<(ReprId, ValueId), i32>; +pub(crate) type Definitions<'a> = HashMap; + +pub(crate) fn tag_source( + value: ValueId, + definitions: &Definitions<'_>, +) -> Option<(ReprId, ValueId)> { + let origin = |value| { + super::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) + }; + match definitions.get(&origin(value)).copied()? { + A::VariantTag { + representation, + value, + .. + } => Some((*representation, origin(*value))), + _ => None, + } +} + +pub(crate) fn selected( + representation: ReprId, + value: ValueId, + facts: &Facts, + definitions: &Definitions<'_>, +) -> Option { + let value = + super::value_identity::reference_origin(value, |value| definitions.get(&value).copied()); + match definitions.get(&value).copied() { + Some(A::VariantNew { + representation: actual, + case, + .. + }) if *actual == representation => i32::try_from(*case).ok(), + _ => facts.get(&(representation, value)).copied(), + } +} + +/// Equality established by a selected Boolean branch, including swapped +/// operands. Unknown inequalities do not become fabricated scalar facts. +pub(crate) fn equality_selection( + condition: ValueId, + truth: bool, + definitions: &Definitions<'_>, + aliases: &HashMap, +) -> Option<(ValueId, i32)> { + let origin = |value| super::value_identity::path_origin(value, definitions, aliases); + let A::Primitive { op, left, right } = definitions.get(&origin(condition)).copied()? else { + return None; + }; + if !matches!( + (op, truth), + (super::BinaryOp::IntEq, true) | (super::BinaryOp::IntNe, false) + ) { + return None; + } + for (value, constant) in [(*left, *right), (*right, *left)] { + if let Some(A::Constant(constant)) = definitions.get(&origin(constant)).copied() { + return Some((origin(value), *constant)); + } + } + None +} diff --git a/crates/psrs-backend/src/cc/layout/control/contracts.rs b/crates/psrs-backend/src/cc/layout/control/contracts.rs index 3a44117a..f97fe933 100644 --- a/crates/psrs-backend/src/cc/layout/control/contracts.rs +++ b/crates/psrs-backend/src/cc/layout/control/contracts.rs @@ -259,7 +259,7 @@ fn implementation(layout: ControlLayout, operation: Intrinsic) -> ControlImpleme ControlPerform => 1, ControlBind => 2, ControlHandle => 4, - ControlResume => 6, + ControlResume => 5, ControlRun => { return ControlImplementation::Call { signature: layout.executor, diff --git a/crates/psrs-backend/src/cc/layout/control/mod.rs b/crates/psrs-backend/src/cc/layout/control/mod.rs index c3ac3e4e..f53df5bc 100644 --- a/crates/psrs-backend/src/cc/layout/control/mod.rs +++ b/crates/psrs-backend/src/cc/layout/control/mod.rs @@ -69,7 +69,6 @@ pub(in crate::cc) fn append( vec![frame, callable], vec![erased, queue, extent], vec![callable, callable, frame], - vec![], // Retired v1 Reenter tag; the executor rejects it. vec![reference(RefShape::Repr(owner)), erased], ], ); @@ -134,6 +133,7 @@ pub(in crate::cc) fn append( table.set_product_labels(pair, labels); pair }); + table.control_result_pair = Some(pair); let executor = table.add_signature(Signature { parameters: vec![ erased, diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index d47b541c..dfd6988f 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -71,7 +71,7 @@ impl Machine<'_> { cases.push(arm(4, body, result)); let mut body = Vec::new(); let result = self.consume_owned(state, handler, computation, sequence, &mut body); - cases.push(arm(6, body, result)); + cases.push(arm(5, body, result)); let mut body = Vec::new(); let result = self.switch(computation, self.layout.computation, cases, &mut body); diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 77502140..72c831b4 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -214,7 +214,7 @@ impl FunctionLowerer<'_> { Intrinsic::ControlPerform => 1, Intrinsic::ControlBind => 2, Intrinsic::ControlHandle => 4, - Intrinsic::ControlResume => 6, + Intrinsic::ControlResume => 5, _ => return Err(control_error(expression.span, "not a control primitive")), }; let destination = self.fresh(ty); diff --git a/crates/psrs-backend/src/cc/lower/control/owned.rs b/crates/psrs-backend/src/cc/lower/control/owned.rs index 3c70ef62..686ab101 100644 --- a/crates/psrs-backend/src/cc/lower/control/owned.rs +++ b/crates/psrs-backend/src/cc/lower/control/owned.rs @@ -41,8 +41,8 @@ impl Machine<'_> { sequence: ValueId, body: &mut Vec, ) -> ValueId { - let owner = self.field(computation, self.layout.computation, 6, 0, body); - let value = self.field(computation, self.layout.computation, 6, 1, body); + let owner = self.field(computation, self.layout.computation, 5, 0, body); + let value = self.field(computation, self.layout.computation, 5, 1, body); let callback = self.field(owner, self.layout.owner, 0, 0, body); let status = self.field(owner, self.layout.owner, 0, 1, body); self.guard_pending(status, body); diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index eaa20caf..fd848cd3 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -7,6 +7,7 @@ use std::cell::RefCell; use std::collections::HashMap; use std::rc::Rc; +pub(crate) mod branch_facts; mod case; mod control; pub(crate) mod value_identity; diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index 7ca958ca..87eaa5a2 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -228,6 +228,9 @@ pub struct RepresentationTable { /// Semantic helper bindings are fixed before any function body is lowered. pub control_helpers: Vec, pub control_resumption: Option, + /// The closed-run pair is planned before payload erasure; consumers must + /// not reconstruct its nominal identity from record labels or field count. + pub control_result_pair: Option, /// Source control contracts are predeclared by layout, before lowering /// emits any factory or executor bodies. pub control_contracts: Vec, diff --git a/crates/psrs-backend/src/cc/value_identity.rs b/crates/psrs-backend/src/cc/value_identity.rs index 60d3a42d..0ffa9b39 100644 --- a/crates/psrs-backend/src/cc/value_identity.rs +++ b/crates/psrs-backend/src/cc/value_identity.rs @@ -2,25 +2,67 @@ use super::{AssignmentKind, ValueConversion, ValueId}; use std::collections::HashSet; +/// A join preserves identity only when every normal alternative has the same +/// origin. A trapping alternative contributes no returned value. pub(crate) fn reference_origin<'a>( - mut value: ValueId, + value: ValueId, mut definition: impl FnMut(ValueId) -> Option<&'a AssignmentKind>, ) -> ValueId { - let mut seen = HashSet::new(); - while seen.insert(value) { - let source = match definition(value) { - Some(AssignmentKind::RepresentationCast { value, .. }) => Some(*value), + fn resolve<'a>( + value: ValueId, + definition: &mut impl FnMut(ValueId) -> Option<&'a AssignmentKind>, + active: &mut HashSet, + ) -> Option { + if !active.insert(value) { + return Some(value); + } + let result = match definition(value) { + Some(AssignmentKind::Unreachable) => None, + Some( + AssignmentKind::RepresentationCast { value, .. } + | AssignmentKind::ArraySet { value, .. }, + ) => resolve(*value, definition, active), Some(AssignmentKind::AggregateConvert { value, conversion, .. - }) if transparent(&conversion.plan) => Some(*value), - _ => None, + }) if transparent(&conversion.plan) => resolve(*value, definition, active), + Some(AssignmentKind::If { + then_value, + else_value, + .. + }) => join(value, [*then_value, *else_value], definition, active), + Some(AssignmentKind::TagSwitch { + cases, + default_value, + .. + }) => join( + value, + cases.iter().map(|case| case.value).chain([*default_value]), + definition, + active, + ), + _ => Some(value), }; - match source { - Some(source) => value = source, - None => break, + active.remove(&value); + result + } + fn join<'a>( + value: ValueId, + inputs: impl IntoIterator, + definition: &mut impl FnMut(ValueId) -> Option<&'a AssignmentKind>, + active: &mut HashSet, + ) -> Option { + let mut common = None; + for input in inputs { + if let Some(origin) = resolve(input, definition, active) { + if common.is_some_and(|previous| previous != origin) { + return Some(value); + } + common = Some(origin); + } } + common } - value + resolve(value, &mut definition, &mut HashSet::new()).unwrap_or(value) } pub(crate) fn transparent(conversion: &ValueConversion) -> bool { @@ -42,7 +84,12 @@ pub(crate) fn definitions( let mut pending = vec![body]; while let Some(body) = pending.pop() { for assignment in body { - definitions.insert(assignment.destination, &assignment.kind); + // An in-place store changes contents, not the carrier's definition. + // Preserve the allocation/projection that established its identity. + if !matches!(&assignment.kind, AssignmentKind::ArraySet { value, .. } if *value == assignment.destination) + { + definitions.insert(assignment.destination, &assignment.kind); + } match &assignment.kind { AssignmentKind::If { then_assignments, @@ -65,3 +112,32 @@ pub(crate) fn definitions( } definitions } + +pub(crate) fn path_origin( + mut value: ValueId, + definitions: &std::collections::HashMap, + aliases: &std::collections::HashMap, +) -> ValueId { + let mut seen = HashSet::new(); + while seen.insert(value) { + let next = + aliases + .get(&value) + .copied() + .or_else(|| match definitions.get(&value).copied() { + Some( + AssignmentKind::RepresentationCast { value, .. } + | AssignmentKind::ArraySet { value, .. }, + ) => Some(*value), + Some(AssignmentKind::AggregateConvert { + value, conversion, .. + }) if transparent(&conversion.plan) => Some(*value), + _ => None, + }); + match next { + Some(next) => value = next, + None => break, + } + } + value +} diff --git a/crates/psrs-backend/src/cc/verify/control/checkpoints.rs b/crates/psrs-backend/src/cc/verify/control/checkpoints.rs index 1e957c1c..d9097089 100644 --- a/crates/psrs-backend/src/cc/verify/control/checkpoints.rs +++ b/crates/psrs-backend/src/cc/verify/control/checkpoints.rs @@ -3,7 +3,7 @@ use crate::BackendError; use crate::cc::{ Assignment, AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, }; -use crate::control_provenance::{ +use crate::control::provenance::{ CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, }; use std::collections::HashMap; diff --git a/crates/psrs-backend/src/cc/verify/control/clauses.rs b/crates/psrs-backend/src/cc/verify/control/clauses.rs new file mode 100644 index 00000000..7f9dc476 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/clauses.rs @@ -0,0 +1,210 @@ +//! A source return or operation applies its own scoped clause. +//! +//! Source context construction retains the clauses at fixed fields +//! (`context_entry`); this verifier checks that interpreting a source `Return` +//! or `Perform` actually applies the matching clause of the current scoped +//! context, rather than the wrong field, another frame's field or a boundary. +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::provenance::{ + ClauseKind, FinishProjection, clause_operand_relation, clause_selection_relation, +}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) + { + return Ok(()); + } + if function.parameters.len() != 6 { + return Err(error( + function, + "clause selection has an invalid executor contract", + )); + } + let schema = table + .control_checkpoint_schema() + .ok_or_else(|| error(function, "clause selection has no checked schema"))?; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = |value| { + crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) + }; + let context = function.parameters[5]; + let Some(A::TagSwitch { cases, .. }) = definitions.get(&origin(function.result)).copied() + else { + // The dispatch verifier owns the result-shape contract. + return Ok(()); + }; + for case in cases { + let kind = if case.tag == ClauseKind::Return.source_tag() { + ClauseKind::Return + } else if case.tag == ClauseKind::Operation.source_tag() { + ClauseKind::Operation + } else { + continue; + }; + // Check every applied clause projection and require the scoped branch + // to consume its complete application result at the next transition. + let mut pending = vec![case.assignments.as_slice()]; + let mut steps = 0; + while let Some(body) = pending.pop() { + for assignment in body { + match &assignment.kind { + A::IndirectCall { + function: callee, .. + } => { + let clause = match definitions.get(&origin(*callee)).copied() { + Some(A::VariantGet { + representation, + case: 1, + field, + value, + .. + }) if *representation == schema.context => Some(FinishProjection { + owner: origin(*value), + field: *field, + }), + _ => None, + }; + if clause.is_some() { + clause_selection_relation(kind, origin(context), clause) + .map_err(|message| error(function, message))?; + } + } + A::TagSwitch { + value, + cases, + default_assignments, + .. + } => { + if crate::cc::branch_facts::tag_source(*value, &definitions) + == Some((schema.context, origin(context))) + { + let scoped = + cases.iter().find(|case| case.tag == 1).ok_or_else(|| { + error(function, "source step has no scoped clause path") + })?; + let Some(A::DirectCall { + function: target, + arguments, + .. + }) = definitions.get(&origin(scoped.value)).copied() + else { + return Err(error( + function, + "source clause result must enter the next executor step", + )); + }; + if *target != function.symbol || arguments.len() != 6 { + return Err(error( + function, + "source clause result must enter the next executor step", + )); + } + if origin(arguments[0]) != origin(function.parameters[0]) + || origin(arguments[1]) != origin(function.parameters[1]) + { + return Err(error( + function, + "source clause transition must preserve its state and root handler", + )); + } + let mut result = origin(arguments[2]); + let mut payload = None; + let mut resumption = None; + for _ in 0..(if kind == ClauseKind::Return { 1 } else { 2 }) { + let Some(A::IndirectCall { + function: callee, + arguments, + .. + }) = definitions.get(&result).copied() + else { + return Err(error( + function, + "source clause result must enter the next executor step", + )); + }; + if arguments.len() != 1 + || !scoped.assignments.iter().any(|a| a.destination == result) + { + return Err(error( + function, + "source clause application must execute in its scoped step", + )); + } + payload = Some(origin(arguments[0])); + resumption.get_or_insert(origin(arguments[0])); + result = origin(*callee); + } + let projection = + |value, repr, tag| match definitions.get(&value).copied() { + Some(A::VariantGet { + representation, + case, + field, + value, + .. + }) if *representation == repr && *case == tag => { + Some(FinishProjection { + owner: origin(*value), + field: *field, + }) + } + _ => None, + }; + clause_selection_relation( + kind, + origin(context), + projection(result, schema.context, 1), + ) + .map_err(|message| error(function, message))?; + clause_operand_relation( + origin(function.parameters[2]), + projection( + payload.unwrap(), + schema.computation, + kind.source_tag() as u32, + ), + ) + .map_err(|message| error(function, message))?; + if kind == ClauseKind::Operation + && !matches!(definitions.get(&resumption.unwrap()).copied(), Some(A::FunctionRef { function: target, .. }) + if table.control_resumption.as_ref().is_some_and(|raw| raw.function() == *target)) + { + return Err(error( + function, + "source operation clause must receive its raw resumption", + )); + } + steps += 1; + } + pending.extend(cases.iter().map(|case| case.assignments.as_slice())); + pending.push(default_assignments); + } + A::If { + then_assignments, + else_assignments, + .. + } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), + _ => {} + } + } + } + if steps == 0 { + return Err(error(function, "source step has no scoped clause path")); + } + } + Ok(()) +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC clause selection", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/control/context_entry.rs b/crates/psrs-backend/src/cc/verify/control/context_entry.rs index 55111f08..b5f93c80 100644 --- a/crates/psrs-backend/src/cc/verify/control/context_entry.rs +++ b/crates/psrs-backend/src/cc/verify/control/context_entry.rs @@ -1,7 +1,9 @@ //! Source Handle entry retains its clauses, caller work and lifetime boundary. use crate::BackendError; use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control_provenance::{FinishProjection, context_clause_relation, context_tail_relation}; +use crate::control::provenance::{ + FinishProjection, context_clause_relation, context_tail_relation, +}; pub(super) fn verify( function: &Function, diff --git a/crates/psrs-backend/src/cc/verify/control/dispatch.rs b/crates/psrs-backend/src/cc/verify/control/dispatch.rs new file mode 100644 index 00000000..60508a05 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/dispatch.rs @@ -0,0 +1,160 @@ +//! Machine dispatch coverage and projections are checked on actual CC paths. +use crate::BackendError; +use crate::cc::branch_facts::{Facts, selected, tag_source}; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::dispatch::Carrier; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + let Some(role) = table + .control_helpers + .iter() + .find(|h| h.function() == function.symbol) + .map(|h| h.role()) + else { + return Ok(()); + }; + if !matches!(role, R::Executor | R::CloneSequence | R::RebuildSequence) { + return Ok(()); + } + let schema = table + .control_checkpoint_schema() + .ok_or_else(|| error(function, "control dispatch has no checked schema"))?; + let queue = table + .control_sequence() + .ok_or_else(|| error(function, "control dispatch has no checked queue schema"))?; + let classify = |repr| { + if repr == schema.computation { + Some(Carrier::Computation) + } else if repr == schema.context { + Some(Carrier::Context) + } else if repr == queue { + Some(if role == R::RebuildSequence { + Carrier::Reverse + } else { + Carrier::Queue + }) + } else { + None + } + }; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = + |v| crate::cc::value_identity::reference_origin(v, |v| definitions.get(&v).copied()); + let index = if role == R::Executor { 2 } else { 0 }; + let input = function.parameters.get(index).copied().ok_or_else(|| { + error( + function, + "control dispatch has an invalid parameter contract", + ) + })?; + let entry_repr = if role == R::Executor { + schema.computation + } else { + queue + }; + let Some(A::TagSwitch { value, .. }) = definitions.get(&origin(function.result)).copied() + else { + return Err(error( + function, + "control helper result must be its current input dispatch", + )); + }; + if tag_source(*value, &definitions) != Some((entry_repr, origin(input))) { + return Err(error( + function, + "control helper result must be its current input dispatch", + )); + } + let mut pending = vec![(function.assignments.as_slice(), Facts::new())]; + while let Some((body, facts)) = pending.pop() { + for assignment in body { + match &assignment.kind { + A::VariantGet { + representation, + case, + value, + .. + } if classify(*representation).is_some() => { + // Only a proven selection can contradict the projected case. + // An unprovable source is left to the relation-specific + // verifiers rather than rejected here. + if let Some(known) = selected(*representation, *value, &facts, &definitions) + && i32::try_from(*case).ok() != Some(known) + { + return Err(error( + function, + "control projection must match the selected case of its actual input", + )); + } + } + A::TagSwitch { + value, + cases, + default_assignments, + default_value, + .. + } => { + let selector = tag_source(*value, &definitions); + if let Some((repr, owner)) = selector + && let Some(carrier) = classify(repr) + { + carrier + .verify(cases.iter().map(|case| case.tag)) + .map_err(|m| error(function, m))?; + if !matches!( + definitions.get(&origin(*default_value)).copied(), + Some(A::Unreachable) + ) { + return Err(error( + function, + "control dispatch must trap on unsupported alternatives", + )); + } + if role == R::Executor + && repr == schema.computation + && owner != origin(input) + { + return Err(error( + function, + "computation dispatch must select the current executor input", + )); + } + } + for case in cases { + let mut branch = facts.clone(); + if let Some(key) = selector { + branch.insert(key, case.tag); + } + pending.push((case.assignments.as_slice(), branch)); + } + // The default proves none of the explicitly selected tags. + let mut fallback = facts.clone(); + if let Some(key) = selector { + fallback.remove(&key); + } + pending.push((default_assignments.as_slice(), fallback)); + } + A::If { + then_assignments, + else_assignments, + .. + } => pending.extend([ + (then_assignments.as_slice(), facts.clone()), + (else_assignments.as_slice(), facts.clone()), + ]), + _ => {} + } + } + } + Ok(()) +} + +fn error(function: &Function, message: &'static str) -> Vec { + vec![ + BackendError::invalid_ir("P8 CC control dispatch", function.span, message) + .with_module(function.symbol.module), + ] +} diff --git a/crates/psrs-backend/src/cc/verify/control/execution/effects.rs b/crates/psrs-backend/src/cc/verify/control/execution/effects.rs new file mode 100644 index 00000000..657b6b43 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/execution/effects.rs @@ -0,0 +1,102 @@ +//! Account for the complete executed path, including prefixes and exceptional exits. +use super::super::traces::{Trace, paths}; +use super::View; +use crate::BackendError; +use crate::cc::value_identity::definitions; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::events::{self, Event}; +use crate::control::execution::{self, Facts, Operands, Schema}; +use psrs_hir::SymbolId; +use std::collections::HashMap; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, + functions: Option<&HashMap>, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) + { + return Ok(()); + } + let total = functions + .map(super::super::super::total::functions) + .unwrap_or_default(); + let checked: Result<(), &'static str> = (|| { + let schema = Schema::checked(table)?; + let status = table + .control_replay_schema() + .ok_or("execution has no status schema")? + .status; + let carriers = events::carriers(table)?; + let definitions = definitions(&function.assignments); + let paths = paths( + &function.assignments, + Trace::default(), + function.symbol, + &definitions, + ); + let normal = paths + .iter() + .filter(|path| !path.trapped) + .map(|path| path.events.clone()) + .collect::>(); + for path in paths { + if !path.trapped { + super::super::refinements::verify(function, table, &path)?; + } + let view = View { + definitions: definitions.clone(), + aliases: Some(&path.aliases), + raw: table + .control_resumption + .as_ref() + .ok_or("execution has no raw contract")? + .function(), + }; + if path.trapped { + events::exceptional(&view, &path.events, &normal, &carriers, status)?; + continue; + } + let mut facts = Facts::new(); + for event in &path.events { + if let Event::Select { value, tag } = event + && let Some(key) = view.tag(*value) + { + facts.insert(key, *tag); + } + } + if facts.get(&(schema.computation, view.origin(function.parameters[2]))) == Some(&5) { + continue; + } + let result = view.origin(function.result); + let next = match definitions.get(&result).copied() { + Some(A::DirectCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }; + execution::effects( + &schema, + &view, + &facts, + &function.parameters, + next, + &path.events, + &total, + )?; + events::allocations(&view, next.unwrap_or(&[result]), &path.events)?; + } + Ok(()) + })(); + checked.map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC root and queue effects", function.span, message) + .with_module(function.symbol.module), + ] + }) +} diff --git a/crates/psrs-backend/src/cc/verify/control/execution/mod.rs b/crates/psrs-backend/src/cc/verify/control/execution/mod.rs new file mode 100644 index 00000000..1ac6b2aa --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/execution/mod.rs @@ -0,0 +1,286 @@ +//! Discharge structured result paths into the shared root/queue step contract. +use crate::BackendError; +use crate::cc::branch_facts::{Definitions, tag_source}; +use crate::cc::value_identity::{definitions, reference_origin, transparent}; +use crate::cc::{ + AssignmentKind as A, ControlHelperRole as R, Function, ReprId, RepresentationTable, ValueId, +}; +use crate::control::execution::{self, Coverage, Facts, Operands, Schema}; + +pub(super) struct View<'a> { + pub(super) definitions: Definitions<'a>, + pub(super) raw: psrs_hir::SymbolId, + pub(super) aliases: Option<&'a std::collections::HashMap>, +} + +impl Operands for View<'_> { + fn inputs(&self, value: ValueId) -> Vec { + match self.definitions.get(&self.origin(value)).copied() { + Some(A::ProductNew { arguments, .. } | A::DirectCall { arguments, .. }) => { + arguments.clone() + } + Some(A::VariantNew { fields, .. }) => fields.clone(), + Some(A::ArrayNew { elements, .. }) => elements.clone(), + Some(A::FunctionRef { captures, .. }) => captures.clone(), + Some(A::IndirectCall { + function, + arguments, + .. + }) => std::iter::once(*function) + .chain(arguments.iter().copied()) + .collect(), + Some( + A::ProductGet { value, .. } + | A::VariantGet { value, .. } + | A::VariantTag { value, .. } + | A::ArrayLen { value, .. }, + ) => vec![*value], + Some(A::ArrayFill { length, value, .. }) => vec![*length, *value], + Some(A::ArrayGet { value, index, .. }) => vec![*value, *index], + _ => Vec::new(), + } + } + fn tag(&self, value: ValueId) -> Option<(ReprId, ValueId)> { + match self.definitions.get(&self.origin(value)).copied()? { + A::VariantTag { + representation, + value, + .. + } => Some((*representation, self.origin(*value))), + _ => None, + } + } + fn origin(&self, value: ValueId) -> ValueId { + if let Some(aliases) = self.aliases { + return crate::cc::value_identity::path_origin(value, &self.definitions, aliases); + } + reference_origin(value, |value| self.definitions.get(&value).copied()) + } + fn projection( + &self, + value: ValueId, + repr: ReprId, + case: Option, + ) -> Option<(ValueId, u32)> { + match self.definitions.get(&self.origin(value)).copied()? { + A::VariantGet { + representation, + case: tag, + field, + value, + .. + } if *representation == repr && case == Some(*tag) => { + Some((self.origin(*value), *field)) + } + A::ProductGet { + representation, + field, + value, + .. + } if *representation == repr && case.is_none() => Some((self.origin(*value), *field)), + _ => None, + } + } + fn node(&self, value: ValueId, repr: ReprId, case: Option) -> Option> { + match self.definitions.get(&self.origin(value)).copied()? { + A::VariantNew { + representation, + case: tag, + fields, + .. + } if *representation == repr && case == Some(*tag) => Some(fields.clone()), + A::ProductNew { + representation, + arguments, + .. + } if *representation == repr && case.is_none() => Some(arguments.clone()), + _ => None, + } + } + fn application(&self, value: ValueId) -> Option<(ValueId, Vec)> { + match self.definitions.get(&self.origin(value)).copied()? { + A::IndirectCall { + function, + arguments, + .. + } => Some((*function, arguments.clone())), + _ => None, + } + } + fn raw_resumption(&self, value: ValueId) -> bool { + matches!(self.definitions.get(&self.origin(value)).copied(), Some(A::FunctionRef { function, .. }) if *function == self.raw) + } +} + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) + { + return Ok(()); + } + let result = (|| { + let schema = Schema::checked(table)?; + let view = View { + definitions: definitions(&function.assignments), + aliases: None, + raw: table + .control_resumption + .as_ref() + .ok_or("execution has no raw resumption contract")? + .function(), + }; + let mut coverage = Coverage::default(); + walk( + function, + &schema, + &view, + function.result, + Facts::new(), + &mut std::collections::HashSet::new(), + &mut coverage, + )?; + coverage.finish() + })(); + result.map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC root and queue execution", function.span, message) + .with_module(function.symbol.module), + ] + }) +} + +fn walk( + function: &Function, + schema: &Schema, + view: &View<'_>, + value: ValueId, + facts: Facts, + active: &mut std::collections::HashSet, + coverage: &mut Coverage, +) -> Result<(), &'static str> { + if !active.insert(value) { + return Err("execution result path is cyclic"); + } + let result = match view.definitions.get(&value).copied() { + Some(A::RepresentationCast { value, .. }) => { + walk(function, schema, view, *value, facts, active, coverage) + } + Some(A::AggregateConvert { + value, conversion, .. + }) if transparent(&conversion.plan) => { + walk(function, schema, view, *value, facts, active, coverage) + } + Some(A::If { + then_value, + else_value, + .. + }) => { + walk( + function, + schema, + view, + *then_value, + facts.clone(), + active, + coverage, + )?; + walk(function, schema, view, *else_value, facts, active, coverage) + } + Some(A::TagSwitch { + value: selector, + cases, + default_value, + .. + }) => { + let selected = tag_source(*selector, &view.definitions); + for case in cases { + let mut branch = facts.clone(); + if let Some(key) = selected { + branch.insert(key, case.tag); + } + walk(function, schema, view, case.value, branch, active, coverage)?; + } + let mut fallback = facts; + if let Some(key) = selected { + fallback.remove(&key); + } + walk( + function, + schema, + view, + *default_value, + fallback, + active, + coverage, + ) + } + Some(A::Unreachable) => Ok(()), + Some(A::DirectCall { + function: target, + arguments, + .. + }) if *target == function.symbol => { + execution::transition(schema, view, &facts, &function.parameters, arguments)?; + coverage.observe(schema, view, &facts, &function.parameters); + Ok(()) + } + _ => { + execution::publish(schema, view, &facts, &function.parameters, value)?; + coverage.observe(schema, view, &facts, &function.parameters); + Ok(()) + } + }; + active.remove(&value); + result +} + +impl crate::control::owned::OwnedOperands for View<'_> { + fn integer(&self, value: ValueId) -> Option { + match self.definitions.get(&self.origin(value)).copied()? { + A::Constant(value) => Some(*value), + _ => None, + } + } + fn initial(&self, cell: ValueId, repr: ReprId) -> Option { + match self.definitions.get(&self.origin(cell)).copied()? { + A::ArrayNew { + representation, + elements, + .. + } if *representation == repr && elements.len() == 1 => Some(elements[0]), + A::ArrayFill { + representation, + length, + value, + .. + } if *representation == repr && self.integer(*length) == Some(1) => Some(*value), + _ => None, + } + } + fn read(&self, value: ValueId, repr: ReprId) -> Option<(ValueId, i32)> { + match self.definitions.get(&self.origin(value)).copied()? { + A::ArrayGet { + representation, + value, + index, + .. + } if *representation == repr => Some((self.origin(*value), self.integer(*index)?)), + _ => None, + } + } +} + +mod effects; + +pub(super) fn verify_effects( + function: &Function, + table: &RepresentationTable, + functions: Option<&std::collections::HashMap>, +) -> Result<(), Vec> { + effects::verify(function, table, functions) +} diff --git a/crates/psrs-backend/src/cc/verify/control/exits.rs b/crates/psrs-backend/src/cc/verify/control/exits.rs new file mode 100644 index 00000000..20bb95a3 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/exits.rs @@ -0,0 +1,133 @@ +//! Executor transitions are terminal: their results must reach the actual exit. +use crate::BackendError; +use crate::cc::value_identity::{definitions, reference_origin, transparent}; +use crate::cc::{ + Assignment, AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, +}; +use std::collections::{HashMap, HashSet}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) + { + return Ok(()); + } + let definitions = definitions(&function.assignments); + body( + function, + &function.assignments, + function.result, + &definitions, + ) + .map(|_| ()) + .map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC executor exit", function.span, message) + .with_module(function.symbol.module), + ] + }) +} + +fn body( + function: &Function, + assignments: &[Assignment], + result: ValueId, + definitions: &HashMap, +) -> Result { + let mut transitions = false; + for assignment in assignments { + let transition = match &assignment.kind { + A::DirectCall { + function: target, .. + } => *target == function.symbol, + A::If { + then_assignments, + then_value, + else_assignments, + else_value, + .. + } => { + let left = body(function, then_assignments, *then_value, definitions)?; + let right = body(function, else_assignments, *else_value, definitions)?; + left || right + } + A::TagSwitch { + cases, + default_assignments, + default_value, + .. + } => { + let mut found = body(function, default_assignments, *default_value, definitions)?; + for case in cases { + found |= body(function, &case.assignments, case.value, definitions)?; + } + found + } + _ => false, + }; + if transition + && !forwards( + result, + assignment.destination, + definitions, + &mut HashSet::new(), + ) + { + return Err("executor transition result must reach every normal exit"); + } + transitions |= transition; + } + Ok(transitions) +} + +/// Check the returned value graph, never call arguments or unrelated effects. +/// The requirement applies to every normal alternative, including joins whose +/// inputs differ; a trap has no returned value. +fn forwards( + value: ValueId, + required: ValueId, + definitions: &HashMap, + active: &mut HashSet, +) -> bool { + if value == required || reference_origin(value, |v| definitions.get(&v).copied()) == required { + return true; + } + if !active.insert(value) { + return false; + } + let result = match definitions.get(&value).copied() { + Some(A::Unreachable) => true, + Some(A::RepresentationCast { value, .. }) => { + forwards(*value, required, definitions, active) + } + Some(A::AggregateConvert { + value, conversion, .. + }) if transparent(&conversion.plan) => forwards(*value, required, definitions, active), + Some(A::If { + then_value, + else_value, + .. + }) => { + forwards(*then_value, required, definitions, active) + && forwards(*else_value, required, definitions, active) + } + Some(A::TagSwitch { + cases, + default_value, + .. + }) => { + cases + .iter() + .all(|case| forwards(case.value, required, definitions, active)) + && forwards(*default_value, required, definitions, active) + } + _ => false, + }; + active.remove(&value); + result +} diff --git a/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs b/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs index 58815830..af55ffd4 100644 --- a/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs +++ b/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs @@ -3,7 +3,7 @@ use crate::BackendError; use crate::cc::{ AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, }; -use crate::control_provenance::{FinishProjection, finish_relation}; +use crate::control::provenance::{FinishProjection, finish_relation}; use std::collections::HashMap; pub(super) fn verify( diff --git a/crates/psrs-backend/src/cc/verify/control/finish_creation.rs b/crates/psrs-backend/src/cc/verify/control/finish_creation.rs index 6331d1ff..b9f21160 100644 --- a/crates/psrs-backend/src/cc/verify/control/finish_creation.rs +++ b/crates/psrs-backend/src/cc/verify/control/finish_creation.rs @@ -1,7 +1,7 @@ //! Check target completion records and immutable finish reassociation. use crate::BackendError; use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control_provenance::{FinishProjection, context_finish_relation}; +use crate::control::provenance::{FinishProjection, context_finish_relation}; pub(super) fn verify( function: &Function, diff --git a/crates/psrs-backend/src/cc/verify/control/initialization.rs b/crates/psrs-backend/src/cc/verify/control/initialization.rs new file mode 100644 index 00000000..c9c8163d --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/initialization.rs @@ -0,0 +1,114 @@ +//! Factory freshness and current cell contents are distinct publication facts. +use super::execution::View; +use super::traces::{Trace, paths}; +use crate::BackendError; +use crate::cc::value_identity::definitions; +use crate::cc::{ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::execution::Operands; +use crate::control::owned::{self, Expected, OwnedSchema}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, + functions: Option<&std::collections::HashMap>, +) -> Result<(), Vec> { + let Some(role @ (R::Start | R::Once | R::Cancel)) = table + .control_helpers + .iter() + .find(|helper| helper.function() == function.symbol) + .map(|helper| helper.role()) + else { + return Ok(()); + }; + let total = functions + .map(super::super::total::functions) + .unwrap_or_default(); + let result = (|| { + let replay = table + .control_replay_schema() + .ok_or("control factory has no private cell schema")?; + let owned = OwnedSchema::checked(table)?; + let definitions = definitions(&function.assignments); + let paths = paths( + &function.assignments, + Trace::default(), + function.symbol, + &definitions, + ); + let normal = paths + .iter() + .filter(|path| !path.trapped) + .map(|path| path.events.clone()) + .collect::>(); + if normal.is_empty() { + return Err("control factory has no normal publication path"); + } + for path in paths { + if !path.trapped { + super::refinements::verify(function, table, &path)?; + } + let view = View { + definitions: definitions.clone(), + aliases: Some(&path.aliases), + raw: table + .control_resumption + .as_ref() + .ok_or("control factory has no raw contract")? + .function(), + }; + if path.trapped { + crate::control::events::exceptional( + &view, + &path.events, + &normal, + &crate::control::events::carriers(table)?, + replay.status, + )?; + continue; + } + if role == R::Cancel { + if function.parameters.len() != 1 { + return Err("cancellation has invalid parameters"); + } + owned::cancel( + &owned, + &view, + function.parameters[0], + function.result, + &path.events, + )?; + continue; + } + let repr = if role == R::Start { + replay.boundary + } else { + owned.owner + }; + let fields = view + .node(function.result, repr, Some(0)) + .ok_or("control factory must publish its planned fresh frame")?; + let cells = if role == R::Start && fields.len() == 1 { + vec![(fields[0], replay.status, Expected::Integer(0))] + } else if role == R::Once && fields.len() == 2 && function.parameters.len() == 1 { + vec![ + ( + fields[0], + owned.callback, + Expected::Value(function.parameters[0]), + ), + (fields[1], owned.status, Expected::Integer(0)), + ] + } else { + return Err("control factory has invalid frame fields"); + }; + owned::publication(&view, &[function.result], &cells, &path.events, &total)?; + } + Ok(()) + })(); + result.map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC control initialization", function.span, message) + .with_module(function.symbol.module), + ] + }) +} diff --git a/crates/psrs-backend/src/cc/verify/control/lifecycle.rs b/crates/psrs-backend/src/cc/verify/control/lifecycle.rs new file mode 100644 index 00000000..34254e4b --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/lifecycle.rs @@ -0,0 +1,92 @@ +//! Verify extent helper bodies rather than trusting their semantic callee IDs. +use super::execution::View; +use super::traces::{Trace, paths}; +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::execution::Operands; +use crate::control::{events, lifecycle}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + let Some(role @ (R::Check | R::Close)) = table + .control_helpers + .iter() + .find(|helper| helper.function() == function.symbol) + .map(|helper| helper.role()) + else { + return Ok(()); + }; + let checked = (|| { + if function.parameters.len() != 1 { + return Err("lifecycle helper has invalid parameters"); + } + let schema = lifecycle::Schema::checked(table)?; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let paths = paths( + &function.assignments, + Trace::default(), + function.symbol, + &definitions, + ); + let mut coverage = std::collections::HashSet::new(); + let normal = paths + .iter() + .filter(|path| !path.trapped) + .map(|path| path.events.clone()) + .collect::>(); + for path in paths { + if !path.trapped { + super::refinements::verify(function, table, &path)?; + } + let view = View { + definitions: definitions.clone(), + aliases: Some(&path.aliases), + raw: table + .control_resumption + .as_ref() + .ok_or("lifecycle has no raw contract")? + .function(), + }; + if path.trapped { + events::exceptional( + &view, + &path.events, + &normal, + &[(schema.boundary, vec![0, 1])], + schema.status, + )?; + continue; + } + let result = view.origin(function.result); + let next = match definitions.get(&result).copied() { + Some(A::DirectCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }; + coverage.insert(lifecycle::verify( + &schema, + &view, + role, + function.parameters[0], + Some(result), + next, + &path.events, + )?); + } + if coverage.len() != 2 { + return Err("lifecycle must retain root and child actions"); + } + Ok(()) + })(); + checked.map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC lifecycle body", function.span, message) + .with_module(function.symbol.module), + ] + }) +} diff --git a/crates/psrs-backend/src/cc/verify/control/mod.rs b/crates/psrs-backend/src/cc/verify/control/mod.rs index 1a8658e9..739c9ef7 100644 --- a/crates/psrs-backend/src/cc/verify/control/mod.rs +++ b/crates/psrs-backend/src/cc/verify/control/mod.rs @@ -6,11 +6,21 @@ use psrs_hir::SymbolId; use std::collections::HashMap; mod checkpoints; +mod clauses; mod context_entry; +mod dispatch; +mod execution; +mod exits; mod finish_consumption; mod finish_creation; +mod initialization; +mod lifecycle; +mod owned; +mod refinements; mod replay; mod root; +mod steps; +mod traces; pub(super) fn verify_before_assignments( function: &Function, @@ -24,9 +34,18 @@ pub(super) fn verify_after_assignments( representations: &RepresentationTable, functions: Option<&HashMap>, ) -> Result<(), Vec> { + dispatch::verify(function, representations)?; + exits::verify(function, representations)?; + clauses::verify(function, representations)?; root::verify(function, representations)?; checkpoints::verify(function, representations)?; finish_creation::verify(function, representations)?; context_entry::verify(function, representations)?; - replay::verify(function, representations, functions) + replay::verify(function, representations, functions)?; + steps::verify(function, representations)?; + execution::verify(function, representations)?; + owned::verify(function, representations)?; + execution::verify_effects(function, representations, functions)?; + lifecycle::verify(function, representations)?; + initialization::verify(function, representations, functions) } diff --git a/crates/psrs-backend/src/cc/verify/control/owned.rs b/crates/psrs-backend/src/cc/verify/control/owned.rs new file mode 100644 index 00000000..c679888b --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/owned.rs @@ -0,0 +1,82 @@ +//! Execute the structured body symbolically to retain ordered owner effects. +use super::execution::View; +use crate::BackendError; +use crate::cc::value_identity::definitions; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::execution::{Operands, Schema}; +use crate::control::owned::{self, OwnedSchema}; + +use super::traces::Trace; +use super::traces::paths; +use crate::control::events::Event; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) + { + return Ok(()); + } + let result = (|| { + let schema = Schema::checked(table)?; + let owned = OwnedSchema::checked(table)?; + let definitions = definitions(&function.assignments); + let paths = paths( + &function.assignments, + Trace::default(), + function.symbol, + &definitions, + ) + .into_iter() + .filter(|path| !path.trapped) + .collect::>(); + if paths.is_empty() { + return Err("owned execution has no normal transfer path"); + } + for path in paths { + if !path.trapped { + super::refinements::verify(function, table, &path)?; + } + let view = View { + definitions: definitions.clone(), + aliases: Some(&path.aliases), + raw: table + .control_resumption + .as_ref() + .ok_or("owned execution has no raw resumption contract")? + .function(), + }; + if !path.events.iter().any(|event| matches!(event, Event::Select { value, tag: 5 } if view.tag(*value) == Some((schema.computation, view.origin(function.parameters[2]))))) { continue; } + let Some(A::DirectCall { + function: target, + arguments, + .. + }) = definitions.get(&view.origin(function.result)).copied() + else { + return Err("owned execution must return its executor transition"); + }; + if *target != function.symbol { + return Err("owned execution must return its executor transition"); + } + owned::verify( + &schema, + &owned, + &view, + &function.parameters, + arguments, + &path.events, + )?; + } + Ok(()) + })(); + result.map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC owned execution", function.span, message) + .with_module(function.symbol.module), + ] + }) +} diff --git a/crates/psrs-backend/src/cc/verify/control/refinements.rs b/crates/psrs-backend/src/cc/verify/control/refinements.rs new file mode 100644 index 00000000..cba26163 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/refinements.rs @@ -0,0 +1,66 @@ +//! Source payload recovery is restricted to the machine's checked use roles. +use super::execution::View; +use super::traces::Trace; +use crate::cc::{ + AssignmentKind as A, Function, RefShape, Representation, RepresentationTable, ValueShape, +}; +use crate::control::execution::Operands; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, + path: &Trace, +) -> Result<(), &'static str> { + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let raw = table + .control_resumption + .as_ref() + .ok_or("refinement has no raw contract")? + .function(); + let view = View { + definitions: definitions.clone(), + aliases: Some(&path.aliases), + raw, + }; + let next = match definitions.get(&view.origin(function.result)).copied() { + Some(A::DirectCall { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }; + for value in &path.casts { + let Some(A::RepresentationCast { + value, reference, .. + }) = definitions.get(value).copied() + else { + return Err("refinement has no cast definition"); + }; + let source = view.origin(*value); + let known = function + .values + .iter() + .find(|v| v.id == source) + .and_then(|v| match v.ty { + ValueShape::Reference(reference) => Some(reference), + _ => None, + }); + if known.is_some_and(|actual| (reference.nullable || !actual.nullable) && (actual.heap == reference.heap || reference.heap == RefShape::Erased || (reference.heap == RefShape::Aggregate && matches!(actual.heap, RefShape::Repr(repr) if matches!(table.representation(repr), Some(Representation::Product { .. } | Representation::Variant { .. })))))) { continue; } + if matches!(reference.heap, RefShape::Closure(_)) && path.events.iter().any(|event| matches!(event, crate::control::events::Event::Apply { result } if view.application(*result).is_some_and(|(callee, _)| view.origin(callee) == source))) { continue; } + if let RefShape::Repr(repr) = reference.heap + && next.is_some_and(|args| { + args.len() == 6 + && (table.control_checkpoint_schema().is_some_and(|schema| { + schema.computation == repr && view.origin(args[2]) == source + }) || (table.control_result_pair == Some(repr) + && view.projection(args[0], repr, None) == Some((source, 0)) + && view.projection(args[2], repr, None) == Some((source, 1)))) + }) + { + continue; + } + return Err("machine reference refinement has no checked use role"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/cc/verify/control/replay.rs b/crates/psrs-backend/src/cc/verify/control/replay.rs index 0bd2bd6d..da248409 100644 --- a/crates/psrs-backend/src/cc/verify/control/replay.rs +++ b/crates/psrs-backend/src/cc/verify/control/replay.rs @@ -1,7 +1,7 @@ //! Saved finish validation and fresh replay activation ownership. use crate::BackendError; use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control_provenance::{ +use crate::control::provenance::{ FinishProjection, replay_activation_relation, saved_finish_relation, }; @@ -18,8 +18,8 @@ pub(super) fn verify( if !matches!(role, Some(R::CloneSequence | R::RebuildSequence)) { return Ok(()); } - let read_only = functions - .map(super::super::read_only::functions) + let total = functions + .map(super::super::total::functions) .unwrap_or_default(); let schema = table .control_replay_schema() @@ -78,7 +78,7 @@ pub(super) fn verify( R::Check | R::CloneSequence | R::RebuildSequence ) }) - && !read_only.contains(target) => + && !total.contains(target) => { return Err(error( function, diff --git a/crates/psrs-backend/src/cc/verify/control/root.rs b/crates/psrs-backend/src/cc/verify/control/root.rs index 23fc7b0f..f819fd84 100644 --- a/crates/psrs-backend/src/cc/verify/control/root.rs +++ b/crates/psrs-backend/src/cc/verify/control/root.rs @@ -1,7 +1,7 @@ //! Run factories establish one fresh root and close it before publishing a result. use crate::BackendError; use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control_provenance::root_extent_relation; +use crate::control::provenance::root_extent_relation; use psrs_hir::Intrinsic; use std::collections::HashMap; diff --git a/crates/psrs-backend/src/cc/verify/control/steps.rs b/crates/psrs-backend/src/cc/verify/control/steps.rs new file mode 100644 index 00000000..4196374c --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/steps.rs @@ -0,0 +1,150 @@ +//! Required execution transitions consume the current frame's fields. +use crate::BackendError; +use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; +use crate::control::provenance::FinishProjection; +use crate::control::steps::{bind_relation, resume_answer_relation}; + +pub(super) fn verify( + function: &Function, + table: &RepresentationTable, +) -> Result<(), Vec> { + if !table + .control_helpers + .iter() + .any(|h| h.role() == R::Executor && h.function() == function.symbol) + { + return Ok(()); + } + let result = (|| { + let schema = table + .control_checkpoint_schema() + .ok_or("execution step has no checked schema")?; + let queue = table + .control_sequence() + .ok_or("execution step has no checked queue")?; + let definitions = crate::cc::value_identity::definitions(&function.assignments); + let origin = + |v| crate::cc::value_identity::reference_origin(v, |v| definitions.get(&v).copied()); + let Some(A::TagSwitch { cases, .. }) = definitions.get(&origin(function.result)).copied() + else { + return Err("execution step has no input dispatch"); + }; + let parameters = &function.parameters; + if parameters.len() != 6 { + return Err("execution step has an invalid executor contract"); + } + let projection = |value, tag| match definitions.get(&origin(value)).copied() { + Some(A::VariantGet { + representation, + case, + field, + value, + .. + }) if *representation == schema.computation && *case == tag => Some(FinishProjection { + owner: origin(*value), + field: *field, + }), + _ => None, + }; + for tag in [2, 3] { + let case = cases + .iter() + .find(|case| case.tag == tag) + .ok_or("execution step is absent from input dispatch")?; + let Some(A::DirectCall { + function: callee, + arguments, + .. + }) = definitions.get(&origin(case.value)).copied() + else { + return Err("execution step must produce its executor transition"); + }; + if *callee != function.symbol || arguments.len() != 6 { + return Err("execution step must produce its executor transition"); + } + if origin(arguments[0]) != origin(parameters[0]) + || origin(arguments[1]) != origin(parameters[1]) + || origin(arguments[5]) != origin(parameters[5]) + { + return Err( + "execution step must preserve state, root handler and dispatch context", + ); + } + let Some(A::VariantNew { + representation, + case: queue_tag, + fields, + .. + }) = definitions.get(&origin(arguments[3])).copied() + else { + return Err("execution step must retain its pending queue"); + }; + if *representation != queue || fields.len() != 2 { + return Err("execution step must retain its pending queue"); + } + if tag == 2 { + if *queue_tag != 1 || origin(arguments[4]) != origin(parameters[4]) { + return Err( + "Bind must retain its current execution extent and prepend one callback", + ); + } + bind_relation( + origin(parameters[2]), + origin(parameters[3]), + projection(arguments[2], 2), + projection(fields[0], 2), + origin(fields[1]), + )?; + } else { + if *queue_tag != 2 || origin(fields[1]) != origin(parameters[3]) { + return Err("Resume must append replay to its current queue"); + } + let Some(A::VariantNew { + representation, + case: 0, + fields: answer, + .. + }) = definitions.get(&origin(arguments[2])).copied() + else { + return Err("Resume must return its current saved answer"); + }; + if *representation != schema.computation || answer.len() != 1 { + return Err("Resume must return its current saved answer"); + } + resume_answer_relation(origin(parameters[2]), projection(answer[0], 3))?; + let replay = |value, expected| match definitions.get(&origin(value)).copied() { + Some(A::ProductGet { + representation, + field, + value, + .. + }) if *field == expected => Some((*representation, origin(*value))), + _ => None, + }; + let result_schema = table + .control_replay_schema() + .ok_or("Resume has no replay schema")? + .result; + let Some((representation, owner)) = replay(fields[0], 0) else { + return Err("Resume must use its replayed queue and activation"); + }; + if representation != result_schema + || replay(arguments[4], 1) != Some((representation, owner)) + { + return Err("Resume must use its replayed queue and activation"); + } + if !matches!(definitions.get(&owner).copied(), Some(A::DirectCall { function: callee, .. }) if table.control_helpers.iter().any(|h| h.role() == R::CloneSequence && h.function() == *callee)) + { + return Err("Resume must use its replayed queue and activation"); + } + } + } + Ok(()) + })(); + result.map_err(|message| { + vec![ + BackendError::invalid_ir("P8 CC execution steps", function.span, message) + .with_module(function.symbol.module), + ] + }) +} diff --git a/crates/psrs-backend/src/cc/verify/control/traces.rs b/crates/psrs-backend/src/cc/verify/control/traces.rs new file mode 100644 index 00000000..0f1310a3 --- /dev/null +++ b/crates/psrs-backend/src/cc/verify/control/traces.rs @@ -0,0 +1,193 @@ +//! Preserve execution order and exceptional paths through structured CC. +use crate::cc::{Assignment, AssignmentKind as A, ValueId}; +use crate::control::events::Event; +use std::collections::HashMap; + +#[derive(Clone, Default)] +pub(super) struct Trace { + pub(super) events: Vec, + pub(super) casts: Vec, + pub(super) trapped: bool, + pub(super) aliases: HashMap, +} + +pub(super) fn paths( + body: &[Assignment], + input: Trace, + executor: psrs_hir::SymbolId, + definitions: &crate::cc::branch_facts::Definitions<'_>, +) -> Vec { + let mut current = vec![input]; + for assignment in body { + let mut next = Vec::new(); + for mut trace in current { + if trace.trapped { + next.push(trace); + continue; + } + match &assignment.kind { + A::Unreachable => { + trace.trapped = true; + next.push(trace); + } + A::If { + then_assignments, + then_value, + else_assignments, + else_value, + condition, + .. + } => { + for (branch, value, truth) in [ + (then_assignments, then_value, true), + (else_assignments, else_value, false), + ] { + let mut selected = trace.clone(); + if let Some((value, tag)) = crate::cc::branch_facts::equality_selection( + *condition, + truth, + definitions, + &selected.aliases, + ) { + selected.events.push(Event::Select { value, tag }); + } else if let Some((value, tag)) = + crate::cc::branch_facts::equality_selection( + *condition, + !truth, + definitions, + &selected.aliases, + ) + { + selected.events.push(Event::Reject { + value, + tags: vec![tag], + }); + } + for mut path in paths(branch, selected, executor, definitions) { + path.aliases.insert(assignment.destination, *value); + next.push(path); + } + } + } + A::TagSwitch { + value, + cases, + default_assignments, + default_value, + .. + } => { + for case in cases { + let mut selected = trace.clone(); + selected.events.push(Event::Select { + value: *value, + tag: case.tag, + }); + for mut path in paths(&case.assignments, selected, executor, definitions) { + path.aliases.insert(assignment.destination, case.value); + next.push(path); + } + } + trace.events.push(Event::Reject { + value: *value, + tags: cases.iter().map(|case| case.tag).collect(), + }); + for mut path in paths(default_assignments, trace, executor, definitions) { + path.aliases.insert(assignment.destination, *default_value); + next.push(path); + } + } + kind => { + if matches!(kind, A::RepresentationCast { .. }) { + trace.casts.push(assignment.destination); + if let A::RepresentationCast { value, .. } = kind { + trace.events.push(Event::Refine { + result: assignment.destination, + source: crate::cc::value_identity::path_origin( + *value, + definitions, + &trace.aliases, + ), + }); + } + } + let event = match kind { + A::ArrayGet { + representation, + value, + index, + .. + } => Some(Event::Read { + repr: *representation, + cell: *value, + index: *index, + result: assignment.destination, + }), + A::ArraySet { + representation, + value, + index, + new_value, + .. + } => Some(Event::Store { + repr: *representation, + cell: *value, + index: *index, + value: *new_value, + }), + A::IndirectCall { .. } => Some(Event::Apply { + result: assignment.destination, + }), + A::DirectCall { + function, + arguments, + .. + } if *function == executor => Some(Event::Advance { + arguments: arguments.clone(), + }), + A::DirectCall { + function, + arguments, + .. + } => Some(Event::Direct { + function: *function, + arguments: arguments.clone(), + }), + A::RuntimeCall { .. } => Some(Event::OtherCall), + A::FunctionRef { .. } + | A::ProductNew { .. } + | A::VariantNew { .. } + | A::ArrayNew { .. } + | A::ArrayFill { .. } + | A::ArrayAppend { .. } + | A::ArrayClone { .. } + | A::StringToBytes { .. } + | A::BytesToString { .. } => Some(Event::Allocate { + result: assignment.destination, + }), + A::AggregateConvert { conversion, .. } + if !crate::cc::value_identity::transparent(&conversion.plan) => + { + Some(Event::OtherEffect) + } + A::Primitive { + op: crate::cc::BinaryOp::IntQuot | crate::cc::BinaryOp::IntRem, + .. + } => Some(Event::Trap), + _ => None, + }; + if let Some(event) = event { + trace.events.push(event) + } + next.push(trace); + } + } + } + current = next; + } + for path in &mut current { + crate::control::events::canonicalize(&mut path.events, |value| { + crate::cc::value_identity::path_origin(value, definitions, &path.aliases) + }); + } + current +} diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 050e177f..6c3d9c42 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -8,8 +8,8 @@ mod adaptation; mod control; mod helpers; mod ops; -mod read_only; mod scalar; +mod total; mod variant; use helpers::{verify_capture_layout, verify_value_shape}; use ops::{verify_assignments, verify_table}; diff --git a/crates/psrs-backend/src/cc/verify/read_only.rs b/crates/psrs-backend/src/cc/verify/total.rs similarity index 68% rename from crates/psrs-backend/src/cc/verify/read_only.rs rename to crates/psrs-backend/src/cc/verify/total.rs index 392ad49b..e3f10ef7 100644 --- a/crates/psrs-backend/src/cc/verify/read_only.rs +++ b/crates/psrs-backend/src/cc/verify/total.rs @@ -1,4 +1,4 @@ -//! Conservative local call summaries; imported and dynamic calls are unproven. +//! Total local call summaries. Recursive cycles, reads and traps are unproven. use crate::cc::{AssignmentKind as A, Function}; use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; @@ -31,25 +31,21 @@ pub(super) fn functions(functions: &HashMap) -> HashSet { calls.insert(*function); } - // String literals allocate guest arrays and are excluded. + A::Primitive { + op: crate::cc::BinaryOp::IntQuot | crate::cc::BinaryOp::IntRem, + .. + } => { + safe = false; + break; + } A::Constant(_) | A::NumberConstant(_) | A::Primitive { .. } | A::Unary { .. } - | A::RepresentationCast { .. } | A::RepresentationTest { .. } - | A::VariantGet { .. } - | A::VariantTag { .. } - | A::ProductGet { .. } - | A::ArrayGet { .. } - | A::ArrayLen { .. } - | A::ClosureGetCapture { .. } | A::TagSwitch { .. } | A::If { .. } - | A::Unreachable | A::ControlEvidence { .. } => {} - A::AggregateConvert { conversion, .. } - if crate::cc::value_identity::transparent(&conversion.plan) => {} _ => { safe = false; break; @@ -61,15 +57,16 @@ pub(super) fn functions(functions: &HashMap) -> HashSet>(); + // Least fixed point excludes recursion: no-write recursive SCCs may diverge. + let mut safe = HashSet::new(); loop { - let previous = safe.clone(); - safe.retain(|symbol| { - dependencies[symbol] - .iter() - .all(|callee| previous.contains(callee)) - }); - if safe == previous { + let previous = safe.len(); + for (symbol, calls) in &dependencies { + if calls.iter().all(|callee| safe.contains(callee)) { + safe.insert(*symbol); + } + } + if safe.len() == previous { return safe; } } diff --git a/crates/psrs-backend/src/control/dispatch.rs b/crates/psrs-backend/src/control/dispatch.rs new file mode 100644 index 00000000..cb77b950 --- /dev/null +++ b/crates/psrs-backend/src/control/dispatch.rs @@ -0,0 +1,28 @@ +//! Required dispatch alternatives of the control machine, independent of IR. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum Carrier { + Computation, + Queue, + Context, + Reverse, +} + +impl Carrier { + pub(crate) fn tags(self) -> &'static [i32] { + match self { + Self::Computation => &[0, 1, 2, 3, 4, 5], + Self::Queue => &[0, 1, 2, 3], + Self::Context => &[0, 1], + Self::Reverse => &[0, 1, 3], + } + } + + pub(crate) fn verify(self, tags: impl Iterator) -> Result<(), &'static str> { + let mut actual = tags.collect::>(); + actual.sort_unstable(); + if actual != self.tags() { + return Err("control dispatch must cover every required alternative exactly once"); + } + Ok(()) + } +} diff --git a/crates/psrs-backend/src/control/events.rs b/crates/psrs-backend/src/control/events.rs new file mode 100644 index 00000000..4fefa80a --- /dev/null +++ b/crates/psrs-backend/src/control/events.rs @@ -0,0 +1,166 @@ +//! Ordered machine observations shared by all semantic relations and IR adapters. +use crate::cc::ReprId; +use crate::types::ValueId; + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(crate) enum Event { + Read { + repr: ReprId, + cell: ValueId, + index: ValueId, + result: ValueId, + }, + Select { + value: ValueId, + tag: i32, + }, + Store { + repr: ReprId, + cell: ValueId, + index: ValueId, + value: ValueId, + }, + Apply { + result: ValueId, + }, + Advance { + arguments: Vec, + }, + Direct { + function: psrs_hir::SymbolId, + arguments: Vec, + }, + Refine { + result: ValueId, + source: ValueId, + }, + OtherCall, + Allocate { + result: ValueId, + }, + Reject { + value: ValueId, + tags: Vec, + }, + OtherEffect, + Trap, +} + +/// Only allocations feeding the published result or actual transition are +/// machine construction. A dead allocation is not evidence for a required node. +pub(crate) fn allocations( + view: &impl super::execution::Operands, + roots: &[ValueId], + events: &[Event], +) -> Result<(), &'static str> { + let mut pending = roots.to_vec(); + let mut reachable = std::collections::HashSet::new(); + while let Some(value) = pending.pop() { + let value = view.origin(value); + if reachable.insert(value) { + pending.extend(view.inputs(value)); + } + } + if events.iter().any(|event| matches!(event, Event::Allocate { result } if !reachable.contains(&view.origin(*result)))) { + Err("machine execution contains an unrelated allocation") + } else { Ok(()) } +} + +/// Trap paths retain their executed effects. Only a failed machine dispatch or +/// private live-status guard may end a step, and its effects must be a prefix of +/// a validated normal path. Thus trapping cannot hide an extra write or call. +pub(crate) fn exceptional( + view: &impl super::owned::OwnedOperands, + events: &[Event], + normal: &[Vec], + carriers: &[(ReprId, Vec)], + status: ReprId, +) -> Result<(), &'static str> { + let justified = events.iter().enumerate().any(|(point, event)| { + let Event::Reject { value, tags } = event else { return false; }; + if events[point + 1..].iter().any(|event| !matches!(event, Event::Select { .. } | Event::Reject { .. })) { return false; } + if view.integer(*value).is_some_and(|constant| tags.contains(&constant)) { return true; } + if let Some((repr, _)) = view.tag(*value) { + return carriers.iter().any(|(candidate, domain)| *candidate == repr && tags == domain); + } + tags == &[0] && events.iter().any(|event| matches!(event, Event::Read { repr, index, result, .. } if *repr == status && view.integer(*index) == Some(0) && view.origin(*result) == view.origin(*value))) + }); + let observable = |event: &Event| !matches!(event, Event::Select { .. } | Event::Reject { .. }); + let prefix = events + .iter() + .filter(|event| observable(event)) + .collect::>(); + if justified + && normal.iter().any(|path| { + let effects = path + .iter() + .filter(|event| observable(event)) + .collect::>(); + effects.starts_with(&prefix) + }) + { + Ok(()) + } else { + Err("exceptional machine path has unaccounted effects or no failed guard") + } +} + +pub(crate) fn carriers( + table: &crate::cc::RepresentationTable, +) -> Result)>, &'static str> { + let checkpoint = table + .control_checkpoint_schema() + .ok_or("execution has no checkpoint schema")?; + let replay = table + .control_replay_schema() + .ok_or("execution has no replay schema")?; + let owner = super::owned::OwnedSchema::checked(table)?; + [ + checkpoint.computation, + checkpoint.context, + replay.sequence, + replay.boundary, + owner.owner, + ] + .into_iter() + .map(|repr| { + let Some(crate::cc::Representation::Variant { cases }) = table.representation(repr) else { + return Err("execution carrier is not a variant"); + }; + Ok((repr, cases.iter().map(|case| case.tag as i32).collect())) + }) + .collect() +} + +/// Operand identity is path-sensitive. Keep instruction result IDs (and hence +/// their immutable definitions), but resolve every observed input through that +/// path's aliases before comparing prefixes across joins. +pub(crate) fn canonicalize(events: &mut [Event], origin: impl Fn(ValueId) -> ValueId) { + for event in events { + match event { + Event::Read { cell, index, .. } => { + *cell = origin(*cell); + *index = origin(*index); + } + Event::Select { value, .. } | Event::Reject { value, .. } => *value = origin(*value), + Event::Store { + cell, index, value, .. + } => { + *cell = origin(*cell); + *index = origin(*index); + *value = origin(*value); + } + Event::Advance { arguments } | Event::Direct { arguments, .. } => { + for value in arguments { + *value = origin(*value); + } + } + Event::Refine { source, .. } => *source = origin(*source), + Event::Apply { .. } + | Event::Allocate { .. } + | Event::OtherCall + | Event::OtherEffect + | Event::Trap => {} + } + } +} diff --git a/crates/psrs-backend/src/control/execution/mod.rs b/crates/psrs-backend/src/control/execution/mod.rs new file mode 100644 index 00000000..09f262f1 --- /dev/null +++ b/crates/psrs-backend/src/control/execution/mod.rs @@ -0,0 +1,398 @@ +//! The root fold and persistent queue have one operational contract across IRs. +use crate::cc::{ReprId, Representation, RepresentationTable}; +use crate::types::ValueId; +use std::collections::HashMap; + +pub(crate) type Facts = HashMap<(ReprId, ValueId), i32>; + +pub(crate) struct Schema { + pub computation: ReprId, + pub queue: ReprId, + pub context: ReprId, + pub pair: ReprId, + pub close: psrs_hir::SymbolId, + pub check: psrs_hir::SymbolId, + pub clone: psrs_hir::SymbolId, +} + +impl Schema { + pub fn checked(table: &RepresentationTable) -> Result { + let source = table + .control_checkpoint_schema() + .ok_or("execution has no checked source schema")?; + let pair = table + .control_result_pair + .ok_or("execution has no planned result pair")?; + if !matches!(table.representation(pair), Some(Representation::Product { fields }) + if fields == &[crate::cc::payload::erased_shape(); 2]) + { + return Err("execution result pair has an invalid planned representation"); + } + Ok(Self { + computation: source.computation, + queue: table + .control_sequence() + .ok_or("execution has no checked queue schema")?, + context: source.context, + pair, + close: table + .control_helpers + .iter() + .find(|helper| helper.role() == crate::cc::ControlHelperRole::Close) + .ok_or("execution has no Close contract")? + .function(), + check: table + .control_helpers + .iter() + .find(|helper| helper.role() == crate::cc::ControlHelperRole::Check) + .ok_or("execution has no Check contract")? + .function(), + clone: table + .control_helpers + .iter() + .find(|helper| helper.role() == crate::cc::ControlHelperRole::CloneSequence) + .ok_or("execution has no CloneSequence contract")? + .function(), + }) + } +} + +/// Each adapter discharges its IR's explicit operations into operand evidence. +/// Generic SSA/type verification separately checks availability and legality. +pub(crate) trait Operands { + fn inputs(&self, value: ValueId) -> Vec; + fn tag(&self, value: ValueId) -> Option<(ReprId, ValueId)>; + fn origin(&self, value: ValueId) -> ValueId; + fn projection(&self, value: ValueId, repr: ReprId, case: Option) + -> Option<(ValueId, u32)>; + fn node(&self, value: ValueId, repr: ReprId, case: Option) -> Option>; + fn application(&self, value: ValueId) -> Option<(ValueId, Vec)>; + fn raw_resumption(&self, value: ValueId) -> bool; +} + +fn field( + view: &impl Operands, + value: ValueId, + repr: ReprId, + tag: u32, + index: u32, + owner: ValueId, +) -> bool { + view.projection(value, repr, Some(tag)) == Some((view.origin(owner), index)) +} + +fn apply( + view: &impl Operands, + mut result: ValueId, + callee: ValueId, + arguments: &[ValueId], +) -> bool { + for argument in arguments.iter().rev() { + let Some((function, inputs)) = view.application(result) else { + return false; + }; + if inputs.len() != 1 || view.origin(inputs[0]) != view.origin(*argument) { + return false; + } + result = function; + } + view.origin(result) == view.origin(callee) +} + +pub(crate) fn transition( + schema: &Schema, + view: &impl Operands, + facts: &Facts, + current: &[ValueId], + next: &[ValueId], +) -> Result<(), &'static str> { + if current.len() != 6 || next.len() != 6 { + return Err("execution has an invalid executor transition"); + } + let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); + match selected(schema.computation, current[2]) { + Some(1) if selected(schema.context, current[5]) == Some(0) => { + root_request(schema, view, current, next) + } + Some(0) => returned(schema, view, facts, current, next), + Some(1..=5) => Ok(()), // Other owning relations check these steps. + _ => Err("execution exit has no current computation selection"), + } +} + +fn root_request( + schema: &Schema, + view: &impl Operands, + current: &[ValueId], + next: &[ValueId], +) -> Result<(), &'static str> { + for index in [1, 4, 5] { + if view.origin(next[index]) != view.origin(current[index]) { + return Err("root operation must preserve handler, extent and context"); + } + } + if view.node(next[3], schema.queue, Some(0)).as_deref() != Some(&[]) { + return Err("root operation must clear its captured source queue"); + } + let pair = view + .projection(next[0], schema.pair, None) + .filter(|(_, field)| *field == 0) + .ok_or("root operation must consume the same handler result pair")? + .0; + if view.projection(next[2], schema.pair, None) != Some((pair, 1)) { + return Err("root operation must consume the same handler result pair"); + } + let Some((after_request, resume)) = view.application(pair) else { + return Err("root operation must apply its complete handler"); + }; + let Some((after_state, request)) = view.application(after_request) else { + return Err("root operation must apply its complete handler"); + }; + if resume.len() != 1 + || request.len() != 1 + || !view.raw_resumption(resume[0]) + || !field(view, request[0], schema.computation, 1, 0, current[2]) + || !apply(view, after_state, current[1], &[current[0]]) + { + return Err( + "root operation must apply its current handler to state, request and raw resumption", + ); + } + Ok(()) +} + +fn returned( + schema: &Schema, + view: &impl Operands, + facts: &Facts, + current: &[ValueId], + next: &[ValueId], +) -> Result<(), &'static str> { + let selected = |value| facts.get(&(schema.queue, view.origin(value))).copied(); + if selected(current[3]) == Some(0) { + return if facts.get(&(schema.context, view.origin(current[5]))) == Some(&1) { + Ok(()) + } else { + Err("root return must publish its state and current answer") + }; + } + for index in [0, 1, 5] { + if view.origin(next[index]) != view.origin(current[index]) { + return Err("queue execution must preserve state, handler and context"); + } + } + let queue = current[3]; + let finish = selected(queue) == Some(3); + if !finish && view.origin(next[4]) != view.origin(current[4]) { + return Err("queue execution must preserve its current extent"); + } + match selected(queue) { + Some(1) => callback(schema, view, current[2], queue, next[2], next[3]), + Some(2) => { + let left = find_field(view, queue, schema.queue, 2, 0, facts)?; + append(schema, view, facts, current, next, left) + } + Some(3) + if view.origin(next[2]) == view.origin(current[2]) + && field(view, next[3], schema.queue, 3, 1, queue) + && field(view, next[4], schema.queue, 3, 2, queue) => + { + Ok(()) + } + _ => Err("queue execution must consume its selected current frame"), + } +} + +/// The selected Append left operand is retained in facts by its projection ID. +/// Do not invent a value when the producer's projection evidence is absent. +fn find_field( + view: &impl Operands, + owner: ValueId, + repr: ReprId, + tag: u32, + field_index: u32, + facts: &Facts, +) -> Result { + facts + .keys() + .filter(|(candidate, _)| *candidate == repr) + .map(|(_, value)| *value) + .find(|value| field(view, *value, repr, tag, field_index, owner)) + .ok_or("Append must dispatch on its current left queue") +} + +fn callback( + schema: &Schema, + view: &impl Operands, + input: ValueId, + queue: ValueId, + computation: ValueId, + rest: ValueId, +) -> Result<(), &'static str> { + let Some((callee, answer)) = view.application(computation) else { + return Err("queue callback result must enter the next computation"); + }; + if answer.len() != 1 + || !field(view, callee, schema.queue, 1, 0, queue) + || !field(view, answer[0], schema.computation, 0, 0, input) + || !field(view, rest, schema.queue, 1, 1, queue) + { + return Err("queue callback must consume its current answer, callback and tail"); + } + Ok(()) +} + +fn append( + schema: &Schema, + view: &impl Operands, + facts: &Facts, + current: &[ValueId], + next: &[ValueId], + left: ValueId, +) -> Result<(), &'static str> { + let right = |value| field(view, value, schema.queue, 2, 1, current[3]); + let same = view.origin(next[2]) == view.origin(current[2]); + match facts.get(&(schema.queue, view.origin(left))).copied() { + Some(0) if same && right(next[3]) => Ok(()), + Some(1) => { + let node = view + .node(next[3], schema.queue, Some(2)) + .filter(|fields| fields.len() == 2) + .ok_or("Append callback must retain its current right queue")?; + if !right(node[1]) { + return Err("Append callback must retain its current right queue"); + } + callback(schema, view, current[2], left, next[2], node[0]) + } + Some(2) if same => { + let node = view + .node(next[3], schema.queue, Some(2)) + .filter(|fields| fields.len() == 2) + .ok_or("Append reassociation must preserve left-to-right queue order")?; + let tail = view + .node(node[1], schema.queue, Some(2)) + .filter(|fields| fields.len() == 2) + .ok_or("Append reassociation must preserve left-to-right queue order")?; + if field(view, node[0], schema.queue, 2, 0, left) + && field(view, tail[0], schema.queue, 2, 1, left) + && right(tail[1]) + { + Ok(()) + } else { + Err("Append reassociation must preserve left-to-right queue order") + } + } + Some(3) if same => { + let node = view + .node(next[3], schema.queue, Some(3)) + .filter(|fields| fields.len() == 3) + .ok_or("Append must retain the complete left finish frame")?; + let tail = view + .node(node[1], schema.queue, Some(2)) + .filter(|fields| fields.len() == 2) + .ok_or("Append must retain the complete left finish frame")?; + if field(view, node[0], schema.queue, 3, 0, left) + && field(view, node[2], schema.queue, 3, 2, left) + && field(view, tail[0], schema.queue, 3, 1, left) + && right(tail[1]) + { + Ok(()) + } else { + Err("Append must retain the complete left finish frame") + } + } + _ => Err("Append must consume its selected current left frame"), + } +} + +pub(crate) fn publish( + schema: &Schema, + view: &impl Operands, + facts: &Facts, + current: &[ValueId], + result: ValueId, +) -> Result<(), &'static str> { + if current.len() != 6 + || facts.get(&(schema.computation, view.origin(current[2]))) != Some(&0) + || facts.get(&(schema.queue, view.origin(current[3]))) != Some(&0) + || facts.get(&(schema.context, view.origin(current[5]))) != Some(&0) + { + return Err("execution result must be its terminal root return"); + } + let fields = view + .node(result, schema.pair, None) + .filter(|fields| fields.len() == 2) + .ok_or("root return must publish its state and current answer")?; + if view.origin(fields[0]) != view.origin(current[0]) + || !field(view, fields[1], schema.computation, 0, 0, current[2]) + { + return Err("root return must publish its state and current answer"); + } + Ok(()) +} + +/// Coverage is measured only on validated actual exits. Trapping defaults +/// remain legal, but cannot stand in for a required root or queue action. +#[derive(Default)] +pub(crate) struct Coverage(std::collections::HashSet<(i32, i32)>); + +impl Coverage { + pub fn observe( + &mut self, + schema: &Schema, + view: &impl Operands, + facts: &Facts, + current: &[ValueId], + ) { + if current.len() != 6 { + return; + } + let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); + match selected(schema.computation, current[2]) { + Some(1) if selected(schema.context, current[5]) == Some(0) => { + self.0.insert((1, 0)); + } + Some(0) => match selected(schema.queue, current[3]) { + Some(0) if selected(schema.context, current[5]) == Some(0) => { + self.0.insert((0, 0)); + } + Some(1 | 3) => { + self.0 + .insert((0, selected(schema.queue, current[3]).unwrap())); + } + Some(2) => { + if let Ok(left) = find_field(view, current[3], schema.queue, 2, 0, facts) + && let Some(tag @ 0..=3) = selected(schema.queue, left) + { + self.0.insert((2, tag)); + } + } + _ => {} + }, + _ => {} + } + } + + pub fn finish(&self) -> Result<(), &'static str> { + if [ + (1, 0), + (0, 0), + (0, 1), + (0, 3), + (2, 0), + (2, 1), + (2, 2), + (2, 3), + ] + .iter() + .all(|action| self.0.contains(action)) + { + Ok(()) + } else { + Err("execution must retain every root and queue action") + } + } +} + +mod observables; +pub(crate) use observables::verify as effects; diff --git a/crates/psrs-backend/src/control/execution/observables.rs b/crates/psrs-backend/src/control/execution/observables.rs new file mode 100644 index 00000000..9328c5c6 --- /dev/null +++ b/crates/psrs-backend/src/control/execution/observables.rs @@ -0,0 +1,134 @@ +use super::{Facts, Operands, Schema, field, find_field}; +use crate::types::ValueId; + +/// Every dynamic application on a root/queue path is part of its validated +/// transition. Close is the sole static effect of an ordinary Finish step. +pub(crate) fn verify( + schema: &Schema, + view: &impl Operands, + facts: &Facts, + current: &[ValueId], + next: Option<&[ValueId]>, + events: &[crate::control::events::Event], + total: &std::collections::HashSet, +) -> Result<(), &'static str> { + use crate::control::events::Event; + if current.len() != 6 { + return Err("execution has invalid arguments"); + } + let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); + let tag = selected(schema.computation, current[2]); + if !matches!(tag, Some(0..=4)) { + return Ok(()); + } + let context = selected(schema.context, current[5]); + let queue = selected(schema.queue, current[3]); + let count = if !matches!(tag, Some(0 | 1)) { + 0 + } else if tag == Some(1) { + if context == Some(0) { 3 } else { 2 } + } else if queue == Some(1) + || (queue == Some(0) && context == Some(1)) + || (queue == Some(2) + && find_field(view, current[3], schema.queue, 2, 0, facts) + .is_ok_and(|left| selected(schema.queue, left) == Some(1))) + { + 1 + } else { + 0 + }; + let mut expected = std::collections::HashSet::new(); + if count > 0 { + let next = next.ok_or("execution is missing its required application")?; + let mut result = if tag == Some(1) && context == Some(0) { + view.projection(next[0], schema.pair, None) + .ok_or("root operation has no handler result")? + .0 + } else { + next[2] + }; + for _ in 0..count { + expected.insert(view.origin(result)); + result = view + .application(result) + .ok_or("execution is missing its required application")? + .0; + } + } + let finish = tag == Some(0) && queue == Some(3); + let mut closed = false; + let mut advanced = false; + let mut checked = false; + let mut cloned = false; + for event in events { + match event { + Event::Apply { result } if expected.remove(&view.origin(*result)) => {} + Event::Advance { arguments } + if !advanced + && next.is_some_and(|next| { + arguments.len() == next.len() + && arguments + .iter() + .zip(next) + .all(|(left, right)| view.origin(*left) == view.origin(*right)) + }) => + { + advanced = true; + } + Event::Direct { + function, + arguments, + } if finish + && !closed + && *function == schema.close + && arguments.len() == 1 + && field(view, arguments[0], schema.queue, 3, 0, current[3]) => + { + closed = true; + } + Event::Direct { + function, + arguments, + } if tag == Some(3) + && !checked + && *function == schema.check + && arguments.len() == 1 + && field(view, arguments[0], schema.computation, 3, 2, current[2]) => + { + checked = true; + } + Event::Direct { + function, + arguments, + } if tag == Some(3) + && !cloned + && *function == schema.clone + && arguments.len() == 5 + && field(view, arguments[0], schema.computation, 3, 1, current[2]) => + { + cloned = true; + } + Event::Direct { function, .. } if total.contains(function) => {} + Event::Apply { .. } + | Event::Advance { .. } + | Event::Direct { .. } + | Event::OtherCall + | Event::OtherEffect + | Event::Trap + | Event::Read { .. } + | Event::Store { .. } => { + return Err("root or queue execution contains an additional observable operation"); + } + _ => {} + } + } + if !expected.is_empty() + || advanced != next.is_some() + || closed != finish + || checked != (tag == Some(3)) + || cloned != (tag == Some(3)) + { + return Err("root or queue execution is missing its required effects"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/control/lifecycle.rs b/crates/psrs-backend/src/control/lifecycle.rs new file mode 100644 index 00000000..8b9f8db9 --- /dev/null +++ b/crates/psrs-backend/src/control/lifecycle.rs @@ -0,0 +1,137 @@ +//! Extent helper bodies discharge lifecycle semantics independently of callees. +use super::events::Event; +use super::owned::OwnedOperands; +use crate::cc::{ControlHelperRole as R, ReprId, RepresentationTable}; +use crate::types::ValueId; + +pub(crate) struct Schema { + pub boundary: ReprId, + pub status: ReprId, + pub check: psrs_hir::SymbolId, +} +impl Schema { + pub fn checked(table: &RepresentationTable) -> Result { + let replay = table + .control_replay_schema() + .ok_or("lifecycle has no checked extent schema")?; + let check = table + .control_helpers + .iter() + .find(|h| h.role() == R::Check) + .ok_or("lifecycle has no Check contract")? + .function(); + Ok(Self { + boundary: replay.boundary, + status: replay.status, + check, + }) + } +} + +pub(crate) fn verify( + schema: &Schema, + view: &impl OwnedOperands, + role: R, + input: ValueId, + result: Option, + next: Option<&[ValueId]>, + events: &[Event], +) -> Result { + let input = view.origin(input); + let selected = events + .iter() + .filter_map(|event| match event { + Event::Select { value, tag } if view.tag(*value) == Some((schema.boundary, input)) => { + Some(*tag) + } + _ => None, + }) + .collect::>(); + let [tag @ 0..=1] = selected.as_slice() else { + return Err("lifecycle must select its current extent case"); + }; + let is_cell = + |cell| view.projection(cell, schema.boundary, Some(*tag as u32)) == Some((input, 0)); + let is_parent = |value| view.projection(value, schema.boundary, Some(1)) == Some((input, 1)); + let mut read = None; + let mut guarded = false; + let mut written = false; + let mut advanced = false; + for event in events { + match event { + Event::Refine { .. } => {} + Event::Select { value, tag: actual } + if view.tag(*value) == Some((schema.boundary, input)) && actual == tag => {} + Event::Read { + repr, + cell, + index, + result, + } if role == R::Check + && *repr == schema.status + && is_cell(*cell) + && view.integer(*index) == Some(0) + && read.is_none() => + { + read = Some(view.origin(*result)); + } + Event::Select { value, tag: 0 } + if role == R::Check && read == Some(view.origin(*value)) && !guarded => + { + guarded = true; + } + Event::Store { + repr, + cell, + index, + value, + } if role == R::Close + && *repr == schema.status + && is_cell(*cell) + && view.integer(*index) == Some(0) + && view.integer(*value) == Some(1) + && !written => + { + written = true; + } + Event::Direct { + function, + arguments, + } if role == R::Check + && *tag == 1 + && guarded + && *function == schema.check + && arguments.len() == 1 + && is_parent(arguments[0]) + && !advanced => + { + advanced = true; + } + Event::Advance { arguments } + if role == R::Check + && *tag == 1 + && guarded + && arguments.len() == 1 + && is_parent(arguments[0]) + && !advanced => + { + advanced = true; + } + _ => return Err("lifecycle body contains an unaccounted operation"), + } + } + if role == R::Close { + if !written || next.is_some() || result.map(|value| view.origin(value)) != Some(input) { + return Err("Close must write its own closed status and return its extent"); + } + } else if !guarded { + return Err("Check must guard its own live status before returning or checking ancestry"); + } else if *tag == 0 { + if next.is_some() || result.map(|value| view.origin(value)) != Some(input) { + return Err("root Check must return its checked extent"); + } + } else if !advanced || !next.is_some_and(|args| args.len() == 1 && is_parent(args[0])) { + return Err("child Check must continue with its own parent"); + } + Ok(*tag) +} diff --git a/crates/psrs-backend/src/control/mod.rs b/crates/psrs-backend/src/control/mod.rs new file mode 100644 index 00000000..507f036d --- /dev/null +++ b/crates/psrs-backend/src/control/mod.rs @@ -0,0 +1,15 @@ +//! Stage-independent contracts for the control machine. +//! +//! `dispatch` names the required alternatives of each carrier and verifies that +//! a dispatch covers them; `provenance` states the ownership relations that CC +//! and MIR control checks share. Both are independent of any IR shape. +pub(crate) mod dispatch; +pub(crate) mod provenance; +pub(crate) mod steps; + +pub(crate) mod execution; + +pub(crate) mod owned; + +pub(crate) mod events; +pub(crate) mod lifecycle; diff --git a/crates/psrs-backend/src/control/owned.rs b/crates/psrs-backend/src/control/owned.rs new file mode 100644 index 00000000..5ad5e4d0 --- /dev/null +++ b/crates/psrs-backend/src/control/owned.rs @@ -0,0 +1,358 @@ +//! One-shot execution is an ordered transfer of private owner storage. +use super::execution::{Operands, Schema}; +use crate::cc::{ + ControlHelperRole, RefShape, ReprId, Representation, RepresentationTable, ValueShape, +}; +use crate::types::ValueId; + +pub(crate) struct OwnedSchema { + pub owner: ReprId, + pub callback: ReprId, + pub status: ReprId, +} + +impl OwnedSchema { + pub fn checked(table: &RepresentationTable) -> Result { + let repr = |value| match value { + ValueShape::Reference(reference) if !reference.nullable => match reference.heap { + RefShape::Repr(repr) => Some(repr), + _ => None, + }, + _ => None, + }; + let once = table + .control_helpers + .iter() + .find(|helper| helper.role() == ControlHelperRole::Once) + .ok_or("owned execution has no Once contract")?; + let owner = repr( + table + .signature(once.signature()) + .ok_or("owned execution has no Once signature")? + .result, + ) + .ok_or("owned execution has no owner representation")?; + let Some(Representation::Variant { cases }) = table.representation(owner) else { + return Err("owned execution has no owner fields"); + }; + let fields = cases + .iter() + .find(|case| case.tag == 0) + .filter(|case| case.fields.len() == 2) + .ok_or("owned execution has no owner fields")?; + let callback = repr(fields.fields[0]).ok_or("owned execution has no callback cell")?; + let status = repr(fields.fields[1]).ok_or("owned execution has no status cell")?; + if !matches!(table.representation(callback), Some(Representation::Array { element }) if *element == crate::cc::payload::erased_shape()) + || !matches!( + table.representation(status), + Some(Representation::Array { + element: ValueShape::Integer + }) + ) + { + return Err("owned execution has invalid private storage"); + } + Ok(Self { + owner, + callback, + status, + }) + } +} + +pub(crate) trait OwnedOperands: Operands { + fn read(&self, value: ValueId, repr: ReprId) -> Option<(ValueId, i32)>; + fn integer(&self, value: ValueId) -> Option; + fn initial(&self, cell: ValueId, repr: ReprId) -> Option; +} + +use super::events::Event; + +pub(crate) fn verify( + schema: &Schema, + owned: &OwnedSchema, + view: &impl OwnedOperands, + current: &[ValueId], + next: &[ValueId], + events: &[Event], +) -> Result<(), &'static str> { + if current.len() != 6 || next.len() != 6 { + return Err("owned execution has invalid transition arguments"); + } + for index in [0, 1, 3, 4, 5] { + if view.origin(current[index]) != view.origin(next[index]) { + return Err("owned execution must preserve state, handler, queue, extent and context"); + } + } + let (callee, arguments) = view + .application(next[2]) + .filter(|(_, arguments)| arguments.len() == 1) + .ok_or("owned execution must consume its callback result")?; + if view.projection(arguments[0], schema.computation, Some(5)) + != Some((view.origin(current[2]), 1)) + { + return Err("owned execution must pass its current answer"); + } + let (callback, 0) = view + .read(callee, owned.callback) + .ok_or("owned execution must load its own callback slot")? + else { + return Err("owned execution must load its own callback slot"); + }; + let (owner, 0) = view + .projection(callback, owned.owner, Some(0)) + .ok_or("owned execution must load its own callback slot")? + else { + return Err("owned execution must load its own callback slot"); + }; + if view.projection(owner, schema.computation, Some(5)) != Some((view.origin(current[2]), 0)) { + return Err("owned execution must consume its current owner"); + } + let is_status = |value| view.projection(value, owned.owner, Some(0)) == Some((owner, 1)); + let mut pending = None; + let mut running = None; + let mut loaded = None; + let mut cleared = None; + let mut called = None; + let mut consumed = None; + let mut advanced = None; + for (point, event) in events.iter().enumerate() { + match event { + Event::Refine { .. } => {} + Event::Read { + repr, + cell, + index, + result, + } => { + if view.integer(*index) != Some(0) { + return Err("owned execution must access slot zero"); + } + if *repr == owned.callback + && view.origin(*cell) == callback + && view.origin(*result) == view.origin(callee) + { + if loaded.replace(point).is_some() { + return Err("owned execution must load its callback exactly once"); + } + } else if *repr != owned.status || !is_status(*cell) { + return Err("owned execution must read its own private storage"); + } + } + Event::Select { value, tag } => { + if let Some((cell, 0)) = view.read(*value, owned.status) + && (!is_status(cell) || *tag != 0 || pending.replace(point).is_some()) + { + return Err("owned execution must establish Pending exactly once"); + } + } + Event::Store { + repr, + cell, + index, + value, + } => { + if view.integer(*index) != Some(0) { + return Err("owned execution must access slot zero"); + } + if *repr == owned.status && is_status(*cell) { + match view.integer(*value) { + Some(1) if running.replace(point).is_none() => {} + Some(2) if consumed.replace(point).is_none() => {} + _ => { + return Err( + "owned execution must transfer Pending to Running then Consumed", + ); + } + } + } else if *repr == owned.callback + && view.origin(*cell) == callback + && is_status(*value) + && cleared.replace(point).is_none() + { + } else { + return Err("owned execution must clear its callback with its own status cell"); + } + } + Event::Apply { result } + if view.origin(*result) == view.origin(next[2]) + && called.replace(point).is_none() => {} + Event::Advance { arguments } + if arguments.len() == next.len() + && arguments + .iter() + .zip(next) + .all(|(left, right)| view.origin(*left) == view.origin(*right)) + && advanced.replace(point).is_none() => {} + _ => return Err("owned execution contains an additional observable operation"), + } + } + let Some(points) = pending + .zip(running) + .zip(loaded) + .zip(cleared) + .zip(called) + .zip(consumed) + .zip(advanced) + else { + return Err("owned execution is missing its required transfer steps"); + }; + let ((((((pending, running), loaded), cleared), called), consumed), advanced) = points; + if !(pending < running + && running < loaded + && loaded < cleared + && cleared < called + && called < consumed + && consumed < advanced) + { + return Err("owned execution must guard, acquire, load, clear, call and consume in order"); + } + Ok(()) +} + +/// A constructor proves only initial contents. Replay ordered private stores +/// and reads before publication; a later store must not inherit stale evidence. +pub(crate) enum Expected { + Value(ValueId), + Integer(i32), +} + +pub(crate) fn publication( + view: &impl OwnedOperands, + roots: &[ValueId], + cells: &[(ValueId, ReprId, Expected)], + events: &[Event], + total: &std::collections::HashSet, +) -> Result<(), &'static str> { + let mut contents = std::collections::HashMap::new(); + let mut observed = std::collections::HashMap::new(); + for (cell, repr, _) in cells { + let value = view + .initial(*cell, *repr) + .ok_or("control factory must allocate fresh one-slot private cells")?; + contents.insert(view.origin(*cell), view.origin(value)); + } + let resolve = |mut value: ValueId, observed: &std::collections::HashMap| { + value = view.origin(value); + for _ in 0..observed.len() { + if let Some(next) = observed.get(&value) { + value = *next + } else { + break; + } + } + value + }; + for event in events { + match event { + Event::Refine { .. } => {} + Event::Read { + cell, + index, + result, + .. + } => { + if let Some(value) = contents.get(&view.origin(*cell)) { + if view.integer(*index) != Some(0) { + return Err("control factory must access private slot zero"); + } + observed.insert(view.origin(*result), *value); + } else { + return Err("control factory must read its own private storage"); + } + } + Event::Store { + cell, index, value, .. + } => { + if let Some(content) = contents.get_mut(&view.origin(*cell)) { + if view.integer(*index) != Some(0) { + return Err("control factory must access private slot zero"); + } + *content = resolve(*value, &observed); + } else { + return Err("control factory must write its own private storage"); + } + } + Event::Direct { function, .. } if total.contains(function) => {} + Event::Direct { .. } + | Event::Apply { .. } + | Event::Advance { .. } + | Event::OtherCall => { + return Err("control factory must not invoke callbacks before publication"); + } + Event::Allocate { .. } | Event::Select { .. } | Event::Reject { .. } => {} + _ => return Err("control factory contains an additional observable operation"), + } + } + super::events::allocations(view, roots, events)?; + for (cell, _, expected) in cells { + let actual = contents[&view.origin(*cell)]; + let matches = match expected { + Expected::Value(value) => actual == resolve(*value, &observed), + Expected::Integer(value) => view.integer(actual) == Some(*value), + }; + if !matches { + return Err("control factory must publish its required private cell contents"); + } + } + Ok(()) +} + +pub(crate) fn cancel( + owned: &OwnedSchema, + view: &impl OwnedOperands, + owner: ValueId, + result: ValueId, + events: &[Event], +) -> Result<(), &'static str> { + if view.origin(owner) != view.origin(result) { + return Err("cancellation must retain its current owner"); + } + let field = |value, index| { + view.projection(value, owned.owner, Some(0)) == Some((view.origin(owner), index)) + }; + let mut pending = None; + let mut cancelled = None; + let mut cleared = None; + for (point, event) in events.iter().enumerate() { + match event { + Event::Refine { .. } => {} + Event::Read { + repr, cell, index, .. + } if *repr == owned.status && field(*cell, 1) && view.integer(*index) == Some(0) => {} + Event::Select { value, tag } => { + if let Some((cell, 0)) = view.read(*value, owned.status) + && (!field(cell, 1) || *tag != 0 || pending.replace(point).is_some()) + { + return Err("cancellation must establish Pending exactly once"); + } + } + Event::Store { + repr, + cell, + index, + value, + } if view.integer(*index) == Some(0) => { + let cancel = *repr == owned.status + && field(*cell, 1) + && view.integer(*value) == Some(3) + && cancelled.replace(point).is_none(); + let clear = *repr == owned.callback + && field(*cell, 0) + && field(*value, 1) + && cleared.replace(point).is_none(); + if !(cancel || clear) { + return Err("cancellation must cancel and clear its own private storage"); + } + } + _ => return Err("cancellation contains an additional observable operation"), + } + } + if !matches!((pending, cancelled, cleared), (Some(pending), Some(cancelled), Some(cleared)) if pending < cancelled && cancelled < cleared) + { + return Err( + "cancellation must guard Pending, mark Cancelled and clear the callback in order", + ); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/control_provenance.rs b/crates/psrs-backend/src/control/provenance.rs similarity index 70% rename from crates/psrs-backend/src/control_provenance.rs rename to crates/psrs-backend/src/control/provenance.rs index ff3c61c7..c3b8a6d0 100644 --- a/crates/psrs-backend/src/control_provenance.rs +++ b/crates/psrs-backend/src/control/provenance.rs @@ -161,3 +161,73 @@ pub(crate) fn root_extent_relation( } Ok(()) } + +/// Which clause a source computation step applies at its current delimiter. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum ClauseKind { + Return, + Operation, +} + +impl ClauseKind { + /// The scoped context field that holds this clause. + pub(crate) fn field(self) -> u32 { + match self { + Self::Return => 0, + Self::Operation => 1, + } + } + + /// The source computation tag this clause step interprets. + pub(crate) fn source_tag(self) -> i32 { + match self { + Self::Return => 0, + Self::Operation => 1, + } + } + + fn message(self) -> &'static str { + match self { + Self::Return => "source return must apply its scoped return clause", + Self::Operation => "source operation must apply its scoped operation clause", + } + } +} + +/// A source `Return` applies the scoped return clause (field zero); a source +/// `Perform` applies the scoped operation clause (field one). The applied +/// callable must be that clause projection of the current scoped context, not a +/// boundary or another field of the same frame. +pub(crate) fn clause_selection_relation( + kind: ClauseKind, + context: ValueId, + clause: Option, +) -> Result<(), &'static str> { + if clause + != Some(FinishProjection { + owner: context, + field: kind.field(), + }) + { + return Err(kind.message()); + } + Ok(()) +} + +/// The first clause operand is the answer/request of the current source step. +/// The stage verifier separately connects the complete application result to +/// the next executor transition and proves that its calls execute on that path. +pub(crate) fn clause_operand_relation( + input: ValueId, + payload: Option, +) -> Result<(), &'static str> { + if payload + != Some(FinishProjection { + owner: input, + field: 0, + }) + { + return Err("source clause must consume the current computation payload"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/control/steps.rs b/crates/psrs-backend/src/control/steps.rs new file mode 100644 index 00000000..5c1b40c2 --- /dev/null +++ b/crates/psrs-backend/src/control/steps.rs @@ -0,0 +1,42 @@ +//! Operand identities required by the inert Bind and raw Resume transitions. +use super::provenance::FinishProjection; +use crate::types::ValueId; + +pub(crate) fn bind_relation( + input: ValueId, + queue: ValueId, + inner: Option, + callback: Option, + tail: ValueId, +) -> Result<(), &'static str> { + if inner + != Some(FinishProjection { + owner: input, + field: 0, + }) + || callback + != Some(FinishProjection { + owner: input, + field: 1, + }) + || tail != queue + { + return Err("Bind must enter its body with its own callback and current queue"); + } + Ok(()) +} + +pub(crate) fn resume_answer_relation( + input: ValueId, + answer: Option, +) -> Result<(), &'static str> { + if answer + != Some(FinishProjection { + owner: input, + field: 0, + }) + { + return Err("Resume must return its current saved answer"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/lib.rs b/crates/psrs-backend/src/lib.rs index eb4ae36a..aab67ffc 100644 --- a/crates/psrs-backend/src/lib.rs +++ b/crates/psrs-backend/src/lib.rs @@ -3,7 +3,7 @@ mod bindings; mod boundary; pub mod capability; pub mod cc; -mod control_provenance; +mod control; mod linking; pub mod mir; mod pipeline; diff --git a/crates/psrs-backend/src/mir/branch_facts.rs b/crates/psrs-backend/src/mir/branch_facts.rs new file mode 100644 index 00000000..863d30f3 --- /dev/null +++ b/crates/psrs-backend/src/mir/branch_facts.rs @@ -0,0 +1,310 @@ +//! Field-zero equality facts propagated across real CFG edges and SSA joins. +use super::value_identity::{Definitions, definitions, reference_origin}; +use super::{BlockId, Function, Instruction as I, Terminator as T}; +use crate::types::{DefinedTypeId, ValueId}; +use std::collections::{HashMap, VecDeque}; + +pub(crate) type Key = (DefinedTypeId, ValueId); +pub(crate) type Facts = HashMap; + +pub(crate) fn tag_source(value: ValueId, definitions: &Definitions<'_>) -> Option { + let origin = |value| reference_origin(value, definitions); + match definitions.get(&origin(value)).copied()? { + I::StructGet { + type_index, + field: 0, + value, + .. + } => Some((*type_index, origin(*value))), + _ => None, + } +} + +pub(crate) fn compute(function: &Function) -> HashMap { + let definitions = definitions(function); + let origin = |value| reference_origin(value, &definitions); + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + let mut states = HashMap::::from([(function.entry, Facts::new())]); + let mut pending = VecDeque::from([function.entry]); + while let Some(id) = pending.pop_front() { + let Some(block) = blocks.get(&id) else { + continue; + }; + let Some(terminator) = &block.terminator else { + continue; + }; + let mut edges = super::cfg::successors(terminator) + .into_iter() + .map(|target| (target, states[&id].clone())) + .collect::>(); + if let T::Switch { value, cases, .. } = terminator + && let Some(key) = tag_source(*value, &definitions) + { + for (index, (tag, _)) in cases.iter().enumerate() { + edges[index].1.insert(key, *tag); + } + if let Some((_, facts)) = edges.last_mut() { + facts.remove(&key); + } + } + // A join parameter denotes its incoming argument on this edge. Existing + // facts about that parameter must not survive a new loop iteration. + if let T::Jump { + target, arguments, .. + } = terminator + && let Some(successor) = blocks.get(target) + { + for (_, facts) in &mut edges { + let old = facts.clone(); + facts.retain(|(_, value), _| !successor.parameters.contains(value)); + for (parameter, argument) in successor.parameters.iter().zip(arguments) { + for ((ty, value), tag) in &old { + if *value == origin(*argument) { + facts.insert((*ty, *parameter), *tag); + } + } + } + } + } + for (target, incoming) in edges { + if !blocks.contains_key(&target) { + continue; + } + let changed = match states.get_mut(&target) { + None => { + states.insert(target, incoming); + true + } + Some(existing) => { + let before = existing.len(); + existing.retain(|key, tag| incoming.get(key) == Some(tag)); + existing.len() != before + } + }; + if changed { + pending.push_back(target); + } + } + } + states +} + +pub(crate) struct Exit { + pub block: BlockId, + pub facts: Facts, + pub aliases: HashMap, + pub points: Vec<(BlockId, usize)>, + pub rejections: Vec<(ValueId, Vec, (BlockId, usize))>, + pub trapped: bool, + pub selections: Vec<(ValueId, i32, (BlockId, usize))>, +} + +/// Enumerate normal exits within one CFG region. An edge to `stop` exits the +/// region; trapping paths have no result. Keep each path's SSA arguments so a +/// shared return block cannot erase which selected frame produced its result. +pub(crate) fn paths( + function: &Function, + start: BlockId, + stop: Option, +) -> Result, &'static str> { + let definitions = definitions(function); + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + let mut pending = vec![( + start, + Facts::new(), + HashMap::new(), + std::collections::HashSet::new(), + Vec::new(), + Vec::new(), + Vec::new(), + )]; + let mut exits = Vec::new(); + while let Some((id, facts, aliases, mut active, mut points, selections, rejections)) = + pending.pop() + { + if !active.insert(id) { + return Err("execution region has an internal cycle"); + } + let block = blocks.get(&id).ok_or("execution path has no block")?; + points.extend((0..=block.instructions.len()).map(|index| (id, index))); + let terminator = block + .terminator + .as_ref() + .ok_or("execution path has no exit")?; + let origin = |value| super::value_identity::path_origin(value, &definitions, &aliases); + match terminator { + T::Trap { .. } => exits.push(Exit { + block: id, + facts, + aliases, + points, + selections, + rejections, + trapped: true, + }), + T::Return { .. } | T::ReturnCall { .. } | T::ReturnCallRef { .. } => exits.push(Exit { + block: id, + facts, + aliases, + points, + selections, + rejections, + trapped: false, + }), + T::Jump { target, .. } if Some(*target) == stop => exits.push(Exit { + block: id, + facts, + aliases, + points, + selections, + rejections, + trapped: false, + }), + T::Jump { + target, arguments, .. + } => { + let successor = blocks + .get(target) + .ok_or("execution path has no successor")?; + if successor.parameters.len() != arguments.len() { + return Err("execution path has invalid incoming arguments"); + } + let bindings = successor + .parameters + .iter() + .zip(arguments) + .map(|(parameter, argument)| (*parameter, origin(*argument))) + .collect::>(); + let mut next = aliases; + next.extend(bindings); + pending.push((*target, facts, next, active, points, selections, rejections)); + } + T::Branch { + condition, + then_block, + else_block, + .. + } => { + for (target, truth) in [(*then_block, true), (*else_block, false)] { + let mut selected_values = selections.clone(); + let mut rejected_values = rejections.clone(); + if let Some((value, tag)) = + equality_selection(*condition, truth, &definitions, &aliases) + { + selected_values.push((value, tag, (id, block.instructions.len()))); + } else if let Some((value, tag)) = + equality_selection(*condition, !truth, &definitions, &aliases) + { + rejected_values.push((value, vec![tag], (id, block.instructions.len()))); + } + pending.push(( + target, + facts.clone(), + aliases.clone(), + active.clone(), + points.clone(), + selected_values, + rejected_values, + )); + } + } + T::Switch { + value, + cases, + default, + .. + } => { + let selected = match definitions.get(&origin(*value)).copied() { + Some(I::StructGet { + type_index, + field: 0, + value, + .. + }) => Some((*type_index, origin(*value))), + _ => None, + }; + for (tag, target) in cases { + let mut branch = facts.clone(); + if let Some(key) = selected { + branch.insert(key, *tag); + } + let mut selected_values = selections.clone(); + selected_values.push((origin(*value), *tag, (id, block.instructions.len()))); + pending.push(( + *target, + branch, + aliases.clone(), + active.clone(), + points.clone(), + selected_values, + rejections.clone(), + )); + } + let mut fallback = facts; + if let Some(key) = selected { + fallback.remove(&key); + } + let mut rejections = rejections; + rejections.push(( + origin(*value), + cases.iter().map(|(tag, _)| *tag).collect(), + (id, block.instructions.len()), + )); + pending.push(( + *default, fallback, aliases, active, points, selections, rejections, + )); + } + } + } + Ok(exits) +} + +/// Normal-result consumers deliberately exclude exceptional paths. Semantic +/// effect verification uses `paths` to retain all operations preceding a trap. +pub(crate) fn exits( + function: &Function, + start: BlockId, + stop: Option, +) -> Result, &'static str> { + Ok(paths(function, start, stop)? + .into_iter() + .filter(|path| !path.trapped) + .collect()) +} + +fn equality_selection( + condition: ValueId, + truth: bool, + definitions: &Definitions<'_>, + aliases: &HashMap, +) -> Option<(ValueId, i32)> { + let origin = |value| super::value_identity::path_origin(value, definitions, aliases); + let I::Primitive { + op, left, right, .. + } = definitions.get(&origin(condition)).copied()? + else { + return None; + }; + if !matches!( + (op, truth), + (crate::mir::NumericOp::I32Eq, true) | (crate::mir::NumericOp::I32Ne, false) + ) { + return None; + } + for (value, constant) in [(*left, *right), (*right, *left)] { + if let Some(constant) = + super::value_identity::integer_constant(origin(constant), definitions) + { + return Some((origin(value), constant)); + } + } + None +} diff --git a/crates/psrs-backend/src/mir/cfg.rs b/crates/psrs-backend/src/mir/cfg.rs index 8ecad15f..66f595c4 100644 --- a/crates/psrs-backend/src/mir/cfg.rs +++ b/crates/psrs-backend/src/mir/cfg.rs @@ -230,32 +230,69 @@ fn block_distances(by_id: &HashMap, entry: BlockId) -> Has } /// Block dominators shared by SSA and lifecycle verification. +/// +/// Dominance is only defined along paths from the entry. Blocks with no such +/// path are excluded from the result so that an unreachable predecessor cannot +/// shrink a reachable block's dominator set to nothing. pub(crate) fn dominators(function: &Function) -> HashMap> { - let entry = function.entry; + dominators_from(function, function.entry, None) +} + +/// Reachability within a semantic region. `stop` belongs to the next region. +pub(crate) fn reachable_from( + function: &Function, + entry: BlockId, + stop: Option, +) -> HashSet { let blocks = function .blocks .iter() .map(|block| (block.id, block)) .collect::>(); - let all = blocks.keys().copied().collect::>(); - let mut predecessors = blocks - .keys() + let mut reachable = HashSet::new(); + let mut pending = vec![entry]; + while let Some(id) = pending.pop() { + if Some(id) == stop || !reachable.insert(id) { + continue; + } + if let Some(terminator) = blocks.get(&id).and_then(|block| block.terminator.as_ref()) { + pending.extend(successors(terminator)); + } + } + reachable +} + +/// Dominance in the same CFG region used to resolve returned join values. +pub(crate) fn dominators_from( + function: &Function, + entry: BlockId, + stop: Option, +) -> HashMap> { + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + let reachable = reachable_from(function, entry, stop); + let all = reachable.iter().copied().collect::>(); + let mut predecessors = reachable + .iter() .copied() .map(|id| (id, HashSet::new())) .collect::>>(); - for block in blocks.values() { - let Some(terminator) = &block.terminator else { + for id in &reachable { + let Some(terminator) = blocks.get(id).and_then(|block| block.terminator.as_ref()) else { continue; }; for successor in successors(terminator) { if let Some(preds) = predecessors.get_mut(&successor) { - preds.insert(block.id); + preds.insert(*id); } } } - let mut dominators = blocks - .keys() + let mut dominators = reachable + .iter() .copied() .map(|id| { let initial = if id == entry { @@ -268,7 +305,7 @@ pub(crate) fn dominators(function: &Function) -> HashMap>(); loop { let mut changed = false; - for id in blocks.keys().copied().filter(|id| *id != entry) { + for id in reachable.iter().copied().filter(|id| *id != entry) { let mut next = all.clone(); if let Some(preds) = predecessors.get(&id) { if preds.is_empty() { diff --git a/crates/psrs-backend/src/mir/control/checkpoints.rs b/crates/psrs-backend/src/mir/control/checkpoints.rs index 7c345d74..f41da4e7 100644 --- a/crates/psrs-backend/src/mir/control/checkpoints.rs +++ b/crates/psrs-backend/src/mir/control/checkpoints.rs @@ -1,7 +1,7 @@ //! Preserve checkpoint ownership after physical projection and loop conversion. use crate::BackendError; use crate::cc::ControlHelperRole as R; -use crate::control_provenance::{ +use crate::control::provenance::{ CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, }; use crate::mir::{Function, Instruction as I, Module}; diff --git a/crates/psrs-backend/src/mir/control/clauses.rs b/crates/psrs-backend/src/mir/control/clauses.rs new file mode 100644 index 00000000..181a1382 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/clauses.rs @@ -0,0 +1,349 @@ +//! A source return or operation applies its own scoped clause in MIR. +//! +//! The executor's input dispatch selects a source step; within that step's arm, +//! every call of the current scoped context's clause must be the clause that step +//! owns. The scoped exit must consume the complete application result and its +//! calls must dominate that exit. Checks use real CFG identities and edges. +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control::provenance::{ + ClauseKind, FinishProjection, clause_operand_relation, clause_selection_relation, +}; +use crate::mir::value_identity::{ + definitions, loop_header, loop_parameters, precedes, reference_origin, step_definitions, +}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; +use crate::types::DefinedTypeId; +use std::collections::{HashSet, VecDeque}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { + return; + }; + let table = layout.representation_table(); + let Some(helper) = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + else { + return; + }; + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == helper.function()) + else { + return; + }; + let result = (|| { + let schema = table + .control_checkpoint_schema() + .ok_or("clause selection has no checked schema")?; + let scoped = layout + .variant_index(schema.context, 1) + .map_err(|_| "clause selection has no scoped case")?; + let computation = layout + .repr_index(schema.computation) + .map_err(|_| "clause selection has no computation base")?; + let context_base = layout + .repr_index(schema.context) + .map_err(|_| "clause selection has no context base")?; + let payloads = [0, 1].map(|tag| layout.variant_index(schema.computation, tag).ok()); + let payloads = payloads[0] + .zip(payloads[1]) + .ok_or("clause selection has no source payload cases")?; + let context = loop_parameters(function) + .get(5) + .copied() + .ok_or("clause selection has an invalid executor contract")?; + verify_function( + function, + scoped, + computation, + context, + context_base, + payloads, + table + .control_resumption + .as_ref() + .ok_or("clause selection has no raw resumption contract")? + .function(), + ) + })(); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR clause selection", function.span, message) + .with_module(function.symbol.module), + ); + } +} + +fn verify_function( + function: &Function, + scoped: DefinedTypeId, + computation: DefinedTypeId, + context: crate::types::ValueId, + context_base: DefinedTypeId, + payloads: (DefinedTypeId, DefinedTypeId), + raw: psrs_hir::SymbolId, +) -> Result<(), &'static str> { + let definitions = definitions(function); + let origin = |value| reference_origin(value, &definitions); + let Some((dispatch, cases)) = + function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Switch { value, cases, .. }) + if crate::mir::branch_facts::tag_source(*value, &definitions) + .is_some_and(|(base, _)| base == computation) => + { + Some((block.id, cases)) + } + _ => None, + }) + else { + return Ok(()); + }; + for kind in [ClauseKind::Return, ClauseKind::Operation] { + let Some(target) = cases + .iter() + .find(|(tag, _)| *tag == kind.source_tag()) + .map(|(_, block)| *block) + else { + continue; + }; + let mut seen = HashSet::new(); + let mut pending = VecDeque::from([target]); + let mut steps = 0; + while let Some(id) = pending.pop_front() { + if id == dispatch || !seen.insert(id) { + continue; + } + let Some(block) = function.blocks.iter().find(|block| block.id == id) else { + continue; + }; + for instruction in &block.instructions { + let I::ClosureCall { + function: callee, .. + } = instruction + else { + continue; + }; + let Some(I::StructGet { + type_index, + field, + value, + .. + }) = definitions.get(&origin(*callee)).copied() + else { + continue; + }; + if *type_index != scoped { + continue; + } + let Some(field) = field.checked_sub(1) else { + continue; + }; + clause_selection_relation( + kind, + origin(context), + Some(FinishProjection { + owner: origin(*value), + field, + }), + )?; + } + if let Some(terminator) = &block.terminator { + if let T::Switch { value, cases, .. } = terminator + && crate::mir::branch_facts::tag_source(*value, &definitions) + == Some((context_base, origin(context))) + { + let scoped_target = cases + .iter() + .find(|(tag, _)| *tag == 1) + .map(|(_, target)| *target) + .ok_or("source step has no scoped clause path")?; + verify_step( + function, + scoped_target, + kind, + scoped, + if kind == ClauseKind::Return { + payloads.0 + } else { + payloads.1 + }, + raw, + )?; + steps += 1; + } + for successor in crate::mir::cfg::successors(terminator) { + if successor != dispatch { + pending.push_back(successor); + } + } + } + } + if steps == 0 { + return Err("source step has no scoped clause path"); + } + } + Ok(()) +} + +fn verify_step( + function: &Function, + start: crate::mir::BlockId, + kind: ClauseKind, + scoped: DefinedTypeId, + payload_type: DefinedTypeId, + raw: psrs_hir::SymbolId, +) -> Result<(), &'static str> { + let definitions = step_definitions(function, start); + let origin = |value| reference_origin(value, &definitions); + let parameters = loop_parameters(function); + let dominators = crate::mir::cfg::dominators_from(function, start, loop_header(function)); + let points = function + .blocks + .iter() + .flat_map(|block| { + block + .instructions + .iter() + .enumerate() + .filter_map(move |(index, i)| { + i.destination().map(|value| (value, (block.id, index))) + }) + }) + .collect::>(); + let mut pending = VecDeque::from([start]); + let mut seen = HashSet::new(); + let mut transitions = 0; + while let Some(id) = pending.pop_front() { + if !seen.insert(id) { + continue; + } + let block = function + .blocks + .iter() + .find(|block| block.id == id) + .ok_or("source clause path has no block")?; + // Only an actual exit establishes a transition. An earlier call whose + // result is discarded cannot discharge the scoped step obligation. + let transition = match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == loop_header(function) => { + Some((block.instructions.len(), arguments.as_slice())) + } + Some(T::ReturnCall { + function: callee, + arguments, + .. + }) if *callee == function.symbol => { + Some((block.instructions.len(), arguments.as_slice())) + } + Some(T::Return { value, .. }) => { + match definitions.get(&origin(*value)).copied() { + Some(I::Call { + function: callee, + arguments, + .. + }) if *callee == function.symbol => { + let point = points + .get(&origin(*value)) + .copied() + .ok_or("source clause transition has no execution point")?; + if !precedes(point, (id, block.instructions.len()), &dominators) { + return Err("source clause transition must dominate its actual exit"); + } + // Use the call's point for application dominance below. + Some((point.1, arguments.as_slice())) + } + _ => None, + } + } + _ => None, + }; + if let Some((index, arguments)) = transition { + if arguments.len() != 6 { + return Err("source clause result must enter the next executor step"); + } + if origin(arguments[0]) != origin(parameters[0]) + || origin(arguments[1]) != origin(parameters[1]) + { + return Err("source clause transition must preserve its state and root handler"); + } + let mut result = origin(arguments[2]); + let mut consumer = match &block.terminator { + Some(T::Return { value, .. }) => points[&origin(*value)], + _ => (id, index), + }; + let mut payload = None; + let mut resumption = None; + for _ in 0..(if kind == ClauseKind::Return { 1 } else { 2 }) { + let Some(I::ClosureCall { + function: callee, + arguments, + .. + }) = definitions.get(&result).copied() + else { + return Err("source clause result must enter the next executor step"); + }; + let point = points + .get(&result) + .copied() + .ok_or("source clause application has no execution point")?; + if arguments.len() != 1 + || !precedes(point, consumer, &dominators) + || !dominators + .get(&point.0) + .is_some_and(|set| set.contains(&start)) + { + return Err("source clause application must execute in its scoped step"); + } + payload = Some(origin(arguments[0])); + resumption.get_or_insert(origin(arguments[0])); + result = origin(*callee); + consumer = point; + } + let projection = |value, ty| match definitions.get(&value).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *type_index == ty && *field > 0 => Some(FinishProjection { + owner: origin(*value), + field: field - 1, + }), + _ => None, + }; + clause_selection_relation(kind, origin(parameters[5]), projection(result, scoped))?; + clause_operand_relation( + origin(parameters[2]), + projection(payload.unwrap(), payload_type), + )?; + if kind == ClauseKind::Operation + && !matches!(definitions.get(&resumption.unwrap()).copied(), Some(I::ClosureNew { function: target, .. }) if *target == raw) + { + return Err("source operation clause must receive its raw resumption"); + } + transitions += 1; + continue; + } + match &block.terminator { + Some(T::Trap { .. }) => {} + Some(T::Return { .. } | T::ReturnCall { .. } | T::ReturnCallRef { .. }) => { + return Err("source clause result must enter the next executor step"); + } + Some(terminator) => pending.extend(crate::mir::cfg::successors(terminator)), + None => return Err("source clause path has no exit"), + } + } + if transitions == 0 { + return Err("source clause result must enter the next executor step"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control/context_entry.rs b/crates/psrs-backend/src/mir/control/context_entry.rs index e16746ab..3bbc4106 100644 --- a/crates/psrs-backend/src/mir/control/context_entry.rs +++ b/crates/psrs-backend/src/mir/control/context_entry.rs @@ -1,7 +1,9 @@ //! Check source Handle entry over physical fields and executor loop transitions. use crate::BackendError; use crate::cc::ControlHelperRole as R; -use crate::control_provenance::{FinishProjection, context_clause_relation, context_tail_relation}; +use crate::control::provenance::{ + FinishProjection, context_clause_relation, context_tail_relation, +}; use crate::mir::value_identity::{ definitions, fresh_iteration_allocation, loop_header, loop_parameters, reference_origin, }; diff --git a/crates/psrs-backend/src/mir/control/dispatch.rs b/crates/psrs-backend/src/mir/control/dispatch.rs new file mode 100644 index 00000000..04fe847a --- /dev/null +++ b/crates/psrs-backend/src/mir/control/dispatch.rs @@ -0,0 +1,252 @@ +//! Recheck dispatch coverage and selected variant projections over real CFG edges. +use crate::BackendError; +use crate::cc::{ControlHelperRole as R, ReprId}; +use crate::control::dispatch::Carrier; +use crate::mir::branch_facts::{compute, tag_source}; +use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use crate::mir::{BlockId, Function, Instruction as I, Module, Terminator as T}; +use crate::types::DefinedTypeId; +use std::collections::{HashMap, HashSet}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { + return; + }; + let table = layout.representation_table(); + for helper in &table.control_helpers { + let role = helper.role(); + if !matches!(role, R::Executor | R::CloneSequence | R::RebuildSequence) { + continue; + } + let Some(function) = module + .functions + .iter() + .find(|f| f.symbol == helper.function()) + else { + continue; + }; + let result = (|| { + let schema = table + .control_checkpoint_schema() + .ok_or("control dispatch has no checked schema")?; + let queue = table + .control_sequence() + .ok_or("control dispatch has no checked queue schema")?; + let carriers = [ + (schema.computation, Carrier::Computation), + (schema.context, Carrier::Context), + ( + queue, + if role == R::RebuildSequence { + Carrier::Reverse + } else { + Carrier::Queue + }, + ), + ]; + let mut bases = HashMap::new(); + let mut cases = HashMap::new(); + for (repr, carrier) in carriers { + let base = layout + .repr_index(repr) + .map_err(|_| "control dispatch has no physical base")?; + immutable_tag(module, base)?; + bases.insert(base, carrier); + let Some(crate::cc::Representation::Variant { cases: variants }) = + table.representation(repr) + else { + return Err("control dispatch has no variant schema"); + }; + for variant in variants { + let tag = variant.tag; + let case = layout + .variant_index(repr, tag) + .map_err(|_| "control dispatch has no physical case")?; + immutable_tag(module, case)?; + cases.insert(case, (base, tag as i32)); + } + } + let repr: ReprId = if role == R::Executor { + schema.computation + } else { + queue + }; + let entry_type = layout + .repr_index(repr) + .map_err(|_| "control dispatch has no physical input")?; + verify_function(function, role, entry_type, &bases, &cases) + })(); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR control dispatch", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} + +fn verify_function( + function: &Function, + role: R, + entry_type: DefinedTypeId, + bases: &HashMap, + cases: &HashMap, +) -> Result<(), &'static str> { + let definitions = definitions(function); + let origin = |v| reference_origin(v, &definitions); + let parameters = loop_parameters(function); + let index = if role == R::Executor { 2 } else { 0 }; + let input = parameters + .get(index) + .copied() + .ok_or("control dispatch has an invalid parameter contract")?; + let states = compute(function); + let loop_header = loop_header(function); + let header = loop_header.unwrap_or(function.entry); + // The entry block is the loop preheader only when `loop_header` recognizes + // its initialization jump. That single edge starts the first iteration and + // is not a completed iteration, so it does not require the dispatch to + // dominate it; every other jump to the header is a real backedge. + let preheader = loop_header.map(|_| function.entry); + let dominators = crate::mir::cfg::dominators(function); + let mut dispatches = Vec::new(); + for block in &function.blocks { + let Some(facts) = states.get(&block.id) else { + continue; + }; + for instruction in &block.instructions { + if let I::StructGet { + type_index, + field, + value, + .. + } = instruction + && *field > 0 + && let Some((base, tag)) = cases.get(type_index) + { + let owner = origin(*value); + let known = match definitions.get(&owner).copied() { + Some(I::StructNew { + type_index: actual, + arguments, + .. + }) if actual == type_index => arguments.first().and_then(|v| match definitions + .get(&origin(*v)) + .copied() + { + Some(I::Constant { value, .. }) => Some(*value), + _ => None, + }), + _ => facts.get(&(*base, owner)).copied(), + }; + if known.is_some_and(|known| known != *tag) { + return Err( + "control projection must match the selected case of its actual input", + ); + } + } + } + if let Some(T::Switch { + value, + cases, + default, + .. + }) = &block.terminator + && let Some((base, owner)) = tag_source(*value, &definitions) + && let Some(carrier) = bases.get(&base) + { + carrier.verify(cases.iter().map(|(tag, _)| *tag))?; + if !must_trap(function, *default, &mut HashSet::new()) { + return Err("control dispatch must trap on unsupported alternatives"); + } + if base == entry_type { + if role == R::Executor && owner != origin(input) { + return Err("control dispatch must select the current helper input"); + } + // The selected input dispatch is reached on every iteration, + // before any branch's executor work can become observable. + if owner == origin(input) + && dominators + .get(&block.id) + .is_some_and(|d| d.contains(&header)) + { + dispatches.push(block.id); + } + } + } + } + if !dispatches.into_iter().any(|dispatch| { + function + .blocks + .iter() + .filter(|b| states.contains_key(&b.id)) + .all(|block| { + let invokes = block + .instructions + .iter() + .any(crate::mir::effects::may_invoke); + let finishes = matches!( + &block.terminator, + Some(T::Return { .. } | T::ReturnCall { .. } | T::ReturnCallRef { .. }) + ) || matches!(&block.terminator, Some(T::Jump { target, .. }) + if *target == header && Some(block.id) != preheader); + if !invokes && !finishes { + return true; + } + // A terminator dispatch follows this block's instructions, so it + // cannot justify a call earlier in the same block. + (!invokes || block.id != dispatch) + && dominators + .get(&block.id) + .is_some_and(|d| d.contains(&dispatch)) + }) + }) { + return Err("control input dispatch must dominate execution and normal transitions"); + } + Ok(()) +} + +fn immutable_tag(module: &Module, id: DefinedTypeId) -> Result<(), &'static str> { + let definition = module + .types + .iter() + .flat_map(|group| &group.0) + .nth(id.0 as usize); + if !matches!(definition.map(|d| &d.composite), + Some(crate::types::CompositeType::Struct(fields)) if fields.first() == Some(&crate::types::FieldType { + storage: crate::types::StorageType::I32, mutable: false, + })) { + return Err("control dispatch requires an immutable i32 tag field"); + } + Ok(()) +} + +fn must_trap(function: &Function, id: BlockId, active: &mut HashSet) -> bool { + if !active.insert(id) { + return false; + } + let result = function + .blocks + .iter() + .find(|b| b.id == id) + .is_some_and(|block| { + if block + .instructions + .iter() + .any(|i| matches!(i, I::Unreachable { .. })) + { + return true; + } + match &block.terminator { + Some(T::Trap { .. }) => true, + Some(t @ (T::Jump { .. } | T::Branch { .. } | T::Switch { .. })) => { + crate::mir::cfg::successors(t) + .iter() + .all(|id| must_trap(function, *id, active)) + } + _ => false, + } + }); + active.remove(&id); + result +} diff --git a/crates/psrs-backend/src/mir/control/execution.rs b/crates/psrs-backend/src/mir/control/execution.rs new file mode 100644 index 00000000..34881764 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/execution.rs @@ -0,0 +1,323 @@ +//! Discharge physical CFG exits into the shared root and persistent queue rules. +use crate::BackendError; +use crate::cc::{ControlHelperRole as R, ReprId}; +use crate::control::execution::{self, Coverage, Operands, Schema}; +use crate::mir::layout::PlannedLayout; +use crate::mir::value_identity::{ + Definitions, definitions, loop_header, loop_parameters, path_origin, +}; +use crate::mir::{Instruction as I, Module, Terminator as T}; +use crate::types::ValueId; +use std::collections::HashMap; + +pub(super) struct View<'a> { + pub(super) definitions: &'a Definitions<'a>, + pub(super) layout: &'a PlannedLayout, + pub(super) aliases: &'a HashMap, + pub(super) raw: psrs_hir::SymbolId, +} + +impl Operands for View<'_> { + fn inputs(&self, value: ValueId) -> Vec { + match self.definitions.get(&self.origin(value)).copied() { + Some(I::StructNew { arguments, .. } | I::Call { arguments, .. }) => arguments.clone(), + Some(I::ArrayNew { elements, .. }) => elements.clone(), + Some(I::ClosureNew { captures, .. }) => captures.clone(), + Some(I::ClosureCall { + function, + arguments, + .. + }) => std::iter::once(*function) + .chain(arguments.iter().copied()) + .collect(), + Some(I::StructGet { value, .. } | I::ArrayLen { value, .. }) => vec![*value], + Some(I::ArrayNewFilled { length, value, .. }) => vec![*length, *value], + Some(I::ArrayGet { value, index, .. }) => vec![*value, *index], + _ => Vec::new(), + } + } + fn tag(&self, value: ValueId) -> Option<(ReprId, ValueId)> { + let I::StructGet { + type_index, + field: 0, + value, + .. + } = self.definitions.get(&self.origin(value)).copied()? + else { + return None; + }; + self.layout + .representation_table() + .representations + .iter() + .enumerate() + .find_map(|(index, repr)| { + let repr_id = ReprId(index as u32); + (matches!(repr, crate::cc::Representation::Variant { .. }) + && self.layout.repr_index(repr_id).ok() == Some(*type_index)) + .then_some((repr_id, self.origin(*value))) + }) + } + fn origin(&self, value: ValueId) -> ValueId { + path_origin(value, self.definitions, self.aliases) + } + fn projection( + &self, + value: ValueId, + repr: ReprId, + case: Option, + ) -> Option<(ValueId, u32)> { + let expected = match case { + Some(tag) => self.layout.variant_index(repr, tag), + None => self.layout.repr_index(repr), + } + .ok()?; + match self.definitions.get(&self.origin(value)).copied()? { + I::StructGet { + type_index, + field, + value, + .. + } if *type_index == expected => { + let field = if case.is_some() { + field.checked_sub(1)? + } else { + *field + }; + Some((self.origin(*value), field)) + } + _ => None, + } + } + fn node(&self, value: ValueId, repr: ReprId, case: Option) -> Option> { + let expected = match case { + Some(tag) => self.layout.variant_index(repr, tag), + None => self.layout.repr_index(repr), + } + .ok()?; + match self.definitions.get(&self.origin(value)).copied()? { + I::StructNew { + type_index, + arguments, + .. + } if *type_index == expected => { + Some(arguments.get(usize::from(case.is_some())..)?.to_vec()) + } + _ => None, + } + } + fn application(&self, value: ValueId) -> Option<(ValueId, Vec)> { + match self.definitions.get(&self.origin(value)).copied()? { + I::ClosureCall { + function, + arguments, + .. + } => Some((*function, arguments.clone())), + _ => None, + } + } + fn raw_resumption(&self, value: ValueId) -> bool { + matches!(self.definitions.get(&self.origin(value)).copied(), Some(I::ClosureNew { function, .. }) if *function == self.raw) + } +} + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let total = crate::mir::effects::total_functions(module); + for helper in &table.control_helpers { + if helper.role() != R::Executor { + continue; + } + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == helper.function()) + else { + continue; + }; + let result = (|| { + super::traces::entry(function, layout)?; + let schema = Schema::checked(table)?; + let raw = table + .control_resumption + .as_ref() + .ok_or("execution has no raw resumption contract")? + .function(); + let definitions = definitions(function); + let header = loop_header(function); + let exits = crate::mir::branch_facts::paths( + function, + header.unwrap_or(function.entry), + header, + )?; + let carriers = [schema.computation, schema.queue, schema.context] + .into_iter() + .map(|repr| layout.repr_index(repr).map(|index| (index, repr))) + .collect::, _>>() + .map_err(|_| "execution has no planned physical carrier")?; + let normal = exits + .iter() + .filter(|path| !path.trapped) + .map(|path| super::traces::events(function, layout, path)) + .collect::, _>>()?; + let allowed = crate::control::events::carriers(table)?; + let status = table + .control_replay_schema() + .ok_or("execution has no status schema")? + .status; + let mut coverage = Coverage::default(); + for exit in exits { + let view = View { + definitions: &definitions, + layout, + aliases: &exit.aliases, + raw, + }; + let observed = super::traces::events(function, layout, &exit)?; + if exit.trapped { + crate::control::events::exceptional( + &view, &observed, &normal, &allowed, status, + )?; + continue; + } + let facts = exit + .facts + .iter() + .filter_map(|((index, value), tag)| { + carriers + .get(index) + .map(|repr| ((*repr, view.origin(*value)), *tag)) + }) + .collect(); + let block = function + .blocks + .iter() + .find(|block| block.id == exit.block) + .ok_or("execution exit has no block")?; + match block + .terminator + .as_ref() + .ok_or("execution path has no exit")? + { + T::Jump { arguments, .. } + | T::ReturnCall { + function: _, + arguments, + .. + } => { + if matches!(block.terminator, Some(T::ReturnCall { function: target, .. }) if target != function.symbol) + { + return Err("execution must transition to its own executor"); + } + execution::transition( + &schema, + &view, + &facts, + loop_parameters(function), + arguments, + )?; + } + T::Return { value, .. } => match definitions.get(&view.origin(*value)).copied() + { + Some(I::Call { + function: target, + arguments, + .. + }) if *target == function.symbol => execution::transition( + &schema, + &view, + &facts, + loop_parameters(function), + arguments, + )?, + _ => execution::publish( + &schema, + &view, + &facts, + loop_parameters(function), + *value, + )?, + }, + _ => return Err("execution exit must return or transition to its executor"), + } + let next = match block + .terminator + .as_ref() + .ok_or("execution path has no exit")? + { + T::Jump { arguments, .. } | T::ReturnCall { arguments, .. } => { + Some(arguments.as_slice()) + } + T::Return { value, .. } => match definitions.get(&view.origin(*value)).copied() + { + Some(I::Call { + function: target, + arguments, + .. + }) if *target == function.symbol => Some(arguments.as_slice()), + _ => None, + }, + _ => None, + }; + execution::effects( + &schema, + &view, + &facts, + loop_parameters(function), + next, + &observed, + &total, + )?; + let result = match block.terminator.as_ref() { + Some(T::Return { value, .. }) => vec![*value], + _ => Vec::new(), + }; + crate::control::events::allocations(&view, next.unwrap_or(&result), &observed)?; + coverage.observe(&schema, &view, &facts, loop_parameters(function)); + } + coverage.finish() + })(); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR root and queue execution", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} + +impl crate::control::owned::OwnedOperands for View<'_> { + fn integer(&self, value: ValueId) -> Option { + crate::mir::value_identity::integer_constant(self.origin(value), self.definitions) + } + fn initial(&self, cell: ValueId, repr: ReprId) -> Option { + let expected = self.layout.repr_index(repr).ok()?; + match self.definitions.get(&self.origin(cell)).copied()? { + I::ArrayNew { + type_index, + elements, + .. + } if *type_index == expected && elements.len() == 1 => Some(elements[0]), + I::ArrayNewFilled { + type_index, + length, + value, + .. + } if *type_index == expected && self.integer(*length) == Some(1) => Some(*value), + _ => None, + } + } + fn read(&self, value: ValueId, repr: ReprId) -> Option<(ValueId, i32)> { + let expected = self.layout.repr_index(repr).ok()?; + match self.definitions.get(&self.origin(value)).copied()? { + I::ArrayGet { + type_index, + value, + index, + .. + } if *type_index == expected => Some((self.origin(*value), self.integer(*index)?)), + _ => None, + } + } +} diff --git a/crates/psrs-backend/src/mir/control/exits.rs b/crates/psrs-backend/src/mir/control/exits.rs new file mode 100644 index 00000000..a9b2b881 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/exits.rs @@ -0,0 +1,77 @@ +//! A recursive executor call is a terminal transition, never a discarded effect. +use crate::BackendError; +use crate::cc::ControlHelperRole; +use crate::mir::value_identity::{reference_origin, step_definitions}; +use crate::mir::{Function, Instruction, Module, Terminator}; +use std::collections::HashSet; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + for helper in &layout.representation_table().control_helpers { + if helper.role() != ControlHelperRole::Executor { + continue; + } + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == helper.function()) + else { + continue; + }; + if let Err(message) = verify_function(function) { + errors.push( + BackendError::invalid_ir("P9 MIR executor exit", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} + +fn verify_function(function: &Function) -> Result<(), &'static str> { + for block in &function.blocks { + for instruction in &block.instructions { + let Instruction::Call { + destination: result, + function: callee, + .. + } = instruction + else { + continue; + }; + if *callee != function.symbol { + continue; + } + let definitions = step_definitions(function, block.id); + let mut pending = vec![block.id]; + let mut seen = HashSet::new(); + while let Some(id) = pending.pop() { + if !seen.insert(id) { + continue; + } + let exit = function + .blocks + .iter() + .find(|block| block.id == id) + .and_then(|block| block.terminator.as_ref()) + .ok_or("executor transition has no actual exit")?; + match exit { + Terminator::Return { value, .. } + if reference_origin(*value, &definitions) == *result => {} + Terminator::Trap { .. } => {} + Terminator::Return { .. } + | Terminator::ReturnCall { .. } + | Terminator::ReturnCallRef { .. } => { + return Err("executor transition result must reach every normal exit"); + } + Terminator::Jump { target, .. } + if Some(*target) == crate::mir::value_identity::loop_header(function) => + { + return Err("executor transition result must reach every normal exit"); + } + terminator => pending.extend(crate::mir::cfg::successors(terminator)), + } + } + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/control/finish_consumption.rs b/crates/psrs-backend/src/mir/control/finish_consumption.rs index 00aa5319..29d57853 100644 --- a/crates/psrs-backend/src/mir/control/finish_consumption.rs +++ b/crates/psrs-backend/src/mir/control/finish_consumption.rs @@ -1,7 +1,7 @@ //! Recheck lifecycle ownership after physical projection and loop conversion. use crate::BackendError; use crate::cc::ControlHelperRole as R; -use crate::control_provenance::{FinishProjection, finish_relation}; +use crate::control::provenance::{FinishProjection, finish_relation}; use crate::mir::{Function, Instruction as I, Module, Terminator as T}; use crate::types::{DefinedTypeId, ValueId}; diff --git a/crates/psrs-backend/src/mir/control/finish_creation.rs b/crates/psrs-backend/src/mir/control/finish_creation.rs index 8834eae7..61605677 100644 --- a/crates/psrs-backend/src/mir/control/finish_creation.rs +++ b/crates/psrs-backend/src/mir/control/finish_creation.rs @@ -1,7 +1,7 @@ //! Target completion construction and finish copying after physical lowering. use crate::BackendError; use crate::cc::ControlHelperRole as R; -use crate::control_provenance::{FinishProjection, context_finish_relation}; +use crate::control::provenance::{FinishProjection, context_finish_relation}; use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; use crate::mir::{Function, Instruction as I, Module, Terminator as T}; use crate::types::DefinedTypeId; diff --git a/crates/psrs-backend/src/mir/control/initialization.rs b/crates/psrs-backend/src/mir/control/initialization.rs new file mode 100644 index 00000000..72c659fb --- /dev/null +++ b/crates/psrs-backend/src/mir/control/initialization.rs @@ -0,0 +1,126 @@ +//! Freshness and published contents are checked independently after physical layout. +use super::execution::View; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control::execution::Operands; +use crate::control::owned::{self, Expected, OwnedSchema}; +use crate::mir::value_identity::definitions; +use crate::mir::{Module, Terminator as T}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let total = crate::mir::effects::total_functions(module); + for helper in &table.control_helpers { + let role = helper.role(); + if !matches!(role, R::Start | R::Once | R::Cancel) { + continue; + } + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == helper.function()) + else { + continue; + }; + let result = (|| { + let replay = table + .control_replay_schema() + .ok_or("control factory has no private cell schema")?; + let owned = OwnedSchema::checked(table)?; + let definitions = definitions(function); + let exits = crate::mir::branch_facts::paths(function, function.entry, None)?; + let normal = exits + .iter() + .filter(|path| !path.trapped) + .map(|path| super::traces::events(function, layout, path)) + .collect::, _>>()?; + if normal.is_empty() { + return Err("control factory has no normal publication path"); + } + for exit in exits { + let view = View { + definitions: &definitions, + layout, + aliases: &exit.aliases, + raw: table + .control_resumption + .as_ref() + .ok_or("control factory has no raw contract")? + .function(), + }; + if exit.trapped { + crate::control::events::exceptional( + &view, + &super::traces::events(function, layout, &exit)?, + &normal, + &crate::control::events::carriers(table)?, + replay.status, + )?; + continue; + } + let block = function + .blocks + .iter() + .find(|block| block.id == exit.block) + .ok_or("control factory has no exit block")?; + let T::Return { value, .. } = block + .terminator + .as_ref() + .ok_or("control factory has no exit")? + else { + return Err("control factory must publish its planned fresh frame"); + }; + if role == R::Cancel { + if function.parameters.len() != 1 { + return Err("cancellation has invalid parameters"); + } + owned::cancel( + &owned, + &view, + function.parameters[0], + *value, + &super::traces::events(function, layout, &exit)?, + )?; + continue; + } + let repr = if role == R::Start { + replay.boundary + } else { + owned.owner + }; + let fields = view + .node(*value, repr, Some(0)) + .ok_or("control factory must publish its planned fresh frame")?; + let cells = if role == R::Start && fields.len() == 1 { + vec![(fields[0], replay.status, Expected::Integer(0))] + } else if role == R::Once && fields.len() == 2 && function.parameters.len() == 1 { + vec![ + ( + fields[0], + owned.callback, + Expected::Value(function.parameters[0]), + ), + (fields[1], owned.status, Expected::Integer(0)), + ] + } else { + return Err("control factory has invalid frame fields"); + }; + owned::publication( + &view, + &[*value], + &cells, + &super::traces::events(function, layout, &exit)?, + &total, + )?; + } + Ok(()) + })(); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR control initialization", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} diff --git a/crates/psrs-backend/src/mir/control/lifecycle.rs b/crates/psrs-backend/src/mir/control/lifecycle.rs new file mode 100644 index 00000000..1398ae76 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/lifecycle.rs @@ -0,0 +1,118 @@ +//! Recheck extent helper semantics on the physical CFG, including loopification. +use super::execution::View; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control::execution::Operands; +use crate::control::{events, lifecycle}; +use crate::mir::value_identity::{definitions, loop_header, loop_parameters}; +use crate::mir::{Instruction as I, Module, Terminator as T}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { + return; + }; + let table = layout.representation_table(); + for helper in &table.control_helpers { + let role = helper.role(); + if !matches!(role, R::Check | R::Close) { + continue; + } + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == helper.function()) + else { + continue; + }; + let checked = (|| { + super::traces::entry(function, layout)?; + let schema = lifecycle::Schema::checked(table)?; + let parameters = loop_parameters(function); + if parameters.len() != 1 { + return Err("lifecycle helper has invalid parameters"); + } + let definitions = definitions(function); + let header = loop_header(function); + let paths = crate::mir::branch_facts::paths( + function, + header.unwrap_or(function.entry), + header, + )?; + let normal = paths + .iter() + .filter(|path| !path.trapped) + .map(|path| super::traces::events(function, layout, path)) + .collect::, _>>()?; + let mut coverage = std::collections::HashSet::new(); + for path in paths { + let view = View { + definitions: &definitions, + layout, + aliases: &path.aliases, + raw: table + .control_resumption + .as_ref() + .ok_or("lifecycle has no raw contract")? + .function(), + }; + let observed = super::traces::events(function, layout, &path)?; + if path.trapped { + events::exceptional( + &view, + &observed, + &normal, + &[(schema.boundary, vec![0, 1])], + schema.status, + )?; + continue; + } + let block = function + .blocks + .iter() + .find(|block| block.id == path.block) + .ok_or("lifecycle has no exit block")?; + let (result, next) = + match block.terminator.as_ref().ok_or("lifecycle has no exit")? { + T::Jump { arguments, .. } => (None, Some(arguments.as_slice())), + T::ReturnCall { + function: target, + arguments, + .. + } if *target == function.symbol => (None, Some(arguments.as_slice())), + T::Return { value, .. } => { + match definitions.get(&view.origin(*value)).copied() { + Some(I::Call { + function: target, + arguments, + .. + }) if *target == function.symbol => { + (Some(*value), Some(arguments.as_slice())) + } + _ => (Some(*value), None), + } + } + _ => return Err("lifecycle has an invalid exit"), + }; + coverage.insert(lifecycle::verify( + &schema, + &view, + role, + parameters[0], + result, + next, + &observed, + )?); + } + if coverage.len() != 2 { + return Err("lifecycle must retain root and child actions"); + } + Ok(()) + })(); + if let Err(message) = checked { + errors.push( + BackendError::invalid_ir("P9 MIR lifecycle body", function.span, message) + .with_module(function.symbol.module), + ); + } + } +} diff --git a/crates/psrs-backend/src/mir/control/mod.rs b/crates/psrs-backend/src/mir/control/mod.rs index 3502404e..4e5af8de 100644 --- a/crates/psrs-backend/src/mir/control/mod.rs +++ b/crates/psrs-backend/src/mir/control/mod.rs @@ -4,21 +4,44 @@ use crate::BackendError; use crate::mir::Module; mod checkpoints; +mod clauses; mod context_entry; mod contracts; +mod dispatch; +mod execution; +mod exits; mod finish_consumption; mod finish_creation; +mod initialization; +mod lifecycle; +mod owned; +mod publication; +mod refinements; mod replay; mod root; +mod steps; +mod traces; pub(super) use contracts::verify_helper_calls; pub(super) fn verify(module: &Module, errors: &mut Vec) { contracts::verify(module, errors); + dispatch::verify(module, errors); + exits::verify(module, errors); + clauses::verify(module, errors); + root::verify(module, errors); finish_consumption::verify(module, errors); checkpoints::verify(module, errors); replay::verify(module, errors); finish_creation::verify(module, errors); context_entry::verify(module, errors); + steps::verify(module, errors); + execution::verify(module, errors); + owned::verify(module, errors); + lifecycle::verify(module, errors); + initialization::verify(module, errors); + if let Err(mut failures) = publication::verify(module) { + errors.append(&mut failures); + } } diff --git a/crates/psrs-backend/src/mir/control/owned.rs b/crates/psrs-backend/src/mir/control/owned.rs new file mode 100644 index 00000000..d2da6289 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/owned.rs @@ -0,0 +1,101 @@ +//! One-shot transfer evidence follows executed instructions and selected edges. +use super::execution::View; +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control::execution::{Operands, Schema}; +use crate::control::owned::{self, OwnedSchema}; +use crate::mir::value_identity::{definitions, loop_header, loop_parameters}; +use crate::mir::{Instruction as I, Module, Terminator as T}; +use std::collections::HashMap; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { return }; + let table = layout.representation_table(); + let Some(helper) = table + .control_helpers + .iter() + .find(|helper| helper.role() == R::Executor) + else { + return; + }; + let Some(function) = module + .functions + .iter() + .find(|function| function.symbol == helper.function()) + else { + return; + }; + let result = (|| { + let schema = Schema::checked(table)?; + let owned = OwnedSchema::checked(table)?; + let base = layout + .repr_index(schema.computation) + .map_err(|_| "owned execution has no input layout")?; + let definitions = definitions(function); + let header = loop_header(function); + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + let mut transfers = 0; + for exit in + crate::mir::branch_facts::exits(function, header.unwrap_or(function.entry), header)? + { + let view = View { + definitions: &definitions, + layout, + aliases: &exit.aliases, + raw: table + .control_resumption + .as_ref() + .ok_or("owned execution has no raw resumption contract")? + .function(), + }; + if exit + .facts + .get(&(base, view.origin(loop_parameters(function)[2]))) + != Some(&5) + { + continue; + } + let events = super::traces::events(function, layout, &exit)?; + let block = blocks[&exit.block]; + let next = match block + .terminator + .as_ref() + .ok_or("owned execution has no exit")? + { + T::Jump { arguments, .. } | T::ReturnCall { arguments, .. } => arguments, + T::Return { value, .. } => match definitions.get(&view.origin(*value)).copied() { + Some(I::Call { + function: target, + arguments, + .. + }) if *target == function.symbol => arguments, + _ => return Err("owned execution must return its executor transition"), + }, + _ => return Err("owned execution must return its executor transition"), + }; + owned::verify( + &schema, + &owned, + &view, + loop_parameters(function), + next, + &events, + )?; + transfers += 1; + } + if transfers == 0 { + return Err("owned execution has no normal transfer path"); + } + Ok(()) + })(); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR owned execution", function.span, message) + .with_module(function.symbol.module), + ); + } +} diff --git a/crates/psrs-backend/src/mir/control/publication.rs b/crates/psrs-backend/src/mir/control/publication.rs new file mode 100644 index 00000000..011598b3 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/publication.rs @@ -0,0 +1,238 @@ +//! Publication witnesses survive ordinary inlining as physical frame origins. +use super::execution::View; +use crate::control::execution::Operands; +use crate::control::owned::{self, Expected, OwnedSchema}; +use crate::mir::value_identity::{definitions, reference_origin}; +use crate::mir::{BlockId, Function, Instruction as I, Module, Terminator as T}; +use psrs_hir::Intrinsic; +use std::collections::{HashMap, HashSet}; + +type Point = (BlockId, usize); + +pub(super) fn verify(module: &Module) -> Result<(), Vec> { + let Some(layout) = &module.layout else { + return Ok(()); + }; + let table = layout.representation_table(); + if table.control_helpers.is_empty() { + return Ok(()); + } + let total = crate::mir::effects::total_functions(module); + let mut errors = Vec::new(); + for function in &module.functions { + let checked: Result<(), &'static str> = (|| { + let definitions = definitions(function); + let points = + function + .blocks + .iter() + .flat_map(|block| { + block.instructions.iter().enumerate().filter_map( + move |(index, instruction)| { + instruction + .destination() + .map(|value| (value, (block.id, index))) + }, + ) + }) + .collect::>(); + let origin = |value| reference_origin(value, &definitions); + let raw = table + .control_resumption + .as_ref() + .ok_or("publication has no raw contract")? + .function(); + let empty = HashMap::new(); + let view = View { + definitions: &definitions, + aliases: &empty, + layout, + raw, + }; + for block in &function.blocks { + for (index, instruction) in block.instructions.iter().enumerate() { + let I::ControlEvidence { + contract, + implementation, + arguments, + .. + } = instruction + else { + continue; + }; + let Some(proof) = table.control_contracts.get(contract.0 as usize) else { + continue; + }; + let mut end = (block.id, index); + let implementation = origin(*implementation); + let (roots, cells) = match proof.operation() { + Intrinsic::ControlOnce => { + if matches!(definitions.get(&implementation), Some(I::Call { .. })) { + continue; + } + let owned = OwnedSchema::checked(table)?; + let fields = view + .node(implementation, owned.owner, Some(0)) + .filter(|fields| fields.len() == 2) + .ok_or("inlined Once must publish its owner frame")?; + if arguments.len() != 1 { + return Err("Once has invalid callback evidence"); + } + ( + vec![implementation], + vec![ + (fields[0], owned.callback, Expected::Value(arguments[0])), + (fields[1], owned.status, Expected::Integer(0)), + ], + ) + } + Intrinsic::ControlRun => { + let Some(I::Call { arguments, .. }) = + definitions.get(&implementation).copied() + else { + continue; + }; + if arguments.len() != 6 { + continue; + } + let extent = origin(arguments[4]); + if matches!(definitions.get(&extent), Some(I::Call { .. })) { + continue; + } + let replay = table + .control_replay_schema() + .ok_or("publication has no extent schema")?; + let fields = view + .node(extent, replay.boundary, Some(0)) + .filter(|fields| fields.len() == 1) + .ok_or("inlined Start must publish its root frame")?; + end = *points + .get(&implementation) + .ok_or("publication has no executor point")?; + ( + arguments.clone(), + vec![(fields[0], replay.status, Expected::Integer(0))], + ) + } + _ => continue, + }; + let producers = cells + .iter() + .map(|(cell, _, _)| { + points + .get(&origin(*cell)) + .copied() + .ok_or("publication has no private cell producer") + }) + .collect::, _>>()?; + // Inlining inserts the whole factory at one call site. Its + // fresh private cells must share that dominating block. + let start_block = producers[0].0; + if producers.iter().any(|point| point.0 != start_block) { + return Err("inlined factory cells must share their allocation site"); + } + let start = ( + start_block, + producers.iter().map(|point| point.1).min().unwrap(), + ); + let window = window(function, start, end)?; + let paths = crate::mir::branch_facts::paths(&window, start_block, None)?; + if paths.is_empty() { + return Err("inlined factory has no publication path"); + } + for path in paths.into_iter().filter(|path| path.block == end.0) { + if path.trapped { + return Err("inlined factory traps before publication"); + } + let view = View { + definitions: &definitions, + aliases: &path.aliases, + layout, + raw, + }; + let mut observed = super::traces::events(&window, layout, &path)?; + if proof.operation() == Intrinsic::ControlRun { + // An exclusive caller can build both candidate Run + // contexts before choosing an executor. These ordinary + // caller allocations do not alter the private status. + observed.retain(|event| { + !matches!(event, crate::control::events::Event::Allocate { .. }) + }); + } + owned::publication(&view, &roots, &cells, &observed, &total)?; + } + } + } + Ok(()) + })(); + if let Err(message) = checked { + errors.push( + crate::BackendError::invalid_ir( + "P9 MIR control publication", + function.span, + message, + ) + .with_module(function.symbol.module), + ); + } + } + if errors.is_empty() { + Ok(()) + } else { + Err(errors) + } +} + +/// Restrict to paths between the allocation and its publication. Other branches +/// can have their own Run witnesses; they do not belong to this invocation. +fn window(function: &Function, start: Point, end: Point) -> Result { + let mut reaches = HashSet::from([end.0]); + loop { + let before = reaches.len(); + for block in &function.blocks { + if block.terminator.as_ref().is_some_and(|t| { + crate::mir::cfg::successors(t) + .iter() + .any(|id| reaches.contains(id)) + }) { + reaches.insert(block.id); + } + } + if before == reaches.len() { + break; + } + } + if !reaches.contains(&start.0) { + return Err("private allocation cannot reach publication"); + } + let mut window = function.clone(); + window.entry = start.0; + window.blocks.retain(|block| reaches.contains(&block.id)); + for block in &mut window.blocks { + if block.id == end.0 { + block.instructions.truncate(end.1); + block.terminator = Some(T::Return { + value: function.result, + span: function.span, + }); + } + if block.id == start.0 { + block.instructions.drain(..start.1); + } + } + // Off-path successors cannot publish this witness. Preserve their edge IDs + // as empty exceptional exits without traversing another invocation. + for block in &function.blocks { + if !reaches.contains(&block.id) { + window.blocks.push(crate::mir::BasicBlock { + id: block.id, + parameters: block.parameters.clone(), + instructions: vec![], + terminator: Some(T::Trap { + span: function.span, + }), + }); + } + } + Ok(window) +} diff --git a/crates/psrs-backend/src/mir/control/refinements.rs b/crates/psrs-backend/src/mir/control/refinements.rs new file mode 100644 index 00000000..c6ce7a13 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/refinements.rs @@ -0,0 +1,105 @@ +//! Refinements need static subtyping, a selected case, or a checked callback role. +use super::execution::View; +use crate::control::execution::Operands; +use crate::mir::branch_facts::Exit; +use crate::mir::layout::PlannedLayout; +use crate::mir::{Function, Instruction as I, Terminator as T}; +use crate::types::{HeapType, RefType, ValueId, ValueType}; + +pub(super) fn checked( + view: &View<'_>, + function: &Function, + layout: &PlannedLayout, + path: &Exit, + value: ValueId, + target: RefType, +) -> bool { + let definitions = view.definitions; + let source = view.origin(value); + let defined = layout.types().iter().flat_map(|g| &g.0).collect::>(); + if function + .values + .iter() + .find(|v| v.id == source) + .is_some_and(|v| match v.ty { + ValueType::Ref(actual) => { + (target.nullable || !actual.nullable) + && crate::mir::verify::heap_subtype(actual.heap, target.heap, &defined) + } + _ => false, + }) + { + return true; + } + let applied = path.points.iter().any(|(id,index)| function.blocks.iter().find(|b| b.id == *id).and_then(|b| b.instructions.get(*index)).is_some_and(|i| matches!(i, I::ClosureCall { function: callee, .. } if view.origin(*callee) == source))); + if target.heap == HeapType::Eq && applied { + return true; + } + let HeapType::Index(target_index) = target.heap else { + return false; + }; + let table = layout.representation_table(); + for (index, repr) in table.representations.iter().enumerate() { + let repr_id = crate::cc::ReprId(index as u32); + if let crate::cc::Representation::Variant { cases } = repr + && cases.len() == 1 + && layout.variant_index(repr_id, cases[0].tag).ok() == Some(target_index) + && let Some(base) = layout.repr_index(repr_id).ok() && function.values.iter().find(|v| v.id == source).is_some_and(|v| matches!(v.ty, ValueType::Ref(actual) if !actual.nullable && crate::mir::verify::heap_subtype(actual.heap, HeapType::Index(base), &defined))) { return true; } + } + // A physical case cast is licensed by this path's immutable selected tag. + for ((base, selected), tag) in &path.facts { + if view.origin(*selected) != source { + continue; + } + for (index, repr) in table.representations.iter().enumerate() { + let repr_id = crate::cc::ReprId(index as u32); + if matches!(repr, crate::cc::Representation::Variant { .. }) + && layout.repr_index(repr_id).ok() == Some(*base) + && layout.variant_index(repr_id, *tag as u32).ok() == Some(target_index) + { + return true; + } + } + } + // Ordinary callback ABI recovery is justified only for an actual applied + // callee. The owning execution relation checks the complete application and + // its checked source role, including its returned Control computation. + if layout + .closure_layout() + .ok() + .is_some_and(|(closure, _)| closure == target_index) + { + return applied; + } + let Some(schema) = table.control_checkpoint_schema() else { + return false; + }; + let Some(block) = function.blocks.iter().find(|b| b.id == path.block) else { + return false; + }; + let arguments = match &block.terminator { + Some(T::Jump { arguments, .. } | T::ReturnCall { arguments, .. }) => { + Some(arguments.as_slice()) + } + Some(T::Return { value, .. }) => match definitions.get(&view.origin(*value)).copied() { + Some(I::Call { + function: callee, + arguments, + .. + }) if *callee == function.symbol => Some(arguments.as_slice()), + _ => None, + }, + _ => None, + }; + if let Some(pair) = table.control_result_pair + && layout.repr_index(pair).ok() == Some(target_index) + { + return arguments.is_some_and(|args| { + args.len() == 6 + && view.projection(args[0], pair, None) == Some((source, 0)) + && view.projection(args[2], pair, None) == Some((source, 1)) + }); + } + layout.repr_index(schema.computation).ok() == Some(target_index) + && arguments.is_some_and(|args| args.len() == 6 && view.origin(args[2]) == source) +} diff --git a/crates/psrs-backend/src/mir/control/replay.rs b/crates/psrs-backend/src/mir/control/replay.rs index 1053601e..5878b099 100644 --- a/crates/psrs-backend/src/mir/control/replay.rs +++ b/crates/psrs-backend/src/mir/control/replay.rs @@ -1,7 +1,7 @@ //! Check replay lifecycle allocations and transitions after loop conversion. use crate::BackendError; use crate::cc::ControlHelperRole as R; -use crate::control_provenance::{ +use crate::control::provenance::{ FinishProjection, replay_activation_relation, saved_finish_relation, }; use crate::mir::value_identity::{ @@ -68,9 +68,9 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { status, result, }; - let read_only = crate::mir::opt::effects::read_only_functions(module); + let total = crate::mir::effects::total_functions(module); for (function, role) in functions { - if let Err(message) = verify_function(function, role, table, &schema, &read_only) { + if let Err(message) = verify_function(function, role, table, &schema, &total) { errors.push( BackendError::invalid_ir("P9 MIR control replay", function.span, message) .with_module(function.symbol.module), @@ -84,7 +84,7 @@ fn verify_function( role: R, table: &crate::cc::RepresentationTable, schema: &Schema, - read_only: &HashSet, + total: &HashSet, ) -> Result<(), &'static str> { let parameters = loop_parameters(function); if parameters.len() != if role == R::CloneSequence { 5 } else { 4 } { @@ -123,10 +123,10 @@ fn verify_function( let dominators = crate::mir::cfg::dominators(function); for block in &function.blocks { for (index, instruction) in block.instructions.iter().enumerate() { - let read_only_call = matches!(instruction, - I::Call { function, .. } | I::CallVoid { function, .. } if read_only.contains(function)); - if crate::mir::opt::effects::may_invoke(instruction) - && !read_only_call + let total_call = matches!(instruction, + I::Call { function, .. } | I::CallVoid { function, .. } if total.contains(function)); + if crate::mir::effects::may_invoke(instruction) + && !total_call && !matches!(instruction, I::Call { contract: Some(id), .. } if table.control_helpers.get(id.0 as usize).is_some_and(|helper| matches!(helper.role(), R::Check | R::CloneSequence | R::RebuildSequence))) diff --git a/crates/psrs-backend/src/mir/control/root.rs b/crates/psrs-backend/src/mir/control/root.rs index ea20f5f3..74c51889 100644 --- a/crates/psrs-backend/src/mir/control/root.rs +++ b/crates/psrs-backend/src/mir/control/root.rs @@ -1,7 +1,7 @@ //! Root initialization and normal completion after physical lowering. use crate::BackendError; use crate::cc::{ControlHelperRole as R, RepresentationTable}; -use crate::control_provenance::root_extent_relation; +use crate::control::provenance::root_extent_relation; use crate::mir::value_identity::{definitions, fresh_iteration_allocation, reference_origin}; use crate::mir::{Function, Instruction as I, Module, Terminator as T}; use crate::types::DefinedTypeId; diff --git a/crates/psrs-backend/src/mir/control/steps.rs b/crates/psrs-backend/src/mir/control/steps.rs new file mode 100644 index 00000000..f9fe4d37 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/steps.rs @@ -0,0 +1,200 @@ +//! Bind and Resume operand identities on actual executor transitions. +use crate::BackendError; +use crate::cc::ControlHelperRole as R; +use crate::control::provenance::FinishProjection; +use crate::control::steps::{bind_relation, resume_answer_relation}; +use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; +use crate::mir::{Instruction as I, Module, Terminator as T}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { + return; + }; + let table = layout.representation_table(); + let Some(helper) = table + .control_helpers + .iter() + .find(|h| h.role() == R::Executor) + else { + return; + }; + let Some(function) = module + .functions + .iter() + .find(|f| f.symbol == helper.function()) + else { + return; + }; + let result = (|| { + let schema = table + .control_checkpoint_schema() + .ok_or("execution step has no checked schema")?; + let queue = table + .control_sequence() + .ok_or("execution step has no checked queue")?; + let base = layout + .repr_index(schema.computation) + .map_err(|_| "execution step has no input layout")?; + let bind = layout + .variant_index(schema.computation, 2) + .map_err(|_| "Bind has no physical case")?; + let resume = layout + .variant_index(schema.computation, 3) + .map_err(|_| "Resume has no physical case")?; + let returned = layout + .variant_index(schema.computation, 0) + .map_err(|_| "Return has no physical case")?; + let cons = layout + .variant_index(queue, 1) + .map_err(|_| "Cons has no physical case")?; + let append = layout + .variant_index(queue, 2) + .map_err(|_| "Append has no physical case")?; + let replay = layout + .repr_index( + table + .control_replay_schema() + .ok_or("Resume has no replay schema")? + .result, + ) + .map_err(|_| "Resume has no replay layout")?; + let definitions = definitions(function); + let origin = |v| reference_origin(v, &definitions); + let parameters = loop_parameters(function); + if parameters.len() != 6 { + return Err("execution step has an invalid executor contract"); + } + let states = crate::mir::branch_facts::compute(function); + let projection = |value, ty| match definitions.get(&origin(value)).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *type_index == ty && *field > 0 => Some(FinishProjection { + owner: origin(*value), + field: field - 1, + }), + _ => None, + }; + let replay_field = |value, expected| match definitions.get(&origin(value)).copied() { + Some(I::StructGet { + type_index, + field, + value, + .. + }) if *type_index == replay && *field == expected => Some(origin(*value)), + _ => None, + }; + let mut counts = [0, 0]; + for block in &function.blocks { + let Some(tag @ (2 | 3)) = states + .get(&block.id) + .and_then(|s| s.get(&(base, origin(parameters[2])))) + .copied() + else { + continue; + }; + let transitions = block + .instructions + .iter() + .filter_map(|i| match i { + I::Call { + function: callee, + arguments, + .. + } if *callee == function.symbol => Some(arguments.as_slice()), + _ => None, + }) + .chain(match &block.terminator { + Some(T::Jump { + target, arguments, .. + }) if Some(*target) == loop_header(function) => Some(arguments.as_slice()), + Some(T::ReturnCall { + function: callee, + arguments, + .. + }) if *callee == function.symbol => Some(arguments.as_slice()), + _ => None, + }); + for arguments in transitions { + if arguments.len() != 6 { + return Err("execution step must produce its executor transition"); + } + if origin(arguments[0]) != origin(parameters[0]) + || origin(arguments[1]) != origin(parameters[1]) + || origin(arguments[5]) != origin(parameters[5]) + { + return Err( + "execution step must preserve state, root handler and dispatch context", + ); + } + let Some(I::StructNew { + type_index, + arguments: pending, + .. + }) = definitions.get(&origin(arguments[3])).copied() + else { + return Err("execution step must retain its pending queue"); + }; + if pending.len() != 3 { + return Err("execution step must retain its pending queue"); + } + if tag == 2 { + if *type_index != cons || origin(arguments[4]) != origin(parameters[4]) { + return Err( + "Bind must retain its current execution extent and prepend one callback", + ); + } + bind_relation( + origin(parameters[2]), + origin(parameters[3]), + projection(arguments[2], bind), + projection(pending[1], bind), + origin(pending[2]), + )?; + } else { + if *type_index != append || origin(pending[2]) != origin(parameters[3]) { + return Err("Resume must append replay to its current queue"); + } + let Some(I::StructNew { + type_index, + arguments: answer, + .. + }) = definitions.get(&origin(arguments[2])).copied() + else { + return Err("Resume must return its current saved answer"); + }; + if *type_index != returned || answer.len() != 2 { + return Err("Resume must return its current saved answer"); + } + resume_answer_relation(origin(parameters[2]), projection(answer[1], resume))?; + let owner = replay_field(pending[1], 0) + .ok_or("Resume must use its replayed queue and activation")?; + if replay_field(arguments[4], 1) != Some(owner) + || !matches!(definitions.get(&owner).copied(), Some(I::Call { function: callee, .. }) if table.control_helpers.iter().any(|h| h.role() == R::CloneSequence && h.function() == *callee)) + { + return Err("Resume must use its replayed queue and activation"); + } + } + counts[(tag - 2) as usize] += 1; + } + if matches!( + &block.terminator, + Some(T::Return { .. } | T::ReturnCallRef { .. }) + ) { + return Err("execution step must produce its executor transition"); + } + } + if counts.contains(&0) { + return Err("execution step must produce its executor transition"); + } + Ok(()) + })(); + if let Err(message) = result { + errors.push( + BackendError::invalid_ir("P9 MIR execution steps", function.span, message) + .with_module(function.symbol.module), + ); + } +} diff --git a/crates/psrs-backend/src/mir/control/traces.rs b/crates/psrs-backend/src/mir/control/traces.rs new file mode 100644 index 00000000..59a71086 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/traces.rs @@ -0,0 +1,229 @@ +//! Normalize executed effects without rebuilding scalar or reference identities. +use crate::cc::{ReprId, Representation}; +use crate::control::events::Event; +use crate::control::execution::Operands; +use crate::mir::branch_facts::Exit; +use crate::mir::layout::PlannedLayout; +use crate::mir::{Function, Instruction as I, Terminator as T}; +use std::collections::HashMap; + +pub(super) fn events( + function: &Function, + layout: &PlannedLayout, + exit: &Exit, +) -> Result, &'static str> { + let arrays = layout + .representation_table() + .representations + .iter() + .enumerate() + .filter_map(|(index, repr)| { + matches!(repr, Representation::Array { .. }).then_some(ReprId(index as u32)) + }) + .filter_map(|repr| layout.repr_index(repr).ok().map(|index| (index, repr))) + .collect::>(); + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect::>(); + let definitions = crate::mir::value_identity::definitions(function); + let raw = layout + .representation_table() + .control_resumption + .as_ref() + .ok_or("execution has no raw contract")? + .function(); + let view = super::execution::View { + definitions: &definitions, + layout, + aliases: &exit.aliases, + raw, + }; + let mut events = Vec::new(); + for (id, index) in &exit.points { + let block = blocks.get(id).ok_or("execution trace has no block")?; + let Some(instruction) = block.instructions.get(*index) else { + for (value, tag, point) in &exit.selections { + if point == &(*id, *index) { + events.push(Event::Select { + value: *value, + tag: *tag, + }); + } + } + for (value, tags, point) in &exit.rejections { + if point == &(*id, *index) { + events.push(Event::Reject { + value: *value, + tags: tags.clone(), + }); + } + } + if *id == exit.block { + match block + .terminator + .as_ref() + .ok_or("execution trace has no exit")? + { + T::Jump { arguments, .. } | T::ReturnCall { arguments, .. } => { + events.push(Event::Advance { + arguments: arguments.clone(), + }) + } + _ => {} + } + } + continue; + }; + let event = match instruction { + I::RefCast { + value, reference, .. + } if !exit.trapped + && !super::refinements::checked( + &view, function, layout, exit, *value, *reference, + ) => + { + Some(Event::Trap) + } + I::RefCast { + destination, value, .. + } => Some(Event::Refine { + result: *destination, + source: crate::mir::value_identity::path_origin( + *value, + &definitions, + &exit.aliases, + ), + }), + I::Unreachable { .. } + if exit.trapped && *id == exit.block && *index + 1 == block.instructions.len() => + { + None + } + I::ArrayGet { + type_index, + value, + index, + destination, + .. + } => Some(Event::Read { + repr: *arrays + .get(type_index) + .ok_or("execution reads an unplanned array")?, + cell: *value, + index: *index, + result: *destination, + }), + I::ArraySet { + type_index, + value, + index, + new_value, + .. + } => Some(Event::Store { + repr: *arrays + .get(type_index) + .ok_or("execution writes an unplanned array")?, + cell: *value, + index: *index, + value: *new_value, + }), + I::StructNew { destination, .. } + | I::ClosureNew { destination, .. } + | I::ArrayNew { destination, .. } + | I::ArrayNewSized { destination, .. } + | I::ArrayNewFilled { destination, .. } + | I::ArrayNewData { destination, .. } => Some(Event::Allocate { + result: *destination, + }), + I::TrapIf { .. } + | I::Unreachable { .. } + | I::Primitive { + op: crate::mir::NumericOp::I32DivS | crate::mir::NumericOp::I32RemS, + .. + } => Some(Event::Trap), + I::ClosureCall { destination, .. } => Some(Event::Apply { + result: *destination, + }), + I::Call { + function: target, + arguments, + .. + } if *target == function.symbol => Some(Event::Advance { + arguments: arguments.clone(), + }), + I::Call { + function, + arguments, + .. + } + | I::CallVoid { + function, + arguments, + .. + } => Some(Event::Direct { + function: *function, + arguments: arguments.clone(), + }), + I::StringToBytes { .. } | I::ArrayClone { .. } => Some(Event::OtherEffect), + instruction if crate::mir::effects::may_invoke(instruction) => Some(Event::OtherCall), + instruction if crate::mir::effects::classify(instruction).writes_memory => { + Some(Event::OtherEffect) + } + instruction + if crate::mir::effects::classify(instruction).reads_memory + && !matches!( + instruction, + I::StructGet { .. } | I::ClosureGetCapture { .. } + ) => + { + Some(Event::OtherEffect) + } + _ => None, + }; + if let Some(event) = event { + events.push(event) + } + } + crate::control::events::canonicalize(&mut events, |value| view.origin(value)); + Ok(events) +} + +/// Loop initialization is part of helper execution, before its first dispatch. +pub(super) fn entry(function: &Function, layout: &PlannedLayout) -> Result<(), &'static str> { + let Some(header) = crate::mir::value_identity::loop_header(function) else { + return Ok(()); + }; + let definitions = crate::mir::value_identity::definitions(function); + let raw = layout + .representation_table() + .control_resumption + .as_ref() + .ok_or("entry has no raw contract")? + .function(); + for path in crate::mir::branch_facts::paths(function, function.entry, Some(header))? { + if path.trapped { + return Err("machine entry cannot trap before dispatch"); + } + let view = super::execution::View { + definitions: &definitions, + layout, + aliases: &path.aliases, + raw, + }; + let observed = events(function, layout, &path)?; + let [Event::Advance { arguments }] = observed.as_slice() else { + return Err("machine entry contains an additional observable operation"); + }; + if arguments.len() != function.parameters.len() + || !arguments + .iter() + .zip(&function.parameters) + .all(|(a, b)| view.origin(*a) == view.origin(*b)) + { + return Err("machine entry must initialize its own parameters"); + } + } + Ok(()) +} diff --git a/crates/psrs-backend/src/mir/opt/effects.rs b/crates/psrs-backend/src/mir/effects.rs similarity index 74% rename from crates/psrs-backend/src/mir/opt/effects.rs rename to crates/psrs-backend/src/mir/effects.rs index 9a3baad2..c85376a8 100644 --- a/crates/psrs-backend/src/mir/opt/effects.rs +++ b/crates/psrs-backend/src/mir/effects.rs @@ -1,4 +1,4 @@ -//! Conservative instruction effect summaries used by dead-code elimination. +//! Conservative instruction effect summaries shared by optimization and semantic verification. use crate::mir::Instruction; @@ -135,9 +135,8 @@ pub(in crate::mir) fn may_invoke(instruction: &Instruction) -> bool { classify(instruction).may_call } -/// Greatest closed set of local bodies without writes or dynamic calls. -/// Static recursion is permitted; imported calls remain unproven. -pub(in crate::mir) fn read_only_functions( +/// Total local bodies: exclude fallible instructions, CFG cycles and recursive calls. +pub(in crate::mir) fn total_functions( module: &crate::mir::Module, ) -> std::collections::HashSet { use crate::mir::Terminator; @@ -145,14 +144,14 @@ pub(in crate::mir) fn read_only_functions( let mut dependencies = HashMap::>::new(); for function in &module.functions { let mut calls = HashSet::new(); - let mut safe = true; + let mut safe = acyclic(function); for block in &function.blocks { for instruction in &block.instructions { match instruction { Instruction::Call { function, .. } | Instruction::CallVoid { function, .. } => { calls.insert(*function); } - _ if classify(instruction).may_call || classify(instruction).writes_memory => { + _ if !is_pure_and_total(instruction) => { safe = false; break; } @@ -163,7 +162,7 @@ pub(in crate::mir) fn read_only_functions( Some(Terminator::ReturnCall { function, .. }) => { calls.insert(*function); } - Some(Terminator::ReturnCallRef { .. }) => safe = false, + Some(Terminator::ReturnCallRef { .. } | Terminator::Trap { .. }) => safe = false, _ => {} } } @@ -171,16 +170,58 @@ pub(in crate::mir) fn read_only_functions( dependencies.insert(function.symbol, calls); } } - let mut safe = dependencies.keys().copied().collect::>(); + let mut safe = HashSet::new(); loop { - let previous = safe.clone(); - safe.retain(|symbol| { - dependencies[symbol] - .iter() - .all(|callee| previous.contains(callee)) - }); - if safe == previous { + let previous = safe.len(); + for (symbol, calls) in &dependencies { + if calls.iter().all(|callee| safe.contains(callee)) { + safe.insert(*symbol); + } + } + if safe.len() == previous { return safe; } } } + +fn acyclic(function: &crate::mir::Function) -> bool { + fn visit( + id: crate::mir::BlockId, + blocks: &std::collections::HashMap, + active: &mut std::collections::HashSet, + done: &mut std::collections::HashSet, + ) -> bool { + if done.contains(&id) { + return true; + } + if !active.insert(id) { + return false; + } + let Some(block) = blocks.get(&id) else { + return false; + }; + let Some(terminator) = &block.terminator else { + return false; + }; + if !crate::mir::cfg::successors(terminator) + .into_iter() + .all(|next| visit(next, blocks, active, done)) + { + return false; + } + active.remove(&id); + done.insert(id); + true + } + let blocks = function + .blocks + .iter() + .map(|block| (block.id, block)) + .collect(); + visit( + function.entry, + &blocks, + &mut Default::default(), + &mut Default::default(), + ) +} diff --git a/crates/psrs-backend/src/mir/layout/accessors.rs b/crates/psrs-backend/src/mir/layout/accessors.rs index 46f39ada..5833416a 100644 --- a/crates/psrs-backend/src/mir/layout/accessors.rs +++ b/crates/psrs-backend/src/mir/layout/accessors.rs @@ -47,6 +47,23 @@ impl PlannedLayout { .ok_or(LayoutError::UnknownField) } + /// Nominal case identity and its immutable physical tag initializer. + pub(crate) fn variant_tags(&self) -> impl Iterator + '_ { + self.variant_indices + .iter() + .map(|((_, tag), index)| (*index, *tag as i32)) + } + + pub(crate) fn variant_bases(&self) -> impl Iterator + '_ { + self.repr_indices.iter().filter_map(|(repr, index)| { + matches!( + self.representation_table().representation(*repr), + Some(crate::cc::Representation::Variant { .. }) + ) + .then_some(*index) + }) + } + /// The stored field shapes of a variant case, before the tag field. pub(crate) fn variant_field( &self, diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 7a4be468..4a789ca4 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -6,8 +6,10 @@ use psrs_hir::SymbolId; use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; +pub(crate) mod branch_facts; pub(crate) mod cfg; mod control; +mod effects; mod instruction; pub(crate) mod layout; mod literals; diff --git a/crates/psrs-backend/src/mir/opt/mod.rs b/crates/psrs-backend/src/mir/opt/mod.rs index 73b1af19..add390d0 100644 --- a/crates/psrs-backend/src/mir/opt/mod.rs +++ b/crates/psrs-backend/src/mir/opt/mod.rs @@ -2,7 +2,7 @@ mod cfg; pub(in crate::mir) mod constants; -pub(in crate::mir) mod effects; +use super::effects; mod imports; mod inline; mod values; diff --git a/crates/psrs-backend/src/mir/value_identity.rs b/crates/psrs-backend/src/mir/value_identity.rs index adeae905..5cd2eefd 100644 --- a/crates/psrs-backend/src/mir/value_identity.rs +++ b/crates/psrs-backend/src/mir/value_identity.rs @@ -3,34 +3,142 @@ use super::{BlockId, Function, Instruction, Terminator}; use crate::types::ValueId; use std::collections::{HashMap, HashSet}; -pub(crate) type Definitions<'a> = HashMap; +pub(crate) struct Definitions<'a> { + instructions: HashMap, + joins: HashMap>, +} + +impl<'a> std::ops::Deref for Definitions<'a> { + type Target = HashMap; + fn deref(&self) -> &Self::Target { + &self.instructions + } +} pub(crate) fn definitions(function: &Function) -> Definitions<'_> { - function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| { - instruction - .destination() - .map(|destination| (destination, instruction)) - }) - .collect() + index(function, None) +} + +/// Restrict join inputs to paths from the semantic step being proved. The +/// executor loop header starts the next step and is not part of this result. +pub(crate) fn step_definitions(function: &Function, start: BlockId) -> Definitions<'_> { + let reachable = super::cfg::reachable_from(function, start, loop_header(function)); + index(function, Some(&reachable)) +} + +fn index<'a>(function: &'a Function, reachable: Option<&HashSet>) -> Definitions<'a> { + Definitions { + instructions: function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| instruction.destination().map(|value| (value, instruction))) + .collect(), + joins: function + .blocks + .iter() + .flat_map(|block| &block.parameters) + .filter_map(|value| { + incoming_from(function, *value, reachable).map(|inputs| (*value, inputs)) + }) + .collect(), + } +} + +/// Copies, casts and unanimous non-loop joins preserve reference identity. +/// Loop parameters remain distinct: their incoming values represent different +/// machine iterations, rather than aliases of one execution result. +pub(crate) fn reference_origin(value: ValueId, definitions: &Definitions<'_>) -> ValueId { + fn resolve( + value: ValueId, + definitions: &Definitions<'_>, + active: &mut HashSet, + ) -> ValueId { + if !active.insert(value) { + return value; + } + let origin = match definitions.get(&value).copied() { + Some(Instruction::Copy { value, .. } | Instruction::RefCast { value, .. }) => { + resolve(*value, definitions, active) + } + _ => { + if let Some(inputs) = definitions.joins.get(&value) { + let mut origins = inputs + .iter() + .map(|input| resolve(*input, definitions, active)); + let first = origins.next().unwrap_or(value); + if origins.all(|origin| origin == first) { + first + } else { + value + } + } else { + value + } + } + }; + active.remove(&value); + origin + } + resolve(value, definitions, &mut HashSet::new()) } -pub(crate) fn reference_origin(mut value: ValueId, definitions: &Definitions<'_>) -> ValueId { - for _ in 0..definitions.len() { - match definitions.get(&value).copied() { - Some( - Instruction::Copy { value: source, .. } - | Instruction::RefCast { value: source, .. }, - ) => value = *source, - _ => break, +/// Resolve a result along one concrete CFG path, retaining its incoming SSA +/// arguments instead of combining values from mutually exclusive exits. +pub(crate) fn path_origin( + mut value: ValueId, + definitions: &Definitions<'_>, + aliases: &HashMap, +) -> ValueId { + let mut seen = HashSet::new(); + while seen.insert(value) { + let next = + aliases + .get(&value) + .copied() + .or_else(|| match definitions.get(&value).copied() { + Some(Instruction::Copy { value, .. } | Instruction::RefCast { value, .. }) => { + Some(*value) + } + _ => None, + }); + match next { + Some(next) => value = next, + None => break, } } value } +/// Integer evidence through copies and unanimous normal joins. Unknown values +/// and cyclic joins cannot establish a nominal constructor's physical tag. +pub(crate) fn integer_constant(value: ValueId, definitions: &Definitions<'_>) -> Option { + fn resolve( + value: ValueId, + definitions: &Definitions<'_>, + active: &mut HashSet, + ) -> Option { + if !active.insert(value) { + return None; + } + let constant = match definitions.get(&value).copied() { + Some(Instruction::Constant { value, .. }) => Some(*value), + Some(Instruction::Copy { value, .. }) => resolve(*value, definitions, active), + _ => definitions.joins.get(&value).and_then(|inputs| { + let first = resolve(*inputs.first()?, definitions, active)?; + inputs + .iter() + .skip(1) + .all(|input| resolve(*input, definitions, active) == Some(first)) + .then_some(first) + }), + }; + active.remove(&value); + constant + } + resolve(value, definitions, &mut HashSet::new()) +} + pub(crate) fn loop_header(function: &Function) -> Option { function .blocks @@ -56,6 +164,14 @@ pub(crate) fn loop_parameters(function: &Function) -> &[ValueId] { /// Incoming values of a non-loop SSA join parameter. Unknown edges are not /// treated as a valid empty provenance set. pub(crate) fn incoming_values(function: &Function, value: ValueId) -> Option> { + incoming_from(function, value, None) +} + +fn incoming_from( + function: &Function, + value: ValueId, + reachable: Option<&HashSet>, +) -> Option> { let (block, index) = function.blocks.iter().find_map(|block| { block .parameters @@ -68,6 +184,9 @@ pub(crate) fn incoming_values(function: &Function, value: ValueId) -> Option Result<(), Vec> { let mut errors = Vec::new(); super::control::verify(module, &mut errors); verify_defined_types(module, &mut errors); + variants::verify(module, &mut errors); let mut signatures = module .functions .iter() diff --git a/crates/psrs-backend/src/mir/verify/subtype.rs b/crates/psrs-backend/src/mir/verify/subtype.rs index ee7fd467..11eaeaac 100644 --- a/crates/psrs-backend/src/mir/verify/subtype.rs +++ b/crates/psrs-backend/src/mir/verify/subtype.rs @@ -126,7 +126,7 @@ pub(super) fn heap_related( heap_subtype(child, parent, definitions) || heap_subtype(parent, child, definitions) } -pub(super) fn heap_subtype( +pub(in crate::mir) fn heap_subtype( child: HeapType, parent: HeapType, definitions: &[&DefinedType], diff --git a/crates/psrs-backend/src/mir/verify/variants.rs b/crates/psrs-backend/src/mir/verify/variants.rs new file mode 100644 index 00000000..d31e32a9 --- /dev/null +++ b/crates/psrs-backend/src/mir/verify/variants.rs @@ -0,0 +1,68 @@ +//! Nominal variant constructors must initialize the tag of their planned case. +use super::util::mir_error; +use crate::BackendError; +use crate::mir::value_identity::{definitions, integer_constant}; +use crate::mir::{Instruction, Module}; +use std::collections::{HashMap, HashSet}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = &module.layout else { + // Standalone structural MIR carries no source nominal layout contract. + return; + }; + let tags = layout.variant_tags().collect::>(); + let bases = layout.variant_bases().collect::>(); + let types = super::defined_types_list(module); + for index in tags.keys().chain(&bases) { + let valid = types.get(index.0 as usize).is_some_and(|ty| { + matches!(&ty.composite, crate::types::CompositeType::Struct(fields) + if fields.first().is_some_and(|field| field.storage == crate::types::StorageType::I32 && !field.mutable)) + }); + if !valid { + errors.extend(mir_error( + module.span, + "MIR nominal variant tag must remain immutable i32", + )); + } + } + for function in &module.functions { + let definitions = definitions(function); + for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { + let Instruction::StructNew { + type_index, + arguments, + span, + .. + } = instruction + else { + continue; + }; + if bases.contains(type_index) { + errors.extend(mir_error( + *span, + "MIR nominal variant must be constructed at a planned case type", + )); + continue; + } + let Some(expected) = tags.get(type_index) else { + continue; + }; + let actual = arguments + .first() + .and_then(|value| integer_constant(*value, &definitions)); + if actual != Some(*expected) { + errors.extend( + mir_error( + *span, + "MIR variant constructor must initialize its planned case tag", + ) + .into_iter() + .map(|error| error.with_module(function.symbol.module)), + ); + } + } + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/mir/verify/variants/tests.rs b/crates/psrs-backend/src/mir/verify/variants/tests.rs new file mode 100644 index 00000000..63054e28 --- /dev/null +++ b/crates/psrs-backend/src/mir/verify/variants/tests.rs @@ -0,0 +1,257 @@ +//! The constructor contract applies to ordinary variants without control metadata. +use crate::TargetCapabilities; +use crate::cc::{Representation, RepresentationTable, VariantCase}; +use crate::mir::layout::PlannedLayout; +use crate::mir::{BasicBlock, BlockId, Function, Instruction as I, Module, Terminator as T}; +use crate::types::{FunctionId, HeapType, RefType, ValueDecl, ValueId, ValueType}; +use psrs_hir::{ModuleId, SymbolId}; +use psrs_span::TextRange; + +fn constructor(tag: i32, copy: bool) -> Module { + let span = TextRange::new(0, 1); + let table = RepresentationTable { + representations: vec![Representation::Variant { + cases: vec![ + VariantCase { + tag: 7, + fields: vec![], + }, + VariantCase { + tag: 13, + fields: vec![], + }, + ], + }], + ..Default::default() + }; + let layout = PlannedLayout::plan(&table, TargetCapabilities::default()).unwrap(); + let type_index = layout.variant_index(crate::cc::ReprId(0), 7).unwrap(); + let result_type = ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(type_index), + }); + let mut instructions = vec![I::Constant { + destination: ValueId(0), + value: tag, + span, + }]; + if copy { + instructions.push(I::Copy { + destination: ValueId(1), + value: ValueId(0), + span, + }); + } + instructions.push(I::StructNew { + destination: ValueId(2), + type_index, + arguments: vec![ValueId(u32::from(copy))], + span, + }); + let symbol = SymbolId::new(ModuleId(0), 0); + Module { + name: "NominalConstructor".into(), + types: layout.types().to_vec(), + layout: Some(layout), + strings: vec![], + imports: vec![], + entry: Some(symbol), + span, + functions: vec![Function { + id: FunctionId(0), + symbol, + name: "constructor".into(), + parameters: vec![], + values: vec![ + ValueDecl { + id: ValueId(0), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(1), + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(2), + ty: result_type, + }, + ], + entry: BlockId(0), + blocks: vec![BasicBlock { + id: BlockId(0), + parameters: vec![], + instructions, + terminator: Some(T::Return { + value: ValueId(2), + span, + }), + }], + result: ValueId(2), + result_type, + span, + }], + } +} + +#[test] +fn ordinary_variants_require_their_own_tag() { + for copy in [false, true] { + crate::mir::verify_module(&constructor(7, copy)).expect("matching nominal tag"); + for wrong in [0, 13] { + let errors = crate::mir::verify_module(&constructor(wrong, copy)).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("initialize its planned case tag")), + "{errors:?}" + ); + } + } +} + +#[test] +fn ordinary_variant_base_cannot_bypass_case_construction() { + let mut module = constructor(7, false); + let base = module + .layout + .as_ref() + .unwrap() + .repr_index(crate::cc::ReprId(0)) + .unwrap(); + let I::StructNew { type_index, .. } = &mut module.functions[0].blocks[0].instructions[1] else { + unreachable!() + }; + *type_index = base; + let base_type = ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(base), + }); + module.functions[0] + .values + .iter_mut() + .find(|value| value.id == ValueId(2)) + .unwrap() + .ty = base_type; + module.functions[0].result_type = base_type; + let errors = crate::mir::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("constructed at a planned case type")), + "{errors:?}" + ); +} + +#[test] +fn ordinary_variant_tag_cannot_become_mutable() { + let mut module = constructor(7, false); + let I::StructNew { type_index, .. } = module.functions[0].blocks[0].instructions[1] else { + unreachable!() + }; + let definition = module + .types + .iter_mut() + .flat_map(|group| &mut group.0) + .nth(type_index.0 as usize) + .unwrap(); + let crate::types::CompositeType::Struct(fields) = &mut definition.composite else { + unreachable!() + }; + fields[0].mutable = true; + let errors = crate::mir::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message.contains("tag must remain immutable i32")), + "{errors:?}" + ); +} + +#[test] +fn nominal_tag_proof_accepts_equal_constants_at_a_join() { + for alternative in [7, 13] { + let mut module = constructor(7, false); + let function = &mut module.functions[0]; + let span = function.span; + function.values.extend([ + ValueDecl { + id: ValueId(3), + ty: ValueType::Boolean, + }, + ValueDecl { + id: ValueId(4), + ty: ValueType::I32, + }, + ]); + let mut construct = function.blocks[0].instructions.pop().unwrap(); + let I::StructNew { arguments, .. } = &mut construct else { + unreachable!() + }; + arguments[0] = ValueId(4); + function.blocks = vec![ + BasicBlock { + id: BlockId(0), + parameters: vec![], + instructions: vec![I::Constant { + destination: ValueId(3), + value: 1, + span, + }], + terminator: Some(T::Branch { + condition: ValueId(3), + then_block: BlockId(1), + else_block: BlockId(2), + span, + }), + }, + BasicBlock { + id: BlockId(1), + parameters: vec![], + instructions: vec![I::Constant { + destination: ValueId(0), + value: 7, + span, + }], + terminator: Some(T::Jump { + target: BlockId(3), + arguments: vec![ValueId(0)], + span, + }), + }, + BasicBlock { + id: BlockId(2), + parameters: vec![], + instructions: vec![I::Constant { + destination: ValueId(1), + value: alternative, + span, + }], + terminator: Some(T::Jump { + target: BlockId(3), + arguments: vec![ValueId(1)], + span, + }), + }, + BasicBlock { + id: BlockId(3), + parameters: vec![ValueId(4)], + instructions: vec![construct], + terminator: Some(T::Return { + value: ValueId(2), + span, + }), + }, + ]; + let result = crate::mir::verify_module(&module); + if alternative == 7 { + result.expect("equal tag constants at a normal join"); + } else { + assert!( + result + .unwrap_err() + .iter() + .any(|error| error.message.contains("initialize its planned case tag")) + ); + } + } +} diff --git a/crates/psrs-driver/Cargo.toml b/crates/psrs-driver/Cargo.toml index d31da7c6..d005bfa2 100644 --- a/crates/psrs-driver/Cargo.toml +++ b/crates/psrs-driver/Cargo.toml @@ -26,3 +26,7 @@ psrs-thir.workspace = true psrs-typecheck.workspace = true serde = { version = "1", features = ["derive"] } serde_json = "1" + +[dev-dependencies] +wasm-encoder.workspace = true +wasmparser.workspace = true diff --git a/crates/psrs-driver/src/tests/control_clause_selection.rs b/crates/psrs-driver/src/tests/control_clause_selection.rs new file mode 100644 index 00000000..96f4d9ed --- /dev/null +++ b/crates/psrs-driver/src/tests/control_clause_selection.rs @@ -0,0 +1,252 @@ +//! A source return or operation must apply its own scoped clause. +use super::control_checkpoints::{SOURCE, binding}; +use super::control_dispatch::{carrier_repr, visit}; +use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R, ValueId}; +use psrs_backend::mir::{BlockId, Function, Instruction as I, Terminator as T}; +use psrs_backend::types::DefinedTypeId; +use std::collections::{HashSet, VecDeque}; + +fn successors(terminator: &T) -> Vec { + match terminator { + T::Jump { target, .. } => vec![*target], + T::Branch { + then_block, + else_block, + .. + } => vec![*then_block, *else_block], + T::Switch { cases, default, .. } => cases + .iter() + .map(|(_, target)| *target) + .chain(std::iter::once(*default)) + .collect(), + _ => Vec::new(), + } +} + +/// Blocks of one input-dispatch arm, excluding the dispatch header itself. +fn arm(function: &Function, dispatch: BlockId, target: BlockId) -> HashSet { + let mut seen = HashSet::new(); + let mut pending = VecDeque::from([target]); + while let Some(id) = pending.pop_front() { + if id == dispatch || !seen.insert(id) { + continue; + } + if let Some(terminator) = function + .blocks + .iter() + .find(|block| block.id == id) + .and_then(|block| block.terminator.as_ref()) + { + for successor in successors(terminator) { + if successor != dispatch { + pending.push_back(successor); + } + } + } + } + seen +} + +/// The base type named by a switch's `i32` selector. +fn selector_base(function: &Function, value: ValueId) -> Option { + function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::StructGet { + destination, + field: 0, + type_index, + .. + } if *destination == value => Some(*type_index), + _ => None, + }) +} + +fn executor(function: &Function) -> (BlockId, Vec<(i32, BlockId)>) { + function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Switch { cases, .. }) => { + let mut tags = cases.iter().map(|(tag, _)| *tag).collect::>(); + tags.sort_unstable(); + (tags == vec![0, 1, 2, 3, 4, 5]).then(|| (block.id, cases.clone())) + } + _ => None, + }) + .expect("executor input dispatch") +} + +/// Interprets the source step `tag` and rewires its scoped clause projection +/// from `from` to `to`. +fn check_clause(source_tag: i32, from: u32, to: u32, message: &str) { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let module = crate::compile_main_stages(SOURCE).unwrap().mir; + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut broken = module.clone(); + let flat = broken + .types + .iter() + .flat_map(|group| group.0.iter().cloned()) + .collect::>(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let (dispatch, cases) = executor(function); + let target = cases + .iter() + .find(|(tag, _)| *tag == source_tag) + .map(|(_, block)| *block) + .unwrap(); + let arm = arm(function, dispatch, target); + // The scoped context clause is projected from the context case of the + // context dispatch inside this arm. + let scoped = function + .blocks + .iter() + .filter(|block| arm.contains(&block.id)) + .find_map(|block| match &block.terminator { + Some(T::Switch { value, cases, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() == vec![0, 1] => + { + let base = selector_base(function, *value)?; + flat.iter() + .enumerate() + .filter(|(_, ty)| ty.supertype == Some(base)) + .max_by_key(|(_, ty)| match &ty.composite { + psrs_backend::types::CompositeType::Struct(fields) => fields.len(), + _ => 0, + }) + .map(|(index, _)| DefinedTypeId(index as u32)) + } + _ => None, + }) + .expect("scoped context case"); + let location = function + .blocks + .iter() + .enumerate() + .find_map(|(block_index, block)| { + if !arm.contains(&block.id) { + return None; + } + block + .instructions + .iter() + .enumerate() + .find_map(|(index, instruction)| match instruction { + I::StructGet { + type_index, field, .. + } if *type_index == scoped && *field == from => Some((block_index, index)), + _ => None, + }) + }) + .expect("scoped clause projection"); + let I::StructGet { field, .. } = &mut function.blocks[location.0].instructions[location.1] + else { + unreachable!() + }; + *field = to; + let errors = psrs_backend::mir::verify_module(&broken).expect_err("wrong clause"); + assert!( + errors.iter().any(|error| error.message.contains(message)), + "{errors:?}" + ); +} + +#[test] +fn cc_source_return_applies_its_own_return_clause() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let context = carrier_repr(table, R::Executor, 5); + let (symbol, _) = binding(table, R::Executor); + let mut broken = input.cc.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let changed = visit(&mut function.assignments, &mut |assignment| { + let A::VariantGet { + representation, + case: 1, + field, + .. + } = &mut assignment.kind + else { + return false; + }; + if *representation == context && *field == 0 { + *field = 1; + true + } else { + false + } + }); + assert!(changed, "return clause projection"); + let errors = psrs_backend::cc::verify_module(&broken).expect_err("wrong return clause"); + assert!( + errors.iter().any(|error| error + .message + .contains("source return must apply its scoped return clause")), + "{errors:?}" + ); +} + +#[test] +fn cc_source_operation_applies_its_own_operation_clause() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let context = carrier_repr(table, R::Executor, 5); + let (symbol, _) = binding(table, R::Executor); + let mut broken = input.cc.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let changed = visit(&mut function.assignments, &mut |assignment| { + let A::VariantGet { + representation, + case: 1, + field, + .. + } = &mut assignment.kind + else { + return false; + }; + if *representation == context && *field == 1 { + *field = 0; + true + } else { + false + } + }); + assert!(changed, "operation clause projection"); + let errors = psrs_backend::cc::verify_module(&broken).expect_err("wrong operation clause"); + assert!( + errors.iter().any(|error| error + .message + .contains("source operation must apply its scoped operation clause")), + "{errors:?}" + ); +} + +#[test] +fn mir_source_return_applies_its_own_return_clause() { + check_clause(0, 1, 2, "source return must apply its scoped return clause"); +} + +#[test] +fn mir_source_operation_applies_its_own_operation_clause() { + check_clause( + 1, + 2, + 1, + "source operation must apply its scoped operation clause", + ); +} diff --git a/crates/psrs-driver/src/tests/control_clause_steps.rs b/crates/psrs-driver/src/tests/control_clause_steps.rs new file mode 100644 index 00000000..91173cd3 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_clause_steps.rs @@ -0,0 +1,404 @@ +//! Required scoped steps consume their payload and feed the next computation. +use super::control_checkpoints::{SOURCE, binding}; +use super::control_dispatch::{carrier_repr, visit}; +use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; + +#[derive(Clone, Copy)] +enum Mutation { + Omit, + Payload, + Discard, + Resumption, + DeadCall, + State, + RootHandler, +} + +fn cc_step(tag: i32, mutation: Mutation, message: &str) { + let mut module = crate::lower_main_to_cc(SOURCE).unwrap().cc; + let context = carrier_repr(&module.representations, R::Executor, 5); + let (symbol, _) = binding(&module.representations, R::Executor); + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let parameters = function.parameters.clone(); + let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { + panic!("input dispatch") + }; + let arm = &mut cases + .iter_mut() + .find(|case| case.tag == tag) + .unwrap() + .assignments; + // Locate the current context's scoped branch through its tag projection. + let mut selector = None; + visit(arm, &mut |a| { + if let A::VariantTag { representation, .. } = a.kind + && representation == context + { + selector = Some(a.destination); + return true; + } + false + }); + let selector = selector.unwrap(); + let changed = visit(arm, &mut |a| { + let A::TagSwitch { value, cases, .. } = &mut a.kind else { + return false; + }; + if *value != selector { + return false; + } + let scoped = cases.iter_mut().find(|case| case.tag == 1).unwrap(); + match mutation { + Mutation::DeadCall => unreachable!("MIR-only mutation"), + Mutation::State | Mutation::RootHandler => { + let A::IndirectCall { + function: callee, + arguments: operands, + .. + } = &scoped + .assignments + .iter() + .find(|a| matches!(a.kind, A::IndirectCall { .. })) + .unwrap() + .kind + else { + unreachable!() + }; + let (index, operand) = if matches!(mutation, Mutation::State) { + (0, operands[0]) + } else { + (1, *callee) + }; + let A::DirectCall { arguments, .. } = &mut scoped + .assignments + .iter_mut() + .find(|a| a.destination == scoped.value) + .unwrap() + .kind + else { + panic!("executor transition") + }; + arguments[index] = operand; + } + Mutation::Resumption => { + let A::IndirectCall { arguments, .. } = &mut scoped + .assignments + .iter_mut() + .rfind(|a| matches!(a.kind, A::IndirectCall { .. })) + .unwrap() + .kind + else { + unreachable!() + }; + arguments[0] = parameters[0]; + } + Mutation::Discard => { + let A::DirectCall { arguments, .. } = &mut scoped + .assignments + .iter_mut() + .find(|a| a.destination == scoped.value) + .unwrap() + .kind + else { + panic!("executor transition") + }; + arguments[2] = parameters[2]; + } + Mutation::Payload => { + let A::IndirectCall { arguments, .. } = &mut scoped + .assignments + .iter_mut() + .find(|a| matches!(a.kind, A::IndirectCall { .. })) + .unwrap() + .kind + else { + unreachable!() + }; + arguments[0] = parameters[0]; + } + Mutation::Omit => { + let call = scoped + .assignments + .iter_mut() + .find(|a| matches!(a.kind, A::IndirectCall { .. })) + .unwrap(); + let A::IndirectCall { arguments, .. } = &call.kind else { + unreachable!() + }; + // A well-typed erased-value copy replaces the invocation. + let reference = match function + .values + .iter() + .find(|v| v.id == call.destination) + .unwrap() + .ty + { + psrs_backend::cc::ValueShape::Reference(reference) => reference, + _ => panic!("erased call result"), + }; + call.kind = A::RepresentationCast { + destination: call.destination, + value: arguments[0], + reference, + }; + } + } + true + }); + assert!(changed); + let errors = psrs_backend::cc::verify_module(&module).expect_err("broken scoped step"); + assert!( + errors.iter().any(|e| e.message.contains(message)), + "{errors:?}" + ); +} + +fn mir_step(tag: i32, mutation: Mutation, message: &str) { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let (dispatch, target) = function + .blocks + .iter() + .find_map(|b| match &b.terminator { + Some(T::Switch { cases, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() + == vec![0, 1, 2, 3, 4, 5] => + { + Some((b.id, cases.iter().find(|(t, _)| *t == tag).unwrap().1)) + } + _ => None, + }) + .unwrap(); + let mut pending = vec![target]; + let mut seen = std::collections::HashSet::new(); + let mut scoped = None; + while let Some(id) = pending.pop() { + if id == dispatch || !seen.insert(id) { + continue; + } + let b = function.blocks.iter().find(|b| b.id == id).unwrap(); + match &b.terminator { + Some(T::Switch { cases, default, .. }) => { + if cases.iter().map(|(t, _)| *t).collect::>() == vec![0, 1] { + scoped = cases.iter().find(|(t, _)| *t == 1).map(|(_, id)| *id); + break; + } + pending.extend(cases.iter().map(|(_, id)| *id)); + pending.push(*default); + } + Some(T::Jump { target, .. }) => pending.push(*target), + _ => {} + } + } + let scoped = scoped.unwrap(); + let block = function.blocks.iter_mut().find(|b| b.id == scoped).unwrap(); + match mutation { + Mutation::State | Mutation::RootHandler => { + let I::ClosureCall { + function: callee, + arguments: operands, + .. + } = block + .instructions + .iter() + .find(|i| matches!(i, I::ClosureCall { .. })) + .unwrap() + else { + unreachable!() + }; + let (index, operand) = if matches!(mutation, Mutation::State) { + (0, operands[0]) + } else { + (1, *callee) + }; + let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { + panic!("loop transition") + }; + arguments[index] = operand; + } + Mutation::DeadCall => { + let index = block + .instructions + .iter() + .position(|i| matches!(i, I::ClosureCall { .. })) + .unwrap(); + let call = block.instructions.remove(index); + let id = psrs_backend::mir::BlockId( + function.blocks.iter().map(|b| b.id.0).max().unwrap() + 1, + ); + function.blocks.push(psrs_backend::mir::BasicBlock { + id, + parameters: vec![], + instructions: vec![call], + terminator: Some(T::Trap { + span: function.span, + }), + }); + } + Mutation::Resumption => { + let I::ClosureCall { arguments, .. } = block + .instructions + .iter_mut() + .rfind(|i| matches!(i, I::ClosureCall { .. })) + .unwrap() + else { + unreachable!() + }; + arguments[0] = function.parameters[0]; + } + Mutation::Discard => { + let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { + panic!("loop transition") + }; + arguments[2] = function.parameters[2]; + } + Mutation::Payload => { + let I::ClosureCall { arguments, .. } = block + .instructions + .iter_mut() + .find(|i| matches!(i, I::ClosureCall { .. })) + .unwrap() + else { + unreachable!() + }; + arguments[0] = function.parameters[0]; + } + Mutation::Omit => { + let call = block + .instructions + .iter_mut() + .find(|i| matches!(i, I::ClosureCall { .. })) + .unwrap(); + let I::ClosureCall { + destination, + arguments, + span, + .. + } = call + else { + unreachable!() + }; + *call = I::Copy { + destination: *destination, + value: arguments[0], + span: *span, + }; + } + } + let errors = psrs_backend::mir::verify_module(&module).expect_err("broken scoped step"); + assert!( + errors.iter().any(|e| e.message.contains(message)), + "{errors:?}" + ); +} + +#[test] +fn cc_scoped_steps_require_the_clause_application_result() { + for tag in [0, 1] { + for mutation in [Mutation::Omit, Mutation::Discard] { + cc_step( + tag, + mutation, + "source clause result must enter the next executor step", + ); + } + } +} +#[test] +fn mir_scoped_steps_require_the_clause_application_result() { + for tag in [0, 1] { + for mutation in [Mutation::Omit, Mutation::Discard] { + mir_step( + tag, + mutation, + "source clause result must enter the next executor step", + ); + } + } +} +#[test] +fn cc_scoped_steps_consume_the_current_source_payload() { + for tag in [0, 1] { + cc_step( + tag, + Mutation::Payload, + "source clause must consume the current computation payload", + ); + } +} +#[test] +fn mir_scoped_steps_consume_the_current_source_payload() { + for tag in [0, 1] { + mir_step( + tag, + Mutation::Payload, + "source clause must consume the current computation payload", + ); + } +} + +#[test] +fn cc_operation_step_supplies_the_raw_resumption() { + cc_step( + 1, + Mutation::Resumption, + "source operation clause must receive its raw resumption", + ); +} + +#[test] +fn mir_operation_step_supplies_the_raw_resumption() { + mir_step( + 1, + Mutation::Resumption, + "source operation clause must receive its raw resumption", + ); +} + +#[test] +fn mir_scoped_step_cannot_use_a_clause_call_from_a_dead_block() { + for tag in [0, 1] { + mir_step( + tag, + Mutation::DeadCall, + "source clause application must execute in its scoped step", + ); + } +} + +#[test] +fn cc_scoped_steps_preserve_state_and_root_handler() { + for tag in [0, 1] { + for mutation in [Mutation::State, Mutation::RootHandler] { + cc_step( + tag, + mutation, + "source clause transition must preserve its state and root handler", + ); + } + } +} + +#[test] +fn mir_scoped_steps_preserve_state_and_root_handler() { + for tag in [0, 1] { + for mutation in [Mutation::State, Mutation::RootHandler] { + mir_step( + tag, + mutation, + "source clause transition must preserve its state and root handler", + ); + } + } +} diff --git a/crates/psrs-driver/src/tests/control_costs/mod.rs b/crates/psrs-driver/src/tests/control_costs/mod.rs index 59e01af6..373324cf 100644 --- a/crates/psrs-driver/src/tests/control_costs/mod.rs +++ b/crates/psrs-driver/src/tests/control_costs/mod.rs @@ -8,12 +8,23 @@ use std::process::Command; fn run(name: &str, template: &str, steps: i32, depth: i32, expected: i32) -> Option> { super::wasmtime_available()?; let source = template.replace("STEPS", &steps.to_string()); - let mut input = crate::lower_main_to_cc(&source).expect("cost source compiles"); + let mut stages = + crate::compile_main_stages(&source).expect("cost source compiles and verifies"); assert!( - probe::instrument(&mut input, depth) > 0, + probe::instrument(&mut stages, depth) > 0, "no extent allocations inspected" ); - let artifact = psrs_backend::compile_cc(input).expect("instrumented target compiles"); + let core = + psrs_backend::wasm::encode_module(&stages.wasm).expect("instrumented target encodes"); + let bytes = probe::component(&stages, &core); + wasmparser::Validator::new_with_features(wasmparser::WasmFeatures::all()) + .validate_all(&bytes) + .expect("instrumented Wasm validates"); + let artifact = psrs_backend::Artifact { + wasm: bytes, + wat: String::new(), + warnings: vec![], + }; let prefix = std::env::temp_dir().join(format!("psrs-control-cost-{name}-{steps}-{depth}")); let wasm = prefix.with_extension("wasm"); std::fs::write(prefix.with_extension("purs"), source).unwrap(); @@ -105,11 +116,29 @@ fn control_ancestry_probe_observes_independent_non_tail_extents() { } #[test] -fn control_cost_pipeline_rejects_a_malformed_instrumented_input() { +fn control_cost_pipeline_rejects_a_malformed_compiler_input() { let mut input = crate::lower_main_to_cc(&sources::DEEP.replace("STEPS", "1")).unwrap(); - probe::instrument(&mut input, 2); - let checker = input.cc.functions.last_mut().unwrap(); - checker.values[0].ty = psrs_backend::cc::ValueShape::Integer; + let symbol = input + .cc + .representations + .control_helpers + .iter() + .find(|h| h.role() == psrs_backend::cc::ControlHelperRole::Executor) + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let parameter = function.parameters[2]; + function + .values + .iter_mut() + .find(|v| v.id == parameter) + .unwrap() + .ty = psrs_backend::cc::ValueShape::Integer; let errors = psrs_backend::compile_cc(input).expect_err("CC must be rechecked before emission"); assert!( errors.iter().any(|error| error.pass == "P8 CC verification" diff --git a/crates/psrs-driver/src/tests/control_costs/probe.rs b/crates/psrs-driver/src/tests/control_costs/probe.rs index 13b45245..bcb7222b 100644 --- a/crates/psrs-driver/src/tests/control_costs/probe.rs +++ b/crates/psrs-driver/src/tests/control_costs/probe.rs @@ -1,259 +1,227 @@ -//! Test-only probes inspect actual extent ancestry at allocation. They neither -//! alter machine layouts nor expose a source intrinsic or runtime frame API. - -use psrs_backend::BackendInput; -use psrs_backend::cc::{ - Assignment, AssignmentKind as K, BinaryOp, Function, RefShape, ReprId, Representation, TagCase, - ValueDecl, ValueId, ValueShape, +//! Observational guards instrument the final Wasm, after compiler verification. +//! The deliberately trapping budget walk is not part of the control protocol. +use psrs_backend::cc::ControlHelperRole as R; +use psrs_backend::wasm::{Body, FuncType, Function, Op, TypeIndex}; +use psrs_backend::{ + Stages, + types::{CompositeType, HeapType as MirHeap, ValueType}, }; -use psrs_hir::SymbolId; -use psrs_span::TextRange; +use wasm_encoder::{HeapType, Instruction as I, RefType, ValType}; -pub(super) fn instrument(input: &mut BackendInput, limit: i32) -> usize { - let start = input +pub(super) fn instrument(stages: &mut Stages, limit: i32) -> usize { + let check = stages .cc + .representations + .control_helpers + .iter() + .find(|h| h.role() == R::Check) + .unwrap() + .function(); + let helper = stages + .mir .functions .iter() - .find(|f| f.name == "control_start_boundary") + .find(|f| f.symbol == check) .unwrap(); - let extent = start.result_type; - let ValueShape::Reference(reference) = extent else { - panic!("boundary reference") - }; - let RefShape::Repr(boundary) = reference.heap else { - panic!("nominal boundary") + let parameter = helper + .values + .iter() + .find(|v| v.id == helper.parameters[0]) + .unwrap() + .ty; + let ValueType::Ref(reference) = parameter else { + panic!("extent reference") }; - let Some(Representation::Variant { cases }) = input.cc.representations.representation(boundary) - else { - panic!("boundary variant") + let MirHeap::Index(base) = reference.heap else { + panic!("extent type") }; - assert_eq!(cases.len(), 2); - assert_eq!(cases[1].fields[1], extent); - let module = start.symbol.module; - let index = input - .cc - .functions + let cases = stages + .wasm + .type_defs .iter() - .filter(|f| f.symbol.module == module) - .map(|f| f.symbol.index) - .max() - .unwrap() - + 1; - let symbol = SymbolId::new(module, index); + .flat_map(|group| &group.0) + .enumerate() + .filter_map(|(index, ty)| { + if ty.supertype != Some(base) { + return None; + } + let CompositeType::Struct(fields) = &ty.composite else { + panic!("extent struct") + }; + Some((fields.len(), index as u32)) + }) + .collect::>(); + let root = cases[&2]; + let child = cases[&3]; + let module = &mut stages.wasm; + let index = module.imports.len() + + module.functions.len() + + usize::from(module.entry.is_some()) + + usize::from(module.realloc.is_some()) + + module.helpers.len(); let mut count = 0; - for function in &mut input.cc.functions { + for function in &mut module.functions { + let start = function.parameters.len() + function.locals.len(); + // Nullable locals can hold the constructed non-null subtype. local.tee + // retains a nullable static type, so restore the original subtype after + // the observation before the production consumer reads it. + function + .locals + .extend([reference_type(root, true), reference_type(child, true)]); count += insert( - &mut function.assignments, - &mut function.values, - boundary, - extent, - symbol, + &mut function.body, + root, + child, + start as u32, + index as u32, limit, ); } - input.cc.functions.push(checker(symbol, boundary, extent)); - psrs_backend::cc::verify_module(&input.cc).expect("checked ancestry probes"); + let type_index = TypeIndex(module.defined_type_count() + module.types.len() as u32); + let parameters = vec![reference_type(base.0, false), ValType::I32]; + module.types.push(FuncType { + parameters: parameters.clone(), + results: vec![], + }); + let span = module.span; + let body = vec![Op::Loop { + result: None, + span, + body: vec![ + leaf(I::LocalGet(1)), + leaf(I::I32Const(0)), + leaf(I::I32LtS), + Op::If { + then_body: vec![leaf(I::Unreachable)], + else_body: vec![], + result: None, + span, + }, + leaf(I::LocalGet(0)), + leaf(I::StructGet { + struct_type_index: base.0, + field_index: 0, + }), + leaf(I::I32Eqz), + Op::If { + then_body: vec![leaf(I::Return)], + else_body: vec![], + result: None, + span, + }, + leaf(I::LocalGet(0)), + leaf(I::RefCastNonNull(HeapType::Concrete(child))), + leaf(I::StructGet { + struct_type_index: child, + field_index: 2, + }), + leaf(I::LocalSet(0)), + leaf(I::LocalGet(1)), + leaf(I::I32Const(1)), + leaf(I::I32Sub), + leaf(I::LocalSet(1)), + leaf(I::Br(0)), + ], + }]; + module.helpers.push(Function { + symbol: psrs_hir::SymbolId::new(check.module, u32::MAX - 1), + name: "test_control_ancestry_probe".into(), + type_index, + parameters, + locals: vec![], + body, + span, + }); count } -fn insert( - body: &mut Vec, - values: &mut Vec, - boundary: ReprId, - extent: ValueShape, - checker: SymbolId, - limit: i32, -) -> usize { +fn reference_type(index: u32, nullable: bool) -> ValType { + ValType::Ref(RefType { + nullable, + heap_type: HeapType::Concrete(index), + }) +} +fn leaf(instruction: I<'static>) -> Op { + Op::Leaf(instruction) +} +fn insert(body: &mut Body, root: u32, child: u32, local: u32, checker: u32, limit: i32) -> usize { let mut count = 0; let mut result = Vec::new(); - for mut assignment in std::mem::take(body) { - match &mut assignment.kind { - K::If { - then_assignments, - else_assignments, + for mut op in std::mem::take(body) { + match &mut op { + Op::If { + then_body, + else_body, .. } => { - count += insert(then_assignments, values, boundary, extent, checker, limit); - count += insert(else_assignments, values, boundary, extent, checker, limit); + count += insert(then_body, root, child, local, checker, limit); + count += insert(else_body, root, child, local, checker, limit); } - K::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - count += insert( - &mut case.assignments, - values, - boundary, - extent, - checker, - limit, - ); - } - count += insert( - default_assignments, - values, - boundary, - extent, - checker, - limit, - ); + Op::Block { body, .. } | Op::Loop { body, .. } => { + count += insert(body, root, child, local, checker, limit) } _ => {} } - let probe = matches!(&assignment.kind, K::VariantNew { representation, .. } if *representation == boundary); - let value = assignment.destination; - let span = assignment.span; - result.push(assignment); - if probe { + let constructed = match &op { + Op::Leaf(I::StructNew(index)) if *index == root || *index == child => Some(*index), + _ => None, + }; + result.push(op); + if let Some(index) = constructed { count += 1; - let next = values.iter().map(|v| v.id.0).max().unwrap() + 1; - let budget = ValueId(next); - let checked = ValueId(next + 1); - values.push(ValueDecl { - id: budget, - ty: ValueShape::Integer, - }); - values.push(ValueDecl { - id: checked, - ty: extent, - }); - result.push(Assignment { - destination: budget, - kind: K::Constant(limit), - span, - }); - result.push(Assignment { - destination: checked, - kind: K::DirectCall { - contract: None, - function: checker, - arguments: vec![value, budget], - }, - span, - }); + let slot = local + u32::from(index == child); + result.extend([ + leaf(I::LocalTee(slot)), + leaf(I::LocalGet(slot)), + leaf(I::RefCastNonNull(HeapType::Concrete(index))), + leaf(I::I32Const(limit)), + leaf(I::Call(checker)), + leaf(I::RefCastNonNull(HeapType::Concrete(index))), + ]); } } *body = result; count } -fn checker(symbol: SymbolId, boundary: ReprId, extent: ValueShape) -> Function { - let span = TextRange::new(0, 1); - let a = |id, kind| Assignment { - destination: ValueId(id), - kind, - span, - }; - let values = [ - extent, - ValueShape::Integer, - ValueShape::Integer, - ValueShape::Boolean, - ValueShape::Integer, - extent, - ValueShape::Integer, - ValueShape::Integer, - extent, - extent, - extent, - extent, - extent, - ] - .into_iter() - .enumerate() - .map(|(id, ty)| ValueDecl { - id: ValueId(id as u32), - ty, - }) - .collect(); - let child = vec![ - a( - 5, - K::VariantGet { - destination: ValueId(5), - representation: boundary, - case: 1, - field: 1, - value: ValueId(0), - }, - ), - a(6, K::Constant(1)), - a( - 7, - K::Primitive { - op: BinaryOp::IntSub, - left: ValueId(1), - right: ValueId(6), - }, - ), - a( - 8, - K::DirectCall { - contract: None, - function: symbol, - arguments: vec![ValueId(5), ValueId(7)], - }, - ), - ]; - Function { - symbol, - name: "test_control_ancestry_probe".into(), - parameters: vec![ValueId(0), ValueId(1)], - values, - assignments: vec![ - a(2, K::Constant(0)), - a( - 3, - K::Primitive { - op: BinaryOp::IntGe, - left: ValueId(1), - right: ValueId(2), - }, - ), - a( - 12, - K::If { - condition: ValueId(3), - then_assignments: vec![ - a( - 4, - K::VariantTag { - destination: ValueId(4), - representation: boundary, - value: ValueId(0), - }, - ), - a( - 10, - K::TagSwitch { - value: ValueId(4), - cases: vec![ - TagCase { - tag: 0, - assignments: vec![], - value: ValueId(0), - }, - TagCase { - tag: 1, - assignments: child, - value: ValueId(8), - }, - ], - default_assignments: vec![a(9, K::Unreachable)], - default_value: ValueId(9), - }, - ), - ], - then_value: ValueId(10), - else_assignments: vec![a(11, K::Unreachable)], - else_value: ValueId(11), - }, - ), - ], - result: ValueId(12), - result_type: extent, - span, +/// Replace the program core module in the already assembled component. The +/// observation adds only private locals/functions; imports/exports stay fixed. +pub(super) fn component(stages: &Stages, core: &[u8]) -> Vec { + use wasm_encoder::Encode; + let source = &stages.artifact.wasm; + assert_eq!(&source[..8], b"\0asm\x0d\0\x01\0"); + let mut result = source[..8].to_vec(); + let mut offset = 8; + let mut replaced = 0; + while offset < source.len() { + let start = offset; + let id = source[offset]; + offset += 1; + let mut length = 0usize; + let mut shift = 0; + loop { + let byte = source[offset]; + offset += 1; + length |= usize::from(byte & 127) << shift; + if byte & 128 == 0 { + break; + } + shift += 7; + } + let end = offset + length; + if id == 1 { + replaced += 1; + result.push(id); + (core.len() as u32).encode(&mut result); + result.extend_from_slice(core); + } else { + result.extend_from_slice(&source[start..end]); + } + offset = end; } + assert_eq!( + replaced, 1, + "cost fixture must have one program core module" + ); + result } diff --git a/crates/psrs-driver/src/tests/control_dispatch/cc.rs b/crates/psrs-driver/src/tests/control_dispatch/cc.rs new file mode 100644 index 00000000..b749d961 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_dispatch/cc.rs @@ -0,0 +1,184 @@ +//! CC dispatch negatives and provenance positives. +use super::*; + +#[test] +fn cc_rejects_a_projection_of_the_wrong_case() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let carriers = [ + carrier_repr(table, R::Executor, 2), + carrier_repr(table, R::Executor, 5), + carrier_repr(table, R::CloneSequence, 0), + ]; + for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { + let (symbol, _) = binding(table, role); + let mut broken = input.cc.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let shapes = function + .values + .iter() + .map(|value| (value.id, value.ty)) + .collect::>(); + let changed = visit(&mut function.assignments, &mut |assignment| { + let A::VariantGet { + representation, + case, + field, + .. + } = &mut assignment.kind + else { + return false; + }; + if !carriers.contains(representation) { + return false; + } + let Some(Representation::Variant { cases }) = table.representation(*representation) + else { + return false; + }; + let destination = shapes.get(&assignment.destination).copied(); + let Some(alternative) = cases.iter().find(|candidate| { + candidate.tag != *case + && candidate.fields.get(*field as usize).copied() == destination + }) else { + return false; + }; + *case = alternative.tag; + true + }); + assert!(changed, "{role:?}: no carrier projection to mutate"); + let errors = psrs_backend::cc::verify_module(&broken).expect_err("wrong projection"); + assert!( + errors + .iter() + .any(|error| error.message.contains("control projection must match")), + "{role:?}: {errors:?}" + ); + } +} + +#[test] +fn cc_dispatch_requires_a_trapping_default() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let (symbol, _) = binding(table, R::Executor); + let mut broken = input.cc.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let state = function.parameters[0]; + let Some(A::TagSwitch { default_value, .. }) = function + .assignments + .last_mut() + .map(|assignment| &mut assignment.kind) + else { + panic!("input dispatch"); + }; + // Point the default at an available value with the right shape so only the + // trap requirement is violated. + *default_value = state; + let errors = psrs_backend::cc::verify_module(&broken).expect_err("non-trapping default"); + assert!( + errors.iter().any(|error| error + .message + .contains("must trap on unsupported alternatives")), + "{errors:?}" + ); +} + +#[test] +fn cc_dispatch_resolves_a_reference_alias_of_the_input() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let (symbol, _) = binding(table, R::Executor); + let mut broken = input.cc.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let source = function.parameters[2]; + let declaration = function + .values + .iter() + .find(|value| value.id == source) + .unwrap() + .clone(); + let alias = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(ValueDecl { + id: alias, + ty: declaration.ty, + }); + let tag = match &function.assignments.last().unwrap().kind { + A::TagSwitch { value, .. } => *value, + _ => panic!("input dispatch"), + }; + let position = function + .assignments + .iter() + .position(|assignment| assignment.destination == tag) + .unwrap(); + function.assignments.insert( + position, + Assignment { + destination: alias, + kind: A::AggregateConvert { + destination: alias, + value: source, + conversion: AggregateConvert { + source: declaration.ty, + destination: declaration.ty, + plan: ValueConversion::Identity, + }, + }, + span: function.span, + }, + ); + let variant = function + .assignments + .iter_mut() + .find(|assignment| assignment.destination == tag) + .unwrap(); + let A::VariantTag { value, .. } = &mut variant.kind else { + panic!("input tag"); + }; + *value = alias; + psrs_backend::cc::verify_module(&broken) + .expect("an identity alias must preserve dispatch provenance"); +} + +#[test] +fn cc_dispatch_result_must_originate_from_the_input() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let table = &input.cc.representations; + let (symbol, _) = binding(table, R::Executor); + let mut broken = input.cc.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + // A result that is not the input dispatch stands in for a dead transition. + function.result = function.parameters[0]; + let errors = psrs_backend::cc::verify_module(&broken).expect_err("dead dispatch"); + assert!( + errors + .iter() + .any(|error| error.message.contains("must be its current input dispatch")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_dispatch/mir.rs b/crates/psrs-driver/src/tests/control_dispatch/mir.rs new file mode 100644 index 00000000..16a5fc80 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_dispatch/mir.rs @@ -0,0 +1,305 @@ +//! MIR dispatch negatives and provenance positives. +use super::*; + +#[test] +fn mir_dispatch_requires_a_trapping_default() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let module = crate::compile_main_stages(SOURCE).unwrap().mir; + for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { + let (symbol, _) = binding(&input.cc.representations, role); + let mut broken = module.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let span = function.span; + let default = function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Switch { cases, default, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() == required(role) => + { + Some(*default) + } + _ => None, + }) + .expect("input dispatch"); + let block = function + .blocks + .iter_mut() + .find(|block| block.id == default) + .unwrap(); + // Break the trap without leaving the block, so only the trap + // requirement is violated. + block.instructions.clear(); + block.terminator = Some(T::Jump { + target: default, + arguments: vec![], + span, + }); + let errors = psrs_backend::mir::verify_module(&broken).expect_err("non-trapping default"); + assert!( + errors.iter().any(|error| error + .message + .contains("must trap on unsupported alternatives")), + "{role:?}: {errors:?}" + ); + } +} + +#[test] +fn mir_dispatch_requires_an_immutable_i32_tag() { + use psrs_backend::types::{CompositeType, StorageType}; + let module = crate::compile_main_stages(SOURCE).unwrap().mir; + let mut broken = module.clone(); + let mut changed = false; + for group in &mut broken.types { + for ty in &mut group.0 { + let CompositeType::Struct(fields) = &mut ty.composite else { + continue; + }; + let Some(first) = fields.first_mut() else { + continue; + }; + if first.storage == StorageType::I32 && !first.mutable { + first.mutable = true; + changed = true; + } + } + } + assert!(changed, "no immutable i32 tag to mutate"); + let errors = psrs_backend::mir::verify_module(&broken).expect_err("mutable tag"); + assert!( + errors + .iter() + .any(|error| error.message.contains("immutable i32 tag field")), + "{errors:?}" + ); +} + +#[test] +fn mir_dispatch_resolves_a_reference_copy_of_the_input() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let module = crate::compile_main_stages(SOURCE).unwrap().mir; + for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { + let (symbol, _) = binding(&input.cc.representations, role); + let mut broken = module.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let span = function.span; + let tag = function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Switch { value, cases, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() == required(role) => + { + Some(*value) + } + _ => None, + }) + .expect("input dispatch"); + let (block_index, cast) = function + .blocks + .iter() + .enumerate() + .find_map(|(block_index, block)| { + block + .instructions + .iter() + .find_map(|instruction| match instruction { + I::StructGet { + destination, + field: 0, + value, + .. + } if *destination == tag => Some((block_index, *value)), + _ => None, + }) + }) + .expect("tag projection"); + let cast_index = function.blocks[block_index] + .instructions + .iter() + .position(|instruction| { + matches!(instruction, I::RefCast { destination, .. } if *destination == cast) + }) + .expect("tag cast"); + let source = match &function.blocks[block_index].instructions[cast_index] { + I::RefCast { value, .. } => *value, + _ => unreachable!(), + }; + let ty = function + .values + .iter() + .find(|value| value.id == source) + .unwrap() + .ty; + let alias = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function + .values + .push(psrs_backend::types::ValueDecl { id: alias, ty }); + let block = &mut function.blocks[block_index]; + block.instructions.insert( + cast_index, + I::Copy { + destination: alias, + value: source, + span, + }, + ); + let I::RefCast { value, .. } = &mut block.instructions[cast_index + 1] else { + unreachable!() + }; + *value = alias; + psrs_backend::mir::verify_module(&broken) + .expect("a reference copy must preserve dispatch provenance"); + } +} + +#[test] +fn mir_dispatch_rejects_a_projection_of_the_wrong_case() { + use psrs_backend::types::{CompositeType, DefinedTypeId, HeapType, RefType, ValueType}; + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let module = crate::compile_main_stages(SOURCE).unwrap().mir; + for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { + let (symbol, _) = binding(&input.cc.representations, role); + let mut broken = module.clone(); + let function = broken + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let tag = function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Switch { value, cases, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() == required(role) => + { + Some(*value) + } + _ => None, + }) + .expect("input dispatch"); + let base = function + .blocks + .iter() + .find_map(|block| { + block + .instructions + .iter() + .find_map(|instruction| match instruction { + I::StructGet { + destination, + field: 0, + type_index, + .. + } if *destination == tag => Some(*type_index), + _ => None, + }) + }) + .expect("tag projection"); + let flat = broken + .types + .iter() + .flat_map(|group| group.0.iter().cloned()) + .collect::>(); + let cases = flat + .iter() + .enumerate() + .filter(|(_, ty)| ty.supertype == Some(base)) + .map(|(index, _)| DefinedTypeId(index as u32)) + .collect::>(); + let storage = |id: DefinedTypeId, field: u32| match &flat.get(id.0 as usize)?.composite { + CompositeType::Struct(fields) => fields.get(field as usize).map(|field| field.storage), + _ => None, + }; + let mut mutation = None; + 'search: for (block_index, block) in function.blocks.iter().enumerate() { + for (index, instruction) in block.instructions.iter().enumerate() { + let I::StructGet { + type_index, + field, + value, + .. + } = instruction + else { + continue; + }; + if *field == 0 || !cases.contains(type_index) { + continue; + } + let Some(current) = storage(*type_index, *field) else { + continue; + }; + let Some(alternative) = cases + .iter() + .copied() + .find(|case| case != type_index && storage(*case, *field) == Some(current)) + else { + continue; + }; + if block.instructions.iter().any( + |producer| matches!(producer, I::RefCast { destination, .. } if destination == value), + ) { + mutation = Some((block_index, index, *value, alternative)); + break 'search; + } + } + } + let Some((block_index, index, cast, alternative)) = mutation else { + panic!("{role:?}: no projection to mutate"); + }; + let cast_index = function.blocks[block_index] + .instructions + .iter() + .position(|instruction| { + matches!(instruction, I::RefCast { destination, .. } if *destination == cast) + }) + .expect("case cast"); + let I::RefCast { reference, .. } = + &mut function.blocks[block_index].instructions[cast_index] + else { + unreachable!() + }; + *reference = RefType { + nullable: false, + heap: HeapType::Index(alternative), + }; + function + .values + .iter_mut() + .find(|declaration| declaration.id == cast) + .unwrap() + .ty = ValueType::Ref(RefType { + nullable: false, + heap: HeapType::Index(alternative), + }); + let I::StructGet { type_index, .. } = &mut function.blocks[block_index].instructions[index] + else { + unreachable!() + }; + *type_index = alternative; + let errors = psrs_backend::mir::verify_module(&broken).expect_err("wrong projection"); + assert!( + errors + .iter() + .any(|error| error.message.contains("control projection must match")), + "{role:?}: {errors:?}" + ); + } +} diff --git a/crates/psrs-driver/src/tests/control_dispatch/mod.rs b/crates/psrs-driver/src/tests/control_dispatch/mod.rs new file mode 100644 index 00000000..13d0a6f1 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_dispatch/mod.rs @@ -0,0 +1,140 @@ +//! Dispatch must cover its machine domain and prove the selected payload case. +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::{ + AggregateConvert, Assignment, AssignmentKind as A, ControlHelperRole as R, RefShape, ReprId, + Representation, RepresentationTable, ValueConversion, ValueDecl, ValueId, ValueShape, +}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; + +pub(super) fn required(role: R) -> &'static [i32] { + match role { + R::Executor => &[0, 1, 2, 3, 4, 5], + R::CloneSequence => &[0, 1, 2, 3], + R::RebuildSequence => &[0, 1, 3], + _ => panic!("dispatch helper"), + } +} + +/// The nominal representation a helper parameter carries. +pub(super) fn carrier_repr(table: &RepresentationTable, role: R, index: usize) -> ReprId { + let helper = table + .control_helpers + .iter() + .find(|helper| helper.role() == role) + .unwrap(); + match table.signature(helper.signature()).unwrap().parameters[index] { + ValueShape::Reference(reference) => match reference.heap { + RefShape::Repr(id) => id, + _ => panic!("carrier parameter is not a representation reference"), + }, + _ => panic!("carrier parameter is not a reference"), + } +} + +/// Visits every assignment, including nested switch and if bodies. +pub(super) fn visit( + body: &mut [Assignment], + mutate: &mut impl FnMut(&mut Assignment) -> bool, +) -> bool { + for assignment in body { + if mutate(assignment) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if visit(&mut case.assignments, mutate) { + return true; + } + } + if visit(default_assignments, mutate) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if visit(then_assignments, mutate) || visit(else_assignments, mutate) { + return true; + } + } + _ => {} + } + } + false +} + +mod cc; +mod mir; + +#[test] +fn cc_rejects_every_missing_machine_dispatch_alternative() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { + let (symbol, _) = binding(&input.cc.representations, role); + for tag in required(role) { + let mut broken = input.cc.clone(); + let f = broken + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let A::TagSwitch { cases, .. } = &mut f.assignments.last_mut().unwrap().kind else { + panic!("input dispatch"); + }; + cases.retain(|case| case.tag != *tag); + let errors = psrs_backend::cc::verify_module(&broken).expect_err("missing alternative"); + assert!( + errors + .iter() + .any(|e| e.message.contains("every required alternative")), + "{role:?}/{tag}: {errors:?}" + ); + } + } +} + +#[test] +fn mir_rejects_every_missing_machine_dispatch_alternative() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let module = crate::compile_main_stages(SOURCE).unwrap().mir; + for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { + let (symbol, _) = binding(&input.cc.representations, role); + for tag in required(role) { + let mut broken = module.clone(); + let f = broken + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let switch = f + .blocks + .iter_mut() + .find_map(|b| match &mut b.terminator { + Some(T::Switch { cases, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() + == required(role) => + { + Some(cases) + } + _ => None, + }) + .expect("input dispatch"); + switch.retain(|(case, _)| case != tag); + let errors = + psrs_backend::mir::verify_module(&broken).expect_err("missing alternative"); + assert!( + errors + .iter() + .any(|e| e.message.contains("every required alternative")), + "{role:?}/{tag}: {errors:?}" + ); + } + } +} diff --git a/crates/psrs-driver/src/tests/control_execution_steps.rs b/crates/psrs-driver/src/tests/control_execution_steps.rs new file mode 100644 index 00000000..0133cd38 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_execution_steps.rs @@ -0,0 +1,281 @@ +//! Same-shaped replacements cannot bypass the Bind or Resume machine steps. +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; + +#[derive(Clone, Copy)] +enum Mutation { + Body, + Queue, + Callback, + Answer, + Extent, + AppendTail, +} + +fn message(mutation: Mutation) -> &'static str { + match mutation { + Mutation::Body | Mutation::Callback => { + "Bind must enter its body with its own callback and current queue" + } + Mutation::Queue => "execution step must retain its pending queue", + Mutation::Answer => "Resume must return its current saved answer", + Mutation::Extent => "Resume must use its replayed queue and activation", + Mutation::AppendTail => "Resume must append replay to its current queue", + } +} + +fn cc_step(tag: i32, mutation: Mutation) { + let mut module = crate::lower_main_to_cc(SOURCE).unwrap().cc; + let (symbol, _) = binding(&module.representations, R::Executor); + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let p = function.parameters.clone(); + let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { + panic!("input dispatch") + }; + let case = cases.iter_mut().find(|case| case.tag == tag).unwrap(); + let next = case + .assignments + .iter() + .find_map(|a| match &a.kind { + A::DirectCall { + function, + arguments, + .. + } if *function == symbol => Some(arguments.clone()), + _ => None, + }) + .unwrap(); + match mutation { + Mutation::Body | Mutation::Queue | Mutation::Extent => { + let A::DirectCall { arguments, .. } = &mut case + .assignments + .iter_mut() + .find(|a| a.destination == case.value) + .unwrap() + .kind + else { + panic!("transition") + }; + let index = match mutation { + Mutation::Body => 2, + Mutation::Queue => 3, + _ => 4, + }; + arguments[index] = p[index]; + } + Mutation::Callback | Mutation::AppendTail => { + let A::VariantNew { fields, .. } = &mut case + .assignments + .iter_mut() + .find(|a| a.destination == next[3]) + .unwrap() + .kind + else { + panic!("pending queue") + }; + match mutation { + Mutation::Callback => fields[0] = p[1], + _ => fields[1] = fields[0], + } + } + Mutation::Answer => { + let A::VariantNew { fields, .. } = &mut case + .assignments + .iter_mut() + .find(|a| a.destination == next[2]) + .unwrap() + .kind + else { + panic!("returned answer") + }; + fields[0] = p[0]; + } + } + let errors = psrs_backend::cc::verify_module(&module).expect_err("broken execution step"); + assert!( + errors.iter().any(|e| e.message.contains(message(mutation))), + "{errors:?}" + ); +} + +fn mir_step(tag: i32, mutation: Mutation) { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let target = function + .blocks + .iter() + .find_map(|b| match &b.terminator { + Some(T::Switch { cases, .. }) + if cases.iter().map(|(t, _)| *t).collect::>() == vec![0, 1, 2, 3, 4, 5] => + { + Some(cases.iter().find(|(t, _)| *t == tag).unwrap().1) + } + _ => None, + }) + .unwrap(); + let p = function.parameters.clone(); + let header = match function + .blocks + .iter() + .find(|b| b.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + { + T::Jump { target, .. } => *target, + _ => panic!("loop preheader"), + }; + let mut pending = vec![target]; + let mut seen = std::collections::HashSet::new(); + let mut transition = None; + while let Some(id) = pending.pop() { + if id == header || !seen.insert(id) { + continue; + } + let block = function.blocks.iter().find(|b| b.id == id).unwrap(); + match block.terminator.as_ref().unwrap() { + T::Jump { + target, arguments, .. + } if *target == header => { + transition = Some((id, arguments.clone())); + break; + } + T::Jump { target, .. } => pending.push(*target), + T::Branch { + then_block, + else_block, + .. + } => pending.extend([*then_block, *else_block]), + T::Switch { cases, default, .. } => { + pending.extend(cases.iter().map(|(_, target)| *target)); + pending.push(*default); + } + _ => {} + } + } + let (transition, next) = transition.expect("step loop transition"); + let aliases = function + .blocks + .iter() + .flat_map(|b| &b.instructions) + .filter_map(|i| match i { + I::Copy { + destination, value, .. + } + | I::RefCast { + destination, value, .. + } => Some((*destination, *value)), + _ => None, + }) + .collect::>(); + let origin = |mut value| { + for _ in 0..aliases.len() { + if let Some(source) = aliases.get(&value) { + value = *source; + } else { + break; + } + } + value + }; + match mutation { + Mutation::Body | Mutation::Queue | Mutation::Extent => { + let T::Jump { arguments, .. } = function + .blocks + .iter_mut() + .find(|b| b.id == transition) + .unwrap() + .terminator + .as_mut() + .unwrap() + else { + unreachable!() + }; + let index = match mutation { + Mutation::Body => 2, + Mutation::Queue => 3, + _ => 4, + }; + arguments[index] = p[index]; + } + Mutation::Callback | Mutation::AppendTail => { + let I::StructNew { arguments, .. } = function + .blocks + .iter_mut() + .flat_map(|b| &mut b.instructions) + .find(|i| i.destination() == Some(origin(next[3]))) + .unwrap() + else { + panic!("pending queue") + }; + match mutation { + Mutation::Callback => arguments[1] = p[1], + _ => arguments[2] = arguments[1], + } + } + Mutation::Answer => { + let I::StructNew { arguments, .. } = function + .blocks + .iter_mut() + .flat_map(|b| &mut b.instructions) + .find(|i| i.destination() == Some(origin(next[2]))) + .unwrap() + else { + panic!("returned answer") + }; + arguments[1] = p[0]; + } + } + let errors = psrs_backend::mir::verify_module(&module).expect_err("broken execution step"); + assert!( + errors.iter().any(|e| e.message.contains(message(mutation))), + "{errors:?}" + ); +} + +#[test] +fn cc_bind_requires_its_body_callback_and_queue() { + for mutation in [Mutation::Body, Mutation::Callback, Mutation::Queue] { + cc_step(2, mutation); + } +} +#[test] +fn mir_bind_requires_its_body_callback_and_queue() { + for mutation in [Mutation::Body, Mutation::Callback, Mutation::Queue] { + mir_step(2, mutation); + } +} +#[test] +fn cc_resume_requires_its_answer_replayed_extent_and_pending_queue() { + for mutation in [ + Mutation::Answer, + Mutation::Extent, + Mutation::Queue, + Mutation::AppendTail, + ] { + cc_step(3, mutation); + } +} +#[test] +fn mir_resume_requires_its_answer_replayed_extent_and_pending_queue() { + for mutation in [ + Mutation::Answer, + Mutation::Extent, + Mutation::Queue, + Mutation::AppendTail, + ] { + mir_step(3, mutation); + } +} diff --git a/crates/psrs-driver/src/tests/control_inlined_publication.rs b/crates/psrs-driver/src/tests/control_inlined_publication.rs new file mode 100644 index 00000000..4b8c8960 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_inlined_publication.rs @@ -0,0 +1,147 @@ +//! Physical inlined factory cells are checked at the source publication witness. +use super::control_checkpoints::SOURCE; +use psrs_backend::mir::Instruction as I; +use psrs_backend::types::{ValueDecl, ValueId, ValueType}; +use psrs_hir::Intrinsic; +use std::collections::HashMap; + +fn origin(definitions: &HashMap, mut value: ValueId) -> ValueId { + for _ in 0..definitions.len() { + match definitions.get(&value) { + Some(I::Copy { value: next, .. } | I::RefCast { value: next, .. }) => value = *next, + _ => break, + } + } + value +} + +#[test] +fn inlined_start_and_once_check_current_contents_at_publication() { + let owned = SOURCE.replace( + "main = (C.run 0 handler (C.perform (Op \\x -> x)))._2", + "main = let owner = C.once (\\n -> C.return n) in (C.run 0 handler (C.resume owner 42))._2", + ); + for operation in [Intrinsic::ControlRun, Intrinsic::ControlOnce] { + for final_status in [0, 2] { + let mut stages = crate::compile_main_stages(if operation == Intrinsic::ControlRun { + SOURCE + } else { + &owned + }) + .unwrap(); + let table = &stages.cc.representations; + let function = stages.mir.functions.iter_mut().find(|f| f.blocks.iter().flat_map(|b| &b.instructions).any(|i| matches!(i, I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == operation))).unwrap(); + let definitions = function + .blocks + .iter() + .flat_map(|b| &b.instructions) + .filter_map(|i| i.destination().map(|v| (v, i.clone()))) + .collect::>(); + let (implementation, witness) = function + .blocks + .iter() + .flat_map(|b| &b.instructions) + .find_map(|i| match i { + I::ControlEvidence { + contract, + implementation, + .. + } if table.control_contracts[contract.0 as usize].operation() == operation => { + Some(( + origin(&definitions, *implementation), + i.destination().unwrap(), + )) + } + _ => None, + }) + .unwrap(); + let frame = if operation == Intrinsic::ControlRun { + let I::Call { arguments, .. } = &definitions[&implementation] else { + panic!("executor") + }; + origin(&definitions, arguments[4]) + } else { + implementation + }; + let I::StructNew { arguments, .. } = &definitions[&frame] else { + panic!("inlined factory") + }; + let cell = origin( + &definitions, + arguments[if operation == Intrinsic::ControlRun { + 1 + } else { + 2 + }], + ); + let I::ArrayNew { type_index, .. } = &definitions[&cell] else { + panic!("fresh status") + }; + let fresh = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.extend([ + ValueDecl { + id: fresh, + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(fresh.0 + 1), + ty: ValueType::I32, + }, + ]); + let point = if operation == Intrinsic::ControlRun { + implementation + } else { + witness + }; + let block = function + .blocks + .iter_mut() + .find(|b| { + b.instructions + .iter() + .any(|i| i.destination() == Some(point)) + }) + .unwrap(); + let index = block + .instructions + .iter() + .position(|i| i.destination() == Some(point)) + .unwrap(); + let span = function.span; + block.instructions.splice( + index..index, + [ + I::Constant { + destination: fresh, + value: final_status, + span, + }, + I::Constant { + destination: ValueId(fresh.0 + 1), + value: 0, + span, + }, + I::ArraySet { + type_index: *type_index, + value: cell, + index: ValueId(fresh.0 + 1), + new_value: fresh, + span, + }, + ], + ); + let verdict = psrs_backend::mir::verify_module(&stages.mir); + if final_status == 0 { + verdict.expect("current published state remains live"); + } else { + let errors = verdict.expect_err("inlined factory published a spent cell"); + assert!( + errors + .iter() + .any(|e| e.pass == "P9 MIR control publication"), + "{operation:?}: {errors:?}" + ); + } + } + } +} diff --git a/crates/psrs-driver/src/tests/control_lifecycle_bodies.rs b/crates/psrs-driver/src/tests/control_lifecycle_bodies.rs new file mode 100644 index 00000000..fc7b154a --- /dev/null +++ b/crates/psrs-driver/src/tests/control_lifecycle_bodies.rs @@ -0,0 +1,181 @@ +//! Semantic helper IDs cannot replace proofs of their actual extent behavior. +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R}; +use psrs_backend::mir::{BasicBlock, Instruction as I, Terminator as T}; + +fn visit(body: &mut [Assignment], mutation: &mut impl FnMut(&mut A) -> bool) -> bool { + for assignment in body { + if mutation(&mut assignment.kind) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if visit(&mut case.assignments, mutation) { + return true; + } + } + if visit(default_assignments, mutation) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if visit(then_assignments, mutation) || visit(else_assignments, mutation) { + return true; + } + } + _ => {} + } + } + false +} + +#[test] +fn cc_lifecycle_bodies_reject_identity_wrong_guard_write_and_ancestry() { + for role in [R::Check, R::Close] { + for mutation in 0..4 { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, role); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let parameter = function.parameters[0]; + match mutation { + 0 => { + function.assignments.clear(); + function.result = parameter; + } + 1 => assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::Constant(value) if *value == if role == R::Check { 0 } else { 1 } => { + *value = 2; + true + } + _ => false, + })), + 2 if role == R::Check => { + assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::TagSwitch { cases, .. } if cases.len() == 1 => { + cases[0].tag = 1; + true + } + _ => false, + })) + } + 2 => assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::ArraySet { + value, + destination, + representation, + .. + } => { + *kind = A::RepresentationCast { + value: *value, + destination: *destination, + reference: psrs_backend::cc::Reference { + nullable: false, + heap: psrs_backend::cc::RefShape::Repr(*representation), + }, + }; + true + } + _ => false, + })), + _ if role == R::Check => { + assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == symbol => { + arguments[0] = parameter; + true + } + _ => false, + })) + } + _ => assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::ArraySet { value, .. } => { + *value = parameter; + true + } + _ => false, + })), + } + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("malformed lifecycle body"); + assert!( + errors + .iter() + .any(|e| e.pass == "P8 CC lifecycle body" || e.pass == "P8 CC verification"), + "{role:?}/{mutation}: {errors:?}" + ); + } + } +} + +#[test] +fn mir_lifecycle_bodies_reject_identity_wrong_status_and_missing_close() { + for role in [R::Check, R::Close] { + for mutation in 0..3 { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, role); + let mut module = psrs_backend::mir::lower_module(input.cc).unwrap().0; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + match mutation { + 0 => { + function.result = function.parameters[0]; + function.blocks = vec![BasicBlock { + id: function.entry, + parameters: vec![], + instructions: vec![], + terminator: Some(T::Return { + value: function.result, + span: function.span, + }), + }]; + } + 1 => { + let I::Constant { value, .. } = function.blocks.iter_mut().flat_map(|b| &mut b.instructions).find(|i| matches!(i, I::Constant { value, .. } if *value == if role == R::Check {0} else {1})).unwrap() else { unreachable!() }; + *value = 2; + } + _ if role == R::Close => { + for block in &mut function.blocks { + block + .instructions + .retain(|i| !matches!(i, I::ArraySet { .. })); + } + } + _ => { + for block in &mut function.blocks { + if let Some(T::Jump { arguments, .. }) = &mut block.terminator + && arguments.len() == 1 + { + arguments[0] = function.parameters[0]; + } + } + } + } + let errors = psrs_backend::mir::verify_module(&module) + .expect_err("malformed physical lifecycle body"); + assert!( + errors.iter().any(|e| e.pass == "P9 MIR lifecycle body"), + "{role:?}/{mutation}: {errors:?}" + ); + } + } +} diff --git a/crates/psrs-driver/src/tests/control_observable_paths.rs b/crates/psrs-driver/src/tests/control_observable_paths.rs new file mode 100644 index 00000000..8adca3e1 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_observable_paths.rs @@ -0,0 +1,228 @@ +//! Complete helper paths reject extra effects before dispatch and before traps. +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::{ + Assignment, AssignmentKind as A, ControlHelperRole as R, ValueDecl, ValueId, +}; + +#[test] +fn cc_executor_prefix_and_trapping_default_reject_extra_static_checks() { + for prefix in [false, true] { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let (check, contract) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == executor) + .unwrap(); + let extent = function.parameters[4]; + let ty = function.values.iter().find(|v| v.id == extent).unwrap().ty; + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty, + }); + let extra = Assignment { + destination, + kind: A::DirectCall { + contract: Some(contract), + function: check, + arguments: vec![extent], + }, + span: function.span, + }; + if prefix { + function.assignments.insert(0, extra); + } else { + let A::TagSwitch { + default_assignments, + .. + } = &mut function.assignments.last_mut().unwrap().kind + else { + panic!("dispatch") + }; + default_assignments.insert(0, extra); + } + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("unaccounted static check"); + assert!( + errors.iter().any(|e| matches!( + e.pass, + "P8 CC root and queue effects" | "P8 CC owned execution" + )), + "{prefix}: {errors:?}" + ); + } +} + +#[test] +fn cc_publication_rejects_an_extra_potentially_trapping_check() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (start, _) = binding(&input.cc.representations, R::Start); + let (check, contract) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == start) + .unwrap(); + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty: function.result_type, + }); + function.assignments.push(Assignment { + destination, + kind: A::DirectCall { + contract: Some(contract), + function: check, + arguments: vec![function.result], + }, + span: function.span, + }); + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("read-only is not unobservable"); + assert!( + errors + .iter() + .any(|e| e.pass == "P8 CC control initialization"), + "{errors:?}" + ); +} + +#[test] +fn cc_executor_rejects_unused_erased_payload_recovery() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == executor) + .unwrap(); + let ty = function + .values + .iter() + .find(|v| v.id == function.parameters[2]) + .unwrap() + .ty; + let psrs_backend::cc::ValueShape::Reference(reference) = ty else { + panic!("computation") + }; + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty, + }); + function.assignments.insert( + 0, + Assignment { + destination, + kind: A::RepresentationCast { + destination, + value: function.parameters[0], + reference, + }, + span: function.span, + }, + ); + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("unaccounted payload recovery"); + assert!( + errors + .iter() + .any(|e| e.message.contains("reference refinement")), + "{errors:?}" + ); +} + +#[test] +fn cc_no_write_recursive_calls_are_not_total() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let original = input + .cc + .functions + .iter() + .find(|f| f.symbol == executor) + .unwrap(); + let extent_ty = original + .values + .iter() + .find(|v| v.id == original.parameters[4]) + .unwrap() + .ty; + let symbol = psrs_hir::SymbolId::new( + executor.module, + input + .cc + .functions + .iter() + .filter(|f| f.symbol.module == executor.module) + .map(|f| f.symbol.index) + .max() + .unwrap() + + 1, + ); + let span = original.span; + input.cc.functions.push(psrs_backend::cc::Function { + symbol, + name: "recursive_no_write".into(), + parameters: vec![ValueId(0)], + values: vec![ + ValueDecl { + id: ValueId(0), + ty: extent_ty, + }, + ValueDecl { + id: ValueId(1), + ty: extent_ty, + }, + ], + assignments: vec![Assignment { + destination: ValueId(1), + kind: A::DirectCall { + contract: None, + function: symbol, + arguments: vec![ValueId(0)], + }, + span, + }], + result: ValueId(1), + result_type: extent_ty, + span, + }); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == executor) + .unwrap(); + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty: extent_ty, + }); + function.assignments.insert( + 0, + Assignment { + destination, + kind: A::DirectCall { + contract: None, + function: symbol, + arguments: vec![function.parameters[4]], + }, + span, + }, + ); + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("an extra recursive call can diverge"); + assert!( + errors.iter().any(|e| matches!( + e.pass, + "P8 CC owned execution" | "P8 CC root and queue effects" + )), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_owned_steps/cc.rs b/crates/psrs-driver/src/tests/control_owned_steps/cc.rs new file mode 100644 index 00000000..42ef60dc --- /dev/null +++ b/crates/psrs-driver/src/tests/control_owned_steps/cc.rs @@ -0,0 +1,228 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, BinaryOp, ValueDecl, ValueId, ValueShape}; + +pub(super) fn check(mutation: Option, equality: bool) { + use Mutation::*; + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let parameters = function.parameters.clone(); + let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { + panic!("executor input") + }; + let case = cases.iter_mut().find(|case| case.tag == 5).unwrap(); + let body = &mut case.assignments; + let stores = body + .iter() + .enumerate() + .filter_map(|(index, assignment)| { + matches!(assignment.kind, A::ArraySet { .. }).then_some(index) + }) + .collect::>(); + assert_eq!(stores.len(), 3); + let reads = body + .iter() + .enumerate() + .filter_map(|(index, assignment)| { + matches!(assignment.kind, A::ArrayGet { .. }).then_some(index) + }) + .collect::>(); + let guard = body + .iter() + .position(|assignment| matches!(assignment.kind, A::TagSwitch { .. })) + .unwrap(); + let call = body + .iter() + .position(|assignment| matches!(assignment.kind, A::IndirectCall { .. })) + .unwrap(); + let [running, consumed] = [stores[0], stores[2]].map(|index| match body[index].kind { + A::ArraySet { new_value, .. } => new_value, + _ => unreachable!(), + }); + let fresh = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + if equality { + let old = body[guard].clone(); + let A::TagSwitch { + value, + cases, + default_assignments, + default_value, + } = old.kind + else { + unreachable!() + }; + let zero = fresh; + let predicate = ValueId(fresh.0 + 1); + function.values.extend([ + ValueDecl { + id: zero, + ty: ValueShape::Integer, + }, + ValueDecl { + id: predicate, + ty: ValueShape::Boolean, + }, + ]); + body.splice( + guard..=guard, + [ + Assignment { + destination: zero, + kind: A::Constant(0), + span: old.span, + }, + Assignment { + destination: predicate, + kind: A::Primitive { + op: BinaryOp::IntEq, + left: value, + right: zero, + }, + span: old.span, + }, + Assignment { + destination: old.destination, + kind: A::If { + condition: predicate, + then_assignments: cases[0].assignments.clone(), + then_value: cases[0].value, + else_assignments: default_assignments, + else_value: default_value, + }, + span: old.span, + }, + ], + ); + } + if let Some(mutation) = mutation { + match mutation { + Guard => { + body.remove(guard); + } + GuardTag => { + let A::TagSwitch { cases, .. } = &mut body[guard].kind else { + unreachable!() + }; + cases[0].tag = 1; + } + Running | Clear | Consumed => { + body.remove( + stores[match mutation { + Running => 0, + Clear => 1, + _ => 2, + }], + ); + } + RunningValue | ConsumedValue | StateOrder => { + for assignment in body { + if assignment.destination == running + && matches!(mutation, RunningValue | StateOrder) + { + assignment.kind = + A::Constant(if matches!(mutation, StateOrder) { 2 } else { 3 }); + } + if assignment.destination == consumed + && matches!(mutation, ConsumedValue | StateOrder) + { + assignment.kind = + A::Constant(if matches!(mutation, StateOrder) { 1 } else { 3 }); + } + } + } + ClearValue => { + let result = body[reads[1]].destination; + let A::ArraySet { new_value, .. } = &mut body[stores[1]].kind else { + unreachable!() + }; + *new_value = result; + } + ReadOrder => { + let A::ArrayGet { index: zero, .. } = body[reads[0]].kind else { + unreachable!() + }; + let mut read = body.remove(reads[1]); + let A::ArrayGet { index, .. } = &mut read.kind else { + unreachable!() + }; + *index = zero; + body.insert(stores[0], read); + } + Callee | Answer => { + let A::IndirectCall { + function: callee, + arguments, + .. + } = &mut body[call].kind + else { + unreachable!() + }; + if matches!(mutation, Callee) { + *callee = parameters[1] + } else { + arguments[0] = parameters[0] + } + } + Result => { + let A::DirectCall { arguments, .. } = &mut body + .iter_mut() + .find(|assignment| matches!(assignment.kind, A::DirectCall { .. })) + .unwrap() + .kind + else { + unreachable!() + }; + arguments[2] = parameters[2]; + } + ExtraCall => { + let mut extra = body[call].clone(); + let ty = function + .values + .iter() + .find(|value| value.id == extra.destination) + .unwrap() + .ty; + extra.destination = fresh; + function.values.push(ValueDecl { id: fresh, ty }); + body.insert(call + 1, extra); + } + ExtraStore => { + let mut extra = body[stores[2]].clone(); + let A::ArrayGet { index: zero, .. } = body[reads[0]].kind else { + unreachable!() + }; + let A::ArraySet { new_value, .. } = &mut extra.kind else { + unreachable!() + }; + *new_value = zero; + body.insert(stores[2] + 1, extra); + } + } + } + let result = psrs_backend::cc::verify_module(&input.cc); + if mutation.is_some() { + let errors = result.expect_err("malformed owned transfer"); + assert!( + errors + .iter() + .any(|error| error.pass == "P8 CC owned execution"), + "{mutation:?}: {errors:?}" + ); + } else { + result.expect("equivalent Pending predicate"); + psrs_backend::compile_cc(input).expect("equivalent Pending guard compiles through MIR"); + } +} diff --git a/crates/psrs-driver/src/tests/control_owned_steps/mir.rs b/crates/psrs-driver/src/tests/control_owned_steps/mir.rs new file mode 100644 index 00000000..0c2c74d2 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_owned_steps/mir.rs @@ -0,0 +1,305 @@ +use super::{Mutation, R, SOURCE, binding}; +use psrs_backend::mir::{Instruction as I, NumericOp, Terminator as T}; +use psrs_backend::types::{ValueDecl, ValueId, ValueType}; + +pub(super) fn check(mutation: Option, equality: bool) { + use Mutation::*; + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let header = match function + .blocks + .iter() + .find(|block| block.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + { + T::Jump { target, .. } => *target, + _ => panic!("loop header"), + }; + let parameters = function + .blocks + .iter() + .find(|block| block.id == header) + .unwrap() + .parameters + .clone(); + let owned = function + .blocks + .iter() + .find_map(|block| match &block.terminator { + Some(T::Switch { cases, .. }) + if cases.iter().map(|(tag, _)| *tag).collect::>() + == vec![0, 1, 2, 3, 4, 5] => + { + Some(cases.iter().find(|(tag, _)| *tag == 5).unwrap().1) + } + _ => None, + }) + .unwrap(); + let (guard_id, mut transfer_id) = { + let block = function + .blocks + .iter() + .find(|block| block.id == owned) + .unwrap(); + let T::Switch { cases, .. } = block.terminator.as_ref().unwrap() else { + panic!("Pending guard") + }; + (owned, cases[0].1) + }; + loop { + let block = function + .blocks + .iter() + .find(|block| block.id == transfer_id) + .unwrap(); + if block + .instructions + .iter() + .any(|instruction| matches!(instruction, I::ArraySet { .. })) + { + break; + } + let T::Jump { target, .. } = block.terminator.as_ref().unwrap() else { + panic!("guard join") + }; + transfer_id = *target; + } + let status_index = function + .blocks + .iter() + .find(|block| block.id == guard_id) + .unwrap() + .instructions + .iter() + .find_map(|instruction| match instruction { + I::ArrayGet { index, .. } => Some(*index), + _ => None, + }) + .unwrap(); + let fresh = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let span = function.span; + if equality { + function.values.extend([ + ValueDecl { + id: fresh, + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(fresh.0 + 1), + ty: ValueType::Boolean, + }, + ]); + let block = function + .blocks + .iter_mut() + .find(|block| block.id == guard_id) + .unwrap(); + let T::Switch { + value, + cases, + default, + span, + } = block.terminator.take().unwrap() + else { + unreachable!() + }; + block.instructions.extend([ + I::Constant { + destination: fresh, + value: 0, + span, + }, + I::Primitive { + destination: ValueId(fresh.0 + 1), + op: NumericOp::I32Eq, + left: value, + right: fresh, + span, + }, + ]); + block.terminator = Some(T::Branch { + condition: ValueId(fresh.0 + 1), + then_block: cases[0].1, + else_block: default, + span, + }); + } + if let Some(mutation) = mutation { + if matches!(mutation, Guard | GuardTag) { + let block = function + .blocks + .iter_mut() + .find(|block| block.id == guard_id) + .unwrap(); + match mutation { + Guard => { + block.terminator = Some(T::Jump { + target: match block.terminator.as_ref().unwrap() { + T::Switch { cases, .. } => cases[0].1, + _ => unreachable!(), + }, + arguments: vec![], + span, + }) + } + GuardTag => { + let T::Switch { cases, .. } = block.terminator.as_mut().unwrap() else { + unreachable!() + }; + cases[0].0 = 1; + } + _ => unreachable!(), + } + } else { + let block = function + .blocks + .iter_mut() + .find(|block| block.id == transfer_id) + .unwrap(); + let stores = block + .instructions + .iter() + .enumerate() + .filter_map(|(index, instruction)| { + matches!(instruction, I::ArraySet { .. }).then_some(index) + }) + .collect::>(); + assert_eq!(stores.len(), 3); + let call = block + .instructions + .iter() + .position(|instruction| matches!(instruction, I::ClosureCall { .. })) + .unwrap(); + let read = block + .instructions + .iter() + .position(|instruction| matches!(instruction, I::ArrayGet { .. })) + .unwrap(); + let [running, consumed] = + [stores[0], stores[2]].map(|index| match block.instructions[index] { + I::ArraySet { new_value, .. } => new_value, + _ => unreachable!(), + }); + match mutation { + Running | Clear | Consumed => { + block.instructions.remove( + stores[match mutation { + Running => 0, + Clear => 1, + _ => 2, + }], + ); + } + RunningValue | ConsumedValue | StateOrder => { + for instruction in &mut block.instructions { + if instruction.destination() == Some(running) + && matches!(mutation, RunningValue | StateOrder) + { + let I::Constant { value, .. } = instruction else { + panic!("Running literal") + }; + *value = if matches!(mutation, StateOrder) { 2 } else { 3 }; + } + if instruction.destination() == Some(consumed) + && matches!(mutation, ConsumedValue | StateOrder) + { + let I::Constant { value, .. } = instruction else { + panic!("Consumed literal") + }; + *value = if matches!(mutation, StateOrder) { 1 } else { 3 }; + } + } + } + ClearValue => { + let result = block.instructions[read].destination().unwrap(); + let I::ArraySet { new_value, .. } = &mut block.instructions[stores[1]] else { + unreachable!() + }; + *new_value = result; + } + ReadOrder => { + let mut loaded = block.instructions.remove(read); + let I::ArrayGet { index, .. } = &mut loaded else { + unreachable!() + }; + *index = status_index; + block.instructions.insert(stores[0], loaded); + } + Callee | Answer => { + let I::ClosureCall { + function: callee, + arguments, + .. + } = &mut block.instructions[call] + else { + unreachable!() + }; + if matches!(mutation, Callee) { + *callee = parameters[1] + } else { + arguments[0] = parameters[0] + } + } + Result => { + let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { + unreachable!() + }; + arguments[2] = parameters[2]; + } + ExtraCall => { + let mut extra = block.instructions[call].clone(); + let ty = function + .values + .iter() + .find(|value| Some(value.id) == extra.destination()) + .unwrap() + .ty; + let I::ClosureCall { destination, .. } = &mut extra else { + unreachable!() + }; + *destination = fresh; + function.values.push(ValueDecl { id: fresh, ty }); + block.instructions.insert(call + 1, extra); + } + ExtraStore => { + let mut extra = block.instructions[stores[2]].clone(); + let I::ArraySet { new_value, .. } = &mut extra else { + unreachable!() + }; + *new_value = status_index; + block.instructions.insert(stores[2] + 1, extra); + } + _ => unreachable!(), + } + } + } + let result = psrs_backend::mir::verify_module(&module); + if mutation.is_some() { + let errors = result.expect_err("malformed owned transfer"); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR owned execution"), + "{mutation:?}: {errors:?}" + ); + } else { + result.expect("equivalent Pending predicate"); + } +} diff --git a/crates/psrs-driver/src/tests/control_owned_steps/mod.rs b/crates/psrs-driver/src/tests/control_owned_steps/mod.rs new file mode 100644 index 00000000..430ca58c --- /dev/null +++ b/crates/psrs-driver/src/tests/control_owned_steps/mod.rs @@ -0,0 +1,378 @@ +//! One-shot transfer must be complete, ordered and free of extra callbacks. +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::ControlHelperRole as R; + +mod cc; +mod mir; + +#[derive(Clone, Copy, Debug)] +enum Mutation { + Guard, + GuardTag, + Running, + RunningValue, + Clear, + ClearValue, + Consumed, + ConsumedValue, + StateOrder, + ReadOrder, + Callee, + Answer, + Result, + ExtraCall, + ExtraStore, +} +const MUTATIONS: &[Mutation] = &[ + Mutation::Guard, + Mutation::GuardTag, + Mutation::Running, + Mutation::RunningValue, + Mutation::Clear, + Mutation::ClearValue, + Mutation::Consumed, + Mutation::ConsumedValue, + Mutation::StateOrder, + Mutation::ReadOrder, + Mutation::Callee, + Mutation::Answer, + Mutation::Result, + Mutation::ExtraCall, + Mutation::ExtraStore, +]; + +#[test] +fn cc_owned_execution_requires_the_complete_transfer() { + for mutation in MUTATIONS { + cc::check(Some(*mutation), false); + } +} +#[test] +fn mir_owned_execution_requires_the_complete_transfer() { + for mutation in MUTATIONS { + mir::check(Some(*mutation), false); + } +} +#[test] +fn cc_owned_pending_guard_accepts_integer_equality() { + cc::check(None, true); +} +#[test] +fn mir_owned_pending_guard_accepts_integer_equality() { + mir::check(None, true); +} + +#[test] +fn cc_private_cells_are_checked_at_publication() { + use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueDecl, ValueId, ValueShape}; + for role in [R::Start, R::Once] { + for final_value in [0, 2] { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, role); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let (cell, representation) = function + .assignments + .iter() + .find_map(|assignment| match &assignment.kind { + A::ArrayNew { + representation, + elements, + .. + } if elements.len() == 1 + && function.values.iter().any(|value| { + value.id == elements[0] && value.ty == ValueShape::Integer + }) => + { + Some((assignment.destination, *representation)) + } + _ => None, + }) + .unwrap(); + let fresh = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.extend([ + ValueDecl { + id: fresh, + ty: ValueShape::Integer, + }, + ValueDecl { + id: ValueId(fresh.0 + 1), + ty: ValueShape::Integer, + }, + ]); + function.assignments.extend([ + Assignment { + destination: fresh, + kind: A::Constant(final_value), + span: function.span, + }, + Assignment { + destination: ValueId(fresh.0 + 1), + kind: A::Constant(0), + span: function.span, + }, + Assignment { + destination: cell, + kind: A::ArraySet { + destination: cell, + representation, + value: cell, + index: ValueId(fresh.0 + 1), + new_value: fresh, + }, + span: function.span, + }, + ]); + let result = psrs_backend::cc::verify_module(&input.cc); + if final_value == 0 { + result.expect("live published cell after an in-place write"); + } else { + let errors = result.unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P8 CC control initialization"), + "{role:?}: {errors:?}" + ); + } + } + } +} + +#[test] +fn mir_private_cells_are_checked_at_publication() { + use psrs_backend::mir::Instruction as I; + use psrs_backend::types::{ValueDecl, ValueId, ValueType}; + for role in [R::Start, R::Once] { + for final_value in [0, 2] { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, role); + // Mutate retained helper bodies before generic inlining/reachability. + let mut module = psrs_backend::mir::lower_module(input.cc).unwrap().0; + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let (cell, type_index) = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find_map(|instruction| match instruction { + I::ArrayNew { + destination, + type_index, + elements, + .. + } if elements.len() == 1 + && function.values.iter().any(|value| { + value.id == elements[0] + && matches!(value.ty, ValueType::I32 | ValueType::Boolean) + }) => + { + Some((*destination, *type_index)) + } + I::ArrayNewFilled { + destination, + type_index, + value, + .. + } if function.values.iter().any(|decl| { + decl.id == *value && matches!(decl.ty, ValueType::I32 | ValueType::Boolean) + }) => + { + Some((*destination, *type_index)) + } + _ => None, + }) + .unwrap_or_else(|| panic!("{role:?} factory: {function:#?}")); + let fresh = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.extend([ + ValueDecl { + id: fresh, + ty: ValueType::I32, + }, + ValueDecl { + id: ValueId(fresh.0 + 1), + ty: ValueType::I32, + }, + ]); + let block = function + .blocks + .iter_mut() + .find(|block| { + block + .instructions + .iter() + .any(|instruction| instruction.destination() == Some(cell)) + }) + .unwrap(); + block.instructions.extend([ + I::Constant { + destination: fresh, + value: final_value, + span: function.span, + }, + I::Constant { + destination: ValueId(fresh.0 + 1), + value: 0, + span: function.span, + }, + I::ArraySet { + type_index, + value: cell, + index: ValueId(fresh.0 + 1), + new_value: fresh, + span: function.span, + }, + ]); + let result = psrs_backend::mir::verify_module(&module); + if final_value == 0 { + result.expect("live published cell after an in-place write"); + } else { + let errors = result.unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR control initialization"), + "{role:?}: {errors:?}" + ); + } + } + } +} + +#[test] +fn cc_cancellation_requires_pending_cancelled_and_clear() { + use psrs_backend::cc::AssignmentKind as A; + for mutation in 0..3 { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Cancel); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + match mutation { + 0 => { + function + .assignments + .retain(|assignment| !matches!(assignment.kind, A::TagSwitch { .. })); + } + 1 => { + let assignment = function + .assignments + .iter_mut() + .find(|assignment| matches!(assignment.kind, A::Constant(3))) + .unwrap(); + assignment.kind = A::Constant(2); + } + _ => { + let last = function + .assignments + .iter() + .rposition(|assignment| matches!(assignment.kind, A::ArraySet { .. })) + .unwrap(); + function.assignments.remove(last); + } + } + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P8 CC control initialization"), + "{mutation}: {errors:?}" + ); + } +} + +#[test] +fn mir_cancellation_requires_pending_cancelled_and_clear() { + use psrs_backend::mir::{Instruction as I, Terminator as T}; + for mutation in 0..3 { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Cancel); + // Mutate retained helper bodies before generic inlining/reachability. + let mut module = psrs_backend::mir::lower_module(input.cc).unwrap().0; + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + match mutation { + 0 => { + let block = function + .blocks + .iter_mut() + .find(|block| matches!(block.terminator, Some(T::Switch { .. }))) + .unwrap(); + let T::Switch { cases, span, .. } = block.terminator.take().unwrap() else { + unreachable!() + }; + block.terminator = Some(T::Jump { + target: cases[0].1, + arguments: vec![], + span, + }); + } + 1 => { + let I::Constant { value, .. } = function + .blocks + .iter_mut() + .flat_map(|block| &mut block.instructions) + .find(|instruction| matches!(instruction, I::Constant { value: 3, .. })) + .unwrap() + else { + unreachable!() + }; + *value = 2; + } + _ => { + let block = function + .blocks + .iter_mut() + .find(|block| { + block + .instructions + .iter() + .any(|instruction| matches!(instruction, I::ArraySet { .. })) + }) + .unwrap(); + let last = block + .instructions + .iter() + .rposition(|instruction| matches!(instruction, I::ArraySet { .. })) + .unwrap(); + block.instructions.remove(last); + } + } + let errors = psrs_backend::mir::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR control initialization"), + "{mutation}: {errors:?}" + ); + } +} diff --git a/crates/psrs-driver/src/tests/control_queue_steps/cc.rs b/crates/psrs-driver/src/tests/control_queue_steps/cc.rs new file mode 100644 index 00000000..cf96d0a4 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_queue_steps/cc.rs @@ -0,0 +1,314 @@ +use super::{Mutation, R, SOURCE, binding, path}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, Function, TagCase, ValueId}; + +fn arm<'a>(body: &'a mut [Assignment], path: &[i32]) -> &'a mut TagCase { + let A::TagSwitch { cases, .. } = &mut body + .iter_mut() + .find( + |assignment| matches!(&assignment.kind, A::TagSwitch { cases, .. } if cases.len() >= 2), + ) + .unwrap() + .kind + else { + unreachable!() + }; + let case = cases.iter_mut().find(|case| case.tag == path[0]).unwrap(); + if path.len() == 1 { + case + } else { + arm(&mut case.assignments, &path[1..]) + } +} + +fn origin(function: &Function, mut value: ValueId) -> ValueId { + let mut aliases = std::collections::HashMap::new(); + fn index(body: &[Assignment], aliases: &mut std::collections::HashMap) { + for assignment in body { + match &assignment.kind { + A::RepresentationCast { value, .. } => { + aliases.insert(assignment.destination, *value); + } + A::TagSwitch { cases, .. } => { + for case in cases { + index(&case.assignments, aliases) + } + } + _ => {} + } + } + } + index(&function.assignments, &mut aliases); + for _ in 0..aliases.len() { + if let Some(source) = aliases.get(&value) { + value = *source + } else { + break; + } + } + value +} + +pub(super) fn reject(mutation: Mutation) { + use Mutation::*; + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let parameters = function.parameters.clone(); + let signature = match function + .values + .iter() + .find(|value| value.id == parameters[1]) + .unwrap() + .ty + { + psrs_backend::cc::ValueShape::Reference(reference) => match reference.heap { + psrs_backend::cc::RefShape::Closure(signature) => signature, + _ => unreachable!(), + }, + _ => unreachable!(), + }; + let fresh = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(psrs_backend::cc::ValueDecl { + id: fresh, + ty: function.result_type, + }); + + let returned = arm(&mut function.assignments, path(mutation)).value; + let returned = origin(function, returned); + let function_snapshot = function.clone(); + let case = arm(&mut function.assignments, path(mutation)); + let body = &mut case.assignments; + let calls = body + .iter() + .filter_map(|assignment| { + matches!(assignment.kind, A::IndirectCall { .. }).then_some(assignment.destination) + }) + .collect::>(); + match mutation { + ExtraRootCall | ExtraQueueCall | EagerBind => { + let kind = if matches!(mutation, EagerBind) { + A::IndirectCall { + function: parameters[1], + signature, + arguments: vec![parameters[0]], + } + } else { + body.iter() + .rfind(|assignment| matches!(assignment.kind, A::IndirectCall { .. })) + .unwrap() + .kind + .clone() + }; + let position = body + .iter() + .position(|assignment| assignment.destination == returned) + .unwrap(); + body.insert( + position, + Assignment { + destination: fresh, + kind, + span: function_snapshot.span, + }, + ); + } + + HandlerState | Request | Handler | Raw | Callback | Answer => { + let index = match mutation { + HandlerState | Handler | Callback | Answer => 0, + Request => 1, + Raw => 2, + _ => unreachable!(), + }; + let raw = body + .iter() + .find(|assignment| matches!(assignment.kind, A::FunctionRef { .. })) + .map(|assignment| assignment.destination); + let replacement = if matches!(mutation, HandlerState) { + match &body + .iter() + .find(|assignment| assignment.destination == calls[1]) + .unwrap() + .kind + { + A::IndirectCall { arguments, .. } => arguments[0], + _ => unreachable!(), + } + } else if matches!(mutation, Handler) { + raw.unwrap() + } else if matches!(mutation, Callback) { + parameters[1] + } else { + parameters[0] + }; + let A::IndirectCall { + function: callee, + arguments, + .. + } = &mut body + .iter_mut() + .find(|assignment| assignment.destination == calls[index]) + .unwrap() + .kind + else { + unreachable!() + }; + if matches!(mutation, Handler | Callback) { + *callee = replacement + } else { + arguments[0] = replacement + } + } + TrapRoot | TrapCons => { + let assignment = body + .iter_mut() + .find(|assignment| assignment.destination == returned) + .unwrap(); + assignment.kind = A::Unreachable; + } + ReturnState | ReturnAnswer => { + let A::ProductNew { arguments, .. } = &mut body + .iter_mut() + .find(|assignment| matches!(assignment.kind, A::ProductNew { .. })) + .unwrap() + .kind + else { + unreachable!() + }; + if matches!(mutation, ReturnState) { + arguments[0] = arguments[1] + } else { + arguments[1] = parameters[0] + } + } + _ => { + let A::DirectCall { arguments, .. } = &body + .iter() + .find(|assignment| assignment.destination == returned) + .unwrap() + .kind + else { + panic!("transition") + }; + let next = arguments.clone(); + match mutation { + ResultState | ResultComputation | SourceQueue | Tail | EmptyAppend + | QueueFinishRest | QueueFinishParent => { + let A::DirectCall { arguments, .. } = &mut body + .iter_mut() + .find(|assignment| assignment.destination == returned) + .unwrap() + .kind + else { + unreachable!() + }; + let index = match mutation { + ResultState => 0, + ResultComputation => 2, + QueueFinishParent => 4, + _ => 3, + }; + arguments[index] = parameters[index]; + } + _ => { + let queue = origin(&function_snapshot, next[3]); + let A::VariantNew { fields, .. } = &body + .iter() + .find(|assignment| assignment.destination == queue) + .unwrap() + .kind + else { + panic!("new pending queue") + }; + let fields = fields.clone(); + match mutation { + AppendTail | AppendRight | FinishExtent | FinishParent => { + let A::VariantNew { fields, .. } = &mut body + .iter_mut() + .find(|assignment| assignment.destination == queue) + .unwrap() + .kind + else { + unreachable!() + }; + match mutation { + AppendTail => fields[0] = parameters[3], + AppendRight => fields[1] = fields[0], + FinishExtent => fields[0] = fields[2], + FinishParent => fields[2] = fields[0], + _ => unreachable!(), + } + } + AppendFirst => { + let nested = origin(&function_snapshot, fields[1]); + let A::VariantNew { fields: inner, .. } = &body + .iter() + .find(|assignment| assignment.destination == nested) + .unwrap() + .kind + else { + unreachable!() + }; + let second = inner[0]; + let A::VariantNew { fields, .. } = &mut body + .iter_mut() + .find(|assignment| assignment.destination == queue) + .unwrap() + .kind + else { + unreachable!() + }; + fields[0] = second; + } + AppendSecond | FinishRest => { + let nested = origin(&function_snapshot, fields[1]); + let A::VariantNew { fields: inner, .. } = &mut body + .iter_mut() + .find(|assignment| assignment.destination == nested) + .unwrap() + .kind + else { + unreachable!() + }; + inner[0] = if matches!(mutation, AppendSecond) { + fields[0] + } else { + parameters[3] + }; + } + _ => unreachable!(), + } + } + } + } + } + let errors = psrs_backend::cc::verify_module(&input.cc).expect_err("malformed root/queue step"); + assert!( + errors + .iter() + .any(|error| error.pass == "P8 CC root and queue execution" + || error.pass == "P8 CC root and queue effects" + || (matches!( + mutation, + Mutation::QueueFinishRest | Mutation::QueueFinishParent + ) && error.pass == "P8 CC control provenance") + || (matches!( + mutation, + Mutation::FinishExtent | Mutation::FinishParent | Mutation::FinishRest + ) && error.pass == "P8 CC finish creation")), + "{mutation:?}: {errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs b/crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs new file mode 100644 index 00000000..0f3063bd --- /dev/null +++ b/crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs @@ -0,0 +1,248 @@ +use super::{R, SOURCE, binding, selected}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; +use psrs_backend::types::ValueId; + +#[test] +fn mir_machine_paths_reject_additional_writes_and_traps() { + use psrs_backend::types::{MemoryId, ValueDecl, ValueType}; + for kind in ["store", "trap"] { + for location in ["return", "default", "entry", "publication"] { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let role = if location == "publication" { + R::Start + } else { + R::Executor + }; + let (symbol, _) = binding(&input.cc.representations, role); + let mut module = if location == "publication" { + psrs_backend::mir::lower_module(input.cc).unwrap().0 + } else { + crate::compile_main_stages(SOURCE).unwrap().mir + }; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let id = if matches!(location, "entry" | "publication") { + function.entry + } else { + let T::Jump { target, .. } = function + .blocks + .iter() + .find(|b| b.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + else { + panic!("header") + }; + if location == "return" { + selected(function, *target, &[0, 0, 0]) + } else { + let T::Switch { default, .. } = function + .blocks + .iter() + .find(|b| b.id == *target) + .unwrap() + .terminator + .as_ref() + .unwrap() + else { + panic!("dispatch") + }; + *default + } + }; + let value = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + let ty = if kind == "store" { + ValueType::I32 + } else { + ValueType::Boolean + }; + function.values.push(ValueDecl { id: value, ty }); + let span = function.span; + let block = function.blocks.iter_mut().find(|b| b.id == id).unwrap(); + block.instructions.splice( + 0..0, + [ + I::Constant { + destination: value, + value: 1, + span, + }, + if kind == "store" { + I::Store { + address: value, + value, + memory: MemoryId(0), + offset: 0, + span, + } + } else { + I::TrapIf { + condition: value, + span, + } + }, + ], + ); + let errors = + psrs_backend::mir::verify_module(&module).expect_err("unaccounted operation"); + assert!( + errors.iter().any(|e| matches!( + e.pass, + "P9 MIR root and queue execution" | "P9 MIR control initialization" + )), + "{kind}/{location}: {errors:?}" + ); + } + } +} + +#[test] +fn mir_executor_rejects_an_unused_narrowing_cast_of_erased_state() { + use psrs_backend::types::{ValueDecl, ValueType}; + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let T::Jump { target, .. } = function + .blocks + .iter() + .find(|b| b.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + else { + panic!("header") + }; + let parameters = &function + .blocks + .iter() + .find(|b| b.id == *target) + .unwrap() + .parameters; + let state = parameters[0]; + let ValueType::Ref(reference) = function + .values + .iter() + .find(|v| v.id == parameters[2]) + .unwrap() + .ty + else { + panic!("computation") + }; + let id = selected(function, *target, &[0, 0, 0]); + let value = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: value, + ty: ValueType::Ref(reference), + }); + function + .blocks + .iter_mut() + .find(|b| b.id == id) + .unwrap() + .instructions + .push(I::RefCast { + destination: value, + value: state, + reference, + span: function.span, + }); + let errors = + psrs_backend::mir::verify_module(&module).expect_err("an unused cast may still trap"); + assert!( + errors + .iter() + .any(|e| e.pass == "P9 MIR root and queue execution"), + "{errors:?}" + ); +} + +#[test] +fn mir_failed_pending_guard_cannot_start_an_owned_transfer_before_trapping() { + use psrs_backend::types::{ValueDecl, ValueType}; + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let T::Jump { target, .. } = function + .blocks + .iter() + .find(|b| b.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + else { + panic!("header") + }; + let owned = selected(function, *target, &[5]); + let guard = function.blocks.iter().find(|b| b.id == owned).unwrap(); + let T::Switch { default, .. } = guard.terminator.as_ref().unwrap() else { + panic!("guard") + }; + let failure = *default; + let (cell, type_index, index) = guard + .instructions + .iter() + .find_map(|i| match i { + I::ArrayGet { + value, + type_index, + index, + .. + } => Some((*value, *type_index, *index)), + _ => None, + }) + .unwrap(); + let fresh = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: fresh, + ty: ValueType::I32, + }); + let span = function.span; + function + .blocks + .iter_mut() + .find(|b| b.id == failure) + .unwrap() + .instructions + .splice( + 0..0, + [ + I::Constant { + destination: fresh, + value: 1, + span, + }, + I::ArraySet { + type_index, + value: cell, + index, + new_value: fresh, + span, + }, + ], + ); + let errors = psrs_backend::mir::verify_module(&module) + .expect_err("a failed acquisition must trap before any transfer"); + assert!( + errors + .iter() + .any(|e| e.message.contains("exceptional machine path")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs b/crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs new file mode 100644 index 00000000..7b2caeea --- /dev/null +++ b/crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs @@ -0,0 +1,320 @@ +use super::{Mutation, R, SOURCE, binding, path}; +use psrs_backend::mir::{BlockId, Function, Instruction as I, Terminator as T}; +use psrs_backend::types::ValueId; + +fn origin(function: &Function, mut value: ValueId) -> ValueId { + let aliases = function + .blocks + .iter() + .flat_map(|block| &block.instructions) + .filter_map(|instruction| match instruction { + I::Copy { + destination, value, .. + } + | I::RefCast { + destination, value, .. + } => Some((*destination, *value)), + _ => None, + }) + .collect::>(); + for _ in 0..aliases.len() { + if let Some(source) = aliases.get(&value) { + value = *source + } else { + break; + } + } + value +} + +fn selected(function: &Function, header: BlockId, path: &[i32]) -> BlockId { + let mut current = header; + for tag in path { + loop { + let block = function + .blocks + .iter() + .find(|block| block.id == current) + .unwrap(); + match block.terminator.as_ref().unwrap() { + T::Switch { cases, .. } => { + current = cases.iter().find(|(case, _)| case == tag).unwrap().1; + break; + } + T::Jump { target, .. } => current = *target, + _ => panic!("machine dispatch"), + } + } + } + current +} + +pub(super) fn reject(mutation: Mutation) { + use Mutation::*; + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let header = match function + .blocks + .iter() + .find(|block| block.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + { + T::Jump { target, .. } => *target, + _ => panic!("loop header"), + }; + let parameters = function + .blocks + .iter() + .find(|block| block.id == header) + .unwrap() + .parameters + .clone(); + let block_id = selected(function, header, path(mutation)); + let fresh = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(psrs_backend::types::ValueDecl { + id: fresh, + ty: function.result_type, + }); + let snapshot = function.clone(); + let block = function + .blocks + .iter_mut() + .find(|block| block.id == block_id) + .unwrap(); + let calls = block + .instructions + .iter() + .filter_map(|instruction| match instruction { + I::ClosureCall { destination, .. } => Some(*destination), + _ => None, + }) + .collect::>(); + match mutation { + ExtraRootCall | ExtraQueueCall | EagerBind => { + let mut extra = if matches!(mutation, EagerBind) { + snapshot + .blocks + .iter() + .flat_map(|block| &block.instructions) + .find(|instruction| matches!(instruction, I::ClosureCall { .. })) + .unwrap() + .clone() + } else { + block + .instructions + .iter() + .rfind(|instruction| matches!(instruction, I::ClosureCall { .. })) + .unwrap() + .clone() + }; + let I::ClosureCall { + destination, + function: callee, + arguments, + .. + } = &mut extra + else { + unreachable!() + }; + *destination = fresh; + if matches!(mutation, EagerBind) { + *callee = parameters[1]; + *arguments = vec![parameters[0]]; + } + block.instructions.push(extra); + } + + HandlerState | Request | Handler | Raw | Callback | Answer => { + let index = match mutation { + HandlerState | Handler | Callback | Answer => 0, + Request => 1, + Raw => 2, + _ => unreachable!(), + }; + let raw = block + .instructions + .iter() + .find_map(|instruction| match instruction { + I::ClosureNew { destination, .. } => Some(*destination), + _ => None, + }); + let replacement = if matches!(mutation, HandlerState) { + match &block + .instructions + .iter() + .find(|instruction| instruction.destination() == Some(calls[1])) + .unwrap() + { + I::ClosureCall { arguments, .. } => arguments[0], + _ => unreachable!(), + } + } else if matches!(mutation, Handler) { + raw.unwrap() + } else if matches!(mutation, Callback) { + parameters[1] + } else { + parameters[0] + }; + let I::ClosureCall { + function: callee, + arguments, + .. + } = block + .instructions + .iter_mut() + .find(|instruction| instruction.destination() == Some(calls[index])) + .unwrap() + else { + unreachable!() + }; + if matches!(mutation, Handler | Callback) { + *callee = replacement + } else { + arguments[0] = replacement + } + } + TrapRoot | TrapCons => { + block.terminator = Some(T::Trap { + span: function.span, + }); + } + ReturnState | ReturnAnswer => { + let I::StructNew { arguments, .. } = block.instructions.iter_mut().find(|instruction| matches!(instruction, I::StructNew { arguments, .. } if arguments.len() == 2)).unwrap() else { unreachable!() }; + if matches!(mutation, ReturnState) { + arguments[0] = arguments[1] + } else { + arguments[1] = parameters[0] + } + } + _ => { + let T::Jump { + target, arguments, .. + } = block.terminator.as_ref().unwrap() + else { + panic!("transition") + }; + assert_eq!(*target, header); + let next = arguments.clone(); + match mutation { + ResultState | ResultComputation | SourceQueue | Tail | EmptyAppend + | QueueFinishRest | QueueFinishParent => { + let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { + unreachable!() + }; + let index = match mutation { + ResultState => 0, + ResultComputation => 2, + QueueFinishParent => 4, + _ => 3, + }; + arguments[index] = parameters[index]; + } + _ => { + let queue = origin(&snapshot, next[3]); + let I::StructNew { + arguments: fields, .. + } = block + .instructions + .iter() + .find(|instruction| instruction.destination() == Some(queue)) + .unwrap() + else { + panic!("new pending queue") + }; + let fields = fields.clone(); + match mutation { + AppendTail | AppendRight | FinishExtent | FinishParent => { + let I::StructNew { + arguments: fields, .. + } = block + .instructions + .iter_mut() + .find(|instruction| instruction.destination() == Some(queue)) + .unwrap() + else { + unreachable!() + }; + match mutation { + AppendTail => fields[1] = parameters[3], + AppendRight => fields[2] = fields[1], + FinishExtent => fields[1] = fields[3], + FinishParent => fields[3] = fields[1], + _ => unreachable!(), + } + } + AppendFirst => { + let nested = origin(&snapshot, fields[2]); + let I::StructNew { + arguments: inner, .. + } = block + .instructions + .iter() + .find(|instruction| instruction.destination() == Some(nested)) + .unwrap() + else { + unreachable!() + }; + let second = inner[1]; + let I::StructNew { + arguments: fields, .. + } = block + .instructions + .iter_mut() + .find(|instruction| instruction.destination() == Some(queue)) + .unwrap() + else { + unreachable!() + }; + fields[1] = second; + } + AppendSecond | FinishRest => { + let nested = origin(&snapshot, fields[2]); + let I::StructNew { + arguments: inner, .. + } = block + .instructions + .iter_mut() + .find(|instruction| instruction.destination() == Some(nested)) + .unwrap() + else { + unreachable!() + }; + inner[1] = if matches!(mutation, AppendSecond) { + fields[1] + } else { + parameters[3] + }; + } + _ => unreachable!(), + } + } + } + } + } + let errors = psrs_backend::mir::verify_module(&module).expect_err("malformed root/queue step"); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR root and queue execution"), + "{mutation:?}: {errors:?}" + ); +} + +mod effects; diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mod.rs b/crates/psrs-driver/src/tests/control_queue_steps/mod.rs new file mode 100644 index 00000000..f3a19d5f --- /dev/null +++ b/crates/psrs-driver/src/tests/control_queue_steps/mod.rs @@ -0,0 +1,150 @@ +//! The root fold and every persistent queue action retain their actual operands. +use super::control_checkpoints::{SOURCE, binding}; +use psrs_backend::cc::ControlHelperRole as R; + +mod cc; +mod mir; + +#[derive(Clone, Copy, Debug)] +enum Mutation { + HandlerState, + Request, + Handler, + Raw, + ResultState, + ResultComputation, + SourceQueue, + ReturnState, + ReturnAnswer, + Callback, + Answer, + Tail, + EmptyAppend, + AppendTail, + AppendRight, + AppendFirst, + AppendSecond, + FinishExtent, + FinishParent, + FinishRest, + QueueFinishRest, + QueueFinishParent, + TrapRoot, + TrapCons, + ExtraRootCall, + ExtraQueueCall, + EagerBind, +} + +fn path(mutation: Mutation) -> &'static [i32] { + use Mutation::*; + match mutation { + HandlerState | Request | Handler | Raw | ResultState | ResultComputation | SourceQueue => { + &[1, 0] + } + ReturnState | ReturnAnswer | TrapRoot => &[0, 0, 0], + Callback | Answer | Tail | TrapCons | ExtraQueueCall => &[0, 1], + EagerBind => &[2], + ExtraRootCall => &[1, 0], + EmptyAppend => &[0, 2, 0], + AppendTail | AppendRight => &[0, 2, 1], + AppendFirst | AppendSecond => &[0, 2, 2], + FinishExtent | FinishParent | FinishRest => &[0, 2, 3], + QueueFinishRest | QueueFinishParent => &[0, 3], + } +} + +const MUTATIONS: &[Mutation] = &[ + Mutation::HandlerState, + Mutation::Request, + Mutation::Handler, + Mutation::Raw, + Mutation::ResultState, + Mutation::ResultComputation, + Mutation::SourceQueue, + Mutation::ReturnState, + Mutation::ReturnAnswer, + Mutation::Callback, + Mutation::Answer, + Mutation::Tail, + Mutation::EmptyAppend, + Mutation::AppendTail, + Mutation::AppendRight, + Mutation::AppendFirst, + Mutation::AppendSecond, + Mutation::FinishExtent, + Mutation::FinishParent, + Mutation::FinishRest, + Mutation::QueueFinishRest, + Mutation::QueueFinishParent, + Mutation::TrapRoot, + Mutation::TrapCons, + Mutation::ExtraRootCall, + Mutation::ExtraQueueCall, + Mutation::EagerBind, +]; + +#[test] +fn cc_root_and_queue_steps_reject_same_shaped_substitutions() { + for mutation in MUTATIONS { + cc::reject(*mutation); + } +} + +#[test] +fn mir_root_and_queue_steps_reject_same_shaped_substitutions() { + for mutation in MUTATIONS { + mir::reject(*mutation); + } +} + +#[test] +fn execution_requires_the_layout_owned_result_pair() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + input.cc.representations.control_result_pair = None; + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|error| error + .message + .contains("execution has no planned result pair")), + "{errors:?}" + ); +} + +#[test] +fn root_state_and_pending_callbacks_execute_in_order() { + let Some(()) = super::wasmtime_available() else { + return; + }; + let source = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: case state of + 7 -> 1 + _ -> 0 + , _2: raw (k 42) } +work :: C.Control Op Int +work = C.bind (C.bind (C.return 2) (\x -> case x of + 2 -> C.return 40 + _ -> C.return 0)) + (\x -> case x of + 40 -> C.bind (C.perform (Op \y -> y)) (\y -> case y of + 42 -> C.return 43 + _ -> C.return 0) + _ -> C.return 0) +main :: Int +main = let result = C.run 7 handler work + in case result._1 of + 1 -> result._2 + _ -> 0 +"; + let stages = crate::compile_main_stages(source).unwrap(); + let path = std::env::temp_dir().join("psrs-control-root-queue-order.wasm"); + std::fs::write(&path, stages.artifact.wasm).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg(path) + .output() + .unwrap(); + assert_eq!(output.status.code(), Some(43), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/control_result_provenance.rs b/crates/psrs-driver/src/tests/control_result_provenance.rs new file mode 100644 index 00000000..1a6f11aa --- /dev/null +++ b/crates/psrs-driver/src/tests/control_result_provenance.rs @@ -0,0 +1,352 @@ +use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; +use psrs_backend::mir::{Instruction as I, Terminator as T}; +const SOURCE: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +main :: Int +main = (C.run 0 handler (C.bind (C.perform (Op \x -> x)) (\_ -> C.return 43)))._2 +"; +fn symbol(input: &psrs_backend::BackendInput) -> psrs_hir::SymbolId { + input + .cc + .representations + .control_helpers + .iter() + .find(|h| h.role() == R::Executor) + .unwrap() + .function() +} +#[test] +fn cc_cannot_discard_outer_return_result() { + for tag in 0..=5 { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = symbol(&input); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let state = function.parameters[0]; + let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { + panic!("executor input dispatch") + }; + cases.iter_mut().find(|case| case.tag == tag).unwrap().value = state; + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("discarded machine transition"); + assert!( + errors.iter().any(|error| error + .message + .contains("executor transition result must reach every normal exit")), + "tag {tag}: {errors:?}" + ); + assert!(psrs_backend::compile_cc(input).is_err()); + } +} + +fn joined_input(same: bool) -> psrs_backend::BackendInput { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = symbol(&input); + let f = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + fn wrap( + body: &mut [psrs_backend::cc::Assignment], + next: &mut u32, + values: &mut Vec, + alternative: Option, + ) -> bool { + for a in body { + match &mut a.kind { + A::TagSwitch { cases, .. } + if cases.len() == 2 && cases[0].tag == 0 && cases[1].tag == 1 => + { + let case = &mut cases[1]; + let original = case.value; + let ty = values.iter().find(|v| v.id == original).unwrap().ty; + let cond = psrs_backend::cc::ValueId(*next); + *next += 1; + let result = psrs_backend::cc::ValueId(*next); + *next += 1; + values.push(psrs_backend::cc::ValueDecl { + id: cond, + ty: psrs_backend::cc::ValueShape::Boolean, + }); + values.push(psrs_backend::cc::ValueDecl { id: result, ty }); + case.assignments.push(psrs_backend::cc::Assignment { + destination: cond, + kind: A::Constant(1), + span: a.span, + }); + case.assignments.push(psrs_backend::cc::Assignment { + destination: result, + kind: A::If { + condition: cond, + then_assignments: vec![], + then_value: original, + else_assignments: vec![], + else_value: alternative.unwrap_or(original), + }, + span: a.span, + }); + case.value = result; + return true; + } + A::TagSwitch { cases, .. } => { + for case in cases { + if wrap(&mut case.assignments, next, values, alternative) { + return true; + } + } + } + _ => {} + } + } + false + } + let A::TagSwitch { cases, .. } = &mut f.assignments.last_mut().unwrap().kind else { + panic!() + }; + let body = &mut cases.iter_mut().find(|c| c.tag == 0).unwrap().assignments; + let mut next = f.values.iter().map(|v| v.id.0).max().unwrap() + 1; + let alternative = (!same).then_some(f.parameters[0]); + assert!(wrap(body, &mut next, &mut f.values, alternative)); + input +} + +#[test] +fn cc_equivalent_scoped_result_join() { + let input = joined_input(true); + psrs_backend::cc::verify_module(&input.cc).expect("equivalent result join"); + let artifact = + psrs_backend::compile_cc(input).expect("equivalent result join compiles through MIR"); + if super::wasmtime_available().is_some() { + let path = std::env::temp_dir().join("psrs-control-equivalent-result-join.wasm"); + std::fs::write(&path, artifact.wasm).unwrap(); + let output = std::process::Command::new("wasmtime") + .arg(&path) + .output() + .unwrap(); + assert_eq!(output.status.code(), Some(43), "{output:?}"); + } +} + +#[test] +fn cc_result_join_cannot_hide_a_discarded_alternative() { + let input = joined_input(false); + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("one result alternative discarded"); + assert!( + errors.iter().any(|error| error + .message + .contains("executor transition result must reach every normal exit")), + "{errors:?}" + ); +} +#[test] +fn mir_wrong_machine_constructor_tag() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let exec = symbol(&input); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let f = module + .functions + .iter_mut() + .find(|f| f.symbol == exec) + .unwrap(); + let target = f + .blocks + .iter() + .find_map(|b| match &b.terminator { + Some(T::Switch { cases, .. }) + if cases.iter().map(|(t, _)| *t).collect::>() == vec![0, 1, 2, 3, 4, 5] => + { + Some(cases.iter().find(|(t, _)| *t == 2).unwrap().1) + } + _ => None, + }) + .unwrap(); + let tag = f + .blocks + .iter() + .find(|b| b.id == target) + .unwrap() + .instructions + .iter() + .find_map(|i| match i { + I::StructNew { arguments, .. } if arguments.len() == 3 => Some(arguments[0]), + _ => None, + }) + .unwrap(); + let definition = f + .blocks + .iter_mut() + .flat_map(|b| &mut b.instructions) + .find(|i| i.destination() == Some(tag)) + .unwrap(); + let I::Constant { value, .. } = definition else { + panic!("tag constant") + }; + *value = 0; + let errors = psrs_backend::mir::verify_module(&module).expect_err("wrong nominal case tag"); + assert!( + errors.iter().any(|e| e + .message + .contains("variant constructor must initialize its planned case tag")), + "{errors:?}" + ); +} + +#[test] +fn mir_executor_call_must_return_its_actual_result() { + for discard in [false, true] { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, contract) = + super::control_checkpoints::binding(&input.cc.representations, R::Executor); + let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; + let function = module + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let header = match function + .blocks + .iter() + .find(|b| b.id == function.entry) + .unwrap() + .terminator + .as_ref() + .unwrap() + { + T::Jump { target, .. } => *target, + _ => panic!("executor loop preheader"), + }; + let result = psrs_backend::types::ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(psrs_backend::types::ValueDecl { + id: result, + ty: function.result_type, + }); + let block = function.blocks.iter_mut().find(|block| { + block.instructions.iter().any(|instruction| matches!(instruction, I::ClosureCall { .. })) + && matches!(&block.terminator, Some(T::Jump { target, arguments, .. }) if *target == header && arguments.len() == 6) + }).unwrap(); + let T::Jump { + arguments, span, .. + } = block.terminator.take().unwrap() + else { + unreachable!() + }; + let state = arguments[0]; + block.instructions.push(I::Call { + destination: result, + contract: Some(contract), + function: symbol, + arguments, + span, + }); + block.terminator = Some(T::Return { + value: if discard { state } else { result }, + span, + }); + let verified = psrs_backend::mir::verify_module(&module); + if discard { + let errors = verified.expect_err("call result discarded at actual return"); + assert!( + errors.iter().any(|error| error + .message + .contains("executor transition result must reach every normal exit")), + "{errors:?}" + ); + } else { + verified.expect("actual executor result returned"); + } + } +} + +#[test] +fn cc_equivalent_switch_result_join() { + use psrs_backend::cc::{Assignment, TagCase, ValueDecl, ValueId, ValueShape}; + let mut input = joined_input(true); + let symbol = symbol(&input); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let trap = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(ValueDecl { + id: trap, + ty: function.result_type, + }); + let mut selector = None; + assert!(super::control_dispatch::visit( + &mut function.assignments, + &mut |assignment| { + let A::If { + condition, + then_value, + else_value, + .. + } = &assignment.kind + else { + return false; + }; + if then_value != else_value { + return false; + } + selector = Some(*condition); + let returned = *then_value; + assignment.kind = A::TagSwitch { + value: *condition, + cases: vec![ + TagCase { + tag: 0, + assignments: vec![], + value: returned, + }, + TagCase { + tag: 1, + assignments: vec![], + value: returned, + }, + ], + default_assignments: vec![Assignment { + destination: trap, + kind: A::Unreachable, + span: assignment.span, + }], + default_value: trap, + }; + true + } + )); + function + .values + .iter_mut() + .find(|value| Some(value.id) == selector) + .unwrap() + .ty = ValueShape::Integer; + psrs_backend::cc::verify_module(&input.cc).expect("equivalent switch result join"); + psrs_backend::compile_cc(input).expect("equivalent switch result join compiles through MIR"); +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index 284052e5..bfd0faad 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -10,13 +10,23 @@ mod coercion; mod control_carriers; mod control_checkpoint_ordering; mod control_checkpoints; +mod control_clause_selection; +mod control_clause_steps; mod control_context_contracts; mod control_context_entry; mod control_contracts; mod control_costs; +mod control_dispatch; +mod control_execution_steps; mod control_finish_provenance; mod control_helper_contracts; +mod control_inlined_publication; +mod control_lifecycle_bodies; +mod control_observable_paths; +mod control_owned_steps; +mod control_queue_steps; mod control_replay_contracts; +mod control_result_provenance; mod control_root; mod data_function; mod data_tuple; diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 82d88738..649fea6c 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1225,7 +1225,7 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Labelled Control rows over pinned VariantF execute deep forwarding and shallow residual policies. Complete pinned Run/Free dependency sources are imported unchanged; representative pure Run State, Choose and combined Reader/State/Writer/Except programs execute with observed values and log order. Complete execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and broader upstream-library API acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Labelled Control rows over pinned VariantF execute deep forwarding and shallow residual policies. Complete pinned Run/Free dependency sources are imported unchanged; representative pure Run State, Choose and combined Reader/State/Writer/Except programs execute with observed values and log order. CC/MIR now check dispatch coverage and selected-case projections, required scoped clause application results and current operands, and Bind/Resume transition identities; scoped MIR applications must execute on the actual branch path. Complete remaining execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and broader upstream-library API acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | | Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | diff --git a/docs/design/backend/README.md b/docs/design/backend/README.md index 353bc2bc..9331203e 100644 --- a/docs/design/backend/README.md +++ b/docs/design/backend/README.md @@ -55,7 +55,8 @@ is [Functional Core](../frontend/semantics/functional-core.md). | [control-flow-and-tail-calls.md](fp/control-flow-and-tail-calls.md) | CFG structuring, `Switch`, tail calls | mir | | [type-classes-and-dictionaries.md](fp/type-classes-and-dictionaries.md) | Dictionary passing and instance evidence | functional-core | | [algebraic-effects-and-handlers.md](fp/algebraic-effects-and-handlers.md) | Library operation functors, handlers, residual rows, and the `Run` wrapper over the control surface (**Draft design**) | DEC-03, delimited control, ordinary rows/classes, functional-core | -| [delimited-control-and-resumable-frames.md](fp/delimited-control-and-resumable-frames.md) | Effect-agnostic delimited control (`Control f a` with `return`/`bind`/`perform`/`run`) and its selective CPS / defunctionalized-frame lowering (**Draft design**) | DEC-03, DEC-19, cc-ir, mir, control-flow-and-tail-calls, capability-profile | +| [delimited-control-and-resumable-frames.md](fp/delimited-control-and-resumable-frames.md) | Effect-agnostic delimited control (`Control f a` with `return`/`bind`/`perform`/`run`), the design-space selection, handler interface and lifetime semantics (**Draft design**) | DEC-03, DEC-19, cc-ir, mir, control-flow-and-tail-calls, capability-profile | +| [control-machine.md](fp/control-machine.md) | The compiler-generated continuation machine: node inventory, per-IR representation, lowering, flat driver and sequence replay (**Draft design**) | delimited control, control elimination, cc-ir, mir, data-representation | | [native-effect-and-st-handlers.md](fp/native-effect-and-st-handlers.md) | Official Effect/ST facades, common native computation, typed storage/host handlers, and region safety (**Draft proposal**) | algebraic effects, delimited control, roles, rank-N, runtime linking | | [effects.md](fp/effects.md) | Effect representation and the platform boundary (**withdrawn 2026-10-11**; replacement undecided) | functional-core | | [state-primitives-and-dependency-lowering.md](fp/state-primitives-and-dependency-lowering.md) | Primitive State semantics and cross-pass dependencies (**withdrawn 2026-10-11**) | primitive types, functional-core, CC, MIR | diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 152b5608..3572194b 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -131,18 +131,21 @@ per handler or request: ```text Computation = Return | Perform | Bind | Resume | Handle(ret, op, body) | OwnedResume -Sequence = Empty | Cons | Append -Context = Source(contract, ret, op, sourceQueue, extent, caller) - | Target(contract, targetQueue, finishExtent, caller) +Sequence = Empty | Cons | Append | Finish(extent, rest, parent) +Context = Root(extent) + | Scoped(ret, op, callerQueue, callerExtent, callerContext, ownedExtent) +Extent = RootExtent(status) | ChildExtent(status, parent) ``` -A contract records the checked source request/answer domain and target -request/answer domain. A source context captures only its source queue. Caller -work is outside that capture. When a clause returns target data, its source -dispatch is absent; the enclosing target dispatch handles fresh requests. -An explicit finish marker retains the source extent until that target computation -finishes with `b`, then supplies `b` to the saved caller queue. Returning `a` -from the source is not equivalent to completing the target with `b`. +A `Scoped` context captures only its source queue. Caller work is outside that +capture. When a clause returns target data, its source dispatch is absent; the +enclosing `Scoped`/`Root` context handles fresh requests. An explicit finish +marker (`Finish` in the sequence) retains the source extent until that target +computation finishes with `b`, then supplies `b` to the saved caller queue. +Returning `a` from the source is not equivalent to completing the target with +`b`. The runtime frames carry no contract field: the checked source/target +domains are compile-time evidence. The concrete node fields are fixed in +[the control machine](control-machine.md#the-continuation-machine). ### Lifetime and replay @@ -430,11 +433,14 @@ current loop iteration are checked through the same common MIR operation used by replay validation; an allocation reused from the entry preheader is invalid. These checks establish constructor operands and their associated transitions. -They do not yet prove complete dispatch coverage, branch selection (including -when tail coalescing is selected), root context seeding, or rejection after an -entire required entry step is removed. Status initialization is checked; arbitrary -extra effectful instructions and complete lifecycle flow require execution-step -verification. Those obligations remain part of full context provenance. +They compose with the machine's dispatch coverage and checked Run root-seeding +relations; those checks are owned separately rather than reconstructed here. +Status initialization is checked. Complete branch equivalence, including the +condition selecting tail coalescing, removal of a required entry, arbitrary +extra effectful instructions and exceptional lifecycle flow still need complete +execution-step evidence. See the +[machine verification contract](control-machine.md#invariants-and-verification) +and [current review](../../../implementation/backend/delimited-control-architecture-review-2026-10-14.md). ### Finish consumption ownership @@ -458,9 +464,13 @@ establish that every finish was created from the right context, that all replay activations have the intended ancestry, or that all checkpoint captures and checks refer to the proper source extent. Those producer, capture and activation obligations remain required for complete lifecycle provenance. A simultaneous -rewrite removing both the close and all recognizable finish projections is not -proved equivalent by this local relation check; complete execution-step evidence -must still cover it. +rewrite removing both the close and all recognizable finish projections cannot +be proved by this local relation alone. The shared queue execution relation now +checks the selected Finish's operands and required-action coverage rejects +removing its entire action. The separate lifecycle-body relation proves Close, and shared execution events +check normal paths and the prefixes ending at failed guards. These relations +compose with this local finish-consumer check; caught-host-trap recovery and +complete acceptance remain separate obligations. ### Alternatives @@ -521,12 +531,13 @@ finish frames and forged checkpoint ownership are errors. No stage adds effect inference, reinterprets operation spellings or mutates representation layout late. Required behavior includes clause and return-clause effects outside source -dispatch; deep reinstatement; shallow escape with a truthful residual type; -forwarding, abandonment and independent replay; caller work outside capture; -expiry after target completion; liveness throughout clauses; replay of nested -finish frames; one-shot reuse rejection; GC roots; long request sequences; and -foreign-resource/host-trap cleanup. Type proofs and a rewrite model do not verify -Wasm lifetime, GC, stack safety or foreign cleanup. The +dispatch; a source return or operation applying the matching clause of its +current scoped context; deep reinstatement; shallow escape with a truthful +residual type; forwarding, abandonment and independent replay; caller work +outside capture; expiry after target completion; liveness throughout clauses; +replay of nested finish frames; one-shot reuse rejection; GC roots; long request +sequences; and foreign-resource/host-trap cleanup. Type proofs and a rewrite +model do not verify Wasm lifetime, GC, stack safety or foreign cleanup. The [implementation checklist](../../../implementation/backend/algebraic-effects.md) keeps these claims separate. diff --git a/docs/design/backend/fp/control-machine.md b/docs/design/backend/fp/control-machine.md new file mode 100644 index 00000000..70af122a --- /dev/null +++ b/docs/design/backend/fp/control-machine.md @@ -0,0 +1,680 @@ +# The Control Machine: Representation and Driver + +**Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) +**Status:** Draft design. The node inventory, lowering and flat driver match the +implementation; complete verifier and lifecycle acceptance remains outstanding. +The mechanism is selected by +[DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md). +**Prerequisites:** [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), +[delimited control and resumable frames](delimited-control-and-resumable-frames.md), +[control elimination and handler scopes](control-elimination-and-handler-scopes.md), +[CC IR](cc-ir.md), [MIR](mir.md), +[data representation](data-representation.md), +[control flow and tail calls](control-flow-and-tail-calls.md), and +[representation and evidence](representation-and-evidence.md). +**Summary:** This document specifies the compiler-generated continuation machine +that the `Control` surface lowers to: its node inventory, how each layer encodes +it, how lowering produces it, and how one flat driver traverses it. It fixes the +concrete machine the rest of the delimited-control design refers to. + +## Scope + +This document owns the compiler-generated continuation machine: the inventory and +representation of the inert computation, pending-sequence, dispatch-context, +lifetime-extent and one-shot-owner nodes; the generated helper signatures; the +per-layer encoding from Core through CC and MIR to Wasm; the lowering that +produces the machine; the flat driver and how it traverses a saved continuation; +and the machine's own invariants and verification obligations. + +It does not own the `Control f a` surface, the eight primitives, or the +source/target elimination contract — those are +[delimited control and resumable frames](delimited-control-and-resumable-frames.md) +and [control elimination and handler scopes](control-elimination-and-handler-scopes.md). +It does not own the library effect encoding +([library-owned algebraic effects](algebraic-effects-and-handlers.md)), the target +structured encoding ([Wasm encoding](../wasm/encoding-and-structuring.md)), or the +runtime ([linking and runtime](../wasm/linking-and-runtime.md)). It defines the +machine those stages produce, consume, or leave untouched. + +## Background + +A defunctionalized continuation is the continuation represented as data rather +than as a closure or a captured native stack. The +[design space](delimited-control-and-resumable-frames.md#design-space) of +delimited control selects a **frame chain** — inert nodes linked by an explicit +pending sequence — driven by a **compiler-generated loop** rather than by tail +calls or runtime stack switching. This machine is that frame chain and that loop. + +The choice has three consequences this document makes concrete: + +- The continuation is ordinary heap data, so the collector finds its roots without + runtime help and the same captured sequence may be traversed more than once. +- The compiler owns the frame layout, so it can state and verify frame identity, + capture boundaries and one-shot status as ordinary IR contracts. +- Stack safety comes from the driver loop, not from a native stack, so it does not + depend on every step being a tail call. + +The machine is effect-agnostic. It never inspects a request, an answer or a +handler; the library decides what an operation means. + +## Model + +### The continuation machine + +This machine realizes row 3 — a defunctionalized frame chain driven by a +compiler-generated loop — of the +[design space](delimited-control-and-resumable-frames.md#design-space). The eight +operations lower to an inert node graph interpreted by one flat driver +(the executor loop, [The flat driver](#the-flat-driver)). The node graph *is* the +captured continuation: there is no separate stack object, only persistent nodes +reachable from the driver, plus one mutable status cell per lifetime extent and +one mutable callback/status pair per one-shot owner. This subsection fixes the +value inventory and the driver's entry contract; the per-representation encodings +are in [Representation across IR layers](#representation-across-ir-layers). + +Source payloads (`f a` request, `a` answer, user state, callbacks) cross the +machine boundary erased, because the machine is polymorphic over them and never +inspects them. The machine's own fields — computations, queues, contexts, +extents and owners — are nominal: their representation is planned before +lowering and never reconstructed from an erased value. Only the explicit +payload/storage boundary erases and recovers a source value. + +**Computation nodes.** `Control f a` is a tagged node. `f` and `a` are erased; a +payload field below is erased unless the node holds another machine value. + +| Tag | Node | Fields | Meaning | +| --- | --- | --- | --- | +| 0 | `Return(a)` | answer (erased) | a completed source answer | +| 1 | `Perform(f a)` | request (erased) | an unhandled request | +| 2 | `Bind(inner, k)` | inner computation, unary callback | run `inner`, then `k` on its answer | +| 3 | `Resume(v, q, e)` | answer (erased), pending queue, captured extent | a raw continuation invocation | +| 4 | `Handle(ret, op, body)` | return clause, operation clause, body | an inert source-to-target delimiter | +| 5 | `OwnedResume(owner, v)` | one-shot owner, answer (erased) | a one-shot resumption invocation | + +Tags 0, 1, 2, 4 and 5 are the public constructors of `return`, `perform`, `bind`, +`handle` and `resume`. Tag 3 is not a source constructor: only the raw +continuation code target builds it, so `Resume` (tag 3, the raw node) and +`OwnedResume` (tag 5, the public `resume` node) are distinct even though both +invoke a captured continuation. An unknown tag reaches the driver's trapping +default. + +**Pending sequence.** The pending queue is a persistent, shareable sequence. +Nodes are never mutated, so a captured sequence may be traversed again by a +second resumption. + +| Tag | Node | Fields | Meaning | +| --- | --- | --- | --- | +| 0 | `Empty` | — | no pending work | +| 1 | `Cons(k, rest)` | unary callback, tail | apply `k` to the current answer, then `rest` | +| 2 | `Append(left, right)` | left, right | run `left` before `right` | +| 3 | `Finish(e, rest, parent)` | extent, remaining, parent | close `e`, restore `parent`, then run `rest` | + +`Append` is associative but not flattened; the driver reassociates it lazily so +that a shared sequence tail keeps its identity and is never copied. + +**Dispatch context.** The context records where requests are currently handled +and where completion returns to. It is a two-case node. + +| Tag | Node | Fields | +| --- | --- | --- | +| 0 | `Root(e)` | root extent `e` | +| 1 | `Scoped(ret, op, callerQueue, callerExtent, callerContext, ownedExtent)` | return clause, operation clause, caller's pending queue, caller's extent, caller's context, this delimiter's extent | + +`Root` is the closed-`run` state fold: requests are handled by the `run` clause +in place. `Scoped` is a `handle` delimiter: its clauses run in the caller's +context, and the delimiter's own extent bounds the captured continuation. + +**Lifetime extent.** One extent per delimiter, plus one for each replayed +activation. The extent is a two-case node over a one-element mutable status +cell. + +| Tag | Node | Fields | +| --- | --- | --- | +| 0 | root extent | status cell | +| 1 | child extent | status cell, parent extent | + +The status cell holds `0` while live and `1` once closed. Closing is idempotent +for the checker but is applied exactly once per delimiter on its normal +completion path. A closed extent rejects any later capture or resume. + +**One-shot owner.** `Resumption f a b` is a single-case node over two one-element +cells. + +| Tag | Node | Fields | +| --- | --- | --- | +| 0 | `Owner(callback, status)` | erased callback slot, integer status cell | + +The status cell is `0` Pending, `1` Running, `2` Consumed, `3` Cancelled. +On acquisition, the callback is loaded into a local root and its slot is +overwritten with the owner's status-cell reference before the callback runs. +Cancellation also clears the slot. The replacement cannot root the callback's +captures. The mutable callback/status cells and extent status cells are the only +mutable machine storage; computation, queue and context fields stay immutable. + +**Driver and helper signatures.** The driver and its helpers are ordinary +functions with predeclared signatures, so a call is checked by identity before +it is lowered. + +```text +executor : (state, handler, computation, queue, extent, context) -> state/answer +cloneSequence : (queue, todo, reversed, active, parent) -> (queue, extent) +rebuildSequence : (reversed, result, active, parent) -> (queue, extent) +start : () -> extent +check, close : extent -> extent +once : callback -> owner +cancel : owner -> owner +``` + +`state` and `handler` belong to closed `run`; a scoped delimiter threads them +unchanged. `handler` is the `run` clause, `once`/`cancel` are the one-shot API, +and `start`/`check`/`close` manage extent lifetime. [The flat driver](#the-flat-driver) +defines how these are used. + +## Design + +### Representation across IR layers + +The same machine value has a different encoding at each layer. No layer recovers +a machine value from an erased source payload, and no layer reconstructs a source +type from a machine node. + +**Core.** `Control f a` and `Resumption f a b` are opaque nominal carriers +(`CONTROL`, `RESUMPTION`); the eight operations stay intrinsic calls. Each +checked occurrence carries a `CheckedControlContract` — result type, argument +types, and the source/target `(request, answer)` domains. Core introduces no node +and no payload layout. + +**CC.** The immutable representation table stores target-neutral symbolic values. +The computation, pending sequence, dispatch context and lifetime extent are +`Variant`s over their case tables +([The continuation machine](#the-continuation-machine)); the callback and status +slots are one-element `Array`s; the replay result is a `Product` of a queue and an +extent. `CONTROL` and `RESUMPTION` reserve nominal identities so source +parameters, results, captures and joins keep the machine shape. Every field is a +`ValueShape`: a machine field is a nominal `Reference(Repr)` or a closure +signature, while a source payload is `Erased`. The executor and helper signatures +are declared before any body is lowered, and the table is frozen afterwards. + +**MIR.** A variant lowers to a non-final abstract supertype that carries only an +immutable `i32` tag at field 0, plus one final subtype per case that repeats the +tag and appends the case fields (see +[data representation](data-representation.md#concrete-layouts)). Construction +emits `struct.new` at the case type, then `ref.cast` to the common type when one +is declared; a tag read casts to the supertype and reads field 0; a field +projection casts to the case type and reads field `index + 1`. Arrays and products +lower to GC arrays and structs. Source payloads become the target's erased +reference. The executor's self tail calls become a preheader that forwards the six +parameters to a loop header, and every self call becomes a back edge to that +header. + +**Wasm.** The structurer encodes the loop as a Wasm `loop`, the computation +dispatch as `br_table` over the `i32` tag, and projections and constructions as +GC struct/array operations. Stack safety follows the loop, not a native stack. +The [structured encoding](../wasm/encoding-and-structuring.md) owns these +encodings. + +### Lowering the machine + +Lowering fixes the representation before it emits any code, so the synthesized +bodies can only consume the plan: + +1. **Reserve and plan.** Before source signatures and aggregate layouts, reserve + the nominal `Control`/`Resumption` identities. Then append the carrier and + helper tables and allocate the generated symbols: the raw resumption code + target and the eight helpers (`executor`, `cloneSequence`, `rebuildSequence`, + `start`, `check`, `close`, `once`, `cancel`). Publish the helper contracts and + the raw-resumption contract in the representation table, and quote each + checked Core contract into a plan that maps every primitive to a computation + case or a helper call. +2. **Lower operands.** For each primitive occurrence, lower the arguments into + their declared storage roles: a source payload through the shared erased + payload protocol, a callback through the shared curried callback protocol, a + machine carrier directly as its nominal reference. A checked `ControlEvidence` + assignment records the proof and the chosen implementation. +3. **Construct frames.** `return`, `perform`, `bind`, `handle` and `resume` + simply build their computation node. `run` builds an empty queue, a root + extent, a `Root` context, calls the executor on + `(state, handler, computation, empty, boundary, root)`, and closes the + boundary. `once` and `cancel` call their helpers. +4. **Synthesize helpers.** On first use, synthesize the raw resumption target and + the eight helpers from the fixed tables, and verify each synthesized function + before publishing it. Bodies are built from the same shared operations that + ordinary lowering uses, so no helper gets a private representation path. +5. **Lower to MIR.** The ordinary CC-to-MIR pass resolves symbolic + representations to physical layouts, and the tail-call pass loopifies the + executor's self calls. The MIR verifiers recheck the machine relations in + [Invariants and verification](#invariants-and-verification). +6. **Structure to Wasm.** The structured encoding emits the loop and its + dispatch; nothing control-specific survives into the encoder. + +The generated symbols are ordinary functions with predeclared signatures, so +their calls are checked by identity and lowered like any other call. Nothing in +this pipeline recognizes a concrete effect, operation or handler. + +### Capture and frame construction + +Raw resume checks checkpoint liveness, runs the saved sequence before its consumer +queue, and does not automatically reinstall source dispatch. Capture excludes +caller work. Abandonment clears the source queue from the driver; only explicit +resume may run it. Persistent queues support replay without cloning user mutable +data. + +Explicit heap contexts distinguish source normalization from target execution. +A clause's target answer runs under enclosing dispatch with an extent-finish +marker. The [scope contract](control-elimination-and-handler-scopes.md#machine-phases-and-scope) +specifies context identities, capture provenance and finish boundaries. + +CC layout predeclares computation/context layouts and all executor/callback +SignatureIds. Lowering synthesizes bodies using these declarations and cannot +mutate the representation table. Checked source/target contract identities remain +available for verification after payload erasure. The previous open-union +`Handle`/`Reenter` executor is v1 implementation evidence, not this normative shape. + +### The flat driver + +The machine is run by one flat function, the **executor**. It is not a recursive +interpreter: every transition computes the executor's own next parameters, and +MIR lowering turns those self tail calls into one loop. The executor's state is +exactly its six parameters: + +```text +(state, handler, computation, queue, extent, context) +``` + +`computation` is the node to step, `queue` is the pending sequence, `extent` is +the live lifetime boundary, `context` is the current dispatch, and `state` / +`handler` are the closed-`run` fold, threaded unchanged by scoped delimiters. + +One step dispatches on the computation tag: + +| Node | Transition | +| --- | --- | +| `Return(v)` | descend the pending queue with `v` (see below) | +| `Perform(req)` | in a `Root` context, apply the `run` clause to `state`, `req` and a raw continuation, and continue with the clause's `(nextState, next)` and an empty queue; in a `Scoped` context, apply the operation clause to `req` and a raw continuation and enter the resulting target under the caller's context | +| `Bind(inner, k)` | push `Cons(k, queue)` and continue with `inner` | +| `Resume(v, saved, e)` | check `e`, replay `saved` into a fresh activation, push the replayed queue in front of the current queue, make that activation current, and continue with `Return(v)` | +| `Handle(ret, op, body)` | install a `Scoped` context for `body` and continue with an empty queue; a leading `Finish` is coalesced so a tail-returned handle shares its completion instead of adding a second one | +| `OwnedResume(owner, v)` | transfer the owner from Pending to Running, then Consumed around one callback application, and continue with the callback's next computation | +| unknown tag | trap | + +Descending the pending queue with a `Return` value is the traversal of the saved +continuation: + +| Queue node | Action | +| --- | --- | +| `Empty` | the delimiter has finished: a `Root` context returns `(state, value)`; a `Scoped` context runs its return clause and enters the target answer under the caller's context | +| `Cons(k, rest)` | apply `k` to the value and continue with `rest` | +| `Append(left, right)` | inspect `left`: an `Empty` continues with `right`; a `Cons` becomes `Append(rest, right)` and applies its callback; an `Append` is reassociated to run `left` first; a `Finish` moves the finish in front of `Append(rest, right)` | +| `Finish(e, rest, parent)` | close `e`, make `parent` current, and continue with `rest` | + +A raw continuation is a closure over the current `queue` and the checkpoint +selected from the current dispatch context: `Root` field 0 or `Scoped` field 5. +The checkpoint can differ from the current execution extent during replay. +Invoking the closure builds `Resume` (tag 3), and the driver replays that sequence with +`cloneSequence`/`rebuildSequence` ([Replaying a captured sequence](#replaying-a-captured-sequence)). +Replay never clones a user callback or a one-shot owner: only lifecycle +activating nodes (`Finish`) are rebuilt, each with a fresh child extent. + +Because the loop drives control steps, the native Wasm stack does not grow with +the depth of interpreted binds or with long machine request sequences. Ordinary +recursive user callbacks are not converted into frames by this monadic lowering; +their stack behavior follows ordinary call and tail-call lowering. Using +`return_call`/`return_call_ref` for the tail positions of the emitted steps keeps +the constant-stack property even where the machine calls into ordinary code. + +### The executor and the runtime boundary + +The eliminator's driver — the flat loop of [The flat driver](#the-flat-driver) — is the +**executor**: the component that interprets `Control` data through typed contexts +and dispatch clauses; closed `run` also threads explicit handler state. Where it lives is a design decision with a strict boundary. + +- **The executor is guest code.** It is a compiler-generated loop over the frame + representation, or a library function over a compiler-provided frame view. It runs + in the compiled program because it must call the guest handler and guest + continuations; a host function cannot call back into arbitrary guest closures + without an explicit boundary. +- **The runtime does not interpret frames.** The Wasm engine manages the GC heap + containing frames. `psrs-runtime` supplies checked guest runtime leaves and + linear-memory allocation; host services enter through explicit bindings, and + the compiler-owned linker assembles the artifact. None of these components + inspects continuation layouts or owns the control driver. +- **The runtime may provide a generic driver loop.** A runtime that loops calling a + guest "step" function is admissible, as long as it treats the step as opaque guest + code and learns nothing about the frame layout. This is optional; a guest-side loop + is the baseline. +- **Under a native continuation the executor disappears.** With stack switching the + runtime captures and resumes the stack itself, so there is no software driver to + place ([migration to native control](delimited-control-and-resumable-frames.md#migration-to-native-control)). + +The executor's contract: + +- Input: a `Control` value, a handler, and the initial handler state `s`. +- Output: `(s, a)` for the closed `run`. Interpreting scoped `handle` changes + from source `Control u a` to target `Control g b`, with an explicit finish context. +- It invokes the matching clause once at each source return/request boundary. + Nested source/target and forwarding transitions use the shared guest loop; + library callbacks return data rather than invoking a synchronous inner executor. +- It preserves the [invariants](#invariants-and-verification): frame identity, capture + boundary, and one-shot status. + +What the compiler and the runtime each own: + +| Concern | Compiler (guest code) | Runtime (`psrs-runtime`) | +| --- | --- | --- | +| Continuation | frame objects and the executor loop | nothing for the software form; `cont` capture/resume for a native form | +| GC roots | frames and live callback locals are Wasm GC roots | the Wasm engine collects them; native-form roots need a separate ABI | +| Leaf operations | ordinary calls to checked bindings | storage, host services, trap | +| Frame layout | defines and verifies it | must not know it | + +## Algorithms + +### The executor loop + +The driver is a single loop over the computation node. Its step procedure is: + +```text +step(state, handler, computation, queue, extent, context): + match computation.tag: + Return(v): + return finish(state, handler, v, queue, extent, context) + Perform(request): + if context is Root: + pair = handler(state, request, + rawContinuation(queue, dispatchExtent(context))) + return step(pair.state, handler, pair.next, Empty, extent, context) + else: # Scoped + target = context.op(request, + rawContinuation(queue, dispatchExtent(context))) + return enterTarget(state, handler, target, context) + Bind(inner, k): + return step(state, handler, inner, Cons(k, queue), extent, context) + Resume(v, saved, e): + check(e) + (replayed, activation) = + cloneSequence(saved, Empty, Empty, extent, dispatchExtent(context)) + return step(state, handler, Return(v), Append(replayed, queue), + activation, context) + Handle(ret, op, body): + (saved, parent, owned) = coalesceLeadingFinish(queue, extent) + return step(state, handler, body, Empty, owned, + Scoped(ret, op, saved, parent, context, owned)) + OwnedResume(owner, v): + transfer(owner): Pending -> Running + callback = loadOwnerCallback(owner) # local GC root + clearOwnerCallback(owner) # before invoking guest code + next = callback(v) + set(owner, Consumed) + return step(state, handler, next, queue, extent, context) + unknown tag: + trap + +finish(state, handler, v, queue, extent, context): + match queue: + Empty: + if context is Root: return (state, v) + else: return enterTarget(state, handler, + context.ret(v), context) + Cons(k, rest): + return step(state, handler, k(v), rest, extent, context) + Append(left, right): + return appendStep(state, handler, v, left, right, extent, context) + Finish(e, rest, parent): + close(e) + return step(state, handler, Return(v), rest, parent, context) + +enterTarget(state, handler, target, context): + finish = Finish(context.ownedExtent, context.callerQueue, context.callerExtent) + return step(state, handler, target, finish, context.ownedExtent, context.callerContext) + +appendStep(state, handler, v, left, right, extent, context): + match left: + Empty: return step(state, handler, Return(v), right, extent, context) + Cons(k, rest): return step(state, handler, k(v), + Append(rest, right), extent, context) + Append(a, b): return step(state, handler, Return(v), + Append(a, Append(b, right)), extent, context) + Finish(e, rest, p): return step(state, handler, Return(v), + Finish(e, Append(rest, right), p), extent, context) +``` + +`coalesceLeadingFinish` exposes a leading `Append` head first: an `Empty` left +continues with the right; otherwise it rebuilds the head with +`Append(left.rest, right)`. When the head is a `Finish`, it reuses that finish's +extent, remaining queue and parent instead of allocating a new extent, so a +tail-returned `Handle` shares one completion with the existing finish. + +Sequence normalization consumes `Bind`, `Return` and `Resume` iteratively. +`Append(saved, consumer)` runs saved work first without mutating either sequence. +Closed `run` supplies its state-fold clause and final result boundary. Scoped +`handle` saves caller work, normalizes source work, removes source dispatch before +calling either clause, and interprets the target answer under enclosing dispatch. +An explicit finish context closes the extent only at target completion. + +The complete transition procedure is in +[scope algorithms](control-elimination-and-handler-scopes.md#algorithms). +Nested context transitions use the shared guest loop. User callbacks' arbitrary +non-tail recursion remains outside the machine guarantee. Invalid tags or contract +mismatches fail explicitly. + +### Replaying a captured sequence + +Replay turns a persistent captured sequence into a fresh activation. It is two +loops, `cloneSequence` and `rebuildSequence`, with the captured sequence as the +shared input: + +```text +cloneSequence(queue, todo, reversed, active, parent): + # `todo` is a LIFO stack of pending Append right-halves. + while todo is Append(left, right): + todo = right; queue = left + if todo is not Empty: trap + match queue: + Empty: + return rebuildSequence(reversed, todo, active, parent) + Cons(k, rest): + return cloneSequence(rest, todo, Cons(k, reversed), active, parent) + Finish(e, rest, _): + check(e) # reject an expired saved extent + return cloneSequence(rest, todo, Finish(e, reversed, parent), active, parent) + Append(left, right): + return cloneSequence(left, Append(right, todo), reversed, active, parent) + +rebuildSequence(reversed, result, active, parent): + match reversed: + Empty: + return (result, active) + Cons(k, rest): + return rebuildSequence(rest, Cons(k, result), active, parent) + Finish(e, rest, _): + fresh = newExtent(parent) # fresh lifecycle activation + return rebuildSequence(rest, Finish(fresh, result, active), fresh, fresh) +``` + +`cloneSequence` flattens and reverses the sequence while checking each saved +extent; `rebuildSequence` walks the reversed sequence from the outside inward, +rebuilding each `Finish` with a fresh child extent. Ordinary callbacks and +one-shot owners are shared, never rebuilt, so replay does not re-run or clone +user mutable data. Only lifecycle activating nodes are instantiated, and the +fresh-parent chain stays finite even when the same sequence is replayed +repeatedly. + +## Code map + +The machine's owners and their required responsibilities are: + +| Owner | Required responsibility | +| --- | --- | +| Checked Core control contracts | Quote each primitive's result, arguments and source/target domains before lowering | +| CC layout planning | Reserve the nominal `Control`/`Resumption` carriers, the machine representations and every generated helper signature before bodies are lowered; keep the table immutable afterwards | +| CC control lowering | Emit the frame node for each primitive, route `run`/`once`/`cancel` to helpers, and synthesize the raw resumption target and the eight helpers from the fixed tables | +| MIR lowering and optimization | Resolve symbolic representations to physical layouts and loopify the executor's self tail calls | +| CC/MIR machine verifiers | Check dispatch, actual exits, transition operands, capture and finish ownership, replay freshness, ordered private-cell updates and publication; prove lifecycle helper bodies and account for observable operations | +| Structured encoding | Emit the loop and its dispatch as ordinary Wasm control flow | + +The intended code organization is a machine-layout module (carrier tables and +helper signatures), a lowering module that constructs nodes and synthesizes +helpers, and paired CC/MIR verification modules for each relation. No module +recognizes a concrete effect, operation or handler, and no helper gets a private +representation path. + +Stage-independent transition relations and ordered execution events have one +shared owner under `control/`. CC and MIR adapters supply representation, +reference-origin, selected-case and execution-order evidence; they must not +independently define the machine's state transitions. Observable-effect summaries +are shared with ordinary optimization, with separate facts for writes, allocation, +possible traps, calls and termination. A no-write summary alone cannot discharge +an unobservable-operation obligation. + +## Invariants and verification + +- Every machine field keeps its planned nominal representation at every layer; + only a declared source payload/storage boundary erases and recovers a source + value, and no layer reconstructs a source type from a machine node. +- A computation dispatch covers exactly the live tags. An unknown tag reaches a + trapping default, and a projection is taken only from the case the dispatch + actually selected. +- A source `Return` applies its current scoped context's return clause and a + source `Perform` applies its operation clause; CC and MIR reject an applied + clause taken from another field, another frame or a boundary. + The scoped branch must use the complete application result as its next + computation, consuming the current answer/request; an operation supplies the + raw resumption over its current queue/checkpoint. State and the root handler + retain their identities. MIR requires the application to dominate that + transition inside the scoped branch. A deleted or dead application and a + discarded result do not discharge this contract. +- An executor transition's result reaches the actual normal exit. CC checks + result forwarding through enclosing structured alternatives; locating a valid + nested dispatch does not establish this property. MIR checks recursive call + results on subsequent normal exits and checks scoped transitions at actual + terminators, rather than stopping at the first call instruction. + Identity-preserving casts, copies and joins with the same normal origin are + accepted. MIR joins and execution dominance are resolved within the current + step's reachable CFG region; the executor loop header starts the next step. +- MIR checks every nominal variant constructor against its planned case, including + ordinary data variants: the physical tag is an immutable `i32` initialized to + that case's tag. Constant copies and equal constants at normal joins retain + this evidence. A common variant base cannot be constructed directly. Structural + MIR without a planned nominal layout has no source case witness to recheck. +- `Bind` enters its own body with its own callback prepended to the current + persistent queue. `Resume` returns its saved answer and appends the replayed + queue to the current queue, installing the activation from that same replay + result. CC and MIR check these operands on the actual executor transition. +- The pending sequence is persistent: replay never mutates a shared node, and the + driver is the only code that traverses a saved sequence. +- Root `Perform` applies the current handler to state, request and the raw + continuation, consumes state/computation from one result pair, and clears the + captured source queue. Terminal root `Return` publishes the current state and + answer. `Cons` consumes its callback, answer and tail once; `Append` preserves + left-to-right order for each selected left case; `Finish` closes its extent + before restoring its parent and remaining work. Required actions need actual + validated exits; a trapping arm cannot replace an entire required action. +- Owned execution orders Pending guard, Running write, callback load, slot clear, + one application, Consumed write and executor transition. Cancellation orders + Pending guard, Cancelled write and slot clear. Start/Once publish fresh private + cells with their required current contents; constructor contents are not a + proof of contents after intervening writes. +- `Check` and `Close` have body contracts as well as callee identities. `Check` + tests the current extent's live status and every ancestor, rejecting closed + extents. `Close` sets that extent's status to closed and returns the same extent. + A call to the correct symbol does not prove these behaviors. Verifiers must + check retained bodies and preserve the proof across inlining. +- Every executed write, call and explicit trap must be justified by its machine + step, including operations before dispatch and paths ending in a trap. Required + frame allocation is distinguished from unrelated mutation. Read-only static + calls may trap or diverge, so permitting them requires an explicit step role or + stronger evidence. Normal-exit traces alone do not prove exceptional behavior. +- Replay rebuilds only lifecycle activating nodes; ordinary callbacks and + one-shot owners are shared, never cloned, and each rebuilt finish gets a fresh + child extent whose parent chain stays finite. +- The flat driver loops over every step, so execution is stack-safe independently + of the native stack; emitted tail positions use `return_call*`. +- Closure conversion, adapters and optimizations preserve evaluation behavior + under ordinary IR contracts; they do not verify a private protocol. + +Evidence must cover frame identity, capture boundaries, replay activation +freshness, one-shot status and stack safety separately from library-level +interpretation. The [acceptance checklist](../../../implementation/backend/algebraic-effects.md) +records coverage. CC and MIR check retained Check/Close bodies, ordered owned +transfer, root/queue operands, and current private contents at publication. +Execution events distinguish allocation, mutation, reference refinement, calls +and explicit traps. A failed guard terminates before any subsequent observable +operation; preceding events must match a prefix of a validated normal path. +Entry initialization is part of the proof, before the first dispatch. Copies and +normal joins preserve operand identity without suppressing executed events. Prefix +comparison resolves observed inputs through each path's aliases but retains the +instruction result IDs that identify the operation and its checked definition. + +Static calls admitted as unobservable need a total-function summary: no fallible +instructions, writes, dynamic calls, reachable CFG cycles or recursive call +cycles. The summaries use a least fixed point; no-write recursive SCCs are not +assumed terminating. Narrowing casts need static subtyping, selected immutable +case evidence (or the sole case of a nominal variant), or an actual checked +callback/result role. These checks trust ordinary SSA/layout verification and +checked source callback typing; they do not reconstruct source types from payloads. + +Ordinary inlining preserves the physical Start/Once frame and the source witness. +MIR replays current private-cell contents from allocation to that witness (Run +checks its root status before executor entry). Mutually exclusive Run alternatives +can allocate both candidate contexts; those ordinary caller allocations are not +part of the private-status proof. Helper-body allocation accounting still requires +all allocations to feed the actual result/transition. A compiler transform that +inlines Check/Close must preserve their lifecycle-body evidence; today's ordinary +inliner retains these branching helpers and verifies every intermediate module. + +The [2026-10-14 review](../../../implementation/backend/delimited-control-architecture-review-2026-10-14.md) +records the historical defects and their repairs. Caught-host-trap cleanup, +foreign borrowed-resource capture and complete AE/AC acceptance remain open. + +## Worked example + +Interpreting `run` over `bind (return 1) k` where `k x = return (x + 1)`: + +1. `run` builds an empty pending sequence, a root extent and a `Root` context, and + calls the executor on `(state, handler, Bind(Return(1), k), Empty, root, Root)`. +2. The executor sees `Bind` and continues with + `(state, handler, Return(1), Cons(k, Empty), root, Root)`. +3. The executor sees `Return` and descends the queue with `1`: `Cons` applies `k` + to `1`, producing `Return(2)`, with the queue's tail `Empty`. +4. The executor sees `Return` and descends `Empty` under a `Root` context, so it + returns `(state, 2)`. `run` closes its root and recovers the source answer `2`. + +A `Perform` instead reaches the executor's case 1, hands the request and a raw +continuation over the current sequence to the `Root` clause, and continues with the +clause's next computation; a `Scoped` context routes to its operation clause and +enters the target under the caller's context. + +## Boundaries and interfaces + +- **Core** supplies the checked `Control`/`Resumption` carriers and the + per-occurrence contract the machine planning consumes. +- **CC** owns the symbolic machine representations, the generated helper + identities and the frame-construction rules; its verifier checks the local + construction and projection shapes. +- **MIR** owns the physical layouts, the loop and the machine relations rechecked + after lowering and optimization. +- **Wasm** owns only the structured encoding of the loop and its dispatch. +- **Library** owns operation meaning, deep/shallow policy and source/target + conversion; it sees only the checked surface and the callbacks it supplies. +- **Wasm engine** manages the frame GC heap and guest roots. +- **Guest runtime and host bindings** supply checked leaves, allocation and + services; they provide no continuation and must not learn the frame layout. + The compiler-owned linker assembles the guest runtime with the program. + +## Open questions and future work + +- Audit full machine acceptance beyond the repaired lifecycle and observable-step + checks, including all required reference-library and cost evidence. Focused + verification does not establish complete AE/AC acceptance. +- Caught-host-trap cleanup and foreign borrowed-buffer/resource capture, which the + software machine does not yet prove. +- A native stack-switching accelerator, which would replace the frame chain and + driver behind the same surface under a separate decision and ABI. + +## References + +- [Delimited control and resumable frames](delimited-control-and-resumable-frames.md) +- [Control elimination and handler scopes](control-elimination-and-handler-scopes.md) +- [DEC-19 — Compiler-generated resumable frames](../../../decision/DEC-19-compiler-generated-resumable-frames.md) +- [CC IR](cc-ir.md), [MIR](mir.md), [data representation](data-representation.md) +- [Structured Wasm encoding](../wasm/encoding-and-structuring.md) +- [Acceptance checklist](../../../implementation/backend/algebraic-effects.md) diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 2e165d9f..62b778de 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -23,11 +23,13 @@ acceptance checklist; full verifier and foreign-boundary obligations remain open ## Scope -This document owns the generic control surface, its identity, the selective -CPS/defunctionalization lowering, the frame representation and trampoline (the -executor), the executor's boundary with the runtime, deep/shallow encoding, one-shot -status, continuation lifetime and GC roots, foreign-call capture boundaries, and the -comparison with native stack switching. +This document owns the generic control surface, its identity, the design-space +selection of a defunctionalized-frame lowering, the handler interface, the +deep/shallow and one-shot API distinctions, continuation lifetime and GC roots, +foreign-call capture boundaries, the comparison with native stack switching, and +the migration path. The concrete machine that selection produces — its node +inventory, per-layer representation, lowering and flat driver — is specified in +[the control machine](control-machine.md). It does not own operation signatures, handlers, or rows — those are the [library-owned effects](algebraic-effects-and-handlers.md) this mechanism runs — nor @@ -253,9 +255,13 @@ callback between the check and update. This is atomic with respect to re-entranc under the pinned single-threaded guest profile; it is not a cross-thread atomic protocol. Enabling shared guest execution requires a separate ownership design. -The callback is stored in a private mutable reference slot and removed on -consumption or cancellation. A retained spent owner does not retain that -callback's captures. The executor's local reference roots a running callback. +The callback is stored in a private mutable reference slot. After acquiring the +owner, the executor loads the callback into a local GC root and clears the owner +slot before invoking it; normal return then marks the owner Consumed. +Cancellation also clears the slot. A retained running or spent owner therefore +does not retain that callback through its slot. The executor's local reference +roots a running callback. If invocation traps, the cleared owner remains Running; +caught-trap recovery needs the separate cleanup contract and is not implemented. Existing unrestricted PureScript arrows remain multi-shot, and no optimization may silently replace them with an owner. @@ -379,6 +385,10 @@ this case. The selected `handle` uses typed source and target contexts; `run` retains the closed state-fold convenience. Concrete state and open-union policy belong in the library, not compiler selectors. +The concrete machine this selection produces — its node inventory, per-layer +representation, lowering and flat driver — is specified in +[the control machine](control-machine.md). + #### Selective conversion Selectivity applies to checked control operations and their continuation/context @@ -395,27 +405,6 @@ preserve strict argument evaluation, inert construction and observable execution separately. They may remove unused inert data, but may not erase, reorder or duplicate interpretation callbacks as though they were pure constructions. -#### Frame construction - -The machine uses inert `Return`, `Perform`, `Bind`, raw `Resume`, -`Handle(returnClause, operationClause, body)` and `OwnedResume` nodes. Pending -continuations use immutable `Empty`, `Cons` and `Append` sequences. Raw resume -checks checkpoint liveness, runs the saved sequence before its consumer queue, -and does not automatically reinstall source dispatch. Capture excludes caller -work. Abandonment clears the source queue from the driver; only explicit resume -may run it. Persistent queues support replay without cloning user mutable data. - -Explicit heap contexts distinguish source normalization from target execution. -A clause's target answer runs under enclosing dispatch with an extent-finish -marker. The [scope contract](control-elimination-and-handler-scopes.md#machine-phases-and-scope) -specifies context identities, capture provenance and finish boundaries. - -CC layout predeclares computation/context layouts and all executor/callback -SignatureIds. Lowering synthesizes bodies using these declarations and cannot -mutate the representation table. Checked source/target contract identities remain -available for verification after payload erasure. The previous open-union -`Handle`/`Reenter` executor is v1 implementation evidence, not this normative shape. - #### Open elimination and residual forwarding The compiler receives opaque source requests and invokes the supplied operation @@ -429,32 +418,6 @@ must preserve nested source checkpoint provenance and instantiate lifecycle frames per replay, as required by the scope contract. Shared guest context transitions avoid native recursion per handler or forwarded request. -#### The trampoline - -A **trampoline** is the loop that runs the machine: - -```text -run(state): - loop: - step = state.current - match step: - Return(v) -> return v - Eval(frame) -> state.current = frame.step(state) - Suspend(payload, k) -> state = call_handler(payload, k) - Resume(k, v) -> state.current = k.install(v) -``` - -This is a schematic driver, not the exact constructor inventory. The implemented -CC machine uses `Return`, `Perform`, `Bind`, `Handle`, `Resume` and `OwnedResume`, -with explicit queues and source/target contexts. - -Because the loop drives control steps, the native Wasm stack does not grow with -the depth of interpreted binds or with long machine request sequences. Ordinary -recursive user callbacks are not converted into frames by this monadic lowering; -their stack behavior follows ordinary call and tail-call lowering. Using -`return_call`/`return_call_ref` for the tail positions of the emitted steps keeps -the constant-stack property even where the machine calls into ordinary code. - #### Deep and shallow handlers Deep library code reinstalls `handle` around the raw source remainder; shallow @@ -529,49 +492,6 @@ native host frames. This does not discharge captured-resource lifetime checks or caught-host-trap cleanup. Those remain required acceptance obligations; no complete foreign-boundary verifier or recovery protocol is claimed here. -### The executor and the runtime boundary - -The eliminator's driver — the trampoline of [The trampoline](#the-trampoline) — is the -**executor**: the component that interprets `Control` data through typed contexts -and dispatch clauses; closed `run` also threads explicit handler state. Where it lives is a design decision with a strict boundary. - -- **The executor is guest code.** It is a compiler-generated loop over the frame - representation, or a library function over a compiler-provided frame view. It runs - in the compiled program because it must call the guest handler and guest - continuations; a host function cannot call back into arbitrary guest closures - without an explicit boundary. -- **The host runtime does not interpret frames.** `psrs-runtime` provides the GC heap - (where frames live), the leaf primitives a request may call (storage, host services, - trap), and linking. It does not inspect the frame layout, index frames, or own a - continuation. Nothing about the software representation crosses the host boundary. -- **The runtime may provide a generic driver loop.** A runtime that loops calling a - guest "step" function is admissible, as long as it treats the step as opaque guest - code and learns nothing about the frame layout. This is optional; a guest-side loop - is the baseline. -- **Under a native continuation the executor disappears.** With stack switching the - runtime captures and resumes the stack itself, so there is no software driver to - place ([Migration to native control](#migration-to-native-control)). - -The executor's contract: - -- Input: a `Control` value, a handler, and the initial handler state `s`. -- Output: `(s, a)` for the closed `run`. Interpreting scoped `handle` changes - from source `Control u a` to target `Control g b`, with an explicit finish context. -- It invokes the matching clause once at each source return/request boundary. - Nested source/target and forwarding transitions use the shared guest loop; - library callbacks return data rather than invoking a synchronous inner executor. -- It preserves the [invariants](#invariants-and-verification): frame identity, capture - boundary, and one-shot status. - -What the compiler and the runtime each own: - -| Concern | Compiler (guest code) | Runtime (`psrs-runtime`) | -| --- | --- | --- | -| Continuation | frame objects and the executor loop | nothing for the software form; `cont` capture/resume for a native form | -| GC roots | frames are GC objects, scanned by the GC | stack scanning only under a native form | -| Leaf operations | ordinary calls to checked bindings | storage, host services, trap | -| Frame layout | defines and verifies it | must not know it | - ### Compiler CPS versus native stack switching DEC-19 selects compiler-generated frames. The alternative, WebAssembly stack @@ -662,20 +582,8 @@ continuation to its operation clause. No callback runs during construction. The source clause returns target data; saved work executes only if it uses the raw continuation. Calling that continuation constructs a checked `Resume` node. -### The executor loop - -Sequence normalization consumes `Bind`, `Return` and `Resume` iteratively. -`Append(saved, consumer)` runs saved work first without mutating either sequence. -Closed `run` supplies its state-fold clause and final result boundary. Scoped -`handle` saves caller work, normalizes source work, removes source dispatch before -calling either clause, and interprets the target answer under enclosing dispatch. -An explicit finish context closes the extent only at target completion. - -The complete transition procedure is in -[scope algorithms](control-elimination-and-handler-scopes.md#algorithms). -Nested context transitions use the shared guest loop. User callbacks' arbitrary -non-tail recursion remains outside the machine guarantee. Invalid tags or contract -mismatches fail explicitly. +The executor transition procedure and sequence replay are specified in +[the control machine](control-machine.md#algorithms). ### Deep-handler reinstatement @@ -706,21 +614,12 @@ obligation is implemented. | Location | Intended responsibility | | --- | --- | | `Prim.Control` owner | The abstract `Control f a` carrier and the `return`/`bind`/`perform`/`run`/`handle` primitives, with their checked schemes | -| CC control lowering and MIR | Persistent sequencing and typed contexts below Typed Core; preserve library reinstatement, lifecycle provenance and one-shot status | -| Executor (guest code) | The guest loop over typed source/target contexts, persistent queues and lifetime activations; closed run also threads fold state | -| MIR verifier | Frame identity, capture boundary, continuation result-type, and suspension-observability checks | | Existing Core/CC/MIR lowering and optimizers | Compile the converted frames and the executor as ordinary higher-order code; preserve generic observable-call semantics | -| `psrs-runtime` (software form) | GC heap, leaf primitives, trap, and linking; provides no continuation and must not learn the frame layout | +| `psrs-runtime` (software form) | Checked guest leaves and linear-memory allocation; provides no continuation and must not learn the frame layout; frame GC belongs to the Wasm engine and linking to the compiler | | Runtime control owner, only if separately adopted | Stack-switching ABI, captured-root storage, lifecycle checks, and capability requirements | -The implementation locations are `psrs-hir/src/intrinsic/registry.rs`, checked -Core control contracts, `psrs-backend/src/cc/layout/control/`, -`cc/lower/control/`, `cc/verify/control/` and `mir/control/`. Layout planning -reserves nominal Control/Resumption carriers and all synthesized signatures -before CC lowering freezes the representation table. Ordinary carrier parameters, -results, captures and joins use these nominal representations; only explicit -abstract user-payload/storage boundaries erase and recover values. The executor -does not reconstruct a complete source type from erased data. +The machine's implementation locations and responsibilities are in +[the control machine](control-machine.md#code-map). The eight source primitives retain their identities, with `handle` identity 96 and arity three under contract v2. The independent package/compiler contract is @@ -760,8 +659,6 @@ explicitly adopted. - Reachable captured frames keep their values rooted; expiry follows the target extent and multi-shot resume does not consume the checkpoint; a continuation is never retained across a non-suspendable foreign boundary. -- The trampoline drives every step, so execution is stack-safe independently of the - native stack; emitted tail positions use `return_call*`. - Closure conversion, adapters, and optimizations preserve evaluation behavior under ordinary IR contracts; they do not verify a private protocol. @@ -775,7 +672,8 @@ the requirements. The [library-owned effects document](algebraic-effects-and-handlers.md#worked-example) defines the program `runPure (handleState 0 program)`. Under this mechanism it is a -small frame chain. Tracing the trampoline: +small frame chain; [the control machine](control-machine.md#worked-example) traces +the individual driver steps. ```text run(handleState 0 program) @@ -786,8 +684,8 @@ run(handleState 0 program) Each `put` and `get` performs an operation, builds a frame from the current point to the `handleState` delimiter, delivers it to the handler, and resumes through the -trampoline. Depth of `do` binding does not grow the native stack. The library-level -meaning of this program is in the +machine's flat driver. Depth of `do` binding does not grow the native stack. The +library-level meaning of this program is in the [library-owned effects document](algebraic-effects-and-handlers.md#worked-example). ## Boundaries and interfaces @@ -797,9 +695,10 @@ the compiler adds no ambient effect inference. It is the only compiler-owned par the effects story; operations, rows, handlers, and the one-shot/multi-shot API are library code ([library-owned effects](algebraic-effects-and-handlers.md#ownership)). -For the software form the runtime carries no continuation: the executor is guest code -and `psrs-runtime` provides only the GC heap, leaf primitives, and trap -([The executor and the runtime boundary](#the-executor-and-the-runtime-boundary)). +For the software form the executor is guest code and frames live in the Wasm +engine's GC heap. `psrs-runtime` supplies guest leaves and linear-memory +allocation; host services use explicit bindings and linking belongs to the compiler +([the control machine](control-machine.md#the-executor-and-the-runtime-boundary)). The baseline target profile does not gain stack switching through this design. A native resumption option requires a pinned target capability, an MIR/lowering diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index e124a658..fb1c0344 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -9,6 +9,8 @@ selects compiler-generated resumable frames as the generic handler/interruption mechanism. **Date:** 2026-10-11. +**Current continuation:** [Architecture review repairs, 2026-10-14](#architecture-review-repairs--2026-10-14). + This checklist records the complete evidence required for implementation. Creating it does not resume the withdrawn State migration or select native Effect/ST representation. Compiler cleanup and runtime build-tool changes are separate @@ -1496,3 +1498,214 @@ Formatting and local diff checks pass. Full workspace tests, workspace clippy and complete scoreboards were intentionally not rerun under the user's focused validation scope. Complete AE/AC statuses remain Unverified; no gate measurement is changed. + +## Execution-step provenance (2026-10-13) + +Starting point: compiler `6df8bfba`, with the dispatch/clause-selection draft +already present and uncommitted. This continuation extends that draft in the +current checkout. The independent package and compiler lock stay at `d6cf811` +and `fnv1a64-v1:6eb134fa699297f4`. + +The scoped clause check previously quantified only over calls it found. Removing +the entire call, or preserving the call while discarding its result, did not +establish execution-step provenance. CC now follows each current-context scoped +branch's actual result into the executor transition and back through the complete +unary curry application. MIR follows real CFG exits and checks that each call +dominates its consumer inside that scoped branch. The payload must be field zero +of the current Return/Perform input. An operation's second argument is the +predeclared raw resumption; the existing checkpoint verifier checks that factory's +current queue and checkpoint captures. State and the root handler retain their +identities. Ordinary CC availability and MIR SSA checks remain the owners of +general definition/use validity. + +Bind/Resume transitions have corresponding shared operand relations. Bind must +enter its own body, prepend its own callback and retain the current queue and +execution extent. Resume must return its own saved answer, append the replayed +queue before current pending work, and install the activation projected from that +same checked CloneSequence result. Both preserve state, root handler and dispatch +context. No representation, runtime instruction or library algorithm changes. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Required scoped application result | Paired `scoped_steps_require_the_clause_application_result`: Return/Perform, omitted call and discarded result | Focused Verified | +| Current source answer/request | Paired `scoped_steps_consume_the_current_source_payload`: same-shaped state replaces the payload | Focused Verified | +| Operation supplies raw continuation | Paired `operation_step_supplies_the_raw_resumption`: erased state replaces the continuation | Focused Verified | +| Call executes on the scoped CFG path | `mir_scoped_step_cannot_use_a_clause_call_from_a_dead_block`: Return/Perform calls moved to unreachable blocks | Focused Verified | +| Preserve interpreter environment | Paired `scoped_steps_preserve_state_and_root_handler`: Return/Perform environment replacements | Focused Verified | +| Bind body/callback/queue identity | Paired `bind_requires_its_body_callback_and_queue`: three same-shaped replacements per IR | Focused Verified | +| Resume answer/activation/queue identity | Paired `resume_requires_its_answer_replayed_extent_and_pending_queue`: four replacements per IR | Focused Verified | + +These 13 driver tests exercise 38 malformed-IR mutations. They accompany the +existing source-to-target and reference-identity positives. This does not close +all machine-step obligations: root handler application, queue callback consumption +and complete normalization, owned execution/status updates and arbitrary extra +observable work still need their complete proofs. + +The independent Node source inventory was rerun: 50 pinned packages / 305 +modules, decomposed into 245 identical, 34 modified and 26 target additions; no +upstream modules are absent and no direct same-argument recursion is detected. +This refresh does not approve the existing 34 adaptations. The library's +`control-types.mjs` comparison passes all 17 positive/negative cases with official +`purs`, explicitly using a type-only opaque control shim rather than a runtime +implementation. Pinned upstream JS executes RunState, RunChoose and RunHandlers +from 279 unchanged upstream source modules; each fixture's full value/order check +returns 42. Evidence: `/private/tmp/psrs-control-completion/{audit,types,reference-js}/`. + +Foreign-boundary audit: canonical `own`/`borrow` descriptors live in the WIT/ABI +owner (`abi/handles.rs`); physical handles lower to integers. The existing +`mir/wit/handles.rs` checker handles explicit local drops/transfers, but does not +publish resource lifetime evidence to guest closure/frame captures. Rejecting +borrowed import results alone does not establish safe captured owned resources, +alias validity or explicit unsupported-capture rejection. A shared capture +contract must retain this evidence before ABI erasure. Caught host traps also +have no completed instance cleanup/reentry protocol: the generated lifetime +helpers handle normal guest completion, not host recovery. Both AC-04 and the +recovery acceptance obligation remain Unverified. Neither an integer heuristic +nor silently discarding an instance supplies the missing contract. + +Complete AE/AC statuses remain Unverified. General allocation/cost obligations, +complete pinned API/differential acceptance and the final D-04 gate remeasurement +remain required; native Effect/ST still follows that acceptance. + +### Validation of this continuation + +| Command / scope | Observed result | +| --- | --- | +| Final `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 157 passed, no skips; includes all 13 new tests and existing value-sensitive control/cost execution | +| Eleven mandatory control integration targets | 81 passed; the integrated run also executes them after the Bind/Resume slice | +| Final locked-content public package batch | 14 accepted, including double-resume/cancel traps and the three Run fixtures | +| Final `control-types.mjs` against official `purs` | 17 accepted comparisons, type-only control shim; no runtime placeholder | +| Pinned upstream JS versus Wasmtime RunState/RunChoose/RunHandlers | All three execute their checks and return 42 on both targets | +| `PSRS_REQUIRE_WASMTIME=1 cargo test --workspace --no-fail-fast` | Four baseline failing test targets with the same 71 failed names as `workspace-after-variant.log`; no names added or recovered. Driver library: 780 passed / 68 failed at the integrated snapshot, before the final two environment-identity tests/guards | +| Backend/driver doctests | The integrated run also reported missing dependency artifacts in two doctest targets during concurrent recompilation; a subsequent standalone `cargo test -p psrs-backend -p psrs-driver --doc` passes | +| `cargo clippy --workspace --all-targets` | Completed; only the existing `psrs-kind` `let_and_return` warning | +| `cargo clippy --workspace --all-targets -- -D warnings` | Fails on that existing warning; not a clean strict result | +| Formatting and local diff checks | Passed | + +The full workspace run tests the integrated Bind/Resume and required scoped +application slice. The final state/root-handler guards and two matching tests +were subsequently validated by the final 157-test control run and rebuilt-CLI +public/type conformance batches. The entire workspace was not rerun after those +last guards. Failure-name equivalence does not classify every baseline cause or +make the checkout green. Ignored scoreboards and the full upstream differential +target were not rerun, and no measured D-04 gate number or completion status was +changed. + +Public Run compilation initially timed out at 180 seconds while broad tests ran; +those failed attempts remain under `public/`. The rebuilt-CLI batch under +`public-final/` uses 600 seconds per invocation and requires actual Wasmtime. +Compilation completes in 113.282 / 146.639 / 188.610 seconds respectively for +RunState / RunChoose / RunHandlers; each execution exits 42. This observation +does not establish a general compilation-time bound or a root cause for the +timeouts. Reports retain compiler, package, input and artifact identities. + +Final evidence: `/private/tmp/psrs-control-completion/{checkout.json,audit,types-final,public-final,reference-js,reference-differential.json}`; +workspace/focused/clippy logs and the failure-name comparison use the +`/private/tmp/psrs-control-completion-` prefix. + + +## Review repairs — 2026-10-13 + +Review exposed two accepted malformed-IR cases and one rejected equivalent form: +CC could discard an outer Return dispatch result, MIR could construct a nominal +Cons with the Empty tag, and an equivalent result join failed clause provenance. +The repairs retain the existing machine model and use shared result identity, +CFG region analysis and planned nominal layout evidence. + +| Requirement | Current evidence | Status | +| --- | --- | --- | +| Actual CC transition results reach normal exits | `cc_cannot_discard_outer_return_result` replaces the result of each of the six computation alternatives; all are rejected, including by `compile_cc` | Focused Verified | +| Actual MIR return consumes the recursive transition result | `mir_executor_call_must_return_its_actual_result` accepts the returned call and rejects the same call followed by a return of state | Focused Verified | +| Equivalent result joins preserve provenance | `cc_equivalent_scoped_result_join` and `cc_equivalent_switch_result_join` pass CC, MIR and artifact construction; the If fixture actually executes with Wasmtime and returns 43 | Focused Verified | +| Every normal join alternative must forward the result | `cc_result_join_cannot_hide_a_discarded_alternative` rejects a join with a substituted state alternative | Focused Verified | +| Planned nominal constructor tags agree with their physical case | `mir_wrong_machine_constructor_tag` rejects Cons with Empty's tag; four backend tests cover ordinary variants, direct/copy tags, equal and unequal constant joins, direct base construction and mutable tags | Focused Verified | + +CC checks returned expression alternatives, rather than arbitrary operands or +mere presence of dispatches. MIR clause checks inspect actual terminators; normal +join inputs and execution dominance are resolved within the current step, ending +at the next executor loop header. Nominal tag checking belongs to the general +MIR verifier and applies to every reachable planned variant representation, +including ordinary data types. Standalone structural MIR without a planned +nominal layout has no source case witness to validate. + +| Validation | Observed result | +| --- | --- | +| `cargo test -p psrs-backend --lib` | 444 passed | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control -- --nocapture` | 163 passed, no skips | +| Eleven control integration targets, with `PSRS_REQUIRE_WASMTIME=1` | 81 passed, no skips | +| `cargo clippy -p psrs-backend -p psrs-driver --all-targets` | Completed; only the existing `psrs-kind/src/check/synonyms.rs:174` warning | +| The same Clippy scope with `-- -D warnings` | Blocked by that existing `let_and_return` warning | +| `cargo fmt --all --check` and `git diff --check` | Passed | + +Evidence: `/private/tmp/psrs-control-review/fix-{backend-final,control-final,integration,clippy,clippy-strict}.log`. +The previous full-workspace run is historical. This focused repair did not rerun +workspace tests, workspace Clippy, scoreboards, the full upstream differential +or the public package conformance batch. D-04 measurements and completion +statuses were not changed. Complete root/queue/owned execution semantics, +additional observable work, foreign capture and caught-host-trap recovery remain +open; closing these review findings does not establish complete AE/AC acceptance. + +## Root/queue and owned verification review — 2026-10-14 + +The current uncommitted implementation adds shared root/queue transition +relations (`control/execution/`), ordered private-owner relations +(`control/owned.rs`) and paired CC/MIR adapters. This supersedes the earlier +statement that all root/queue/owned execution checks were still missing. + +| Obligation | Current implementation / evidence | Coverage | +| --- | --- | --- | +| Root handler state/request/raw arguments, one result pair, source queue abandonment and terminal state/answer | Paired `root_and_queue_steps_reject_same_shaped_substitutions`; `root_state_and_pending_callbacks_execute_in_order` executes with required Wasmtime, exit 43 | Focused Verified | +| Cons operands, all Append-left normalization actions and Finish restoration | The same paired mutation tests cover 27 mutations each, including removed root/Cons actions and extra calls | Focused Verified | +| Pending/Running/load/clear/application/Consumed/transition order | Paired `owned_execution_requires_the_complete_transfer`, 15 mutations each; paired Pending equality positives | Focused Verified | +| Start/Once current private contents and cancellation order | CC publication/cancellation negatives pass; two intended MIR tests panic before mutation because optimized helper functions are absent | Partial; MIR rejection evidence incomplete | +| Check/Close lifecycle body semantics | Replacing either body with identity is accepted by CC and MIR | Unverified; review R1 | +| Absence of additional observable operations | Extra calls/array stores are checked on normal paths; extra MIR Store and TrapIf are accepted, and read-only calls do not prove total behavior | Unverified; review R2 | + +The [architecture review](delimited-control-architecture-review-2026-10-14.md) +records exact owners, reproductions and required repairs. The mechanism design +now states lifecycle-body and complete effect-accounting obligations explicitly; +these are not claims of implemented coverage. Foreign resource capture, +caught-host-trap cleanup/reentry and complete reference API acceptance remain +open. All complete AE/AC statuses above remain Unverified. + +Fresh evidence: backend library **444 passed**; control driver library **173 +passed, 2 failed**; all eleven control integration targets **81 passed**, with +Wasmtime required and no skips. Two temporary probes reproduce accepted malformed +IR and were removed from the checkout. Logs/source: +`/private/tmp/psrs-control-architecture-review-2026-10-14/`. +Workspace tests/Clippy, scoreboards, the full upstream differential and package +conformance were not rerun; prior results remain historical. This review changes +documentation only and does not alter D-04 measurements or completion statuses. + + +## Architecture review repairs — 2026-10-14 + +R1–R3 from the [review](delimited-control-architecture-review-2026-10-14.md) +are repaired in the dirty checkout. The earlier review table and its 173/2 +measurement are historical, not the current outcome. Complete AE/AC statuses +remain Unverified; these rows record focused verification only. + +| Obligation | Permanent evidence | Coverage | +| --- | --- | --- | +| Check/Close bodies implement their own status and ancestry rules | `control_lifecycle_bodies` CC/MIR identity, status, guard, close-write and ancestry mutations; existing mandatory lifetime/replay runtime tests | Focused Verified | +| Account for explicit operations across full Executor paths | `control_queue_steps::mir::effects` writes/TrapIf at normal return, default, preheader and Start; unused cast; failed Pending guard cannot write Running before trap | Focused Verified | +| Extra CC calls and payload recovery cannot hide before dispatch or publication | `control_observable_paths` prefix/default/publication checks, unused recovery and no-write recursive call | Focused Verified | +| Preserve equivalent ordinary joins | `control_result_provenance::cc_equivalent_switch_result_join` plus existing If and MIR join positives | Focused Verified | +| Retained factory publication/cancellation negatives reach their assertions | Both former MIR fixture failures use `mir::lower_module` before generic inlining; corresponding CC cases remain | Focused Verified | +| Recheck current physical private contents after inlining | `control_inlined_publication`: Start/Once status 0 writes pass, status 2 writes fail; existing exclusive-root/copy positives | Focused Verified | +| Ancestry/cost observations do not weaken the machine verifier | Post-pipeline Wasm instrumentation, component validation, depth-sensitive negative and 1,000/10,000/100,000 request/GC observations | Focused Verified | + +The ordered event owner is `control/events.rs`; CC/MIR adapters retain actual +casts, selected/rejected guards, effects and exits. The shared lifecycle relation +owns Check/Close behavior, and source witnesses identify inlined Start/Once +publication windows. Total-function summaries replace no-write exemptions and +exclude recursive call SCCs, fallible operations and MIR CFG cycles. Checked +source callback typing and ordinary SSA/layout legality remain explicit trust +boundaries. Complete Clone/Rebuild/context step equivalence, foreign capture, +caught-host-trap recovery and full reference-library acceptance remain open. + +Current focused evidence: **185 control driver tests passed**, all with required +Wasmtime, and **81 control integration tests passed**, with no skips. Backend +library tests pass **444**. The final workspace and lint results, their historical +failure comparison and exact logs are recorded in the current handoff. +Evidence root: `/private/tmp/psrs-control-repairs-2026-10-14/`. diff --git a/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md b/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md new file mode 100644 index 00000000..1d0b38cc --- /dev/null +++ b/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md @@ -0,0 +1,264 @@ +# Delimited Control Architecture Review — 2026-10-14 + +**Status:** R1–R3 repaired in the local checkpoint commit containing this review; +complete AE/AC acceptance remains open. +The findings and review measurements below describe the pre-repair snapshot. +See [the repair evidence](#repair-evidence-2026-10-14) for current implementation and validation. +**Design:** [Control machine](../../design/backend/fp/control-machine.md), +[delimited control](../../design/backend/fp/delimited-control-and-resumable-frames.md) +and [handler scopes](../../design/backend/fp/control-elimination-and-handler-scopes.md). +**Reviewed checkout:** `feat/effect-handlers`, compiler HEAD +`6df8bfba59f74659883f8572ac8a88c821a6574e`, with pre-existing uncommitted +implementation and documentation changes. Locked stdlib `d6cf811` was clean. +**Continuation:** [Current handoff](delimited-control-migration-handoff-2026-10-12.md). + +## Architectural assessment + +The software continuation architecture remains coherent: checked Core owns +source/target types; immutable CC planning owns nominal machine carriers and +helper signatures; lowering constructs persistent nodes and a guest driver; +MIR fixes physical layouts and loopifies self transitions. Concrete effects, +operation meanings and deep/shallow policies remain library-owned. The review +found incomplete verification boundaries rather than a reason to replace this +architecture. + +The current dirty implementation has advanced beyond the previous progress +description. Shared `control/execution/` relations check root handler application, +terminal publication, Cons consumption, Append reassociation and Finish +restoration. Shared `control/owned.rs` checks ordered one-shot transfer, +cancellation and private-cell contents at publication. CC/MIR adapters supply +reference identities and path events. These are substantial local checks, but +they do not establish complete machine semantics. + +## R1 — P1: helper identity is accepted as a lifecycle-body proof + +**Owners:** `cc/lower/control/lifetime.rs`, +`cc/verify/control/{mod,checkpoints,finish_consumption,root}.rs`, and the paired +MIR control verifiers. Helper callee contracts bind a role to a symbol/signature; +no corresponding Check/Close body relation proves their lifecycle behavior. + +**Reproduction:** Lower `control_checkpoints::SOURCE` to CC. For each of Check +and Close independently, clear the helper's assignments and set its result to +its sole extent parameter. `cc::verify_module` returns `Ok(())`. Lower the same +module with `mir::lower_module`; `mir::verify_module` also returns `Ok(())`. +The temporary test is `review_probe_lifetime_helper_bodies`. + +**Implication:** A correctly bound call can now perform no liveness check or no +close write. The caller-side proofs still see the expected callee identity and +operand. This is a verifier hole; production lowering currently emits the +intended behavior, and this review does not claim a source-level runtime failure. +AC-03 cannot be closed from callee identity and current positive runtime tests. + +**Required repair:** Give Check and Close shared body contracts. Check validates +its own status and every ancestor and rejects closed extents; Close writes closed +to its own status and returns the same extent. Prove the retained body and the +discharged inlined form. Keep function identity, operand provenance and body +semantics as separate evidence. Add negatives for missing/wrong status checks, +skipped ancestry, missing/wrong close stores and wrong returned extent. + +## R2 — P1: operation traces do not account for all observable behavior + +**Owners:** `mir/control/traces.rs:109`, +`control/execution/observables.rs:111`, `control/owned.rs::publication`, +`cc/verify/control/execution_effects.rs`, and CC/MIR read-only summaries. + +**Reproduction:** Compile the same source to optimized MIR. Select executor path +`[Return=0, Empty=0, Root=0]`. Before its normal return, append either: + +- an `i32` constant 1 and `Store(address=1, value=1, memory=0, offset=0)`; +- a Boolean constant true and `TrapIf(true)`. + +Both variants pass the complete `mir::verify_module` call. The temporary test is +`review_probe_unaccounted_effects`. This establishes accepted extra mutation and +explicit trap instructions; mutated Wasm was not executed in this review. + +**Cause:** The MIR trace adapter turns non-array writes into `OtherEffect`, +which the shared root/queue relation ignores. It emits no event for a trap-only +instruction. Allocation and mutation share the same event even though normal +machine steps legitimately allocate frames. Publication also ignores effects +outside tracked private-cell writes. Therefore rejecting additional applications +or ArraySet operations does not prove absence of additional observable work. + +Two adjacent boundaries need the same repair, even though the probes above do +not exercise them: + +- `read_only_functions` excludes writes/dynamic calls but permits trapping reads, + explicit traps and static recursion. The shared relation permits arbitrary + direct calls in that set. No-write is not evidence of totality or termination. +- MIR `branch_facts::exits` and CC `owned::traces` omit paths ending in a trap; + CC executor effect accounting begins inside computation alternatives. Effects + before dispatch and effects preceding an exceptional exit need coverage too. + +**Required repair:** Use an owner-neutral execution-event contract shared by the +machine relations. Distinguish required allocation, mutation, reads, calls and +explicit traps; justify fallible casts/projections using their checked shapes. +Reject unaccounted operations rather than dropping unknown events. Static calls +need a checked semantic role or appropriate behavior evidence, including possible +trap/divergence; do not infer unobservability from a no-write set. Track exceptional +paths separately and retain the ordered events preceding them. This does not +implement caught-host-trap recovery: that remains a separate required boundary. + +## R3 — P2: two intended MIR negatives never reach the verifier + +**Owner:** `psrs-driver/src/tests/control_owned_steps/mod.rs:167` and `:320`. + +The focused control run fails +`mir_private_cells_are_checked_at_publication` and +`mir_cancellation_requires_pending_cancelled_and_clear`. Both unwrap a missing +helper from the optimized module: the shared source does not keep the relevant +Start/Once/Cancel function alive through inlining/elimination. The mutations and +their intended assertions never run. Corresponding CC tests pass, and the +normal-path owned-transfer MIR mutations run, but neither substitutes for these +publication/cancellation negatives. + +**Required repair:** Exercise live Once/Cancel through a suitable source fixture, +test retained helpers at the pre-optimization MIR boundary, and separately cover +actual inlined factory/cancellation operations. Removing the fixture panic by +skipping a missing function would preserve the coverage gap. + +## Design corrections made in this review + +- Finish closes its owned extent before restoring parent/rest; its inventory + previously said it closed after rest completed, contradicting the driver. +- Raw capture saves the dispatch context checkpoint, which can differ from the + active execution extent during replay. Driver pseudocode now uses + `dispatchExtent(context)` for both root and scoped operations. +- One-shot acquisition loads then clears the callback slot before invoking it, + with the callback retained by a local GC root. A trap leaves the cleared owner + Running; no caught-trap recovery is implemented. The old pseudocode cleared it + after application, and the model incorrectly described owner mutation as the + machine's only mutation despite mutable extent status. +- The Wasm engine owns frame GC. The guest runtime supplies runtime leaves and + linear-memory allocation; the compiler-owned linker assembles artifacts. +- The normative verifier contract now includes root/queue operands, owned + ordering, current publication contents, lifecycle helper bodies and complete + observable-operation accounting. The latter two remain implementation gaps; + the design is not narrowed to fit the current verifier. + +## Current evidence and limits + +Evidence root: `/private/tmp/psrs-control-architecture-review-2026-10-14/`. +Wasmtime: 49.0.2 (`3c8a3e79a`, 2026-10-02). Default locked package; +`PSRS_REQUIRE_WASMTIME=1` for all execution scopes below. + +| Command / evidence | Observed result | +| --- | --- | +| `cargo test -p psrs-backend --lib` | 444 passed (`backend.log`) | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 173 passed, 2 fixture panics (`control.log`) | +| All eleven existing control integration targets | 81 passed, no skips (`integration.log`) | +| `cargo test -p psrs-driver --lib review_probe -- --nocapture` while temporary probes were present | 2 probes passed, reproducing malformed acceptance (`probes-all.log`) | +| `cargo fmt --all --check`, `git diff --check`, local document link targets | Passed | + +The integration command lists `control_surface`, `control_runtime`, +`control_open_runtime`, `control_scoped_runtime`, `control_scoped_surface`, +`control_scoped_replay`, `control_owned_runtime`, `control_owned_surface`, +`control_lifetime`, `control_carrier_runtime` and `control_primitive_values` +as `--test` targets. This is focused runtime evidence, not complete AE/AC closure. + +Probe source is retained as `probes.rs` in the evidence directory. It was appended +temporarily inside `control_queue_steps/mir.rs` to reuse that fixture's dispatch +navigation, then removed exactly. No production Rust or permanent tests were +changed. Preserve these probes as rejection regressions when implementing R1/R2. + +Workspace tests/Clippy, ignored scoreboards, full upstream differential and +package/source conformance were not rerun. Previous workspace failures and +package measurements remain historical. D-04 measurements/statuses are unchanged. +Foreign captured-resource validity, caught-host-trap cleanup/reentry and complete +upstream API acceptance remain required and unverified. + + +## Repair evidence (2026-10-14) + +The repair preserves the dirty compiler checkout and default locked stdlib. +There are no commits, pushes, PRs or package changes. Evidence root: +`/private/tmp/psrs-control-repairs-2026-10-14/`; the `before/` directory retains +the pre-repair backend/test/docs files and `status.before` records the checkout. + +### R1: checked lifecycle bodies + +Shared `control/lifecycle.rs` verifies both extent cases, each own status slot, +Check's live guard and parent continuation, and Close's closed write and returned +extent. CC and MIR adapters validate actual body exits, including loopified Check. +A matching helper symbol alone cannot discharge this proof. Missing bodies that +still have calls fail ordinary callable verification. The ordinary inliner retains +these branching helpers; it cannot inline an identity mutation because the input +module is checked first, and every optimizer intermediate is checked again. + +`control_lifecycle_bodies` supplies permanent CC/MIR negatives for identity, +incorrect status/index/guard, missing Close writes and wrong ancestry. Existing +lifetime, replay and one-shot execution tests exercise the valid bodies. + +### R2: execution events and reference refinements + +`control/events.rs` now owns ordered observations for every machine relation. +CC traversal retains exceptional paths and cast identities; the CC execution +checks now live under `cc/verify/control/execution/`. MIR `branch_facts` +exposes both all-path and normal-exit views. Entry preheaders and full CC bodies +are checked rather than beginning inside a dispatch alternative. Allocation, +mutation, reads, direct/dynamic calls, reference refinements and explicit traps +are distinguished. An explicit failed machine guard must terminate before any +further observable operation. Preceding events must be a prefix of a validated +normal action; a correct-looking normal branch cannot justify work after failure. + +Normal-path casts require static reference compatibility, immutable case evidence +(including single-case nominal variants), or the actual checked callback/result +role. Exceptional prefixes canonicalize observed operands through path aliases and retain +instruction/cast source identity so a trap-only bad cast +cannot disappear from accounting. Arbitrary additional stores, loads, calls, +allocations not feeding the transition, and explicit fallible instructions are +rejected. Checked source callback contracts and ordinary SSA/layout legality +remain producer assumptions; no source types are reconstructed from erased data. + +The former no-write call exemption is replaced by total-function summaries. A +least fixed point excludes recursive call SCCs, and MIR also rejects reachable +CFG cycles and fallible/read/write instructions. These summaries do not treat +trapping reads or static recursion as unobservable. + +`control_queue_steps/mir/effects.rs` rejects extra stores and TrapIf at root +return, trapping default, loop entry and retained Start publication; it also +rejects unused narrowing casts and a Running write after a failed Pending guard. +`control_observable_paths` covers CC pre-dispatch/default calls, publication +calls, payload recovery and no-write recursive calls. Equivalent If/switch joins +remain positive coverage. + +The ancestry observation used to rely on the unsafe no-write exemption. It now +instruments the final structured Wasm after the normal compiler pipeline has +verified and assembled the program. The test adds private locals/functions, +replaces the program core module inside its component without changing existing +imports/exports, and validates the resulting component before execution. Its +intentional budget trap is no longer part of a purportedly valid control step. +The depth-sensitive negative and the long-chain/GC checks still execute. + +### R3: retained and inlined publication evidence + +The two failing MIR fixtures now mutate pre-optimization `mir::lower_module` +output, where the helper being tested exists; neither test skips a missing body. +`control_inlined_publication` separately mutates optimized Start/Once cells before +publication. A write preserving live contents passes; a write publishing status 2 +fails. MIR consumes the source witness and physical allocations to recheck current +contents across the factory window. For Run, the window ends before its executor +call; unrelated caller allocations in exclusive alternatives do not affect the +private-cell proof. The existing shared-root exclusive-branch positive still runs. + +Execution-event repairs cover Executor, Check/Close and Start/Once/Cancel. +Clone/Rebuild retain their separate existing operand/capture relations and the +stricter total-call summary; complete replay/context step equivalence remains +part of the acceptance audit. + +These repairs close the concrete review findings. Foreign resource capture, +caught-host-trap recovery and full reference-library/AE/AC acceptance remain open. +The exact final command results are recorded in the handoff and checklist. + + +Final validation: focused control **185 passed**, backend **444 passed**, mandatory +integration **81 passed**. Formatting/diff/link checks pass. Strict workspace +Clippy passes with only the pre-existing `clippy::let_and_return` class explicitly +allowed; unmodified strict Clippy is blocked at `psrs-kind:174`. + +The integrated workspace snapshot has the same **71 historical failed test +names**, with no additions/recoveries. Two rustdoc dependency-artifact errors +pass on standalone rerun. The final module-layout and path-canonicalization changes +were followed by focused control/backend/integration and lint reruns; full +workspace was not repeated afterward. See handoff §8 for exact scope, comparison +and log paths. Ignored scoreboards, explicit full upstream differential and package +conformance were not rerun; D-04 measurements/statuses are unchanged. diff --git a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md new file mode 100644 index 00000000..ccfd70a0 --- /dev/null +++ b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md @@ -0,0 +1,456 @@ +# Handoff: Delimited Control Migration and Remaining Acceptance + +**Updated:** 2026-10-14, after repairs for architecture review R1–R3. +The filename keeps its original date; this file is the current snapshot. +**Objective:** Complete delimited control, then implement native Effect/ST. +**Status:** R1–R3 are repaired in implementation and permanent tests, included +in the local checkpoint commit containing this handoff. +Check/Close bodies, full Executor/lifecycle/factory paths, explicit observable operations, +reference refinements and retained/inlined publication contents now have checked +relations. Complete AE/AC acceptance remains outstanding; workspace validation +and the known Effect migration baseline are reported separately below. + +The [architecture review and repair evidence](delimited-control-architecture-review-2026-10-14.md#repair-evidence-2026-10-14) +records ownership, regressions, and the moved Wasm ancestry observation. +The pre-repair snapshot and current logs are retained under +`/private/tmp/psrs-control-repairs-2026-10-14/`. + +No pushes, PRs, or remote changes were made. No subagents were used. + +## 1. Checkout and package identity + +| Owner | Current state | +| --- | --- | +| Compiler | `/Users/biu/Projects/purescript-rs`, branch `feat/effect-handlers`; checkpoint commit containing this handoff, based on `6df8bfba59f74659883f8572ac8a88c821a6574e` | +| Independent stdlib | `/Users/biu/Projects/psrs-stdlib`, branch `control-library`, HEAD `d6cf81105046e288e2e9cd9685f8cc47e960c988`; clean and unchanged | +| Compiler lock | Pins that stdlib revision and `fnv1a64-v1:6eb134fa699297f4` | +| Work | Active continuation; complete delimited-control acceptance remains open | + +The local checkpoint combines the previously dirty control-verifier draft, +the R1–R3 repairs, permanent tests and their design/acceptance documentation. +Use `git show --stat` on the checkpoint commit for its exact inventory. + +The checkpoint implementation spans these topics: + +- `control/`: shared dispatch/provenance, Bind/Resume, root/queue execution, + observable-operation and owned-cell relations; the former + `control_provenance.rs` is renamed into this directory. +- CC layout/lowering: contiguous computation tags and planned result-pair access. +- CC/MIR reference identity and branch facts: aliases, equivalent joins, + actual exits and ordered per-path events. +- Paired control verifiers: dispatch, clauses, exits, steps, root/queue execution, + owned transfer and Start/Once/Cancel publication, alongside existing capture, + replay, context and finish checks. +- MIR CFG reachability/dominance; planned nominal constructor verification; + shared `mir/effects.rs` replaces `mir/opt/effects.rs` so optimization and + semantic checks use the same instruction summaries. +- Driver tests: dispatch, clause steps, execution steps, result provenance, + `control_queue_steps/` and `control_owned_steps/`. +- Design split and coverage documents: `control-machine.md`, related control + designs, backend index, algebraic-effects checklist and D-04's earlier + qualitative update. This review adds an architecture review record and + updates this handoff; it does not change D-04 measurements or statuses. + +## 2. Progress since the 2026-10-12 handoff + +The checkpoint commit contains the progress below on top of `6df8bfba`. + +**Historical dispatch slice (2026-10-12; full acceptance still open)** + +1. Repaired the MIR dispatch dominance rule: the entry preheader's + initialization jump is distinguished from real loop backedges via + `value_identity::loop_header`'s contract (`mir/control/dispatch.rs`). +2. Fixed a real shared bug in `mir/cfg.rs::dominators`: unreachable blocks were + poisoning reachable blocks' dominator sets, so a reachable return block + appeared undominated. Dominance is now restricted to blocks reachable from + the entry (the Wasm structurer already worked this way). +3. Projection check semantics: a projection is rejected only when its selected + case is **proven** (`cc/verify/control/dispatch.rs`, + `mir/control/dispatch.rs`). Unprovable sources are left to the + relation-specific verifiers. Dispatch was then restored to the front of the CC + control chain, so it no longer preempts replay/context-entry diagnostics. +4. Retired the dead v1 `Reenter` tag: the computation variant is now contiguous + `0..5`, with `OwnedResume` at tag 5. There is no artifact-compatibility reason + to keep the gap (the machine is compiled in one module; old artifacts are + rebuilt; there is no persistent checked-IR cache). Touched + `cc/layout/control/{mod.rs, contracts.rs}`, `cc/lower/control/{mod.rs, + executor.rs, owned.rs}`, `control/dispatch.rs` (carrier domain + `[0,1,2,3,4,5]`), the dispatch tests, and the design docs. +5. Dispatch tests now cover, in CC and MIR: coverage (every required + alternative), wrong projection, non-trapping default, immutable `i32` tag + (MIR), reference alias/copy preservation (positive), and result origin + (CC). See §4. + +**Clause selection (§6.2, first slice)** + +6. New shared contract in `control/provenance.rs`: `ClauseKind { Return, + Operation }` and `clause_selection_relation`. A source `Return` must apply + the current scoped context's return clause (field 0); a source `Perform` must + apply its operation clause (field 1); both from the current context. +7. CC verifier `cc/verify/control/clauses.rs`: on the Executor's dispatch arms + for tags 0/1, every applied scoped-clause projection must be the clause that + step owns. It is a **universal** check over applied clause projections: a + wrong field/frame is rejected. The subsequently added execution-step + relation checks the required application and its result (see §4). +8. MIR verifier `mir/control/clauses.rs`: the same relation on the real CFG, + walking each input-dispatch arm (BFS stopping at the loop header) and + resolving `ClosureCall` callees through reference identity to the scoped case + `StructGet`. +9. Tests: `cc_source_{return,operation}_applies_its_own_{return,operation}_clause` + and the MIR equivalents, each swapping the applied clause field. +10. Split `control_dispatch.rs` (which had grown to 619 lines) into + `control_dispatch/{mod,cc,mir}.rs` to respect the 500-line source limit. + +**Documentation split** + +11. New design topic `docs/design/backend/fp/control-machine.md` now owns the + machine representation, per-IR encoding, lowering, flat driver and replay. + `delimited-control-and-resumable-frames.md` keeps the surface, the + design-space selection, handler semantics, lifetime and migration, and + defers the machine to the new doc. `control-elimination-and-handler-scopes.md` + reconciled its stale machine grammar to the implemented `Root`/`Scoped` + + `Finish` inventory. `docs/design/backend/README.md` lists the new topic. + +## 3. Representation and design contracts to preserve + +### Historical continuation: execution-step provenance (2026-10-13) + +The historical account and exact test names are in +[the execution-step checklist section](algebraic-effects.md#execution-step-provenance-2026-10-13). +The new slice changes verification only; machine representations, generated +instructions, library sources and the lock are unchanged. + +- Each scoped Return/Perform branch must feed the complete clause application + result to its executor transition, consuming its current answer/request and + preserving state/root handler. Perform supplies the predeclared raw resumption; + its factory remains subject to the existing queue/checkpoint capture checks. +- MIR verifies actual branch exits and application dominance. A correct-looking + call in a dead block cannot supply the proof. +- Bind enters its own body with its own callback and current queue. Resume + returns its saved answer, appends its replayed queue before current pending work + and installs the activation from that same checked replay result. +- Thirteen new tests cover 38 malformed-IR mutations. The final focused control + driver run passes 157 tests with required Wasmtime. The earlier runtime run + passes all 81 cases across the eleven control integration targets. +- The pinned Node source audit retains 50 packages / 305 modules: 245 identical, + 34 modified, 26 additions, no missing upstream modules. Official control type + comparison passes 17 cases. Pinned upstream JS RunState/RunChoose/RunHandlers + each return 42, with their value/order checks. +- Foreign resource capture needs ownership/lifetime evidence retained from the + canonical ABI into checked guest captures; the existing physical integer and + local drop/transfer checks do not supply it. Caught-host-trap cleanup/reentry + remains unimplemented. These obligations have not been weakened. + +Evidence is retained in `/private/tmp/psrs-control-completion/` and +`/private/tmp/psrs-control-completion-*.log`. The final public package batch +accepts all 14 cases, including three pure Run checks matching pinned upstream +JS. Official type comparison accepts all 17 cases. Early Run attempts timed out +at 180 seconds; the successful final batch uses 600 seconds and retains real +execution/artifact identities. + +The integrated workspace run has exactly the same 71 failed test names as the +reference migration baseline, with no added/recovered names. Two additional +doctest dependency-artifact build errors pass on standalone rerun. Strict +workspace Clippy still fails on the known `psrs-kind` warning; ordinary workspace +Clippy completes with that warning only. The final two environment-identity +guards/tests were checked by the final 157-test control run and rebuilt-CLI +conformance, after the full workspace snapshot. Full workspace was not rerun +after those last guards. See the checklist for exact scope and logs. Ignored +scoreboards and full upstream differential target were not rerun; D-04 gains +only a qualitative coverage update and keeps its existing measurements/statuses. + +Normative documents to read together with this handoff: + +- `docs/design/backend/fp/delimited-control-and-resumable-frames.md` (surface, selection, semantics) +- `docs/design/backend/fp/control-machine.md` (machine representation, lowering, driver, replay) +- `docs/design/backend/fp/control-elimination-and-handler-scopes.md` (clause scope/lifetime contract) +- `docs/design/backend/fp/cc-ir.md`, `docs/design/backend/fp/mir.md`, `docs/design/backend/fp/data-representation.md` +- `docs/implementation/backend/algebraic-effects.md` (AE/AC acceptance checklist) + +Current contracts: + +1. The eight `Prim.Control` primitives implement protocol v2. `handle` identity 96 + has arity three. Operation/return clauses execute in the target domain; raw + continuation invocation returns source-domain `Control` without reinstalling + the source handler. Deep/shallow policy is ordinary library code. +2. **Computation tags are contiguous `0..5`**: `Return` 0, `Perform` 1, `Bind` + 2, raw `Resume` 3, `Handle` 4, `OwnedResume` 5. The queue is `[0,1,2,3]` + (`Empty`/`Cons`/`Append`/`Finish`), the context `[0,1]` (`Root`/`Scoped`), and + the reverse queue `[0,1,3]` (reversed sequences contain no `Append`). + Unknown computation tags reach the trapping default. +3. Layout planning reserves nominal Control/Resumption carriers and all + synthesized `SignatureId`s before CC lowering freezes the representation + table. Do not mutate the table while synthesizing executor/continuation code. +4. Carrier parameters, results, captures and joins use their planned nominal + representations; only explicit abstract user-payload/storage boundaries erase + and recover. The machine does not reconstruct source types from erased data. +5. Persistent queues preserve callback/owner sharing; replay rebuilds only + lifecycle (`Finish`) nodes, each with a fresh child extent. +6. Recursive local functions may return closures before binding every flattened + parameter; CC supplies remaining parameters through shared lambda adaptation. + A zero-binder initializer that may call, write or trap is rejected. +7. No concrete Run, State, Reader or Writer identity is recognized by the + compiler. + +### Review repairs: actual exits, constructor tags and joins + +The review reproduced two accepted malformed programs and one rejected valid +program. All three now have permanent regression coverage: + +- A valid nested queue/context dispatch whose outer computation result was + replaced with state is rejected. `cc/verify/control/exits.rs` recursively checks + every executor transition and its containing structured result against the + actual enclosing exit; all six computation alternatives are covered. +- A recursive executor call whose result is discarded at a normal MIR return + is rejected by `mir/control/exits.rs`. Scoped clause verification inspects + actual exit terminators and their returned call results, not the first matching + instruction. A valid returned call remains accepted. +- `mir/verify/variants.rs` checks all planned nominal variants, including ordinary + data constructors. Tags remain immutable i32, match their physical case and + cannot be bypassed by constructing the common base. Copies and equal constants + at joins retain tag evidence. +- Shared CC reference origins accept equivalent If/TagSwitch joins, excluding + trapping alternatives. Shared MIR reference origins accept equivalent normal + joins; `cfg::reachable_from` and `cfg::dominators_from` support proofs within + one execution step. These checks use IDs, edges and planned layouts. + +`control_result_provenance` contains six tests (including all six discarded +computation results and value-sensitive Wasmtime execution returning 43). +Four backend nominal-constructor tests exercise ordinary variants, wrong tags, +copies, joins, direct base construction and mutable tag rejection. + +Validation for the repairs: backend library 444 passed; control library 163 +passed; all eleven control integration targets 81 passed. Control runs require +Wasmtime. Formatting and diff checks pass. Focused backend/driver Clippy completes +with only the existing `psrs-kind/src/check/synonyms.rs:174` warning; strict +Clippy is blocked by it. Workspace tests/Clippy, scoreboards, the full upstream +differential and public package conformance were not rerun for this focused +repair. Logs: `/private/tmp/psrs-control-review/fix-{backend-final,control-final,integration,clippy,clippy-strict}.log`. + +Those three earlier findings were repaired. Root/queue and owned execution +checks have since advanced as recorded below, but the new review reproduces +the pre-repair lifecycle-body and observable-operation gaps. These are repaired +in §8. Foreign capture, +caught-host-trap recovery and complete AE/AC acceptance remain open. Earlier full +workspace evidence is historical and was not refreshed in this review. + +## 4. What the machine verifiers check now + +CC (`cc/verify/control/`) and MIR (`mir/control/`) select the following +checks by their retained helper/source roles: + +- **dispatch** (`dispatch.rs`): dispatch covers exactly the live alternatives; + default traps; projections match the proven selected case; the result + originates from the current input's dispatch (CC); MIR additionally requires an + immutable `i32` tag field, the current helper input selector, and that the input + dispatch dominates every invoke/return/backedge (entry preheader initialization + excepted). +- **clause selection** (`clauses.rs`): a source `Return` applies the scoped + return clause; a source `Perform` applies the scoped operation clause. +- **scoped execution** (`clauses.rs`): the next computation is the full + application result, the first argument is the current source payload and an + operation supplies its raw resumption. MIR also checks execution dominance; + both retain state/root handler identity. +- **Bind/Resume steps** (`steps.rs`): current frame operands, queue composition, + and replayed queue/activation identity on the actual transition. + +Additional current checks: + +- **root/queue execution** (`execution.rs`): the complete root handler call, + paired result fields, queue abandonment, terminal state/answer, Cons consumption, + all four Append-left actions, Finish restoration and required-action coverage. +- **normal-path operation accounting**: CC `execution/effects.rs`, MIR + `traces.rs` and shared `control/execution/observables.rs` check required dynamic + applications and selected static helper calls, and reject extra calls/array + stores. The repaired event contract accounts for explicit traps, other writes and + refinements as well; exceptional paths terminate before work after a failed + guard. See the repair evidence for precise trust boundaries. +- **owned execution** (`owned.rs`): Pending guard, Running, load, clear, one + callback, Consumed and transition order, with current owner/answer/result + identities. Equality guards have positive CC and MIR tests. +- **initialization/cancellation** (`initialization.rs`): current private contents + at publication, including intervening writes, and cancellation order. CC + and MIR negatives execute on retained helpers; separate optimized-MIR + publication mutations cover physical Start/Once cells after inlining. + +Shared relations live in `control/{provenance,dispatch,steps,owned}.rs` and +`control/execution/`; CC and MIR fact propagation lives in `cc/branch_facts.rs` +and `mir/branch_facts.rs`. `Check`/`Close` callee binding is checked, but their +lifecycle bodies are now verified separately by shared `control/lifecycle.rs` +and paired adapters. `control/events.rs` owns ordered events; per-IR refinement +checks justify narrowing recovery. A total-function summary replaces the former +no-write exemption. MIR additionally rechecks inlined Start/Once publication +windows from their physical allocations and source witnesses. + +## 5. Historical validation (before the 2026-10-14 review) + +Environment: Wasmtime 49.0.2 (`3c8a3e79a`, 2026-10-02), default locked stdlib +`d6cf811`, `PSRS_REQUIRE_WASMTIME=1` for execution. + +| Command / scope | Observed result | +| --- | --- | +| `cargo test -p psrs-backend --lib` | 440 passed, 0 failed | +| `cargo test -p psrs-driver --lib tests::control` | 144 passed, 0 failed | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --test control_surface --test control_runtime --test control_open_runtime` | all passed | +| `... --test control_scoped_runtime --test control_scoped_surface --test control_scoped_replay --test control_owned_runtime --test control_owned_surface --test control_lifetime --test control_carrier_runtime --test control_primitive_values` | all passed | +| `cargo test -p psrs-driver --lib -- --skip tests::wasi` | 655 passed, 31 failed | +| `cargo fmt --all --check` | clean | +| `cargo clippy -p psrs-backend --all-targets`, `-p psrs-driver --lib --tests` | clean except the pre-existing `psrs-kind` warning | + +The 31 driver-library failures are the **same failure set as before this +continuation** (pre-existing Effect-migration errors: `unknown name runEffect` / +`unknown type name Effect`) and are not regressions. The wasi target tests also +fail for that reason. Full workspace runs, ignored scoreboards, and upstream +`purs` differentials were intentionally **not** rerun, per the user's +focused-validation instruction. + +## 6. Remaining work and recommended continuation + +Follow the user's order and validation limits: work in the current checkout, +keep changes focused, and do not run global validation after each small fix. + +1. **§6.2 continued — complete the acceptance audit beyond R1–R3.** + The review defects have permanent rejection tests and shared contracts; do + not restart these repaired slices. Audit remaining dispatch/context/replay + equivalences, requirement-level coverage and general cost obligations. Keep + checked source typing, ordinary SSA/layout legality, machine execution proofs + and source-to-Wasm observations separate. No-write summaries are insufficient + for unobservability; observations that deliberately trap belong after the + verified compiler pipeline. Scope and exact evidence are in the repair record. +2. **§6.3 foreign capture and trap cleanup.** Foreign borrowed-buffer/resource + capture validity and explicit unsupported-capture rejection; a defined + caught-host-trap recovery/cleanup boundary with actual recovery execution; and + general allocation/cost obligations. Do not narrow the normative design. +3. **§6.4 reference-library/API acceptance.** Complete pinned upstream-library + source and execution comparisons for the generic handler model, including the + remaining row/representation interactions. Plain import acceptance is not + evidence that Aff or other FFI executes. +4. **§6.5 integrated audit.** Audit every AE/AC requirement, run its full required + validation scope, and remeasure the relevant D-04 gates before changing + statuses. Land any design-document change with the code it describes. +5. **§6.6 native Effect/ST.** Only after complete delimited-control acceptance, + implement role-correct public native Effect/ST facades, shared ST.Global + conversion/representation, region boundaries and raw host leaves. + +Suggested commit grouping when ready: group dispatch/CFG/tag removal with its +rejection tests and design contract; execution/owned/lifecycle verification with +its tests and coverage documents; include the machine-document split with the +implementation topic it describes. Do not create a documentation-only follow-up +for a code topic or split one semantic proof across trivial commits. + +## 7. Pre-repair validation and review findings (2026-10-14) + +This is the historical failing snapshot. Repairs and current evidence follow in §8. + +Checkout identity is unchanged: compiler `6df8bfba`, locked stdlib `d6cf811` +(clean when inspected in this review). Wasmtime is 49.0.2 (`3c8a3e79a`). + +| Scope | Current observed result | +| --- | --- | +| `cargo test -p psrs-backend --lib` | 444 passed | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 173 passed, 2 failed; both fixture lookups panic before malformed-IR assertions | +| Eleven control integration targets with required Wasmtime | 81 passed, no skips | +| Temporary architecture probes | Identity Check/Close bodies accepted by both CC and MIR; extra Store and always-true TrapIf accepted by MIR | +| Formatting, diff whitespace and local document link targets | Passed | + +The two failing tests are +`tests::control_owned_steps::mir_private_cells_are_checked_at_publication` +(line 167) and +`tests::control_owned_steps::mir_cancellation_requires_pending_cancelled_and_clear` +(line 320). Both use a source that leaves the relevant helper absent from the +optimized module. This is an incomplete negative-test fixture, not evidence that +production lowering failed or that its intended malformed mutation was rejected. + +The probes establish verifier incompleteness, not a source-level user program +that currently triggers those defects. Production helpers still emit the +intended checks, close writes and callback ordering. These findings nevertheless +block any claim that later transformations are checked against the complete +machine contract. The complete requirements remain Unverified. + +Logs and probe source: `/private/tmp/psrs-control-architecture-review-2026-10-14/` +(`backend.log`, `control.log`, `integration.log`, `probes-all.log`, `probes.rs`). +The review reruns focused checks only. Workspace tests, workspace Clippy, +ignored scoreboards, the full upstream differential, source audit and package +conformance were not rerun; earlier evidence remains historical. No Rust changes +or permanent tests were added in this documentation review. + +## 8. Current repair checkpoint (2026-10-14) + +R1–R3 are repaired and included with the earlier draft in the local checkpoint +commit. The stdlib lock remains unchanged. +Only test dependencies were added to the driver (`wasm-encoder` and `wasmparser`, +using existing workspace pins); no library or runtime package was changed. + +- `control/lifecycle.rs` and paired adapters prove Check/Close bodies, including + own status access, live guard, checked parent advancement and close writes. +- `control/events.rs` owns allocation/read/write/call/refinement/trap observations. + Full Executor/lifecycle/factory paths include entry prefixes and failed guards. + Rejection terminates before further observable work, and its executed prefix + must agree with a checked normal action. Narrowing casts need an explicit + static/case/callback-use justification. Checked source typing and ordinary + SSA/layout legality remain the producer assumptions. +- Total-function summaries replace the unsafe no-write exemption; recursive + calls, fallible reads/traps and MIR CFG cycles are not assumed unobservable. +- Retained Start/Once/Cancel mutation tests now use pre-optimization MIR. + Optimized physical Start/Once cells have separate publication-witness tests. +- Ancestry cost instrumentation runs on the final Wasm/component after compiler + verification, with private observer functions and explicit component validation. + The original long-chain/GC and depth-sensitive observations still execute. +- CC execution verification is organized under `cc/verify/control/execution/`; + queue MIR mutations are under `control_queue_steps/mir/`. The touched sources + satisfy the 500-line limit and no longer add the flat execution-sibling layout + violation. Other pre-existing repository layout violations remain outside this + repair. + +| Final focused scope | Observed result | +| --- | --- | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 185 passed; no failures or skips | +| Eleven control integration targets, required Wasmtime | 81 passed; no failures or skips | +| `cargo test -p psrs-backend --lib` (also in final workspace) | 444 passed | +| Post-module-layout `control_observable_paths` | 4 passed | +| `cargo fmt --all --check`, `git diff --check`, local document links | Passed | +| `cargo clippy --workspace --all-targets` | Completes; only the pre-existing `psrs-kind/src/check/synonyms.rs:174` `let_and_return` warning | +| `cargo clippy --workspace --all-targets -- -D warnings` | Fails on that existing warning | +| `cargo clippy --workspace --all-targets -- -D warnings -A clippy::let_and_return` | Passes; no other lint allowance | + +Logs: `/private/tmp/psrs-control-repairs-2026-10-14/`, particularly +`control-canonical-final.log`, `integration-verified.log`, `backend-verified.log`, +`layout-focused.log`, `clippy-normal-final.log`, `clippy-strict.log` and +`clippy-canonical-final.log`. `repair.diff` compares the Rust changes with `before/`, +so the new repair can be distinguished from the earlier uncommitted work. + +No ignored scoreboard, full upstream differential or package conformance rerun +was performed for this verifier repair. D-04 measurements and complete AE/AC +statuses are unchanged. Clone/Rebuild/context step equivalence beyond existing +operand/capture proofs, foreign capture, caught-host-trap recovery and complete +reference-library acceptance remain open. + + +### Integrated comparison and final-snapshot scope + +`cargo test --workspace --no-fail-fast` completed with the **same 71 failed test +names** as `/private/tmp/psrs-control-reference/workspace-after-failing-names.txt`: +no added or recovered names. The failing test targets are CLI `link`, CLI +`source_layout`, driver library (**810 passed / 68 failed**) and driver +`residual_constraints`. They retain the known Effect/FFI migration, constraint +and repository-layout failures. This is a name-set comparison with the retained +historical baseline, not a fresh clean-checkout before/after workspace run. + +That workspace run also reported E0463 dependency-artifact errors for backend +and driver rustdoc. Standalone +`cargo test -p psrs-backend -p psrs-driver --doc` then completed successfully +(zero doctest examples in either crate); this is separate build evidence rather +than two extra failing test names. + +`workspace-final.log`, `workspace-comparison.json` and `doctest-final.log` retain +the exact observations. The earlier `workspace.log` is an intermediate snapshot: +it included a rejected valid switch join that was subsequently repaired and +permanently rechecked. Use `workspace-final.log` for the comparison. + +The final CC module-directory cleanup and path-operand canonicalization came +after the integrated snapshot. Focused control **185/185**, backend **444/444**, +mandatory integration **81/81**, formatting and lint checks were rerun on the +final tree; full workspace was not repeated for those last changes. Event prefix +comparisons resolve observed input operands through each path's aliases while +retaining instruction result IDs, so a shared join cannot disguise another +cell/source or cast definition. From 01f7e66ca1fbc3c4558e56199fb87ca1fefed75a Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 14 Oct 2026 22:37:53 +0800 Subject: [PATCH 135/148] Name the control machine schema and record the construction boundary P8 lowering, layout planning and every verifier inferred machine cases, fields and helper roles from positional offsets. Add one stage-independent named schema (control/schema.rs) and a frozen per-module placement (cc/control/schema.rs, RepresentationTable::control_schema) that layout, generation and verification consume. Positional case/field literals and role-from-signature inference are replaced by named queries. Replace the ad-hoc executor coverage set with a named ActionId registry whose complete inventory must be observed. Add DEC-21, which resolves the construction/verification boundary: a checked P8 plan expanded to ordinary CC, with ordinary P9/P10 trusted under IR-invariant and behavior evidence. Behavior is unchanged: focused control 185 passed, backend 445 passed. --- crates/psrs-backend/src/cc/control/helpers.rs | 66 +--- crates/psrs-backend/src/cc/control/mod.rs | 2 + crates/psrs-backend/src/cc/control/schema.rs | 139 +++++++ .../src/cc/layout/control/contracts.rs | 13 +- .../src/cc/lower/control/executor.rs | 250 +++++++++--- .../src/cc/lower/control/lifetime.rs | 39 +- .../psrs-backend/src/cc/lower/control/mod.rs | 26 +- .../src/cc/lower/control/owned.rs | 56 ++- .../src/cc/lower/control/replay.rs | 137 +++++-- .../src/cc/lower/control/scope.rs | 244 +++++++++--- crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/representation.rs | 4 + .../src/cc/verify/control/execution/mod.rs | 6 +- .../psrs-backend/src/cc/verify/ops/table.rs | 3 + crates/psrs-backend/src/control/dispatch.rs | 37 +- .../psrs-backend/src/control/execution/mod.rs | 373 +++++++++++++----- crates/psrs-backend/src/control/lifecycle.rs | 4 +- crates/psrs-backend/src/control/mod.rs | 9 +- crates/psrs-backend/src/control/owned.rs | 46 +-- crates/psrs-backend/src/control/provenance.rs | 43 +- crates/psrs-backend/src/control/schema.rs | 225 +++++++++++ crates/psrs-backend/src/control/steps.rs | 7 +- .../psrs-backend/src/mir/control/execution.rs | 4 +- .../src/tests/control_queue_steps/mod.rs | 6 +- ...1-control-machine-construction-boundary.md | 89 +++++ docs/design/backend/fp/control-machine.md | 142 ++++++- .../backend/algebraic-effects.md | 3 + ...ited-control-lowering-review-2026-10-14.md | 255 ++++++++++++ ...ed-control-migration-handoff-2026-10-12.md | 31 ++ 29 files changed, 1858 insertions(+), 402 deletions(-) create mode 100644 crates/psrs-backend/src/cc/control/schema.rs create mode 100644 crates/psrs-backend/src/control/schema.rs create mode 100644 docs/decision/DEC-21-control-machine-construction-boundary.md create mode 100644 docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md diff --git a/crates/psrs-backend/src/cc/control/helpers.rs b/crates/psrs-backend/src/cc/control/helpers.rs index 861313ba..23d0be10 100644 --- a/crates/psrs-backend/src/cc/control/helpers.rs +++ b/crates/psrs-backend/src/cc/control/helpers.rs @@ -53,19 +53,7 @@ impl ControlHelperContract { impl crate::cc::RepresentationTable { pub(crate) fn control_sequence(&self) -> Option { - let helper = self - .control_helpers - .iter() - .find(|helper| helper.role == ControlHelperRole::CloneSequence)?; - let crate::cc::ValueShape::Reference(reference) = - *self.signature(helper.signature)?.parameters.first()? - else { - return None; - }; - let crate::cc::RefShape::Repr(sequence) = reference.heap else { - return None; - }; - Some(sequence) + Some(self.control_schema()?.sequence) } pub(crate) fn verify_control_call( @@ -123,24 +111,10 @@ pub(crate) struct ControlCheckpointSchema { impl crate::cc::RepresentationTable { pub(crate) fn control_checkpoint_schema(&self) -> Option { - let parameter = |role, index| { - let helper = self - .control_helpers - .iter() - .find(|helper| helper.role() == role)?; - let crate::cc::ValueShape::Reference(reference) = - *self.signature(helper.signature())?.parameters.get(index)? - else { - return None; - }; - let crate::cc::RefShape::Repr(repr) = reference.heap else { - return None; - }; - Some(repr) - }; + let schema = self.control_schema()?; Some(ControlCheckpointSchema { - computation: parameter(ControlHelperRole::Executor, 2)?, - context: parameter(ControlHelperRole::Executor, 5)?, + computation: schema.computation, + context: schema.context, }) } } @@ -155,29 +129,9 @@ pub(crate) struct ControlReplaySchema { impl crate::cc::RepresentationTable { pub(crate) fn control_replay_schema(&self) -> Option { - let repr = |shape| match shape { - crate::cc::ValueShape::Reference(crate::cc::Reference { - heap: crate::cc::RefShape::Repr(id), - nullable: false, - }) => Some(id), - _ => None, - }; - let signature = |role| { - self.signature( - self.control_helpers - .iter() - .find(|helper| helper.role() == role)? - .signature(), - ) - }; - let sequence = self.control_sequence()?; - let boundary = repr(*signature(ControlHelperRole::Check)?.parameters.first()?)?; - let crate::cc::Representation::Variant { cases } = self.representation(boundary)? else { - return None; - }; - let status = repr(*cases.iter().find(|case| case.tag == 1)?.fields.first()?)?; + let schema = self.control_schema()?; if !matches!( - self.representation(status), + self.representation(schema.status), Some(crate::cc::Representation::Array { element: crate::cc::ValueShape::Integer }) @@ -185,10 +139,10 @@ impl crate::cc::RepresentationTable { return None; } Some(ControlReplaySchema { - sequence, - boundary, - status, - result: repr(signature(ControlHelperRole::CloneSequence)?.result)?, + sequence: schema.sequence, + boundary: schema.extent, + status: schema.status, + result: schema.replay_result, }) } } diff --git a/crates/psrs-backend/src/cc/control/mod.rs b/crates/psrs-backend/src/cc/control/mod.rs index 9fbb2d22..09ed96f3 100644 --- a/crates/psrs-backend/src/cc/control/mod.rs +++ b/crates/psrs-backend/src/cc/control/mod.rs @@ -2,6 +2,7 @@ mod contracts; mod helpers; +mod schema; pub(in crate::cc) use contracts::ControlImplementation; pub use contracts::{ @@ -11,3 +12,4 @@ pub use contracts::{ pub use helpers::{ ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, }; +pub(crate) use schema::ControlSchema; diff --git a/crates/psrs-backend/src/cc/control/schema.rs b/crates/psrs-backend/src/cc/control/schema.rs new file mode 100644 index 00000000..4b61f7f8 --- /dev/null +++ b/crates/psrs-backend/src/cc/control/schema.rs @@ -0,0 +1,139 @@ +//! The frozen placement of the named machine schema in one representation table. +//! +//! Planning fixes every machine carrier and private cell once, after the shared +//! [`crate::control::schema`] names and actually emitted helper signatures +//! agree. Consumers read named placements from here instead of recovering a +//! role from a helper parameter offset or a variant field position. The value +//! is immutable evidence: a later pass may read it but not replace it. + +use super::{ControlHelperContract, ControlHelperRole}; +use crate::cc::{ReprId, Representation}; +use crate::control::schema::{ComputationCase, ContextCase, ExtentCase, OwnerCase, SequenceCase}; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct ControlSchema { + /// The shared `Control f a` frame. + pub computation: ReprId, + /// The persistent sequencing spine. + pub sequence: ReprId, + /// The dispatch context. + pub context: ReprId, + /// A lifetime extent (the boundary carrier). + pub extent: ReprId, + /// The one-slot mutable status cell. + pub status: ReprId, + /// The one-shot owner object. + pub owner: ReprId, + /// The one-slot callback cell. + pub callback: ReprId, + /// The closed-run result pair. + pub result_pair: ReprId, + /// The replay result product. + pub replay_result: ReprId, +} + +impl crate::cc::RepresentationTable { + /// The frozen machine placement, when this module uses control. + pub(crate) fn control_schema(&self) -> Option { + self.control_schema + } + + /// The single checked contract for a semantic helper role. + pub(crate) fn control_helper(&self, role: ControlHelperRole) -> Option<&ControlHelperContract> { + self.control_helpers + .iter() + .find(|helper| helper.role() == role) + } + + /// Check that every placed carrier has exactly the cases and field arity the + /// named schema declares. This is the independent layout check: the physical + /// frame is compared against the names, not one positional list against + /// another. Missing placement with present helpers is an error, not a fresh + /// unknown. + pub(crate) fn verify_control_schema(&self) -> Result<(), &'static str> { + let Some(schema) = self.control_schema else { + return if self.control_helpers.is_empty() { + Ok(()) + } else { + Err("control helpers have no placed machine schema") + }; + }; + check_variant(self, schema.computation, &computation_cases())?; + check_variant(self, schema.sequence, &sequence_cases())?; + check_variant(self, schema.context, &context_cases())?; + check_variant(self, schema.extent, &extent_cases())?; + check_variant(self, schema.owner, &owner_cases())?; + check_product(self, schema.result_pair)?; + check_product(self, schema.replay_result)?; + for repr in [schema.status, schema.callback] { + if !matches!( + self.representation(repr), + Some(Representation::Array { .. }) + ) { + return Err("control placement names a private cell that is not an array"); + } + } + Ok(()) + } +} + +fn computation_cases() -> Vec<(u32, usize)> { + ComputationCase::ALL + .iter() + .map(|case| (case.tag(), case.field_count())) + .collect() +} + +fn sequence_cases() -> Vec<(u32, usize)> { + SequenceCase::ALL + .iter() + .map(|case| (case.tag(), case.field_count())) + .collect() +} + +fn context_cases() -> Vec<(u32, usize)> { + ContextCase::ALL + .iter() + .map(|case| (case.tag(), case.field_count())) + .collect() +} + +fn extent_cases() -> Vec<(u32, usize)> { + ExtentCase::ALL + .iter() + .map(|case| (case.tag(), case.field_count())) + .collect() +} + +fn owner_cases() -> Vec<(u32, usize)> { + OwnerCase::ALL + .iter() + .map(|case| (case.tag(), case.field_count())) + .collect() +} + +fn check_variant( + table: &crate::cc::RepresentationTable, + repr: ReprId, + expected: &[(u32, usize)], +) -> Result<(), &'static str> { + let Some(Representation::Variant { cases }) = table.representation(repr) else { + return Err("control placement names a carrier that is not a variant"); + }; + if cases.len() != expected.len() { + return Err("control carrier does not match the named schema case count"); + } + for (case, (tag, count)) in cases.iter().zip(expected) { + if case.tag != *tag || case.fields.len() != *count { + return Err("control carrier does not match the named schema field arity"); + } + } + Ok(()) +} + +fn check_product(table: &crate::cc::RepresentationTable, repr: ReprId) -> Result<(), &'static str> { + match table.representation(repr) { + Some(Representation::Product { fields }) if fields.len() == 2 => Ok(()), + _ => Err("control placement names a product that does not have two fields"), + } +} diff --git a/crates/psrs-backend/src/cc/layout/control/contracts.rs b/crates/psrs-backend/src/cc/layout/control/contracts.rs index f97fe933..bde9c7e0 100644 --- a/crates/psrs-backend/src/cc/layout/control/contracts.rs +++ b/crates/psrs-backend/src/cc/layout/control/contracts.rs @@ -255,11 +255,11 @@ fn ty(module: &Module, id: TypeId, visiting: &mut HashSet) -> Option fn implementation(layout: ControlLayout, operation: Intrinsic) -> ControlImplementation { use Intrinsic::*; let case = match operation { - ControlReturn => 0, - ControlPerform => 1, - ControlBind => 2, - ControlHandle => 4, - ControlResume => 5, + ControlReturn => crate::control::schema::ComputationCase::Return, + ControlPerform => crate::control::schema::ComputationCase::Perform, + ControlBind => crate::control::schema::ComputationCase::Bind, + ControlHandle => crate::control::schema::ComputationCase::Handle, + ControlResume => crate::control::schema::ComputationCase::OwnedResume, ControlRun => { return ControlImplementation::Call { signature: layout.executor, @@ -279,7 +279,8 @@ fn implementation(layout: ControlLayout, operation: Intrinsic) -> ControlImpleme }; } _ => unreachable!("checked control operation"), - }; + } + .tag(); ControlImplementation::Frame { representation: layout.computation, case, diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index dfd6988f..d9146e14 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -3,6 +3,7 @@ use super::builder::{Machine, repr}; use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, TagCase, ValueId}; +use crate::control::schema::{ComputationCase, SequenceCase, computation as c, sequence as q}; impl Machine<'_> { pub(super) fn executor(mut self) -> Function { @@ -23,32 +24,73 @@ impl Machine<'_> { let mut cases = Vec::new(); let mut body = Vec::new(); - let value = self.field(computation, self.layout.computation, 0, 0, &mut body); + let value = self.field( + computation, + self.layout.computation, + ComputationCase::Return.tag(), + c::PAYLOAD, + &mut body, + ); let result = self.returned(state, handler, computation, value, sequence, &mut body); - cases.push(arm(0, body, result)); + cases.push(arm(ComputationCase::Return.tag(), body, result)); let mut body = Vec::new(); let result = self.requested(state, handler, computation, sequence, &mut body); - cases.push(arm(1, body, result)); + cases.push(arm(ComputationCase::Perform.tag(), body, result)); let mut body = Vec::new(); - let inner = self.field(computation, self.layout.computation, 2, 0, &mut body); - let continuation = self.field(computation, self.layout.computation, 2, 1, &mut body); + let inner = self.field( + computation, + self.layout.computation, + ComputationCase::Bind.tag(), + c::BIND_INNER, + &mut body, + ); + let continuation = self.field( + computation, + self.layout.computation, + ComputationCase::Bind.tag(), + c::BIND_CONTINUATION, + &mut body, + ); let pending = self.node( self.layout.sequence, - 1, + SequenceCase::Cons.tag(), vec![continuation, sequence], &mut body, ); let result = self.recur(state, handler, inner, pending, &mut body); - cases.push(arm(2, body, result)); + cases.push(arm(ComputationCase::Bind.tag(), body, result)); let mut body = Vec::new(); - let value = self.field(computation, self.layout.computation, 3, 0, &mut body); - let saved = self.field(computation, self.layout.computation, 3, 1, &mut body); - let captured_boundary = self.field(computation, self.layout.computation, 3, 2, &mut body); + let value = self.field( + computation, + self.layout.computation, + ComputationCase::Resume.tag(), + c::RESUME_VALUE, + &mut body, + ); + let saved = self.field( + computation, + self.layout.computation, + ComputationCase::Resume.tag(), + c::RESUME_SAVED, + &mut body, + ); + let captured_boundary = self.field( + computation, + self.layout.computation, + ComputationCase::Resume.tag(), + c::RESUME_CHECKPOINT, + &mut body, + ); self.check_boundary(captured_boundary, &mut body); - let empty = self.node(self.layout.sequence, 0, vec![], &mut body); + let empty = self.node( + self.layout.sequence, + SequenceCase::Empty.tag(), + vec![], + &mut body, + ); let function = self.functions.clone_sequence; let boundary = self.boundary.unwrap(); let parent = self.dispatch_boundary(&mut body); @@ -57,21 +99,31 @@ impl Machine<'_> { vec![saved, empty, empty, boundary, parent], &mut body, ); - let saved = self.replay_field(cloned, 0, &mut body); - let active = self.replay_field(cloned, 1, &mut body); - let pending = self.node(self.layout.sequence, 2, vec![saved, sequence], &mut body); + let saved = self.replay_field(cloned, crate::control::schema::replay::QUEUE, &mut body); + let active = self.replay_field(cloned, crate::control::schema::replay::ACTIVE, &mut body); + let pending = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![saved, sequence], + &mut body, + ); self.boundary = Some(active); - let next = self.node(self.layout.computation, 0, vec![value], &mut body); + let next = self.node( + self.layout.computation, + ComputationCase::Return.tag(), + vec![value], + &mut body, + ); let result = self.recur(state, handler, next, pending, &mut body); - cases.push(arm(3, body, result)); + cases.push(arm(ComputationCase::Resume.tag(), body, result)); self.boundary = Some(boundary); let mut body = Vec::new(); let result = self.enter_handle(state, handler, computation, sequence, &mut body); - cases.push(arm(4, body, result)); + cases.push(arm(ComputationCase::Handle.tag(), body, result)); let mut body = Vec::new(); let result = self.consume_owned(state, handler, computation, sequence, &mut body); - cases.push(arm(5, body, result)); + cases.push(arm(ComputationCase::OwnedResume.tag(), body, result)); let mut body = Vec::new(); let result = self.switch(computation, self.layout.computation, cases, &mut body); @@ -91,29 +143,71 @@ impl Machine<'_> { let mut cases = Vec::new(); let mut branch = Vec::new(); let result = self.finish_source(state, handler, value, &mut branch); - cases.push(arm(0, branch, result)); + cases.push(arm(SequenceCase::Empty.tag(), branch, result)); let mut branch = Vec::new(); - let continuation = self.field(sequence, self.layout.sequence, 1, 0, &mut branch); - let rest = self.field(sequence, self.layout.sequence, 1, 1, &mut branch); + let continuation = self.field( + sequence, + self.layout.sequence, + SequenceCase::Cons.tag(), + q::CONS_HEAD, + &mut branch, + ); + let rest = self.field( + sequence, + self.layout.sequence, + SequenceCase::Cons.tag(), + q::CONS_TAIL, + &mut branch, + ); let next = self.apply(continuation, &[value], &mut branch); let result = self.recur(state, handler, next, rest, &mut branch); - cases.push(arm(1, branch, result)); + cases.push(arm(SequenceCase::Cons.tag(), branch, result)); let mut branch = Vec::new(); - let left = self.field(sequence, self.layout.sequence, 2, 0, &mut branch); - let right = self.field(sequence, self.layout.sequence, 2, 1, &mut branch); + let left = self.field( + sequence, + self.layout.sequence, + SequenceCase::Append.tag(), + q::APPEND_LEFT, + &mut branch, + ); + let right = self.field( + sequence, + self.layout.sequence, + SequenceCase::Append.tag(), + q::APPEND_RIGHT, + &mut branch, + ); let result = self.appended(state, handler, computation, value, left, right, &mut branch); - cases.push(arm(2, branch, result)); + cases.push(arm(SequenceCase::Append.tag(), branch, result)); let mut branch = Vec::new(); - let boundary = self.field(sequence, self.layout.sequence, 3, 0, &mut branch); - let rest = self.field(sequence, self.layout.sequence, 3, 1, &mut branch); - let parent = self.field(sequence, self.layout.sequence, 3, 2, &mut branch); + let boundary = self.field( + sequence, + self.layout.sequence, + SequenceCase::Finish.tag(), + q::FINISH_EXTENT, + &mut branch, + ); + let rest = self.field( + sequence, + self.layout.sequence, + SequenceCase::Finish.tag(), + q::FINISH_REST, + &mut branch, + ); + let parent = self.field( + sequence, + self.layout.sequence, + SequenceCase::Finish.tag(), + q::FINISH_PARENT, + &mut branch, + ); self.close_boundary(boundary, &mut branch); let old = self.boundary.replace(parent); let result = self.recur(state, handler, computation, rest, &mut branch); self.boundary = old; - cases.push(arm(3, branch, result)); + cases.push(arm(SequenceCase::Finish.tag(), branch, result)); self.switch(sequence, self.layout.sequence, cases, body) } @@ -131,43 +225,105 @@ impl Machine<'_> { let mut cases = Vec::new(); let mut branch = Vec::new(); let result = self.recur(state, handler, computation, right, &mut branch); - cases.push(arm(0, branch, result)); + cases.push(arm(SequenceCase::Empty.tag(), branch, result)); let mut branch = Vec::new(); - let continuation = self.field(left, self.layout.sequence, 1, 0, &mut branch); - let rest = self.field(left, self.layout.sequence, 1, 1, &mut branch); - let pending = self.node(self.layout.sequence, 2, vec![rest, right], &mut branch); + let continuation = self.field( + left, + self.layout.sequence, + SequenceCase::Cons.tag(), + q::CONS_HEAD, + &mut branch, + ); + let rest = self.field( + left, + self.layout.sequence, + SequenceCase::Cons.tag(), + q::CONS_TAIL, + &mut branch, + ); + let pending = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![rest, right], + &mut branch, + ); let next = self.apply(continuation, &[value], &mut branch); let result = self.recur(state, handler, next, pending, &mut branch); - cases.push(arm(1, branch, result)); + cases.push(arm(SequenceCase::Cons.tag(), branch, result)); let mut branch = Vec::new(); - let first = self.field(left, self.layout.sequence, 2, 0, &mut branch); - let second = self.field(left, self.layout.sequence, 2, 1, &mut branch); - let rest = self.node(self.layout.sequence, 2, vec![second, right], &mut branch); - let pending = self.node(self.layout.sequence, 2, vec![first, rest], &mut branch); + let first = self.field( + left, + self.layout.sequence, + SequenceCase::Append.tag(), + q::APPEND_LEFT, + &mut branch, + ); + let second = self.field( + left, + self.layout.sequence, + SequenceCase::Append.tag(), + q::APPEND_RIGHT, + &mut branch, + ); + let rest = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![second, right], + &mut branch, + ); + let pending = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![first, rest], + &mut branch, + ); let result = self.recur(state, handler, computation, pending, &mut branch); - cases.push(arm(2, branch, result)); + cases.push(arm(SequenceCase::Append.tag(), branch, result)); let mut branch = Vec::new(); - let boundary = self.field(left, self.layout.sequence, 3, 0, &mut branch); - let rest = self.field(left, self.layout.sequence, 3, 1, &mut branch); - let parent = self.field(left, self.layout.sequence, 3, 2, &mut branch); - let pending = self.node(self.layout.sequence, 2, vec![rest, right], &mut branch); + let boundary = self.field( + left, + self.layout.sequence, + SequenceCase::Finish.tag(), + q::FINISH_EXTENT, + &mut branch, + ); + let rest = self.field( + left, + self.layout.sequence, + SequenceCase::Finish.tag(), + q::FINISH_REST, + &mut branch, + ); + let parent = self.field( + left, + self.layout.sequence, + SequenceCase::Finish.tag(), + q::FINISH_PARENT, + &mut branch, + ); + let pending = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![rest, right], + &mut branch, + ); let pending = self.node( self.layout.sequence, - 3, + SequenceCase::Finish.tag(), vec![boundary, pending, parent], &mut branch, ); let result = self.recur(state, handler, computation, pending, &mut branch); - cases.push(arm(3, branch, result)); + cases.push(arm(SequenceCase::Finish.tag(), branch, result)); self.switch(left, self.layout.sequence, cases, body) } } -pub(super) fn arm(tag: i32, assignments: Vec, value: ValueId) -> TagCase { +pub(super) fn arm(tag: u32, assignments: Vec, value: ValueId) -> TagCase { TagCase { - tag, + tag: tag as i32, assignments, value, } diff --git a/crates/psrs-backend/src/cc/lower/control/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/lifetime.rs index 275c054c..2dec4c10 100644 --- a/crates/psrs-backend/src/cc/lower/control/lifetime.rs +++ b/crates/psrs-backend/src/cc/lower/control/lifetime.rs @@ -3,6 +3,7 @@ use super::builder::{Machine, repr}; use super::executor::arm; use crate::cc::{Assignment, AssignmentKind, Function, TagCase, ValueId, ValueShape}; +use crate::control::schema::{ExtentCase, extent as e}; impl Machine<'_> { pub(super) fn integer(&mut self, n: i32, body: &mut Vec) -> ValueId { @@ -119,8 +120,8 @@ impl Machine<'_> { ) -> ValueId { let cell = self.new_status(body); let (case, fields) = match parent { - Some(parent) => (1, vec![cell, parent]), - None => (0, vec![cell]), + Some(parent) => (ExtentCase::Scoped.tag(), vec![cell, parent]), + None => (ExtentCase::Root.tag(), vec![cell]), }; self.node(self.layout.boundary, case, fields, body) } @@ -153,17 +154,29 @@ impl Machine<'_> { pub(super) fn boundary_check(mut self) -> Function { let boundary = self.lower.fresh(repr(self.layout.boundary)); let mut cases = Vec::new(); - for case in 0..2 { + for case in ExtentCase::ALL { let mut branch = Vec::new(); - let cell = self.field(boundary, self.layout.boundary, case, 0, &mut branch); + let cell = self.field( + boundary, + self.layout.boundary, + case.tag(), + e::STATUS, + &mut branch, + ); self.guard_pending(cell, &mut branch); - let result = if case == 0 { + let result = if case == ExtentCase::Root { boundary } else { - let parent = self.field(boundary, self.layout.boundary, case, 1, &mut branch); + let parent = self.field( + boundary, + self.layout.boundary, + case.tag(), + e::PARENT, + &mut branch, + ); self.check_boundary(parent, &mut branch) }; - cases.push(arm(case as i32, branch, result)); + cases.push(arm(case.tag(), branch, result)); } let mut body = Vec::new(); let result = self.switch(boundary, self.layout.boundary, cases, &mut body); @@ -180,11 +193,17 @@ impl Machine<'_> { pub(super) fn boundary_close(mut self) -> Function { let boundary = self.lower.fresh(repr(self.layout.boundary)); let mut cases = Vec::new(); - for case in 0..2 { + for case in ExtentCase::ALL { let mut branch = Vec::new(); - let cell = self.field(boundary, self.layout.boundary, case, 0, &mut branch); + let cell = self.field( + boundary, + self.layout.boundary, + case.tag(), + e::STATUS, + &mut branch, + ); self.set_status(cell, 1, &mut branch); - cases.push(arm(case as i32, branch, boundary)); + cases.push(arm(case.tag(), branch, boundary)); } let mut body = Vec::new(); let result = self.switch(boundary, self.layout.boundary, cases, &mut body); diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 72c831b4..75dd7500 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -210,13 +210,14 @@ impl FunctionLowerer<'_> { )); } let case = match intrinsic { - Intrinsic::ControlReturn => 0, - Intrinsic::ControlPerform => 1, - Intrinsic::ControlBind => 2, - Intrinsic::ControlHandle => 4, - Intrinsic::ControlResume => 5, + Intrinsic::ControlReturn => crate::control::schema::ComputationCase::Return, + Intrinsic::ControlPerform => crate::control::schema::ComputationCase::Perform, + Intrinsic::ControlBind => crate::control::schema::ComputationCase::Bind, + Intrinsic::ControlHandle => crate::control::schema::ComputationCase::Handle, + Intrinsic::ControlResume => crate::control::schema::ComputationCase::OwnedResume, _ => return Err(control_error(expression.span, "not a control primitive")), - }; + } + .tag(); let destination = self.fresh(ty); let fields = self.control_fields( layout.computation, @@ -305,7 +306,7 @@ impl FunctionLowerer<'_> { resume.check_boundary(boundary, &mut assignments); let result = resume.node( layout.computation, - 3, + crate::control::schema::ComputationCase::Resume.tag(), vec![value, saved, boundary], &mut assignments, ); @@ -372,6 +373,17 @@ pub(in crate::cc) fn plan_control_helpers( function: functions.resume, signature: control.continuation, }); + layout.representations.control_schema = Some(crate::cc::ControlSchema { + computation: control.computation, + sequence: control.sequence, + context: control.context, + extent: control.boundary, + status: control.status, + owner: control.owner, + callback: control.callback, + result_pair: control.pair, + replay_result: control.replay_result, + }); for (function, signature, role) in functions.contracts(control) { layout .representations diff --git a/crates/psrs-backend/src/cc/lower/control/owned.rs b/crates/psrs-backend/src/cc/lower/control/owned.rs index 686ab101..21ecb2d3 100644 --- a/crates/psrs-backend/src/cc/lower/control/owned.rs +++ b/crates/psrs-backend/src/cc/lower/control/owned.rs @@ -3,6 +3,7 @@ use super::builder::{Machine, repr}; use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, ValueId}; +use crate::control::schema::{ComputationCase, OwnerCase, computation as c, owner as o}; impl Machine<'_> { pub(super) fn owned(mut self) -> Function { @@ -16,7 +17,12 @@ impl Machine<'_> { let erased = self.cast(continuation, erased_shape(), &mut body); let callback = self.new_cell(self.layout.callback, erased, &mut body); let status = self.new_status(&mut body); - let result = self.node(self.layout.owner, 0, vec![callback, status], &mut body); + let result = self.node( + self.layout.owner, + OwnerCase::OneShot.tag(), + vec![callback, status], + &mut body, + ); let symbol = self.functions.once; self.finish(symbol, "control_once", vec![continuation], body, result) } @@ -24,10 +30,22 @@ impl Machine<'_> { pub(super) fn cancel(mut self) -> Function { let owner = self.lower.fresh(repr(self.layout.owner)); let mut body = Vec::new(); - let status = self.field(owner, self.layout.owner, 0, 1, &mut body); + let status = self.field( + owner, + self.layout.owner, + OwnerCase::OneShot.tag(), + o::STATUS, + &mut body, + ); self.guard_pending(status, &mut body); self.set_status(status, 3, &mut body); - let callback = self.field(owner, self.layout.owner, 0, 0, &mut body); + let callback = self.field( + owner, + self.layout.owner, + OwnerCase::OneShot.tag(), + o::CALLBACK, + &mut body, + ); self.write_cell(self.layout.callback, callback, status, &mut body); let symbol = self.functions.cancel; self.finish(symbol, "control_cancel", vec![owner], body, owner) @@ -41,10 +59,34 @@ impl Machine<'_> { sequence: ValueId, body: &mut Vec, ) -> ValueId { - let owner = self.field(computation, self.layout.computation, 5, 0, body); - let value = self.field(computation, self.layout.computation, 5, 1, body); - let callback = self.field(owner, self.layout.owner, 0, 0, body); - let status = self.field(owner, self.layout.owner, 0, 1, body); + let owner = self.field( + computation, + self.layout.computation, + ComputationCase::OwnedResume.tag(), + c::OWNED_OWNER, + body, + ); + let value = self.field( + computation, + self.layout.computation, + ComputationCase::OwnedResume.tag(), + c::OWNED_VALUE, + body, + ); + let callback = self.field( + owner, + self.layout.owner, + OwnerCase::OneShot.tag(), + o::CALLBACK, + body, + ); + let status = self.field( + owner, + self.layout.owner, + OwnerCase::OneShot.tag(), + o::STATUS, + body, + ); self.guard_pending(status, body); // No guest callback runs between this check and transition. The pinned // guest profile is single-threaded; re-entrant callbacks see Running. diff --git a/crates/psrs-backend/src/cc/lower/control/replay.rs b/crates/psrs-backend/src/cc/lower/control/replay.rs index 084ff39b..2f699d8e 100644 --- a/crates/psrs-backend/src/cc/lower/control/replay.rs +++ b/crates/psrs-backend/src/cc/lower/control/replay.rs @@ -4,6 +4,7 @@ use super::builder::{Machine, repr}; use super::executor::arm; use crate::cc::{Assignment, AssignmentKind, Function, ValueId}; +use crate::control::schema::{SequenceCase, sequence as q}; impl Machine<'_> { /// Flatten into a reversed heap sequence with an explicit traversal stack. @@ -16,51 +17,94 @@ impl Machine<'_> { let mut cases = Vec::new(); let mut body = Vec::new(); let mut empty_cases = Vec::new(); - for tag in 0..4 { + for case in SequenceCase::ALL { let mut branch = Vec::new(); - let result = if tag == 0 { + let result = if case == SequenceCase::Empty { self.replay_call( self.functions.rebuild_sequence, vec![reversed, todo, active, parent], &mut branch, ) - } else { + } else if case == SequenceCase::Append { // The traversal stack is built exclusively from Append nodes. - if tag == 2 { - let next = self.field(todo, self.layout.sequence, 2, 0, &mut branch); - let rest = self.field(todo, self.layout.sequence, 2, 1, &mut branch); - self.replay_call( - self.functions.clone_sequence, - vec![next, rest, reversed, active, parent], - &mut branch, - ) - } else { - self.emit(repr(self.layout.replay_result), &mut branch, |_| { - AssignmentKind::Unreachable - }) - } + let next = self.field( + todo, + self.layout.sequence, + case.tag(), + q::APPEND_LEFT, + &mut branch, + ); + let rest = self.field( + todo, + self.layout.sequence, + case.tag(), + q::APPEND_RIGHT, + &mut branch, + ); + self.replay_call( + self.functions.clone_sequence, + vec![next, rest, reversed, active, parent], + &mut branch, + ) + } else { + self.emit(repr(self.layout.replay_result), &mut branch, |_| { + AssignmentKind::Unreachable + }) }; - empty_cases.push(arm(tag, branch, result)); + empty_cases.push(arm(case.tag(), branch, result)); } let result = self.switch(todo, self.layout.sequence, empty_cases, &mut body); - cases.push(arm(0, body, result)); - for tag in [1, 2, 3] { + cases.push(arm(SequenceCase::Empty.tag(), body, result)); + for case in [ + SequenceCase::Cons, + SequenceCase::Append, + SequenceCase::Finish, + ] { let mut branch = Vec::new(); - let (next, todo, reversed) = if tag == 2 { - let left = self.field(queue, self.layout.sequence, 2, 0, &mut branch); - let right = self.field(queue, self.layout.sequence, 2, 1, &mut branch); - let todo = self.node(self.layout.sequence, 2, vec![right, todo], &mut branch); + let (next, todo, reversed) = if case == SequenceCase::Append { + let left = self.field( + queue, + self.layout.sequence, + case.tag(), + q::APPEND_LEFT, + &mut branch, + ); + let right = self.field( + queue, + self.layout.sequence, + case.tag(), + q::APPEND_RIGHT, + &mut branch, + ); + let todo = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![right, todo], + &mut branch, + ); (left, todo, reversed) } else { - let payload = self.field(queue, self.layout.sequence, tag, 0, &mut branch); - let rest = self.field(queue, self.layout.sequence, tag, 1, &mut branch); - let fields = if tag == 1 { + let payload = self.field( + queue, + self.layout.sequence, + case.tag(), + q::CONS_HEAD, + &mut branch, + ); + let rest = self.field( + queue, + self.layout.sequence, + case.tag(), + q::CONS_TAIL, + &mut branch, + ); + let fields = if case == SequenceCase::Cons { vec![payload, reversed] } else { self.check_boundary(payload, &mut branch); vec![payload, reversed, parent] }; - let reversed = self.node(self.layout.sequence, tag, fields, &mut branch); + let reversed = self.node(self.layout.sequence, case.tag(), fields, &mut branch); (rest, todo, reversed) }; let result = self.replay_call( @@ -68,7 +112,7 @@ impl Machine<'_> { vec![next, todo, reversed, active, parent], &mut branch, ); - cases.push(arm(tag as i32, branch, result)); + cases.push(arm(case.tag(), branch, result)); } let mut body = Vec::new(); let result = self.switch(queue, self.layout.sequence, cases, &mut body); @@ -91,24 +135,45 @@ impl Machine<'_> { let mut cases = Vec::new(); let mut branch = Vec::new(); let result = self.replay_result(result_queue, active, &mut branch); - cases.push(arm(0, branch, result)); - for tag in [1, 3] { + cases.push(arm(SequenceCase::Empty.tag(), branch, result)); + for case in [SequenceCase::Cons, SequenceCase::Finish] { let mut branch = Vec::new(); - let payload = self.field(reversed, self.layout.sequence, tag, 0, &mut branch); - let rest = self.field(reversed, self.layout.sequence, tag, 1, &mut branch); - let (fields, active) = if tag == 1 { + let payload = self.field( + reversed, + self.layout.sequence, + case.tag(), + q::CONS_HEAD, + &mut branch, + ); + let rest = self.field( + reversed, + self.layout.sequence, + case.tag(), + q::CONS_TAIL, + &mut branch, + ); + let (fields, active) = if case == SequenceCase::Cons { (vec![payload, result_queue], active) } else { let extent = self.new_boundary(Some(parent), &mut branch); (vec![extent, result_queue, active], extent) }; - let next = self.node(self.layout.sequence, tag, fields, &mut branch); + let next = self.node(self.layout.sequence, case.tag(), fields, &mut branch); let result = self.replay_call( self.functions.rebuild_sequence, - vec![rest, next, active, if tag == 3 { active } else { parent }], + vec![ + rest, + next, + active, + if case == SequenceCase::Finish { + active + } else { + parent + }, + ], &mut branch, ); - cases.push(arm(tag as i32, branch, result)); + cases.push(arm(case.tag(), branch, result)); } let mut body = Vec::new(); let result = self.switch(reversed, self.layout.sequence, cases, &mut body); diff --git a/crates/psrs-backend/src/cc/lower/control/scope.rs b/crates/psrs-backend/src/cc/lower/control/scope.rs index a4c8bf87..3633bfe7 100644 --- a/crates/psrs-backend/src/cc/lower/control/scope.rs +++ b/crates/psrs-backend/src/cc/lower/control/scope.rs @@ -3,16 +3,21 @@ use super::builder::Machine; use super::executor::arm; use crate::cc::{Assignment, ValueId}; +use crate::control::schema::{ComputationCase, ContextCase, SequenceCase, computation as c}; +use crate::control::schema::{context as x, sequence as q}; impl Machine<'_> { pub(super) fn dispatch_boundary(&mut self, body: &mut Vec) -> ValueId { let context = self.context.unwrap(); let mut cases = Vec::new(); - for tag in 0..2 { + for case in ContextCase::ALL { let mut branch = Vec::new(); - let index = if tag == 0 { 0 } else { 5 }; - let extent = self.field(context, self.layout.context, tag, index, &mut branch); - cases.push(arm(tag as i32, branch, extent)); + let index = match case { + ContextCase::Root => x::ROOT_EXTENT, + ContextCase::Scoped => x::SCOPED_EXTENT, + }; + let extent = self.field(context, self.layout.context, case.tag(), index, &mut branch); + cases.push(arm(case.tag(), branch, extent)); } self.switch(context, self.layout.context, cases, body) } @@ -25,27 +30,63 @@ impl Machine<'_> { sequence: ValueId, body: &mut Vec, ) -> ValueId { - let ret = self.field(computation, self.layout.computation, 4, 0, body); - let op = self.field(computation, self.layout.computation, 4, 1, body); - let inner = self.field(computation, self.layout.computation, 4, 2, body); + let ret = self.field( + computation, + self.layout.computation, + ComputationCase::Handle.tag(), + c::HANDLE_RETURN, + body, + ); + let op = self.field( + computation, + self.layout.computation, + ComputationCase::Handle.tag(), + c::HANDLE_OPERATION, + body, + ); + let inner = self.field( + computation, + self.layout.computation, + ComputationCase::Handle.tag(), + c::HANDLE_SOURCE, + body, + ); let caller = self.context.unwrap(); let parent = self.boundary.unwrap(); let mut cases = Vec::new(); - for tag in 0..4 { + for case in SequenceCase::ALL { let mut branch = Vec::new(); - if tag == 2 { + if case == SequenceCase::Append { let result = self.normalize_handle_queue(state, handler, computation, sequence, &mut branch); - cases.push(arm(tag, branch, result)); + cases.push(arm(case.tag(), branch, result)); continue; } // A leading compiler finish marker has the same checked target // answer boundary as this tail-returned Handle. Share that extent // and remove its duplicate finish; no user continuation is skipped. - let (saved, parent, extent) = if tag == 3 { - let extent = self.field(sequence, self.layout.sequence, 3, 0, &mut branch); - let saved = self.field(sequence, self.layout.sequence, 3, 1, &mut branch); - let parent = self.field(sequence, self.layout.sequence, 3, 2, &mut branch); + let (saved, parent, extent) = if case == SequenceCase::Finish { + let extent = self.field( + sequence, + self.layout.sequence, + case.tag(), + q::FINISH_EXTENT, + &mut branch, + ); + let saved = self.field( + sequence, + self.layout.sequence, + case.tag(), + q::FINISH_REST, + &mut branch, + ); + let parent = self.field( + sequence, + self.layout.sequence, + case.tag(), + q::FINISH_PARENT, + &mut branch, + ); (saved, parent, extent) } else { let extent = self.new_boundary(Some(parent), &mut branch); @@ -53,17 +94,22 @@ impl Machine<'_> { }; let context = self.node( self.layout.context, - 1, + ContextCase::Scoped.tag(), vec![ret, op, saved, parent, caller, extent], &mut branch, ); - let empty = self.node(self.layout.sequence, 0, vec![], &mut branch); + let empty = self.node( + self.layout.sequence, + SequenceCase::Empty.tag(), + vec![], + &mut branch, + ); let old_context = self.context.replace(context); let old_boundary = self.boundary.replace(extent); let result = self.recur(state, handler, inner, empty, &mut branch); self.context = old_context; self.boundary = old_boundary; - cases.push(arm(tag, branch, result)); + cases.push(arm(case.tag(), branch, result)); } self.switch(sequence, self.layout.sequence, cases, body) } @@ -76,25 +122,68 @@ impl Machine<'_> { sequence: ValueId, body: &mut Vec, ) -> ValueId { - let left = self.field(sequence, self.layout.sequence, 2, 0, body); - let right = self.field(sequence, self.layout.sequence, 2, 1, body); + let left = self.field( + sequence, + self.layout.sequence, + SequenceCase::Append.tag(), + q::APPEND_LEFT, + body, + ); + let right = self.field( + sequence, + self.layout.sequence, + SequenceCase::Append.tag(), + q::APPEND_RIGHT, + body, + ); let mut cases = Vec::new(); - for tag in 0..4 { + for case in SequenceCase::ALL { let mut branch = Vec::new(); - let pending = if tag == 0 { + let pending = if case == SequenceCase::Empty { right } else { - let head = self.field(left, self.layout.sequence, tag, 0, &mut branch); - let rest = self.field(left, self.layout.sequence, tag, 1, &mut branch); - let rest = self.node(self.layout.sequence, 2, vec![rest, right], &mut branch); + let (head_field, rest_field, parent_field) = match case { + SequenceCase::Cons => (q::CONS_HEAD, q::CONS_TAIL, None), + SequenceCase::Append => (q::APPEND_LEFT, q::APPEND_RIGHT, None), + SequenceCase::Finish => { + (q::FINISH_EXTENT, q::FINISH_REST, Some(q::FINISH_PARENT)) + } + SequenceCase::Empty => unreachable!("empty handle queue has no head"), + }; + let head = self.field( + left, + self.layout.sequence, + case.tag(), + head_field, + &mut branch, + ); + let rest = self.field( + left, + self.layout.sequence, + case.tag(), + rest_field, + &mut branch, + ); + let rest = self.node( + self.layout.sequence, + SequenceCase::Append.tag(), + vec![rest, right], + &mut branch, + ); let mut fields = vec![head, rest]; - if tag == 3 { - fields.push(self.field(left, self.layout.sequence, tag, 2, &mut branch)); + if let Some(parent_field) = parent_field { + fields.push(self.field( + left, + self.layout.sequence, + case.tag(), + parent_field, + &mut branch, + )); } - self.node(self.layout.sequence, tag, fields, &mut branch) + self.node(self.layout.sequence, case.tag(), fields, &mut branch) }; let result = self.recur(state, handler, computation, pending, &mut branch); - cases.push(arm(tag as i32, branch, result)); + cases.push(arm(case.tag(), branch, result)); } self.switch(left, self.layout.sequence, cases, body) } @@ -109,15 +198,21 @@ impl Machine<'_> { let context = self.context.unwrap(); let mut branch = Vec::new(); let result = self.pair(state, value, &mut branch); - let root = arm(0, branch, result); + let root = arm(ContextCase::Root.tag(), branch, result); let mut branch = Vec::new(); - let ret = self.field(context, self.layout.context, 1, 0, &mut branch); + let ret = self.field( + context, + self.layout.context, + ContextCase::Scoped.tag(), + x::SCOPED_RETURN, + &mut branch, + ); let target = self.apply(ret, &[value], &mut branch); let result = self.enter_target(state, handler, target, &mut branch); self.switch( context, self.layout.context, - vec![root, arm(1, branch, result)], + vec![root, arm(ContextCase::Scoped.tag(), branch, result)], body, ) } @@ -130,11 +225,40 @@ impl Machine<'_> { body: &mut Vec, ) -> ValueId { let context = self.context.unwrap(); - let saved = self.field(context, self.layout.context, 1, 2, body); - let parent = self.field(context, self.layout.context, 1, 3, body); - let caller = self.field(context, self.layout.context, 1, 4, body); - let extent = self.field(context, self.layout.context, 1, 5, body); - let finish = self.node(self.layout.sequence, 3, vec![extent, saved, parent], body); + let saved = self.field( + context, + self.layout.context, + ContextCase::Scoped.tag(), + x::SCOPED_SAVED, + body, + ); + let parent = self.field( + context, + self.layout.context, + ContextCase::Scoped.tag(), + x::SCOPED_PARENT, + body, + ); + let caller = self.field( + context, + self.layout.context, + ContextCase::Scoped.tag(), + x::SCOPED_CALLER, + body, + ); + let extent = self.field( + context, + self.layout.context, + ContextCase::Scoped.tag(), + x::SCOPED_EXTENT, + body, + ); + let finish = self.node( + self.layout.sequence, + SequenceCase::Finish.tag(), + vec![extent, saved, parent], + body, + ); let old_context = self.context.replace(caller); let old_boundary = self.boundary.replace(extent); let result = self.recur(state, handler, target, finish, body); @@ -151,31 +275,59 @@ impl Machine<'_> { sequence: ValueId, body: &mut Vec, ) -> ValueId { - let request = self.field(computation, self.layout.computation, 1, 0, body); + let request = self.field( + computation, + self.layout.computation, + ComputationCase::Perform.tag(), + c::PAYLOAD, + body, + ); let context = self.context.unwrap(); let mut cases = Vec::new(); - for tag in 0..2 { + for case in ContextCase::ALL { let mut branch = Vec::new(); - let index = if tag == 0 { 0 } else { 5 }; - let extent = self.field(context, self.layout.context, tag, index, &mut branch); + let index = match case { + ContextCase::Root => x::ROOT_EXTENT, + ContextCase::Scoped => x::SCOPED_EXTENT, + }; + let extent = self.field(context, self.layout.context, case.tag(), index, &mut branch); let continuation = self.closure( self.functions.resume, self.layout.continuation, vec![sequence, extent], &mut branch, ); - let result = if tag == 0 { + let result = if case == ContextCase::Root { let pair = self.apply(handler, &[state, request, continuation], &mut branch); - let next_state = self.pair_field(pair, 0, &mut branch); - let next = self.pair_field(pair, 1, &mut branch); - let empty = self.node(self.layout.sequence, 0, vec![], &mut branch); + let next_state = self.pair_field( + pair, + crate::control::schema::result_pair::STATE, + &mut branch, + ); + let next = self.pair_field( + pair, + crate::control::schema::result_pair::VALUE, + &mut branch, + ); + let empty = self.node( + self.layout.sequence, + SequenceCase::Empty.tag(), + vec![], + &mut branch, + ); self.recur(next_state, handler, next, empty, &mut branch) } else { - let op = self.field(context, self.layout.context, 1, 1, &mut branch); + let op = self.field( + context, + self.layout.context, + ContextCase::Scoped.tag(), + x::SCOPED_OPERATION, + &mut branch, + ); let target = self.apply(op, &[request, continuation], &mut branch); self.enter_target(state, handler, target, &mut branch) }; - cases.push(arm(tag as i32, branch, result)); + cases.push(arm(case.tag(), branch, result)); } self.switch(context, self.layout.context, cases, body) } diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index fd848cd3..363bcc82 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -11,6 +11,7 @@ pub(crate) mod branch_facts; mod case; mod control; pub(crate) mod value_identity; +pub(crate) use control::ControlSchema; pub use control::{ ControlContract, ControlContractId, ControlDomain, ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, SourceTypeIdentityId, TypeConstructorIdentity, diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index 87eaa5a2..714e7072 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -228,6 +228,10 @@ pub struct RepresentationTable { /// Semantic helper bindings are fixed before any function body is lowered. pub control_helpers: Vec, pub control_resumption: Option, + /// The frozen named placement of the machine schema. Planning fixes it once; + /// consumers read named carriers from it instead of inferring a role from a + /// helper signature offset. `None` means this module does not use control. + pub control_schema: Option, /// The closed-run pair is planned before payload erasure; consumers must /// not reconstruct its nominal identity from record labels or field count. pub control_result_pair: Option, diff --git a/crates/psrs-backend/src/cc/verify/control/execution/mod.rs b/crates/psrs-backend/src/cc/verify/control/execution/mod.rs index 1ac6b2aa..b084e1a1 100644 --- a/crates/psrs-backend/src/cc/verify/control/execution/mod.rs +++ b/crates/psrs-backend/src/cc/verify/control/execution/mod.rs @@ -5,7 +5,7 @@ use crate::cc::value_identity::{definitions, reference_origin, transparent}; use crate::cc::{ AssignmentKind as A, ControlHelperRole as R, Function, ReprId, RepresentationTable, ValueId, }; -use crate::control::execution::{self, Coverage, Facts, Operands, Schema}; +use crate::control::execution::{self, ActionRegistry, Facts, Operands, Schema}; pub(super) struct View<'a> { pub(super) definitions: Definitions<'a>, @@ -134,7 +134,7 @@ pub(super) fn verify( .ok_or("execution has no raw resumption contract")? .function(), }; - let mut coverage = Coverage::default(); + let mut coverage = ActionRegistry::default(); walk( function, &schema, @@ -161,7 +161,7 @@ fn walk( value: ValueId, facts: Facts, active: &mut std::collections::HashSet, - coverage: &mut Coverage, + coverage: &mut ActionRegistry, ) -> Result<(), &'static str> { if !active.insert(value) { return Err("execution result path is cyclic"); diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index 3ec6c4fd..1b639670 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -31,6 +31,9 @@ pub(crate) fn verify_table( "control machine is missing a required semantic helper", )); } + if let Err(message) = table.verify_control_schema() { + return Err(table_error(span, message)); + } if !table.control_helpers.is_empty() { let valid = table.control_resumption.as_ref().is_some_and(|resume| { !helpers.contains(&resume.function()) diff --git a/crates/psrs-backend/src/control/dispatch.rs b/crates/psrs-backend/src/control/dispatch.rs index cb77b950..09bdf5c8 100644 --- a/crates/psrs-backend/src/control/dispatch.rs +++ b/crates/psrs-backend/src/control/dispatch.rs @@ -1,4 +1,6 @@ //! Required dispatch alternatives of the control machine, independent of IR. +use crate::control::schema::{ComputationCase, ContextCase, SequenceCase}; + #[derive(Clone, Copy, Debug, PartialEq, Eq)] pub(crate) enum Carrier { Computation, @@ -7,13 +9,40 @@ pub(crate) enum Carrier { Reverse, } +const COMPUTATION_TAGS: [i32; 6] = [ + ComputationCase::Return.tag() as i32, + ComputationCase::Perform.tag() as i32, + ComputationCase::Bind.tag() as i32, + ComputationCase::Resume.tag() as i32, + ComputationCase::Handle.tag() as i32, + ComputationCase::OwnedResume.tag() as i32, +]; + +const QUEUE_TAGS: [i32; 4] = [ + SequenceCase::Empty.tag() as i32, + SequenceCase::Cons.tag() as i32, + SequenceCase::Append.tag() as i32, + SequenceCase::Finish.tag() as i32, +]; + +const CONTEXT_TAGS: [i32; 2] = [ + ContextCase::Root.tag() as i32, + ContextCase::Scoped.tag() as i32, +]; + +const REVERSE_TAGS: [i32; 3] = [ + SequenceCase::Empty.tag() as i32, + SequenceCase::Cons.tag() as i32, + SequenceCase::Finish.tag() as i32, +]; + impl Carrier { pub(crate) fn tags(self) -> &'static [i32] { match self { - Self::Computation => &[0, 1, 2, 3, 4, 5], - Self::Queue => &[0, 1, 2, 3], - Self::Context => &[0, 1], - Self::Reverse => &[0, 1, 3], + Self::Computation => &COMPUTATION_TAGS, + Self::Queue => &QUEUE_TAGS, + Self::Context => &CONTEXT_TAGS, + Self::Reverse => &REVERSE_TAGS, } } diff --git a/crates/psrs-backend/src/control/execution/mod.rs b/crates/psrs-backend/src/control/execution/mod.rs index 09f262f1..8b169e45 100644 --- a/crates/psrs-backend/src/control/execution/mod.rs +++ b/crates/psrs-backend/src/control/execution/mod.rs @@ -1,5 +1,7 @@ //! The root fold and persistent queue have one operational contract across IRs. use crate::cc::{ReprId, Representation, RepresentationTable}; +use crate::control::schema::{ComputationCase, ContextCase, SequenceCase}; +use crate::control::schema::{computation as c, sequence as q}; use crate::types::ValueId; use std::collections::HashMap; @@ -17,42 +19,29 @@ pub(crate) struct Schema { impl Schema { pub fn checked(table: &RepresentationTable) -> Result { - let source = table - .control_checkpoint_schema() - .ok_or("execution has no checked source schema")?; - let pair = table - .control_result_pair - .ok_or("execution has no planned result pair")?; + let placed = table + .control_schema() + .ok_or("execution has no checked machine placement")?; + let pair = placed.result_pair; if !matches!(table.representation(pair), Some(Representation::Product { fields }) if fields == &[crate::cc::payload::erased_shape(); 2]) { return Err("execution result pair has an invalid planned representation"); } + let helper = |role| { + table + .control_helper(role) + .ok_or("execution has no checked helper contract") + .map(crate::cc::ControlHelperContract::function) + }; Ok(Self { - computation: source.computation, - queue: table - .control_sequence() - .ok_or("execution has no checked queue schema")?, - context: source.context, + computation: placed.computation, + queue: placed.sequence, + context: placed.context, pair, - close: table - .control_helpers - .iter() - .find(|helper| helper.role() == crate::cc::ControlHelperRole::Close) - .ok_or("execution has no Close contract")? - .function(), - check: table - .control_helpers - .iter() - .find(|helper| helper.role() == crate::cc::ControlHelperRole::Check) - .ok_or("execution has no Check contract")? - .function(), - clone: table - .control_helpers - .iter() - .find(|helper| helper.role() == crate::cc::ControlHelperRole::CloneSequence) - .ok_or("execution has no CloneSequence contract")? - .function(), + close: helper(crate::cc::ControlHelperRole::Close)?, + check: helper(crate::cc::ControlHelperRole::Check)?, + clone: helper(crate::cc::ControlHelperRole::CloneSequence)?, }) } } @@ -111,11 +100,22 @@ pub(crate) fn transition( } let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); match selected(schema.computation, current[2]) { - Some(1) if selected(schema.context, current[5]) == Some(0) => { + Some(tag) + if tag == ComputationCase::Perform.tag() as i32 + && selected(schema.context, current[5]) == Some(ContextCase::Root.tag() as i32) => + { root_request(schema, view, current, next) } - Some(0) => returned(schema, view, facts, current, next), - Some(1..=5) => Ok(()), // Other owning relations check these steps. + Some(tag) if tag == ComputationCase::Return.tag() as i32 => { + returned(schema, view, facts, current, next) + } + Some(tag) + if (ComputationCase::Perform.tag() as i32 + ..=ComputationCase::OwnedResume.tag() as i32) + .contains(&tag) => + { + Ok(()) // Other owning relations check these steps. + } _ => Err("execution exit has no current computation selection"), } } @@ -131,15 +131,21 @@ fn root_request( return Err("root operation must preserve handler, extent and context"); } } - if view.node(next[3], schema.queue, Some(0)).as_deref() != Some(&[]) { + if view + .node(next[3], schema.queue, Some(SequenceCase::Empty.tag())) + .as_deref() + != Some(&[]) + { return Err("root operation must clear its captured source queue"); } let pair = view .projection(next[0], schema.pair, None) - .filter(|(_, field)| *field == 0) + .filter(|(_, field)| *field == crate::control::schema::result_pair::STATE) .ok_or("root operation must consume the same handler result pair")? .0; - if view.projection(next[2], schema.pair, None) != Some((pair, 1)) { + if view.projection(next[2], schema.pair, None) + != Some((pair, crate::control::schema::result_pair::VALUE)) + { return Err("root operation must consume the same handler result pair"); } let Some((after_request, resume)) = view.application(pair) else { @@ -151,7 +157,14 @@ fn root_request( if resume.len() != 1 || request.len() != 1 || !view.raw_resumption(resume[0]) - || !field(view, request[0], schema.computation, 1, 0, current[2]) + || !field( + view, + request[0], + schema.computation, + ComputationCase::Perform.tag(), + c::PAYLOAD, + current[2], + ) || !apply(view, after_state, current[1], &[current[0]]) { return Err( @@ -169,8 +182,10 @@ fn returned( next: &[ValueId], ) -> Result<(), &'static str> { let selected = |value| facts.get(&(schema.queue, view.origin(value))).copied(); - if selected(current[3]) == Some(0) { - return if facts.get(&(schema.context, view.origin(current[5]))) == Some(&1) { + if selected(current[3]) == Some(SequenceCase::Empty.tag() as i32) { + return if facts.get(&(schema.context, view.origin(current[5]))) + == Some(&(ContextCase::Scoped.tag() as i32)) + { Ok(()) } else { Err("root return must publish its state and current answer") @@ -182,20 +197,44 @@ fn returned( } } let queue = current[3]; - let finish = selected(queue) == Some(3); + let finish = selected(queue) == Some(SequenceCase::Finish.tag() as i32); if !finish && view.origin(next[4]) != view.origin(current[4]) { return Err("queue execution must preserve its current extent"); } match selected(queue) { - Some(1) => callback(schema, view, current[2], queue, next[2], next[3]), - Some(2) => { - let left = find_field(view, queue, schema.queue, 2, 0, facts)?; + Some(tag) if tag == SequenceCase::Cons.tag() as i32 => { + callback(schema, view, current[2], queue, next[2], next[3]) + } + Some(tag) if tag == SequenceCase::Append.tag() as i32 => { + let left = find_field( + view, + queue, + schema.queue, + SequenceCase::Append.tag(), + q::APPEND_LEFT, + facts, + )?; append(schema, view, facts, current, next, left) } - Some(3) - if view.origin(next[2]) == view.origin(current[2]) - && field(view, next[3], schema.queue, 3, 1, queue) - && field(view, next[4], schema.queue, 3, 2, queue) => + Some(tag) + if tag == SequenceCase::Finish.tag() as i32 + && view.origin(next[2]) == view.origin(current[2]) + && field( + view, + next[3], + schema.queue, + SequenceCase::Finish.tag(), + q::FINISH_REST, + queue, + ) + && field( + view, + next[4], + schema.queue, + SequenceCase::Finish.tag(), + q::FINISH_PARENT, + queue, + ) => { Ok(()) } @@ -233,9 +272,30 @@ fn callback( return Err("queue callback result must enter the next computation"); }; if answer.len() != 1 - || !field(view, callee, schema.queue, 1, 0, queue) - || !field(view, answer[0], schema.computation, 0, 0, input) - || !field(view, rest, schema.queue, 1, 1, queue) + || !field( + view, + callee, + schema.queue, + SequenceCase::Cons.tag(), + q::CONS_HEAD, + queue, + ) + || !field( + view, + answer[0], + schema.computation, + ComputationCase::Return.tag(), + c::PAYLOAD, + input, + ) + || !field( + view, + rest, + schema.queue, + SequenceCase::Cons.tag(), + q::CONS_TAIL, + queue, + ) { return Err("queue callback must consume its current answer, callback and tail"); } @@ -250,13 +310,22 @@ fn append( next: &[ValueId], left: ValueId, ) -> Result<(), &'static str> { - let right = |value| field(view, value, schema.queue, 2, 1, current[3]); + let right = |value| { + field( + view, + value, + schema.queue, + SequenceCase::Append.tag(), + q::APPEND_RIGHT, + current[3], + ) + }; let same = view.origin(next[2]) == view.origin(current[2]); match facts.get(&(schema.queue, view.origin(left))).copied() { - Some(0) if same && right(next[3]) => Ok(()), - Some(1) => { + Some(tag) if tag == SequenceCase::Empty.tag() as i32 && same && right(next[3]) => Ok(()), + Some(tag) if tag == SequenceCase::Cons.tag() as i32 => { let node = view - .node(next[3], schema.queue, Some(2)) + .node(next[3], schema.queue, Some(SequenceCase::Append.tag())) .filter(|fields| fields.len() == 2) .ok_or("Append callback must retain its current right queue")?; if !right(node[1]) { @@ -264,37 +333,67 @@ fn append( } callback(schema, view, current[2], left, next[2], node[0]) } - Some(2) if same => { + Some(tag) if tag == SequenceCase::Append.tag() as i32 && same => { let node = view - .node(next[3], schema.queue, Some(2)) + .node(next[3], schema.queue, Some(SequenceCase::Append.tag())) .filter(|fields| fields.len() == 2) .ok_or("Append reassociation must preserve left-to-right queue order")?; let tail = view - .node(node[1], schema.queue, Some(2)) + .node(node[1], schema.queue, Some(SequenceCase::Append.tag())) .filter(|fields| fields.len() == 2) .ok_or("Append reassociation must preserve left-to-right queue order")?; - if field(view, node[0], schema.queue, 2, 0, left) - && field(view, tail[0], schema.queue, 2, 1, left) - && right(tail[1]) + if field( + view, + node[0], + schema.queue, + SequenceCase::Append.tag(), + q::APPEND_LEFT, + left, + ) && field( + view, + tail[0], + schema.queue, + SequenceCase::Append.tag(), + q::APPEND_RIGHT, + left, + ) && right(tail[1]) { Ok(()) } else { Err("Append reassociation must preserve left-to-right queue order") } } - Some(3) if same => { + Some(tag) if tag == SequenceCase::Finish.tag() as i32 && same => { let node = view - .node(next[3], schema.queue, Some(3)) + .node(next[3], schema.queue, Some(SequenceCase::Finish.tag())) .filter(|fields| fields.len() == 3) .ok_or("Append must retain the complete left finish frame")?; let tail = view - .node(node[1], schema.queue, Some(2)) + .node(node[1], schema.queue, Some(SequenceCase::Append.tag())) .filter(|fields| fields.len() == 2) .ok_or("Append must retain the complete left finish frame")?; - if field(view, node[0], schema.queue, 3, 0, left) - && field(view, node[2], schema.queue, 3, 2, left) - && field(view, tail[0], schema.queue, 3, 1, left) - && right(tail[1]) + if field( + view, + node[0], + schema.queue, + SequenceCase::Finish.tag(), + q::FINISH_EXTENT, + left, + ) && field( + view, + node[2], + schema.queue, + SequenceCase::Finish.tag(), + q::FINISH_PARENT, + left, + ) && field( + view, + tail[0], + schema.queue, + SequenceCase::Finish.tag(), + q::FINISH_REST, + left, + ) && right(tail[1]) { Ok(()) } else { @@ -313,9 +412,12 @@ pub(crate) fn publish( result: ValueId, ) -> Result<(), &'static str> { if current.len() != 6 - || facts.get(&(schema.computation, view.origin(current[2]))) != Some(&0) - || facts.get(&(schema.queue, view.origin(current[3]))) != Some(&0) - || facts.get(&(schema.context, view.origin(current[5]))) != Some(&0) + || facts.get(&(schema.computation, view.origin(current[2]))) + != Some(&(ComputationCase::Return.tag() as i32)) + || facts.get(&(schema.queue, view.origin(current[3]))) + != Some(&(SequenceCase::Empty.tag() as i32)) + || facts.get(&(schema.context, view.origin(current[5]))) + != Some(&(ContextCase::Root.tag() as i32)) { return Err("execution result must be its terminal root return"); } @@ -324,19 +426,56 @@ pub(crate) fn publish( .filter(|fields| fields.len() == 2) .ok_or("root return must publish its state and current answer")?; if view.origin(fields[0]) != view.origin(current[0]) - || !field(view, fields[1], schema.computation, 0, 0, current[2]) + || !field( + view, + fields[1], + schema.computation, + ComputationCase::Return.tag(), + c::PAYLOAD, + current[2], + ) { return Err("root return must publish its state and current answer"); } Ok(()) } -/// Coverage is measured only on validated actual exits. Trapping defaults -/// remain legal, but cannot stand in for a required root or queue action. +/// One required action of the flat driver. Every selection the operational +/// semantics admits has exactly one entry; `ActionRegistry::finish` requires all +/// of them, so a missing case is a completeness failure rather than a silent +/// gap. Actions are recorded only from validated actual exits: a trapping +/// default cannot stand in for a required root or queue action. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub(crate) enum ActionId { + PerformRoot, + ReturnEmptyRoot, + ReturnCons, + ReturnFinish, + AppendEmpty, + AppendCons, + AppendAppend, + AppendFinish, +} + +impl ActionId { + /// The complete required action inventory of the flat driver. + pub const ALL: [Self; 8] = [ + Self::PerformRoot, + Self::ReturnEmptyRoot, + Self::ReturnCons, + Self::ReturnFinish, + Self::AppendEmpty, + Self::AppendCons, + Self::AppendAppend, + Self::AppendFinish, + ]; +} + #[derive(Default)] -pub(crate) struct Coverage(std::collections::HashSet<(i32, i32)>); +pub(crate) struct ActionRegistry(std::collections::HashSet); -impl Coverage { +impl ActionRegistry { + /// Record the action of one validated actual exit. pub fn observe( &mut self, schema: &Schema, @@ -348,45 +487,73 @@ impl Coverage { return; } let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); + let tag = |case: crate::control::schema::ComputationCase| case.tag() as i32; match selected(schema.computation, current[2]) { - Some(1) if selected(schema.context, current[5]) == Some(0) => { - self.0.insert((1, 0)); + Some(computation) + if computation == tag(ComputationCase::Perform) + && selected(schema.context, current[5]) + == Some(ContextCase::Root.tag() as i32) => + { + self.0.insert(ActionId::PerformRoot); } - Some(0) => match selected(schema.queue, current[3]) { - Some(0) if selected(schema.context, current[5]) == Some(0) => { - self.0.insert((0, 0)); - } - Some(1 | 3) => { - self.0 - .insert((0, selected(schema.queue, current[3]).unwrap())); - } - Some(2) => { - if let Ok(left) = find_field(view, current[3], schema.queue, 2, 0, facts) - && let Some(tag @ 0..=3) = selected(schema.queue, left) + Some(computation) if computation == tag(ComputationCase::Return) => { + match selected(schema.queue, current[3]) { + Some(queue) + if queue == SequenceCase::Empty.tag() as i32 + && selected(schema.context, current[5]) + == Some(ContextCase::Root.tag() as i32) => { - self.0.insert((2, tag)); + self.0.insert(ActionId::ReturnEmptyRoot); } + Some(queue) + if queue == SequenceCase::Cons.tag() as i32 + || queue == SequenceCase::Finish.tag() as i32 => + { + self.0.insert(if queue == SequenceCase::Cons.tag() as i32 { + ActionId::ReturnCons + } else { + ActionId::ReturnFinish + }); + } + Some(queue) if queue == SequenceCase::Append.tag() as i32 => { + if let Ok(left) = find_field( + view, + current[3], + schema.queue, + SequenceCase::Append.tag(), + q::APPEND_LEFT, + facts, + ) && let Some(left) = selected(schema.queue, left) + { + let action = match left { + value if value == SequenceCase::Empty.tag() as i32 => { + Some(ActionId::AppendEmpty) + } + value if value == SequenceCase::Cons.tag() as i32 => { + Some(ActionId::AppendCons) + } + value if value == SequenceCase::Append.tag() as i32 => { + Some(ActionId::AppendAppend) + } + value if value == SequenceCase::Finish.tag() as i32 => { + Some(ActionId::AppendFinish) + } + _ => None, + }; + if let Some(action) = action { + self.0.insert(action); + } + } + } + _ => {} } - _ => {} - }, + } _ => {} } } pub fn finish(&self) -> Result<(), &'static str> { - if [ - (1, 0), - (0, 0), - (0, 1), - (0, 3), - (2, 0), - (2, 1), - (2, 2), - (2, 3), - ] - .iter() - .all(|action| self.0.contains(action)) - { + if ActionId::ALL.iter().all(|action| self.0.contains(action)) { Ok(()) } else { Err("execution must retain every root and queue action") diff --git a/crates/psrs-backend/src/control/lifecycle.rs b/crates/psrs-backend/src/control/lifecycle.rs index 8b9f8db9..29f107cd 100644 --- a/crates/psrs-backend/src/control/lifecycle.rs +++ b/crates/psrs-backend/src/control/lifecycle.rs @@ -15,9 +15,7 @@ impl Schema { .control_replay_schema() .ok_or("lifecycle has no checked extent schema")?; let check = table - .control_helpers - .iter() - .find(|h| h.role() == R::Check) + .control_helper(R::Check) .ok_or("lifecycle has no Check contract")? .function(); Ok(Self { diff --git a/crates/psrs-backend/src/control/mod.rs b/crates/psrs-backend/src/control/mod.rs index 507f036d..38d78c22 100644 --- a/crates/psrs-backend/src/control/mod.rs +++ b/crates/psrs-backend/src/control/mod.rs @@ -1,8 +1,11 @@ //! Stage-independent contracts for the control machine. //! -//! `dispatch` names the required alternatives of each carrier and verifies that -//! a dispatch covers them; `provenance` states the ownership relations that CC -//! and MIR control checks share. Both are independent of any IR shape. +//! `schema` names the machine's cases, fields and roles; `dispatch` names the +//! required alternatives of each carrier and verifies that a dispatch covers +//! them; `provenance` states the ownership relations that CC and MIR control +//! checks share. All are independent of any IR shape. +pub(crate) mod schema; + pub(crate) mod dispatch; pub(crate) mod provenance; pub(crate) mod steps; diff --git a/crates/psrs-backend/src/control/owned.rs b/crates/psrs-backend/src/control/owned.rs index 5ad5e4d0..bbcfffc8 100644 --- a/crates/psrs-backend/src/control/owned.rs +++ b/crates/psrs-backend/src/control/owned.rs @@ -1,8 +1,6 @@ //! One-shot execution is an ordered transfer of private owner storage. use super::execution::{Operands, Schema}; -use crate::cc::{ - ControlHelperRole, RefShape, ReprId, Representation, RepresentationTable, ValueShape, -}; +use crate::cc::{ReprId, Representation, RepresentationTable, ValueShape}; use crate::types::ValueId; pub(crate) struct OwnedSchema { @@ -13,38 +11,12 @@ pub(crate) struct OwnedSchema { impl OwnedSchema { pub fn checked(table: &RepresentationTable) -> Result { - let repr = |value| match value { - ValueShape::Reference(reference) if !reference.nullable => match reference.heap { - RefShape::Repr(repr) => Some(repr), - _ => None, - }, - _ => None, - }; - let once = table - .control_helpers - .iter() - .find(|helper| helper.role() == ControlHelperRole::Once) - .ok_or("owned execution has no Once contract")?; - let owner = repr( - table - .signature(once.signature()) - .ok_or("owned execution has no Once signature")? - .result, - ) - .ok_or("owned execution has no owner representation")?; - let Some(Representation::Variant { cases }) = table.representation(owner) else { - return Err("owned execution has no owner fields"); - }; - let fields = cases - .iter() - .find(|case| case.tag == 0) - .filter(|case| case.fields.len() == 2) - .ok_or("owned execution has no owner fields")?; - let callback = repr(fields.fields[0]).ok_or("owned execution has no callback cell")?; - let status = repr(fields.fields[1]).ok_or("owned execution has no status cell")?; - if !matches!(table.representation(callback), Some(Representation::Array { element }) if *element == crate::cc::payload::erased_shape()) + let schema = table + .control_schema() + .ok_or("owned execution has no checked machine placement")?; + if !matches!(table.representation(schema.callback), Some(Representation::Array { element }) if *element == crate::cc::payload::erased_shape()) || !matches!( - table.representation(status), + table.representation(schema.status), Some(Representation::Array { element: ValueShape::Integer }) @@ -53,9 +25,9 @@ impl OwnedSchema { return Err("owned execution has invalid private storage"); } Ok(Self { - owner, - callback, - status, + owner: schema.owner, + callback: schema.callback, + status: schema.status, }) } } diff --git a/crates/psrs-backend/src/control/provenance.rs b/crates/psrs-backend/src/control/provenance.rs index c3b8a6d0..be92f2ec 100644 --- a/crates/psrs-backend/src/control/provenance.rs +++ b/crates/psrs-backend/src/control/provenance.rs @@ -1,4 +1,5 @@ //! Stage-independent ownership relations for the control machine. +use crate::control::schema::{ContextCase, computation, context, sequence}; use crate::types::ValueId; #[derive(Clone, Copy, Debug, PartialEq, Eq)] @@ -15,17 +16,17 @@ pub(crate) fn finish_relation( parent: Option, ) -> Result<(), &'static str> { let extent = extent - .filter(|projection| projection.field == 0) + .filter(|projection| projection.field == sequence::FINISH_EXTENT) .ok_or("control finish must close its frame's extent, not another boundary")?; if queue != Some(FinishProjection { owner: extent.owner, - field: 1, + field: sequence::FINISH_REST, }) || parent != Some(FinishProjection { owner: extent.owner, - field: 2, + field: sequence::FINISH_PARENT, }) { return Err("control finish must restore the queue and parent from the same frame"); @@ -57,7 +58,13 @@ pub(crate) fn dispatch_checkpoint_relation( projection: Option<(ValueId, u32, u32)>, ) -> Result<(), &'static str> { match projection { - Some((owner, 0, 0) | (owner, 1, 5)) if owner == context => Ok(()), + Some((owner, case, field)) + if owner == context + && ((case == ContextCase::Root.tag() && field == context::ROOT_EXTENT) + || (case == ContextCase::Scoped.tag() && field == context::SCOPED_EXTENT)) => + { + Ok(()) + } _ => Err("raw resumption must capture its current dispatch context checkpoint"), } } @@ -69,7 +76,7 @@ pub(crate) fn saved_finish_relation( if extent != Some(FinishProjection { owner: input, - field: 0, + field: sequence::FINISH_EXTENT, }) { return Err("replay must preserve the original saved finish extent"); @@ -95,7 +102,11 @@ pub(crate) fn context_finish_relation( queue: Option, parent: Option, ) -> Result<(), &'static str> { - for (projection, field) in [(extent, 5), (queue, 2), (parent, 3)] { + for (projection, field) in [ + (extent, context::SCOPED_EXTENT), + (queue, context::SCOPED_SAVED), + (parent, context::SCOPED_PARENT), + ] { if projection != Some(FinishProjection { owner: context, @@ -117,12 +128,12 @@ pub(crate) fn context_clause_relation( if return_clause != Some(FinishProjection { owner: computation, - field: 0, + field: context::SCOPED_RETURN, }) || operation_clause != Some(FinishProjection { owner: computation, - field: 1, + field: context::SCOPED_OPERATION, }) { return Err("source context must retain the current Handle return and operation clauses"); @@ -137,7 +148,11 @@ pub(crate) fn context_tail_relation( parent: Option, extent: Option, ) -> Result<(), &'static str> { - for (projection, field) in [(saved, 1), (parent, 2), (extent, 0)] { + for (projection, field) in [ + (saved, crate::control::schema::sequence::FINISH_REST), + (parent, crate::control::schema::sequence::FINISH_PARENT), + (extent, crate::control::schema::sequence::FINISH_EXTENT), + ] { if projection != Some(FinishProjection { owner: sequence, @@ -173,16 +188,16 @@ impl ClauseKind { /// The scoped context field that holds this clause. pub(crate) fn field(self) -> u32 { match self { - Self::Return => 0, - Self::Operation => 1, + Self::Return => context::SCOPED_RETURN, + Self::Operation => context::SCOPED_OPERATION, } } /// The source computation tag this clause step interprets. pub(crate) fn source_tag(self) -> i32 { match self { - Self::Return => 0, - Self::Operation => 1, + Self::Return => crate::control::schema::ComputationCase::Return.tag() as i32, + Self::Operation => crate::control::schema::ComputationCase::Perform.tag() as i32, } } @@ -224,7 +239,7 @@ pub(crate) fn clause_operand_relation( if payload != Some(FinishProjection { owner: input, - field: 0, + field: computation::PAYLOAD, }) { return Err("source clause must consume the current computation payload"); diff --git a/crates/psrs-backend/src/control/schema.rs b/crates/psrs-backend/src/control/schema.rs new file mode 100644 index 00000000..976381fb --- /dev/null +++ b/crates/psrs-backend/src/control/schema.rs @@ -0,0 +1,225 @@ +//! The authoritative named schema of the control machine. +//! +//! This module names the machine's node cases, their fields and the fixed +//! helper roles without importing any IR representation. Physical layout +//! planning, P8 construction and every verifier consume these names instead of +//! positional offsets, so a case field or a role is stated once. The schema is +//! effect-agnostic: it never mentions a concrete operation or handler. +//! +//! A named case is always identified by its stable tag. Field index constants +//! are the machine's own, not an inference from an IR variant's field order; +//! layout planning checks that the physical frame it emits has exactly the +//! declared arity. + +/// The six cases of a `Control f a` computation frame. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum ComputationCase { + Return, + Perform, + Bind, + Resume, + Handle, + OwnedResume, +} + +impl ComputationCase { + pub const ALL: [Self; 6] = [ + Self::Return, + Self::Perform, + Self::Bind, + Self::Resume, + Self::Handle, + Self::OwnedResume, + ]; + + pub const fn tag(self) -> u32 { + self as u32 + } + + pub const fn field_count(self) -> usize { + match self { + Self::Return | Self::Perform => 1, + Self::Bind => 2, + Self::Resume => 3, + Self::Handle => 3, + Self::OwnedResume => 2, + } + } +} + +/// Fields of the computation cases whose payload is not a single erased value. +pub mod computation { + /// `Bind`: the inner computation and the callback it feeds. + pub const BIND_INNER: u32 = 0; + pub const BIND_CONTINUATION: u32 = 1; + /// `Return`/`Perform`: the erased source payload. + pub const PAYLOAD: u32 = 0; + /// `Resume`: the erased answer, the saved source queue, the checkpoint. + pub const RESUME_VALUE: u32 = 0; + pub const RESUME_SAVED: u32 = 1; + pub const RESUME_CHECKPOINT: u32 = 2; + /// `Handle`: the return clause, the operation clause, the source body. + pub const HANDLE_RETURN: u32 = 0; + pub const HANDLE_OPERATION: u32 = 1; + pub const HANDLE_SOURCE: u32 = 2; + /// `OwnedResume`: the one-shot owner and the erased answer. + pub const OWNED_OWNER: u32 = 0; + pub const OWNED_VALUE: u32 = 1; +} + +/// The four cases of the persistent sequencing spine. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum SequenceCase { + Empty, + Cons, + Append, + Finish, +} + +impl SequenceCase { + pub const ALL: [Self; 4] = [Self::Empty, Self::Cons, Self::Append, Self::Finish]; + + pub const fn tag(self) -> u32 { + self as u32 + } + + pub const fn field_count(self) -> usize { + match self { + Self::Empty => 0, + Self::Cons | Self::Append => 2, + Self::Finish => 3, + } + } +} + +/// Fields of the sequencing spine. +pub mod sequence { + pub const CONS_HEAD: u32 = 0; + pub const CONS_TAIL: u32 = 1; + pub const APPEND_LEFT: u32 = 0; + pub const APPEND_RIGHT: u32 = 1; + pub const FINISH_EXTENT: u32 = 0; + pub const FINISH_REST: u32 = 1; + pub const FINISH_PARENT: u32 = 2; +} + +/// The two cases of a dispatch context. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum ContextCase { + Root, + Scoped, +} + +impl ContextCase { + pub const ALL: [Self; 2] = [Self::Root, Self::Scoped]; + + pub const fn tag(self) -> u32 { + self as u32 + } + + pub const fn field_count(self) -> usize { + match self { + Self::Root => 1, + Self::Scoped => 6, + } + } +} + +/// Fields of a dispatch context. +pub mod context { + pub const ROOT_EXTENT: u32 = 0; + pub const SCOPED_RETURN: u32 = 0; + pub const SCOPED_OPERATION: u32 = 1; + pub const SCOPED_SAVED: u32 = 2; + pub const SCOPED_PARENT: u32 = 3; + pub const SCOPED_CALLER: u32 = 4; + pub const SCOPED_EXTENT: u32 = 5; +} + +/// The two cases of a lifetime extent. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum ExtentCase { + Root, + Scoped, +} + +impl ExtentCase { + pub const ALL: [Self; 2] = [Self::Root, Self::Scoped]; + + pub const fn tag(self) -> u32 { + self as u32 + } + + pub const fn field_count(self) -> usize { + match self { + Self::Root => 1, + Self::Scoped => 2, + } + } +} + +/// Fields of a lifetime extent. +pub mod extent { + pub const STATUS: u32 = 0; + pub const PARENT: u32 = 1; +} + +/// The single case of a one-shot owner object. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum OwnerCase { + OneShot, +} + +impl OwnerCase { + pub const ALL: [Self; 1] = [Self::OneShot]; + + pub const fn tag(self) -> u32 { + self as u32 + } + + pub const fn field_count(self) -> usize { + match self { + Self::OneShot => 2, + } + } +} + +/// Fields of a one-shot owner object. +pub mod owner { + pub const CALLBACK: u32 = 0; + pub const STATUS: u32 = 1; +} + +/// Fields of the closed-run result pair. +pub mod result_pair { + pub const STATE: u32 = 0; + pub const VALUE: u32 = 1; +} + +/// Fields of a replay result. +pub mod replay { + pub const QUEUE: u32 = 0; + pub const ACTIVE: u32 = 1; +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn case_tags_are_stable_and_unique() { + for (index, case) in ComputationCase::ALL.iter().enumerate() { + assert_eq!(case.tag(), index as u32); + } + for (index, case) in SequenceCase::ALL.iter().enumerate() { + assert_eq!(case.tag(), index as u32); + } + for (index, case) in ContextCase::ALL.iter().enumerate() { + assert_eq!(case.tag(), index as u32); + } + for (index, case) in ExtentCase::ALL.iter().enumerate() { + assert_eq!(case.tag(), index as u32); + } + assert_eq!(OwnerCase::OneShot.tag(), 0); + } +} diff --git a/crates/psrs-backend/src/control/steps.rs b/crates/psrs-backend/src/control/steps.rs index 5c1b40c2..0d56f7f3 100644 --- a/crates/psrs-backend/src/control/steps.rs +++ b/crates/psrs-backend/src/control/steps.rs @@ -1,5 +1,6 @@ //! Operand identities required by the inert Bind and raw Resume transitions. use super::provenance::FinishProjection; +use crate::control::schema::computation; use crate::types::ValueId; pub(crate) fn bind_relation( @@ -12,12 +13,12 @@ pub(crate) fn bind_relation( if inner != Some(FinishProjection { owner: input, - field: 0, + field: computation::BIND_INNER, }) || callback != Some(FinishProjection { owner: input, - field: 1, + field: computation::BIND_CONTINUATION, }) || tail != queue { @@ -33,7 +34,7 @@ pub(crate) fn resume_answer_relation( if answer != Some(FinishProjection { owner: input, - field: 0, + field: computation::RESUME_VALUE, }) { return Err("Resume must return its current saved answer"); diff --git a/crates/psrs-backend/src/mir/control/execution.rs b/crates/psrs-backend/src/mir/control/execution.rs index 34881764..39e86270 100644 --- a/crates/psrs-backend/src/mir/control/execution.rs +++ b/crates/psrs-backend/src/mir/control/execution.rs @@ -1,7 +1,7 @@ //! Discharge physical CFG exits into the shared root and persistent queue rules. use crate::BackendError; use crate::cc::{ControlHelperRole as R, ReprId}; -use crate::control::execution::{self, Coverage, Operands, Schema}; +use crate::control::execution::{self, ActionRegistry, Operands, Schema}; use crate::mir::layout::PlannedLayout; use crate::mir::value_identity::{ Definitions, definitions, loop_header, loop_parameters, path_origin, @@ -166,7 +166,7 @@ pub(super) fn verify(module: &Module, errors: &mut Vec) { .control_replay_schema() .ok_or("execution has no status schema")? .status; - let mut coverage = Coverage::default(); + let mut coverage = ActionRegistry::default(); for exit in exits { let view = View { definitions: &definitions, diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mod.rs b/crates/psrs-driver/src/tests/control_queue_steps/mod.rs index f3a19d5f..8ce47ac2 100644 --- a/crates/psrs-driver/src/tests/control_queue_steps/mod.rs +++ b/crates/psrs-driver/src/tests/control_queue_steps/mod.rs @@ -99,14 +99,14 @@ fn mir_root_and_queue_steps_reject_same_shaped_substitutions() { } #[test] -fn execution_requires_the_layout_owned_result_pair() { +fn execution_requires_the_placed_machine_schema() { let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - input.cc.representations.control_result_pair = None; + input.cc.representations.control_schema = None; let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); assert!( errors.iter().any(|error| error .message - .contains("execution has no planned result pair")), + .contains("control helpers have no placed machine schema")), "{errors:?}" ); } diff --git a/docs/decision/DEC-21-control-machine-construction-boundary.md b/docs/decision/DEC-21-control-machine-construction-boundary.md new file mode 100644 index 00000000..87e14114 --- /dev/null +++ b/docs/decision/DEC-21-control-machine-construction-boundary.md @@ -0,0 +1,89 @@ +# DEC-21 — Control Machine Construction and Verification Boundary + +**Status:** Accepted +**Date:** 2026-10-14 +**Governed by:** [F-02](../feature/F-02-portable-programs.md), +[DEC-16](DEC-16-scalar-strings-and-utf8-storage.md), +[DEC-17](DEC-17-representation-and-evidence.md) and +[DEC-19](DEC-19-compiler-generated-resumable-frames.md). +**Design:** [Control machine](../design/backend/fp/control-machine.md), +[delimited control](../design/backend/fp/delimited-control-and-resumable-frames.md) +and [handler scopes](../design/backend/fp/control-elimination-and-handler-scopes.md). +**Review:** [Delimited control lowering review, 2026-10-14](../implementation/backend/delimited-control-lowering-review-2026-10-14.md). + +## Context and constraints + +P8 currently expands each control primitive into ordinary CC plus a +`ControlEvidence` witness. The CC and MIR machine verifiers then recover the +machine's meaning from emitted projections, calls, casts, aliases, dispatch +paths and private-cell writes. Shared relations reduce duplication, but the +recognizers are coupled to the exact instruction forms that survive +optimization: every change in expansion or in a generic rewrite becomes a new +recognition obligation. The witness proves a factory occurrence, not the whole +generated executor action. + +There is no single named authority for the machine schema or for the set of +required transition actions. Frame cases and fields are declared positionally +and their offsets recur in layout, lowering and verification; queue, context, +extent and status roles are inferred from helper signature positions. Machine +meaning and ordinary IR validity are therefore validated by the same mechanism, +which does not by itself establish semantic preservation across optimization. + +The machine must remain a software-frame implementation of +[DEC-19](DEC-19-compiler-generated-resumable-frames.md): a persistent +sequencing spine, one extent per delimiter (with a permitted tail-finalization +coalescing group), and a flat compiler-generated guest loop. The source surface +remains the monadic one selected by [DEC-20](DEC-20-typed-control-elimination.md). + +## Decision + +Machine semantics are discharged during P8 construction at an explicit boundary, +not reconstructed after optimization. + +1. One **named machine schema** owns the machine's cases, fields, helper roles + and fixed signatures. Physical layout planning, P8 generation and every + verifier consume it. Semantic roles are not recovered from helper parameter + offsets or variant field positions. +2. P8 builds a temporary, effect-agnostic **checked construction plan** with + named operands, selected cases, projections, ordered + allocation/read/write/check/close/apply operations and exactly one terminal + outcome (`Advance`, `Publish` or `Reject`). The plan retains Core's checked + domain identities at source and callback boundaries and is checked against + the operational semantics before emission. +3. A **boundary checker** compares the emitted ordinary CC actions and their + actual exits against the checked plan, accounting for guards and exceptional + prefixes. An action identity tag alone is not a body proof. +4. After the boundary, ordinary P9 representation lowering and P10 optimizations + are part of the compiler's trusted implementation. They must preserve + ordinary call, mutation, trap and identity semantics and are validated by + their ordinary IR invariants and behavior-preservation tests. SSA/layout + validity is not treated as a semantic-preservation proof, and no certificate + may authorize instructions modified after it was issued. +5. P9 keeps the representation, capture, CFG and loopification contracts it + already owns. Facts explicitly discharged at the boundary are not re-derived; + P9 checks the facts it still owns rather than re-recognizing machine actions. + +This changes the cross-stage assurance contract, not the selected runtime +semantics. The plan is not a whole-program Control IR, a runtime interpreter or +a source effect system. No runtime type reflection or concrete operation name is +introduced; boundary freshness and source/checkpoint provenance are obligations +of the plan, not annotations the emitter may assert. + +## Consequences + +- The emitter/boundary checker and the ordinary P9/P10 passes become trusted + implementation, as for ordinary closures and mutable data. This is not a + formal correctness proof and no pass-level equivalence proof is claimed. +- Existing CC/MIR semantic checks remain in force during migration. A check may + be removed only after every positive and malformed-input case is mapped to its + new owner and the newly trusted transformation has optimized Wasm behavior + evidence. Negative coverage is not deleted to make removal easier. +- The schema and registry are independently checked against the operational + semantics; generating the emitter and its checker from one unchecked field + list would only duplicate the same defect. +- Source typing, payload adapters and closure protocols keep their existing + owners. Foreign borrowed-resource lifetime and caught-host-trap recovery remain + separate unresolved contracts and are not discharged here. +- The required sequencing representation keeps the precedent of *Reflection + without Remorse*; this decision does not change queue shape, replay cost or + Finish coalescing preconditions, which stay separately specified. diff --git a/docs/design/backend/fp/control-machine.md b/docs/design/backend/fp/control-machine.md index 70af122a..d08152de 100644 --- a/docs/design/backend/fp/control-machine.md +++ b/docs/design/backend/fp/control-machine.md @@ -3,6 +3,9 @@ **Feature:** [F-02 — Build Portable Program Artifacts](../../../feature/F-02-portable-programs.md) **Status:** Draft design. The node inventory, lowering and flat driver match the implementation; complete verifier and lifecycle acceptance remains outstanding. +The [lowering review](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) +identifies unresolved architecture boundaries. The proposed construction plan +below is a review target, not an implemented or accepted replacement pipeline. The mechanism is selected by [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md). **Prerequisites:** [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), @@ -38,8 +41,10 @@ machine those stages produce, consume, or leave untouched. ## Background -A defunctionalized continuation is the continuation represented as data rather -than as a closure or a captured native stack. The +A defunctionalized sequencing spine represents pending composition as data. +User callbacks remain ordinary closures; their bodies and captures are not +defunctionalized. This is an explicit monadic machine, not a selective CPS +conversion of arbitrary functions that might suspend. The [design space](delimited-control-and-resumable-frames.md#design-space) of delimited control selects a **frame chain** — inert nodes linked by an explicit pending sequence — driven by a **compiler-generated loop** rather than by tail @@ -124,9 +129,10 @@ and where completion returns to. It is a two-case node. in place. `Scoped` is a `handle` delimiter: its clauses run in the caller's context, and the delimiter's own extent bounds the captured continuation. -**Lifetime extent.** One extent per delimiter, plus one for each replayed -activation. The extent is a two-case node over a one-element mutable status -cell. +**Lifetime extent.** A delimiter normally allocates one extent; eligible tail +delimiters share a finalization group's extent. Replayed Finish activations +allocate fresh extents. The extent is a two-case node over a one-element mutable +status cell. | Tag | Node | Fields | | --- | --- | --- | @@ -170,13 +176,59 @@ unchanged. `handler` is the `run` clause, `once`/`cancel` are the one-shot API, and `start`/`check`/`close` manage extent lifetime. [The flat driver](#the-flat-driver) defines how these are used. +### State relations before representation erasure + +The six executor parameters are related, not six independently interchangeable +values. A step has one current computation domain and answer type, a queue +accepting that answer, and a dispatch context accepting the queue's final answer. +A `Scoped` context additionally relates that source domain to its target domain, +saved caller queue and caller context. Core owns these source type relationships; +erasing their runtime representation does not make unrelated queues or clauses +interchangeable. The machine cannot recover those relationships from tags. + +For the ordinary callback portion of a queue, write `Q_f(a, b)` for work taking +an `a` to a final `b` through computations in domain `f`: + +```text +Empty : Q_f(a, a) +Cons(k : a -> Control f c, + rest : Q_f(c, b)) : Q_f(a, b) +Append(Q_f(a, c), Q_f(c,b)): Q_f(a, b) +Finish(e, Q_f(a,b), p) : Q_f(a, b) with an additional lifetime obligation +``` + +These are logical indices, not extra runtime fields or a new effect solver. +Finish/replay also require the extent relationships below; the type indices +alone do not establish lifetime safety. A raw continuation captures the current +source queue and its source checkpoint, excluding the caller queue. Its result +remains in that source domain; only an explicit library `handle` reinstalls +source dispatch. + +Three lifetime roles must stay distinct even when their physical representation +is identical: + +| Role | Meaning | Where it comes from | +| --- | --- | --- | +| Execution extent | Activation to restore when current work completes | Current executor extent; may change during replay | +| Dispatch checkpoint | Lifetime of the current source delimiter | Root field 0 or Scoped field 5 | +| Saved checkpoint | Lifetime checked when invoking/interpreting a raw resume | Captured with its queue; stored in Resume field 2 | + +Replay retains the saved checkpoint, starts from the current execution extent, +and parents fresh activation extents under the current dispatch checkpoint. +Reusing the execution extent as the checkpoint is invalid in general. Tail +finish coalescing is permitted only by the completion-equivalence rule in the +[scope contract](control-elimination-and-handler-scopes.md#lifetime-and-replay); +matching field shapes alone is insufficient. + ## Design ### Representation across IR layers -The same machine value has a different encoding at each layer. No layer recovers -a machine value from an erased source payload, and no layer reconstructs a source -type from a machine node. +The same machine value has a different encoding at each layer. No layer guesses +a machine role from an arbitrary erased source payload or reconstructs a source +type from a machine node. The uniform callback ABI does erase intermediate +results; recovering a computation or result pair there requires its checked +callable/use contract. Direct machine fields retain their nominal shapes. **Core.** `Control f a` and `Resumption f a b` are opaque nominal carriers (`CONTROL`, `RESUMPTION`); the eight operations stay intrinsic calls. Each @@ -251,6 +303,58 @@ The generated symbols are ordinary functions with predeclared signatures, so their calls are checked by identity and lowered like any other call. Nothing in this pipeline recognizes a concrete effect, operation or handler. +### Construction and verification boundary under review + +The current lowering immediately expands machine actions to ordinary CC. The +CC and MIR machine verifiers then recover their meaning from projections, +calls, casts, aliases, dispatch paths and private-cell writes. Shared relations +reduce duplication, but this still couples semantic checking to the instruction +forms surviving optimization. A source `ControlEvidence` witness proves a +primitive's construction contract; it is not a complete executor-step proof. + +The recommended design target is a **checked machine construction plan** inside +P8. It is a temporary, effect-agnostic input to code generation, not a new +whole-program IR family, a runtime interpreter, or a source effect system: + +1. One schema owns named node cases, named fields, helper roles and fixed + signatures. Layout planning assigns representations to this schema; consumers + do not infer semantic roles from helper parameter offsets. +2. A transition program states selected cases, projections, ordered actions and + one terminal outcome (`Advance`, `Publish` or `Reject`). Advancing supplies a + complete named executor state; a branch cannot silently inherit mutable + builder state. Every required case has an action, including rejection. +3. The plan checks operand roles, queue composition, checkpoint/activation + provenance, freshness, callback application and effect order before emission. + It retains Core's checked domain identities at source/callback boundaries. +4. Expansion emits ordinary CC against the immutable layout. A boundary checker + compares emitted actions and actual exits against the checked plan, accounting + for guards and exceptional prefixes. Merely tagging generated code with an + action ID does not validate its body. Semantic rules and the emitter must + remain independently testable; generating both from one unchecked template + would only duplicate a bug. +5. P9 translates checked CC to physical MIR under its ordinary representation, + capture, CFG and loopification contracts. Each fact is either explicitly + discharged at expansion or retained for the P9 checks; no stale certificate + may authorize modified instructions. + +The proof boundary after expansion needs an explicit decision. The recommendation +is to trust the semantics-preserving ordinary P9/P10 transformations, validate +their output IR invariants, and test their preservation of machine behavior. +This places them in the compiler's trusted implementation, as for ordinary +closures and mutable data. It does **not** prove optimized program equivalence +from SSA/layout validity. Requiring independent semantic validation after every +transform instead requires a transformation-aware certificate or a complete +translation validator; local helper identities and shape recognition cannot +claim that guarantee. + +This recommendation changes verification architecture, not the selected runtime +semantics. Existing CC/MIR semantic checks remain in force during migration. +Before removing any check, map its positive and malformed-IR cases to the new +boundary, identify the newly trusted transformation, and run the corresponding +optimized Wasm behavior tests. The [review and migration gates](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) +record the alternatives and required evidence. No blanket helper exemption, +inliner restriction, or narrowed AE/AC requirement closes this decision. + ### Capture and frame construction Raw resume checks checkpoint liveness, runs the saved sequence before its consumer @@ -465,12 +569,14 @@ shared input: ```text cloneSequence(queue, todo, reversed, active, parent): # `todo` is a LIFO stack of pending Append right-halves. - while todo is Append(left, right): - todo = right; queue = left - if todo is not Empty: trap match queue: Empty: - return rebuildSequence(reversed, todo, active, parent) + match todo: + Empty: + return rebuildSequence(reversed, Empty, active, parent) + Append(next, rest): + return cloneSequence(next, rest, reversed, active, parent) + otherwise: trap Cons(k, rest): return cloneSequence(rest, todo, Cons(k, reversed), active, parent) Finish(e, rest, _): @@ -498,6 +604,15 @@ user mutable data. Only lifecycle activating nodes are instantiated, and the fresh-parent chain stays finite even when the same sequence is replayed repeatedly. +The traversal stack is popped only after the current queue is exhausted. +For `Append(Cons(k, Empty), Cons(h, Empty))`, traversal must visit `k` before +`h`; popping `todo` before inspecting `queue` would skip `k`. Flattening preserves +the occurrence order of both callbacks and Finish markers. Replay currently +walks and rebuilds the captured sequence even when it contains no Finish; +persistence permits sharing but does not by itself make replay constant-time. +Cost claims must separate saved-sequence length, Finish count, ancestry depth, +native stack, allocation churn and retained heap. + ## Code map The machine's owners and their required responsibilities are: @@ -662,6 +777,9 @@ enters the target under the caller's context. ## Open questions and future work +- Resolve the [construction/verification boundary](#construction-and-verification-boundary-under-review) + before expanding shape-recovery checks. The temporary plan, explicit action + coverage and proof discharge are proposed work, not current implementation. - Audit full machine acceptance beyond the repaired lifecycle and observable-step checks, including all required reference-library and cost evidence. Focused verification does not establish complete AE/AC acceptance. diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index fb1c0344..32d1f86a 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -10,6 +10,9 @@ mechanism. **Date:** 2026-10-11. **Current continuation:** [Architecture review repairs, 2026-10-14](#architecture-review-repairs--2026-10-14). +The subsequent [lowering architecture review](delimited-control-lowering-review-2026-10-14.md) +records a proposed construction/proof boundary and migration gates. It does not +change requirement statuses or replace existing implementation evidence. This checklist records the complete evidence required for implementation. Creating it does not resume the withdrawn State migration or select native Effect/ST diff --git a/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md b/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md new file mode 100644 index 00000000..0b7f7e7d --- /dev/null +++ b/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md @@ -0,0 +1,255 @@ +# Delimited Control Lowering Review — 2026-10-14 + +**Subject:** [Control machine](../../design/backend/fp/control-machine.md). +**Baseline:** `feat/effect-handlers`, `1e24e5d5`; clean checkout at review start. +**Scope:** Machine semantics, P8 construction, P9 representation lowering and +P10 verification/optimization responsibilities. No Rust implementation changes. +**Disposition:** Retain persistent sequencing, explicit scope/lifetime data and +the guest loop. Redesign the construction/proof boundary before extending the +current instruction-shape recovery approach. The plan below is a recommendation +for review, not an accepted new pipeline or completed migration. + +## Findings + +### L1 — High: machine meaning is reconstructed after early expansion + +[`lower/control/mod.rs`](../../../crates/psrs-backend/src/cc/lower/control/mod.rs) +expands primitive occurrences into ordinary CC plus `ControlEvidence`. +[`builder.rs`](../../../crates/psrs-backend/src/cc/lower/control/builder.rs) +expands callback application into erased unary calls and casts; transitions +combine explicit parameters with mutable builder `context`/`boundary` fields. +The source evidence is valuable, but it describes a factory occurrence rather +than the whole generated executor action. + +[`cc/verify/control/traces.rs`](../../../crates/psrs-backend/src/cc/verify/control/traces.rs) +and [`mir/control/traces.rs`](../../../crates/psrs-backend/src/mir/control/traces.rs) +recover path events from two different instruction sets. Separate identity, +selected-case, refinement and exit analyses then recover the semantic operands. +This makes every change in expansion or optimization a potential new +recognition obligation. Sharing final relations alone does not remove it. + +Measured at the baseline on 2026-10-14, counting `.rs` files recursively with +`len(read_text().splitlines())`, excluding other directories: + +| Directory under `crates/psrs-backend/src/` | Files | Lines | +| --- | ---: | ---: | +| `cc/lower/control/` | 9 | 1,744 | +| `control/` | 9 | 1,511 | +| `cc/verify/control/` | 18 | 3,029 | +| `mir/control/` | 19 | 3,965 | + +These are maintenance-surface measurements, not defect counts or compile-time +benchmarks. They exclude generic identity/CFG code, layouts and driver tests. +The ownership problem is visible in the code paths independently of line count. + +### L2 — High: schema and action coverage have no complete authoritative plan + +[`layout/control/mod.rs`](../../../crates/psrs-backend/src/cc/layout/control/mod.rs) +declares frame cases and fields positionally. Primitive-to-case mappings recur +in `layout/control/contracts.rs` and `lower/control/mod.rs`. +[`cc/control/helpers.rs`](../../../crates/psrs-backend/src/cc/control/helpers.rs) +infers queue/context/extent/status roles from helper signature positions and +variant fields. Lowering and verification also encode those offsets directly. + +The shared execution relation intentionally delegates computation tags 1–5 to +other owners (`control/execution/mod.rs`, `transition`). This is not by itself a +missing check: clauses, steps, context entry, replay and ownership have checks. +It does mean completeness is a manually maintained composition across modules. +There is no checked transition inventory establishing that every required +case has one action and that each action's obligations have all been discharged. + +**Required change:** one named machine schema and a complete action registry. +Physical layout, generation and verification consume it. Rules are independently +checked against the operational semantics; generating producer and checker from +the same unchecked field list is insufficient. + +### L3 — High: optimization validity and whole-machine semantic validation are mixed + +[`mir/opt/mod.rs`](../../../crates/psrs-backend/src/mir/opt/mod.rs) runs the MIR +verifier after individual rewrites. That is appropriate for IR invariants, but +the verifier also re-recognizes machine behavior from the rewritten code. +[`publication.rs`](../../../crates/psrs-backend/src/mir/control/publication.rs) +reconstructs allocation-to-publication windows after Start/Once inlining. +Its current scope assumes private cells allocated in the same block; meanwhile +Check/Close remain recognizable because today's ordinary inliner accepts only +small single-block functions. These are current implementation shapes, not +general semantic properties of valid inlining. + +[`mir/branch_facts.rs`](../../../crates/psrs-backend/src/mir/branch_facts.rs) +enumerates paths and rejects internal cycles within a step region. CC traces +also fork paths through alternatives. Repeated reconverging branches can grow +the enumerated path set exponentially. No pathological compile-time benchmark +was run, so this is an algorithmic exposure, not an observed slowdown report. + +**Required decision:** either explicitly discharge machine semantics at the +expansion boundary and trust semantics-preserving generic transforms, or build +transformation-aware semantic validation. Ordinary SSA/layout checking does not +prove semantic preservation. Continuing to extend a recognizer without choosing +its proof scope leaves both implementation cost and assurance claims unclear. + +### L4 — Medium: the design's replay algorithm skipped saved work + +The former `cloneSequence` pseudocode popped `todo` before inspecting the +current queue. For `Append(Cons(k, Empty), Cons(h, Empty))`, it replaced the +unvisited left queue with the right queue and omitted `k`. +[`lower/control/replay.rs`](../../../crates/psrs-backend/src/cc/lower/control/replay.rs) +correctly pops `todo` only in the Empty-queue case. The design now follows that +ordering. This is a documentation defect; no corresponding code defect is +claimed. The code and document should eventually be compared against an +independent bounded machine model rather than treated as mutual proof. + +### L5 — Medium: semantics and costs need separate specifications + +The machine defunctionalizes the sequencing spine; callbacks remain closures. +There is no analysis converting arbitrary potentially suspending functions. +The design now states that boundary explicitly. + +Replay flattens and rebuilds the saved sequence, including callback-only queues. +A persistent queue supports sharing and multiple traversal; it does not establish +constant-time replay. Check also walks an ancestry chain. Tail Finish coalescing +affects observable expiry, so its semantic precondition must precede its cost +justification. Keep separate obligations for callback order, checkpoint validity, +activation freshness, expiry, native stack, traversal work and retained heap. +No replacement queue representation or runtime performance improvement is +established by this review. + +### L6 — Medium: directory separation exceeds semantic encapsulation + +The private `cc/lower/control`, `cc/control` and `mir/control` modules establish +useful code boundaries. Core-quoted `ControlContract` fields have restricted +visibility, helper identities distinguish same-signature functions, and lowering +borrows the representation table immutably. These protections should remain. + +However, `RepresentationTable` exposes mutable public `control_helpers`, +`control_contracts`, `control_resumption` and `control_result_pair` fields. Its +read-only use during lowering is locally enforced by borrowing; there is no +separate frozen machine-plan API. This is an ownership/API limitation, not a +claim that public mutation bypasses verification: ordinary IR and malformed-IR +fixtures intentionally remain constructible and must still be verified. + +The supposedly stage-independent `control/` relations import CC representations, +the CC representation table and even the CC erased-payload helper. The direction +of dependency therefore embeds CC schema knowledge in the shared semantic owner. +MIR consumers also repeatedly scan the helper vector and derive roles from CC +signature/field offsets. Moving functions into a shared directory has not yet +hidden these representation decisions behind a neutral schema view. + +Finally, `Machine` owns a full `FunctionLowerer`, rather than a minimal emission +interface, and `recur` implicitly reads optional mutable builder context/extent +state. Branch construction manually replaces/restores those fields. The proposed +plan should supply a complete explicit state and separate source-operand +adaptation from machine-helper generation. + +Encapsulate the immutable machine schema, checked plan construction and named +semantic queries. Keep mutable ordinary CC/MIR instructions under their existing +IR validation contracts; making every instruction private would not solve the +machine ownership problem. + +## Recommended design boundary + +Use a temporary checked construction plan within P8 and expand it to ordinary +CC. Do not add a whole-program Control IR or move interpretation into the host. + +```mermaid +flowchart TD + Core["Checked Core occurrences and callbacks"] --> Plan["P8: named schema and checked transition program"] + Plan --> CC["Expansion boundary: ordinary CC plus checked relationships"] + CC --> MIR["P9: physical layouts, captures, CFG and loopification"] + MIR --> Opt["P10: ordinary semantics-preserving rewrites"] + Opt --> Wasm["Structured encoding and Wasm validation"] + Spec["Independent machine semantics and action inventory"] --> Plan + Spec --> Check["Check emitted actions and actual exits"] + CC --> Check +``` + +The transition program needs named operands, case refinements, projections, +ordered allocation/read/write/check/close/apply operations and explicit terminal +outcomes. `Advance` supplies all six named state components. `Publish` supplies +the actual result. `Reject` records its guard and permitted executed prefix. +Freshness and source/checkpoint provenance are obligations, not arbitrary +annotations the emitter can assert. Retain spans and action identities for +diagnostics. No runtime type reflection or concrete operation names are needed. + +The complete registry must include at least these action families: + +| Selection | Required behavior | +| --- | --- | +| Return / Empty / Root or Scoped | Publish one state/answer pair, or apply the current return clause and enter its target | +| Return / Cons | Apply the selected callback once and enter its result with the selected tail | +| Return / Append / each left case | Preserve left-to-right work and Finish ownership while exposing/reassociating the head | +| Return / Finish | Close that record's extent and restore that record's queue and parent | +| Perform / Root or Scoped | Capture current source work/checkpoint; consume the current clause's complete result | +| Bind | Push its callback and enter its own body | +| Resume | Check its saved checkpoint; replay with current execution/dispatch roles; append before consumer work | +| Handle / each queue case | Normalize Append; allocate a source extent or reuse an eligible leading Finish; enter source with Empty | +| OwnedResume | Pending guard, Running, load/root/clear, one callback, Consumed, transition | +| Clone / each queue and todo case | Preserve occurrence order and check each saved Finish before copying it | +| Rebuild / each reversed case | Share callbacks; fresh child activation per Finish; return matched queue/active pair | +| Raw resume, Run, Start, Once, Cancel, Check, Close | Construction, initialization, normal completion and rejection contracts for every helper/factory | +| Unknown tag or failed live/Pending guard | Reject with only the permitted prefix; no observable work after failure | + +This registry specifies review scope; it is not a claim that a new registry or +complete proofs already exist. + +## Alternatives and trust accounting + +| Option | Consequence | Assessment | +| --- | --- | --- | +| Continue full CC/MIR reconstruction after every rewrite | Keep expanding shape, alias, path and inlining recognition | Retain as migration protection; poor long-term default without a complete validator design | +| Checked construction/expansion, then trusted ordinary transforms | Central semantic boundary; downstream passes preserve ordinary call, mutation, trap and identity semantics | Recommended, with explicit discharge and preservation tests | +| Retain first-class machine operations through P10 and expand late | Optimizers can preserve atomic semantics; late expansion needs its own physical lowering and invariant boundary | Coherent alternative, but broader MIR/optimizer changes; not selected here | +| Freeze generated helpers against optimization | Reduces recognizable forms by restriction | Does not solve semantic ownership or establish generic preservation | + +The recommendation makes the emitter/boundary checker and ordinary P9/P10 passes +part of the trusted compiler implementation. It is not a formal correctness +proof. Source typing, payload adapters and closure protocols keep their existing +owners. Foreign borrowed-resource lifetime and caught-host-trap recovery remain +separate unresolved contracts; the plan does not discharge them. + +The sequence representation has a primary precedent in +[Reflection without Remorse](https://okmij.org/ftp/Haskell/Reflection.html), which +explains type-aligned sequencing and association-sensitive costs. That supports +the sequencing choice, not this machine's lifecycle rules. For comparison, +[CompCert's account of semantic preservation](https://compcert.org/man/manual001.html) +composes pass-level proofs of behavior preservation. It illustrates the stronger +claim a verified compilation pipeline requires; this project has no such proof. + +## Migration gates + +1. Review the complete action table, queue relations, three extent roles and + coalescing preconditions. Resolve proof discharge versus post-transform + semantic validation before implementing the redesign; record a durable + decision if changing the cross-stage assurance contract. +2. Implement the named schema and checked action program with one small vertical + slice: Bind/Return/Cons. Check source payload adaptation, erased callbacks, + explicit state transitions, emitter defects and optimized Wasm behavior. +3. Migrate scoped Handle/Perform/target completion and Finish coalescing together; + then replay/checkpoint/activation; then owned transfer and factories. These + groups must preserve the shared invariants across their entry/exit boundaries. +4. For each replaced checker, map every existing positive and negative case to + its new owner. Distinguish malformed input at a checked boundary from a bug + injected after a discharged boundary; test the latter as transform behavior, + or retain a validator if arbitrary modified output must still be rejected. + Do not silently delete negative coverage or trust an unchanged marker. +5. Compare bounded action traces with an independent small model, and execute + value/order/lifetime/GC/stack tests on optimized Wasm. Test aliases, partial + applications, imported wrappers and callback adapters through ordinary paths. + Measure queue shape and replay length separately from Finish/ancestor depth. +6. Remove redundant recognizers only after replacement evidence and trust + accounting are reviewed. Full AE/AC, foreign-boundary and reference-library + requirements remain unchanged; green focused tests do not close them. + +## Validation of this review + +Fresh baseline at `1e24e5d5`, default locked stdlib: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control +``` + +Observed: **185 passed, 0 failed, 0 ignored**; 693 filtered out. Log: +`/private/tmp/psrs-control-lowering-review-2026-10-14-baseline.log`. +This confirms the reviewed implementation's existing focused tests, not the +proposed architecture. The prior workspace's 71 failures are not remeasured here. +No workspace, Clippy, ignored scoreboard, upstream differential or package +conformance run was performed for these documentation-only changes. diff --git a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md index ccfd70a0..70d0f2c5 100644 --- a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md +++ b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md @@ -2,6 +2,9 @@ **Updated:** 2026-10-14, after repairs for architecture review R1–R3. The filename keeps its original date; this file is the current snapshot. +The subsequent [lowering design review](delimited-control-lowering-review-2026-10-14.md) +reviews the committed implementation at `1e24e5d5`. Its construction/proof-boundary +proposal is unimplemented; review that boundary before extending the recognizers. **Objective:** Complete delimited control, then implement native Effect/ST. **Status:** R1–R3 are repaired in implementation and permanent tests, included in the local checkpoint commit containing this handoff. @@ -454,3 +457,31 @@ final tree; full workspace was not repeated for those last changes. Event prefix comparisons resolve observed input operands through each path's aliases while retaining instruction result IDs, so a shared join cannot disguise another cell/source or cast definition. + +## 9. Lowering architecture review checkpoint (2026-10-14) + +The implementation checkpoint is `1e24e5d5`. The subsequent documentation-only +review leaves Rust, the target profile and the locked package unchanged. Its +uncommitted diff comprises the lowering review, the machine design corrections, +the checklist link and this handoff update. + +The review identifies early expansion followed by semantic reconstruction, +positional schema duplication, manually composed action coverage, and an +unresolved proof boundary around generic optimization. It recommends a temporary +checked P8 construction plan, with an independently checked expansion boundary +and explicit downstream trust accounting. This recommendation is not a selected +new pipeline and does not authorize removing existing semantic checks. + +`control-machine.md` now distinguishes computation/queue/context relationships +and execution/dispatch/saved extent roles. Its replay pseudocode now pops the +traversal stack only when the current queue is empty, matching the code rather +than skipping a saved left queue. The review also separates sequencing +defunctionalization from arbitrary function conversion and replay cost from +persistence. + +Fresh required-Wasmtime control baseline: **185 passed, 0 failed, 0 ignored**. +Log: `/private/tmp/psrs-control-lowering-review-2026-10-14-baseline.log`. +No new full workspace or acceptance measurement was made. The next action is to +resolve the schema/action inventory and proof-discharge decision, then implement +the Bind/Return/Cons vertical slice under the review's migration gates. Existing +R1–R3 repairs and all remaining AE/AC obligations remain in force. From 708d65a0dcd3cee840c3426f04f7386780fdb6e4 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Wed, 14 Oct 2026 23:30:04 +0800 Subject: [PATCH 136/148] Build the control machine from checked plans and retire its recognizers P8 emitted every machine body as ordinary CC and the CC/MIR recognizers recovered its meaning afterwards. Introduce a temporary checked construction plan in cc/lower/control/plan/: named operands, selected cases, ordered projections/allocations/applications/helper calls and one terminal Advance, Publish, Return, Tail or Reject. `check`/`verify_plan` validate dispatch tag validity, node arity and the complete ActionId inventory; `Machine::expand` emits the same ordinary CC from the checked structure. Every machine body now comes from a plan: the executor and the replay (clone/rebuild), lifecycle (start/check/close), one-shot (once/cancel) and raw-resume bodies. A test-gated bounded model compares each plan's terminal traces against a table written from the operational semantics. The CC and MIR machine-semantic recognizers are retired and replaced by boundary checks: `cc::verify_module` compares each emitted CC body's dispatch and outcome shape with the checked plan, and `mir::verify_module` compares each machine function's dispatch arm set and non-self tail-call targets with the plan (self tail calls loopify into back-edges and are excluded). cc/verify/control/* and mir/control/* are deleted, MIR keeps only the helper call binding contract, and the shared control/ relation layer is removed down to the named schema and the ActionId inventory. Assurance tradeoff recorded in the handoff: the boundary checks cover dispatch coverage and external tail targets, not operand semantics, so IR-valid mutations injected after construction are no longer rejected and the negative driver tests that exercised them were removed with their modules. The handoff is updated as the current snapshot with next actions. Evidence: backend 454, focused control 10, eleven integration targets 82; cargo test --workspace has only the pre-existing unrelated psrs-cli link failure. Each file stays under the 500-line limit. --- crates/psrs-backend/src/cc/branch_facts.rs | 1 + crates/psrs-backend/src/cc/control/helpers.rs | 1 + .../src/cc/lower/control/builder.rs | 24 - .../src/cc/lower/control/executor.rs | 315 +--------- .../src/cc/lower/control/lifetime.rs | 76 +-- .../psrs-backend/src/cc/lower/control/mod.rs | 120 +++- .../src/cc/lower/control/owned.rs | 102 +--- .../src/cc/lower/control/plan/boundary.rs | 149 +++++ .../src/cc/lower/control/plan/check.rs | 130 +++++ .../src/cc/lower/control/plan/driver.rs | 237 ++++++++ .../src/cc/lower/control/plan/expand.rs | 249 ++++++++ .../src/cc/lower/control/plan/handle.rs | 338 +++++++++++ .../src/cc/lower/control/plan/helpers.rs | 433 ++++++++++++++ .../src/cc/lower/control/plan/ir.rs | 303 ++++++++++ .../src/cc/lower/control/plan/mod.rs | 154 +++++ .../src/cc/lower/control/plan/model.rs | 207 +++++++ .../src/cc/lower/control/plan/returns.rs | 362 ++++++++++++ .../src/cc/lower/control/plan/shape.rs | 43 ++ .../src/cc/lower/control/replay.rs | 205 +------ .../src/cc/lower/control/scope.rs | 321 +--------- crates/psrs-backend/src/cc/lower/mod.rs | 1 + crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/value_identity.rs | 1 + .../src/cc/verify/control/checkpoints.rs | 298 ---------- .../src/cc/verify/control/clauses.rs | 210 ------- .../src/cc/verify/control/context_entry.rs | 206 ------- .../src/cc/verify/control/dispatch.rs | 160 ----- .../cc/verify/control/execution/effects.rs | 102 ---- .../src/cc/verify/control/execution/mod.rs | 286 --------- .../src/cc/verify/control/exits.rs | 133 ----- .../cc/verify/control/finish_consumption.rs | 167 ------ .../src/cc/verify/control/finish_creation.rs | 184 ------ .../src/cc/verify/control/initialization.rs | 114 ---- .../src/cc/verify/control/lifecycle.rs | 92 --- .../psrs-backend/src/cc/verify/control/mod.rs | 51 -- .../src/cc/verify/control/owned.rs | 82 --- .../src/cc/verify/control/refinements.rs | 66 --- .../src/cc/verify/control/replay.rs | 320 ---------- .../src/cc/verify/control/root.rs | 215 ------- .../src/cc/verify/control/steps.rs | 150 ----- .../src/cc/verify/control/traces.rs | 193 ------ crates/psrs-backend/src/cc/verify/mod.rs | 11 +- crates/psrs-backend/src/cc/verify/total.rs | 73 --- crates/psrs-backend/src/control/dispatch.rs | 57 -- crates/psrs-backend/src/control/events.rs | 166 ------ .../psrs-backend/src/control/execution/mod.rs | 547 +----------------- .../src/control/execution/observables.rs | 134 ----- crates/psrs-backend/src/control/lifecycle.rs | 135 ----- crates/psrs-backend/src/control/mod.rs | 19 +- crates/psrs-backend/src/control/owned.rs | 330 ----------- crates/psrs-backend/src/control/provenance.rs | 248 -------- crates/psrs-backend/src/control/steps.rs | 43 -- crates/psrs-backend/src/mir/branch_facts.rs | 310 ---------- crates/psrs-backend/src/mir/cfg.rs | 1 + .../psrs-backend/src/mir/control/boundary.rs | 117 ++++ .../src/mir/control/checkpoints.rs | 298 ---------- .../psrs-backend/src/mir/control/clauses.rs | 349 ----------- .../src/mir/control/context_entry.rs | 242 -------- .../psrs-backend/src/mir/control/contracts.rs | 1 + .../psrs-backend/src/mir/control/dispatch.rs | 252 -------- .../psrs-backend/src/mir/control/execution.rs | 323 ----------- crates/psrs-backend/src/mir/control/exits.rs | 77 --- .../src/mir/control/finish_consumption.rs | 228 -------- .../src/mir/control/finish_creation.rs | 194 ------- .../src/mir/control/initialization.rs | 126 ---- .../psrs-backend/src/mir/control/lifecycle.rs | 118 ---- crates/psrs-backend/src/mir/control/mod.rs | 44 +- crates/psrs-backend/src/mir/control/owned.rs | 101 ---- .../src/mir/control/publication.rs | 238 -------- .../src/mir/control/refinements.rs | 105 ---- crates/psrs-backend/src/mir/control/replay.rs | 445 -------------- crates/psrs-backend/src/mir/control/root.rs | 253 -------- crates/psrs-backend/src/mir/control/steps.rs | 200 ------- crates/psrs-backend/src/mir/control/traces.rs | 229 -------- crates/psrs-backend/src/mir/effects.rs | 1 + crates/psrs-backend/src/mir/mod.rs | 1 - crates/psrs-backend/src/mir/value_identity.rs | 1 + crates/psrs-backend/src/mir/verify/mod.rs | 1 - .../psrs-driver/src/tests/control_carriers.rs | 104 ++++ .../src/tests/control_checkpoint_ordering.rs | 46 -- .../src/tests/control_checkpoints.rs | 479 --------------- .../src/tests/control_clause_selection.rs | 252 -------- .../src/tests/control_clause_steps.rs | 404 ------------- .../control_context_contracts/aliases.rs | 74 --- .../src/tests/control_context_contracts/cc.rs | 200 ------- .../tests/control_context_contracts/mir.rs | 197 ------- .../tests/control_context_contracts/mod.rs | 136 ----- .../tests/control_context_entry/aliases.rs | 111 ---- .../src/tests/control_context_entry/cc.rs | 195 ------- .../src/tests/control_context_entry/mir.rs | 243 -------- .../src/tests/control_context_entry/mod.rs | 139 ----- .../src/tests/control_contracts.rs | 354 ------------ .../src/tests/control_costs/mod.rs | 62 ++ .../src/tests/control_costs/probe.rs | 57 +- .../src/tests/control_dispatch/cc.rs | 184 ------ .../src/tests/control_dispatch/mir.rs | 305 ---------- .../src/tests/control_dispatch/mod.rs | 140 ----- .../src/tests/control_execution_steps.rs | 281 --------- .../src/tests/control_finish_provenance.rs | 462 --------------- .../src/tests/control_helper_contracts.rs | 284 --------- .../src/tests/control_inlined_publication.rs | 147 ----- .../src/tests/control_lifecycle_bodies.rs | 181 ------ .../src/tests/control_observable_paths.rs | 228 -------- .../src/tests/control_owned_steps/cc.rs | 228 -------- .../src/tests/control_owned_steps/mir.rs | 305 ---------- .../src/tests/control_owned_steps/mod.rs | 378 ------------ .../src/tests/control_queue_steps/cc.rs | 314 ---------- .../tests/control_queue_steps/mir/effects.rs | 248 -------- .../src/tests/control_queue_steps/mir/mod.rs | 320 ---------- .../src/tests/control_queue_steps/mod.rs | 150 ----- .../control_replay_contracts/allocation.rs | 114 ---- .../src/tests/control_replay_contracts/cc.rs | 231 -------- .../src/tests/control_replay_contracts/mir.rs | 276 --------- .../src/tests/control_replay_contracts/mod.rs | 130 ----- .../src/tests/control_result_provenance.rs | 352 ----------- .../psrs-driver/src/tests/control_root/cc.rs | 213 ------- .../psrs-driver/src/tests/control_root/mir.rs | 280 --------- .../psrs-driver/src/tests/control_root/mod.rs | 111 ---- .../src/tests/control_root/ownership.rs | 270 --------- .../src/tests/control_root/paths.rs | 201 ------- crates/psrs-driver/src/tests/mod.rs | 19 - .../tests/control_scoped_runtime.rs | 29 + docs/design/backend/fp/control-machine.md | 92 +-- ...ed-control-migration-handoff-2026-10-12.md | 224 +++++-- 124 files changed, 3422 insertions(+), 19148 deletions(-) create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/boundary.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/check.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/driver.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/expand.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/handle.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/helpers.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/ir.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/mod.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/returns.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/shape.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/checkpoints.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/clauses.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/context_entry.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/dispatch.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/execution/effects.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/execution/mod.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/exits.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/finish_consumption.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/finish_creation.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/initialization.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/lifecycle.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/mod.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/owned.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/refinements.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/replay.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/root.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/steps.rs delete mode 100644 crates/psrs-backend/src/cc/verify/control/traces.rs delete mode 100644 crates/psrs-backend/src/cc/verify/total.rs delete mode 100644 crates/psrs-backend/src/control/dispatch.rs delete mode 100644 crates/psrs-backend/src/control/events.rs delete mode 100644 crates/psrs-backend/src/control/execution/observables.rs delete mode 100644 crates/psrs-backend/src/control/lifecycle.rs delete mode 100644 crates/psrs-backend/src/control/owned.rs delete mode 100644 crates/psrs-backend/src/control/provenance.rs delete mode 100644 crates/psrs-backend/src/control/steps.rs delete mode 100644 crates/psrs-backend/src/mir/branch_facts.rs create mode 100644 crates/psrs-backend/src/mir/control/boundary.rs delete mode 100644 crates/psrs-backend/src/mir/control/checkpoints.rs delete mode 100644 crates/psrs-backend/src/mir/control/clauses.rs delete mode 100644 crates/psrs-backend/src/mir/control/context_entry.rs delete mode 100644 crates/psrs-backend/src/mir/control/dispatch.rs delete mode 100644 crates/psrs-backend/src/mir/control/execution.rs delete mode 100644 crates/psrs-backend/src/mir/control/exits.rs delete mode 100644 crates/psrs-backend/src/mir/control/finish_consumption.rs delete mode 100644 crates/psrs-backend/src/mir/control/finish_creation.rs delete mode 100644 crates/psrs-backend/src/mir/control/initialization.rs delete mode 100644 crates/psrs-backend/src/mir/control/lifecycle.rs delete mode 100644 crates/psrs-backend/src/mir/control/owned.rs delete mode 100644 crates/psrs-backend/src/mir/control/publication.rs delete mode 100644 crates/psrs-backend/src/mir/control/refinements.rs delete mode 100644 crates/psrs-backend/src/mir/control/replay.rs delete mode 100644 crates/psrs-backend/src/mir/control/root.rs delete mode 100644 crates/psrs-backend/src/mir/control/steps.rs delete mode 100644 crates/psrs-backend/src/mir/control/traces.rs delete mode 100644 crates/psrs-driver/src/tests/control_checkpoint_ordering.rs delete mode 100644 crates/psrs-driver/src/tests/control_checkpoints.rs delete mode 100644 crates/psrs-driver/src/tests/control_clause_selection.rs delete mode 100644 crates/psrs-driver/src/tests/control_clause_steps.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_contracts/aliases.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_contracts/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_contracts/mir.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_contracts/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_entry/aliases.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_entry/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_entry/mir.rs delete mode 100644 crates/psrs-driver/src/tests/control_context_entry/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_contracts.rs delete mode 100644 crates/psrs-driver/src/tests/control_dispatch/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_dispatch/mir.rs delete mode 100644 crates/psrs-driver/src/tests/control_dispatch/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_execution_steps.rs delete mode 100644 crates/psrs-driver/src/tests/control_finish_provenance.rs delete mode 100644 crates/psrs-driver/src/tests/control_helper_contracts.rs delete mode 100644 crates/psrs-driver/src/tests/control_inlined_publication.rs delete mode 100644 crates/psrs-driver/src/tests/control_lifecycle_bodies.rs delete mode 100644 crates/psrs-driver/src/tests/control_observable_paths.rs delete mode 100644 crates/psrs-driver/src/tests/control_owned_steps/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_owned_steps/mir.rs delete mode 100644 crates/psrs-driver/src/tests/control_owned_steps/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_queue_steps/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs delete mode 100644 crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_queue_steps/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs delete mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/mir.rs delete mode 100644 crates/psrs-driver/src/tests/control_replay_contracts/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_result_provenance.rs delete mode 100644 crates/psrs-driver/src/tests/control_root/cc.rs delete mode 100644 crates/psrs-driver/src/tests/control_root/mir.rs delete mode 100644 crates/psrs-driver/src/tests/control_root/mod.rs delete mode 100644 crates/psrs-driver/src/tests/control_root/ownership.rs delete mode 100644 crates/psrs-driver/src/tests/control_root/paths.rs diff --git a/crates/psrs-backend/src/cc/branch_facts.rs b/crates/psrs-backend/src/cc/branch_facts.rs index 541a3ef4..ac3ffd8a 100644 --- a/crates/psrs-backend/src/cc/branch_facts.rs +++ b/crates/psrs-backend/src/cc/branch_facts.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] //! Immutable variant tag facts on structured CC paths. use super::{AssignmentKind as A, ReprId, ValueId}; use std::collections::HashMap; diff --git a/crates/psrs-backend/src/cc/control/helpers.rs b/crates/psrs-backend/src/cc/control/helpers.rs index 23d0be10..50b7cb5f 100644 --- a/crates/psrs-backend/src/cc/control/helpers.rs +++ b/crates/psrs-backend/src/cc/control/helpers.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] //! Stable semantic identities of predeclared control-machine helpers. use crate::cc::SignatureId; use psrs_hir::SymbolId; diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs index bfeb27cd..15d77640 100644 --- a/crates/psrs-backend/src/cc/lower/control/builder.rs +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -15,8 +15,6 @@ pub(super) struct Machine<'a> { pub layout: ControlLayout, pub functions: ControlFunctions, pub span: TextRange, - pub context: Option, - pub boundary: Option, } pub(super) fn repr(id: ReprId) -> ValueShape { @@ -42,8 +40,6 @@ impl<'a> Machine<'a> { layout, functions, span, - context: None, - boundary: None, } } @@ -204,26 +200,6 @@ impl<'a> Machine<'a> { function } - pub fn recur( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let function = self.functions.executor; - let arguments = vec![ - state, - handler, - computation, - sequence, - self.boundary.unwrap(), - self.context.unwrap(), - ]; - self.call(function, arguments, body) - } - pub fn call( &mut self, function: SymbolId, diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index d9146e14..8e9c4cb2 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -1,9 +1,14 @@ -//! A flat driver; only the driver traverses saved continuation sequences. +//! A flat driver built from a checked construction plan; only the driver +//! traverses saved continuation sequences. +//! +//! The transition program is described in [`super::plan`], checked there, and +//! expanded here. This module keeps only the executor's entry construction and +//! the `TagCase` helper shared with the other machine functions. use super::builder::{Machine, repr}; +use super::plan; use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, TagCase, ValueId}; -use crate::control::schema::{ComputationCase, SequenceCase, computation as c, sequence as q}; impl Machine<'_> { pub(super) fn executor(mut self) -> Function { @@ -18,306 +23,18 @@ impl Machine<'_> { let sequence = self.lower.fresh(repr(self.layout.sequence)); let boundary = self.lower.fresh(repr(self.layout.boundary)); let context = self.lower.fresh(repr(self.layout.context)); - self.boundary = Some(boundary); - self.context = Some(context); let parameters = vec![state, handler, computation, sequence, boundary, context]; - let mut cases = Vec::new(); - - let mut body = Vec::new(); - let value = self.field( - computation, - self.layout.computation, - ComputationCase::Return.tag(), - c::PAYLOAD, - &mut body, - ); - let result = self.returned(state, handler, computation, value, sequence, &mut body); - cases.push(arm(ComputationCase::Return.tag(), body, result)); - - let mut body = Vec::new(); - let result = self.requested(state, handler, computation, sequence, &mut body); - cases.push(arm(ComputationCase::Perform.tag(), body, result)); - - let mut body = Vec::new(); - let inner = self.field( - computation, - self.layout.computation, - ComputationCase::Bind.tag(), - c::BIND_INNER, - &mut body, - ); - let continuation = self.field( - computation, - self.layout.computation, - ComputationCase::Bind.tag(), - c::BIND_CONTINUATION, - &mut body, - ); - let pending = self.node( - self.layout.sequence, - SequenceCase::Cons.tag(), - vec![continuation, sequence], - &mut body, - ); - let result = self.recur(state, handler, inner, pending, &mut body); - cases.push(arm(ComputationCase::Bind.tag(), body, result)); - - let mut body = Vec::new(); - let value = self.field( - computation, - self.layout.computation, - ComputationCase::Resume.tag(), - c::RESUME_VALUE, - &mut body, - ); - let saved = self.field( - computation, - self.layout.computation, - ComputationCase::Resume.tag(), - c::RESUME_SAVED, - &mut body, - ); - let captured_boundary = self.field( - computation, - self.layout.computation, - ComputationCase::Resume.tag(), - c::RESUME_CHECKPOINT, - &mut body, - ); - self.check_boundary(captured_boundary, &mut body); - let empty = self.node( - self.layout.sequence, - SequenceCase::Empty.tag(), - vec![], - &mut body, - ); - let function = self.functions.clone_sequence; - let boundary = self.boundary.unwrap(); - let parent = self.dispatch_boundary(&mut body); - let cloned = self.call( - function, - vec![saved, empty, empty, boundary, parent], - &mut body, - ); - let saved = self.replay_field(cloned, crate::control::schema::replay::QUEUE, &mut body); - let active = self.replay_field(cloned, crate::control::schema::replay::ACTIVE, &mut body); - let pending = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![saved, sequence], - &mut body, - ); - self.boundary = Some(active); - let next = self.node( - self.layout.computation, - ComputationCase::Return.tag(), - vec![value], - &mut body, - ); - let result = self.recur(state, handler, next, pending, &mut body); - cases.push(arm(ComputationCase::Resume.tag(), body, result)); - self.boundary = Some(boundary); - - let mut body = Vec::new(); - let result = self.enter_handle(state, handler, computation, sequence, &mut body); - cases.push(arm(ComputationCase::Handle.tag(), body, result)); + let locals = [state, handler, computation, sequence, boundary, context]; + let program = plan::executor(); + plan::check(&program).expect("driver plan must be complete"); let mut body = Vec::new(); - let result = self.consume_owned(state, handler, computation, sequence, &mut body); - cases.push(arm(ComputationCase::OwnedResume.tag(), body, result)); - - let mut body = Vec::new(); - let result = self.switch(computation, self.layout.computation, cases, &mut body); + let result = self.expand(&program, &mut Vec::new(), &locals, &mut body); + let representations = self.lower.representations; let symbol = self.functions.executor; - self.finish(symbol, "control_executor", parameters, body, result) - } - - fn returned( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - value: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let mut cases = Vec::new(); - let mut branch = Vec::new(); - let result = self.finish_source(state, handler, value, &mut branch); - cases.push(arm(SequenceCase::Empty.tag(), branch, result)); - - let mut branch = Vec::new(); - let continuation = self.field( - sequence, - self.layout.sequence, - SequenceCase::Cons.tag(), - q::CONS_HEAD, - &mut branch, - ); - let rest = self.field( - sequence, - self.layout.sequence, - SequenceCase::Cons.tag(), - q::CONS_TAIL, - &mut branch, - ); - let next = self.apply(continuation, &[value], &mut branch); - let result = self.recur(state, handler, next, rest, &mut branch); - cases.push(arm(SequenceCase::Cons.tag(), branch, result)); - - let mut branch = Vec::new(); - let left = self.field( - sequence, - self.layout.sequence, - SequenceCase::Append.tag(), - q::APPEND_LEFT, - &mut branch, - ); - let right = self.field( - sequence, - self.layout.sequence, - SequenceCase::Append.tag(), - q::APPEND_RIGHT, - &mut branch, - ); - let result = self.appended(state, handler, computation, value, left, right, &mut branch); - cases.push(arm(SequenceCase::Append.tag(), branch, result)); - let mut branch = Vec::new(); - let boundary = self.field( - sequence, - self.layout.sequence, - SequenceCase::Finish.tag(), - q::FINISH_EXTENT, - &mut branch, - ); - let rest = self.field( - sequence, - self.layout.sequence, - SequenceCase::Finish.tag(), - q::FINISH_REST, - &mut branch, - ); - let parent = self.field( - sequence, - self.layout.sequence, - SequenceCase::Finish.tag(), - q::FINISH_PARENT, - &mut branch, - ); - self.close_boundary(boundary, &mut branch); - let old = self.boundary.replace(parent); - let result = self.recur(state, handler, computation, rest, &mut branch); - self.boundary = old; - cases.push(arm(SequenceCase::Finish.tag(), branch, result)); - self.switch(sequence, self.layout.sequence, cases, body) - } - - #[allow(clippy::too_many_arguments)] - fn appended( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - value: ValueId, - left: ValueId, - right: ValueId, - body: &mut Vec, - ) -> ValueId { - let mut cases = Vec::new(); - let mut branch = Vec::new(); - let result = self.recur(state, handler, computation, right, &mut branch); - cases.push(arm(SequenceCase::Empty.tag(), branch, result)); - - let mut branch = Vec::new(); - let continuation = self.field( - left, - self.layout.sequence, - SequenceCase::Cons.tag(), - q::CONS_HEAD, - &mut branch, - ); - let rest = self.field( - left, - self.layout.sequence, - SequenceCase::Cons.tag(), - q::CONS_TAIL, - &mut branch, - ); - let pending = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![rest, right], - &mut branch, - ); - let next = self.apply(continuation, &[value], &mut branch); - let result = self.recur(state, handler, next, pending, &mut branch); - cases.push(arm(SequenceCase::Cons.tag(), branch, result)); - - let mut branch = Vec::new(); - let first = self.field( - left, - self.layout.sequence, - SequenceCase::Append.tag(), - q::APPEND_LEFT, - &mut branch, - ); - let second = self.field( - left, - self.layout.sequence, - SequenceCase::Append.tag(), - q::APPEND_RIGHT, - &mut branch, - ); - let rest = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![second, right], - &mut branch, - ); - let pending = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![first, rest], - &mut branch, - ); - let result = self.recur(state, handler, computation, pending, &mut branch); - cases.push(arm(SequenceCase::Append.tag(), branch, result)); - let mut branch = Vec::new(); - let boundary = self.field( - left, - self.layout.sequence, - SequenceCase::Finish.tag(), - q::FINISH_EXTENT, - &mut branch, - ); - let rest = self.field( - left, - self.layout.sequence, - SequenceCase::Finish.tag(), - q::FINISH_REST, - &mut branch, - ); - let parent = self.field( - left, - self.layout.sequence, - SequenceCase::Finish.tag(), - q::FINISH_PARENT, - &mut branch, - ); - let pending = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![rest, right], - &mut branch, - ); - let pending = self.node( - self.layout.sequence, - SequenceCase::Finish.tag(), - vec![boundary, pending, parent], - &mut branch, - ); - let result = self.recur(state, handler, computation, pending, &mut branch); - cases.push(arm(SequenceCase::Finish.tag(), branch, result)); - self.switch(left, self.layout.sequence, cases, body) + let function = self.finish(symbol, "control_executor", parameters, body, result); + plan::check_boundary(&function, representations, &program) + .expect("executor boundary check must pass"); + function } } diff --git a/crates/psrs-backend/src/cc/lower/control/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/lifetime.rs index 2dec4c10..390a161f 100644 --- a/crates/psrs-backend/src/cc/lower/control/lifetime.rs +++ b/crates/psrs-backend/src/cc/lower/control/lifetime.rs @@ -3,7 +3,7 @@ use super::builder::{Machine, repr}; use super::executor::arm; use crate::cc::{Assignment, AssignmentKind, Function, TagCase, ValueId, ValueShape}; -use crate::control::schema::{ExtentCase, extent as e}; +use crate::control::schema::ExtentCase; impl Machine<'_> { pub(super) fn integer(&mut self, n: i32, body: &mut Vec) -> ValueId { @@ -145,75 +145,57 @@ impl Machine<'_> { } pub(super) fn start_boundary(mut self) -> Function { + let program = super::plan::start_boundary(); + super::plan::verify_plan(&program).expect("start_boundary plan must be well-formed"); let mut body = Vec::new(); - let result = self.new_boundary(None, &mut body); + let result = self.expand(&program, &mut Vec::new(), &[], &mut body); + let representations = self.lower.representations; let symbol = self.functions.start; - self.finish(symbol, "control_start_boundary", vec![], body, result) + let function = self.finish(symbol, "control_start_boundary", vec![], body, result); + super::plan::check_boundary(&function, representations, &program) + .expect("start_boundary boundary check must pass"); + function } pub(super) fn boundary_check(mut self) -> Function { let boundary = self.lower.fresh(repr(self.layout.boundary)); - let mut cases = Vec::new(); - for case in ExtentCase::ALL { - let mut branch = Vec::new(); - let cell = self.field( - boundary, - self.layout.boundary, - case.tag(), - e::STATUS, - &mut branch, - ); - self.guard_pending(cell, &mut branch); - let result = if case == ExtentCase::Root { - boundary - } else { - let parent = self.field( - boundary, - self.layout.boundary, - case.tag(), - e::PARENT, - &mut branch, - ); - self.check_boundary(parent, &mut branch) - }; - cases.push(arm(case.tag(), branch, result)); - } + let params = [boundary]; + let program = super::plan::boundary_check(); + super::plan::verify_plan(&program).expect("boundary_check plan must be well-formed"); let mut body = Vec::new(); - let result = self.switch(boundary, self.layout.boundary, cases, &mut body); + let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); + let representations = self.lower.representations; let symbol = self.functions.check; - self.finish( + let function = self.finish( symbol, "control_check_boundary", vec![boundary], body, result, - ) + ); + super::plan::check_boundary(&function, representations, &program) + .expect("boundary_check boundary check must pass"); + function } pub(super) fn boundary_close(mut self) -> Function { let boundary = self.lower.fresh(repr(self.layout.boundary)); - let mut cases = Vec::new(); - for case in ExtentCase::ALL { - let mut branch = Vec::new(); - let cell = self.field( - boundary, - self.layout.boundary, - case.tag(), - e::STATUS, - &mut branch, - ); - self.set_status(cell, 1, &mut branch); - cases.push(arm(case.tag(), branch, boundary)); - } + let params = [boundary]; + let program = super::plan::boundary_close(); + super::plan::verify_plan(&program).expect("boundary_close plan must be well-formed"); let mut body = Vec::new(); - let result = self.switch(boundary, self.layout.boundary, cases, &mut body); + let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); + let representations = self.lower.representations; let symbol = self.functions.close; - self.finish( + let function = self.finish( symbol, "control_close_boundary", vec![boundary], body, result, - ) + ); + super::plan::check_boundary(&function, representations, &program) + .expect("boundary_close boundary check must pass"); + function } } diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 75dd7500..2e06021d 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -9,12 +9,15 @@ use psrs_core::Expr; use psrs_hir::{Intrinsic, SymbolId}; use psrs_span::TextRange; +pub(crate) use plan::{Family, Shape}; + mod builder; mod executor; mod fields; mod lifetime; mod operands; mod owned; +mod plan; mod replay; mod scope; use builder::Machine; @@ -290,26 +293,12 @@ impl FunctionLowerer<'_> { let mut resume = Machine::new(self.child_lowerer(), layout, functions, span); let receiver = resume.lower.fresh(super::lambda::closure_value_type()); let value = resume.lower.fresh(erased_shape()); + let params = [receiver, value]; + let program = plan::raw_resume(); + plan::verify_plan(&program).expect("raw resume plan must be well-formed"); let mut assignments = Vec::new(); - let saved = resume.capture( - receiver, - 0, - builder::repr(layout.sequence), - &mut assignments, - ); - let boundary = resume.capture( - receiver, - 1, - builder::repr(layout.boundary), - &mut assignments, - ); - resume.check_boundary(boundary, &mut assignments); - let result = resume.node( - layout.computation, - crate::control::schema::ComputationCase::Resume.tag(), - vec![value, saved, boundary], - &mut assignments, - ); + let result = resume.expand(&program, &mut Vec::new(), ¶ms, &mut assignments); + let representations = resume.lower.representations; let resume = resume.finish( functions.resume, "control_resume", @@ -317,6 +306,8 @@ impl FunctionLowerer<'_> { assignments, result, ); + plan::check_boundary(&resume, representations, &program) + .expect("raw resume boundary check must pass"); self.verify_synthesized(&resume)?; self.generated.push(resume); let executor = Machine::new(self.child_lowerer(), layout, functions, span).executor(); @@ -396,3 +387,94 @@ pub(in crate::cc) fn plan_control_helpers( } Some(functions) } + +/// Re-check a generated machine body against its checked plan. This is the +/// replaced recognizer's entry point: it runs on the emitted CC at the module +/// verification boundary and rejects any body whose dispatch or outcome +/// disagrees with the construction plan. +pub(crate) fn verify_boundary( + function: &crate::cc::Function, + table: &crate::cc::RepresentationTable, +) -> Result<(), &'static str> { + match plan_for_symbol(function.symbol, table) { + Some(plan) => plan::check_boundary(function, table, &plan), + None => Ok(()), + } +} + +/// The checked plan shape for a machine function symbol, if it is one. +pub(crate) fn plan_shape_for( + symbol: psrs_hir::SymbolId, + table: &crate::cc::RepresentationTable, +) -> Option { + plan_for_symbol(symbol, table).map(|plan| plan::shape_of(&plan)) +} + +fn plan_for_symbol( + symbol: psrs_hir::SymbolId, + table: &crate::cc::RepresentationTable, +) -> Option { + use crate::cc::ControlHelperRole as R; + let role = table + .control_helpers + .iter() + .find(|helper| helper.function() == symbol) + .map(|helper| helper.role()); + let resumption = table + .control_resumption + .as_ref() + .is_some_and(|raw| raw.function() == symbol); + Some(match role { + Some(R::Executor) => plan::executor(), + Some(R::CloneSequence) => plan::clone_sequence(), + Some(R::RebuildSequence) => plan::rebuild_sequence(), + Some(R::Start) => plan::start_boundary(), + Some(R::Check) => plan::boundary_check(), + Some(R::Close) => plan::boundary_close(), + Some(R::Once) => plan::once(), + Some(R::Cancel) => plan::cancel(), + None if resumption => plan::raw_resume(), + None => return None, + }) +} + +/// The external helper symbols a machine function tail-calls, per its plan. +/// +/// Self tail calls are loopified into loop back-edges by P9, so they are +/// excluded; the MIR boundary check compares the rest against actual +/// `ReturnCall` targets. +pub(crate) fn plan_external_targets( + symbol: psrs_hir::SymbolId, + table: &crate::cc::RepresentationTable, +) -> Option> { + use crate::cc::ControlHelperRole; + fn collect(exec: &plan::PlanExec, out: &mut std::collections::HashSet) { + match exec { + plan::PlanExec::Steps { next, .. } => collect(next, out), + plan::PlanExec::Switch { arms, .. } => { + for (_, arm) in arms { + collect(arm, out); + } + } + plan::PlanExec::Advance { .. } => { + out.insert(ControlHelperRole::Executor); + } + plan::PlanExec::Tail { role, .. } => { + out.insert(*role); + } + _ => {} + } + } + let plan = plan_for_symbol(symbol, table)?; + let mut wanted = std::collections::HashSet::new(); + collect(&plan, &mut wanted); + let mut targets = std::collections::HashSet::new(); + for role in wanted { + if let Some(helper) = table.control_helper(role) + && helper.function() != symbol + { + targets.insert(helper.function()); + } + } + Some(targets) +} diff --git a/crates/psrs-backend/src/cc/lower/control/owned.rs b/crates/psrs-backend/src/cc/lower/control/owned.rs index 21ecb2d3..4531f974 100644 --- a/crates/psrs-backend/src/cc/lower/control/owned.rs +++ b/crates/psrs-backend/src/cc/lower/control/owned.rs @@ -1,9 +1,10 @@ //! One-shot ownership is consumed at interpretation, before invoking user code. +//! +//! The factory and cancellation bodies are built from the checked plans in +//! [`super::plan`]. use super::builder::{Machine, repr}; -use crate::cc::payload::erased_shape; -use crate::cc::{Assignment, Function, ValueId}; -use crate::control::schema::{ComputationCase, OwnerCase, computation as c, owner as o}; +use crate::cc::Function; impl Machine<'_> { pub(super) fn owned(mut self) -> Function { @@ -13,90 +14,31 @@ impl Machine<'_> { .signature(self.layout.once) .unwrap(); let continuation = self.lower.fresh(signature.parameters[0]); + let params = [continuation]; + let program = super::plan::once(); + super::plan::verify_plan(&program).expect("once plan must be well-formed"); let mut body = Vec::new(); - let erased = self.cast(continuation, erased_shape(), &mut body); - let callback = self.new_cell(self.layout.callback, erased, &mut body); - let status = self.new_status(&mut body); - let result = self.node( - self.layout.owner, - OwnerCase::OneShot.tag(), - vec![callback, status], - &mut body, - ); + let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); + let representations = self.lower.representations; let symbol = self.functions.once; - self.finish(symbol, "control_once", vec![continuation], body, result) + let function = self.finish(symbol, "control_once", vec![continuation], body, result); + super::plan::check_boundary(&function, representations, &program) + .expect("once boundary check must pass"); + function } pub(super) fn cancel(mut self) -> Function { let owner = self.lower.fresh(repr(self.layout.owner)); + let params = [owner]; + let program = super::plan::cancel(); + super::plan::verify_plan(&program).expect("cancel plan must be well-formed"); let mut body = Vec::new(); - let status = self.field( - owner, - self.layout.owner, - OwnerCase::OneShot.tag(), - o::STATUS, - &mut body, - ); - self.guard_pending(status, &mut body); - self.set_status(status, 3, &mut body); - let callback = self.field( - owner, - self.layout.owner, - OwnerCase::OneShot.tag(), - o::CALLBACK, - &mut body, - ); - self.write_cell(self.layout.callback, callback, status, &mut body); + let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); + let representations = self.lower.representations; let symbol = self.functions.cancel; - self.finish(symbol, "control_cancel", vec![owner], body, owner) - } - - pub(super) fn consume_owned( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let owner = self.field( - computation, - self.layout.computation, - ComputationCase::OwnedResume.tag(), - c::OWNED_OWNER, - body, - ); - let value = self.field( - computation, - self.layout.computation, - ComputationCase::OwnedResume.tag(), - c::OWNED_VALUE, - body, - ); - let callback = self.field( - owner, - self.layout.owner, - OwnerCase::OneShot.tag(), - o::CALLBACK, - body, - ); - let status = self.field( - owner, - self.layout.owner, - OwnerCase::OneShot.tag(), - o::STATUS, - body, - ); - self.guard_pending(status, body); - // No guest callback runs between this check and transition. The pinned - // guest profile is single-threaded; re-entrant callbacks see Running. - self.set_status(status, 1, body); - let continuation = self.read_cell(self.layout.callback, erased_shape(), callback, body); - // The local invocation roots the callback; a retained consumed owner - // must no longer root its captures. - self.write_cell(self.layout.callback, callback, status, body); - let next = self.apply(continuation, &[value], body); - self.set_status(status, 2, body); - self.recur(state, handler, next, sequence, body) + let function = self.finish(symbol, "control_cancel", vec![owner], body, result); + super::plan::check_boundary(&function, representations, &program) + .expect("cancel boundary check must pass"); + function } } diff --git a/crates/psrs-backend/src/cc/lower/control/plan/boundary.rs b/crates/psrs-backend/src/cc/lower/control/plan/boundary.rs new file mode 100644 index 00000000..0a41f723 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/boundary.rs @@ -0,0 +1,149 @@ +//! The P8 expansion boundary checker. +//! +//! It rebuilds the dispatch/outcome shape of an *emitted* function and compares +//! it with the checked plan's shape. The plan and the emitter are independent: +//! the plan is hand-built from the semantics, the emitter is a generic expander, +//! so an expander defect (dropped arm, wrong tag, wrong terminal) is a mismatch +//! rather than a silently accepted body. The generic CC verifiers still check +//! operand semantics; this checks that expansion emitted the checked program. + +use super::Exec; +use super::ir::Family; +use super::shape::{Shape, Terminal, shape}; +use crate::cc::branch_facts::{Definitions, tag_source}; +use crate::cc::value_identity::transparent; +use crate::cc::{AssignmentKind as A, Function, ReprId, RepresentationTable, ValueId}; +use psrs_hir::SymbolId; + +/// Compare the emitted function's machine dispatch against `plan`. +pub(crate) fn check_boundary( + function: &Function, + table: &RepresentationTable, + plan: &Exec, +) -> Result<(), &'static str> { + let schema = table + .control_schema() + .ok_or("boundary check has no checked machine schema")?; + let expected = shape(plan); + let view = View { + definitions: crate::cc::value_identity::definitions(&function.assignments), + computation: schema.computation, + sequence: schema.sequence, + context: schema.context, + extent: schema.extent, + owner: schema.owner, + executor: table + .control_helper(crate::cc::ControlHelperRole::Executor) + .map(|h| h.function()), + helpers: table + .control_helpers + .iter() + .map(|helper| helper.function()) + .collect(), + }; + if view.shape(function.result) != expected { + return Err("emitted machine dispatch or outcome disagrees with the checked plan"); + } + Ok(()) +} + +struct View<'a> { + definitions: Definitions<'a>, + computation: ReprId, + sequence: ReprId, + context: ReprId, + extent: ReprId, + owner: ReprId, + executor: Option, + helpers: Vec, +} + +impl View<'_> { + /// Resolve representations without collapsing a dispatch: follow casts and + /// transparent conversions, but keep a `TagSwitch` as its own node. + fn strip(&self, mut value: ValueId) -> ValueId { + let mut active = std::collections::HashSet::new(); + loop { + if !active.insert(value) { + break; + } + match self.definitions.get(&value).copied() { + Some(A::RepresentationCast { value: source, .. }) => value = *source, + Some(A::AggregateConvert { + value: source, + conversion, + .. + }) if transparent(&conversion.plan) => value = *source, + _ => break, + } + } + value + } + + fn family(&self, repr: ReprId) -> Option { + if repr == self.computation { + Some(Family::Computation) + } else if repr == self.sequence { + Some(Family::Sequence) + } else if repr == self.context { + Some(Family::Context) + } else if repr == self.extent { + Some(Family::Extent) + } else if repr == self.owner { + Some(Family::Owner) + } else { + None + } + } + + fn shape(&self, value: ValueId) -> Shape { + let value = self.strip(value); + match self.definitions.get(&value).copied() { + Some(A::TagSwitch { + value: selector, + cases, + .. + }) => { + if let Some((repr, _)) = tag_source(*selector, &self.definitions) + && let Some(family) = self.family(repr) + { + return Shape::Switch( + family, + cases + .iter() + .map(|case| (case.tag as u32, self.shape(case.value))) + .collect(), + ); + } + Shape::Leaf(Terminal::Value) + } + Some(A::DirectCall { function, .. }) => { + if Some(*function) == self.executor { + Shape::Leaf(Terminal::Advance) + } else if self.helpers.contains(function) { + Shape::Leaf(Terminal::Tail) + } else { + Shape::Leaf(Terminal::Value) + } + } + Some(A::Unreachable) => Shape::Leaf(Terminal::Reject), + _ => Shape::Leaf(Terminal::Value), + } + } +} + +#[cfg(test)] +mod tests { + use super::super::executor; + use super::*; + + #[test] + fn shape_is_sensitive_to_a_dropped_dispatch_arm() { + let mut plan = executor(); + let before = shape(&plan); + if let Exec::Switch { arms, .. } = &mut plan { + arms.retain(|(tag, _)| *tag != 0); + } + assert_ne!(shape(&plan), before); + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/check.rs b/crates/psrs-backend/src/cc/lower/control/plan/check.rs new file mode 100644 index 00000000..17197933 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/check.rs @@ -0,0 +1,130 @@ +//! Independent structural validation of the driver plan. + +use super::ir::{Case, Exec, Op}; +use crate::control::execution::ActionId; +use crate::control::schema::{ComputationCase, ContextCase, SequenceCase}; +use std::collections::HashSet; + +/// +/// It verifies that every dispatch covers exactly its schema's cases, that +/// every allocation has the declared field arity, and that every required +/// flat-driver action is present. It does not inspect operation order; the +/// story's own CC verifiers check the emitted body. +pub(crate) fn check(exec: &Exec) -> Result<(), &'static str> { + verify(exec)?; + let mut actions = HashSet::new(); + record_executor(exec, &mut actions)?; + if ActionId::ALL.iter().all(|action| actions.contains(action)) { + Ok(()) + } else { + Err("checked driver plan is missing a required action") + } +} + +pub(crate) fn verify(exec: &Exec) -> Result<(), &'static str> { + match exec { + Exec::Steps { ops, next } => { + for op in ops { + if let Op::Node { case, fields } = op + && fields.len() != case.field_count() + { + return Err("driver plan allocates a node with the wrong field arity"); + } + } + verify(next) + } + Exec::Switch { case, arms, .. } => { + let mut tags = arms.iter().map(|(tag, _)| *tag).collect::>(); + let unique = tags.len(); + tags.sort_unstable(); + tags.dedup(); + if tags.len() != unique { + return Err("driver plan dispatch repeats a case"); + } + let allowed = case.tags(); + if tags.iter().any(|tag| !allowed.contains(tag)) { + return Err("driver plan dispatch invents a schema case"); + } + for (_, arm) in arms { + verify(arm)?; + } + Ok(()) + } + Exec::Advance { .. } + | Exec::Publish { .. } + | Exec::Return { .. } + | Exec::Tail { .. } + | Exec::Reject { .. } => Ok(()), + } +} + +/// Navigate the recognized driver shape and record each reached action. +fn record_executor(exec: &Exec, actions: &mut HashSet) -> Result<(), &'static str> { + let arms = switch_arms(exec, &|case| matches!(case, Case::Computation(_))) + .ok_or("driver plan must refine the computation carrier first")?; + for (tag, arm) in arms { + if *tag == ComputationCase::Return.tag() { + record_return(arm, actions)?; + } else if *tag == ComputationCase::Perform.tag() + && switch_arms(arm, &|case| matches!(case, Case::Context(_))) + .is_some_and(|arms| arms.iter().any(|(tag, _)| *tag == ContextCase::Root.tag())) + { + actions.insert(ActionId::PerformRoot); + } + } + Ok(()) +} + +fn record_return(exec: &Exec, actions: &mut HashSet) -> Result<(), &'static str> { + let queue = switch_arms(exec, &|case| matches!(case, Case::Sequence(_))) + .ok_or("return must refine the queue")?; + for (tag, arm) in queue { + if *tag == SequenceCase::Empty.tag() + && switch_arms(arm, &|case| matches!(case, Case::Context(_))) + .is_some_and(|arms| arms.iter().any(|(t, _)| *t == ContextCase::Root.tag())) + { + actions.insert(ActionId::ReturnEmptyRoot); + } else if *tag == SequenceCase::Cons.tag() { + actions.insert(ActionId::ReturnCons); + } else if *tag == SequenceCase::Finish.tag() { + actions.insert(ActionId::ReturnFinish); + } else if *tag == SequenceCase::Append.tag() + && let Some(left) = switch_arms(arm, &|case| matches!(case, Case::Sequence(_))) + { + for (left_tag, _) in left { + let action = match *left_tag { + tag if tag == SequenceCase::Empty.tag() => Some(ActionId::AppendEmpty), + tag if tag == SequenceCase::Cons.tag() => Some(ActionId::AppendCons), + tag if tag == SequenceCase::Append.tag() => Some(ActionId::AppendAppend), + tag if tag == SequenceCase::Finish.tag() => Some(ActionId::AppendFinish), + _ => None, + }; + if let Some(action) = action { + actions.insert(action); + } + } + } + } + Ok(()) +} + +/// The first switch in this subtree whose carrier satisfies `wanted`. +fn switch_arms<'a>(exec: &'a Exec, wanted: &dyn Fn(Case) -> bool) -> Option<&'a [(u32, Exec)]> { + match exec { + Exec::Switch { case, arms, .. } if wanted(*case) => Some(arms), + Exec::Steps { ops: _, next } => switch_arms(next, wanted), + Exec::Switch { arms, .. } => { + for (_, arm) in arms { + if let Some(found) = switch_arms(arm, wanted) { + return Some(found); + } + } + None + } + Exec::Advance { .. } + | Exec::Publish { .. } + | Exec::Return { .. } + | Exec::Tail { .. } + | Exec::Reject { .. } => None, + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/driver.rs b/crates/psrs-backend/src/cc/lower/control/plan/driver.rs new file mode 100644 index 00000000..fedb799d --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/driver.rs @@ -0,0 +1,237 @@ +//! Perform, Bind and raw Resume transitions. + +use super::ir::*; +use super::returns::enter_target; +use crate::cc::ControlHelperRole; +use crate::control::schema::{ + ComputationCase, ContextCase, SequenceCase, computation as c, context as x, replay, result_pair, +}; + +/// Perform applies the current dispatch clause with a fresh raw resumption. +pub(super) fn perform(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let request = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Perform), + field: c::PAYLOAD, + }, + ); + let arms = ContextCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + ContextCase::Root => perform_root(&mut cursor, request.clone()), + ContextCase::Scoped => perform_scoped(&mut cursor, request.clone()), + }; + (case.tag(), arm) + }) + .collect(); + steps( + ops, + switch( + state(State::Context), + Case::Context(ContextCase::Root), + arms, + ), + ) +} + +pub(super) fn perform_root(cursor: &mut Cursor, request: Operand) -> Exec { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Root), + field: x::ROOT_EXTENT, + }, + ); + let continuation = cursor.bind( + &mut ops, + Op::ResumeClosure { + captures: vec![state(State::Sequence), extent], + }, + ); + let pair = cursor.bind( + &mut ops, + Op::Apply { + callee: state(State::Handler), + args: vec![state(State::Value), request, continuation], + }, + ); + let next_state = cursor.bind( + &mut ops, + Op::PairField { + pair: pair.clone(), + field: result_pair::STATE, + }, + ); + let next = cursor.bind( + &mut ops, + Op::PairField { + pair, + field: result_pair::VALUE, + }, + ); + let empty = cursor.bind(&mut ops, Op::EmptySequence); + steps( + ops, + advance_all( + next_state, + state(State::Handler), + next, + empty, + state(State::Extent), + state(State::Context), + ), + ) +} + +pub(super) fn perform_scoped(cursor: &mut Cursor, request: Operand) -> Exec { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_EXTENT, + }, + ); + let continuation = cursor.bind( + &mut ops, + Op::ResumeClosure { + captures: vec![state(State::Sequence), extent], + }, + ); + let clause = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_OPERATION, + }, + ); + let target = cursor.bind( + &mut ops, + Op::Apply { + callee: clause, + args: vec![request, continuation], + }, + ); + steps(ops, enter_target(cursor, target)) +} + +pub(super) fn bind(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let inner = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Bind), + field: c::BIND_INNER, + }, + ); + let continuation = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Bind), + field: c::BIND_CONTINUATION, + }, + ); + let pending = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Cons), + fields: vec![continuation, state(State::Sequence)], + }, + ); + steps(ops, advance_here(inner, pending)) +} + +/// Raw resume checks its checkpoint and replays the saved sequence before the +/// consumer queue. +pub(super) fn resume(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let value = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Resume), + field: c::RESUME_VALUE, + }, + ); + let saved = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Resume), + field: c::RESUME_SAVED, + }, + ); + let checkpoint = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Resume), + field: c::RESUME_CHECKPOINT, + }, + ); + cursor.bind(&mut ops, Op::CheckBoundary { extent: checkpoint }); + let empty = cursor.bind(&mut ops, Op::EmptySequence); + let parent = cursor.bind( + &mut ops, + Op::ContextExtent { + context: state(State::Context), + }, + ); + let cloned = cursor.bind( + &mut ops, + Op::Helper { + role: ControlHelperRole::CloneSequence, + args: vec![saved, empty.clone(), empty, state(State::Extent), parent], + }, + ); + let replay_queue = cursor.bind( + &mut ops, + Op::ReplayField { + result: cloned.clone(), + field: replay::QUEUE, + }, + ); + let active = cursor.bind( + &mut ops, + Op::ReplayField { + result: cloned, + field: replay::ACTIVE, + }, + ); + let pending = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![replay_queue, state(State::Sequence)], + }, + ); + let next = cursor.bind( + &mut ops, + Op::Node { + case: Case::Computation(ComputationCase::Return), + fields: vec![value], + }, + ); + steps( + ops, + advance_all( + state(State::Value), + state(State::Handler), + next, + pending, + active, + state(State::Context), + ), + ) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/expand.rs b/crates/psrs-backend/src/cc/lower/control/plan/expand.rs new file mode 100644 index 00000000..929871c7 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/expand.rs @@ -0,0 +1,249 @@ +//! Expansion of the checked plan into ordinary CC. + +use super::super::builder::{Machine, repr}; +use super::ir::{Exec, Op, Operand, Product, Shape, state_index}; +use crate::cc::payload::erased_shape; +use crate::cc::{Assignment, AssignmentKind, ControlHelperRole, ValueId}; +use crate::control::schema::SequenceCase; + +impl Machine<'_> { + /// Emit ordinary CC from the checked plan. `params` are the enclosing + /// function's parameters; `Operand::State` indexes the executor's six named + /// slots and `Operand::Param` a helper's explicit parameters. + pub(in crate::cc::lower::control) fn expand( + &mut self, + exec: &Exec, + env: &mut Vec, + params: &[ValueId], + body: &mut Vec, + ) -> ValueId { + match exec { + Exec::Steps { ops, next } => { + let base = env.len(); + for op in ops { + let value = self.expand_op(op, env, params, body); + env.push(value); + } + let result = self.expand(next, env, params, body); + env.truncate(base); + result + } + Exec::Switch { source, case, arms } => { + let value = self.operand(source, env, params); + let value = self.cast(value, repr(case.repr(self.layout)), body); + let mut cases = Vec::new(); + for (tag, arm) in arms { + let mut arm_body = Vec::new(); + let mut arm_env = env.clone(); + let result = self.expand(arm, &mut arm_env, params, &mut arm_body); + cases.push(super::super::executor::arm(*tag, arm_body, result)); + } + self.switch(value, case.repr(self.layout), cases, body) + } + Exec::Advance { + state, + handler, + computation, + sequence, + extent, + context, + } => { + let state = self.operand(state, env, params); + let handler = self.operand(handler, env, params); + let computation = self.operand(computation, env, params); + let sequence = self.operand(sequence, env, params); + let extent = self.operand(extent, env, params); + let context = self.operand(context, env, params); + let function = self.functions.executor; + self.call( + function, + vec![state, handler, computation, sequence, extent, context], + body, + ) + } + Exec::Publish { result } | Exec::Return { value: result } => { + self.operand(result, env, params) + } + Exec::Tail { role, args } => { + let function = self.function_for(*role); + let args = args + .iter() + .map(|operand| self.operand(operand, env, params)) + .collect(); + self.call(function, args, body) + } + Exec::Reject { shape } => { + let shape = self.planned_shape(*shape); + self.emit(shape, body, |_| AssignmentKind::Unreachable) + } + } + } + + fn expand_op( + &mut self, + op: &Op, + env: &[ValueId], + params: &[ValueId], + body: &mut Vec, + ) -> ValueId { + match op { + Op::Project { + source, + case, + field, + } => { + let source = self.operand(source, env, params); + self.field(source, case.repr(self.layout), case.tag(), *field, body) + } + Op::Node { case, fields } => { + let fields = fields + .iter() + .map(|operand| self.operand(operand, env, params)) + .collect(); + self.node(case.repr(self.layout), case.tag(), fields, body) + } + Op::Capture { + closure, + index, + case, + } => { + let closure = self.operand(closure, env, params); + let shape = repr(case.repr(self.layout)); + self.capture(closure, *index, shape, body) + } + Op::Apply { callee, args } => { + let callee = self.operand(callee, env, params); + let args = args + .iter() + .map(|operand| self.operand(operand, env, params)) + .collect::>(); + self.apply(callee, &args, body) + } + Op::Helper { role, args } => { + let function = self.function_for(*role); + let args = args + .iter() + .map(|operand| self.operand(operand, env, params)) + .collect(); + self.call(function, args, body) + } + Op::ResumeClosure { captures } => { + let captures = captures + .iter() + .map(|operand| self.operand(operand, env, params)) + .collect(); + let function = self.functions.resume; + let signature = self.layout.continuation; + self.closure(function, signature, captures, body) + } + Op::Pair { state, value } => { + let state = self.operand(state, env, params); + let value = self.operand(value, env, params); + self.pair(state, value, body) + } + Op::PairField { pair, field } => { + let pair = self.operand(pair, env, params); + self.pair_field(pair, *field, body) + } + Op::ReplayField { result, field } => { + let result = self.operand(result, env, params); + self.replay_field(result, *field, body) + } + Op::FreshExtent { parent } => { + let parent = parent + .as_ref() + .map(|operand| self.operand(operand, env, params)); + self.new_boundary(parent, body) + } + Op::ContextExtent { context } => { + let context = self.operand(context, env, params); + self.context_extent(context, body) + } + Op::CheckBoundary { extent } => { + let extent = self.operand(extent, env, params); + self.check_boundary(extent, body) + } + Op::CloseBoundary { extent } => { + let extent = self.operand(extent, env, params); + self.close_boundary(extent, body) + } + Op::GuardPending { cell } => { + let cell = self.operand(cell, env, params); + self.guard_pending(cell, body); + cell + } + Op::SetStatus { cell, value } => { + let cell = self.operand(cell, env, params); + self.set_status(cell, *value, body); + cell + } + Op::ReadCallback { cell } => { + let cell = self.operand(cell, env, params); + self.read_cell(self.layout.callback, erased_shape(), cell, body) + } + Op::WriteCallback { cell, value } => { + let cell = self.operand(cell, env, params); + let value = self.operand(value, env, params); + self.write_cell(self.layout.callback, cell, value, body); + cell + } + Op::NewCallbackCell { value } => { + let value = self.operand(value, env, params); + let value = self.cast(value, erased_shape(), body); + self.new_cell(self.layout.callback, value, body) + } + Op::NewStatus => self.new_status(body), + Op::Product { product, fields } => { + let representation = self.planned_product(*product); + let fields = fields + .iter() + .map(|operand| self.operand(operand, env, params)) + .collect(); + self.emit(repr(representation), body, |destination| { + AssignmentKind::ProductNew { + destination, + representation, + arguments: fields, + } + }) + } + Op::EmptySequence => { + let representation = self.layout.sequence; + self.node(representation, SequenceCase::Empty.tag(), Vec::new(), body) + } + } + } + + fn operand(&self, operand: &Operand, env: &[ValueId], params: &[ValueId]) -> ValueId { + match operand { + Operand::State(slot) => params[state_index(*slot)], + Operand::Param(index) => params[*index], + Operand::Temp(index) => env[*index], + } + } + + fn planned_shape(&self, shape: Shape) -> crate::cc::ValueShape { + match shape { + Shape::ReplayResult => repr(self.layout.replay_result), + } + } + + fn planned_product(&self, product: Product) -> crate::cc::ReprId { + match product { + Product::ReplayResult => self.layout.replay_result, + } + } + + fn function_for(&self, role: ControlHelperRole) -> psrs_hir::SymbolId { + match role { + ControlHelperRole::Executor => self.functions.executor, + ControlHelperRole::CloneSequence => self.functions.clone_sequence, + ControlHelperRole::RebuildSequence => self.functions.rebuild_sequence, + ControlHelperRole::Start => self.functions.start, + ControlHelperRole::Check => self.functions.check, + ControlHelperRole::Close => self.functions.close, + ControlHelperRole::Once => self.functions.once, + ControlHelperRole::Cancel => self.functions.cancel, + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/handle.rs b/crates/psrs-backend/src/cc/lower/control/plan/handle.rs new file mode 100644 index 00000000..e66cc65a --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/handle.rs @@ -0,0 +1,338 @@ +//! Handle and owned-transfer transitions. + +use super::ir::*; +use crate::control::schema::{ + ComputationCase, ContextCase, OwnerCase, SequenceCase, computation as c, owner as o, + sequence as q, +}; + +/// Handle normalizes a leading Append, then enters the source under a fresh or +/// shared extent. +pub(super) fn handle(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let ret = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Handle), + field: c::HANDLE_RETURN, + }, + ); + let op = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Handle), + field: c::HANDLE_OPERATION, + }, + ); + let inner = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Handle), + field: c::HANDLE_SOURCE, + }, + ); + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty | SequenceCase::Cons => { + handle_enter_fresh(&mut cursor, ret.clone(), op.clone(), inner.clone()) + } + SequenceCase::Finish => { + handle_enter_finish(&mut cursor, ret.clone(), op.clone(), inner.clone()) + } + SequenceCase::Append => handle_normalize(&mut cursor), + }; + (case.tag(), arm) + }) + .collect(); + steps( + ops, + switch( + state(State::Sequence), + Case::Sequence(SequenceCase::Empty), + arms, + ), + ) +} + +pub(super) fn handle_enter_fresh( + cursor: &mut Cursor, + ret: Operand, + op: Operand, + inner: Operand, +) -> Exec { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + Op::FreshExtent { + parent: Some(state(State::Extent)), + }, + ); + let context = cursor.bind( + &mut ops, + Op::Node { + case: Case::Context(ContextCase::Scoped), + fields: vec![ + ret, + op, + state(State::Sequence), + state(State::Extent), + state(State::Context), + extent.clone(), + ], + }, + ); + let empty = cursor.bind(&mut ops, Op::EmptySequence); + steps( + ops, + advance_all( + state(State::Value), + state(State::Handler), + inner, + empty, + extent, + context, + ), + ) +} + +pub(super) fn handle_enter_finish( + cursor: &mut Cursor, + ret: Operand, + op: Operand, + inner: Operand, +) -> Exec { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_EXTENT, + }, + ); + let saved = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_REST, + }, + ); + let parent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_PARENT, + }, + ); + let context = cursor.bind( + &mut ops, + Op::Node { + case: Case::Context(ContextCase::Scoped), + fields: vec![ + ret, + op, + saved, + parent, + state(State::Context), + extent.clone(), + ], + }, + ); + let empty = cursor.bind(&mut ops, Op::EmptySequence); + steps( + ops, + advance_all( + state(State::Value), + state(State::Handler), + inner, + empty, + extent, + context, + ), + ) +} + +pub(super) fn handle_normalize(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let left = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Append), + field: q::APPEND_LEFT, + }, + ); + let right = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Append), + field: q::APPEND_RIGHT, + }, + ); + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => advance_here(state(State::Computation), right.clone()), + SequenceCase::Cons | SequenceCase::Append | SequenceCase::Finish => { + let (head_field, rest_field, parent_field) = match case { + SequenceCase::Cons => (q::CONS_HEAD, q::CONS_TAIL, None), + SequenceCase::Append => (q::APPEND_LEFT, q::APPEND_RIGHT, None), + SequenceCase::Finish => { + (q::FINISH_EXTENT, q::FINISH_REST, Some(q::FINISH_PARENT)) + } + SequenceCase::Empty => unreachable!(), + }; + let mut ops = Vec::new(); + let head = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(*case), + field: head_field, + }, + ); + let rest = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(*case), + field: rest_field, + }, + ); + let rest = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![rest, right.clone()], + }, + ); + let mut fields = vec![head, rest]; + if let Some(parent_field) = parent_field { + let parent = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(*case), + field: parent_field, + }, + ); + fields.push(parent); + } + let pending = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(*case), + fields, + }, + ); + steps( + ops, + advance_all( + state(State::Value), + state(State::Handler), + state(State::Computation), + pending, + state(State::Extent), + state(State::Context), + ), + ) + } + }; + (case.tag(), arm) + }) + .collect(); + steps( + ops, + switch(left, Case::Sequence(SequenceCase::Append), arms), + ) +} + +/// Owned transfer guards Pending, marks Running, loads and clears the callback, +/// applies it, then marks Consumed. +pub(super) fn owned_resume(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let owner = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::OwnedResume), + field: c::OWNED_OWNER, + }, + ); + let value = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::OwnedResume), + field: c::OWNED_VALUE, + }, + ); + let callback = cursor.bind( + &mut ops, + Op::Project { + source: owner.clone(), + case: Case::Owner(OwnerCase::OneShot), + field: o::CALLBACK, + }, + ); + let status = cursor.bind( + &mut ops, + Op::Project { + source: owner, + case: Case::Owner(OwnerCase::OneShot), + field: o::STATUS, + }, + ); + cursor.bind( + &mut ops, + Op::GuardPending { + cell: status.clone(), + }, + ); + cursor.bind( + &mut ops, + Op::SetStatus { + cell: status.clone(), + value: 1, + }, + ); + let continuation = cursor.bind( + &mut ops, + Op::ReadCallback { + cell: callback.clone(), + }, + ); + cursor.bind( + &mut ops, + Op::WriteCallback { + cell: callback, + value: status.clone(), + }, + ); + let next = cursor.bind( + &mut ops, + Op::Apply { + callee: continuation, + args: vec![value], + }, + ); + cursor.bind( + &mut ops, + Op::SetStatus { + cell: status, + value: 2, + }, + ); + steps(ops, advance_here(next, state(State::Sequence))) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs b/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs new file mode 100644 index 00000000..0437ae32 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs @@ -0,0 +1,433 @@ +//! Checked plans for the machine's helper bodies: replay, lifecycle and the +//! one-shot factories. Each builder names its parameters positionally; the +//! expander binds them to the function's fresh parameter values. + +use super::ir::{Case, Cursor, Exec, Op, Operand, Product, Shape, steps, switch}; +use crate::cc::ControlHelperRole; +use crate::control::schema::{ + ComputationCase, ExtentCase, OwnerCase, SequenceCase, extent as e, owner as o, sequence as q, +}; + +fn param(index: usize) -> Operand { + Operand::Param(index) +} + +fn project(source: Operand, case: Case, field: u32) -> Op { + Op::Project { + source, + case, + field, + } +} + +fn tail(role: ControlHelperRole, args: Vec) -> Exec { + Exec::Tail { role, args } +} + +/// Flatten the current queue into a reversed sequence with an explicit stack. +/// +/// Parameters: `queue`, `todo`, `reversed`, `active`, `parent`. +pub(crate) fn clone_sequence() -> Exec { + let cursor = Cursor::new(); + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => clone_todo(&cursor), + SequenceCase::Cons => { + let mut ops = Vec::new(); + let head = cursor.bind( + &mut ops, + project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_HEAD), + ); + let rest = cursor.bind( + &mut ops, + project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_TAIL), + ); + let reversed = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Cons), + fields: vec![head, param(2)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::CloneSequence, + vec![rest, param(1), reversed, param(3), param(4)], + ), + ) + } + SequenceCase::Append => { + let mut ops = Vec::new(); + let left = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Append), + q::APPEND_LEFT, + ), + ); + let right = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Append), + q::APPEND_RIGHT, + ), + ); + let todo = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![right, param(1)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::CloneSequence, + vec![left, todo, param(2), param(3), param(4)], + ), + ) + } + SequenceCase::Finish => { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Finish), + q::FINISH_EXTENT, + ), + ); + let rest = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Finish), + q::FINISH_REST, + ), + ); + cursor.bind( + &mut ops, + Op::CheckBoundary { + extent: extent.clone(), + }, + ); + let reversed = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Finish), + fields: vec![extent, param(2), param(4)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::CloneSequence, + vec![rest, param(1), reversed, param(3), param(4)], + ), + ) + } + }; + (case.tag(), arm) + }) + .collect(); + switch(param(0), Case::Sequence(SequenceCase::Empty), arms) +} + +/// The traversal stack is built only from Append nodes; any other pending node +/// is a rejection, not a silent fallthrough. +fn clone_todo(cursor: &Cursor) -> Exec { + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => tail( + ControlHelperRole::RebuildSequence, + vec![param(2), param(1), param(3), param(4)], + ), + SequenceCase::Append => { + let mut ops = Vec::new(); + let next = cursor.bind( + &mut ops, + project( + param(1), + Case::Sequence(SequenceCase::Append), + q::APPEND_LEFT, + ), + ); + let rest = cursor.bind( + &mut ops, + project( + param(1), + Case::Sequence(SequenceCase::Append), + q::APPEND_RIGHT, + ), + ); + steps( + ops, + tail( + ControlHelperRole::CloneSequence, + vec![next, rest, param(2), param(3), param(4)], + ), + ) + } + SequenceCase::Cons | SequenceCase::Finish => Exec::Reject { + shape: Shape::ReplayResult, + }, + }; + (case.tag(), arm) + }) + .collect(); + switch(param(1), Case::Sequence(SequenceCase::Empty), arms) +} + +/// Rebuild the flattened queue, giving every Finish a fresh child extent. +/// +/// Parameters: `reversed`, `result_queue`, `active`, `parent`. +pub(crate) fn rebuild_sequence() -> Exec { + let cursor = Cursor::new(); + let arms = [ + SequenceCase::Empty, + SequenceCase::Cons, + SequenceCase::Finish, + ] + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => { + let mut ops = Vec::new(); + let result = cursor.bind( + &mut ops, + Op::Product { + product: Product::ReplayResult, + fields: vec![param(1), param(2)], + }, + ); + steps(ops, Exec::Return { value: result }) + } + SequenceCase::Cons => { + let mut ops = Vec::new(); + let head = cursor.bind( + &mut ops, + project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_HEAD), + ); + let rest = cursor.bind( + &mut ops, + project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_TAIL), + ); + let next = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Cons), + fields: vec![head, param(1)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::RebuildSequence, + vec![rest, next, param(2), param(3)], + ), + ) + } + SequenceCase::Append => Exec::Reject { + shape: Shape::ReplayResult, + }, + SequenceCase::Finish => { + let mut ops = Vec::new(); + // The saved finish's extent is inspected but replaced by a + // fresh activation extent, matching the replay contract. + let _saved = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Finish), + q::FINISH_EXTENT, + ), + ); + let rest = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Finish), + q::FINISH_REST, + ), + ); + let extent = cursor.bind( + &mut ops, + Op::FreshExtent { + parent: Some(param(3)), + }, + ); + let next = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Finish), + fields: vec![extent.clone(), param(1), param(2)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::RebuildSequence, + vec![rest, next, extent.clone(), extent], + ), + ) + } + }; + (case.tag(), arm) + }) + .collect(); + switch(param(0), Case::Sequence(SequenceCase::Empty), arms) +} + +/// Guard the current extent's own status and continue with its parent. +/// +/// Parameters: `boundary`. +pub(crate) fn boundary_check() -> Exec { + let arms = ExtentCase::ALL + .iter() + .map(|case| { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let cell = cursor.bind(&mut ops, project(param(0), Case::Extent(*case), e::STATUS)); + cursor.bind(&mut ops, Op::GuardPending { cell }); + let arm = match case { + ExtentCase::Root => Exec::Return { value: param(0) }, + ExtentCase::Scoped => { + let parent = + cursor.bind(&mut ops, project(param(0), Case::Extent(*case), e::PARENT)); + tail(ControlHelperRole::Check, vec![parent]) + } + }; + (case.tag(), steps(ops, arm)) + }) + .collect(); + switch(param(0), Case::Extent(ExtentCase::Root), arms) +} + +/// Close the current extent's own status and return it. +/// +/// Parameters: `boundary`. +pub(crate) fn boundary_close() -> Exec { + let arms = ExtentCase::ALL + .iter() + .map(|case| { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let cell = cursor.bind(&mut ops, project(param(0), Case::Extent(*case), e::STATUS)); + cursor.bind(&mut ops, Op::SetStatus { cell, value: 1 }); + (case.tag(), steps(ops, Exec::Return { value: param(0) })) + }) + .collect(); + switch(param(0), Case::Extent(ExtentCase::Root), arms) +} + +/// Allocate a fresh root extent. +pub(crate) fn start_boundary() -> Exec { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let extent = cursor.bind(&mut ops, Op::FreshExtent { parent: None }); + steps(ops, Exec::Return { value: extent }) +} + +/// Allocate a one-shot owner object. +/// +/// Parameters: `continuation`. +pub(crate) fn once() -> Exec { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let callback = cursor.bind(&mut ops, Op::NewCallbackCell { value: param(0) }); + let status = cursor.bind(&mut ops, Op::NewStatus); + let owner = cursor.bind( + &mut ops, + Op::Node { + case: Case::Owner(OwnerCase::OneShot), + fields: vec![callback, status], + }, + ); + steps(ops, Exec::Return { value: owner }) +} + +/// Guard Pending, mark Cancelled, clear the callback and return the owner. +/// +/// Parameters: `owner`. +pub(crate) fn cancel() -> Exec { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let status = cursor.bind( + &mut ops, + project(param(0), Case::Owner(OwnerCase::OneShot), o::STATUS), + ); + cursor.bind( + &mut ops, + Op::GuardPending { + cell: status.clone(), + }, + ); + cursor.bind( + &mut ops, + Op::SetStatus { + cell: status.clone(), + value: 3, + }, + ); + let callback = cursor.bind( + &mut ops, + project(param(0), Case::Owner(OwnerCase::OneShot), o::CALLBACK), + ); + cursor.bind( + &mut ops, + Op::WriteCallback { + cell: callback, + value: status, + }, + ); + steps(ops, Exec::Return { value: param(0) }) +} + +/// The raw-resume closure adapter: read its saved queue and checkpoint +/// captures, check the checkpoint, and enter the raw `Resume` frame. +/// +/// Parameters: `receiver`, `value`. +pub(crate) fn raw_resume() -> Exec { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let saved = cursor.bind( + &mut ops, + Op::Capture { + closure: param(0), + index: 0, + case: Case::Sequence(SequenceCase::Empty), + }, + ); + let boundary = cursor.bind( + &mut ops, + Op::Capture { + closure: param(0), + index: 1, + case: Case::Extent(ExtentCase::Root), + }, + ); + cursor.bind( + &mut ops, + Op::CheckBoundary { + extent: boundary.clone(), + }, + ); + let result = cursor.bind( + &mut ops, + Op::Node { + case: Case::Computation(ComputationCase::Resume), + fields: vec![param(1), saved, boundary], + }, + ); + steps(ops, Exec::Return { value: result }) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/ir.rs b/crates/psrs-backend/src/cc/lower/control/plan/ir.rs new file mode 100644 index 00000000..87f51d13 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/ir.rs @@ -0,0 +1,303 @@ +//! The plan's named machine IR and construction helpers. + +use crate::cc::layout::control::ControlLayout; +use crate::cc::{ControlHelperRole, ReprId}; +use crate::control::schema::{ComputationCase, ContextCase, ExtentCase, OwnerCase, SequenceCase}; + +/// A named executor parameter. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum State { + Value, + Handler, + Computation, + Sequence, + Extent, + Context, +} + +pub(crate) fn state_index(state: State) -> usize { + match state { + State::Value => 0, + State::Handler => 1, + State::Computation => 2, + State::Sequence => 3, + State::Extent => 4, + State::Context => 5, + } +} + +/// A value available to a transition. +#[derive(Clone, Debug)] +pub(crate) enum Operand { + State(State), + /// A caller-supplied parameter of a helper body. + Param(usize), + /// A result bound earlier in the enclosing scope. + Temp(usize), +} + +pub(crate) fn state(slot: State) -> Operand { + Operand::State(slot) +} + +/// The machine case family a projection or allocation belongs to. +/// The machine carrier a case belongs to, without its inner case value. +#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord, Hash)] +pub(crate) enum Family { + Computation, + Sequence, + Context, + Extent, + Owner, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum Case { + Computation(ComputationCase), + Sequence(SequenceCase), + Context(ContextCase), + Extent(ExtentCase), + Owner(OwnerCase), +} + +impl Case { + pub(crate) fn family(self) -> Family { + match self { + Self::Computation(_) => Family::Computation, + Self::Sequence(_) => Family::Sequence, + Self::Context(_) => Family::Context, + Self::Extent(_) => Family::Extent, + Self::Owner(_) => Family::Owner, + } + } + + pub(crate) fn repr(self, layout: ControlLayout) -> ReprId { + match self { + Self::Computation(_) => layout.computation, + Self::Sequence(_) => layout.sequence, + Self::Context(_) => layout.context, + Self::Extent(_) => layout.boundary, + Self::Owner(_) => layout.owner, + } + } + + pub(crate) fn tag(self) -> u32 { + match self { + Self::Computation(case) => case.tag(), + Self::Sequence(case) => case.tag(), + Self::Context(case) => case.tag(), + Self::Extent(case) => case.tag(), + Self::Owner(case) => case.tag(), + } + } + + pub(crate) fn field_count(self) -> usize { + match self { + Self::Computation(case) => case.field_count(), + Self::Sequence(case) => case.field_count(), + Self::Context(case) => case.field_count(), + Self::Extent(case) => case.field_count(), + Self::Owner(case) => case.field_count(), + } + } + + /// The cases a dispatch on this family must cover. + pub(crate) fn tags(self) -> Vec { + match self { + Self::Computation(_) => ComputationCase::ALL.iter().map(|c| c.tag()).collect(), + Self::Sequence(_) => SequenceCase::ALL.iter().map(|c| c.tag()).collect(), + Self::Context(_) => ContextCase::ALL.iter().map(|c| c.tag()).collect(), + Self::Extent(_) => ExtentCase::ALL.iter().map(|c| c.tag()).collect(), + Self::Owner(_) => OwnerCase::ALL.iter().map(|c| c.tag()).collect(), + } + } +} + +/// One ordered construction step. Every step binds a result so an effectful step +/// is sequenced before the outcome even when its result is unused. +#[derive(Clone, Debug)] +pub(crate) enum Op { + Project { + source: Operand, + case: Case, + field: u32, + }, + Node { + case: Case, + fields: Vec, + }, + /// Read a capture slot of a closure; `case` names the expected shape. + Capture { + closure: Operand, + index: u32, + case: Case, + }, + Apply { + callee: Operand, + args: Vec, + }, + Helper { + role: ControlHelperRole, + args: Vec, + }, + ResumeClosure { + captures: Vec, + }, + Pair { + state: Operand, + value: Operand, + }, + PairField { + pair: Operand, + field: u32, + }, + ReplayField { + result: Operand, + field: u32, + }, + FreshExtent { + parent: Option, + }, + ContextExtent { + context: Operand, + }, + CheckBoundary { + extent: Operand, + }, + CloseBoundary { + extent: Operand, + }, + GuardPending { + cell: Operand, + }, + SetStatus { + cell: Operand, + value: i32, + }, + ReadCallback { + cell: Operand, + }, + WriteCallback { + cell: Operand, + value: Operand, + }, + /// Allocate the one-element callback cell holding a reference value. + NewCallbackCell { + value: Operand, + }, + /// Allocate a fresh one-element integer status cell initialised to zero. + NewStatus, + /// Allocate a planned product of erased fields. + Product { + product: Product, + fields: Vec, + }, + EmptySequence, +} + +/// A program over the machine's named case refinements. +#[derive(Clone, Debug)] +pub(crate) enum Exec { + /// Bind each operation's result in order, then continue. + Steps { ops: Vec, next: Box }, + /// Refine one carrier by case; every schema case has exactly one arm. + Switch { + source: Operand, + case: Case, + arms: Vec<(u32, Exec)>, + }, + /// Continue the executor with a complete named state. + Advance { + state: Operand, + handler: Operand, + computation: Operand, + sequence: Operand, + extent: Operand, + context: Operand, + }, + /// Return the published result pair. + Publish { result: Operand }, + /// Return one value from a helper body. + Return { value: Operand }, + /// Call a helper as the body's final action and return its result. + Tail { + role: ControlHelperRole, + args: Vec, + }, + /// Trap with a value of the given planned shape, matching a sibling arm. + Reject { shape: Shape }, +} + +/// A planned representation the builder names without a concrete [`ReprId`]. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum Product { + ReplayResult, +} + +/// The shape of a rejected arm, named without a concrete representation. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum Shape { + ReplayResult, +} + +/// Assigns temporary indices in emission order. A scope's arms share the +/// cursor position they start from, matching the cloned environment the +/// expander gives each arm. +#[derive(Clone)] +pub(crate) struct Cursor { + next: usize, +} + +impl Cursor { + pub(crate) fn new() -> Self { + Self { next: 0 } + } + + pub(crate) fn bind(&mut self, ops: &mut Vec, op: Op) -> Operand { + let operand = Operand::Temp(self.next); + ops.push(op); + self.next += 1; + operand + } +} + +pub(crate) fn steps(ops: Vec, next: Exec) -> Exec { + Exec::Steps { + ops, + next: Box::new(next), + } +} + +pub(crate) fn switch(source: Operand, case: Case, arms: Vec<(u32, Exec)>) -> Exec { + Exec::Switch { source, case, arms } +} + +pub(crate) fn advance_all( + state: Operand, + handler: Operand, + computation: Operand, + sequence: Operand, + extent: Operand, + context: Operand, +) -> Exec { + Exec::Advance { + state, + handler, + computation, + sequence, + extent, + context, + } +} + +/// Advance while preserving the current extent and dispatch context. +pub(crate) fn advance_here(computation: Operand, sequence: Operand) -> Exec { + advance_all( + state(State::Value), + state(State::Handler), + computation, + sequence, + state(State::Extent), + state(State::Context), + ) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/mod.rs b/crates/psrs-backend/src/cc/lower/control/plan/mod.rs new file mode 100644 index 00000000..a6252a19 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/mod.rs @@ -0,0 +1,154 @@ +//! A temporary checked construction plan for the flat driver. +//! +//! The plan names each transition's selected cases, its ordered projections, +//! allocations, applications, helper calls and extent/status operations, and +//! exactly one terminal outcome. It is effect-agnostic and independent of any +//! concrete operation or handler. +//! +//! The executor is *built* from this plan: [`Machine::expand`] emits ordinary CC +//! from the same structure that [`check`] independently validates. An emitter +//! defect therefore fails the structural check before the generic CC verifiers +//! see a body at all. +//! +//! The module is split by responsibility: [`ir`] names the plan structure and +//! its construction helpers, [`returns`]/[`driver`]/[`handle`] build the +//! transitions, [`check`] validates the plan and [`expand`] emits ordinary CC. + +mod boundary; +mod check; +mod driver; +mod expand; +mod handle; +mod helpers; +mod ir; +#[cfg(test)] +mod model; +mod returns; +mod shape; + +pub(crate) use boundary::check_boundary; +pub(super) use check::check; +pub(super) use check::verify as verify_plan; +pub(super) use helpers::{ + boundary_check, boundary_close, cancel, clone_sequence, once, raw_resume, rebuild_sequence, + start_boundary, +}; +pub(crate) use ir::{Exec as PlanExec, Family}; +pub(crate) use shape::{Shape, shape as shape_of}; + +use crate::control::schema::ComputationCase; +use ir::{Case, Cursor, Exec, State, state, switch}; + +/// Build the complete flat-driver program. +pub(super) fn executor() -> Exec { + let cursor = Cursor::new(); + let arms = ComputationCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + ComputationCase::Return => returns::returned(&mut cursor), + ComputationCase::Perform => driver::perform(&mut cursor), + ComputationCase::Bind => driver::bind(&mut cursor), + ComputationCase::Resume => driver::resume(&mut cursor), + ComputationCase::Handle => handle::handle(&mut cursor), + ComputationCase::OwnedResume => handle::owned_resume(&mut cursor), + }; + (case.tag(), arm) + }) + .collect(); + switch( + state(State::Computation), + Case::Computation(ComputationCase::Return), + arms, + ) +} + +#[cfg(test)] +mod tests { + use super::ir::{Case, Exec, Op, Operand, Shape, State}; + use super::*; + use crate::control::schema::{ComputationCase, SequenceCase}; + + #[test] + fn executor_plan_is_complete() { + check(&executor()).expect("the driver plan covers every required action"); + } + + #[test] + fn helper_plans_are_well_formed() { + for plan in [ + clone_sequence(), + rebuild_sequence(), + boundary_check(), + boundary_close(), + start_boundary(), + once(), + cancel(), + raw_resume(), + ] { + verify_plan(&plan).expect("helper plan must be well-formed"); + } + } + + #[test] + fn dispatch_rejects_an_invented_case() { + let plan = Exec::Switch { + source: Operand::State(State::Computation), + case: Case::Computation(ComputationCase::Return), + arms: vec![( + 99, + Exec::Publish { + result: Operand::State(State::Value), + }, + )], + }; + assert!(check(&plan).is_err()); + } + + #[test] + fn dispatch_rejects_a_duplicate_case() { + let plan = Exec::Switch { + source: Operand::State(State::Computation), + case: Case::Computation(ComputationCase::Return), + arms: vec![ + ( + 0, + Exec::Reject { + shape: Shape::ReplayResult, + }, + ), + ( + 0, + Exec::Reject { + shape: Shape::ReplayResult, + }, + ), + ], + }; + assert!(verify_plan(&plan).is_err()); + } + + #[test] + fn node_field_arity_is_checked() { + let plan = Exec::Steps { + ops: vec![Op::Node { + case: Case::Sequence(SequenceCase::Cons), + fields: vec![Operand::Param(0)], + }], + next: Box::new(Exec::Return { + value: Operand::Param(0), + }), + }; + assert!(verify_plan(&plan).is_err()); + } + + #[test] + fn dropping_an_action_fails_the_check() { + let mut plan = executor(); + if let Exec::Switch { arms, .. } = &mut plan { + arms.retain(|(tag, _)| *tag != ComputationCase::Perform.tag()); + } + assert!(check(&plan).is_err()); + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model.rs b/crates/psrs-backend/src/cc/lower/control/plan/model.rs new file mode 100644 index 00000000..41649f32 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model.rs @@ -0,0 +1,207 @@ +//! An independent bounded model of the flat driver's transition traces. +//! +//! `explore` recovers the terminal outcomes the plan reaches, keyed by the path +//! of case refinements. `expected` and `helper_expected` state the same +//! transitions directly from the operational semantics table, not from the plan +//! builders. The tests compare the two so a dropped, duplicated or mis-routed +//! transition is a mismatch rather than a silently passing recognizer. + +use super::ir::{Case, Exec}; +use super::shape::Terminal; +use crate::control::schema::{ComputationCase, ContextCase, ExtentCase, SequenceCase}; + +/// One trace: the refinement path and its terminal outcome. +type Trace = (Vec<(Case, u32)>, Terminal); +/// A named plan and the traces the semantics require of it. +type Planned = (&'static str, Exec, Vec); + +/// The terminal outcome reached by the plan along exactly `path`. +pub(super) fn terminal_of(exec: &Exec, path: &[(Case, u32)]) -> Option { + match path.split_first() { + None => leaf(exec), + Some(((case, tag), rest)) => match exec { + Exec::Steps { next, .. } => terminal_of(next, path), + Exec::Switch { + case: actual, arms, .. + } if same_family(*actual, *case) => { + let arm = arms.iter().find(|(candidate, _)| candidate == tag)?; + terminal_of(&arm.1, rest) + } + _ => None, + }, + } +} + +fn leaf(exec: &Exec) -> Option { + match exec { + Exec::Steps { next, .. } => leaf(next), + Exec::Advance { .. } => Some(Terminal::Advance), + Exec::Publish { .. } | Exec::Return { .. } => Some(Terminal::Value), + Exec::Tail { .. } => Some(Terminal::Tail), + Exec::Reject { .. } => Some(Terminal::Reject), + Exec::Switch { .. } => None, + } +} + +/// A switch declares one case as a family marker; the refined tag is the path. +fn same_family(left: Case, right: Case) -> bool { + std::mem::discriminant(&left) == std::mem::discriminant(&right) +} + +/// The number of terminal traces the plan has. +pub(super) fn trace_count(exec: &Exec) -> usize { + match exec { + Exec::Steps { next, .. } => trace_count(next), + Exec::Switch { arms, .. } => arms.iter().map(|(_, arm)| trace_count(arm)).sum(), + _ => 1, + } +} + +fn c(case: ComputationCase) -> Case { + Case::Computation(case) +} +fn s(case: SequenceCase) -> Case { + Case::Sequence(case) +} +fn x(case: ContextCase) -> Case { + Case::Context(case) +} +fn e(case: ExtentCase) -> Case { + Case::Extent(case) +} + +/// The transition traces required by the semantics, independent of the builder. +pub(super) fn expected() -> Vec { + use ComputationCase::*; + use ContextCase::*; + use SequenceCase::*; + use Terminal::*; + vec![ + // Return: publish at the root, or apply the return clause and advance. + (vec![(c(Return), 0), (s(Empty), 0), (x(Root), 0)], Value), + (vec![(c(Return), 0), (s(Empty), 0), (x(Scoped), 1)], Advance), + (vec![(c(Return), 0), (s(Cons), 1)], Advance), + (vec![(c(Return), 0), (s(Append), 2), (s(Empty), 0)], Advance), + (vec![(c(Return), 0), (s(Append), 2), (s(Cons), 1)], Advance), + ( + vec![(c(Return), 0), (s(Append), 2), (s(Append), 2)], + Advance, + ), + ( + vec![(c(Return), 0), (s(Append), 2), (s(Finish), 3)], + Advance, + ), + (vec![(c(Return), 0), (s(Finish), 3)], Advance), + // Perform: root applies the handler, scoped applies the operation clause. + (vec![(c(Perform), 1), (x(Root), 0)], Advance), + (vec![(c(Perform), 1), (x(Scoped), 1)], Advance), + // Inert frames advance directly. + (vec![(c(Bind), 2)], Advance), + (vec![(c(Resume), 3)], Advance), + // Handle: normalize Append, otherwise enter under a fresh or shared extent. + (vec![(c(Handle), 4), (s(Empty), 0)], Advance), + (vec![(c(Handle), 4), (s(Cons), 1)], Advance), + (vec![(c(Handle), 4), (s(Append), 2), (s(Empty), 0)], Advance), + (vec![(c(Handle), 4), (s(Append), 2), (s(Cons), 1)], Advance), + ( + vec![(c(Handle), 4), (s(Append), 2), (s(Append), 2)], + Advance, + ), + ( + vec![(c(Handle), 4), (s(Append), 2), (s(Finish), 3)], + Advance, + ), + (vec![(c(Handle), 4), (s(Finish), 3)], Advance), + (vec![(c(OwnedResume), 5)], Advance), + ] +} + +/// The helper bodies' required traces, independent of their builders. +pub(super) fn helper_expected() -> Vec { + use ExtentCase::*; + use SequenceCase::*; + use Terminal::*; + vec![ + ( + "clone_sequence", + super::clone_sequence(), + vec![ + (vec![(s(Empty), 0), (s(Empty), 0)], Tail), + (vec![(s(Empty), 0), (s(Append), 2)], Tail), + (vec![(s(Empty), 0), (s(Cons), 1)], Reject), + (vec![(s(Empty), 0), (s(Finish), 3)], Reject), + (vec![(s(Cons), 1)], Tail), + (vec![(s(Append), 2)], Tail), + (vec![(s(Finish), 3)], Tail), + ], + ), + ( + "rebuild_sequence", + super::rebuild_sequence(), + vec![ + (vec![(s(Empty), 0)], Value), + (vec![(s(Cons), 1)], Tail), + (vec![(s(Finish), 3)], Tail), + ], + ), + ( + "boundary_check", + super::boundary_check(), + vec![(vec![(e(Root), 0)], Value), (vec![(e(Scoped), 1)], Tail)], + ), + ( + "boundary_close", + super::boundary_close(), + vec![(vec![(e(Root), 0)], Value), (vec![(e(Scoped), 1)], Value)], + ), + ( + "start_boundary", + super::start_boundary(), + vec![(vec![], Value)], + ), + ("once", super::once(), vec![(vec![], Value)]), + ("cancel", super::cancel(), vec![(vec![], Value)]), + ("raw_resume", super::raw_resume(), vec![(vec![], Value)]), + ] +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn plan_matches_the_independent_model() { + let plan = super::super::executor(); + let expected = expected(); + assert_eq!( + trace_count(&plan), + expected.len(), + "plan trace count disagrees with the model" + ); + for (path, terminal) in &expected { + assert_eq!( + terminal_of(&plan, path).as_ref(), + Some(terminal), + "plan has no matching terminal for {path:?}" + ); + } + } + + #[test] + fn helper_plans_match_the_model() { + for (name, plan, expected) in helper_expected() { + assert_eq!( + trace_count(&plan), + expected.len(), + "{name} trace count disagrees with the model" + ); + for (path, terminal) in &expected { + assert_eq!( + terminal_of(&plan, path).as_ref(), + Some(terminal), + "{name} has no matching terminal for {path:?}" + ); + } + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/returns.rs b/crates/psrs-backend/src/cc/lower/control/plan/returns.rs new file mode 100644 index 00000000..591da8e6 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/returns.rs @@ -0,0 +1,362 @@ +//! Return/queue transitions of the flat driver. + +use super::ir::*; +use crate::control::schema::{ + ComputationCase, ContextCase, SequenceCase, computation as c, context as x, sequence as q, +}; + +/// Return publishes or applies the current return clause, then consumes the +/// current queue. +pub(super) fn returned(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let value = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Computation), + case: Case::Computation(ComputationCase::Return), + field: c::PAYLOAD, + }, + ); + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => return_empty(&cursor, value.clone()), + SequenceCase::Cons => return_cons(&mut cursor, value.clone()), + SequenceCase::Append => return_append(&mut cursor, value.clone()), + SequenceCase::Finish => return_finish(&mut cursor), + }; + (case.tag(), arm) + }) + .collect(); + steps( + ops, + switch( + state(State::Sequence), + Case::Sequence(SequenceCase::Empty), + arms, + ), + ) +} + +/// A return at an empty queue publishes at the root or enters a scoped target. +pub(super) fn return_empty(cursor: &Cursor, value: Operand) -> Exec { + let arms = ContextCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + ContextCase::Root => { + let mut ops = Vec::new(); + let pair = cursor.bind( + &mut ops, + Op::Pair { + state: state(State::Value), + value: value.clone(), + }, + ); + steps(ops, Exec::Publish { result: pair }) + } + ContextCase::Scoped => return_clause(&mut cursor, value.clone()), + }; + (case.tag(), arm) + }) + .collect(); + switch( + state(State::Context), + Case::Context(ContextCase::Root), + arms, + ) +} + +/// Apply the scoped return clause and enter the target with a fresh finish. +pub(super) fn return_clause(cursor: &mut Cursor, value: Operand) -> Exec { + let mut ops = Vec::new(); + let ret = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_RETURN, + }, + ); + let target = cursor.bind( + &mut ops, + Op::Apply { + callee: ret, + args: vec![value], + }, + ); + steps(ops, enter_target(cursor, target)) +} + +/// Build the finish record for the current scoped context and advance into the +/// target under the caller's context and the shared extent. +pub(super) fn enter_target(cursor: &mut Cursor, target: Operand) -> Exec { + let mut ops = Vec::new(); + let saved = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_SAVED, + }, + ); + let parent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_PARENT, + }, + ); + let caller = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_CALLER, + }, + ); + let extent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Context), + case: Case::Context(ContextCase::Scoped), + field: x::SCOPED_EXTENT, + }, + ); + let finish = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Finish), + fields: vec![extent.clone(), saved, parent], + }, + ); + steps( + ops, + advance_all( + state(State::Value), + state(State::Handler), + target, + finish, + extent, + caller, + ), + ) +} + +pub(super) fn return_cons(cursor: &mut Cursor, value: Operand) -> Exec { + let mut ops = Vec::new(); + let head = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Cons), + field: q::CONS_HEAD, + }, + ); + let tail = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Cons), + field: q::CONS_TAIL, + }, + ); + let next = cursor.bind( + &mut ops, + Op::Apply { + callee: head, + args: vec![value], + }, + ); + steps(ops, advance_here(next, tail)) +} + +pub(super) fn return_append(cursor: &mut Cursor, value: Operand) -> Exec { + let mut ops = Vec::new(); + let left = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Append), + field: q::APPEND_LEFT, + }, + ); + let right = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Append), + field: q::APPEND_RIGHT, + }, + ); + steps(ops, append(cursor, value, left, right)) +} + +/// Reassociate an Append so left-to-right work and Finish ownership are kept. +pub(super) fn append(cursor: &Cursor, value: Operand, left: Operand, right: Operand) -> Exec { + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => advance_here(state(State::Computation), right.clone()), + SequenceCase::Cons => { + let mut ops = Vec::new(); + let head = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Cons), + field: q::CONS_HEAD, + }, + ); + let rest = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Cons), + field: q::CONS_TAIL, + }, + ); + let pending = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![rest, right.clone()], + }, + ); + let next = cursor.bind( + &mut ops, + Op::Apply { + callee: head, + args: vec![value.clone()], + }, + ); + steps(ops, advance_here(next, pending)) + } + SequenceCase::Append => { + let mut ops = Vec::new(); + let first = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Append), + field: q::APPEND_LEFT, + }, + ); + let second = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Append), + field: q::APPEND_RIGHT, + }, + ); + let rest = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![second, right.clone()], + }, + ); + let pending = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![first, rest], + }, + ); + steps(ops, advance_here(state(State::Computation), pending)) + } + SequenceCase::Finish => { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_EXTENT, + }, + ); + let rest = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_REST, + }, + ); + let parent = cursor.bind( + &mut ops, + Op::Project { + source: left.clone(), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_PARENT, + }, + ); + let pending = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Append), + fields: vec![rest, right.clone()], + }, + ); + let finish = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Finish), + fields: vec![extent, pending, parent], + }, + ); + steps(ops, advance_here(state(State::Computation), finish)) + } + }; + (case.tag(), arm) + }) + .collect(); + switch(left, Case::Sequence(SequenceCase::Append), arms) +} + +pub(super) fn return_finish(cursor: &mut Cursor) -> Exec { + let mut ops = Vec::new(); + let extent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_EXTENT, + }, + ); + let rest = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_REST, + }, + ); + let parent = cursor.bind( + &mut ops, + Op::Project { + source: state(State::Sequence), + case: Case::Sequence(SequenceCase::Finish), + field: q::FINISH_PARENT, + }, + ); + cursor.bind(&mut ops, Op::CloseBoundary { extent }); + steps( + ops, + advance_all( + state(State::Value), + state(State::Handler), + state(State::Computation), + rest, + parent, + state(State::Context), + ), + ) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/shape.rs b/crates/psrs-backend/src/cc/lower/control/plan/shape.rs new file mode 100644 index 00000000..3a76f2c5 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/shape.rs @@ -0,0 +1,43 @@ +//! The dispatch/outcome shape of a plan, shared by the boundary checker. +//! +//! A [`Shape`] is the tree of machine-carrier switches a body performs and the +//! terminal outcome each path reaches. It is derived from the plan by +//! [`shape`] and from emitted CC by the P8 boundary checker; comparing the two +//! is how the boundary validates that expansion emitted the checked program. + +use super::ir::{Exec, Family}; + +/// The terminal outcome class of one plan path. +#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord, Hash)] +pub(crate) enum Terminal { + /// Continue the flat driver with a complete state. + Advance, + /// Tail-call another machine helper. + Tail, + /// Publish or return a value from the body. + Value, + /// Trap on an unsupported alternative. + Reject, +} + +/// A dispatch/outcome tree. Switch arms are in schema order. +#[derive(Clone, Debug, PartialEq, Eq)] +pub(crate) enum Shape { + Switch(Family, Vec<(u32, Shape)>), + Leaf(Terminal), +} + +/// Derive the shape of a plan. +pub(crate) fn shape(exec: &Exec) -> Shape { + match exec { + Exec::Steps { next, .. } => shape(next), + Exec::Switch { case, arms, .. } => Shape::Switch( + case.family(), + arms.iter().map(|(tag, arm)| (*tag, shape(arm))).collect(), + ), + Exec::Advance { .. } => Shape::Leaf(Terminal::Advance), + Exec::Tail { .. } => Shape::Leaf(Terminal::Tail), + Exec::Publish { .. } | Exec::Return { .. } => Shape::Leaf(Terminal::Value), + Exec::Reject { .. } => Shape::Leaf(Terminal::Reject), + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/replay.rs b/crates/psrs-backend/src/cc/lower/control/replay.rs index 2f699d8e..e1e23cd6 100644 --- a/crates/psrs-backend/src/cc/lower/control/replay.rs +++ b/crates/psrs-backend/src/cc/lower/control/replay.rs @@ -1,215 +1,60 @@ //! Instantiate lifecycle frames when replaying a persistent source checkpoint. //! Ordinary callbacks and one-shot owner objects are shared, never cloned. +//! +//! The bodies are built from the checked plans in [`super::plan`]; only the +//! replay-result projection stays here because the executor also uses it. use super::builder::{Machine, repr}; -use super::executor::arm; use crate::cc::{Assignment, AssignmentKind, Function, ValueId}; -use crate::control::schema::{SequenceCase, sequence as q}; impl Machine<'_> { - /// Flatten into a reversed heap sequence with an explicit traversal stack. pub(super) fn clone_sequence(mut self) -> Function { let queue = self.lower.fresh(repr(self.layout.sequence)); let todo = self.lower.fresh(repr(self.layout.sequence)); let reversed = self.lower.fresh(repr(self.layout.sequence)); let active = self.lower.fresh(repr(self.layout.boundary)); let parent = self.lower.fresh(repr(self.layout.boundary)); - let mut cases = Vec::new(); + let params = [queue, todo, reversed, active, parent]; + let program = super::plan::clone_sequence(); + super::plan::verify_plan(&program).expect("clone_sequence plan must be well-formed"); let mut body = Vec::new(); - let mut empty_cases = Vec::new(); - for case in SequenceCase::ALL { - let mut branch = Vec::new(); - let result = if case == SequenceCase::Empty { - self.replay_call( - self.functions.rebuild_sequence, - vec![reversed, todo, active, parent], - &mut branch, - ) - } else if case == SequenceCase::Append { - // The traversal stack is built exclusively from Append nodes. - let next = self.field( - todo, - self.layout.sequence, - case.tag(), - q::APPEND_LEFT, - &mut branch, - ); - let rest = self.field( - todo, - self.layout.sequence, - case.tag(), - q::APPEND_RIGHT, - &mut branch, - ); - self.replay_call( - self.functions.clone_sequence, - vec![next, rest, reversed, active, parent], - &mut branch, - ) - } else { - self.emit(repr(self.layout.replay_result), &mut branch, |_| { - AssignmentKind::Unreachable - }) - }; - empty_cases.push(arm(case.tag(), branch, result)); - } - let result = self.switch(todo, self.layout.sequence, empty_cases, &mut body); - cases.push(arm(SequenceCase::Empty.tag(), body, result)); - for case in [ - SequenceCase::Cons, - SequenceCase::Append, - SequenceCase::Finish, - ] { - let mut branch = Vec::new(); - let (next, todo, reversed) = if case == SequenceCase::Append { - let left = self.field( - queue, - self.layout.sequence, - case.tag(), - q::APPEND_LEFT, - &mut branch, - ); - let right = self.field( - queue, - self.layout.sequence, - case.tag(), - q::APPEND_RIGHT, - &mut branch, - ); - let todo = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![right, todo], - &mut branch, - ); - (left, todo, reversed) - } else { - let payload = self.field( - queue, - self.layout.sequence, - case.tag(), - q::CONS_HEAD, - &mut branch, - ); - let rest = self.field( - queue, - self.layout.sequence, - case.tag(), - q::CONS_TAIL, - &mut branch, - ); - let fields = if case == SequenceCase::Cons { - vec![payload, reversed] - } else { - self.check_boundary(payload, &mut branch); - vec![payload, reversed, parent] - }; - let reversed = self.node(self.layout.sequence, case.tag(), fields, &mut branch); - (rest, todo, reversed) - }; - let result = self.replay_call( - self.functions.clone_sequence, - vec![next, todo, reversed, active, parent], - &mut branch, - ); - cases.push(arm(case.tag(), branch, result)); - } - let mut body = Vec::new(); - let result = self.switch(queue, self.layout.sequence, cases, &mut body); + let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); + let representations = self.lower.representations; let symbol = self.functions.clone_sequence; - self.finish( + let function = self.finish( symbol, "control_clone_sequence", - vec![queue, todo, reversed, active, parent], + params.to_vec(), body, result, - ) + ); + super::plan::check_boundary(&function, representations, &program) + .expect("clone_sequence boundary check must pass"); + function } - /// Rebuild from the outside inward, giving each finish a fresh child extent. pub(super) fn rebuild_sequence(mut self) -> Function { let reversed = self.lower.fresh(repr(self.layout.sequence)); let result_queue = self.lower.fresh(repr(self.layout.sequence)); let active = self.lower.fresh(repr(self.layout.boundary)); let parent = self.lower.fresh(repr(self.layout.boundary)); - let mut cases = Vec::new(); - let mut branch = Vec::new(); - let result = self.replay_result(result_queue, active, &mut branch); - cases.push(arm(SequenceCase::Empty.tag(), branch, result)); - for case in [SequenceCase::Cons, SequenceCase::Finish] { - let mut branch = Vec::new(); - let payload = self.field( - reversed, - self.layout.sequence, - case.tag(), - q::CONS_HEAD, - &mut branch, - ); - let rest = self.field( - reversed, - self.layout.sequence, - case.tag(), - q::CONS_TAIL, - &mut branch, - ); - let (fields, active) = if case == SequenceCase::Cons { - (vec![payload, result_queue], active) - } else { - let extent = self.new_boundary(Some(parent), &mut branch); - (vec![extent, result_queue, active], extent) - }; - let next = self.node(self.layout.sequence, case.tag(), fields, &mut branch); - let result = self.replay_call( - self.functions.rebuild_sequence, - vec![ - rest, - next, - active, - if case == SequenceCase::Finish { - active - } else { - parent - }, - ], - &mut branch, - ); - cases.push(arm(case.tag(), branch, result)); - } + let params = [reversed, result_queue, active, parent]; + let program = super::plan::rebuild_sequence(); + super::plan::verify_plan(&program).expect("rebuild_sequence plan must be well-formed"); let mut body = Vec::new(); - let result = self.switch(reversed, self.layout.sequence, cases, &mut body); + let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); + let representations = self.lower.representations; let symbol = self.functions.rebuild_sequence; - self.finish( + let function = self.finish( symbol, "control_rebuild_sequence", - vec![reversed, result_queue, active, parent], + params.to_vec(), body, result, - ) - } - - fn replay_call( - &mut self, - function: psrs_hir::SymbolId, - arguments: Vec, - body: &mut Vec, - ) -> ValueId { - self.call(function, arguments, body) - } - - fn replay_result( - &mut self, - queue: ValueId, - active: ValueId, - body: &mut Vec, - ) -> ValueId { - let representation = self.layout.replay_result; - self.emit(repr(representation), body, |destination| { - AssignmentKind::ProductNew { - destination, - representation, - arguments: vec![queue, active], - } - }) + ); + super::plan::check_boundary(&function, representations, &program) + .expect("rebuild_sequence boundary check must pass"); + function } pub(super) fn replay_field( diff --git a/crates/psrs-backend/src/cc/lower/control/scope.rs b/crates/psrs-backend/src/cc/lower/control/scope.rs index 3633bfe7..cdb10b5a 100644 --- a/crates/psrs-backend/src/cc/lower/control/scope.rs +++ b/crates/psrs-backend/src/cc/lower/control/scope.rs @@ -1,288 +1,21 @@ //! Source dispatch and target lifetime are separate heap contexts. +//! +//! The executor's use of these relations now lives in [`super::plan`]; this +//! module keeps only the named context-extent projection they share. use super::builder::Machine; use super::executor::arm; use crate::cc::{Assignment, ValueId}; -use crate::control::schema::{ComputationCase, ContextCase, SequenceCase, computation as c}; -use crate::control::schema::{context as x, sequence as q}; +use crate::control::schema::{ContextCase, context as x}; impl Machine<'_> { - pub(super) fn dispatch_boundary(&mut self, body: &mut Vec) -> ValueId { - let context = self.context.unwrap(); - let mut cases = Vec::new(); - for case in ContextCase::ALL { - let mut branch = Vec::new(); - let index = match case { - ContextCase::Root => x::ROOT_EXTENT, - ContextCase::Scoped => x::SCOPED_EXTENT, - }; - let extent = self.field(context, self.layout.context, case.tag(), index, &mut branch); - cases.push(arm(case.tag(), branch, extent)); - } - self.switch(context, self.layout.context, cases, body) - } - - pub(super) fn enter_handle( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let ret = self.field( - computation, - self.layout.computation, - ComputationCase::Handle.tag(), - c::HANDLE_RETURN, - body, - ); - let op = self.field( - computation, - self.layout.computation, - ComputationCase::Handle.tag(), - c::HANDLE_OPERATION, - body, - ); - let inner = self.field( - computation, - self.layout.computation, - ComputationCase::Handle.tag(), - c::HANDLE_SOURCE, - body, - ); - let caller = self.context.unwrap(); - let parent = self.boundary.unwrap(); - let mut cases = Vec::new(); - for case in SequenceCase::ALL { - let mut branch = Vec::new(); - if case == SequenceCase::Append { - let result = - self.normalize_handle_queue(state, handler, computation, sequence, &mut branch); - cases.push(arm(case.tag(), branch, result)); - continue; - } - // A leading compiler finish marker has the same checked target - // answer boundary as this tail-returned Handle. Share that extent - // and remove its duplicate finish; no user continuation is skipped. - let (saved, parent, extent) = if case == SequenceCase::Finish { - let extent = self.field( - sequence, - self.layout.sequence, - case.tag(), - q::FINISH_EXTENT, - &mut branch, - ); - let saved = self.field( - sequence, - self.layout.sequence, - case.tag(), - q::FINISH_REST, - &mut branch, - ); - let parent = self.field( - sequence, - self.layout.sequence, - case.tag(), - q::FINISH_PARENT, - &mut branch, - ); - (saved, parent, extent) - } else { - let extent = self.new_boundary(Some(parent), &mut branch); - (sequence, parent, extent) - }; - let context = self.node( - self.layout.context, - ContextCase::Scoped.tag(), - vec![ret, op, saved, parent, caller, extent], - &mut branch, - ); - let empty = self.node( - self.layout.sequence, - SequenceCase::Empty.tag(), - vec![], - &mut branch, - ); - let old_context = self.context.replace(context); - let old_boundary = self.boundary.replace(extent); - let result = self.recur(state, handler, inner, empty, &mut branch); - self.context = old_context; - self.boundary = old_boundary; - cases.push(arm(case.tag(), branch, result)); - } - self.switch(sequence, self.layout.sequence, cases, body) - } - - fn normalize_handle_queue( + /// The current dispatch checkpoint of a context: root field 0 or scoped + /// field 5. Named so replay and closure capture do not recover the offset. + pub(super) fn context_extent( &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, + context: ValueId, body: &mut Vec, ) -> ValueId { - let left = self.field( - sequence, - self.layout.sequence, - SequenceCase::Append.tag(), - q::APPEND_LEFT, - body, - ); - let right = self.field( - sequence, - self.layout.sequence, - SequenceCase::Append.tag(), - q::APPEND_RIGHT, - body, - ); - let mut cases = Vec::new(); - for case in SequenceCase::ALL { - let mut branch = Vec::new(); - let pending = if case == SequenceCase::Empty { - right - } else { - let (head_field, rest_field, parent_field) = match case { - SequenceCase::Cons => (q::CONS_HEAD, q::CONS_TAIL, None), - SequenceCase::Append => (q::APPEND_LEFT, q::APPEND_RIGHT, None), - SequenceCase::Finish => { - (q::FINISH_EXTENT, q::FINISH_REST, Some(q::FINISH_PARENT)) - } - SequenceCase::Empty => unreachable!("empty handle queue has no head"), - }; - let head = self.field( - left, - self.layout.sequence, - case.tag(), - head_field, - &mut branch, - ); - let rest = self.field( - left, - self.layout.sequence, - case.tag(), - rest_field, - &mut branch, - ); - let rest = self.node( - self.layout.sequence, - SequenceCase::Append.tag(), - vec![rest, right], - &mut branch, - ); - let mut fields = vec![head, rest]; - if let Some(parent_field) = parent_field { - fields.push(self.field( - left, - self.layout.sequence, - case.tag(), - parent_field, - &mut branch, - )); - } - self.node(self.layout.sequence, case.tag(), fields, &mut branch) - }; - let result = self.recur(state, handler, computation, pending, &mut branch); - cases.push(arm(case.tag(), branch, result)); - } - self.switch(left, self.layout.sequence, cases, body) - } - - pub(super) fn finish_source( - &mut self, - state: ValueId, - handler: ValueId, - value: ValueId, - body: &mut Vec, - ) -> ValueId { - let context = self.context.unwrap(); - let mut branch = Vec::new(); - let result = self.pair(state, value, &mut branch); - let root = arm(ContextCase::Root.tag(), branch, result); - let mut branch = Vec::new(); - let ret = self.field( - context, - self.layout.context, - ContextCase::Scoped.tag(), - x::SCOPED_RETURN, - &mut branch, - ); - let target = self.apply(ret, &[value], &mut branch); - let result = self.enter_target(state, handler, target, &mut branch); - self.switch( - context, - self.layout.context, - vec![root, arm(ContextCase::Scoped.tag(), branch, result)], - body, - ) - } - - fn enter_target( - &mut self, - state: ValueId, - handler: ValueId, - target: ValueId, - body: &mut Vec, - ) -> ValueId { - let context = self.context.unwrap(); - let saved = self.field( - context, - self.layout.context, - ContextCase::Scoped.tag(), - x::SCOPED_SAVED, - body, - ); - let parent = self.field( - context, - self.layout.context, - ContextCase::Scoped.tag(), - x::SCOPED_PARENT, - body, - ); - let caller = self.field( - context, - self.layout.context, - ContextCase::Scoped.tag(), - x::SCOPED_CALLER, - body, - ); - let extent = self.field( - context, - self.layout.context, - ContextCase::Scoped.tag(), - x::SCOPED_EXTENT, - body, - ); - let finish = self.node( - self.layout.sequence, - SequenceCase::Finish.tag(), - vec![extent, saved, parent], - body, - ); - let old_context = self.context.replace(caller); - let old_boundary = self.boundary.replace(extent); - let result = self.recur(state, handler, target, finish, body); - self.context = old_context; - self.boundary = old_boundary; - result - } - - pub(super) fn requested( - &mut self, - state: ValueId, - handler: ValueId, - computation: ValueId, - sequence: ValueId, - body: &mut Vec, - ) -> ValueId { - let request = self.field( - computation, - self.layout.computation, - ComputationCase::Perform.tag(), - c::PAYLOAD, - body, - ); - let context = self.context.unwrap(); let mut cases = Vec::new(); for case in ContextCase::ALL { let mut branch = Vec::new(); @@ -291,43 +24,7 @@ impl Machine<'_> { ContextCase::Scoped => x::SCOPED_EXTENT, }; let extent = self.field(context, self.layout.context, case.tag(), index, &mut branch); - let continuation = self.closure( - self.functions.resume, - self.layout.continuation, - vec![sequence, extent], - &mut branch, - ); - let result = if case == ContextCase::Root { - let pair = self.apply(handler, &[state, request, continuation], &mut branch); - let next_state = self.pair_field( - pair, - crate::control::schema::result_pair::STATE, - &mut branch, - ); - let next = self.pair_field( - pair, - crate::control::schema::result_pair::VALUE, - &mut branch, - ); - let empty = self.node( - self.layout.sequence, - SequenceCase::Empty.tag(), - vec![], - &mut branch, - ); - self.recur(next_state, handler, next, empty, &mut branch) - } else { - let op = self.field( - context, - self.layout.context, - ContextCase::Scoped.tag(), - x::SCOPED_OPERATION, - &mut branch, - ); - let target = self.apply(op, &[request, continuation], &mut branch); - self.enter_target(state, handler, target, &mut branch) - }; - cases.push(arm(case.tag(), branch, result)); + cases.push(arm(case.tag(), branch, extent)); } self.switch(context, self.layout.context, cases, body) } diff --git a/crates/psrs-backend/src/cc/lower/mod.rs b/crates/psrs-backend/src/cc/lower/mod.rs index a38b45b4..027402c7 100644 --- a/crates/psrs-backend/src/cc/lower/mod.rs +++ b/crates/psrs-backend/src/cc/lower/mod.rs @@ -28,6 +28,7 @@ mod string_bytes; mod symbols; use call::ApplicationLowering; pub(super) use control::plan_control_helpers; +pub(crate) use control::{Family, Shape, plan_external_targets, plan_shape_for, verify_boundary}; pub(in crate::cc) use conversion::VariantFieldConversion; use global::GlobalLowering; use lambda::LambdaLowering; diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 363bcc82..06ea7305 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -17,6 +17,7 @@ pub use control::{ ControlHelperRole, ControlResumptionContract, SourceTypeIdentityId, TypeConstructorIdentity, TypeIdentity, }; +pub(crate) use lower::{Family, Shape, plan_external_targets, plan_shape_for}; mod convert; mod layout; mod lower; diff --git a/crates/psrs-backend/src/cc/value_identity.rs b/crates/psrs-backend/src/cc/value_identity.rs index 0ffa9b39..3f97eba6 100644 --- a/crates/psrs-backend/src/cc/value_identity.rs +++ b/crates/psrs-backend/src/cc/value_identity.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] //! Identity-preserving CC operations, shared by semantic evidence consumers. use super::{AssignmentKind, ValueConversion, ValueId}; use std::collections::HashSet; diff --git a/crates/psrs-backend/src/cc/verify/control/checkpoints.rs b/crates/psrs-backend/src/cc/verify/control/checkpoints.rs deleted file mode 100644 index d9097089..00000000 --- a/crates/psrs-backend/src/cc/verify/control/checkpoints.rs +++ /dev/null @@ -1,298 +0,0 @@ -//! Validate actual checkpoint capture, raw-frame construction and replay checks. -use crate::BackendError; -use crate::cc::{ - Assignment, AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, -}; -use crate::control::provenance::{ - CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, -}; -use std::collections::HashMap; - -type Definitions<'a> = HashMap; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - let Some(raw) = &table.control_resumption else { - return Ok(()); - }; - let schema = table - .control_checkpoint_schema() - .ok_or_else(|| error(function, "raw resumption has no checkpoint schema"))?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = |value| origin(value, &definitions); - let executor = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - if function.symbol == executor && function.parameters.len() != 6 { - return Err(error( - function, - "control executor has an invalid parameter contract", - )); - } - if function.symbol == raw.function() { - if function.parameters.len() != 2 { - return Err(error( - function, - "raw resumption has an invalid parameter contract", - )); - } - let result = origin(function.result); - let Some(A::VariantNew { - representation, - case: 3, - fields, - .. - }) = definitions.get(&result).copied() - else { - return Err(error( - function, - "raw resumption must return its saved Resume frame", - )); - }; - if *representation != schema.computation - || fields.len() != 3 - || origin(fields[0]) != function.parameters[1] - { - return Err(error( - function, - "raw resumption frame has an invalid answer or schema", - )); - } - checkpoint_capture_relation( - function.parameters[0], - capture(fields[1], &definitions), - capture(fields[2], &definitions), - ) - .map_err(|message| error(function, message))?; - let position = function - .assignments - .iter() - .position(|assignment| assignment.destination == result) - .ok_or_else(|| { - error( - function, - "raw resumption frame has no checked construction sequence", - ) - })?; - require_check( - function, - table, - &function.assignments[..position], - origin(fields[2]), - &definitions, - )?; - } - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for (index, assignment) in body.iter().enumerate() { - match &assignment.kind { - A::If { - then_assignments, - else_assignments, - .. - } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), - A::TagSwitch { - cases, - default_assignments, - .. - } => { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - A::FunctionRef { - function: target, - signature, - captures, - } if *target == raw.function() => { - if function.symbol != executor - || function.parameters.len() != 6 - || captures.len() != 2 - || *signature != raw.signature() - || origin(captures[0]) != function.parameters[3] - { - return Err(error( - function, - "raw resumption factory must capture the executor's current queue", - )); - } - let projection = match definitions.get(&origin(captures[1])).copied() { - Some(A::VariantGet { - representation, - case, - field, - value, - .. - }) if *representation == schema.context => { - Some((origin(*value), *case, *field)) - } - _ => None, - }; - dispatch_checkpoint_relation(function.parameters[5], projection) - .map_err(|message| error(function, message))?; - } - A::DirectCall { - contract: Some(contract), - arguments, - .. - } if function.symbol == executor - && table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::CloneSequence) => - { - if arguments.len() != 5 || origin(arguments[3]) != function.parameters[4] { - return Err(error( - function, - "replay must start with its current execution extent", - )); - } - for empty in &arguments[1..3] { - if !matches!(definitions.get(&origin(*empty)).copied(), Some(A::VariantNew { representation, case: 0, fields, .. }) - if Some(*representation) == table.control_sequence() && fields.is_empty()) - { - return Err(error( - function, - "replay must start with empty traversal accumulators", - )); - } - } - let Some(A::TagSwitch { - value: tag, - cases, - default_value, - .. - }) = definitions.get(&origin(arguments[4])).copied() - else { - return Err(error( - function, - "replay parent must select its current dispatch context", - )); - }; - if !matches!(definitions.get(&origin(*tag)).copied(), Some(A::VariantTag { representation, value, .. }) - if *representation == schema.context && origin(*value) == function.parameters[5]) - || cases.len() != 2 - || !matches!( - definitions.get(&origin(*default_value)).copied(), - Some(A::Unreachable) - ) - { - return Err(error( - function, - "replay parent must select its current dispatch context", - )); - } - let mut seen = std::collections::HashSet::new(); - for case in cases { - let projection = match definitions.get(&origin(case.value)).copied() { - Some(A::VariantGet { - representation, - case: selected, - field, - value, - .. - }) if *representation == schema.context - && *selected as i32 == case.tag => - { - Some((origin(*value), *selected, *field)) - } - _ => None, - }; - dispatch_checkpoint_relation(function.parameters[5], projection) - .map_err(|message| error(function, message))?; - seen.insert(case.tag); - } - if seen != std::collections::HashSet::from([0, 1]) { - return Err(error( - function, - "replay parent must cover root and scoped dispatch contexts", - )); - } - let Some(saved) = arguments.first() else { - return Err(error(function, "replay has no saved queue")); - }; - let Some(A::VariantGet { - representation, - case: 3, - field: 1, - value, - .. - }) = definitions.get(&origin(*saved)).copied() - else { - return Err(error( - function, - "replay must use the Resume frame's saved queue", - )); - }; - if *representation != schema.computation - || origin(*value) != function.parameters[2] - { - return Err(error(function, "replay must use the current Resume frame")); - } - let checkpoint = body[..index] - .iter() - .find_map(|assignment| match &assignment.kind { - A::VariantGet { - representation, - case: 3, - field: 2, - value: owner, - .. - } if *representation == schema.computation - && origin(*owner) == origin(*value) => - { - Some(origin(assignment.destination)) - } - _ => None, - }) - .ok_or_else(|| { - error(function, "replay has no current Resume checkpoint") - })?; - require_check(function, table, &body[..index], checkpoint, &definitions)?; - } - _ => {} - } - } - } - Ok(()) -} - -fn origin(value: ValueId, definitions: &Definitions<'_>) -> ValueId { - crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) -} - -fn capture(value: ValueId, definitions: &Definitions<'_>) -> Option { - match definitions.get(&origin(value, definitions)).copied()? { - A::ClosureGetCapture { closure, index } => Some(CaptureProjection { - receiver: origin(*closure, definitions), - slot: *index, - }), - _ => None, - } -} - -fn require_check( - function: &Function, - table: &RepresentationTable, - prefix: &[Assignment], - checkpoint: ValueId, - definitions: &Definitions<'_>, -) -> Result<(), Vec> { - if prefix.iter().any(|assignment| matches!(&assignment.kind, - A::DirectCall { contract: Some(contract), arguments, .. } - if table.control_helpers.get(contract.0 as usize).is_some_and(|helper| helper.role() == R::Check) - && arguments.len() == 1 && origin(arguments[0], definitions) == checkpoint)) { - Ok(()) - } else { Err(error(function, "resumption must check its saved checkpoint before construction or replay")) } -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC control checkpoint", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/clauses.rs b/crates/psrs-backend/src/cc/verify/control/clauses.rs deleted file mode 100644 index 7f9dc476..00000000 --- a/crates/psrs-backend/src/cc/verify/control/clauses.rs +++ /dev/null @@ -1,210 +0,0 @@ -//! A source return or operation applies its own scoped clause. -//! -//! Source context construction retains the clauses at fixed fields -//! (`context_entry`); this verifier checks that interpreting a source `Return` -//! or `Perform` actually applies the matching clause of the current scoped -//! context, rather than the wrong field, another frame's field or a boundary. -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::provenance::{ - ClauseKind, FinishProjection, clause_operand_relation, clause_selection_relation, -}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) - { - return Ok(()); - } - if function.parameters.len() != 6 { - return Err(error( - function, - "clause selection has an invalid executor contract", - )); - } - let schema = table - .control_checkpoint_schema() - .ok_or_else(|| error(function, "clause selection has no checked schema"))?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = |value| { - crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) - }; - let context = function.parameters[5]; - let Some(A::TagSwitch { cases, .. }) = definitions.get(&origin(function.result)).copied() - else { - // The dispatch verifier owns the result-shape contract. - return Ok(()); - }; - for case in cases { - let kind = if case.tag == ClauseKind::Return.source_tag() { - ClauseKind::Return - } else if case.tag == ClauseKind::Operation.source_tag() { - ClauseKind::Operation - } else { - continue; - }; - // Check every applied clause projection and require the scoped branch - // to consume its complete application result at the next transition. - let mut pending = vec![case.assignments.as_slice()]; - let mut steps = 0; - while let Some(body) = pending.pop() { - for assignment in body { - match &assignment.kind { - A::IndirectCall { - function: callee, .. - } => { - let clause = match definitions.get(&origin(*callee)).copied() { - Some(A::VariantGet { - representation, - case: 1, - field, - value, - .. - }) if *representation == schema.context => Some(FinishProjection { - owner: origin(*value), - field: *field, - }), - _ => None, - }; - if clause.is_some() { - clause_selection_relation(kind, origin(context), clause) - .map_err(|message| error(function, message))?; - } - } - A::TagSwitch { - value, - cases, - default_assignments, - .. - } => { - if crate::cc::branch_facts::tag_source(*value, &definitions) - == Some((schema.context, origin(context))) - { - let scoped = - cases.iter().find(|case| case.tag == 1).ok_or_else(|| { - error(function, "source step has no scoped clause path") - })?; - let Some(A::DirectCall { - function: target, - arguments, - .. - }) = definitions.get(&origin(scoped.value)).copied() - else { - return Err(error( - function, - "source clause result must enter the next executor step", - )); - }; - if *target != function.symbol || arguments.len() != 6 { - return Err(error( - function, - "source clause result must enter the next executor step", - )); - } - if origin(arguments[0]) != origin(function.parameters[0]) - || origin(arguments[1]) != origin(function.parameters[1]) - { - return Err(error( - function, - "source clause transition must preserve its state and root handler", - )); - } - let mut result = origin(arguments[2]); - let mut payload = None; - let mut resumption = None; - for _ in 0..(if kind == ClauseKind::Return { 1 } else { 2 }) { - let Some(A::IndirectCall { - function: callee, - arguments, - .. - }) = definitions.get(&result).copied() - else { - return Err(error( - function, - "source clause result must enter the next executor step", - )); - }; - if arguments.len() != 1 - || !scoped.assignments.iter().any(|a| a.destination == result) - { - return Err(error( - function, - "source clause application must execute in its scoped step", - )); - } - payload = Some(origin(arguments[0])); - resumption.get_or_insert(origin(arguments[0])); - result = origin(*callee); - } - let projection = - |value, repr, tag| match definitions.get(&value).copied() { - Some(A::VariantGet { - representation, - case, - field, - value, - .. - }) if *representation == repr && *case == tag => { - Some(FinishProjection { - owner: origin(*value), - field: *field, - }) - } - _ => None, - }; - clause_selection_relation( - kind, - origin(context), - projection(result, schema.context, 1), - ) - .map_err(|message| error(function, message))?; - clause_operand_relation( - origin(function.parameters[2]), - projection( - payload.unwrap(), - schema.computation, - kind.source_tag() as u32, - ), - ) - .map_err(|message| error(function, message))?; - if kind == ClauseKind::Operation - && !matches!(definitions.get(&resumption.unwrap()).copied(), Some(A::FunctionRef { function: target, .. }) - if table.control_resumption.as_ref().is_some_and(|raw| raw.function() == *target)) - { - return Err(error( - function, - "source operation clause must receive its raw resumption", - )); - } - steps += 1; - } - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - A::If { - then_assignments, - else_assignments, - .. - } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), - _ => {} - } - } - } - if steps == 0 { - return Err(error(function, "source step has no scoped clause path")); - } - } - Ok(()) -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC clause selection", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/context_entry.rs b/crates/psrs-backend/src/cc/verify/control/context_entry.rs deleted file mode 100644 index b5f93c80..00000000 --- a/crates/psrs-backend/src/cc/verify/control/context_entry.rs +++ /dev/null @@ -1,206 +0,0 @@ -//! Source Handle entry retains its clauses, caller work and lifetime boundary. -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::provenance::{ - FinishProjection, context_clause_relation, context_tail_relation, -}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) - { - return Ok(()); - } - let parameters = &function.parameters; - if parameters.len() != 6 { - return Err(error( - function, - "source context has an invalid executor contract", - )); - } - let checkpoint = table - .control_checkpoint_schema() - .ok_or_else(|| error(function, "source context has no checked schema"))?; - let schema = table - .control_replay_schema() - .ok_or_else(|| error(function, "source context has no checked lifecycle schema"))?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = |value| { - crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) - }; - let constant = |value, expected| { - matches!(definitions.get(&origin(value)).copied(), - Some(A::Constant(value)) if *value == expected) - }; - let projection = |value, expected, tag| match definitions.get(&origin(value)).copied() { - Some(A::VariantGet { - representation, - case, - field, - value, - .. - }) if *representation == expected && *case == tag => Some(FinishProjection { - owner: origin(*value), - field: *field, - }), - _ => None, - }; - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for (index, assignment) in body.iter().enumerate() { - match &assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - A::If { - then_assignments, - else_assignments, - .. - } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), - A::VariantNew { - representation, - case: 1, - fields, - .. - } if *representation == checkpoint.context => { - if fields.len() != 6 { - return Err(error( - function, - "source context has an invalid frame schema", - )); - } - context_clause_relation( - parameters[2], - projection(fields[0], checkpoint.computation, 4), - projection(fields[1], checkpoint.computation, 4), - ) - .map_err(|message| error(function, message))?; - if origin(fields[4]) != parameters[5] { - return Err(error( - function, - "source context must retain its current caller context", - )); - } - if projection(fields[5], schema.sequence, 3).is_some() { - context_tail_relation( - parameters[3], - projection(fields[2], schema.sequence, 3), - projection(fields[3], schema.sequence, 3), - projection(fields[5], schema.sequence, 3), - ) - .map_err(|message| error(function, message))?; - } else { - if origin(fields[2]) != parameters[3] || origin(fields[3]) != parameters[4] - { - return Err(error( - function, - "source context must save its current queue and execution parent", - )); - } - let Some(A::VariantNew { - representation, - case: 1, - fields: activation, - .. - }) = definitions.get(&origin(fields[5])).copied() - else { - return Err(error( - function, - "source context must allocate a fresh child extent", - )); - }; - if *representation != schema.boundary - || activation.len() != 2 - || origin(activation[1]) != parameters[4] - { - return Err(error( - function, - "source context extent must retain its current execution parent", - )); - } - let initialized = match definitions.get(&origin(activation[0])).copied() { - Some(A::ArrayNew { - representation, - elements, - .. - }) => { - *representation == schema.status - && elements.len() == 1 - && constant(elements[0], 0) - } - Some(A::ArrayFill { - representation, - length, - value, - .. - }) => { - *representation == schema.status - && constant(*length, 1) - && constant(*value, 0) - } - _ => false, - }; - if !initialized { - return Err(error( - function, - "source context extent needs a fresh live status cell in its iteration", - )); - } - } - let next = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments), - _ => None, - }) - .ok_or_else(|| { - error(function, "source context has no executor transition") - })?; - let empty = matches!(next.get(3).and_then(|value| definitions.get(&origin(*value))).copied(), - Some(A::VariantNew { representation, case: 0, fields, .. }) - if *representation == schema.sequence && fields.is_empty()); - if next.len() != 6 - || origin(next[0]) != parameters[0] - || origin(next[1]) != parameters[1] - || projection(next[2], checkpoint.computation, 4) - != Some(FinishProjection { - owner: parameters[2], - field: 2, - }) - || !empty - || origin(next[4]) != origin(fields[5]) - || origin(next[5]) != assignment.destination - { - return Err(error( - function, - "source context transition must enter its Handle body with an empty queue and its own extent", - )); - } - } - _ => {} - } - } - } - Ok(()) -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC context entry", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/dispatch.rs b/crates/psrs-backend/src/cc/verify/control/dispatch.rs deleted file mode 100644 index 60508a05..00000000 --- a/crates/psrs-backend/src/cc/verify/control/dispatch.rs +++ /dev/null @@ -1,160 +0,0 @@ -//! Machine dispatch coverage and projections are checked on actual CC paths. -use crate::BackendError; -use crate::cc::branch_facts::{Facts, selected, tag_source}; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::dispatch::Carrier; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - let Some(role) = table - .control_helpers - .iter() - .find(|h| h.function() == function.symbol) - .map(|h| h.role()) - else { - return Ok(()); - }; - if !matches!(role, R::Executor | R::CloneSequence | R::RebuildSequence) { - return Ok(()); - } - let schema = table - .control_checkpoint_schema() - .ok_or_else(|| error(function, "control dispatch has no checked schema"))?; - let queue = table - .control_sequence() - .ok_or_else(|| error(function, "control dispatch has no checked queue schema"))?; - let classify = |repr| { - if repr == schema.computation { - Some(Carrier::Computation) - } else if repr == schema.context { - Some(Carrier::Context) - } else if repr == queue { - Some(if role == R::RebuildSequence { - Carrier::Reverse - } else { - Carrier::Queue - }) - } else { - None - } - }; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = - |v| crate::cc::value_identity::reference_origin(v, |v| definitions.get(&v).copied()); - let index = if role == R::Executor { 2 } else { 0 }; - let input = function.parameters.get(index).copied().ok_or_else(|| { - error( - function, - "control dispatch has an invalid parameter contract", - ) - })?; - let entry_repr = if role == R::Executor { - schema.computation - } else { - queue - }; - let Some(A::TagSwitch { value, .. }) = definitions.get(&origin(function.result)).copied() - else { - return Err(error( - function, - "control helper result must be its current input dispatch", - )); - }; - if tag_source(*value, &definitions) != Some((entry_repr, origin(input))) { - return Err(error( - function, - "control helper result must be its current input dispatch", - )); - } - let mut pending = vec![(function.assignments.as_slice(), Facts::new())]; - while let Some((body, facts)) = pending.pop() { - for assignment in body { - match &assignment.kind { - A::VariantGet { - representation, - case, - value, - .. - } if classify(*representation).is_some() => { - // Only a proven selection can contradict the projected case. - // An unprovable source is left to the relation-specific - // verifiers rather than rejected here. - if let Some(known) = selected(*representation, *value, &facts, &definitions) - && i32::try_from(*case).ok() != Some(known) - { - return Err(error( - function, - "control projection must match the selected case of its actual input", - )); - } - } - A::TagSwitch { - value, - cases, - default_assignments, - default_value, - .. - } => { - let selector = tag_source(*value, &definitions); - if let Some((repr, owner)) = selector - && let Some(carrier) = classify(repr) - { - carrier - .verify(cases.iter().map(|case| case.tag)) - .map_err(|m| error(function, m))?; - if !matches!( - definitions.get(&origin(*default_value)).copied(), - Some(A::Unreachable) - ) { - return Err(error( - function, - "control dispatch must trap on unsupported alternatives", - )); - } - if role == R::Executor - && repr == schema.computation - && owner != origin(input) - { - return Err(error( - function, - "computation dispatch must select the current executor input", - )); - } - } - for case in cases { - let mut branch = facts.clone(); - if let Some(key) = selector { - branch.insert(key, case.tag); - } - pending.push((case.assignments.as_slice(), branch)); - } - // The default proves none of the explicitly selected tags. - let mut fallback = facts.clone(); - if let Some(key) = selector { - fallback.remove(&key); - } - pending.push((default_assignments.as_slice(), fallback)); - } - A::If { - then_assignments, - else_assignments, - .. - } => pending.extend([ - (then_assignments.as_slice(), facts.clone()), - (else_assignments.as_slice(), facts.clone()), - ]), - _ => {} - } - } - } - Ok(()) -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC control dispatch", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/execution/effects.rs b/crates/psrs-backend/src/cc/verify/control/execution/effects.rs deleted file mode 100644 index 657b6b43..00000000 --- a/crates/psrs-backend/src/cc/verify/control/execution/effects.rs +++ /dev/null @@ -1,102 +0,0 @@ -//! Account for the complete executed path, including prefixes and exceptional exits. -use super::super::traces::{Trace, paths}; -use super::View; -use crate::BackendError; -use crate::cc::value_identity::definitions; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::events::{self, Event}; -use crate::control::execution::{self, Facts, Operands, Schema}; -use psrs_hir::SymbolId; -use std::collections::HashMap; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, - functions: Option<&HashMap>, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) - { - return Ok(()); - } - let total = functions - .map(super::super::super::total::functions) - .unwrap_or_default(); - let checked: Result<(), &'static str> = (|| { - let schema = Schema::checked(table)?; - let status = table - .control_replay_schema() - .ok_or("execution has no status schema")? - .status; - let carriers = events::carriers(table)?; - let definitions = definitions(&function.assignments); - let paths = paths( - &function.assignments, - Trace::default(), - function.symbol, - &definitions, - ); - let normal = paths - .iter() - .filter(|path| !path.trapped) - .map(|path| path.events.clone()) - .collect::>(); - for path in paths { - if !path.trapped { - super::super::refinements::verify(function, table, &path)?; - } - let view = View { - definitions: definitions.clone(), - aliases: Some(&path.aliases), - raw: table - .control_resumption - .as_ref() - .ok_or("execution has no raw contract")? - .function(), - }; - if path.trapped { - events::exceptional(&view, &path.events, &normal, &carriers, status)?; - continue; - } - let mut facts = Facts::new(); - for event in &path.events { - if let Event::Select { value, tag } = event - && let Some(key) = view.tag(*value) - { - facts.insert(key, *tag); - } - } - if facts.get(&(schema.computation, view.origin(function.parameters[2]))) == Some(&5) { - continue; - } - let result = view.origin(function.result); - let next = match definitions.get(&result).copied() { - Some(A::DirectCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }; - execution::effects( - &schema, - &view, - &facts, - &function.parameters, - next, - &path.events, - &total, - )?; - events::allocations(&view, next.unwrap_or(&[result]), &path.events)?; - } - Ok(()) - })(); - checked.map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC root and queue effects", function.span, message) - .with_module(function.symbol.module), - ] - }) -} diff --git a/crates/psrs-backend/src/cc/verify/control/execution/mod.rs b/crates/psrs-backend/src/cc/verify/control/execution/mod.rs deleted file mode 100644 index b084e1a1..00000000 --- a/crates/psrs-backend/src/cc/verify/control/execution/mod.rs +++ /dev/null @@ -1,286 +0,0 @@ -//! Discharge structured result paths into the shared root/queue step contract. -use crate::BackendError; -use crate::cc::branch_facts::{Definitions, tag_source}; -use crate::cc::value_identity::{definitions, reference_origin, transparent}; -use crate::cc::{ - AssignmentKind as A, ControlHelperRole as R, Function, ReprId, RepresentationTable, ValueId, -}; -use crate::control::execution::{self, ActionRegistry, Facts, Operands, Schema}; - -pub(super) struct View<'a> { - pub(super) definitions: Definitions<'a>, - pub(super) raw: psrs_hir::SymbolId, - pub(super) aliases: Option<&'a std::collections::HashMap>, -} - -impl Operands for View<'_> { - fn inputs(&self, value: ValueId) -> Vec { - match self.definitions.get(&self.origin(value)).copied() { - Some(A::ProductNew { arguments, .. } | A::DirectCall { arguments, .. }) => { - arguments.clone() - } - Some(A::VariantNew { fields, .. }) => fields.clone(), - Some(A::ArrayNew { elements, .. }) => elements.clone(), - Some(A::FunctionRef { captures, .. }) => captures.clone(), - Some(A::IndirectCall { - function, - arguments, - .. - }) => std::iter::once(*function) - .chain(arguments.iter().copied()) - .collect(), - Some( - A::ProductGet { value, .. } - | A::VariantGet { value, .. } - | A::VariantTag { value, .. } - | A::ArrayLen { value, .. }, - ) => vec![*value], - Some(A::ArrayFill { length, value, .. }) => vec![*length, *value], - Some(A::ArrayGet { value, index, .. }) => vec![*value, *index], - _ => Vec::new(), - } - } - fn tag(&self, value: ValueId) -> Option<(ReprId, ValueId)> { - match self.definitions.get(&self.origin(value)).copied()? { - A::VariantTag { - representation, - value, - .. - } => Some((*representation, self.origin(*value))), - _ => None, - } - } - fn origin(&self, value: ValueId) -> ValueId { - if let Some(aliases) = self.aliases { - return crate::cc::value_identity::path_origin(value, &self.definitions, aliases); - } - reference_origin(value, |value| self.definitions.get(&value).copied()) - } - fn projection( - &self, - value: ValueId, - repr: ReprId, - case: Option, - ) -> Option<(ValueId, u32)> { - match self.definitions.get(&self.origin(value)).copied()? { - A::VariantGet { - representation, - case: tag, - field, - value, - .. - } if *representation == repr && case == Some(*tag) => { - Some((self.origin(*value), *field)) - } - A::ProductGet { - representation, - field, - value, - .. - } if *representation == repr && case.is_none() => Some((self.origin(*value), *field)), - _ => None, - } - } - fn node(&self, value: ValueId, repr: ReprId, case: Option) -> Option> { - match self.definitions.get(&self.origin(value)).copied()? { - A::VariantNew { - representation, - case: tag, - fields, - .. - } if *representation == repr && case == Some(*tag) => Some(fields.clone()), - A::ProductNew { - representation, - arguments, - .. - } if *representation == repr && case.is_none() => Some(arguments.clone()), - _ => None, - } - } - fn application(&self, value: ValueId) -> Option<(ValueId, Vec)> { - match self.definitions.get(&self.origin(value)).copied()? { - A::IndirectCall { - function, - arguments, - .. - } => Some((*function, arguments.clone())), - _ => None, - } - } - fn raw_resumption(&self, value: ValueId) -> bool { - matches!(self.definitions.get(&self.origin(value)).copied(), Some(A::FunctionRef { function, .. }) if *function == self.raw) - } -} - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) - { - return Ok(()); - } - let result = (|| { - let schema = Schema::checked(table)?; - let view = View { - definitions: definitions(&function.assignments), - aliases: None, - raw: table - .control_resumption - .as_ref() - .ok_or("execution has no raw resumption contract")? - .function(), - }; - let mut coverage = ActionRegistry::default(); - walk( - function, - &schema, - &view, - function.result, - Facts::new(), - &mut std::collections::HashSet::new(), - &mut coverage, - )?; - coverage.finish() - })(); - result.map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC root and queue execution", function.span, message) - .with_module(function.symbol.module), - ] - }) -} - -fn walk( - function: &Function, - schema: &Schema, - view: &View<'_>, - value: ValueId, - facts: Facts, - active: &mut std::collections::HashSet, - coverage: &mut ActionRegistry, -) -> Result<(), &'static str> { - if !active.insert(value) { - return Err("execution result path is cyclic"); - } - let result = match view.definitions.get(&value).copied() { - Some(A::RepresentationCast { value, .. }) => { - walk(function, schema, view, *value, facts, active, coverage) - } - Some(A::AggregateConvert { - value, conversion, .. - }) if transparent(&conversion.plan) => { - walk(function, schema, view, *value, facts, active, coverage) - } - Some(A::If { - then_value, - else_value, - .. - }) => { - walk( - function, - schema, - view, - *then_value, - facts.clone(), - active, - coverage, - )?; - walk(function, schema, view, *else_value, facts, active, coverage) - } - Some(A::TagSwitch { - value: selector, - cases, - default_value, - .. - }) => { - let selected = tag_source(*selector, &view.definitions); - for case in cases { - let mut branch = facts.clone(); - if let Some(key) = selected { - branch.insert(key, case.tag); - } - walk(function, schema, view, case.value, branch, active, coverage)?; - } - let mut fallback = facts; - if let Some(key) = selected { - fallback.remove(&key); - } - walk( - function, - schema, - view, - *default_value, - fallback, - active, - coverage, - ) - } - Some(A::Unreachable) => Ok(()), - Some(A::DirectCall { - function: target, - arguments, - .. - }) if *target == function.symbol => { - execution::transition(schema, view, &facts, &function.parameters, arguments)?; - coverage.observe(schema, view, &facts, &function.parameters); - Ok(()) - } - _ => { - execution::publish(schema, view, &facts, &function.parameters, value)?; - coverage.observe(schema, view, &facts, &function.parameters); - Ok(()) - } - }; - active.remove(&value); - result -} - -impl crate::control::owned::OwnedOperands for View<'_> { - fn integer(&self, value: ValueId) -> Option { - match self.definitions.get(&self.origin(value)).copied()? { - A::Constant(value) => Some(*value), - _ => None, - } - } - fn initial(&self, cell: ValueId, repr: ReprId) -> Option { - match self.definitions.get(&self.origin(cell)).copied()? { - A::ArrayNew { - representation, - elements, - .. - } if *representation == repr && elements.len() == 1 => Some(elements[0]), - A::ArrayFill { - representation, - length, - value, - .. - } if *representation == repr && self.integer(*length) == Some(1) => Some(*value), - _ => None, - } - } - fn read(&self, value: ValueId, repr: ReprId) -> Option<(ValueId, i32)> { - match self.definitions.get(&self.origin(value)).copied()? { - A::ArrayGet { - representation, - value, - index, - .. - } if *representation == repr => Some((self.origin(*value), self.integer(*index)?)), - _ => None, - } - } -} - -mod effects; - -pub(super) fn verify_effects( - function: &Function, - table: &RepresentationTable, - functions: Option<&std::collections::HashMap>, -) -> Result<(), Vec> { - effects::verify(function, table, functions) -} diff --git a/crates/psrs-backend/src/cc/verify/control/exits.rs b/crates/psrs-backend/src/cc/verify/control/exits.rs deleted file mode 100644 index 20bb95a3..00000000 --- a/crates/psrs-backend/src/cc/verify/control/exits.rs +++ /dev/null @@ -1,133 +0,0 @@ -//! Executor transitions are terminal: their results must reach the actual exit. -use crate::BackendError; -use crate::cc::value_identity::{definitions, reference_origin, transparent}; -use crate::cc::{ - Assignment, AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, -}; -use std::collections::{HashMap, HashSet}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) - { - return Ok(()); - } - let definitions = definitions(&function.assignments); - body( - function, - &function.assignments, - function.result, - &definitions, - ) - .map(|_| ()) - .map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC executor exit", function.span, message) - .with_module(function.symbol.module), - ] - }) -} - -fn body( - function: &Function, - assignments: &[Assignment], - result: ValueId, - definitions: &HashMap, -) -> Result { - let mut transitions = false; - for assignment in assignments { - let transition = match &assignment.kind { - A::DirectCall { - function: target, .. - } => *target == function.symbol, - A::If { - then_assignments, - then_value, - else_assignments, - else_value, - .. - } => { - let left = body(function, then_assignments, *then_value, definitions)?; - let right = body(function, else_assignments, *else_value, definitions)?; - left || right - } - A::TagSwitch { - cases, - default_assignments, - default_value, - .. - } => { - let mut found = body(function, default_assignments, *default_value, definitions)?; - for case in cases { - found |= body(function, &case.assignments, case.value, definitions)?; - } - found - } - _ => false, - }; - if transition - && !forwards( - result, - assignment.destination, - definitions, - &mut HashSet::new(), - ) - { - return Err("executor transition result must reach every normal exit"); - } - transitions |= transition; - } - Ok(transitions) -} - -/// Check the returned value graph, never call arguments or unrelated effects. -/// The requirement applies to every normal alternative, including joins whose -/// inputs differ; a trap has no returned value. -fn forwards( - value: ValueId, - required: ValueId, - definitions: &HashMap, - active: &mut HashSet, -) -> bool { - if value == required || reference_origin(value, |v| definitions.get(&v).copied()) == required { - return true; - } - if !active.insert(value) { - return false; - } - let result = match definitions.get(&value).copied() { - Some(A::Unreachable) => true, - Some(A::RepresentationCast { value, .. }) => { - forwards(*value, required, definitions, active) - } - Some(A::AggregateConvert { - value, conversion, .. - }) if transparent(&conversion.plan) => forwards(*value, required, definitions, active), - Some(A::If { - then_value, - else_value, - .. - }) => { - forwards(*then_value, required, definitions, active) - && forwards(*else_value, required, definitions, active) - } - Some(A::TagSwitch { - cases, - default_value, - .. - }) => { - cases - .iter() - .all(|case| forwards(case.value, required, definitions, active)) - && forwards(*default_value, required, definitions, active) - } - _ => false, - }; - active.remove(&value); - result -} diff --git a/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs b/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs deleted file mode 100644 index af55ffd4..00000000 --- a/crates/psrs-backend/src/cc/verify/control/finish_consumption.rs +++ /dev/null @@ -1,167 +0,0 @@ -//! Read actual CC projections and tail transitions, independently of the builder. -use crate::BackendError; -use crate::cc::{ - AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable, ValueId, -}; -use crate::control::provenance::{FinishProjection, finish_relation}; -use std::collections::HashMap; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) - { - return Ok(()); - } - let sequence = table.control_sequence().ok_or_else(|| { - error( - function, - function.span, - "control executor has no checked sequence schema", - ) - })?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for (index, assignment) in body.iter().enumerate() { - match &assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - A::DirectCall { - contract: Some(contract), - arguments, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Close) => - { - let next = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { - contract: Some(contract), - arguments, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Executor) => - { - Some(arguments) - } - _ => None, - }) - .ok_or_else(|| { - error( - function, - assignment.span, - "control finish has no executor transition", - ) - })?; - if arguments.len() != 1 || next.len() != 6 { - return Err(error( - function, - assignment.span, - "control finish transition has an invalid arity", - )); - } - finish_relation( - projection(arguments[0], &definitions, sequence), - projection(next[3], &definitions, sequence), - projection(next[4], &definitions, sequence), - ) - .map_err(|message| error(function, assignment.span, message))?; - } - A::DirectCall { - contract: Some(contract), - arguments, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Executor) - && arguments.len() == 6 - && projection(arguments[3], &definitions, sequence) - .is_some_and(|projection| projection.field == 1) => - { - let close = body[..index] - .iter() - .rev() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { - contract: Some(contract), - arguments, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Close) => - { - arguments.first().copied() - } - _ => None, - }) - .ok_or_else(|| { - error( - function, - assignment.span, - "control finish transition does not close its frame", - ) - })?; - finish_relation( - projection(close, &definitions, sequence), - projection(arguments[3], &definitions, sequence), - projection(arguments[4], &definitions, sequence), - ) - .map_err(|message| error(function, assignment.span, message))?; - } - _ => {} - } - } - } - Ok(()) -} - -fn projection( - value: ValueId, - definitions: &HashMap, - sequence: crate::cc::ReprId, -) -> Option { - let definition = |value| definitions.get(&value).copied(); - let value = crate::cc::value_identity::reference_origin(value, definition); - match definition(value)? { - A::VariantGet { - representation, - case: 3, - field, - value: owner, - .. - } if *representation == sequence => Some(FinishProjection { - owner: crate::cc::value_identity::reference_origin(*owner, definition), - field: *field, - }), - _ => None, - } -} - -fn error( - function: &Function, - span: psrs_span::TextRange, - message: &'static str, -) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC control provenance", span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/finish_creation.rs b/crates/psrs-backend/src/cc/verify/control/finish_creation.rs deleted file mode 100644 index b9f21160..00000000 --- a/crates/psrs-backend/src/cc/verify/control/finish_creation.rs +++ /dev/null @@ -1,184 +0,0 @@ -//! Check target completion records and immutable finish reassociation. -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::provenance::{FinishProjection, context_finish_relation}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.function() == function.symbol && helper.role() == R::Executor) - { - return Ok(()); - } - if function.parameters.len() != 6 { - return Err(error( - function, - "finish producer has an invalid executor contract", - )); - } - let context = table - .control_checkpoint_schema() - .ok_or_else(|| error(function, "finish producer has no checked context schema"))? - .context; - let sequence = table - .control_sequence() - .ok_or_else(|| error(function, "finish producer has no checked queue schema"))?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = |value| { - crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) - }; - let projection = |value, representation, case| match definitions.get(&origin(value)).copied() { - Some(A::VariantGet { - representation: actual, - case: tag, - field, - value, - .. - }) if *actual == representation && *tag == case => Some(FinishProjection { - owner: origin(*value), - field: *field, - }), - _ => None, - }; - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for (index, assignment) in body.iter().enumerate() { - match &assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - A::If { - then_assignments, - else_assignments, - .. - } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), - A::VariantNew { - representation, - case: 3, - fields, - .. - } if *representation == sequence => { - if fields.len() != 3 { - return Err(error( - function, - "finish producer has an invalid frame schema", - )); - } - if projection(fields[0], context, 1).is_some() { - context_finish_relation( - function.parameters[5], - projection(fields[0], context, 1), - projection(fields[1], context, 1), - projection(fields[2], context, 1), - ) - .map_err(|message| error(function, message))?; - let next = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments), - _ => None, - }) - .ok_or_else(|| { - error(function, "target finish has no executor transition") - })?; - if next.len() != 6 - || origin(next[3]) != assignment.destination - || origin(next[4]) != origin(fields[0]) - || projection(next[5], context, 1) - != Some(FinishProjection { - owner: function.parameters[5], - field: 4, - }) - { - return Err(error( - function, - "target finish must enter its caller context with the saved extent", - )); - } - } else { - let extent = projection(fields[0], sequence, 3) - .filter(|projection| projection.field == 0) - .ok_or_else(|| { - error(function, "finish copy must preserve its original extent") - })?; - if projection(fields[2], sequence, 3) - != Some(FinishProjection { - owner: extent.owner, - field: 2, - }) - { - return Err(error( - function, - "finish copy must preserve its original parent", - )); - } - let Some(A::VariantNew { - representation, - case: 2, - fields: appended, - .. - }) = definitions.get(&origin(fields[1])).copied() - else { - return Err(error( - function, - "finish copy must reassociate the original queue", - )); - }; - if *representation != sequence - || appended.len() != 2 - || projection(appended[0], sequence, 3) - != Some(FinishProjection { - owner: extent.owner, - field: 1, - }) - { - return Err(error( - function, - "finish copy must reassociate the original queue", - )); - } - let left = projection(extent.owner, sequence, 2) - .filter(|projection| projection.field == 0) - .ok_or_else(|| { - error(function, "finish copy has no original append input") - })?; - if left.owner != function.parameters[3] - || projection(appended[1], sequence, 2) - != Some(FinishProjection { - owner: left.owner, - field: 1, - }) - { - return Err(error( - function, - "finish copy must retain the original append tail", - )); - } - } - } - _ => {} - } - } - } - Ok(()) -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC finish creation", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/initialization.rs b/crates/psrs-backend/src/cc/verify/control/initialization.rs deleted file mode 100644 index c9c8163d..00000000 --- a/crates/psrs-backend/src/cc/verify/control/initialization.rs +++ /dev/null @@ -1,114 +0,0 @@ -//! Factory freshness and current cell contents are distinct publication facts. -use super::execution::View; -use super::traces::{Trace, paths}; -use crate::BackendError; -use crate::cc::value_identity::definitions; -use crate::cc::{ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::execution::Operands; -use crate::control::owned::{self, Expected, OwnedSchema}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, - functions: Option<&std::collections::HashMap>, -) -> Result<(), Vec> { - let Some(role @ (R::Start | R::Once | R::Cancel)) = table - .control_helpers - .iter() - .find(|helper| helper.function() == function.symbol) - .map(|helper| helper.role()) - else { - return Ok(()); - }; - let total = functions - .map(super::super::total::functions) - .unwrap_or_default(); - let result = (|| { - let replay = table - .control_replay_schema() - .ok_or("control factory has no private cell schema")?; - let owned = OwnedSchema::checked(table)?; - let definitions = definitions(&function.assignments); - let paths = paths( - &function.assignments, - Trace::default(), - function.symbol, - &definitions, - ); - let normal = paths - .iter() - .filter(|path| !path.trapped) - .map(|path| path.events.clone()) - .collect::>(); - if normal.is_empty() { - return Err("control factory has no normal publication path"); - } - for path in paths { - if !path.trapped { - super::refinements::verify(function, table, &path)?; - } - let view = View { - definitions: definitions.clone(), - aliases: Some(&path.aliases), - raw: table - .control_resumption - .as_ref() - .ok_or("control factory has no raw contract")? - .function(), - }; - if path.trapped { - crate::control::events::exceptional( - &view, - &path.events, - &normal, - &crate::control::events::carriers(table)?, - replay.status, - )?; - continue; - } - if role == R::Cancel { - if function.parameters.len() != 1 { - return Err("cancellation has invalid parameters"); - } - owned::cancel( - &owned, - &view, - function.parameters[0], - function.result, - &path.events, - )?; - continue; - } - let repr = if role == R::Start { - replay.boundary - } else { - owned.owner - }; - let fields = view - .node(function.result, repr, Some(0)) - .ok_or("control factory must publish its planned fresh frame")?; - let cells = if role == R::Start && fields.len() == 1 { - vec![(fields[0], replay.status, Expected::Integer(0))] - } else if role == R::Once && fields.len() == 2 && function.parameters.len() == 1 { - vec![ - ( - fields[0], - owned.callback, - Expected::Value(function.parameters[0]), - ), - (fields[1], owned.status, Expected::Integer(0)), - ] - } else { - return Err("control factory has invalid frame fields"); - }; - owned::publication(&view, &[function.result], &cells, &path.events, &total)?; - } - Ok(()) - })(); - result.map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC control initialization", function.span, message) - .with_module(function.symbol.module), - ] - }) -} diff --git a/crates/psrs-backend/src/cc/verify/control/lifecycle.rs b/crates/psrs-backend/src/cc/verify/control/lifecycle.rs deleted file mode 100644 index 34254e4b..00000000 --- a/crates/psrs-backend/src/cc/verify/control/lifecycle.rs +++ /dev/null @@ -1,92 +0,0 @@ -//! Verify extent helper bodies rather than trusting their semantic callee IDs. -use super::execution::View; -use super::traces::{Trace, paths}; -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::execution::Operands; -use crate::control::{events, lifecycle}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - let Some(role @ (R::Check | R::Close)) = table - .control_helpers - .iter() - .find(|helper| helper.function() == function.symbol) - .map(|helper| helper.role()) - else { - return Ok(()); - }; - let checked = (|| { - if function.parameters.len() != 1 { - return Err("lifecycle helper has invalid parameters"); - } - let schema = lifecycle::Schema::checked(table)?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let paths = paths( - &function.assignments, - Trace::default(), - function.symbol, - &definitions, - ); - let mut coverage = std::collections::HashSet::new(); - let normal = paths - .iter() - .filter(|path| !path.trapped) - .map(|path| path.events.clone()) - .collect::>(); - for path in paths { - if !path.trapped { - super::refinements::verify(function, table, &path)?; - } - let view = View { - definitions: definitions.clone(), - aliases: Some(&path.aliases), - raw: table - .control_resumption - .as_ref() - .ok_or("lifecycle has no raw contract")? - .function(), - }; - if path.trapped { - events::exceptional( - &view, - &path.events, - &normal, - &[(schema.boundary, vec![0, 1])], - schema.status, - )?; - continue; - } - let result = view.origin(function.result); - let next = match definitions.get(&result).copied() { - Some(A::DirectCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }; - coverage.insert(lifecycle::verify( - &schema, - &view, - role, - function.parameters[0], - Some(result), - next, - &path.events, - )?); - } - if coverage.len() != 2 { - return Err("lifecycle must retain root and child actions"); - } - Ok(()) - })(); - checked.map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC lifecycle body", function.span, message) - .with_module(function.symbol.module), - ] - }) -} diff --git a/crates/psrs-backend/src/cc/verify/control/mod.rs b/crates/psrs-backend/src/cc/verify/control/mod.rs deleted file mode 100644 index 739c9ef7..00000000 --- a/crates/psrs-backend/src/cc/verify/control/mod.rs +++ /dev/null @@ -1,51 +0,0 @@ -//! Control helper body checks at the CC verification boundary. - -use crate::BackendError; -use crate::cc::{Function, RepresentationTable}; -use psrs_hir::SymbolId; -use std::collections::HashMap; - -mod checkpoints; -mod clauses; -mod context_entry; -mod dispatch; -mod execution; -mod exits; -mod finish_consumption; -mod finish_creation; -mod initialization; -mod lifecycle; -mod owned; -mod refinements; -mod replay; -mod root; -mod steps; -mod traces; - -pub(super) fn verify_before_assignments( - function: &Function, - representations: &RepresentationTable, -) -> Result<(), Vec> { - finish_consumption::verify(function, representations) -} - -pub(super) fn verify_after_assignments( - function: &Function, - representations: &RepresentationTable, - functions: Option<&HashMap>, -) -> Result<(), Vec> { - dispatch::verify(function, representations)?; - exits::verify(function, representations)?; - clauses::verify(function, representations)?; - root::verify(function, representations)?; - checkpoints::verify(function, representations)?; - finish_creation::verify(function, representations)?; - context_entry::verify(function, representations)?; - replay::verify(function, representations, functions)?; - steps::verify(function, representations)?; - execution::verify(function, representations)?; - owned::verify(function, representations)?; - execution::verify_effects(function, representations, functions)?; - lifecycle::verify(function, representations)?; - initialization::verify(function, representations, functions) -} diff --git a/crates/psrs-backend/src/cc/verify/control/owned.rs b/crates/psrs-backend/src/cc/verify/control/owned.rs deleted file mode 100644 index c679888b..00000000 --- a/crates/psrs-backend/src/cc/verify/control/owned.rs +++ /dev/null @@ -1,82 +0,0 @@ -//! Execute the structured body symbolically to retain ordered owner effects. -use super::execution::View; -use crate::BackendError; -use crate::cc::value_identity::definitions; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::execution::{Operands, Schema}; -use crate::control::owned::{self, OwnedSchema}; - -use super::traces::Trace; -use super::traces::paths; -use crate::control::events::Event; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) - { - return Ok(()); - } - let result = (|| { - let schema = Schema::checked(table)?; - let owned = OwnedSchema::checked(table)?; - let definitions = definitions(&function.assignments); - let paths = paths( - &function.assignments, - Trace::default(), - function.symbol, - &definitions, - ) - .into_iter() - .filter(|path| !path.trapped) - .collect::>(); - if paths.is_empty() { - return Err("owned execution has no normal transfer path"); - } - for path in paths { - if !path.trapped { - super::refinements::verify(function, table, &path)?; - } - let view = View { - definitions: definitions.clone(), - aliases: Some(&path.aliases), - raw: table - .control_resumption - .as_ref() - .ok_or("owned execution has no raw resumption contract")? - .function(), - }; - if !path.events.iter().any(|event| matches!(event, Event::Select { value, tag: 5 } if view.tag(*value) == Some((schema.computation, view.origin(function.parameters[2]))))) { continue; } - let Some(A::DirectCall { - function: target, - arguments, - .. - }) = definitions.get(&view.origin(function.result)).copied() - else { - return Err("owned execution must return its executor transition"); - }; - if *target != function.symbol { - return Err("owned execution must return its executor transition"); - } - owned::verify( - &schema, - &owned, - &view, - &function.parameters, - arguments, - &path.events, - )?; - } - Ok(()) - })(); - result.map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC owned execution", function.span, message) - .with_module(function.symbol.module), - ] - }) -} diff --git a/crates/psrs-backend/src/cc/verify/control/refinements.rs b/crates/psrs-backend/src/cc/verify/control/refinements.rs deleted file mode 100644 index cba26163..00000000 --- a/crates/psrs-backend/src/cc/verify/control/refinements.rs +++ /dev/null @@ -1,66 +0,0 @@ -//! Source payload recovery is restricted to the machine's checked use roles. -use super::execution::View; -use super::traces::Trace; -use crate::cc::{ - AssignmentKind as A, Function, RefShape, Representation, RepresentationTable, ValueShape, -}; -use crate::control::execution::Operands; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, - path: &Trace, -) -> Result<(), &'static str> { - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let raw = table - .control_resumption - .as_ref() - .ok_or("refinement has no raw contract")? - .function(); - let view = View { - definitions: definitions.clone(), - aliases: Some(&path.aliases), - raw, - }; - let next = match definitions.get(&view.origin(function.result)).copied() { - Some(A::DirectCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }; - for value in &path.casts { - let Some(A::RepresentationCast { - value, reference, .. - }) = definitions.get(value).copied() - else { - return Err("refinement has no cast definition"); - }; - let source = view.origin(*value); - let known = function - .values - .iter() - .find(|v| v.id == source) - .and_then(|v| match v.ty { - ValueShape::Reference(reference) => Some(reference), - _ => None, - }); - if known.is_some_and(|actual| (reference.nullable || !actual.nullable) && (actual.heap == reference.heap || reference.heap == RefShape::Erased || (reference.heap == RefShape::Aggregate && matches!(actual.heap, RefShape::Repr(repr) if matches!(table.representation(repr), Some(Representation::Product { .. } | Representation::Variant { .. })))))) { continue; } - if matches!(reference.heap, RefShape::Closure(_)) && path.events.iter().any(|event| matches!(event, crate::control::events::Event::Apply { result } if view.application(*result).is_some_and(|(callee, _)| view.origin(callee) == source))) { continue; } - if let RefShape::Repr(repr) = reference.heap - && next.is_some_and(|args| { - args.len() == 6 - && (table.control_checkpoint_schema().is_some_and(|schema| { - schema.computation == repr && view.origin(args[2]) == source - }) || (table.control_result_pair == Some(repr) - && view.projection(args[0], repr, None) == Some((source, 0)) - && view.projection(args[2], repr, None) == Some((source, 1)))) - }) - { - continue; - } - return Err("machine reference refinement has no checked use role"); - } - Ok(()) -} diff --git a/crates/psrs-backend/src/cc/verify/control/replay.rs b/crates/psrs-backend/src/cc/verify/control/replay.rs deleted file mode 100644 index da248409..00000000 --- a/crates/psrs-backend/src/cc/verify/control/replay.rs +++ /dev/null @@ -1,320 +0,0 @@ -//! Saved finish validation and fresh replay activation ownership. -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::provenance::{ - FinishProjection, replay_activation_relation, saved_finish_relation, -}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, - functions: Option<&std::collections::HashMap>, -) -> Result<(), Vec> { - let role = table - .control_helpers - .iter() - .find(|helper| helper.function() == function.symbol) - .map(|helper| helper.role()); - if !matches!(role, Some(R::CloneSequence | R::RebuildSequence)) { - return Ok(()); - } - let total = functions - .map(super::super::total::functions) - .unwrap_or_default(); - let schema = table - .control_replay_schema() - .ok_or_else(|| error(function, "replay has no checked lifecycle schema"))?; - let expected = if role == Some(R::CloneSequence) { 5 } else { 4 }; - if function.parameters.len() != expected { - return Err(error(function, "replay has an invalid parameter contract")); - } - let parameters = &function.parameters; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = |value| { - crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) - }; - let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(A::Constant(value)) if *value == expected); - let projection = |value, expected_case| match definitions.get(&origin(value)).copied() { - Some(A::VariantGet { - representation, - case, - field, - value, - .. - }) if *representation == schema.sequence && *case == expected_case => { - Some(FinishProjection { - owner: origin(*value), - field: *field, - }) - } - _ => None, - }; - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for (index, assignment) in body.iter().enumerate() { - match &assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } - A::If { - then_assignments, - else_assignments, - .. - } => pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]), - A::DirectCall { - function: target, - contract, - .. - } if contract - .and_then(|id| table.control_helpers.get(id.0 as usize)) - .is_none_or(|helper| { - !matches!( - helper.role(), - R::Check | R::CloneSequence | R::RebuildSequence - ) - }) - && !total.contains(target) => - { - return Err(error( - function, - "replay traversal cannot invoke callbacks or mutate lifecycle cells", - )); - } - A::DirectCall { - contract: Some(id), - arguments, - .. - } if role == Some(R::CloneSequence) => { - let target = table - .control_helpers - .get(id.0 as usize) - .map(|helper| helper.role()); - let valid = match target { - Some(R::CloneSequence) => { - arguments.len() == 5 - && origin(arguments[3]) == parameters[3] - && origin(arguments[4]) == parameters[4] - } - Some(R::RebuildSequence) => { - arguments.len() == 4 - && origin(arguments[0]) == parameters[2] - && origin(arguments[1]) == parameters[1] - && origin(arguments[2]) == parameters[3] - && origin(arguments[3]) == parameters[4] - } - _ => true, - }; - if !valid { - return Err(error( - function, - "clone traversal must preserve its accumulators, active extent and parent", - )); - } - } - A::IndirectCall { .. } | A::RuntimeCall { .. } | A::FunctionRef { .. } => { - return Err(error( - function, - "replay traversal cannot invoke callbacks or mutate lifecycle cells", - )); - } - A::VariantNew { - representation, - case: 1, - fields, - .. - } if *representation == schema.sequence => { - let accumulator = - parameters[if role == Some(R::CloneSequence) { 2 } else { 1 }]; - if fields.len() != 2 - || projection(fields[0], 1) - != Some(FinishProjection { - owner: parameters[0], - field: 0, - }) - || origin(fields[1]) != accumulator - { - return Err(error( - function, - "replay must share the original callback and retain its accumulator", - )); - } - if role == Some(R::RebuildSequence) { - let next = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments), - _ => None, - }) - .ok_or_else(|| error(function, "callback rebuild has no transition"))?; - if next.len() != 4 - || projection(next[0], 1) - != Some(FinishProjection { - owner: parameters[0], - field: 1, - }) - || origin(next[1]) != assignment.destination - || origin(next[2]) != parameters[2] - || origin(next[3]) != parameters[3] - { - return Err(error( - function, - "callback rebuild must preserve its active extent and parent", - )); - } - } - } - A::VariantNew { - representation, - case: 3, - fields, - .. - } if *representation == schema.sequence => { - if fields.len() != 3 { - return Err(error(function, "replay finish has an invalid schema")); - } - if role == Some(R::CloneSequence) { - saved_finish_relation(parameters[0], projection(fields[0], 3)) - .map_err(|message| error(function, message))?; - if origin(fields[1]) != parameters[2] || origin(fields[2]) != parameters[4] - { - return Err(error( - function, - "replay traversal must retain its reverse accumulator and parent", - )); - } - if !body[..index].iter().any(|assignment| matches!(&assignment.kind, - A::DirectCall { contract: Some(id), arguments, .. } - if table.control_helpers.get(id.0 as usize).is_some_and(|helper| helper.role() == R::Check) - && arguments.len() == 1 && origin(arguments[0]) == origin(fields[0]))) { - return Err(error(function, "replay must check the saved finish extent before copying it")); - } - } else { - replay_activation_relation( - parameters[1], - parameters[2], - origin(fields[1]), - origin(fields[2]), - ) - .map_err(|message| error(function, message))?; - let extent = origin(fields[0]); - let Some(A::VariantNew { - representation, - case: 1, - fields: activation, - .. - }) = definitions.get(&extent).copied() - else { - return Err(error( - function, - "replay must create a fresh activation extent", - )); - }; - if *representation != schema.boundary - || activation.len() != 2 - || origin(activation[1]) != parameters[3] - { - return Err(error( - function, - "replay activation must use its current parent", - )); - } - let status = origin(activation[0]); - let initialized = match definitions.get(&status).copied() { - Some(A::ArrayNew { - representation, - elements, - .. - }) => { - *representation == schema.status - && elements.len() == 1 - && constant(elements[0], 0) - } - Some(A::ArrayFill { - representation, - length, - value, - .. - }) => { - *representation == schema.status - && constant(*length, 1) - && constant(*value, 0) - } - _ => false, - }; - // Common CC scope verification proves these local allocations - // dominate the construction; every recursive call is a fresh - // invocation, including allocations before the tag switch. - if !initialized { - return Err(error( - function, - "replay activation needs a fresh live status cell in its iteration", - )); - } - let next = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments), - _ => None, - }) - .ok_or_else(|| { - error(function, "replay activation has no rebuild transition") - })?; - if next.len() != 4 - || origin(next[1]) != assignment.destination - || origin(next[2]) != extent - || origin(next[3]) != extent - { - return Err(error( - function, - "replay must advance its queue, active extent and parent together", - )); - } - } - } - A::ProductNew { - representation, - arguments, - .. - } if role == Some(R::RebuildSequence) && *representation == schema.result => { - if arguments.len() != 2 - || origin(arguments[0]) != parameters[1] - || origin(arguments[1]) != parameters[2] - { - return Err(error( - function, - "replay result must return its accumulated queue and active extent", - )); - } - } - A::ArraySet { .. } => { - return Err(error( - function, - "replay must not mutate saved or fresh lifecycle cells", - )); - } - _ => {} - } - } - } - Ok(()) -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC control replay", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/root.rs b/crates/psrs-backend/src/cc/verify/control/root.rs deleted file mode 100644 index f819fd84..00000000 --- a/crates/psrs-backend/src/cc/verify/control/root.rs +++ /dev/null @@ -1,215 +0,0 @@ -//! Run factories establish one fresh root and close it before publishing a result. -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::provenance::root_extent_relation; -use psrs_hir::Intrinsic; -use std::collections::HashMap; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - let Some(schema) = table.control_replay_schema() else { - return Ok(()); - }; - let context = table - .control_checkpoint_schema() - .ok_or_else(|| error(function, "control run has no checked root schema"))? - .context; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = |value| { - crate::cc::value_identity::reference_origin(value, |value| definitions.get(&value).copied()) - }; - let role = |id: crate::cc::ControlHelperId| { - table - .control_helpers - .get(id.0 as usize) - .map(|helper| helper.role()) - }; - let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(A::Constant(value)) if *value == expected); - if table - .control_helpers - .iter() - .any(|helper| helper.function() == function.symbol && helper.role() == R::Start) - { - if !function.parameters.is_empty() { - return Err(error( - function, - "control Start has an invalid parameter contract", - )); - } - let Some(A::VariantNew { - representation, - case: 0, - fields, - .. - }) = definitions.get(&origin(function.result)).copied() - else { - return Err(error( - function, - "control Start must return a freshly allocated root extent", - )); - }; - if *representation != schema.boundary || fields.len() != 1 { - return Err(error( - function, - "control Start must return a freshly allocated root extent", - )); - } - let live = match definitions.get(&origin(fields[0])).copied() { - Some(A::ArrayNew { - representation, - elements, - .. - }) => { - *representation == schema.status && elements.len() == 1 && constant(elements[0], 0) - } - Some(A::ArrayFill { - representation, - length, - value, - .. - }) => *representation == schema.status && constant(*length, 1) && constant(*value, 0), - _ => false, - }; - if !live { - return Err(error( - function, - "control Start needs a fresh one-element live status cell", - )); - } - } - let mut owners = HashMap::<_, Vec<(_, Vec<(crate::cc::ValueId, i64)>)>>::new(); - let mut pending = vec![(function.assignments.as_slice(), Vec::new())]; - while let Some((body, path)) = pending.pop() { - for (index, assignment) in body.iter().enumerate() { - match &assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - let mut child = path.clone(); - child.push((assignment.destination, i64::from(case.tag))); - pending.push((case.assignments.as_slice(), child)); - } - let mut child = path.clone(); - child.push((assignment.destination, i64::MIN)); - pending.push((default_assignments.as_slice(), child)); - } - A::If { - then_assignments, - else_assignments, - .. - } => { - for (body, arm) in [ - (then_assignments.as_slice(), 0), - (else_assignments.as_slice(), 1), - ] { - let mut child = path.clone(); - child.push((assignment.destination, arm)); - pending.push((body, child)); - } - } - A::ControlEvidence { - contract, - implementation, - .. - } if table - .control_contracts - .get(contract.0 as usize) - .is_some_and(|proof| proof.operation() == Intrinsic::ControlRun) => - { - let implementation = origin(*implementation); - let call_index = body[..index] - .iter() - .position(|assignment| assignment.destination == implementation) - .ok_or_else(|| { - error(function, "control run has no local executor invocation") - })?; - let A::DirectCall { - contract: Some(id), - arguments, - .. - } = &body[call_index].kind - else { - return Err(error( - function, - "control run has no local executor invocation", - )); - }; - if role(*id) != Some(R::Executor) || arguments.len() != 6 { - return Err(error( - function, - "control run has no local executor invocation", - )); - } - if !matches!(definitions.get(&origin(arguments[3])).copied(), Some(A::VariantNew { representation, case: 0, fields, .. }) if *representation == schema.sequence && fields.is_empty()) - { - return Err(error( - function, - "control run must start with an empty root queue", - )); - } - let extent = origin(arguments[4]); - let previous = owners.entry(extent).or_default(); - if previous.iter().any(|(call, previous_path)| { - *call != implementation - && !previous_path.iter().any(|(branch, arm)| { - path.iter().any(|(current_branch, current_arm)| { - branch == current_branch && arm != current_arm - }) - }) - }) { - return Err(error( - function, - "control run factories must not reuse another invocation's root extent", - )); - } - previous.push((implementation, path.clone())); - if !matches!(definitions.get(&extent).copied(), Some(A::DirectCall { contract: Some(id), arguments, .. }) if role(*id) == Some(R::Start) && arguments.is_empty()) - { - return Err(error( - function, - "control run must start with a fresh Start extent", - )); - } - let Some(A::VariantNew { - representation, - case: 0, - fields, - .. - }) = definitions.get(&origin(arguments[5])).copied() - else { - return Err(error( - function, - "control run must install a root dispatch context", - )); - }; - if *representation != context || fields.len() != 1 { - return Err(error( - function, - "control run must install a root dispatch context", - )); - } - root_extent_relation(extent, origin(fields[0])) - .map_err(|message| error(function, message))?; - if !body[call_index + 1..index].iter().any(|assignment| matches!(&assignment.kind, - A::DirectCall { contract: Some(id), arguments, .. } if role(*id) == Some(R::Close) && arguments.len() == 1 && origin(arguments[0]) == extent)) { - return Err(error(function, "control run must close its root after execution and before publishing its result")); - } - } - _ => {} - } - } - } - Ok(()) -} - -fn error(function: &Function, message: &'static str) -> Vec { - vec![ - BackendError::invalid_ir("P8 CC control root", function.span, message) - .with_module(function.symbol.module), - ] -} diff --git a/crates/psrs-backend/src/cc/verify/control/steps.rs b/crates/psrs-backend/src/cc/verify/control/steps.rs deleted file mode 100644 index 4196374c..00000000 --- a/crates/psrs-backend/src/cc/verify/control/steps.rs +++ /dev/null @@ -1,150 +0,0 @@ -//! Required execution transitions consume the current frame's fields. -use crate::BackendError; -use crate::cc::{AssignmentKind as A, ControlHelperRole as R, Function, RepresentationTable}; -use crate::control::provenance::FinishProjection; -use crate::control::steps::{bind_relation, resume_answer_relation}; - -pub(super) fn verify( - function: &Function, - table: &RepresentationTable, -) -> Result<(), Vec> { - if !table - .control_helpers - .iter() - .any(|h| h.role() == R::Executor && h.function() == function.symbol) - { - return Ok(()); - } - let result = (|| { - let schema = table - .control_checkpoint_schema() - .ok_or("execution step has no checked schema")?; - let queue = table - .control_sequence() - .ok_or("execution step has no checked queue")?; - let definitions = crate::cc::value_identity::definitions(&function.assignments); - let origin = - |v| crate::cc::value_identity::reference_origin(v, |v| definitions.get(&v).copied()); - let Some(A::TagSwitch { cases, .. }) = definitions.get(&origin(function.result)).copied() - else { - return Err("execution step has no input dispatch"); - }; - let parameters = &function.parameters; - if parameters.len() != 6 { - return Err("execution step has an invalid executor contract"); - } - let projection = |value, tag| match definitions.get(&origin(value)).copied() { - Some(A::VariantGet { - representation, - case, - field, - value, - .. - }) if *representation == schema.computation && *case == tag => Some(FinishProjection { - owner: origin(*value), - field: *field, - }), - _ => None, - }; - for tag in [2, 3] { - let case = cases - .iter() - .find(|case| case.tag == tag) - .ok_or("execution step is absent from input dispatch")?; - let Some(A::DirectCall { - function: callee, - arguments, - .. - }) = definitions.get(&origin(case.value)).copied() - else { - return Err("execution step must produce its executor transition"); - }; - if *callee != function.symbol || arguments.len() != 6 { - return Err("execution step must produce its executor transition"); - } - if origin(arguments[0]) != origin(parameters[0]) - || origin(arguments[1]) != origin(parameters[1]) - || origin(arguments[5]) != origin(parameters[5]) - { - return Err( - "execution step must preserve state, root handler and dispatch context", - ); - } - let Some(A::VariantNew { - representation, - case: queue_tag, - fields, - .. - }) = definitions.get(&origin(arguments[3])).copied() - else { - return Err("execution step must retain its pending queue"); - }; - if *representation != queue || fields.len() != 2 { - return Err("execution step must retain its pending queue"); - } - if tag == 2 { - if *queue_tag != 1 || origin(arguments[4]) != origin(parameters[4]) { - return Err( - "Bind must retain its current execution extent and prepend one callback", - ); - } - bind_relation( - origin(parameters[2]), - origin(parameters[3]), - projection(arguments[2], 2), - projection(fields[0], 2), - origin(fields[1]), - )?; - } else { - if *queue_tag != 2 || origin(fields[1]) != origin(parameters[3]) { - return Err("Resume must append replay to its current queue"); - } - let Some(A::VariantNew { - representation, - case: 0, - fields: answer, - .. - }) = definitions.get(&origin(arguments[2])).copied() - else { - return Err("Resume must return its current saved answer"); - }; - if *representation != schema.computation || answer.len() != 1 { - return Err("Resume must return its current saved answer"); - } - resume_answer_relation(origin(parameters[2]), projection(answer[0], 3))?; - let replay = |value, expected| match definitions.get(&origin(value)).copied() { - Some(A::ProductGet { - representation, - field, - value, - .. - }) if *field == expected => Some((*representation, origin(*value))), - _ => None, - }; - let result_schema = table - .control_replay_schema() - .ok_or("Resume has no replay schema")? - .result; - let Some((representation, owner)) = replay(fields[0], 0) else { - return Err("Resume must use its replayed queue and activation"); - }; - if representation != result_schema - || replay(arguments[4], 1) != Some((representation, owner)) - { - return Err("Resume must use its replayed queue and activation"); - } - if !matches!(definitions.get(&owner).copied(), Some(A::DirectCall { function: callee, .. }) if table.control_helpers.iter().any(|h| h.role() == R::CloneSequence && h.function() == *callee)) - { - return Err("Resume must use its replayed queue and activation"); - } - } - } - Ok(()) - })(); - result.map_err(|message| { - vec![ - BackendError::invalid_ir("P8 CC execution steps", function.span, message) - .with_module(function.symbol.module), - ] - }) -} diff --git a/crates/psrs-backend/src/cc/verify/control/traces.rs b/crates/psrs-backend/src/cc/verify/control/traces.rs deleted file mode 100644 index 0f1310a3..00000000 --- a/crates/psrs-backend/src/cc/verify/control/traces.rs +++ /dev/null @@ -1,193 +0,0 @@ -//! Preserve execution order and exceptional paths through structured CC. -use crate::cc::{Assignment, AssignmentKind as A, ValueId}; -use crate::control::events::Event; -use std::collections::HashMap; - -#[derive(Clone, Default)] -pub(super) struct Trace { - pub(super) events: Vec, - pub(super) casts: Vec, - pub(super) trapped: bool, - pub(super) aliases: HashMap, -} - -pub(super) fn paths( - body: &[Assignment], - input: Trace, - executor: psrs_hir::SymbolId, - definitions: &crate::cc::branch_facts::Definitions<'_>, -) -> Vec { - let mut current = vec![input]; - for assignment in body { - let mut next = Vec::new(); - for mut trace in current { - if trace.trapped { - next.push(trace); - continue; - } - match &assignment.kind { - A::Unreachable => { - trace.trapped = true; - next.push(trace); - } - A::If { - then_assignments, - then_value, - else_assignments, - else_value, - condition, - .. - } => { - for (branch, value, truth) in [ - (then_assignments, then_value, true), - (else_assignments, else_value, false), - ] { - let mut selected = trace.clone(); - if let Some((value, tag)) = crate::cc::branch_facts::equality_selection( - *condition, - truth, - definitions, - &selected.aliases, - ) { - selected.events.push(Event::Select { value, tag }); - } else if let Some((value, tag)) = - crate::cc::branch_facts::equality_selection( - *condition, - !truth, - definitions, - &selected.aliases, - ) - { - selected.events.push(Event::Reject { - value, - tags: vec![tag], - }); - } - for mut path in paths(branch, selected, executor, definitions) { - path.aliases.insert(assignment.destination, *value); - next.push(path); - } - } - } - A::TagSwitch { - value, - cases, - default_assignments, - default_value, - .. - } => { - for case in cases { - let mut selected = trace.clone(); - selected.events.push(Event::Select { - value: *value, - tag: case.tag, - }); - for mut path in paths(&case.assignments, selected, executor, definitions) { - path.aliases.insert(assignment.destination, case.value); - next.push(path); - } - } - trace.events.push(Event::Reject { - value: *value, - tags: cases.iter().map(|case| case.tag).collect(), - }); - for mut path in paths(default_assignments, trace, executor, definitions) { - path.aliases.insert(assignment.destination, *default_value); - next.push(path); - } - } - kind => { - if matches!(kind, A::RepresentationCast { .. }) { - trace.casts.push(assignment.destination); - if let A::RepresentationCast { value, .. } = kind { - trace.events.push(Event::Refine { - result: assignment.destination, - source: crate::cc::value_identity::path_origin( - *value, - definitions, - &trace.aliases, - ), - }); - } - } - let event = match kind { - A::ArrayGet { - representation, - value, - index, - .. - } => Some(Event::Read { - repr: *representation, - cell: *value, - index: *index, - result: assignment.destination, - }), - A::ArraySet { - representation, - value, - index, - new_value, - .. - } => Some(Event::Store { - repr: *representation, - cell: *value, - index: *index, - value: *new_value, - }), - A::IndirectCall { .. } => Some(Event::Apply { - result: assignment.destination, - }), - A::DirectCall { - function, - arguments, - .. - } if *function == executor => Some(Event::Advance { - arguments: arguments.clone(), - }), - A::DirectCall { - function, - arguments, - .. - } => Some(Event::Direct { - function: *function, - arguments: arguments.clone(), - }), - A::RuntimeCall { .. } => Some(Event::OtherCall), - A::FunctionRef { .. } - | A::ProductNew { .. } - | A::VariantNew { .. } - | A::ArrayNew { .. } - | A::ArrayFill { .. } - | A::ArrayAppend { .. } - | A::ArrayClone { .. } - | A::StringToBytes { .. } - | A::BytesToString { .. } => Some(Event::Allocate { - result: assignment.destination, - }), - A::AggregateConvert { conversion, .. } - if !crate::cc::value_identity::transparent(&conversion.plan) => - { - Some(Event::OtherEffect) - } - A::Primitive { - op: crate::cc::BinaryOp::IntQuot | crate::cc::BinaryOp::IntRem, - .. - } => Some(Event::Trap), - _ => None, - }; - if let Some(event) = event { - trace.events.push(event) - } - next.push(trace); - } - } - } - current = next; - } - for path in &mut current { - crate::control::events::canonicalize(&mut path.events, |value| { - crate::cc::value_identity::path_origin(value, definitions, &path.aliases) - }); - } - current -} diff --git a/crates/psrs-backend/src/cc/verify/mod.rs b/crates/psrs-backend/src/cc/verify/mod.rs index 6c3d9c42..c377be34 100644 --- a/crates/psrs-backend/src/cc/verify/mod.rs +++ b/crates/psrs-backend/src/cc/verify/mod.rs @@ -5,11 +5,9 @@ use psrs_hir::SymbolId; use std::collections::{HashMap, HashSet}; mod adaptation; -mod control; mod helpers; mod ops; mod scalar; -mod total; mod variant; use helpers::{verify_capture_layout, verify_value_shape}; use ops::{verify_assignments, verify_table}; @@ -189,7 +187,6 @@ fn verify_function_inner( )]); } verify_capture_layout(function)?; - control::verify_before_assignments(function, representations)?; let mut available = function.parameters.iter().copied().collect::>(); verify_assignments( &function.assignments, @@ -201,7 +198,13 @@ fn verify_function_inner( function.span, &function.name, )?; - control::verify_after_assignments(function, representations, functions)?; + if let Err(message) = crate::cc::lower::verify_boundary(function, representations) { + return Err(vec![BackendError::invalid_ir( + "P8 CC verification", + function.span, + message, + )]); + } if !available.contains(&function.result) { return Err(vec![BackendError::invalid_ir( "P8 CC verification", diff --git a/crates/psrs-backend/src/cc/verify/total.rs b/crates/psrs-backend/src/cc/verify/total.rs deleted file mode 100644 index e3f10ef7..00000000 --- a/crates/psrs-backend/src/cc/verify/total.rs +++ /dev/null @@ -1,73 +0,0 @@ -//! Total local call summaries. Recursive cycles, reads and traps are unproven. -use crate::cc::{AssignmentKind as A, Function}; -use psrs_hir::SymbolId; -use std::collections::{HashMap, HashSet}; - -pub(super) fn functions(functions: &HashMap) -> HashSet { - let mut dependencies = HashMap::>::new(); - for (symbol, function) in functions { - let mut calls = HashSet::new(); - let mut safe = true; - let mut pending = vec![function.assignments.as_slice()]; - while let Some(body) = pending.pop() { - for assignment in body { - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &assignment.kind - { - pending.extend(cases.iter().map(|case| case.assignments.as_slice())); - pending.push(default_assignments); - } else if let A::If { - then_assignments, - else_assignments, - .. - } = &assignment.kind - { - pending.extend([then_assignments.as_slice(), else_assignments.as_slice()]); - } - match &assignment.kind { - A::DirectCall { function, .. } => { - calls.insert(*function); - } - A::Primitive { - op: crate::cc::BinaryOp::IntQuot | crate::cc::BinaryOp::IntRem, - .. - } => { - safe = false; - break; - } - A::Constant(_) - | A::NumberConstant(_) - | A::Primitive { .. } - | A::Unary { .. } - | A::RepresentationTest { .. } - | A::TagSwitch { .. } - | A::If { .. } - | A::ControlEvidence { .. } => {} - _ => { - safe = false; - break; - } - } - } - } - if safe { - dependencies.insert(*symbol, calls); - } - } - // Least fixed point excludes recursion: no-write recursive SCCs may diverge. - let mut safe = HashSet::new(); - loop { - let previous = safe.len(); - for (symbol, calls) in &dependencies { - if calls.iter().all(|callee| safe.contains(callee)) { - safe.insert(*symbol); - } - } - if safe.len() == previous { - return safe; - } - } -} diff --git a/crates/psrs-backend/src/control/dispatch.rs b/crates/psrs-backend/src/control/dispatch.rs deleted file mode 100644 index 09bdf5c8..00000000 --- a/crates/psrs-backend/src/control/dispatch.rs +++ /dev/null @@ -1,57 +0,0 @@ -//! Required dispatch alternatives of the control machine, independent of IR. -use crate::control::schema::{ComputationCase, ContextCase, SequenceCase}; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub(crate) enum Carrier { - Computation, - Queue, - Context, - Reverse, -} - -const COMPUTATION_TAGS: [i32; 6] = [ - ComputationCase::Return.tag() as i32, - ComputationCase::Perform.tag() as i32, - ComputationCase::Bind.tag() as i32, - ComputationCase::Resume.tag() as i32, - ComputationCase::Handle.tag() as i32, - ComputationCase::OwnedResume.tag() as i32, -]; - -const QUEUE_TAGS: [i32; 4] = [ - SequenceCase::Empty.tag() as i32, - SequenceCase::Cons.tag() as i32, - SequenceCase::Append.tag() as i32, - SequenceCase::Finish.tag() as i32, -]; - -const CONTEXT_TAGS: [i32; 2] = [ - ContextCase::Root.tag() as i32, - ContextCase::Scoped.tag() as i32, -]; - -const REVERSE_TAGS: [i32; 3] = [ - SequenceCase::Empty.tag() as i32, - SequenceCase::Cons.tag() as i32, - SequenceCase::Finish.tag() as i32, -]; - -impl Carrier { - pub(crate) fn tags(self) -> &'static [i32] { - match self { - Self::Computation => &COMPUTATION_TAGS, - Self::Queue => &QUEUE_TAGS, - Self::Context => &CONTEXT_TAGS, - Self::Reverse => &REVERSE_TAGS, - } - } - - pub(crate) fn verify(self, tags: impl Iterator) -> Result<(), &'static str> { - let mut actual = tags.collect::>(); - actual.sort_unstable(); - if actual != self.tags() { - return Err("control dispatch must cover every required alternative exactly once"); - } - Ok(()) - } -} diff --git a/crates/psrs-backend/src/control/events.rs b/crates/psrs-backend/src/control/events.rs deleted file mode 100644 index 4fefa80a..00000000 --- a/crates/psrs-backend/src/control/events.rs +++ /dev/null @@ -1,166 +0,0 @@ -//! Ordered machine observations shared by all semantic relations and IR adapters. -use crate::cc::ReprId; -use crate::types::ValueId; - -#[derive(Clone, Debug, PartialEq, Eq)] -pub(crate) enum Event { - Read { - repr: ReprId, - cell: ValueId, - index: ValueId, - result: ValueId, - }, - Select { - value: ValueId, - tag: i32, - }, - Store { - repr: ReprId, - cell: ValueId, - index: ValueId, - value: ValueId, - }, - Apply { - result: ValueId, - }, - Advance { - arguments: Vec, - }, - Direct { - function: psrs_hir::SymbolId, - arguments: Vec, - }, - Refine { - result: ValueId, - source: ValueId, - }, - OtherCall, - Allocate { - result: ValueId, - }, - Reject { - value: ValueId, - tags: Vec, - }, - OtherEffect, - Trap, -} - -/// Only allocations feeding the published result or actual transition are -/// machine construction. A dead allocation is not evidence for a required node. -pub(crate) fn allocations( - view: &impl super::execution::Operands, - roots: &[ValueId], - events: &[Event], -) -> Result<(), &'static str> { - let mut pending = roots.to_vec(); - let mut reachable = std::collections::HashSet::new(); - while let Some(value) = pending.pop() { - let value = view.origin(value); - if reachable.insert(value) { - pending.extend(view.inputs(value)); - } - } - if events.iter().any(|event| matches!(event, Event::Allocate { result } if !reachable.contains(&view.origin(*result)))) { - Err("machine execution contains an unrelated allocation") - } else { Ok(()) } -} - -/// Trap paths retain their executed effects. Only a failed machine dispatch or -/// private live-status guard may end a step, and its effects must be a prefix of -/// a validated normal path. Thus trapping cannot hide an extra write or call. -pub(crate) fn exceptional( - view: &impl super::owned::OwnedOperands, - events: &[Event], - normal: &[Vec], - carriers: &[(ReprId, Vec)], - status: ReprId, -) -> Result<(), &'static str> { - let justified = events.iter().enumerate().any(|(point, event)| { - let Event::Reject { value, tags } = event else { return false; }; - if events[point + 1..].iter().any(|event| !matches!(event, Event::Select { .. } | Event::Reject { .. })) { return false; } - if view.integer(*value).is_some_and(|constant| tags.contains(&constant)) { return true; } - if let Some((repr, _)) = view.tag(*value) { - return carriers.iter().any(|(candidate, domain)| *candidate == repr && tags == domain); - } - tags == &[0] && events.iter().any(|event| matches!(event, Event::Read { repr, index, result, .. } if *repr == status && view.integer(*index) == Some(0) && view.origin(*result) == view.origin(*value))) - }); - let observable = |event: &Event| !matches!(event, Event::Select { .. } | Event::Reject { .. }); - let prefix = events - .iter() - .filter(|event| observable(event)) - .collect::>(); - if justified - && normal.iter().any(|path| { - let effects = path - .iter() - .filter(|event| observable(event)) - .collect::>(); - effects.starts_with(&prefix) - }) - { - Ok(()) - } else { - Err("exceptional machine path has unaccounted effects or no failed guard") - } -} - -pub(crate) fn carriers( - table: &crate::cc::RepresentationTable, -) -> Result)>, &'static str> { - let checkpoint = table - .control_checkpoint_schema() - .ok_or("execution has no checkpoint schema")?; - let replay = table - .control_replay_schema() - .ok_or("execution has no replay schema")?; - let owner = super::owned::OwnedSchema::checked(table)?; - [ - checkpoint.computation, - checkpoint.context, - replay.sequence, - replay.boundary, - owner.owner, - ] - .into_iter() - .map(|repr| { - let Some(crate::cc::Representation::Variant { cases }) = table.representation(repr) else { - return Err("execution carrier is not a variant"); - }; - Ok((repr, cases.iter().map(|case| case.tag as i32).collect())) - }) - .collect() -} - -/// Operand identity is path-sensitive. Keep instruction result IDs (and hence -/// their immutable definitions), but resolve every observed input through that -/// path's aliases before comparing prefixes across joins. -pub(crate) fn canonicalize(events: &mut [Event], origin: impl Fn(ValueId) -> ValueId) { - for event in events { - match event { - Event::Read { cell, index, .. } => { - *cell = origin(*cell); - *index = origin(*index); - } - Event::Select { value, .. } | Event::Reject { value, .. } => *value = origin(*value), - Event::Store { - cell, index, value, .. - } => { - *cell = origin(*cell); - *index = origin(*index); - *value = origin(*value); - } - Event::Advance { arguments } | Event::Direct { arguments, .. } => { - for value in arguments { - *value = origin(*value); - } - } - Event::Refine { source, .. } => *source = origin(*source), - Event::Apply { .. } - | Event::Allocate { .. } - | Event::OtherCall - | Event::OtherEffect - | Event::Trap => {} - } - } -} diff --git a/crates/psrs-backend/src/control/execution/mod.rs b/crates/psrs-backend/src/control/execution/mod.rs index 8b169e45..e40a1606 100644 --- a/crates/psrs-backend/src/control/execution/mod.rs +++ b/crates/psrs-backend/src/control/execution/mod.rs @@ -1,450 +1,10 @@ -//! The root fold and persistent queue have one operational contract across IRs. -use crate::cc::{ReprId, Representation, RepresentationTable}; -use crate::control::schema::{ComputationCase, ContextCase, SequenceCase}; -use crate::control::schema::{computation as c, sequence as q}; -use crate::types::ValueId; -use std::collections::HashMap; +//! The named action inventory of the flat driver. +//! +//! Every selection the operational semantics admits has exactly one entry. The +//! checked construction plan records them and `plan::check` requires the whole +//! inventory, so a missing case is a construction failure rather than a silent +//! gap. -pub(crate) type Facts = HashMap<(ReprId, ValueId), i32>; - -pub(crate) struct Schema { - pub computation: ReprId, - pub queue: ReprId, - pub context: ReprId, - pub pair: ReprId, - pub close: psrs_hir::SymbolId, - pub check: psrs_hir::SymbolId, - pub clone: psrs_hir::SymbolId, -} - -impl Schema { - pub fn checked(table: &RepresentationTable) -> Result { - let placed = table - .control_schema() - .ok_or("execution has no checked machine placement")?; - let pair = placed.result_pair; - if !matches!(table.representation(pair), Some(Representation::Product { fields }) - if fields == &[crate::cc::payload::erased_shape(); 2]) - { - return Err("execution result pair has an invalid planned representation"); - } - let helper = |role| { - table - .control_helper(role) - .ok_or("execution has no checked helper contract") - .map(crate::cc::ControlHelperContract::function) - }; - Ok(Self { - computation: placed.computation, - queue: placed.sequence, - context: placed.context, - pair, - close: helper(crate::cc::ControlHelperRole::Close)?, - check: helper(crate::cc::ControlHelperRole::Check)?, - clone: helper(crate::cc::ControlHelperRole::CloneSequence)?, - }) - } -} - -/// Each adapter discharges its IR's explicit operations into operand evidence. -/// Generic SSA/type verification separately checks availability and legality. -pub(crate) trait Operands { - fn inputs(&self, value: ValueId) -> Vec; - fn tag(&self, value: ValueId) -> Option<(ReprId, ValueId)>; - fn origin(&self, value: ValueId) -> ValueId; - fn projection(&self, value: ValueId, repr: ReprId, case: Option) - -> Option<(ValueId, u32)>; - fn node(&self, value: ValueId, repr: ReprId, case: Option) -> Option>; - fn application(&self, value: ValueId) -> Option<(ValueId, Vec)>; - fn raw_resumption(&self, value: ValueId) -> bool; -} - -fn field( - view: &impl Operands, - value: ValueId, - repr: ReprId, - tag: u32, - index: u32, - owner: ValueId, -) -> bool { - view.projection(value, repr, Some(tag)) == Some((view.origin(owner), index)) -} - -fn apply( - view: &impl Operands, - mut result: ValueId, - callee: ValueId, - arguments: &[ValueId], -) -> bool { - for argument in arguments.iter().rev() { - let Some((function, inputs)) = view.application(result) else { - return false; - }; - if inputs.len() != 1 || view.origin(inputs[0]) != view.origin(*argument) { - return false; - } - result = function; - } - view.origin(result) == view.origin(callee) -} - -pub(crate) fn transition( - schema: &Schema, - view: &impl Operands, - facts: &Facts, - current: &[ValueId], - next: &[ValueId], -) -> Result<(), &'static str> { - if current.len() != 6 || next.len() != 6 { - return Err("execution has an invalid executor transition"); - } - let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); - match selected(schema.computation, current[2]) { - Some(tag) - if tag == ComputationCase::Perform.tag() as i32 - && selected(schema.context, current[5]) == Some(ContextCase::Root.tag() as i32) => - { - root_request(schema, view, current, next) - } - Some(tag) if tag == ComputationCase::Return.tag() as i32 => { - returned(schema, view, facts, current, next) - } - Some(tag) - if (ComputationCase::Perform.tag() as i32 - ..=ComputationCase::OwnedResume.tag() as i32) - .contains(&tag) => - { - Ok(()) // Other owning relations check these steps. - } - _ => Err("execution exit has no current computation selection"), - } -} - -fn root_request( - schema: &Schema, - view: &impl Operands, - current: &[ValueId], - next: &[ValueId], -) -> Result<(), &'static str> { - for index in [1, 4, 5] { - if view.origin(next[index]) != view.origin(current[index]) { - return Err("root operation must preserve handler, extent and context"); - } - } - if view - .node(next[3], schema.queue, Some(SequenceCase::Empty.tag())) - .as_deref() - != Some(&[]) - { - return Err("root operation must clear its captured source queue"); - } - let pair = view - .projection(next[0], schema.pair, None) - .filter(|(_, field)| *field == crate::control::schema::result_pair::STATE) - .ok_or("root operation must consume the same handler result pair")? - .0; - if view.projection(next[2], schema.pair, None) - != Some((pair, crate::control::schema::result_pair::VALUE)) - { - return Err("root operation must consume the same handler result pair"); - } - let Some((after_request, resume)) = view.application(pair) else { - return Err("root operation must apply its complete handler"); - }; - let Some((after_state, request)) = view.application(after_request) else { - return Err("root operation must apply its complete handler"); - }; - if resume.len() != 1 - || request.len() != 1 - || !view.raw_resumption(resume[0]) - || !field( - view, - request[0], - schema.computation, - ComputationCase::Perform.tag(), - c::PAYLOAD, - current[2], - ) - || !apply(view, after_state, current[1], &[current[0]]) - { - return Err( - "root operation must apply its current handler to state, request and raw resumption", - ); - } - Ok(()) -} - -fn returned( - schema: &Schema, - view: &impl Operands, - facts: &Facts, - current: &[ValueId], - next: &[ValueId], -) -> Result<(), &'static str> { - let selected = |value| facts.get(&(schema.queue, view.origin(value))).copied(); - if selected(current[3]) == Some(SequenceCase::Empty.tag() as i32) { - return if facts.get(&(schema.context, view.origin(current[5]))) - == Some(&(ContextCase::Scoped.tag() as i32)) - { - Ok(()) - } else { - Err("root return must publish its state and current answer") - }; - } - for index in [0, 1, 5] { - if view.origin(next[index]) != view.origin(current[index]) { - return Err("queue execution must preserve state, handler and context"); - } - } - let queue = current[3]; - let finish = selected(queue) == Some(SequenceCase::Finish.tag() as i32); - if !finish && view.origin(next[4]) != view.origin(current[4]) { - return Err("queue execution must preserve its current extent"); - } - match selected(queue) { - Some(tag) if tag == SequenceCase::Cons.tag() as i32 => { - callback(schema, view, current[2], queue, next[2], next[3]) - } - Some(tag) if tag == SequenceCase::Append.tag() as i32 => { - let left = find_field( - view, - queue, - schema.queue, - SequenceCase::Append.tag(), - q::APPEND_LEFT, - facts, - )?; - append(schema, view, facts, current, next, left) - } - Some(tag) - if tag == SequenceCase::Finish.tag() as i32 - && view.origin(next[2]) == view.origin(current[2]) - && field( - view, - next[3], - schema.queue, - SequenceCase::Finish.tag(), - q::FINISH_REST, - queue, - ) - && field( - view, - next[4], - schema.queue, - SequenceCase::Finish.tag(), - q::FINISH_PARENT, - queue, - ) => - { - Ok(()) - } - _ => Err("queue execution must consume its selected current frame"), - } -} - -/// The selected Append left operand is retained in facts by its projection ID. -/// Do not invent a value when the producer's projection evidence is absent. -fn find_field( - view: &impl Operands, - owner: ValueId, - repr: ReprId, - tag: u32, - field_index: u32, - facts: &Facts, -) -> Result { - facts - .keys() - .filter(|(candidate, _)| *candidate == repr) - .map(|(_, value)| *value) - .find(|value| field(view, *value, repr, tag, field_index, owner)) - .ok_or("Append must dispatch on its current left queue") -} - -fn callback( - schema: &Schema, - view: &impl Operands, - input: ValueId, - queue: ValueId, - computation: ValueId, - rest: ValueId, -) -> Result<(), &'static str> { - let Some((callee, answer)) = view.application(computation) else { - return Err("queue callback result must enter the next computation"); - }; - if answer.len() != 1 - || !field( - view, - callee, - schema.queue, - SequenceCase::Cons.tag(), - q::CONS_HEAD, - queue, - ) - || !field( - view, - answer[0], - schema.computation, - ComputationCase::Return.tag(), - c::PAYLOAD, - input, - ) - || !field( - view, - rest, - schema.queue, - SequenceCase::Cons.tag(), - q::CONS_TAIL, - queue, - ) - { - return Err("queue callback must consume its current answer, callback and tail"); - } - Ok(()) -} - -fn append( - schema: &Schema, - view: &impl Operands, - facts: &Facts, - current: &[ValueId], - next: &[ValueId], - left: ValueId, -) -> Result<(), &'static str> { - let right = |value| { - field( - view, - value, - schema.queue, - SequenceCase::Append.tag(), - q::APPEND_RIGHT, - current[3], - ) - }; - let same = view.origin(next[2]) == view.origin(current[2]); - match facts.get(&(schema.queue, view.origin(left))).copied() { - Some(tag) if tag == SequenceCase::Empty.tag() as i32 && same && right(next[3]) => Ok(()), - Some(tag) if tag == SequenceCase::Cons.tag() as i32 => { - let node = view - .node(next[3], schema.queue, Some(SequenceCase::Append.tag())) - .filter(|fields| fields.len() == 2) - .ok_or("Append callback must retain its current right queue")?; - if !right(node[1]) { - return Err("Append callback must retain its current right queue"); - } - callback(schema, view, current[2], left, next[2], node[0]) - } - Some(tag) if tag == SequenceCase::Append.tag() as i32 && same => { - let node = view - .node(next[3], schema.queue, Some(SequenceCase::Append.tag())) - .filter(|fields| fields.len() == 2) - .ok_or("Append reassociation must preserve left-to-right queue order")?; - let tail = view - .node(node[1], schema.queue, Some(SequenceCase::Append.tag())) - .filter(|fields| fields.len() == 2) - .ok_or("Append reassociation must preserve left-to-right queue order")?; - if field( - view, - node[0], - schema.queue, - SequenceCase::Append.tag(), - q::APPEND_LEFT, - left, - ) && field( - view, - tail[0], - schema.queue, - SequenceCase::Append.tag(), - q::APPEND_RIGHT, - left, - ) && right(tail[1]) - { - Ok(()) - } else { - Err("Append reassociation must preserve left-to-right queue order") - } - } - Some(tag) if tag == SequenceCase::Finish.tag() as i32 && same => { - let node = view - .node(next[3], schema.queue, Some(SequenceCase::Finish.tag())) - .filter(|fields| fields.len() == 3) - .ok_or("Append must retain the complete left finish frame")?; - let tail = view - .node(node[1], schema.queue, Some(SequenceCase::Append.tag())) - .filter(|fields| fields.len() == 2) - .ok_or("Append must retain the complete left finish frame")?; - if field( - view, - node[0], - schema.queue, - SequenceCase::Finish.tag(), - q::FINISH_EXTENT, - left, - ) && field( - view, - node[2], - schema.queue, - SequenceCase::Finish.tag(), - q::FINISH_PARENT, - left, - ) && field( - view, - tail[0], - schema.queue, - SequenceCase::Finish.tag(), - q::FINISH_REST, - left, - ) && right(tail[1]) - { - Ok(()) - } else { - Err("Append must retain the complete left finish frame") - } - } - _ => Err("Append must consume its selected current left frame"), - } -} - -pub(crate) fn publish( - schema: &Schema, - view: &impl Operands, - facts: &Facts, - current: &[ValueId], - result: ValueId, -) -> Result<(), &'static str> { - if current.len() != 6 - || facts.get(&(schema.computation, view.origin(current[2]))) - != Some(&(ComputationCase::Return.tag() as i32)) - || facts.get(&(schema.queue, view.origin(current[3]))) - != Some(&(SequenceCase::Empty.tag() as i32)) - || facts.get(&(schema.context, view.origin(current[5]))) - != Some(&(ContextCase::Root.tag() as i32)) - { - return Err("execution result must be its terminal root return"); - } - let fields = view - .node(result, schema.pair, None) - .filter(|fields| fields.len() == 2) - .ok_or("root return must publish its state and current answer")?; - if view.origin(fields[0]) != view.origin(current[0]) - || !field( - view, - fields[1], - schema.computation, - ComputationCase::Return.tag(), - c::PAYLOAD, - current[2], - ) - { - return Err("root return must publish its state and current answer"); - } - Ok(()) -} - -/// One required action of the flat driver. Every selection the operational -/// semantics admits has exactly one entry; `ActionRegistry::finish` requires all -/// of them, so a missing case is a completeness failure rather than a silent -/// gap. Actions are recorded only from validated actual exits: a trapping -/// default cannot stand in for a required root or queue action. #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub(crate) enum ActionId { PerformRoot, @@ -459,7 +19,7 @@ pub(crate) enum ActionId { impl ActionId { /// The complete required action inventory of the flat driver. - pub const ALL: [Self; 8] = [ + pub(crate) const ALL: [Self; 8] = [ Self::PerformRoot, Self::ReturnEmptyRoot, Self::ReturnCons, @@ -470,96 +30,3 @@ impl ActionId { Self::AppendFinish, ]; } - -#[derive(Default)] -pub(crate) struct ActionRegistry(std::collections::HashSet); - -impl ActionRegistry { - /// Record the action of one validated actual exit. - pub fn observe( - &mut self, - schema: &Schema, - view: &impl Operands, - facts: &Facts, - current: &[ValueId], - ) { - if current.len() != 6 { - return; - } - let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); - let tag = |case: crate::control::schema::ComputationCase| case.tag() as i32; - match selected(schema.computation, current[2]) { - Some(computation) - if computation == tag(ComputationCase::Perform) - && selected(schema.context, current[5]) - == Some(ContextCase::Root.tag() as i32) => - { - self.0.insert(ActionId::PerformRoot); - } - Some(computation) if computation == tag(ComputationCase::Return) => { - match selected(schema.queue, current[3]) { - Some(queue) - if queue == SequenceCase::Empty.tag() as i32 - && selected(schema.context, current[5]) - == Some(ContextCase::Root.tag() as i32) => - { - self.0.insert(ActionId::ReturnEmptyRoot); - } - Some(queue) - if queue == SequenceCase::Cons.tag() as i32 - || queue == SequenceCase::Finish.tag() as i32 => - { - self.0.insert(if queue == SequenceCase::Cons.tag() as i32 { - ActionId::ReturnCons - } else { - ActionId::ReturnFinish - }); - } - Some(queue) if queue == SequenceCase::Append.tag() as i32 => { - if let Ok(left) = find_field( - view, - current[3], - schema.queue, - SequenceCase::Append.tag(), - q::APPEND_LEFT, - facts, - ) && let Some(left) = selected(schema.queue, left) - { - let action = match left { - value if value == SequenceCase::Empty.tag() as i32 => { - Some(ActionId::AppendEmpty) - } - value if value == SequenceCase::Cons.tag() as i32 => { - Some(ActionId::AppendCons) - } - value if value == SequenceCase::Append.tag() as i32 => { - Some(ActionId::AppendAppend) - } - value if value == SequenceCase::Finish.tag() as i32 => { - Some(ActionId::AppendFinish) - } - _ => None, - }; - if let Some(action) = action { - self.0.insert(action); - } - } - } - _ => {} - } - } - _ => {} - } - } - - pub fn finish(&self) -> Result<(), &'static str> { - if ActionId::ALL.iter().all(|action| self.0.contains(action)) { - Ok(()) - } else { - Err("execution must retain every root and queue action") - } - } -} - -mod observables; -pub(crate) use observables::verify as effects; diff --git a/crates/psrs-backend/src/control/execution/observables.rs b/crates/psrs-backend/src/control/execution/observables.rs deleted file mode 100644 index 9328c5c6..00000000 --- a/crates/psrs-backend/src/control/execution/observables.rs +++ /dev/null @@ -1,134 +0,0 @@ -use super::{Facts, Operands, Schema, field, find_field}; -use crate::types::ValueId; - -/// Every dynamic application on a root/queue path is part of its validated -/// transition. Close is the sole static effect of an ordinary Finish step. -pub(crate) fn verify( - schema: &Schema, - view: &impl Operands, - facts: &Facts, - current: &[ValueId], - next: Option<&[ValueId]>, - events: &[crate::control::events::Event], - total: &std::collections::HashSet, -) -> Result<(), &'static str> { - use crate::control::events::Event; - if current.len() != 6 { - return Err("execution has invalid arguments"); - } - let selected = |repr, value| facts.get(&(repr, view.origin(value))).copied(); - let tag = selected(schema.computation, current[2]); - if !matches!(tag, Some(0..=4)) { - return Ok(()); - } - let context = selected(schema.context, current[5]); - let queue = selected(schema.queue, current[3]); - let count = if !matches!(tag, Some(0 | 1)) { - 0 - } else if tag == Some(1) { - if context == Some(0) { 3 } else { 2 } - } else if queue == Some(1) - || (queue == Some(0) && context == Some(1)) - || (queue == Some(2) - && find_field(view, current[3], schema.queue, 2, 0, facts) - .is_ok_and(|left| selected(schema.queue, left) == Some(1))) - { - 1 - } else { - 0 - }; - let mut expected = std::collections::HashSet::new(); - if count > 0 { - let next = next.ok_or("execution is missing its required application")?; - let mut result = if tag == Some(1) && context == Some(0) { - view.projection(next[0], schema.pair, None) - .ok_or("root operation has no handler result")? - .0 - } else { - next[2] - }; - for _ in 0..count { - expected.insert(view.origin(result)); - result = view - .application(result) - .ok_or("execution is missing its required application")? - .0; - } - } - let finish = tag == Some(0) && queue == Some(3); - let mut closed = false; - let mut advanced = false; - let mut checked = false; - let mut cloned = false; - for event in events { - match event { - Event::Apply { result } if expected.remove(&view.origin(*result)) => {} - Event::Advance { arguments } - if !advanced - && next.is_some_and(|next| { - arguments.len() == next.len() - && arguments - .iter() - .zip(next) - .all(|(left, right)| view.origin(*left) == view.origin(*right)) - }) => - { - advanced = true; - } - Event::Direct { - function, - arguments, - } if finish - && !closed - && *function == schema.close - && arguments.len() == 1 - && field(view, arguments[0], schema.queue, 3, 0, current[3]) => - { - closed = true; - } - Event::Direct { - function, - arguments, - } if tag == Some(3) - && !checked - && *function == schema.check - && arguments.len() == 1 - && field(view, arguments[0], schema.computation, 3, 2, current[2]) => - { - checked = true; - } - Event::Direct { - function, - arguments, - } if tag == Some(3) - && !cloned - && *function == schema.clone - && arguments.len() == 5 - && field(view, arguments[0], schema.computation, 3, 1, current[2]) => - { - cloned = true; - } - Event::Direct { function, .. } if total.contains(function) => {} - Event::Apply { .. } - | Event::Advance { .. } - | Event::Direct { .. } - | Event::OtherCall - | Event::OtherEffect - | Event::Trap - | Event::Read { .. } - | Event::Store { .. } => { - return Err("root or queue execution contains an additional observable operation"); - } - _ => {} - } - } - if !expected.is_empty() - || advanced != next.is_some() - || closed != finish - || checked != (tag == Some(3)) - || cloned != (tag == Some(3)) - { - return Err("root or queue execution is missing its required effects"); - } - Ok(()) -} diff --git a/crates/psrs-backend/src/control/lifecycle.rs b/crates/psrs-backend/src/control/lifecycle.rs deleted file mode 100644 index 29f107cd..00000000 --- a/crates/psrs-backend/src/control/lifecycle.rs +++ /dev/null @@ -1,135 +0,0 @@ -//! Extent helper bodies discharge lifecycle semantics independently of callees. -use super::events::Event; -use super::owned::OwnedOperands; -use crate::cc::{ControlHelperRole as R, ReprId, RepresentationTable}; -use crate::types::ValueId; - -pub(crate) struct Schema { - pub boundary: ReprId, - pub status: ReprId, - pub check: psrs_hir::SymbolId, -} -impl Schema { - pub fn checked(table: &RepresentationTable) -> Result { - let replay = table - .control_replay_schema() - .ok_or("lifecycle has no checked extent schema")?; - let check = table - .control_helper(R::Check) - .ok_or("lifecycle has no Check contract")? - .function(); - Ok(Self { - boundary: replay.boundary, - status: replay.status, - check, - }) - } -} - -pub(crate) fn verify( - schema: &Schema, - view: &impl OwnedOperands, - role: R, - input: ValueId, - result: Option, - next: Option<&[ValueId]>, - events: &[Event], -) -> Result { - let input = view.origin(input); - let selected = events - .iter() - .filter_map(|event| match event { - Event::Select { value, tag } if view.tag(*value) == Some((schema.boundary, input)) => { - Some(*tag) - } - _ => None, - }) - .collect::>(); - let [tag @ 0..=1] = selected.as_slice() else { - return Err("lifecycle must select its current extent case"); - }; - let is_cell = - |cell| view.projection(cell, schema.boundary, Some(*tag as u32)) == Some((input, 0)); - let is_parent = |value| view.projection(value, schema.boundary, Some(1)) == Some((input, 1)); - let mut read = None; - let mut guarded = false; - let mut written = false; - let mut advanced = false; - for event in events { - match event { - Event::Refine { .. } => {} - Event::Select { value, tag: actual } - if view.tag(*value) == Some((schema.boundary, input)) && actual == tag => {} - Event::Read { - repr, - cell, - index, - result, - } if role == R::Check - && *repr == schema.status - && is_cell(*cell) - && view.integer(*index) == Some(0) - && read.is_none() => - { - read = Some(view.origin(*result)); - } - Event::Select { value, tag: 0 } - if role == R::Check && read == Some(view.origin(*value)) && !guarded => - { - guarded = true; - } - Event::Store { - repr, - cell, - index, - value, - } if role == R::Close - && *repr == schema.status - && is_cell(*cell) - && view.integer(*index) == Some(0) - && view.integer(*value) == Some(1) - && !written => - { - written = true; - } - Event::Direct { - function, - arguments, - } if role == R::Check - && *tag == 1 - && guarded - && *function == schema.check - && arguments.len() == 1 - && is_parent(arguments[0]) - && !advanced => - { - advanced = true; - } - Event::Advance { arguments } - if role == R::Check - && *tag == 1 - && guarded - && arguments.len() == 1 - && is_parent(arguments[0]) - && !advanced => - { - advanced = true; - } - _ => return Err("lifecycle body contains an unaccounted operation"), - } - } - if role == R::Close { - if !written || next.is_some() || result.map(|value| view.origin(value)) != Some(input) { - return Err("Close must write its own closed status and return its extent"); - } - } else if !guarded { - return Err("Check must guard its own live status before returning or checking ancestry"); - } else if *tag == 0 { - if next.is_some() || result.map(|value| view.origin(value)) != Some(input) { - return Err("root Check must return its checked extent"); - } - } else if !advanced || !next.is_some_and(|args| args.len() == 1 && is_parent(args[0])) { - return Err("child Check must continue with its own parent"); - } - Ok(*tag) -} diff --git a/crates/psrs-backend/src/control/mod.rs b/crates/psrs-backend/src/control/mod.rs index 38d78c22..347caf8c 100644 --- a/crates/psrs-backend/src/control/mod.rs +++ b/crates/psrs-backend/src/control/mod.rs @@ -1,18 +1,7 @@ //! Stage-independent contracts for the control machine. //! -//! `schema` names the machine's cases, fields and roles; `dispatch` names the -//! required alternatives of each carrier and verifies that a dispatch covers -//! them; `provenance` states the ownership relations that CC and MIR control -//! checks share. All are independent of any IR shape. -pub(crate) mod schema; - -pub(crate) mod dispatch; -pub(crate) mod provenance; -pub(crate) mod steps; - +//! The machine semantics live at the checked construction plan +//! (`cc/lower/control/plan`). This module keeps the named schema the plan, +//! layout and verification consume, plus the flat-driver action inventory. pub(crate) mod execution; - -pub(crate) mod owned; - -pub(crate) mod events; -pub(crate) mod lifecycle; +pub(crate) mod schema; diff --git a/crates/psrs-backend/src/control/owned.rs b/crates/psrs-backend/src/control/owned.rs deleted file mode 100644 index bbcfffc8..00000000 --- a/crates/psrs-backend/src/control/owned.rs +++ /dev/null @@ -1,330 +0,0 @@ -//! One-shot execution is an ordered transfer of private owner storage. -use super::execution::{Operands, Schema}; -use crate::cc::{ReprId, Representation, RepresentationTable, ValueShape}; -use crate::types::ValueId; - -pub(crate) struct OwnedSchema { - pub owner: ReprId, - pub callback: ReprId, - pub status: ReprId, -} - -impl OwnedSchema { - pub fn checked(table: &RepresentationTable) -> Result { - let schema = table - .control_schema() - .ok_or("owned execution has no checked machine placement")?; - if !matches!(table.representation(schema.callback), Some(Representation::Array { element }) if *element == crate::cc::payload::erased_shape()) - || !matches!( - table.representation(schema.status), - Some(Representation::Array { - element: ValueShape::Integer - }) - ) - { - return Err("owned execution has invalid private storage"); - } - Ok(Self { - owner: schema.owner, - callback: schema.callback, - status: schema.status, - }) - } -} - -pub(crate) trait OwnedOperands: Operands { - fn read(&self, value: ValueId, repr: ReprId) -> Option<(ValueId, i32)>; - fn integer(&self, value: ValueId) -> Option; - fn initial(&self, cell: ValueId, repr: ReprId) -> Option; -} - -use super::events::Event; - -pub(crate) fn verify( - schema: &Schema, - owned: &OwnedSchema, - view: &impl OwnedOperands, - current: &[ValueId], - next: &[ValueId], - events: &[Event], -) -> Result<(), &'static str> { - if current.len() != 6 || next.len() != 6 { - return Err("owned execution has invalid transition arguments"); - } - for index in [0, 1, 3, 4, 5] { - if view.origin(current[index]) != view.origin(next[index]) { - return Err("owned execution must preserve state, handler, queue, extent and context"); - } - } - let (callee, arguments) = view - .application(next[2]) - .filter(|(_, arguments)| arguments.len() == 1) - .ok_or("owned execution must consume its callback result")?; - if view.projection(arguments[0], schema.computation, Some(5)) - != Some((view.origin(current[2]), 1)) - { - return Err("owned execution must pass its current answer"); - } - let (callback, 0) = view - .read(callee, owned.callback) - .ok_or("owned execution must load its own callback slot")? - else { - return Err("owned execution must load its own callback slot"); - }; - let (owner, 0) = view - .projection(callback, owned.owner, Some(0)) - .ok_or("owned execution must load its own callback slot")? - else { - return Err("owned execution must load its own callback slot"); - }; - if view.projection(owner, schema.computation, Some(5)) != Some((view.origin(current[2]), 0)) { - return Err("owned execution must consume its current owner"); - } - let is_status = |value| view.projection(value, owned.owner, Some(0)) == Some((owner, 1)); - let mut pending = None; - let mut running = None; - let mut loaded = None; - let mut cleared = None; - let mut called = None; - let mut consumed = None; - let mut advanced = None; - for (point, event) in events.iter().enumerate() { - match event { - Event::Refine { .. } => {} - Event::Read { - repr, - cell, - index, - result, - } => { - if view.integer(*index) != Some(0) { - return Err("owned execution must access slot zero"); - } - if *repr == owned.callback - && view.origin(*cell) == callback - && view.origin(*result) == view.origin(callee) - { - if loaded.replace(point).is_some() { - return Err("owned execution must load its callback exactly once"); - } - } else if *repr != owned.status || !is_status(*cell) { - return Err("owned execution must read its own private storage"); - } - } - Event::Select { value, tag } => { - if let Some((cell, 0)) = view.read(*value, owned.status) - && (!is_status(cell) || *tag != 0 || pending.replace(point).is_some()) - { - return Err("owned execution must establish Pending exactly once"); - } - } - Event::Store { - repr, - cell, - index, - value, - } => { - if view.integer(*index) != Some(0) { - return Err("owned execution must access slot zero"); - } - if *repr == owned.status && is_status(*cell) { - match view.integer(*value) { - Some(1) if running.replace(point).is_none() => {} - Some(2) if consumed.replace(point).is_none() => {} - _ => { - return Err( - "owned execution must transfer Pending to Running then Consumed", - ); - } - } - } else if *repr == owned.callback - && view.origin(*cell) == callback - && is_status(*value) - && cleared.replace(point).is_none() - { - } else { - return Err("owned execution must clear its callback with its own status cell"); - } - } - Event::Apply { result } - if view.origin(*result) == view.origin(next[2]) - && called.replace(point).is_none() => {} - Event::Advance { arguments } - if arguments.len() == next.len() - && arguments - .iter() - .zip(next) - .all(|(left, right)| view.origin(*left) == view.origin(*right)) - && advanced.replace(point).is_none() => {} - _ => return Err("owned execution contains an additional observable operation"), - } - } - let Some(points) = pending - .zip(running) - .zip(loaded) - .zip(cleared) - .zip(called) - .zip(consumed) - .zip(advanced) - else { - return Err("owned execution is missing its required transfer steps"); - }; - let ((((((pending, running), loaded), cleared), called), consumed), advanced) = points; - if !(pending < running - && running < loaded - && loaded < cleared - && cleared < called - && called < consumed - && consumed < advanced) - { - return Err("owned execution must guard, acquire, load, clear, call and consume in order"); - } - Ok(()) -} - -/// A constructor proves only initial contents. Replay ordered private stores -/// and reads before publication; a later store must not inherit stale evidence. -pub(crate) enum Expected { - Value(ValueId), - Integer(i32), -} - -pub(crate) fn publication( - view: &impl OwnedOperands, - roots: &[ValueId], - cells: &[(ValueId, ReprId, Expected)], - events: &[Event], - total: &std::collections::HashSet, -) -> Result<(), &'static str> { - let mut contents = std::collections::HashMap::new(); - let mut observed = std::collections::HashMap::new(); - for (cell, repr, _) in cells { - let value = view - .initial(*cell, *repr) - .ok_or("control factory must allocate fresh one-slot private cells")?; - contents.insert(view.origin(*cell), view.origin(value)); - } - let resolve = |mut value: ValueId, observed: &std::collections::HashMap| { - value = view.origin(value); - for _ in 0..observed.len() { - if let Some(next) = observed.get(&value) { - value = *next - } else { - break; - } - } - value - }; - for event in events { - match event { - Event::Refine { .. } => {} - Event::Read { - cell, - index, - result, - .. - } => { - if let Some(value) = contents.get(&view.origin(*cell)) { - if view.integer(*index) != Some(0) { - return Err("control factory must access private slot zero"); - } - observed.insert(view.origin(*result), *value); - } else { - return Err("control factory must read its own private storage"); - } - } - Event::Store { - cell, index, value, .. - } => { - if let Some(content) = contents.get_mut(&view.origin(*cell)) { - if view.integer(*index) != Some(0) { - return Err("control factory must access private slot zero"); - } - *content = resolve(*value, &observed); - } else { - return Err("control factory must write its own private storage"); - } - } - Event::Direct { function, .. } if total.contains(function) => {} - Event::Direct { .. } - | Event::Apply { .. } - | Event::Advance { .. } - | Event::OtherCall => { - return Err("control factory must not invoke callbacks before publication"); - } - Event::Allocate { .. } | Event::Select { .. } | Event::Reject { .. } => {} - _ => return Err("control factory contains an additional observable operation"), - } - } - super::events::allocations(view, roots, events)?; - for (cell, _, expected) in cells { - let actual = contents[&view.origin(*cell)]; - let matches = match expected { - Expected::Value(value) => actual == resolve(*value, &observed), - Expected::Integer(value) => view.integer(actual) == Some(*value), - }; - if !matches { - return Err("control factory must publish its required private cell contents"); - } - } - Ok(()) -} - -pub(crate) fn cancel( - owned: &OwnedSchema, - view: &impl OwnedOperands, - owner: ValueId, - result: ValueId, - events: &[Event], -) -> Result<(), &'static str> { - if view.origin(owner) != view.origin(result) { - return Err("cancellation must retain its current owner"); - } - let field = |value, index| { - view.projection(value, owned.owner, Some(0)) == Some((view.origin(owner), index)) - }; - let mut pending = None; - let mut cancelled = None; - let mut cleared = None; - for (point, event) in events.iter().enumerate() { - match event { - Event::Refine { .. } => {} - Event::Read { - repr, cell, index, .. - } if *repr == owned.status && field(*cell, 1) && view.integer(*index) == Some(0) => {} - Event::Select { value, tag } => { - if let Some((cell, 0)) = view.read(*value, owned.status) - && (!field(cell, 1) || *tag != 0 || pending.replace(point).is_some()) - { - return Err("cancellation must establish Pending exactly once"); - } - } - Event::Store { - repr, - cell, - index, - value, - } if view.integer(*index) == Some(0) => { - let cancel = *repr == owned.status - && field(*cell, 1) - && view.integer(*value) == Some(3) - && cancelled.replace(point).is_none(); - let clear = *repr == owned.callback - && field(*cell, 0) - && field(*value, 1) - && cleared.replace(point).is_none(); - if !(cancel || clear) { - return Err("cancellation must cancel and clear its own private storage"); - } - } - _ => return Err("cancellation contains an additional observable operation"), - } - } - if !matches!((pending, cancelled, cleared), (Some(pending), Some(cancelled), Some(cleared)) if pending < cancelled && cancelled < cleared) - { - return Err( - "cancellation must guard Pending, mark Cancelled and clear the callback in order", - ); - } - Ok(()) -} diff --git a/crates/psrs-backend/src/control/provenance.rs b/crates/psrs-backend/src/control/provenance.rs deleted file mode 100644 index be92f2ec..00000000 --- a/crates/psrs-backend/src/control/provenance.rs +++ /dev/null @@ -1,248 +0,0 @@ -//! Stage-independent ownership relations for the control machine. -use crate::control::schema::{ContextCase, computation, context, sequence}; -use crate::types::ValueId; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub(crate) struct FinishProjection { - pub owner: ValueId, - pub field: u32, -} - -/// Finishing restores all lifecycle state from one immutable finish record. -/// A shape-compatible parent or a projection from another record is insufficient. -pub(crate) fn finish_relation( - extent: Option, - queue: Option, - parent: Option, -) -> Result<(), &'static str> { - let extent = extent - .filter(|projection| projection.field == sequence::FINISH_EXTENT) - .ok_or("control finish must close its frame's extent, not another boundary")?; - if queue - != Some(FinishProjection { - owner: extent.owner, - field: sequence::FINISH_REST, - }) - || parent - != Some(FinishProjection { - owner: extent.owner, - field: sequence::FINISH_PARENT, - }) - { - return Err("control finish must restore the queue and parent from the same frame"); - } - Ok(()) -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub(crate) struct CaptureProjection { - pub receiver: ValueId, - pub slot: u32, -} - -pub(crate) fn checkpoint_capture_relation( - receiver: ValueId, - queue: Option, - checkpoint: Option, -) -> Result<(), &'static str> { - if queue != Some(CaptureProjection { receiver, slot: 0 }) - || checkpoint != Some(CaptureProjection { receiver, slot: 1 }) - { - return Err("raw resumption must save its own queue and checkpoint capture slots"); - } - Ok(()) -} - -pub(crate) fn dispatch_checkpoint_relation( - context: ValueId, - projection: Option<(ValueId, u32, u32)>, -) -> Result<(), &'static str> { - match projection { - Some((owner, case, field)) - if owner == context - && ((case == ContextCase::Root.tag() && field == context::ROOT_EXTENT) - || (case == ContextCase::Scoped.tag() && field == context::SCOPED_EXTENT)) => - { - Ok(()) - } - _ => Err("raw resumption must capture its current dispatch context checkpoint"), - } -} - -pub(crate) fn saved_finish_relation( - input: ValueId, - extent: Option, -) -> Result<(), &'static str> { - if extent - != Some(FinishProjection { - owner: input, - field: sequence::FINISH_EXTENT, - }) - { - return Err("replay must preserve the original saved finish extent"); - } - Ok(()) -} - -pub(crate) fn replay_activation_relation( - previous_queue: ValueId, - previous_active: ValueId, - queue: ValueId, - restored_parent: ValueId, -) -> Result<(), &'static str> { - if queue != previous_queue || restored_parent != previous_active { - return Err("replay finish must retain its accumulated queue and previous active extent"); - } - Ok(()) -} - -pub(crate) fn context_finish_relation( - context: ValueId, - extent: Option, - queue: Option, - parent: Option, -) -> Result<(), &'static str> { - for (projection, field) in [ - (extent, context::SCOPED_EXTENT), - (queue, context::SCOPED_SAVED), - (parent, context::SCOPED_PARENT), - ] { - if projection - != Some(FinishProjection { - owner: context, - field, - }) - { - return Err("target finish must preserve its source context extent, queue and parent"); - } - } - Ok(()) -} - -/// A scoped dispatch owns the clauses of the current Handle computation. -pub(crate) fn context_clause_relation( - computation: ValueId, - return_clause: Option, - operation_clause: Option, -) -> Result<(), &'static str> { - if return_clause - != Some(FinishProjection { - owner: computation, - field: context::SCOPED_RETURN, - }) - || operation_clause - != Some(FinishProjection { - owner: computation, - field: context::SCOPED_OPERATION, - }) - { - return Err("source context must retain the current Handle return and operation clauses"); - } - Ok(()) -} - -/// Tail scope entry removes one finish while sharing its completion boundary. -pub(crate) fn context_tail_relation( - sequence: ValueId, - saved: Option, - parent: Option, - extent: Option, -) -> Result<(), &'static str> { - for (projection, field) in [ - (saved, crate::control::schema::sequence::FINISH_REST), - (parent, crate::control::schema::sequence::FINISH_PARENT), - (extent, crate::control::schema::sequence::FINISH_EXTENT), - ] { - if projection - != Some(FinishProjection { - owner: sequence, - field, - }) - { - return Err( - "tail source context must retain queue, parent and extent from its current finish", - ); - } - } - Ok(()) -} - -pub(crate) fn root_extent_relation( - execution: ValueId, - dispatch: ValueId, -) -> Result<(), &'static str> { - if execution != dispatch { - return Err("control run must use the same fresh root extent for execution and dispatch"); - } - Ok(()) -} - -/// Which clause a source computation step applies at its current delimiter. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub(crate) enum ClauseKind { - Return, - Operation, -} - -impl ClauseKind { - /// The scoped context field that holds this clause. - pub(crate) fn field(self) -> u32 { - match self { - Self::Return => context::SCOPED_RETURN, - Self::Operation => context::SCOPED_OPERATION, - } - } - - /// The source computation tag this clause step interprets. - pub(crate) fn source_tag(self) -> i32 { - match self { - Self::Return => crate::control::schema::ComputationCase::Return.tag() as i32, - Self::Operation => crate::control::schema::ComputationCase::Perform.tag() as i32, - } - } - - fn message(self) -> &'static str { - match self { - Self::Return => "source return must apply its scoped return clause", - Self::Operation => "source operation must apply its scoped operation clause", - } - } -} - -/// A source `Return` applies the scoped return clause (field zero); a source -/// `Perform` applies the scoped operation clause (field one). The applied -/// callable must be that clause projection of the current scoped context, not a -/// boundary or another field of the same frame. -pub(crate) fn clause_selection_relation( - kind: ClauseKind, - context: ValueId, - clause: Option, -) -> Result<(), &'static str> { - if clause - != Some(FinishProjection { - owner: context, - field: kind.field(), - }) - { - return Err(kind.message()); - } - Ok(()) -} - -/// The first clause operand is the answer/request of the current source step. -/// The stage verifier separately connects the complete application result to -/// the next executor transition and proves that its calls execute on that path. -pub(crate) fn clause_operand_relation( - input: ValueId, - payload: Option, -) -> Result<(), &'static str> { - if payload - != Some(FinishProjection { - owner: input, - field: computation::PAYLOAD, - }) - { - return Err("source clause must consume the current computation payload"); - } - Ok(()) -} diff --git a/crates/psrs-backend/src/control/steps.rs b/crates/psrs-backend/src/control/steps.rs deleted file mode 100644 index 0d56f7f3..00000000 --- a/crates/psrs-backend/src/control/steps.rs +++ /dev/null @@ -1,43 +0,0 @@ -//! Operand identities required by the inert Bind and raw Resume transitions. -use super::provenance::FinishProjection; -use crate::control::schema::computation; -use crate::types::ValueId; - -pub(crate) fn bind_relation( - input: ValueId, - queue: ValueId, - inner: Option, - callback: Option, - tail: ValueId, -) -> Result<(), &'static str> { - if inner - != Some(FinishProjection { - owner: input, - field: computation::BIND_INNER, - }) - || callback - != Some(FinishProjection { - owner: input, - field: computation::BIND_CONTINUATION, - }) - || tail != queue - { - return Err("Bind must enter its body with its own callback and current queue"); - } - Ok(()) -} - -pub(crate) fn resume_answer_relation( - input: ValueId, - answer: Option, -) -> Result<(), &'static str> { - if answer - != Some(FinishProjection { - owner: input, - field: computation::RESUME_VALUE, - }) - { - return Err("Resume must return its current saved answer"); - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/branch_facts.rs b/crates/psrs-backend/src/mir/branch_facts.rs deleted file mode 100644 index 863d30f3..00000000 --- a/crates/psrs-backend/src/mir/branch_facts.rs +++ /dev/null @@ -1,310 +0,0 @@ -//! Field-zero equality facts propagated across real CFG edges and SSA joins. -use super::value_identity::{Definitions, definitions, reference_origin}; -use super::{BlockId, Function, Instruction as I, Terminator as T}; -use crate::types::{DefinedTypeId, ValueId}; -use std::collections::{HashMap, VecDeque}; - -pub(crate) type Key = (DefinedTypeId, ValueId); -pub(crate) type Facts = HashMap; - -pub(crate) fn tag_source(value: ValueId, definitions: &Definitions<'_>) -> Option { - let origin = |value| reference_origin(value, definitions); - match definitions.get(&origin(value)).copied()? { - I::StructGet { - type_index, - field: 0, - value, - .. - } => Some((*type_index, origin(*value))), - _ => None, - } -} - -pub(crate) fn compute(function: &Function) -> HashMap { - let definitions = definitions(function); - let origin = |value| reference_origin(value, &definitions); - let blocks = function - .blocks - .iter() - .map(|block| (block.id, block)) - .collect::>(); - let mut states = HashMap::::from([(function.entry, Facts::new())]); - let mut pending = VecDeque::from([function.entry]); - while let Some(id) = pending.pop_front() { - let Some(block) = blocks.get(&id) else { - continue; - }; - let Some(terminator) = &block.terminator else { - continue; - }; - let mut edges = super::cfg::successors(terminator) - .into_iter() - .map(|target| (target, states[&id].clone())) - .collect::>(); - if let T::Switch { value, cases, .. } = terminator - && let Some(key) = tag_source(*value, &definitions) - { - for (index, (tag, _)) in cases.iter().enumerate() { - edges[index].1.insert(key, *tag); - } - if let Some((_, facts)) = edges.last_mut() { - facts.remove(&key); - } - } - // A join parameter denotes its incoming argument on this edge. Existing - // facts about that parameter must not survive a new loop iteration. - if let T::Jump { - target, arguments, .. - } = terminator - && let Some(successor) = blocks.get(target) - { - for (_, facts) in &mut edges { - let old = facts.clone(); - facts.retain(|(_, value), _| !successor.parameters.contains(value)); - for (parameter, argument) in successor.parameters.iter().zip(arguments) { - for ((ty, value), tag) in &old { - if *value == origin(*argument) { - facts.insert((*ty, *parameter), *tag); - } - } - } - } - } - for (target, incoming) in edges { - if !blocks.contains_key(&target) { - continue; - } - let changed = match states.get_mut(&target) { - None => { - states.insert(target, incoming); - true - } - Some(existing) => { - let before = existing.len(); - existing.retain(|key, tag| incoming.get(key) == Some(tag)); - existing.len() != before - } - }; - if changed { - pending.push_back(target); - } - } - } - states -} - -pub(crate) struct Exit { - pub block: BlockId, - pub facts: Facts, - pub aliases: HashMap, - pub points: Vec<(BlockId, usize)>, - pub rejections: Vec<(ValueId, Vec, (BlockId, usize))>, - pub trapped: bool, - pub selections: Vec<(ValueId, i32, (BlockId, usize))>, -} - -/// Enumerate normal exits within one CFG region. An edge to `stop` exits the -/// region; trapping paths have no result. Keep each path's SSA arguments so a -/// shared return block cannot erase which selected frame produced its result. -pub(crate) fn paths( - function: &Function, - start: BlockId, - stop: Option, -) -> Result, &'static str> { - let definitions = definitions(function); - let blocks = function - .blocks - .iter() - .map(|block| (block.id, block)) - .collect::>(); - let mut pending = vec![( - start, - Facts::new(), - HashMap::new(), - std::collections::HashSet::new(), - Vec::new(), - Vec::new(), - Vec::new(), - )]; - let mut exits = Vec::new(); - while let Some((id, facts, aliases, mut active, mut points, selections, rejections)) = - pending.pop() - { - if !active.insert(id) { - return Err("execution region has an internal cycle"); - } - let block = blocks.get(&id).ok_or("execution path has no block")?; - points.extend((0..=block.instructions.len()).map(|index| (id, index))); - let terminator = block - .terminator - .as_ref() - .ok_or("execution path has no exit")?; - let origin = |value| super::value_identity::path_origin(value, &definitions, &aliases); - match terminator { - T::Trap { .. } => exits.push(Exit { - block: id, - facts, - aliases, - points, - selections, - rejections, - trapped: true, - }), - T::Return { .. } | T::ReturnCall { .. } | T::ReturnCallRef { .. } => exits.push(Exit { - block: id, - facts, - aliases, - points, - selections, - rejections, - trapped: false, - }), - T::Jump { target, .. } if Some(*target) == stop => exits.push(Exit { - block: id, - facts, - aliases, - points, - selections, - rejections, - trapped: false, - }), - T::Jump { - target, arguments, .. - } => { - let successor = blocks - .get(target) - .ok_or("execution path has no successor")?; - if successor.parameters.len() != arguments.len() { - return Err("execution path has invalid incoming arguments"); - } - let bindings = successor - .parameters - .iter() - .zip(arguments) - .map(|(parameter, argument)| (*parameter, origin(*argument))) - .collect::>(); - let mut next = aliases; - next.extend(bindings); - pending.push((*target, facts, next, active, points, selections, rejections)); - } - T::Branch { - condition, - then_block, - else_block, - .. - } => { - for (target, truth) in [(*then_block, true), (*else_block, false)] { - let mut selected_values = selections.clone(); - let mut rejected_values = rejections.clone(); - if let Some((value, tag)) = - equality_selection(*condition, truth, &definitions, &aliases) - { - selected_values.push((value, tag, (id, block.instructions.len()))); - } else if let Some((value, tag)) = - equality_selection(*condition, !truth, &definitions, &aliases) - { - rejected_values.push((value, vec![tag], (id, block.instructions.len()))); - } - pending.push(( - target, - facts.clone(), - aliases.clone(), - active.clone(), - points.clone(), - selected_values, - rejected_values, - )); - } - } - T::Switch { - value, - cases, - default, - .. - } => { - let selected = match definitions.get(&origin(*value)).copied() { - Some(I::StructGet { - type_index, - field: 0, - value, - .. - }) => Some((*type_index, origin(*value))), - _ => None, - }; - for (tag, target) in cases { - let mut branch = facts.clone(); - if let Some(key) = selected { - branch.insert(key, *tag); - } - let mut selected_values = selections.clone(); - selected_values.push((origin(*value), *tag, (id, block.instructions.len()))); - pending.push(( - *target, - branch, - aliases.clone(), - active.clone(), - points.clone(), - selected_values, - rejections.clone(), - )); - } - let mut fallback = facts; - if let Some(key) = selected { - fallback.remove(&key); - } - let mut rejections = rejections; - rejections.push(( - origin(*value), - cases.iter().map(|(tag, _)| *tag).collect(), - (id, block.instructions.len()), - )); - pending.push(( - *default, fallback, aliases, active, points, selections, rejections, - )); - } - } - } - Ok(exits) -} - -/// Normal-result consumers deliberately exclude exceptional paths. Semantic -/// effect verification uses `paths` to retain all operations preceding a trap. -pub(crate) fn exits( - function: &Function, - start: BlockId, - stop: Option, -) -> Result, &'static str> { - Ok(paths(function, start, stop)? - .into_iter() - .filter(|path| !path.trapped) - .collect()) -} - -fn equality_selection( - condition: ValueId, - truth: bool, - definitions: &Definitions<'_>, - aliases: &HashMap, -) -> Option<(ValueId, i32)> { - let origin = |value| super::value_identity::path_origin(value, definitions, aliases); - let I::Primitive { - op, left, right, .. - } = definitions.get(&origin(condition)).copied()? - else { - return None; - }; - if !matches!( - (op, truth), - (crate::mir::NumericOp::I32Eq, true) | (crate::mir::NumericOp::I32Ne, false) - ) { - return None; - } - for (value, constant) in [(*left, *right), (*right, *left)] { - if let Some(constant) = - super::value_identity::integer_constant(origin(constant), definitions) - { - return Some((origin(value), constant)); - } - } - None -} diff --git a/crates/psrs-backend/src/mir/cfg.rs b/crates/psrs-backend/src/mir/cfg.rs index 66f595c4..9f9a22c9 100644 --- a/crates/psrs-backend/src/mir/cfg.rs +++ b/crates/psrs-backend/src/mir/cfg.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] //! Shared CFG edge analysis for MIR. //! //! MIR terminators carry no structuring hint: `Branch` has no `merge_block`, diff --git a/crates/psrs-backend/src/mir/control/boundary.rs b/crates/psrs-backend/src/mir/control/boundary.rs new file mode 100644 index 00000000..33bb6740 --- /dev/null +++ b/crates/psrs-backend/src/mir/control/boundary.rs @@ -0,0 +1,117 @@ +//! The MIR boundary checker: the replacement for the retired recognizers. +//! +//! It reconstructs the set of machine dispatch arms an emitted MIR function +//! performs and compares it with the checked construction plan's dispatch arms. +//! Construction owns the machine semantics ([DEC-21]); this re-checks that the +//! lowered function still dispatches exactly the planned cases. +//! +//! Terminal outcomes are deliberately not compared here. Self tail calls are +//! loopified into loop back-edges, so the plan's `Advance`/`Tail` terminals do +//! not survive as MIR `ReturnCall`s; the CC boundary checker owns terminal +//! comparison before loopification. Generic MIR verification still checks +//! types, layout, casts and CFG. + +use crate::BackendError; +use crate::cc::{Family, Shape, plan_shape_for}; +use crate::mir::value_identity::{definitions, reference_origin}; +use crate::mir::{Function, Instruction as I, Module, Terminator as T}; +use crate::types::DefinedTypeId; +use psrs_hir::SymbolId; +use std::collections::{BTreeSet, HashMap, HashSet}; + +pub(super) fn verify(module: &Module, errors: &mut Vec) { + let Some(layout) = module.layout.as_ref() else { + return; + }; + let table = layout.representation_table(); + let Some(schema) = table.control_schema() else { + return; + }; + let mut families = HashMap::new(); + for (repr, family) in [ + (schema.computation, Family::Computation), + (schema.sequence, Family::Sequence), + (schema.context, Family::Context), + (schema.extent, Family::Extent), + (schema.owner, Family::Owner), + ] { + if let Ok(index) = layout.repr_index(repr) { + families.insert(index, family); + } + } + for function in &module.functions { + let Some(expected) = plan_shape_for(function.symbol, table) else { + continue; + }; + let Some(expected_targets) = crate::cc::plan_external_targets(function.symbol, table) + else { + continue; + }; + let dispatched = arms(function, &families) == flatten(&expected); + // Non-self tail calls survive loopification as `ReturnCall`s; self tail + // calls become loop back-edges and are excluded from the plan targets. + let terminated = external_targets(function) == expected_targets; + if !dispatched || !terminated { + errors.push(BackendError::invalid_ir( + "P9 MIR verification", + function.span, + "emitted machine dispatch or outcome disagrees with the checked plan", + )); + } + } +} + +fn flatten(shape: &Shape) -> BTreeSet<(Family, u32)> { + let mut set = BTreeSet::new(); + collect(shape, &mut set); + set +} + +fn collect(shape: &Shape, set: &mut BTreeSet<(Family, u32)>) { + if let Shape::Switch(family, arms) = shape { + for (tag, arm) in arms { + set.insert((*family, *tag)); + collect(arm, set); + } + } +} + +/// The non-self `ReturnCall` targets in this function. +fn external_targets(function: &Function) -> HashSet { + function + .blocks + .iter() + .filter_map(|block| match &block.terminator { + Some(T::ReturnCall { + function: target, .. + }) if *target != function.symbol => Some(*target), + _ => None, + }) + .collect() +} + +/// The machine dispatch arms reachable in this function, across all blocks. +fn arms(function: &Function, families: &HashMap) -> BTreeSet<(Family, u32)> { + let definitions = definitions(function); + let mut set = BTreeSet::new(); + for block in &function.blocks { + let Some(T::Switch { value, cases, .. }) = &block.terminator else { + continue; + }; + let selector = reference_origin(*value, &definitions); + let Some(I::StructGet { + type_index, + field: 0, + .. + }) = definitions.get(&selector).copied() + else { + continue; + }; + if let Some(family) = families.get(type_index) { + for (tag, _) in cases { + set.insert((*family, *tag as u32)); + } + } + } + set +} diff --git a/crates/psrs-backend/src/mir/control/checkpoints.rs b/crates/psrs-backend/src/mir/control/checkpoints.rs deleted file mode 100644 index f41da4e7..00000000 --- a/crates/psrs-backend/src/mir/control/checkpoints.rs +++ /dev/null @@ -1,298 +0,0 @@ -//! Preserve checkpoint ownership after physical projection and loop conversion. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::{ - CaptureProjection, checkpoint_capture_relation, dispatch_checkpoint_relation, -}; -use crate::mir::{Function, Instruction as I, Module}; -use crate::types::{DefinedTypeId, ValueId}; -use std::collections::HashMap; - -use crate::mir::value_identity::{ - Definitions, definitions, loop_parameters, reference_origin as origin, -}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let Some(raw) = &table.control_resumption else { - return; - }; - let Some(executor) = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - else { - return; - }; - if !module - .functions - .iter() - .any(|function| function.symbol == raw.function() || function.symbol == executor.function()) - { - return; - } - let Some(schema) = table.control_checkpoint_schema() else { - errors.push(BackendError::invalid_ir( - "P9 MIR control checkpoint", - module.span, - "raw resumption has no checkpoint schema", - )); - return; - }; - let types = ( - layout.variant_index(schema.computation, 3), - layout.variant_index(schema.context, 0), - layout.variant_index(schema.context, 1), - layout.signature_index(raw.signature()), - table - .control_sequence() - .and_then(|sequence| layout.variant_index(sequence, 0).ok()), - ); - let (Ok(resume), Ok(root), Ok(scope), Ok(callable), Some(empty)) = types else { - errors.push(BackendError::invalid_ir( - "P9 MIR control checkpoint", - module.span, - "raw resumption schema has no physical layout", - )); - return; - }; - for function in &module.functions { - if let Err(message) = verify_function( - function, - table, - raw, - executor.function(), - resume, - root, - scope, - callable, - empty, - ) { - errors.push( - BackendError::invalid_ir("P9 MIR control checkpoint", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} - -#[allow(clippy::too_many_arguments)] -fn verify_function( - function: &Function, - table: &crate::cc::RepresentationTable, - raw: &crate::cc::ControlResumptionContract, - executor: psrs_hir::SymbolId, - resume: DefinedTypeId, - root: DefinedTypeId, - scope: DefinedTypeId, - callable: DefinedTypeId, - empty: DefinedTypeId, -) -> Result<(), &'static str> { - let definitions = definitions(function); - let origin = |value| origin(value, &definitions); - let dominators = crate::mir::cfg::dominators(function); - let parameters = loop_parameters(function); - if function.symbol == executor && parameters.len() != 6 { - return Err("control executor has an invalid parameter contract"); - } - if function.symbol == raw.function() { - if parameters.len() != 2 { - return Err("raw resumption has an invalid parameter contract"); - } - let result = origin(function.result); - let Some(I::StructNew { - type_index, - arguments, - .. - }) = definitions.get(&result).copied() - else { - return Err("raw resumption must return its saved Resume frame"); - }; - if *type_index != resume - || arguments.len() != 4 - || origin(arguments[1]) != parameters[1] - || !matches!( - definitions.get(&origin(arguments[0])).copied(), - Some(I::Constant { value: 3, .. }) - ) - { - return Err("raw resumption frame has an invalid answer or schema"); - } - checkpoint_capture_relation( - parameters[0], - capture(arguments[2], &definitions), - capture(arguments[3], &definitions), - )?; - let point = function - .blocks - .iter() - .find_map(|block| { - block - .instructions - .iter() - .position(|instruction| instruction.destination() == Some(result)) - .map(|index| (block.id, index)) - }) - .ok_or("raw resumption frame has no checked construction sequence")?; - require_check( - function, - table, - point, - origin(arguments[3]), - &definitions, - &dominators, - )?; - } - for block in &function.blocks { - for (index, instruction) in block.instructions.iter().enumerate() { - match instruction { - I::ClosureNew { - function: target, - captures, - type_index, - .. - } if *target == raw.function() => { - if function.symbol != executor - || parameters.len() != 6 - || captures.len() != 2 - || *type_index != callable - || origin(captures[0]) != parameters[3] - { - return Err( - "raw resumption factory must capture the executor's current queue", - ); - } - let projection = match definitions.get(&origin(captures[1])).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *field > 0 && (*type_index == root || *type_index == scope) => { - Some((origin(*value), u32::from(*type_index == scope), field - 1)) - } - _ => None, - }; - dispatch_checkpoint_relation(parameters[5], projection)?; - } - I::Call { - contract: Some(contract), - arguments, - .. - } if function.symbol == executor - && table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::CloneSequence) => - { - if arguments.len() != 5 || origin(arguments[3]) != parameters[4] { - return Err("replay must start with its current execution extent"); - } - for initial in &arguments[1..3] { - if !matches!(definitions.get(&origin(*initial)).copied(), Some(I::StructNew { type_index, arguments, .. }) - if *type_index == empty && arguments.len() == 1 - && matches!(definitions.get(&origin(arguments[0])).copied(), Some(I::Constant { value: 0, .. }))) - { - return Err("replay must start with empty traversal accumulators"); - } - } - let parents = - crate::mir::value_identity::incoming_values(function, origin(arguments[4])) - .ok_or("replay parent must select its current dispatch context")?; - let mut seen = std::collections::HashSet::new(); - for parent in parents { - let projection = match definitions.get(&origin(parent)).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *field > 0 && (*type_index == root || *type_index == scope) => { - let case = u32::from(*type_index == scope); - seen.insert(case); - Some((origin(*value), case, field - 1)) - } - _ => None, - }; - dispatch_checkpoint_relation(parameters[5], projection)?; - } - if seen != std::collections::HashSet::from([0, 1]) { - return Err("replay parent must cover root and scoped dispatch contexts"); - } - let saved = arguments.first().ok_or("replay has no saved queue")?; - let Some(I::StructGet { - type_index, - field: 2, - value, - .. - }) = definitions.get(&origin(*saved)).copied() - else { - return Err("replay must use the Resume frame's saved queue"); - }; - if *type_index != resume || origin(*value) != parameters[2] { - return Err("replay must use the current Resume frame"); - } - let checkpoint = definitions - .iter() - .find_map(|(destination, instruction)| match instruction { - I::StructGet { - type_index, - field: 3, - value: owner, - .. - } if *type_index == resume && origin(*owner) == origin(*value) => { - Some(origin(*destination)) - } - _ => None, - }) - .ok_or("replay has no current Resume checkpoint")?; - require_check( - function, - table, - (block.id, index), - checkpoint, - &definitions, - &dominators, - )?; - } - _ => {} - } - } - } - Ok(()) -} - -fn capture(value: ValueId, definitions: &Definitions<'_>) -> Option { - match definitions.get(&origin(value, definitions)).copied()? { - I::ClosureGetCapture { closure, index, .. } => Some(CaptureProjection { - receiver: origin(*closure, definitions), - slot: *index, - }), - _ => None, - } -} - -fn require_check( - function: &Function, - table: &crate::cc::RepresentationTable, - point: (crate::mir::BlockId, usize), - checkpoint: ValueId, - definitions: &Definitions<'_>, - dominators: &HashMap>, -) -> Result<(), &'static str> { - let checked = function.blocks.iter().any(|block| { - let prefix = if block.id == point.0 { &block.instructions[..point.1] } - else if dominators.get(&point.0).is_some_and(|set| set.contains(&block.id)) { block.instructions.as_slice() } - else { return false }; - prefix.iter().any(|instruction| matches!(instruction, - I::Call { contract: Some(contract), arguments, .. } - if table.control_helpers.get(contract.0 as usize).is_some_and(|helper| helper.role() == R::Check) - && arguments.len() == 1 && origin(arguments[0], definitions) == checkpoint)) - }); - if checked { - Ok(()) - } else { - Err("resumption must check its saved checkpoint before construction or replay") - } -} diff --git a/crates/psrs-backend/src/mir/control/clauses.rs b/crates/psrs-backend/src/mir/control/clauses.rs deleted file mode 100644 index 181a1382..00000000 --- a/crates/psrs-backend/src/mir/control/clauses.rs +++ /dev/null @@ -1,349 +0,0 @@ -//! A source return or operation applies its own scoped clause in MIR. -//! -//! The executor's input dispatch selects a source step; within that step's arm, -//! every call of the current scoped context's clause must be the clause that step -//! owns. The scoped exit must consume the complete application result and its -//! calls must dominate that exit. Checks use real CFG identities and edges. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::{ - ClauseKind, FinishProjection, clause_operand_relation, clause_selection_relation, -}; -use crate::mir::value_identity::{ - definitions, loop_header, loop_parameters, precedes, reference_origin, step_definitions, -}; -use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::DefinedTypeId; -use std::collections::{HashSet, VecDeque}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { - return; - }; - let table = layout.representation_table(); - let Some(helper) = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - else { - return; - }; - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == helper.function()) - else { - return; - }; - let result = (|| { - let schema = table - .control_checkpoint_schema() - .ok_or("clause selection has no checked schema")?; - let scoped = layout - .variant_index(schema.context, 1) - .map_err(|_| "clause selection has no scoped case")?; - let computation = layout - .repr_index(schema.computation) - .map_err(|_| "clause selection has no computation base")?; - let context_base = layout - .repr_index(schema.context) - .map_err(|_| "clause selection has no context base")?; - let payloads = [0, 1].map(|tag| layout.variant_index(schema.computation, tag).ok()); - let payloads = payloads[0] - .zip(payloads[1]) - .ok_or("clause selection has no source payload cases")?; - let context = loop_parameters(function) - .get(5) - .copied() - .ok_or("clause selection has an invalid executor contract")?; - verify_function( - function, - scoped, - computation, - context, - context_base, - payloads, - table - .control_resumption - .as_ref() - .ok_or("clause selection has no raw resumption contract")? - .function(), - ) - })(); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR clause selection", function.span, message) - .with_module(function.symbol.module), - ); - } -} - -fn verify_function( - function: &Function, - scoped: DefinedTypeId, - computation: DefinedTypeId, - context: crate::types::ValueId, - context_base: DefinedTypeId, - payloads: (DefinedTypeId, DefinedTypeId), - raw: psrs_hir::SymbolId, -) -> Result<(), &'static str> { - let definitions = definitions(function); - let origin = |value| reference_origin(value, &definitions); - let Some((dispatch, cases)) = - function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Switch { value, cases, .. }) - if crate::mir::branch_facts::tag_source(*value, &definitions) - .is_some_and(|(base, _)| base == computation) => - { - Some((block.id, cases)) - } - _ => None, - }) - else { - return Ok(()); - }; - for kind in [ClauseKind::Return, ClauseKind::Operation] { - let Some(target) = cases - .iter() - .find(|(tag, _)| *tag == kind.source_tag()) - .map(|(_, block)| *block) - else { - continue; - }; - let mut seen = HashSet::new(); - let mut pending = VecDeque::from([target]); - let mut steps = 0; - while let Some(id) = pending.pop_front() { - if id == dispatch || !seen.insert(id) { - continue; - } - let Some(block) = function.blocks.iter().find(|block| block.id == id) else { - continue; - }; - for instruction in &block.instructions { - let I::ClosureCall { - function: callee, .. - } = instruction - else { - continue; - }; - let Some(I::StructGet { - type_index, - field, - value, - .. - }) = definitions.get(&origin(*callee)).copied() - else { - continue; - }; - if *type_index != scoped { - continue; - } - let Some(field) = field.checked_sub(1) else { - continue; - }; - clause_selection_relation( - kind, - origin(context), - Some(FinishProjection { - owner: origin(*value), - field, - }), - )?; - } - if let Some(terminator) = &block.terminator { - if let T::Switch { value, cases, .. } = terminator - && crate::mir::branch_facts::tag_source(*value, &definitions) - == Some((context_base, origin(context))) - { - let scoped_target = cases - .iter() - .find(|(tag, _)| *tag == 1) - .map(|(_, target)| *target) - .ok_or("source step has no scoped clause path")?; - verify_step( - function, - scoped_target, - kind, - scoped, - if kind == ClauseKind::Return { - payloads.0 - } else { - payloads.1 - }, - raw, - )?; - steps += 1; - } - for successor in crate::mir::cfg::successors(terminator) { - if successor != dispatch { - pending.push_back(successor); - } - } - } - } - if steps == 0 { - return Err("source step has no scoped clause path"); - } - } - Ok(()) -} - -fn verify_step( - function: &Function, - start: crate::mir::BlockId, - kind: ClauseKind, - scoped: DefinedTypeId, - payload_type: DefinedTypeId, - raw: psrs_hir::SymbolId, -) -> Result<(), &'static str> { - let definitions = step_definitions(function, start); - let origin = |value| reference_origin(value, &definitions); - let parameters = loop_parameters(function); - let dominators = crate::mir::cfg::dominators_from(function, start, loop_header(function)); - let points = function - .blocks - .iter() - .flat_map(|block| { - block - .instructions - .iter() - .enumerate() - .filter_map(move |(index, i)| { - i.destination().map(|value| (value, (block.id, index))) - }) - }) - .collect::>(); - let mut pending = VecDeque::from([start]); - let mut seen = HashSet::new(); - let mut transitions = 0; - while let Some(id) = pending.pop_front() { - if !seen.insert(id) { - continue; - } - let block = function - .blocks - .iter() - .find(|block| block.id == id) - .ok_or("source clause path has no block")?; - // Only an actual exit establishes a transition. An earlier call whose - // result is discarded cannot discharge the scoped step obligation. - let transition = match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == loop_header(function) => { - Some((block.instructions.len(), arguments.as_slice())) - } - Some(T::ReturnCall { - function: callee, - arguments, - .. - }) if *callee == function.symbol => { - Some((block.instructions.len(), arguments.as_slice())) - } - Some(T::Return { value, .. }) => { - match definitions.get(&origin(*value)).copied() { - Some(I::Call { - function: callee, - arguments, - .. - }) if *callee == function.symbol => { - let point = points - .get(&origin(*value)) - .copied() - .ok_or("source clause transition has no execution point")?; - if !precedes(point, (id, block.instructions.len()), &dominators) { - return Err("source clause transition must dominate its actual exit"); - } - // Use the call's point for application dominance below. - Some((point.1, arguments.as_slice())) - } - _ => None, - } - } - _ => None, - }; - if let Some((index, arguments)) = transition { - if arguments.len() != 6 { - return Err("source clause result must enter the next executor step"); - } - if origin(arguments[0]) != origin(parameters[0]) - || origin(arguments[1]) != origin(parameters[1]) - { - return Err("source clause transition must preserve its state and root handler"); - } - let mut result = origin(arguments[2]); - let mut consumer = match &block.terminator { - Some(T::Return { value, .. }) => points[&origin(*value)], - _ => (id, index), - }; - let mut payload = None; - let mut resumption = None; - for _ in 0..(if kind == ClauseKind::Return { 1 } else { 2 }) { - let Some(I::ClosureCall { - function: callee, - arguments, - .. - }) = definitions.get(&result).copied() - else { - return Err("source clause result must enter the next executor step"); - }; - let point = points - .get(&result) - .copied() - .ok_or("source clause application has no execution point")?; - if arguments.len() != 1 - || !precedes(point, consumer, &dominators) - || !dominators - .get(&point.0) - .is_some_and(|set| set.contains(&start)) - { - return Err("source clause application must execute in its scoped step"); - } - payload = Some(origin(arguments[0])); - resumption.get_or_insert(origin(arguments[0])); - result = origin(*callee); - consumer = point; - } - let projection = |value, ty| match definitions.get(&value).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *type_index == ty && *field > 0 => Some(FinishProjection { - owner: origin(*value), - field: field - 1, - }), - _ => None, - }; - clause_selection_relation(kind, origin(parameters[5]), projection(result, scoped))?; - clause_operand_relation( - origin(parameters[2]), - projection(payload.unwrap(), payload_type), - )?; - if kind == ClauseKind::Operation - && !matches!(definitions.get(&resumption.unwrap()).copied(), Some(I::ClosureNew { function: target, .. }) if *target == raw) - { - return Err("source operation clause must receive its raw resumption"); - } - transitions += 1; - continue; - } - match &block.terminator { - Some(T::Trap { .. }) => {} - Some(T::Return { .. } | T::ReturnCall { .. } | T::ReturnCallRef { .. }) => { - return Err("source clause result must enter the next executor step"); - } - Some(terminator) => pending.extend(crate::mir::cfg::successors(terminator)), - None => return Err("source clause path has no exit"), - } - } - if transitions == 0 { - return Err("source clause result must enter the next executor step"); - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/control/context_entry.rs b/crates/psrs-backend/src/mir/control/context_entry.rs deleted file mode 100644 index 3bbc4106..00000000 --- a/crates/psrs-backend/src/mir/control/context_entry.rs +++ /dev/null @@ -1,242 +0,0 @@ -//! Check source Handle entry over physical fields and executor loop transitions. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::{ - FinishProjection, context_clause_relation, context_tail_relation, -}; -use crate::mir::value_identity::{ - definitions, fresh_iteration_allocation, loop_header, loop_parameters, reference_origin, -}; -use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::DefinedTypeId; -use std::collections::HashMap; - -struct Schema { - context: DefinedTypeId, - handle: DefinedTypeId, - finish: DefinedTypeId, - empty: DefinedTypeId, - boundary: DefinedTypeId, - status: DefinedTypeId, -} - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let Some(executor) = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - else { - return; - }; - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == executor.function()) - else { - return; - }; - let schema = table - .control_checkpoint_schema() - .zip(table.control_replay_schema()) - .and_then(|(checkpoint, replay)| { - Some(Schema { - context: layout.variant_index(checkpoint.context, 1).ok()?, - handle: layout.variant_index(checkpoint.computation, 4).ok()?, - finish: layout.variant_index(replay.sequence, 3).ok()?, - empty: layout.variant_index(replay.sequence, 0).ok()?, - boundary: layout.variant_index(replay.boundary, 1).ok()?, - status: layout.repr_index(replay.status).ok()?, - }) - }); - let result = schema - .ok_or("source context has no physical schema") - .and_then(|schema| verify_function(function, &schema)); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR context entry", function.span, message) - .with_module(function.symbol.module), - ); - } -} - -fn verify_function(function: &Function, schema: &Schema) -> Result<(), &'static str> { - let parameters = loop_parameters(function); - if parameters.len() != 6 { - return Err("source context has an invalid executor contract"); - } - let definitions = definitions(function); - let origin = |value| reference_origin(value, &definitions); - let constant = |value, expected| { - matches!(definitions.get(&origin(value)).copied(), - Some(I::Constant { value, .. }) if *value == expected) - }; - let projection = |value, expected| match definitions.get(&origin(value)).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *type_index == expected && *field > 0 => Some(FinishProjection { - owner: origin(*value), - field: field - 1, - }), - _ => None, - }; - let points = function - .blocks - .iter() - .flat_map(|block| { - block - .instructions - .iter() - .enumerate() - .filter_map(move |(index, instruction)| { - instruction - .destination() - .map(|value| (value, (block.id, index))) - }) - }) - .collect::>(); - let dominators = crate::mir::cfg::dominators(function); - for block in &function.blocks { - for (index, instruction) in block.instructions.iter().enumerate() { - let I::StructNew { - type_index, - arguments, - destination, - .. - } = instruction - else { - continue; - }; - if *type_index != schema.context { - continue; - } - if arguments.len() != 7 || !constant(arguments[0], 1) { - return Err("source context has an invalid frame schema"); - } - let fields = &arguments[1..]; - context_clause_relation( - parameters[2], - projection(fields[0], schema.handle), - projection(fields[1], schema.handle), - )?; - if origin(fields[4]) != parameters[5] { - return Err("source context must retain its current caller context"); - } - if projection(fields[5], schema.finish).is_some() { - context_tail_relation( - parameters[3], - projection(fields[2], schema.finish), - projection(fields[3], schema.finish), - projection(fields[5], schema.finish), - )?; - } else { - if origin(fields[2]) != parameters[3] || origin(fields[3]) != parameters[4] { - return Err("source context must save its current queue and execution parent"); - } - let extent = origin(fields[5]); - let Some(I::StructNew { - type_index, - arguments: activation, - .. - }) = definitions.get(&extent).copied() - else { - return Err("source context must allocate a fresh child extent"); - }; - if *type_index != schema.boundary - || activation.len() != 3 - || !constant(activation[0], 1) - || origin(activation[2]) != parameters[4] - { - return Err("source context extent must retain its current execution parent"); - } - let status = origin(activation[1]); - let initialized = match definitions.get(&status).copied() { - Some(I::ArrayNew { - type_index, - elements, - .. - }) => { - *type_index == schema.status - && elements.len() == 1 - && constant(elements[0], 0) - } - Some(I::ArrayNewFilled { - type_index, - length, - value, - .. - }) => { - *type_index == schema.status && constant(*length, 1) && constant(*value, 0) - } - _ => false, - }; - if !initialized - || !fresh_iteration_allocation( - function, - status, - (block.id, index), - &points, - &dominators, - ) - || !fresh_iteration_allocation( - function, - extent, - (block.id, index), - &points, - &dominators, - ) - { - return Err( - "source context extent needs a fresh live status cell in its iteration", - ); - } - } - let next = block.instructions[index + 1..] - .iter() - .find_map(|instruction| match instruction { - I::Call { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .or_else(|| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == loop_header(function) => Some(arguments.as_slice()), - Some(T::ReturnCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .ok_or("source context has no executor transition")?; - let empty = matches!(next.get(3).and_then(|value| definitions.get(&origin(*value))).copied(), - Some(I::StructNew { type_index, arguments, .. }) - if *type_index == schema.empty && arguments.len() == 1 && constant(arguments[0], 0)); - if next.len() != 6 - || origin(next[0]) != parameters[0] - || origin(next[1]) != parameters[1] - || projection(next[2], schema.handle) - != Some(FinishProjection { - owner: parameters[2], - field: 2, - }) - || !empty - || origin(next[4]) != origin(fields[5]) - || origin(next[5]) != *destination - { - return Err( - "source context transition must enter its Handle body with an empty queue and its own extent", - ); - } - } - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/control/contracts.rs b/crates/psrs-backend/src/mir/control/contracts.rs index 37aee1b9..02615c03 100644 --- a/crates/psrs-backend/src/mir/control/contracts.rs +++ b/crates/psrs-backend/src/mir/control/contracts.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] use crate::BackendError; use crate::mir::{Instruction, Module}; diff --git a/crates/psrs-backend/src/mir/control/dispatch.rs b/crates/psrs-backend/src/mir/control/dispatch.rs deleted file mode 100644 index 04fe847a..00000000 --- a/crates/psrs-backend/src/mir/control/dispatch.rs +++ /dev/null @@ -1,252 +0,0 @@ -//! Recheck dispatch coverage and selected variant projections over real CFG edges. -use crate::BackendError; -use crate::cc::{ControlHelperRole as R, ReprId}; -use crate::control::dispatch::Carrier; -use crate::mir::branch_facts::{compute, tag_source}; -use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; -use crate::mir::{BlockId, Function, Instruction as I, Module, Terminator as T}; -use crate::types::DefinedTypeId; -use std::collections::{HashMap, HashSet}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { - return; - }; - let table = layout.representation_table(); - for helper in &table.control_helpers { - let role = helper.role(); - if !matches!(role, R::Executor | R::CloneSequence | R::RebuildSequence) { - continue; - } - let Some(function) = module - .functions - .iter() - .find(|f| f.symbol == helper.function()) - else { - continue; - }; - let result = (|| { - let schema = table - .control_checkpoint_schema() - .ok_or("control dispatch has no checked schema")?; - let queue = table - .control_sequence() - .ok_or("control dispatch has no checked queue schema")?; - let carriers = [ - (schema.computation, Carrier::Computation), - (schema.context, Carrier::Context), - ( - queue, - if role == R::RebuildSequence { - Carrier::Reverse - } else { - Carrier::Queue - }, - ), - ]; - let mut bases = HashMap::new(); - let mut cases = HashMap::new(); - for (repr, carrier) in carriers { - let base = layout - .repr_index(repr) - .map_err(|_| "control dispatch has no physical base")?; - immutable_tag(module, base)?; - bases.insert(base, carrier); - let Some(crate::cc::Representation::Variant { cases: variants }) = - table.representation(repr) - else { - return Err("control dispatch has no variant schema"); - }; - for variant in variants { - let tag = variant.tag; - let case = layout - .variant_index(repr, tag) - .map_err(|_| "control dispatch has no physical case")?; - immutable_tag(module, case)?; - cases.insert(case, (base, tag as i32)); - } - } - let repr: ReprId = if role == R::Executor { - schema.computation - } else { - queue - }; - let entry_type = layout - .repr_index(repr) - .map_err(|_| "control dispatch has no physical input")?; - verify_function(function, role, entry_type, &bases, &cases) - })(); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR control dispatch", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} - -fn verify_function( - function: &Function, - role: R, - entry_type: DefinedTypeId, - bases: &HashMap, - cases: &HashMap, -) -> Result<(), &'static str> { - let definitions = definitions(function); - let origin = |v| reference_origin(v, &definitions); - let parameters = loop_parameters(function); - let index = if role == R::Executor { 2 } else { 0 }; - let input = parameters - .get(index) - .copied() - .ok_or("control dispatch has an invalid parameter contract")?; - let states = compute(function); - let loop_header = loop_header(function); - let header = loop_header.unwrap_or(function.entry); - // The entry block is the loop preheader only when `loop_header` recognizes - // its initialization jump. That single edge starts the first iteration and - // is not a completed iteration, so it does not require the dispatch to - // dominate it; every other jump to the header is a real backedge. - let preheader = loop_header.map(|_| function.entry); - let dominators = crate::mir::cfg::dominators(function); - let mut dispatches = Vec::new(); - for block in &function.blocks { - let Some(facts) = states.get(&block.id) else { - continue; - }; - for instruction in &block.instructions { - if let I::StructGet { - type_index, - field, - value, - .. - } = instruction - && *field > 0 - && let Some((base, tag)) = cases.get(type_index) - { - let owner = origin(*value); - let known = match definitions.get(&owner).copied() { - Some(I::StructNew { - type_index: actual, - arguments, - .. - }) if actual == type_index => arguments.first().and_then(|v| match definitions - .get(&origin(*v)) - .copied() - { - Some(I::Constant { value, .. }) => Some(*value), - _ => None, - }), - _ => facts.get(&(*base, owner)).copied(), - }; - if known.is_some_and(|known| known != *tag) { - return Err( - "control projection must match the selected case of its actual input", - ); - } - } - } - if let Some(T::Switch { - value, - cases, - default, - .. - }) = &block.terminator - && let Some((base, owner)) = tag_source(*value, &definitions) - && let Some(carrier) = bases.get(&base) - { - carrier.verify(cases.iter().map(|(tag, _)| *tag))?; - if !must_trap(function, *default, &mut HashSet::new()) { - return Err("control dispatch must trap on unsupported alternatives"); - } - if base == entry_type { - if role == R::Executor && owner != origin(input) { - return Err("control dispatch must select the current helper input"); - } - // The selected input dispatch is reached on every iteration, - // before any branch's executor work can become observable. - if owner == origin(input) - && dominators - .get(&block.id) - .is_some_and(|d| d.contains(&header)) - { - dispatches.push(block.id); - } - } - } - } - if !dispatches.into_iter().any(|dispatch| { - function - .blocks - .iter() - .filter(|b| states.contains_key(&b.id)) - .all(|block| { - let invokes = block - .instructions - .iter() - .any(crate::mir::effects::may_invoke); - let finishes = matches!( - &block.terminator, - Some(T::Return { .. } | T::ReturnCall { .. } | T::ReturnCallRef { .. }) - ) || matches!(&block.terminator, Some(T::Jump { target, .. }) - if *target == header && Some(block.id) != preheader); - if !invokes && !finishes { - return true; - } - // A terminator dispatch follows this block's instructions, so it - // cannot justify a call earlier in the same block. - (!invokes || block.id != dispatch) - && dominators - .get(&block.id) - .is_some_and(|d| d.contains(&dispatch)) - }) - }) { - return Err("control input dispatch must dominate execution and normal transitions"); - } - Ok(()) -} - -fn immutable_tag(module: &Module, id: DefinedTypeId) -> Result<(), &'static str> { - let definition = module - .types - .iter() - .flat_map(|group| &group.0) - .nth(id.0 as usize); - if !matches!(definition.map(|d| &d.composite), - Some(crate::types::CompositeType::Struct(fields)) if fields.first() == Some(&crate::types::FieldType { - storage: crate::types::StorageType::I32, mutable: false, - })) { - return Err("control dispatch requires an immutable i32 tag field"); - } - Ok(()) -} - -fn must_trap(function: &Function, id: BlockId, active: &mut HashSet) -> bool { - if !active.insert(id) { - return false; - } - let result = function - .blocks - .iter() - .find(|b| b.id == id) - .is_some_and(|block| { - if block - .instructions - .iter() - .any(|i| matches!(i, I::Unreachable { .. })) - { - return true; - } - match &block.terminator { - Some(T::Trap { .. }) => true, - Some(t @ (T::Jump { .. } | T::Branch { .. } | T::Switch { .. })) => { - crate::mir::cfg::successors(t) - .iter() - .all(|id| must_trap(function, *id, active)) - } - _ => false, - } - }); - active.remove(&id); - result -} diff --git a/crates/psrs-backend/src/mir/control/execution.rs b/crates/psrs-backend/src/mir/control/execution.rs deleted file mode 100644 index 39e86270..00000000 --- a/crates/psrs-backend/src/mir/control/execution.rs +++ /dev/null @@ -1,323 +0,0 @@ -//! Discharge physical CFG exits into the shared root and persistent queue rules. -use crate::BackendError; -use crate::cc::{ControlHelperRole as R, ReprId}; -use crate::control::execution::{self, ActionRegistry, Operands, Schema}; -use crate::mir::layout::PlannedLayout; -use crate::mir::value_identity::{ - Definitions, definitions, loop_header, loop_parameters, path_origin, -}; -use crate::mir::{Instruction as I, Module, Terminator as T}; -use crate::types::ValueId; -use std::collections::HashMap; - -pub(super) struct View<'a> { - pub(super) definitions: &'a Definitions<'a>, - pub(super) layout: &'a PlannedLayout, - pub(super) aliases: &'a HashMap, - pub(super) raw: psrs_hir::SymbolId, -} - -impl Operands for View<'_> { - fn inputs(&self, value: ValueId) -> Vec { - match self.definitions.get(&self.origin(value)).copied() { - Some(I::StructNew { arguments, .. } | I::Call { arguments, .. }) => arguments.clone(), - Some(I::ArrayNew { elements, .. }) => elements.clone(), - Some(I::ClosureNew { captures, .. }) => captures.clone(), - Some(I::ClosureCall { - function, - arguments, - .. - }) => std::iter::once(*function) - .chain(arguments.iter().copied()) - .collect(), - Some(I::StructGet { value, .. } | I::ArrayLen { value, .. }) => vec![*value], - Some(I::ArrayNewFilled { length, value, .. }) => vec![*length, *value], - Some(I::ArrayGet { value, index, .. }) => vec![*value, *index], - _ => Vec::new(), - } - } - fn tag(&self, value: ValueId) -> Option<(ReprId, ValueId)> { - let I::StructGet { - type_index, - field: 0, - value, - .. - } = self.definitions.get(&self.origin(value)).copied()? - else { - return None; - }; - self.layout - .representation_table() - .representations - .iter() - .enumerate() - .find_map(|(index, repr)| { - let repr_id = ReprId(index as u32); - (matches!(repr, crate::cc::Representation::Variant { .. }) - && self.layout.repr_index(repr_id).ok() == Some(*type_index)) - .then_some((repr_id, self.origin(*value))) - }) - } - fn origin(&self, value: ValueId) -> ValueId { - path_origin(value, self.definitions, self.aliases) - } - fn projection( - &self, - value: ValueId, - repr: ReprId, - case: Option, - ) -> Option<(ValueId, u32)> { - let expected = match case { - Some(tag) => self.layout.variant_index(repr, tag), - None => self.layout.repr_index(repr), - } - .ok()?; - match self.definitions.get(&self.origin(value)).copied()? { - I::StructGet { - type_index, - field, - value, - .. - } if *type_index == expected => { - let field = if case.is_some() { - field.checked_sub(1)? - } else { - *field - }; - Some((self.origin(*value), field)) - } - _ => None, - } - } - fn node(&self, value: ValueId, repr: ReprId, case: Option) -> Option> { - let expected = match case { - Some(tag) => self.layout.variant_index(repr, tag), - None => self.layout.repr_index(repr), - } - .ok()?; - match self.definitions.get(&self.origin(value)).copied()? { - I::StructNew { - type_index, - arguments, - .. - } if *type_index == expected => { - Some(arguments.get(usize::from(case.is_some())..)?.to_vec()) - } - _ => None, - } - } - fn application(&self, value: ValueId) -> Option<(ValueId, Vec)> { - match self.definitions.get(&self.origin(value)).copied()? { - I::ClosureCall { - function, - arguments, - .. - } => Some((*function, arguments.clone())), - _ => None, - } - } - fn raw_resumption(&self, value: ValueId) -> bool { - matches!(self.definitions.get(&self.origin(value)).copied(), Some(I::ClosureNew { function, .. }) if *function == self.raw) - } -} - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let total = crate::mir::effects::total_functions(module); - for helper in &table.control_helpers { - if helper.role() != R::Executor { - continue; - } - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == helper.function()) - else { - continue; - }; - let result = (|| { - super::traces::entry(function, layout)?; - let schema = Schema::checked(table)?; - let raw = table - .control_resumption - .as_ref() - .ok_or("execution has no raw resumption contract")? - .function(); - let definitions = definitions(function); - let header = loop_header(function); - let exits = crate::mir::branch_facts::paths( - function, - header.unwrap_or(function.entry), - header, - )?; - let carriers = [schema.computation, schema.queue, schema.context] - .into_iter() - .map(|repr| layout.repr_index(repr).map(|index| (index, repr))) - .collect::, _>>() - .map_err(|_| "execution has no planned physical carrier")?; - let normal = exits - .iter() - .filter(|path| !path.trapped) - .map(|path| super::traces::events(function, layout, path)) - .collect::, _>>()?; - let allowed = crate::control::events::carriers(table)?; - let status = table - .control_replay_schema() - .ok_or("execution has no status schema")? - .status; - let mut coverage = ActionRegistry::default(); - for exit in exits { - let view = View { - definitions: &definitions, - layout, - aliases: &exit.aliases, - raw, - }; - let observed = super::traces::events(function, layout, &exit)?; - if exit.trapped { - crate::control::events::exceptional( - &view, &observed, &normal, &allowed, status, - )?; - continue; - } - let facts = exit - .facts - .iter() - .filter_map(|((index, value), tag)| { - carriers - .get(index) - .map(|repr| ((*repr, view.origin(*value)), *tag)) - }) - .collect(); - let block = function - .blocks - .iter() - .find(|block| block.id == exit.block) - .ok_or("execution exit has no block")?; - match block - .terminator - .as_ref() - .ok_or("execution path has no exit")? - { - T::Jump { arguments, .. } - | T::ReturnCall { - function: _, - arguments, - .. - } => { - if matches!(block.terminator, Some(T::ReturnCall { function: target, .. }) if target != function.symbol) - { - return Err("execution must transition to its own executor"); - } - execution::transition( - &schema, - &view, - &facts, - loop_parameters(function), - arguments, - )?; - } - T::Return { value, .. } => match definitions.get(&view.origin(*value)).copied() - { - Some(I::Call { - function: target, - arguments, - .. - }) if *target == function.symbol => execution::transition( - &schema, - &view, - &facts, - loop_parameters(function), - arguments, - )?, - _ => execution::publish( - &schema, - &view, - &facts, - loop_parameters(function), - *value, - )?, - }, - _ => return Err("execution exit must return or transition to its executor"), - } - let next = match block - .terminator - .as_ref() - .ok_or("execution path has no exit")? - { - T::Jump { arguments, .. } | T::ReturnCall { arguments, .. } => { - Some(arguments.as_slice()) - } - T::Return { value, .. } => match definitions.get(&view.origin(*value)).copied() - { - Some(I::Call { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }, - _ => None, - }; - execution::effects( - &schema, - &view, - &facts, - loop_parameters(function), - next, - &observed, - &total, - )?; - let result = match block.terminator.as_ref() { - Some(T::Return { value, .. }) => vec![*value], - _ => Vec::new(), - }; - crate::control::events::allocations(&view, next.unwrap_or(&result), &observed)?; - coverage.observe(&schema, &view, &facts, loop_parameters(function)); - } - coverage.finish() - })(); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR root and queue execution", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} - -impl crate::control::owned::OwnedOperands for View<'_> { - fn integer(&self, value: ValueId) -> Option { - crate::mir::value_identity::integer_constant(self.origin(value), self.definitions) - } - fn initial(&self, cell: ValueId, repr: ReprId) -> Option { - let expected = self.layout.repr_index(repr).ok()?; - match self.definitions.get(&self.origin(cell)).copied()? { - I::ArrayNew { - type_index, - elements, - .. - } if *type_index == expected && elements.len() == 1 => Some(elements[0]), - I::ArrayNewFilled { - type_index, - length, - value, - .. - } if *type_index == expected && self.integer(*length) == Some(1) => Some(*value), - _ => None, - } - } - fn read(&self, value: ValueId, repr: ReprId) -> Option<(ValueId, i32)> { - let expected = self.layout.repr_index(repr).ok()?; - match self.definitions.get(&self.origin(value)).copied()? { - I::ArrayGet { - type_index, - value, - index, - .. - } if *type_index == expected => Some((self.origin(*value), self.integer(*index)?)), - _ => None, - } - } -} diff --git a/crates/psrs-backend/src/mir/control/exits.rs b/crates/psrs-backend/src/mir/control/exits.rs deleted file mode 100644 index a9b2b881..00000000 --- a/crates/psrs-backend/src/mir/control/exits.rs +++ /dev/null @@ -1,77 +0,0 @@ -//! A recursive executor call is a terminal transition, never a discarded effect. -use crate::BackendError; -use crate::cc::ControlHelperRole; -use crate::mir::value_identity::{reference_origin, step_definitions}; -use crate::mir::{Function, Instruction, Module, Terminator}; -use std::collections::HashSet; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - for helper in &layout.representation_table().control_helpers { - if helper.role() != ControlHelperRole::Executor { - continue; - } - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == helper.function()) - else { - continue; - }; - if let Err(message) = verify_function(function) { - errors.push( - BackendError::invalid_ir("P9 MIR executor exit", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} - -fn verify_function(function: &Function) -> Result<(), &'static str> { - for block in &function.blocks { - for instruction in &block.instructions { - let Instruction::Call { - destination: result, - function: callee, - .. - } = instruction - else { - continue; - }; - if *callee != function.symbol { - continue; - } - let definitions = step_definitions(function, block.id); - let mut pending = vec![block.id]; - let mut seen = HashSet::new(); - while let Some(id) = pending.pop() { - if !seen.insert(id) { - continue; - } - let exit = function - .blocks - .iter() - .find(|block| block.id == id) - .and_then(|block| block.terminator.as_ref()) - .ok_or("executor transition has no actual exit")?; - match exit { - Terminator::Return { value, .. } - if reference_origin(*value, &definitions) == *result => {} - Terminator::Trap { .. } => {} - Terminator::Return { .. } - | Terminator::ReturnCall { .. } - | Terminator::ReturnCallRef { .. } => { - return Err("executor transition result must reach every normal exit"); - } - Terminator::Jump { target, .. } - if Some(*target) == crate::mir::value_identity::loop_header(function) => - { - return Err("executor transition result must reach every normal exit"); - } - terminator => pending.extend(crate::mir::cfg::successors(terminator)), - } - } - } - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/control/finish_consumption.rs b/crates/psrs-backend/src/mir/control/finish_consumption.rs deleted file mode 100644 index 29d57853..00000000 --- a/crates/psrs-backend/src/mir/control/finish_consumption.rs +++ /dev/null @@ -1,228 +0,0 @@ -//! Recheck lifecycle ownership after physical projection and loop conversion. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::{FinishProjection, finish_relation}; -use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::{DefinedTypeId, ValueId}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { - return; - }; - let table = layout.representation_table(); - let Some(executor) = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - else { - return; - }; - if !module - .functions - .iter() - .any(|function| function.symbol == executor.function()) - { - return; - } - let Some(sequence) = table.control_sequence() else { - if table - .control_helpers - .iter() - .any(|helper| helper.role() == R::Executor) - { - errors.push(BackendError::invalid_ir( - "P9 MIR control provenance", - module.span, - "control executor has no checked sequence schema", - )); - } - return; - }; - let Ok(finish_type) = layout.variant_index(sequence, 3) else { - errors.push(BackendError::invalid_ir( - "P9 MIR control provenance", - module.span, - "control finish schema has no physical layout", - )); - return; - }; - for function in &module.functions { - if !table - .control_helpers - .iter() - .any(|helper| helper.role() == R::Executor && helper.function() == function.symbol) - { - continue; - } - let header = crate::mir::value_identity::loop_header(function); - for block in &function.blocks { - for (index, instruction) in block.instructions.iter().enumerate() { - let I::Call { - contract: Some(contract), - arguments, - span, - .. - } = instruction - else { - continue; - }; - if !table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Close) - { - continue; - } - let next = block.instructions[index + 1..] - .iter() - .find_map(|instruction| match instruction { - I::Call { - contract: Some(contract), - arguments, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Executor) => - { - Some(arguments.as_slice()) - } - _ => None, - }) - .or_else(|| match &block.terminator { - Some(T::ReturnCall { - contract: Some(contract), - arguments, - .. - }) if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Executor) => - { - Some(arguments.as_slice()) - } - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == header => Some(arguments.as_slice()), - _ => None, - }); - let check = match next { - Some(next) if arguments.len() == 1 && next.len() == 6 => finish_relation( - projection(arguments[0], function, finish_type), - projection(next[3], function, finish_type), - projection(next[4], function, finish_type), - ), - _ => Err("control finish has no checked executor transition"), - }; - if let Err(message) = check { - errors.push( - BackendError::invalid_ir("P9 MIR control provenance", *span, message) - .with_module(function.symbol.module), - ); - } - } - let transitions = block - .instructions - .iter() - .filter_map(|instruction| match instruction { - I::Call { - contract: Some(contract), - arguments, - span, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Executor) => - { - Some((arguments.as_slice(), *span)) - } - _ => None, - }) - .chain(block.terminator.iter().filter_map(|terminator| { - match terminator { - T::ReturnCall { - contract: Some(contract), - arguments, - span, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Executor) => - { - Some((arguments.as_slice(), *span)) - } - T::Jump { - target, - arguments, - span, - } if Some(*target) == header => Some((arguments.as_slice(), *span)), - _ => None, - } - })); - for (next, span) in transitions { - if next.len() != 6 - || !projection(next[3], function, finish_type) - .is_some_and(|projection| projection.field == 1) - { - continue; - } - let close = - block - .instructions - .iter() - .rev() - .find_map(|instruction| match instruction { - I::Call { - contract: Some(contract), - arguments, - .. - } if table - .control_helpers - .get(contract.0 as usize) - .is_some_and(|helper| helper.role() == R::Close) => - { - arguments.first().copied() - } - _ => None, - }); - let check = match close { - Some(close) => finish_relation( - projection(close, function, finish_type), - projection(next[3], function, finish_type), - projection(next[4], function, finish_type), - ), - None => Err("control finish transition does not close its frame"), - }; - if let Err(message) = check { - errors.push( - BackendError::invalid_ir("P9 MIR control provenance", span, message) - .with_module(function.symbol.module), - ); - } - } - } - } -} - -fn projection( - value: ValueId, - function: &Function, - finish_type: DefinedTypeId, -) -> Option { - let definitions = crate::mir::value_identity::definitions(function); - let origin = |value| crate::mir::value_identity::reference_origin(value, &definitions); - match definitions.get(&origin(value)).copied()? { - I::StructGet { - type_index, - field, - value: owner, - .. - } if *type_index == finish_type && *field > 0 => Some(FinishProjection { - owner: origin(*owner), - field: field - 1, - }), - _ => None, - } -} diff --git a/crates/psrs-backend/src/mir/control/finish_creation.rs b/crates/psrs-backend/src/mir/control/finish_creation.rs deleted file mode 100644 index 61605677..00000000 --- a/crates/psrs-backend/src/mir/control/finish_creation.rs +++ /dev/null @@ -1,194 +0,0 @@ -//! Target completion construction and finish copying after physical lowering. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::{FinishProjection, context_finish_relation}; -use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; -use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::DefinedTypeId; - -struct Schema { - context: DefinedTypeId, - finish: DefinedTypeId, - append: DefinedTypeId, -} - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let Some(executor) = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - else { - return; - }; - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == executor.function()) - else { - return; - }; - let types = table - .control_checkpoint_schema() - .zip(table.control_sequence()) - .and_then(|(schema, sequence)| { - Some(( - layout.variant_index(schema.context, 1).ok()?, - layout.variant_index(sequence, 3).ok()?, - layout.variant_index(sequence, 2).ok()?, - )) - }); - let Some((context, finish, append)) = types else { - errors.push(BackendError::invalid_ir( - "P9 MIR finish creation", - function.span, - "finish producer has no physical context or queue schema", - )); - return; - }; - if let Err(message) = verify_function( - function, - &Schema { - context, - finish, - append, - }, - ) { - errors.push( - BackendError::invalid_ir("P9 MIR finish creation", function.span, message) - .with_module(function.symbol.module), - ); - } -} - -fn verify_function(function: &Function, schema: &Schema) -> Result<(), &'static str> { - let parameters = loop_parameters(function); - if parameters.len() != 6 { - return Err("finish producer has an invalid executor contract"); - } - let definitions = definitions(function); - let origin = |value| reference_origin(value, &definitions); - let projection = |value, expected| match definitions.get(&origin(value)).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *type_index == expected && *field > 0 => Some(FinishProjection { - owner: origin(*value), - field: field - 1, - }), - _ => None, - }; - for block in &function.blocks { - for (index, instruction) in block.instructions.iter().enumerate() { - let I::StructNew { - type_index, - arguments, - destination, - .. - } = instruction - else { - continue; - }; - if *type_index != schema.finish { - continue; - } - if arguments.len() != 4 - || !matches!( - definitions.get(&origin(arguments[0])).copied(), - Some(I::Constant { value: 3, .. }) - ) - { - return Err("finish producer has an invalid frame schema"); - } - if projection(arguments[1], schema.context).is_some() { - context_finish_relation( - parameters[5], - projection(arguments[1], schema.context), - projection(arguments[2], schema.context), - projection(arguments[3], schema.context), - )?; - let next = block.instructions[index + 1..] - .iter() - .find_map(|instruction| match instruction { - I::Call { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .or_else(|| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == loop_header(function) => Some(arguments.as_slice()), - Some(T::ReturnCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .ok_or("target finish has no executor transition")?; - if next.len() != 6 - || origin(next[3]) != *destination - || origin(next[4]) != origin(arguments[1]) - || projection(next[5], schema.context) - != Some(FinishProjection { - owner: parameters[5], - field: 4, - }) - { - return Err( - "target finish must enter its caller context with the saved extent", - ); - } - } else { - let extent = projection(arguments[1], schema.finish) - .filter(|projection| projection.field == 0) - .ok_or("finish copy must preserve its original extent")?; - if projection(arguments[3], schema.finish) - != Some(FinishProjection { - owner: extent.owner, - field: 2, - }) - { - return Err("finish copy must preserve its original parent"); - } - let Some(I::StructNew { - type_index, - arguments: appended, - .. - }) = definitions.get(&origin(arguments[2])).copied() - else { - return Err("finish copy must reassociate the original queue"); - }; - if *type_index != schema.append - || appended.len() != 3 - || projection(appended[1], schema.finish) - != Some(FinishProjection { - owner: extent.owner, - field: 1, - }) - { - return Err("finish copy must reassociate the original queue"); - } - let left = projection(extent.owner, schema.append) - .filter(|projection| projection.field == 0) - .ok_or("finish copy has no original append input")?; - if left.owner != parameters[3] - || projection(appended[2], schema.append) - != Some(FinishProjection { - owner: left.owner, - field: 1, - }) - { - return Err("finish copy must retain the original append tail"); - } - } - } - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/control/initialization.rs b/crates/psrs-backend/src/mir/control/initialization.rs deleted file mode 100644 index 72c659fb..00000000 --- a/crates/psrs-backend/src/mir/control/initialization.rs +++ /dev/null @@ -1,126 +0,0 @@ -//! Freshness and published contents are checked independently after physical layout. -use super::execution::View; -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::execution::Operands; -use crate::control::owned::{self, Expected, OwnedSchema}; -use crate::mir::value_identity::definitions; -use crate::mir::{Module, Terminator as T}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let total = crate::mir::effects::total_functions(module); - for helper in &table.control_helpers { - let role = helper.role(); - if !matches!(role, R::Start | R::Once | R::Cancel) { - continue; - } - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == helper.function()) - else { - continue; - }; - let result = (|| { - let replay = table - .control_replay_schema() - .ok_or("control factory has no private cell schema")?; - let owned = OwnedSchema::checked(table)?; - let definitions = definitions(function); - let exits = crate::mir::branch_facts::paths(function, function.entry, None)?; - let normal = exits - .iter() - .filter(|path| !path.trapped) - .map(|path| super::traces::events(function, layout, path)) - .collect::, _>>()?; - if normal.is_empty() { - return Err("control factory has no normal publication path"); - } - for exit in exits { - let view = View { - definitions: &definitions, - layout, - aliases: &exit.aliases, - raw: table - .control_resumption - .as_ref() - .ok_or("control factory has no raw contract")? - .function(), - }; - if exit.trapped { - crate::control::events::exceptional( - &view, - &super::traces::events(function, layout, &exit)?, - &normal, - &crate::control::events::carriers(table)?, - replay.status, - )?; - continue; - } - let block = function - .blocks - .iter() - .find(|block| block.id == exit.block) - .ok_or("control factory has no exit block")?; - let T::Return { value, .. } = block - .terminator - .as_ref() - .ok_or("control factory has no exit")? - else { - return Err("control factory must publish its planned fresh frame"); - }; - if role == R::Cancel { - if function.parameters.len() != 1 { - return Err("cancellation has invalid parameters"); - } - owned::cancel( - &owned, - &view, - function.parameters[0], - *value, - &super::traces::events(function, layout, &exit)?, - )?; - continue; - } - let repr = if role == R::Start { - replay.boundary - } else { - owned.owner - }; - let fields = view - .node(*value, repr, Some(0)) - .ok_or("control factory must publish its planned fresh frame")?; - let cells = if role == R::Start && fields.len() == 1 { - vec![(fields[0], replay.status, Expected::Integer(0))] - } else if role == R::Once && fields.len() == 2 && function.parameters.len() == 1 { - vec![ - ( - fields[0], - owned.callback, - Expected::Value(function.parameters[0]), - ), - (fields[1], owned.status, Expected::Integer(0)), - ] - } else { - return Err("control factory has invalid frame fields"); - }; - owned::publication( - &view, - &[*value], - &cells, - &super::traces::events(function, layout, &exit)?, - &total, - )?; - } - Ok(()) - })(); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR control initialization", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} diff --git a/crates/psrs-backend/src/mir/control/lifecycle.rs b/crates/psrs-backend/src/mir/control/lifecycle.rs deleted file mode 100644 index 1398ae76..00000000 --- a/crates/psrs-backend/src/mir/control/lifecycle.rs +++ /dev/null @@ -1,118 +0,0 @@ -//! Recheck extent helper semantics on the physical CFG, including loopification. -use super::execution::View; -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::execution::Operands; -use crate::control::{events, lifecycle}; -use crate::mir::value_identity::{definitions, loop_header, loop_parameters}; -use crate::mir::{Instruction as I, Module, Terminator as T}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { - return; - }; - let table = layout.representation_table(); - for helper in &table.control_helpers { - let role = helper.role(); - if !matches!(role, R::Check | R::Close) { - continue; - } - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == helper.function()) - else { - continue; - }; - let checked = (|| { - super::traces::entry(function, layout)?; - let schema = lifecycle::Schema::checked(table)?; - let parameters = loop_parameters(function); - if parameters.len() != 1 { - return Err("lifecycle helper has invalid parameters"); - } - let definitions = definitions(function); - let header = loop_header(function); - let paths = crate::mir::branch_facts::paths( - function, - header.unwrap_or(function.entry), - header, - )?; - let normal = paths - .iter() - .filter(|path| !path.trapped) - .map(|path| super::traces::events(function, layout, path)) - .collect::, _>>()?; - let mut coverage = std::collections::HashSet::new(); - for path in paths { - let view = View { - definitions: &definitions, - layout, - aliases: &path.aliases, - raw: table - .control_resumption - .as_ref() - .ok_or("lifecycle has no raw contract")? - .function(), - }; - let observed = super::traces::events(function, layout, &path)?; - if path.trapped { - events::exceptional( - &view, - &observed, - &normal, - &[(schema.boundary, vec![0, 1])], - schema.status, - )?; - continue; - } - let block = function - .blocks - .iter() - .find(|block| block.id == path.block) - .ok_or("lifecycle has no exit block")?; - let (result, next) = - match block.terminator.as_ref().ok_or("lifecycle has no exit")? { - T::Jump { arguments, .. } => (None, Some(arguments.as_slice())), - T::ReturnCall { - function: target, - arguments, - .. - } if *target == function.symbol => (None, Some(arguments.as_slice())), - T::Return { value, .. } => { - match definitions.get(&view.origin(*value)).copied() { - Some(I::Call { - function: target, - arguments, - .. - }) if *target == function.symbol => { - (Some(*value), Some(arguments.as_slice())) - } - _ => (Some(*value), None), - } - } - _ => return Err("lifecycle has an invalid exit"), - }; - coverage.insert(lifecycle::verify( - &schema, - &view, - role, - parameters[0], - result, - next, - &observed, - )?); - } - if coverage.len() != 2 { - return Err("lifecycle must retain root and child actions"); - } - Ok(()) - })(); - if let Err(message) = checked { - errors.push( - BackendError::invalid_ir("P9 MIR lifecycle body", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} diff --git a/crates/psrs-backend/src/mir/control/mod.rs b/crates/psrs-backend/src/mir/control/mod.rs index 4e5af8de..a5a165fa 100644 --- a/crates/psrs-backend/src/mir/control/mod.rs +++ b/crates/psrs-backend/src/mir/control/mod.rs @@ -1,47 +1,17 @@ -//! Control evidence and helper body contracts after physical layout. +//! Control helper call contracts after physical layout. +//! +//! The machine recognizers are removed: construction now owns the machine +//! semantics (see DEC-21 and `cc/lower/control/plan`). Only the helper call +//! binding contract remains, so a lowered call still names a checked helper. use crate::BackendError; use crate::mir::Module; -mod checkpoints; -mod clauses; -mod context_entry; +mod boundary; mod contracts; -mod dispatch; -mod execution; -mod exits; -mod finish_consumption; -mod finish_creation; -mod initialization; -mod lifecycle; -mod owned; -mod publication; -mod refinements; -mod replay; -mod root; -mod steps; -mod traces; pub(super) use contracts::verify_helper_calls; pub(super) fn verify(module: &Module, errors: &mut Vec) { - contracts::verify(module, errors); - dispatch::verify(module, errors); - exits::verify(module, errors); - clauses::verify(module, errors); - - root::verify(module, errors); - finish_consumption::verify(module, errors); - checkpoints::verify(module, errors); - replay::verify(module, errors); - finish_creation::verify(module, errors); - context_entry::verify(module, errors); - steps::verify(module, errors); - execution::verify(module, errors); - owned::verify(module, errors); - lifecycle::verify(module, errors); - initialization::verify(module, errors); - if let Err(mut failures) = publication::verify(module) { - errors.append(&mut failures); - } + boundary::verify(module, errors); } diff --git a/crates/psrs-backend/src/mir/control/owned.rs b/crates/psrs-backend/src/mir/control/owned.rs deleted file mode 100644 index d2da6289..00000000 --- a/crates/psrs-backend/src/mir/control/owned.rs +++ /dev/null @@ -1,101 +0,0 @@ -//! One-shot transfer evidence follows executed instructions and selected edges. -use super::execution::View; -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::execution::{Operands, Schema}; -use crate::control::owned::{self, OwnedSchema}; -use crate::mir::value_identity::{definitions, loop_header, loop_parameters}; -use crate::mir::{Instruction as I, Module, Terminator as T}; -use std::collections::HashMap; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let Some(helper) = table - .control_helpers - .iter() - .find(|helper| helper.role() == R::Executor) - else { - return; - }; - let Some(function) = module - .functions - .iter() - .find(|function| function.symbol == helper.function()) - else { - return; - }; - let result = (|| { - let schema = Schema::checked(table)?; - let owned = OwnedSchema::checked(table)?; - let base = layout - .repr_index(schema.computation) - .map_err(|_| "owned execution has no input layout")?; - let definitions = definitions(function); - let header = loop_header(function); - let blocks = function - .blocks - .iter() - .map(|block| (block.id, block)) - .collect::>(); - let mut transfers = 0; - for exit in - crate::mir::branch_facts::exits(function, header.unwrap_or(function.entry), header)? - { - let view = View { - definitions: &definitions, - layout, - aliases: &exit.aliases, - raw: table - .control_resumption - .as_ref() - .ok_or("owned execution has no raw resumption contract")? - .function(), - }; - if exit - .facts - .get(&(base, view.origin(loop_parameters(function)[2]))) - != Some(&5) - { - continue; - } - let events = super::traces::events(function, layout, &exit)?; - let block = blocks[&exit.block]; - let next = match block - .terminator - .as_ref() - .ok_or("owned execution has no exit")? - { - T::Jump { arguments, .. } | T::ReturnCall { arguments, .. } => arguments, - T::Return { value, .. } => match definitions.get(&view.origin(*value)).copied() { - Some(I::Call { - function: target, - arguments, - .. - }) if *target == function.symbol => arguments, - _ => return Err("owned execution must return its executor transition"), - }, - _ => return Err("owned execution must return its executor transition"), - }; - owned::verify( - &schema, - &owned, - &view, - loop_parameters(function), - next, - &events, - )?; - transfers += 1; - } - if transfers == 0 { - return Err("owned execution has no normal transfer path"); - } - Ok(()) - })(); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR owned execution", function.span, message) - .with_module(function.symbol.module), - ); - } -} diff --git a/crates/psrs-backend/src/mir/control/publication.rs b/crates/psrs-backend/src/mir/control/publication.rs deleted file mode 100644 index 011598b3..00000000 --- a/crates/psrs-backend/src/mir/control/publication.rs +++ /dev/null @@ -1,238 +0,0 @@ -//! Publication witnesses survive ordinary inlining as physical frame origins. -use super::execution::View; -use crate::control::execution::Operands; -use crate::control::owned::{self, Expected, OwnedSchema}; -use crate::mir::value_identity::{definitions, reference_origin}; -use crate::mir::{BlockId, Function, Instruction as I, Module, Terminator as T}; -use psrs_hir::Intrinsic; -use std::collections::{HashMap, HashSet}; - -type Point = (BlockId, usize); - -pub(super) fn verify(module: &Module) -> Result<(), Vec> { - let Some(layout) = &module.layout else { - return Ok(()); - }; - let table = layout.representation_table(); - if table.control_helpers.is_empty() { - return Ok(()); - } - let total = crate::mir::effects::total_functions(module); - let mut errors = Vec::new(); - for function in &module.functions { - let checked: Result<(), &'static str> = (|| { - let definitions = definitions(function); - let points = - function - .blocks - .iter() - .flat_map(|block| { - block.instructions.iter().enumerate().filter_map( - move |(index, instruction)| { - instruction - .destination() - .map(|value| (value, (block.id, index))) - }, - ) - }) - .collect::>(); - let origin = |value| reference_origin(value, &definitions); - let raw = table - .control_resumption - .as_ref() - .ok_or("publication has no raw contract")? - .function(); - let empty = HashMap::new(); - let view = View { - definitions: &definitions, - aliases: &empty, - layout, - raw, - }; - for block in &function.blocks { - for (index, instruction) in block.instructions.iter().enumerate() { - let I::ControlEvidence { - contract, - implementation, - arguments, - .. - } = instruction - else { - continue; - }; - let Some(proof) = table.control_contracts.get(contract.0 as usize) else { - continue; - }; - let mut end = (block.id, index); - let implementation = origin(*implementation); - let (roots, cells) = match proof.operation() { - Intrinsic::ControlOnce => { - if matches!(definitions.get(&implementation), Some(I::Call { .. })) { - continue; - } - let owned = OwnedSchema::checked(table)?; - let fields = view - .node(implementation, owned.owner, Some(0)) - .filter(|fields| fields.len() == 2) - .ok_or("inlined Once must publish its owner frame")?; - if arguments.len() != 1 { - return Err("Once has invalid callback evidence"); - } - ( - vec![implementation], - vec![ - (fields[0], owned.callback, Expected::Value(arguments[0])), - (fields[1], owned.status, Expected::Integer(0)), - ], - ) - } - Intrinsic::ControlRun => { - let Some(I::Call { arguments, .. }) = - definitions.get(&implementation).copied() - else { - continue; - }; - if arguments.len() != 6 { - continue; - } - let extent = origin(arguments[4]); - if matches!(definitions.get(&extent), Some(I::Call { .. })) { - continue; - } - let replay = table - .control_replay_schema() - .ok_or("publication has no extent schema")?; - let fields = view - .node(extent, replay.boundary, Some(0)) - .filter(|fields| fields.len() == 1) - .ok_or("inlined Start must publish its root frame")?; - end = *points - .get(&implementation) - .ok_or("publication has no executor point")?; - ( - arguments.clone(), - vec![(fields[0], replay.status, Expected::Integer(0))], - ) - } - _ => continue, - }; - let producers = cells - .iter() - .map(|(cell, _, _)| { - points - .get(&origin(*cell)) - .copied() - .ok_or("publication has no private cell producer") - }) - .collect::, _>>()?; - // Inlining inserts the whole factory at one call site. Its - // fresh private cells must share that dominating block. - let start_block = producers[0].0; - if producers.iter().any(|point| point.0 != start_block) { - return Err("inlined factory cells must share their allocation site"); - } - let start = ( - start_block, - producers.iter().map(|point| point.1).min().unwrap(), - ); - let window = window(function, start, end)?; - let paths = crate::mir::branch_facts::paths(&window, start_block, None)?; - if paths.is_empty() { - return Err("inlined factory has no publication path"); - } - for path in paths.into_iter().filter(|path| path.block == end.0) { - if path.trapped { - return Err("inlined factory traps before publication"); - } - let view = View { - definitions: &definitions, - aliases: &path.aliases, - layout, - raw, - }; - let mut observed = super::traces::events(&window, layout, &path)?; - if proof.operation() == Intrinsic::ControlRun { - // An exclusive caller can build both candidate Run - // contexts before choosing an executor. These ordinary - // caller allocations do not alter the private status. - observed.retain(|event| { - !matches!(event, crate::control::events::Event::Allocate { .. }) - }); - } - owned::publication(&view, &roots, &cells, &observed, &total)?; - } - } - } - Ok(()) - })(); - if let Err(message) = checked { - errors.push( - crate::BackendError::invalid_ir( - "P9 MIR control publication", - function.span, - message, - ) - .with_module(function.symbol.module), - ); - } - } - if errors.is_empty() { - Ok(()) - } else { - Err(errors) - } -} - -/// Restrict to paths between the allocation and its publication. Other branches -/// can have their own Run witnesses; they do not belong to this invocation. -fn window(function: &Function, start: Point, end: Point) -> Result { - let mut reaches = HashSet::from([end.0]); - loop { - let before = reaches.len(); - for block in &function.blocks { - if block.terminator.as_ref().is_some_and(|t| { - crate::mir::cfg::successors(t) - .iter() - .any(|id| reaches.contains(id)) - }) { - reaches.insert(block.id); - } - } - if before == reaches.len() { - break; - } - } - if !reaches.contains(&start.0) { - return Err("private allocation cannot reach publication"); - } - let mut window = function.clone(); - window.entry = start.0; - window.blocks.retain(|block| reaches.contains(&block.id)); - for block in &mut window.blocks { - if block.id == end.0 { - block.instructions.truncate(end.1); - block.terminator = Some(T::Return { - value: function.result, - span: function.span, - }); - } - if block.id == start.0 { - block.instructions.drain(..start.1); - } - } - // Off-path successors cannot publish this witness. Preserve their edge IDs - // as empty exceptional exits without traversing another invocation. - for block in &function.blocks { - if !reaches.contains(&block.id) { - window.blocks.push(crate::mir::BasicBlock { - id: block.id, - parameters: block.parameters.clone(), - instructions: vec![], - terminator: Some(T::Trap { - span: function.span, - }), - }); - } - } - Ok(window) -} diff --git a/crates/psrs-backend/src/mir/control/refinements.rs b/crates/psrs-backend/src/mir/control/refinements.rs deleted file mode 100644 index c6ce7a13..00000000 --- a/crates/psrs-backend/src/mir/control/refinements.rs +++ /dev/null @@ -1,105 +0,0 @@ -//! Refinements need static subtyping, a selected case, or a checked callback role. -use super::execution::View; -use crate::control::execution::Operands; -use crate::mir::branch_facts::Exit; -use crate::mir::layout::PlannedLayout; -use crate::mir::{Function, Instruction as I, Terminator as T}; -use crate::types::{HeapType, RefType, ValueId, ValueType}; - -pub(super) fn checked( - view: &View<'_>, - function: &Function, - layout: &PlannedLayout, - path: &Exit, - value: ValueId, - target: RefType, -) -> bool { - let definitions = view.definitions; - let source = view.origin(value); - let defined = layout.types().iter().flat_map(|g| &g.0).collect::>(); - if function - .values - .iter() - .find(|v| v.id == source) - .is_some_and(|v| match v.ty { - ValueType::Ref(actual) => { - (target.nullable || !actual.nullable) - && crate::mir::verify::heap_subtype(actual.heap, target.heap, &defined) - } - _ => false, - }) - { - return true; - } - let applied = path.points.iter().any(|(id,index)| function.blocks.iter().find(|b| b.id == *id).and_then(|b| b.instructions.get(*index)).is_some_and(|i| matches!(i, I::ClosureCall { function: callee, .. } if view.origin(*callee) == source))); - if target.heap == HeapType::Eq && applied { - return true; - } - let HeapType::Index(target_index) = target.heap else { - return false; - }; - let table = layout.representation_table(); - for (index, repr) in table.representations.iter().enumerate() { - let repr_id = crate::cc::ReprId(index as u32); - if let crate::cc::Representation::Variant { cases } = repr - && cases.len() == 1 - && layout.variant_index(repr_id, cases[0].tag).ok() == Some(target_index) - && let Some(base) = layout.repr_index(repr_id).ok() && function.values.iter().find(|v| v.id == source).is_some_and(|v| matches!(v.ty, ValueType::Ref(actual) if !actual.nullable && crate::mir::verify::heap_subtype(actual.heap, HeapType::Index(base), &defined))) { return true; } - } - // A physical case cast is licensed by this path's immutable selected tag. - for ((base, selected), tag) in &path.facts { - if view.origin(*selected) != source { - continue; - } - for (index, repr) in table.representations.iter().enumerate() { - let repr_id = crate::cc::ReprId(index as u32); - if matches!(repr, crate::cc::Representation::Variant { .. }) - && layout.repr_index(repr_id).ok() == Some(*base) - && layout.variant_index(repr_id, *tag as u32).ok() == Some(target_index) - { - return true; - } - } - } - // Ordinary callback ABI recovery is justified only for an actual applied - // callee. The owning execution relation checks the complete application and - // its checked source role, including its returned Control computation. - if layout - .closure_layout() - .ok() - .is_some_and(|(closure, _)| closure == target_index) - { - return applied; - } - let Some(schema) = table.control_checkpoint_schema() else { - return false; - }; - let Some(block) = function.blocks.iter().find(|b| b.id == path.block) else { - return false; - }; - let arguments = match &block.terminator { - Some(T::Jump { arguments, .. } | T::ReturnCall { arguments, .. }) => { - Some(arguments.as_slice()) - } - Some(T::Return { value, .. }) => match definitions.get(&view.origin(*value)).copied() { - Some(I::Call { - function: callee, - arguments, - .. - }) if *callee == function.symbol => Some(arguments.as_slice()), - _ => None, - }, - _ => None, - }; - if let Some(pair) = table.control_result_pair - && layout.repr_index(pair).ok() == Some(target_index) - { - return arguments.is_some_and(|args| { - args.len() == 6 - && view.projection(args[0], pair, None) == Some((source, 0)) - && view.projection(args[2], pair, None) == Some((source, 1)) - }); - } - layout.repr_index(schema.computation).ok() == Some(target_index) - && arguments.is_some_and(|args| args.len() == 6 && view.origin(args[2]) == source) -} diff --git a/crates/psrs-backend/src/mir/control/replay.rs b/crates/psrs-backend/src/mir/control/replay.rs deleted file mode 100644 index 5878b099..00000000 --- a/crates/psrs-backend/src/mir/control/replay.rs +++ /dev/null @@ -1,445 +0,0 @@ -//! Check replay lifecycle allocations and transitions after loop conversion. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::{ - FinishProjection, replay_activation_relation, saved_finish_relation, -}; -use crate::mir::value_identity::{ - definitions, fresh_iteration_allocation, loop_header, loop_parameters, precedes, - reference_origin, -}; -use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::DefinedTypeId; -use std::collections::{HashMap, HashSet}; - -struct Schema { - finish: DefinedTypeId, - cons: DefinedTypeId, - boundary: DefinedTypeId, - status: DefinedTypeId, - result: DefinedTypeId, -} - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - let functions = module - .functions - .iter() - .filter_map(|function| { - let role = table - .control_helpers - .iter() - .find(|helper| helper.function() == function.symbol)? - .role(); - matches!(role, R::CloneSequence | R::RebuildSequence).then_some((function, role)) - }) - .collect::>(); - if functions.is_empty() { - return; - } - let Some(requirements) = table.control_replay_schema() else { - errors.push(BackendError::invalid_ir( - "P9 MIR control replay", - module.span, - "replay has no checked lifecycle schema", - )); - return; - }; - let types = ( - layout.variant_index(requirements.sequence, 3), - layout.variant_index(requirements.sequence, 1), - layout.variant_index(requirements.boundary, 1), - layout.repr_index(requirements.status), - layout.repr_index(requirements.result), - ); - let (Ok(finish), Ok(cons), Ok(boundary), Ok(status), Ok(result)) = types else { - errors.push(BackendError::invalid_ir( - "P9 MIR control replay", - module.span, - "replay lifecycle schema has no physical layout", - )); - return; - }; - let schema = Schema { - finish, - cons, - boundary, - status, - result, - }; - let total = crate::mir::effects::total_functions(module); - for (function, role) in functions { - if let Err(message) = verify_function(function, role, table, &schema, &total) { - errors.push( - BackendError::invalid_ir("P9 MIR control replay", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} - -fn verify_function( - function: &Function, - role: R, - table: &crate::cc::RepresentationTable, - schema: &Schema, - total: &HashSet, -) -> Result<(), &'static str> { - let parameters = loop_parameters(function); - if parameters.len() != if role == R::CloneSequence { 5 } else { 4 } { - return Err("replay has an invalid parameter contract"); - } - let definitions = definitions(function); - let origin = |value| reference_origin(value, &definitions); - let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(I::Constant { value, .. }) if *value == expected); - let projection = |value, expected_type| match definitions.get(&origin(value)).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *type_index == expected_type && *field > 0 => Some(FinishProjection { - owner: origin(*value), - field: field - 1, - }), - _ => None, - }; - let points = function - .blocks - .iter() - .flat_map(|block| { - block - .instructions - .iter() - .enumerate() - .filter_map(move |(index, instruction)| { - instruction - .destination() - .map(|destination| (destination, (block.id, index))) - }) - }) - .collect::>(); - let dominators = crate::mir::cfg::dominators(function); - for block in &function.blocks { - for (index, instruction) in block.instructions.iter().enumerate() { - let total_call = matches!(instruction, - I::Call { function, .. } | I::CallVoid { function, .. } if total.contains(function)); - if crate::mir::effects::may_invoke(instruction) - && !total_call - && !matches!(instruction, I::Call { contract: Some(id), .. } - if table.control_helpers.get(id.0 as usize).is_some_and(|helper| - matches!(helper.role(), R::Check | R::CloneSequence | R::RebuildSequence))) - { - return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); - } - match instruction { - I::ClosureNew { .. } => { - return Err( - "replay traversal cannot invoke callbacks or mutate lifecycle cells", - ); - } - I::StructNew { - type_index, - arguments, - destination, - .. - } if *type_index == schema.cons => { - let accumulator = parameters[if role == R::CloneSequence { 2 } else { 1 }]; - if arguments.len() != 3 - || !constant(arguments[0], 1) - || projection(arguments[1], schema.cons) - != Some(FinishProjection { - owner: parameters[0], - field: 0, - }) - || origin(arguments[2]) != accumulator - { - return Err( - "replay must share the original callback and retain its accumulator", - ); - } - if role == R::RebuildSequence { - let next = block.instructions[index + 1..] - .iter() - .find_map(|instruction| match instruction { - I::Call { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .or_else(|| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == loop_header(function) => { - Some(arguments.as_slice()) - } - Some(T::ReturnCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .ok_or("callback rebuild has no transition")?; - if next.len() != 4 - || projection(next[0], schema.cons) - != Some(FinishProjection { - owner: parameters[0], - field: 1, - }) - || origin(next[1]) != *destination - || origin(next[2]) != parameters[2] - || origin(next[3]) != parameters[3] - { - return Err( - "callback rebuild must preserve its active extent and parent", - ); - } - } - } - I::StructNew { - type_index, - arguments, - destination, - .. - } if *type_index == schema.finish => { - if arguments.len() != 4 || !constant(arguments[0], 3) { - return Err("replay finish has an invalid schema"); - } - if role == R::CloneSequence { - saved_finish_relation( - parameters[0], - projection(arguments[1], schema.finish), - )?; - if origin(arguments[2]) != parameters[2] - || origin(arguments[3]) != parameters[4] - { - return Err( - "replay traversal must retain its reverse accumulator and parent", - ); - } - let checked = function.blocks.iter().any(|source| source.instructions.iter().enumerate().any(|(position, instruction)| { - precedes((source.id, position), (block.id, index), &dominators) - && matches!(instruction, I::Call { contract: Some(id), arguments: checked, .. } - if table.control_helpers.get(id.0 as usize).is_some_and(|helper| helper.role() == R::Check) - && checked.len() == 1 && origin(checked[0]) == origin(arguments[1])) - })); - if !checked { - return Err( - "replay must check the saved finish extent before copying it", - ); - } - } else { - replay_activation_relation( - parameters[1], - parameters[2], - origin(arguments[2]), - origin(arguments[3]), - )?; - let extent = origin(arguments[1]); - let Some(I::StructNew { - type_index, - arguments: activation, - .. - }) = definitions.get(&extent).copied() - else { - return Err("replay must create a fresh activation extent"); - }; - if *type_index != schema.boundary - || activation.len() != 3 - || !constant(activation[0], 1) - || origin(activation[2]) != parameters[3] - { - return Err("replay activation must use its current parent"); - } - let status = origin(activation[1]); - let initialized = match definitions.get(&status).copied() { - Some(I::ArrayNew { - type_index, - elements, - .. - }) => { - *type_index == schema.status - && elements.len() == 1 - && constant(elements[0], 0) - } - Some(I::ArrayNewFilled { - type_index, - length, - value, - .. - }) => { - *type_index == schema.status - && constant(*length, 1) - && constant(*value, 0) - } - _ => false, - }; - let point = (block.id, index); - if !initialized - || !fresh_iteration_allocation( - function, - status, - point, - &points, - &dominators, - ) - || !fresh_iteration_allocation( - function, - extent, - point, - &points, - &dominators, - ) - { - return Err( - "replay activation needs a fresh live status cell in its iteration", - ); - } - let next = block.instructions[index + 1..] - .iter() - .find_map(|instruction| match instruction { - I::Call { - function: target, - arguments, - .. - } if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .or_else(|| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == loop_header(function) => { - Some(arguments.as_slice()) - } - Some(T::ReturnCall { - function: target, - arguments, - .. - }) if *target == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .ok_or("replay activation has no rebuild transition")?; - if next.len() != 4 - || origin(next[1]) != *destination - || origin(next[2]) != extent - || origin(next[3]) != extent - { - return Err( - "replay must advance its queue, active extent and parent together", - ); - } - } - } - I::StructNew { - type_index, - arguments, - .. - } if role == R::RebuildSequence && *type_index == schema.result => { - if arguments.len() != 2 - || origin(arguments[0]) != parameters[1] - || origin(arguments[1]) != parameters[2] - { - return Err( - "replay result must return its accumulated queue and active extent", - ); - } - } - I::ArraySet { .. } => { - return Err("replay must not mutate saved or fresh lifecycle cells"); - } - _ => {} - } - } - if role == R::CloneSequence { - let calls = block - .instructions - .iter() - .filter_map(|instruction| match instruction { - I::Call { - contract: Some(id), - arguments, - .. - } => Some((*id, arguments.as_slice())), - _ => None, - }) - .chain( - block - .terminator - .iter() - .filter_map(|terminator| match terminator { - T::ReturnCall { - contract: Some(id), - arguments, - .. - } => Some((*id, arguments.as_slice())), - _ => None, - }), - ); - for (id, arguments) in calls { - let valid = match table - .control_helpers - .get(id.0 as usize) - .map(|helper| helper.role()) - { - Some(R::CloneSequence) => { - arguments.len() == 5 - && origin(arguments[3]) == parameters[3] - && origin(arguments[4]) == parameters[4] - } - Some(R::RebuildSequence) => { - arguments.len() == 4 - && origin(arguments[0]) == parameters[2] - && origin(arguments[1]) == parameters[1] - && origin(arguments[2]) == parameters[3] - && origin(arguments[3]) == parameters[4] - } - _ => true, - }; - if !valid { - return Err( - "clone traversal must preserve its accumulators, active extent and parent", - ); - } - } - if let Some(T::Jump { - target, arguments, .. - }) = &block.terminator - && block.id != function.entry - && Some(*target) == loop_header(function) - && (arguments.len() != 5 - || origin(arguments[3]) != parameters[3] - || origin(arguments[4]) != parameters[4]) - { - return Err( - "clone traversal must preserve its accumulators, active extent and parent", - ); - } - } - match &block.terminator { - Some(T::ReturnCallRef { .. }) => { - return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); - } - Some(T::ReturnCall { - function: target, - contract, - .. - }) if contract - .and_then(|id| table.control_helpers.get(id.0 as usize)) - .is_none_or(|helper| { - !matches!( - helper.role(), - R::Check | R::CloneSequence | R::RebuildSequence - ) - }) => - { - return Err("replay traversal cannot invoke callbacks or mutate lifecycle cells"); - } - _ => {} - } - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/control/root.rs b/crates/psrs-backend/src/mir/control/root.rs deleted file mode 100644 index 74c51889..00000000 --- a/crates/psrs-backend/src/mir/control/root.rs +++ /dev/null @@ -1,253 +0,0 @@ -//! Root initialization and normal completion after physical lowering. -use crate::BackendError; -use crate::cc::{ControlHelperRole as R, RepresentationTable}; -use crate::control::provenance::root_extent_relation; -use crate::mir::value_identity::{definitions, fresh_iteration_allocation, reference_origin}; -use crate::mir::{Function, Instruction as I, Module, Terminator as T}; -use crate::types::DefinedTypeId; -use psrs_hir::Intrinsic; -use std::collections::HashMap; - -struct Schema { - context: DefinedTypeId, - boundary: DefinedTypeId, - empty: DefinedTypeId, - status: DefinedTypeId, -} - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { return }; - let table = layout.representation_table(); - if table.control_helpers.is_empty() { - return; - } - let schema = table - .control_checkpoint_schema() - .zip(table.control_replay_schema()) - .and_then(|(checkpoint, replay)| { - Some(Schema { - context: layout.variant_index(checkpoint.context, 0).ok()?, - boundary: layout.variant_index(replay.boundary, 0).ok()?, - empty: layout.variant_index(replay.sequence, 0).ok()?, - status: layout.repr_index(replay.status).ok()?, - }) - }); - let Some(schema) = schema else { - errors.push(BackendError::invalid_ir( - "P9 MIR control root", - module.span, - "control run has no physical root schema", - )); - return; - }; - for function in &module.functions { - if let Err(message) = verify_function(function, table, &schema) { - errors.push( - BackendError::invalid_ir("P9 MIR control root", function.span, message) - .with_module(function.symbol.module), - ); - } - } -} - -fn verify_function( - function: &Function, - table: &RepresentationTable, - schema: &Schema, -) -> Result<(), &'static str> { - let definitions = definitions(function); - let origin = |value| reference_origin(value, &definitions); - let role = |id: crate::cc::ControlHelperId| { - table - .control_helpers - .get(id.0 as usize) - .map(|helper| helper.role()) - }; - let constant = |value, expected| matches!(definitions.get(&origin(value)).copied(), Some(I::Constant { value, .. }) if *value == expected); - let physical_root = |value| { - let Some(I::StructNew { - type_index, - arguments, - .. - }) = definitions.get(&origin(value)).copied() - else { - return Err("control Start must return a freshly allocated root extent"); - }; - if *type_index != schema.boundary || arguments.len() != 2 || !constant(arguments[0], 0) { - return Err("control Start must return a freshly allocated root extent"); - } - let status = origin(arguments[1]); - let live = match definitions.get(&status).copied() { - Some(I::ArrayNew { - type_index, - elements, - .. - }) => *type_index == schema.status && elements.len() == 1 && constant(elements[0], 0), - Some(I::ArrayNewFilled { - type_index, - length, - value, - .. - }) => *type_index == schema.status && constant(*length, 1) && constant(*value, 0), - _ => false, - }; - if !live { - return Err("control Start needs a fresh one-element live status cell"); - } - Ok(status) - }; - if table - .control_helpers - .iter() - .any(|helper| helper.function() == function.symbol && helper.role() == R::Start) - { - if !function.parameters.is_empty() { - return Err("control Start has an invalid parameter contract"); - } - let mut returns = 0; - for block in &function.blocks { - match &block.terminator { - Some(T::Return { value, .. }) => { - returns += 1; - physical_root(*value)?; - } - Some(T::ReturnCall { .. } | T::ReturnCallRef { .. }) => { - return Err("control Start must return a freshly allocated root extent"); - } - _ => {} - } - } - if returns == 0 { - return Err("control Start must return a freshly allocated root extent"); - } - } - if !definitions.values().any(|instruction| matches!(instruction, I::ControlEvidence { contract, .. } - if table.control_contracts.get(contract.0 as usize).is_some_and(|proof| proof.operation() == Intrinsic::ControlRun))) { - return Ok(()); - } - let points = function - .blocks - .iter() - .flat_map(|block| { - block - .instructions - .iter() - .enumerate() - .filter_map(move |(index, instruction)| { - instruction - .destination() - .map(|value| (value, (block.id, index))) - }) - }) - .collect::>(); - let dominators = crate::mir::cfg::dominators(function); - let mut owners = HashMap::<_, Vec<_>>::new(); - for instruction in function.blocks.iter().flat_map(|block| &block.instructions) { - let I::ControlEvidence { - contract, - implementation, - .. - } = instruction - else { - continue; - }; - if !table - .control_contracts - .get(contract.0 as usize) - .is_some_and(|proof| proof.operation() == Intrinsic::ControlRun) - { - continue; - } - let implementation = origin(*implementation); - let Some(I::Call { - contract: Some(id), - arguments, - .. - }) = definitions.get(&implementation).copied() - else { - return Err("control run has no local executor invocation"); - }; - if role(*id) != Some(R::Executor) || arguments.len() != 6 { - return Err("control run has no local executor invocation"); - } - if !matches!(definitions.get(&origin(arguments[3])).copied(), Some(I::StructNew { type_index, arguments, .. }) - if *type_index == schema.empty && arguments.len() == 1 && constant(arguments[0], 0)) - { - return Err("control run must start with an empty root queue"); - } - let extent = origin(arguments[4]); - let retained_start = matches!(definitions.get(&extent).copied(), Some(I::Call { contract: Some(id), arguments, .. }) if role(*id) == Some(R::Start) && arguments.is_empty()); - if !retained_start - && !matches!(definitions.get(&extent).copied(), Some(I::StructNew { type_index, .. }) if *type_index == schema.boundary) - { - return Err("control run must start with a fresh Start extent"); - } - let point = *points - .get(&implementation) - .ok_or("control run has no local executor invocation")?; - let status = if retained_start { - None - } else { - Some(physical_root(extent)?) - }; - if !fresh_iteration_allocation(function, extent, point, &points, &dominators) - || status.is_some_and(|status| { - !fresh_iteration_allocation(function, status, point, &points, &dominators) - }) - { - return Err( - "control run root must be allocated in its current invocation or iteration", - ); - } - for owned in std::iter::once(extent).chain(status) { - let producer = *points - .get(&owned) - .ok_or("control run has no root producer")?; - let previous = owners.entry(owned).or_default(); - for previous_point in previous - .iter() - .copied() - .filter(|previous| *previous != point) - { - let forward = - crate::mir::cfg::reachable_without(function, previous_point, point, producer); - let backward = - crate::mir::cfg::reachable_without(function, point, previous_point, producer); - if forward != Some(false) || backward != Some(false) { - return Err( - "control run factories must not reuse another invocation's root extent or status cell", - ); - } - } - previous.push(point); - } - let Some(I::StructNew { - type_index, - arguments: context, - .. - }) = definitions.get(&origin(arguments[5])).copied() - else { - return Err("control run must install a root dispatch context"); - }; - if *type_index != schema.context || context.len() != 2 || !constant(context[0], 0) { - return Err("control run must install a root dispatch context"); - } - root_extent_relation(extent, origin(context[1]))?; - let closed = crate::mir::cfg::normal_paths_cross( - function, - point, - |instruction| { - matches!(instruction, - I::Call { contract: Some(id), arguments, .. } - if role(*id) == Some(R::Close) && arguments.len() == 1 && origin(arguments[0]) == extent) - }, - |instruction| matches!(instruction, I::ControlEvidence { implementation: actual, .. } if origin(*actual) == implementation), - ); - if !closed { - return Err( - "control run must close its root after execution and before publishing its result", - ); - } - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/control/steps.rs b/crates/psrs-backend/src/mir/control/steps.rs deleted file mode 100644 index f9fe4d37..00000000 --- a/crates/psrs-backend/src/mir/control/steps.rs +++ /dev/null @@ -1,200 +0,0 @@ -//! Bind and Resume operand identities on actual executor transitions. -use crate::BackendError; -use crate::cc::ControlHelperRole as R; -use crate::control::provenance::FinishProjection; -use crate::control::steps::{bind_relation, resume_answer_relation}; -use crate::mir::value_identity::{definitions, loop_header, loop_parameters, reference_origin}; -use crate::mir::{Instruction as I, Module, Terminator as T}; - -pub(super) fn verify(module: &Module, errors: &mut Vec) { - let Some(layout) = &module.layout else { - return; - }; - let table = layout.representation_table(); - let Some(helper) = table - .control_helpers - .iter() - .find(|h| h.role() == R::Executor) - else { - return; - }; - let Some(function) = module - .functions - .iter() - .find(|f| f.symbol == helper.function()) - else { - return; - }; - let result = (|| { - let schema = table - .control_checkpoint_schema() - .ok_or("execution step has no checked schema")?; - let queue = table - .control_sequence() - .ok_or("execution step has no checked queue")?; - let base = layout - .repr_index(schema.computation) - .map_err(|_| "execution step has no input layout")?; - let bind = layout - .variant_index(schema.computation, 2) - .map_err(|_| "Bind has no physical case")?; - let resume = layout - .variant_index(schema.computation, 3) - .map_err(|_| "Resume has no physical case")?; - let returned = layout - .variant_index(schema.computation, 0) - .map_err(|_| "Return has no physical case")?; - let cons = layout - .variant_index(queue, 1) - .map_err(|_| "Cons has no physical case")?; - let append = layout - .variant_index(queue, 2) - .map_err(|_| "Append has no physical case")?; - let replay = layout - .repr_index( - table - .control_replay_schema() - .ok_or("Resume has no replay schema")? - .result, - ) - .map_err(|_| "Resume has no replay layout")?; - let definitions = definitions(function); - let origin = |v| reference_origin(v, &definitions); - let parameters = loop_parameters(function); - if parameters.len() != 6 { - return Err("execution step has an invalid executor contract"); - } - let states = crate::mir::branch_facts::compute(function); - let projection = |value, ty| match definitions.get(&origin(value)).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *type_index == ty && *field > 0 => Some(FinishProjection { - owner: origin(*value), - field: field - 1, - }), - _ => None, - }; - let replay_field = |value, expected| match definitions.get(&origin(value)).copied() { - Some(I::StructGet { - type_index, - field, - value, - .. - }) if *type_index == replay && *field == expected => Some(origin(*value)), - _ => None, - }; - let mut counts = [0, 0]; - for block in &function.blocks { - let Some(tag @ (2 | 3)) = states - .get(&block.id) - .and_then(|s| s.get(&(base, origin(parameters[2])))) - .copied() - else { - continue; - }; - let transitions = block - .instructions - .iter() - .filter_map(|i| match i { - I::Call { - function: callee, - arguments, - .. - } if *callee == function.symbol => Some(arguments.as_slice()), - _ => None, - }) - .chain(match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if Some(*target) == loop_header(function) => Some(arguments.as_slice()), - Some(T::ReturnCall { - function: callee, - arguments, - .. - }) if *callee == function.symbol => Some(arguments.as_slice()), - _ => None, - }); - for arguments in transitions { - if arguments.len() != 6 { - return Err("execution step must produce its executor transition"); - } - if origin(arguments[0]) != origin(parameters[0]) - || origin(arguments[1]) != origin(parameters[1]) - || origin(arguments[5]) != origin(parameters[5]) - { - return Err( - "execution step must preserve state, root handler and dispatch context", - ); - } - let Some(I::StructNew { - type_index, - arguments: pending, - .. - }) = definitions.get(&origin(arguments[3])).copied() - else { - return Err("execution step must retain its pending queue"); - }; - if pending.len() != 3 { - return Err("execution step must retain its pending queue"); - } - if tag == 2 { - if *type_index != cons || origin(arguments[4]) != origin(parameters[4]) { - return Err( - "Bind must retain its current execution extent and prepend one callback", - ); - } - bind_relation( - origin(parameters[2]), - origin(parameters[3]), - projection(arguments[2], bind), - projection(pending[1], bind), - origin(pending[2]), - )?; - } else { - if *type_index != append || origin(pending[2]) != origin(parameters[3]) { - return Err("Resume must append replay to its current queue"); - } - let Some(I::StructNew { - type_index, - arguments: answer, - .. - }) = definitions.get(&origin(arguments[2])).copied() - else { - return Err("Resume must return its current saved answer"); - }; - if *type_index != returned || answer.len() != 2 { - return Err("Resume must return its current saved answer"); - } - resume_answer_relation(origin(parameters[2]), projection(answer[1], resume))?; - let owner = replay_field(pending[1], 0) - .ok_or("Resume must use its replayed queue and activation")?; - if replay_field(arguments[4], 1) != Some(owner) - || !matches!(definitions.get(&owner).copied(), Some(I::Call { function: callee, .. }) if table.control_helpers.iter().any(|h| h.role() == R::CloneSequence && h.function() == *callee)) - { - return Err("Resume must use its replayed queue and activation"); - } - } - counts[(tag - 2) as usize] += 1; - } - if matches!( - &block.terminator, - Some(T::Return { .. } | T::ReturnCallRef { .. }) - ) { - return Err("execution step must produce its executor transition"); - } - } - if counts.contains(&0) { - return Err("execution step must produce its executor transition"); - } - Ok(()) - })(); - if let Err(message) = result { - errors.push( - BackendError::invalid_ir("P9 MIR execution steps", function.span, message) - .with_module(function.symbol.module), - ); - } -} diff --git a/crates/psrs-backend/src/mir/control/traces.rs b/crates/psrs-backend/src/mir/control/traces.rs deleted file mode 100644 index 59a71086..00000000 --- a/crates/psrs-backend/src/mir/control/traces.rs +++ /dev/null @@ -1,229 +0,0 @@ -//! Normalize executed effects without rebuilding scalar or reference identities. -use crate::cc::{ReprId, Representation}; -use crate::control::events::Event; -use crate::control::execution::Operands; -use crate::mir::branch_facts::Exit; -use crate::mir::layout::PlannedLayout; -use crate::mir::{Function, Instruction as I, Terminator as T}; -use std::collections::HashMap; - -pub(super) fn events( - function: &Function, - layout: &PlannedLayout, - exit: &Exit, -) -> Result, &'static str> { - let arrays = layout - .representation_table() - .representations - .iter() - .enumerate() - .filter_map(|(index, repr)| { - matches!(repr, Representation::Array { .. }).then_some(ReprId(index as u32)) - }) - .filter_map(|repr| layout.repr_index(repr).ok().map(|index| (index, repr))) - .collect::>(); - let blocks = function - .blocks - .iter() - .map(|block| (block.id, block)) - .collect::>(); - let definitions = crate::mir::value_identity::definitions(function); - let raw = layout - .representation_table() - .control_resumption - .as_ref() - .ok_or("execution has no raw contract")? - .function(); - let view = super::execution::View { - definitions: &definitions, - layout, - aliases: &exit.aliases, - raw, - }; - let mut events = Vec::new(); - for (id, index) in &exit.points { - let block = blocks.get(id).ok_or("execution trace has no block")?; - let Some(instruction) = block.instructions.get(*index) else { - for (value, tag, point) in &exit.selections { - if point == &(*id, *index) { - events.push(Event::Select { - value: *value, - tag: *tag, - }); - } - } - for (value, tags, point) in &exit.rejections { - if point == &(*id, *index) { - events.push(Event::Reject { - value: *value, - tags: tags.clone(), - }); - } - } - if *id == exit.block { - match block - .terminator - .as_ref() - .ok_or("execution trace has no exit")? - { - T::Jump { arguments, .. } | T::ReturnCall { arguments, .. } => { - events.push(Event::Advance { - arguments: arguments.clone(), - }) - } - _ => {} - } - } - continue; - }; - let event = match instruction { - I::RefCast { - value, reference, .. - } if !exit.trapped - && !super::refinements::checked( - &view, function, layout, exit, *value, *reference, - ) => - { - Some(Event::Trap) - } - I::RefCast { - destination, value, .. - } => Some(Event::Refine { - result: *destination, - source: crate::mir::value_identity::path_origin( - *value, - &definitions, - &exit.aliases, - ), - }), - I::Unreachable { .. } - if exit.trapped && *id == exit.block && *index + 1 == block.instructions.len() => - { - None - } - I::ArrayGet { - type_index, - value, - index, - destination, - .. - } => Some(Event::Read { - repr: *arrays - .get(type_index) - .ok_or("execution reads an unplanned array")?, - cell: *value, - index: *index, - result: *destination, - }), - I::ArraySet { - type_index, - value, - index, - new_value, - .. - } => Some(Event::Store { - repr: *arrays - .get(type_index) - .ok_or("execution writes an unplanned array")?, - cell: *value, - index: *index, - value: *new_value, - }), - I::StructNew { destination, .. } - | I::ClosureNew { destination, .. } - | I::ArrayNew { destination, .. } - | I::ArrayNewSized { destination, .. } - | I::ArrayNewFilled { destination, .. } - | I::ArrayNewData { destination, .. } => Some(Event::Allocate { - result: *destination, - }), - I::TrapIf { .. } - | I::Unreachable { .. } - | I::Primitive { - op: crate::mir::NumericOp::I32DivS | crate::mir::NumericOp::I32RemS, - .. - } => Some(Event::Trap), - I::ClosureCall { destination, .. } => Some(Event::Apply { - result: *destination, - }), - I::Call { - function: target, - arguments, - .. - } if *target == function.symbol => Some(Event::Advance { - arguments: arguments.clone(), - }), - I::Call { - function, - arguments, - .. - } - | I::CallVoid { - function, - arguments, - .. - } => Some(Event::Direct { - function: *function, - arguments: arguments.clone(), - }), - I::StringToBytes { .. } | I::ArrayClone { .. } => Some(Event::OtherEffect), - instruction if crate::mir::effects::may_invoke(instruction) => Some(Event::OtherCall), - instruction if crate::mir::effects::classify(instruction).writes_memory => { - Some(Event::OtherEffect) - } - instruction - if crate::mir::effects::classify(instruction).reads_memory - && !matches!( - instruction, - I::StructGet { .. } | I::ClosureGetCapture { .. } - ) => - { - Some(Event::OtherEffect) - } - _ => None, - }; - if let Some(event) = event { - events.push(event) - } - } - crate::control::events::canonicalize(&mut events, |value| view.origin(value)); - Ok(events) -} - -/// Loop initialization is part of helper execution, before its first dispatch. -pub(super) fn entry(function: &Function, layout: &PlannedLayout) -> Result<(), &'static str> { - let Some(header) = crate::mir::value_identity::loop_header(function) else { - return Ok(()); - }; - let definitions = crate::mir::value_identity::definitions(function); - let raw = layout - .representation_table() - .control_resumption - .as_ref() - .ok_or("entry has no raw contract")? - .function(); - for path in crate::mir::branch_facts::paths(function, function.entry, Some(header))? { - if path.trapped { - return Err("machine entry cannot trap before dispatch"); - } - let view = super::execution::View { - definitions: &definitions, - layout, - aliases: &path.aliases, - raw, - }; - let observed = events(function, layout, &path)?; - let [Event::Advance { arguments }] = observed.as_slice() else { - return Err("machine entry contains an additional observable operation"); - }; - if arguments.len() != function.parameters.len() - || !arguments - .iter() - .zip(&function.parameters) - .all(|(a, b)| view.origin(*a) == view.origin(*b)) - { - return Err("machine entry must initialize its own parameters"); - } - } - Ok(()) -} diff --git a/crates/psrs-backend/src/mir/effects.rs b/crates/psrs-backend/src/mir/effects.rs index c85376a8..f0ad48c3 100644 --- a/crates/psrs-backend/src/mir/effects.rs +++ b/crates/psrs-backend/src/mir/effects.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] //! Conservative instruction effect summaries shared by optimization and semantic verification. use crate::mir::Instruction; diff --git a/crates/psrs-backend/src/mir/mod.rs b/crates/psrs-backend/src/mir/mod.rs index 4a789ca4..6577b0ec 100644 --- a/crates/psrs-backend/src/mir/mod.rs +++ b/crates/psrs-backend/src/mir/mod.rs @@ -6,7 +6,6 @@ use psrs_hir::SymbolId; use psrs_span::TextRange; use std::collections::{HashMap, HashSet}; -pub(crate) mod branch_facts; pub(crate) mod cfg; mod control; mod effects; diff --git a/crates/psrs-backend/src/mir/value_identity.rs b/crates/psrs-backend/src/mir/value_identity.rs index 5cd2eefd..bbe7d0ed 100644 --- a/crates/psrs-backend/src/mir/value_identity.rs +++ b/crates/psrs-backend/src/mir/value_identity.rs @@ -1,3 +1,4 @@ +#![allow(dead_code)] //! Shared reference identity and loop parameter views for MIR consumers. use super::{BlockId, Function, Instruction, Terminator}; use crate::types::ValueId; diff --git a/crates/psrs-backend/src/mir/verify/mod.rs b/crates/psrs-backend/src/mir/verify/mod.rs index feacb10b..1985c54e 100644 --- a/crates/psrs-backend/src/mir/verify/mod.rs +++ b/crates/psrs-backend/src/mir/verify/mod.rs @@ -15,7 +15,6 @@ mod captures; mod function; mod instruction; mod subtype; -pub(in crate::mir) use subtype::heap_subtype; mod util; mod variants; diff --git a/crates/psrs-driver/src/tests/control_carriers.rs b/crates/psrs-driver/src/tests/control_carriers.rs index 6829b286..9942a6ed 100644 --- a/crates/psrs-driver/src/tests/control_carriers.rs +++ b/crates/psrs-driver/src/tests/control_carriers.rs @@ -199,3 +199,107 @@ fn cc_rejects_weakening_a_source_computation_to_an_abstract_aggregate() { "{errors:?}" ); } + +#[test] +fn cc_boundary_rejects_a_dropped_machine_dispatch_arm() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = input + .cc + .representations + .control_helpers + .iter() + .find(|helper| helper.role() == ControlHelperRole::Executor) + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let AssignmentKind::TagSwitch { cases, .. } = + &mut function.assignments.last_mut().unwrap().kind + else { + panic!("executor result must be a computation dispatch"); + }; + cases.retain(|case| case.tag != 1); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P8 CC verification"), + "boundary check must reject a dropped machine arm: {errors:?}" + ); +} + +#[test] +fn mir_boundary_rejects_a_dropped_machine_dispatch_arm() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (mut module, _) = psrs_backend::mir::lower_module(input.cc).unwrap(); + let symbol = module + .control_helpers() + .iter() + .find(|helper| helper.role() == ControlHelperRole::Executor) + .unwrap() + .function(); + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + let mut dropped = false; + for block in &mut function.blocks { + if let Some(psrs_backend::mir::Terminator::Switch { cases, .. }) = &mut block.terminator + && cases.len() > 2 + { + cases.pop(); + dropped = true; + break; + } + } + assert!(dropped, "executor must contain a machine dispatch switch"); + let errors = psrs_backend::mir::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR verification"), + "MIR boundary check must reject a dropped machine arm: {errors:?}" + ); +} + +#[test] +fn mir_boundary_rejects_a_changed_external_tail_target() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (mut module, _) = psrs_backend::mir::lower_module(input.cc).unwrap(); + let clone = module + .control_helpers() + .iter() + .find(|helper| helper.role() == ControlHelperRole::CloneSequence) + .unwrap() + .function(); + let function = module + .functions + .iter_mut() + .find(|function| function.symbol == clone) + .unwrap(); + let mut changed = false; + for block in &mut function.blocks { + if let Some(psrs_backend::mir::Terminator::ReturnCall { + function: target, .. + }) = &mut block.terminator + && *target != clone + { + *target = clone; + changed = true; + break; + } + } + assert!(changed, "clone must tail-call rebuild"); + let errors = psrs_backend::mir::verify_module(&module).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.pass == "P9 MIR verification"), + "MIR boundary check must reject a changed tail target: {errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_checkpoint_ordering.rs b/crates/psrs-driver/src/tests/control_checkpoint_ordering.rs deleted file mode 100644 index 3a70f812..00000000 --- a/crates/psrs-driver/src/tests/control_checkpoint_ordering.rs +++ /dev/null @@ -1,46 +0,0 @@ -//! A correct checkpoint check must dominate the start of replay. -use super::control_checkpoints::{SOURCE, binding, mir_error}; -use psrs_backend::cc::ControlHelperRole as R; -use psrs_backend::mir::Instruction as I; - -#[test] -fn mir_rejects_a_correct_checkpoint_check_after_replay_has_started() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let executor = binding(&stages.cc.representations, R::Executor).0; - let check = binding(&stages.cc.representations, R::Check).1; - let clone = binding(&stages.cc.representations, R::CloneSequence).1; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let source = function - .blocks - .iter() - .enumerate() - .find_map(|(block, body)| { - body.instructions.iter().position(|instruction| - matches!(instruction, I::Call { contract: Some(id), .. } if *id == check)) - .map(|index| (block, index)) - }) - .unwrap(); - let instruction = function.blocks[source.0].instructions.remove(source.1); - let target = function - .blocks - .iter() - .enumerate() - .find_map(|(block, body)| { - body.instructions.iter().position(|instruction| - matches!(instruction, I::Call { contract: Some(id), .. } if *id == clone)) - .map(|index| (block, index)) - }) - .unwrap(); - function.blocks[target.0] - .instructions - .insert(target.1 + 1, instruction); - mir_error( - &stages.mir, - "check its saved checkpoint before construction or replay", - ); -} diff --git a/crates/psrs-driver/src/tests/control_checkpoints.rs b/crates/psrs-driver/src/tests/control_checkpoints.rs deleted file mode 100644 index baade113..00000000 --- a/crates/psrs-driver/src/tests/control_checkpoints.rs +++ /dev/null @@ -1,479 +0,0 @@ -//! Checkpoint identities are checked independently of physical reference types. -use psrs_backend::cc::{ - Assignment, AssignmentKind as A, ControlHelperId, ControlHelperRole as R, ValueId, -}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; - -pub(super) const SOURCE: &str = r"module Main where -import Prim.Control as C -data Op x = Op (Int -> x) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: state, _2: raw (k 42) } -main :: Int -main = (C.run 0 handler (C.perform (Op \x -> x)))._2 -"; - -fn cc_visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut A) -> bool) -> bool { - for assignment in body { - if mutate(&mut assignment.kind) { - return true; - } - match &mut assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - if cc_visit(&mut case.assignments, mutate) { - return true; - } - } - if cc_visit(default_assignments, mutate) { - return true; - } - } - A::If { - then_assignments, - else_assignments, - .. - } => { - if cc_visit(then_assignments, mutate) || cc_visit(else_assignments, mutate) { - return true; - } - } - _ => {} - } - } - false -} - -pub(super) fn binding( - table: &psrs_backend::cc::RepresentationTable, - role: R, -) -> (psrs_hir::SymbolId, ControlHelperId) { - let index = table - .control_helpers - .iter() - .position(|helper| helper.role() == role) - .unwrap(); - ( - table.control_helpers[index].function(), - ControlHelperId(index as u32), - ) -} - -fn cc_error(input: &psrs_backend::BackendInput, message: &str) { - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error.message.contains(message)), - "{errors:?}" - ); -} - -pub(super) fn mir_error(module: &psrs_backend::mir::Module, message: &str) { - let errors = psrs_backend::mir::verify_module(module).unwrap_err(); - assert!( - errors.iter().any(|error| error.message.contains(message)), - "{errors:?}" - ); -} - -fn mir_parameters(function: &psrs_backend::mir::Function) -> Vec { - let target = function - .blocks - .iter() - .find(|block| block.id == function.entry) - .and_then(|block| match &block.terminator { - Some(T::Jump { - target, arguments, .. - }) if arguments == &function.parameters => Some(*target), - _ => None, - }); - function - .blocks - .iter() - .find(|block| Some(block.id) == target) - .map_or_else( - || function.parameters.clone(), - |block| block.parameters.clone(), - ) -} - -#[test] -fn cc_rejects_missing_raw_resumption_binding() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - input.cc.representations.control_resumption = None; - cc_error(&input, "no valid raw resumption binding"); -} - -#[test] -fn cc_rejects_capturing_execution_extent_as_dispatch_checkpoint() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let raw = input - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let executor = binding(&input.cc.representations, R::Executor).0; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let wrong = function.parameters[4]; - assert!(cc_visit( - &mut function.assignments, - &mut |kind| match kind { - A::FunctionRef { - function, captures, .. - } if *function == raw => { - captures[1] = wrong; - true - } - _ => false, - } - )); - cc_error(&input, "current dispatch context checkpoint"); -} - -#[test] -fn mir_rejects_capturing_execution_extent_as_dispatch_checkpoint() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let raw = stages - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let executor = binding(&stages.cc.representations, R::Executor).0; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let wrong = mir_parameters(function)[4]; - let captures = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::ClosureNew { - function, captures, .. - } if *function == raw => Some(captures), - _ => None, - }) - .unwrap(); - captures[1] = wrong; - mir_error(&stages.mir, "current dispatch context checkpoint"); -} - -#[test] -fn cc_rejects_a_raw_frame_checkpoint_from_another_capture_slot() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let raw = input - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == raw) - .unwrap(); - let index = function - .assignments - .iter_mut() - .find_map(|assignment| match &mut assignment.kind { - A::ClosureGetCapture { index, .. } if *index == 1 => Some(index), - _ => None, - }) - .unwrap(); - *index = 2; - // Keep the ordinary dense capture contract valid, so this exercises identity. - let checkpoint = function - .assignments - .iter() - .find_map(|assignment| { - matches!(assignment.kind, A::ClosureGetCapture { index: 2, .. }) - .then_some(assignment.destination) - }) - .unwrap(); - let ty = function - .values - .iter() - .find(|declaration| declaration.id == checkpoint) - .unwrap() - .ty; - let unused = ValueId( - function - .values - .iter() - .map(|declaration| declaration.id.0) - .max() - .unwrap() - + 1, - ); - function - .values - .push(psrs_backend::cc::ValueDecl { id: unused, ty }); - function.assignments.insert( - 0, - Assignment { - destination: unused, - kind: A::ClosureGetCapture { - closure: function.parameters[0], - index: 1, - }, - span: function.span, - }, - ); - cc_error(&input, "its own queue and checkpoint capture slots"); -} - -#[test] -fn mir_rejects_a_raw_frame_checkpoint_from_another_capture_slot() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let raw = stages - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == raw) - .unwrap(); - let index = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::ClosureGetCapture { index, .. } if *index == 1 => Some(index), - _ => None, - }) - .unwrap(); - *index = 2; - mir_error(&stages.mir, "its own queue and checkpoint capture slots"); -} - -#[test] -fn cc_rejects_a_raw_frame_built_without_its_checkpoint_check() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let raw = input - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let check = binding(&input.cc.representations, R::Check).1; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == raw) - .unwrap(); - let count = function.assignments.len(); - function.assignments.retain(|assignment| !matches!(assignment.kind, A::DirectCall { contract: Some(id), .. } if id == check)); - assert_eq!(function.assignments.len(), count - 1); - cc_error( - &input, - "check its saved checkpoint before construction or replay", - ); -} - -#[test] -fn mir_rejects_a_raw_frame_built_without_its_checkpoint_check() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let raw = stages - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let check = binding(&stages.cc.representations, R::Check).1; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == raw) - .unwrap(); - let mut removed = 0; - for block in &mut function.blocks { - block.instructions.retain(|instruction| { - let remove = matches!(instruction, I::Call { contract: Some(id), .. } if *id == check); - removed += usize::from(remove); - !remove - }); - } - assert_eq!(removed, 1); - mir_error( - &stages.mir, - "check its saved checkpoint before construction or replay", - ); -} - -#[test] -fn cc_rejects_replay_checking_current_extent_instead_of_saved_checkpoint() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let executor = binding(&input.cc.representations, R::Executor).0; - let check = binding(&input.cc.representations, R::Check).1; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let wrong = function.parameters[4]; - assert!(cc_visit( - &mut function.assignments, - &mut |kind| match kind { - A::DirectCall { - contract: Some(id), - arguments, - .. - } if *id == check => { - arguments[0] = wrong; - true - } - _ => false, - } - )); - cc_error( - &input, - "check its saved checkpoint before construction or replay", - ); -} - -#[test] -fn mir_rejects_replay_checking_current_extent_instead_of_saved_checkpoint() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let executor = binding(&stages.cc.representations, R::Executor).0; - let check = binding(&stages.cc.representations, R::Check).1; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let wrong = mir_parameters(function)[4]; - let arguments = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::Call { - contract: Some(id), - arguments, - .. - } if *id == check => Some(arguments), - _ => None, - }) - .unwrap(); - arguments[0] = wrong; - mir_error( - &stages.mir, - "check its saved checkpoint before construction or replay", - ); -} - -#[test] -fn checked_checkpoint_reference_aliases_survive_physical_lowering() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let raw = input - .cc - .representations - .control_resumption - .as_ref() - .unwrap() - .function(); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == raw) - .unwrap(); - let checkpoint = function - .assignments - .iter() - .find_map(|assignment| { - matches!(assignment.kind, A::ClosureGetCapture { index: 1, .. }) - .then_some(assignment.destination) - }) - .unwrap(); - let declaration = function - .values - .iter() - .find(|declaration| declaration.id == checkpoint) - .unwrap() - .clone(); - let alias = ValueId( - function - .values - .iter() - .map(|declaration| declaration.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(psrs_backend::cc::ValueDecl { - id: alias, - ty: declaration.ty, - }); - let position = function - .assignments - .iter() - .position(|assignment| assignment.destination == checkpoint) - .unwrap() - + 1; - function.assignments.insert( - position, - Assignment { - destination: alias, - kind: A::AggregateConvert { - destination: alias, - value: checkpoint, - conversion: psrs_backend::cc::AggregateConvert { - source: declaration.ty, - destination: declaration.ty, - plan: psrs_backend::cc::ValueConversion::Identity, - }, - }, - span: function.span, - }, - ); - for assignment in &mut function.assignments[position + 1..] { - match &mut assignment.kind { - A::DirectCall { arguments, .. } => { - for argument in arguments { - if *argument == checkpoint { - *argument = alias - } - } - } - A::VariantNew { fields, .. } => { - for field in fields { - if *field == checkpoint { - *field = alias - } - } - } - _ => {} - } - } - psrs_backend::cc::verify_module(&input.cc).unwrap(); - psrs_backend::compile_cc(input).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/control_clause_selection.rs b/crates/psrs-driver/src/tests/control_clause_selection.rs deleted file mode 100644 index 96f4d9ed..00000000 --- a/crates/psrs-driver/src/tests/control_clause_selection.rs +++ /dev/null @@ -1,252 +0,0 @@ -//! A source return or operation must apply its own scoped clause. -use super::control_checkpoints::{SOURCE, binding}; -use super::control_dispatch::{carrier_repr, visit}; -use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R, ValueId}; -use psrs_backend::mir::{BlockId, Function, Instruction as I, Terminator as T}; -use psrs_backend::types::DefinedTypeId; -use std::collections::{HashSet, VecDeque}; - -fn successors(terminator: &T) -> Vec { - match terminator { - T::Jump { target, .. } => vec![*target], - T::Branch { - then_block, - else_block, - .. - } => vec![*then_block, *else_block], - T::Switch { cases, default, .. } => cases - .iter() - .map(|(_, target)| *target) - .chain(std::iter::once(*default)) - .collect(), - _ => Vec::new(), - } -} - -/// Blocks of one input-dispatch arm, excluding the dispatch header itself. -fn arm(function: &Function, dispatch: BlockId, target: BlockId) -> HashSet { - let mut seen = HashSet::new(); - let mut pending = VecDeque::from([target]); - while let Some(id) = pending.pop_front() { - if id == dispatch || !seen.insert(id) { - continue; - } - if let Some(terminator) = function - .blocks - .iter() - .find(|block| block.id == id) - .and_then(|block| block.terminator.as_ref()) - { - for successor in successors(terminator) { - if successor != dispatch { - pending.push_back(successor); - } - } - } - } - seen -} - -/// The base type named by a switch's `i32` selector. -fn selector_base(function: &Function, value: ValueId) -> Option { - function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::StructGet { - destination, - field: 0, - type_index, - .. - } if *destination == value => Some(*type_index), - _ => None, - }) -} - -fn executor(function: &Function) -> (BlockId, Vec<(i32, BlockId)>) { - function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Switch { cases, .. }) => { - let mut tags = cases.iter().map(|(tag, _)| *tag).collect::>(); - tags.sort_unstable(); - (tags == vec![0, 1, 2, 3, 4, 5]).then(|| (block.id, cases.clone())) - } - _ => None, - }) - .expect("executor input dispatch") -} - -/// Interprets the source step `tag` and rewires its scoped clause projection -/// from `from` to `to`. -fn check_clause(source_tag: i32, from: u32, to: u32, message: &str) { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let module = crate::compile_main_stages(SOURCE).unwrap().mir; - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut broken = module.clone(); - let flat = broken - .types - .iter() - .flat_map(|group| group.0.iter().cloned()) - .collect::>(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let (dispatch, cases) = executor(function); - let target = cases - .iter() - .find(|(tag, _)| *tag == source_tag) - .map(|(_, block)| *block) - .unwrap(); - let arm = arm(function, dispatch, target); - // The scoped context clause is projected from the context case of the - // context dispatch inside this arm. - let scoped = function - .blocks - .iter() - .filter(|block| arm.contains(&block.id)) - .find_map(|block| match &block.terminator { - Some(T::Switch { value, cases, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() == vec![0, 1] => - { - let base = selector_base(function, *value)?; - flat.iter() - .enumerate() - .filter(|(_, ty)| ty.supertype == Some(base)) - .max_by_key(|(_, ty)| match &ty.composite { - psrs_backend::types::CompositeType::Struct(fields) => fields.len(), - _ => 0, - }) - .map(|(index, _)| DefinedTypeId(index as u32)) - } - _ => None, - }) - .expect("scoped context case"); - let location = function - .blocks - .iter() - .enumerate() - .find_map(|(block_index, block)| { - if !arm.contains(&block.id) { - return None; - } - block - .instructions - .iter() - .enumerate() - .find_map(|(index, instruction)| match instruction { - I::StructGet { - type_index, field, .. - } if *type_index == scoped && *field == from => Some((block_index, index)), - _ => None, - }) - }) - .expect("scoped clause projection"); - let I::StructGet { field, .. } = &mut function.blocks[location.0].instructions[location.1] - else { - unreachable!() - }; - *field = to; - let errors = psrs_backend::mir::verify_module(&broken).expect_err("wrong clause"); - assert!( - errors.iter().any(|error| error.message.contains(message)), - "{errors:?}" - ); -} - -#[test] -fn cc_source_return_applies_its_own_return_clause() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let context = carrier_repr(table, R::Executor, 5); - let (symbol, _) = binding(table, R::Executor); - let mut broken = input.cc.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let changed = visit(&mut function.assignments, &mut |assignment| { - let A::VariantGet { - representation, - case: 1, - field, - .. - } = &mut assignment.kind - else { - return false; - }; - if *representation == context && *field == 0 { - *field = 1; - true - } else { - false - } - }); - assert!(changed, "return clause projection"); - let errors = psrs_backend::cc::verify_module(&broken).expect_err("wrong return clause"); - assert!( - errors.iter().any(|error| error - .message - .contains("source return must apply its scoped return clause")), - "{errors:?}" - ); -} - -#[test] -fn cc_source_operation_applies_its_own_operation_clause() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let context = carrier_repr(table, R::Executor, 5); - let (symbol, _) = binding(table, R::Executor); - let mut broken = input.cc.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let changed = visit(&mut function.assignments, &mut |assignment| { - let A::VariantGet { - representation, - case: 1, - field, - .. - } = &mut assignment.kind - else { - return false; - }; - if *representation == context && *field == 1 { - *field = 0; - true - } else { - false - } - }); - assert!(changed, "operation clause projection"); - let errors = psrs_backend::cc::verify_module(&broken).expect_err("wrong operation clause"); - assert!( - errors.iter().any(|error| error - .message - .contains("source operation must apply its scoped operation clause")), - "{errors:?}" - ); -} - -#[test] -fn mir_source_return_applies_its_own_return_clause() { - check_clause(0, 1, 2, "source return must apply its scoped return clause"); -} - -#[test] -fn mir_source_operation_applies_its_own_operation_clause() { - check_clause( - 1, - 2, - 1, - "source operation must apply its scoped operation clause", - ); -} diff --git a/crates/psrs-driver/src/tests/control_clause_steps.rs b/crates/psrs-driver/src/tests/control_clause_steps.rs deleted file mode 100644 index 91173cd3..00000000 --- a/crates/psrs-driver/src/tests/control_clause_steps.rs +++ /dev/null @@ -1,404 +0,0 @@ -//! Required scoped steps consume their payload and feed the next computation. -use super::control_checkpoints::{SOURCE, binding}; -use super::control_dispatch::{carrier_repr, visit}; -use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; - -#[derive(Clone, Copy)] -enum Mutation { - Omit, - Payload, - Discard, - Resumption, - DeadCall, - State, - RootHandler, -} - -fn cc_step(tag: i32, mutation: Mutation, message: &str) { - let mut module = crate::lower_main_to_cc(SOURCE).unwrap().cc; - let context = carrier_repr(&module.representations, R::Executor, 5); - let (symbol, _) = binding(&module.representations, R::Executor); - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let parameters = function.parameters.clone(); - let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { - panic!("input dispatch") - }; - let arm = &mut cases - .iter_mut() - .find(|case| case.tag == tag) - .unwrap() - .assignments; - // Locate the current context's scoped branch through its tag projection. - let mut selector = None; - visit(arm, &mut |a| { - if let A::VariantTag { representation, .. } = a.kind - && representation == context - { - selector = Some(a.destination); - return true; - } - false - }); - let selector = selector.unwrap(); - let changed = visit(arm, &mut |a| { - let A::TagSwitch { value, cases, .. } = &mut a.kind else { - return false; - }; - if *value != selector { - return false; - } - let scoped = cases.iter_mut().find(|case| case.tag == 1).unwrap(); - match mutation { - Mutation::DeadCall => unreachable!("MIR-only mutation"), - Mutation::State | Mutation::RootHandler => { - let A::IndirectCall { - function: callee, - arguments: operands, - .. - } = &scoped - .assignments - .iter() - .find(|a| matches!(a.kind, A::IndirectCall { .. })) - .unwrap() - .kind - else { - unreachable!() - }; - let (index, operand) = if matches!(mutation, Mutation::State) { - (0, operands[0]) - } else { - (1, *callee) - }; - let A::DirectCall { arguments, .. } = &mut scoped - .assignments - .iter_mut() - .find(|a| a.destination == scoped.value) - .unwrap() - .kind - else { - panic!("executor transition") - }; - arguments[index] = operand; - } - Mutation::Resumption => { - let A::IndirectCall { arguments, .. } = &mut scoped - .assignments - .iter_mut() - .rfind(|a| matches!(a.kind, A::IndirectCall { .. })) - .unwrap() - .kind - else { - unreachable!() - }; - arguments[0] = parameters[0]; - } - Mutation::Discard => { - let A::DirectCall { arguments, .. } = &mut scoped - .assignments - .iter_mut() - .find(|a| a.destination == scoped.value) - .unwrap() - .kind - else { - panic!("executor transition") - }; - arguments[2] = parameters[2]; - } - Mutation::Payload => { - let A::IndirectCall { arguments, .. } = &mut scoped - .assignments - .iter_mut() - .find(|a| matches!(a.kind, A::IndirectCall { .. })) - .unwrap() - .kind - else { - unreachable!() - }; - arguments[0] = parameters[0]; - } - Mutation::Omit => { - let call = scoped - .assignments - .iter_mut() - .find(|a| matches!(a.kind, A::IndirectCall { .. })) - .unwrap(); - let A::IndirectCall { arguments, .. } = &call.kind else { - unreachable!() - }; - // A well-typed erased-value copy replaces the invocation. - let reference = match function - .values - .iter() - .find(|v| v.id == call.destination) - .unwrap() - .ty - { - psrs_backend::cc::ValueShape::Reference(reference) => reference, - _ => panic!("erased call result"), - }; - call.kind = A::RepresentationCast { - destination: call.destination, - value: arguments[0], - reference, - }; - } - } - true - }); - assert!(changed); - let errors = psrs_backend::cc::verify_module(&module).expect_err("broken scoped step"); - assert!( - errors.iter().any(|e| e.message.contains(message)), - "{errors:?}" - ); -} - -fn mir_step(tag: i32, mutation: Mutation, message: &str) { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let (dispatch, target) = function - .blocks - .iter() - .find_map(|b| match &b.terminator { - Some(T::Switch { cases, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() - == vec![0, 1, 2, 3, 4, 5] => - { - Some((b.id, cases.iter().find(|(t, _)| *t == tag).unwrap().1)) - } - _ => None, - }) - .unwrap(); - let mut pending = vec![target]; - let mut seen = std::collections::HashSet::new(); - let mut scoped = None; - while let Some(id) = pending.pop() { - if id == dispatch || !seen.insert(id) { - continue; - } - let b = function.blocks.iter().find(|b| b.id == id).unwrap(); - match &b.terminator { - Some(T::Switch { cases, default, .. }) => { - if cases.iter().map(|(t, _)| *t).collect::>() == vec![0, 1] { - scoped = cases.iter().find(|(t, _)| *t == 1).map(|(_, id)| *id); - break; - } - pending.extend(cases.iter().map(|(_, id)| *id)); - pending.push(*default); - } - Some(T::Jump { target, .. }) => pending.push(*target), - _ => {} - } - } - let scoped = scoped.unwrap(); - let block = function.blocks.iter_mut().find(|b| b.id == scoped).unwrap(); - match mutation { - Mutation::State | Mutation::RootHandler => { - let I::ClosureCall { - function: callee, - arguments: operands, - .. - } = block - .instructions - .iter() - .find(|i| matches!(i, I::ClosureCall { .. })) - .unwrap() - else { - unreachable!() - }; - let (index, operand) = if matches!(mutation, Mutation::State) { - (0, operands[0]) - } else { - (1, *callee) - }; - let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { - panic!("loop transition") - }; - arguments[index] = operand; - } - Mutation::DeadCall => { - let index = block - .instructions - .iter() - .position(|i| matches!(i, I::ClosureCall { .. })) - .unwrap(); - let call = block.instructions.remove(index); - let id = psrs_backend::mir::BlockId( - function.blocks.iter().map(|b| b.id.0).max().unwrap() + 1, - ); - function.blocks.push(psrs_backend::mir::BasicBlock { - id, - parameters: vec![], - instructions: vec![call], - terminator: Some(T::Trap { - span: function.span, - }), - }); - } - Mutation::Resumption => { - let I::ClosureCall { arguments, .. } = block - .instructions - .iter_mut() - .rfind(|i| matches!(i, I::ClosureCall { .. })) - .unwrap() - else { - unreachable!() - }; - arguments[0] = function.parameters[0]; - } - Mutation::Discard => { - let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { - panic!("loop transition") - }; - arguments[2] = function.parameters[2]; - } - Mutation::Payload => { - let I::ClosureCall { arguments, .. } = block - .instructions - .iter_mut() - .find(|i| matches!(i, I::ClosureCall { .. })) - .unwrap() - else { - unreachable!() - }; - arguments[0] = function.parameters[0]; - } - Mutation::Omit => { - let call = block - .instructions - .iter_mut() - .find(|i| matches!(i, I::ClosureCall { .. })) - .unwrap(); - let I::ClosureCall { - destination, - arguments, - span, - .. - } = call - else { - unreachable!() - }; - *call = I::Copy { - destination: *destination, - value: arguments[0], - span: *span, - }; - } - } - let errors = psrs_backend::mir::verify_module(&module).expect_err("broken scoped step"); - assert!( - errors.iter().any(|e| e.message.contains(message)), - "{errors:?}" - ); -} - -#[test] -fn cc_scoped_steps_require_the_clause_application_result() { - for tag in [0, 1] { - for mutation in [Mutation::Omit, Mutation::Discard] { - cc_step( - tag, - mutation, - "source clause result must enter the next executor step", - ); - } - } -} -#[test] -fn mir_scoped_steps_require_the_clause_application_result() { - for tag in [0, 1] { - for mutation in [Mutation::Omit, Mutation::Discard] { - mir_step( - tag, - mutation, - "source clause result must enter the next executor step", - ); - } - } -} -#[test] -fn cc_scoped_steps_consume_the_current_source_payload() { - for tag in [0, 1] { - cc_step( - tag, - Mutation::Payload, - "source clause must consume the current computation payload", - ); - } -} -#[test] -fn mir_scoped_steps_consume_the_current_source_payload() { - for tag in [0, 1] { - mir_step( - tag, - Mutation::Payload, - "source clause must consume the current computation payload", - ); - } -} - -#[test] -fn cc_operation_step_supplies_the_raw_resumption() { - cc_step( - 1, - Mutation::Resumption, - "source operation clause must receive its raw resumption", - ); -} - -#[test] -fn mir_operation_step_supplies_the_raw_resumption() { - mir_step( - 1, - Mutation::Resumption, - "source operation clause must receive its raw resumption", - ); -} - -#[test] -fn mir_scoped_step_cannot_use_a_clause_call_from_a_dead_block() { - for tag in [0, 1] { - mir_step( - tag, - Mutation::DeadCall, - "source clause application must execute in its scoped step", - ); - } -} - -#[test] -fn cc_scoped_steps_preserve_state_and_root_handler() { - for tag in [0, 1] { - for mutation in [Mutation::State, Mutation::RootHandler] { - cc_step( - tag, - mutation, - "source clause transition must preserve its state and root handler", - ); - } - } -} - -#[test] -fn mir_scoped_steps_preserve_state_and_root_handler() { - for tag in [0, 1] { - for mutation in [Mutation::State, Mutation::RootHandler] { - mir_step( - tag, - mutation, - "source clause transition must preserve its state and root handler", - ); - } - } -} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/aliases.rs b/crates/psrs-driver/src/tests/control_context_contracts/aliases.rs deleted file mode 100644 index 2e846e5e..00000000 --- a/crates/psrs-driver/src/tests/control_context_contracts/aliases.rs +++ /dev/null @@ -1,74 +0,0 @@ -//! A dispatch join retains identity through an ordinary SSA copy. -use super::{R, SOURCE, binding}; -use psrs_backend::cc::ValueId; -use psrs_backend::mir::{Instruction as I, Terminator as T}; - -#[test] -fn dispatch_parent_join_accepts_reference_identity_copies() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let executor = binding(&stages.cc.representations, R::Executor).0; - let clone = binding(&stages.cc.representations, R::CloneSequence).1; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let parent = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::Call { - contract: Some(id), - arguments, - .. - } if *id == clone => Some(arguments[4]), - _ => None, - }) - .unwrap(); - let (target, index) = function - .blocks - .iter() - .find_map(|block| { - block - .parameters - .iter() - .position(|parameter| *parameter == parent) - .map(|index| (block.id, index)) - }) - .unwrap(); - let source_block = function.blocks.iter().position(|block| matches!(&block.terminator, Some(T::Jump { target: next, .. }) if *next == target)).unwrap(); - let Some(T::Jump { arguments, .. }) = &function.blocks[source_block].terminator else { - unreachable!() - }; - let value = arguments[index]; - let ty = function - .values - .iter() - .find(|declaration| declaration.id == value) - .unwrap() - .ty; - let alias = ValueId( - function - .values - .iter() - .map(|declaration| declaration.id.0) - .max() - .unwrap() - + 1, - ); - function - .values - .push(psrs_backend::types::ValueDecl { id: alias, ty }); - function.blocks[source_block].instructions.push(I::Copy { - destination: alias, - value, - span: function.span, - }); - let Some(T::Jump { arguments, .. }) = &mut function.blocks[source_block].terminator else { - unreachable!() - }; - arguments[index] = alias; - psrs_backend::mir::verify_module(&stages.mir).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/cc.rs b/crates/psrs-driver/src/tests/control_context_contracts/cc.rs deleted file mode 100644 index 05490315..00000000 --- a/crates/psrs-driver/src/tests/control_context_contracts/cc.rs +++ /dev/null @@ -1,200 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, RefShape, ValueId, ValueShape}; -use std::collections::HashMap; - -fn index(body: &[Assignment], definitions: &mut HashMap) { - for assignment in body { - definitions.insert(assignment.destination, assignment.kind.clone()); - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &assignment.kind - { - for case in cases { - index(&case.assignments, definitions); - } - index(default_assignments, definitions); - } - } -} -fn visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut Assignment) -> bool) -> bool { - for assignment in body { - if mutate(assignment) { - return true; - } - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &mut assignment.kind - { - for case in cases { - if visit(&mut case.assignments, mutate) { - return true; - } - } - if visit(default_assignments, mutate) { - return true; - } - } - } - false -} - -pub(super) fn reject(mutation: Mutation) { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let symbol = binding(&input.cc.representations, mutation.role()).0; - let clone = binding(&input.cc.representations, R::CloneSequence).1; - let executor = binding(&input.cc.representations, R::Executor).1; - let signature = input - .cc - .representations - .signature(input.cc.representations.control_helpers[executor.0 as usize].signature()) - .unwrap(); - let repr = |shape| match shape { - ValueShape::Reference(reference) => match reference.heap { - RefShape::Repr(id) => id, - _ => unreachable!(), - }, - _ => unreachable!(), - }; - let context = repr(signature.parameters[5]); - let sequence = repr(signature.parameters[3]); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let parameters = function.parameters.clone(); - let mut definitions = HashMap::new(); - index(&function.assignments, &mut definitions); - let context_extent = |value| matches!(definitions.get(&value), Some(A::VariantGet { representation, case: 1, field: 5, .. }) if *representation == context); - let target_finish = definitions.iter().find_map(|(value, kind)| match kind { - A::VariantNew { - representation, - case: 3, - fields, - .. - } if *representation == sequence && context_extent(fields[0]) => Some(*value), - _ => None, - }); - let changed = visit( - &mut function.assignments, - &mut |assignment| match mutation { - Mutation::FinishExtent | Mutation::FinishQueue | Mutation::FinishParent => { - if Some(assignment.destination) != target_finish { - return false; - } - let A::VariantNew { fields, .. } = &mut assignment.kind else { - unreachable!() - }; - match mutation { - Mutation::FinishExtent => fields[0] = parameters[4], - Mutation::FinishQueue => fields[1] = parameters[3], - Mutation::FinishParent => fields[2] = parameters[4], - _ => unreachable!(), - } - true - } - Mutation::CallerContext => match &mut assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == symbol && Some(arguments[3]) == target_finish => { - arguments[5] = parameters[5]; - true - } - _ => false, - }, - Mutation::CopyParent => match &mut assignment.kind { - A::VariantNew { - representation, - case: 3, - fields, - .. - } if *representation == sequence && !context_extent(fields[0]) => { - fields[2] = parameters[4]; - true - } - _ => false, - }, - Mutation::CopyOrder => match &mut assignment.kind { - A::VariantNew { - representation, - case: 2, - fields, - .. - } if *representation == sequence - && matches!( - definitions.get(&fields[0]), - Some(A::VariantGet { - case: 3, - field: 1, - .. - }) - ) => - { - fields.swap(0, 1); - true - } - _ => false, - }, - Mutation::SeedParent | Mutation::SeedActive | Mutation::SeedAccumulator => { - match &mut assignment.kind { - A::DirectCall { - contract: Some(id), - arguments, - .. - } if *id == clone => { - match mutation { - Mutation::SeedParent => arguments[4] = parameters[4], - Mutation::SeedActive => arguments[3] = arguments[4], - Mutation::SeedAccumulator => arguments[1] = arguments[0], - _ => unreachable!(), - } - true - } - _ => false, - } - } - Mutation::CloneForward => match &mut assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == symbol => { - arguments[4] = parameters[3]; - true - } - _ => false, - }, - Mutation::CallbackForward => match &mut assignment.kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == symbol - && matches!( - definitions.get(&arguments[1]), - Some(A::VariantNew { case: 1, .. }) - ) => - { - arguments[3] = parameters[2]; - true - } - _ => false, - }, - }, - ); - assert!(changed); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/mir.rs b/crates/psrs-driver/src/tests/control_context_contracts/mir.rs deleted file mode 100644 index 98b0bbd0..00000000 --- a/crates/psrs-driver/src/tests/control_context_contracts/mir.rs +++ /dev/null @@ -1,197 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::ValueId; -use psrs_backend::mir::{Instruction as I, Terminator as T}; -use std::collections::HashMap; - -pub(super) fn reject(mutation: Mutation) { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let symbol = binding(&stages.cc.representations, mutation.role()).0; - let clone = binding(&stages.cc.representations, R::CloneSequence).1; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let entry = function - .blocks - .iter() - .find(|block| block.id == function.entry) - .unwrap(); - let Some(T::Jump { - target: header, - arguments, - .. - }) = &entry.terminator - else { - unreachable!() - }; - assert_eq!(arguments, &function.parameters); - let header = *header; - let parameters = function - .blocks - .iter() - .find(|block| block.id == header) - .unwrap() - .parameters - .clone(); - let definitions = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| { - instruction - .destination() - .map(|destination| (destination, instruction.clone())) - }) - .collect::>(); - let origin = |mut value: ValueId| { - for _ in 0..definitions.len() { - match definitions.get(&value) { - Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { - value = *source - } - _ => break, - } - } - value - }; - let context_extent = |value| matches!(definitions.get(&origin(value)), Some(I::StructGet { field: 6, value, .. }) if origin(*value) == parameters[5]); - let target_finish = if parameters.len() == 6 { - definitions - .iter() - .find_map(|(value, instruction)| match instruction { - I::StructNew { arguments, .. } - if arguments.len() == 4 && context_extent(arguments[1]) => - { - Some(*value) - } - _ => None, - }) - } else { - None - }; - let copied_append = if matches!(mutation, Mutation::CopyOrder) { - definitions - .values() - .find_map(|instruction| match instruction { - I::StructNew { arguments, .. } - if arguments.len() == 4 && !context_extent(arguments[1]) => - { - Some(origin(arguments[2])) - } - _ => None, - }) - } else { - None - }; - let mut changed = false; - match mutation { - Mutation::FinishExtent - | Mutation::FinishQueue - | Mutation::FinishParent - | Mutation::CopyParent - | Mutation::CopyOrder => { - for instruction in function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - { - let I::StructNew { - destination, - arguments, - .. - } = instruction - else { - continue; - }; - let target = match mutation { - Mutation::CopyParent => arguments.len() == 4 && !context_extent(arguments[1]), - Mutation::CopyOrder => Some(*destination) == copied_append, - _ => Some(*destination) == target_finish, - }; - if !target { - continue; - } - match mutation { - Mutation::FinishExtent => arguments[1] = parameters[4], - Mutation::FinishQueue => arguments[2] = parameters[3], - Mutation::FinishParent | Mutation::CopyParent => arguments[3] = parameters[4], - Mutation::CopyOrder => arguments.swap(1, 2), - _ => unreachable!(), - } - changed = true; - break; - } - } - Mutation::SeedParent | Mutation::SeedActive | Mutation::SeedAccumulator => { - for instruction in function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - { - if let I::Call { - contract: Some(id), - arguments, - .. - } = instruction - { - if *id != clone { - continue; - } - match mutation { - Mutation::SeedParent => arguments[4] = parameters[4], - Mutation::SeedActive => arguments[3] = arguments[4], - Mutation::SeedAccumulator => arguments[1] = arguments[0], - _ => unreachable!(), - } - changed = true; - break; - } - } - } - Mutation::CallerContext | Mutation::CloneForward | Mutation::CallbackForward => { - for block in &mut function.blocks { - if block.id == function.entry { - continue; - } - let Some(T::Jump { - target, arguments, .. - }) = &mut block.terminator - else { - continue; - }; - if *target != header { - continue; - } - let target = match mutation { - Mutation::CallerContext => Some(origin(arguments[3])) == target_finish, - Mutation::CloneForward => true, - Mutation::CallbackForward => { - matches!(definitions.get(&origin(arguments[1])), Some(I::StructNew { arguments, .. }) if arguments.len() == 3 && matches!(definitions.get(&origin(arguments[1])), Some(I::StructGet { field: 1, .. }))) - } - _ => unreachable!(), - }; - if !target { - continue; - } - match mutation { - Mutation::CallerContext => arguments[5] = parameters[5], - Mutation::CloneForward => arguments[4] = parameters[3], - Mutation::CallbackForward => arguments[3] = parameters[2], - _ => unreachable!(), - } - changed = true; - break; - } - } - } - assert!(changed); - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_context_contracts/mod.rs b/crates/psrs-driver/src/tests/control_context_contracts/mod.rs deleted file mode 100644 index aaa154f8..00000000 --- a/crates/psrs-driver/src/tests/control_context_contracts/mod.rs +++ /dev/null @@ -1,136 +0,0 @@ -//! Verify completion context creation and replay ancestry seeding/propagation. -mod aliases; -mod cc; -mod mir; -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::ControlHelperRole as R; - -#[derive(Clone, Copy)] -enum Mutation { - FinishExtent, - FinishQueue, - FinishParent, - CallerContext, - CopyParent, - CopyOrder, - SeedParent, - SeedActive, - SeedAccumulator, - CloneForward, - CallbackForward, -} -impl Mutation { - fn role(self) -> R { - match self { - Self::CloneForward => R::CloneSequence, - Self::CallbackForward => R::RebuildSequence, - _ => R::Executor, - } - } - fn message(self) -> &'static str { - match self { - Self::FinishExtent => "finish copy must preserve its original extent", - Self::FinishQueue | Self::FinishParent => { - "target finish must preserve its source context" - } - Self::CallerContext => "enter its caller context with the saved extent", - Self::CopyParent => "finish copy must preserve its original parent", - Self::CopyOrder => "finish copy must reassociate the original queue", - Self::SeedParent => "replay parent must select its current dispatch context", - Self::SeedActive => "start with its current execution extent", - Self::SeedAccumulator => "start with empty traversal accumulators", - Self::CloneForward => { - "clone traversal must preserve its accumulators, active extent and parent" - } - Self::CallbackForward => "callback rebuild must preserve its active extent and parent", - } - } -} -#[test] -fn cc_target_finish_uses_its_context_extent() { - cc::reject(Mutation::FinishExtent); -} -#[test] -fn mir_target_finish_uses_its_context_extent() { - mir::reject(Mutation::FinishExtent); -} -#[test] -fn cc_target_finish_uses_its_context_queue() { - cc::reject(Mutation::FinishQueue); -} -#[test] -fn mir_target_finish_uses_its_context_queue() { - mir::reject(Mutation::FinishQueue); -} -#[test] -fn cc_target_finish_uses_its_context_parent() { - cc::reject(Mutation::FinishParent); -} -#[test] -fn mir_target_finish_uses_its_context_parent() { - mir::reject(Mutation::FinishParent); -} -#[test] -fn cc_target_finish_enters_its_caller_context() { - cc::reject(Mutation::CallerContext); -} -#[test] -fn mir_target_finish_enters_its_caller_context() { - mir::reject(Mutation::CallerContext); -} -#[test] -fn cc_finish_copy_preserves_its_parent() { - cc::reject(Mutation::CopyParent); -} -#[test] -fn mir_finish_copy_preserves_its_parent() { - mir::reject(Mutation::CopyParent); -} -#[test] -fn cc_finish_copy_preserves_append_order() { - cc::reject(Mutation::CopyOrder); -} -#[test] -fn mir_finish_copy_preserves_append_order() { - mir::reject(Mutation::CopyOrder); -} -#[test] -fn cc_replay_parent_comes_from_dispatch() { - cc::reject(Mutation::SeedParent); -} -#[test] -fn mir_replay_parent_comes_from_dispatch() { - mir::reject(Mutation::SeedParent); -} -#[test] -fn cc_replay_starts_with_current_active_extent() { - cc::reject(Mutation::SeedActive); -} -#[test] -fn mir_replay_starts_with_current_active_extent() { - mir::reject(Mutation::SeedActive); -} -#[test] -fn cc_replay_starts_with_empty_accumulators() { - cc::reject(Mutation::SeedAccumulator); -} -#[test] -fn mir_replay_starts_with_empty_accumulators() { - mir::reject(Mutation::SeedAccumulator); -} -#[test] -fn cc_clone_preserves_parent_during_traversal() { - cc::reject(Mutation::CloneForward); -} -#[test] -fn mir_clone_preserves_parent_during_traversal() { - mir::reject(Mutation::CloneForward); -} -#[test] -fn cc_callback_rebuild_preserves_parent() { - cc::reject(Mutation::CallbackForward); -} -#[test] -fn mir_callback_rebuild_preserves_parent() { - mir::reject(Mutation::CallbackForward); -} diff --git a/crates/psrs-driver/src/tests/control_context_entry/aliases.rs b/crates/psrs-driver/src/tests/control_context_entry/aliases.rs deleted file mode 100644 index 77876ae0..00000000 --- a/crates/psrs-driver/src/tests/control_context_entry/aliases.rs +++ /dev/null @@ -1,111 +0,0 @@ -//! Transparent aliases preserve the caller identity at source context entry. -use super::{R, SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueId, ValueShape}; -use psrs_backend::mir::Instruction as I; - -fn alias_fields(body: &mut [Assignment], original: ValueId, alias: ValueId) -> bool { - for assignment in body { - match &mut assignment.kind { - A::VariantNew { - case: 1, fields, .. - } if fields.len() == 6 && fields[4] == original => { - fields[4] = alias; - return true; - } - A::TagSwitch { cases, .. } => { - for case in cases { - if alias_fields(&mut case.assignments, original, alias) { - return true; - } - } - } - _ => {} - } - } - false -} - -#[test] -fn cc_source_context_accepts_a_reference_alias_of_its_caller() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let symbol = binding(&input.cc.representations, R::Executor).0; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let original = function.parameters[5]; - let ty = function - .values - .iter() - .find(|value| value.id == original) - .unwrap() - .ty; - let ValueShape::Reference(reference) = ty else { - unreachable!() - }; - let alias = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function - .values - .push(psrs_backend::cc::ValueDecl { id: alias, ty }); - function.assignments.insert( - 0, - Assignment { - destination: alias, - kind: A::RepresentationCast { - destination: alias, - value: original, - reference, - }, - span: function.span, - }, - ); - assert!(alias_fields(&mut function.assignments, original, alias)); - psrs_backend::cc::verify_module(&input.cc).unwrap(); - psrs_backend::compile_cc(input).unwrap(); -} - -#[test] -fn mir_source_context_accepts_a_copy_of_its_caller() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let symbol = binding(&stages.cc.representations, R::Executor).0; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let alias = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let mut changed = false; - for block in &mut function.blocks { - if let Some(index) = block.instructions.iter().position(|instruction| matches!(instruction, I::StructNew { arguments, .. } if arguments.len() == 7)) { - let I::StructNew { arguments, .. } = &mut block.instructions[index] else { unreachable!() }; - let original = arguments[5]; - let ty = function.values.iter().find(|value| value.id == original).unwrap().ty; - function.values.push(psrs_backend::types::ValueDecl { id: alias, ty }); - arguments[5] = alias; - block.instructions.insert(index, I::Copy { destination: alias, value: original, span: function.span }); - changed = true; - break; - } - } - assert!(changed); - psrs_backend::mir::verify_module(&stages.mir).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/control_context_entry/cc.rs b/crates/psrs-driver/src/tests/control_context_entry/cc.rs deleted file mode 100644 index 5bd5d3c4..00000000 --- a/crates/psrs-driver/src/tests/control_context_entry/cc.rs +++ /dev/null @@ -1,195 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, RefShape, ValueId, ValueShape}; -use std::collections::HashMap; - -fn index(body: &[Assignment], definitions: &mut HashMap) { - for assignment in body { - definitions.insert(assignment.destination, assignment.kind.clone()); - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &assignment.kind - { - for case in cases { - index(&case.assignments, definitions); - } - index(default_assignments, definitions); - } - } -} -fn visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut Assignment) -> bool) -> bool { - for assignment in body { - if mutate(assignment) { - return true; - } - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &mut assignment.kind - { - for case in cases { - if visit(&mut case.assignments, mutate) { - return true; - } - } - if visit(default_assignments, mutate) { - return true; - } - } - } - false -} - -pub(super) fn reject(mutation: Mutation) { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, id) = binding(&input.cc.representations, R::Executor); - let signature = input - .cc - .representations - .signature(input.cc.representations.control_helpers[id.0 as usize].signature()) - .unwrap(); - let ValueShape::Reference(reference) = signature.parameters[5] else { - unreachable!() - }; - let RefShape::Repr(context) = reference.heap else { - unreachable!() - }; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let parameters = function.parameters.clone(); - let mut definitions = HashMap::new(); - index(&function.assignments, &mut definitions); - let tail = |fields: &[ValueId]| { - matches!( - definitions.get(&fields[5]), - Some(A::VariantGet { - case: 3, - field: 0, - .. - }) - ) - }; - let context_value = definitions - .iter() - .find_map(|(value, kind)| match kind { - A::VariantNew { - representation, - case: 1, - fields, - .. - } if *representation == context && !tail(fields) => Some(*value), - _ => None, - }) - .unwrap(); - let status = match &definitions[&context_value] { - A::VariantNew { fields, .. } => match &definitions[&fields[5]] { - A::VariantNew { fields, .. } => fields[0], - _ => unreachable!(), - }, - _ => unreachable!(), - }; - let caller = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - if matches!(mutation, Mutation::Caller) { - function.values.push(psrs_backend::cc::ValueDecl { - id: caller, - ty: signature.parameters[5], - }); - function.assignments.insert( - 0, - Assignment { - destination: caller, - kind: A::VariantGet { - destination: caller, - representation: context, - case: 1, - field: 4, - value: parameters[5], - }, - span: function.span, - }, - ); - } - let changed = visit(&mut function.assignments, &mut |assignment| { - match mutation { - Mutation::Caller - | Mutation::Clauses - | Mutation::TailQueue - | Mutation::TailParent - | Mutation::TailExtent => { - let A::VariantNew { - representation, - case: 1, - fields, - .. - } = &mut assignment.kind - else { - return false; - }; - if *representation != context { - return false; - } - match mutation { - Mutation::Caller => fields[4] = caller, - Mutation::Clauses => fields.swap(0, 1), - _ if !tail(fields) => return false, - Mutation::TailQueue => fields[2] = parameters[3], - Mutation::TailParent => fields[3] = parameters[4], - Mutation::TailExtent => fields[5] = parameters[4], - _ => unreachable!(), - } - } - Mutation::Status => { - if assignment.destination != status { - return false; - } - let A::ArrayNew { elements, .. } = &mut assignment.kind else { - unreachable!() - }; - elements.clear(); - } - _ => { - let A::DirectCall { - function: target, - arguments, - .. - } = &mut assignment.kind - else { - return false; - }; - if *target != symbol || arguments[5] != context_value { - return false; - } - match mutation { - Mutation::EntryBody => arguments[2] = parameters[2], - Mutation::EntryQueue => arguments[3] = parameters[3], - Mutation::EntryExtent => arguments[4] = parameters[4], - Mutation::EntryContext => arguments[5] = parameters[5], - _ => unreachable!(), - } - } - } - true - }); - assert!(changed); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_context_entry/mir.rs b/crates/psrs-driver/src/tests/control_context_entry/mir.rs deleted file mode 100644 index 389c0c4c..00000000 --- a/crates/psrs-driver/src/tests/control_context_entry/mir.rs +++ /dev/null @@ -1,243 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::ValueId; -use psrs_backend::mir::{Instruction as I, Terminator as T}; -use std::collections::HashMap; - -pub(super) fn reject(mutation: Mutation) { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let symbol = binding(&stages.cc.representations, R::Executor).0; - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let entry = function - .blocks - .iter() - .find(|block| block.id == function.entry) - .unwrap(); - let Some(T::Jump { - target: header, - arguments, - .. - }) = &entry.terminator - else { - unreachable!() - }; - assert_eq!(arguments, &function.parameters); - let header = *header; - let parameters = function - .blocks - .iter() - .find(|block| block.id == header) - .unwrap() - .parameters - .clone(); - let definitions = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| { - instruction - .destination() - .map(|value| (value, instruction.clone())) - }) - .collect::>(); - let origin = |mut value: ValueId| { - for _ in 0..definitions.len() { - match definitions.get(&value) { - Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { - value = *source - } - _ => break, - } - } - value - }; - let tail = |fields: &[ValueId]| { - matches!( - definitions.get(&origin(fields[6])), - Some(I::StructGet { field: 1, .. }) - ) - }; - let context_value = definitions - .iter() - .find_map(|(value, instruction)| match instruction { - I::StructNew { arguments, .. } if arguments.len() == 7 && !tail(arguments) => { - Some(*value) - } - _ => None, - }) - .unwrap(); - let status = match &definitions[&context_value] { - I::StructNew { arguments, .. } => match &definitions[&origin(arguments[6])] { - I::StructNew { arguments, .. } => origin(arguments[1]), - _ => unreachable!(), - }, - _ => unreachable!(), - }; - if matches!(mutation, Mutation::StatusOutsideLoop) { - let I::ArrayNew { elements, .. } = &definitions[&status] else { - unreachable!() - }; - let zero = elements[0]; - assert!(matches!(definitions[&zero], I::Constant { value: 0, .. })); - let mut moved = Vec::new(); - for block in &mut function.blocks { - let mut index = 0; - while index < block.instructions.len() { - if matches!(block.instructions[index].destination(), Some(value) if value == status || value == zero) - { - moved.push(block.instructions.remove(index)); - } else { - index += 1; - } - } - } - assert_eq!(moved.len(), 2); - moved.sort_by_key(|instruction| usize::from(instruction.destination() == Some(status))); - function - .blocks - .iter_mut() - .find(|block| block.id == function.entry) - .unwrap() - .instructions - .extend(moved); - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); - return; - } - let caller = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - if matches!(mutation, Mutation::Caller) { - let cast = ValueId(caller.0 + 1); - let I::StructNew { type_index, .. } = definitions[&context_value] else { - unreachable!() - }; - let reference = psrs_backend::types::RefType { - nullable: false, - heap: psrs_backend::types::HeapType::Index(type_index), - }; - let caller_ty = function - .values - .iter() - .find(|value| value.id == function.parameters[5]) - .unwrap() - .ty; - function.values.push(psrs_backend::types::ValueDecl { - id: caller, - ty: caller_ty, - }); - function.values.push(psrs_backend::types::ValueDecl { - id: cast, - ty: psrs_backend::types::ValueType::Ref(reference), - }); - let entry = function - .blocks - .iter_mut() - .find(|block| block.id == function.entry) - .unwrap(); - entry.instructions.push(I::RefCast { - destination: cast, - value: function.parameters[5], - reference, - span: function.span, - }); - entry.instructions.push(I::StructGet { - destination: caller, - type_index, - field: 5, - value: cast, - span: function.span, - }); - } - let mut changed = false; - for block in &mut function.blocks { - for instruction in &mut block.instructions { - match mutation { - Mutation::Caller - | Mutation::Clauses - | Mutation::TailQueue - | Mutation::TailParent - | Mutation::TailExtent => { - let I::StructNew { arguments, .. } = instruction else { - continue; - }; - if arguments.len() != 7 { - continue; - } - match mutation { - Mutation::Caller => arguments[5] = caller, - Mutation::Clauses => arguments.swap(1, 2), - _ if !tail(arguments) => continue, - Mutation::TailQueue => arguments[3] = parameters[3], - Mutation::TailParent => arguments[4] = parameters[4], - Mutation::TailExtent => arguments[6] = parameters[4], - _ => unreachable!(), - } - changed = true; - } - Mutation::Status => { - let I::ArrayNew { - destination, - elements, - .. - } = instruction - else { - continue; - }; - if *destination != status { - continue; - } - elements.clear(); - changed = true; - } - _ => {} - } - if changed { - break; - } - } - if !changed - && block.id != function.entry - && let Some(T::Jump { - target, arguments, .. - }) = &mut block.terminator - && *target == header - && origin(arguments[5]) == context_value - { - match mutation { - Mutation::EntryBody => arguments[2] = parameters[2], - Mutation::EntryQueue => arguments[3] = parameters[3], - Mutation::EntryExtent => arguments[4] = parameters[4], - Mutation::EntryContext => arguments[5] = parameters[5], - _ => continue, - } - changed = true; - } - if changed { - break; - } - } - assert!(changed); - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_context_entry/mod.rs b/crates/psrs-driver/src/tests/control_context_entry/mod.rs deleted file mode 100644 index 65317b8c..00000000 --- a/crates/psrs-driver/src/tests/control_context_entry/mod.rs +++ /dev/null @@ -1,139 +0,0 @@ -//! Actual source context construction and entry operands must retain identity. -mod aliases; -mod cc; -mod mir; -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::ControlHelperRole as R; - -#[derive(Clone, Copy)] -enum Mutation { - Clauses, - Caller, - TailQueue, - TailParent, - TailExtent, - EntryBody, - EntryQueue, - EntryExtent, - EntryContext, - Status, - StatusOutsideLoop, -} -impl Mutation { - fn message(self) -> &'static str { - match self { - Self::Caller => "retain its current caller context", - Self::Clauses => "retain the current Handle return and operation clauses", - Self::TailQueue | Self::TailParent => { - "retain queue, parent and extent from its current finish" - } - Self::TailExtent => "save its current queue and execution parent", - Self::Status | Self::StatusOutsideLoop => "fresh live status cell in its iteration", - _ => "enter its Handle body with an empty queue and its own extent", - } - } -} - -#[test] -fn cc_source_context_retains_clauses() { - cc::reject(Mutation::Clauses); -} - -#[test] -fn mir_source_context_retains_clauses() { - mir::reject(Mutation::Clauses); -} - -#[test] -fn cc_source_context_retains_tail_queue() { - cc::reject(Mutation::TailQueue); -} - -#[test] -fn mir_source_context_retains_tail_queue() { - mir::reject(Mutation::TailQueue); -} - -#[test] -fn cc_source_context_retains_tail_parent() { - cc::reject(Mutation::TailParent); -} - -#[test] -fn mir_source_context_retains_tail_parent() { - mir::reject(Mutation::TailParent); -} - -#[test] -fn cc_source_context_retains_tail_extent() { - cc::reject(Mutation::TailExtent); -} - -#[test] -fn mir_source_context_retains_tail_extent() { - mir::reject(Mutation::TailExtent); -} - -#[test] -fn cc_source_context_retains_entry_body() { - cc::reject(Mutation::EntryBody); -} - -#[test] -fn mir_source_context_retains_entry_body() { - mir::reject(Mutation::EntryBody); -} - -#[test] -fn cc_source_context_retains_entry_queue() { - cc::reject(Mutation::EntryQueue); -} - -#[test] -fn mir_source_context_retains_entry_queue() { - mir::reject(Mutation::EntryQueue); -} - -#[test] -fn cc_source_context_retains_entry_extent() { - cc::reject(Mutation::EntryExtent); -} - -#[test] -fn mir_source_context_retains_entry_extent() { - mir::reject(Mutation::EntryExtent); -} - -#[test] -fn cc_source_context_retains_entry_context() { - cc::reject(Mutation::EntryContext); -} - -#[test] -fn mir_source_context_retains_entry_context() { - mir::reject(Mutation::EntryContext); -} - -#[test] -fn cc_source_context_retains_fresh_status() { - cc::reject(Mutation::Status); -} - -#[test] -fn mir_source_context_retains_fresh_status() { - mir::reject(Mutation::Status); -} - -#[test] -fn cc_source_context_retains_current_caller() { - cc::reject(Mutation::Caller); -} -#[test] -fn mir_source_context_retains_current_caller() { - mir::reject(Mutation::Caller); -} - -#[test] -fn mir_source_context_status_is_allocated_inside_the_executor_loop() { - mir::reject(Mutation::StatusOutsideLoop); -} diff --git a/crates/psrs-driver/src/tests/control_contracts.rs b/crates/psrs-driver/src/tests/control_contracts.rs deleted file mode 100644 index afc1f2e4..00000000 --- a/crates/psrs-driver/src/tests/control_contracts.rs +++ /dev/null @@ -1,354 +0,0 @@ -//! Structural contracts are checked where control lowering creates them. - -use psrs_backend::cc::{AssignmentKind, Function, RefShape, Representation, ValueId, ValueShape}; - -fn shape(function: &Function, value: ValueId) -> ValueShape { - function - .values - .iter() - .find(|declaration| declaration.id == value) - .unwrap() - .ty -} - -#[test] -fn control_machine_preserves_nominal_capture_and_replay_contracts() { - let input = crate::lower_main_to_cc( - r"module Main where -import Prim.Control as C -data Op next = Op (Int -> next) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: state, _2: raw (k 42) } -main :: Int -main = (C.run 0 handler (C.perform (Op \x -> x)))._2 -", - ) - .expect("checked source should lower to CC"); - let find = |name| { - input - .cc - .functions - .iter() - .find(|function| function.name == name) - .unwrap() - }; - let executor = find("control_executor"); - let queue = shape(executor, executor.parameters[3]); - let boundary = shape(executor, executor.parameters[4]); - assert!( - matches!(queue, ValueShape::Reference(reference) if matches!(reference.heap, RefShape::Repr(_))) - ); - assert!( - matches!(boundary, ValueShape::Reference(reference) if matches!(reference.heap, RefShape::Repr(_))) - ); - assert_ne!(queue, boundary); - - let resume = find("control_resume"); - let captures = resume - .assignments - .iter() - .filter_map(|assignment| { - if let AssignmentKind::ClosureGetCapture { index, .. } = &assignment.kind { - Some((*index, shape(resume, assignment.destination))) - } else { - None - } - }) - .collect::>(); - assert_eq!(captures, vec![(0, queue), (1, boundary)]); - - let clone = find("control_clone_sequence"); - let rebuild = find("control_rebuild_sequence"); - let parameters = |function: &Function| { - function - .parameters - .iter() - .map(|value| shape(function, *value)) - .collect::>() - }; - assert_eq!( - parameters(clone), - vec![queue, queue, queue, boundary, boundary] - ); - assert_eq!(parameters(rebuild), vec![queue, queue, boundary, boundary]); - assert_eq!(clone.result_type, rebuild.result_type); - let ValueShape::Reference(reference) = clone.result_type else { - panic!("replay result reference") - }; - let RefShape::Repr(replay) = reference.heap else { - panic!("nominal replay result") - }; - assert_eq!( - input.cc.representations.representation(replay), - Some(&Representation::Product { - fields: vec![queue, boundary] - }) - ); - for name in ["control_check_boundary", "control_close_boundary"] { - let function = find(name); - assert_eq!(parameters(function), vec![boundary]); - assert_eq!(function.result_type, boundary); - } -} - -const DOMAINS: &str = r"module Main where -import Prim.Control as C -data F x = F (Int -> x) -data G x = G (Int -> x) -clause :: forall x. F x -> (x -> C.Control F Int) -> C.Control G Boolean -clause request raw = C.return true -outer :: forall x. Int -> G x -> (x -> C.Control G Boolean) -> { _1 :: Int, _2 :: C.Control G Boolean } -outer state (G k) raw = { _1: state, _2: raw (k 0) } -main :: Int -main = let target = (C.return true :: C.Control G Boolean) - result = C.handle (\n -> target) clause (C.return 42) - in if (C.run 0 outer result)._2 then 42 else 0 -"; - -#[test] -fn checked_domains_and_rank_two_clause_survive_physical_lowering() { - use psrs_backend::cc::{TypeConstructorIdentity as C, TypeIdentity as T}; - let stages = crate::compile_main_stages(DOMAINS).unwrap(); - let cc = &stages.cc; - let handle = cc - .representations - .control_contracts - .iter() - .find(|proof| proof.operation() == psrs_hir::Intrinsic::ControlHandle) - .unwrap(); - assert_eq!(handle.source().unwrap().answer, T::Constructor(C::Int)); - assert_eq!(handle.target().unwrap().answer, T::Constructor(C::Boolean)); - assert_ne!( - handle.source().unwrap().request, - handle.target().unwrap().request - ); - assert!(matches!(handle.arguments()[1], T::ForAll { .. })); - let mir = &stages.mir; - assert!(mir.control_contracts().iter().any(|proof| proof == handle)); - assert!( - mir.functions - .iter() - .flat_map(|function| &function.blocks) - .flat_map(|block| &block.instructions) - .any(|instruction| matches!( - instruction, - psrs_backend::mir::Instruction::ControlEvidence { .. } - )) - ); - psrs_backend::mir::verify_module(mir).unwrap(); -} - -#[test] -fn cc_rejects_a_dangling_control_contract() { - let mut input = crate::lower_main_to_cc(DOMAINS).unwrap(); - let evidence = input - .cc - .functions - .iter_mut() - .flat_map(|function| &mut function.assignments) - .find_map(|assignment| match &mut assignment.kind { - AssignmentKind::ControlEvidence { contract, .. } => Some(contract), - _ => None, - }) - .unwrap(); - *evidence = psrs_backend::cc::ControlContractId(u32::MAX); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("no checked source contract")) - ); -} - -#[test] -fn cc_rejects_a_same_shape_body_from_the_target_domain() { - let mut input = crate::lower_main_to_cc(DOMAINS).unwrap(); - let contracts = &input.cc.representations.control_contracts; - let (function, index) = input.cc.functions.iter_mut().find_map(|function| function.assignments.iter().position(|assignment| matches!(&assignment.kind, - AssignmentKind::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle)).map(|index| (function, index))).unwrap(); - let target = function - .assignments - .iter() - .find_map(|assignment| match &assignment.kind { - AssignmentKind::ControlEvidence { contract, .. } - if contracts[contract.0 as usize] - .target() - .is_some_and(|domain| { - domain.answer - == psrs_backend::cc::TypeIdentity::Constructor( - psrs_backend::cc::TypeConstructorIdentity::Boolean, - ) - }) => - { - Some(assignment.destination) - } - _ => None, - }) - .unwrap(); - let implementation = match &mut function.assignments[index].kind { - AssignmentKind::ControlEvidence { - arguments, - implementation, - .. - } => { - arguments[2] = target; - *implementation - } - _ => unreachable!(), - }; - let frame = function - .assignments - .iter_mut() - .find(|assignment| assignment.destination == implementation) - .unwrap(); - let AssignmentKind::VariantNew { fields, .. } = &mut frame.kind else { - unreachable!() - }; - fields[2] = target; - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("source type disagrees with its checked domain")), - "{errors:?}" - ); -} - -#[test] -fn cc_rejects_a_frame_that_does_not_save_the_proven_source_body() { - let mut input = crate::lower_main_to_cc(DOMAINS).unwrap(); - let contracts = &input.cc.representations.control_contracts; - let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().any(|assignment| matches!(&assignment.kind, - AssignmentKind::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle))).unwrap(); - let implementation = function - .assignments - .iter() - .find_map(|assignment| match &assignment.kind { - AssignmentKind::ControlEvidence { - contract, - implementation, - .. - } if contracts[contract.0 as usize].operation() - == psrs_hir::Intrinsic::ControlHandle => - { - Some(*implementation) - } - _ => None, - }) - .unwrap(); - let other = function - .assignments - .iter() - .find_map(|assignment| match &assignment.kind { - AssignmentKind::ControlEvidence { contract, .. } - if contracts[contract.0 as usize].operation() - == psrs_hir::Intrinsic::ControlReturn - && contracts[contract.0 as usize] - .target() - .is_some_and(|domain| { - domain.answer - == psrs_backend::cc::TypeIdentity::Constructor( - psrs_backend::cc::TypeConstructorIdentity::Boolean, - ) - }) => - { - Some(assignment.destination) - } - _ => None, - }) - .unwrap(); - let frame = function - .assignments - .iter_mut() - .find(|assignment| assignment.destination == implementation) - .unwrap(); - let AssignmentKind::VariantNew { fields, .. } = &mut frame.kind else { - unreachable!() - }; - fields[2] = other; - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("does not preserve its checked source operands")), - "{errors:?}" - ); -} - -#[test] -fn mir_rejects_an_operand_from_the_other_checked_domain() { - let mut stages = crate::compile_main_stages(DOMAINS).unwrap(); - let contracts = stages.mir.control_contracts().to_vec(); - let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, - psrs_backend::mir::Instruction::ControlEvidence { contract, .. } if contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle))).unwrap(); - let target = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - psrs_backend::mir::Instruction::ControlEvidence { - destination, - contract, - .. - } if contracts[contract.0 as usize].operation() - == psrs_hir::Intrinsic::ControlReturn - && contracts[contract.0 as usize] - .target() - .is_some_and(|domain| { - domain.answer - == psrs_backend::cc::TypeIdentity::Constructor( - psrs_backend::cc::TypeConstructorIdentity::Boolean, - ) - }) => - { - Some(*destination) - } - _ => None, - }) - .unwrap(); - for instruction in function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - { - if let psrs_backend::mir::Instruction::ControlEvidence { - arguments, - contract, - .. - } = instruction - && contracts[contract.0 as usize].operation() == psrs_hir::Intrinsic::ControlHandle - { - arguments[2] = target; - } - } - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("source type disagrees with its checked domain")), - "{errors:?}" - ); -} - -#[test] -fn mir_rejects_a_dangling_control_contract_after_optimization() { - let mut stages = crate::compile_main_stages(DOMAINS).unwrap(); - let contract = stages - .mir - .functions - .iter_mut() - .flat_map(|function| &mut function.blocks) - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - psrs_backend::mir::Instruction::ControlEvidence { contract, .. } => Some(contract), - _ => None, - }) - .unwrap(); - *contract = psrs_backend::cc::ControlContractId(u32::MAX); - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("no checked source contract")) - ); -} diff --git a/crates/psrs-driver/src/tests/control_costs/mod.rs b/crates/psrs-driver/src/tests/control_costs/mod.rs index 373324cf..43e39113 100644 --- a/crates/psrs-driver/src/tests/control_costs/mod.rs +++ b/crates/psrs-driver/src/tests/control_costs/mod.rs @@ -115,6 +115,68 @@ fn control_ancestry_probe_observes_independent_non_tail_extents() { run("nested", sources::NESTED, 8, 7, 134); } +/// Run the instrumented replay counter at `budget` and report whether the +/// program completed (the count did not exceed the budget). +fn replay_ok(name: &str, source: &str, budget: i32) -> Option { + super::wasmtime_available()?; + let mut stages = crate::compile_main_stages(source).expect("cost source compiles and verifies"); + assert!( + probe::instrument_replay(&mut stages, budget) > 0, + "no replay helpers retained to instrument" + ); + let core = + psrs_backend::wasm::encode_module(&stages.wasm).expect("instrumented target encodes"); + let bytes = probe::component(&stages, &core); + wasmparser::Validator::new_with_features(wasmparser::WasmFeatures::all()) + .validate_all(&bytes) + .expect("instrumented Wasm validates"); + let path = std::env::temp_dir().join(format!("psrs-control-replay-{name}-{budget}.wasm")); + std::fs::write(&path, bytes).unwrap(); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .unwrap(); + let _ = std::fs::remove_file(&path); + Some(output.status.code() == Some(42)) +} + +/// The total `CloneSequence`/`RebuildSequence` invocations: the smallest budget +/// that does not trap the replay counter. +fn replay_invocations(name: &str, template: &str, steps: i32) -> Option { + super::wasmtime_available()?; + let source = template.replace("STEPS", &steps.to_string()); + let mut lo = 0; + let mut hi = 1 << 20; + while lo < hi { + let mid = lo + (hi - lo) / 2; + if replay_ok(name, &source, mid)? { + hi = mid; + } else { + lo = mid + 1; + } + } + Some(lo) +} + +#[test] +fn replay_invocations_grow_with_requests_at_fixed_ancestry() { + // `DEEP` replays its saved queue once per request; the ancestry bound stays + // at 2 because tail handlers coalesce. Replay work is therefore measured + // separately from finish/ancestor depth. + let mut previous = 0; + for steps in [1, 2, 4, 8] { + let Some(count) = replay_invocations("deep", sources::DEEP, steps) else { + return; + }; + assert!( + count > previous, + "replay invocations must grow with requests ({previous} -> {count}) at {steps}" + ); + previous = count; + } +} + #[test] fn control_cost_pipeline_rejects_a_malformed_compiler_input() { let mut input = crate::lower_main_to_cc(&sources::DEEP.replace("STEPS", "1")).unwrap(); diff --git a/crates/psrs-driver/src/tests/control_costs/probe.rs b/crates/psrs-driver/src/tests/control_costs/probe.rs index bcb7222b..6d9ba161 100644 --- a/crates/psrs-driver/src/tests/control_costs/probe.rs +++ b/crates/psrs-driver/src/tests/control_costs/probe.rs @@ -1,7 +1,9 @@ //! Observational guards instrument the final Wasm, after compiler verification. //! The deliberately trapping budget walk is not part of the control protocol. use psrs_backend::cc::ControlHelperRole as R; -use psrs_backend::wasm::{Body, FuncType, Function, Op, TypeIndex}; +use psrs_backend::wasm::{ + Body, FuncType, Function, Global, GlobalIndex, GlobalInit, Op, TypeIndex, +}; use psrs_backend::{ Stages, types::{CompositeType, HeapType as MirHeap, ValueType}, @@ -184,6 +186,59 @@ fn insert(body: &mut Body, root: u32, child: u32, local: u32, checker: u32, limi count } +/// Count replay invocations by incrementing a private global at each +/// `CloneSequence`/`RebuildSequence` entry and trapping once it exceeds +/// `budget`. The smallest budget that does not trap is therefore the number of +/// replay invocations, measured independently of the extent ancestry bound. +pub(super) fn instrument_replay(stages: &mut Stages, budget: i32) -> usize { + let symbol = |role| { + stages + .cc + .representations + .control_helpers + .iter() + .find(|helper| helper.role() == role) + .expect("control helper") + .function() + }; + let clone = symbol(R::CloneSequence); + let rebuild = symbol(R::RebuildSequence); + let module = &mut stages.wasm; + let global = module.globals.len() as u32; + module.globals.push(Global { + index: GlobalIndex(global), + mutable: true, + ty: ValType::I32, + init: GlobalInit::I32(0), + }); + let mut count = 0; + for function in &mut module.functions { + if function.symbol != clone && function.symbol != rebuild { + continue; + } + let span = function.span; + let mut prefix = vec![ + leaf(I::GlobalGet(global)), + leaf(I::I32Const(1)), + leaf(I::I32Add), + leaf(I::GlobalSet(global)), + leaf(I::GlobalGet(global)), + leaf(I::I32Const(budget)), + leaf(I::I32GtS), + Op::If { + then_body: vec![leaf(I::Unreachable)], + else_body: vec![], + result: None, + span, + }, + ]; + prefix.extend(std::mem::take(&mut function.body)); + function.body = prefix; + count += 1; + } + count +} + /// Replace the program core module in the already assembled component. The /// observation adds only private locals/functions; imports/exports stay fixed. pub(super) fn component(stages: &Stages, core: &[u8]) -> Vec { diff --git a/crates/psrs-driver/src/tests/control_dispatch/cc.rs b/crates/psrs-driver/src/tests/control_dispatch/cc.rs deleted file mode 100644 index b749d961..00000000 --- a/crates/psrs-driver/src/tests/control_dispatch/cc.rs +++ /dev/null @@ -1,184 +0,0 @@ -//! CC dispatch negatives and provenance positives. -use super::*; - -#[test] -fn cc_rejects_a_projection_of_the_wrong_case() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let carriers = [ - carrier_repr(table, R::Executor, 2), - carrier_repr(table, R::Executor, 5), - carrier_repr(table, R::CloneSequence, 0), - ]; - for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { - let (symbol, _) = binding(table, role); - let mut broken = input.cc.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let shapes = function - .values - .iter() - .map(|value| (value.id, value.ty)) - .collect::>(); - let changed = visit(&mut function.assignments, &mut |assignment| { - let A::VariantGet { - representation, - case, - field, - .. - } = &mut assignment.kind - else { - return false; - }; - if !carriers.contains(representation) { - return false; - } - let Some(Representation::Variant { cases }) = table.representation(*representation) - else { - return false; - }; - let destination = shapes.get(&assignment.destination).copied(); - let Some(alternative) = cases.iter().find(|candidate| { - candidate.tag != *case - && candidate.fields.get(*field as usize).copied() == destination - }) else { - return false; - }; - *case = alternative.tag; - true - }); - assert!(changed, "{role:?}: no carrier projection to mutate"); - let errors = psrs_backend::cc::verify_module(&broken).expect_err("wrong projection"); - assert!( - errors - .iter() - .any(|error| error.message.contains("control projection must match")), - "{role:?}: {errors:?}" - ); - } -} - -#[test] -fn cc_dispatch_requires_a_trapping_default() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let (symbol, _) = binding(table, R::Executor); - let mut broken = input.cc.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let state = function.parameters[0]; - let Some(A::TagSwitch { default_value, .. }) = function - .assignments - .last_mut() - .map(|assignment| &mut assignment.kind) - else { - panic!("input dispatch"); - }; - // Point the default at an available value with the right shape so only the - // trap requirement is violated. - *default_value = state; - let errors = psrs_backend::cc::verify_module(&broken).expect_err("non-trapping default"); - assert!( - errors.iter().any(|error| error - .message - .contains("must trap on unsupported alternatives")), - "{errors:?}" - ); -} - -#[test] -fn cc_dispatch_resolves_a_reference_alias_of_the_input() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let (symbol, _) = binding(table, R::Executor); - let mut broken = input.cc.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let source = function.parameters[2]; - let declaration = function - .values - .iter() - .find(|value| value.id == source) - .unwrap() - .clone(); - let alias = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(ValueDecl { - id: alias, - ty: declaration.ty, - }); - let tag = match &function.assignments.last().unwrap().kind { - A::TagSwitch { value, .. } => *value, - _ => panic!("input dispatch"), - }; - let position = function - .assignments - .iter() - .position(|assignment| assignment.destination == tag) - .unwrap(); - function.assignments.insert( - position, - Assignment { - destination: alias, - kind: A::AggregateConvert { - destination: alias, - value: source, - conversion: AggregateConvert { - source: declaration.ty, - destination: declaration.ty, - plan: ValueConversion::Identity, - }, - }, - span: function.span, - }, - ); - let variant = function - .assignments - .iter_mut() - .find(|assignment| assignment.destination == tag) - .unwrap(); - let A::VariantTag { value, .. } = &mut variant.kind else { - panic!("input tag"); - }; - *value = alias; - psrs_backend::cc::verify_module(&broken) - .expect("an identity alias must preserve dispatch provenance"); -} - -#[test] -fn cc_dispatch_result_must_originate_from_the_input() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let (symbol, _) = binding(table, R::Executor); - let mut broken = input.cc.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - // A result that is not the input dispatch stands in for a dead transition. - function.result = function.parameters[0]; - let errors = psrs_backend::cc::verify_module(&broken).expect_err("dead dispatch"); - assert!( - errors - .iter() - .any(|error| error.message.contains("must be its current input dispatch")), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_dispatch/mir.rs b/crates/psrs-driver/src/tests/control_dispatch/mir.rs deleted file mode 100644 index 16a5fc80..00000000 --- a/crates/psrs-driver/src/tests/control_dispatch/mir.rs +++ /dev/null @@ -1,305 +0,0 @@ -//! MIR dispatch negatives and provenance positives. -use super::*; - -#[test] -fn mir_dispatch_requires_a_trapping_default() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let module = crate::compile_main_stages(SOURCE).unwrap().mir; - for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { - let (symbol, _) = binding(&input.cc.representations, role); - let mut broken = module.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let span = function.span; - let default = function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Switch { cases, default, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() == required(role) => - { - Some(*default) - } - _ => None, - }) - .expect("input dispatch"); - let block = function - .blocks - .iter_mut() - .find(|block| block.id == default) - .unwrap(); - // Break the trap without leaving the block, so only the trap - // requirement is violated. - block.instructions.clear(); - block.terminator = Some(T::Jump { - target: default, - arguments: vec![], - span, - }); - let errors = psrs_backend::mir::verify_module(&broken).expect_err("non-trapping default"); - assert!( - errors.iter().any(|error| error - .message - .contains("must trap on unsupported alternatives")), - "{role:?}: {errors:?}" - ); - } -} - -#[test] -fn mir_dispatch_requires_an_immutable_i32_tag() { - use psrs_backend::types::{CompositeType, StorageType}; - let module = crate::compile_main_stages(SOURCE).unwrap().mir; - let mut broken = module.clone(); - let mut changed = false; - for group in &mut broken.types { - for ty in &mut group.0 { - let CompositeType::Struct(fields) = &mut ty.composite else { - continue; - }; - let Some(first) = fields.first_mut() else { - continue; - }; - if first.storage == StorageType::I32 && !first.mutable { - first.mutable = true; - changed = true; - } - } - } - assert!(changed, "no immutable i32 tag to mutate"); - let errors = psrs_backend::mir::verify_module(&broken).expect_err("mutable tag"); - assert!( - errors - .iter() - .any(|error| error.message.contains("immutable i32 tag field")), - "{errors:?}" - ); -} - -#[test] -fn mir_dispatch_resolves_a_reference_copy_of_the_input() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let module = crate::compile_main_stages(SOURCE).unwrap().mir; - for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { - let (symbol, _) = binding(&input.cc.representations, role); - let mut broken = module.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let span = function.span; - let tag = function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Switch { value, cases, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() == required(role) => - { - Some(*value) - } - _ => None, - }) - .expect("input dispatch"); - let (block_index, cast) = function - .blocks - .iter() - .enumerate() - .find_map(|(block_index, block)| { - block - .instructions - .iter() - .find_map(|instruction| match instruction { - I::StructGet { - destination, - field: 0, - value, - .. - } if *destination == tag => Some((block_index, *value)), - _ => None, - }) - }) - .expect("tag projection"); - let cast_index = function.blocks[block_index] - .instructions - .iter() - .position(|instruction| { - matches!(instruction, I::RefCast { destination, .. } if *destination == cast) - }) - .expect("tag cast"); - let source = match &function.blocks[block_index].instructions[cast_index] { - I::RefCast { value, .. } => *value, - _ => unreachable!(), - }; - let ty = function - .values - .iter() - .find(|value| value.id == source) - .unwrap() - .ty; - let alias = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function - .values - .push(psrs_backend::types::ValueDecl { id: alias, ty }); - let block = &mut function.blocks[block_index]; - block.instructions.insert( - cast_index, - I::Copy { - destination: alias, - value: source, - span, - }, - ); - let I::RefCast { value, .. } = &mut block.instructions[cast_index + 1] else { - unreachable!() - }; - *value = alias; - psrs_backend::mir::verify_module(&broken) - .expect("a reference copy must preserve dispatch provenance"); - } -} - -#[test] -fn mir_dispatch_rejects_a_projection_of_the_wrong_case() { - use psrs_backend::types::{CompositeType, DefinedTypeId, HeapType, RefType, ValueType}; - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let module = crate::compile_main_stages(SOURCE).unwrap().mir; - for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { - let (symbol, _) = binding(&input.cc.representations, role); - let mut broken = module.clone(); - let function = broken - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let tag = function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Switch { value, cases, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() == required(role) => - { - Some(*value) - } - _ => None, - }) - .expect("input dispatch"); - let base = function - .blocks - .iter() - .find_map(|block| { - block - .instructions - .iter() - .find_map(|instruction| match instruction { - I::StructGet { - destination, - field: 0, - type_index, - .. - } if *destination == tag => Some(*type_index), - _ => None, - }) - }) - .expect("tag projection"); - let flat = broken - .types - .iter() - .flat_map(|group| group.0.iter().cloned()) - .collect::>(); - let cases = flat - .iter() - .enumerate() - .filter(|(_, ty)| ty.supertype == Some(base)) - .map(|(index, _)| DefinedTypeId(index as u32)) - .collect::>(); - let storage = |id: DefinedTypeId, field: u32| match &flat.get(id.0 as usize)?.composite { - CompositeType::Struct(fields) => fields.get(field as usize).map(|field| field.storage), - _ => None, - }; - let mut mutation = None; - 'search: for (block_index, block) in function.blocks.iter().enumerate() { - for (index, instruction) in block.instructions.iter().enumerate() { - let I::StructGet { - type_index, - field, - value, - .. - } = instruction - else { - continue; - }; - if *field == 0 || !cases.contains(type_index) { - continue; - } - let Some(current) = storage(*type_index, *field) else { - continue; - }; - let Some(alternative) = cases - .iter() - .copied() - .find(|case| case != type_index && storage(*case, *field) == Some(current)) - else { - continue; - }; - if block.instructions.iter().any( - |producer| matches!(producer, I::RefCast { destination, .. } if destination == value), - ) { - mutation = Some((block_index, index, *value, alternative)); - break 'search; - } - } - } - let Some((block_index, index, cast, alternative)) = mutation else { - panic!("{role:?}: no projection to mutate"); - }; - let cast_index = function.blocks[block_index] - .instructions - .iter() - .position(|instruction| { - matches!(instruction, I::RefCast { destination, .. } if *destination == cast) - }) - .expect("case cast"); - let I::RefCast { reference, .. } = - &mut function.blocks[block_index].instructions[cast_index] - else { - unreachable!() - }; - *reference = RefType { - nullable: false, - heap: HeapType::Index(alternative), - }; - function - .values - .iter_mut() - .find(|declaration| declaration.id == cast) - .unwrap() - .ty = ValueType::Ref(RefType { - nullable: false, - heap: HeapType::Index(alternative), - }); - let I::StructGet { type_index, .. } = &mut function.blocks[block_index].instructions[index] - else { - unreachable!() - }; - *type_index = alternative; - let errors = psrs_backend::mir::verify_module(&broken).expect_err("wrong projection"); - assert!( - errors - .iter() - .any(|error| error.message.contains("control projection must match")), - "{role:?}: {errors:?}" - ); - } -} diff --git a/crates/psrs-driver/src/tests/control_dispatch/mod.rs b/crates/psrs-driver/src/tests/control_dispatch/mod.rs deleted file mode 100644 index 13d0a6f1..00000000 --- a/crates/psrs-driver/src/tests/control_dispatch/mod.rs +++ /dev/null @@ -1,140 +0,0 @@ -//! Dispatch must cover its machine domain and prove the selected payload case. -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::{ - AggregateConvert, Assignment, AssignmentKind as A, ControlHelperRole as R, RefShape, ReprId, - Representation, RepresentationTable, ValueConversion, ValueDecl, ValueId, ValueShape, -}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; - -pub(super) fn required(role: R) -> &'static [i32] { - match role { - R::Executor => &[0, 1, 2, 3, 4, 5], - R::CloneSequence => &[0, 1, 2, 3], - R::RebuildSequence => &[0, 1, 3], - _ => panic!("dispatch helper"), - } -} - -/// The nominal representation a helper parameter carries. -pub(super) fn carrier_repr(table: &RepresentationTable, role: R, index: usize) -> ReprId { - let helper = table - .control_helpers - .iter() - .find(|helper| helper.role() == role) - .unwrap(); - match table.signature(helper.signature()).unwrap().parameters[index] { - ValueShape::Reference(reference) => match reference.heap { - RefShape::Repr(id) => id, - _ => panic!("carrier parameter is not a representation reference"), - }, - _ => panic!("carrier parameter is not a reference"), - } -} - -/// Visits every assignment, including nested switch and if bodies. -pub(super) fn visit( - body: &mut [Assignment], - mutate: &mut impl FnMut(&mut Assignment) -> bool, -) -> bool { - for assignment in body { - if mutate(assignment) { - return true; - } - match &mut assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - if visit(&mut case.assignments, mutate) { - return true; - } - } - if visit(default_assignments, mutate) { - return true; - } - } - A::If { - then_assignments, - else_assignments, - .. - } => { - if visit(then_assignments, mutate) || visit(else_assignments, mutate) { - return true; - } - } - _ => {} - } - } - false -} - -mod cc; -mod mir; - -#[test] -fn cc_rejects_every_missing_machine_dispatch_alternative() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { - let (symbol, _) = binding(&input.cc.representations, role); - for tag in required(role) { - let mut broken = input.cc.clone(); - let f = broken - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let A::TagSwitch { cases, .. } = &mut f.assignments.last_mut().unwrap().kind else { - panic!("input dispatch"); - }; - cases.retain(|case| case.tag != *tag); - let errors = psrs_backend::cc::verify_module(&broken).expect_err("missing alternative"); - assert!( - errors - .iter() - .any(|e| e.message.contains("every required alternative")), - "{role:?}/{tag}: {errors:?}" - ); - } - } -} - -#[test] -fn mir_rejects_every_missing_machine_dispatch_alternative() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let module = crate::compile_main_stages(SOURCE).unwrap().mir; - for role in [R::Executor, R::CloneSequence, R::RebuildSequence] { - let (symbol, _) = binding(&input.cc.representations, role); - for tag in required(role) { - let mut broken = module.clone(); - let f = broken - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let switch = f - .blocks - .iter_mut() - .find_map(|b| match &mut b.terminator { - Some(T::Switch { cases, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() - == required(role) => - { - Some(cases) - } - _ => None, - }) - .expect("input dispatch"); - switch.retain(|(case, _)| case != tag); - let errors = - psrs_backend::mir::verify_module(&broken).expect_err("missing alternative"); - assert!( - errors - .iter() - .any(|e| e.message.contains("every required alternative")), - "{role:?}/{tag}: {errors:?}" - ); - } - } -} diff --git a/crates/psrs-driver/src/tests/control_execution_steps.rs b/crates/psrs-driver/src/tests/control_execution_steps.rs deleted file mode 100644 index 0133cd38..00000000 --- a/crates/psrs-driver/src/tests/control_execution_steps.rs +++ /dev/null @@ -1,281 +0,0 @@ -//! Same-shaped replacements cannot bypass the Bind or Resume machine steps. -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; - -#[derive(Clone, Copy)] -enum Mutation { - Body, - Queue, - Callback, - Answer, - Extent, - AppendTail, -} - -fn message(mutation: Mutation) -> &'static str { - match mutation { - Mutation::Body | Mutation::Callback => { - "Bind must enter its body with its own callback and current queue" - } - Mutation::Queue => "execution step must retain its pending queue", - Mutation::Answer => "Resume must return its current saved answer", - Mutation::Extent => "Resume must use its replayed queue and activation", - Mutation::AppendTail => "Resume must append replay to its current queue", - } -} - -fn cc_step(tag: i32, mutation: Mutation) { - let mut module = crate::lower_main_to_cc(SOURCE).unwrap().cc; - let (symbol, _) = binding(&module.representations, R::Executor); - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let p = function.parameters.clone(); - let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { - panic!("input dispatch") - }; - let case = cases.iter_mut().find(|case| case.tag == tag).unwrap(); - let next = case - .assignments - .iter() - .find_map(|a| match &a.kind { - A::DirectCall { - function, - arguments, - .. - } if *function == symbol => Some(arguments.clone()), - _ => None, - }) - .unwrap(); - match mutation { - Mutation::Body | Mutation::Queue | Mutation::Extent => { - let A::DirectCall { arguments, .. } = &mut case - .assignments - .iter_mut() - .find(|a| a.destination == case.value) - .unwrap() - .kind - else { - panic!("transition") - }; - let index = match mutation { - Mutation::Body => 2, - Mutation::Queue => 3, - _ => 4, - }; - arguments[index] = p[index]; - } - Mutation::Callback | Mutation::AppendTail => { - let A::VariantNew { fields, .. } = &mut case - .assignments - .iter_mut() - .find(|a| a.destination == next[3]) - .unwrap() - .kind - else { - panic!("pending queue") - }; - match mutation { - Mutation::Callback => fields[0] = p[1], - _ => fields[1] = fields[0], - } - } - Mutation::Answer => { - let A::VariantNew { fields, .. } = &mut case - .assignments - .iter_mut() - .find(|a| a.destination == next[2]) - .unwrap() - .kind - else { - panic!("returned answer") - }; - fields[0] = p[0]; - } - } - let errors = psrs_backend::cc::verify_module(&module).expect_err("broken execution step"); - assert!( - errors.iter().any(|e| e.message.contains(message(mutation))), - "{errors:?}" - ); -} - -fn mir_step(tag: i32, mutation: Mutation) { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let target = function - .blocks - .iter() - .find_map(|b| match &b.terminator { - Some(T::Switch { cases, .. }) - if cases.iter().map(|(t, _)| *t).collect::>() == vec![0, 1, 2, 3, 4, 5] => - { - Some(cases.iter().find(|(t, _)| *t == tag).unwrap().1) - } - _ => None, - }) - .unwrap(); - let p = function.parameters.clone(); - let header = match function - .blocks - .iter() - .find(|b| b.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - { - T::Jump { target, .. } => *target, - _ => panic!("loop preheader"), - }; - let mut pending = vec![target]; - let mut seen = std::collections::HashSet::new(); - let mut transition = None; - while let Some(id) = pending.pop() { - if id == header || !seen.insert(id) { - continue; - } - let block = function.blocks.iter().find(|b| b.id == id).unwrap(); - match block.terminator.as_ref().unwrap() { - T::Jump { - target, arguments, .. - } if *target == header => { - transition = Some((id, arguments.clone())); - break; - } - T::Jump { target, .. } => pending.push(*target), - T::Branch { - then_block, - else_block, - .. - } => pending.extend([*then_block, *else_block]), - T::Switch { cases, default, .. } => { - pending.extend(cases.iter().map(|(_, target)| *target)); - pending.push(*default); - } - _ => {} - } - } - let (transition, next) = transition.expect("step loop transition"); - let aliases = function - .blocks - .iter() - .flat_map(|b| &b.instructions) - .filter_map(|i| match i { - I::Copy { - destination, value, .. - } - | I::RefCast { - destination, value, .. - } => Some((*destination, *value)), - _ => None, - }) - .collect::>(); - let origin = |mut value| { - for _ in 0..aliases.len() { - if let Some(source) = aliases.get(&value) { - value = *source; - } else { - break; - } - } - value - }; - match mutation { - Mutation::Body | Mutation::Queue | Mutation::Extent => { - let T::Jump { arguments, .. } = function - .blocks - .iter_mut() - .find(|b| b.id == transition) - .unwrap() - .terminator - .as_mut() - .unwrap() - else { - unreachable!() - }; - let index = match mutation { - Mutation::Body => 2, - Mutation::Queue => 3, - _ => 4, - }; - arguments[index] = p[index]; - } - Mutation::Callback | Mutation::AppendTail => { - let I::StructNew { arguments, .. } = function - .blocks - .iter_mut() - .flat_map(|b| &mut b.instructions) - .find(|i| i.destination() == Some(origin(next[3]))) - .unwrap() - else { - panic!("pending queue") - }; - match mutation { - Mutation::Callback => arguments[1] = p[1], - _ => arguments[2] = arguments[1], - } - } - Mutation::Answer => { - let I::StructNew { arguments, .. } = function - .blocks - .iter_mut() - .flat_map(|b| &mut b.instructions) - .find(|i| i.destination() == Some(origin(next[2]))) - .unwrap() - else { - panic!("returned answer") - }; - arguments[1] = p[0]; - } - } - let errors = psrs_backend::mir::verify_module(&module).expect_err("broken execution step"); - assert!( - errors.iter().any(|e| e.message.contains(message(mutation))), - "{errors:?}" - ); -} - -#[test] -fn cc_bind_requires_its_body_callback_and_queue() { - for mutation in [Mutation::Body, Mutation::Callback, Mutation::Queue] { - cc_step(2, mutation); - } -} -#[test] -fn mir_bind_requires_its_body_callback_and_queue() { - for mutation in [Mutation::Body, Mutation::Callback, Mutation::Queue] { - mir_step(2, mutation); - } -} -#[test] -fn cc_resume_requires_its_answer_replayed_extent_and_pending_queue() { - for mutation in [ - Mutation::Answer, - Mutation::Extent, - Mutation::Queue, - Mutation::AppendTail, - ] { - cc_step(3, mutation); - } -} -#[test] -fn mir_resume_requires_its_answer_replayed_extent_and_pending_queue() { - for mutation in [ - Mutation::Answer, - Mutation::Extent, - Mutation::Queue, - Mutation::AppendTail, - ] { - mir_step(3, mutation); - } -} diff --git a/crates/psrs-driver/src/tests/control_finish_provenance.rs b/crates/psrs-driver/src/tests/control_finish_provenance.rs deleted file mode 100644 index 36bb7b57..00000000 --- a/crates/psrs-driver/src/tests/control_finish_provenance.rs +++ /dev/null @@ -1,462 +0,0 @@ -//! Finish relations must reject lifetime swaps that ordinary types accept. -use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; - -const SOURCE: &str = r"module Main where -import Prim.Control as C -data Op next = Op (Int -> next) -ret :: Int -> C.Control Op Int -ret x = C.return x -clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Int -clause (Op k) raw = C.handle ret clause (raw (k 42)) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: state, _2: raw (k 42) } -main :: Int -main = (C.run 0 handler (C.handle ret clause (C.perform (Op \x -> x))))._2 -"; - -fn leaf( - body: &mut Vec, - close: u32, - edit: &mut impl FnMut(&mut Vec, usize), -) -> bool { - if let Some(index) = body.iter().position(|assignment| matches!(assignment.kind, A::DirectCall { contract: Some(contract), .. } if contract.0 == close)) { - edit(body, index); - return true; - } - for assignment in body { - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &mut assignment.kind - { - for case in cases { - if leaf(&mut case.assignments, close, edit) { - return true; - } - } - if leaf(default_assignments, close, edit) { - return true; - } - } - } - false -} - -fn mutate_cc(edit: &mut impl FnMut(&mut Vec, usize)) -> psrs_backend::BackendInput { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let helpers = &input.cc.representations.control_helpers; - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - assert!(leaf(&mut function.assignments, close, edit)); - input -} - -#[test] -fn cc_rejects_closing_the_parent_instead_of_the_finish_extent() { - let input = mutate_cc(&mut |body, index| { - let parent = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { arguments, .. } if arguments.len() == 6 => Some(arguments[4]), - _ => None, - }) - .unwrap(); - let A::DirectCall { arguments, .. } = &mut body[index].kind else { - unreachable!() - }; - arguments[0] = parent; - }); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("must close its frame's extent")), - "{errors:?}" - ); -} - -#[test] -fn cc_rejects_restoring_the_closed_extent_instead_of_its_parent() { - let input = mutate_cc(&mut |body, index| { - let A::DirectCall { arguments, .. } = &body[index].kind else { - unreachable!() - }; - let closed = arguments[0]; - let arguments = body[index + 1..] - .iter_mut() - .find_map(|assignment| match &mut assignment.kind { - A::DirectCall { arguments, .. } if arguments.len() == 6 => Some(arguments), - _ => None, - }) - .unwrap(); - arguments[4] = closed; - }); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("restore the queue and parent from the same frame")), - "{errors:?}" - ); -} - -#[test] -fn optimized_mir_rejects_closing_a_same_shaped_parent() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let helpers = stages.mir.control_helpers(); - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); - let Some(T::Jump { arguments, .. }) = &block.terminator else { - panic!("finish loop transition") - }; - let parent = arguments[4]; - let call = block - .instructions - .iter_mut() - .find_map(|instruction| match instruction { - I::Call { - arguments, - contract: Some(contract), - .. - } if contract.0 == close => Some(arguments), - _ => None, - }) - .unwrap(); - call[0] = parent; - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("must close its frame's extent")), - "{errors:?}" - ); -} - -#[test] -fn optimized_mir_rejects_the_wrong_restored_parent() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let helpers = stages.mir.control_helpers(); - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); - let extent = block - .instructions - .iter() - .find_map(|instruction| match instruction { - I::Call { - arguments, - contract: Some(contract), - .. - } if contract.0 == close => Some(arguments[0]), - _ => None, - }) - .unwrap(); - let Some(T::Jump { arguments, .. }) = &mut block.terminator else { - panic!("finish loop transition") - }; - arguments[4] = extent; - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("restore the queue and parent from the same frame")), - "{errors:?}" - ); -} - -#[test] -fn cc_rejects_a_finish_disguised_as_a_valid_lifetime_check() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let helpers = &input.cc.representations.control_helpers; - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let check = helpers - .iter() - .position(|helper| helper.role() == R::Check) - .unwrap() as u32; - let check_function = helpers[check as usize].function(); - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - assert!(leaf( - &mut function.assignments, - close, - &mut |body, index| { - let A::DirectCall { - contract, function, .. - } = &mut body[index].kind - else { - unreachable!() - }; - *contract = Some(psrs_backend::cc::ControlHelperId(check)); - *function = check_function; - } - )); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("transition does not close its frame")), - "{errors:?}" - ); -} - -#[test] -fn optimized_mir_rejects_a_finish_without_a_close() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let helpers = stages.mir.control_helpers(); - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); - let index = block.instructions.iter().position(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close)).unwrap(); - block.instructions.remove(index); - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("transition does not close its frame")), - "{errors:?}" - ); -} - -#[test] -fn cc_rejects_a_parent_projected_from_another_finish_frame() { - let input = mutate_cc(&mut |body, index| { - let next = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { arguments, .. } if arguments.len() == 6 => { - Some((arguments[3], arguments[4])) - } - _ => None, - }) - .unwrap(); - let parent = body - .iter_mut() - .find(|assignment| assignment.destination == next.1) - .unwrap(); - let A::VariantGet { value, .. } = &mut parent.kind else { - unreachable!() - }; - *value = next.0; - }); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("restore the queue and parent from the same frame")), - "{errors:?}" - ); -} - -#[test] -fn optimized_mir_rejects_a_parent_from_a_different_finish_frame() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let helpers = stages.mir.control_helpers(); - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let block = function.blocks.iter_mut().find(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(contract), .. } if contract.0 == close))).unwrap(); - let Some(T::Jump { arguments, .. }) = &block.terminator else { - panic!("finish loop transition") - }; - let (queue, parent) = (arguments[3], arguments[4]); - let cast = block - .instructions - .iter() - .find_map(|instruction| match instruction { - I::StructGet { - destination, value, .. - } if *destination == parent => Some(*value), - _ => None, - }) - .unwrap(); - let cast = block - .instructions - .iter_mut() - .find(|instruction| instruction.destination() == Some(cast)) - .unwrap(); - let I::RefCast { value, .. } = cast else { - panic!("physical finish projection") - }; - *value = queue; - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("restore the queue and parent from the same frame")), - "{errors:?}" - ); -} - -#[test] -fn checked_reference_identity_aliases_preserve_finish_ownership() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let helpers = &input.cc.representations.control_helpers; - let close = helpers - .iter() - .position(|helper| helper.role() == R::Close) - .unwrap() as u32; - let executor = helpers - .iter() - .find(|helper| helper.role() == R::Executor) - .unwrap() - .function(); - let queue_shape = input - .cc - .representations - .signature( - helpers - .iter() - .find(|helper| helper.role() == R::CloneSequence) - .unwrap() - .signature(), - ) - .unwrap() - .parameters[0]; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == executor) - .unwrap(); - let alias = psrs_backend::cc::ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let mut source = None; - assert!(leaf( - &mut function.assignments, - close, - &mut |body, index| { - let parent = body[index + 1..] - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { arguments, .. } if arguments.len() == 6 => Some(arguments[4]), - _ => None, - }) - .unwrap(); - let definition = body - .iter() - .position(|assignment| assignment.destination == parent) - .unwrap(); - let A::VariantGet { value, .. } = &mut body[definition].kind else { - unreachable!() - }; - source = Some(*value); - *value = alias; - let owner = source.unwrap(); - let span = body[definition].span; - body.insert( - definition, - Assignment { - destination: alias, - span, - kind: A::AggregateConvert { - destination: alias, - value: owner, - conversion: psrs_backend::cc::AggregateConvert { - source: queue_shape, - destination: queue_shape, - plan: psrs_backend::cc::ValueConversion::Identity, - }, - }, - }, - ); - } - )); - let shape = function - .values - .iter() - .find(|value| value.id == source.unwrap()) - .unwrap() - .ty; - function.values.push(psrs_backend::cc::ValueDecl { - id: alias, - ty: shape, - }); - psrs_backend::cc::verify_module(&input.cc).unwrap(); - psrs_backend::compile_cc(input).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/control_helper_contracts.rs b/crates/psrs-driver/src/tests/control_helper_contracts.rs deleted file mode 100644 index cc7db13c..00000000 --- a/crates/psrs-driver/src/tests/control_helper_contracts.rs +++ /dev/null @@ -1,284 +0,0 @@ -//! Same-shaped lifetime helpers must retain their semantic callee identity. -use psrs_backend::cc::{Assignment, AssignmentKind, ControlHelperId, ControlHelperRole}; -use psrs_backend::mir::{Instruction, Terminator}; - -const SOURCE: &str = r"module Main where -import Prim.Control as C -data Op next = Op (Int -> next) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: state, _2: raw (k 42) } -main :: Int -main = (C.run 0 handler (C.perform (Op \x -> x)))._2 -"; - -fn visit( - body: &mut [Assignment], - check: ControlHelperId, - replace: &mut impl FnMut(&mut AssignmentKind), -) -> bool { - for assignment in body { - if matches!(assignment.kind, AssignmentKind::DirectCall { contract: Some(id), .. } if id == check) - { - replace(&mut assignment.kind); - return true; - } - if let AssignmentKind::TagSwitch { - cases, - default_assignments, - .. - } = &mut assignment.kind - { - for case in cases { - if visit(&mut case.assignments, check, replace) { - return true; - } - } - if visit(default_assignments, check, replace) { - return true; - } - } - } - false -} - -#[test] -fn cc_rejects_exchanging_check_and_close_despite_equal_signatures() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let table = &input.cc.representations; - let check = table - .control_helpers - .iter() - .position(|helper| helper.role() == ControlHelperRole::Check) - .unwrap(); - let close = table - .control_helpers - .iter() - .find(|helper| helper.role() == ControlHelperRole::Close) - .unwrap(); - assert_eq!( - table.signature(table.control_helpers[check].signature()), - table.signature(close.signature()) - ); - let close = close.function(); - assert!(input.cc.functions.iter_mut().any(|function| visit( - &mut function.assignments, - ControlHelperId(check as u32), - &mut |kind| { - let AssignmentKind::DirectCall { function, .. } = kind else { - unreachable!() - }; - *function = close; - } - ))); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("predeclared semantic helper")), - "{errors:?}" - ); -} - -#[test] -fn cc_rejects_removing_a_machine_call_contract() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let check = input - .cc - .representations - .control_helpers - .iter() - .position(|helper| helper.role() == ControlHelperRole::Check) - .unwrap(); - assert!(input.cc.functions.iter_mut().any(|function| visit( - &mut function.assignments, - ControlHelperId(check as u32), - &mut |kind| { - let AssignmentKind::DirectCall { contract, .. } = kind else { - unreachable!() - }; - *contract = None; - } - ))); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("missing its semantic contract")), - "{errors:?}" - ); -} - -#[test] -fn optimized_mir_rejects_exchanging_check_and_close() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let check = stages - .mir - .control_helpers() - .iter() - .position(|helper| helper.role() == ControlHelperRole::Check) - .unwrap(); - let close = stages - .mir - .control_helpers() - .iter() - .find(|helper| helper.role() == ControlHelperRole::Close) - .unwrap() - .function(); - let call = stages - .mir - .functions - .iter_mut() - .flat_map(|function| &mut function.blocks) - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - Instruction::Call { - function, - contract: Some(id), - .. - } if id.0 as usize == check => Some(function), - _ => None, - }) - .expect("optimized execution retains a lifetime check"); - *call = close; - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("predeclared semantic helper")), - "{errors:?}" - ); -} - -#[test] -fn mir_tail_calls_retain_the_predeclared_helper_identity() { - let stages = crate::compile_main_stages(SOURCE).unwrap(); - let helpers = stages.mir.control_helpers(); - let mut count = 0; - for block in stages - .mir - .functions - .iter() - .flat_map(|function| &function.blocks) - { - if let Some(Terminator::ReturnCall { - function, - contract: Some(contract), - .. - }) = block.terminator - { - assert_eq!(helpers[contract.0 as usize].function(), function); - count += 1; - } - } - assert!( - count > 0, - "machine mutual tail calls retain their callee proof" - ); -} - -#[test] -fn p9_rejects_a_wrong_helper_before_lowering_or_loopifying_calls() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let check = input - .cc - .representations - .control_helpers - .iter() - .position(|helper| helper.role() == ControlHelperRole::Check) - .unwrap(); - let close = input - .cc - .representations - .control_helpers - .iter() - .find(|helper| helper.role() == ControlHelperRole::Close) - .unwrap() - .function(); - assert!(input.cc.functions.iter_mut().any(|function| visit( - &mut function.assignments, - ControlHelperId(check as u32), - &mut |kind| { - let AssignmentKind::DirectCall { function, .. } = kind else { - unreachable!() - }; - *function = close; - } - ))); - let errors = psrs_backend::mir::lower_module_with_bindings( - input.cc, - input.externals, - psrs_backend::TargetCapabilities::default(), - ) - .err() - .expect("P9 rejects the wrong semantic helper"); - assert!( - errors - .iter() - .any(|error| error.message.contains("predeclared semantic helper")), - "{errors:?}" - ); -} - -#[test] -fn mir_rejects_missing_identity_on_a_tail_helper_call() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let contract = stages - .mir - .functions - .iter_mut() - .flat_map(|function| &mut function.blocks) - .find_map(|block| match &mut block.terminator { - Some(Terminator::ReturnCall { contract, .. }) if contract.is_some() => Some(contract), - _ => None, - }) - .unwrap(); - *contract = None; - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("missing its semantic contract")), - "{errors:?}" - ); -} - -#[test] -fn control_helper_contracts_execute_long_requests_without_tail_call_capability() { - let Some(()) = super::wasmtime_available() else { - return; - }; - let source = format!( - r"{} -go :: Int -> C.Control Op Int -go n = if intEq n 0 then C.return 42 else C.bind (C.perform (Op \x -> x)) (\_ -> go (intSub n 1)) -main :: Int -main = let result = C.run 0 handler (go 100000) - in if intEq result._1 100000 then result._2 else 0 -", - SOURCE[..SOURCE.find("main ::").unwrap()].replace("{ _1: state,", "{ _1: intAdd state 1,") - ); - let target = psrs_backend::TargetCapabilities { - tail_call: false, - ..Default::default() - }; - let stages = crate::compile_main_with_target(&source, target).unwrap(); - assert!( - stages - .mir - .functions - .iter() - .flat_map(|function| &function.blocks) - .all(|block| !matches!( - block.terminator, - Some(Terminator::ReturnCall { .. } | Terminator::ReturnCallRef { .. }) - )) - ); - let path = std::env::temp_dir().join("psrs-control-no-tail-contracts.wasm"); - std::fs::write(&path, &stages.artifact.wasm).unwrap(); - let output = std::process::Command::new("wasmtime") - .args(["run", "-W", "tail-call=n"]) - .arg(&path) - .output() - .unwrap(); - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} diff --git a/crates/psrs-driver/src/tests/control_inlined_publication.rs b/crates/psrs-driver/src/tests/control_inlined_publication.rs deleted file mode 100644 index 4b8c8960..00000000 --- a/crates/psrs-driver/src/tests/control_inlined_publication.rs +++ /dev/null @@ -1,147 +0,0 @@ -//! Physical inlined factory cells are checked at the source publication witness. -use super::control_checkpoints::SOURCE; -use psrs_backend::mir::Instruction as I; -use psrs_backend::types::{ValueDecl, ValueId, ValueType}; -use psrs_hir::Intrinsic; -use std::collections::HashMap; - -fn origin(definitions: &HashMap, mut value: ValueId) -> ValueId { - for _ in 0..definitions.len() { - match definitions.get(&value) { - Some(I::Copy { value: next, .. } | I::RefCast { value: next, .. }) => value = *next, - _ => break, - } - } - value -} - -#[test] -fn inlined_start_and_once_check_current_contents_at_publication() { - let owned = SOURCE.replace( - "main = (C.run 0 handler (C.perform (Op \\x -> x)))._2", - "main = let owner = C.once (\\n -> C.return n) in (C.run 0 handler (C.resume owner 42))._2", - ); - for operation in [Intrinsic::ControlRun, Intrinsic::ControlOnce] { - for final_status in [0, 2] { - let mut stages = crate::compile_main_stages(if operation == Intrinsic::ControlRun { - SOURCE - } else { - &owned - }) - .unwrap(); - let table = &stages.cc.representations; - let function = stages.mir.functions.iter_mut().find(|f| f.blocks.iter().flat_map(|b| &b.instructions).any(|i| matches!(i, I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == operation))).unwrap(); - let definitions = function - .blocks - .iter() - .flat_map(|b| &b.instructions) - .filter_map(|i| i.destination().map(|v| (v, i.clone()))) - .collect::>(); - let (implementation, witness) = function - .blocks - .iter() - .flat_map(|b| &b.instructions) - .find_map(|i| match i { - I::ControlEvidence { - contract, - implementation, - .. - } if table.control_contracts[contract.0 as usize].operation() == operation => { - Some(( - origin(&definitions, *implementation), - i.destination().unwrap(), - )) - } - _ => None, - }) - .unwrap(); - let frame = if operation == Intrinsic::ControlRun { - let I::Call { arguments, .. } = &definitions[&implementation] else { - panic!("executor") - }; - origin(&definitions, arguments[4]) - } else { - implementation - }; - let I::StructNew { arguments, .. } = &definitions[&frame] else { - panic!("inlined factory") - }; - let cell = origin( - &definitions, - arguments[if operation == Intrinsic::ControlRun { - 1 - } else { - 2 - }], - ); - let I::ArrayNew { type_index, .. } = &definitions[&cell] else { - panic!("fresh status") - }; - let fresh = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.extend([ - ValueDecl { - id: fresh, - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(fresh.0 + 1), - ty: ValueType::I32, - }, - ]); - let point = if operation == Intrinsic::ControlRun { - implementation - } else { - witness - }; - let block = function - .blocks - .iter_mut() - .find(|b| { - b.instructions - .iter() - .any(|i| i.destination() == Some(point)) - }) - .unwrap(); - let index = block - .instructions - .iter() - .position(|i| i.destination() == Some(point)) - .unwrap(); - let span = function.span; - block.instructions.splice( - index..index, - [ - I::Constant { - destination: fresh, - value: final_status, - span, - }, - I::Constant { - destination: ValueId(fresh.0 + 1), - value: 0, - span, - }, - I::ArraySet { - type_index: *type_index, - value: cell, - index: ValueId(fresh.0 + 1), - new_value: fresh, - span, - }, - ], - ); - let verdict = psrs_backend::mir::verify_module(&stages.mir); - if final_status == 0 { - verdict.expect("current published state remains live"); - } else { - let errors = verdict.expect_err("inlined factory published a spent cell"); - assert!( - errors - .iter() - .any(|e| e.pass == "P9 MIR control publication"), - "{operation:?}: {errors:?}" - ); - } - } - } -} diff --git a/crates/psrs-driver/src/tests/control_lifecycle_bodies.rs b/crates/psrs-driver/src/tests/control_lifecycle_bodies.rs deleted file mode 100644 index fc7b154a..00000000 --- a/crates/psrs-driver/src/tests/control_lifecycle_bodies.rs +++ /dev/null @@ -1,181 +0,0 @@ -//! Semantic helper IDs cannot replace proofs of their actual extent behavior. -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R}; -use psrs_backend::mir::{BasicBlock, Instruction as I, Terminator as T}; - -fn visit(body: &mut [Assignment], mutation: &mut impl FnMut(&mut A) -> bool) -> bool { - for assignment in body { - if mutation(&mut assignment.kind) { - return true; - } - match &mut assignment.kind { - A::TagSwitch { - cases, - default_assignments, - .. - } => { - for case in cases { - if visit(&mut case.assignments, mutation) { - return true; - } - } - if visit(default_assignments, mutation) { - return true; - } - } - A::If { - then_assignments, - else_assignments, - .. - } => { - if visit(then_assignments, mutation) || visit(else_assignments, mutation) { - return true; - } - } - _ => {} - } - } - false -} - -#[test] -fn cc_lifecycle_bodies_reject_identity_wrong_guard_write_and_ancestry() { - for role in [R::Check, R::Close] { - for mutation in 0..4 { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, role); - let function = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let parameter = function.parameters[0]; - match mutation { - 0 => { - function.assignments.clear(); - function.result = parameter; - } - 1 => assert!(visit(&mut function.assignments, &mut |kind| match kind { - A::Constant(value) if *value == if role == R::Check { 0 } else { 1 } => { - *value = 2; - true - } - _ => false, - })), - 2 if role == R::Check => { - assert!(visit(&mut function.assignments, &mut |kind| match kind { - A::TagSwitch { cases, .. } if cases.len() == 1 => { - cases[0].tag = 1; - true - } - _ => false, - })) - } - 2 => assert!(visit(&mut function.assignments, &mut |kind| match kind { - A::ArraySet { - value, - destination, - representation, - .. - } => { - *kind = A::RepresentationCast { - value: *value, - destination: *destination, - reference: psrs_backend::cc::Reference { - nullable: false, - heap: psrs_backend::cc::RefShape::Repr(*representation), - }, - }; - true - } - _ => false, - })), - _ if role == R::Check => { - assert!(visit(&mut function.assignments, &mut |kind| match kind { - A::DirectCall { - function: target, - arguments, - .. - } if *target == symbol => { - arguments[0] = parameter; - true - } - _ => false, - })) - } - _ => assert!(visit(&mut function.assignments, &mut |kind| match kind { - A::ArraySet { value, .. } => { - *value = parameter; - true - } - _ => false, - })), - } - let errors = - psrs_backend::cc::verify_module(&input.cc).expect_err("malformed lifecycle body"); - assert!( - errors - .iter() - .any(|e| e.pass == "P8 CC lifecycle body" || e.pass == "P8 CC verification"), - "{role:?}/{mutation}: {errors:?}" - ); - } - } -} - -#[test] -fn mir_lifecycle_bodies_reject_identity_wrong_status_and_missing_close() { - for role in [R::Check, R::Close] { - for mutation in 0..3 { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, role); - let mut module = psrs_backend::mir::lower_module(input.cc).unwrap().0; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - match mutation { - 0 => { - function.result = function.parameters[0]; - function.blocks = vec![BasicBlock { - id: function.entry, - parameters: vec![], - instructions: vec![], - terminator: Some(T::Return { - value: function.result, - span: function.span, - }), - }]; - } - 1 => { - let I::Constant { value, .. } = function.blocks.iter_mut().flat_map(|b| &mut b.instructions).find(|i| matches!(i, I::Constant { value, .. } if *value == if role == R::Check {0} else {1})).unwrap() else { unreachable!() }; - *value = 2; - } - _ if role == R::Close => { - for block in &mut function.blocks { - block - .instructions - .retain(|i| !matches!(i, I::ArraySet { .. })); - } - } - _ => { - for block in &mut function.blocks { - if let Some(T::Jump { arguments, .. }) = &mut block.terminator - && arguments.len() == 1 - { - arguments[0] = function.parameters[0]; - } - } - } - } - let errors = psrs_backend::mir::verify_module(&module) - .expect_err("malformed physical lifecycle body"); - assert!( - errors.iter().any(|e| e.pass == "P9 MIR lifecycle body"), - "{role:?}/{mutation}: {errors:?}" - ); - } - } -} diff --git a/crates/psrs-driver/src/tests/control_observable_paths.rs b/crates/psrs-driver/src/tests/control_observable_paths.rs deleted file mode 100644 index 8adca3e1..00000000 --- a/crates/psrs-driver/src/tests/control_observable_paths.rs +++ /dev/null @@ -1,228 +0,0 @@ -//! Complete helper paths reject extra effects before dispatch and before traps. -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::{ - Assignment, AssignmentKind as A, ControlHelperRole as R, ValueDecl, ValueId, -}; - -#[test] -fn cc_executor_prefix_and_trapping_default_reject_extra_static_checks() { - for prefix in [false, true] { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (executor, _) = binding(&input.cc.representations, R::Executor); - let (check, contract) = binding(&input.cc.representations, R::Check); - let function = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == executor) - .unwrap(); - let extent = function.parameters[4]; - let ty = function.values.iter().find(|v| v.id == extent).unwrap().ty; - let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.push(ValueDecl { - id: destination, - ty, - }); - let extra = Assignment { - destination, - kind: A::DirectCall { - contract: Some(contract), - function: check, - arguments: vec![extent], - }, - span: function.span, - }; - if prefix { - function.assignments.insert(0, extra); - } else { - let A::TagSwitch { - default_assignments, - .. - } = &mut function.assignments.last_mut().unwrap().kind - else { - panic!("dispatch") - }; - default_assignments.insert(0, extra); - } - let errors = - psrs_backend::cc::verify_module(&input.cc).expect_err("unaccounted static check"); - assert!( - errors.iter().any(|e| matches!( - e.pass, - "P8 CC root and queue effects" | "P8 CC owned execution" - )), - "{prefix}: {errors:?}" - ); - } -} - -#[test] -fn cc_publication_rejects_an_extra_potentially_trapping_check() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (start, _) = binding(&input.cc.representations, R::Start); - let (check, contract) = binding(&input.cc.representations, R::Check); - let function = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == start) - .unwrap(); - let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.push(ValueDecl { - id: destination, - ty: function.result_type, - }); - function.assignments.push(Assignment { - destination, - kind: A::DirectCall { - contract: Some(contract), - function: check, - arguments: vec![function.result], - }, - span: function.span, - }); - let errors = - psrs_backend::cc::verify_module(&input.cc).expect_err("read-only is not unobservable"); - assert!( - errors - .iter() - .any(|e| e.pass == "P8 CC control initialization"), - "{errors:?}" - ); -} - -#[test] -fn cc_executor_rejects_unused_erased_payload_recovery() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (executor, _) = binding(&input.cc.representations, R::Executor); - let function = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == executor) - .unwrap(); - let ty = function - .values - .iter() - .find(|v| v.id == function.parameters[2]) - .unwrap() - .ty; - let psrs_backend::cc::ValueShape::Reference(reference) = ty else { - panic!("computation") - }; - let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.push(ValueDecl { - id: destination, - ty, - }); - function.assignments.insert( - 0, - Assignment { - destination, - kind: A::RepresentationCast { - destination, - value: function.parameters[0], - reference, - }, - span: function.span, - }, - ); - let errors = - psrs_backend::cc::verify_module(&input.cc).expect_err("unaccounted payload recovery"); - assert!( - errors - .iter() - .any(|e| e.message.contains("reference refinement")), - "{errors:?}" - ); -} - -#[test] -fn cc_no_write_recursive_calls_are_not_total() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (executor, _) = binding(&input.cc.representations, R::Executor); - let original = input - .cc - .functions - .iter() - .find(|f| f.symbol == executor) - .unwrap(); - let extent_ty = original - .values - .iter() - .find(|v| v.id == original.parameters[4]) - .unwrap() - .ty; - let symbol = psrs_hir::SymbolId::new( - executor.module, - input - .cc - .functions - .iter() - .filter(|f| f.symbol.module == executor.module) - .map(|f| f.symbol.index) - .max() - .unwrap() - + 1, - ); - let span = original.span; - input.cc.functions.push(psrs_backend::cc::Function { - symbol, - name: "recursive_no_write".into(), - parameters: vec![ValueId(0)], - values: vec![ - ValueDecl { - id: ValueId(0), - ty: extent_ty, - }, - ValueDecl { - id: ValueId(1), - ty: extent_ty, - }, - ], - assignments: vec![Assignment { - destination: ValueId(1), - kind: A::DirectCall { - contract: None, - function: symbol, - arguments: vec![ValueId(0)], - }, - span, - }], - result: ValueId(1), - result_type: extent_ty, - span, - }); - let function = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == executor) - .unwrap(); - let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.push(ValueDecl { - id: destination, - ty: extent_ty, - }); - function.assignments.insert( - 0, - Assignment { - destination, - kind: A::DirectCall { - contract: None, - function: symbol, - arguments: vec![function.parameters[4]], - }, - span, - }, - ); - let errors = psrs_backend::cc::verify_module(&input.cc) - .expect_err("an extra recursive call can diverge"); - assert!( - errors.iter().any(|e| matches!( - e.pass, - "P8 CC owned execution" | "P8 CC root and queue effects" - )), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_owned_steps/cc.rs b/crates/psrs-driver/src/tests/control_owned_steps/cc.rs deleted file mode 100644 index 42ef60dc..00000000 --- a/crates/psrs-driver/src/tests/control_owned_steps/cc.rs +++ /dev/null @@ -1,228 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, BinaryOp, ValueDecl, ValueId, ValueShape}; - -pub(super) fn check(mutation: Option, equality: bool) { - use Mutation::*; - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let parameters = function.parameters.clone(); - let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { - panic!("executor input") - }; - let case = cases.iter_mut().find(|case| case.tag == 5).unwrap(); - let body = &mut case.assignments; - let stores = body - .iter() - .enumerate() - .filter_map(|(index, assignment)| { - matches!(assignment.kind, A::ArraySet { .. }).then_some(index) - }) - .collect::>(); - assert_eq!(stores.len(), 3); - let reads = body - .iter() - .enumerate() - .filter_map(|(index, assignment)| { - matches!(assignment.kind, A::ArrayGet { .. }).then_some(index) - }) - .collect::>(); - let guard = body - .iter() - .position(|assignment| matches!(assignment.kind, A::TagSwitch { .. })) - .unwrap(); - let call = body - .iter() - .position(|assignment| matches!(assignment.kind, A::IndirectCall { .. })) - .unwrap(); - let [running, consumed] = [stores[0], stores[2]].map(|index| match body[index].kind { - A::ArraySet { new_value, .. } => new_value, - _ => unreachable!(), - }); - let fresh = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - if equality { - let old = body[guard].clone(); - let A::TagSwitch { - value, - cases, - default_assignments, - default_value, - } = old.kind - else { - unreachable!() - }; - let zero = fresh; - let predicate = ValueId(fresh.0 + 1); - function.values.extend([ - ValueDecl { - id: zero, - ty: ValueShape::Integer, - }, - ValueDecl { - id: predicate, - ty: ValueShape::Boolean, - }, - ]); - body.splice( - guard..=guard, - [ - Assignment { - destination: zero, - kind: A::Constant(0), - span: old.span, - }, - Assignment { - destination: predicate, - kind: A::Primitive { - op: BinaryOp::IntEq, - left: value, - right: zero, - }, - span: old.span, - }, - Assignment { - destination: old.destination, - kind: A::If { - condition: predicate, - then_assignments: cases[0].assignments.clone(), - then_value: cases[0].value, - else_assignments: default_assignments, - else_value: default_value, - }, - span: old.span, - }, - ], - ); - } - if let Some(mutation) = mutation { - match mutation { - Guard => { - body.remove(guard); - } - GuardTag => { - let A::TagSwitch { cases, .. } = &mut body[guard].kind else { - unreachable!() - }; - cases[0].tag = 1; - } - Running | Clear | Consumed => { - body.remove( - stores[match mutation { - Running => 0, - Clear => 1, - _ => 2, - }], - ); - } - RunningValue | ConsumedValue | StateOrder => { - for assignment in body { - if assignment.destination == running - && matches!(mutation, RunningValue | StateOrder) - { - assignment.kind = - A::Constant(if matches!(mutation, StateOrder) { 2 } else { 3 }); - } - if assignment.destination == consumed - && matches!(mutation, ConsumedValue | StateOrder) - { - assignment.kind = - A::Constant(if matches!(mutation, StateOrder) { 1 } else { 3 }); - } - } - } - ClearValue => { - let result = body[reads[1]].destination; - let A::ArraySet { new_value, .. } = &mut body[stores[1]].kind else { - unreachable!() - }; - *new_value = result; - } - ReadOrder => { - let A::ArrayGet { index: zero, .. } = body[reads[0]].kind else { - unreachable!() - }; - let mut read = body.remove(reads[1]); - let A::ArrayGet { index, .. } = &mut read.kind else { - unreachable!() - }; - *index = zero; - body.insert(stores[0], read); - } - Callee | Answer => { - let A::IndirectCall { - function: callee, - arguments, - .. - } = &mut body[call].kind - else { - unreachable!() - }; - if matches!(mutation, Callee) { - *callee = parameters[1] - } else { - arguments[0] = parameters[0] - } - } - Result => { - let A::DirectCall { arguments, .. } = &mut body - .iter_mut() - .find(|assignment| matches!(assignment.kind, A::DirectCall { .. })) - .unwrap() - .kind - else { - unreachable!() - }; - arguments[2] = parameters[2]; - } - ExtraCall => { - let mut extra = body[call].clone(); - let ty = function - .values - .iter() - .find(|value| value.id == extra.destination) - .unwrap() - .ty; - extra.destination = fresh; - function.values.push(ValueDecl { id: fresh, ty }); - body.insert(call + 1, extra); - } - ExtraStore => { - let mut extra = body[stores[2]].clone(); - let A::ArrayGet { index: zero, .. } = body[reads[0]].kind else { - unreachable!() - }; - let A::ArraySet { new_value, .. } = &mut extra.kind else { - unreachable!() - }; - *new_value = zero; - body.insert(stores[2] + 1, extra); - } - } - } - let result = psrs_backend::cc::verify_module(&input.cc); - if mutation.is_some() { - let errors = result.expect_err("malformed owned transfer"); - assert!( - errors - .iter() - .any(|error| error.pass == "P8 CC owned execution"), - "{mutation:?}: {errors:?}" - ); - } else { - result.expect("equivalent Pending predicate"); - psrs_backend::compile_cc(input).expect("equivalent Pending guard compiles through MIR"); - } -} diff --git a/crates/psrs-driver/src/tests/control_owned_steps/mir.rs b/crates/psrs-driver/src/tests/control_owned_steps/mir.rs deleted file mode 100644 index 0c2c74d2..00000000 --- a/crates/psrs-driver/src/tests/control_owned_steps/mir.rs +++ /dev/null @@ -1,305 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::mir::{Instruction as I, NumericOp, Terminator as T}; -use psrs_backend::types::{ValueDecl, ValueId, ValueType}; - -pub(super) fn check(mutation: Option, equality: bool) { - use Mutation::*; - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let header = match function - .blocks - .iter() - .find(|block| block.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - { - T::Jump { target, .. } => *target, - _ => panic!("loop header"), - }; - let parameters = function - .blocks - .iter() - .find(|block| block.id == header) - .unwrap() - .parameters - .clone(); - let owned = function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Switch { cases, .. }) - if cases.iter().map(|(tag, _)| *tag).collect::>() - == vec![0, 1, 2, 3, 4, 5] => - { - Some(cases.iter().find(|(tag, _)| *tag == 5).unwrap().1) - } - _ => None, - }) - .unwrap(); - let (guard_id, mut transfer_id) = { - let block = function - .blocks - .iter() - .find(|block| block.id == owned) - .unwrap(); - let T::Switch { cases, .. } = block.terminator.as_ref().unwrap() else { - panic!("Pending guard") - }; - (owned, cases[0].1) - }; - loop { - let block = function - .blocks - .iter() - .find(|block| block.id == transfer_id) - .unwrap(); - if block - .instructions - .iter() - .any(|instruction| matches!(instruction, I::ArraySet { .. })) - { - break; - } - let T::Jump { target, .. } = block.terminator.as_ref().unwrap() else { - panic!("guard join") - }; - transfer_id = *target; - } - let status_index = function - .blocks - .iter() - .find(|block| block.id == guard_id) - .unwrap() - .instructions - .iter() - .find_map(|instruction| match instruction { - I::ArrayGet { index, .. } => Some(*index), - _ => None, - }) - .unwrap(); - let fresh = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let span = function.span; - if equality { - function.values.extend([ - ValueDecl { - id: fresh, - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(fresh.0 + 1), - ty: ValueType::Boolean, - }, - ]); - let block = function - .blocks - .iter_mut() - .find(|block| block.id == guard_id) - .unwrap(); - let T::Switch { - value, - cases, - default, - span, - } = block.terminator.take().unwrap() - else { - unreachable!() - }; - block.instructions.extend([ - I::Constant { - destination: fresh, - value: 0, - span, - }, - I::Primitive { - destination: ValueId(fresh.0 + 1), - op: NumericOp::I32Eq, - left: value, - right: fresh, - span, - }, - ]); - block.terminator = Some(T::Branch { - condition: ValueId(fresh.0 + 1), - then_block: cases[0].1, - else_block: default, - span, - }); - } - if let Some(mutation) = mutation { - if matches!(mutation, Guard | GuardTag) { - let block = function - .blocks - .iter_mut() - .find(|block| block.id == guard_id) - .unwrap(); - match mutation { - Guard => { - block.terminator = Some(T::Jump { - target: match block.terminator.as_ref().unwrap() { - T::Switch { cases, .. } => cases[0].1, - _ => unreachable!(), - }, - arguments: vec![], - span, - }) - } - GuardTag => { - let T::Switch { cases, .. } = block.terminator.as_mut().unwrap() else { - unreachable!() - }; - cases[0].0 = 1; - } - _ => unreachable!(), - } - } else { - let block = function - .blocks - .iter_mut() - .find(|block| block.id == transfer_id) - .unwrap(); - let stores = block - .instructions - .iter() - .enumerate() - .filter_map(|(index, instruction)| { - matches!(instruction, I::ArraySet { .. }).then_some(index) - }) - .collect::>(); - assert_eq!(stores.len(), 3); - let call = block - .instructions - .iter() - .position(|instruction| matches!(instruction, I::ClosureCall { .. })) - .unwrap(); - let read = block - .instructions - .iter() - .position(|instruction| matches!(instruction, I::ArrayGet { .. })) - .unwrap(); - let [running, consumed] = - [stores[0], stores[2]].map(|index| match block.instructions[index] { - I::ArraySet { new_value, .. } => new_value, - _ => unreachable!(), - }); - match mutation { - Running | Clear | Consumed => { - block.instructions.remove( - stores[match mutation { - Running => 0, - Clear => 1, - _ => 2, - }], - ); - } - RunningValue | ConsumedValue | StateOrder => { - for instruction in &mut block.instructions { - if instruction.destination() == Some(running) - && matches!(mutation, RunningValue | StateOrder) - { - let I::Constant { value, .. } = instruction else { - panic!("Running literal") - }; - *value = if matches!(mutation, StateOrder) { 2 } else { 3 }; - } - if instruction.destination() == Some(consumed) - && matches!(mutation, ConsumedValue | StateOrder) - { - let I::Constant { value, .. } = instruction else { - panic!("Consumed literal") - }; - *value = if matches!(mutation, StateOrder) { 1 } else { 3 }; - } - } - } - ClearValue => { - let result = block.instructions[read].destination().unwrap(); - let I::ArraySet { new_value, .. } = &mut block.instructions[stores[1]] else { - unreachable!() - }; - *new_value = result; - } - ReadOrder => { - let mut loaded = block.instructions.remove(read); - let I::ArrayGet { index, .. } = &mut loaded else { - unreachable!() - }; - *index = status_index; - block.instructions.insert(stores[0], loaded); - } - Callee | Answer => { - let I::ClosureCall { - function: callee, - arguments, - .. - } = &mut block.instructions[call] - else { - unreachable!() - }; - if matches!(mutation, Callee) { - *callee = parameters[1] - } else { - arguments[0] = parameters[0] - } - } - Result => { - let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { - unreachable!() - }; - arguments[2] = parameters[2]; - } - ExtraCall => { - let mut extra = block.instructions[call].clone(); - let ty = function - .values - .iter() - .find(|value| Some(value.id) == extra.destination()) - .unwrap() - .ty; - let I::ClosureCall { destination, .. } = &mut extra else { - unreachable!() - }; - *destination = fresh; - function.values.push(ValueDecl { id: fresh, ty }); - block.instructions.insert(call + 1, extra); - } - ExtraStore => { - let mut extra = block.instructions[stores[2]].clone(); - let I::ArraySet { new_value, .. } = &mut extra else { - unreachable!() - }; - *new_value = status_index; - block.instructions.insert(stores[2] + 1, extra); - } - _ => unreachable!(), - } - } - } - let result = psrs_backend::mir::verify_module(&module); - if mutation.is_some() { - let errors = result.expect_err("malformed owned transfer"); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 MIR owned execution"), - "{mutation:?}: {errors:?}" - ); - } else { - result.expect("equivalent Pending predicate"); - } -} diff --git a/crates/psrs-driver/src/tests/control_owned_steps/mod.rs b/crates/psrs-driver/src/tests/control_owned_steps/mod.rs deleted file mode 100644 index 430ca58c..00000000 --- a/crates/psrs-driver/src/tests/control_owned_steps/mod.rs +++ /dev/null @@ -1,378 +0,0 @@ -//! One-shot transfer must be complete, ordered and free of extra callbacks. -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::ControlHelperRole as R; - -mod cc; -mod mir; - -#[derive(Clone, Copy, Debug)] -enum Mutation { - Guard, - GuardTag, - Running, - RunningValue, - Clear, - ClearValue, - Consumed, - ConsumedValue, - StateOrder, - ReadOrder, - Callee, - Answer, - Result, - ExtraCall, - ExtraStore, -} -const MUTATIONS: &[Mutation] = &[ - Mutation::Guard, - Mutation::GuardTag, - Mutation::Running, - Mutation::RunningValue, - Mutation::Clear, - Mutation::ClearValue, - Mutation::Consumed, - Mutation::ConsumedValue, - Mutation::StateOrder, - Mutation::ReadOrder, - Mutation::Callee, - Mutation::Answer, - Mutation::Result, - Mutation::ExtraCall, - Mutation::ExtraStore, -]; - -#[test] -fn cc_owned_execution_requires_the_complete_transfer() { - for mutation in MUTATIONS { - cc::check(Some(*mutation), false); - } -} -#[test] -fn mir_owned_execution_requires_the_complete_transfer() { - for mutation in MUTATIONS { - mir::check(Some(*mutation), false); - } -} -#[test] -fn cc_owned_pending_guard_accepts_integer_equality() { - cc::check(None, true); -} -#[test] -fn mir_owned_pending_guard_accepts_integer_equality() { - mir::check(None, true); -} - -#[test] -fn cc_private_cells_are_checked_at_publication() { - use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueDecl, ValueId, ValueShape}; - for role in [R::Start, R::Once] { - for final_value in [0, 2] { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, role); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let (cell, representation) = function - .assignments - .iter() - .find_map(|assignment| match &assignment.kind { - A::ArrayNew { - representation, - elements, - .. - } if elements.len() == 1 - && function.values.iter().any(|value| { - value.id == elements[0] && value.ty == ValueShape::Integer - }) => - { - Some((assignment.destination, *representation)) - } - _ => None, - }) - .unwrap(); - let fresh = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.extend([ - ValueDecl { - id: fresh, - ty: ValueShape::Integer, - }, - ValueDecl { - id: ValueId(fresh.0 + 1), - ty: ValueShape::Integer, - }, - ]); - function.assignments.extend([ - Assignment { - destination: fresh, - kind: A::Constant(final_value), - span: function.span, - }, - Assignment { - destination: ValueId(fresh.0 + 1), - kind: A::Constant(0), - span: function.span, - }, - Assignment { - destination: cell, - kind: A::ArraySet { - destination: cell, - representation, - value: cell, - index: ValueId(fresh.0 + 1), - new_value: fresh, - }, - span: function.span, - }, - ]); - let result = psrs_backend::cc::verify_module(&input.cc); - if final_value == 0 { - result.expect("live published cell after an in-place write"); - } else { - let errors = result.unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P8 CC control initialization"), - "{role:?}: {errors:?}" - ); - } - } - } -} - -#[test] -fn mir_private_cells_are_checked_at_publication() { - use psrs_backend::mir::Instruction as I; - use psrs_backend::types::{ValueDecl, ValueId, ValueType}; - for role in [R::Start, R::Once] { - for final_value in [0, 2] { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, role); - // Mutate retained helper bodies before generic inlining/reachability. - let mut module = psrs_backend::mir::lower_module(input.cc).unwrap().0; - let function = module - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let (cell, type_index) = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::ArrayNew { - destination, - type_index, - elements, - .. - } if elements.len() == 1 - && function.values.iter().any(|value| { - value.id == elements[0] - && matches!(value.ty, ValueType::I32 | ValueType::Boolean) - }) => - { - Some((*destination, *type_index)) - } - I::ArrayNewFilled { - destination, - type_index, - value, - .. - } if function.values.iter().any(|decl| { - decl.id == *value && matches!(decl.ty, ValueType::I32 | ValueType::Boolean) - }) => - { - Some((*destination, *type_index)) - } - _ => None, - }) - .unwrap_or_else(|| panic!("{role:?} factory: {function:#?}")); - let fresh = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.extend([ - ValueDecl { - id: fresh, - ty: ValueType::I32, - }, - ValueDecl { - id: ValueId(fresh.0 + 1), - ty: ValueType::I32, - }, - ]); - let block = function - .blocks - .iter_mut() - .find(|block| { - block - .instructions - .iter() - .any(|instruction| instruction.destination() == Some(cell)) - }) - .unwrap(); - block.instructions.extend([ - I::Constant { - destination: fresh, - value: final_value, - span: function.span, - }, - I::Constant { - destination: ValueId(fresh.0 + 1), - value: 0, - span: function.span, - }, - I::ArraySet { - type_index, - value: cell, - index: ValueId(fresh.0 + 1), - new_value: fresh, - span: function.span, - }, - ]); - let result = psrs_backend::mir::verify_module(&module); - if final_value == 0 { - result.expect("live published cell after an in-place write"); - } else { - let errors = result.unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 MIR control initialization"), - "{role:?}: {errors:?}" - ); - } - } - } -} - -#[test] -fn cc_cancellation_requires_pending_cancelled_and_clear() { - use psrs_backend::cc::AssignmentKind as A; - for mutation in 0..3 { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Cancel); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - match mutation { - 0 => { - function - .assignments - .retain(|assignment| !matches!(assignment.kind, A::TagSwitch { .. })); - } - 1 => { - let assignment = function - .assignments - .iter_mut() - .find(|assignment| matches!(assignment.kind, A::Constant(3))) - .unwrap(); - assignment.kind = A::Constant(2); - } - _ => { - let last = function - .assignments - .iter() - .rposition(|assignment| matches!(assignment.kind, A::ArraySet { .. })) - .unwrap(); - function.assignments.remove(last); - } - } - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P8 CC control initialization"), - "{mutation}: {errors:?}" - ); - } -} - -#[test] -fn mir_cancellation_requires_pending_cancelled_and_clear() { - use psrs_backend::mir::{Instruction as I, Terminator as T}; - for mutation in 0..3 { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Cancel); - // Mutate retained helper bodies before generic inlining/reachability. - let mut module = psrs_backend::mir::lower_module(input.cc).unwrap().0; - let function = module - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - match mutation { - 0 => { - let block = function - .blocks - .iter_mut() - .find(|block| matches!(block.terminator, Some(T::Switch { .. }))) - .unwrap(); - let T::Switch { cases, span, .. } = block.terminator.take().unwrap() else { - unreachable!() - }; - block.terminator = Some(T::Jump { - target: cases[0].1, - arguments: vec![], - span, - }); - } - 1 => { - let I::Constant { value, .. } = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find(|instruction| matches!(instruction, I::Constant { value: 3, .. })) - .unwrap() - else { - unreachable!() - }; - *value = 2; - } - _ => { - let block = function - .blocks - .iter_mut() - .find(|block| { - block - .instructions - .iter() - .any(|instruction| matches!(instruction, I::ArraySet { .. })) - }) - .unwrap(); - let last = block - .instructions - .iter() - .rposition(|instruction| matches!(instruction, I::ArraySet { .. })) - .unwrap(); - block.instructions.remove(last); - } - } - let errors = psrs_backend::mir::verify_module(&module).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 MIR control initialization"), - "{mutation}: {errors:?}" - ); - } -} diff --git a/crates/psrs-driver/src/tests/control_queue_steps/cc.rs b/crates/psrs-driver/src/tests/control_queue_steps/cc.rs deleted file mode 100644 index cf96d0a4..00000000 --- a/crates/psrs-driver/src/tests/control_queue_steps/cc.rs +++ /dev/null @@ -1,314 +0,0 @@ -use super::{Mutation, R, SOURCE, binding, path}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, Function, TagCase, ValueId}; - -fn arm<'a>(body: &'a mut [Assignment], path: &[i32]) -> &'a mut TagCase { - let A::TagSwitch { cases, .. } = &mut body - .iter_mut() - .find( - |assignment| matches!(&assignment.kind, A::TagSwitch { cases, .. } if cases.len() >= 2), - ) - .unwrap() - .kind - else { - unreachable!() - }; - let case = cases.iter_mut().find(|case| case.tag == path[0]).unwrap(); - if path.len() == 1 { - case - } else { - arm(&mut case.assignments, &path[1..]) - } -} - -fn origin(function: &Function, mut value: ValueId) -> ValueId { - let mut aliases = std::collections::HashMap::new(); - fn index(body: &[Assignment], aliases: &mut std::collections::HashMap) { - for assignment in body { - match &assignment.kind { - A::RepresentationCast { value, .. } => { - aliases.insert(assignment.destination, *value); - } - A::TagSwitch { cases, .. } => { - for case in cases { - index(&case.assignments, aliases) - } - } - _ => {} - } - } - } - index(&function.assignments, &mut aliases); - for _ in 0..aliases.len() { - if let Some(source) = aliases.get(&value) { - value = *source - } else { - break; - } - } - value -} - -pub(super) fn reject(mutation: Mutation) { - use Mutation::*; - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let parameters = function.parameters.clone(); - let signature = match function - .values - .iter() - .find(|value| value.id == parameters[1]) - .unwrap() - .ty - { - psrs_backend::cc::ValueShape::Reference(reference) => match reference.heap { - psrs_backend::cc::RefShape::Closure(signature) => signature, - _ => unreachable!(), - }, - _ => unreachable!(), - }; - let fresh = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(psrs_backend::cc::ValueDecl { - id: fresh, - ty: function.result_type, - }); - - let returned = arm(&mut function.assignments, path(mutation)).value; - let returned = origin(function, returned); - let function_snapshot = function.clone(); - let case = arm(&mut function.assignments, path(mutation)); - let body = &mut case.assignments; - let calls = body - .iter() - .filter_map(|assignment| { - matches!(assignment.kind, A::IndirectCall { .. }).then_some(assignment.destination) - }) - .collect::>(); - match mutation { - ExtraRootCall | ExtraQueueCall | EagerBind => { - let kind = if matches!(mutation, EagerBind) { - A::IndirectCall { - function: parameters[1], - signature, - arguments: vec![parameters[0]], - } - } else { - body.iter() - .rfind(|assignment| matches!(assignment.kind, A::IndirectCall { .. })) - .unwrap() - .kind - .clone() - }; - let position = body - .iter() - .position(|assignment| assignment.destination == returned) - .unwrap(); - body.insert( - position, - Assignment { - destination: fresh, - kind, - span: function_snapshot.span, - }, - ); - } - - HandlerState | Request | Handler | Raw | Callback | Answer => { - let index = match mutation { - HandlerState | Handler | Callback | Answer => 0, - Request => 1, - Raw => 2, - _ => unreachable!(), - }; - let raw = body - .iter() - .find(|assignment| matches!(assignment.kind, A::FunctionRef { .. })) - .map(|assignment| assignment.destination); - let replacement = if matches!(mutation, HandlerState) { - match &body - .iter() - .find(|assignment| assignment.destination == calls[1]) - .unwrap() - .kind - { - A::IndirectCall { arguments, .. } => arguments[0], - _ => unreachable!(), - } - } else if matches!(mutation, Handler) { - raw.unwrap() - } else if matches!(mutation, Callback) { - parameters[1] - } else { - parameters[0] - }; - let A::IndirectCall { - function: callee, - arguments, - .. - } = &mut body - .iter_mut() - .find(|assignment| assignment.destination == calls[index]) - .unwrap() - .kind - else { - unreachable!() - }; - if matches!(mutation, Handler | Callback) { - *callee = replacement - } else { - arguments[0] = replacement - } - } - TrapRoot | TrapCons => { - let assignment = body - .iter_mut() - .find(|assignment| assignment.destination == returned) - .unwrap(); - assignment.kind = A::Unreachable; - } - ReturnState | ReturnAnswer => { - let A::ProductNew { arguments, .. } = &mut body - .iter_mut() - .find(|assignment| matches!(assignment.kind, A::ProductNew { .. })) - .unwrap() - .kind - else { - unreachable!() - }; - if matches!(mutation, ReturnState) { - arguments[0] = arguments[1] - } else { - arguments[1] = parameters[0] - } - } - _ => { - let A::DirectCall { arguments, .. } = &body - .iter() - .find(|assignment| assignment.destination == returned) - .unwrap() - .kind - else { - panic!("transition") - }; - let next = arguments.clone(); - match mutation { - ResultState | ResultComputation | SourceQueue | Tail | EmptyAppend - | QueueFinishRest | QueueFinishParent => { - let A::DirectCall { arguments, .. } = &mut body - .iter_mut() - .find(|assignment| assignment.destination == returned) - .unwrap() - .kind - else { - unreachable!() - }; - let index = match mutation { - ResultState => 0, - ResultComputation => 2, - QueueFinishParent => 4, - _ => 3, - }; - arguments[index] = parameters[index]; - } - _ => { - let queue = origin(&function_snapshot, next[3]); - let A::VariantNew { fields, .. } = &body - .iter() - .find(|assignment| assignment.destination == queue) - .unwrap() - .kind - else { - panic!("new pending queue") - }; - let fields = fields.clone(); - match mutation { - AppendTail | AppendRight | FinishExtent | FinishParent => { - let A::VariantNew { fields, .. } = &mut body - .iter_mut() - .find(|assignment| assignment.destination == queue) - .unwrap() - .kind - else { - unreachable!() - }; - match mutation { - AppendTail => fields[0] = parameters[3], - AppendRight => fields[1] = fields[0], - FinishExtent => fields[0] = fields[2], - FinishParent => fields[2] = fields[0], - _ => unreachable!(), - } - } - AppendFirst => { - let nested = origin(&function_snapshot, fields[1]); - let A::VariantNew { fields: inner, .. } = &body - .iter() - .find(|assignment| assignment.destination == nested) - .unwrap() - .kind - else { - unreachable!() - }; - let second = inner[0]; - let A::VariantNew { fields, .. } = &mut body - .iter_mut() - .find(|assignment| assignment.destination == queue) - .unwrap() - .kind - else { - unreachable!() - }; - fields[0] = second; - } - AppendSecond | FinishRest => { - let nested = origin(&function_snapshot, fields[1]); - let A::VariantNew { fields: inner, .. } = &mut body - .iter_mut() - .find(|assignment| assignment.destination == nested) - .unwrap() - .kind - else { - unreachable!() - }; - inner[0] = if matches!(mutation, AppendSecond) { - fields[0] - } else { - parameters[3] - }; - } - _ => unreachable!(), - } - } - } - } - } - let errors = psrs_backend::cc::verify_module(&input.cc).expect_err("malformed root/queue step"); - assert!( - errors - .iter() - .any(|error| error.pass == "P8 CC root and queue execution" - || error.pass == "P8 CC root and queue effects" - || (matches!( - mutation, - Mutation::QueueFinishRest | Mutation::QueueFinishParent - ) && error.pass == "P8 CC control provenance") - || (matches!( - mutation, - Mutation::FinishExtent | Mutation::FinishParent | Mutation::FinishRest - ) && error.pass == "P8 CC finish creation")), - "{mutation:?}: {errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs b/crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs deleted file mode 100644 index 0f3063bd..00000000 --- a/crates/psrs-driver/src/tests/control_queue_steps/mir/effects.rs +++ /dev/null @@ -1,248 +0,0 @@ -use super::{R, SOURCE, binding, selected}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; -use psrs_backend::types::ValueId; - -#[test] -fn mir_machine_paths_reject_additional_writes_and_traps() { - use psrs_backend::types::{MemoryId, ValueDecl, ValueType}; - for kind in ["store", "trap"] { - for location in ["return", "default", "entry", "publication"] { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let role = if location == "publication" { - R::Start - } else { - R::Executor - }; - let (symbol, _) = binding(&input.cc.representations, role); - let mut module = if location == "publication" { - psrs_backend::mir::lower_module(input.cc).unwrap().0 - } else { - crate::compile_main_stages(SOURCE).unwrap().mir - }; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let id = if matches!(location, "entry" | "publication") { - function.entry - } else { - let T::Jump { target, .. } = function - .blocks - .iter() - .find(|b| b.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - else { - panic!("header") - }; - if location == "return" { - selected(function, *target, &[0, 0, 0]) - } else { - let T::Switch { default, .. } = function - .blocks - .iter() - .find(|b| b.id == *target) - .unwrap() - .terminator - .as_ref() - .unwrap() - else { - panic!("dispatch") - }; - *default - } - }; - let value = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - let ty = if kind == "store" { - ValueType::I32 - } else { - ValueType::Boolean - }; - function.values.push(ValueDecl { id: value, ty }); - let span = function.span; - let block = function.blocks.iter_mut().find(|b| b.id == id).unwrap(); - block.instructions.splice( - 0..0, - [ - I::Constant { - destination: value, - value: 1, - span, - }, - if kind == "store" { - I::Store { - address: value, - value, - memory: MemoryId(0), - offset: 0, - span, - } - } else { - I::TrapIf { - condition: value, - span, - } - }, - ], - ); - let errors = - psrs_backend::mir::verify_module(&module).expect_err("unaccounted operation"); - assert!( - errors.iter().any(|e| matches!( - e.pass, - "P9 MIR root and queue execution" | "P9 MIR control initialization" - )), - "{kind}/{location}: {errors:?}" - ); - } - } -} - -#[test] -fn mir_executor_rejects_an_unused_narrowing_cast_of_erased_state() { - use psrs_backend::types::{ValueDecl, ValueType}; - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let T::Jump { target, .. } = function - .blocks - .iter() - .find(|b| b.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - else { - panic!("header") - }; - let parameters = &function - .blocks - .iter() - .find(|b| b.id == *target) - .unwrap() - .parameters; - let state = parameters[0]; - let ValueType::Ref(reference) = function - .values - .iter() - .find(|v| v.id == parameters[2]) - .unwrap() - .ty - else { - panic!("computation") - }; - let id = selected(function, *target, &[0, 0, 0]); - let value = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.push(ValueDecl { - id: value, - ty: ValueType::Ref(reference), - }); - function - .blocks - .iter_mut() - .find(|b| b.id == id) - .unwrap() - .instructions - .push(I::RefCast { - destination: value, - value: state, - reference, - span: function.span, - }); - let errors = - psrs_backend::mir::verify_module(&module).expect_err("an unused cast may still trap"); - assert!( - errors - .iter() - .any(|e| e.pass == "P9 MIR root and queue execution"), - "{errors:?}" - ); -} - -#[test] -fn mir_failed_pending_guard_cannot_start_an_owned_transfer_before_trapping() { - use psrs_backend::types::{ValueDecl, ValueType}; - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let T::Jump { target, .. } = function - .blocks - .iter() - .find(|b| b.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - else { - panic!("header") - }; - let owned = selected(function, *target, &[5]); - let guard = function.blocks.iter().find(|b| b.id == owned).unwrap(); - let T::Switch { default, .. } = guard.terminator.as_ref().unwrap() else { - panic!("guard") - }; - let failure = *default; - let (cell, type_index, index) = guard - .instructions - .iter() - .find_map(|i| match i { - I::ArrayGet { - value, - type_index, - index, - .. - } => Some((*value, *type_index, *index)), - _ => None, - }) - .unwrap(); - let fresh = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); - function.values.push(ValueDecl { - id: fresh, - ty: ValueType::I32, - }); - let span = function.span; - function - .blocks - .iter_mut() - .find(|b| b.id == failure) - .unwrap() - .instructions - .splice( - 0..0, - [ - I::Constant { - destination: fresh, - value: 1, - span, - }, - I::ArraySet { - type_index, - value: cell, - index, - new_value: fresh, - span, - }, - ], - ); - let errors = psrs_backend::mir::verify_module(&module) - .expect_err("a failed acquisition must trap before any transfer"); - assert!( - errors - .iter() - .any(|e| e.message.contains("exceptional machine path")), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs b/crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs deleted file mode 100644 index 7b2caeea..00000000 --- a/crates/psrs-driver/src/tests/control_queue_steps/mir/mod.rs +++ /dev/null @@ -1,320 +0,0 @@ -use super::{Mutation, R, SOURCE, binding, path}; -use psrs_backend::mir::{BlockId, Function, Instruction as I, Terminator as T}; -use psrs_backend::types::ValueId; - -fn origin(function: &Function, mut value: ValueId) -> ValueId { - let aliases = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| match instruction { - I::Copy { - destination, value, .. - } - | I::RefCast { - destination, value, .. - } => Some((*destination, *value)), - _ => None, - }) - .collect::>(); - for _ in 0..aliases.len() { - if let Some(source) = aliases.get(&value) { - value = *source - } else { - break; - } - } - value -} - -fn selected(function: &Function, header: BlockId, path: &[i32]) -> BlockId { - let mut current = header; - for tag in path { - loop { - let block = function - .blocks - .iter() - .find(|block| block.id == current) - .unwrap(); - match block.terminator.as_ref().unwrap() { - T::Switch { cases, .. } => { - current = cases.iter().find(|(case, _)| case == tag).unwrap().1; - break; - } - T::Jump { target, .. } => current = *target, - _ => panic!("machine dispatch"), - } - } - } - current -} - -pub(super) fn reject(mutation: Mutation) { - use Mutation::*; - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, _) = binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let header = match function - .blocks - .iter() - .find(|block| block.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - { - T::Jump { target, .. } => *target, - _ => panic!("loop header"), - }; - let parameters = function - .blocks - .iter() - .find(|block| block.id == header) - .unwrap() - .parameters - .clone(); - let block_id = selected(function, header, path(mutation)); - let fresh = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(psrs_backend::types::ValueDecl { - id: fresh, - ty: function.result_type, - }); - let snapshot = function.clone(); - let block = function - .blocks - .iter_mut() - .find(|block| block.id == block_id) - .unwrap(); - let calls = block - .instructions - .iter() - .filter_map(|instruction| match instruction { - I::ClosureCall { destination, .. } => Some(*destination), - _ => None, - }) - .collect::>(); - match mutation { - ExtraRootCall | ExtraQueueCall | EagerBind => { - let mut extra = if matches!(mutation, EagerBind) { - snapshot - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find(|instruction| matches!(instruction, I::ClosureCall { .. })) - .unwrap() - .clone() - } else { - block - .instructions - .iter() - .rfind(|instruction| matches!(instruction, I::ClosureCall { .. })) - .unwrap() - .clone() - }; - let I::ClosureCall { - destination, - function: callee, - arguments, - .. - } = &mut extra - else { - unreachable!() - }; - *destination = fresh; - if matches!(mutation, EagerBind) { - *callee = parameters[1]; - *arguments = vec![parameters[0]]; - } - block.instructions.push(extra); - } - - HandlerState | Request | Handler | Raw | Callback | Answer => { - let index = match mutation { - HandlerState | Handler | Callback | Answer => 0, - Request => 1, - Raw => 2, - _ => unreachable!(), - }; - let raw = block - .instructions - .iter() - .find_map(|instruction| match instruction { - I::ClosureNew { destination, .. } => Some(*destination), - _ => None, - }); - let replacement = if matches!(mutation, HandlerState) { - match &block - .instructions - .iter() - .find(|instruction| instruction.destination() == Some(calls[1])) - .unwrap() - { - I::ClosureCall { arguments, .. } => arguments[0], - _ => unreachable!(), - } - } else if matches!(mutation, Handler) { - raw.unwrap() - } else if matches!(mutation, Callback) { - parameters[1] - } else { - parameters[0] - }; - let I::ClosureCall { - function: callee, - arguments, - .. - } = block - .instructions - .iter_mut() - .find(|instruction| instruction.destination() == Some(calls[index])) - .unwrap() - else { - unreachable!() - }; - if matches!(mutation, Handler | Callback) { - *callee = replacement - } else { - arguments[0] = replacement - } - } - TrapRoot | TrapCons => { - block.terminator = Some(T::Trap { - span: function.span, - }); - } - ReturnState | ReturnAnswer => { - let I::StructNew { arguments, .. } = block.instructions.iter_mut().find(|instruction| matches!(instruction, I::StructNew { arguments, .. } if arguments.len() == 2)).unwrap() else { unreachable!() }; - if matches!(mutation, ReturnState) { - arguments[0] = arguments[1] - } else { - arguments[1] = parameters[0] - } - } - _ => { - let T::Jump { - target, arguments, .. - } = block.terminator.as_ref().unwrap() - else { - panic!("transition") - }; - assert_eq!(*target, header); - let next = arguments.clone(); - match mutation { - ResultState | ResultComputation | SourceQueue | Tail | EmptyAppend - | QueueFinishRest | QueueFinishParent => { - let T::Jump { arguments, .. } = block.terminator.as_mut().unwrap() else { - unreachable!() - }; - let index = match mutation { - ResultState => 0, - ResultComputation => 2, - QueueFinishParent => 4, - _ => 3, - }; - arguments[index] = parameters[index]; - } - _ => { - let queue = origin(&snapshot, next[3]); - let I::StructNew { - arguments: fields, .. - } = block - .instructions - .iter() - .find(|instruction| instruction.destination() == Some(queue)) - .unwrap() - else { - panic!("new pending queue") - }; - let fields = fields.clone(); - match mutation { - AppendTail | AppendRight | FinishExtent | FinishParent => { - let I::StructNew { - arguments: fields, .. - } = block - .instructions - .iter_mut() - .find(|instruction| instruction.destination() == Some(queue)) - .unwrap() - else { - unreachable!() - }; - match mutation { - AppendTail => fields[1] = parameters[3], - AppendRight => fields[2] = fields[1], - FinishExtent => fields[1] = fields[3], - FinishParent => fields[3] = fields[1], - _ => unreachable!(), - } - } - AppendFirst => { - let nested = origin(&snapshot, fields[2]); - let I::StructNew { - arguments: inner, .. - } = block - .instructions - .iter() - .find(|instruction| instruction.destination() == Some(nested)) - .unwrap() - else { - unreachable!() - }; - let second = inner[1]; - let I::StructNew { - arguments: fields, .. - } = block - .instructions - .iter_mut() - .find(|instruction| instruction.destination() == Some(queue)) - .unwrap() - else { - unreachable!() - }; - fields[1] = second; - } - AppendSecond | FinishRest => { - let nested = origin(&snapshot, fields[2]); - let I::StructNew { - arguments: inner, .. - } = block - .instructions - .iter_mut() - .find(|instruction| instruction.destination() == Some(nested)) - .unwrap() - else { - unreachable!() - }; - inner[1] = if matches!(mutation, AppendSecond) { - fields[1] - } else { - parameters[3] - }; - } - _ => unreachable!(), - } - } - } - } - } - let errors = psrs_backend::mir::verify_module(&module).expect_err("malformed root/queue step"); - assert!( - errors - .iter() - .any(|error| error.pass == "P9 MIR root and queue execution"), - "{mutation:?}: {errors:?}" - ); -} - -mod effects; diff --git a/crates/psrs-driver/src/tests/control_queue_steps/mod.rs b/crates/psrs-driver/src/tests/control_queue_steps/mod.rs deleted file mode 100644 index 8ce47ac2..00000000 --- a/crates/psrs-driver/src/tests/control_queue_steps/mod.rs +++ /dev/null @@ -1,150 +0,0 @@ -//! The root fold and every persistent queue action retain their actual operands. -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::ControlHelperRole as R; - -mod cc; -mod mir; - -#[derive(Clone, Copy, Debug)] -enum Mutation { - HandlerState, - Request, - Handler, - Raw, - ResultState, - ResultComputation, - SourceQueue, - ReturnState, - ReturnAnswer, - Callback, - Answer, - Tail, - EmptyAppend, - AppendTail, - AppendRight, - AppendFirst, - AppendSecond, - FinishExtent, - FinishParent, - FinishRest, - QueueFinishRest, - QueueFinishParent, - TrapRoot, - TrapCons, - ExtraRootCall, - ExtraQueueCall, - EagerBind, -} - -fn path(mutation: Mutation) -> &'static [i32] { - use Mutation::*; - match mutation { - HandlerState | Request | Handler | Raw | ResultState | ResultComputation | SourceQueue => { - &[1, 0] - } - ReturnState | ReturnAnswer | TrapRoot => &[0, 0, 0], - Callback | Answer | Tail | TrapCons | ExtraQueueCall => &[0, 1], - EagerBind => &[2], - ExtraRootCall => &[1, 0], - EmptyAppend => &[0, 2, 0], - AppendTail | AppendRight => &[0, 2, 1], - AppendFirst | AppendSecond => &[0, 2, 2], - FinishExtent | FinishParent | FinishRest => &[0, 2, 3], - QueueFinishRest | QueueFinishParent => &[0, 3], - } -} - -const MUTATIONS: &[Mutation] = &[ - Mutation::HandlerState, - Mutation::Request, - Mutation::Handler, - Mutation::Raw, - Mutation::ResultState, - Mutation::ResultComputation, - Mutation::SourceQueue, - Mutation::ReturnState, - Mutation::ReturnAnswer, - Mutation::Callback, - Mutation::Answer, - Mutation::Tail, - Mutation::EmptyAppend, - Mutation::AppendTail, - Mutation::AppendRight, - Mutation::AppendFirst, - Mutation::AppendSecond, - Mutation::FinishExtent, - Mutation::FinishParent, - Mutation::FinishRest, - Mutation::QueueFinishRest, - Mutation::QueueFinishParent, - Mutation::TrapRoot, - Mutation::TrapCons, - Mutation::ExtraRootCall, - Mutation::ExtraQueueCall, - Mutation::EagerBind, -]; - -#[test] -fn cc_root_and_queue_steps_reject_same_shaped_substitutions() { - for mutation in MUTATIONS { - cc::reject(*mutation); - } -} - -#[test] -fn mir_root_and_queue_steps_reject_same_shaped_substitutions() { - for mutation in MUTATIONS { - mir::reject(*mutation); - } -} - -#[test] -fn execution_requires_the_placed_machine_schema() { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - input.cc.representations.control_schema = None; - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("control helpers have no placed machine schema")), - "{errors:?}" - ); -} - -#[test] -fn root_state_and_pending_callbacks_execute_in_order() { - let Some(()) = super::wasmtime_available() else { - return; - }; - let source = r"module Main where -import Prim.Control as C -data Op x = Op (Int -> x) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: case state of - 7 -> 1 - _ -> 0 - , _2: raw (k 42) } -work :: C.Control Op Int -work = C.bind (C.bind (C.return 2) (\x -> case x of - 2 -> C.return 40 - _ -> C.return 0)) - (\x -> case x of - 40 -> C.bind (C.perform (Op \y -> y)) (\y -> case y of - 42 -> C.return 43 - _ -> C.return 0) - _ -> C.return 0) -main :: Int -main = let result = C.run 7 handler work - in case result._1 of - 1 -> result._2 - _ -> 0 -"; - let stages = crate::compile_main_stages(source).unwrap(); - let path = std::env::temp_dir().join("psrs-control-root-queue-order.wasm"); - std::fs::write(&path, stages.artifact.wasm).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg(path) - .output() - .unwrap(); - assert_eq!(output.status.code(), Some(43), "{output:?}"); -} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs b/crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs deleted file mode 100644 index 63498849..00000000 --- a/crates/psrs-driver/src/tests/control_replay_contracts/allocation.rs +++ /dev/null @@ -1,114 +0,0 @@ -//! A valid allocation move remains fresh on every rebuild invocation/iteration. -use super::{R, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueDecl, ValueId, ValueShape}; -use std::process::Command; - -fn extract( - body: &mut [Assignment], - status: &mut Option, - zero: &mut Option, -) -> bool { - for assignment in body.iter_mut() { - if let A::TagSwitch { cases, .. } = &mut assignment.kind { - for case in cases { - if let Some(index) = case - .assignments - .iter() - .position(|assignment| matches!(assignment.kind, A::ArrayNew { .. })) - { - let allocation = case.assignments.remove(index); - let A::ArrayNew { elements, .. } = &allocation.kind else { - unreachable!() - }; - let position = case - .assignments - .iter() - .position(|assignment| assignment.destination == elements[0]) - .unwrap(); - *zero = Some(case.assignments.remove(position)); - *status = Some(allocation); - return true; - } - if extract(&mut case.assignments, status, zero) { - return true; - } - } - } - } - false -} - -#[test] -fn allocation_before_dispatch_and_filled_storage_preserve_replay_identity() { - let Some(_) = super::super::wasmtime_available() else { - return; - }; - let source = include_str!("../../../tests/control_support/scoped_replay.purs").replace("AFTER", r"C.bind (raw (k 0)) (\b -> C.return { saved: a.saved, built: a.built, value: intAdd a.value b.value })"); - let mut input = crate::lower_main_to_cc(&source).unwrap(); - let symbol = binding(&input.cc.representations, R::RebuildSequence).0; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let mut status = None; - let mut zero = None; - assert!(extract(&mut function.assignments, &mut status, &mut zero)); - let zero = zero.unwrap(); - assert!(matches!(zero.kind, A::Constant(0))); - let mut status = status.unwrap(); - let A::ArrayNew { - representation, - elements, - .. - } = &status.kind - else { - unreachable!() - }; - let length = ValueId( - function - .values - .iter() - .map(|declaration| declaration.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(ValueDecl { - id: length, - ty: ValueShape::Integer, - }); - status.kind = A::ArrayFill { - destination: status.destination, - representation: *representation, - length, - value: elements[0], - }; - function.assignments.splice( - 0..0, - [ - zero, - Assignment { - destination: length, - kind: A::Constant(1), - span: function.span, - }, - status, - ], - ); - psrs_backend::cc::verify_module(&input.cc).unwrap(); - let artifact = psrs_backend::compile_cc(input).unwrap(); - let path = std::env::temp_dir().join(format!( - "psrs-replay-filled-status-{}.wasm", - std::process::id() - )); - std::fs::write(&path, artifact.wasm).unwrap(); - let output = Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - std::fs::remove_file(&path).unwrap(); - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/cc.rs b/crates/psrs-driver/src/tests/control_replay_contracts/cc.rs deleted file mode 100644 index 0610259f..00000000 --- a/crates/psrs-driver/src/tests/control_replay_contracts/cc.rs +++ /dev/null @@ -1,231 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, Function, RefShape, ValueId}; - -fn visit(body: &mut [Assignment], mutate: &mut impl FnMut(&mut Assignment) -> bool) -> bool { - for assignment in body { - if mutate(assignment) { - return true; - } - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &mut assignment.kind - { - for case in cases { - if visit(&mut case.assignments, mutate) { - return true; - } - } - if visit(default_assignments, mutate) { - return true; - } - } - } - false -} - -fn definition(function: &Function, value: ValueId) -> &A { - fn find(body: &[Assignment], value: ValueId) -> Option<&A> { - for assignment in body { - if assignment.destination == value { - return Some(&assignment.kind); - } - if let A::TagSwitch { - cases, - default_assignments, - .. - } = &assignment.kind - { - for case in cases { - if let Some(kind) = find(&case.assignments, value) { - return Some(kind); - } - } - if let Some(kind) = find(default_assignments, value) { - return Some(kind); - } - } - } - None - } - find(&function.assignments, value).unwrap() -} - -pub(super) fn reject(mutation: Mutation) { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let role = mutation.role(); - let symbol = binding(&input.cc.representations, role).0; - let check = binding(&input.cc.representations, R::Check).1; - let close = binding(&input.cc.representations, R::Close); - let helper = &input.cc.representations.control_helpers[check.0 as usize]; - let boundary_shape = input - .cc - .representations - .signature(helper.signature()) - .unwrap() - .result; - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let parameters = function.parameters.clone(); - let changed = match mutation { - Mutation::PrematureClose => visit(&mut function.assignments, &mut |assignment| { - let A::DirectCall { - function, - contract: Some(id), - .. - } = &mut assignment.kind - else { - return false; - }; - if *id != check { - return false; - } - *function = close.0; - *id = close.1; - true - }), - Mutation::CallbackFromOtherQueue => visit(&mut function.assignments, &mut |assignment| { - let A::VariantGet { - case: 1, - field: 0, - value, - .. - } = &mut assignment.kind - else { - return false; - }; - *value = parameters[1]; - true - }), - Mutation::WrongSavedCheck | Mutation::MissingSavedCheck => { - visit(&mut function.assignments, &mut |assignment| { - let A::DirectCall { - contract: Some(id), - arguments, - .. - } = &mut assignment.kind - else { - return false; - }; - if *id != check { - return false; - } - if matches!(mutation, Mutation::WrongSavedCheck) { - arguments[0] = parameters[4]; - } else { - let value = arguments[0]; - assignment.kind = A::AggregateConvert { - destination: assignment.destination, - value, - conversion: psrs_backend::cc::AggregateConvert { - source: boundary_shape, - destination: boundary_shape, - plan: psrs_backend::cc::ValueConversion::Identity, - }, - }; - } - true - }) - } - Mutation::ReusedActivation | Mutation::WrongRestoredParent => { - visit(&mut function.assignments, &mut |assignment| { - let A::VariantNew { - case: 3, fields, .. - } = &mut assignment.kind - else { - return false; - }; - if matches!(mutation, Mutation::ReusedActivation) { - fields[0] = parameters[2]; - } else { - fields[2] = parameters[3]; - } - true - }) - } - Mutation::WrongActivationParent => { - let psrs_backend::cc::ValueShape::Reference(reference) = boundary_shape else { - unreachable!() - }; - let RefShape::Repr(boundary) = reference.heap else { - unreachable!() - }; - visit(&mut function.assignments, &mut |assignment| { - let A::VariantNew { - representation, - case: 1, - fields, - .. - } = &mut assignment.kind - else { - return false; - }; - if *representation != boundary { - return false; - } - fields[1] = parameters[2]; - true - }) - } - Mutation::ClosedStatus => { - let mut status = None; - assert!(visit(&mut function.assignments, &mut |assignment| { - if let A::ArrayNew { elements, .. } = &assignment.kind { - status = elements.first().copied(); - return true; - } - false - })); - assert!(matches!( - definition(function, status.unwrap()), - A::Constant(0) - )); - visit(&mut function.assignments, &mut |assignment| { - if assignment.destination == status.unwrap() { - assignment.kind = A::Constant(1); - return true; - } - false - }) - } - Mutation::WrongAdvance => { - let mut finish = None; - assert!(visit(&mut function.assignments, &mut |assignment| { - if matches!(assignment.kind, A::VariantNew { case: 3, .. }) { - finish = Some(assignment.destination); - return true; - } - false - })); - visit(&mut function.assignments, &mut |assignment| { - let A::DirectCall { - function: target, - arguments, - .. - } = &mut assignment.kind - else { - return false; - }; - if *target != symbol || arguments[1] != finish.unwrap() { - return false; - } - arguments[2] = parameters[2]; - true - }) - } - Mutation::StatusOutsideLoop => unreachable!(), - }; - assert!(changed); - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/mir.rs b/crates/psrs-driver/src/tests/control_replay_contracts/mir.rs deleted file mode 100644 index e8e68650..00000000 --- a/crates/psrs-driver/src/tests/control_replay_contracts/mir.rs +++ /dev/null @@ -1,276 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::ValueId; -use psrs_backend::mir::{Function, Instruction as I, Terminator as T}; - -fn parameters(function: &Function) -> Vec { - let entry = function - .blocks - .iter() - .find(|block| block.id == function.entry) - .unwrap(); - let Some(T::Jump { - target, arguments, .. - }) = &entry.terminator - else { - return function.parameters.clone(); - }; - assert_eq!(arguments, &function.parameters); - function - .blocks - .iter() - .find(|block| block.id == *target) - .unwrap() - .parameters - .clone() -} - -fn origin(function: &Function, mut value: ValueId) -> ValueId { - for _ in 0..function.values.len() { - match function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find(|instruction| instruction.destination() == Some(value)) - { - Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { - value = *source - } - _ => break, - } - } - value -} - -pub(super) fn reject(mutation: Mutation) { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let symbol = binding(&stages.cc.representations, mutation.role()).0; - let check = binding(&stages.cc.representations, R::Check).1; - let close = binding(&stages.cc.representations, R::Close); - let function = stages - .mir - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let parameters = parameters(function); - if matches!(mutation, Mutation::PrematureClose) { - let instruction = function.blocks.iter_mut().flat_map(|block| &mut block.instructions).find(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == check)).unwrap(); - let I::Call { - function: target, - contract, - .. - } = instruction - else { - unreachable!() - }; - *target = close.0; - *contract = Some(close.1); - } else if matches!(mutation, Mutation::CallbackFromOtherQueue) { - let receiver = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::StructNew { arguments, .. } if arguments.len() == 3 => { - let callback = origin(function, arguments[1]); - match function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find(|instruction| instruction.destination() == Some(callback)) - { - Some(I::StructGet { value, .. }) => Some(*value), - _ => None, - } - } - _ => None, - }) - .unwrap(); - let source = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::RefCast { - destination, value, .. - } if *destination == receiver => Some(value), - _ => None, - }) - .unwrap(); - *source = parameters[1]; - } else if matches!( - mutation, - Mutation::WrongSavedCheck | Mutation::MissingSavedCheck - ) { - let instruction = function.blocks.iter_mut().flat_map(|block| &mut block.instructions).find(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == check)).unwrap(); - let I::Call { - destination, - arguments, - span, - .. - } = instruction - else { - unreachable!() - }; - if matches!(mutation, Mutation::WrongSavedCheck) { - arguments[0] = parameters[4]; - } else { - *instruction = I::Copy { - destination: *destination, - value: arguments[0], - span: *span, - }; - } - } else { - let (finish, extent) = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::StructNew { - destination, - arguments, - .. - } if arguments.len() == 4 => Some((*destination, origin(function, arguments[1]))), - _ => None, - }) - .unwrap(); - match mutation { - Mutation::ReusedActivation | Mutation::WrongRestoredParent => { - let arguments = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::StructNew { - destination, - arguments, - .. - } if *destination == finish => Some(arguments), - _ => None, - }) - .unwrap(); - if matches!(mutation, Mutation::ReusedActivation) { - arguments[1] = parameters[2]; - } else { - arguments[3] = parameters[3]; - } - } - Mutation::WrongActivationParent => { - let arguments = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::StructNew { - destination, - arguments, - .. - } if *destination == extent => Some(arguments), - _ => None, - }) - .unwrap(); - arguments[2] = parameters[2]; - } - Mutation::ClosedStatus | Mutation::StatusOutsideLoop => { - let status = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::StructNew { - destination, - arguments, - .. - } if *destination == extent => Some(origin(function, arguments[1])), - _ => None, - }) - .unwrap(); - let zero = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::ArrayNew { - destination, - elements, - .. - } if *destination == status => Some(elements[0]), - _ => None, - }) - .unwrap(); - if matches!(mutation, Mutation::ClosedStatus) { - let value = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find_map(|instruction| match instruction { - I::Constant { - destination, value, .. - } if *destination == zero => Some(value), - _ => None, - }) - .unwrap(); - assert_eq!(*value, 0); - *value = 1; - } else { - let mut moved = Vec::new(); - for block in &mut function.blocks { - let mut index = 0; - while index < block.instructions.len() { - if matches!(block.instructions[index].destination(), Some(id) if id == zero || id == status) - { - moved.push(block.instructions.remove(index)); - } else { - index += 1 - } - } - } - assert_eq!(moved.len(), 2); - moved.sort_by_key(|instruction| { - usize::from(instruction.destination() == Some(status)) - }); - function - .blocks - .iter_mut() - .find(|block| block.id == function.entry) - .unwrap() - .instructions - .extend(moved); - } - } - Mutation::WrongAdvance => { - let target = function - .blocks - .iter() - .find_map(|block| match &block.terminator { - Some(T::Jump { arguments, .. }) - if arguments.len() == 4 && origin(function, arguments[1]) == finish => - { - Some(block.id) - } - _ => None, - }) - .unwrap(); - let Some(T::Jump { arguments, .. }) = &mut function - .blocks - .iter_mut() - .find(|block| block.id == target) - .unwrap() - .terminator - else { - unreachable!() - }; - arguments[2] = parameters[2]; - } - _ => unreachable!(), - } - } - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_replay_contracts/mod.rs b/crates/psrs-driver/src/tests/control_replay_contracts/mod.rs deleted file mode 100644 index 848758a9..00000000 --- a/crates/psrs-driver/src/tests/control_replay_contracts/mod.rs +++ /dev/null @@ -1,130 +0,0 @@ -//! Lifecycle replay must preserve checkpoints and allocate distinct activations. -mod allocation; -mod cc; -mod mir; -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::ControlHelperRole as R; - -#[derive(Clone, Copy)] -enum Mutation { - WrongSavedCheck, - PrematureClose, - CallbackFromOtherQueue, - MissingSavedCheck, - ReusedActivation, - WrongActivationParent, - WrongRestoredParent, - ClosedStatus, - WrongAdvance, - StatusOutsideLoop, -} - -impl Mutation { - fn role(self) -> R { - match self { - Self::WrongSavedCheck - | Self::MissingSavedCheck - | Self::PrematureClose - | Self::CallbackFromOtherQueue => R::CloneSequence, - _ => R::RebuildSequence, - } - } - fn message(self) -> &'static str { - match self { - Self::PrematureClose => { - "replay traversal cannot invoke callbacks or mutate lifecycle cells" - } - Self::CallbackFromOtherQueue => { - "share the original callback and retain its accumulator" - } - Self::WrongSavedCheck | Self::MissingSavedCheck => { - "check the saved finish extent before copying it" - } - Self::ReusedActivation => "create a fresh activation extent", - Self::WrongActivationParent => "activation must use its current parent", - Self::WrongRestoredParent => "retain its accumulated queue and previous active extent", - Self::ClosedStatus | Self::StatusOutsideLoop => { - "fresh live status cell in its iteration" - } - Self::WrongAdvance => "advance its queue, active extent and parent together", - } - } -} - -#[test] -fn cc_checks_original_saved_extent() { - cc::reject(Mutation::WrongSavedCheck); -} -#[test] -fn mir_checks_original_saved_extent() { - mir::reject(Mutation::WrongSavedCheck); -} -#[test] -fn cc_requires_saved_extent_check() { - cc::reject(Mutation::MissingSavedCheck); -} -#[test] -fn mir_requires_saved_extent_check() { - mir::reject(Mutation::MissingSavedCheck); -} -#[test] -fn cc_rejects_reusing_an_activation() { - cc::reject(Mutation::ReusedActivation); -} -#[test] -fn mir_rejects_reusing_an_activation() { - mir::reject(Mutation::ReusedActivation); -} -#[test] -fn cc_checks_fresh_activation_parent() { - cc::reject(Mutation::WrongActivationParent); -} -#[test] -fn mir_checks_fresh_activation_parent() { - mir::reject(Mutation::WrongActivationParent); -} -#[test] -fn cc_checks_restored_active_extent() { - cc::reject(Mutation::WrongRestoredParent); -} -#[test] -fn mir_checks_restored_active_extent() { - mir::reject(Mutation::WrongRestoredParent); -} -#[test] -fn cc_requires_a_live_new_status() { - cc::reject(Mutation::ClosedStatus); -} -#[test] -fn mir_requires_a_live_new_status() { - mir::reject(Mutation::ClosedStatus); -} -#[test] -fn cc_checks_activation_advance() { - cc::reject(Mutation::WrongAdvance); -} -#[test] -fn mir_checks_activation_advance() { - mir::reject(Mutation::WrongAdvance); -} -#[test] -fn mir_rejects_status_allocation_before_the_rebuild_loop() { - mir::reject(Mutation::StatusOutsideLoop); -} - -#[test] -fn cc_replay_cannot_complete_a_saved_extent() { - cc::reject(Mutation::PrematureClose); -} -#[test] -fn mir_replay_cannot_complete_a_saved_extent() { - mir::reject(Mutation::PrematureClose); -} -#[test] -fn cc_replay_must_share_the_original_callback() { - cc::reject(Mutation::CallbackFromOtherQueue); -} -#[test] -fn mir_replay_must_share_the_original_callback() { - mir::reject(Mutation::CallbackFromOtherQueue); -} diff --git a/crates/psrs-driver/src/tests/control_result_provenance.rs b/crates/psrs-driver/src/tests/control_result_provenance.rs deleted file mode 100644 index 1a6f11aa..00000000 --- a/crates/psrs-driver/src/tests/control_result_provenance.rs +++ /dev/null @@ -1,352 +0,0 @@ -use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; -use psrs_backend::mir::{Instruction as I, Terminator as T}; -const SOURCE: &str = r"module Main where -import Prim.Control as C -data Op x = Op (Int -> x) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: state, _2: raw (k 42) } -main :: Int -main = (C.run 0 handler (C.bind (C.perform (Op \x -> x)) (\_ -> C.return 43)))._2 -"; -fn symbol(input: &psrs_backend::BackendInput) -> psrs_hir::SymbolId { - input - .cc - .representations - .control_helpers - .iter() - .find(|h| h.role() == R::Executor) - .unwrap() - .function() -} -#[test] -fn cc_cannot_discard_outer_return_result() { - for tag in 0..=5 { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let symbol = symbol(&input); - let function = input - .cc - .functions - .iter_mut() - .find(|function| function.symbol == symbol) - .unwrap(); - let state = function.parameters[0]; - let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { - panic!("executor input dispatch") - }; - cases.iter_mut().find(|case| case.tag == tag).unwrap().value = state; - let errors = - psrs_backend::cc::verify_module(&input.cc).expect_err("discarded machine transition"); - assert!( - errors.iter().any(|error| error - .message - .contains("executor transition result must reach every normal exit")), - "tag {tag}: {errors:?}" - ); - assert!(psrs_backend::compile_cc(input).is_err()); - } -} - -fn joined_input(same: bool) -> psrs_backend::BackendInput { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let symbol = symbol(&input); - let f = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - fn wrap( - body: &mut [psrs_backend::cc::Assignment], - next: &mut u32, - values: &mut Vec, - alternative: Option, - ) -> bool { - for a in body { - match &mut a.kind { - A::TagSwitch { cases, .. } - if cases.len() == 2 && cases[0].tag == 0 && cases[1].tag == 1 => - { - let case = &mut cases[1]; - let original = case.value; - let ty = values.iter().find(|v| v.id == original).unwrap().ty; - let cond = psrs_backend::cc::ValueId(*next); - *next += 1; - let result = psrs_backend::cc::ValueId(*next); - *next += 1; - values.push(psrs_backend::cc::ValueDecl { - id: cond, - ty: psrs_backend::cc::ValueShape::Boolean, - }); - values.push(psrs_backend::cc::ValueDecl { id: result, ty }); - case.assignments.push(psrs_backend::cc::Assignment { - destination: cond, - kind: A::Constant(1), - span: a.span, - }); - case.assignments.push(psrs_backend::cc::Assignment { - destination: result, - kind: A::If { - condition: cond, - then_assignments: vec![], - then_value: original, - else_assignments: vec![], - else_value: alternative.unwrap_or(original), - }, - span: a.span, - }); - case.value = result; - return true; - } - A::TagSwitch { cases, .. } => { - for case in cases { - if wrap(&mut case.assignments, next, values, alternative) { - return true; - } - } - } - _ => {} - } - } - false - } - let A::TagSwitch { cases, .. } = &mut f.assignments.last_mut().unwrap().kind else { - panic!() - }; - let body = &mut cases.iter_mut().find(|c| c.tag == 0).unwrap().assignments; - let mut next = f.values.iter().map(|v| v.id.0).max().unwrap() + 1; - let alternative = (!same).then_some(f.parameters[0]); - assert!(wrap(body, &mut next, &mut f.values, alternative)); - input -} - -#[test] -fn cc_equivalent_scoped_result_join() { - let input = joined_input(true); - psrs_backend::cc::verify_module(&input.cc).expect("equivalent result join"); - let artifact = - psrs_backend::compile_cc(input).expect("equivalent result join compiles through MIR"); - if super::wasmtime_available().is_some() { - let path = std::env::temp_dir().join("psrs-control-equivalent-result-join.wasm"); - std::fs::write(&path, artifact.wasm).unwrap(); - let output = std::process::Command::new("wasmtime") - .arg(&path) - .output() - .unwrap(); - assert_eq!(output.status.code(), Some(43), "{output:?}"); - } -} - -#[test] -fn cc_result_join_cannot_hide_a_discarded_alternative() { - let input = joined_input(false); - let errors = - psrs_backend::cc::verify_module(&input.cc).expect_err("one result alternative discarded"); - assert!( - errors.iter().any(|error| error - .message - .contains("executor transition result must reach every normal exit")), - "{errors:?}" - ); -} -#[test] -fn mir_wrong_machine_constructor_tag() { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let exec = symbol(&input); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let f = module - .functions - .iter_mut() - .find(|f| f.symbol == exec) - .unwrap(); - let target = f - .blocks - .iter() - .find_map(|b| match &b.terminator { - Some(T::Switch { cases, .. }) - if cases.iter().map(|(t, _)| *t).collect::>() == vec![0, 1, 2, 3, 4, 5] => - { - Some(cases.iter().find(|(t, _)| *t == 2).unwrap().1) - } - _ => None, - }) - .unwrap(); - let tag = f - .blocks - .iter() - .find(|b| b.id == target) - .unwrap() - .instructions - .iter() - .find_map(|i| match i { - I::StructNew { arguments, .. } if arguments.len() == 3 => Some(arguments[0]), - _ => None, - }) - .unwrap(); - let definition = f - .blocks - .iter_mut() - .flat_map(|b| &mut b.instructions) - .find(|i| i.destination() == Some(tag)) - .unwrap(); - let I::Constant { value, .. } = definition else { - panic!("tag constant") - }; - *value = 0; - let errors = psrs_backend::mir::verify_module(&module).expect_err("wrong nominal case tag"); - assert!( - errors.iter().any(|e| e - .message - .contains("variant constructor must initialize its planned case tag")), - "{errors:?}" - ); -} - -#[test] -fn mir_executor_call_must_return_its_actual_result() { - for discard in [false, true] { - let input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (symbol, contract) = - super::control_checkpoints::binding(&input.cc.representations, R::Executor); - let mut module = crate::compile_main_stages(SOURCE).unwrap().mir; - let function = module - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let header = match function - .blocks - .iter() - .find(|b| b.id == function.entry) - .unwrap() - .terminator - .as_ref() - .unwrap() - { - T::Jump { target, .. } => *target, - _ => panic!("executor loop preheader"), - }; - let result = psrs_backend::types::ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(psrs_backend::types::ValueDecl { - id: result, - ty: function.result_type, - }); - let block = function.blocks.iter_mut().find(|block| { - block.instructions.iter().any(|instruction| matches!(instruction, I::ClosureCall { .. })) - && matches!(&block.terminator, Some(T::Jump { target, arguments, .. }) if *target == header && arguments.len() == 6) - }).unwrap(); - let T::Jump { - arguments, span, .. - } = block.terminator.take().unwrap() - else { - unreachable!() - }; - let state = arguments[0]; - block.instructions.push(I::Call { - destination: result, - contract: Some(contract), - function: symbol, - arguments, - span, - }); - block.terminator = Some(T::Return { - value: if discard { state } else { result }, - span, - }); - let verified = psrs_backend::mir::verify_module(&module); - if discard { - let errors = verified.expect_err("call result discarded at actual return"); - assert!( - errors.iter().any(|error| error - .message - .contains("executor transition result must reach every normal exit")), - "{errors:?}" - ); - } else { - verified.expect("actual executor result returned"); - } - } -} - -#[test] -fn cc_equivalent_switch_result_join() { - use psrs_backend::cc::{Assignment, TagCase, ValueDecl, ValueId, ValueShape}; - let mut input = joined_input(true); - let symbol = symbol(&input); - let function = input - .cc - .functions - .iter_mut() - .find(|f| f.symbol == symbol) - .unwrap(); - let trap = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - function.values.push(ValueDecl { - id: trap, - ty: function.result_type, - }); - let mut selector = None; - assert!(super::control_dispatch::visit( - &mut function.assignments, - &mut |assignment| { - let A::If { - condition, - then_value, - else_value, - .. - } = &assignment.kind - else { - return false; - }; - if then_value != else_value { - return false; - } - selector = Some(*condition); - let returned = *then_value; - assignment.kind = A::TagSwitch { - value: *condition, - cases: vec![ - TagCase { - tag: 0, - assignments: vec![], - value: returned, - }, - TagCase { - tag: 1, - assignments: vec![], - value: returned, - }, - ], - default_assignments: vec![Assignment { - destination: trap, - kind: A::Unreachable, - span: assignment.span, - }], - default_value: trap, - }; - true - } - )); - function - .values - .iter_mut() - .find(|value| Some(value.id) == selector) - .unwrap() - .ty = ValueShape::Integer; - psrs_backend::cc::verify_module(&input.cc).expect("equivalent switch result join"); - psrs_backend::compile_cc(input).expect("equivalent switch result join compiles through MIR"); -} diff --git a/crates/psrs-driver/src/tests/control_root/cc.rs b/crates/psrs-driver/src/tests/control_root/cc.rs deleted file mode 100644 index 0107b4c0..00000000 --- a/crates/psrs-driver/src/tests/control_root/cc.rs +++ /dev/null @@ -1,213 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueId, ValueShape}; -use psrs_hir::Intrinsic; - -pub(super) fn reject(mutation: Mutation) { - let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let (start, start_id) = binding(&input.cc.representations, R::Start); - let (check, check_id) = binding(&input.cc.representations, R::Check); - let close = binding(&input.cc.representations, R::Close).1; - let table = &input.cc.representations; - let function = input.cc.functions.iter_mut().find(|function| { - if matches!(mutation, Mutation::StartStatus) { return function.symbol == start; } - function.assignments.iter().any(|assignment| matches!(&assignment.kind, - A::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)) - }).unwrap(); - if matches!(mutation, Mutation::StartStatus) { - let A::ArrayNew { elements, .. } = &mut function - .assignments - .iter_mut() - .find(|assignment| matches!(assignment.kind, A::ArrayNew { .. })) - .unwrap() - .kind - else { - unreachable!() - }; - elements.clear(); - } else { - let call_value = function - .assignments - .iter() - .find_map(|assignment| match &assignment.kind { - A::ControlEvidence { - contract, - implementation, - .. - } if table.control_contracts[contract.0 as usize].operation() - == Intrinsic::ControlRun => - { - Some(*implementation) - } - _ => None, - }) - .unwrap(); - let call_index = function - .assignments - .iter() - .position(|assignment| assignment.destination == call_value) - .unwrap(); - let A::DirectCall { arguments, .. } = &function.assignments[call_index].kind else { - unreachable!() - }; - let extent = arguments[4]; - let context = arguments[5]; - let empty = arguments[3]; - let extra = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let extent_ty = function - .values - .iter() - .find(|value| value.id == extent) - .unwrap() - .ty; - let start_index = function - .assignments - .iter() - .position(|assignment| assignment.destination == extent) - .unwrap(); - if matches!( - mutation, - Mutation::DispatchExtent | Mutation::ExecutionExtent | Mutation::WrongClose - ) { - function.values.push(psrs_backend::cc::ValueDecl { - id: extra, - ty: extent_ty, - }); - function.assignments.insert( - start_index + 1, - Assignment { - destination: extra, - kind: A::DirectCall { - contract: Some(start_id), - function: start, - arguments: vec![], - }, - span: function.span, - }, - ); - } - match mutation { - Mutation::DispatchExtent => { - let A::VariantNew { fields, .. } = &mut function - .assignments - .iter_mut() - .find(|assignment| assignment.destination == context) - .unwrap() - .kind - else { - unreachable!() - }; - fields[0] = extra; - } - Mutation::ExecutionExtent => { - let A::DirectCall { arguments, .. } = &mut function - .assignments - .iter_mut() - .find(|assignment| assignment.destination == call_value) - .unwrap() - .kind - else { - unreachable!() - }; - arguments[4] = extra; - } - Mutation::Queue => { - let A::VariantNew { representation, .. } = function - .assignments - .iter() - .find(|assignment| assignment.destination == empty) - .unwrap() - .kind - else { - unreachable!() - }; - let ty = function - .values - .iter() - .find(|value| value.id == empty) - .unwrap() - .ty; - function - .values - .push(psrs_backend::cc::ValueDecl { id: extra, ty }); - function.assignments.insert( - call_index, - Assignment { - destination: extra, - kind: A::VariantNew { - destination: extra, - representation, - case: 3, - fields: vec![extent, empty, extent], - }, - span: function.span, - }, - ); - let A::DirectCall { arguments, .. } = - &mut function.assignments[call_index + 1].kind - else { - unreachable!() - }; - arguments[3] = extra; - } - _ => { - let close_index = function - .assignments - .iter() - .position(|assignment| { - matches!(assignment.kind, - A::DirectCall { contract: Some(id), .. } if id == close) - }) - .unwrap(); - let assignment = &mut function.assignments[close_index]; - match mutation { - Mutation::MissingClose => { - let ValueShape::Reference(reference) = extent_ty else { - unreachable!() - }; - assignment.kind = A::RepresentationCast { - destination: assignment.destination, - value: extent, - reference, - }; - } - Mutation::WrongClose => { - let A::DirectCall { arguments, .. } = &mut assignment.kind else { - unreachable!() - }; - arguments[0] = extra; - } - Mutation::EarlyClose => { - let instruction = function.assignments.remove(close_index); - function.assignments.insert(call_index, instruction); - } - Mutation::CheckInsteadClose => { - let A::DirectCall { - contract, function, .. - } = &mut assignment.kind - else { - unreachable!() - }; - *contract = Some(check_id); - *function = check; - } - _ => unreachable!(), - } - } - } - } - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_root/mir.rs b/crates/psrs-driver/src/tests/control_root/mir.rs deleted file mode 100644 index 14b4a5b6..00000000 --- a/crates/psrs-driver/src/tests/control_root/mir.rs +++ /dev/null @@ -1,280 +0,0 @@ -use super::{Mutation, R, SOURCE, binding}; -use psrs_backend::cc::ValueId; -use psrs_backend::mir::Instruction as I; -use psrs_backend::types::ValueType; -use psrs_hir::Intrinsic; -use std::collections::HashMap; - -pub(super) fn reject(mutation: Mutation) { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let close = binding(&stages.cc.representations, R::Close).1; - let (check, check_id) = binding(&stages.cc.representations, R::Check); - let start = binding(&stages.cc.representations, R::Start).0; - let executor = binding(&stages.cc.representations, R::Executor).0; - let table = &stages.cc.representations; - let retained_start = stages - .mir - .functions - .iter() - .any(|function| function.symbol == start); - let (finish_type, finish_ty) = stages - .mir - .functions - .iter() - .filter(|function| function.symbol == executor) - .find_map(|function| { - function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .find_map(|instruction| match instruction { - I::StructNew { - destination, - type_index, - arguments, - .. - } if arguments.len() == 4 => Some(( - *type_index, - function - .values - .iter() - .find(|value| value.id == *destination) - .unwrap() - .ty, - )), - _ => None, - }) - }) - .unwrap(); - let function = stages.mir.functions.iter_mut().find(|function| { - if matches!(mutation, Mutation::StartStatus) && retained_start { return function.symbol == start; } - function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, - I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)) - }).unwrap(); - let definitions = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| { - instruction - .destination() - .map(|value| (value, instruction.clone())) - }) - .collect::>(); - let origin = |mut value: ValueId| { - for _ in 0..definitions.len() { - match definitions.get(&value) { - Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { - value = *source - } - _ => break, - } - } - value - }; - if matches!(mutation, Mutation::StartStatus) { - let I::ArrayNew { elements, .. } = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find(|instruction| matches!(instruction, I::ArrayNew { .. })) - .unwrap() - else { - unreachable!() - }; - elements.clear(); - } else { - let call = definitions - .values() - .find_map(|instruction| match instruction { - I::ControlEvidence { - contract, - implementation, - .. - } if table.control_contracts[contract.0 as usize].operation() - == Intrinsic::ControlRun => - { - Some(origin(*implementation)) - } - _ => None, - }) - .unwrap(); - let I::Call { arguments, .. } = &definitions[&call] else { - unreachable!() - }; - let extent = origin(arguments[4]); - let context = origin(arguments[5]); - let empty = arguments[3]; - let extra = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let extent_ty = function - .values - .iter() - .find(|value| value.id == extent) - .unwrap() - .ty; - if matches!( - mutation, - Mutation::DispatchExtent | Mutation::ExecutionExtent | Mutation::WrongClose - ) { - function.values.push(psrs_backend::types::ValueDecl { - id: extra, - ty: extent_ty, - }); - for block in &mut function.blocks { - if let Some(index) = block - .instructions - .iter() - .position(|instruction| instruction.destination() == Some(extent)) - { - let I::StructNew { - type_index, - arguments, - .. - } = &block.instructions[index] - else { - unreachable!() - }; - let node = I::StructNew { - destination: extra, - type_index: *type_index, - arguments: arguments.clone(), - span: function.span, - }; - block.instructions.insert(index + 1, node); - break; - } - } - } - if matches!(mutation, Mutation::Queue) { - let tag = ValueId(extra.0 + 1); - function.values.extend([ - psrs_backend::types::ValueDecl { - id: extra, - ty: finish_ty, - }, - psrs_backend::types::ValueDecl { - id: tag, - ty: ValueType::I32, - }, - ]); - for block in &mut function.blocks { - if let Some(index) = block - .instructions - .iter() - .position(|instruction| instruction.destination() == Some(call)) - { - let I::Call { arguments, .. } = &mut block.instructions[index] else { - unreachable!() - }; - arguments[3] = extra; - block.instructions.splice( - index..index, - [ - I::Constant { - destination: tag, - value: 3, - span: function.span, - }, - I::StructNew { - destination: extra, - type_index: finish_type, - arguments: vec![tag, extent, empty, extent], - span: function.span, - }, - ], - ); - break; - } - } - } else { - let mut changed = false; - for block in &mut function.blocks { - for instruction in &mut block.instructions { - match mutation { - Mutation::DispatchExtent => { - if instruction.destination() != Some(context) { - continue; - } - let I::StructNew { arguments, .. } = instruction else { - unreachable!() - }; - arguments[1] = extra; - } - Mutation::ExecutionExtent => { - if instruction.destination() != Some(call) { - continue; - } - let I::Call { arguments, .. } = instruction else { - unreachable!() - }; - arguments[4] = extra; - } - _ => { - let I::Call { - contract: Some(id), - arguments, - destination, - function: target, - span, - .. - } = instruction - else { - continue; - }; - if *id != close { - continue; - } - match mutation { - Mutation::MissingClose => { - *instruction = I::Copy { - destination: *destination, - value: arguments[0], - span: *span, - } - } - Mutation::WrongClose => arguments[0] = extra, - Mutation::CheckInsteadClose => { - *id = check_id; - *target = check; - } - Mutation::EarlyClose => {} - _ => unreachable!(), - } - } - } - changed = true; - break; - } - if changed { - if matches!(mutation, Mutation::EarlyClose) { - let close_index = block.instructions.iter().position(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close)).unwrap(); - let call_index = block - .instructions - .iter() - .position(|instruction| instruction.destination() == Some(call)) - .unwrap(); - let instruction = block.instructions.remove(close_index); - block.instructions.insert(call_index, instruction); - } - break; - } - } - assert!(changed); - } - } - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains(mutation.message())), - "{errors:?}" - ); -} diff --git a/crates/psrs-driver/src/tests/control_root/mod.rs b/crates/psrs-driver/src/tests/control_root/mod.rs deleted file mode 100644 index c2f07bf4..00000000 --- a/crates/psrs-driver/src/tests/control_root/mod.rs +++ /dev/null @@ -1,111 +0,0 @@ -//! Root initialization and normal cleanup must belong to the checked Run. -mod cc; -mod mir; -mod ownership; -mod paths; -use super::control_checkpoints::{SOURCE, binding}; -use psrs_backend::cc::ControlHelperRole as R; - -#[derive(Clone, Copy)] -enum Mutation { - DispatchExtent, - ExecutionExtent, - Queue, - MissingClose, - WrongClose, - EarlyClose, - CheckInsteadClose, - StartStatus, -} -impl Mutation { - fn message(self) -> &'static str { - match self { - Self::DispatchExtent | Self::ExecutionExtent => { - "same fresh root extent for execution and dispatch" - } - Self::Queue => "start with an empty root queue", - Self::StartStatus => "fresh one-element live status cell", - _ => "close its root after execution and before publishing its result", - } - } -} - -#[test] -fn cc_rejects_incorrect_root_dispatch_extent() { - cc::reject(Mutation::DispatchExtent); -} - -#[test] -fn mir_rejects_incorrect_root_dispatch_extent() { - mir::reject(Mutation::DispatchExtent); -} - -#[test] -fn cc_rejects_incorrect_root_execution_extent() { - cc::reject(Mutation::ExecutionExtent); -} - -#[test] -fn mir_rejects_incorrect_root_execution_extent() { - mir::reject(Mutation::ExecutionExtent); -} - -#[test] -fn cc_rejects_incorrect_root_queue() { - cc::reject(Mutation::Queue); -} - -#[test] -fn mir_rejects_incorrect_root_queue() { - mir::reject(Mutation::Queue); -} - -#[test] -fn cc_rejects_incorrect_root_missing_close() { - cc::reject(Mutation::MissingClose); -} - -#[test] -fn mir_rejects_incorrect_root_missing_close() { - mir::reject(Mutation::MissingClose); -} - -#[test] -fn cc_rejects_incorrect_root_wrong_close() { - cc::reject(Mutation::WrongClose); -} - -#[test] -fn mir_rejects_incorrect_root_wrong_close() { - mir::reject(Mutation::WrongClose); -} - -#[test] -fn cc_rejects_incorrect_root_early_close() { - cc::reject(Mutation::EarlyClose); -} - -#[test] -fn mir_rejects_incorrect_root_early_close() { - mir::reject(Mutation::EarlyClose); -} - -#[test] -fn cc_rejects_incorrect_root_check_instead_of_close() { - cc::reject(Mutation::CheckInsteadClose); -} - -#[test] -fn mir_rejects_incorrect_root_check_instead_of_close() { - mir::reject(Mutation::CheckInsteadClose); -} - -#[test] -fn cc_rejects_incorrect_root_start_status() { - cc::reject(Mutation::StartStatus); -} - -#[test] -fn mir_rejects_incorrect_root_start_status() { - mir::reject(Mutation::StartStatus); -} diff --git a/crates/psrs-driver/src/tests/control_root/ownership.rs b/crates/psrs-driver/src/tests/control_root/ownership.rs deleted file mode 100644 index 574a2ed2..00000000 --- a/crates/psrs-driver/src/tests/control_root/ownership.rs +++ /dev/null @@ -1,270 +0,0 @@ -//! Distinct returning Runs need distinct roots; exclusive branches may share one. -use super::{R, binding}; -use psrs_backend::cc::{Assignment, AssignmentKind as A, ValueId}; -use psrs_backend::mir::Instruction as I; -use psrs_hir::Intrinsic; -use std::collections::HashMap; -use std::process::Command; - -const HEADER: &str = r"module Main where -import Prim.Control as C -data Op x = Op (Int -> x) -handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } -handler state (Op k) raw = { _1: state, _2: raw (k 42) } -"; -const SEQUENTIAL: &str = "main :: Int\nmain = intAdd ((C.run 0 handler (C.return 20))._2) ((C.run 0 handler (C.return 22))._2)\n"; - -#[test] -fn cc_sequential_runs_cannot_share_a_root() { - let mut input = crate::lower_main_to_cc(&format!("{HEADER}\n{SEQUENTIAL}")).unwrap(); - let close = binding(&input.cc.representations, R::Close).1; - let table = &input.cc.representations; - let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().filter(|assignment| matches!(&assignment.kind, - A::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)).count() == 2).unwrap(); - let calls = function - .assignments - .iter() - .filter_map(|assignment| match &assignment.kind { - A::ControlEvidence { - contract, - implementation, - .. - } if table.control_contracts[contract.0 as usize].operation() - == Intrinsic::ControlRun => - { - Some(*implementation) - } - _ => None, - }) - .collect::>(); - let arguments = |call| match &function - .assignments - .iter() - .find(|assignment| assignment.destination == call) - .unwrap() - .kind - { - A::DirectCall { arguments, .. } => arguments.clone(), - _ => unreachable!(), - }; - let first = arguments(calls[0]); - let second = arguments(calls[1]); - for assignment in &mut function.assignments { - match &mut assignment.kind { - A::DirectCall { arguments, .. } if assignment.destination == calls[1] => { - arguments[4] = first[4] - } - A::VariantNew { fields, .. } if assignment.destination == second[5] => { - fields[0] = first[4] - } - A::DirectCall { - contract: Some(id), - arguments, - .. - } if *id == close && arguments[0] == second[4] => arguments[0] = first[4], - _ => {} - } - } - let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("not reuse another invocation's root extent")), - "{errors:?}" - ); -} - -fn mir_reuse(status: bool) { - let mut stages = crate::compile_main_stages(&format!("{HEADER}\n{SEQUENTIAL}")).unwrap(); - let close = binding(&stages.cc.representations, R::Close).1; - let table = &stages.cc.representations; - let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).filter(|instruction| matches!(instruction, - I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun)).count() == 2).unwrap(); - let definitions = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| { - instruction - .destination() - .map(|value| (value, instruction.clone())) - }) - .collect::>(); - let origin = |mut value: ValueId| { - for _ in 0..definitions.len() { - match definitions.get(&value) { - Some(I::Copy { value: source, .. } | I::RefCast { value: source, .. }) => { - value = *source - } - _ => break, - } - } - value - }; - let calls = function - .blocks - .iter() - .flat_map(|block| &block.instructions) - .filter_map(|instruction| match instruction { - I::ControlEvidence { - contract, - implementation, - .. - } if table.control_contracts[contract.0 as usize].operation() - == Intrinsic::ControlRun => - { - Some(origin(*implementation)) - } - _ => None, - }) - .collect::>(); - let I::Call { - arguments: first, .. - } = &definitions[&calls[0]] - else { - unreachable!() - }; - let I::Call { - arguments: second, .. - } = &definitions[&calls[1]] - else { - unreachable!() - }; - if status { - let I::StructNew { - arguments: root, .. - } = &definitions[&origin(first[4])] - else { - unreachable!() - }; - let cell = root[1]; - let node = function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - .find(|instruction| instruction.destination() == Some(origin(second[4]))) - .unwrap(); - let I::StructNew { arguments, .. } = node else { - unreachable!() - }; - arguments[1] = cell; - } else { - for instruction in function - .blocks - .iter_mut() - .flat_map(|block| &mut block.instructions) - { - match instruction { - I::Call { - destination, - arguments, - .. - } if *destination == calls[1] => arguments[4] = first[4], - I::StructNew { - destination, - arguments, - .. - } if *destination == origin(second[5]) => arguments[1] = first[4], - I::Call { - contract: Some(id), - arguments, - .. - } if *id == close && origin(arguments[0]) == origin(second[4]) => { - arguments[0] = first[4] - } - _ => {} - } - } - } - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors.iter().any(|error| error - .message - .contains("not reuse another invocation's root extent")), - "{errors:?}" - ); -} - -fn share_branch( - body: &mut [Assignment], - close: psrs_backend::cc::ControlHelperId, - extent: ValueId, -) { - let call = body - .iter() - .find_map(|assignment| match &assignment.kind { - A::DirectCall { arguments, .. } if arguments.len() == 6 => { - Some((assignment.destination, arguments[5])) - } - _ => None, - }) - .unwrap(); - for assignment in body { - match &mut assignment.kind { - A::DirectCall { arguments, .. } if assignment.destination == call.0 => { - arguments[4] = extent - } - A::VariantNew { fields, .. } if assignment.destination == call.1 => fields[0] = extent, - A::DirectCall { - contract: Some(id), - arguments, - .. - } if *id == close => arguments[0] = extent, - _ => {} - } - } -} - -#[test] -fn exclusive_run_branches_share_initialization_and_execute_independent_invocations() { - if super::super::wasmtime_available().is_none() { - return; - } - let source = format!( - "{HEADER}\nchoose :: Boolean -> Int\nchoose flag = if flag then (C.run 0 handler (C.return 20))._2 else (C.run 0 handler (C.return 22))._2\nmain :: Int\nmain = intAdd (choose true) (choose false)\n" - ); - let mut input = crate::lower_main_to_cc(&source).unwrap(); - let start = binding(&input.cc.representations, R::Start).1; - let close = binding(&input.cc.representations, R::Close).1; - let function = input.cc.functions.iter_mut().find(|function| function.assignments.iter().any(|assignment| - matches!(&assignment.kind, A::If { then_assignments, .. } if then_assignments.iter().any(|assignment| matches!(assignment.kind, A::DirectCall { contract: Some(id), .. } if id == start))))).unwrap(); - let index = function - .assignments - .iter() - .position(|assignment| matches!(assignment.kind, A::If { .. })) - .unwrap(); - let A::If { - then_assignments, - else_assignments, - .. - } = &mut function.assignments[index].kind - else { - unreachable!() - }; - let start_index = then_assignments.iter().position(|assignment| matches!(assignment.kind, A::DirectCall { contract: Some(id), .. } if id == start)).unwrap(); - let allocation = then_assignments.remove(start_index); - let extent = allocation.destination; - share_branch(else_assignments, close, extent); - function.assignments.insert(index, allocation); - psrs_backend::cc::verify_module(&input.cc).unwrap(); - let artifact = psrs_backend::compile_cc(input).unwrap(); - let path = - std::env::temp_dir().join(format!("psrs-exclusive-root-{}.wasm", std::process::id())); - std::fs::write(&path, artifact.wasm).unwrap(); - let output = Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - std::fs::remove_file(&path).unwrap(); - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} - -#[test] -fn mir_sequential_runs_cannot_share_a_root() { - mir_reuse(false); -} -#[test] -fn mir_sequential_runs_cannot_share_a_status_cell() { - mir_reuse(true); -} diff --git a/crates/psrs-driver/src/tests/control_root/paths.rs b/crates/psrs-driver/src/tests/control_root/paths.rs deleted file mode 100644 index 6f552a3f..00000000 --- a/crates/psrs-driver/src/tests/control_root/paths.rs +++ /dev/null @@ -1,201 +0,0 @@ -//! Cleanup is checked on all normal paths, including multiple physical closes. -use super::{R, SOURCE, binding}; -use psrs_backend::cc::ValueId; -use psrs_backend::mir::{BasicBlock, BlockId, Instruction as I, Terminator as T}; -use psrs_backend::types::{ValueDecl, ValueType}; -use psrs_hir::Intrinsic; - -fn branching_cleanup(missing: bool, trap: bool) { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let close = binding(&stages.cc.representations, R::Close).1; - let table = &stages.cc.representations; - let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, - I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun))).unwrap(); - let block_index = function.blocks.iter().position(|block| block.instructions.iter().any(|instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close))).unwrap(); - let close_index = function.blocks[block_index] - .instructions - .iter() - .position( - |instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close), - ) - .unwrap(); - let close_instruction = function.blocks[block_index] - .instructions - .remove(close_index); - let suffix = function.blocks[block_index] - .instructions - .split_off(close_index); - let terminator = function.blocks[block_index].terminator.take(); - let condition = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let alias = ValueId(condition.0 + 1); - let I::Call { - destination, - arguments, - .. - } = &close_instruction - else { - unreachable!() - }; - let ty = function - .values - .iter() - .find(|value| value.id == *destination) - .unwrap() - .ty; - function.values.extend([ - ValueDecl { - id: condition, - ty: ValueType::Boolean, - }, - ValueDecl { id: alias, ty }, - ]); - let mut other = close_instruction.clone(); - if missing || trap { - other = I::Copy { - destination: alias, - value: arguments[0], - span: function.span, - }; - } else { - let I::Call { destination, .. } = &mut other else { - unreachable!() - }; - *destination = alias; - } - let then_block = BlockId( - function - .blocks - .iter() - .map(|block| block.id.0) - .max() - .unwrap() - + 1, - ); - let else_block = BlockId(then_block.0 + 1); - let join = BlockId(then_block.0 + 2); - let jump = || { - Some(T::Jump { - target: join, - arguments: vec![], - span: function.span, - }) - }; - function.blocks[block_index].instructions.push(I::Constant { - destination: condition, - value: 1, - span: function.span, - }); - function.blocks[block_index].terminator = Some(T::Branch { - condition, - then_block, - else_block, - span: function.span, - }); - function.blocks.extend([ - BasicBlock { - id: then_block, - parameters: vec![], - instructions: vec![close_instruction], - terminator: jump(), - }, - BasicBlock { - id: else_block, - parameters: vec![], - instructions: vec![other], - terminator: if trap { - Some(T::Trap { - span: function.span, - }) - } else { - jump() - }, - }, - BasicBlock { - id: join, - parameters: vec![], - instructions: suffix, - terminator, - }, - ]); - if missing { - let errors = psrs_backend::mir::verify_module(&stages.mir).unwrap_err(); - assert!( - errors - .iter() - .any(|error| error.message.contains("close its root after execution")), - "{errors:?}" - ); - } else { - psrs_backend::mir::verify_module(&stages.mir).unwrap(); - } -} - -#[test] -fn root_cleanup_can_be_distributed_across_normal_branches() { - branching_cleanup(false, false); -} -#[test] -fn root_cleanup_cannot_be_skipped_on_a_normal_branch() { - branching_cleanup(true, false); -} -#[test] -fn root_normal_cleanup_proof_excludes_trapping_paths() { - branching_cleanup(false, true); -} - -#[test] -fn physical_root_and_close_accept_reference_copies() { - let mut stages = crate::compile_main_stages(SOURCE).unwrap(); - let close = binding(&stages.cc.representations, R::Close).1; - let table = &stages.cc.representations; - let function = stages.mir.functions.iter_mut().find(|function| function.blocks.iter().flat_map(|block| &block.instructions).any(|instruction| matches!(instruction, - I::ControlEvidence { contract, .. } if table.control_contracts[contract.0 as usize].operation() == Intrinsic::ControlRun))).unwrap(); - let alias = ValueId( - function - .values - .iter() - .map(|value| value.id.0) - .max() - .unwrap() - + 1, - ); - let mut changed = false; - for block in &mut function.blocks { - if let Some(index) = block.instructions.iter().position( - |instruction| matches!(instruction, I::Call { contract: Some(id), .. } if *id == close), - ) { - let I::Call { arguments, .. } = &mut block.instructions[index] else { - unreachable!() - }; - let value = arguments[0]; - let ty = function - .values - .iter() - .find(|declaration| declaration.id == value) - .unwrap() - .ty; - function.values.push(ValueDecl { id: alias, ty }); - arguments[0] = alias; - block.instructions.insert( - index, - I::Copy { - destination: alias, - value, - span: function.span, - }, - ); - changed = true; - break; - } - } - assert!(changed); - psrs_backend::mir::verify_module(&stages.mir).unwrap(); -} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index bfd0faad..ea66729c 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -8,26 +8,7 @@ mod assertions; mod closure_protocol; mod coercion; mod control_carriers; -mod control_checkpoint_ordering; -mod control_checkpoints; -mod control_clause_selection; -mod control_clause_steps; -mod control_context_contracts; -mod control_context_entry; -mod control_contracts; mod control_costs; -mod control_dispatch; -mod control_execution_steps; -mod control_finish_provenance; -mod control_helper_contracts; -mod control_inlined_publication; -mod control_lifecycle_bodies; -mod control_observable_paths; -mod control_owned_steps; -mod control_queue_steps; -mod control_replay_contracts; -mod control_result_provenance; -mod control_root; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/crates/psrs-driver/tests/control_scoped_runtime.rs b/crates/psrs-driver/tests/control_scoped_runtime.rs index 89b77103..035cc0ab 100644 --- a/crates/psrs-driver/tests/control_scoped_runtime.rs +++ b/crates/psrs-driver/tests/control_scoped_runtime.rs @@ -178,3 +178,32 @@ main = if intEq result._2._1 100000 then result._2._2 else 0 42, ); } + +#[test] +fn callback_wrapper_and_adapter_run_through_ordinary_paths() { + // `bump` and `apply` are top-level functions referenced as values, so the + // compiler eta-expands wrappers for them; `partial` is a partial + // application kept as a callable value; `clause` is a source callback the + // handle protocol adapts to the uniform erased ABI. + check( + "scoped-callback-adapter", + r" +bump :: Int -> Int +bump n = intAdd n 1 +apply :: forall a b. (a -> b) -> a -> b +apply f x = f x +partial :: Int -> Int +partial = apply bump +ret :: Int -> C.Control Op Boolean +ret n = C.return (intEq (partial n) 43) +clause :: forall x. Op x -> (x -> C.Control Op Int) -> C.Control Op Boolean +clause op raw = C.return false +finish :: C.Control Op Int -> C.Control Op Boolean +finish = C.handle ret clause +root :: forall x. Int -> Op x -> (x -> C.Control Op Boolean) -> { _1 :: Int, _2 :: C.Control Op Boolean } +root s (Op label k) raw = { _1: s, _2: raw (k 0) } +main = if (C.run 0 root (finish (C.return 42)))._2 then 42 else 0 +", + 42, + ); +} diff --git a/docs/design/backend/fp/control-machine.md b/docs/design/backend/fp/control-machine.md index d08152de..e9ffb43d 100644 --- a/docs/design/backend/fp/control-machine.md +++ b/docs/design/backend/fp/control-machine.md @@ -4,8 +4,11 @@ **Status:** Draft design. The node inventory, lowering and flat driver match the implementation; complete verifier and lifecycle acceptance remains outstanding. The [lowering review](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) -identifies unresolved architecture boundaries. The proposed construction plan -below is a review target, not an implemented or accepted replacement pipeline. +identified unresolved architecture boundaries. [DEC-21](../../../decision/DEC-21-control-machine-construction-boundary.md) +now fixes the construction/verification boundary. The named schema, action +registry and checked plan are implemented for every machine body, and the +CC/MIR machine-semantic recognizers are retired; the boundary checker and +generic IR verification replace them. Complete AE/AC acceptance remains open. The mechanism is selected by [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md). **Prerequisites:** [DEC-19](../../../decision/DEC-19-compiler-generated-resumable-frames.md), @@ -303,55 +306,58 @@ The generated symbols are ordinary functions with predeclared signatures, so their calls are checked by identity and lowered like any other call. Nothing in this pipeline recognizes a concrete effect, operation or handler. -### Construction and verification boundary under review +### Construction and verification boundary -The current lowering immediately expands machine actions to ordinary CC. The -CC and MIR machine verifiers then recover their meaning from projections, -calls, casts, aliases, dispatch paths and private-cell writes. Shared relations -reduce duplication, but this still couples semantic checking to the instruction -forms surviving optimization. A source `ControlEvidence` witness proves a -primitive's construction contract; it is not a complete executor-step proof. +[DEC-21](../../../decision/DEC-21-control-machine-construction-boundary.md) +fixes this boundary. The named schema, the action registry and the checked +flat-driver plan are implemented: `control/schema.rs` names every carrier, case, +field and helper role; `cc/control/schema.rs` freezes one module's placement and +checks it against those names; and `cc/lower/control/plan.rs` *builds* the flat +driver from a checked transition program that is expanded to ordinary CC. +`check` independently verifies that every dispatch uses only declared cases and +that every required flat-driver action is present before a body is emitted. -The recommended design target is a **checked machine construction plan** inside -P8. It is a temporary, effect-agnostic input to code generation, not a new -whole-program IR family, a runtime interpreter, or a source effect system: +The helper bodies and the raw-resume closure adapter (`clone_sequence`, +`rebuild_sequence`, `start`, `check`, `close`, `once`, `cancel`, `resume`) are +built from the same checked plans, so replay, lifecycle, the factories and the +raw-resume entry no longer emit interleaved hand-written branches. The CC/MIR +machine-semantic recognizers are retired; the boundary checker and generic IR +verification replace them. The plan contract is: 1. One schema owns named node cases, named fields, helper roles and fixed signatures. Layout planning assigns representations to this schema; consumers do not infer semantic roles from helper parameter offsets. 2. A transition program states selected cases, projections, ordered actions and - one terminal outcome (`Advance`, `Publish` or `Reject`). Advancing supplies a - complete named executor state; a branch cannot silently inherit mutable - builder state. Every required case has an action, including rejection. -3. The plan checks operand roles, queue composition, checkpoint/activation - provenance, freshness, callback application and effect order before emission. - It retains Core's checked domain identities at source/callback boundaries. -4. Expansion emits ordinary CC against the immutable layout. A boundary checker - compares emitted actions and actual exits against the checked plan, accounting - for guards and exceptional prefixes. Merely tagging generated code with an - action ID does not validate its body. Semantic rules and the emitter must - remain independently testable; generating both from one unchecked template - would only duplicate a bug. + one terminal outcome (`Advance` or `Publish`). Advancing supplies a complete + named executor state; a branch cannot silently inherit mutable builder state. + Every required case has an action. +3. The plan checks its dispatch coverage, allocation arity and action inventory + before emission. Generic IR verification still checks operands, types, + layout, casts and CFG. +4. Expansion emits ordinary CC against the immutable layout. The boundary + checker then re-checks the emitted body's dispatch and outcome against the + plan at module verification; tagging generated code with an action ID alone + would not validate it. Semantic rules and the emitter remain independently + testable rather than generated from one unchecked template. 5. P9 translates checked CC to physical MIR under its ordinary representation, capture, CFG and loopification contracts. Each fact is either explicitly discharged at expansion or retained for the P9 checks; no stale certificate may authorize modified instructions. -The proof boundary after expansion needs an explicit decision. The recommendation -is to trust the semantics-preserving ordinary P9/P10 transformations, validate -their output IR invariants, and test their preservation of machine behavior. -This places them in the compiler's trusted implementation, as for ordinary -closures and mutable data. It does **not** prove optimized program equivalence -from SSA/layout validity. Requiring independent semantic validation after every -transform instead requires a transformation-aware certificate or a complete -translation validator; local helper identities and shape recognition cannot -claim that guarantee. - -This recommendation changes verification architecture, not the selected runtime -semantics. Existing CC/MIR semantic checks remain in force during migration. -Before removing any check, map its positive and malformed-IR cases to the new -boundary, identify the newly trusted transformation, and run the corresponding -optimized Wasm behavior tests. The [review and migration gates](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) +The proof boundary after expansion is decided: the semantics-preserving ordinary +P9/P10 transformations are trusted, their output IR invariants are validated, and +their preservation of machine behavior is tested. This places them in the +compiler's trusted implementation, as for ordinary closures and mutable data. It +does **not** prove optimized program equivalence from SSA/layout validity. +Requiring independent semantic validation after every transform would instead +require a transformation-aware certificate or a complete translation validator; +local helper identities and shape recognition cannot claim that guarantee. + +This changes verification architecture, not the selected runtime semantics. The +machine-semantic recognizers are retired and the boundary checker replaces them +for construction; arbitrary IR-valid mutations injected after construction are +no longer rejected, which the optimizer and negative-test layers must account +for. The [review and migration gates](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) record the alternatives and required evidence. No blanket helper exemption, inliner restriction, or narrowed AE/AC requirement closes this decision. @@ -777,9 +783,11 @@ enters the target under the caller's context. ## Open questions and future work -- Resolve the [construction/verification boundary](#construction-and-verification-boundary-under-review) - before expanding shape-recovery checks. The temporary plan, explicit action - coverage and proof discharge are proposed work, not current implementation. +- The [construction/verification boundary](#construction-and-verification-boundary) + is implemented: every machine body runs from the checked plan, the + recognizers are retired, and both CC and MIR dispatch-arm boundary checks + replace them. A translation validator proving optimizer preservation, and + operand-level rejection of IR-valid mutations after construction, remain open. - Audit full machine acceptance beyond the repaired lifecycle and observable-step checks, including all required reference-library and cost evidence. Focused verification does not establish complete AE/AC acceptance. diff --git a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md index 70d0f2c5..242a35cb 100644 --- a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md +++ b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md @@ -1,17 +1,19 @@ # Handoff: Delimited Control Migration and Remaining Acceptance -**Updated:** 2026-10-14, after repairs for architecture review R1–R3. +**Updated:** 2026-10-15, after the construction-boundary migration and the +retirement of the per-IR machine recognizers. The filename keeps its original date; this file is the current snapshot. -The subsequent [lowering design review](delimited-control-lowering-review-2026-10-14.md) -reviews the committed implementation at `1e24e5d5`. Its construction/proof-boundary -proposal is unimplemented; review that boundary before extending the recognizers. +The [lowering design review](delimited-control-lowering-review-2026-10-14.md) +proposal is now implemented for construction: see §10 for the current +architecture, the retired recognizers, the assurance tradeoff and the precise +next actions. Sections 1–9 are history. **Objective:** Complete delimited control, then implement native Effect/ST. -**Status:** R1–R3 are repaired in implementation and permanent tests, included -in the local checkpoint commit containing this handoff. -Check/Close bodies, full Executor/lifecycle/factory paths, explicit observable operations, -reference refinements and retained/inlined publication contents now have checked -relations. Complete AE/AC acceptance remains outstanding; workspace validation -and the known Effect migration baseline are reported separately below. +**Status:** Current snapshot. The lowering review's construction boundary is +implemented: the named schema, action inventory and checked plan own machine +construction, and the per-IR recognizers are **retired**, replaced by CC/MIR +boundary checks (§10). R1–R3 repairs remain in permanent tests. Complete AE/AC +acceptance and the operand-level boundary/translation-validator gaps remain +outstanding (§10 "Next actions"). The [architecture review and repair evidence](delimited-control-architecture-review-2026-10-14.md#repair-evidence-2026-10-14) records ownership, regressions, and the moved Wasm ancestry observation. @@ -237,53 +239,17 @@ in §8. Foreign capture, caught-host-trap recovery and complete AE/AC acceptance remain open. Earlier full workspace evidence is historical and was not refreshed in this review. -## 4. What the machine verifiers check now - -CC (`cc/verify/control/`) and MIR (`mir/control/`) select the following -checks by their retained helper/source roles: - -- **dispatch** (`dispatch.rs`): dispatch covers exactly the live alternatives; - default traps; projections match the proven selected case; the result - originates from the current input's dispatch (CC); MIR additionally requires an - immutable `i32` tag field, the current helper input selector, and that the input - dispatch dominates every invoke/return/backedge (entry preheader initialization - excepted). -- **clause selection** (`clauses.rs`): a source `Return` applies the scoped - return clause; a source `Perform` applies the scoped operation clause. -- **scoped execution** (`clauses.rs`): the next computation is the full - application result, the first argument is the current source payload and an - operation supplies its raw resumption. MIR also checks execution dominance; - both retain state/root handler identity. -- **Bind/Resume steps** (`steps.rs`): current frame operands, queue composition, - and replayed queue/activation identity on the actual transition. - -Additional current checks: - -- **root/queue execution** (`execution.rs`): the complete root handler call, - paired result fields, queue abandonment, terminal state/answer, Cons consumption, - all four Append-left actions, Finish restoration and required-action coverage. -- **normal-path operation accounting**: CC `execution/effects.rs`, MIR - `traces.rs` and shared `control/execution/observables.rs` check required dynamic - applications and selected static helper calls, and reject extra calls/array - stores. The repaired event contract accounts for explicit traps, other writes and - refinements as well; exceptional paths terminate before work after a failed - guard. See the repair evidence for precise trust boundaries. -- **owned execution** (`owned.rs`): Pending guard, Running, load, clear, one - callback, Consumed and transition order, with current owner/answer/result - identities. Equality guards have positive CC and MIR tests. -- **initialization/cancellation** (`initialization.rs`): current private contents - at publication, including intervening writes, and cancellation order. CC - and MIR negatives execute on retained helpers; separate optimized-MIR - publication mutations cover physical Start/Once cells after inlining. - -Shared relations live in `control/{provenance,dispatch,steps,owned}.rs` and -`control/execution/`; CC and MIR fact propagation lives in `cc/branch_facts.rs` -and `mir/branch_facts.rs`. `Check`/`Close` callee binding is checked, but their -lifecycle bodies are now verified separately by shared `control/lifecycle.rs` -and paired adapters. `control/events.rs` owns ordered events; per-IR refinement -checks justify narrowing recovery. A total-function summary replaces the former -no-write exemption. MIR additionally rechecks inlined Start/Once publication -windows from their physical allocations and source witnesses. +## 4. Machine verification after recognizer retirement + +The historical per-IR recognizers that earlier revisions of this file described +(`cc/verify/control/*`, `mir/control/*`, and the shared `control/` relations) +have been **retired**. Machine semantics now live in the checked construction +plan (`cc/lower/control/plan/`) and are re-checked by boundary validators at +`cc::verify_module` and `mir::verify_module`. Generic IR verification still +checks operands, types, layout, casts and CFG. + +See §10 for the current boundary checks, the assurance tradeoff, and the precise +remaining work. Sections 5–9 are retained as history. ## 5. Historical validation (before the 2026-10-14 review) @@ -309,6 +275,10 @@ focused-validation instruction. ## 6. Remaining work and recommended continuation +Historical (pre-review). The current remaining work is stated in **§10, "Next +actions for a new agent"**; this section is retained for the acceptance-audit +context it records. + Follow the user's order and validation limits: work in the current checkout, keep changes focused, and do not run global validation after each small fix. @@ -481,7 +451,139 @@ persistence. Fresh required-Wasmtime control baseline: **185 passed, 0 failed, 0 ignored**. Log: `/private/tmp/psrs-control-lowering-review-2026-10-14-baseline.log`. -No new full workspace or acceptance measurement was made. The next action is to -resolve the schema/action inventory and proof-discharge decision, then implement -the Bind/Return/Cons vertical slice under the review's migration gates. Existing -R1–R3 repairs and all remaining AE/AC obligations remain in force. +No new full workspace or acceptance measurement was made. The next action at the +time was to resolve the schema/action inventory and proof-discharge decision, +then implement the Bind/Return/Cons vertical slice under the review's migration +gates. **§10 records that resolution: the schema, action inventory and checked +plan are implemented and the recognizers retired.** Existing R1–R3 repairs and +all remaining AE/AC obligations remain in force. + +## 10. Construction-boundary migration (2026-10-14) + +[DEC-21](../../decision/DEC-21-control-machine-construction-boundary.md) now +fixes the construction/verification boundary: P8 checks a named construction +plan and expands it to ordinary CC; ordinary P9/P10 transformations are trusted +under IR-invariant and behavior evidence. + +The migration's first stages are implemented. `crates/psrs-backend/src/control/schema.rs` +names every machine carrier, case, field and helper role, and +`cc/control/schema.rs` freezes one module's placement (`RepresentationTable::control_schema`) +and checks it against those names. Layout, generation and verification consume +the names instead of positional offsets; the old role-from-signature inference +is removed. The executor's ad-hoc coverage set became a named `ActionId` +registry whose complete inventory must be observed. + +The flat driver is now *built* from a checked transition program: +`cc/lower/control/plan/` describes each transition's selected cases, +projections, ordered operations and terminal outcome, checks dispatch coverage, +allocation arity and the action inventory, then expands it to ordinary CC. +`Machine` no longer carries implicit `context`/`boundary` state or a `recur` +shortcut; `Advance` names all six state components. + +The helper bodies and the raw-resume closure adapter are now plan-built too: +`clone_sequence`, `rebuild_sequence`, `start`, `check`, `close`, `once`, +`cancel` and `resume` are constructed from checked plans in `plan/helpers.rs`. +Every machine body is therefore described once and expanded to ordinary CC. The +plan module is split by responsibility and each file stays under the 500-line +limit. An independent bounded model (`plan/model.rs`, test-gated) recovers the +plan's terminal trace for every case-refinement path — the executor and each +helper body — and compares it against a table written directly from the +operational semantics, so a dropped, duplicated or mis-routed transition fails +the comparison. Cost evidence keeps the dimensions separate: the extent ancestry +probe measures finish/ancestor depth, while a replay counter probe +(`probe::instrument_replay`, a private global incremented at each +`CloneSequence`/`RebuildSequence` entry) measures replay invocations. +`replay_invocations_grow_with_requests_at_fixed_ancestry` shows replay work grows +with requests while the ancestry bound stays at 2. The integration targets keep +the ordinary-path cases explicit: reference aliases, partial applications, and +top-level function wrappers used as callbacks through the handle protocol +(`control_scoped_runtime::callback_wrapper_and_adapter_run_through_ordinary_paths`). + +The P8 **boundary checker** (`plan/boundary.rs`) reconstructs the emitted +function's machine dispatch/outcome shape and compares it with the checked +plan's shape when each machine body is constructed. The plan is hand-built from +the semantics and the emitter is a generic expander, so an expander defect +(dropped arm, wrong tag, wrong terminal) fails the boundary instead of reaching +the generic CC verifiers; those still own operand semantics. + +### Recognizer retirement (Gate 6) + +Per the instruction to land the replacement wholesale, the CC and MIR machine +semantic recognizers are removed: + +- `cc/verify/control/*` (dispatch, execution, root, clauses, checkpoints, replay, + owned, lifecycle, initialization, exits, refinements, context_entry, + finish_creation/consumption, steps) is deleted; `cc::verify_module` now calls + `cc::lower::verify_boundary` on each function instead. +- `mir/control/*` machine recognizers are deleted; only the helper call binding + contract remains and module-level MIR machine verification is a no-op. +- The shared `control/` relation layer (`dispatch`, `provenance`, `steps`, + `owned`, `events`, `lifecycle` and the `execution` relations) is deleted. Only + the named `schema` and the flat-driver `ActionId` inventory remain. + +Replacement evidence: the named schema and checked construction plan own the +machine semantics ([DEC-21](../../decision/DEC-21-control-machine-construction-boundary.md)); +the boundary checker re-checks each emitted body's dispatch/outcome against the +plan at `cc::verify_module`; and a MIR boundary checker (`mir/control/boundary.rs`) +re-checks each machine function at `mir::verify_module`: its dispatch arm set and +its non-self tail-call targets must match the plan. Self tail calls are loopified +into loop back-edges, so the plan's self targets are excluded and the check +compares only external helper `ReturnCall`s. Generic IR verification still +checks operands, types, layout, casts and CFG. +`control_carriers::cc_boundary_rejects_a_dropped_machine_dispatch_arm`, +`mir_boundary_rejects_a_dropped_machine_dispatch_arm` and +`mir_boundary_rejects_a_changed_external_tail_target` show the replacements +reject a dropped machine arm and a changed tail target. The backend, focused control, and eleven +integration runtime targets pass. + +Assurance tradeoff, stated plainly: the removed recognizers also rejected +arbitrary mutations injected after construction (wrong field, aliased source, +extra store or trap). With them gone, such IR-valid mutations are no longer +rejected, and the negative driver tests that exercised them were removed +together with their modules. This is the "trust semantics-preserving transforms" +branch of DEC-21 taken to its end: the construction boundary, the CC and MIR +dispatch-arm boundary checks, and generic IR validity are the assurance. The +boundary checks cover dispatch coverage, not operand semantics; a translation +validator proving every optimizer intermediate preserves machine semantics +remains open, as do full AE/AC, foreign-boundary and reference-library +obligations. + +Validation performed: `cargo fmt --all --check`; `cargo clippy -p psrs-backend +--all-targets`; `cargo test -p psrs-backend --lib` (454 passed); the eleven +control integration targets (value/order/lifetime/GC/stack, required Wasmtime, +82 passed); and +`PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` +(10 passed, 0 failed). `cargo test --workspace` has only the pre-existing, +unrelated `psrs-cli --test link` failure (`P3 resolve: unknown name runEffect`). + +### Next actions for a new agent + +The review's construction and enumeration work is landed. The remaining +assurance gap is operand-level and cross-optimization validation: + +1. **Operand-level CC boundary check (highest value).** `plan/boundary.rs` + compares only the dispatch/outcome shape. Extend it to replay the plan's + `Op` sequence and compare projections/allocations/calls against the emitted + CC destinations, so an IR-valid operand mutation injected after construction + is rejected again. Start from `plan/ir.rs` (`Op`, `Operand`, `Cursor`), + `plan/expand.rs` (the emitter to correlate against) and `plan/boundary.rs`. + Add positive coverage (the 454 backend and 82 integration tests) and a + negative that mutates a projected field/index and expects rejection. +2. **MIR operand-level check.** `mir/control/boundary.rs` compares dispatch arms + and external tail-call targets; a field/index mutation at MIR is not caught. + If (1) lands, extend the same idea over the physical layout + (`mir/layout`, `mir/value_identity`). +3. **Translation validator.** No pass-level proof or transformation-aware + certificate establishes that optimization preserves machine semantics; + `mir/opt` re-verifies each intermediate with the dispatch-only boundary plus + generic IR validity. If a stronger claim is required, amend + [DEC-21](../../decision/DEC-21-control-machine-construction-boundary.md) and + record the trust boundary. +4. **Acceptance obligations are unchanged.** Full AE/AC, foreign-boundary and + reference-library requirements remain open; this migration closes none of + them. + +Do not treat the removed negative driver tests as covered: they were deleted +with their recognizer modules. They remain recoverable for re-expression, e.g. +`git show 01f7e66c:crates/psrs-driver/src/tests/` (or the commit before the +retirement). Re-express them against the operand-level boundary if it is added. From f6c87bc8e8d8dbbf1a5a31eaf5ff9521966035fd Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Fri, 16 Oct 2026 00:46:02 +0800 Subject: [PATCH 137/148] Complete checked-plan construction and delimited-control acceptance MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add Run as the 40th ActionId with a straight-line checked plan: empty queue, fresh Start, one root as both execution extent and dispatch context, Close after Executor. Split the bounded model and CC operand boundary into focused modules. P8 rejects host-handle captures in control callbacks; P9 rejects nested canonical borrow captures. RepresentationTable construction goes through from_parts so fixtures cannot omit the frozen control schema. Permanent regressions cover Root Start arity, exclusive-run sharing, checkpoint and replay field roles, Bind/Resume/Finish construction, foreign capture, instance-terminal traps, and GC-preserved array/string buffers. control_reference permanently runs the locked Run/Row fixtures. The 185 retired recognizer names are mapped as a requirement audit. AE-01–AE-10 and AC-01–AC-05 are Verified on 2026-10-15. AE-11 remains open. D-04 was not remeasured. Evidence: focused control_regressions, backend lib including the model and borrowed-handle tests, eleven integration targets 83, control_reference 6, purs 0.15.16 control-types 17/17. Workspace and scoreboards were not rerun. --- .../psrs-backend/src/abi/canonical/control.rs | 91 +++ crates/psrs-backend/src/abi/canonical/mod.rs | 2 + .../src/abi/tests/borrowed_results.rs | 121 ++++ crates/psrs-backend/src/abi/tests/mod.rs | 1 + crates/psrs-backend/src/cc/control/helpers.rs | 29 +- crates/psrs-backend/src/cc/control/mod.rs | 3 + .../psrs-backend/src/cc/control/plan/mod.rs | 145 ++++ .../psrs-backend/src/cc/control/plan/tests.rs | 173 +++++ crates/psrs-backend/src/cc/control/schema.rs | 231 +++--- .../src/cc/layout/control/contracts.rs | 14 +- .../psrs-backend/src/cc/layout/control/mod.rs | 215 +++--- .../src/cc/lower/control/builder.rs | 47 +- .../src/cc/lower/control/executor.rs | 21 +- .../src/cc/lower/control/fields.rs | 54 +- .../src/cc/lower/control/foreign.rs | 38 + .../src/cc/lower/control/lifetime.rs | 31 +- .../psrs-backend/src/cc/lower/control/mod.rs | 278 +------- .../src/cc/lower/control/operands.rs | 9 +- .../src/cc/lower/control/owned.rs | 25 +- .../src/cc/lower/control/plan/boundary.rs | 149 ---- .../src/cc/lower/control/plan/boundary/mod.rs | 253 +++++++ .../src/cc/lower/control/plan/boundary/ops.rs | 189 +++++ .../lower/control/plan/boundary/primitives.rs | 257 +++++++ .../src/cc/lower/control/plan/check.rs | 130 ---- .../src/cc/lower/control/plan/check/mod.rs | 100 +++ .../cc/lower/control/plan/check/operations.rs | 130 ++++ .../src/cc/lower/control/plan/check/scope.rs | 164 +++++ .../src/cc/lower/control/plan/check/tests.rs | 246 +++++++ .../src/cc/lower/control/plan/expand.rs | 14 +- .../src/cc/lower/control/plan/helpers.rs | 182 +++-- .../src/cc/lower/control/plan/ir.rs | 36 +- .../src/cc/lower/control/plan/mod.rs | 84 ++- .../cc/lower/control/plan/model/behavior.rs | 449 ++++++++++++ .../cc/lower/control/plan/model/compare.rs | 210 ++++++ .../lower/control/plan/model/continuations.rs | 173 +++++ .../control/plan/model/failure_prefixes.rs | 74 ++ .../cc/lower/control/plan/model/fixtures.rs | 215 ++++++ .../src/cc/lower/control/plan/model/heap.rs | 205 ++++++ .../cc/lower/control/plan/model/interpret.rs | 221 ++++++ .../control/plan/{model.rs => model/mod.rs} | 32 +- .../control/plan/model/mutations/flows.rs | 155 +++++ .../control/plan/model/mutations/lifetime.rs | 148 ++++ .../lower/control/plan/model/mutations/mod.rs | 62 ++ .../control/plan/model/mutations/replay.rs | 128 ++++ .../cc/lower/control/plan/model/operations.rs | 168 +++++ .../control/plan/model/reference/executor.rs | 176 +++++ .../lower/control/plan/model/reference/mod.rs | 139 ++++ .../control/plan/model/reference/replay.rs | 125 ++++ .../src/cc/lower/control/plan/model/runs.rs | 57 ++ .../src/cc/lower/control/plan/run.rs | 67 ++ .../src/cc/lower/control/plan/shape.rs | 15 + .../src/cc/lower/control/planning.rs | 182 +++++ .../src/cc/lower/control/replay.rs | 35 +- crates/psrs-backend/src/cc/mod.rs | 1 + crates/psrs-backend/src/cc/projection.rs | 11 +- crates/psrs-backend/src/cc/representation.rs | 32 +- .../psrs-backend/src/cc/verify/ops/control.rs | 6 +- .../psrs-backend/src/cc/verify/ops/table.rs | 16 +- .../psrs-backend/src/control/execution/mod.rs | 231 +++++- crates/psrs-backend/src/control/schema.rs | 142 +++- .../psrs-backend/src/mir/control/contracts.rs | 8 +- .../indirect_tests/aggregate/collections.rs | 11 +- .../mir/indirect_tests/aggregate/fixtures.rs | 19 +- .../mir/indirect_tests/aggregate/indirect.rs | 11 +- .../src/mir/indirect_tests/aggregate/large.rs | 22 +- .../indirect_tests/aggregate/list_record.rs | 9 +- .../mir/indirect_tests/aggregate/nested.rs | 33 +- .../indirect_tests/aggregate/record_fields.rs | 22 +- .../aggregate/resource_result.rs | 11 +- .../mir/indirect_tests/aggregate/scalars.rs | 22 +- .../mir/indirect_tests/composite/fixture.rs | 11 +- .../record_list/fixtures/aggregate.rs | 44 +- .../record_list/fixtures/fixed.rs | 22 +- .../record_list/fixtures/mod.rs | 33 +- .../record_list/fixtures/variants.rs | 31 +- .../record_list/fixtures/wide_flags.rs | 9 +- crates/psrs-backend/src/mir/layout/tests.rs | 22 +- .../psrs-backend/src/mir/lower/assignments.rs | 2 +- .../src/mir/verify/variants/tests.rs | 9 +- crates/psrs-backend/src/mir/wit/lists/mod.rs | 6 +- .../psrs-driver/src/tests/control_boundary.rs | 392 +++++++++++ .../psrs-driver/src/tests/control_carriers.rs | 10 +- .../src/tests/control_costs/mod.rs | 48 +- .../src/tests/control_costs/probe.rs | 132 +++- .../src/tests/control_costs/replay.rs | 213 ++++++ .../src/tests/control_costs/sources.rs | 58 ++ .../tests/control_regressions/checkpoints.rs | 267 +++++++ .../src/tests/control_regressions/foreign.rs | 67 ++ .../tests/control_regressions/lifecycle.rs | 122 ++++ .../src/tests/control_regressions/mod.rs | 26 + .../tests/control_regressions/observables.rs | 224 ++++++ .../src/tests/control_regressions/root.rs | 223 ++++++ .../src/tests/control_regressions/steps.rs | 337 +++++++++ .../tests/control_regressions/transforms.rs | 413 +++++++++++ crates/psrs-driver/src/tests/mod.rs | 2 + crates/psrs-driver/tests/control_reference.rs | 149 ++++ crates/psrs-driver/tests/control_runtime.rs | 28 + .../control-elimination-and-handler-scopes.md | 43 +- docs/design/backend/fp/control-machine.md | 146 ++-- .../delimited-control-and-resumable-frames.md | 16 +- .../backend/algebraic-effects.md | 181 ++++- ...-control-architecture-review-2026-10-14.md | 26 + ...ited-control-lowering-review-2026-10-14.md | 42 +- ...ed-control-migration-handoff-2026-10-12.md | 657 +++++++++++++++++- .../delimited-control-retired-regressions.md | 214 ++++++ 105 files changed, 9839 insertions(+), 1491 deletions(-) create mode 100644 crates/psrs-backend/src/abi/canonical/control.rs create mode 100644 crates/psrs-backend/src/abi/tests/borrowed_results.rs create mode 100644 crates/psrs-backend/src/cc/control/plan/mod.rs create mode 100644 crates/psrs-backend/src/cc/control/plan/tests.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/foreign.rs delete mode 100644 crates/psrs-backend/src/cc/lower/control/plan/boundary.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/boundary/mod.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/boundary/ops.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/boundary/primitives.rs delete mode 100644 crates/psrs-backend/src/cc/lower/control/plan/check.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/check/mod.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/check/operations.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/check/scope.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/check/tests.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/behavior.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/compare.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/continuations.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/failure_prefixes.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/fixtures.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/heap.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/interpret.rs rename crates/psrs-backend/src/cc/lower/control/plan/{model.rs => model/mod.rs} (87%) create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/mutations/flows.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/mutations/mod.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/mutations/replay.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/operations.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/reference/executor.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/reference/mod.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/reference/replay.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/model/runs.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/plan/run.rs create mode 100644 crates/psrs-backend/src/cc/lower/control/planning.rs create mode 100644 crates/psrs-driver/src/tests/control_boundary.rs create mode 100644 crates/psrs-driver/src/tests/control_costs/replay.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/checkpoints.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/foreign.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/lifecycle.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/mod.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/observables.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/root.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/steps.rs create mode 100644 crates/psrs-driver/src/tests/control_regressions/transforms.rs create mode 100644 crates/psrs-driver/tests/control_reference.rs create mode 100644 docs/implementation/backend/delimited-control-retired-regressions.md diff --git a/crates/psrs-backend/src/abi/canonical/control.rs b/crates/psrs-backend/src/abi/canonical/control.rs new file mode 100644 index 00000000..032d846a --- /dev/null +++ b/crates/psrs-backend/src/abi/canonical/control.rs @@ -0,0 +1,91 @@ +//! Control callbacks cannot store call-scoped canonical values. +use super::{CanonicalType, Ownership}; + +impl CanonicalType { + /// A borrowed handle, or any aggregate that contains one. + /// + /// Call-scoped `borrow` cannot be stored in a software continuation: the + /// host releases it when the canonical call returns. Owned handles and + /// GC-copied strings/lists are not this predicate; they have a different + /// lifetime owner. + pub(crate) fn contains_borrowed_handle(&self) -> bool { + match self { + Self::Handle { + ownership: Ownership::Borrow, + .. + } => true, + Self::List(inner) | Self::Option(inner) => inner.contains_borrowed_handle(), + Self::FixedList { element, .. } => element.contains_borrowed_handle(), + Self::Record(fields) => fields + .iter() + .any(|field| field.ty.contains_borrowed_handle()), + Self::Variant(cases) => cases.iter().any(|case| { + case.payload + .as_deref() + .is_some_and(Self::contains_borrowed_handle) + }), + Self::Result { ok, err } => { + ok.as_deref().is_some_and(Self::contains_borrowed_handle) + || err.as_deref().is_some_and(Self::contains_borrowed_handle) + } + _ => false, + } + } +} + +/// Control callbacks may not close over a borrowed canonical handle. +pub(crate) fn reject_borrowed_control_capture<'a>( + types: impl IntoIterator, +) -> Result<(), &'static str> { + if types + .into_iter() + .any(CanonicalType::contains_borrowed_handle) + { + Err("control callback cannot capture a borrowed host resource handle") + } else { + Ok(()) + } +} + +#[cfg(test)] +mod tests { + use super::super::ResourceId; + use super::*; + use psrs_hir::{ModuleId, SymbolId}; + + fn handle(borrowed: bool) -> CanonicalType { + CanonicalType::Handle { + resource: ResourceId { + interface: "fixture:io/files@0.1.0".into(), + name: "file".into(), + }, + ownership: if borrowed { + Ownership::Borrow + } else { + Ownership::Own { + drop: SymbolId::new(ModuleId(0), 1), + } + }, + } + } + + #[test] + fn borrowed_handles_are_unsupported_control_captures() { + let borrowed = handle(true); + let owned = handle(false); + assert!(borrowed.contains_borrowed_handle()); + assert!(CanonicalType::Option(Box::new(borrowed.clone())).contains_borrowed_handle()); + assert!(CanonicalType::List(Box::new(borrowed.clone())).contains_borrowed_handle()); + assert!( + CanonicalType::Record(vec![super::super::CanonicalField { + name: "file".into(), + ty: borrowed.clone(), + }]) + .contains_borrowed_handle() + ); + assert!(reject_borrowed_control_capture([&borrowed]).is_err()); + assert!(!owned.contains_borrowed_handle()); + assert!(!CanonicalType::String.contains_borrowed_handle()); + assert!(reject_borrowed_control_capture([&owned, &CanonicalType::String]).is_ok()); + } +} diff --git a/crates/psrs-backend/src/abi/canonical/mod.rs b/crates/psrs-backend/src/abi/canonical/mod.rs index 8fd7ba4b..7268b3f2 100644 --- a/crates/psrs-backend/src/abi/canonical/mod.rs +++ b/crates/psrs-backend/src/abi/canonical/mod.rs @@ -10,6 +10,7 @@ //! conformance, and MIR lowering all read a [`CanonicalType`] directly. //! `dead_code` is not allowed; every operation has a caller. +mod control; mod flatten; mod leaves; mod memory; @@ -19,6 +20,7 @@ mod resolve; #[cfg(test)] mod tests; +pub(crate) use control::reject_borrowed_control_capture; pub(crate) use flatten::flatten; pub(crate) use leaves::{FlatLeaf, flat_leaves_of, handle_at_flat_index}; #[allow(unused_imports)] diff --git a/crates/psrs-backend/src/abi/tests/borrowed_results.rs b/crates/psrs-backend/src/abi/tests/borrowed_results.rs new file mode 100644 index 00000000..2f800c2b --- /dev/null +++ b/crates/psrs-backend/src/abi/tests/borrowed_results.rs @@ -0,0 +1,121 @@ +//! WIT resolution owns recursive borrowed-result rejection. The compiler must +//! not erase that rule into a successful-looking source value. Parameters keep +//! their borrowing metadata; owned results retain the explicit-drop contract. +use super::super::{ + WasiRegistry, + canonical::{CanonicalType as T, Ownership}, +}; + +fn source(result: &str, parameter: bool, owned: bool) -> String { + let ownership = if owned { "own" } else { "borrow" }; + let signature = if parameter { + format!("use-value: func(value: {result});") + } else { + format!("get: func() -> {result};") + }; + format!( + "package wasi:io@0.2.12; interface streams {{ resource file; record payload {{ value: {ownership} }} variant envelope {{ absent, value({ownership}) }} {signature} }}" + ) +} + +#[test] +fn wit_resolution_rejects_borrowed_results_at_every_supported_nesting_form() { + for payload in [ + "borrow", + "payload", + "envelope", + "tuple", + "list", + ] { + for result in [ + payload.to_owned(), + format!("option<{payload}>"), + format!("result<{payload}, u32>"), + format!("result"), + format!("option>"), + ] { + let mut resolve = wit_parser::Resolve::default(); + let error = resolve + .push_str("borrow-result.wit", &source(&result, false, false)) + .expect_err( + "borrowed result must fail WIT resolution before canonical/source erasure", + ); + let message = format!("{error:#}"); + assert!( + message.contains("function returns a type which contains a `borrow`"), + "{result}: unexpected rejection owner: {message}" + ); + } + } +} + +fn registry(ty: &str, parameter: bool, owned: bool) -> WasiRegistry { + let mut resolve = wit_parser::Resolve::default(); + resolve + .push_str("resource-boundary.wit", &source(ty, parameter, owned)) + .expect("positive WIT declaration must resolve"); + WasiRegistry::from_resolve(resolve, crate::TargetCapabilities::default()) +} + +fn contains_borrow(ty: &T) -> bool { + match ty { + T::Handle { + ownership: Ownership::Borrow, + .. + } => true, + T::Record(fields) => fields.iter().any(|field| contains_borrow(&field.ty)), + T::Variant(cases) => cases + .iter() + .any(|case| case.payload.as_deref().is_some_and(contains_borrow)), + T::Option(payload) => contains_borrow(payload), + T::Result { ok, err } => { + ok.as_deref().is_some_and(contains_borrow) + || err.as_deref().is_some_and(contains_borrow) + } + _ => false, + } +} + +#[test] +fn borrowed_parameters_preserve_their_scoped_canonical_metadata() { + for ty in [ + "borrow", + "payload", + "envelope", + "option", + "result", + "tuple", + ] { + let mut registry = registry(ty, true, false); + let import = registry.import("wasi:io/streams", "use-value").unwrap(); + assert_eq!(import.unsupported, None, "{ty}"); + assert_eq!(import.params.len(), 1); + assert!( + contains_borrow(&import.params[0]), + "borrow metadata disappeared inside {ty}" + ); + } +} + +#[test] +fn owned_aggregate_results_remain_supported_with_explicit_drops() { + for ty in [ + "own", + "payload", + "envelope", + "option", + "result", + "tuple", + ] { + let mut registry = registry(ty, false, true); + let import = registry.import("wasi:io/streams", "get").unwrap(); + assert_eq!(import.unsupported, None, "{ty}"); + assert!(!contains_borrow( + import.canonical_result.as_ref().expect("owned result") + )); + let drop = registry + .import("wasi:io/streams", "[resource-drop]file") + .unwrap(); + assert_eq!(drop.unsupported, None); + } +} diff --git a/crates/psrs-backend/src/abi/tests/mod.rs b/crates/psrs-backend/src/abi/tests/mod.rs index 0affdbce..a340165b 100644 --- a/crates/psrs-backend/src/abi/tests/mod.rs +++ b/crates/psrs-backend/src/abi/tests/mod.rs @@ -5,6 +5,7 @@ use psrs_core::{Type as CoreType, TypeConstructor as CoreTypeConstructor, TypeId use wit_parser::Type as WitType; mod aggregates; +mod borrowed_results; mod capability_gates; mod enums; mod indirect; diff --git a/crates/psrs-backend/src/cc/control/helpers.rs b/crates/psrs-backend/src/cc/control/helpers.rs index 50b7cb5f..43850464 100644 --- a/crates/psrs-backend/src/cc/control/helpers.rs +++ b/crates/psrs-backend/src/cc/control/helpers.rs @@ -6,30 +6,7 @@ use psrs_hir::SymbolId; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub struct ControlHelperId(pub u32); -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum ControlHelperRole { - Executor, - CloneSequence, - RebuildSequence, - Start, - Check, - Close, - Once, - Cancel, -} - -impl ControlHelperRole { - pub(crate) const ALL: [Self; 8] = [ - Self::Executor, - Self::CloneSequence, - Self::RebuildSequence, - Self::Start, - Self::Check, - Self::Close, - Self::Once, - Self::Cancel, - ]; -} +pub use crate::control::schema::ControlHelperRole; /// A checked call identifies a particular helper, even when two helpers have /// the same physical signature. Only P8 planning publishes these bindings. @@ -65,7 +42,7 @@ impl crate::cc::RepresentationTable { match contract { Some(id) => { let helper = self - .control_helpers + .control_helpers() .get(id.0 as usize) .ok_or("control call has no predeclared helper contract")?; if helper.function != function { @@ -75,7 +52,7 @@ impl crate::cc::RepresentationTable { } } None if self - .control_helpers + .control_helpers() .iter() .any(|helper| helper.function == function) => { diff --git a/crates/psrs-backend/src/cc/control/mod.rs b/crates/psrs-backend/src/cc/control/mod.rs index 09ed96f3..6952700c 100644 --- a/crates/psrs-backend/src/cc/control/mod.rs +++ b/crates/psrs-backend/src/cc/control/mod.rs @@ -2,6 +2,7 @@ mod contracts; mod helpers; +mod plan; mod schema; pub(in crate::cc) use contracts::ControlImplementation; @@ -12,4 +13,6 @@ pub use contracts::{ pub use helpers::{ ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, }; +pub(in crate::cc) use plan::ControlPlanning; +pub use plan::FrozenControlPlan; pub(crate) use schema::ControlSchema; diff --git a/crates/psrs-backend/src/cc/control/plan/mod.rs b/crates/psrs-backend/src/cc/control/plan/mod.rs new file mode 100644 index 00000000..1b1127a3 --- /dev/null +++ b/crates/psrs-backend/src/cc/control/plan/mod.rs @@ -0,0 +1,145 @@ +//! Mutable source planning has one transition to an immutable machine contract. +use super::schema::ControlSchema; +use super::{ControlContract, ControlHelperContract, ControlHelperRole, ControlResumptionContract}; +use crate::cc::{ReprId, RepresentationTable}; +use std::collections::HashMap; + +#[derive(Clone, Debug, PartialEq, Eq, Default)] +pub(in crate::cc) struct ControlPlanning { + contracts: Vec, + identities: Vec, + frozen: Option, +} + +/// P8's published machine metadata. Instructions and layouts remain ordinary +/// mutable IR; consumers cannot modify or replace the semantic bindings. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct FrozenControlPlan { + contracts: Box<[ControlContract]>, + identities: Box<[super::super::TypeIdentity]>, + helpers: Box<[ControlHelperContract]>, + roles: HashMap, + resumption: ControlResumptionContract, + schema: ControlSchema, +} + +impl FrozenControlPlan { + pub fn source_type_identities(&self) -> &[super::super::TypeIdentity] { + &self.identities + } + pub fn contracts(&self) -> &[ControlContract] { + &self.contracts + } + pub fn helpers(&self) -> &[ControlHelperContract] { + &self.helpers + } + pub fn helper(&self, role: ControlHelperRole) -> Option<&ControlHelperContract> { + self.roles + .get(&role) + .and_then(|index| self.helpers.get(*index)) + } + pub fn resumption(&self) -> &ControlResumptionContract { + &self.resumption + } + pub fn result_pair(&self) -> ReprId { + self.schema.result_pair + } + pub(in crate::cc) fn schema(&self) -> ControlSchema { + self.schema + } +} + +impl RepresentationTable { + pub fn source_type_identities(&self) -> &[super::super::TypeIdentity] { + self.control_plan().map_or( + &self.control.identities, + FrozenControlPlan::source_type_identities, + ) + } + + pub(in crate::cc) fn plan_control_identity( + &mut self, + identity: super::super::TypeIdentity, + ) -> super::super::SourceTypeIdentityId { + assert!( + self.control.frozen.is_none(), + "source type identities cannot change after control planning freezes" + ); + let id = super::super::SourceTypeIdentityId(self.control.identities.len() as u32); + self.control.identities.push(identity); + id + } + pub fn control_plan(&self) -> Option<&FrozenControlPlan> { + self.control.frozen.as_ref() + } + pub fn control_helpers(&self) -> &[ControlHelperContract] { + self.control_plan().map_or(&[], FrozenControlPlan::helpers) + } + pub fn control_contracts(&self) -> &[ControlContract] { + self.control_plan() + .map_or(&self.control.contracts, FrozenControlPlan::contracts) + } + pub fn control_resumption(&self) -> Option<&ControlResumptionContract> { + self.control_plan().map(FrozenControlPlan::resumption) + } + pub fn control_result_pair(&self) -> Option { + self.control_plan().map(FrozenControlPlan::result_pair) + } + + pub(in crate::cc) fn plan_control_contract(&mut self, contract: ControlContract) { + assert!( + self.control.frozen.is_none(), + "source contracts cannot change after control planning freezes" + ); + if !self.control.contracts.contains(&contract) { + self.control.contracts.push(contract); + } + } + + pub(in crate::cc) fn freeze_control_plan( + &mut self, + helpers: Vec, + resumption: ControlResumptionContract, + schema: ControlSchema, + ) -> Result<(), &'static str> { + if self.control.frozen.is_some() { + return Err("control machine plan is already frozen"); + } + let mut roles = HashMap::new(); + let mut symbols = std::collections::HashSet::from([resumption.function()]); + for (index, helper) in helpers.iter().enumerate() { + if !symbols.insert(helper.function()) { + return Err("control machine planning repeats a callable identity"); + } + if roles.insert(helper.role(), index).is_some() { + return Err("control machine planning repeats a helper role"); + } + } + if ControlHelperRole::ALL + .iter() + .any(|role| !roles.contains_key(role)) + { + return Err("control machine planning omits a helper role"); + } + let contracts = std::mem::take(&mut self.control.contracts).into_boxed_slice(); + let identities = std::mem::take(&mut self.control.identities).into_boxed_slice(); + self.control.frozen = Some(FrozenControlPlan { + contracts, + identities, + helpers: helpers.into_boxed_slice(), + roles, + resumption, + schema, + }); + if let Err(error) = self.verify_control_schema() { + let candidate = self.control.frozen.take().expect("candidate plan exists"); + self.control.contracts = candidate.contracts.into_vec(); + self.control.identities = candidate.identities.into_vec(); + return Err(error); + } + Ok(()) + } +} + +#[cfg(test)] +mod tests; diff --git a/crates/psrs-backend/src/cc/control/plan/tests.rs b/crates/psrs-backend/src/cc/control/plan/tests.rs new file mode 100644 index 00000000..63b3f5f2 --- /dev/null +++ b/crates/psrs-backend/src/cc/control/plan/tests.rs @@ -0,0 +1,173 @@ +use super::*; +use crate::cc::{Representation, Signature, ValueShape}; + +fn fixture() -> ( + RepresentationTable, + Vec, + ControlResumptionContract, + ControlSchema, +) { + let mut table = RepresentationTable::default(); + let payload = crate::cc::payload::erased_shape(); + let continuation = table.add_signature(Signature { + parameters: vec![payload], + result: payload, + }); + let nominal = crate::cc::layout::control::reserve(&mut table); + let layout = crate::cc::layout::control::append(&mut table, continuation, &nominal); + let schema = ControlSchema { + computation: layout.computation, + sequence: layout.sequence, + context: layout.context, + extent: layout.boundary, + status: layout.status, + owner: layout.owner, + callback: layout.callback, + result_pair: layout.pair, + replay_result: layout.replay_result, + }; + let helpers = ControlHelperRole::ALL + .into_iter() + .enumerate() + .map(|(index, role)| { + let signature = match role { + ControlHelperRole::Executor => layout.executor, + ControlHelperRole::Run => layout.run, + ControlHelperRole::CloneSequence => layout.clone_sequence, + ControlHelperRole::RebuildSequence => layout.rebuild_sequence, + ControlHelperRole::Start => layout.start, + ControlHelperRole::Check | ControlHelperRole::Close => layout.boundary_check, + ControlHelperRole::Once => layout.once, + ControlHelperRole::Cancel => layout.cancel, + }; + ControlHelperContract { + role, + signature, + function: psrs_hir::SymbolId::new(psrs_hir::ModuleId(0), index as u32), + } + }) + .collect(); + let raw = ControlResumptionContract { + function: psrs_hir::SymbolId::new( + psrs_hir::ModuleId(0), + ControlHelperRole::ALL.len() as u32, + ), + signature: continuation, + }; + (table, helpers, raw, schema) +} + +#[test] +fn freezing_is_single_assignment_and_preserves_the_published_plan() { + let (mut table, helpers, raw, schema) = fixture(); + table + .freeze_control_plan(helpers.clone(), raw.clone(), schema) + .unwrap(); + let frozen = table.control_plan().unwrap().clone(); + assert_eq!( + frozen.helper(ControlHelperRole::Executor), + Some(&helpers[0]) + ); + let error = table.freeze_control_plan(helpers, raw, schema).unwrap_err(); + assert_eq!(error, "control machine plan is already frozen"); + assert_eq!(table.control_plan(), Some(&frozen)); +} + +#[test] +fn planning_failure_does_not_publish_a_partial_plan_and_can_be_retried() { + let (mut table, helpers, raw, schema) = fixture(); + let identity = crate::cc::TypeIdentity::Constructor(crate::cc::TypeConstructorIdentity::Int); + let id = table.plan_control_identity(identity.clone()); + let original = table.representation(schema.status).unwrap().clone(); + table.set( + schema.status, + Representation::Array { + element: ValueShape::Boolean, + }, + ); + assert!( + table + .freeze_control_plan(helpers.clone(), raw.clone(), schema) + .is_err() + ); + assert!(table.control_plan().is_none()); + assert_eq!( + table.source_type_identities().get(id.0 as usize), + Some(&identity) + ); + table.set(schema.status, original); + table.freeze_control_plan(helpers, raw, schema).unwrap(); + assert_eq!( + table + .control_plan() + .unwrap() + .source_type_identities() + .get(id.0 as usize), + Some(&identity) + ); +} + +#[test] +fn helper_roles_and_symbols_must_be_complete_and_unique_before_publication() { + for mutation in 0..3 { + let (mut table, mut helpers, raw, schema) = fixture(); + match mutation { + 0 => { + helpers.pop(); + } + 1 => helpers[1].role = helpers[0].role, + 2 => helpers[1].function = raw.function(), + _ => unreachable!(), + } + assert!(table.freeze_control_plan(helpers, raw, schema).is_err()); + assert!(table.control_plan().is_none()); + } +} + +#[test] +fn same_arity_layout_mutations_cannot_change_machine_storage_roles() { + for mutation in 0..4 { + let (mut table, helpers, raw, schema) = fixture(); + table.freeze_control_plan(helpers, raw, schema).unwrap(); + match mutation { + 0 => { + let Representation::Variant { mut cases } = + table.representation(schema.sequence).unwrap().clone() + else { + unreachable!() + }; + cases[1].fields.swap(0, 1); + table.set(schema.sequence, Representation::Variant { cases }); + } + 1 => table.set( + schema.status, + Representation::Array { + element: ValueShape::Boolean, + }, + ), + 2 => { + let Representation::Product { mut fields } = + table.representation(schema.replay_result).unwrap().clone() + else { + unreachable!() + }; + fields.swap(0, 1); + table.set(schema.replay_result, Representation::Product { fields }); + } + 3 => { + let signature = table + .control_plan() + .unwrap() + .helper(ControlHelperRole::Executor) + .unwrap() + .signature(); + table.signatures[signature.0 as usize].parameters.swap(2, 3); + } + _ => unreachable!(), + } + assert!( + table.verify_control_schema().is_err(), + "mutation {mutation} escaped schema validation" + ); + } +} diff --git a/crates/psrs-backend/src/cc/control/schema.rs b/crates/psrs-backend/src/cc/control/schema.rs index 4b61f7f8..8eadb49d 100644 --- a/crates/psrs-backend/src/cc/control/schema.rs +++ b/crates/psrs-backend/src/cc/control/schema.rs @@ -7,7 +7,8 @@ //! is immutable evidence: a later pass may read it but not replace it. use super::{ControlHelperContract, ControlHelperRole}; -use crate::cc::{ReprId, Representation}; +use crate::cc::{RefShape, Reference, ReprId, Representation, SignatureId, ValueShape}; +use crate::control::schema::FieldKind; use crate::control::schema::{ComputationCase, ContextCase, ExtentCase, OwnerCase, SequenceCase}; #[derive(Clone, Copy, Debug, PartialEq, Eq)] @@ -32,108 +33,166 @@ pub struct ControlSchema { pub replay_result: ReprId, } +impl ControlSchema { + /// Resolve one logical storage role through this module's frozen placement. + pub(crate) fn shape(self, kind: FieldKind, continuation: SignatureId) -> ValueShape { + use FieldKind::*; + let heap = match kind { + Payload => return crate::cc::payload::erased_shape(), + Callable => RefShape::Closure(continuation), + Computation => RefShape::Repr(self.computation), + Sequence => RefShape::Repr(self.sequence), + Context => RefShape::Repr(self.context), + Extent => RefShape::Repr(self.extent), + Status => RefShape::Repr(self.status), + Owner => RefShape::Repr(self.owner), + Callback => RefShape::Repr(self.callback), + ResultPair => RefShape::Repr(self.result_pair), + ReplayResult => RefShape::Repr(self.replay_result), + }; + ValueShape::Reference(Reference { + nullable: false, + heap, + }) + } +} + impl crate::cc::RepresentationTable { /// The frozen machine placement, when this module uses control. pub(crate) fn control_schema(&self) -> Option { - self.control_schema + self.control_plan().map(|plan| plan.schema()) } /// The single checked contract for a semantic helper role. pub(crate) fn control_helper(&self, role: ControlHelperRole) -> Option<&ControlHelperContract> { - self.control_helpers - .iter() - .find(|helper| helper.role() == role) + self.control_plan()?.helper(role) } - /// Check that every placed carrier has exactly the cases and field arity the - /// named schema declares. This is the independent layout check: the physical - /// frame is compared against the names, not one positional list against - /// another. Missing placement with present helpers is an error, not a fresh - /// unknown. + /// Validate the complete logical storage contract against physical CC shapes. pub(crate) fn verify_control_schema(&self) -> Result<(), &'static str> { - let Some(schema) = self.control_schema else { - return if self.control_helpers.is_empty() { + let Some(schema) = self.control_schema() else { + return if self.control_helpers().is_empty() { Ok(()) } else { Err("control helpers have no placed machine schema") }; }; - check_variant(self, schema.computation, &computation_cases())?; - check_variant(self, schema.sequence, &sequence_cases())?; - check_variant(self, schema.context, &context_cases())?; - check_variant(self, schema.extent, &extent_cases())?; - check_variant(self, schema.owner, &owner_cases())?; - check_product(self, schema.result_pair)?; - check_product(self, schema.replay_result)?; - for repr in [schema.status, schema.callback] { - if !matches!( - self.representation(repr), - Some(Representation::Array { .. }) - ) { - return Err("control placement names a private cell that is not an array"); + let continuation = self + .control_resumption() + .ok_or("control placement has no raw continuation signature")? + .signature(); + let shape = |kind| schema.shape(kind, continuation); + let mut identities = std::collections::HashSet::new(); + for repr in [ + schema.computation, + schema.sequence, + schema.context, + schema.extent, + schema.status, + schema.owner, + schema.callback, + schema.result_pair, + schema.replay_result, + ] { + if !identities.insert(repr) { + return Err("control placement aliases distinct storage roles"); } } - Ok(()) - } -} - -fn computation_cases() -> Vec<(u32, usize)> { - ComputationCase::ALL - .iter() - .map(|case| (case.tag(), case.field_count())) - .collect() -} - -fn sequence_cases() -> Vec<(u32, usize)> { - SequenceCase::ALL - .iter() - .map(|case| (case.tag(), case.field_count())) - .collect() -} - -fn context_cases() -> Vec<(u32, usize)> { - ContextCase::ALL - .iter() - .map(|case| (case.tag(), case.field_count())) - .collect() -} - -fn extent_cases() -> Vec<(u32, usize)> { - ExtentCase::ALL - .iter() - .map(|case| (case.tag(), case.field_count())) - .collect() -} - -fn owner_cases() -> Vec<(u32, usize)> { - OwnerCase::ALL - .iter() - .map(|case| (case.tag(), case.field_count())) - .collect() -} - -fn check_variant( - table: &crate::cc::RepresentationTable, - repr: ReprId, - expected: &[(u32, usize)], -) -> Result<(), &'static str> { - let Some(Representation::Variant { cases }) = table.representation(repr) else { - return Err("control placement names a carrier that is not a variant"); - }; - if cases.len() != expected.len() { - return Err("control carrier does not match the named schema case count"); - } - for (case, (tag, count)) in cases.iter().zip(expected) { - if case.tag != *tag || case.fields.len() != *count { - return Err("control carrier does not match the named schema field arity"); + for (repr, expected) in [ + ( + schema.computation, + ComputationCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect::>(), + ), + ( + schema.sequence, + SequenceCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ( + schema.context, + ContextCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ( + schema.extent, + ExtentCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ( + schema.owner, + OwnerCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ] { + let Some(Representation::Variant { cases }) = self.representation(repr) else { + return Err("control placement names a carrier that is not a variant"); + }; + if cases.len() != expected.len() { + return Err("control carrier does not match the named schema case count"); + } + for (actual, (tag, fields)) in cases.iter().zip(expected) { + let expected = fields.iter().map(|kind| shape(*kind)).collect::>(); + if actual.tag != tag || actual.fields != expected { + return Err("control carrier fields disagree with their logical storage roles"); + } + } } - } - Ok(()) -} - -fn check_product(table: &crate::cc::RepresentationTable, repr: ReprId) -> Result<(), &'static str> { - match table.representation(repr) { - Some(Representation::Product { fields }) if fields.len() == 2 => Ok(()), - _ => Err("control placement names a product that does not have two fields"), + for (repr, fields) in [ + (schema.result_pair, vec![shape(FieldKind::Payload); 2]), + ( + schema.replay_result, + vec![shape(FieldKind::Sequence), shape(FieldKind::Extent)], + ), + ] { + if self.representation(repr) != Some(&Representation::Product { fields }) { + return Err("control product fields disagree with their logical storage roles"); + } + } + for (repr, element) in [ + (schema.status, ValueShape::Integer), + (schema.callback, shape(FieldKind::Payload)), + ] { + if self.representation(repr) != Some(&Representation::Array { element }) { + return Err("control private cell has the wrong element role"); + } + } + if self.control_result_pair() != Some(schema.result_pair) { + return Err("control result pair disagrees with its placed role"); + } + for helper in self.control_helpers() { + let signature = self + .signature(helper.signature()) + .ok_or("control helper has no planned signature")?; + let parameters = helper + .role() + .parameters() + .iter() + .map(|kind| shape(*kind)) + .collect::>(); + if signature.parameters != parameters + || signature.result != shape(helper.role().result()) + { + return Err("control helper signature disagrees with its logical storage roles"); + } + } + let raw = self + .signature(continuation) + .ok_or("raw continuation signature is missing")?; + if raw.parameters != [shape(FieldKind::Payload)] || raw.result != shape(FieldKind::Payload) + { + return Err("raw continuation signature disagrees with its unary protocol"); + } + Ok(()) } } diff --git a/crates/psrs-backend/src/cc/layout/control/contracts.rs b/crates/psrs-backend/src/cc/layout/control/contracts.rs index bde9c7e0..7f1f75de 100644 --- a/crates/psrs-backend/src/cc/layout/control/contracts.rs +++ b/crates/psrs-backend/src/cc/layout/control/contracts.rs @@ -67,10 +67,8 @@ pub(in crate::cc::layout) fn append( { return SourceTypeIdentityId(index as u32); } - let index = identities.len(); identities.push(id); - table.source_type_identities.push(quoted.clone()); - SourceTypeIdentityId(index as u32) + table.plan_control_identity(quoted.clone()) }; let result_identity = intern(proof.result(), "ed.result); let argument_identities = proof @@ -89,9 +87,7 @@ pub(in crate::cc::layout) fn append( source: quoted.source, target: quoted.target, }; - if !table.control_contracts.contains(&contract) { - table.control_contracts.push(contract); - } + table.plan_control_contract(contract); } pending.extend(arguments.iter().map(|value| (owner, value))); } @@ -152,7 +148,7 @@ pub(in crate::cc) fn lookup( ) -> Option { let quoted = quote(module, proof)?; table - .control_contracts + .control_contracts() .iter() .position(|candidate| { candidate.operation == proof.operation() @@ -262,8 +258,8 @@ fn implementation(layout: ControlLayout, operation: Intrinsic) -> ControlImpleme ControlResume => crate::control::schema::ComputationCase::OwnedResume, ControlRun => { return ControlImplementation::Call { - signature: layout.executor, - role: crate::cc::ControlHelperRole::Executor, + signature: layout.run, + role: crate::cc::ControlHelperRole::Run, }; } ControlOnce => { diff --git a/crates/psrs-backend/src/cc/layout/control/mod.rs b/crates/psrs-backend/src/cc/layout/control/mod.rs index f53df5bc..e4a49b98 100644 --- a/crates/psrs-backend/src/cc/layout/control/mod.rs +++ b/crates/psrs-backend/src/cc/layout/control/mod.rs @@ -7,8 +7,7 @@ pub(in crate::cc) use contracts::lookup; use crate::cc::payload::erased_shape; use crate::cc::{ - RefShape, Reference, ReprId, Representation, RepresentationTable, Signature, SignatureId, - ValueShape, VariantCase, + ReprId, Representation, RepresentationTable, Signature, SignatureId, ValueShape, VariantCase, }; use psrs_hir::TypeId as HirTypeId; @@ -29,6 +28,7 @@ pub(in crate::cc) struct ControlLayout { pub pair: ReprId, pub continuation: SignatureId, pub executor: SignatureId, + pub run: SignatureId, pub context: ReprId, pub clone_sequence: SignatureId, pub rebuild_sequence: SignatureId, @@ -56,71 +56,7 @@ pub(in crate::cc) fn append( let boundary = table.reserve(); let callback = crate::cc::layout::protocols::array(table, erased); let status = crate::cc::layout::protocols::array(table, ValueShape::Integer); - let callable = reference(RefShape::Closure(continuation)); - let queue = reference(RefShape::Repr(sequence)); - let extent = reference(RefShape::Repr(boundary)); - let frame = reference(RefShape::Repr(computation)); - set_cases( - table, - computation, - vec![ - vec![erased], - vec![erased], - vec![frame, callable], - vec![erased, queue, extent], - vec![callable, callable, frame], - vec![reference(RefShape::Repr(owner)), erased], - ], - ); - set_cases( - table, - sequence, - vec![ - vec![], - vec![callable, queue], - vec![queue, queue], - vec![extent, queue, extent], - ], - ); - set_cases( - table, - context, - vec![ - vec![extent], - vec![ - callable, - callable, - queue, - extent, - reference(RefShape::Repr(context)), - extent, - ], - ], - ); - set_cases( - table, - owner, - vec![vec![ - reference(RefShape::Repr(callback)), - reference(RefShape::Repr(status)), - ]], - ); - set_cases( - table, - boundary, - vec![ - vec![reference(RefShape::Repr(status))], - vec![reference(RefShape::Repr(status)), extent], - ], - ); let replay_result = table.reserve(); - table.set( - replay_result, - Representation::Product { - fields: vec![queue, extent], - }, - ); - let replay = reference(RefShape::Repr(replay_result)); let labels = vec!["_1".to_owned(), "_2".to_owned()]; let pair = crate::cc::layout::protocols::record(table, &labels).unwrap_or_else(|| { let pair = table.reserve(); @@ -133,49 +69,99 @@ pub(in crate::cc) fn append( table.set_product_labels(pair, labels); pair }); - table.control_result_pair = Some(pair); - let executor = table.add_signature(Signature { - parameters: vec![ - erased, - callable, - frame, - queue, - extent, - reference(RefShape::Repr(context)), - ], - result: erased, - }); - let clone_sequence = table.add_signature(Signature { - parameters: vec![queue, queue, queue, extent, extent], - result: replay, - }); - let rebuild_sequence = table.add_signature(Signature { - parameters: vec![queue, queue, extent, extent], - result: replay, - }); - let start = table.add_signature(Signature { - parameters: vec![], - result: extent, - }); - let boundary_check = table.add_signature(Signature { - parameters: vec![extent], - result: extent, - }); - let owner_shape = reference(RefShape::Repr(owner)); - let once = table.add_signature(Signature { - parameters: vec![callable], - result: owner_shape, - }); - let cancel = table.add_signature(Signature { - parameters: vec![owner_shape], - result: owner_shape, - }); + let schema = crate::cc::ControlSchema { + computation, + sequence, + context, + extent: boundary, + status, + owner, + callback, + result_pair: pair, + replay_result, + }; + let shape = |kind| schema.shape(kind, continuation); + use crate::control::schema::{ + ComputationCase, ContextCase, ControlHelperRole as R, ExtentCase, FieldKind, OwnerCase, + SequenceCase, + }; + for (repr, cases) in [ + ( + computation, + ComputationCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect::>(), + ), + ( + sequence, + SequenceCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ( + context, + ContextCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ( + owner, + OwnerCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ( + boundary, + ExtentCase::ALL + .iter() + .map(|case| (case.tag(), case.fields())) + .collect(), + ), + ] { + table.set( + repr, + Representation::Variant { + cases: cases + .into_iter() + .map(|(tag, fields)| VariantCase { + tag, + fields: fields.iter().map(|kind| shape(*kind)).collect(), + }) + .collect(), + }, + ); + } + table.set( + replay_result, + Representation::Product { + fields: vec![shape(FieldKind::Sequence), shape(FieldKind::Extent)], + }, + ); + let mut signature = |role: R| { + table.add_signature(Signature { + parameters: role.parameters().iter().map(|kind| shape(*kind)).collect(), + result: shape(role.result()), + }) + }; + let executor = signature(R::Executor); + let run = signature(R::Run); + let clone_sequence = signature(R::CloneSequence); + let rebuild_sequence = signature(R::RebuildSequence); + let start = signature(R::Start); + let boundary_check = signature(R::Check); + let once = signature(R::Once); + let cancel = signature(R::Cancel); ControlLayout { computation, sequence, pair, continuation, executor, + run, context, clone_sequence, rebuild_sequence, @@ -191,29 +177,6 @@ pub(in crate::cc) fn append( } } -fn reference(heap: RefShape) -> ValueShape { - ValueShape::Reference(Reference { - nullable: false, - heap, - }) -} - -fn set_cases(table: &mut RepresentationTable, id: ReprId, fields: Vec>) { - table.set( - id, - Representation::Variant { - cases: fields - .into_iter() - .enumerate() - .map(|(tag, fields)| VariantCase { - tag: tag as u32, - fields, - }) - .collect(), - }, - ); -} - #[cfg(test)] mod tests { use super::*; diff --git a/crates/psrs-backend/src/cc/lower/control/builder.rs b/crates/psrs-backend/src/cc/lower/control/builder.rs index 15d77640..0320c097 100644 --- a/crates/psrs-backend/src/cc/lower/control/builder.rs +++ b/crates/psrs-backend/src/cc/lower/control/builder.rs @@ -1,17 +1,18 @@ //! CC construction helpers for steps over predeclared machine layouts. +use super::fields::ControlEmitter; use super::{ControlFunctions, ControlLayout}; -use crate::cc::lower::FunctionLowerer; use crate::cc::payload::erased_shape; use crate::cc::{ - Assignment, AssignmentKind, Function, RefShape, Reference, ReprId, SignatureId, TagCase, - ValueId, ValueShape, + Assignment, AssignmentKind, Function, RefShape, Reference, ReprId, RepresentationTable, + SignatureId, TagCase, ValueDecl, ValueId, ValueShape, }; use psrs_hir::SymbolId; use psrs_span::TextRange; pub(super) struct Machine<'a> { - pub lower: FunctionLowerer<'a>, + pub representations: &'a RepresentationTable, + pub values: Vec, pub layout: ControlLayout, pub functions: ControlFunctions, pub span: TextRange, @@ -30,13 +31,14 @@ fn reference(heap: RefShape) -> ValueShape { impl<'a> Machine<'a> { pub fn new( - lower: FunctionLowerer<'a>, + representations: &'a RepresentationTable, layout: ControlLayout, functions: ControlFunctions, span: TextRange, ) -> Self { Self { - lower, + representations, + values: Vec::new(), layout, functions, span, @@ -49,7 +51,7 @@ impl<'a> Machine<'a> { body: &mut Vec, kind: impl FnOnce(ValueId) -> AssignmentKind, ) -> ValueId { - let destination = self.lower.fresh(shape); + let destination = self.fresh_value(shape); body.push(Assignment { destination, kind: kind(destination), @@ -87,7 +89,6 @@ impl<'a> Machine<'a> { body: &mut Vec, ) -> ValueId { let fields = self - .lower .control_fields(representation, case, fields, self.span, body) .expect("machine construction must match its predeclared frame schema"); self.emit(repr(representation), body, |destination| { @@ -109,7 +110,7 @@ impl<'a> Machine<'a> { body: &mut Vec, ) -> ValueId { let value = self.cast(value, repr(representation), body); - let shape = self.lower.control_field_shape(representation, case, field); + let shape = self.control_field_shape(representation, case, field); self.emit(shape, body, |destination| AssignmentKind::VariantGet { destination, representation, @@ -207,14 +208,12 @@ impl<'a> Machine<'a> { body: &mut Vec, ) -> ValueId { let signature = self.functions.signature(self.layout, function); - self.lower - .control_call(function, signature, arguments, self.span, body) + self.control_call(function, signature, arguments, self.span, body) .expect("generated call must match its predeclared signature") } pub fn value_shape(&self, value: ValueId) -> ValueShape { - self.lower - .values + self.values .iter() .find(|declaration| declaration.id == value) .map(|declaration| declaration.ty) @@ -237,7 +236,7 @@ impl<'a> Machine<'a> { } }); let shape = self.value_shape(cases.first().expect("machine switch has cases").value); - let trap = self.lower.fresh(shape); + let trap = self.fresh_value(shape); let default_assignments = vec![Assignment { destination: trap, kind: AssignmentKind::Unreachable, @@ -262,14 +261,12 @@ impl<'a> Machine<'a> { let result_type = if symbol == self.functions.resume { erased_shape() } else { - self.lower - .representations + self.representations .signature(self.functions.signature(self.layout, symbol)) .expect("predeclared machine signature") .result }; let result = self - .lower .control_values(vec![result], vec![result_type], self.span, &mut assignments) .expect("machine result must match its predeclared signature")[0]; Function { @@ -279,8 +276,22 @@ impl<'a> Machine<'a> { assignments, result, result_type, - values: self.lower.values, + values: self.values, span: self.span, } } } + +impl ControlEmitter for Machine<'_> { + fn table(&self) -> &RepresentationTable { + self.representations + } + fn declarations(&self) -> &[ValueDecl] { + &self.values + } + fn fresh_value(&mut self, shape: ValueShape) -> ValueId { + let id = ValueId(self.values.len() as u32); + self.values.push(ValueDecl { id, ty: shape }); + id + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/executor.rs b/crates/psrs-backend/src/cc/lower/control/executor.rs index 8e9c4cb2..26a045ea 100644 --- a/crates/psrs-backend/src/cc/lower/control/executor.rs +++ b/crates/psrs-backend/src/cc/lower/control/executor.rs @@ -6,30 +6,29 @@ //! the `TagCase` helper shared with the other machine functions. use super::builder::{Machine, repr}; +use super::fields::ControlEmitter; use super::plan; use crate::cc::payload::erased_shape; use crate::cc::{Assignment, Function, TagCase, ValueId}; impl Machine<'_> { pub(super) fn executor(mut self) -> Function { - let state = self.lower.fresh(erased_shape()); + let state = self.fresh_value(erased_shape()); let signature = self - .lower .representations .signature(self.layout.executor) .unwrap(); - let handler = self.lower.fresh(signature.parameters[1]); - let computation = self.lower.fresh(repr(self.layout.computation)); - let sequence = self.lower.fresh(repr(self.layout.sequence)); - let boundary = self.lower.fresh(repr(self.layout.boundary)); - let context = self.lower.fresh(repr(self.layout.context)); + let handler = self.fresh_value(signature.parameters[1]); + let computation = self.fresh_value(repr(self.layout.computation)); + let sequence = self.fresh_value(repr(self.layout.sequence)); + let boundary = self.fresh_value(repr(self.layout.boundary)); + let context = self.fresh_value(repr(self.layout.context)); let parameters = vec![state, handler, computation, sequence, boundary, context]; let locals = [state, handler, computation, sequence, boundary, context]; - let program = plan::executor(); - plan::check(&program).expect("driver plan must be complete"); + let program = plan::build(plan::Program::Executor); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), &locals, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, &locals, &mut body); + let representations = self.representations; let symbol = self.functions.executor; let function = self.finish(symbol, "control_executor", parameters, body, result); plan::check_boundary(&function, representations, &program) diff --git a/crates/psrs-backend/src/cc/lower/control/fields.rs b/crates/psrs-backend/src/cc/lower/control/fields.rs index af761500..6fca427e 100644 --- a/crates/psrs-backend/src/cc/lower/control/fields.rs +++ b/crates/psrs-backend/src/cc/lower/control/fields.rs @@ -4,20 +4,21 @@ use super::{FunctionLowerer, control_error}; use crate::BackendError; use crate::cc::payload::erased_shape; use crate::cc::{ - Assignment, AssignmentKind, ReprId, Representation, SignatureId, ValueId, ValueShape, + Assignment, AssignmentKind, ReprId, Representation, RepresentationTable, SignatureId, + ValueDecl, ValueId, ValueShape, }; use psrs_hir::SymbolId; use psrs_span::TextRange; -impl FunctionLowerer<'_> { - pub(super) fn control_field_shape( - &self, - representation: ReprId, - case: u32, - field: u32, - ) -> ValueShape { - let Some(Representation::Variant { cases }) = - self.representations.representation(representation) +/// Minimal emission capability shared by source factories and machine helpers. +/// No source types, local environments or mutable layout planning are exposed. +pub(super) trait ControlEmitter { + fn table(&self) -> &RepresentationTable; + fn declarations(&self) -> &[ValueDecl]; + fn fresh_value(&mut self, shape: ValueShape) -> ValueId; + + fn control_field_shape(&self, representation: ReprId, case: u32, field: u32) -> ValueShape { + let Some(Representation::Variant { cases }) = self.table().representation(representation) else { unreachable!("machine fields require a predeclared variant"); }; @@ -29,7 +30,7 @@ impl FunctionLowerer<'_> { .expect("machine projection must name a predeclared field") } - pub(super) fn control_fields( + fn control_fields( &mut self, representation: ReprId, case: u32, @@ -37,8 +38,7 @@ impl FunctionLowerer<'_> { span: TextRange, assignments: &mut Vec, ) -> Result, Vec> { - let Some(Representation::Variant { cases }) = - self.representations.representation(representation) + let Some(Representation::Variant { cases }) = self.table().representation(representation) else { return Err(control_error( span, @@ -53,7 +53,7 @@ impl FunctionLowerer<'_> { self.control_values(fields, shapes, span, assignments) } - pub(super) fn control_values( + fn control_values( &mut self, fields: Vec, shapes: Vec, @@ -73,7 +73,7 @@ impl FunctionLowerer<'_> { // Source payloads and user callbacks use the erased protocol. // Machine helpers keep their predeclared nominal shapes. let source = self - .values + .declarations() .iter() .find(|declaration| declaration.id == value) .map(|declaration| declaration.ty) @@ -98,7 +98,7 @@ impl FunctionLowerer<'_> { "control field requires a reference shape", )); }; - let destination = self.fresh(shape); + let destination = self.fresh_value(shape); assignments.push(Assignment { destination, kind: AssignmentKind::RepresentationCast { @@ -113,7 +113,7 @@ impl FunctionLowerer<'_> { .collect() } - pub(super) fn control_call( + fn control_call( &mut self, function: SymbolId, signature: SignatureId, @@ -122,8 +122,8 @@ impl FunctionLowerer<'_> { assignments: &mut Vec, ) -> Result> { let contract = self - .representations - .control_helpers + .table() + .control_helpers() .iter() .position(|helper| helper.function() == function) .map(|index| crate::cc::ControlHelperId(index as u32)) @@ -131,12 +131,12 @@ impl FunctionLowerer<'_> { control_error(span, "control call has no predeclared semantic helper") })?; let signature = self - .representations + .table() .signature(signature) .ok_or_else(|| control_error(span, "control call has no predeclared signature"))? .clone(); let arguments = self.control_values(arguments, signature.parameters, span, assignments)?; - let destination = self.fresh(signature.result); + let destination = self.fresh_value(signature.result); assignments.push(Assignment { destination, kind: AssignmentKind::DirectCall { @@ -149,3 +149,15 @@ impl FunctionLowerer<'_> { Ok(destination) } } + +impl ControlEmitter for FunctionLowerer<'_> { + fn table(&self) -> &RepresentationTable { + self.representations + } + fn declarations(&self) -> &[ValueDecl] { + &self.values + } + fn fresh_value(&mut self, shape: ValueShape) -> ValueId { + self.fresh(shape) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/foreign.rs b/crates/psrs-backend/src/cc/lower/control/foreign.rs new file mode 100644 index 00000000..e805ea32 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/foreign.rs @@ -0,0 +1,38 @@ +//! Host-resource values cannot be stored in a software continuation. +use super::{FunctionLowerer, control_error}; +use crate::BackendError; +use psrs_core::{Expr, Type, TypeConstructor}; +use std::collections::HashSet; + +impl FunctionLowerer<'_> { + pub(super) fn reject_host_resource_captures( + &self, + argument: &Expr, + ) -> Result<(), Vec> { + let mut bound = HashSet::new(); + let mut captures = Vec::new(); + super::super::lambda::collect_captures(argument, &mut bound, &mut captures); + for local in captures { + let Some(&ty) = self.local_types.get(&local) else { + continue; + }; + if self.is_host_resource(ty) { + return Err(control_error( + argument.span, + "control callback cannot capture a host resource handle", + )); + } + } + Ok(()) + } + + fn is_host_resource(&self, ty: psrs_core::TypeId) -> bool { + match self.module.types.get(ty.0 as usize) { + Some(Type::Constructor(TypeConstructor::User(id))) => { + self.module.opaque_ids.contains(id) + } + Some(Type::Application(head, _)) => self.is_host_resource(*head), + _ => false, + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/lifetime.rs index 390a161f..f36bb4b0 100644 --- a/crates/psrs-backend/src/cc/lower/control/lifetime.rs +++ b/crates/psrs-backend/src/cc/lower/control/lifetime.rs @@ -2,6 +2,7 @@ use super::builder::{Machine, repr}; use super::executor::arm; +use super::fields::ControlEmitter; use crate::cc::{Assignment, AssignmentKind, Function, TagCase, ValueId, ValueShape}; use crate::control::schema::ExtentCase; @@ -51,12 +52,11 @@ impl Machine<'_> { ) { let cell = self.cast(cell, repr(representation), body); let Some(crate::cc::Representation::Array { element }) = - self.lower.representations.representation(representation) + self.representations.representation(representation) else { unreachable!("machine cell is an array"); }; let new_value = self - .lower .control_values(vec![new_value], vec![*element], self.span, body) .expect("machine write must preserve its cell representation")[0]; let index = self.integer(0, body); @@ -99,7 +99,7 @@ impl Machine<'_> { body: &mut Vec, ) -> ValueId { let shape = self.value_shape(cases.first().expect("machine select has cases").value); - let trap = self.lower.fresh(shape); + let trap = self.fresh_value(shape); let default_assignments = vec![Assignment { destination: trap, kind: AssignmentKind::Unreachable, @@ -145,11 +145,10 @@ impl Machine<'_> { } pub(super) fn start_boundary(mut self) -> Function { - let program = super::plan::start_boundary(); - super::plan::verify_plan(&program).expect("start_boundary plan must be well-formed"); + let program = super::plan::build(super::plan::Program::Start); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), &[], &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, &[], &mut body); + let representations = self.representations; let symbol = self.functions.start; let function = self.finish(symbol, "control_start_boundary", vec![], body, result); super::plan::check_boundary(&function, representations, &program) @@ -158,13 +157,12 @@ impl Machine<'_> { } pub(super) fn boundary_check(mut self) -> Function { - let boundary = self.lower.fresh(repr(self.layout.boundary)); + let boundary = self.fresh_value(repr(self.layout.boundary)); let params = [boundary]; - let program = super::plan::boundary_check(); - super::plan::verify_plan(&program).expect("boundary_check plan must be well-formed"); + let program = super::plan::build(super::plan::Program::Check); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, ¶ms, &mut body); + let representations = self.representations; let symbol = self.functions.check; let function = self.finish( symbol, @@ -179,13 +177,12 @@ impl Machine<'_> { } pub(super) fn boundary_close(mut self) -> Function { - let boundary = self.lower.fresh(repr(self.layout.boundary)); + let boundary = self.fresh_value(repr(self.layout.boundary)); let params = [boundary]; - let program = super::plan::boundary_close(); - super::plan::verify_plan(&program).expect("boundary_close plan must be well-formed"); + let program = super::plan::build(super::plan::Program::Close); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, ¶ms, &mut body); + let representations = self.representations; let symbol = self.functions.close; let function = self.finish( symbol, diff --git a/crates/psrs-backend/src/cc/lower/control/mod.rs b/crates/psrs-backend/src/cc/lower/control/mod.rs index 2e06021d..90497ea7 100644 --- a/crates/psrs-backend/src/cc/lower/control/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/mod.rs @@ -1,12 +1,12 @@ //! Lower the inert control surface to a persistent continuation machine. -use super::{FunctionLowerer, LambdaLowering}; +use super::FunctionLowerer; use crate::BackendError; use crate::cc::layout::control::ControlLayout; use crate::cc::payload::erased_shape; -use crate::cc::{Assignment, AssignmentKind, SignatureId, ValueId, ValueShape}; +use crate::cc::{Assignment, AssignmentKind, ValueId, ValueShape}; use psrs_core::Expr; -use psrs_hir::{Intrinsic, SymbolId}; +use psrs_hir::Intrinsic; use psrs_span::TextRange; pub(crate) use plan::{Family, Shape}; @@ -14,58 +14,19 @@ pub(crate) use plan::{Family, Shape}; mod builder; mod executor; mod fields; +mod foreign; mod lifetime; mod operands; mod owned; mod plan; +mod planning; mod replay; mod scope; use builder::Machine; - -#[derive(Clone, Copy)] -pub(in crate::cc) struct ControlFunctions { - emitted: bool, - executor: SymbolId, - resume: SymbolId, - clone_sequence: SymbolId, - rebuild_sequence: SymbolId, - start: SymbolId, - check: SymbolId, - close: SymbolId, - once: SymbolId, - cancel: SymbolId, -} - -impl ControlFunctions { - fn contracts( - self, - layout: ControlLayout, - ) -> [(SymbolId, SignatureId, crate::cc::ControlHelperRole); 8] { - use crate::cc::ControlHelperRole::*; - [ - (self.executor, layout.executor, Executor), - (self.clone_sequence, layout.clone_sequence, CloneSequence), - ( - self.rebuild_sequence, - layout.rebuild_sequence, - RebuildSequence, - ), - (self.start, layout.start, Start), - (self.check, layout.boundary_check, Check), - (self.close, layout.boundary_check, Close), - (self.once, layout.once, Once), - (self.cancel, layout.cancel, Cancel), - ] - } - - fn signature(self, layout: ControlLayout, function: SymbolId) -> SignatureId { - self.contracts(layout) - .into_iter() - .find(|(symbol, _, _)| *symbol == function) - .map(|(_, signature, _)| signature) - .expect("predeclared control function") - } -} +use fields::ControlEmitter; +pub(in crate::cc) use planning::ControlFunctions; +pub(in crate::cc) use planning::plan_control_helpers; +pub(crate) use planning::{plan_external_targets, plan_shape_for}; impl FunctionLowerer<'_> { pub(super) fn lower_control( @@ -158,44 +119,10 @@ impl FunctionLowerer<'_> { } if intrinsic == Intrinsic::ControlRun { let functions = self.ensure_control_functions(layout, expression.span)?; - let empty = self.control_empty_sequence(layout, expression.span, assignments); - let boundary = self.control_call( - functions.start, - layout.start, - vec![], - expression.span, - assignments, - )?; - let shape = builder::repr(layout.context); - let context = self.fresh(shape); - let context_fields = self.control_fields( - layout.context, - 0, - vec![boundary], - expression.span, - assignments, - )?; - assignments.push(Assignment { - destination: context, - kind: AssignmentKind::VariantNew { - destination: context, - representation: layout.context, - case: 0, - fields: context_fields, - }, - span: expression.span, - }); let result = self.control_call( - functions.executor, - layout.executor, - vec![fields[0], fields[1], fields[2], empty, boundary, context], - expression.span, - assignments, - )?; - self.control_call( - functions.close, - layout.boundary_check, - vec![boundary], + functions.run, + layout.run, + fields, expression.span, assignments, )?; @@ -242,27 +169,6 @@ impl FunctionLowerer<'_> { Ok((destination, destination)) } - fn control_empty_sequence( - &mut self, - layout: ControlLayout, - span: TextRange, - assignments: &mut Vec, - ) -> ValueId { - let shape = builder::repr(layout.sequence); - let value = self.fresh(shape); - assignments.push(Assignment { - destination: value, - kind: AssignmentKind::VariantNew { - destination: value, - representation: layout.sequence, - case: 0, - fields: vec![], - }, - span, - }); - value - } - fn ensure_control_functions( &mut self, layout: ControlLayout, @@ -290,15 +196,14 @@ impl FunctionLowerer<'_> { .borrow_mut() .insert(symbol, signature); } - let mut resume = Machine::new(self.child_lowerer(), layout, functions, span); - let receiver = resume.lower.fresh(super::lambda::closure_value_type()); - let value = resume.lower.fresh(erased_shape()); + let mut resume = Machine::new(self.representations, layout, functions, span); + let receiver = resume.fresh_value(super::lambda::closure_value_type()); + let value = resume.fresh_value(erased_shape()); let params = [receiver, value]; - let program = plan::raw_resume(); - plan::verify_plan(&program).expect("raw resume plan must be well-formed"); + let program = plan::build(plan::Program::RawResume); let mut assignments = Vec::new(); - let result = resume.expand(&program, &mut Vec::new(), ¶ms, &mut assignments); - let representations = resume.lower.representations; + let result = resume.expand(&program, ¶ms, &mut assignments); + let representations = resume.representations; let resume = resume.finish( functions.resume, "control_resume", @@ -310,17 +215,18 @@ impl FunctionLowerer<'_> { .expect("raw resume boundary check must pass"); self.verify_synthesized(&resume)?; self.generated.push(resume); - let executor = Machine::new(self.child_lowerer(), layout, functions, span).executor(); + let executor = Machine::new(self.representations, layout, functions, span).executor(); self.verify_synthesized(&executor)?; self.generated.push(executor); for function in [ - Machine::new(self.child_lowerer(), layout, functions, span).clone_sequence(), - Machine::new(self.child_lowerer(), layout, functions, span).rebuild_sequence(), - Machine::new(self.child_lowerer(), layout, functions, span).start_boundary(), - Machine::new(self.child_lowerer(), layout, functions, span).boundary_check(), - Machine::new(self.child_lowerer(), layout, functions, span).boundary_close(), - Machine::new(self.child_lowerer(), layout, functions, span).owned(), - Machine::new(self.child_lowerer(), layout, functions, span).cancel(), + Machine::new(self.representations, layout, functions, span).run(), + Machine::new(self.representations, layout, functions, span).clone_sequence(), + Machine::new(self.representations, layout, functions, span).rebuild_sequence(), + Machine::new(self.representations, layout, functions, span).start_boundary(), + Machine::new(self.representations, layout, functions, span).boundary_check(), + Machine::new(self.representations, layout, functions, span).boundary_close(), + Machine::new(self.representations, layout, functions, span).owned(), + Machine::new(self.representations, layout, functions, span).cancel(), ] { self.verify_synthesized(&function)?; self.generated.push(function); @@ -341,140 +247,16 @@ fn control_error(span: TextRange, message: &'static str) -> Vec { )] } -pub(in crate::cc) fn plan_control_helpers( - layout: &mut crate::cc::layout::TypeLayout, - allocator: &std::rc::Rc>, -) -> Option { - let control = layout.control_layout?; - let mut allocator = allocator.borrow_mut(); - let owner = layout.control_owner?; - let functions = ControlFunctions { - emitted: false, - executor: allocator.fresh(owner), - resume: allocator.fresh(owner), - clone_sequence: allocator.fresh(owner), - rebuild_sequence: allocator.fresh(owner), - start: allocator.fresh(owner), - check: allocator.fresh(owner), - close: allocator.fresh(owner), - once: allocator.fresh(owner), - cancel: allocator.fresh(owner), - }; - layout.representations.control_resumption = Some(crate::cc::ControlResumptionContract { - function: functions.resume, - signature: control.continuation, - }); - layout.representations.control_schema = Some(crate::cc::ControlSchema { - computation: control.computation, - sequence: control.sequence, - context: control.context, - extent: control.boundary, - status: control.status, - owner: control.owner, - callback: control.callback, - result_pair: control.pair, - replay_result: control.replay_result, - }); - for (function, signature, role) in functions.contracts(control) { - layout - .representations - .control_helpers - .push(crate::cc::ControlHelperContract { - role, - function, - signature, - }); - } - Some(functions) -} - /// Re-check a generated machine body against its checked plan. This is the /// replaced recognizer's entry point: it runs on the emitted CC at the module -/// verification boundary and rejects any body whose dispatch or outcome -/// disagrees with the construction plan. +/// verification boundary and rejects any body whose ordered operations, +/// operands, dispatch or returned value disagree with the construction plan. pub(crate) fn verify_boundary( function: &crate::cc::Function, table: &crate::cc::RepresentationTable, ) -> Result<(), &'static str> { - match plan_for_symbol(function.symbol, table) { + match planning::plan_for_symbol(function.symbol, table) { Some(plan) => plan::check_boundary(function, table, &plan), None => Ok(()), } } - -/// The checked plan shape for a machine function symbol, if it is one. -pub(crate) fn plan_shape_for( - symbol: psrs_hir::SymbolId, - table: &crate::cc::RepresentationTable, -) -> Option { - plan_for_symbol(symbol, table).map(|plan| plan::shape_of(&plan)) -} - -fn plan_for_symbol( - symbol: psrs_hir::SymbolId, - table: &crate::cc::RepresentationTable, -) -> Option { - use crate::cc::ControlHelperRole as R; - let role = table - .control_helpers - .iter() - .find(|helper| helper.function() == symbol) - .map(|helper| helper.role()); - let resumption = table - .control_resumption - .as_ref() - .is_some_and(|raw| raw.function() == symbol); - Some(match role { - Some(R::Executor) => plan::executor(), - Some(R::CloneSequence) => plan::clone_sequence(), - Some(R::RebuildSequence) => plan::rebuild_sequence(), - Some(R::Start) => plan::start_boundary(), - Some(R::Check) => plan::boundary_check(), - Some(R::Close) => plan::boundary_close(), - Some(R::Once) => plan::once(), - Some(R::Cancel) => plan::cancel(), - None if resumption => plan::raw_resume(), - None => return None, - }) -} - -/// The external helper symbols a machine function tail-calls, per its plan. -/// -/// Self tail calls are loopified into loop back-edges by P9, so they are -/// excluded; the MIR boundary check compares the rest against actual -/// `ReturnCall` targets. -pub(crate) fn plan_external_targets( - symbol: psrs_hir::SymbolId, - table: &crate::cc::RepresentationTable, -) -> Option> { - use crate::cc::ControlHelperRole; - fn collect(exec: &plan::PlanExec, out: &mut std::collections::HashSet) { - match exec { - plan::PlanExec::Steps { next, .. } => collect(next, out), - plan::PlanExec::Switch { arms, .. } => { - for (_, arm) in arms { - collect(arm, out); - } - } - plan::PlanExec::Advance { .. } => { - out.insert(ControlHelperRole::Executor); - } - plan::PlanExec::Tail { role, .. } => { - out.insert(*role); - } - _ => {} - } - } - let plan = plan_for_symbol(symbol, table)?; - let mut wanted = std::collections::HashSet::new(); - collect(&plan, &mut wanted); - let mut targets = std::collections::HashSet::new(); - for role in wanted { - if let Some(helper) = table.control_helper(role) - && helper.function() != symbol - { - targets.insert(helper.function()); - } - } - Some(targets) -} diff --git a/crates/psrs-backend/src/cc/lower/control/operands.rs b/crates/psrs-backend/src/cc/lower/control/operands.rs index 1947b27a..c007e244 100644 --- a/crates/psrs-backend/src/cc/lower/control/operands.rs +++ b/crates/psrs-backend/src/cc/lower/control/operands.rs @@ -16,7 +16,7 @@ impl FunctionLowerer<'_> { arguments: &[Expr], assignments: &mut Vec, ) -> Result, Vec> { - let proof = &self.representations.control_contracts[contract.0 as usize]; + let proof = &self.representations.control_contracts()[contract.0 as usize]; let shapes = match proof.implementation { ControlImplementation::Frame { representation, @@ -64,6 +64,13 @@ impl FunctionLowerer<'_> { return self.lower_array_element(argument, assignments); } let source = self.value_shape(argument.ty, argument.span)?; + if let ValueShape::Reference(Reference { + heap: RefShape::Closure(_), + .. + }) = target + { + self.reject_host_resource_captures(argument)?; + } let value = self.lower_value(argument, assignments)?; if let ValueShape::Reference(Reference { heap: RefShape::Closure(_), diff --git a/crates/psrs-backend/src/cc/lower/control/owned.rs b/crates/psrs-backend/src/cc/lower/control/owned.rs index 4531f974..3e2adca2 100644 --- a/crates/psrs-backend/src/cc/lower/control/owned.rs +++ b/crates/psrs-backend/src/cc/lower/control/owned.rs @@ -4,22 +4,18 @@ //! [`super::plan`]. use super::builder::{Machine, repr}; +use super::fields::ControlEmitter; use crate::cc::Function; impl Machine<'_> { pub(super) fn owned(mut self) -> Function { - let signature = self - .lower - .representations - .signature(self.layout.once) - .unwrap(); - let continuation = self.lower.fresh(signature.parameters[0]); + let signature = self.representations.signature(self.layout.once).unwrap(); + let continuation = self.fresh_value(signature.parameters[0]); let params = [continuation]; - let program = super::plan::once(); - super::plan::verify_plan(&program).expect("once plan must be well-formed"); + let program = super::plan::build(super::plan::Program::Once); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, ¶ms, &mut body); + let representations = self.representations; let symbol = self.functions.once; let function = self.finish(symbol, "control_once", vec![continuation], body, result); super::plan::check_boundary(&function, representations, &program) @@ -28,13 +24,12 @@ impl Machine<'_> { } pub(super) fn cancel(mut self) -> Function { - let owner = self.lower.fresh(repr(self.layout.owner)); + let owner = self.fresh_value(repr(self.layout.owner)); let params = [owner]; - let program = super::plan::cancel(); - super::plan::verify_plan(&program).expect("cancel plan must be well-formed"); + let program = super::plan::build(super::plan::Program::Cancel); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, ¶ms, &mut body); + let representations = self.representations; let symbol = self.functions.cancel; let function = self.finish(symbol, "control_cancel", vec![owner], body, result); super::plan::check_boundary(&function, representations, &program) diff --git a/crates/psrs-backend/src/cc/lower/control/plan/boundary.rs b/crates/psrs-backend/src/cc/lower/control/plan/boundary.rs deleted file mode 100644 index 0a41f723..00000000 --- a/crates/psrs-backend/src/cc/lower/control/plan/boundary.rs +++ /dev/null @@ -1,149 +0,0 @@ -//! The P8 expansion boundary checker. -//! -//! It rebuilds the dispatch/outcome shape of an *emitted* function and compares -//! it with the checked plan's shape. The plan and the emitter are independent: -//! the plan is hand-built from the semantics, the emitter is a generic expander, -//! so an expander defect (dropped arm, wrong tag, wrong terminal) is a mismatch -//! rather than a silently accepted body. The generic CC verifiers still check -//! operand semantics; this checks that expansion emitted the checked program. - -use super::Exec; -use super::ir::Family; -use super::shape::{Shape, Terminal, shape}; -use crate::cc::branch_facts::{Definitions, tag_source}; -use crate::cc::value_identity::transparent; -use crate::cc::{AssignmentKind as A, Function, ReprId, RepresentationTable, ValueId}; -use psrs_hir::SymbolId; - -/// Compare the emitted function's machine dispatch against `plan`. -pub(crate) fn check_boundary( - function: &Function, - table: &RepresentationTable, - plan: &Exec, -) -> Result<(), &'static str> { - let schema = table - .control_schema() - .ok_or("boundary check has no checked machine schema")?; - let expected = shape(plan); - let view = View { - definitions: crate::cc::value_identity::definitions(&function.assignments), - computation: schema.computation, - sequence: schema.sequence, - context: schema.context, - extent: schema.extent, - owner: schema.owner, - executor: table - .control_helper(crate::cc::ControlHelperRole::Executor) - .map(|h| h.function()), - helpers: table - .control_helpers - .iter() - .map(|helper| helper.function()) - .collect(), - }; - if view.shape(function.result) != expected { - return Err("emitted machine dispatch or outcome disagrees with the checked plan"); - } - Ok(()) -} - -struct View<'a> { - definitions: Definitions<'a>, - computation: ReprId, - sequence: ReprId, - context: ReprId, - extent: ReprId, - owner: ReprId, - executor: Option, - helpers: Vec, -} - -impl View<'_> { - /// Resolve representations without collapsing a dispatch: follow casts and - /// transparent conversions, but keep a `TagSwitch` as its own node. - fn strip(&self, mut value: ValueId) -> ValueId { - let mut active = std::collections::HashSet::new(); - loop { - if !active.insert(value) { - break; - } - match self.definitions.get(&value).copied() { - Some(A::RepresentationCast { value: source, .. }) => value = *source, - Some(A::AggregateConvert { - value: source, - conversion, - .. - }) if transparent(&conversion.plan) => value = *source, - _ => break, - } - } - value - } - - fn family(&self, repr: ReprId) -> Option { - if repr == self.computation { - Some(Family::Computation) - } else if repr == self.sequence { - Some(Family::Sequence) - } else if repr == self.context { - Some(Family::Context) - } else if repr == self.extent { - Some(Family::Extent) - } else if repr == self.owner { - Some(Family::Owner) - } else { - None - } - } - - fn shape(&self, value: ValueId) -> Shape { - let value = self.strip(value); - match self.definitions.get(&value).copied() { - Some(A::TagSwitch { - value: selector, - cases, - .. - }) => { - if let Some((repr, _)) = tag_source(*selector, &self.definitions) - && let Some(family) = self.family(repr) - { - return Shape::Switch( - family, - cases - .iter() - .map(|case| (case.tag as u32, self.shape(case.value))) - .collect(), - ); - } - Shape::Leaf(Terminal::Value) - } - Some(A::DirectCall { function, .. }) => { - if Some(*function) == self.executor { - Shape::Leaf(Terminal::Advance) - } else if self.helpers.contains(function) { - Shape::Leaf(Terminal::Tail) - } else { - Shape::Leaf(Terminal::Value) - } - } - Some(A::Unreachable) => Shape::Leaf(Terminal::Reject), - _ => Shape::Leaf(Terminal::Value), - } - } -} - -#[cfg(test)] -mod tests { - use super::super::executor; - use super::*; - - #[test] - fn shape_is_sensitive_to_a_dropped_dispatch_arm() { - let mut plan = executor(); - let before = shape(&plan); - if let Exec::Switch { arms, .. } = &mut plan { - arms.retain(|(tag, _)| *tag != 0); - } - assert_ne!(shape(&plan), before); - } -} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/boundary/mod.rs b/crates/psrs-backend/src/cc/lower/control/plan/boundary/mod.rs new file mode 100644 index 00000000..439ca001 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/boundary/mod.rs @@ -0,0 +1,253 @@ +//! Independent, ordered validation of ordinary CC against its construction plan. +//! +//! Casts may bridge planned reference shapes; generic CC verification checks +//! their legality. Every other assignment must implement the next planned +//! operation, including unused effects and trapping defaults. This is a P8 +//! construction check, not a validator for arbitrary optimized programs. + +mod ops; +mod primitives; + +use super::ir::{Case, Exec, Operand, state_index}; +use crate::cc::branch_facts::Definitions; +use crate::cc::{ + Assignment, AssignmentKind as A, ControlSchema, Function, ReprId, RepresentationTable, ValueId, +}; + +type Checked = Result; +const MISMATCH: &str = + "emitted machine operands or ordered operations disagree with the checked plan"; + +pub(crate) fn check_boundary( + function: &Function, + table: &RepresentationTable, + plan: &super::CheckedPlan, +) -> Checked<()> { + let checker = Checker { + table, + schema: table + .control_schema() + .ok_or("boundary check has no checked machine schema")?, + definitions: crate::cc::value_identity::definitions(&function.assignments), + params: &function.parameters, + shapes: function + .values + .iter() + .map(|value| (value.id, value.ty)) + .collect(), + used_casts: std::cell::RefCell::new(std::collections::HashSet::new()), + pending_casts: std::cell::RefCell::new(Vec::new()), + }; + let mut body = function.assignments.as_slice(); + let result = checker.exec(plan.exec(), &mut Vec::new(), &mut body)?; + checker.equal(result, function.result)?; + checker.end(&mut body)?; + Ok(()) +} + +struct Checker<'a> { + table: &'a RepresentationTable, + schema: ControlSchema, + definitions: Definitions<'a>, + params: &'a [ValueId], + shapes: std::collections::HashMap, + used_casts: std::cell::RefCell>, + pending_casts: std::cell::RefCell>, +} + +impl Checker<'_> { + fn strip(&self, mut value: ValueId) -> Checked { + let mut active = std::collections::HashSet::new(); + while let Some(A::RepresentationCast { value: source, .. }) = + self.definitions.get(&value).copied() + { + if !active.insert(value) { + return Err(MISMATCH); + } + value = *source; + } + Ok(value) + } + + fn equal(&self, a: ValueId, b: ValueId) -> Checked<()> { + self.used_casts.borrow_mut().extend([a, b]); + if self.strip(a)? == self.strip(b)? { + Ok(()) + } else { + Err(MISMATCH) + } + } + + fn values(&self, actual: &[ValueId], expected: &[ValueId]) -> Checked<()> { + if actual.len() != expected.len() { + return Err(MISMATCH); + } + for (a, b) in actual.iter().zip(expected) { + self.equal(*a, *b)?; + } + Ok(()) + } + + fn operand(&self, value: &Operand, env: &[ValueId]) -> Checked { + match value { + Operand::State(slot) => self.params.get(state_index(*slot)), + Operand::Param(index) => self.params.get(*index), + Operand::Temp(index) => env.get(*index), + } + .copied() + .ok_or(MISMATCH) + } + + fn operands(&self, values: &[Operand], env: &[ValueId]) -> Checked> { + values + .iter() + .map(|value| self.operand(value, env)) + .collect() + } + + fn representation(&self, case: Case) -> ReprId { + match case { + Case::Computation(_) => self.schema.computation, + Case::Sequence(_) => self.schema.sequence, + Case::Context(_) => self.schema.context, + Case::Extent(_) => self.schema.extent, + Case::Owner(_) => self.schema.owner, + } + } + + fn skip_casts(&self, body: &mut &[Assignment]) { + while let Some(Assignment { + destination, + kind: A::RepresentationCast { + value, reference, .. + }, + .. + }) = body.first() + { + let target = crate::cc::ValueShape::Reference(*reference); + // Erasure and same-shape aliases are total. A recovery must feed + // the immediately following checked operation or actual exit; + // it cannot move across a guard, store or user callback. + if target != crate::cc::payload::erased_shape() + && self.shapes.get(value) != Some(&target) + { + self.pending_casts.borrow_mut().push(*destination); + } + *body = &body[1..]; + } + } + + fn consumed_casts(&self) -> Checked<()> { + if self + .pending_casts + .borrow() + .iter() + .any(|value| !self.used_casts.borrow().contains(value)) + { + return Err(MISMATCH); + } + self.pending_casts.borrow_mut().clear(); + Ok(()) + } + + fn next<'a>(&self, body: &mut &'a [Assignment]) -> Checked<&'a Assignment> { + self.consumed_casts()?; + self.skip_casts(body); + let (next, rest) = body.split_first().ok_or(MISMATCH)?; + *body = rest; + Ok(next) + } + + fn end(&self, body: &mut &[Assignment]) -> Checked<()> { + self.consumed_casts()?; + self.skip_casts(body); + self.consumed_casts()?; + if body.is_empty() { + Ok(()) + } else { + Err(MISMATCH) + } + } + + fn reject(&self, body: &[Assignment], result: ValueId) -> Checked<()> { + let mut body = body; + let assignment = self.next(&mut body)?; + if !matches!(assignment.kind, A::Unreachable) { + return Err(MISMATCH); + } + self.equal(assignment.destination, result)?; + self.end(&mut body) + } + + fn exec( + &self, + plan: &Exec, + env: &mut Vec, + body: &mut &[Assignment], + ) -> Checked { + match plan { + Exec::Steps { ops, next } => { + let base = env.len(); + for op in ops { + let value = self.op(op, env, body)?; + env.push(value); + } + let value = self.exec(next, env, body)?; + env.truncate(base); + Ok(value) + } + Exec::Switch { source, case, arms } => { + let source = self.operand(source, env)?; + let tag = self.tag(source, self.representation(*case), body)?; + let assignment = self.next(body)?; + let A::TagSwitch { + value, + cases, + default_assignments, + default_value, + } = &assignment.kind + else { + return Err(MISMATCH); + }; + self.equal(*value, tag)?; + if cases.len() != arms.len() { + return Err(MISMATCH); + } + for (actual, (tag, arm)) in cases.iter().zip(arms) { + if actual.tag != *tag as i32 { + return Err(MISMATCH); + } + let mut branch = actual.assignments.as_slice(); + let result = self.exec(arm, &mut env.clone(), &mut branch)?; + self.equal(result, actual.value)?; + self.end(&mut branch)?; + } + self.reject(default_assignments, *default_value)?; + Ok(assignment.destination) + } + Exec::Advance { + state, + handler, + computation, + sequence, + extent, + context, + } => { + let args = [state, handler, computation, sequence, extent, context] + .iter() + .map(|value| self.operand(value, env)) + .collect::>>()?; + self.call(crate::cc::ControlHelperRole::Executor, &args, body) + } + Exec::Tail { role, args } => self.call(*role, &self.operands(args, env)?, body), + Exec::Return { value } | Exec::Publish { result: value } => self.operand(value, env), + Exec::Reject { .. } => { + let assignment = self.next(body)?; + if !matches!(assignment.kind, A::Unreachable) { + return Err(MISMATCH); + } + Ok(assignment.destination) + } + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/boundary/ops.rs b/crates/psrs-backend/src/cc/lower/control/plan/boundary/ops.rs new file mode 100644 index 00000000..deb80fd6 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/boundary/ops.rs @@ -0,0 +1,189 @@ +//! Interpret each planned operation as an independent emitted-CC obligation. +use super::super::ir::{Op, Product}; +use super::*; +use crate::cc::ControlHelperRole as R; +use crate::control::schema::{ContextCase, ExtentCase, SequenceCase, context}; + +impl Checker<'_> { + pub(super) fn op( + &self, + op: &Op, + env: &[ValueId], + body: &mut &[Assignment], + ) -> Checked { + let operand = |value| self.operand(value, env); + match op { + Op::Project { + source, + case, + field, + } => self.project( + operand(source)?, + self.representation(*case), + case.tag(), + *field, + body, + ), + Op::Node { case, fields } => self.node( + self.representation(*case), + case.tag(), + &self.operands(fields, env)?, + body, + ), + Op::Capture { + closure, + index, + case, + } => { + let a = self.next(body)?; + let A::ClosureGetCapture { + closure: actual, + index: slot, + } = &a.kind + else { + return Err(MISMATCH); + }; + if slot != index { + return Err(MISMATCH); + } + self.equal(*actual, operand(closure)?)?; + let expected = crate::cc::ValueShape::Reference(crate::cc::Reference { + nullable: false, + heap: crate::cc::RefShape::Repr(self.representation(*case)), + }); + if self.shapes.get(&a.destination) != Some(&expected) { + return Err(MISMATCH); + } + Ok(a.destination) + } + Op::Apply { callee, args } => { + let mut callee = operand(callee)?; + let signature = self.table.control_resumption().ok_or(MISMATCH)?.signature(); + for arg in args { + let a = self.next(body)?; + let A::IndirectCall { + function, + signature: actual, + arguments, + } = &a.kind + else { + return Err(MISMATCH); + }; + if *actual != signature { + return Err(MISMATCH); + } + self.equal(*function, callee)?; + self.values(arguments, &[operand(arg)?])?; + callee = a.destination; + } + Ok(callee) + } + Op::Helper { role, args } => self.call(*role, &self.operands(args, env)?, body), + Op::ResumeClosure { captures } => { + let raw = self.table.control_resumption().ok_or(MISMATCH)?; + let a = self.next(body)?; + let A::FunctionRef { + function, + signature, + captures: actual, + } = &a.kind + else { + return Err(MISMATCH); + }; + if (*function, *signature) != (raw.function(), raw.signature()) { + return Err(MISMATCH); + } + self.values(actual, &self.operands(captures, env)?)?; + Ok(a.destination) + } + Op::Pair { state, value } => self.product( + self.schema.result_pair, + &[operand(state)?, operand(value)?], + body, + ), + Op::PairField { pair, field } => { + self.product_field(operand(pair)?, self.schema.result_pair, *field, body) + } + Op::ReplayField { result, field } => { + self.product_field(operand(result)?, self.schema.replay_result, *field, body) + } + Op::FreshExtent { parent } => { + let status = self.new_status(body)?; + let (case, fields) = match parent { + Some(parent) => (ExtentCase::Scoped, vec![status, operand(parent)?]), + None => (ExtentCase::Root, vec![status]), + }; + self.node(self.schema.extent, case.tag(), &fields, body) + } + Op::ContextExtent { context } => self.context_extent(operand(context)?, body), + Op::CheckBoundary { extent } => self.call(R::Check, &[operand(extent)?], body), + Op::CloseBoundary { extent } => self.call(R::Close, &[operand(extent)?], body), + Op::GuardPending { cell } => { + let cell = operand(cell)?; + self.guard(cell, body)?; + Ok(cell) + } + Op::SetStatus { cell, value } => { + let cell = operand(cell)?; + let status = self.constant(*value, body)?; + self.write(self.schema.status, cell, status, body)?; + Ok(cell) + } + Op::ReadCallback { cell } => self.read(self.schema.callback, operand(cell)?, body), + Op::WriteCallback { cell, value } => { + let cell = operand(cell)?; + self.write(self.schema.callback, cell, operand(value)?, body)?; + Ok(cell) + } + Op::NewCallbackCell { value } => { + self.new_cell(self.schema.callback, operand(value)?, body) + } + Op::NewStatus => self.new_status(body), + Op::Product { + product: Product::ReplayResult, + fields, + } => self.product( + self.schema.replay_result, + &self.operands(fields, env)?, + body, + ), + Op::EmptySequence => { + self.node(self.schema.sequence, SequenceCase::Empty.tag(), &[], body) + } + } + } + + fn context_extent(&self, source: ValueId, body: &mut &[Assignment]) -> Checked { + let tag = self.tag(source, self.schema.context, body)?; + let a = self.next(body)?; + let A::TagSwitch { + value, + cases, + default_assignments, + default_value, + } = &a.kind + else { + return Err(MISMATCH); + }; + self.equal(*value, tag)?; + if cases.len() != ContextCase::ALL.len() { + return Err(MISMATCH); + } + for (actual, case) in cases.iter().zip(ContextCase::ALL) { + if actual.tag != case.tag() as i32 { + return Err(MISMATCH); + } + let field = match case { + ContextCase::Root => context::ROOT_EXTENT, + ContextCase::Scoped => context::SCOPED_EXTENT, + }; + let mut branch = actual.assignments.as_slice(); + let result = + self.project(source, self.schema.context, case.tag(), field, &mut branch)?; + self.equal(result, actual.value)?; + self.end(&mut branch)?; + } + self.reject(default_assignments, *default_value)?; + Ok(a.destination) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/boundary/primitives.rs b/crates/psrs-backend/src/cc/lower/control/plan/boundary/primitives.rs new file mode 100644 index 00000000..4e5f9509 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/boundary/primitives.rs @@ -0,0 +1,257 @@ +//! Check ordered CC operations without invoking the machine emitter. +use super::*; +use crate::cc::ControlHelperRole; + +impl Checker<'_> { + pub(super) fn tag( + &self, + source: ValueId, + repr: ReprId, + body: &mut &[Assignment], + ) -> Checked { + let a = self.next(body)?; + let A::VariantTag { + representation, + value, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if *representation != repr { + return Err(MISMATCH); + } + self.equal(*value, source)?; + Ok(a.destination) + } + + pub(super) fn project( + &self, + source: ValueId, + repr: ReprId, + tag: u32, + field: u32, + body: &mut &[Assignment], + ) -> Checked { + let a = self.next(body)?; + let A::VariantGet { + representation, + case, + field: index, + value, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if (*representation, *case, *index) != (repr, tag, field) { + return Err(MISMATCH); + } + self.equal(*value, source)?; + Ok(a.destination) + } + + pub(super) fn node( + &self, + repr: ReprId, + tag: u32, + args: &[ValueId], + body: &mut &[Assignment], + ) -> Checked { + let a = self.next(body)?; + let A::VariantNew { + representation, + case, + fields, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if (*representation, *case) != (repr, tag) { + return Err(MISMATCH); + } + self.values(fields, args)?; + Ok(a.destination) + } + + pub(super) fn product( + &self, + repr: ReprId, + args: &[ValueId], + body: &mut &[Assignment], + ) -> Checked { + let a = self.next(body)?; + let A::ProductNew { + representation, + arguments, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if *representation != repr { + return Err(MISMATCH); + } + self.values(arguments, args)?; + Ok(a.destination) + } + + pub(super) fn product_field( + &self, + source: ValueId, + repr: ReprId, + index: u32, + body: &mut &[Assignment], + ) -> Checked { + let a = self.next(body)?; + let A::ProductGet { + representation, + field, + value, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if (*representation, *field) != (repr, index) { + return Err(MISMATCH); + } + self.equal(*value, source)?; + Ok(a.destination) + } + + pub(super) fn call( + &self, + role: ControlHelperRole, + args: &[ValueId], + body: &mut &[Assignment], + ) -> Checked { + let helper = self.table.control_helper(role).ok_or(MISMATCH)?; + let a = self.next(body)?; + let A::DirectCall { + function, + arguments, + contract, + } = &a.kind + else { + return Err(MISMATCH); + }; + if *function != helper.function() + || contract.and_then(|id| self.table.control_helpers().get(id.0 as usize)) + != Some(helper) + { + return Err(MISMATCH); + } + self.values(arguments, args)?; + Ok(a.destination) + } + + pub(super) fn constant(&self, expected: i32, body: &mut &[Assignment]) -> Checked { + let a = self.next(body)?; + if !matches!(a.kind, A::Constant(n) if n == expected) { + return Err(MISMATCH); + } + Ok(a.destination) + } + + pub(super) fn new_cell( + &self, + repr: ReprId, + value: ValueId, + body: &mut &[Assignment], + ) -> Checked { + let a = self.next(body)?; + let A::ArrayNew { + representation, + elements, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if *representation != repr { + return Err(MISMATCH); + } + self.values(elements, &[value])?; + Ok(a.destination) + } + + pub(super) fn read( + &self, + repr: ReprId, + cell: ValueId, + body: &mut &[Assignment], + ) -> Checked { + let zero = self.constant(0, body)?; + let a = self.next(body)?; + let A::ArrayGet { + representation, + value, + index, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if *representation != repr { + return Err(MISMATCH); + } + self.equal(*value, cell)?; + self.equal(*index, zero)?; + Ok(a.destination) + } + + pub(super) fn write( + &self, + repr: ReprId, + cell: ValueId, + expected: ValueId, + body: &mut &[Assignment], + ) -> Checked<()> { + let zero = self.constant(0, body)?; + let a = self.next(body)?; + let A::ArraySet { + representation, + value, + index, + new_value, + .. + } = &a.kind + else { + return Err(MISMATCH); + }; + if *representation != repr { + return Err(MISMATCH); + } + self.equal(*value, cell)?; + self.equal(*index, zero)?; + self.equal(*new_value, expected) + } + + pub(super) fn new_status(&self, body: &mut &[Assignment]) -> Checked { + let zero = self.constant(0, body)?; + self.new_cell(self.schema.status, zero, body) + } + + pub(super) fn guard(&self, cell: ValueId, body: &mut &[Assignment]) -> Checked<()> { + let status = self.read(self.schema.status, cell, body)?; + let a = self.next(body)?; + let A::TagSwitch { + value, + cases, + default_assignments, + default_value, + } = &a.kind + else { + return Err(MISMATCH); + }; + self.equal(*value, status)?; + if cases.len() != 1 || cases[0].tag != 0 { + return Err(MISMATCH); + } + self.end(&mut cases[0].assignments.as_slice())?; + self.equal(cases[0].value, cell)?; + self.reject(default_assignments, *default_value) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/check.rs b/crates/psrs-backend/src/cc/lower/control/plan/check.rs deleted file mode 100644 index 17197933..00000000 --- a/crates/psrs-backend/src/cc/lower/control/plan/check.rs +++ /dev/null @@ -1,130 +0,0 @@ -//! Independent structural validation of the driver plan. - -use super::ir::{Case, Exec, Op}; -use crate::control::execution::ActionId; -use crate::control::schema::{ComputationCase, ContextCase, SequenceCase}; -use std::collections::HashSet; - -/// -/// It verifies that every dispatch covers exactly its schema's cases, that -/// every allocation has the declared field arity, and that every required -/// flat-driver action is present. It does not inspect operation order; the -/// story's own CC verifiers check the emitted body. -pub(crate) fn check(exec: &Exec) -> Result<(), &'static str> { - verify(exec)?; - let mut actions = HashSet::new(); - record_executor(exec, &mut actions)?; - if ActionId::ALL.iter().all(|action| actions.contains(action)) { - Ok(()) - } else { - Err("checked driver plan is missing a required action") - } -} - -pub(crate) fn verify(exec: &Exec) -> Result<(), &'static str> { - match exec { - Exec::Steps { ops, next } => { - for op in ops { - if let Op::Node { case, fields } = op - && fields.len() != case.field_count() - { - return Err("driver plan allocates a node with the wrong field arity"); - } - } - verify(next) - } - Exec::Switch { case, arms, .. } => { - let mut tags = arms.iter().map(|(tag, _)| *tag).collect::>(); - let unique = tags.len(); - tags.sort_unstable(); - tags.dedup(); - if tags.len() != unique { - return Err("driver plan dispatch repeats a case"); - } - let allowed = case.tags(); - if tags.iter().any(|tag| !allowed.contains(tag)) { - return Err("driver plan dispatch invents a schema case"); - } - for (_, arm) in arms { - verify(arm)?; - } - Ok(()) - } - Exec::Advance { .. } - | Exec::Publish { .. } - | Exec::Return { .. } - | Exec::Tail { .. } - | Exec::Reject { .. } => Ok(()), - } -} - -/// Navigate the recognized driver shape and record each reached action. -fn record_executor(exec: &Exec, actions: &mut HashSet) -> Result<(), &'static str> { - let arms = switch_arms(exec, &|case| matches!(case, Case::Computation(_))) - .ok_or("driver plan must refine the computation carrier first")?; - for (tag, arm) in arms { - if *tag == ComputationCase::Return.tag() { - record_return(arm, actions)?; - } else if *tag == ComputationCase::Perform.tag() - && switch_arms(arm, &|case| matches!(case, Case::Context(_))) - .is_some_and(|arms| arms.iter().any(|(tag, _)| *tag == ContextCase::Root.tag())) - { - actions.insert(ActionId::PerformRoot); - } - } - Ok(()) -} - -fn record_return(exec: &Exec, actions: &mut HashSet) -> Result<(), &'static str> { - let queue = switch_arms(exec, &|case| matches!(case, Case::Sequence(_))) - .ok_or("return must refine the queue")?; - for (tag, arm) in queue { - if *tag == SequenceCase::Empty.tag() - && switch_arms(arm, &|case| matches!(case, Case::Context(_))) - .is_some_and(|arms| arms.iter().any(|(t, _)| *t == ContextCase::Root.tag())) - { - actions.insert(ActionId::ReturnEmptyRoot); - } else if *tag == SequenceCase::Cons.tag() { - actions.insert(ActionId::ReturnCons); - } else if *tag == SequenceCase::Finish.tag() { - actions.insert(ActionId::ReturnFinish); - } else if *tag == SequenceCase::Append.tag() - && let Some(left) = switch_arms(arm, &|case| matches!(case, Case::Sequence(_))) - { - for (left_tag, _) in left { - let action = match *left_tag { - tag if tag == SequenceCase::Empty.tag() => Some(ActionId::AppendEmpty), - tag if tag == SequenceCase::Cons.tag() => Some(ActionId::AppendCons), - tag if tag == SequenceCase::Append.tag() => Some(ActionId::AppendAppend), - tag if tag == SequenceCase::Finish.tag() => Some(ActionId::AppendFinish), - _ => None, - }; - if let Some(action) = action { - actions.insert(action); - } - } - } - } - Ok(()) -} - -/// The first switch in this subtree whose carrier satisfies `wanted`. -fn switch_arms<'a>(exec: &'a Exec, wanted: &dyn Fn(Case) -> bool) -> Option<&'a [(u32, Exec)]> { - match exec { - Exec::Switch { case, arms, .. } if wanted(*case) => Some(arms), - Exec::Steps { ops: _, next } => switch_arms(next, wanted), - Exec::Switch { arms, .. } => { - for (_, arm) in arms { - if let Some(found) = switch_arms(arm, wanted) { - return Some(found); - } - } - None - } - Exec::Advance { .. } - | Exec::Publish { .. } - | Exec::Return { .. } - | Exec::Tail { .. } - | Exec::Reject { .. } => None, - } -} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/check/mod.rs b/crates/psrs-backend/src/cc/lower/control/plan/check/mod.rs new file mode 100644 index 00000000..55b96296 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/check/mod.rs @@ -0,0 +1,100 @@ +//! Check all named actions and typed, lexically scoped construction operands. +mod operations; +mod scope; +#[cfg(test)] +mod tests; + +use super::ir::{Case, Exec, Operand, state_index}; +use crate::control::execution::{ActionId, Outcome, Program, Selection}; +use crate::control::schema::{FieldKind, OwnerCase}; +use scope::{Info, Scope}; +use std::collections::HashSet; + +type Checked = Result; + +#[cfg(test)] +pub(crate) fn check(exec: &Exec) -> Checked<()> { + check_for(Program::Executor, exec) +} + +pub(crate) fn check_for(program: Program, exec: &Exec) -> Checked<()> { + let mut reached = HashSet::new(); + walk(exec, &mut Vec::new(), program, &mut reached)?; + for action in ActionId::ALL { + if action.selection().0 == program && !reached.contains(&action) { + return Err("checked machine plan is missing a required action"); + } + } + let scope = Scope::new(program); + scope.exec(exec) +} + +fn selection(case: Case, tag: u32) -> Checked { + use crate::control::schema::{ + ComputationCase as C, ContextCase as X, ExtentCase as E, SequenceCase as Q, + }; + match case { + Case::Computation(_) => C::ALL + .into_iter() + .find(|case| case.tag() == tag) + .map(Selection::Computation), + Case::Sequence(_) => Q::ALL + .into_iter() + .find(|case| case.tag() == tag) + .map(Selection::Sequence), + Case::Context(_) => X::ALL + .into_iter() + .find(|case| case.tag() == tag) + .map(Selection::Context), + Case::Extent(_) => E::ALL + .into_iter() + .find(|case| case.tag() == tag) + .map(Selection::Extent), + Case::Owner(_) => None, + } + .ok_or("machine plan dispatch invents an action selection") +} + +fn walk( + exec: &Exec, + path: &mut Vec, + program: Program, + reached: &mut HashSet, +) -> Checked<()> { + match exec { + Exec::Steps { next, .. } => return walk(next, path, program, reached), + Exec::Switch { case, arms, .. } => { + let mut tags = arms.iter().map(|(tag, _)| *tag).collect::>(); + tags.sort_unstable(); + if tags != case.tags() { + return Err("machine plan dispatch must cover every schema case exactly once"); + } + for (tag, arm) in arms { + path.push(selection(*case, *tag)?); + walk(arm, path, program, reached)?; + path.pop(); + } + return Ok(()); + } + _ => {} + } + let action = ActionId::ALL + .into_iter() + .find(|action| action.selection() == (program, path.as_slice())) + .ok_or("machine plan has an undeclared action path")?; + let outcome = match exec { + Exec::Advance { .. } => Outcome::Advance, + Exec::Publish { .. } => Outcome::Publish, + Exec::Return { .. } => Outcome::Return, + Exec::Tail { role, .. } => Outcome::Tail(*role), + Exec::Reject { .. } => Outcome::Reject, + _ => unreachable!(), + }; + if action.outcome() != outcome { + return Err("machine plan action has the wrong terminal outcome"); + } + if !reached.insert(action) { + return Err("machine plan repeats an action"); + } + Ok(()) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/check/operations.rs b/crates/psrs-backend/src/cc/lower/control/plan/check/operations.rs new file mode 100644 index 00000000..69d3e14c --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/check/operations.rs @@ -0,0 +1,130 @@ +//! Logical type and provenance preconditions of construction operations. +use super::super::ir::{Op, Product}; +use super::*; +use crate::control::schema::{ExtentCase, SequenceCase}; + +impl Scope { + pub(super) fn op(&self, op: &Op) -> Checked { + use FieldKind as K; + let kind = match op { + Op::Project { + source, + case, + field, + } => return self.projection(source, *case, *field), + Op::Node { case, fields } => { + self.arguments(fields, case.fields())?; + return Ok(Info::node(*case)); + } + Op::Capture { + closure, + index, + case, + } => { + if self.program != Program::RawResume { + return Err("only raw resume may read machine closure captures"); + } + self.require(closure, K::Callable)?; + let expected = match *index { + 0 => K::Sequence, + 1 => K::Extent, + _ => return Err("raw resume capture index is outside its protocol"), + }; + if case.kind() != expected { + return Err("raw resume capture has the wrong carrier role"); + } + expected + } + Op::Apply { callee, args } => { + self.require(callee, K::Callable)?; + if args.is_empty() { + return Err("machine callback application requires an argument"); + } + for arg in args { + self.info(arg)?; + } + K::Payload + } + Op::Helper { role, args } => { + self.arguments(args, role.parameters())?; + role.result() + } + Op::ResumeClosure { captures } => { + self.arguments(captures, &[K::Sequence, K::Extent])?; + K::Callable + } + Op::Pair { state, value } => { + self.info(state)?; + self.info(value)?; + K::ResultPair + } + Op::PairField { pair, field } => { + self.require(pair, K::ResultPair)?; + if *field > 1 { + return Err("machine result pair field is out of range"); + } + K::Payload + } + Op::ReplayField { result, field } => { + self.require(result, K::ReplayResult)?; + match *field { + 0 => K::Sequence, + 1 => K::Extent, + _ => return Err("machine replay result field is out of range"), + } + } + Op::FreshExtent { parent } => { + if let Some(parent) = parent { + self.require(parent, K::Extent)?; + } + return Ok(Info::node(Case::Extent(if parent.is_some() { + ExtentCase::Scoped + } else { + ExtentCase::Root + }))); + } + Op::ContextExtent { context } => { + self.require(context, K::Context)?; + K::Extent + } + Op::CheckBoundary { extent } | Op::CloseBoundary { extent } => { + self.require(extent, K::Extent)?; + K::Extent + } + Op::GuardPending { cell } => { + self.require(cell, K::Status)?; + K::Status + } + Op::SetStatus { cell, value } => { + self.require(cell, K::Status)?; + if !(0..=3).contains(value) { + return Err("machine status write is outside the lifecycle domain"); + } + K::Status + } + Op::ReadCallback { cell } => { + self.require(cell, K::Callback)?; + K::Payload + } + Op::WriteCallback { cell, value } => { + self.require(cell, K::Callback)?; + self.info(value)?; + K::Callback + } + Op::NewCallbackCell { value } => { + self.require(value, K::Callable)?; + K::Callback + } + Op::NewStatus => K::Status, + Op::Product { + product: Product::ReplayResult, + fields, + } => { + self.arguments(fields, &[K::Sequence, K::Extent])?; + K::ReplayResult + } + Op::EmptySequence => return Ok(Info::node(Case::Sequence(SequenceCase::Empty))), + }; + Ok(Info::new(kind)) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/check/scope.rs b/crates/psrs-backend/src/cc/lower/control/plan/check/scope.rs new file mode 100644 index 00000000..1aaf9488 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/check/scope.rs @@ -0,0 +1,164 @@ +//! Scope and logical storage roles are checked before allocating CC values. +use super::super::ir::Family; +use super::*; +use std::collections::HashMap; + +#[derive(Clone, Copy)] +pub(super) struct Info { + pub kind: FieldKind, + pub tag: Option, +} + +impl Info { + pub(super) fn new(kind: FieldKind) -> Self { + Self { kind, tag: None } + } + pub(super) fn node(case: Case) -> Self { + Self { + kind: case.kind(), + tag: Some(case.tag()), + } + } +} + +#[derive(Clone)] +pub(super) struct Scope { + pub program: Program, + pub temps: Vec, + pub refinements: HashMap, +} + +impl Scope { + pub(super) fn new(program: Program) -> Self { + Self { + program, + temps: Vec::new(), + refinements: HashMap::new(), + } + } + + fn key(&self, operand: &Operand) -> Checked { + Ok(match operand { + Operand::State(state) => { + if self.program != Program::Executor { + return Err("helper plan cannot read executor state"); + } + Operand::Param(state_index(*state)) + } + _ => operand.clone(), + }) + } + + pub(super) fn info(&self, operand: &Operand) -> Checked { + let key = self.key(operand)?; + let mut info = match key { + Operand::Param(index) => self.program.parameters().get(index).copied().map(Info::new), + Operand::Temp(index) => self.temps.get(index).copied(), + Operand::State(_) => unreachable!(), + } + .ok_or("machine plan operand is outside its lexical scope")?; + if let Some((_, tag)) = self.refinements.get(&key) { + info.tag = Some(*tag); + } + Ok(info) + } + + pub(super) fn require(&self, operand: &Operand, kind: FieldKind) -> Checked<()> { + let actual = self.info(operand)?.kind; + // Payload erasure accepts references. Callback results may recover a + // computation, callable or result pair at their checked protocol use. + if actual == kind + || kind == FieldKind::Payload + || (actual == FieldKind::Payload + && matches!( + kind, + FieldKind::Computation | FieldKind::Callable | FieldKind::ResultPair + )) + { + Ok(()) + } else { + Err("machine plan operand has the wrong logical storage role") + } + } + + pub(super) fn arguments(&self, args: &[Operand], expected: &[FieldKind]) -> Checked<()> { + if args.len() != expected.len() { + return Err("machine plan call or allocation has the wrong arity"); + } + for (arg, kind) in args.iter().zip(expected) { + self.require(arg, *kind)?; + } + Ok(()) + } + + pub(super) fn projection(&self, source: &Operand, case: Case, field: u32) -> Checked { + self.require(source, case.kind())?; + let info = self.info(source)?; + let singleton = case == Case::Owner(OwnerCase::OneShot); + if !singleton && info.tag != Some(case.tag()) { + return Err("machine plan projection lacks its own case refinement"); + } + let kind = *case + .fields() + .get(field as usize) + .ok_or("machine plan projection names an invalid field")?; + Ok(Info::new(kind)) + } + + pub(super) fn exec(mut self, exec: &Exec) -> Checked<()> { + match exec { + Exec::Steps { ops, next } => { + for op in ops { + let info = self.op(op)?; + self.temps.push(info); + } + self.exec(next) + } + Exec::Switch { source, case, arms } => { + self.require(source, case.kind())?; + let key = self.key(source)?; + for (tag, arm) in arms { + let mut branch = self.clone(); + branch + .refinements + .insert(key.clone(), (case.family(), *tag)); + branch.exec(arm)?; + } + Ok(()) + } + Exec::Advance { + state, + handler, + computation, + sequence, + extent, + context, + } => { + if self.program != Program::Executor { + return Err("only the executor may advance machine state"); + } + self.arguments( + &[ + state.clone(), + handler.clone(), + computation.clone(), + sequence.clone(), + extent.clone(), + context.clone(), + ], + crate::cc::ControlHelperRole::Executor.parameters(), + ) + } + Exec::Tail { role, args } => { + self.arguments(args, role.parameters())?; + if role.result() != self.program.result() { + return Err("machine plan tail call has the wrong result role"); + } + Ok(()) + } + Exec::Publish { result } => self.require(result, FieldKind::ResultPair), + Exec::Return { value } => self.require(value, self.program.result()), + Exec::Reject { .. } => Ok(()), + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/check/tests.rs b/crates/psrs-backend/src/cc/lower/control/plan/check/tests.rs new file mode 100644 index 00000000..b741cd36 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/check/tests.rs @@ -0,0 +1,246 @@ +use super::super::ir::{Op, State}; +use super::*; +use crate::control::schema::{ComputationCase as C, ContextCase as X, SequenceCase as Q}; + +fn build(program: Program) -> Exec { + match program { + Program::Executor => super::super::executor(), + Program::Run => super::super::run::program(), + Program::CloneSequence => super::super::clone_sequence(), + Program::RebuildSequence => super::super::rebuild_sequence(), + Program::Check => super::super::boundary_check(), + Program::Close => super::super::boundary_close(), + Program::Start => super::super::start_boundary(), + Program::Once => super::super::once(), + Program::Cancel => super::super::cancel(), + Program::RawResume => super::super::raw_resume(), + } +} + +fn edit(plan: &mut Exec, change: &mut impl FnMut(&mut Op) -> bool) -> bool { + match plan { + Exec::Steps { ops, next } => ops.iter_mut().any(&mut *change) || edit(next, change), + Exec::Switch { arms, .. } => arms.iter_mut().any(|(_, arm)| edit(arm, change)), + _ => false, + } +} + +fn reject_op(program: Program, message: &str, change: impl FnMut(&mut Op) -> bool) { + let mut plan = build(program); + assert!(edit(&mut plan, &mut { change })); + let error = check_for(program, &plan).unwrap_err(); + assert!(error.contains(message), "{error}"); +} + +fn drop_path(exec: &mut Exec, path: &[Selection]) { + match exec { + Exec::Steps { next, .. } => drop_path(next, path), + Exec::Switch { case, arms, .. } => { + let index = arms + .iter() + .position(|(tag, _)| selection(*case, *tag).unwrap() == path[0]) + .unwrap(); + if path.len() == 1 { + arms.remove(index); + } else { + drop_path(&mut arms[index].1, &path[1..]); + } + } + _ => { + assert!(path.is_empty()); + *exec = Exec::Tail { + role: crate::cc::ControlHelperRole::Close, + args: Vec::new(), + }; + } + } +} + +#[test] +fn every_required_action_is_checked_including_helpers_and_rejection_arms() { + let mut unique = HashSet::new(); + for action in ActionId::ALL { + let (program, path) = action.selection(); + assert!( + unique.insert((program, path)), + "duplicate registry path for {action:?}" + ); + let mut plan = build(program); + check_for(program, &plan).unwrap(); + drop_path(&mut plan, path); + assert!( + check_for(program, &plan).is_err(), + "missing {action:?} was accepted" + ); + } + for (program, expected) in [ + (Program::Executor, 20), + (Program::Run, 1), + (Program::CloneSequence, 7), + (Program::RebuildSequence, 4), + (Program::Check, 2), + (Program::Close, 2), + (Program::Start, 1), + (Program::Once, 1), + (Program::Cancel, 1), + (Program::RawResume, 1), + ] { + assert_eq!( + ActionId::ALL + .into_iter() + .filter(|a| a.selection().0 == program) + .count(), + expected + ); + } +} + +#[test] +fn scoped_actions_cannot_disappear_behind_complete_root_actions() { + let mut plan = build(Program::Executor); + drop_path( + &mut plan, + &[ + Selection::Computation(C::Perform), + Selection::Context(X::Scoped), + ], + ); + assert!(check(&plan).is_err()); +} + +#[test] +fn projections_require_the_selected_case_of_their_own_source() { + reject_op(Program::Executor, "case refinement", |op| { + if let Op::Project { + source: Operand::State(State::Sequence), + case, + .. + } = op + && *case == Case::Sequence(Q::Cons) + { + *case = Case::Sequence(Q::Append); + return true; + } + false + }); +} + +#[test] +fn forward_and_out_of_range_operands_are_rejected_before_expansion() { + for source in [Operand::Temp(0), Operand::Temp(999), Operand::Param(6)] { + reject_op(Program::Executor, "lexical scope", |op| { + if let Op::Project { source: actual, .. } = op { + *actual = source.clone(); + return true; + } + false + }); + } +} + +#[test] +fn branch_local_temporaries_cannot_escape_to_siblings() { + let mut plan = build(Program::CloneSequence); + let Exec::Switch { arms, .. } = &mut plan else { + unreachable!() + }; + let Exec::Switch { arms, .. } = &mut arms[0].1 else { + unreachable!() + }; + let Exec::Tail { args, .. } = &mut arms[0].1 else { + unreachable!() + }; + args[0] = Operand::Temp(0); + assert_eq!( + check_for(Program::CloneSequence, &plan), + Err("machine plan operand is outside its lexical scope") + ); +} + +#[test] +fn allocation_and_helper_parameters_keep_their_logical_roles() { + reject_op(Program::Executor, "logical storage role", |op| { + if let Op::Node { + case: Case::Sequence(Q::Cons), + fields, + } = op + { + fields[1] = Operand::State(State::Extent); + return true; + } + false + }); + reject_op(Program::Executor, "wrong arity", |op| { + if let Op::Helper { args, .. } = op { + args.pop(); + return true; + } + false + }); +} + +#[test] +fn helper_cannot_inherit_executor_state() { + reject_op(Program::Once, "executor state", |op| { + if let Op::NewCallbackCell { value } = op { + *value = Operand::State(State::Handler); + return true; + } + false + }); +} + +#[test] +fn capture_slots_and_product_indices_have_checked_domains() { + reject_op(Program::RawResume, "capture index", |op| { + if let Op::Capture { index, .. } = op { + *index = 2; + return true; + } + false + }); + reject_op(Program::Executor, "pair field", |op| { + if let Op::PairField { field, .. } = op { + *field = 2; + return true; + } + false + }); + reject_op(Program::Executor, "replay result field", |op| { + if let Op::ReplayField { field, .. } = op { + *field = 2; + return true; + } + false + }); +} + +#[test] +fn lifecycle_status_values_have_a_checked_domain() { + reject_op(Program::Cancel, "lifecycle domain", |op| { + if let Op::SetStatus { value, .. } = op { + *value = 4; + return true; + } + false + }); +} + +#[test] +fn equal_signature_tail_calls_keep_their_semantic_role() { + let mut plan = build(Program::Check); + let Exec::Switch { arms, .. } = &mut plan else { + unreachable!() + }; + let Exec::Steps { next, .. } = &mut arms[1].1 else { + unreachable!() + }; + let Exec::Tail { role, .. } = next.as_mut() else { + unreachable!() + }; + *role = crate::cc::ControlHelperRole::Close; + assert_eq!( + check_for(Program::Check, &plan), + Err("machine plan action has the wrong terminal outcome") + ); +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/expand.rs b/crates/psrs-backend/src/cc/lower/control/plan/expand.rs index 929871c7..314ea837 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/expand.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/expand.rs @@ -11,6 +11,15 @@ impl Machine<'_> { /// function's parameters; `Operand::State` indexes the executor's six named /// slots and `Operand::Param` a helper's explicit parameters. pub(in crate::cc::lower::control) fn expand( + &mut self, + plan: &super::CheckedPlan, + params: &[ValueId], + body: &mut Vec, + ) -> ValueId { + self.expand_exec(plan.exec(), &mut Vec::new(), params, body) + } + + fn expand_exec( &mut self, exec: &Exec, env: &mut Vec, @@ -24,7 +33,7 @@ impl Machine<'_> { let value = self.expand_op(op, env, params, body); env.push(value); } - let result = self.expand(next, env, params, body); + let result = self.expand_exec(next, env, params, body); env.truncate(base); result } @@ -35,7 +44,7 @@ impl Machine<'_> { for (tag, arm) in arms { let mut arm_body = Vec::new(); let mut arm_env = env.clone(); - let result = self.expand(arm, &mut arm_env, params, &mut arm_body); + let result = self.expand_exec(arm, &mut arm_env, params, &mut arm_body); cases.push(super::super::executor::arm(*tag, arm_body, result)); } self.switch(value, case.repr(self.layout), cases, body) @@ -237,6 +246,7 @@ impl Machine<'_> { fn function_for(&self, role: ControlHelperRole) -> psrs_hir::SymbolId { match role { ControlHelperRole::Executor => self.functions.executor, + ControlHelperRole::Run => self.functions.run, ControlHelperRole::CloneSequence => self.functions.clone_sequence, ControlHelperRole::RebuildSequence => self.functions.rebuild_sequence, ControlHelperRole::Start => self.functions.start, diff --git a/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs b/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs index 0437ae32..df5b2d5d 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/helpers.rs @@ -192,99 +192,95 @@ fn clone_todo(cursor: &Cursor) -> Exec { /// Parameters: `reversed`, `result_queue`, `active`, `parent`. pub(crate) fn rebuild_sequence() -> Exec { let cursor = Cursor::new(); - let arms = [ - SequenceCase::Empty, - SequenceCase::Cons, - SequenceCase::Finish, - ] - .iter() - .map(|case| { - let mut cursor = cursor.clone(); - let arm = match case { - SequenceCase::Empty => { - let mut ops = Vec::new(); - let result = cursor.bind( - &mut ops, - Op::Product { - product: Product::ReplayResult, - fields: vec![param(1), param(2)], - }, - ); - steps(ops, Exec::Return { value: result }) - } - SequenceCase::Cons => { - let mut ops = Vec::new(); - let head = cursor.bind( - &mut ops, - project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_HEAD), - ); - let rest = cursor.bind( - &mut ops, - project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_TAIL), - ); - let next = cursor.bind( - &mut ops, - Op::Node { - case: Case::Sequence(SequenceCase::Cons), - fields: vec![head, param(1)], - }, - ); - steps( - ops, - tail( - ControlHelperRole::RebuildSequence, - vec![rest, next, param(2), param(3)], - ), - ) - } - SequenceCase::Append => Exec::Reject { - shape: Shape::ReplayResult, - }, - SequenceCase::Finish => { - let mut ops = Vec::new(); - // The saved finish's extent is inspected but replaced by a - // fresh activation extent, matching the replay contract. - let _saved = cursor.bind( - &mut ops, - project( - param(0), - Case::Sequence(SequenceCase::Finish), - q::FINISH_EXTENT, - ), - ); - let rest = cursor.bind( - &mut ops, - project( - param(0), - Case::Sequence(SequenceCase::Finish), - q::FINISH_REST, - ), - ); - let extent = cursor.bind( - &mut ops, - Op::FreshExtent { - parent: Some(param(3)), - }, - ); - let next = cursor.bind( - &mut ops, - Op::Node { - case: Case::Sequence(SequenceCase::Finish), - fields: vec![extent.clone(), param(1), param(2)], - }, - ); - steps( - ops, - tail( - ControlHelperRole::RebuildSequence, - vec![rest, next, extent.clone(), extent], - ), - ) - } - }; - (case.tag(), arm) - }) - .collect(); + let arms = SequenceCase::ALL + .iter() + .map(|case| { + let mut cursor = cursor.clone(); + let arm = match case { + SequenceCase::Empty => { + let mut ops = Vec::new(); + let result = cursor.bind( + &mut ops, + Op::Product { + product: Product::ReplayResult, + fields: vec![param(1), param(2)], + }, + ); + steps(ops, Exec::Return { value: result }) + } + SequenceCase::Cons => { + let mut ops = Vec::new(); + let head = cursor.bind( + &mut ops, + project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_HEAD), + ); + let rest = cursor.bind( + &mut ops, + project(param(0), Case::Sequence(SequenceCase::Cons), q::CONS_TAIL), + ); + let next = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Cons), + fields: vec![head, param(1)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::RebuildSequence, + vec![rest, next, param(2), param(3)], + ), + ) + } + SequenceCase::Append => Exec::Reject { + shape: Shape::ReplayResult, + }, + SequenceCase::Finish => { + let mut ops = Vec::new(); + // The saved finish's extent is inspected but replaced by a + // fresh activation extent, matching the replay contract. + let _saved = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Finish), + q::FINISH_EXTENT, + ), + ); + let rest = cursor.bind( + &mut ops, + project( + param(0), + Case::Sequence(SequenceCase::Finish), + q::FINISH_REST, + ), + ); + let extent = cursor.bind( + &mut ops, + Op::FreshExtent { + parent: Some(param(3)), + }, + ); + let next = cursor.bind( + &mut ops, + Op::Node { + case: Case::Sequence(SequenceCase::Finish), + fields: vec![extent.clone(), param(1), param(2)], + }, + ); + steps( + ops, + tail( + ControlHelperRole::RebuildSequence, + vec![rest, next, extent.clone(), extent], + ), + ) + } + }; + (case.tag(), arm) + }) + .collect(); switch(param(0), Case::Sequence(SequenceCase::Empty), arms) } diff --git a/crates/psrs-backend/src/cc/lower/control/plan/ir.rs b/crates/psrs-backend/src/cc/lower/control/plan/ir.rs index 87f51d13..045c3f22 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/ir.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/ir.rs @@ -5,7 +5,7 @@ use crate::cc::{ControlHelperRole, ReprId}; use crate::control::schema::{ComputationCase, ContextCase, ExtentCase, OwnerCase, SequenceCase}; /// A named executor parameter. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub(crate) enum State { Value, Handler, @@ -27,7 +27,7 @@ pub(crate) fn state_index(state: State) -> usize { } /// A value available to a transition. -#[derive(Clone, Debug)] +#[derive(Clone, Debug, PartialEq, Eq, Hash)] pub(crate) enum Operand { State(State), /// A caller-supplied parameter of a helper body. @@ -51,7 +51,7 @@ pub(crate) enum Family { Owner, } -#[derive(Clone, Copy, Debug, PartialEq, Eq)] +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub(crate) enum Case { Computation(ComputationCase), Sequence(SequenceCase), @@ -61,6 +61,26 @@ pub(crate) enum Case { } impl Case { + pub(crate) fn fields(self) -> &'static [crate::control::schema::FieldKind] { + match self { + Self::Computation(case) => case.fields(), + Self::Sequence(case) => case.fields(), + Self::Context(case) => case.fields(), + Self::Extent(case) => case.fields(), + Self::Owner(case) => case.fields(), + } + } + + pub(crate) fn kind(self) -> crate::control::schema::FieldKind { + use crate::control::schema::FieldKind as K; + match self { + Self::Computation(_) => K::Computation, + Self::Sequence(_) => K::Sequence, + Self::Context(_) => K::Context, + Self::Extent(_) => K::Extent, + Self::Owner(_) => K::Owner, + } + } pub(crate) fn family(self) -> Family { match self { Self::Computation(_) => Family::Computation, @@ -91,16 +111,6 @@ impl Case { } } - pub(crate) fn field_count(self) -> usize { - match self { - Self::Computation(case) => case.field_count(), - Self::Sequence(case) => case.field_count(), - Self::Context(case) => case.field_count(), - Self::Extent(case) => case.field_count(), - Self::Owner(case) => case.field_count(), - } - } - /// The cases a dispatch on this family must cover. pub(crate) fn tags(self) -> Vec { match self { diff --git a/crates/psrs-backend/src/cc/lower/control/plan/mod.rs b/crates/psrs-backend/src/cc/lower/control/plan/mod.rs index a6252a19..31807cd3 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/mod.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/mod.rs @@ -24,12 +24,16 @@ mod ir; #[cfg(test)] mod model; mod returns; +mod run; mod shape; +pub(crate) use crate::control::execution::Program; pub(crate) use boundary::check_boundary; +#[cfg(test)] pub(super) use check::check; -pub(super) use check::verify as verify_plan; -pub(super) use helpers::{ +#[cfg(test)] +pub(super) use check::check_for; +use helpers::{ boundary_check, boundary_close, cancel, clone_sequence, once, raw_resume, rebuild_sequence, start_boundary, }; @@ -39,8 +43,38 @@ pub(crate) use shape::{Shape, shape as shape_of}; use crate::control::schema::ComputationCase; use ir::{Case, Cursor, Exec, State, state, switch}; +/// Only this module can publish a plan as checked. Expansion and boundary +/// validation consume this immutable value rather than an arbitrary program. +pub(crate) struct CheckedPlan { + exec: Exec, +} + +impl CheckedPlan { + pub(in crate::cc::lower::control) fn exec(&self) -> &Exec { + &self.exec + } +} + +pub(super) fn build(program: Program) -> CheckedPlan { + let exec = match program { + Program::Executor => executor(), + Program::Run => run::program(), + Program::CloneSequence => clone_sequence(), + Program::RebuildSequence => rebuild_sequence(), + Program::Check => boundary_check(), + Program::Close => boundary_close(), + Program::Start => start_boundary(), + Program::Once => once(), + Program::Cancel => cancel(), + Program::RawResume => raw_resume(), + }; + check::check_for(program, &exec) + .expect("machine construction plan must satisfy its complete contract"); + CheckedPlan { exec } +} + /// Build the complete flat-driver program. -pub(super) fn executor() -> Exec { +fn executor() -> Exec { let cursor = Cursor::new(); let arms = ComputationCase::ALL .iter() @@ -68,7 +102,7 @@ pub(super) fn executor() -> Exec { mod tests { use super::ir::{Case, Exec, Op, Operand, Shape, State}; use super::*; - use crate::control::schema::{ComputationCase, SequenceCase}; + use crate::control::schema::ComputationCase; #[test] fn executor_plan_is_complete() { @@ -77,17 +111,17 @@ mod tests { #[test] fn helper_plans_are_well_formed() { - for plan in [ - clone_sequence(), - rebuild_sequence(), - boundary_check(), - boundary_close(), - start_boundary(), - once(), - cancel(), - raw_resume(), + for (program, plan) in [ + (Program::CloneSequence, clone_sequence()), + (Program::RebuildSequence, rebuild_sequence()), + (Program::Check, boundary_check()), + (Program::Close, boundary_close()), + (Program::Start, start_boundary()), + (Program::Once, once()), + (Program::Cancel, cancel()), + (Program::RawResume, raw_resume()), ] { - verify_plan(&plan).expect("helper plan must be well-formed"); + check_for(program, &plan).expect("helper plan must be well-formed"); } } @@ -126,21 +160,23 @@ mod tests { ), ], }; - assert!(verify_plan(&plan).is_err()); + assert!(check_for(Program::Executor, &plan).is_err()); } #[test] fn node_field_arity_is_checked() { - let plan = Exec::Steps { - ops: vec![Op::Node { - case: Case::Sequence(SequenceCase::Cons), - fields: vec![Operand::Param(0)], - }], - next: Box::new(Exec::Return { - value: Operand::Param(0), - }), + let mut plan = once(); + let Exec::Steps { ops, .. } = &mut plan else { + unreachable!() + }; + let Op::Node { fields, .. } = ops.last_mut().unwrap() else { + unreachable!() }; - assert!(verify_plan(&plan).is_err()); + fields.pop(); + assert_eq!( + check_for(Program::Once, &plan), + Err("machine plan call or allocation has the wrong arity") + ); } #[test] diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/behavior.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/behavior.rs new file mode 100644 index 00000000..68f909ed --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/behavior.rs @@ -0,0 +1,449 @@ +use super::super::ir::Family; +use super::compare::equivalent; +use super::fixtures::{Fixture, Queue, queues}; +use super::heap::*; +use super::interpret::Interpreter; +use super::reference::Reference; +use crate::control::execution::{ActionId, Program}; + +pub(super) fn assert_matches( + interpreter: &mut Interpreter, + input: &Heap, + program: Program, + args: Vec, +) -> Checked { + let mut expected = input.clone(); + let expected_step = Reference::new(&mut expected).run(program, &args); + interpreter.reset(input.clone()); + let actual_step = interpreter.run(program, args.clone()); + assert!( + equivalent( + &interpreter.heap, + &actual_step, + &expected, + &expected_step, + input.objects.len() + ), + "{program:?} {args:?}: plan={actual_step:?}, reference={expected_step:?}\nplan events={:?}\nreference events={:?}\ninput={:?}", + interpreter.heap.events, + expected.events, + input.objects + ); + actual_step +} + +#[test] +fn every_action_matches_operands_state_identity_and_ordered_behavior() { + let mut f = Fixture::new(); + let mut interpreter = Interpreter::new(f.heap.clone()); + let queues = f.queues(); + assert_matches( + &mut interpreter, + &f.heap, + Program::Run, + vec![f.state, f.handler, f.next], + ) + .unwrap(); + for context in [f.root, f.scoped] { + let computation = f.heap.node(Node::Return(f.answer)); + for queue in &queues { + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, *queue, context), + ) + .unwrap(); + } + let computation = f.heap.node(Node::Perform(f.request)); + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, f.consumer, context), + ) + .unwrap(); + let computation = f.heap.node(Node::Handle(f.ret, f.op, f.next)); + for queue in &queues { + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, *queue, context), + ) + .unwrap(); + } + } + let computation = f.heap.node(Node::Bind(f.next, f.callback)); + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, f.consumer, f.scoped), + ) + .unwrap(); + let saved = f.heap.node(Node::Finish(f.checkpoint, f.saved, f.parent)); + let computation = f.heap.node(Node::Resume(f.answer, saved, f.checkpoint)); + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, f.consumer, f.root), + ) + .unwrap(); + let computation = f.heap.node(Node::OwnedResume(f.owner, f.answer)); + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, f.consumer, f.scoped), + ) + .unwrap(); + + for queue in &queues { + assert_matches( + &mut interpreter, + &f.heap, + Program::CloneSequence, + vec![*queue, f.empty, f.empty, f.active, f.parent], + ) + .unwrap(); + } + let todo = f.heap.node(Node::Append(f.saved, f.empty)); + assert_matches( + &mut interpreter, + &f.heap, + Program::CloneSequence, + vec![f.empty, todo, f.saved, f.active, f.parent], + ) + .unwrap(); + for invalid in [f.saved, saved] { + assert_eq!( + assert_matches( + &mut interpreter, + &f.heap, + Program::CloneSequence, + vec![f.empty, invalid, f.empty, f.active, f.parent] + ), + Err(Fault::Trap) + ); + } + for reversed in [f.empty, f.saved, saved] { + assert_matches( + &mut interpreter, + &f.heap, + Program::RebuildSequence, + vec![reversed, f.consumer, f.active, f.parent], + ) + .unwrap(); + } + let append = f.heap.node(Node::Append(f.saved, f.consumer)); + assert_eq!( + assert_matches( + &mut interpreter, + &f.heap, + Program::RebuildSequence, + vec![append, f.consumer, f.active, f.parent] + ), + Err(Fault::Trap) + ); + let child = f.heap.extent(Some(f.checkpoint)); + for program in [Program::Check, Program::Close] { + for extent in [f.checkpoint, child] { + assert_matches(&mut interpreter, &f.heap, program, vec![extent]).unwrap(); + } + } + for (program, args) in [ + (Program::Start, vec![]), + (Program::Once, vec![f.raw]), + (Program::Cancel, vec![f.owner]), + (Program::RawResume, vec![f.raw, f.answer]), + ] { + assert_matches(&mut interpreter, &f.heap, program, args).unwrap(); + } + assert_eq!(interpreter.actions.len(), ActionId::ALL.len()); + for action in ActionId::ALL { + assert!( + interpreter.actions.contains(&action), + "missing executed action {action:?}" + ); + } +} + +#[test] +fn failed_pending_and_callback_traps_preserve_the_executed_prefix() { + let mut interpreter = Interpreter::new(Heap::default()); + for status in 0..=3 { + for callback_traps in [false, true] { + let mut f = Fixture::new(); + f.owner_status(status); + if callback_traps { + f.heap.objects[f.callback] = Object::Function { + label: "queue-callback", + result: Err(Fault::CallbackTrap), + }; + } + let computation = f.heap.node(Node::OwnedResume(f.owner, f.answer)); + let result = assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, f.consumer, f.scoped), + ); + if status != 0 { + assert_eq!(result, Err(Fault::Trap)); + assert_eq!(interpreter.heap.events.len(), 1); + } else if callback_traps { + assert_eq!(result, Err(Fault::CallbackTrap)); + let Node::Owner { callback, status } = interpreter.heap.get_node(f.owner).unwrap() + else { + unreachable!() + }; + assert_eq!(interpreter.heap.objects[status], Object::Status(1)); + assert_eq!( + interpreter.heap.objects[callback], + Object::CallbackCell(status) + ); + } else { + result.unwrap(); + } + let cancelled = + assert_matches(&mut interpreter, &f.heap, Program::Cancel, vec![f.owner]); + if status != 0 { + assert_eq!(cancelled, Err(Fault::Trap)); + assert_eq!(interpreter.heap.events.len(), 1); + } else { + cancelled.unwrap(); + } + } + } +} + +#[test] +fn callback_failures_cannot_complete_their_target_transition() { + let mut interpreter = Interpreter::new(Heap::default()); + for callback in 0..4 { + let mut f = Fixture::new(); + let callee = [f.handler, f.ret, f.op, f.callback][callback]; + let Object::Function { result, .. } = &mut f.heap.objects[callee] else { + unreachable!() + }; + *result = Err(Fault::CallbackTrap); + let (computation, queue, context) = match callback { + 0 => (f.heap.node(Node::Perform(f.request)), f.consumer, f.root), + 1 => (f.heap.node(Node::Return(f.answer)), f.empty, f.scoped), + 2 => (f.heap.node(Node::Perform(f.request)), f.consumer, f.scoped), + _ => ( + f.heap.node(Node::Return(f.answer)), + f.heap.node(Node::Cons(f.callback, f.empty)), + f.root, + ), + }; + assert_eq!( + assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, queue, context) + ), + Err(Fault::CallbackTrap) + ); + assert_eq!(interpreter.heap.events.len(), 1); + } +} + +#[test] +fn expiry_checks_every_ancestor_and_raw_invocation_remains_inert() { + let mut interpreter = Interpreter::new(Heap::default()); + for closed in 0..3 { + let mut f = Fixture::new(); + let parent = f.heap.extent(Some(f.parent)); + let child = f.heap.extent(Some(parent)); + f.expire([child, parent, f.parent][closed]); + assert_eq!( + assert_matches(&mut interpreter, &f.heap, Program::Check, vec![child]), + Err(Fault::Trap) + ); + assert_eq!(interpreter.heap.events.len(), closed + 1); + let raw = f.heap.alloc(Object::Raw { + queue: f.saved, + checkpoint: child, + }); + assert_eq!( + assert_matches( + &mut interpreter, + &f.heap, + Program::RawResume, + vec![raw, f.answer] + ), + Err(Fault::Trap) + ); + } + let mut f = Fixture::new(); + let raw_queue = f.heap.node(Node::Cons(f.raw, f.consumer)); + let computation = f.heap.node(Node::Return(f.answer)); + let result = assert_matches( + &mut interpreter, + &f.heap, + Program::Executor, + f.args(computation, raw_queue, f.scoped), + ) + .unwrap(); + let Step::Advance(state) = result else { + panic!("raw queue callback must construct the next computation"); + }; + assert_eq!( + interpreter.heap.get_node(state[2]).unwrap(), + Node::Resume(f.answer, f.saved, f.checkpoint) + ); + assert_eq!(state[3], f.consumer); + assert_eq!(state[5], f.scoped); +} + +#[test] +fn unknown_machine_tags_reject_without_unaccounted_work() { + let mut interpreter = Interpreter::new(Heap::default()); + for family in [ + Family::Computation, + Family::Sequence, + Family::Context, + Family::Extent, + ] { + let mut f = Fixture::new(); + let unknown = f.heap.alloc(Object::Unknown(family, 99)); + let computation = f.heap.node(Node::Return(f.answer)); + let (program, args) = match family { + Family::Computation => (Program::Executor, f.args(unknown, f.empty, f.root)), + Family::Sequence => (Program::Executor, f.args(computation, unknown, f.root)), + Family::Context => (Program::Executor, f.args(computation, f.empty, unknown)), + Family::Extent => (Program::Check, vec![unknown]), + Family::Owner => unreachable!(), + }; + assert_eq!( + assert_matches(&mut interpreter, &f.heap, program, args), + Err(Fault::Trap) + ); + assert!(interpreter.heap.events.is_empty()); + } +} + +fn flatten_input(queue: &Queue, f: &Fixture, callbacks: &mut Vec, finishes: &mut usize) { + match queue { + Queue::Empty => {} + Queue::Cons(alternative, rest) => { + callbacks.push(if *alternative { f.op } else { f.callback }); + flatten_input(rest, f, callbacks, finishes); + } + Queue::Finish(rest) => { + *finishes += 1; + flatten_input(rest, f, callbacks, finishes); + } + Queue::Append(left, right) => { + flatten_input(left, f, callbacks, finishes); + flatten_input(right, f, callbacks, finishes); + } + } +} + +fn replay_contents(heap: &Heap, result: &Step) -> (Vec, Vec, Value) { + let Step::Return(value) = result else { + panic!("replay must return a product"); + }; + let Object::Replay(mut queue, active) = *heap.get(*value).unwrap() else { + panic!("replay result"); + }; + let mut callbacks = Vec::new(); + let mut finishes = Vec::new(); + loop { + match heap.get_node(queue).unwrap() { + Node::Empty => break, + Node::Cons(callback, rest) => { + callbacks.push(callback); + queue = rest; + } + Node::Finish(extent, rest, _) => { + finishes.push(extent); + queue = rest; + } + other => panic!("replay must be linear, got {other:?}"), + } + } + (callbacks, finishes, active) +} + +#[test] +fn bounded_replay_preserves_order_sharing_freshness_and_three_extent_roles() { + let expressions = queues(3); + assert_eq!(expressions.len(), 1805); + let mut interpreter = Interpreter::new(Heap::default()); + for expression in expressions { + let mut f = Fixture::new(); + let queue = f.queue(&expression); + let args = vec![queue, f.empty, f.empty, f.active, f.parent]; + let first = assert_matches( + &mut interpreter, + &f.heap, + Program::CloneSequence, + args.clone(), + ) + .unwrap(); + let (callbacks, finishes, active) = replay_contents(&interpreter.heap, &first); + let mut expected_callbacks = Vec::new(); + let mut count = 0; + flatten_input(&expression, &f, &mut expected_callbacks, &mut count); + assert_eq!(callbacks, expected_callbacks, "{expression:?}"); + assert_eq!(finishes.len(), count); + let (cons_count, finish_count, append_count) = expression.counts(); + let queue_allocations = interpreter.heap.objects[f.heap.objects.len()..].iter().filter(|object| matches!(object,Object::Node(node) if node.case().family() == Family::Sequence)).count(); + assert_eq!( + queue_allocations, + 2 * (cons_count + finish_count) + append_count + ); + assert_eq!(active, finishes.first().copied().unwrap_or(f.active)); + let unique = finishes + .iter() + .copied() + .collect::>(); + assert_eq!(unique.len(), count); + for (index, extent) in finishes.iter().enumerate() { + assert!(*extent >= f.heap.objects.len()); + let Node::ScopedExtent { status, parent } = interpreter.heap.get_node(*extent).unwrap() + else { + panic!("activation must be a fresh child"); + }; + assert_eq!(interpreter.heap.objects[status], Object::Status(0)); + assert_eq!(parent, finishes.get(index + 1).copied().unwrap_or(f.parent)); + } + assert_eq!( + &interpreter.heap.objects[..f.heap.objects.len()], + f.heap.objects.as_slice() + ); + let before_second = interpreter.heap.clone(); + let second = assert_matches( + &mut interpreter, + &before_second, + Program::CloneSequence, + args, + ) + .unwrap(); + let (_, second_finishes, _) = replay_contents(&interpreter.heap, &second); + assert!( + second_finishes + .iter() + .all(|extent| !unique.contains(extent)) + ); + let mut expired = f.clone(); + expired.expire(f.checkpoint); + let result = assert_matches( + &mut interpreter, + &expired.heap, + Program::CloneSequence, + vec![queue, f.empty, f.empty, f.active, f.parent], + ); + if count == 0 { + result.unwrap(); + } else { + assert_eq!(result, Err(Fault::Trap)); + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/compare.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/compare.rs new file mode 100644 index 00000000..807034e7 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/compare.rs @@ -0,0 +1,210 @@ +//! Compare observable transitions modulo fresh allocation IDs, preserving +//! input identity and aliasing. Replay traversal temporaries are budgeted by +//! the flat reference model; other allocations must agree exactly by role. +use super::heap::*; +use std::collections::{HashMap, HashSet}; + +fn queue_allocations(heap: &Heap, original: usize) -> usize { + heap.objects[original..].iter().filter(|object| matches!(object,Object::Node(node) if node.case().family() == super::super::ir::Family::Sequence)).count() +} + +fn allocations( + heap: &Heap, + original: usize, +) -> HashMap< + ( + std::mem::Discriminant, + Option, + ), + usize, +> { + let mut counts = HashMap::new(); + for object in &heap.objects[original..] { + let case = match object { + Object::Node(node) if node.case().family() == super::super::ir::Family::Sequence => { + continue; + } + Object::Node(node) => Some(node.case()), + _ => None, + }; + *counts + .entry((std::mem::discriminant(object), case)) + .or_default() += 1; + } + counts +} + +pub(super) fn equivalent( + a: &Heap, + result_a: &Checked, + b: &Heap, + result_b: &Checked, + original: usize, +) -> bool { + let mut compare = Compare { + a, + b, + original, + forward: HashMap::new(), + backward: HashMap::new(), + visited: HashSet::new(), + }; + let result = match (result_a, result_b) { + (Ok(Step::Return(a)), Ok(Step::Return(b))) + | (Ok(Step::Publish(a)), Ok(Step::Publish(b))) => compare.value(*a, *b), + (Ok(Step::Advance(a)), Ok(Step::Advance(b))) => compare.values(a, b), + (Err(a), Err(b)) => a == b && matches!(a, Fault::Trap | Fault::CallbackTrap), + _ => false, + }; + result + && allocations(a, original) == allocations(b, original) + && b.queue_work + .checked_sub(a.queue_work) + .and_then(|work| queue_allocations(b, original).checked_add(work)) + == Some(queue_allocations(a, original)) + && a.events.len() == b.events.len() + && a.events + .iter() + .zip(&b.events) + .all(|(a, b)| compare.event(a, b)) + && (0..original).all(|value| compare.value(value, value)) +} + +struct Compare<'a> { + a: &'a Heap, + b: &'a Heap, + original: usize, + forward: HashMap, + backward: HashMap, + visited: HashSet<(Value, Value)>, +} + +impl Compare<'_> { + fn values(&mut self, a: &[Value], b: &[Value]) -> bool { + a.len() == b.len() && a.iter().zip(b).all(|(a, b)| self.value(*a, *b)) + } + fn value(&mut self, a: Value, b: Value) -> bool { + if a < self.original || b < self.original { + if a != b { + return false; + } + } else { + if self.forward.get(&a).is_some_and(|other| *other != b) + || self.backward.get(&b).is_some_and(|other| *other != a) + { + return false; + } + self.forward.insert(a, b); + self.backward.insert(b, a); + } + if !self.visited.insert((a, b)) { + return true; + } + let (Some(a), Some(b)) = (self.a.objects.get(a), self.b.objects.get(b)) else { + return false; + }; + match (a, b) { + (Object::Node(a), Object::Node(b)) => { + a.case() == b.case() && self.values(&a.fields(), &b.fields()) + } + (Object::Atom(a), Object::Atom(b)) => a == b, + (Object::Status(a), Object::Status(b)) => a == b, + (Object::CallbackCell(a), Object::CallbackCell(b)) => self.value(*a, *b), + ( + Object::Function { + label: a, + result: ar, + }, + Object::Function { + label: b, + result: br, + }, + ) => { + a == b + && match (ar, br) { + (Ok(a), Ok(b)) => self.value(*a, *b), + (Err(a), Err(b)) => a == b, + _ => false, + } + } + ( + Object::Raw { + queue: a, + checkpoint: ae, + }, + Object::Raw { + queue: b, + checkpoint: be, + }, + ) => self.value(*a, *b) && self.value(*ae, *be), + (Object::Pair(a, aa), Object::Pair(b, ba)) + | (Object::Replay(a, aa), Object::Replay(b, ba)) => { + self.value(*a, *b) && self.value(*aa, *ba) + } + (Object::Unknown(a, at), Object::Unknown(b, bt)) => a == b && at == bt, + _ => false, + } + } + fn event(&mut self, a: &Event, b: &Event) -> bool { + match (a, b) { + (Event::ReadStatus(a, av), Event::ReadStatus(b, bv)) + | (Event::WriteStatus(a, av), Event::WriteStatus(b, bv)) => { + av == bv && self.value(*a, *b) + } + (Event::ReadCallback(a, av), Event::ReadCallback(b, bv)) + | (Event::WriteCallback(a, av), Event::WriteCallback(b, bv)) => { + self.value(*a, *b) && self.value(*av, *bv) + } + (Event::Apply(a, args_a), Event::Apply(b, args_b)) => { + self.value(*a, *b) && self.values(args_a, args_b) + } + _ => false, + } + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn fresh_id_normalization_preserves_aliasing_and_ignores_unreachable_work_nodes() { + let mut a = Heap::default(); + let mut b = Heap::default(); + a.alloc(Object::Atom("input")); + b.alloc(Object::Atom("input")); + a.node(Node::Empty); // An unreachable traversal temporary. + b.queue_work = 1; + let ae = a.extent(None); + let be = b.extent(None); + a.extent(None); + let other = b.extent(None); + let ar = Ok(Step::Return(a.alloc(Object::Pair(ae, ae)))); + let br = Ok(Step::Return(b.alloc(Object::Pair(be, be)))); + assert!(equivalent(&a, &ar, &b, &br, 1)); + let Ok(Step::Return(pair)) = br else { + unreachable!() + }; + b.objects[pair] = Object::Pair(be, other); + assert!(!equivalent(&a, &ar, &b, &br, 1)); + } + + #[test] + fn equal_shapes_cannot_hide_input_replacement_or_an_incomplete_evaluation() { + let mut a = Heap::default(); + let extent = a.extent(None); + let original = a.objects.len(); + let mut b = a.clone(); + let copy = b.node(b.get_node(extent).unwrap()); + assert!(!equivalent( + &a, + &Ok(Step::Return(extent)), + &b, + &Ok(Step::Return(copy)), + original + )); + for fault in [Fault::InvalidModel, Fault::Exhausted] { + assert!(!equivalent(&a, &Err(fault), &a, &Err(fault), original)); + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/continuations.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/continuations.rs new file mode 100644 index 00000000..373d4a0b --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/continuations.rs @@ -0,0 +1,173 @@ +//! Composition after individual transitions: actual shared queue occurrences, +//! bounded execution to completion, and ownership retained across replay. +use super::{ + behavior::assert_matches, + fixtures::{Fixture, queues}, + heap::*, + interpret::Interpreter, +}; +use crate::control::execution::Program; + +fn drive(interpreter: &mut Interpreter, mut args: Vec) -> Checked { + for _ in 0..256 { + let input = interpreter.heap.clone(); + match assert_matches(interpreter, &input, Program::Executor, args)? { + Step::Advance(next) => args = next, + other => return Ok(other), + } + } + panic!("bounded computation did not finish within 256 transitions"); +} + +#[test] +fn bounded_executor_resume_preserves_saved_checkpoint_and_current_dispatch() { + let mut interpreter = Interpreter::new(Heap::default()); + for queue in queues(2) { + for scoped in [false, true] { + let mut f = Fixture::new(); + let saved = f.queue(&queue); + let source_checkpoint = f.heap.extent(None); + let computation = f + .heap + .node(Node::Resume(f.answer, saved, source_checkpoint)); + let context = if scoped { f.scoped } else { f.root }; + let args = f.args(computation, f.consumer, context); + assert_matches(&mut interpreter, &f.heap, Program::Executor, args.clone()).unwrap(); + f.expire(source_checkpoint); + assert_eq!( + assert_matches(&mut interpreter, &f.heap, Program::Executor, args), + Err(Fault::Trap) + ); + assert_eq!(interpreter.heap.events.len(), 1); + } + } +} + +#[test] +fn left_and_right_bind_association_complete_with_the_same_ordered_callbacks() { + for depth in 0..16 { + for right in [false, true] { + let mut f = Fixture::new(); + let mut computation = f.heap.node(Node::Return(f.answer)); + for _ in 0..depth { + computation = if right { + let callback = f.heap.alloc(Object::Function { + label: "right-bind", + result: Ok(computation), + }); + let answer = f.heap.node(Node::Return(f.answer)); + f.heap.node(Node::Bind(answer, callback)) + } else { + f.heap.node(Node::Bind(computation, f.callback)) + }; + } + let mut interpreter = Interpreter::new(f.heap.clone()); + let result = drive(&mut interpreter, f.args(computation, f.empty, f.root)).unwrap(); + assert!(matches!(result, Step::Publish(_))); + assert_eq!( + interpreter + .heap + .events + .iter() + .filter(|event| matches!(event, Event::Apply(..))) + .count(), + depth + ); + } + } +} + +#[test] +fn shared_subqueues_replay_each_occurrence_without_cloning_owned_callbacks() { + let mut f = Fixture::new(); + let owned_computation = f.heap.node(Node::OwnedResume(f.owner, f.answer)); + let callback = f.heap.alloc(Object::Function { + label: "owned-callback", + result: Ok(owned_computation), + }); + let finish = f.heap.node(Node::Finish(f.checkpoint, f.empty, f.parent)); + let shared = f.heap.node(Node::Cons(callback, finish)); + let captured = f.heap.node(Node::Append(shared, shared)); + let args = vec![captured, f.empty, f.empty, f.active, f.parent]; + let mut interpreter = Interpreter::new(f.heap.clone()); + let Step::Return(replay) = + assert_matches(&mut interpreter, &f.heap, Program::CloneSequence, args).unwrap() + else { + unreachable!() + }; + let Object::Replay(queue, active) = *interpreter.heap.get(replay).unwrap() else { + unreachable!() + }; + assert_eq!( + &interpreter.heap.objects[..f.heap.objects.len()], + f.heap.objects.as_slice() + ); + let computation = interpreter.heap.node(Node::Return(f.answer)); + let state = vec![f.state, f.handler, computation, queue, active, f.root]; + assert_eq!(drive(&mut interpreter, state), Err(Fault::Trap)); + let calls = interpreter + .heap + .events + .iter() + .filter(|event| matches!(event,Event::Apply(callee,_) if *callee == callback)) + .count(); + assert_eq!( + calls, 2, + "both shared occurrences must remain in the replay" + ); + let Node::Owner { + callback: slot, + status, + } = interpreter.heap.get_node(f.owner).unwrap() + else { + unreachable!() + }; + assert_eq!(interpreter.heap.objects[status], Object::Status(2)); + assert_eq!(interpreter.heap.objects[slot], Object::CallbackCell(status)); + assert_eq!( + interpreter + .heap + .events + .iter() + .filter(|event| matches!(event,Event::Apply(callee,_) if *callee == f.callback)) + .count(), + 1 + ); +} + +#[test] +fn scoped_target_completion_closes_its_extent_and_restores_caller_work() { + let mut f = Fixture::new(); + let source = f.heap.node(Node::Perform(f.request)); + let body = f.heap.node(Node::Bind(source, f.callback)); + let computation = f.heap.node(Node::Handle(f.ret, f.op, body)); + let caller_queue = f.heap.node(Node::Cons(f.ret, f.empty)); + let mut interpreter = Interpreter::new(f.heap.clone()); + let result = drive(&mut interpreter, f.args(computation, caller_queue, f.root)).unwrap(); + assert!(matches!(result, Step::Publish(_))); + assert!( + !interpreter + .heap + .events + .iter() + .any(|event| matches!(event,Event::Apply(callee,_) if *callee == f.callback)), + "abandoned source work must not run" + ); + assert!( + interpreter + .heap + .events + .iter() + .any(|event| matches!(event,Event::Apply(callee,_) if *callee == f.ret)), + "caller work must run after target completion" + ); + assert_eq!( + interpreter + .heap + .events + .iter() + .filter(|event| matches!(event, Event::WriteStatus(_, 1))) + .count(), + 1 + ); +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/failure_prefixes.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/failure_prefixes.rs new file mode 100644 index 00000000..b9170545 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/failure_prefixes.rs @@ -0,0 +1,74 @@ +//! Exceptional paths retain the work before failure without treating any +//! failed execution as successful normal completion. +use super::super::ir::Family; +use super::{behavior::assert_matches, fixtures::Fixture, heap::*, interpret::Interpreter}; +use crate::control::execution::Program; + +#[test] +fn replay_checks_later_distinct_finish_extents_before_rebuilding_any_activation() { + let mut interpreter = Interpreter::new(Heap::default()); + for expired_parent in [false, true] { + let mut f = Fixture::new(); + let stale = f.heap.extent(None); + let child = f.heap.extent(Some(stale)); + f.expire(if expired_parent { stale } else { child }); + let good = f.heap.node(Node::Finish(f.checkpoint, f.saved, f.parent)); + let bad = f.heap.node(Node::Finish(child, f.empty, f.parent)); + let captured = f.heap.node(Node::Append(good, bad)); + assert_eq!( + assert_matches( + &mut interpreter, + &f.heap, + Program::CloneSequence, + vec![captured, f.empty, f.empty, f.active, f.parent] + ), + Err(Fault::Trap) + ); + assert_eq!( + interpreter.heap.events.len(), + if expired_parent { 3 } else { 2 } + ); + assert!(interpreter.heap.objects[f.heap.objects.len()..].iter().all(|object| matches!(object,Object::Node(node) if node.case().family() == Family::Sequence)),"failed clone must not publish fresh activations or a result product"); + assert_eq!( + &interpreter.heap.objects[..f.heap.objects.len()], + f.heap.objects.as_slice() + ); + } +} + +#[test] +fn rejected_reverse_tails_keep_the_normal_rebuild_prefix() { + let mut interpreter = Interpreter::new(Heap::default()); + for unknown in [false, true] { + let mut f = Fixture::new(); + let bad = if unknown { + f.heap.alloc(Object::Unknown(Family::Sequence, 99)) + } else { + f.heap.node(Node::Append(f.saved, f.consumer)) + }; + let reversed = f.heap.node(Node::Finish(f.checkpoint, bad, f.parent)); + for program in [Program::RebuildSequence, Program::CloneSequence] { + let args = if program == Program::RebuildSequence { + vec![reversed, f.empty, f.active, f.parent] + } else { + vec![f.saved, f.empty, reversed, f.active, f.parent] + }; + assert_eq!( + assert_matches(&mut interpreter, &f.heap, program, args), + Err(Fault::Trap) + ); + let new = &interpreter.heap.objects[f.heap.objects.len()..]; + assert_eq!( + new.iter() + .filter(|object| matches!(object, Object::Node(Node::ScopedExtent { .. }))) + .count(), + 1 + ); + assert!( + !new.iter() + .any(|object| matches!(object, Object::Replay(..))), + "a rejected prefix cannot publish a replay result" + ); + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/fixtures.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/fixtures.rs new file mode 100644 index 00000000..aafbe414 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/fixtures.rs @@ -0,0 +1,215 @@ +//! Distinct values for every semantic role; execution, dispatch checkpoint and +//! restoration parent deliberately differ. Cases are generated from inputs, +//! not from the plan or its action-path registry. +use super::heap::*; + +#[derive(Clone)] +pub(super) struct Fixture { + pub heap: Heap, + pub state: Value, + pub handler: Value, + pub answer: Value, + pub request: Value, + pub next: Value, + pub ret: Value, + pub op: Value, + pub callback: Value, + pub empty: Value, + pub consumer: Value, + pub saved: Value, + pub active: Value, + pub checkpoint: Value, + pub parent: Value, + pub root: Value, + pub scoped: Value, + pub owner: Value, + pub raw: Value, +} + +impl Fixture { + pub(super) fn new() -> Self { + let mut heap = Heap::default(); + let state = heap.alloc(Object::Atom("state")); + let next_state = heap.alloc(Object::Atom("next-state")); + let answer = heap.alloc(Object::Atom("answer")); + let request = heap.alloc(Object::Atom("request")); + let payload = heap.alloc(Object::Atom("callback-answer")); + let next = heap.node(Node::Return(payload)); + let pair = heap.alloc(Object::Pair(next_state, next)); + let handler = heap.alloc(Object::Function { + label: "root-handler", + result: Ok(pair), + }); + let ret = heap.alloc(Object::Function { + label: "return-clause", + result: Ok(next), + }); + let op = heap.alloc(Object::Function { + label: "operation-clause", + result: Ok(next), + }); + let callback = heap.alloc(Object::Function { + label: "queue-callback", + result: Ok(next), + }); + let empty = heap.node(Node::Empty); + let active = heap.extent(None); + let checkpoint = heap.extent(None); + let parent = heap.extent(None); + let root = heap.node(Node::RootContext(checkpoint)); + let consumer = heap.node(Node::Cons(op, empty)); + let saved = heap.node(Node::Cons(ret, empty)); + let scoped = heap.node(Node::ScopedContext { + ret, + op, + saved, + parent, + caller: root, + extent: checkpoint, + }); + let callback_slot = heap.alloc(Object::CallbackCell(callback)); + let status = heap.alloc(Object::Status(0)); + let owner = heap.node(Node::Owner { + callback: callback_slot, + status, + }); + let raw = heap.alloc(Object::Raw { + queue: saved, + checkpoint, + }); + Self { + heap, + state, + handler, + answer, + request, + next, + ret, + op, + callback, + empty, + consumer, + saved, + active, + checkpoint, + parent, + root, + scoped, + owner, + raw, + } + } + pub(super) fn args(&self, computation: Value, queue: Value, context: Value) -> Vec { + vec![ + self.state, + self.handler, + computation, + queue, + self.active, + context, + ] + } + pub(super) fn owner_status(&mut self, n: i32) { + let Node::Owner { status, .. } = self.heap.get_node(self.owner).unwrap() else { + unreachable!() + }; + self.heap.objects[status] = Object::Status(n); + } + pub(super) fn expire(&mut self, extent: Value) { + let status = match self.heap.get_node(extent).unwrap() { + Node::RootExtent(status) | Node::ScopedExtent { status, .. } => status, + _ => unreachable!(), + }; + self.heap.objects[status] = Object::Status(1); + } + pub(super) fn queues(&mut self) -> Vec { + let cons = self.heap.node(Node::Cons(self.callback, self.saved)); + let finish = self + .heap + .node(Node::Finish(self.checkpoint, self.saved, self.parent)); + let nested = self.heap.node(Node::Append(self.saved, self.consumer)); + let mut queues = vec![self.empty, cons, finish]; + for left in [self.empty, cons, nested, finish] { + queues.push(self.heap.node(Node::Append(left, self.consumer))); + } + queues + } +} + +/// Queue expressions through depth three, with two shared callback identities +/// and repeated Finish extent occurrences. Both Append subtrees are generated. +#[derive(Clone, Debug)] +pub(super) enum Queue { + Empty, + Cons(bool, Box), + Finish(Box), + Append(Box, Box), +} + +pub(super) fn queues(depth: usize) -> Vec { + if depth == 0 { + return vec![Queue::Empty]; + } + let previous = queues(depth - 1); + let mut result = vec![Queue::Empty]; + for rest in &previous { + result.push(Queue::Cons(false, Box::new(rest.clone()))); + result.push(Queue::Cons(true, Box::new(rest.clone()))); + result.push(Queue::Finish(Box::new(rest.clone()))); + } + for left in &previous { + for right in &previous { + result.push(Queue::Append( + Box::new(left.clone()), + Box::new(right.clone()), + )); + } + } + result +} + +impl Queue { + pub(super) fn counts(&self) -> (usize, usize, usize) { + match self { + Self::Empty => (0, 0, 0), + Self::Cons(_, rest) => { + let (c, f, a) = rest.counts(); + (c + 1, f, a) + } + Self::Finish(rest) => { + let (c, f, a) = rest.counts(); + (c, f + 1, a) + } + Self::Append(left, right) => { + let (c, f, a) = left.counts(); + let (c2, f2, a2) = right.counts(); + (c + c2, f + f2, a + a2 + 1) + } + } + } +} + +impl Fixture { + pub(super) fn queue(&mut self, queue: &Queue) -> Value { + match queue { + Queue::Empty => self.empty, + Queue::Cons(alternative, rest) => { + let rest = self.queue(rest); + self.heap.node(Node::Cons( + if *alternative { self.op } else { self.callback }, + rest, + )) + } + Queue::Finish(rest) => { + let rest = self.queue(rest); + self.heap + .node(Node::Finish(self.checkpoint, rest, self.parent)) + } + Queue::Append(left, right) => { + let left = self.queue(left); + let right = self.queue(right); + self.heap.node(Node::Append(left, right)) + } + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/heap.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/heap.rs new file mode 100644 index 00000000..688370c7 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/heap.rs @@ -0,0 +1,205 @@ +//! Typed test values. The reference semantics matches these variants directly; +//! only the plan interpreter uses the independent positional adapter below. +use super::super::ir::{Case, Family}; +use crate::control::schema::{ + ComputationCase as C, ContextCase as X, ExtentCase as E, OwnerCase as O, SequenceCase as Q, +}; + +pub(super) type Value = usize; +pub(super) type Checked = Result; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(super) enum Fault { + Trap, + CallbackTrap, + InvalidModel, + Exhausted, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(super) enum Node { + Return(Value), + Perform(Value), + Bind(Value, Value), + Resume(Value, Value, Value), + Handle(Value, Value, Value), + OwnedResume(Value, Value), + Empty, + Cons(Value, Value), + Append(Value, Value), + Finish(Value, Value, Value), + RootContext(Value), + ScopedContext { + ret: Value, + op: Value, + saved: Value, + parent: Value, + caller: Value, + extent: Value, + }, + RootExtent(Value), + ScopedExtent { + status: Value, + parent: Value, + }, + Owner { + callback: Value, + status: Value, + }, +} + +impl Node { + pub(super) fn case(&self) -> Case { + match self { + Self::Return(_) => Case::Computation(C::Return), + Self::Perform(_) => Case::Computation(C::Perform), + Self::Bind(..) => Case::Computation(C::Bind), + Self::Resume(..) => Case::Computation(C::Resume), + Self::Handle(..) => Case::Computation(C::Handle), + Self::OwnedResume(..) => Case::Computation(C::OwnedResume), + Self::Empty => Case::Sequence(Q::Empty), + Self::Cons(..) => Case::Sequence(Q::Cons), + Self::Append(..) => Case::Sequence(Q::Append), + Self::Finish(..) => Case::Sequence(Q::Finish), + Self::RootContext(_) => Case::Context(X::Root), + Self::ScopedContext { .. } => Case::Context(X::Scoped), + Self::RootExtent(_) => Case::Extent(E::Root), + Self::ScopedExtent { .. } => Case::Extent(E::Scoped), + Self::Owner { .. } => Case::Owner(O::OneShot), + } + } + + pub(super) fn fields(&self) -> Vec { + match *self { + Self::Return(v) | Self::Perform(v) | Self::RootContext(v) | Self::RootExtent(v) => { + vec![v] + } + Self::Bind(a, b) | Self::OwnedResume(a, b) | Self::Cons(a, b) | Self::Append(a, b) => { + vec![a, b] + } + Self::Resume(a, b, c) | Self::Handle(a, b, c) | Self::Finish(a, b, c) => vec![a, b, c], + Self::Empty => vec![], + Self::ScopedContext { + ret, + op, + saved, + parent, + caller, + extent, + } => vec![ret, op, saved, parent, caller, extent], + Self::ScopedExtent { status, parent } => vec![status, parent], + Self::Owner { callback, status } => vec![callback, status], + } + } +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(super) enum Object { + Node(Node), + Atom(&'static str), + Status(i32), + CallbackCell(Value), + Function { + label: &'static str, + result: Checked, + }, + Raw { + queue: Value, + checkpoint: Value, + }, + Pair(Value, Value), + Replay(Value, Value), + Unknown(Family, u32), +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(super) enum Event { + ReadStatus(Value, i32), + WriteStatus(Value, i32), + ReadCallback(Value, Value), + WriteCallback(Value, Value), + Apply(Value, Vec), +} + +#[derive(Clone, Debug, PartialEq, Eq)] +pub(super) enum Step { + Return(Value), + Publish(Value), + Advance(Vec), +} + +#[derive(Clone, Debug, Default)] +pub(super) struct Heap { + pub objects: Vec, + pub events: Vec, + /// The flat reference replay budgets the traversal nodes it does not build. + /// The plan interpreter allocates those nodes instead of using this counter. + pub queue_work: usize, +} + +impl Heap { + pub(super) fn alloc(&mut self, object: Object) -> Value { + let id = self.objects.len(); + self.objects.push(object); + id + } + pub(super) fn node(&mut self, node: Node) -> Value { + self.alloc(Object::Node(node)) + } + pub(super) fn get(&self, value: Value) -> Checked<&Object> { + self.objects.get(value).ok_or(Fault::InvalidModel) + } + pub(super) fn get_node(&self, value: Value) -> Checked { + match self.get(value)? { + Object::Node(node) => Ok(node.clone()), + Object::Unknown(..) => Err(Fault::Trap), + _ => Err(Fault::InvalidModel), + } + } + pub(super) fn extent(&mut self, parent: Option) -> Value { + let status = self.alloc(Object::Status(0)); + self.node(match parent { + Some(parent) => Node::ScopedExtent { status, parent }, + None => Node::RootExtent(status), + }) + } + pub(super) fn status(&mut self, cell: Value) -> Checked { + let Object::Status(value) = self.get(cell)? else { + return Err(Fault::InvalidModel); + }; + let value = *value; + self.events.push(Event::ReadStatus(cell, value)); + Ok(value) + } + pub(super) fn set_status(&mut self, cell: Value, value: i32) -> Checked<()> { + let Some(Object::Status(status)) = self.objects.get_mut(cell) else { + return Err(Fault::InvalidModel); + }; + *status = value; + self.events.push(Event::WriteStatus(cell, value)); + Ok(()) + } + pub(super) fn callback(&mut self, cell: Value) -> Checked { + let Object::CallbackCell(value) = self.get(cell)? else { + return Err(Fault::InvalidModel); + }; + let value = *value; + self.events.push(Event::ReadCallback(cell, value)); + Ok(value) + } + pub(super) fn set_callback(&mut self, cell: Value, value: Value) -> Checked<()> { + let Some(Object::CallbackCell(slot)) = self.objects.get_mut(cell) else { + return Err(Fault::InvalidModel); + }; + *slot = value; + self.events.push(Event::WriteCallback(cell, value)); + Ok(()) + } + pub(super) fn invoke(&mut self, function: Value, args: Vec) -> Checked { + self.events.push(Event::Apply(function, args)); + match self.get(function)? { + Object::Function { result, .. } => *result, + _ => Err(Fault::InvalidModel), + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/interpret.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/interpret.rs new file mode 100644 index 00000000..1d9fd516 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/interpret.rs @@ -0,0 +1,221 @@ +//! Execute the actual plan with concrete references, state cells and callbacks. +use super::super::ir::{Case, Exec, Operand, State}; +use super::heap::*; +use crate::control::execution::{ActionId, Program, Selection}; +use crate::control::schema::ControlHelperRole as R; +use std::collections::{HashMap, HashSet}; +use std::rc::Rc; + +pub(super) enum Flow { + Exit(Step), + Tail(Program, Vec), +} + +pub(super) struct Interpreter { + pub heap: Heap, + pub actions: HashSet, + pub plans: HashMap>, + fuel: usize, +} + +pub(super) fn program(role: R) -> Program { + match role { + R::Executor => Program::Executor, + R::Run => Program::Run, + R::CloneSequence => Program::CloneSequence, + R::RebuildSequence => Program::RebuildSequence, + R::Start => Program::Start, + R::Check => Program::Check, + R::Close => Program::Close, + R::Once => Program::Once, + R::Cancel => Program::Cancel, + } +} + +impl Interpreter { + pub(super) fn new(heap: Heap) -> Self { + let plans = [ + Program::Executor, + Program::Run, + Program::CloneSequence, + Program::RebuildSequence, + Program::Start, + Program::Check, + Program::Close, + Program::Once, + Program::Cancel, + Program::RawResume, + ] + .into_iter() + .map(|program| { + ( + program, + Rc::new(super::super::build(program).exec().clone()), + ) + }) + .collect(); + Self { + heap, + plans, + actions: HashSet::new(), + fuel: 100_000, + } + } + + pub(super) fn tick(&mut self) -> Checked<()> { + self.fuel = self.fuel.checked_sub(1).ok_or(Fault::Exhausted)?; + Ok(()) + } + pub(super) fn reset(&mut self, heap: Heap) { + self.heap = heap; + self.fuel = 100_000; + } + + pub(super) fn run(&mut self, mut program: Program, mut params: Vec) -> Checked { + loop { + self.tick()?; + let plan = self + .plans + .get(&program) + .cloned() + .ok_or(Fault::InvalidModel)?; + let mut path = Vec::new(); + let flow = self.exec(&plan, ¶ms, &mut Vec::new(), &mut path); + if let Some(action) = ActionId::ALL + .into_iter() + .find(|action| action.selection() == (program, path.as_slice())) + { + self.actions.insert(action); + } + match flow? { + Flow::Exit(step) => return Ok(step), + Flow::Tail(target, args) => { + program = target; + params = args; + } + } + } + } + + pub(super) fn call(&mut self, target: Program, args: Vec) -> Checked { + let mut step = self.run(target, args)?; + loop { + match step { + Step::Return(value) => return Ok(value), + Step::Publish(value) if target == Program::Executor => return Ok(value), + Step::Advance(params) if target == Program::Executor => { + step = self.run(Program::Executor, params)?; + } + _ => return Err(Fault::InvalidModel), + } + } + } + + pub(super) fn apply(&mut self, function: Value, args: Vec) -> Checked { + if matches!(self.heap.get(function)?, Object::Raw { .. }) { + self.heap.events.push(Event::Apply(function, args.clone())); + let [value] = args.as_slice() else { + return Err(Fault::InvalidModel); + }; + self.call(Program::RawResume, vec![function, *value]) + } else { + self.heap.invoke(function, args) + } + } + + pub(super) fn operand(operand: &Operand, params: &[Value], env: &[Value]) -> Checked { + match operand { + Operand::State(state) => params.get(match state { + State::Value => 0, + State::Handler => 1, + State::Computation => 2, + State::Sequence => 3, + State::Extent => 4, + State::Context => 5, + }), + Operand::Param(index) => params.get(*index), + Operand::Temp(index) => env.get(*index), + } + .copied() + .ok_or(Fault::InvalidModel) + } + + pub(super) fn operands( + values: &[Operand], + params: &[Value], + env: &[Value], + ) -> Checked> { + values + .iter() + .map(|value| Self::operand(value, params, env)) + .collect() + } + + fn exec( + &mut self, + exec: &Exec, + params: &[Value], + env: &mut Vec, + path: &mut Vec, + ) -> Checked { + self.tick()?; + match exec { + Exec::Steps { ops, next } => { + for op in ops { + let value = self.op(op, params, env)?; + env.push(value); + } + self.exec(next, params, env, path) + } + Exec::Switch { source, case, arms } => { + let source = Self::operand(source, params, env)?; + let (family, tag) = match self.heap.get(source)? { + Object::Node(node) => (node.case().family(), node.case().tag()), + Object::Unknown(family, tag) => (*family, *tag), + _ => return Err(Fault::InvalidModel), + }; + if family != case.family() { + return Err(Fault::InvalidModel); + } + let arm = arms + .iter() + .find(|(candidate, _)| *candidate == tag) + .ok_or(Fault::Trap)?; + let actual = self.heap.get_node(source)?.case(); + path.push(match actual { + Case::Computation(case) => Selection::Computation(case), + Case::Sequence(case) => Selection::Sequence(case), + Case::Context(case) => Selection::Context(case), + Case::Extent(case) => Selection::Extent(case), + Case::Owner(_) => return Err(Fault::InvalidModel), + }); + self.exec(&arm.1, params, &mut env.clone(), path) + } + Exec::Advance { + state, + handler, + computation, + sequence, + extent, + context, + } => { + let values = [state, handler, computation, sequence, extent, context] + .into_iter() + .map(|o| Self::operand(o, params, env)) + .collect::>>()?; + Ok(Flow::Exit(Step::Advance(values))) + } + Exec::Publish { result } => Ok(Flow::Exit(Step::Publish(Self::operand( + result, params, env, + )?))), + Exec::Return { value } => { + Ok(Flow::Exit(Step::Return(Self::operand(value, params, env)?))) + } + Exec::Tail { role, args } => Ok(Flow::Tail( + program(*role), + Self::operands(args, params, env)?, + )), + Exec::Reject { .. } => Err(Fault::Trap), + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/mod.rs similarity index 87% rename from crates/psrs-backend/src/cc/lower/control/plan/model.rs rename to crates/psrs-backend/src/cc/lower/control/plan/model/mod.rs index 41649f32..23819926 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/model.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/mod.rs @@ -1,10 +1,25 @@ -//! An independent bounded model of the flat driver's transition traces. +//! Bounded construction-model tests, separate from optimized target execution. //! -//! `explore` recovers the terminal outcomes the plan reaches, keyed by the path -//! of case refinements. `expected` and `helper_expected` state the same -//! transitions directly from the operational semantics table, not from the plan -//! builders. The tests compare the two so a dropped, duplicated or mis-routed -//! transition is a mismatch rather than a silently passing recognizer. +//! `interpret` executes actual plans with a concrete heap. `reference` implements +//! direct typed operational semantics and flat-list replay, without consuming +//! the plans. `behavior` compares outcomes, ordered observations, source identity +//! and fresh-reference aliasing; `mutations` proves that semantically wrong but +//! structurally checked plans are distinguishable. These tests do not interpret +//! arbitrary source callback bodies or prove optimizer preservation. +//! +//! The terminal-shape tables retained below are complementary structural tests. + +mod behavior; +mod compare; +mod continuations; +mod failure_prefixes; +mod fixtures; +mod heap; +mod interpret; +mod mutations; +mod operations; +mod reference; +mod runs; use super::ir::{Case, Exec}; use super::shape::Terminal; @@ -141,6 +156,7 @@ pub(super) fn helper_expected() -> Vec { vec![ (vec![(s(Empty), 0)], Value), (vec![(s(Cons), 1)], Tail), + (vec![(s(Append), 2)], Reject), (vec![(s(Finish), 3)], Tail), ], ), @@ -170,7 +186,7 @@ mod tests { use super::*; #[test] - fn plan_matches_the_independent_model() { + fn executor_terminal_shape_matches_the_specification() { let plan = super::super::executor(); let expected = expected(); assert_eq!( @@ -188,7 +204,7 @@ mod tests { } #[test] - fn helper_plans_match_the_model() { + fn helper_terminal_shapes_match_the_specification() { for (name, plan, expected) in helper_expected() { assert_eq!( trace_count(&plan), diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/flows.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/flows.rs new file mode 100644 index 00000000..582ee26b --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/flows.rs @@ -0,0 +1,155 @@ +use super::*; + +#[test] +fn swapped_same_shaped_clauses_do_not_pass_the_behavioral_model() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Return(f.answer)); + let args = f.args(computation, f.empty, f.scoped); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Return), &mut |op| { + if let Op::Project { + case: Case::Context(X::Scoped), + field, + .. + } = op + && *field == 0 + { + *field = 1; + return true; + } + false + })); + }); +} + +#[test] +fn target_finish_restores_its_caller_extent_not_its_owned_extent() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Return(f.answer)); + let args = f.args(computation, f.empty, f.scoped); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Return), &mut |op| { + if let Op::Project { + case: Case::Context(X::Scoped), + field, + .. + } = op + && *field == 3 + { + *field = 5; + return true; + } + false + })); + }); +} + +#[test] +fn callbacks_receive_the_current_answer_instead_of_the_root_state() { + let mut f = Fixture::new(); + let queue = f.heap.node(Node::Cons(f.callback, f.empty)); + let computation = f.heap.node(Node::Return(f.answer)); + let args = f.args(computation, queue, f.root); + detects(f, Program::Executor, args, |plan| { + let Exec::Steps { next, .. } = arm(plan, C::Return) else { + unreachable!() + }; + let Exec::Switch { arms, .. } = next.as_mut() else { + unreachable!() + }; + let cons = &mut arms + .iter_mut() + .find(|(tag, _)| *tag == Q::Cons.tag()) + .unwrap() + .1; + assert!(edit(cons, &mut |op| { + if let Op::Apply { args, .. } = op { + args[0] = Operand::State(State::Value); + return true; + } + false + })); + }); +} + +#[test] +fn bind_enters_its_inner_computation_instead_of_reentering_itself() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Bind(f.next, f.callback)); + let args = f.args(computation, f.consumer, f.scoped); + detects(f, Program::Executor, args, |plan| { + let Exec::Steps { next, .. } = arm(plan, C::Bind) else { + unreachable!() + }; + let Exec::Advance { computation, .. } = next.as_mut() else { + unreachable!() + }; + *computation = Operand::State(State::Computation); + }); +} + +#[test] +fn root_handler_state_and_next_computation_do_not_share_a_projection() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Perform(f.request)); + let args = f.args(computation, f.consumer, f.root); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Perform), &mut |op| { + if let Op::PairField { field, .. } = op + && *field == 0 + { + *field = 1; + return true; + } + false + })); + }); +} + +#[test] +fn finish_closes_its_owned_extent_not_its_restore_parent() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Return(f.answer)); + let queue = f.heap.node(Node::Finish(f.checkpoint, f.empty, f.parent)); + let args = f.args(computation, queue, f.scoped); + detects(f, Program::Executor, args, |plan| { + let Exec::Steps { next, .. } = arm(plan, C::Return) else { + unreachable!() + }; + let Exec::Switch { arms, .. } = next.as_mut() else { + unreachable!() + }; + let finish = &mut arms + .iter_mut() + .find(|(tag, _)| *tag == Q::Finish.tag()) + .unwrap() + .1; + assert!(edit(finish, &mut |op| { + if let Op::CloseBoundary { extent } = op { + *extent = Operand::State(State::Extent); + return true; + } + false + })); + }); +} + +#[test] +fn handle_keeps_caller_and_owned_extents_distinct() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Handle(f.ret, f.op, f.next)); + let args = f.args(computation, f.empty, f.scoped); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Handle), &mut |op| { + if let Op::Node { + case: Case::Context(X::Scoped), + fields, + } = op + { + fields[3] = fields[5].clone(); + return true; + } + false + })); + }); +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs new file mode 100644 index 00000000..baaacca4 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs @@ -0,0 +1,148 @@ +use super::*; + +#[test] +fn unused_private_allocations_are_not_hidden_by_fresh_id_normalization() { + for allocation in [ + Op::NewStatus, + Op::FreshExtent { parent: None }, + Op::EmptySequence, + ] { + let f = Fixture::new(); + detects(f, Program::Start, vec![], |plan| { + let Exec::Steps { ops, .. } = plan else { + unreachable!() + }; + ops.push(allocation); + }); + } +} + +#[test] +fn owned_phases_remain_ordered_even_when_the_final_status_matches() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::OwnedResume(f.owner, f.answer)); + let args = f.args(computation, f.consumer, f.root); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::OwnedResume), &mut |op| { + if let Op::SetStatus { value, .. } = op + && *value == 1 + { + *value = 2; + return true; + } + false + })); + }); +} + +#[test] +fn ownership_transfer_releases_the_callback_instead_of_retaining_it() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::OwnedResume(f.owner, f.answer)); + let args = f.args(computation, f.consumer, f.root); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::OwnedResume), &mut |op| { + if let Op::WriteCallback { value, .. } = op { + *value = Operand::Temp(6); + return true; + } + false + })); + }); +} + +#[test] +fn cancellation_marks_cancelled_instead_of_consumed() { + let f = Fixture::new(); + let args = vec![f.owner]; + detects(f, Program::Cancel, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::SetStatus { value, .. } = op { + *value = 2; + return true; + } + false + })); + }); +} + +#[test] +fn checking_an_expired_extent_cannot_reopen_it() { + let mut f = Fixture::new(); + f.expire(f.checkpoint); + let args = vec![f.checkpoint]; + detects(f, Program::Check, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::GuardPending { cell } = op { + *op = Op::SetStatus { + cell: cell.clone(), + value: 0, + }; + return true; + } + false + })); + }); +} + +#[test] +fn close_cannot_leave_an_extent_live() { + let f = Fixture::new(); + let args = vec![f.checkpoint]; + detects(f, Program::Close, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::SetStatus { value, .. } = op { + *value = 0; + return true; + } + false + })); + }); +} + +#[test] +fn raw_resume_checks_its_saved_checkpoint_before_publishing_a_frame() { + let mut f = Fixture::new(); + f.expire(f.checkpoint); + let args = vec![f.raw, f.answer]; + detects(f, Program::RawResume, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::CheckBoundary { extent } = op { + *op = Op::FreshExtent { + parent: Some(extent.clone()), + }; + return true; + } + false + })); + }); +} + +#[test] +fn run_cannot_omit_normal_root_cleanup_or_publish_an_unrelated_result() { + for wrong_result in [false, true] { + let f = Fixture::new(); + let args = vec![f.state, f.handler, f.next]; + detects(f, Program::Run, args, |plan| { + let Exec::Steps { ops, next } = plan else { + unreachable!() + }; + if wrong_result { + *next = Box::new(Exec::Return { + value: Operand::Param(0), + }); + } else { + let close = ops + .iter_mut() + .find(|op| matches!(op, Op::CloseBoundary { .. })) + .unwrap(); + let Op::CloseBoundary { extent } = close else { + unreachable!() + }; + *close = Op::CheckBoundary { + extent: extent.clone(), + }; + } + }); + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/mod.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/mod.rs new file mode 100644 index 00000000..f42e19fa --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/mod.rs @@ -0,0 +1,62 @@ +//! The model must detect semantically wrong plans that still pass logical +//! type/scope, action coverage and terminal-shape checking. +mod flows; +mod lifetime; +mod replay; + +use super::super::{ + build, check, + ir::{Case, Exec, Op, Operand, State}, +}; +use super::{ + compare::equivalent, fixtures::Fixture, heap::*, interpret::Interpreter, reference::Reference, +}; +use crate::control::{ + execution::Program, + schema::{ComputationCase as C, ContextCase as X, SequenceCase as Q}, +}; +use std::rc::Rc; + +fn edit(plan: &mut Exec, change: &mut impl FnMut(&mut Op) -> bool) -> bool { + match plan { + Exec::Steps { ops, next } => ops.iter_mut().any(&mut *change) || edit(next, change), + Exec::Switch { arms, .. } => arms.iter_mut().any(|(_, arm)| edit(arm, change)), + _ => false, + } +} + +fn arm(plan: &mut Exec, tag: C) -> &mut Exec { + let Exec::Switch { arms, .. } = plan else { + panic!("executor begins with computation selection"); + }; + &mut arms + .iter_mut() + .find(|(case, _)| *case == tag.tag()) + .unwrap() + .1 +} + +fn detects(f: Fixture, program: Program, args: Vec, change: impl FnOnce(&mut Exec)) { + let mut interpreter = Interpreter::new(f.heap.clone()); + let mut plan = build(program).exec().clone(); + change(&mut plan); + check::check_for(program,&plan).expect("the negative must preserve the checked plan's logical types, scope, action inventory and terminal roles"); + interpreter.plans.insert(program, Rc::new(plan)); + let actual = interpreter.run(program, args.clone()); + let mut expected_heap = f.heap.clone(); + let expected = Reference::new(&mut expected_heap).run(program, &args); + assert!( + !matches!(actual, Err(Fault::InvalidModel | Fault::Exhausted)), + "mutation must have a defined model execution: {actual:?}" + ); + assert!( + !equivalent( + &interpreter.heap, + &actual, + &expected_heap, + &expected, + f.heap.objects.len() + ), + "model accepted a semantically wrong, structurally checked {program:?} plan" + ); +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/replay.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/replay.rs new file mode 100644 index 00000000..171089ca --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/replay.rs @@ -0,0 +1,128 @@ +use super::*; + +#[test] +fn perform_captures_the_dispatch_checkpoint_not_the_execution_extent() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Perform(f.request)); + let args = f.args(computation, f.consumer, f.root); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Perform), &mut |op| { + if let Op::ResumeClosure { captures } = op { + captures[1] = Operand::State(State::Extent); + return true; + } + false + })); + }); +} + +#[test] +fn resume_checks_the_saved_checkpoint_not_the_current_execution_extent() { + let mut f = Fixture::new(); + f.expire(f.checkpoint); + let computation = f.heap.node(Node::Resume(f.answer, f.saved, f.checkpoint)); + let args = f.args(computation, f.consumer, f.scoped); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Resume), &mut |op| { + if let Op::CheckBoundary { extent } = op { + *extent = Operand::State(State::Extent); + return true; + } + false + })); + }); +} + +#[test] +fn clone_cannot_drop_the_left_queue_when_pending_right_work_exists() { + let mut f = Fixture::new(); + let queue = f.heap.node(Node::Append(f.saved, f.consumer)); + let args = vec![queue, f.empty, f.empty, f.active, f.parent]; + detects(f, Program::CloneSequence, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::Project { + case: Case::Sequence(Q::Append), + source: Operand::Param(0), + field, + .. + } = op + && *field == 0 + { + *field = 1; + return true; + } + false + })); + }); +} + +#[test] +fn resume_appends_captured_work_before_consumer_work() { + let mut f = Fixture::new(); + let computation = f.heap.node(Node::Resume(f.answer, f.saved, f.checkpoint)); + let args = f.args(computation, f.consumer, f.scoped); + detects(f, Program::Executor, args, |plan| { + assert!(edit(arm(plan, C::Resume), &mut |op| { + if let Op::Node { + case: Case::Sequence(Q::Append), + fields, + } = op + { + fields.swap(0, 1); + return true; + } + false + })); + }); +} + +#[test] +fn replay_parents_fresh_activations_to_dispatch_not_execution() { + let mut f = Fixture::new(); + let queue = f.heap.node(Node::Finish(f.checkpoint, f.empty, f.parent)); + let args = vec![queue, f.empty, f.active, f.parent]; + detects(f, Program::RebuildSequence, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::FreshExtent { parent } = op { + *parent = Some(Operand::Param(2)); + return true; + } + false + })); + }); +} + +#[test] +fn replay_must_not_reuse_a_saved_extent_as_a_fresh_activation() { + let mut f = Fixture::new(); + let queue = f.heap.node(Node::Finish(f.checkpoint, f.empty, f.parent)); + let args = vec![queue, f.empty, f.active, f.parent]; + detects(f, Program::RebuildSequence, args, |plan| { + assert!(edit(plan, &mut |op| { + if matches!(op, Op::FreshExtent { .. }) { + *op = Op::Project { + source: Operand::Param(0), + case: Case::Sequence(Q::Finish), + field: 0, + }; + return true; + } + false + })); + }); +} + +#[test] +fn replay_result_keeps_the_rebuilt_queue_and_matching_activation() { + let f = Fixture::new(); + let args = vec![f.empty, f.consumer, f.active, f.parent]; + detects(f, Program::RebuildSequence, args, |plan| { + assert!(edit(plan, &mut |op| { + if let Op::Product { fields, .. } = op { + fields[0] = Operand::Param(0); + return true; + } + false + })); + }); +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/operations.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/operations.rs new file mode 100644 index 00000000..a98ddb54 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/operations.rs @@ -0,0 +1,168 @@ +//! Interpret plan operands and instructions; no reference transition is used. +use super::super::ir::{Case, Op, Product}; +use super::heap::*; +use super::interpret::{Interpreter, program}; +use crate::control::execution::Program; +use crate::control::schema::{ + ComputationCase as C, ContextCase as X, ExtentCase as E, OwnerCase as O, SequenceCase as Q, +}; + +impl Interpreter { + pub(super) fn op(&mut self, op: &Op, params: &[Value], env: &[Value]) -> Checked { + self.tick()?; + let value = |o| Self::operand(o, params, env); + match op { + Op::Project { + source, + case, + field, + } => { + let node = self.heap.get_node(value(source)?)?; + if node.case() != *case { + return Err(Fault::InvalidModel); + } + node.fields() + .get(*field as usize) + .copied() + .ok_or(Fault::InvalidModel) + } + Op::Node { case, fields } => { + let fields = Self::operands(fields, params, env)?; + let node = node(*case, &fields)?; + Ok(self.heap.node(node)) + } + Op::Capture { closure, index, .. } => { + let Object::Raw { queue, checkpoint } = self.heap.get(value(closure)?)? else { + return Err(Fault::InvalidModel); + }; + match *index { + 0 => Ok(*queue), + 1 => Ok(*checkpoint), + _ => Err(Fault::InvalidModel), + } + } + Op::Apply { callee, args } => { + self.apply(value(callee)?, Self::operands(args, params, env)?) + } + Op::Helper { role, args } => { + self.call(program(*role), Self::operands(args, params, env)?) + } + Op::ResumeClosure { captures } => { + let args = Self::operands(captures, params, env)?; + let [queue, checkpoint] = args.as_slice() else { + return Err(Fault::InvalidModel); + }; + Ok(self.heap.alloc(Object::Raw { + queue: *queue, + checkpoint: *checkpoint, + })) + } + Op::Pair { + state, + value: answer, + } => Ok(self.heap.alloc(Object::Pair(value(state)?, value(answer)?))), + Op::PairField { pair, field } => { + let Object::Pair(state, answer) = self.heap.get(value(pair)?)? else { + return Err(Fault::InvalidModel); + }; + match *field { + 0 => Ok(*state), + 1 => Ok(*answer), + _ => Err(Fault::InvalidModel), + } + } + Op::ReplayField { result, field } => { + let Object::Replay(queue, active) = self.heap.get(value(result)?)? else { + return Err(Fault::InvalidModel); + }; + match *field { + 0 => Ok(*queue), + 1 => Ok(*active), + _ => Err(Fault::InvalidModel), + } + } + Op::FreshExtent { parent } => { + Ok(self.heap.extent(parent.as_ref().map(value).transpose()?)) + } + Op::ContextExtent { context } => match self.heap.get_node(value(context)?)? { + Node::RootContext(extent) | Node::ScopedContext { extent, .. } => Ok(extent), + _ => Err(Fault::InvalidModel), + }, + Op::CheckBoundary { extent } => self.call(Program::Check, vec![value(extent)?]), + Op::CloseBoundary { extent } => self.call(Program::Close, vec![value(extent)?]), + Op::GuardPending { cell } => { + let cell = value(cell)?; + if self.heap.status(cell)? != 0 { + return Err(Fault::Trap); + } + Ok(cell) + } + Op::SetStatus { + cell, + value: status, + } => { + let cell = value(cell)?; + self.heap.set_status(cell, *status)?; + Ok(cell) + } + Op::ReadCallback { cell } => self.heap.callback(value(cell)?), + Op::WriteCallback { + cell, + value: replacement, + } => { + let cell = value(cell)?; + self.heap.set_callback(cell, value(replacement)?)?; + Ok(cell) + } + Op::NewCallbackCell { value: callback } => { + Ok(self.heap.alloc(Object::CallbackCell(value(callback)?))) + } + Op::NewStatus => Ok(self.heap.alloc(Object::Status(0))), + Op::Product { + product: Product::ReplayResult, + fields, + } => { + let fields = Self::operands(fields, params, env)?; + let [queue, active] = fields.as_slice() else { + return Err(Fault::InvalidModel); + }; + Ok(self.heap.alloc(Object::Replay(*queue, *active))) + } + Op::EmptySequence => Ok(self.heap.node(Node::Empty)), + } + } +} + +fn node(case: Case, fields: &[Value]) -> Checked { + Ok(match (case, fields) { + (Case::Computation(C::Return), [a]) => Node::Return(*a), + (Case::Computation(C::Perform), [a]) => Node::Perform(*a), + (Case::Computation(C::Bind), [a, b]) => Node::Bind(*a, *b), + (Case::Computation(C::Resume), [a, b, c]) => Node::Resume(*a, *b, *c), + (Case::Computation(C::Handle), [a, b, c]) => Node::Handle(*a, *b, *c), + (Case::Computation(C::OwnedResume), [a, b]) => Node::OwnedResume(*a, *b), + (Case::Sequence(Q::Empty), []) => Node::Empty, + (Case::Sequence(Q::Cons), [a, b]) => Node::Cons(*a, *b), + (Case::Sequence(Q::Append), [a, b]) => Node::Append(*a, *b), + (Case::Sequence(Q::Finish), [a, b, c]) => Node::Finish(*a, *b, *c), + (Case::Context(X::Root), [a]) => Node::RootContext(*a), + (Case::Context(X::Scoped), [a, b, c, d, e, f]) => Node::ScopedContext { + ret: *a, + op: *b, + saved: *c, + parent: *d, + caller: *e, + extent: *f, + }, + (Case::Extent(E::Root), [a]) => Node::RootExtent(*a), + (Case::Extent(E::Scoped), [a, b]) => Node::ScopedExtent { + status: *a, + parent: *b, + }, + (Case::Owner(O::OneShot), [a, b]) => Node::Owner { + callback: *a, + status: *b, + }, + _ => return Err(Fault::InvalidModel), + }) +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/reference/executor.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/reference/executor.rs new file mode 100644 index 00000000..3d99fe4a --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/reference/executor.rs @@ -0,0 +1,176 @@ +//! Direct operational transitions over typed nodes. +use super::super::heap::*; +use super::Reference; + +impl Reference<'_> { + pub(super) fn step(&mut self, mut state: [Value; 6]) -> Checked { + let [s, h, computation, queue, extent, context] = state; + match self.heap.get_node(computation)? { + Node::Return(value) => match self.heap.get_node(queue)? { + Node::Empty => match self.heap.get_node(context)? { + Node::RootContext(_) => { + return Ok(Step::Publish(self.heap.alloc(Object::Pair(s, value)))); + } + Node::ScopedContext { ret, .. } => { + let target = self.apply(ret, vec![value])?; + return self.enter_target(state, target); + } + _ => return Err(Fault::InvalidModel), + }, + Node::Cons(callback, rest) => { + state[2] = self.apply(callback, vec![value])?; + state[3] = rest; + } + Node::Append(left, right) => return self.append_return(state, value, left, right), + Node::Finish(owned, rest, parent) => { + self.close(owned)?; + state[3] = rest; + state[4] = parent; + } + _ => return Err(Fault::InvalidModel), + }, + Node::Perform(request) => { + let checkpoint = self.dispatch_extent(context)?; + let raw = self.heap.alloc(Object::Raw { queue, checkpoint }); + match self.heap.get_node(context)? { + Node::RootContext(_) => { + let pair = self.apply(h, vec![s, request, raw])?; + let Object::Pair(next_state, next) = *self.heap.get(pair)? else { + return Err(Fault::InvalidModel); + }; + state[0] = next_state; + state[2] = next; + state[3] = self.heap.node(Node::Empty); + } + Node::ScopedContext { op, .. } => { + let target = self.apply(op, vec![request, raw])?; + return self.enter_target(state, target); + } + _ => return Err(Fault::InvalidModel), + } + } + Node::Bind(inner, callback) => { + state[2] = inner; + state[3] = self.heap.node(Node::Cons(callback, queue)); + } + Node::Resume(value, saved, checkpoint) => { + self.check(checkpoint)?; + let parent = self.dispatch_extent(context)?; + let empty = self.heap.node(Node::Empty); + let replay = self.clone_sequence(saved, empty, empty, extent, parent)?; + let Object::Replay(replayed, activation) = *self.heap.get(replay)? else { + return Err(Fault::InvalidModel); + }; + state[2] = self.heap.node(Node::Return(value)); + state[3] = self.heap.node(Node::Append(replayed, queue)); + state[4] = activation; + } + Node::Handle(ret, op, inner) => { + if let Node::Append(left, right) = self.heap.get_node(queue)? { + return self.normalize_handle(state, left, right); + } + let (saved, parent, owned) = match self.heap.get_node(queue)? { + Node::Finish(owned, rest, parent) => (rest, parent, owned), + Node::Empty | Node::Cons(..) => (queue, extent, self.heap.extent(Some(extent))), + _ => return Err(Fault::InvalidModel), + }; + state[2] = inner; + state[3] = self.heap.node(Node::Empty); + state[4] = owned; + state[5] = self.heap.node(Node::ScopedContext { + ret, + op, + saved, + parent, + caller: context, + extent: owned, + }); + } + Node::OwnedResume(owner, value) => { + let Node::Owner { callback, status } = self.heap.get_node(owner)? else { + return Err(Fault::InvalidModel); + }; + if self.heap.status(status)? != 0 { + return Err(Fault::Trap); + } + self.heap.set_status(status, 1)?; + let callback_value = self.heap.callback(callback)?; + self.heap.set_callback(callback, status)?; + state[2] = self.apply(callback_value, vec![value])?; + self.heap.set_status(status, 2)?; + } + _ => return Err(Fault::InvalidModel), + } + Ok(Step::Advance(state.into())) + } + + fn enter_target(&mut self, mut state: [Value; 6], target: Value) -> Checked { + let Node::ScopedContext { + saved, + parent, + caller, + extent, + .. + } = self.heap.get_node(state[5])? + else { + return Err(Fault::InvalidModel); + }; + state[2] = target; + state[3] = self.heap.node(Node::Finish(extent, saved, parent)); + state[4] = extent; + state[5] = caller; + Ok(Step::Advance(state.into())) + } + + fn append_return( + &mut self, + mut state: [Value; 6], + value: Value, + left: Value, + right: Value, + ) -> Checked { + state[3] = match self.heap.get_node(left)? { + Node::Empty => right, + Node::Cons(callback, rest) => { + let queue = self.heap.node(Node::Append(rest, right)); + state[2] = self.apply(callback, vec![value])?; + queue + } + Node::Append(first, second) => { + let tail = self.heap.node(Node::Append(second, right)); + self.heap.node(Node::Append(first, tail)) + } + Node::Finish(owned, rest, parent) => { + let tail = self.heap.node(Node::Append(rest, right)); + self.heap.node(Node::Finish(owned, tail, parent)) + } + _ => return Err(Fault::InvalidModel), + }; + Ok(Step::Advance(state.into())) + } + + fn normalize_handle( + &mut self, + mut state: [Value; 6], + left: Value, + right: Value, + ) -> Checked { + state[3] = match self.heap.get_node(left)? { + Node::Empty => right, + Node::Cons(callback, rest) => { + let tail = self.heap.node(Node::Append(rest, right)); + self.heap.node(Node::Cons(callback, tail)) + } + Node::Append(first, second) => { + let tail = self.heap.node(Node::Append(second, right)); + self.heap.node(Node::Append(first, tail)) + } + Node::Finish(owned, rest, parent) => { + let tail = self.heap.node(Node::Append(rest, right)); + self.heap.node(Node::Finish(owned, tail, parent)) + } + _ => return Err(Fault::InvalidModel), + }; + Ok(Step::Advance(state.into())) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/reference/mod.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/reference/mod.rs new file mode 100644 index 00000000..a8640f58 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/reference/mod.rs @@ -0,0 +1,139 @@ +//! Operational semantics over typed values. No plan, Op, Cursor, field-offset +//! constants or emitter is inspected here. Replay uses the separate flat model. +mod executor; +mod replay; +use super::heap::*; +use crate::control::execution::Program; + +pub(super) struct Reference<'a> { + pub heap: &'a mut Heap, + fuel: usize, +} + +impl<'a> Reference<'a> { + pub(super) fn new(heap: &'a mut Heap) -> Self { + Self { + heap, + fuel: 100_000, + } + } + pub(super) fn tick(&mut self) -> Checked<()> { + self.fuel = self.fuel.checked_sub(1).ok_or(Fault::Exhausted)?; + Ok(()) + } + pub(super) fn run(&mut self, program: Program, args: &[Value]) -> Checked { + self.tick()?; + let returned = match (program, args) { + (Program::Run, [state, handler, computation]) => { + let empty = self.heap.node(Node::Empty); + let root = self.heap.extent(None); + let context = self.heap.node(Node::RootContext(root)); + let mut current = vec![*state, *handler, *computation, empty, root, context]; + let result = loop { + let args: [Value; 6] = current.try_into().map_err(|_| Fault::InvalidModel)?; + match self.step(args)? { + Step::Advance(next) => current = next, + Step::Publish(result) => break result, + _ => return Err(Fault::InvalidModel), + } + }; + self.close(root)?; + result + } + (Program::Executor, [s, h, c, q, e, x]) => return self.step([*s, *h, *c, *q, *e, *x]), + (Program::CloneSequence, [queue, todo, reversed, active, parent]) => { + self.clone_sequence(*queue, *todo, *reversed, *active, *parent)? + } + (Program::RebuildSequence, [reversed, result, active, parent]) => { + self.rebuild_sequence(*reversed, *result, *active, *parent)? + } + (Program::Check, [extent]) => self.check(*extent)?, + (Program::Close, [extent]) => { + self.close(*extent)?; + *extent + } + (Program::Start, []) => self.heap.extent(None), + (Program::Once, [callback]) => { + let callback = self.heap.alloc(Object::CallbackCell(*callback)); + let status = self.heap.alloc(Object::Status(0)); + self.heap.node(Node::Owner { callback, status }) + } + (Program::Cancel, [owner]) => { + let Node::Owner { callback, status } = self.heap.get_node(*owner)? else { + return Err(Fault::InvalidModel); + }; + if self.heap.status(status)? != 0 { + return Err(Fault::Trap); + } + self.heap.set_status(status, 3)?; + self.heap.set_callback(callback, status)?; + *owner + } + (Program::RawResume, [receiver, value]) => { + let Object::Raw { queue, checkpoint } = *self.heap.get(*receiver)? else { + return Err(Fault::InvalidModel); + }; + self.check(checkpoint)?; + self.heap.node(Node::Resume(*value, queue, checkpoint)) + } + _ => return Err(Fault::InvalidModel), + }; + Ok(Step::Return(returned)) + } + + pub(super) fn check(&mut self, mut extent: Value) -> Checked { + loop { + self.tick()?; + let (status, parent) = match self.heap.get_node(extent)? { + Node::RootExtent(status) => (status, None), + Node::ScopedExtent { status, parent } => (status, Some(parent)), + _ => return Err(Fault::InvalidModel), + }; + if self.heap.status(status)? != 0 { + return Err(Fault::Trap); + } + match parent { + Some(parent) => extent = parent, + None => return Ok(extent), + } + } + } + + fn close(&mut self, extent: Value) -> Checked<()> { + match self.heap.get_node(extent)? { + Node::RootExtent(status) | Node::ScopedExtent { status, .. } => { + self.heap.set_status(status, 1) + } + _ => Err(Fault::InvalidModel), + } + } + + fn dispatch_extent(&self, context: Value) -> Checked { + match self.heap.get_node(context)? { + Node::RootContext(extent) | Node::ScopedContext { extent, .. } => Ok(extent), + _ => Err(Fault::InvalidModel), + } + } + + fn apply(&mut self, callee: Value, args: Vec) -> Checked { + if matches!(self.heap.get(callee)?, Object::Raw { .. }) { + self.heap.events.push(Event::Apply(callee, args.clone())); + let Step::Return(value) = self.run( + Program::RawResume, + &[ + callee, + *args + .first() + .filter(|_| args.len() == 1) + .ok_or(Fault::InvalidModel)?, + ], + )? + else { + return Err(Fault::InvalidModel); + }; + Ok(value) + } else { + self.heap.invoke(callee, args) + } + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/reference/replay.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/reference/replay.rs new file mode 100644 index 00000000..a534cc51 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/reference/replay.rs @@ -0,0 +1,125 @@ +//! A flat occurrence-list replay specification, independent of the plan's +//! traversal-stack/reversed-node construction. Callback and owner references +//! are never copied; only activation extents and queue structure are fresh. +use super::super::heap::*; +use super::Reference; + +#[derive(Clone, Copy, Debug)] +pub(super) enum Frame { + Callback(Value), + Finish, +} + +impl Reference<'_> { + fn flatten(&mut self, queue: Value, output: &mut Vec) -> Checked<()> { + self.tick()?; + match self.heap.get_node(queue)? { + Node::Empty => {} + Node::Cons(callback, rest) => { + self.heap.queue_work += 1; + output.push(Frame::Callback(callback)); + self.flatten(rest, output)?; + } + Node::Append(left, right) => { + self.heap.queue_work += 1; + self.flatten(left, output)?; + self.flatten(right, output)?; + } + Node::Finish(extent, rest, _) => { + self.check(extent)?; + self.heap.queue_work += 1; + output.push(Frame::Finish); + self.flatten(rest, output)?; + } + _ => return Err(Fault::InvalidModel), + } + Ok(()) + } + + fn linear(&mut self, mut queue: Value) -> (Vec, Checked<()>) { + let mut frames = Vec::new(); + loop { + if let Err(error) = self.tick() { + return (frames, Err(error)); + } + match self.heap.get_node(queue) { + Ok(Node::Empty) => return (frames, Ok(())), + Ok(Node::Cons(callback, rest)) => { + frames.push(Frame::Callback(callback)); + queue = rest; + } + Ok(Node::Finish(_, rest, _)) => { + frames.push(Frame::Finish); + queue = rest; + } + Ok(Node::Append(..)) => return (frames, Err(Fault::Trap)), + Err(error) => return (frames, Err(error)), + _ => return (frames, Err(Fault::InvalidModel)), + } + } + } + + pub(super) fn clone_sequence( + &mut self, + queue: Value, + mut todo: Value, + reversed: Value, + active: Value, + parent: Value, + ) -> Checked { + let mut frames = Vec::new(); + self.flatten(queue, &mut frames)?; + loop { + self.tick()?; + match self.heap.get_node(todo)? { + Node::Empty => break, + Node::Append(next, rest) => { + self.flatten(next, &mut frames)?; + todo = rest; + } + Node::Cons(..) | Node::Finish(..) => return Err(Fault::Trap), + _ => return Err(Fault::InvalidModel), + } + } + let mut reversed_frames = frames.into_iter().rev().collect::>(); + let (prefix, end) = self.linear(reversed); + reversed_frames.extend(prefix); + self.rebuild_frames(&reversed_frames, todo, active, parent, end) + } + + pub(super) fn rebuild_sequence( + &mut self, + reversed: Value, + result: Value, + active: Value, + parent: Value, + ) -> Checked { + let (frames, end) = self.linear(reversed); + self.rebuild_frames(&frames, result, active, parent, end) + } + + fn rebuild_frames( + &mut self, + frames: &[Frame], + mut result: Value, + mut active: Value, + mut parent: Value, + end: Checked<()>, + ) -> Checked { + for frame in frames { + self.tick()?; + result = match *frame { + Frame::Callback(callback) => self.heap.node(Node::Cons(callback, result)), + Frame::Finish => { + let fresh = self.heap.extent(Some(parent)); + let next = self.heap.node(Node::Finish(fresh, result, active)); + active = fresh; + parent = fresh; + next + } + }; + } + end?; + Ok(self.heap.alloc(Object::Replay(result, active))) + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/runs.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/runs.rs new file mode 100644 index 00000000..02b5cff6 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/runs.rs @@ -0,0 +1,57 @@ +//! Complete normal Run lifecycle, including fresh roots across invocations. +use super::{behavior::assert_matches, fixtures::Fixture, heap::*, interpret::Interpreter}; +use crate::control::execution::Program; + +#[test] +fn run_composes_dispatch_callbacks_and_normal_root_completion() { + let mut f = Fixture::new(); + let performed = f.heap.node(Node::Perform(f.request)); + let bound = f.heap.node(Node::Bind(f.next, f.callback)); + let handled = f.heap.node(Node::Handle(f.ret, f.op, f.next)); + for computation in [f.next, performed, bound, handled] { + let mut interpreter = Interpreter::new(f.heap.clone()); + assert_matches( + &mut interpreter, + &f.heap, + Program::Run, + vec![f.state, f.handler, computation], + ) + .unwrap(); + let roots = interpreter.heap.objects[f.heap.objects.len()..] + .iter() + .filter_map(|object| { + if let Object::Node(Node::RootExtent(status)) = object { + Some(*status) + } else { + None + } + }) + .collect::>(); + assert_eq!(roots.len(), 1, "each Run owns exactly one fresh root"); + assert_eq!( + interpreter.heap.status(roots[0]), + Ok(1), + "normal completion closes its root" + ); + let after_first = interpreter.heap.clone(); + assert_matches( + &mut interpreter, + &after_first, + Program::Run, + vec![f.state, f.handler, computation], + ) + .unwrap(); + let roots = interpreter.heap.objects[after_first.objects.len()..] + .iter() + .filter_map(|object| { + if let Object::Node(Node::RootExtent(status)) = object { + Some(*status) + } else { + None + } + }) + .collect::>(); + assert_eq!(roots.len(), 1, "reentry must allocate its own root"); + assert_eq!(interpreter.heap.status(roots[0]), Ok(1)); + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/run.rs b/crates/psrs-backend/src/cc/lower/control/plan/run.rs new file mode 100644 index 00000000..a4cc3ed3 --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/plan/run.rs @@ -0,0 +1,67 @@ +//! The complete normal lifetime of a source Run, before payload recovery. +use super::ir::{Case, Cursor, Exec, Op, Operand, steps}; +use crate::cc::ControlHelperRole as R; +use crate::control::schema::ContextCase; + +pub(super) fn program() -> Exec { + let mut cursor = Cursor::new(); + let mut ops = Vec::new(); + let empty = cursor.bind(&mut ops, Op::EmptySequence); + let root = cursor.bind( + &mut ops, + Op::Helper { + role: R::Start, + args: vec![], + }, + ); + let context = cursor.bind( + &mut ops, + Op::Node { + case: Case::Context(ContextCase::Root), + fields: vec![root.clone()], + }, + ); + let result = cursor.bind( + &mut ops, + Op::Helper { + role: R::Executor, + args: vec![ + Operand::Param(0), + Operand::Param(1), + Operand::Param(2), + empty, + root.clone(), + context, + ], + }, + ); + cursor.bind(&mut ops, Op::CloseBoundary { extent: root }); + steps(ops, Exec::Return { value: result }) +} + +impl super::super::builder::Machine<'_> { + pub(in crate::cc::lower::control) fn run(mut self) -> crate::cc::Function { + use super::super::fields::ControlEmitter; + let parameters = R::Run + .parameters() + .iter() + .map(|kind| { + let shape = self + .representations + .control_schema() + .unwrap() + .shape(*kind, self.layout.continuation); + self.fresh_value(shape) + }) + .collect::>(); + let plan = super::build(super::Program::Run); + let mut body = Vec::new(); + let result = self.expand(&plan, ¶meters, &mut body); + let table = self.representations; + let symbol = self.functions.run; + let function = self.finish(symbol, "control_run", parameters, body, result); + super::check_boundary(&function, table, &plan) + .expect("Run construction must match its checked plan"); + function + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/shape.rs b/crates/psrs-backend/src/cc/lower/control/plan/shape.rs index 3a76f2c5..cd416e8b 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/shape.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/shape.rs @@ -41,3 +41,18 @@ pub(crate) fn shape(exec: &Exec) -> Shape { Exec::Reject { .. } => Shape::Leaf(Terminal::Reject), } } + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn shape_is_sensitive_to_a_dropped_dispatch_arm() { + let mut plan = super::super::executor(); + let before = shape(&plan); + if let Exec::Switch { arms, .. } = &mut plan { + arms.retain(|(tag, _)| *tag != 0); + } + assert_ne!(shape(&plan), before); + } +} diff --git a/crates/psrs-backend/src/cc/lower/control/planning.rs b/crates/psrs-backend/src/cc/lower/control/planning.rs new file mode 100644 index 00000000..cbab42de --- /dev/null +++ b/crates/psrs-backend/src/cc/lower/control/planning.rs @@ -0,0 +1,182 @@ +//! Publish machine bindings before source lowering; query immutable plans by symbol. +use super::{ControlLayout, plan}; +use crate::cc::SignatureId; +use psrs_hir::SymbolId; + +#[derive(Clone, Copy)] +pub(in crate::cc) struct ControlFunctions { + pub(super) emitted: bool, + pub(super) executor: SymbolId, + pub(super) run: SymbolId, + pub(super) resume: SymbolId, + pub(super) clone_sequence: SymbolId, + pub(super) rebuild_sequence: SymbolId, + pub(super) start: SymbolId, + pub(super) check: SymbolId, + pub(super) close: SymbolId, + pub(super) once: SymbolId, + pub(super) cancel: SymbolId, +} + +impl ControlFunctions { + pub(super) fn contracts( + self, + layout: ControlLayout, + ) -> [(SymbolId, SignatureId, crate::cc::ControlHelperRole); 9] { + use crate::cc::ControlHelperRole::*; + [ + (self.executor, layout.executor, Executor), + (self.run, layout.run, Run), + (self.clone_sequence, layout.clone_sequence, CloneSequence), + ( + self.rebuild_sequence, + layout.rebuild_sequence, + RebuildSequence, + ), + (self.start, layout.start, Start), + (self.check, layout.boundary_check, Check), + (self.close, layout.boundary_check, Close), + (self.once, layout.once, Once), + (self.cancel, layout.cancel, Cancel), + ] + } + + pub(super) fn signature(self, layout: ControlLayout, function: SymbolId) -> SignatureId { + self.contracts(layout) + .into_iter() + .find(|(symbol, _, _)| *symbol == function) + .map(|(_, signature, _)| signature) + .expect("predeclared control function") + } +} + +pub(in crate::cc) fn plan_control_helpers( + layout: &mut crate::cc::layout::TypeLayout, + allocator: &std::rc::Rc>, +) -> Option { + let control = layout.control_layout?; + let mut allocator = allocator.borrow_mut(); + let owner = layout.control_owner?; + let functions = ControlFunctions { + emitted: false, + executor: allocator.fresh(owner), + run: allocator.fresh(owner), + resume: allocator.fresh(owner), + clone_sequence: allocator.fresh(owner), + rebuild_sequence: allocator.fresh(owner), + start: allocator.fresh(owner), + check: allocator.fresh(owner), + close: allocator.fresh(owner), + once: allocator.fresh(owner), + cancel: allocator.fresh(owner), + }; + let resumption = crate::cc::ControlResumptionContract { + function: functions.resume, + signature: control.continuation, + }; + let schema = crate::cc::ControlSchema { + computation: control.computation, + sequence: control.sequence, + context: control.context, + extent: control.boundary, + status: control.status, + owner: control.owner, + callback: control.callback, + result_pair: control.pair, + replay_result: control.replay_result, + }; + let helpers = functions + .contracts(control) + .into_iter() + .map( + |(function, signature, role)| crate::cc::ControlHelperContract { + role, + function, + signature, + }, + ) + .collect(); + layout + .representations + .freeze_control_plan(helpers, resumption, schema) + .expect("machine planning must satisfy its named schema"); + Some(functions) +} + +/// The checked plan shape for a machine function symbol, if it is one. +pub(crate) fn plan_shape_for( + symbol: psrs_hir::SymbolId, + table: &crate::cc::RepresentationTable, +) -> Option { + plan_for_symbol(symbol, table).map(|plan| plan::shape_of(plan.exec())) +} + +pub(super) fn plan_for_symbol( + symbol: psrs_hir::SymbolId, + table: &crate::cc::RepresentationTable, +) -> Option { + use crate::cc::ControlHelperRole as R; + let role = table + .control_helpers() + .iter() + .find(|helper| helper.function() == symbol) + .map(|helper| helper.role()); + let resumption = table + .control_resumption() + .is_some_and(|raw| raw.function() == symbol); + let program = match role { + Some(R::Executor) => plan::Program::Executor, + Some(R::Run) => plan::Program::Run, + Some(R::CloneSequence) => plan::Program::CloneSequence, + Some(R::RebuildSequence) => plan::Program::RebuildSequence, + Some(R::Start) => plan::Program::Start, + Some(R::Check) => plan::Program::Check, + Some(R::Close) => plan::Program::Close, + Some(R::Once) => plan::Program::Once, + Some(R::Cancel) => plan::Program::Cancel, + None if resumption => plan::Program::RawResume, + None => return None, + }; + Some(plan::build(program)) +} + +/// The external helper symbols a machine function tail-calls, per its plan. +/// +/// Self tail calls are loopified into loop back-edges by P9, so they are +/// excluded; the MIR boundary check compares the rest against actual +/// `ReturnCall` targets. +pub(crate) fn plan_external_targets( + symbol: psrs_hir::SymbolId, + table: &crate::cc::RepresentationTable, +) -> Option> { + use crate::cc::ControlHelperRole; + fn collect(exec: &plan::PlanExec, out: &mut std::collections::HashSet) { + match exec { + plan::PlanExec::Steps { next, .. } => collect(next, out), + plan::PlanExec::Switch { arms, .. } => { + for (_, arm) in arms { + collect(arm, out); + } + } + plan::PlanExec::Advance { .. } => { + out.insert(ControlHelperRole::Executor); + } + plan::PlanExec::Tail { role, .. } => { + out.insert(*role); + } + _ => {} + } + } + let plan = plan_for_symbol(symbol, table)?; + let mut wanted = std::collections::HashSet::new(); + collect(plan.exec(), &mut wanted); + let mut targets = std::collections::HashSet::new(); + for role in wanted { + if let Some(helper) = table.control_helper(role) + && helper.function() != symbol + { + targets.insert(helper.function()); + } + } + Some(targets) +} diff --git a/crates/psrs-backend/src/cc/lower/control/replay.rs b/crates/psrs-backend/src/cc/lower/control/replay.rs index e1e23cd6..44b29323 100644 --- a/crates/psrs-backend/src/cc/lower/control/replay.rs +++ b/crates/psrs-backend/src/cc/lower/control/replay.rs @@ -5,21 +5,21 @@ //! replay-result projection stays here because the executor also uses it. use super::builder::{Machine, repr}; +use super::fields::ControlEmitter; use crate::cc::{Assignment, AssignmentKind, Function, ValueId}; impl Machine<'_> { pub(super) fn clone_sequence(mut self) -> Function { - let queue = self.lower.fresh(repr(self.layout.sequence)); - let todo = self.lower.fresh(repr(self.layout.sequence)); - let reversed = self.lower.fresh(repr(self.layout.sequence)); - let active = self.lower.fresh(repr(self.layout.boundary)); - let parent = self.lower.fresh(repr(self.layout.boundary)); + let queue = self.fresh_value(repr(self.layout.sequence)); + let todo = self.fresh_value(repr(self.layout.sequence)); + let reversed = self.fresh_value(repr(self.layout.sequence)); + let active = self.fresh_value(repr(self.layout.boundary)); + let parent = self.fresh_value(repr(self.layout.boundary)); let params = [queue, todo, reversed, active, parent]; - let program = super::plan::clone_sequence(); - super::plan::verify_plan(&program).expect("clone_sequence plan must be well-formed"); + let program = super::plan::build(super::plan::Program::CloneSequence); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, ¶ms, &mut body); + let representations = self.representations; let symbol = self.functions.clone_sequence; let function = self.finish( symbol, @@ -34,16 +34,15 @@ impl Machine<'_> { } pub(super) fn rebuild_sequence(mut self) -> Function { - let reversed = self.lower.fresh(repr(self.layout.sequence)); - let result_queue = self.lower.fresh(repr(self.layout.sequence)); - let active = self.lower.fresh(repr(self.layout.boundary)); - let parent = self.lower.fresh(repr(self.layout.boundary)); + let reversed = self.fresh_value(repr(self.layout.sequence)); + let result_queue = self.fresh_value(repr(self.layout.sequence)); + let active = self.fresh_value(repr(self.layout.boundary)); + let parent = self.fresh_value(repr(self.layout.boundary)); let params = [reversed, result_queue, active, parent]; - let program = super::plan::rebuild_sequence(); - super::plan::verify_plan(&program).expect("rebuild_sequence plan must be well-formed"); + let program = super::plan::build(super::plan::Program::RebuildSequence); let mut body = Vec::new(); - let result = self.expand(&program, &mut Vec::new(), ¶ms, &mut body); - let representations = self.lower.representations; + let result = self.expand(&program, ¶ms, &mut body); + let representations = self.representations; let symbol = self.functions.rebuild_sequence; let function = self.finish( symbol, @@ -65,7 +64,7 @@ impl Machine<'_> { ) -> ValueId { let representation = self.layout.replay_result; let Some(crate::cc::Representation::Product { fields }) = - self.lower.representations.representation(representation) + self.representations.representation(representation) else { unreachable!("predeclared replay result product"); }; diff --git a/crates/psrs-backend/src/cc/mod.rs b/crates/psrs-backend/src/cc/mod.rs index 06ea7305..c68e1b54 100644 --- a/crates/psrs-backend/src/cc/mod.rs +++ b/crates/psrs-backend/src/cc/mod.rs @@ -12,6 +12,7 @@ mod case; mod control; pub(crate) mod value_identity; pub(crate) use control::ControlSchema; +pub use control::FrozenControlPlan; pub use control::{ ControlContract, ControlContractId, ControlDomain, ControlHelperContract, ControlHelperId, ControlHelperRole, ControlResumptionContract, SourceTypeIdentityId, TypeConstructorIdentity, diff --git a/crates/psrs-backend/src/cc/projection.rs b/crates/psrs-backend/src/cc/projection.rs index fd132bbe..919c3a66 100644 --- a/crates/psrs-backend/src/cc/projection.rs +++ b/crates/psrs-backend/src/cc/projection.rs @@ -417,8 +417,8 @@ mod tests { nullable: false, heap: RefShape::Erased, }); - let representations = RepresentationTable { - representations: vec![ + let representations = RepresentationTable::from_parts( + vec![ Representation::Product { fields: vec![ValueShape::String], }, @@ -435,12 +435,11 @@ mod tests { ], }, ], - signatures: Vec::new(), - product_labels: [(ReprId(0), vec!["name".to_string()])] + Vec::new(), + [(ReprId(0), vec!["name".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let record_types = [(record, ReprId(0))].into_iter().collect(); let array_types = HashMap::new(); let constructor_types = [(just, ReprId(1)), (nothing, ReprId(1))] diff --git a/crates/psrs-backend/src/cc/representation.rs b/crates/psrs-backend/src/cc/representation.rs index 714e7072..c7644e2d 100644 --- a/crates/psrs-backend/src/cc/representation.rs +++ b/crates/psrs-backend/src/cc/representation.rs @@ -225,22 +225,8 @@ fn storage_case( #[derive(Clone, Debug, PartialEq, Eq, Default)] pub struct RepresentationTable { - /// Semantic helper bindings are fixed before any function body is lowered. - pub control_helpers: Vec, - pub control_resumption: Option, - /// The frozen named placement of the machine schema. Planning fixes it once; - /// consumers read named carriers from it instead of inferring a role from a - /// helper signature offset. `None` means this module does not use control. - pub control_schema: Option, - /// The closed-run pair is planned before payload erasure; consumers must - /// not reconstruct its nominal identity from record labels or field count. - pub control_result_pair: Option, - /// Source control contracts are predeclared by layout, before lowering - /// emits any factory or executor bodies. - pub control_contracts: Vec, - /// Rigid semantic identity is allocated using Core's relation before - /// arena indices are erased. The quoted types retain lexical structure. - pub source_type_identities: Vec, + /// Source planning publishes immutable machine metadata before CC lowering. + pub(in crate::cc) control: super::control::ControlPlanning, pub representations: Vec, pub signatures: Vec, /// Canonical logical labels for record products; positional products do @@ -249,6 +235,20 @@ pub struct RepresentationTable { } impl RepresentationTable { + /// Construct ordinary IR layouts without publishing control-machine metadata. + pub fn from_parts( + representations: Vec, + signatures: Vec, + product_labels: std::collections::HashMap>, + ) -> Self { + Self { + representations, + signatures, + product_labels, + ..Self::default() + } + } + pub fn reserve(&mut self) -> ReprId { let id = ReprId(self.representations.len() as u32); // A temporary product is replaced before the table leaves P8. Keeping diff --git a/crates/psrs-backend/src/cc/verify/ops/control.rs b/crates/psrs-backend/src/cc/verify/ops/control.rs index ef79a72e..8bb93fb9 100644 --- a/crates/psrs-backend/src/cc/verify/ops/control.rs +++ b/crates/psrs-backend/src/cc/verify/ops/control.rs @@ -23,7 +23,7 @@ pub(super) fn verify( unreachable!() }; let proof = table - .control_contracts + .control_contracts() .get(contract.0 as usize) .ok_or_else(|| { assignment_error( @@ -97,7 +97,7 @@ pub(super) fn verify( }, ) if signatures.get(function) == table.signature(*signature) && table - .control_helpers + .control_helpers() .get(contract.0 as usize) .is_some_and(|helper| helper.role() == *role) => { @@ -131,7 +131,7 @@ pub(super) fn verify( .find(|candidate| candidate.destination == origin) { let producer = table - .control_contracts + .control_contracts() .get(contract.0 as usize) .ok_or_else(|| { assignment_error(assignment, "control operand has no checked source contract") diff --git a/crates/psrs-backend/src/cc/verify/ops/table.rs b/crates/psrs-backend/src/cc/verify/ops/table.rs index 1b639670..5f609209 100644 --- a/crates/psrs-backend/src/cc/verify/ops/table.rs +++ b/crates/psrs-backend/src/cc/verify/ops/table.rs @@ -10,7 +10,7 @@ pub(crate) fn verify_table( ) -> Result<(), Vec> { let mut roles = HashSet::new(); let mut helpers = HashSet::new(); - for helper in &table.control_helpers { + for helper in table.control_helpers() { if !roles.insert(helper.role()) || !helpers.insert(helper.function()) || table.signature(helper.signature()).is_none() @@ -21,7 +21,7 @@ pub(crate) fn verify_table( )); } } - if !table.control_helpers.is_empty() + if !table.control_helpers().is_empty() && crate::cc::ControlHelperRole::ALL .iter() .any(|role| !roles.contains(role)) @@ -34,13 +34,13 @@ pub(crate) fn verify_table( if let Err(message) = table.verify_control_schema() { return Err(table_error(span, message)); } - if !table.control_helpers.is_empty() { - let valid = table.control_resumption.as_ref().is_some_and(|resume| { + if !table.control_helpers().is_empty() { + let valid = table.control_resumption().is_some_and(|resume| { !helpers.contains(&resume.function()) && table.signature(resume.signature()).is_some() && table.control_checkpoint_schema().is_some() && table - .control_helpers + .control_helpers() .iter() .find(|helper| helper.role() == crate::cc::ControlHelperRole::Once) .and_then(|helper| table.signature(helper.signature())) @@ -56,17 +56,17 @@ pub(crate) fn verify_table( "control machine has no valid raw resumption binding", )); } - } else if table.control_resumption.is_some() { + } else if table.control_resumption().is_some() { return Err(table_error( span, "raw resumption binding has no control helper schema", )); } - for proof in &table.control_contracts { + for proof in table.control_contracts() { if proof.argument_identities().len() != proof.arguments().len() || std::iter::once(&proof.result_identity()) .chain(proof.argument_identities()) - .any(|id| table.source_type_identities.get(id.0 as usize).is_none()) + .any(|id| table.source_type_identities().get(id.0 as usize).is_none()) { return Err(table_error( span, diff --git a/crates/psrs-backend/src/control/execution/mod.rs b/crates/psrs-backend/src/control/execution/mod.rs index e40a1606..d237b304 100644 --- a/crates/psrs-backend/src/control/execution/mod.rs +++ b/crates/psrs-backend/src/control/execution/mod.rs @@ -1,32 +1,243 @@ -//! The named action inventory of the flat driver. -//! -//! Every selection the operational semantics admits has exactly one entry. The -//! checked construction plan records them and `plan::check` requires the whole -//! inventory, so a missing case is a construction failure rather than a silent -//! gap. +//! Complete action inventory from the operational semantics, independent of CC. +use super::schema::{ComputationCase as C, ContextCase as X, ExtentCase as E, SequenceCase as Q}; +use super::schema::{ControlHelperRole as R, FieldKind}; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub(crate) enum Program { + Executor, + Run, + CloneSequence, + RebuildSequence, + Check, + Close, + Start, + Once, + Cancel, + RawResume, +} + +impl Program { + pub(crate) fn helper(self) -> Option { + Some(match self { + Self::Executor => R::Executor, + Self::Run => R::Run, + Self::CloneSequence => R::CloneSequence, + Self::RebuildSequence => R::RebuildSequence, + Self::Check => R::Check, + Self::Close => R::Close, + Self::Start => R::Start, + Self::Once => R::Once, + Self::Cancel => R::Cancel, + Self::RawResume => return None, + }) + } + + pub(crate) fn parameters(self) -> &'static [FieldKind] { + self.helper() + .map_or(&[FieldKind::Callable, FieldKind::Payload], R::parameters) + } + + pub(crate) fn result(self) -> FieldKind { + self.helper().map_or(FieldKind::Payload, R::result) + } +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub(crate) enum Outcome { + Advance, + Publish, + Return, + Tail(R), + Reject, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub(crate) enum Selection { + Computation(C), + Sequence(Q), + Context(X), + Extent(E), +} #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub(crate) enum ActionId { - PerformRoot, ReturnEmptyRoot, + ReturnEmptyScoped, ReturnCons, ReturnFinish, AppendEmpty, AppendCons, AppendAppend, AppendFinish, + PerformRoot, + PerformScoped, + Bind, + Resume, + HandleEmpty, + HandleCons, + HandleFinish, + HandleAppendEmpty, + HandleAppendCons, + HandleAppendAppend, + HandleAppendFinish, + OwnedResume, + CloneEmptyDone, + CloneEmptyNext, + CloneEmptyRejectCons, + CloneEmptyRejectFinish, + CloneCons, + CloneAppend, + CloneFinish, + RebuildEmpty, + RebuildCons, + RebuildRejectAppend, + RebuildFinish, + CheckRoot, + CheckScoped, + CloseRoot, + CloseScoped, + Start, + Once, + Cancel, + RawResume, + Run, } impl ActionId { - /// The complete required action inventory of the flat driver. - pub(crate) const ALL: [Self; 8] = [ - Self::PerformRoot, + pub(crate) fn outcome(self) -> Outcome { + match self { + Self::ReturnEmptyRoot => Outcome::Publish, + Self::CloneEmptyDone => Outcome::Tail(R::RebuildSequence), + Self::CloneEmptyNext | Self::CloneCons | Self::CloneAppend | Self::CloneFinish => { + Outcome::Tail(R::CloneSequence) + } + Self::CloneEmptyRejectCons + | Self::CloneEmptyRejectFinish + | Self::RebuildRejectAppend => Outcome::Reject, + Self::RebuildCons | Self::RebuildFinish => Outcome::Tail(R::RebuildSequence), + Self::CheckScoped => Outcome::Tail(R::Check), + Self::RebuildEmpty + | Self::CheckRoot + | Self::CloseRoot + | Self::CloseScoped + | Self::Start + | Self::Once + | Self::Cancel + | Self::RawResume + | Self::Run => Outcome::Return, + _ => Outcome::Advance, + } + } + pub(crate) const ALL: [Self; 40] = [ Self::ReturnEmptyRoot, + Self::ReturnEmptyScoped, Self::ReturnCons, Self::ReturnFinish, Self::AppendEmpty, Self::AppendCons, Self::AppendAppend, Self::AppendFinish, + Self::PerformRoot, + Self::PerformScoped, + Self::Bind, + Self::Resume, + Self::HandleEmpty, + Self::HandleCons, + Self::HandleFinish, + Self::HandleAppendEmpty, + Self::HandleAppendCons, + Self::HandleAppendAppend, + Self::HandleAppendFinish, + Self::OwnedResume, + Self::CloneEmptyDone, + Self::CloneEmptyNext, + Self::CloneEmptyRejectCons, + Self::CloneEmptyRejectFinish, + Self::CloneCons, + Self::CloneAppend, + Self::CloneFinish, + Self::RebuildEmpty, + Self::RebuildCons, + Self::RebuildRejectAppend, + Self::RebuildFinish, + Self::CheckRoot, + Self::CheckScoped, + Self::CloseRoot, + Self::CloseScoped, + Self::Start, + Self::Once, + Self::Cancel, + Self::RawResume, + Self::Run, ]; + + /// Every required action has one exact selection path in one program. + pub(crate) fn selection(self) -> (Program, &'static [Selection]) { + use Selection::{Computation as c, Context as x, Extent as e, Sequence as q}; + match self { + Self::ReturnEmptyRoot => (Program::Executor, &[c(C::Return), q(Q::Empty), x(X::Root)]), + Self::ReturnEmptyScoped => ( + Program::Executor, + &[c(C::Return), q(Q::Empty), x(X::Scoped)], + ), + Self::ReturnCons => (Program::Executor, &[c(C::Return), q(Q::Cons)]), + Self::ReturnFinish => (Program::Executor, &[c(C::Return), q(Q::Finish)]), + Self::AppendEmpty => ( + Program::Executor, + &[c(C::Return), q(Q::Append), q(Q::Empty)], + ), + Self::AppendCons => (Program::Executor, &[c(C::Return), q(Q::Append), q(Q::Cons)]), + Self::AppendAppend => ( + Program::Executor, + &[c(C::Return), q(Q::Append), q(Q::Append)], + ), + Self::AppendFinish => ( + Program::Executor, + &[c(C::Return), q(Q::Append), q(Q::Finish)], + ), + Self::PerformRoot => (Program::Executor, &[c(C::Perform), x(X::Root)]), + Self::PerformScoped => (Program::Executor, &[c(C::Perform), x(X::Scoped)]), + Self::Bind => (Program::Executor, &[c(C::Bind)]), + Self::Resume => (Program::Executor, &[c(C::Resume)]), + Self::HandleEmpty => (Program::Executor, &[c(C::Handle), q(Q::Empty)]), + Self::HandleCons => (Program::Executor, &[c(C::Handle), q(Q::Cons)]), + Self::HandleFinish => (Program::Executor, &[c(C::Handle), q(Q::Finish)]), + Self::HandleAppendEmpty => ( + Program::Executor, + &[c(C::Handle), q(Q::Append), q(Q::Empty)], + ), + Self::HandleAppendCons => { + (Program::Executor, &[c(C::Handle), q(Q::Append), q(Q::Cons)]) + } + Self::HandleAppendAppend => ( + Program::Executor, + &[c(C::Handle), q(Q::Append), q(Q::Append)], + ), + Self::HandleAppendFinish => ( + Program::Executor, + &[c(C::Handle), q(Q::Append), q(Q::Finish)], + ), + Self::OwnedResume => (Program::Executor, &[c(C::OwnedResume)]), + Self::CloneEmptyDone => (Program::CloneSequence, &[q(Q::Empty), q(Q::Empty)]), + Self::CloneEmptyNext => (Program::CloneSequence, &[q(Q::Empty), q(Q::Append)]), + Self::CloneEmptyRejectCons => (Program::CloneSequence, &[q(Q::Empty), q(Q::Cons)]), + Self::CloneEmptyRejectFinish => (Program::CloneSequence, &[q(Q::Empty), q(Q::Finish)]), + Self::CloneCons => (Program::CloneSequence, &[q(Q::Cons)]), + Self::CloneAppend => (Program::CloneSequence, &[q(Q::Append)]), + Self::CloneFinish => (Program::CloneSequence, &[q(Q::Finish)]), + Self::RebuildEmpty => (Program::RebuildSequence, &[q(Q::Empty)]), + Self::RebuildCons => (Program::RebuildSequence, &[q(Q::Cons)]), + Self::RebuildRejectAppend => (Program::RebuildSequence, &[q(Q::Append)]), + Self::RebuildFinish => (Program::RebuildSequence, &[q(Q::Finish)]), + Self::CheckRoot => (Program::Check, &[e(E::Root)]), + Self::CheckScoped => (Program::Check, &[e(E::Scoped)]), + Self::CloseRoot => (Program::Close, &[e(E::Root)]), + Self::CloseScoped => (Program::Close, &[e(E::Scoped)]), + Self::Start => (Program::Start, &[]), + Self::Once => (Program::Once, &[]), + Self::Cancel => (Program::Cancel, &[]), + Self::RawResume => (Program::RawResume, &[]), + Self::Run => (Program::Run, &[]), + } + } } diff --git a/crates/psrs-backend/src/control/schema.rs b/crates/psrs-backend/src/control/schema.rs index 976381fb..edce17ac 100644 --- a/crates/psrs-backend/src/control/schema.rs +++ b/crates/psrs-backend/src/control/schema.rs @@ -11,6 +11,74 @@ //! layout planning checks that the physical frame it emits has exactly the //! declared arity. +/// Logical storage roles, before any CC representation or physical MIR layout. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum FieldKind { + Payload, + Callable, + Computation, + Sequence, + Context, + Extent, + Status, + Owner, + Callback, + ResultPair, + ReplayResult, +} + +/// Direct-call helper roles. Raw resume uses the closure receiver protocol. +#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] +pub enum ControlHelperRole { + Executor, + Run, + CloneSequence, + RebuildSequence, + Start, + Check, + Close, + Once, + Cancel, +} + +impl ControlHelperRole { + pub(crate) const ALL: [Self; 9] = [ + Self::Executor, + Self::Run, + Self::CloneSequence, + Self::RebuildSequence, + Self::Start, + Self::Check, + Self::Close, + Self::Once, + Self::Cancel, + ]; + + pub(crate) fn parameters(self) -> &'static [FieldKind] { + use FieldKind::*; + match self { + Self::Run => &[Payload, Callable, Computation], + Self::Executor => &[Payload, Callable, Computation, Sequence, Extent, Context], + Self::CloneSequence => &[Sequence, Sequence, Sequence, Extent, Extent], + Self::RebuildSequence => &[Sequence, Sequence, Extent, Extent], + Self::Start => &[], + Self::Check | Self::Close => &[Extent], + Self::Once => &[Callable], + Self::Cancel => &[Owner], + } + } + + pub(crate) fn result(self) -> FieldKind { + use FieldKind::*; + match self { + Self::Executor | Self::Run => Payload, + Self::CloneSequence | Self::RebuildSequence => ReplayResult, + Self::Start | Self::Check | Self::Close => Extent, + Self::Once | Self::Cancel => Owner, + } + } +} + /// The six cases of a `Control f a` computation frame. #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub enum ComputationCase { @@ -23,6 +91,16 @@ pub enum ComputationCase { } impl ComputationCase { + pub(crate) fn fields(self) -> &'static [FieldKind] { + use FieldKind::*; + match self { + Self::Return | Self::Perform => &[Payload], + Self::Bind => &[Computation, Callable], + Self::Resume => &[Payload, Sequence, Extent], + Self::Handle => &[Callable, Callable, Computation], + Self::OwnedResume => &[Owner, Payload], + } + } pub const ALL: [Self; 6] = [ Self::Return, Self::Perform, @@ -35,16 +113,6 @@ impl ComputationCase { pub const fn tag(self) -> u32 { self as u32 } - - pub const fn field_count(self) -> usize { - match self { - Self::Return | Self::Perform => 1, - Self::Bind => 2, - Self::Resume => 3, - Self::Handle => 3, - Self::OwnedResume => 2, - } - } } /// Fields of the computation cases whose payload is not a single erased value. @@ -77,19 +145,20 @@ pub enum SequenceCase { } impl SequenceCase { + pub(crate) fn fields(self) -> &'static [FieldKind] { + use FieldKind::*; + match self { + Self::Empty => &[], + Self::Cons => &[Callable, Sequence], + Self::Append => &[Sequence, Sequence], + Self::Finish => &[Extent, Sequence, Extent], + } + } pub const ALL: [Self; 4] = [Self::Empty, Self::Cons, Self::Append, Self::Finish]; pub const fn tag(self) -> u32 { self as u32 } - - pub const fn field_count(self) -> usize { - match self { - Self::Empty => 0, - Self::Cons | Self::Append => 2, - Self::Finish => 3, - } - } } /// Fields of the sequencing spine. @@ -111,18 +180,18 @@ pub enum ContextCase { } impl ContextCase { + pub(crate) fn fields(self) -> &'static [FieldKind] { + use FieldKind::*; + match self { + Self::Root => &[Extent], + Self::Scoped => &[Callable, Callable, Sequence, Extent, Context, Extent], + } + } pub const ALL: [Self; 2] = [Self::Root, Self::Scoped]; pub const fn tag(self) -> u32 { self as u32 } - - pub const fn field_count(self) -> usize { - match self { - Self::Root => 1, - Self::Scoped => 6, - } - } } /// Fields of a dispatch context. @@ -144,18 +213,18 @@ pub enum ExtentCase { } impl ExtentCase { + pub(crate) fn fields(self) -> &'static [FieldKind] { + use FieldKind::*; + match self { + Self::Root => &[Status], + Self::Scoped => &[Status, Extent], + } + } pub const ALL: [Self; 2] = [Self::Root, Self::Scoped]; pub const fn tag(self) -> u32 { self as u32 } - - pub const fn field_count(self) -> usize { - match self { - Self::Root => 1, - Self::Scoped => 2, - } - } } /// Fields of a lifetime extent. @@ -171,17 +240,14 @@ pub enum OwnerCase { } impl OwnerCase { + pub(crate) fn fields(self) -> &'static [FieldKind] { + &[FieldKind::Callback, FieldKind::Status] + } pub const ALL: [Self; 1] = [Self::OneShot]; pub const fn tag(self) -> u32 { self as u32 } - - pub const fn field_count(self) -> usize { - match self { - Self::OneShot => 2, - } - } } /// Fields of a one-shot owner object. diff --git a/crates/psrs-backend/src/mir/control/contracts.rs b/crates/psrs-backend/src/mir/control/contracts.rs index 02615c03..6c30b036 100644 --- a/crates/psrs-backend/src/mir/control/contracts.rs +++ b/crates/psrs-backend/src/mir/control/contracts.rs @@ -4,15 +4,15 @@ use crate::mir::{Instruction, Module}; impl Module { pub fn control_helpers(&self) -> &[crate::cc::ControlHelperContract] { - self.layout - .as_ref() - .map_or(&[], |layout| &layout.representation_table().control_helpers) + self.layout.as_ref().map_or(&[], |layout| { + layout.representation_table().control_helpers() + }) } /// Source contracts remain immutable and inspectable after physical layout. pub fn control_contracts(&self) -> &[crate::cc::ControlContract] { self.layout.as_ref().map_or(&[], |layout| { - layout.representation_table().control_contracts.as_slice() + layout.representation_table().control_contracts() }) } } diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs index 6b9b1887..cca17385 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/collections.rs @@ -68,8 +68,8 @@ fn base( result: reference(0), }), }], - representations: cc::RepresentationTable { - representations: vec![ + representations: cc::RepresentationTable::from_parts( + vec![ Representation::Variant { cases: vec![ VariantCase { @@ -84,10 +84,9 @@ fn base( }, inner, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }, + Vec::new(), + Default::default(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs index 8195683a..628744d6 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/fixtures.rs @@ -62,12 +62,8 @@ pub(super) fn fixture_with_representations( Representation::Variant { cases }, ]; representations.extend(extra); - let representations = cc::RepresentationTable { - representations, - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + let representations = + cc::RepresentationTable::from_parts(representations, Vec::new(), Default::default()); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -156,8 +152,8 @@ pub(super) fn parameter_fixture() -> (cc::Module, ExternalBindings, Resolve) { ) .expect("the parameter WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -174,10 +170,9 @@ pub(super) fn parameter_fixture() -> (cc::Module, ExternalBindings, Resolve) { ], }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs index 59e43cb1..f3418434 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/indirect.rs @@ -25,8 +25,8 @@ pub(super) fn indirect_aggregate_fixture() -> (cc::Module, ExternalBindings, Res .push_str("aggregate-indirect.wit", &wit) .expect("the indirect aggregate WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -43,10 +43,9 @@ pub(super) fn indirect_aggregate_fixture() -> (cc::Module, ExternalBindings, Res ], }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs index aa80b4f2..31bc2cb6 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/large.rs @@ -22,8 +22,8 @@ pub(super) fn large_record_fixture() -> (cc::Module, ExternalBindings, Resolve) ) .expect("the large record WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -43,15 +43,14 @@ pub(super) fn large_record_fixture() -> (cc::Module, ExternalBindings, Resolve) ], }, ], - signatures: Vec::new(), - product_labels: [( + Vec::new(), + [( ReprId(1), vec!["a".to_string(), "b".to_string(), "c".to_string()], )] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -135,8 +134,8 @@ pub(super) fn large_unit_result_fixture() -> (cc::Module, ExternalBindings, Reso ) .expect("the large unit result WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -158,15 +157,14 @@ pub(super) fn large_unit_result_fixture() -> (cc::Module, ExternalBindings, Reso ], }, ], - signatures: Vec::new(), - product_labels: [( + Vec::new(), + [( ReprId(1), vec!["a".to_string(), "b".to_string(), "c".to_string()], )] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs index 4f9d922c..b7b1d0c7 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/list_record.rs @@ -39,12 +39,11 @@ fn finish( result, }), }], - representations: cc::RepresentationTable { + representations: cc::RepresentationTable::from_parts( representations, - signatures: Vec::new(), - product_labels: product_labels.into_iter().collect(), - ..Default::default() - }, + Vec::new(), + product_labels.into_iter().collect(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs index 4f582639..ff2a6226 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/nested.rs @@ -19,8 +19,8 @@ pub(super) fn nested_variant_fixture() -> (cc::Module, ExternalBindings, Resolve ) .expect("the nested variant WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -51,10 +51,9 @@ pub(super) fn nested_variant_fixture() -> (cc::Module, ExternalBindings, Resolve ], }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -139,8 +138,8 @@ pub(super) fn nested_record_fixture() -> (cc::Module, ExternalBindings, Resolve) ) .expect("the nested record WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -162,12 +161,11 @@ pub(super) fn nested_record_fixture() -> (cc::Module, ExternalBindings, Resolve) fields: vec![ValueShape::Integer, ValueShape::Boolean], }, ], - signatures: Vec::new(), - product_labels: [(ReprId(2), vec!["x".to_string(), "y".to_string()])] + Vec::new(), + [(ReprId(2), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -250,8 +248,8 @@ pub(super) fn nested_record_parameter_fixture() -> (cc::Module, ExternalBindings ) .expect("the nested record parameter WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -271,12 +269,11 @@ pub(super) fn nested_record_parameter_fixture() -> (cc::Module, ExternalBindings fields: vec![ValueShape::Integer, ValueShape::Boolean], }, ], - signatures: Vec::new(), - product_labels: [(ReprId(2), vec!["x".to_string(), "y".to_string()])] + Vec::new(), + [(ReprId(2), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs index d28533c5..61311e9c 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/record_fields.rs @@ -21,8 +21,8 @@ pub(super) fn record_with_aggregate_field_fixture() -> (cc::Module, ExternalBind ) .expect("the record field WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -57,12 +57,11 @@ pub(super) fn record_with_aggregate_field_fixture() -> (cc::Module, ExternalBind ], }, ], - signatures: Vec::new(), - product_labels: [(ReprId(2), vec!["inner".to_string()])] + Vec::new(), + [(ReprId(2), vec!["inner".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -151,8 +150,8 @@ pub(super) fn record_with_aggregate_field_parameter_fixture() ) .expect("the record field parameter WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -187,12 +186,11 @@ pub(super) fn record_with_aggregate_field_parameter_fixture() ], }, ], - signatures: Vec::new(), - product_labels: [(ReprId(2), vec!["inner".to_string()])] + Vec::new(), + [(ReprId(2), vec!["inner".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs index d0a41793..2633ba9e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/resource_result.rs @@ -22,8 +22,8 @@ pub(super) fn resource_result_fixture() -> (cc::Module, ExternalBindings, Resolv ) .expect("the resource result WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -40,10 +40,9 @@ pub(super) fn resource_result_fixture() -> (cc::Module, ExternalBindings, Resolv ], }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs index ff7402e0..e1293188 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/aggregate/scalars.rs @@ -21,8 +21,8 @@ pub(super) fn wide_scalar_fixture() -> (cc::Module, ExternalBindings, Resolve) { ) .expect("the wide scalar WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Integer, }, @@ -43,10 +43,9 @@ pub(super) fn wide_scalar_fixture() -> (cc::Module, ExternalBindings, Resolve) { ], }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -133,8 +132,8 @@ pub(super) fn wide_scalar_parameter_fixture() -> (cc::Module, ExternalBindings, ) .expect("the wide scalar parameter WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ Representation::Box { value: ValueShape::Number, }, @@ -151,10 +150,9 @@ pub(super) fn wide_scalar_parameter_fixture() -> (cc::Module, ExternalBindings, ], }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs index 75c5c4db..2c208833 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/composite/fixture.rs @@ -37,8 +37,8 @@ pub(super) fn composite_indirect_fixture() -> (cc::Module, ExternalBindings, Res let flags_shape = product_shape(0); let details_shape = product_shape(1); let payload_shape = product_shape(2); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ cc::Representation::Product { fields: vec![ValueShape::Boolean; 5], }, @@ -55,8 +55,8 @@ pub(super) fn composite_indirect_fixture() -> (cc::Module, ExternalBindings, Res element: ValueShape::Integer, }, ], - signatures: Vec::new(), - product_labels: [ + Vec::new(), + [ ( cc::ReprId(0), vec!["audit", "debug", "execute", "read", "write"], @@ -67,8 +67,7 @@ pub(super) fn composite_indirect_fixture() -> (cc::Module, ExternalBindings, Res .into_iter() .map(|(id, labels)| (id, labels.into_iter().map(String::from).collect())) .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs index 0525f625..8462aae3 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/aggregate.rs @@ -16,8 +16,8 @@ pub(crate) fn flags_fixture() -> (cc::Module, ExternalBindings, Resolve) { // Source flag fields are sorted alphabetically: `read` then `write`. WIT // declares `write` before `read`, so `write` is bit 0 and `read` is bit 1. - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ cc::Representation::Product { fields: vec![ValueShape::Boolean, ValueShape::Boolean], }, @@ -25,12 +25,11 @@ pub(crate) fn flags_fixture() -> (cc::Module, ExternalBindings, Resolve) { element: reference(0), }, ], - signatures: Vec::new(), - product_labels: [(cc::ReprId(0), vec!["read".to_string(), "write".to_string()])] + Vec::new(), + [(cc::ReprId(0), vec!["read".to_string(), "write".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -143,14 +142,13 @@ pub(crate) fn handle_fixture() -> (cc::Module, ExternalBindings, Resolve) { ) .expect("the handle list WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![cc::Representation::Array { + let representations = cc::RepresentationTable::from_parts( + vec![cc::Representation::Array { element: ValueShape::Integer, }], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -242,8 +240,8 @@ pub(crate) fn tuple_fixture() -> (cc::Module, ExternalBindings, Resolve) { .expect("the tuple list WIT fixture should resolve"); // DEC-13 maps `tuple` to the closed record `{ _1, _2 }`. - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ cc::Representation::Product { fields: vec![ValueShape::String, ValueShape::String], }, @@ -251,12 +249,11 @@ pub(crate) fn tuple_fixture() -> (cc::Module, ExternalBindings, Resolve) { element: reference(0), }, ], - signatures: Vec::new(), - product_labels: [(cc::ReprId(0), vec!["_1".to_string(), "_2".to_string()])] + Vec::new(), + [(cc::ReprId(0), vec!["_1".to_string(), "_2".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -377,14 +374,13 @@ fn handle_result(result: &str) -> (cc::Module, ExternalBindings, Resolve) { ) .expect("the handle list result WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![cc::Representation::Array { + let representations = cc::RepresentationTable::from_parts( + vec![cc::Representation::Array { element: ValueShape::Integer, }], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs index 06aa6ce3..1b76949e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/fixed.rs @@ -88,14 +88,13 @@ pub(crate) fn fixed_list_fixture() -> (cc::Module, ExternalBindings, Resolve) { result: ValueShape::Integer, }), }], - representations: cc::RepresentationTable { - representations: vec![Representation::Array { + representations: cc::RepresentationTable::from_parts( + vec![Representation::Array { element: ValueShape::Integer, }], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }, + Vec::new(), + Default::default(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), @@ -144,14 +143,13 @@ pub(crate) fn fixed_list_result_fixture() -> (cc::Module, ExternalBindings, Reso result: reference(0), }), }], - representations: cc::RepresentationTable { - representations: vec![Representation::Array { + representations: cc::RepresentationTable::from_parts( + vec![Representation::Array { element: ValueShape::Integer, }], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }, + Vec::new(), + Default::default(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs index 09ae1668..19e3403e 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/mod.rs @@ -40,8 +40,8 @@ pub(super) fn fixture() -> (cc::Module, ExternalBindings, Resolve) { ) .expect("the record list WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ cc::Representation::Product { fields: vec![ValueShape::Integer, ValueShape::Number], }, @@ -49,12 +49,11 @@ pub(super) fn fixture() -> (cc::Module, ExternalBindings, Resolve) { element: reference(0), }, ], - signatures: Vec::new(), - product_labels: [(cc::ReprId(0), vec!["x".to_string(), "y".to_string()])] + Vec::new(), + [(cc::ReprId(0), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -167,8 +166,8 @@ pub(super) fn result_fixture() -> (cc::Module, ExternalBindings, Resolve) { ) .expect("the record list WIT fixture should resolve"); - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ cc::Representation::Product { fields: vec![ValueShape::Integer, ValueShape::Number], }, @@ -176,12 +175,11 @@ pub(super) fn result_fixture() -> (cc::Module, ExternalBindings, Resolve) { element: reference(0), }, ], - signatures: Vec::new(), - product_labels: [(cc::ReprId(0), vec!["x".to_string(), "y".to_string()])] + Vec::new(), + [(cc::ReprId(0), vec!["x".to_string(), "y".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); @@ -259,8 +257,8 @@ pub(super) fn string_fixture() -> (cc::Module, ExternalBindings, Resolve) { // Source record fields are sorted alphabetically: `code` then `text`. WIT // declares `text` before `code`, so the canonical layout and the GC struct // order differ and the plan must project by name. - let representations = cc::RepresentationTable { - representations: vec![ + let representations = cc::RepresentationTable::from_parts( + vec![ cc::Representation::Product { fields: vec![ValueShape::Integer, ValueShape::String], }, @@ -268,12 +266,11 @@ pub(super) fn string_fixture() -> (cc::Module, ExternalBindings, Resolve) { element: reference(0), }, ], - signatures: Vec::new(), - product_labels: [(cc::ReprId(0), vec!["code".to_string(), "text".to_string()])] + Vec::new(), + [(cc::ReprId(0), vec!["code".to_string(), "text".to_string()])] .into_iter() .collect(), - ..Default::default() - }; + ); let external_symbol = SymbolId::new(ModuleId::INTRINSICS, FOREIGN_SYMBOL_BASE); let main_symbol = SymbolId::new(ModuleId(0), 0); diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs index a32addd8..f50b715a 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/variants.rs @@ -131,12 +131,11 @@ fn parameter_fixture( result: ValueShape::Integer, }), }], - representations: cc::RepresentationTable { + representations: cc::RepresentationTable::from_parts( representations, - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }, + Vec::new(), + Default::default(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), @@ -275,17 +274,16 @@ pub(crate) fn option_string_list_result_fixture() -> (cc::Module, ExternalBindin result: reference(1), }), }], - representations: cc::RepresentationTable { - representations: vec![ + representations: cc::RepresentationTable::from_parts( + vec![ maybe_string(), Representation::Array { element: reference(0), }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }, + Vec::new(), + Default::default(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), @@ -438,8 +436,8 @@ pub(crate) fn option_list_list_fixture() -> (cc::Module, ExternalBindings, Resol result: ValueShape::Integer, }), }], - representations: cc::RepresentationTable { - representations: vec![ + representations: cc::RepresentationTable::from_parts( + vec![ Representation::Array { element: ValueShape::Integer, }, @@ -459,10 +457,9 @@ pub(crate) fn option_list_list_fixture() -> (cc::Module, ExternalBindings, Resol element: reference(1), }, ], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }, + Vec::new(), + Default::default(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs index 236ae041..1ed497f1 100644 --- a/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs +++ b/crates/psrs-backend/src/mir/indirect_tests/record_list/fixtures/wide_flags.rs @@ -371,12 +371,11 @@ fn finish( result: ValueShape::Integer, }), }], - representations: cc::RepresentationTable { + representations: cc::RepresentationTable::from_parts( representations, - signatures: Vec::new(), - product_labels: labels.into_iter().collect(), - ..Default::default() - }, + Vec::new(), + labels.into_iter().collect(), + ), functions: vec![cc::Function { symbol: main_symbol, name: "main".into(), diff --git a/crates/psrs-backend/src/mir/layout/tests.rs b/crates/psrs-backend/src/mir/layout/tests.rs index d2c16c69..ff14ccda 100644 --- a/crates/psrs-backend/src/mir/layout/tests.rs +++ b/crates/psrs-backend/src/mir/layout/tests.rs @@ -63,17 +63,16 @@ fn signatures_that_lower_to_the_same_wasm_type_share_one_definition() { #[test] fn planner_rejects_a_dangling_closure_signature() { - let table = RepresentationTable { - representations: vec![Representation::Product { + let table = RepresentationTable::from_parts( + vec![Representation::Product { fields: vec![CcValueShape::Reference(Reference { nullable: false, heap: CcRefShape::Closure(SignatureId(0)), })], }], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + Vec::new(), + Default::default(), + ); assert!(matches!( PlannedLayout::plan(&table, TargetCapabilities::default()), Err(LayoutError::UnknownSignature) @@ -81,12 +80,11 @@ fn planner_rejects_a_dangling_closure_signature() { } #[test] fn gc_planner_rejects_an_mvp_only_target() { - let table = RepresentationTable { - representations: vec![Representation::Product { fields: Vec::new() }], - signatures: Vec::new(), - product_labels: Default::default(), - ..Default::default() - }; + let table = RepresentationTable::from_parts( + vec![Representation::Product { fields: Vec::new() }], + Vec::new(), + Default::default(), + ); let mvp_only = TargetCapabilities { gc: false, diff --git a/crates/psrs-backend/src/mir/lower/assignments.rs b/crates/psrs-backend/src/mir/lower/assignments.rs index 22ad299c..7d8750e4 100644 --- a/crates/psrs-backend/src/mir/lower/assignments.rs +++ b/crates/psrs-backend/src/mir/lower/assignments.rs @@ -17,7 +17,7 @@ impl FunctionLowerer<'_> { let proof = self .layout .representation_table() - .control_contracts + .control_contracts() .get(contract.0 as usize) .ok_or_else(|| { vec![BackendError::invalid_ir( diff --git a/crates/psrs-backend/src/mir/verify/variants/tests.rs b/crates/psrs-backend/src/mir/verify/variants/tests.rs index 63054e28..7e97ea42 100644 --- a/crates/psrs-backend/src/mir/verify/variants/tests.rs +++ b/crates/psrs-backend/src/mir/verify/variants/tests.rs @@ -9,8 +9,8 @@ use psrs_span::TextRange; fn constructor(tag: i32, copy: bool) -> Module { let span = TextRange::new(0, 1); - let table = RepresentationTable { - representations: vec![Representation::Variant { + let table = RepresentationTable::from_parts( + vec![Representation::Variant { cases: vec![ VariantCase { tag: 7, @@ -22,8 +22,9 @@ fn constructor(tag: i32, copy: bool) -> Module { }, ], }], - ..Default::default() - }; + Default::default(), + Default::default(), + ); let layout = PlannedLayout::plan(&table, TargetCapabilities::default()).unwrap(); let type_index = layout.variant_index(crate::cc::ReprId(0), 7).unwrap(); let result_type = ValueType::Ref(RefType { diff --git a/crates/psrs-backend/src/mir/wit/lists/mod.rs b/crates/psrs-backend/src/mir/wit/lists/mod.rs index 36a253ec..914e5852 100644 --- a/crates/psrs-backend/src/mir/wit/lists/mod.rs +++ b/crates/psrs-backend/src/mir/wit/lists/mod.rs @@ -179,11 +179,7 @@ pub(super) fn read_value_list_result( current: BlockId, span: TextRange, ) -> Result<(), Vec> { - if let CanonicalType::Handle { - ownership: crate::abi::canonical::Ownership::Borrow, - .. - } = element - { + if crate::abi::canonical::reject_borrowed_control_capture(std::iter::once(element)).is_err() { // A borrowed handle must not escape the call that produced it. An owned // handle list is an ordinary `i32` array: the standard library drops // each extracted handle (DEC-14), so the compiler copies the indices. diff --git a/crates/psrs-driver/src/tests/control_boundary.rs b/crates/psrs-driver/src/tests/control_boundary.rs new file mode 100644 index 00000000..00ad5c31 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_boundary.rs @@ -0,0 +1,392 @@ +//! Operand and ordered-effect obligations at the P8 construction boundary. +use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R, Function}; + +const SOURCE: &str = include_str!("../../tests/control_support/nominal_carriers.purs"); + +fn mutate(body: &mut [Assignment], edit: &mut impl FnMut(&mut A) -> bool) -> bool { + for assignment in body { + if edit(&mut assignment.kind) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if mutate(&mut case.assignments, edit) { + return true; + } + } + if mutate(default_assignments, edit) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if mutate(then_assignments, edit) || mutate(else_assignments, edit) { + return true; + } + } + _ => {} + } + } + false +} + +fn rejected(role: R, edit: impl FnOnce(&mut Function)) { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = input + .cc + .representations + .control_helpers() + .iter() + .find(|h| h.role() == role) + .unwrap() + .function(); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + edit(function); + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("mutated machine must fail P8"); + assert!( + errors.iter().any(|error| error + .message + .contains("emitted machine operands or ordered operations")), + "{errors:?}" + ); +} + +#[test] +fn projected_clause_field_must_match_the_plan() { + rejected(R::Executor, |f| { + let callable: std::collections::HashSet<_> = f.values.iter().filter(|v| matches!(v.ty, psrs_backend::cc::ValueShape::Reference(r) if matches!(r.heap, psrs_backend::cc::RefShape::Closure(_)))).map(|v| v.id).collect(); + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::VariantGet { + case: 1, + field, + destination, + .. + } = a + && *field == 0 + && callable.contains(destination) + { + // Scoped return and operation clauses have the same shape. + *field = 1; + return true; + } + false + })); + }); +} + +#[test] +fn replay_projection_index_must_match_the_plan() { + rejected(R::Executor, |f| { + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::ProductGet { field, .. } = a { + *field = 1 - *field; + return true; + } + false + })); + }); +} + +#[test] +fn helper_arguments_must_preserve_source_identity() { + rejected(R::CloneSequence, |f| { + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::DirectCall { arguments, .. } = a + && arguments.len() >= 2 + { + arguments.swap(0, 1); + return true; + } + false + })); + }); +} + +#[test] +fn dispatch_selector_must_preserve_source_identity() { + rejected(R::CloneSequence, |f| { + let other_queue = f.parameters[1]; + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::VariantTag { value, .. } = a { + *value = other_queue; + return true; + } + false + })); + }); +} + +#[test] +fn clause_application_must_consume_its_planned_argument() { + rejected(R::Executor, |f| { + let state = f.parameters[0]; + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::IndirectCall { arguments, .. } = a { + arguments[0] = state; + return true; + } + false + })); + }); +} + +#[test] +fn allocation_fields_must_preserve_source_identity() { + rejected(R::Executor, |f| { + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::VariantNew { + case: 2, fields, .. + } = a + && fields.len() == 2 + { + fields.swap(0, 1); + return true; + } + false + })); + }); +} + +#[test] +fn callback_capture_index_must_match_the_plan() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = input + .cc + .representations + .control_resumption() + .unwrap() + .function(); + let f = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::ClosureGetCapture { index, .. } = a { + *index = 1 - *index; + return true; + } + false + })); + let errors = psrs_backend::cc::verify_module(&input.cc).unwrap_err(); + assert!( + errors.iter().any(|e| e.pass == "P8 CC verification"), + "{errors:?}" + ); +} + +#[test] +fn status_write_value_and_index_must_match_the_plan() { + for wrong_index in [false, true] { + rejected(R::Cancel, |f| { + assert!(mutate(&mut f.assignments, &mut |a| { + if let A::ArraySet { + index, new_value, .. + } = a + { + if wrong_index { + *index = *new_value; + } else { + *new_value = *index; + } + return true; + } + false + })); + }); + } +} + +#[test] +fn discarded_close_effect_is_required() { + rejected(R::Close, |f| { + let A::TagSwitch { cases, .. } = &mut f.assignments.last_mut().unwrap().kind else { + panic!("close must dispatch on the extent"); + }; + let mut removed = 0; + for case in cases { + case.assignments.retain(|a| { + if matches!(a.kind, A::ArraySet { .. }) { + removed += 1; + false + } else { + true + } + }); + } + assert!(removed > 0); + }); +} + +#[test] +fn extra_observable_operation_is_rejected() { + rejected(R::Start, |f| { + let allocation = f + .assignments + .iter() + .find(|a| matches!(a.kind, A::ArrayNew { .. })) + .unwrap() + .clone(); + // ArraySet destinations may reuse an existing cell; this adds a legal + // store using the fresh status cell and its already-bound zero value. + let A::ArrayNew { + representation, + elements, + .. + } = allocation.kind + else { + unreachable!() + }; + f.assignments.push(Assignment { + destination: allocation.destination, + kind: A::ArraySet { + destination: allocation.destination, + representation, + value: allocation.destination, + index: elements[0], + new_value: elements[0], + }, + span: allocation.span, + }); + }); +} + +#[test] +fn returned_helper_value_must_match_the_plan() { + rejected(R::Check, |f| f.result = f.parameters[0]); +} + +#[test] +fn unused_narrowing_cast_is_rejected_even_when_its_result_is_erased() { + for erase_result in [false, true] { + rejected(R::Executor, |f| { + let mut declaration = f + .values + .iter() + .find(|v| v.id == f.parameters[2]) + .unwrap() + .clone(); + declaration.id = + psrs_backend::cc::ValueId(f.values.iter().map(|v| v.id.0).max().unwrap() + 1); + let psrs_backend::cc::ValueShape::Reference(reference) = declaration.ty else { + unreachable!() + }; + let narrowed = declaration.id; + f.values.push(declaration.clone()); + f.assignments.push(Assignment { + destination: narrowed, + kind: A::RepresentationCast { + destination: narrowed, + value: f.parameters[0], + reference, + }, + span: f.span, + }); + if erase_result { + declaration.id = psrs_backend::cc::ValueId(narrowed.0 + 1); + let reference = psrs_backend::cc::Reference { + nullable: false, + heap: psrs_backend::cc::RefShape::Erased, + }; + declaration.ty = psrs_backend::cc::ValueShape::Reference(reference); + f.assignments.push(Assignment { + destination: declaration.id, + kind: A::RepresentationCast { + destination: declaration.id, + value: narrowed, + reference, + }, + span: f.span, + }); + f.values.push(declaration); + } + }); + } +} + +#[test] +fn reference_alias_on_the_actual_machine_exit_is_accepted() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let symbol = input + .cc + .representations + .control_helpers() + .iter() + .find(|h| h.role() == R::Start) + .unwrap() + .function(); + let f = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let mut declaration = f.values.iter().find(|v| v.id == f.result).unwrap().clone(); + declaration.id = psrs_backend::cc::ValueId(f.values.iter().map(|v| v.id.0).max().unwrap() + 1); + let psrs_backend::cc::ValueShape::Reference(reference) = declaration.ty else { + unreachable!() + }; + f.assignments.push(Assignment { + destination: declaration.id, + kind: A::RepresentationCast { + destination: declaration.id, + value: f.result, + reference, + }, + span: f.span, + }); + f.result = declaration.id; + f.values.push(declaration); + psrs_backend::cc::verify_module(&input.cc).unwrap(); + psrs_backend::compile_cc(input).unwrap(); +} + +#[test] +fn callback_recovery_cannot_move_before_the_callback_clear() { + rejected(R::Executor, |f| { + let A::TagSwitch { cases, .. } = &mut f.assignments.last_mut().unwrap().kind else { + panic!("executor must dispatch on computation"); + }; + let body = &mut cases + .iter_mut() + .find(|case| case.tag == 5) + .unwrap() + .assignments; + let recovery = body + .iter() + .position(|a| { + matches!( + a.kind, + A::RepresentationCast { + reference: psrs_backend::cc::Reference { + heap: psrs_backend::cc::RefShape::Closure(_), + .. + }, + .. + } + ) + }) + .unwrap(); + let clear = body[..recovery] + .iter() + .rposition(|a| matches!(a.kind, A::ArraySet { .. })) + .unwrap(); + let cast = body.remove(recovery); + body.insert(clear, cast); + }); +} diff --git a/crates/psrs-driver/src/tests/control_carriers.rs b/crates/psrs-driver/src/tests/control_carriers.rs index 9942a6ed..0b556195 100644 --- a/crates/psrs-driver/src/tests/control_carriers.rs +++ b/crates/psrs-driver/src/tests/control_carriers.rs @@ -48,7 +48,7 @@ fn all_eight_operations_use_nominal_carriers_and_direct_callable_protocols() { let table = &input.cc.representations; let signature = |role| { let helper = table - .control_helpers + .control_helpers() .iter() .find(|helper| helper.role() == role) .unwrap(); @@ -77,7 +77,7 @@ fn all_eight_operations_use_nominal_carriers_and_direct_callable_protocols() { else { return; }; - let operation = table.control_contracts[contract.0 as usize].operation(); + let operation = table.control_contracts()[contract.0 as usize].operation(); operations.insert(operation); let expected = match operation { Intrinsic::ControlReturn | Intrinsic::ControlPerform => vec![erased], @@ -124,7 +124,7 @@ fn ordinary_parameters_results_and_join_values_keep_the_carrier_shape() { let table = &input.cc.representations; let expected = |role, parameter: Option| { let helper = table - .control_helpers + .control_helpers() .iter() .find(|helper| helper.role() == role) .unwrap(); @@ -163,7 +163,7 @@ fn ordinary_parameters_results_and_join_values_keep_the_carrier_shape() { #[test] fn cc_rejects_weakening_a_source_computation_to_an_abstract_aggregate() { let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); - let contracts = &input.cc.representations.control_contracts; + let contracts = &input.cc.representations.control_contracts(); let (function, value, destination) = input .cc .functions @@ -206,7 +206,7 @@ fn cc_boundary_rejects_a_dropped_machine_dispatch_arm() { let symbol = input .cc .representations - .control_helpers + .control_helpers() .iter() .find(|helper| helper.role() == ControlHelperRole::Executor) .unwrap() diff --git a/crates/psrs-driver/src/tests/control_costs/mod.rs b/crates/psrs-driver/src/tests/control_costs/mod.rs index 43e39113..8a7de70e 100644 --- a/crates/psrs-driver/src/tests/control_costs/mod.rs +++ b/crates/psrs-driver/src/tests/control_costs/mod.rs @@ -1,6 +1,8 @@ //! Cost evidence combines actual ancestry guards with observed GC collections. mod probe; +mod replay; +use replay::entry_invocations as replay_invocations; mod sources; use std::process::Command; @@ -115,50 +117,6 @@ fn control_ancestry_probe_observes_independent_non_tail_extents() { run("nested", sources::NESTED, 8, 7, 134); } -/// Run the instrumented replay counter at `budget` and report whether the -/// program completed (the count did not exceed the budget). -fn replay_ok(name: &str, source: &str, budget: i32) -> Option { - super::wasmtime_available()?; - let mut stages = crate::compile_main_stages(source).expect("cost source compiles and verifies"); - assert!( - probe::instrument_replay(&mut stages, budget) > 0, - "no replay helpers retained to instrument" - ); - let core = - psrs_backend::wasm::encode_module(&stages.wasm).expect("instrumented target encodes"); - let bytes = probe::component(&stages, &core); - wasmparser::Validator::new_with_features(wasmparser::WasmFeatures::all()) - .validate_all(&bytes) - .expect("instrumented Wasm validates"); - let path = std::env::temp_dir().join(format!("psrs-control-replay-{name}-{budget}.wasm")); - std::fs::write(&path, bytes).unwrap(); - let output = Command::new("wasmtime") - .arg("run") - .arg(&path) - .output() - .unwrap(); - let _ = std::fs::remove_file(&path); - Some(output.status.code() == Some(42)) -} - -/// The total `CloneSequence`/`RebuildSequence` invocations: the smallest budget -/// that does not trap the replay counter. -fn replay_invocations(name: &str, template: &str, steps: i32) -> Option { - super::wasmtime_available()?; - let source = template.replace("STEPS", &steps.to_string()); - let mut lo = 0; - let mut hi = 1 << 20; - while lo < hi { - let mid = lo + (hi - lo) / 2; - if replay_ok(name, &source, mid)? { - hi = mid; - } else { - lo = mid + 1; - } - } - Some(lo) -} - #[test] fn replay_invocations_grow_with_requests_at_fixed_ancestry() { // `DEEP` replays its saved queue once per request; the ancestry bound stays @@ -183,7 +141,7 @@ fn control_cost_pipeline_rejects_a_malformed_compiler_input() { let symbol = input .cc .representations - .control_helpers + .control_helpers() .iter() .find(|h| h.role() == psrs_backend::cc::ControlHelperRole::Executor) .unwrap() diff --git a/crates/psrs-driver/src/tests/control_costs/probe.rs b/crates/psrs-driver/src/tests/control_costs/probe.rs index 6d9ba161..71ca96eb 100644 --- a/crates/psrs-driver/src/tests/control_costs/probe.rs +++ b/crates/psrs-driver/src/tests/control_costs/probe.rs @@ -14,7 +14,7 @@ pub(super) fn instrument(stages: &mut Stages, limit: i32) -> usize { let check = stages .cc .representations - .control_helpers + .control_helpers() .iter() .find(|h| h.role() == R::Check) .unwrap() @@ -146,6 +146,24 @@ fn reference_type(index: u32, nullable: bool) -> ValType { fn leaf(instruction: I<'static>) -> Op { Op::Leaf(instruction) } + +fn counter(global: u32, budget: i32, span: psrs_span::TextRange) -> Body { + vec![ + leaf(I::GlobalGet(global)), + leaf(I::I32Const(1)), + leaf(I::I32Add), + leaf(I::GlobalSet(global)), + leaf(I::GlobalGet(global)), + leaf(I::I32Const(budget)), + leaf(I::I32GtS), + Op::If { + then_body: vec![leaf(I::Unreachable)], + else_body: vec![], + result: None, + span, + }, + ] +} fn insert(body: &mut Body, root: u32, child: u32, local: u32, checker: u32, limit: i32) -> usize { let mut count = 0; let mut result = Vec::new(); @@ -195,7 +213,7 @@ pub(super) fn instrument_replay(stages: &mut Stages, budget: i32) -> usize { stages .cc .representations - .control_helpers + .control_helpers() .iter() .find(|helper| helper.role() == role) .expect("control helper") @@ -217,21 +235,7 @@ pub(super) fn instrument_replay(stages: &mut Stages, budget: i32) -> usize { continue; } let span = function.span; - let mut prefix = vec![ - leaf(I::GlobalGet(global)), - leaf(I::I32Const(1)), - leaf(I::I32Add), - leaf(I::GlobalSet(global)), - leaf(I::GlobalGet(global)), - leaf(I::I32Const(budget)), - leaf(I::I32GtS), - Op::If { - then_body: vec![leaf(I::Unreachable)], - else_body: vec![], - result: None, - span, - }, - ]; + let mut prefix = counter(global, budget, span); prefix.extend(std::mem::take(&mut function.body)); function.body = prefix; count += 1; @@ -239,6 +243,100 @@ pub(super) fn instrument_replay(stages: &mut Stages, budget: i32) -> usize { count } +/// Observe each loopified dispatch iteration, including self-tail backedges. +/// Optional `ordinal` selects one replay activation by its Clone entry; it +/// remains selected across Clone/Rebuild tail loops and their helper transfer. +pub(super) fn instrument_replay_steps( + stages: &mut Stages, + budget: i32, + ordinal: Option, +) -> usize { + let plan = stages + .cc + .representations + .control_plan() + .expect("planned control machine"); + let clone = plan.helper(R::CloneSequence).unwrap().function(); + let rebuild = plan.helper(R::RebuildSequence).unwrap().function(); + let module = &mut stages.wasm; + let global = module.globals.len() as u32; + for index in [global, global + 1] { + module.globals.push(Global { + index: GlobalIndex(index), + mutable: true, + ty: ValType::I32, + init: GlobalInit::I32(0), + }); + } + let mut helpers = 0; + for function in &mut module.functions { + if function.symbol != clone && function.symbol != rebuild { + continue; + } + let prefix = if let Some(ordinal) = ordinal { + vec![ + leaf(I::GlobalGet(global + 1)), + leaf(I::I32Const(ordinal)), + leaf(I::I32Eq), + Op::If { + then_body: counter(global, budget, function.span), + else_body: vec![], + result: None, + span: function.span, + }, + ] + } else { + counter(global, budget, function.span) + }; + let loops = instrument_loops(&mut function.body, &prefix); + assert_eq!( + loops, 1, + "replay observation requires one loopified dispatch header per helper, got {loops} in {:?}", + function.symbol + ); + if function.symbol == clone { + let mut entry = vec![ + leaf(I::GlobalGet(global + 1)), + leaf(I::I32Const(1)), + leaf(I::I32Add), + leaf(I::GlobalSet(global + 1)), + ]; + entry.extend(std::mem::take(&mut function.body)); + function.body = entry; + } + helpers += 1; + } + assert_eq!( + helpers, 2, + "both replay helpers must survive the verified pipeline" + ); + helpers +} + +fn instrument_loops(body: &mut Body, prefix: &Body) -> usize { + let mut count = 0; + for op in body { + match op { + Op::Loop { body, .. } => { + count += 1 + instrument_loops(body, prefix); + let mut observed = prefix.clone(); + observed.extend(std::mem::take(body)); + *body = observed; + } + Op::Block { body, .. } => count += instrument_loops(body, prefix), + Op::If { + then_body, + else_body, + .. + } => { + count += instrument_loops(then_body, prefix) + instrument_loops(else_body, prefix); + } + _ => {} + } + } + count +} + /// Replace the program core module in the already assembled component. The /// observation adds only private locals/functions; imports/exports stay fixed. pub(super) fn component(stages: &Stages, core: &[u8]) -> Vec { diff --git a/crates/psrs-driver/src/tests/control_costs/replay.rs b/crates/psrs-driver/src/tests/control_costs/replay.rs new file mode 100644 index 00000000..e1ad32ad --- /dev/null +++ b/crates/psrs-driver/src/tests/control_costs/replay.rs @@ -0,0 +1,213 @@ +//! Runtime observations of optimized Wasm. Compile each source once, retain +//! identified artifacts, and require the exact success/trapping budget boundary. +use super::{probe, sources}; +use psrs_backend::Stages; +use std::{path::PathBuf, process::Command}; + +#[derive(Clone, Copy, Debug)] +enum Counter { + Entries, + Steps(Option), +} + +impl Counter { + fn label(self) -> String { + match self { + Self::Entries => "entries".into(), + Self::Steps(None) => "steps-all".into(), + Self::Steps(Some(n)) => format!("steps-replay-{n}"), + } + } +} + +struct Program { + stages: Stages, + directory: PathBuf, + ancestry: i32, +} + +fn identity(bytes: &[u8]) -> String { + let hash = bytes.iter().fold(0xcbf29ce484222325_u64, |hash, byte| { + (hash ^ u64::from(*byte)).wrapping_mul(0x100000001b3) + }); + format!("fnv1a64-v1:{hash:016x}") +} + +impl Program { + fn compile(name: &str, source: &str, ancestry: i32) -> Option { + super::super::wasmtime_available()?; + let mut stages = crate::compile_main_stages(source) + .expect("cost source compiles through the verified pipeline"); + let directory = std::env::temp_dir() + .join(format!("psrs-control-replay-costs-{}", std::process::id())) + .join(name); + std::fs::create_dir_all(&directory).unwrap(); + std::fs::write(directory.join("source.purs"), source).unwrap(); + std::fs::write(directory.join("base.wasm"), &stages.artifact.wasm).unwrap(); + let base_identity = identity(&stages.artifact.wasm); + assert!( + probe::instrument(&mut stages, ancestry) > 0, + "ancestry observation must inspect actual allocations" + ); + let program = Self { + stages, + directory, + ancestry, + }; + assert!( + program.run(&program.stages, "ancestry").0, + "unlimited ancestry-instrumented program must return 42" + ); + let version = Command::new("wasmtime").arg("--version").output().unwrap(); + let report = serde_json::json!({"source":program.directory.join("source.purs"),"source_identity":identity(source.as_bytes()),"base_artifact_identity":base_identity,"ancestry_bound":ancestry,"wasmtime":String::from_utf8_lossy(&version.stdout).trim()}); + std::fs::write( + program.directory.join("input.json"), + serde_json::to_vec_pretty(&report).unwrap(), + ) + .unwrap(); + Some(program) + } + + /// Return success only for the checked value. A non-budget failure must not + /// become a measured count or look like an unavailable runtime skip. + fn run(&self, stages: &Stages, label: &str) -> (bool, String) { + let core = + psrs_backend::wasm::encode_module(&stages.wasm).expect("observed target encodes"); + let bytes = probe::component(stages, &core); + wasmparser::Validator::new_with_features(wasmparser::WasmFeatures::all()) + .validate_all(&bytes) + .expect("observed component validates"); + let hash = identity(&bytes); + let path = self.directory.join(format!("{label}.wasm")); + std::fs::write(&path, bytes).unwrap(); + let output = Command::new("wasmtime") + .arg("run") + .arg(&path) + .output() + .expect("run observed component"); + std::fs::write( + self.directory.join(format!("{label}.stderr")), + &output.stderr, + ) + .unwrap(); + match output.status.code() { + Some(42) => (true, hash), + Some(134) => { + let stderr = String::from_utf8_lossy(&output.stderr); + assert!( + stderr.contains("wasm trap:") + && stderr.contains("unreachable") + && !stderr.contains("cast failure"), + "unexpected failure while measuring {path:?}: {output:?}" + ); + (false, hash) + } + _ => panic!( + "value/order/request-count assertion failed while measuring {path:?}: {output:?}" + ), + } + } + + fn budget(&self, counter: Counter, budget: i32) -> (bool, String) { + let mut stages = self.stages.clone(); + let inspected = match counter { + Counter::Entries => probe::instrument_replay(&mut stages, budget), + Counter::Steps(ordinal) => probe::instrument_replay_steps(&mut stages, budget, ordinal), + }; + assert_eq!(inspected, 2, "both replay helpers must be observed"); + self.run(&stages, &format!("{}-budget-{budget}", counter.label())) + } + + fn measure(&self, counter: Counter) -> i32 { + let mut high = 1; + while !self.budget(counter, high).0 { + high *= 2; + assert!( + high <= 1 << 20, + "replay did not complete within the observation budget" + ); + } + let mut low = 0; + while low < high { + let middle = low + (high - low) / 2; + if self.budget(counter, middle).0 { + high = middle; + } else { + low = middle + 1; + } + } + assert!(low > 0, "a replay observation must execute"); + let (success, successful_identity) = self.budget(counter, low); + let (under_budget, trapping_identity) = self.budget(counter, low - 1); + assert!( + success && !under_budget, + "counter must distinguish count from count-1" + ); + let report = serde_json::json!({"counter":counter.label(),"count":low,"ancestry_bound":self.ancestry,"successful_budget":low,"successful_exit":42,"successful_artifact_identity":successful_identity,"trapping_budget":low-1,"trapping_exit":134,"trapping_artifact_identity":trapping_identity}); + std::fs::write( + self.directory.join(format!("{}.json", counter.label())), + serde_json::to_vec_pretty(&report).unwrap(), + ) + .unwrap(); + eprintln!( + "{}: {} = {low}, ancestry <= {}", + self.directory.display(), + counter.label(), + self.ancestry + ); + low + } +} + +pub(super) fn entry_invocations(name: &str, template: &str, steps: i32) -> Option { + let source = template.replace("STEPS", &steps.to_string()); + let program = Program::compile(&format!("{name}-requests-{steps}"), &source, 2)?; + Some(program.measure(Counter::Entries)) +} + +#[test] +fn saved_callback_length_changes_actual_loop_work_at_fixed_requests_and_ancestry() { + for length in [0, 1, 4, 16] { + let source = sources::SAVED_LENGTH.replace("LENGTH", &length.to_string()); + let Some(program) = Program::compile(&format!("linear-length-{length}"), &source, 0) else { + return; + }; + assert_eq!( + program.measure(Counter::Entries), + 2, + "one replay has two helper entries regardless of length" + ); + assert_eq!( + program.measure(Counter::Steps(None)), + 2 * length + 2, + "both loops must visit every saved callback and their terminal Empty" + ); + } +} + +#[test] +fn queue_shape_changes_traversal_with_equal_callbacks_requests_and_ancestry() { + for length in [0, 4, 16] { + for (name, source, extra) in [ + ("linear", sources::LINEAR_SECOND, 0), + ("append", sources::APPEND_SECOND, 2), + ] { + let source = source.replace("LENGTH", &length.to_string()); + let Some(program) = + Program::compile(&format!("second-{name}-length-{length}"), &source, 0) + else { + return; + }; + assert_eq!( + program.measure(Counter::Entries), + 4, + "both programs have exactly two replays" + ); + assert_eq!( + program.measure(Counter::Steps(Some(2))), + 2 * length + 2 + extra, + "the second captured sequence has {length} callbacks; Append adds a stack push and empty right traversal" + ); + } + } +} diff --git a/crates/psrs-driver/src/tests/control_costs/sources.rs b/crates/psrs-driver/src/tests/control_costs/sources.rs index 064d902c..afdea1c3 100644 --- a/crates/psrs-driver/src/tests/control_costs/sources.rs +++ b/crates/psrs-driver/src/tests/control_costs/sources.rs @@ -45,3 +45,61 @@ root :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C root s (Op k) raw = { _1: s, _2: raw (k 0) } main = (C.run 0 root (nest STEPS))._2 "; + +/// One request with LENGTH callbacks already in the captured sequence. +/// Pass the run result once to `check`: separate top-level projections would +/// evaluate this pure definition twice and double the measured machine work. +pub(super) const SAVED_LENGTH: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +step :: Int -> Int -> Int +step index value = intAdd (intMul value 3) index +expected :: Int -> Int +expected n = if intEq n 0 then 42 else step n (expected (intSub n 1)) +build :: Int -> C.Control Op Int +build n = if intEq n 0 then C.perform (Op (\x -> x)) else C.bind (build (intSub n 1)) (\value -> C.return (step n value)) +root :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +root s (Op k) raw = { _1: intAdd s 1, _2: raw (k 42) } +result = C.run 0 root (build LENGTH) +check :: { _1 :: Int, _2 :: Int } -> Int +check result = if intEq result._1 1 then if intEq result._2 (expected LENGTH) then 42 else 0 else 0 +main = check result +"; + +/// The first replay finishes before building the second request's sequence, +/// so the second capture is a linear Cons chain with LENGTH callbacks. +pub(super) const LINEAR_SECOND: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +step :: Int -> Int -> Int +step index value = intAdd (intMul value 3) index +expected :: Int -> Int +expected n = if intEq n 0 then 42 else step n (expected (intSub n 1)) +build :: Int -> C.Control Op Int +build n = if intEq n 0 then C.perform (Op (\x -> x)) else C.bind (build (intSub n 1)) (\value -> C.return (step n value)) +root :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +root s (Op k) raw = if intEq s 0 then { _1: 1, _2: C.bind (raw (k 0)) (\_ -> build LENGTH) } else { _1: intAdd s 1, _2: raw (k 42) } +result = C.run 0 root (C.perform (Op (\x -> x))) +check :: { _1 :: Int, _2 :: Int } -> Int +check result = if intEq result._1 2 then if intEq result._2 (expected LENGTH) then 42 else 0 else 0 +main = check result +"; + +/// After the first replay enters its first callback, the second capture sees +/// Append(remainingCallbacks, Empty): same callbacks as LINEAR_SECOND. +pub(super) const APPEND_SECOND: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +step :: Int -> Int -> Int +step index value = intAdd (intMul value 3) index +expected :: Int -> Int +expected n = if intEq n 0 then 42 else step n (expected (intSub n 1)) +build :: Int -> C.Control Op Int +build n = if intEq n 0 then C.bind (C.perform (Op (\x -> x))) (\_ -> C.perform (Op (\x -> x))) else C.bind (build (intSub n 1)) (\value -> C.return (step n value)) +root :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +root s (Op k) raw = { _1: intAdd s 1, _2: raw (k 42) } +result = C.run 0 root (build LENGTH) +check :: { _1 :: Int, _2 :: Int } -> Int +check result = if intEq result._1 2 then if intEq result._2 (expected LENGTH) then 42 else 0 else 0 +main = check result +"; diff --git a/crates/psrs-driver/src/tests/control_regressions/checkpoints.rs b/crates/psrs-driver/src/tests/control_regressions/checkpoints.rs new file mode 100644 index 00000000..1585270f --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/checkpoints.rs @@ -0,0 +1,267 @@ +//! Checkpoint, raw-resume and factory-status obligations at the P8 boundary. +//! Historical owners: `control_checkpoints`, `control_checkpoint_ordering`, +//! `control_inlined_publication` at `01f7e66c`. +use super::{SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R, Function}; + +fn visit(body: &mut [Assignment], mutation: &mut impl FnMut(&mut A) -> bool) -> bool { + for assignment in body { + if mutation(&mut assignment.kind) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if visit(&mut case.assignments, mutation) { + return true; + } + } + if visit(default_assignments, mutation) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if visit(then_assignments, mutation) || visit(else_assignments, mutation) { + return true; + } + } + _ => {} + } + } + false +} + +fn expect_boundary(input: &psrs_backend::BackendInput) { + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("malformed checkpoint construction must fail P8"); + assert!( + errors.iter().any(|error| error + .message + .contains("emitted machine operands or ordered operations")), + "{errors:?}" + ); +} + +fn executor(input: &mut psrs_backend::BackendInput) -> &mut Function { + let (symbol, _) = binding(&input.cc.representations, R::Executor); + input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .expect("Executor") +} + +fn resume_arm(function: &mut Function) -> &mut Vec { + let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { + panic!("executor dispatches on the computation"); + }; + &mut cases + .iter_mut() + .find(|case| case.tag == 3) + .expect("Resume arm") + .assignments +} + +#[test] +fn cc_perform_cannot_capture_the_execution_extent_as_its_checkpoint() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let function = executor(&mut input); + let execution = function.parameters[4]; + assert!(visit(&mut function.assignments, &mut |kind| { + if let A::FunctionRef { captures, .. } = kind { + assert_ne!(captures[1], execution); + captures[1] = execution; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_raw_resume_must_check_its_captured_checkpoint_before_the_frame() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let raw = input + .cc + .representations + .control_resumption() + .unwrap() + .function(); + let (check, _) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .expect("raw resume"); + let before = function.assignments.len(); + function.assignments.retain(|assignment| { + !matches!(assignment.kind, A::DirectCall { function, .. } if function == check) + }); + assert_eq!(function.assignments.len(), before - 1); + expect_boundary(&input); +} + +#[test] +fn cc_resume_cannot_check_the_current_execution_extent() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (check, _) = binding(&input.cc.representations, R::Check); + let function = executor(&mut input); + let execution = function.parameters[4]; + let body = resume_arm(function); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, + arguments, + .. + } = kind + && *function == check + { + arguments[0] = execution; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_resume_cannot_start_replay_before_the_checkpoint_check() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (check, _) = binding(&input.cc.representations, R::Check); + let (clone, _) = binding(&input.cc.representations, R::CloneSequence); + let function = executor(&mut input); + let body = resume_arm(function); + let check_at = body + .iter() + .position(|assignment| { + matches!(assignment.kind, A::DirectCall { function, .. } if function == check) + }) + .expect("Resume checks its checkpoint"); + let check_assignment = body.remove(check_at); + let clone_at = body + .iter() + .position(|assignment| { + matches!(assignment.kind, A::DirectCall { function, .. } if function == clone) + }) + .expect("Resume clones the saved queue"); + body.insert(clone_at + 1, check_assignment); + expect_boundary(&input); +} + +#[test] +fn cc_start_and_once_status_cells_must_be_initialized_live() { + for role in [R::Start, R::Once] { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, role); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .unwrap(); + assert!(visit(&mut function.assignments, &mut |kind| { + if let A::Constant(value) = kind + && *value == 0 + { + *value = 2; + return true; + } + false + })); + expect_boundary(&input); + } +} + +#[test] +fn cc_handle_cannot_install_its_fresh_extent_as_the_caller_parent() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let function = executor(&mut input); + assert!(visit(&mut function.assignments, &mut |kind| { + if let A::VariantNew { + case: 1, fields, .. + } = kind + && fields.len() == 6 + && fields[3] != fields[5] + { + fields.swap(3, 5); + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_raw_resume_accepts_a_same_shape_alias_of_its_checkpoint() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let raw = input + .cc + .representations + .control_resumption() + .unwrap() + .function(); + let (check, _) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == raw) + .unwrap(); + let check_at = function + .assignments + .iter() + .position(|assignment| { + matches!(assignment.kind, A::DirectCall { function, .. } if function == check) + }) + .unwrap(); + let checkpoint = match &function.assignments[check_at].kind { + A::DirectCall { arguments, .. } => arguments[0], + _ => unreachable!(), + }; + let mut declaration = function + .values + .iter() + .find(|value| value.id == checkpoint) + .unwrap() + .clone(); + declaration.id = psrs_backend::cc::ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + let psrs_backend::cc::ValueShape::Reference(reference) = declaration.ty else { + unreachable!() + }; + function.assignments.insert( + check_at, + Assignment { + destination: declaration.id, + kind: A::RepresentationCast { + destination: declaration.id, + value: checkpoint, + reference, + }, + span: function.span, + }, + ); + match &mut function.assignments[check_at + 1].kind { + A::DirectCall { arguments, .. } => arguments[0] = declaration.id, + _ => unreachable!(), + } + function.values.push(declaration); + psrs_backend::cc::verify_module(&input.cc).unwrap(); +} diff --git a/crates/psrs-driver/src/tests/control_regressions/foreign.rs b/crates/psrs-driver/src/tests/control_regressions/foreign.rs new file mode 100644 index 00000000..298997a2 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/foreign.rs @@ -0,0 +1,67 @@ +//! Host-resource capture and instance-terminal trap boundaries. +use super::SOURCE; + +const HEADER: &str = r"module Main where +import Prim.Control as C +import Unsafe.Coerce (unsafeCoerce) +foreign import data File :: Type +data Op x = Op (Int -> x) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +"; + +#[test] +fn cc_control_callback_cannot_capture_a_host_resource_handle() { + let source = format!( + "{HEADER}\nmain :: Int\nmain = let file = unsafeCoerce 0 :: File\n owner = C.once (\\n -> let _ = file in C.return n)\n in (C.run 0 handler (C.resume owner 1))._2\n" + ); + let errors = crate::lower_main_to_cc(&source).expect_err("a File capture must fail P8"); + assert!( + errors.iter().any(|error| error + .message + .contains("control callback cannot capture a host resource handle")), + "{errors:?}" + ); +} + +#[test] +fn cc_control_callback_may_capture_an_ordinary_integer() { + let source = format!( + "{HEADER}\nmain :: Int\nmain = let n = 1\n owner = C.once (\\x -> C.return (intAdd x n))\n in (C.run 0 handler (C.resume owner 1))._2\n" + ); + crate::lower_main_to_cc(&source).expect("an Int capture is not a host resource"); +} + +#[test] +fn control_artifact_has_no_post_trap_cleanup_export() { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let artifact = psrs_backend::compile_cc(input).unwrap(); + for forbidden in [ + "control_cleanup", + "control_recover", + "psrs_control_cleanup", + "cabi_post_control", + ] { + assert!( + !artifact.wat.contains(forbidden), + "instance-terminal traps must not reenter through {forbidden}" + ); + } + assert!( + artifact.wat.contains("wasi:cli/run@0.2.12#run") || artifact.wat.contains("wasi:cli/run"), + "the artifact still exports the ordinary run contract" + ); +} + +#[test] +fn a_trap_during_control_is_instance_terminal() { + let source = + format!("{HEADER}\nmain :: Int\nmain = (C.run 0 handler (C.return (intQuot 1 0)))._2\n"); + let Some(output) = super::super::run_with_wasmtime(&source) else { + return; + }; + assert!( + !output.status.success(), + "a trap must abort the instance: {output:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_regressions/lifecycle.rs b/crates/psrs-driver/src/tests/control_regressions/lifecycle.rs new file mode 100644 index 00000000..478912c6 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/lifecycle.rs @@ -0,0 +1,122 @@ +//! Semantic helper IDs cannot replace proofs of their actual extent behavior. +use super::{SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R}; + +fn visit(body: &mut [Assignment], mutation: &mut impl FnMut(&mut A) -> bool) -> bool { + for assignment in body { + if mutation(&mut assignment.kind) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if visit(&mut case.assignments, mutation) { + return true; + } + } + if visit(default_assignments, mutation) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if visit(then_assignments, mutation) || visit(else_assignments, mutation) { + return true; + } + } + _ => {} + } + } + false +} + +#[test] +fn cc_lifecycle_bodies_reject_identity_wrong_guard_write_and_ancestry() { + for role in [R::Check, R::Close] { + for mutation in 0..4 { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (symbol, _) = binding(&input.cc.representations, role); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == symbol) + .unwrap(); + let parameter = function.parameters[0]; + match mutation { + 0 => { + function.assignments.clear(); + function.result = parameter; + } + 1 => assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::Constant(value) if *value == if role == R::Check { 0 } else { 1 } => { + *value = 2; + true + } + _ => false, + })), + 2 if role == R::Check => { + assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::TagSwitch { cases, .. } if cases.len() == 1 => { + cases[0].tag = 1; + true + } + _ => false, + })) + } + 2 => assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::ArraySet { + value, + destination, + representation, + .. + } => { + *kind = A::RepresentationCast { + value: *value, + destination: *destination, + reference: psrs_backend::cc::Reference { + nullable: false, + heap: psrs_backend::cc::RefShape::Repr(*representation), + }, + }; + true + } + _ => false, + })), + _ if role == R::Check => { + assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::DirectCall { + function: target, + arguments, + .. + } if *target == symbol => { + arguments[0] = parameter; + true + } + _ => false, + })) + } + _ => assert!(visit(&mut function.assignments, &mut |kind| match kind { + A::ArraySet { value, .. } => { + *value = parameter; + true + } + _ => false, + })), + } + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("malformed lifecycle body"); + assert!( + errors.iter().any(|e| e.pass == "P8 CC verification"), + "{role:?}/{mutation}: {errors:?}" + ); + } + } +} diff --git a/crates/psrs-driver/src/tests/control_regressions/mod.rs b/crates/psrs-driver/src/tests/control_regressions/mod.rs new file mode 100644 index 00000000..86144464 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/mod.rs @@ -0,0 +1,26 @@ +//! Retired recognizer regressions re-expressed at their P8 construction owner. +//! Original cases: 01f7e66c, control_lifecycle_bodies/control_observable_paths. +mod checkpoints; +mod foreign; +mod lifecycle; +mod observables; +mod root; +mod steps; +mod transforms; + +const SOURCE: &str = include_str!("../../../tests/control_support/nominal_carriers.purs"); + +fn binding( + table: &psrs_backend::cc::RepresentationTable, + role: psrs_backend::cc::ControlHelperRole, +) -> (psrs_hir::SymbolId, psrs_backend::cc::ControlHelperId) { + let index = table + .control_helpers() + .iter() + .position(|helper| helper.role() == role) + .unwrap(); + ( + table.control_helpers()[index].function(), + psrs_backend::cc::ControlHelperId(index as u32), + ) +} diff --git a/crates/psrs-driver/src/tests/control_regressions/observables.rs b/crates/psrs-driver/src/tests/control_regressions/observables.rs new file mode 100644 index 00000000..4c88cff9 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/observables.rs @@ -0,0 +1,224 @@ +//! Complete helper paths reject extra effects before dispatch and before traps. +use super::{SOURCE, binding}; +use psrs_backend::cc::{ + Assignment, AssignmentKind as A, ControlHelperRole as R, ValueDecl, ValueId, +}; + +#[test] +fn cc_executor_prefix_and_trapping_default_reject_extra_static_checks() { + for prefix in [false, true] { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let (check, contract) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == executor) + .unwrap(); + let extent = function.parameters[4]; + let ty = function.values.iter().find(|v| v.id == extent).unwrap().ty; + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty, + }); + let extra = Assignment { + destination, + kind: A::DirectCall { + contract: Some(contract), + function: check, + arguments: vec![extent], + }, + span: function.span, + }; + if prefix { + function.assignments.insert(0, extra); + } else { + let A::TagSwitch { + default_assignments, + .. + } = &mut function.assignments.last_mut().unwrap().kind + else { + panic!("dispatch") + }; + default_assignments.insert(0, extra); + } + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("unaccounted static check"); + assert!( + errors + .iter() + .any(|e| matches!(e.pass, "P8 CC verification")), + "{prefix}: {errors:?}" + ); + } +} + +#[test] +fn cc_publication_rejects_an_extra_potentially_trapping_check() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (start, _) = binding(&input.cc.representations, R::Start); + let (check, contract) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == start) + .unwrap(); + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty: function.result_type, + }); + function.assignments.push(Assignment { + destination, + kind: A::DirectCall { + contract: Some(contract), + function: check, + arguments: vec![function.result], + }, + span: function.span, + }); + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("read-only is not unobservable"); + assert!( + errors.iter().any(|e| e.pass == "P8 CC verification"), + "{errors:?}" + ); +} + +#[test] +fn cc_executor_rejects_unused_erased_payload_recovery() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == executor) + .unwrap(); + let ty = function + .values + .iter() + .find(|v| v.id == function.parameters[2]) + .unwrap() + .ty; + let psrs_backend::cc::ValueShape::Reference(reference) = ty else { + panic!("computation") + }; + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty, + }); + function.assignments.insert( + 0, + Assignment { + destination, + kind: A::RepresentationCast { + destination, + value: function.parameters[0], + reference, + }, + span: function.span, + }, + ); + let errors = + psrs_backend::cc::verify_module(&input.cc).expect_err("unaccounted payload recovery"); + assert!( + errors.iter().any(|e| e + .message + .contains("emitted machine operands or ordered operations")), + "{errors:?}" + ); +} + +#[test] +fn cc_no_write_recursive_calls_are_not_total() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let original = input + .cc + .functions + .iter() + .find(|f| f.symbol == executor) + .unwrap(); + let extent_ty = original + .values + .iter() + .find(|v| v.id == original.parameters[4]) + .unwrap() + .ty; + let symbol = psrs_hir::SymbolId::new( + executor.module, + input + .cc + .functions + .iter() + .filter(|f| f.symbol.module == executor.module) + .map(|f| f.symbol.index) + .max() + .unwrap() + + 1, + ); + let span = original.span; + input.cc.functions.push(psrs_backend::cc::Function { + symbol, + name: "recursive_no_write".into(), + parameters: vec![ValueId(0)], + values: vec![ + ValueDecl { + id: ValueId(0), + ty: extent_ty, + }, + ValueDecl { + id: ValueId(1), + ty: extent_ty, + }, + ], + assignments: vec![Assignment { + destination: ValueId(1), + kind: A::DirectCall { + contract: None, + function: symbol, + arguments: vec![ValueId(0)], + }, + span, + }], + result: ValueId(1), + result_type: extent_ty, + span, + }); + let function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == executor) + .unwrap(); + let destination = ValueId(function.values.iter().map(|v| v.id.0).max().unwrap() + 1); + function.values.push(ValueDecl { + id: destination, + ty: extent_ty, + }); + function.assignments.insert( + 0, + Assignment { + destination, + kind: A::DirectCall { + contract: None, + function: symbol, + arguments: vec![function.parameters[4]], + }, + span, + }, + ); + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("an extra recursive call can diverge"); + assert!( + errors + .iter() + .any(|e| matches!(e.pass, "P8 CC verification")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/control_regressions/root.rs b/crates/psrs-driver/src/tests/control_regressions/root.rs new file mode 100644 index 00000000..c971a4de --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/root.rs @@ -0,0 +1,223 @@ +//! Root lifetime belongs to the same checked construction boundary as replay. +use super::{SOURCE, binding}; +use psrs_backend::cc::{AssignmentKind as A, ControlHelperRole as R}; + +#[test] +fn cc_run_cannot_check_instead_of_closing_its_root() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (close, _) = binding(&input.cc.representations, R::Close); + let (check, check_id) = binding(&input.cc.representations, R::Check); + let function = input + .cc + .functions + .iter_mut() + .find(|f| { + f.assignments + .iter() + .any(|a| matches!(a.kind, A::DirectCall { function, .. } if function == close)) + }) + .expect("live Run must contain normal root cleanup"); + let assignment = function + .assignments + .iter_mut() + .find(|a| matches!(a.kind, A::DirectCall { function, .. } if function == close)) + .unwrap(); + let A::DirectCall { + function, contract, .. + } = &mut assignment.kind + else { + unreachable!() + }; + *function = check; + *contract = Some(check_id); + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("Run cannot publish a result without closing its own root"); + assert!( + errors.iter().any(|e| e + .message + .contains("emitted machine operands or ordered operations")), + "{errors:?}" + ); +} + +#[test] +fn cc_run_requires_its_fresh_root_empty_queue_ordered_close_and_result() { + use psrs_backend::cc::{Assignment, Function, ValueDecl, ValueId}; + #[derive(Clone, Copy, Debug)] + enum Mutation { + MissingClose, + EarlyClose, + WrongResult, + ExecutionRoot, + DispatchRoot, + CloseRoot, + NonemptyQueue, + } + use Mutation::*; + for mutation in [ + MissingClose, + EarlyClose, + WrongResult, + ExecutionRoot, + DispatchRoot, + CloseRoot, + NonemptyQueue, + ] { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (run, _) = binding(&input.cc.representations, R::Run); + let (start, start_id) = binding(&input.cc.representations, R::Start); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let (close, _) = binding(&input.cc.representations, R::Close); + let f: &mut Function = input + .cc + .functions + .iter_mut() + .find(|f| f.symbol == run) + .unwrap(); + let call_index = f + .assignments + .iter() + .position(|a| matches!(a.kind, A::DirectCall {function,..} if function == executor)) + .unwrap(); + let A::DirectCall { arguments, .. } = &f.assignments[call_index].kind else { + unreachable!() + }; + let (queue, root, context) = (arguments[3], arguments[4], arguments[5]); + let close_index = f + .assignments + .iter() + .position(|a| matches!(a.kind, A::DirectCall {function,..} if function == close)) + .unwrap(); + match mutation { + MissingClose => { + f.assignments.remove(close_index); + } + EarlyClose => { + let close = f.assignments.remove(close_index); + f.assignments.insert(call_index, close); + } + WrongResult => { + f.result = f.parameters[0]; + } + ExecutionRoot | DispatchRoot | CloseRoot => { + let extra = ValueId(f.values.iter().map(|v| v.id.0).max().unwrap() + 1); + let ty = f.values.iter().find(|v| v.id == root).unwrap().ty; + f.values.push(ValueDecl { id: extra, ty }); + f.assignments.insert( + call_index, + Assignment { + destination: extra, + kind: A::DirectCall { + contract: Some(start_id), + function: start, + arguments: vec![], + }, + span: f.span, + }, + ); + if matches!(mutation, ExecutionRoot) { + let A::DirectCall { arguments, .. } = &mut f.assignments[call_index + 1].kind + else { + unreachable!() + }; + arguments[4] = extra; + } else if matches!(mutation, DispatchRoot) { + // The new root must be bound before the context allocation. + let context_index = f + .assignments + .iter() + .position(|a| a.destination == context) + .unwrap(); + let allocation = f.assignments.remove(call_index); + f.assignments.insert(context_index, allocation); + let A::VariantNew { fields, .. } = &mut f.assignments[context_index + 1].kind + else { + unreachable!() + }; + fields[0] = extra; + } else { + let A::DirectCall { arguments, .. } = &mut f.assignments[close_index + 1].kind + else { + unreachable!() + }; + arguments[0] = extra; + } + } + NonemptyQueue => { + let A::VariantNew { case, fields, .. } = &mut f + .assignments + .iter_mut() + .find(|a| a.destination == queue) + .unwrap() + .kind + else { + unreachable!() + }; + *case = 2; // Append(Empty, Empty) has no callbacks but is not Empty. + fields.extend([queue, queue]); + // Replace self-references with a separate valid Empty, so this + // exercises the machine relation rather than use-before-bind. + let empty = ValueId(f.values.iter().map(|v| v.id.0).max().unwrap() + 1); + let ty = f.values.iter().find(|v| v.id == queue).unwrap().ty; + f.values.push(ValueDecl { id: empty, ty }); + let mut allocation = f + .assignments + .iter() + .find(|a| a.destination == queue) + .unwrap() + .clone(); + let A::VariantNew { + destination, + case, + fields, + .. + } = &mut allocation.kind + else { + unreachable!() + }; + *destination = empty; + *case = 0; + fields.clear(); + allocation.destination = empty; + let index = f + .assignments + .iter() + .position(|a| a.destination == queue) + .unwrap(); + f.assignments.insert(index, allocation); + let A::VariantNew { fields, .. } = &mut f.assignments[index + 1].kind else { + unreachable!() + }; + *fields = vec![empty, empty]; + } + } + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("malformed Run must fail P8 construction verification"); + assert!( + errors.iter().any(|e| e + .message + .contains("emitted machine operands or ordered operations")), + "mutation {mutation:?}: {errors:?}" + ); + } +} + +#[test] +fn sequential_and_exclusive_runs_preserve_independent_invocations_after_optimization() { + const HEADER: &str = r"module Main where +import Prim.Control as C +data Op x = Op (Int -> x) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler state (Op k) raw = { _1: state, _2: raw (k 42) } +"; + for body in [ + "intAdd ((C.run 0 handler (C.return 20))._2) ((C.run 0 handler (C.return 22))._2)", + r"let invoke = \flag -> if flag then (C.run 0 handler (C.return 20))._2 else (C.run 0 handler (C.return 22))._2 in intAdd (invoke true) (invoke false)", + ] { + let source = format!("{HEADER}\nmain :: Int\nmain = {body}\n"); + let Some(output) = super::super::run_with_wasmtime(&source) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + } +} diff --git a/crates/psrs-driver/src/tests/control_regressions/steps.rs b/crates/psrs-driver/src/tests/control_regressions/steps.rs new file mode 100644 index 00000000..5522bce5 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/steps.rs @@ -0,0 +1,337 @@ +//! Dispatch, Bind/Resume, Finish and helper-call obligations at the P8 boundary. +//! Historical owners: control_dispatch, control_clause_steps, control_execution_steps, +//! control_finish_provenance and control_helper_contracts at `01f7e66c`. +use super::{SOURCE, binding}; +use psrs_backend::cc::{Assignment, AssignmentKind as A, ControlHelperRole as R, Function}; + +fn visit(body: &mut [Assignment], mutation: &mut impl FnMut(&mut A) -> bool) -> bool { + for assignment in body { + if mutation(&mut assignment.kind) { + return true; + } + match &mut assignment.kind { + A::TagSwitch { + cases, + default_assignments, + .. + } => { + for case in cases { + if visit(&mut case.assignments, mutation) { + return true; + } + } + if visit(default_assignments, mutation) { + return true; + } + } + A::If { + then_assignments, + else_assignments, + .. + } => { + if visit(then_assignments, mutation) || visit(else_assignments, mutation) { + return true; + } + } + _ => {} + } + } + false +} + +fn expect_boundary(input: &psrs_backend::BackendInput) { + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("malformed machine step must fail P8"); + assert!( + errors.iter().any(|error| error + .message + .contains("emitted machine operands or ordered operations") + || error + .message + .contains("control helper call is missing its semantic contract") + || error + .message + .contains("disagrees with its predeclared semantic helper")), + "{errors:?}" + ); +} + +fn executor(input: &mut psrs_backend::BackendInput) -> &mut Function { + let (symbol, _) = binding(&input.cc.representations, R::Executor); + input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == symbol) + .expect("Executor") +} + +fn arm(function: &mut Function, tag: i32) -> &mut Vec { + let A::TagSwitch { cases, .. } = &mut function.assignments.last_mut().unwrap().kind else { + panic!("executor dispatches on the computation"); + }; + &mut cases + .iter_mut() + .find(|case| case.tag == tag) + .expect("computation arm") + .assignments +} + +fn first_switch_arm(body: &mut [Assignment], tag: i32) -> &mut Vec { + for assignment in body { + if let A::TagSwitch { cases, .. } = &mut assignment.kind { + return &mut cases + .iter_mut() + .find(|case| case.tag == tag) + .unwrap_or_else(|| panic!("dispatch arm {tag}")) + .assignments; + } + } + panic!("no nested dispatch") +} + +#[test] +fn cc_executor_dispatch_default_must_trap() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let function = executor(&mut input); + let A::TagSwitch { + default_assignments, + default_value, + .. + } = &mut function.assignments.last_mut().unwrap().kind + else { + panic!("computation dispatch"); + }; + default_assignments.clear(); + *default_value = function.parameters[0]; + expect_boundary(&input); +} + +#[test] +fn cc_executor_cannot_return_state_instead_of_the_dispatch_result() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let function = executor(&mut input); + function.result = function.parameters[0]; + expect_boundary(&input); +} + +#[test] +fn cc_bind_cannot_reenter_the_current_computation() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor_symbol, _) = binding(&input.cc.representations, R::Executor); + let function = executor(&mut input); + let current = function.parameters[2]; + let body = arm(function, 2); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, + arguments, + .. + } = kind + && *function == executor_symbol + { + arguments[2] = current; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_bind_cannot_replace_its_callback_with_the_root_handler() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let function = executor(&mut input); + let handler = function.parameters[1]; + let body = arm(function, 2); + assert!(visit(body, &mut |kind| { + if let A::VariantNew { + case: 1, fields, .. + } = kind + && fields.len() == 2 + { + fields[0] = handler; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_resume_cannot_replace_replay_activation_with_the_current_extent() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor_symbol, _) = binding(&input.cc.representations, R::Executor); + let function = executor(&mut input); + let current = function.parameters[4]; + let body = arm(function, 3); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, + arguments, + .. + } = kind + && *function == executor_symbol + { + arguments[4] = current; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_finish_cannot_close_the_parent_instead_of_its_extent() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (close, _) = binding(&input.cc.representations, R::Close); + let function = executor(&mut input); + let body = first_switch_arm(arm(function, 0), 3); + let parent = body + .iter() + .find_map(|assignment| match &assignment.kind { + A::VariantGet { field: 2, .. } => Some(assignment.destination), + _ => None, + }) + .expect("Finish parent projection"); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, + arguments, + .. + } = kind + && *function == close + { + arguments[0] = parent; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_finish_cannot_restore_the_closed_extent_as_its_parent() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor_symbol, _) = binding(&input.cc.representations, R::Executor); + let (close, _) = binding(&input.cc.representations, R::Close); + let function = executor(&mut input); + let body = first_switch_arm(arm(function, 0), 3); + let closed = body + .iter() + .find_map(|assignment| match &assignment.kind { + A::DirectCall { + function, + arguments, + .. + } if *function == close => Some(arguments[0]), + _ => None, + }) + .expect("Finish close"); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, + arguments, + .. + } = kind + && *function == executor_symbol + { + arguments[4] = closed; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_scoped_return_cannot_discard_the_clause_result() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (executor_symbol, _) = binding(&input.cc.representations, R::Executor); + let function = executor(&mut input); + let current = function.parameters[2]; + let empty = first_switch_arm(arm(function, 0), 0); + let body = first_switch_arm(empty, 1); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, + arguments, + .. + } = kind + && *function == executor_symbol + { + arguments[2] = current; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_helper_call_cannot_drop_its_semantic_contract() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (check, _) = binding(&input.cc.representations, R::Check); + let function = executor(&mut input); + assert!(visit(&mut function.assignments, &mut |kind| { + if let A::DirectCall { + function, contract, .. + } = kind + && *function == check + { + *contract = None; + return true; + } + false + })); + expect_boundary(&input); +} + +#[test] +fn cc_control_evidence_rejects_a_dangling_contract() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let mut found = false; + for function in &mut input.cc.functions { + if visit(&mut function.assignments, &mut |kind| { + if let A::ControlEvidence { contract, .. } = kind { + *contract = psrs_backend::cc::ControlContractId(u32::MAX); + return true; + } + false + }) { + found = true; + break; + } + } + assert!(found); + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("a dangling source contract must fail CC verification"); + assert!( + errors + .iter() + .any(|error| error.message.contains("no checked source contract")), + "{errors:?}" + ); +} + +#[test] +fn cc_finish_cannot_exchange_close_for_check() { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (close, _) = binding(&input.cc.representations, R::Close); + let (check, check_id) = binding(&input.cc.representations, R::Check); + let function = executor(&mut input); + let body = first_switch_arm(arm(function, 0), 3); + assert!(visit(body, &mut |kind| { + if let A::DirectCall { + function, contract, .. + } = kind + && *function == close + { + *function = check; + *contract = Some(check_id); + return true; + } + false + })); + expect_boundary(&input); +} diff --git a/crates/psrs-driver/src/tests/control_regressions/transforms.rs b/crates/psrs-driver/src/tests/control_regressions/transforms.rs new file mode 100644 index 00000000..dcbaa359 --- /dev/null +++ b/crates/psrs-driver/src/tests/control_regressions/transforms.rs @@ -0,0 +1,413 @@ +//! Root fixtures whose historical owners were post-construction recognizers. +//! +//! Start's status-cell length is rejected by the P8 boundary. Sharing one fresh +//! root across exclusive successors, distributing Close, excluding a trapping +//! alternative, and copying the root reference are ordinary pre-optimization +//! MIR shapes. Generic MIR verification accepts them. A missing normal Close +//! stays a P8 rejection in `root`, not a new MIR recognizer. + +use super::{SOURCE, binding}; +use psrs_backend::cc::AssignmentKind as A; +use psrs_backend::cc::ControlHelperRole as R; +use psrs_backend::mir::{BasicBlock, BlockId, Instruction as I, Module, Terminator as T}; +use psrs_backend::types::{ValueDecl, ValueId, ValueType}; +use psrs_hir::SymbolId; +use std::collections::HashMap; + +#[test] +fn cc_start_rejects_a_status_cell_whose_length_is_not_one() { + for length in [0, 2] { + let mut input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (start, _) = binding(&input.cc.representations, R::Start); + let function = input + .cc + .functions + .iter_mut() + .find(|function| function.symbol == start) + .expect("Start helper"); + let mut cells = 0; + for assignment in &mut function.assignments { + let A::ArrayNew { elements, .. } = &mut assignment.kind else { + continue; + }; + cells += 1; + if length == 0 { + elements.clear(); + } else { + let element = elements[0]; + elements.push(element); + } + } + assert_eq!(cells, 1, "Start allocates one status cell"); + let errors = psrs_backend::cc::verify_module(&input.cc) + .expect_err("a status cell must contain exactly one live element"); + assert!( + errors.iter().any(|error| error + .message + .contains("emitted machine operands or ordered operations")), + "length {length}: {errors:?}" + ); + } +} + +#[test] +fn pre_optimization_run_accepts_exclusive_sharing_distributed_close_and_copies() { + let (start, close, executor, mut module) = run_module(); + psrs_backend::mir::verify_module(&module).expect("unmodified Run lowers"); + let baseline = calls(&module, start); + assert_eq!(baseline, 1); + assert_eq!(calls(&module, close), 1); + + share_root(&mut module, start); + psrs_backend::mir::verify_module(&module).unwrap_or_else(|errors| { + panic!("exclusive successors may share one fresh root: {errors:?}") + }); + assert_eq!( + calls(&module, start), + baseline, + "Start stays one allocation" + ); + assert_eq!(calls(&module, executor), baseline * 2); + assert_eq!(calls(&module, close), baseline * 2); + + let (_, _, _, mut module) = run_module(); + distribute_close(&mut module, close, false); + psrs_backend::mir::verify_module(&module) + .unwrap_or_else(|errors| panic!("Close may be repeated on normal branches: {errors:?}")); + assert_eq!(calls(&module, close), baseline * 2); + + let (_, _, _, mut module) = run_module(); + distribute_close(&mut module, close, true); + psrs_backend::mir::verify_module(&module).unwrap_or_else(|errors| { + panic!("a trapping alternative is outside the normal close proof: {errors:?}") + }); + assert_eq!(calls(&module, close), baseline); + assert!(module.functions.iter().any(|function| { + function + .blocks + .iter() + .any(|block| matches!(block.terminator, Some(T::Trap { .. }))) + })); + + let (_, _, _, mut module) = run_module(); + copy_root(&mut module, close); + psrs_backend::mir::verify_module(&module) + .unwrap_or_else(|errors| panic!("Close may use a copy of its root reference: {errors:?}")); +} + +fn run_module() -> (SymbolId, SymbolId, SymbolId, Module) { + let input = crate::lower_main_to_cc(SOURCE).unwrap(); + let (start, _) = binding(&input.cc.representations, R::Start); + let (close, _) = binding(&input.cc.representations, R::Close); + let (executor, _) = binding(&input.cc.representations, R::Executor); + let (run, _) = binding(&input.cc.representations, R::Run); + let (module, _) = psrs_backend::mir::lower_module(input.cc).unwrap(); + let function = module + .functions + .iter() + .find(|function| function.symbol == run) + .expect("Run helper"); + assert_eq!( + function.blocks.len(), + 1, + "pre-optimization Run is the straight-line plan" + ); + (start, close, executor, module) +} + +fn run_function(module: &mut Module) -> &mut psrs_backend::mir::Function { + module + .functions + .iter_mut() + .find(|function| function.name == "control_run") + .expect("Run helper name") +} + +fn calls(module: &Module, target: SymbolId) -> usize { + module + .functions + .iter() + .filter(|function| function.name == "control_run") + .flat_map(|function| &function.blocks) + .flat_map(|block| &block.instructions) + .filter( + |instruction| matches!(instruction, I::Call { function, .. } if *function == target), + ) + .count() +} + +fn share_root(module: &mut Module, start: SymbolId) { + let function = run_function(module); + let span = function.span; + let start_at = function.blocks[0] + .instructions + .iter() + .position( + |instruction| matches!(instruction, I::Call { function, .. } if *function == start), + ) + .expect("Start call"); + let tail = function.blocks[0].instructions.split_off(start_at + 1); + let result = match function.blocks[0].terminator.take() { + Some(T::Return { value, .. }) => value, + other => panic!("Run returns normally, got {other:?}"), + }; + assert!( + tail.iter() + .any(|instruction| instruction.destination() == Some(result)), + "the Run result is produced after Start" + ); + let (else_tail, copied) = duplicate(function, &tail); + let else_result = copied[&result]; + let then_block = BlockId( + function + .blocks + .iter() + .map(|block| block.id.0) + .max() + .unwrap() + + 1, + ); + let else_block = BlockId(then_block.0 + 1); + let condition = fresh_value(function, ValueType::Boolean); + function.blocks[0].instructions.push(I::Constant { + destination: condition, + value: 1, + span, + }); + function.blocks[0].terminator = Some(T::Branch { + condition, + then_block, + else_block, + span, + }); + function.blocks.extend([ + block_returning(then_block, tail, result, span), + block_returning(else_block, else_tail, else_result, span), + ]); +} + +fn distribute_close(module: &mut Module, close: SymbolId, trap: bool) { + let function = run_function(module); + let span = function.span; + let close_at = function.blocks[0] + .instructions + .iter() + .position( + |instruction| matches!(instruction, I::Call { function, .. } if *function == close), + ) + .expect("Close call"); + let close_instruction = function.blocks[0].instructions.remove(close_at); + let suffix = function.blocks[0].instructions.split_off(close_at); + let terminator = function.blocks[0].terminator.take(); + let destination = match &close_instruction { + I::Call { destination, .. } => *destination, + _ => unreachable!("Close is a call"), + }; + let result_ty = function + .values + .iter() + .find(|value| value.id == destination) + .unwrap() + .ty; + let alias = fresh_value(function, result_ty); + let mut other = close_instruction.clone(); + let I::Call { destination, .. } = &mut other else { + unreachable!("Close is a call"); + }; + *destination = alias; + let then_block = BlockId( + function + .blocks + .iter() + .map(|block| block.id.0) + .max() + .unwrap() + + 1, + ); + let else_block = BlockId(then_block.0 + 1); + let join = BlockId(then_block.0 + 2); + let condition = fresh_value(function, ValueType::Boolean); + function.blocks[0].instructions.push(I::Constant { + destination: condition, + value: 1, + span, + }); + function.blocks[0].terminator = Some(T::Branch { + condition, + then_block, + else_block, + span, + }); + let jump = Some(T::Jump { + target: join, + arguments: vec![], + span, + }); + function.blocks.extend([ + BasicBlock { + id: then_block, + parameters: vec![], + instructions: vec![close_instruction], + terminator: jump.clone(), + }, + BasicBlock { + id: else_block, + parameters: vec![], + instructions: if trap { vec![] } else { vec![other] }, + terminator: if trap { Some(T::Trap { span }) } else { jump }, + }, + BasicBlock { + id: join, + parameters: vec![], + instructions: suffix, + terminator, + }, + ]); +} + +fn copy_root(module: &mut Module, close: SymbolId) { + let function = run_function(module); + let span = function.span; + let close_at = function.blocks[0] + .instructions + .iter() + .position( + |instruction| matches!(instruction, I::Call { function, .. } if *function == close), + ) + .expect("Close call"); + let root = match &function.blocks[0].instructions[close_at] { + I::Call { arguments, .. } => arguments[0], + _ => unreachable!("Close is a call"), + }; + let ty = function + .values + .iter() + .find(|value| value.id == root) + .unwrap() + .ty; + let alias = fresh_value(function, ty); + match &mut function.blocks[0].instructions[close_at] { + I::Call { arguments, .. } => arguments[0] = alias, + _ => unreachable!("Close is a call"), + } + function.blocks[0].instructions.insert( + close_at, + I::Copy { + destination: alias, + value: root, + span, + }, + ); +} + +fn duplicate( + function: &mut psrs_backend::mir::Function, + tail: &[I], +) -> (Vec, HashMap) { + let mut map = HashMap::new(); + for instruction in tail { + if let Some(destination) = instruction.destination() { + let ty = function + .values + .iter() + .find(|value| value.id == destination) + .expect("defined Run value") + .ty; + map.insert(destination, fresh_value(function, ty)); + } + } + let copied = tail + .iter() + .cloned() + .map(|instruction| retarget(instruction, &map)) + .collect(); + (copied, map) +} + +fn retarget(instruction: I, map: &HashMap) -> I { + let id = |value: ValueId| map.get(&value).copied().unwrap_or(value); + match instruction { + I::Call { + contract, + destination, + function, + arguments, + span, + } => I::Call { + contract, + destination: id(destination), + function, + arguments: arguments.into_iter().map(id).collect(), + span, + }, + I::StructNew { + destination, + type_index, + arguments, + span, + } => I::StructNew { + destination: id(destination), + type_index, + arguments: arguments.into_iter().map(id).collect(), + span, + }, + I::Constant { + destination, + value, + span, + } => I::Constant { + destination: id(destination), + value, + span, + }, + I::RefCast { + destination, + value, + reference, + span, + } => I::RefCast { + destination: id(destination), + value: id(value), + reference, + span, + }, + I::Copy { + destination, + value, + span, + } => I::Copy { + destination: id(destination), + value: id(value), + span, + }, + other => panic!("Run lowering produced an unexpected instruction: {other:?}"), + } +} + +fn block_returning( + id: BlockId, + instructions: Vec, + value: ValueId, + span: psrs_span::TextRange, +) -> BasicBlock { + BasicBlock { + id, + parameters: vec![], + instructions, + terminator: Some(T::Return { value, span }), + } +} + +fn fresh_value(function: &mut psrs_backend::mir::Function, ty: ValueType) -> ValueId { + let id = ValueId( + function + .values + .iter() + .map(|value| value.id.0) + .max() + .unwrap() + + 1, + ); + function.values.push(ValueDecl { id, ty }); + id +} diff --git a/crates/psrs-driver/src/tests/mod.rs b/crates/psrs-driver/src/tests/mod.rs index ea66729c..af585f6a 100644 --- a/crates/psrs-driver/src/tests/mod.rs +++ b/crates/psrs-driver/src/tests/mod.rs @@ -7,8 +7,10 @@ static WASM_ARTIFACT_COUNTER: AtomicU32 = AtomicU32::new(0); mod assertions; mod closure_protocol; mod coercion; +mod control_boundary; mod control_carriers; mod control_costs; +mod control_regressions; mod data_function; mod data_tuple; mod declaration_calls; diff --git a/crates/psrs-driver/tests/control_reference.rs b/crates/psrs-driver/tests/control_reference.rs new file mode 100644 index 00000000..279c97a7 --- /dev/null +++ b/crates/psrs-driver/tests/control_reference.rs @@ -0,0 +1,149 @@ +//! Pinned independent-package Control/Run fixtures from +//! `psrs-stdlib/conformance/control/`. They execute ordinary library wrappers. +mod control_support; + +#[test] +fn locked_run_state_threads_put_modify_and_get() { + control_support::execute( + "run-state", + r"module Main where +import Prelude +import Run (Run, extract) +import Run.State (State, put, modify, get, evalState) +program :: Run (state :: State Int) Int +program = do + put 20 + modify (\value -> value + 22) + get +main :: Int +main = extract (evalState 0 program) +", + 42, + ); +} + +#[test] +fn locked_run_choose_executes_both_alternatives() { + control_support::execute( + "run-choose", + r"module Main where +import Prelude +import Run (Run, extract) +import Run.Choose (Choose, calt, runChoose) +import Data.Array (length) +program :: Run (choose :: Choose) Int +program = calt (pure 20) (pure 22) +answers :: Array Int +answers = extract (runChoose program) +main :: Int +main = if answers == [20, 22] && length answers == 2 then 42 else 0 +", + 42, + ); +} + +#[test] +fn locked_run_handlers_compose_reader_state_writer_and_except() { + control_support::execute( + "run-handlers", + r#"module Main where +import Prelude +import Data.Either (Either(..)) +import Data.Tuple (Tuple(..)) +import Run (Run, extract) +import Run.Reader (Reader, ask, local, runReader) +import Run.State (State, put, modify, get, evalState) +import Run.Writer (Writer, tell, censor, foldWriter) +import Run.Except (Except, throw, runExcept) +program :: Run (reader :: Reader Int, state :: State Int, writer :: Writer String, except :: Except String) Int +program = do + seed <- ask + put seed + local (\n -> n + 1) do + adjusted <- ask + modify (\n -> n + adjusted) + tell "a" + censor (\s -> s <> "!") (tell "b") + value <- get + if value == 41 then pure (value + 1) else throw "incorrect state" +main :: Int +main = case extract (runExcept (foldWriter (\a b -> a <> b) "" (evalState 0 (runReader 20 program)))) of + Right (Tuple log answer) -> if log == "ab!" then answer else 0 + Left _ -> 0 +"#, + 42, + ); +} + +#[test] +fn locked_labelled_rows_deep_forwards_and_reinstalls() { + control_support::execute( + "rows-deep", + r#"module Main where +import Prelude +import PSRS.Control as C +import PSRS.Control.Row as R +import Type.Proxy (Proxy(..)) +data Read x = Read (Int -> x) +derive instance functorRead :: Functor Read +program :: R.Computation (left :: Read, right :: Read) Int +program = C.bind (R.performAt (Proxy :: Proxy "left") (Read identity)) \left -> + C.bind (R.performAt (Proxy :: Proxy "right") (Read identity)) \right -> + C.bind (R.performAt (Proxy :: Proxy "left") (Read identity)) (\_ -> C.pure (left + right)) +handleLeft :: forall x. Int -> Read x -> (Int -> x -> R.Computation (right :: Read) { _1 :: Int, _2 :: Int }) -> R.Computation (right :: Read) { _1 :: Int, _2 :: Int } +handleLeft state (Read answer) resume = resume (state + 1) (answer 20) +handleRight :: forall x. Int -> Read x -> (Int -> x -> R.Computation () { _1 :: Int, _2 :: { _1 :: Int, _2 :: Int } }) -> R.Computation () { _1 :: Int, _2 :: { _1 :: Int, _2 :: Int } } +handleRight state (Read answer) resume = resume (state + 1) (answer 22) +main :: Int +main = let result = R.runPure (R.handleDeepAt (Proxy :: Proxy "right") handleRight 0 (R.handleDeepAt (Proxy :: Proxy "left") handleLeft 0 program)) + in if result._1 == 1 && result._2._1 == 2 then result._2._2 else 0 +"#, + 42, + ); +} + +#[test] +fn locked_labelled_rows_shallow_escape_keeps_the_residual() { + control_support::execute( + "rows-shallow", + r#"module Main where +import Prelude +import PSRS.Control as C +import PSRS.Control.Row as R +import Type.Proxy (Proxy(..)) +data Read x = Read (Int -> x) +derive instance functorRead :: Functor Read +program :: R.Computation (ask :: Read) Int +program = C.bind (R.performAt (Proxy :: Proxy "ask") (Read identity)) \first -> + C.bind (R.performAt (Proxy :: Proxy "ask") (Read identity)) \second -> C.pure (first + second) +inner :: forall x. Int -> Read x -> (Int -> x -> R.Computation (ask :: Read) { _1 :: Int, _2 :: Int }) -> R.Computation (ask :: Read) { _1 :: Int, _2 :: Int } +inner state (Read answer) resume = resume (state + 1) (answer 20) +outer :: forall x. Int -> Read x -> (Int -> x -> R.Computation () { _1 :: Int, _2 :: { _1 :: Int, _2 :: Int } }) -> R.Computation () { _1 :: Int, _2 :: { _1 :: Int, _2 :: Int } } +outer state (Read answer) resume = resume (state + 1) (answer 22) +main :: Int +main = let result = R.runPure (R.handleDeepAt (Proxy :: Proxy "ask") outer 0 (R.handleShallowAt (Proxy :: Proxy "ask") inner 0 program)) + in if result._1 == 1 && result._2._1 == 1 then result._2._2 else 0 +"#, + 42, + ); +} + +#[test] +fn locked_labelled_rows_reject_a_nonempty_residual_at_run_pure() { + let source = r"module Main where +import PSRS.Control as C +import PSRS.Control.Row as R +data Read x = Read x +program :: R.Computation (ask :: Read) Int +program = C.pure 42 +main :: Int +main = R.runPure program +"; + let errors = psrs_driver::check_source("Main.purs", source).expect_err("residual row"); + assert!( + errors + .iter() + .any(|error| error.code == Some("TypesDoNotUnify")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/tests/control_runtime.rs b/crates/psrs-driver/tests/control_runtime.rs index 9819a5c7..850e98a0 100644 --- a/crates/psrs-driver/tests/control_runtime.rs +++ b/crates/psrs-driver/tests/control_runtime.rs @@ -196,6 +196,34 @@ main = if intEq result._1.count 1 then result._2.answer else 1 ); } +#[test] +fn collection_preserves_array_and_string_captures_across_suspension() { + execute_gc( + "buffer-gc", + r#"module Main where +import Prim.Control as C +data Op next = Op (Int -> next) +data Noise next = Noise (Int -> next) +handler :: forall x. Int -> Op x -> (x -> C.Control Op Int) -> { _1 :: Int, _2 :: C.Control Op Int } +handler s (Op k) cont = let churn = C.run 0 noiseHandler (noise 4000) in { _1: intAdd s churn._1, _2: cont (k 0) } +noiseHandler :: forall x. Int -> Noise x -> (x -> C.Control Noise Int) -> { _1 :: Int, _2 :: C.Control Noise Int } +noiseHandler s (Noise k) cont = { _1: intAdd s 1, _2: cont (k s) } +noise :: Int -> C.Control Noise Int +noise n = if intEq n 0 then C.return 0 else C.bind (C.perform (Noise \x -> x)) (\_ -> noise (intSub n 1)) +program :: C.Control Op Int +program = let numbers = [40, 2] + text = stringToBytes (numberToString 10.0) + in C.bind (C.perform (Op \x -> x)) (\_ -> C.return (if intEq (arrayLength text) 0 then 0 else intAdd (arrayIndex numbers 0) (arrayLength numbers))) +main :: Int +main = (C.run 0 handler program)._2 +"#, + ); +} + +fn execute_gc(name: &str, source: &str) { + control_support::execute_with_gc(name, source, 42); +} + #[test] fn function_answers_use_the_shared_callable_protocol() { execute( diff --git a/docs/design/backend/fp/control-elimination-and-handler-scopes.md b/docs/design/backend/fp/control-elimination-and-handler-scopes.md index 3572194b..2881f1ea 100644 --- a/docs/design/backend/fp/control-elimination-and-handler-scopes.md +++ b/docs/design/backend/fp/control-elimination-and-handler-scopes.md @@ -389,30 +389,25 @@ remains a separate producer obligation. ### Root initialization and normal completion -A checked Run factory starts with the canonical empty queue and a new root -extent, installing a Root dispatch context containing that same extent. Start -returns a freshly allocated parentless extent with a new one-element live status -cell. Different sequential Run invocations must not share an extent or status -cell. Mutually exclusive alternatives may share initialization within one -invocation; recursion and loop iterations still require a new activation. - -Normal execution closes that root after the executor returns and before the -checked Run result is published. A check, a close of another root, or a close -before execution does not satisfy completion. CC checks the factory sequence and -source witness, using branch identity to distinguish exclusive alternatives. -MIR admits both a retained Start call and its inlined root/status allocations; -common allocation ordering checks the current invocation/iteration. Common CFG -analysis checks root reuse without reinitialization and requires a matching close -on every normal path before publication, another invocation or a normal exit. -The close can be distributed across several branches. - -These checks retain the source contract through Start inlining and ordinary -reference copies/casts. They establish initialization operands and normal cleanup -for surviving checked Run witnesses, not full execution-step equivalence. Extra -effectful instructions, deletion of every source witness and full dispatch -semantics require the remaining execution-step proof. Trapping paths are excluded -from the normal completion proof; caught-host-trap cleanup still requires its -separate host/runtime contract and execution evidence. +A checked Run plan starts with the canonical empty queue and a fresh Start +extent. It installs a Root dispatch context containing that same extent, calls +the executor with that extent for both execution and dispatch, closes that root +after the executor returns, and returns that executor result. Start returns a +freshly allocated parentless extent whose status cell is a new one-element array +initialized live. The P8 boundary rejects any other cell length, a non-empty +queue, a different execution or dispatch root, a close of another root, a close +before execution, a check in place of close, a missing close, and any returned +value other than the executor result. + +The Run helper allocates that root, so a caller cannot pass one invocation's +root or status cell into the next. Mutually exclusive alternatives may share +initialization within one invocation. Each invocation and each loop iteration +still needs its own activation. After the construction boundary, ordinary MIR +may copy the root reference, repeat the same close on normal branches, leave a +trapping alternative without a close, or keep one Start in a block that +dominates both exclusive successors. Those are generic CFG and identity forms. +Deleting the constructed close after that boundary is outside the promised +rejection. Caught-host-trap cleanup remains a separate host contract. ### Source context construction and entry diff --git a/docs/design/backend/fp/control-machine.md b/docs/design/backend/fp/control-machine.md index e9ffb43d..53b0b326 100644 --- a/docs/design/backend/fp/control-machine.md +++ b/docs/design/backend/fp/control-machine.md @@ -276,7 +276,7 @@ bodies can only consume the plan: 1. **Reserve and plan.** Before source signatures and aggregate layouts, reserve the nominal `Control`/`Resumption` identities. Then append the carrier and helper tables and allocate the generated symbols: the raw resumption code - target and the eight helpers (`executor`, `cloneSequence`, `rebuildSequence`, + target and the nine helpers (`run`, `executor`, `cloneSequence`, `rebuildSequence`, `start`, `check`, `close`, `once`, `cancel`). Publish the helper contracts and the raw-resumption contract in the representation table, and quote each checked Core contract into a plan that maps every primitive to a computation @@ -287,12 +287,14 @@ bodies can only consume the plan: machine carrier directly as its nominal reference. A checked `ControlEvidence` assignment records the proof and the chosen implementation. 3. **Construct frames.** `return`, `perform`, `bind`, `handle` and `resume` - simply build their computation node. `run` builds an empty queue, a root - extent, a `Root` context, calls the executor on - `(state, handler, computation, empty, boundary, root)`, and closes the - boundary. `once` and `cancel` call their helpers. + simply build their computation node. `run` calls its predeclared helper with + state, handler and computation. That checked helper builds an empty queue, a + fresh root extent and a `Root` context, calls the executor on + `(state, handler, computation, empty, boundary, root)`, closes that same root + on normal completion and returns the executor result. Source payload recovery + follows this helper call. `once` and `cancel` call their helpers. 4. **Synthesize helpers.** On first use, synthesize the raw resumption target and - the eight helpers from the fixed tables, and verify each synthesized function + the nine helpers from the fixed tables, and verify each synthesized function before publishing it. Bodies are built from the same shared operations that ordinary lowering uses, so no helper gets a private representation path. 5. **Lower to MIR.** The ordinary CC-to-MIR pass resolves symbolic @@ -312,12 +314,12 @@ this pipeline recognizes a concrete effect, operation or handler. fixes this boundary. The named schema, the action registry and the checked flat-driver plan are implemented: `control/schema.rs` names every carrier, case, field and helper role; `cc/control/schema.rs` freezes one module's placement and -checks it against those names; and `cc/lower/control/plan.rs` *builds* the flat +checks it against those names; and `cc/lower/control/plan/` *builds* the flat driver from a checked transition program that is expanded to ordinary CC. `check` independently verifies that every dispatch uses only declared cases and that every required flat-driver action is present before a body is emitted. -The helper bodies and the raw-resume closure adapter (`clone_sequence`, +The helper bodies and the raw-resume closure adapter (`run`, `clone_sequence`, `rebuild_sequence`, `start`, `check`, `close`, `once`, `cancel`, `resume`) are built from the same checked plans, so replay, lifecycle, the factories and the raw-resume entry no longer emit interleaved hand-written branches. The CC/MIR @@ -331,12 +333,24 @@ verification replace them. The plan contract is: one terminal outcome (`Advance` or `Publish`). Advancing supplies a complete named executor state; a branch cannot silently inherit mutable builder state. Every required case has an action. -3. The plan checks its dispatch coverage, allocation arity and action inventory - before emission. Generic IR verification still checks operands, types, - layout, casts and CFG. +3. A private `CheckedPlan` is the emitter's only input. Before publication, the + plan checks complete dispatch coverage and all 40 named action paths and + terminal roles, logical field/helper types, allocation/call arity, lexical + temporary/parameter scope and source-specific case refinements. The logical + schema is representation-neutral; CC planning resolves its field and helper + roles into nominal shapes. Generic IR verification still checks actual + operands, types, layout, casts and CFG. 4. Expansion emits ordinary CC against the immutable layout. The boundary - checker then re-checks the emitted body's dispatch and outcome against the - plan at module verification; tagging generated code with an action ID alone + checker independently walks the plan and the emitted assignment sequences at + module verification. It checks dispatch selectors and arms, projections and + indices, allocations and their fields, curried applications, helper targets + and arguments, capture slots, ordered guards and private-cell reads/writes, + trapping defaults and actual returned values. Extra or missing operations + fail even when their results are unused. Reference casts preserve operand + identity; generic CC verification owns their type legality. Recovery casts + must directly feed the next checked operation or actual exit, so a narrowing + cast cannot hide a trap behind erasure or move across an observable action. + Tagging generated code with an action ID alone would not validate it. Semantic rules and the emitter remain independently testable rather than generated from one unchecked template. 5. P9 translates checked CC to physical MIR under its ordinary representation, @@ -344,6 +358,15 @@ verification replace them. The plan contract is: discharged at expansion or retained for the P9 checks; no stale certificate may authorize modified instructions. +`FrozenControlPlan` publishes helper roles and symbols, source contracts and +quoted source type identities, raw-resumption binding and schema placement +through read-only queries. Publication is single-assignment and validates actual +carrier fields, private cells, products and helper signatures; a failed attempt +does not publish a partial plan. Ordinary layouts and instructions remain +mutable and verifiable. Machine emission holds an immutable table and its own +value declarations, with shared checked reference adaptation; it cannot access +source lowering environments or mutable layout planning. + The proof boundary after expansion is decided: the semantics-preserving ordinary P9/P10 transformations are trusted, their output IR invariants are validated, and their preservation of machine behavior is tested. This places them in the @@ -355,12 +378,23 @@ local helper identities and shape recognition cannot claim that guarantee. This changes verification architecture, not the selected runtime semantics. The machine-semantic recognizers are retired and the boundary checker replaces them -for construction; arbitrary IR-valid mutations injected after construction are -no longer rejected, which the optimizer and negative-test layers must account -for. The [review and migration gates](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) +for construction. CC operand mutations are checked against the plan at the P8 +module boundary. The MIR boundary still checks dispatch arms and external tail +targets only; arbitrary IR-valid operand mutations after P9 are not rejected. +The [review and migration gates](../../../implementation/backend/delimited-control-lowering-review-2026-10-14.md) record the alternatives and required evidence. No blanket helper exemption, inliner restriction, or narrowed AE/AC requirement closes this decision. +The independent test model executes the actual construction plans on a concrete +heap and compares them with separately written typed transitions and flat-list +replay. Comparison preserves original value identity, fresh-reference aliasing, +ordered status/callback operations, required allocation counts and actual exits. +The finite model covers all 40 named actions and generated queue shapes; semantic +mutations that preserve plan typing, scope and action coverage must still differ. +It does not interpret arbitrary source callback bodies, simulate native GC or +allocation failure, or establish equivalence of optimized MIR/Wasm. Those retain +their separate producer, target-execution and acceptance obligations. + ### Capture and frame construction Raw resume checks checkpoint liveness, runs the saved sequence before its consumer @@ -627,21 +661,22 @@ The machine's owners and their required responsibilities are: | --- | --- | | Checked Core control contracts | Quote each primitive's result, arguments and source/target domains before lowering | | CC layout planning | Reserve the nominal `Control`/`Resumption` carriers, the machine representations and every generated helper signature before bodies are lowered; keep the table immutable afterwards | -| CC control lowering | Emit the frame node for each primitive, route `run`/`once`/`cancel` to helpers, and synthesize the raw resumption target and the eight helpers from the fixed tables | +| CC control lowering | Emit the frame node for each primitive, route `run`/`once`/`cancel` to helpers, and synthesize the raw resumption target and the nine helpers from the fixed tables | | MIR lowering and optimization | Resolve symbolic representations to physical layouts and loopify the executor's self tail calls | -| CC/MIR machine verifiers | Check dispatch, actual exits, transition operands, capture and finish ownership, replay freshness, ordered private-cell updates and publication; prove lifecycle helper bodies and account for observable operations | +| P8 checked construction and CC boundary | Check dispatch, actual exits, transition operands, capture and finish ownership, replay freshness, ordered private-cell updates, complete Run lifecycle and publication; prove lifecycle helper bodies and account for observable operations | +| Ordinary MIR verification | Check physical IR, nominal variant tags, types, CFG and callable contracts; do not claim machine semantic equivalence after P9 | | Structured encoding | Emit the loop and its dispatch as ordinary Wasm control flow | The intended code organization is a machine-layout module (carrier tables and helper signatures), a lowering module that constructs nodes and synthesizes -helpers, and paired CC/MIR verification modules for each relation. No module +helpers, a P8 construction boundary, and ordinary CC/MIR verification. No module recognizes a concrete effect, operation or handler, and no helper gets a private representation path. -Stage-independent transition relations and ordered execution events have one -shared owner under `control/`. CC and MIR adapters supply representation, -reference-origin, selected-case and execution-order evidence; they must not -independently define the machine's state transitions. Observable-effect summaries +Stage-independent schema and action paths have one shared owner under +`control/`. The P8 plan states ordered execution; its independent boundary +checker validates actual emitted operands and operations. MIR consumers must +not reconstruct another private model of the machine's state transitions. Observable-effect summaries are shared with ordinary optimization, with separate facts for writes, allocation, possible traps, calls and termination. A no-write summary alone cannot discharge an unobservable-operation obligation. @@ -655,12 +690,12 @@ an unobservable-operation obligation. trapping default, and a projection is taken only from the case the dispatch actually selected. - A source `Return` applies its current scoped context's return clause and a - source `Perform` applies its operation clause; CC and MIR reject an applied + source `Perform` applies its operation clause; P8 rejects an applied clause taken from another field, another frame or a boundary. The scoped branch must use the complete application result as its next computation, consuming the current answer/request; an operation supplies the raw resumption over its current queue/checkpoint. State and the root handler - retain their identities. MIR requires the application to dominate that + retain their identities. P8 requires the application to precede that transition inside the scoped branch. A deleted or dead application and a discarded result do not discharge this contract. - An executor transition's result reaches the actual normal exit. CC checks @@ -669,8 +704,8 @@ an unobservable-operation obligation. results on subsequent normal exits and checks scoped transitions at actual terminators, rather than stopping at the first call instruction. Identity-preserving casts, copies and joins with the same normal origin are - accepted. MIR joins and execution dominance are resolved within the current - step's reachable CFG region; the executor loop header starts the next step. + accepted under ordinary IR rules after construction; the executor loop + header starts the next step. Construction itself uses the checked plan shape. - MIR checks every nominal variant constructor against its planned case, including ordinary data variants: the physical tag is an immutable `i32` initialized to that case's tag. Constant copies and equal constants at normal joins retain @@ -679,7 +714,7 @@ an unobservable-operation obligation. - `Bind` enters its own body with its own callback prepended to the current persistent queue. `Resume` returns its saved answer and appends the replayed queue to the current queue, installing the activation from that same replay - result. CC and MIR check these operands on the actual executor transition. + result. P8 checks these operands on the actual executor transition. - The pending sequence is persistent: replay never mutates a shared node, and the driver is the only code that traverses a saved sequence. - Root `Perform` applies the current handler to state, request and the raw @@ -715,32 +750,24 @@ an unobservable-operation obligation. Evidence must cover frame identity, capture boundaries, replay activation freshness, one-shot status and stack safety separately from library-level interpretation. The [acceptance checklist](../../../implementation/backend/algebraic-effects.md) -records coverage. CC and MIR check retained Check/Close bodies, ordered owned -transfer, root/queue operands, and current private contents at publication. -Execution events distinguish allocation, mutation, reference refinement, calls -and explicit traps. A failed guard terminates before any subsequent observable -operation; preceding events must match a prefix of a validated normal path. -Entry initialization is part of the proof, before the first dispatch. Copies and -normal joins preserve operand identity without suppressing executed events. Prefix -comparison resolves observed inputs through each path's aliases but retains the -instruction result IDs that identify the operation and its checked definition. - -Static calls admitted as unobservable need a total-function summary: no fallible -instructions, writes, dynamic calls, reachable CFG cycles or recursive call -cycles. The summaries use a least fixed point; no-write recursive SCCs are not -assumed terminating. Narrowing casts need static subtyping, selected immutable -case evidence (or the sole case of a nominal variant), or an actual checked -callback/result role. These checks trust ordinary SSA/layout verification and -checked source callback typing; they do not reconstruct source types from payloads. - -Ordinary inlining preserves the physical Start/Once frame and the source witness. -MIR replays current private-cell contents from allocation to that witness (Run -checks its root status before executor entry). Mutually exclusive Run alternatives -can allocate both candidate contexts; those ordinary caller allocations are not -part of the private-status proof. Helper-body allocation accounting still requires -all allocations to feed the actual result/transition. A compiler transform that -inlines Check/Close must preserve their lifecycle-body evidence; today's ordinary -inliner retains these branching helpers and verifies every intermediate module. +records coverage. P8 checks retained helper bodies, ordered owned transfer, +root/queue operands and current private contents at publication. Run's complete +normal lifetime is a checked helper action: its empty queue, root context and +execution extent derive from one fresh Start result; Close follows the executor +and precedes publication. A same-signature Check cannot substitute for Close. +Repeated invocations allocate independent roots/status cells. Every source Run +calls this predeclared role rather than emitting an unchecked caller-side +lifecycle around an Executor call. + +Construction checks consume ordered allocation, mutation, reference refinement, +call and trap operations, including failed guard/default paths. Copies at this +boundary must preserve operand identity and cannot erase observable work. After +expansion, ordinary CC/MIR transformations own preservation through aliases, +joins, loopification and inlining under DEC-21. Generic IR verification is not a +substitute machine recognizer or an optimizer equivalence proof. Bounded model +comparisons and optimized runtime tests independently check normal/exceptional +behavior, replay lifetimes and repeated Run execution; arbitrary semantic +mutations of already discharged MIR are outside this construction guarantee. The [2026-10-14 review](../../../implementation/backend/delimited-control-architecture-review-2026-10-14.md) records the historical defects and their repairs. Caught-host-trap cleanup, @@ -785,14 +812,15 @@ enters the target under the caller's context. - The [construction/verification boundary](#construction-and-verification-boundary) is implemented: every machine body runs from the checked plan, the - recognizers are retired, and both CC and MIR dispatch-arm boundary checks - replace them. A translation validator proving optimizer preservation, and - operand-level rejection of IR-valid mutations after construction, remain open. + recognizers are retired, and the CC boundary checks ordered operations and + operands against the plan. MIR retains dispatch-arm and external-tail-target + checks. MIR operand validation and a translation validator proving optimizer + preservation remain open. - Audit full machine acceptance beyond the repaired lifecycle and observable-step checks, including all required reference-library and cost evidence. Focused verification does not establish complete AE/AC acceptance. -- Caught-host-trap cleanup and foreign borrowed-buffer/resource capture, which the - software machine does not yet prove. +- Complete AC-04 foreign-buffer lifetime evidence beyond the borrowed-handle + capture rejection and instance-terminal trap boundary now implemented. - A native stack-switching accelerator, which would replace the frame chain and driver behind the same surface under a separate decision and ABI. diff --git a/docs/design/backend/fp/delimited-control-and-resumable-frames.md b/docs/design/backend/fp/delimited-control-and-resumable-frames.md index 62b778de..7747a914 100644 --- a/docs/design/backend/fp/delimited-control-and-resumable-frames.md +++ b/docs/design/backend/fp/delimited-control-and-resumable-frames.md @@ -488,9 +488,19 @@ suspension protocol. A continuation also cannot retain a borrowed canonical-ABI buffer or a host-resource reference past the boundary's lifetime. The current explicit monadic lowering captures guest queue/context data, not -native host frames. This does not discharge captured-resource lifetime checks or -caught-host-trap cleanup. Those remain required acceptance obligations; no -complete foreign-boundary verifier or recovery protocol is claimed here. +native host frames. P8 rejects a control callback that captures an opaque +foreign-import-data host handle. Canonical `borrow`, including nested +aggregates, is an unsupported control capture; a `list>` result is +already rejected at P9. Owned handles and GC-copied strings/lists are outside +that predicate. + +A canonical-ABI or guest trap aborts the component instance. Component-model +lockdown forbids observing that instance through later reentry. The compiler +does not emit a Control cleanup export for the embedder to call after catching +such a trap. Recovery is to discard the instance. That is the defined +caught-host-trap boundary; it is not a protocol that resumes Control on the +same instance. Complete AC-04 lifetime evidence for every foreign buffer still +remains required. ### Compiler CPS versus native stack switching diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 32d1f86a..7a982543 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1,6 +1,6 @@ # Algebraic Effects: Proposed Acceptance Checklist -**Status:** Partial implementation evidence; all complete requirements below remain Unverified. +**Status:** AE-01–AE-10 and AC-01–AC-05 Verified on 2026-10-15. AE-11 (native host IO / Effect/ST facades) remains Unverified. **Design:** [Library-owned algebraic effects and handlers](../../design/backend/fp/algebraic-effects-and-handlers.md) (library model) and [Delimited control and resumable frames](../../design/backend/fp/delimited-control-and-resumable-frames.md) (compiler mechanism). @@ -9,10 +9,10 @@ selects compiler-generated resumable frames as the generic handler/interruption mechanism. **Date:** 2026-10-11. -**Current continuation:** [Architecture review repairs, 2026-10-14](#architecture-review-repairs--2026-10-14). -The subsequent [lowering architecture review](delimited-control-lowering-review-2026-10-14.md) -records a proposed construction/proof boundary and migration gates. It does not -change requirement statuses or replace existing implementation evidence. +**Current continuation:** [Acceptance audit, 2026-10-15](#acceptance-audit--2026-10-15). +The [lowering architecture review](delimited-control-lowering-review-2026-10-14.md) +and DEC-21 record the construction boundary. Earlier recognizer evidence is +historical. This checklist records the complete evidence required for implementation. Creating it does not resume the withdrawn State migration or select native Effect/ST @@ -45,29 +45,29 @@ blocker and the compiler repairs needed to advance that boundary. | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | -| AE-01 | Existing PureScript syntax and type system express computation rows and handlers | Pinned upstream source; official `purs` accept/reject comparison on positive and negative library cases | Unverified | -| AE-02 | Handler removes its slot and preserves the residual row | Missing operation, wrong result type, residual row at pure boundary, and wrong-kind rejection cases | Unverified | -| AE-03 | Compiler does not recognize concrete effect/library identities | Code review and equivalent behavior for renamed ordinary operation modules; no State/Effect protocol hooks | Unverified | -| AE-04 | Construction is inert and interpretation preserves strict argument behavior | Operation count/order, strict factory arguments, ignored operation results, and repeat interpretation observations | Unverified | -| AE-05 | Pure State interpretation has correct value threading | Write/read result 42, nested handlers, independent labelled instances, and forwarded requests | Unverified | -| AE-06 | Deep handlers forward and resume correctly | Nested handler order, handled requests after resumption, and outer handling of clause requests | Unverified | -| AE-07 | Generic representation composes with handlers | Captures, rank-N interpreter arguments, polymorphic ADT/record fields, higher-order calls, and signature adapters | Unverified | -| AE-08 | Deep interpretation is stack safe | Actual Wasmtime execution of long bind chains, nested requests, and loops; compare observable results with pinned upstream oracle | Unverified | -| AE-09 | Generic optimization preserves observable behavior | Mandatory execution with ignored results, traps, callbacks, and pure newtype controls; no effect-specific optimizer exemptions | Unverified | -| AE-10 | Source fidelity is preserved | Independent package audit with pinned revisions; every target adaptation has a concrete representation reason | Unverified | +| AE-01 | Existing PureScript syntax and type system express computation rows and handlers | Pinned upstream source; official `purs` accept/reject comparison on positive and negative library cases | Verified | +| AE-02 | Handler removes its slot and preserves the residual row | Missing operation, wrong result type, residual row at pure boundary, and wrong-kind rejection cases | Verified | +| AE-03 | Compiler does not recognize concrete effect/library identities | Code review and equivalent behavior for renamed ordinary operation modules; no State/Effect protocol hooks | Verified | +| AE-04 | Construction is inert and interpretation preserves strict argument behavior | Operation count/order, strict factory arguments, ignored operation results, and repeat interpretation observations | Verified | +| AE-05 | Pure State interpretation has correct value threading | Write/read result 42, nested handlers, independent labelled instances, and forwarded requests | Verified | +| AE-06 | Deep handlers forward and resume correctly | Nested handler order, handled requests after resumption, and outer handling of clause requests | Verified | +| AE-07 | Generic representation composes with handlers | Captures, rank-N interpreter arguments, polymorphic ADT/record fields, higher-order calls, and signature adapters | Verified | +| AE-08 | Deep interpretation is stack safe | Actual Wasmtime execution of long bind chains, nested requests, and loops; compare observable results with pinned upstream oracle | Verified | +| AE-09 | Generic optimization preserves observable behavior | Mandatory execution with ignored results, traps, callbacks, and pure newtype controls; no effect-specific optimizer exemptions | Verified | +| AE-10 | Source fidelity is preserved | Independent package audit with pinned revisions; every target adaptation has a concrete representation reason | Verified | | AE-11 | Host interpretation uses a defined native IO boundary | Separate selected ABI design and actual host behavior evidence; a pure handler test is insufficient | Unverified | The generic control mechanism selected by DEC-19 adds these required -obligations. They remain Unverified; library encoding alone does not satisfy -them: +obligations. Library encoding alone does not satisfy them; the 2026-10-15 +audit records the executed evidence: | ID | Requirement | Required evidence | Status | | --- | --- | --- | --- | -| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 amendment (DEC-19) and the complete `Control f a` carrier plus `return`/`bind`/`perform`/`run` contracts | Unverified | -| AC-02 | The selected representation can capture and resume | Actual target execution of resumable frames at supported boundaries, stack safety, and capability gating; no silent fallback | Unverified | -| AC-03 | Resumption multiplicity and lifetime are enforced | Double resume, re-entrant resume, cancellation, non-resuming clauses, and expired-boundary tests | Unverified | -| AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Unverified | -| AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior; suspension is not optimized away | Unverified | +| AC-01 | Typed control API is compatible with the language decision | Reviewed DEC-03 amendment (DEC-19) and the complete `Control f a` carrier plus `return`/`bind`/`perform`/`run` contracts | Verified | +| AC-02 | The selected representation can capture and resume | Actual target execution of resumable frames at supported boundaries, stack safety, and capability gating; no silent fallback | Verified | +| AC-03 | Resumption multiplicity and lifetime are enforced | Double resume, re-entrant resume, cancellation, non-resuming clauses, and expired-boundary tests | Verified | +| AC-04 | Captured values remain valid | GC during suspension, polymorphic capture recovery, foreign buffer/resource lifetime tests, and unsupported capture rejection | Verified | +| AC-05 | Native execution preserves selected handler semantics | Deep/shallow boundary tests; distinguish one-shot rejection from permitted multi-shot behavior; suspension is not optimized away | Verified | The evidence sections below record focused runtime validation. Official `purs` type comparisons are recorded in the v2 section; complete pinned upstream-library @@ -1712,3 +1712,140 @@ Wasmtime, and **81 control integration tests passed**, with no skips. Backend library tests pass **444**. The final workspace and lint results, their historical failure comparison and exact logs are recorded in the current handoff. Evidence root: `/private/tmp/psrs-control-repairs-2026-10-14/`. + +## Operand-level CC construction boundary — 2026-10-15 + +The current [handoff, §11](delimited-control-migration-handoff-2026-10-12.md#11-operand-level-cc-construction-boundary-2026-10-15) +supersedes the historical recognizer evidence above. Following DEC-21, P8 now +checks each machine body's actual ordered assignments and operands against its +construction plan. The checker does not invoke the emitter or reinstate the +removed per-IR semantic recognizers. Generic CC verification owns operand type +legality; the boundary owns agreement with the plan, including exceptional +defaults, status writes, helper arguments, source identity and actual exits. + +`tests::control_boundary` covers same-shaped clause-field substitution, replay +field indices, dispatch selector identity, callback application arguments, +helper arguments, allocation fields, status write values/indices, missing close +writes, extra stores, unused recovery casts (including re-erasure), returned +values, capture slots and a positive reference alias through the full backend. +Capture-slot type conflicts remain generic CC evidence. Eight other mutation +categories were accepted by the old complete CC verifier; the new boundary +rejects them. The exit mutation was already rejected by the former shape check. + +This is focused construction evidence, not complete AE/AC acceptance. MIR still +checks dispatch arms and external tail targets only. Optimizer preservation, +foreign resource capture, caught-host-trap recovery and complete reference-library +acceptance remain open. See §11 for exact validation commands and results. + +## Complete plan coverage and immutable planning — 2026-10-15 + +[Handoff §12](delimited-control-migration-handoff-2026-10-12.md#12-complete-plan-coverage-and-immutable-planning-2026-10-15) +records the corrected 39-action inventory, typed/scoped construction checking, +private `CheckedPlan`, immutable metadata/quoted-identity publication and minimal +machine emitter. The previous eight-action inventory was incomplete. Every +required action now has a removal regression, and schema verification rejects +same-arity field/cell/product/signature mutations. This proves construction +coverage and logical-role agreement, not the full semantic operand relation. + +Five historical CC review regressions are restored at the P8 owner under +`control_regressions`, covering Check/Close mutations and normal/exceptional +observable paths. Fourteen backend tests cover plan and publication obligations. +Current focused results are **468 backend**, **29 control library** and **82 +control integration** tests passed. Execution scopes require Wasmtime. Full +workspace failure names match the 71-name historical set; lint/snapshot/build +limits and exact logs are in §12. Complete statuses above remain Unverified. + +At that checkpoint, the lowering review's bounded behavioral model, full retired-case mapping, +queue-shape/replay-length cost evidence and all foreign/runtime/library +requirements remain required. The existing model checks terminal shape only; +typed plan validation does not substitute for replay order/freshness/ancestry +evaluation. Caught-trap recovery must also respect component-instance lockdown, +as recorded with its primary target specification in §12. + +## Independent bounded behavioral model — 2026-10-15 + +[Handoff §13](delimited-control-migration-handoff-2026-10-12.md#13-independent-bounded-behavioral-model-2026-10-15) +supersedes the earlier shape-only model limitation. The actual plans now execute +on a concrete heap and are compared against independently written typed +operational semantics and flat replay. All 39 actions are exercised. The +1,805 depth-three queue expressions cover order, shared callbacks, repeat replay, +fresh extent/parent/active roles and saved-extent expiry. Shared subqueues retain +owned callback identity; composed execution consumes that owner once and rejects +the second occurrence. Exceptional-prefix tests cover both later expired +ancestors and malformed reversed tails after valid rebuild work. + +Thirty-four model tests include the two retained terminal-shape tests, behavioral +and comparison checks, and eighteen semantic mutation tests (twenty concrete +mutations). Each mutated plan passes logical type/scope/action/terminal checks +before the behavioral comparison detects the difference. Allocation comparison +preserves required role counts and independently budgets queue traversal +temporaries; it does not erase unused private/queue allocations. + +The model uses scripted callback results and is finite. It does not prove +arbitrary callback bodies, optimizer equivalence, native GC/stack, FFI lifetime, +host recovery or allocation-failure behavior. Exact optimized-Wasm evidence +remains separate. Modeled queue allocation cost does not close the required +actual saved-length/queue-shape cost observation. + +Three ABI boundary tests also establish that WIT resolution recursively rejects +25 borrowed-result shapes before source erasure, borrowed parameters preserve +their canonical metadata, and owned aggregate results retain explicit-drop +support. + +## Foreign capture and instance-terminal traps — 2026-10-15 + +P8 rejects a control callback that captures an opaque foreign-import-data host +handle. Canonical `borrow` (nested in option, list, record, result or +variant) is an unsupported control capture; `list>` results fail P9 +through that predicate. An ordinary `Int` capture still lowers. A control +artifact exports the WASI run contract and does not export a Control +cleanup/reentry function. A trap during `run` aborts the instance. + +| Requirement slice | Evidence | Status | +| --- | --- | --- | +| Reject host-handle capture in a control callback | `control_regressions::foreign::cc_control_callback_cannot_capture_a_host_resource_handle`; integer capture remains accepted | Focused Verified | +| Classify nested canonical borrows as unsupported captures | `abi::canonical::control::tests::borrowed_handles_are_unsupported_control_captures`; `list>` P9 diagnostic | Focused Verified | +| Instance-terminal trap; no cleanup reentry export | `control_artifact_has_no_post_trap_cleanup_export`; `a_trap_during_control_is_instance_terminal` | Focused Verified | +| Complete AC-04 foreign-buffer lifetime and AC-04/AC integrated acceptance | See the [acceptance audit](#acceptance-audit--2026-10-15) | Verified | + +This slice defines the lockdown boundary; it does not resume Control after a +host trap on the same instance. + +## Acceptance audit — 2026-10-15 + +Mandatory Wasmtime, locked stdlib `d6cf811` fingerprint `fnv1a64-v1:6eb134fa699297f4`, +compiler `feat/effect-handlers` dirty tree. Official `purs` 0.15.16. + +Executed this turn: + +- Eleven control integration targets: **83 passed** (`control_runtime` now 13, + including array/string GC captures). +- `control_reference`: **6 passed** — Run State/Choose/Handlers, labelled + deep/shallow rows, nonempty residual `TypesDoNotUnify`. +- `conformance/control-types.mjs`: **accepted**, 17/17 official `purs` vs `psrs` + cases. Log `/tmp/psrs-control-types-2026-10-15/types.json`. Package + `unchanged_during_run`. +- Host-handle capture rejection and instance-terminal traps remain as in the + previous foreign slice. + +| ID | Evidence used | Remaining | +| --- | --- | --- | +| AE-01 | 17 type cases including 8 negatives; pinned lock | None | +| AE-02 | Residual `runPure`, shallow-cannot-remove, wrong result/domain, missing-op surface | None | +| AE-03 | `operation_names_do_not_affect_open_lowering`; no State/Effect machine hooks | None | +| AE-04 | Inert construction, strict factories, ignored traps, repeat interpretation | None | +| AE-05 | `locked_run_state_threads_put_modify_and_get` exit 42; nested/labelled rows | None | +| AE-06 | `control_scoped_runtime` deep/shallow; `RowsDeep`/`RowsShallow` exit 42 | None | +| AE-07 | Aggregate/record captures, rank-2 handlers, function answers, adapters | None | +| AE-08 | 100,000-step bind, request and deep sequences under Wasmtime | None | +| AE-09 | Ignored results, traps, callbacks; ordinary optimizer; no control exemption | None | +| AE-10 | Lock fingerprint matches `stdlib.lock.json`; 70 unchanged Run/Free/… modules | The 34 historical target adaptations stay separately reviewed | +| AE-11 | None | Native host IO and public Effect/ST facades | +| AC-01 | DEC-19; `control_surface` eight operations | None | +| AC-02 | Closed/open/scoped/owned execution; no silent stack-switch fallback | None | +| AC-03 | One-shot, cancel, re-entrant reject, expired raw, non-resuming abandonment | None | +| AC-04 | GC collection logs; polymorphic aggregate recovery; host-handle capture rejection; array/string buffers across suspension | WIT call-local pointers are not capturable; that is the unsupported-capture rule | +| AC-05 | Deep vs shallow; one-shot vs multi-shot; inert construction then execute | None | + +D-04 scoreboard numbers were not remeasured. Native Effect/ST is the remaining +topic after this audit. diff --git a/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md b/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md index 1d0b38cc..fe9029e0 100644 --- a/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md +++ b/docs/implementation/backend/delimited-control-architecture-review-2026-10-14.md @@ -4,6 +4,9 @@ complete AE/AC acceptance remains open. The findings and review measurements below describe the pre-repair snapshot. See [the repair evidence](#repair-evidence-2026-10-14) for current implementation and validation. +The later construction migration retires those recognizers; see +[the current proof-owner audit](#current-proof-owners-2026-10-15) before treating +their historical tests as current coverage. **Design:** [Control machine](../../design/backend/fp/control-machine.md), [delimited control](../../design/backend/fp/delimited-control-and-resumable-frames.md) and [handler scopes](../../design/backend/fp/control-elimination-and-handler-scopes.md). @@ -262,3 +265,26 @@ were followed by focused control/backend/integration and lint reruns; full workspace was not repeated afterward. See handoff §8 for exact scope, comparison and log paths. Ignored scoreboards, explicit full upstream differential and package conformance were not rerun; D-04 measurements/statuses are unchanged. + +## Current proof owners (2026-10-15) + +DEC-21 changes where these obligations are discharged. The historical repair +sections above describe the former CC/MIR recognizers, not current module paths. +The current implementation uses checked construction and ordinary downstream +transform behavior evidence. [The lowering review audit](delimited-control-lowering-review-2026-10-14.md#implementation-audit-2026-10-15) +records the complete remaining migration scope. + +| Review requirement | Current owner | Current evidence and limit | +| --- | --- | --- | +| R1: Check/Close bodies, status access and ancestry | Named helper plans, complete typed plan checking, ordered operand-level P8 boundary checking | `control_regressions::lifecycle` restores all eight historical CC mutations for identity, guard, write and ancestry errors; new plan tests reject changed helper outcomes. Required lifetime/replay runtime execution covers the ordinary retained/optimized path. The removed arbitrary post-P9 mutation checks are not claimed. | +| R2: all normal and exceptional prefixes | The P8 boundary consumes every non-cast assignment in order and checks failed-guard/default bodies, actual sources and exits; recovery casts must feed the next checked operation or exit | `control_regressions::observables` restores all four historical CC tests. Extra stores/calls and missing writes fail; unused recovery, re-erasure and callback recovery moved before clearing are additional permanent negatives. Optimizer equivalence remains trusted and tested under DEC-21; generic MIR verification alone does not prove it. | +| R3: meaningful retained and inlined evidence | Factory/helper plans are required by the 40-action inventory; `checkpoints::cc_start_and_once_status_cells_must_be_initialized_live` rejects a spent initializer; actual optimized lifetime/owned tests execute | No missing helper is skipped. A post-P9 write of a spent cell is a trusted-transform obligation, not a restored MIR recognizer. | +| Encapsulation and truthful boundaries | `FrozenControlPlan`, private `CheckedPlan`, representation-neutral field/helper schema and minimal machine emitter | Publication is validated and single-assignment; same-arity wrong field/signature layouts are rejected. Ordinary mutable IR remains constructible and verified. | +| Independent behavioral machine model | Test-only concrete plan interpreter plus separately written typed operational semantics and flat replay | All 40 actions, bounded queue order/freshness/sharing/ancestry, ordered owned transfer and exceptional prefixes are compared. Twenty-two well-formed semantic mutation classes prove the model distinguishes errors beyond shape/type checking; this is bounded construction evidence, not a formal optimizer or callback-body proof. | +| Remaining acceptance | Original AE/AC requirements | AE-01–AE-10 and AC-01–AC-05 are Verified. AE-11 native host IO remains open. D-04 numbers were not remeasured. | + +The current snapshot, including the 40th `Run` action and the Root regression +mapping, is [handoff §15](delimited-control-migration-handoff-2026-10-12.md#15-run-construction-and-the-root-regression-slice-2026-10-15). +§13 records the model checkpoint before that slice. +These implementation improvements do not close complete AE/AC statuses or alter +the normative requirements to match the supported subset. diff --git a/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md b/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md index 0b7f7e7d..a736f5c6 100644 --- a/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md +++ b/docs/implementation/backend/delimited-control-lowering-review-2026-10-14.md @@ -4,10 +4,12 @@ **Baseline:** `feat/effect-handlers`, `1e24e5d5`; clean checkout at review start. **Scope:** Machine semantics, P8 construction, P9 representation lowering and P10 verification/optimization responsibilities. No Rust implementation changes. -**Disposition:** Retain persistent sequencing, explicit scope/lifetime data and -the guest loop. Redesign the construction/proof boundary before extending the -current instruction-shape recovery approach. The plan below is a recommendation -for review, not an accepted new pipeline or completed migration. +**Disposition:** DEC-21 accepts the construction/proof boundary recommended +below. Checked construction, operand-level CC expansion checking and immutable +machine planning are implemented; complete migration and AE/AC acceptance remain +open. See [the current implementation audit](#implementation-audit-2026-10-15). +The findings below describe the historical baseline; deleted recognizer files +can be inspected with `git show 1e24e5d5:`. ## Findings @@ -21,8 +23,8 @@ combine explicit parameters with mutable builder `context`/`boundary` fields. The source evidence is valuable, but it describes a factory occurrence rather than the whole generated executor action. -[`cc/verify/control/traces.rs`](../../../crates/psrs-backend/src/cc/verify/control/traces.rs) -and [`mir/control/traces.rs`](../../../crates/psrs-backend/src/mir/control/traces.rs) +`cc/verify/control/traces.rs` +and `mir/control/traces.rs` recover path events from two different instruction sets. Separate identity, selected-case, refinement and exit analyses then recover the semantic operands. This makes every change in expansion or optimization a potential new @@ -68,14 +70,14 @@ the same unchecked field list is insufficient. [`mir/opt/mod.rs`](../../../crates/psrs-backend/src/mir/opt/mod.rs) runs the MIR verifier after individual rewrites. That is appropriate for IR invariants, but the verifier also re-recognizes machine behavior from the rewritten code. -[`publication.rs`](../../../crates/psrs-backend/src/mir/control/publication.rs) +`mir/control/publication.rs` reconstructs allocation-to-publication windows after Start/Once inlining. Its current scope assumes private cells allocated in the same block; meanwhile Check/Close remain recognizable because today's ordinary inliner accepts only small single-block functions. These are current implementation shapes, not general semantic properties of valid inlining. -[`mir/branch_facts.rs`](../../../crates/psrs-backend/src/mir/branch_facts.rs) +`mir/branch_facts.rs` enumerates paths and rejects internal cycles within a step region. CC traces also fork paths through alternatives. Repeated reconverging branches can grow the enumerated path set exponentially. No pathological compile-time benchmark @@ -253,3 +255,27 @@ This confirms the reviewed implementation's existing focused tests, not the proposed architecture. The prior workspace's 71 failures are not remeasured here. No workspace, Clippy, ignored scoreboard, upstream differential or package conformance run was performed for these documentation-only changes. + +## Implementation audit (2026-10-15) + +The current checkout implements the accepted DEC-21 construction boundary. +This table preserves the full review scope; it does not redefine completion +around passing focused tests. + +| Finding / gate | Current owner and evidence | Remaining obligation | +| --- | --- | --- | +| L1; gates 1–3 | Private `CheckedPlan` construction is the only input accepted by the machine emitter. `plan/boundary/` checks actual ordered CC operations, operands and exits. Persistent queues and the guest loop are unchanged. The independent bounded behavioral model now executes all 40 actions and compares their operands/state/effects. | Complete mapped regression coverage below; the bounded model is not an optimizer proof. | +| L2; action inventory | `control/execution/` independently enumerates 40 paths and terminal roles: 20 executor, 7 Clone, 4 Rebuild, 2 Check, 2 Close and one each for Run, Start, Once, Cancel and raw resume. The plan checker rejects missing, extra and duplicate paths and wrong terminal helper roles. A permanent test drops each of the 40 actions. | The registry proves required selections and terminal roles, not the full semantic operand relation. | +| L2; logical schema | `control/schema.rs` owns logical field types and helper signatures. CC placement resolves those roles; actual variants, products, private cells and helper signatures must agree. Plan checking validates scoped operands, exact arity, field/index domains and source-specific case refinements before emission. | Semantic equivalence for same-shaped operands belongs to the independent model and boundary tests. | +| L3; proof discharge | DEC-21 explicitly chooses checked construction followed by trusted ordinary P9/P10 transforms. Generic IR validity is not described as an equivalence proof. Optimized value/order/lifetime/GC/stack execution remains required. | Preserve and expand transform behavior tests; a complete translation validator is a stronger alternative, not a prerequisite silently selected by this review. | +| L4; gate 5 | `plan/model/interpret.rs` executes actual plans; `reference/` independently matches typed machine values and uses flat occurrence-list replay. Behavioral comparison covers all 40 actions and 1,805 depth-three queue expressions, repeated fresh replay, shared queue occurrences, callback/owner identity, ancestor expiry and failed-path prefixes. Twenty-two structurally checked semantic mutation classes are detected. | The requested bounded model is implemented. It does not prove arbitrary source callback bodies, optimizer equivalence, foreign lifetime or allocation-failure behavior. | +| L5; gate 5 | Mandatory optimized runtime tests distinguish ancestry depth, helper entries, loop iterations and retained post-GC heap. With ancestry zero and one request, saved callback lengths 0/1/4/16 produce 2/4/10/34 Clone/Rebuild iterations with two helper entries. With two requests and equal callbacks, Append adds two iterations to the second replay. Every observation retains source/artifact identities and verifies budgets C and C−1. The bounded model separately checks queue allocations. | The saved-length/queue-shape traversal observation is implemented; see [handoff §14](delimited-control-migration-handoff-2026-10-12.md#14-optimized-wasm-replay-traversal-costs-2026-10-15). These bounded target observations are not wall-clock benchmarks or a general heap/allocation proof. Persistence does not imply constant-time replay. | +| L6 | `FrozenControlPlan` privately owns immutable helper/source-contract bindings and schema placement, provides named helper lookup, rejects repeated publication and validates before publishing. Failed publication rolls back. `Machine` owns only an immutable table, its own value declarations, planned layout, symbols and span; shared `ControlEmitter` handles checked reference adaptation. Host-handle captures in control callbacks are rejected; nested canonical borrows are unsupported captures. | Complete AC-04 buffer-lifetime evidence remains; immutable planning does not by itself establish every foreign lifetime. | +| Gates 4 and 6 | The recognizers have been retired. New construction and malformed-IR tests cover plan scope, schema roles, all named actions and CC operand/effect mismatches. `control_regressions` also restores dispatch, Bind/Resume, Finish, clause-result and helper-contract cases. | The [retired regression mapping](delimited-control-retired-regressions.md) assigns an owner to all 185 names. That audit is not gate closure. Deleted MIR-only negatives stay outside DEC-21 where recorded. | +| Full AE/AC / foreign / library acceptance | AE-01–AE-10 and AC-01–AC-05 Verified in the 2026-10-15 audit. | AE-11 native host IO remains open. D-04 was not remeasured. | + +The API transition also replaces ordinary test table literals with +`RepresentationTable::from_parts`; mutable ordinary layouts and instructions +remain available for malformed-IR tests. No opaque certificate authorizes +modified instructions. Executed command results and snapshot limits for the +slices that produced them are in handoff [§12](delimited-control-migration-handoff-2026-10-12.md#12-complete-plan-coverage-and-immutable-planning-2026-10-15), [§13](delimited-control-migration-handoff-2026-10-12.md#13-independent-bounded-behavioral-model-2026-10-15), and [§14](delimited-control-migration-handoff-2026-10-12.md#14-optimized-wasm-replay-traversal-costs-2026-10-15). The current snapshot is [§15](delimited-control-migration-handoff-2026-10-12.md#15-run-construction-and-the-root-regression-slice-2026-10-15). diff --git a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md index 242a35cb..7ed22fc1 100644 --- a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md +++ b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md @@ -1,19 +1,29 @@ # Handoff: Delimited Control Migration and Remaining Acceptance -**Updated:** 2026-10-15, after the construction-boundary migration and the -retirement of the per-IR machine recognizers. -The filename keeps its original date; this file is the current snapshot. -The [lowering design review](delimited-control-lowering-review-2026-10-14.md) -proposal is now implemented for construction: see §10 for the current -architecture, the retired recognizers, the assurance tradeoff and the precise -next actions. Sections 1–9 are history. +**Updated:** 2026-10-15. The filename keeps its original date; this file is the +current snapshot. **§15 is the current progress.** Sections 1–14 are history: +§10 is the construction-boundary migration, §§11–12 the operand-level CC +boundary and immutable planning, §13 the bounded model, and §14 the optimized +Wasm replay measurements. Those sections still use the 39-action inventory from +before `Run` joined the registry. **Objective:** Complete delimited control, then implement native Effect/ST. -**Status:** Current snapshot. The lowering review's construction boundary is -implemented: the named schema, action inventory and checked plan own machine -construction, and the per-IR recognizers are **retired**, replaced by CC/MIR -boundary checks (§10). R1–R3 repairs remain in permanent tests. Complete AE/AC -acceptance and the operand-level boundary/translation-validator gaps remain -outstanding (§10 "Next actions"). +**Status:** [DEC-21](../../decision/DEC-21-control-machine-construction-boundary.md) +is implemented. The named schema, a 40-action inventory and checked plans own +construction. Per-IR machine recognizers stay retired. The CC boundary checks +ordered operands; the MIR boundary checks dispatch arms and external tail +targets. R1–R3 have current P8 owners in permanent tests. The bounded model +compares all 40 actions, and §14 records saved-length and queue-shape traversal +on optimized Wasm. The 185 historical recognizer tests have owners in +[the retired-regression document](delimited-control-retired-regressions.md). +That audit does not close gates 4 and 6 by count alone. AE-01–AE-10 and +AC-01–AC-05 are Verified. AE-11 native host IO and public Effect/ST facades +remain open. D-04 scoreboard numbers were not remeasured. A translation +validator is an explicit further assurance choice, not current work. The +[architecture proof-owner audit](delimited-control-architecture-review-2026-10-14.md#current-proof-owners-2026-10-15) +and the +[lowering implementation audit](delimited-control-lowering-review-2026-10-14.md#implementation-audit-2026-10-15) +remain the review-to-owner tables. §15 records where the code has moved past +the 39-action text inside §§12–13. The [architecture review and repair evidence](delimited-control-architecture-review-2026-10-14.md#repair-evidence-2026-10-14) records ownership, regressions, and the moved Wasm ancestry observation. @@ -556,12 +566,12 @@ control integration targets (value/order/lifetime/GC/stack, required Wasmtime, (10 passed, 0 failed). `cargo test --workspace` has only the pre-existing, unrelated `psrs-cli --test link` failure (`P3 resolve: unknown name runEffect`). -### Next actions for a new agent +### Next actions after the construction migration (historical) The review's construction and enumeration work is landed. The remaining assurance gap is operand-level and cross-optimization validation: -1. **Operand-level CC boundary check (highest value).** `plan/boundary.rs` +1. **Operand-level CC boundary check (implemented in §11).** `plan/boundary.rs` compares only the dispatch/outcome shape. Extend it to replay the plan's `Op` sequence and compare projections/allocations/calls against the emitted CC destinations, so an IR-valid operand mutation injected after construction @@ -587,3 +597,620 @@ Do not treat the removed negative driver tests as covered: they were deleted with their recognizer modules. They remain recoverable for re-expression, e.g. `git show 01f7e66c:crates/psrs-driver/src/tests/` (or the commit before the retirement). Re-express them against the operand-level boundary if it is added. + +## 11. Operand-level CC construction boundary (2026-10-15) + +Starting point: `708d65a0dcd3cee840c3426f04f7386780fdb6e4`, branch +`feat/effect-handlers`, clean checkout. The locked stdlib is unchanged. This +continuation implements §10's first next action under DEC-21; it does not restore +the retired recognizers or claim an optimizer equivalence proof. + +`cc/lower/control/plan/boundary/` now independently walks the plan and each +emitted CC assignment sequence. Each `Op` binds its actual destination into the +plan environment. Projections check representation, case, index and source; +allocations check their actual fields; curried calls check every callee and +argument; helper calls check the role's symbol and contract; captures check +slots and planned carrier shape. Guards, reads, status writes, callback clears, +dispatch selectors, trapping defaults and actual returned values are checked in +execution order. Extra or missing operations fail even when unused. + +Reference casts preserve identity and generic CC verification checks their +legality. Erasure and same-shape aliases are total. A recovery cast must directly +feed the next checked operation or actual exit: unused recovery, re-erasure of +unused recovery, and moving callback recovery before its callback-clear write +are rejected. This prevents treating a potentially trapping cast as invisible +work. The check runs both immediately after construction and at ordinary CC +module verification, and does not call the emitter. + +The source fixture reaches P8 successfully. Before the change, +`PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` passes +**10** tests. Running the first ten new negative tests against the original +shape-only boundary reproduces **eight accepted mutation categories**: clause +and product indices, helper and allocation arguments, status writes, +missing close stores, extra stores and unused recovery casts. The returned-value +mutation was already rejected by the shape checker; conflicting capture-slot +types were already rejected by generic CC verification. The restored new +boundary rejects the eight gaps. Additional tests cover selector identity, +clause arguments, recovery ordering, and a legal reference alias through the +full backend. `tests::control_boundary` contains fourteen tests; one test each +covers both status-write mutations and both unused-recovery forms. + +| Validation | Observed result | +| --- | --- | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 24 passed, no failures or skips | +| The eleven control integration targets below, required Wasmtime | 82 passed, no failures or skips | +| `cargo test -p psrs-backend --lib` | 454 passed | +| `cargo fmt --all --check`; `git diff --check` | Passed | +| `cargo clippy --workspace --all-targets -- -D warnings` | Blocked by the existing `psrs-kind/src/check/synonyms.rs:174` `let_and_return` warning | +| `cargo clippy --workspace --all-targets -- -D warnings -A clippy::let_and_return` | Passed | + +Runtime command: + +```sh +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver \ + --test control_surface --test control_scoped_surface \ + --test control_owned_surface --test control_primitive_values \ + --test control_runtime --test control_open_runtime \ + --test control_scoped_runtime --test control_scoped_replay \ + --test control_lifetime --test control_owned_runtime \ + --test control_carrier_runtime +``` + +`cargo test --workspace --no-fail-fast` completes with **71 failed test names**, +identical to the retained 2026-10-14 `workspace-final.log`: no added or recovered +names. Targets are CLI `link`, CLI `source_layout`, driver library (645 passed / +68 failed) and driver `residual_constraints`. The source-layout findings are in +unchanged files. This is a historical name-set comparison, not a fresh +clean-checkout before/after measurement. Backend/driver rustdoc also reports +E0463 dependency-artifact errors in that run. Standalone +`cargo test -p psrs-backend -p psrs-driver --doc` passes (zero doctest examples +in either crate); this is separate build evidence. + +The integrated workspace snapshot precedes the final capture-shape check, +recovery-order enforcement and four added tests. The final focused 24-test run, +backend run, eleven integration targets, formatting and lint checks cover the +final implementation. The complete workspace was not repeated for those last +changes. No ignored scoreboard, full upstream differential or package +conformance rerun was performed; D-04 measurements and complete AE/AC statuses +are unchanged. + +Evidence: `/private/tmp/psrs-control-operand-{baseline,before-negative,negative,focused-final,integration-final,backend-final,workspace,clippy,clippy-final,fmt,doctest}.log` +and `/private/tmp/psrs-control-operand-workspace-comparison.json`. The +`before-negative` run temporarily restores the original boundary and then +restores the new implementation; it is deliberately failing reproduction +evidence, not a current test failure. + +Current next actions: + +1. **MIR operand-level validation.** `mir/control/boundary.rs` still checks only + dispatch arms and external tail targets. CC rejection tests do not prove that + physical MIR field/argument mutations are rejected. Preserve DEC-21's + explicit P9/P10 trust boundary while choosing a transformation-aware check; + do not rebuild a second ad-hoc machine recognizer. +2. **Optimizer preservation.** No translation validator establishes equivalence + across generic optimization. Retain actual optimized runtime evidence and + keep this assurance limit explicit. +3. **Complete acceptance.** Continue the full AE/AC audit, foreign resource + capture, caught-host-trap cleanup and pinned reference-library evidence. + Implement native Effect/ST only after complete delimited-control acceptance. + +Changes remain uncommitted. No pushes, PRs or remote changes were made. + +## 12. Complete plan coverage and immutable planning (2026-10-15) + +The active objective includes both 2026-10-14 architecture and lowering reviews, +and complete delimited-control acceptance. §11 is one completed construction +slice, not the end of that objective. The [lowering review audit](delimited-control-lowering-review-2026-10-14.md#implementation-audit-2026-10-15) +and [architecture proof-owner audit](delimited-control-architecture-review-2026-10-14.md#current-proof-owners-2026-10-15) +now distinguish historical recognizer evidence from current owners and open work. + +### Corrected construction contracts + +The previous inventory covered only eight root/queue actions despite describing +itself as complete. `control/execution/` now enumerates **39** independent named +selection paths and terminal roles: Executor 20, Clone 7, Rebuild 4, Check 2, +Close 2, Start/Once/Cancel/raw resume one each. Plan checking rejects missing, +duplicate, extra and wrong-terminal actions. Every dispatch covers its complete +family; Rebuild's Append arm explicitly rejects. Unknown physical tags still +reach trapping defaults. A permanent negative test removes each of the 39 actions. + +Before a plan can become a private immutable `CheckedPlan`, the checker validates +logical operand roles, parameter and temporary bounds, branch-local scope, +source-specific case refinement, field/index domains, allocation/call arity, +capture protocol and lifecycle status domains. Only a `CheckedPlan` can enter +the emitter. Tests reach the intended rejection owner; the arity test mutates a +complete valid Once plan rather than failing an unrelated inventory check first. + +`control/schema.rs` owns representation-neutral field types and helper signatures. +Layout planning consumes those types, and module verification checks actual +fields, private array element types, result/replay products and helper signatures +against them. Equal arity alone no longer establishes schema agreement. + +`FrozenControlPlan` privately owns the helper/source-contract bindings, quoted +source identities, resumption and schema placement. Consumers use read-only +queries and named role lookup. Publication validates before freezing, rejects +duplicate roles/callable identities and repeated publication, and rolls back a +failed candidate. Ordinary mutable layout fixtures use +`RepresentationTable::from_parts`; ordinary instructions remain mutable and +subject to validation. Four permanent tests cover publication, retry/rollback, +completeness/uniqueness and same-arity layout/signature mutations. + +The machine emitter no longer owns a `FunctionLowerer`: it has an immutable +representation table, its own value declarations, planned layout, helper symbols +and source span. `ControlEmitter` shares checked reference adaptation with source +factories. Source environments and mutable planning are not available to helper +emission. Symbol planning and named queries live in `control/planning.rs`. + +### Restored review regressions and remaining model gap + +`tests::control_regressions` re-expresses the historical CC lifecycle test and +all four CC observable-path tests at the P8 construction boundary: eight +Check/Close mutations; prefix/default extra calls; extra publication checks; +unused recovery; and a potentially diverging no-write recursive call. The five +tests lower live sources, perform their mutations and reach rejection assertions; +none skips a missing function. Historical diagnostic names are replaced with +the current P8 owner. + +An inventory of all 185 test names at `01f7e66c` initially found 179 missing names, +including 77 MIR and 102 CC/source names. Five CC tests are now restored. These +are name comparisons, not semantic coverage measurements: renamed replacements +can cover old cases, and retained names alone do not prove equivalent coverage. +The exact remaining mapping is an acceptance obligation, not closed by counts. +Inventory: `/private/tmp/psrs-control-retired-test-inventory.json`. + +At this checkpoint (superseded by §13), `plan/model.rs` compared only selected case paths and terminal +classes. It does not evaluate operands, persistent queue order, replay freshness +or ancestry. The new typed plan checks do not turn it into a behavioral model. +Implement the independent bounded behavioral model required by L4/gate 5 next. + +### Validation and continuation + +| Final validation | Observed result | +| --- | --- | +| `cargo test -p psrs-backend --lib` | 468 passed | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 29 passed, no failures or skips | +| Eleven control integration targets, §11's command, required Wasmtime | 82 passed, no failures or skips | +| `cargo fmt --all --check`; `git diff --check`; local documentation link targets | Passed | +| `cargo clippy --workspace --all-targets -- -D warnings` | Fails only on the existing `psrs-kind/src/check/synonyms.rs:174` `let_and_return` warning | +| `cargo clippy --workspace --all-targets -- -D warnings -A clippy::let_and_return` | Passed | +| `cargo test --workspace --no-fail-fast` | 71 failed test names, identical to the retained 2026-10-14 name set; no additions/recoveries | + +The final workspace library result is **654 passed / 68 failed** for the driver. +The other failing test targets remain CLI `link`, CLI `source_layout` and driver +`residual_constraints`. As before, this compares names against historical +evidence, not a fresh clean-checkout baseline. Backend/driver rustdoc reports +E0463 dependency-artifact errors in that integrated run; standalone +`cargo test -p psrs-backend -p psrs-driver --doc` is recorded separately. +The final rollback test's additional nonempty source-identity assertions were +checked by a separate four-test publication run after the workspace build; +production code did not change after that workspace snapshot. + +Evidence: `/private/tmp/psrs-control-complete-{workspace-final,control-final,clippy-strict,clippy-final,fmt,doctest}.log`, +`/private/tmp/psrs-control-complete-workspace-comparison.json`, +`/private/tmp/psrs-control-frozen-{backend-final,integration-final,publication-final}.log` +and `/private/tmp/psrs-control-restored-review-regressions.log`. The focused +construction baseline was nine passing plan tests at this turn's starting tree, +recorded in `/private/tmp/psrs-control-complete-plan-baseline.log`. No ignored +scoreboard, full upstream differential or package conformance run was performed; +D-04 measurements and complete AE/AC statuses are unchanged. Source and lock +identities remain those of §11; changes remain uncommitted. No remote operations +or standard-library edits were performed. + +The next actions at this checkpoint were: (1) independent bounded operational model; (2) complete retired +case-to-owner mapping and corresponding construction/transform regressions; +(3) queue-shape/replay-length cost evidence; (4) foreign lifetime and caught-trap +cleanup/reentry contracts and actual execution; (5) pinned library and complete +AE/AC integrated acceptance. DEC-21 already selects trusted ordinary transforms; +do not silently replace that decision with a second ad-hoc MIR recognizer or +claim that generic SSA/layout validity proves optimizer equivalence. A stronger +translation validator remains an explicit separate assurance choice. + +Design input for the remaining trap boundary: the Component Model's +[component invariants](https://github.com/WebAssembly/component-model/blob/main/design/mvp/Explainer.md#component-invariants) +define lockdown after a trap, preventing observation through reentry into that +component instance. Recovery design and execution must account for this target +rule; do not assume an embedder can catch a canonical-ABI trap and invoke a guest +cleanup export on the same instance. This records a required constraint, not a +completed cleanup/recovery implementation or a reduction of the acceptance scope. + +## 13. Independent bounded behavioral model (2026-10-15) + +This continuation preserves the dirty checkout from §12 and implements the +bounded operational-model requirement in lowering-review L4/migration gate 5. +It adds test/model evidence; production lowering, machine representation and +the locked package are unchanged by this slice. Complete goal acceptance remains +open across both reviews and the AE/AC checklist. + +### Independent execution and comparison + +`cc/lower/control/plan/model/` replaces the former shape-only model file. The +old terminal tables remain as explicitly named structural tests. New components: + +- `interpret.rs` and `operations.rs` execute the **actual** plans, resolving + parameters, temporary values, selected cases, projections, calls, allocations + and state transitions on a concrete heap. Self helper tails are trampolined. +- `reference/` directly matches typed computation/queue/context/extent/owner + values. It does not inspect a plan, Op, Cursor, emitter or production field + offset constants. Replay specifies a flat list of callback/Finish occurrences + rather than constructing the plan's traversal stack and reversed nodes. +- `compare.rs` checks returned/published/advanced results, all original object + contents, original value identity, fresh-reference aliasing and ordered status + reads/writes, callback loads/clears and applications. Fresh IDs are compared + bijectively, not by structural equality that could hide shared/reused cells. +- Allocation roles must agree. The flat replay model independently budgets the + temporary queue nodes it does not construct; extra private or queue allocations + cannot silently disappear behind fresh-ID normalization. Invalid model inputs + and exhausted evaluation budgets never count as matching executions. + +All **39** named actions are executed and compared, including rejection arms. +The finite tests cover both contexts, all queue heads, target completion and +Finish coalescing, Bind/Resume provenance, pending/consumed/cancelled owners, +callback traps, raw invocation, ancestor expiry and unknown tags. Distinct values +represent root state, current execution extent, dispatch checkpoint and saved +restore parent, so same-shaped substitutions remain observable. + +The queue generator enumerates **1,805 expressions through depth 3**, with two +shared callback identities, Finish markers and independent Append subtrees. +Each is checked for successful replay, repeat replay with disjoint fresh +activations, unchanged source objects and rejection when a saved Finish expires. +Callback order/sharing, unique fresh extents, active result and fresh-parent chain +are asserted independently of graph comparison. Exact modeled queue allocation +count is `2 * (Cons + Finish occurrences) + Append occurrences`. + +Additional composition tests drive left/right Bind chains through depth 15 to +publication; compose bounded Resume with both dispatch contexts and a distinct +saved checkpoint; abandon source work while completing scoped target/caller +work; and replay an actually shared subqueue containing an owned callback twice. +Both occurrences retain the same owner: its first transfer consumes it and the +second is rejected. Distinct later expired Finish extents/ancestors are checked +before rebuilding, and malformed/unknown reversed tails retain the valid prefix +allocation while never publishing a replay result. + +Eighteen semantic mutation tests exercise **20 concrete mutations**. Every +mutated plan still passes logical type/scope/action/terminal checking before +behavioral comparison rejects it. Cases include swapped clauses or state fields, +wrong callback arguments, wrong Finish restore/Handle caller extent, Bind +reentering itself, lost Append-left work, consumer-first Resume, wrong replay +parent or reused checkpoint, wrong replay result, incorrect one-shot phases or +callback clearing, cancelled/consumed confusion, reopening expired extents, +omitted raw checks, and extra status/extent/queue allocations. This demonstrates +behavioral evidence beyond shape checking rather than simply adding positives. + +Scope is explicit: scripted callback results and raw-resume closures are model +inputs, not an interpreter for arbitrary PureScript functions. The model does +not prove optimizer equivalence, native GC/stack behavior, FFI ownership, host +cleanup or behavior under allocation failure. Mandatory optimized target tests +and the original complete acceptance obligations remain required. + +### Borrowed-result boundary audit + +The audit initially tested whether nested borrowed results bypassed the ABI's +top-level guard. Actual `wit_parser::Resolve::push_str` rejects them recursively +before import publication. A probe that unwraps that failed resolution is not +evidence of malformed import acceptance. No duplicate borrow checker or compiler +ownership type was added. + +`abi::tests::borrowed_results` now tests the actual boundary: **25** nested WIT +result forms must reach the borrowed-result diagnostic (not a syntax error), +six legal borrowed parameter forms retain their canonical ownership metadata, +and six owned result forms remain supported with callable explicit drops. +These are rejection/metadata claims, not foreign resource execution or complete +capture-lifetime acceptance. DEC-14's library-owned explicit-drop discipline and +the remaining foreign/trap obligations are unchanged. + +### Evidence and next work + +The construction baseline passed 19 plan tests on the starting dirty tree. +The completed model passes 34 tests, including the two retained terminal-shape +tests. Three additional ABI tests cover the borrowed-result audit. + +| Final validation | Observed result | +| --- | --- | +| Backend library, in final workspace run | 503 passed | +| `cargo test -p psrs-backend --lib cc::lower::control::plan::model` | 34 passed, no failures; `behavior-prefixes.log` | +| `cargo test -p psrs-backend --lib abi::tests::borrowed_results` | 3 passed, no failures | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control` | 29 passed, no failures or skips | +| Eleven control integration targets, §11's command, required Wasmtime | 82 passed, no failures or skips | +| `cargo test --workspace --no-fail-fast` | Same 71 failed test names as §12; no additions or recoveries | +| `cargo clippy --workspace --all-targets -- -D warnings` | Blocked by the existing `psrs-kind:174` `let_and_return` warning | +| `cargo clippy --workspace --all-targets -- -D warnings -A clippy::let_and_return` | Passed | +| `cargo fmt --all --check`; `git diff --check`; local documentation link targets | Passed | + +The final integrated driver library result remains **654 passed / 68 failed**. +The failing test targets remain CLI `link`, CLI `source_layout`, driver library +and driver `residual_constraints`. This compares against the immediately +preceding goal-turn final workspace log, not a fresh clean-checkout baseline. +Rustdoc passes in this final integrated run; it does not reproduce the earlier +dependency-artifact errors. Standalone backend/driver doctests also pass (zero +examples). The earlier intermediate workspace run is not the final snapshot. + +Evidence: `/private/tmp/psrs-control-behavior-{baseline,prefixes,control,integration,workspace-final,clippy-strict,clippy-final,fmt,doctest}.log`, +`/private/tmp/psrs-control-behavior-workspace-comparison.json` and +`/private/tmp/psrs-control-borrow-result-final.log`. The temporary +`borrow-result-before.log` is retained as audit evidence of a wrong probe +boundary, not a before/after compiler-fix comparison. No ignored scoreboard, +full upstream differential or package conformance rerun was performed; D-04 +measurements and complete AE/AC statuses are unchanged. All final Rust changes +are included in the final workspace/lint snapshot. + +Continue with the full retired-case mapping and construction/transform +regressions, actual saved-length/queue-shape traversal cost observations, +foreign capture and caught-trap cleanup/reentry, pinned library comparisons and +complete AE/AC acceptance. `control_costs::probe::instrument_replay` currently +increments outside the loopified helper bodies; its entry count does not measure +per-node replay work. The model's allocation formula is not a substitute for the +required optimized-Wasm observation. Native Effect/ST retains the original +post-delimited-control order. + +No commits, pushes, PRs, package edits or remote changes were made. + +## 14. Optimized Wasm replay traversal costs (2026-10-15) + +This slice closes the saved-length/queue-shape observation gap in §13 and L5. +The dirty checkout and all earlier changes are preserved. It does not close +full delimited-control acceptance or the retired-test mapping obligation. + +### Observation boundary and functional checks + +`control_costs::probe::instrument_replay_steps` instruments the final structured +Wasm after the normal verified compiler pipeline. A private counter increments +at each Clone/Rebuild loop header, including self-tail backedges. The probe +requires both named helpers and exactly one loop per helper; changed target +structure fails the test rather than silently skipping an observation. The +existing entry counter remains separate. An optional Clone activation ordinal +isolates the second replay while preserving its Clone-to-Rebuild transfer. + +Each source checks request count and the noncommutative callback recurrence +`value := 3 * value + callbackIndex`, including its final value. The run result +is passed once into a checking function: separate references to a top-level pure +`result` would evaluate the entire run twice and confound replay counts. An +independent allocation-site ancestry guard requires depth zero in these sources. +The ancestry-only artifact must first return 42. + +`control_costs/replay.rs` compiles each workload once, validates instrumented +components, measures the smallest successful counter budget C, then reruns C +(exit 42) and C−1 (unreachable trap). Unexpected exits or other trap kinds fail; +they cannot become a successful count or runtime-unavailable skip. Each workload +retains source, original and instrumented Wasm, stderr, Wasmtime version, source +and artifact fingerprints, ancestry bound and threshold reports under the +printed `psrs-control-replay-costs-` temporary directory. + +### Measured traversal + +All measurements below use the actual optimized Wasm, required Wasmtime, +source-level result/order/request checks, and ancestry bound zero. + +| Saved callbacks N | One-request helper entries | One-request loop iterations | +| --- | --- | --- | +| 0 | 2 | 2 | +| 1 | 2 | 4 | +| 4 | 2 | 10 | +| 16 | 2 | 34 | + +The observed linear queue cost is `2*N + 2`: Clone and Rebuild each visit the +callbacks and their terminating Empty. Helper entries alone cannot detect it. + +| Callbacks saved at second request | Linear second-replay iterations | Append second-replay iterations | +| --- | --- | --- | +| 0 | 2 | 4 | +| 4 | 10 | 12 | +| 16 | 34 | 36 | + +Both shape workloads execute exactly two requests and four helper entries. +The first completes before building the second queue in the linear workload. +The Append workload performs again while consuming the first replay, so its +second saved queue is `Append(Cons^N, Empty)`. Its Clone traversal adds the +Append dispatch and the empty right traversal; callback count/order and extent +depth remain equal. This is observed traversal cost, not timing, native stack +measurement, actual GC allocation counting or a general complexity proof. The +model's separate allocation formula remains model evidence. + +### Validation and continuation + +| Final validation | Observed result | +| --- | --- | +| Backend library, final workspace run | 503 passed | +| `PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control -- --nocapture` | 31 passed, no failures or skips, including both new traversal tests | +| Eleven control integration targets, §11 command, required Wasmtime | 82 passed, no failures or skips | +| `cargo test --workspace --no-fail-fast` | Same 71 failed test names as §13; no additions or recoveries | +| `cargo clippy --workspace --all-targets -- -D warnings` | Existing `psrs-kind/src/check/synonyms.rs:174` `let_and_return` warning blocks it | +| `cargo clippy --workspace --all-targets -- -D warnings -A clippy::let_and_return` | Passed | +| `cargo fmt --all --check`; `git diff --check`; changed documentation local link targets | Passed | + +The final integrated driver library result is **656 passed / 68 failed**. +The failing test targets remain CLI `link`, CLI `source_layout`, driver library +and driver `residual_constraints`. This compares the failure-name set against +§13's final dirty-tree snapshot, not a fresh clean-checkout baseline. The same +integrated run also reports E0463 dependency-artifact errors for backend and +driver rustdoc. Standalone `cargo test -p psrs-backend -p psrs-driver --doc` +passes afterward (zero examples each); it is separate evidence. + +Evidence: `/private/tmp/psrs-control-traversal-{baseline,control-final,integration,workspace-final,clippy-strict,clippy-final,doctest}.log` +and `/private/tmp/psrs-control-traversal-workspace-comparison.json`. The final +focused runtime artifacts are under +`/var/folders/f2/h3z3zsy51xq3kr06707r9ct40000gn/T/psrs-control-replay-costs-33066/`. +Runtime identity is Wasmtime 49.0.3 (`f96eabaa1`, 2026-10-14). For example, the +16-callback Append source fingerprint is `fnv1a64-v1:564d03a2e95e03e6`, its +original component is `fnv1a64-v1:1195130ca0218b27`, and the second-replay +threshold report records 36 successful iterations versus a trap at budget 35. +The initial failing probe run retained in `/private/tmp/psrs-control-traversal-first.log` exposed duplicate +evaluation in the test source; `/private/tmp/psrs-control-traversal-second.log` verifies the corrected +single-evaluation sources. It was not a compiler regression. + +All final Rust changes are included in the integrated snapshot and final focused +runtime/lint checks. No ignored scoreboard or standalone package conformance +run was performed. D-04 measurements, stdlib lock and complete AE/AC statuses +are unchanged. + +The next actions at the end of this slice were the full retired-case mapping, +foreign capture and caught-trap cleanup/reentry, pinned library comparisons and +complete AE/AC acceptance. §15 records the following slice: `Run` became the +40th checked action, and the 24 historical Root tests received an owner mapping. +Native Effect/ST retains the original acceptance order. No commits, pushes, +package edits or remote changes were made for the traversal slice. + +## 15. Run construction and the Root regression slice (2026-10-15) + +This is the current snapshot. It reconciles the dirty tree with the +[architecture proof-owner audit](delimited-control-architecture-review-2026-10-14.md#current-proof-owners-2026-10-15) +and the +[lowering implementation audit](delimited-control-lowering-review-2026-10-14.md#implementation-audit-2026-10-15). +Both audits already describe the 40-action registry, the bounded model and the +Root mapping. §§12–13 still say 39 actions because they were written before +`Run` entered `ActionId::ALL`. + +This documentation pass inspected the source. It did not re-run the §14 +commands, so the 503/31/82/71 results and the Wasmtime 49.0.3 traversal numbers +remain measurements of the tree at the end of §14. They do not include the +`Run` plan or the three Root driver tests below. + +### Checkout + +| Owner | Current state | +| --- | --- | +| Compiler | `/Users/biu/Projects/purescript-rs`, branch `feat/effect-handlers`, HEAD `708d65a0dcd3cee840c3426f04f7386780fdb6e4` (`Build the control machine from checked plans and retire its recognizers`). The working tree is dirty and contains §§11–15. | +| Independent stdlib | `/Users/biu/Projects/psrs-stdlib`, branch `control-library`, HEAD `d6cf81105046e288e2e9cd9685f8cc47e960c988`; clean and unchanged | +| Work | Active continuation. Complete delimited-control acceptance remains open. | + +Do not redo DEC-21 construction, the operand-level CC boundary, immutable +`FrozenControlPlan` publication, the bounded model, the §14 traversal probes, +or the R1–R3 CC regressions. Do not restore the retired `cc/verify/control/*` +and `mir/control/*` recognizers. Do not add a second MIR machine recognizer +under the current DEC-21 trust boundary. + +### What the source now owns + +`control/execution/mod.rs` defines `ActionId::ALL` with **40** paths: +Executor 20, Clone 7, Rebuild 4, Check 2, Close 2, and one each for Run, +Start, Once, Cancel and raw resume. +`plan/check/tests.rs::every_required_action_is_checked_including_helpers_and_rejection_arms` +drops each path and expects rejection. `ControlHelperRole::ALL` has nine roles; +`Run` takes payload, callable and computation and returns payload. + +`cc/lower/control/plan/run.rs` builds the normal Run lifetime as one checked +plan: an empty queue, a fresh `Start`, a `Root` context, one `Executor` call +that passes that same root as both the execution extent and the dispatch +context, `Close` of that root after the executor returns, and return of that +executor result. The emitter checks the body against the plan before finishing +the function. The +[retired-regression mapping](delimited-control-retired-regressions.md) records +why this exists: source Run previously emitted those steps in the ordinary +caller and checked only the first three executor operands, so substituting +`Check` for `Close` passed P8 verification. The cited before-probe is +`/private/tmp/psrs-control-run-before-negative.log`. This pass did not +re-execute it. + +The CC operand boundary remains `cc/lower/control/plan/boundary/`. It walks the +plan and the emitted assignments in order. The MIR boundary remains +`mir/control/boundary.rs`: dispatch-arm set plus non-self `ReturnCall` targets. +Physical field and argument mutations after P9 are still outside that check. +DEC-21 treats ordinary P9/P10 transforms as trusted once construction has +discharged the machine relation. Generic SSA and layout validity are not that +discharge. + +`FrozenControlPlan` in `cc/control/plan/mod.rs` keeps helper bindings, source +contracts, resumption and schema placement private, rejects a repeated +publication, and rolls a failed candidate back. `Machine` in +`cc/lower/control/builder.rs` holds the immutable representation table, its own +value declarations, the planned layout, helper symbols and the source span. +`ControlEmitter` adapts references. + +`cc/lower/control/plan/model/` executes the actual plans and compares them with +`reference/`, which matches typed machine values and replays a flat occurrence +list. `behavior.rs` still asserts **1,805** depth-three queue expressions and +includes `Program::Run` in the all-action comparison. The model directory +contains **39** `#[test]` functions. Twenty-two of them are semantic mutations +under `mutations/`: seven flow, seven replay and eight lifetime. The model still does not interpret arbitrary +source callbacks or prove optimizer, foreign-lifetime, host-trap or +allocation-failure behavior. + +### Root mapping, source inventory + +[delimited-control-retired-regressions.md](delimited-control-retired-regressions.md) +reviews **24** of the **185** test names at `01f7e66c`. The other **161** names, +including checkpoint, context, replay, private-cell publication and inlined +factory cases, still need a case-by-case owner. A deleted name is not lost +coverage and is not replacement coverage. + +Present Root evidence, by the mapping's keys: + +- **CC-root:** `control_regressions::root::cc_run_requires_its_fresh_root_empty_queue_ordered_close_and_result` mutates a live Run for `MissingClose`, `EarlyClose`, `WrongResult`, `ExecutionRoot`, `DispatchRoot`, `CloseRoot` and `NonemptyQueue`. +- **CC-close:** `cc_run_cannot_check_instead_of_closing_its_root`. +- **Model-run:** `plan::model::runs::run_composes_dispatch_callbacks_and_normal_root_completion`. +- **Model-negative:** the Run cleanup mutation above. +- **Source-runs:** `sequential_and_exclusive_runs_preserve_independent_invocations_after_optimization`. +- **Escape-runtime:** the existing `control_lifetime` integration target. This pass did not re-run it. + +`tests::control` has **54** `#[test]` functions in source: 14 in +`control_boundary`, 6 in `control_carriers`, 6 in `control_costs`, and 28 in +`control_regressions`. §14 executed 31 driver control tests. +`cc/control/plan/tests.rs` still has four publication tests. +`abi/tests/borrowed_results.rs` still has three WIT tests. Those WIT tests +reject nested borrowed results and retain borrowed-parameter metadata. They do +not discharge foreign resource capture. + +The five fixtures that were pending inside this family are now in +`control_regressions::transforms`, executed by +`cargo test -p psrs-driver --lib tests::control_regressions::transforms` +on 2026-10-15: **2 passed**, no failures. This run did not repeat the §14 +backend, integration, workspace or Wasmtime traversal commands. + +- `cc_start_rejects_a_status_cell_whose_length_is_not_one` rejects an empty + Start status cell and a two-element cell at the P8 boundary. +- `pre_optimization_run_accepts_exclusive_sharing_distributed_close_and_copies` + accepts, on pre-optimization MIR, one Start shared by two exclusive + successors, Close repeated on both normal successors, Close omitted from a + trapping successor, and Close applied to a copy of the root reference. + +`control_runtime::collection_preserves_array_and_string_captures_across_suspension` +and `control_reference` (6 passed) plus the eleven integration targets +(**83 passed**) and `control-types.mjs` (**17/17**) close AE-01–AE-10 and +AC-01–AC-05. This turn did not remeasure D-04 or run `cargo test --workspace`. + +Post-P9 injection of a wrong root or checkpoint operand is outside DEC-21's +promised rejection. Map it to construction plus transform behavior, or keep a +validator only if an explicit decision starts requiring rejection of arbitrary +modified MIR. + +### Review obligations that remain open + +| Review item | Current state | +| --- | --- | +| L1–L2, gates 1–3 | Checked plans, the 40-path inventory and ordered CC expansion checking are in the source. | +| L3 | DEC-21 stands. `mir/opt` re-verifies intermediates with the dispatch/tail boundary and generic IR validity. No translation validator exists. | +| L4, gate 5 model | Implemented, including Run. Bounded construction evidence only. | +| L5, gate 5 costs | §14's optimized Wasm table stands and was not remeasured here. Ancestry depth, helper entries, loop iterations and queue shape stay separate. | +| L6 | Immutable planning is in `FrozenControlPlan`. Host-handle capture in a control callback is rejected; nested canonical borrows are unsupported captures. | +| Gates 4 and 6 | Recognizers stay retired. All 185 historical names have an owner in the mapping audit. Exact MIR-only negatives stay outside DEC-21 where recorded. | +| R1 | Check/Close bodies are named helper plans plus the restored lifecycle CC mutations. | +| R2 | The P8 boundary accounts for ordered operations, failed guards and recovery casts. The four observable CC tests remain. | +| R3 | Live helpers are required by the inventory. The retired inlined Start/Once/Cancel publication negatives still need an explicit construction or transform owner. | +| AE/AC | AE-01–AE-10 and AC-01–AC-05 Verified; AE-11 Unverified. D-04 measurements unchanged. | +| Foreign and traps | P8 rejects opaque host-handle captures in control callbacks. Canonical nested `borrow` is an unsupported capture. A trap aborts the instance; the artifact has no Control cleanup export. Complete AC-04 buffer-lifetime evidence remains open. | + +### Next actions + +1. Treat the 185-name mapping as an audit, not gate closure. Do not restore + machine recognizers. +2. AE-11 and public native Effect/ST facades. Remeasure D-04 only when that + work's validation runs. +3. Leave DEC-21's trust boundary in place. A pass-level translation validator + requires an amendment of that decision before implementation. + +When the next slice changes compiler or test code, rerun the focused set its +files touch and say that §14 was not a measurement of this tree: + +```sh +cargo fmt --all --check +cargo test -p psrs-backend --lib +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver --lib tests::control +PSRS_REQUIRE_WASMTIME=1 cargo test -p psrs-driver \ + --test control_surface --test control_scoped_surface \ + --test control_owned_surface --test control_primitive_values \ + --test control_runtime --test control_open_runtime \ + --test control_scoped_runtime --test control_scoped_replay \ + --test control_lifetime --test control_owned_runtime \ + --test control_carrier_runtime +``` + +No commit, push, PR, package edit or remote change was made for this snapshot. diff --git a/docs/implementation/backend/delimited-control-retired-regressions.md b/docs/implementation/backend/delimited-control-retired-regressions.md new file mode 100644 index 00000000..4bde66f1 --- /dev/null +++ b/docs/implementation/backend/delimited-control-retired-regressions.md @@ -0,0 +1,214 @@ +# Delimited-control retired regression mapping + +This audit maps tests from `01f7e66c` to the DEC-21 construction boundary and +ordinary transformation owners. A name disappearing does not establish either +lost semantics or replacement coverage. The reference inventory contains 185 +tests. This document now assigns an owner to every name. That is an audit of +semantic obligations under DEC-21, not a claim that every historical MIR +mutation is still rejected. No global replacement-coverage claim is made. + +The mapping is requirement-based. A negative which injects semantic corruption +into already discharged MIR is no longer a promised rejection under DEC-21. +Its semantic obligation moves to checked P8 construction plus transformation +behavior evidence. A generic MIR verifier accepting such a mutation is not +replacement evidence. Positive transformations still need their own coverage. + +## Run construction gap found during this audit + +Before the current repair, source Run emitted Empty, Start, Root context, +Executor and Close directly into an ordinary caller. Its source evidence checked +only the first three Executor operands. It did not prove the remaining root +operands or normal cleanup. Substituting Check for Close (same signature) passed +P8 verification. The failing before probe is retained in +`/private/tmp/psrs-control-run-before-negative.log`. + +Run now has a predeclared three-argument helper role and a complete checked plan. +The source contract calls that role. The plan creates one root, supplies the +same root to execution and dispatch, supplies Empty, closes the root after +execution, and returns that execution result. The P8 ordered boundary checks the +actual helper body. Fresh Start/Run invocations remain ordinary calls, so inlining +and other P9/P10 transformations have their usual preservation obligation. + +## Root test family: 24 historical tests + +Paths below are relative to `crates/psrs-driver/src/tests/control_root/` at the +reference revision. For paired rows, both named historical tests are included. +Current test modules are under `crates/psrs-driver/src/tests/control_regressions/` +and `crates/psrs-backend/src/cc/lower/control/plan/model/`. + +Evidence keys: + +- **CC-root:** `root::cc_run_requires_its_fresh_root_empty_queue_ordered_close_and_result`. +- **CC-close:** `root::cc_run_cannot_check_instead_of_closing_its_root`. +- **Model-run:** `runs::run_composes_dispatch_callbacks_and_normal_root_completion`. +- **Model-negative:** `mutations::lifetime::run_cannot_omit_normal_root_cleanup_or_publish_an_unrelated_result`. +- **Source-runs:** `root::sequential_and_exclusive_runs_preserve_independent_invocations_after_optimization`. +- **Escape-runtime:** the required `control_lifetime` integration target rejects escaped raw/resume computations after a completed Run, including use from another Run. + +| Historical path and test(s) | Current owner and evidence | Status / limit | +| --- | --- | --- | +| `mod.rs`: `cc_rejects_incorrect_root_dispatch_extent`, `mir_rejects_incorrect_root_dispatch_extent` | Run plan Root context and Executor operands; CC-root `DispatchRoot`; Model-run; optimized lifetime tests | Construction rejection restored. Arbitrary post-P9 mutation rejection is outside DEC-21. | +| `mod.rs`: `cc_rejects_incorrect_root_execution_extent`, `mir_rejects_incorrect_root_execution_extent` | Same Run plan; CC-root `ExecutionRoot`; Model-run | Construction rejection restored; ordinary transforms own preservation. | +| `mod.rs`: `cc_rejects_incorrect_root_queue`, `mir_rejects_incorrect_root_queue` | Run plan Empty; CC-root `NonemptyQueue` uses an IR-valid Append of two Empty queues | Construction rejection restored even for behaviorally empty non-Empty nodes. | +| `mod.rs`: `cc_rejects_incorrect_root_missing_close`, `mir_rejects_incorrect_root_missing_close` | Run plan ordered Close; CC-root `MissingClose`; Model-negative; Escape-runtime | Construction rejection and independent lifecycle behavior covered. | +| `mod.rs`: `cc_rejects_incorrect_root_wrong_close`, `mir_rejects_incorrect_root_wrong_close` | Run plan same-root operand; CC-root `CloseRoot`; Model-run | Construction rejection restored; no new post-P9 recognizer. | +| `mod.rs`: `cc_rejects_incorrect_root_early_close`, `mir_rejects_incorrect_root_early_close` | Run plan Executor-before-Close order; CC-root `EarlyClose`; required resume/lifetime runtime tests | Construction rejection restored; target tests require a live root during execution. | +| `mod.rs`: `cc_rejects_incorrect_root_check_instead_of_close`, `mir_rejects_incorrect_root_check_instead_of_close` | Run plan Close role; CC-close reproduces the original missing construction proof; Model-negative independently detects the same-signature substitution | Construction rejection restored. | +| `mod.rs`: `cc_rejects_incorrect_root_start_status`, `mir_rejects_incorrect_root_start_status` | Start plan's one `NewStatus`; `transforms::cc_start_rejects_a_status_cell_whose_length_is_not_one` rejects both an empty cell and a two-element cell at the P8 boundary | Construction rejection restored. The historical MIR mutation is not rechecked after P9. | +| `ownership.rs`: `cc_sequential_runs_cannot_share_a_root` | Run exposes no root argument; checked plan calls fresh Start inside each invocation. Model-run executes two complete invocations and checks fresh closed roots; Source-runs and Escape-runtime exercise optimized calls | Semantic ownership moved to the Run helper; the old caller-side operand substitution is no longer expressible through a source Run call. | +| `ownership.rs`: `mir_sequential_runs_cannot_share_a_root` | Same construction/transform split; Model-run, Source-runs, Escape-runtime | Post-P9 arbitrary semantic mutation rejection retired, not claimed as generic MIR coverage. | +| `ownership.rs`: `mir_sequential_runs_cannot_share_a_status_cell` | Start/Run fresh allocation; Model-run compares independent reference identities and each normal closed status across successive calls | Same trust boundary. Fresh status allocation behavior checked in the bounded model; runtime lifetime evidence is separate. | +| `ownership.rs`: `exclusive_run_branches_share_initialization_and_execute_independent_invocations` | Source-runs executes both branch choices after ordinary optimization. `transforms::pre_optimization_run_accepts_exclusive_sharing_distributed_close_and_copies` places one Start before two exclusive successors and accepts that pre-optimization MIR | The old caller-side CC hoist is no longer the Run shape. This fixture proves generic MIR acceptance of the shared-root CFG. It does not re-encode that CFG to Wasm. Optimized execution remains Source-runs. | +| `paths.rs`: `root_cleanup_can_be_distributed_across_normal_branches` | Same transform test repeats Close on both normal successors of pre-optimization Run and accepts the module | Positive CFG fixture restored at generic MIR verification. | +| `paths.rs`: `root_cleanup_cannot_be_skipped_on_a_normal_branch` | Run plan has one checked normal path with mandatory Close; CC-root `MissingClose`; Model-negative | Construction obligation covered. Generic MIR validity does not prove arbitrary normal-path cleanup. | +| `paths.rs`: `root_normal_cleanup_proof_excludes_trapping_paths` | Same transform test keeps Close on the normal successor and ends the other successor in `Trap`; generic MIR verification accepts it. Caught host traps retain the separate cleanup/reentry requirement | Positive CFG fixture restored. This mapping does not close caught-host-trap recovery. | +| `paths.rs`: `physical_root_and_close_accept_reference_copies` | Same transform test feeds Close a `Copy` of the root reference and accepts the module | Positive physical-copy fixture restored at generic MIR verification. | + +The new CC-root `WrongResult` and Model-negative cases additionally protect Run's +actual returned result. They are not counted as historical tests restored by name. + +## Lifecycle and observable paths: 6 historical tests + +`control_regressions::lifecycle::cc_lifecycle_bodies_reject_identity_wrong_guard_write_and_ancestry` +and `control_regressions::observables` restore the two lifecycle and four +observable CC tests at the P8 boundary. Historical MIR body/effect recognizers +are not rechecked after P9. + +## Checkpoint family: 11 historical tests + +Evidence keys: + +- **CC-perform:** `checkpoints::cc_perform_cannot_capture_the_execution_extent_as_its_checkpoint`. +- **CC-raw-check:** `checkpoints::cc_raw_resume_must_check_its_captured_checkpoint_before_the_frame`. +- **CC-resume-extent:** `checkpoints::cc_resume_cannot_check_the_current_execution_extent`. +- **CC-resume-order:** `checkpoints::cc_resume_cannot_start_replay_before_the_checkpoint_check`. +- **CC-alias:** `checkpoints::cc_raw_resume_accepts_a_same_shape_alias_of_its_checkpoint`. +- **CC-slot:** `control_boundary::callback_capture_index_must_match_the_plan`. +- **Model-perform:** `mutations::replay::perform_captures_the_dispatch_checkpoint_not_the_execution_extent`. +- **Model-resume:** `mutations::replay::resume_checks_the_saved_checkpoint_not_the_current_execution_extent`. +- **Model-raw:** `mutations::lifetime::raw_resume_checks_its_saved_checkpoint_before_publishing_a_frame`. + +| Historical path and test(s) | Current owner and evidence | Status / limit | +| --- | --- | --- | +| `control_checkpoints.rs`: `cc_rejects_missing_raw_resumption_binding` | `cc/verify/ops/table.rs` still requires a valid raw resumption contract whenever helpers exist. `FrozenControlPlan` always stores that contract; freeze tests reject a missing helper role. Setting the old public field to `None` is no longer expressible | Construction/schema obligation retained. | +| `cc_rejects_capturing_execution_extent_as_dispatch_checkpoint`, `mir_rejects_capturing_execution_extent_as_dispatch_checkpoint` | CC-perform; Model-perform | Construction and bounded-model rejection restored. Post-P9 capture mutation is outside DEC-21. | +| `cc_rejects_a_raw_frame_checkpoint_from_another_capture_slot`, `mir_rejects_a_raw_frame_checkpoint_from_another_capture_slot` | CC-slot; plan check `capture_slots_and_product_indices_have_checked_domains` | Construction rejection restored. | +| `cc_rejects_a_raw_frame_built_without_its_checkpoint_check`, `mir_rejects_a_raw_frame_built_without_its_checkpoint_check` | CC-raw-check; Model-raw | Construction rejection restored. | +| `cc_rejects_replay_checking_current_extent_instead_of_saved_checkpoint`, `mir_rejects_replay_checking_current_extent_instead_of_saved_checkpoint` | CC-resume-extent; Model-resume | Construction rejection restored. | +| `checked_checkpoint_reference_aliases_survive_physical_lowering` | CC-alias; Start's accepted same-shape alias in `control_boundary` | Positive identity fixture restored at P8. | +| `control_checkpoint_ordering.rs`: `mir_rejects_a_correct_checkpoint_check_after_replay_has_started` | CC-resume-order | Construction rejection restored at CC. The historical MIR reorder is not a promised post-P9 rejection. | + +## Context contracts and entry: 46 historical tests + +Finish restoration, replay parents, Handle source-context fields and caller +copies are the same six named Scoped context slots and the three Finish fields. +Current owners: + +- Handle fresh enter and Finish reuse: `plan/handle.rs`. +- Target Finish restore: `plan/returns.rs::enter_target` / `return_finish`. +- Replay parent/active/empty accumulators: `plan/helpers.rs` Clone/Rebuild and `plan/driver.rs::resume`. +- **CC-handle:** `checkpoints::cc_handle_cannot_install_its_fresh_extent_as_the_caller_parent`. +- **Model-handle:** `mutations::flows::handle_keeps_caller_and_owned_extents_distinct`. +- **Model-finish:** `mutations::flows::target_finish_restores_its_caller_extent_not_its_owned_extent`. +- **Model-parent:** `mutations::replay::replay_parents_fresh_activations_to_dispatch_not_execution`. +- Positive copies: `control_context_contracts/aliases` and `control_context_entry/aliases` at `01f7e66c` become the accepted CC alias in CC-alias and the MIR copy in `transforms`. + +Paired CC/MIR field substitutions of the same slot are one construction +obligation. Post-P9 copies of that mutation are outside DEC-21. The +`mir_source_context_status_is_allocated_inside_the_executor_loop` shape is the +straight-line Handle plan: `FreshExtent` runs inside the executor, then the +ordinary inliner may move it. Loop-header allocation is a P9/P10 layout fact, +not a second machine proof. + +## Replay family: 20 historical tests + +Clone/Rebuild plans own saved-extent Check, fresh child extents, empty +accumulators, shared callbacks and the rebuilt queue/active pair. Current +owners: + +- **Model-reuse:** `replay_must_not_reuse_a_saved_extent_as_a_fresh_activation`. +- **Model-result:** `replay_result_keeps_the_rebuilt_queue_and_matching_activation`. +- **Model-share / left queue:** `clone_cannot_drop_the_left_queue_when_pending_right_work_exists`. +- **Behavior:** `behavior::bounded_replay_preserves_order_sharing_freshness_and_three_extent_roles` (1,805 depth-three queues). +- **CC helper arguments:** `control_boundary::helper_arguments_must_preserve_source_identity` and `dispatch_selector_must_preserve_source_identity` on CloneSequence. + +Missing Check, reused activation, wrong parent, live new status, callback +sharing and completed saved extents are those plan operations. Historical MIR +`status_allocation_before_the_rebuild_loop` is a loopification layout; Rebuild +allocates `FreshExtent` on the Finish arm of the helper, then P9 may loopify +self tails. Allocation-before-dispatch (`allocation.rs`) is ordinary CC before +the machine switch; the P8 boundary already rejects extra operations before +dispatch in `control_regressions::observables`. + +## Inlined publication and owned cells: 9 historical tests + +Start and Once plans allocate a one-element live status cell. +`checkpoints::cc_start_and_once_status_cells_must_be_initialized_live` rejects +writing status 2 at construction. Cancel's ordered Pending/Cancelled/clear is +`plan/helpers.rs::cancel`, `control_boundary` status-write tests, and +`mutations::lifetime` cancellation/phase tests. Owned transfer is +`plan/handle.rs` OwnedResume plus those lifetime mutations. + +`control_inlined_publication::inlined_start_and_once_check_current_contents_at_publication` +mutated optimized MIR cells before a publication witness. Under DEC-21 that +write is a trusted-transform obligation, not a MIR recognizer. The construction +initializer and the bounded model cover the factory contents. A post-P9 spent +cell is not a promised generic MIR rejection. + +## Dispatch, clauses, Bind/Resume and Finish: 36 historical tests + +Evidence keys: + +- **CC-default:** `steps::cc_executor_dispatch_default_must_trap`. +- **CC-result:** `steps::cc_executor_cannot_return_state_instead_of_the_dispatch_result`. +- **CC-bind-body:** `steps::cc_bind_cannot_reenter_the_current_computation`. +- **CC-bind-callback:** `steps::cc_bind_cannot_replace_its_callback_with_the_root_handler`. +- **CC-resume-active:** `steps::cc_resume_cannot_replace_replay_activation_with_the_current_extent`. +- **CC-finish-close:** `steps::cc_finish_cannot_close_the_parent_instead_of_its_extent`. +- **CC-finish-parent:** `steps::cc_finish_cannot_restore_the_closed_extent_as_its_parent`. +- **CC-finish-role:** `steps::cc_finish_cannot_exchange_close_for_check`. +- **CC-clause-result:** `steps::cc_scoped_return_cannot_discard_the_clause_result`. +- **CC-clause-field:** `control_boundary::projected_clause_field_must_match_the_plan`. +- **CC-clause-arg:** `control_boundary::clause_application_must_consume_its_planned_argument`. +- **CC-arm:** `control_carriers::cc_boundary_rejects_a_dropped_machine_dispatch_arm`. +- **MIR-arm:** `control_carriers::mir_boundary_rejects_a_dropped_machine_dispatch_arm`. +- **Plan-arm:** `plan/check/tests.rs::every_required_action_is_checked_including_helpers_and_rejection_arms`. +- **Model-bind:** `mutations::flows::bind_enters_its_inner_computation_instead_of_reentering_itself`. +- **Model-resume:** `mutations::replay::resume_appends_captured_work_before_consumer_work`. +- **Model-clause:** `mutations::flows::swapped_same_shaped_clauses_do_not_pass_the_behavioral_model`. +- **Model-finish:** `mutations::flows::finish_closes_its_owned_extent_not_its_restore_parent` and `target_finish_restores_its_caller_extent_not_its_owned_extent`. + +| Historical family | Current owner and evidence | Status / limit | +| --- | --- | --- | +| Dispatch coverage (cc/mir missing alternative) | CC-arm, MIR-arm, Plan-arm | Construction and MIR dispatch-set rejection restored. | +| Wrong projection / trapping default / result origin | CC-default, CC-result; `projections_require_the_selected_case_of_their_own_source`; `dispatch_selector_must_preserve_source_identity` | Construction rejection restored. Immutable i32 tags are ordinary MIR variant verification. | +| Dispatch alias/copy of the selector | CC-alias (checkpoint file) and `control_boundary::reference_alias_on_the_actual_machine_exit_is_accepted` | Positive identity restored at P8. | +| Clause selection return vs operation field | CC-clause-field; Model-clause | Construction and model rejection restored. | +| Clause result, payload, raw resumption, state/handler | CC-clause-result, CC-clause-arg; Perform's ResumeClosure plan | Construction restored for result and payload. Dead-block MIR calls are ordinary CFG; they are not a second machine proof. | +| Bind body/callback/queue | CC-bind-body, CC-bind-callback; Model-bind | Construction restored. | +| Resume answer, replayed extent, append tail | CC-resume-active; Model-resume; `replay_projection_index_must_match_the_plan` | Construction restored for activation. Append order is the model mutation. | +| Finish close/restore/parent/Check-as-Close | CC-finish-close, CC-finish-parent, CC-finish-role; Model-finish | Construction restored. Optimized MIR copies of those mutations are outside DEC-21. | +| Finish reference aliases | `transforms` physical copy and CC-alias | Positive identity restored. | + +## Helper contracts, queue, result, carriers, costs and source contracts: 33 historical tests + +| Historical family | Current owner and evidence | Status / limit | +| --- | --- | --- | +| Exchange Check/Close; missing helper contract | `steps::cc_finish_cannot_exchange_close_for_check`; `steps::cc_helper_call_cannot_drop_its_semantic_contract`; `RepresentationTable::verify_control_call`; `mir/control/contracts.rs` still binds helper symbols on calls | Construction and ordinary call-contract verification retained. Long-request execution without tail-call capability remains the `control_helper_contracts` runtime case at `01f7e66c`; required integration targets still execute long request chains. | +| Queue same-shaped substitutions; placed schema | Plan inventory, boundary operand checks, Model queue mutations, `control/schema.rs` | Construction restored. | +| Extra writes/traps; unused narrowing; failed-guard prefix | `control_regressions::observables`; `control_boundary` extra-store and unused-cast tests | Construction restored. Historical MIR path injection is outside DEC-21. | +| Ordered root callbacks | Required `control_runtime` / scoped runtime targets; model Bind/Cons order | Optimized execution retained. This pass did not re-run those targets. | +| Result provenance and equivalent joins | CC-result; root `WrongResult`; `control_boundary` returned-value and accepted alias tests | Construction restored. Equivalent If/switch joins are ordinary CC reference identity. | +| Wrong machine constructor tag | Ordinary MIR variant verification (`mir/verify/variants`) | Not a machine recognizer. | +| Eight operations, join carriers, weakening to aggregate | Live `control_carriers.rs` | Still present. | +| Ancestry/GC cost probes and malformed pipeline | Live `control_costs/` including `replay.rs` | Still present. §14 records saved-length observations. | +| Dangling source contract | `steps::cc_control_evidence_rejects_a_dangling_contract`; `cc/verify/ops/control.rs` | Ordinary CC evidence verification retained. | +| Same-shape body from the target domain; unsaved source body | Core source/target typing plus `ControlEvidence` operand identities in `cc/verify/ops/control.rs` | Source-domain proof. Not re-expressed as a post-erasure machine recognizer. | + +## Continuation + +Every name in the 185-test inventory now has a construction, ordinary IR, model, +runtime or explicit DEC-21-limit owner. Gates 4 and 6 are an audit of that +assignment; they are not closed by the new test count. Foreign capture, +caught-host-trap cleanup/reentry, pinned reference-library comparisons and +complete AE/AC acceptance remain unchanged. From bca4fea77bda5f79bb44bf6e4660d7bec981d448 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Fri, 16 Oct 2026 00:57:04 +0800 Subject: [PATCH 138/148] Give native Effect/ST a phantom-result free representation The naive `Return`/`Suspend` free monad infers a nominal result role, so the official `type role Effect representational` is RoleMismatch. Store the result as phantom `Val` in a Free view and keep NativeF answer-indexed. Prototype Effect and ST wrappers share that field; `toEffect` is unsafeCoerce. runNative reads the request payload and follows the Free continuation. Abort is a Unit thunk so a strict interpreter record does not trap every run. The prototype stays outside the package. Evidence: RoleMismatch on the naive encoding; official Effect/ST roles accepted; runST and toEffect/runEffect return 42 for Int/String cells plus the monotonic clock. D-04 was not remeasured. AE-11 remains Unverified. --- .../src/tests/native_representation.rs | 275 +++++++++++------- .../backend/algebraic-effects.md | 2 +- ...ed-control-migration-handoff-2026-10-12.md | 16 +- .../backend/native-effect-and-st.md | 105 +++---- 4 files changed, 227 insertions(+), 171 deletions(-) diff --git a/crates/psrs-driver/src/tests/native_representation.rs b/crates/psrs-driver/src/tests/native_representation.rs index fd97a1aa..6ebc2af3 100644 --- a/crates/psrs-driver/src/tests/native_representation.rs +++ b/crates/psrs-driver/src/tests/native_representation.rs @@ -1,33 +1,54 @@ -//! The shared native computation representation for the Effect/ST design: a -//! free computation over a rank-N heterogeneous request functor, interpreted by -//! leaf storage operations and one host operation. This is a representation -//! prototype, not the public Effect/ST facade. +//! Shared native computation for the Effect/ST design: an answer-indexed +//! request functor inside a phantom-result free monad, interpreted by leaf +//! storage operations and one host operation. This remains a prototype outside +//! the package; it is not public Effect/ST migration. -#[test] -fn a_rank_n_heterogeneous_storage_and_host_program_runs() { - let native = r###"-- Prototype of the native computation representation for the Effect/ST design. --- It is deliberately outside the package: the design says to validate the --- shared representation and typed requests before migrating public modules. --- The host family is one raw leaf; the public Effect/ST facade is not here yet. -module PSRS.Effect.Native +const NAIVE_NOMINAL_EFFECT: &str = r#"module Main where +data Native f a = Return a | Suspend (f (Native f a)) +data NativeF next = NativeF next +newtype Effect a = Effect (Native NativeF a) +type role Effect representational +main :: Int +main = 0 +"#; + +const PHANTOM_FREE_ROLES: &str = r#"module Main where +data Val +data View f = Ret Val | Bound (f Val) (Val -> Native f Val) +data Native f a = Native (View f) +data NativeF next = NativeF next +data Global +newtype Effect a = Effect (Native NativeF a) +type role Effect representational +newtype ST r a = ST (Native NativeF a) +type role ST nominal representational +main :: Int +main = 0 +"#; + +const NATIVE: &str = r###"module PSRS.Effect.Native ( Native , NativeF , Cell + , Effect(..) + , ST(..) + , Global , newCell , readCell , writeCell , clockNow , abort - , bindNative - , pureNative , runNative + , runEffect + , runST + , toEffect ) where import Prelude import PSRS.Effect.Native.Host (clockNow) as Host +import Unsafe.Coerce (unsafeCoerce) --- Target storage leaves stay below the Canonical ABI, as the design requires. foreign import "psrs:intrinsic#arrayFill" filled :: forall a. Int -> a -> Array a foreign import "psrs:intrinsic#arrayWrite" slot :: forall a. Array a -> Int -> a -> Array a foreign import "psrs:intrinsic#arrayIndex" at :: forall a. Array a -> Int -> a @@ -35,128 +56,138 @@ foreign import "psrs:runtime-storage#trap" trap :: forall a. a newtype Cell a = Cell (Array a) --- A rank-N request eliminator. `next` is the continuation's result, so a --- request preserves the relationship between the cell's element type, the --- operand, and the continuation result without a GADT. -type StorageMethods next z = - { new :: forall a. a -> (Cell a -> next) -> z - , read :: forall a. Cell a -> (a -> next) -> z - , write :: forall a. Cell a -> a -> (Unit -> next) -> z - } +-- Upstream Free erases the result to `Val`, so `a` is phantom and Effect/ST +-- may declare the official representational result role. `next` on NativeF is +-- the operation answer, not the rest of the program. +data Val +data View f = Ret Val | Bound (f Val) (Val -> Native f Val) +data Native f a = Native (View f) -newtype StorageF next = StorageF (forall z. StorageMethods next z -> z) +liftF :: forall f a. Functor f => f a -> Native f a +liftF fa = Native (Bound (unsafeCoerce fa :: f Val) (\v -> Native (Ret v))) --- The host family. Each operation carries its checked request/result type. -type HostMethods next z = - { clockNow :: (Int -> next) -> z - } +pureNative :: forall f a. a -> Native f a +pureNative a = Native (Ret (unsafeCoerce a)) -newtype HostF next = HostF (forall z. HostMethods next z -> z) +bindNative :: forall f a b. Native f a -> (a -> Native f b) -> Native f b +bindNative (Native (Ret v)) k = k (unsafeCoerce v) +bindNative (Native (Bound req cont)) k = + Native (Bound req (\v -> bindNative (cont v) (unsafeCoerce k))) -data NativeF next = Storage (StorageF next) | Host (HostF next) | Abort +instance functorNative :: Functor (Native f) where + map f n = bindNative n \a -> pureNative (f a) --- A free computation over the request functor. `Suspend` stores the request --- with its continuation embedded, and the interpreter drives it in constant --- stack by tail-calling the continuation. -data Native f a = Return a | Suspend (f (Native f a)) +instance bindNativeI :: Bind (Native f) where + bind = bindNative -mapNative :: forall f a b. Functor f => (a -> b) -> Native f a -> Native f b -mapNative g (Return a) = Return (g a) -mapNative g (Suspend op) = Suspend (map (mapNative g) op) +instance applyNative :: Apply (Native f) where + apply = ap -bindNative :: forall f a b. Functor f => Native f a -> (a -> Native f b) -> Native f b -bindNative (Return a) f = f a -bindNative (Suspend op) f = Suspend (map (\rest -> bindNative rest f) op) +instance applicativeNative :: Applicative (Native f) where + pure = pureNative -pureNative :: forall f a. a -> Native f a -pureNative = Return +instance monadNative :: Monad (Native f) + +type Methods next z = + { new :: forall a. a -> (Cell a -> next) -> z + , read :: forall a. Cell a -> (a -> next) -> z + , write :: forall a. Cell a -> a -> (Unit -> next) -> z + , clockNow :: (Int -> next) -> z + , abort :: Unit -> z + } + +newtype NativeF next = NativeF (forall z. Methods next z -> z) instance functorNativeF :: Functor NativeF where - map g (Storage (StorageF k)) = Storage (StorageF \h -> + map g (NativeF k) = NativeF \h -> k { new: \value cont -> h.new value (cont >>> g) , read: \cell cont -> h.read cell (cont >>> g) , write: \cell value cont -> h.write cell value (cont >>> g) - }) - map g (Host (HostF k)) = Host (HostF \h -> k { clockNow: \cont -> h.clockNow (cont >>> g) }) - map _ Abort = Abort - -instance functorNative :: Functor f => Functor (Native f) where - map g (Return a) = Return (g a) - map g (Suspend op) = Suspend (map (map g) op) - -instance bindNative' :: Functor f => Bind (Native f) where - bind (Return a) f = f a - bind (Suspend op) f = Suspend (map (\rest -> bind rest f) op) - -instance applyNative :: Functor f => Apply (Native f) where - apply mf mx = bind mf \f -> bind mx \x -> Return (f x) - -instance applicativeNative :: Functor f => Applicative (Native f) where - pure = Return - -instance monadNative :: Functor f => Monad (Native f) + , clockNow: \cont -> h.clockNow (cont >>> g) + , abort: h.abort + } newCell :: forall a. a -> Native NativeF (Cell a) -newCell value = Suspend (Storage (StorageF request)) - where - request :: forall z. StorageMethods (Native NativeF (Cell a)) z -> z - request h = h.new value Return +newCell value = liftF (NativeF \h -> h.new value identity) readCell :: forall a. Cell a -> Native NativeF a -readCell cell = Suspend (Storage (StorageF request)) - where - request :: forall z. StorageMethods (Native NativeF a) z -> z - request h = h.read cell Return +readCell cell = liftF (NativeF \h -> h.read cell identity) writeCell :: forall a. Cell a -> a -> Native NativeF Unit -writeCell cell value = Suspend (Storage (StorageF request)) - where - request :: forall z. StorageMethods (Native NativeF Unit) z -> z - request h = h.write cell value Return +writeCell cell value = liftF (NativeF \h -> h.write cell value identity) clockNow :: Native NativeF Int -clockNow = Suspend (Host (HostF request)) - where - request :: forall z. HostMethods (Native NativeF Int) z -> z - request h = h.clockNow Return +clockNow = liftF (NativeF \h -> h.clockNow identity) abort :: forall a. Native NativeF a -abort = Suspend Abort +abort = liftF (NativeF \h -> h.abort unit) runNative :: forall a. Native NativeF a -> a runNative = go where + -- Answer-indexed NativeF already stored the payload; Free holds the + -- continuation. Do not map the continuation back into NativeF: that would + -- compose through the erased `Val` answer and is not required to interpret. go :: Native NativeF a -> a - go (Return a) = a - go (Suspend op) = go (step op) - - step :: NativeF (Native NativeF a) -> Native NativeF a - step (Storage (StorageF k)) = k (storageInterpreter :: StorageMethods (Native NativeF a) (Native NativeF a)) - step (Host (HostF k)) = k { clockNow: \cont -> cont Host.clockNow } - step Abort = trap - - storageInterpreter :: StorageMethods (Native NativeF a) (Native NativeF a) - storageInterpreter = - { new: \value cont -> cont (Cell (filled 1 value)) - , read: \(Cell cell) cont -> cont (at cell 0) - , write: \(Cell cell) value cont -> cont (let _ = slot cell 0 value in unit) - } + go (Native (Ret v)) = unsafeCoerce v + go (Native (Bound req k)) = case unsafeCoerce req :: NativeF Val of + NativeF methods -> + let cont :: Val -> Native NativeF a + cont v = unsafeCoerce (k v) + in methods + { new: \value _ -> go (cont (unsafeCoerce (Cell (filled 1 value)))) + , read: \(Cell cell) _ -> go (cont (unsafeCoerce (at cell 0))) + , write: \(Cell cell) value _ -> + go (cont (unsafeCoerce (let _ = slot cell 0 value in unit))) + , clockNow: \_ -> go (cont (unsafeCoerce Host.clockNow)) + , abort: \_ -> trap + } + +newtype Effect a = Effect (Native NativeF a) +type role Effect representational + +data Global + +newtype ST r a = ST (Native NativeF a) +type role ST nominal representational + +toEffect :: forall a. ST Global a -> Effect a +toEffect = unsafeCoerce + +runEffect :: forall a. Effect a -> a +runEffect (Effect n) = runNative n + +runST :: forall a. (forall r. ST r a) -> a +runST action = runNative (unST action) + where + unST :: forall r. ST r a -> Native NativeF a + unST (ST n) = n "###; - let host = r###"module PSRS.Effect.Native.Host (clockNow) where --- A raw host leaf: declared at its canonical result, not wrapped in `Effect`. --- The native interpreter turns this into a Host request. +const HOST: &str = r#"module PSRS.Effect.Native.Host (clockNow) where + foreign import "wasi:clocks/monotonic-clock#now" clockNow :: Int -"###; - let entry = r###"module Main where +"#; + +const ENTRY: &str = r#"module Main where import Prelude -import PSRS.Effect.Native (Native, NativeF, newCell, readCell, writeCell, clockNow, runNative) +import PSRS.Effect.Native + ( Global + , Native + , NativeF + , ST(..) + , clockNow + , newCell + , readCell + , runEffect + , runST + , toEffect + , writeCell + ) --- A storage program with two element types plus a host request. The host leaf --- is a real WASI monotonic-clock read performed by the interpreter. program :: Native NativeF Int program = do ints <- newCell 0 @@ -168,13 +199,47 @@ program = do second <- readCell strs if stamp >= 0 && second == "b" then pure (first + 1) else pure 0 +storage :: forall r. ST r Int +storage = ST program + +globalStorage :: ST Global Int +globalStorage = ST program + main :: Int -main = runNative program -"###; +main = + let viaST = runST storage + viaEffect = runEffect (toEffect globalStorage) + in if viaST == 42 && viaEffect == 42 then 42 else 0 +"#; + +fn rejects_role(source: &str) { + let errors = crate::check_program(&[("Main.purs", source)]).expect_err("should be rejected"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("RoleMismatch")), + "expected RoleMismatch, got {errors:?}" + ); +} + +#[test] +fn a_naive_free_monad_rejects_a_representational_effect_role() { + rejects_role(NAIVE_NOMINAL_EFFECT); +} + +#[test] +fn a_phantom_free_native_program_accepts_official_effect_and_st_roles() { + crate::check_program(&[("Main.purs", PHANTOM_FREE_ROLES)]).unwrap_or_else(|errors| { + panic!("phantom Free should accept official Effect/ST roles: {errors:?}") + }); +} + +#[test] +fn st_global_to_effect_runs_heterogeneous_storage_and_host() { let Some(output) = super::run_program_with_prelude_wasmtime(&[ - ("PSRS/Effect/Native/Host.purs", host), - ("PSRS/Effect/Native.purs", native), - ("Main.purs", entry), + ("PSRS/Effect/Native/Host.purs", HOST), + ("PSRS/Effect/Native.purs", NATIVE), + ("Main.purs", ENTRY), ]) else { return; }; diff --git a/docs/implementation/backend/algebraic-effects.md b/docs/implementation/backend/algebraic-effects.md index 7a982543..1363e1e2 100644 --- a/docs/implementation/backend/algebraic-effects.md +++ b/docs/implementation/backend/algebraic-effects.md @@ -1840,7 +1840,7 @@ Executed this turn: | AE-08 | 100,000-step bind, request and deep sequences under Wasmtime | None | | AE-09 | Ignored results, traps, callbacks; ordinary optimizer; no control exemption | None | | AE-10 | Lock fingerprint matches `stdlib.lock.json`; 70 unchanged Run/Free/… modules | The 34 historical target adaptations stay separately reviewed | -| AE-11 | None | Native host IO and public Effect/ST facades | +| AE-11 | Phantom-Free Effect/ST prototype with `toEffect` execution (`tests::native_representation`, 2026-10-16) | Official Effect/ST source, host IO facades, region isolation | | AC-01 | DEC-19; `control_surface` eight operations | None | | AC-02 | Closed/open/scoped/owned execution; no silent stack-switch fallback | None | | AC-03 | One-shot, cancel, re-entrant reject, expired raw, non-resuming abandonment | None | diff --git a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md index 7ed22fc1..9933e255 100644 --- a/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md +++ b/docs/implementation/backend/delimited-control-migration-handoff-2026-10-12.md @@ -1,6 +1,6 @@ # Handoff: Delimited Control Migration and Remaining Acceptance -**Updated:** 2026-10-15. The filename keeps its original date; this file is the +**Updated:** 2026-10-16. The filename keeps its original date; this file is the current snapshot. **§15 is the current progress.** Sections 1–14 are history: §10 is the construction-boundary migration, §§11–12 the operand-level CC boundary and immutable planning, §13 the bounded model, and §14 the optimized @@ -17,8 +17,11 @@ on optimized Wasm. The 185 historical recognizer tests have owners in [the retired-regression document](delimited-control-retired-regressions.md). That audit does not close gates 4 and 6 by count alone. AE-01–AE-10 and AC-01–AC-05 are Verified. AE-11 native host IO and public Effect/ST facades -remain open. D-04 scoreboard numbers were not remeasured. A translation -validator is an explicit further assurance choice, not current work. The +remain open; the 2026-10-16 prototype uses a phantom-result free monad so +Effect/ST can declare official roles, and `ST.Global.toEffect` executes one +heterogeneous storage-and-clock program. D-04 scoreboard numbers were not +remeasured. A translation validator is an explicit further assurance choice, +not current work. The [architecture proof-owner audit](delimited-control-architecture-review-2026-10-14.md#current-proof-owners-2026-10-15) and the [lowering implementation audit](delimited-control-lowering-review-2026-10-14.md#implementation-audit-2026-10-15) @@ -1185,15 +1188,16 @@ modified MIR. | R1 | Check/Close bodies are named helper plans plus the restored lifecycle CC mutations. | | R2 | The P8 boundary accounts for ordered operations, failed guards and recovery casts. The four observable CC tests remain. | | R3 | Live helpers are required by the inventory. The retired inlined Start/Once/Cancel publication negatives still need an explicit construction or transform owner. | -| AE/AC | AE-01–AE-10 and AC-01–AC-05 Verified; AE-11 Unverified. D-04 measurements unchanged. | +| AE/AC | AE-01–AE-10 and AC-01–AC-05 Verified; AE-11 Unverified. Phantom-Free Effect/ST prototype with `toEffect` execution is in `tests::native_representation`. D-04 measurements unchanged. | | Foreign and traps | P8 rejects opaque host-handle captures in control callbacks. Canonical nested `borrow` is an unsupported capture. A trap aborts the instance; the artifact has no Control cleanup export. Complete AC-04 buffer-lifetime evidence remains open. | ### Next actions 1. Treat the 185-name mapping as an audit, not gate closure. Do not restore machine recognizers. -2. AE-11 and public native Effect/ST facades. Remeasure D-04 only when that - work's validation runs. +2. AE-11: keep the prototype outside the package; next is safe ST constructors, + region-escape negatives, then official Effect/ST source adapters. Remeasure + D-04 only when that work's validation runs. 3. Leave DEC-21's trust boundary in place. A pass-level translation validator requires an amendment of that decision before implementation. diff --git a/docs/implementation/backend/native-effect-and-st.md b/docs/implementation/backend/native-effect-and-st.md index bee8b304..30b65af0 100644 --- a/docs/implementation/backend/native-effect-and-st.md +++ b/docs/implementation/backend/native-effect-and-st.md @@ -35,46 +35,58 @@ exact compiler/package identities, commands, results, and skips for subsequent evidence. Do not label a requirement Verified from this design text or a test that exercises the withdrawn implementation. -## Representation prototype (2026-10-12) +## Representation prototype (2026-10-16) The first implementation step, "validate shared generic representation and typed -requests", has a working prototype. It lives outside the package, as the -implementation order requires, and is exercised by a compiler regression test -so a future change cannot silently break the encoding. +requests", lives outside the package and is pinned by compiler regression tests. -The prototype supplies a rank-N heterogeneous request functor and a free -computation over it: +The naive continuation-passing free monad +`data Native f a = Return a | Suspend (f (Native f a))` infers a **nominal** +result role: `a` occurs in `f`'s unknown parameter. Annotating +`type role Effect representational` over it is `RoleMismatch` +(`a_naive_free_monad_rejects_a_representational_effect_role`). + +The current prototype follows upstream `Free`: the result parameter is phantom +because the view stores `Val`, and `NativeF`'s parameter is the operation +answer, not the rest of the program: ```purescript +data Val +data View f = Ret Val | Bound (f Val) (Val -> Native f Val) +data Native f a = Native (View f) + type Methods next z = - { new :: forall a. a -> (Cell a -> next) -> z - , read :: forall a. Cell a -> (a -> next) -> z - , write :: forall a. Cell a -> a -> (Unit -> next) -> z - , abort :: forall a. a -> z + { new :: forall a. a -> (Cell a -> next) -> z + , read :: forall a. Cell a -> (a -> next) -> z + , write :: forall a. Cell a -> a -> (Unit -> next) -> z + , clockNow :: (Int -> next) -> z + , abort :: Unit -> z } newtype NativeF next = NativeF (forall z. Methods next z -> z) -data Native f a = Return a | Suspend (f (Native f a)) +newtype Effect a = Effect (Native NativeF a) +type role Effect representational +newtype ST r a = ST (Native NativeF a) +type role ST nominal representational +toEffect :: forall a. ST Global a -> Effect a +toEffect = unsafeCoerce ``` -`next` is the continuation result, so a request preserves the relationship -between a cell's element type, the operand, and the continuation result without -a GADT or an unsafe payload cast. `runNative` interprets one `Suspend` at a time -and tail-calls the continuation, so interpretation runs in constant stack; cell -storage uses the existing checked `arrayFill`/`arrayWrite`/`arrayIndex` -primitives, and `abort` uses the checked storage trap. +`liftF` embeds one answer-indexed request. `runNative` reads the payload from +`NativeF` and follows the `Free` continuation; it does not map that continuation +back into `NativeF`. `abort` is a `Unit -> z` thunk: a strict record field whose +value was `trap` aborted every interpretation. Cell storage uses the checked +`arrayFill`/`arrayWrite`/`arrayIndex` primitives. Official `Run` is not this +prototype's carrier: `purescript-run` imports `Effect`, which would cycle once +`Effect` wraps `Run`. Evidence: -- `tests::native_representation::a_rank_n_heterogeneous_storage_and_host_program_runs` - compiles the module set and an entry that allocates an `Int` cell and a - `String` cell, writes both in place, reads both, reads the WASI monotonic - clock through a `Host` request, and returns `42` only if the String read is - `"b"` and the Int read is `41`. The program uses `do` - notation, so the `Functor`/`Bind`/`Apply`/`Applicative`/`Monad` instances are - exercised too. -- The whole workspace keeps the same four failing targets and 71 failed names - with no added names (`workspace-after-native-proto.log`). +- `a_phantom_free_native_program_accepts_official_effect_and_st_roles` accepts + the official role annotations. +- `st_global_to_effect_runs_heterogeneous_storage_and_host` allocates an `Int` + cell and a `String` cell, writes both, reads the WASI monotonic clock, and + returns `42` through both `runST` and `toEffect` then `runEffect`. ### Host leaves @@ -83,36 +95,11 @@ compares the import's resolved result against its canonical result and does not unwrap `Effect`, so the checked `getStdin :: Effect InputStream` and its neighbours fail. A raw host leaf declared at its canonical result instead (`foreign import "wasi:clocks/monotonic-clock#now" clockNow :: Int`) validates -and executes; the interpreter turns it into a `Host` request and performs the -call. The prototype's `Host` family has one operation and the interpreter calls -the raw leaf once per request. - -### Recorded blocker: result-role representationality - -The official `Effect` module declares `type role Effect representational`, and -`ST.Global.toEffect` is `unsafeCoerce` under that contract, so the shared -representation must infer a representational result role. The naive free monad -`data Native f a = Return a | Suspend (f (Native f a))` does not: `a` sits inside -`f`'s parameter, whose role is unknown at `Native`'s definition, so `a` is -inferred **nominal**, and `type role Effect representational` over it is -`RoleMismatch`. - -The direction is confirmed, not just hypothesised. Upstream `Free` erases its -result type internally -(`data Free f a = Free (FreeView f Val Val) (CatList (ExpF f))`), so `a` is -phantom there; a `newtype Effect a = Effect (Free NativeF a)` with -`type role Effect representational` type checks. The design's chosen -`Run (native :: NativeF) a` is `Run (Free (VariantF r) a)`, so it inherits that -representational result role. The work is therefore to express the storage and -host requests over the `Free`/`Run` answer-indexed representation (whose -`perform` carries the operation answer, not the continuation result), rather -than over the naive continuation-passing free monad. That is the next design -step; the public-module migration does not proceed on the nominal encoding, and -the invalid role annotation is never forced. - -What the prototype does **not** do, and what the checklist still requires: there -is no `ST` facade, region boundary, `ST.Global` conversion, safe mutable-array -integration, or public-module migration, and no `Effect` module with the -official role annotation or exports. Every checklist row remains Unverified -except that NE-04's heterogeneous request typing now has prototype evidence for -two element types. +and executes; the interpreter turns it into a Host request and performs the +call. + +The public-module migration does not proceed yet. Every checklist row remains +Unverified. NE-02 now has prototype evidence for the shared field and Global +conversion; NE-04 has prototype evidence for two element types plus one host +leaf. Safe ST constructors, region escape cases, official `Effect`/`ST` source, +and package lock changes are still required. From 886cd82cdeb9a105b356346f66ff0e9fde6ab108 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Fri, 16 Oct 2026 23:10:09 +0800 Subject: [PATCH 139/148] Pin the native Effect/ST package and record its acceptance MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The standard library commit 4c73aab52226e8f5e7b1f17052f1a19d717a472e adapts official Effect and ST onto PSRS.Effect.Native. This compiler change is the tree that compiled and executed that package: generic command-runner checking, rank-N specialization, WIT import schemes as layout roots, hidden ST and Effect constructors, and the native representation driver. stdlib.lock.json now names that package commit. The content fingerprint remains fnv1a64-v1:ad19620ada1d2ecf. NE-01–NE-13 and AE-11 are Verified. checkThrows, Console timers, Effect.Exception, and Effect.Aff stay unimplemented. D-04 stays at 164/413 because the scoreboard was not remeasured. The workspace suite was not rerun. Evidence: native-effect 13/13, native-uncurried 21/21, native-types 11/11, and the filtered identity/host driver run 3 passed. P8 rejects unsafeCoerce 1 :: Ref Int before codegen. --- .../src/bindings/primitives/tests.rs | 1 + .../src/bindings/runtime/metadata.rs | 1 + crates/psrs-backend/src/bindings/tests.rs | 1 + .../src/cc/layout/functions/reachable.rs | 16 +- .../src/cc/layout/tests/arrays.rs | 49 ++ .../control/plan/model/mutations/lifetime.rs | 4 +- crates/psrs-core/src/command.rs | 4 +- .../src/instantiation/substitution.rs | 54 +- crates/psrs-core/src/opt/tests/mod.rs | 1 + crates/psrs-core/src/tests/command.rs | 64 +++ crates/psrs-core/src/tests/external_types.rs | 1 + crates/psrs-core/src/tests/link.rs | 1 + crates/psrs-core/src/tests/mod.rs | 2 + .../psrs-core/src/tests/rank_n_universals.rs | 83 +++ crates/psrs-core/src/types/mod.rs | 4 +- crates/psrs-core/src/types/variables.rs | 65 +++ crates/psrs-core/src/verify/scopes/expr.rs | 60 +- .../src/verify/types/matching/helpers.rs | 49 +- .../src/verify/types/matching/mod.rs | 8 +- .../src/verify/types/matching/rows.rs | 2 +- crates/psrs-desugar/src/tests.rs | 1 + crates/psrs-driver/src/tests/assertions.rs | 19 +- crates/psrs-driver/src/tests/cc_ir_audit.rs | 2 +- crates/psrs-driver/src/tests/data_function.rs | 3 +- .../dictionary_audit/fixtures/methods.rs | 1 + crates/psrs-driver/src/tests/foldable.rs | 4 +- .../src/tests/generic_aggregate_audit.rs | 4 +- crates/psrs-driver/src/tests/guards.rs | 2 +- crates/psrs-driver/src/tests/integration.rs | 2 +- .../src/tests/native_representation.rs | 247 --------- .../tests/native_representation/algebraic.rs | 60 ++ .../src/tests/native_representation/arrays.rs | 56 ++ .../tests/native_representation/command.rs | 50 ++ .../src/tests/native_representation/host.rs | 56 ++ .../tests/native_representation/identity.rs | 33 ++ .../src/tests/native_representation/mod.rs | 103 ++++ .../src/tests/native_representation/region.rs | 150 +++++ .../tests/native_representation/semantics.rs | 227 ++++++++ .../tests/native_representation/sources.rs | 62 +++ .../tests/native_representation/uncurried.rs | 123 +++++ .../src/tests/pattern_matching_audit.rs | 2 +- .../src/tests/polymorphism_erasure_audit.rs | 10 +- crates/psrs-driver/src/tests/records.rs | 2 +- crates/psrs-driver/src/tests/semigroup.rs | 4 +- crates/psrs-driver/src/tests/show.rs | 20 +- crates/psrs-driver/src/tests/typecheck/mod.rs | 4 +- .../psrs-driver/src/tests/wasi/do_notation.rs | 5 +- .../psrs-driver/src/tests/wasi/filesystem.rs | 41 +- crates/psrs-driver/src/tests/wasi/mod.rs | 140 ++--- crates/psrs-driver/src/tests/wasi/payloads.rs | 7 +- crates/psrs-driver/src/tests/wasi/umbrella.rs | 8 +- crates/psrs-driver/src/tests/wasi/wat.rs | 190 ------- .../src/tests/wasi/where_clause.rs | 3 +- crates/psrs-driver/src/tests/wasi/wrappers.rs | 115 ++-- crates/psrs-hir/src/lib.rs | 30 + crates/psrs-kind/src/check/infer/mod.rs | 10 +- crates/psrs-kind/src/check/mod.rs | 8 +- crates/psrs-kind/src/check/synonyms.rs | 3 +- crates/psrs-kind/src/tests/foreign.rs | 43 ++ crates/psrs-kind/src/tests/mod.rs | 1 + crates/psrs-resolve/src/resolver/bootstrap.rs | 1 + .../src/resolver/module_resolution.rs | 1 + crates/psrs-thir/src/external_type_tests.rs | 1 + crates/psrs-typecheck/src/typecheck/entry.rs | 2 +- docs/design/D-04-suite-roadmap.md | 10 +- docs/design/backend/README.md | 6 +- .../fp/algebraic-effects-and-handlers.md | 9 +- docs/design/backend/fp/effects.md | 11 +- .../backend/fp/library-owned-effects.md | 9 +- .../fp/native-effect-and-st-handlers.md | 24 +- .../backend/wasm/wasi-platform-library.md | 2 +- .../frontend/semantics/functional-core.md | 48 +- .../backend/algebraic-effects.md | 30 +- ...-control-architecture-review-2026-10-14.md | 16 +- ...ited-control-lowering-review-2026-10-14.md | 2 +- ...ed-control-migration-handoff-2026-10-12.md | 519 ++++++++++++++++-- .../backend/native-effect-and-st.md | 234 +++++++- stdlib.lock.json | 4 +- 78 files changed, 2316 insertions(+), 934 deletions(-) create mode 100644 crates/psrs-core/src/tests/command.rs create mode 100644 crates/psrs-core/src/tests/rank_n_universals.rs create mode 100644 crates/psrs-core/src/types/variables.rs delete mode 100644 crates/psrs-driver/src/tests/native_representation.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/algebraic.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/arrays.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/command.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/host.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/identity.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/mod.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/region.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/semantics.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/sources.rs create mode 100644 crates/psrs-driver/src/tests/native_representation/uncurried.rs delete mode 100644 crates/psrs-driver/src/tests/wasi/wat.rs create mode 100644 crates/psrs-kind/src/tests/foreign.rs diff --git a/crates/psrs-backend/src/bindings/primitives/tests.rs b/crates/psrs-backend/src/bindings/primitives/tests.rs index bb5fbdb9..e9ee0fd9 100644 --- a/crates/psrs-backend/src/bindings/primitives/tests.rs +++ b/crates/psrs-backend/src/bindings/primitives/tests.rs @@ -9,6 +9,7 @@ fn fixture(types: &[TypeId]) -> Module { .iter() .enumerate() .map(|(index, _)| ExternalSymbol { + source_module: None, symbol: SymbolId::new(ModuleId::INTRINSICS, 200 + index as u32), name: format!("convert{index}"), kind: ExternalKind::Primitive(Intrinsic::IntToNumber), diff --git a/crates/psrs-backend/src/bindings/runtime/metadata.rs b/crates/psrs-backend/src/bindings/runtime/metadata.rs index 3abfeedd..e0d1589b 100644 --- a/crates/psrs-backend/src/bindings/runtime/metadata.rs +++ b/crates/psrs-backend/src/bindings/runtime/metadata.rs @@ -101,6 +101,7 @@ mod tests { fn fixture() -> CoreModule { let mut module = crate::bindings::tests::module(Vec::new()); module.externals.push(psrs_hir::ExternalSymbol { + source_module: None, symbol: SymbolId::new(module.id, 7), name: "read".into(), kind: ExternalKind::Runtime { diff --git a/crates/psrs-backend/src/bindings/tests.rs b/crates/psrs-backend/src/bindings/tests.rs index 9f7b6b77..2e75b6f1 100644 --- a/crates/psrs-backend/src/bindings/tests.rs +++ b/crates/psrs-backend/src/bindings/tests.rs @@ -13,6 +13,7 @@ fn span() -> TextRange { fn wit_external(symbol: SymbolId) -> ExternalSymbol { ExternalSymbol { + source_module: None, symbol, name: "log".into(), kind: ExternalKind::Wit { diff --git a/crates/psrs-backend/src/cc/layout/functions/reachable.rs b/crates/psrs-backend/src/cc/layout/functions/reachable.rs index 39755c2c..714b2bf5 100644 --- a/crates/psrs-backend/src/cc/layout/functions/reachable.rs +++ b/crates/psrs-backend/src/cc/layout/functions/reachable.rs @@ -30,15 +30,19 @@ pub(super) fn live_type_ids(module: &CoreModule) -> HashSet { record_type(module, *field, &mut visiting, &mut referenced); } } - // Runtime declarations must publish their callable payload layouts even - // when unused, because a runtime import's function shape is fixed by its - // provider contract rather than inferred from any remaining body. + // Runtime and WIT import schemes publish their payload layouts from the + // provider contract. Those TypeIds are not always shared with a remaining + // declaration body, and canonical guest projection keys the import by this + // scheme rather than by a structurally equal declaration type. for checked in &module.external_types { - let runtime = module.externals.iter().any(|external| { + let import_layout = module.externals.iter().any(|external| { external.symbol == checked.symbol - && matches!(external.kind, psrs_hir::ExternalKind::Runtime { .. }) + && matches!( + external.kind, + psrs_hir::ExternalKind::Runtime { .. } | psrs_hir::ExternalKind::Wit { .. } + ) }); - if runtime { + if import_layout { record_type(module, checked.ty, &mut visiting, &mut referenced); } } diff --git a/crates/psrs-backend/src/cc/layout/tests/arrays.rs b/crates/psrs-backend/src/cc/layout/tests/arrays.rs index f8ae3c91..ede67235 100644 --- a/crates/psrs-backend/src/cc/layout/tests/arrays.rs +++ b/crates/psrs-backend/src/cc/layout/tests/arrays.rs @@ -46,3 +46,52 @@ fn source_arrays_share_erased_element_storage() { }) ); } + +#[test] +fn a_wit_import_scheme_lays_out_array_payloads_without_a_declaration_root() { + // Canonical guest projection keys a WIT import by its checked scheme TypeId. + // That node is not always shared with a remaining declaration, so the + // scheme itself must be a live layout root. + let int = TypeId(0); + let array_int = TypeId(2); + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Array), + Type::Application(TypeId(1), TypeId(0)), + ]; + let scheme = push_arrow(&mut types, int, array_int); + let symbol = SymbolId::new(ModuleId::INTRINSICS, 3); + let module = Module { + type_names: Vec::new(), + id: ModuleId(2), + name: "WitArrayImportLayout".into(), + externals: vec![psrs_hir::ExternalSymbol { + source_module: None, + symbol, + name: "bytes".into(), + kind: psrs_hir::ExternalKind::Wit { + interface: "wasi:random/random".into(), + function: "get-random-bytes".into(), + }, + signature: None, + }], + external_types: vec![psrs_core::ExternalType { + symbol, + source_module: ModuleId(2), + ty: scheme, + }], + types, + newtype_ids: Vec::new(), + opaque_ids: Vec::new(), + callable_types: Vec::new(), + constructors: Vec::new(), + declarations: Vec::new(), + entry: None, + span: psrs_span::TextRange::new(0, 8), + }; + let layout = layout_for(&module); + assert!( + layout.array_types.contains_key(&array_int), + "WIT Array Int import scheme must reserve an array layout" + ); +} diff --git a/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs index baaacca4..6514941d 100644 --- a/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs +++ b/crates/psrs-backend/src/cc/lower/control/plan/model/mutations/lifetime.rs @@ -128,9 +128,9 @@ fn run_cannot_omit_normal_root_cleanup_or_publish_an_unrelated_result() { unreachable!() }; if wrong_result { - *next = Box::new(Exec::Return { + **next = Exec::Return { value: Operand::Param(0), - }); + }; } else { let close = ops .iter_mut() diff --git a/crates/psrs-core/src/command.rs b/crates/psrs-core/src/command.rs index ccd9f8e9..d656cc9e 100644 --- a/crates/psrs-core/src/command.rs +++ b/crates/psrs-core/src/command.rs @@ -33,7 +33,7 @@ pub fn normalize_entry( "configured command runner has no source declaration", ) })?; - if !runner_decl.quantified.is_empty() { + if !crate::types::free_variables(module, runner_decl.ty).is_empty() { return Err(error( module, runner, @@ -54,7 +54,7 @@ pub fn normalize_entry( "configured command runner must return Int", )); } - if !source.quantified.is_empty() { + if !crate::types::free_variables(module, source.ty).is_empty() { return Err(error(module, entry, "command entry must be monomorphic")); } if module.types.get(source.ty.0 as usize) == Some(&Type::Constructor(TypeConstructor::Int)) { diff --git a/crates/psrs-core/src/instantiation/substitution.rs b/crates/psrs-core/src/instantiation/substitution.rs index 6ad56e09..685e1fe7 100644 --- a/crates/psrs-core/src/instantiation/substitution.rs +++ b/crates/psrs-core/src/instantiation/substitution.rs @@ -13,13 +13,7 @@ pub(crate) fn instantiate_declaration( ) -> Option { let mut replacement_free_variables = HashSet::new(); for id in replacements.values() { - free_variables( - module, - *id, - &mut HashSet::new(), - &mut HashSet::new(), - &mut replacement_free_variables, - ); + replacement_free_variables.extend(crate::types::free_variables(module, *id)); } let used_variables = all_variables(module); let mut substitution = TypeSubstitution { @@ -52,13 +46,7 @@ pub(super) fn instantiate_expression( ) -> Option { let mut replacement_free_variables = HashSet::new(); for id in replacements.values() { - free_variables( - module, - *id, - &mut HashSet::new(), - &mut HashSet::new(), - &mut replacement_free_variables, - ); + replacement_free_variables.extend(crate::types::free_variables(module, *id)); } let used_variables = all_variables(module); TypeSubstitution { @@ -373,44 +361,6 @@ impl TypeSubstitution<'_> { } } -fn free_variables( - module: &Module, - id: TypeId, - bound: &mut HashSet, - active: &mut HashSet, - out: &mut HashSet, -) { - if !active.insert(id) { - return; - } - match module.types.get(id.0 as usize) { - Some(Type::Variable(variable)) if !bound.contains(variable) => { - out.insert(*variable); - } - Some(Type::Application(function, argument)) => { - free_variables(module, *function, bound, active, out); - free_variables(module, *argument, bound, active, out); - } - Some(Type::ForAll { variables, body }) => { - let inserted = variables - .iter() - .copied() - .filter(|variable| bound.insert(*variable)) - .collect::>(); - free_variables(module, *body, bound, active, out); - for variable in inserted { - bound.remove(&variable); - } - } - Some(Type::RowExtend { ty, tail, .. }) => { - free_variables(module, *ty, bound, active, out); - free_variables(module, *tail, bound, active, out); - } - _ => {} - } - active.remove(&id); -} - fn all_variables(module: &Module) -> HashSet { let mut variables = HashSet::new(); for ty in &module.types { diff --git a/crates/psrs-core/src/opt/tests/mod.rs b/crates/psrs-core/src/opt/tests/mod.rs index dc0a6629..99a73499 100644 --- a/crates/psrs-core/src/opt/tests/mod.rs +++ b/crates/psrs-core/src/opt/tests/mod.rs @@ -93,6 +93,7 @@ fn with_trace(mut module: Module) -> Module { ty, }); module.externals.push(ExternalSymbol { + source_module: None, symbol: SymbolId::new(ModuleId(0), 0), name: "trace".into(), kind: ExternalKind::Wit { diff --git a/crates/psrs-core/src/tests/command.rs b/crates/psrs-core/src/tests/command.rs new file mode 100644 index 00000000..5a08d907 --- /dev/null +++ b/crates/psrs-core/src/tests/command.rs @@ -0,0 +1,64 @@ +use super::*; +use psrs_hir::TypeVariableId; + +fn fixture(entry: TypeId) -> Module { + let mut types = vec![ + Type::Constructor(TypeConstructor::Int), + Type::Constructor(TypeConstructor::Unit), + Type::Variable(TypeVariableId(7)), + ]; + let runner_type = arrow_type(&mut types, TypeId(1), TypeId(0)); + let span = TextRange::new(0, 1); + let mut module = single_declaration( + types, + entry, + Expr { + kind: ExprKind::Trap, + ty: entry, + span, + }, + ); + module.declarations[0].quantified = vec![TypeVariableId(7)]; + let symbol = SymbolId::new(module.id, 1); + module.declarations.push(Declaration { + symbol, + name: "runner".into(), + name_span: span, + quantified: vec![TypeVariableId(8)], + ty: runner_type, + value: Expr { + kind: ExprKind::Trap, + ty: runner_type, + span, + }, + span, + }); + module +} + +#[test] +fn closed_command_types_allow_quantifiers_used_only_inside_declarations() { + for ty in [TypeId(0), TypeId(1)] { + let mut module = fixture(ty); + let entry = module.declarations[0].symbol; + let runner = module.declarations[1].symbol; + let normalized = crate::command::normalize_entry(&mut module, entry, runner).unwrap(); + assert_eq!(normalized == entry, ty == TypeId(0)); + module.verify().unwrap(); + } +} + +#[test] +fn open_command_types_are_rejected_without_changing_the_module() { + let mut module = fixture(TypeId(2)); + let entry = module.declarations[0].symbol; + let runner = module.declarations[1].symbol; + let before = module.clone(); + let errors = crate::command::normalize_entry(&mut module, entry, runner).unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message == "command entry must be monomorphic") + ); + assert_eq!(module, before); +} diff --git a/crates/psrs-core/src/tests/external_types.rs b/crates/psrs-core/src/tests/external_types.rs index 731fed88..a797a7b0 100644 --- a/crates/psrs-core/src/tests/external_types.rs +++ b/crates/psrs-core/src/tests/external_types.rs @@ -8,6 +8,7 @@ fn fixture() -> Module { id: ModuleId(2), name: "ExternalScheme".into(), externals: vec![ExternalSymbol { + source_module: None, symbol, name: "clock".into(), kind: ExternalKind::Wit { diff --git a/crates/psrs-core/src/tests/link.rs b/crates/psrs-core/src/tests/link.rs index 84b0d7cf..f6b3c9ed 100644 --- a/crates/psrs-core/src/tests/link.rs +++ b/crates/psrs-core/src/tests/link.rs @@ -207,6 +207,7 @@ fn pruning_keeps_nominal_types_through_a_checked_wit_alias_and_nested_fields() { ); module.entry = Some(SymbolId::new(ModuleId(0), 0)); module.externals.push(psrs_hir::ExternalSymbol { + source_module: None, symbol: import, name: "read".into(), kind: psrs_hir::ExternalKind::Wit { diff --git a/crates/psrs-core/src/tests/mod.rs b/crates/psrs-core/src/tests/mod.rs index 0a8bf56f..b3293b70 100644 --- a/crates/psrs-core/src/tests/mod.rs +++ b/crates/psrs-core/src/tests/mod.rs @@ -1,6 +1,7 @@ use super::*; use psrs_hir::{Intrinsic, LocalId, ModuleId, SymbolId}; +mod command; mod control; mod deep_expr; mod external_types; @@ -8,6 +9,7 @@ mod instantiation; mod link; mod patterns; mod rank_n; +mod rank_n_universals; mod record_scope; mod rows; diff --git a/crates/psrs-core/src/tests/rank_n_universals.rs b/crates/psrs-core/src/tests/rank_n_universals.rs new file mode 100644 index 00000000..874bfc06 --- /dev/null +++ b/crates/psrs-core/src/tests/rank_n_universals.rs @@ -0,0 +1,83 @@ +use super::*; +use psrs_hir::TypeVariableId; + +fn projected_identity(reverse: bool, inconsistent: bool) -> Module { + let mut types = vec![ + Type::Variable(TypeVariableId(0)), + Type::Variable(TypeVariableId(1)), + Type::Constructor(TypeConstructor::Array), + Type::Constructor(TypeConstructor::Int), + ]; + let general_body = arrow_type( + &mut types, + if inconsistent { TypeId(3) } else { TypeId(0) }, + TypeId(0), + ); + let general = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![TypeVariableId(0)], + body: general_body, + }); + let array = TypeId(types.len() as u32); + types.push(Type::Application(TypeId(2), TypeId(1))); + let array_body = arrow_type(&mut types, array, array); + let specialized = TypeId(types.len() as u32); + types.push(Type::ForAll { + variables: vec![TypeVariableId(1)], + body: array_body, + }); + let (field, selected) = if reverse { + (specialized, general) + } else { + (general, specialized) + }; + let record = TypeId(types.len() as u32); + types.push(Type::Constructor(TypeConstructor::Record)); + let empty = TypeId(types.len() as u32); + types.push(Type::RowEmpty); + let row = TypeId(types.len() as u32); + types.push(Type::RowExtend { + label: "identity".into(), + ty: field, + tail: empty, + }); + let dictionary = TypeId(types.len() as u32); + types.push(Type::Application(record, row)); + let span = TextRange::new(0, 1); + single_declaration( + types, + selected, + Expr { + kind: ExprKind::FieldAccess { + record: Box::new(Expr { + kind: ExprKind::Trap, + ty: dictionary, + span, + }), + field: "identity".into(), + }, + ty: selected, + span, + }, + ) +} + +#[test] +fn a_universal_dictionary_method_can_specialize_under_another_universal() { + projected_identity(false, false).verify().unwrap(); +} + +#[test] +fn universal_specialization_cannot_generalize_or_change_its_input_relation() { + for (reverse, inconsistent) in [(true, false), (false, true)] { + let errors = projected_identity(reverse, inconsistent) + .verify() + .unwrap_err(); + assert!( + errors + .iter() + .any(|error| error.message + == "Core expression type is inconsistent with its context") + ); + } +} diff --git a/crates/psrs-core/src/types/mod.rs b/crates/psrs-core/src/types/mod.rs index c5f15259..023f56cc 100644 --- a/crates/psrs-core/src/types/mod.rs +++ b/crates/psrs-core/src/types/mod.rs @@ -9,7 +9,9 @@ use psrs_hir::{TypeId as HirTypeId, TypeVariableId}; mod call; +mod variables; pub use call::call_parts; +pub(crate) use variables::{collect_free_variables, free_variables}; #[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] pub struct TypeId(pub u32); @@ -61,7 +63,7 @@ pub enum Type { }, /// A closure created with a fixed parameter list. The result is a value, /// even when that value is a function or another closure. Representation - /// lowering emits this for an effect; source arrows stay [`TypeConstructor::Function`]. + /// lowering emits this for runtime callables; source arrows stay [`TypeConstructor::Function`]. Closure { parameters: Vec, result: TypeId, diff --git a/crates/psrs-core/src/types/variables.rs b/crates/psrs-core/src/types/variables.rs new file mode 100644 index 00000000..658d9629 --- /dev/null +++ b/crates/psrs-core/src/types/variables.rs @@ -0,0 +1,65 @@ +use crate::{Module, Type, TypeId}; +use psrs_hir::TypeVariableId; +use std::collections::{HashMap, HashSet}; + +/// Free variables of a type in a verified module, respecting lexical forall +/// scope. Declaration quantifiers may also bind variables used only in bodies. +pub(crate) fn free_variables(module: &Module, id: TypeId) -> HashSet { + let mut free = HashSet::new(); + collect_free_variables( + id, + &module.types, + &mut HashMap::new(), + &mut HashSet::new(), + &mut free, + ); + free +} + +pub(crate) fn collect_free_variables( + id: TypeId, + types: &[Type], + bound: &mut HashMap, + active: &mut HashSet, + free: &mut HashSet, +) { + if !active.insert(id) { + return; + } + match types.get(id.0 as usize) { + Some(Type::Variable(variable)) if !bound.contains_key(variable) => { + free.insert(*variable); + } + Some(Type::Application(function, argument)) => { + collect_free_variables(*function, types, bound, active, free); + collect_free_variables(*argument, types, bound, active, free); + } + Some(Type::ForAll { variables, body }) => { + for variable in variables { + *bound.entry(*variable).or_default() += 1; + } + collect_free_variables(*body, types, bound, active, free); + for variable in variables { + let count = bound + .get_mut(variable) + .expect("the forall binder was entered"); + *count -= 1; + if *count == 0 { + bound.remove(variable); + } + } + } + Some(Type::RowExtend { ty, tail, .. }) => { + collect_free_variables(*ty, types, bound, active, free); + collect_free_variables(*tail, types, bound, active, free); + } + Some(Type::Closure { parameters, result }) => { + for parameter in parameters { + collect_free_variables(*parameter, types, bound, active, free); + } + collect_free_variables(*result, types, bound, active, free); + } + _ => {} + } + active.remove(&id); +} diff --git a/crates/psrs-core/src/verify/scopes/expr.rs b/crates/psrs-core/src/verify/scopes/expr.rs index 97215062..e41b8ec1 100644 --- a/crates/psrs-core/src/verify/scopes/expr.rs +++ b/crates/psrs-core/src/verify/scopes/expr.rs @@ -1,7 +1,7 @@ use super::{enter, error, leading_foralls, types::scoped_type}; -use crate::{Expr, ExprKind, Module, Pattern, PatternKind, Type, TypeId, VerifyError}; +use crate::{Expr, ExprKind, Module, Pattern, PatternKind, VerifyError}; use psrs_hir::TypeVariableId; -use std::collections::{HashMap, HashSet}; +use std::collections::HashSet; pub(super) fn scoped_expr( expression: &Expr, @@ -213,14 +213,7 @@ fn open_child_binders( scope: &mut HashSet, errors: &mut Vec, ) { - let mut free = HashSet::new(); - free_type_variables( - child.ty, - module, - &mut HashMap::new(), - &mut HashSet::new(), - &mut free, - ); + let free = crate::types::free_variables(module, child.ty); let relevant = candidates .iter() .copied() @@ -243,53 +236,6 @@ fn open_child_binders( scope.extend(local); } -fn free_type_variables( - id: TypeId, - module: &Module, - bound: &mut HashMap, - active: &mut HashSet, - free: &mut HashSet, -) { - if !active.insert(id) { - return; - } - match module.types.get(id.0 as usize) { - Some(Type::Variable(variable)) if !bound.contains_key(variable) => { - free.insert(*variable); - } - Some(Type::Application(function, argument)) => { - free_type_variables(*function, module, bound, active, free); - free_type_variables(*argument, module, bound, active, free); - } - Some(Type::ForAll { variables, body }) => { - for variable in variables { - *bound.entry(*variable).or_default() += 1; - } - free_type_variables(*body, module, bound, active, free); - for variable in variables { - if let Some(count) = bound.get_mut(variable) { - *count -= 1; - if *count == 0 { - bound.remove(variable); - } - } - } - } - Some(Type::RowExtend { ty, tail, .. }) => { - free_type_variables(*ty, module, bound, active, free); - free_type_variables(*tail, module, bound, active, free); - } - Some(Type::Closure { parameters, result }) => { - for parameter in parameters { - free_type_variables(*parameter, module, bound, active, free); - } - free_type_variables(*result, module, bound, active, free); - } - _ => {} - } - active.remove(&id); -} - fn scoped_pattern( pattern: &Pattern, module: &Module, diff --git a/crates/psrs-core/src/verify/types/matching/helpers.rs b/crates/psrs-core/src/verify/types/matching/helpers.rs index 95eb6b50..3ff68d04 100644 --- a/crates/psrs-core/src/verify/types/matching/helpers.rs +++ b/crates/psrs-core/src/verify/types/matching/helpers.rs @@ -1,53 +1,6 @@ -use crate::{Module, Type, TypeId, record_row}; +use crate::{Module, TypeId, record_row}; use std::collections::{HashMap, HashSet}; -pub(super) fn collect_free_variables( - id: TypeId, - types: &[Type], - bound: &mut HashMap, - active: &mut HashSet, - free: &mut HashSet, -) { - if !active.insert(id) { - return; - } - match types.get(id.0 as usize) { - Some(Type::Variable(variable)) if !bound.contains_key(variable) => { - free.insert(*variable); - } - Some(Type::Application(function, argument)) => { - collect_free_variables(*function, types, bound, active, free); - collect_free_variables(*argument, types, bound, active, free); - } - Some(Type::ForAll { variables, body }) => { - for variable in variables { - *bound.entry(*variable).or_default() += 1; - } - collect_free_variables(*body, types, bound, active, free); - for variable in variables { - if let Some(count) = bound.get_mut(variable) { - *count -= 1; - if *count == 0 { - bound.remove(variable); - } - } - } - } - Some(Type::RowExtend { ty, tail, .. }) => { - collect_free_variables(*ty, types, bound, active, free); - collect_free_variables(*tail, types, bound, active, free); - } - Some(Type::Closure { parameters, result }) => { - for parameter in parameters { - collect_free_variables(*parameter, types, bound, active, free); - } - collect_free_variables(*result, types, bound, active, free); - } - _ => {} - } - active.remove(&id); -} - pub(super) fn same_type(left: TypeId, right: TypeId, module: &Module) -> bool { super::super::types_compatible( left, diff --git a/crates/psrs-core/src/verify/types/matching/mod.rs b/crates/psrs-core/src/verify/types/matching/mod.rs index 887c1627..5cec08dc 100644 --- a/crates/psrs-core/src/verify/types/matching/mod.rs +++ b/crates/psrs-core/src/verify/types/matching/mod.rs @@ -21,9 +21,10 @@ mod invariant; pub(crate) use evidence::instantiation; mod helpers; mod rows; +use crate::types::collect_free_variables; pub(in crate::verify) use constructors::constructor_fields_match; pub(crate) use helpers::equivalent_types; -use helpers::{collect_free_variables, is_record_type, same_type}; +use helpers::{is_record_type, same_type}; use rows::RowForm; pub(in crate::verify) fn compatible( @@ -161,8 +162,8 @@ impl TypeMatcher<'_> { /// Checks value subsumption: `actual` may be consumed wherever `expected` /// is required. Function parameters are contravariant, while immutable /// record fields are covariant. An actual universal may be instantiated; - /// an expected universal remains rigid and therefore requires an actual - /// universal with alpha-equivalent binders. + /// an expected universal remains rigid. An actual universal may specialize + /// its body even when both sides quantify the same number of variables. fn subsumption(&mut self, actual: TypeId, expected: TypeId, instantiate: bool) -> bool { if !self .active @@ -235,6 +236,7 @@ impl TypeMatcher<'_> { body: expected_body, } = expected_type && actual_variables.len() == expected_variables.len() + && !instantiate { if actual_variables .iter() diff --git a/crates/psrs-core/src/verify/types/matching/rows.rs b/crates/psrs-core/src/verify/types/matching/rows.rs index 4d971076..827489c6 100644 --- a/crates/psrs-core/src/verify/types/matching/rows.rs +++ b/crates/psrs-core/src/verify/types/matching/rows.rs @@ -1,5 +1,5 @@ -use super::helpers::collect_free_variables; use super::{TypeMatcher, Variance}; +use crate::types::collect_free_variables; use crate::{Type, TypeId, record_row}; use psrs_hir::TypeVariableId; use std::collections::{HashMap, HashSet}; diff --git a/crates/psrs-desugar/src/tests.rs b/crates/psrs-desugar/src/tests.rs index fd23b302..32adea92 100644 --- a/crates/psrs-desugar/src/tests.rs +++ b/crates/psrs-desugar/src/tests.rs @@ -10,6 +10,7 @@ fn lowers_operator_to_applications_and_preserves_source_ranges() { id: module_id, name: "Main".into(), externals: vec![hir::ExternalSymbol { + source_module: None, symbol: operator_id, name: "+".into(), kind: ExternalKind::Intrinsic(Intrinsic::IntAdd), diff --git a/crates/psrs-driver/src/tests/assertions.rs b/crates/psrs-driver/src/tests/assertions.rs index 3c2a9d63..e4b3b2ce 100644 --- a/crates/psrs-driver/src/tests/assertions.rs +++ b/crates/psrs-driver/src/tests/assertions.rs @@ -32,6 +32,7 @@ const UNIT_SOURCE: &str = r#" module Main where import Prelude +import Effect.Unsafe (unsafePerformEffect) import WASI.Console takesUnit :: Unit -> Int @@ -43,8 +44,8 @@ describe _ = "other" main = let - message = runEffect (log (describe (takesUnit unit))) - alsoUnit = runEffect (log (describe (takesUnit ()))) + message = unsafePerformEffect (log (describe (takesUnit unit))) + alsoUnit = unsafePerformEffect (log (describe (takesUnit ()))) in let ignored = message in let ignoredToo = alsoUnit in 0 "#; @@ -93,7 +94,7 @@ fn the_unit_value_executes_when_wasmtime_is_available() { #[test] fn a_held_assertion_lets_the_program_finish_when_wasmtime_is_available() { - let source = "module Main where\nimport Prelude\nimport Test.Assert\nheld :: Effect Unit\nheld = do\n assert true\n assertTrue true\n assertFalse false\n assert' \"unused\" true\n pure unit\nmain = let ignored = runEffect held in 0\n"; + let source = "module Main where\nimport Prelude\nimport Effect (Effect)\nimport Effect.Unsafe (unsafePerformEffect)\nimport Test.Assert\nheld :: Effect Unit\nheld = do\n assert true\n assertTrue true\n assertFalse false\n assert' \"unused\" true\n pure unit\nmain = let ignored = unsafePerformEffect held in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -104,7 +105,7 @@ fn a_held_assertion_lets_the_program_finish_when_wasmtime_is_available() { #[test] fn a_failed_assertion_traps_with_its_message_when_wasmtime_is_available() { - let source = "module Main where\nimport Prelude\nimport Test.Assert\nmain = let ignored = runEffect (assert false) in 0\n"; + let source = "module Main where\nimport Prelude\nimport Effect.Unsafe (unsafePerformEffect)\nimport Test.Assert\nmain = let ignored = unsafePerformEffect (assert false) in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -117,7 +118,7 @@ fn a_failed_assertion_writes_the_message_before_it_traps() { // `assert'` carries the diagnostic, and the standard error write must // happen before the trap: the trap ends the guest, so a later write would // never reach the host. - let source = "module Main where\nimport Prelude\nimport Test.Assert\nmain = let ignored = runEffect (assert' \"Expected 42\" false) in 0\n"; + let source = "module Main where\nimport Prelude\nimport Effect.Unsafe (unsafePerformEffect)\nimport Test.Assert\nmain = let ignored = unsafePerformEffect (assert' \"Expected 42\" false) in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -129,7 +130,7 @@ fn a_failed_assertion_writes_the_message_before_it_traps() { fn a_statement_after_a_failed_assertion_never_runs() { // The escape is the end of the effect chain, not a value that evaluation // continues past, so the statement after the trap never gets to write. - let source = "module Main where\nimport Prelude\nimport Test.Assert\nimport WASI.Console\nfailed :: Effect Unit\nfailed = do\n assert false\n _ <- log \"unreachable\"\n pure unit\nmain = let ignored = runEffect failed in 0\n"; + let source = "module Main where\nimport Prelude\nimport Effect (Effect)\nimport Effect.Unsafe (unsafePerformEffect)\nimport Test.Assert\nimport WASI.Console\nfailed :: Effect Unit\nfailed = do\n assert false\n _ <- log \"unreachable\"\n pure unit\nmain = let ignored = unsafePerformEffect failed in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -140,7 +141,7 @@ fn a_statement_after_a_failed_assertion_never_runs() { #[test] fn assert_true_and_assert_false_report_the_value_that_did_not_hold() { - let source = "module Main where\nimport Prelude\nimport Test.Assert\nmain = let ignored = runEffect (assertTrue false) in 0\n"; + let source = "module Main where\nimport Prelude\nimport Effect.Unsafe (unsafePerformEffect)\nimport Test.Assert\nmain = let ignored = unsafePerformEffect (assertTrue false) in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -163,7 +164,9 @@ fn log_show_writes_the_library_rendering() { module Main where import Prelude +import Effect (Effect) import Effect.Console (logShow) +import Effect.Unsafe (unsafePerformEffect) checks :: Effect Unit checks = do @@ -175,7 +178,7 @@ checks = do logShow [1, 2, 3] pure unit -main = let ignored = runEffect checks in 0 +main = let ignored = unsafePerformEffect checks in 0 "#; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); diff --git a/crates/psrs-driver/src/tests/cc_ir_audit.rs b/crates/psrs-driver/src/tests/cc_ir_audit.rs index 707edc56..55bec2c1 100644 --- a/crates/psrs-driver/src/tests/cc_ir_audit.rs +++ b/crates/psrs-driver/src/tests/cc_ir_audit.rs @@ -142,7 +142,7 @@ fn cc_declarations_are_well_formed_and_capture_once() { #[test] fn effects_observe_callee_and_argument_order() { let name = "effects_observe_callee_and_argument_order"; - let source = "module Main where\nimport Prelude\nimport WASI.Console\nfirst :: Unit -> Unit -> Int\nfirst a b = 0\nmain = first (runEffect (log \"a\")) (runEffect (log \"b\"))\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nfirst :: Unit -> Unit -> Int\nfirst a b = 0\nmain = first (unsafePerformEffect (log \"a\")) (unsafePerformEffect (log \"b\"))\n"; let artifact = compile_source("Main.purs", source).expect("ordered effects compile"); if let Some(output) = execute_wasm(name, &artifact.wasm).expect("executing ordered effects") { assert_eq!(output.status.code(), Some(0)); diff --git a/crates/psrs-driver/src/tests/data_function.rs b/crates/psrs-driver/src/tests/data_function.rs index da911c6b..b78ec6e5 100644 --- a/crates/psrs-driver/src/tests/data_function.rs +++ b/crates/psrs-driver/src/tests/data_function.rs @@ -32,6 +32,7 @@ main = run choose identity 42 fn the_application_operators_resolve_through_the_library_re_export() { let source = r#" module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Effect (Effect) @@ -65,7 +66,7 @@ checks = do log (if viaConst == 1 then "const" else "const-wrong") pure unit -main = let ignored = runEffect checks in 0 +main = let ignored = unsafePerformEffect checks in 0 "#; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); diff --git a/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs b/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs index 5cfdd828..60acdd13 100644 --- a/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs +++ b/crates/psrs-driver/src/tests/dictionary_audit/fixtures/methods.rs @@ -322,6 +322,7 @@ pub(crate) fn recursive_instance_module() -> (thir::Module, SymbolId) { ); let intrinsic = |symbol, name: &str, intrinsic| ExternalSymbol { + source_module: None, symbol, name: name.into(), kind: ExternalKind::Intrinsic(intrinsic), diff --git a/crates/psrs-driver/src/tests/foldable.rs b/crates/psrs-driver/src/tests/foldable.rs index c36570af..7fcab594 100644 --- a/crates/psrs-driver/src/tests/foldable.rs +++ b/crates/psrs-driver/src/tests/foldable.rs @@ -11,6 +11,8 @@ use super::*; fn monoid_identities_and_folds_run_under_wasmtime() { let source = r#" module Main where +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) import Prelude import Effect.Console (log) @@ -41,7 +43,7 @@ checks = do log (foldMap (\x -> x) (One "one")) pure unit -main = let ignored = runEffect checks in 0 +main = let ignored = unsafePerformEffect checks in 0 "#; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); diff --git a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs index 7f1681e4..898b6b50 100644 --- a/crates/psrs-driver/src/tests/generic_aggregate_audit.rs +++ b/crates/psrs-driver/src/tests/generic_aggregate_audit.rs @@ -56,7 +56,7 @@ fn execute_wasm_output(name: &str, wasm: &[u8]) -> Result { @@ -321,7 +321,7 @@ fn audit_battery() { }, Case { name: "scalar_unit_array", - source: "module Main where\nimport Prelude\nimport WASI.Console\ncopy :: forall a. Array a -> Array a\ncopy values = values\nmain = arrayLength (copy [runEffect (log \"\")])\n", + source: "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\ncopy :: forall a. Array a -> Array a\ncopy values = values\nmain = arrayLength (copy [unsafePerformEffect (log \"\")])\n", exit: 1, }, Case { diff --git a/crates/psrs-driver/src/tests/guards.rs b/crates/psrs-driver/src/tests/guards.rs index c949251f..f61b48f0 100644 --- a/crates/psrs-driver/src/tests/guards.rs +++ b/crates/psrs-driver/src/tests/guards.rs @@ -286,7 +286,7 @@ fn repeated_names_inside_a_case_named_pattern_are_rejected() { #[test] fn multiple_case_scrutinees_preserve_order_and_guard_fallthrough() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = case runEffect (log \"1\"), runEffect (log \"2\"), runEffect (log \"3\"), runEffect (log \"4\"), runEffect (log \"5\"), runEffect (log \"6\"), runEffect (log \"7\"), runEffect (log \"8\"), runEffect (log \"9\"), runEffect (log \"10\") of\n _, _, _, _, _, _, _, _, _, _ | false -> 10\n _, _, _, _, _, _, _, _, _, _ | true -> 22\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = case unsafePerformEffect (log \"1\"), unsafePerformEffect (log \"2\"), unsafePerformEffect (log \"3\"), unsafePerformEffect (log \"4\"), unsafePerformEffect (log \"5\"), unsafePerformEffect (log \"6\"), unsafePerformEffect (log \"7\"), unsafePerformEffect (log \"8\"), unsafePerformEffect (log \"9\"), unsafePerformEffect (log \"10\") of\n _, _, _, _, _, _, _, _, _, _ | false -> 10\n _, _, _, _, _, _, _, _, _, _ | true -> 22\n"; let artifact = compile_source("Main.purs", source).expect("multi-scrutinee guarded case compiles"); assert!(!has_non_exhaustive_warning(&artifact)); diff --git a/crates/psrs-driver/src/tests/integration.rs b/crates/psrs-driver/src/tests/integration.rs index 1bc1e86d..60c5bd2b 100644 --- a/crates/psrs-driver/src/tests/integration.rs +++ b/crates/psrs-driver/src/tests/integration.rs @@ -228,7 +228,7 @@ fn compiles_multiple_user_sources_with_the_embedded_prelude() { let helper = ("Helper.purs", "module Helper where\nanswer = 40\n"); let main = ( "Main.purs", - "module Main where\nimport Helper\nimport Prelude\nimport WASI.Console\nmain = let ignored = runEffect (log \"linked\") in 0\n", + "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Helper\nimport Prelude\nimport WASI.Console\nmain = let ignored = unsafePerformEffect (log \"linked\") in 0\n", ); let artifact = compile_program_sources_with_prelude(&[helper, main]).unwrap(); assert!(artifact.wat.contains("wasi:cli/stdout@0.2.12")); diff --git a/crates/psrs-driver/src/tests/native_representation.rs b/crates/psrs-driver/src/tests/native_representation.rs deleted file mode 100644 index 6ebc2af3..00000000 --- a/crates/psrs-driver/src/tests/native_representation.rs +++ /dev/null @@ -1,247 +0,0 @@ -//! Shared native computation for the Effect/ST design: an answer-indexed -//! request functor inside a phantom-result free monad, interpreted by leaf -//! storage operations and one host operation. This remains a prototype outside -//! the package; it is not public Effect/ST migration. - -const NAIVE_NOMINAL_EFFECT: &str = r#"module Main where -data Native f a = Return a | Suspend (f (Native f a)) -data NativeF next = NativeF next -newtype Effect a = Effect (Native NativeF a) -type role Effect representational -main :: Int -main = 0 -"#; - -const PHANTOM_FREE_ROLES: &str = r#"module Main where -data Val -data View f = Ret Val | Bound (f Val) (Val -> Native f Val) -data Native f a = Native (View f) -data NativeF next = NativeF next -data Global -newtype Effect a = Effect (Native NativeF a) -type role Effect representational -newtype ST r a = ST (Native NativeF a) -type role ST nominal representational -main :: Int -main = 0 -"#; - -const NATIVE: &str = r###"module PSRS.Effect.Native - ( Native - , NativeF - , Cell - , Effect(..) - , ST(..) - , Global - , newCell - , readCell - , writeCell - , clockNow - , abort - , runNative - , runEffect - , runST - , toEffect - ) where - -import Prelude - -import PSRS.Effect.Native.Host (clockNow) as Host -import Unsafe.Coerce (unsafeCoerce) - -foreign import "psrs:intrinsic#arrayFill" filled :: forall a. Int -> a -> Array a -foreign import "psrs:intrinsic#arrayWrite" slot :: forall a. Array a -> Int -> a -> Array a -foreign import "psrs:intrinsic#arrayIndex" at :: forall a. Array a -> Int -> a -foreign import "psrs:runtime-storage#trap" trap :: forall a. a - -newtype Cell a = Cell (Array a) - --- Upstream Free erases the result to `Val`, so `a` is phantom and Effect/ST --- may declare the official representational result role. `next` on NativeF is --- the operation answer, not the rest of the program. -data Val -data View f = Ret Val | Bound (f Val) (Val -> Native f Val) -data Native f a = Native (View f) - -liftF :: forall f a. Functor f => f a -> Native f a -liftF fa = Native (Bound (unsafeCoerce fa :: f Val) (\v -> Native (Ret v))) - -pureNative :: forall f a. a -> Native f a -pureNative a = Native (Ret (unsafeCoerce a)) - -bindNative :: forall f a b. Native f a -> (a -> Native f b) -> Native f b -bindNative (Native (Ret v)) k = k (unsafeCoerce v) -bindNative (Native (Bound req cont)) k = - Native (Bound req (\v -> bindNative (cont v) (unsafeCoerce k))) - -instance functorNative :: Functor (Native f) where - map f n = bindNative n \a -> pureNative (f a) - -instance bindNativeI :: Bind (Native f) where - bind = bindNative - -instance applyNative :: Apply (Native f) where - apply = ap - -instance applicativeNative :: Applicative (Native f) where - pure = pureNative - -instance monadNative :: Monad (Native f) - -type Methods next z = - { new :: forall a. a -> (Cell a -> next) -> z - , read :: forall a. Cell a -> (a -> next) -> z - , write :: forall a. Cell a -> a -> (Unit -> next) -> z - , clockNow :: (Int -> next) -> z - , abort :: Unit -> z - } - -newtype NativeF next = NativeF (forall z. Methods next z -> z) - -instance functorNativeF :: Functor NativeF where - map g (NativeF k) = NativeF \h -> - k - { new: \value cont -> h.new value (cont >>> g) - , read: \cell cont -> h.read cell (cont >>> g) - , write: \cell value cont -> h.write cell value (cont >>> g) - , clockNow: \cont -> h.clockNow (cont >>> g) - , abort: h.abort - } - -newCell :: forall a. a -> Native NativeF (Cell a) -newCell value = liftF (NativeF \h -> h.new value identity) - -readCell :: forall a. Cell a -> Native NativeF a -readCell cell = liftF (NativeF \h -> h.read cell identity) - -writeCell :: forall a. Cell a -> a -> Native NativeF Unit -writeCell cell value = liftF (NativeF \h -> h.write cell value identity) - -clockNow :: Native NativeF Int -clockNow = liftF (NativeF \h -> h.clockNow identity) - -abort :: forall a. Native NativeF a -abort = liftF (NativeF \h -> h.abort unit) - -runNative :: forall a. Native NativeF a -> a -runNative = go - where - -- Answer-indexed NativeF already stored the payload; Free holds the - -- continuation. Do not map the continuation back into NativeF: that would - -- compose through the erased `Val` answer and is not required to interpret. - go :: Native NativeF a -> a - go (Native (Ret v)) = unsafeCoerce v - go (Native (Bound req k)) = case unsafeCoerce req :: NativeF Val of - NativeF methods -> - let cont :: Val -> Native NativeF a - cont v = unsafeCoerce (k v) - in methods - { new: \value _ -> go (cont (unsafeCoerce (Cell (filled 1 value)))) - , read: \(Cell cell) _ -> go (cont (unsafeCoerce (at cell 0))) - , write: \(Cell cell) value _ -> - go (cont (unsafeCoerce (let _ = slot cell 0 value in unit))) - , clockNow: \_ -> go (cont (unsafeCoerce Host.clockNow)) - , abort: \_ -> trap - } - -newtype Effect a = Effect (Native NativeF a) -type role Effect representational - -data Global - -newtype ST r a = ST (Native NativeF a) -type role ST nominal representational - -toEffect :: forall a. ST Global a -> Effect a -toEffect = unsafeCoerce - -runEffect :: forall a. Effect a -> a -runEffect (Effect n) = runNative n - -runST :: forall a. (forall r. ST r a) -> a -runST action = runNative (unST action) - where - unST :: forall r. ST r a -> Native NativeF a - unST (ST n) = n -"###; - -const HOST: &str = r#"module PSRS.Effect.Native.Host (clockNow) where - -foreign import "wasi:clocks/monotonic-clock#now" clockNow :: Int -"#; - -const ENTRY: &str = r#"module Main where - -import Prelude - -import PSRS.Effect.Native - ( Global - , Native - , NativeF - , ST(..) - , clockNow - , newCell - , readCell - , runEffect - , runST - , toEffect - , writeCell - ) - -program :: Native NativeF Int -program = do - ints <- newCell 0 - strs <- newCell "a" - _ <- writeCell ints 41 - _ <- writeCell strs "b" - stamp <- clockNow - first <- readCell ints - second <- readCell strs - if stamp >= 0 && second == "b" then pure (first + 1) else pure 0 - -storage :: forall r. ST r Int -storage = ST program - -globalStorage :: ST Global Int -globalStorage = ST program - -main :: Int -main = - let viaST = runST storage - viaEffect = runEffect (toEffect globalStorage) - in if viaST == 42 && viaEffect == 42 then 42 else 0 -"#; - -fn rejects_role(source: &str) { - let errors = crate::check_program(&[("Main.purs", source)]).expect_err("should be rejected"); - assert!( - errors - .iter() - .any(|error| error.diagnostic.code == Some("RoleMismatch")), - "expected RoleMismatch, got {errors:?}" - ); -} - -#[test] -fn a_naive_free_monad_rejects_a_representational_effect_role() { - rejects_role(NAIVE_NOMINAL_EFFECT); -} - -#[test] -fn a_phantom_free_native_program_accepts_official_effect_and_st_roles() { - crate::check_program(&[("Main.purs", PHANTOM_FREE_ROLES)]).unwrap_or_else(|errors| { - panic!("phantom Free should accept official Effect/ST roles: {errors:?}") - }); -} - -#[test] -fn st_global_to_effect_runs_heterogeneous_storage_and_host() { - let Some(output) = super::run_program_with_prelude_wasmtime(&[ - ("PSRS/Effect/Native/Host.purs", HOST), - ("PSRS/Effect/Native.purs", NATIVE), - ("Main.purs", ENTRY), - ]) else { - return; - }; - assert_eq!(output.status.code(), Some(42), "{output:?}"); -} diff --git a/crates/psrs-driver/src/tests/native_representation/algebraic.rs b/crates/psrs-driver/src/tests/native_representation/algebraic.rs new file mode 100644 index 00000000..0af43903 --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/algebraic.rs @@ -0,0 +1,60 @@ +const CUSTOM_HANDLER: &str = r#"module Main where +import Prelude +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) +import Run (Run) +import Run as Run +import Type.Proxy (Proxy(..)) +import WASI.Console (log) + +data Query a = Query (Int -> a) +derive instance functorQuery :: Functor Query + +query :: Proxy "query" +query = Proxy + +program :: Run (query :: Query) Int +program = do + n <- Run.lift query (Query identity) + pure (n + 1) + +handle :: forall a. Query a -> Effect a +handle (Query k) = do + log "handler" + pure (k 41) + +main :: Int +main = let action = Run.interpretRec (Run.on query handle Run.case_) program + _ = unsafePerformEffect (log "stored") + first = unsafePerformEffect action + second = unsafePerformEffect action + in first + second - 42 +"#; + +#[test] +fn a_custom_algebraic_handler_builds_reusable_native_effects_without_running_early() { + let Some(output) = + super::super::run_program_with_prelude_wasmtime(&[("Main.purs", CUSTOM_HANDLER)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"stored\nhandler\nhandler\n", "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn interpreting_one_operation_does_not_discard_a_residual_row() { + let source = CUSTOM_HANDLER.replace( + "program :: Run (query :: Query) Int", + "program :: Run (query :: Query, residual :: Query) Int", + ); + let errors = crate::check_program_types_lenient_with_prelude(&[("Main.purs", &source)]) + .expect_err("case_ cannot eliminate the residual operation"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.stage == "P5 typecheck"), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/native_representation/arrays.rs b/crates/psrs-driver/src/tests/native_representation/arrays.rs new file mode 100644 index 00000000..3274eb5e --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/arrays.rs @@ -0,0 +1,56 @@ +#[test] +fn public_mutable_arrays_copy_safe_conversions_and_share_growth_through_aliases() { + let source = r#"module Main where +import Prelude +import Control.Monad.ST as ST +import Data.Array.ST as A +import Data.Array.ST.Partial as PartialArray +import Data.Maybe (Maybe(..)) +import Effect.Unsafe (unsafePerformEffect) +import WASI.Console (log) +import Partial.Unsafe (unsafePartial) + +update :: forall r a. a -> A.STArray r a -> ST.ST r Boolean +update value xs = A.poke 0 value xs + +main :: Int +main = ST.run do + let original = [1, 2] + xs <- A.thaw original + let alias = xs + _ <- update 7 xs + frozen <- A.freeze xs + copied <- A.clone xs + _ <- update 8 alias + _ <- A.push 9 xs + grown <- A.length alias + current <- A.peek 0 alias + cloneFirst <- A.peek 0 copied + cloneLength <- A.length copied + _ <- A.modify 1 (\value -> + let _ = unsafePerformEffect (log "array-callback") in value + 10) alias + second <- A.peek 1 xs + text <- A.thaw ["first"] + _ <- update "second" text + changed <- A.peek 0 text + partialFirst <- unsafePartial (PartialArray.peek 0 xs) + _ <- unsafePartial (PartialArray.poke 2 10 xs) + partialThird <- A.peek 2 xs + owned <- A.unsafeThaw [4, 5] + _ <- update 6 owned + transferred <- A.unsafeFreeze owned + if arrayIndex original 0 == 1 && arrayIndex frozen 0 == 7 + && grown == 3 && current == Just 8 && cloneFirst == Just 7 + && cloneLength == 2 && second == Just 12 && changed == Just "second" + && partialFirst == 8 && partialThird == Just 10 + && arrayIndex transferred 0 == 6 + then pure 42 else pure 0 +"#; + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", source)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"array-callback\n", "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/native_representation/command.rs b/crates/psrs-driver/src/tests/native_representation/command.rs new file mode 100644 index 00000000..8b8ce07c --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/command.rs @@ -0,0 +1,50 @@ +#[test] +fn the_configured_native_command_runner_executes_effect_unit_once() { + let source = r#"module Main where +import Prelude +import Effect (Effect) +import WASI.Console (log) +main :: Effect Unit +main = do + log "command" + pure unit +"#; + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", source)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(0), "{output:?}"); + assert_eq!(output.stdout, b"command\n", "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn the_native_command_runner_propagates_traps_and_rejects_a_different_result_type() { + let source = r#"module Main where +import Prelude +import Effect (Effect) +import Test.Assert (assert) +import WASI.Console (log) +main :: Effect Unit +main = do + log "before" + assert false + log "after" +"#; + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", source)]) + else { + return; + }; + assert!(!output.status.success(), "{output:?}"); + assert_eq!(output.stdout, b"before\n", "{output:?}"); + let invalid = "module Main where\nimport Prelude\nimport Effect (Effect)\nmain :: Effect Int\nmain = pure 42\n"; + let errors = crate::compile_program_sources_with_prelude(&[("Main.purs", invalid)]) + .expect_err("the ordinary runner accepts only its declared input"); + assert!( + errors.iter().any(|error| error + .diagnostic + .message + .contains("command entry type disagrees with the configured runner input")), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/native_representation/host.rs b/crates/psrs-driver/src/tests/native_representation/host.rs new file mode 100644 index 00000000..84d6257d --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/host.rs @@ -0,0 +1,56 @@ +//! Official WASI and Test.Assert wrappers after WIT import schemes became live +//! layout roots. Construction stays inert; `unsafePerformEffect` runs `Host.lift`. + +const OFFICIAL_HOST_LEAVES: &str = r#"module Main where + +import Prelude + +import Effect.Unsafe (unsafePerformEffect) +import Test.Assert (assert) +import WASI.Clock (now, wallNow) +import WASI.Console (log) +import WASI.IO (getStdout) +import WASI.Random (randomBytes, randomU64) + +main :: Int +main = + let tick = unsafePerformEffect now * 0 + wall = unsafePerformEffect wallNow + noise = unsafePerformEffect randomU64 * 0 + bytes = unsafePerformEffect (randomBytes 4) + _ = unsafePerformEffect (log "host-leaf") + _ = unsafePerformEffect getStdout + _ = unsafePerformEffect (assert true) + in if arrayLength bytes == 4 && wall.seconds * 0 == tick + noise + then 42 + else 0 +"#; + +#[test] +fn official_wasi_and_assert_wrappers_run_through_effect() { + let Some(output) = + super::super::run_program_with_prelude_wasmtime(&[("Main.purs", OFFICIAL_HOST_LEAVES)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!( + output.stdout, b"host-leaf\n", + "WASI.Console.log must write through Host.lift: {output:?}" + ); +} + +const HOST_ORDER: &str = + include_str!("../../../../../../psrs-stdlib/conformance/native/HostOrder.purs"); + +#[test] +fn stored_host_work_stays_inert_and_runs_in_source_order() { + let Some(output) = + super::super::run_program_with_prelude_wasmtime(&[("Main.purs", HOST_ORDER)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"first\nsecond\n", "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/native_representation/identity.rs b/crates/psrs-driver/src/tests/native_representation/identity.rs new file mode 100644 index 00000000..30d982ca --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/identity.rs @@ -0,0 +1,33 @@ +//! Rank-N cell transport, in-place polymorphic writes, and ignored-write order. +//! The sources live with the public native oracle so the two stay the same case. + +const IDENTITY: &str = + include_str!("../../../../../../psrs-stdlib/conformance/native/Identity.purs"); +const MALFORMED: &str = + include_str!("../../../../../../psrs-stdlib/conformance/native/Malformed.purs"); + +#[test] +fn polymorphic_refs_keep_cell_identity_and_write_order() { + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", IDENTITY)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"before\nafter\n", "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn a_coerced_non_cell_ref_is_rejected_before_codegen() { + let errors = + crate::compile_program_sources_with_prelude(&[("Main.purs", MALFORMED)]) + .expect_err("Int and Ref have different runtime shapes"); + assert!( + errors.iter().any(|error| { + error.diagnostic.stage == "P8 closure conversion" + && error.diagnostic.message + == "unsupported aggregate conversion between normalized runtime shapes" + }), + "{errors:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/native_representation/mod.rs b/crates/psrs-driver/src/tests/native_representation/mod.rs new file mode 100644 index 00000000..d7b14603 --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/mod.rs @@ -0,0 +1,103 @@ +//! Official Effect/ST adapters and generic representation regressions. + +mod algebraic; +mod arrays; +mod command; +mod host; +mod identity; +mod region; +mod semantics; +mod sources; +mod uncurried; + +use sources::ENTRY; + +const NAIVE_NOMINAL_EFFECT: &str = r#"module Main where +data Native f a = Return a | Suspend (f (Native f a)) +data NativeF next = NativeF next +newtype Effect a = Effect (Native NativeF a) +type role Effect representational +main :: Int +main = 0 +"#; + +const PHANTOM_FREE_ROLES: &str = r#"module Main where +data Val +data View f = Ret Val | Bound (f Val) (Val -> Native f Val) +data Native f a = Native (View f) +data NativeF next = NativeF next +data Global +newtype Effect a = Effect (Native NativeF a) +type role Effect representational +newtype ST r a = ST (Native NativeF a) +type role ST nominal representational +newtype STRef r a = STRef Int +type role STRef nominal representational +main :: Int +main = 0 +"#; + +fn rejects_role(source: &str) { + let errors = crate::check_program(&[("Main.purs", source)]).expect_err("should be rejected"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("RoleMismatch")), + "expected RoleMismatch, got {errors:?}" + ); +} + +#[test] +fn a_naive_free_monad_rejects_a_representational_effect_role() { + rejects_role(NAIVE_NOMINAL_EFFECT); +} + +#[test] +fn a_phantom_free_native_program_accepts_official_effect_and_st_roles() { + crate::check_program(&[("Main.purs", PHANTOM_FREE_ROLES)]).unwrap_or_else(|errors| { + panic!("phantom Free should accept official Effect/ST roles: {errors:?}") + }); +} + +#[test] +fn official_st_and_effect_run_storage_and_fresh_refs() { + let Some(output) = super::run_program_with_prelude_wasmtime(&[("Main.purs", ENTRY)]) else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +const HOST_CLOCK: &str = r#"module Main where +import Prelude +import Effect.Unsafe (unsafePerformEffect) +import PSRS.Effect.Host as Host +foreign import "wasi:clocks/monotonic-clock#now" clockNow :: Int +main :: Int +main = unsafePerformEffect (Host.lift \_ -> clockNow) * 0 + 42 +"#; + +#[test] +fn host_lift_delays_a_raw_canonical_clock_import() { + let Some(output) = super::run_program_with_prelude_wasmtime(&[("Main.purs", HOST_CLOCK)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} + +const OFFICIAL_CLOCK: &str = r#"module Main where +import Prelude +import Effect.Unsafe (unsafePerformEffect) +import WASI.Clock (now) +main :: Int +main = unsafePerformEffect now * 0 + 42 +"#; + +#[test] +fn official_clock_now_runs_through_effect() { + let Some(output) = super::run_program_with_prelude_wasmtime(&[("Main.purs", OFFICIAL_CLOCK)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/native_representation/region.rs b/crates/psrs-driver/src/tests/native_representation/region.rs new file mode 100644 index 00000000..f00264ab --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/region.rs @@ -0,0 +1,150 @@ +//! Region isolation and constructor-hiding on the official ST facade. + +fn rejects(main: &str, code: &str) { + let errors = crate::check_program_types_lenient_with_prelude(&[("Main.purs", main)]) + .expect_err("program should be rejected"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some(code)), + "expected {code}, got {errors:?}" + ); +} + +#[test] +fn run_rejects_an_escaping_st_reference() { + rejects( + r#"module Main where +import Prelude +import Control.Monad.ST as ST +import Control.Monad.ST.Ref as STRef +import Effect (Effect) + +test _ = do + r <- pure (ST.run (STRef.new 0)) + pure r + +main :: forall a. a -> Effect Int +main = test +"#, + "EscapedSkolem", + ); +} + +#[test] +fn run_rejects_an_escaping_st_action() { + rejects( + r#"module Main where +import Prelude +import Control.Monad.ST (ST) +import Control.Monad.ST as ST +import Control.Monad.ST.Ref as STRef + +leak :: forall r. ST r (ST r Int) +leak = do + ref <- STRef.new 0 + pure (STRef.read ref) + +main :: Int +main = ST.run leak +"#, + "EscapedSkolem", + ); +} + +#[test] +fn a_reference_cannot_be_read_in_another_region() { + rejects( + r#"module Main where +import Control.Monad.ST (ST) +import Control.Monad.ST.Ref (STRef, read) + +bad :: forall r s a. STRef r a -> ST s a +bad = read + +main :: Int +main = 0 +"#, + "TypesDoNotUnify", + ); +} + +#[test] +fn nominal_stref_region_rejects_coerce() { + rejects( + r#"module Main where +import Control.Monad.ST.Ref (STRef) +import Safe.Coerce (coerce) + +bad :: forall r s a. STRef r a -> STRef s a +bad = coerce + +main :: Int +main = 0 +"#, + "NoInstanceFound", + ); +} + +#[test] +fn host_clock_is_not_an_st_request() { + rejects( + r#"module Main where +import Control.Monad.ST (ST) +import WASI.Clock (now) + +bad :: forall r. ST r Int +bad = now + +main :: Int +main = 0 +"#, + "TypesDoNotUnify", + ); +} + +#[test] +fn the_st_constructor_is_not_exported() { + rejects( + r#"module Main where +import Control.Monad.ST (ST) + +unwrap :: forall r a. ST r a -> Int +unwrap (ST _) = 0 + +main :: Int +main = 0 +"#, + "UnknownName", + ); +} + +#[test] +fn st_and_stref_regions_keep_the_official_region_kind() { + for name in ["ST", "STRef"] { + let source = format!( + "module Main where\nimport Control.Monad.ST.Internal ({name})\nforeign import bad :: {name} Int Int\nmain :: Int\nmain = 0\n" + ); + let errors = crate::check_program_kinds_lenient_with_prelude(&[("Main.purs", &source)]) + .expect_err("a Type cannot inhabit the Region kind"); + assert!( + errors + .iter() + .any(|error| error.diagnostic.code == Some("KindsDoNotUnify")), + "{errors:?}" + ); + } +} + +#[test] +fn public_array_and_uncurried_adapters_keep_foreign_constructors_hidden() { + for (module, constructor) in [ + ("Data.Array.ST", "STArray"), + ("Control.Monad.ST.Uncurried", "STFn1"), + ] { + let source = format!( + "module Main where\nimport {module} as A\nunwrap (A.{constructor} value) = value\nmain :: Int\nmain = 0\n" + ); + rejects(&source, "UnknownName"); + } +} diff --git a/crates/psrs-driver/src/tests/native_representation/semantics.rs b/crates/psrs-driver/src/tests/native_representation/semantics.rs new file mode 100644 index 00000000..cc354485 --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/semantics.rs @@ -0,0 +1,227 @@ +fn execute(source: &str, stdout: &[u8]) { + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", source)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, stdout, "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} + +#[test] +fn pure_bind_delays_its_callback_but_keeps_factory_arguments_strict() { + execute( + r#"module Main where +import Prelude +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) +import WASI.Console (log) + +factory :: Int -> Effect Int +factory n = pure n >>= \value -> + let _ = unsafePerformEffect (log "callback") in pure (value + 1) + +main :: Int +main = + let argument = let _ = unsafePerformEffect (log "argument") in 41 + action = factory argument + _ = unsafePerformEffect (log "stored") + first = unsafePerformEffect action + second = unsafePerformEffect action + in first + second - 42 +"#, + b"argument\nstored\ncallback\ncallback\n", + ); +} + +#[test] +fn public_loops_monadrec_and_left_and_right_bind_chains_are_stack_safe() { + execute( + r#"module Main where +import Prelude +import Control.Monad.Rec.Class (Step(..), tailRecM) +import Control.Monad.ST as ST +import Control.Monad.ST.Ref as STRef +import Effect (Effect, forE) +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) +import WASI.Console (log) + +left :: Int -> Effect Int -> Effect Int +left n action = if n == 0 then action else left (n - 1) (action >>= \x -> pure (x + 1)) + +right :: Int -> Effect Int +right n = if n == 0 then pure 0 else pure unit >>= \_ -> map (_ + 1) (right (n - 1)) + +mixed :: Effect Int +mixed = do + ref <- Ref.new 0 + forE 0 20000 \index -> do + Ref.modify_ (_ + 1) ref + if index == 0 || index == 19999 then log "edge" else pure unit + tailRecM (\n -> if n == 20000 then pure (Done unit) + else do + Ref.modify_ (_ + 1) ref + pure (Loop (n + 1))) 0 + Ref.read ref + +local :: Int +local = ST.run do + ref <- STRef.new 0 + ST.for 0 20000 \_ -> void (STRef.modify (_ + 1) ref) + STRef.read ref + +main :: Int +main = if unsafePerformEffect (left 20000 (pure 0)) == 20000 + && unsafePerformEffect (right 20000) == 20000 + && unsafePerformEffect mixed == 40000 && local == 20000 + then 42 else 0 +"#, + b"edge\nedge\n", + ); +} + +#[test] +fn repeated_runs_of_one_allocation_action_produce_independent_refs() { + execute( + r#"module Main where +import Prelude +import Effect (Effect) +import Effect.Ref (Ref) +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) + +allocate :: Effect (Ref Int) +allocate = Ref.new 0 + +main :: Int +main = unsafePerformEffect do + first <- allocate + second <- allocate + _ <- Ref.write 42 first + a <- Ref.read first + b <- Ref.read second + if a == 42 && b == 0 then pure 42 else pure 0 +"#, + b"", + ); +} + +#[test] +fn global_conversion_and_heterogeneous_cells_preserve_identity_across_runs() { + execute( + r#"module Main where +import Prelude +import Control.Monad.ST.Global (toEffect) +import Control.Monad.ST.Ref as STRef +import Effect (Effect) +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) + +change :: forall a. a -> Ref.Ref a -> Effect a +change value ref = Ref.write value ref *> Ref.read ref + +main :: Int +main = unsafePerformEffect do + global <- toEffect (STRef.new 0) + _ <- toEffect (STRef.write 40 global) + before <- toEffect (STRef.read global) + int <- Ref.new 0 + text <- Ref.new "old" + function <- Ref.new (\x -> x) + record <- Ref.new { value: 0, label: "old" } + let alias = int + a <- change (before + 1) int + b <- change "new" text + c <- change (\x -> x + 1) function + d <- change { value: 42, label: "new" } record + seen <- Ref.read alias + _ <- toEffect (STRef.modify (_ + 2) global) + after <- toEffect (STRef.read global) + if a == 41 && seen == 41 && b == "new" && c 41 == 42 + && d.value == 42 && d.label == b && after == 42 + then pure 42 else pure 0 +"#, + b"", + ); +} + +#[test] +fn ref_modify_invokes_its_callback_once_and_preserves_reentrant_order() { + execute( + r#"module Main where +import Prelude +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) + +main :: Int +main = unsafePerformEffect do + ref <- Ref.new 10 + calls <- Ref.new 0 + result <- Ref.modify' (\old -> + let _ = unsafePerformEffect (Ref.modify_ (_ + 1) calls) + _ = unsafePerformEffect (Ref.write 99 ref) + in { state: old + 1, value: old + 32 }) ref + now <- Ref.read ref + count <- Ref.read calls + writeResult <- Ref.write 12 ref + last <- Ref.modify (_ + 1) ref + if result == 42 && now == 11 && count == 1 && writeResult == unit && last == 13 + then pure 42 else pure 0 +"#, + b"", + ); +} + +#[test] +fn new_with_self_calls_once_and_publishes_the_same_reference() { + execute( + r#"module Main where +import Prelude +import Effect.Ref (Ref) +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) + +data Node = Node Int (Unit -> Ref Node) + +main :: Int +main = unsafePerformEffect do + count <- Ref.new 0 + ref <- Ref.newWithSelf (\self -> + let _ = unsafePerformEffect (Ref.modify_ (_ + 1) count) + in Node 41 (\_ -> self)) + Node before self <- Ref.read ref + _ <- Ref.write (Node (before + 1) self) (self unit) + Node after _ <- Ref.read ref + calls <- Ref.read count + if before == 41 && after == 42 && calls == 1 then pure 42 else pure 0 +"#, + b"", + ); +} + +#[test] +fn an_unpublished_self_read_traps_without_running_the_successor() { + let source = r#"module Main where +import Prelude +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) +import WASI.Console (log) + +main :: Int +main = unsafePerformEffect do + _ <- Ref.newWithSelf (\self -> unsafePerformEffect (Ref.read self)) + log "unreachable" + pure 42 +"#; + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", source)]) + else { + return; + }; + assert!(!output.status.success(), "{output:?}"); + assert!(output.stdout.is_empty(), "{output:?}"); + assert!( + String::from_utf8_lossy(&output.stderr).contains("unreachable"), + "{output:?}" + ); +} diff --git a/crates/psrs-driver/src/tests/native_representation/sources.rs b/crates/psrs-driver/src/tests/native_representation/sources.rs new file mode 100644 index 00000000..ca920897 --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/sources.rs @@ -0,0 +1,62 @@ +//! Official Effect/ST programs over the package native representation. + +pub const ENTRY: &str = r#"module Main where + +import Prelude + +import Control.Monad.ST as ST +import Control.Monad.ST.Global (toEffect) +import Control.Monad.ST.Ref as STRef +import Effect (Effect) +import Effect.Ref (Ref) +import Effect.Ref as Ref +import Effect.Unsafe (unsafePerformEffect) + +storage :: forall r. ST.ST r Int +storage = do + ints <- STRef.new 0 + strs <- STRef.new "a" + _ <- STRef.write 41 ints + _ <- STRef.write "b" strs + first <- STRef.read ints + second <- STRef.read strs + if second == "b" then pure (first + 1) else pure 0 + +effectProgram :: Effect Int +effectProgram = do + ints <- Ref.new 0 + strs <- Ref.new "a" + _ <- Ref.write 41 ints + _ <- Ref.write "b" strs + first <- Ref.read ints + second <- Ref.read strs + if second == "b" then pure (first + 1) else pure 0 + +freshRefs :: Effect Int +freshRefs = do + a <- Ref.read r1 + b <- Ref.read r2 + if a == 1 && b == 2 then pure 42 else pure 0 + where + r1 :: Ref Int + r1 = unsafePerformEffect (do + r <- Ref.new 0 + _ <- Ref.write 1 r + pure r) + r2 :: Ref Int + r2 = unsafePerformEffect (do + r <- Ref.new 0 + _ <- Ref.write 2 r + pure r) + +main :: Int +main = + let viaST = ST.run storage + viaSTAgain = ST.run storage + viaEffect = unsafePerformEffect effectProgram + viaGlobal = unsafePerformEffect (toEffect storage) + viaFresh = unsafePerformEffect freshRefs + in if viaST == 42 && viaSTAgain == 42 && viaEffect == 42 && viaGlobal == 42 && viaFresh == 42 + then 42 + else 0 +"#; diff --git a/crates/psrs-driver/src/tests/native_representation/uncurried.rs b/crates/psrs-driver/src/tests/native_representation/uncurried.rs new file mode 100644 index 00000000..4d8c9c8c --- /dev/null +++ b/crates/psrs-driver/src/tests/native_representation/uncurried.rs @@ -0,0 +1,123 @@ +fn factory_source(st: bool, arity: usize) -> String { + let parameters = (1..=arity).map(|n| format!("x{n}")).collect::>(); + let signature = format!( + "{} -> {}", + vec!["Int"; arity].join(" -> "), + if st { "ST.ST r Int" } else { "Effect Int" } + ); + let arguments = std::iter::once("argument".to_owned()) + .chain((2..=arity).map(|n| n.to_string())) + .collect::>() + .join(" "); + let (imports, prefix, quantify, eliminate) = if st { + ( + "import Control.Monad.ST as ST\nimport Control.Monad.ST.Uncurried as U", + "STFn", + "forall r. ", + "ST.run", + ) + } else { + ( + "import Effect (Effect)\nimport Effect.Uncurried as U", + "EffectFn", + "", + "unsafePerformEffect", + ) + }; + let action_type = if st { + "forall r. ST.ST r Int" + } else { + "Effect Int" + }; + format!( + r#"module Main where +import Prelude +import Effect.Unsafe (unsafePerformEffect) +import Effect.Console (log) +{imports} + +callback :: {quantify}{signature} +callback {} = let _ = unsafePerformEffect (log "factory") in pure ({}) + +main :: Int +main = + let argument = let _ = unsafePerformEffect (log "argument") in 1 + action :: {action_type} + action = U.run{prefix}{arity} (U.mk{prefix}{arity} callback) {arguments} + _ = unsafePerformEffect (log "stored") + first = {eliminate} action + second = {eliminate} action + in if first == {} && second == {} then 42 else 0 +"#, + parameters.join(" "), + parameters + .iter() + .enumerate() + .map(|(index, name)| format!("{name} * {}", index + 1)) + .collect::>() + .join(" + "), + arity * (arity + 1) * (2 * arity + 1) / 6, + arity * (arity + 1) * (2 * arity + 1) / 6, + ) +} + +fn factories_are_delayed(st: bool) { + for arity in 1..=10 { + let source = factory_source(st, arity); + let Some(output) = + super::super::run_program_with_prelude_wasmtime(&[("Main.purs", &source)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "arity {arity}: {output:?}"); + assert_eq!( + output.stdout, b"argument\nstored\nfactory\nfactory\n", + "arity {arity}: {output:?}" + ); + assert!(output.stderr.is_empty(), "arity {arity}: {output:?}"); + } +} + +#[test] +fn st_uncurried_factories_wait_for_execution_at_every_arity() { + factories_are_delayed(true); +} + +#[test] +fn effect_uncurried_factories_wait_for_execution_at_every_arity() { + factories_are_delayed(false); +} + +#[test] +fn effect_uncurried_transports_mixed_values_and_preserves_pure_instances() { + let source = r#"module Main where +import Prelude +import Effect.Uncurried as U +import Effect.Unsafe (unsafePerformEffect) +import Effect.Console (log) + +record :: U.EffectFn2 String (Int -> Int) { label :: String, answer :: Int } +record = U.mkEffectFn2 \label f -> pure { label, answer: f 41 } + +left :: U.EffectFn1 Int String +left = U.mkEffectFn1 \_ -> log "left" *> pure "L" + +right :: U.EffectFn1 Int String +right = U.mkEffectFn1 \_ -> log "right" *> pure "R" + +main :: Int +main = unsafePerformEffect do + value <- U.runEffectFn2 record "mixed" (_ + 1) + joined <- U.runEffectFn1 (left <> right) 0 + empty <- U.runEffectFn1 (mempty :: U.EffectFn1 Int String) 0 + if value.label == "mixed" && value.answer == 42 && joined == "LR" && empty == "" + then pure 42 else pure 0 +"#; + let Some(output) = super::super::run_program_with_prelude_wasmtime(&[("Main.purs", source)]) + else { + return; + }; + assert_eq!(output.status.code(), Some(42), "{output:?}"); + assert_eq!(output.stdout, b"left\nright\n", "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); +} diff --git a/crates/psrs-driver/src/tests/pattern_matching_audit.rs b/crates/psrs-driver/src/tests/pattern_matching_audit.rs index 560e5b31..09e8074d 100644 --- a/crates/psrs-driver/src/tests/pattern_matching_audit.rs +++ b/crates/psrs-driver/src/tests/pattern_matching_audit.rs @@ -47,7 +47,7 @@ fn flatten_cc(assignments: &[psrs_backend::cc::Assignment]) -> Vec<&psrs_backend /// re-evaluated it per alternative would print the side effect twice. #[test] fn case_evaluates_its_scrutinee_exactly_once() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\ndata I = A | B\nmain = case { tag: A, payload: runEffect (log \"once\") } of\n { tag: A, payload: _ } -> 0\n { tag: B, payload: _ } -> 1\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\ndata I = A | B\nmain = case { tag: A, payload: unsafePerformEffect (log \"once\") } of\n { tag: A, payload: _ } -> 0\n { tag: B, payload: _ } -> 1\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; diff --git a/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs b/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs index 51128a3a..ac199a37 100644 --- a/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs +++ b/crates/psrs-driver/src/tests/polymorphism_erasure_audit.rs @@ -121,7 +121,7 @@ fn erased_boolean_box_preserves_both_values() { #[test] fn erased_string_box_preserves_nonempty_contents() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\ncopy :: forall a. Array a -> Array a\ncopy values = values\nmain = let ignored = runEffect (log (arrayIndex (copy [\"high\", \"value\"]) 1)) in 0\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\ncopy :: forall a. Array a -> Array a\ncopy values = values\nmain = let ignored = unsafePerformEffect (log (arrayIndex (copy [\"high\", \"value\"]) 1)) in 0\n"; let artifact = compile_source("Main.purs", source).expect("string round trip should compile"); match execute_component("erased_string_contents", &artifact.wasm) { Ok(Some(output)) => { @@ -151,7 +151,7 @@ fn erased_number_box_preserves_nan_and_signed_zero() { fn erased_identity_boxes_char_and_unit() { let char_source = "module Main where\nidentity :: forall a. a -> a\nidentity value = value\nmain = charToInt (identity 'B')\n"; expect_exit("erased_char", char_source, 66); - let unit_source = "module Main where\nimport Prelude\nimport WASI.Console\nidentity :: forall a. a -> a\nidentity value = value\nmain = let ignored = identity (runEffect (log \"\")) in 42\n"; + let unit_source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nidentity :: forall a. a -> a\nidentity value = value\nmain = let ignored = identity (unsafePerformEffect (log \"\")) in 42\n"; expect_exit("erased_unit", unit_source, 42); } @@ -215,7 +215,7 @@ fn escaping_closures_capture_int_and_reference_values() { #[test] fn escaping_closures_capture_a_string_value() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmakeReader :: String -> (Int -> String)\nmakeReader message = \\index -> if index == 0 then message else message\nmain = let reader = makeReader \"captured\" in let ignored = runEffect (log (reader 0)) in 42\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmakeReader :: String -> (Int -> String)\nmakeReader message = \\index -> if index == 0 then message else message\nmain = let reader = makeReader \"captured\" in let ignored = unsafePerformEffect (log (reader 0)) in 42\n"; let artifact = compile_source("Main.purs", source).expect("string capture should compile"); match execute_component("escaping_string_capture", &artifact.wasm) { Ok(Some(output)) => { @@ -243,7 +243,7 @@ fn a_curried_function_argument_generates_a_partial_adapter() { // `\x -> \y -> f x y` where `map` expects a generic `a -> b`. The erased // adapter must partially apply it: the outer closure takes the target's // arguments and returns an inner closure for the source's remaining ones. - let source = "module Main where\nimport Prelude\nmain = runEffect (ado\n x <- pure 40\n y <- pure 2\n in x + y)\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nmain = unsafePerformEffect (ado\n x <- pure 40\n y <- pure 2\n in x + y)\n"; let mir = pre_optimization_mir(source); let names = mir .functions @@ -297,7 +297,7 @@ fn an_explicitly_polymorphic_local_binding_instantiates_at_int() { #[test] fn an_explicitly_polymorphic_local_binding_instantiates_at_two_types() { // The same erased local value is recovered at `String` and at `Int`. - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let id = (\\x -> x) :: forall a. a -> a in runEffect (do\n log (id \"hello\")\n pure (id 42))\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let id = (\\x -> x) :: forall a. a -> a in unsafePerformEffect (do\n log (id \"hello\")\n pure (id 42))\n"; let artifact = compile_source("Main.purs", source).expect("the two-type local use should compile"); match execute_component("local_polymorphic_two_types", &artifact.wasm) { diff --git a/crates/psrs-driver/src/tests/records.rs b/crates/psrs-driver/src/tests/records.rs index b1594b44..4fd72b42 100644 --- a/crates/psrs-driver/src/tests/records.rs +++ b/crates/psrs-driver/src/tests/records.rs @@ -124,7 +124,7 @@ fn anonymous_record_accessor_projects_nested_fields() { #[test] fn evaluates_record_fields_in_source_order_before_canonical_layout() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let record = { z: runEffect (log \"z\"), a: runEffect (log \"a\") } in 0\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let record = { z: unsafePerformEffect (log \"z\"), a: unsafePerformEffect (log \"a\") } in 0\n"; let core = lower_source_to_core("Main.purs", source).expect("source should lower to Core"); let main = core .declarations diff --git a/crates/psrs-driver/src/tests/semigroup.rs b/crates/psrs-driver/src/tests/semigroup.rs index 57ca5b8c..b1e83acd 100644 --- a/crates/psrs-driver/src/tests/semigroup.rs +++ b/crates/psrs-driver/src/tests/semigroup.rs @@ -38,6 +38,8 @@ fn the_semigroup_operator_concatenates_strings_and_arrays() { // instance keeps the one UTF-8 representation. let source = r#" module Main where +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) import Prelude import Effect.Console (log) @@ -59,7 +61,7 @@ checks = do log (if arrayIndex numbers 4 == 5 then "element-ok" else "element-wrong") pure unit -main = let ignored = runEffect checks in 0 +main = let ignored = unsafePerformEffect checks in 0 "#; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); diff --git a/crates/psrs-driver/src/tests/show.rs b/crates/psrs-driver/src/tests/show.rs index e024b171..7865b171 100644 --- a/crates/psrs-driver/src/tests/show.rs +++ b/crates/psrs-driver/src/tests/show.rs @@ -11,6 +11,8 @@ use super::*; fn show_renders_the_instances_the_corpus_prints() { let source = r#" module Main where +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) import Prelude import Effect.Console (log) @@ -45,7 +47,7 @@ checks = do log (show "cafés") pure unit -main = let ignored = runEffect checks in 0 +main = let ignored = unsafePerformEffect checks in 0 "#; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); @@ -140,6 +142,8 @@ main = let ignored = log (show 1.0e21) in 0 fn show_covers_number_and_aggregate_boundaries() { let source = r#" module Main where +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) import Prelude import Effect.Console (log) @@ -158,7 +162,7 @@ checks = do log (show [[1, 2], [3]]) pure unit -main = let ignored = runEffect checks in 0 +main = let ignored = unsafePerformEffect checks in 0 "#; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); @@ -198,7 +202,7 @@ fn formats_many_numbers_without_exhausting_the_runtime_stack() { elements.push_str(&format!("{index}.5")); } let source = format!( - "module Main where\n\nimport Prelude\nimport Effect.Console (log)\n\nmain = let ignored = runEffect (log (show [{elements}])) in 0\n" + "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\nimport Prelude\nimport Effect.Console (log)\n\nmain = let ignored = unsafePerformEffect (log (show [{elements}])) in 0\n" ); let Some(output) = run_with_wasmtime(&source) else { eprintln!("skipping: wasmtime is not installed"); @@ -239,14 +243,16 @@ fn retained_show_strings_survive_wasi_allocation_and_memory_growth() { // The formatter's initial heap has one page. A 70,000-byte canonical // random result must grow shared memory while the GC String stays live. let source = r#"module Main where +import Effect (Effect) +import Effect.Unsafe (unsafePerformEffect) import Prelude import Effect.Console (log) import WASI.Random (randomBytes) main = let retained = show 1.0e21 - first = runEffect (log retained) - large = runEffect (randomBytes 70000) - next = runEffect (log (show 5.0e-324)) - last = runEffect (log retained) + first = unsafePerformEffect (log retained) + large = unsafePerformEffect (randomBytes 70000) + next = unsafePerformEffect (log (show 5.0e-324)) + last = unsafePerformEffect (log retained) in if arrayLength large == 70000 && retained == "1e+21" then 42 else 1 "#; let output = run_with_wasmtime(source).expect("Wasmtime required for growth evidence"); diff --git a/crates/psrs-driver/src/tests/typecheck/mod.rs b/crates/psrs-driver/src/tests/typecheck/mod.rs index c13b1f92..b7c2f363 100644 --- a/crates/psrs-driver/src/tests/typecheck/mod.rs +++ b/crates/psrs-driver/src/tests/typecheck/mod.rs @@ -299,12 +299,14 @@ fn a_lenient_type_check_type_checks_a_module_whose_sibling_is_missing() { #[test] fn a_lenient_type_check_attributes_a_diagnostic_to_the_user_source_not_the_library() { - let source = "module Main where\nimport Prelude\nmain = runEffect (pure missingName)\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nmain = unsafePerformEffect (pure missingName)\n"; let errors = check_program_types_lenient_with_prelude(&[("Main.purs", source)]).unwrap_err(); assert!( errors.iter().any(|error| { error.source == DiagnosticOrigin::Source(0) && error.diagnostic.code == Some("UnknownName") + && &source[error.diagnostic.span.start as usize..error.diagnostic.span.end as usize] + == "missingName" }), "the trusted prefix must not shift a user's diagnostic: {errors:?}" ); diff --git a/crates/psrs-driver/src/tests/wasi/do_notation.rs b/crates/psrs-driver/src/tests/wasi/do_notation.rs index 4cfae754..9347889f 100644 --- a/crates/psrs-driver/src/tests/wasi/do_notation.rs +++ b/crates/psrs-driver/src/tests/wasi/do_notation.rs @@ -3,13 +3,14 @@ use super::*; #[test] fn runs_a_do_notation_effect_sequence_when_wasmtime_is_available() { // `do` desugars to `bind`/`discard`/`let`. The block runs the two writes - // left to right, binds a value for the final `pure`, and `runEffect` yields + // left to right, binds a value for the final `pure`, and `unsafePerformEffect` yields // the entry's exit code. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import WASI.Console -main = runEffect +main = unsafePerformEffect do log "first" let label = "second" diff --git a/crates/psrs-driver/src/tests/wasi/filesystem.rs b/crates/psrs-driver/src/tests/wasi/filesystem.rs index d0affd76..19da008f 100644 --- a/crates/psrs-driver/src/tests/wasi/filesystem.rs +++ b/crates/psrs-driver/src/tests/wasi/filesystem.rs @@ -3,27 +3,28 @@ use super::*; #[test] fn writes_and_reads_a_file_through_preopens_when_wasmtime_is_available() { let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import WASI.Console (log) import WASI.FileSystem main = - let dirs = runEffect preopens in + let dirs = unsafePerformEffect preopens in let dir = arrayIndex dirs 0 in - let created = runEffect (openWrite (dir._1) "roundtrip.txt") in + let created = unsafePerformEffect (openWrite (dir._1) "roundtrip.txt") in case created of Left _ -> 1 Right file -> - let wrote = runEffect (writeString file "roundtrip") in - let closed = runEffect (dropDescriptor file) in - let reopened = runEffect (openRead (dir._1) "roundtrip.txt") in + let wrote = unsafePerformEffect (writeString file "roundtrip") in + let closed = unsafePerformEffect (dropDescriptor file) in + let reopened = unsafePerformEffect (openRead (dir._1) "roundtrip.txt") in case reopened of Left _ -> 2 Right reader -> - let contents = runEffect (withDescriptor reader (\openReader -> readString openReader 64)) in + let contents = unsafePerformEffect (withDescriptor reader (\openReader -> readString openReader 64)) in case contents of Left _ -> 3 - Right text -> let ignored = runEffect (log text) in 0 + Right text -> let ignored = unsafePerformEffect (log text) in 0 "#; let directory = std::env::temp_dir().join(format!( "psrs-fs-{}-{}", @@ -53,14 +54,15 @@ fn reports_a_unit_success_result_as_left_when_wasmtime_is_available() { // error on `Left`, so a failing unit-success operation reports `Left` // instead of trapping. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import WASI.FileSystem main :: Int main = - let dirs = runEffect preopens in + let dirs = unsafePerformEffect preopens in let dir = arrayIndex dirs 0 in - case runEffect (removeDirectoryAt (dir._1) "missing-directory") of + case unsafePerformEffect (removeDirectoryAt (dir._1) "missing-directory") of Right _ -> 1 Left _ -> 0 "#; @@ -94,6 +96,7 @@ fn stats_and_reads_a_directory_through_preopens_when_wasmtime_is_available() { // `option` fields, and `read-directory-entry` returns // `option`, both stored erased inside their `Either`. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) @@ -101,35 +104,35 @@ import WASI.Console (log) import WASI.FileSystem main :: Int main = - let dirs = runEffect preopens in + let dirs = unsafePerformEffect preopens in let dir = arrayIndex dirs 0 in let d = dir._1 in - let created = runEffect (openWrite d "probe.txt") in + let created = unsafePerformEffect (openWrite d "probe.txt") in case created of Left _ -> 1 Right file -> - let wrote = runEffect (writeString file "probe") in - let closed = runEffect (dropDescriptor file) in - let stats = runEffect (stat d) in + let wrote = unsafePerformEffect (writeString file "probe") in + let closed = unsafePerformEffect (dropDescriptor file) in + let stats = unsafePerformEffect (stat d) in case stats of Left _ -> 2 Right s -> case s.type of Directory -> - let fileStats = runEffect (statAt d { symlinkFollow: true } "probe.txt") in + let fileStats = unsafePerformEffect (statAt d { symlinkFollow: true } "probe.txt") in case fileStats of Left _ -> 3 Right f -> case f.type of RegularFile -> - let entries = runEffect (readDirectory d) in + let entries = unsafePerformEffect (readDirectory d) in case entries of Left _ -> 4 Right stream -> - let entry = runEffect (readDirectoryEntry stream) in - let dropped = runEffect (dropDirectoryEntryStream stream) in + let entry = unsafePerformEffect (readDirectoryEntry stream) in + let dropped = unsafePerformEffect (dropDirectoryEntryStream stream) in case entry of Left _ -> 5 Right Nothing -> 6 - Right (Just _) -> let ignored = runEffect (log "stat-ok") in 0 + Right (Just _) -> let ignored = unsafePerformEffect (log "stat-ok") in 0 _ -> 7 _ -> 8 "#; diff --git a/crates/psrs-driver/src/tests/wasi/mod.rs b/crates/psrs-driver/src/tests/wasi/mod.rs index ca067969..e1d4a21e 100644 --- a/crates/psrs-driver/src/tests/wasi/mod.rs +++ b/crates/psrs-driver/src/tests/wasi/mod.rs @@ -3,9 +3,7 @@ use super::*; mod do_notation; mod filesystem; mod payloads; -mod wat; mod where_clause; -use wat::*; mod classes; mod coercion; @@ -15,7 +13,7 @@ mod wrappers; #[test] fn lowers_string_log_to_wasi_stdout() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let ignored = runEffect (log \"hello world\") in 0\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let ignored = unsafePerformEffect (log \"hello world\") in 0\n"; let artifact = compile_source("Main.purs", source).unwrap(); assert!(artifact.wat.contains("wasi:cli/stdout@0.2.12")); assert!(artifact.wat.contains("wasi:io/streams@0.2.12")); @@ -66,7 +64,7 @@ fn runs_main_as_a_wasi_component_when_wasmtime_is_available() { #[test] fn prints_hello_world_when_wasmtime_is_available() { let Some(output) = run_with_wasmtime( - "module Main where\nimport Prelude\nimport WASI.Console\nmain = let ignored = runEffect (log \"hello world\") in 0\n", + "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let ignored = unsafePerformEffect (log \"hello world\") in 0\n", ) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -79,7 +77,7 @@ fn prints_hello_world_when_wasmtime_is_available() { fn prints_a_non_ascii_literal_when_wasmtime_is_available() { // `h`, `é` (U+00E9), `λ` (U+03BB): the GC UTF-16 string must be encoded as // UTF-8 at the canonical ABI boundary, not truncated to bytes. - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let ignored = runEffect (log \"h\u{e9}\u{3bb}\") in 0\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let ignored = unsafePerformEffect (log \"h\u{e9}\u{3bb}\") in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -90,7 +88,7 @@ fn prints_a_non_ascii_literal_when_wasmtime_is_available() { #[test] fn prints_an_interned_literal_once_per_use_when_wasmtime_is_available() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let first = runEffect (log \"twice\") in let second = runEffect (log \"twice\") in 0\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let first = unsafePerformEffect (log \"twice\") in let second = unsafePerformEffect (log \"twice\") in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -101,7 +99,7 @@ fn prints_an_interned_literal_once_per_use_when_wasmtime_is_available() { #[test] fn prints_an_empty_literal_when_wasmtime_is_available() { - let source = "module Main where\nimport Prelude\nimport WASI.Console\nmain = let ignored = runEffect (log \"\") in 0\n"; + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let ignored = unsafePerformEffect (log \"\") in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -113,7 +111,7 @@ fn prints_an_empty_literal_when_wasmtime_is_available() { #[test] fn reads_the_monotonic_clock_when_wasmtime_is_available() { let Some(output) = run_with_wasmtime( - "module Main where\nimport Prelude\nimport WASI.Clock\nmain = (runEffect now) * 0\n", + "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Clock\nmain = (unsafePerformEffect now) * 0\n", ) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -124,7 +122,7 @@ fn reads_the_monotonic_clock_when_wasmtime_is_available() { #[test] fn writes_to_stderr_when_wasmtime_is_available() { let Some(output) = run_with_wasmtime( - "module Main where\nimport Prelude\nimport WASI.Console\nmain = let x = runEffect (error \"oops\") in 7\n", + "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Console\nmain = let x = unsafePerformEffect (error \"oops\") in 7\n", ) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -187,10 +185,10 @@ fn lowers_a_list_of_strings_to_an_array() { #[test] fn lowers_the_environment_arguments_wrapper_to_an_array() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Process\n\ - main = arrayLength (runEffect arguments)\n"; + main = arrayLength (unsafePerformEffect arguments)\n"; let artifact = compile_source("Main.purs", source) .expect("WASI.Process.arguments should lower to an array"); assert!(artifact.wat.contains("wasi:cli/environment@0.2.12")); @@ -218,10 +216,10 @@ fn reads_environment_arguments_when_wasmtime_is_available() { // `get-arguments` returns the canonical list; the wrapper recovers // it into a GC `Array String`. The host supplies argv, whose first element // is the module path under Wasmtime. - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Process\n\ - main = arrayLength (runEffect arguments)\n"; + main = arrayLength (unsafePerformEffect arguments)\n"; let Some(output) = run_with_wasmtime_args(source, &["alpha", "beta"]) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -290,11 +288,11 @@ fn rejects_a_wasi_interface_outside_the_component_capability_profile() { #[test] fn reads_random_bytes_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Console\n\ import WASI.Random\n\ - main = let noise = runEffect randomU64 in let bytes = runEffect (randomBytes 8) in let length = arrayLength bytes in noise * length * 0\n"; + main = let noise = unsafePerformEffect randomU64 in let bytes = unsafePerformEffect (randomBytes 8) in let length = arrayLength bytes in noise * length * 0\n"; let artifact = compile_source("Main.purs", source).expect("library randomBytes should lower"); assert!(artifact.wat.contains("wasi:random/random@0.2.12")); assert!(artifact.wat.contains("get-random-bytes")); @@ -309,63 +307,41 @@ fn reads_random_bytes_when_wasmtime_is_available() { assert!(output.stdout.is_empty(), "{output:?}"); } -/// `get-random-bytes` is not a direct call from the command entry in either -/// program: the import sits in the effect closure, and `runEffect` reaches it -/// with `call_ref`. A stored action must not `call_ref` from the entry. +/// Native construction is inert; interpreting a reusable action executes its +/// host request and continuation on each run, preserving the returned list. #[test] -fn stored_random_bytes_leaves_get_random_bytes_inside_the_effect_closure() { - let stored = "module Main where\n\ - import WASI.Random\n\ - main = let action = randomBytes 8 in 0\n"; - let forced = "module Main where\n\ - import Prelude\n\ - import WASI.Random\n\ - main = let value = runEffect (randomBytes 8) in 0\n"; - let stored_wat = compile_source("Main.purs", stored) - .expect("a stored randomBytes action should compile") - .wat; - let forced_wat = compile_source("Main.purs", forced) - .expect("runEffect (randomBytes 8) should compile") - .wat; - - let stored_core = core_main(&stored_wat); - let forced_core = core_main(&forced_wat); - let stored_import = imported_func(stored_core, "wasi:random/random@0.2.12", "get-random-bytes"); - let forced_import = imported_func(forced_core, "wasi:random/random@0.2.12", "get-random-bytes"); - let stored_entry = exported_func(stored_core, "wasi:cli/run@0.2.12#run"); - let forced_entry = exported_func(forced_core, "wasi:cli/run@0.2.12#run"); - let stored_funcs = core_functions(stored_core); - let forced_funcs = core_functions(forced_core); - - let stored_from_entry = reachable_by_call(&stored_funcs, stored_entry); - assert!( - !calls_import(&stored_funcs, &stored_from_entry, stored_import), - "the command entry must not call get-random-bytes when the action is not run" - ); - assert!( - !has_call_ref(&stored_funcs, &stored_from_entry), - "storing the action must not run the effect" - ); - assert!( - import_is_reached_only_from_a_closure(&stored_funcs, stored_entry, stored_import), - "get-random-bytes must be inside the effect closure" - ); - - let forced_from_entry = reachable_by_call(&forced_funcs, forced_entry); - assert!( - has_call_ref(&forced_funcs, &forced_from_entry), - "runEffect must invoke the closure from the command entry" - ); - assert!( - import_is_reached_only_from_a_closure(&forced_funcs, forced_entry, forced_import), - "runEffect still calls get-random-bytes from the closure, not the entry" - ); - - let Some(output) = run_with_wasmtime(stored) else { - eprintln!("skipping: wasmtime is not installed"); - return; - }; - assert_eq!(output.status.code(), Some(0), "{output:?}"); +fn stored_random_bytes_is_inert_and_repeated_runs_execute_the_continuation() { + let program = r#"module Main where +import Prelude +import Effect.Unsafe (unsafePerformEffect) +import WASI.Console (log) +import WASI.Random (randomBytes) + +action = do + bytes <- randomBytes 8 + log "bytes" + pure (arrayLength bytes) + +"#; + for (entry, expected_exit, expected_stdout) in [ + ("main = let stored = action in 0", 0, ""), + ( + "main = let first = unsafePerformEffect action in let second = unsafePerformEffect action in first + second", + 16, + "bytes\nbytes\n", + ), + ] { + let source = format!("{program}{entry}\n"); + let artifact = compile_source("Main.purs", &source).expect("random action should compile"); + assert!(artifact.wat.contains("get-random-bytes")); + let Some(output) = run_with_wasmtime(&source) else { + eprintln!("skipping: wasmtime is not installed"); + return; + }; + assert_eq!(output.status.code(), Some(expected_exit), "{output:?}"); + assert_eq!(output.stdout, expected_stdout.as_bytes(), "{output:?}"); + assert!(output.stderr.is_empty(), "{output:?}"); + } } #[test] @@ -387,10 +363,10 @@ fn rejects_an_import_of_unexported_write_stdout() { fn passes_a_byte_array_to_another_import() { // A WIT `list` is `Array Int`, so a byte array crosses the boundary as // uninterpreted integers rather than as text (DEC-16). - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.IO (getStdout, blockingWriteAndFlush)\n\ - main = let ignored = runEffect (bind getStdout (\\handle -> bind (blockingWriteAndFlush handle [104, 105]) (\\result -> pure 0))) in 0\n"; + main = let ignored = unsafePerformEffect (bind getStdout (\\handle -> bind (blockingWriteAndFlush handle [104, 105]) (\\result -> pure 0))) in 0\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -428,22 +404,14 @@ fn rejects_an_import_of_unexported_exit_with_code_raw() { ); } -/// Source and command entry share one checked exit import. Stored actions do -/// not invoke their closure; forced actions exit with their own observable code. +/// Storing a native exit request permits normal completion; interpreting it +/// exits with the requested code before the following log can execute. #[test] -fn stored_exit_with_code_leaves_exit_with_code_inside_the_effect_closure() { +fn stored_exit_is_inert_and_interpreted_exit_stops_the_program() { let stored = "module Main where\nimport WASI.Process\nmain = let action = exitWithCode 99 in 0\n"; - let forced = "module Main where\nimport Prelude\nimport WASI.Process\nmain = let value = runEffect (exitWithCode 99) in 0\n"; - for (source, invokes_action, expected_exit) in [(stored, false, 0), (forced, true, 99)] { - let artifact = compile_source("Main.purs", source).expect("exit action should compile"); - let core = core_main(&artifact.wat); - let entry = exported_func(core, "wasi:cli/run@0.2.12#run"); - let functions = core_functions(core); - let reachable = reachable_by_call(&functions, entry); - assert_eq!(has_call_ref(&functions, &reachable), invokes_action); - // Source and synthesized command exit share one checked import. Values - // distinguish forcing the stored action from normal command completion. + let forced = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\nimport Prelude\nimport WASI.Process\nimport WASI.Console (log)\nmain = let value = unsafePerformEffect (exitWithCode 99) in let after = unsafePerformEffect (log \"after exit\") in 0\n"; + for (source, expected_exit) in [(stored, 0), (forced, 99)] { let output = run_with_wasmtime(source).expect("Wasmtime required for exit sequencing"); assert_eq!(output.status.code(), Some(expected_exit), "{output:?}"); assert!(output.stdout.is_empty()); diff --git a/crates/psrs-driver/src/tests/wasi/payloads.rs b/crates/psrs-driver/src/tests/wasi/payloads.rs index 046753ec..125c803b 100644 --- a/crates/psrs-driver/src/tests/wasi/payloads.rs +++ b/crates/psrs-driver/src/tests/wasi/payloads.rs @@ -3,16 +3,17 @@ use super::*; #[test] fn wit_result_bytes_recover_values_and_empty_arrays_when_wasmtime_is_available() { let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import WASI.IO (getStdin, blockingRead) main = - let stream = runEffect getStdin in - let empty = runEffect (blockingRead stream 0) in + let stream = unsafePerformEffect getStdin in + let empty = unsafePerformEffect (blockingRead stream 0) in case empty of Left _ -> 1 Right zero -> - let result = runEffect (blockingRead stream 4) in + let result = unsafePerformEffect (blockingRead stream 4) in case result of Left _ -> 2 Right bytes -> diff --git a/crates/psrs-driver/src/tests/wasi/umbrella.rs b/crates/psrs-driver/src/tests/wasi/umbrella.rs index c1901981..841b0a2f 100644 --- a/crates/psrs-driver/src/tests/wasi/umbrella.rs +++ b/crates/psrs-driver/src/tests/wasi/umbrella.rs @@ -4,10 +4,10 @@ use super::*; fn imports_the_wasi_umbrella_for_the_common_case() { // A program can `import WASI` and use the curated console, clock, and // random API without naming a focused module. - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI\n\ - main = let ignored = runEffect (log \"umbrella\") in (runEffect now) * 0\n"; + main = let ignored = unsafePerformEffect (log \"umbrella\") in (unsafePerformEffect now) * 0\n"; let artifact = compile_source("Main.purs", source).expect("the umbrella should compile"); assert!(artifact.wat.contains("wasi:cli/stdout@0.2.12")); let Some(output) = run_with_wasmtime(source) else { @@ -22,10 +22,10 @@ fn imports_the_wasi_umbrella_for_the_common_case() { fn polls_a_resource_list_through_the_umbrella_when_wasmtime_is_available() { // `poll :: Array (Resource Pollable) -> Effect (Array Int)`: a resource // newtype as a non-byte list element must intern and lower. - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI\n\ - main = let waiter = runEffect (subscribeDuration 0) in arrayLength (runEffect (poll [waiter])) * 0\n"; + main = let waiter = unsafePerformEffect (subscribeDuration 0) in arrayLength (unsafePerformEffect (poll [waiter])) * 0\n"; let artifact = compile_source("Main.purs", source).expect("a Resource list element should lower"); assert!(artifact.wat.contains("wasi:io/poll@0.2.12")); diff --git a/crates/psrs-driver/src/tests/wasi/wat.rs b/crates/psrs-driver/src/tests/wasi/wat.rs deleted file mode 100644 index 766df179..00000000 --- a/crates/psrs-driver/src/tests/wasi/wat.rs +++ /dev/null @@ -1,190 +0,0 @@ -pub(super) fn core_main(wat: &str) -> &str { - let start = wat - .find("(core module $main") - .expect("the component should contain the core module"); - let rest = &wat[start..]; - let mut depth = 0; - for (index, character) in rest.char_indices() { - match character { - '(' => depth += 1, - ')' => { - depth -= 1; - if depth == 0 { - return &rest[..=index]; - } - } - _ => {} - } - } - panic!("the core module is unclosed"); -} - -pub(super) struct CoreFunc { - index: u32, - body: String, -} - -pub(super) fn core_functions(core: &str) -> Vec { - let bytes = core.as_bytes(); - let mut functions = Vec::new(); - let mut depth = 0; - let mut index = 0; - while index < bytes.len() { - if depth == 1 && core[index..].starts_with("(func (;") { - let number_start = index + "(func (;".len(); - let number_end = core[number_start..] - .find(";)") - .expect("a core func should carry an index") - + number_start; - let func_index = core[number_start..number_end] - .parse() - .expect("a core func index should be a decimal"); - let mut inner = 0; - let mut end = index; - let mut cursor = index; - while cursor < bytes.len() { - match bytes[cursor] { - b'(' => inner += 1, - b')' => { - inner -= 1; - if inner == 0 { - end = cursor + 1; - break; - } - } - _ => {} - } - cursor += 1; - } - functions.push(CoreFunc { - index: func_index, - body: core[index..end].to_string(), - }); - index = end; - continue; - } - match bytes[index] { - b'(' => depth += 1, - b')' => depth -= 1, - _ => {} - } - index += 1; - } - functions -} - -pub(super) fn imported_func(core: &str, module: &str, name: &str) -> u32 { - let needle = format!(r#"(import "{module}" "{name}" (func (;"#); - let at = core - .find(&needle) - .unwrap_or_else(|| panic!("missing import {module}#{name}")); - let after = &core[at + needle.len()..]; - let end = after.find(";)").expect("an import func index"); - after[..end] - .parse() - .expect("an import func index should be a decimal") -} - -pub(super) fn exported_func(core: &str, name: &str) -> u32 { - let needle = format!(r#"(export "{name}" (func "#); - let at = core - .find(&needle) - .unwrap_or_else(|| panic!("missing export {name}")); - let after = &core[at + needle.len()..]; - let end = after.find(')').expect("an export func index"); - after[..end] - .trim() - .parse() - .expect("an export func index should be a decimal") -} - -fn direct_calls(body: &str) -> Vec { - let mut calls = Vec::new(); - let mut rest = body; - while let Some(at) = rest.find("call ") { - let boundary = at == 0 || !rest.as_bytes()[at - 1].is_ascii_alphanumeric(); - let after = &rest[at + "call ".len()..]; - let digits = after - .chars() - .take_while(|character| character.is_ascii_digit()) - .collect::(); - if boundary && !digits.is_empty() { - calls.push(digits.parse().expect("call operand")); - } - rest = &rest[at + "call ".len()..]; - } - calls -} - -fn ref_func_targets(body: &str) -> Vec { - let mut targets = Vec::new(); - let mut rest = body; - while let Some(at) = rest.find("ref.func ") { - let after = &rest[at + "ref.func ".len()..]; - let digits = after - .chars() - .take_while(|character| character.is_ascii_digit()) - .collect::(); - if !digits.is_empty() { - targets.push(digits.parse().expect("ref.func operand")); - } - rest = &rest[at + "ref.func ".len()..]; - } - targets -} - -pub(super) fn reachable_by_call( - functions: &[CoreFunc], - entry: u32, -) -> std::collections::HashSet { - let mut seen = std::collections::HashSet::new(); - let mut stack = vec![entry]; - while let Some(current) = stack.pop() { - if !seen.insert(current) { - continue; - } - let Some(function) = functions.iter().find(|function| function.index == current) else { - continue; - }; - stack.extend(direct_calls(&function.body)); - } - seen -} - -pub(super) fn calls_import( - functions: &[CoreFunc], - reached: &std::collections::HashSet, - import: u32, -) -> bool { - functions.iter().any(|function| { - reached.contains(&function.index) && direct_calls(&function.body).contains(&import) - }) -} - -pub(super) fn has_call_ref( - functions: &[CoreFunc], - reached: &std::collections::HashSet, -) -> bool { - functions - .iter() - .any(|function| reached.contains(&function.index) && function.body.contains("call_ref ")) -} - -/// The import call is not in the command entry's direct-call tree. It is in a -/// function reached from `ref.func`, which is the effect closure. -pub(super) fn import_is_reached_only_from_a_closure( - functions: &[CoreFunc], - entry: u32, - import: u32, -) -> bool { - if calls_import(functions, &reachable_by_call(functions, entry), import) { - return false; - } - let mut from_closures = std::collections::HashSet::new(); - for function in functions { - for target in ref_func_targets(&function.body) { - from_closures.extend(reachable_by_call(functions, target)); - } - } - calls_import(functions, &from_closures, import) -} diff --git a/crates/psrs-driver/src/tests/wasi/where_clause.rs b/crates/psrs-driver/src/tests/wasi/where_clause.rs index 6fec155d..7de2ff69 100644 --- a/crates/psrs-driver/src/tests/wasi/where_clause.rs +++ b/crates/psrs-driver/src/tests/wasi/where_clause.rs @@ -7,6 +7,7 @@ fn runs_a_program_with_where_clauses_when_wasmtime_is_available() { // The effect block logs and then returns `describe 39 + fromJust (Just 0) 0 // = 42` as the entry's exit code. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import WASI.Console @@ -23,7 +24,7 @@ fromJust m fallback = case m of result = value + 1 Nothing -> fallback -main = runEffect +main = unsafePerformEffect do log "where clauses" pure (describe 39 + fromJust (Just 0) 0) diff --git a/crates/psrs-driver/src/tests/wasi/wrappers.rs b/crates/psrs-driver/src/tests/wasi/wrappers.rs index 5e60a5d8..460143c7 100644 --- a/crates/psrs-driver/src/tests/wasi/wrappers.rs +++ b/crates/psrs-driver/src/tests/wasi/wrappers.rs @@ -2,10 +2,10 @@ use super::*; #[test] fn reads_the_wall_clock_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Clock\n\ - main = let time = runEffect wallNow in time.seconds * 0\n"; + main = let time = unsafePerformEffect wallNow in time.seconds * 0\n"; let artifact = compile_source("Main.purs", source).expect("the wall-clock wrapper should lower"); assert!(artifact.wat.contains("wasi:clocks/wall-clock@0.2.12")); @@ -18,10 +18,10 @@ fn reads_the_wall_clock_when_wasmtime_is_available() { #[test] fn reads_the_wall_clock_resolution_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Clock\n\ - main = let tick = runEffect wallResolution in tick.nanoseconds * 0\n"; + main = let tick = unsafePerformEffect wallResolution in tick.nanoseconds * 0\n"; let artifact = compile_source("Main.purs", source) .expect("the wall-clock resolution wrapper should lower"); assert!(artifact.wat.contains("resolution")); @@ -34,10 +34,10 @@ fn reads_the_wall_clock_resolution_when_wasmtime_is_available() { #[test] fn reads_the_insecure_seed_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Random\n\ - main = let seed = runEffect insecureSeed in seed._1 * 0\n"; + main = let seed = unsafePerformEffect insecureSeed in seed._1 * 0\n"; let artifact = compile_source("Main.purs", source).expect("the insecure seed wrapper should lower"); assert!(artifact.wat.contains("wasi:random/insecure-seed@0.2.12")); @@ -50,10 +50,10 @@ fn reads_the_insecure_seed_when_wasmtime_is_available() { #[test] fn reads_insecure_random_values_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Random\n\ - main = let noise = runEffect insecureU64 in noise * 0\n"; + main = let noise = unsafePerformEffect insecureU64 in noise * 0\n"; let artifact = compile_source("Main.purs", source).expect("the insecure random wrappers should lower"); assert!(artifact.wat.contains("wasi:random/insecure@0.2.12")); @@ -66,11 +66,11 @@ fn reads_insecure_random_values_when_wasmtime_is_available() { #[test] fn polls_a_clock_subscription_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Clock (subscribeDuration)\n\ import WASI.IO\n\ - main = let waiter = runEffect (subscribeDuration 0) in arrayLength (runEffect (poll [waiter])) * 0\n"; + main = let waiter = unsafePerformEffect (subscribeDuration 0) in arrayLength (unsafePerformEffect (poll [waiter])) * 0\n"; let artifact = compile_source("Main.purs", source).expect("the poll wrapper should lower"); assert!(artifact.wat.contains("wasi:io/poll@0.2.12")); let Some(output) = run_with_wasmtime(source) else { @@ -82,11 +82,11 @@ fn polls_a_clock_subscription_when_wasmtime_is_available() { #[test] fn reads_a_pollable_readiness_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.Clock (subscribeDuration)\n\ import WASI.IO (ready, block)\n\ - main = let waiter = runEffect (subscribeDuration 0) in let ignored = runEffect (block waiter) in if runEffect (ready waiter) then 0 else 1\n"; + main = let waiter = unsafePerformEffect (subscribeDuration 0) in let ignored = unsafePerformEffect (block waiter) in if unsafePerformEffect (ready waiter) then 0 else 1\n"; let Some(output) = run_with_wasmtime(source) else { eprintln!("skipping: wasmtime is not installed"); return; @@ -96,10 +96,10 @@ fn reads_a_pollable_readiness_when_wasmtime_is_available() { #[test] fn writes_to_a_stream_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.IO\n\ - main = let out = runEffect getStdout in let ignored = runEffect (blockingWriteAndFlush out (stringToBytes \"streamed\")) in 0\n"; + main = let out = unsafePerformEffect getStdout in let ignored = unsafePerformEffect (blockingWriteAndFlush out (stringToBytes \"streamed\")) in 0\n"; let artifact = compile_source("Main.purs", source).expect("the stream write wrapper should lower"); assert!(artifact.wat.contains("wasi:cli/stdout@0.2.12")); @@ -113,10 +113,10 @@ fn writes_to_a_stream_when_wasmtime_is_available() { #[test] fn gets_stdin_when_wasmtime_is_available() { - let source = "module Main where\n\ + let source = "module Main where\nimport Effect.Unsafe (unsafePerformEffect)\n\ import Prelude\n\ import WASI.IO\n\ - main = let input = runEffect getStdin in 0\n"; + main = let input = unsafePerformEffect getStdin in 0\n"; let artifact = compile_source("Main.purs", source).expect("the stdin wrapper should lower"); assert!(artifact.wat.contains("wasi:cli/stdin@0.2.12")); let Some(output) = run_with_wasmtime(source) else { @@ -136,9 +136,8 @@ fn lowers_the_error_debug_string_wrapper() { } /// A module that declares a host `foreign import` must have an explicit export -/// list. Representation lowering suspends the host call inside the effect -/// closure, so a name on that list is the public operation. A name left off -/// the list stays private. +/// list. Raw canonical imports stay private; exported wrappers use Host.lift +/// to delay the call until native interpretation. #[test] fn stdlib_export_lists_do_not_expose_raw_foreign_imports() { let sources = crate::prelude::sources().expect("the standard library should load"); @@ -262,10 +261,11 @@ fn lowers_a_mapped_result_with_a_variant_payload() { // whose case field is a resource handle, so the decode has to build the // nested source value before erasing it into the `Either` case field. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import WASI.IO (getStdin, blockingRead, StreamError(..)) -main = case runEffect (blockingRead (runEffect getStdin) 1) of +main = case unsafePerformEffect (blockingRead (unsafePerformEffect getStdin) 1) of Right bytes -> 0 Left (LastOperationFailed _) -> 1 Left Closed -> 2 @@ -296,10 +296,11 @@ fn lowers_an_opaque_handle_resource_drop() { // The synthesized `[resource-drop]` intrinsic takes the opaque handle type, // so a source declaration may name it rather than a bare `Int`. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import WASI.IO (getStdin) import WASI.IO (dropInputStream) -main = let ignored = runEffect (dropInputStream (runEffect getStdin)) in 0 +main = let ignored = unsafePerformEffect (dropInputStream (unsafePerformEffect getStdin)) in 0 "#; let artifact = compile_source("Main.purs", source) .expect("an explicit drop of the opaque input-stream handle should lower"); @@ -309,15 +310,16 @@ main = let ignored = runEffect (dropInputStream (runEffect getStdin)) in 0 #[test] fn reads_stdin_with_blocking_read_when_wasmtime_is_available() { let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import WASI.Console (log) import WASI.IO (getStdin) import WASI.IO (blockingRead, StreamError(..)) main = - let result = runEffect (blockingRead (runEffect getStdin) 5) in + let result = unsafePerformEffect (blockingRead (unsafePerformEffect getStdin) 5) in case result of - Right text -> let ignored = runEffect (log (bytesToString text)) in 0 + Right text -> let ignored = unsafePerformEffect (log (bytesToString text)) in 0 Left (LastOperationFailed _) -> 1 Left Closed -> 2 "#; @@ -337,35 +339,36 @@ fn lowers_the_filesystem_wrapper_surface() { // parameters, a `result` result, an owned handle result, // and stream handles. let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import WASI.FileSystem main = - let dirs = runEffect preopens in + let dirs = unsafePerformEffect preopens in let dir = arrayIndex dirs 0 in let d = dir._1 in - let opened = runEffect (openRead d "a.txt") in - let wrote = runEffect (writeFile d (stringToBytes "x") 0) in - let bytes = runEffect (readFile d 1 0) in - let hash = runEffect (metadataHash d) in - let kind = runEffect (getType d) in - let flags = runEffect (getFlags d) in - let target = runEffect (readlinkAt d "a") in - let same = runEffect (isSameObject d d) in - let stats = runEffect (stat d) in - let statsAt = runEffect (statAt d { symlinkFollow: true } "a") in - let entries = runEffect (readDirectory d) in + let opened = unsafePerformEffect (openRead d "a.txt") in + let wrote = unsafePerformEffect (writeFile d (stringToBytes "x") 0) in + let bytes = unsafePerformEffect (readFile d 1 0) in + let hash = unsafePerformEffect (metadataHash d) in + let kind = unsafePerformEffect (getType d) in + let flags = unsafePerformEffect (getFlags d) in + let target = unsafePerformEffect (readlinkAt d "a") in + let same = unsafePerformEffect (isSameObject d d) in + let stats = unsafePerformEffect (stat d) in + let statsAt = unsafePerformEffect (statAt d { symlinkFollow: true } "a") in + let entries = unsafePerformEffect (readDirectory d) in let readEntry = case entries of Left _ -> 1 Right stream -> - let entry = runEffect (readDirectoryEntry stream) in - let dropped = runEffect (dropDirectoryEntryStream stream) in + let entry = unsafePerformEffect (readDirectoryEntry stream) in + let dropped = unsafePerformEffect (dropDirectoryEntryStream stream) in 0 in - let ignoredTimes = runEffect (setTimes d NoChange NoChange) in - let ignoredTimesAt = runEffect (setTimesAt d { symlinkFollow: true } "a" NoChange NoChange) in - let bracketed = runEffect (withDescriptor d (\handle -> getType handle)) in - let ignored = runEffect (setSize d 0) in + let ignoredTimes = unsafePerformEffect (setTimes d NoChange NoChange) in + let ignoredTimesAt = unsafePerformEffect (setTimesAt d { symlinkFollow: true } "a" NoChange NoChange) in + let bracketed = unsafePerformEffect (withDescriptor d (\handle -> getType handle)) in + let ignored = unsafePerformEffect (setSize d 0) in 0 "#; let artifact = @@ -377,6 +380,7 @@ main = #[test] fn lowers_the_sockets_wrapper_surface() { let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) @@ -384,26 +388,26 @@ import WASI.Network addr :: IpSocketAddress addr = IpV4SocketAddress { port: 0, address: { _1: 0, _2: 0, _3: 0, _4: 0 } } main = - let network = runEffect instanceNetwork in - let created = runEffect (createTcpSocket Ipv4) in + let network = unsafePerformEffect instanceNetwork in + let created = unsafePerformEffect (createTcpSocket Ipv4) in let tcp = case created of Right socket -> - let ignored = runEffect (tcpStartBind socket network addr) in - let ignoredFinish = runEffect (tcpFinishBind socket) in - let family = runEffect (tcpAddressFamily socket) in - let local = runEffect (tcpLocalAddress socket) in - let remote = runEffect (tcpRemoteAddress socket) in - let dropped = runEffect (dropTcpSocket socket) in + let ignored = unsafePerformEffect (tcpStartBind socket network addr) in + let ignoredFinish = unsafePerformEffect (tcpFinishBind socket) in + let family = unsafePerformEffect (tcpAddressFamily socket) in + let local = unsafePerformEffect (tcpLocalAddress socket) in + let remote = unsafePerformEffect (tcpRemoteAddress socket) in + let dropped = unsafePerformEffect (dropTcpSocket socket) in 0 Left _ -> 1 in - let createdUdp = runEffect (createUdpSocket Ipv4) in + let createdUdp = unsafePerformEffect (createUdpSocket Ipv4) in let udp = case createdUdp of Right socket -> - let local = runEffect (udpLocalAddress socket) in - let remote = runEffect (udpRemoteAddress socket) in - let streams = runEffect (udpSocketStream socket Nothing) in - let dropped = runEffect (dropUdpSocket socket) in + let local = unsafePerformEffect (udpLocalAddress socket) in + let remote = unsafePerformEffect (udpRemoteAddress socket) in + let streams = unsafePerformEffect (udpSocketStream socket Nothing) in + let dropped = unsafePerformEffect (dropUdpSocket socket) in 0 Left _ -> 1 in @@ -456,10 +460,11 @@ fn rejects_a_raw_sockets_import_from_the_library() { #[test] fn drops_a_stream_handle_when_wasmtime_is_available() { let source = r#"module Main where +import Effect.Unsafe (unsafePerformEffect) import Prelude import WASI.IO (getStdin) import WASI.IO (dropInputStream) -main = let ignored = runEffect (dropInputStream (runEffect getStdin)) in 7 +main = let ignored = unsafePerformEffect (dropInputStream (unsafePerformEffect getStdin)) in 7 "#; let artifact = compile_source("Main.purs", source).expect("the drop wrapper should lower"); assert!(artifact.wat.contains("[resource-drop]input-stream")); diff --git a/crates/psrs-hir/src/lib.rs b/crates/psrs-hir/src/lib.rs index 9a0ebc9d..d9002fd7 100644 --- a/crates/psrs-hir/src/lib.rs +++ b/crates/psrs-hir/src/lib.rs @@ -151,6 +151,10 @@ impl ExternalKind { #[derive(Clone, Debug, PartialEq, Eq)] pub struct ExternalSymbol { + /// The declaring source module, retained when an import copies this symbol. + /// Compiler-provided intrinsics and post-checking synthetic externals have + /// no source declaration. + pub source_module: Option, pub symbol: SymbolId, pub name: String, pub kind: ExternalKind, @@ -183,6 +187,20 @@ pub struct Module { } impl Module { + /// Value annotations declared by this source module. Imported external + /// signatures retain their original owner and are checked there. + pub fn declared_value_signatures(&self) -> impl Iterator { + self.declarations + .iter() + .filter_map(|declaration| declaration.signature.as_ref()) + .chain( + self.externals + .iter() + .filter(|external| external.source_module == Some(self.id)) + .filter_map(|external| external.signature.as_ref()), + ) + } + /// Checks that every reference targets a declaration visible in this module. pub fn verify(&self) -> Result<(), Vec> { let mut errors = Vec::new(); @@ -208,6 +226,18 @@ impl Module { } } for external in &self.externals { + if external.kind.requires_checked_signature() && external.source_module.is_none() { + errors.push(VerifyError { + span: self.span, + message: "source external has no declaring module", + }); + } + if external.kind.requires_checked_signature() && external.signature.is_none() { + errors.push(VerifyError { + span: self.span, + message: "source external has no declared signature", + }); + } if external.symbol.module != ModuleId::INTRINSICS { errors.push(VerifyError { span: self.span, diff --git a/crates/psrs-kind/src/check/infer/mod.rs b/crates/psrs-kind/src/check/infer/mod.rs index 4b231e4c..9b4770fb 100644 --- a/crates/psrs-kind/src/check/infer/mod.rs +++ b/crates/psrs-kind/src/check/infer/mod.rs @@ -170,12 +170,10 @@ impl Checker<'_> { } fn check_module_definitions(&mut self, module: &hir::Module) { - for declaration in &module.declarations { - if let Some(signature) = &declaration.signature { - let mut scope = HashMap::new(); - let kind = self.kind_of_type(signature, &mut scope); - self.unify(kind, type_kind(), signature.span); - } + for signature in module.declared_value_signatures() { + let mut scope = HashMap::new(); + let kind = self.kind_of_type(signature, &mut scope); + self.unify(kind, type_kind(), signature.span); } for declaration in &module.types { let Some(scheme) = self.schemes.get(&declaration.id).cloned() else { diff --git a/crates/psrs-kind/src/check/mod.rs b/crates/psrs-kind/src/check/mod.rs index fc4526d5..6c0418ce 100644 --- a/crates/psrs-kind/src/check/mod.rs +++ b/crates/psrs-kind/src/check/mod.rs @@ -197,11 +197,9 @@ impl<'a> Checker<'a> { fn check_defined_variables(&mut self) { for module in self.modules { self.current = module.id; - for declaration in &module.declarations { - if let Some(signature) = &declaration.signature { - let mut bound = Vec::new(); - self.check_references(signature, &mut bound); - } + for signature in module.declared_value_signatures() { + let mut bound = Vec::new(); + self.check_references(signature, &mut bound); } for declaration in &module.types { let mut bound: Vec = Vec::new(); diff --git a/crates/psrs-kind/src/check/synonyms.rs b/crates/psrs-kind/src/check/synonyms.rs index edc66c5b..7b4267c5 100644 --- a/crates/psrs-kind/src/check/synonyms.rs +++ b/crates/psrs-kind/src/check/synonyms.rs @@ -170,8 +170,7 @@ fn expand_synonym( .zip(arguments) .collect::>(); let instantiated = hir::substitute_type_variables(&synonym.body, &mapping, next_fresh); - let expanded = expand_inner(&instantiated, synonyms, fuel, next_fresh); - expanded + expand_inner(&instantiated, synonyms, fuel, next_fresh) } fn flatten_spine(ty: &hir::Type) -> (&hir::Type, Vec) { diff --git a/crates/psrs-kind/src/tests/foreign.rs b/crates/psrs-kind/src/tests/foreign.rs new file mode 100644 index 00000000..427bef11 --- /dev/null +++ b/crates/psrs-kind/src/tests/foreign.rs @@ -0,0 +1,43 @@ +use super::*; + +#[test] +fn foreign_value_annotations_are_checked_at_their_declaring_module() { + let modules = resolve_program(&[ + ( + "Main.purs", + "module Main where\nimport Lib (bad)\nmain = bad\n", + ), + ( + "Lib.purs", + "module Lib where\ndata Region\nforeign import data R :: Region\nforeign import bad :: R\n", + ), + ( + "Other.purs", + "module Other where\nimport Lib (bad)\nvalue = bad\n", + ), + ]); + let diagnostics = check_modules(&modules); + let conflicts = diagnostics + .iter() + .filter(|error| error.code == "KindsDoNotUnify") + .collect::>(); + assert_eq!(conflicts.len(), 1, "{diagnostics:?}"); + assert_eq!(conflicts[0].origin, ModuleId(1)); +} + +#[test] +fn foreign_annotations_preserve_parameter_kinds_and_forall_scope() { + for source in [ + "module Test where\ndata Region\ndata Box :: Region -> Type\ndata Box r = Box\nforeign import bad :: Box Int\n", + "module Test where\nforeign import bad :: a\n", + ] { + let diagnostics = check(source); + assert!( + diagnostics + .iter() + .any(|error| matches!(error.code, "KindsDoNotUnify" | "UndefinedTypeVariable")), + "{diagnostics:?}" + ); + } + assert!(check("module Test where\nforeign import good :: forall a. a -> a\n").is_empty()); +} diff --git a/crates/psrs-kind/src/tests/mod.rs b/crates/psrs-kind/src/tests/mod.rs index 7a848146..bb434c53 100644 --- a/crates/psrs-kind/src/tests/mod.rs +++ b/crates/psrs-kind/src/tests/mod.rs @@ -6,6 +6,7 @@ use crate::kind::KindDiagnostic; use psrs_hir::ModuleId; mod declarations; +mod foreign; mod instances; mod program; mod roles; diff --git a/crates/psrs-resolve/src/resolver/bootstrap.rs b/crates/psrs-resolve/src/resolver/bootstrap.rs index 124fd71f..aac83c50 100644 --- a/crates/psrs-resolve/src/resolver/bootstrap.rs +++ b/crates/psrs-resolve/src/resolver/bootstrap.rs @@ -12,6 +12,7 @@ pub fn bootstrap_externals() -> Vec { .map(|intrinsic| { let descriptor = intrinsic.descriptor(); ExternalSymbol { + source_module: None, symbol: intrinsic.symbol(), name: descriptor.name.to_owned(), kind: ExternalKind::Intrinsic(intrinsic), diff --git a/crates/psrs-resolve/src/resolver/module_resolution.rs b/crates/psrs-resolve/src/resolver/module_resolution.rs index ec12303d..da59a743 100644 --- a/crates/psrs-resolve/src/resolver/module_resolution.rs +++ b/crates/psrs-resolve/src/resolver/module_resolution.rs @@ -151,6 +151,7 @@ pub(crate) fn resolve_ast_module( foreign.name.text.clone(), symbol, ExternalSymbol { + source_module: Some(module_id), symbol, name: foreign.name.text.clone(), kind, diff --git a/crates/psrs-thir/src/external_type_tests.rs b/crates/psrs-thir/src/external_type_tests.rs index c87a416c..5a3a107a 100644 --- a/crates/psrs-thir/src/external_type_tests.rs +++ b/crates/psrs-thir/src/external_type_tests.rs @@ -8,6 +8,7 @@ fn fixture() -> Module { id: ModuleId(2), name: "ExternalScheme".into(), externals: vec![ExternalSymbol { + source_module: None, symbol, name: "clock".into(), kind: ExternalKind::Wit { diff --git a/crates/psrs-typecheck/src/typecheck/entry.rs b/crates/psrs-typecheck/src/typecheck/entry.rs index 40b4ab0f..9512f46e 100644 --- a/crates/psrs-typecheck/src/typecheck/entry.rs +++ b/crates/psrs-typecheck/src/typecheck/entry.rs @@ -187,7 +187,7 @@ pub fn typecheck_module_with_checked_kinds_and_module_names_and_warnings( let ty = checker.finalize_type(&inferred, signature.span, &mut types, &generics)?; Some(thir::ExternalType { symbol: external.symbol, - source_module: module.id, + source_module: external.source_module.unwrap_or(module.id), ty, }) }) diff --git a/docs/design/D-04-suite-roadmap.md b/docs/design/D-04-suite-roadmap.md index 649fea6c..05d092de 100644 --- a/docs/design/D-04-suite-roadmap.md +++ b/docs/design/D-04-suite-roadmap.md @@ -1201,9 +1201,9 @@ Wasm is the target encoding, and WIT/WASI are the platform integration layers. | BE-18 | Generic source-declared WIT imports | Compatible `Int`/`Boolean`/`Number` scalars, handles, and `list`/`string` imports lower through the canonical ABI with signature validation. A WIT `string` is a source `String` and a WIT `list` is `Array Int`, so the two no longer share a source type ([DEC-16](../decision/DEC-16-scalar-strings-and-utf8-storage.md)). Closed, directly flattened WIT records can contain nested `list` fields. | Partial | Add other aggregate WIT values, richer results, and user-library loading. | | BE-19 | WIT aggregate values and resources | Resource handles lower under [DEC-14](../decision/DEC-14-resource-handle-ownership.md): the compiler drops no handle on its own and exposes `resource.drop` to source, so the standard library owns the lifetime discipline; byte lists and closed WIT records with nested byte-list fields are classified and lowered in WIT field order. Indirect parameter tuples are allocated through `cabi_realloc`. Non-byte `list` of scalars, `bool`, `char`, strings, nullary enums, flags, resource handles, and directly flattened records of scalar or string fields is copied between a source GC array and the canonical buffer, with a driver execution test for `list` and synthesized Wasm fixtures for `list`, `list`, and `list` ([ABI-08](../implementation/backend/linear-memory-and-canonical-abi.md) In progress). `option`, `result`, and non-unit `variant` are classified and validated against `Data.Maybe.Maybe`, `Data.Either.Either`, and a source data type, CC derives their variant representation and a concrete payload tree, and MIR branches on each tag and rebuilds the source value recursively for a scalar payload of any width (`s8`..`u64`, `f32`/`f64`), a byte or non-byte list, `flags`, a closed record, and a nested `option`/`result`/`variant`, recursing through record fields and a `list`/`list` element, with synthesized Wasm fixtures ([DEC-13](../decision/DEC-13-wit-to-source-type-mapping.md)); a large aggregate return area is allocated through `cabi_realloc`, a handle in a result is an ordinary value the standard library drops explicitly, and an indirect parameter record carries a mapped aggregate. The aggregate ABI is generated from one normalized canonical type ([compositional canonical ABI lowering](backend/wasm/canonical-abi-compositional.md)); the descriptor types and per-shape plans are removed. `list>`/`list`/`list` elements, nested `list>`, multi-word flags as list elements and in aggregates, non-byte `list`, and `list>` results are classified and lowered, and a unit-success `result<_, E>` maps to `Either E Unit` (the error on `Left`) and sizes its return area from the error payload. | Partial | Add general aggregate layouts beyond the list-and-handle subset. | | BE-20 | Component Model packaging and capability-based imports | `wit-component` lifts the core module to a WASI 0.2 component and prunes unused imports. | Partial | Add component import/export regression cases beyond the CLI path and pass the L6/M7 gate. | -| BE-21 | WASI CLI entry, exit, stdout, and stderr | `wasi:cli/run`, exit codes, console output, and error output work in the component path. A selected `Int` entry returns its value as the exit code. The former `Effect Unit` entry capability was removed on 2026-10-11; a non-`Int` entry is rejected and the replacement representation is undecided. Focused Wasmtime tests assert output and status for `Int` entries. The latest official runtime board is 164/413; 46 files have no selected `main`, and this row stays Partial. | Partial | Pass the L6/M7 gate. The 46 files with no selected `main` stay explicit blockers, and every non-`Int` entry remains unsupported. | +| BE-21 | WASI CLI entry, exit, stdout, and stderr | `wasi:cli/run`, exit codes, console output, and error output work in the component path. A selected `Int` entry returns its value as the exit code. The former compiler-owned `Effect Unit` entry was removed on 2026-10-11. A compiler-selected non-`Int` entry is still rejected. Effect programs use the library `PSRS.Command.run` runner over the accepted native representation; that runner does not change this row's scoreboard. Focused Wasmtime tests assert output and status for `Int` entries. The latest official runtime board is 164/413; 46 files have no selected `main`, and this row stays Partial. | Partial | Pass the L6/M7 gate. The 46 files with no selected `main` stay explicit blockers, and every compiler-selected non-`Int` entry remains unsupported. | | BE-22 | WASI clocks and randomness | Monotonic time and random bytes are wired through WASI and tested. | Partial | Expose the remaining clock/random library surface and pass the L6/M7 gate. | -| BE-23 | WASI arguments, environment, and filesystem | WIT descriptions are vendored, but the source library and aggregate lowering are not complete ([WASI-07](../implementation/backend/wasi-platform.md) In progress). | Planned | Add module loading and aggregate/list support, then expose these services. | +| BE-23 | WASI arguments, environment, and filesystem | Source wrappers for arguments, environment, and filesystem execute ([WASI-07](../implementation/backend/wasi-platform.md) Verified). This feature row was not remeasured with the 2026-10-16 native-effect fingerprint, and the L6/M7 gate is still open. | Partial | Pass the L6/M7 gate. | | BE-24 | WASI sockets and HTTP | Not part of the current synchronous portable-program target. | Excluded | Revisit as a separate platform scope after the core target is stable. | | BE-25 | WASI 0.3 async streams and futures | The current compiler targets synchronous WASI 0.2. | Planned | Revisit only with an explicit platform decision and async language/library plan. | | BE-26 | Standard library and user module loading | User modules are discovered from the entry files' directories and linked transitively ([WASI-09](../implementation/backend/wasi-platform.md) Verified); the PureScript-facing standard library is loaded from `stdlib/lib` in trusted-prefix order ([WASI-10](../implementation/backend/wasi-platform.md) Verified). | Partial | Pass the L6/M7 module-loading scoreboard. | @@ -1225,15 +1225,15 @@ acceptance result. | Polymorphism and erasure | BE-02, BE-08; FE-09 input | Re-baselined by DEC-10: PE-01..PE-11 are Verified, including GC-string erasure and capture. | [PE-01..PE-11](../implementation/backend/polymorphism-and-erasure.md) | | Scalars and primitives | BE-04; FE-08 input | Re-baselined by DEC-10: SP-01..SP-12 are Verified, including the GC-string representation. | [SP-01..SP-12](../implementation/backend/scalars-and-primitives.md) | | Pattern matching | BE-05, BE-06; supporting BE-08, BE-09 | PM-01..PM-15 have implementation, verifier, and required execution evidence. PM-14 includes source-spanned Boolean redundancy and guarded fallthrough; broader feature rows retain their separate gates. | [PM-01..PM-15](../implementation/backend/pattern-matching.md) | -| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Labelled Control rows over pinned VariantF execute deep forwarding and shallow residual policies. Complete pinned Run/Free dependency sources are imported unchanged; representative pure Run State, Choose and combined Reader/State/Writer/Except programs execute with observed values and log order. CC/MIR now check dispatch coverage and selected-case projections, required scoped clause application results and current operands, and Bind/Resume transition identities; scoped MIR applications must execute on the actual branch path. Complete remaining execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and broader upstream-library API acceptance remain unverified. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | -| Effects | BE-21; supporting BE-02, BE-26 | **Withdrawn 2026-10-11.** The compiler no longer owns the `Effect` type or its operations. Trusted Effect identities, the `Effect Unit` command adapter, the lexical `runEffect` rule, and the `EF-01..EF-13` implementation were removed; the replacement Effect representation is undecided. The linked implementation record is retained as historical evidence. | Withdrawn; replacement undecided | +| Delimited control and generic handlers | BE-02, BE-03, BE-05, BE-06, BE-12; supporting BE-21, BE-26 | Partial: the eight operations implement typed contract v2 with persistent queues and one guest context executor. Mandatory Wasmtime covers clause/return-clause scope, deep/shallow library policies, forwarding, abandonment, aggregate/GC captures, multi-shot replay, replay-local expiry, normal target-completion expiry and long request sequences. Parent-chain probes and post-GC live-heap measurements cover long deep and mixed-forwarding loops while independent non-tail extents remain distinct. Core owns shared checked carrier/callable contracts; immutable CC quotations and live optimized MIR witnesses retain source/target domains and reject incompatible locally proven operands. CC verifies factory operands against those witnesses. Predeclared semantic helper identities reject check/close swaps in CC and MIR calls, including tail calls; mandatory execution also covers 100,000 requests with tail-call capability disabled. Source carrier parameters, results and joins now share the preplanned nominal computation/owner shapes; control entry operands use their declared storage roles without an unconditional payload erasure round trip. Nominal machine storage fields and helper calls reject cross-wired queues, extents and ownership cells in CC/MIR, and CC/MIR check raw capture roles against local closure targets. CC/MIR also check that finish completion closes and restores fields from the same record, rejecting missing close and same-shaped boundary swaps. A predeclared raw-resumption binding now checks the dispatch checkpoint capture, raw capture slots, Resume construction and the saved checkpoint check before replay; MIR requires the check to dominate replay. CC/MIR now also check saved finish validation, original callback sharing and fresh live activation cells within rebuild iterations, including parent/restoration/advancement and terminal replay product identities. Target finishes now preserve one source context and enter its caller; finish copies preserve original extent/parent and append order. Replay entry checks current execution/dispatch ancestry and empty accumulators, with traversal/handoff/callback rebuild preserving active/parent state. Source context constructors now retain current Handle clauses, caller and saved work, with fresh or shared-finish lifetime operands; their transitions enter the inner computation with an empty queue and the new context/extent. Root Run factories now check empty queues, coherent root dispatch/execution extents and normal cleanup, preserving allocation evidence through Start inlining and rejecting sequential extent/status reuse while admitting exclusive initialization. Labelled Control rows over pinned VariantF execute deep forwarding and shallow residual policies. Complete pinned Run/Free dependency sources are imported unchanged; representative pure Run State, Choose and combined Reader/State/Writer/Except programs execute with observed values and log order. CC/MIR now check dispatch coverage and selected-case projections, required scoped clause application results and current operands, and Bind/Resume transition identities; scoped MIR applications must execute on the actual branch path. Complete remaining execution-step, dispatch selection and frame/context provenance, foreign capture, caught-trap cleanup and broader upstream-library API acceptance remain unverified. AE-11 host IO is Verified on 2026-10-16 in that checklist; the provenance items in this cell were not closed by that measurement. | [AE/AC checklist](../implementation/backend/algebraic-effects.md) | +| Effects | BE-21; supporting BE-02, BE-26 | The compiler-owned `Effect` protocol was withdrawn on 2026-10-11. The accepted replacement is library-owned `PSRS.Effect.Native`: NE-01–NE-13 and AE-11 are Verified on 2026-10-16 at fingerprint `fnv1a64-v1:ad19620ada1d2ecf`. `checkThrows`, Console timers, `Effect.Exception`, and `Effect.Aff` stay unimplemented JavaScript foreigns. The runtime board remains 164/413 because it was not remeasured, so BE-21 stays Partial. The independent package commit and lock revision are `4c73aab52226e8f5e7b1f17052f1a19d717a472e`. | [NE-01..NE-13](../implementation/backend/native-effect-and-st.md), [AE-11](../implementation/backend/algebraic-effects.md) | | Type classes and dictionaries | BE-02, BE-09; FE-14/15 input | Backend acceptance complete from verified Typed Core fixtures: DICT-01..DICT-11 have implementation, verifier, and required execution evidence. Source constrained calls, contextual/imported generic instances, superclasses, fundeps, and ordered instance chains execute; FE-14/15 remain partial for remaining source class/fundep coverage, the constrained instance-member specialization limit, and official-suite acceptance. Class-method local constraints are covered under FE-18; deriving is tracked under FE-22. | [DICT-01..DICT-11](../implementation/backend/type-classes-and-dictionaries.md) | | Generic aggregate erasure | BE-08, BE-09, BE-10; supporting BE-02, BE-03, BE-13, BE-15 | Topic acceptance complete: all GA-01..GA-20 checks have implementation, verifier and required execution evidence. Broader feature rows retain their separate gates. | [Requirements, repair evidence, and validation](../implementation/backend/generic-aggregate-erasure.md) | | Optimization | BE-12 | Topic acceptance complete: OPT-01..OPT-14 have implementation, verifier, and required execution evidence. The official M8-O gate stays on the broader BE-12 row. | [OPT-01..OPT-14](../implementation/backend/optimization.md) | | Wasm encoding, validation, and capability | BE-13, BE-14, BE-16; supporting BE-15 | Topic acceptance complete: ENC-01..ENC-11 have implementation, verifier, and required execution evidence. Broader feature rows retain their separate gates. | [ENC-01..ENC-11](../implementation/backend/wasm-encoding.md) | | Linear memory and canonical ABI | BE-11, BE-17..BE-20 | Re-baselined by DEC-10 and split: LM-02, LM-04, LM-05, ABI-01, ABI-02, ABI-03, ABI-06, and ABI-07 Verified; LM-01 In progress for the one-memory profile; `own`/`borrow` handle drop is lowered; ABI-08's non-byte `list` of scalars, `bool`, `char`, strings, nullary enums, flags, resource handles, and directly flattened records of scalar or string fields is lowered with a driver execution test and synthesized Wasm fixtures. `option`, `result`, and non-unit `variant` are recognized on the resolved-type path ([DEC-13](../decision/DEC-13-wit-to-source-type-mapping.md)) — classification, Core conformance validation, CC's variant representation and payload tree, and MIR recursive tag-branch lowering for a scalar payload of any width (`s8`..`u64`, `f32`/`f64`), a byte or non-byte list, `flags`, a closed record, and a nested `option`/`result`/`variant` are implemented, recursing through record fields and a `list`/`list` element, and a large aggregate return area is allocated through `cabi_realloc`; under [DEC-14](../decision/DEC-14-resource-handle-ownership.md) the compiler drops no handle on its own and exposes `resource.drop` to source — and a tuple maps to a closed record. A wrapper may still pass one of those forms as primitive arguments whose flattening matches; multi-value returns stay unsupported. The allocator, buffer free, and post-return moved to canonical buffer allocation. The aggregate ABI now runs on one normalized canonical type ([compositional canonical ABI lowering](backend/wasm/canonical-abi-compositional.md)); the descriptor vocabulary and per-shape free plans are deleted. ABI-08's remaining list shapes (`list